From 2c842f7b8b11155419e7c46d411b6c14abec16d5 Mon Sep 17 00:00:00 2001 From: "John C. Burnham" Date: Fri, 11 Sep 2026 11:05:20 -0400 Subject: [PATCH 01/31] Integrate certified checking and Aiur soundness foundations Import the compiler and selected consistency model into Ix, consolidate the production kernel, and maintain the certified source and claim adapters with their exact provenance, dependency audits, differential corpora and CI gates. Repair Aiur call-cycle, inactive lookup, memory and compiler-normalization soundness defects, retain native supplied-witness regressions, and add checked extraction from balanced physical circuit lookups to finite bytecode execution. Derive witness shapes and lookup limits from the actual compiler and grouping. The Aiur component audit now checks 268 roots and freezes their exact premises and runtime inventory. Full public certified-verification soundness remains open: native/FFI reflection, the remaining compiler and certified VM bridge, release selection and the concrete cryptographic reduction are not asserted. Validation: compiler, theory, certified-adapter and Aiur component gates; 49 parallel release Aiur tests, release Clippy, 1,345 broader Aiur assertions, C2 VM integration cases, and exact generated VM source comparisons. --- .github/workflows/ci.yml | 29 +- .github/workflows/merge-tests.yml | 23 +- .github/workflows/set-theory-model.yml | 47 + AGENTS.md | 6 + BENCHMARKS.md | 6 +- .../Compile/TruthMines/Members/Lean4Lean.lean | 2 - .../Compile/TruthMines/lake-manifest.json | 10 - Benchmarks/Compile/lake-manifest.json | 10 - Benchmarks/Compiler.lean | 52 + Benchmarks/Compiler/Analyze.lean | 317 + Benchmarks/Compiler/Build.lean | 255 + Benchmarks/Compiler/Check.lean | 121 + Benchmarks/Compiler/CounterFold.lean | 213 + Benchmarks/Compiler/CounterFoldBuild.lean | 182 + Benchmarks/Compiler/CounterFoldRun.lean | 184 + Benchmarks/Compiler/Data.lean | 159 + Benchmarks/Compiler/Diagnostics.lean | 139 + Benchmarks/Compiler/Environment.lean | 71 + Benchmarks/Compiler/Measure.lean | 149 + Benchmarks/Compiler/Pilot.lean | 108 + Benchmarks/Compiler/Reproduce.lean | 98 + Benchmarks/Compiler/Schedule.lean | 146 + Benchmarks/Compiler/Verify.lean | 114 + Benchmarks/Compiler/cakeml/reverse.cml | 132 + Benchmarks/Compiler/counter-fold.md | 80 + Benchmarks/Compiler/lean/LeanReverse.lean | 12 + Benchmarks/Compiler/manifest.json | 88 + Benchmarks/Compiler/native/arena.h | 17 + Benchmarks/Compiler/native/arena_backend.c | 130 + Benchmarks/Compiler/native/arena_kernel.c | 70 + Benchmarks/Compiler/native/cakeml_ffi.c | 100 + Benchmarks/Compiler/native/common.c | 170 + Benchmarks/Compiler/native/common.h | 43 + Benchmarks/Compiler/native/driver.c | 90 + Benchmarks/Compiler/native/lean_backend.c | 83 + Benchmarks/Compiler/native/worker_launcher.c | 29 + Benchmarks/Compiler/protocol.md | 167 + Benchmarks/Compiler/toolchains.json | 47 + Benchmarks/Lean4Lean.lean | 541 - Benchmarks/Lean4LeanMain.lean | 11 - Benchmarks/TruthMines/Drivers/Lean4Lean.lean | 2 - Benchmarks/TruthMines/lake-manifest.json | 10 - Benchmarks/TruthMines/lakefile.lean | 2 - Benchmarks/TruthMinesSpec/Catalog.lean | 5 - Benchmarks/TruthMinesSpec/Spec.lean | 2 - CLAUDE.md | 1 + Ix.lean | 2 +- Ix/Address.lean | 7 +- Ix/Aiur/BoundVerifier.lean | 124 + Ix/Aiur/Branchless.lean | 27 + Ix/Aiur/Compiler.lean | 19 +- Ix/Aiur/Compiler/Dedup.lean | 45 +- Ix/Aiur/Compiler/Layout.lean | 8 +- Ix/Aiur/Compiler/Lower.lean | 2 +- Ix/Aiur/LookupShapes.lean | 114 + Ix/Aiur/Proofs.lean | 61 + Ix/Aiur/Proofs/Activity.lean | 60 + Ix/Aiur/Proofs/Audit.lean | 660 + Ix/Aiur/Proofs/BlockQueryPool.lean | 71 + Ix/Aiur/Proofs/BlockQuerySlots.lean | 303 + Ix/Aiur/Proofs/BlockRowCalls.lean | 272 + Ix/Aiur/Proofs/BlockRowExecution.lean | 666 + Ix/Aiur/Proofs/BlockRowInputs.lean | 312 + Ix/Aiur/Proofs/BlockRowProjection.lean | 436 + Ix/Aiur/Proofs/BlockRows.lean | 159 + Ix/Aiur/Proofs/BranchSelection.lean | 117 + Ix/Aiur/Proofs/BranchlessSlots.lean | 177 + Ix/Aiur/Proofs/ByteArithmetic.lean | 185 + Ix/Aiur/Proofs/ByteLookups.lean | 284 + Ix/Aiur/Proofs/CallInventory.lean | 93 + Ix/Aiur/Proofs/CallOrder.lean | 143 + Ix/Aiur/Proofs/CircuitMembership.lean | 234 + Ix/Aiur/Proofs/CircuitPoolExecution.lean | 114 + Ix/Aiur/Proofs/CircuitRowCounts.lean | 133 + Ix/Aiur/Proofs/CircuitRowExecution.lean | 54 + Ix/Aiur/Proofs/CircuitRowMembers.lean | 203 + Ix/Aiur/Proofs/CircuitRowQueries.lean | 160 + Ix/Aiur/Proofs/CircuitRowReturns.lean | 117 + Ix/Aiur/Proofs/CircuitRows.lean | 102 + Ix/Aiur/Proofs/CircuitTableData.lean | 130 + Ix/Aiur/Proofs/CircuitTableExecution.lean | 152 + Ix/Aiur/Proofs/CircuitTraces.lean | 217 + Ix/Aiur/Proofs/Compilation.lean | 98 + Ix/Aiur/Proofs/Dedup.lean | 67 + Ix/Aiur/Proofs/EncodedCircuitExecution.lean | 159 + Ix/Aiur/Proofs/Execution.lean | 182 + Ix/Aiur/Proofs/Field.lean | 268 + Ix/Aiur/Proofs/FunctionRows.lean | 168 + Ix/Aiur/Proofs/GlobalLookups.lean | 536 + Ix/Aiur/Proofs/Grouping.lean | 139 + Ix/Aiur/Proofs/LocalConstraints.lean | 190 + Ix/Aiur/Proofs/Lookup.lean | 168 + Ix/Aiur/Proofs/LookupBudget.lean | 268 + Ix/Aiur/Proofs/LookupLayout.lean | 1021 + Ix/Aiur/Proofs/LookupMessages.lean | 371 + Ix/Aiur/Proofs/LookupShapes.lean | 264 + Ix/Aiur/Proofs/Memory.lean | 236 + Ix/Aiur/Proofs/Metadata.lean | 159 + Ix/Aiur/Proofs/NormalizationFrames.lean | 162 + Ix/Aiur/Proofs/OperationRows.lean | 663 + Ix/Aiur/Proofs/ProviderEquivalence.lean | 103 + Ix/Aiur/Proofs/PublicCircuitExecution.lean | 78 + Ix/Aiur/Proofs/QuerySlotMessages.lean | 216 + Ix/Aiur/Proofs/QuerySlots.lean | 203 + Ix/Aiur/Proofs/Renaming.lean | 284 + Ix/Aiur/Proofs/ReturnGates.lean | 214 + Ix/Aiur/Proofs/RowCounts.lean | 236 + Ix/Aiur/Proofs/SelectorControl.lean | 377 + Ix/Aiur/Proofs/SelectorMessages.lean | 217 + Ix/Aiur/Proofs/TailMatches.lean | 85 + Ix/Aiur/RowCounts.lean | 105 + Ix/Aiur/Semantics/AIR.lean | 214 + Ix/Aiur/Semantics/BytecodeEval.lean | 11 +- Ix/Aiur/Semantics/Flatten.lean | 29 +- Ix/Aiur/Semantics/SourceEval.lean | 17 +- Ix/Aiur/Stages/Bytecode.lean | 207 +- Ix/Aiur/Stages/Source.lean | 599 +- Ix/AuxGen/ExprUtils.lean | 2 +- Ix/AuxGen/Kernel.lean | 148 +- Ix/AuxGen/Nested.lean | 2 +- Ix/AuxGen/Recursor.lean | 10 +- Ix/BenchConstants.lean | 4 +- Ix/Certified.lean | 13 + Ix/Certified/Audit.lean | 28 + Ix/Certified/AuditAll.lean | 25 + Ix/Certified/AuditSupport.lean | 162 + Ix/Certified/Bytes.lean | 151 + Ix/Certified/ClaimAccept.lean | 164 + Ix/Certified/ClaimAudit.lean | 49 + Ix/Certified/ClaimCheck.lean | 104 + Ix/Certified/ClaimCommand.lean | 117 + Ix/Certified/ClaimInput.lean | 145 + Ix/Certified/ClaimMain.lean | 8 + Ix/Certified/ClaimMeaning.lean | 151 + Ix/Certified/ClaimSuggest.lean | 75 + Ix/Certified/Command.lean | 96 + Ix/Certified/Corpus.lean | 123 + Ix/Certified/Envelope.lean | 92 + Ix/Certified/Fixtures.lean | 141 + Ix/Certified/Ingress.lean | 315 + Ix/Certified/Ixon.lean | 225 + Ix/Certified/Main.lean | 8 + Ix/Certified/ModelHints.lean | 104 + Ix/Certified/ModeledAudit.lean | 56 + Ix/Certified/NOTICE | 22 + Ix/Certified/Packet.lean | 185 + Ix/Certified/Reveal.lean | 155 + Ix/Certified/SourceAudit.lean | 39 + Ix/Certified/SourceExpr.lean | 274 + Ix/Certified/SourceMeaning.lean | 245 + Ix/Certified/SourceStore.lean | 318 + Ix/Certified/Store.lean | 74 + Ix/Certified/Suggest.lean | 31 + Ix/Certified/TcAudit.lean | 42 + Ix/Certified/Trees.lean | 117 + Ix/Cli/BenchCmd.lean | 42 +- Ix/Cli/CheckLeanCmd.lean | 12 +- Ix/Cli/ValidateLeanCmd.lean | 6 +- Ix/Compile/Verify/Audit/SorryFrontier.lean | 2 +- Ix/Compile/Verify/Audit/Statements.lean | 163 +- Ix/Compile/Verify/Catalog.lean | 6 +- Ix/Compile/Verify/CompileExpr.lean | 50 +- Ix/Compile/Verify/CompilePreseed.lean | 6 +- Ix/Compile/Verify/CompileUniv.lean | 4 +- Ix/Compile/Verify/IxonValue.lean | 18 +- Ix/Compile/Verify/Reference.lean | 10 +- Ix/Compile/Verify/SourceValue.lean | 8 +- Ix/Compile/Verify/Statements.lean | 10 +- Ix/Compiler.lean | 164 + Ix/Compiler/AddressEnv.lean | 58 + Ix/Compiler/Borrow/Pipeline.lean | 141 + Ix/Compiler/Borrow/Report.lean | 148 + Ix/Compiler/Borrow/Runtime.lean | 92 + Ix/Compiler/Borrow/RuntimeInput.lean | 132 + Ix/Compiler/Borrow/RuntimeReport.lean | 199 + Ix/Compiler/Borrow/RuntimeSim.lean | 166 + Ix/Compiler/Borrow/RuntimeSource.lean | 151 + Ix/Compiler/Borrow/Sources.lean | 72 + Ix/Compiler/CallReuse/MapPipeline.lean | 105 + Ix/Compiler/CallReuse/MapSim.lean | 130 + Ix/Compiler/CallReuse/Observations.lean | 340 + Ix/Compiler/CallReuse/Pipeline.lean | 32 + Ix/Compiler/CallReuse/PolicyExamples.lean | 200 + Ix/Compiler/CallReuse/Provenance.lean | 63 + Ix/Compiler/CallReuse/Rejections.lean | 71 + Ix/Compiler/CallReuse/Sim.lean | 98 + Ix/Compiler/CallReuse/Sources.lean | 135 + Ix/Compiler/Coverage/HeapSnapshot.lean | 16 + Ix/Compiler/Coverage/Report.lean | 120 + Ix/Compiler/Coverage/Run.lean | 218 + Ix/Compiler/Coverage/Snapshot.lean | 164 + Ix/Compiler/Coverage/Sources.lean | 169 + Ix/Compiler/Coverage/StdContact.lean | 136 + Ix/Compiler/Coverage/Upstream.lean | 289 + Ix/Compiler/Coverage/UpstreamNative.lean | 147 + Ix/Compiler/DurableSync.lean | 23 + Ix/Compiler/Erase.lean | 930 + Ix/Compiler/EraseAddressed.lean | 144 + Ix/Compiler/EraseAddressedSim.lean | 229 + Ix/Compiler/EraseValidator.lean | 1538 + Ix/Compiler/Fence.lean | 7405 ++++ Ix/Compiler/Fuel.lean | 22 + Ix/Compiler/IxIR/Decode.lean | 470 + Ix/Compiler/IxIR/Encoding.lean | 78 + Ix/Compiler/IxIR0/Basic.lean | 187 + Ix/Compiler/IxIR0/Decode.lean | 357 + Ix/Compiler/IxIR0/DynamicCost.lean | 615 + Ix/Compiler/IxIR0/Eval.lean | 197 + Ix/Compiler/IxIR0/Examples.lean | 282 + Ix/Compiler/IxIR0/MapRecovery.lean | 217 + Ix/Compiler/IxIR0/MapRecoverySim.lean | 216 + Ix/Compiler/IxIR0/Mono.lean | 166 + Ix/Compiler/IxIR0/MutualBlock.lean | 986 + Ix/Compiler/IxIR0/NatArithmetic.lean | 144 + Ix/Compiler/IxIR0/NatRecursors.lean | 150 + Ix/Compiler/IxIR0/ProjectionFree.lean | 429 + Ix/Compiler/IxIR0/ProjectionSafe.lean | 642 + Ix/Compiler/IxIR0/Readdress.lean | 420 + Ix/Compiler/IxIR0/ReaddressOracle.lean | 263 + .../IxIR0/ReaddressOracleExamples.lean | 63 + .../IxIR0/ReaddressProjectionSafe.lean | 397 + Ix/Compiler/IxIR0/ReaddressSim.lean | 676 + Ix/Compiler/IxIR0/Recursion.lean | 286 + Ix/Compiler/IxIR0/RecursionSim.lean | 451 + Ix/Compiler/IxIR0/RecursorModes.lean | 44 + Ix/Compiler/IxIR0/Serialize.lean | 115 + Ix/Compiler/IxIR0/UniqueReverse.lean | 158 + Ix/Compiler/IxIR0/UniqueReverseSim.lean | 154 + Ix/Compiler/IxIR1/Basic.lean | 172 + Ix/Compiler/IxIR1/CostInstance.lean | 135 + Ix/Compiler/IxIR1/CostModel.lean | 336 + Ix/Compiler/IxIR1/CostTrace.lean | 26091 ++++++++++++ Ix/Compiler/IxIR1/Decode.lean | 441 + Ix/Compiler/IxIR1/Eval.lean | 1295 + Ix/Compiler/IxIR1/EvalHistory.lean | 371 + Ix/Compiler/IxIR1/EvalIso.lean | 2692 ++ Ix/Compiler/IxIR1/EvalRewrite.lean | 1857 + Ix/Compiler/IxIR1/Examples.lean | 375 + Ix/Compiler/IxIR1/HPT.lean | 1735 + Ix/Compiler/IxIR1/HPTCache.lean | 543 + Ix/Compiler/IxIR1/HPTCacheDirIO.lean | 262 + Ix/Compiler/IxIR1/HPTCacheIO.lean | 471 + Ix/Compiler/IxIR1/HPTCasePrune.lean | 1807 + Ix/Compiler/IxIR1/HPTCasePruneProgram.lean | 360 + Ix/Compiler/IxIR1/HPTDestroy.lean | 903 + Ix/Compiler/IxIR1/HPTFetchForward.lean | 816 + Ix/Compiler/IxIR1/HPTPAPFuse.lean | 2770 ++ Ix/Compiler/IxIR1/HPTPAPFuseProgram.lean | 781 + Ix/Compiler/IxIR1/HPTProduce.lean | 334 + Ix/Compiler/IxIR1/HPTSound.lean | 2989 ++ Ix/Compiler/IxIR1/Lower.lean | 1589 + Ix/Compiler/IxIR1/LowerAddressed.lean | 103 + Ix/Compiler/IxIR1/LowerAddressedSim.lean | 580 + Ix/Compiler/IxIR1/LowerFullyAddressed.lean | 129 + Ix/Compiler/IxIR1/LowerFullyAddressedSim.lean | 343 + .../IxIR1/LowerMutualAddressedProgress.lean | 942 + .../IxIR1/LowerMutualAddressedSim.lean | 271 + Ix/Compiler/IxIR1/LowerProgress.lean | 20940 ++++++++++ Ix/Compiler/IxIR1/LowerSim.lean | 34095 ++++++++++++++++ Ix/Compiler/IxIR1/LowerStateBase.lean | 3277 ++ Ix/Compiler/IxIR1/LowerStateSim.lean | 8245 ++++ Ix/Compiler/IxIR1/Mono.lean | 1160 + Ix/Compiler/IxIR1/MutualBlock.lean | 1240 + Ix/Compiler/IxIR1/NoReuse.lean | 4076 ++ Ix/Compiler/IxIR1/NoReuseAddressed.lean | 325 + Ix/Compiler/IxIR1/Optimizer.lean | 798 + Ix/Compiler/IxIR1/OptimizerReclamation.lean | 256 + Ix/Compiler/IxIR1/Progress.lean | 739 + Ix/Compiler/IxIR1/RcPotential.lean | 195 + Ix/Compiler/IxIR1/Reachability.lean | 731 + Ix/Compiler/IxIR1/Readdress.lean | 593 + Ix/Compiler/IxIR1/ReaddressAll.lean | 876 + Ix/Compiler/IxIR1/ReaddressAllSim.lean | 355 + Ix/Compiler/IxIR1/ReaddressOwnership.lean | 158 + Ix/Compiler/IxIR1/ReaddressSim.lean | 1735 + Ix/Compiler/IxIR1/Reclamation.lean | 2500 ++ Ix/Compiler/IxIR1/Serialize.lean | 159 + Ix/Compiler/IxIR1/Sim.lean | 6882 ++++ Ix/Compiler/IxIR1/ThesisBench.lean | 278 + Ix/Compiler/IxIR1/WellModedGen.lean | 552 + Ix/Compiler/IxIR2/AllocationEvents.lean | 400 + Ix/Compiler/IxIR2/Basic.lean | 156 + Ix/Compiler/IxIR2/Borrow/Examples.lean | 149 + Ix/Compiler/IxIR2/Borrow/OpenCheck.lean | 175 + Ix/Compiler/IxIR2/Borrow/OpenControl.lean | 180 + Ix/Compiler/IxIR2/Borrow/OpenExamples.lean | 104 + Ix/Compiler/IxIR2/Borrow/OpenHeap.lean | 142 + Ix/Compiler/IxIR2/Borrow/OpenResources.lean | 179 + Ix/Compiler/IxIR2/Borrow/OpenShape.lean | 151 + Ix/Compiler/IxIR2/Borrow/OpenSim.lean | 188 + Ix/Compiler/IxIR2/Borrow/Replay.lean | 166 + Ix/Compiler/IxIR2/Borrow/Rewrite.lean | 185 + Ix/Compiler/IxIR2/CallEval.lean | 373 + Ix/Compiler/IxIR2/CallEvalFuel.lean | 60 + Ix/Compiler/IxIR2/CallResources.lean | 107 + Ix/Compiler/IxIR2/CallReuse.lean | 280 + Ix/Compiler/IxIR2/CallReuseApply.lean | 147 + Ix/Compiler/IxIR2/CallReuseBody.lean | 137 + Ix/Compiler/IxIR2/CallReuseCalls.lean | 71 + Ix/Compiler/IxIR2/CallReuseControl.lean | 370 + Ix/Compiler/IxIR2/CallReuseHeapShape.lean | 208 + Ix/Compiler/IxIR2/CallReuseInstructions.lean | 151 + Ix/Compiler/IxIR2/CallReuseMain.lean | 91 + Ix/Compiler/IxIR2/CallReuseOrder.lean | 197 + Ix/Compiler/IxIR2/CallReusePrefix.lean | 183 + Ix/Compiler/IxIR2/CallReusePrefixHeap.lean | 72 + Ix/Compiler/IxIR2/CallReusePrefixTrace.lean | 252 + Ix/Compiler/IxIR2/CallReuseProgress.lean | 127 + Ix/Compiler/IxIR2/CallReuseShape.lean | 158 + Ix/Compiler/IxIR2/CallReuseSimulation.lean | 88 + Ix/Compiler/IxIR2/CallReuseTerminators.lean | 155 + Ix/Compiler/IxIR2/CallReuseTransition.lean | 220 + Ix/Compiler/IxIR2/CostObservations.lean | 470 + Ix/Compiler/IxIR2/CostSteps.lean | 371 + Ix/Compiler/IxIR2/CreditApply.lean | 166 + Ix/Compiler/IxIR2/CreditControl.lean | 150 + Ix/Compiler/IxIR2/CreditExamples.lean | 325 + Ix/Compiler/IxIR2/CreditFree.lean | 32 + Ix/Compiler/IxIR2/CreditHeap.lean | 185 + Ix/Compiler/IxIR2/CreditHeapObservations.lean | 113 + Ix/Compiler/IxIR2/CreditInstructions.lean | 230 + Ix/Compiler/IxIR2/CreditPolicy.lean | 24 + Ix/Compiler/IxIR2/CreditReclamation.lean | 163 + Ix/Compiler/IxIR2/CreditRefinement.lean | 138 + Ix/Compiler/IxIR2/CreditRelation.lean | 195 + Ix/Compiler/IxIR2/CreditResources.lean | 152 + Ix/Compiler/IxIR2/CreditSimulation.lean | 90 + Ix/Compiler/IxIR2/CreditSteps.lean | 120 + Ix/Compiler/IxIR2/CreditTerminators.lean | 98 + Ix/Compiler/IxIR2/Eval.lean | 5334 +++ Ix/Compiler/IxIR2/EvalCounter.lean | 273 + Ix/Compiler/IxIR2/EvalExamples.lean | 388 + Ix/Compiler/IxIR2/EvalFuel.lean | 205 + Ix/Compiler/IxIR2/HeapAccounting.lean | 361 + Ix/Compiler/IxIR2/Interpretation.lean | 270 + Ix/Compiler/IxIR2/Liveness.lean | 909 + Ix/Compiler/IxIR2/LivenessExamples.lean | 96 + Ix/Compiler/IxIR2/Lower.lean | 7324 ++++ Ix/Compiler/IxIR2/LowerExamples.lean | 351 + Ix/Compiler/IxIR2/LowerSim.lean | 12906 ++++++ Ix/Compiler/IxIR2/Pipeline.lean | 3548 ++ Ix/Compiler/IxIR2/PipelineAllocation.lean | 124 + Ix/Compiler/IxIR2/PipelineCallReuse.lean | 168 + Ix/Compiler/IxIR2/PipelineCosts.lean | 177 + Ix/Compiler/IxIR2/PipelineInvoke.lean | 84 + Ix/Compiler/IxIR2/PipelinePhysical.lean | 48 + Ix/Compiler/IxIR2/PipelineResources.lean | 140 + Ix/Compiler/IxIR2/PipelineSim.lean | 11102 +++++ Ix/Compiler/IxIR2/ReservationHeap.lean | 233 + Ix/Compiler/IxIR2/ReservationOwnership.lean | 187 + Ix/Compiler/IxIR2/ReservationSteps.lean | 230 + Ix/Compiler/IxIR2/Resources.lean | 286 + Ix/Compiler/IxIR2/Reuse.lean | 1747 + Ix/Compiler/IxIR2/ReuseAllocation.lean | 73 + Ix/Compiler/IxIR2/ReuseCost.lean | 287 + Ix/Compiler/IxIR2/ReuseExamples.lean | 977 + Ix/Compiler/IxIR2/ReuseHeapMap.lean | 274 + Ix/Compiler/IxIR2/ReuseHeapMapOps.lean | 385 + Ix/Compiler/IxIR2/ReuseHeapMapResults.lean | 182 + Ix/Compiler/IxIR2/ReuseLiveSim.lean | 27547 +++++++++++++ Ix/Compiler/IxIR2/ReuseResources.lean | 40 + Ix/Compiler/IxIR2/ReuseSim.lean | 19042 +++++++++ Ix/Compiler/IxIR2/ReuseSimExamples.lean | 197 + Ix/Compiler/IxIR2/SourcePipelineSim.lean | 119 + Ix/Compiler/IxIR2/UniqueLower.lean | 140 + Ix/Compiler/IxIR2/Validate.lean | 1093 + Ix/Compiler/IxIR2/ValidateExamples.lean | 530 + Ix/Compiler/Ixon/Address.lean | 214 + Ix/Compiler/Ixon/Catalog.lean | 770 + Ix/Compiler/Ixon/CatalogIO.lean | 133 + Ix/Compiler/Ixon/Const.lean | 2784 ++ Ix/Compiler/Ixon/DecodeCheck.lean | 768 + Ix/Compiler/Ixon/Eval.lean | 1918 + Ix/Compiler/Ixon/Expr.lean | 2339 ++ Ix/Compiler/Ixon/Hash.lean | 48 + Ix/Compiler/Ixon/Merkle.lean | 84 + Ix/Compiler/Ixon/RecursorUsage.lean | 199 + Ix/Compiler/Ixon/Serialize.lean | 1639 + Ix/Compiler/Ixon/Sharing.lean | 715 + Ix/Compiler/Ixon/Sharing/Basic.lean | 454 + Ix/Compiler/Ixon/Sharing/Compress.lean | 1182 + Ix/Compiler/Ixon/Sharing/Eval.lean | 2277 ++ Ix/Compiler/Ixon/Univ.lean | 980 + Ix/Compiler/Ixon/UsageCheck.lean | 1306 + Ix/Compiler/Ixon/Uses.lean | 188 + Ix/Compiler/Ixon/Work.lean | 222 + Ix/Compiler/LICENSE-APACHE | 201 + Ix/Compiler/LICENSE-MIT | 21 + Ix/Compiler/LoweredCompilation.lean | 110 + Ix/Compiler/LoweredCompilationSim.lean | 184 + Ix/Compiler/Pipeline.lean | 1849 + Ix/Compiler/PipelineApply.lean | 85 + Ix/Compiler/PipelineErasure.lean | 212 + Ix/Compiler/PipelineSound.lean | 1055 + Ix/Compiler/Recursion/Allocation.lean | 123 + Ix/Compiler/Recursion/Costs.lean | 121 + Ix/Compiler/Recursion/Observations.lean | 320 + Ix/Compiler/Recursion/PhysicalSim.lean | 176 + Ix/Compiler/Recursion/Pipeline.lean | 142 + Ix/Compiler/Recursion/Rejections.lean | 127 + Ix/Compiler/Recursion/Resources.lean | 134 + Ix/Compiler/Recursion/Sim.lean | 58 + Ix/Compiler/Recursion/Sources.lean | 138 + Ix/Compiler/Recursion/Trace.lean | 51 + Ix/Compiler/Sim.lean | 5547 +++ Ix/Compiler/Sim/Segment.lean | 517 + Ix/Compiler/SimApply.lean | 125 + Ix/Compiler/SimInstance.lean | 4548 +++ Ix/Compiler/Tools/BorrowCheck.lean | 152 + Ix/Compiler/Tools/BorrowExecution.lean | 242 + Ix/Compiler/Tools/BorrowRuntimeCheck.lean | 230 + .../Tools/CapturedScalarNativeCheck.lean | 162 + Ix/Compiler/Tools/Check.lean | 118 + .../Tools/PhysicalScalarNativeCheck.lean | 134 + Ix/Compiler/Tools/ScalarNativeCheck.lean | 99 + Ix/Compiler/Tools/SourceScan.lean | 169 + Ix/Compiler/Tools/TrustLedger.lean | 213 + Ix/Compiler/Tools/TrustProfile.lean | 45 + Ix/Compiler/Tools/UniqueCheck.lean | 236 + Ix/Compiler/Tools/UpstreamNativeCheck.lean | 340 + Ix/Compiler/Tools/X86Check.lean | 50 + Ix/Compiler/UniqueReuse/Heap.lean | 171 + Ix/Compiler/UniqueReuse/Lower.lean | 67 + Ix/Compiler/UniqueReuse/LowerSim.lean | 204 + Ix/Compiler/UniqueReuse/ModeCheck.lean | 85 + Ix/Compiler/UniqueReuse/Native.lean | 76 + Ix/Compiler/UniqueReuse/NativeObject.lean | 76 + .../UniqueReuse/NativeObservations.lean | 184 + Ix/Compiler/UniqueReuse/NativeSim.lean | 130 + Ix/Compiler/UniqueReuse/Observations.lean | 203 + Ix/Compiler/UniqueReuse/Pipeline.lean | 52 + Ix/Compiler/UniqueReuse/PipelineSim.lean | 96 + Ix/Compiler/UniqueReuse/Provenance.lean | 59 + Ix/Compiler/UniqueReuse/Reclamation.lean | 136 + Ix/Compiler/UniqueReuse/Rejections.lean | 165 + Ix/Compiler/UniqueReuse/Runtime.lean | 91 + Ix/Compiler/UniqueReuse/RuntimeNative.lean | 120 + Ix/Compiler/UniqueReuse/RuntimeNativeSim.lean | 86 + Ix/Compiler/UniqueReuse/RuntimeObjectSim.lean | 188 + .../UniqueReuse/RuntimeObservations.lean | 229 + Ix/Compiler/UniqueReuse/RuntimeSource.lean | 94 + Ix/Compiler/UniqueReuse/RuntimeSourceSim.lean | 70 + Ix/Compiler/UniqueReuse/RuntimeTarget.lean | 164 + Ix/Compiler/UniqueReuse/SourceSim.lean | 29 + Ix/Compiler/UniqueReuse/Sources.lean | 105 + Ix/Compiler/UniqueReuse/TargetHeap.lean | 94 + Ix/Compiler/UniqueReuse/TargetInput.lean | 106 + Ix/Compiler/UniqueReuse/TargetLoop.lean | 158 + Ix/Compiler/UniqueReuse/TargetMain.lean | 135 + Ix/Compiler/UniqueReuse/TargetResources.lean | 60 + Ix/Compiler/UniqueReuse/TargetSim.lean | 56 + Ix/Compiler/UniqueReuse/TargetSteps.lean | 169 + Ix/Compiler/UsageSound.lean | 482 + Ix/Compiler/X86/Basic.lean | 359 + Ix/Compiler/X86/ByteBranch.lean | 144 + Ix/Compiler/X86/ByteCall.lean | 86 + Ix/Compiler/X86/ByteControl.lean | 79 + Ix/Compiler/X86/ByteEval.lean | 136 + Ix/Compiler/X86/ByteExamples.lean | 45 + Ix/Compiler/X86/ByteFlags.lean | 71 + Ix/Compiler/X86/Decode.lean | 266 + Ix/Compiler/X86/ELF.lean | 301 + Ix/Compiler/X86/ELFExamples.lean | 156 + Ix/Compiler/X86/ELFLink.lean | 167 + Ix/Compiler/X86/ELFRead.lean | 213 + Ix/Compiler/X86/ELFValidate.lean | 184 + Ix/Compiler/X86/Encode.lean | 419 + Ix/Compiler/X86/EncodeBytes.lean | 114 + Ix/Compiler/X86/EncodeControl.lean | 57 + Ix/Compiler/X86/EncodeExamples.lean | 174 + Ix/Compiler/X86/EncodeExecution.lean | 111 + Ix/Compiler/X86/EncodeFields.lean | 76 + Ix/Compiler/X86/EncodeForms.lean | 80 + Ix/Compiler/X86/EncodeLength.lean | 108 + Ix/Compiler/X86/EncodeMemory.lean | 100 + Ix/Compiler/X86/EncodePatch.lean | 53 + Ix/Compiler/X86/EncodeRegisters.lean | 156 + Ix/Compiler/X86/EncodeWord.lean | 106 + Ix/Compiler/X86/Eval.lean | 513 + Ix/Compiler/X86/EvalExamples.lean | 178 + Ix/Compiler/X86/ExactNat.lean | 108 + Ix/Compiler/X86/Execution.lean | 234 + Ix/Compiler/X86/FrameCalls.lean | 65 + Ix/Compiler/X86/FrameExecution.lean | 119 + Ix/Compiler/X86/Memory.lean | 143 + Ix/Compiler/X86/NatCalls.lean | 126 + Ix/Compiler/X86/NatCallsCapture.lean | 49 + Ix/Compiler/X86/NatCallsCheck.lean | 207 + Ix/Compiler/X86/NatCallsExamples.lean | 106 + Ix/Compiler/X86/NatCallsSim.lean | 98 + Ix/Compiler/X86/NatCallsSyntax.lean | 95 + Ix/Compiler/X86/ObjectExecution.lean | 92 + Ix/Compiler/X86/PhysicalScalar.lean | 97 + .../X86/PhysicalScalarCapturedExport.lean | 101 + .../X86/PhysicalScalarCapturedHeap.lean | 157 + .../X86/PhysicalScalarCapturedInit.lean | 86 + .../PhysicalScalarCapturedSourceApply.lean | 148 + .../PhysicalScalarCapturedSourceObject.lean | 97 + Ix/Compiler/X86/PhysicalScalarContracts.lean | 83 + Ix/Compiler/X86/PhysicalScalarControl.lean | 208 + Ix/Compiler/X86/PhysicalScalarExamples.lean | 91 + Ix/Compiler/X86/PhysicalScalarExport.lean | 155 + Ix/Compiler/X86/PhysicalScalarObject.lean | 114 + Ix/Compiler/X86/PhysicalScalarSelect.lean | 194 + Ix/Compiler/X86/PhysicalScalarSim.lean | 115 + .../X86/PhysicalScalarSourceApply.lean | 147 + Ix/Compiler/X86/PhysicalScalarSourceHeap.lean | 132 + .../X86/PhysicalScalarSourceObject.lean | 96 + Ix/Compiler/X86/PhysicalScalarSources.lean | 66 + Ix/Compiler/X86/PhysicalScalarValues.lean | 186 + Ix/Compiler/X86/PipelineSim.lean | 168 + Ix/Compiler/X86/RuntimeExecution.lean | 135 + Ix/Compiler/X86/RuntimeGuards.lean | 119 + Ix/Compiler/X86/RuntimeHeader.lean | 150 + Ix/Compiler/X86/RuntimeInput.lean | 132 + Ix/Compiler/X86/RuntimeInspect.lean | 117 + Ix/Compiler/X86/RuntimeReject.lean | 113 + Ix/Compiler/X86/RuntimeScan.lean | 237 + Ix/Compiler/X86/RuntimeTarget.lean | 122 + Ix/Compiler/X86/SafeControl.lean | 54 + Ix/Compiler/X86/SafeSteps.lean | 69 + Ix/Compiler/X86/SafeStepsObject.lean | 88 + Ix/Compiler/X86/Scalar.lean | 151 + Ix/Compiler/X86/ScalarApply.lean | 140 + Ix/Compiler/X86/ScalarArguments.lean | 68 + Ix/Compiler/X86/ScalarBind.lean | 62 + Ix/Compiler/X86/ScalarCalls.lean | 129 + Ix/Compiler/X86/ScalarCapacity.lean | 60 + Ix/Compiler/X86/ScalarComposition.lean | 96 + Ix/Compiler/X86/ScalarContracts.lean | 82 + Ix/Compiler/X86/ScalarFrames.lean | 135 + Ix/Compiler/X86/ScalarFunctions.lean | 113 + Ix/Compiler/X86/ScalarInstructions.lean | 107 + Ix/Compiler/X86/ScalarNat.lean | 121 + Ix/Compiler/X86/ScalarObject.lean | 130 + Ix/Compiler/X86/ScalarPrimitives.lean | 100 + Ix/Compiler/X86/ScalarSafeFrames.lean | 91 + Ix/Compiler/X86/ScalarSafety.lean | 90 + Ix/Compiler/X86/ScalarSimulation.lean | 135 + Ix/Compiler/X86/ScalarSourceApply.lean | 122 + Ix/Compiler/X86/ScalarSourceObject.lean | 118 + Ix/Compiler/X86/ScalarSourceSelect.lean | 148 + Ix/Compiler/X86/ScalarSourceSim.lean | 119 + Ix/Compiler/X86/ScalarSourceSyntax.lean | 178 + Ix/Compiler/X86/ScalarSources.lean | 148 + Ix/Compiler/X86/ScalarStack.lean | 189 + Ix/Compiler/X86/ScalarTarget.lean | 173 + Ix/Compiler/X86/ScalarTotal.lean | 89 + Ix/Compiler/X86/Select.lean | 389 + Ix/Compiler/X86/SelectExamples.lean | 123 + Ix/Compiler/X86/StreamCalls.lean | 220 + Ix/Compiler/X86/StreamControl.lean | 121 + Ix/Compiler/X86/StreamDecidable.lean | 72 + Ix/Compiler/X86/StreamEffects.lean | 128 + Ix/Compiler/X86/StreamExamples.lean | 69 + Ix/Compiler/X86/StreamLayout.lean | 239 + Ix/Compiler/X86/StreamLinear.lean | 109 + Ix/Compiler/X86/StreamMemory.lean | 146 + Ix/Compiler/X86/StreamPermissions.lean | 57 + Ix/Compiler/X86/StreamRun.lean | 247 + Ix/Compiler/X86/StreamTrace.lean | 219 + Ix/Compiler/X86/StreamValidate.lean | 131 + Ix/Compiler/X86/UniqueABI.lean | 207 + Ix/Compiler/X86/UniqueControl.lean | 130 + Ix/Compiler/X86/UniqueCounterFold.lean | 91 + Ix/Compiler/X86/UniqueExecution.lean | 128 + Ix/Compiler/X86/UniqueHeap.lean | 238 + Ix/Compiler/X86/UniqueInvariant.lean | 207 + Ix/Compiler/X86/UniqueLoop.lean | 158 + Ix/Compiler/X86/UniqueMacros.lean | 325 + Ix/Compiler/X86/UniqueMain.lean | 145 + Ix/Compiler/X86/UniqueRelease.lean | 161 + Ix/Compiler/X86/UniqueResult.lean | 145 + Ix/Compiler/X86/UniqueTarget.lean | 108 + Ix/Compiler/X86/ValidatedScalar.lean | 151 + Ix/Compiler/X86/WordRegion.lean | 117 + Ix/Compiler/X86/WordRegionExecution.lean | 153 + Ix/Compiler/X86/WordRegionSafeCalls.lean | 40 + Ix/Compiler/X86/WordRegionSafeControl.lean | 45 + Ix/Compiler/X86/WordRegionSafeMacros.lean | 80 + Ix/Compiler/X86/WordRegionSafeTrace.lean | 88 + Ix/Environment.lean | 2 +- Ix/IxVM/Certified/Accept.lean | 113 + Ix/IxVM/Certified/Checker.lean | 116 + Ix/IxVM/Certified/Expr.lean | 136 + Ix/IxVM/Certified/Levels.lean | 132 + Ix/IxVM/Certified/Read.lean | 241 + Ix/IxVM/Certified/Types.lean | 140 + Ix/IxVM/ClaimHarness.lean | 6 +- Ix/IxVM/Kernel/DefEq.lean | 12 +- Ix/IxVM/Kernel/Infer.lean | 6 +- Ix/IxVM/Kernel/Levels.lean | 4 +- Ix/IxVM/Kernel/Whnf.lean | 10 +- Ix/IxonUniv.lean | 22 +- Ix/Kernel.lean | 54 + Ix/{Tc => Kernel}/CanonicalCheck.lean | 8 +- Ix/Kernel/Certified.lean | 338 + Ix/Kernel/CertifiedClaims.lean | 95 + Ix/{Tc => Kernel}/Check.lean | 10 +- Ix/{Tc => Kernel}/Const.lean | 6 +- Ix/{Tc => Kernel}/DefEq.lean | 8 +- Ix/{Tc => Kernel}/Driver.lean | 20 +- Ix/{Tc => Kernel}/Egress.lean | 8 +- Ix/{Tc => Kernel}/EgressLean.lean | 6 +- Ix/{Tc => Kernel}/Env.lean | 14 +- Ix/{Tc => Kernel}/Equiv.lean | 4 +- Ix/{Tc => Kernel}/Error.lean | 6 +- Ix/{Tc => Kernel}/Expr.lean | 10 +- Ix/{Tc => Kernel}/Id.lean | 6 +- Ix/{Tc => Kernel}/Inductive.lean | 10 +- Ix/{Tc => Kernel}/Infer.lean | 12 +- Ix/{Tc => Kernel}/Ingress.lean | 12 +- Ix/{Tc => Kernel}/IngressMeta.lean | 12 +- Ix/{Tc => Kernel}/Knot.lean | 8 +- Ix/{Tc => Kernel}/Lctx.lean | 6 +- Ix/{Tc => Kernel}/Level.lean | 16 +- Ix/{Tc => Kernel}/Mode.lean | 6 +- Ix/{Tc => Kernel}/Monad.lean | 27 +- Ix/{Tc => Kernel}/ParCheck.lean | 10 +- Ix/{Tc => Kernel}/Primitive.lean | 6 +- Ix/{Tc => Kernel}/Subst.lean | 8 +- Ix/{Tc => Kernel}/Validate.lean | 16 +- Ix/{Tc => Kernel}/Verify/Audit/Basic.lean | 106 +- Ix/{Tc => Kernel}/Verify/Audit/Completed.lean | 7257 ++-- .../Verify/Audit/Conditional.lean | 22 +- .../Verify/Audit/SorryFrontier.lean | 28 +- .../Verify/Audit/Statements.lean | 124 +- Ix/{Tc => Kernel}/Verify/Cache.lean | 18 +- .../Verify/Check/Acceptance.lean | 20 +- .../Verify/Check/BinderRoundTrip.lean | 20 +- .../Verify/Check/BlockAcceptance.lean | 28 +- .../Verify/Check/BlockCache.lean | 6 +- .../Verify/Check/BlockClassification.lean | 6 +- .../Verify/Check/BlockDefinition.lean | 18 +- .../Verify/Check/BlockExecution.lean | 6 +- .../Verify/Check/BlockIdentity.lean | 8 +- .../Verify/Check/BlockNatFixture.lean | 8 +- .../Verify/Check/BlockOracle.lean | 10 +- .../Verify/Check/BlockRouteFrame.lean | 6 +- .../Verify/Check/BlockRouting.lean | 8 +- .../Verify/Check/BlockTransaction.lean | 10 +- .../Verify/Check/BoundedPipelines.lean | 28 +- .../Verify/Check/CheckConstExecution.lean | 8 +- .../Verify/Check/CheckConstTransaction.lean | 6 +- .../Verify/Check/CheckerEvidence.lean | 14 +- .../Verify/Check/DeclarationIngress.lean | 12 +- .../Verify/Check/DeclarationValidation.lean | 10 +- .../Verify/Check/DefEqBasicPolicy.lean | 8 +- .../Verify/Check/DefEqCachePolicy.lean | 6 +- .../Verify/Check/DefEqEtaPolicy.lean | 6 +- .../Verify/Check/DefEqFinalWhnfPolicy.lean | 6 +- .../Verify/Check/DefEqLazyDeltaPolicy.lean | 6 +- .../Verify/Check/DefEqNatPolicy.lean | 6 +- .../Verify/Check/DefEqPipelinePolicy.lean | 6 +- .../Check/DefEqProjectionDeltaPolicy.lean | 6 +- .../Verify/Check/DefEqPropositionPolicy.lean | 6 +- .../Verify/Check/FullInference.lean | 10 +- .../Check/FullInferenceApplications.lean | 12 +- .../Verify/Check/FullInferenceBinders.lean | 22 +- .../Verify/Check/FullInferenceCache.lean | 14 +- .../Verify/Check/FullInferenceDispatcher.lean | 12 +- .../Verify/Check/FullInferenceKnot.lean | 22 +- .../Verify/Check/FullInferenceLeaves.lean | 20 +- .../Check/FullInferenceProjections.lean | 10 +- .../Verify/Check/InferencePolicy.lean | 14 +- .../Verify/Check/MemberEvidence.lean | 16 +- .../Verify/Check/NatAcceptance.lean | 22 +- .../Verify/Check/PositiveFuelSort.lean | 26 +- .../Verify/Check/PreTranslation.lean | 14 +- .../Check/PreTranslationCompatibility.lean | 16 +- .../Verify/Check/PreTranslationIngress.lean | 26 +- .../Verify/Check/PreTranslationOpening.lean | 10 +- .../Verify/Check/PreTranslationScopes.lean | 20 +- .../Check/ProjectionInferencePolicy.lean | 6 +- .../Verify/Check/PublicBlocks.lean | 22 +- .../Verify/Check/PublicStandalone.lean | 44 +- .../Verify/Check/QuotientAdmission.lean | 42 +- .../Verify/Check/QuotientBoundary.lean | 10 +- .../Verify/Check/QuotientBridge.lean | 50 +- .../Verify/Check/RecursiveMethodPolicy.lean | 6 +- .../Verify/Check/ResetFrame.lean | 6 +- .../Verify/Check/SafetyFrame.lean | 6 +- Ix/{Tc => Kernel}/Verify/Check/Scoped.lean | 16 +- .../Verify/Check/ScopedActiveBlock.lean | 14 +- .../Verify/Check/ScopedBoundedPipelines.lean | 22 +- .../Verify/Check/ScopedMemberEvidence.lean | 18 +- .../Verify/Check/ScopedPositiveFuelAxiom.lean | 26 +- .../Check/ScopedPositiveFuelCertificate.lean | 6 +- .../Verify/Check/ScopedStandaloneDriver.lean | 14 +- .../Verify/Check/SingletonInductive.lean | 34 +- .../Verify/Check/StandaloneDriver.lean | 12 +- .../Verify/Check/UncachedInferencePolicy.lean | 8 +- .../Check/UniverseInstantiationPolicy.lean | 6 +- .../Verify/Check/ValidationReach.lean | 8 +- .../Verify/Check/ValidatorFrame.lean | 8 +- .../Verify/Check/ValidatorSoundness.lean | 6 +- .../Verify/Check/WhnfBasicHelperPolicy.lean | 6 +- .../Verify/Check/WhnfBitVecPolicy.lean | 6 +- .../Verify/Check/WhnfDecidablePolicy.lean | 6 +- .../Verify/Check/WhnfDriverPolicy.lean | 6 +- .../Verify/Check/WhnfHelperPolicy.lean | 6 +- .../Verify/Check/WhnfIotaBasePolicy.lean | 6 +- .../Verify/Check/WhnfIotaDispatchPolicy.lean | 6 +- .../Verify/Check/WhnfIotaRecursionPolicy.lean | 6 +- .../Verify/Check/WhnfIotaScopePolicy.lean | 6 +- .../Verify/Check/WhnfIotaSynthesisPolicy.lean | 6 +- .../Verify/Check/WhnfNatArgumentPolicy.lean | 6 +- .../Verify/Check/WhnfNatPolicy.lean | 6 +- .../Verify/Check/WhnfNativePolicy.lean | 6 +- .../Verify/Check/WhnfProjectionPolicy.lean | 6 +- .../Verify/Check/WhnfReductionPolicy.lean | 6 +- Ix/Kernel/Verify/Consistency.lean | 19 + Ix/Kernel/Verify/Consistency/Audit.lean | 51 + Ix/Kernel/Verify/Consistency/Expr.lean | 88 + Ix/Kernel/Verify/Consistency/Infer.lean | 47 + Ix/Kernel/Verify/Consistency/Judgment.lean | 118 + Ix/Kernel/Verify/Consistency/Level.lean | 74 + Ix/{Tc => Kernel}/Verify/Ctx.lean | 58 +- Ix/{Tc => Kernel}/Verify/Decl.lean | 42 +- Ix/{Tc => Kernel}/Verify/DefEq.lean | 12 +- .../Verify/DefEq/AcceleratorGates.lean | 10 +- .../Verify/DefEq/ApplicationSpine.lean | 8 +- Ix/{Tc => Kernel}/Verify/DefEq/BoolTrue.lean | 8 +- .../Verify/DefEq/CacheBranches.lean | 16 +- .../Verify/DefEq/CacheShell.lean | 22 +- .../Verify/DefEq/CheapReduction.lean | 10 +- Ix/{Tc => Kernel}/Verify/DefEq/Closure.lean | 10 +- .../Verify/DefEq/DeltaClassification.lean | 10 +- .../Verify/DefEq/EqualRankCache.lean | 10 +- .../Verify/DefEq/EqualRankPrefix.lean | 8 +- .../Verify/DefEq/EqualRankReduction.lean | 8 +- .../Verify/DefEq/FinalWhnf/Application.lean | 8 +- .../Verify/DefEq/FinalWhnf/Closure.lean | 18 +- .../Verify/DefEq/FinalWhnf/Contracts.lean | 10 +- .../Verify/DefEq/FinalWhnf/EtaExpansion.lean | 12 +- .../DefEq/FinalWhnf/LetDeclaration.lean | 10 +- .../Verify/DefEq/FinalWhnf/NatBridge.lean | 20 +- .../Verify/DefEq/FinalWhnf/ProofTail.lean | 10 +- .../DefEq/FinalWhnf/StringExpansion.lean | 10 +- .../DefEq/FinalWhnf/StructuralPrefix.lean | 16 +- .../Verify/DefEq/FinalWhnf/StructureEta.lean | 14 +- .../DefEq/FinalWhnf/StructureEtaBase.lean | 12 +- .../DefEq/FinalWhnf/StructureEtaFields.lean | 8 +- .../DefEq/FinalWhnf/StructureEtaTail.lean | 8 +- .../Verify/DefEq/FinalWhnf/UnitLike.lean | 16 +- Ix/{Tc => Kernel}/Verify/DefEq/LazyDelta.lean | 8 +- .../Verify/DefEq/LazyDeltaClosure.lean | 8 +- .../Verify/DefEq/LazyDeltaIteration.lean | 8 +- .../Verify/DefEq/LoopFinish.lean | 8 +- Ix/{Tc => Kernel}/Verify/DefEq/NatOffset.lean | 20 +- .../Verify/DefEq/NatOffsetDecomposition.lean | 10 +- .../Verify/DefEq/NatReduction.lean | 8 +- .../Verify/DefEq/OneSidedDelta.lean | 8 +- .../Verify/DefEq/ProjectionDeltaActive.lean | 8 +- .../Verify/DefEq/ProjectionDeltaClosure.lean | 8 +- .../DefEq/ProjectionDeltaEqualRank.lean | 10 +- .../Verify/DefEq/ProjectionDeltaFinish.lean | 8 +- .../Verify/DefEq/ProjectionDeltaLoop.lean | 8 +- .../Verify/DefEq/ProjectionDeltaRank.lean | 8 +- .../Verify/DefEq/ProjectionDeltaStep.lean | 12 +- .../DefEq/ProjectionDeltaUnfolding.lean | 8 +- .../Verify/DefEq/ProjectionProbe.lean | 8 +- .../Verify/DefEq/ProjectionReduction.lean | 10 +- .../Verify/DefEq/ProofIrrelevance.lean | 10 +- .../Verify/DefEq/PropositionClassifier.lean | 10 +- .../Verify/DefEq/RankDispatch.lean | 8 +- .../Verify/DefEq/SameHeadSpine.lean | 12 +- .../Verify/DefEq/SpineArguments.lean | 10 +- .../Verify/DefEq/StoppedContinuation.lean | 10 +- .../DefEq/StoppedContinuationClosure.lean | 8 +- .../Verify/DefEq/StringLiteral.lean | 10 +- .../Verify/DefEq/Structural.lean | 18 +- .../Verify/DefEq/StructuralCongruence.lean | 10 +- .../Verify/Driver/BooleanAcceptance.lean | 8 +- .../Verify/Driver/Dependencies.lean | 6 +- .../Verify/Driver/Enumeration.lean | 6 +- Ix/{Tc => Kernel}/Verify/Driver/Fixtures.lean | 6 +- Ix/{Tc => Kernel}/Verify/Driver/Model.lean | 6 +- Ix/{Tc => Kernel}/Verify/Driver/Serial.lean | 6 +- .../Verify/Driver/SupportedAcceptance.lean | 36 +- .../Driver/SupportedAcceptanceFixtures.lean | 12 +- Ix/{Tc => Kernel}/Verify/Env.lean | 32 +- .../Verify/EquivalenceManager.lean | 8 +- Ix/{Tc => Kernel}/Verify/Execution.lean | 6 +- Ix/{Tc => Kernel}/Verify/Expr.lean | 8 +- Ix/{Tc => Kernel}/Verify/Frame.lean | 14 +- .../Verify/Frontier}/Pending.lean | 31 +- Ix/{Tc => Kernel}/Verify/Inductive.lean | 64 +- .../Inductive/AliasFormerAdmission.lean | 12 +- .../Inductive/AliasFormerCertificate.lean | 22 +- .../Verify/Inductive/AliasFormerFixture.lean | 16 +- .../Verify/Inductive/AliasFormerPattern.lean | 14 +- .../Inductive/AliasFormerRecursorFixture.lean | 12 +- .../Verify/Inductive/AliasRecAdmission.lean | 12 +- .../Verify/Inductive/AliasRecCertificate.lean | 20 +- .../Verify/Inductive/AliasRecFixture.lean | 16 +- .../Verify/Inductive/AliasRecPattern.lean | 14 +- .../Inductive/AliasRecRecursorFixture.lean | 12 +- .../Verify/Inductive/AliasRecSoundness.lean | 28 +- .../Inductive/AnnotatedPiAdmission.lean | 12 +- .../Inductive/AnnotatedPiCertificate.lean | 26 +- .../Verify/Inductive/AnnotatedPiFixture.lean | 16 +- .../Verify/Inductive/AnnotatedPiPattern.lean | 14 +- .../Inductive/AnnotatedPiRecursorFixture.lean | 12 +- .../Inductive/AnnotatedPiSoundness.lean | 28 +- .../Verify/Inductive/BlockCertificate.lean | 16 +- .../Inductive/BlockPatternSoundness.lean | 14 +- .../Verify/Inductive/CandidateSyntax.lean | 26 +- .../Verify/Inductive/Certificate.lean | 14 +- .../Verify/Inductive/ConcreteFixture.lean | 12 +- .../ConstructorPositivityTraversal.lean | 6 +- .../ConstructorValidationTraversal.lean | 6 +- .../Inductive/EliminationBreadthFixture.lean | 24 +- .../Inductive/EnumerationAcceptance.lean | 20 +- .../Verify/Inductive/EnumerationFixture.lean | 20 +- .../Verify/Inductive/ExactLeanSyntax.lean | 6 +- .../GeneratedRecursorAcceptance.lean | 10 +- .../GeneratedRecursorAcceptanceClosure.lean | 18 +- .../Inductive/GeneratedRecursorAdmission.lean | 16 +- .../GeneratedRecursorCheckerFixture.lean | 14 +- .../GeneratedRecursorCommitFixture.lean | 12 +- .../GeneratedRecursorComparison.lean | 6 +- .../GeneratedRecursorInitialInvariant.lean | 54 +- .../GeneratedRecursorMemberCheck.lean | 16 +- .../GeneratedRecursorMemberFixture.lean | 32 +- .../Inductive/GeneratedRecursorMetadata.lean | 8 +- .../GeneratedRecursorRuleFixture.lean | 14 +- .../Inductive/GeneratedRecursorSelection.lean | 12 +- .../Inductive/GeneratedRecursorSemantics.lean | 22 +- .../GeneratedRecursorTypeClosure.lean | 32 +- .../GeneratedRecursorTypeFixture.lean | 18 +- .../Inductive/IndexedBlockValidation.lean | 10 +- .../Inductive/IndexedCandidateOperations.lean | 12 +- .../Inductive/IndexedCandidateSyntax.lean | 40 +- .../IndexedCandidateTransaction.lean | 22 +- .../IndexedConstructorPositivity.lean | 8 +- .../IndexedConstructorValidation.lean | 74 +- .../Inductive/IndexedPositivityTransport.lean | 130 +- .../Inductive/IndexedProducerClosure.lean | 12 +- .../IndexedProductionPositivity.lean | 10 +- .../Inductive/IndexedRecursiveAcceptance.lean | 30 +- .../IndexedRecursiveCertificate.lean | 18 +- .../Inductive/IndexedRecursiveFixture.lean | 16 +- .../Inductive/IndexedRecursiveOracle.lean | 12 +- .../Inductive/IndexedRecursivePattern.lean | 16 +- .../Inductive/IndexedRecursiveSoundness.lean | 80 +- .../Verify/Inductive/IngressExecution.lean | 10 +- .../Verify/Inductive/IotaPattern.lean | 76 +- .../Inductive/MutualBlockCertificate.lean | 22 +- .../Verify/Inductive/MutualBlockFixture.lean | 14 +- .../Inductive/MutualBlockValidation.lean | 8 +- .../Verify/Inductive/MutualFamily.lean | 16 +- .../Inductive/MutualFamilyAdmission.lean | 20 +- .../Verify/Inductive/MutualRecursor.lean | 18 +- .../Inductive/MutualRecursorAdmission.lean | 110 +- .../Verify/Inductive/NestedAdmission.lean | 16 +- .../Inductive/NestedAuxiliaryExpansion.lean | 6 +- .../Inductive/NestedAuxiliaryPositivity.lean | 52 +- .../Inductive/NestedBlockCertificate.lean | 12 +- .../Inductive/NestedCandidateSyntax.lean | 60 +- .../NestedConstructorValidation.lean | 56 +- .../Inductive/NestedPositivityTransport.lean | 54 +- .../Inductive/NestedPositivityTraversal.lean | 8 +- .../Inductive/NestedRecursiveFixture.lean | 10 +- .../Inductive/NestedRecursorAdmission.lean | 12 +- .../Inductive/NestedRecursorFixture.lean | 6 +- .../Inductive/NestedRecursorPattern.lean | 14 +- .../Inductive/NestedRecursorSoundness.lean | 52 +- .../Inductive/NestedSemanticTransaction.lean | 22 +- .../Verify/Inductive/OccurrenceClosure.lean | 8 +- .../Inductive/OccurrenceValidation.lean | 20 +- .../Verify/Inductive/OneFamilyAdmission.lean | 34 +- .../Inductive/PositivityTraceAdapter.lean | 84 +- .../Verify/Inductive/PositivityTraversal.lean | 6 +- .../ProducedGenerationTransaction.lean | 26 +- .../Inductive/RecursivePiAcceptance.lean | 14 +- .../Inductive/RecursivePiAdmission.lean | 12 +- .../Inductive/RecursivePiCertificate.lean | 16 +- .../Verify/Inductive/RecursivePiFixture.lean | 12 +- .../Verify/Inductive/RecursivePiPattern.lean | 16 +- .../Inductive/RecursivePiRecursorFixture.lean | 10 +- .../Inductive/RecursivePiSoundness.lean | 64 +- .../RecursivePositivityTraversal.lean | 6 +- .../Verify/Inductive/ResultSortTelescope.lean | 8 +- .../Verify/Inductive/RuleApplication.lean | 14 +- .../Inductive/SingletonEnumeration.lean | 48 +- .../Verify/Inductive/SingletonFamily.lean | 10 +- .../Verify/Inductive/SingletonIngress.lean | 18 +- .../Verify/Inductive/SingletonOracle.lean | 8 +- .../Verify/Inductive/SingletonRecursor.lean | 14 +- .../Inductive/SpecializationIdentity.lean | 6 +- .../Inductive/StructuralCacheSemantics.lean | 6 +- Ix/{Tc => Kernel}/Verify/Infer.lean | 10 +- .../Verify/Infer/Applications.lean | 16 +- .../Verify/Infer/BinderClosing.lean | 14 +- .../Verify/Infer/BinderOpening.lean | 12 +- .../Verify/Infer/BinderScopes.lean | 12 +- .../Verify/Infer/CacheShell.lean | 6 +- .../Verify/Infer/CacheSoundness.lean | 14 +- Ix/{Tc => Kernel}/Verify/Infer/Callbacks.lean | 10 +- Ix/{Tc => Kernel}/Verify/Infer/CheapBeta.lean | 12 +- Ix/{Tc => Kernel}/Verify/Infer/Constants.lean | 18 +- .../Verify/Infer/Dispatcher.lean | 22 +- .../Verify/Infer/ForallTypes.lean | 16 +- .../Verify/Infer/FunctionTypes.lean | 12 +- .../Verify/Infer/LambdaTypes.lean | 20 +- Ix/{Tc => Kernel}/Verify/Infer/LeafCases.lean | 16 +- Ix/{Tc => Kernel}/Verify/Infer/LetScopes.lean | 8 +- Ix/{Tc => Kernel}/Verify/Infer/LetTypes.lean | 22 +- Ix/{Tc => Kernel}/Verify/Infer/Literals.lean | 32 +- .../Infer/ProjectionClassification.lean | 10 +- .../Verify/Infer/ProjectionTelescope.lean | 62 +- .../Verify/Infer/ProjectionTypes.lean | 18 +- .../Verify/Infer/ScopedLocals.lean | 12 +- Ix/{Tc => Kernel}/Verify/Infer/SortTypes.lean | 18 +- .../Verify/Infer/Substitution.lean | 8 +- .../Verify/InferDefEq/Closure.lean | 8 +- .../Verify/Ingress/AnonStructural.lean | 20 +- .../Verify/Ingress/LiteralBlobs.lean | 8 +- .../Verify/Ingress/Representation.lean | 10 +- .../Verify/Ingress/SerializedBoolean.lean | 10 +- Ix/{Tc => Kernel}/Verify/InstL.lean | 40 +- Ix/{Tc => Kernel}/Verify/InstUniv.lean | 12 +- Ix/{Tc => Kernel}/Verify/Knot.lean | 6 +- Ix/{Tc => Kernel}/Verify/Level.lean | 79 +- Ix/{Tc => Kernel}/Verify/Monad.lean | 8 +- Ix/{Tc => Kernel}/Verify/NatFixture.lean | 114 +- .../Verify/Projection/Concrete.lean | 52 +- .../Verify/Projection/ConcreteFixture.lean | 30 +- .../Verify/RecursiveMethods/CallDomains.lean | 18 +- .../Verify/RecursiveMethods/Closure.lean | 8 +- .../FiniteSupportBoundary.lean | 6 +- .../Verify/RecursiveMethods/Inference.lean | 16 +- .../Verify/RecursiveMethods/Public.lean | 22 +- .../RecursiveMethods/ScopedCallDomains.lean | 20 +- .../RecursiveMethods/ScopedInference.lean | 16 +- .../RecursiveMethods/ScopedSortInference.lean | 18 +- .../RecursiveMethods/SortInference.lean | 16 +- Ix/{Tc => Kernel}/Verify/Run.lean | 22 +- .../Verify/ScopedSuffix/ClosedContext.lean | 8 +- Ix/{Tc => Kernel}/Verify/State.lean | 18 +- Ix/{Tc => Kernel}/Verify/Statements.lean | 12 +- Ix/{Tc => Kernel}/Verify/Subst.lean | 8 +- Ix/{Tc => Kernel}/Verify/Suffix.lean | 6 +- Ix/{Tc => Kernel}/Verify/Support.lean | 6 +- Ix/{Tc => Kernel}/Verify/Totalization.lean | 10 +- Ix/{Tc => Kernel}/Verify/Trans.lean | 204 +- Ix/{Tc => Kernel}/Verify/VLCtx.lean | 16 +- Ix/{Tc => Kernel}/Verify/Whnf.lean | 76 +- .../Verify/Whnf/Beta/ArgumentAlignment.lean | 8 +- .../Verify/Whnf/Beta/ConsumptionBoundary.lean | 26 +- .../Verify/Whnf/Beta/DependentContexts.lean | 14 +- .../Verify/Whnf/Beta/InstantiationChain.lean | 10 +- .../Verify/Whnf/Beta/LambdaInstantiation.lean | 48 +- .../Verify/Whnf/Beta/LambdaPeeling.lean | 6 +- .../Verify/Whnf/Beta/LiftSubstitution.lean | 6 +- .../Verify/Whnf/Beta/Meaning.lean | 8 +- .../Verify/Whnf/Beta/PeelTrace.lean | 30 +- .../Verify/Whnf/Beta/PrefixSemantics.lean | 36 +- .../Verify/Whnf/Beta/SemanticCore.lean | 8 +- .../Whnf/Beta/SimultaneousSubstitution.lean | 6 +- .../Whnf/Beta/SingletonSubstitution.lean | 6 +- .../Verify/Whnf/Beta/Translation.lean | 12 +- Ix/{Tc => Kernel}/Verify/Whnf/Closure.lean | 8 +- .../Verify/Whnf/Delta/CacheExecution.lean | 10 +- .../Verify/Whnf/Delta/CacheSemantics.lean | 6 +- .../Verify/Whnf/Delta/ClosedTranslation.lean | 58 +- .../Verify/Whnf/Delta/Integration.lean | 8 +- .../Verify/Whnf/Delta/OptionalReduction.lean | 8 +- .../Verify/Whnf/Delta/SpineUnfolding.lean | 12 +- .../Verify/Whnf/Delta/StableCache.lean | 16 +- .../Verify/Whnf/Delta/TrustedBody.lean | 10 +- .../Verify/Whnf/Delta/UnfoldingState.lean | 8 +- .../Whnf/Delta/UniverseMonotonicity.lean | 10 +- .../Verify/Whnf/Driver/FullStep.lean | 6 +- .../Verify/Whnf/Driver/PublicReducers.lean | 12 +- .../Verify/Whnf/Iota/ApplicationRequests.lean | 8 +- .../Verify/Whnf/Iota/ArgumentBranches.lean | 18 +- .../Verify/Whnf/Iota/ArgumentExecution.lean | 18 +- .../Verify/Whnf/Iota/ConstructorDispatch.lean | 22 +- .../Whnf/Iota/ConstructorSynthesis.lean | 14 +- .../Iota/ConstructorSynthesisFallback.lean | 6 +- .../Verify/Whnf/Iota/Ingress.lean | 12 +- .../Verify/Whnf/Iota/NatLiteral.lean | 14 +- .../Verify/Whnf/Iota/NatOffset.lean | 10 +- .../Verify/Whnf/Iota/NatPatternMatching.lean | 70 +- .../Verify/Whnf/Iota/NatRecognizer.lean | 6 +- .../Verify/Whnf/Iota/NatReduction.lean | 30 +- .../Verify/Whnf/Iota/NatRuleLayout.lean | 26 +- .../Verify/Whnf/Iota/OptionalReduction.lean | 8 +- .../Verify/Whnf/Iota/RuleInstantiation.lean | 12 +- .../Verify/Whnf/Iota/RuleSuffixTransport.lean | 16 +- .../Verify/Whnf/Iota/SelectedRule.lean | 24 +- .../Verify/Whnf/Iota/StringLiteral.lean | 14 +- .../Verify/Whnf/Iota/StructEtaControl.lean | 6 +- .../Verify/Whnf/Iota/Substitution.lean | 14 +- .../Verify/Whnf/Iota/SynthesisRequests.lean | 16 +- .../Verify/Whnf/NoDelta/BaseReductions.lean | 6 +- .../Whnf/NoDelta/ProjectionApplication.lean | 8 +- .../Whnf/NoDelta/ProjectionDefinition.lean | 8 +- .../Verify/Whnf/NoDelta/Quotient.lean | 12 +- .../Whnf/NoDelta/QuotientReflection.lean | 40 +- .../Verify/Whnf/NoDelta/Reducer.lean | 8 +- .../Verify/Whnf/NoDelta/StringPrimitive.lean | 8 +- .../Verify/Whnf/Projection/NoAccelTail.lean | 6 +- .../Whnf/Projection/StringCallback.lean | 6 +- .../Whnf/Projection/StringExpansion.lean | 6 +- Ix/{Tc => Kernel}/Verify/Whnf/README.md | 2 +- .../Verify/Whnf/Runtime/LazyIngress.lean | 8 +- .../Verify/Whnf/RuntimeContracts.lean | 6 +- .../Verify/Whnf/StructEta/CallbackPrefix.lean | 12 +- .../Verify/Whnf/StructEta/Classifier.lean | 10 +- .../Whnf/StructEta/ExactMajorTelescope.lean | 6 +- .../Verify/Whnf/StructEta/Rebuild.lean | 6 +- .../Whnf/StructEta/RebuildRequests.lean | 10 +- .../Verify/Whnf/StructEta/RebuildTail.lean | 6 +- .../Whnf/StructEta/RecursionClassifier.lean | 10 +- .../Whnf/StructEta/ScopedClassifier.lean | 14 +- .../Whnf/StructEta/ScopedTelescope.lean | 24 +- .../Structural/ApplicationCongruence.lean | 14 +- .../Whnf/Structural/ApplicationRebuild.lean | 8 +- .../Whnf/Structural/ApplicationStep.lean | 6 +- .../Whnf/Structural/ApplicationTails.lean | 10 +- .../Verify/Whnf/Structural/BasicStep.lean | 6 +- .../Verify/Whnf/Structural/BetaBoundary.lean | 10 +- .../Verify/Whnf/Structural/CacheShell.lean | 12 +- .../Whnf/Structural/ProjectionStep.lean | 6 +- .../Whnf/Structural/RecursiveCallbacks.lean | 16 +- .../Verify/Whnf/Structural/Reducer.lean | 8 +- .../Verify/Whnf/Structural/StepAssembly.lean | 6 +- .../Verify/Whnf/Structural/VariableStep.lean | 8 +- .../Verify/Whnf/Structural/VerifiedStep.lean | 6 +- Ix/{Tc => Kernel}/Verify/World.lean | 12 +- Ix/{Tc => Kernel}/Whnf.lean | 24 +- Ix/Tc.lean | 54 - Ix/Theory.lean | 6 + Ix/Theory/Certificate/Build.lean | 211 + Ix/Theory/Certificate/Claims.lean | 50 + Ix/Theory/Certificate/Modeled.lean | 104 + Ix/Theory/Certificate/Ordinary.lean | 98 + Ix/Theory/Certificate/OrdinarySource.lean | 98 + Ix/Theory/Certificate/Quotient.lean | 75 + Ix/Theory/Certificate/Standard.lean | 54 + Ix/Theory/Certificate/Structure.lean | 43 + Ix/Theory/Certificate/Suggest.lean | 417 + Ix/Theory/Certified.lean | 48 + Ix/Theory/Certified/Accept.lean | 139 + Ix/Theory/Certified/Admission.lean | 245 + Ix/Theory/Certified/Basis/Equality.lean | 199 + Ix/Theory/Certified/Basis/Iff.lean | 171 + Ix/Theory/Certified/Basis/Interface.lean | 38 + Ix/Theory/Certified/Basis/Nonempty.lean | 138 + Ix/Theory/Certified/Checker.lean | 316 + Ix/Theory/Certified/ClaimComposition.lean | 245 + Ix/Theory/Certified/Claims.lean | 242 + Ix/Theory/Certified/Frontier.lean | 279 + Ix/Theory/Certified/Level.lean | 121 + Ix/Theory/Certified/LevelEq.lean | 116 + Ix/Theory/Certified/LogicalPolicy.lean | 130 + Ix/Theory/Certified/Modeled/Admission.lean | 59 + Ix/Theory/Certified/Modeled/Equation.lean | 73 + Ix/Theory/Certified/Modeled/Source.lean | 268 + Ix/Theory/Certified/Modeled/Transport.lean | 290 + Ix/Theory/Certified/Natural/Admission.lean | 63 + Ix/Theory/Certified/Natural/Checked.lean | 46 + Ix/Theory/Certified/Natural/Publish.lean | 90 + Ix/Theory/Certified/Natural/Value.lean | 120 + Ix/Theory/Certified/Operations.lean | 103 + Ix/Theory/Certified/Ordinary/Admission.lean | 113 + Ix/Theory/Certified/Ordinary/Checked.lean | 164 + Ix/Theory/Certified/Ordinary/Computation.lean | 133 + .../Certified/Ordinary/ConstructorStage.lean | 154 + .../Certified/Ordinary/Constructors.lean | 237 + Ix/Theory/Certified/Ordinary/Container.lean | 266 + Ix/Theory/Certified/Ordinary/Eliminator.lean | 264 + Ix/Theory/Certified/Ordinary/Family.lean | 139 + Ix/Theory/Certified/Ordinary/LargeElim.lean | 65 + Ix/Theory/Certified/Ordinary/Reading.lean | 309 + .../Certified/Ordinary/RecursorReading.lean | 415 + .../Certified/Ordinary/RecursorStage.lean | 163 + .../Certified/Ordinary/RecursorSyntax.lean | 155 + .../Certified/Ordinary/RecursorValue.lean | 136 + Ix/Theory/Certified/Ordinary/RuleChecks.lean | 90 + .../Certified/Ordinary/RuleEquations.lean | 115 + Ix/Theory/Certified/Ordinary/RuleReading.lean | 270 + Ix/Theory/Certified/Ordinary/Shape.lean | 212 + Ix/Theory/Certified/Policy.lean | 131 + Ix/Theory/Certified/Prelude.lean | 247 + Ix/Theory/Certified/PropWhen.lean | 330 + Ix/Theory/Certified/Quotient/Admission.lean | 57 + Ix/Theory/Certified/Quotient/Checked.lean | 179 + Ix/Theory/Certified/Quotient/Publish.lean | 195 + Ix/Theory/Certified/Quotient/Reading.lean | 184 + Ix/Theory/Certified/Quotient/Syntax.lean | 144 + Ix/Theory/Certified/Quotient/Value.lean | 185 + Ix/Theory/Certified/Signature.lean | 162 + Ix/Theory/Certified/Source.lean | 153 + Ix/Theory/Certified/Standard/Admission.lean | 61 + Ix/Theory/Certified/Standard/Checked.lean | 89 + Ix/Theory/Certified/Standard/Realization.lean | 127 + Ix/Theory/Certified/Store.lean | 69 + Ix/Theory/Certified/Structure/Admission.lean | 62 + Ix/Theory/Certified/Structure/Checked.lean | 117 + .../Certified/Structure/Computation.lean | 84 + Ix/Theory/Certified/Structure/Publish.lean | 161 + Ix/Theory/Certified/Structure/Reading.lean | 149 + Ix/Theory/Certified/Structure/Syntax.lean | 111 + Ix/Theory/Certified/Structure/Value.lean | 141 + Ix/Theory/Certified/Telescope.lean | 172 + Ix/Theory/Const.lean | 165 + Ix/Theory/Expr.lean | 284 + Ix/Theory/Inductive/Levels.lean | 124 + Ix/Theory/LICENSE | 234 + Ix/Theory/LICENSE-APACHE | 201 + Ix/Theory/LICENSE-MIT | 21 + Ix/Theory/Model/Annotated.lean | 221 + Ix/Theory/Model/Context.lean | 56 + Ix/Theory/Model/Environment.lean | 76 + Ix/Theory/Model/Extension.lean | 346 + Ix/Theory/Model/Inductive/Codes.lean | 43 + Ix/Theory/Model/Inductive/Container.lean | 192 + Ix/Theory/Model/Inductive/Recursor.lean | 218 + Ix/Theory/Model/Inductive/Telescope.lean | 585 + Ix/Theory/Model/Instantiation.lean | 96 + Ix/Theory/Model/Interpret.lean | 150 + Ix/Theory/Model/Judgment.lean | 280 + Ix/Theory/Model/PrimitiveValues.lean | 38 + Ix/Theory/Model/ReferenceMap.lean | 168 + Ix/Theory/Model/SetModel/Container.lean | 665 + Ix/Theory/Model/SetModel/Iter.lean | 107 + Ix/Theory/Model/SetModel/Ops.lean | 366 + Ix/Theory/Model/SetModel/RecGraph.lean | 270 + Ix/Theory/Model/SetModel/TaggedSum.lean | 186 + Ix/Theory/Model/SetModel/TupleTower.lean | 424 + Ix/Theory/Model/SetTheory/Core.lean | 166 + Ix/Theory/Model/SetTheory/Derive/Choice.lean | 75 + Ix/Theory/Model/SetTheory/Derive/Empty.lean | 79 + Ix/Theory/Model/SetTheory/Derive/Graphs.lean | 252 + Ix/Theory/Model/SetTheory/Derive/Lfp.lean | 162 + Ix/Theory/Model/SetTheory/Derive/LfpFam.lean | 170 + Ix/Theory/Model/SetTheory/Derive/Omega.lean | 142 + Ix/Theory/Model/SetTheory/Derive/Pair.lean | 128 + Ix/Theory/Model/SetTheory/Derive/Pt.lean | 240 + Ix/Theory/Model/SetTheory/Derive/Quot.lean | 234 + Ix/Theory/Model/SetTheory/Derive/Sep.lean | 74 + Ix/Theory/Model/SetTheory/Derive/Sigma.lean | 158 + Ix/Theory/Model/SetTheory/Derive/Univ.lean | 110 + .../Model/SetTheory/Derive/Universe.lean | 175 + Ix/Theory/Model/Signature.lean | 159 + Ix/Theory/Model/Support.lean | 126 + Ix/Theory/Model/TelescopeSemantics.lean | 81 + Ix/Theory/Model/Value.lean | 90 + Ix/Theory/Model/WellDenoted.lean | 148 + Ix/Theory/NOTICE | 51 + .../Named/ConstructorValidityFixtures.lean | 176 + .../Fixtures/ProjectionExpressibility.lean | 1307 + Ix/Theory/Named/Inductive.lean | 3045 ++ Ix/Theory/Named/InductiveFixtures.lean | 2897 ++ Ix/Theory/Named/LICENSE | 201 + Ix/Theory/Named/Literals.lean | 682 + Ix/Theory/Named/LocalContext.lean | 150 + Ix/Theory/Named/Meta.lean | 120 + Ix/Theory/Named/MutualInductiveFixtures.lean | 199 + Ix/Theory/Named/NOTICE | 116 + Ix/Theory/Named/NestedInductive.lean | 534 + Ix/Theory/Named/NestedInductiveFixtures.lean | 329 + Ix/Theory/Named/Projection.lean | 3518 ++ Ix/Theory/Named/Quot.lean | 27 + Ix/Theory/Named/Reference/Declaration.lean | 33 + Ix/Theory/Named/Reference/Environment.lean | 125 + .../Named/Reference/Environment/Basic.lean | 226 + Ix/Theory/Named/Reference/Expr.lean | 138 + Ix/Theory/Named/Reference/ForEachExprV.lean | 36 + Ix/Theory/Named/Reference/FuelConfig.lean | 41 + Ix/Theory/Named/Reference/Inductive/Add.lean | 2941 ++ .../Reference/Inductive/EliminationTrace.lean | 581 + .../Named/Reference/Inductive/Reduce.lean | 120 + .../Reference/Inductive/ValidationTrace.lean | 1600 + Ix/Theory/Named/Reference/Instantiate.lean | 39 + Ix/Theory/Named/Reference/Level.lean | 412 + Ix/Theory/Named/Reference/List.lean | 11 + Ix/Theory/Named/Reference/LocalContext.lean | 27 + Ix/Theory/Named/Reference/Primitive.lean | 498 + Ix/Theory/Named/Reference/PtrEq.lean | 28 + Ix/Theory/Named/Reference/Quot.lean | 126 + Ix/Theory/Named/Reference/TypeChecker.lean | 1074 + Ix/Theory/Named/SingletonParity.lean | 186 + Ix/Theory/Named/Std/AxiomAudit.lean | 130 + Ix/Theory/Named/Std/Basic.lean | 270 + Ix/Theory/Named/Std/Control.lean | 8 + Ix/Theory/Named/Std/HashMap.lean | 105 + Ix/Theory/Named/Std/NodupKeys.lean | 45 + Ix/Theory/Named/Std/Ord.lean | 58 + Ix/Theory/Named/Std/PersistentHashMap.lean | 48 + Ix/Theory/Named/Std/SMap.lean | 83 + Ix/Theory/Named/Std/ToExpr.lean | 73 + Ix/Theory/Named/Std/VariableBang.lean | 22 + Ix/Theory/Named/Typing/Basic.lean | 141 + Ix/Theory/Named/Typing/Env.lean | 79 + Ix/Theory/Named/Typing/EnvLemmas.lean | 120 + .../Named/Typing/InductiveCertificate.lean | 514 + Ix/Theory/Named/Typing/InductiveLemmas.lean | 14628 +++++++ Ix/Theory/Named/Typing/InductivePattern.lean | 761 + .../Named/Typing/InductivePatternWF.lean | 943 + Ix/Theory/Named/Typing/Injectivity.lean | 43 + Ix/Theory/Named/Typing/Lemmas.lean | 1115 + Ix/Theory/Named/Typing/Meta.lean | 54 + .../Named/Typing/NestedInductiveLemmas.lean | 190 + Ix/Theory/Named/Typing/Pattern.lean | 466 + Ix/Theory/Named/Typing/QuotLemmas.lean | 39 + Ix/Theory/Named/Typing/Strong.lean | 1031 + Ix/Theory/Named/Typing/UniqueTyping.lean | 377 + Ix/Theory/Named/VDecl.lean | 37 + Ix/Theory/Named/VEnv.lean | 214 + Ix/Theory/Named/VExpr.lean | 831 + Ix/Theory/Named/VLevel.lean | 99 + Ix/Theory/Named/Verify/Axioms.lean | 516 + Ix/Theory/Named/Verify/Environment/Basic.lean | 555 + .../Environment/ConstructorValidation.lean | 9028 ++++ .../ConstructorValidityMatrix.lean | 358 + .../Named/Verify/Environment/Elimination.lean | 244 + .../EliminationFixturesCommon.lean | 65 + .../Environment/EliminationFixturesEdges.lean | 249 + .../Environment/EliminationFixturesEq.lean | 65 + .../Environment/EliminationFixturesEqNat.lean | 10 + .../Environment/EliminationFixturesNat.lean | 114 + .../Environment/EliminationFixturesOrAnd.lean | 137 + .../Environment/EliminationFixturesSmall.lean | 100 + .../Environment/IndexedVecCandidate.lean | 1686 + .../Environment/IndexedVecConsReplay.lean | 2863 ++ .../Environment/IndexedVecConstructors.lean | 1803 + .../Environment/IndexedVecOuterReplay.lean | 1757 + .../Environment/IndexedVecSemanticReplay.lean | 3540 ++ .../Verify/Environment/InductiveFixtures.lean | 12189 ++++++ .../Named/Verify/Environment/Lemmas.lean | 664 + .../Environment/MutualInductiveFixtures.lean | 3150 ++ .../Verify/Environment/NestedReplay.lean | 3402 ++ .../Environment/NestedRepresentation.lean | 718 + .../Environment/NestedTransformation.lean | 389 + .../Verify/Environment/Normalization.lean | 6953 ++++ .../Environment/NormalizationMatrix.lean | 749 + .../Environment/SingletonParityMatrix.lean | 471 + .../Environment/SingletonParityReplay.lean | 2820 ++ Ix/Theory/Named/Verify/Expr.lean | 1303 + Ix/Theory/Named/Verify/Level.lean | 3916 ++ Ix/Theory/Named/Verify/LevelStd.lean | 549 + Ix/Theory/Named/Verify/LocalContext.lean | 337 + Ix/Theory/Named/Verify/Name.lean | 96 + Ix/Theory/Named/Verify/NameGenerator.lean | 34 + Ix/Theory/Named/Verify/NormLt.lean | 370 + Ix/Theory/Named/Verify/QSort.lean | 398 + Ix/Theory/Named/Verify/TypeChecker.lean | 236 + Ix/Theory/Named/Verify/TypeChecker/Basic.lean | 1176 + .../Named/Verify/TypeChecker/InferType.lean | 1082 + .../Named/Verify/TypeChecker/IsDefEq.lean | 1228 + .../Named/Verify/TypeChecker/Reduce.lean | 221 + Ix/Theory/Named/Verify/TypeChecker/WHNF.lean | 275 + .../Verify/Typing/ConditionallyTyped.lean | 150 + Ix/Theory/Named/Verify/Typing/Expr.lean | 146 + Ix/Theory/Named/Verify/Typing/Lemmas.lean | 2636 ++ Ix/Theory/Named/Verify/VLCtx.lean | 88 + Ix/Theory/PORTING.md | 11 + Ix/Theory/Quot.lean | 239 + Ix/Theory/Ref.lean | 23 + Ix/Theory/Rename.lean | 308 + Ix/Theory/Std/Basic.lean | 31 + Ix/Theory/Store.lean | 116 + Ix/Theory/VLevel.lean | 128 + Models/SetTheory/IxSetTheoryModel.lean | 6 + Models/SetTheory/IxSetTheoryModel/Audit.lean | 52 + .../SetTheory/IxSetTheoryModel/Carneiro.lean | 181 + Models/SetTheory/LICENSE-CON-LECHE | 71 + Models/SetTheory/NOTICE | 11 + Models/SetTheory/README.md | 53 + Models/SetTheory/lake-manifest.json | 123 + Models/SetTheory/lakefile.toml | 17 + Models/SetTheory/lean-toolchain | 1 + README.md | 4 + Tests/Aiur/AIRSemantics.lean | 189 + Tests/Aiur/Backend.lean | 99 + Tests/Aiur/BlockRows.lean | 127 + Tests/Aiur/ByteGadgets.lean | 68 + Tests/Aiur/BytecodeCompare.lean | 70 + Tests/Aiur/CircuitRows.lean | 169 + Tests/Aiur/Dedup.lean | 111 + Tests/Aiur/DedupFixtures.lean | 59 + Tests/Aiur/Hoisting.lean | 97 + Tests/Aiur/LookupBudget.lean | 61 + Tests/Aiur/LookupShapes.lean | 93 + Tests/Aiur/OperationRows.lean | 124 + Tests/Aiur/SelectorControl.lean | 110 + Tests/Aiur/SourceValues.lean | 43 + Tests/Aiur/TailMatches.lean | 81 + Tests/Aiur/backend-foundation.txt | 11181 +++++ Tests/Aiur/bytecode-compatibility.txt | 396 + Tests/Aiur/dedup-compatibility.txt | 1333 + Tests/Aiur/source-value-compatibility.txt | 100 + Tests/Aiur/tail-match-compatibility.txt | 282 + Tests/Certified/CLI.lean | 264 + Tests/Certified/Check.lean | 132 + Tests/Certified/Claims.lean | 375 + Tests/Certified/ClaimsMain.lean | 13 + Tests/Certified/FeatureCases.lean | 296 + Tests/Certified/Features.lean | 13 + Tests/Certified/Fidelity.lean | 132 + Tests/Certified/FidelityMain.lean | 13 + Tests/Certified/ImportManifest.lean | 80 + Tests/Certified/ModelSerialize.lean | 113 + Tests/Certified/Modeled.lean | 147 + Tests/Certified/ModeledAdversarial.lean | 232 + Tests/Certified/ModeledMain.lean | 11 + Tests/Certified/Ordinary.lean | 252 + Tests/Certified/Serialize.lean | 243 + Tests/Certified/Source.lean | 272 + Tests/Certified/SourceMain.lean | 13 + Tests/Certified/VM.lean | 136 + Tests/Certified/foundation.txt | 4243 ++ Tests/Compiler/CatalogContact.lean | 33 + Tests/Compiler/Checks/CheckSourceBorrow.lean | 167 + .../Checks/CheckSourceBorrowRuntime.lean | 146 + .../Compiler/Checks/CheckSourceCallReuse.lean | 184 + .../Compiler/Checks/CheckSourceCoverage.lean | 204 + .../CheckSourceNativeCapturedScalar.lean | 62 + .../CheckSourceNativePhysicalScalar.lean | 59 + .../Checks/CheckSourceNativeRuntime.lean | 348 + .../Checks/CheckSourceNativeScalar.lean | 58 + .../Checks/CheckSourceNativeUnique.lean | 241 + .../Checks/CheckSourceNativeUpstream.lean | 67 + .../Compiler/Checks/CheckSourceRecursion.lean | 122 + .../Checks/CheckSourceUniqueReuse.lean | 38 + Tests/Compiler/Checks/CheckToolsTests.lean | 133 + .../Compiler/Checks/CheckTrustedExterns.lean | 16 + Tests/Compiler/Checks/CheckX86Bytes.lean | 262 + Tests/Compiler/Checks/CheckX86Encoder.lean | 42 + Tests/Compiler/Checks/CheckX86Object.lean | 108 + Tests/Compiler/Checks/CheckX86Streams.lean | 309 + Tests/Compiler/SourceBorrow.lean | 35 + Tests/Compiler/SourceBorrowRuntime.lean | 36 + Tests/Compiler/SourceCallReuse.lean | 29 + Tests/Compiler/SourceCoverage.lean | 51 + .../Compiler/SourceNativeCapturedScalar.lean | 251 + .../Compiler/SourceNativePhysicalScalar.lean | 270 + Tests/Compiler/SourceNativeRuntime.lean | 30 + Tests/Compiler/SourceNativeScalar.lean | 173 + Tests/Compiler/SourceNativeUnique.lean | 32 + Tests/Compiler/SourceNativeUpstream.lean | 33 + Tests/Compiler/SourceRecursion.lean | 30 + Tests/Compiler/SourceUniqueReuse.lean | 29 + Tests/Compiler/Tests.lean | 6083 +++ Tests/Compiler/X86ObjectFixture.lean | 123 + Tests/Fixtures/Certified/README.md | 22 + Tests/Fixtures/Certified/c7-handoff.tar.gz | Bin 0 -> 3510635 bytes .../CompilatrixStdContact.ixe.hex | 457 + .../Compiler/ixon-std-contact/README.md | 75 + .../Compiler/ixon-std-contact/manifest.hex | 9 + .../ixon-upstream/CompilatrixUpstream.lean | 29 + .../Fixtures/Compiler/ixon-upstream/README.md | 60 + .../Compiler/ixon-upstream/addClosed.ixe.hex | 192 + .../ixon-upstream/addClosed.manifest.hex | 18 + .../ixon-upstream/applyClosed.ixe.hex | 42 + .../ixon-upstream/applyClosed.manifest.hex | 18 + .../ixon-upstream/captureClosed.ixe.hex | 42 + .../ixon-upstream/captureClosed.manifest.hex | 18 + .../Compiler/ixon-upstream/lake-manifest.json | 1 + .../Compiler/ixon-upstream/lakefile.toml | 5 + .../Compiler/ixon-upstream/lean-toolchain | 1 + .../Compiler/ixon-upstream/letClosed.ixe.hex | 42 + .../ixon-upstream/letClosed.manifest.hex | 18 + .../Compiler/ixon-upstream/recClosed.ixe.hex | 50 + .../ixon-upstream/recClosed.manifest.hex | 18 + .../source-borrow-runtime/expected.json | 161 + .../Compiler/source-borrow/expected.json | 181 + .../Compiler/source-call-reuse/expected.json | 543 + .../Compiler/source-coverage/README.md | 17 + .../Compiler/source-coverage/expected.json | 561 + .../source-native-captured-scalar/README.md | 27 + .../expected.json | 207 + .../native_harness.c | 97 + .../source-native-physical-scalar/README.md | 31 + .../expected.json | 155 + .../native_harness.c | 105 + .../Compiler/source-native-runtime/README.md | 24 + .../expected-counter-fold.json | 414 + .../source-native-runtime/expected.json | 414 + .../source-native-runtime/native_harness.c | 205 + .../Compiler/source-native-scalar/README.md | 12 + .../source-native-scalar/expected.json | 75 + .../source-native-scalar/native_harness.c | 97 + .../source-native-unique/expected.json | 302 + .../source-native-unique/native_harness.c | 163 + .../source-native-upstream/expected.json | 174 + .../source-native-upstream/native_harness.c | 79 + .../Compiler/source-recursion/README.md | 31 + .../Compiler/source-recursion/expected.json | 465 + .../source-unique-reuse/expected.json | 468 + Tests/Fixtures/Compiler/x86/native_harness.c | 15 + Tests/Ix/Compile/LevelSpellings.lean | 2 +- Tests/Ix/IxVM.lean | 167 +- Tests/Ix/IxVM/Exploits.lean | 12 +- Tests/Ix/{Tc => Kernel}/AccelDiff.lean | 14 +- Tests/Ix/{Tc => Kernel}/AnonDiff.lean | 10 +- Tests/Ix/Kernel/CheckPrimeGaps.lean | 2 +- Tests/Ix/Kernel/CheckTauCetiReduction.lean | 2 +- Tests/Ix/{Tc => Kernel}/CheckTests.lean | 22 +- .../CheckerRoundtrip.lean} | 48 +- Tests/Ix/Kernel/FocusedLeanCheck.lean | 4 +- Tests/Ix/{Tc => Kernel}/InferDefEq.lean | 22 +- Tests/Ix/{Tc => Kernel}/IngressMetaTests.lean | 42 +- Tests/Ix/{Tc => Kernel}/InitScale.lean | 12 +- Tests/Ix/{Tc => Kernel}/IxonFixtures.lean | 12 +- Tests/Ix/Kernel/NatReduction.lean | 2 +- Tests/Ix/{Tc => Kernel}/ParityEnv.lean | 4 +- Tests/Ix/{Tc => Kernel}/Pins.lean | 16 +- Tests/Ix/Kernel/PrimAddrs.lean | 10 +- Tests/Ix/{Tc => Kernel}/Substrate.lean | 10 +- Tests/Ix/{Tc => Kernel}/TutorialTc.lean | 18 +- Tests/Ix/{Tc => Kernel}/Unit.lean | 14 +- Tests/Ix/{Tc => Kernel}/WhnfTests.lean | 12 +- Tests/Ix/Lean4Lean.lean | 37 - Tests/Main.lean | 60 +- Tests/Theory.lean | 22 + Tests/Theory/Acceptance.lean | 161 + Tests/Theory/Audit/Certified.lean | 484 + Tests/Theory/Certified.lean | 76 + Tests/Theory/Checker.lean | 86 + Tests/Theory/Claims.lean | 130 + Tests/Theory/ImportManifest.lean | 176 + Tests/Theory/Modeled.lean | 165 + Tests/Theory/ModeledEquations.lean | 99 + Tests/Theory/ModeledFixtures.lean | 83 + Tests/Theory/ModeledNested.lean | 177 + Tests/Theory/ModeledPermutation.lean | 105 + Tests/Theory/NamedManifest.lean | 123 + Tests/Theory/Natural.lean | 108 + Tests/Theory/Operations.lean | 49 + Tests/Theory/Ordinary.lean | 203 + Tests/Theory/OrdinaryAcceptance.lean | 162 + Tests/Theory/Provenance.lean | 57 + Tests/Theory/Quotient.lean | 144 + Tests/Theory/RecursorGoldens.lean | 45 + Tests/Theory/Standard.lean | 132 + Tests/Theory/Structure.lean | 159 + Tests/Theory/Suggestions.lean | 55 + Tests/Theory/certified-foundation.txt | 10669 +++++ crates/aiur/src/call_order.rs | 27 + crates/aiur/src/constraints.rs | 85 +- crates/aiur/src/constraints/tests.rs | 281 + .../aiur/src/constraints/tests/block_rows.rs | 165 + .../src/constraints/tests/circuit_rows.rs | 211 + .../src/constraints/tests/operation_rows.rs | 207 + crates/aiur/src/execute.rs | 9 +- crates/aiur/src/gadgets/bytes2.rs | 9 + crates/aiur/src/lib.rs | 4 + crates/aiur/src/lookup_budget.rs | 34 + crates/aiur/src/lookup_shapes.rs | 138 + crates/aiur/src/memory.rs | 4 +- crates/aiur/src/querymap.rs | 70 +- crates/aiur/src/row_counts.rs | 210 + crates/aiur/src/synthesis.rs | 108 +- crates/aiur/src/synthesis/tests/acceptance.rs | 219 + crates/aiur/src/synthesis/tests/advice.rs | 156 + crates/aiur/src/synthesis/tests/branchless.rs | 124 + .../aiur/src/synthesis/tests/byte_gadgets.rs | 243 + crates/aiur/src/synthesis/tests/call_order.rs | 396 + .../aiur/src/synthesis/tests/lookup_budget.rs | 186 + .../aiur/src/synthesis/tests/lookup_shapes.rs | 298 + crates/aiur/src/synthesis/tests/memory.rs | 112 + crates/aiur/src/synthesis/tests/scalar.rs | 125 + crates/aiur/src/trace.rs | 49 +- crates/common/src/prim_addrs.rs | 2 +- .../compile/src/compile/aux_gen/expr_utils.rs | 2 +- .../aux_gen/source_name_hints_reference.rs | 2 +- crates/ffi/src/kernel.rs | 2 +- crates/ffi/src/lean_build.rs | 2 +- crates/ixon/src/canon_univ.rs | 12 +- crates/ixon/src/diff.rs | 2 +- crates/ixvm-codegen/src/aiur_ix_aggr.rs | 7622 ++-- crates/ixvm-codegen/src/aiur_ixvm.rs | 5230 +-- crates/ixvm-codegen/src/aiur_ixvm_witness.rs | 2 +- crates/ixvm-codegen/src/aiur_multi_stark.rs | 12346 +++--- crates/kernel/src/def_eq.rs | 44 +- crates/kernel/src/def_eq/application.rs | 2 +- crates/kernel/src/def_eq/binders.rs | 4 +- crates/kernel/src/env.rs | 4 +- crates/kernel/src/inductive.rs | 18 +- crates/kernel/src/infer.rs | 6 +- crates/kernel/src/level.rs | 36 +- crates/kernel/src/subst.rs | 10 +- crates/kernel/src/tc.rs | 8 +- crates/kernel/src/tutorial/defeq.rs | 2 +- crates/kernel/src/whnf.rs | 44 +- docs/benchmarking.md | 6 - docs/certified-checking.md | 158 + docs/compiler/README.md | 52 + docs/compiler/compiler-design.md | 45 + docs/compiler/lowering-restrictions.md | 19 + docs/compiler/trusted-extern-ledger.md | 38 + docs/ix_canonicity.md | 24 +- docs/kernel-verification.md | 556 + docs/tc-context-digest-collision-boundary.md | 2 +- docs/tc-k0-backedge-audit.md | 20 +- docs/theory.md | 67 + flake.nix | 16 - lake-manifest.json | 12 +- lakefile.lean | 502 +- native/compiler/hpt_cache_sync.c | 105 + 1506 files changed, 562262 insertions(+), 21616 deletions(-) create mode 100644 .github/workflows/set-theory-model.yml create mode 100644 AGENTS.md delete mode 100644 Benchmarks/Compile/TruthMines/Members/Lean4Lean.lean create mode 100644 Benchmarks/Compiler.lean create mode 100644 Benchmarks/Compiler/Analyze.lean create mode 100644 Benchmarks/Compiler/Build.lean create mode 100644 Benchmarks/Compiler/Check.lean create mode 100644 Benchmarks/Compiler/CounterFold.lean create mode 100644 Benchmarks/Compiler/CounterFoldBuild.lean create mode 100644 Benchmarks/Compiler/CounterFoldRun.lean create mode 100644 Benchmarks/Compiler/Data.lean create mode 100644 Benchmarks/Compiler/Diagnostics.lean create mode 100644 Benchmarks/Compiler/Environment.lean create mode 100644 Benchmarks/Compiler/Measure.lean create mode 100644 Benchmarks/Compiler/Pilot.lean create mode 100644 Benchmarks/Compiler/Reproduce.lean create mode 100644 Benchmarks/Compiler/Schedule.lean create mode 100644 Benchmarks/Compiler/Verify.lean create mode 100644 Benchmarks/Compiler/cakeml/reverse.cml create mode 100644 Benchmarks/Compiler/counter-fold.md create mode 100644 Benchmarks/Compiler/lean/LeanReverse.lean create mode 100644 Benchmarks/Compiler/manifest.json create mode 100644 Benchmarks/Compiler/native/arena.h create mode 100644 Benchmarks/Compiler/native/arena_backend.c create mode 100644 Benchmarks/Compiler/native/arena_kernel.c create mode 100644 Benchmarks/Compiler/native/cakeml_ffi.c create mode 100644 Benchmarks/Compiler/native/common.c create mode 100644 Benchmarks/Compiler/native/common.h create mode 100644 Benchmarks/Compiler/native/driver.c create mode 100644 Benchmarks/Compiler/native/lean_backend.c create mode 100644 Benchmarks/Compiler/native/worker_launcher.c create mode 100644 Benchmarks/Compiler/protocol.md create mode 100644 Benchmarks/Compiler/toolchains.json delete mode 100644 Benchmarks/Lean4Lean.lean delete mode 100644 Benchmarks/Lean4LeanMain.lean delete mode 100644 Benchmarks/TruthMines/Drivers/Lean4Lean.lean create mode 120000 CLAUDE.md create mode 100644 Ix/Aiur/BoundVerifier.lean create mode 100644 Ix/Aiur/Branchless.lean create mode 100644 Ix/Aiur/LookupShapes.lean create mode 100644 Ix/Aiur/Proofs.lean create mode 100644 Ix/Aiur/Proofs/Activity.lean create mode 100644 Ix/Aiur/Proofs/Audit.lean create mode 100644 Ix/Aiur/Proofs/BlockQueryPool.lean create mode 100644 Ix/Aiur/Proofs/BlockQuerySlots.lean create mode 100644 Ix/Aiur/Proofs/BlockRowCalls.lean create mode 100644 Ix/Aiur/Proofs/BlockRowExecution.lean create mode 100644 Ix/Aiur/Proofs/BlockRowInputs.lean create mode 100644 Ix/Aiur/Proofs/BlockRowProjection.lean create mode 100644 Ix/Aiur/Proofs/BlockRows.lean create mode 100644 Ix/Aiur/Proofs/BranchSelection.lean create mode 100644 Ix/Aiur/Proofs/BranchlessSlots.lean create mode 100644 Ix/Aiur/Proofs/ByteArithmetic.lean create mode 100644 Ix/Aiur/Proofs/ByteLookups.lean create mode 100644 Ix/Aiur/Proofs/CallInventory.lean create mode 100644 Ix/Aiur/Proofs/CallOrder.lean create mode 100644 Ix/Aiur/Proofs/CircuitMembership.lean create mode 100644 Ix/Aiur/Proofs/CircuitPoolExecution.lean create mode 100644 Ix/Aiur/Proofs/CircuitRowCounts.lean create mode 100644 Ix/Aiur/Proofs/CircuitRowExecution.lean create mode 100644 Ix/Aiur/Proofs/CircuitRowMembers.lean create mode 100644 Ix/Aiur/Proofs/CircuitRowQueries.lean create mode 100644 Ix/Aiur/Proofs/CircuitRowReturns.lean create mode 100644 Ix/Aiur/Proofs/CircuitRows.lean create mode 100644 Ix/Aiur/Proofs/CircuitTableData.lean create mode 100644 Ix/Aiur/Proofs/CircuitTableExecution.lean create mode 100644 Ix/Aiur/Proofs/CircuitTraces.lean create mode 100644 Ix/Aiur/Proofs/Compilation.lean create mode 100644 Ix/Aiur/Proofs/Dedup.lean create mode 100644 Ix/Aiur/Proofs/EncodedCircuitExecution.lean create mode 100644 Ix/Aiur/Proofs/Execution.lean create mode 100644 Ix/Aiur/Proofs/Field.lean create mode 100644 Ix/Aiur/Proofs/FunctionRows.lean create mode 100644 Ix/Aiur/Proofs/GlobalLookups.lean create mode 100644 Ix/Aiur/Proofs/Grouping.lean create mode 100644 Ix/Aiur/Proofs/LocalConstraints.lean create mode 100644 Ix/Aiur/Proofs/Lookup.lean create mode 100644 Ix/Aiur/Proofs/LookupBudget.lean create mode 100644 Ix/Aiur/Proofs/LookupLayout.lean create mode 100644 Ix/Aiur/Proofs/LookupMessages.lean create mode 100644 Ix/Aiur/Proofs/LookupShapes.lean create mode 100644 Ix/Aiur/Proofs/Memory.lean create mode 100644 Ix/Aiur/Proofs/Metadata.lean create mode 100644 Ix/Aiur/Proofs/NormalizationFrames.lean create mode 100644 Ix/Aiur/Proofs/OperationRows.lean create mode 100644 Ix/Aiur/Proofs/ProviderEquivalence.lean create mode 100644 Ix/Aiur/Proofs/PublicCircuitExecution.lean create mode 100644 Ix/Aiur/Proofs/QuerySlotMessages.lean create mode 100644 Ix/Aiur/Proofs/QuerySlots.lean create mode 100644 Ix/Aiur/Proofs/Renaming.lean create mode 100644 Ix/Aiur/Proofs/ReturnGates.lean create mode 100644 Ix/Aiur/Proofs/RowCounts.lean create mode 100644 Ix/Aiur/Proofs/SelectorControl.lean create mode 100644 Ix/Aiur/Proofs/SelectorMessages.lean create mode 100644 Ix/Aiur/Proofs/TailMatches.lean create mode 100644 Ix/Aiur/RowCounts.lean create mode 100644 Ix/Aiur/Semantics/AIR.lean create mode 100644 Ix/Certified.lean create mode 100644 Ix/Certified/Audit.lean create mode 100644 Ix/Certified/AuditAll.lean create mode 100644 Ix/Certified/AuditSupport.lean create mode 100644 Ix/Certified/Bytes.lean create mode 100644 Ix/Certified/ClaimAccept.lean create mode 100644 Ix/Certified/ClaimAudit.lean create mode 100644 Ix/Certified/ClaimCheck.lean create mode 100644 Ix/Certified/ClaimCommand.lean create mode 100644 Ix/Certified/ClaimInput.lean create mode 100644 Ix/Certified/ClaimMain.lean create mode 100644 Ix/Certified/ClaimMeaning.lean create mode 100644 Ix/Certified/ClaimSuggest.lean create mode 100644 Ix/Certified/Command.lean create mode 100644 Ix/Certified/Corpus.lean create mode 100644 Ix/Certified/Envelope.lean create mode 100644 Ix/Certified/Fixtures.lean create mode 100644 Ix/Certified/Ingress.lean create mode 100644 Ix/Certified/Ixon.lean create mode 100644 Ix/Certified/Main.lean create mode 100644 Ix/Certified/ModelHints.lean create mode 100644 Ix/Certified/ModeledAudit.lean create mode 100644 Ix/Certified/NOTICE create mode 100644 Ix/Certified/Packet.lean create mode 100644 Ix/Certified/Reveal.lean create mode 100644 Ix/Certified/SourceAudit.lean create mode 100644 Ix/Certified/SourceExpr.lean create mode 100644 Ix/Certified/SourceMeaning.lean create mode 100644 Ix/Certified/SourceStore.lean create mode 100644 Ix/Certified/Store.lean create mode 100644 Ix/Certified/Suggest.lean create mode 100644 Ix/Certified/TcAudit.lean create mode 100644 Ix/Certified/Trees.lean create mode 100644 Ix/Compiler.lean create mode 100644 Ix/Compiler/AddressEnv.lean create mode 100644 Ix/Compiler/Borrow/Pipeline.lean create mode 100644 Ix/Compiler/Borrow/Report.lean create mode 100644 Ix/Compiler/Borrow/Runtime.lean create mode 100644 Ix/Compiler/Borrow/RuntimeInput.lean create mode 100644 Ix/Compiler/Borrow/RuntimeReport.lean create mode 100644 Ix/Compiler/Borrow/RuntimeSim.lean create mode 100644 Ix/Compiler/Borrow/RuntimeSource.lean create mode 100644 Ix/Compiler/Borrow/Sources.lean create mode 100644 Ix/Compiler/CallReuse/MapPipeline.lean create mode 100644 Ix/Compiler/CallReuse/MapSim.lean create mode 100644 Ix/Compiler/CallReuse/Observations.lean create mode 100644 Ix/Compiler/CallReuse/Pipeline.lean create mode 100644 Ix/Compiler/CallReuse/PolicyExamples.lean create mode 100644 Ix/Compiler/CallReuse/Provenance.lean create mode 100644 Ix/Compiler/CallReuse/Rejections.lean create mode 100644 Ix/Compiler/CallReuse/Sim.lean create mode 100644 Ix/Compiler/CallReuse/Sources.lean create mode 100644 Ix/Compiler/Coverage/HeapSnapshot.lean create mode 100644 Ix/Compiler/Coverage/Report.lean create mode 100644 Ix/Compiler/Coverage/Run.lean create mode 100644 Ix/Compiler/Coverage/Snapshot.lean create mode 100644 Ix/Compiler/Coverage/Sources.lean create mode 100644 Ix/Compiler/Coverage/StdContact.lean create mode 100644 Ix/Compiler/Coverage/Upstream.lean create mode 100644 Ix/Compiler/Coverage/UpstreamNative.lean create mode 100644 Ix/Compiler/DurableSync.lean create mode 100644 Ix/Compiler/Erase.lean create mode 100644 Ix/Compiler/EraseAddressed.lean create mode 100644 Ix/Compiler/EraseAddressedSim.lean create mode 100644 Ix/Compiler/EraseValidator.lean create mode 100644 Ix/Compiler/Fence.lean create mode 100644 Ix/Compiler/Fuel.lean create mode 100644 Ix/Compiler/IxIR/Decode.lean create mode 100644 Ix/Compiler/IxIR/Encoding.lean create mode 100644 Ix/Compiler/IxIR0/Basic.lean create mode 100644 Ix/Compiler/IxIR0/Decode.lean create mode 100644 Ix/Compiler/IxIR0/DynamicCost.lean create mode 100644 Ix/Compiler/IxIR0/Eval.lean create mode 100644 Ix/Compiler/IxIR0/Examples.lean create mode 100644 Ix/Compiler/IxIR0/MapRecovery.lean create mode 100644 Ix/Compiler/IxIR0/MapRecoverySim.lean create mode 100644 Ix/Compiler/IxIR0/Mono.lean create mode 100644 Ix/Compiler/IxIR0/MutualBlock.lean create mode 100644 Ix/Compiler/IxIR0/NatArithmetic.lean create mode 100644 Ix/Compiler/IxIR0/NatRecursors.lean create mode 100644 Ix/Compiler/IxIR0/ProjectionFree.lean create mode 100644 Ix/Compiler/IxIR0/ProjectionSafe.lean create mode 100644 Ix/Compiler/IxIR0/Readdress.lean create mode 100644 Ix/Compiler/IxIR0/ReaddressOracle.lean create mode 100644 Ix/Compiler/IxIR0/ReaddressOracleExamples.lean create mode 100644 Ix/Compiler/IxIR0/ReaddressProjectionSafe.lean create mode 100644 Ix/Compiler/IxIR0/ReaddressSim.lean create mode 100644 Ix/Compiler/IxIR0/Recursion.lean create mode 100644 Ix/Compiler/IxIR0/RecursionSim.lean create mode 100644 Ix/Compiler/IxIR0/RecursorModes.lean create mode 100644 Ix/Compiler/IxIR0/Serialize.lean create mode 100644 Ix/Compiler/IxIR0/UniqueReverse.lean create mode 100644 Ix/Compiler/IxIR0/UniqueReverseSim.lean create mode 100644 Ix/Compiler/IxIR1/Basic.lean create mode 100644 Ix/Compiler/IxIR1/CostInstance.lean create mode 100644 Ix/Compiler/IxIR1/CostModel.lean create mode 100644 Ix/Compiler/IxIR1/CostTrace.lean create mode 100644 Ix/Compiler/IxIR1/Decode.lean create mode 100644 Ix/Compiler/IxIR1/Eval.lean create mode 100644 Ix/Compiler/IxIR1/EvalHistory.lean create mode 100644 Ix/Compiler/IxIR1/EvalIso.lean create mode 100644 Ix/Compiler/IxIR1/EvalRewrite.lean create mode 100644 Ix/Compiler/IxIR1/Examples.lean create mode 100644 Ix/Compiler/IxIR1/HPT.lean create mode 100644 Ix/Compiler/IxIR1/HPTCache.lean create mode 100644 Ix/Compiler/IxIR1/HPTCacheDirIO.lean create mode 100644 Ix/Compiler/IxIR1/HPTCacheIO.lean create mode 100644 Ix/Compiler/IxIR1/HPTCasePrune.lean create mode 100644 Ix/Compiler/IxIR1/HPTCasePruneProgram.lean create mode 100644 Ix/Compiler/IxIR1/HPTDestroy.lean create mode 100644 Ix/Compiler/IxIR1/HPTFetchForward.lean create mode 100644 Ix/Compiler/IxIR1/HPTPAPFuse.lean create mode 100644 Ix/Compiler/IxIR1/HPTPAPFuseProgram.lean create mode 100644 Ix/Compiler/IxIR1/HPTProduce.lean create mode 100644 Ix/Compiler/IxIR1/HPTSound.lean create mode 100644 Ix/Compiler/IxIR1/Lower.lean create mode 100644 Ix/Compiler/IxIR1/LowerAddressed.lean create mode 100644 Ix/Compiler/IxIR1/LowerAddressedSim.lean create mode 100644 Ix/Compiler/IxIR1/LowerFullyAddressed.lean create mode 100644 Ix/Compiler/IxIR1/LowerFullyAddressedSim.lean create mode 100644 Ix/Compiler/IxIR1/LowerMutualAddressedProgress.lean create mode 100644 Ix/Compiler/IxIR1/LowerMutualAddressedSim.lean create mode 100644 Ix/Compiler/IxIR1/LowerProgress.lean create mode 100644 Ix/Compiler/IxIR1/LowerSim.lean create mode 100644 Ix/Compiler/IxIR1/LowerStateBase.lean create mode 100644 Ix/Compiler/IxIR1/LowerStateSim.lean create mode 100644 Ix/Compiler/IxIR1/Mono.lean create mode 100644 Ix/Compiler/IxIR1/MutualBlock.lean create mode 100644 Ix/Compiler/IxIR1/NoReuse.lean create mode 100644 Ix/Compiler/IxIR1/NoReuseAddressed.lean create mode 100644 Ix/Compiler/IxIR1/Optimizer.lean create mode 100644 Ix/Compiler/IxIR1/OptimizerReclamation.lean create mode 100644 Ix/Compiler/IxIR1/Progress.lean create mode 100644 Ix/Compiler/IxIR1/RcPotential.lean create mode 100644 Ix/Compiler/IxIR1/Reachability.lean create mode 100644 Ix/Compiler/IxIR1/Readdress.lean create mode 100644 Ix/Compiler/IxIR1/ReaddressAll.lean create mode 100644 Ix/Compiler/IxIR1/ReaddressAllSim.lean create mode 100644 Ix/Compiler/IxIR1/ReaddressOwnership.lean create mode 100644 Ix/Compiler/IxIR1/ReaddressSim.lean create mode 100644 Ix/Compiler/IxIR1/Reclamation.lean create mode 100644 Ix/Compiler/IxIR1/Serialize.lean create mode 100644 Ix/Compiler/IxIR1/Sim.lean create mode 100644 Ix/Compiler/IxIR1/ThesisBench.lean create mode 100644 Ix/Compiler/IxIR1/WellModedGen.lean create mode 100644 Ix/Compiler/IxIR2/AllocationEvents.lean create mode 100644 Ix/Compiler/IxIR2/Basic.lean create mode 100644 Ix/Compiler/IxIR2/Borrow/Examples.lean create mode 100644 Ix/Compiler/IxIR2/Borrow/OpenCheck.lean create mode 100644 Ix/Compiler/IxIR2/Borrow/OpenControl.lean create mode 100644 Ix/Compiler/IxIR2/Borrow/OpenExamples.lean create mode 100644 Ix/Compiler/IxIR2/Borrow/OpenHeap.lean create mode 100644 Ix/Compiler/IxIR2/Borrow/OpenResources.lean create mode 100644 Ix/Compiler/IxIR2/Borrow/OpenShape.lean create mode 100644 Ix/Compiler/IxIR2/Borrow/OpenSim.lean create mode 100644 Ix/Compiler/IxIR2/Borrow/Replay.lean create mode 100644 Ix/Compiler/IxIR2/Borrow/Rewrite.lean create mode 100644 Ix/Compiler/IxIR2/CallEval.lean create mode 100644 Ix/Compiler/IxIR2/CallEvalFuel.lean create mode 100644 Ix/Compiler/IxIR2/CallResources.lean create mode 100644 Ix/Compiler/IxIR2/CallReuse.lean create mode 100644 Ix/Compiler/IxIR2/CallReuseApply.lean create mode 100644 Ix/Compiler/IxIR2/CallReuseBody.lean create mode 100644 Ix/Compiler/IxIR2/CallReuseCalls.lean create mode 100644 Ix/Compiler/IxIR2/CallReuseControl.lean create mode 100644 Ix/Compiler/IxIR2/CallReuseHeapShape.lean create mode 100644 Ix/Compiler/IxIR2/CallReuseInstructions.lean create mode 100644 Ix/Compiler/IxIR2/CallReuseMain.lean create mode 100644 Ix/Compiler/IxIR2/CallReuseOrder.lean create mode 100644 Ix/Compiler/IxIR2/CallReusePrefix.lean create mode 100644 Ix/Compiler/IxIR2/CallReusePrefixHeap.lean create mode 100644 Ix/Compiler/IxIR2/CallReusePrefixTrace.lean create mode 100644 Ix/Compiler/IxIR2/CallReuseProgress.lean create mode 100644 Ix/Compiler/IxIR2/CallReuseShape.lean create mode 100644 Ix/Compiler/IxIR2/CallReuseSimulation.lean create mode 100644 Ix/Compiler/IxIR2/CallReuseTerminators.lean create mode 100644 Ix/Compiler/IxIR2/CallReuseTransition.lean create mode 100644 Ix/Compiler/IxIR2/CostObservations.lean create mode 100644 Ix/Compiler/IxIR2/CostSteps.lean create mode 100644 Ix/Compiler/IxIR2/CreditApply.lean create mode 100644 Ix/Compiler/IxIR2/CreditControl.lean create mode 100644 Ix/Compiler/IxIR2/CreditExamples.lean create mode 100644 Ix/Compiler/IxIR2/CreditFree.lean create mode 100644 Ix/Compiler/IxIR2/CreditHeap.lean create mode 100644 Ix/Compiler/IxIR2/CreditHeapObservations.lean create mode 100644 Ix/Compiler/IxIR2/CreditInstructions.lean create mode 100644 Ix/Compiler/IxIR2/CreditPolicy.lean create mode 100644 Ix/Compiler/IxIR2/CreditReclamation.lean create mode 100644 Ix/Compiler/IxIR2/CreditRefinement.lean create mode 100644 Ix/Compiler/IxIR2/CreditRelation.lean create mode 100644 Ix/Compiler/IxIR2/CreditResources.lean create mode 100644 Ix/Compiler/IxIR2/CreditSimulation.lean create mode 100644 Ix/Compiler/IxIR2/CreditSteps.lean create mode 100644 Ix/Compiler/IxIR2/CreditTerminators.lean create mode 100644 Ix/Compiler/IxIR2/Eval.lean create mode 100644 Ix/Compiler/IxIR2/EvalCounter.lean create mode 100644 Ix/Compiler/IxIR2/EvalExamples.lean create mode 100644 Ix/Compiler/IxIR2/EvalFuel.lean create mode 100644 Ix/Compiler/IxIR2/HeapAccounting.lean create mode 100644 Ix/Compiler/IxIR2/Interpretation.lean create mode 100644 Ix/Compiler/IxIR2/Liveness.lean create mode 100644 Ix/Compiler/IxIR2/LivenessExamples.lean create mode 100644 Ix/Compiler/IxIR2/Lower.lean create mode 100644 Ix/Compiler/IxIR2/LowerExamples.lean create mode 100644 Ix/Compiler/IxIR2/LowerSim.lean create mode 100644 Ix/Compiler/IxIR2/Pipeline.lean create mode 100644 Ix/Compiler/IxIR2/PipelineAllocation.lean create mode 100644 Ix/Compiler/IxIR2/PipelineCallReuse.lean create mode 100644 Ix/Compiler/IxIR2/PipelineCosts.lean create mode 100644 Ix/Compiler/IxIR2/PipelineInvoke.lean create mode 100644 Ix/Compiler/IxIR2/PipelinePhysical.lean create mode 100644 Ix/Compiler/IxIR2/PipelineResources.lean create mode 100644 Ix/Compiler/IxIR2/PipelineSim.lean create mode 100644 Ix/Compiler/IxIR2/ReservationHeap.lean create mode 100644 Ix/Compiler/IxIR2/ReservationOwnership.lean create mode 100644 Ix/Compiler/IxIR2/ReservationSteps.lean create mode 100644 Ix/Compiler/IxIR2/Resources.lean create mode 100644 Ix/Compiler/IxIR2/Reuse.lean create mode 100644 Ix/Compiler/IxIR2/ReuseAllocation.lean create mode 100644 Ix/Compiler/IxIR2/ReuseCost.lean create mode 100644 Ix/Compiler/IxIR2/ReuseExamples.lean create mode 100644 Ix/Compiler/IxIR2/ReuseHeapMap.lean create mode 100644 Ix/Compiler/IxIR2/ReuseHeapMapOps.lean create mode 100644 Ix/Compiler/IxIR2/ReuseHeapMapResults.lean create mode 100644 Ix/Compiler/IxIR2/ReuseLiveSim.lean create mode 100644 Ix/Compiler/IxIR2/ReuseResources.lean create mode 100644 Ix/Compiler/IxIR2/ReuseSim.lean create mode 100644 Ix/Compiler/IxIR2/ReuseSimExamples.lean create mode 100644 Ix/Compiler/IxIR2/SourcePipelineSim.lean create mode 100644 Ix/Compiler/IxIR2/UniqueLower.lean create mode 100644 Ix/Compiler/IxIR2/Validate.lean create mode 100644 Ix/Compiler/IxIR2/ValidateExamples.lean create mode 100644 Ix/Compiler/Ixon/Address.lean create mode 100644 Ix/Compiler/Ixon/Catalog.lean create mode 100644 Ix/Compiler/Ixon/CatalogIO.lean create mode 100644 Ix/Compiler/Ixon/Const.lean create mode 100644 Ix/Compiler/Ixon/DecodeCheck.lean create mode 100644 Ix/Compiler/Ixon/Eval.lean create mode 100644 Ix/Compiler/Ixon/Expr.lean create mode 100644 Ix/Compiler/Ixon/Hash.lean create mode 100644 Ix/Compiler/Ixon/Merkle.lean create mode 100644 Ix/Compiler/Ixon/RecursorUsage.lean create mode 100644 Ix/Compiler/Ixon/Serialize.lean create mode 100644 Ix/Compiler/Ixon/Sharing.lean create mode 100644 Ix/Compiler/Ixon/Sharing/Basic.lean create mode 100644 Ix/Compiler/Ixon/Sharing/Compress.lean create mode 100644 Ix/Compiler/Ixon/Sharing/Eval.lean create mode 100644 Ix/Compiler/Ixon/Univ.lean create mode 100644 Ix/Compiler/Ixon/UsageCheck.lean create mode 100644 Ix/Compiler/Ixon/Uses.lean create mode 100644 Ix/Compiler/Ixon/Work.lean create mode 100644 Ix/Compiler/LICENSE-APACHE create mode 100644 Ix/Compiler/LICENSE-MIT create mode 100644 Ix/Compiler/LoweredCompilation.lean create mode 100644 Ix/Compiler/LoweredCompilationSim.lean create mode 100644 Ix/Compiler/Pipeline.lean create mode 100644 Ix/Compiler/PipelineApply.lean create mode 100644 Ix/Compiler/PipelineErasure.lean create mode 100644 Ix/Compiler/PipelineSound.lean create mode 100644 Ix/Compiler/Recursion/Allocation.lean create mode 100644 Ix/Compiler/Recursion/Costs.lean create mode 100644 Ix/Compiler/Recursion/Observations.lean create mode 100644 Ix/Compiler/Recursion/PhysicalSim.lean create mode 100644 Ix/Compiler/Recursion/Pipeline.lean create mode 100644 Ix/Compiler/Recursion/Rejections.lean create mode 100644 Ix/Compiler/Recursion/Resources.lean create mode 100644 Ix/Compiler/Recursion/Sim.lean create mode 100644 Ix/Compiler/Recursion/Sources.lean create mode 100644 Ix/Compiler/Recursion/Trace.lean create mode 100644 Ix/Compiler/Sim.lean create mode 100644 Ix/Compiler/Sim/Segment.lean create mode 100644 Ix/Compiler/SimApply.lean create mode 100644 Ix/Compiler/SimInstance.lean create mode 100644 Ix/Compiler/Tools/BorrowCheck.lean create mode 100644 Ix/Compiler/Tools/BorrowExecution.lean create mode 100644 Ix/Compiler/Tools/BorrowRuntimeCheck.lean create mode 100644 Ix/Compiler/Tools/CapturedScalarNativeCheck.lean create mode 100644 Ix/Compiler/Tools/Check.lean create mode 100644 Ix/Compiler/Tools/PhysicalScalarNativeCheck.lean create mode 100644 Ix/Compiler/Tools/ScalarNativeCheck.lean create mode 100644 Ix/Compiler/Tools/SourceScan.lean create mode 100644 Ix/Compiler/Tools/TrustLedger.lean create mode 100644 Ix/Compiler/Tools/TrustProfile.lean create mode 100644 Ix/Compiler/Tools/UniqueCheck.lean create mode 100644 Ix/Compiler/Tools/UpstreamNativeCheck.lean create mode 100644 Ix/Compiler/Tools/X86Check.lean create mode 100644 Ix/Compiler/UniqueReuse/Heap.lean create mode 100644 Ix/Compiler/UniqueReuse/Lower.lean create mode 100644 Ix/Compiler/UniqueReuse/LowerSim.lean create mode 100644 Ix/Compiler/UniqueReuse/ModeCheck.lean create mode 100644 Ix/Compiler/UniqueReuse/Native.lean create mode 100644 Ix/Compiler/UniqueReuse/NativeObject.lean create mode 100644 Ix/Compiler/UniqueReuse/NativeObservations.lean create mode 100644 Ix/Compiler/UniqueReuse/NativeSim.lean create mode 100644 Ix/Compiler/UniqueReuse/Observations.lean create mode 100644 Ix/Compiler/UniqueReuse/Pipeline.lean create mode 100644 Ix/Compiler/UniqueReuse/PipelineSim.lean create mode 100644 Ix/Compiler/UniqueReuse/Provenance.lean create mode 100644 Ix/Compiler/UniqueReuse/Reclamation.lean create mode 100644 Ix/Compiler/UniqueReuse/Rejections.lean create mode 100644 Ix/Compiler/UniqueReuse/Runtime.lean create mode 100644 Ix/Compiler/UniqueReuse/RuntimeNative.lean create mode 100644 Ix/Compiler/UniqueReuse/RuntimeNativeSim.lean create mode 100644 Ix/Compiler/UniqueReuse/RuntimeObjectSim.lean create mode 100644 Ix/Compiler/UniqueReuse/RuntimeObservations.lean create mode 100644 Ix/Compiler/UniqueReuse/RuntimeSource.lean create mode 100644 Ix/Compiler/UniqueReuse/RuntimeSourceSim.lean create mode 100644 Ix/Compiler/UniqueReuse/RuntimeTarget.lean create mode 100644 Ix/Compiler/UniqueReuse/SourceSim.lean create mode 100644 Ix/Compiler/UniqueReuse/Sources.lean create mode 100644 Ix/Compiler/UniqueReuse/TargetHeap.lean create mode 100644 Ix/Compiler/UniqueReuse/TargetInput.lean create mode 100644 Ix/Compiler/UniqueReuse/TargetLoop.lean create mode 100644 Ix/Compiler/UniqueReuse/TargetMain.lean create mode 100644 Ix/Compiler/UniqueReuse/TargetResources.lean create mode 100644 Ix/Compiler/UniqueReuse/TargetSim.lean create mode 100644 Ix/Compiler/UniqueReuse/TargetSteps.lean create mode 100644 Ix/Compiler/UsageSound.lean create mode 100644 Ix/Compiler/X86/Basic.lean create mode 100644 Ix/Compiler/X86/ByteBranch.lean create mode 100644 Ix/Compiler/X86/ByteCall.lean create mode 100644 Ix/Compiler/X86/ByteControl.lean create mode 100644 Ix/Compiler/X86/ByteEval.lean create mode 100644 Ix/Compiler/X86/ByteExamples.lean create mode 100644 Ix/Compiler/X86/ByteFlags.lean create mode 100644 Ix/Compiler/X86/Decode.lean create mode 100644 Ix/Compiler/X86/ELF.lean create mode 100644 Ix/Compiler/X86/ELFExamples.lean create mode 100644 Ix/Compiler/X86/ELFLink.lean create mode 100644 Ix/Compiler/X86/ELFRead.lean create mode 100644 Ix/Compiler/X86/ELFValidate.lean create mode 100644 Ix/Compiler/X86/Encode.lean create mode 100644 Ix/Compiler/X86/EncodeBytes.lean create mode 100644 Ix/Compiler/X86/EncodeControl.lean create mode 100644 Ix/Compiler/X86/EncodeExamples.lean create mode 100644 Ix/Compiler/X86/EncodeExecution.lean create mode 100644 Ix/Compiler/X86/EncodeFields.lean create mode 100644 Ix/Compiler/X86/EncodeForms.lean create mode 100644 Ix/Compiler/X86/EncodeLength.lean create mode 100644 Ix/Compiler/X86/EncodeMemory.lean create mode 100644 Ix/Compiler/X86/EncodePatch.lean create mode 100644 Ix/Compiler/X86/EncodeRegisters.lean create mode 100644 Ix/Compiler/X86/EncodeWord.lean create mode 100644 Ix/Compiler/X86/Eval.lean create mode 100644 Ix/Compiler/X86/EvalExamples.lean create mode 100644 Ix/Compiler/X86/ExactNat.lean create mode 100644 Ix/Compiler/X86/Execution.lean create mode 100644 Ix/Compiler/X86/FrameCalls.lean create mode 100644 Ix/Compiler/X86/FrameExecution.lean create mode 100644 Ix/Compiler/X86/Memory.lean create mode 100644 Ix/Compiler/X86/NatCalls.lean create mode 100644 Ix/Compiler/X86/NatCallsCapture.lean create mode 100644 Ix/Compiler/X86/NatCallsCheck.lean create mode 100644 Ix/Compiler/X86/NatCallsExamples.lean create mode 100644 Ix/Compiler/X86/NatCallsSim.lean create mode 100644 Ix/Compiler/X86/NatCallsSyntax.lean create mode 100644 Ix/Compiler/X86/ObjectExecution.lean create mode 100644 Ix/Compiler/X86/PhysicalScalar.lean create mode 100644 Ix/Compiler/X86/PhysicalScalarCapturedExport.lean create mode 100644 Ix/Compiler/X86/PhysicalScalarCapturedHeap.lean create mode 100644 Ix/Compiler/X86/PhysicalScalarCapturedInit.lean create mode 100644 Ix/Compiler/X86/PhysicalScalarCapturedSourceApply.lean create mode 100644 Ix/Compiler/X86/PhysicalScalarCapturedSourceObject.lean create mode 100644 Ix/Compiler/X86/PhysicalScalarContracts.lean create mode 100644 Ix/Compiler/X86/PhysicalScalarControl.lean create mode 100644 Ix/Compiler/X86/PhysicalScalarExamples.lean create mode 100644 Ix/Compiler/X86/PhysicalScalarExport.lean create mode 100644 Ix/Compiler/X86/PhysicalScalarObject.lean create mode 100644 Ix/Compiler/X86/PhysicalScalarSelect.lean create mode 100644 Ix/Compiler/X86/PhysicalScalarSim.lean create mode 100644 Ix/Compiler/X86/PhysicalScalarSourceApply.lean create mode 100644 Ix/Compiler/X86/PhysicalScalarSourceHeap.lean create mode 100644 Ix/Compiler/X86/PhysicalScalarSourceObject.lean create mode 100644 Ix/Compiler/X86/PhysicalScalarSources.lean create mode 100644 Ix/Compiler/X86/PhysicalScalarValues.lean create mode 100644 Ix/Compiler/X86/PipelineSim.lean create mode 100644 Ix/Compiler/X86/RuntimeExecution.lean create mode 100644 Ix/Compiler/X86/RuntimeGuards.lean create mode 100644 Ix/Compiler/X86/RuntimeHeader.lean create mode 100644 Ix/Compiler/X86/RuntimeInput.lean create mode 100644 Ix/Compiler/X86/RuntimeInspect.lean create mode 100644 Ix/Compiler/X86/RuntimeReject.lean create mode 100644 Ix/Compiler/X86/RuntimeScan.lean create mode 100644 Ix/Compiler/X86/RuntimeTarget.lean create mode 100644 Ix/Compiler/X86/SafeControl.lean create mode 100644 Ix/Compiler/X86/SafeSteps.lean create mode 100644 Ix/Compiler/X86/SafeStepsObject.lean create mode 100644 Ix/Compiler/X86/Scalar.lean create mode 100644 Ix/Compiler/X86/ScalarApply.lean create mode 100644 Ix/Compiler/X86/ScalarArguments.lean create mode 100644 Ix/Compiler/X86/ScalarBind.lean create mode 100644 Ix/Compiler/X86/ScalarCalls.lean create mode 100644 Ix/Compiler/X86/ScalarCapacity.lean create mode 100644 Ix/Compiler/X86/ScalarComposition.lean create mode 100644 Ix/Compiler/X86/ScalarContracts.lean create mode 100644 Ix/Compiler/X86/ScalarFrames.lean create mode 100644 Ix/Compiler/X86/ScalarFunctions.lean create mode 100644 Ix/Compiler/X86/ScalarInstructions.lean create mode 100644 Ix/Compiler/X86/ScalarNat.lean create mode 100644 Ix/Compiler/X86/ScalarObject.lean create mode 100644 Ix/Compiler/X86/ScalarPrimitives.lean create mode 100644 Ix/Compiler/X86/ScalarSafeFrames.lean create mode 100644 Ix/Compiler/X86/ScalarSafety.lean create mode 100644 Ix/Compiler/X86/ScalarSimulation.lean create mode 100644 Ix/Compiler/X86/ScalarSourceApply.lean create mode 100644 Ix/Compiler/X86/ScalarSourceObject.lean create mode 100644 Ix/Compiler/X86/ScalarSourceSelect.lean create mode 100644 Ix/Compiler/X86/ScalarSourceSim.lean create mode 100644 Ix/Compiler/X86/ScalarSourceSyntax.lean create mode 100644 Ix/Compiler/X86/ScalarSources.lean create mode 100644 Ix/Compiler/X86/ScalarStack.lean create mode 100644 Ix/Compiler/X86/ScalarTarget.lean create mode 100644 Ix/Compiler/X86/ScalarTotal.lean create mode 100644 Ix/Compiler/X86/Select.lean create mode 100644 Ix/Compiler/X86/SelectExamples.lean create mode 100644 Ix/Compiler/X86/StreamCalls.lean create mode 100644 Ix/Compiler/X86/StreamControl.lean create mode 100644 Ix/Compiler/X86/StreamDecidable.lean create mode 100644 Ix/Compiler/X86/StreamEffects.lean create mode 100644 Ix/Compiler/X86/StreamExamples.lean create mode 100644 Ix/Compiler/X86/StreamLayout.lean create mode 100644 Ix/Compiler/X86/StreamLinear.lean create mode 100644 Ix/Compiler/X86/StreamMemory.lean create mode 100644 Ix/Compiler/X86/StreamPermissions.lean create mode 100644 Ix/Compiler/X86/StreamRun.lean create mode 100644 Ix/Compiler/X86/StreamTrace.lean create mode 100644 Ix/Compiler/X86/StreamValidate.lean create mode 100644 Ix/Compiler/X86/UniqueABI.lean create mode 100644 Ix/Compiler/X86/UniqueControl.lean create mode 100644 Ix/Compiler/X86/UniqueCounterFold.lean create mode 100644 Ix/Compiler/X86/UniqueExecution.lean create mode 100644 Ix/Compiler/X86/UniqueHeap.lean create mode 100644 Ix/Compiler/X86/UniqueInvariant.lean create mode 100644 Ix/Compiler/X86/UniqueLoop.lean create mode 100644 Ix/Compiler/X86/UniqueMacros.lean create mode 100644 Ix/Compiler/X86/UniqueMain.lean create mode 100644 Ix/Compiler/X86/UniqueRelease.lean create mode 100644 Ix/Compiler/X86/UniqueResult.lean create mode 100644 Ix/Compiler/X86/UniqueTarget.lean create mode 100644 Ix/Compiler/X86/ValidatedScalar.lean create mode 100644 Ix/Compiler/X86/WordRegion.lean create mode 100644 Ix/Compiler/X86/WordRegionExecution.lean create mode 100644 Ix/Compiler/X86/WordRegionSafeCalls.lean create mode 100644 Ix/Compiler/X86/WordRegionSafeControl.lean create mode 100644 Ix/Compiler/X86/WordRegionSafeMacros.lean create mode 100644 Ix/Compiler/X86/WordRegionSafeTrace.lean create mode 100644 Ix/IxVM/Certified/Accept.lean create mode 100644 Ix/IxVM/Certified/Checker.lean create mode 100644 Ix/IxVM/Certified/Expr.lean create mode 100644 Ix/IxVM/Certified/Levels.lean create mode 100644 Ix/IxVM/Certified/Read.lean create mode 100644 Ix/IxVM/Certified/Types.lean create mode 100644 Ix/Kernel.lean rename Ix/{Tc => Kernel}/CanonicalCheck.lean (99%) create mode 100644 Ix/Kernel/Certified.lean create mode 100644 Ix/Kernel/CertifiedClaims.lean rename Ix/{Tc => Kernel}/Check.lean (99%) rename Ix/{Tc => Kernel}/Const.lean (98%) rename Ix/{Tc => Kernel}/DefEq.lean (99%) rename Ix/{Tc => Kernel}/Driver.lean (97%) rename Ix/{Tc => Kernel}/Egress.lean (99%) rename Ix/{Tc => Kernel}/EgressLean.lean (99%) rename Ix/{Tc => Kernel}/Env.lean (98%) rename Ix/{Tc => Kernel}/Equiv.lean (99%) rename Ix/{Tc => Kernel}/Error.lean (98%) rename Ix/{Tc => Kernel}/Expr.lean (99%) rename Ix/{Tc => Kernel}/Id.lean (97%) rename Ix/{Tc => Kernel}/Inductive.lean (99%) rename Ix/{Tc => Kernel}/Infer.lean (97%) rename Ix/{Tc => Kernel}/Ingress.lean (99%) rename Ix/{Tc => Kernel}/IngressMeta.lean (99%) rename Ix/{Tc => Kernel}/Knot.lean (94%) rename Ix/{Tc => Kernel}/Lctx.lean (98%) rename Ix/{Tc => Kernel}/Level.lean (97%) rename Ix/{Tc => Kernel}/Mode.lean (98%) rename Ix/{Tc => Kernel}/Monad.lean (98%) rename Ix/{Tc => Kernel}/ParCheck.lean (98%) rename Ix/{Tc => Kernel}/Primitive.lean (99%) rename Ix/{Tc => Kernel}/Subst.lean (99%) rename Ix/{Tc => Kernel}/Validate.lean (98%) rename Ix/{Tc => Kernel}/Verify/Audit/Basic.lean (64%) rename Ix/{Tc => Kernel}/Verify/Audit/Completed.lean (59%) rename Ix/{Tc => Kernel}/Verify/Audit/Conditional.lean (51%) rename Ix/{Tc => Kernel}/Verify/Audit/SorryFrontier.lean (66%) rename Ix/{Tc => Kernel}/Verify/Audit/Statements.lean (50%) rename Ix/{Tc => Kernel}/Verify/Cache.lean (99%) rename Ix/{Tc => Kernel}/Verify/Check/Acceptance.lean (96%) rename Ix/{Tc => Kernel}/Verify/Check/BinderRoundTrip.lean (95%) rename Ix/{Tc => Kernel}/Verify/Check/BlockAcceptance.lean (96%) rename Ix/{Tc => Kernel}/Verify/Check/BlockCache.lean (98%) rename Ix/{Tc => Kernel}/Verify/Check/BlockClassification.lean (99%) rename Ix/{Tc => Kernel}/Verify/Check/BlockDefinition.lean (94%) rename Ix/{Tc => Kernel}/Verify/Check/BlockExecution.lean (99%) rename Ix/{Tc => Kernel}/Verify/Check/BlockIdentity.lean (99%) rename Ix/{Tc => Kernel}/Verify/Check/BlockNatFixture.lean (97%) rename Ix/{Tc => Kernel}/Verify/Check/BlockOracle.lean (95%) rename Ix/{Tc => Kernel}/Verify/Check/BlockRouteFrame.lean (98%) rename Ix/{Tc => Kernel}/Verify/Check/BlockRouting.lean (99%) rename Ix/{Tc => Kernel}/Verify/Check/BlockTransaction.lean (98%) rename Ix/{Tc => Kernel}/Verify/Check/BoundedPipelines.lean (96%) rename Ix/{Tc => Kernel}/Verify/Check/CheckConstExecution.lean (95%) rename Ix/{Tc => Kernel}/Verify/Check/CheckConstTransaction.lean (98%) rename Ix/{Tc => Kernel}/Verify/Check/CheckerEvidence.lean (95%) rename Ix/{Tc => Kernel}/Verify/Check/DeclarationIngress.lean (95%) rename Ix/{Tc => Kernel}/Verify/Check/DeclarationValidation.lean (96%) rename Ix/{Tc => Kernel}/Verify/Check/DefEqBasicPolicy.lean (99%) rename Ix/{Tc => Kernel}/Verify/Check/DefEqCachePolicy.lean (99%) rename Ix/{Tc => Kernel}/Verify/Check/DefEqEtaPolicy.lean (99%) rename Ix/{Tc => Kernel}/Verify/Check/DefEqFinalWhnfPolicy.lean (99%) rename Ix/{Tc => Kernel}/Verify/Check/DefEqLazyDeltaPolicy.lean (99%) rename Ix/{Tc => Kernel}/Verify/Check/DefEqNatPolicy.lean (98%) rename Ix/{Tc => Kernel}/Verify/Check/DefEqPipelinePolicy.lean (99%) rename Ix/{Tc => Kernel}/Verify/Check/DefEqProjectionDeltaPolicy.lean (99%) rename Ix/{Tc => Kernel}/Verify/Check/DefEqPropositionPolicy.lean (98%) rename Ix/{Tc => Kernel}/Verify/Check/FullInference.lean (95%) rename Ix/{Tc => Kernel}/Verify/Check/FullInferenceApplications.lean (98%) rename Ix/{Tc => Kernel}/Verify/Check/FullInferenceBinders.lean (98%) rename Ix/{Tc => Kernel}/Verify/Check/FullInferenceCache.lean (96%) rename Ix/{Tc => Kernel}/Verify/Check/FullInferenceDispatcher.lean (96%) rename Ix/{Tc => Kernel}/Verify/Check/FullInferenceKnot.lean (94%) rename Ix/{Tc => Kernel}/Verify/Check/FullInferenceLeaves.lean (95%) rename Ix/{Tc => Kernel}/Verify/Check/FullInferenceProjections.lean (96%) rename Ix/{Tc => Kernel}/Verify/Check/InferencePolicy.lean (98%) rename Ix/{Tc => Kernel}/Verify/Check/MemberEvidence.lean (98%) rename Ix/{Tc => Kernel}/Verify/Check/NatAcceptance.lean (97%) rename Ix/{Tc => Kernel}/Verify/Check/PositiveFuelSort.lean (94%) rename Ix/{Tc => Kernel}/Verify/Check/PreTranslation.lean (96%) rename Ix/{Tc => Kernel}/Verify/Check/PreTranslationCompatibility.lean (95%) rename Ix/{Tc => Kernel}/Verify/Check/PreTranslationIngress.lean (97%) rename Ix/{Tc => Kernel}/Verify/Check/PreTranslationOpening.lean (97%) rename Ix/{Tc => Kernel}/Verify/Check/PreTranslationScopes.lean (97%) rename Ix/{Tc => Kernel}/Verify/Check/ProjectionInferencePolicy.lean (99%) rename Ix/{Tc => Kernel}/Verify/Check/PublicBlocks.lean (80%) rename Ix/{Tc => Kernel}/Verify/Check/PublicStandalone.lean (91%) rename Ix/{Tc => Kernel}/Verify/Check/QuotientAdmission.lean (88%) rename Ix/{Tc => Kernel}/Verify/Check/QuotientBoundary.lean (95%) rename Ix/{Tc => Kernel}/Verify/Check/QuotientBridge.lean (94%) rename Ix/{Tc => Kernel}/Verify/Check/RecursiveMethodPolicy.lean (97%) rename Ix/{Tc => Kernel}/Verify/Check/ResetFrame.lean (97%) rename Ix/{Tc => Kernel}/Verify/Check/SafetyFrame.lean (98%) rename Ix/{Tc => Kernel}/Verify/Check/Scoped.lean (89%) rename Ix/{Tc => Kernel}/Verify/Check/ScopedActiveBlock.lean (98%) rename Ix/{Tc => Kernel}/Verify/Check/ScopedBoundedPipelines.lean (96%) rename Ix/{Tc => Kernel}/Verify/Check/ScopedMemberEvidence.lean (98%) rename Ix/{Tc => Kernel}/Verify/Check/ScopedPositiveFuelAxiom.lean (96%) rename Ix/{Tc => Kernel}/Verify/Check/ScopedPositiveFuelCertificate.lean (98%) rename Ix/{Tc => Kernel}/Verify/Check/ScopedStandaloneDriver.lean (98%) rename Ix/{Tc => Kernel}/Verify/Check/SingletonInductive.lean (92%) rename Ix/{Tc => Kernel}/Verify/Check/StandaloneDriver.lean (98%) rename Ix/{Tc => Kernel}/Verify/Check/UncachedInferencePolicy.lean (98%) rename Ix/{Tc => Kernel}/Verify/Check/UniverseInstantiationPolicy.lean (99%) rename Ix/{Tc => Kernel}/Verify/Check/ValidationReach.lean (99%) rename Ix/{Tc => Kernel}/Verify/Check/ValidatorFrame.lean (99%) rename Ix/{Tc => Kernel}/Verify/Check/ValidatorSoundness.lean (99%) rename Ix/{Tc => Kernel}/Verify/Check/WhnfBasicHelperPolicy.lean (99%) rename Ix/{Tc => Kernel}/Verify/Check/WhnfBitVecPolicy.lean (99%) rename Ix/{Tc => Kernel}/Verify/Check/WhnfDecidablePolicy.lean (99%) rename Ix/{Tc => Kernel}/Verify/Check/WhnfDriverPolicy.lean (99%) rename Ix/{Tc => Kernel}/Verify/Check/WhnfHelperPolicy.lean (95%) rename Ix/{Tc => Kernel}/Verify/Check/WhnfIotaBasePolicy.lean (99%) rename Ix/{Tc => Kernel}/Verify/Check/WhnfIotaDispatchPolicy.lean (99%) rename Ix/{Tc => Kernel}/Verify/Check/WhnfIotaRecursionPolicy.lean (99%) rename Ix/{Tc => Kernel}/Verify/Check/WhnfIotaScopePolicy.lean (98%) rename Ix/{Tc => Kernel}/Verify/Check/WhnfIotaSynthesisPolicy.lean (99%) rename Ix/{Tc => Kernel}/Verify/Check/WhnfNatArgumentPolicy.lean (98%) rename Ix/{Tc => Kernel}/Verify/Check/WhnfNatPolicy.lean (99%) rename Ix/{Tc => Kernel}/Verify/Check/WhnfNativePolicy.lean (98%) rename Ix/{Tc => Kernel}/Verify/Check/WhnfProjectionPolicy.lean (99%) rename Ix/{Tc => Kernel}/Verify/Check/WhnfReductionPolicy.lean (99%) create mode 100644 Ix/Kernel/Verify/Consistency.lean create mode 100644 Ix/Kernel/Verify/Consistency/Audit.lean create mode 100644 Ix/Kernel/Verify/Consistency/Expr.lean create mode 100644 Ix/Kernel/Verify/Consistency/Infer.lean create mode 100644 Ix/Kernel/Verify/Consistency/Judgment.lean create mode 100644 Ix/Kernel/Verify/Consistency/Level.lean rename Ix/{Tc => Kernel}/Verify/Ctx.lean (96%) rename Ix/{Tc => Kernel}/Verify/Decl.lean (95%) rename Ix/{Tc => Kernel}/Verify/DefEq.lean (99%) rename Ix/{Tc => Kernel}/Verify/DefEq/AcceleratorGates.lean (97%) rename Ix/{Tc => Kernel}/Verify/DefEq/ApplicationSpine.lean (98%) rename Ix/{Tc => Kernel}/Verify/DefEq/BoolTrue.lean (99%) rename Ix/{Tc => Kernel}/Verify/DefEq/CacheBranches.lean (98%) rename Ix/{Tc => Kernel}/Verify/DefEq/CacheShell.lean (98%) rename Ix/{Tc => Kernel}/Verify/DefEq/CheapReduction.lean (98%) rename Ix/{Tc => Kernel}/Verify/DefEq/Closure.lean (97%) rename Ix/{Tc => Kernel}/Verify/DefEq/DeltaClassification.lean (96%) rename Ix/{Tc => Kernel}/Verify/DefEq/EqualRankCache.lean (98%) rename Ix/{Tc => Kernel}/Verify/DefEq/EqualRankPrefix.lean (97%) rename Ix/{Tc => Kernel}/Verify/DefEq/EqualRankReduction.lean (98%) rename Ix/{Tc => Kernel}/Verify/DefEq/FinalWhnf/Application.lean (97%) rename Ix/{Tc => Kernel}/Verify/DefEq/FinalWhnf/Closure.lean (91%) rename Ix/{Tc => Kernel}/Verify/DefEq/FinalWhnf/Contracts.lean (98%) rename Ix/{Tc => Kernel}/Verify/DefEq/FinalWhnf/EtaExpansion.lean (98%) rename Ix/{Tc => Kernel}/Verify/DefEq/FinalWhnf/LetDeclaration.lean (99%) rename Ix/{Tc => Kernel}/Verify/DefEq/FinalWhnf/NatBridge.lean (97%) rename Ix/{Tc => Kernel}/Verify/DefEq/FinalWhnf/ProofTail.lean (97%) rename Ix/{Tc => Kernel}/Verify/DefEq/FinalWhnf/StringExpansion.lean (97%) rename Ix/{Tc => Kernel}/Verify/DefEq/FinalWhnf/StructuralPrefix.lean (95%) rename Ix/{Tc => Kernel}/Verify/DefEq/FinalWhnf/StructureEta.lean (98%) rename Ix/{Tc => Kernel}/Verify/DefEq/FinalWhnf/StructureEtaBase.lean (98%) rename Ix/{Tc => Kernel}/Verify/DefEq/FinalWhnf/StructureEtaFields.lean (97%) rename Ix/{Tc => Kernel}/Verify/DefEq/FinalWhnf/StructureEtaTail.lean (97%) rename Ix/{Tc => Kernel}/Verify/DefEq/FinalWhnf/UnitLike.lean (96%) rename Ix/{Tc => Kernel}/Verify/DefEq/LazyDelta.lean (99%) rename Ix/{Tc => Kernel}/Verify/DefEq/LazyDeltaClosure.lean (93%) rename Ix/{Tc => Kernel}/Verify/DefEq/LazyDeltaIteration.lean (97%) rename Ix/{Tc => Kernel}/Verify/DefEq/LoopFinish.lean (95%) rename Ix/{Tc => Kernel}/Verify/DefEq/NatOffset.lean (96%) rename Ix/{Tc => Kernel}/Verify/DefEq/NatOffsetDecomposition.lean (98%) rename Ix/{Tc => Kernel}/Verify/DefEq/NatReduction.lean (98%) rename Ix/{Tc => Kernel}/Verify/DefEq/OneSidedDelta.lean (98%) rename Ix/{Tc => Kernel}/Verify/DefEq/ProjectionDeltaActive.lean (98%) rename Ix/{Tc => Kernel}/Verify/DefEq/ProjectionDeltaClosure.lean (97%) rename Ix/{Tc => Kernel}/Verify/DefEq/ProjectionDeltaEqualRank.lean (98%) rename Ix/{Tc => Kernel}/Verify/DefEq/ProjectionDeltaFinish.lean (96%) rename Ix/{Tc => Kernel}/Verify/DefEq/ProjectionDeltaLoop.lean (98%) rename Ix/{Tc => Kernel}/Verify/DefEq/ProjectionDeltaRank.lean (95%) rename Ix/{Tc => Kernel}/Verify/DefEq/ProjectionDeltaStep.lean (96%) rename Ix/{Tc => Kernel}/Verify/DefEq/ProjectionDeltaUnfolding.lean (97%) rename Ix/{Tc => Kernel}/Verify/DefEq/ProjectionProbe.lean (98%) rename Ix/{Tc => Kernel}/Verify/DefEq/ProjectionReduction.lean (96%) rename Ix/{Tc => Kernel}/Verify/DefEq/ProofIrrelevance.lean (97%) rename Ix/{Tc => Kernel}/Verify/DefEq/PropositionClassifier.lean (98%) rename Ix/{Tc => Kernel}/Verify/DefEq/RankDispatch.lean (98%) rename Ix/{Tc => Kernel}/Verify/DefEq/SameHeadSpine.lean (98%) rename Ix/{Tc => Kernel}/Verify/DefEq/SpineArguments.lean (97%) rename Ix/{Tc => Kernel}/Verify/DefEq/StoppedContinuation.lean (98%) rename Ix/{Tc => Kernel}/Verify/DefEq/StoppedContinuationClosure.lean (94%) rename Ix/{Tc => Kernel}/Verify/DefEq/StringLiteral.lean (98%) rename Ix/{Tc => Kernel}/Verify/DefEq/Structural.lean (97%) rename Ix/{Tc => Kernel}/Verify/DefEq/StructuralCongruence.lean (97%) rename Ix/{Tc => Kernel}/Verify/Driver/BooleanAcceptance.lean (99%) rename Ix/{Tc => Kernel}/Verify/Driver/Dependencies.lean (99%) rename Ix/{Tc => Kernel}/Verify/Driver/Enumeration.lean (99%) rename Ix/{Tc => Kernel}/Verify/Driver/Fixtures.lean (98%) rename Ix/{Tc => Kernel}/Verify/Driver/Model.lean (99%) rename Ix/{Tc => Kernel}/Verify/Driver/Serial.lean (99%) rename Ix/{Tc => Kernel}/Verify/Driver/SupportedAcceptance.lean (96%) rename Ix/{Tc => Kernel}/Verify/Driver/SupportedAcceptanceFixtures.lean (95%) rename Ix/{Tc => Kernel}/Verify/Env.lean (98%) rename Ix/{Tc => Kernel}/Verify/EquivalenceManager.lean (99%) rename Ix/{Tc => Kernel}/Verify/Execution.lean (99%) rename Ix/{Tc => Kernel}/Verify/Expr.lean (99%) rename Ix/{Tc => Kernel}/Verify/Frame.lean (98%) rename Ix/{Tc/Verify/Upstream => Kernel/Verify/Frontier}/Pending.lean (69%) rename Ix/{Tc => Kernel}/Verify/Inductive.lean (94%) rename Ix/{Tc => Kernel}/Verify/Inductive/AliasFormerAdmission.lean (98%) rename Ix/{Tc => Kernel}/Verify/Inductive/AliasFormerCertificate.lean (91%) rename Ix/{Tc => Kernel}/Verify/Inductive/AliasFormerFixture.lean (98%) rename Ix/{Tc => Kernel}/Verify/Inductive/AliasFormerPattern.lean (90%) rename Ix/{Tc => Kernel}/Verify/Inductive/AliasFormerRecursorFixture.lean (99%) rename Ix/{Tc => Kernel}/Verify/Inductive/AliasRecAdmission.lean (98%) rename Ix/{Tc => Kernel}/Verify/Inductive/AliasRecCertificate.lean (91%) rename Ix/{Tc => Kernel}/Verify/Inductive/AliasRecFixture.lean (98%) rename Ix/{Tc => Kernel}/Verify/Inductive/AliasRecPattern.lean (96%) rename Ix/{Tc => Kernel}/Verify/Inductive/AliasRecRecursorFixture.lean (99%) rename Ix/{Tc => Kernel}/Verify/Inductive/AliasRecSoundness.lean (95%) rename Ix/{Tc => Kernel}/Verify/Inductive/AnnotatedPiAdmission.lean (98%) rename Ix/{Tc => Kernel}/Verify/Inductive/AnnotatedPiCertificate.lean (91%) rename Ix/{Tc => Kernel}/Verify/Inductive/AnnotatedPiFixture.lean (98%) rename Ix/{Tc => Kernel}/Verify/Inductive/AnnotatedPiPattern.lean (96%) rename Ix/{Tc => Kernel}/Verify/Inductive/AnnotatedPiRecursorFixture.lean (99%) rename Ix/{Tc => Kernel}/Verify/Inductive/AnnotatedPiSoundness.lean (95%) rename Ix/{Tc => Kernel}/Verify/Inductive/BlockCertificate.lean (91%) rename Ix/{Tc => Kernel}/Verify/Inductive/BlockPatternSoundness.lean (90%) rename Ix/{Tc => Kernel}/Verify/Inductive/CandidateSyntax.lean (95%) rename Ix/{Tc => Kernel}/Verify/Inductive/Certificate.lean (94%) rename Ix/{Tc => Kernel}/Verify/Inductive/ConcreteFixture.lean (97%) rename Ix/{Tc => Kernel}/Verify/Inductive/ConstructorPositivityTraversal.lean (99%) rename Ix/{Tc => Kernel}/Verify/Inductive/ConstructorValidationTraversal.lean (99%) rename Ix/{Tc => Kernel}/Verify/Inductive/EliminationBreadthFixture.lean (97%) rename Ix/{Tc => Kernel}/Verify/Inductive/EnumerationAcceptance.lean (97%) rename Ix/{Tc => Kernel}/Verify/Inductive/EnumerationFixture.lean (99%) rename Ix/{Tc => Kernel}/Verify/Inductive/ExactLeanSyntax.lean (98%) rename Ix/{Tc => Kernel}/Verify/Inductive/GeneratedRecursorAcceptance.lean (98%) rename Ix/{Tc => Kernel}/Verify/Inductive/GeneratedRecursorAcceptanceClosure.lean (97%) rename Ix/{Tc => Kernel}/Verify/Inductive/GeneratedRecursorAdmission.lean (95%) rename Ix/{Tc => Kernel}/Verify/Inductive/GeneratedRecursorCheckerFixture.lean (97%) rename Ix/{Tc => Kernel}/Verify/Inductive/GeneratedRecursorCommitFixture.lean (97%) rename Ix/{Tc => Kernel}/Verify/Inductive/GeneratedRecursorComparison.lean (99%) rename Ix/{Tc => Kernel}/Verify/Inductive/GeneratedRecursorInitialInvariant.lean (97%) rename Ix/{Tc => Kernel}/Verify/Inductive/GeneratedRecursorMemberCheck.lean (99%) rename Ix/{Tc => Kernel}/Verify/Inductive/GeneratedRecursorMemberFixture.lean (99%) rename Ix/{Tc => Kernel}/Verify/Inductive/GeneratedRecursorMetadata.lean (99%) rename Ix/{Tc => Kernel}/Verify/Inductive/GeneratedRecursorRuleFixture.lean (94%) rename Ix/{Tc => Kernel}/Verify/Inductive/GeneratedRecursorSelection.lean (98%) rename Ix/{Tc => Kernel}/Verify/Inductive/GeneratedRecursorSemantics.lean (94%) rename Ix/{Tc => Kernel}/Verify/Inductive/GeneratedRecursorTypeClosure.lean (96%) rename Ix/{Tc => Kernel}/Verify/Inductive/GeneratedRecursorTypeFixture.lean (92%) rename Ix/{Tc => Kernel}/Verify/Inductive/IndexedBlockValidation.lean (98%) rename Ix/{Tc => Kernel}/Verify/Inductive/IndexedCandidateOperations.lean (97%) rename Ix/{Tc => Kernel}/Verify/Inductive/IndexedCandidateSyntax.lean (81%) rename Ix/{Tc => Kernel}/Verify/Inductive/IndexedCandidateTransaction.lean (78%) rename Ix/{Tc => Kernel}/Verify/Inductive/IndexedConstructorPositivity.lean (91%) rename Ix/{Tc => Kernel}/Verify/Inductive/IndexedConstructorValidation.lean (85%) rename Ix/{Tc => Kernel}/Verify/Inductive/IndexedPositivityTransport.lean (90%) rename Ix/{Tc => Kernel}/Verify/Inductive/IndexedProducerClosure.lean (84%) rename Ix/{Tc => Kernel}/Verify/Inductive/IndexedProductionPositivity.lean (99%) rename Ix/{Tc => Kernel}/Verify/Inductive/IndexedRecursiveAcceptance.lean (96%) rename Ix/{Tc => Kernel}/Verify/Inductive/IndexedRecursiveCertificate.lean (91%) rename Ix/{Tc => Kernel}/Verify/Inductive/IndexedRecursiveFixture.lean (99%) rename Ix/{Tc => Kernel}/Verify/Inductive/IndexedRecursiveOracle.lean (93%) rename Ix/{Tc => Kernel}/Verify/Inductive/IndexedRecursivePattern.lean (98%) rename Ix/{Tc => Kernel}/Verify/Inductive/IndexedRecursiveSoundness.lean (96%) rename Ix/{Tc => Kernel}/Verify/Inductive/IngressExecution.lean (99%) rename Ix/{Tc => Kernel}/Verify/Inductive/IotaPattern.lean (79%) rename Ix/{Tc => Kernel}/Verify/Inductive/MutualBlockCertificate.lean (85%) rename Ix/{Tc => Kernel}/Verify/Inductive/MutualBlockFixture.lean (97%) rename Ix/{Tc => Kernel}/Verify/Inductive/MutualBlockValidation.lean (97%) rename Ix/{Tc => Kernel}/Verify/Inductive/MutualFamily.lean (94%) rename Ix/{Tc => Kernel}/Verify/Inductive/MutualFamilyAdmission.lean (98%) rename Ix/{Tc => Kernel}/Verify/Inductive/MutualRecursor.lean (94%) rename Ix/{Tc => Kernel}/Verify/Inductive/MutualRecursorAdmission.lean (92%) rename Ix/{Tc => Kernel}/Verify/Inductive/NestedAdmission.lean (96%) rename Ix/{Tc => Kernel}/Verify/Inductive/NestedAuxiliaryExpansion.lean (99%) rename Ix/{Tc => Kernel}/Verify/Inductive/NestedAuxiliaryPositivity.lean (93%) rename Ix/{Tc => Kernel}/Verify/Inductive/NestedBlockCertificate.lean (95%) rename Ix/{Tc => Kernel}/Verify/Inductive/NestedCandidateSyntax.lean (85%) rename Ix/{Tc => Kernel}/Verify/Inductive/NestedConstructorValidation.lean (78%) rename Ix/{Tc => Kernel}/Verify/Inductive/NestedPositivityTransport.lean (84%) rename Ix/{Tc => Kernel}/Verify/Inductive/NestedPositivityTraversal.lean (99%) rename Ix/{Tc => Kernel}/Verify/Inductive/NestedRecursiveFixture.lean (98%) rename Ix/{Tc => Kernel}/Verify/Inductive/NestedRecursorAdmission.lean (98%) rename Ix/{Tc => Kernel}/Verify/Inductive/NestedRecursorFixture.lean (98%) rename Ix/{Tc => Kernel}/Verify/Inductive/NestedRecursorPattern.lean (99%) rename Ix/{Tc => Kernel}/Verify/Inductive/NestedRecursorSoundness.lean (95%) rename Ix/{Tc => Kernel}/Verify/Inductive/NestedSemanticTransaction.lean (97%) rename Ix/{Tc => Kernel}/Verify/Inductive/OccurrenceClosure.lean (97%) rename Ix/{Tc => Kernel}/Verify/Inductive/OccurrenceValidation.lean (98%) rename Ix/{Tc => Kernel}/Verify/Inductive/OneFamilyAdmission.lean (90%) rename Ix/{Tc => Kernel}/Verify/Inductive/PositivityTraceAdapter.lean (85%) rename Ix/{Tc => Kernel}/Verify/Inductive/PositivityTraversal.lean (99%) rename Ix/{Tc => Kernel}/Verify/Inductive/ProducedGenerationTransaction.lean (91%) rename Ix/{Tc => Kernel}/Verify/Inductive/RecursivePiAcceptance.lean (95%) rename Ix/{Tc => Kernel}/Verify/Inductive/RecursivePiAdmission.lean (98%) rename Ix/{Tc => Kernel}/Verify/Inductive/RecursivePiCertificate.lean (89%) rename Ix/{Tc => Kernel}/Verify/Inductive/RecursivePiFixture.lean (98%) rename Ix/{Tc => Kernel}/Verify/Inductive/RecursivePiPattern.lean (96%) rename Ix/{Tc => Kernel}/Verify/Inductive/RecursivePiRecursorFixture.lean (99%) rename Ix/{Tc => Kernel}/Verify/Inductive/RecursivePiSoundness.lean (94%) rename Ix/{Tc => Kernel}/Verify/Inductive/RecursivePositivityTraversal.lean (99%) rename Ix/{Tc => Kernel}/Verify/Inductive/ResultSortTelescope.lean (97%) rename Ix/{Tc => Kernel}/Verify/Inductive/RuleApplication.lean (98%) rename Ix/{Tc => Kernel}/Verify/Inductive/SingletonEnumeration.lean (96%) rename Ix/{Tc => Kernel}/Verify/Inductive/SingletonFamily.lean (99%) rename Ix/{Tc => Kernel}/Verify/Inductive/SingletonIngress.lean (97%) rename Ix/{Tc => Kernel}/Verify/Inductive/SingletonOracle.lean (96%) rename Ix/{Tc => Kernel}/Verify/Inductive/SingletonRecursor.lean (97%) rename Ix/{Tc => Kernel}/Verify/Inductive/SpecializationIdentity.lean (97%) rename Ix/{Tc => Kernel}/Verify/Inductive/StructuralCacheSemantics.lean (99%) rename Ix/{Tc => Kernel}/Verify/Infer.lean (99%) rename Ix/{Tc => Kernel}/Verify/Infer/Applications.lean (97%) rename Ix/{Tc => Kernel}/Verify/Infer/BinderClosing.lean (98%) rename Ix/{Tc => Kernel}/Verify/Infer/BinderOpening.lean (98%) rename Ix/{Tc => Kernel}/Verify/Infer/BinderScopes.lean (98%) rename Ix/{Tc => Kernel}/Verify/Infer/CacheShell.lean (99%) rename Ix/{Tc => Kernel}/Verify/Infer/CacheSoundness.lean (97%) rename Ix/{Tc => Kernel}/Verify/Infer/Callbacks.lean (92%) rename Ix/{Tc => Kernel}/Verify/Infer/CheapBeta.lean (98%) rename Ix/{Tc => Kernel}/Verify/Infer/Constants.lean (96%) rename Ix/{Tc => Kernel}/Verify/Infer/Dispatcher.lean (94%) rename Ix/{Tc => Kernel}/Verify/Infer/ForallTypes.lean (95%) rename Ix/{Tc => Kernel}/Verify/Infer/FunctionTypes.lean (94%) rename Ix/{Tc => Kernel}/Verify/Infer/LambdaTypes.lean (95%) rename Ix/{Tc => Kernel}/Verify/Infer/LeafCases.lean (96%) rename Ix/{Tc => Kernel}/Verify/Infer/LetScopes.lean (99%) rename Ix/{Tc => Kernel}/Verify/Infer/LetTypes.lean (95%) rename Ix/{Tc => Kernel}/Verify/Infer/Literals.lean (88%) rename Ix/{Tc => Kernel}/Verify/Infer/ProjectionClassification.lean (97%) rename Ix/{Tc => Kernel}/Verify/Infer/ProjectionTelescope.lean (94%) rename Ix/{Tc => Kernel}/Verify/Infer/ProjectionTypes.lean (97%) rename Ix/{Tc => Kernel}/Verify/Infer/ScopedLocals.lean (97%) rename Ix/{Tc => Kernel}/Verify/Infer/SortTypes.lean (92%) rename Ix/{Tc => Kernel}/Verify/Infer/Substitution.lean (93%) rename Ix/{Tc => Kernel}/Verify/InferDefEq/Closure.lean (96%) rename Ix/{Tc => Kernel}/Verify/Ingress/AnonStructural.lean (94%) rename Ix/{Tc => Kernel}/Verify/Ingress/LiteralBlobs.lean (99%) rename Ix/{Tc => Kernel}/Verify/Ingress/Representation.lean (98%) rename Ix/{Tc => Kernel}/Verify/Ingress/SerializedBoolean.lean (99%) rename Ix/{Tc => Kernel}/Verify/InstL.lean (95%) rename Ix/{Tc => Kernel}/Verify/InstUniv.lean (99%) rename Ix/{Tc => Kernel}/Verify/Knot.lean (99%) rename Ix/{Tc => Kernel}/Verify/Level.lean (98%) rename Ix/{Tc => Kernel}/Verify/Monad.lean (98%) rename Ix/{Tc => Kernel}/Verify/NatFixture.lean (98%) rename Ix/{Tc => Kernel}/Verify/Projection/Concrete.lean (75%) rename Ix/{Tc => Kernel}/Verify/Projection/ConcreteFixture.lean (80%) rename Ix/{Tc => Kernel}/Verify/RecursiveMethods/CallDomains.lean (98%) rename Ix/{Tc => Kernel}/Verify/RecursiveMethods/Closure.lean (96%) rename Ix/{Tc => Kernel}/Verify/RecursiveMethods/FiniteSupportBoundary.lean (98%) rename Ix/{Tc => Kernel}/Verify/RecursiveMethods/Inference.lean (96%) rename Ix/{Tc => Kernel}/Verify/RecursiveMethods/Public.lean (94%) rename Ix/{Tc => Kernel}/Verify/RecursiveMethods/ScopedCallDomains.lean (96%) rename Ix/{Tc => Kernel}/Verify/RecursiveMethods/ScopedInference.lean (98%) rename Ix/{Tc => Kernel}/Verify/RecursiveMethods/ScopedSortInference.lean (96%) rename Ix/{Tc => Kernel}/Verify/RecursiveMethods/SortInference.lean (96%) rename Ix/{Tc => Kernel}/Verify/Run.lean (97%) rename Ix/{Tc => Kernel}/Verify/ScopedSuffix/ClosedContext.lean (98%) rename Ix/{Tc => Kernel}/Verify/State.lean (98%) rename Ix/{Tc => Kernel}/Verify/Statements.lean (89%) rename Ix/{Tc => Kernel}/Verify/Subst.lean (99%) rename Ix/{Tc => Kernel}/Verify/Suffix.lean (99%) rename Ix/{Tc => Kernel}/Verify/Support.lean (99%) rename Ix/{Tc => Kernel}/Verify/Totalization.lean (99%) rename Ix/{Tc => Kernel}/Verify/Trans.lean (94%) rename Ix/{Tc => Kernel}/Verify/VLCtx.lean (93%) rename Ix/{Tc => Kernel}/Verify/Whnf.lean (99%) rename Ix/{Tc => Kernel}/Verify/Whnf/Beta/ArgumentAlignment.lean (97%) rename Ix/{Tc => Kernel}/Verify/Whnf/Beta/ConsumptionBoundary.lean (87%) rename Ix/{Tc => Kernel}/Verify/Whnf/Beta/DependentContexts.lean (98%) rename Ix/{Tc => Kernel}/Verify/Whnf/Beta/InstantiationChain.lean (95%) rename Ix/{Tc => Kernel}/Verify/Whnf/Beta/LambdaInstantiation.lean (83%) rename Ix/{Tc => Kernel}/Verify/Whnf/Beta/LambdaPeeling.lean (98%) rename Ix/{Tc => Kernel}/Verify/Whnf/Beta/LiftSubstitution.lean (99%) rename Ix/{Tc => Kernel}/Verify/Whnf/Beta/Meaning.lean (94%) rename Ix/{Tc => Kernel}/Verify/Whnf/Beta/PeelTrace.lean (81%) rename Ix/{Tc => Kernel}/Verify/Whnf/Beta/PrefixSemantics.lean (95%) rename Ix/{Tc => Kernel}/Verify/Whnf/Beta/SemanticCore.lean (95%) rename Ix/{Tc => Kernel}/Verify/Whnf/Beta/SimultaneousSubstitution.lean (99%) rename Ix/{Tc => Kernel}/Verify/Whnf/Beta/SingletonSubstitution.lean (98%) rename Ix/{Tc => Kernel}/Verify/Whnf/Beta/Translation.lean (98%) rename Ix/{Tc => Kernel}/Verify/Whnf/Closure.lean (98%) rename Ix/{Tc => Kernel}/Verify/Whnf/Delta/CacheExecution.lean (96%) rename Ix/{Tc => Kernel}/Verify/Whnf/Delta/CacheSemantics.lean (98%) rename Ix/{Tc => Kernel}/Verify/Whnf/Delta/ClosedTranslation.lean (80%) rename Ix/{Tc => Kernel}/Verify/Whnf/Delta/Integration.lean (97%) rename Ix/{Tc => Kernel}/Verify/Whnf/Delta/OptionalReduction.lean (98%) rename Ix/{Tc => Kernel}/Verify/Whnf/Delta/SpineUnfolding.lean (96%) rename Ix/{Tc => Kernel}/Verify/Whnf/Delta/StableCache.lean (94%) rename Ix/{Tc => Kernel}/Verify/Whnf/Delta/TrustedBody.lean (98%) rename Ix/{Tc => Kernel}/Verify/Whnf/Delta/UnfoldingState.lean (99%) rename Ix/{Tc => Kernel}/Verify/Whnf/Delta/UniverseMonotonicity.lean (97%) rename Ix/{Tc => Kernel}/Verify/Whnf/Driver/FullStep.lean (99%) rename Ix/{Tc => Kernel}/Verify/Whnf/Driver/PublicReducers.lean (94%) rename Ix/{Tc => Kernel}/Verify/Whnf/Iota/ApplicationRequests.lean (98%) rename Ix/{Tc => Kernel}/Verify/Whnf/Iota/ArgumentBranches.lean (95%) rename Ix/{Tc => Kernel}/Verify/Whnf/Iota/ArgumentExecution.lean (98%) rename Ix/{Tc => Kernel}/Verify/Whnf/Iota/ConstructorDispatch.lean (98%) rename Ix/{Tc => Kernel}/Verify/Whnf/Iota/ConstructorSynthesis.lean (99%) rename Ix/{Tc => Kernel}/Verify/Whnf/Iota/ConstructorSynthesisFallback.lean (99%) rename Ix/{Tc => Kernel}/Verify/Whnf/Iota/Ingress.lean (97%) rename Ix/{Tc => Kernel}/Verify/Whnf/Iota/NatLiteral.lean (97%) rename Ix/{Tc => Kernel}/Verify/Whnf/Iota/NatOffset.lean (99%) rename Ix/{Tc => Kernel}/Verify/Whnf/Iota/NatPatternMatching.lean (86%) rename Ix/{Tc => Kernel}/Verify/Whnf/Iota/NatRecognizer.lean (99%) rename Ix/{Tc => Kernel}/Verify/Whnf/Iota/NatReduction.lean (91%) rename Ix/{Tc => Kernel}/Verify/Whnf/Iota/NatRuleLayout.lean (96%) rename Ix/{Tc => Kernel}/Verify/Whnf/Iota/OptionalReduction.lean (97%) rename Ix/{Tc => Kernel}/Verify/Whnf/Iota/RuleInstantiation.lean (97%) rename Ix/{Tc => Kernel}/Verify/Whnf/Iota/RuleSuffixTransport.lean (94%) rename Ix/{Tc => Kernel}/Verify/Whnf/Iota/SelectedRule.lean (98%) rename Ix/{Tc => Kernel}/Verify/Whnf/Iota/StringLiteral.lean (98%) rename Ix/{Tc => Kernel}/Verify/Whnf/Iota/StructEtaControl.lean (99%) rename Ix/{Tc => Kernel}/Verify/Whnf/Iota/Substitution.lean (98%) rename Ix/{Tc => Kernel}/Verify/Whnf/Iota/SynthesisRequests.lean (98%) rename Ix/{Tc => Kernel}/Verify/Whnf/NoDelta/BaseReductions.lean (97%) rename Ix/{Tc => Kernel}/Verify/Whnf/NoDelta/ProjectionApplication.lean (98%) rename Ix/{Tc => Kernel}/Verify/Whnf/NoDelta/ProjectionDefinition.lean (98%) rename Ix/{Tc => Kernel}/Verify/Whnf/NoDelta/Quotient.lean (97%) rename Ix/{Tc => Kernel}/Verify/Whnf/NoDelta/QuotientReflection.lean (97%) rename Ix/{Tc => Kernel}/Verify/Whnf/NoDelta/Reducer.lean (94%) rename Ix/{Tc => Kernel}/Verify/Whnf/NoDelta/StringPrimitive.lean (98%) rename Ix/{Tc => Kernel}/Verify/Whnf/Projection/NoAccelTail.lean (99%) rename Ix/{Tc => Kernel}/Verify/Whnf/Projection/StringCallback.lean (97%) rename Ix/{Tc => Kernel}/Verify/Whnf/Projection/StringExpansion.lean (99%) rename Ix/{Tc => Kernel}/Verify/Whnf/README.md (97%) rename Ix/{Tc => Kernel}/Verify/Whnf/Runtime/LazyIngress.lean (99%) rename Ix/{Tc => Kernel}/Verify/Whnf/RuntimeContracts.lean (99%) rename Ix/{Tc => Kernel}/Verify/Whnf/StructEta/CallbackPrefix.lean (96%) rename Ix/{Tc => Kernel}/Verify/Whnf/StructEta/Classifier.lean (99%) rename Ix/{Tc => Kernel}/Verify/Whnf/StructEta/ExactMajorTelescope.lean (99%) rename Ix/{Tc => Kernel}/Verify/Whnf/StructEta/Rebuild.lean (99%) rename Ix/{Tc => Kernel}/Verify/Whnf/StructEta/RebuildRequests.lean (97%) rename Ix/{Tc => Kernel}/Verify/Whnf/StructEta/RebuildTail.lean (98%) rename Ix/{Tc => Kernel}/Verify/Whnf/StructEta/RecursionClassifier.lean (99%) rename Ix/{Tc => Kernel}/Verify/Whnf/StructEta/ScopedClassifier.lean (98%) rename Ix/{Tc => Kernel}/Verify/Whnf/StructEta/ScopedTelescope.lean (97%) rename Ix/{Tc => Kernel}/Verify/Whnf/Structural/ApplicationCongruence.lean (92%) rename Ix/{Tc => Kernel}/Verify/Whnf/Structural/ApplicationRebuild.lean (94%) rename Ix/{Tc => Kernel}/Verify/Whnf/Structural/ApplicationStep.lean (98%) rename Ix/{Tc => Kernel}/Verify/Whnf/Structural/ApplicationTails.lean (97%) rename Ix/{Tc => Kernel}/Verify/Whnf/Structural/BasicStep.lean (98%) rename Ix/{Tc => Kernel}/Verify/Whnf/Structural/BetaBoundary.lean (96%) rename Ix/{Tc => Kernel}/Verify/Whnf/Structural/CacheShell.lean (98%) rename Ix/{Tc => Kernel}/Verify/Whnf/Structural/ProjectionStep.lean (98%) rename Ix/{Tc => Kernel}/Verify/Whnf/Structural/RecursiveCallbacks.lean (93%) rename Ix/{Tc => Kernel}/Verify/Whnf/Structural/Reducer.lean (97%) rename Ix/{Tc => Kernel}/Verify/Whnf/Structural/StepAssembly.lean (97%) rename Ix/{Tc => Kernel}/Verify/Whnf/Structural/VariableStep.lean (98%) rename Ix/{Tc => Kernel}/Verify/Whnf/Structural/VerifiedStep.lean (96%) rename Ix/{Tc => Kernel}/Verify/World.lean (98%) rename Ix/{Tc => Kernel}/Whnf.lean (99%) delete mode 100644 Ix/Tc.lean create mode 100644 Ix/Theory.lean create mode 100644 Ix/Theory/Certificate/Build.lean create mode 100644 Ix/Theory/Certificate/Claims.lean create mode 100644 Ix/Theory/Certificate/Modeled.lean create mode 100644 Ix/Theory/Certificate/Ordinary.lean create mode 100644 Ix/Theory/Certificate/OrdinarySource.lean create mode 100644 Ix/Theory/Certificate/Quotient.lean create mode 100644 Ix/Theory/Certificate/Standard.lean create mode 100644 Ix/Theory/Certificate/Structure.lean create mode 100644 Ix/Theory/Certificate/Suggest.lean create mode 100644 Ix/Theory/Certified.lean create mode 100644 Ix/Theory/Certified/Accept.lean create mode 100644 Ix/Theory/Certified/Admission.lean create mode 100644 Ix/Theory/Certified/Basis/Equality.lean create mode 100644 Ix/Theory/Certified/Basis/Iff.lean create mode 100644 Ix/Theory/Certified/Basis/Interface.lean create mode 100644 Ix/Theory/Certified/Basis/Nonempty.lean create mode 100644 Ix/Theory/Certified/Checker.lean create mode 100644 Ix/Theory/Certified/ClaimComposition.lean create mode 100644 Ix/Theory/Certified/Claims.lean create mode 100644 Ix/Theory/Certified/Frontier.lean create mode 100644 Ix/Theory/Certified/Level.lean create mode 100644 Ix/Theory/Certified/LevelEq.lean create mode 100644 Ix/Theory/Certified/LogicalPolicy.lean create mode 100644 Ix/Theory/Certified/Modeled/Admission.lean create mode 100644 Ix/Theory/Certified/Modeled/Equation.lean create mode 100644 Ix/Theory/Certified/Modeled/Source.lean create mode 100644 Ix/Theory/Certified/Modeled/Transport.lean create mode 100644 Ix/Theory/Certified/Natural/Admission.lean create mode 100644 Ix/Theory/Certified/Natural/Checked.lean create mode 100644 Ix/Theory/Certified/Natural/Publish.lean create mode 100644 Ix/Theory/Certified/Natural/Value.lean create mode 100644 Ix/Theory/Certified/Operations.lean create mode 100644 Ix/Theory/Certified/Ordinary/Admission.lean create mode 100644 Ix/Theory/Certified/Ordinary/Checked.lean create mode 100644 Ix/Theory/Certified/Ordinary/Computation.lean create mode 100644 Ix/Theory/Certified/Ordinary/ConstructorStage.lean create mode 100644 Ix/Theory/Certified/Ordinary/Constructors.lean create mode 100644 Ix/Theory/Certified/Ordinary/Container.lean create mode 100644 Ix/Theory/Certified/Ordinary/Eliminator.lean create mode 100644 Ix/Theory/Certified/Ordinary/Family.lean create mode 100644 Ix/Theory/Certified/Ordinary/LargeElim.lean create mode 100644 Ix/Theory/Certified/Ordinary/Reading.lean create mode 100644 Ix/Theory/Certified/Ordinary/RecursorReading.lean create mode 100644 Ix/Theory/Certified/Ordinary/RecursorStage.lean create mode 100644 Ix/Theory/Certified/Ordinary/RecursorSyntax.lean create mode 100644 Ix/Theory/Certified/Ordinary/RecursorValue.lean create mode 100644 Ix/Theory/Certified/Ordinary/RuleChecks.lean create mode 100644 Ix/Theory/Certified/Ordinary/RuleEquations.lean create mode 100644 Ix/Theory/Certified/Ordinary/RuleReading.lean create mode 100644 Ix/Theory/Certified/Ordinary/Shape.lean create mode 100644 Ix/Theory/Certified/Policy.lean create mode 100644 Ix/Theory/Certified/Prelude.lean create mode 100644 Ix/Theory/Certified/PropWhen.lean create mode 100644 Ix/Theory/Certified/Quotient/Admission.lean create mode 100644 Ix/Theory/Certified/Quotient/Checked.lean create mode 100644 Ix/Theory/Certified/Quotient/Publish.lean create mode 100644 Ix/Theory/Certified/Quotient/Reading.lean create mode 100644 Ix/Theory/Certified/Quotient/Syntax.lean create mode 100644 Ix/Theory/Certified/Quotient/Value.lean create mode 100644 Ix/Theory/Certified/Signature.lean create mode 100644 Ix/Theory/Certified/Source.lean create mode 100644 Ix/Theory/Certified/Standard/Admission.lean create mode 100644 Ix/Theory/Certified/Standard/Checked.lean create mode 100644 Ix/Theory/Certified/Standard/Realization.lean create mode 100644 Ix/Theory/Certified/Store.lean create mode 100644 Ix/Theory/Certified/Structure/Admission.lean create mode 100644 Ix/Theory/Certified/Structure/Checked.lean create mode 100644 Ix/Theory/Certified/Structure/Computation.lean create mode 100644 Ix/Theory/Certified/Structure/Publish.lean create mode 100644 Ix/Theory/Certified/Structure/Reading.lean create mode 100644 Ix/Theory/Certified/Structure/Syntax.lean create mode 100644 Ix/Theory/Certified/Structure/Value.lean create mode 100644 Ix/Theory/Certified/Telescope.lean create mode 100644 Ix/Theory/Const.lean create mode 100644 Ix/Theory/Expr.lean create mode 100644 Ix/Theory/Inductive/Levels.lean create mode 100644 Ix/Theory/LICENSE create mode 100644 Ix/Theory/LICENSE-APACHE create mode 100644 Ix/Theory/LICENSE-MIT create mode 100644 Ix/Theory/Model/Annotated.lean create mode 100644 Ix/Theory/Model/Context.lean create mode 100644 Ix/Theory/Model/Environment.lean create mode 100644 Ix/Theory/Model/Extension.lean create mode 100644 Ix/Theory/Model/Inductive/Codes.lean create mode 100644 Ix/Theory/Model/Inductive/Container.lean create mode 100644 Ix/Theory/Model/Inductive/Recursor.lean create mode 100644 Ix/Theory/Model/Inductive/Telescope.lean create mode 100644 Ix/Theory/Model/Instantiation.lean create mode 100644 Ix/Theory/Model/Interpret.lean create mode 100644 Ix/Theory/Model/Judgment.lean create mode 100644 Ix/Theory/Model/PrimitiveValues.lean create mode 100644 Ix/Theory/Model/ReferenceMap.lean create mode 100644 Ix/Theory/Model/SetModel/Container.lean create mode 100644 Ix/Theory/Model/SetModel/Iter.lean create mode 100644 Ix/Theory/Model/SetModel/Ops.lean create mode 100644 Ix/Theory/Model/SetModel/RecGraph.lean create mode 100644 Ix/Theory/Model/SetModel/TaggedSum.lean create mode 100644 Ix/Theory/Model/SetModel/TupleTower.lean create mode 100644 Ix/Theory/Model/SetTheory/Core.lean create mode 100644 Ix/Theory/Model/SetTheory/Derive/Choice.lean create mode 100644 Ix/Theory/Model/SetTheory/Derive/Empty.lean create mode 100644 Ix/Theory/Model/SetTheory/Derive/Graphs.lean create mode 100644 Ix/Theory/Model/SetTheory/Derive/Lfp.lean create mode 100644 Ix/Theory/Model/SetTheory/Derive/LfpFam.lean create mode 100644 Ix/Theory/Model/SetTheory/Derive/Omega.lean create mode 100644 Ix/Theory/Model/SetTheory/Derive/Pair.lean create mode 100644 Ix/Theory/Model/SetTheory/Derive/Pt.lean create mode 100644 Ix/Theory/Model/SetTheory/Derive/Quot.lean create mode 100644 Ix/Theory/Model/SetTheory/Derive/Sep.lean create mode 100644 Ix/Theory/Model/SetTheory/Derive/Sigma.lean create mode 100644 Ix/Theory/Model/SetTheory/Derive/Univ.lean create mode 100644 Ix/Theory/Model/SetTheory/Derive/Universe.lean create mode 100644 Ix/Theory/Model/Signature.lean create mode 100644 Ix/Theory/Model/Support.lean create mode 100644 Ix/Theory/Model/TelescopeSemantics.lean create mode 100644 Ix/Theory/Model/Value.lean create mode 100644 Ix/Theory/Model/WellDenoted.lean create mode 100644 Ix/Theory/NOTICE create mode 100644 Ix/Theory/Named/ConstructorValidityFixtures.lean create mode 100644 Ix/Theory/Named/Fixtures/ProjectionExpressibility.lean create mode 100644 Ix/Theory/Named/Inductive.lean create mode 100644 Ix/Theory/Named/InductiveFixtures.lean create mode 100644 Ix/Theory/Named/LICENSE create mode 100644 Ix/Theory/Named/Literals.lean create mode 100644 Ix/Theory/Named/LocalContext.lean create mode 100644 Ix/Theory/Named/Meta.lean create mode 100644 Ix/Theory/Named/MutualInductiveFixtures.lean create mode 100644 Ix/Theory/Named/NOTICE create mode 100644 Ix/Theory/Named/NestedInductive.lean create mode 100644 Ix/Theory/Named/NestedInductiveFixtures.lean create mode 100644 Ix/Theory/Named/Projection.lean create mode 100644 Ix/Theory/Named/Quot.lean create mode 100644 Ix/Theory/Named/Reference/Declaration.lean create mode 100644 Ix/Theory/Named/Reference/Environment.lean create mode 100644 Ix/Theory/Named/Reference/Environment/Basic.lean create mode 100644 Ix/Theory/Named/Reference/Expr.lean create mode 100644 Ix/Theory/Named/Reference/ForEachExprV.lean create mode 100644 Ix/Theory/Named/Reference/FuelConfig.lean create mode 100644 Ix/Theory/Named/Reference/Inductive/Add.lean create mode 100644 Ix/Theory/Named/Reference/Inductive/EliminationTrace.lean create mode 100644 Ix/Theory/Named/Reference/Inductive/Reduce.lean create mode 100644 Ix/Theory/Named/Reference/Inductive/ValidationTrace.lean create mode 100644 Ix/Theory/Named/Reference/Instantiate.lean create mode 100644 Ix/Theory/Named/Reference/Level.lean create mode 100644 Ix/Theory/Named/Reference/List.lean create mode 100644 Ix/Theory/Named/Reference/LocalContext.lean create mode 100644 Ix/Theory/Named/Reference/Primitive.lean create mode 100644 Ix/Theory/Named/Reference/PtrEq.lean create mode 100644 Ix/Theory/Named/Reference/Quot.lean create mode 100644 Ix/Theory/Named/Reference/TypeChecker.lean create mode 100644 Ix/Theory/Named/SingletonParity.lean create mode 100644 Ix/Theory/Named/Std/AxiomAudit.lean create mode 100644 Ix/Theory/Named/Std/Basic.lean create mode 100644 Ix/Theory/Named/Std/Control.lean create mode 100644 Ix/Theory/Named/Std/HashMap.lean create mode 100644 Ix/Theory/Named/Std/NodupKeys.lean create mode 100644 Ix/Theory/Named/Std/Ord.lean create mode 100644 Ix/Theory/Named/Std/PersistentHashMap.lean create mode 100644 Ix/Theory/Named/Std/SMap.lean create mode 100644 Ix/Theory/Named/Std/ToExpr.lean create mode 100644 Ix/Theory/Named/Std/VariableBang.lean create mode 100644 Ix/Theory/Named/Typing/Basic.lean create mode 100644 Ix/Theory/Named/Typing/Env.lean create mode 100644 Ix/Theory/Named/Typing/EnvLemmas.lean create mode 100644 Ix/Theory/Named/Typing/InductiveCertificate.lean create mode 100644 Ix/Theory/Named/Typing/InductiveLemmas.lean create mode 100644 Ix/Theory/Named/Typing/InductivePattern.lean create mode 100644 Ix/Theory/Named/Typing/InductivePatternWF.lean create mode 100644 Ix/Theory/Named/Typing/Injectivity.lean create mode 100644 Ix/Theory/Named/Typing/Lemmas.lean create mode 100644 Ix/Theory/Named/Typing/Meta.lean create mode 100644 Ix/Theory/Named/Typing/NestedInductiveLemmas.lean create mode 100644 Ix/Theory/Named/Typing/Pattern.lean create mode 100644 Ix/Theory/Named/Typing/QuotLemmas.lean create mode 100644 Ix/Theory/Named/Typing/Strong.lean create mode 100644 Ix/Theory/Named/Typing/UniqueTyping.lean create mode 100644 Ix/Theory/Named/VDecl.lean create mode 100644 Ix/Theory/Named/VEnv.lean create mode 100644 Ix/Theory/Named/VExpr.lean create mode 100644 Ix/Theory/Named/VLevel.lean create mode 100644 Ix/Theory/Named/Verify/Axioms.lean create mode 100644 Ix/Theory/Named/Verify/Environment/Basic.lean create mode 100644 Ix/Theory/Named/Verify/Environment/ConstructorValidation.lean create mode 100644 Ix/Theory/Named/Verify/Environment/ConstructorValidityMatrix.lean create mode 100644 Ix/Theory/Named/Verify/Environment/Elimination.lean create mode 100644 Ix/Theory/Named/Verify/Environment/EliminationFixturesCommon.lean create mode 100644 Ix/Theory/Named/Verify/Environment/EliminationFixturesEdges.lean create mode 100644 Ix/Theory/Named/Verify/Environment/EliminationFixturesEq.lean create mode 100644 Ix/Theory/Named/Verify/Environment/EliminationFixturesEqNat.lean create mode 100644 Ix/Theory/Named/Verify/Environment/EliminationFixturesNat.lean create mode 100644 Ix/Theory/Named/Verify/Environment/EliminationFixturesOrAnd.lean create mode 100644 Ix/Theory/Named/Verify/Environment/EliminationFixturesSmall.lean create mode 100644 Ix/Theory/Named/Verify/Environment/IndexedVecCandidate.lean create mode 100644 Ix/Theory/Named/Verify/Environment/IndexedVecConsReplay.lean create mode 100644 Ix/Theory/Named/Verify/Environment/IndexedVecConstructors.lean create mode 100644 Ix/Theory/Named/Verify/Environment/IndexedVecOuterReplay.lean create mode 100644 Ix/Theory/Named/Verify/Environment/IndexedVecSemanticReplay.lean create mode 100644 Ix/Theory/Named/Verify/Environment/InductiveFixtures.lean create mode 100644 Ix/Theory/Named/Verify/Environment/Lemmas.lean create mode 100644 Ix/Theory/Named/Verify/Environment/MutualInductiveFixtures.lean create mode 100644 Ix/Theory/Named/Verify/Environment/NestedReplay.lean create mode 100644 Ix/Theory/Named/Verify/Environment/NestedRepresentation.lean create mode 100644 Ix/Theory/Named/Verify/Environment/NestedTransformation.lean create mode 100644 Ix/Theory/Named/Verify/Environment/Normalization.lean create mode 100644 Ix/Theory/Named/Verify/Environment/NormalizationMatrix.lean create mode 100644 Ix/Theory/Named/Verify/Environment/SingletonParityMatrix.lean create mode 100644 Ix/Theory/Named/Verify/Environment/SingletonParityReplay.lean create mode 100644 Ix/Theory/Named/Verify/Expr.lean create mode 100644 Ix/Theory/Named/Verify/Level.lean create mode 100644 Ix/Theory/Named/Verify/LevelStd.lean create mode 100644 Ix/Theory/Named/Verify/LocalContext.lean create mode 100644 Ix/Theory/Named/Verify/Name.lean create mode 100644 Ix/Theory/Named/Verify/NameGenerator.lean create mode 100644 Ix/Theory/Named/Verify/NormLt.lean create mode 100644 Ix/Theory/Named/Verify/QSort.lean create mode 100644 Ix/Theory/Named/Verify/TypeChecker.lean create mode 100644 Ix/Theory/Named/Verify/TypeChecker/Basic.lean create mode 100644 Ix/Theory/Named/Verify/TypeChecker/InferType.lean create mode 100644 Ix/Theory/Named/Verify/TypeChecker/IsDefEq.lean create mode 100644 Ix/Theory/Named/Verify/TypeChecker/Reduce.lean create mode 100644 Ix/Theory/Named/Verify/TypeChecker/WHNF.lean create mode 100644 Ix/Theory/Named/Verify/Typing/ConditionallyTyped.lean create mode 100644 Ix/Theory/Named/Verify/Typing/Expr.lean create mode 100644 Ix/Theory/Named/Verify/Typing/Lemmas.lean create mode 100644 Ix/Theory/Named/Verify/VLCtx.lean create mode 100644 Ix/Theory/PORTING.md create mode 100644 Ix/Theory/Quot.lean create mode 100644 Ix/Theory/Ref.lean create mode 100644 Ix/Theory/Rename.lean create mode 100644 Ix/Theory/Std/Basic.lean create mode 100644 Ix/Theory/Store.lean create mode 100644 Ix/Theory/VLevel.lean create mode 100644 Models/SetTheory/IxSetTheoryModel.lean create mode 100644 Models/SetTheory/IxSetTheoryModel/Audit.lean create mode 100644 Models/SetTheory/IxSetTheoryModel/Carneiro.lean create mode 100644 Models/SetTheory/LICENSE-CON-LECHE create mode 100644 Models/SetTheory/NOTICE create mode 100644 Models/SetTheory/README.md create mode 100644 Models/SetTheory/lake-manifest.json create mode 100644 Models/SetTheory/lakefile.toml create mode 100644 Models/SetTheory/lean-toolchain create mode 100644 Tests/Aiur/AIRSemantics.lean create mode 100644 Tests/Aiur/Backend.lean create mode 100644 Tests/Aiur/BlockRows.lean create mode 100644 Tests/Aiur/ByteGadgets.lean create mode 100644 Tests/Aiur/BytecodeCompare.lean create mode 100644 Tests/Aiur/CircuitRows.lean create mode 100644 Tests/Aiur/Dedup.lean create mode 100644 Tests/Aiur/DedupFixtures.lean create mode 100644 Tests/Aiur/Hoisting.lean create mode 100644 Tests/Aiur/LookupBudget.lean create mode 100644 Tests/Aiur/LookupShapes.lean create mode 100644 Tests/Aiur/OperationRows.lean create mode 100644 Tests/Aiur/SelectorControl.lean create mode 100644 Tests/Aiur/SourceValues.lean create mode 100644 Tests/Aiur/TailMatches.lean create mode 100644 Tests/Aiur/backend-foundation.txt create mode 100644 Tests/Aiur/bytecode-compatibility.txt create mode 100644 Tests/Aiur/dedup-compatibility.txt create mode 100644 Tests/Aiur/source-value-compatibility.txt create mode 100644 Tests/Aiur/tail-match-compatibility.txt create mode 100644 Tests/Certified/CLI.lean create mode 100644 Tests/Certified/Check.lean create mode 100644 Tests/Certified/Claims.lean create mode 100644 Tests/Certified/ClaimsMain.lean create mode 100644 Tests/Certified/FeatureCases.lean create mode 100644 Tests/Certified/Features.lean create mode 100644 Tests/Certified/Fidelity.lean create mode 100644 Tests/Certified/FidelityMain.lean create mode 100644 Tests/Certified/ImportManifest.lean create mode 100644 Tests/Certified/ModelSerialize.lean create mode 100644 Tests/Certified/Modeled.lean create mode 100644 Tests/Certified/ModeledAdversarial.lean create mode 100644 Tests/Certified/ModeledMain.lean create mode 100644 Tests/Certified/Ordinary.lean create mode 100644 Tests/Certified/Serialize.lean create mode 100644 Tests/Certified/Source.lean create mode 100644 Tests/Certified/SourceMain.lean create mode 100644 Tests/Certified/VM.lean create mode 100644 Tests/Certified/foundation.txt create mode 100644 Tests/Compiler/CatalogContact.lean create mode 100644 Tests/Compiler/Checks/CheckSourceBorrow.lean create mode 100644 Tests/Compiler/Checks/CheckSourceBorrowRuntime.lean create mode 100644 Tests/Compiler/Checks/CheckSourceCallReuse.lean create mode 100644 Tests/Compiler/Checks/CheckSourceCoverage.lean create mode 100644 Tests/Compiler/Checks/CheckSourceNativeCapturedScalar.lean create mode 100644 Tests/Compiler/Checks/CheckSourceNativePhysicalScalar.lean create mode 100644 Tests/Compiler/Checks/CheckSourceNativeRuntime.lean create mode 100644 Tests/Compiler/Checks/CheckSourceNativeScalar.lean create mode 100644 Tests/Compiler/Checks/CheckSourceNativeUnique.lean create mode 100644 Tests/Compiler/Checks/CheckSourceNativeUpstream.lean create mode 100644 Tests/Compiler/Checks/CheckSourceRecursion.lean create mode 100644 Tests/Compiler/Checks/CheckSourceUniqueReuse.lean create mode 100644 Tests/Compiler/Checks/CheckToolsTests.lean create mode 100644 Tests/Compiler/Checks/CheckTrustedExterns.lean create mode 100644 Tests/Compiler/Checks/CheckX86Bytes.lean create mode 100644 Tests/Compiler/Checks/CheckX86Encoder.lean create mode 100644 Tests/Compiler/Checks/CheckX86Object.lean create mode 100644 Tests/Compiler/Checks/CheckX86Streams.lean create mode 100644 Tests/Compiler/SourceBorrow.lean create mode 100644 Tests/Compiler/SourceBorrowRuntime.lean create mode 100644 Tests/Compiler/SourceCallReuse.lean create mode 100644 Tests/Compiler/SourceCoverage.lean create mode 100644 Tests/Compiler/SourceNativeCapturedScalar.lean create mode 100644 Tests/Compiler/SourceNativePhysicalScalar.lean create mode 100644 Tests/Compiler/SourceNativeRuntime.lean create mode 100644 Tests/Compiler/SourceNativeScalar.lean create mode 100644 Tests/Compiler/SourceNativeUnique.lean create mode 100644 Tests/Compiler/SourceNativeUpstream.lean create mode 100644 Tests/Compiler/SourceRecursion.lean create mode 100644 Tests/Compiler/SourceUniqueReuse.lean create mode 100644 Tests/Compiler/Tests.lean create mode 100644 Tests/Compiler/X86ObjectFixture.lean create mode 100644 Tests/Fixtures/Certified/README.md create mode 100644 Tests/Fixtures/Certified/c7-handoff.tar.gz create mode 100644 Tests/Fixtures/Compiler/ixon-std-contact/CompilatrixStdContact.ixe.hex create mode 100644 Tests/Fixtures/Compiler/ixon-std-contact/README.md create mode 100644 Tests/Fixtures/Compiler/ixon-std-contact/manifest.hex create mode 100644 Tests/Fixtures/Compiler/ixon-upstream/CompilatrixUpstream.lean create mode 100644 Tests/Fixtures/Compiler/ixon-upstream/README.md create mode 100644 Tests/Fixtures/Compiler/ixon-upstream/addClosed.ixe.hex create mode 100644 Tests/Fixtures/Compiler/ixon-upstream/addClosed.manifest.hex create mode 100644 Tests/Fixtures/Compiler/ixon-upstream/applyClosed.ixe.hex create mode 100644 Tests/Fixtures/Compiler/ixon-upstream/applyClosed.manifest.hex create mode 100644 Tests/Fixtures/Compiler/ixon-upstream/captureClosed.ixe.hex create mode 100644 Tests/Fixtures/Compiler/ixon-upstream/captureClosed.manifest.hex create mode 100644 Tests/Fixtures/Compiler/ixon-upstream/lake-manifest.json create mode 100644 Tests/Fixtures/Compiler/ixon-upstream/lakefile.toml create mode 100644 Tests/Fixtures/Compiler/ixon-upstream/lean-toolchain create mode 100644 Tests/Fixtures/Compiler/ixon-upstream/letClosed.ixe.hex create mode 100644 Tests/Fixtures/Compiler/ixon-upstream/letClosed.manifest.hex create mode 100644 Tests/Fixtures/Compiler/ixon-upstream/recClosed.ixe.hex create mode 100644 Tests/Fixtures/Compiler/ixon-upstream/recClosed.manifest.hex create mode 100644 Tests/Fixtures/Compiler/source-borrow-runtime/expected.json create mode 100644 Tests/Fixtures/Compiler/source-borrow/expected.json create mode 100644 Tests/Fixtures/Compiler/source-call-reuse/expected.json create mode 100644 Tests/Fixtures/Compiler/source-coverage/README.md create mode 100644 Tests/Fixtures/Compiler/source-coverage/expected.json create mode 100644 Tests/Fixtures/Compiler/source-native-captured-scalar/README.md create mode 100644 Tests/Fixtures/Compiler/source-native-captured-scalar/expected.json create mode 100644 Tests/Fixtures/Compiler/source-native-captured-scalar/native_harness.c create mode 100644 Tests/Fixtures/Compiler/source-native-physical-scalar/README.md create mode 100644 Tests/Fixtures/Compiler/source-native-physical-scalar/expected.json create mode 100644 Tests/Fixtures/Compiler/source-native-physical-scalar/native_harness.c create mode 100644 Tests/Fixtures/Compiler/source-native-runtime/README.md create mode 100644 Tests/Fixtures/Compiler/source-native-runtime/expected-counter-fold.json create mode 100644 Tests/Fixtures/Compiler/source-native-runtime/expected.json create mode 100644 Tests/Fixtures/Compiler/source-native-runtime/native_harness.c create mode 100644 Tests/Fixtures/Compiler/source-native-scalar/README.md create mode 100644 Tests/Fixtures/Compiler/source-native-scalar/expected.json create mode 100644 Tests/Fixtures/Compiler/source-native-scalar/native_harness.c create mode 100644 Tests/Fixtures/Compiler/source-native-unique/expected.json create mode 100644 Tests/Fixtures/Compiler/source-native-unique/native_harness.c create mode 100644 Tests/Fixtures/Compiler/source-native-upstream/expected.json create mode 100644 Tests/Fixtures/Compiler/source-native-upstream/native_harness.c create mode 100644 Tests/Fixtures/Compiler/source-recursion/README.md create mode 100644 Tests/Fixtures/Compiler/source-recursion/expected.json create mode 100644 Tests/Fixtures/Compiler/source-unique-reuse/expected.json create mode 100644 Tests/Fixtures/Compiler/x86/native_harness.c rename Tests/Ix/{Tc => Kernel}/AccelDiff.lean (93%) rename Tests/Ix/{Tc => Kernel}/AnonDiff.lean (96%) rename Tests/Ix/{Tc => Kernel}/CheckTests.lean (98%) rename Tests/Ix/{Tc/Roundtrip.lean => Kernel/CheckerRoundtrip.lean} (92%) rename Tests/Ix/{Tc => Kernel}/InferDefEq.lean (97%) rename Tests/Ix/{Tc => Kernel}/IngressMetaTests.lean (96%) rename Tests/Ix/{Tc => Kernel}/InitScale.lean (94%) rename Tests/Ix/{Tc => Kernel}/IxonFixtures.lean (98%) rename Tests/Ix/{Tc => Kernel}/ParityEnv.lean (97%) rename Tests/Ix/{Tc => Kernel}/Pins.lean (94%) rename Tests/Ix/{Tc => Kernel}/Substrate.lean (98%) rename Tests/Ix/{Tc => Kernel}/TutorialTc.lean (96%) rename Tests/Ix/{Tc => Kernel}/Unit.lean (98%) rename Tests/Ix/{Tc => Kernel}/WhnfTests.lean (98%) delete mode 100644 Tests/Ix/Lean4Lean.lean create mode 100644 Tests/Theory.lean create mode 100644 Tests/Theory/Acceptance.lean create mode 100644 Tests/Theory/Audit/Certified.lean create mode 100644 Tests/Theory/Certified.lean create mode 100644 Tests/Theory/Checker.lean create mode 100644 Tests/Theory/Claims.lean create mode 100644 Tests/Theory/ImportManifest.lean create mode 100644 Tests/Theory/Modeled.lean create mode 100644 Tests/Theory/ModeledEquations.lean create mode 100644 Tests/Theory/ModeledFixtures.lean create mode 100644 Tests/Theory/ModeledNested.lean create mode 100644 Tests/Theory/ModeledPermutation.lean create mode 100644 Tests/Theory/NamedManifest.lean create mode 100644 Tests/Theory/Natural.lean create mode 100644 Tests/Theory/Operations.lean create mode 100644 Tests/Theory/Ordinary.lean create mode 100644 Tests/Theory/OrdinaryAcceptance.lean create mode 100644 Tests/Theory/Provenance.lean create mode 100644 Tests/Theory/Quotient.lean create mode 100644 Tests/Theory/RecursorGoldens.lean create mode 100644 Tests/Theory/Standard.lean create mode 100644 Tests/Theory/Structure.lean create mode 100644 Tests/Theory/Suggestions.lean create mode 100644 Tests/Theory/certified-foundation.txt create mode 100644 crates/aiur/src/call_order.rs create mode 100644 crates/aiur/src/constraints/tests.rs create mode 100644 crates/aiur/src/constraints/tests/block_rows.rs create mode 100644 crates/aiur/src/constraints/tests/circuit_rows.rs create mode 100644 crates/aiur/src/constraints/tests/operation_rows.rs create mode 100644 crates/aiur/src/lookup_budget.rs create mode 100644 crates/aiur/src/lookup_shapes.rs create mode 100644 crates/aiur/src/row_counts.rs create mode 100644 crates/aiur/src/synthesis/tests/acceptance.rs create mode 100644 crates/aiur/src/synthesis/tests/advice.rs create mode 100644 crates/aiur/src/synthesis/tests/branchless.rs create mode 100644 crates/aiur/src/synthesis/tests/byte_gadgets.rs create mode 100644 crates/aiur/src/synthesis/tests/call_order.rs create mode 100644 crates/aiur/src/synthesis/tests/lookup_budget.rs create mode 100644 crates/aiur/src/synthesis/tests/lookup_shapes.rs create mode 100644 crates/aiur/src/synthesis/tests/memory.rs create mode 100644 crates/aiur/src/synthesis/tests/scalar.rs create mode 100644 docs/certified-checking.md create mode 100644 docs/compiler/README.md create mode 100644 docs/compiler/compiler-design.md create mode 100644 docs/compiler/lowering-restrictions.md create mode 100644 docs/compiler/trusted-extern-ledger.md create mode 100644 docs/kernel-verification.md create mode 100644 docs/theory.md create mode 100644 native/compiler/hpt_cache_sync.c diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 267f0b62e..beead8192 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -31,7 +31,7 @@ jobs: with: build-args: "--wfail -v" test: false - # build-all lint driver compiles every lib/exe target with --wfail, so a + # build-all lint driver compiles production lib/exe targets with --wfail, so a # warning in any target (exes, benchmarks, Apps) — not just the default lib # lean-action builds above — fails CI. - name: Build all targets @@ -86,6 +86,33 @@ jobs: use-github-cache: false - name: Test Ix CLI run: lake test --wfail -- cli + - name: Check Aiur proof boundaries and native verifier binding + run: lake run check-aiur + - name: Check certified source and claim adapters + run: lake run check-certified + + compiler: + runs-on: warp-ubuntu-latest-x64-16x + steps: + - uses: actions/checkout@v7 + - uses: ./.github/actions/setup-rust-toolchain + - uses: leanprover/lean-action@v1 + with: + auto-config: false + use-github-cache: false + - name: Check compiler proofs, trust boundary, and native fixtures + run: lake run check-compiler + + theory: + runs-on: warp-ubuntu-latest-x64-16x + steps: + - uses: actions/checkout@v7 + - uses: leanprover/lean-action@v1 + with: + auto-config: false + use-github-cache: false + - name: Check consistency model and exact foundation manifest + run: lake run check-theory rust-test: runs-on: warp-ubuntu-latest-x64-8x diff --git a/.github/workflows/merge-tests.yml b/.github/workflows/merge-tests.yml index dccdf83cd..420798b0b 100644 --- a/.github/workflows/merge-tests.yml +++ b/.github/workflows/merge-tests.yml @@ -47,13 +47,13 @@ jobs: - name: Valgrind FFI kind: valgrind runner: warp-ubuntu-latest-x64-8x - - name: Ix.Tc verification and parity + - name: Ix.Kernel verification and parity kind: tc runner: warp-ubuntu-latest-x64-16x test_args: >- --ignored tc-anon-diff tc-init tc-tutorial tc-roundtrip tc-ingress-meta - tc-pins tc-accel-diff lean4lean + tc-pins tc-accel-diff runs-on: ${{ matrix.runner }} steps: - name: Validate merge-test variant @@ -147,19 +147,22 @@ jobs: --suppressions=.github/valgrind.supp \ .lake/build/bin/IxTests ffi - - name: Check Ix.Tc exported theorem trust manifest + - name: Check Ix.Kernel exported theorem trust manifest if: ${{ matrix.kind == 'tc' }} - run: lake build Ix.Tc.Verify.Audit.Completed Ix.Tc.Verify.Audit.Conditional Ix.Tc.Verify.Audit.Statements - - name: Build Ix.Tc formal verification + run: lake build Ix.Kernel.Verify.Audit.Completed Ix.Kernel.Verify.Audit.Conditional Ix.Kernel.Verify.Audit.Statements + - name: Build Ix.Kernel formal verification if: ${{ matrix.kind == 'tc' }} - run: lake build IxTcVerify - - name: Check Ix.Tc verification sorry frontier + run: lake build IxKernelVerify IxCompileVerify + - name: Check Ix.Kernel consistency refinement if: ${{ matrix.kind == 'tc' }} - run: lake build Ix.Tc.Verify.Audit.SorryFrontier - - name: Test Ix.Tc unit and adversarial fixtures + run: lake build --wfail IxKernelConsistency + - name: Check Ix.Kernel verification sorry frontier + if: ${{ matrix.kind == 'tc' }} + run: lake build Ix.Kernel.Verify.Audit.SorryFrontier + - name: Test Ix.Kernel unit and adversarial fixtures if: ${{ matrix.kind == 'tc' }} run: lake test --wfail -- tc-unit - - name: Run Ix.Tc ignored tests + - name: Run Ix.Kernel ignored tests if: ${{ matrix.kind == 'tc' }} run: lake test --wfail -- ${{ matrix.test_args }} diff --git a/.github/workflows/set-theory-model.yml b/.github/workflows/set-theory-model.yml new file mode 100644 index 000000000..e415b0c2a --- /dev/null +++ b/.github/workflows/set-theory-model.yml @@ -0,0 +1,47 @@ +name: Set-theory model + +on: + pull_request: + paths: + - 'Models/SetTheory/**' + - 'Ix/Theory/Model/SetTheory/Core.lean' + - 'lakefile.lean' + - 'lake-manifest.json' + - 'lean-toolchain' + - '.github/workflows/set-theory-model.yml' + merge_group: + workflow_dispatch: + +permissions: + contents: read + +concurrency: + group: ${{ github.workflow }}-${{ github.head_ref || github.run_id }} + cancel-in-progress: true + +jobs: + model: + runs-on: warp-ubuntu-latest-x64-16x + timeout-minutes: 60 + defaults: + run: + working-directory: Models/SetTheory + env: + MATHLIB_NO_CACHE_ON_UPDATE: '1' + MATHLIB_CACHE_DIR: .lake/mathlib-cache + steps: + - uses: actions/checkout@v7 + - uses: leanprover/lean-action@v1 + with: + auto-config: false + use-github-cache: false + - name: Check Lean toolchains match + run: cmp ../../lean-toolchain lean-toolchain + - uses: actions/cache@v6 + with: + path: Models/SetTheory/.lake + key: set-theory-model-${{ runner.os }}-${{ runner.arch }}-${{ hashFiles('Models/SetTheory/lean-toolchain', 'Models/SetTheory/lakefile.toml', 'Models/SetTheory/lake-manifest.json') }} + - name: Fetch the imported Mathlib modules and dependencies + run: lake exe cache get Mathlib.SetTheory.Cardinal.Regular Mathlib.SetTheory.ZFC.VonNeumann Mathlib.SetTheory.ZFC.Cardinal + - name: Build model and check axiom guard + run: lake build --wfail diff --git a/AGENTS.md b/AGENTS.md new file mode 100644 index 000000000..006d21f21 --- /dev/null +++ b/AGENTS.md @@ -0,0 +1,6 @@ +# Repository guidelines + +- Keep local plans and work notes in the gitignored `plans/` directory. +- Reserve `docs/` for polished, permanent, user-facing documentation. +- Use Lean or Ix instead of Python, Perl, or shell scripts wherever possible. +- Use Ixon instead of JSON wherever possible. diff --git a/BENCHMARKS.md b/BENCHMARKS.md index 6d1740331..5b1b683d0 100644 --- a/BENCHMARKS.md +++ b/BENCHMARKS.md @@ -2,7 +2,7 @@ Head-to-head timings for every stage of the Ix pipeline across three environments, comparing the pure-Lean implementation (`Ix.CompileM` / -`Ix.DecompileM` / `Ix.Tc`) against the Rust implementation +`Ix.DecompileM` / `Ix.Kernel`) against the Rust implementation (`crates/compile` / `crates/kernel`). ## Methodology @@ -119,7 +119,7 @@ Rust: `ix decompile` (the decompile pass over a `.ixe`). Lean: flags → Pass 2 aux regeneration/recovery) *plus* the hash comparison against the canonicalized source (comparison overhead ~5 s at 205k constants). Lean decompilation is dominated by Pass 2's kernel bridge -(regeneration re-infers through `Ix.Tc`); Pass 2 runs on the +(regeneration re-infers through `Ix.Kernel`); Pass 2 runs on the wave-parallel driver (`decompileEnvPass2Parallel`, 16 workers — the count is memory-bound, not core-bound; `IX_DECOMPILE_WORKERS` overrides). The sequential figures from before the parallel driver are @@ -147,7 +147,7 @@ full verdict parity. worker config keeps warm caches; both a 32-worker meta run and a 32-worker anon run without cache clearing were OOM-killed while swap-thrashing). The anon row uses the scale configuration from the -`Ix.Tc` Mathlib-tier validation: 16 workers, `--clear-every 50` +`Ix.Kernel` Mathlib-tier validation: 16 workers, `--clear-every 50` (whole-worker-state renewal every 50 items; RSS plateaus ~42 GB) — **640,658/640,658 passed, zero failures, full verdict parity**. Anon mode dedups alpha-identical constants, hence the smaller count. diff --git a/Benchmarks/Compile/TruthMines/Members/Lean4Lean.lean b/Benchmarks/Compile/TruthMines/Members/Lean4Lean.lean deleted file mode 100644 index f3f063175..000000000 --- a/Benchmarks/Compile/TruthMines/Members/Lean4Lean.lean +++ /dev/null @@ -1,2 +0,0 @@ -/- GENERATED by `lake exe truthmines gen` from `Benchmarks.TruthMinesSpec`; do not edit. -/ -import Drivers.Lean4Lean diff --git a/Benchmarks/Compile/TruthMines/lake-manifest.json b/Benchmarks/Compile/TruthMines/lake-manifest.json index a80f29677..1f25e71e6 100644 --- a/Benchmarks/Compile/TruthMines/lake-manifest.json +++ b/Benchmarks/Compile/TruthMines/lake-manifest.json @@ -375,16 +375,6 @@ "inputRev": "453f4feb6508ec787fc325a70523d38e4378ef8f", "inherited": true, "configFile": "lakefile.lean"}, - {"url": "https://github.com/digama0/lean4lean", - "type": "git", - "subDir": null, - "scope": "", - "rev": "e0e3f6bcccb840cb0ea6f11c2b274ada93a12e00", - "name": "lean4lean", - "manifestFile": "lake-manifest.json", - "inputRev": "e0e3f6bcccb840cb0ea6f11c2b274ada93a12e00", - "inherited": true, - "configFile": "lakefile.toml"}, {"url": "https://github.com/leanprover-community/import-graph", "type": "git", "subDir": null, diff --git a/Benchmarks/Compile/lake-manifest.json b/Benchmarks/Compile/lake-manifest.json index 1112621d5..dbf19a9d3 100644 --- a/Benchmarks/Compile/lake-manifest.json +++ b/Benchmarks/Compile/lake-manifest.json @@ -168,16 +168,6 @@ "inputRev": null, "inherited": true, "configFile": "lakefile.lean"}, - {"url": "https://github.com/argumentcomputer/lean4ix", - "type": "git", - "subDir": null, - "scope": "", - "rev": "a4188d7c2979378d85c6bb41fdd96c3a48a71371", - "name": "lean4lean", - "manifestFile": "lake-manifest.json", - "inputRev": "a4188d7c2979378d85c6bb41fdd96c3a48a71371", - "inherited": true, - "configFile": "lakefile.toml"}, {"url": "https://github.com/leanprover/lean4-cli", "type": "git", "subDir": null, diff --git a/Benchmarks/Compiler.lean b/Benchmarks/Compiler.lean new file mode 100644 index 000000000..05a2e3ea4 --- /dev/null +++ b/Benchmarks/Compiler.lean @@ -0,0 +1,52 @@ +import Benchmarks.Compiler.Reproduce +import Benchmarks.Compiler.CounterFold + +open Ix.Compiler.Tools.Check + +def main (args : List String) : IO UInt32 := cli "benchmark failed" do + match args with + | "counter-fold-build" :: output :: options => + let options ← checked (parseArgs ["--gcc", "--time"] options) + Benchmarks.Compiler.CounterFold.buildSuite output (option options "--gcc" "gcc") (option options "--time" "time") + | ["counter-fold-verify", build, output] => Benchmarks.Compiler.CounterFold.verifySuite build output + | ["counter-fold-smoke", build, output, core] => + Benchmarks.Compiler.CounterFold.smokeSuite build output (← present core.toNat? "core must be a natural number") + | ["counter-fold-smoke", build, output] => Benchmarks.Compiler.CounterFold.smokeSuite build output (← Benchmarks.Compiler.firstCore) + | ["counter-fold-pilot", build, correctness, output, core] => + Benchmarks.Compiler.CounterFold.pilotSuite build correctness output (← present core.toNat? "core must be a natural number") + | ["counter-fold-measure", build, correctness, pilot, output, core] => + Benchmarks.Compiler.CounterFold.measureSuite build correctness pilot output (← present core.toNat? "core must be a natural number") + | ["counter-fold-analyze", build, measured, output] => Benchmarks.Compiler.CounterFold.analyzeSuite build measured output + | ["counter-fold-reproduce", build, measured, output] => Benchmarks.Compiler.CounterFold.reproduceSuite build measured output + | ["datasets", output] => + Benchmarks.Compiler.writeDatasets output + IO.println "benchmark datasets: 585 inputs, 19305 arena capacity cases, 38 timing rows" + | "build" :: output :: options => + let options ← checked (parseArgs ["--gcc", "--clang", "--compcert", "--cakeml", "--time"] options) + Benchmarks.Compiler.buildSuite output { + gcc := option options "--gcc" "gcc", clang := option options "--clang" "clang", + compcert := option options "--compcert" "ccomp", cakeml := option options "--cakeml" "cake", + timerTool := option options "--time" "time" } + | ["check-matrix", implementation, path] => + let rows ← Benchmarks.Compiler.readLines path + let result ← Benchmarks.Compiler.inspectMatrix implementation rows + Benchmarks.Compiler.checkerRegressions implementation rows + IO.println result.compress + | ["verify", build, output] => Benchmarks.Compiler.verifySuite build output + | ["smoke", build, output, core] => + Benchmarks.Compiler.smokeSuite build output (← present core.toNat? "core must be a natural number") + | ["smoke", build, output] => Benchmarks.Compiler.smokeSuite build output (← Benchmarks.Compiler.firstCore) + | ["gc-smoke", build, output, core] => + Benchmarks.Compiler.gcSmokeSuite build output (← present core.toNat? "core must be a natural number") + | ["gc-smoke", build, output] => Benchmarks.Compiler.gcSmokeSuite build output (← Benchmarks.Compiler.firstCore) + | ["pilot", build, correctness, output, core] => + Benchmarks.Compiler.pilotSuite build correctness output (← present core.toNat? "core must be a natural number") + | ["measure", build, correctness, pilot, output, core] => + Benchmarks.Compiler.measureSuite build correctness pilot output (← present core.toNat? "core must be a natural number") + | ["analyze", build, measured, output] => Benchmarks.Compiler.analyzeSuite build measured output + | ["analysis-self-check"] => Benchmarks.Compiler.analysisSelfCheck + | ["diagnose", build, pilot, output, core] => + Benchmarks.Compiler.diagnoseSuite build pilot output (← present core.toNat? "core must be a natural number") + | ["reproduce", build, measured, output] => Benchmarks.Compiler.reproduceSuite build measured output + | ["rebuild-check", build, output] => let _ ← Benchmarks.Compiler.rebuildArtifacts build output; pure () + | _ => throw (IO.userError "usage: benchmark datasets OUT | build OUT [--gcc PATH --clang PATH --compcert PATH --cakeml PATH --time PATH] | verify BUILD OUT | smoke BUILD OUT [CORE] | gc-smoke BUILD OUT [CORE] | pilot BUILD VERIFY OUT CORE | measure BUILD VERIFY PILOT OUT CORE | diagnose BUILD PILOT OUT CORE | analyze BUILD MEASURED OUT | reproduce BUILD MEASURED OUT | analysis-self-check") diff --git a/Benchmarks/Compiler/Analyze.lean b/Benchmarks/Compiler/Analyze.lean new file mode 100644 index 000000000..fb769770a --- /dev/null +++ b/Benchmarks/Compiler/Analyze.lean @@ -0,0 +1,317 @@ +import Benchmarks.Compiler.Measure + +namespace Benchmarks.Compiler +open Lean System Ix.Compiler.Tools.Check Ix.Compiler.Tools.UniqueCheck + +def quantile (values : Array Float) (numerator denominator : Nat) : Float := Id.run do + if values.isEmpty then return 0 + let sorted := values.qsort (· < ·) + let position := numerator * (values.size - 1) + let left := position / denominator + let fraction := (position % denominator).toFloat / denominator.toFloat + return sorted[left]! * (1 - fraction) + sorted[min (left + 1) (values.size - 1)]! * fraction + +def median (values : Array Float) : Float := quantile values 1 2 + +/-- The same index vectors apply to every implementation and every ratio. +Sessions are the outer cluster, and each selected session contributes ten +paired blocks sampled with replacement. -/ +def bootstrapIndices (seed : UInt64 := 2671931027) (replicates : Nat := 10000) : Array (Array Nat) := Id.run do + let mut state := seed + let mut result := #[] + for _ in [:replicates] do + let mut indices := #[] + for _ in [:3] do + state := nextRandom state + let session := state.toNat % 3 + for _ in [:10] do + state := nextRandom state + indices := indices.push (session * 10 + state.toNat % 10) + result := result.push indices + return result + +def distribution (indices : Array (Array Nat)) (values : Array Float) : Json := + let bootstraps := indices.map fun sample => median (sample.map (values[·]!)) + Json.mkObj [("blocks", toJson values.size), ("median", toJson (median values)), + ("q25", toJson (quantile values 1 4)), ("q75", toJson (quantile values 3 4)), + ("ci95_low", toJson (quantile bootstraps 1 40)), ("ci95_high", toJson (quantile bootstraps 39 40)), + ("session_medians", toJson ((List.range 3).map fun session => median (values.extract (session * 10) ((session + 1) * 10))))] + +def numeric (json : Json) : IO Float := do + let value ← checked (fromJson? json : Except String Float) + need (value.isFinite && value > 0) "analysis expects finite positive numeric observations" + return value + +def statistic (json : Json) (name : String) : IO Float := do numeric (← field json name) + +def analysisSelfCheck : IO Unit := do + let values := (List.range 30).toArray.map (fun n => (n + 1).toFloat) + need (median values == 15.5 && quantile values 1 4 == 8.25 && quantile values 3 4 == 22.75) + "analysis quantile regression" + let indices := bootstrapIndices 2671931027 1000 + need (indices == bootstrapIndices 2671931027 1000 && indices.size == 1000 && + indices.all (fun row => row.size == 30 && row.all (· < 30))) "analysis bootstrap is not reproducible or bounded" + for row in indices do + for cluster in [:3] do + let segment := row.extract (cluster * 10) ((cluster + 1) * 10) + need (segment.all (fun index => index / 10 == segment[0]! / 10)) "bootstrap broke a session cluster" + let ratios := values.map (fun value => (2 * value) / value) + let result := distribution indices ratios + for key in ["median", "q25", "q75", "ci95_low", "ci95_high"] do + need ((← statistic result key) == 2) "paired ratio bootstrap lost pairing" + rejects "zero analysis input" "finite positive" (numeric (toJson (0 : Nat)) *> pure ()) + IO.println "benchmark analysis self-check: quantiles, deterministic hierarchical session clusters, paired ratios, and invalid numeric inputs passed" + +structure ObservedBlock where + -- Stable layout: row ID, implementation, then the three native observations. + samples : Array (Array (Array Json)) + upstream : Array (Array Json) + initialRss : Array Nat + +def inspectMeasurement (build measured : FilePath) : IO (Json × Array ObservedBlock) := do + let metadata ← inspectBuild build + let freeze ← inspectFreeze build measured + let manifest ← readJson (measured / "measurement.json") + need ((← strField manifest "format") == "compilatrix/benchmark-measurement/1" && + (← strField manifest "status") == "complete") "measurement is not complete" + let buildHash := digest (← IO.FS.readBinFile (build / "build.json")) + let freezeHash := digest (← IO.FS.readBinFile (measured / "freeze.json")) + need ((← strField manifest "build_blake3") == buildHash && (← strField manifest "freeze_blake3") == freezeHash) + "measurement build/freeze identity disagrees" + for (name, key) in [("samples.jsonl", "samples_blake3"), ("upstream.jsonl", "upstream_blake3")] do + need (digest (← IO.FS.readBinFile (measured / name)) == (← strField manifest key)) "retained sample digest disagrees" + let correctness ← readJson (measured / "correctness.json") + need ((← strField correctness "build_blake3") == buildHash && (← strField correctness "status") == "passed" && + (← field correctness "executables") == (← field metadata "executables")) "measurement correctness record differs" + let reference ← field freeze "environment" + for file in ["environment-start.json", "environment-end.json"] do + need (← stableEnvironment reference (← readJson (measured / file))) "measurement environment drift" + let valid ← arrField manifest "valid_blocks" + need (valid.size == 30 && (← number manifest "samples") == 20520 && (← number manifest "upstream_samples") == 180) + "measurement block/sample inventory disagrees" + let mut observations := #[] + let mut reconstructed := #[] + let mut upstreamReconstructed := #[] + for block in (← arrField freeze "blocks") do + let id ← number block "block" + let session ← number block "session" + let status := valid[id]! + let attempt ← number status "attempt" + need ((← number status "block") == id && (← number status "session") == session && + (← strField status "status") == "valid" && attempt < 3) "valid block identity disagrees" + let directory := measured / s!"session-{session}/block-{id}/attempt-{attempt}" + need ((← readJson (directory / "status.json")) == status) "retained block status disagrees" + for file in ["environment-start.json", "environment-end.json"] do + need (← stableEnvironment reference (← readJson (directory / file))) "valid block has environmental drift" + let schedule ← checked (fromJson? (← field block "schedule") : Except String Schedule) + let order ← (← arrField block "implementation_order").mapM string + let mut samples := Array.replicate 38 (Array.replicate 6 #[]) + let mut initialRss := Array.replicate 6 0 + for orderIndex in [:order.size] do + let implementation := order[orderIndex]! + let implementationIndex ← present (implementations.toList.idxOf? implementation) "unknown measured implementation" + let path := directory / s!"{implementation}.jsonl" + let rows ← readLines path + let native ← inspectRun implementation schedule rows true + initialRss := initialRss.set! implementationIndex (← number rows[0]! "initial_rss_kb") + let process ← readJson (path.withExtension "process.json") + need ((← number process "exit_code") == 0 && (← field process "schedule") == toJson schedule && + (← number process "core") == (← number freeze "core") && (← strField process "implementation") == implementation && + (← strField process "schedule_blake3") == digest schedule.bytes && + (← strField process "stdout_blake3") == digest (← IO.FS.readBinFile path)) "raw process identity disagrees" + need ((← IO.FS.readBinFile (path.withExtension "bin")) == schedule.bytes) "raw binary schedule drifted" + let hash := digest (← IO.FS.readBinFile (build / s!"bin/{implementation}")) + for sample in native do + let row ← number sample "row" + need ((← number sample "peak_rss_kb") <= (← number freeze "resource_bound_rss_kb")) "valid block exceeded RSS limit" + samples := samples.set! row (samples[row]!.set! implementationIndex (samples[row]![implementationIndex]!.push sample)) + reconstructed := reconstructed.push (enriched sample id session orderIndex attempt buildHash freezeHash hash) + let entries ← arrField freeze "upstream" + need (entries.size == 2) "upstream measured inventory changed" + let entries := if id % 2 == 0 then entries else entries.reverse + let mut upstream := Array.replicate 2 #[] + for upstreamOrder in [:entries.size] do + let entry := entries[upstreamOrder]! + let name ← strField entry "name" + let index := if name == "applyClosed" then 0 else 1 + need (name == (if index == 0 then "applyClosed" else "letClosed")) "unknown upstream measured entry" + let value ← number entry "value" + let operations ← number entry "operations" + let rows ← readLines (directory / s!"upstream-{name}.jsonl") + need (rows.size == 4 && (← kind rows[0]!) == "warmup" && (← number rows[0]! "elapsed_ns") >= 1000000000) + "upstream native warm-up/sample inventory disagrees" + let hash := digest (← IO.FS.readBinFile (build / s!"bin/upstream-{name}")) + for i in [:3] do + let row := rows[i + 1]! + need ((← kind row) == "sample" && (← number row "sample") == i && + (← number row "operations") == operations && (← number row "elapsed_ns") >= minimumNs && + (← number row "sink") == operations * value && + (← number row "peak_rss_kb") <= (← number freeze "resource_bound_rss_kb")) "upstream native sample identity, value or resource bound disagrees" + upstreamReconstructed := upstreamReconstructed.push (Json.mkObj [("name", toJson name), + ("sample", enriched row id session upstreamOrder attempt buildHash freezeHash hash)]) + upstream := upstream.set! index (rows.extract 1 rows.size) + need (samples.all (fun row => row.all (·.size == 3)) && upstream.all (·.size == 3)) "block has missing paired rows" + observations := observations.push { samples, upstream, initialRss } + need ((← readLines (measured / "samples.jsonl")) == reconstructed) "combined samples differ from original paired process records" + need ((← readLines (measured / "upstream.jsonl")) == upstreamReconstructed) "combined upstream samples differ from process records" + return (freeze, observations) + +def nsPerOp (sample : Json) : IO Float := do + let elapsed ← number sample "elapsed_ns" + let count ← number sample "operations" + need (elapsed > 0 && count > 0) "zero time or operation count" + return elapsed.toFloat / count.toFloat + +def compactFloat (value : Float) : String := + toString ((value * 100).round / 100) + +def analyzeSuite (build measured output : FilePath) : IO Unit := do + fresh output + analysisSelfCheck + let (freeze, blocks) ← inspectMeasurement build measured + let diagnostics ← readJson (measured / "diagnostics/diagnostics.json") + let diagnosticBuildHash := digest (← IO.FS.readBinFile (build / "build.json")) + need ((← strField diagnostics "status") == "passed" && (← strField diagnostics "build_blake3") == + diagnosticBuildHash) "diagnostics do not match the measured build" + let gc ← field diagnostics "gc" + need ((← strField gc "raw_blake3") == digest (← IO.FS.readBinFile (measured / "diagnostics/cakeml-gc.jsonl"))) + "retained collection diagnostics changed" + let indices := bootstrapIndices + let mut results := #[] + let mut report := "# Native reversal: shared-host reference run\n\n" + report := report ++ "This report covers one bounded reversal workload on one recorded x86-64 Linux host. " ++ + "It compares the checked Ix.Compiler object with consuming Lean and CakeML programs and the same arena C kernel compiled by CompCert, GCC, and Clang. " ++ + "The worker is pinned, but the host, SMT sibling, temperature, and turbo behavior are not controlled. These observations do not establish a dedicated regression baseline.\n\n" ++ + "Every row has 30 paired blocks in three sessions, with the median of three samples per executable per block. " ++ + "Samples accumulate at least 100 ms of measured work. Counts are identical across implementations in each paired case. " ++ + "The raw timer and handoff control is retained without subtraction. All valid slow observations are included. " ++ + "Intervals use 10,000 hierarchical paired bootstrap replicates (seed 2671931027), resampling sessions then blocks. " ++ + "Only three session clusters are available, so interval precision and generalization remain limited. Full medians, quartiles, intervals, session medians, and paired ratios are in `summary.json`.\n\n" + for profile in [:2] do + report := report ++ s!"## {if profile == 0 then "Entry plus bounded handoff" else "Fresh allocation lifecycle"}\n\n" ++ + "Nanoseconds per operation, median across block medians. Lifecycle includes construction, reversal, order-sensitive consumption, and normal memory management.\n\n" ++ + "| Length | Payload domain | Ix.Compiler | Lean | CakeML | CompCert | GCC | Clang |\n" ++ + "| ---: | --- | ---: | ---: | ---: | ---: | ---: | ---: |\n" + for localId in [:19] do + let id := profile * 19 + localId + let specification := timingCases[id]! + let mut implementationResults := #[] + let mut blockValues := #[] + for implementationIndex in [:6] do + let values ← blocks.mapM fun block => do + return median (← block.samples[id]![implementationIndex]!.mapM nsPerOp) + blockValues := blockValues.push values + for implementationIndex in [:6] do + let values := blockValues[implementationIndex]! + let stats := distribution indices values + let ratios := values.zipWith (· / ·) blockValues[0]! + let ratios := distribution indices ratios + let ns := median values + implementationResults := implementationResults.push (Json.mkObj [ + ("implementation", toJson implementations[implementationIndex]!), ("ns_per_operation", stats), + ("ns_per_element", if specification.length == 0 then Json.null else toJson (ns / specification.length.toFloat)), + ("operations_per_second", toJson (1000000000 / ns)), + ("paired_speedup_baseline_over_compilatrix", ratios)]) + let domain := if specification.domain == 0 then "six patterns, <2^30" else + ["", "2^63-1", "2^63", "2^64-1"][specification.domain]! + report := report ++ s!"| {specification.length} | {domain} | " ++ + String.intercalate " | " ((blockValues.map (fun values => compactFloat (median values))).toList) ++ " |\n" + results := results.push (Json.mkObj [("row", toJson id), ("length", toJson specification.length), + ("domain", toJson specification.domain), ("profile", toJson (if profile == 0 then "entry+handoff" else "lifecycle")), + ("implementations", Json.arr implementationResults)]) + report := report ++ "\n" + report := report ++ "## Paired comparison at the current 64-element bound\n\n" ++ + "Each cell is baseline time / Ix.Compiler time, followed by its 95% interval. Values above one favor Ix.Compiler. " ++ + "The JSON summary retains paired intervals for every other length as well.\n\n" ++ + "| Profile | Domain | Lean | CakeML | CompCert | GCC | Clang |\n| --- | --- | --- | --- | --- | --- | --- |\n" + for row in results do + if (← number row "length") != 64 then continue + let cells ← (← arrField row "implementations").extract 1 6 |>.mapM fun implementation => do + let stats ← field implementation "paired_speedup_baseline_over_compilatrix" + return s!"{compactFloat (← statistic stats "median")} [{compactFloat (← statistic stats "ci95_low")}, {compactFloat (← statistic stats "ci95_high")}]" + report := report ++ s!"| {← strField row "profile"} | {domainName (← number row "domain")} | " ++ String.intercalate " | " cells.toList ++ " |\n" + let mut memory := #[] + report := report ++ "\n## Process memory and collection observations\n\n" ++ + "RSS is read from `/proc/self/statm`; peak RSS is the maximum recorded `getrusage(RUSAGE_SELF)` high-water value. " ++ + "Ready-process RSS includes initialized runtimes and immutable scalar datasets, before list work. " ++ + "These process measurements include allocator/runtime reservation and differ from live application bytes.\n\n" ++ + "| Implementation | Median ready RSS KiB | Minimum sample RSS KiB | Maximum sample RSS KiB | Maximum recorded peak KiB |\n| --- | ---: | ---: | ---: | ---: |\n" + for index in [:6] do + let initial := blocks.map fun block => block.initialRss[index]!.toFloat + let mut rssMin : Option Nat := none + let mut rssMax := 0 + let mut peak := 0 + for block in blocks do + for row in block.samples do + for sample in row[index]! do + let rss ← number sample "rss_kb" + rssMin := some (min rss (rssMin.getD rss)) + rssMax := max rss rssMax + peak := max peak (← number sample "peak_rss_kb") + memory := memory.push (Json.mkObj [("implementation", toJson implementations[index]!), + ("ready_rss_kb_median", toJson (median initial)), ("minimum_sample_rss_kb", toJson rssMin), + ("maximum_sample_rss_kb", toJson rssMax), ("maximum_recorded_peak_rss_kb", toJson peak)]) + report := report ++ s!"| {implementations[index]!} | {compactFloat (median initial)} | {rssMin.getD 0} | {rssMax} | {peak} |\n" + let terminal ← field gc "terminal_collection" + report := report ++ s!"\nThe separate CakeML lifecycle diagnostic observed {← number gc "natural_collections_in_sample_envelopes"} natural collections " ++ + s!"across 20 samples. Maximum observed post-collection live data was {← number gc "maximum_post_gc_live_bytes"} bytes; " ++ + s!"the separately timed terminal collection took {← number terminal "elapsed_ns"} ns and retained {← number terminal "post_gc_live_bytes"} bytes. " ++ + "These instrumented event counts include each sample envelope and are separate from primary timing. " ++ + s!"Hardware counters: {← strField (← field diagnostics "hardware_counters") "status"}; the diagnostic record gives the actual availability reason/event output.\n\n" + report := report ++ "## Native code and compiler work\n\n" ++ + "The following object `.text` sizes come from retained `size -A` output. The CakeML object includes the ML driver and basis code; " ++ + "the Lean object includes its generated module entry, and the C/Ix.Compiler rows isolate the arena kernels. " ++ + "The complete sections, linked executable sizes, and dynamic dependencies are retained; these scopes are not interchangeable.\n\n" ++ + "| Object | `.text` bytes |\n| --- | ---: |\n" + for entry in (← arrField diagnostics "code_sizes") do + let name ← strField entry "name" + if implementations.contains name then continue + let text ← strField entry "gnu_size_A" + let line := (text.splitOn "\n").find? (fun line => (words line).head? == some ".text") + let count := line.bind (fun line => (words line)[1]?.bind String.toNat?) + report := report ++ s!"| {name} | {count.map toString |>.getD "unavailable"} |\n" + report := report ++ "\nCompiler rows are single observed process envelopes. They include process startup and the named producer/checker work; " ++ + "they are separate from seed installation, proof-library builds, and runtime comparisons. CPU time and peak compiler RSS are in the retained diagnostics.\n\n" ++ + "| Operation | Elapsed ms | Peak RSS KiB |\n| --- | ---: | ---: |\n" + for cost in (← arrField diagnostics "compiler_costs") do + let command ← field cost "command" + let resources ← field cost "resources" + report := report ++ s!"| {← strField cost "name"} | {compactFloat ((← number command "envelope_ns").toFloat / 1000000)} | {← number resources "peak_rss_kb"} |\n" + report := report ++ "\n" + let mut upstream := #[] + report := report ++ "## Unchanged upstream computations\n\n" ++ + "These closed entries retain their native successor instructions and four direct calls. They take no runtime arguments. " ++ + "Their call timings are separate from the runtime-input reversal comparison.\n\n" ++ + "| Entry | Result | Native text bytes | Object bytes | Median ns/call | 95% interval |\n| --- | ---: | ---: | ---: | ---: | --- |\n" + for index in [:2] do + let name := if index == 0 then "applyClosed" else "letClosed" + let values ← blocks.mapM fun block => do return median (← block.upstream[index]!.mapM nsPerOp) + let stats := distribution indices values + let native ← field (← readJson (build / s!"artifacts/upstream-{name}/upstream-{name}.json")) "native" + let row := Json.mkObj [("name", toJson name), ("ns_per_call", stats), ("value", ← field native "value"), + ("text_bytes", ← field native "text_bytes"), ("object_bytes", ← field native "object_bytes"), + ("native_heap", ← field native "native_heap"), ("executions", ← field native "executions")] + upstream := upstream.push row + report := report ++ s!"| {name} | {← number native "value"} | {← number native "text_bytes"} | {← number native "object_bytes"} | " ++ + s!"{compactFloat (median values)} | {compactFloat (← statistic stats "ci95_low")}–{compactFloat (← statistic stats "ci95_high")} |\n" + report := report ++ "\nThe baseline source/physical heap is fully reclaimed in the checked artifacts. Native Nat values use one exact 64-bit word and allocate no heap. " ++ + "The call traces write 48 bytes below the caller return slot. These closed translation-validation and supplied-state execution certificates do not close N3's open-call, branch/join, or F1's general stack contracts.\n\n" ++ + "Code sizes, compiler/checker resource envelopes, runtime dependencies, RSS observations, GC diagnostics, and complete inputs are retained with the build and raw run. " ++ + "Arena capacity is n+2 cells (80+32*(n+2) bytes); release clears cells before freeing the arena. " ++ + "Lean uniqueness diagnostics establish exclusive spines and cons reuse. CakeML uses a 64 MiB simple copying heap and an 8 MiB stack; separate diagnostics report actual collection cycles and terminal collection. " ++ + "Dropping roots is not immediate reclamation. Hardware counters are reported only when available.\n" + let summary := Json.mkObj [("format", toJson "compilatrix/benchmark-analysis/1"), + ("build_blake3", toJson (digest (← IO.FS.readBinFile (build / "build.json")))) , + ("measurement_blake3", toJson (digest (← IO.FS.readBinFile (measured / "measurement.json")))), + ("freeze_blake3", toJson (digest (← IO.FS.readBinFile (measured / "freeze.json")))), + ("bootstrap", ← field freeze "bootstrap"), ("bootstrap_replicates", toJson (10000 : Nat)), + ("bootstrap_seed", toJson (2671931027 : Nat)), ("quantile", toJson "linear interpolation at (n-1)*p"), + ("within_block", toJson "median of three samples"), ("rows", Json.arr results), ("upstream", Json.arr upstream), + ("process_memory", Json.arr memory), ("diagnostics", diagnostics), + ("diagnostics_blake3", toJson (digest (← IO.FS.readBinFile (measured / "diagnostics/diagnostics.json")))), + ("missing_rows", Json.arr #[]), ("failed_published_rows", Json.arr #[]), ("status", toJson "complete")] + writeJson (output / "summary.json") summary + IO.FS.writeFile (output / "report.md") report + IO.println "benchmark analysis: 38 rows, paired uncertainty, two upstream entries, and complete raw-record replay passed" + +end Benchmarks.Compiler diff --git a/Benchmarks/Compiler/Build.lean b/Benchmarks/Compiler/Build.lean new file mode 100644 index 000000000..52b91980a --- /dev/null +++ b/Benchmarks/Compiler/Build.lean @@ -0,0 +1,255 @@ +import Benchmarks.Compiler.Check + +namespace Benchmarks.Compiler +open Lean System Ix.Compiler.Tools.Check Ix.Compiler.Tools.UniqueCheck + +structure Toolchains where + gcc : String := "gcc" + clang : String := "clang" + compcert : String := "ccomp" + cakeml : String := "cake" + timerTool : String := "time" + deriving ToJson, FromJson + +def cFlags : Array String := #["-O3", "-march=x86-64", "-mtune=generic", "-fno-lto", "-fomit-frame-pointer"] +def runtimeEnv : Array (String × Option String) := + #[("CML_HEAP_SIZE", some "64"), ("CML_STACK_SIZE", some "8")] + +def buildEnvNames : Array String := #["PATH", "LIBCLANG_PATH", "LEAN_PATH", "LEAN_CC", "LEAN_SYSROOT", + "NIX_CFLAGS_COMPILE", "NIX_LDFLAGS", "NIX_ENFORCE_PURITY", "NIX_CC", "NIX_BINTOOLS", + "NIX_CC_WRAPPER_TARGET_HOST_x86_64_unknown_linux_gnu", "NIX_BINTOOLS_WRAPPER_TARGET_HOST_x86_64_unknown_linux_gnu", + "NIX_HARDENING_ENABLE", "NIX_ENFORCE_NO_NATIVE", "LD_LIBRARY_PATH", "LIBRARY_PATH", "CPATH", + "C_INCLUDE_PATH", "CPLUS_INCLUDE_PATH", "NIX_STORE", "NIX_BUILD_TOP", "SOURCE_DATE_EPOCH", "LANG", "LC_ALL"] + +def absolute (path : FilePath) : IO FilePath := do + if path.isAbsolute then return path + return (← IO.currentDir) / path + +def fresh (output : FilePath) : IO Unit := do + need (!(← output.pathExists)) s!"fresh output directory required: {output}" + IO.FS.createDirAll output + +def writeJson (path : FilePath) (json : Json) : IO Unit := + IO.FS.writeFile path (json.pretty 120 ++ "\n") + +def binaryOutput (args : IO.Process.SpawnArgs) (input : Option String) : IO (UInt32 × ByteArray × String) := do + let child ← if let some input := input then do + let (stdin, child) ← (← IO.Process.spawn { args with stdout := .piped, stderr := .piped, stdin := .piped }).takeStdin + stdin.putStr input + stdin.flush + pure child + else IO.Process.spawn { args with stdout := .piped, stderr := .piped, stdin := .null } + let stdout ← IO.asTask child.stdout.readBinToEnd Task.Priority.dedicated + let stderr ← child.stderr.readToEnd + let exitCode ← child.wait + return (exitCode, ← IO.ofExcept stdout.get, stderr) + +/-- Persist each raw timing record as it arrives, including partial output +from interrupted or failed processes. The reader runs outside the worker. -/ +def streamed (args : IO.Process.SpawnArgs) (path : FilePath) : IO IO.Process.Output := do + let child ← IO.Process.spawn { args with stdout := .piped, stderr := .piped, stdin := .null } + let stderr ← IO.asTask child.stderr.readToEnd Task.Priority.dedicated + let file ← IO.FS.Handle.mk path .write + let mut stdout := "" + repeat + let line ← child.stdout.getLine + if line.isEmpty then break + file.putStr line + file.flush + stdout := stdout ++ line + let exitCode ← child.wait + return { exitCode, stdout, stderr := ← IO.ofExcept stderr.get } + +def logged (directory : FilePath) (name command : String) (args : Array String) + (env : Array (String × Option String) := #[]) (input : Option String := none) + (timeTool : String := "time") : IO String := do + IO.FS.createDirAll directory + let before ← IO.monoNanosNow + let (exitCode, stdout, stderr) ← binaryOutput { + cmd := timeTool + args := #["-f", "{\"user_seconds\":%U,\"system_seconds\":%S,\"wall_seconds\":%e,\"peak_rss_kb\":%M,\"exit_code\":%x}", + "-o", (directory / s!"{name}.resources.json").toString, command] ++ args + env := env } input + let elapsed := (← IO.monoNanosNow) - before + IO.FS.writeBinFile (directory / s!"{name}.stdout") stdout + IO.FS.writeFile (directory / s!"{name}.stderr") stderr + writeJson (directory / s!"{name}.command.json") (Json.mkObj [ + ("command", toJson command), ("arguments", toJson args), ("environment_overrides", toJson env), + ("stdin_blake3", toJson (input.map (digest ·.toUTF8))), ("exit_code", toJson exitCode.toNat), + ("envelope_ns", toJson elapsed)]) + need (exitCode == 0) s!"{name} exited {exitCode}; see {directory / s!"{name}.stderr"}\n{stderr}" + -- CakeML's exploration stream contains raw byte-string literals. Preserve + -- the exact bytes above; an ASCII projection is sufficient to inspect calls. + match String.fromUTF8? stdout with + | some text => return text + | none => return stdout.foldl (fun text byte => text.push (if byte.toNat < 128 then Char.ofNat byte.toNat else '?')) "" + +def recordFiles (root : FilePath) : IO Json := do + let paths ← files root + let rows ← paths.toArray.mapM fun path => do + let bytes ← IO.FS.readBinFile path + return Json.mkObj [("path", toJson (path.toString.drop (root.toString.length + 1)).toString), + ("bytes", toJson bytes.size), ("blake3", toJson (digest bytes))] + return Json.arr rows + +def inspectFiles (root : FilePath) (inventory : Json) : IO Unit := do + need ((← recordFiles root) == inventory) s!"artifact inventory or digest changed: {root}" + +def sourceSnapshot (output : FilePath) : IO Json := do + let git ← IO.Process.output { cmd := "git", args := #["rev-parse", "HEAD"] } + let names ← if git.exitCode == 0 then run "git" #["ls-files", "-z", "--cached", "--others", "--exclude-standard"] + else run "rg" #["--files", "--hidden", "-g", "!.lake", "-g", "!.git", "-0"] + let paths := names.splitOn "\x00" |>.filter (!·.isEmpty) |>.mergeSort (· ≤ ·) + let mut rows := #[] + let mut included := [] + for name in paths do + if !(← (FilePath.mk name).pathExists) then continue + let bytes ← IO.FS.readBinFile name + rows := rows.push (Json.mkObj [("path", toJson name), ("bytes", toJson bytes.size), ("blake3", toJson (digest bytes))]) + included := name :: included + IO.FS.writeFile (output / "source-files.list0") (String.intercalate "\x00" included.reverse ++ "\x00") + let _ ← run "tar" #["--null", "--verbatim-files-from", "--files-from", (output / "source-files.list0").toString, + "--sort=name", "--mtime=@1", "--owner=0", "--group=0", "--numeric-owner", "-czf", (output / "source.tar.gz").toString] + let snapshot := Json.mkObj [("revision", toJson (if git.exitCode == 0 then git.stdout.trimAscii.toString else "source-snapshot-without-git")), + ("status", toJson (← if git.exitCode == 0 then run "git" #["status", "--short"] else pure "Nix or extracted source snapshot")), ("files", Json.arr rows), + ("archive", toJson "source.tar.gz"), ("archive_blake3", toJson (digest (← IO.FS.readBinFile (output / "source.tar.gz"))))] + writeJson (output / "source.json") snapshot + return snapshot + +def buildSuite (output : FilePath) (tools : Toolchains) : IO Unit := do + let output ← absolute output + let cFlags := cFlags ++ #[s!"-ffile-prefix-map={output}=/benchmark-build"] + fresh output + for name in ["bin", "tools-bin", "artifacts/driver", "artifacts/lean", "artifacts/cakeml", "diagnostics/build"] do + IO.FS.createDirAll (output / name) + writeDatasets (output / "datasets") + let logs := output / "diagnostics/build" + let _ ← logged logs "worker-launcher" tools.gcc + (cFlags ++ #["-Wall", "-Wextra", "-Werror", "Benchmarks/Compiler/native/worker_launcher.c", + "-o", (output / "bin/worker-launcher").toString]) #[] none tools.timerTool + let mut versions := #[] + for (name, command, args, expected) in [ + ("gcc", tools.gcc, #["--version"], "14.3.0"), + ("clang", tools.clang, #["--version"], "21.1.2"), + ("compcert", tools.compcert, #["-version"], "3.16"), + ("cakeml", tools.cakeml, #["--version"], "e8eca63affd1653105ca4b9cc2f5ca87a01cd0af"), + ("lean", "lean", #["--version"], "4.33.1")] do + let version ← logged logs s!"version-{name}" command args #[] none tools.timerTool + need (version.contains expected) s!"pinned {name} version unavailable" + versions := versions.push (Json.mkObj [("name", toJson name), ("version_output", toJson version)]) + let n2 := output / "artifacts/compilatrix" + let _ ← logged logs "compilatrix-produce" ".lake/build/bin/compiler-source-native-runtime" #[n2.toString] #[] none tools.timerTool + let _ ← logged logs "compilatrix-independent-gate" ".lake/build/bin/compiler-check-source-native-runtime" + #["--fixture", ".lake/build/bin/compiler-source-native-runtime", "--cc", tools.gcc, + "--harness", "Tests/Fixtures/Compiler/source-native-runtime/native_harness.c"] #[] none tools.timerTool + for (name, value) in [("applyClosed", 3), ("letClosed", 4)] do + let upstream := output / s!"artifacts/upstream-{name}" + let _ ← logged logs s!"upstream-{name}-produce" ".lake/build/bin/compiler-source-native-upstream" + #[upstream.toString, name] #[] none tools.timerTool + let _ ← logged logs s!"upstream-{name}-check" ".lake/build/bin/compiler-check-source-native-upstream" + #["inspect", upstream.toString] #[] none tools.timerTool + let object := upstream / s!"upstream-{name}.o" + let executable := output / s!"bin/upstream-{name}" + let _ ← logged logs s!"upstream-{name}-link" tools.gcc + (cFlags ++ #["-Wall", "-Wextra", "-Werror", s!"-DEXPECTED_RESULT={value}", + "Tests/Fixtures/Compiler/source-native-upstream/native_harness.c", object.toString, "-Wl,-z,noexecstack", "-o", executable.toString]) + #[] none tools.timerTool + let _ ← logged logs s!"upstream-{name}-native-check" executable.toString #[] #[] none tools.timerTool + let _ ← logged logs s!"upstream-{name}-size" "size" #["-A", object.toString, executable.toString] #[] none tools.timerTool + let _ ← logged logs s!"upstream-{name}-disassembly" "objdump" #["-d", object.toString] #[] none tools.timerTool + let manifest ← readJson "Benchmarks/Compiler/manifest.json" + let report ← readJson (n2 / "report.json") + for key in ["source_identity", "ixir1_root", "main_identity", "release_identity", "pipeline_identity"] do + need ((← field report key) == (← field (← field manifest "compilatrix") key)) s!"N2 {key} drifted" + for name in ["common", "driver", "arena_backend"] do + let _ ← logged logs s!"driver-{name}" tools.gcc (cFlags ++ #["-Wall", "-Wextra", "-Werror", "-c", + s!"Benchmarks/Compiler/native/{name}.c", "-o", (output / s!"artifacts/driver/{name}.o").toString]) #[] none tools.timerTool + for (name, command, flags) in [("gcc", tools.gcc, cFlags), ("clang", tools.clang, cFlags), ("compcert", tools.compcert, #["-O"])] do + IO.FS.createDirAll (output / s!"artifacts/{name}") + let _ ← logged logs s!"kernel-{name}" command (flags ++ #["-c", "Benchmarks/Compiler/native/arena_kernel.c", + "-o", (output / s!"artifacts/{name}/kernel.o").toString]) #[] none tools.timerTool + let driverObjects := #["common", "driver"].map fun name => (output / s!"artifacts/driver/{name}.o").toString + for name in ["compilatrix", "compcert", "gcc", "clang"] do + let kernels := if name == "compilatrix" then #[(n2 / "main.o").toString, (n2 / "release.o").toString] + else #[(output / s!"artifacts/{name}/kernel.o").toString] + let _ ← logged logs s!"link-{name}" tools.gcc (cFlags ++ driverObjects ++ + #[(output / "artifacts/driver/arena_backend.o").toString] ++ kernels ++ + #["-Wl,-z,noexecstack", "-o", (output / s!"bin/{name}").toString]) #[] none tools.timerTool + let leanRoot := ((← run "lean" #["--print-prefix"]).trimAscii.toString : FilePath) + let leanC := output / "artifacts/lean/LeanReverse.c" + let _ ← logged logs "lean-generate-c" "lean" #["--root=Benchmarks/Compiler/lean", "-c", leanC.toString, "Benchmarks/Compiler/lean/LeanReverse.lean"] #[] none tools.timerTool + let generated ← IO.FS.readFile leanC + requireAll generated ["lean_is_exclusive", "lean_ctor_set", "LEAN_EXPORT lean_object* bench_lean_reverse", "l_benchReverseOnto"] "Lean operation boundary" + for (name, source) in [("kernel", leanC.toString), ("backend", "Benchmarks/Compiler/native/lean_backend.c")] do + -- Lake's ordinary release configuration is -O3 -DNDEBUG. Use leanc's + -- installed C/ABI flags as well as the declared target and opaque boundary. + let _ ← logged logs s!"lean-{name}" "leanc" (cFlags ++ #["-DNDEBUG", "-I", (leanRoot / "include").toString, + "-c", source, "-o", (output / s!"artifacts/lean/{name}.o").toString]) #[("LEAN_CC", some tools.gcc)] none tools.timerTool + let _ ← logged logs "link-lean" "leanc" (cFlags ++ driverObjects ++ + #["-Wl,-z,noexecstack", (output / "artifacts/lean/kernel.o").toString, (output / "artifacts/lean/backend.o").toString, + "-o", (output / "bin/lean").toString]) #[("LEAN_CC", some tools.gcc)] none tools.timerTool + let cakeDir := (FilePath.mk tools.cakeml).parent.getD "." + let basis := cakeDir / "basis_ffi.c" + need (← basis.pathExists) "CakeML bootstrap basis_ffi.c must be beside its executable" + IO.FS.writeFile (output / "artifacts/cakeml/basis_ffi.c") (← IO.FS.readFile basis) + let source ← IO.FS.readFile "Benchmarks/Compiler/cakeml/reverse.cml" + for (name, extra) in [("kernel", #[]), ("diagnostic", #["--emit_empty_ffi=true"])] do + let assembly ← logged logs s!"cakeml-{name}" tools.cakeml + (#["--target=x64", "--reg_alg=2", "--gc=simple"] ++ extra) #[] (some source) tools.timerTool + IO.FS.writeFile (output / s!"artifacts/cakeml/{name}.S") assembly + let definitions := if name == "diagnostic" then #["-DDEBUG_FFI", "-DBENCH_CAKEML_GC", "-include", "sys/time.h"] else #[] + let _ ← logged logs s!"cakeml-assemble-{name}" tools.gcc + (cFlags ++ #["-c", (output / s!"artifacts/cakeml/{name}.S").toString, "-o", + (output / s!"artifacts/cakeml/{name}.o").toString]) #[] none tools.timerTool + let _ ← logged logs s!"link-cakeml-{name}" tools.gcc (cFlags ++ definitions ++ + #[(output / "artifacts/driver/common.o").toString, "Benchmarks/Compiler/native/cakeml_ffi.c", + (output / "artifacts/cakeml/basis_ffi.c").toString, (output / s!"artifacts/cakeml/{name}.o").toString, + "-lm", "-Wl,-z,noexecstack", "-o", (output / (if name == "kernel" then "bin/cakeml" else "bin/cakeml-diagnostic")).toString]) #[] none tools.timerTool + let explore ← logged logs "cakeml-explore" tools.cakeml + #["--target=x64", "--reg_alg=2", "--gc=simple", "--explore"] #[] (some source) tools.timerTool + requireAll explore ["(jump reverseOnto@", "(jump digest_loop@", "(jump make@", "(lifecycle_loop_clos@"] "CakeML operation boundary" + let _ ← logged logs "compress-cakeml-explore" "gzip" #["-n", (logs / "cakeml-explore.stdout").toString] #[] none tools.timerTool + for name in implementations do + let _ ← logged logs s!"size-{name}" "size" #["-A", (output / s!"bin/{name}").toString] #[] none tools.timerTool + let _ ← logged logs s!"dependencies-{name}" "ldd" #[(output / s!"bin/{name}").toString] #[] none tools.timerTool + let _ ← logged logs s!"disassembly-{name}" "objdump" #["-d", (output / s!"bin/{name}").toString] #[] none tools.timerTool + for (name, path) in [("compilatrix-main", n2 / "main.o"), ("compilatrix-release", n2 / "release.o"), + ("gcc-kernel", output / "artifacts/gcc/kernel.o"), ("clang-kernel", output / "artifacts/clang/kernel.o"), + ("compcert-kernel", output / "artifacts/compcert/kernel.o"), ("lean-kernel", output / "artifacts/lean/kernel.o"), + ("cakeml-kernel", output / "artifacts/cakeml/kernel.o")] do + let _ ← logged logs s!"size-{name}" "size" #["-A", path.toString] #[] none tools.timerTool + IO.FS.writeFile (output / "manifest.json") (← IO.FS.readFile "Benchmarks/Compiler/manifest.json") + IO.FS.writeFile (output / "toolchains.json") (← IO.FS.readFile "Benchmarks/Compiler/toolchains.json") + let mut toolRows := #[] + let mut storePaths : Array String := #[] + for (name, command) in [("gcc", tools.gcc), ("clang", tools.clang), ("compcert", tools.compcert), + ("cakeml", tools.cakeml), ("lean", "lean"), ("lake", "lake"), ("leanc", "leanc")] do + let path := ((← run "which" #[command]).trimAscii.toString : FilePath) + let resolved := (← run "readlink" #["-f", path.toString]).trimAscii.toString + toolRows := toolRows.push (Json.mkObj [("name", toJson name), ("command", toJson command), + ("resolved", toJson resolved), ("retained_path", if name == "cakeml" then toJson "tools-bin/cakeml-bootstrap" else Json.null), + ("blake3", toJson (digest (← IO.FS.readBinFile resolved)))]) + if resolved.startsWith "/nix/store/" then + let storePath := String.intercalate "/" ((resolved.splitOn "/").take 4) + if !storePaths.contains storePath then storePaths := storePaths.push storePath + writeJson (output / "tool-identities.json") (Json.arr toolRows) + let closure ← IO.Process.output { cmd := "nix-store", args := #["--query", "--requisites"] ++ storePaths } + IO.FS.writeFile (output / "nix-closure.txt") closure.stdout + writeJson (output / "nix-closure-status.json") (Json.mkObj [("exit_code", toJson closure.exitCode.toNat), + ("stderr", toJson closure.stderr), ("roots", toJson storePaths)]) + for name in ["benchmark", "source-native-runtime", "check-source-native-runtime", "source-native-upstream", "check-source-native-upstream"] do + let _ ← run "cp" #[s!".lake/build/bin/compiler-{name}", (output / s!"tools-bin/compiler-{name}").toString] + let _ ← run "cp" #[tools.cakeml, (output / "tools-bin/cakeml-bootstrap").toString] + IO.FS.writeFile (output / "tools-bin/basis_ffi.c") (← IO.FS.readFile basis) + writeJson (output / "build.json") (Json.mkObj [ + ("format", toJson "compilatrix/benchmark-build/1"), ("tool_commands", toJson tools), ("versions", Json.arr versions), + ("build_environment", toJson (← buildEnvNames.mapM fun name => do return (name, ← IO.getEnv name))), + ("datasets_blake3", toJson (digest datasetBytes)), ("artifacts", ← recordFiles (output / "artifacts")), + ("executables", ← recordFiles (output / "bin")), ("tools", ← recordFiles (output / "tools-bin")), + ("tool_identities_blake3", toJson (digest (← IO.FS.readBinFile (output / "tool-identities.json")))), + ("manifest_blake3", toJson (digest (← IO.FS.readBinFile (output / "manifest.json")))), + ("toolchains_blake3", toJson (digest (← IO.FS.readBinFile (output / "toolchains.json"))))]) + let _ ← sourceSnapshot output + IO.println s!"benchmark build: six implementations and separate CakeML GC executable in {output}" + +end Benchmarks.Compiler diff --git a/Benchmarks/Compiler/Check.lean b/Benchmarks/Compiler/Check.lean new file mode 100644 index 000000000..5251c45ed --- /dev/null +++ b/Benchmarks/Compiler/Check.lean @@ -0,0 +1,121 @@ +import Benchmarks.Compiler.Data + +/-! The benchmark oracle imports diagnostic IO and hashing, not the source +compiler, target selector, emitter, or any comparison implementation. -/ +namespace Benchmarks.Compiler +open Lean System Ix.Compiler.Tools.Check Ix.Compiler.Tools.UniqueCheck + +def implementations : Array String := #["compilatrix", "lean", "cakeml", "compcert", "gcc", "clang"] +def isArena (implementation : String) : Bool := !["lean", "cakeml"].contains implementation + +def readLines (path : FilePath) : IO (Array Json) := do + let lines := (← IO.FS.readFile path).splitOn "\n" |>.filter (!·.isEmpty) + lines.toArray.mapM fun line => checked (Json.parse line) + +def kind (row : Json) : IO String := strField row "kind" + +def inspectHeap (heap : Json) (input : Input) (capacity : Nat) (released : Bool) : IO Unit := do + let n := input.length + let header ← (← arrField heap "header").mapM nat + need (header == #[32 * (n + 2), 32 * capacity, n + 2, if released then n + 2 else 1, + n, if released then 0 else n + 1, n + 2, 0, 2 * n, 0]) "benchmark heap counters disagree" + let cells ← arrField heap "cells" + need (cells.size == n + 2) "benchmark allocated cell inventory disagrees" + for index in [:cells.size] do + let actual ← array cells[index]! + let expected := if released || index == 0 then + #[toJson (3 : Nat), toJson (0 : Nat), Json.null, toJson (0 : Nat)] + else if index == n + 1 then + #[toJson (0 : Nat), toJson (0 : Nat), Json.null, toJson (0 : Nat)] + else #[toJson (1 : Nat), toJson input.values[n - index]!.toNat, toJson (index + 1), toJson (0 : Nat)] + need (actual == expected) "benchmark cell value, ownership, or reclamation disagrees" + +def inspectCase (implementation : String) (input : Input) (capacity : Nat) (row : Json) : IO Unit := do + need ((← kind row) == "case" && (← number row "id") == input.id) "benchmark case identity disagrees" + need ((← field row "values") == toJson (input.values.reverse.map UInt64.toNat)) "benchmark reversed values disagree" + need ((← number row "digest") == input.expectedDigest.toNat) "benchmark case digest disagrees" + if isArena implementation then + need ((← number row "capacity") == capacity) "benchmark capacity disagrees" + inspectHeap (← field row "returned") input capacity false + inspectHeap (← field row "reclaimed") input capacity true + for flag in ["abi_preserved", "canaries_preserved", "unused_capacity_preserved"] do + need ((← field row flag) == toJson true) s!"benchmark {flag} failed" + else + need ((← field row "capacity") == Json.null) "language runtime declared an arena capacity" + if implementation == "lean" then + for key in ["exclusive_input_cons", "exclusive_output_cons", "reused_cons"] do + need ((← number row key) == input.length) s!"Lean {key} disagrees" + need ((← field row "released") == toJson true) "Lean result was not released" + else need ((← field row "roots_dropped") == toJson true) "CakeML result root retained" + +def inspectMetadata (implementation : String) (row : Json) : IO Unit := do + need ((← kind row) == "metadata" && (← strField row "format") == "compilatrix/benchmark-native/1" && + (← strField row "implementation") == implementation && (← strField row "timer") == "CLOCK_MONOTONIC_RAW") + "benchmark metadata disagrees" + for key in ["resolution_ns", "timer_pair_min_ns", "initial_rss_kb"] do + need ((← number row key) > 0) s!"benchmark invalid metadata: {key}" + let mean ← checked (fromJson? (← field row "timer_pair_mean_ns") : Except String Float) + need (mean > 0 && mean < 1000000) "benchmark timer overhead invalid" + +def inspectControl (row : Json) : IO Unit := do + need ((← kind row) == "control" && (← number row "operations") == 4194304 && + (← number row "elapsed_ns") > 0 && (← number row "sink") == 0) "benchmark driver control invalid" + need (["opaque-empty-handoff", "empty-reverse-handoff"].contains (← strField row "name")) "unknown driver control" + +def inspectMatrix (implementation : String) (rows : Array Json) : IO Json := do + need (implementations.contains implementation && rows.size >= 3) "benchmark implementation or matrix missing" + inspectMetadata implementation rows[0]! + inspectControl rows[1]! + let mut index := 2 + for input in inputs do + let capacities := if isArena implementation then 65 - input.length else 1 + for extra in [:capacities] do + need (index < rows.size) "benchmark missing correctness row" + inspectCase implementation input (input.length + 2 + extra) rows[index]! + index := index + 1 + need (index + 1 == rows.size && (← kind rows[index]!) == "verified" && + (← number rows[index]! "cases") == index - 2) "benchmark correctness inventory disagrees" + return Json.mkObj [("implementation", toJson implementation), ("cases", toJson (index - 2)), + ("full_values", toJson true), ("matrix_blake3", toJson (digest (Json.arr (rows.extract 2 index)).compress.toUTF8))] + +def sampleSink (row : TimingCase) (operations : Nat) : UInt64 := Id.run do + let ids := row.inputIds + let cycle := ids.foldl (fun total id => total + inputs[id]!.expectedDigest) 0 + let rest := (ids.extract 0 (operations % ids.size)).foldl (fun total id => total + inputs[id]!.expectedDigest) 0 + return cycle * (operations / ids.size).toUInt64 + rest + +def inspectSample (implementation : String) (mode rowId sample operations : Nat) (row : Json) : IO Unit := do + need (rowId < timingCases.size) "benchmark row outside inventory" + need ((← kind row) == "sample" && (← strField row "implementation") == implementation && + (← number row "mode") == mode && (← number row "row") == rowId && + (← number row "sample") == sample && (← number row "operations") == operations && + operations > 0 && operations % (chunkSize * 6) == 0) "benchmark sample identity disagrees" + need ((← number row "sink") == (sampleSink timingCases[rowId]! operations).toNat) "benchmark timed sink disagrees" + let elapsed ← number row "elapsed_ns" + let minimum ← number row "minimum_chunk_ns" + let chunks := operations / chunkSize + need ((← number row "chunks") == chunks && (← number row "timer_calls") == 2 * chunks && + minimum > 0 && elapsed >= minimum * chunks) "benchmark timer/chunk counts disagree" + for key in ["envelope_cpu_ns", "minor_faults", "major_faults", "voluntary_switches", "involuntary_switches"] do + let _ ← number row key + need ((← number row "envelope_ns") >= elapsed && (← number row "rss_kb") > 0 && + (← number row "peak_rss_kb") > 0) "benchmark envelope or process memory invalid" + +def checkerRegressions (implementation : String) (rows : Array Json) : IO Unit := do + let row := rows[11]! + let id ← number row "id" + let input := inputs[id]! + let capacity ← if isArena implementation then number row "capacity" else pure (input.length + 2) + for (name, path, replacement, fragment) in [ + ("case id", ["id"], toJson (585 : Nat), "case identity"), + ("case values", ["values"], toJson [123456789], "reversed values"), + ("case digest", ["digest"], toJson (0 : Nat), "case digest")] do + rejects name fragment (inspectCase implementation input capacity (← replaceAt row path replacement)) + if isArena implementation then + for key in ["abi_preserved", "canaries_preserved", "unused_capacity_preserved"] do + rejects key key (inspectCase implementation input capacity (← replaceAt row [key] (toJson false))) + rejects "heap counters" "heap counters" (inspectCase implementation input capacity + (← replaceAt row ["reclaimed", "header"] (toJson ([] : List Nat)))) + rejects "missing correctness row" "missing correctness row" (inspectMatrix implementation (rows.extract 0 8) *> pure ()) + +end Benchmarks.Compiler diff --git a/Benchmarks/Compiler/CounterFold.lean b/Benchmarks/Compiler/CounterFold.lean new file mode 100644 index 000000000..0ba855088 --- /dev/null +++ b/Benchmarks/Compiler/CounterFold.lean @@ -0,0 +1,213 @@ +import Benchmarks.Compiler.CounterFoldRun +import Benchmarks.Compiler.Reproduce + +namespace Benchmarks.Compiler.CounterFold +open Lean System Ix.Compiler.Tools.Check Ix.Compiler.Tools.UniqueCheck + +def inspectProcess (process : Json) (variant executableHash stdoutHash : String) (core : Nat) (schedule : Schedule) : IO Unit := do + need ((← strField process "variant") == variant && (← strField process "executable_blake3") == executableHash && + (← number process "exit_code") == 0 && (← number process "core") == core && + (← field process "schedule") == toJson schedule && + (← strField process "schedule_blake3") == digest schedule.bytes && + (← strField process "stdout_blake3") == stdoutHash) "counter-fold raw process identity disagrees" + +def inspectMeasurement (build measured : FilePath) : IO (Json × Array ObservedBlock) := do + requireCorrectness build measured + let freeze ← inspectFreeze build measured + let manifest ← readJson (measured / "measurement.json") + let buildHash := digest (← IO.FS.readBinFile (build / "build.json")) + let freezeHash := digest (← IO.FS.readBinFile (measured / "freeze.json")) + need ((← strField manifest "format") == "compilatrix/counter-fold-measurement/1" && + (← strField manifest "status") == "complete" && (← number manifest "samples") == 6840 && + (← strField manifest "build_blake3") == buildHash && (← strField manifest "freeze_blake3") == freezeHash && + (← strField manifest "samples_blake3") == digest (← IO.FS.readBinFile (measured / "samples.jsonl"))) + "counter-fold measurement inventory or digest disagrees" + let reference ← field freeze "environment" + let core ← number freeze "core" + for file in ["environment-start.json", "environment-end.json"] do + need (← stableEnvironment reference (← readJson (measured / file))) "counter-fold measurement environment drift" + let valid ← arrField manifest "valid_blocks" + need (valid.size == 30) "counter-fold paired block inventory disagrees" + let mut observations := #[] + let mut reconstructed := #[] + for block in (← arrField freeze "blocks") do + let id ← number block "block" + let session ← number block "session" + let status := valid[id]! + let attempt ← number status "attempt" + need ((← number status "block") == id && (← number status "session") == session && + (← strField status "status") == "valid" && (← field status "reason") == Json.null && + (← number status "samples") == 228 && attempt < 3) "counter-fold valid block identity disagrees" + let directory := measured / s!"session-{session}/block-{id}/attempt-{attempt}" + need ((← readJson (directory / "status.json")) == status) "counter-fold retained block status disagrees" + for file in ["environment-start.json", "environment-end.json"] do + need (← stableEnvironment reference (← readJson (directory / file))) "counter-fold valid block environment drift" + let schedule ← checked (fromJson? (← field block "schedule") : Except String Schedule) + let order ← (← arrField block "variant_order").mapM string + let mut samples := Array.replicate 38 (Array.replicate 2 #[]) + let mut initialRss := Array.replicate 2 0 + for index in [:order.size] do + let variant := order[index]! + let variantIndex ← present (variants.toList.idxOf? variant) "unknown measured variant" + let path := directory / s!"{variant}.jsonl" + let rows ← readLines path + let native ← inspectRun "compilatrix" schedule rows true + initialRss := initialRss.set! variantIndex (← number rows[0]! "initial_rss_kb") + let process ← readJson (path.withExtension "process.json") + let hash := digest (← IO.FS.readBinFile (build / s!"bin/{variant}")) + let stdoutHash := digest (← IO.FS.readBinFile path) + inspectProcess process variant hash stdoutHash core schedule + need ((← IO.FS.readBinFile (path.withExtension "bin")) == schedule.bytes) "counter-fold raw binary schedule drift" + if id == 0 then + for (key, value) in [("variant", toJson "unknown"), ("executable_blake3", toJson "wrong"), + ("stdout_blake3", toJson "wrong"), ("core", toJson (core + 1)), ("exit_code", toJson (1 : Nat))] do + rejects key "raw process identity" (inspectProcess (← replaceAt process [key] value) variant hash stdoutHash core schedule) + for sample in native do + let row ← number sample "row" + need ((← number sample "peak_rss_kb") <= 2097152) "counter-fold valid block exceeded RSS bound" + samples := samples.set! row (samples[row]!.set! variantIndex (samples[row]![variantIndex]!.push sample)) + reconstructed := reconstructed.push (enriched sample variant id session index attempt buildHash freezeHash hash) + need (samples.all (fun row => row.all (·.size == 3))) "counter-fold block has missing paired rows" + observations := observations.push { samples, upstream := #[], initialRss } + need ((← readLines (measured / "samples.jsonl")) == reconstructed) "counter-fold combined samples differ from paired raw process records" + return (freeze, observations) + +def analyzeSuite (build measured output : FilePath) : IO Unit := do + fresh output + analysisSelfCheck + let (freeze, blocks) ← inspectMeasurement build measured + let hash := digest (← IO.FS.readBinFile (build / "build.json")) + freezeRegressions hash freeze + let indices := bootstrapIndices + let mut results := #[] + let mut report := "# Checked reserve/reuse counter folding\n\n" ++ + "One source function, two checked native lowerings, and identical C driver objects. " ++ + "The only loop rewrite removes four cancelling reservation/live counter changes (12 instructions per element). " ++ + "Every cell operation and cumulative reuse/payload counter update remains.\n\n" ++ + "Each row contains 30 paired blocks across three sessions, using each variant's median of three native samples per block. " ++ + "Operation counts are common within each row and frozen before measurement. Samples accumulate at least 100 ms. " ++ + "The paired speedup is baseline time divided by folded time; values above one favor folding. " ++ + "The 95% intervals use 10,000 hierarchical paired bootstrap draws, resampling sessions and then blocks (seed 2671931027). " ++ + "All valid slow samples are retained and the timer control is not subtracted. " ++ + "This is a shared host with a pinned worker, uncontrolled SMT sibling and only three session clusters; it establishes no CI timing threshold.\n\n" + for profile in [:2] do + report := report ++ s!"## {if profile == 0 then "Entry plus handoff" else "Complete lifecycle"}\n\n" ++ + "Nanoseconds per operation; lifecycle includes fresh construction, reversal, digest and full reclamation.\n\n" ++ + "| Length | Domain | Baseline ns | Folded ns | Paired speedup [95% interval] |\n" ++ + "| ---: | --- | ---: | ---: | ---: |\n" + for localId in [:19] do + let id := profile * 19 + localId + let specification := timingCases[id]! + let values ← variants.mapIdxM fun variantIndex _ => blocks.mapM fun block => do + return median (← block.samples[id]![variantIndex]!.mapM nsPerOp) + let stats := values.map (distribution indices) + let ratio := distribution indices (values[0]!.zipWith (· / ·) values[1]!) + let row := Json.mkObj [("row", toJson id), ("case", specification.json), + ("baseline_ns_per_operation", stats[0]!), ("folded_ns_per_operation", stats[1]!), + ("paired_speedup_baseline_over_folded", ratio)] + results := results.push row + report := report ++ s!"| {specification.length} | {domainName specification.domain} | " ++ + s!"{compactFloat (median values[0]!)} | {compactFloat (median values[1]!)} | " ++ + s!"{compactFloat (← statistic ratio "median")} [{compactFloat (← statistic ratio "ci95_low")}, {compactFloat (← statistic ratio "ci95_high")}] |\n" + report := report ++ "\n" + let mut resources := #[] + let mut code := #[] + report := report ++ "## Code and checking work\n\n" ++ + "The object text sizes below isolate the checked reversal and release functions. " ++ + "Generation and independent-gate CPU/wall/RSS records are diagnostic envelopes: generation includes pipeline construction and modeled fixture executions; " ++ + "each gate includes two fresh generations, decoding, corruption checks and a linked native harness. " ++ + "They are retained as complete costs, without attributing them to an isolated compiler or proof-checker phase.\n\n" ++ + "| Variant | Reversal `.text` bytes | Release `.text` bytes | Producer wall s | Gate wall s |\n" ++ + "| --- | ---: | ---: | ---: | ---: |\n" + for variant in variants do + let mut sizes := #[] + for role in ["main", "release"] do + let text ← IO.FS.readFile (build / s!"diagnostics/build/size-{variant}-{role}.stdout") + let line ← present ((text.splitOn "\n").find? (fun line => (words line).head? == some ".text")) "missing object text size" + let size ← present ((words line)[1]?.bind String.toNat?) "invalid object text size" + sizes := sizes.push size + let generation ← readJson (build / s!"diagnostics/build/produce-{variant}.resources.json") + let gate ← readJson (build / s!"diagnostics/build/independent-gate-{variant}.resources.json") + let pipeline ← IO.FS.readBinFile (build / s!"artifacts/{variant}/pipeline.json") + code := code.push (Json.mkObj [("variant", toJson variant), ("main_text_bytes", toJson sizes[0]!), + ("release_text_bytes", toJson sizes[1]!), ("pipeline_json_bytes", toJson pipeline.size), + ("generation_envelope", generation), ("independent_gate_envelope", gate)]) + report := report ++ s!"| {variant} | {sizes[0]!} | {sizes[1]!} | {← statistic generation "wall_seconds"} | {← statistic gate "wall_seconds"} |\n" + for index in [:2] do + let mut peak := 0 + let mut currentMin : Option Nat := none + let mut currentMax := 0 + for block in blocks do + for row in block.samples do + for sample in row[index]! do + let rss ← number sample "rss_kb" + currentMin := some (min rss (currentMin.getD rss)) + currentMax := max currentMax rss + peak := max peak (← number sample "peak_rss_kb") + resources := resources.push (Json.mkObj [("variant", toJson variants[index]!), + ("ready_rss_kb_median", toJson (median (blocks.map (fun block => block.initialRss[index]!.toFloat)))), + ("minimum_sample_rss_kb", toJson currentMin), ("maximum_sample_rss_kb", toJson currentMax), + ("maximum_recorded_peak_rss_kb", toJson peak)]) + writeJson (output / "summary.json") (Json.mkObj [("format", toJson "compilatrix/counter-fold-analysis/1"), + ("build_blake3", toJson hash), ("freeze_blake3", toJson (digest (← IO.FS.readBinFile (measured / "freeze.json")))), + ("measurement_blake3", toJson (digest (← IO.FS.readBinFile (measured / "measurement.json")))), + ("environment", ← field freeze "environment"), ("timing_policy", timingPolicy), ("results", toJson results), + ("code_and_checking", toJson code), ("process_memory", toJson resources)]) + IO.FS.writeFile (output / "report.md") report + IO.println "counter-fold analysis: 38 paired comparisons, uncertainty, code/checking costs and process memory validated" + +def reproduceSuite (build measured output : FilePath) : IO Unit := do + let build ← absolute build + let measured ← absolute measured + let output ← absolute output + let (_, _) ← inspectMeasurement build measured + fresh output + let metadata ← inspectBuild build + let environment ← checked (fromJson? (← field metadata "build_environment") : Except String (Array (String × Option String))) + need (environment.map Prod.fst == buildEnvNames) "counter-fold replay environment inventory disagrees" + for row in (← array (← readJson (build / "tool-identities.json"))) do + need (digest (← IO.FS.readBinFile (← strField row "resolved")) == (← strField row "blake3")) "counter-fold installed tool drift" + let snapshot ← readJson (build / "source.json") + need (digest (← IO.FS.readBinFile (build / "source.tar.gz")) == (← strField snapshot "archive_blake3")) "counter-fold source archive digest disagrees" + let source := output / "source" + IO.FS.createDirAll source + let inventory ← arrField snapshot "files" + let names ← inventory.mapM (fun row => strField row "path") + need (names.toList.Nodup && names.all (fun name => !name.startsWith "/" && + !(name.splitOn "/").any (fun part => part == ".." || part.isEmpty))) "unsafe counter-fold source inventory" + let listing := (← run "tar" #["-tzf", (build / "source.tar.gz").toString]).trimAscii.toString.splitOn "\n" + need (listing.mergeSort (· ≤ ·) == names.toList.mergeSort (· ≤ ·)) "counter-fold source tar inventory disagrees" + let _ ← run "tar" #["--no-same-owner", "--no-same-permissions", "-xzf", (build / "source.tar.gz").toString, "-C", source.toString] + for row in inventory do + let bytes ← IO.FS.readBinFile (source / (← strField row "path")) + need (bytes.size == (← number row "bytes") && digest bytes == (← strField row "blake3")) "counter-fold extracted source differs" + IO.FS.createDirAll (source / ".lake/build/bin") + for path in (← files (build / "tools-bin")) do + let _ ← run "cp" #[path.toString, (source / ".lake/build/bin" / path.fileName.getD "missing").toString] + let runner := (source / ".lake/build/bin/compiler-benchmark").toString + let rebuilt := output / "build" + replayCommand source environment runner #["counter-fold-build", rebuilt.toString, "--gcc", ← strField metadata "gcc", + "--time", ← strField metadata "timer_tool"] (output / "rebuild.jsonl") + let rebuiltMetadata ← inspectBuild rebuilt + for key in ["artifacts", "executables", "tools", "goldens", "datasets_blake3", "protocol_blake3"] do + need ((← field rebuiltMetadata key) == (← field metadata key)) s!"counter-fold independent rebuild changed {key}" + replayCommand source environment runner #["counter-fold-verify", rebuilt.toString, (output / "correctness").toString] (output / "verify.jsonl") + let original ← arrField (← readJson (measured / "correctness.json")) "matrices" + let repeated ← arrField (← readJson (output / "correctness/correctness.json")) "matrices" + need (original.size == 2 && repeated.size == 2) "counter-fold replay matrix inventory changed" + for i in [:2] do + need ((← field original[i]! "result") == (← field repeated[i]! "result")) "counter-fold independent matrix differs" + replayCommand source environment runner #["counter-fold-analyze", build.toString, measured.toString, + (output / "analysis").toString] (output / "analysis.jsonl") + for file in ["summary.json", "report.md"] do + need ((← IO.FS.readBinFile (output / "analysis" / file)) == (← IO.FS.readBinFile (measured / "analysis" / file))) + s!"counter-fold independent analysis changed {file}" + writeJson (output / "reproduction.json") (Json.mkObj [("format", toJson "compilatrix/counter-fold-reproduction/1"), + ("source_archive_blake3", ← field snapshot "archive_blake3"), ("original_build_blake3", toJson (digest (← IO.FS.readBinFile (build / "build.json")))), + ("rebuilt_build_blake3", toJson (digest (← IO.FS.readBinFile (rebuilt / "build.json")))), ("source_files", toJson inventory.size), + ("artifacts_exact", toJson true), ("executables_exact", toJson true), ("correctness_exact", toJson true), ("analysis_exact", toJson true), + ("scope", toJson "fresh extracted source, empty process environment plus recorded variables, hashed producer/checker seeds, same host and pinned Nix closure"), + ("timing_samples_rerun", toJson false), ("status", toJson "passed")]) + IO.println "counter-fold reproduction: exact rebuilt objects, executables, complete results and retained-sample analysis passed" + +end Benchmarks.Compiler.CounterFold diff --git a/Benchmarks/Compiler/CounterFoldBuild.lean b/Benchmarks/Compiler/CounterFoldBuild.lean new file mode 100644 index 000000000..20ae1101d --- /dev/null +++ b/Benchmarks/Compiler/CounterFoldBuild.lean @@ -0,0 +1,182 @@ +import Benchmarks.Compiler.Schedule + +namespace Benchmarks.Compiler.CounterFold +open Lean System Ix.Compiler.Tools.Check Ix.Compiler.Tools.UniqueCheck + +def variants : Array String := #["baseline", "counter-fold"] + +def inspectBuild (build : FilePath) : IO Json := do + checkData + let metadata ← readJson (build / "build.json") + need ((← strField metadata "format") == "compilatrix/counter-fold-build/1" && + (← field metadata "variants") == toJson variants) "counter-fold build policy disagrees" + need ((← IO.FS.readBinFile (build / "datasets/datasets.bin")) == datasetBytes && + (← readJson (build / "datasets/datasets.json")) == datasetJson && + (← strField metadata "datasets_blake3") == digest datasetBytes) "counter-fold dataset drift" + for (directory, key) in [("artifacts", "artifacts"), ("bin", "executables"), ("tools-bin", "tools"), ("goldens", "goldens")] do + inspectFiles (build / directory) (← field metadata key) + need (digest (← IO.FS.readBinFile (build / "tool-identities.json")) == (← strField metadata "tool_identities_blake3") && + digest (← IO.FS.readBinFile (build / "protocol.md")) == (← strField metadata "protocol_blake3")) "counter-fold tool/protocol drift" + let baseline ← readJson (build / "artifacts/baseline/report.json") + let folded ← readJson (build / "artifacts/counter-fold/report.json") + for variant in variants do + need ((← readJson (build / s!"artifacts/{variant}/report.json")) == + (← readJson (build / s!"goldens/{variant}.json"))) "counter-fold artifact differs from reviewed golden" + for key in ["source_identity", "ixir1_root", "adapter_and_selection_rejections"] do + need ((← field baseline key) == (← field folded key)) "paired source or fallback behavior differs" + let original ← arrField baseline "cases" + let improved ← arrField folded "cases" + need (original.size == 8 && improved.size == 8) "paired artifact case inventory disagrees" + for i in [:8] do + for key in ["name", "input", "value", "release_steps", "rejections"] do + need ((← field original[i]! key) == (← field improved[i]! key)) "paired artifact semantics differ" + let count := (← arrField original[i]! "input").size + need ((← number original[i]! "main_steps") == 42 * count + 82 && + (← number improved[i]! "main_steps") == 30 * count + 82) "paired instruction cost disagrees" + return metadata + +def buildSuite (output : FilePath) (gcc : String := "gcc") (timerTool : String := "time") : IO Unit := do + let output ← absolute output + fresh output + for directory in ["bin", "artifacts/driver", "tools-bin", "goldens", "diagnostics/build"] do + IO.FS.createDirAll (output / directory) + writeDatasets (output / "datasets") + IO.FS.writeFile (output / "protocol.md") (← IO.FS.readFile "Benchmarks/Compiler/counter-fold.md") + let logs := output / "diagnostics/build" + let flags := cFlags ++ #[s!"-ffile-prefix-map={output}=/counter-fold-build"] + let version ← logged logs "gcc-version" gcc #["--version"] #[] none timerTool + need (version.contains "14.3.0") "counter-fold requires pinned GCC 14.3.0" + let _ ← logged logs "worker-launcher" gcc + (flags ++ #["-Wall", "-Wextra", "-Werror", "Benchmarks/Compiler/native/worker_launcher.c", "-o", (output / "bin/worker-launcher").toString]) #[] none timerTool + for name in ["common", "driver", "arena_backend"] do + let _ ← logged logs s!"driver-{name}" gcc (flags ++ #["-Wall", "-Wextra", "-Werror", "-c", + s!"Benchmarks/Compiler/native/{name}.c", "-o", (output / s!"artifacts/driver/{name}.o").toString]) #[] none timerTool + let driver := #["common", "driver", "arena_backend"].map fun name => (output / s!"artifacts/driver/{name}.o").toString + for variant in variants do + let artifacts := output / s!"artifacts/{variant}" + let options := if variant == "counter-fold" then #["--counter-fold"] else #[] + let _ ← logged logs s!"produce-{variant}" ".lake/build/bin/compiler-source-native-runtime" (options ++ #[artifacts.toString]) #[] none timerTool + let expected := if variant == "counter-fold" then "expected-counter-fold.json" else "expected.json" + IO.FS.writeFile (output / s!"goldens/{variant}.json") (← IO.FS.readFile s!"Tests/Fixtures/Compiler/source-native-runtime/{expected}") + let _ ← logged logs s!"independent-gate-{variant}" ".lake/build/bin/compiler-check-source-native-runtime" + #["--fixture", ".lake/build/bin/compiler-source-native-runtime", "--variant", variant, "--artifacts", artifacts.toString, "--cc", gcc, + "--harness", "Tests/Fixtures/Compiler/source-native-runtime/native_harness.c"] #[] none timerTool + let _ ← logged logs s!"link-{variant}" gcc (flags ++ driver ++ + #[(artifacts / "main.o").toString, (artifacts / "release.o").toString, + "-Wl,-z,noexecstack", "-o", (output / s!"bin/{variant}").toString]) #[] none timerTool + for role in ["main", "release"] do + let _ ← logged logs s!"size-{variant}-{role}" "size" #["-A", (artifacts / s!"{role}.o").toString] #[] none timerTool + let _ ← logged logs s!"disassembly-{variant}-{role}" "objdump" #["-d", (artifacts / s!"{role}.o").toString] #[] none timerTool + let _ ← logged logs s!"size-{variant}" "size" #["-A", (output / s!"bin/{variant}").toString] #[] none timerTool + let _ ← logged logs s!"dependencies-{variant}" "ldd" #[(output / s!"bin/{variant}").toString] #[] none timerTool + let mut identities := #[] + let mut roots : Array String := #[] + for (name, command) in [("gcc", gcc), ("lean", "lean"), ("lake", "lake"), ("time", timerTool)] do + let path := (← run "which" #[command]).trimAscii.toString + let resolved := (← run "readlink" #["-f", path]).trimAscii.toString + identities := identities.push (Json.mkObj [("name", toJson name), ("resolved", toJson resolved), + ("blake3", toJson (digest (← IO.FS.readBinFile resolved)))]) + if resolved.startsWith "/nix/store/" then + let root := String.intercalate "/" ((resolved.splitOn "/").take 4) + if !roots.contains root then roots := roots.push root + writeJson (output / "tool-identities.json") (Json.arr identities) + let closure ← IO.Process.output { cmd := "nix-store", args := #["--query", "--requisites"] ++ roots } + IO.FS.writeFile (output / "nix-closure.txt") closure.stdout + writeJson (output / "nix-closure-status.json") (Json.mkObj [("roots", toJson roots), + ("exit_code", toJson closure.exitCode.toNat), ("stderr", toJson closure.stderr)]) + for name in ["benchmark", "source-native-runtime", "check-source-native-runtime"] do + let _ ← run "cp" #[s!".lake/build/bin/compiler-{name}", (output / s!"tools-bin/compiler-{name}").toString] + writeJson (output / "build.json") (Json.mkObj [ + ("format", toJson "compilatrix/counter-fold-build/1"), ("variants", toJson variants), + ("gcc", toJson gcc), ("timer_tool", toJson timerTool), ("gcc_version", toJson version), + ("build_environment", toJson (← buildEnvNames.mapM fun name => do return (name, ← IO.getEnv name))), + ("datasets_blake3", toJson (digest datasetBytes)), ("artifacts", ← recordFiles (output / "artifacts")), + ("executables", ← recordFiles (output / "bin")), ("tools", ← recordFiles (output / "tools-bin")), + ("goldens", ← recordFiles (output / "goldens")), + ("tool_identities_blake3", toJson (digest (← IO.FS.readBinFile (output / "tool-identities.json")))), + ("protocol_blake3", toJson (digest (← IO.FS.readBinFile (output / "protocol.md"))))]) + let _ ← inspectBuild output + let _ ← sourceSnapshot output + IO.println s!"counter-fold build: two checked variants, identical driver objects, retained source and native artifacts in {output}" + +def runScheduled (build output : FilePath) (variant : String) (schedule : Schedule) (core : Nat) : IO (Array Json) := do + need (variants.contains variant) "unknown counter-fold variant" + writeSchedule (output.withExtension "bin") schedule + let result ← streamed { cmd := "taskset", args := #["--cpu-list", toString core, + (build / "bin/worker-launcher").toString, (build / s!"bin/{variant}").toString, + "compilatrix", "run", (build / "datasets/datasets.bin").toString, (output.withExtension "bin").toString], env := runtimeEnv } output + IO.FS.writeFile (output.withExtension "stderr") result.stderr + writeJson (output.withExtension "process.json") (Json.mkObj [("variant", toJson variant), + ("executable_blake3", toJson (digest (← IO.FS.readBinFile (build / s!"bin/{variant}")))), + ("exit_code", toJson result.exitCode.toNat), ("core", toJson core), ("schedule", toJson schedule), + ("schedule_blake3", toJson (digest schedule.bytes)), ("stdout_blake3", toJson (digest result.stdout.toUTF8))]) + need (result.exitCode == 0) s!"counter-fold {variant} failed: {result.stderr}" + inspectRun "compilatrix" schedule (← readLines output) (schedule.mode == 2) + +def verifySuite (build output : FilePath) : IO Unit := do + let build ← absolute build + let output ← absolute output + fresh output + let metadata ← inspectBuild build + let timer ← strField metadata "timer_tool" + let mut summaries := #[] + let mut matrixIdentity : Option Json := none + for variant in variants do + let result ← logged (output / "logs") s!"matrix-{variant}" (build / s!"bin/{variant}").toString + #["compilatrix", "verify", (build / "datasets/datasets.bin").toString] runtimeEnv none timer + IO.FS.writeFile (output / s!"{variant}.jsonl") result + let rows ← readLines (output / s!"{variant}.jsonl") + let start ← IO.monoNanosNow + let summary ← inspectMatrix "compilatrix" rows + checkerRegressions "compilatrix" rows + let checkNs := (← IO.monoNanosNow) - start + let identity ← field summary "matrix_blake3" + if let some expected := matrixIdentity then need (identity == expected) "paired complete arena observations differ" + matrixIdentity := some identity + summaries := summaries.push (Json.mkObj [("variant", toJson variant), ("result", summary), ("independent_check_ns", toJson checkNs)]) + IO.println s!"counter-fold verify: {variant}, 585 inputs and 19305 complete arena observations" + let mut negatives := #[] + for (name, bytes, reason) in [ + ("magic", datasetBytes.set! 0 0, "wrong binary magic"), + ("count", datasetBytes.set! 8 0, "wrong dataset inventory"), + ("metadata", datasetBytes.set! 16 1, "noncanonical dataset metadata"), + ("padding", datasetBytes.set! 48 1, "nonzero dataset padding"), + ("trailing", datasetBytes.push 0, "trailing binary input"), + ("truncated", datasetBytes.extract 0 (datasetBytes.size - 1), "truncated binary input")] do + let path := output / s!"bad-{name}.bin" + IO.FS.writeBinFile path bytes + for variant in variants do + let result ← IO.Process.output { + cmd := (build / s!"bin/{variant}").toString, + args := #["compilatrix", "verify", path.toString], env := runtimeEnv } + need (result.exitCode != 0 && result.stderr.contains reason) s!"{variant} accepted malformed dataset {name}" + negatives := negatives.push (Json.mkObj [("variant", toJson variant), ("case", toJson name), + ("exit_code", toJson result.exitCode.toNat), ("stderr", toJson result.stderr)]) + let _ ← inspectBuild build + writeJson (output / "correctness.json") (Json.mkObj [("format", toJson "compilatrix/counter-fold-correctness/1"), + ("build_blake3", toJson (digest (← IO.FS.readBinFile (build / "build.json")))), + ("executables", ← field metadata "executables"), ("matrices", Json.arr summaries), + ("malformed_datasets", Json.arr negatives), ("status", toJson "passed")]) + +def smokeSuite (build output : FilePath) (core : Nat) : IO Unit := do + let build ← absolute build + fresh output + let metadata ← inspectBuild build + let schedule : Schedule := { + mode := 0, samples := 1, warmNs := 10000000, + order := (List.range 38).toArray, operations := Array.replicate 38 (chunkSize * 6) } + let mut samples := #[] + for variant in variants do + let rows ← runScheduled build (output / s!"{variant}.jsonl") variant schedule core + samples := samples ++ rows + need (samples.size == 76) "counter-fold smoke inventory disagrees" + let first ← readLines (output / "baseline.jsonl") + rejects "missing paired sample" "run inventory" (inspectRun "compilatrix" schedule (first.pop) *> pure ()) + for (key, value, reason) in [("operations", toJson (1 : Nat), "sample identity"), + ("sink", toJson (0 : Nat), "timed sink"), ("elapsed_ns", toJson (0 : Nat), "timer/chunk")] do + rejects key reason (inspectSample "compilatrix" 0 0 0 (chunkSize * 6) (← replaceAt samples[0]! [key] value)) + writeJson (output / "smoke.json") (Json.mkObj [("format", toJson "compilatrix/counter-fold-smoke/1"), + ("executables", ← field metadata "executables"), ("samples", toJson samples), ("status", toJson "passed")]) + IO.println "counter-fold smoke: both executables, 76 timing rows, full results and sample corruption checks passed" + +end Benchmarks.Compiler.CounterFold diff --git a/Benchmarks/Compiler/CounterFoldRun.lean b/Benchmarks/Compiler/CounterFoldRun.lean new file mode 100644 index 000000000..1e87b100e --- /dev/null +++ b/Benchmarks/Compiler/CounterFoldRun.lean @@ -0,0 +1,184 @@ +import Benchmarks.Compiler.CounterFoldBuild +import Benchmarks.Compiler.Analyze + +namespace Benchmarks.Compiler.CounterFold +open Lean System Ix.Compiler.Tools.Check Ix.Compiler.Tools.UniqueCheck + +def requireCorrectness (build correctness : FilePath) : IO Unit := do + let result ← readJson (correctness / "correctness.json") + let metadata ← inspectBuild build + need ((← strField result "format") == "compilatrix/counter-fold-correctness/1" && + (← strField result "status") == "passed" && (← strField result "build_blake3") == + digest (← IO.FS.readBinFile (build / "build.json")) && + (← field result "executables") == (← field metadata "executables")) "counter-fold correctness identity disagrees" + +def frozenBlocks (counts : Array Nat) : Array Json := Id.run do + let mut state := orderSeed + let mut blocks := #[] + for block in [:blockCount] do + let (order, next) := shuffled (List.range 38).toArray state + let (variantOrder, next) := shuffled #[0, 1] next + state := next + let schedule : Schedule := { mode := 2, samples := 3, warmNs := 1000000000, order, operations := counts } + blocks := blocks.push (Json.mkObj [("block", toJson block), ("session", toJson (block / 10)), + ("variant_order", toJson (variantOrder.map (variants[·]!))), ("schedule", toJson schedule)]) + return blocks + +def timingPolicy : Json := Json.mkObj [ + ("minimum_sample_ns", toJson minimumNs), ("pilot_target_ns", toJson pilotTargetNs), + ("order_seed", toJson orderSeed.toNat), ("resource_bound_rss_kb", toJson (2097152 : Nat)), + ("timer_chunk_minimum_factor", toJson (100 : Nat)), ("session_separation_seconds", toJson (60 : Nat)), + ("bootstrap_replicates", toJson (10000 : Nat)), ("bootstrap_seed", toJson (2671931027 : Nat)), + ("bootstrap", toJson "hierarchical paired bootstrap: resample three sessions, then ten whole paired blocks within each selected session")] + +def inspectFreezeValue (buildHash : String) (freeze : Json) : IO Unit := do + need ((← strField freeze "format") == "compilatrix/counter-fold-freeze/1" && + (← strField freeze "build_blake3") == buildHash && + (← field freeze "timing_policy") == timingPolicy) "counter-fold frozen identity or timing policy changed" + let counts ← (← arrField freeze "operations").mapM nat + let blocks ← arrField freeze "blocks" + need (blocks == frozenBlocks counts) "counter-fold frozen randomized order changed" + for block in blocks do + let schedule ← checked (fromJson? (← field block "schedule") : Except String Schedule) + need schedule.valid "counter-fold frozen schedule invalid" + +def inspectFreeze (build pilot : FilePath) : IO Json := do + let freeze ← readJson (pilot / "freeze.json") + inspectFreezeValue (digest (← IO.FS.readBinFile (build / "build.json"))) freeze + return freeze + +def freezeRegressions (hash : String) (freeze : Json) : IO Unit := do + for (name, path, value, reason) in [ + ("build", ["build_blake3"], toJson "different", "frozen identity"), + ("floor", ["timing_policy", "minimum_sample_ns"], toJson (1 : Nat), "timing policy"), + ("bootstrap", ["timing_policy", "bootstrap_seed"], toJson (1 : Nat), "timing policy"), + ("missing block", ["blocks"], Json.arr #[], "randomized order")] do + rejects name reason (inspectFreezeValue hash (← replaceAt freeze path value)) + let blocks ← arrField freeze "blocks" + let changed ← replaceAt blocks[0]! ["variant_order"] (toJson #["baseline", "baseline"]) + rejects "duplicate variant" "randomized order" + (inspectFreezeValue hash (← replaceAt freeze ["blocks"] (toJson (blocks.set! 0 changed)))) + +def pilotSuite (build correctness output : FilePath) (core : Nat) : IO Unit := do + let build ← absolute build + let output ← absolute output + requireCorrectness build correctness + fresh output + let before ← environment core + writeJson (output / "environment-start.json") before + environmentRegressions before + let initial : Schedule := { + mode := 1, samples := 1, warmNs := 1000000000, + order := (List.range 38).toArray, operations := Array.replicate 38 (chunkSize * 6) } + let mut counts := initial.operations + let mut estimates := #[] + for variant in variants do + let samples ← runScheduled build (output / s!"initial-{variant}.jsonl") variant initial core + for row in samples do + let id ← number row "row" + let operations ← number row "operations" + let elapsed ← number row "elapsed_ns" + counts := counts.set! id (max counts[id]! (roundOperations ((operations * pilotTargetNs + elapsed - 1) / elapsed))) + estimates := estimates.push (Json.mkObj [("variant", toJson variant), ("observation", row)]) + IO.println s!"counter-fold pilot: initial {variant} complete" + let schedule := { initial with operations := counts } + let mut confirmation := #[] + for variant in variants do + let samples ← runScheduled build (output / s!"confirmation-{variant}.jsonl") variant schedule core + for row in samples do + need ((← number row "elapsed_ns") >= minimumNs) s!"new premeasurement calibration required: {variant}" + confirmation := confirmation.push (Json.mkObj [("variant", toJson variant), ("observation", row)]) + IO.println s!"counter-fold pilot: confirmed {variant}" + let after ← environment core + writeJson (output / "environment-end.json") after + need (← stableEnvironment before after) "counter-fold pilot environment drift" + let _ ← inspectBuild build + let hash := digest (← IO.FS.readBinFile (build / "build.json")) + let freeze := Json.mkObj [("format", toJson "compilatrix/counter-fold-freeze/1"), ("build_blake3", toJson hash), + ("environment", before), ("core", toJson core), ("timing_policy", timingPolicy), ("operations", toJson counts), + ("blocks", toJson (frozenBlocks counts)), ("initial_estimates", toJson estimates), ("confirmation", toJson confirmation)] + inspectFreezeValue hash freeze + freezeRegressions hash freeze + writeJson (output / "freeze.json") freeze + IO.println "counter-fold pilot: common counts frozen for 30 paired blocks in three sessions" + +def enriched (sample : Json) (variant : String) (block session order attempt : Nat) + (buildHash freezeHash executableHash : String) : Json := + Json.mkObj [("variant", toJson variant), + ("sample", Benchmarks.Compiler.enriched sample block session order attempt buildHash freezeHash executableHash)] + +def measureSuite (build correctness pilot output : FilePath) (core : Nat) : IO Unit := do + let build ← absolute build + let output ← absolute output + requireCorrectness build correctness + let freeze ← inspectFreeze build pilot + need ((← number freeze "core") == core) "counter-fold measurement core differs from pilot" + let reference ← field freeze "environment" + let initial ← environment core + need (← stableEnvironment reference initial) "counter-fold measurement environment differs from pilot" + fresh output + for (source, name) in [(pilot, "freeze.json"), (correctness, "correctness.json")] do + IO.FS.writeFile (output / name) (← IO.FS.readFile (source / name)) + writeJson (output / "environment-start.json") initial + let buildHash := digest (← IO.FS.readBinFile (build / "build.json")) + let freezeHash := digest (← IO.FS.readBinFile (output / "freeze.json")) + let combined ← IO.FS.Handle.mk (output / "samples.jsonl") .write + let mut completed := #[] + for block in (← arrField freeze "blocks") do + let id ← number block "block" + let session ← number block "session" + if id > 0 && id % 10 == 0 then + IO.println s!"counter-fold measurement: session {session + 1} after the frozen 60-second idle interval" + IO.sleep 60000 + let schedule ← checked (fromJson? (← field block "schedule") : Except String Schedule) + let order ← (← arrField block "variant_order").mapM string + let mut accepted := false + for attempt in [:3] do + if accepted then break + let directory := output / s!"session-{session}/block-{id}/attempt-{attempt}" + IO.FS.createDirAll directory + let before ← environment core + writeJson (directory / "environment-start.json") before + let mut samples := #[] + let mut reason : Option String := none + try + need (← stableEnvironment reference before) "environment drift before block" + let _ ← inspectBuild build + for index in [:order.size] do + let variant := order[index]! + let hash := digest (← IO.FS.readBinFile (build / s!"bin/{variant}")) + IO.println s!"counter-fold measurement: session {session + 1}/3, block {id + 1}/30, {variant}" + let rows ← runScheduled build (directory / s!"{variant}.jsonl") variant schedule core + for row in rows do + need ((← number row "peak_rss_kb") <= 2097152) "resource RSS bound exceeded" + samples := samples.push (enriched row variant id session index attempt buildHash freezeHash hash) + let after ← environment core + writeJson (directory / "environment-end.json") after + need (← stableEnvironment reference after) "environment drift after block" + let _ ← inspectBuild build + catch error => reason := some error.toString + let status := Json.mkObj [("block", toJson id), ("session", toJson session), ("attempt", toJson attempt), + ("status", toJson (if reason.isSome then "invalid" else "valid")), ("reason", toJson reason), ("samples", toJson samples.size)] + writeJson (directory / "status.json") status + if let some failure := reason then + IO.println s!"counter-fold measurement: retained invalid complete-block attempt {id}/{attempt}: {failure}" + need (["environment drift", "shorter than 100 ms", "does not dominate timer", "resource RSS bound"].any (fun fragment => failure.contains fragment)) + s!"correctness or artifact failure; publication stopped: {failure}" + else + need (samples.size == 228) "counter-fold paired block is incomplete" + for sample in samples do combined.putStrLn sample.compress + combined.flush + completed := completed.push status + writeJson (output / "progress.json") (Json.mkObj [("valid_blocks", toJson completed), ("complete", toJson false)]) + accepted := true + need accepted s!"block {id} exhausted three retained attempts" + let final ← environment core + writeJson (output / "environment-end.json") final + need (← stableEnvironment reference final) "environment drift at measurement completion" + writeJson (output / "measurement.json") (Json.mkObj [("format", toJson "compilatrix/counter-fold-measurement/1"), + ("build_blake3", toJson buildHash), ("freeze_blake3", toJson freezeHash), ("valid_blocks", toJson completed), + ("samples", toJson (6840 : Nat)), ("samples_blake3", toJson (digest (← IO.FS.readBinFile (output / "samples.jsonl")))), + ("status", toJson "complete")]) + IO.println "counter-fold measurement: 6840 samples, all 38 rows, 30 paired blocks, three sessions complete" + +end Benchmarks.Compiler.CounterFold diff --git a/Benchmarks/Compiler/Data.lean b/Benchmarks/Compiler/Data.lean new file mode 100644 index 000000000..5f154393f --- /dev/null +++ b/Benchmarks/Compiler/Data.lean @@ -0,0 +1,159 @@ +import Ix.Compiler.Tools.UniqueCheck + +namespace Benchmarks.Compiler + +open Lean Ix.Compiler.Tools.Check Ix.Compiler.Tools.UniqueCheck + +def workload : String := "native-reverse/1" +def datasetMagic : String := "CPBN001\n" +def scheduleMagic : String := "CPBS001\n" +def baseSeed : UInt64 := 0x6a09e667f3bcc909 +def chunkSize : Nat := 4096 +def primaryLimit : Nat := 2^30 + +def word? (value : Nat) : Option UInt64 := + if value < UInt64.size then some value.toUInt64 else none + +structure Input where + id : Nat + length : Nat + pattern : Nat + domain : Nat + seed : UInt64 + values : Array UInt64 + deriving Inhabited + +def Input.name (input : Input) : String := + s!"n{input.length}-p{input.pattern}" + +def patternName (pattern : Nat) : String := + (#[("zero" : String), "repeated", "ascending", "descending", "alternating", "random", + "2^63-1", "2^63", "2^64-1"])[pattern]! + +def domainName (domain : Nat) : String := + (#[("primary" : String), "stress-2^63-1", "stress-2^63", "stress-2^64-1"])[domain]! + +def nextRandom (state : UInt64) : UInt64 := + let state := state ^^^ (state >>> 12) + let state := state ^^^ (state <<< 25) + state ^^^ (state >>> 27) + +def input (length pattern : Nat) : Input := Id.run do + let seed := baseSeed ^^^ ((length.toUInt64 + 1) * 0x9e3779b97f4a7c15) + let mut state := seed + let mut values := #[] + for index in [:length] do + state := nextRandom state + let value : UInt64 := match pattern with + | 0 => 0 + | 1 => 17 + | 2 => index.toUInt64 + | 3 => (length - index - 1).toUInt64 + | 4 => if index % 2 == 0 then 0 else (primaryLimit - 1).toUInt64 + | 5 => (state * 0x2545f4914f6cdd1d) &&& (primaryLimit - 1).toUInt64 + | 6 => 0x7fffffffffffffff + | 7 => 0x8000000000000000 + | _ => 0xffffffffffffffff + values := values.push value + return { id := length * 9 + pattern, length, pattern + domain := if pattern < 6 then 0 else pattern - 5 + seed, values } + +def inputs : Array Input := Id.run do + let mut cases := #[] + for length in [:65] do + for pattern in [:9] do cases := cases.push (input length pattern) + return cases + +/-- Each list contributes a word-sized, order- and payload-sensitive digest. +All arithmetic wraps modulo 2^64. Full correctness compares every value. -/ +def listDigest (values : Array UInt64) : UInt64 := + values.foldl (fun hash value => (hash ^^^ value) * 0x100000001b3) 0xcbf29ce484222325 + +def Input.expectedDigest (input : Input) : UInt64 := listDigest input.values.reverse + +def wordBytes (value : UInt64) : ByteArray := Id.run do + let mut bytes := ByteArray.empty + for index in [:8] do bytes := bytes.push (value >>> (8 * index).toUInt64).toUInt8 + return bytes + +def Input.bytes (input : Input) : ByteArray := Id.run do + let mut bytes := wordBytes input.length.toUInt64 ++ wordBytes input.pattern.toUInt64 ++ + wordBytes input.domain.toUInt64 ++ wordBytes input.seed + for index in [:64] do bytes := bytes ++ wordBytes (input.values[index]?.getD 0) + return bytes + +def datasetBytes : ByteArray := + inputs.foldl (fun bytes input => bytes ++ input.bytes) + (datasetMagic.toUTF8 ++ wordBytes inputs.size.toUInt64) + +def Input.json (input : Input) : Json := + Json.mkObj [ + ("id", toJson input.id), ("name", toJson input.name), ("length", toJson input.length), + ("pattern", toJson (patternName input.pattern)), ("domain", toJson (domainName input.domain)), + ("seed", toJson input.seed.toNat), ("values", toJson (input.values.map UInt64.toNat)), + ("expected", toJson (input.values.reverse.map UInt64.toNat)), + ("expected_digest", toJson input.expectedDigest.toNat)] + +structure TimingCase where + length : Nat + domain : Nat + profile : Nat + deriving BEq, Repr, Inhabited + +def TimingCase.profileName (row : TimingCase) : String := + if row.profile == 0 then "entry+handoff" else "lifecycle" + +def TimingCase.name (row : TimingCase) : String := + s!"{domainName row.domain}-n{row.length}-{row.profileName}" + +def TimingCase.inputIds (row : TimingCase) : Array Nat := + if row.domain == 0 then (List.range 6).toArray.map (row.length * 9 + ·) + else #[row.length * 9 + row.domain + 5] + +def timingCases : Array TimingCase := Id.run do + let mut rows := #[] + for profile in [:2] do + for length in [0, 1, 2, 4, 8, 16, 32, 48, 63, 64] do + rows := rows.push { length, domain := 0, profile } + for domain in [1, 2, 3] do + for length in [1, 16, 64] do rows := rows.push { length, domain, profile } + return rows + +def TimingCase.json (row : TimingCase) : Json := + Json.mkObj [("name", toJson row.name), ("length", toJson row.length), + ("domain", toJson (domainName row.domain)), ("profile", toJson row.profileName), + ("input_ids", toJson row.inputIds), ("capacity", toJson (row.length + 2))] + +def datasetJson : Json := + Json.mkObj [ + ("format", toJson "compilatrix/benchmark-datasets/1"), ("workload", toJson workload), + ("generator", toJson "xorshift64star-patterns/1"), ("seed", toJson baseSeed.toNat), + ("binary", toJson "datasets.bin"), ("binary_bytes", toJson datasetBytes.size), + ("binary_blake3", toJson (digest datasetBytes)), + ("cases", toJson (inputs.map Input.json)), ("timing_cases", toJson (timingCases.map TimingCase.json))] + +def checkData : IO Unit := do + need (inputs.size == 585 && datasetBytes.size == 318256 && timingCases.size == 38) + "benchmark dataset inventory drifted" + need (word? UInt64.size == none && word? (UInt64.size + 1) == none && + (word? (UInt64.size - 1)).map UInt64.toNat == some (UInt64.size - 1)) + "benchmark Word admission wrapped a Nat" + let mut capacityCases := 0 + for index in [:inputs.size] do + let input := inputs[index]! + need (input.id == index && input.length ≤ 64 && input.values.size == input.length && input.bytes.size == 544) + "benchmark input shape disagrees" + if input.domain == 0 then + need (input.values.all (fun word => word.toNat < primaryLimit)) "primary input needs boxing outside the common range" + capacityCases := capacityCases + (65 - input.length) + need (capacityCases == 19305) "benchmark capacity inventory drifted" + +def writeDatasets (output : System.FilePath) : IO Unit := do + checkData + need (!(← output.pathExists)) "benchmark datasets require a fresh output directory" + IO.FS.createDirAll output + IO.FS.writeBinFile (output / "datasets.bin") datasetBytes + IO.FS.writeFile (output / "datasets.json") (datasetJson.pretty 120 ++ "\n") + +end Benchmarks.Compiler diff --git a/Benchmarks/Compiler/Diagnostics.lean b/Benchmarks/Compiler/Diagnostics.lean new file mode 100644 index 000000000..df2a429d6 --- /dev/null +++ b/Benchmarks/Compiler/Diagnostics.lean @@ -0,0 +1,139 @@ +import Benchmarks.Compiler.Analyze + +namespace Benchmarks.Compiler +open Lean System Ix.Compiler.Tools.Check Ix.Compiler.Tools.UniqueCheck + +def collectionDiagnostic (build output : FilePath) (core : Nat) (schedule : Schedule) + (measurement : Bool) : IO Json := do + let path := output / "cakeml-gc.jsonl" + writeSchedule (path.withExtension "bin") schedule + let result ← streamed { cmd := "taskset", args := #["--cpu-list", toString core, + (build / "bin/worker-launcher").toString, + (build / "bin/cakeml-diagnostic").toString, "cakeml", "run", (build / "datasets/datasets.bin").toString, + (path.withExtension "bin").toString], env := runtimeEnv } path + IO.FS.writeFile (path.withExtension "stderr") result.stderr + need (result.exitCode == 0) "CakeML collection diagnostic failed" + let rows ← readLines path + let mut nativeRows := #[] + let mut collectionRows := #[] + let mut terminal : Option Json := none + for row in rows do + match ← kind row with + | "gc-sample" => collectionRows := collectionRows.push row + | "terminal-gc" => + need terminal.isNone "duplicate terminal collection record" + terminal := some row + | _ => nativeRows := nativeRows.push row + let samples ← inspectRun "cakeml" schedule nativeRows measurement + need (collectionRows.size == schedule.order.size * schedule.samples) "incomplete collection diagnostic" + let mut collections := 0 + let mut lastTotal := 0 + let mut maximumLive := 0 + let mut liveValues : Array Nat := #[] + let mut maxRss := 0 + for i in [:collectionRows.size] do + let row := collectionRows[i]! + need ((← number row "row") == (← number samples[i]! "row") && + (← number row "sample") == (← number samples[i]! "sample")) "collection diagnostic sample identity disagrees" + let count ← number row "collections" + let total ← number row "total_collections" + need (count > 0 && total >= lastTotal + count) "lifecycle diagnostic did not exercise natural collection cycles" + collections := collections + count + lastTotal := total + let live ← number row "last_post_gc_live_bytes" + need (live < 8388608) "post-collection retention exceeded the frozen diagnostic bound" + liveValues := liveValues.push live + maximumLive := max maximumLive live + maxRss := max maxRss (← number samples[i]! "rss_kb") + let terminalObservation ← present terminal "missing terminal collection observation" + need ((← number terminalObservation "total_collections") == lastTotal + 1 && + (← number terminalObservation "post_gc_live_bytes") < 8388608) "terminal collection inventory or retention disagrees" + return Json.mkObj [("schedule", toJson schedule), ("natural_collections_in_sample_envelopes", toJson collections), + ("maximum_post_gc_live_bytes", toJson maximumLive), ("post_gc_live_bytes_across_samples", toJson liveValues), + ("maximum_current_rss_kb", toJson maxRss), ("terminal_collection", terminalObservation), + ("sample_envelopes", Json.arr collectionRows), ("raw_blake3", toJson (digest (← IO.FS.readBinFile path))), + ("interpretation", toJson "separate instrumented lifecycle executions; GC time uses the pinned runtime gettimeofday hook; terminal elapsed time uses CLOCK_MONOTONIC_RAW")] + +def gcSmokeSuite (build output : FilePath) (core : Nat) : IO Unit := do + let build ← absolute build + fresh output + let _ ← inspectBuild build + let schedule : Schedule := { + mode := 0, samples := 1, warmNs := 10000000, order := #[28, 31, 34, 37], + operations := Array.replicate 38 (chunkSize * 6) } + let gc ← collectionDiagnostic build output core schedule false + writeJson (output / "gc-smoke.json") (Json.mkObj [("format", toJson "compilatrix/benchmark-gc-smoke/1"), + ("build_blake3", toJson (digest (← IO.FS.readBinFile (build / "build.json")))) , + ("gc", gc), ("status", toJson "passed")]) + IO.println "benchmark GC smoke: all four lifecycle domains exercise natural collections, bounded retention, and one actual terminal collection" + +def diagnoseSuite (build pilot output : FilePath) (core : Nat) : IO Unit := do + fresh output + let freeze ← inspectFreeze build pilot + need (core == (← number freeze "core")) "diagnostic core differs from frozen run" + let first := (← arrField freeze "blocks")[0]! + let common ← checked (fromJson? (← field first "schedule") : Except String Schedule) + let schedule : Schedule := { + mode := 1, samples := 5, warmNs := 1000000000, order := #[28, 31, 34, 37], operations := common.operations } + let gc ← collectionDiagnostic build output core schedule true + let mut compilerCosts := #[] + for name in ["compilatrix-produce", "compilatrix-independent-gate", "lean-generate-c", "lean-kernel", + "cakeml-kernel", "kernel-compcert", "kernel-gcc", "kernel-clang", + "upstream-applyClosed-produce", "upstream-applyClosed-check", "upstream-letClosed-produce", "upstream-letClosed-check"] do + compilerCosts := compilerCosts.push (Json.mkObj [("name", toJson name), + ("resources", ← readJson (build / s!"diagnostics/build/{name}.resources.json")), + ("command", ← readJson (build / s!"diagnostics/build/{name}.command.json"))]) + let mut sizes := #[] + for name in ["compilatrix-main", "compilatrix-release", "lean-kernel", "cakeml-kernel", "compcert-kernel", "gcc-kernel", "clang-kernel", + "compilatrix", "lean", "cakeml", "compcert", "gcc", "clang"] do + sizes := sizes.push (Json.mkObj [("name", toJson name), + ("gnu_size_A", toJson (← IO.FS.readFile (build / s!"diagnostics/build/size-{name}.stdout")))]) + let mut upstream := #[] + for name in ["applyClosed", "letClosed"] do + let directory := build / s!"artifacts/upstream-{name}" + let snapshot ← readJson (directory / s!"upstream-{name}.json") + let native ← field snapshot "native" + let row := (← arrField (← readJson (directory / "report.json")) "cases")[0]! + let compilation ← field snapshot "compilation" + let mut encoded := #[] + for (label, container, key, payload) in [("ixir0_declarations", ← field compilation "ixir0", "declarations", "preimage"), + ("ixir1_artifacts", ← field compilation "ixir1", "artifacts", "preimage"), + ("hpt_certificates", ← field compilation "hpt", "artifacts", "bytes")] do + let artifacts ← arrField container key + let mut total := 0 + for artifact in artifacts do total := total + (← byteField artifact payload).size + encoded := encoded.push (Json.mkObj [("name", toJson label), ("count", toJson artifacts.size), ("encoded_bytes", toJson total)]) + let mut pieces := #[] + for key in ["input", "compilation", "observations", "native"] do + let json ← field snapshot key + pieces := pieces.push (Json.mkObj [("name", toJson key), ("canonical_json_bytes", toJson json.compress.toUTF8.size)]) + upstream := upstream.push (Json.mkObj [("name", toJson name), ("root", ← field row "root"), + ("source_constants", ← field row "source_constants"), ("source_piece_bytes", toJson (if name == "applyClosed" then 662 else 670 : Nat)), + ("snapshot_bytes", toJson (← IO.FS.readBinFile (directory / s!"upstream-{name}.json")).size), + ("snapshot_parts", Json.arr pieces), ("encoded_artifacts", Json.arr encoded), + ("text_bytes", ← field native "text_bytes"), ("object_bytes", ← field native "object_bytes"), + ("baseline_counters", ← field row "observation"), ("native_heap", ← field native "native_heap"), + ("scope", toJson "serialized artifacts and executable certificates; Lean proof-term allocation is not inferred from JSON size")]) + let hardware ← try + let which ← IO.Process.output { cmd := "which", args := #["perf"] } + if which.exitCode != 0 then pure (Json.mkObj [("status", toJson "unavailable"), ("reason", toJson "perf is not installed in the recorded runtime environment")]) + else do + let perf ← IO.Process.output { + cmd := which.stdout.trimAscii.toString, + args := #["stat", "-x,", "-e", "cycles,instructions,branches,branch-misses,cache-misses,page-faults", + "--", "taskset", "--cpu-list", toString core, (build / "bin/upstream-applyClosed").toString, "1000000", "1"] } + IO.FS.writeFile (output / "perf.stdout") perf.stdout + IO.FS.writeFile (output / "perf.stderr") perf.stderr + pure (Json.mkObj [("status", toJson (if perf.exitCode == 0 then "available-diagnostic-only" else "unavailable")), + ("exit_code", toJson perf.exitCode.toNat), ("scope", toJson "whole upstream applyClosed diagnostic process including warmup and checks"), + ("raw_events_and_scaling", toJson perf.stderr)]) + catch error => pure (Json.mkObj [("status", toJson "unavailable"), ("reason", toJson error.toString)]) + let _ ← inspectBuild build + writeJson (output / "diagnostics.json") (Json.mkObj [("format", toJson "compilatrix/benchmark-diagnostics/1"), + ("build_blake3", toJson (digest (← IO.FS.readBinFile (build / "build.json")))), + ("gc", gc), + ("hardware_counters", hardware), ("compiler_costs", Json.arr compilerCosts), ("code_sizes", Json.arr sizes), + ("upstream_artifact_growth", Json.arr upstream), ("status", toJson "passed")]) + IO.println s!"benchmark diagnostics: {← number gc "natural_collections_in_sample_envelopes"} natural GC cycles, bounded post-collection storage, separate terminal GC, compiler costs and sizes retained" + +end Benchmarks.Compiler diff --git a/Benchmarks/Compiler/Environment.lean b/Benchmarks/Compiler/Environment.lean new file mode 100644 index 000000000..d34c6406b --- /dev/null +++ b/Benchmarks/Compiler/Environment.lean @@ -0,0 +1,71 @@ +import Benchmarks.Compiler.Schedule + +namespace Benchmarks.Compiler +open Lean System Ix.Compiler.Tools.Check Ix.Compiler.Tools.UniqueCheck + +def optionalFile (path : FilePath) : IO String := do + try return (← IO.FS.readFile path).trimAscii.toString + catch _ => return "unavailable" + +def firstCore : IO Nat := do + let status ← IO.FS.readFile "/proc/self/status" + let some line := (status.splitOn "\n").find? (·.startsWith "Cpus_allowed_list:") | + throw (IO.userError "Linux CPU affinity list unavailable") + let list := (line.drop "Cpus_allowed_list:".length).toString.trimAscii.toString + present (((list.splitOn ",").head!).splitOn "-").head!.toNat? "invalid Linux CPU affinity list" + +def environment (core : Nat) : IO Json := do + let cpu := s!"/sys/devices/system/cpu/cpu{core}" + let mut stable := #[] + for path in ["/proc/sys/kernel/random/boot_id", "/sys/devices/system/cpu/online", + "/sys/devices/system/cpu/smt/active", "/sys/devices/system/cpu/cpufreq/boost", + "/sys/devices/system/cpu/intel_pstate/no_turbo", "/sys/devices/system/clocksource/clocksource0/current_clocksource", + s!"{cpu}/topology/thread_siblings_list", s!"{cpu}/topology/core_id", s!"{cpu}/topology/physical_package_id", + s!"{cpu}/cpufreq/scaling_governor", s!"{cpu}/cpufreq/scaling_driver", + s!"{cpu}/cpufreq/cpuinfo_min_freq", s!"{cpu}/cpufreq/cpuinfo_max_freq", s!"{cpu}/microcode/version"] do + stable := stable.push (path, toJson (← optionalFile path)) + let kernel ← run "uname" #["-srvmo"] + stable := stable.push ("kernel", toJson kernel.trimAscii.toString) + let cpuinfo ← IO.FS.readFile "/proc/cpuinfo" + let first := (cpuinfo.splitOn "\n\n").head! + let identity := (first.splitOn "\n").filter fun line => + ["vendor_id", "cpu family", "model\t", "model name", "stepping", "microcode", "flags"].any (fun startText => line.startsWith startText) + stable := stable.push ("cpu_identity", toJson identity) + let topology ← run "lscpu" #["--json"] + let placement ← IO.Process.output { cmd := "taskset", args := #["--cpu-list", toString core, "sh", "-c", "cat /proc/self/status"] } + need (placement.exitCode == 0) "requested benchmark core is unavailable" + let affinity := (placement.stdout.splitOn "\n").filter fun line => + ["Cpus_allowed_list:", "Mems_allowed_list:"].any (fun startText => line.startsWith startText) + stable := stable.push ("placed_affinity_and_numa_nodes", toJson affinity) + let controller ← IO.FS.readFile "/proc/self/status" + stable := stable.push ("controller_affinity_and_numa_nodes", toJson ((controller.splitOn "\n").filter fun line => + ["Cpus_allowed_list:", "Mems_allowed_list:"].any (fun startText => line.startsWith startText))) + let stableFields := Json.mkObj stable.toList + let mut dynamic := #[] + for path in ["/proc/loadavg", "/proc/meminfo", "/proc/pressure/cpu", "/proc/pressure/memory", + s!"{cpu}/cpufreq/scaling_cur_freq", "/proc/sys/kernel/perf_event_paranoid", "/proc/sys/kernel/nmi_watchdog", + "/proc/1/cgroup", "/etc/os-release"] do + dynamic := dynamic.push (path, toJson (← optionalFile path)) + let mut variables := #[] + for name in ["CML_HEAP_SIZE", "CML_STACK_SIZE", "MALLOC_ARENA_MAX", "MALLOC_PERTURB_", "LD_PRELOAD", "LD_LIBRARY_PATH", + "LEAN_NUM_THREADS", "OMP_NUM_THREADS", "NIX_CFLAGS_COMPILE", "NIX_LDFLAGS"] do + variables := variables.push (name, toJson (← IO.getEnv name)) + return Json.mkObj [ + ("format", toJson "compilatrix/benchmark-environment/1"), ("utc", toJson (← run "date" #["-u", "+%Y-%m-%dT%H:%M:%SZ"]).trimAscii.toString), + ("core", toJson core), ("stable", stableFields), ("stable_blake3", toJson (digest stableFields.compress.toUTF8)), + ("lscpu", ← checked (Json.parse topology)), ("observations", Json.mkObj dynamic.toList), + ("environment_variables", Json.mkObj variables.toList), ("runtime_overrides", toJson runtimeEnv), + ("limitations", toJson (["shared host; other tenants and SMT sibling are not controlled", + "worker affinity is pinned; NUMA follows Linux first-touch placement on the pinned worker", + "turbo, governor, system services, thermal state, and ambient load are observed, not administratively changed", + "this run is not a dedicated performance-regression baseline"] : List String))] + +def stableEnvironment (before after : Json) : IO Bool := do + pure ((← field before "stable") == (← field after "stable") && + (← field before "environment_variables") == (← field after "environment_variables")) + +def environmentRegressions (original : Json) : IO Unit := do + let changed ← replaceAt original ["stable", "kernel"] (toJson "different kernel") + need (!(← stableEnvironment original changed)) "environment drift was not detected" + +end Benchmarks.Compiler diff --git a/Benchmarks/Compiler/Measure.lean b/Benchmarks/Compiler/Measure.lean new file mode 100644 index 000000000..d76c7a966 --- /dev/null +++ b/Benchmarks/Compiler/Measure.lean @@ -0,0 +1,149 @@ +import Benchmarks.Compiler.Pilot + +namespace Benchmarks.Compiler +open Lean System Ix.Compiler.Tools.Check Ix.Compiler.Tools.UniqueCheck + +def inspectFreeze (build pilot : FilePath) : IO Json := do + let freeze ← readJson (pilot / "freeze.json") + let buildHash := digest (← IO.FS.readBinFile (build / "build.json")) + need ((← strField freeze "format") == "compilatrix/benchmark-freeze/1" && + (← strField freeze "build_blake3") == buildHash) "frozen schedule belongs to a different build" + let manifest ← readJson (build / "manifest.json") + need ((← number freeze "minimum_sample_ns") == minimumNs && (← number freeze "pilot_target_ns") == pilotTargetNs && + (← number freeze "order_seed") == orderSeed.toNat && (← number freeze "resource_bound_rss_kb") == 2097152 && + (← number freeze "timer_chunk_minimum_factor") == 100 && (← number freeze "session_separation_seconds") == 60 && + (← number freeze "bootstrap_replicates") == 10000 && (← number freeze "bootstrap_seed") == 2671931027 && + (← field freeze "bootstrap") == (← field (← field manifest "analysis") "bootstrap")) "frozen timing/analysis policy changed" + let blocks ← arrField freeze "blocks" + need (blocks.size == blockCount) "frozen block inventory disagrees" + let mut common : Option (Array Nat) := none + let mut state := orderSeed + for index in [:blocks.size] do + let block := blocks[index]! + need ((← number block "block") == index && (← number block "session") == index / 10) "frozen block/session identity disagrees" + let schedule ← checked (fromJson? (← field block "schedule") : Except String Schedule) + need (schedule.valid && schedule.mode == 2) "frozen measurement schedule invalid" + let order ← (← arrField block "implementation_order").mapM string + need (order.toList.mergeSort (· ≤ ·) == implementations.toList.mergeSort (· ≤ ·)) "frozen comparison inventory disagrees" + let (expectedRows, next) := shuffled (List.range 38).toArray state + let (expectedImplementations, next) := shuffled (List.range 6).toArray next + state := next + need (schedule.order == expectedRows && order == expectedImplementations.map (implementations[·]!)) "frozen randomized order changed" + if let some counts := common then need (counts == schedule.operations) "frozen counts vary across blocks" + common := some schedule.operations + let upstream ← arrField freeze "upstream" + need (upstream.size == 2) "frozen upstream inventory changed" + for i in [:2] do + need ((← strField upstream[i]! "name") == (if i == 0 then "applyClosed" else "letClosed") && + (← number upstream[i]! "value") == i + 3 && (← number upstream[i]! "operations") > 0 && + (← number upstream[i]! "operations") <= 100000000000 && (← number upstream[i]! "operations") % (chunkSize * 6) == 0) + "frozen upstream counts or values changed" + return freeze + +def enriched (sample : Json) (block session order attempt : Nat) (buildHash freezeHash executableHash : String) : Json := + let row := (sample.getObjValAs? Nat "row").toOption.map (timingCases[·]!) + Json.mkObj [("format", toJson "compilatrix/benchmark-sample/1"), ("block", toJson block), ("session", toJson session), + ("workload", toJson (if row.isSome then workload else "upstream-closed-nat")), + ("profile", toJson (row.map TimingCase.profileName |>.getD "native-call")), + ("case", row.map TimingCase.json |>.getD (Json.mkObj [("runtime_arguments", toJson (0 : Nat))])), + ("dataset_seeds", row.map (fun row => toJson (row.inputIds.map (fun id => inputs[id]!.seed.toNat))) |>.getD Json.null), + ("order", toJson order), ("attempt", toJson attempt), ("build_blake3", toJson buildHash), + ("freeze_blake3", toJson freezeHash), ("executable_blake3", toJson executableHash), + ("dataset_blake3", toJson (digest datasetBytes)), ("status", toJson "valid"), ("observation", sample)] + +def measureSuite (build correctness pilot output : FilePath) (core : Nat) : IO Unit := do + let build ← absolute build + let output ← absolute output + requireCorrectness build correctness + let freeze ← inspectFreeze build pilot + need ((← number freeze "core") == core) "measurement core differs from frozen pilot" + let reference ← field freeze "environment" + let initial ← environment core + need (← stableEnvironment reference initial) "measurement environment differs from pilot" + fresh output + IO.FS.writeFile (output / "freeze.json") (← IO.FS.readFile (pilot / "freeze.json")) + IO.FS.writeFile (output / "correctness.json") (← IO.FS.readFile (correctness / "correctness.json")) + writeJson (output / "environment-start.json") initial + let buildHash := digest (← IO.FS.readBinFile (build / "build.json")) + let freezeHash := digest (← IO.FS.readBinFile (output / "freeze.json")) + let allSamples ← IO.FS.Handle.mk (output / "samples.jsonl") .write + let upstreamSamples ← IO.FS.Handle.mk (output / "upstream.jsonl") .write + let mut completed := #[] + for block in (← arrField freeze "blocks") do + let id ← number block "block" + let session ← number block "session" + if id > 0 && id % 10 == 0 then + IO.println s!"benchmark measurement: session {session} starts after the frozen 60-second idle interval" + IO.sleep 60000 + let schedule ← checked (fromJson? (← field block "schedule") : Except String Schedule) + let order ← (← arrField block "implementation_order").mapM string + let mut accepted := false + for attempt in [:3] do + if accepted then break + let directory := output / s!"session-{session}/block-{id}/attempt-{attempt}" + IO.FS.createDirAll directory + let before ← environment core + writeJson (directory / "environment-start.json") before + let mut samples := #[] + let mut upstreamRows := #[] + let mut reason : Option String := none + try + need (← stableEnvironment reference before) "environment drift before block" + let _ ← inspectBuild build + for orderIndex in [:order.size] do + let implementation := order[orderIndex]! + let hash := digest (← IO.FS.readBinFile (build / s!"bin/{implementation}")) + IO.println s!"benchmark measurement: session {session + 1}/3, block {id + 1}/30, {implementation}" + let rows ← runScheduled build (directory / s!"{implementation}.jsonl") implementation schedule core + for row in rows do + need ((← number row "peak_rss_kb") <= (← number freeze "resource_bound_rss_kb")) "resource RSS bound exceeded" + samples := samples.push (enriched row id session orderIndex attempt buildHash freezeHash hash) + let upstream := (← arrField freeze "upstream") + let upstream := if id % 2 == 0 then upstream else upstream.reverse + for upstreamOrder in [:upstream.size] do + let entry := upstream[upstreamOrder]! + let name ← strField entry "name" + let value ← number entry "value" + let operations ← number entry "operations" + let rows ← runUpstream build (directory / s!"upstream-{name}.jsonl") name value operations 3 core true + let hash := digest (← IO.FS.readBinFile (build / s!"bin/upstream-{name}")) + for row in rows do + need ((← number row "peak_rss_kb") <= (← number freeze "resource_bound_rss_kb")) "resource RSS bound exceeded" + upstreamRows := upstreamRows.push (Json.mkObj [("name", toJson name), + ("sample", enriched row id session upstreamOrder attempt buildHash freezeHash hash)]) + let after ← environment core + writeJson (directory / "environment-end.json") after + need (← stableEnvironment reference after) "environment drift after block" + let _ ← inspectBuild build + catch error => reason := some error.toString + let status := Json.mkObj [("block", toJson id), ("session", toJson session), ("attempt", toJson attempt), + ("status", toJson (if reason.isSome then "invalid" else "valid")), ("reason", toJson reason), + ("samples", toJson samples.size), ("upstream_samples", toJson upstreamRows.size)] + writeJson (directory / "status.json") status + if let some failure := reason then + IO.println s!"benchmark measurement: retained invalid complete-block attempt {id}/{attempt}: {failure}" + -- Only environmental/timing validity failures admit a complete-block + -- rerun. A failed result, parser, process, or artifact stops the run. + need (["environment drift", "shorter than 100 ms", "does not dominate timer", "resource RSS bound"].any (fun fragment => failure.contains fragment)) + s!"correctness or artifact failure; publication stopped: {failure}" + else + need (samples.size == 684 && upstreamRows.size == 6) "valid block is incomplete" + for sample in samples do allSamples.putStrLn sample.compress + for sample in upstreamRows do upstreamSamples.putStrLn sample.compress + allSamples.flush + upstreamSamples.flush + completed := completed.push status + writeJson (output / "progress.json") (Json.mkObj [("valid_blocks", Json.arr completed), ("complete", toJson false)]) + accepted := true + need accepted s!"block {id} exhausted three recorded attempts; no complete report" + let final ← environment core + writeJson (output / "environment-end.json") final + need (← stableEnvironment reference final) "environment drift at measurement completion" + writeJson (output / "measurement.json") (Json.mkObj [("format", toJson "compilatrix/benchmark-measurement/1"), + ("build_blake3", toJson buildHash), ("freeze_blake3", toJson freezeHash), ("valid_blocks", Json.arr completed), + ("samples", toJson (20520 : Nat)), ("upstream_samples", toJson (180 : Nat)), + ("samples_blake3", toJson (digest (← IO.FS.readBinFile (output / "samples.jsonl")))), + ("upstream_blake3", toJson (digest (← IO.FS.readBinFile (output / "upstream.jsonl")))), ("status", toJson "complete")]) + IO.println "benchmark measurement: all six implementations and two upstream entries completed 30 blocks across three sessions" + +end Benchmarks.Compiler diff --git a/Benchmarks/Compiler/Pilot.lean b/Benchmarks/Compiler/Pilot.lean new file mode 100644 index 000000000..32c0a7493 --- /dev/null +++ b/Benchmarks/Compiler/Pilot.lean @@ -0,0 +1,108 @@ +import Benchmarks.Compiler.Environment + +namespace Benchmarks.Compiler +open Lean System Ix.Compiler.Tools.Check Ix.Compiler.Tools.UniqueCheck + +def minimumNs : Nat := 100000000 +def pilotTargetNs : Nat := 200000000 +def orderSeed : UInt64 := 1210345809 +def blockCount : Nat := 30 +def sessionCount : Nat := 3 + +def roundOperations (count : Nat) : Nat := + ((count + chunkSize * 6 - 1) / (chunkSize * 6)) * (chunkSize * 6) + +def requireCorrectness (build correctness : FilePath) : IO Unit := do + let result ← readJson (correctness / "correctness.json") + let buildHash := digest (← IO.FS.readBinFile (build / "build.json")) + need ((← strField result "status") == "passed" && (← strField result "build_blake3") == + buildHash) "correctness record does not match the timed build" + need ((← field result "executables") == (← field (← inspectBuild build) "executables")) "correctness executable identities differ" + +def runUpstream (build output : FilePath) (name : String) (value operations samples core : Nat) + (measurement : Bool := false) : IO (Array Json) := do + let result ← streamed { cmd := "taskset", args := #["--cpu-list", toString core, + (build / "bin/worker-launcher").toString, + (build / s!"bin/upstream-{name}").toString, toString operations, toString samples] } output + IO.FS.writeFile (output.withExtension "stderr") result.stderr + need (result.exitCode == 0) s!"upstream {name} timing failed: {result.stderr}" + let rows ← readLines output + need (rows.size == samples + 1 && (← kind rows[0]!) == "warmup" && + (← number rows[0]! "elapsed_ns") >= 1000000000) "upstream warm-up or sample inventory disagrees" + for i in [:samples] do + let row := rows[i + 1]! + need ((← kind row) == "sample" && (← number row "sample") == i && + (← number row "operations") == operations && (← number row "sink") == value * operations && + (← number row "elapsed_ns") > 0) "upstream timed sample identity or result disagrees" + if measurement then need ((← number row "elapsed_ns") >= minimumNs) "upstream measured sample shorter than 100 ms" + return rows.extract 1 rows.size + +def pilotSuite (build correctness output : FilePath) (core : Nat) : IO Unit := do + let build ← absolute build + let output ← absolute output + requireCorrectness build correctness + fresh output + let before ← environment core + writeJson (output / "environment-start.json") before + environmentRegressions before + let initial : Schedule := { + mode := 1, samples := 1, warmNs := 1000000000, + order := (List.range 38).toArray, operations := Array.replicate 38 (chunkSize * 6) } + let mut counts := initial.operations + let mut estimates : Array Json := #[] + for implementation in implementations do + let samples ← runScheduled build (output / s!"initial-{implementation}.jsonl") implementation initial core + for row in samples do + let id ← number row "row" + let operations ← number row "operations" + let elapsed ← number row "elapsed_ns" + let count := roundOperations ((operations * pilotTargetNs + elapsed - 1) / elapsed) + counts := counts.set! id (max counts[id]! count) + estimates := estimates.push (Json.mkObj [("implementation", toJson implementation), ("row", toJson id), + ("elapsed_ns", toJson elapsed), ("operations", toJson operations), ("envelope_ns", ← field row "envelope_ns")]) + IO.println s!"benchmark pilot: initial {implementation} complete" + let schedule := { initial with operations := counts } + let mut confirmation := #[] + for implementation in implementations do + let samples ← runScheduled build (output / s!"confirmation-{implementation}.jsonl") implementation schedule core + for row in samples do + need ((← number row "elapsed_ns") >= minimumNs) s!"pilot count needs a new premeasurement calibration: {implementation}" + let id ← number row "row" + confirmation := confirmation.push (Json.mkObj [("implementation", toJson implementation), ("row", toJson id), + ("elapsed_ns", ← field row "elapsed_ns"), ("envelope_ns", ← field row "envelope_ns")]) + IO.println s!"benchmark pilot: confirmed {implementation}" + let mut upstream := #[] + for (name, value) in [("applyClosed", 3), ("letClosed", 4)] do + let samples ← runUpstream build (output / s!"initial-upstream-{name}.jsonl") name value 1000000 1 core + let elapsed ← number samples[0]! "elapsed_ns" + let operations := roundOperations ((1000000 * pilotTargetNs + elapsed - 1) / elapsed) + let _ ← runUpstream build (output / s!"confirmation-upstream-{name}.jsonl") name value operations 1 core true + upstream := upstream.push (Json.mkObj [("name", toJson name), ("value", toJson value), ("operations", toJson operations)]) + let after ← environment core + writeJson (output / "environment-end.json") after + need (← stableEnvironment before after) "pilot environment drifted; no schedule frozen" + let _ ← inspectBuild build + let mut state := orderSeed + let mut blocks := #[] + for block in [:blockCount] do + let (order, next) := shuffled (List.range 38).toArray state + let (implementationOrder, next) := shuffled (List.range implementations.size).toArray next + state := next + let schedule : Schedule := { mode := 2, samples := 3, warmNs := 1000000000, order, operations := counts } + blocks := blocks.push (Json.mkObj [("block", toJson block), ("session", toJson (block / 10)), + ("implementation_order", toJson (implementationOrder.map (implementations[·]!))), ("schedule", toJson schedule)]) + writeJson (output / "freeze.json") (Json.mkObj [ + ("format", toJson "compilatrix/benchmark-freeze/1"), ("build_blake3", toJson (digest (← IO.FS.readBinFile (build / "build.json")))) , + ("environment", before), ("core", toJson core), ("pilot_target_ns", toJson pilotTargetNs), + ("minimum_sample_ns", toJson minimumNs), ("resource_bound_rss_kb", toJson (2097152 : Nat)), + ("timer_chunk_minimum_factor", toJson (100 : Nat)), ("session_separation_seconds", toJson (60 : Nat)), + ("order_seed", toJson orderSeed.toNat), ("blocks", Json.arr blocks), ("upstream", Json.arr upstream), + ("initial_estimates", Json.arr estimates), ("confirmation", Json.arr confirmation), + ("invalidations", toJson (["changed boot, CPU identity/topology, kernel, affinity, governor/turbo, clocksource, or declared runtime environment", + "incorrect sink/schema, executable drift, process failure, RSS above 2 GiB, sample below 100 ms, chunk below 100 minimum clock-pair costs", + "slow samples, context switches, page faults, load, and frequency variation are retained and reported"] : List String)), + ("bootstrap", toJson "hierarchical paired bootstrap: resample three sessions, then ten whole paired blocks within each selected session"), + ("bootstrap_replicates", toJson (10000 : Nat)), ("bootstrap_seed", toJson (2671931027 : Nat))]) + IO.println s!"benchmark pilot: fixed common counts, 30 randomized paired blocks, and two upstream entries frozen in {output}" + +end Benchmarks.Compiler diff --git a/Benchmarks/Compiler/Reproduce.lean b/Benchmarks/Compiler/Reproduce.lean new file mode 100644 index 000000000..4009ad29a --- /dev/null +++ b/Benchmarks/Compiler/Reproduce.lean @@ -0,0 +1,98 @@ +import Benchmarks.Compiler.Diagnostics + +namespace Benchmarks.Compiler +open Lean System Ix.Compiler.Tools.Check Ix.Compiler.Tools.UniqueCheck + +def replayCommand (directory : FilePath) (environment : Array (String × Option String)) + (command : String) (arguments : Array String) (log : FilePath) : IO Unit := do + let assignments := environment.filterMap fun (name, value) => value.map (fun value => s!"{name}={value}") + let result ← streamed { cmd := "env", args := #["-i"] ++ assignments ++ #[command] ++ arguments, cwd := some directory } log + IO.FS.writeFile (log.withExtension "stderr") result.stderr + writeJson (log.withExtension "command.json") (Json.mkObj [("environment_policy", toJson "env -i plus the exact recorded build variables"), + ("environment", toJson environment), ("cwd", toJson directory.toString), ("command", toJson command), + ("arguments", toJson arguments), ("exit_code", toJson result.exitCode.toNat)]) + need (result.exitCode == 0) s!"independent environment command failed; see {log}: {result.stderr}" + +def rebuildArtifacts (build output : FilePath) : IO FilePath := do + let build ← absolute build + let output ← absolute output + fresh output + let metadata ← inspectBuild build + let environment ← checked (fromJson? (← field metadata "build_environment") : Except String (Array (String × Option String))) + need (environment.map Prod.fst == buildEnvNames) "recorded build environment inventory disagrees" + let toolIdentities ← array (← readJson (build / "tool-identities.json")) + for row in toolIdentities do + let original ← strField row "resolved" + let path ← if (← strField row "name") == "cakeml" then + pure (build / (← strField row "retained_path")) + else pure (FilePath.mk original) + need (digest (← IO.FS.readBinFile path) == (← strField row "blake3")) "installed tool differs from retained compiler seed" + let snapshot ← readJson (build / "source.json") + need (digest (← IO.FS.readBinFile (build / "source.tar.gz")) == (← strField snapshot "archive_blake3")) "source archive digest disagrees" + let source := output / "source" + IO.FS.createDirAll source + let inventory ← arrField snapshot "files" + let names ← inventory.mapM (fun row => strField row "path") + need (names.toList.Nodup && names.all (fun name => !name.startsWith "/" && + !(name.splitOn "/").any (fun part => part == ".." || part.isEmpty))) "unsafe source archive inventory" + let listing := (← run "tar" #["-tzf", (build / "source.tar.gz").toString]).trimAscii.toString.splitOn "\n" + need (listing.mergeSort (· ≤ ·) == names.toList.mergeSort (· ≤ ·)) "source tar inventory disagrees" + let _ ← run "tar" #["--no-same-owner", "--no-same-permissions", "-xzf", (build / "source.tar.gz").toString, "-C", source.toString] + for row in inventory do + let bytes ← IO.FS.readBinFile (source / (← strField row "path")) + need (bytes.size == (← number row "bytes") && digest bytes == (← strField row "blake3")) "extracted source differs from retained snapshot" + IO.FS.createDirAll (source / ".lake/build/bin") + for path in (← files (build / "tools-bin")) do + let _ ← run "cp" #[path.toString, (source / ".lake/build/bin" / path.fileName.getD "missing").toString] + let runner := (source / ".lake/build/bin/compiler-benchmark").toString + let recordedTools ← checked (fromJson? (← field metadata "tool_commands") : Except String Toolchains) + let tools := { recordedTools with cakeml := (source / ".lake/build/bin/cakeml-bootstrap").toString } + let rebuilt := output / "build" + replayCommand source environment runner #["build", rebuilt.toString, "--gcc", tools.gcc, "--clang", tools.clang, + "--compcert", tools.compcert, "--cakeml", tools.cakeml, "--time", tools.timerTool] (output / "rebuild.jsonl") + let rebuiltMetadata ← inspectBuild rebuilt + for key in ["artifacts", "executables", "tools", "datasets_blake3", "manifest_blake3", "toolchains_blake3"] do + need ((← field rebuiltMetadata key) == (← field metadata key)) s!"independent rebuild changed {key}" + writeJson (output / "rebuild-check.json") (Json.mkObj [("source_files", toJson inventory.size), + ("source_archive_blake3", ← field snapshot "archive_blake3"), ("artifacts_exact", toJson true), + ("executables_exact", toJson true), ("status", toJson "passed")]) + IO.println "benchmark rebuild check: fresh source/environment produced exact objects and executables" + return source + +def reproduceSuite (build measured output : FilePath) : IO Unit := do + let build ← absolute build + let measured ← absolute measured + let output ← absolute output + let (_, _) ← inspectMeasurement build measured + let source ← rebuildArtifacts build output + let metadata ← inspectBuild build + let snapshot ← readJson (build / "source.json") + let inventory ← arrField snapshot "files" + let environment ← checked (fromJson? (← field metadata "build_environment") : Except String (Array (String × Option String))) + let runner := (source / ".lake/build/bin/compiler-benchmark").toString + let rebuilt := output / "build" + replayCommand source environment runner #["verify", rebuilt.toString, (output / "correctness").toString] (output / "verify.jsonl") + let originalCorrectness ← readJson (measured / "correctness.json") + let replayCorrectness ← readJson (output / "correctness/correctness.json") + let originalMatrices ← arrField originalCorrectness "matrices" + let replayMatrices ← arrField replayCorrectness "matrices" + need (originalMatrices.size == replayMatrices.size) "independent correctness inventory changed" + for i in [:originalMatrices.size] do + need ((← field originalMatrices[i]! "result") == (← field replayMatrices[i]! "result")) "independent complete matrix differs" + -- Retained samples remain inputs. Reproduction never asks clock readings + -- or diagnostic compiler resource envelopes to be byte-identical. + replayCommand source environment runner #["analyze", build.toString, measured.toString, (output / "analysis").toString] + (output / "analysis.jsonl") + for file in ["summary.json", "report.md"] do + need ((← IO.FS.readBinFile (output / "analysis" / file)) == (← IO.FS.readBinFile (measured / "analysis" / file))) + s!"independent analysis changed {file}" + writeJson (output / "reproduction.json") (Json.mkObj [("format", toJson "compilatrix/benchmark-reproduction/1"), + ("source_archive_blake3", ← field snapshot "archive_blake3"), ("original_build_blake3", toJson (digest (← IO.FS.readBinFile (build / "build.json")))), + ("rebuilt_build_blake3", toJson (digest (← IO.FS.readBinFile (rebuilt / "build.json")))), + ("source_files", toJson inventory.size), ("artifacts_exact", toJson true), ("executables_exact", toJson true), + ("correctness_exact", toJson true), ("analysis_exact", toJson true), + ("scope", toJson "fresh extracted source directory and empty process environment; retained hashed compiler/checker seeds; same physical host and pinned Nix runtime closure"), + ("timing_samples_rerun", toJson false), ("status", toJson "passed")]) + IO.println "benchmark reproduction: clean source/environment rebuild, exact objects/executables, complete correctness, and byte-exact analysis passed" + +end Benchmarks.Compiler diff --git a/Benchmarks/Compiler/Schedule.lean b/Benchmarks/Compiler/Schedule.lean new file mode 100644 index 000000000..f337017b2 --- /dev/null +++ b/Benchmarks/Compiler/Schedule.lean @@ -0,0 +1,146 @@ +import Benchmarks.Compiler.Verify + +namespace Benchmarks.Compiler +open Lean System Ix.Compiler.Tools.Check Ix.Compiler.Tools.UniqueCheck + +structure Schedule where + mode : Nat + samples : Nat + warmNs : Nat + order : Array Nat + operations : Array Nat + deriving ToJson, FromJson, BEq + +def Schedule.valid (schedule : Schedule) : Bool := + schedule.mode ≤ 2 && 0 < schedule.samples && schedule.samples ≤ 10 && schedule.warmNs ≤ 10000000000 && + 0 < schedule.order.size && schedule.order.size ≤ 38 && schedule.order.toList.Nodup && + schedule.order.all (· < 38) && schedule.operations.size == 38 && + schedule.operations.all (fun count => 0 < count && count ≤ 1000000000000 && count % (chunkSize * 6) == 0) && + (schedule.mode != 2 || (schedule.order.size == 38 && schedule.samples == 3 && schedule.warmNs ≥ 1000000000)) + +def Schedule.bytes (schedule : Schedule) : ByteArray := Id.run do + let mut bytes := scheduleMagic.toUTF8 + for value in [schedule.order.size, schedule.samples, schedule.warmNs, chunkSize, schedule.mode] do + bytes := bytes ++ wordBytes value.toUInt64 + for id in schedule.order do + let row := timingCases[id]! + for value in [id, row.length, row.domain, row.profile, schedule.operations[id]!] do + bytes := bytes ++ wordBytes value.toUInt64 + return bytes + +def writeSchedule (path : FilePath) (schedule : Schedule) : IO Unit := do + need schedule.valid "invalid benchmark schedule" + IO.FS.writeBinFile path schedule.bytes + +def shuffled (values : Array Nat) (seed : UInt64) : Array Nat × UInt64 := Id.run do + let mut values := values + let mut state := seed + for index in [:values.size] do + state := nextRandom state + let target := index + (state.toNat % (values.size - index)) + values := values.swapIfInBounds index target + return (values, state) + +def inspectRun (implementation : String) (schedule : Schedule) (rows : Array Json) + (measurement : Bool := false) : IO (Array Json) := do + need schedule.valid "invalid benchmark schedule" + need (rows.size == 4 + schedule.order.size * schedule.samples) "benchmark run inventory disagrees" + inspectMetadata implementation rows[0]! + inspectControl rows[1]! + let warm := rows[2]! + need ((← kind warm) == "warmup" && (← number warm "elapsed_ns") >= schedule.warmNs && + (← number warm "operations") > 0 && (← number warm "operations") % chunkSize == 0) "benchmark warm-up incomplete" + need ((← number warm "sink") == (sampleSink timingCases[28]! (← number warm "operations")).toNat) "benchmark warm-up sink disagrees" + let timerPair ← number rows[0]! "timer_pair_min_ns" + let mut index := 3 + let mut samples := #[] + for id in schedule.order do + for sample in [:schedule.samples] do + let row := rows[index]! + inspectSample implementation schedule.mode id sample schedule.operations[id]! row + if measurement then + need ((← number row "elapsed_ns") >= 100000000) "measured sample shorter than 100 ms" + need ((← number row "minimum_chunk_ns") >= 100 * timerPair) "timed chunk does not dominate timer overhead" + samples := samples.push row + index := index + 1 + need ((← kind rows[index]!) == "completed" && (← number rows[index]! "rows") == schedule.order.size && + (← number rows[index]! "samples_per_row") == schedule.samples) "benchmark run did not complete" + return samples + +def runScheduled (build output : FilePath) (implementation : String) (schedule : Schedule) + (core : Nat) : IO (Array Json) := do + let schedulePath := output.withExtension "bin" + writeSchedule schedulePath schedule + -- All compilation has finished before this function is used for measurement. + let result ← streamed { + cmd := "taskset" + args := #["--cpu-list", toString core, (build / "bin/worker-launcher").toString, + (build / s!"bin/{implementation}").toString, implementation, + "run", (build / "datasets/datasets.bin").toString, schedulePath.toString] + env := runtimeEnv } output + IO.FS.writeFile (output.withExtension "stderr") result.stderr + writeJson (output.withExtension "process.json") (Json.mkObj [("exit_code", toJson result.exitCode.toNat), + ("implementation", toJson implementation), ("core", toJson core), ("schedule", toJson schedule), + ("schedule_blake3", toJson (digest schedule.bytes)), ("stdout_blake3", toJson (digest result.stdout.toUTF8))]) + need (result.exitCode == 0) s!"benchmark {implementation} failed: {result.stderr}" + inspectRun implementation schedule (← readLines output) (schedule.mode == 2) + +def smokeSuite (build output : FilePath) (core : Nat) : IO Unit := do + let build ← absolute build + let output ← absolute output + fresh output + let metadata ← inspectBuild build + let schedule : Schedule := { + mode := 0, samples := 1, warmNs := 10000000, + order := (List.range 38).toArray, operations := Array.replicate 38 (chunkSize * 6) } + let mut samples := #[] + for implementation in implementations do + let rows ← runScheduled build (output / s!"{implementation}.jsonl") implementation schedule core + samples := samples ++ rows + IO.println s!"benchmark smoke: {implementation}, {rows.size} timing rows and periodic full checks" + need (samples.size == 228) "smoke run incomplete" + let sample := samples[0]! + for (name, path, replacement, fragment) in [ + ("mode", ["mode"], toJson (2 : Nat), "sample identity"), + ("profile id", ["row"], toJson (19 : Nat), "sample identity"), + ("implementation", ["implementation"], toJson "clang", "sample identity"), + ("operation count", ["operations"], toJson (1 : Nat), "sample identity"), + ("sink", ["sink"], toJson (0 : Nat), "timed sink"), + ("timer calls", ["timer_calls"], toJson (1 : Nat), "timer/chunk"), + ("zero time", ["elapsed_ns"], toJson (0 : Nat), "timer/chunk")] do + rejects name fragment (inspectSample "compilatrix" 0 0 0 (chunkSize * 6) (← replaceAt sample path replacement)) + let first ← readLines (output / "compilatrix.jsonl") + rejects "missing samples" "run inventory" (inspectRun "compilatrix" schedule (first.extract 0 (first.size - 1)) *> pure ()) + rejects "mixed samples" "sample identity" (inspectRun "gcc" schedule (first.set! 0 (← readLines (output / "gcc.jsonl"))[0]!) *> pure ()) + let canonical := schedule.bytes + let badSchedules : Array (String × ByteArray × String) := #[ + ("magic", canonical.set! 0 0, "wrong binary magic"), + ("empty", canonical.set! 8 0, "invalid schedule header"), + ("samples", canonical.set! 16 0, "invalid schedule header"), + ("chunk", canonical.set! 32 1, "invalid schedule header"), + ("mode", canonical.set! 40 3, "invalid schedule header"), + ("measurement-minimums", canonical.set! 40 2, "incomplete measurement schedule"), + ("row-id", canonical.set! 48 38, "schedule row id out of range"), + ("row-length", canonical.set! 56 1, "invalid schedule row"), + ("operations", canonical.set! 80 1, "invalid schedule row"), + ("duplicate", canonical.extract 0 88 ++ canonical.extract 48 88 ++ canonical.extract 128 canonical.size, "invalid schedule row"), + ("truncated", canonical.extract 0 (canonical.size - 1), "truncated binary input"), + ("trailing", canonical.push 0, "trailing binary input")] + let mut negativeRows := #[] + for (name, bytes, reason) in badSchedules do + let path := output / s!"bad-schedule-{name}.bin" + IO.FS.writeBinFile path bytes + for implementation in implementations do + let result ← IO.Process.output { + cmd := (build / s!"bin/{implementation}").toString, + args := #[implementation, "run", (build / "datasets/datasets.bin").toString, path.toString], env := runtimeEnv } + need (result.exitCode != 0 && result.stderr.contains reason) s!"{implementation} accepted malformed schedule {name}" + negativeRows := negativeRows.push (Json.mkObj [("implementation", toJson implementation), ("case", toJson name), + ("exit_code", toJson result.exitCode.toNat), ("stderr", toJson result.stderr)]) + writeJson (output / "malformed-schedules.json") (Json.arr negativeRows) + writeJson (output / "smoke.json") (Json.mkObj [("format", toJson "compilatrix/benchmark-smoke/1"), + ("executables", ← field metadata "executables"), ("schedule", toJson schedule), + ("samples", Json.arr samples), ("status", toJson "passed")]) + IO.println "benchmark smoke: six executables, 228 timing rows, periodic full results, and sample-schema corruptions passed" + +end Benchmarks.Compiler diff --git a/Benchmarks/Compiler/Verify.lean b/Benchmarks/Compiler/Verify.lean new file mode 100644 index 000000000..948d5a7c9 --- /dev/null +++ b/Benchmarks/Compiler/Verify.lean @@ -0,0 +1,114 @@ +import Benchmarks.Compiler.Build + +namespace Benchmarks.Compiler +open Lean System Ix.Compiler.Tools.Check Ix.Compiler.Tools.UniqueCheck + +def inspectBuild (build : FilePath) : IO Json := do + checkData + let metadata ← readJson (build / "build.json") + need ((← strField metadata "format") == "compilatrix/benchmark-build/1") "unknown benchmark build format" + for (name, key) in [("manifest.json", "manifest_blake3"), ("toolchains.json", "toolchains_blake3")] do + need (digest (← IO.FS.readBinFile (build / name)) == (← strField metadata key)) s!"{name} changed after build" + need ((← IO.FS.readBinFile (build / "datasets/datasets.bin")) == datasetBytes && + (← readJson (build / "datasets/datasets.json")) == datasetJson && + (← strField metadata "datasets_blake3") == digest datasetBytes) "benchmark datasets changed or disagree with oracle" + inspectFiles (build / "artifacts") (← field metadata "artifacts") + inspectFiles (build / "bin") (← field metadata "executables") + inspectFiles (build / "tools-bin") (← field metadata "tools") + need (digest (← IO.FS.readBinFile (build / "tool-identities.json")) == (← strField metadata "tool_identities_blake3")) + "tool identity inventory changed" + return metadata + +def originalHarness (build output : FilePath) (tools : Toolchains) : IO Json := do + let n2 := build / "artifacts/compilatrix" + let report ← readJson (n2 / "report.json") + let rows ← arrField report "cases" + let initializers ← rows.mapM fun row => do + let name ← strField row "name" + let values ← (← arrField row "input").mapM fun value => do return s!"UINT64_C({← nat value})" + return "{\"" ++ name ++ "\"," ++ toString values.size ++ ",{ " ++ + (if values.isEmpty then "0" else String.intercalate "," values.toList) ++ " }}" + IO.FS.writeFile (output / "runtime_cases.h") + ("static const Input inputs[] = {\n" ++ String.intercalate ",\n" initializers.toList ++ "\n};\n") + let mut summaries := #[] + for implementation in ["compilatrix", "compcert", "gcc", "clang"] do + let objects := if implementation == "compilatrix" then #[(n2 / "main.o").toString, (n2 / "release.o").toString] + else #[(build / s!"artifacts/{implementation}/kernel.o").toString] + let binary := output / s!"original-{implementation}" + let _ ← logged (output / "logs") s!"original-link-{implementation}" tools.gcc + (#["-std=c11", "-O2", "-fomit-frame-pointer", "-Wall", "-Wextra", "-Werror", "-no-pie", + "-I", output.toString, "Tests/Fixtures/Compiler/source-native-runtime/native_harness.c"] ++ objects ++ + #["-Wl,-z,noexecstack", "-o", binary.toString]) #[] none tools.timerTool + let result ← logged (output / "logs") s!"original-run-{implementation}" binary.toString #[] #[] none tools.timerTool + let observed ← array (← checked (Json.parse result)) + need (observed.size == rows.size) "original native matrix incomplete" + let mut rejections := 0 + for index in [:rows.size] do + let expected ← field (← readJson (n2 / (← strField rows[index]! "snapshot"))) "native" + need ((← field observed[index]! "name") == (← field rows[index]! "name")) "original native case name drifted" + for key in ["input", "root", "value", "returned", "reclaimed", "rejections"] do + need ((← field observed[index]! key) == (← field expected key)) s!"{implementation}: original byte/native {key} disagreement" + rejections := rejections + (← arrField observed[index]! "rejections").size + need (rejections == 203) "original malformed input inventory drifted" + summaries := summaries.push (Json.mkObj [("implementation", toJson implementation), + ("successful_inputs", toJson rows.size), ("malformed_inputs", toJson rejections), + ("observations_blake3", toJson (digest (Json.arr observed).compress.toUTF8))]) + return Json.arr summaries + +def malformedDatasets (build output : FilePath) : IO Json := do + let cases : Array (String × ByteArray × String) := #[ + ("magic", datasetBytes.set! 0 0, "wrong binary magic"), + ("count", datasetBytes.set! 8 0, "wrong dataset inventory"), + ("metadata", datasetBytes.set! 16 1, "noncanonical dataset metadata"), + ("padding", datasetBytes.set! 48 1, "nonzero dataset padding"), + ("trailing", datasetBytes.push 0, "trailing binary input"), + ("truncated", datasetBytes.extract 0 (datasetBytes.size - 1), "truncated binary input")] + let mut results := #[] + for (name, bytes, expected) in cases do + let path := output / s!"bad-{name}.bin" + IO.FS.writeBinFile path bytes + for implementation in implementations do + let result ← IO.Process.output { + cmd := (build / s!"bin/{implementation}").toString + args := #[implementation, "verify", path.toString] + env := runtimeEnv } + need (result.exitCode != 0 && result.stderr.contains expected) s!"{implementation} accepted malformed dataset {name}" + results := results.push (Json.mkObj [("implementation", toJson implementation), ("case", toJson name), + ("exit_code", toJson result.exitCode.toNat), ("stderr", toJson result.stderr)]) + return Json.arr results + +def verifySuite (build output : FilePath) : IO Unit := do + let build ← absolute build + let output ← absolute output + fresh output + let metadata ← inspectBuild build + let tools ← checked (fromJson? (← field metadata "tool_commands") : Except String Toolchains) + let mut summaries := #[] + let mut arenaIdentity : Option Json := none + for implementation in implementations do + let result ← logged (output / "logs") s!"matrix-{implementation}" (build / s!"bin/{implementation}").toString + #[implementation, "verify", (build / "datasets/datasets.bin").toString] runtimeEnv none tools.timerTool + IO.FS.writeFile (output / s!"{implementation}.jsonl") result + let rows ← readLines (output / s!"{implementation}.jsonl") + let before ← IO.monoNanosNow + let summary ← inspectMatrix implementation rows + checkerRegressions implementation rows + let checkNs := (← IO.monoNanosNow) - before + if isArena implementation then + let identity ← field summary "matrix_blake3" + if let some expected := arenaIdentity then need (identity == expected) "matched arena complete observations differ" + arenaIdentity := some identity + summaries := summaries.push (Json.mkObj [("result", summary), ("independent_check_ns", toJson checkNs)]) + IO.println s!"benchmark verify: {implementation} complete matrix checked" + let original ← originalHarness build output tools + let binaryNegatives ← malformedDatasets build output + -- Check the artifacts again after every executable and diagnostic has run. + let _ ← inspectBuild build + writeJson (output / "correctness.json") (Json.mkObj [ + ("format", toJson "compilatrix/benchmark-correctness/1"), ("build_blake3", toJson (digest (← IO.FS.readBinFile (build / "build.json")))), + ("executables", ← field metadata "executables"), ("matrices", Json.arr summaries), + ("original_native_matrix", original), ("malformed_datasets", binaryNegatives), + ("word_overflow_rejected", toJson true), ("full_values", toJson true), ("status", toJson "passed")]) + IO.println "benchmark verify: six implementations, original ABI/rejection matrix, malformed inputs, and checker corruptions passed" + +end Benchmarks.Compiler diff --git a/Benchmarks/Compiler/cakeml/reverse.cml b/Benchmarks/Compiler/cakeml/reverse.cml new file mode 100644 index 000000000..7ab51cc97 --- /dev/null +++ b/Benchmarks/Compiler/cakeml/reverse.cml @@ -0,0 +1,132 @@ +(* Ordinary int lists; each input spine is constructed independently. + Recursive reversal remains a callable boundary in the optimized IR. *) +fun reverseOnto xs acc = + case xs of [] => acc | x::rest => reverseOnto rest (x::acc); +fun reverse xs = reverseOnto xs []; + +val packet = Word8Array.array 1024 (Word8.fromInt 0); +fun ffi command = #(bench) command packet; +fun getWord offset = + let fun loop i acc = if i < 0 then acc else + loop (i - 1) (acc * 256 + Word8.toInt (Word8Array.sub packet (offset + i))) + in loop 7 0 end; +fun putWord offset value = + let fun loop i rest = if i = 8 then () else + (Word8Array.update packet (offset + i) (Word8.fromInt (rest mod 256)); loop (i + 1) (rest div 256)) + in loop 0 value end; +fun times n f = let fun loop i = if i = n then () else (f i; loop (i + 1)) in loop 0 end; + +val () = ffi "init"; +val verifyMode = getWord 0 = 1; +val rowCount = getWord 8; +val samples = getWord 16; +val diagnostic = getWord 32 = 1; +val scalars = Array.tabulate 585 (fn id => + (putWord 0 id; ffi "input"; Array.tabulate (getWord 0) (fn i => getWord (8 + 8 * i)))); +fun make id = + let val values = Array.sub scalars id + fun loop i acc = if i < 0 then acc else loop (i - 1) (Array.sub values i :: acc) + in loop (Array.length values - 1) [] end; + +(* The pinned Word64 basis has shifts and addition but no multiplication. + This exactly multiplies by 2^40 + 2^8 + 2^7 + 2^5 + 2^4 + 2 + 1. *) +fun fnvMultiply x = Word64.+ (Word64.<< x 40) + (Word64.+ (Word64.<< x 8) (Word64.+ (Word64.<< x 7) + (Word64.+ (Word64.<< x 5) (Word64.+ (Word64.<< x 4) (Word64.+ (Word64.<< x 1) x))))); +val basis = Word64.fromInt 14695981039346656037; +val zeroWord = Word64.fromInt 0; +fun digest xs = + let fun loop ys acc = case ys of [] => acc | x::rest => loop rest (fnvMultiply (Word64.xorb acc (Word64.fromInt x))) + in loop xs basis end; + +val inputSlots = Array.array 4096 (make 0); +val outputSlots = Array.array 4096 (make 0); +fun inputId n domain opIndex = n * 9 + (if domain = 0 then opIndex mod 6 else domain + 5); +fun prepare n domain offset = times 4096 (fn i => Array.update inputSlots i (make (inputId n domain (offset + i)))); +fun enter () = times 4096 (fn i => + let val owned = Array.sub inputSlots i + val () = Array.update inputSlots i [] + in Array.update outputSlots i (reverse owned) end); +fun consume () = + let fun loop i acc = if i = 4096 then acc else + let val owned = Array.sub outputSlots i + val () = Array.update outputSlots i [] + in loop (i + 1) (Word64.+ acc (digest owned)) end + in loop 0 zeroWord end; +fun lifecycle n domain offset = + let fun loop i acc = if i = 4096 then acc else + loop (i + 1) (Word64.+ acc (digest (reverse (make (inputId n domain (offset + i)))))) + in loop 0 zeroWord end; +fun chunk n domain profile offset timed = + if profile = 0 then + (prepare n domain offset; + if timed then ffi "clock-start" else (); + enter (); + if timed then ffi "clock-stop" else (); + consume ()) + else + let val () = if timed then ffi "clock-start" else () + val result = lifecycle n domain offset + val () = if timed then ffi "clock-stop" else () + in result end; + +fun check id emit = + let val result = reverse (make id) + val n = Array.length (Array.sub scalars id) + fun values xs index = case xs of + [] => if index = n then () else Runtime.abort () + | x::rest => if index >= n then Runtime.abort () else + (putWord (32 + 8 * index) x; values rest (index + 1)) + val () = values result 0 + val hash = digest result + val () = putWord 0 id + val () = putWord 8 n + val () = putWord 16 (Word64.toInt hash) + val () = putWord 24 emit + in ffi "verify" end; + +fun control () = + (ffi "control-start"; + times 1024 (fn _ => enter ()); + putWord 0 (List.length (Array.sub outputSlots 0)); + ffi "control-end"); +fun warm () = + let val () = ffi "warm-start" + fun loop operations acc = + let val next = Word64.+ acc (chunk 64 0 1 operations False) + val count = operations + 4096 + val () = ffi "warm-test" + in if getWord 0 = 1 then + (putWord 0 count; putWord 8 (Word64.toInt next); ffi "warm-end") + else loop count next + end + in loop 0 zeroWord end; +fun runRow index = + let val () = putWord 0 index + val () = ffi "row" + val n = getWord 8 + val domain = getWord 16 + val profile = getWord 24 + val operations = getWord 32 + fun sample index = + let val () = ffi "sample-begin" + fun loop offset acc = if offset = operations then acc else + loop (offset + 4096) (Word64.+ acc (chunk n domain profile offset True)) + val sink = loop 0 zeroWord + val () = putWord 0 index + val () = putWord 8 (Word64.toInt sink) + val () = ffi "sample-end" + in times (if domain = 0 then 6 else 1) (fn p => check (inputId n domain p) 0) end + in times samples sample end; + +val () = control (); +val () = if verifyMode then times 585 (fn id => check id 1) + else (warm (); times rowCount runRow); +(* Keep the request opaque: the pinned compiler folds an inlined ConfigGC + * with constant arguments. This separate diagnostic requires an actual + * additional traced collection, checked by the Lean runner. *) +val () = if diagnostic then + let val request = Array.array 1 Runtime.fullGC + in ffi "terminal-start"; (Array.sub request 0) (); ffi "terminal-end" end + else (); +val () = ffi "finish"; diff --git a/Benchmarks/Compiler/counter-fold.md b/Benchmarks/Compiler/counter-fold.md new file mode 100644 index 000000000..3d16ce54c --- /dev/null +++ b/Benchmarks/Compiler/counter-fold.md @@ -0,0 +1,80 @@ +# Checked reserve/reuse counter folding: paired protocol + +This PERF3 experiment uses the runtime reversal source and every dataset, +timing row, full-result oracle, driver operation and timer convention from +[protocol version 1](protocol.md). The comparison is `baseline` versus +`counter-fold`, built by the same producer with identical GCC 14.3.0 driver +objects and link options. Native records identify the common `compilatrix` +driver; enclosing records bind the variant to its actual executable digest. + +The selected rewrite removes only the cancelling reservation/live counter +changes in an adjacent reserve/reuse pair: twelve instructions per consumed +cons cell. It retains all cell loads/stores and cumulative reuse/payload +counter updates. Every final general-purpose register and arena word agrees +with the baseline. +The combined operation is atomic with respect to the source resource relation; +intermediate reservation accounting is not an observation boundary for the +folded body. The canonical exclusive-arena, guard, ABI and word-range contracts +are identical. The default selector still emits the original baseline. + +Both variants pass the independent native artifact gate, eight runtime inputs, +203 malformed calls, complete reclamation and corruption tests. The timing +binaries also pass all 585 inputs and 19,305 capacity cases, with exact equality +of complete arena observations, malformed-dataset checks and timing smoke. +The gate's `--artifacts` option binds every benchmark artifact byte for byte +to its freshly checked counterparts. The paired build pins both reviewed goldens; the original PERF1 manifest and +reference bundle retain their original identities. + +The pilot targets 200 ms, taking the larger count required by either variant +for each row and rounding to a multiple of 24,576 operations (4,096 chunks, +six primary patterns). A confirmation pass requires at least 100 ms before +freezing all counts. There are 30 paired blocks, in three groups of ten, +separated by 60 seconds. Row and variant orders use the existing deterministic +shuffle with seed 1210345809. Each variant starts a new worker process for +each block, warms for one second and records three samples for all 38 rows: +6,840 accepted samples in total. Workers and controller are pinned separately. +All builds, checks and network setup finish before the pilot. + +The existing floors apply: at least 100 ms per sample, minimum chunk duration +at least 100 times the observed minimum clock-pair cost, peak worker RSS no +greater than 2 GiB, and no drift in recorded stable machine/environment fields. +At most three complete attempts are retained for an invalid block; wrong +results, artifacts, schemas or process failures stop publication. Every valid +slow observation stays. The timer control is retained without subtraction. + +Analysis uses the median of three samples per variant/block and reports all +38 baseline/folded distributions and paired ratios. Ratios above one favor +folding. The same 10,000 hierarchical bootstrap index vectors resample three +sessions and ten paired blocks within each selected session, seed 2671931027. +This shared-host experiment and its three clusters cannot establish CI timing +thresholds or remove between-day uncertainty. RSS, raw context switches, +page faults, environment observations and timer controls remain in the bundle. + +Generation and independent-gate wall/CPU/RSS are diagnostic envelopes, not +isolated compiler or proof-checker phases. Generation includes modeled fixture +executions; each independent gate includes two generations, artifact checking, +corruption regressions and a native harness. The report includes both envelopes, +serialized pipeline bytes and object `.text` sizes. The proof checks are run +before timing and documented separately. + +Run in the pinned repository environment, using fresh directories: + +```sh +lake build compiler-benchmark compiler-source-native-runtime compiler-check-source-native-runtime +.lake/build/bin/compiler-benchmark counter-fold-build BUILD +.lake/build/bin/compiler-benchmark counter-fold-verify BUILD VERIFY +.lake/build/bin/compiler-benchmark counter-fold-smoke BUILD SMOKE 2 +taskset --cpu-list 0 .lake/build/bin/compiler-benchmark counter-fold-pilot BUILD VERIFY PILOT 2 +taskset --cpu-list 0 .lake/build/bin/compiler-benchmark counter-fold-measure BUILD VERIFY PILOT MEASURED 2 +.lake/build/bin/compiler-benchmark counter-fold-analyze BUILD MEASURED MEASURED/analysis +.lake/build/bin/compiler-benchmark counter-fold-reproduce BUILD MEASURED REPLAY +``` + +Select available controller/worker cores before piloting and retain them for +measurement. Replay extracts and validates the source snapshot, uses an empty +environment plus recorded variables and retained hashed producer/checker seeds, +rebuilds exact objects/executables, repeats full correctness, and regenerates +the same analysis from retained raw process records. It does not equate fresh +clock readings or claim an independent physical host. The source, tools, +objects, schedules, raw samples, diagnostic costs and replay are retained in +a digest-addressed archive under `benchmarks/runs/`. diff --git a/Benchmarks/Compiler/lean/LeanReverse.lean b/Benchmarks/Compiler/lean/LeanReverse.lean new file mode 100644 index 000000000..e556a85eb --- /dev/null +++ b/Benchmarks/Compiler/lean/LeanReverse.lean @@ -0,0 +1,12 @@ +import Init + +/- The consuming argument is deliberately not borrowed. The C driver owns +each list exactly once, clears its input slot before this call, and checks +exclusivity and cell reuse in a separate diagnostic run. -/ +@[noinline] +def benchReverseOnto : List Nat → List Nat → List Nat + | [], accumulator => accumulator + | value :: rest, accumulator => benchReverseOnto rest (value :: accumulator) + +@[noinline, export bench_lean_reverse] +def benchReverse (input : List Nat) : List Nat := benchReverseOnto input [] diff --git a/Benchmarks/Compiler/manifest.json b/Benchmarks/Compiler/manifest.json new file mode 100644 index 000000000..e8886eeb1 --- /dev/null +++ b/Benchmarks/Compiler/manifest.json @@ -0,0 +1,88 @@ +{ + "format": "compilatrix/benchmark-suite/1", + "workload": "native-reverse/1", + "toolchains": "toolchains.json", + "implementations": ["compilatrix", "lean", "cakeml", "compcert", "gcc", "clang"], + "comparison_groups": { + "language_runtime": ["compilatrix", "lean", "cakeml"], + "matched_arena": ["compilatrix", "compcert", "gcc", "clang"] + }, + "compilatrix": { + "origin": "synthetic-ixon-runtime-function", + "producer": "source-native-runtime", + "correctness_gate": "check-source-native-runtime", + "source_identity": "98a3fce164301466d4a5bbc36d847a2515d45b1c97b788b38af411a6d2b17815", + "ixir1_root": "6f0a0fc8cd38011ce68c710019fe0f6dc53ebaf691508cf2c4ce67345865b1df", + "main_identity": "2e2e92297dc85259600f807045e2442e3e890812fdaa5af2f85a8f250bb80a9e", + "release_identity": "ee24dd7813f34e83cc165e2517e1d96a7c21f243d9c0fdf2301b11d63822263d", + "pipeline_identity": "bf9fc4c3d067dde6f3e3513f64910f68add1cb1862c86da616612e503af3b427", + "policy": "production guards, counters, and static unique reuse; one object pair for every input" + }, + "datasets": { + "generator": "xorshift64star-patterns/1", + "generator_source": "Benchmark/Data.lean", + "binary_bytes": 318256, + "binary_blake3": "9e7b53b6321516f99019b0c55c99b719b89b046c0cf7281b7f545b3d9625a8f5", + "input_cases": 585, + "arena_capacity_cases": 19305, + "length_range": [0, 64], + "primary_patterns": ["zero", "repeated", "ascending", "descending", "alternating", "random"], + "primary_upper_bound_exclusive": 1073741824, + "stress_values": [9223372036854775807, 9223372036854775808, 18446744073709551615], + "primary_timing_lengths": [0, 1, 2, 4, 8, 16, 32, 48, 63, 64], + "stress_timing_lengths": [1, 16, 64], + "primary_pattern_schedule": "absolute operation index modulo six" + }, + "ownership": { + "input_list_owners": 1, + "input_slot": "cleared before the consuming call", + "scalar_inputs": "immutable pre-generated scalar values may be shared", + "output_slots_per_chunk": 4096, + "reclamation": "release each returned list; tracing-GC cycles and terminal collection are reported separately" + }, + "timing": { + "profiles": ["entry+handoff", "lifecycle"], + "rows": 38, + "storage_profile": "fresh allocation", + "arena_capacity": "length + 2", + "chunk_operations": 4096, + "timer": "CLOCK_MONOTONIC_RAW", + "minimum_sample_ns": 100000000, + "pilot_target_ns": 200000000, + "warmup_ns_per_process": 1000000000, + "samples_per_block": 3, + "blocks": 30, + "sessions": 3, + "session_separation_seconds": 60, + "maximum_rss_kb": 2097152, + "minimum_chunk_clock_pair_factor": 100, + "order_seed": 1210345809, + "outlier_policy": "retain every valid block, including slow observations", + "operation_counts": "pilot then freeze identical counts for every implementation in a paired case", + "sink": "per-list fold h=(h xor value)*1099511628211 modulo 2^64, starting at 14695981039346656037; sum list digests modulo 2^64" + }, + "analysis": { + "within_block": "median", + "distribution": ["median", "q25", "q75", "ci95_low", "ci95_high"], + "speedup": "baseline_ns_per_operation / compilatrix_ns_per_operation", + "bootstrap": "hierarchical paired bootstrap: resample three sessions, then ten whole paired blocks within each selected session", + "bootstrap_replicates": 10000, + "bootstrap_seed": 2671931027, + "aggregate_workload_ranking": false + }, + "diagnostics": { + "cakeml_lifecycle_rows": [28, 31, 34, 37], + "samples_per_row": 5, + "maximum_post_gc_live_bytes_exclusive": 8388608, + "minimum_natural_collections_per_sample": 1, + "terminal_collection": "one separately timed collection after all diagnostic samples" + }, + "upstream_computations": { + "selector": "closed-unary-nat-calls/1", + "entries": ["applyClosed", "letClosed"], + "runtime_arguments": 0, + "profile": "opaque native call plus scalar sum sink; separate from reversal", + "blocks": 30, + "samples_per_block": 3 + } +} diff --git a/Benchmarks/Compiler/native/arena.h b/Benchmarks/Compiler/native/arena.h new file mode 100644 index 000000000..c7f292697 --- /dev/null +++ b/Benchmarks/Compiler/native/arena.h @@ -0,0 +1,17 @@ +#ifndef COMPILATRIX_BENCH_ARENA_H +#define COMPILATRIX_BENCH_ARENA_H + +#include + +enum { BENCH_MAX_LENGTH = 64, BENCH_MAX_CAPACITY = 66, HEADER_WORDS = 10, CELL_WORDS = 4 }; +enum { CURSOR, CAPACITY, ALLOCS, FREES, REUSES, LIVE, PEAK, RCOPS, PAYLOAD, RESERVATIONS }; + +typedef struct { + uint64_t header[HEADER_WORDS]; + uint64_t cells[][CELL_WORDS]; +} Arena; + +uint64_t compilatrix_runtime_reverse(Arena *arena, uint64_t length); +uint64_t compilatrix_runtime_drop(Arena *arena, uint64_t root); + +#endif diff --git a/Benchmarks/Compiler/native/arena_backend.c b/Benchmarks/Compiler/native/arena_backend.c new file mode 100644 index 000000000..596e6161b --- /dev/null +++ b/Benchmarks/Compiler/native/arena_backend.c @@ -0,0 +1,130 @@ +#include "common.h" +#include "arena.h" +#include +#include + +static void prepare(Arena *arena, const BenchInput *input, uint64_t capacity) { + memset(arena, 0, 80 + 32 * capacity); + arena->header[CURSOR] = 32 * (input->n + 1); + arena->header[CAPACITY] = 32 * capacity; + arena->header[ALLOCS] = arena->header[LIVE] = arena->header[PEAK] = input->n + 1; + for (uint64_t i = 1; i <= input->n; ++i) { + arena->cells[i][0] = 1; + arena->cells[i][1] = input->values[input->n - i]; + arena->cells[i][2] = (uintptr_t)arena->cells[i - 1]; + } +} +void backend_init(void) {} +void backend_finish(void) {} +BenchItem backend_make(const BenchInput *input, uint64_t capacity) { + Arena *arena = malloc(80 + 32 * capacity); + bench_need(arena != NULL, "arena allocation failed"); + prepare(arena, input, capacity); + return (BenchItem){arena, input->n}; +} +BenchItem backend_reverse(BenchItem input, uint64_t n) { + return (BenchItem){input.owner, compilatrix_runtime_reverse(input.owner, n)}; +} +uint64_t backend_digest(BenchItem output) { + uint64_t *cell = (uint64_t *)(uintptr_t)output.value, hash = UINT64_C(14695981039346656037); + while (cell[0] == 1) { + hash = (hash ^ cell[1]) * UINT64_C(1099511628211); + cell = (uint64_t *)(uintptr_t)cell[2]; + } + return hash; +} +void backend_release(BenchItem output) { + compilatrix_runtime_drop(output.owner, output.value); + free(output.owner); +} +uint64_t backend_capacity_count(const BenchInput *input) { return 65 - input->n; } + +/* Same physical SysV observations as the existing N2 gate. Diagnostics only. */ +__attribute__((noinline)) +static uint64_t checked_call(uint64_t (*entry)(Arena *, uint64_t), Arena *arena, uint64_t root) { + register uint64_t bx __asm__("rbx") = UINT64_C(0x1020304050607080); + register uint64_t bp __asm__("rbp") = UINT64_C(0x2131415161718191); + register uint64_t r12 __asm__("r12") = UINT64_C(0x32425262728292a2); + register uint64_t r13 __asm__("r13") = UINT64_C(0x435363738393a3b3); + register uint64_t r14 __asm__("r14") = UINT64_C(0x5464748494a4b4c4); + register uint64_t r15 __asm__("r15") = UINT64_C(0x65758595a5b5c5d5); + uintptr_t before, after; + __asm__ volatile("" : "+r"(bx), "+r"(bp), "+r"(r12), "+r"(r13), "+r"(r14), "+r"(r15) : : "memory"); + __asm__ volatile("mov %%rsp, %0" : "=r"(before)); + uint64_t result = entry(arena, root); + __asm__ volatile("mov %%rsp, %0" : "=r"(after)); + __asm__ volatile("" : "+r"(bx), "+r"(bp), "+r"(r12), "+r"(r13), "+r"(r14), "+r"(r15) : : "memory"); + bench_need(before == after, "stack pointer changed"); + bench_need(bx == UINT64_C(0x1020304050607080) && bp == UINT64_C(0x2131415161718191) && + r12 == UINT64_C(0x32425262728292a2) && r13 == UINT64_C(0x435363738393a3b3) && + r14 == UINT64_C(0x5464748494a4b4c4) && r15 == UINT64_C(0x65758595a5b5c5d5), "callee-saved register changed"); + return result; +} +static uint64_t spare(uint64_t cell, uint64_t field) { + return UINT64_C(0xc13fa9a902a6328f) ^ (cell * 17 + field); +} +static void frame(const uint64_t *storage, uint64_t words, const Arena *arena, uint64_t n, uint64_t capacity) { + bench_need(storage[0] == UINT64_C(0xfedcba9876543210) && storage[1] == UINT64_C(0x123456789abcdef0) && + storage[words + 2] == UINT64_C(0xfedcba9876543210) && storage[words + 3] == UINT64_C(0x123456789abcdef0), + "arena canary changed"); + for (uint64_t i = n + 2; i < capacity; ++i) + for (uint64_t j = 0; j < 4; ++j) bench_need(arena->cells[i][j] == spare(i, j), "unused capacity changed"); +} +static void headers(const Arena *arena, uint64_t n, uint64_t capacity, int released) { + const uint64_t expected[10] = {32 * (n + 2), 32 * capacity, n + 2, released ? n + 2 : 1, + n, released ? 0 : n + 1, n + 2, 0, 2 * n, 0}; + bench_need(memcmp(arena->header, expected, sizeof expected) == 0, "arena counters mismatch"); +} +static void heap(const Arena *arena, uint64_t n) { + printf("{\"header\":"); bench_values(arena->header, 10); printf(",\"cells\":["); + for (uint64_t i = 0; i < n + 2; ++i) { + const uint64_t *cell = arena->cells[i]; + printf("%s[%" PRIu64 ",%" PRIu64 ",", i ? "," : "", cell[0], cell[1]); + if (cell[2] == 0) printf("null"); + else printf("%" PRIu64, (cell[2] - (uint64_t)(uintptr_t)arena->cells) / 32); + printf(",%" PRIu64 "]", cell[3]); + } + printf("]}"); +} +void backend_verify(const BenchInput *input, uint64_t capacity, int emit) { + uint64_t n = input->n, words = 10 + 4 * capacity; + uint64_t *storage = malloc((words + 4) * 8); + bench_need(storage != NULL, "diagnostic allocation failed"); + storage[0] = storage[words + 2] = UINT64_C(0xfedcba9876543210); + storage[1] = storage[words + 3] = UINT64_C(0x123456789abcdef0); + Arena *arena = (Arena *)(storage + 2); + prepare(arena, input, capacity); + for (uint64_t i = n + 2; i < capacity; ++i) + for (uint64_t j = 0; j < 4; ++j) arena->cells[i][j] = spare(i, j); + uint64_t root = checked_call(compilatrix_runtime_reverse, arena, n); + bench_need(root == (uintptr_t)arena->cells[1], "wrong arena result root"); + headers(arena, n, capacity, 0); frame(storage, words, arena, n, capacity); + uint64_t values[MAX_N]; + for (uint64_t i = 0; i < n + 2; ++i) { + const uint64_t *cell = arena->cells[i]; + if (i == 0) bench_need(cell[0] == 3 && cell[1] == 0 && cell[2] == 0 && cell[3] == 0, "old nil not freed"); + else if (i == n + 1) bench_need(cell[0] == 0 && cell[1] == 0 && cell[2] == 0 && cell[3] == 0, "new nil invalid"); + else { + bench_need(cell[0] == 1 && cell[1] == input->values[n - i] && + cell[2] == (uintptr_t)arena->cells[i + 1] && cell[3] == 0, "reversed cell mismatch"); + values[i - 1] = cell[1]; + } + } + uint64_t hash = backend_digest((BenchItem){arena, root}); + bench_need(hash == input->digest, "arena digest mismatch"); + if (emit) { + printf("{\"kind\":\"case\",\"id\":%" PRIu64 ",\"capacity\":%" PRIu64 ",\"values\":", + n * 9 + input->pattern, capacity); + bench_values(values, n); printf(",\"digest\":%" PRIu64 ",\"returned\":", hash); heap(arena, n); + } + bench_need(checked_call(compilatrix_runtime_drop, arena, root) == 0, "release result mismatch"); + headers(arena, n, capacity, 1); frame(storage, words, arena, n, capacity); + for (uint64_t i = 0; i < n + 2; ++i) + bench_need(arena->cells[i][0] == 3 && arena->cells[i][1] == 0 && + arena->cells[i][2] == 0 && arena->cells[i][3] == 0, "incomplete arena release"); + if (emit) { + printf(",\"reclaimed\":"); heap(arena, n); + printf(",\"abi_preserved\":true,\"canaries_preserved\":true,\"unused_capacity_preserved\":true}\n"); + } + free(storage); +} diff --git a/Benchmarks/Compiler/native/arena_kernel.c b/Benchmarks/Compiler/native/arena_kernel.c new file mode 100644 index 000000000..94ba1368e --- /dev/null +++ b/Benchmarks/Compiler/native/arena_kernel.c @@ -0,0 +1,70 @@ +/* One C implementation is compiled unchanged by CompCert, GCC, and Clang. + The caller supplies mapped, aligned storage for the declared capacity. + All integer checks precede cell pointer formation. The guards, counters, + cell reuse, and complete release match native-reverse/1's production ABI. */ +#include "arena.h" + +uint64_t compilatrix_runtime_reverse(Arena *arena, uint64_t length) { + uint64_t base = (uint64_t)(uintptr_t)arena; + uint64_t capacity, cursor, index, accumulator; + if (length > BENCH_MAX_LENGTH || base == 0 || base % 8 != 0) + return 0; + capacity = arena->header[CAPACITY]; + cursor = 32 * (length + 1); + if (capacity > 32 * BENCH_MAX_CAPACITY || capacity % 32 != 0 || + capacity < cursor + 32 || base > UINT64_MAX - 80 - capacity) + return 0; + if (arena->header[CURSOR] != cursor || + arena->header[ALLOCS] != length + 1 || arena->header[FREES] != 0 || + arena->header[REUSES] != 0 || arena->header[LIVE] != length + 1 || + arena->header[PEAK] != length + 1 || arena->header[RCOPS] != 0 || + arena->header[PAYLOAD] != 0 || arena->header[RESERVATIONS] != 0) + return 0; + if (arena->cells[0][0] != 0 || arena->cells[0][1] != 0 || + arena->cells[0][2] != 0 || arena->cells[0][3] != 0) + return 0; + for (index = 1; index <= length; ++index) { + if (arena->cells[index][0] != 1 || arena->cells[index][3] != 0 || + arena->cells[index][2] != (uint64_t)(uintptr_t)arena->cells[index - 1]) + return 0; + } + + index = length + 1; + arena->cells[index][0] = 0; + arena->cells[index][1] = 0; + arena->cells[index][2] = 0; + arena->cells[index][3] = 0; + accumulator = (uint64_t)(uintptr_t)arena->cells[index]; + arena->header[CURSOR] += 32; + ++arena->header[ALLOCS]; + ++arena->header[LIVE]; + arena->header[PEAK] = arena->header[LIVE]; + for (index = length; index != 0; --index) { + arena->cells[index][2] = accumulator; + accumulator = (uint64_t)(uintptr_t)arena->cells[index]; + ++arena->header[REUSES]; + arena->header[PAYLOAD] += 2; + } + arena->cells[0][0] = 3; + ++arena->header[FREES]; + --arena->header[LIVE]; + return accumulator; +} + +/* As in the emitted release entry, root must own a well-formed returned + chain. Invalid-input diagnostics exercise reversal's guarded entry. */ +uint64_t compilatrix_runtime_drop(Arena *arena, uint64_t root) { + uint64_t current = root; + while (current != 0) { + uint64_t *cell = (uint64_t *)(uintptr_t)current; + uint64_t next = cell[0] == 1 ? cell[2] : 0; + cell[0] = 3; + cell[1] = 0; + cell[2] = 0; + cell[3] = 0; + ++arena->header[FREES]; + --arena->header[LIVE]; + current = next; + } + return 0; +} diff --git a/Benchmarks/Compiler/native/cakeml_ffi.c b/Benchmarks/Compiler/native/cakeml_ffi.c new file mode 100644 index 000000000..30b30df47 --- /dev/null +++ b/Benchmarks/Compiler/native/cakeml_ffi.c @@ -0,0 +1,100 @@ +#include "common.h" +#include +#include + +extern unsigned int argc; +extern char **argv; +#ifdef BENCH_CAKEML_GC +extern int numGC; +extern long prevOcc, numAllocBytes, microsecs; +static int gc_before; +#endif +static int verifying; +static uint64_t row_index, warm_start, terminal_start; + +static int command(const unsigned char *text, long length, const char *expected) { + return length == (long)strlen(expected) && memcmp(text, expected, length) == 0; +} +void ffibench(unsigned char *config, long length, unsigned char *bytes, long size) { + bench_need(size == 1024, "CakeML FFI packet size mismatch"); + if (command(config, length, "init")) { + bench_need(argc == 4 || argc == 5, "invalid CakeML driver arguments"); + bench_implementation = argv[1]; verifying = strcmp(argv[2], "verify") == 0; + bench_need((verifying && argc == 4) || (!verifying && argc == 5 && strcmp(argv[2], "run") == 0), "invalid CakeML mode"); + bench_load(argv[3], verifying ? NULL : argv[4]); + bench_metadata(); + bench_put_word(bytes, verifying); bench_put_word(bytes + 8, bench_schedule.count); + bench_put_word(bytes + 16, bench_schedule.samples); bench_put_word(bytes + 24, bench_schedule.warm_ns); +#ifdef BENCH_CAKEML_GC + bench_put_word(bytes + 32, 1); +#else + bench_put_word(bytes + 32, 0); +#endif + } else if (command(config, length, "input")) { + uint64_t id = bench_word(bytes); + bench_need(id < INPUT_COUNT, "CakeML input id out of range"); + bench_put_word(bytes, bench_inputs[id].n); + for (uint64_t i = 0; i < MAX_N; ++i) bench_put_word(bytes + 8 + i * 8, bench_inputs[id].values[i]); + } else if (command(config, length, "row")) { + row_index = bench_word(bytes); + bench_need(row_index < bench_schedule.count, "CakeML row out of range"); + const BenchRow *row = &bench_schedule.rows[row_index]; + bench_put_word(bytes, row->id); bench_put_word(bytes + 8, row->n); bench_put_word(bytes + 16, row->domain); + bench_put_word(bytes + 24, row->profile); bench_put_word(bytes + 32, row->operations); + } else if (command(config, length, "sample-begin")) { + bench_sample_begin(); +#ifdef BENCH_CAKEML_GC + gc_before = numGC; +#endif + } else if (command(config, length, "clock-start")) bench_clock_start(); + else if (command(config, length, "clock-stop")) bench_clock_stop(); + else if (command(config, length, "sample-end")) { + uint64_t sample = bench_word(bytes), sink = bench_word(bytes + 8); + bench_sample_end(&bench_schedule.rows[row_index], sample, sink); +#ifdef BENCH_CAKEML_GC + printf("{\"kind\":\"gc-sample\",\"row\":%" PRIu64 ",\"sample\":%" PRIu64 + ",\"collections\":%d,\"total_collections\":%d,\"last_post_gc_live_bytes\":%ld," + "\"allocated_bytes_at_last_gc\":%ld,\"total_gc_microseconds\":%ld}\n", + bench_schedule.rows[row_index].id, sample, numGC - gc_before, numGC, prevOcc, numAllocBytes, microsecs); +#endif + } else if (command(config, length, "warm-start")) warm_start = bench_now(); + else if (command(config, length, "warm-test")) bench_put_word(bytes, bench_now() - warm_start >= bench_schedule.warm_ns); + else if (command(config, length, "warm-end")) { + uint64_t operations = bench_word(bytes), sink = bench_word(bytes + 8); + BenchRow row = {28, 64, 0, 1, operations}; + bench_need(sink == bench_expected_sink(&row, operations), "CakeML warm-up sink mismatch"); + printf("{\"kind\":\"warmup\",\"elapsed_ns\":%" PRIu64 ",\"operations\":%" PRIu64 + ",\"sink\":%" PRIu64 "}\n", bench_now() - warm_start, operations, sink); + } else if (command(config, length, "control-start")) terminal_start = bench_now(); + else if (command(config, length, "control-end")) { + uint64_t duration = bench_now() - terminal_start; + bench_need(bench_word(bytes) == 0, "CakeML empty control mismatch"); + printf("{\"kind\":\"control\",\"name\":\"empty-reverse-handoff\",\"operations\":4194304,\"elapsed_ns\":%" PRIu64 + ",\"sink\":0}\n", duration); + } else if (command(config, length, "verify")) { + uint64_t id = bench_word(bytes), n = bench_word(bytes + 8), hash = bench_word(bytes + 16), emit = bench_word(bytes + 24); + bench_need(id < INPUT_COUNT && n == bench_inputs[id].n && hash == bench_inputs[id].digest, "CakeML result metadata mismatch"); + uint64_t values[MAX_N]; + for (uint64_t i = 0; i < n; ++i) { + values[i] = bench_word(bytes + 32 + 8 * i); + bench_need(values[i] == bench_inputs[id].values[n - i - 1], "CakeML reversed value mismatch"); + } + if (emit) { + printf("{\"kind\":\"case\",\"id\":%" PRIu64 ",\"capacity\":null,\"values\":", id); + bench_values(values, n); + printf(",\"digest\":%" PRIu64 ",\"roots_dropped\":true}\n", hash); + } + } else if (command(config, length, "terminal-start")) terminal_start = bench_now(); + else if (command(config, length, "terminal-end")) { +#ifdef BENCH_CAKEML_GC + printf("{\"kind\":\"terminal-gc\",\"elapsed_ns\":%" PRIu64 ",\"total_collections\":%d,\"post_gc_live_bytes\":%ld," + "\"rss_kb\":%" PRIu64 "}\n", bench_now() - terminal_start, numGC, prevOcc, bench_rss_kb()); +#else + bench_need(0, "terminal GC must use the diagnostic executable"); +#endif + } else if (command(config, length, "finish")) { + if (verifying) printf("{\"kind\":\"verified\",\"cases\":585}\n"); + else printf("{\"kind\":\"completed\",\"rows\":%" PRIu64 ",\"samples_per_row\":%" PRIu64 "}\n", + bench_schedule.count, bench_schedule.samples); + } else bench_need(0, "unknown CakeML FFI command"); +} diff --git a/Benchmarks/Compiler/native/common.c b/Benchmarks/Compiler/native/common.c new file mode 100644 index 000000000..ac3b5061d --- /dev/null +++ b/Benchmarks/Compiler/native/common.c @@ -0,0 +1,170 @@ +#define _GNU_SOURCE +#include "common.h" +#include +#include +#include +#include +#include +#include +#include + +BenchInput bench_inputs[INPUT_COUNT]; +BenchSchedule bench_schedule; +const char *bench_implementation; +static uint64_t elapsed, started, chunks, minimum_chunk; +static struct rusage sample_usage; +static uint64_t sample_envelope; + +void bench_need(int ok, const char *message) { + if (!ok) { fprintf(stderr, "benchmark: %s\n", message); exit(1); } +} +uint64_t bench_word(const unsigned char *bytes) { + uint64_t value = 0; + for (unsigned i = 0; i < 8; ++i) value |= (uint64_t)bytes[i] << (8 * i); + return value; +} +void bench_put_word(unsigned char *bytes, uint64_t value) { + for (unsigned i = 0; i < 8; ++i) bytes[i] = value >> (8 * i); +} +static uint64_t read_word(FILE *file) { + unsigned char bytes[8]; + bench_need(fread(bytes, 1, 8, file) == 8, "truncated binary input"); + return bench_word(bytes); +} +static FILE *open_binary(const char *name, const char *magic) { + FILE *file = fopen(name, "rb"); + unsigned char actual[8]; + bench_need(file != NULL, "cannot open binary input"); + bench_need(fread(actual, 1, 8, file) == 8 && memcmp(actual, magic, 8) == 0, "wrong binary magic"); + return file; +} +static void close_binary(FILE *file) { + bench_need(fgetc(file) == EOF && !ferror(file), "trailing binary input"); + bench_need(fclose(file) == 0, "cannot close binary input"); +} +void bench_load(const char *datasets, const char *schedule) { + FILE *file = open_binary(datasets, "CPBN001\n"); + bench_need(read_word(file) == INPUT_COUNT, "wrong dataset inventory"); + for (uint64_t id = 0; id < INPUT_COUNT; ++id) { + BenchInput *input = &bench_inputs[id]; + input->n = read_word(file); input->pattern = read_word(file); + input->domain = read_word(file); input->seed = read_word(file); + bench_need(input->n == id / 9 && input->pattern == id % 9 && + input->domain == (id % 9 < 6 ? 0 : id % 9 - 5), "noncanonical dataset metadata"); + for (uint64_t i = 0; i < MAX_N; ++i) { + input->values[i] = read_word(file); + bench_need(i < input->n || input->values[i] == 0, "nonzero dataset padding"); + bench_need(input->domain != 0 || input->values[i] < (UINT64_C(1) << 30), "primary value out of range"); + } + input->digest = UINT64_C(14695981039346656037); + for (uint64_t i = input->n; i != 0; --i) + input->digest = (input->digest ^ input->values[i - 1]) * UINT64_C(1099511628211); + } + close_binary(file); + if (schedule == NULL) return; + file = open_binary(schedule, "CPBS001\n"); + bench_schedule.count = read_word(file); bench_schedule.samples = read_word(file); + bench_schedule.warm_ns = read_word(file); bench_schedule.chunk = read_word(file); + bench_schedule.mode = read_word(file); + bench_need(bench_schedule.count > 0 && bench_schedule.count <= ROW_COUNT && + bench_schedule.samples > 0 && bench_schedule.samples <= 10 && + bench_schedule.warm_ns <= UINT64_C(10000000000) && bench_schedule.chunk == CHUNK && + bench_schedule.mode <= 2, "invalid schedule header"); + if (bench_schedule.mode == 2) + bench_need(bench_schedule.count == ROW_COUNT && bench_schedule.samples == 3 && + bench_schedule.warm_ns >= UINT64_C(1000000000), "incomplete measurement schedule"); + uint64_t seen = 0; + const uint64_t lengths[10] = {0, 1, 2, 4, 8, 16, 32, 48, 63, 64}; + const uint64_t stress_lengths[3] = {1, 16, 64}; + for (uint64_t i = 0; i < bench_schedule.count; ++i) { + BenchRow *row = &bench_schedule.rows[i]; + row->id = read_word(file); row->n = read_word(file); row->domain = read_word(file); + row->profile = read_word(file); row->operations = read_word(file); + bench_need(row->id < ROW_COUNT, "schedule row id out of range"); + uint64_t local = row->id % 19; + bench_need(row->profile == row->id / 19 && row->domain == (local < 10 ? 0 : 1 + (local - 10) / 3) && + row->n == (local < 10 ? lengths[local] : stress_lengths[(local - 10) % 3]) && + row->operations > 0 && row->operations <= UINT64_C(1000000000000) && + row->operations % (CHUNK * 6) == 0 && !(seen & (UINT64_C(1) << row->id)), "invalid schedule row"); + seen |= UINT64_C(1) << row->id; + } + close_binary(file); +} +uint64_t bench_now(void) { + struct timespec value; + bench_need(clock_gettime(CLOCK_MONOTONIC_RAW, &value) == 0, "monotonic timer unavailable"); + return (uint64_t)value.tv_sec * UINT64_C(1000000000) + value.tv_nsec; +} +uint64_t bench_rss_kb(void) { + FILE *file = fopen("/proc/self/statm", "r"); + unsigned long pages, resident; + bench_need(file != NULL && fscanf(file, "%lu %lu", &pages, &resident) == 2, "cannot read process RSS"); + fclose(file); + return (uint64_t)resident * (uint64_t)sysconf(_SC_PAGESIZE) / 1024; +} +void bench_metadata(void) { + uint64_t minimum = UINT64_MAX, sum = 0; + for (unsigned i = 0; i < 10000; ++i) { + uint64_t before = bench_now(), delta = bench_now() - before; + if (delta && delta < minimum) minimum = delta; + sum += delta; + } + struct timespec resolution; + bench_need(clock_getres(CLOCK_MONOTONIC_RAW, &resolution) == 0, "cannot read timer resolution"); + printf("{\"kind\":\"metadata\",\"format\":\"compilatrix/benchmark-native/1\",\"implementation\":\"%s\"," + "\"timer\":\"CLOCK_MONOTONIC_RAW\",\"resolution_ns\":%" PRIu64 ",\"timer_pair_min_ns\":%" PRIu64 + ",\"timer_pair_mean_ns\":%.4f,\"initial_rss_kb\":%" PRIu64 "}\n", bench_implementation, + (uint64_t)resolution.tv_sec * UINT64_C(1000000000) + resolution.tv_nsec, minimum, sum / 10000.0, bench_rss_kb()); +} +const BenchInput *bench_input(const BenchRow *row, uint64_t operation) { + uint64_t pattern = row->domain == 0 ? operation % 6 : row->domain + 5; + return &bench_inputs[row->n * 9 + pattern]; +} +uint64_t bench_expected_sink(const BenchRow *row, uint64_t operations) { + if (row->domain != 0) return bench_input(row, 0)->digest * operations; + uint64_t cycle = 0, rest = 0; + for (uint64_t i = 0; i < 6; ++i) { + cycle += bench_input(row, i)->digest; + if (i < operations % 6) rest += bench_input(row, i)->digest; + } + return cycle * (operations / 6) + rest; +} +void bench_values(const uint64_t *values, uint64_t n) { + printf("["); + for (uint64_t i = 0; i < n; ++i) printf("%s%" PRIu64, i ? "," : "", values[i]); + printf("]"); +} +void bench_sample_begin(void) { + elapsed = chunks = 0; minimum_chunk = UINT64_MAX; + bench_need(getrusage(RUSAGE_SELF, &sample_usage) == 0, "cannot read sample resource usage"); + sample_envelope = bench_now(); +} +void bench_clock_start(void) { started = bench_now(); } +void bench_clock_stop(void) { + uint64_t delta = bench_now() - started; + elapsed += delta; ++chunks; + if (delta < minimum_chunk) minimum_chunk = delta; +} +uint64_t bench_elapsed(void) { return elapsed; } +static uint64_t cpu_ns(struct rusage *usage) { + return ((uint64_t)usage->ru_utime.tv_sec + usage->ru_stime.tv_sec) * UINT64_C(1000000000) + + ((uint64_t)usage->ru_utime.tv_usec + usage->ru_stime.tv_usec) * 1000; +} +void bench_sample_end(const BenchRow *row, uint64_t sample, uint64_t sink) { + struct rusage usage; + uint64_t envelope = bench_now() - sample_envelope; + bench_need(getrusage(RUSAGE_SELF, &usage) == 0, "cannot read resource usage"); + bench_need(sink == bench_expected_sink(row, row->operations), "timed sink mismatch"); + bench_need(chunks == row->operations / CHUNK && elapsed > 0, "invalid timed chunk count"); + printf("{\"kind\":\"sample\",\"implementation\":\"%s\",\"mode\":%" PRIu64 + ",\"row\":%" PRIu64 ",\"sample\":%" PRIu64 ",\"operations\":%" PRIu64 + ",\"elapsed_ns\":%" PRIu64 ",\"chunks\":%" PRIu64 ",\"timer_calls\":%" PRIu64 + ",\"minimum_chunk_ns\":%" PRIu64 ",\"sink\":%" PRIu64 ",\"envelope_ns\":%" PRIu64 + ",\"envelope_cpu_ns\":%" PRIu64 ",\"rss_kb\":%" PRIu64 ",\"peak_rss_kb\":%ld" + ",\"minor_faults\":%ld,\"major_faults\":%ld,\"voluntary_switches\":%ld,\"involuntary_switches\":%ld}\n", + bench_implementation, bench_schedule.mode, row->id, sample, row->operations, elapsed, chunks, chunks * 2, + minimum_chunk, sink, envelope, cpu_ns(&usage) - cpu_ns(&sample_usage), bench_rss_kb(), usage.ru_maxrss, + usage.ru_minflt - sample_usage.ru_minflt, usage.ru_majflt - sample_usage.ru_majflt, + usage.ru_nvcsw - sample_usage.ru_nvcsw, usage.ru_nivcsw - sample_usage.ru_nivcsw); + fflush(stdout); +} diff --git a/Benchmarks/Compiler/native/common.h b/Benchmarks/Compiler/native/common.h new file mode 100644 index 000000000..eb64232a1 --- /dev/null +++ b/Benchmarks/Compiler/native/common.h @@ -0,0 +1,43 @@ +#ifndef COMPILATRIX_BENCH_COMMON_H +#define COMPILATRIX_BENCH_COMMON_H +#include +#include +#include +#include + +enum { INPUT_COUNT = 585, MAX_N = 64, MAX_C = 66, CHUNK = 4096, ROW_COUNT = 38 }; +typedef struct { uint64_t n, pattern, domain, seed, values[MAX_N], digest; } BenchInput; +typedef struct { uint64_t id, n, domain, profile, operations; } BenchRow; +typedef struct { + BenchRow rows[ROW_COUNT]; + uint64_t count, samples, warm_ns, chunk, mode; +} BenchSchedule; +extern BenchInput bench_inputs[INPUT_COUNT]; +extern BenchSchedule bench_schedule; +extern const char *bench_implementation; +void bench_need(int ok, const char *message); +uint64_t bench_word(const unsigned char *bytes); +void bench_put_word(unsigned char *bytes, uint64_t value); +void bench_load(const char *datasets, const char *schedule); +uint64_t bench_now(void); +uint64_t bench_rss_kb(void); +void bench_metadata(void); +const BenchInput *bench_input(const BenchRow *row, uint64_t operation); +uint64_t bench_expected_sink(const BenchRow *row, uint64_t operations); +void bench_values(const uint64_t *values, uint64_t n); +void bench_sample_begin(void); +void bench_clock_start(void); +void bench_clock_stop(void); +uint64_t bench_elapsed(void); +void bench_sample_end(const BenchRow *row, uint64_t sample, uint64_t sink); + +typedef struct { void *owner; uint64_t value; } BenchItem; +void backend_init(void); +void backend_finish(void); +BenchItem backend_make(const BenchInput *input, uint64_t capacity); +BenchItem backend_reverse(BenchItem input, uint64_t n); +uint64_t backend_digest(BenchItem output); +void backend_release(BenchItem output); +void backend_verify(const BenchInput *input, uint64_t capacity, int emit); +uint64_t backend_capacity_count(const BenchInput *input); +#endif diff --git a/Benchmarks/Compiler/native/driver.c b/Benchmarks/Compiler/native/driver.c new file mode 100644 index 000000000..380105081 --- /dev/null +++ b/Benchmarks/Compiler/native/driver.c @@ -0,0 +1,90 @@ +#include "common.h" +#include +#include + +static BenchItem inputs[CHUNK], outputs[CHUNK]; +static volatile uint64_t observed; + +static uint64_t run_chunk(const BenchRow *row, uint64_t offset, int timed) { + uint64_t sink = 0; + if (row->profile == 0) { + for (uint64_t i = 0; i < CHUNK; ++i) inputs[i] = backend_make(bench_input(row, offset + i), row->n + 2); + if (timed) bench_clock_start(); + for (uint64_t i = 0; i < CHUNK; ++i) { + BenchItem owned = inputs[i]; inputs[i] = (BenchItem){0, 0}; + outputs[i] = backend_reverse(owned, row->n); + } + if (timed) bench_clock_stop(); + for (uint64_t i = 0; i < CHUNK; ++i) { + BenchItem owned = outputs[i]; outputs[i] = (BenchItem){0, 0}; + sink += backend_digest(owned); backend_release(owned); + } + } else { + if (timed) bench_clock_start(); + for (uint64_t i = 0; i < CHUNK; ++i) { + BenchItem owned = backend_make(bench_input(row, offset + i), row->n + 2); + owned = backend_reverse(owned, row->n); + sink += backend_digest(owned); backend_release(owned); + } + if (timed) bench_clock_stop(); + } + return sink; +} + +/* Opaque call and bounded slot traffic, without reversal. It exposes driver + overhead; its raw time is never subtracted from the workload samples. */ +__attribute__((noinline)) static BenchItem handoff(BenchItem item) { + __asm__ volatile("" : "+r"(item.owner), "+r"(item.value) : : "memory"); + return item; +} +static void control(void) { + uint64_t total = 0, count = 1024 * CHUNK; + uint64_t before = bench_now(); + for (uint64_t j = 0; j < 1024; ++j) + for (uint64_t i = 0; i < CHUNK; ++i) outputs[i] = handoff(inputs[i]); + uint64_t elapsed = bench_now() - before; + for (uint64_t i = 0; i < CHUNK; ++i) total += outputs[i].value; + observed = total; + printf("{\"kind\":\"control\",\"name\":\"opaque-empty-handoff\",\"operations\":%" PRIu64 + ",\"elapsed_ns\":%" PRIu64 ",\"sink\":%" PRIu64 "}\n", count, elapsed, total); +} + +int main(int argc, char **argv) { + bench_need(argc == 4 || argc == 5, "usage: executable IMPLEMENTATION verify DATASET | IMPLEMENTATION run DATASET SCHEDULE"); + bench_implementation = argv[1]; + int verify = strcmp(argv[2], "verify") == 0; + bench_need((verify && argc == 4) || (!verify && argc == 5 && strcmp(argv[2], "run") == 0), "unknown driver mode"); + bench_load(argv[3], verify ? NULL : argv[4]); + backend_init(); bench_metadata(); control(); + if (verify) { + uint64_t count = 0; + for (uint64_t i = 0; i < INPUT_COUNT; ++i) + for (uint64_t j = 0; j < backend_capacity_count(&bench_inputs[i]); ++j) { + backend_verify(&bench_inputs[i], bench_inputs[i].n + 2 + j, 1); ++count; + } + printf("{\"kind\":\"verified\",\"cases\":%" PRIu64 "}\n", count); + } else { + BenchRow warm = {28, 64, 0, 1, CHUNK}; + uint64_t before = bench_now(), operations = 0, sink = 0; + do { sink += run_chunk(&warm, operations, 0); operations += CHUNK; } + while (bench_now() - before < bench_schedule.warm_ns); + bench_need(sink == bench_expected_sink(&warm, operations), "warm-up sink mismatch"); + observed = sink; + printf("{\"kind\":\"warmup\",\"elapsed_ns\":%" PRIu64 ",\"operations\":%" PRIu64 + ",\"sink\":%" PRIu64 "}\n", bench_now() - before, operations, sink); + for (uint64_t r = 0; r < bench_schedule.count; ++r) { + const BenchRow *row = &bench_schedule.rows[r]; + for (uint64_t sample = 0; sample < bench_schedule.samples; ++sample) { + bench_sample_begin(); sink = 0; + for (uint64_t op = 0; op < row->operations; op += CHUNK) sink += run_chunk(row, op, 1); + observed = sink; bench_sample_end(row, sample, sink); + for (uint64_t pattern = 0; pattern < (row->domain ? 1 : 6); ++pattern) + backend_verify(bench_input(row, pattern), row->n + 2, 0); + } + } + printf("{\"kind\":\"completed\",\"rows\":%" PRIu64 ",\"samples_per_row\":%" PRIu64 "}\n", + bench_schedule.count, bench_schedule.samples); + } + backend_finish(); + return 0; +} diff --git a/Benchmarks/Compiler/native/lean_backend.c b/Benchmarks/Compiler/native/lean_backend.c new file mode 100644 index 000000000..78c66c4ca --- /dev/null +++ b/Benchmarks/Compiler/native/lean_backend.c @@ -0,0 +1,83 @@ +#include "common.h" +#include + +extern lean_object *bench_lean_reverse(lean_object *input); +extern lean_object *initialize_LeanReverse(uint8_t builtin); +extern void lean_initialize_runtime_module(void); +static lean_object *scalars[INPUT_COUNT][MAX_N]; + +void backend_init(void) { + lean_initialize_runtime_module(); + lean_object *result = initialize_LeanReverse(1); + bench_need(lean_io_result_is_ok(result), "Lean initialization failed"); + lean_dec_ref(result); + lean_io_mark_end_initialization(); + for (uint64_t id = 0; id < INPUT_COUNT; ++id) + for (uint64_t i = 0; i < bench_inputs[id].n; ++i) + scalars[id][i] = lean_uint64_to_nat(bench_inputs[id].values[i]); +} +void backend_finish(void) { + for (uint64_t id = 0; id < INPUT_COUNT; ++id) + for (uint64_t i = 0; i < bench_inputs[id].n; ++i) lean_dec(scalars[id][i]); +} +BenchItem backend_make(const BenchInput *input, uint64_t capacity) { + (void)capacity; + uint64_t id = input - bench_inputs; + lean_object *list = lean_box(0); + for (uint64_t i = input->n; i != 0; --i) { + lean_object *node = lean_alloc_ctor(1, 2, 0), *value = scalars[id][i - 1]; + lean_inc(value); + lean_ctor_set(node, 0, value); lean_ctor_set(node, 1, list); list = node; + } + return (BenchItem){list, 0}; +} +BenchItem backend_reverse(BenchItem input, uint64_t n) { + (void)n; + return (BenchItem){bench_lean_reverse(input.owner), 0}; +} +uint64_t backend_digest(BenchItem output) { + lean_object *list = output.owner; + uint64_t hash = UINT64_C(14695981039346656037); + while (!lean_is_scalar(list)) { + hash = (hash ^ lean_uint64_of_nat(lean_ctor_get(list, 0))) * UINT64_C(1099511628211); + list = lean_ctor_get(list, 1); + } + return hash; +} +void backend_release(BenchItem output) { lean_dec((lean_object *)output.owner); } +uint64_t backend_capacity_count(const BenchInput *input) { (void)input; return 1; } +void backend_verify(const BenchInput *input, uint64_t capacity, int emit) { + BenchItem owned = backend_make(input, capacity); + /* Integer addresses are diagnostic weak observations, never RC owners. */ + uintptr_t addresses[MAX_N]; + lean_object *cursor = owned.owner; + for (uint64_t i = 0; i < input->n; ++i) { + bench_need(!lean_is_scalar(cursor) && lean_is_exclusive(cursor), "Lean input spine is shared"); + addresses[i] = (uintptr_t)cursor; + cursor = lean_ctor_get(cursor, 1); + } + bench_need(lean_is_scalar(cursor) && lean_unbox(cursor) == 0, "Lean input nil invalid"); + cursor = NULL; + BenchItem result = backend_reverse(owned, input->n); owned = (BenchItem){0, 0}; + cursor = result.owner; + uint64_t values[MAX_N], reused = 0; + for (uint64_t i = 0; i < input->n; ++i) { + bench_need(!lean_is_scalar(cursor) && lean_is_exclusive(cursor), "Lean output spine is shared or short"); + values[i] = lean_uint64_of_nat(lean_ctor_get(cursor, 0)); + bench_need(values[i] == input->values[input->n - i - 1], "Lean reversal value mismatch"); + reused += (uintptr_t)cursor == addresses[input->n - i - 1]; + cursor = lean_ctor_get(cursor, 1); + } + bench_need(lean_is_scalar(cursor) && lean_unbox(cursor) == 0 && reused == input->n, "Lean reuse or nil mismatch"); + uint64_t hash = backend_digest(result); + bench_need(hash == input->digest, "Lean digest mismatch"); + cursor = NULL; + backend_release(result); result = (BenchItem){0, 0}; + if (emit) { + printf("{\"kind\":\"case\",\"id\":%" PRIu64 ",\"capacity\":null,\"values\":", input->n * 9 + input->pattern); + bench_values(values, input->n); + printf(",\"digest\":%" PRIu64 ",\"exclusive_input_cons\":%" PRIu64 + ",\"exclusive_output_cons\":%" PRIu64 ",\"reused_cons\":%" PRIu64 ",\"released\":true}\n", + hash, input->n, input->n, reused); + } +} diff --git a/Benchmarks/Compiler/native/worker_launcher.c b/Benchmarks/Compiler/native/worker_launcher.c new file mode 100644 index 000000000..f2f353234 --- /dev/null +++ b/Benchmarks/Compiler/native/worker_launcher.c @@ -0,0 +1,29 @@ +#include +#include +#include +#include +#include + +/* Fork from this small image: Linux preserves a process's pre-exec RSS + * high-water mark, which would otherwise include the Lean runner's memory. + * The child starts with this launcher's current resident set. Startup and + * this fork are outside every recorded native timing interval. */ +int main(int argc, char **argv) { + if (argc < 2) return 2; + pid_t child = fork(); + if (child < 0) { perror("benchmark worker fork"); return 2; } + if (child == 0) { + execv(argv[1], argv + 1); + perror("benchmark worker exec"); + _exit(127); + } + int status; + while (waitpid(child, &status, 0) < 0) { + if (errno == EINTR) continue; + perror("benchmark worker wait"); + return 2; + } + if (WIFEXITED(status)) return WEXITSTATUS(status); + if (WIFSIGNALED(status)) return 128 + WTERMSIG(status); + return 2; +} diff --git a/Benchmarks/Compiler/protocol.md b/Benchmarks/Compiler/protocol.md new file mode 100644 index 000000000..960c96ebe --- /dev/null +++ b/Benchmarks/Compiler/protocol.md @@ -0,0 +1,167 @@ +# Native reversal suite protocol, version 1 + +The manifest freezes one synthetic runtime-input Compilatrix function and +handwritten comparison programs. `Benchmarks/Compiler/Data.lean` defines every scalar +input and its independent expected reversal. Inputs are read after compilation; +all Compilatrix cases use the same checked reversal and release object pair. + +The dataset contains every length 0–64 with six primary patterns and three +large-integer patterns. Primary values are below `2^30`. Stress values are +`2^63-1`, `2^63`, and `2^64-1`, each repeated for its list. The arena checker +also visits every capacity from `n+2` to 66, for 19,305 case/capacity pairs. +The existing N2 gate supplies the original malformed-input and ABI matrix. +The Nat-to-Word adapter rejects integers at least `2^64` before conversion; +its input type excludes negative integers. Dataset padding and trailing bytes +must be canonical, and JSON observations must match the nonnegative oracle. + +The binary format is exactly eight ASCII bytes `CPBN001\n`, an unsigned +little-endian 64-bit case count, and 585 fixed 544-byte records. A record has +four little-endian 64-bit words: length, pattern index, domain index, and +generator seed. Sixty-four payload words follow; words after the list's length +are zero. Record index is `9*length+pattern`. Patterns 0–5 are primary; patterns +6–8 have domain indices 1–3 respectively. The file has 318,256 bytes and the +manifest pins its BLAKE3. JSON diagnostics retain decimal integers exactly. + +The timing schedule has eight ASCII bytes `CPBS001\n`, followed by five +little-endian 64-bit words: row count, samples per row, warm-up nanoseconds, +chunk operations, and mode (0 smoke, 1 pilot, 2 measurement). Each row contains +five more words: stable row ID, length, domain, profile, and operation count. +Row IDs index `timingCases` in the dataset generator. Profiles 0 and 1 mean +`entry+handoff` and `lifecycle`. The row order may change between paired blocks; +all implementations receive identical schedule bytes within a block. Pilot and +smoke records are excluded from the reference analysis. + +Both profiles use fresh allocation. For `entry+handoff`, prepare 4,096 +independently owned lists, clear each owning input slot before calling reversal, +and retain at most 4,096 outputs. Calls and handoff are timed; preparation, +full result checks, the digest, and release occur between timed chunks. At the +largest arena size, the list storage occupies 8,978,432 bytes per chunk, plus +the fixed input/output slots and allocator metadata. Only one list allocation +is live at a time during lifecycle work. No application arena pool substitutes +for fresh allocation; the system allocator can recycle its freed storage. + +Lifecycle timing includes input list construction, reversal, an order- and +payload-sensitive result digest, and normal release. Immutable scalar datasets +are prepared in each language's scalar representation before timing. Sharing +those scalar values does not share the list spine. Each list digest folds the +returned payload words using the manifest's 64-bit recurrence, and a sample +sums its operation digests modulo `2^64`. Full correctness checks every value; +the timing digest supplements those checks. Operation boundaries remain visible +in generated code. Diagnostic instrumentation uses separate executions. + +Lean uses consuming `List Nat` arguments and explicit RC release, compiled +through `leanc` with Lake's ordinary release flags (`-O3 -DNDEBUG`) and pinned +GCC. Its compiled +diagnostic inspects exclusive input spines and reused cons addresses. CakeML +uses ordinary nonnegative integer lists, its default optimizing register +allocator, and its simple copying collector with a 64 MiB heap and an 8 MiB +stack. Collection-triggering allocations stay inside the timed interval. +Separate GC diagnostics establish collection cycles, post-collection occupancy, +and bounded process memory; a terminal forced collection is a distinct result. +Dropping the final root is not reported as immediate reclamation. + +The pilot records timer resolution and a minimal driver control, chooses common +operation counts, and freezes them before the 30 blocks in three sessions. +Each implementation starts a fresh process for each block, warms for at least +one second, and collects three samples for every scheduled row. Each sample +must accumulate at least 100 ms of timed work, and chunks must dominate clock +overhead. No outlier rule removes an observation merely for being slow. +Compilation and network setup finish before measurement. The run records core +placement, host limitations, executable identities, raw samples, and failures. + +A retained C launcher forks each timed worker from a small process image before +executing it. Linux can preserve the pre-exec high-water RSS of the large Lean +runner; this extra fork prevents that inherited memory from appearing as the +worker's peak. Launcher startup is outside the native sample intervals. Current +RSS still comes directly from the worker's `/proc/self/statm`, and peak RSS from +its `getrusage(RUSAGE_SELF)` record. +The reference invocation also pins the controller to a different core from the +worker and its SMT sibling. Both affinity masks are retained in the environment. + +Analysis takes the median within a block, then reports the distribution across +blocks. Speedup means baseline time divided by Compilatrix time. Bootstrap +resampling first draws three sessions with replacement, then ten complete +paired blocks within each selected session. The same 10,000 index vectors +apply to every implementation and within-block ratio, using seed 2671931027. +Quantiles interpolate linearly at `(n-1)*p`. Sessions consist of ten consecutive +blocks; a fixed 60-second idle interval separates them. They share one host and +one continuous run, so three session clusters give limited evidence about between-day variation. +There is no suite-wide ranking of +these lengths as if they were independent application workloads. A shared-host +run does not establish a dedicated performance-regression baseline. + +The pilot targets 200 ms per aggregate sample to provide headroom above the +100 ms acceptance floor. A block invalidates on drift in boot, CPU identity or +topology, kernel, affinity/NUMA permissions, governor/turbo policy, clocksource, +or declared environment variables; a sample below the timer/chunk floors or +above 2 GiB peak RSS also invalidates its whole block. The runner retains up to +three complete attempts. Wrong results, schemas, artifacts, or process exits +stop publication. Slow observations, page faults, context switches, load, and +instantaneous frequency changes remain in the data. The protocol does not +reserve the host or SMT sibling. + +The separate CakeML diagnostic runs length 64 in all four payload domains, +five samples each, using frozen operation counts. Every sample must include a +natural collection, and observed post-collection live data must stay below +8 MiB in the configured 64 MiB heap. It reports sample-envelope GC events, +the pinned runtime's GC clock, current RSS, and one terminal collection with +its own monotonic interval. Compiler wall/CPU/RSS envelopes and actual serialized +IR/HPT evidence sizes accompany native text and executable/dependency sizes. +The terminal request reads `Runtime.fullGC` through a runtime array because the +pinned optimizer folds the directly inlined constant request. The diagnostic +accepts only an actual additional GC event; `gc-smoke` checks this boundary in CI. + +Two unchanged upstream entries, `applyClosed` and `letClosed`, use the same +sessions and block count for a separate opaque native-call profile. They return +3 and 4 without runtime arguments; their successors and four direct calls remain +in the emitted object. Full source/baseline heap observations, complete release, +supplied-state call certificates, ABI checks, and precise fallback neighbors are +retained. No runtime-input or general N3 claim follows from these closed rows. + +## Commands and replay + +Build the runner and producer/checker seeds in the pinned repository environment: + +```sh +lake build compiler-benchmark compiler-source-native-runtime compiler-check-source-native-runtime \ + compiler-source-native-upstream compiler-check-source-native-upstream +``` + +Use fresh directories for each command. The four compiler paths must resolve +the exact lock in `toolchains.json`; CakeML's `basis_ffi.c` must be beside `cake`. +The Nix correctness check builds that pinned bootstrap and all six adapters. + +```sh +.lake/build/bin/compiler-benchmark build BUILD --gcc GCC_PATH --clang CLANG_PATH \ + --compcert CCOMP_PATH --cakeml CAKE_PATH +.lake/build/bin/compiler-benchmark verify BUILD VERIFY +.lake/build/bin/compiler-benchmark smoke BUILD SMOKE 2 +.lake/build/bin/compiler-benchmark gc-smoke BUILD GC-SMOKE 2 +.lake/build/bin/compiler-benchmark analysis-self-check +taskset --cpu-list 0 .lake/build/bin/compiler-benchmark pilot BUILD VERIFY PILOT 2 +taskset --cpu-list 0 .lake/build/bin/compiler-benchmark measure BUILD VERIFY PILOT MEASURED 2 +.lake/build/bin/compiler-benchmark diagnose BUILD PILOT MEASURED/diagnostics 2 +.lake/build/bin/compiler-benchmark analyze BUILD MEASURED MEASURED/analysis +.lake/build/bin/compiler-benchmark reproduce BUILD MEASURED REPLAY +``` + +Replace `2` with an available core before the pilot; later commands must use +that same core. `smoke` can choose the first permitted core when omitted. +Network setup, builds, correctness, and any concurrent benchmark jobs finish +before the pilot/reference measurement. The runner retains partial raw output +as it arrives. It does not append to an old run or silently resume a partial one. + +`reproduce` extracts and validates every source file into a new directory, +starts processes with an empty environment plus the recorded build variables, +uses the retained hashed producer/checker/compiler seeds, rebuilds every kernel +and executable, checks byte equality and complete correctness, and regenerates +the analysis from the original raw records. A separate Nix check rebuilds the +project and runs correctness/smoke in its sandbox. Reproduction does not require +new clock readings to equal old ones or claim a second physical CPU. + +The build retains source and tool identities, Nix closure paths, a source +archive including the dirty tree, commands/logs, actual objects, executables, +and the runner/checker seeds. The source study retained reference bundles under `benchmarks/runs/` +with digest-addressed archives; reviewed reports record their exact local +retrieval path and digest. Copy the entire archive when moving a result to +another storage service; temporary build directories are not its retention copy. diff --git a/Benchmarks/Compiler/toolchains.json b/Benchmarks/Compiler/toolchains.json new file mode 100644 index 000000000..737ea9f9a --- /dev/null +++ b/Benchmarks/Compiler/toolchains.json @@ -0,0 +1,47 @@ +{ + "format": "compilatrix/benchmark-toolchains/1", + "platform": "x86_64-linux", + "repository_lock": "../../flake.lock", + "scope": "Ix compiler import. Comparison compiler versions and their source Nixpkgs provenance are retained from the original study; the monorepo does not provision these external toolchains.", + "nixpkgs": { + "revision": "1306659b587dc277866c7b69eb97e5f07864d8c4", + "nar_hash": "sha256-KJ2wa/BLSrTqDjbfyNx70ov/HdgNBCBBSQP3BIzKnv4=" + }, + "lean": { + "version": "4.33.1", + "revision": "819816b2e0a3bf405af45ae5c7af2491d8f5bee6", + "toolchain_file": "../../lean-toolchain", + "native_c_compiler": "gcc", + "c_flags": ["-O3", "-DNDEBUG", "-march=x86-64", "-mtune=generic", "-fno-lto", "-fomit-frame-pointer"], + "c_driver": "leanc with the installed Lean ABI flags and LEAN_CC set to pinned GCC" + }, + "cakeml": { + "release": "v3479", + "revision": "e8eca63affd1653105ca4b9cc2f5ca87a01cd0af", + "bootstrap_url": "https://github.com/CakeML/cakeml/releases/download/v3479/cake-x64-64.tar.gz", + "bootstrap_sha256": "e110bfcba19d6524ee4748608a67a275647445a048928cf623c2c9a973e31c9a", + "hol_revision": "a390cbabd3a4521bab4ee20281e3e42933a8a3ae", + "bootstrap_polymL": "5.9", + "flags": ["--target=x64", "--reg_alg=2", "--gc=simple"], + "diagnostic_extra_flags": ["--emit_empty_ffi=true"], + "runtime_environment": {"CML_HEAP_SIZE": "64", "CML_STACK_SIZE": "8"}, + "heap_units": "MiB", + "bootstrap_build": ["make", "cake", "CC=gcc"] + }, + "compcert": { + "version": "3.16", + "source_revision": "v3.16", + "source_url": "https://github.com/AbsInt/CompCert/archive/refs/tags/v3.16.tar.gz", + "source_nar_hash": "sha256-Ep8bcSFs3Cu+lV5qgo89JJU2vh4TTq66Or0c4evo3gM=", + "nix_attribute": "compcert", + "coq_version": "9.0.1", + "coq_compatibility_patch": "https://github.com/AbsInt/CompCert/commit/a962ef9da0fb4ef2a4314ccedd111eb248e42cf2.patch", + "patch_nix_hash": "sha256-ipYqcfcgz3cKyI1NGSgfOgiVdV1WUwlv6DVB1S1hJvw=", + "configuration": ["x86_64-linux", "-clightgen", "-use-external-Flocq", "-use-external-MenhirLib"], + "nix_wrapper_flags": ["-U_FORTIFY_SOURCE"], + "kernel_flags": ["-O", "-c"] + }, + "gcc": {"version": "14.3.0", "nix_attribute": "gcc", "kernel_flags": ["-O3", "-march=x86-64", "-mtune=generic", "-fno-lto", "-fomit-frame-pointer", "-c"]}, + "clang": {"version": "21.1.2", "nix_attribute": "clang", "kernel_flags": ["-O3", "-march=x86-64", "-mtune=generic", "-fno-lto", "-fomit-frame-pointer", "-c"]}, + "arena_driver": {"compiler": "gcc", "flags": ["-O3", "-march=x86-64", "-mtune=generic", "-fno-lto", "-fomit-frame-pointer"], "lto": false, "pgo": false} +} diff --git a/Benchmarks/Lean4Lean.lean b/Benchmarks/Lean4Lean.lean deleted file mode 100644 index f7437b91c..000000000 --- a/Benchmarks/Lean4Lean.lean +++ /dev/null @@ -1,541 +0,0 @@ -import Cli -import Lean4Lean.Environment -import Ix.Meta -import Ix.TracingTexray -import Ix.Benchmark.Results -import Ix.Cli.ConstsFile - -/-! -# lean4lean typecheck benchmark - -Benchmarks the reference Lean4-in-Lean4 kernel — -[lean4lean](https://github.com/digama0/lean4lean), required by the lakefile -at a pinned rev — over the same library envs the other kernel backends -measure (`Benchmarks/Compile/Compile.lean`). It is the external -yardstick for the Ix kernels: `ix check-rs` (Rust, the `ooc` backend) and -`ix check-lean` (pure-Lean `Ix.Tc`) check the serialized `.ixe` of an env; -this tool has lean4lean check the same library from its `.olean`s. - -``` -lake exe bench-lean4lean [flags] - - the env's Lean source, same input `ix compile` takes - (e.g. `Benchmarks/Compile/CompileInitStd.lean`). Its - lake project supplies the module search path; the - module set is the file's transitive import closure. - --consts per-constant mode: replay each named constant's whole - transitive closure into a fresh kernel environment — - one row per name, the lean4lean counterpart of the ooc - backend's full-closure rows. Same flag/shape as - `ix check-rs --consts`. - --consts-file additionally read names from a file (one per line, - `#` comments ignored). Unions with --consts. - --json write benchmark results rows to (the shared - row contract, `Ix.Benchmark.Results`). - --json-name row key for the whole-library row (default: the - file's stem). The orchestrator passes the env name. - --no-build skip the `lake build` of the env module (for callers - that know the oleans are fresh). - --verbose print each declaration as it is added. -``` - -Without `--consts` the tool measures the **whole library**: every module in -the import closure is replayed through lean4lean — each module's new -constants are re-checked against its imports, one `IO.asTask` per module — -upstream `lake exe lean4lean`'s default mode, i.e. the canonical "how does -lean4lean perform on this library" number. Two driver divergences from -upstream, both required to run at all on this toolchain (the kernel itself -is untouched): duplicated cross-module realizations are skipped instead of -spuriously rejected, and only import regions are freed per task — the -stock binary segfaults freeing a module's own parts (see -`replayFromImports` for both). The row -carries `check-time` (wall over the sweep), `constants` (Σ declarations -added), `throughput` (constants/s), `peak-rss`. Caveats for cross-kernel -reading: lean4lean trusts `.olean` loading for a module's *imports* (every -constant is still checked exactly once, in its home module's task), its -parallelism unit is the module (tune with `LEAN_NUM_THREADS`), the -constant count is Lean declarations rather than Ixon constants — compare -end-to-end library numbers, not per-constant arithmetic — and auto-generated -lemmas that v4.29 multi-part oleans materialize in several modules are -checked once and skipped as duplicates thereafter (see `replayFromImports`; -upstream re-declares and spuriously rejects them). - -A kernel rejection writes the row as `{"status": "rejected"}` (no metrics — -a rejection is a correctness signal, not a benchmark datum) and the run -exits with the reserved code 3; a missing `.olean` is an infrastructure -error (exit 1) detected before any timed window. Rows are flushed after -every result, so a killed run keeps the rows measured so far. - -The replay machinery (`Context`/`State`/`replayConstant`/`replay`, -`replayFromImports`) is adapted from lean4lean's own `Main.lean` -(Apache 2.0, © the lean4lean authors) at the pinned rev — kept in lockstep -with the require so both sides agree on `Lean4Lean.addDecl`'s surface. --/ - -open Lean hiding Environment Exception -open Kernel - -namespace BenchLean4Lean - -/-- Like `Expr.getUsedConstants`, but produce a `NameSet`. -/ -def getUsedConstants' (e : Expr) : NameSet := - e.foldConsts {} fun c cs => cs.insert c - -/-- Return all names appearing in the type or value of a `ConstantInfo`. - -`allowOpaque := true` is load-bearing since v4.33: `ConstantInfo.value?` -now hides theorem proofs (and opaque bodies) by default, and a replay walk -that misses proof references skips their auxiliaries — e.g. the -`._f` structural-recursion helpers (`Nat.add_comm._f`), so the kernel then -rejects the theorem with "unknown constant". Mirrors the fork's -`Lean4Lean.Replay` fix. -/ -def getUsedConstants (c : ConstantInfo) : NameSet := - getUsedConstants' c.type ++ match c.value? (allowOpaque := true) with - | some v => getUsedConstants' v - | none => match c with - | .inductInfo val => .ofList val.ctors - | .ctorInfo val => ({} : NameSet).insert val.name - | .recInfo val => .ofList val.all - | _ => {} - -structure Context where - newConstants : Std.HashMap Name ConstantInfo - verbose := false - checkQuot := true - -structure State where - env : Environment - remaining : NameSet := {} - pending : NameSet := {} - postponedConstructors : NameSet := {} - postponedRecursors : NameSet := {} - numAdded : Nat := 0 - hasStrings := false - -abbrev M := ReaderT Context <| StateRefT State IO - -/-- Check if a `Name` still needs processing. If so, move it from `remaining` to `pending`. -/ -def isTodo (name : Name) : M Bool := do - let r := (← get).remaining - if r.contains name then - modify fun s => { s with remaining := s.remaining.erase name, pending := s.pending.insert name } - return true - else - return false - -def mapEnvM [Monad m] (ex : Exception) (f : Environment → m Environment) : m Exception := do - match ex with - | .unknownConstant env c => return .unknownConstant (← f env) c - | .alreadyDeclared env c => return .alreadyDeclared (← f env) c - | .declTypeMismatch env d t => return .declTypeMismatch env d t - | .declHasMVars env c e => return .declHasMVars (← f env) c e - | .declHasFVars env c e => return .declHasFVars (← f env) c e - | .funExpected env lctx e => return .funExpected (← f env) lctx e - | .typeExpected env lctx e => return .typeExpected (← f env) lctx e - | .letTypeMismatch env lctx n t1 t2 => return .letTypeMismatch (← f env) lctx n t1 t2 - | .exprTypeMismatch env lctx e t => return .exprTypeMismatch (← f env) lctx e t - | .appTypeMismatch env lctx e fn arg => return .appTypeMismatch (← f env) lctx e fn arg - | .invalidProj env lctx e => return .invalidProj (← f env) lctx e - | .thmTypeIsNotProp env c t => return .thmTypeIsNotProp (← f env) c t - | .other _ - | .deterministicTimeout - | .excessiveMemory - | .deepRecursion - | .interrupted => return ex - -/-- Use the current `Environment` to throw a `Kernel.Exception`. -/ -def throwKernelException (ex : Exception) : M α := do - let options := pp.match.set (pp.rawOnError.set {} true) false - -- The replayed environment has no extension state, so it cannot back the - -- pretty printer; a fresh empty environment is good enough for basic - -- printing of the offending declaration. - let env ← mkEmptyEnvironment - let ex ← mapEnvM ex fun _ => return env.toKernelEnv - Prod.fst <$> (Lean.Core.CoreM.toIO · { fileName := "", options, fileMap := default } { env }) do - Lean.throwKernelException ex - -def declName : Declaration → String - | .axiomDecl d => s!"axiomDecl {d.name}" - | .defnDecl d => s!"defnDecl {d.name}" - | .thmDecl d => s!"thmDecl {d.name}" - | .opaqueDecl d => s!"opaqueDecl {d.name}" - | .quotDecl => s!"quotDecl" - | .mutualDefnDecl d => s!"mutualDefnDecl {d.map (·.name)}" - | .inductDecl _ _ d _ => s!"inductDecl {d.map (·.name)}" - -/-- Add a declaration through the lean4lean kernel, possibly throwing a - `KernelException`. -/ -def addDecl (d : Declaration) : M Unit := do - if (← read).verbose then - println! "adding {declName d}" - let t1 ← IO.monoMsNow - match Lean4Lean.addDecl (← get).env d true with - | .ok env => - let t2 ← IO.monoMsNow - if t2 - t1 > 1000 then - println! "{declName d}: lean4lean took {t2 - t1}ms" - modify fun s => { s with env, numAdded := s.numAdded + 1 } - | .error ex => - throwKernelException ex - -def hasStrLit (e : Expr) : Bool := (e.find? (·.isStringLit)).isSome - -def constHasStrLit (ci : ConstantInfo) : Bool := - -- `allowOpaque := true` for the same reason as `getUsedConstants`: a string - -- literal inside a theorem proof must still pre-seed `String.ofList`. - hasStrLit ci.type || (ci.value? (allowOpaque := true)).any hasStrLit - -mutual -/-- -Check if a `Name` still needs to be processed (i.e. is in `remaining`). - -If so, recursively replay any constants it refers to, -to ensure we add declarations in the right order. - -Then construct the `Declaration` from its stored `ConstantInfo`, -and add it to the environment. --/ -partial def replayConstant (name : Name) : M Unit := do - if ← isTodo name then - let some ci := (← read).newConstants[name]? | unreachable! - let mut usedConstants := getUsedConstants ci - -- We want `String.ofList` to be available when encountering string literals. - unless (← get).hasStrings do - if constHasStrLit ci then - usedConstants := usedConstants.insert ``String.ofList - usedConstants := usedConstants.insert ``Char.ofNat - modify ({· with hasStrings := true }) - replayConstants usedConstants - -- Check that this name is still pending: a mutual block may have taken care of it. - if (← get).pending.contains name then - let addDeclAt (d : Declaration) := - try addDecl d catch e => throw <| IO.userError s!"at {name}: {e.toString}" - match ci with - | .defnInfo info => addDeclAt (.defnDecl info) - | .thmInfo info => addDeclAt (.thmDecl info) - | .axiomInfo info => addDeclAt (.axiomDecl info) - | .opaqueInfo info => addDeclAt (.opaqueDecl info) - | .inductInfo info => - let lparams := info.levelParams - let nparams := info.numParams - let all ← info.all.mapM fun n => do pure <| (← read).newConstants[n]! - for o in all do - modify fun s => - { s with remaining := s.remaining.erase o.name, pending := s.pending.erase o.name } - let ctorInfo ← all.mapM fun ci => do - pure (ci, ← ci.inductiveVal!.ctors.mapM fun n => do - pure (← read).newConstants[n]!) - -- Make sure we are really finished with the constructors. - for (_, ctors) in ctorInfo do - for ctor in ctors do - replayConstants (getUsedConstants ctor) - let types : List InductiveType := ctorInfo.map fun ⟨ci, ctors⟩ => - { name := ci.name - type := ci.type - ctors := ctors.map fun ci => { name := ci.name, type := ci.type } } - addDeclAt (.inductDecl lparams nparams types false) - -- We postpone checking constructors, - -- and at the end make sure they are identical - -- to the constructors generated when we replay the inductives. - | .ctorInfo info => - modify fun s => { s with postponedConstructors := s.postponedConstructors.insert info.name } - -- Similarly we postpone checking recursors. - | .recInfo info => - modify fun s => { s with postponedRecursors := s.postponedRecursors.insert info.name } - | .quotInfo _ => addDeclAt .quotDecl - modify fun s => { s with pending := s.pending.erase name } - -/-- Replay a set of constants one at a time. -/ -partial def replayConstants (names : NameSet) : M Unit := do - for n in names do replayConstant n - -end - -end BenchLean4Lean - -deriving instance BEq for ConstantVal -deriving instance BEq for ConstructorVal -deriving instance BEq for RecursorRule -deriving instance BEq for RecursorVal - -namespace BenchLean4Lean - -/-- -Check that all postponed constructors are identical to those generated -when we replayed the inductives. --/ -def checkPostponedConstructors : M Unit := do - for ctor in (← get).postponedConstructors do - match (← get).env.constants.find? ctor, (← read).newConstants[ctor]? with - | some (.ctorInfo info), some (.ctorInfo info') => - unless info == info' do throw <| IO.userError s!"Invalid constructor {ctor}" - | _, _ => throw <| IO.userError s!"No such constructor {ctor}" - -/-- -Check that all postponed recursors are identical to those generated -when we replayed the inductives. --/ -def checkPostponedRecursors : M Unit := do - for ctor in (← get).postponedRecursors do - match (← get).env.constants.find? ctor, (← read).newConstants[ctor]? with - | some (.recInfo info), some (.recInfo info') => - unless info == info' do throw <| IO.userError s!"Invalid recursor {ctor}" - | _, _ => throw <| IO.userError s!"No such recursor {ctor}" - -/-- Check that at the end of (any) file, the quotient module is initialized. -(It will already be initialized at the beginning, unless this is the very -first file, which is responsible for initializing it.) -/ -def checkQuotInit : M Unit := do - unless (← get).env.quotInit do - throw <| IO.userError s!"initial import (Init.Prelude) didn't initialize quotient module" - -/-- "Replay" some constants into an `Environment`, sending them to the - lean4lean kernel for checking. Returns the number of declarations added - and the final environment. -/ -def replay (ctx : Context) (env : Environment) (decl : Option Name := none) : - IO (Nat × Environment) := do - let mut remaining : NameSet := ∅ - for (n, ci) in ctx.newConstants.toList do - -- We skip unsafe constants, and also partial constants. - if !ci.isUnsafe && !ci.isPartial then - remaining := remaining.insert n - let (_, s) ← StateRefT'.run (s := { env, remaining }) do - ReaderT.run (r := ctx) do - match decl with - | some d => replayConstant d - | none => - for n in remaining do - replayConstant n - checkPostponedConstructors - checkPostponedRecursors - if (← read).checkQuot then checkQuotInit - return (s.numAdded, s.env) - -/-- Read a module's olean parts (base + server + private when present), - most complete last — the shape `readModuleDataParts` and the - toolchain's own `LeanChecker` frontend use. Shared by the closure - scanner and the replay tasks so both see the same (private-level) - import set. Throws when the base olean is missing. -/ -def readModuleParts (module : Name) : IO (Array (ModuleData × CompactedRegion)) := do - let mFile ← findOLean module - unless (← mFile.pathExists) do - throw <| IO.userError s!"object file '{mFile}' of module {module} does not exist" - let mut fnames := #[mFile] - let sFile := OLeanLevel.server.adjustFileName mFile - if (← sFile.pathExists) then - fnames := fnames.push sFile - let pFile := OLeanLevel.private.adjustFileName mFile - if (← pFile.pathExists) then - fnames := fnames.push pFile - readModuleDataParts fnames - -open private ImportedModule.mk from Lean.Environment in -/-- Replay one module's new constants against its (trusted-loaded) imports — - upstream `lake exe lean4lean`'s per-module unit of work. -/ -unsafe def replayFromImports (module : Name) (verbose := false) : IO Nat := do - let parts ← readModuleParts module - let some (mod, _) := parts[parts.size - 1]? | unreachable! -- load private module data - let (_, s) ← (importModulesCore mod.imports).run - let env ← match Kernel.Environment.finalizeImport s mod.imports module 0 with - | .ok env => pure env - | .error e => throw <| .userError <| ← (e.toMessageData {}).toString - let mut newConstants := {} - for name in mod.constNames, ci in mod.constants do - -- v4.29 multi-part oleans can materialize the same auto-generated - -- lemma (`*.eq_1`, `*.congr_simp`, …) in several modules' parts; a - -- real import dedups those realizations in `finalizeImport`, so the - -- replay must skip names the imported env already provides instead of - -- re-declaring them (upstream replays them and spuriously rejects, - -- e.g. on v4.29 Std). - if (env.constants.find? name).isNone then - newConstants := newConstants.insert name ci - let (n, env') ← replay { newConstants, verbose } env - -- Free the task's IMPORT regions only (the memory that scales with the - -- sweep: every task maps its whole import closure). Upstream also frees - -- the module's own `parts` regions, which segfaults — reproducibly, in - -- the stock `lean4lean` binary too on this toolchain (decref of - -- persistent region objects after munmap at scope exit) — so the small - -- per-module parts stay mapped: one copy of the library across the - -- sweep, not one closure per task. - (Environment.ofKernelEnv env').freeRegions - pure n - -/-- Replay every module of the library through lean4lean, one `IO.asTask` - per module (parallelism follows the task pool, i.e. `LEAN_NUM_THREADS`). - Callers pre-flight olean existence via `moduleClosure`, so a task - failure here is a kernel rejection, not infrastructure. Returns the - total declarations added plus per-module failures. -/ -unsafe def replayLibrary (modules : Array Name) (verbose : Bool) : - IO (Nat × Array (Name × String)) := do - let mut tasks := #[] - for m in modules do - tasks := tasks.push (m, ← IO.asTask (replayFromImports m verbose)) - let mut added := 0 - let mut failures : Array (Name × String) := #[] - for (m, t) in tasks do - match t.get with - | .error e => failures := failures.push (m, toString e) - | .ok n => added := added + n - return (added, failures) - -/-- Transitive module closure of `roots`, discovered by scanning olean - headers (private-level parts, so `private import`s are covered). No - environment is imported here: the whole-library sweep's tasks free - their compacted regions when done — upstream's memory bound — which is - only sound while nothing else in the process shares mapped regions. - The scanner's own header regions stay mapped (the returned `Name`s - live inside them): one copy of the library's headers, not one per - task. A missing olean throws here, before any timed window. -/ -def moduleClosure (roots : Array Name) : IO (Array Name) := do - let mut seen : NameSet := {} - let mut order : Array Name := #[] - let mut stack : List Name := roots.toList - repeat - match stack with - | [] => break - | m :: rest => - stack := rest - if seen.contains m then - continue - seen := seen.insert m - order := order.push m - let parts ← readModuleParts m - let some (mod, _) := parts[parts.size - 1]? | unreachable! - for imp in mod.imports do - unless seen.contains imp.module do - stack := imp.module :: stack - return order - -/-- Replay `target`'s whole transitive closure into a fresh kernel - environment — the full-closure check semantics of the ooc backend's - per-constant rows. Returns the closure size (declarations added). -/ -def replayClosure (env : Lean.Environment) (newConstants : Std.HashMap Name ConstantInfo) - (target : Name) (verbose : Bool) : IO Nat := do - let _ := env - (·.1) <$> replay { newConstants, verbose, checkQuot := false } (.empty default) (some target) - -/-- Resolve a raw `--consts` string against the env: `toName` first, then a - displayed-form scan (numeric/private components don't round-trip through - `toName`) — the same fallback the other tools' resolvers use. -/ -def resolveName (env : Lean.Environment) (raw : String) : Option Name := - let n := raw.toName - if env.constants.contains n then some n - else env.constants.fold (init := none) fun acc cn _ => - acc <|> if toString cn == raw then some cn else none - -open Ix.Benchmark.Results in -unsafe def runBenchCmd (p : Cli.Parsed) : IO UInt32 := do - let some pathArg := p.positionalArg? "path" - | p.printError "error: must specify to the env's Lean source (e.g. Benchmarks/Compile/CompileInitStd.lean)" - return exitUsage - let path := pathArg.as! String - let jsonOut : Option String := (p.flag? "json").map (·.as! String) - let jsonName := ((p.flag? "json-name").map (·.as! String)).getD - ((System.FilePath.mk path).fileStem.getD path) - let verbose := p.hasFlag "verbose" - let rawNames ← Ix.Cli.ConstsFile.gather p - - -- Build the env module first (outside every timed window). The file's - -- lake project supplies the module search path — the same entry - -- `ix compile` uses, so both backends accept the same registry - -- `module` path. - unless p.hasFlag "no-build" do buildFile path - - if rawNames.isEmpty then - -- Whole-library mode. The import closure is enumerated by scanning - -- olean headers — deliberately WITHOUT importing an environment into - -- this process: the replay tasks free their compacted regions when - -- done (upstream's memory bound, ~steady-state instead of the whole - -- library's fixed-up regions accumulating), and those frees are only - -- sound while no co-resident env shares mapped regions. - initLeanSearchPath (← IO.FS.realPath path).parent - let header ← Lean.parseImports' (← IO.FS.readFile path) path - let modules ← moduleClosure (header.imports.map (·.module)) - IO.println s!"Loaded {path}: {modules.size} modules in the import closure" - TracingTexray.startSampler - -- Whole-library row: module-parallel replay of the import closure. - IO.println s!"replaying {modules.size} modules through lean4lean …" - (← IO.getStdout).flush - TracingTexray.resetPeakTreeRss - let t0 ← IO.monoNanosNow - let (added, failures) ← replayLibrary modules verbose - let t1 ← IO.monoNanosNow - let secs := (t1 - t0).toFloat / 1e9 - let peak ← TracingTexray.peakTreeRssBytes - if failures.isEmpty then - if let some out := jsonOut then - writeRow out jsonName "ok" - [ ("check-time", jsonRound 6 secs) - , ("constants", Lean.toJson added) - , ("throughput", jsonRound 2 (if secs > 0 then added.toFloat / secs else 0)) - , ("peak-rss", Lean.toJson peak) ] - IO.println s!"{jsonName}: checked {added} declarations in {secs}s \ - ({(added.toFloat / secs).toUInt64} consts/s)" - return 0 - else - for (m, e) in failures do - IO.eprintln s!"❌ lean4lean REJECTED module {m}: {e}" - if let some out := jsonOut then - writeRow out jsonName "rejected" [] - return exitRejected - else - -- Per-constant mode: the elaborated file env supplies the constants - -- map (`getFileEnv`, the same entry `ix compile` uses — it also sets - -- the search path). Closure replays never free regions, so the - -- co-resident env is fine here. Each row is the name's whole - -- transitive closure into a fresh kernel env. - let env ← getFileEnv path - TracingTexray.startSampler - let newConstants := env.constants.fold - (init := ({} : Std.HashMap Name ConstantInfo)) fun m n ci => m.insert n ci - let mut anyRejected := false - let mut idx := 0 - for raw in rawNames do - idx := idx + 1 - match resolveName env raw with - | none => IO.eprintln s!"warning: {raw} not found in the env; skipping" - | some target => - -- Announce BEFORE the replay (flushed): a kill mid-replay must - -- leave the in-flight constant's name in the log. - IO.println s!" [{idx}/{rawNames.size}] replaying closure of {raw} …" - (← IO.getStdout).flush - TracingTexray.resetPeakTreeRss - let t0 ← IO.monoNanosNow - let res ← (replayClosure env newConstants target verbose).toBaseIO - let t1 ← IO.monoNanosNow - let secs := (t1 - t0).toFloat / 1e9 - let peak ← TracingTexray.peakTreeRssBytes - match res with - | .ok added => - if let some out := jsonOut then - writeRow out raw "ok" - [ ("check-time", jsonRound 6 secs) - , ("constants", Lean.toJson added) - , ("throughput", jsonRound 2 (if secs > 0 then added.toFloat / secs else 0)) - , ("peak-rss", Lean.toJson peak) ] - IO.println s!" {raw}: constants={added} check={secs}s" - | .error e => - IO.eprintln s!" ❌ {raw} FAILED TO TYPECHECK: {e}" - if let some out := jsonOut then - writeRow out raw "rejected" [] - anyRejected := true - return if anyRejected then exitRejected else 0 - -end BenchLean4Lean - -unsafe def benchLean4LeanCmd : Cli.Cmd := `[Cli| - "bench-lean4lean" VIA BenchLean4Lean.runBenchCmd; - "Benchmark the lean4lean reference kernel over a library env (whole-library module replay, or per-constant closures with --consts)" - - FLAGS: - consts : String; "Per-constant mode: comma-separated fully-qualified names, each replayed as its whole transitive closure into a fresh kernel env (the ooc backend's full-closure row shape). Same flag/shape as `ix check-rs --consts`." - "consts-file" : String; "Additionally read constant names from a file (one per line; `#` comments and blank lines ignored). Unions with --consts." - json : String; "Write benchmark results rows to this path (shared row contract). Off by default." - "json-name" : String; "Row key for the whole-library row (default: the file stem; the orchestrator passes the registry env name)." - "no-build"; "Skip the `lake build` of the env module (callers that know the oleans are fresh)." - verbose; "Print each declaration as it is added." - - ARGS: - path : String; "Path to the env's Lean source, e.g. Benchmarks/Compile/CompileInitStd.lean (same input as `ix compile`)" -] - diff --git a/Benchmarks/Lean4LeanMain.lean b/Benchmarks/Lean4LeanMain.lean deleted file mode 100644 index dbfb3d5b0..000000000 --- a/Benchmarks/Lean4LeanMain.lean +++ /dev/null @@ -1,11 +0,0 @@ -import Benchmarks.Lean4Lean - -/-! -Exe root for `bench-lean4lean`. `main` lives here, in a module nothing -imports, so the machinery in `Benchmarks.Lean4Lean` stays importable -(the `lean4lean` ignored test runner uses it) without a root-level `main` -collision. --/ - -unsafe def main (args : List String) : IO UInt32 := - benchLean4LeanCmd.validate args diff --git a/Benchmarks/TruthMines/Drivers/Lean4Lean.lean b/Benchmarks/TruthMines/Drivers/Lean4Lean.lean deleted file mode 100644 index a866ccf8a..000000000 --- a/Benchmarks/TruthMines/Drivers/Lean4Lean.lean +++ /dev/null @@ -1,2 +0,0 @@ -/- GENERATED by `lake exe truthmines gen` from `Benchmarks.TruthMinesSpec`; do not edit. -/ -import Lean4Lean diff --git a/Benchmarks/TruthMines/lake-manifest.json b/Benchmarks/TruthMines/lake-manifest.json index 6f81f4e9f..e49130584 100644 --- a/Benchmarks/TruthMines/lake-manifest.json +++ b/Benchmarks/TruthMines/lake-manifest.json @@ -358,16 +358,6 @@ "inputRev": "453f4feb6508ec787fc325a70523d38e4378ef8f", "inherited": false, "configFile": "lakefile.lean"}, - {"url": "https://github.com/digama0/lean4lean", - "type": "git", - "subDir": null, - "scope": "", - "rev": "e0e3f6bcccb840cb0ea6f11c2b274ada93a12e00", - "name": "lean4lean", - "manifestFile": "lake-manifest.json", - "inputRev": "e0e3f6bcccb840cb0ea6f11c2b274ada93a12e00", - "inherited": false, - "configFile": "lakefile.toml"}, {"url": "https://github.com/leanprover-community/import-graph", "type": "git", "subDir": null, diff --git a/Benchmarks/TruthMines/lakefile.lean b/Benchmarks/TruthMines/lakefile.lean index b5aa0ca1a..7916e9b75 100644 --- a/Benchmarks/TruthMines/lakefile.lean +++ b/Benchmarks/TruthMines/lakefile.lean @@ -49,7 +49,6 @@ require «Parser» from git "https://github.com/fgdorais/lean4-parser" @ "e2c243 require «aesop» from git "https://github.com/leanprover-community/aesop" @ "3448c0bcc5ce01b2d1546e483ec3620e32df3d0e" require «i18n» from git "https://github.com/hhu-adam/lean-i18n" @ "1a99b00a940624c0a6c3009b756fb922acf0fe78" require «importGraph» from git "https://github.com/leanprover-community/import-graph" @ "16f02aa7642864af59f1ff0e384a015994db9118" -require «lean4lean» from git "https://github.com/digama0/lean4lean" @ "e0e3f6bcccb840cb0ea6f11c2b274ada93a12e00" require «lean_eff» from git "https://github.com/palladin/lean-eff" @ "453f4feb6508ec787fc325a70523d38e4378ef8f" require «lean_reducers» from git "https://github.com/palladin/lean-reducers" @ "6e93e0ce326025f762d00b947716c2b98ce1fb06" require «protobuf» from git "https://github.com/Lean-zh/protobuf" @ "8c707f2cb4ab8eae280127651162d28e58164c1e" @@ -141,7 +140,6 @@ def catalogRootModules : Array Lean.Name := #[ `Aesop, `I18n, `ImportGraph, - `Lean4Lean, `LeanEff, `LeanReducers, `Protobuf, diff --git a/Benchmarks/TruthMinesSpec/Catalog.lean b/Benchmarks/TruthMinesSpec/Catalog.lean index 7d0b12c0f..2aa8b8938 100644 --- a/Benchmarks/TruthMinesSpec/Catalog.lean +++ b/Benchmarks/TruthMinesSpec/Catalog.lean @@ -326,11 +326,6 @@ member of the mini infrastructure tier."), "079463134b9c50450b8393e1566a09fc492a34d9" #[] "NONE" "2026-07-20" #[`Sail] (notes := "UNLICENSED. REMS' Sail-to-Lean runtime library, the substrate for Sail-generated ISA models. Zero deps."), - gitPackage "lean4lean" `Lean4Lean - "https://github.com/digama0/lean4lean" - "e0e3f6bcccb840cb0ea6f11c2b274ada93a12e00" - #["batteries"] "Apache-2.0" "2026-08-14" - #[`Lean4Lean] (notes := "The Lean 4 kernel reimplemented and verified in Lean 4. Clean pure-Lean build, batteries only. Library target is Lean4Lean, not the capitalisation Lake would guess from the package name."), gitPackage "phi-confluence" `PhiConfluence "https://github.com/objectionary/proof" "58aa7731076d02bf51b2dfbcdc06c4f764101fb4" diff --git a/Benchmarks/TruthMinesSpec/Spec.lean b/Benchmarks/TruthMinesSpec/Spec.lean index 18257b5d8..743df87b2 100644 --- a/Benchmarks/TruthMinesSpec/Spec.lean +++ b/Benchmarks/TruthMinesSpec/Spec.lean @@ -102,8 +102,6 @@ def catalogSpec : CatalogSpecProjection := { roots := #[`I18n] }, { qualifier := `ImportGraph roots := #[`ImportGraph] }, - { qualifier := `Lean4Lean - roots := #[`Lean4Lean] }, { qualifier := `LeanEff roots := #[`LeanEff] }, { qualifier := `LeanReducers diff --git a/CLAUDE.md b/CLAUDE.md new file mode 120000 index 000000000..47dc3e3d8 --- /dev/null +++ b/CLAUDE.md @@ -0,0 +1 @@ +AGENTS.md \ No newline at end of file diff --git a/Ix.lean b/Ix.lean index 9ad43890d..8f0c35502 100644 --- a/Ix.lean +++ b/Ix.lean @@ -17,7 +17,7 @@ public import Ix.Catalog public import Ix.ImportIxe public import Ix.IxEval public import Ix.KernelCheck -public import Ix.Tc +public import Ix.Kernel public import Ix.Claim public import Ix.Merkle public import Ix.AssumptionTree diff --git a/Ix/Address.lean b/Ix/Address.lean index a3a75bf25..a3196baaa 100644 --- a/Ix/Address.lean +++ b/Ix/Address.lean @@ -45,7 +45,12 @@ instance : Hashable Address where ||| ((h.get! 7).toUInt64 <<< 56) /-- Compute the Blake3 hash of a `ByteArray`, returning an `Address`. -/ -def Address.blake3 (x: ByteArray) : Address := ⟨(Blake3.Rust.hash x).val⟩ +def Address.blake3 (x: ByteArray) : Address := + let hasher := Blake3.Rust.hasherUpdate (Blake3.Rust.hasherInit ()) x + -- Supply a kernel-checked size bound: the upstream `hash` helper fills + -- this argument using native evaluation, adding an unnecessary axiom. + ⟨(Blake3.HasherOps.finalizeWithLength hasher 32 (by + rcases System.Platform.numBits_eq with bits | bits <;> rw [bits] <;> decide)).val⟩ /-- Convert a nibble (0--15) to its lowercase hexadecimal character. -/ def hexOfNat : Nat -> Option Char diff --git a/Ix/Aiur/BoundVerifier.lean b/Ix/Aiur/BoundVerifier.lean new file mode 100644 index 000000000..63eff11f3 --- /dev/null +++ b/Ix/Aiur/BoundVerifier.lean @@ -0,0 +1,124 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.Compilation +import Ix.Aiur.LookupShapes +import Ix.Aiur.RowCounts +import Ix.Aiur.Protocol + +/-! A verifier whose caller selects the source, entrypoint, parameters and +complete allowed key bytes. Untrusted proof bytes cannot select any of them. + +This is a program/statement/key binding component. It does not assert that +the selected source implements the certified checker, that compilation or +AIR constraints reflect source execution, or that the proof-system FFI is +sound. Those are distinct C8 obligations. In particular, no certified release +is instantiated here for the legacy `verify_claim` or the C2 pilot. +-/ + +namespace Aiur.BoundVerifier + +/-- Trusted deployment selection, independent of the proof being verified. +Circuit grouping is explicit; environment-variable overrides are not used. -/ +structure Selection where + source : Source.Toplevel + groups : Array (String × Array String) := #[] + entrypoint : Lean.Name + function : Bytecode.FunIdx + inputSize : Nat + success : Array G + commitment : CommitmentParameters + fri : FriParameters + key : ByteArray + +def Selection.compile (selection : Selection) : Except String CompiledToplevel := do + let compiled ← selection.source.compile + if selection.groups.isEmpty then return compiled + compiled.groupFunctions selection.groups + +/-- The system is built from exactly the selected compilation and parameters. +It is derived, rather than accepted as a second independent caller argument. -/ +def Selection.system (selection : Selection) (compiled : CompiledToplevel) : AiurSystem := + AiurSystem.build compiled.bytecode selection.commitment selection.fri + +structure Backend (selection : Selection) where + compiled : CompiledToplevel + compilation : selection.compile = .ok compiled + system : AiurSystem + systemBuilt : system = selection.system compiled + selected : compiled.getFuncIdx selection.entrypoint = some selection.function + functionRange : selection.function < gSize.toNat + entry : Bytecode.Function + present : compiled.bytecode.functions[selection.function]? = some entry + publicEntry : entry.entry = true + constrained : entry.constrained = true + arity : entry.layout.inputSize = selection.inputSize + returnArity : entry.body.returnsHaveSize selection.success.size = true + lookupShapes : compiled.bytecode.validateLookupShapes = true + rowCounts : compiled.bytecode.validateRowCounts = true + keyBound : system.vkBytes = selection.key + +def build (selection : Selection) : Except String (Backend selection) := + match hc : selection.compile with + | .error e => .error e + | .ok compiled => + if hs : compiled.getFuncIdx selection.entrypoint = some selection.function then + if hr : selection.function < gSize.toNat then + match hp : compiled.bytecode.functions[selection.function]? with + | none => .error "selected function is absent" + | some entry => + if he : entry.entry = true ∧ entry.constrained = true ∧ + entry.layout.inputSize = selection.inputSize then + if ho : entry.body.returnsHaveSize selection.success.size = true then + if hl : compiled.bytecode.validateLookupShapes = true then + if hn : compiled.bytecode.validateRowCounts = true then + let system := selection.system compiled + if hk : system.vkBytes = selection.key then + .ok ⟨compiled, hc, system, rfl, hs, hr, entry, hp, he.1, he.2.1, he.2.2, ho, hl, hn, hk⟩ + else .error "verification key differs from the selected key" + else .error "compiled circuit control counts exceed their bounds" + else .error "compiled lookup message arities differ" + else .error "selected success result has the wrong output arity" + else .error "selected function is not a constrained public entry of the expected arity" + else .error "function index is not a canonical field element" + else .error "entrypoint differs from the selected function" + +/-- `input` is the statement the caller expects. A serialized proof supplies +neither a different statement nor an alternative key or success result. -/ +def verify {selection : Selection} (backend : Backend selection) (input : Array G) + (bytes : ByteArray) : Except String Unit := do + if input.size != selection.inputSize then throw "public input arity differs" + let proof ← Proof.ofBytesChecked bytes + backend.system.verify + (buildClaim selection.function input selection.success) proof + +theorem verify_success {selection : Selection} {backend : Backend selection} + {input : Array G} {bytes : ByteArray} (h : verify backend input bytes = .ok ()) : + input.size = selection.inputSize ∧ + ∃ proof, Proof.ofBytesChecked bytes = .ok proof ∧ + backend.system.verify + (buildClaim selection.function input selection.success) proof = .ok () := by + unfold verify at h + split at h + · cases h + · rename_i ha + refine ⟨by simpa using ha, ?_⟩ + cases hp : Proof.ofBytesChecked bytes with + | error e => simp [hp, bind, Except.bind] at h + | ok proof => exact ⟨proof, rfl, by simpa [hp, bind, Except.bind] using h⟩ + +/-- Every produced backend retains the actual compiler artifact, including +the grouping result. No compiler-semantic claim is packed into this result. -/ +theorem Backend.compilation_stages {selection : Selection} (backend : Backend selection) : + ∃ initial, selection.source.compile = .ok initial ∧ + (if selection.groups.isEmpty then .ok initial + else initial.groupFunctions selection.groups) = .ok backend.compiled := by + have h := backend.compilation + unfold Selection.compile at h + cases hc : selection.source.compile with + | error e => simp [hc, bind, Except.bind] at h + | ok initial => exact ⟨initial, rfl, by simpa [hc, bind, Except.bind, pure, Except.pure] using h⟩ + +end Aiur.BoundVerifier diff --git a/Ix/Aiur/Branchless.lean b/Ix/Aiur/Branchless.lean new file mode 100644 index 000000000..a5c0ab9a4 --- /dev/null +++ b/Ix/Aiur/Branchless.lean @@ -0,0 +1,27 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +module +public import Ix.Aiur.Stages.Bytecode + +/-! Ungated lookup messages require one writer per physical slot. A single +selector does not ensure that: a branch with no terminal can still emit +lookups. Restrict the optimization to one function with terminal control. -/ + +public section +@[expose] section +namespace Aiur.Bytecode + +def Function.hasTerminalControl (function : Function) : Bool := + match function.body.ctrl with + | .«return» .. | .yield .. => true + | _ => false + +def circuitBranchless (selectors : Nat) (functions : List Function) : Bool := + selectors == 1 && match functions with + | [function] => function.hasTerminalControl + | _ => false + +end Aiur.Bytecode diff --git a/Ix/Aiur/Compiler.lean b/Ix/Aiur/Compiler.lean index 5eb558e18..88542e5d4 100644 --- a/Ix/Aiur/Compiler.lean +++ b/Ix/Aiur/Compiler.lean @@ -189,12 +189,11 @@ def Bytecode.Toplevel.needsCircuit (t : Bytecode.Toplevel) : Array Bool := Id.ru stack := stack.push callee needs -/-- Full compilation pipeline. -/ -def Source.Toplevel.compile (t : Source.Toplevel) : Except String CompiledToplevel := do - let t ← t.inlineCalls - let typedDecls ← t.checkAndSimplify.mapError toString - let concDecls ← typedDecls.concretize.mapError toString - let (bytecodeRaw, preNameMap) ← concDecls.toBytecode +/-- The exact artifact produced by the total final compilation passes. +Keeping this operation separate lets the compilation success theorem bind +the returned bytecode and function map to the successful stage outputs. -/ +def finishCompilation (t : Source.Toplevel) (bytecodeRaw : Bytecode.Toplevel) + (preNameMap : Std.HashMap Global Bytecode.FunIdx) : CompiledToplevel := Id.run do let (bytecodeDedup, remap) := bytecodeRaw.deduplicate let needs := bytecodeDedup.needsCircuit let bytecode : Bytecode.Toplevel := { bytecodeDedup with @@ -209,6 +208,14 @@ def Source.Toplevel.compile (t : Source.Toplevel) : Except String CompiledToplev circuits := bytecode.singletonCircuits fun i => reverseMap[i]?.getD s!"" } pure (CompiledToplevel.mk t bytecode nameMap) +/-- Full compilation pipeline. -/ +def Source.Toplevel.compile (t : Source.Toplevel) : Except String CompiledToplevel := do + let t ← t.inlineCalls + let typedDecls ← t.checkAndSimplify.mapError toString + let concDecls ← typedDecls.concretize.mapError toString + let (bytecodeRaw, preNameMap) ← concDecls.toBytecode + return finishCompilation t bytecodeRaw preNameMap + /-- Name of the environment variable that switches function grouping OFF process-wide: when it is set to anything but `0` or the empty string, `compileWithGroups` ignores its grouping and compiles the singleton diff --git a/Ix/Aiur/Compiler/Dedup.lean b/Ix/Aiur/Compiler/Dedup.lean index 8a9d70bfa..521738be4 100644 --- a/Ix/Aiur/Compiler/Dedup.lean +++ b/Ix/Aiur/Compiler/Dedup.lean @@ -138,14 +138,14 @@ def assignClasses [BEq α] [Hashable α] (values : Array α) : Array Nat × Nat | none => (classes.push nextId, map.insert v nextId, nextId + 1) (classes, nextId) -/-- Bounded refinement step. The `bound` caps iterations — `classes.size + 1` -is always enough since the number of distinct equivalence classes can only -increase (or stay the same) per step, and is bounded above by `classes.size`. -/ +/-- Bounded refinement step. The bound caps optimization work. The public +pass validates the final candidate, so execution preservation does not +depend on proving that this iteration has reached a fixed point. -/ def partitionRefineBound : Nat → Array Nat → Array (Array FunIdx) → Array Nat | 0, classes, _ => classes | bound+1, classes, callees => let signatures := classes.mapIdx fun i cls => - (cls, callees[i]!.map (classes[·]!)) + (cls, (callees[i]?.getD #[]).map fun callee => classes[callee]?.getD 0) let (newClasses, _) := assignClasses signatures if newClasses == classes then classes else partitionRefineBound bound newClasses callees @@ -200,9 +200,9 @@ def deduplicate_newFunctions (functions : Array Function) (classes : Array Nat) else acc) #[] -/-- Deduplicate bytecode functions via partition refinement. -Returns the deduplicated toplevel and a mapping from old index to new index. -/ -def Toplevel.deduplicate (t : Toplevel) : Toplevel × (FunIdx → FunIdx) := +/-- Propose a deduplication by partition refinement. The public pass validates +this candidate before returning it. -/ +def Toplevel.deduplicateCandidate (t : Toplevel) : Toplevel × (FunIdx → FunIdx) := let functions := t.functions let n := functions.size if n == 0 then (t, id) @@ -219,6 +219,37 @@ def Toplevel.deduplicate (t : Toplevel) : Toplevel × (FunIdx → FunIdx) := let newFunctions := deduplicate_newFunctions functions classes canonical remapFn ({ t with functions := newFunctions }, remapFn) +/-- Keep invalid source function indices outside the target's domain. -/ +def boundedRenaming (source : Toplevel) (rename : FunIdx → FunIdx) (i : FunIdx) : FunIdx := + if i < source.functions.size then rename i else i + +/-- Every old function must map to a valid target with the same layout and +the exact body obtained by rewriting calls. Target size and bounded renaming +also prevent invalid source calls from becoming valid target calls. -/ +def validatesRenaming (source target : Toplevel) (rename : FunIdx → FunIdx) : Bool := + target.functions.size ≤ source.functions.size && + (Array.range source.functions.size).all fun i => + if hi : i < source.functions.size then + if hj : rename i < target.functions.size then + source.functions[i].layout == target.functions[rename i].layout && + rewriteBlock rename source.functions[i].body == target.functions[rename i].body + else false + else false + +/-- Use a proposed function renaming only after checking its complete code +relation. An invalid candidate leaves the original program and indices intact. -/ +def checkedRenaming (source candidate : Toplevel) (rename : FunIdx → FunIdx) : + Toplevel × (FunIdx → FunIdx) := + let bounded := boundedRenaming source rename + if validatesRenaming source candidate bounded then (candidate, bounded) + else (source, id) + +/-- Deduplicate bytecode functions via validated partition refinement. +Returns the selected program and a mapping from old index to new index. -/ +def Toplevel.deduplicate (source : Toplevel) : Toplevel × (FunIdx → FunIdx) := + let candidate := source.deduplicateCandidate + checkedRenaming source candidate.1 candidate.2 + end Bytecode end Aiur diff --git a/Ix/Aiur/Compiler/Layout.lean b/Ix/Aiur/Compiler/Layout.lean index a43f1469b..6676a7dfc 100644 --- a/Ix/Aiur/Compiler/Layout.lean +++ b/Ix/Aiur/Compiler/Layout.lean @@ -109,7 +109,8 @@ structure LayoutMState where degrees : Array Nat @[inline] def LayoutMState.new (inputSize : Nat) : LayoutMState := - ⟨{ inputSize, selectors := 0, auxiliaries := 1, lookups := 0 }, .empty, Array.replicate inputSize 1⟩ + -- Multiplicity plus six rank bytes, with three byte-pair range lookups. + ⟨{ inputSize, selectors := 0, auxiliaries := 7, lookups := 3 }, .empty, Array.replicate inputSize 1⟩ abbrev LayoutM := StateM LayoutMState @@ -174,7 +175,10 @@ def opLayout : Bytecode.Op → LayoutM Unit | .call _ _ outputSize unconstrained => do pushDegrees $ .replicate outputSize 1 bumpAuxiliaries outputSize - if !unconstrained then bumpLookups + if !unconstrained then + -- Callee rank and six bytes for (callee rank - caller rank - 1). + bumpAuxiliaries 7 + bumpLookups 4 | .store values => do pushDegree 1; bumpAuxiliaries; bumpLookups; addMemSize values.size | .load size _ => do diff --git a/Ix/Aiur/Compiler/Lower.lean b/Ix/Aiur/Compiler/Lower.lean index 039eb7dcc..db1e22f26 100644 --- a/Ix/Aiur/Compiler/Lower.lean +++ b/Ix/Aiur/Compiler/Lower.lean @@ -250,9 +250,9 @@ def toIndex let eltSize ← match typSize layoutMap eltTyp with | .error e => throw e | .ok len => pure len + let val ← toIndex layoutMap bindings val let arr ← toIndex layoutMap bindings arr let left := arr.extract 0 (i * eltSize) - let val ← toIndex layoutMap bindings val let right := arr.extract ((i + 1) * eltSize) pure $ left ++ val ++ right | .store _ _ arg => do diff --git a/Ix/Aiur/LookupShapes.lean b/Ix/Aiur/LookupShapes.lean new file mode 100644 index 000000000..68bc15db1 --- /dev/null +++ b/Ix/Aiur/LookupShapes.lean @@ -0,0 +1,114 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +module +public import Ix.Aiur.Stages.Bytecode + +/-! +Total structural checks for the boundaries of zero-padded lookup messages. + +Function messages contain the function index, inputs, outputs and rank, +without length separators. Calls must use their callee's input and return +arities. Public result arity is checked separately against the entry body. +These checks do not establish value-index or circuit-layout correctness. +-/ + +public section +@[expose] section + +namespace Aiur.Bytecode + +private theorem block_ctrl_smaller (block : Block) : sizeOf block.ctrl < sizeOf block := by + cases block + simp + omega + +mutual + +/-- Check every function return, including early returns from continuation +arms. A yield returns to its enclosing continuation, not the function. -/ +def Ctrl.returnsHaveSize (size : Nat) : Ctrl → Bool + | .return _ values => values.size == size + | .yield .. => true + | .match _ branches fallback => + branches.attach.all (fun ⟨(_, block), _⟩ => block.returnsHaveSize size) && + (match fallback with | none => true | some block => block.returnsHaveSize size) + | .matchContinue _ branches fallback _ _ _ continuation => + branches.attach.all (fun ⟨(_, block), _⟩ => block.returnsHaveSize size) && + ((match fallback with | none => true | some block => block.returnsHaveSize size) && + continuation.returnsHaveSize size) +termination_by ctrl => sizeOf ctrl +decreasing_by + all_goals first + | decreasing_tactic + | (have := Array.sizeOf_lt_of_mem ‹_ ∈ _›; grind) + +def Block.returnsHaveSize (size : Nat) (block : Block) : Bool := + block.ctrl.returnsHaveSize size +termination_by sizeOf block +decreasing_by exact block_ctrl_smaller block + +end + +def Op.lookupShape (program : Toplevel) : Op → Bool + | .call index inputs outputs false => + match program.functions[index]? with + | none => false + | some callee => callee.constrained && + (callee.layout.inputSize == inputs.size && callee.body.returnsHaveSize outputs) + | .store values => decide (values.size < gSize.toNat) + | .load size _ => decide (size < gSize.toNat) + | _ => true + +mutual + +def Ctrl.lookupShapes (program : Toplevel) (yieldSize : Option Nat) : Ctrl → Bool + | .return .. => true + | .yield _ values => yieldSize == some values.size + | .match _ branches fallback => + branches.attach.all (fun ⟨(_, block), _⟩ => block.lookupShapes program yieldSize) && + (match fallback with | none => true | some block => block.lookupShapes program yieldSize) + | .matchContinue _ branches fallback size _ _ continuation => + branches.attach.all (fun ⟨(_, block), _⟩ => block.lookupShapes program (some size)) && + ((match fallback with | none => true | some block => block.lookupShapes program (some size)) && + continuation.lookupShapes program yieldSize) +termination_by ctrl => sizeOf ctrl +decreasing_by + all_goals first + | decreasing_tactic + | (have := Array.sizeOf_lt_of_mem ‹_ ∈ _›; grind) + +def Block.lookupShapes (program : Toplevel) (yieldSize : Option Nat) (block : Block) : Bool := + block.ops.all (Op.lookupShape program) && block.ctrl.lookupShapes program yieldSize +termination_by sizeOf block +decreasing_by exact block_ctrl_smaller block + +end + +/-- Mirror the native construction guard, including canonical function +indices, canonical memory widths and continuation-yield arities. -/ +def Toplevel.validateLookupShapes (program : Toplevel) : Bool := + decide (program.functions.size < gSize.toNat) && + (program.memorySizes.all (fun size => decide (size < gSize.toNat)) && + program.functions.all (fun function => + !function.constrained || function.body.lookupShapes program none)) + +/-- A public claim names a constrained public function and has exactly its +input and return widths. The final zero rank is omitted from this encoding. -/ +def Toplevel.validClaimShape (program : Toplevel) (claim : Array G) : Bool := + match claim.toList with + | channel :: index :: arguments => + channel == 0 && + (match program.functions[index.n]? with + | none => false + | some function => function.entry && function.constrained && + (decide (function.layout.inputSize ≤ arguments.length) && + function.body.returnsHaveSize (arguments.length - function.layout.inputSize))) + | _ => false + +end Aiur.Bytecode + +end +end diff --git a/Ix/Aiur/Proofs.lean b/Ix/Aiur/Proofs.lean new file mode 100644 index 000000000..e2ae74aff --- /dev/null +++ b/Ix/Aiur/Proofs.lean @@ -0,0 +1,61 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.Activity +import Ix.Aiur.Proofs.CallOrder +import Ix.Aiur.Proofs.Lookup +import Ix.Aiur.Proofs.Execution +import Ix.Aiur.Proofs.Memory +import Ix.Aiur.Proofs.Field +import Ix.Aiur.Proofs.LocalConstraints +import Ix.Aiur.Proofs.ByteArithmetic +import Ix.Aiur.Proofs.ByteLookups +import Ix.Aiur.Proofs.LookupMessages +import Ix.Aiur.Proofs.LookupShapes +import Ix.Aiur.Proofs.GlobalLookups +import Ix.Aiur.Proofs.LookupBudget +import Ix.Aiur.Proofs.SelectorMessages +import Ix.Aiur.Proofs.SelectorControl +import Ix.Aiur.Proofs.ReturnGates +import Ix.Aiur.Proofs.BranchSelection +import Ix.Aiur.Proofs.OperationRows +import Ix.Aiur.Proofs.CallInventory +import Ix.Aiur.Proofs.BlockRows +import Ix.Aiur.Proofs.BlockRowProjection +import Ix.Aiur.Proofs.BlockRowExecution +import Ix.Aiur.Proofs.BlockRowCalls +import Ix.Aiur.Proofs.BlockRowInputs +import Ix.Aiur.Proofs.FunctionRows +import Ix.Aiur.Proofs.QuerySlots +import Ix.Aiur.Proofs.BlockQuerySlots +import Ix.Aiur.Proofs.QuerySlotMessages +import Ix.Aiur.Proofs.BlockQueryPool +import Ix.Aiur.Proofs.CircuitRows +import Ix.Aiur.Proofs.CircuitRowMembers +import Ix.Aiur.Proofs.CircuitRowQueries +import Ix.Aiur.Proofs.CircuitRowReturns +import Ix.Aiur.Proofs.CircuitRowExecution +import Ix.Aiur.Proofs.RowCounts +import Ix.Aiur.Proofs.CircuitRowCounts +import Ix.Aiur.Proofs.ProviderEquivalence +import Ix.Aiur.Proofs.CircuitTableData +import Ix.Aiur.Proofs.CircuitTableExecution +import Ix.Aiur.Proofs.PublicCircuitExecution +import Ix.Aiur.Proofs.BranchlessSlots +import Ix.Aiur.Proofs.EncodedCircuitExecution +import Ix.Aiur.Proofs.CircuitTraces +import Ix.Aiur.Proofs.CircuitMembership +import Ix.Aiur.Proofs.LookupLayout +import Ix.Aiur.Proofs.Metadata +import Ix.Aiur.Proofs.Renaming +import Ix.Aiur.Proofs.Dedup +import Ix.Aiur.Proofs.TailMatches +import Ix.Aiur.Proofs.NormalizationFrames +import Ix.Aiur.Proofs.Compilation +import Ix.Aiur.Proofs.Grouping +import Ix.Aiur.Proofs.Audit + +/-! Audited compiler, grouping and verifier-binding components for Aiur. +These roots do not yet establish full public acceptance-to-model soundness. -/ diff --git a/Ix/Aiur/Proofs/Activity.lean b/Ix/Aiur/Proofs/Activity.lean new file mode 100644 index 000000000..a1d5abdaf --- /dev/null +++ b/Ix/Aiur/Proofs/Activity.lean @@ -0,0 +1,60 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Goldilocks + +/-! Local arithmetic for the function and memory AIR's activity constraint. +The Rust constraint emitter uses `multiplicity * (1 - selector)` on every +function and memory circuit. This theorem rules out a nonzero return/pull +multiplicity on an inactive row. It is not the full AIR/execution reflection +theorem, nor a proof of the Rust field implementation or constraint emitter. +-/ + +namespace Aiur + +theorem G.ofNat_n (a : G) : G.ofNat a.n = a := by + have h : a.n < gSize.toNat := UInt64.lt_iff_toNat_lt.mp a.property + simp only [G.ofNat, Nat.mod_eq_of_lt h, Nat.toUInt64, UInt64.ofNat_toNat] + split + · rfl + · contradiction + +theorem G.mul_one (a : G) : a * 1 = a := by + change G.ofNat (a.n * (1 : G).n) = a + have h : (1 : G).n = 1 := rfl + rw [h, Nat.mul_one] + exact G.ofNat_n a + +theorem G.mul_zero (a : G) : a * 0 = 0 := by + change G.ofNat (a.n * (0 : G).n) = 0 + have h : (0 : G).n = 0 := rfl + rw [h, Nat.mul_zero] + rfl + +namespace AIR + +/-- Exact polynomial appended by both the function and memory emitters. -/ +def activityConstraint (multiplicity selector : G) : G := + multiplicity * (1 - selector) + +theorem inactive_multiplicity_zero {multiplicity selector : G} + (inactive : selector = 0) (satisfied : activityConstraint multiplicity selector = 0) : + multiplicity = 0 := by + subst selector + have h : (1 : G) - 0 = 1 := by decide + simpa only [activityConstraint, h, G.mul_one] using satisfied + +theorem nonzero_multiplicity_active {multiplicity selector : G} + (satisfied : activityConstraint multiplicity selector = 0) + (nonzero : multiplicity ≠ 0) : selector ≠ 0 := by + intro inactive + exact nonzero (inactive_multiplicity_zero inactive satisfied) + +theorem active_satisfies (multiplicity : G) : activityConstraint multiplicity 1 = 0 := by + have h : (1 : G) - 1 = 0 := by decide + simp only [activityConstraint, h, G.mul_zero] + +end AIR +end Aiur diff --git a/Ix/Aiur/Proofs/Audit.lean b/Ix/Aiur/Proofs/Audit.lean new file mode 100644 index 000000000..d7b0e0aa5 --- /dev/null +++ b/Ix/Aiur/Proofs/Audit.lean @@ -0,0 +1,660 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Lean +import Ix.Aiur.BoundVerifier +import Ix.Aiur.Proofs.Activity +import Ix.Aiur.Proofs.CallOrder +import Ix.Aiur.Proofs.Lookup +import Ix.Aiur.Proofs.Execution +import Ix.Aiur.Proofs.Memory +import Ix.Aiur.Proofs.LocalConstraints +import Ix.Aiur.Proofs.ByteLookups +import Ix.Aiur.Proofs.LookupMessages +import Ix.Aiur.Proofs.LookupShapes +import Ix.Aiur.Proofs.GlobalLookups +import Ix.Aiur.Proofs.LookupBudget +import Ix.Aiur.Proofs.ReturnGates +import Ix.Aiur.Proofs.BranchSelection +import Ix.Aiur.Proofs.CallInventory +import Ix.Aiur.Proofs.FunctionRows +import Ix.Aiur.Proofs.BlockQueryPool +import Ix.Aiur.Proofs.CircuitRowExecution +import Ix.Aiur.Proofs.CircuitRowCounts +import Ix.Aiur.Proofs.PublicCircuitExecution +import Ix.Aiur.Proofs.EncodedCircuitExecution +import Ix.Aiur.Proofs.CircuitTraces +import Ix.Aiur.Proofs.CircuitMembership +import Ix.Aiur.Proofs.LookupLayout +import Ix.Aiur.Proofs.Grouping +import Ix.Aiur.Proofs.TailMatches +import Ix.Aiur.Proofs.NormalizationFrames + +/-! Exact proof and execution inventory for the implemented C8 components. +The compiler and proof-system runtime are inventoried here; their presence +is not a proof of runtime refinement or public certified semantic soundness. +-/ + +open Lean Lean.Elab Command + +namespace Aiur.Proofs.Audit + +def callOrderRoots : Array Lean.Name := #[ + `Aiur.G.n_ofNat, `Aiur.G.sub_eq_zero_iff, `Aiur.G.n_add, `Aiur.G.n_mul, + `Aiur.AIR.packRank_lt, `Aiur.AIR.call_order_strict, `Aiur.AIR.call_order_irrefl, + `Aiur.AIR.active_call_order_strict, `Aiur.AIR.packed_call_order_strict, + `Aiur.AIR.call_relation_wellFounded] + +def lookupRoots : Array Lean.Name := #[ + `Aiur.G.zero_add, `Aiur.G.ofNat_ne_zero_of_lt, + `Aiur.AIR.characteristic_queries_balance, `Aiur.AIR.suppliedWeight_nonzero_provider, + `Aiur.AIR.exactLookupBalance_provider, `Aiur.AIR.byteRangeMessage_bounded, + `Aiur.AIR.exactLookupBalance_byteRange, `Aiur.AIR.exactLookupBalance_rankBytes, + `Aiur.AIR.exactLookupBalance_call_order] + +def executionRoots : Array Lean.Name := #[ + `Aiur.AIR.FunctionRow.Valid.active_of_nonzero, + `Aiur.AIR.functionQueries_provider, + `Aiur.AIR.balancedRows_execute, + `Aiur.AIR.balancedRoots_execute] + +def memoryRoots : Array Lean.Name := #[ + `Aiur.AIR.MemoryRowsValid.pointer_injective, + `Aiur.AIR.memoryFacts_functional, + `Aiur.AIR.memoryQueries_provider, + `Aiur.AIR.memoryQueries_width, + `Aiur.AIR.memoryQueries_consistent, + `Aiur.AIR.memoryQueries_fact] + +def fieldRoots : Array Lean.Name := #[ + `Aiur.gSize_prime, + `Aiur.G.mul_eq_zero_iff, + `Aiur.G.boolean_of_constraint, + `Aiur.G.boolean_of_one_sub_constraint, + `Aiur.G.eqZero_of_constraints] + +def localConstraintRoots : Array Lean.Name := #[ + `Aiur.AIR.selectorSum_count_le_one, + `Aiur.AIR.selectorSum_inactive, + `Aiur.AIR.selectorSum_active_split, + `Aiur.AIR.selectorSum_characteristic_cancel, + `Aiur.AIR.nonzero_multiplicity_selector_one, + `Aiur.AIR.active_eqZero, + `Aiur.AIR.active_case, + `Aiur.AIR.active_default, + `Aiur.AIR.MemoryRowsPolynomials.valid, + `Aiur.AIR.MemoryRowsPolynomials.functional] + +def byteArithmeticRoots : Array Lean.Name := #[ + `Aiur.AIR.inverse256_correct, + `Aiur.AIR.byte_add_carry, + `Aiur.AIR.byte_sub_borrow, + `Aiur.AIR.byte_carry_relation, + `Aiur.AIR.pack4_n, + `Aiur.AIR.u32Carry_relation, + `Aiur.AIR.u32_less_than, + `Aiur.AIR.active_u32_less_than] + +def byteLookupRoots : Array Lean.Name := #[ + `Aiur.AIR.exactLookupBalance_byte1, + `Aiur.AIR.exactLookupBalance_byte2, + `Aiur.AIR.exactLookupBalance_byte1_step, + `Aiur.AIR.exactLookupBalance_byte2_step, + `Aiur.AIR.active_u32_less_than_step] + +def lookupMessageRoots : Array Lean.Name := #[ + `Aiur.AIR.padMessage_injective_of_shape, + `Aiur.AIR.exactLookupBalance_of_injective_on, + `Aiur.AIR.ExactLookupBalance.filter, + `Aiur.AIR.paddedLookupBalance_provider, + `Aiur.AIR.paddedLookupBalance_exact, + `Aiur.AIR.functionMessage_shape, + `Aiur.AIR.memoryMessage_shape, + `Aiur.AIR.byte1Request_shape, + `Aiur.AIR.byte2Request_shape, + `Aiur.AIR.functionMessage_injective, + `Aiur.AIR.exactLookupBalance_functionMessages, + `Aiur.AIR.memoryMessage_injective, + `Aiur.AIR.exactLookupBalance_memoryMessages, + `Aiur.AIR.padMessage_append_zero, + `Aiur.AIR.functionMessage_rank_alias] + +def lookupShapeRoots : Array Lean.Name := #[ + `Aiur.Bytecode.AIR.RunBlock.return_size, + `Aiur.Bytecode.AIR.RunFunction.return_size, + `Aiur.Bytecode.AIR.Step.calls_lookupShape, + `Aiur.Bytecode.AIR.RunOps.calls_lookupShape, + `Aiur.Bytecode.AIR.RunBlock.calls_lookupShape, + `Aiur.Bytecode.AIR.RunFunction.calls_lookupShape, + `Aiur.BoundVerifier.Backend.air_return_size, + `Aiur.BoundVerifier.Backend.claim_shape] + +def globalLookupRoots : Array Lean.Name := #[ + `Aiur.AIR.padded_functionMessage_reflects, + `Aiur.AIR.GlobalLookups.function_provider, + `Aiur.AIR.GlobalLookups.byte1, + `Aiur.AIR.GlobalLookups.byte2, + `Aiur.AIR.GlobalLookups.memory_fact, + `Aiur.AIR.GlobalLookups.memory_consistent, + `Aiur.AIR.GlobalLookups.byte1_step, + `Aiur.AIR.GlobalLookups.byte2_step, + `Aiur.AIR.GlobalLookups.rank_bytes, + `Aiur.AIR.GlobalLookups.rows_execute, + `Aiur.AIR.GlobalLookups.roots_execute, + `Aiur.BoundVerifier.Backend.root_lookupShape, + `Aiur.BoundVerifier.claim_padding, + `Aiur.BoundVerifier.Backend.global_execution] + +def lookupBudgetRoots : Array Lean.Name := #[ + `Aiur.lookupQueryBound_sound, + `Aiur.lookupQueryBound_consumer_count, + `Aiur.lookupQueryBound_shape, + `Aiur.lookupQueryBound_step_no_overflow, + `Aiur.lookupQueryBound_complete, + `Aiur.lookupSlotSum_bounded, + `Aiur.lookupQueryBound_encodedKey, + `Aiur.AIR.GlobalLookups.of_budget] + +def selectorControlRoots : Array Lean.Name := #[ + `Aiur.AIR.weightedMessage_active, + `Aiur.AIR.weightedMessage_inactive, + `Aiur.AIR.slotMessage_active, + `Aiur.AIR.continuation_merge, + `Aiur.Bytecode.Block.selectorFlow_sound, + `Aiur.Bytecode.Block.selectorFlow_yields_empty, + `Aiur.Bytecode.Block.selectorFlow_active_return, + `Aiur.Bytecode.Block.selectorFlow_provider_return, + `Aiur.AIR.SelectorFlow.Sound.inactive_terminal, + `Aiur.AIR.SelectorFlow.Sound.return_stops_continuation, + `Aiur.AIR.SelectorFlow.Sound.yield_starts_continuation, + `Aiur.Bytecode.Block.returnGates_reflects, + `Aiur.Bytecode.Block.return_message] + +def operationRowRoots : Array Lean.Name := #[ + `Aiur.AIR.emitOp_step, + `Aiur.AIR.emitOps_run, + `Aiur.AIR.emitOp_calls, + `Aiur.AIR.emitOps_calls, + `Aiur.AIR.CallsEmitted.ordered, + `Aiur.AIR.active_array_equality, + `Aiur.Bytecode.Block.selectorFlow_boolean, + `Aiur.Bytecode.MatchPolynomials.active_branch, + `Aiur.Bytecode.MatchPolynomials.active_match, + `Aiur.Bytecode.MatchPolynomials.active_matchContinue] + +def blockRowRoots : Array Lean.Name := #[ + `Aiur.Bytecode.Block.emitRow_projection, + `Aiur.Bytecode.Block.emitRow_selectors, + `Aiur.AIR.mergeEquations_chosen, + `Aiur.Bytecode.branchRows_selected, + `Aiur.Bytecode.Block.emitRow_run, + `Aiur.Bytecode.Block.emitRow_tracks_calls, + `Aiur.Bytecode.Block.emitRow_inputs, + `Aiur.Bytecode.Function.emitRow_run, + `Aiur.Bytecode.Function.emitRow_valid, + `Aiur.AIR.slotMessage_chosen, + `Aiur.Bytecode.Function.emitRow_message] + +def querySlotRoots : Array Lean.Name := #[ + `Aiur.Bytecode.Block.emitRow_equation_querySlots, + `Aiur.AIR.QuerySlots.slot_multiplicity, + `Aiur.AIR.QuerySlots.multiplicity_boolean, + `Aiur.AIR.QuerySlots.active_singleton, + `Aiur.AIR.QuerySlots.slot_message, + `Aiur.AIR.QuerySlots.queries_reflect, + `Aiur.AIR.QuerySlots.padded_balance, + `Aiur.AIR.decodedQueries_length, + `Aiur.Bytecode.Block.emitRow_queried_pool, + `Aiur.Bytecode.Function.emitRow_pool_valid] + +def circuitRowRoots : Array Lean.Name := #[ + `Aiur.AIR.emitMembers_spec, + `Aiur.Bytecode.Circuit.emitRow_spec, + `Aiur.Bytecode.Circuit.emitRow_boolean, + `Aiur.Bytecode.Circuit.emitRow_active_member, + `Aiur.Bytecode.Circuit.emitRow_querySlots, + `Aiur.AIR.circuitEmission_rank_queried, + `Aiur.AIR.MemberEmission.FromProgram.return_count, + `Aiur.AIR.circuitEmission_return_count, + `Aiur.AIR.circuitEmission_return_message, + `Aiur.Bytecode.Circuit.emitRow_valid] + +def rowCountRoots : Array Lean.Name := #[ + `Aiur.Bytecode.Ctrl.controlCounts_spec, + `Aiur.Bytecode.Block.controlCounts_spec, + `Aiur.Bytecode.Block.rowBounds_of_controlCounts, + `Aiur.Bytecode.Block.return_bound_of_controlCounts, + `Aiur.Bytecode.Block.returns_le_selectors, + `Aiur.Bytecode.Toplevel.validateRowCounts_circuit, + `Aiur.Bytecode.Circuit.validateRowCounts_spec, + `Aiur.Bytecode.Circuit.emitRow_count_bounds, + `Aiur.Bytecode.Circuit.emitRow_valid_checked, + `Aiur.BoundVerifier.Backend.circuit_row_counts] + +def circuitTableRoots : Array Lean.Name := #[ + `Aiur.Bytecode.Circuit.emitRow_valid_in_pool, + `Aiur.AIR.suppliedWeight_padded_congr, + `Aiur.AIR.PaddedLookupBalance.congr_providers, + `Aiur.Bytecode.Circuit.emitRow_provider, + `Aiur.AIR.AuxiliaryTables.global_of_circuit_balance, + `Aiur.AIR.FunctionRow.inactive_valid, + `Aiur.AIR.CircuitWitness.provider_row, + `Aiur.AIR.CircuitWitness.interpreted_row, + `Aiur.AIR.circuitWitnesses_interpret, + `Aiur.AIR.circuitWitnesses_execute, + `Aiur.AIR.PaddedLookupBalance.congr_queries, + `Aiur.BoundVerifier.Backend.public_circuit_execution] + +def branchlessRoots : Array Lean.Name := #[ + `Aiur.AIR.QueryWriters.single, + `Aiur.Bytecode.Function.emitRow_terminal_writers, + `Aiur.AIR.circuitEmission_queryWriters, + `Aiur.Bytecode.Circuit.emitRow_queryWriters, + `Aiur.Bytecode.Circuit.emitRow_queries_reflect, + `Aiur.AIR.slotMessage_member_length, + `Aiur.AIR.QuerySlots.decoded_widths, + `Aiur.AIR.circuitWitnesses_queries_reflect, + `Aiur.AIR.circuitWitnesses_decoded_widths, + `Aiur.BoundVerifier.Backend.encoded_circuit_execution] + +def circuitTraceRoots : Array Lean.Name := #[ + `Aiur.AIR.CircuitTraces.slot_sum_append, + `Aiur.AIR.CircuitTraces.capacity_bounded, + `Aiur.AIR.emitCircuitWitness_spec, + `Aiur.AIR.encodedQueries_length, + `Aiur.AIR.encodedCircuitQueryPool_uniform_bound, + `Aiur.AIR.emitCircuitWitnesses_spec, + `Aiur.AIR.CircuitTraces.emitWitnesses_spec, + `Aiur.BoundVerifier.Backend.trace_circuit_execution] + +def circuitMembershipRoots : Array Lean.Name := #[ + `Aiur.Bytecode.singletonCircuits_constrained, + `Aiur.CompiledToplevel.groupFunctions_constrained, + `Aiur.finishCompilation_circuits_constrained, + `Aiur.Source.Toplevel.compile_circuits_constrained, + `Aiur.BoundVerifier.Backend.circuits_constrained, + `Aiur.Bytecode.Toplevel.validateLookupShapes_function, + `Aiur.AIR.CircuitWitness.shapes_of_compiled, + `Aiur.BoundVerifier.Backend.witness_shapes, + `Aiur.BoundVerifier.Backend.compiled_trace_execution] + +def lookupLayoutRoots : Array Lean.Name := #[ + `Aiur.Concrete.Bytecode.opLayout_lookupUsage, + `Aiur.Concrete.Bytecode.opsLayout_lookupUsage, + `Aiur.AIR.emitOp_lookupUsage, + `Aiur.AIR.emitOps_lookupUsage, + `Aiur.Bytecode.branchRows_lookupUsage, + `Aiur.Bytecode.Ctrl.emitRow_lookupUsage, + `Aiur.Bytecode.Block.emitRow_lookupUsage, + `Aiur.Concrete.Bytecode.ctrlLayout_lookupUsage, + `Aiur.Concrete.Bytecode.blockLayout_lookupUsage, + `Aiur.Concrete.Function.compile_lookupLayout, + `Aiur.Concrete.Decls.toBytecode_lookupLayout, + `Aiur.Bytecode.rewriteCtrl_lookupUsage, + `Aiur.Bytecode.rewriteBlock_lookupUsage, + `Aiur.Bytecode.Toplevel.deduplicate_lookupLayout, + `Aiur.finishCompilation_lookupLayout, + `Aiur.Source.Toplevel.compile_lookupLayout, + `Aiur.BoundVerifier.Backend.functions_lookupLayout, + `Aiur.Bytecode.singletonCircuits_lookupBound, + `Aiur.Bytecode.merged_lookupBound, + `Aiur.CompiledToplevel.groupFunctions_lookupBound, + `Aiur.finishCompilation_lookupBound, + `Aiur.Source.Toplevel.compile_lookupBound, + `Aiur.BoundVerifier.Backend.circuits_lookupBound, + `Aiur.AIR.CircuitWitness.lookupBounds_of_compiled, + `Aiur.BoundVerifier.Backend.witness_lookupBounds, + `Aiur.BoundVerifier.Backend.bounded_trace_execution] + +def roots : Array Lean.Name := #[ + `Aiur.G.ofNat_n, `Aiur.G.mul_one, `Aiur.G.mul_zero, + `Aiur.AIR.inactive_multiplicity_zero, + `Aiur.AIR.nonzero_multiplicity_active, `Aiur.AIR.active_satisfies, + `Aiur.Bytecode.Eval.runFunction_sameCode, + `Aiur.finishCompilation_sameCode, `Aiur.finishCompilation_reflects, + `Aiur.Source.Toplevel.compile_artifact_of_ok, + `Aiur.BoundVerifier.build, `Aiur.BoundVerifier.verify_success, + `Aiur.BoundVerifier.Backend.compilation_stages, + `Aiur.CompiledToplevel.groupFunctions_preserves_code, + `Aiur.CompiledToplevel.groupFunctions_sameCode, + `Aiur.CompiledToplevel.groupFunctions_preserves_execution, + `Aiur.BoundVerifier.Backend.reference_execution, + `Aiur.BoundVerifier.Backend.execution_reflects, + `Aiur.Bytecode.Ctrl.beq_eq_true_iff, + `Aiur.Bytecode.Block.beq_eq_true_iff, + `Aiur.Bytecode.Eval.runFunction_renamed_iff, + `Aiur.Bytecode.Eval.deduplicate_preserves_execution, + `Aiur.finishCompilation_preserves_execution, + `Aiur.finishCompilation_nameMap_image, + `Aiur.BoundVerifier.Backend.execution_reflects_raw, + `Aiur.Source.Eval.interp_restoreTailMatches, + `Aiur.Source.Eval.interp_wrapLets, + `Aiur.Source.Eval.evalFrames_append, + `Aiur.Source.Eval.interp_peelLets, + `Aiur.Source.Eval.interp_ret_wrapLets, + `Aiur.Source.Eval.interp_ioWrite_sequence, + `Aiur.Source.Eval.interp_debug_sequence, + `Aiur.Source.Eval.interp_assertEq_sequence, + `Aiur.Source.Eval.interp_ioSetInfo_sequence, + `Aiur.Source.Eval.interp_app_mode, + `Aiur.AIR.memoryPointerCycle_valid, + `Aiur.AIR.memoryPointerCycle_inconsistent] ++ callOrderRoots ++ lookupRoots ++ executionRoots ++ memoryRoots ++ + fieldRoots ++ localConstraintRoots ++ byteArithmeticRoots ++ byteLookupRoots ++ + lookupMessageRoots ++ lookupShapeRoots ++ globalLookupRoots ++ lookupBudgetRoots ++ + selectorControlRoots ++ operationRowRoots ++ blockRowRoots ++ querySlotRoots ++ circuitRowRoots ++ + rowCountRoots ++ circuitTableRoots ++ branchlessRoots ++ circuitTraceRoots ++ circuitMembershipRoots ++ lookupLayoutRoots + +def premises : Array Lean.Name := #[ + `Aiur.AIR.activityConstraint, + `Aiur.Bytecode.Eval.SameCode.mk, + `Aiur.finishCompilation, + `Aiur.BoundVerifier.Selection.mk, + `Aiur.BoundVerifier.Selection.compile, + `Aiur.BoundVerifier.Selection.system, + `Aiur.BoundVerifier.Backend.mk, + `Aiur.BoundVerifier.verify, + `Aiur.CompiledToplevel.groupFunctions, + `Aiur.AIR.callRankBound, `Aiur.AIR.packRank, `Aiur.AIR.callOrderConstraint, + `Aiur.Concrete.Bytecode.LayoutMState.new, `Aiur.Concrete.Bytecode.opLayout, + `Aiur.AIR.suppliedWeight, `Aiur.AIR.ExactLookupBalance, + `Aiur.AIR.byteRangeMessage, `Aiur.AIR.byteRangeProviders, `Aiur.AIR.rankByteQueries, + `Aiur.Bytecode.instBEqCtrl, `Aiur.Bytecode.instBEqBlock, + `Aiur.Bytecode.instHashableCtrl, `Aiur.Bytecode.instHashableBlock, + `Aiur.Bytecode.Eval.RenamedCode.mk, + `Aiur.Bytecode.boundedRenaming, `Aiur.Bytecode.validatesRenaming, + `Aiur.Bytecode.checkedRenaming, `Aiur.Bytecode.Toplevel.deduplicate, + `Aiur.Bytecode.Toplevel.deduplicateCandidate, + `Aiur.Source.Term.restoreTailMatches, `Aiur.instHashableValue, + `Aiur.Source.Term.hoistLets, `Aiur.Source.Term.bindArguments, `Aiur.Source.Toplevel.inlineCalls, + `Aiur.Bytecode.AIR.Memory, `Aiur.Bytecode.AIR.Call.mk, `Aiur.Bytecode.AIR.primitive, + `Aiur.Bytecode.AIR.readValues, `Aiur.Bytecode.AIR.packWord, `Aiur.Bytecode.AIR.adviceOfSize, + `Aiur.Bytecode.AIR.unaryByte, `Aiur.Bytecode.AIR.binaryByte, + `Aiur.Bytecode.AIR.pairValues, `Aiur.Bytecode.AIR.readWord, + `Aiur.Bytecode.AIR.Step.primitive, `Aiur.Bytecode.AIR.Step.call, + `Aiur.Bytecode.AIR.Step.store, `Aiur.Bytecode.AIR.Step.load, + `Aiur.Bytecode.AIR.RunOps.nil, `Aiur.Bytecode.AIR.RunOps.cons, + `Aiur.Bytecode.AIR.SelectArm.case, `Aiur.Bytecode.AIR.SelectArm.fallback, + `Aiur.Bytecode.AIR.RunBlock.block, + `Aiur.Bytecode.AIR.RunCtrl.returned, `Aiur.Bytecode.AIR.RunCtrl.yielded, + `Aiur.Bytecode.AIR.RunCtrl.match, `Aiur.Bytecode.AIR.RunCtrl.matchContinueReturn, + `Aiur.Bytecode.AIR.RunCtrl.matchContinueYield, + `Aiur.Bytecode.AIR.RunFunction.function, `Aiur.Bytecode.AIR.Execution.function, + `Aiur.AIR.FunctionRow.mk, `Aiur.AIR.FunctionRow.Valid.mk, + `Aiur.AIR.FunctionRow.requests, `Aiur.AIR.FunctionRow.byteQueries, + `Aiur.AIR.functionProviders, `Aiur.AIR.functionQueries, `Aiur.AIR.functionByteQueries, + `Aiur.AIR.MemoryRow.mk, `Aiur.AIR.memoryActivityTransition, + `Aiur.AIR.memoryPointerTransition, `Aiur.AIR.MemoryRowsValid.mk, + `Aiur.AIR.memoryFacts, `Aiur.AIR.memoryProviders, `Aiur.AIR.memoryPointerCycle, + `Aiur.GoldilocksProof.squareMod, `Aiur.AIR.booleanConstraint, + `Aiur.AIR.oneSubBooleanConstraint, `Aiur.AIR.selectorSum, + `Aiur.AIR.MemoryRowsPolynomials.mk, + `Aiur.AIR.inverse256, `Aiur.AIR.pack4, `Aiur.AIR.pack4Nat, + `Aiur.AIR.carryStep, `Aiur.AIR.u32Carries, + `Aiur.AIR.Byte1Kind.all, `Aiur.AIR.Byte1Kind.channel, `Aiur.AIR.Byte1Kind.result, + `Aiur.AIR.byte1Outputs, `Aiur.AIR.byte1Request, `Aiur.AIR.byte1Providers, + `Aiur.AIR.Byte1Kind.op, + `Aiur.AIR.Byte2Kind.all, `Aiur.AIR.Byte2Kind.channel, `Aiur.AIR.Byte2Kind.result, + `Aiur.AIR.byte2Outputs, `Aiur.AIR.byte2Request, `Aiur.AIR.byte2Providers, + `Aiur.AIR.Byte2Kind.op, `Aiur.AIR.Byte2Kind.extendOutputs, + `Aiur.AIR.byte1Preprocessed, `Aiur.AIR.byte2Preprocessed, + `Aiur.AIR.padMessage, `Aiur.AIR.HasMessageShape, `Aiur.AIR.mapProviders, + `Aiur.AIR.PaddedLookupBalance, `Aiur.AIR.functionMessage, `Aiur.AIR.memoryMessage, + `Aiur.AIR.Byte1Kind.outputSize, `Aiur.AIR.Byte2Kind.outputSize, + `Aiur.AIR.lookupMessageWidth, `Aiur.AIR.FunctionMessageValid, + `Aiur.Bytecode.Ctrl.returnsHaveSize, `Aiur.Bytecode.Block.returnsHaveSize, + `Aiur.Bytecode.Op.lookupShape, `Aiur.Bytecode.Ctrl.lookupShapes, + `Aiur.Bytecode.Block.lookupShapes, `Aiur.Bytecode.Toplevel.validateLookupShapes, + `Aiur.Bytecode.Toplevel.validClaimShape, `Aiur.Bytecode.AIR.Call.LookupShape, + `Aiur.Bytecode.AIR.Outcome.ReturnSize, + `Aiur.AIR.LookupTables.mk, `Aiur.AIR.LookupTables.providers, + `Aiur.AIR.GlobalLookups.mk, `Aiur.AIR.rangeMessage, + `Aiur.lookupSlotSum, `Aiur.lookupQueryBoundAux, `Aiur.lookupQueryBound, + `Aiur.AIR.addMessages, `Aiur.AIR.scaleMessage, `Aiur.AIR.weightedMessage, + `Aiur.AIR.gateMessage, `Aiur.AIR.slotMessage, + `Aiur.AIR.SelectorFlow.mk, `Aiur.AIR.SelectorFlow.guard, + `Aiur.AIR.SelectorFlow.join, `Aiur.AIR.SelectorFlow.continue, + `Aiur.AIR.SelectorFlow.Satisfied, `Aiur.AIR.SelectorFlow.Sound.mk, + `Aiur.Bytecode.Ctrl.selectorFlow, `Aiur.Bytecode.Block.selectorFlow, + `Aiur.Bytecode.branchSelectorFlows, `Aiur.Bytecode.Ctrl.returnGates, + `Aiur.Bytecode.Block.returnGates, `Aiur.Bytecode.branchReturnGates, + `Aiur.AIR.RowValue.mk, `Aiur.AIR.RowValue.variable, `Aiur.AIR.RowValue.konst, + `Aiur.AIR.rowValues, `Aiur.AIR.RowValue.add, `Aiur.AIR.RowValue.sub, + `Aiur.AIR.RowValue.mul, `Aiur.AIR.rowAdvice, `Aiur.AIR.RowValue.pack, + `Aiur.AIR.readRowWord, `Aiur.AIR.OpEmission.mk, `Aiur.AIR.emitAdvice, + `Aiur.AIR.emitByte1, `Aiur.AIR.Byte2Kind.extendRowOutputs, `Aiur.AIR.emitByte2, + `Aiur.AIR.range4Queries, `Aiur.AIR.emitU32LessThan, `Aiur.AIR.emitU32Add, + `Aiur.AIR.emitOp, `Aiur.AIR.OpsEmission.mk, `Aiur.AIR.emitOps, + `Aiur.AIR.CallsEmitted, `Aiur.Bytecode.MatchPolynomials.mk, + `Aiur.AIR.RowContext.mk, `Aiur.AIR.QueryPart.mk, `Aiur.AIR.queryParts, + `Aiur.AIR.BlockEmission.mk, `Aiur.AIR.BlockEmission.prefix, + `Aiur.AIR.BlockEmission.afterOps, `Aiur.AIR.joinBlockEmissions, + `Aiur.AIR.mergeEquations, `Aiur.AIR.BlockEmission.continued, + `Aiur.Bytecode.Ctrl.emitRow, `Aiur.Bytecode.Block.emitRow, + `Aiur.AIR.SelectorFlow.unguard, `Aiur.AIR.EmissionProjection.mk, + `Aiur.Bytecode.caseRow, `Aiur.Bytecode.defaultRow, `Aiur.Bytecode.branchRows, + `Aiur.Bytecode.continueRow, `Aiur.AIR.BlockEmission.QueriesIn, + `Aiur.AIR.BlockEmission.CallsAt, `Aiur.AIR.BlockEmission.TerminalAt, + `Aiur.AIR.EmissionIncluded.mk, `Aiur.Bytecode.Ctrl.rowBounds, + `Aiur.Bytecode.Block.rowBounds, `Aiur.AIR.BlockEmission.HasQuery, + `Aiur.AIR.BlockEmission.TracksCalls, `Aiur.AIR.RowInputs, + `Aiur.AIR.InputPreservation.mk, `Aiur.Bytecode.Function.emitRow, + `Aiur.AIR.gateCount, `Aiur.AIR.queryCount, `Aiur.AIR.QuerySlots.mk, + `Aiur.AIR.activeQuerySlot, `Aiur.AIR.querySlotParts, `Aiur.AIR.querySlotMultiplicity, + `Aiur.AIR.decodedQuery, `Aiur.AIR.encodedQuery, `Aiur.AIR.decodedQueries, + `Aiur.AIR.encodedQueries, `Aiur.AIR.blockQueryPool, + `Aiur.AIR.MemberEmission.mk, `Aiur.AIR.MemberEmission.selector, `Aiur.AIR.MemberEmission.entry, + `Aiur.AIR.emitMember, `Aiur.AIR.emitMembers, `Aiur.AIR.CircuitEmission.mk, + `Aiur.AIR.circuitRankBytes, `Aiur.AIR.circuitEmission, `Aiur.AIR.CircuitEmission.lookup, + `Aiur.Bytecode.Circuit.emitRow, `Aiur.AIR.MemberEmission.FromProgram.mk, + `Aiur.AIR.CircuitEmission.QueriesIn, `Aiur.AIR.circuitQueryPool, + `Aiur.Bytecode.FunctionLayout.width, + `Aiur.Bytecode.ControlCounts.mk, `Aiur.Bytecode.ControlCounts.sum, + `Aiur.Bytecode.ControlCounts.branch, `Aiur.Bytecode.ControlCounts.continue, + `Aiur.Bytecode.Ctrl.controlCounts, `Aiur.Bytecode.Block.controlCounts, + `Aiur.Bytecode.branchControlCounts, `Aiur.Bytecode.Circuit.validateRowCounts, + `Aiur.Bytecode.Toplevel.validateRowCounts, `Aiur.Bytecode.ControlCounts.Describes.mk, + `Aiur.BoundVerifier.build, + `Aiur.AIR.Provider.PaddedEq, `Aiur.AIR.CircuitEmission.provider, + `Aiur.AIR.AuxiliaryTables.mk, `Aiur.AIR.AuxiliaryTables.withFunctions, + `Aiur.AIR.AuxiliaryTables.providers, `Aiur.AIR.AuxiliaryTables.circuitProviders, + `Aiur.AIR.circuitProviders, `Aiur.AIR.FunctionRow.Provides, + `Aiur.AIR.FunctionRow.inactive, `Aiur.AIR.FunctionRow.QueriesIn, + `Aiur.AIR.CircuitWitness.mk, `Aiur.AIR.CircuitWitness.Emitted, + `Aiur.AIR.CircuitWitness.Satisfied, `Aiur.AIR.CircuitWitness.Shapes, + `Aiur.AIR.CircuitWitness.LookupBounds, + `Aiur.Bytecode.Function.hasTerminalControl, `Aiur.Bytecode.circuitBranchless, + `Aiur.AIR.unitQuerySelectors, `Aiur.AIR.QueryWriters, + `Aiur.AIR.encodedCircuitQueryPool, + `Aiur.AIR.CircuitTraces.nil, `Aiur.AIR.CircuitTraces.inactive, `Aiur.AIR.CircuitTraces.active, + `Aiur.AIR.CircuitTraces.bitmap, `Aiur.AIR.CircuitTraces.degrees, `Aiur.AIR.CircuitTraces.capacity, + `Aiur.AIR.emitCircuitWitness, `Aiur.AIR.CircuitTraces.emitWitnesses, + `Aiur.Bytecode.Toplevel.singletonCircuits, + `Aiur.Bytecode.MembersConstrained, `Aiur.Bytecode.CircuitsConstrained, + `Aiur.Bytecode.Op.lookupUsage, + `Aiur.Bytecode.Ctrl.lookupUsage, + `Aiur.Bytecode.Block.lookupUsage, + `Aiur.Bytecode.branchLookupUsage, + `Aiur.Bytecode.Function.LookupLayout, + `Aiur.Bytecode.FunctionsLookupLayout, + `Aiur.Bytecode.MembersLookupBound, + `Aiur.Bytecode.CircuitsLookupBound] + +private def constants (info : Lean.ConstantInfo) : Array Lean.Name := + info.type.getUsedConstants ++ match info with + | .thmInfo value => value.value.getUsedConstants + | .defnInfo value => value.value.getUsedConstants + | .opaqueInfo value => value.value.getUsedConstants + | .inductInfo value => value.ctors.toArray + | _ => #[] + +private partial def closure (env : Lean.Environment) (runtime : Bool) (pending : List Lean.Name) + (seen : NameSet := {}) : NameSet := + match pending with + | [] => seen + | name :: rest => + if seen.contains name then closure env runtime rest seen + else match env.checked.get.find? name with + | none => closure env runtime rest (seen.insert name) + | some info => + let extras := if runtime then Id.run do + let mut names := #[] + let worker := Lean.Compiler.mkUnsafeRecName name + if (env.checked.get.find? worker).isSome then names := names.push worker + if let some other := Lean.Compiler.getImplementedBy? env name then + names := names.push other + if let some other := (Lean.Compiler.CSimp.ext.getState env).map.find? name then + names := names.push other.toDeclName + return names + else #[] + closure env runtime ((constants info ++ extras).toList ++ rest) (seen.insert name) + +private def projectConstant (env : Lean.Environment) (name : Lean.Name) : Bool := + match env.getModuleIdxFor? name with + | none => false + | some idx => (`Ix).isPrefixOf env.allImportedModuleNames[idx.toNat]! + +private def sortedNames (names : Array Name) : Array Name := names.qsort Name.lt + +/-- Read checked types, bodies and constructors; imported cached axiom +summaries can omit constructor dependencies. -/ +private def checkAxioms (env : Environment) (root : Name) (expected : Array Name) : + CommandElabM (Array Name) := do + let reachable := closure env false [root] + let mut actual := #[] + for name in reachable do + let some info := env.checked.get.find? name + | throwError "C8 component has an unavailable checked dependency: {name}" + if info.isAxiom then actual := actual.push name + let sorted := sortedNames actual + unless sorted == sortedNames expected do + throwError "C8 axiom boundary changed for {root}: expected {sortedNames expected}, actual {sorted}" + return sorted + +-- Constructor closure and exact-set failure paths are part of the audit. +private inductive ConstructorAuditFixture where + | plain + | withProof (proof : propext (Iff.refl True) = rfl) + +run_cmd do + let _ ← checkAxioms (← getEnv) ``ConstructorAuditFixture.plain #[``propext] + let _ ← checkAxioms (← getEnv) ``Eq.refl #[] + +/-- error: C8 axiom boundary changed for Eq.refl: expected [propext], actual [] -/ +#guard_msgs in +run_cmd do + let _ ← checkAxioms (← getEnv) ``Eq.refl #[``propext] + +/-- error: C8 axiom boundary changed for propext: expected [], actual [propext] -/ +#guard_msgs in +run_cmd do + let _ ← checkAxioms (← getEnv) ``propext #[] + +end Aiur.Proofs.Audit + +open Aiur.Proofs.Audit in +run_cmd do + let env ← getEnv + for root in roots do + let some info := env.checked.get.find? root | throwError "C8 component audit: missing root {root}" + let expected := if (roots.extract 0 6).contains root || + #[`Aiur.G.n_ofNat, `Aiur.G.n_add, `Aiur.G.n_mul, `Aiur.G.zero_add, + `Aiur.AIR.suppliedWeight_nonzero_provider, `Aiur.AIR.inverse256_correct, + `Aiur.AIR.byte1Request_shape, `Aiur.AIR.byte2Request_shape, + `Aiur.AIR.functionMessage_injective, `Aiur.AIR.memoryMessage_injective, + `Aiur.AIR.decodedQueries_length, + `Aiur.AIR.encodedQueries_length, + `Aiur.AIR.slotMessage_member_length, + `Aiur.AIR.suppliedWeight_padded_congr, + `Aiur.AIR.PaddedLookupBalance.congr_providers, + `Aiur.AIR.PaddedLookupBalance.congr_queries].contains root + then #[``propext] + else if callOrderRoots.contains root || lookupRoots.contains root || + executionRoots.contains root || memoryRoots.contains root || + #[`Aiur.AIR.selectorSum_characteristic_cancel, `Aiur.AIR.active_case, + `Aiur.AIR.active_default, `Aiur.AIR.byte_add_carry, `Aiur.AIR.byte_sub_borrow, + `Aiur.AIR.byte_carry_relation, `Aiur.AIR.pack4_n, + `Aiur.AIR.exactLookupBalance_byte1, `Aiur.AIR.exactLookupBalance_byte2, + `Aiur.AIR.exactLookupBalance_byte1_step, `Aiur.AIR.exactLookupBalance_byte2_step, + `Aiur.AIR.padMessage_injective_of_shape, `Aiur.AIR.ExactLookupBalance.filter, + `Aiur.AIR.paddedLookupBalance_provider, `Aiur.AIR.padMessage_append_zero, + `Aiur.AIR.functionMessage_rank_alias, + `Aiur.AIR.GlobalLookups.byte1, `Aiur.AIR.GlobalLookups.byte2, + `Aiur.AIR.GlobalLookups.byte1_step, `Aiur.AIR.GlobalLookups.byte2_step, + `Aiur.AIR.GlobalLookups.rank_bytes, `Aiur.BoundVerifier.claim_padding, + `Aiur.lookupQueryBound_sound, `Aiur.lookupQueryBound_consumer_count, + `Aiur.AIR.CircuitTraces.slot_sum_append, `Aiur.AIR.CircuitTraces.capacity_bounded, + `Aiur.AIR.encodedCircuitQueryPool_uniform_bound, + `Aiur.lookupQueryBound_shape, `Aiur.lookupQueryBound_complete, + `Aiur.lookupSlotSum_bounded, `Aiur.lookupQueryBound_encodedKey, + `Aiur.AIR.GlobalLookups.of_budget, + `Aiur.AIR.emitOp_calls, `Aiur.AIR.emitOps_calls, + `Aiur.AIR.emitOp_lookupUsage, `Aiur.AIR.emitOps_lookupUsage, + `Aiur.AIR.AuxiliaryTables.global_of_circuit_balance, + `Aiur.AIR.FunctionRow.inactive_valid, + `Aiur.AIR.CallsEmitted.ordered, `Aiur.AIR.active_array_equality, + `Aiur.AIR.QuerySlots.active_singleton].contains root + then #[``propext, ``Quot.sound] + else #[``propext, ``Classical.choice, ``Quot.sound] + let axioms ← checkAxioms env root expected + liftTermElabM do logInfo m!"ROOT {root}\n{← Meta.ppExpr info.type}\nAXIOMS {axioms}" + for name in premises do + let some info := env.checked.get.find? name | throwError "C8 component audit: missing premise {name}" + liftTermElabM do + logInfo m!"PREMISE {name}\n{← Meta.ppExpr info.type}" + if let .defnInfo value := info then logInfo m!"DEFINITION\n{← Meta.ppExpr value.value}" + let logical := closure env false roots.toList + -- Also follow compiler workers and replacements transitively. They need + -- not occur in the logical body, especially for partial opaque functions. + let reachable := (closure env true roots.toList).toList.mergeSort (fun a b => a.toString < b.toString) + let mut workers : Array Lean.Name := #[] + let mut partials : Array Lean.Name := #[] + let mut externs : Array Lean.Name := #[] + let mut replacements : Array (Lean.Name × Lean.Name) := #[] + let mut runtime : Array Lean.Name := #[] + for name in reachable do + unless (env.checked.get.find? name).isSome do + throwError "C8 component has an unavailable checked runtime dependency: {name}" + if projectConstant env name then + if let some parent := Lean.Compiler.isUnsafeRecName? name then + match env.checked.get.find? parent with + | some (.defnInfo original) => + unless original.safety == .safe do + throwError "C8 recursion worker source is not safe: {name}" + | some (.opaqueInfo original) => + if original.isUnsafe then throwError "C8 recursion worker source is unsafe: {name}" + partials := partials.push parent + | _ => throwError "C8 recursion worker has no source definition: {name}" + workers := workers.push name + if Lean.isExtern env name then externs := externs.push name + if let some other := Lean.Compiler.getImplementedBy? env name then + replacements := replacements.push (name, other) + if let some other := (Lean.Compiler.CSimp.ext.getState env).map.find? name then + replacements := replacements.push (name, other.toDeclName) + if let some (.defnInfo definition) := env.checked.get.find? name then + unless definition.safety == .safe || (Lean.Compiler.isUnsafeRecName? name).isSome do + runtime := runtime.push name + if let some (.opaqueInfo definition) := env.checked.get.find? name then + if definition.isUnsafe then runtime := runtime.push name + if Lean.Elab.ComputedFields.computedFieldAttr.hasTag env name then + throwError "C8 component has an unreviewed computed field: {name}" + unless externs == #[`Aiur.AiurSystem.build, `Aiur.AiurSystem.verify, + `Aiur.AiurSystem.vkBytes, `Aiur.Proof.ofBytesChecked] do + throwError "C8 component runtime extern inventory changed: {externs}" + unless replacements.isEmpty do throwError "C8 component runtime replacements changed: {replacements}" + unless runtime.isEmpty do throwError "C8 component has an unreviewed unsafe runtime: {runtime}" + unless partials == #[`Aiur.instHashableTyp.hash, + `Aiur.instReprPattern.repr, `Aiur.instReprTyp.repr] do + throwError "C8 component partial opaque inventory changed: {partials}" + if reachable.contains `Aiur.functionGroupsDisabledImpl then + throwError "C8 selected program must not depend on the environment grouping override" + for name in workers.qsort Name.lt do + let some (.defnInfo value) := env.checked.get.find? name + | throwError "C8 recursion worker is missing: {name}" + liftTermElabM do + logInfo m!"RECURSION WORKER {name}\n{← Meta.ppExpr value.type}\nIMPLEMENTATION\n{← Meta.ppExpr value.value}" + logInfo m!"C8 component ROOTS {roots.size}; LOGICAL DECLARATIONS {logical.size}; WITH RUNTIME {reachable.length}" + logInfo m!"IX RUNTIME EXTERNS {externs}\nPARTIAL OPAQUE SOURCES {partials}\nOTHER UNSAFE RUNTIME {runtime}\nRECURSION WORKERS {workers.size}" + logInfo "Runtime diagnostics cover Ix modules, including private constants. Lean/Std runtime primitives remain an external execution boundary. Partial opaque implementations are inventoried, not proved to refine their logical defaults." + logInfo "The runtime inventory and theorem premises are frozen separately. These roots do not establish full compiler/AIR reflection or public certified claim semantics." diff --git a/Ix/Aiur/Proofs/BlockQueryPool.lean b/Ix/Aiur/Proofs/BlockQueryPool.lean new file mode 100644 index 000000000..6d7e3a8eb --- /dev/null +++ b/Ix/Aiur/Proofs/BlockQueryPool.lean @@ -0,0 +1,71 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.QuerySlotMessages + +/-! +Function-row validity using the query pool computed from valued block +emissions. Slot exclusivity supplies active raw-query membership, removing +that separate premise from the function-row theorem. Exact global lookup +balance, count/layout validity and native verifier reflection remain open. +-/ + +namespace Aiur.AIR + +def blockQueryPool (emissions : List BlockEmission) : List (List G) := + emissions.flatMap fun emission => decodedQueries emission.queries emission.lookup + +theorem QuerySlots.queried_pool {gate : G} {start : Nat} {emission : BlockEmission} + (slots : QuerySlots gate start emission.lookup emission.queries) + {emissions : List BlockEmission} (member : emission ∈ emissions) : + emission.QueriesIn (blockQueryPool emissions) := by + intro query present active + exact List.mem_flatMap.mpr ⟨emission, member, slots.decoded_member present active⟩ + +end Aiur.AIR + +namespace Aiur.Bytecode +open Aiur.AIR + +theorem Block.emitRow_queried_pool (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (incoming : G) (values : Array RowValue) (column lookup : Nat) (block : Block) + (bounds : block.rowBounds selector) {emission : BlockEmission} + (emitted : block.emitRow row selector context incoming values column lookup = some emission) + (linked : incoming = (block.selectorFlow selector).entry) + (satisfied : ∀ equation ∈ emission.equations, equation = 0) + {emissions : List BlockEmission} (member : emission ∈ emissions) : + emission.QueriesIn (blockQueryPool emissions) := + (block.emitRow_equation_querySlots row selector context incoming values column lookup + bounds emitted linked satisfied).queried_pool member + +theorem Function.emitRow_pool_valid {tables : LookupTables} {width : Nat} + {emissions : List BlockEmission} (global : GlobalLookups tables width (blockQueryPool emissions)) + (memoryValid : ∀ size, MemoryRowsValid size (tables.memory size)) + (canonical : ∀ size ∈ tables.memoryWidths, size < gSize.toNat) + (program : Toplevel) (row : Nat → G) (selector : SelIdx → G) + (functionIndex : FunIdx) (rankBytes : Fin 6 → G) (values : Array RowValue) (column lookup : Nat) + (function : Function) (present : program.functions[functionIndex]? = some function) + (arity : values.size = function.layout.inputSize) + (shape : function.body.lookupShapes program none = true) (bounds : function.body.rowBounds selector) + {emission : BlockEmission} + (emitted : function.emitRow row selector functionIndex (packRank rankBytes) values column lookup = some emission) + (member : emission ∈ emissions) + (multiplicity : G) (nonzero : multiplicity ≠ 0) + (activity : activityConstraint multiplicity (function.body.selectorFlow selector).entry = 0) + (satisfied : ∀ equation ∈ emission.equations, equation = 0) : + ∃ interpreted : FunctionRow, interpreted.Valid program (memoryFacts tables.memory) ∧ + (1, interpreted.request) ∈ emission.returns ∧ + interpreted.request.function = functionIndex ∧ interpreted.request.inputs = rowValues values ∧ + interpreted.request.rank = packRank rankBytes ∧ interpreted.rankBytes = rankBytes ∧ + interpreted.selector = (function.body.selectorFlow selector).entry ∧ + interpreted.multiplicity = multiplicity ∧ emission.CallsAt interpreted.calls ∧ + CallsEmitted (packRank rankBytes) 1 emission.equations (blockQueryPool emissions) interpreted.calls := by + have bodyEmitted := emitted + rw [Function.emitRow] at bodyEmitted + have queried := function.body.emitRow_queried_pool row selector _ _ _ _ _ bounds bodyEmitted rfl satisfied member + exact function.emitRow_valid global memoryValid canonical program row selector functionIndex rankBytes + values column lookup present arity shape bounds emitted multiplicity nonzero activity satisfied queried + +end Aiur.Bytecode diff --git a/Ix/Aiur/Proofs/BlockQuerySlots.lean b/Ix/Aiur/Proofs/BlockQuerySlots.lean new file mode 100644 index 000000000..4d564bc11 --- /dev/null +++ b/Ix/Aiur/Proofs/BlockQuerySlots.lean @@ -0,0 +1,303 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.QuerySlots + +/-! +The valued block emitter respects lookup-slot intervals and has at most +one active query in each slot. Branch exclusivity follows from the emitted +selector equations; continuations resume after the maximum branch cursor. +An inactive parent also disables its continuation under the terminal bound. + +Only the selector equations and explicit syntax count bounds are needed. +Native expression/layout reflection remains separate. +-/ + +namespace Aiur.AIR + +theorem selectorSum_all_zero {gates : List G} (zero : ∀ gate ∈ gates, gate = 0) : + selectorSum gates = 0 := by + induction gates with + | nil => rfl + | cons gate gates ih => + rw [selectorSum_cons, zero gate List.mem_cons_self, G.zero_add] + exact ih (fun gate member => zero gate (List.mem_cons_of_mem _ member)) + +theorem SelectorFlow.Sound.yield_gateCount {flow : SelectorFlow} (sound : flow.Sound) + (bounded : flow.returns.length + flow.yields.length < gSize.toNat) + (boolean : booleanConstraint flow.entry = 0) : + gateCount (selectorSum flow.yields) ≤ gateCount flow.entry := by + rcases G.boolean_of_constraint boolean with inactive | active + · have zero := sound.inactive_terminal bounded inactive + have yieldsZero := selectorSum_all_zero (fun gate member => zero gate (List.mem_append_right _ member)) + rw [inactive, yieldsZero] + exact Nat.le_refl _ + · rw [active] + exact gateCount_le_one _ + +end Aiur.AIR + +namespace Aiur.Bytecode +open Aiur.AIR + +theorem branchSelectorFlows_case_satisfied {selector : SelIdx → G} + {branches : Array (G × Block)} {fallback : Option Block} + (valid : (SelectorFlow.join (branchSelectorFlows selector branches fallback)).Satisfied) + {pair : G × Block} (member : pair ∈ branches.toList) : + (pair.2.selectorFlow selector).Satisfied := + SelectorFlow.join_satisfied valid _ (List.mem_append_left _ (List.mem_map.mpr ⟨pair, member, rfl⟩)) + +theorem branchSelectorFlows_default_satisfied {selector : SelIdx → G} + {branches : Array (G × Block)} {fallback : Option Block} + (valid : (SelectorFlow.join (branchSelectorFlows selector branches fallback)).Satisfied) + {block : Block} (present : fallback = some block) : (block.selectorFlow selector).Satisfied := by + apply SelectorFlow.join_satisfied valid _ + apply List.mem_append_right + rw [present] + exact List.mem_cons_self + +theorem branchRows_querySlots (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (matched : G) (values : Array RowValue) (column lookup : Nat) + (branches : Array (G × Block)) (fallback : Option Block) {emission : BlockEmission} + (emitted : branchRows row selector context matched values column lookup branches fallback = some emission) + (valid : (SelectorFlow.join (branchSelectorFlows selector branches fallback)).Satisfied) + (bounded : branches.size + fallback.toList.length < gSize.toNat) + (boolean : booleanConstraint (SelectorFlow.join (branchSelectorFlows selector branches fallback)).entry = 0) + (caseSound : ∀ pair ∈ branches.toList, ∀ emission, + pair.2.emitRow row selector context (pair.2.selectorFlow selector).entry values column lookup = some emission → + QuerySlots (pair.2.selectorFlow selector).entry lookup emission.lookup emission.queries) + (defaultSound : ∀ block, fallback = some block → ∀ emission, + block.emitRow row selector context (block.selectorFlow selector).entry values + (column + branches.size) lookup = some emission → + QuerySlots (block.selectorFlow selector).entry lookup emission.lookup emission.queries) : + QuerySlots (SelectorFlow.join (branchSelectorFlows selector branches fallback)).entry + lookup emission.lookup emission.queries := by + simp only [branchRows, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i cases casesEmitted + dsimp only at emitted + split at emitted + · cases emitted + · rename_i default defaultEmitted + have equal := Option.some.inj emitted + subst emission + have casesRelated : List.Forall₂ (fun block emission => + QuerySlots (block.selectorFlow selector).entry lookup emission.lookup emission.queries) + (branches.toList.map Prod.snd) cases := by + apply forall₂_map_left + apply mapM_forall₂ casesEmitted + intro pair member emission emitted + simp only [caseRow, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i body bodyEmitted + have equal := Option.some.inj emitted + subst emission + exact caseSound pair member body bodyEmitted + have defaultRelated : List.Forall₂ (fun block emission => + QuerySlots (block.selectorFlow selector).entry lookup emission.lookup emission.queries) + fallback.toList default := by + cases fallback with + | none => + have equal := Option.some.inj defaultEmitted + subst default + exact .nil + | some block => + simp only [defaultRow, bind, Option.bind] at defaultEmitted + split at defaultEmitted + · cases defaultEmitted + · rename_i body bodyEmitted + have equal := Option.some.inj defaultEmitted + subst default + exact .cons (defaultSound block rfl body bodyEmitted) .nil + have individual := branchSelectorFlows_boolean selector branches fallback valid + have count := selector_gateCount + (gates := (branchSelectorFlows selector branches fallback).map SelectorFlow.entry) + (fun gate member => by + obtain ⟨flow, flowMember, equal⟩ := List.mem_map.mp member + subst gate + exact individual flow flowMember) + (by simpa only [branchSelectorFlows, List.length_map, List.length_append, Array.length_toList] using bounded) + boolean + apply QuerySlots.join (fun block : Block => (block.selectorFlow selector).entry) + _ values column lookup (forall₂_append casesRelated defaultRelated) + apply Nat.le_of_eq + simpa only [SelectorFlow.join, branchSelectorFlows, List.map_append, List.map_map, Function.comp_def] using count + +private theorem block_query_smaller (block : Block) : sizeOf block.ctrl < sizeOf block := by + cases block + simp + omega + +private theorem block_query_pair_smaller (pair : G × Block) : sizeOf pair.2 < sizeOf pair := by + cases pair + simp + omega + +private theorem block_query_option_smaller {block : Block} {fallback : Option Block} + (present : fallback = some block) : sizeOf block < sizeOf fallback := by + rw [present] + simp + +mutual + +theorem Ctrl.emitRow_querySlots (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (incoming : G) (values : Array RowValue) (column lookup : Nat) (ctrl : Ctrl) + (bounds : ctrl.rowBounds selector) {emission : BlockEmission} + (emitted : ctrl.emitRow row selector context incoming values column lookup = some emission) + (linked : incoming = (ctrl.selectorFlow selector).entry) + (valid : (ctrl.selectorFlow selector).Satisfied) : + QuerySlots incoming lookup emission.lookup emission.queries := by + cases ctrlEq : ctrl with + | «return» index indices => + rw [ctrlEq] at bounds emitted linked valid + rw [Ctrl.emitRow.eq_def] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · dsimp only at emitted + split at emitted + · cases emitted + · have equal := Option.some.inj emitted + subst emission + exact QuerySlots.empty incoming lookup + | yield index indices => + rw [ctrlEq] at bounds emitted linked valid + rw [Ctrl.emitRow.eq_def] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · have equal := Option.some.inj emitted + subst emission + exact QuerySlots.empty incoming lookup + | «match» index branches fallback => + rw [ctrlEq] at bounds emitted linked valid + have boolean := (Ctrl.match index branches fallback).selectorFlow_boolean selector valid + rw [Ctrl.emitRow_match] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i matched read + rw [Ctrl.rowBounds.eq_def] at bounds + obtain ⟨branchBound, casesBounded, fallbackBounded⟩ := bounds + rw [Ctrl.selectorFlow_match] at valid boolean linked + have joinedValid := SelectorFlow.guard_satisfied valid + rw [linked] + apply branchRows_querySlots row selector context matched.value values column lookup branches fallback + emitted joinedValid branchBound boolean + · intro pair member body bodyEmitted + exact Block.emitRow_querySlots row selector context _ values column lookup pair.2 + (casesBounded pair member) bodyEmitted rfl (branchSelectorFlows_case_satisfied joinedValid member) + · intro block present body bodyEmitted + have bounded : block.rowBounds selector := by rw [present] at fallbackBounded; exact fallbackBounded + exact Block.emitRow_querySlots row selector context _ values _ lookup block bounded bodyEmitted rfl + (branchSelectorFlows_default_satisfied joinedValid present) + | matchContinue index branches fallback size aux slots continuation => + rw [ctrlEq] at bounds emitted linked valid + have boolean := (Ctrl.matchContinue index branches fallback size aux slots continuation).selectorFlow_boolean selector valid + rw [Ctrl.emitRow_matchContinue] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i matched read + dsimp only at emitted + split at emitted + · cases emitted + · rename_i joined branchesEmitted + simp only [continueRow] at emitted + split at emitted + · simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i continued contEmitted + have equal := Option.some.inj emitted + subst emission + rw [Ctrl.rowBounds.eq_def] at bounds + obtain ⟨branchBound, terminalBound, casesBounded, fallbackBounded, contBounded⟩ := bounds + rw [Ctrl.selectorFlow_matchContinue] at valid boolean linked + obtain ⟨joinedValid, contValid, link⟩ := + SelectorFlow.continue_satisfied (SelectorFlow.guard_satisfied valid) + have joinedSlots := branchRows_querySlots row selector context matched.value values column lookup + branches fallback branchesEmitted joinedValid branchBound boolean + (fun pair member body bodyEmitted => + Block.emitRow_querySlots row selector context _ values column lookup pair.2 + (casesBounded pair member) bodyEmitted rfl (branchSelectorFlows_case_satisfied joinedValid member)) + (fun block present body bodyEmitted => + Block.emitRow_querySlots row selector context _ values _ lookup block + (by rw [present] at fallbackBounded; exact fallbackBounded) bodyEmitted rfl + (branchSelectorFlows_default_satisfied joinedValid present)) + have projected := branchRows_selector_projection row selector context matched.value values column lookup + branches fallback branchesEmitted + have contLinked : selectorSum (joined.yields.map Prod.fst) = + (continuation.selectorFlow selector).entry := by + rw [projected.yielded] + exact link.symm + have continuedSlots := Block.emitRow_querySlots row selector context _ _ _ _ continuation + contBounded contEmitted contLinked contValid + have joinedSound := branchSelectorFlows_sound selector branches fallback joinedValid + (fun pair _ valid => pair.2.selectorFlow_sound selector valid) + (fun block _ valid => block.selectorFlow_sound selector valid) + have countBound := joinedSound.yield_gateCount terminalBound boolean + rw [← projected.yielded] at countBound + rw [linked] + exact joinedSlots.append (continuedSlots.weaken countBound) + · cases emitted +termination_by sizeOf ctrl +decreasing_by + all_goals + try rw [ctrlEq] + first + | (have bound := Array.sizeOf_lt_of_mem (Array.mem_def.mpr member) + have pairBound := block_query_pair_smaller pair + first | simp only [Ctrl.match.sizeOf_spec] | simp only [Ctrl.matchContinue.sizeOf_spec] + omega) + | (have optionBound := block_query_option_smaller present + first | simp only [Ctrl.match.sizeOf_spec] | simp only [Ctrl.matchContinue.sizeOf_spec] + omega) + | (simp only [Ctrl.matchContinue.sizeOf_spec]; omega) + +theorem Block.emitRow_querySlots (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (incoming : G) (values : Array RowValue) (column lookup : Nat) (block : Block) + (bounds : block.rowBounds selector) {emission : BlockEmission} + (emitted : block.emitRow row selector context incoming values column lookup = some emission) + (linked : incoming = (block.selectorFlow selector).entry) + (valid : (block.selectorFlow selector).Satisfied) : + QuerySlots incoming lookup emission.lookup emission.queries := by + rw [Block.rowBounds] at bounds + have boolean : booleanConstraint incoming = 0 := by + rw [linked] + exact block.selectorFlow_boolean selector valid + rw [Block.selectorFlow] at linked valid + rw [Block.emitRow] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i operations opsEmitted + dsimp only at emitted + split at emitted + · cases emitted + · rename_i control ctrlEmitted + have controlSlots := Ctrl.emitRow_querySlots row selector context incoming _ _ _ block.ctrl + bounds ctrlEmitted linked valid + have equal := Option.some.inj emitted + subst emission + exact (QuerySlots.indexed incoming lookup operations.queries boolean).append controlSlots +termination_by sizeOf block +decreasing_by exact block_query_smaller block + +end + +theorem Block.emitRow_equation_querySlots (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (incoming : G) (values : Array RowValue) (column lookup : Nat) (block : Block) + (bounds : block.rowBounds selector) {emission : BlockEmission} + (emitted : block.emitRow row selector context incoming values column lookup = some emission) + (linked : incoming = (block.selectorFlow selector).entry) + (satisfied : ∀ equation ∈ emission.equations, equation = 0) : + QuerySlots incoming lookup emission.lookup emission.queries := + block.emitRow_querySlots row selector context incoming values column lookup bounds emitted linked + (block.emitRow_selectors row selector context incoming values column lookup emitted satisfied) + +end Aiur.Bytecode diff --git a/Ix/Aiur/Proofs/BlockRowCalls.lean b/Ix/Aiur/Proofs/BlockRowCalls.lean new file mode 100644 index 000000000..7d6d81932 --- /dev/null +++ b/Ix/Aiur/Proofs/BlockRowCalls.lean @@ -0,0 +1,272 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.BlockRowExecution + +/-! +Every call recorded by the valued block emitter retains its own gate, +function query, rank-byte queries and call-order equation through branching +and continuations. Tracking holds for arbitrary assignments; an active +execution then inherits the inventory required by the rank argument. +-/ + +namespace Aiur.AIR +open Bytecode + +def BlockEmission.HasQuery (emission : BlockEmission) (selector : G) (message : List G) : Prop := + ∃ part ∈ emission.queries, part.selector = selector ∧ part.message = message + +def BlockEmission.TracksCalls (rank : G) (emission : BlockEmission) : Prop := + ∀ part ∈ emission.calls, + emission.HasQuery part.1 (functionMessage part.2.1) ∧ + (∀ message ∈ (rankByteQueries part.2.2).map rangeMessage, emission.HasQuery part.1 message) ∧ + part.1 * callOrderConstraint rank part.2.1.rank (packRank part.2.2) ∈ emission.equations + +theorem BlockEmission.HasQuery.mono {first last : BlockEmission} + (included : first.queries ⊆ last.queries) {selector : G} {message : List G} + (queried : first.HasQuery selector message) : last.HasQuery selector message := by + obtain ⟨part, member, gate, equal⟩ := queried + exact ⟨part, included member, gate, equal⟩ + +theorem BlockEmission.HasQuery.active {emission : BlockEmission} {queries : List (List G)} + (queried : emission.QueriesIn queries) {message : List G} (present : emission.HasQuery 1 message) : + message ∈ queries := by + obtain ⟨part, member, gate, equal⟩ := present + rw [← equal] + exact queried part member gate + +theorem BlockEmission.TracksCalls.prefix {rank : G} {emission : BlockEmission} + (tracked : emission.TracksCalls rank) (equations : List G) : + (emission.prefix equations).TracksCalls rank := by + intro part member + obtain ⟨query, bytes, equation⟩ := tracked part member + exact ⟨query, bytes, List.mem_append_right _ equation⟩ + +theorem BlockEmission.TracksCalls.afterOps {rank incoming : G} {lookup : Nat} + {operations : OpsEmission} {control : BlockEmission} + (opsTracked : CallsEmitted rank incoming operations.equations operations.queries operations.calls) + (ctrlTracked : control.TracksCalls rank) : + (control.afterOps incoming lookup operations).TracksCalls rank := by + intro part member + rcases List.mem_append.mp member with first | last + · obtain ⟨edge, edgeMember, equal⟩ := List.mem_map.mp first + subst part + obtain ⟨query, bytes, equation⟩ := opsTracked edge edgeMember + have memberQuery : ∀ message ∈ operations.queries, + (control.afterOps incoming lookup operations).HasQuery incoming message := by + intro message member + obtain ⟨query, queryMember, gate, equal⟩ := queryParts_member lookup incoming member + exact ⟨query, List.mem_append_left _ queryMember, gate, equal⟩ + exact ⟨memberQuery _ query, fun message member => memberQuery message (bytes member), + List.mem_append_left _ equation⟩ + · obtain ⟨query, bytes, equation⟩ := ctrlTracked part last + exact ⟨query.mono (fun _ member => List.mem_append_right _ member), + fun message member => (bytes message member).mono (fun _ member => List.mem_append_right _ member), + List.mem_append_right _ equation⟩ + +theorem BlockEmission.TracksCalls.join (rank : G) (values : Array RowValue) (column lookup : Nat) + (emissions : List BlockEmission) (tracked : ∀ emission ∈ emissions, emission.TracksCalls rank) : + (joinBlockEmissions values column lookup emissions).TracksCalls rank := by + intro part member + obtain ⟨emission, emissionMember, partMember⟩ := List.mem_flatMap.mp member + obtain ⟨query, bytes, equation⟩ := tracked emission emissionMember part partMember + have included := EmissionIncluded.join values column lookup emissionMember + exact ⟨query.mono included.queries, fun message member => (bytes message member).mono included.queries, + included.equations equation⟩ + +theorem BlockEmission.TracksCalls.continued {rank : G} {branches continuation : BlockEmission} + (first : branches.TracksCalls rank) (last : continuation.TracksCalls rank) (equations : List G) : + (branches.continued equations continuation).TracksCalls rank := by + intro part member + rcases List.mem_append.mp member with left | right + · obtain ⟨query, bytes, equation⟩ := first part left + exact ⟨query.mono (fun _ member => List.mem_append_left _ member), + fun message member => (bytes message member).mono (fun _ member => List.mem_append_left _ member), + List.mem_append_left _ (List.mem_append_left _ equation)⟩ + · obtain ⟨query, bytes, equation⟩ := last part right + exact ⟨query.mono (fun _ member => List.mem_append_right _ member), + fun message member => (bytes message member).mono (fun _ member => List.mem_append_right _ member), + List.mem_append_right _ equation⟩ + +theorem BlockEmission.TracksCalls.active {rank : G} {emission : BlockEmission} + (tracked : emission.TracksCalls rank) + {queries : List (List G)} (queried : emission.QueriesIn queries) + {calls : List (Bytecode.AIR.Call × (Fin 6 → G))} (called : emission.CallsAt calls) : + CallsEmitted rank 1 emission.equations queries calls := by + intro edge member + obtain ⟨query, bytes, equation⟩ := tracked (1, edge) (called edge member) + exact ⟨query.active queried, fun _ member => (bytes _ member).active queried, equation⟩ + +theorem forall₂_right_property {α β : Type} {source : List α} {emissions : List β} {property : β → Prop} + (related : List.Forall₂ (fun _ emission => property emission) source emissions) : + ∀ emission ∈ emissions, property emission := by + induction related with + | nil => simp + | cons first _ ih => + intro emission member + rcases List.mem_cons.mp member with equal | tail + · subst emission; exact first + · exact ih emission tail + +end Aiur.AIR + +namespace Aiur.Bytecode +open Aiur.AIR + +theorem branchRows_tracks_calls (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (matched : G) (values : Array RowValue) (column lookup : Nat) + (branches : Array (G × Block)) (fallback : Option Block) {emission : BlockEmission} + (emitted : branchRows row selector context matched values column lookup branches fallback = some emission) + (caseSound : ∀ pair ∈ branches.toList, ∀ emission, + pair.2.emitRow row selector context (pair.2.selectorFlow selector).entry values column lookup = some emission → + emission.TracksCalls context.rank) + (defaultSound : ∀ block, fallback = some block → ∀ emission, + block.emitRow row selector context (block.selectorFlow selector).entry values + (column + branches.size) lookup = some emission → emission.TracksCalls context.rank) : + emission.TracksCalls context.rank := by + simp only [branchRows, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i cases casesEmitted + dsimp only at emitted + split at emitted + · cases emitted + · rename_i default defaultEmitted + have equal := Option.some.inj emitted + subst emission + have casesTracked : ∀ emission ∈ cases, emission.TracksCalls context.rank := by + apply forall₂_right_property + apply mapM_forall₂ casesEmitted + intro pair member result resultEmitted + simp only [caseRow, bind, Option.bind] at resultEmitted + split at resultEmitted + · cases resultEmitted + · rename_i body bodyEmitted + have equal := Option.some.inj resultEmitted + subst result + exact (caseSound pair member body bodyEmitted).prefix _ + have defaultTracked : ∀ emission ∈ default, emission.TracksCalls context.rank := by + cases fallback with + | none => + simp only [defaultRow, Option.some.injEq] at defaultEmitted + subst default + simp + | some block => + simp only [defaultRow, bind, Option.bind] at defaultEmitted + split at defaultEmitted + · cases defaultEmitted + · rename_i body bodyEmitted + have equal := Option.some.inj defaultEmitted + subst default + intro emission member + have equal := List.mem_singleton.mp member + subst emission + exact (defaultSound block rfl body bodyEmitted).prefix _ + apply BlockEmission.TracksCalls.join + intro emission member + rcases List.mem_append.mp member with left | right + · exact casesTracked emission left + · exact defaultTracked emission right + +private theorem block_call_smaller (block : Block) : sizeOf block.ctrl < sizeOf block := by + cases block + simp + omega + +mutual + +theorem Ctrl.emitRow_tracks_calls (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (incoming : G) (values : Array RowValue) (column lookup : Nat) (ctrl : Ctrl) + {emission : BlockEmission} + (emitted : ctrl.emitRow row selector context incoming values column lookup = some emission) : + emission.TracksCalls context.rank := by + cases ctrl with + | «return» index indices => + rw [Ctrl.emitRow.eq_def] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · dsimp only at emitted + split at emitted + · cases emitted + · have equal := Option.some.inj emitted + subst emission + simp [BlockEmission.TracksCalls] + | yield index indices => + rw [Ctrl.emitRow.eq_def] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · have equal := Option.some.inj emitted + subst emission + simp [BlockEmission.TracksCalls] + | «match» index branches fallback => + rw [Ctrl.emitRow_match] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i matched read + apply branchRows_tracks_calls row selector context matched.value values column lookup branches fallback emitted + · intro pair member body bodyEmitted + exact Block.emitRow_tracks_calls row selector context _ values column lookup pair.2 bodyEmitted + · intro block present body bodyEmitted + exact Block.emitRow_tracks_calls row selector context _ values _ lookup block bodyEmitted + | matchContinue index branches fallback size aux slots continuation => + rw [Ctrl.emitRow_matchContinue] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i matched read + dsimp only at emitted + split at emitted + · cases emitted + · rename_i joined branchesEmitted + have branchesTracked := branchRows_tracks_calls row selector context matched.value values column lookup + branches fallback branchesEmitted + (fun pair member body bodyEmitted => + Block.emitRow_tracks_calls row selector context _ values column lookup pair.2 bodyEmitted) + (fun block present body bodyEmitted => + Block.emitRow_tracks_calls row selector context _ values _ lookup block bodyEmitted) + simp only [continueRow] at emitted + split at emitted + · simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i continued contEmitted + have contTracked := Block.emitRow_tracks_calls row selector context _ _ _ _ continuation contEmitted + have equal := Option.some.inj emitted + subst emission + exact branchesTracked.continued contTracked _ + · cases emitted +termination_by sizeOf ctrl +decreasing_by + all_goals first + | decreasing_tactic + | (have := Array.sizeOf_lt_of_mem (Array.mem_def.mpr ‹_ ∈ _›); grind) + +theorem Block.emitRow_tracks_calls (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (incoming : G) (values : Array RowValue) (column lookup : Nat) (block : Block) + {emission : BlockEmission} + (emitted : block.emitRow row selector context incoming values column lookup = some emission) : + emission.TracksCalls context.rank := by + rw [Block.emitRow] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i operations opsEmitted + dsimp only at emitted + split at emitted + · cases emitted + · rename_i control ctrlEmitted + have tracked := Ctrl.emitRow_tracks_calls row selector context incoming _ _ _ block.ctrl ctrlEmitted + have equal := Option.some.inj emitted + subst emission + exact (BlockEmission.TracksCalls.afterOps (emitOps_calls opsEmitted) tracked).prefix _ +termination_by sizeOf block +decreasing_by exact block_call_smaller block + +end + +end Aiur.Bytecode diff --git a/Ix/Aiur/Proofs/BlockRowExecution.lean b/Ix/Aiur/Proofs/BlockRowExecution.lean new file mode 100644 index 000000000..9cd3c81ab --- /dev/null +++ b/Ix/Aiur/Proofs/BlockRowExecution.lean @@ -0,0 +1,666 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.BlockRowProjection + +/-! +Execution extraction from the valued block emitter, covering operations, +case and default selection, early returns, and continuation merges. The +proof follows the actual emitted equations and logical value map. + +Active raw queries must belong to the global lookup pool, and the explicit +branch and terminal counts must fit the field characteristic. Deriving +these premises from shared slots and validated native layouts is separate. +-/ + +namespace Aiur.AIR +open Bytecode + +theorem selector_pair_split {α : Type} {parts : List (G × α)} + (individual : ∀ part ∈ parts, booleanConstraint part.1 = 0) + (bounded : parts.length < gSize.toNat) + (active : selectorSum (parts.map Prod.fst) = 1) : + ∃ before chosen after, parts = before ++ chosen :: after ∧ chosen.1 = 1 ∧ + ∀ part ∈ before ++ after, part.1 = 0 := by + obtain ⟨before, after, split, zero⟩ := selectorSum_active_split + (fun value member => by + obtain ⟨part, partMember, equal⟩ := List.mem_map.mp member + subst value + exact individual part partMember) + (by simpa only [List.length_map] using bounded) active + obtain ⟨first, rest, partsEq, firstEq, restEq⟩ := List.map_eq_append_iff.mp split + obtain ⟨chosen, last, tailEq, activeChosen, lastEq⟩ := List.map_eq_cons_iff.mp restEq + refine ⟨first, chosen, last, by rw [partsEq, tailEq], activeChosen, ?_⟩ + intro part member + apply zero part.1 + rcases List.mem_append.mp member with firstMember | lastMember + · apply List.mem_append_left + rw [← firstEq] + exact List.mem_map.mpr ⟨part, firstMember, rfl⟩ + · apply List.mem_append_right + rw [← lastEq] + exact List.mem_map.mpr ⟨part, lastMember, rfl⟩ + +theorem selector_pair_chosen {α : Type} {parts : List (G × α)} + (individual : ∀ part ∈ parts, booleanConstraint part.1 = 0) + (bounded : parts.length < gSize.toNat) + (active : selectorSum (parts.map Prod.fst) = 1) + {chosen : G × α} (member : chosen ∈ parts) (selected : chosen.1 = 1) : + ∃ before after, parts = before ++ chosen :: after ∧ + ∀ part ∈ before ++ after, part.1 = 0 := by + obtain ⟨before, other, after, equal, _, zero⟩ := selector_pair_split individual bounded active + rw [equal] at member + rcases List.mem_append.mp member with left | tail + · have inactive := zero chosen (List.mem_append_left _ left) + exact False.elim (G.one_ne_zero (selected.symm.trans inactive)) + · rcases List.mem_cons.mp tail with same | right + · subst chosen + exact ⟨before, after, equal, zero⟩ + · have inactive := zero chosen (List.mem_append_right _ right) + exact False.elim (G.one_ne_zero (selected.symm.trans inactive)) + +theorem selector_weighted_zero {α : Type} (read : α → G) {parts : List (G × α)} + (zero : ∀ part ∈ parts, part.1 = 0) : + selectorSum (parts.map fun part => part.1 * read part.2) = 0 := by + induction parts with + | nil => rfl + | cons part parts ih => + rw [List.map_cons, selectorSum_cons, zero part List.mem_cons_self, + G.mul_comm 0, G.mul_zero, G.zero_add] + exact ih (fun part member => zero part (List.mem_cons_of_mem _ member)) + +theorem selector_weighted_chosen {α : Type} (read : α → G) {parts : List (G × α)} + (individual : ∀ part ∈ parts, booleanConstraint part.1 = 0) + (bounded : parts.length < gSize.toNat) + (active : selectorSum (parts.map Prod.fst) = 1) + {chosen : G × α} (member : chosen ∈ parts) (selected : chosen.1 = 1) : + selectorSum (parts.map fun part => part.1 * read part.2) = read chosen.2 := by + obtain ⟨before, after, equal, zero⟩ := selector_pair_chosen individual bounded active member selected + rw [equal, List.map_append, selectorSum_append, + selector_weighted_zero read (fun part member => zero part (List.mem_append_left _ member)), + G.zero_add, List.map_cons, selectorSum_cons, + selector_weighted_zero read (fun part member => zero part (List.mem_append_right _ member)), + G.add_zero, selected, G.mul_comm, G.mul_one] + +theorem mergeEquations_chosen (row : Nat → G) {parent : G} {column size : Nat} + {parts : List (G × Array RowValue)} (parentActive : parent = 1) + (individual : ∀ part ∈ parts, booleanConstraint part.1 = 0) + (bounded : parts.length < gSize.toNat) + (active : selectorSum (parts.map Prod.fst) = 1) + {chosen : Array RowValue} (member : (1, chosen) ∈ parts) (width : chosen.size = size) + (equations : ∀ equation ∈ mergeEquations row parent column size parts, equation = 0) : + rowValues (rowAdvice row column size) = rowValues chosen := by + apply Array.ext (by + rw [rowValues_advice_size] + simpa only [rowValues, Array.size_map] using width.symm) + intro index leftBound rightBound + have bound : index < size := by simpa only [rowValues_advice_size] using leftBound + have polynomial := equations _ (List.mem_map.mpr ⟨index, List.mem_range.mpr bound, rfl⟩) + change parent * (row (column + index) - selectorSum + (parts.map fun part => part.1 * (rowValues part.2)[index]?.getD 0)) = 0 at polynomial + rw [selector_weighted_chosen (fun values => (rowValues values)[index]?.getD 0) + individual bounded active member rfl] at polynomial + have equal := active_case parentActive polynomial + rw [Array.getElem?_eq_getElem rightBound, Option.getD_some] at equal + simpa only [rowValues, rowAdvice, Array.getElem_map, Array.getElem_ofFn, + RowValue.variable, Fin.getElem_fin] using equal + +def BlockEmission.QueriesIn (emission : BlockEmission) (queries : List (List G)) : Prop := + ∀ part ∈ emission.queries, part.selector = 1 → part.message ∈ queries + +def BlockEmission.CallsAt (emission : BlockEmission) + (calls : List (Bytecode.AIR.Call × (Fin 6 → G))) : Prop := + ∀ edge ∈ calls, (1, edge) ∈ emission.calls + +def BlockEmission.TerminalAt (emission : BlockEmission) : Bytecode.AIR.Outcome → Prop + | .returned outputs => ∃ request, (1, request) ∈ emission.returns ∧ request.outputs = outputs + | .yielded outputs => ∃ yielded, (1, yielded) ∈ emission.yields ∧ rowValues yielded = outputs + +structure EmissionIncluded (part whole : BlockEmission) : Prop where + equations : part.equations ⊆ whole.equations + queries : part.queries ⊆ whole.queries + returns : part.returns ⊆ whole.returns + yields : part.yields ⊆ whole.yields + calls : part.calls ⊆ whole.calls + +theorem EmissionIncluded.refl (emission : BlockEmission) : EmissionIncluded emission emission := + ⟨List.Subset.refl _, List.Subset.refl _, List.Subset.refl _, List.Subset.refl _, List.Subset.refl _⟩ + +theorem EmissionIncluded.trans {first middle last : BlockEmission} + (left : EmissionIncluded first middle) (right : EmissionIncluded middle last) : + EmissionIncluded first last := + ⟨left.equations.trans right.equations, left.queries.trans right.queries, + left.returns.trans right.returns, left.yields.trans right.yields, left.calls.trans right.calls⟩ + +theorem EmissionIncluded.prefix (emission : BlockEmission) (equations : List G) : + EmissionIncluded emission (emission.prefix equations) := + ⟨fun _ member => List.mem_append_right _ member, List.Subset.refl _, + List.Subset.refl _, List.Subset.refl _, List.Subset.refl _⟩ + +theorem EmissionIncluded.join (values : Array RowValue) (column lookup : Nat) + {emissions : List BlockEmission} {emission : BlockEmission} (member : emission ∈ emissions) : + EmissionIncluded emission (joinBlockEmissions values column lookup emissions) := by + constructor <;> exact fun _ present => List.mem_flatMap.mpr ⟨emission, member, present⟩ + +theorem EmissionIncluded.satisfied {part whole : BlockEmission} (included : EmissionIncluded part whole) + (satisfied : ∀ equation ∈ whole.equations, equation = 0) : + ∀ equation ∈ part.equations, equation = 0 := + fun equation member => satisfied equation (included.equations member) + +theorem EmissionIncluded.queried {part whole : BlockEmission} (included : EmissionIncluded part whole) + {queries : List (List G)} (queried : whole.QueriesIn queries) : part.QueriesIn queries := + fun query member active => queried query (included.queries member) active + +theorem EmissionIncluded.terminal {part whole : BlockEmission} (included : EmissionIncluded part whole) + {outcome : Bytecode.AIR.Outcome} (terminal : part.TerminalAt outcome) : whole.TerminalAt outcome := by + cases outcome with + | returned outputs => + obtain ⟨request, member, equal⟩ := terminal + exact ⟨request, included.returns member, equal⟩ + | yielded outputs => + obtain ⟨values, member, equal⟩ := terminal + exact ⟨values, included.yields member, equal⟩ + +theorem EmissionIncluded.called {part whole : BlockEmission} (included : EmissionIncluded part whole) + {calls : List (Bytecode.AIR.Call × (Fin 6 → G))} (called : part.CallsAt calls) : whole.CallsAt calls := + fun edge member => included.calls (called edge member) + +theorem forall₂_left_member {α β : Type} {relation : α → β → Prop} {source : List α} + {emissions : List β} (related : List.Forall₂ relation source emissions) {item : α} + (member : item ∈ source) : ∃ emission ∈ emissions, relation item emission := by + induction related with + | nil => cases member + | @cons head emission heads emissions first rest ih => + rcases List.mem_cons.mp member with equal | tail + · subst item + exact ⟨emission, List.mem_cons_self, first⟩ + · obtain ⟨body, bodyMember, correct⟩ := ih tail + exact ⟨body, List.mem_cons_of_mem _ bodyMember, correct⟩ + +theorem mapM_member {α β : Type} {source : List α} {emissions : List β} {emit : α → Option β} + (emitted : source.mapM emit = some emissions) {item : α} (member : item ∈ source) : + ∃ emission ∈ emissions, emit item = some emission := + forall₂_left_member (mapM_forall₂ emitted (fun _ _ _ equal => equal)) member + +theorem mapM_of_forall₂ {α β : Type} {source : List α} {emissions : List β} {emit : α → Option β} + (related : List.Forall₂ (fun item emission => emit item = some emission) source emissions) : + source.mapM emit = some emissions := by + induction related with + | nil => rfl + | cons first _ ih => rw [List.mapM_cons, first, ih]; rfl + +theorem readRowValues (values : Array RowValue) (indices : Array ValIdx) (outputs : List RowValue) + (read : indices.toList.mapM (fun index => values[index]?) = some outputs) : + Bytecode.AIR.readValues (rowValues values) indices = some (rowValues outputs.toArray) := by + have related := mapM_forall₂ read (fun _ _ _ equal => equal) + have mapped : List.Forall₂ (fun index value => (rowValues values)[index]? = some value) + indices.toList (outputs.map RowValue.value) := by + generalize sourceEq : indices.toList = source at related ⊢ + clear read sourceEq + induction related with + | nil => exact .nil + | cons first _ ih => exact .cons (rowValues_read first) ih + have result := mapM_of_forall₂ mapped + have listResult : (Array.toList <$> Bytecode.AIR.readValues (rowValues values) indices) = + some (rowValues outputs.toArray).toList := by + rw [Bytecode.AIR.readValues, Array.toList_mapM] + simpa only [rowValues, Array.toList_map, List.toList_toArray] using result + cases emitted : Bytecode.AIR.readValues (rowValues values) indices with + | none => rw [emitted] at listResult; cases listResult + | some array => + rw [emitted] at listResult + have equal := Array.toList_inj.mp (Option.some.inj listResult) + exact congrArg some equal + +theorem queryParts_member (slot : Nat) (selector : G) {queries : List (List G)} {message : List G} + (member : message ∈ queries) : + ∃ part ∈ queryParts slot selector queries, part.selector = selector ∧ part.message = message := by + obtain ⟨index, bound, equal⟩ := List.mem_iff_getElem.mp member + refine ⟨⟨slot + index, selector, message⟩, ?_, rfl, rfl⟩ + exact List.mem_mapIdx.mpr ⟨index, bound, by rw [equal]⟩ + +theorem EmissionIncluded.afterOps (incoming : G) (lookup : Nat) (operations : OpsEmission) + (control : BlockEmission) : EmissionIncluded control (control.afterOps incoming lookup operations) := + ⟨fun _ member => List.mem_append_right _ member, + fun _ member => List.mem_append_right _ member, List.Subset.refl _, List.Subset.refl _, + fun _ member => List.mem_append_right _ member⟩ + +theorem BlockEmission.afterOps_queried {incoming : G} {lookup : Nat} {operations : OpsEmission} + {control : BlockEmission} {queries : List (List G)} (active : incoming = 1) + (queried : (control.afterOps incoming lookup operations).QueriesIn queries) : + operations.queries ⊆ queries := by + intro message member + obtain ⟨part, partMember, gate, equal⟩ := queryParts_member lookup incoming member + rw [← equal] + exact queried part (List.mem_append_left _ partMember) (gate.trans active) + +theorem BlockEmission.afterOps_called {incoming : G} {lookup : Nat} {operations : OpsEmission} + {control : BlockEmission} {calls : List (Bytecode.AIR.Call × (Fin 6 → G))} + (active : incoming = 1) (called : control.CallsAt calls) : + (control.afterOps incoming lookup operations).CallsAt (operations.calls ++ calls) := by + intro edge member + rcases List.mem_append.mp member with first | rest + · exact List.mem_append_left _ (List.mem_map.mpr ⟨edge, first, by rw [active]⟩) + · exact List.mem_append_right _ (called edge rest) + +theorem EmissionIncluded.continued (branches : BlockEmission) (equations : List G) + (continuation : BlockEmission) : EmissionIncluded continuation (branches.continued equations continuation) := + ⟨fun _ member => List.mem_append_right _ member, + fun _ member => List.mem_append_right _ member, + fun _ member => List.mem_append_right _ member, List.Subset.refl _, + fun _ member => List.mem_append_right _ member⟩ + +end Aiur.AIR + +namespace Aiur.Bytecode +open Aiur.AIR + +private theorem row_bounds_smaller (block : Block) : sizeOf block.ctrl < sizeOf block := by + cases block + simp + omega + +mutual + +def Ctrl.rowBounds (selector : SelIdx → G) : Ctrl → Prop + | .return .. | .yield .. => True + | .match _ branches fallback => + branches.size + fallback.toList.length < gSize.toNat ∧ + (∀ pair ∈ branches.toList, pair.2.rowBounds selector) ∧ + (match fallback with | none => True | some block => block.rowBounds selector) + | .matchContinue _ branches fallback _ _ _ continuation => + let flow := SelectorFlow.join (branchSelectorFlows selector branches fallback) + branches.size + fallback.toList.length < gSize.toNat ∧ + flow.returns.length + flow.yields.length < gSize.toNat ∧ + (∀ pair ∈ branches.toList, pair.2.rowBounds selector) ∧ + (match fallback with | none => True | some block => block.rowBounds selector) ∧ + continuation.rowBounds selector +termination_by ctrl => sizeOf ctrl +decreasing_by + all_goals first + | decreasing_tactic + | (have := Array.sizeOf_lt_of_mem (Array.mem_def.mpr ‹_ ∈ _›); grind) + +def Block.rowBounds (selector : SelIdx → G) (block : Block) : Prop := + block.ctrl.rowBounds selector +termination_by sizeOf block +decreasing_by exact row_bounds_smaller block + +end + +theorem AIR.SelectArm.rowBounds {selector : SelIdx → G} {matched : G} + {branches : Array (G × Block)} {fallback : Option Block} {block : Block} + (selected : SelectArm matched branches fallback block) + (casesBounded : ∀ pair ∈ branches.toList, pair.2.rowBounds selector) + (fallbackBounded : ∀ block, fallback = some block → block.rowBounds selector) : + block.rowBounds selector := by + cases selected with + | case member => exact casesBounded _ member + | fallback present unmatched => exact fallbackBounded block present + +theorem AIR.SelectArm.smaller_match {matched : G} {branches : Array (G × Block)} + {fallback : Option Block} {block : Block} (selected : SelectArm matched branches fallback block) + (index : ValIdx) : sizeOf block < sizeOf (Ctrl.match index branches fallback) := by + cases selected with + | case member => + have bound := Array.sizeOf_lt_of_mem (Array.mem_def.mpr member) + simp only [Prod.mk.sizeOf_spec, Ctrl.match.sizeOf_spec] at * + omega + | fallback present unmatched => rw [present]; simp; omega + +theorem AIR.SelectArm.smaller_matchContinue {matched : G} {branches : Array (G × Block)} + {fallback : Option Block} {block : Block} (selected : SelectArm matched branches fallback block) + (index : ValIdx) (size aux slots : Nat) (continuation : Block) : + sizeOf block < sizeOf (Ctrl.matchContinue index branches fallback size aux slots continuation) := by + cases selected with + | case member => + have bound := Array.sizeOf_lt_of_mem (Array.mem_def.mpr member) + simp only [Prod.mk.sizeOf_spec, Ctrl.matchContinue.sizeOf_spec] at * + omega + | fallback present unmatched => rw [present]; simp; omega + +theorem branchRows_polynomials (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (matched : G) (values : Array RowValue) (column lookup : Nat) + (branches : Array (G × Block)) (fallback : Option Block) {emission : BlockEmission} + (emitted : branchRows row selector context matched values column lookup branches fallback = some emission) + (satisfied : ∀ equation ∈ emission.equations, equation = 0) : + MatchPolynomials selector matched branches fallback := by + simp only [branchRows, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i cases casesEmitted + dsimp only at emitted + split at emitted + · cases emitted + · rename_i default defaultEmitted + have equal := Option.some.inj emitted + subst emission + constructor + · intro pair member + obtain ⟨result, resultMember, resultEmitted⟩ := mapM_member casesEmitted member + simp only [caseRow, bind, Option.bind] at resultEmitted + split at resultEmitted + · cases resultEmitted + · rename_i body bodyEmitted + have equal := Option.some.inj resultEmitted + subst result + exact satisfied _ ((EmissionIncluded.join values column lookup + (List.mem_append_left _ resultMember)).equations List.mem_cons_self) + · intro block present pair member + rw [present] at defaultEmitted + simp only [defaultRow, bind, Option.bind] at defaultEmitted + split at defaultEmitted + · cases defaultEmitted + · rename_i body bodyEmitted + have equal := Option.some.inj defaultEmitted + subst default + obtain ⟨index, bound, selected⟩ := List.mem_iff_getElem.mp member + refine ⟨row (column + index), ?_⟩ + apply satisfied + apply (EmissionIncluded.join values column lookup + (List.mem_append_right cases List.mem_cons_self)).equations + apply List.mem_append_left + exact List.mem_mapIdx.mpr ⟨index, bound, by rw [selected]⟩ + +theorem branchRows_body (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (matched : G) (values : Array RowValue) (column lookup : Nat) + (branches : Array (G × Block)) (fallback : Option Block) {emission : BlockEmission} + (emitted : branchRows row selector context matched values column lookup branches fallback = some emission) + {block : Block} (selected : AIR.SelectArm matched branches fallback block) : + ∃ bodyColumn body, + block.emitRow row selector context (block.selectorFlow selector).entry values bodyColumn lookup = some body ∧ + EmissionIncluded body emission := by + simp only [branchRows, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i cases casesEmitted + dsimp only at emitted + split at emitted + · cases emitted + · rename_i default defaultEmitted + have equal := Option.some.inj emitted + subst emission + cases selected with + | case member => + obtain ⟨result, resultMember, resultEmitted⟩ := mapM_member casesEmitted member + simp only [caseRow, bind, Option.bind] at resultEmitted + split at resultEmitted + · cases resultEmitted + · rename_i body bodyEmitted + have equal := Option.some.inj resultEmitted + subst result + exact ⟨column, body, bodyEmitted, + (EmissionIncluded.prefix body _).trans + (EmissionIncluded.join values column lookup (List.mem_append_left _ resultMember))⟩ + | fallback present unmatched => + rw [present] at defaultEmitted + simp only [defaultRow, bind, Option.bind] at defaultEmitted + split at defaultEmitted + · cases defaultEmitted + · rename_i body bodyEmitted + have equal := Option.some.inj defaultEmitted + subst default + exact ⟨column + branches.size, body, bodyEmitted, + (EmissionIncluded.prefix body _).trans + (EmissionIncluded.join values column lookup + (List.mem_append_right _ List.mem_cons_self))⟩ + +theorem branchRows_selector_projection (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (matched : G) (values : Array RowValue) (column lookup : Nat) + (branches : Array (G × Block)) (fallback : Option Block) {emission : BlockEmission} + (emitted : branchRows row selector context matched values column lookup branches fallback = some emission) : + EmissionProjection (SelectorFlow.join (branchSelectorFlows selector branches fallback)) + (branchReturnGates selector branches fallback) emission := + branchRows_projection row selector context matched values column lookup branches fallback emitted + (fun pair _ _ bodyEmitted => pair.2.emitRow_projection row selector context _ _ _ _ bodyEmitted) + (fun block _ _ bodyEmitted => block.emitRow_projection row selector context _ _ _ _ bodyEmitted) + +theorem branchRows_selected (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (matched : G) (values : Array RowValue) (column lookup : Nat) + (branches : Array (G × Block)) (fallback : Option Block) {emission : BlockEmission} + (emitted : branchRows row selector context matched values column lookup branches fallback = some emission) + (satisfied : ∀ equation ∈ emission.equations, equation = 0) + (bounded : branches.size + fallback.toList.length < gSize.toNat) + (active : (SelectorFlow.join (branchSelectorFlows selector branches fallback)).entry = 1) : + ∃ block bodyColumn body, AIR.SelectArm matched branches fallback block ∧ + (block.selectorFlow selector).entry = 1 ∧ + block.emitRow row selector context (block.selectorFlow selector).entry values bodyColumn lookup = some body ∧ + EmissionIncluded body emission := by + have projected := branchRows_selector_projection row selector context matched values column lookup + branches fallback emitted + have polynomials := branchRows_polynomials row selector context matched values column lookup + branches fallback emitted satisfied + obtain ⟨block, selected, _, blockActive⟩ := polynomials.active_branch + (fun equation member => satisfied equation (projected.equations member)) bounded active + obtain ⟨bodyColumn, body, bodyEmitted, included⟩ := branchRows_body row selector context matched values + column lookup branches fallback emitted selected + exact ⟨block, bodyColumn, body, selected, blockActive, bodyEmitted, included⟩ + +mutual + +theorem Ctrl.emitRow_run {tables : LookupTables} {width : Nat} {queries : List (List G)} + (global : GlobalLookups tables width queries) + (memoryValid : ∀ size, MemoryRowsValid size (tables.memory size)) + (canonical : ∀ size ∈ tables.memoryWidths, size < gSize.toNat) + (program : Toplevel) (yieldSize : Option Nat) + (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (incoming : G) (values : Array RowValue) (column lookup : Nat) (ctrl : Ctrl) + (shape : ctrl.lookupShapes program yieldSize = true) (bounds : ctrl.rowBounds selector) + {emission : BlockEmission} + (emitted : ctrl.emitRow row selector context incoming values column lookup = some emission) + (active : incoming = 1) (linked : incoming = (ctrl.selectorFlow selector).entry) + (satisfied : ∀ equation ∈ emission.equations, equation = 0) (queried : emission.QueriesIn queries) : + ∃ outcome calls, + AIR.RunCtrl (memoryFacts tables.memory) ctrl (rowValues values) outcome (calls.map Prod.fst) ∧ + emission.TerminalAt outcome ∧ emission.CallsAt calls := by + cases ctrl with + | «return» index indices => + rw [Ctrl.emitRow.eq_def] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i inputs readInputs + dsimp only at emitted + split at emitted + · cases emitted + · rename_i outputs readOutputs + have equal := Option.some.inj emitted + subst emission + refine ⟨.returned outputs, [], AIR.RunCtrl.returned readOutputs, ?_, by simp [BlockEmission.CallsAt]⟩ + refine ⟨⟨context.function, inputs, outputs, context.rank⟩, ?_, rfl⟩ + change (1, _) ∈ [(incoming, _)] + rw [active] + exact List.mem_cons_self + | yield index indices => + rw [Ctrl.emitRow.eq_def] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i outputs readOutputs + have equal := Option.some.inj emitted + subst emission + rw [Ctrl.selectorFlow.eq_def] at linked + have selected : selector index = 1 := linked.symm.trans active + refine ⟨.yielded (rowValues outputs.toArray), [], + AIR.RunCtrl.yielded (readRowValues values indices outputs readOutputs), ?_, + by simp [BlockEmission.CallsAt]⟩ + exact ⟨outputs.toArray, by change (1, _) ∈ [(selector index, _)]; rw [selected]; exact List.mem_cons_self, rfl⟩ + | «match» index branches fallback => + rw [Ctrl.emitRow_match] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i matched read + rw [Ctrl.rowBounds.eq_def] at bounds + obtain ⟨branchBound, casesBounded, fallbackBounded⟩ := bounds + obtain ⟨casesShape, fallbackShape⟩ := (lookupShapes_match _ _ _ _ _).mp shape + rw [Ctrl.selectorFlow_match] at linked + obtain ⟨arm, bodyColumn, body, selected, armActive, bodyEmitted, included⟩ := + branchRows_selected row selector context matched.value values column lookup branches fallback + emitted satisfied branchBound (linked.symm.trans active) + have smaller := selected.smaller_match index + obtain ⟨outcome, calls, execution, terminal, called⟩ := Block.emitRow_run global memoryValid canonical + program yieldSize row selector context _ values bodyColumn lookup arm + (selected.lookupShapes program yieldSize casesShape fallbackShape) + (selected.rowBounds casesBounded (fun block present => by + rw [present] at fallbackBounded; exact fallbackBounded)) bodyEmitted armActive rfl + (included.satisfied satisfied) (included.queried queried) + exact ⟨outcome, calls, AIR.RunCtrl.match (rowValues_read read) selected execution, + included.terminal terminal, included.called called⟩ + | matchContinue index branches fallback size aux slots continuation => + rw [Ctrl.emitRow_matchContinue] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i matched read + dsimp only at emitted + split at emitted + · cases emitted + · rename_i joined branchesEmitted + simp only [continueRow] at emitted + split at emitted + · rename_i sizes + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i continued contEmitted + have equal := Option.some.inj emitted + subst emission + rw [Ctrl.rowBounds.eq_def] at bounds + obtain ⟨branchBound, terminalBound, casesBounded, fallbackBounded, contBounded⟩ := bounds + obtain ⟨casesShape, fallbackShape, contShape⟩ := + (lookupShapes_matchContinue _ _ _ _ _ _ _ _ _).mp shape + rw [Ctrl.selectorFlow_matchContinue] at linked + have joinedActive : (SelectorFlow.join (branchSelectorFlows selector branches fallback)).entry = 1 := + linked.symm.trans active + have joinedSatisfied : ∀ equation ∈ joined.equations, equation = 0 := + fun equation member => satisfied equation + (List.mem_append_left _ (List.mem_append_left _ member)) + have joinedQueried : joined.QueriesIn queries := + fun part member gate => queried part (List.mem_append_left _ member) gate + obtain ⟨arm, bodyColumn, body, selected, armActive, bodyEmitted, included⟩ := + branchRows_selected row selector context matched.value values column lookup branches fallback + branchesEmitted joinedSatisfied branchBound joinedActive + have smaller := selected.smaller_matchContinue index size aux slots continuation + obtain ⟨outcome, calls, execution, terminal, called⟩ := Block.emitRow_run global memoryValid canonical + program (some size) row selector context _ values bodyColumn lookup arm + (selected.lookupShapes program (some size) casesShape fallbackShape) + (selected.rowBounds casesBounded (fun block present => by + rw [present] at fallbackBounded; exact fallbackBounded)) bodyEmitted armActive rfl + (included.satisfied joinedSatisfied) (included.queried joinedQueried) + have joinedTerminal := included.terminal terminal + have joinedCalls := included.called called + cases outcome with + | returned outputs => + refine ⟨.returned outputs, calls, + AIR.RunCtrl.matchContinueReturn (rowValues_read read) selected execution, ?_, ?_⟩ + · obtain ⟨request, member, equal⟩ := joinedTerminal + exact ⟨request, List.mem_append_left _ member, equal⟩ + · exact fun edge member => List.mem_append_left _ (joinedCalls edge member) + | yielded outputs => + obtain ⟨yielded, yieldMember, yieldEqual⟩ := joinedTerminal + have projected := branchRows_selector_projection row selector context matched.value values column lookup + branches fallback branchesEmitted + have flowValid : (SelectorFlow.join (branchSelectorFlows selector branches fallback)).Satisfied := + fun equation member => joinedSatisfied equation (projected.equations member) + have flowSound := branchSelectorFlows_sound selector branches fallback flowValid + (fun pair _ valid => pair.2.selectorFlow_sound selector valid) + (fun block _ valid => block.selectorFlow_sound selector valid) + have oneYield : (1 : G) ∈ (SelectorFlow.join (branchSelectorFlows selector branches fallback)).yields := by + rw [← projected.yielded] + exact List.mem_map.mpr ⟨(1, yielded), yieldMember, rfl⟩ + have gateOne : selectorSum (joined.yields.map Prod.fst) = 1 := by + rw [projected.yielded] + exact flowSound.yield_starts_continuation terminalBound joinedActive oneYield + have link : (continuation.selectorFlow selector).entry = selectorSum (joined.yields.map Prod.fst) := by + apply (G.sub_eq_zero_iff _ _).mp + apply satisfied + exact List.mem_append_left _ (List.mem_append_right _ + (List.mem_append_right _ List.mem_cons_self)) + have yieldWidth : yielded.size = size := + beq_iff_eq.mp ((List.all_eq_true.mp sizes) _ yieldMember) + have yieldBound : joined.yields.length < gSize.toNat := by + have lengths := congrArg List.length projected.yielded + simp only [List.length_map] at lengths + omega + have yieldBoolean : ∀ part ∈ joined.yields, booleanConstraint part.1 = 0 := by + intro part member + apply flowSound.yielded + rw [← projected.yielded] + exact List.mem_map.mpr ⟨part, member, rfl⟩ + have mergeValues := mergeEquations_chosen row active yieldBoolean yieldBound gateOne + yieldMember yieldWidth (fun equation member => satisfied equation + (List.mem_append_left _ (List.mem_append_right _ (List.mem_append_left _ member)))) + have contIncluded := EmissionIncluded.continued joined + (mergeEquations row incoming joined.column size joined.yields ++ + [(continuation.selectorFlow selector).entry - selectorSum (joined.yields.map Prod.fst)]) continued + obtain ⟨result, contCalls, contRun, contTerminal, contCallsAt⟩ := + Block.emitRow_run global memoryValid canonical program yieldSize row selector context _ _ _ _ + continuation contShape contBounded contEmitted gateOne link.symm + (contIncluded.satisfied satisfied) (contIncluded.queried queried) + rw [rowValues_append, mergeValues, yieldEqual] at contRun + have outputSize : outputs.size = size := by + rw [← yieldEqual] + simpa only [rowValues, Array.size_map] using yieldWidth + refine ⟨result, calls ++ contCalls, ?_, contIncluded.terminal contTerminal, ?_⟩ + · simpa only [List.map_append] using + AIR.RunCtrl.matchContinueYield (rowValues_read read) selected execution outputSize contRun + · intro edge member + rcases List.mem_append.mp member with first | last + · exact List.mem_append_left _ (joinedCalls edge first) + · exact List.mem_append_right _ (contCallsAt edge last) + · cases emitted +termination_by sizeOf ctrl +decreasing_by all_goals first | decreasing_tactic | omega + +theorem Block.emitRow_run {tables : LookupTables} {width : Nat} {queries : List (List G)} + (global : GlobalLookups tables width queries) + (memoryValid : ∀ size, MemoryRowsValid size (tables.memory size)) + (canonical : ∀ size ∈ tables.memoryWidths, size < gSize.toNat) + (program : Toplevel) (yieldSize : Option Nat) + (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (incoming : G) (values : Array RowValue) (column lookup : Nat) (block : Block) + (shape : block.lookupShapes program yieldSize = true) (bounds : block.rowBounds selector) + {emission : BlockEmission} + (emitted : block.emitRow row selector context incoming values column lookup = some emission) + (active : incoming = 1) (linked : incoming = (block.selectorFlow selector).entry) + (satisfied : ∀ equation ∈ emission.equations, equation = 0) (queried : emission.QueriesIn queries) : + ∃ outcome calls, + AIR.RunBlock (memoryFacts tables.memory) block (rowValues values) outcome (calls.map Prod.fst) ∧ + emission.TerminalAt outcome ∧ emission.CallsAt calls := by + rw [Block.emitRow] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i operations opsEmitted + dsimp only at emitted + split at emitted + · cases emitted + · rename_i control ctrlEmitted + have equal := Option.some.inj emitted + subst emission + have tailIncluded := EmissionIncluded.prefix (control.afterOps incoming lookup operations) + [oneSubBooleanConstraint (block.selectorFlow selector).entry] + have controlIncluded := (EmissionIncluded.afterOps incoming lookup operations control).trans tailIncluded + rw [Block.lookupShapes, Bool.and_eq_true] at shape + have opsRun := emitOps_run global memoryValid canonical + (fun op member => (Array.all_eq_true'.mp shape.1) op (Array.mem_def.mpr member)) + opsEmitted active + (fun equation member => (tailIncluded.satisfied satisfied) equation (List.mem_append_left _ member)) + (BlockEmission.afterOps_queried active (tailIncluded.queried queried)) + obtain ⟨outcome, calls, ctrlRun, terminal, called⟩ := Ctrl.emitRow_run global memoryValid canonical + program yieldSize row selector context incoming _ _ _ block.ctrl shape.2 + (by rwa [Block.rowBounds] at bounds) ctrlEmitted active + (by simpa only [Block.selectorFlow] using linked) + (controlIncluded.satisfied satisfied) (controlIncluded.queried queried) + refine ⟨outcome, operations.calls ++ calls, ?_, controlIncluded.terminal terminal, ?_⟩ + · simpa only [List.map_append] using AIR.RunBlock.block opsRun ctrlRun + · exact tailIncluded.called (BlockEmission.afterOps_called active called) +termination_by sizeOf block +decreasing_by exact row_bounds_smaller block + +end + +end Aiur.Bytecode diff --git a/Ix/Aiur/Proofs/BlockRowInputs.lean b/Ix/Aiur/Proofs/BlockRowInputs.lean new file mode 100644 index 000000000..22870e7e6 --- /dev/null +++ b/Ix/Aiur/Proofs/BlockRowInputs.lean @@ -0,0 +1,312 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.BlockRowCalls + +/-! +Input-prefix preservation through the valued block emitter. Operation +outputs and continuation merges append logical values, while branch joins +restore their incoming scope. Every emitted return therefore identifies +the original function, inputs and rank, including on inactive branches. +-/ + +namespace Aiur.AIR +open Bytecode + +theorem option_array_eq_of_toList {α : Type} {result : Option (Array α)} {expected : Array α} + (equal : (Array.toList <$> result) = some expected.toList) : result = some expected := by + cases result with + | none => cases equal + | some array => exact congrArg some (Array.toList_inj.mp (Option.some.inj equal)) + +theorem forall₂_imp {α β : Type} {source : List α} {target : List β} + {first last : α → β → Prop} (related : List.Forall₂ first source target) + (implies : ∀ left right, first left right → last left right) : + List.Forall₂ last source target := by + induction related with + | nil => exact .nil + | cons head _ ih => exact .cons (implies _ _ head) ih + +theorem forall₂_of_get {α β : Type} {source : List α} {target : List β} {relation : α → β → Prop} + (sizes : source.length = target.length) + (related : ∀ index (leftBound : index < source.length) (rightBound : index < target.length), + relation source[index] target[index]) : List.Forall₂ relation source target := by + induction source generalizing target with + | nil => + have empty : target = [] := List.eq_nil_of_length_eq_zero sizes.symm + subst target + exact .nil + | cons head tail ih => + cases target with + | nil => simp at sizes + | cons first rest => + refine .cons (related 0 (by simp) (by simp)) ?_ + apply ih (Nat.succ.inj sizes) + intro index leftBound rightBound + exact related (index + 1) (by simpa using leftBound) (by simpa using rightBound) + +theorem readValues_append {values extra : Array G} {indices : Array ValIdx} {outputs : Array G} + (read : Bytecode.AIR.readValues values indices = some outputs) : + Bytecode.AIR.readValues (values ++ extra) indices = some outputs := by + have listRead := congrArg (Functor.map Array.toList) read + rw [Bytecode.AIR.readValues, Array.toList_mapM] at listRead + have related := mapM_forall₂ listRead (fun _ _ _ equal => equal) + have lifted := forall₂_imp related (last := fun index value => (values ++ extra)[index]? = some value) + (fun index value present => by + have bound := (Array.getElem?_eq_some_iff.mp present).choose + rw [Array.getElem?_append_left bound] + exact present) + apply option_array_eq_of_toList + rw [Bytecode.AIR.readValues, Array.toList_mapM] + exact mapM_of_forall₂ lifted + +theorem readValues_range (values : Array G) : + Bytecode.AIR.readValues values (Array.range values.size) = some values := by + apply option_array_eq_of_toList + rw [Bytecode.AIR.readValues, Array.toList_mapM] + apply mapM_of_forall₂ + apply forall₂_of_get (by simp) + intro index leftBound rightBound + have bound : index < values.size := by simpa only [Array.length_toList] using rightBound + simpa only [Array.getElem_toList, Array.getElem_range] using Array.getElem?_eq_getElem bound + +def RowInputs (size : Nat) (inputs : Array G) (values : Array RowValue) : Prop := + Bytecode.AIR.readValues (rowValues values) (Array.range size) = some inputs + +theorem RowInputs.append {size : Nat} {inputs : Array G} {values extra : Array RowValue} + (preserved : RowInputs size inputs values) : RowInputs size inputs (values ++ extra) := by + unfold RowInputs at * + rw [rowValues_append] + exact readValues_append preserved + +theorem RowInputs.full (values : Array RowValue) : RowInputs values.size (rowValues values) values := by + have read := readValues_range (rowValues values) + simpa only [RowInputs, rowValues, Array.size_map] using read + +theorem emitOps_inputs {row : Nat → G} {selector rank : G} {ops : List Op} + {values : Array RowValue} {column : Nat} {emission : OpsEmission} + (emitted : emitOps row selector rank ops values column = some emission) + {size : Nat} {inputs : Array G} (preserved : RowInputs size inputs values) : + RowInputs size inputs emission.values := by + induction ops generalizing values column emission with + | nil => + simp only [emitOps, Option.some.injEq] at emitted + subst emission + exact preserved + | cons op ops ih => + simp only [emitOps, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i first firstEmitted + dsimp only at emitted + split at emitted + · cases emitted + · rename_i rest restEmitted + have equal := Option.some.inj emitted + subst emission + change RowInputs size inputs rest.values + exact ih restEmitted preserved.append + +structure InputPreservation (context : RowContext) (inputs : Array G) (emission : BlockEmission) : Prop where + values : RowInputs context.inputSize inputs emission.values + returned : ∀ part ∈ emission.returns, + part.2.function = context.function ∧ part.2.inputs = inputs ∧ part.2.rank = context.rank + +theorem InputPreservation.prefix {context : RowContext} {inputs : Array G} {emission : BlockEmission} + (preserved : InputPreservation context inputs emission) (equations : List G) : + InputPreservation context inputs (emission.prefix equations) := + ⟨preserved.values, preserved.returned⟩ + +theorem InputPreservation.afterOps {context : RowContext} {inputs : Array G} {control : BlockEmission} + (preserved : InputPreservation context inputs control) (incoming : G) (lookup : Nat) + (operations : OpsEmission) : InputPreservation context inputs (control.afterOps incoming lookup operations) := + ⟨preserved.values, preserved.returned⟩ + +theorem InputPreservation.join {context : RowContext} {inputs : Array G} {values : Array RowValue} + (initial : RowInputs context.inputSize inputs values) (column lookup : Nat) (emissions : List BlockEmission) + (preserved : ∀ emission ∈ emissions, InputPreservation context inputs emission) : + InputPreservation context inputs (joinBlockEmissions values column lookup emissions) := by + refine ⟨initial, ?_⟩ + intro part member + obtain ⟨emission, emissionMember, partMember⟩ := List.mem_flatMap.mp member + exact (preserved emission emissionMember).returned part partMember + +theorem InputPreservation.continued {context : RowContext} {inputs : Array G} + {branches continuation : BlockEmission} + (first : InputPreservation context inputs branches) (last : InputPreservation context inputs continuation) + (equations : List G) : InputPreservation context inputs (branches.continued equations continuation) := by + refine ⟨last.values, ?_⟩ + intro part member + rcases List.mem_append.mp member with left | right + · exact first.returned part left + · exact last.returned part right + +end Aiur.AIR + +namespace Aiur.Bytecode +open Aiur.AIR + +theorem branchRows_inputs (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (matched : G) (values : Array RowValue) (column lookup : Nat) + (branches : Array (G × Block)) (fallback : Option Block) {emission : BlockEmission} + {inputs : Array G} (initial : RowInputs context.inputSize inputs values) + (emitted : branchRows row selector context matched values column lookup branches fallback = some emission) + (caseSound : ∀ pair ∈ branches.toList, ∀ emission, + pair.2.emitRow row selector context (pair.2.selectorFlow selector).entry values column lookup = some emission → + InputPreservation context inputs emission) + (defaultSound : ∀ block, fallback = some block → ∀ emission, + block.emitRow row selector context (block.selectorFlow selector).entry values + (column + branches.size) lookup = some emission → InputPreservation context inputs emission) : + InputPreservation context inputs emission := by + simp only [branchRows, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i cases casesEmitted + dsimp only at emitted + split at emitted + · cases emitted + · rename_i default defaultEmitted + have equal := Option.some.inj emitted + subst emission + have casesPreserved : ∀ emission ∈ cases, InputPreservation context inputs emission := by + apply forall₂_right_property + apply mapM_forall₂ casesEmitted + intro pair member result resultEmitted + simp only [caseRow, bind, Option.bind] at resultEmitted + split at resultEmitted + · cases resultEmitted + · rename_i body bodyEmitted + have equal := Option.some.inj resultEmitted + subst result + exact (caseSound pair member body bodyEmitted).prefix _ + have defaultPreserved : ∀ emission ∈ default, InputPreservation context inputs emission := by + cases fallback with + | none => + simp only [defaultRow, Option.some.injEq] at defaultEmitted + subst default + simp + | some block => + simp only [defaultRow, bind, Option.bind] at defaultEmitted + split at defaultEmitted + · cases defaultEmitted + · rename_i body bodyEmitted + have equal := Option.some.inj defaultEmitted + subst default + intro emission member + have equal := List.mem_singleton.mp member + subst emission + exact (defaultSound block rfl body bodyEmitted).prefix _ + apply InputPreservation.join initial + intro emission member + rcases List.mem_append.mp member with left | right + · exact casesPreserved emission left + · exact defaultPreserved emission right + +private theorem block_input_smaller (block : Block) : sizeOf block.ctrl < sizeOf block := by + cases block + simp + omega + +mutual + +theorem Ctrl.emitRow_inputs (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (incoming : G) (values : Array RowValue) (column lookup : Nat) (ctrl : Ctrl) + {emission : BlockEmission} {inputs : Array G} (initial : RowInputs context.inputSize inputs values) + (emitted : ctrl.emitRow row selector context incoming values column lookup = some emission) : + InputPreservation context inputs emission := by + cases ctrl with + | «return» index indices => + rw [Ctrl.emitRow.eq_def] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i provided readInputs + dsimp only at emitted + split at emitted + · cases emitted + · have equal := Option.some.inj emitted + subst emission + refine ⟨initial, ?_⟩ + intro part member + have equal := List.mem_singleton.mp member + subst part + exact ⟨rfl, Option.some.inj (readInputs.symm.trans initial), rfl⟩ + | yield index indices => + rw [Ctrl.emitRow.eq_def] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · have equal := Option.some.inj emitted + subst emission + exact ⟨initial, by simp⟩ + | «match» index branches fallback => + rw [Ctrl.emitRow_match] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i matched read + apply branchRows_inputs row selector context matched.value values column lookup branches fallback initial emitted + · intro pair member body bodyEmitted + exact Block.emitRow_inputs row selector context _ values column lookup pair.2 initial bodyEmitted + · intro block present body bodyEmitted + exact Block.emitRow_inputs row selector context _ values _ lookup block initial bodyEmitted + | matchContinue index branches fallback size aux slots continuation => + rw [Ctrl.emitRow_matchContinue] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i matched read + dsimp only at emitted + split at emitted + · cases emitted + · rename_i joined branchesEmitted + have branchesPreserved := branchRows_inputs row selector context matched.value values column lookup + branches fallback initial branchesEmitted + (fun pair member body bodyEmitted => + Block.emitRow_inputs row selector context _ values column lookup pair.2 initial bodyEmitted) + (fun block present body bodyEmitted => + Block.emitRow_inputs row selector context _ values _ lookup block initial bodyEmitted) + simp only [continueRow] at emitted + split at emitted + · simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i continued contEmitted + have contPreserved := Block.emitRow_inputs row selector context _ _ _ _ continuation initial.append contEmitted + have equal := Option.some.inj emitted + subst emission + exact branchesPreserved.continued contPreserved _ + · cases emitted +termination_by sizeOf ctrl +decreasing_by + all_goals first + | decreasing_tactic + | (have := Array.sizeOf_lt_of_mem (Array.mem_def.mpr ‹_ ∈ _›); grind) + +theorem Block.emitRow_inputs (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (incoming : G) (values : Array RowValue) (column lookup : Nat) (block : Block) + {emission : BlockEmission} {inputs : Array G} (initial : RowInputs context.inputSize inputs values) + (emitted : block.emitRow row selector context incoming values column lookup = some emission) : + InputPreservation context inputs emission := by + rw [Block.emitRow] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i operations opsEmitted + dsimp only at emitted + split at emitted + · cases emitted + · rename_i control ctrlEmitted + have preserved := Ctrl.emitRow_inputs row selector context incoming _ _ _ block.ctrl + (emitOps_inputs opsEmitted initial) ctrlEmitted + have equal := Option.some.inj emitted + subst emission + exact (preserved.afterOps incoming lookup operations).prefix _ +termination_by sizeOf block +decreasing_by exact block_input_smaller block + +end + +end Aiur.Bytecode diff --git a/Ix/Aiur/Proofs/BlockRowProjection.lean b/Ix/Aiur/Proofs/BlockRowProjection.lean new file mode 100644 index 000000000..696405cee --- /dev/null +++ b/Ix/Aiur/Proofs/BlockRowProjection.lean @@ -0,0 +1,436 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.BlockRows +import Batteries.Data.List.Basic + +/-! +The selector and return-gate projections of the valued block emitter. +Successful emission suffices for the projection equalities; no satisfying +assignment is assumed. Its equations therefore imply the previously checked +selector-flow equations. +-/ + +namespace Aiur.AIR +open Bytecode + +theorem mapM_forall₂ {α β : Type} {relation : α → β → Prop} {source : List α} + {emissions : List β} {emit : α → Option β} + (emitted : source.mapM emit = some emissions) + (each : ∀ item ∈ source, ∀ emission, emit item = some emission → relation item emission) : + List.Forall₂ relation source emissions := by + induction source generalizing emissions with + | nil => + simp only [List.mapM_nil, pure, Option.some.injEq] at emitted + subst emissions + exact .nil + | cons item items ih => + simp only [List.mapM_cons, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i first firstEmitted + dsimp only at emitted + split at emitted + · cases emitted + · rename_i rest restEmitted + have equal := Option.some.inj emitted + subst emissions + exact .cons (each item List.mem_cons_self first firstEmitted) + (ih restEmitted (fun item member => each item (List.mem_cons_of_mem _ member))) + +theorem attachWith_mapM_val {α β : Type} (items : List α) (predicate : α → Prop) + (holds : ∀ item ∈ items, predicate item) (emit : α → Option β) : + (items.attachWith predicate holds).mapM (fun item => emit item.val) = items.mapM emit := by + have result := List.mapM_map (m := Option) (l := items.attachWith predicate holds) + (f := Subtype.val) (g := emit) + rw [List.attachWith_map_subtype_val] at result + exact result.symm + +theorem forall₂_map_left {α β γ : Type} {relation : β → γ → Prop} {map : α → β} + {left : List α} {right : List γ} + (related : List.Forall₂ (fun item result => relation (map item) result) left right) : + List.Forall₂ relation (left.map map) right := by + induction related with + | nil => exact .nil + | cons first _ ih => exact .cons first ih + +theorem forall₂_append {α β : Type} {relation : α → β → Prop} + {firstLeft restLeft : List α} {firstRight restRight : List β} + (first : List.Forall₂ relation firstLeft firstRight) + (rest : List.Forall₂ relation restLeft restRight) : + List.Forall₂ relation (firstLeft ++ restLeft) (firstRight ++ restRight) := by + induction first with + | nil => exact rest + | cons head _ ih => exact .cons head ih + +def SelectorFlow.unguard (flow : SelectorFlow) : SelectorFlow := + { flow with equations := flow.equations.tail } + +structure EmissionProjection (flow : SelectorFlow) (gates : List G) + (emission : BlockEmission) : Prop where + returned : emission.returns.map Prod.fst = gates + yielded : emission.yields.map Prod.fst = flow.yields + equations : flow.equations ⊆ emission.equations + +theorem EmissionProjection.prefix {flow : SelectorFlow} {gates : List G} + {emission : BlockEmission} (projection : EmissionProjection flow gates emission) + (equations : List G) : EmissionProjection flow gates (emission.prefix equations) := + ⟨projection.returned, projection.yielded, + fun _ member => List.mem_append_right _ (projection.equations member)⟩ + +theorem EmissionProjection.join {α : Type} {source : List α} {emissions : List BlockEmission} + (flow : α → SelectorFlow) (gates : α → List G) + (projections : List.Forall₂ (fun item emission => EmissionProjection (flow item) (gates item) emission) + source emissions) (values : Array RowValue) (column lookup : Nat) : + EmissionProjection (SelectorFlow.join (source.map flow)) (source.flatMap gates) + (joinBlockEmissions values column lookup emissions) := by + induction projections with + | nil => exact ⟨rfl, rfl, by simp [SelectorFlow.join]⟩ + | @cons item emission items emissions first rest ih => + refine ⟨?_, ?_, ?_⟩ + · change (emission.returns ++ emissions.flatMap (·.returns)).map Prod.fst = + gates item ++ items.flatMap gates + rw [List.map_append, first.returned] + exact congrArg (gates item ++ ·) ih.returned + · change (emission.yields ++ emissions.flatMap (·.yields)).map Prod.fst = + (flow item).yields ++ (items.map flow).flatMap (·.yields) + rw [List.map_append, first.yielded] + exact congrArg ((flow item).yields ++ ·) ih.yielded + · intro equation member + change equation ∈ (flow item).equations ++ (items.map flow).flatMap (·.equations) at member + change equation ∈ emission.equations ++ emissions.flatMap (·.equations) + rcases List.mem_append.mp member with left | right + · exact List.mem_append_left _ (first.equations left) + · exact List.mem_append_right _ (ih.equations right) + +end Aiur.AIR + +namespace Aiur.Bytecode +open Aiur.AIR + +theorem Ctrl.selectorFlow_equations (selector : SelIdx → G) (ctrl : Ctrl) : + (ctrl.selectorFlow selector).equations = + oneSubBooleanConstraint (ctrl.selectorFlow selector).entry :: + (ctrl.selectorFlow selector).equations.tail := by + cases ctrl <;> rw [Ctrl.selectorFlow.eq_def] + all_goals rfl + +def caseRow (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (matched : G) (values : Array RowValue) (column lookup : Nat) (pair : G × Block) : + Option BlockEmission := do + let entry := (pair.2.selectorFlow selector).entry + let emission ← pair.2.emitRow row selector context entry values column lookup + return emission.prefix [entry * (matched - pair.1)] + +def defaultRow (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (matched : G) (values : Array RowValue) (column lookup : Nat) + (branches : Array (G × Block)) (fallback : Option Block) : Option (List BlockEmission) := + match fallback with + | none => some [] + | some block => do + let entry := (block.selectorFlow selector).entry + let emission ← block.emitRow row selector context entry values (column + branches.size) lookup + return [emission.prefix (branches.toList.mapIdx fun i pair => + entry * ((matched - pair.1) * row (column + i) - 1))] + +def branchRows (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (matched : G) (values : Array RowValue) (column lookup : Nat) + (branches : Array (G × Block)) (fallback : Option Block) : Option BlockEmission := do + let cases ← branches.toList.mapM (caseRow row selector context matched values column lookup) + let default ← defaultRow row selector context matched values column lookup branches fallback + return joinBlockEmissions values column lookup (cases ++ default) + +theorem Ctrl.emitRow_match (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (incoming : G) (values : Array RowValue) (column lookup : Nat) + (index : ValIdx) (branches : Array (G × Block)) (fallback : Option Block) : + (Ctrl.match index branches fallback).emitRow row selector context incoming values column lookup = (do + let matched ← values[index]? + branchRows row selector context matched.value values column lookup branches fallback) := by + rw [Ctrl.emitRow.eq_def] + simp only [branchRows, Array.toList_attach] + cases read : values[index]? with + | none => simp only [bind, Option.bind_none] + | some matched => + simp only [bind, Option.bind_some] + rw [attachWith_mapM_val _ _ _ (fun pair : G × Block => + (pair.2.emitRow row selector context (pair.2.selectorFlow selector).entry values column lookup).bind + fun emission => pure (emission.prefix + [(pair.2.selectorFlow selector).entry * (matched.value - pair.1)]))] + change (branches.toList.mapM (caseRow row selector context matched.value values column lookup)).bind _ = _ + congr 1 + funext cases + cases fallback with + | none => rfl + | some block => simp only [defaultRow, bind, Option.bind_assoc] + +def continueRow (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (incoming : G) (values : Array RowValue) (size : Nat) (continuation : Block) + (joined : BlockEmission) : Option BlockEmission := + if joined.yields.all (fun part => part.2.size == size) then do + let gate := selectorSum (joined.yields.map Prod.fst) + let merged := rowAdvice row joined.column size + let equations := mergeEquations row incoming joined.column size joined.yields ++ + [(continuation.selectorFlow selector).entry - gate] + let continued ← continuation.emitRow row selector context gate (values ++ merged) + (joined.column + size) joined.lookup + return joined.continued equations continued + else none + +theorem Ctrl.emitRow_matchContinue (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (incoming : G) (values : Array RowValue) (column lookup : Nat) + (index : ValIdx) (branches : Array (G × Block)) (fallback : Option Block) + (size aux slots : Nat) (continuation : Block) : + (Ctrl.matchContinue index branches fallback size aux slots continuation).emitRow + row selector context incoming values column lookup = (do + let matched ← values[index]? + let joined ← branchRows row selector context matched.value values column lookup branches fallback + continueRow row selector context incoming values size continuation joined) := by + rw [Ctrl.emitRow.eq_def] + simp only [branchRows, Array.toList_attach] + cases read : values[index]? with + | none => simp only [bind, Option.bind_none] + | some matched => + simp only [bind, Option.bind_some] + rw [attachWith_mapM_val _ _ _ (fun pair : G × Block => + (pair.2.emitRow row selector context (pair.2.selectorFlow selector).entry values column lookup).bind + fun emission => pure (emission.prefix + [(pair.2.selectorFlow selector).entry * (matched.value - pair.1)]))] + simp only [Option.bind_assoc] + change (branches.toList.mapM (caseRow row selector context matched.value values column lookup)).bind _ = _ + congr 1 + funext cases + cases fallback <;> simp only [defaultRow, continueRow, bind, pure, + Option.bind_assoc, Option.bind_some] + +theorem caseRows_projection (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (matched : G) (values : Array RowValue) (column lookup : Nat) + (branches : Array (G × Block)) {emissions : List BlockEmission} + (emitted : branches.toList.mapM (caseRow row selector context matched values column lookup) = some emissions) + (sound : ∀ pair ∈ branches.toList, ∀ emission, + pair.2.emitRow row selector context (pair.2.selectorFlow selector).entry values column lookup = some emission → + EmissionProjection (pair.2.selectorFlow selector) + (pair.2.returnGates selector (pair.2.selectorFlow selector).entry) emission) : + List.Forall₂ (fun block emission => EmissionProjection (block.selectorFlow selector) + (block.returnGates selector (block.selectorFlow selector).entry) emission) + (branches.toList.map Prod.snd) emissions := by + apply forall₂_map_left + apply mapM_forall₂ emitted + intro pair member emission emitted + simp only [caseRow, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i body bodyEmitted + have equal := Option.some.inj emitted + subst emission + exact (sound pair member body bodyEmitted).prefix _ + +theorem defaultRow_projection (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (matched : G) (values : Array RowValue) (column lookup : Nat) + (branches : Array (G × Block)) (fallback : Option Block) {emissions : List BlockEmission} + (emitted : defaultRow row selector context matched values column lookup branches fallback = some emissions) + (sound : ∀ block, fallback = some block → ∀ emission, + block.emitRow row selector context (block.selectorFlow selector).entry values + (column + branches.size) lookup = some emission → + EmissionProjection (block.selectorFlow selector) + (block.returnGates selector (block.selectorFlow selector).entry) emission) : + List.Forall₂ (fun block emission => EmissionProjection (block.selectorFlow selector) + (block.returnGates selector (block.selectorFlow selector).entry) emission) + fallback.toList emissions := by + cases fallback with + | none => + simp only [defaultRow, Option.some.injEq] at emitted + subst emissions + exact .nil + | some block => + simp only [defaultRow, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i body bodyEmitted + have equal := Option.some.inj emitted + subst emissions + exact .cons ((sound block rfl body bodyEmitted).prefix _) .nil + +theorem branchRows_projection (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (matched : G) (values : Array RowValue) (column lookup : Nat) + (branches : Array (G × Block)) (fallback : Option Block) {emission : BlockEmission} + (emitted : branchRows row selector context matched values column lookup branches fallback = some emission) + (caseSound : ∀ pair ∈ branches.toList, ∀ emission, + pair.2.emitRow row selector context (pair.2.selectorFlow selector).entry values column lookup = some emission → + EmissionProjection (pair.2.selectorFlow selector) + (pair.2.returnGates selector (pair.2.selectorFlow selector).entry) emission) + (defaultSound : ∀ block, fallback = some block → ∀ emission, + block.emitRow row selector context (block.selectorFlow selector).entry values + (column + branches.size) lookup = some emission → + EmissionProjection (block.selectorFlow selector) + (block.returnGates selector (block.selectorFlow selector).entry) emission) : + EmissionProjection (SelectorFlow.join (branchSelectorFlows selector branches fallback)) + (branchReturnGates selector branches fallback) emission := by + simp only [branchRows, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i cases casesEmitted + dsimp only at emitted + split at emitted + · cases emitted + · rename_i default defaultEmitted + have equal := Option.some.inj emitted + subst emission + have casesProjection := caseRows_projection row selector context matched values column lookup branches + casesEmitted caseSound + have defaultProjection := defaultRow_projection row selector context matched values column lookup + branches fallback defaultEmitted defaultSound + have result := EmissionProjection.join + (fun block : Block => block.selectorFlow selector) + (fun block : Block => block.returnGates selector (block.selectorFlow selector).entry) + (forall₂_append casesProjection defaultProjection) values column lookup + simpa only [branchSelectorFlows, branchReturnGates, List.map_append, List.map_map, + List.flatMap_append, List.flatMap_map, Function.comp_def] using result + +private theorem block_projection_smaller (block : Block) : sizeOf block.ctrl < sizeOf block := by + cases block + simp + omega + +mutual + +theorem Ctrl.emitRow_projection (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (incoming : G) (values : Array RowValue) (column lookup : Nat) (ctrl : Ctrl) + {emission : BlockEmission} + (emitted : ctrl.emitRow row selector context incoming values column lookup = some emission) : + EmissionProjection (ctrl.selectorFlow selector).unguard + (ctrl.returnGates selector incoming) emission := by + cases ctrl with + | «return» index indices => + rw [Ctrl.emitRow.eq_def] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · dsimp only at emitted + split at emitted + · cases emitted + · have equal := Option.some.inj emitted + subst emission + rw [Ctrl.selectorFlow.eq_def, Ctrl.returnGates.eq_def] + exact ⟨rfl, rfl, by simp [SelectorFlow.unguard, SelectorFlow.guard]⟩ + | yield index indices => + rw [Ctrl.emitRow.eq_def] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · have equal := Option.some.inj emitted + subst emission + rw [Ctrl.selectorFlow.eq_def, Ctrl.returnGates.eq_def] + exact ⟨rfl, rfl, by simp [SelectorFlow.unguard, SelectorFlow.guard]⟩ + | «match» index branches fallback => + rw [Ctrl.emitRow_match] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i matched read + rw [Ctrl.selectorFlow_match, Ctrl.returnGates_match] + apply branchRows_projection row selector context matched.value values column lookup branches fallback emitted + · intro pair member body bodyEmitted + exact Block.emitRow_projection row selector context _ values column lookup pair.2 bodyEmitted + · intro block present body bodyEmitted + exact Block.emitRow_projection row selector context _ values _ lookup block bodyEmitted + | matchContinue index branches fallback size aux slots continuation => + rw [Ctrl.emitRow_matchContinue] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i matched read + dsimp only at emitted + split at emitted + · cases emitted + · rename_i joined branchesEmitted + have branchesProjection := branchRows_projection row selector context matched.value values column lookup + branches fallback branchesEmitted + (fun pair member body bodyEmitted => + Block.emitRow_projection row selector context _ values column lookup pair.2 bodyEmitted) + (fun block present body bodyEmitted => + Block.emitRow_projection row selector context _ values _ lookup block bodyEmitted) + simp only [continueRow] at emitted + split at emitted + · simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i continued contEmitted + have contProjection := Block.emitRow_projection row selector context _ _ _ _ continuation contEmitted + have gate := congrArg selectorSum branchesProjection.yielded + have equal := Option.some.inj emitted + subst emission + rw [Ctrl.selectorFlow_matchContinue, Ctrl.returnGates_matchContinue] + refine ⟨?_, contProjection.yielded, ?_⟩ + · change (joined.returns ++ continued.returns).map Prod.fst = _ + rw [List.map_append, branchesProjection.returned, contProjection.returned, gate] + · intro equation member + change equation ∈ + (SelectorFlow.join (branchSelectorFlows selector branches fallback)).equations ++ + ((continuation.selectorFlow selector).entry - + selectorSum (SelectorFlow.join (branchSelectorFlows selector branches fallback)).yields) :: + (continuation.selectorFlow selector).equations at member + change equation ∈ (joined.equations ++ + (mergeEquations row incoming joined.column size joined.yields ++ + [(continuation.selectorFlow selector).entry - selectorSum (joined.yields.map Prod.fst)])) ++ + continued.equations + rcases List.mem_append.mp member with branchEquation | contEquation + · exact List.mem_append_left _ (List.mem_append_left _ + (branchesProjection.equations branchEquation)) + · rcases List.mem_cons.mp contEquation with link | contEquation + · rw [link, ← gate] + exact List.mem_append_left _ (List.mem_append_right _ + (List.mem_append_right _ List.mem_cons_self)) + · exact List.mem_append_right _ (contProjection.equations contEquation) + · cases emitted +termination_by sizeOf ctrl +decreasing_by + all_goals first + | decreasing_tactic + | (have := Array.sizeOf_lt_of_mem (Array.mem_def.mpr ‹_ ∈ _›); grind) + +theorem Block.emitRow_projection (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (incoming : G) (values : Array RowValue) (column lookup : Nat) (block : Block) + {emission : BlockEmission} + (emitted : block.emitRow row selector context incoming values column lookup = some emission) : + EmissionProjection (block.selectorFlow selector) + (block.returnGates selector incoming) emission := by + rw [Block.emitRow] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i operations opsEmitted + dsimp only at emitted + split at emitted + · cases emitted + · rename_i control ctrlEmitted + have projected := Ctrl.emitRow_projection row selector context incoming _ _ _ block.ctrl ctrlEmitted + have equal := Option.some.inj emitted + subst emission + rw [Block.returnGates, Block.selectorFlow] + refine ⟨projected.returned, projected.yielded, ?_⟩ + intro equation member + change equation ∈ oneSubBooleanConstraint (block.ctrl.selectorFlow selector).entry :: + (operations.equations ++ control.equations) + change equation ∈ (block.ctrl.selectorFlow selector).equations at member + rw [Ctrl.selectorFlow_equations] at member + rcases List.mem_cons.mp member with guard | tail + · rw [guard] + exact List.mem_cons_self + · exact List.mem_cons_of_mem _ (List.mem_append_right _ (projected.equations tail)) +termination_by sizeOf block +decreasing_by exact block_projection_smaller block + +end + +theorem Block.emitRow_selectors (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (incoming : G) (values : Array RowValue) (column lookup : Nat) (block : Block) + {emission : BlockEmission} + (emitted : block.emitRow row selector context incoming values column lookup = some emission) + (satisfied : ∀ equation ∈ emission.equations, equation = 0) : + (block.selectorFlow selector).Satisfied := + fun equation member => satisfied equation + ((block.emitRow_projection row selector context incoming values column lookup emitted).equations member) + +end Aiur.Bytecode diff --git a/Ix/Aiur/Proofs/BlockRows.lean b/Ix/Aiur/Proofs/BlockRows.lean new file mode 100644 index 000000000..2d392f8c7 --- /dev/null +++ b/Ix/Aiur/Proofs/BlockRows.lean @@ -0,0 +1,159 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.CallInventory +import Ix.Aiur.Proofs.BranchSelection + +/-! +A total valued model of native block constraint emission. Branches share +columns and lookup slots, default arms allocate inverse witnesses, and +continuations consume local yields while preserving early returns. Selector +gates match native emission even on assignments that violate its equations. + +Native expression reflection and successful emission from validated layouts +remain separate obligations. +-/ + +namespace Aiur.AIR +open Bytecode + +structure RowContext where + function : FunIdx + inputSize : Nat + rank : G + +structure QueryPart where + slot : Nat + selector : G + message : List G + deriving Repr + +def queryParts (slot : Nat) (selector : G) (queries : List (List G)) : List QueryPart := + queries.mapIdx fun index message => ⟨slot + index, selector, message⟩ + +structure BlockEmission where + values : Array RowValue + column : Nat + lookup : Nat + equations : List G := [] + queries : List QueryPart := [] + returns : List (G × Bytecode.AIR.Call) := [] + yields : List (G × Array RowValue) := [] + calls : List (G × (Bytecode.AIR.Call × (Fin 6 → G))) := [] + +def BlockEmission.prefix (equations : List G) (emission : BlockEmission) : BlockEmission := + { emission with equations := equations ++ emission.equations } + +def BlockEmission.afterOps (incoming : G) (lookup : Nat) (ops : OpsEmission) + (control : BlockEmission) : BlockEmission := + { control with + equations := ops.equations ++ control.equations + queries := queryParts lookup incoming ops.queries ++ control.queries + calls := ops.calls.map (incoming, ·) ++ control.calls } + +def joinBlockEmissions (values : Array RowValue) (column lookup : Nat) + (emissions : List BlockEmission) : BlockEmission := + { values + column := emissions.foldl (fun column emission => max column emission.column) column + lookup := emissions.foldl (fun lookup emission => max lookup emission.lookup) lookup + equations := emissions.flatMap (·.equations) + queries := emissions.flatMap (·.queries) + returns := emissions.flatMap (·.returns) + yields := emissions.flatMap (·.yields) + calls := emissions.flatMap (·.calls) } + +def mergeEquations (row : Nat → G) (parent : G) (column size : Nat) + (yields : List (G × Array RowValue)) : List G := + (List.range size).map fun index => parent * (row (column + index) - + selectorSum (yields.map fun part => part.1 * (rowValues part.2)[index]?.getD 0)) + +def BlockEmission.continued (branches : BlockEmission) (equations : List G) + (continuation : BlockEmission) : BlockEmission := + { continuation with + equations := branches.equations ++ equations ++ continuation.equations + queries := branches.queries ++ continuation.queries + returns := branches.returns ++ continuation.returns + calls := branches.calls ++ continuation.calls } + +end Aiur.AIR + +namespace Aiur.Bytecode +open Aiur.AIR + +private theorem block_row_smaller (block : Block) : sizeOf block.ctrl < sizeOf block := by + cases block + simp + omega + +mutual + +def Ctrl.emitRow (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (incoming : G) (values : Array RowValue) (column lookup : Nat) : Ctrl → Option BlockEmission + | .return _ indices => do + let inputs ← AIR.readValues (rowValues values) (Array.range context.inputSize) + let outputs ← AIR.readValues (rowValues values) indices + return { + values, column, lookup + returns := [(incoming, ⟨context.function, inputs, outputs, context.rank⟩)] } + | .yield index indices => do + let outputs ← indices.toList.mapM fun index => values[index]? + return { values, column, lookup, yields := [(selector index, outputs.toArray)] } + | .match index branches fallback => do + let matched ← values[index]? + let cases ← branches.attach.toList.mapM fun ⟨pair, _⟩ => do + let entry := (pair.2.selectorFlow selector).entry + let emission ← pair.2.emitRow row selector context entry values column lookup + return emission.prefix [entry * (matched.value - pair.1)] + let default : List BlockEmission ← match fallback with + | none => some [] + | some block => do + let entry := (block.selectorFlow selector).entry + let emission ← block.emitRow row selector context entry values (column + branches.size) lookup + pure [emission.prefix (branches.toList.mapIdx fun i pair => + entry * ((matched.value - pair.1) * row (column + i) - 1))] + return joinBlockEmissions values column lookup (cases ++ default) + | .matchContinue index branches fallback size _ _ continuation => do + let matched ← values[index]? + let cases ← branches.attach.toList.mapM fun ⟨pair, _⟩ => do + let entry := (pair.2.selectorFlow selector).entry + let emission ← pair.2.emitRow row selector context entry values column lookup + return emission.prefix [entry * (matched.value - pair.1)] + let default : List BlockEmission ← match fallback with + | none => some [] + | some block => do + let entry := (block.selectorFlow selector).entry + let emission ← block.emitRow row selector context entry values (column + branches.size) lookup + pure [emission.prefix (branches.toList.mapIdx fun i pair => + entry * ((matched.value - pair.1) * row (column + i) - 1))] + let joined := joinBlockEmissions values column lookup (cases ++ default) + if joined.yields.all (fun part => part.2.size == size) then do + let gate := selectorSum (joined.yields.map Prod.fst) + let merged := rowAdvice row joined.column size + let equations := mergeEquations row incoming joined.column size joined.yields ++ + [(continuation.selectorFlow selector).entry - gate] + let continued ← continuation.emitRow row selector context gate (values ++ merged) + (joined.column + size) joined.lookup + return joined.continued equations continued + else none +termination_by ctrl => sizeOf ctrl +decreasing_by + all_goals first + | decreasing_tactic + | (have := Array.sizeOf_lt_of_mem ‹_ ∈ _›; grind) + +def Block.emitRow (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (incoming : G) (values : Array RowValue) (column lookup : Nat) + (block : Block) : Option BlockEmission := do + let operations ← emitOps row incoming context.rank block.ops.toList values column + let control ← block.ctrl.emitRow row selector context incoming operations.values + operations.column (lookup + operations.queries.length) + return (control.afterOps incoming lookup operations).prefix + [oneSubBooleanConstraint (block.selectorFlow selector).entry] +termination_by sizeOf block +decreasing_by exact block_row_smaller block + +end + +end Aiur.Bytecode diff --git a/Ix/Aiur/Proofs/BranchSelection.lean b/Ix/Aiur/Proofs/BranchSelection.lean new file mode 100644 index 000000000..c19363738 --- /dev/null +++ b/Ix/Aiur/Proofs/BranchSelection.lean @@ -0,0 +1,117 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.ReturnGates + +/-! Active case/default polynomial equations recover a branch of the actual +bytecode and its selector constraints. The branch-count bound and decoding +of the matched expression and default inverse columns remain explicit. -/ + +namespace Aiur.Bytecode +open Aiur.AIR + +theorem Ctrl.selectorFlow_boolean (selector : SelIdx → G) (ctrl : Ctrl) + (valid : (ctrl.selectorFlow selector).Satisfied) : + booleanConstraint (ctrl.selectorFlow selector).entry = 0 := by + cases ctrl <;> rw [Ctrl.selectorFlow.eq_def] at valid ⊢ + all_goals + have boolean := SelectorFlow.guard_boolean valid + exact boolean + +theorem Block.selectorFlow_boolean (selector : SelIdx → G) (block : Block) + (valid : (block.selectorFlow selector).Satisfied) : + booleanConstraint (block.selectorFlow selector).entry = 0 := by + rw [Block.selectorFlow] at valid ⊢ + exact Ctrl.selectorFlow_boolean selector block.ctrl valid + +/-- Case and default polynomial forms after reading the matched expression. +Default inverse advice is arbitrary; its equation establishes disequality. -/ +structure MatchPolynomials (selector : SelIdx → G) (scrutinee : G) + (branches : Array (G × Block)) (fallback : Option Block) : Prop where + cases : ∀ pair ∈ branches.toList, + (pair.2.selectorFlow selector).entry * (scrutinee - pair.1) = 0 + default : ∀ block, fallback = some block → ∀ pair ∈ branches.toList, + ∃ inverse : G, + (block.selectorFlow selector).entry * ((scrutinee - pair.1) * inverse - 1) = 0 + +theorem branchSelectorFlows_boolean (selector : SelIdx → G) (branches : Array (G × Block)) + (fallback : Option Block) + (valid : (SelectorFlow.join (branchSelectorFlows selector branches fallback)).Satisfied) : + ∀ flow ∈ branchSelectorFlows selector branches fallback, booleanConstraint flow.entry = 0 := by + intro flow member + have satisfied := SelectorFlow.join_satisfied valid flow member + rcases List.mem_append.mp member with caseMember | defaultMember + · obtain ⟨pair, pairMember, equal⟩ := List.mem_map.mp caseMember + subst flow + exact pair.2.selectorFlow_boolean selector satisfied + · obtain ⟨block, blockMember, equal⟩ := List.mem_map.mp defaultMember + subst flow + exact block.selectorFlow_boolean selector satisfied + +/-- An active sum selects a branch that matches the scrutinee, with its own +selector equations available for recursive local execution extraction. -/ +theorem MatchPolynomials.active_branch {selector : SelIdx → G} {scrutinee : G} + {branches : Array (G × Block)} {fallback : Option Block} + (polynomials : MatchPolynomials selector scrutinee branches fallback) + (valid : (SelectorFlow.join (branchSelectorFlows selector branches fallback)).Satisfied) + (bounded : branches.size + fallback.toList.length < gSize.toNat) + (active : (SelectorFlow.join (branchSelectorFlows selector branches fallback)).entry = 1) : + ∃ block, AIR.SelectArm scrutinee branches fallback block ∧ + (block.selectorFlow selector).Satisfied ∧ (block.selectorFlow selector).entry = 1 := by + have individual := branchSelectorFlows_boolean selector branches fallback valid + change selectorSum ((branchSelectorFlows selector branches fallback).map SelectorFlow.entry) = 1 at active + have count := selectorSum_active_count + (selectors := (branchSelectorFlows selector branches fallback).map SelectorFlow.entry) + (fun value member => by + obtain ⟨flow, flowMember, equal⟩ := List.mem_map.mp member + subst value + exact individual flow flowMember) + (by simpa only [List.length_map, branchSelectorFlows, List.length_append, + Array.length_toList] using bounded) active + have oneMember : (1 : G) ∈ (branchSelectorFlows selector branches fallback).map SelectorFlow.entry := + List.count_pos_iff.mp (Nat.lt_of_lt_of_eq (by decide : 0 < 1) count.symm) + obtain ⟨flow, flowMember, selected⟩ := List.mem_map.mp oneMember + have satisfied := SelectorFlow.join_satisfied valid flow flowMember + rcases List.mem_append.mp flowMember with caseMember | defaultMember + · obtain ⟨pair, pairMember, equal⟩ := List.mem_map.mp caseMember + subst flow + refine ⟨pair.2, ?_, satisfied, selected⟩ + apply AIR.SelectArm.case + have matchesEq := active_case selected (polynomials.cases pair pairMember) + rw [matchesEq] + exact pairMember + · obtain ⟨block, blockMember, equal⟩ := List.mem_map.mp defaultMember + subst flow + have present : fallback = some block := by simpa using blockMember + refine ⟨block, AIR.SelectArm.fallback present ?_, satisfied, selected⟩ + intro pair pairMember + obtain ⟨inverse, equation⟩ := polynomials.default block present pair pairMember + exact (active_default selected equation).symm + +theorem MatchPolynomials.active_match {selector : SelIdx → G} {scrutinee : G} + {index : ValIdx} {branches : Array (G × Block)} {fallback : Option Block} + (polynomials : MatchPolynomials selector scrutinee branches fallback) + (valid : ((Ctrl.match index branches fallback).selectorFlow selector).Satisfied) + (bounded : branches.size + fallback.toList.length < gSize.toNat) + (active : ((Ctrl.match index branches fallback).selectorFlow selector).entry = 1) : + ∃ block, AIR.SelectArm scrutinee branches fallback block ∧ + (block.selectorFlow selector).Satisfied ∧ (block.selectorFlow selector).entry = 1 := by + rw [Ctrl.selectorFlow_match] at valid active + exact polynomials.active_branch (SelectorFlow.guard_satisfied valid) bounded active + +theorem MatchPolynomials.active_matchContinue {selector : SelIdx → G} {scrutinee : G} + {index : ValIdx} {branches : Array (G × Block)} {fallback : Option Block} + {outputs aux lookups : Nat} {continuation : Block} + (polynomials : MatchPolynomials selector scrutinee branches fallback) + (valid : ((Ctrl.matchContinue index branches fallback outputs aux lookups continuation).selectorFlow selector).Satisfied) + (bounded : branches.size + fallback.toList.length < gSize.toNat) + (active : ((Ctrl.matchContinue index branches fallback outputs aux lookups continuation).selectorFlow selector).entry = 1) : + ∃ block, AIR.SelectArm scrutinee branches fallback block ∧ + (block.selectorFlow selector).Satisfied ∧ (block.selectorFlow selector).entry = 1 := by + rw [Ctrl.selectorFlow_matchContinue] at valid active + exact polynomials.active_branch + (SelectorFlow.continue_satisfied (SelectorFlow.guard_satisfied valid)).1 bounded active + +end Aiur.Bytecode diff --git a/Ix/Aiur/Proofs/BranchlessSlots.lean b/Ix/Aiur/Proofs/BranchlessSlots.lean new file mode 100644 index 000000000..956c7f7a8 --- /dev/null +++ b/Ix/Aiur/Proofs/BranchlessSlots.lean @@ -0,0 +1,177 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.CircuitRowCounts + +/-! Every circuit eligible for ungated messages has a single function +with terminal control. Its queries occupy disjoint slots, independent of +witness selectors. This closes the single-writer premise and reflects all +encoded consumer slots after padding; native expression reflection remains +a separate obligation. -/ + +namespace Aiur.AIR +open Bytecode + +def unitQuerySelectors (queries : List QueryPart) : List QueryPart := + queries.map fun query => { query with selector := 1 } + +def QueryWriters (start finish : Nat) (queries : List QueryPart) : Prop := + QuerySlots 1 start finish (unitQuerySelectors queries) + +theorem unitQuerySelectors_parts (slot : Nat) (selector : G) (queries : List (List G)) : + unitQuerySelectors (queryParts slot selector queries) = queryParts slot 1 queries := by + induction queries generalizing slot with + | nil => rfl + | cons message queries ih => + rw [queryParts_cons, queryParts_cons] + change _ :: unitQuerySelectors (queryParts (slot + 1) selector queries) = _ + rw [ih] + +theorem QueryWriters.indexed (slot : Nat) (selector : G) (queries : List (List G)) : + QueryWriters slot (slot + queries.length) (queryParts slot selector queries) := by + rw [QueryWriters, unitQuerySelectors_parts] + exact QuerySlots.indexed 1 slot queries (by decide +kernel) + +theorem QueryWriters.append {start middle finish : Nat} {first rest : List QueryPart} + (left : QueryWriters start middle first) (right : QueryWriters middle finish rest) : + QueryWriters start finish (first ++ rest) := by + unfold QueryWriters unitQuerySelectors + rw [List.map_append] + exact QuerySlots.append left right + +theorem QueryWriters.extend {start finish limit : Nat} {queries : List QueryPart} + (writers : QueryWriters start finish queries) (bound : finish ≤ limit) : + QueryWriters start limit queries := QuerySlots.extend writers bound + +theorem QueryWriters.permuted {start finish : Nat} {queries other : List QueryPart} + (writers : QueryWriters start finish queries) (permutation : queries.Perm other) : + QueryWriters start finish other := QuerySlots.permuted writers (permutation.map _) + +theorem unitQuerySelectors_count (queries : List QueryPart) (slot : Nat) : + queryCount (unitQuerySelectors queries) slot = (querySlotParts queries slot).length := by + simp only [queryCount, unitQuerySelectors, List.filter_map, List.length_map, + querySlotParts, Function.comp_def, beq_self_eq_true, Bool.and_true] + +theorem QueryWriters.single {start finish : Nat} {queries : List QueryPart} + (writers : QueryWriters start finish queries) (slot : Nat) : + (querySlotParts queries slot).length ≤ 1 := by + rw [← unitQuerySelectors_count] + exact writers.count slot + +end Aiur.AIR + +namespace Aiur.Bytecode +open Aiur.AIR + +theorem Function.emitRow_terminal_writers (row : Nat → G) (selector : SelIdx → G) + (function : Function) (functionIndex : FunIdx) (rank : G) + (inputs : Array RowValue) (column lookup : Nat) {emission : BlockEmission} + (terminal : function.hasTerminalControl = true) + (emitted : function.emitRow row selector functionIndex rank inputs column lookup = some emission) : + QueryWriters lookup emission.lookup emission.queries := by + rw [Function.emitRow, Block.emitRow] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i ops opsEmitted + dsimp only at emitted + split at emitted + · cases emitted + · rename_i control controlEmitted + have equal := Option.some.inj emitted + subst emission + cases ctrlEq : function.body.ctrl with + | «match» index branches fallback => + simp only [Function.hasTerminalControl, ctrlEq, Bool.false_eq_true] at terminal + | matchContinue index branches fallback size aux slots continuation => + simp only [Function.hasTerminalControl, ctrlEq, Bool.false_eq_true] at terminal + | «return» index indices => + rw [ctrlEq, Ctrl.emitRow.eq_def] at controlEmitted + simp only [bind, Option.bind] at controlEmitted + split at controlEmitted + · cases controlEmitted + · dsimp only at controlEmitted + split at controlEmitted + · cases controlEmitted + · have equal := Option.some.inj controlEmitted + subst control + simpa only [BlockEmission.prefix, BlockEmission.afterOps, List.append_nil] using + QueryWriters.indexed lookup (function.body.selectorFlow selector).entry ops.queries + | yield index indices => + rw [ctrlEq, Ctrl.emitRow.eq_def] at controlEmitted + simp only [bind, Option.bind] at controlEmitted + split at controlEmitted + · cases controlEmitted + · have equal := Option.some.inj controlEmitted + subst control + simpa only [BlockEmission.prefix, BlockEmission.afterOps, List.append_nil] using + QueryWriters.indexed lookup (function.body.selectorFlow selector).entry ops.queries + +end Aiur.Bytecode + +namespace Aiur.AIR +open Bytecode + +theorem circuitBranchless_member {selectors : Nat} {members : List MemberEmission} + (enabled : circuitBranchless selectors (members.map (·.function)) = true) : + ∃ member, members = [member] ∧ member.function.hasTerminalControl = true := by + cases members with + | nil => simp only [List.map_nil, circuitBranchless, Bool.and_false, Bool.false_eq_true] at enabled + | cons member rest => + cases rest with + | nil => + refine ⟨member, rfl, ?_⟩ + simp only [List.map_cons, List.map_nil, circuitBranchless, Bool.and_eq_true] at enabled + exact enabled.2 + | cons next rest => + simp only [List.map_cons, circuitBranchless, Bool.and_false, Bool.false_eq_true] at enabled + +theorem circuitEmission_queryWriters {row : Nat → G} {rank : G} {column : Nat} + {program : Toplevel} {circuit : Circuit} {members : List MemberEmission} + (source : ∀ member ∈ members, member.FromProgram row rank column 4 program) + (enabled : (circuitEmission row circuit members).branchless = true) + (limits : ∀ member ∈ members, member.body.lookup ≤ circuit.layout.lookups) : + QueryWriters 1 circuit.layout.lookups (circuitEmission row circuit members).queries := by + obtain ⟨member, membersEq, terminal⟩ := circuitBranchless_member enabled + subst members + have body := member.function.emitRow_terminal_writers row (member.selector row) + member.functionIndex rank (rowAdvice row 0 member.function.layout.inputSize) column 4 + terminal (source member List.mem_cons_self).emitted + have headers := QueryWriters.indexed 1 (circuitEmission row circuit [member]).selector + ((rankByteQueries (circuitRankBytes row circuit.layout)).map rangeMessage) + have combined := (headers.append (body.extend (limits member List.mem_cons_self))).permuted List.perm_append_comm + simpa only [circuitEmission, List.flatMap_cons, List.flatMap_nil, List.append_nil] using combined + +end Aiur.AIR + +namespace Aiur.Bytecode +open Aiur.AIR + +theorem Circuit.emitRow_queryWriters (row : Nat → G) (program : Toplevel) (circuit : Circuit) + {emission : CircuitEmission} (emitted : circuit.emitRow row program = some emission) + (enabled : emission.branchless = true) + (limits : ∀ member ∈ emission.members, member.body.lookup ≤ circuit.layout.lookups) : + QueryWriters 1 emission.lookupCount emission.queries := by + obtain ⟨description, _, source⟩ := circuit.emitRow_spec row program emitted + have writers := circuitEmission_queryWriters source (by rw [← description]; exact enabled) limits + have lookupEq := congrArg CircuitEmission.lookupCount description + change emission.lookupCount = circuit.layout.lookups at lookupEq + rw [← lookupEq, ← description] at writers + exact writers + +theorem Circuit.emitRow_queries_reflect (row : Nat → G) (program : Toplevel) (circuit : Circuit) + {emission : CircuitEmission} (emitted : circuit.emitRow row program = some emission) + (validated : circuit.validateRowCounts program = true) + (reserved : 4 ≤ circuit.layout.lookups) + (limits : ∀ member ∈ emission.members, member.body.lookup ≤ circuit.layout.lookups) + (satisfied : ∀ equation ∈ emission.equations, equation = 0) (width : Nat) : + (encodedQueries emission.branchless emission.queries emission.lookupCount).map (padMessage width) = + (decodedQueries emission.queries emission.lookupCount).map (padMessage width) := by + obtain ⟨bounded, bounds, _, _⟩ := circuit.emitRow_count_bounds row program emitted validated satisfied + have slots := circuit.emitRow_querySlots row program emitted bounded bounds reserved limits satisfied + apply slots.queries_reflect + exact fun enabled slot => (circuit.emitRow_queryWriters row program emitted enabled limits).single slot + +end Aiur.Bytecode diff --git a/Ix/Aiur/Proofs/ByteArithmetic.lean b/Ix/Aiur/Proofs/ByteArithmetic.lean new file mode 100644 index 000000000..fe7190a2b --- /dev/null +++ b/Ix/Aiur/Proofs/ByteArithmetic.lean @@ -0,0 +1,185 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.LocalConstraints + +/-! +Virtual byte carries and the four-byte strict-comparison gadget. + +The native byte-add/subtract lookups supply only their low byte. Multiplying +the residual by the inverse of 256 gives the carry or borrow in the semantic +operation. For `u32_less_than`, twelve range-checked bytes and four boolean +carry equations give the integer identity `a + witness + 1 = b + carry*2^32`. +The range bounds make its final carry exactly the complement of `a < b`. + +All arithmetic is over the actual Goldilocks representation. Lookup-derived +byte bounds and decoding the native expressions remain separate inputs. +-/ + +namespace Aiur + +theorem G.mul_assoc (a b c : G) : (a * b) * c = a * (b * c) := by + apply G.ext_n + simp only [G.n_mul, Nat.mod_mul_mod, Nat.mul_mod_mod, Nat.mul_assoc] + +theorem G.n_sub (a b : G) : (a - b).n = (a.n + gSize.toNat - b.n) % gSize.toNat := + G.n_ofNat _ + +namespace AIR + +def inverse256 : G := 18374686475393433601 + +theorem inverse256_correct : inverse256 * 256 = 1 := by decide +kernel + +theorem byte_division_eq (value : G) : (value * inverse256) * 256 = value := by + rw [G.mul_assoc, inverse256_correct, G.mul_one] + +theorem byte_add_carry {x y low : G} (hx : x.n < 256) (hy : y.n < 256) + (hlow : low = G.ofNat ((x.n + y.n) % 256)) : + (x + y - low) * inverse256 = G.ofNat ((x.n + y.n) / 256) := by + apply G.ext_n + rw [hlow] + simp only [G.n_mul, G.n_sub, G.n_add, G.n_ofNat] + have p : gSize.toNat = 18446744069414584321 := by decide + have inv : inverse256.n = 18374686475393433601 := rfl + rw [p, inv] + omega + +theorem byte_sub_borrow {x y low : G} (hx : x.n < 256) (hy : y.n < 256) + (hlow : low = G.ofNat ((x.n + 256 - y.n) % 256)) : + (low + y - x) * inverse256 = if x.n < y.n then 1 else 0 := by + have diff : low + y - x = if x.n < y.n then 256 else 0 := by + apply G.ext_n + rw [hlow] + split + all_goals + simp only [G.n_sub, G.n_add, G.n_ofNat] + have full : (256 : G).n = 256 := rfl + have zero : (0 : G).n = 0 := rfl + simp only [full, zero] + have p : gSize.toNat = 18446744069414584321 := by decide + rw [p] + omega + rw [diff] + split <;> decide +kernel + +theorem byte_carry_relation {x y z previous carry : G} + (hx : x.n < 256) (hy : y.n < 256) (hz : z.n < 256) + (hp : previous = 0 ∨ previous = 1) (hc : carry = 0 ∨ carry = 1) + (computed : carry = (x + y + previous - z) * inverse256) : + x.n + y.n + previous.n = z.n + 256 * carry.n := by + have hp' : previous.n ≤ 1 := by rcases hp with rfl | rfl <;> decide + have hc' : carry.n ≤ 1 := by rcases hc with rfl | rfl <;> decide + have fieldEqual : carry * 256 = x + y + previous - z := by + rw [computed, byte_division_eq] + have numeric := congrArg G.n fieldEqual + simp only [G.n_mul, G.n_sub, G.n_add] at numeric + have scale : (256 : G).n = 256 := rfl + have p : gSize.toNat = 18446744069414584321 := by decide + rw [scale, p] at numeric + omega + +def pack4 (bytes : Fin 4 → G) : G := + bytes 0 + 256 * bytes 1 + 65536 * bytes 2 + 16777216 * bytes 3 + +def pack4Nat (bytes : Fin 4 → G) : Nat := + (bytes 0).n + 256 * (bytes 1).n + 65536 * (bytes 2).n + 16777216 * (bytes 3).n + +theorem pack4_n (bytes : Fin 4 → G) (bounded : ∀ i, (bytes i).n < 256) : + (pack4 bytes).n = pack4Nat bytes ∧ (pack4 bytes).n < 2 ^ 32 := by + have h0 := bounded 0 + have h1 := bounded 1 + have h2 := bounded 2 + have h3 := bounded 3 + have totalBound : (bytes 0).n + 256 * (bytes 1).n + 65536 * (bytes 2).n + + 16777216 * (bytes 3).n < 2 ^ 32 := by omega + have fieldBound : (bytes 0).n + 256 * (bytes 1).n + 65536 * (bytes 2).n + + 16777216 * (bytes 3).n < 18446744069414584321 := + Nat.lt_trans totalBound (by decide) + have s1 : (256 : G).n = 256 := rfl + have s2 : (65536 : G).n = 65536 := rfl + have s3 : (16777216 : G).n = 16777216 := rfl + simp only [pack4, pack4Nat, G.n_add, G.n_mul, s1, s2, s3] + have p : gSize.toNat = 18446744069414584321 := by decide + rw [p] + simp only [Nat.add_mod_mod, Nat.mod_add_mod] + rw [Nat.mod_eq_of_lt fieldBound] + exact ⟨rfl, totalBound⟩ + +def carryStep (x y z previous : G) : G := (x + y + previous - z) * inverse256 + +def u32Carries (x y z : Fin 4 → G) : Fin 5 → G := + let c1 := carryStep (x 0) (y 0) (z 0) 1 + let c2 := carryStep (x 1) (y 1) (z 1) c1 + let c3 := carryStep (x 2) (y 2) (z 2) c2 + let c4 := carryStep (x 3) (y 3) (z 3) c3 + fun i => match i with + | 0 => 1 + | 1 => c1 + | 2 => c2 + | 3 => c3 + | 4 => c4 + +theorem u32Carry_relation (x y z : Fin 4 → G) + (hx : ∀ i, (x i).n < 256) (hy : ∀ i, (y i).n < 256) (hz : ∀ i, (z i).n < 256) + (boolean : ∀ i : Fin 4, booleanConstraint (u32Carries x y z i.succ) = 0) : + pack4Nat x + pack4Nat y + 1 = pack4Nat z + 2 ^ 32 * (u32Carries x y z 4).n := by + have hc0 : u32Carries x y z 0 = 0 ∨ u32Carries x y z 0 = 1 := Or.inr rfl + have hc1 := G.boolean_of_constraint (boolean 0) + have hc2 := G.boolean_of_constraint (boolean 1) + have hc3 := G.boolean_of_constraint (boolean 2) + have hc4 := G.boolean_of_constraint (boolean 3) + have r0 := byte_carry_relation (hx 0) (hy 0) (hz 0) hc0 hc1 rfl + have r1 := byte_carry_relation (hx 1) (hy 1) (hz 1) hc1 hc2 rfl + have r2 := byte_carry_relation (hx 2) (hy 2) (hz 2) hc2 hc3 rfl + have r3 := byte_carry_relation (hx 3) (hy 3) (hz 3) hc3 hc4 rfl + simp only [show (0 : Fin 4).succ = (1 : Fin 5) from rfl, + show (1 : Fin 4).succ = (2 : Fin 5) from rfl, + show (2 : Fin 4).succ = (3 : Fin 5) from rfl, + show (3 : Fin 4).succ = (4 : Fin 5) from rfl] at r0 r1 r2 r3 + have initial : (u32Carries x y z 0).n = 1 := rfl + rw [initial] at r0 + unfold pack4Nat + omega + +theorem u32_less_than (x y z : Fin 4 → G) + (hx : ∀ i, (x i).n < 256) (hy : ∀ i, (y i).n < 256) (hz : ∀ i, (z i).n < 256) + (boolean : ∀ i : Fin 4, booleanConstraint (u32Carries x y z i.succ) = 0) : + 1 - u32Carries x y z 4 = G.u32LessThan (pack4 x) (pack4 z) := by + have relation := u32Carry_relation x y z hx hy hz boolean + obtain ⟨nx, bx⟩ := pack4_n x hx + obtain ⟨ny, by'⟩ := pack4_n y hy + obtain ⟨nz, bz⟩ := pack4_n z hz + have last := G.boolean_of_constraint (boolean 3) + change u32Carries x y z 4 = 0 ∨ u32Carries x y z 4 = 1 at last + rcases last with zero | one + · have value : (u32Carries x y z 4).n = 0 := congrArg G.n zero + have less : (pack4 x).n < (pack4 z).n := by omega + rw [zero, G.u32LessThan, if_pos less] + decide +kernel + · have value : (u32Carries x y z 4).n = 1 := congrArg G.n one + have notLess : ¬(pack4 x).n < (pack4 z).n := by omega + rw [one, G.u32LessThan, if_neg notLess] + decide +kernel + +theorem active_u32_less_than {selector a b : G} (active : selector = 1) + (x y z : Fin 4 → G) + (hx : ∀ i, (x i).n < 256) (hy : ∀ i, (y i).n < 256) (hz : ∀ i, (z i).n < 256) + (decomposeA : selector * (a - pack4 x) = 0) + (decomposeB : selector * (b - pack4 z) = 0) + (carries : ∀ i : Fin 4, selector * booleanConstraint (u32Carries x y z i.succ) = 0) : + a.n < 2 ^ 32 ∧ b.n < 2 ^ 32 ∧ + 1 - u32Carries x y z 4 = G.u32LessThan a b := by + have ha := active_case active decomposeA + have hb := active_case active decomposeB + subst a b + refine ⟨(pack4_n x hx).2, (pack4_n z hz).2, u32_less_than x y z hx hy hz ?_⟩ + intro i + have satisfied := carries i + rw [active, G.mul_comm, G.mul_one] at satisfied + exact satisfied + +end AIR +end Aiur diff --git a/Ix/Aiur/Proofs/ByteLookups.lean b/Ix/Aiur/Proofs/ByteLookups.lean new file mode 100644 index 000000000..73e644c1f --- /dev/null +++ b/Ix/Aiur/Proofs/ByteLookups.lean @@ -0,0 +1,284 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.ByteArithmetic + +/-! +Extraction of byte operations from fixed byte-table lookup messages. + +The three unary and ten binary channels, row order, output columns and +arities match the native byte chips. Providers range over the complete +fixed tables with arbitrary field multiplicities. Exact balance and a +query-count bound force each requested input and output to match one row. +The step theorems include virtual carry/borrow outputs omitted by lookups. + +Native preprocessed rows and lookup expressions are compared exhaustively +against these definitions by the component gate. That executable comparison +does not prove native refinement. Extracting balance for these exact tuples +from the global padded/compressed lookup argument remains a separate task. +-/ + +namespace Aiur.AIR + +inductive Byte1Kind where + | bits | shiftLeft | shiftRight + deriving DecidableEq + +def Byte1Kind.all : List Byte1Kind := [.bits, .shiftLeft, .shiftRight] + +def Byte1Kind.channel : Byte1Kind → G + | .bits => 2 + | .shiftLeft => 3 + | .shiftRight => 4 + +theorem Byte1Kind.channel_injective {left right : Byte1Kind} + (same : left.channel = right.channel) : left = right := by + revert same + cases left <;> cases right <;> decide +kernel + +def Byte1Kind.result : Byte1Kind → G → Array G + | .bits, input => Array.ofFn (G.u8BitDecomposition input) + | .shiftLeft, input => #[G.u8ShiftLeft input] + | .shiftRight, input => #[G.u8ShiftRight input] + +def byte1Outputs (kind : Byte1Kind) (row : Fin 256) : Array G := + match kind with + | .bits => Array.ofFn fun bit : Fin 8 => G.ofNat ((row.val >>> bit.val) &&& 1) + | .shiftLeft => #[G.ofNat ((row.val * 2) % 256)] + | .shiftRight => #[G.ofNat (row.val / 2)] + +def byte1Request (kind : Byte1Kind) (input : G) (outputs : Array G) : List G := + kind.channel :: input :: outputs.toList + +def byte1Providers (weights : Byte1Kind → Fin 256 → G) : List (Provider (List G)) := + Byte1Kind.all.flatMap fun kind => List.ofFn fun row => + (byte1Request kind (G.ofNat row.val) (byte1Outputs kind row), weights kind row) + +theorem byte1Outputs_correct (kind : Byte1Kind) (row : Fin 256) : + byte1Outputs kind row = kind.result (G.ofNat row.val) := by + have below : row.val < gSize.toNat := Nat.lt_trans row.isLt (by decide) + cases kind <;> + simp only [byte1Outputs, Byte1Kind.result, G.u8ShiftLeft, + G.u8ShiftRight, G.n_ofNat, Nat.mod_eq_of_lt below] + apply congrArg Array.ofFn + funext bit + simp only [G.u8BitDecomposition, G.n_ofNat, Nat.mod_eq_of_lt below] + +theorem exactLookupBalance_byte1 {queries : List (List G)} + (weights : Byte1Kind → Fin 256 → G) + (balanced : ExactLookupBalance queries (byte1Providers weights)) + (bounded : queries.length < gSize.toNat) + {kind : Byte1Kind} {input : G} {outputs : Array G} + (queried : byte1Request kind input outputs ∈ queries) : + input.n < 256 ∧ outputs = kind.result input := by + obtain ⟨provider, member, same, _⟩ := exactLookupBalance_provider balanced bounded queried + obtain ⟨providerKind, _, rowMember⟩ := List.mem_flatMap.mp member + obtain ⟨row, equal⟩ := List.mem_ofFn.mp rowMember + subst provider + change byte1Request providerKind (G.ofNat row.val) (byte1Outputs providerKind row) = + byte1Request kind input outputs at same + obtain ⟨sameChannel, sameTail⟩ := List.cons.inj same + have equalKind := Byte1Kind.channel_injective sameChannel + subst providerKind + obtain ⟨sameInput, sameOutputs⟩ := List.cons.inj sameTail + have below : row.val < gSize.toNat := Nat.lt_trans row.isLt (by decide) + constructor + · rw [← sameInput, G.n_ofNat, Nat.mod_eq_of_lt below] + exact row.isLt + · rw [← sameInput] + exact (Array.toList_inj.mp sameOutputs).symm.trans (byte1Outputs_correct kind row) + +inductive Byte2Kind where + | xor | add | sub | and | or | lessThan | range | mul | split7 | split4 + deriving DecidableEq + +def Byte2Kind.all : List Byte2Kind := + [.xor, .add, .sub, .and, .or, .lessThan, .range, .mul, .split7, .split4] + +def Byte2Kind.channel : Byte2Kind → G + | .xor => 5 + | .add => 6 + | .sub => 7 + | .and => 8 + | .or => 9 + | .lessThan => 10 + | .range => 11 + | .mul => 12 + | .split7 => 13 + | .split4 => 14 + +theorem Byte2Kind.channel_injective {left right : Byte2Kind} + (same : left.channel = right.channel) : left = right := by + revert same + cases left <;> cases right <;> decide +kernel + +def Byte2Kind.result : Byte2Kind → G → G → Array G + | .xor, x, y => #[G.u8Xor x y] + | .add, x, y => #[(G.u8Add x y).1] + | .sub, x, y => #[(G.u8Sub x y).1] + | .and, x, y => #[G.u8And x y] + | .or, x, y => #[G.u8Or x y] + | .lessThan, x, y => #[G.u8LessThan x y] + | .range, _, _ => #[] + | .mul, x, y => Bytecode.AIR.pairValues (G.u8Mul x y) + | .split7, x, y => #[G.ofNat ((x.n ^^^ y.n) / 128), G.ofNat (((x.n ^^^ y.n) * 2) % 256)] + | .split4, x, y => #[G.ofNat ((x.n ^^^ y.n) / 16), G.ofNat (((x.n ^^^ y.n) * 16) % 256)] + +def byte2Outputs (kind : Byte2Kind) (row : Fin 65536) : Array G := + let x := row.val / 256 + let y := row.val % 256 + match kind with + | .xor => #[G.ofNat (x ^^^ y)] + | .add => #[G.ofNat ((x + y) % 256)] + | .sub => #[G.ofNat ((x + 256 - y) % 256)] + | .and => #[G.ofNat (x &&& y)] + | .or => #[G.ofNat (x ||| y)] + | .lessThan => #[if x < y then 1 else 0] + | .range => #[] + | .mul => #[G.ofNat ((x * y) % 256), G.ofNat ((x * y) / 256)] + | .split7 => #[G.ofNat ((x ^^^ y) / 128), G.ofNat (((x ^^^ y) * 2) % 256)] + | .split4 => #[G.ofNat ((x ^^^ y) / 16), G.ofNat (((x ^^^ y) * 16) % 256)] + +def byte2Request (kind : Byte2Kind) (x y : G) (outputs : Array G) : List G := + kind.channel :: x :: y :: outputs.toList + +def byte2Providers (weights : Byte2Kind → Fin 65536 → G) : List (Provider (List G)) := + Byte2Kind.all.flatMap fun kind => List.ofFn fun row => + let inputs := byteRangeMessage row + (byte2Request kind inputs.1 inputs.2 (byte2Outputs kind row), weights kind row) + +theorem byte2Outputs_correct (kind : Byte2Kind) (row : Fin 65536) : + byte2Outputs kind row = kind.result (byteRangeMessage row).1 (byteRangeMessage row).2 := by + have left : row.val / 256 < gSize.toNat := + Nat.lt_trans (show row.val / 256 < 256 by omega) (by decide) + have right : row.val % 256 < gSize.toNat := Nat.lt_trans (Nat.mod_lt _ (by decide)) (by decide) + cases kind <;> + simp only [byte2Outputs, Byte2Kind.result, byteRangeMessage, G.u8Xor, G.u8Add, + G.u8Sub, G.u8And, G.u8Or, G.u8LessThan, G.u8Mul, Bytecode.AIR.pairValues, + G.n_ofNat, Nat.mod_eq_of_lt left, Nat.mod_eq_of_lt right] + +theorem exactLookupBalance_byte2 {queries : List (List G)} + (weights : Byte2Kind → Fin 65536 → G) + (balanced : ExactLookupBalance queries (byte2Providers weights)) + (bounded : queries.length < gSize.toNat) + {kind : Byte2Kind} {x y : G} {outputs : Array G} + (queried : byte2Request kind x y outputs ∈ queries) : + x.n < 256 ∧ y.n < 256 ∧ outputs = kind.result x y := by + obtain ⟨provider, member, same, _⟩ := exactLookupBalance_provider balanced bounded queried + obtain ⟨providerKind, _, rowMember⟩ := List.mem_flatMap.mp member + obtain ⟨row, equal⟩ := List.mem_ofFn.mp rowMember + subst provider + change byte2Request providerKind (byteRangeMessage row).1 (byteRangeMessage row).2 + (byte2Outputs providerKind row) = byte2Request kind x y outputs at same + obtain ⟨sameChannel, sameTail⟩ := List.cons.inj same + have equalKind := Byte2Kind.channel_injective sameChannel + subst providerKind + obtain ⟨sameX, sameTail⟩ := List.cons.inj sameTail + obtain ⟨sameY, sameOutputs⟩ := List.cons.inj sameTail + rw [← sameX, ← sameY] + refine ⟨(byteRangeMessage_bounded row).1, (byteRangeMessage_bounded row).2, ?_⟩ + exact (Array.toList_inj.mp sameOutputs).symm.trans (byte2Outputs_correct kind row) + +def Byte1Kind.op : Byte1Kind → Bytecode.ValIdx → Bytecode.Op + | .bits => .u8BitDecomposition + | .shiftLeft => .u8ShiftLeft + | .shiftRight => .u8ShiftRight + +theorem byte1_primitive {kind : Byte1Kind} {values : Array G} {index : Bytecode.ValIdx} + {input : G} (read : values[index]? = some input) (bounded : input.n < 256) : + Bytecode.AIR.primitive (kind.op index) values #[] = some (kind.result input) := by + cases kind <;> + simp only [Byte1Kind.op, Byte1Kind.result, Bytecode.AIR.primitive, + Bytecode.AIR.unaryByte, read, bind, Option.bind, if_pos bounded, Function.comp_apply] + +theorem exactLookupBalance_byte1_step {queries : List (List G)} + (weights : Byte1Kind → Fin 256 → G) + (balanced : ExactLookupBalance queries (byte1Providers weights)) + (bounded : queries.length < gSize.toNat) + (memory : Bytecode.AIR.Memory) {kind : Byte1Kind} {values : Array G} + {index : Bytecode.ValIdx} {input : G} {outputs : Array G} + (read : values[index]? = some input) + (queried : byte1Request kind input outputs ∈ queries) : + Bytecode.AIR.Step memory (kind.op index) values (values ++ outputs) [] := by + obtain ⟨range, correct⟩ := exactLookupBalance_byte1 weights balanced bounded queried + apply Bytecode.AIR.Step.primitive (advice := #[]) + rw [correct] + exact byte1_primitive read range + +def Byte2Kind.op : Byte2Kind → Bytecode.ValIdx → Bytecode.ValIdx → Bytecode.Op + | .xor => .u8Xor + | .add => .u8Add + | .sub => .u8Sub + | .and => .u8And + | .or => .u8Or + | .lessThan => .u8LessThan + | .range => .u8RangeCheck + | .mul => .u8Mul + | .split7 => .u8XorSplit7 + | .split4 => .u8XorSplit4 + +def Byte2Kind.extendOutputs (kind : Byte2Kind) (x y : G) (outputs : Array G) : Array G := + match kind with + | .add => outputs.push ((x + y - outputs[0]?.getD 0) * inverse256) + | .sub => outputs.push ((outputs[0]?.getD 0 + y - x) * inverse256) + | _ => outputs + +theorem byte2_primitive {kind : Byte2Kind} {values : Array G} {left right : Bytecode.ValIdx} + {x y : G} (readX : values[left]? = some x) (readY : values[right]? = some y) + (hx : x.n < 256) (hy : y.n < 256) : + Bytecode.AIR.primitive (kind.op left right) values #[] = + some (kind.extendOutputs x y (kind.result x y)) := by + cases kind <;> + simp only [Byte2Kind.op, Byte2Kind.result, Byte2Kind.extendOutputs, + Bytecode.AIR.primitive, Bytecode.AIR.binaryByte, readX, readY, + bind, Option.bind, if_pos (And.intro hx hy)] + · simp only [G.u8Add, Bytecode.AIR.pairValues, Array.getElem?_singleton, ite_true, Option.getD_some] + rw [byte_add_carry hx hy rfl] + rfl + · simp only [G.u8Sub, Bytecode.AIR.pairValues, Array.getElem?_singleton, ite_true, Option.getD_some] + rw [byte_sub_borrow hx hy rfl] + rfl + +theorem exactLookupBalance_byte2_step {queries : List (List G)} + (weights : Byte2Kind → Fin 65536 → G) + (balanced : ExactLookupBalance queries (byte2Providers weights)) + (bounded : queries.length < gSize.toNat) + (memory : Bytecode.AIR.Memory) {kind : Byte2Kind} {values : Array G} + {left right : Bytecode.ValIdx} {x y : G} {outputs : Array G} + (readX : values[left]? = some x) (readY : values[right]? = some y) + (queried : byte2Request kind x y outputs ∈ queries) : + Bytecode.AIR.Step memory (kind.op left right) values + (values ++ kind.extendOutputs x y outputs) [] := by + obtain ⟨rangeX, rangeY, correct⟩ := exactLookupBalance_byte2 weights balanced bounded queried + apply Bytecode.AIR.Step.primitive (advice := #[]) + rw [correct] + exact byte2_primitive readX readY rangeX rangeY + +theorem active_u32_less_than_step (memory : Bytecode.AIR.Memory) + {selector a b : G} {values : Array G} {left right : Bytecode.ValIdx} + (active : selector = 1) (readA : values[left]? = some a) (readB : values[right]? = some b) + (x y z : Fin 4 → G) + (hx : ∀ i, (x i).n < 256) (hy : ∀ i, (y i).n < 256) (hz : ∀ i, (z i).n < 256) + (decomposeA : selector * (a - pack4 x) = 0) + (decomposeB : selector * (b - pack4 z) = 0) + (carries : ∀ i : Fin 4, selector * booleanConstraint (u32Carries x y z i.succ) = 0) : + Bytecode.AIR.Step memory (.u32LessThan left right) values + (values ++ #[1 - u32Carries x y z 4]) [] := by + obtain ⟨rangeA, rangeB, correct⟩ := active_u32_less_than active x y z hx hy hz decomposeA decomposeB carries + apply Bytecode.AIR.Step.primitive (advice := #[]) + simp only [Bytecode.AIR.primitive, readA, readB, bind, Option.bind, if_pos (And.intro rangeA rangeB), correct] + +def byte1Preprocessed (row : Fin 256) : Array G := + #[G.ofNat row.val] ++ byte1Outputs .bits row ++ + byte1Outputs .shiftLeft row ++ byte1Outputs .shiftRight row + +def byte2Preprocessed (row : Fin 65536) : Array G := + let inputs := byteRangeMessage row + #[inputs.1, inputs.2] ++ byte2Outputs .xor row ++ byte2Outputs .add row ++ + byte2Outputs .sub row ++ byte2Outputs .and row ++ byte2Outputs .or row ++ + byte2Outputs .lessThan row ++ byte2Outputs .mul row ++ byte2Outputs .split7 row ++ + byte2Outputs .split4 row + +end Aiur.AIR diff --git a/Ix/Aiur/Proofs/CallInventory.lean b/Ix/Aiur/Proofs/CallInventory.lean new file mode 100644 index 000000000..69f790b63 --- /dev/null +++ b/Ix/Aiur/Proofs/CallInventory.lean @@ -0,0 +1,93 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.OperationRows + +/-! +Call inventories retain the exact function and gap queries and rank-order +polynomials emitted alongside each operation. Sequence composition preserves +this inventory. Active satisfying calls have strictly increasing bounded ranks +when their byte queries belong to the shared global lookup pool. +-/ + +namespace Aiur.AIR +open Bytecode + +/-- Every recorded call has its function query, all gap range queries and +its selector-gated rank-order equation in the same emission. -/ +def CallsEmitted (rank selector : G) (equations : List G) (queries : List (List G)) + (calls : List (Bytecode.AIR.Call × (Fin 6 → G))) : Prop := + ∀ edge ∈ calls, functionMessage edge.1 ∈ queries ∧ + (rankByteQueries edge.2).map rangeMessage ⊆ queries ∧ + selector * callOrderConstraint rank edge.1.rank (packRank edge.2) ∈ equations + +theorem emitOp_calls {row : Nat → G} {selector rank : G} {op : Op} + {values : Array RowValue} {emission : OpEmission} + (emitted : emitOp row selector rank op values = some emission) : + CallsEmitted rank selector emission.equations emission.queries emission.calls := by + cases op <;> simp only [emitOp, emitByte1, emitByte2, emitU32LessThan, emitU32Add, + emitAdvice, bind, Option.bind, Option.map, pure] at emitted + all_goals + repeat' first + | split at emitted + | (dsimp only at emitted; split at emitted) + all_goals cases emitted + all_goals simp [CallsEmitted] + +theorem CallsEmitted.append {rank selector : G} {firstEquations restEquations : List G} + {firstQueries restQueries : List (List G)} + {firstCalls restCalls : List (Bytecode.AIR.Call × (Fin 6 → G))} + (first : CallsEmitted rank selector firstEquations firstQueries firstCalls) + (rest : CallsEmitted rank selector restEquations restQueries restCalls) : + CallsEmitted rank selector (firstEquations ++ restEquations) + (firstQueries ++ restQueries) (firstCalls ++ restCalls) := by + intro edge member + rcases List.mem_append.mp member with left | right + · obtain ⟨query, bytes, equation⟩ := first edge left + exact ⟨List.mem_append_left _ query, + fun _ member => List.mem_append_left _ (bytes member), + List.mem_append_left _ equation⟩ + · obtain ⟨query, bytes, equation⟩ := rest edge right + exact ⟨List.mem_append_right _ query, + fun _ member => List.mem_append_right _ (bytes member), + List.mem_append_right _ equation⟩ + +theorem emitOps_calls {row : Nat → G} {selector rank : G} {ops : List Op} + {values : Array RowValue} {column : Nat} {emission : OpsEmission} + (emitted : emitOps row selector rank ops values column = some emission) : + CallsEmitted rank selector emission.equations emission.queries emission.calls := by + induction ops generalizing values column emission with + | nil => + simp only [emitOps, Option.some.injEq] at emitted + subst emission + simp [CallsEmitted] + | cons op ops ih => + simp only [emitOps, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i first firstEmitted + dsimp only at emitted + split at emitted + · cases emitted + · rename_i rest restEmitted + have equal := Option.some.inj emitted + subst emission + exact (emitOp_calls firstEmitted).append (ih restEmitted) + +theorem CallsEmitted.ordered {tables : LookupTables} {width : Nat} {pool : List (List G)} + (global : GlobalLookups tables width pool) + {rank selector : G} {equations : List G} {queries : List (List G)} + {calls : List (Bytecode.AIR.Call × (Fin 6 → G))} + (tracked : CallsEmitted rank selector equations queries calls) + (active : selector = 1) (satisfied : ∀ equation ∈ equations, equation = 0) + (queried : queries ⊆ pool) (rankBound : rank.n < callRankBound) + {edge : Bytecode.AIR.Call × (Fin 6 → G)} (called : edge ∈ calls) + (childBound : edge.1.rank.n < callRankBound) : + functionMessage edge.1 ∈ pool ∧ rank.n < edge.1.rank.n := by + obtain ⟨query, bytes, equation⟩ := tracked edge called + refine ⟨queried query, active_call_order_strict active rankBound childBound ?_ (satisfied _ equation)⟩ + exact packRank_lt edge.2 (global.rank_bytes edge.2 (fun _ member => queried (bytes member))) + +end Aiur.AIR diff --git a/Ix/Aiur/Proofs/CallOrder.lean b/Ix/Aiur/Proofs/CallOrder.lean new file mode 100644 index 000000000..5fde65ca6 --- /dev/null +++ b/Ix/Aiur/Proofs/CallOrder.lean @@ -0,0 +1,143 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.Activity + +/-! Arithmetic for the call-order AIR. Each active function row carries a +48-bit rank. A constrained call binds the callee's rank in its function +lookup and supplies a 48-bit gap satisfying `child - parent - 1 - gap = 0`. +The bounds prevent field wraparound and force strict increase. Connecting +the byte-table lookups and native constraint emitter to these premises is +part of the remaining AIR extraction proof. +-/ + +namespace Aiur + +theorem G.n_ofNat (n : Nat) : (G.ofNat n).n = n % gSize.toNat := by + have hm : n % gSize.toNat < gSize.toNat := Nat.mod_lt _ (by decide) + have hw : n % gSize.toNat < UInt64.size := Nat.lt_trans hm (by decide) + have hv : (n % gSize.toNat).toUInt64.toNat = n % gSize.toNat := by + simp [Nat.toUInt64, Nat.mod_eq_of_lt hw] + have h : (n % gSize.toNat).toUInt64 < gSize := by + simpa only [UInt64.lt_iff_toNat_lt, hv] using hm + simp only [G.ofNat, dif_pos h, G.n, hv] + +theorem G.sub_eq_zero_iff (a b : G) : a - b = 0 ↔ a = b := by + have ha : a.n < gSize.toNat := UInt64.lt_iff_toNat_lt.mp a.property + have hb : b.n < gSize.toNat := UInt64.lt_iff_toNat_lt.mp b.property + have hp : gSize.toNat = 18446744069414584321 := by decide + constructor + · intro h + have hn := congrArg G.n h + change (G.ofNat (a.n + gSize.toNat - b.n)).n = 0 at hn + rw [G.n_ofNat, hp] at hn + rw [hp] at ha hb + have he : a.n = b.n := by omega + apply Subtype.ext + exact UInt64.toNat_inj.mp he + · intro h + subst b + change G.ofNat (a.n + gSize.toNat - a.n) = 0 + simp only [Nat.add_sub_cancel_left] + rfl + +theorem G.n_add (a b : G) : (a + b).n = (a.n + b.n) % gSize.toNat := + G.n_ofNat _ + +theorem G.n_mul (a b : G) : (a * b).n = (a.n * b.n) % gSize.toNat := + G.n_ofNat _ + +namespace AIR + +def callRankBound : Nat := 2 ^ 48 + +/-- The six little-endian byte expressions used by the Rust emitter. -/ +def packRank (bytes : Fin 6 → G) : G := + bytes 0 + 256 * bytes 1 + 65536 * bytes 2 + 16777216 * bytes 3 + + 4294967296 * bytes 4 + 1099511627776 * bytes 5 + +theorem packRank_lt (bytes : Fin 6 → G) (bounded : ∀ i, (bytes i).n < 256) : + (packRank bytes).n < callRankBound := by + have h0 := bounded 0 + have h1 := bounded 1 + have h2 := bounded 2 + have h3 := bounded 3 + have h4 := bounded 4 + have h5 := bounded 5 + have c1 : (256 : G).n = 256 := rfl + have c2 : (65536 : G).n = 65536 := rfl + have c3 : (16777216 : G).n = 16777216 := rfl + have c4 : (4294967296 : G).n = 4294967296 := rfl + have c5 : (1099511627776 : G).n = 1099511627776 := rfl + simp only [packRank, G.n_add, G.n_mul, c1, c2, c3, c4, c5] + have modulus : gSize.toNat = 18446744069414584321 := by decide + rw [modulus] + simp only [Nat.add_mod_mod, Nat.mod_add_mod] + apply Nat.lt_of_le_of_lt (Nat.mod_le _ _) + unfold callRankBound + omega + +/-- Exact active-call polynomial, before selector gating. -/ +def callOrderConstraint (parent child gap : G) : G := + child - parent - 1 - gap + +theorem call_order_strict {parent child gap : G} + (hp : parent.n < callRankBound) (hc : child.n < callRankBound) + (hg : gap.n < callRankBound) + (satisfied : callOrderConstraint parent child gap = 0) : + parent.n < child.n := by + have h1 : child - parent - 1 = gap := + (G.sub_eq_zero_iff _ _).mp satisfied + have h := congrArg G.n h1 + change (G.ofNat ((G.ofNat (child.n + gSize.toNat - parent.n)).n + + gSize.toNat - 1)).n = gap.n at h + simp only [G.n_ofNat] at h + have modulus : gSize.toNat = 18446744069414584321 := by decide + rw [modulus] at h + unfold callRankBound at hp hc hg + omega + +theorem call_order_irrefl (rank gap : G) (hr : rank.n < callRankBound) + (hg : gap.n < callRankBound) : callOrderConstraint rank rank gap ≠ 0 := by + intro h + exact Nat.lt_irrefl _ (call_order_strict hr hr hg h) + +theorem active_call_order_strict {selector parent child gap : G} + (active : selector = 1) + (hp : parent.n < callRankBound) (hc : child.n < callRankBound) + (hg : gap.n < callRankBound) + (satisfied : selector * callOrderConstraint parent child gap = 0) : + parent.n < child.n := by + rw [active, G.mul_comm, G.mul_one] at satisfied + exact call_order_strict hp hc hg satisfied + +/-- Range-checked bytes suffice for the rank bounds in an active call. -/ +theorem packed_call_order_strict (parent child gap : Fin 6 → G) + (hp : ∀ i, (parent i).n < 256) (hc : ∀ i, (child i).n < 256) + (hg : ∀ i, (gap i).n < 256) + (satisfied : callOrderConstraint (packRank parent) (packRank child) (packRank gap) = 0) : + (packRank parent).n < (packRank child).n := + call_order_strict (packRank_lt parent hp) (packRank_lt child hc) + (packRank_lt gap hg) satisfied + +/-- Any call relation satisfying the bounded-rank constraints is well founded. +The relation is oriented `calls child parent`, as required by recursion. -/ +theorem call_relation_wellFounded {α : Sort u} (rank : α → G) + (bounded : ∀ node, (rank node).n < callRankBound) (calls : α → α → Prop) + (ordered : ∀ child parent, calls child parent → + ∃ gap : G, gap.n < callRankBound ∧ + callOrderConstraint (rank parent) (rank child) gap = 0) : + WellFounded calls := by + apply Subrelation.wf (r := fun child parent => + callRankBound - (rank child).n < callRankBound - (rank parent).n) + (fun {child parent} h => ?_) + (InvImage.wf (fun node => callRankBound - (rank node).n) Nat.lt_wfRel.wf) + obtain ⟨gap, hg, hs⟩ := ordered child parent h + have strict := call_order_strict (bounded parent) (bounded child) hg hs + have limit := bounded child + omega + +end AIR +end Aiur diff --git a/Ix/Aiur/Proofs/CircuitMembership.lean b/Ix/Aiur/Proofs/CircuitMembership.lean new file mode 100644 index 000000000..78fea71fc --- /dev/null +++ b/Ix/Aiur/Proofs/CircuitMembership.lean @@ -0,0 +1,234 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.CircuitTraces +import Ix.Aiur.Proofs.Grouping +import Std.Tactic.Do + +/-! The actual compiler and successful grouping produce only constrained +circuit members. The selected backend's program shape check therefore +discharges the shape condition for every successfully emitted trace row. +Physical lookup bounds, native extraction and the cryptographic and +source-semantic endpoint remain separate proof obligations. -/ + +open Std.Do +namespace Aiur.Bytecode + +def MembersConstrained (functions : Array Function) (members : Array FunIdx) : Prop := + ∀ index ∈ members, ∃ function, functions[index]? = some function ∧ function.constrained = true + +def CircuitsConstrained (functions : Array Function) (circuits : Array Circuit) : Prop := + ∀ circuit ∈ circuits, MembersConstrained functions circuit.members + +private theorem circuits_empty (functions : Array Function) : CircuitsConstrained functions #[] := by + simp [CircuitsConstrained] + +private theorem circuits_push {functions : Array Function} {circuits : Array Circuit} {circuit : Circuit} + (before : CircuitsConstrained functions circuits) (member : MembersConstrained functions circuit.members) : + CircuitsConstrained functions (circuits.push circuit) := by + intro c present + rcases Array.mem_push.mp present with prior | equal + · exact before c prior + · subst c; exact member + +private theorem member_singleton {functions : Array Function} {index : FunIdx} {function : Function} + (present : functions[index]? = some function) (constrained : function.constrained = true) : + MembersConstrained functions #[index] := by + intro i member + have equal : i = index := by simpa using member + subst i + exact ⟨function, present, constrained⟩ + +private theorem members_empty (functions : Array Function) : MembersConstrained functions #[] := by + simp [MembersConstrained] + +private theorem members_push {functions : Array Function} {members : Array FunIdx} {index : FunIdx} + (before : MembersConstrained functions members) (constrained : functions[index]!.constrained = true) : + MembersConstrained functions (members.push index) := by + intro i member + rcases Array.mem_push.mp member with prior | equal + · exact before i prior + · subst i + by_cases bound : index < functions.size + · exact ⟨functions[index], Array.getElem?_eq_getElem bound, + by simpa only [getElem!_pos functions index bound] using constrained⟩ + · rw [getElem!_neg functions index bound] at constrained + contradiction + +private theorem array_bang_valid {α : Type} [Inhabited α] (property : α → Prop) + {array : Array α} (valid : ∀ value ∈ array, property value) (fallback : property default) (index : Nat) : + property array[index]! := by + by_cases bound : index < array.size + · rw [getElem!_pos array index bound] + exact valid _ (Array.getElem_mem bound) + · rw [getElem!_neg array index bound] + exact fallback + +private theorem array_split_member {α : Type} {array : Array α} {pref suff : List α} {value : α} + (split : array.toList = pref ++ value :: suff) : value ∈ array := by + apply Array.mem_toList_iff.mp + rw [split] + simp + +set_option mvcgen.warning false in +theorem singletonCircuits_constrained (program : Toplevel) (nameOf : FunIdx → String) : + CircuitsConstrained program.functions (program.singletonCircuits nameOf) := by + have spec : Triple (m := Id) (program.singletonCircuits nameOf) ⌜True⌝ + (⇓ circuits => ⌜CircuitsConstrained program.functions circuits⌝) := by + mvcgen [Toplevel.singletonCircuits, Id.run] invariants + · ⇓⟨_, circuits⟩ => ⌜CircuitsConstrained program.functions circuits⌝ + case vc1.step.isTrue => + apply circuits_push (by assumption) + apply member_singleton (Array.getElem?_eq_getElem _) + assumption + case vc3.pre => exact circuits_empty _ + exact Id.of_wp_run_eq rfl _ spec + +end Aiur.Bytecode + +namespace Aiur +open Bytecode + +-- The library's corresponding specification has unused monad parameters. +-- This specialization keeps loop verification conditions fully determined. +private theorem throw_except {ε α : Type} {error : ε} {post : PostCond α (.except ε .pure)} : + Triple (ps := .except ε .pure) (throw error : Except ε α) (spred(post.2.1 error)) post := by + simp [Triple.iff] + +set_option mvcgen.warning false in +theorem CompiledToplevel.groupFunctions_constrained {before after : CompiledToplevel} + {groups : Array (String × Array String)} + (valid : CircuitsConstrained before.bytecode.functions before.bytecode.circuits) + (accepted : before.groupFunctions groups = .ok after) : + CircuitsConstrained after.bytecode.functions after.bytecode.circuits := by + have spec : ⦃⌜True⌝⦄ before.groupFunctions groups + ⦃post⟨fun compiled => ⌜CircuitsConstrained compiled.bytecode.functions compiled.bytecode.circuits⌝, + fun _ => ⌜True⌝⟩⦄ := by + mvcgen [CompiledToplevel.groupFunctions, -Spec.throw_Except, throw_except] invariants + · post⟨fun ⟨_, _, resolved⟩ => ⌜∀ pair ∈ resolved, + MembersConstrained before.bytecode.functions pair.2⌝, fun _ => ⌜True⌝⟩ + · post⟨fun ⟨_, _, members⟩ => ⌜MembersConstrained before.bytecode.functions members⌝, + fun _ => ⌜True⌝⟩ + · post⟨fun ⟨_, circuits, _⟩ => ⌜CircuitsConstrained before.bytecode.functions circuits⌝, + fun _ => ⌜True⌝⟩ + case vc4.step.h_1.isTrue.isFalse.isFalse => exact members_push (by assumption) (by assumption) + case vc7.step.isFalse.pre => exact members_empty _ + case vc8.step.isFalse.post.success => + intro pair member + rcases Array.mem_push.mp member with prior | equal + · apply_assumption; exact prior + · subst pair; assumption + case vc10.pre => + change ∀ pair ∈ (#[] : Array (String × Array FunIdx)), _ + simp + case vc11.step.isTrue.h_1 => + apply circuits_push (by assumption) + apply valid + exact array_split_member (by assumption) + case vc13.step.isTrue.h_2.isFalse => + apply circuits_push (by assumption) + exact array_bang_valid (fun pair : String × Array FunIdx => + MembersConstrained before.bytecode.functions pair.2) (by assumption) (members_empty _) _ + case vc15.post.success.pre => exact circuits_empty _ + exact Except.of_wp_eq accepted (fun result => match result with + | .error _ => True + | .ok compiled => CircuitsConstrained compiled.bytecode.functions compiled.bytecode.circuits) spec + +theorem finishCompilation_circuits_constrained (source : Source.Toplevel) (raw : Bytecode.Toplevel) + (names : Std.HashMap Global Bytecode.FunIdx) : + CircuitsConstrained (finishCompilation source raw names).bytecode.functions + (finishCompilation source raw names).bytecode.circuits := by + unfold finishCompilation + exact singletonCircuits_constrained _ _ + +theorem Source.Toplevel.compile_circuits_constrained {source : Source.Toplevel} {compiled : CompiledToplevel} + (accepted : source.compile = .ok compiled) : + CircuitsConstrained compiled.bytecode.functions compiled.bytecode.circuits := by + obtain ⟨inlined, typed, concrete, raw, names, _, _, _, _, artifact⟩ := + source.compile_artifact_of_ok accepted + rw [artifact] + exact finishCompilation_circuits_constrained inlined raw names + +theorem BoundVerifier.Backend.circuits_constrained {selection : BoundVerifier.Selection} + (backend : BoundVerifier.Backend selection) : + CircuitsConstrained backend.compiled.bytecode.functions backend.compiled.bytecode.circuits := by + obtain ⟨initial, compiled, grouped⟩ := backend.compilation_stages + have valid := Source.Toplevel.compile_circuits_constrained compiled + split at grouped + · cases grouped + exact valid + · exact CompiledToplevel.groupFunctions_constrained valid grouped + +end Aiur + +namespace Aiur.Bytecode + +theorem Toplevel.validateLookupShapes_function {program : Toplevel} + (valid : program.validateLookupShapes = true) {function : Function} {index : FunIdx} + (present : program.functions[index]? = some function) (constrained : function.constrained = true) : + function.body.lookupShapes program none = true := by + simp only [Toplevel.validateLookupShapes, Bool.and_eq_true] at valid + have checked := Array.all_eq_true'.mp valid.2.2 function (Array.mem_of_getElem? present) + simpa only [constrained, Bool.not_true, Bool.false_or] using checked + +end Aiur.Bytecode + +namespace Aiur.AIR +open Bytecode + +theorem CircuitWitness.shapes_of_compiled {program : Toplevel} + (shapes : program.validateLookupShapes = true) + (constrained : CircuitsConstrained program.functions program.circuits) + (witness : CircuitWitness) (circuit : witness.circuit ∈ program.circuits) + (emitted : witness.Emitted program) : witness.Shapes program := by + obtain ⟨_, indices, source⟩ := witness.circuit.emitRow_spec witness.values program emitted + intro part member + have index : part.functionIndex ∈ witness.circuit.members := by + apply Array.mem_toList_iff.mp + rw [← indices] + exact List.mem_map.mpr ⟨part, member, rfl⟩ + obtain ⟨function, present, isConstrained⟩ := constrained witness.circuit circuit part.functionIndex index + have equal := Option.some.inj (present.symm.trans (source part member).present) + subst function + exact Toplevel.validateLookupShapes_function shapes present isConstrained + +end Aiur.AIR + +namespace Aiur.BoundVerifier +open AIR Bytecode.AIR + +theorem Backend.witness_shapes {selection : Selection} (backend : Backend selection) + (witness : CircuitWitness) (circuit : witness.circuit ∈ backend.compiled.bytecode.circuits) + (emitted : witness.Emitted backend.compiled.bytecode) : witness.Shapes backend.compiled.bytecode := + witness.shapes_of_compiled backend.lookupShapes backend.circuits_constrained circuit emitted + +theorem Backend.compiled_trace_execution {selection : Selection} (backend : Backend selection) + (tables : AuxiliaryTables) (traces : CircuitTraces backend.compiled.bytecode.circuits.toList) + {witnesses : List CircuitWitness} + (emitted : traces.emitWitnesses backend.compiled.bytecode = some witnesses) + {otherSlots : List Nat} {otherActive : List Bool} {otherDegrees : List Nat} {result : Nat} + (budget : lookupQueryBound + (backend.compiled.bytecode.circuits.toList.map (·.layout.lookups) ++ otherSlots) + (traces.bitmap ++ otherActive) (traces.degrees ++ otherDegrees) = some result) + (width : Nat) (input : Array G) (arity : input.size = selection.inputSize) + (balanced : PaddedLookupBalance width + ((buildClaim selection.function input selection.success).toList :: + encodedCircuitQueryPool (witnesses.map (·.emission))) + (tables.circuitProviders (witnesses.map (·.emission)))) + (publicWidth : (buildClaim selection.function input selection.success).size + 1 ≤ width) + (queryWidths : ∀ query ∈ encodedCircuitQueryPool (witnesses.map (·.emission)), query.length ≤ width) + (memoryValid : ∀ size, MemoryRowsValid size (tables.memory size)) + (canonical : ∀ size ∈ tables.memoryWidths, size < gSize.toNat) + (satisfied : ∀ witness ∈ witnesses, witness.Satisfied) + (limits : ∀ witness ∈ witnesses, witness.LookupBounds) : + Execution backend.compiled.bytecode (memoryFacts tables.memory) + ⟨selection.function, input, selection.success, 0⟩ := by + have valid := (traces.emitWitnesses_spec emitted).1 + apply backend.trace_circuit_execution tables traces emitted budget width input arity balanced + publicWidth queryWidths memoryValid canonical satisfied _ limits + intro witness member + exact backend.witness_shapes witness (by simpa using (valid witness member).1) (valid witness member).2 + +end Aiur.BoundVerifier diff --git a/Ix/Aiur/Proofs/CircuitPoolExecution.lean b/Ix/Aiur/Proofs/CircuitPoolExecution.lean new file mode 100644 index 000000000..a27a2537c --- /dev/null +++ b/Ix/Aiur/Proofs/CircuitPoolExecution.lean @@ -0,0 +1,114 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.CircuitRowReturns + +/-! +A nonzero provider row of the valued circuit model yields a valid +function row from the same bytecode program. The interpreted inputs, rank +bytes and multiplicity agree with the circuit, and its padded provider +message names that same semantic call. All selected call and rank-byte +queries belong to any ambient pool containing the computed circuit pool. + +Exact global lookup balance, memory validity, shape and count/layout bounds +remain explicit. This is not yet extraction from native public verification. +-/ + +namespace Aiur.Bytecode +open Aiur.AIR + +theorem Circuit.emitRow_valid_in_pool {tables : LookupTables} {width : Nat} {emissions : List CircuitEmission} {queries : List (List G)} + (global : GlobalLookups tables width queries) + (memoryValid : ∀ size, MemoryRowsValid size (tables.memory size)) + (canonical : ∀ size ∈ tables.memoryWidths, size < gSize.toNat) + (row : Nat → G) (program : Toplevel) (circuit : Circuit) + {emission : CircuitEmission} (emitted : circuit.emitRow row program = some emission) + (member : emission ∈ emissions) + (pooled : circuitQueryPool emissions ⊆ queries) + (bounded : circuit.members.size < gSize.toNat) + (bounds : ∀ part ∈ emission.members, part.function.body.rowBounds (part.selector row)) + (shape : ∀ part ∈ emission.members, part.function.body.lookupShapes program none = true) + (returnBound : ∀ part ∈ emission.members, + (part.function.body.selectorFlow (part.selector row)).returns.length < gSize.toNat) + (reserved : 4 ≤ circuit.layout.lookups) + (limits : ∀ part ∈ emission.members, part.body.lookup ≤ circuit.layout.lookups) + (single : emission.branchless = true → emission.returns.length ≤ 1) + (satisfied : ∀ equation ∈ emission.equations, equation = 0) + (nonzero : emission.multiplicity ≠ 0) : + ∃ selected ∈ emission.members, ∃ interpreted : FunctionRow, + interpreted.Valid program (memoryFacts tables.memory) ∧ + interpreted.request.function = selected.functionIndex ∧ + interpreted.request.inputs = rowValues (rowAdvice row 0 selected.function.layout.inputSize) ∧ + interpreted.request.rank = packRank emission.rankBytes ∧ + interpreted.rankBytes = emission.rankBytes ∧ + interpreted.selector = emission.selector ∧ interpreted.multiplicity = emission.multiplicity ∧ + (1, interpreted.request) ∈ emission.returns ∧ + padMessage width (emission.lookup 0).2 = padMessage width (functionMessage interpreted.request) ∧ + selected.body.CallsAt interpreted.calls ∧ + (interpreted.requests.map functionMessage) ⊆ queries ∧ + (interpreted.byteQueries.map rangeMessage) ⊆ queries := by + obtain ⟨description, indices, source⟩ := circuit.emitRow_spec row program emitted + have count := congrArg List.length indices + simp only [List.length_map, Array.length_toList] at count + have valid : ∀ equation ∈ (circuitEmission row circuit emission.members).equations, equation = 0 := by + rw [← description] + exact satisfied + have slots := circuit.emitRow_querySlots row program emitted bounded bounds reserved limits satisfied + have inCircuit := slots.circuit_pool member + have queried : emission.QueriesIn queries := fun query present active => + pooled (inCircuit query present active) + have wholeQueried : (circuitEmission row circuit emission.members).QueriesIn queries := by + rw [← description] + exact queried + have activity := circuitEmission_activity valid + rw [← description] at activity + have active := nonzero_multiplicity_selector_one activity nonzero + obtain ⟨selected, selectedMember, selectedActive, selectedSource⟩ := + circuit.emitRow_active_member row program emitted satisfied bounded nonzero + have bodySatisfied := circuitEmission_member_satisfied valid selectedMember + have bodyQueried := circuitEmission_member_queried wholeQueried selectedMember + have selectedActivity : activityConstraint emission.multiplicity + (selected.function.body.selectorFlow (selected.selector row)).entry = 0 := by + change activityConstraint emission.multiplicity (selected.entry row) = 0 + rw [selectedActive] + rw [active] at activity + exact activity + obtain ⟨interpreted, interpretedValid, returned, functionEq, inputsEq, rankEq, + rankBytesEq, selectorEq, multiplicityEq, called, inventory⟩ := + selected.function.emitRow_valid global memoryValid canonical program row (selected.selector row) + selected.functionIndex emission.rankBytes (rowAdvice row 0 selected.function.layout.inputSize) + _ 4 selectedSource.present (by simp only [rowAdvice, Array.size_ofFn]) + (shape selected selectedMember) (bounds selected selectedMember) selectedSource.emitted + emission.multiplicity nonzero selectedActivity bodySatisfied bodyQueried + have returnMember : (1, interpreted.request) ∈ emission.returns := by + have returnsEq := congrArg CircuitEmission.returns description + rw [returnsEq] + exact List.mem_flatMap.mpr ⟨selected, selectedMember, returned⟩ + have message := circuitEmission_return_message source shape (by omega) returnBound valid + (by rw [← description]; exact active) width + (by rw [← description]; exact single) + (by rw [← description]; exact returnMember) + rw [← description] at message + have headers := circuitEmission_rank_queried wholeQueried (by rw [← description]; exact active) + rw [← description] at headers + refine ⟨selected, selectedMember, interpreted, interpretedValid, functionEq, inputsEq, + rankEq, rankBytesEq, ?_, multiplicityEq, returnMember, message, called, ?_, ?_⟩ + · exact selectorEq.trans (selectedActive.trans active.symm) + · intro message member + simp only [FunctionRow.requests, List.map_map, List.mem_map, Function.comp_def] at member + obtain ⟨edge, edgeMember, equal⟩ := member + rw [← equal] + exact (inventory edge edgeMember).1 + · intro message member + rw [FunctionRow.byteQueries, List.map_append] at member + rcases List.mem_append.mp member with header | gap + · rw [rankBytesEq] at header + exact headers header + · obtain ⟨pair, pairMember, messageEq⟩ := List.mem_map.mp gap + obtain ⟨edge, edgeMember, pairMember⟩ := List.mem_flatMap.mp pairMember + rw [← messageEq] + exact (inventory edge edgeMember).2.1 (List.mem_map.mpr ⟨pair, pairMember, rfl⟩) + +end Aiur.Bytecode diff --git a/Ix/Aiur/Proofs/CircuitRowCounts.lean b/Ix/Aiur/Proofs/CircuitRowCounts.lean new file mode 100644 index 000000000..6304c6e6e --- /dev/null +++ b/Ix/Aiur/Proofs/CircuitRowCounts.lean @@ -0,0 +1,133 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.RowCounts + +/-! A successful circuit count check discharges all branch and terminal +count premises and the branchless single-return condition in row extraction. +Native expression reflection and the remaining layout obligations are separate. -/ + +namespace Aiur.Bytecode +open Aiur.AIR + +theorem Toplevel.validateRowCounts_circuit {program : Toplevel} + (validated : program.validateRowCounts = true) {circuit : Circuit} + (member : circuit ∈ program.circuits) : circuit.validateRowCounts program = true := by + rw [Toplevel.validateRowCounts, Array.all_eq_true'] at validated + exact validated circuit member + +private theorem mapM_of_members {α β γ : Type} (items : List α) (index : α → β) (value : α → γ) + (read : β → Option γ) (present : ∀ item ∈ items, read (index item) = some (value item)) : + (items.map index).mapM read = some (items.map value) := by + induction items with + | nil => rfl + | cons item rest ih => + simp only [List.map_cons, List.mapM_cons, present item List.mem_cons_self, + ih (fun item member => present item (List.mem_cons_of_mem _ member))] + rfl + +theorem Circuit.validateRowCounts_spec (row : Nat → G) (program : Toplevel) (circuit : Circuit) + {emission : CircuitEmission} (emitted : circuit.emitRow row program = some emission) + (validated : circuit.validateRowCounts program = true) : + circuit.members.size < gSize.toNat ∧ + (∀ part ∈ emission.members, part.function.body.controlCounts.nodes < gSize.toNat) ∧ + (emission.members.map (fun part => part.function.body.controlCounts.leaves)).sum ≤ circuit.layout.selectors := by + obtain ⟨_, indices, source⟩ := circuit.emitRow_spec row program emitted + have present := mapM_of_members emission.members (·.functionIndex) (·.function) + (fun index => program.functions[index]?) (fun part member => (source part member).present) + rw [indices] at present + rw [Circuit.validateRowCounts, present] at validated + simpa only [Bool.and_eq_true, decide_eq_true_eq, List.all_map, List.all_eq_true, + List.map_map, Function.comp_def] using validated + +private theorem flatMap_length_le_sum {α β : Type} (items : List α) (parts : α → List β) + (bound : α → Nat) (bounded : ∀ item ∈ items, (parts item).length ≤ bound item) : + (items.flatMap parts).length ≤ (items.map bound).sum := by + induction items with + | nil => exact Nat.le_refl _ + | cons first rest ih => + have head := bounded first List.mem_cons_self + have tail := ih (fun item member => bounded item (List.mem_cons_of_mem _ member)) + simp only [List.flatMap_cons, List.length_append, List.map_cons, List.sum_cons] + omega + +theorem Circuit.emitRow_count_bounds (row : Nat → G) (program : Toplevel) (circuit : Circuit) + {emission : CircuitEmission} (emitted : circuit.emitRow row program = some emission) + (validated : circuit.validateRowCounts program = true) + (satisfied : ∀ equation ∈ emission.equations, equation = 0) : + circuit.members.size < gSize.toNat ∧ + (∀ part ∈ emission.members, part.function.body.rowBounds (part.selector row)) ∧ + (∀ part ∈ emission.members, + (part.function.body.selectorFlow (part.selector row)).returns.length < gSize.toNat) ∧ + (emission.branchless = true → emission.returns.length ≤ 1) := by + obtain ⟨bounded, nodes, leaves⟩ := circuit.validateRowCounts_spec row program emitted validated + refine ⟨bounded, ?_, ?_, ?_⟩ + · intro part member + exact part.function.body.rowBounds_of_controlCounts (part.selector row) (nodes part member) + · intro part member + exact part.function.body.return_bound_of_controlCounts (part.selector row) (nodes part member) + · intro branchless + obtain ⟨description, _, source⟩ := circuit.emitRow_spec row program emitted + have valid : ∀ equation ∈ (circuitEmission row circuit emission.members).equations, equation = 0 := by + rw [← description] + exact satisfied + have each : ∀ part ∈ emission.members, part.body.returns.length ≤ part.function.body.controlCounts.leaves := by + intro part member + have gates := congrArg List.length ((source part member).return_gates + (circuitEmission_member_satisfied valid member)) + simp only [List.length_map] at gates + rw [gates] + exact part.function.body.returns_le_selectors (part.selector row) + have combined := flatMap_length_le_sum emission.members (·.body.returns) + (fun part => part.function.body.controlCounts.leaves) each + have returnsEq := congrArg CircuitEmission.returns description + rw [returnsEq] + rw [description] at branchless + change circuitBranchless circuit.layout.selectors (emission.members.map (·.function)) = true at branchless + unfold circuitBranchless at branchless + rw [Bool.and_eq_true] at branchless + have one := beq_iff_eq.mp branchless.1 + change (emission.members.flatMap (·.body.returns)).length ≤ 1 + omega + +theorem Circuit.emitRow_valid_checked {tables : LookupTables} {width : Nat} {emissions : List CircuitEmission} + (global : GlobalLookups tables width (circuitQueryPool emissions)) + (memoryValid : ∀ size, MemoryRowsValid size (tables.memory size)) + (canonical : ∀ size ∈ tables.memoryWidths, size < gSize.toNat) + (row : Nat → G) (program : Toplevel) (circuit : Circuit) + {emission : CircuitEmission} (emitted : circuit.emitRow row program = some emission) + (member : emission ∈ emissions) + (validated : circuit.validateRowCounts program = true) + (shape : ∀ part ∈ emission.members, part.function.body.lookupShapes program none = true) + (reserved : 4 ≤ circuit.layout.lookups) + (limits : ∀ part ∈ emission.members, part.body.lookup ≤ circuit.layout.lookups) + (satisfied : ∀ equation ∈ emission.equations, equation = 0) + (nonzero : emission.multiplicity ≠ 0) : + ∃ selected ∈ emission.members, ∃ interpreted : FunctionRow, + interpreted.Valid program (memoryFacts tables.memory) ∧ + interpreted.request.function = selected.functionIndex ∧ + interpreted.request.inputs = rowValues (rowAdvice row 0 selected.function.layout.inputSize) ∧ + interpreted.request.rank = packRank emission.rankBytes ∧ + interpreted.rankBytes = emission.rankBytes ∧ + interpreted.selector = emission.selector ∧ interpreted.multiplicity = emission.multiplicity ∧ + (1, interpreted.request) ∈ emission.returns ∧ + padMessage width (emission.lookup 0).2 = padMessage width (functionMessage interpreted.request) ∧ + selected.body.CallsAt interpreted.calls ∧ + (interpreted.requests.map functionMessage) ⊆ circuitQueryPool emissions ∧ + (interpreted.byteQueries.map rangeMessage) ⊆ circuitQueryPool emissions := by + obtain ⟨bounded, bounds, returnBound, single⟩ := circuit.emitRow_count_bounds row program emitted validated satisfied + exact circuit.emitRow_valid global memoryValid canonical row program emitted member bounded bounds shape + returnBound reserved limits single satisfied nonzero + +end Aiur.Bytecode + +namespace Aiur.BoundVerifier + +theorem Backend.circuit_row_counts {selection : Selection} (backend : Backend selection) + {circuit : Bytecode.Circuit} (member : circuit ∈ backend.compiled.bytecode.circuits) : + circuit.validateRowCounts backend.compiled.bytecode = true := + Bytecode.Toplevel.validateRowCounts_circuit backend.rowCounts member + +end Aiur.BoundVerifier diff --git a/Ix/Aiur/Proofs/CircuitRowExecution.lean b/Ix/Aiur/Proofs/CircuitRowExecution.lean new file mode 100644 index 000000000..8bb78947b --- /dev/null +++ b/Ix/Aiur/Proofs/CircuitRowExecution.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.CircuitPoolExecution + +/-! +A nonzero provider row of the valued circuit model yields a valid +function row from the same bytecode program. The interpreted inputs, rank +bytes and multiplicity agree with the circuit, and its padded provider +message names that same semantic call. All selected call and rank-byte +queries belong to the computed circuit pool. + +Exact global lookup balance, memory validity, shape and count/layout bounds +remain explicit. This is not yet extraction from native public verification. +-/ + +namespace Aiur.Bytecode +open Aiur.AIR + +theorem Circuit.emitRow_valid {tables : LookupTables} {width : Nat} {emissions : List CircuitEmission} + (global : GlobalLookups tables width (circuitQueryPool emissions)) + (memoryValid : ∀ size, MemoryRowsValid size (tables.memory size)) + (canonical : ∀ size ∈ tables.memoryWidths, size < gSize.toNat) + (row : Nat → G) (program : Toplevel) (circuit : Circuit) + {emission : CircuitEmission} (emitted : circuit.emitRow row program = some emission) + (member : emission ∈ emissions) + (bounded : circuit.members.size < gSize.toNat) + (bounds : ∀ part ∈ emission.members, part.function.body.rowBounds (part.selector row)) + (shape : ∀ part ∈ emission.members, part.function.body.lookupShapes program none = true) + (returnBound : ∀ part ∈ emission.members, + (part.function.body.selectorFlow (part.selector row)).returns.length < gSize.toNat) + (reserved : 4 ≤ circuit.layout.lookups) + (limits : ∀ part ∈ emission.members, part.body.lookup ≤ circuit.layout.lookups) + (single : emission.branchless = true → emission.returns.length ≤ 1) + (satisfied : ∀ equation ∈ emission.equations, equation = 0) + (nonzero : emission.multiplicity ≠ 0) : + ∃ selected ∈ emission.members, ∃ interpreted : FunctionRow, + interpreted.Valid program (memoryFacts tables.memory) ∧ + interpreted.request.function = selected.functionIndex ∧ + interpreted.request.inputs = rowValues (rowAdvice row 0 selected.function.layout.inputSize) ∧ + interpreted.request.rank = packRank emission.rankBytes ∧ + interpreted.rankBytes = emission.rankBytes ∧ + interpreted.selector = emission.selector ∧ interpreted.multiplicity = emission.multiplicity ∧ + (1, interpreted.request) ∈ emission.returns ∧ + padMessage width (emission.lookup 0).2 = padMessage width (functionMessage interpreted.request) ∧ + selected.body.CallsAt interpreted.calls ∧ + (interpreted.requests.map functionMessage) ⊆ circuitQueryPool emissions ∧ + (interpreted.byteQueries.map rangeMessage) ⊆ circuitQueryPool emissions := by + exact circuit.emitRow_valid_in_pool global memoryValid canonical row program emitted member + (List.Subset.refl _) bounded bounds shape returnBound reserved limits single satisfied nonzero + +end Aiur.Bytecode diff --git a/Ix/Aiur/Proofs/CircuitRowMembers.lean b/Ix/Aiur/Proofs/CircuitRowMembers.lean new file mode 100644 index 000000000..57f34166b --- /dev/null +++ b/Ix/Aiur/Proofs/CircuitRowMembers.lean @@ -0,0 +1,203 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.CircuitRows + +/-! +Successful circuit emission retains the actual program functions and +member selector offsets. Satisfying header and body equations make the +circuit selector boolean. Nonzero provider multiplicity selects an active +member under the explicit member-count bound. +-/ + +namespace Aiur.AIR +open Bytecode + +structure MemberEmission.FromProgram (row : Nat → G) (rank : G) (column lookup : Nat) + (program : Toplevel) (member : MemberEmission) : Prop where + present : program.functions[member.functionIndex]? = some member.function + emitted : member.function.emitRow row (member.selector row) member.functionIndex rank + (rowAdvice row 0 member.function.layout.inputSize) column lookup = some member.body + +theorem emitMember_spec (row : Nat → G) (rank : G) (column lookup selectorBase : Nat) + (program : Toplevel) (functionIndex : FunIdx) {member : MemberEmission} + (emitted : emitMember row rank column lookup selectorBase program functionIndex = some member) : + member.functionIndex = functionIndex ∧ member.selectorBase = selectorBase ∧ + member.FromProgram row rank column lookup program := by + simp only [emitMember, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i function present + dsimp only at emitted + split at emitted + · cases emitted + · rename_i body bodyEmitted + have equal := Option.some.inj emitted + subst member + exact ⟨rfl, rfl, present, bodyEmitted⟩ + +theorem emitMembers_spec (row : Nat → G) (rank : G) (column lookup selectorBase : Nat) + (program : Toplevel) (indices : List FunIdx) {members : List MemberEmission} + (emitted : emitMembers row rank column lookup selectorBase program indices = some members) : + members.map MemberEmission.functionIndex = indices ∧ + ∀ member ∈ members, member.FromProgram row rank column lookup program := by + induction indices generalizing selectorBase members with + | nil => + have equal := Option.some.inj emitted + subst members + exact ⟨rfl, by simp⟩ + | cons index indices ih => + simp only [emitMembers, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i member memberEmitted + dsimp only at emitted + split at emitted + · cases emitted + · rename_i rest restEmitted + have equal := Option.some.inj emitted + subst members + obtain ⟨indexEq, _, first⟩ := emitMember_spec row rank column lookup selectorBase program index memberEmitted + obtain ⟨indicesEq, remaining⟩ := ih _ restEmitted + refine ⟨by rw [List.map_cons, indexEq, indicesEq], ?_⟩ + intro item present + rcases List.mem_cons.mp present with equal | tail + · subst item + exact first + · exact remaining item tail + +theorem MemberEmission.FromProgram.selector_satisfied {row : Nat → G} {rank : G} {column lookup : Nat} + {program : Toplevel} {member : MemberEmission} (source : member.FromProgram row rank column lookup program) + (satisfied : ∀ equation ∈ member.body.equations, equation = 0) : + (member.function.body.selectorFlow (member.selector row)).Satisfied := by + have emitted := source.emitted + rw [Bytecode.Function.emitRow] at emitted + exact member.function.body.emitRow_selectors row (member.selector row) _ _ _ _ _ emitted satisfied + +theorem circuitEmission_member_satisfied {row : Nat → G} {circuit : Circuit} {members : List MemberEmission} + (satisfied : ∀ equation ∈ (circuitEmission row circuit members).equations, equation = 0) + {member : MemberEmission} (present : member ∈ members) : + ∀ equation ∈ member.body.equations, equation = 0 := by + intro equation member + apply satisfied equation + exact List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ + (List.mem_flatMap.mpr ⟨_, present, member⟩))) + +theorem circuitEmission_activity {row : Nat → G} {circuit : Circuit} {members : List MemberEmission} + (satisfied : ∀ equation ∈ (circuitEmission row circuit members).equations, equation = 0) : + activityConstraint (circuitEmission row circuit members).multiplicity + (circuitEmission row circuit members).selector = 0 := + satisfied _ (List.mem_append_right _ List.mem_cons_self) + +theorem circuitEmission_member_boolean {row : Nat → G} {rank : G} {column lookup : Nat} + {program : Toplevel} {circuit : Circuit} {members : List MemberEmission} + (source : ∀ member ∈ members, member.FromProgram row rank column lookup program) + (satisfied : ∀ equation ∈ (circuitEmission row circuit members).equations, equation = 0) : + ∀ member ∈ members, booleanConstraint (member.entry row) = 0 := by + intro member present + exact member.function.body.selectorFlow_boolean (member.selector row) + ((source member present).selector_satisfied (circuitEmission_member_satisfied satisfied present)) + +theorem circuitEmission_boolean {row : Nat → G} {rank : G} {column lookup : Nat} + {program : Toplevel} {circuit : Circuit} {members : List MemberEmission} + (source : ∀ member ∈ members, member.FromProgram row rank column lookup program) + (count : members.length = circuit.members.size) + (satisfied : ∀ equation ∈ (circuitEmission row circuit members).equations, equation = 0) : + booleanConstraint (circuitEmission row circuit members).selector = 0 := by + by_cases grouped : 1 < circuit.members.size + · have constraint : oneSubBooleanConstraint (circuitEmission row circuit members).selector = 0 := by + apply satisfied _ + apply List.mem_append_left + apply List.mem_append_right + simp only [if_pos grouped] + exact List.mem_cons_self + rcases G.boolean_of_one_sub_constraint constraint with inactive | active + · rw [inactive]; rfl + · rw [active]; rfl + · have bounded : members.length ≤ 1 := by omega + cases members with + | nil => + change booleanConstraint 0 = 0 + rw [booleanConstraint, G.mul_comm, G.mul_zero] + | cons member rest => + have empty : rest = [] := List.length_eq_zero_iff.mp (by simp only [List.length_cons] at bounded; omega) + subst rest + have boolean := circuitEmission_member_boolean source satisfied member List.mem_cons_self + change booleanConstraint (selectorSum [member.entry row]) = 0 + rw [selectorSum_cons] + change booleanConstraint (member.entry row + 0) = 0 + rw [G.add_zero] + exact boolean + +end Aiur.AIR + +namespace Aiur.Bytecode +open Aiur.AIR + +theorem Circuit.emitRow_spec (row : Nat → G) (program : Toplevel) (circuit : Circuit) + {emission : CircuitEmission} (emitted : circuit.emitRow row program = some emission) : + emission = circuitEmission row circuit emission.members ∧ + emission.members.map MemberEmission.functionIndex = circuit.members.toList ∧ + ∀ member ∈ emission.members, + member.FromProgram row (packRank (circuitRankBytes row circuit.layout)) + (circuit.layout.inputSize + circuit.layout.selectors + 1 + 6) 4 program := by + simp only [Circuit.emitRow, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i members membersEmitted + have equal := Option.some.inj emitted + subst emission + obtain ⟨indices, source⟩ := emitMembers_spec row _ _ _ _ program _ membersEmitted + exact ⟨rfl, indices, source⟩ + +theorem Circuit.emitRow_boolean (row : Nat → G) (program : Toplevel) (circuit : Circuit) + {emission : CircuitEmission} (emitted : circuit.emitRow row program = some emission) + (satisfied : ∀ equation ∈ emission.equations, equation = 0) : + booleanConstraint emission.selector = 0 := by + obtain ⟨description, indices, source⟩ := circuit.emitRow_spec row program emitted + have count := congrArg List.length indices + simp only [List.length_map, Array.length_toList] at count + have valid : ∀ equation ∈ (circuitEmission row circuit emission.members).equations, equation = 0 := by + rw [← description] + exact satisfied + have boolean := circuitEmission_boolean source count valid + rw [← description] at boolean + exact boolean + +theorem Circuit.emitRow_active_member (row : Nat → G) (program : Toplevel) (circuit : Circuit) + {emission : CircuitEmission} (emitted : circuit.emitRow row program = some emission) + (satisfied : ∀ equation ∈ emission.equations, equation = 0) + (bounded : circuit.members.size < gSize.toNat) (nonzero : emission.multiplicity ≠ 0) : + ∃ member ∈ emission.members, member.entry row = 1 ∧ + member.FromProgram row (packRank emission.rankBytes) + (circuit.layout.inputSize + circuit.layout.selectors + 1 + 6) 4 program := by + obtain ⟨description, indices, source⟩ := circuit.emitRow_spec row program emitted + have length := congrArg List.length indices + simp only [List.length_map, Array.length_toList] at length + have valid : ∀ equation ∈ (circuitEmission row circuit emission.members).equations, equation = 0 := by + rw [← description] + exact satisfied + have activity := circuitEmission_activity valid + rw [← description] at activity + have active := nonzero_multiplicity_selector_one activity nonzero + have individual := circuitEmission_member_boolean source valid + have selectorEq := congrArg CircuitEmission.selector description + have count := selectorSum_active_count + (selectors := emission.members.map (fun member : MemberEmission => member.entry row)) + (fun gate member => by + obtain ⟨part, partMember, equal⟩ := List.mem_map.mp member + subst gate + exact individual part partMember) + (by simpa only [List.length_map, length] using bounded) + (show selectorSum (emission.members.map (fun member => member.entry row)) = 1 from selectorEq.symm.trans active) + have existsOne : (1 : G) ∈ emission.members.map (·.entry row) := + List.count_pos_iff.mp (Nat.lt_of_lt_of_eq (by decide : 0 < 1) count.symm) + obtain ⟨member, present, selected⟩ := List.mem_map.mp existsOne + refine ⟨member, present, selected, ?_⟩ + have rankEq := congrArg CircuitEmission.rankBytes description + rw [rankEq] + exact source member present + +end Aiur.Bytecode diff --git a/Ix/Aiur/Proofs/CircuitRowQueries.lean b/Ix/Aiur/Proofs/CircuitRowQueries.lean new file mode 100644 index 000000000..98b733860 --- /dev/null +++ b/Ix/Aiur/Proofs/CircuitRowQueries.lean @@ -0,0 +1,160 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.CircuitRowMembers + +/-! +Shared-slot extraction across circuit members and the three reserved +rank-byte lookup slots. Validated body bounds and lookup cursor limits give +one active query per physical slot and a computed circuit query pool. +Native layout enforcement and verifier-to-valued-model reflection remain +separate. +-/ + +namespace Aiur.AIR +open Bytecode + +theorem QuerySlots.extend {gate : G} {start finish limit : Nat} {queries : List QueryPart} + (slots : QuerySlots gate start finish queries) (bound : finish ≤ limit) : + QuerySlots gate start limit queries := + ⟨Nat.le_trans slots.extent bound, + fun query member => ⟨(slots.range query member).1, Nat.lt_of_lt_of_le (slots.range query member).2 bound⟩, + slots.boolean, slots.count⟩ + +theorem QuerySlots.permuted {gate : G} {start finish : Nat} {queries other : List QueryPart} + (slots : QuerySlots gate start finish queries) (permutation : queries.Perm other) : + QuerySlots gate start finish other := by + refine ⟨slots.extent, ?_, ?_, ?_⟩ + · exact fun query member => slots.range query (permutation.mem_iff.mpr member) + · exact fun query member => slots.boolean query (permutation.mem_iff.mpr member) + · intro slot + have counts : queryCount queries slot = queryCount other slot := (permutation.filter _).length_eq + rw [← counts] + exact slots.count slot + +theorem fold_lookup_upper (emissions : List BlockEmission) (start limit : Nat) + (initial : start ≤ limit) (bounded : ∀ emission ∈ emissions, emission.lookup ≤ limit) : + emissions.foldl (fun current emission => max current emission.lookup) start ≤ limit := by + induction emissions generalizing start with + | nil => exact initial + | cons emission rest ih => + apply ih + · exact Nat.max_le.mpr ⟨initial, bounded emission List.mem_cons_self⟩ + · exact fun item member => bounded item (List.mem_cons_of_mem _ member) + +theorem forall₂_self_map {α β : Type} (items : List α) (map : α → β) (relation : α → β → Prop) + (related : ∀ item ∈ items, relation item (map item)) : List.Forall₂ relation items (items.map map) := by + induction items with + | nil => exact .nil + | cons item rest ih => + exact .cons (related item List.mem_cons_self) (ih (fun item member => related item (List.mem_cons_of_mem _ member))) + +theorem MemberEmission.FromProgram.querySlots {row : Nat → G} {rank : G} {column lookup : Nat} + {program : Toplevel} {member : MemberEmission} (source : member.FromProgram row rank column lookup program) + (bounds : member.function.body.rowBounds (member.selector row)) + (satisfied : ∀ equation ∈ member.body.equations, equation = 0) : + QuerySlots (member.entry row) lookup member.body.lookup member.body.queries := by + have emitted := source.emitted + rw [Bytecode.Function.emitRow] at emitted + exact member.function.body.emitRow_equation_querySlots row (member.selector row) _ _ _ _ _ bounds emitted rfl satisfied + +theorem circuitEmission_querySlots {row : Nat → G} {rank : G} {column : Nat} + {program : Toplevel} {circuit : Circuit} {members : List MemberEmission} + (source : ∀ member ∈ members, member.FromProgram row rank column 4 program) + (count : members.length = circuit.members.size) + (bounded : circuit.members.size < gSize.toNat) + (bounds : ∀ member ∈ members, member.function.body.rowBounds (member.selector row)) + (reserved : 4 ≤ circuit.layout.lookups) + (limits : ∀ member ∈ members, member.body.lookup ≤ circuit.layout.lookups) + (satisfied : ∀ equation ∈ (circuitEmission row circuit members).equations, equation = 0) : + QuerySlots (circuitEmission row circuit members).selector 1 circuit.layout.lookups + (circuitEmission row circuit members).queries := by + have boolean := circuitEmission_boolean source count satisfied + have individual := circuitEmission_member_boolean source satisfied + have slots : ∀ member ∈ members, QuerySlots (member.entry row) 4 member.body.lookup member.body.queries := + fun member present => (source member present).querySlots (bounds member present) + (circuitEmission_member_satisfied satisfied present) + have related := forall₂_self_map members MemberEmission.body + (fun member body => QuerySlots (member.entry row) 4 body.lookup body.queries) slots + have selectorCount := selector_gateCount + (gates := members.map (fun member : MemberEmission => member.entry row)) + (fun gate member => by + obtain ⟨part, partMember, equal⟩ := List.mem_map.mp member + subst gate + exact individual part partMember) + (by simpa only [List.length_map, count] using bounded) boolean + have joined := QuerySlots.join (fun member : MemberEmission => member.entry row) + (circuitEmission row circuit members).selector #[] 0 4 related (Nat.le_of_eq selectorCount) + have upper : (joinBlockEmissions #[] 0 4 (members.map MemberEmission.body)).lookup ≤ circuit.layout.lookups := by + apply fold_lookup_upper _ _ _ reserved + intro body member + obtain ⟨part, partMember, equal⟩ := List.mem_map.mp member + subst body + exact limits part partMember + have bodies := joined.extend upper + have rankSlots : QuerySlots (circuitEmission row circuit members).selector 1 4 + (queryParts 1 (circuitEmission row circuit members).selector + ((rankByteQueries (circuitRankBytes row circuit.layout)).map rangeMessage)) := + QuerySlots.indexed _ 1 ((rankByteQueries (circuitRankBytes row circuit.layout)).map rangeMessage) boolean + have combined := (rankSlots.append bodies).permuted List.perm_append_comm + simpa only [joinBlockEmissions, List.flatMap_map, Function.comp_def, circuitEmission] using combined + +def CircuitEmission.QueriesIn (emission : CircuitEmission) (queries : List (List G)) : Prop := + ∀ part ∈ emission.queries, part.selector = 1 → part.message ∈ queries + +def circuitQueryPool (emissions : List CircuitEmission) : List (List G) := + emissions.flatMap fun emission => decodedQueries emission.queries emission.lookupCount + +theorem QuerySlots.circuit_pool {emission : CircuitEmission} + (slots : QuerySlots emission.selector 1 emission.lookupCount emission.queries) + {emissions : List CircuitEmission} (member : emission ∈ emissions) : + emission.QueriesIn (circuitQueryPool emissions) := by + intro query present active + exact List.mem_flatMap.mpr ⟨emission, member, slots.decoded_member present active⟩ + +theorem circuitEmission_member_queried {row : Nat → G} {circuit : Circuit} {members : List MemberEmission} + {queries : List (List G)} (queried : (circuitEmission row circuit members).QueriesIn queries) + {member : MemberEmission} (present : member ∈ members) : member.body.QueriesIn queries := by + intro query member active + exact queried query (List.mem_append_left _ (List.mem_flatMap.mpr ⟨_, present, member⟩)) active + +theorem circuitEmission_rank_queried {row : Nat → G} {circuit : Circuit} {members : List MemberEmission} + {queries : List (List G)} (queried : (circuitEmission row circuit members).QueriesIn queries) + (active : (circuitEmission row circuit members).selector = 1) : + (rankByteQueries (circuitEmission row circuit members).rankBytes).map rangeMessage ⊆ queries := by + intro message member + obtain ⟨part, partMember, selectorEq, messageEq⟩ := + queryParts_member 1 (circuitEmission row circuit members).selector member + have result := queried part (List.mem_append_right _ partMember) (selectorEq.trans active) + rw [messageEq] at result + exact result + +end Aiur.AIR + +namespace Aiur.Bytecode +open Aiur.AIR + +theorem Circuit.emitRow_querySlots (row : Nat → G) (program : Toplevel) (circuit : Circuit) + {emission : CircuitEmission} (emitted : circuit.emitRow row program = some emission) + (bounded : circuit.members.size < gSize.toNat) + (bounds : ∀ member ∈ emission.members, member.function.body.rowBounds (member.selector row)) + (reserved : 4 ≤ circuit.layout.lookups) + (limits : ∀ member ∈ emission.members, member.body.lookup ≤ circuit.layout.lookups) + (satisfied : ∀ equation ∈ emission.equations, equation = 0) : + QuerySlots emission.selector 1 emission.lookupCount emission.queries := by + obtain ⟨description, indices, source⟩ := circuit.emitRow_spec row program emitted + have count := congrArg List.length indices + simp only [List.length_map, Array.length_toList] at count + have valid : ∀ equation ∈ (circuitEmission row circuit emission.members).equations, equation = 0 := by + rw [← description] + exact satisfied + have slots := circuitEmission_querySlots source count bounded bounds reserved limits valid + have lookupEq := congrArg CircuitEmission.lookupCount description + change emission.lookupCount = circuit.layout.lookups at lookupEq + rw [← lookupEq] at slots + rw [← description] at slots + exact slots + +end Aiur.Bytecode diff --git a/Ix/Aiur/Proofs/CircuitRowReturns.lean b/Ix/Aiur/Proofs/CircuitRowReturns.lean new file mode 100644 index 000000000..77ed1e5df --- /dev/null +++ b/Ix/Aiur/Proofs/CircuitRowReturns.lean @@ -0,0 +1,117 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.CircuitRowQueries + +/-! +The combined circuit return slot encodes the selected semantic return. +Per-function selector conservation and return-count bounds compose across +grouped members without an extra bound on the total inactive return count. +The single-writer premise for the ungated branchless optimization is explicit. +-/ + +namespace Aiur.AIR +open Bytecode + +theorem MemberEmission.FromProgram.return_gates {row : Nat → G} {rank : G} {column lookup : Nat} + {program : Toplevel} {member : MemberEmission} (source : member.FromProgram row rank column lookup program) + (satisfied : ∀ equation ∈ member.body.equations, equation = 0) : + member.body.returns.map Prod.fst = (member.function.body.selectorFlow (member.selector row)).returns := by + have emitted := source.emitted + rw [Bytecode.Function.emitRow] at emitted + have projected := member.function.body.emitRow_projection row (member.selector row) _ _ _ _ _ emitted + exact projected.returned.trans (member.function.body.returnGates_reflects (member.selector row) _ + (source.selector_satisfied satisfied) rfl) + +theorem MemberEmission.FromProgram.return_boolean {row : Nat → G} {rank : G} {column lookup : Nat} + {program : Toplevel} {member : MemberEmission} (source : member.FromProgram row rank column lookup program) + (satisfied : ∀ equation ∈ member.body.equations, equation = 0) : + ∀ part ∈ member.body.returns, booleanConstraint part.1 = 0 := by + intro part present + have sound := member.function.body.selectorFlow_sound (member.selector row) (source.selector_satisfied satisfied) + apply sound.returned part.1 + rw [← source.return_gates satisfied] + exact List.mem_map.mpr ⟨part, present, rfl⟩ + +theorem MemberEmission.FromProgram.return_count {row : Nat → G} {rank : G} {column lookup : Nat} + {program : Toplevel} {member : MemberEmission} (source : member.FromProgram row rank column lookup program) + (shape : member.function.body.lookupShapes program none = true) + (bounded : (member.function.body.selectorFlow (member.selector row)).returns.length < gSize.toNat) + (satisfied : ∀ equation ∈ member.body.equations, equation = 0) : + (member.body.returns.map Prod.fst).count 1 = gateCount (member.entry row) := by + have valid := source.selector_satisfied satisfied + have sound := member.function.body.selectorFlow_sound (member.selector row) valid + have empty := member.function.body.selectorFlow_yields_empty (member.selector row) program shape + have conservation := sound.conservation + rw [empty] at conservation + change _ = selectorSum (member.function.body.selectorFlow (member.selector row)).returns + 0 at conservation + rw [G.add_zero] at conservation + rw [source.return_gates satisfied, MemberEmission.entry, conservation] + apply selector_gateCount sound.returned bounded + rw [← conservation] + exact member.function.body.selectorFlow_boolean (member.selector row) valid + +theorem flatMap_return_count {α β : Type} (items : List α) (gate : α → G) (parts : α → List (G × β)) + (count : ∀ item ∈ items, ((parts item).map Prod.fst).count 1 = gateCount (gate item)) : + ((items.flatMap parts).map Prod.fst).count 1 = (items.map gate).count 1 := by + have summed : ((items.flatMap parts).map Prod.fst).count 1 = ((items.map gate).map gateCount).sum := by + induction items with + | nil => rfl + | cons item rest ih => + rw [List.flatMap_cons, List.map_append, List.count_append, count item List.mem_cons_self, + ih (fun item member => count item (List.mem_cons_of_mem _ member))] + rfl + exact summed.trans (gateCount_list _) + +theorem circuitEmission_return_count {row : Nat → G} {rank : G} {column lookup : Nat} + {program : Toplevel} {circuit : Circuit} {members : List MemberEmission} + (source : ∀ member ∈ members, member.FromProgram row rank column lookup program) + (shape : ∀ member ∈ members, member.function.body.lookupShapes program none = true) + (bounded : members.length < gSize.toNat) + (returnBound : ∀ member ∈ members, + (member.function.body.selectorFlow (member.selector row)).returns.length < gSize.toNat) + (satisfied : ∀ equation ∈ (circuitEmission row circuit members).equations, equation = 0) + (active : (circuitEmission row circuit members).selector = 1) : + ((circuitEmission row circuit members).returns.map Prod.fst).count 1 = 1 := by + have each := fun member present => (source member present).return_count (shape member present) + (returnBound member present) (circuitEmission_member_satisfied satisfied present) + change ((members.flatMap (·.body.returns)).map Prod.fst).count 1 = 1 + rw [flatMap_return_count members (fun member => member.entry row) (fun member => member.body.returns) each] + have individual := circuitEmission_member_boolean source satisfied + apply selectorSum_active_count + · intro gate member + obtain ⟨part, partMember, equal⟩ := List.mem_map.mp member + subst gate + exact individual part partMember + · simpa only [List.length_map] using bounded + · exact active + +theorem circuitEmission_return_message {row : Nat → G} {rank : G} {column lookup : Nat} + {program : Toplevel} {circuit : Circuit} {members : List MemberEmission} + (source : ∀ member ∈ members, member.FromProgram row rank column lookup program) + (shape : ∀ member ∈ members, member.function.body.lookupShapes program none = true) + (bounded : members.length < gSize.toNat) + (returnBound : ∀ member ∈ members, + (member.function.body.selectorFlow (member.selector row)).returns.length < gSize.toNat) + (satisfied : ∀ equation ∈ (circuitEmission row circuit members).equations, equation = 0) + (active : (circuitEmission row circuit members).selector = 1) + (width : Nat) + (single : (circuitEmission row circuit members).branchless = true → + (circuitEmission row circuit members).returns.length ≤ 1) + {request : Bytecode.AIR.Call} (present : (1, request) ∈ (circuitEmission row circuit members).returns) : + padMessage width ((circuitEmission row circuit members).lookup 0).2 = padMessage width (functionMessage request) := by + have count := circuitEmission_return_count source shape bounded returnBound satisfied active + apply slotMessage_chosen_count width (circuitEmission row circuit members).branchless + (by simpa only [List.length_map] using single) + (fun part member => ?_) + (by simpa only [List.map_map, Function.comp_def] using count) + (List.mem_map.mpr ⟨(1, request), present, rfl⟩) rfl + obtain ⟨returned, returnMember, equal⟩ := List.mem_map.mp member + subst part + obtain ⟨body, bodyMember, returnedMember⟩ := List.mem_flatMap.mp returnMember + exact (source body bodyMember).return_boolean (circuitEmission_member_satisfied satisfied bodyMember) + returned returnedMember + +end Aiur.AIR diff --git a/Ix/Aiur/Proofs/CircuitRows.lean b/Ix/Aiur/Proofs/CircuitRows.lean new file mode 100644 index 000000000..3968f591b --- /dev/null +++ b/Ix/Aiur/Proofs/CircuitRows.lean @@ -0,0 +1,102 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.BlockQueryPool +import Ix.Aiur.Branchless + +/-! +A valued model of the complete native function-circuit builder. Grouped +members share auxiliary columns, rank bytes, multiplicity and lookup slots, +while their selector columns occupy consecutive regions. The model retains +the native header equations and provider-message combination on arbitrary +assignments. Native expression/codec reflection and layout validity remain +separate obligations. +-/ + +namespace Aiur.AIR +open Bytecode + +structure MemberEmission where + functionIndex : FunIdx + function : Function + selectorBase : Nat + body : BlockEmission + +def MemberEmission.selector (row : Nat → G) (member : MemberEmission) : SelIdx → G := + fun index => row (member.selectorBase + index) + +def MemberEmission.entry (row : Nat → G) (member : MemberEmission) : G := + (member.function.body.selectorFlow (member.selector row)).entry + +def emitMember (row : Nat → G) (rank : G) (column lookup selectorBase : Nat) + (program : Toplevel) (functionIndex : FunIdx) : Option MemberEmission := do + let function ← program.functions[functionIndex]? + let body ← function.emitRow row (fun index => row (selectorBase + index)) functionIndex rank + (rowAdvice row 0 function.layout.inputSize) column lookup + return ⟨functionIndex, function, selectorBase, body⟩ + +def emitMembers (row : Nat → G) (rank : G) (column lookup selectorBase : Nat) + (program : Toplevel) : List FunIdx → Option (List MemberEmission) + | [] => some [] + | index :: indices => do + let member ← emitMember row rank column lookup selectorBase program index + let rest ← emitMembers row rank column lookup (selectorBase + member.function.layout.selectors) program indices + return member :: rest + +structure CircuitEmission where + members : List MemberEmission + selector : G + multiplicity : G + rankBytes : Fin 6 → G + width : Nat + selectorStart : Nat + selectorCount : Nat + lookupCount : Nat + branchless : Bool + equations : List G + queries : List QueryPart + returns : List (G × Bytecode.AIR.Call) + +def circuitRankBytes (row : Nat → G) (layout : Bytecode.FunctionLayout) : Fin 6 → G := + fun index => row (layout.inputSize + layout.selectors + 1 + index.val) + +def circuitEmission (row : Nat → G) (circuit : Circuit) (members : List MemberEmission) : CircuitEmission := + let selector := selectorSum (members.map (·.entry row)) + let multiplicity := row (circuit.layout.inputSize + circuit.layout.selectors) + let rankBytes := circuitRankBytes row circuit.layout + { members, selector, multiplicity, rankBytes + width := circuit.layout.width + selectorStart := circuit.layout.inputSize + selectorCount := circuit.layout.selectors + lookupCount := circuit.layout.lookups + branchless := circuitBranchless circuit.layout.selectors (members.map (·.function)) + equations := members.flatMap (·.body.equations) ++ + (List.range circuit.layout.selectors).map (fun index => booleanConstraint (row (circuit.layout.inputSize + index))) ++ + (if 1 < circuit.members.size then [oneSubBooleanConstraint selector] else []) ++ + [activityConstraint multiplicity selector] + queries := members.flatMap (·.body.queries) ++ + queryParts 1 selector ((rankByteQueries rankBytes).map rangeMessage) + returns := members.flatMap (·.body.returns) } + +def CircuitEmission.lookup (emission : CircuitEmission) (slot : Nat) : G × List G := + if slot = 0 then + (0 - emission.multiplicity, + slotMessage emission.branchless (emission.returns.map fun part => (part.1, functionMessage part.2))) + else + (querySlotMultiplicity emission.queries slot, + slotMessage emission.branchless (querySlotParts emission.queries slot)) + +end Aiur.AIR + +namespace Aiur.Bytecode +open Aiur.AIR + +def Circuit.emitRow (row : Nat → G) (program : Toplevel) (circuit : Circuit) : Option CircuitEmission := do + let rank := packRank (circuitRankBytes row circuit.layout) + let column := circuit.layout.inputSize + circuit.layout.selectors + 1 + 6 + let members ← emitMembers row rank column 4 circuit.layout.inputSize program circuit.members.toList + return circuitEmission row circuit members + +end Aiur.Bytecode diff --git a/Ix/Aiur/Proofs/CircuitTableData.lean b/Ix/Aiur/Proofs/CircuitTableData.lean new file mode 100644 index 000000000..6fd625f9c --- /dev/null +++ b/Ix/Aiur/Proofs/CircuitTableData.lean @@ -0,0 +1,130 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.ProviderEquivalence + +/-! Physical circuit providers, auxiliary tables and witness assignments. +Provider-only function rows initialize lookup extraction; their local validity +is not assumed. Zero-weight rows can be represented by a valid inactive row. -/ + +namespace Aiur.AIR +open Bytecode + +/-- Memory and fixed byte tables before any function-row interpretation. -/ +structure AuxiliaryTables where + memoryWidths : List Nat + memory : Nat → Array MemoryRow + byte1 : Byte1Kind → Fin 256 → G + byte2 : Byte2Kind → Fin 65536 → G + +def AuxiliaryTables.withFunctions (tables : AuxiliaryTables) (functions : List FunctionRow) : LookupTables := + ⟨functions, tables.memoryWidths, tables.memory, tables.byte1, tables.byte2⟩ + +def AuxiliaryTables.providers (tables : AuxiliaryTables) : List (Provider (List G)) := + tables.memoryWidths.flatMap (fun width => + mapProviders (fun request => memoryMessage width request.1 request.2) + (memoryProviders (tables.memory width))) ++ + byte1Providers tables.byte1 ++ byte2Providers tables.byte2 + +def circuitProviders (emissions : List CircuitEmission) : List (Provider (List G)) := + emissions.map CircuitEmission.provider + +def AuxiliaryTables.circuitProviders (tables : AuxiliaryTables) (emissions : List CircuitEmission) : + List (Provider (List G)) := Aiur.AIR.circuitProviders emissions ++ tables.providers + +theorem AuxiliaryTables.withFunctions_providers (tables : AuxiliaryTables) (functions : List FunctionRow) : + (tables.withFunctions functions).providers = + mapProviders functionMessage (functionProviders functions) ++ tables.providers := by + simp only [withFunctions, LookupTables.providers, providers, List.append_assoc] + +def FunctionRow.Provides (width : Nat) (emission : CircuitEmission) (row : FunctionRow) : Prop := + Provider.PaddedEq width emission.provider (functionMessage row.request, row.multiplicity) + +theorem AuxiliaryTables.providers_related (tables : AuxiliaryTables) {width : Nat} + {emissions : List CircuitEmission} {functions : List FunctionRow} + (related : List.Forall₂ (FunctionRow.Provides width) emissions functions) : + List.Forall₂ (Provider.PaddedEq width) (tables.circuitProviders emissions) + (tables.withFunctions functions).providers := by + rw [tables.withFunctions_providers] + apply forall₂_append + · induction related with + | nil => exact .nil + | cons first rest ih => exact .cons first ih + · exact paddedProviders_refl width tables.providers + +theorem AuxiliaryTables.global_of_circuit_balance (tables : AuxiliaryTables) + {width : Nat} {queries : List (List G)} {emissions : List CircuitEmission} + {functions : List FunctionRow} + (balanced : PaddedLookupBalance width queries (tables.circuitProviders emissions)) + (bounded : queries.length < gSize.toNat) + (widths : ∀ query ∈ queries, query.length ≤ width) + (related : List.Forall₂ (FunctionRow.Provides width) emissions functions) : + GlobalLookups (tables.withFunctions functions) width queries := + ⟨balanced.congr_providers (tables.providers_related related), bounded, widths⟩ + +def FunctionRow.inactive : FunctionRow := + ⟨⟨0, #[], #[], 0⟩, [], fun _ => 0, 0, 0⟩ + +theorem FunctionRow.inactive_valid (program : Toplevel) (memory : Bytecode.AIR.Memory) : + inactive.Valid program memory := by + have notActive : inactive.selector ≠ 1 := by + intro equal + have bad := congrArg G.n equal + change 0 = 1 at bad + omega + refine ⟨Or.inl rfl, ?_, fun active => False.elim (notActive active), + fun active => False.elim (notActive active), ?_⟩ + · change (0 : G) * (1 - 0) = 0 + rw [G.mul_comm, G.mul_zero] + · intro edge member + cases member + +theorem FunctionRow.inactive_provides (width : Nat) {emission : CircuitEmission} + (zero : emission.multiplicity = 0) : Provides width emission inactive := + ⟨zero, fun nonzero => False.elim (nonzero zero)⟩ + +theorem forall₂_exists_right {α β : Type} (source : List α) (relation : α → β → Prop) + (available : ∀ item ∈ source, ∃ value, relation item value) : + ∃ target, List.Forall₂ relation source target := by + induction source with + | nil => exact ⟨[], .nil⟩ + | cons first rest ih => + obtain ⟨value, firstRelated⟩ := available first List.mem_cons_self + obtain ⟨values, restRelated⟩ := ih (fun item member => available item (List.mem_cons_of_mem _ member)) + exact ⟨value :: values, .cons firstRelated restRelated⟩ + +/-- One valued row, retaining the selected circuit and the assignment used +by its emitter. Membership, successful emission and satisfaction are proved +separately when extracting a trace. -/ +structure CircuitWitness where + circuit : Circuit + values : Nat → G + emission : CircuitEmission + +def CircuitWitness.Emitted (program : Toplevel) (witness : CircuitWitness) : Prop := + witness.circuit.emitRow witness.values program = some witness.emission + +def CircuitWitness.Satisfied (witness : CircuitWitness) : Prop := + ∀ equation ∈ witness.emission.equations, equation = 0 + +def CircuitWitness.Shapes (program : Toplevel) (witness : CircuitWitness) : Prop := + ∀ part ∈ witness.emission.members, part.function.body.lookupShapes program none = true + +def CircuitWitness.LookupBounds (witness : CircuitWitness) : Prop := + 4 ≤ witness.circuit.layout.lookups ∧ + ∀ part ∈ witness.emission.members, part.body.lookup ≤ witness.circuit.layout.lookups + +theorem CircuitWitness.provider_row {program : Toplevel} (witness : CircuitWitness) + (emitted : witness.Emitted program) (satisfied : witness.Satisfied) + (validated : witness.circuit.validateRowCounts program = true) (shape : witness.Shapes program) + (width : Nat) : ∃ row : FunctionRow, row.Provides width witness.emission := by + by_cases zero : witness.emission.multiplicity = 0 + · exact ⟨FunctionRow.inactive, FunctionRow.inactive_provides width zero⟩ + · obtain ⟨request, _, message⟩ := witness.circuit.emitRow_provider witness.values program + emitted validated shape satisfied zero width + exact ⟨⟨request, [], witness.emission.rankBytes, 0, witness.emission.multiplicity⟩, + rfl, fun _ => message⟩ + +end Aiur.AIR diff --git a/Ix/Aiur/Proofs/CircuitTableExecution.lean b/Ix/Aiur/Proofs/CircuitTableExecution.lean new file mode 100644 index 000000000..f4a1e2e85 --- /dev/null +++ b/Ix/Aiur/Proofs/CircuitTableExecution.lean @@ -0,0 +1,152 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.CircuitTableData + +/-! Construct locally valid function rows from valued circuit witnesses and +physical provider balance, then derive finite call executions. The two-stage +construction avoids assuming the validity of the table being extracted. +Native extraction and the explicit layout/shape conditions remain separate. -/ + +namespace Aiur.AIR +open Bytecode + +private theorem forall₂_weaken {α β : Type} {left : List α} {right : List β} + {first second : α → β → Prop} (related : List.Forall₂ first left right) + (weaken : ∀ a b, first a b → second a b) : List.Forall₂ second left right := by + induction related with + | nil => exact .nil + | cons head tail ih => exact .cons (weaken _ _ head) ih + +def FunctionRow.QueriesIn (queries : List (List G)) (row : FunctionRow) : Prop := + row.selector = 1 → row.requests.map functionMessage ⊆ queries ∧ row.byteQueries.map rangeMessage ⊆ queries + +theorem FunctionRow.inactive_queried (queries : List (List G)) : inactive.QueriesIn queries := by + intro active + have bad := congrArg G.n active + change 0 = 1 at bad + omega + +theorem CircuitWitness.interpreted_row {tables : LookupTables} {width : Nat} + {queries : List (List G)} {emissions : List CircuitEmission} + (global : GlobalLookups tables width queries) + (memoryValid : ∀ size, MemoryRowsValid size (tables.memory size)) + (canonical : ∀ size ∈ tables.memoryWidths, size < gSize.toNat) + {program : Toplevel} (witness : CircuitWitness) + (emitted : witness.Emitted program) (satisfied : witness.Satisfied) + (validated : witness.circuit.validateRowCounts program = true) (shape : witness.Shapes program) + (limits : witness.LookupBounds) (member : witness.emission ∈ emissions) + (pooled : circuitQueryPool emissions ⊆ queries) : + ∃ row : FunctionRow, row.Valid program (memoryFacts tables.memory) ∧ + row.Provides width witness.emission ∧ row.QueriesIn queries := by + by_cases zero : witness.emission.multiplicity = 0 + · exact ⟨FunctionRow.inactive, FunctionRow.inactive_valid _ _, + FunctionRow.inactive_provides width zero, FunctionRow.inactive_queried queries⟩ + · obtain ⟨bounded, bounds, returnBound, single⟩ := witness.circuit.emitRow_count_bounds + witness.values program emitted validated satisfied + obtain ⟨_, _, row, valid, _, _, _, _, _, multiplicity, _, message, _, called, bytes⟩ := + witness.circuit.emitRow_valid_in_pool global memoryValid canonical witness.values program + emitted member pooled bounded bounds shape returnBound limits.1 limits.2 single satisfied zero + exact ⟨row, valid, ⟨multiplicity.symm, fun _ => message⟩, fun _ => ⟨called, bytes⟩⟩ + +theorem functionQueries_in_pool {queries : List (List G)} {roots : List Bytecode.AIR.Call} + {rows : List FunctionRow} (rootQueries : roots.map functionMessage ⊆ queries) + (queried : ∀ row ∈ rows, row.QueriesIn queries) : + (functionQueries roots rows).map functionMessage ⊆ queries := by + intro message member + obtain ⟨request, requestMember, equal⟩ := List.mem_map.mp member + subst message + rcases List.mem_append.mp requestMember with root | called + · exact rootQueries (List.mem_map.mpr ⟨request, root, rfl⟩) + · obtain ⟨row, rowMember, callMember⟩ := List.mem_flatMap.mp called + by_cases active : row.selector = 1 + · rw [if_pos active] at callMember + exact (queried row rowMember active).1 (List.mem_map.mpr ⟨request, callMember, rfl⟩) + · rw [if_neg active] at callMember + cases callMember + +theorem functionByteQueries_in_pool {queries : List (List G)} {rows : List FunctionRow} + (queried : ∀ row ∈ rows, row.QueriesIn queries) : + (functionByteQueries rows).map rangeMessage ⊆ queries := by + intro message member + obtain ⟨pair, pairMember, equal⟩ := List.mem_map.mp member + subst message + obtain ⟨row, rowMember, queryMember⟩ := List.mem_flatMap.mp pairMember + by_cases active : row.selector = 1 + · rw [if_pos active] at queryMember + exact (queried row rowMember active).2 (List.mem_map.mpr ⟨pair, queryMember, rfl⟩) + · rw [if_neg active] at queryMember + cases queryMember + +/-- Construct locally valid function rows from the complete circuit witness +list. The input balance names only physical circuit providers and auxiliary +tables. Function-row validity is a conclusion, not an input. -/ +theorem circuitWitnesses_interpret (tables : AuxiliaryTables) {program : Toplevel} + (witnesses : List CircuitWitness) {width : Nat} {queries : List (List G)} + (balanced : PaddedLookupBalance width queries (tables.circuitProviders (witnesses.map (·.emission)))) + (bounded : queries.length < gSize.toNat) (widths : ∀ query ∈ queries, query.length ≤ width) + (memoryValid : ∀ size, MemoryRowsValid size (tables.memory size)) + (canonical : ∀ size ∈ tables.memoryWidths, size < gSize.toNat) + (counted : program.validateRowCounts = true) + (circuits : ∀ witness ∈ witnesses, witness.circuit ∈ program.circuits) + (emitted : ∀ witness ∈ witnesses, witness.Emitted program) + (satisfied : ∀ witness ∈ witnesses, witness.Satisfied) + (shapes : ∀ witness ∈ witnesses, witness.Shapes program) + (limits : ∀ witness ∈ witnesses, witness.LookupBounds) + (pooled : circuitQueryPool (witnesses.map (·.emission)) ⊆ queries) : + ∃ functions : List FunctionRow, + List.Forall₂ (FunctionRow.Provides width) (witnesses.map (·.emission)) functions ∧ + GlobalLookups (tables.withFunctions functions) width queries ∧ + (∀ row ∈ functions, row.Valid program (memoryFacts tables.memory)) ∧ + (∀ row ∈ functions, row.QueriesIn queries) := by + have counts := fun witness member => Toplevel.validateRowCounts_circuit counted (circuits witness member) + obtain ⟨provisional, providers⟩ := forall₂_exists_right witnesses + (fun witness (row : FunctionRow) => row.Provides width witness.emission) + (fun witness member => witness.provider_row (emitted witness member) (satisfied witness member) + (counts witness member) (shapes witness member) width) + have providerRows := forall₂_map_left providers + have global := tables.global_of_circuit_balance balanced bounded widths providerRows + obtain ⟨functions, interpreted⟩ := forall₂_exists_right witnesses + (fun witness (row : FunctionRow) => row.Valid program (memoryFacts tables.memory) ∧ + row.Provides width witness.emission ∧ row.QueriesIn queries) + (fun witness member => witness.interpreted_row global memoryValid canonical + (emitted witness member) (satisfied witness member) (counts witness member) (shapes witness member) + (limits witness member) (List.mem_map.mpr ⟨witness, member, rfl⟩) pooled) + have provided : List.Forall₂ (FunctionRow.Provides width) (witnesses.map (·.emission)) functions := by + apply forall₂_map_left + exact forall₂_weaken interpreted (fun _ _ evidence => evidence.2.1) + refine ⟨functions, provided, tables.global_of_circuit_balance balanced bounded widths provided, ?_, ?_⟩ + · intro row member + obtain ⟨witness, _, evidence⟩ := forall₂_right_member interpreted member + exact evidence.1 + · intro row member + obtain ⟨witness, _, evidence⟩ := forall₂_right_member interpreted member + exact evidence.2.2 + +theorem circuitWitnesses_execute (tables : AuxiliaryTables) {program : Toplevel} + (witnesses : List CircuitWitness) {width : Nat} {queries : List (List G)} + (balanced : PaddedLookupBalance width queries (tables.circuitProviders (witnesses.map (·.emission)))) + (bounded : queries.length < gSize.toNat) (widths : ∀ query ∈ queries, query.length ≤ width) + (memoryValid : ∀ size, MemoryRowsValid size (tables.memory size)) + (canonical : ∀ size ∈ tables.memoryWidths, size < gSize.toNat) + (counted : program.validateRowCounts = true) (programShapes : program.validateLookupShapes = true) + (circuits : ∀ witness ∈ witnesses, witness.circuit ∈ program.circuits) + (emitted : ∀ witness ∈ witnesses, witness.Emitted program) + (satisfied : ∀ witness ∈ witnesses, witness.Satisfied) + (shapes : ∀ witness ∈ witnesses, witness.Shapes program) + (limits : ∀ witness ∈ witnesses, witness.LookupBounds) + (pooled : circuitQueryPool (witnesses.map (·.emission)) ⊆ queries) + {request : Bytecode.AIR.Call} (shape : request.LookupShape program) + (root : functionMessage request ∈ queries) : + Bytecode.AIR.Execution program (memoryFacts tables.memory) request := by + obtain ⟨functions, _, global, valid, queried⟩ := circuitWitnesses_interpret tables witnesses + balanced bounded widths memoryValid canonical counted circuits emitted satisfied shapes limits pooled + apply global.roots_execute (roots := [request]) programShapes valid + (functionQueries_in_pool ?_ queried) (functionByteQueries_in_pool queried) shape List.mem_cons_self + intro message member + have equal : message = functionMessage request := List.mem_singleton.mp member + rwa [equal] + +end Aiur.AIR diff --git a/Ix/Aiur/Proofs/CircuitTraces.lean b/Ix/Aiur/Proofs/CircuitTraces.lean new file mode 100644 index 000000000..d11a5f147 --- /dev/null +++ b/Ix/Aiur/Proofs/CircuitTraces.lean @@ -0,0 +1,217 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.EncodedCircuitExecution +import Ix.Aiur.Proofs.LookupBudget + +/-! Canonical circuit traces encode the activation bitmap and active-order +degrees directly. Successful emission supplies every row's circuit and +lookup extent. Unit consumers fit the trace capacity, which the checked +global budget bounds below the field characteristic. Native extraction +from the accepted commitments and proof metadata remains separate. -/ + +namespace Aiur.AIR +open Bytecode + +/-- Trace assignments indexed by the canonical circuit order. An active +circuit has exactly the height specified by its active-position degree. -/ +inductive CircuitTraces : List Circuit → Type where + | nil : CircuitTraces [] + | inactive (circuit : Circuit) {circuits : List Circuit} (rest : CircuitTraces circuits) : + CircuitTraces (circuit :: circuits) + | active (circuit : Circuit) (degree : Nat) (values : Fin (2 ^ degree) → Nat → G) + {circuits : List Circuit} (rest : CircuitTraces circuits) : CircuitTraces (circuit :: circuits) + +def CircuitTraces.bitmap {circuits : List Circuit} : CircuitTraces circuits → List Bool + | .nil => [] + | .inactive _ rest => false :: rest.bitmap + | .active _ _ _ rest => true :: rest.bitmap + +def CircuitTraces.degrees {circuits : List Circuit} : CircuitTraces circuits → List Nat + | .nil => [] + | .inactive _ rest => rest.degrees + | .active _ degree _ rest => degree :: rest.degrees + +def CircuitTraces.capacity {circuits : List Circuit} : CircuitTraces circuits → Nat + | .nil => 0 + | .inactive _ rest => rest.capacity + | .active circuit degree _ rest => 2 ^ degree * circuit.layout.lookups + rest.capacity + +def emitCircuitWitness (program : Toplevel) (circuit : Circuit) (values : Nat → G) : Option CircuitWitness := do + let emission ← circuit.emitRow values program + return ⟨circuit, values, emission⟩ + +def CircuitTraces.emitWitnesses {circuits : List Circuit} (program : Toplevel) : + CircuitTraces circuits → Option (List CircuitWitness) + | .nil => some [] + | .inactive _ rest => rest.emitWitnesses program + | .active circuit _ values rest => do + let first ← (List.ofFn values).mapM (emitCircuitWitness program circuit) + let later ← rest.emitWitnesses program + return first ++ later + +theorem CircuitTraces.slot_sum_append {circuits : List Circuit} (traces : CircuitTraces circuits) + (otherSlots : List Nat) (otherActive : List Bool) (otherDegrees : List Nat) : + lookupSlotSum (circuits.map (·.layout.lookups) ++ otherSlots) + (traces.bitmap ++ otherActive) (traces.degrees ++ otherDegrees) = + (lookupSlotSum otherSlots otherActive otherDegrees).map (traces.capacity + ·) := by + induction traces with + | nil => + simp only [List.map_nil, List.nil_append, bitmap, degrees, capacity, Nat.zero_add] + cases lookupSlotSum otherSlots otherActive otherDegrees <;> rfl + | inactive circuit rest ih => + simp only [List.map_cons, List.cons_append, bitmap, degrees, capacity, lookupSlotSum] + exact ih + | active circuit degree values rest ih => + simp only [List.map_cons, List.cons_append, bitmap, degrees, capacity, lookupSlotSum, ih, + bind, Option.bind] + cases lookupSlotSum otherSlots otherActive otherDegrees <;> + simp only [Option.map_none, Option.map_some, pure, Nat.add_assoc] + +theorem CircuitTraces.capacity_bounded {circuits : List Circuit} (traces : CircuitTraces circuits) + {otherSlots : List Nat} {otherActive : List Bool} {otherDegrees : List Nat} {result : Nat} + (accepted : lookupQueryBound (circuits.map (·.layout.lookups) ++ otherSlots) + (traces.bitmap ++ otherActive) (traces.degrees ++ otherDegrees) = some result) : + traces.capacity + 1 < gSize.toNat := by + obtain ⟨_, total, shape, count, bounded⟩ := lookupQueryBound_sound accepted + rw [traces.slot_sum_append] at shape + cases other : lookupSlotSum otherSlots otherActive otherDegrees with + | none => simp only [other, Option.map_none, reduceCtorEq] at shape + | some extra => + simp only [other, Option.map_some, Option.some.injEq] at shape + omega + +theorem emitCircuitWitness_spec {program : Toplevel} {circuit : Circuit} {values : Nat → G} + {witness : CircuitWitness} (emitted : emitCircuitWitness program circuit values = some witness) : + witness.circuit = circuit ∧ witness.values = values ∧ witness.Emitted program ∧ + witness.emission.lookupCount = circuit.layout.lookups := by + simp only [emitCircuitWitness, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i emission emissionEq + have equal := Option.some.inj emitted + subst witness + have description := (circuit.emitRow_spec values program emissionEq).1 + refine ⟨rfl, rfl, emissionEq, ?_⟩ + exact congrArg CircuitEmission.lookupCount description + +theorem encodedQueries_length (branchless : Bool) (queries : List QueryPart) (limit : Nat) : + (encodedQueries branchless queries limit).length ≤ limit := by + simpa only [encodedQueries, List.length_range] using + List.length_filterMap_le (encodedQuery branchless queries) (List.range limit) + +theorem encodedCircuitQueryPool_uniform_bound (witnesses : List CircuitWitness) (slots : Nat) + (bounded : ∀ witness ∈ witnesses, witness.emission.lookupCount ≤ slots) : + (encodedCircuitQueryPool (witnesses.map (·.emission))).length ≤ witnesses.length * slots := by + induction witnesses with + | nil => simp only [List.map_nil, encodedCircuitQueryPool, List.flatMap_nil, List.length_nil, Nat.zero_mul, Nat.le_refl] + | cons witness rest ih => + have first := Nat.le_trans (encodedQueries_length witness.emission.branchless + witness.emission.queries witness.emission.lookupCount) (bounded witness List.mem_cons_self) + have later := ih (fun item member => bounded item (List.mem_cons_of_mem _ member)) + simp only [encodedCircuitQueryPool, List.map_cons, List.flatMap_cons, + List.length_append, List.length_cons, Nat.add_mul, Nat.one_mul] at * + omega + +theorem emitCircuitWitnesses_spec {program : Toplevel} {circuit : Circuit} + {values : List (Nat → G)} {witnesses : List CircuitWitness} + (emitted : values.mapM (emitCircuitWitness program circuit) = some witnesses) : + witnesses.length = values.length ∧ + (∀ witness ∈ witnesses, witness.circuit = circuit ∧ witness.Emitted program ∧ + witness.emission.lookupCount = circuit.layout.lookups) := by + have related : List.Forall₂ (fun _ witness => witness.circuit = circuit ∧ witness.Emitted program ∧ + witness.emission.lookupCount = circuit.layout.lookups) values witnesses := by + apply mapM_forall₂ emitted + intro value member witness produced + obtain ⟨same, _, emitted, count⟩ := emitCircuitWitness_spec produced + exact ⟨same, emitted, count⟩ + have length : witnesses.length = values.length := by + clear emitted + induction related with + | nil => rfl + | cons first rest ih => simpa only [List.length_cons] using congrArg (· + 1) ih + refine ⟨length, ?_⟩ + intro witness member + obtain ⟨_, _, evidence⟩ := forall₂_right_member related member + exact evidence + +theorem CircuitTraces.emitWitnesses_spec {circuits : List Circuit} (traces : CircuitTraces circuits) + {program : Toplevel} {witnesses : List CircuitWitness} + (emitted : traces.emitWitnesses program = some witnesses) : + (∀ witness ∈ witnesses, witness.circuit ∈ circuits ∧ witness.Emitted program) ∧ + (encodedCircuitQueryPool (witnesses.map (·.emission))).length ≤ traces.capacity := by + induction traces generalizing witnesses with + | nil => + have equal := Option.some.inj emitted + subst witnesses + exact ⟨by simp only [List.not_mem_nil, false_implies, implies_true], Nat.le_refl 0⟩ + | inactive circuit rest ih => + obtain ⟨valid, bounded⟩ := ih emitted + exact ⟨fun witness member => ⟨List.mem_cons_of_mem _ (valid witness member).1, + (valid witness member).2⟩, bounded⟩ + | active circuit degree values rest ih => + simp only [emitWitnesses, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i first firstEmitted + dsimp only at emitted + split at emitted + · cases emitted + · rename_i later laterEmitted + have equal := Option.some.inj emitted + subst witnesses + obtain ⟨valid, bounded⟩ := ih laterEmitted + obtain ⟨length, firstValid⟩ := emitCircuitWitnesses_spec firstEmitted + have firstBound := encodedCircuitQueryPool_uniform_bound first circuit.layout.lookups + (fun witness member => Nat.le_of_eq (firstValid witness member).2.2) + simp only [List.length_ofFn] at length + rw [length] at firstBound + refine ⟨?_, ?_⟩ + · intro witness member + rcases List.mem_append.mp member with before | after + · have evidence := firstValid witness before + exact ⟨List.mem_cons.mpr (Or.inl evidence.1), evidence.2.1⟩ + · exact ⟨List.mem_cons_of_mem _ (valid witness after).1, (valid witness after).2⟩ + · simp only [encodedCircuitQueryPool, List.map_append, List.flatMap_append, + List.length_append, capacity] at * + omega + +end Aiur.AIR + +namespace Aiur.BoundVerifier +open AIR Bytecode.AIR + +/-- Trace rows and the checked native-style budget replace the separate +query-count premise. Native commitment/trace extraction remains separate. -/ +theorem Backend.trace_circuit_execution {selection : Selection} (backend : Backend selection) + (tables : AuxiliaryTables) (traces : CircuitTraces backend.compiled.bytecode.circuits.toList) + {witnesses : List CircuitWitness} + (emitted : traces.emitWitnesses backend.compiled.bytecode = some witnesses) + {otherSlots : List Nat} {otherActive : List Bool} {otherDegrees : List Nat} {result : Nat} + (budget : lookupQueryBound + (backend.compiled.bytecode.circuits.toList.map (·.layout.lookups) ++ otherSlots) + (traces.bitmap ++ otherActive) (traces.degrees ++ otherDegrees) = some result) + (width : Nat) (input : Array G) (arity : input.size = selection.inputSize) + (balanced : PaddedLookupBalance width + ((buildClaim selection.function input selection.success).toList :: + encodedCircuitQueryPool (witnesses.map (·.emission))) + (tables.circuitProviders (witnesses.map (·.emission)))) + (publicWidth : (buildClaim selection.function input selection.success).size + 1 ≤ width) + (queryWidths : ∀ query ∈ encodedCircuitQueryPool (witnesses.map (·.emission)), query.length ≤ width) + (memoryValid : ∀ size, MemoryRowsValid size (tables.memory size)) + (canonical : ∀ size ∈ tables.memoryWidths, size < gSize.toNat) + (satisfied : ∀ witness ∈ witnesses, witness.Satisfied) + (shapes : ∀ witness ∈ witnesses, witness.Shapes backend.compiled.bytecode) + (limits : ∀ witness ∈ witnesses, witness.LookupBounds) : + Execution backend.compiled.bytecode (memoryFacts tables.memory) + ⟨selection.function, input, selection.success, 0⟩ := by + obtain ⟨valid, bound⟩ := traces.emitWitnesses_spec emitted + have totalBound := traces.capacity_bounded budget + apply backend.encoded_circuit_execution tables witnesses width input arity balanced (by omega) + publicWidth queryWidths memoryValid canonical + (fun witness member => by simpa using (valid witness member).1) + (fun witness member => (valid witness member).2) satisfied shapes limits + +end Aiur.BoundVerifier diff --git a/Ix/Aiur/Proofs/Compilation.lean b/Ix/Aiur/Proofs/Compilation.lean new file mode 100644 index 000000000..1c36ddbc4 --- /dev/null +++ b/Ix/Aiur/Proofs/Compilation.lean @@ -0,0 +1,98 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Compiler +import Ix.Aiur.Proofs.Metadata +import Ix.Aiur.Proofs.Dedup +import Std.Data.HashMap.Lemmas + +/-! Artifact binding for the actual compilation pipeline. This strengthens +stage existence with equality to the returned artifact. Semantic success +reflection through these stages remains a separate obligation. -/ + +namespace Aiur + +theorem Source.Toplevel.compile_artifact_of_ok + {source : Source.Toplevel} {compiled : CompiledToplevel} + (h : source.compile = .ok compiled) : + ∃ inlined typed concrete raw names, + source.inlineCalls = .ok inlined ∧ + inlined.checkAndSimplify = .ok typed ∧ + typed.concretize = .ok concrete ∧ + concrete.toBytecode = .ok (raw, names) ∧ + compiled = finishCompilation inlined raw names := by + obtain ⟨inlined, typed, concrete, raw, names, hi, ht, hc, hb⟩ := + source.compile_stages_of_ok h + refine ⟨inlined, typed, concrete, raw, names, hi, ht, hc, hb, ?_⟩ + simpa only [Source.Toplevel.compile, hi, ht, hc, hb, Except.mapError, + bind, Except.bind, pure, Except.pure, Except.ok.injEq] using h.symm + +/-- Circuit reachability flags and partition construction retain every +bytecode body and input layout of the deduplicated program. -/ +theorem finishCompilation_sameCode (source : Source.Toplevel) (raw : Bytecode.Toplevel) + (names : Std.HashMap Global Bytecode.FunIdx) : + Bytecode.Eval.SameCode (finishCompilation source raw names).bytecode raw.deduplicate.1 := by + constructor + · simp [finishCompilation] + · intro i ha hb + simp [finishCompilation] + · intro i ha hb + simp [finishCompilation] + +/-- Backward success reflection for the final reachability/partition passes. +The preceding deduplication and source-to-bytecode passes remain separate. -/ +theorem finishCompilation_reflects {source : Source.Toplevel} {raw : Bytecode.Toplevel} + {names : Std.HashMap Global Bytecode.FunIdx} {function : Bytecode.FunIdx} + {args : Array G} {io : IOBuffer} {fuel : Nat} {result : Array G × IOBuffer} + (h : Bytecode.Eval.runFunction (finishCompilation source raw names).bytecode + function args io fuel = .ok result) : + Bytecode.Eval.runFunction raw.deduplicate.1 function args io fuel = .ok result := + (Bytecode.Eval.runFunction_sameCode (finishCompilation_sameCode source raw names) + function args io fuel).symm.trans h + +/-- Checked deduplication, reachability metadata and circuit construction +preserve and reflect success at the actual remapping of each original index. -/ +theorem finishCompilation_preserves_execution (source : Source.Toplevel) (raw : Bytecode.Toplevel) + (names : Std.HashMap Global Bytecode.FunIdx) (function : Bytecode.FunIdx) + (args : Array G) (io : IOBuffer) (fuel : Nat) (result : Array G × IOBuffer) : + Bytecode.Eval.runFunction raw function args io fuel = .ok result ↔ + Bytecode.Eval.runFunction (finishCompilation source raw names).bytecode + (raw.deduplicate.2 function) args io fuel = .ok result := by + rw [Bytecode.Eval.runFunction_sameCode (finishCompilation_sameCode source raw names)] + exact Bytecode.Eval.deduplicate_preserves_execution raw function args io fuel result + +private theorem fold_renamed_name_image {α : Type} [BEq α] [Hashable α] [LawfulBEq α] + (items : List (α × Nat)) (initial : Std.HashMap α Nat) (rename : Nat → Nat) + {name : α} {value : Nat} + (present : (items.foldl (fun acc item => acc.insert item.1 (rename item.2)) initial)[name]? = + some value) : + initial[name]? = some value ∨ ∃ before, (name, before) ∈ items ∧ rename before = value := by + induction items generalizing initial with + | nil => exact Or.inl present + | cons item items ih => + simp only [List.foldl_cons] at present + rcases ih _ present with prior | ⟨before, member, eq⟩ + · rw [Std.HashMap.getElem?_insert] at prior + split at prior + next same => + have hname : item.1 = name := eq_of_beq same + have hvalue : rename item.2 = value := Option.some.inj prior + exact Or.inr ⟨item.2, List.mem_cons.mpr (Or.inl (Prod.ext hname.symm rfl)), hvalue⟩ + next different => exact Or.inl prior + · exact Or.inr ⟨before, by simp [member], eq⟩ + +/-- A compiled entrypoint comes from the same name before deduplication, +with its index transformed by the actual selected renaming. -/ +theorem finishCompilation_nameMap_image {source : Source.Toplevel} {raw : Bytecode.Toplevel} + {names : Std.HashMap Global Bytecode.FunIdx} {name : Lean.Name} {function : Bytecode.FunIdx} + (present : (finishCompilation source raw names).getFuncIdx name = some function) : + ∃ original, names[Global.mk name]? = some original ∧ raw.deduplicate.2 original = function := by + simp only [finishCompilation, CompiledToplevel.getFuncIdx, Id.run, pure] at present + rw [Std.HashMap.fold_eq_foldl_toList] at present + rcases fold_renamed_name_image names.toList ∅ raw.deduplicate.2 present with impossible | ⟨original, member, eq⟩ + · simp at impossible + · exact ⟨original, by simpa using member, eq⟩ + +end Aiur diff --git a/Ix/Aiur/Proofs/Dedup.lean b/Ix/Aiur/Proofs/Dedup.lean new file mode 100644 index 000000000..96d754b3a --- /dev/null +++ b/Ix/Aiur/Proofs/Dedup.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.Renaming + +/-! The actual deduplication pass validates its proposed transformation. +These proofs require no correctness assumption about partition refinement. -/ + +namespace Aiur.Bytecode.Eval + +theorem validatesRenaming_sound {a b : Toplevel} {rename : FunIdx → FunIdx} + (valid : validatesRenaming a b (boundedRenaming a rename) = true) : + RenamedCode a b (boundedRenaming a rename) := by + simp only [validatesRenaming, Bool.and_eq_true, decide_eq_true_eq] at valid + have all := Array.all_eq_true.mp valid.2 + simp only [Array.size_range, Array.getElem_range] at all + have checked (i : Nat) (hi : i < a.functions.size) : + ∃ hj : boundedRenaming a rename i < b.functions.size, + a.functions[i].layout = b.functions[boundedRenaming a rename i].layout ∧ + rewriteBlock (boundedRenaming a rename) a.functions[i].body = + b.functions[boundedRenaming a rename i].body := by + have h := all i hi + simp only [dif_pos hi] at h + split at h + next hj => exact ⟨hj, by simpa only [Bool.and_eq_true, beq_iff_eq] using h⟩ + next hj => contradiction + constructor + · intro i + constructor + · intro hi + obtain ⟨hj, _⟩ := checked i hi + exact hj + · intro hj + by_cases hi : i < a.functions.size + · exact hi + · simp only [boundedRenaming, if_neg hi] at hj + exact Nat.lt_of_lt_of_le hj valid.1 + · intro i hi hj + obtain ⟨_, _, body⟩ := checked i hi + exact body + · intro i hi hj + obtain ⟨_, layout, _⟩ := checked i hi + exact congrArg FunctionLayout.inputSize layout + +theorem checkedRenaming_preserves_execution (source candidate : Toplevel) (rename : FunIdx → FunIdx) + (function : FunIdx) (args : Array G) (io : IOBuffer) (fuel : Nat) (result : Array G × IOBuffer) : + runFunction source function args io fuel = .ok result ↔ + runFunction (checkedRenaming source candidate rename).1 + ((checkedRenaming source candidate rename).2 function) + args io fuel = .ok result := by + unfold checkedRenaming + dsimp only + split + next valid => exact runFunction_renamed_iff (validatesRenaming_sound valid) function args io fuel result + next invalid => rfl + +theorem deduplicate_preserves_execution (source : Toplevel) + (function : FunIdx) (args : Array G) (io : IOBuffer) (fuel : Nat) (result : Array G × IOBuffer) : + runFunction source function args io fuel = .ok result ↔ + runFunction source.deduplicate.1 (source.deduplicate.2 function) + args io fuel = .ok result := + checkedRenaming_preserves_execution source source.deduplicateCandidate.1 source.deduplicateCandidate.2 + function args io fuel result + +end Aiur.Bytecode.Eval diff --git a/Ix/Aiur/Proofs/EncodedCircuitExecution.lean b/Ix/Aiur/Proofs/EncodedCircuitExecution.lean new file mode 100644 index 000000000..288662132 --- /dev/null +++ b/Ix/Aiur/Proofs/EncodedCircuitExecution.lean @@ -0,0 +1,159 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.BranchlessSlots +import Ix.Aiur.Proofs.PublicCircuitExecution + +/-! Encoded circuit consumer messages give the same padded query pool +and query count as decoded active operations. Their physical message widths +bound the decoded widths. This connects valued slot balance to execution +of the selected public success call without a single-writer assumption. +Native trace extraction and the cryptographic reduction remain separate. -/ + +namespace Aiur.AIR +open Bytecode + +theorem gateMessage_length (branchless : Bool) (gate : G) (message : List G) : + (gateMessage branchless gate message).length = message.length := by + cases branchless <;> simp only [gateMessage, Bool.false_eq_true, if_false, + scaleMessage, List.length_map, if_true] + +private theorem slotMessage_fold_start (branchless : Bool) (parts : List (G × List G)) (start : List G) : + start.length ≤ (parts.foldl (fun combined part => addMessages combined + (gateMessage branchless part.1 part.2)) start).length := by + induction parts generalizing start with + | nil => exact Nat.le_refl _ + | cons part rest ih => + have step := ih (addMessages start (gateMessage branchless part.1 part.2)) + simp only [List.foldl_cons] + apply Nat.le_trans _ step + rw [addMessages_length] + exact Nat.le_max_left _ _ + +private theorem slotMessage_fold_member (branchless : Bool) {parts : List (G × List G)} + {part : G × List G} (member : part ∈ parts) (start : List G) : + part.2.length ≤ (parts.foldl (fun combined part => addMessages combined + (gateMessage branchless part.1 part.2)) start).length := by + induction parts generalizing start with + | nil => cases member + | cons first rest ih => + rcases List.mem_cons.mp member with equal | later + · subst part + apply Nat.le_trans _ (slotMessage_fold_start branchless rest _) + rw [addMessages_length, gateMessage_length] + exact Nat.le_max_right _ _ + · exact ih later _ + +theorem slotMessage_member_length (branchless : Bool) {parts : List (G × List G)} + {part : G × List G} (member : part ∈ parts) : part.2.length ≤ (slotMessage branchless parts).length := + slotMessage_fold_member branchless member [] + +theorem QuerySlots.encoded_member {gate : G} {start finish : Nat} {queries : List QueryPart} + (slots : QuerySlots gate start finish queries) (branchless : Bool) + {query : QueryPart} (member : query ∈ queries) (active : query.selector = 1) : + slotMessage branchless (querySlotParts queries query.slot) ∈ encodedQueries branchless queries finish := by + have count : queryCount queries query.slot = 1 := congrArg List.length (slots.active_singleton member active) + have multiplicity : querySlotMultiplicity queries query.slot = 1 := by + rw [slots.slot_multiplicity, count] + rfl + apply List.mem_filterMap.mpr + refine ⟨query.slot, List.mem_range.mpr (slots.range query member).2, ?_⟩ + simp only [encodedQuery, multiplicity, if_true] + +theorem QuerySlots.decoded_widths {gate : G} {start finish : Nat} {queries : List QueryPart} + (slots : QuerySlots gate start finish queries) (branchless : Bool) (width : Nat) + (widths : ∀ message ∈ encodedQueries branchless queries finish, message.length ≤ width) : + ∀ message ∈ decodedQueries queries finish, message.length ≤ width := by + intro message present + obtain ⟨slot, _, decoded⟩ := List.mem_filterMap.mp present + cases found : activeQuerySlot queries slot with + | nil => simp only [decodedQuery, found, List.head?_nil, Option.map_none, reduceCtorEq] at decoded + | cons query rest => + have member : query ∈ activeQuerySlot queries slot := by rw [found]; exact List.mem_cons_self + obtain ⟨original, _, active⟩ := by + simpa only [activeQuerySlot, List.mem_filter, Bool.and_eq_true, beq_iff_eq] using member + simp only [decodedQuery, found, List.head?_cons, Option.map_some, Option.some.injEq] at decoded + rw [← decoded] + exact Nat.le_trans (slotMessage_member_length branchless (querySlotParts_member original)) + (widths _ (slots.encoded_member branchless original active)) + +/-- Unit consumers encoded by the valued circuit's physical lookup slots. +The return provider is kept separately in `circuitProviders`. -/ +def encodedCircuitQueryPool (emissions : List CircuitEmission) : List (List G) := + emissions.flatMap fun emission => encodedQueries emission.branchless emission.queries emission.lookupCount + +theorem circuitWitnesses_queries_reflect {program : Toplevel} (witnesses : List CircuitWitness) + (counted : program.validateRowCounts = true) + (circuits : ∀ witness ∈ witnesses, witness.circuit ∈ program.circuits) + (emitted : ∀ witness ∈ witnesses, witness.Emitted program) + (satisfied : ∀ witness ∈ witnesses, witness.Satisfied) + (limits : ∀ witness ∈ witnesses, witness.LookupBounds) (width : Nat) : + (encodedCircuitQueryPool (witnesses.map (·.emission))).map (padMessage width) = + (circuitQueryPool (witnesses.map (·.emission))).map (padMessage width) := by + simp only [encodedCircuitQueryPool, circuitQueryPool, List.map_flatMap] + rw [List.flatMap, List.flatMap] + apply congrArg List.flatten + apply List.map_congr_left + intro emission member + obtain ⟨witness, witnessMember, equal⟩ := List.mem_map.mp member + subst emission + exact witness.circuit.emitRow_queries_reflect witness.values program (emitted witness witnessMember) + (Toplevel.validateRowCounts_circuit counted (circuits witness witnessMember)) + (limits witness witnessMember).1 (limits witness witnessMember).2 (satisfied witness witnessMember) width + +theorem circuitWitnesses_decoded_widths {program : Toplevel} (witnesses : List CircuitWitness) + (counted : program.validateRowCounts = true) + (circuits : ∀ witness ∈ witnesses, witness.circuit ∈ program.circuits) + (emitted : ∀ witness ∈ witnesses, witness.Emitted program) + (satisfied : ∀ witness ∈ witnesses, witness.Satisfied) + (limits : ∀ witness ∈ witnesses, witness.LookupBounds) (width : Nat) + (widths : ∀ query ∈ encodedCircuitQueryPool (witnesses.map (·.emission)), query.length ≤ width) : + ∀ query ∈ circuitQueryPool (witnesses.map (·.emission)), query.length ≤ width := by + intro query member + obtain ⟨emission, emissionMember, queryMember⟩ := List.mem_flatMap.mp member + obtain ⟨witness, witnessMember, equal⟩ := List.mem_map.mp emissionMember + subst emission + obtain ⟨bounded, bounds, _, _⟩ := witness.circuit.emitRow_count_bounds witness.values program + (emitted witness witnessMember) (Toplevel.validateRowCounts_circuit counted (circuits witness witnessMember)) + (satisfied witness witnessMember) + have slots := witness.circuit.emitRow_querySlots witness.values program (emitted witness witnessMember) + bounded bounds (limits witness witnessMember).1 (limits witness witnessMember).2 (satisfied witness witnessMember) + exact slots.decoded_widths witness.emission.branchless width + (fun message present => widths message (List.mem_flatMap.mpr + ⟨witness.emission, List.mem_map.mpr ⟨witness, witnessMember, rfl⟩, present⟩)) query queryMember + +end Aiur.AIR + +namespace Aiur.BoundVerifier +open AIR Bytecode.AIR + +theorem Backend.encoded_circuit_execution {selection : Selection} (backend : Backend selection) + (tables : AuxiliaryTables) (witnesses : List CircuitWitness) (width : Nat) + (input : Array G) (arity : input.size = selection.inputSize) + (balanced : PaddedLookupBalance width + ((buildClaim selection.function input selection.success).toList :: + encodedCircuitQueryPool (witnesses.map (·.emission))) + (tables.circuitProviders (witnesses.map (·.emission)))) + (bounded : (encodedCircuitQueryPool (witnesses.map (·.emission))).length + 1 < gSize.toNat) + (publicWidth : (buildClaim selection.function input selection.success).size + 1 ≤ width) + (queryWidths : ∀ query ∈ encodedCircuitQueryPool (witnesses.map (·.emission)), query.length ≤ width) + (memoryValid : ∀ size, MemoryRowsValid size (tables.memory size)) + (canonical : ∀ size ∈ tables.memoryWidths, size < gSize.toNat) + (circuits : ∀ witness ∈ witnesses, witness.circuit ∈ backend.compiled.bytecode.circuits) + (emitted : ∀ witness ∈ witnesses, witness.Emitted backend.compiled.bytecode) + (satisfied : ∀ witness ∈ witnesses, witness.Satisfied) + (shapes : ∀ witness ∈ witnesses, witness.Shapes backend.compiled.bytecode) + (limits : ∀ witness ∈ witnesses, witness.LookupBounds) : + Execution backend.compiled.bytecode (memoryFacts tables.memory) + ⟨selection.function, input, selection.success, 0⟩ := by + have messages := circuitWitnesses_queries_reflect witnesses backend.rowCounts circuits emitted satisfied limits width + have lengths := congrArg List.length messages + simp only [List.length_map] at lengths + apply backend.public_circuit_execution tables witnesses width input arity + (balanced.congr_queries (by simp only [List.map_cons, messages])) (by rwa [← lengths]) publicWidth + (circuitWitnesses_decoded_widths witnesses backend.rowCounts circuits emitted satisfied limits width queryWidths) + memoryValid canonical circuits emitted satisfied shapes limits + +end Aiur.BoundVerifier diff --git a/Ix/Aiur/Proofs/Execution.lean b/Ix/Aiur/Proofs/Execution.lean new file mode 100644 index 000000000..f34e5688a --- /dev/null +++ b/Ix/Aiur/Proofs/Execution.lean @@ -0,0 +1,182 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Semantics.AIR +import Ix.Aiur.Proofs.Lookup + +/-! +Finite execution from locally interpreted rows and exact lookup balance. + +The interface keeps function requests, provider multiplicities, active-row +rank bytes and call-gap bytes explicit. Local row interpretation is still an +extraction obligation for the native constraint emitter. This theorem closes +the global call-table obligation once those local interpretations, exact +balance and the query-count bounds have been established. In particular, it +does not assume that a matching provider already has a finite execution. +-/ + +namespace Aiur.AIR + +open Bytecode.AIR + +/-- One interpreted function row; each call carries its six gap bytes. -/ +structure FunctionRow where + request : Call + calls : List (Call × (Fin 6 → G)) + rankBytes : Fin 6 → G + selector : G + multiplicity : G + +def FunctionRow.requests (row : FunctionRow) : List Call := row.calls.map Prod.fst + +def FunctionRow.byteQueries (row : FunctionRow) : List (G × G) := + rankByteQueries row.rankBytes ++ row.calls.flatMap fun edge => rankByteQueries edge.2 + +/-- The concrete local obligations of an interpreted row. The execution +field resolves operations and control flow but leaves calls as requests. -/ +structure FunctionRow.Valid (program : Bytecode.Toplevel) (memory : Memory) + (row : FunctionRow) : Prop where + selector : row.selector = 0 ∨ row.selector = 1 + activity : activityConstraint row.multiplicity row.selector = 0 + rank : row.selector = 1 → row.request.rank = packRank row.rankBytes + execution : row.selector = 1 → RunFunction program memory row.request row.requests + order : ∀ edge ∈ row.calls, + row.selector * callOrderConstraint row.request.rank edge.1.rank (packRank edge.2) = 0 + +def functionProviders (rows : List FunctionRow) : List (Provider Call) := + rows.map fun row => (row.request, row.multiplicity) + +def functionQueries (roots : List Call) (rows : List FunctionRow) : List Call := + roots ++ rows.flatMap fun row => if row.selector = 1 then row.requests else [] + +def functionByteQueries (rows : List FunctionRow) : List (G × G) := + rows.flatMap fun row => if row.selector = 1 then row.byteQueries else [] + +theorem FunctionRow.Valid.active_of_nonzero {program : Bytecode.Toplevel} + {memory : Memory} {row : FunctionRow} (valid : row.Valid program memory) + (nonzero : row.multiplicity ≠ 0) : row.selector = 1 := by + rcases valid.selector with inactive | active + · exact False.elim (nonzero (inactive_multiplicity_zero inactive valid.activity)) + · exact active + +theorem functionByteQueries_member {rows : List FunctionRow} {row : FunctionRow} + (member : row ∈ rows) (active : row.selector = 1) : + row.byteQueries ⊆ functionByteQueries rows := by + intro query queried + apply List.mem_flatMap.mpr + exact ⟨row, member, by simpa only [if_pos active] using queried⟩ + +theorem functionQueries_member {roots : List Call} {rows : List FunctionRow} + {row : FunctionRow} (member : row ∈ rows) (active : row.selector = 1) : + row.requests ⊆ functionQueries roots rows := by + intro query queried + apply List.mem_append_right + apply List.mem_flatMap.mpr + exact ⟨row, member, by simpa only [if_pos active] using queried⟩ + +/-- Every requested call has an active row supplying exactly that call, +including its rank. Provider multiplicities need not be natural counts. -/ +theorem functionQueries_provider {program : Bytecode.Toplevel} {memory : Memory} + {roots : List Call} {rows : List FunctionRow} + (valid : ∀ row ∈ rows, row.Valid program memory) + (balanced : ExactLookupBalance (functionQueries roots rows) (functionProviders rows)) + (bounded : (functionQueries roots rows).length < gSize.toNat) + {request : Call} (queried : request ∈ functionQueries roots rows) : + ∃ row ∈ rows, row.request = request ∧ row.selector = 1 := by + obtain ⟨provider, member, same, nonzero⟩ := + exactLookupBalance_provider balanced bounded queried + obtain ⟨row, rowMember, providerEq⟩ := List.mem_map.mp member + subst provider + exact ⟨row, rowMember, same, (valid row rowMember).active_of_nonzero nonzero⟩ + +theorem FunctionRow.Valid.rank_bounded {program : Bytecode.Toplevel} + {memory : Memory} {rows : List FunctionRow} {row : FunctionRow} + (valid : row.Valid program memory) (member : row ∈ rows) (active : row.selector = 1) + (weights : Fin 65536 → G) + (balanced : ExactLookupBalance (functionByteQueries rows) (byteRangeProviders weights)) + (bounded : (functionByteQueries rows).length < gSize.toNat) : + row.request.rank.n < callRankBound := by + rw [valid.rank active] + apply packRank_lt + apply exactLookupBalance_rankBytes weights balanced bounded + intro pair queried + apply functionByteQueries_member member active + exact List.mem_append_left _ queried + +theorem FunctionRow.Valid.call_order {program : Bytecode.Toplevel} {memory : Memory} + {rows : List FunctionRow} {row : FunctionRow} (valid : row.Valid program memory) + (member : row ∈ rows) (active : row.selector = 1) + (weights : Fin 65536 → G) + (balanced : ExactLookupBalance (functionByteQueries rows) (byteRangeProviders weights)) + (bounded : (functionByteQueries rows).length < gSize.toNat) + {edge : Call × (Fin 6 → G)} (called : edge ∈ row.calls) + (childBound : edge.1.rank.n < callRankBound) : + row.request.rank.n < edge.1.rank.n := by + have gapBound : (packRank edge.2).n < callRankBound := by + apply packRank_lt + apply exactLookupBalance_rankBytes weights balanced bounded + intro pair queried + apply functionByteQueries_member member active + apply List.mem_append_right + exact List.mem_flatMap.mpr ⟨edge, called, queried⟩ + exact active_call_order_strict active + (valid.rank_bounded member active weights balanced bounded) + childBound gapBound (valid.order edge called) + +/-- Active locally valid rows give finite call derivations. The proof uses +the actual 48-bit rank/gap equations and balanced byte-table queries, not a +postulated acyclic call graph or an execution assumption on callees. -/ +theorem balancedRows_execute {program : Bytecode.Toplevel} {memory : Memory} + {roots : List Call} {rows : List FunctionRow} + (valid : ∀ row ∈ rows, row.Valid program memory) + (balanced : ExactLookupBalance (functionQueries roots rows) (functionProviders rows)) + (bounded : (functionQueries roots rows).length < gSize.toNat) + (weights : Fin 65536 → G) + (bytesBalanced : ExactLookupBalance (functionByteQueries rows) (byteRangeProviders weights)) + (bytesBounded : (functionByteQueries rows).length < gSize.toNat) + {row : FunctionRow} (member : row ∈ rows) (active : row.selector = 1) : + Execution program memory row.request := by + have all : ∀ n : Nat, ∀ row : FunctionRow, + callRankBound - row.request.rank.n = n → row ∈ rows → row.selector = 1 → + Execution program memory row.request := by + intro n + induction n using Nat.strongRecOn with + | ind n ih => + intro parent measure member active + apply Execution.function ((valid parent member).execution active) + intro child called + obtain ⟨edge, edgeMember, edgeEq⟩ := List.mem_map.mp called + obtain ⟨provider, providerMember, same, providerActive⟩ := + functionQueries_provider valid balanced bounded + (functionQueries_member member active called) + have childBound := (valid provider providerMember).rank_bounded + providerMember providerActive weights bytesBalanced bytesBounded + have order := (valid parent member).call_order member active weights + bytesBalanced bytesBounded edgeMember + (by simpa only [edgeEq, ← same] using childBound) + rw [edgeEq, ← same] at order + have smaller : callRankBound - provider.request.rank.n < n := by omega + rw [← same] + exact ih _ smaller provider rfl providerMember providerActive + exact all _ row rfl member active + +/-- Every public/root request has a finite derivation under the same local, +balance and count obligations. Root rank zero may be imposed by the public +message encoding without changing this statement. -/ +theorem balancedRoots_execute {program : Bytecode.Toplevel} {memory : Memory} + {roots : List Call} {rows : List FunctionRow} + (valid : ∀ row ∈ rows, row.Valid program memory) + (balanced : ExactLookupBalance (functionQueries roots rows) (functionProviders rows)) + (bounded : (functionQueries roots rows).length < gSize.toNat) + (weights : Fin 65536 → G) + (bytesBalanced : ExactLookupBalance (functionByteQueries rows) (byteRangeProviders weights)) + (bytesBounded : (functionByteQueries rows).length < gSize.toNat) + {request : Call} (root : request ∈ roots) : Execution program memory request := by + obtain ⟨row, member, same, active⟩ := functionQueries_provider valid balanced bounded + (List.mem_append_left _ root) + rw [← same] + exact balancedRows_execute valid balanced bounded weights bytesBalanced bytesBounded member active + +end Aiur.AIR diff --git a/Ix/Aiur/Proofs/Field.lean b/Ix/Aiur/Proofs/Field.lean new file mode 100644 index 000000000..07da05f5e --- /dev/null +++ b/Ix/Aiur/Proofs/Field.lean @@ -0,0 +1,268 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.Lookup +import Init.Data.Nat.Coprime +import Init.Data.List.Nat.Range +import Init.Data.List.Perm + +/-! +Primality and local field consequences for the actual Goldilocks model. + +A kernel-checked certificate gives a unit of order `2^32` modulo every +nontrivial divisor of `2^64 - 2^32 + 1`. Its first `2^32` powers are distinct, +so each such divisor is at least `2^32`. Two nontrivial factors would have +product at least `2^64`, proving primality. Only 32 modular squarings are +evaluated; the proof neither enumerates the field nor evaluates enormous +unreduced powers. It uses no native-evaluation axiom or external field oracle. + +The resulting no-zero-divisors theorem discharges boolean-selector and +equality-test polynomial implications. These are arithmetic facts about +Lean's `G`; extraction from native constraint expressions remains separate. +-/ + +namespace Aiur.GoldilocksProof + +/-- Repeated modular squaring, with an explicit modulus and base. -/ +def squareMod (modulus base : Nat) : Nat → Nat + | 0 => base % modulus + | n + 1 => let previous := squareMod modulus base n; previous * previous % modulus + +theorem squareMod_eq (modulus base n : Nat) : + squareMod modulus base n = base ^ (2 ^ n) % modulus := by + induction n with + | zero => simp [squareMod] + | succ n ih => + rw [squareMod, ih, Nat.pow_succ, Nat.pow_mul] + simp only [Nat.pow_two, Nat.mul_mod_mod, Nat.mod_mul_mod] + +theorem squareMod_half : squareMod gSize.toNat 1753635133440165772 31 = gSize.toNat - 1 := by + decide +kernel + +theorem squareMod_full : squareMod gSize.toNat 1753635133440165772 32 = 1 := by + decide +kernel + +theorem pow_mod_period {modulus base period : Nat} (hmod : 1 < modulus) + (hperiod : base ^ period % modulus = 1) (exponent : Nat) : + base ^ exponent % modulus = base ^ (exponent % period) % modulus := by + conv => lhs; rw [← Nat.mod_add_div exponent period] + rw [Nat.pow_add, Nat.pow_mul, Nat.mul_mod, Nat.pow_mod (base ^ period), hperiod] + simp only [Nat.one_pow, Nat.mod_eq_of_lt hmod, Nat.mul_one, Nat.mod_mod] + +theorem pow_mod_gcd {modulus base : Nat} (hmod : 1 < modulus) (a b : Nat) + (ha : base ^ a % modulus = 1) (hb : base ^ b % modulus = 1) : + base ^ (Nat.gcd a b) % modulus = 1 := by + induction a using Nat.strongRecOn generalizing b with + | ind a ih => + by_cases hz : a = 0 + · subst a; simpa only [Nat.gcd_zero_left] using hb + · rw [Nat.gcd_rec] + apply ih (b % a) (Nat.mod_lt _ (Nat.pos_of_ne_zero hz)) a + · exact (pow_mod_period hmod ha b).symm.trans hb + · exact ha + +theorem divisor_two_pow {d n : Nat} (divides : d ∣ 2 ^ n) : + ∃ k, k ≤ n ∧ d = 2 ^ k := by + induction n generalizing d with + | zero => exact ⟨0, Nat.le_refl _, Nat.eq_one_of_dvd_one divides⟩ + | succ n ih => + rw [Nat.pow_succ, Nat.dvd_mul] at divides + obtain ⟨a, b, ha, hb, equal⟩ := divides + obtain ⟨k, hk, rfl⟩ := ih ha + have bound : b ≤ 2 := Nat.le_of_dvd (by decide) hb + have positive : 0 < b := Nat.pos_of_dvd_of_pos hb (by decide) + have cases : b = 1 ∨ b = 2 := by omega + rcases cases with rfl | rfl + · exact ⟨k, by omega, by simpa only [Nat.mul_one] using equal.symm⟩ + · exact ⟨k + 1, by omega, by simpa only [Nat.pow_succ] using equal.symm⟩ + +theorem proper_divisor_two_pow {d n : Nat} (divides : d ∣ 2 ^ (n + 1)) + (proper : d < 2 ^ (n + 1)) : d ∣ 2 ^ n := by + obtain ⟨k, hk, rfl⟩ := divisor_two_pow divides + apply Nat.pow_dvd_pow + have ne : k ≠ n + 1 := by intro equal; subst k; exact Nat.lt_irrefl _ proper + omega + +theorem pow_mod_ne_one {modulus base n : Nat} (hmod : 1 < modulus) + (full : base ^ (2 ^ (n + 1)) % modulus = 1) + (half : base ^ (2 ^ n) % modulus ≠ 1) + {k : Nat} (positive : 0 < k) (small : k < 2 ^ (n + 1)) : + base ^ k % modulus ≠ 1 := by + intro equal + have hg := pow_mod_gcd hmod k (2 ^ (n + 1)) equal full + have gd : Nat.gcd k (2 ^ (n + 1)) ∣ 2 ^ n := by + apply proper_divisor_two_pow (Nat.gcd_dvd_right _ _) + exact Nat.lt_of_le_of_lt (Nat.gcd_le_left _ positive) small + apply half + rw [pow_mod_period hmod hg, Nat.mod_eq_zero_of_dvd gd] + exact Nat.mod_eq_of_lt hmod + +theorem pow_mod_injective {modulus base n : Nat} (hmod : 1 < modulus) + (full : base ^ (2 ^ (n + 1)) % modulus = 1) + (half : base ^ (2 ^ n) % modulus ≠ 1) + {i j : Nat} (hi : i < 2 ^ (n + 1)) (hj : j < 2 ^ (n + 1)) + (equal : base ^ i % modulus = base ^ j % modulus) : i = j := by + suffices step : ∀ i j, i < j → j < 2 ^ (n + 1) → + base ^ i % modulus = base ^ j % modulus → False by + by_cases h : i < j + · exact False.elim (step i j h hj equal) + · by_cases h' : j < i + · exact False.elim (step j i h' hi equal.symm) + · omega + intro i j lt bound same + have translated : base ^ (i + (2 ^ (n + 1) - i)) % modulus = + base ^ (j + (2 ^ (n + 1) - i)) % modulus := by + rw [Nat.pow_add base i, Nat.pow_add base j, + Nat.mul_mod (base ^ i), Nat.mul_mod (base ^ j), same] + have left : i + (2 ^ (n + 1) - i) = 2 ^ (n + 1) := by omega + have right : j + (2 ^ (n + 1) - i) = (j - i) + 2 ^ (n + 1) := by omega + rw [left, full, right, Nat.pow_add, Nat.mul_mod, full, Nat.mul_one, Nat.mod_mod] at translated + exact pow_mod_ne_one hmod full half (by omega) (by omega) translated.symm + +theorem two_pow_le_modulus {modulus base n : Nat} (hmod : 1 < modulus) + (full : base ^ (2 ^ (n + 1)) % modulus = 1) + (half : base ^ (2 ^ n) % modulus ≠ 1) : 2 ^ (n + 1) ≤ modulus := by + let residues := List.ofFn fun i : Fin (2 ^ (n + 1)) => base ^ i.val % modulus + have distinct : residues.Nodup := by + apply List.pairwise_iff_getElem.mpr + intro i j hi hj lt same + simp only [residues, List.getElem_ofFn] at same + have hi' : i < 2 ^ (n + 1) := by simpa only [residues, List.length_ofFn] using hi + have hj' : j < 2 ^ (n + 1) := by simpa only [residues, List.length_ofFn] using hj + have equal := pow_mod_injective hmod full half hi' hj' same + omega + have subset : residues ⊆ List.range modulus := by + intro value member + obtain ⟨i, rfl⟩ := List.mem_ofFn.mp member + exact List.mem_range.mpr (Nat.mod_lt _ (by omega)) + have bound := distinct.length_le_of_subset subset + simpa only [residues, List.length_ofFn, List.length_range] using bound + +/-- A power-of-two order certificate forces every nontrivial divisor to +contain at least that many distinct residues. -/ +theorem two_power_divisor_bound {modulus base n : Nat} + (certificateFull : squareMod modulus base (n + 1) = 1) + (certificateHalf : Nat.gcd modulus (squareMod modulus base n - 1) = 1) + {d : Nat} (divides : d ∣ modulus) (nontrivial : 1 < d) : 2 ^ (n + 1) ≤ d := by + have full : base ^ (2 ^ (n + 1)) % d = 1 := by + have h := congrArg (· % d) certificateFull + rw [squareMod_eq, Nat.mod_mod_of_dvd _ divides, Nat.mod_eq_of_lt nontrivial] at h + exact h + have half : base ^ (2 ^ n) % d ≠ 1 := by + intro equal + have h : squareMod modulus base n % d = 1 := by + rw [squareMod_eq, Nat.mod_mod_of_dvd _ divides, equal] + have hd : d ∣ squareMod modulus base n - 1 := + Nat.dvd_of_mod_eq_zero (Nat.sub_mod_eq_zero_of_mod_eq + (h.trans (Nat.mod_eq_of_lt nontrivial).symm)) + have one := Nat.dvd_gcd divides hd + rw [certificateHalf] at one + have := Nat.eq_one_of_dvd_one one + omega + exact two_pow_le_modulus nontrivial full half + +theorem nontrivial_divisor_large {d : Nat} (divides : d ∣ gSize.toNat) + (nontrivial : 1 < d) : 2 ^ 32 ≤ d := by + apply two_power_divisor_bound (modulus := gSize.toNat) (base := 1753635133440165772) + (n := 31) squareMod_full ?_ divides nontrivial + rw [squareMod_half] + decide +kernel + +theorem goldilocks_divisors {d : Nat} (divides : d ∣ gSize.toNat) : + d = 1 ∨ d = gSize.toNat := by + obtain ⟨e, product⟩ := divides + by_cases hd : d = 1 + · exact Or.inl hd + · by_cases he : e = 1 + · exact Or.inr (by simpa only [he, Nat.mul_one] using product.symm) + · have positiveD : 0 < d := Nat.pos_of_dvd_of_pos ⟨e, product⟩ (by decide) + have dividesE : e ∣ gSize.toNat := ⟨d, product.trans (Nat.mul_comm _ _)⟩ + have positiveE : 0 < e := Nat.pos_of_dvd_of_pos dividesE (by decide) + have boundD := nontrivial_divisor_large ⟨e, product⟩ (by omega) + have boundE := nontrivial_divisor_large dividesE (by omega) + have impossible := Nat.mul_le_mul boundD boundE + rw [← product] at impossible + have bad : ¬(2 ^ 32 * 2 ^ 32 ≤ gSize.toNat) := by decide +kernel + exact False.elim (bad impossible) + +end Aiur.GoldilocksProof + +namespace Aiur + +/-- Primality stated explicitly as the nontriviality and divisor criterion. -/ +theorem gSize_prime : 1 < gSize.toNat ∧ + ∀ d : Nat, d ∣ gSize.toNat → d = 1 ∨ d = gSize.toNat := + ⟨by decide, fun _ => GoldilocksProof.goldilocks_divisors⟩ + +theorem G.n_eq_zero_iff (a : G) : a.n = 0 ↔ a = 0 := by + constructor + · intro equal + rw [← G.ofNat_n a, equal] + rfl + · intro equal; subst a; rfl + +theorem G.coprime_characteristic_of_ne_zero {a : G} (nonzero : a ≠ 0) : + Nat.Coprime gSize.toNat a.n := by + have positive : 0 < a.n := Nat.pos_of_ne_zero fun equal => nonzero ((G.n_eq_zero_iff a).mp equal) + have bounded : a.n < gSize.toNat := UInt64.lt_iff_toNat_lt.mp a.property + rcases GoldilocksProof.goldilocks_divisors (Nat.gcd_dvd_left gSize.toNat a.n) with one | whole + · exact one + · have small := Nat.gcd_le_right gSize.toNat positive + rw [whole] at small + omega + +theorem G.mul_eq_zero_iff (a b : G) : a * b = 0 ↔ a = 0 ∨ b = 0 := by + constructor + · intro equal + by_cases zero : a = 0 + · exact Or.inl zero + · apply Or.inr + have numeric := congrArg G.n equal + rw [G.n_mul] at numeric + have divides : gSize.toNat ∣ b.n := + (G.coprime_characteristic_of_ne_zero zero).dvd_of_dvd_mul_left + (Nat.dvd_of_mod_eq_zero numeric) + have bound : b.n < gSize.toNat := UInt64.lt_iff_toNat_lt.mp b.property + apply (G.n_eq_zero_iff b).mp + by_cases z : b.n = 0 + · exact z + · have large := Nat.le_of_dvd (Nat.pos_of_ne_zero z) divides + omega + · rintro (rfl | rfl) + · rw [G.mul_comm, G.mul_zero] + · exact G.mul_zero a + +theorem G.mul_eq_zero_of_left_ne_zero {a b : G} (nonzero : a ≠ 0) (zero : a * b = 0) : + b = 0 := (G.mul_eq_zero_iff a b).mp zero |>.resolve_left nonzero + +theorem G.boolean_of_constraint {value : G} (satisfied : value * (value - 1) = 0) : + value = 0 ∨ value = 1 := by + rcases (G.mul_eq_zero_iff _ _).mp satisfied with zero | one + · exact Or.inl zero + · exact Or.inr ((G.sub_eq_zero_iff value 1).mp one) + +theorem G.boolean_of_one_sub_constraint {value : G} (satisfied : value * (1 - value) = 0) : + value = 0 ∨ value = 1 := by + rcases (G.mul_eq_zero_iff _ _).mp satisfied with zero | one + · exact Or.inl zero + · exact Or.inr (((G.sub_eq_zero_iff 1 value).mp one).symm) + +theorem G.eqZero_of_constraints {input inverse output : G} + (annihilate : input * output = 0) + (complement : input * inverse + output - 1 = 0) : output = G.eqZero input := by + by_cases zero : input = 0 + · rw [zero, G.mul_comm (0 : G), G.mul_zero, G.zero_add] at complement + rw [G.eqZero, if_pos zero] + exact (G.sub_eq_zero_iff output 1).mp complement + · rw [G.eqZero, if_neg zero] + exact G.mul_eq_zero_of_left_ne_zero zero annihilate + +theorem G.ne_zero_of_inverse_constraint {input inverse : G} + (satisfied : input * inverse - 1 = 0) : input ≠ 0 := by + intro zero + rw [zero, G.mul_comm (0 : G), G.mul_zero] at satisfied + exact G.one_ne_zero ((G.sub_eq_zero_iff (0 : G) 1).mp satisfied).symm + +end Aiur diff --git a/Ix/Aiur/Proofs/FunctionRows.lean b/Ix/Aiur/Proofs/FunctionRows.lean new file mode 100644 index 000000000..20722840b --- /dev/null +++ b/Ix/Aiur/Proofs/FunctionRows.lean @@ -0,0 +1,168 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.BlockRowInputs + +/-! +Whole-function execution and local function-row validity derived from the +valued emitter. The same semantic return determines the combined provider +message, including shared slots with differing raw message lengths. + +Lookup membership, count bounds, function layout and activity premises are +explicit. These theorems do not yet extract rows from the Rust verifier or +establish public acceptance-to-certified-claim soundness. +-/ + +namespace Aiur.AIR + +theorem slotMessage_chosen (width : Nat) (branchless : Bool) {parts : List (G × List G)} + (single : branchless = true → parts.length = 1) + (individual : ∀ part ∈ parts, booleanConstraint part.1 = 0) + (bounded : parts.length < gSize.toNat) + (active : selectorSum (parts.map Prod.fst) = 1) + {chosen : G × List G} (member : chosen ∈ parts) (selected : chosen.1 = 1) : + padMessage width (slotMessage branchless parts) = padMessage width chosen.2 := by + cases branchless with + | false => + obtain ⟨before, after, equal, zero⟩ := selector_pair_chosen individual bounded active member selected + rw [equal] + exact weightedMessage_split width before after chosen selected zero + | true => + obtain ⟨part, equal⟩ := List.length_eq_one_iff.mp (single rfl) + subst parts + have same := List.mem_singleton.mp member + subst chosen + rfl + +end Aiur.AIR + +namespace Aiur.Bytecode +open Aiur.AIR + +def Function.emitRow (row : Nat → G) (selector : SelIdx → G) (functionIndex : FunIdx) (rank : G) + (values : Array RowValue) (column lookup : Nat) (function : Function) : Option BlockEmission := + function.body.emitRow row selector ⟨functionIndex, function.layout.inputSize, rank⟩ + (function.body.selectorFlow selector).entry values column lookup + +theorem Function.emitRow_run {tables : LookupTables} {width : Nat} {queries : List (List G)} + (global : GlobalLookups tables width queries) + (memoryValid : ∀ size, MemoryRowsValid size (tables.memory size)) + (canonical : ∀ size ∈ tables.memoryWidths, size < gSize.toNat) + (program : Toplevel) (row : Nat → G) (selector : SelIdx → G) + (functionIndex : FunIdx) (rank : G) (values : Array RowValue) (column lookup : Nat) + (function : Function) (present : program.functions[functionIndex]? = some function) + (arity : values.size = function.layout.inputSize) + (shape : function.body.lookupShapes program none = true) (bounds : function.body.rowBounds selector) + {emission : BlockEmission} + (emitted : function.emitRow row selector functionIndex rank values column lookup = some emission) + (active : (function.body.selectorFlow selector).entry = 1) + (satisfied : ∀ equation ∈ emission.equations, equation = 0) (queried : emission.QueriesIn queries) : + ∃ request calls, (1, request) ∈ emission.returns ∧ + request.function = functionIndex ∧ request.inputs = rowValues values ∧ request.rank = rank ∧ + AIR.RunFunction program (memoryFacts tables.memory) request (calls.map Prod.fst) ∧ + emission.CallsAt calls ∧ CallsEmitted rank 1 emission.equations queries calls := by + have bodyEmitted := emitted + rw [Function.emitRow] at bodyEmitted + have initial : RowInputs function.layout.inputSize (rowValues values) values := by + rw [← arity] + exact RowInputs.full values + have preserved := function.body.emitRow_inputs row selector _ _ _ _ _ initial bodyEmitted + have tracked := function.body.emitRow_tracks_calls row selector _ _ _ _ _ bodyEmitted + obtain ⟨outcome, calls, execution, terminal, called⟩ := function.body.emitRow_run global memoryValid canonical + program none row selector _ _ _ _ _ shape bounds bodyEmitted active rfl satisfied queried + cases outcome with + | returned outputs => + obtain ⟨request, member, outputsEq⟩ := terminal + obtain ⟨functionEq, inputsEq, rankEq⟩ := preserved.returned (1, request) member + refine ⟨request, calls, member, functionEq, inputsEq, rankEq, ?_, called, tracked.active queried called⟩ + apply AIR.RunFunction.function + · rw [functionEq] + exact present + · rw [inputsEq] + simpa only [rowValues, Array.size_map] using arity.symm + · rw [inputsEq, outputsEq] + exact execution + | yielded outputs => + obtain ⟨yielded, member, _⟩ := terminal + have empty := function.body.selectorFlow_yields_empty selector program shape + have projected := function.body.emitRow_projection row selector _ _ _ _ _ bodyEmitted + have one : (1 : G) ∈ emission.yields.map Prod.fst := + List.mem_map.mpr ⟨(1, yielded), member, rfl⟩ + rw [projected.yielded, empty] at one + cases one + +theorem Function.emitRow_valid {tables : LookupTables} {width : Nat} {queries : List (List G)} + (global : GlobalLookups tables width queries) + (memoryValid : ∀ size, MemoryRowsValid size (tables.memory size)) + (canonical : ∀ size ∈ tables.memoryWidths, size < gSize.toNat) + (program : Toplevel) (row : Nat → G) (selector : SelIdx → G) + (functionIndex : FunIdx) (rankBytes : Fin 6 → G) (values : Array RowValue) (column lookup : Nat) + (function : Function) (present : program.functions[functionIndex]? = some function) + (arity : values.size = function.layout.inputSize) + (shape : function.body.lookupShapes program none = true) (bounds : function.body.rowBounds selector) + {emission : BlockEmission} + (emitted : function.emitRow row selector functionIndex (packRank rankBytes) values column lookup = some emission) + (multiplicity : G) (nonzero : multiplicity ≠ 0) + (activity : activityConstraint multiplicity (function.body.selectorFlow selector).entry = 0) + (satisfied : ∀ equation ∈ emission.equations, equation = 0) (queried : emission.QueriesIn queries) : + ∃ interpreted : FunctionRow, interpreted.Valid program (memoryFacts tables.memory) ∧ + (1, interpreted.request) ∈ emission.returns ∧ + interpreted.request.function = functionIndex ∧ interpreted.request.inputs = rowValues values ∧ + interpreted.request.rank = packRank rankBytes ∧ interpreted.rankBytes = rankBytes ∧ + interpreted.selector = (function.body.selectorFlow selector).entry ∧ + interpreted.multiplicity = multiplicity ∧ emission.CallsAt interpreted.calls ∧ + CallsEmitted (packRank rankBytes) 1 emission.equations queries interpreted.calls := by + have active := nonzero_multiplicity_selector_one activity nonzero + obtain ⟨request, calls, member, functionEq, inputsEq, rankEq, execution, called, inventory⟩ := + function.emitRow_run global memoryValid canonical program row selector functionIndex (packRank rankBytes) + values column lookup present arity shape bounds emitted active satisfied queried + let interpreted : FunctionRow := ⟨request, calls, rankBytes, 1, multiplicity⟩ + refine ⟨interpreted, ?_, member, functionEq, inputsEq, rankEq, rfl, active.symm, rfl, called, inventory⟩ + refine ⟨Or.inr rfl, ?_, fun _ => rankEq, fun _ => execution, ?_⟩ + · rw [active] at activity + exact activity + · intro edge edgeMember + change 1 * callOrderConstraint request.rank edge.1.rank (packRank edge.2) = 0 + rw [rankEq] + exact satisfied _ (inventory edge edgeMember).2.2 + +theorem Function.emitRow_message (row : Nat → G) (selector : SelIdx → G) + (functionIndex : FunIdx) (rank : G) (values : Array RowValue) (column lookup : Nat) + (function : Function) (program : Toplevel) + (shape : function.body.lookupShapes program none = true) + {emission : BlockEmission} + (emitted : function.emitRow row selector functionIndex rank values column lookup = some emission) + (active : (function.body.selectorFlow selector).entry = 1) + (satisfied : ∀ equation ∈ emission.equations, equation = 0) + (bounded : emission.returns.length < gSize.toNat) + (width : Nat) (branchless : Bool) (single : branchless = true → emission.returns.length = 1) + {request : AIR.Call} (member : (1, request) ∈ emission.returns) : + padMessage width (slotMessage branchless + (emission.returns.map fun part => (part.1, functionMessage part.2))) = + padMessage width (functionMessage request) := by + have bodyEmitted := emitted + rw [Function.emitRow] at bodyEmitted + have projection := function.body.emitRow_projection row selector _ _ _ _ _ bodyEmitted + have valid := function.body.emitRow_selectors row selector _ _ _ _ _ bodyEmitted satisfied + have gates := projection.returned.trans (function.body.returnGates_reflects selector _ valid rfl) + have empty := function.body.selectorFlow_yields_empty selector program shape + have sound := function.body.selectorFlow_sound selector valid + have conservation := sound.conservation + rw [empty] at conservation + change _ = selectorSum (function.body.selectorFlow selector).returns + 0 at conservation + rw [G.add_zero, active] at conservation + apply slotMessage_chosen width branchless + (by simpa only [List.length_map] using single) + (fun part present => ?_) + (by simpa only [List.length_map] using bounded) + (by simpa only [List.map_map, Function.comp_def, gates] using conservation.symm) + (List.mem_map.mpr ⟨(1, request), member, rfl⟩) rfl + obtain ⟨returned, returnMember, equal⟩ := List.mem_map.mp present + subst part + apply sound.returned returned.1 + rw [← gates] + exact List.mem_map.mpr ⟨returned, returnMember, rfl⟩ + +end Aiur.Bytecode diff --git a/Ix/Aiur/Proofs/GlobalLookups.lean b/Ix/Aiur/Proofs/GlobalLookups.lean new file mode 100644 index 000000000..c381a1b73 --- /dev/null +++ b/Ix/Aiur/Proofs/GlobalLookups.lean @@ -0,0 +1,536 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.LookupMessages +import Ix.Aiur.Proofs.LookupShapes +import Ix.Aiur.Proofs.Execution +import Ix.Aiur.Proofs.Memory + +/-! +Function execution, immutable memory facts and byte operations from one +mixed pool of zero-padded lookup messages. + +The native function, memory and thirteen byte channels determine the +provider family. Query widths and the actual structural call checks prevent +padding aliases. Only reachable calls need a checked shape; an active row's +local execution determines its return width and propagates the callee checks. +Byte lookups from the same pool bound all call ranks and gaps, giving finite +execution by strict rank increase. + +The pool retains arbitrary field provider multiplicities, inactive rows and +all consumer kinds. It assumes local row interpretation, exact padded +balance, and explicit query-count and width bounds. Extraction of these +obligations from native AIR and cryptographic verification is still required. +-/ + +namespace Aiur.AIR + +open Bytecode.AIR + +structure LookupTables where + functions : List FunctionRow + memoryWidths : List Nat + memory : Nat → Array MemoryRow + byte1 : Byte1Kind → Fin 256 → G + byte2 : Byte2Kind → Fin 65536 → G + +def LookupTables.providers (tables : LookupTables) : List (Provider (List G)) := + mapProviders functionMessage (functionProviders tables.functions) ++ + tables.memoryWidths.flatMap (fun width => + mapProviders (fun request => memoryMessage width request.1 request.2) + (memoryProviders (tables.memory width))) ++ + byte1Providers tables.byte1 ++ byte2Providers tables.byte2 + +theorem LookupTables.provider_cases {tables : LookupTables} {provider : Provider (List G)} + (member : provider ∈ tables.providers) : + (∃ row ∈ tables.functions, provider = (functionMessage row.request, row.multiplicity)) ∨ + (∃ width ∈ tables.memoryWidths, ∃ i : Fin (tables.memory width).size, + provider = (memoryMessage width (tables.memory width)[i].pointer + (tables.memory width)[i].contents, (tables.memory width)[i].multiplicity)) ∨ + (∃ kind : Byte1Kind, ∃ row : Fin 256, + provider = (byte1Request kind (G.ofNat row.val) (byte1Outputs kind row), tables.byte1 kind row)) ∨ + (∃ kind : Byte2Kind, ∃ row : Fin 65536, + provider = (byte2Request kind (byteRangeMessage row).1 (byteRangeMessage row).2 + (byte2Outputs kind row), tables.byte2 kind row)) := by + simp only [LookupTables.providers, List.mem_append] at member + rcases member with ((function | memory) | byte1) | byte2 + · obtain ⟨original, originalMember, equal⟩ := List.mem_map.mp function + obtain ⟨row, rowMember, rowEq⟩ := List.mem_map.mp originalMember + subst original + exact Or.inl ⟨row, rowMember, equal.symm⟩ + · obtain ⟨width, widthMember, originalMember⟩ := List.mem_flatMap.mp memory + obtain ⟨original, rowMember, equal⟩ := List.mem_map.mp originalMember + obtain ⟨row, rowEq⟩ := List.mem_ofFn.mp rowMember + subst original + exact Or.inr (Or.inl ⟨width, widthMember, row, equal.symm⟩) + · obtain ⟨kind, _, rowMember⟩ := List.mem_flatMap.mp byte1 + obtain ⟨row, equal⟩ := List.mem_ofFn.mp rowMember + exact Or.inr (Or.inr (Or.inl ⟨kind, row, equal.symm⟩)) + · obtain ⟨kind, _, rowMember⟩ := List.mem_flatMap.mp byte2 + obtain ⟨row, equal⟩ := List.mem_ofFn.mp rowMember + exact Or.inr (Or.inr (Or.inr ⟨kind, row, equal.symm⟩)) + +theorem Byte1Kind.channel_range (kind : Byte1Kind) : + 2 ≤ kind.channel.n ∧ kind.channel.n ≤ 4 := by + cases kind <;> decide +kernel + +theorem Byte2Kind.channel_range (kind : Byte2Kind) : + 5 ≤ kind.channel.n ∧ kind.channel.n ≤ 14 := by + cases kind <;> decide +kernel + +theorem padMessage_channel {width : Nat} {left right : List G} + (positive : 0 < width) (same : padMessage width left = padMessage width right) : + left[0]?.getD 0 = right[0]?.getD 0 := by + have first := congrArg (fun message => message[0]?.getD 0) same + simpa only [padMessage_read left 0 positive, padMessage_read right 0 positive] using first + +theorem LookupTables.function_provider {tables : LookupTables} {provider : Provider (List G)} + (member : provider ∈ tables.providers) (channel : provider.1[0]?.getD 0 = 0) : + ∃ row ∈ tables.functions, provider = (functionMessage row.request, row.multiplicity) := by + rcases tables.provider_cases member with function | ⟨width, _, i, equal⟩ | + ⟨kind, row, equal⟩ | ⟨kind, row, equal⟩ + · exact function + · subst provider + have bad := congrArg G.n channel + change 1 = 0 at bad + omega + · subst provider + have bad := congrArg G.n channel + change kind.channel.n = 0 at bad + have range := kind.channel_range + omega + · subst provider + have bad := congrArg G.n channel + change kind.channel.n = 0 at bad + have range := kind.channel_range + omega + +theorem LookupTables.memory_provider {tables : LookupTables} {provider : Provider (List G)} + (member : provider ∈ tables.providers) (channel : provider.1[0]?.getD 0 = 1) : + ∃ width ∈ tables.memoryWidths, ∃ i : Fin (tables.memory width).size, + provider = (memoryMessage width (tables.memory width)[i].pointer + (tables.memory width)[i].contents, (tables.memory width)[i].multiplicity) := by + rcases tables.provider_cases member with ⟨row, _, equal⟩ | memory | + ⟨kind, row, equal⟩ | ⟨kind, row, equal⟩ + · subst provider + have bad := congrArg G.n channel + change 0 = 1 at bad + omega + · exact memory + · subst provider + have bad := congrArg G.n channel + change kind.channel.n = 1 at bad + have range := kind.channel_range + omega + · subst provider + have bad := congrArg G.n channel + change kind.channel.n = 1 at bad + have range := kind.channel_range + omega + +theorem LookupTables.byte1_provider {tables : LookupTables} {provider : Provider (List G)} + {kind : Byte1Kind} (member : provider ∈ tables.providers) + (channel : provider.1[0]?.getD 0 = kind.channel) : + ∃ row : Fin 256, + provider = (byte1Request kind (G.ofNat row.val) (byte1Outputs kind row), tables.byte1 kind row) := by + have range := kind.channel_range + rcases tables.provider_cases member with ⟨row, _, equal⟩ | ⟨width, _, i, equal⟩ | + ⟨providedKind, row, equal⟩ | ⟨providedKind, row, equal⟩ + · subst provider + have bad := congrArg G.n channel + change 0 = kind.channel.n at bad + omega + · subst provider + have bad := congrArg G.n channel + change 1 = kind.channel.n at bad + omega + · subst provider + have same := Byte1Kind.channel_injective channel + subst providedKind + exact ⟨row, rfl⟩ + · subst provider + have bad := congrArg G.n channel + change providedKind.channel.n = kind.channel.n at bad + have providedRange := providedKind.channel_range + omega + +theorem LookupTables.byte2_provider {tables : LookupTables} {provider : Provider (List G)} + {kind : Byte2Kind} (member : provider ∈ tables.providers) + (channel : provider.1[0]?.getD 0 = kind.channel) : + ∃ row : Fin 65536, + provider = (byte2Request kind (byteRangeMessage row).1 (byteRangeMessage row).2 + (byte2Outputs kind row), tables.byte2 kind row) := by + have range := kind.channel_range + rcases tables.provider_cases member with ⟨row, _, equal⟩ | ⟨width, _, i, equal⟩ | + ⟨providedKind, row, equal⟩ | ⟨providedKind, row, equal⟩ + · subst provider + have bad := congrArg G.n channel + change 0 = kind.channel.n at bad + omega + · subst provider + have bad := congrArg G.n channel + change 1 = kind.channel.n at bad + omega + · subst provider + have bad := congrArg G.n channel + change providedKind.channel.n = kind.channel.n at bad + have providedRange := providedKind.channel_range + omega + · subst provider + have same := Byte2Kind.channel_injective channel + subst providedKind + exact ⟨row, rfl⟩ + +theorem functionMessage_minimum (request : Call) : 3 ≤ (functionMessage request).length := by + simp only [functionMessage, List.length_cons, List.length_append, List.length_nil] + omega + +theorem padded_functionMessage_index {width : Nat} {left right : Call} + (leftBound : left.function < gSize.toNat) (rightBound : right.function < gSize.toNat) + (widthBound : (functionMessage left).length ≤ width) + (same : padMessage width (functionMessage left) = padMessage width (functionMessage right)) : + left.function = right.function := by + have minimum := functionMessage_minimum left + have key := congrArg (fun message => message[1]?.getD 0) same + rw [padMessage_read (functionMessage left) 1 (by omega), + padMessage_read (functionMessage right) 1 (by omega)] at key + exact G.ofNat_injective_below leftBound rightBound key + +/-- The query's structural return check and the provider's local execution +determine the same message width, even when some callees never return. -/ +theorem padded_functionMessage_reflects {width : Nat} {program : Bytecode.Toplevel} + {memory : Memory} {request provided : Call} {calls : List Call} + (programBound : program.functions.size < gSize.toNat) + (shape : request.LookupShape program) + (execution : RunFunction program memory provided calls) + (widthBound : (functionMessage request).length ≤ width) + (same : padMessage width (functionMessage request) = padMessage width (functionMessage provided)) : + request = provided := by + obtain ⟨callee, present, constrained, inputSize, returnSize⟩ := shape + have requestBound : request.function < gSize.toNat := + Nat.lt_trans (Array.getElem?_eq_some_iff.mp present).choose programBound + cases execution with + | function supplied arity body => + have providedBound : provided.function < gSize.toNat := + Nat.lt_trans (Array.getElem?_eq_some_iff.mp supplied).choose programBound + have index := padded_functionMessage_index requestBound providedBound widthBound same + have calleeEq := Option.some.inj ((index ▸ present).symm.trans supplied) + subst callee + have inputEq : request.inputs.size = provided.inputs.size := inputSize.symm.trans arity + have outputEq : request.outputs.size = provided.outputs.size := + (body.return_size request.outputs.size returnSize).symm + have lengths : (functionMessage request).length = (functionMessage provided).length := by + simp only [functionMessage, List.length_cons, List.length_append, Array.length_toList, + inputEq, outputEq] + have raw := padMessage_injective_of_length widthBound lengths same + exact functionMessage_injective (arities := fun _ => (request.inputs.size, request.outputs.size)) + ⟨requestBound, rfl, rfl⟩ ⟨providedBound, inputEq.symm, outputEq.symm⟩ raw + +/-- One mixed padded pool. Only consumer counts are bounded; provider +multiplicities are arbitrary field elements. Message widths are checked on +queries, without imposing a global output-arity table on function rows. -/ +structure GlobalLookups (tables : LookupTables) (width : Nat) (queries : List (List G)) : Prop where + balance : PaddedLookupBalance width queries tables.providers + count : queries.length < gSize.toNat + widths : ∀ query ∈ queries, query.length ≤ width + +theorem GlobalLookups.function_provider {tables : LookupTables} {width : Nat} + {queries : List (List G)} (global : GlobalLookups tables width queries) + {program : Bytecode.Toplevel} {memory : Memory} + (valid : ∀ row ∈ tables.functions, row.Valid program memory) + (programBound : program.functions.size < gSize.toNat) + {request : Call} (shape : request.LookupShape program) + (queried : functionMessage request ∈ queries) : + ∃ row ∈ tables.functions, row.request = request ∧ row.selector = 1 := by + obtain ⟨provider, member, same, nonzero⟩ := + paddedLookupBalance_provider global.balance global.count queried + have widthBound := global.widths _ queried + have minimum := functionMessage_minimum request + have channel := padMessage_channel (by omega : 0 < width) same + obtain ⟨row, rowMember, equal⟩ := tables.function_provider member channel + subst provider + have active := (valid row rowMember).active_of_nonzero nonzero + have exactCall := padded_functionMessage_reflects programBound shape + ((valid row rowMember).execution active) widthBound same.symm + exact ⟨row, rowMember, exactCall.symm, active⟩ + +theorem GlobalLookups.byte1 {tables : LookupTables} {width : Nat} + {queries : List (List G)} (global : GlobalLookups tables width queries) + {kind : Byte1Kind} {input : G} {outputs : Array G} + (sized : outputs.size = kind.outputSize) + (queried : byte1Request kind input outputs ∈ queries) : + input.n < 256 ∧ outputs = kind.result input := by + obtain ⟨provider, member, same, _⟩ := + paddedLookupBalance_provider global.balance global.count queried + have shape := byte1Request_shape (fun _ => (0, 0)) kind input outputs sized + have widthBound := global.widths _ queried + have minimum := shape.1 + have channel := padMessage_channel (by omega : 0 < width) same + obtain ⟨row, equal⟩ := tables.byte1_provider member channel + subst provider + have raw := (padMessage_injective_of_shape shape + (byte1Request_shape _ kind _ _ (byte1Outputs_size kind row)) widthBound same.symm).symm + obtain ⟨_, tail⟩ := List.cons.inj raw + obtain ⟨sameInput, sameOutputs⟩ := List.cons.inj tail + have below : row.val < gSize.toNat := Nat.lt_trans row.isLt (by decide) + constructor + · rw [← sameInput, G.n_ofNat, Nat.mod_eq_of_lt below] + exact row.isLt + · rw [← sameInput] + exact (Array.toList_inj.mp sameOutputs).symm.trans (byte1Outputs_correct kind row) + +theorem GlobalLookups.byte2 {tables : LookupTables} {width : Nat} + {queries : List (List G)} (global : GlobalLookups tables width queries) + {kind : Byte2Kind} {x y : G} {outputs : Array G} + (sized : outputs.size = kind.outputSize) + (queried : byte2Request kind x y outputs ∈ queries) : + x.n < 256 ∧ y.n < 256 ∧ outputs = kind.result x y := by + obtain ⟨provider, member, same, _⟩ := + paddedLookupBalance_provider global.balance global.count queried + have shape := byte2Request_shape (fun _ => (0, 0)) kind x y outputs sized + have widthBound := global.widths _ queried + have minimum := shape.1 + have channel := padMessage_channel (by omega : 0 < width) same + obtain ⟨row, equal⟩ := tables.byte2_provider member channel + subst provider + have raw := (padMessage_injective_of_shape shape + (byte2Request_shape _ kind _ _ _ (byte2Outputs_size kind row)) widthBound same.symm).symm + obtain ⟨_, tail⟩ := List.cons.inj raw + obtain ⟨sameX, tail⟩ := List.cons.inj tail + obtain ⟨sameY, sameOutputs⟩ := List.cons.inj tail + rw [← sameX, ← sameY] + refine ⟨(byteRangeMessage_bounded row).1, (byteRangeMessage_bounded row).2, ?_⟩ + exact (Array.toList_inj.mp sameOutputs).symm.trans (byte2Outputs_correct kind row) + +theorem GlobalLookups.memory_fact {tables : LookupTables} {width : Nat} + {queries : List (List G)} (global : GlobalLookups tables width queries) + (valid : ∀ size, MemoryRowsValid size (tables.memory size)) + (canonical : ∀ size ∈ tables.memoryWidths, size < gSize.toNat) + {size : Nat} {pointer : G} {contents : Array G} + (sizeBound : size < gSize.toNat) (sized : contents.size = size) + (queried : memoryMessage size pointer contents ∈ queries) : + memoryFacts tables.memory size pointer contents := by + obtain ⟨provider, member, same, nonzero⟩ := + paddedLookupBalance_provider global.balance global.count queried + have shape := memoryMessage_shape (fun _ => (0, 0)) size pointer contents sizeBound sized + have widthBound := global.widths _ queried + have minimum := shape.1 + have channel := padMessage_channel (by omega : 0 < width) same + obtain ⟨providedSize, sizeMember, row, equal⟩ := tables.memory_provider member channel + subst provider + have raw := (padMessage_injective_of_shape shape + (memoryMessage_shape _ providedSize _ _ (canonical _ sizeMember) + ((valid providedSize).widths row row.isLt)) widthBound same.symm).symm + obtain ⟨sameSize, tail⟩ := List.cons.inj (List.cons.inj raw).2 + have sizeEq := G.ofNat_injective_below (canonical _ sizeMember) sizeBound sameSize + subst providedSize + obtain ⟨samePointer, sameContents⟩ := List.cons.inj tail + have active : (tables.memory size)[row].selector = 1 := by + rcases (valid size).selectors row row.isLt with inactive | active + · exact False.elim (nonzero (inactive_multiplicity_zero inactive + ((valid size).activity row row.isLt))) + · exact active + exact ⟨row, row.isLt, active, samePointer, Array.toList_inj.mp sameContents⟩ + +theorem GlobalLookups.memory_consistent {tables : LookupTables} {width : Nat} + {queries : List (List G)} (global : GlobalLookups tables width queries) + (valid : ∀ size, MemoryRowsValid size (tables.memory size)) + (heights : ∀ size, (tables.memory size).size < gSize.toNat) + (canonical : ∀ size ∈ tables.memoryWidths, size < gSize.toNat) + {size : Nat} {pointer : G} {left right : Array G} + (sizeBound : size < gSize.toNat) (leftSize : left.size = size) (rightSize : right.size = size) + (queriedLeft : memoryMessage size pointer left ∈ queries) + (queriedRight : memoryMessage size pointer right ∈ queries) : left = right := + memoryFacts_functional tables.memory valid heights + (global.memory_fact valid canonical sizeBound leftSize queriedLeft) + (global.memory_fact valid canonical sizeBound rightSize queriedRight) + +theorem GlobalLookups.byte1_step {tables : LookupTables} {width : Nat} + {queries : List (List G)} (global : GlobalLookups tables width queries) + (memory : Memory) {kind : Byte1Kind} {values : Array G} + {index : Bytecode.ValIdx} {input : G} {outputs : Array G} + (read : values[index]? = some input) (sized : outputs.size = kind.outputSize) + (queried : byte1Request kind input outputs ∈ queries) : + Step memory (kind.op index) values (values ++ outputs) [] := by + obtain ⟨range, correct⟩ := global.byte1 sized queried + apply Step.primitive (advice := #[]) + rw [correct] + exact byte1_primitive read range + +theorem GlobalLookups.byte2_step {tables : LookupTables} {width : Nat} + {queries : List (List G)} (global : GlobalLookups tables width queries) + (memory : Memory) {kind : Byte2Kind} {values : Array G} + {left right : Bytecode.ValIdx} {x y : G} {outputs : Array G} + (readX : values[left]? = some x) (readY : values[right]? = some y) + (sized : outputs.size = kind.outputSize) + (queried : byte2Request kind x y outputs ∈ queries) : + Step memory (kind.op left right) values + (values ++ kind.extendOutputs x y outputs) [] := by + obtain ⟨rangeX, rangeY, correct⟩ := global.byte2 sized queried + apply Step.primitive (advice := #[]) + rw [correct] + exact byte2_primitive readX readY rangeX rangeY + +def rangeMessage (pair : G × G) : List G := byte2Request .range pair.1 pair.2 #[] + +theorem GlobalLookups.rank_bytes {tables : LookupTables} {width : Nat} + {queries : List (List G)} (global : GlobalLookups tables width queries) + (bytes : Fin 6 → G) (queried : (rankByteQueries bytes).map rangeMessage ⊆ queries) : + ∀ i, (bytes i).n < 256 := by + have pairRange : ∀ pair ∈ rankByteQueries bytes, pair.1.n < 256 ∧ pair.2.n < 256 := by + intro pair member + have result := global.byte2 (kind := .range) (outputs := #[]) rfl + (queried (List.mem_map.mpr ⟨pair, member, rfl⟩)) + exact ⟨result.1, result.2.1⟩ + have p0 := pairRange _ (by simp [rankByteQueries] : (bytes 0, bytes 1) ∈ rankByteQueries bytes) + have p1 := pairRange _ (by simp [rankByteQueries] : (bytes 2, bytes 3) ∈ rankByteQueries bytes) + have p2 := pairRange _ (by simp [rankByteQueries] : (bytes 4, bytes 5) ∈ rankByteQueries bytes) + intro i + have cases : i = 0 ∨ i = 1 ∨ i = 2 ∨ i = 3 ∨ i = 4 ∨ i = 5 := by omega + rcases cases with rfl | rfl | rfl | rfl | rfl | rfl + · exact p0.1 + · exact p0.2 + · exact p1.1 + · exact p1.2 + · exact p2.1 + · exact p2.2 + +theorem FunctionRow.Valid.global_rank_bounded {tables : LookupTables} {width : Nat} + {queries : List (List G)} (global : GlobalLookups tables width queries) + {program : Bytecode.Toplevel} {memory : Memory} {row : FunctionRow} + (valid : row.Valid program memory) (member : row ∈ tables.functions) (active : row.selector = 1) + (queried : (functionByteQueries tables.functions).map rangeMessage ⊆ queries) : + row.request.rank.n < callRankBound := by + rw [valid.rank active] + apply packRank_lt + apply global.rank_bytes + intro message messageMember + obtain ⟨pair, pairMember, equal⟩ := List.mem_map.mp messageMember + apply queried + exact List.mem_map.mpr ⟨pair, functionByteQueries_member member active + (List.mem_append_left _ pairMember), equal⟩ + +theorem FunctionRow.Valid.global_call_order {tables : LookupTables} {width : Nat} + {queries : List (List G)} (global : GlobalLookups tables width queries) + {program : Bytecode.Toplevel} {memory : Memory} {row : FunctionRow} + (valid : row.Valid program memory) (member : row ∈ tables.functions) (active : row.selector = 1) + (queried : (functionByteQueries tables.functions).map rangeMessage ⊆ queries) + {edge : Call × (Fin 6 → G)} (called : edge ∈ row.calls) + (childBound : edge.1.rank.n < callRankBound) : + row.request.rank.n < edge.1.rank.n := by + have gapBound : (packRank edge.2).n < callRankBound := by + apply packRank_lt + apply global.rank_bytes + intro message messageMember + obtain ⟨pair, pairMember, equal⟩ := List.mem_map.mp messageMember + apply queried + exact List.mem_map.mpr ⟨pair, functionByteQueries_member member active + (List.mem_append_right _ (List.mem_flatMap.mpr ⟨edge, called, pairMember⟩)), equal⟩ + exact active_call_order_strict active + (valid.global_rank_bounded global member active queried) + childBound gapBound (valid.order edge called) + +/-- Reachable rows execute finitely using one global padded lookup balance. +Only the current request is assumed to have a checked call shape; structural +program validation propagates that fact to its children. -/ +theorem GlobalLookups.rows_execute {tables : LookupTables} {width : Nat} + {queries : List (List G)} (global : GlobalLookups tables width queries) + {program : Bytecode.Toplevel} {memory : Memory} {roots : List Call} + (programValid : program.validateLookupShapes = true) + (valid : ∀ row ∈ tables.functions, row.Valid program memory) + (functionsQueried : (functionQueries roots tables.functions).map functionMessage ⊆ queries) + (bytesQueried : (functionByteQueries tables.functions).map rangeMessage ⊆ queries) + {row : FunctionRow} (member : row ∈ tables.functions) (active : row.selector = 1) + (shape : row.request.LookupShape program) : Execution program memory row.request := by + have programBound : program.functions.size < gSize.toNat := by + have checked := programValid + simp only [Bytecode.Toplevel.validateLookupShapes, Bool.and_eq_true, decide_eq_true_eq] at checked + exact checked.1 + have all : ∀ n : Nat, ∀ row : FunctionRow, + callRankBound - row.request.rank.n = n → row ∈ tables.functions → row.selector = 1 → + row.request.LookupShape program → Execution program memory row.request := by + intro n + induction n using Nat.strongRecOn with + | ind n ih => + intro parent measure member active shape + have body := (valid parent member).execution active + have children : ∀ child ∈ parent.requests, child.LookupShape program := by + obtain ⟨callee, present, constrained, _, _⟩ := shape + exact body.calls_lookupShape programValid present constrained + apply Execution.function body + intro child called + obtain ⟨edge, edgeMember, edgeEq⟩ := List.mem_map.mp called + obtain ⟨provider, providerMember, same, providerActive⟩ := + global.function_provider valid programBound (children child called) + (functionsQueried (List.mem_map.mpr + ⟨child, functionQueries_member member active called, rfl⟩)) + have childBound := (valid provider providerMember).global_rank_bounded + global providerMember providerActive bytesQueried + have order := (valid parent member).global_call_order global member active bytesQueried + edgeMember (by simpa only [edgeEq, ← same] using childBound) + rw [edgeEq, ← same] at order + have smaller : callRankBound - provider.request.rank.n < n := by omega + rw [← same] + exact ih _ smaller provider rfl providerMember providerActive (same ▸ children child called) + exact all _ row rfl member active shape + +theorem GlobalLookups.roots_execute {tables : LookupTables} {width : Nat} + {queries : List (List G)} (global : GlobalLookups tables width queries) + {program : Bytecode.Toplevel} {memory : Memory} {roots : List Call} + (programValid : program.validateLookupShapes = true) + (valid : ∀ row ∈ tables.functions, row.Valid program memory) + (functionsQueried : (functionQueries roots tables.functions).map functionMessage ⊆ queries) + (bytesQueried : (functionByteQueries tables.functions).map rangeMessage ⊆ queries) + {request : Call} (shape : request.LookupShape program) (root : request ∈ roots) : + Execution program memory request := by + have programBound : program.functions.size < gSize.toNat := by + have checked := programValid + simp only [Bytecode.Toplevel.validateLookupShapes, Bool.and_eq_true, decide_eq_true_eq] at checked + exact checked.1 + obtain ⟨row, member, same, active⟩ := global.function_provider valid programBound shape + (functionsQueried (List.mem_map.mpr ⟨request, List.mem_append_left _ root, rfl⟩)) + rw [← same] + exact global.rows_execute programValid valid functionsQueried bytesQueried member active (same ▸ shape) + +end Aiur.AIR + +namespace Aiur.BoundVerifier + +open AIR Bytecode.AIR + +theorem Backend.root_lookupShape {selection : Selection} (backend : Backend selection) + (input : Array G) (arity : input.size = selection.inputSize) : + Call.LookupShape backend.compiled.bytecode ⟨selection.function, input, selection.success, 0⟩ := + ⟨backend.entry, backend.present, backend.constrained, backend.arity.trans arity.symm, + backend.returnArity⟩ + +theorem claim_padding (selection : Selection) + (width : Nat) (input : Array G) : + padMessage width (functionMessage ⟨selection.function, input, selection.success, 0⟩) = + padMessage width (buildClaim selection.function input selection.success).toList := by + have encoding : functionMessage ⟨selection.function, input, selection.success, 0⟩ = + (buildClaim selection.function input selection.success).toList ++ [0] := by + simp only [functionMessage, buildClaim, Array.toList_append, List.cons_append, + List.nil_append, functionChannel] + rfl + rw [encoding] + exact padMessage_append_zero _ + +/-- The selected success request has a finite AIR execution once its local +row and mixed lookup obligations are discharged. This is still conditional +on those obligations, not a theorem about public verifier acceptance. -/ +theorem Backend.global_execution {selection : Selection} (backend : Backend selection) + {tables : LookupTables} {width : Nat} {queries : List (List G)} + (global : GlobalLookups tables width queries) {memory : Memory} + (input : Array G) (arity : input.size = selection.inputSize) + (valid : ∀ row ∈ tables.functions, row.Valid backend.compiled.bytecode memory) + (functionsQueried : (functionQueries [⟨selection.function, input, selection.success, 0⟩] + tables.functions).map functionMessage ⊆ queries) + (bytesQueried : (functionByteQueries tables.functions).map rangeMessage ⊆ queries) : + Execution backend.compiled.bytecode memory ⟨selection.function, input, selection.success, 0⟩ := + global.roots_execute backend.lookupShapes valid functionsQueried bytesQueried + (backend.root_lookupShape input arity) List.mem_cons_self + +end Aiur.BoundVerifier diff --git a/Ix/Aiur/Proofs/Grouping.lean b/Ix/Aiur/Proofs/Grouping.lean new file mode 100644 index 000000000..8b87dc367 --- /dev/null +++ b/Ix/Aiur/Proofs/Grouping.lean @@ -0,0 +1,139 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.BoundVerifier + +/-! +# Reference execution through the selected circuit grouping + +Successful grouping preserves the source, function map, complete function +array and memory widths. Its partition change therefore preserves reference +execution, including errors and final I/O state. The selected backend can +reflect that execution back through final compilation metadata and checked +deduplication to the same named function in the actual lowering output. This +does not yet extract execution from AIR witnesses or reflect earlier passes. +-/ + +namespace Aiur + +theorem CompiledToplevel.groupFunctions_preserves_code + {before after : CompiledToplevel} {groups : Array (String × Array String)} + (accepted : before.groupFunctions groups = .ok after) : + after.source = before.source ∧ after.nameMap = before.nameMap ∧ + after.bytecode.functions = before.bytecode.functions ∧ + after.bytecode.memorySizes = before.bytecode.memorySizes := by + unfold CompiledToplevel.groupFunctions at accepted + simp only [bind, Except.bind, pure, Except.pure] at accepted + split at accepted + · cases accepted + · split at accepted + · cases accepted + · cases accepted + exact ⟨rfl, rfl, rfl, rfl⟩ + +theorem CompiledToplevel.groupFunctions_sameCode + {before after : CompiledToplevel} {groups : Array (String × Array String)} + (accepted : before.groupFunctions groups = .ok after) : + Bytecode.Eval.SameCode after.bytecode before.bytecode := by + have same := (groupFunctions_preserves_code accepted).2.2.1 + constructor + · exact congrArg Array.size same + · intro i ha hb + simp only [same] + · intro i ha hb + simp only [same] + +/-- Equality includes error results and final I/O state at every fuel value. -/ +theorem CompiledToplevel.groupFunctions_preserves_execution + {before after : CompiledToplevel} {groups : Array (String × Array String)} + (accepted : before.groupFunctions groups = .ok after) + (function : Bytecode.FunIdx) (args : Array G) (io : IOBuffer) (fuel : Nat) : + Bytecode.Eval.runFunction after.bytecode function args io fuel = + Bytecode.Eval.runFunction before.bytecode function args io fuel := + Bytecode.Eval.runFunction_sameCode (groupFunctions_sameCode accepted) + function args io fuel + +/-- The actual selected compilation preserves the ungrouped reference run. -/ +theorem BoundVerifier.Backend.reference_execution + {selection : BoundVerifier.Selection} (backend : BoundVerifier.Backend selection) + (function : Bytecode.FunIdx) (args : Array G) (io : IOBuffer) (fuel : Nat) : + ∃ initial, selection.source.compile = .ok initial ∧ + Bytecode.Eval.runFunction backend.compiled.bytecode function args io fuel = + Bytecode.Eval.runFunction initial.bytecode function args io fuel := by + obtain ⟨initial, compiled, grouped⟩ := backend.compilation_stages + refine ⟨initial, compiled, ?_⟩ + split at grouped + · cases grouped + rfl + · exact CompiledToplevel.groupFunctions_preserves_execution grouped function args io fuel + +/-- Reference success at the selected entrypoint reflects to the exact +deduplicated output of the successful source compiler stages. No AIR or +cryptographic acceptance premise is substituted for reference execution. -/ +theorem BoundVerifier.Backend.execution_reflects + {selection : BoundVerifier.Selection} (backend : BoundVerifier.Backend selection) + {args : Array G} {io : IOBuffer} {fuel : Nat} {result : Array G × IOBuffer} + (accepted : Bytecode.Eval.runFunction backend.compiled.bytecode + selection.function args io fuel = .ok result) : + ∃ inlined typed concrete raw names, + selection.source.inlineCalls = .ok inlined ∧ + inlined.checkAndSimplify = .ok typed ∧ + typed.concretize = .ok concrete ∧ + concrete.toBytecode = .ok (raw, names) ∧ + Bytecode.Eval.runFunction raw.deduplicate.1 + selection.function args io fuel = .ok result := by + obtain ⟨initial, compiled, execution⟩ := + backend.reference_execution selection.function args io fuel + obtain ⟨inlined, typed, concrete, raw, names, hi, ht, hc, hb, artifact⟩ := + Source.Toplevel.compile_artifact_of_ok compiled + refine ⟨inlined, typed, concrete, raw, names, hi, ht, hc, hb, ?_⟩ + apply finishCompilation_reflects (source := inlined) (names := names) + rw [← artifact] + exact execution.symm.trans accepted + +/-- Grouping retains the selected entrypoint as well as its reference run. -/ +theorem BoundVerifier.Backend.reference_entrypoint + {selection : BoundVerifier.Selection} (backend : BoundVerifier.Backend selection) + (args : Array G) (io : IOBuffer) (fuel : Nat) : + ∃ initial, selection.source.compile = .ok initial ∧ + initial.getFuncIdx selection.entrypoint = some selection.function ∧ + Bytecode.Eval.runFunction backend.compiled.bytecode selection.function args io fuel = + Bytecode.Eval.runFunction initial.bytecode selection.function args io fuel := by + obtain ⟨initial, compiled, grouped⟩ := backend.compilation_stages + refine ⟨initial, compiled, ?_⟩ + split at grouped + · cases grouped + exact ⟨backend.selected, rfl⟩ + · have sameNames := (CompiledToplevel.groupFunctions_preserves_code grouped).2.1 + exact ⟨by simpa only [CompiledToplevel.getFuncIdx, sameNames] using backend.selected, + CompiledToplevel.groupFunctions_preserves_execution grouped selection.function args io fuel⟩ + +/-- Successful execution of the selected backend reflects through grouping, +metadata and checked deduplication to the same named function in the actual +lowering output. The earlier source passes and AIR extraction are separate. -/ +theorem BoundVerifier.Backend.execution_reflects_raw + {selection : BoundVerifier.Selection} (backend : BoundVerifier.Backend selection) + {args : Array G} {io : IOBuffer} {fuel : Nat} {result : Array G × IOBuffer} + (accepted : Bytecode.Eval.runFunction backend.compiled.bytecode + selection.function args io fuel = .ok result) : + ∃ inlined typed concrete raw names original, + selection.source.inlineCalls = .ok inlined ∧ + inlined.checkAndSimplify = .ok typed ∧ + typed.concretize = .ok concrete ∧ + concrete.toBytecode = .ok (raw, names) ∧ + names[Global.mk selection.entrypoint]? = some original ∧ + raw.deduplicate.2 original = selection.function ∧ + Bytecode.Eval.runFunction raw original args io fuel = .ok result := by + obtain ⟨initial, compiled, selected, execution⟩ := backend.reference_entrypoint args io fuel + obtain ⟨inlined, typed, concrete, raw, names, hi, ht, hc, hb, artifact⟩ := + Source.Toplevel.compile_artifact_of_ok compiled + rw [artifact] at selected + obtain ⟨original, named, remapped⟩ := finishCompilation_nameMap_image selected + refine ⟨inlined, typed, concrete, raw, names, original, hi, ht, hc, hb, named, remapped, ?_⟩ + apply (finishCompilation_preserves_execution inlined raw names original args io fuel result).mpr + rw [remapped, ← artifact] + exact execution.symm.trans accepted + +end Aiur diff --git a/Ix/Aiur/Proofs/LocalConstraints.lean b/Ix/Aiur/Proofs/LocalConstraints.lean new file mode 100644 index 000000000..add26a239 --- /dev/null +++ b/Ix/Aiur/Proofs/LocalConstraints.lean @@ -0,0 +1,190 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.Field +import Ix.Aiur.Proofs.Memory + +/-! +Arithmetic extraction from the native AIR's local polynomial forms. + +Boolean selector equations, the two `eq_zero` equations, case equality and +default disequality imply their semantic properties over `G`. Boolean sums +select at most one branch when the number of summands is below the field +characteristic. The bound is explicit and a cancellation counterexample +shows its necessity. These sums use the native emitter's left-fold order. + +Memory-table functionality now follows from its polynomial equations and +trace-height bound without separately assuming boolean selectors. Decoding +the Rust expressions, trace widths and transition selectors, and extracting +exact lookup balance from proof verification, remain separate obligations. +-/ + +namespace Aiur.AIR + +/-- Selector-column equation used in function and memory circuits. -/ +def booleanConstraint (value : G) : G := value * (value - 1) + +/-- Block and grouped-circuit selector equation, with the opposite sign. -/ +def oneSubBooleanConstraint (value : G) : G := value * (1 - value) + +def selectorSum (selectors : List G) : G := selectors.foldl (· + ·) 0 + +theorem foldl_add_eq (selectors : List G) (initial : G) : + selectors.foldl (· + ·) initial = initial + selectorSum selectors := by + induction selectors generalizing initial with + | nil => exact (G.add_zero initial).symm + | cons head tail ih => + simp only [List.foldl_cons, selectorSum] + rw [ih, ih] + simp only [G.zero_add, G.add_assoc] + +theorem selectorSum_cons (head : G) (tail : List G) : + selectorSum (head :: tail) = head + selectorSum tail := by + simpa only [selectorSum, List.foldl_cons, G.zero_add] using foldl_add_eq tail head + +theorem selectorSum_eq_count (selectors : List G) + (boolean : ∀ value ∈ selectors, value = 0 ∨ value = 1) : + selectorSum selectors = G.ofNat (selectors.count 1) := by + induction selectors with + | nil => rfl + | cons head tail ih => + have rest : ∀ value ∈ tail, value = 0 ∨ value = 1 := + fun value member => boolean value (List.mem_cons_of_mem _ member) + rcases boolean head List.mem_cons_self with rfl | rfl + · rw [selectorSum_cons, G.zero_add, List.count_cons_of_ne (Ne.symm G.one_ne_zero), ih rest] + · rw [selectorSum_cons, List.count_cons_self, ih rest, G.ofNat_add, G.add_comm] + rfl + +theorem selectorSum_n_eq_count {selectors : List G} + (boolean : ∀ value ∈ selectors, value = 0 ∨ value = 1) + (bounded : selectors.length < gSize.toNat) : + (selectorSum selectors).n = selectors.count 1 := by + rw [selectorSum_eq_count selectors boolean, G.n_ofNat] + exact Nat.mod_eq_of_lt (Nat.lt_of_le_of_lt List.count_le_length bounded) + +theorem selectorSum_count_le_one {selectors : List G} + (individual : ∀ value ∈ selectors, booleanConstraint value = 0) + (combined : oneSubBooleanConstraint (selectorSum selectors) = 0) + (bounded : selectors.length < gSize.toNat) : selectors.count 1 ≤ 1 := by + have boolean : ∀ value ∈ selectors, value = 0 ∨ value = 1 := + fun value member => G.boolean_of_constraint (individual value member) + have count := selectorSum_n_eq_count boolean bounded + rcases G.boolean_of_one_sub_constraint combined with zero | one + · rw [zero] at count + change 0 = selectors.count 1 at count + omega + · rw [one] at count + change 1 = selectors.count 1 at count + omega + +theorem selectorSum_inactive {selectors : List G} + (individual : ∀ value ∈ selectors, booleanConstraint value = 0) + (bounded : selectors.length < gSize.toNat) + (inactive : selectorSum selectors = 0) : ∀ value ∈ selectors, value = 0 := by + have boolean : ∀ value ∈ selectors, value = 0 ∨ value = 1 := + fun value member => G.boolean_of_constraint (individual value member) + have count := selectorSum_n_eq_count boolean bounded + rw [inactive] at count + have absent : (1 : G) ∉ selectors := List.count_eq_zero.mp count.symm + intro value member + rcases boolean value member with zero | one + · exact zero + · subst value; exact False.elim (absent member) + +theorem selectorSum_active_count {selectors : List G} + (individual : ∀ value ∈ selectors, booleanConstraint value = 0) + (bounded : selectors.length < gSize.toNat) + (active : selectorSum selectors = 1) : selectors.count 1 = 1 := by + have boolean : ∀ value ∈ selectors, value = 0 ∨ value = 1 := + fun value member => G.boolean_of_constraint (individual value member) + have count := selectorSum_n_eq_count boolean bounded + rw [active] at count + exact count.symm + +/-- An active bounded sum has exactly one active occurrence; all other +occurrences are zero, even when list values repeat. -/ +theorem selectorSum_active_split {selectors : List G} + (individual : ∀ value ∈ selectors, booleanConstraint value = 0) + (bounded : selectors.length < gSize.toNat) (active : selectorSum selectors = 1) : + ∃ before after : List G, selectors = before ++ 1 :: after ∧ + ∀ value ∈ before ++ after, value = 0 := by + have count := selectorSum_active_count individual bounded active + have member : (1 : G) ∈ selectors := List.count_pos_iff.mp (by omega) + obtain ⟨before, after, equal, _⟩ := List.eq_append_cons_of_mem member + refine ⟨before, after, equal, ?_⟩ + rw [equal, List.count_append, List.count_cons_self] at count + have absent : (1 : G) ∉ before ++ after := by + apply List.count_eq_zero.mp + rw [List.count_append] + omega + intro value member + have member' : value ∈ selectors := by + rw [equal] + rcases List.mem_append.mp member with left | right + · exact List.mem_append_left _ left + · exact List.mem_append_right _ (List.mem_cons_of_mem _ right) + rcases G.boolean_of_constraint (individual value member') with zero | one + · exact zero + · subst value; exact False.elim (absent member) + +/-- Boolean summands alone do not prevent a full characteristic of active +branches from being represented by an inactive field sum. -/ +theorem selectorSum_characteristic_cancel : + selectorSum (List.replicate gSize.toNat (1 : G)) = 0 := by + rw [selectorSum_eq_count _ (fun value member => + Or.inr (List.eq_of_mem_replicate member)), List.count_replicate_self] + rfl + +theorem nonzero_multiplicity_selector_one {multiplicity selector : G} + (satisfied : activityConstraint multiplicity selector = 0) + (nonzero : multiplicity ≠ 0) : selector = 1 := by + have zero := G.mul_eq_zero_of_left_ne_zero nonzero satisfied + exact ((G.sub_eq_zero_iff 1 selector).mp zero).symm + +theorem active_eqZero {selector input inverse output : G} (active : selector = 1) + (annihilate : selector * input * output = 0) + (complement : selector * (input * inverse + output - 1) = 0) : + output = G.eqZero input := by + rw [active, G.mul_comm (1 : G) input, G.mul_one] at annihilate + rw [active, G.mul_comm, G.mul_one] at complement + exact G.eqZero_of_constraints annihilate complement + +theorem active_case {selector matched key : G} (active : selector = 1) + (satisfied : selector * (matched - key) = 0) : matched = key := by + rw [active, G.mul_comm, G.mul_one] at satisfied + exact (G.sub_eq_zero_iff matched key).mp satisfied + +theorem active_default {selector matched key inverse : G} (active : selector = 1) + (satisfied : selector * ((matched - key) * inverse - 1) = 0) : matched ≠ key := by + rw [active, G.mul_comm, G.mul_one] at satisfied + intro equal + have nonzero := G.ne_zero_of_inverse_constraint satisfied + exact nonzero ((G.sub_eq_zero_iff matched key).mpr equal) + +/-- The four memory polynomial forms, with interior transition gating +resolved and column widths decoded. No boolean-selector premise. -/ +structure MemoryRowsPolynomials (width : Nat) (rows : Array MemoryRow) : Prop where + selectors : ∀ i (hi : i < rows.size), booleanConstraint rows[i].selector = 0 + activity : ∀ i (hi : i < rows.size), activityConstraint rows[i].multiplicity rows[i].selector = 0 + widths : ∀ i (hi : i < rows.size), rows[i].contents.size = width + activityTransition : ∀ i (hi : i + 1 < rows.size), + memoryActivityTransition (rows[i]'(by omega)) rows[i + 1] = 0 + pointerTransition : ∀ i (hi : i + 1 < rows.size), + memoryPointerTransition (rows[i]'(by omega)) rows[i + 1] = 0 + +theorem MemoryRowsPolynomials.valid {width : Nat} {rows : Array MemoryRow} + (polynomials : MemoryRowsPolynomials width rows) : MemoryRowsValid width rows := + ⟨fun i hi => G.boolean_of_constraint (polynomials.selectors i hi), + polynomials.activity, polynomials.widths, polynomials.activityTransition, polynomials.pointerTransition⟩ + +theorem MemoryRowsPolynomials.functional (tables : Nat → Array MemoryRow) + (polynomials : ∀ width, MemoryRowsPolynomials width (tables width)) + (bounded : ∀ width, (tables width).size < gSize.toNat) + {width : Nat} {pointer : G} {left right : Array G} + (loadedLeft : memoryFacts tables width pointer left) + (loadedRight : memoryFacts tables width pointer right) : left = right := + memoryFacts_functional tables (fun width => (polynomials width).valid) bounded loadedLeft loadedRight + +end Aiur.AIR diff --git a/Ix/Aiur/Proofs/Lookup.lean b/Ix/Aiur/Proofs/Lookup.lean new file mode 100644 index 000000000..01f4a4989 --- /dev/null +++ b/Ix/Aiur/Proofs/Lookup.lean @@ -0,0 +1,168 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.CallOrder + +/-! Exact lookup balance over the actual Goldilocks representation. + +Consumer queries have unit weight; providers may have arbitrary field +multiplicities. A query count below the characteristic cannot disappear by +modular cancellation, so every queried message has a nonzero provider. +Instantiating this result with the fixed 256-by-256 byte table recovers byte +bounds, including the six bytes used by the call-order constraint. + +These theorems assume exact message balance. They do not extract that +balance from a cryptographic transcript or identify the Rust emitter with +this mathematical interface. +-/ + +namespace Aiur + +theorem G.zero_add (a : G) : 0 + a = a := by + change G.ofNat (0 + a.n) = a + simpa only [Nat.zero_add] using G.ofNat_n a + +theorem G.ofNat_ne_zero_of_lt {n : Nat} (positive : 0 < n) + (bounded : n < gSize.toNat) : G.ofNat n ≠ 0 := by + intro h + have hn := congrArg G.n h + rw [G.n_ofNat, Nat.mod_eq_of_lt bounded] at hn + change n = 0 at hn + omega + +namespace AIR + +/-- A supplied message and its return/pull multiplicity. -/ +abbrev Provider (α : Type u) := α × G + +/-- Total supplied weight for one exact message. -/ +def suppliedWeight [DecidableEq α] (message : α) (providers : List (Provider α)) : G := + providers.foldr (fun provider rest => + if provider.1 = message then provider.2 + rest else rest) 0 + +/-- Exact tuple balance, before randomized message compression. Each +consumer contributes one; arbitrary provider weights are field elements. -/ +def ExactLookupBalance [DecidableEq α] (queries : List α) + (providers : List (Provider α)) : Prop := + ∀ message, G.ofNat (queries.count message) = suppliedWeight message providers + +/-- The count bound is necessary: exactly one characteristic's worth of +identical queries has zero field weight, even with no providers. -/ +theorem characteristic_queries_balance [DecidableEq α] (message : α) : + ExactLookupBalance (List.replicate gSize.toNat message) [] := by + intro query + simp only [List.count_replicate, suppliedWeight] + split <;> rfl + +theorem suppliedWeight_nonzero_provider [DecidableEq α] (message : α) + (providers : List (Provider α)) + (nonzero : suppliedWeight message providers ≠ 0) : + ∃ provider ∈ providers, provider.1 = message ∧ provider.2 ≠ 0 := by + induction providers with + | nil => exact False.elim (nonzero rfl) + | cons provider rest ih => + obtain ⟨provided, multiplicity⟩ := provider + by_cases same : provided = message + · by_cases zero : multiplicity = 0 + · have hn : suppliedWeight message rest ≠ 0 := by + simpa only [suppliedWeight, List.foldr_cons, if_pos same, zero, G.zero_add] using nonzero + obtain ⟨provider, member, hm, hw⟩ := ih hn + exact ⟨provider, List.mem_cons_of_mem _ member, hm, hw⟩ + · exact ⟨(provided, multiplicity), List.mem_cons_self, same, zero⟩ + · have hn : suppliedWeight message rest ≠ 0 := by + simpa only [suppliedWeight, List.foldr_cons, if_neg same] using nonzero + obtain ⟨provider, member, hm, hw⟩ := ih hn + exact ⟨provider, List.mem_cons_of_mem _ member, hm, hw⟩ + +/-- A bounded positive request cannot be supplied solely by zero weights, +even when other providers use negative field multiplicities. -/ +theorem exactLookupBalance_provider [DecidableEq α] + {queries : List α} {providers : List (Provider α)} + (balanced : ExactLookupBalance queries providers) + (bounded : queries.length < gSize.toNat) {message : α} + (queried : message ∈ queries) : + ∃ provider ∈ providers, provider.1 = message ∧ provider.2 ≠ 0 := by + have positive : 0 < queries.count message := List.count_pos_iff.mpr queried + have countBound : queries.count message < gSize.toNat := + Nat.lt_of_le_of_lt List.count_le_length bounded + have nonzero := G.ofNat_ne_zero_of_lt positive countBound + rw [balanced message] at nonzero + exact suppliedWeight_nonzero_provider message providers nonzero + +/-- Row order of the two-byte preprocessed table: outer first byte, inner +second byte, each ranging from 0 through 255. -/ +def byteRangeMessage (row : Fin 65536) : G × G := + (G.ofNat (row.val / 256), G.ofNat (row.val % 256)) + +def byteRangeProviders (weights : Fin 65536 → G) : List (Provider (G × G)) := + List.ofFn fun row => (byteRangeMessage row, weights row) + +theorem byteRangeMessage_bounded (row : Fin 65536) : + (byteRangeMessage row).1.n < 256 ∧ (byteRangeMessage row).2.n < 256 := by + have first : row.val / 256 < 256 := by omega + have second : row.val % 256 < 256 := Nat.mod_lt _ (by decide) + have firstField : row.val / 256 < gSize.toNat := by + exact Nat.lt_trans first (by decide) + have secondField : row.val % 256 < gSize.toNat := by + exact Nat.lt_trans second (by decide) + simpa only [byteRangeMessage, G.n_ofNat, Nat.mod_eq_of_lt firstField, + Nat.mod_eq_of_lt secondField] using And.intro first second + +/-- Exact balance against the fixed byte table establishes both byte +bounds. The table's multiplicity column remains arbitrary. -/ +theorem exactLookupBalance_byteRange {queries : List (G × G)} + (weights : Fin 65536 → G) + (balanced : ExactLookupBalance queries (byteRangeProviders weights)) + (bounded : queries.length < gSize.toNat) {a b : G} + (queried : (a, b) ∈ queries) : a.n < 256 ∧ b.n < 256 := by + obtain ⟨provider, member, message, _⟩ := + exactLookupBalance_provider balanced bounded queried + obtain ⟨row, hrow⟩ := List.mem_ofFn.mp member + have same : byteRangeMessage row = (a, b) := by + exact (congrArg Prod.fst hrow).trans message + simpa only [same] using byteRangeMessage_bounded row + +/-- The three pair queries emitted for one six-byte rank or gap. -/ +def rankByteQueries (bytes : Fin 6 → G) : List (G × G) := + [(bytes 0, bytes 1), (bytes 2, bytes 3), (bytes 4, bytes 5)] + +theorem exactLookupBalance_rankBytes {queries : List (G × G)} + (weights : Fin 65536 → G) + (balanced : ExactLookupBalance queries (byteRangeProviders weights)) + (bounded : queries.length < gSize.toNat) (bytes : Fin 6 → G) + (queried : rankByteQueries bytes ⊆ queries) : + ∀ i, (bytes i).n < 256 := by + have p0 := exactLookupBalance_byteRange weights balanced bounded + (queried (by simp [rankByteQueries] : (bytes 0, bytes 1) ∈ rankByteQueries bytes)) + have p1 := exactLookupBalance_byteRange weights balanced bounded + (queried (by simp [rankByteQueries] : (bytes 2, bytes 3) ∈ rankByteQueries bytes)) + have p2 := exactLookupBalance_byteRange weights balanced bounded + (queried (by simp [rankByteQueries] : (bytes 4, bytes 5) ∈ rankByteQueries bytes)) + intro i + have cases : i = 0 ∨ i = 1 ∨ i = 2 ∨ i = 3 ∨ i = 4 ∨ i = 5 := by omega + rcases cases with rfl | rfl | rfl | rfl | rfl | rfl + · exact p0.1 + · exact p0.2 + · exact p1.1 + · exact p1.2 + · exact p2.1 + · exact p2.2 + +theorem exactLookupBalance_call_order {queries : List (G × G)} + (weights : Fin 65536 → G) + (balanced : ExactLookupBalance queries (byteRangeProviders weights)) + (bounded : queries.length < gSize.toNat) (parent child gap : Fin 6 → G) + (hp : rankByteQueries parent ⊆ queries) + (hc : rankByteQueries child ⊆ queries) + (hg : rankByteQueries gap ⊆ queries) + (satisfied : callOrderConstraint (packRank parent) (packRank child) (packRank gap) = 0) : + (packRank parent).n < (packRank child).n := + packed_call_order_strict parent child gap + (exactLookupBalance_rankBytes weights balanced bounded parent hp) + (exactLookupBalance_rankBytes weights balanced bounded child hc) + (exactLookupBalance_rankBytes weights balanced bounded gap hg) satisfied + +end AIR +end Aiur diff --git a/Ix/Aiur/Proofs/LookupBudget.lean b/Ix/Aiur/Proofs/LookupBudget.lean new file mode 100644 index 000000000..7a3ff6c9f --- /dev/null +++ b/Ix/Aiur/Proofs/LookupBudget.lean @@ -0,0 +1,268 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.GlobalLookups + +/-! +The native verifier's conservative lookup-consumer budget. + +Canonical slot counts and active-order trace heights determine the bound: +one public claim plus every lookup slot in every active trace row. The total +natural-number model below checks sequence alignment, shift bounds and the +strict field-characteristic bound. Its accepted arithmetic fits the native +checked u64 operations. The component gate compares both implementations. + +Interpreting actual consumer multiplicities as zero or one and counting them +within these slots still belongs to native AIR extraction. These definitions +and comparisons are not a proof of Rust execution refinement. +-/ + +namespace Aiur + +/-- Canonical circuit slot counts and the activation bitmap consume trace +degrees in active order. Missing, extra and misaligned entries fail. -/ +def lookupSlotSum : List Nat → List Bool → List Nat → Option Nat + | [], [], [] => some 0 + | _ :: slots, false :: active, degrees => lookupSlotSum slots active degrees + | slots :: rest, true :: active, degree :: degrees => do + let tail ← lookupSlotSum rest active degrees + pure (2 ^ degree * slots + tail) + | _, _, _ => none + +def lookupQueryBoundAux : List Nat → List Bool → List Nat → Nat → Option Nat + | [], [], [], used => some used + | _ :: slots, false :: active, degrees, used => lookupQueryBoundAux slots active degrees used + | slots :: rest, true :: active, degree :: degrees, used => + if degree < 64 then + let next := used + 2 ^ degree * slots + if next < gSize.toNat then lookupQueryBoundAux rest active degrees next else none + else none + | _, _, _, _ => none + +/-- Total natural-number mirror of the native checked-u64 budget guard. +Counting every slot includes providers and bounds unit consumers from above. +The initial one is the single public claim. -/ +def lookupQueryBound (slots : List Nat) (active : List Bool) (degrees : List Nat) : Option Nat := + if active.any id then lookupQueryBoundAux slots active degrees 1 else none + +theorem lookupQueryBoundAux_sound {slots : List Nat} {active : List Bool} {degrees : List Nat} + {used result : Nat} (below : used < gSize.toNat) + (accepted : lookupQueryBoundAux slots active degrees used = some result) : + ∃ total, lookupSlotSum slots active degrees = some total ∧ result = used + total ∧ + result < gSize.toNat := by + induction slots generalizing active degrees used with + | nil => + cases active <;> cases degrees <;> simp only [lookupQueryBoundAux, reduceCtorEq] at accepted + cases accepted + exact ⟨0, rfl, by omega, below⟩ + | cons count slots ih => + cases active with + | nil => simp only [lookupQueryBoundAux, reduceCtorEq] at accepted + | cons enabled active => + cases enabled with + | false => exact ih below accepted + | true => + cases degrees with + | nil => simp only [lookupQueryBoundAux, reduceCtorEq] at accepted + | cons degree degrees => + simp only [lookupQueryBoundAux] at accepted + split at accepted + next degreeBound => + split at accepted + next nextBound => + obtain ⟨total, shape, sum, bounded⟩ := ih nextBound accepted + refine ⟨2 ^ degree * count + total, ?_, by omega, bounded⟩ + simp only [lookupSlotSum, shape, bind, Option.bind, pure] + next => contradiction + next => contradiction + +theorem lookupQueryBound_sound {slots : List Nat} {active : List Bool} {degrees : List Nat} + {result : Nat} (accepted : lookupQueryBound slots active degrees = some result) : + active.any id = true ∧ ∃ total, lookupSlotSum slots active degrees = some total ∧ + result = 1 + total ∧ result < gSize.toNat := by + simp only [lookupQueryBound] at accepted + split at accepted + next enabled => exact ⟨enabled, lookupQueryBoundAux_sound (by decide) accepted⟩ + next => contradiction + +theorem lookupQueryBound_consumer_count {slots : List Nat} {active : List Bool} {degrees : List Nat} + {result total : Nat} (accepted : lookupQueryBound slots active degrees = some result) + (shape : lookupSlotSum slots active degrees = some total) + {α : Type u} (queries : List α) (perSlot : queries.length ≤ total) : + (queries.length + 1) < gSize.toNat := by + obtain ⟨_, sum, sameShape, sameResult, below⟩ := lookupQueryBound_sound accepted + have equal := Option.some.inj (sameShape.symm.trans shape) + omega + +theorem lookupQueryBoundAux_shape {slots : List Nat} {active : List Bool} {degrees : List Nat} + {used result : Nat} (accepted : lookupQueryBoundAux slots active degrees used = some result) : + slots.length = active.length ∧ degrees.length = active.count true ∧ + ∀ degree ∈ degrees, degree < 64 := by + induction slots generalizing active degrees used with + | nil => + cases active <;> cases degrees <;> simp only [lookupQueryBoundAux, reduceCtorEq] at accepted + exact ⟨rfl, rfl, by simp only [List.not_mem_nil, false_implies, implies_true]⟩ + | cons count slots ih => + cases active with + | nil => simp only [lookupQueryBoundAux, reduceCtorEq] at accepted + | cons enabled active => + cases enabled with + | false => + obtain ⟨aligned, degreesCount, bounded⟩ := ih accepted + refine ⟨by simpa only [List.length_cons] using congrArg Nat.succ aligned, ?_, bounded⟩ + simpa only [List.count_cons, beq_iff_eq, Bool.false_eq_true, ↓reduceIte, Nat.add_zero] + using degreesCount + | true => + cases degrees with + | nil => simp only [lookupQueryBoundAux, reduceCtorEq] at accepted + | cons degree degrees => + simp only [lookupQueryBoundAux] at accepted + split at accepted + next degreeBound => + split at accepted + next => + obtain ⟨aligned, degreesCount, bounded⟩ := ih accepted + refine ⟨by simpa only [List.length_cons] using congrArg Nat.succ aligned, ?_, ?_⟩ + · simpa only [List.length_cons, List.count_cons, beq_iff_eq, ↓reduceIte, Nat.succ_eq_add_one] + using congrArg Nat.succ degreesCount + · intro d member + rcases List.mem_cons.mp member with same | later + · exact same ▸ degreeBound + · exact bounded d later + next => contradiction + next => contradiction + +theorem lookupQueryBound_shape {slots : List Nat} {active : List Bool} {degrees : List Nat} + {result : Nat} (accepted : lookupQueryBound slots active degrees = some result) : + active.any id = true ∧ slots.length = active.length ∧ + degrees.length = active.count true ∧ ∀ degree ∈ degrees, degree < 64 := by + simp only [lookupQueryBound] at accepted + split at accepted + next enabled => exact ⟨enabled, lookupQueryBoundAux_shape accepted⟩ + next => contradiction + +/-- A step admitted by the natural-number guard fits both native checked +u64 operations. Arithmetic overflow can never turn a rejected sum into an +accepted smaller count. -/ +theorem lookupQueryBound_step_no_overflow {used height slots : Nat} + (accepted : used + height * slots < gSize.toNat) : + height * slots < 2 ^ 64 ∧ used + height * slots < 2 ^ 64 := by + have modulus : gSize.toNat < 2 ^ 64 := by decide +kernel + omega + +theorem lookupQueryBoundAux_complete {slots : List Nat} {active : List Bool} {degrees : List Nat} + {used total : Nat} (shape : lookupSlotSum slots active degrees = some total) + (degreesBound : ∀ degree ∈ degrees, degree < 64) + (bounded : used + total < gSize.toNat) : + lookupQueryBoundAux slots active degrees used = some (used + total) := by + induction slots generalizing active degrees used total with + | nil => + cases active <;> cases degrees <;> simp only [lookupSlotSum, reduceCtorEq] at shape + cases shape + rfl + | cons count slots ih => + cases active with + | nil => simp only [lookupSlotSum, reduceCtorEq] at shape + | cons enabled active => + cases enabled with + | false => exact ih shape degreesBound bounded + | true => + cases degrees with + | nil => simp only [lookupSlotSum, reduceCtorEq] at shape + | cons degree degrees => + cases tail : lookupSlotSum slots active degrees with + | none => simp only [lookupSlotSum, tail, bind, Option.bind, reduceCtorEq] at shape + | some rest => + have totalEq : 2 ^ degree * count + rest = total := by + simpa only [lookupSlotSum, tail, bind, Option.bind, pure, Option.some.injEq] using shape + have nextBound : used + 2 ^ degree * count < gSize.toNat := by omega + have continued := ih tail + (fun d member => degreesBound d (List.mem_cons_of_mem degree member)) + (used := used + 2 ^ degree * count) (by omega) + simp only [lookupQueryBoundAux, if_pos (degreesBound degree List.mem_cons_self), + if_pos nextBound, continued] + congr 1 + omega + +theorem lookupQueryBound_complete {slots : List Nat} {active : List Bool} {degrees : List Nat} + {total : Nat} (enabled : active.any id = true) + (shape : lookupSlotSum slots active degrees = some total) + (degreesBound : ∀ degree ∈ degrees, degree < 64) + (bounded : 1 + total < gSize.toNat) : + lookupQueryBound slots active degrees = some (1 + total) := by + simp only [lookupQueryBound, enabled, ↓reduceIte] + exact lookupQueryBoundAux_complete shape degreesBound bounded + +theorem lookupSlotSum_bounded {slots : List Nat} {active : List Bool} {degrees : List Nat} + {total maxSlots maxDegree : Nat} (shape : lookupSlotSum slots active degrees = some total) + (slotsBound : ∀ count ∈ slots, count ≤ maxSlots) + (degreesBound : ∀ degree ∈ degrees, degree ≤ maxDegree) : + total ≤ slots.length * (2 ^ maxDegree * maxSlots) := by + induction slots generalizing active degrees total with + | nil => + cases active <;> cases degrees <;> simp only [lookupSlotSum, reduceCtorEq] at shape + cases shape + exact Nat.zero_le _ + | cons count slots ih => + have tailSlots : ∀ n ∈ slots, n ≤ maxSlots := + fun n member => slotsBound n (List.mem_cons_of_mem count member) + cases active with + | nil => simp only [lookupSlotSum, reduceCtorEq] at shape + | cons enabled active => + cases enabled with + | false => + have bound := ih shape tailSlots degreesBound + simp only [List.length_cons, Nat.add_mul] + omega + | true => + cases degrees with + | nil => simp only [lookupSlotSum, reduceCtorEq] at shape + | cons degree degrees => + cases tail : lookupSlotSum slots active degrees with + | none => simp only [lookupSlotSum, tail, bind, Option.bind, reduceCtorEq] at shape + | some rest => + have totalEq : 2 ^ degree * count + rest = total := by + simpa only [lookupSlotSum, tail, bind, Option.bind, pure, Option.some.injEq] using shape + have tailBound := ih tail tailSlots + (fun d member => degreesBound d (List.mem_cons_of_mem degree member)) + have powerBound : 2 ^ degree ≤ 2 ^ maxDegree := + Nat.pow_le_pow_right (by decide) (degreesBound degree List.mem_cons_self) + have headBound := Nat.mul_le_mul powerBound (slotsBound count List.mem_cons_self) + simp only [List.length_cons, Nat.add_mul] + omega + +/-- Version-five keys encode circuit and slot counts as u16. Together with +Goldilocks' maximum 2^32 trace height, those format limits already leave a +strict margin below the characteristic. The explicit budget guard preserves +every such well-shaped proof, independently of its chosen activation subset. -/ +theorem lookupQueryBound_encodedKey {slots : List Nat} {active : List Bool} {degrees : List Nat} + {total : Nat} (enabled : active.any id = true) + (shape : lookupSlotSum slots active degrees = some total) + (circuitCount : slots.length < 65536) + (slotsBound : ∀ count ∈ slots, count < 65536) + (degreesBound : ∀ degree ∈ degrees, degree ≤ 32) : + lookupQueryBound slots active degrees = some (1 + total) := by + apply lookupQueryBound_complete enabled shape + (fun degree member => Nat.lt_of_le_of_lt (degreesBound degree member) (by decide)) + have totalBound := lookupSlotSum_bounded shape (maxSlots := 65535) + (fun count member => Nat.le_sub_one_of_lt (slotsBound count member)) degreesBound + have countBound : slots.length ≤ 65535 := by omega + have outerBound := Nat.mul_le_mul_right (2 ^ 32 * 65535) countBound + have margin : 1 + 65535 * (2 ^ 32 * 65535) < gSize.toNat := by decide +kernel + omega + +/-- The checked native budget supplies the global count premise once local +AIR extraction bounds internal unit consumers by the trace's slot total. -/ +theorem AIR.GlobalLookups.of_budget {tables : AIR.LookupTables} {width : Nat} + {slots : List Nat} {active : List Bool} {degrees : List Nat} {result total : Nat} + (accepted : lookupQueryBound slots active degrees = some result) + (shape : lookupSlotSum slots active degrees = some total) + (root : List G) (queries : List (List G)) (perSlot : queries.length ≤ total) + (balance : AIR.PaddedLookupBalance width (root :: queries) tables.providers) + (widths : ∀ query ∈ root :: queries, query.length ≤ width) : + AIR.GlobalLookups tables width (root :: queries) := + ⟨balance, lookupQueryBound_consumer_count accepted shape queries perSlot, widths⟩ + +end Aiur diff --git a/Ix/Aiur/Proofs/LookupLayout.lean b/Ix/Aiur/Proofs/LookupLayout.lean new file mode 100644 index 000000000..aa833192f --- /dev/null +++ b/Ix/Aiur/Proofs/LookupLayout.lean @@ -0,0 +1,1021 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.CircuitMembership + +/-! +The compiler's lookup allocation equals the valued emitter's physical extent. +The equality is preserved by function renaming and deduplication; final +compilation and grouping bound every member by its selected circuit layout. +Canonical trace execution therefore needs no independent per-witness lookup +limit or shape hypothesis. Native extraction, memory validity and the complete +compiler and certified semantic/cryptographic endpoint remain obligations. +-/ + +namespace Aiur.Bytecode + +def Op.lookupUsage : Op → Nat + | .call _ _ _ unconstrained => if unconstrained then 0 else 4 + | .store _ | .load _ _ | .u8BitDecomposition _ | .u8ShiftLeft _ | .u8ShiftRight _ + | .u8Xor .. | .u8And .. | .u8Or .. | .u8Add .. | .u8Sub .. | .u8Mul .. + | .u8XorSplit7 .. | .u8XorSplit4 .. | .u8LessThan .. | .u8RangeCheck .. => 1 + | .u32LessThan .. => 6 + | _ => 0 + +private theorem lookup_block_smaller (block : Block) : sizeOf block.ctrl < sizeOf block := by + cases block + simp + omega + +mutual + +def Ctrl.lookupUsage : Ctrl → Nat + | .return .. | .yield .. => 0 + | .match _ branches fallback => ( + (branches.attach.toList.map fun ⟨pair, _⟩ => pair.2.lookupUsage) ++ + (match fallback with | none => [] | some block => [block.lookupUsage])).foldl Nat.max 0 + | .matchContinue _ branches fallback _ _ _ continuation => ( + (branches.attach.toList.map fun ⟨pair, _⟩ => pair.2.lookupUsage) ++ + (match fallback with | none => [] | some block => [block.lookupUsage])).foldl Nat.max 0 + + continuation.lookupUsage +termination_by ctrl => sizeOf ctrl +decreasing_by + all_goals first + | decreasing_tactic + | (have := Array.sizeOf_lt_of_mem ‹_ ∈ _›; grind) + +def Block.lookupUsage (block : Block) : Nat := + (block.ops.toList.map Op.lookupUsage).sum + block.ctrl.lookupUsage +termination_by sizeOf block +decreasing_by exact lookup_block_smaller block + +end + +def branchLookupUsage (branches : Array (G × Block)) (fallback : Option Block) : Nat := + (branches.toList.map (fun pair => pair.2.lookupUsage) ++ + fallback.toList.map (fun block => block.lookupUsage)).foldl Nat.max 0 + +theorem Ctrl.lookupUsage_match (index : ValIdx) (branches : Array (G × Block)) (fallback : Option Block) : + (Ctrl.match index branches fallback).lookupUsage = branchLookupUsage branches fallback := by + rw [Ctrl.lookupUsage.eq_def] + simp only [branchLookupUsage, Array.toList_attach] + rw [List.attachWith_map_val (f := fun pair : G × Block => pair.2.lookupUsage)] + cases fallback <;> rfl + +theorem Ctrl.lookupUsage_matchContinue (index : ValIdx) (branches : Array (G × Block)) + (fallback : Option Block) (outputs aux lookups : Nat) (continuation : Block) : + (Ctrl.matchContinue index branches fallback outputs aux lookups continuation).lookupUsage = + branchLookupUsage branches fallback + continuation.lookupUsage := by + rw [Ctrl.lookupUsage.eq_def] + simp only [branchLookupUsage, Array.toList_attach] + rw [List.attachWith_map_val (f := fun pair : G × Block => pair.2.lookupUsage)] + cases fallback <;> rfl + +end Aiur.Bytecode + +namespace Aiur.Concrete.Bytecode +open Aiur.Bytecode Std.Do + +private theorem list_getDegree (indices : List ValIdx) (initial : LayoutMState) : + (indices.mapM getDegree).run initial = (indices.map (fun i => initial.degrees[i]?.getD 0), initial) := by + induction indices with + | nil => rfl + | cons index indices ih => + rw [List.mapM_cons] + change (let (values, final) := (indices.mapM getDegree).run initial; + (initial.degrees[index]?.getD 0 :: values, final)) = + (initial.degrees[index]?.getD 0 :: indices.map (fun i => initial.degrees[i]?.getD 0), initial) + rw [ih] + +private theorem array_getDegree (indices : Array ValIdx) : + indices.mapM getDegree = (fun initial => pure (indices.map (fun i => initial.degrees[i]?.getD 0), initial)) := by + rw [Array.mapM_eq_mapM_toList] + funext initial + change (let (values, final) := (indices.toList.mapM getDegree).run initial; + (values.toArray, final)) = (indices.map (fun i => initial.degrees[i]?.getD 0), initial) + rw [list_getDegree] + simp only [← List.map_toArray, Array.toArray_toList] + +set_option mvcgen.warning false in +theorem opLayout_lookupUsage (op : Op) (initial : LayoutMState) : + ((opLayout op).run initial).2.functionLayout.lookups = initial.functionLayout.lookups + op.lookupUsage := by + cases op <;> + simp only [opLayout, array_getDegree] <;> + apply StateM.of_wp_run_eq rfl (fun result : Unit × LayoutMState => + result.2.functionLayout.lookups = _) + all_goals + mvcgen [opLayout, array_getDegree, bumpLookups, bumpAuxiliaries, getDegree, getDegrees, + pushDegree, pushDegrees, addMemSize] + all_goals simp_all [Op.lookupUsage] + all_goals try rfl + +private theorem ops_fold_lookupUsage (ops : List Op) (initial : LayoutMState) : + ((ops.foldlM (fun _ op => opLayout op) ()).run initial).2.functionLayout.lookups = + initial.functionLayout.lookups + (ops.map Op.lookupUsage).sum := by + induction ops generalizing initial with + | nil => rfl + | cons op ops ih => + rw [List.foldlM_cons] + change ((ops.foldlM (fun _ op => opLayout op) ()).run ((opLayout op).run initial).2).2.functionLayout.lookups = _ + rw [ih, opLayout_lookupUsage, List.map_cons, List.sum_cons, Nat.add_assoc] + +theorem opsLayout_lookupUsage (ops : Array Op) (initial : LayoutMState) : + ((ops.forM opLayout).run initial).2.functionLayout.lookups = + initial.functionLayout.lookups + (ops.toList.map Op.lookupUsage).sum := by + unfold Array.forM + rw [← Array.foldlM_toList] + exact ops_fold_lookupUsage ops.toList initial + +private def branchLayoutStep (shared : SharedData) (degrees : Array Nat) (acc : SharedData) + (block : Block) : LayoutM SharedData := do + setSharedData shared + blockLayout block + let used ← getSharedData + setDegrees degrees + return acc.maximals used + +private theorem branchLayoutStep_lookupUsage (shared : SharedData) (degrees : Array Nat) (acc : SharedData) + (block : Block) (initial : LayoutMState) + (effect : ∀ state, ((blockLayout block).run state).2.functionLayout.lookups = + state.functionLayout.lookups + block.lookupUsage) : + ((branchLayoutStep shared degrees acc block).run initial).1.lookups = + max acc.lookups (shared.lookups + block.lookupUsage) := by + change max acc.lookups ((blockLayout block).run ((setSharedData shared).run initial).2).2.functionLayout.lookups = _ + rw [effect] + rfl + +private theorem branchFold_lookupUsage {α : Type} (items : List α) (blockOf : α → Block) + (shared : SharedData) (degrees : Array Nat) (acc : SharedData) (initial : LayoutMState) + (start : Nat) (aligned : acc.lookups = shared.lookups + start) + (effect : ∀ item ∈ items, ∀ state, ((blockLayout (blockOf item)).run state).2.functionLayout.lookups = + state.functionLayout.lookups + (blockOf item).lookupUsage) : + ((items.foldlM (fun acc item => branchLayoutStep shared degrees acc (blockOf item)) acc).run initial).1.lookups = + shared.lookups + (items.map (fun item => (blockOf item).lookupUsage)).foldl Nat.max start := by + induction items generalizing acc initial start with + | nil => exact aligned + | cons item items ih => + rw [List.foldlM_cons] + change ((items.foldlM (fun acc item => branchLayoutStep shared degrees acc (blockOf item)) + ((branchLayoutStep shared degrees acc (blockOf item)).run initial).1).run + ((branchLayoutStep shared degrees acc (blockOf item)).run initial).2).1.lookups = _ + simp only [List.map_cons, List.foldl_cons] + apply ih _ _ _ _ (fun item member => effect item (List.mem_cons_of_mem _ member)) + rw [branchLayoutStep_lookupUsage shared degrees acc (blockOf item) initial + (effect item List.mem_cons_self), aligned, Nat.add_max_add_left] + +private theorem matchLayout_lookupUsage (index : ValIdx) (branches : Array (G × Block)) + (fallback : Option Block) (initial : LayoutMState) + (caseEffect : ∀ pair ∈ branches.toList, ∀ state, ((blockLayout pair.2).run state).2.functionLayout.lookups = + state.functionLayout.lookups + pair.2.lookupUsage) + (defaultEffect : ∀ block, fallback = some block → ∀ state, + ((blockLayout block).run state).2.functionLayout.lookups = + state.functionLayout.lookups + block.lookupUsage) : + ((ctrlLayout (.match index branches fallback)).run initial).2.functionLayout.lookups = + initial.functionLayout.lookups + branchLookupUsage branches fallback := by + let shared : SharedData := ⟨initial.functionLayout.auxiliaries, initial.functionLayout.lookups⟩ + let loop : LayoutM SharedData := branches.attach.foldlM (init := shared) + fun acc pair => branchLayoutStep shared initial.degrees acc pair.val.2 + have loopCount : (loop.run initial).1.lookups = initial.functionLayout.lookups + + (branches.toList.map (fun pair => pair.2.lookupUsage)).foldl Nat.max 0 := by + dsimp only [loop] + rw [← Array.foldlM_toList] + have count := branchFold_lookupUsage branches.attach.toList (fun pair => pair.val.2) + shared initial.degrees shared initial 0 (Nat.add_zero _).symm + (fun pair _ => caseEffect pair.val (Array.mem_def.mp pair.property)) + simp only [Array.toList_attach] at count ⊢ + rw [List.attachWith_map_val (f := fun pair : G × Block => pair.2.lookupUsage)] at count + exact count + rw [ctrlLayout.eq_def] + cases fallbackEq : fallback with + | none => + change (loop.run initial).1.lookups = _ + simpa only [branchLookupUsage, fallbackEq, Option.toList_none, List.map_nil, List.append_nil] using loopCount + | some block => + change max (loop.run initial).1.lookups + ((blockLayout block).run ((bumpAuxiliaries branches.size).run + ((setSharedData shared).run (loop.run initial).2).2).2).2.functionLayout.lookups = _ + rw [defaultEffect block fallbackEq] + change max (loop.run initial).1.lookups (initial.functionLayout.lookups + block.lookupUsage) = _ + rw [loopCount, Nat.add_max_add_left] + simp only [branchLookupUsage, Option.toList_some, List.map_cons, List.map_nil, + List.foldl_append, List.foldl_cons, List.foldl_nil] + +end Aiur.Concrete.Bytecode + +namespace Aiur.Bytecode + +def Function.LookupLayout (function : Function) : Prop := + function.layout.lookups = 4 + function.body.lookupUsage + +def FunctionsLookupLayout (functions : Array Function) : Prop := + ∀ function ∈ functions, function.LookupLayout + +private theorem functionsLookupLayout_empty : FunctionsLookupLayout #[] := by + simp [FunctionsLookupLayout] + +private theorem functionsLookupLayout_push {functions : Array Function} {function : Function} + (before : FunctionsLookupLayout functions) (valid : function.LookupLayout) : + FunctionsLookupLayout (functions.push function) := by + intro fn member + rcases Array.mem_push.mp member with prior | equal + · exact before fn prior + · subst fn; exact valid + +end Aiur.Bytecode + +namespace Aiur.AIR +open Bytecode + +theorem emitOp_lookupUsage {row : Nat → G} {selector rank : G} {op : Op} + {values : Array RowValue} {emission : OpEmission} + (emitted : emitOp row selector rank op values = some emission) : + emission.queries.length = op.lookupUsage := by + cases op <;> simp only [emitOp, emitByte1, emitByte2, emitU32LessThan, emitU32Add, + emitAdvice, bind, Option.bind, Option.map, pure] at emitted + all_goals + repeat' first + | split at emitted + | (dsimp only at emitted; split at emitted) + all_goals cases emitted + all_goals simp_all [Op.lookupUsage, rankByteQueries, range4Queries] + +theorem emitOps_lookupUsage {row : Nat → G} {selector rank : G} {ops : List Op} + {values : Array RowValue} {column : Nat} {emission : OpsEmission} + (emitted : emitOps row selector rank ops values column = some emission) : + emission.queries.length = (ops.map Op.lookupUsage).sum := by + induction ops generalizing values column emission with + | nil => + have equal := Option.some.inj emitted + subst emission + rfl + | cons op ops ih => + simp only [emitOps, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i first firstEmitted + dsimp only at emitted + split at emitted + · cases emitted + · rename_i rest restEmitted + have equal := Option.some.inj emitted + subst emission + simp only [List.length_append, List.map_cons, List.sum_cons, + emitOp_lookupUsage firstEmitted, ih restEmitted] + +end Aiur.AIR + +namespace Aiur.Bytecode +open Aiur.AIR + +private theorem lookup_fold_related {blocks : List Block} {emissions : List BlockEmission} {lookup : Nat} + (related : List.Forall₂ (fun block emission => emission.lookup = lookup + block.lookupUsage) blocks emissions) + (acc : Nat) : + emissions.foldl (fun value emission => max value emission.lookup) (lookup + acc) = + lookup + (blocks.map Block.lookupUsage).foldl Nat.max acc := by + induction related generalizing acc with + | nil => rfl + | cons first rest ih => + simp only [List.foldl_cons, List.map_cons, first, Nat.add_max_add_left] + exact ih _ + +theorem branchRows_lookupUsage (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (matched : G) (values : Array RowValue) (column lookup : Nat) + (branches : Array (G × Block)) (fallback : Option Block) {emission : BlockEmission} + (emitted : branchRows row selector context matched values column lookup branches fallback = some emission) + (caseSound : ∀ pair ∈ branches.toList, ∀ emission, + pair.2.emitRow row selector context (pair.2.selectorFlow selector).entry values column lookup = some emission → + emission.lookup = lookup + pair.2.lookupUsage) + (defaultSound : ∀ block, fallback = some block → ∀ emission, + block.emitRow row selector context (block.selectorFlow selector).entry values + (column + branches.size) lookup = some emission → + emission.lookup = lookup + block.lookupUsage) : + emission.lookup = lookup + branchLookupUsage branches fallback := by + simp only [branchRows, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i cases casesEmitted + dsimp only at emitted + split at emitted + · cases emitted + · rename_i default defaultEmitted + have equal := Option.some.inj emitted + subst emission + have casesRelated : List.Forall₂ (fun block emission => emission.lookup = lookup + block.lookupUsage) + (branches.toList.map Prod.snd) cases := by + apply forall₂_map_left + apply mapM_forall₂ casesEmitted + intro pair member emission emitted + simp only [caseRow, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i body bodyEmitted + have equal := Option.some.inj emitted + subst emission + exact caseSound pair member body bodyEmitted + have defaultRelated : List.Forall₂ (fun block emission => emission.lookup = lookup + block.lookupUsage) + fallback.toList default := by + cases fallbackEq : fallback with + | none => + simp only [defaultRow, fallbackEq, Option.some.injEq] at defaultEmitted + subst default + exact .nil + | some block => + simp only [defaultRow, fallbackEq, bind, Option.bind] at defaultEmitted + split at defaultEmitted + · cases defaultEmitted + · rename_i body bodyEmitted + have equal := Option.some.inj defaultEmitted + subst default + exact .cons (defaultSound block fallbackEq body bodyEmitted) .nil + have joined := lookup_fold_related (forall₂_append casesRelated defaultRelated) 0 + simpa only [Nat.add_zero, joinBlockEmissions, branchLookupUsage, List.map_append, + List.map_map, Function.comp_def] using joined + +private theorem lookup_pair_smaller (pair : G × Block) : sizeOf pair.2 < sizeOf pair := by + cases pair + simp + omega + +private theorem lookup_option_smaller {fallback : Option Block} {block : Block} + (present : fallback = some block) : sizeOf block < sizeOf fallback := by + rw [present] + simp + +mutual + +theorem Ctrl.emitRow_lookupUsage (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (incoming : G) (values : Array RowValue) (column lookup : Nat) (ctrl : Ctrl) + {emission : BlockEmission} + (emitted : ctrl.emitRow row selector context incoming values column lookup = some emission) : + emission.lookup = lookup + ctrl.lookupUsage := by + cases ctrlEq : ctrl with + | «return» index indices => + rw [ctrlEq] at emitted + rw [Ctrl.emitRow.eq_def] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · dsimp only at emitted + split at emitted + · cases emitted + · have equal := Option.some.inj emitted + subst emission + simp only [Ctrl.lookupUsage, Nat.add_zero] + | yield index indices => + rw [ctrlEq] at emitted + rw [Ctrl.emitRow.eq_def] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · have equal := Option.some.inj emitted + subst emission + simp only [Ctrl.lookupUsage, Nat.add_zero] + | «match» index branches fallback => + rw [ctrlEq] at emitted + rw [Ctrl.lookupUsage_match] + rw [Ctrl.emitRow_match] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i matched read + apply branchRows_lookupUsage row selector context matched.value values column lookup branches fallback emitted + · intro pair member body bodyEmitted + exact Block.emitRow_lookupUsage row selector context _ values column lookup pair.2 bodyEmitted + · intro block present body bodyEmitted + exact Block.emitRow_lookupUsage row selector context _ values _ lookup block bodyEmitted + | matchContinue index branches fallback size aux slots continuation => + rw [ctrlEq] at emitted + rw [Ctrl.lookupUsage_matchContinue] + rw [Ctrl.emitRow_matchContinue] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i matched read + dsimp only at emitted + split at emitted + · cases emitted + · rename_i joined branchesEmitted + simp only [continueRow] at emitted + split at emitted + · simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i continued contEmitted + have equal := Option.some.inj emitted + subst emission + have joinedLookup := branchRows_lookupUsage row selector context matched.value values column lookup + branches fallback branchesEmitted + (fun pair member body bodyEmitted => + Block.emitRow_lookupUsage row selector context _ values column lookup pair.2 bodyEmitted) + (fun block present body bodyEmitted => + Block.emitRow_lookupUsage row selector context _ values _ lookup block bodyEmitted) + have contLookup := Block.emitRow_lookupUsage row selector context _ _ _ _ continuation contEmitted + simpa only [BlockEmission.continued, joinedLookup, Nat.add_assoc] using contLookup + · cases emitted +termination_by sizeOf ctrl +decreasing_by + all_goals + try rw [ctrlEq] + first + | (have bound := Array.sizeOf_lt_of_mem (Array.mem_def.mpr member) + have pairBound := lookup_pair_smaller pair + first | simp only [Ctrl.match.sizeOf_spec] | simp only [Ctrl.matchContinue.sizeOf_spec] + omega) + | (have optionBound := lookup_option_smaller present + first | simp only [Ctrl.match.sizeOf_spec] | simp only [Ctrl.matchContinue.sizeOf_spec] + omega) + | (simp only [Ctrl.matchContinue.sizeOf_spec]; omega) + +theorem Block.emitRow_lookupUsage (row : Nat → G) (selector : SelIdx → G) (context : RowContext) + (incoming : G) (values : Array RowValue) (column lookup : Nat) (block : Block) + {emission : BlockEmission} + (emitted : block.emitRow row selector context incoming values column lookup = some emission) : + emission.lookup = lookup + block.lookupUsage := by + rw [Block.emitRow] at emitted + simp only [bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i operations opsEmitted + dsimp only at emitted + split at emitted + · cases emitted + · rename_i control ctrlEmitted + have controlLookup := Ctrl.emitRow_lookupUsage row selector context incoming _ _ _ block.ctrl ctrlEmitted + have equal := Option.some.inj emitted + subst emission + simpa only [BlockEmission.prefix, BlockEmission.afterOps, Block.lookupUsage, + emitOps_lookupUsage opsEmitted, Nat.add_assoc] using controlLookup +termination_by sizeOf block +decreasing_by exact lookup_block_smaller block + +end + +end Aiur.Bytecode + +namespace Aiur.Concrete.Bytecode +open Aiur.Bytecode + +private theorem ctrlLayout_matchContinue (index : ValIdx) (branches : Array (G × Block)) + (fallback : Option Block) (size aux slots : Nat) (continuation : Block) : + ctrlLayout (.matchContinue index branches fallback size aux slots continuation) = (do + ctrlLayout (.match index branches fallback) + bumpAuxiliaries size + pushDegrees (.replicate size 1) + blockLayout continuation) := by + cases fallback <;> simp only [ctrlLayout.eq_def, bind_assoc] + all_goals rfl + +mutual + +theorem ctrlLayout_lookupUsage (ctrl : Ctrl) (initial : LayoutMState) : + ((ctrlLayout ctrl).run initial).2.functionLayout.lookups = + initial.functionLayout.lookups + ctrl.lookupUsage := by + cases ctrlEq : ctrl with + | «return» index indices => + rw [ctrlLayout.eq_def, Ctrl.lookupUsage.eq_def] + rfl + | yield index indices => + rw [ctrlLayout.eq_def, Ctrl.lookupUsage.eq_def] + rfl + | «match» index branches fallback => + rw [Ctrl.lookupUsage_match] + apply matchLayout_lookupUsage index branches fallback initial + · intro pair member state + exact blockLayout_lookupUsage pair.2 state + · intro block present state + exact blockLayout_lookupUsage block state + | matchContinue index branches fallback size aux slots continuation => + rw [ctrlLayout_matchContinue, Ctrl.lookupUsage_matchContinue] + change ((blockLayout continuation).run ((pushDegrees (.replicate size 1)).run + ((bumpAuxiliaries size).run ((ctrlLayout (.match index branches fallback)).run initial).2).2).2).2.functionLayout.lookups = _ + rw [blockLayout_lookupUsage] + change ((ctrlLayout (.match index branches fallback)).run initial).2.functionLayout.lookups + + continuation.lookupUsage = _ + have first := matchLayout_lookupUsage index branches fallback initial + (fun pair member state => blockLayout_lookupUsage pair.2 state) + (fun block present state => blockLayout_lookupUsage block state) + rw [first, Nat.add_assoc] +termination_by sizeOf ctrl +decreasing_by + all_goals + try rw [ctrlEq] + first + | (have bound := Array.sizeOf_lt_of_mem (Array.mem_def.mpr member) + have pairBound := lookup_pair_smaller pair + first | simp only [Ctrl.match.sizeOf_spec] | simp only [Ctrl.matchContinue.sizeOf_spec] + omega) + | (have optionBound := lookup_option_smaller present + first | simp only [Ctrl.match.sizeOf_spec] | simp only [Ctrl.matchContinue.sizeOf_spec] + omega) + | (simp only [Ctrl.matchContinue.sizeOf_spec]; omega) + +theorem blockLayout_lookupUsage (block : Block) (initial : LayoutMState) : + ((blockLayout block).run initial).2.functionLayout.lookups = + initial.functionLayout.lookups + block.lookupUsage := by + rw [blockLayout] + change ((ctrlLayout block.ctrl).run ((block.ops.forM opLayout).run initial).2).2.functionLayout.lookups = _ + rw [ctrlLayout_lookupUsage, opsLayout_lookupUsage, Block.lookupUsage, Nat.add_assoc] +termination_by sizeOf block +decreasing_by exact lookup_block_smaller block + +end + +end Aiur.Concrete.Bytecode + +namespace Aiur.Concrete +open Aiur.Bytecode + +private theorem layout_result_lookupUsage {body : Block} {size : Nat} {state : Bytecode.LayoutMState} + {resultUnit : Unit} (computed : (Bytecode.blockLayout body).run (.new size) = (resultUnit, state)) : + state.functionLayout.lookups + 1 = 4 + body.lookupUsage := by + have count := Bytecode.blockLayout_lookupUsage body (.new size) + rw [computed] at count + simp only [Bytecode.LayoutMState.new] at count + omega + +theorem Function.compile_lookupLayout {layoutMap : LayoutMap} {function : Function} + {body : Block} {state : Bytecode.LayoutMState} + (compiled : function.compile layoutMap = .ok (body, state)) : + state.functionLayout.lookups = 4 + body.lookupUsage := by + unfold Function.compile at compiled + simp only [bind, Except.bind, pure, Except.pure] at compiled + repeat' first + | split at compiled + | (dsimp only at compiled; split at compiled) + all_goals cases compiled + all_goals + change _ + 1 = 4 + _ + exact layout_result_lookupUsage (by assumption) + +open Std.Do + +private theorem except_post {ε α : Type} (action : Except ε α) (property : α → Prop) + (valid : ∀ value, action = .ok value → property value) : + ⦃⌜True⌝⦄ action ⦃post⟨fun value => ⌜property value⌝, fun _ => ⌜True⌝⟩⦄ := by + cases computed : action with + | error error => + change ⦃⌜True⌝⦄ (throw error : Except ε α) ⦃post⟨fun value => ⌜property value⌝, fun _ => ⌜True⌝⟩⦄ + simp [Triple.iff] + | ok value => + change ⦃⌜True⌝⦄ (pure value : Except ε α) ⦃post⟨fun value => ⌜property value⌝, fun _ => ⌜True⌝⟩⦄ + simpa [Triple.iff] using valid value computed + +private theorem lookup_throw {ε α : Type} {error : ε} {post : PostCond α (.except ε .pure)} : + Triple (ps := .except ε .pure) (throw error : Except ε α) (spred(post.2.1 error)) post := by + simp [Triple.iff] + +private theorem layoutMap_spec (decls : Decls) : + ⦃⌜True⌝⦄ decls.layoutMap ⦃post⟨fun _ => ⌜True⌝, fun _ => ⌜True⌝⟩⦄ := + except_post decls.layoutMap (fun _ => True) (fun _ _ => trivial) + +set_option mvcgen.warning false in +theorem Decls.toBytecode_lookupLayout {decls : Decls} {program : Toplevel} + {names : Std.HashMap Global FunIdx} (compiled : decls.toBytecode = .ok (program, names)) : + FunctionsLookupLayout program.functions := by + have spec : ⦃⌜True⌝⦄ decls.toBytecode + ⦃post⟨fun result => ⌜FunctionsLookupLayout result.1.functions⌝, fun _ => ⌜True⌝⟩⦄ := by + mvcgen [Decls.toBytecode, IndexMap.foldlM, ← Array.foldlM_toList, + layoutMap_spec, -Spec.throw_Except, lookup_throw] invariants + · post⟨fun ⟨_, functions, _⟩ => ⌜FunctionsLookupLayout functions⌝, fun _ => ⌜True⌝⟩ + case vc2.step.h_1.h_2 => + apply functionsLookupLayout_push (by assumption) + exact Function.compile_lookupLayout (by assumption) + case vc4.success.pre => exact functionsLookupLayout_empty + exact Except.of_wp_eq compiled (fun result => match result with + | .error _ => True + | .ok result => FunctionsLookupLayout result.1.functions) spec + +end Aiur.Concrete + +namespace Aiur.Bytecode + +theorem rewriteOp_lookupUsage (rename : FunIdx → FunIdx) (op : Op) : + (rewriteOp rename op).lookupUsage = op.lookupUsage := by + cases op <;> rfl + +private theorem branchLookupUsage_rewrite (rename : FunIdx → FunIdx) + (branches : Array (G × Block)) (fallback : Option Block) + (caseEqual : ∀ pair ∈ branches.toList, (rewriteBlock rename pair.2).lookupUsage = pair.2.lookupUsage) + (defaultEqual : ∀ block, fallback = some block → (rewriteBlock rename block).lookupUsage = block.lookupUsage) : + branchLookupUsage (branches.attach.map fun ⟨(tag, block), _⟩ => (tag, rewriteBlock rename block)) + (fallback.map (rewriteBlock rename)) = + branchLookupUsage branches fallback := by + unfold branchLookupUsage + apply congrArg (fun values : List Nat => values.foldl Nat.max 0) + congr 1 + · simp only [Array.toList_map, Array.toList_attach, List.map_map, Function.comp_def] + rw [← List.attachWith_map_val (p := fun pair => pair ∈ branches) + (f := fun pair : G × Block => pair.2.lookupUsage) (fun _ member => Array.mem_def.mpr member)] + apply List.map_congr_left + intro pair member + rcases pair with ⟨⟨tag, block⟩, present⟩ + exact caseEqual (tag, block) (Array.mem_def.mp present) + · cases fallbackEq : fallback with + | none => rfl + | some block => + simp only [Option.map_some, Option.toList_some, List.map_cons, List.map_nil] + rw [defaultEqual block fallbackEq] + +mutual + +theorem rewriteCtrl_lookupUsage (rename : FunIdx → FunIdx) (ctrl : Ctrl) : + (rewriteCtrl rename ctrl).lookupUsage = ctrl.lookupUsage := by + cases ctrlEq : ctrl with + | «return» index indices => rw [rewriteCtrl.eq_def] + | yield index indices => rw [rewriteCtrl.eq_def] + | «match» index branches fallback => + rw [rewriteCtrl.eq_def, Ctrl.lookupUsage_match, Ctrl.lookupUsage_match] + have equal := branchLookupUsage_rewrite rename branches fallback + (fun pair member => rewriteBlock_lookupUsage rename pair.2) + (fun block present => rewriteBlock_lookupUsage rename block) + cases fallback <;> exact equal + | matchContinue index branches fallback size aux slots continuation => + rw [rewriteCtrl.eq_def, Ctrl.lookupUsage_matchContinue, Ctrl.lookupUsage_matchContinue, + rewriteBlock_lookupUsage rename continuation] + congr 1 + have equal := branchLookupUsage_rewrite rename branches fallback + (fun pair member => rewriteBlock_lookupUsage rename pair.2) + (fun block present => rewriteBlock_lookupUsage rename block) + cases fallback <;> exact equal +termination_by sizeOf ctrl +decreasing_by + all_goals + try rw [ctrlEq] + first + | (have bound := Array.sizeOf_lt_of_mem (Array.mem_def.mpr member) + have pairBound := lookup_pair_smaller pair + first | simp only [Ctrl.match.sizeOf_spec] | simp only [Ctrl.matchContinue.sizeOf_spec] + omega) + | (have optionBound := lookup_option_smaller present + first | simp only [Ctrl.match.sizeOf_spec] | simp only [Ctrl.matchContinue.sizeOf_spec] + omega) + | (simp only [Ctrl.matchContinue.sizeOf_spec]; omega) + +theorem rewriteBlock_lookupUsage (rename : FunIdx → FunIdx) (block : Block) : + (rewriteBlock rename block).lookupUsage = block.lookupUsage := by + rw [rewriteBlock, Block.lookupUsage, Block.lookupUsage, rewriteCtrl_lookupUsage] + simp only [Array.toList_map, List.map_map, Function.comp_def, rewriteOp_lookupUsage] +termination_by sizeOf block +decreasing_by exact lookup_block_smaller block + +end + +theorem deduplicate_newFunctions_lookupLayout (functions : Array Function) + (classes : Array Nat) (canonical : Array Bool) (rename : FunIdx → FunIdx) + (valid : FunctionsLookupLayout functions) : + FunctionsLookupLayout (deduplicate_newFunctions functions classes canonical rename) := by + unfold deduplicate_newFunctions + apply Array.foldl_induction (fun _ result => FunctionsLookupLayout result) functionsLookupLayout_empty + intro index accumulated before + dsimp only + split + · apply functionsLookupLayout_push before + change (((classes.zip canonical).zip functions)[index]).2.layout.lookups = + 4 + (rewriteBlock rename (((classes.zip canonical).zip functions)[index]).2.body).lookupUsage + rw [rewriteBlock_lookupUsage] + apply valid + exact (Array.of_mem_zip (Array.getElem_mem index.isLt)).2 + · exact before + +theorem Toplevel.deduplicateCandidate_lookupLayout (program : Toplevel) + (valid : FunctionsLookupLayout program.functions) : + FunctionsLookupLayout program.deduplicateCandidate.1.functions := by + unfold Toplevel.deduplicateCandidate + dsimp only + split + · exact valid + · exact deduplicate_newFunctions_lookupLayout _ _ _ _ valid + +theorem Toplevel.deduplicate_lookupLayout (program : Toplevel) + (valid : FunctionsLookupLayout program.functions) : + FunctionsLookupLayout program.deduplicate.1.functions := by + unfold Toplevel.deduplicate checkedRenaming + dsimp only + split + · exact program.deduplicateCandidate_lookupLayout valid + · exact valid + +end Aiur.Bytecode + +namespace Aiur +open Bytecode + +theorem finishCompilation_lookupLayout (source : Source.Toplevel) (raw : Bytecode.Toplevel) + (names : Std.HashMap Global Bytecode.FunIdx) (valid : FunctionsLookupLayout raw.functions) : + FunctionsLookupLayout (finishCompilation source raw names).bytecode.functions := by + unfold finishCompilation + intro function member + obtain ⟨index, bound, equal⟩ := Array.exists_of_mem_mapIdx member + subst function + change raw.deduplicate.1.functions[index].LookupLayout + exact raw.deduplicate_lookupLayout valid _ (Array.getElem_mem bound) + +theorem Source.Toplevel.compile_lookupLayout {source : Source.Toplevel} {compiled : CompiledToplevel} + (accepted : source.compile = .ok compiled) : FunctionsLookupLayout compiled.bytecode.functions := by + obtain ⟨inlined, typed, concrete, raw, names, _, _, _, lowered, artifact⟩ := + source.compile_artifact_of_ok accepted + rw [artifact] + exact finishCompilation_lookupLayout inlined raw names (Concrete.Decls.toBytecode_lookupLayout lowered) + +theorem BoundVerifier.Backend.functions_lookupLayout {selection : BoundVerifier.Selection} + (backend : BoundVerifier.Backend selection) : FunctionsLookupLayout backend.compiled.bytecode.functions := by + obtain ⟨initial, compiled, grouped⟩ := backend.compilation_stages + have valid := Source.Toplevel.compile_lookupLayout compiled + split at grouped + · cases grouped + exact valid + · rw [(CompiledToplevel.groupFunctions_preserves_code grouped).2.2.1] + exact valid + +end Aiur + +namespace Aiur.Bytecode + +def MembersLookupBound (functions : Array Function) (members : Array FunIdx) (slots : Nat) : Prop := + 4 ≤ slots ∧ ∀ index ∈ members, functions[index]!.layout.lookups ≤ slots + +def CircuitsLookupBound (functions : Array Function) (circuits : Array Circuit) : Prop := + ∀ circuit ∈ circuits, MembersLookupBound functions circuit.members circuit.layout.lookups + +private theorem lookup_circuits_empty (functions : Array Function) : CircuitsLookupBound functions #[] := by + simp [CircuitsLookupBound] + +private theorem lookup_circuits_push {functions : Array Function} {circuits : Array Circuit} {circuit : Circuit} + (before : CircuitsLookupBound functions circuits) + (member : MembersLookupBound functions circuit.members circuit.layout.lookups) : + CircuitsLookupBound functions (circuits.push circuit) := by + intro c present + rcases Array.mem_push.mp present with prior | equal + · exact before c prior + · subst c; exact member + +private theorem lookup_member_singleton {functions : Array Function} {index : FunIdx} {function : Function} + (present : functions[index]? = some function) (valid : function.LookupLayout) : + MembersLookupBound functions #[index] function.layout.lookups := by + constructor + · change function.layout.lookups = 4 + function.body.lookupUsage at valid + omega + · intro i member + have equal : i = index := by simpa using member + subst i + rw [Array.getElem!_eq_getD, Array.getD_eq_getD_getElem?, present] + exact Nat.le_refl _ + +open Std.Do + +set_option mvcgen.warning false in +theorem singletonCircuits_lookupBound (program : Toplevel) (nameOf : FunIdx → String) + (valid : FunctionsLookupLayout program.functions) : + CircuitsLookupBound program.functions (program.singletonCircuits nameOf) := by + have spec : Triple (m := Id) (program.singletonCircuits nameOf) ⌜True⌝ + (⇓ circuits => ⌜CircuitsLookupBound program.functions circuits⌝) := by + mvcgen [Toplevel.singletonCircuits, Id.run] invariants + · ⇓⟨_, circuits⟩ => ⌜CircuitsLookupBound program.functions circuits⌝ + case vc1.step.isTrue => + apply lookup_circuits_push (by assumption) + exact lookup_member_singleton (Array.getElem?_eq_getElem _) (valid _ (Array.getElem_mem _)) + case vc3.pre => exact lookup_circuits_empty _ + exact Id.of_wp_run_eq rfl _ spec + +private theorem lookup_bang_of_present {functions : Array Function} {index : Nat} {function : Function} + (present : functions[index]? = some function) : functions[index]! = function := by + rw [Array.getElem!_eq_getD, Array.getD_eq_getD_getElem?, present] + rfl + +private theorem lookup_array_bang {α : Type} [Inhabited α] (property : α → Prop) + {array : Array α} (valid : ∀ value ∈ array, property value) (fallback : property default) (index : Nat) : + property array[index]! := by + by_cases bound : index < array.size + · rw [getElem!_pos array index bound] + exact valid _ (Array.getElem_mem bound) + · rw [getElem!_neg array index bound] + exact fallback + +private theorem lookup_first_reserved {functions : Array Function} {members : Array FunIdx} + (valid : FunctionsLookupLayout functions) (nonempty : 0 < functions.size) + (constrained : MembersConstrained functions members) : + 4 ≤ functions[members[0]!]!.layout.lookups := by + refine lookup_array_bang (fun index : FunIdx => 4 ≤ functions[index]!.layout.lookups) + (array := members) ?_ ?_ 0 + · intro index member + obtain ⟨function, present, _⟩ := constrained index member + rw [lookup_bang_of_present present] + have bound := valid function (Array.mem_of_getElem? present) + change function.layout.lookups = 4 + function.body.lookupUsage at bound + omega + · change 4 ≤ functions[0]!.layout.lookups + rw [getElem!_pos functions 0 nonempty] + have bound := valid _ (Array.getElem_mem nonempty) + change functions[0].layout.lookups = 4 + functions[0].body.lookupUsage at bound + omega + +private theorem lookup_merge_fold (functions : Array Function) (first : FunIdx) (members : List FunIdx) + (initial : FunctionLayout) (firstBound : functions[first]!.layout.lookups ≤ initial.lookups) : + let final := members.foldl (fun acc index => if index == first then acc else acc.merge functions[index]!.layout) initial + initial.lookups ≤ final.lookups ∧ ∀ index ∈ members, functions[index]!.layout.lookups ≤ final.lookups := by + induction members generalizing initial with + | nil => exact ⟨Nat.le_refl _, by simp⟩ + | cons index members ih => + let next := if index == first then initial else initial.merge functions[index]!.layout + have before : initial.lookups ≤ next.lookups := by + dsimp only [next] + split + · exact Nat.le_refl _ + · exact Nat.le_max_left _ _ + have here : functions[index]!.layout.lookups ≤ next.lookups := by + dsimp only [next] + split + · rename_i equal + have eq : index = first := beq_iff_eq.mp equal + subst index + exact firstBound + · exact Nat.le_max_right _ _ + have rest := ih next (Nat.le_trans firstBound before) + refine ⟨Nat.le_trans before rest.1, ?_⟩ + intro chosen member + rcases List.mem_cons.mp member with equal | later + · subst chosen; exact Nat.le_trans here rest.1 + · exact rest.2 chosen later + +theorem merged_lookupBound (functions : Array Function) (members : Array FunIdx) + (valid : FunctionsLookupLayout functions) (nonempty : 0 < functions.size) + (constrained : MembersConstrained functions members) : + MembersLookupBound functions members + (members.foldl (init := functions[members[0]!]!.layout) + fun acc index => if index == members[0]! then acc else acc.merge functions[index]!.layout).lookups := by + rw [← Array.foldl_toList] + have folded := lookup_merge_fold functions members[0]! members.toList functions[members[0]!]!.layout + (Nat.le_refl _) + exact ⟨Nat.le_trans (lookup_first_reserved valid nonempty constrained) folded.1, + fun index member => folded.2 index (Array.mem_def.mp member)⟩ + +end Aiur.Bytecode + +namespace Aiur +open Bytecode Std.Do + +private theorem lookup_throw_except {ε α : Type} {error : ε} {post : PostCond α (.except ε .pure)} : + Triple (ps := .except ε .pure) (throw error : Except ε α) (spred(post.2.1 error)) post := by + simp [Triple.iff] + +private theorem lookup_members_empty (functions : Array Function) : MembersConstrained functions #[] := by + simp [MembersConstrained] + +private theorem lookup_members_push {functions : Array Function} {members : Array FunIdx} {index : FunIdx} + (before : MembersConstrained functions members) (constrained : functions[index]!.constrained = true) : + MembersConstrained functions (members.push index) := by + intro i member + rcases Array.mem_push.mp member with prior | equal + · exact before i prior + · subst i + by_cases bound : index < functions.size + · exact ⟨functions[index], Array.getElem?_eq_getElem bound, + by simpa only [getElem!_pos functions index bound] using constrained⟩ + · rw [getElem!_neg functions index bound] at constrained + contradiction + +private theorem lookup_split_member {α : Type} {array : Array α} {pref suff : List α} {value : α} + (split : array.toList = pref ++ value :: suff) : value ∈ array := by + apply Array.mem_toList_iff.mp + rw [split] + simp + +set_option mvcgen.warning false in +theorem CompiledToplevel.groupFunctions_lookupBound {before after : CompiledToplevel} + {groups : Array (String × Array String)} + (functions : FunctionsLookupLayout before.bytecode.functions) + (nonempty : 0 < before.bytecode.functions.size) + (valid : CircuitsLookupBound before.bytecode.functions before.bytecode.circuits) + (accepted : before.groupFunctions groups = .ok after) : + CircuitsLookupBound after.bytecode.functions after.bytecode.circuits := by + have spec : ⦃⌜True⌝⦄ before.groupFunctions groups + ⦃post⟨fun compiled => ⌜CircuitsLookupBound compiled.bytecode.functions compiled.bytecode.circuits⌝, + fun _ => ⌜True⌝⟩⦄ := by + mvcgen [CompiledToplevel.groupFunctions, -Spec.throw_Except, lookup_throw_except] invariants + · post⟨fun ⟨_, _, resolved⟩ => ⌜∀ pair ∈ resolved, + MembersConstrained before.bytecode.functions pair.2⌝, fun _ => ⌜True⌝⟩ + · post⟨fun ⟨_, _, members⟩ => ⌜MembersConstrained before.bytecode.functions members⌝, + fun _ => ⌜True⌝⟩ + · post⟨fun ⟨_, circuits, _⟩ => ⌜CircuitsLookupBound before.bytecode.functions circuits⌝, + fun _ => ⌜True⌝⟩ + case vc4.step.h_1.isTrue.isFalse.isFalse => exact lookup_members_push (by assumption) (by assumption) + case vc7.step.isFalse.pre => exact lookup_members_empty _ + case vc8.step.isFalse.post.success => + intro pair member + rcases Array.mem_push.mp member with prior | equal + · apply_assumption; exact prior + · subst pair; assumption + case vc10.pre => + change ∀ pair ∈ (#[] : Array (String × Array FunIdx)), _ + simp + case vc11.step.isTrue.h_1 => + apply lookup_circuits_push (by assumption) + apply valid + exact lookup_split_member (by assumption) + case vc13.step.isTrue.h_2.isFalse => + apply lookup_circuits_push (by assumption) + apply merged_lookupBound _ _ functions nonempty + exact lookup_array_bang (fun pair : String × Array FunIdx => + MembersConstrained before.bytecode.functions pair.2) (by assumption) (lookup_members_empty _) _ + case vc15.post.success.pre => exact lookup_circuits_empty _ + exact Except.of_wp_eq accepted (fun result => match result with + | .error _ => True + | .ok compiled => CircuitsLookupBound compiled.bytecode.functions compiled.bytecode.circuits) spec + +theorem finishCompilation_lookupBound (source : Source.Toplevel) (raw : Bytecode.Toplevel) + (names : Std.HashMap Global Bytecode.FunIdx) (valid : FunctionsLookupLayout raw.functions) : + CircuitsLookupBound (finishCompilation source raw names).bytecode.functions + (finishCompilation source raw names).bytecode.circuits := by + unfold finishCompilation + apply singletonCircuits_lookupBound + exact finishCompilation_lookupLayout source raw names valid + +theorem Source.Toplevel.compile_lookupBound {source : Source.Toplevel} {compiled : CompiledToplevel} + (accepted : source.compile = .ok compiled) : + CircuitsLookupBound compiled.bytecode.functions compiled.bytecode.circuits := by + obtain ⟨inlined, typed, concrete, raw, names, _, _, _, lowered, artifact⟩ := + source.compile_artifact_of_ok accepted + rw [artifact] + exact finishCompilation_lookupBound inlined raw names (Concrete.Decls.toBytecode_lookupLayout lowered) + +theorem BoundVerifier.Backend.circuits_lookupBound {selection : BoundVerifier.Selection} + (backend : BoundVerifier.Backend selection) : + CircuitsLookupBound backend.compiled.bytecode.functions backend.compiled.bytecode.circuits := by + obtain ⟨initial, compiled, grouped⟩ := backend.compilation_stages + have valid := Source.Toplevel.compile_lookupBound compiled + split at grouped + · cases grouped + exact valid + · have same := (CompiledToplevel.groupFunctions_preserves_code grouped).2.2.1 + have bound := (Array.getElem?_eq_some_iff.mp backend.present).choose + rw [same] at bound + exact CompiledToplevel.groupFunctions_lookupBound + (Source.Toplevel.compile_lookupLayout compiled) (by omega) valid grouped + +end Aiur + +namespace Aiur.AIR +open Bytecode + +theorem CircuitWitness.lookupBounds_of_compiled {program : Toplevel} + (functions : FunctionsLookupLayout program.functions) + (layouts : CircuitsLookupBound program.functions program.circuits) + (witness : CircuitWitness) (circuit : witness.circuit ∈ program.circuits) + (emitted : witness.Emitted program) : witness.LookupBounds := by + obtain ⟨_, indices, source⟩ := witness.circuit.emitRow_spec witness.values program emitted + have bounds := layouts witness.circuit circuit + refine ⟨bounds.1, ?_⟩ + intro part member + have index : part.functionIndex ∈ witness.circuit.members := by + apply Array.mem_toList_iff.mp + rw [← indices] + exact List.mem_map.mpr ⟨part, member, rfl⟩ + have present := (source part member).present + have count := Block.emitRow_lookupUsage witness.values (part.selector witness.values) _ _ _ _ _ + part.function.body (source part member).emitted + have layout := functions part.function (Array.mem_of_getElem? present) + change part.function.layout.lookups = 4 + part.function.body.lookupUsage at layout + have limit := bounds.2 part.functionIndex index + rw [lookup_bang_of_present present] at limit + rw [count, ← layout] + exact limit + +end Aiur.AIR + +namespace Aiur.BoundVerifier +open AIR Bytecode.AIR + +theorem Backend.witness_lookupBounds {selection : Selection} (backend : Backend selection) + (witness : CircuitWitness) (circuit : witness.circuit ∈ backend.compiled.bytecode.circuits) + (emitted : witness.Emitted backend.compiled.bytecode) : witness.LookupBounds := + witness.lookupBounds_of_compiled backend.functions_lookupLayout backend.circuits_lookupBound circuit emitted + +theorem Backend.bounded_trace_execution {selection : Selection} (backend : Backend selection) + (tables : AuxiliaryTables) (traces : CircuitTraces backend.compiled.bytecode.circuits.toList) + {witnesses : List CircuitWitness} + (emitted : traces.emitWitnesses backend.compiled.bytecode = some witnesses) + {otherSlots : List Nat} {otherActive : List Bool} {otherDegrees : List Nat} {result : Nat} + (budget : lookupQueryBound + (backend.compiled.bytecode.circuits.toList.map (·.layout.lookups) ++ otherSlots) + (traces.bitmap ++ otherActive) (traces.degrees ++ otherDegrees) = some result) + (width : Nat) (input : Array G) (arity : input.size = selection.inputSize) + (balanced : PaddedLookupBalance width + ((buildClaim selection.function input selection.success).toList :: + encodedCircuitQueryPool (witnesses.map (·.emission))) + (tables.circuitProviders (witnesses.map (·.emission)))) + (publicWidth : (buildClaim selection.function input selection.success).size + 1 ≤ width) + (queryWidths : ∀ query ∈ encodedCircuitQueryPool (witnesses.map (·.emission)), query.length ≤ width) + (memoryValid : ∀ size, MemoryRowsValid size (tables.memory size)) + (canonical : ∀ size ∈ tables.memoryWidths, size < gSize.toNat) + (satisfied : ∀ witness ∈ witnesses, witness.Satisfied) : + Execution backend.compiled.bytecode (memoryFacts tables.memory) + ⟨selection.function, input, selection.success, 0⟩ := by + have valid := (traces.emitWitnesses_spec emitted).1 + apply backend.compiled_trace_execution tables traces emitted budget width input arity balanced + publicWidth queryWidths memoryValid canonical satisfied + intro witness member + exact backend.witness_lookupBounds witness (by simpa using (valid witness member).1) (valid witness member).2 + +end Aiur.BoundVerifier diff --git a/Ix/Aiur/Proofs/LookupMessages.lean b/Ix/Aiur/Proofs/LookupMessages.lean new file mode 100644 index 000000000..482a07d1f --- /dev/null +++ b/Ix/Aiur/Proofs/LookupMessages.lean @@ -0,0 +1,371 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.ByteLookups + +/-! +Exact lookup messages from their zero-padded representations. + +The first two fields determine message length through the native channel +and function-arity schema. Padding is then injective, and exact balance +passes through padding and channel filtering. Zero-weight providers may +contain arbitrary data. Function and memory encodings recover the typed +messages used by execution and memory-table proofs. + +These results do not extract padded balance from the cryptographic verifier. +Connecting all native active rows to the function-arity schema is also an +obligation; an arbitrary bytecode program need not have uniform returns. +-/ + +namespace Aiur.AIR + +def padMessage (width : Nat) (message : List G) : List G := + List.ofFn fun i : Fin width => message[i.val]?.getD 0 + +theorem padMessage_length (width : Nat) (message : List G) : + (padMessage width message).length = width := List.length_ofFn + +theorem padMessage_read {width : Nat} (message : List G) (i : Nat) (hi : i < width) : + (padMessage width message)[i]?.getD 0 = message[i]?.getD 0 := by + simp only [padMessage, List.getElem?_ofFn, dif_pos hi, Option.getD_some] + +theorem padMessage_injective_of_length {width : Nat} {left right : List G} + (bounded : left.length ≤ width) (lengths : left.length = right.length) + (same : padMessage width left = padMessage width right) : left = right := by + apply List.ext_getElem lengths + intro i hi hj + have equal := congrArg (fun message => message[i]?.getD 0) same + rw [padMessage_read left i (by omega), padMessage_read right i (by omega)] at equal + simpa only [List.getElem?_eq_getElem hi, List.getElem?_eq_getElem hj, + Option.getD_some] using equal + +/-- The message length is determined by its first two entries. -/ +def HasMessageShape (widths : G → G → Nat) (message : List G) : Prop := + 2 ≤ message.length ∧ message.length = widths (message[0]?.getD 0) (message[1]?.getD 0) + +theorem padMessage_injective_of_shape {width : Nat} {widths : G → G → Nat} + {left right : List G} (leftShape : HasMessageShape widths left) + (rightShape : HasMessageShape widths right) (bounded : left.length ≤ width) + (same : padMessage width left = padMessage width right) : left = right := by + have minimum := leftShape.1 + have first := congrArg (fun message => message[0]?.getD 0) same + have second := congrArg (fun message => message[1]?.getD 0) same + rw [padMessage_read left 0 (by omega), padMessage_read right 0 (by omega)] at first + rw [padMessage_read left 1 (by omega), padMessage_read right 1 (by omega)] at second + apply padMessage_injective_of_length bounded _ same + rw [leftShape.2, rightShape.2, first, second] + +def mapProviders (encode : α → β) (providers : List (Provider α)) : List (Provider β) := + providers.map fun provider => (encode provider.1, provider.2) + +theorem count_map_of_matching [DecidableEq α] [DecidableEq β] + (encode : α → β) (message : α) (queries : List α) + (matching : ∀ query ∈ queries, encode query = encode message ↔ query = message) : + (queries.map encode).count (encode message) = queries.count message := by + induction queries with + | nil => rfl + | cons query queries ih => + have head := matching query List.mem_cons_self + have tail := ih (fun value member => matching value (List.mem_cons_of_mem query member)) + simp only [List.map_cons, List.count_cons, beq_iff_eq, head, tail] + +theorem suppliedWeight_map_of_matching [DecidableEq α] [DecidableEq β] + (encode : α → β) (message : α) (providers : List (Provider α)) + (matching : ∀ provider ∈ providers, + provider.2 ≠ 0 → (encode provider.1 = encode message ↔ provider.1 = message)) : + suppliedWeight (encode message) (mapProviders encode providers) = + suppliedWeight message providers := by + induction providers with + | nil => rfl + | cons provider providers ih => + have tail := ih (fun value member => matching value (List.mem_cons_of_mem provider member)) + change (if encode provider.1 = encode message then + provider.2 + suppliedWeight (encode message) (mapProviders encode providers) + else suppliedWeight (encode message) (mapProviders encode providers)) = + (if provider.1 = message then provider.2 + suppliedWeight message providers + else suppliedWeight message providers) + by_cases zero : provider.2 = 0 + · simp only [zero, G.zero_add, ite_self, tail] + · have head := matching provider List.mem_cons_self zero + simp only [head, tail] + +theorem suppliedWeight_eq_zero_of_absent [DecidableEq α] (message : α) + (providers : List (Provider α)) + (absent : ∀ provider ∈ providers, provider.2 ≠ 0 → provider.1 ≠ message) : + suppliedWeight message providers = 0 := by + induction providers with + | nil => rfl + | cons provider providers ih => + have tail := ih (fun value member => absent value (List.mem_cons_of_mem provider member)) + change (if provider.1 = message then provider.2 + suppliedWeight message providers + else suppliedWeight message providers) = 0 + by_cases zero : provider.2 = 0 + · simpa only [zero, G.zero_add, ite_self] using tail + · have head := absent provider List.mem_cons_self zero + simpa only [if_neg head] using tail + +theorem exactLookupBalance_of_injective_on [DecidableEq α] [DecidableEq β] + (encode : α → β) (admissible : α → Prop) + (injective : ∀ {left right}, admissible left → admissible right → + encode left = encode right → left = right) + {queries : List α} {providers : List (Provider α)} + (queriesAdmissible : ∀ query ∈ queries, admissible query) + (providersAdmissible : ∀ provider ∈ providers, provider.2 ≠ 0 → admissible provider.1) + (balanced : ExactLookupBalance (queries.map encode) (mapProviders encode providers)) : + ExactLookupBalance queries providers := by + intro message + by_cases valid : admissible message + · have queryMatching : ∀ query ∈ queries, + encode query = encode message ↔ query = message := by + intro query member + exact ⟨injective (queriesAdmissible query member) valid, congrArg encode⟩ + have providerMatching : ∀ provider ∈ providers, + provider.2 ≠ 0 → (encode provider.1 = encode message ↔ provider.1 = message) := by + intro provider member nonzero + exact ⟨injective (providersAdmissible provider member nonzero) valid, congrArg encode⟩ + have result := balanced (encode message) + rw [count_map_of_matching encode message queries queryMatching, + suppliedWeight_map_of_matching encode message providers providerMatching] at result + exact result + · have absent : message ∉ queries := fun member => valid (queriesAdmissible message member) + rw [List.count_eq_zero.mpr absent, suppliedWeight_eq_zero_of_absent message providers] + · rfl + · intro provider member nonzero equal + exact valid (equal ▸ providersAdmissible provider member nonzero) + +theorem suppliedWeight_filter [DecidableEq α] (keep : α → Bool) (message : α) + (providers : List (Provider α)) : + suppliedWeight message (providers.filter fun provider => keep provider.1) = + if keep message then suppliedWeight message providers else 0 := by + induction providers with + | nil => simp only [suppliedWeight, List.filter_nil, List.foldr_nil, ite_self] + | cons provider providers ih => + by_cases same : provider.1 = message + · by_cases retained : keep message = true + · simp only [List.filter_cons, same, retained, ↓reduceIte, suppliedWeight, List.foldr_cons] at * + rw [ih] + · have dropped : keep message = false := Bool.eq_false_iff.mpr retained + simp only [List.filter_cons, same, dropped, Bool.false_eq_true, ↓reduceIte] + simpa only [dropped, Bool.false_eq_true, ↓reduceIte] using ih + · by_cases retained : keep provider.1 = true + · simp only [List.filter_cons, retained, ↓reduceIte, suppliedWeight, + List.foldr_cons, if_neg same] at * + exact ih + · have dropped : keep provider.1 = false := Bool.eq_false_iff.mpr retained + simp only [List.filter_cons, dropped, Bool.false_eq_true, ↓reduceIte] + simpa only [suppliedWeight, List.foldr_cons, if_neg same] using ih + +/-- Restrict global exact balance to any collection of message channels. -/ +theorem ExactLookupBalance.filter [DecidableEq α] {queries : List α} + {providers : List (Provider α)} (balanced : ExactLookupBalance queries providers) + (keep : α → Bool) : + ExactLookupBalance (queries.filter keep) (providers.filter fun provider => keep provider.1) := by + intro message + rw [suppliedWeight_filter] + by_cases retained : keep message = true + · rw [if_pos retained, List.count_filter retained, balanced] + · rw [if_neg retained] + have absent : message ∉ queries.filter keep := fun member => + retained (List.mem_filter.mp member).2 + rw [List.count_eq_zero.mpr absent] + rfl + +def PaddedLookupBalance (width : Nat) (queries : List (List G)) + (providers : List (Provider (List G))) : Prop := + ExactLookupBalance (queries.map (padMessage width)) (mapProviders (padMessage width) providers) + +/-- A bounded query has a nonzero provider with the same padded message. +No message-shape hypothesis is needed for this first extraction step. -/ +theorem paddedLookupBalance_provider {width : Nat} {queries : List (List G)} + {providers : List (Provider (List G))} (balanced : PaddedLookupBalance width queries providers) + (bounded : queries.length < gSize.toNat) {message : List G} (queried : message ∈ queries) : + ∃ provider ∈ providers, padMessage width provider.1 = padMessage width message ∧ provider.2 ≠ 0 := by + obtain ⟨provider, member, same, nonzero⟩ := exactLookupBalance_provider balanced + (by simpa only [List.length_map] using bounded) (List.mem_map.mpr ⟨message, queried, rfl⟩) + obtain ⟨original, originalMember, equal⟩ := List.mem_map.mp member + subst provider + exact ⟨original, originalMember, same, nonzero⟩ + +theorem paddedLookupBalance_exact {width : Nat} (widths : G → G → Nat) + {queries : List (List G)} {providers : List (Provider (List G))} + (queryShapes : ∀ query ∈ queries, HasMessageShape widths query ∧ query.length ≤ width) + (providerShapes : ∀ provider ∈ providers, provider.2 ≠ 0 → + HasMessageShape widths provider.1 ∧ provider.1.length ≤ width) + (balanced : PaddedLookupBalance width queries providers) : + ExactLookupBalance queries providers := by + apply exactLookupBalance_of_injective_on (padMessage width) + (fun message => HasMessageShape widths message ∧ message.length ≤ width) _ + queryShapes providerShapes balanced + intro left right hl hr same + exact padMessage_injective_of_shape hl.1 hr.1 hl.2 same + +/-- Input and output widths for each function index. -/ +abbrev FunctionArities := Nat → Nat × Nat + +def functionMessage (request : Bytecode.AIR.Call) : List G := + 0 :: G.ofNat request.function :: + (request.inputs.toList ++ request.outputs.toList ++ [request.rank]) + +def memoryMessage (width : Nat) (pointer : G) (contents : Array G) : List G := + 1 :: G.ofNat width :: pointer :: contents.toList + +def Byte1Kind.outputSize : Byte1Kind → Nat + | .bits => 8 + | .shiftLeft | .shiftRight => 1 + +def Byte2Kind.outputSize : Byte2Kind → Nat + | .range => 0 + | .mul | .split7 | .split4 => 2 + | _ => 1 + +/-- Length of a native message, determined by its channel and second field. +Function messages include the final call-order rank. -/ +def lookupMessageWidth (arities : FunctionArities) (channel key : G) : Nat := + match channel.n with + | 0 => 3 + (arities key.n).1 + (arities key.n).2 + | 1 => 3 + key.n + | 2 => 10 + | 3 | 4 => 3 + | 5 | 6 | 7 | 8 | 9 | 10 => 4 + | 11 => 3 + | 12 | 13 | 14 => 5 + | _ => 0 + +def FunctionMessageValid (arities : FunctionArities) (request : Bytecode.AIR.Call) : Prop := + request.function < gSize.toNat ∧ + request.inputs.size = (arities request.function).1 ∧ + request.outputs.size = (arities request.function).2 + +theorem functionMessage_shape (arities : FunctionArities) (request : Bytecode.AIR.Call) + (valid : FunctionMessageValid arities request) : + HasMessageShape (lookupMessageWidth arities) (functionMessage request) := by + obtain ⟨indexBound, inputs, outputs⟩ := valid + simp only [HasMessageShape, functionMessage, List.length_cons, List.length_append, + List.length_nil, Array.length_toList, List.getElem?_cons_zero, + List.getElem?_cons_succ, Option.getD_some, lookupMessageWidth, G.n_ofNat, + Nat.mod_eq_of_lt indexBound] + change _ ∧ _ = 3 + (arities request.function).1 + (arities request.function).2 + omega + +theorem memoryMessage_shape (arities : FunctionArities) (width : Nat) + (pointer : G) (contents : Array G) (bounded : width < gSize.toNat) + (sized : contents.size = width) : + HasMessageShape (lookupMessageWidth arities) (memoryMessage width pointer contents) := by + simp only [HasMessageShape, memoryMessage, List.length_cons, Array.length_toList, + List.getElem?_cons_zero, List.getElem?_cons_succ, Option.getD_some, + lookupMessageWidth, G.n_ofNat, Nat.mod_eq_of_lt bounded] + change _ ∧ _ = 3 + width + omega + +theorem byte1Request_shape (arities : FunctionArities) (kind : Byte1Kind) (input : G) + (outputs : Array G) (sized : outputs.size = kind.outputSize) : + HasMessageShape (lookupMessageWidth arities) (byte1Request kind input outputs) := by + cases kind <;> + simp only [Byte1Kind.outputSize] at sized <;> + simp only [HasMessageShape, byte1Request, List.length_cons, Array.length_toList, + List.getElem?_cons_zero, List.getElem?_cons_succ, Option.getD_some, + lookupMessageWidth, Byte1Kind.channel, sized] <;> exact ⟨by decide +kernel, rfl⟩ + +theorem byte2Request_shape (arities : FunctionArities) (kind : Byte2Kind) (x y : G) + (outputs : Array G) (sized : outputs.size = kind.outputSize) : + HasMessageShape (lookupMessageWidth arities) (byte2Request kind x y outputs) := by + cases kind <;> + simp only [Byte2Kind.outputSize] at sized <;> + simp only [HasMessageShape, byte2Request, List.length_cons, Array.length_toList, + List.getElem?_cons_zero, List.getElem?_cons_succ, Option.getD_some, + lookupMessageWidth, Byte2Kind.channel, sized] <;> exact ⟨by decide +kernel, rfl⟩ + +theorem byte1Outputs_size (kind : Byte1Kind) (row : Fin 256) : + (byte1Outputs kind row).size = kind.outputSize := by + cases kind <;> simp only [byte1Outputs, Byte1Kind.outputSize, Array.size_ofFn, + List.size_toArray, List.length_cons, List.length_nil] + +theorem byte2Outputs_size (kind : Byte2Kind) (row : Fin 65536) : + (byte2Outputs kind row).size = kind.outputSize := by + cases kind <;> simp only [byte2Outputs, Byte2Kind.outputSize, + List.size_toArray, List.length_cons, List.length_nil] + +theorem functionMessage_injective {arities : FunctionArities} + {left right : Bytecode.AIR.Call} + (validLeft : FunctionMessageValid arities left) + (validRight : FunctionMessageValid arities right) + (same : functionMessage left = functionMessage right) : left = right := by + obtain ⟨lf, li, lo, lr⟩ := left + obtain ⟨rf, ri, ro, rr⟩ := right + obtain ⟨lb, lis, los⟩ := validLeft + obtain ⟨rb, ris, ros⟩ := validRight + obtain ⟨index, values⟩ := List.cons.inj (List.cons.inj same).2 + have index := G.ofNat_injective_below lb rb index + change lf = rf at index + subst rf + have inputSize : li.toList.length = ri.toList.length := by + simp only [Array.length_toList] + exact lis.trans ris.symm + change (li.toList ++ lo.toList) ++ [lr] = (ri.toList ++ ro.toList) ++ [rr] at values + obtain ⟨data, rank⟩ := List.append_inj' values rfl + obtain ⟨input, output⟩ := List.append_inj data inputSize + have input := Array.toList_inj.mp input + have output := Array.toList_inj.mp output + have rank := (List.cons.inj rank).1 + subst ri + subst ro + subst rr + rfl + +theorem exactLookupBalance_functionMessages (arities : FunctionArities) + {queries : List Bytecode.AIR.Call} {providers : List (Provider Bytecode.AIR.Call)} + (queryShapes : ∀ query ∈ queries, FunctionMessageValid arities query) + (providerShapes : ∀ provider ∈ providers, provider.2 ≠ 0 → + FunctionMessageValid arities provider.1) + (balanced : ExactLookupBalance (queries.map functionMessage) (mapProviders functionMessage providers)) : + ExactLookupBalance queries providers := + exactLookupBalance_of_injective_on functionMessage (FunctionMessageValid arities) + (fun left right same => functionMessage_injective left right same) + queryShapes providerShapes balanced + +theorem memoryMessage_injective {width : Nat} {left right : G × Array G} + (same : memoryMessage width left.1 left.2 = memoryMessage width right.1 right.2) : + left = right := by + obtain ⟨pointer, contents⟩ := List.cons.inj (List.cons.inj (List.cons.inj same).2).2 + exact Prod.ext pointer (Array.toList_inj.mp contents) + +theorem exactLookupBalance_memoryMessages (width : Nat) + {queries : List (G × Array G)} {providers : List (Provider (G × Array G))} + (balanced : ExactLookupBalance (queries.map fun request => memoryMessage width request.1 request.2) + (mapProviders (fun request => memoryMessage width request.1 request.2) providers)) : + ExactLookupBalance queries providers := + exactLookupBalance_of_injective_on (fun request => memoryMessage width request.1 request.2) + (fun _ => True) (fun _ _ same => memoryMessage_injective same) + (fun _ _ => True.intro) (fun _ _ _ => True.intro) balanced + +/-- Root messages omit the final rank field; appending its fixed zero does +not change any padded lookup message. -/ +theorem padMessage_append_zero {width : Nat} (message : List G) : + padMessage width (message ++ [0]) = padMessage width message := by + apply congrArg List.ofFn + funext i + by_cases inside : i.val < message.length + · simp only [List.getElem?_append_left inside] + · rw [List.getElem?_append_right (by omega)] + have outside : message[i.val]? = none := List.getElem?_eq_none (by omega) + rw [outside, Option.getD_none] + by_cases last : i.val = message.length + · simp only [last, Nat.sub_self, List.getElem?_cons_zero, Option.getD_some] + · rw [List.getElem?_eq_none (by simp only [List.length_cons, List.length_nil]; omega)] + rfl + +/-- Without an output-arity check, the last output of one request can be +the rank of a shorter return. This holds at every padding width. -/ +theorem functionMessage_rank_alias (width : Nat) : + let output : Bytecode.AIR.Call := ⟨0, #[], #[7], 0⟩ + let rank : Bytecode.AIR.Call := ⟨0, #[], #[], 7⟩ + output ≠ rank ∧ padMessage width (functionMessage output) = + padMessage width (functionMessage rank) := by + constructor + · decide +kernel + · change padMessage width ([0, 0, 7] ++ [0]) = padMessage width [0, 0, 7] + exact padMessage_append_zero _ + +end Aiur.AIR diff --git a/Ix/Aiur/Proofs/LookupShapes.lean b/Ix/Aiur/Proofs/LookupShapes.lean new file mode 100644 index 000000000..c54900191 --- /dev/null +++ b/Ix/Aiur/Proofs/LookupShapes.lean @@ -0,0 +1,264 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.LookupShapes +import Ix.Aiur.Semantics.AIR +import Ix.Aiur.BoundVerifier +import Ix.Aiur.Proofs.CallOrder + +/-! A checked return-arity validator implies the output size of every AIR +execution, including early returns and match continuations. -/ + +namespace Aiur.Bytecode + +theorem returnsHaveSize_match (size : Nat) (index : ValIdx) (branches : Array (G × Block)) + (fallback : Option Block) : + (Ctrl.match index branches fallback).returnsHaveSize size = true ↔ + (∀ pair ∈ branches.toList, pair.2.returnsHaveSize size = true) ∧ + (∀ block, fallback = some block → block.returnsHaveSize size = true) := by + rw [Ctrl.returnsHaveSize.eq_def] + simp only [Bool.and_eq_true, Array.all_eq_true', + Array.mem_attach, forall_const, Subtype.forall] + cases fallback <;> simp + +theorem returnsHaveSize_matchContinue (size : Nat) (index : ValIdx) + (branches : Array (G × Block)) (fallback : Option Block) + (outputs aux lookups : Nat) (continuation : Block) : + (Ctrl.matchContinue index branches fallback outputs aux lookups continuation).returnsHaveSize size = true ↔ + (∀ pair ∈ branches.toList, pair.2.returnsHaveSize size = true) ∧ + (∀ block, fallback = some block → block.returnsHaveSize size = true) ∧ + continuation.returnsHaveSize size = true := by + rw [Ctrl.returnsHaveSize.eq_def] + simp only [Bool.and_eq_true, Array.all_eq_true', + Array.mem_attach, forall_const, Subtype.forall] + cases fallback <;> simp + +namespace AIR + +/-- A function query uses the input and return boundaries of its selected +callee. Returnless functions satisfy the last check vacuously; they still +need a finite execution before they can provide a return. -/ +def Call.LookupShape (program : Toplevel) (request : Call) : Prop := + ∃ callee, program.functions[request.function]? = some callee ∧ + callee.constrained = true ∧ callee.layout.inputSize = request.inputs.size ∧ + callee.body.returnsHaveSize request.outputs.size = true + +theorem list_mapM_some_length (f : α → Option β) (inputs : List α) (outputs : List β) + (result : inputs.mapM f = some outputs) : outputs.length = inputs.length := by + induction inputs generalizing outputs with + | nil => simp only [List.mapM_nil, pure, Option.some.injEq] at result + subst outputs; rfl + | cons input inputs ih => + simp only [List.mapM_cons, bind, Option.bind, pure] at result + cases head : f input with + | none => simp only [head, reduceCtorEq] at result + | some output => + cases tail : inputs.mapM f with + | none => simp only [head, tail, reduceCtorEq] at result + | some rest => + simp only [head, tail, Option.some.injEq] at result + subst outputs + simp only [List.length_cons, ih rest tail] + +theorem readValues_size {values : Array G} {indices : Array ValIdx} {outputs : Array G} + (read : readValues values indices = some outputs) : outputs.size = indices.size := by + have listResult := congrArg (Functor.map Array.toList) read + rw [readValues, Array.toList_mapM] at listResult + have sizes := list_mapM_some_length (fun index => values[index]?) indices.toList outputs.toList listResult + simpa only [Array.length_toList] using sizes + +theorem SelectArm.returnsHaveSize {scrutinee : G} {branches : Array (G × Block)} + {fallback : Option Block} {arm : Block} (selected : SelectArm scrutinee branches fallback arm) + (size : Nat) (casesValid : ∀ pair ∈ branches.toList, pair.2.returnsHaveSize size = true) + (fallbackValid : ∀ block, fallback = some block → block.returnsHaveSize size = true) : + arm.returnsHaveSize size = true := by + cases selected with + | case member => exact casesValid _ member + | fallback present unmatched => exact fallbackValid _ present + +def Outcome.ReturnSize (outcome : Outcome) (size : Nat) : Prop := + match outcome with + | .returned outputs => outputs.size = size + | .yielded _ => True + +theorem RunBlock.return_size {memory : Memory} {block : Block} {values : Array G} + {outcome : Outcome} {calls : List Call} (execution : RunBlock memory block values outcome calls) + (size : Nat) (valid : block.returnsHaveSize size = true) : outcome.ReturnSize size := by + revert valid + induction execution using RunBlock.rec + (motive_2 := fun ctrl _ outcome _ _ => ctrl.returnsHaveSize size = true → outcome.ReturnSize size) with + | block operations control ih => + intro valid + apply ih + simpa only [Block.returnsHaveSize] using valid + | returned result valid => + rw [Ctrl.returnsHaveSize] at valid + have sized : _ = size := beq_iff_eq.mp valid + exact (readValues_size result).trans sized + | yielded result valid => exact True.intro + | «match» value selected branch ih valid => + obtain ⟨casesValid, fallbackValid⟩ := (returnsHaveSize_match _ _ _ _).mp valid + exact ih (selected.returnsHaveSize size casesValid fallbackValid) + | matchContinueReturn value selected branch ih valid => + obtain ⟨casesValid, fallbackValid, _⟩ := (returnsHaveSize_matchContinue _ _ _ _ _ _ _ _).mp valid + exact ih (selected.returnsHaveSize size casesValid fallbackValid) + | matchContinueYield value selected branch outputSize continued ihBranch ihCont valid => + obtain ⟨_, _, contValid⟩ := (returnsHaveSize_matchContinue _ _ _ _ _ _ _ _).mp valid + exact ihCont contValid + +theorem RunFunction.return_size {program : Toplevel} {memory : Memory} + {request : Call} {calls : List Call} (execution : RunFunction program memory request calls) + {callee : Function} (present : program.functions[request.function]? = some callee) + (size : Nat) (valid : callee.body.returnsHaveSize size = true) : request.outputs.size = size := by + cases execution with + | function selected arity body => + have same := Option.some.inj (selected.symm.trans present) + subst callee + exact body.return_size size valid + +theorem Step.calls_lookupShape {program : Toplevel} {memory : Memory} {op : Op} + {values outputs : Array G} {calls : List Call} (execution : Step memory op values outputs calls) + (valid : op.lookupShape program = true) : ∀ request ∈ calls, request.LookupShape program := by + intro request member + cases execution with + | primitive evaluated => cases member + | call arguments outputSize => + have same := List.mem_singleton.mp member + subst request + simp only [Op.lookupShape] at valid + split at valid + · cases valid + · rename_i callee present + obtain ⟨constrained, inputSize, returnSize⟩ := + (show _ ∧ _ ∧ _ from by simpa only [Bool.and_eq_true, beq_iff_eq] using valid) + refine ⟨callee, present, constrained, ?_, ?_⟩ + · exact inputSize.trans (readValues_size arguments).symm + · simpa only [outputSize] using returnSize + | store arguments stored => cases member + | load address width loaded => cases member + +theorem RunOps.calls_lookupShape {program : Toplevel} {memory : Memory} {ops : List Op} + {values outputs : Array G} {calls : List Call} (execution : RunOps memory ops values outputs calls) + (valid : ∀ op ∈ ops, op.lookupShape program = true) : + ∀ request ∈ calls, request.LookupShape program := by + induction execution with + | nil => intro request member; cases member + | @cons op ops values intermediate firstCalls finalValues restCalls first rest ih => + intro request member + rcases List.mem_append.mp member with firstMember | restMember + · exact first.calls_lookupShape (valid op List.mem_cons_self) request firstMember + · exact ih (fun op member => valid op (List.mem_cons_of_mem _ member)) request restMember + +end AIR + +theorem lookupShapes_match (program : Toplevel) (yieldSize : Option Nat) + (index : ValIdx) (branches : Array (G × Block)) (fallback : Option Block) : + (Ctrl.match index branches fallback).lookupShapes program yieldSize = true ↔ + (∀ pair ∈ branches.toList, pair.2.lookupShapes program yieldSize = true) ∧ + (∀ block, fallback = some block → block.lookupShapes program yieldSize = true) := by + rw [Ctrl.lookupShapes.eq_def] + simp only [Bool.and_eq_true, Array.all_eq_true', + Array.mem_attach, forall_const, Subtype.forall] + cases fallback <;> simp + +theorem lookupShapes_matchContinue (program : Toplevel) (yieldSize : Option Nat) + (index : ValIdx) (branches : Array (G × Block)) (fallback : Option Block) + (outputs aux lookups : Nat) (continuation : Block) : + (Ctrl.matchContinue index branches fallback outputs aux lookups continuation).lookupShapes program yieldSize = true ↔ + (∀ pair ∈ branches.toList, pair.2.lookupShapes program (some outputs) = true) ∧ + (∀ block, fallback = some block → block.lookupShapes program (some outputs) = true) ∧ + continuation.lookupShapes program yieldSize = true := by + rw [Ctrl.lookupShapes.eq_def] + simp only [Bool.and_eq_true, Array.all_eq_true', + Array.mem_attach, forall_const, Subtype.forall] + cases fallback <;> simp + +namespace AIR + +theorem SelectArm.lookupShapes {scrutinee : G} {branches : Array (G × Block)} + {fallback : Option Block} {arm : Block} (selected : SelectArm scrutinee branches fallback arm) + (program : Toplevel) (yieldSize : Option Nat) + (casesValid : ∀ pair ∈ branches.toList, pair.2.lookupShapes program yieldSize = true) + (fallbackValid : ∀ block, fallback = some block → block.lookupShapes program yieldSize = true) : + arm.lookupShapes program yieldSize = true := by + cases selected with + | case member => exact casesValid _ member + | fallback present unmatched => exact fallbackValid _ present + +theorem RunBlock.calls_lookupShape {program : Toplevel} {memory : Memory} {block : Block} + {values : Array G} {outcome : Outcome} {calls : List Call} + (execution : RunBlock memory block values outcome calls) + (yieldSize : Option Nat) (valid : block.lookupShapes program yieldSize = true) : + ∀ request ∈ calls, request.LookupShape program := by + revert yieldSize valid + induction execution using RunBlock.rec + (motive_2 := fun ctrl _ _ calls _ => ∀ yieldSize, + ctrl.lookupShapes program yieldSize = true → + ∀ request ∈ calls, request.LookupShape program) with + | block operations control ih => + intro yieldSize valid request member + obtain ⟨opsValid, ctrlValid⟩ := (show _ ∧ _ from by + simpa only [Block.lookupShapes, Bool.and_eq_true] using valid) + rcases List.mem_append.mp member with first | last + · apply operations.calls_lookupShape _ request first + simpa only [Array.all_eq_true', Array.mem_def] using opsValid + · exact ih yieldSize ctrlValid request last + | returned result yieldSize valid request member => cases member + | yielded result yieldSize valid request member => cases member + | «match» value selected branch ih yieldSize valid request member => + obtain ⟨casesValid, fallbackValid⟩ := (lookupShapes_match _ _ _ _ _).mp valid + exact ih yieldSize (selected.lookupShapes program yieldSize casesValid fallbackValid) request member + | matchContinueReturn value selected branch ih yieldSize valid request member => + obtain ⟨casesValid, fallbackValid, _⟩ := (lookupShapes_matchContinue _ _ _ _ _ _ _ _ _).mp valid + exact ih _ (selected.lookupShapes program _ casesValid fallbackValid) request member + | matchContinueYield value selected branch outputSize continued ihBranch ihCont yieldSize valid request member => + obtain ⟨casesValid, fallbackValid, contValid⟩ := (lookupShapes_matchContinue _ _ _ _ _ _ _ _ _).mp valid + rcases List.mem_append.mp member with first | last + · exact ihBranch _ (selected.lookupShapes program _ casesValid fallbackValid) request first + · exact ihCont yieldSize contValid request last + +theorem RunFunction.calls_lookupShape {program : Toplevel} {memory : Memory} + {request : Call} {calls : List Call} (execution : RunFunction program memory request calls) + (valid : program.validateLookupShapes = true) + {callee : Function} (present : program.functions[request.function]? = some callee) + (constrained : callee.constrained = true) : + ∀ child ∈ calls, child.LookupShape program := by + simp only [Toplevel.validateLookupShapes, Bool.and_eq_true] at valid + have functionsValid := valid.2.2 + have member : callee ∈ program.functions := Array.mem_of_getElem? present + have bodyValid := Array.all_eq_true'.mp functionsValid callee member + simp only [constrained, Bool.not_true, Bool.false_or] at bodyValid + cases execution with + | function selected arity body => + have same := Option.some.inj (selected.symm.trans present) + subst callee + exact body.calls_lookupShape none bodyValid + +end AIR +end Aiur.Bytecode + +namespace Aiur.BoundVerifier + +theorem Backend.air_return_size {selection : Selection} (backend : Backend selection) + {memory : Bytecode.AIR.Memory} {request : Bytecode.AIR.Call} + {calls : List Bytecode.AIR.Call} + (execution : Bytecode.AIR.RunFunction backend.compiled.bytecode memory request calls) + (selected : request.function = selection.function) : + request.outputs.size = selection.success.size := by + apply execution.return_size (callee := backend.entry) _ _ backend.returnArity + simpa only [selected] using backend.present + +theorem Backend.claim_shape {selection : Selection} (backend : Backend selection) + (input : Array G) (arity : input.size = selection.inputSize) : + backend.compiled.bytecode.validClaimShape + (buildClaim selection.function input selection.success) = true := by + simp only [Bytecode.Toplevel.validClaimShape, buildClaim, Array.toList_append, + List.cons_append, List.nil_append, G.n_ofNat, + Nat.mod_eq_of_lt backend.functionRange, backend.present, backend.publicEntry, + backend.constrained, functionChannel, Bool.true_and, Bool.and_true, List.length_append, + Array.length_toList, backend.arity, arity, Nat.add_sub_cancel_left, backend.returnArity] + exact decide_eq_true (by omega) + +end Aiur.BoundVerifier diff --git a/Ix/Aiur/Proofs/Memory.lean b/Ix/Aiur/Proofs/Memory.lean new file mode 100644 index 000000000..369fdc836 --- /dev/null +++ b/Ix/Aiur/Proofs/Memory.lean @@ -0,0 +1,236 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Semantics.AIR +import Ix.Aiur.Proofs.Lookup + +/-! +Immutable memory facts from incrementing memory tables and exact balance. + +The native memory AIR has no first-pointer-zero constraint. Active rows form +a prefix and their pointers increment in the field; an arbitrary initial +pointer and wraparound are permitted. A trace-height bound below the field +characteristic suffices to make these pointers distinct. A separate bound +on query counts prevents modular cancellation in the lookup argument. + +The local polynomial and exact-message interfaces below still require +extraction from the native proof system. Contents need not be injectively +stored, acyclic, or created by earlier runtime operations. These theorems +establish functionality at a fixed width and pointer, not refinement to the +reference evaluator's insertion-order memory. +-/ + +namespace Aiur + +theorem G.ext_n {a b : G} (equal : a.n = b.n) : a = b := + Subtype.ext (UInt64.toNat_inj.mp equal) + +theorem G.add_zero (a : G) : a + 0 = a := by + change G.ofNat (a.n + 0) = a + simpa only [Nat.add_zero] using G.ofNat_n a + +theorem G.ofNat_add (a b : Nat) : G.ofNat (a + b) = G.ofNat a + G.ofNat b := by + apply G.ext_n + simp only [G.n_ofNat, G.n_add, Nat.add_mod, Nat.mod_mod] + +theorem G.add_assoc (a b c : G) : (a + b) + c = a + (b + c) := by + apply G.ext_n + simp only [G.n_add, Nat.mod_add_mod, Nat.add_mod_mod, Nat.add_assoc] + +theorem G.add_left_cancel (a : G) {b c : G} (equal : a + b = a + c) : b = c := by + have ha : a.n < gSize.toNat := UInt64.lt_iff_toNat_lt.mp a.property + have hb : b.n < gSize.toNat := UInt64.lt_iff_toNat_lt.mp b.property + have hc : c.n < gSize.toNat := UInt64.lt_iff_toNat_lt.mp c.property + have equal := congrArg G.n equal + simp only [G.n_add] at equal + apply G.ext_n + have modulus : gSize.toNat = 18446744069414584321 := by decide + rw [modulus] at ha hb hc equal + omega + +theorem G.ofNat_injective_below {a b : Nat} (ha : a < gSize.toNat) + (hb : b < gSize.toNat) (equal : G.ofNat a = G.ofNat b) : a = b := by + have equal := congrArg G.n equal + simpa only [G.n_ofNat, Nat.mod_eq_of_lt ha, Nat.mod_eq_of_lt hb] using equal + +namespace AIR + +/-- Columns of a memory row; the table fixes the contents width. -/ +structure MemoryRow where + selector : G + multiplicity : G + pointer : G + contents : Array G + +/-- Interior transition polynomial: an active successor requires an active row. -/ +def memoryActivityTransition (row next : MemoryRow) : G := + next.selector * (row.selector - 1) + +/-- Interior transition polynomial for the incrementing pointer column. -/ +def memoryPointerTransition (row next : MemoryRow) : G := + next.selector * (row.pointer + 1 - next.pointer) + +/-- Local memory constraints after decoding boolean selectors. The last row +has no successor constraint, matching the native transition selector. -/ +structure MemoryRowsValid (width : Nat) (rows : Array MemoryRow) : Prop where + selectors : ∀ i (hi : i < rows.size), rows[i].selector = 0 ∨ rows[i].selector = 1 + activity : ∀ i (hi : i < rows.size), activityConstraint rows[i].multiplicity rows[i].selector = 0 + widths : ∀ i (hi : i < rows.size), rows[i].contents.size = width + activityTransition : ∀ i (hi : i + 1 < rows.size), + memoryActivityTransition (rows[i]'(by omega)) rows[i + 1] = 0 + pointerTransition : ∀ i (hi : i + 1 < rows.size), + memoryPointerTransition (rows[i]'(by omega)) rows[i + 1] = 0 + +theorem MemoryRowsValid.previous_active {width : Nat} {rows : Array MemoryRow} + (valid : MemoryRowsValid width rows) (i : Nat) (hi : i + 1 < rows.size) + (active : rows[i + 1].selector = 1) : (rows[i]'(by omega)).selector = 1 := by + have satisfied := valid.activityTransition i hi + unfold memoryActivityTransition at satisfied + rw [active, G.mul_comm, G.mul_one] at satisfied + exact (G.sub_eq_zero_iff (rows[i]'(by omega)).selector 1).mp satisfied + +theorem MemoryRowsValid.next_pointer {width : Nat} {rows : Array MemoryRow} + (valid : MemoryRowsValid width rows) (i : Nat) (hi : i + 1 < rows.size) + (active : rows[i + 1].selector = 1) : + rows[i + 1].pointer = (rows[i]'(by omega)).pointer + 1 := by + have satisfied := valid.pointerTransition i hi + unfold memoryPointerTransition at satisfied + rw [active, G.mul_comm, G.mul_one] at satisfied + exact ((G.sub_eq_zero_iff ((rows[i]'(by omega)).pointer + 1) rows[i + 1].pointer).mp satisfied).symm + +theorem MemoryRowsValid.pointer_eq_first_add {width : Nat} {rows : Array MemoryRow} + (valid : MemoryRowsValid width rows) (i : Nat) (hi : i < rows.size) + (active : rows[i].selector = 1) : + rows[i].pointer = (rows[0]'(by omega)).pointer + G.ofNat i := by + induction i with + | zero => simp only [show G.ofNat 0 = (0 : G) from rfl, G.add_zero] + | succ i ih => + rw [valid.next_pointer i hi active] + rw [ih (by omega) (valid.previous_active i hi active), G.ofNat_add, G.add_assoc] + rfl + +theorem MemoryRowsValid.pointer_injective {width : Nat} {rows : Array MemoryRow} + (valid : MemoryRowsValid width rows) (bounded : rows.size < gSize.toNat) + (i j : Nat) (hi : i < rows.size) (hj : j < rows.size) + (activeI : rows[i].selector = 1) (activeJ : rows[j].selector = 1) + (same : rows[i].pointer = rows[j].pointer) : i = j := by + rw [valid.pointer_eq_first_add i hi activeI, valid.pointer_eq_first_add j hj activeJ] at same + exact G.ofNat_injective_below (by omega) (by omega) (G.add_left_cancel _ same) + +def memoryFacts (tables : Nat → Array MemoryRow) : Bytecode.AIR.Memory := + fun width pointer contents => ∃ i : Nat, ∃ hi : i < (tables width).size, + (tables width)[i].selector = 1 ∧ (tables width)[i].pointer = pointer ∧ + (tables width)[i].contents = contents + +theorem memoryFacts_functional (tables : Nat → Array MemoryRow) + (valid : ∀ width, MemoryRowsValid width (tables width)) + (bounded : ∀ width, (tables width).size < gSize.toNat) + {width : Nat} {pointer : G} {left right : Array G} + (loadedLeft : memoryFacts tables width pointer left) + (loadedRight : memoryFacts tables width pointer right) : left = right := by + obtain ⟨i, hi, ai, pi, vi⟩ := loadedLeft + obtain ⟨j, hj, aj, pj, vj⟩ := loadedRight + have same := (valid width).pointer_injective (bounded width) i j hi hj ai aj (pi.trans pj.symm) + subst j + exact vi.symm.trans vj + +/-- Providers for one fixed-width memory table, in native row order. -/ +def memoryProviders (rows : Array MemoryRow) : List (Provider (G × Array G)) := + List.ofFn fun i : Fin rows.size => + ((rows[i].pointer, rows[i].contents), rows[i].multiplicity) + +theorem memoryQueries_provider {width : Nat} {rows : Array MemoryRow} + (valid : MemoryRowsValid width rows) {queries : List (G × Array G)} + (balanced : ExactLookupBalance queries (memoryProviders rows)) + (bounded : queries.length < gSize.toNat) + {pointer : G} {contents : Array G} (queried : (pointer, contents) ∈ queries) : + ∃ i : Nat, ∃ hi : i < rows.size, + rows[i].selector = 1 ∧ rows[i].pointer = pointer ∧ rows[i].contents = contents := by + obtain ⟨provider, member, same, nonzero⟩ := exactLookupBalance_provider balanced bounded queried + obtain ⟨i, provided⟩ := List.mem_ofFn.mp member + subst provider + have active : rows[i].selector = 1 := by + rcases valid.selectors i i.isLt with inactive | active + · exact False.elim (nonzero (inactive_multiplicity_zero inactive (valid.activity i i.isLt))) + · exact active + exact ⟨i, i.isLt, active, congrArg Prod.fst same, congrArg Prod.snd same⟩ + +theorem memoryQueries_width {width : Nat} {rows : Array MemoryRow} + (valid : MemoryRowsValid width rows) {queries : List (G × Array G)} + (balanced : ExactLookupBalance queries (memoryProviders rows)) + (bounded : queries.length < gSize.toNat) + {pointer : G} {contents : Array G} (queried : (pointer, contents) ∈ queries) : + contents.size = width := by + obtain ⟨i, hi, _, _, same⟩ := memoryQueries_provider valid balanced bounded queried + rw [← same] + exact valid.widths i hi + +/-- Two balanced requests for the same width and pointer have equal data. +The trace-height bound prevents a pointer from recurring after a full field +cycle; the query-count bound separately prevents requests cancelling out. -/ +theorem memoryQueries_consistent {width : Nat} {rows : Array MemoryRow} + (valid : MemoryRowsValid width rows) (heightBound : rows.size < gSize.toNat) + {queries : List (G × Array G)} + (balanced : ExactLookupBalance queries (memoryProviders rows)) + (queryBound : queries.length < gSize.toNat) + {pointer : G} {left right : Array G} + (queriedLeft : (pointer, left) ∈ queries) + (queriedRight : (pointer, right) ∈ queries) : left = right := by + obtain ⟨i, hi, ai, pi, vi⟩ := memoryQueries_provider valid balanced queryBound queriedLeft + obtain ⟨j, hj, aj, pj, vj⟩ := memoryQueries_provider valid balanced queryBound queriedRight + have same := valid.pointer_injective heightBound i j hi hj ai aj (pi.trans pj.symm) + subst j + exact vi.symm.trans vj + +theorem memoryQueries_fact (tables : Nat → Array MemoryRow) + (valid : ∀ width, MemoryRowsValid width (tables width)) + (queries : Nat → List (G × Array G)) + (balanced : ∀ width, ExactLookupBalance (queries width) (memoryProviders (tables width))) + (bounded : ∀ width, (queries width).length < gSize.toNat) + {width : Nat} {pointer : G} {contents : Array G} + (queried : (pointer, contents) ∈ queries width) : + memoryFacts tables width pointer contents := + memoryQueries_provider (valid width) (balanced width) (bounded width) queried + +/-- A size-parameterized table used symbolically at `period = p`. Keeping +the size as an argument avoids a native initializer allocating `p + 1` rows +when this proof module is imported. -/ +def memoryPointerCycle (period : Nat) : Array MemoryRow := + Array.ofFn fun i : Fin (period + 1) => + ⟨1, 0, G.ofNat i.val, #[G.ofNat (i.val / period)]⟩ + +theorem memoryPointerCycle_valid : MemoryRowsValid 1 (memoryPointerCycle gSize.toNat) := by + constructor + · intro i hi + right + simp only [memoryPointerCycle, Array.getElem_ofFn] + · intro i hi + simp only [memoryPointerCycle, Array.getElem_ofFn] + exact active_satisfies 0 + · intro i hi + simp only [memoryPointerCycle, Array.getElem_ofFn, List.size_toArray, List.length_cons, + List.length_nil] + · intro i hi + simp only [memoryActivityTransition, memoryPointerCycle, Array.getElem_ofFn] + have same : (1 : G) - 1 = 0 := (G.sub_eq_zero_iff _ _).mpr rfl + rw [same, G.mul_zero] + · intro i hi + simp only [memoryPointerTransition, memoryPointerCycle, Array.getElem_ofFn] + have same : G.ofNat i + 1 = G.ofNat (i + 1) := (G.ofNat_add i 1).symm + rw [same, (G.sub_eq_zero_iff _ _).mpr rfl, G.mul_zero] + +theorem memoryPointerCycle_inconsistent : + ∃ i j : Fin (memoryPointerCycle gSize.toNat).size, + (memoryPointerCycle gSize.toNat)[i].selector = 1 ∧ (memoryPointerCycle gSize.toNat)[j].selector = 1 ∧ + (memoryPointerCycle gSize.toNat)[i].pointer = (memoryPointerCycle gSize.toNat)[j].pointer ∧ + (memoryPointerCycle gSize.toNat)[i].contents ≠ (memoryPointerCycle gSize.toNat)[j].contents := by + have size : (memoryPointerCycle gSize.toNat).size = gSize.toNat + 1 := by + simp only [memoryPointerCycle, Array.size_ofFn] + refine ⟨⟨0, by rw [size]; omega⟩, ⟨gSize.toNat, by rw [size]; omega⟩, ?_⟩ + simp only [Fin.getElem_fin, memoryPointerCycle, Array.getElem_ofFn] + decide + +end AIR +end Aiur diff --git a/Ix/Aiur/Proofs/Metadata.lean b/Ix/Aiur/Proofs/Metadata.lean new file mode 100644 index 000000000..416a8ab57 --- /dev/null +++ b/Ix/Aiur/Proofs/Metadata.lean @@ -0,0 +1,159 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Semantics.BytecodeEval + +/-! Circuit metadata does not change reference bytecode execution. The +theorem preserves errors and state as well as successful outputs, and works +in both directions. It does not interpret satisfying AIR witnesses as +executions of the reference evaluator. -/ + +namespace Aiur.Bytecode.Eval + +structure SameCode (a b : Toplevel) : Prop where + size : a.functions.size = b.functions.size + body : ∀ i (ha : i < a.functions.size) (hb : i < b.functions.size), + a.functions[i].body = b.functions[i].body + inputSize : ∀ i (ha : i < a.functions.size) (hb : i < b.functions.size), + a.functions[i].layout.inputSize = b.functions[i].layout.inputSize + +private theorem ops_lt (b : Block) : sizeOf b.ops < sizeOf b := by + cases b; simp; omega + +private theorem ctrl_lt (b : Block) : sizeOf b.ctrl < sizeOf b := by + cases b; simp; omega + +private theorem case_lt (cases : Array (G × Block)) (defaultBlock : Option Block) + (i : Nat) (h : i < cases.size) : + sizeOf cases[i].2 < sizeOf cases + sizeOf defaultBlock := by + have h1 := Array.sizeOf_get cases i h + have h2 : sizeOf cases[i].2 < sizeOf cases[i] := by + cases cases[i]; simp; omega + omega + +mutual + +theorem evalOp_sameCode {a b : Toplevel} (code : SameCode a b) + (fuel : Nat) (op : Op) (st : EvalState) : + evalOp a fuel op st = evalOp b fuel op st := by + cases op <;> simp only [evalOp] + case call fi args outputSize unconstrained => + cases hg : readIdxs st args with + | error e => rfl + | ok gs => + simp only [bind, Except.bind] + by_cases ha : fi < a.functions.size + · have hb : fi < b.functions.size := by rwa [← code.size] + simp only [dif_pos ha, dif_pos hb, code.inputSize fi ha hb] + split + · rfl + · cases fuel with + | zero => rfl + | succ fuel => + simp only + rw [code.body fi ha hb, evalBlock_sameCode code] + · have hb : ¬ fi < b.functions.size := by rwa [← code.size] + simp only [dif_neg ha, dif_neg hb] +termination_by (fuel, sizeOf op, 0) +decreasing_by all_goals first | decreasing_tactic | omega + +theorem runOps_sameCode {a b : Toplevel} (code : SameCode a b) + (fuel : Nat) (ops : Array Op) (st : EvalState) (i : Nat) : + runOps a fuel ops st i = runOps b fuel ops st i := by + rw [runOps.eq_1 a, runOps.eq_1 b] + by_cases h : i < ops.size + · simp only [dif_pos h, evalOp_sameCode code fuel ops[i] st] + cases evalOp b fuel ops[i] st with + | error e => rfl + | ok st' => exact runOps_sameCode code fuel ops st' (i + 1) + · simp only [dif_neg h] +termination_by (fuel, sizeOf ops, 1 + (ops.size - i)) +decreasing_by all_goals first | decreasing_tactic | omega + +theorem evalBlock_sameCode {a b : Toplevel} (code : SameCode a b) + (fuel : Nat) (block : Block) (st : EvalState) : + evalBlock a fuel block st = evalBlock b fuel block st := by + rw [evalBlock.eq_1 a, evalBlock.eq_1 b, runOps_sameCode code] + cases runOps b fuel block.ops st 0 with + | error e => rfl + | ok st' => exact evalCtrl_sameCode code fuel block.ctrl st' +termination_by (fuel, sizeOf block, 4) +decreasing_by + all_goals first + | decreasing_tactic + | (apply Prod.Lex.right; apply Prod.Lex.left; exact ops_lt _) + | (apply Prod.Lex.right; apply Prod.Lex.left; exact ctrl_lt _) + | omega + +theorem evalCtrl_sameCode {a b : Toplevel} (code : SameCode a b) + (fuel : Nat) (ctrl : Ctrl) (st : EvalState) : + evalCtrl a fuel ctrl st = evalCtrl b fuel ctrl st := by + cases ctrl with + | «return» sel outs => simp only [evalCtrl] + | «yield» sel outs => simp only [evalCtrl] + | «match» idx cases fallback => + simp only [evalCtrl] + cases readIdx st idx with + | error e => rfl + | ok scrut => exact evalMatchArm_sameCode code fuel cases fallback scrut st 0 + | matchContinue idx cases fallback out aux lookups cont => + simp only [evalCtrl] + cases readIdx st idx with + | error e => rfl + | ok scrut => + simp only + rw [evalMatchArm_sameCode code] + cases evalMatchArm b fuel cases fallback scrut st with + | error e => rfl + | ok result => exact evalBlock_sameCode code fuel cont _ +termination_by (fuel, sizeOf ctrl, 3) +decreasing_by all_goals first | decreasing_tactic | omega + +theorem evalMatchArm_sameCode {a b : Toplevel} (code : SameCode a b) + (fuel : Nat) (cases : Array (G × Block)) (fallback : Option Block) + (scrut : G) (st : EvalState) (i : Nat) : + evalMatchArm a fuel cases fallback scrut st i = evalMatchArm b fuel cases fallback scrut st i := by + rw [evalMatchArm.eq_1 a, evalMatchArm.eq_1 b] + by_cases h : i < cases.size + · simp only [dif_pos h] + split + · exact evalBlock_sameCode code fuel cases[i].2 st + · exact evalMatchArm_sameCode code fuel cases fallback scrut st (i + 1) + · simp only [dif_neg h] + exact evalDefaultBlock_sameCode code fuel fallback st +termination_by (fuel, sizeOf cases + sizeOf fallback, 2 + (cases.size - i)) +decreasing_by + all_goals + clean_wf + first + | decreasing_tactic + | (apply Prod.Lex.right; apply Prod.Lex.left; exact case_lt cases fallback i ‹_›) + | (apply Prod.Lex.right; apply Prod.Lex.left + cases cases; simp; omega) + | omega + +theorem evalDefaultBlock_sameCode {a b : Toplevel} (code : SameCode a b) + (fuel : Nat) (fallback : Option Block) (st : EvalState) : + evalDefaultBlock a fuel fallback st = evalDefaultBlock b fuel fallback st := by + cases fallback with + | none => simp only [evalDefaultBlock] + | some block => simpa only [evalDefaultBlock] using evalBlock_sameCode code fuel block st +termination_by (fuel, sizeOf fallback, 1) +decreasing_by all_goals first | decreasing_tactic | (simp_wf; omega) + +end + +theorem runFunction_sameCode {a b : Toplevel} (code : SameCode a b) + (function : FunIdx) (args : Array G) (io : IOBuffer) (fuel : Nat) : + runFunction a function args io fuel = runFunction b function args io fuel := by + rw [runFunction.eq_1 a, runFunction.eq_1 b] + by_cases ha : function < a.functions.size + · have hb : function < b.functions.size := by rwa [← code.size] + simp only [dif_pos ha, dif_pos hb, code.inputSize function ha hb, + code.body function ha hb, evalBlock_sameCode code] + · have hb : ¬ function < b.functions.size := by rwa [← code.size] + simp only [dif_neg ha, dif_neg hb] + +end Aiur.Bytecode.Eval diff --git a/Ix/Aiur/Proofs/NormalizationFrames.lean b/Ix/Aiur/Proofs/NormalizationFrames.lean new file mode 100644 index 000000000..fca517727 --- /dev/null +++ b/Ix/Aiur/Proofs/NormalizationFrames.lean @@ -0,0 +1,162 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Semantics.SourceEval + +/-! Semantic identities for let frames, continuation sequencing and call +modes. They preserve complete results at unchanged call fuel. These are +components of normalization; fresh naming and complete argument hoisting +require separate proofs. -/ + +namespace Aiur.Source.Eval + +theorem wrapLets_peelLets (term : Term) : + Term.wrapLets term.peelLets.1 term.peelLets.2 = term := by + induction term using Term.peelLets.induct with + | case1 pattern value body frames core peeled ih => + simpa only [Term.peelLets, peeled, Term.wrapLets] using congrArg (Term.let pattern value) ih + | case2 term notLet => + rw [Term.peelLets.eq_def] + split + · exact False.elim (notLet _ _ _ rfl) + · rfl + +def evalFrames (decls : Decls) (fuel : Nat) : + List (Pattern × Term) → Bindings → EvalState → Except SourceError (Bindings × EvalState) + | [], bindings, st => .ok (bindings, st) + | (pattern, value) :: frames, bindings, st => do + let (value, st) ← interp decls fuel bindings value st + let some added := matchPattern st.store pattern value | .error .patternFail + evalFrames decls fuel frames (added ++ bindings) st + +theorem interp_wrapLets (decls : Decls) (fuel : Nat) (frames : List (Pattern × Term)) + (body : Term) (bindings : Bindings) (st : EvalState) : + interp decls fuel bindings (Term.wrapLets frames body) st = + (do let (bindings, st) ← evalFrames decls fuel frames bindings st + interp decls fuel bindings body st) := by + induction frames generalizing bindings st with + | nil => rfl + | cons frame frames ih => + rcases frame with ⟨pattern, value⟩ + simp only [Term.wrapLets, interp, evalFrames] + cases interp decls fuel bindings value st with + | error error => rfl + | ok result => + rcases result with ⟨value, st'⟩ + dsimp only [bind, Except.bind] + cases matchPattern st'.store pattern value with + | none => rfl + | some added => exact ih (added ++ bindings) st' + +theorem evalFrames_append (decls : Decls) (fuel : Nat) + (first rest : List (Pattern × Term)) (bindings : Bindings) (st : EvalState) : + evalFrames decls fuel (first ++ rest) bindings st = + (do let (bindings, st) ← evalFrames decls fuel first bindings st + evalFrames decls fuel rest bindings st) := by + induction first generalizing bindings st with + | nil => rfl + | cons frame frames ih => + rcases frame with ⟨pattern, value⟩ + simp only [List.cons_append, evalFrames] + cases interp decls fuel bindings value st with + | error error => rfl + | ok result => + rcases result with ⟨value, st'⟩ + dsimp only [bind, Except.bind] + cases matchPattern st'.store pattern value with + | none => rfl + | some added => exact ih (added ++ bindings) st' + +theorem interp_peelLets (decls : Decls) (fuel : Nat) (term : Term) + (bindings : Bindings) (st : EvalState) : + interp decls fuel bindings term st = + (do let (bindings, st) ← evalFrames decls fuel term.peelLets.1 bindings st + interp decls fuel bindings term.peelLets.2 st) := by + rw [← interp_wrapLets, wrapLets_peelLets] + +theorem interp_ret_wrapLets (decls : Decls) (fuel : Nat) + (frames : List (Pattern × Term)) (body : Term) (bindings : Bindings) (st : EvalState) : + interp decls fuel bindings (.ret (Term.wrapLets frames body)) st = + interp decls fuel bindings (Term.wrapLets frames (.ret body)) st := by + rw [interp_wrapLets] + simp only [interp, interp_wrapLets] + cases evalFrames decls fuel frames bindings st with + | error error => rfl + | ok result => cases result; rfl + +theorem interp_ioWrite_sequence (decls : Decls) (fuel : Nat) + (channel data continuation : Term) (bindings : Bindings) (st : EvalState) : + interp decls fuel bindings (.ioWrite channel data continuation) st = + interp decls fuel bindings (.let .wildcard (.ioWrite channel data .unit) continuation) st := by + simp only [interp] + cases interp decls fuel bindings channel st <;> simp only + next result => + rcases result with ⟨channel, st⟩ + cases interp decls fuel bindings data st <;> simp only + next result => + rcases result with ⟨data, st⟩ + cases channel <;> cases data <;> simp only + split <;> simp only [matchPattern, List.nil_append] + +theorem interp_debug_sequence (decls : Decls) (fuel : Nat) + (label : String) (value : Option Term) (continuation : Term) + (bindings : Bindings) (st : EvalState) : + interp decls fuel bindings (.debug label value continuation) st = + interp decls fuel bindings (.let .wildcard (.debug label value .unit) continuation) st := by + cases value with + | none => simp only [interp, matchPattern, List.nil_append] + | some value => + simp only [interp] + cases interp decls fuel bindings value st with + | error error => rfl + | ok result => + rcases result with ⟨value, st'⟩ + simp only [matchPattern, List.nil_append] + +theorem interp_assertEq_sequence (decls : Decls) (fuel : Nat) + (first second : Term) (message : Option String) (continuation : Term) + (bindings : Bindings) (st : EvalState) : + interp decls fuel bindings (.assertEq first second message continuation) st = + interp decls fuel bindings + (.let .wildcard (.assertEq first second message .unit) continuation) st := by + cases message <;> ( + simp only [interp] + cases interp decls fuel bindings first st <;> simp only + next result => + rcases result with ⟨first, st⟩ + cases interp decls fuel bindings second st <;> simp only + next result => + rcases result with ⟨second, st⟩ + split <;> simp only [matchPattern, List.nil_append]) + +theorem interp_ioSetInfo_sequence (decls : Decls) (fuel : Nat) + (channel key index length continuation : Term) (bindings : Bindings) (st : EvalState) : + interp decls fuel bindings (.ioSetInfo channel key index length continuation) st = + interp decls fuel bindings + (.let .wildcard (.ioSetInfo channel key index length .unit) continuation) st := by + simp only [interp] + cases interp decls fuel bindings channel st <;> simp only + next result => + rcases result with ⟨channel, st⟩ + cases interp decls fuel bindings key st <;> simp only + next result => + rcases result with ⟨key, st⟩ + cases interp decls fuel bindings index st <;> simp only + next result => + rcases result with ⟨index, st⟩ + cases interp decls fuel bindings length st <;> simp only + next result => + rcases result with ⟨length, st⟩ + cases channel <;> cases key <;> cases index <;> cases length <;> simp only + split <;> try simp only + split <;> simp only [matchPattern, List.nil_append] + +theorem interp_app_mode (decls : Decls) (fuel : Nat) (bindings : Bindings) + (global : Global) (args : List Term) (before after : CallMode) (st : EvalState) : + interp decls fuel bindings (.app global args before) st = + interp decls fuel bindings (.app global args after) st := by + simp only [interp] + +end Aiur.Source.Eval diff --git a/Ix/Aiur/Proofs/OperationRows.lean b/Ix/Aiur/Proofs/OperationRows.lean new file mode 100644 index 000000000..9bd3bf8ad --- /dev/null +++ b/Ix/Aiur/Proofs/OperationRows.lean @@ -0,0 +1,663 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.GlobalLookups + +/-! +Valued emission and local execution for every native bytecode operation. +The model retains expression degree, constant folding, fresh auxiliary-column +allocation, logical map extension, polynomial values and raw query parts. +Active satisfying emissions derive relational steps and operation sequences +using byte and memory facts from the global lookup pool. + +This is a total Lean model. Identifying its reads and metadata with the Rust +expression emitter, proving index and layout validity, and extracting its +active query parts from shared slots remain explicit obligations. +-/ + +namespace Aiur.AIR +open Bytecode + +/-- One evaluated logical value, retaining the native emitter's expression +degree and whether its frontend expression is syntactically constant. -/ +structure RowValue where + value : G + degree : Nat + constant : Bool + deriving Repr, DecidableEq + +def RowValue.variable (value : G) : RowValue := ⟨value, 1, false⟩ +def RowValue.konst (value : G) : RowValue := ⟨value, 0, true⟩ +def rowValues (values : Array RowValue) : Array G := values.map RowValue.value + +def RowValue.add (left right : RowValue) : RowValue := + ⟨left.value + right.value, max left.degree right.degree, left.constant && right.constant⟩ + +def RowValue.sub (left right : RowValue) : RowValue := + ⟨left.value - right.value, max left.degree right.degree, left.constant && right.constant⟩ + +/-- Multiplication by a known zero also folds a nonconstant expression to +a constant; the native operation's degree bookkeeping remains independent. -/ +def RowValue.mul (left right : RowValue) : RowValue := + ⟨left.value * right.value, left.degree + right.degree, + (left.constant && right.constant) || (left.constant && left.value == 0) || + (right.constant && right.value == 0)⟩ + +def rowAdvice (row : Nat → G) (start count : Nat) : Array RowValue := + Array.ofFn fun index : Fin count => RowValue.variable (row (start + index.val)) + +def RowValue.pack (values : Array RowValue) : RowValue := + ⟨Bytecode.AIR.packWord (rowValues values), + values.toList.foldl (fun degree value => max degree value.degree) 0, + values.all (·.constant)⟩ + +def readRowWord (values : Array RowValue) (indices : Array ValIdx) : Option RowValue := do + let word ← Bytecode.AIR.readWord (rowValues values) indices + let bytes := indices.map fun index => values[index]?.getD (RowValue.konst 0) + return { RowValue.pack bytes with value := word } + +/-- One operation's evaluated outputs and newly emitted constraints. Lookup +messages are ungated contributions; slot assembly supplies their selector. +`used` is the exact number of fresh auxiliary columns consumed. -/ +structure OpEmission where + outputs : Array RowValue := #[] + used : Nat := 0 + equations : List G := [] + queries : List (List G) := [] + calls : List (Bytecode.AIR.Call × (Fin 6 → G)) := [] + +def emitAdvice (row : Nat → G) (count : Nat) : OpEmission := + { outputs := rowAdvice row 0 count, used := count } + +def emitByte1 (row : Nat → G) (kind : Byte1Kind) (index : ValIdx) + (values : Array RowValue) : Option OpEmission := do + let input ← values[index]? + let outputs := rowAdvice row 0 kind.outputSize + return { + outputs, used := kind.outputSize + queries := [byte1Request kind input.value (rowValues outputs)] } + +def Byte2Kind.extendRowOutputs (kind : Byte2Kind) (left right : RowValue) + (outputs : Array RowValue) : Array RowValue := + let low := ((rowValues outputs)[0]?).getD 0 + let degree := max (max left.degree right.degree) 1 + match kind with + | .add => outputs.push ⟨(left.value + right.value - low) * inverse256, degree, false⟩ + | .sub => outputs.push ⟨(low + right.value - left.value) * inverse256, degree, false⟩ + | _ => outputs + +def emitByte2 (row : Nat → G) (kind : Byte2Kind) (left right : ValIdx) + (values : Array RowValue) : Option OpEmission := do + let x ← values[left]? + let y ← values[right]? + let outputs := rowAdvice row 0 kind.outputSize + return { + outputs := kind.extendRowOutputs x y outputs, used := kind.outputSize + queries := [byte2Request kind x.value y.value (rowValues outputs)] } + +def range4Queries (bytes : Fin 4 → G) : List (List G) := + [rangeMessage (bytes 0, bytes 1), rangeMessage (bytes 2, bytes 3)] + +def emitU32LessThan (row : Nat → G) (selector : G) (left right : ValIdx) + (values : Array RowValue) : Option OpEmission := do + let a ← values[left]? + let b ← values[right]? + let x : Fin 4 → G := fun index => row index.val + let y : Fin 4 → G := fun index => row (4 + index.val) + let z : Fin 4 → G := fun index => row (8 + index.val) + return { + outputs := #[⟨1 - u32Carries x y z 4, 1, false⟩], used := 12 + equations := selector * (a.value - pack4 x) :: selector * (b.value - pack4 z) :: + List.ofFn (fun index : Fin 4 => selector * booleanConstraint (u32Carries x y z index.succ)), + queries := range4Queries x ++ range4Queries y ++ range4Queries z } + +def emitU32Add (row : Nat → G) (left right : Array ValIdx) + (third : Option (Array ValIdx)) (values : Array RowValue) : Option OpEmission := do + let x ← readRowWord values left + let y ← readRowWord values right + let sum ← match third with + | none => some (x.add y) + | some indices => (readRowWord values indices).map fun z => (x.add y).add z + let bytes := rowAdvice row 0 4 + let packed := RowValue.pack bytes + return { outputs := bytes.push ⟨(sum.value - packed.value) * 0xfffffffe00000002, + max sum.degree packed.degree, false⟩, used := 4 } + +/-- Valued model of one native operation. Invalid reads, malformed word +widths and the native constant-`eq_zero` degree assertion return `none`. +Store operands are checked in the incoming logical scope; identifying that +scope with the Rust emitter's post-pointer reads requires index validity. -/ +def emitOp (row : Nat → G) (selector rank : G) (op : Op) + (values : Array RowValue) : Option OpEmission := + match op with + | .const value => some { outputs := #[RowValue.konst value] } + | .add a b => do return { outputs := #[(← values[a]?).add (← values[b]?)] } + | .sub a b => do return { outputs := #[(← values[a]?).sub (← values[b]?)] } + | .mul a b => do + let x ← values[a]? + let y ← values[b]? + let product := x.mul y + if product.degree < 2 then return { outputs := #[product] } + else return { + outputs := #[RowValue.variable (row 0)], used := 1 + equations := [selector * (row 0 - product.value)] } + | .eqZero a => do + let input ← values[a]? + if input.constant then + if input.degree = 0 then return { outputs := #[RowValue.konst (G.eqZero input.value)] } + else none + else return { + outputs := #[RowValue.variable (row 1)], used := 2 + equations := [selector * input.value * row 1, + selector * (input.value * row 0 + row 1 - 1)] } + | .call function indices size unconstrained => + if unconstrained then some (emitAdvice row size) + else do + let inputs ← Bytecode.AIR.readValues (rowValues values) indices + let outputs := rowAdvice row 0 size + let request : Bytecode.AIR.Call := ⟨function, inputs, rowValues outputs, row size⟩ + let gap : Fin 6 → G := fun index => row (size + 1 + index.val) + return { + outputs, used := size + 7 + equations := [selector * callOrderConstraint rank request.rank (packRank gap)], + queries := functionMessage request :: (rankByteQueries gap).map rangeMessage, + calls := [(request, gap)] } + | .store indices => do + let contents ← Bytecode.AIR.readValues (rowValues values) indices + return { + outputs := #[RowValue.variable (row 0)], used := 1 + queries := [memoryMessage indices.size (row 0) contents] } + | .load size index => do + let pointer ← values[index]? + let outputs := rowAdvice row 0 size + return { + outputs, used := size + queries := [memoryMessage size pointer.value (rowValues outputs)] } + | .assertEq xs ys _ => do + if xs.size ≠ ys.size then none else do + let left ← Bytecode.AIR.readValues (rowValues values) xs + let right ← Bytecode.AIR.readValues (rowValues values) ys + return { equations := List.ofFn fun i : Fin left.size => + selector * (left[i] - right[i.val]?.getD 0) } + | .ioGetInfo .. => some (emitAdvice row 2) + | .ioRead _ _ size => some (emitAdvice row size) + | .ioSetInfo .. | .ioWrite .. | .debug .. => some {} + | .u8BitDecomposition index => emitByte1 row .bits index values + | .u8ShiftLeft index => emitByte1 row .shiftLeft index values + | .u8ShiftRight index => emitByte1 row .shiftRight index values + | .u8Xor a b => emitByte2 row .xor a b values + | .u8Add a b => emitByte2 row .add a b values + | .u8Sub a b => emitByte2 row .sub a b values + | .u8And a b => emitByte2 row .and a b values + | .u8Or a b => emitByte2 row .or a b values + | .u8LessThan a b => emitByte2 row .lessThan a b values + | .u8RangeCheck a b => emitByte2 row .range a b values + | .u8Mul a b => emitByte2 row .mul a b values + | .u8XorSplit7 a b => emitByte2 row .split7 a b values + | .u8XorSplit4 a b => emitByte2 row .split4 a b values + | .u32LessThan a b => emitU32LessThan row selector a b values + | .unconstrainedBigUintDivMod .. => some (emitAdvice row 2) + | .unconstrainedGToBytes .. => some (emitAdvice row 8) + | .unconstrainedGInverse .. => some (emitAdvice row 1) + | .unconstrainedU32Add a b => emitU32Add row a b none values + | .unconstrainedU32Add3 a b c => emitU32Add row a b (some c) values + | .u32ToField indices => do return { outputs := #[← readRowWord values indices] } + +theorem rowValues_read {values : Array RowValue} {index : ValIdx} {value : RowValue} + (read : values[index]? = some value) : (rowValues values)[index]? = some value.value := by + simp only [rowValues, Array.getElem?_map, read, Option.map_some] + +theorem rowValues_advice_size (row : Nat → G) (start count : Nat) : + (rowValues (rowAdvice row start count)).size = count := by + simp only [rowValues, rowAdvice, Array.size_map, Array.size_ofFn] + +theorem rowValues_singleton (value : RowValue) : rowValues #[value] = #[value.value] := by + simp only [rowValues, Array.map_singleton] + +theorem rowValues_empty : rowValues #[] = #[] := by + simp only [rowValues, Array.map_empty] + +theorem rowValues_extendOutputs (kind : Byte2Kind) (left right : RowValue) + (outputs : Array RowValue) : + rowValues (kind.extendRowOutputs left right outputs) = + kind.extendOutputs left.value right.value (rowValues outputs) := by + cases kind <;> simp only [Byte2Kind.extendRowOutputs, Byte2Kind.extendOutputs, + rowValues, Array.map_push] + +theorem readRowWord_value {values : Array RowValue} {indices : Array ValIdx} {word : RowValue} + (read : readRowWord values indices = some word) : + Bytecode.AIR.readWord (rowValues values) indices = some word.value := by + simp only [readRowWord, bind, Option.bind] at read + split at read + · cases read + · have equal := Option.some.inj read + rw [← equal] + assumption + +theorem emitByte1_step {tables : LookupTables} {width : Nat} {queries : List (List G)} + (global : GlobalLookups tables width queries) (memory : Bytecode.AIR.Memory) + {row : Nat → G} {kind : Byte1Kind} {index : ValIdx} {values : Array RowValue} + {emission : OpEmission} (emitted : emitByte1 row kind index values = some emission) + (queried : emission.queries ⊆ queries) : + Bytecode.AIR.Step memory (kind.op index) (rowValues values) + (rowValues values ++ rowValues emission.outputs) (emission.calls.map Prod.fst) := by + simp only [emitByte1, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i input read + have equal := Option.some.inj emitted + subst emission + exact global.byte1_step memory (rowValues_read read) (rowValues_advice_size _ _ _) + (queried List.mem_cons_self) + +theorem emitByte2_step {tables : LookupTables} {width : Nat} {queries : List (List G)} + (global : GlobalLookups tables width queries) (memory : Bytecode.AIR.Memory) + {row : Nat → G} {kind : Byte2Kind} {left right : ValIdx} {values : Array RowValue} + {emission : OpEmission} (emitted : emitByte2 row kind left right values = some emission) + (queried : emission.queries ⊆ queries) : + Bytecode.AIR.Step memory (kind.op left right) (rowValues values) + (rowValues values ++ rowValues emission.outputs) (emission.calls.map Prod.fst) := by + simp only [emitByte2, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i x readX + dsimp only at emitted + split at emitted + · cases emitted + · rename_i y readY + have equal := Option.some.inj emitted + subst emission + simp only [rowValues_extendOutputs] + exact global.byte2_step memory (rowValues_read readX) (rowValues_read readY) + (rowValues_advice_size _ _ _) (queried List.mem_cons_self) + +theorem GlobalLookups.range4 {tables : LookupTables} {width : Nat} {queries : List (List G)} + (global : GlobalLookups tables width queries) (bytes : Fin 4 → G) + (queried : range4Queries bytes ⊆ queries) : ∀ i, (bytes i).n < 256 := by + have first := global.byte2 (kind := .range) (x := bytes 0) (y := bytes 1) (outputs := #[]) rfl + (queried (by simp [range4Queries, rangeMessage])) + have last := global.byte2 (kind := .range) (outputs := #[]) rfl + (queried (by simp [range4Queries, rangeMessage] : rangeMessage (bytes 2, bytes 3) ∈ range4Queries bytes)) + intro i + have cases : i = 0 ∨ i = 1 ∨ i = 2 ∨ i = 3 := by omega + rcases cases with rfl | rfl | rfl | rfl + · exact first.1 + · exact first.2.1 + · exact last.1 + · exact last.2.1 + +theorem emitU32LessThan_step {tables : LookupTables} {width : Nat} {queries : List (List G)} + (global : GlobalLookups tables width queries) (memory : Bytecode.AIR.Memory) + {row : Nat → G} {selector : G} {left right : ValIdx} {values : Array RowValue} + {emission : OpEmission} (emitted : emitU32LessThan row selector left right values = some emission) + (active : selector = 1) (satisfied : ∀ equation ∈ emission.equations, equation = 0) + (queried : emission.queries ⊆ queries) : + Bytecode.AIR.Step memory (.u32LessThan left right) (rowValues values) + (rowValues values ++ rowValues emission.outputs) (emission.calls.map Prod.fst) := by + simp only [emitU32LessThan, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i a readA + dsimp only at emitted + split at emitted + · cases emitted + · rename_i b readB + have equal := Option.some.inj emitted + subst emission + simp only [rowValues_singleton] + apply active_u32_less_than_step memory active (rowValues_read readA) (rowValues_read readB) + (fun index => row index.val) (fun index => row (4 + index.val)) (fun index => row (8 + index.val)) + · exact global.range4 _ (fun message member => queried + (List.mem_append_left _ (List.mem_append_left _ member))) + · exact global.range4 _ (fun message member => queried + (List.mem_append_left _ (List.mem_append_right _ member))) + · exact global.range4 _ (fun message member => queried (List.mem_append_right _ member)) + · exact satisfied _ List.mem_cons_self + · exact satisfied _ (List.mem_cons_of_mem _ List.mem_cons_self) + · intro index + apply satisfied + exact List.mem_cons_of_mem _ (List.mem_cons_of_mem _ (List.mem_ofFn.mpr ⟨index, rfl⟩)) + +theorem emitU32Add_step (memory : Bytecode.AIR.Memory) + {row : Nat → G} {left right : Array ValIdx} {values : Array RowValue} {emission : OpEmission} + (emitted : emitU32Add row left right none values = some emission) : + Bytecode.AIR.Step memory (.unconstrainedU32Add left right) (rowValues values) + (rowValues values ++ rowValues emission.outputs) (emission.calls.map Prod.fst) := by + simp only [emitU32Add, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i x readX + dsimp only at emitted + split at emitted + · cases emitted + · rename_i y readY + have equal := Option.some.inj emitted + subst emission + apply Bytecode.AIR.Step.primitive (advice := rowValues (rowAdvice row 0 4)) + simp only [Bytecode.AIR.primitive, readRowWord_value readX, readRowWord_value readY, + Bytecode.AIR.adviceOfSize, rowValues_advice_size, ite_true, bind, Option.bind] + simp only [RowValue.add, RowValue.pack, rowValues, Array.map_push, pure] + +theorem emitU32Add3_step (memory : Bytecode.AIR.Memory) + {row : Nat → G} {left right third : Array ValIdx} {values : Array RowValue} {emission : OpEmission} + (emitted : emitU32Add row left right (some third) values = some emission) : + Bytecode.AIR.Step memory (.unconstrainedU32Add3 left right third) (rowValues values) + (rowValues values ++ rowValues emission.outputs) (emission.calls.map Prod.fst) := by + simp only [emitU32Add, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i x readX + dsimp only at emitted + split at emitted + · cases emitted + · rename_i y readY + dsimp only at emitted + cases readZ : readRowWord values third with + | none => simp only [readZ, Option.map_none] at emitted; cases emitted + | some z => + simp only [readZ, Option.map_some] at emitted + have equal := Option.some.inj emitted + subst emission + apply Bytecode.AIR.Step.primitive (advice := rowValues (rowAdvice row 0 4)) + simp only [Bytecode.AIR.primitive, readRowWord_value readX, readRowWord_value readY, + readRowWord_value readZ, Bytecode.AIR.adviceOfSize, rowValues_advice_size, + ite_true, bind, Option.bind] + simp only [RowValue.add, RowValue.pack, rowValues, Array.map_push, pure] + +theorem active_array_equality {selector : G} {left right : Array G} + (active : selector = 1) (sizes : left.size = right.size) + (equations : ∀ equation ∈ (List.ofFn fun i : Fin left.size => + selector * (left[i] - right[i.val]?.getD 0)), equation = 0) : left = right := by + apply Array.ext sizes + intro index leftBound rightBound + have equal := active_case active (equations _ (List.mem_ofFn.mpr ⟨⟨index, leftBound⟩, rfl⟩)) + simpa only [Fin.getElem_fin, Array.getElem?_eq_getElem rightBound, Option.getD_some] using equal + +/-- A successful valued emission on an active row has the full relational +meaning of its bytecode operation. Byte and memory facts come from the one +global pool; constrained calls remain requests for the later rank induction. -/ +theorem emitOp_step {tables : LookupTables} {width : Nat} {queries : List (List G)} + (global : GlobalLookups tables width queries) + (memoryValid : ∀ size, MemoryRowsValid size (tables.memory size)) + (canonical : ∀ size ∈ tables.memoryWidths, size < gSize.toNat) + {program : Toplevel} {op : Op} (shape : op.lookupShape program = true) + {row : Nat → G} {selector rank : G} {values : Array RowValue} {emission : OpEmission} + (emitted : emitOp row selector rank op values = some emission) + (active : selector = 1) (satisfied : ∀ equation ∈ emission.equations, equation = 0) + (queried : emission.queries ⊆ queries) : + Bytecode.AIR.Step (memoryFacts tables.memory) op (rowValues values) + (rowValues values ++ rowValues emission.outputs) (emission.calls.map Prod.fst) := by + cases op with + | const value => + simp only [emitOp, Option.some.injEq] at emitted + subst emission + apply Bytecode.AIR.Step.primitive (advice := #[]) + simp only [Bytecode.AIR.primitive, rowValues_singleton, RowValue.konst] + | add a b => + simp only [emitOp, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i x readX + dsimp only at emitted + split at emitted + · cases emitted + · rename_i y readY + have equal := Option.some.inj emitted + subst emission + apply Bytecode.AIR.Step.primitive (advice := #[]) + simp only [Bytecode.AIR.primitive, rowValues_read readX, rowValues_read readY, + bind, Option.bind, pure, rowValues_singleton, RowValue.add] + | sub a b => + simp only [emitOp, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i x readX + dsimp only at emitted + split at emitted + · cases emitted + · rename_i y readY + have equal := Option.some.inj emitted + subst emission + apply Bytecode.AIR.Step.primitive (advice := #[]) + simp only [Bytecode.AIR.primitive, rowValues_read readX, rowValues_read readY, + bind, Option.bind, pure, rowValues_singleton, RowValue.sub] + | mul a b => + simp only [emitOp, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i x readX + dsimp only at emitted + split at emitted + · cases emitted + · rename_i y readY + dsimp only at emitted + split at emitted + · have equal := Option.some.inj emitted + subst emission + apply Bytecode.AIR.Step.primitive (advice := #[]) + simp only [Bytecode.AIR.primitive, rowValues_read readX, rowValues_read readY, + bind, Option.bind, pure, rowValues_singleton, RowValue.mul] + · have equal := Option.some.inj emitted + subst emission + have product := active_case active (satisfied _ List.mem_cons_self) + apply Bytecode.AIR.Step.primitive (advice := #[]) + simp only [Bytecode.AIR.primitive, rowValues_read readX, rowValues_read readY, + bind, Option.bind, pure, rowValues_singleton, RowValue.variable, product, RowValue.mul] + | eqZero a => + simp only [emitOp, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i input read + dsimp only at emitted + split at emitted + · split at emitted + · have equal := Option.some.inj emitted + subst emission + apply Bytecode.AIR.Step.primitive (advice := #[]) + simp only [Bytecode.AIR.primitive, rowValues_read read, bind, Option.bind, + pure, rowValues_singleton, RowValue.konst] + · cases emitted + · have equal := Option.some.inj emitted + subst emission + have result := active_eqZero active (satisfied _ List.mem_cons_self) + (satisfied _ (List.mem_cons_of_mem _ List.mem_cons_self)) + apply Bytecode.AIR.Step.primitive (advice := #[]) + simp only [Bytecode.AIR.primitive, rowValues_read read, bind, Option.bind, + pure, rowValues_singleton, RowValue.variable, result] + | call function indices size unconstrained => + cases unconstrained with + | true => + simp only [emitOp, ite_true, Option.some.injEq] at emitted + subst emission + apply Bytecode.AIR.Step.primitive (advice := rowValues (rowAdvice row 0 size)) + simp only [Bytecode.AIR.primitive, Bytecode.AIR.adviceOfSize, rowValues_advice_size, ite_true, emitAdvice] + | false => + simp only [emitOp, Bool.false_eq_true, ite_false, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i inputs read + have equal := Option.some.inj emitted + subst emission + exact Bytecode.AIR.Step.call + (request := ⟨function, inputs, rowValues (rowAdvice row 0 size), row size⟩) + read (rowValues_advice_size row 0 size) + | store indices => + have widthBound : indices.size < gSize.toNat := by + simpa only [Op.lookupShape, decide_eq_true_eq] using shape + simp only [emitOp, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i contents read + have equal := Option.some.inj emitted + subst emission + have size := Bytecode.AIR.readValues_size read + have fact := global.memory_fact memoryValid canonical widthBound size (queried List.mem_cons_self) + rw [← size] at fact + simpa only [rowValues_singleton, RowValue.variable, Array.push_eq_append, List.map_nil] using + Bytecode.AIR.Step.store read fact + | load size index => + have widthBound : size < gSize.toNat := by + simpa only [Op.lookupShape, decide_eq_true_eq] using shape + simp only [emitOp, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i pointer read + have equal := Option.some.inj emitted + subst emission + exact Bytecode.AIR.Step.load (rowValues_read read) (rowValues_advice_size _ _ _) + (global.memory_fact memoryValid canonical widthBound (rowValues_advice_size _ _ _) + (queried List.mem_cons_self)) + | assertEq xs ys message => + simp only [emitOp, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i sameSize + split at emitted + · cases emitted + · rename_i left readLeft + dsimp only at emitted + split at emitted + · cases emitted + · rename_i right readRight + have equal := Option.some.inj emitted + subst emission + have sizes : left.size = right.size := by + have := Bytecode.AIR.readValues_size readLeft + have := Bytecode.AIR.readValues_size readRight + omega + have contents := active_array_equality active sizes satisfied + apply Bytecode.AIR.Step.primitive (advice := #[]) + simp only [rowValues_empty] + simp only [Bytecode.AIR.primitive, readLeft, readRight, bind, Option.bind, + if_pos contents] + | ioGetInfo key data => + simp only [emitOp, Option.some.injEq] at emitted + subst emission + apply Bytecode.AIR.Step.primitive (advice := rowValues (rowAdvice row 0 2)) + simp only [Bytecode.AIR.primitive, Bytecode.AIR.adviceOfSize, rowValues_advice_size, ite_true, emitAdvice] + | ioRead key offset size => + simp only [emitOp, Option.some.injEq] at emitted + subst emission + apply Bytecode.AIR.Step.primitive (advice := rowValues (rowAdvice row 0 size)) + simp only [Bytecode.AIR.primitive, Bytecode.AIR.adviceOfSize, rowValues_advice_size, ite_true, emitAdvice] + | ioSetInfo key data flag length => + simp only [emitOp, Option.some.injEq] at emitted + subst emission + apply Bytecode.AIR.Step.primitive (advice := #[]) + simp only [Bytecode.AIR.primitive, rowValues, Array.map_empty] + | ioWrite key data => + simp only [emitOp, Option.some.injEq] at emitted + subst emission + apply Bytecode.AIR.Step.primitive (advice := #[]) + simp only [Bytecode.AIR.primitive, rowValues, Array.map_empty] + | debug message data => + simp only [emitOp, Option.some.injEq] at emitted + subst emission + apply Bytecode.AIR.Step.primitive (advice := #[]) + simp only [Bytecode.AIR.primitive, rowValues, Array.map_empty] + | u8BitDecomposition index => exact emitByte1_step global _ emitted queried + | u8ShiftLeft index => exact emitByte1_step global _ emitted queried + | u8ShiftRight index => exact emitByte1_step global _ emitted queried + | u8Xor a b => exact emitByte2_step global _ emitted queried + | u8Add a b => exact emitByte2_step global _ emitted queried + | u8Sub a b => exact emitByte2_step global _ emitted queried + | u8And a b => exact emitByte2_step global _ emitted queried + | u8Or a b => exact emitByte2_step global _ emitted queried + | u8LessThan a b => exact emitByte2_step global _ emitted queried + | u8RangeCheck a b => exact emitByte2_step global _ emitted queried + | u8Mul a b => exact emitByte2_step global _ emitted queried + | u8XorSplit7 a b => exact emitByte2_step global _ emitted queried + | u8XorSplit4 a b => exact emitByte2_step global _ emitted queried + | u32LessThan a b => exact emitU32LessThan_step global _ emitted active satisfied queried + | unconstrainedBigUintDivMod a b => + simp only [emitOp, Option.some.injEq] at emitted + subst emission + apply Bytecode.AIR.Step.primitive (advice := rowValues (rowAdvice row 0 2)) + simp only [Bytecode.AIR.primitive, Bytecode.AIR.adviceOfSize, rowValues_advice_size, ite_true, emitAdvice] + | unconstrainedGToBytes index => + simp only [emitOp, Option.some.injEq] at emitted + subst emission + apply Bytecode.AIR.Step.primitive (advice := rowValues (rowAdvice row 0 8)) + simp only [Bytecode.AIR.primitive, Bytecode.AIR.adviceOfSize, rowValues_advice_size, ite_true, emitAdvice] + | unconstrainedGInverse index => + simp only [emitOp, Option.some.injEq] at emitted + subst emission + apply Bytecode.AIR.Step.primitive (advice := rowValues (rowAdvice row 0 1)) + simp only [Bytecode.AIR.primitive, Bytecode.AIR.adviceOfSize, rowValues_advice_size, ite_true, emitAdvice] + | unconstrainedU32Add a b => exact emitU32Add_step _ emitted + | unconstrainedU32Add3 a b c => exact emitU32Add3_step _ emitted + | u32ToField indices => + simp only [emitOp, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i word read + have equal := Option.some.inj emitted + subst emission + apply Bytecode.AIR.Step.primitive (advice := #[]) + simp only [Bytecode.AIR.primitive, readRowWord_value read, bind, Option.bind, + pure, rowValues_singleton] + +structure OpsEmission where + values : Array RowValue + column : Nat + equations : List G := [] + queries : List (List G) := [] + calls : List (Bytecode.AIR.Call × (Fin 6 → G)) := [] + +/-- Native operation order, including the logical map extension and exact +advance of the auxiliary-column cursor after each operation. -/ +def emitOps (row : Nat → G) (selector rank : G) : + List Op → Array RowValue → Nat → Option OpsEmission + | [], values, column => some { values, column } + | op :: ops, values, column => do + let first ← emitOp (fun i => row (column + i)) selector rank op values + let rest ← emitOps row selector rank ops (values ++ first.outputs) (column + first.used) + return { rest with + equations := first.equations ++ rest.equations + queries := first.queries ++ rest.queries + calls := first.calls ++ rest.calls } + +theorem rowValues_append (left right : Array RowValue) : + rowValues (left ++ right) = rowValues left ++ rowValues right := by + simp only [rowValues, Array.map_append] + +theorem emitOps_run {tables : LookupTables} {width : Nat} {queries : List (List G)} + (global : GlobalLookups tables width queries) + (memoryValid : ∀ size, MemoryRowsValid size (tables.memory size)) + (canonical : ∀ size ∈ tables.memoryWidths, size < gSize.toNat) + {program : Toplevel} {ops : List Op} (shapes : ∀ op ∈ ops, op.lookupShape program = true) + {row : Nat → G} {selector rank : G} {values : Array RowValue} {column : Nat} + {emission : OpsEmission} (emitted : emitOps row selector rank ops values column = some emission) + (active : selector = 1) (satisfied : ∀ equation ∈ emission.equations, equation = 0) + (queried : emission.queries ⊆ queries) : + Bytecode.AIR.RunOps (memoryFacts tables.memory) ops (rowValues values) + (rowValues emission.values) (emission.calls.map Prod.fst) := by + induction ops generalizing values column emission with + | nil => + simp only [emitOps, Option.some.injEq] at emitted + subst emission + exact Bytecode.AIR.RunOps.nil + | cons op ops ih => + simp only [emitOps, bind, Option.bind] at emitted + split at emitted + · cases emitted + · rename_i first firstEmitted + dsimp only at emitted + split at emitted + · cases emitted + · rename_i rest restEmitted + have equal := Option.some.inj emitted + subst emission + have firstStep := emitOp_step global memoryValid canonical (shapes op List.mem_cons_self) + firstEmitted active + (fun equation member => satisfied equation (List.mem_append_left _ member)) + (fun message member => queried (List.mem_append_left _ member)) + have restRun := ih (fun op member => shapes op (List.mem_cons_of_mem _ member)) + restEmitted (fun equation member => satisfied equation (List.mem_append_right _ member)) + (fun message member => queried (List.mem_append_right _ member)) + rw [rowValues_append] at restRun + simpa only [List.map_append] using Bytecode.AIR.RunOps.cons firstStep restRun + +end Aiur.AIR diff --git a/Ix/Aiur/Proofs/ProviderEquivalence.lean b/Ix/Aiur/Proofs/ProviderEquivalence.lean new file mode 100644 index 000000000..2b4c940e1 --- /dev/null +++ b/Ix/Aiur/Proofs/ProviderEquivalence.lean @@ -0,0 +1,103 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.CircuitRowCounts +import Ix.Aiur.Proofs.CircuitPoolExecution + +/-! Provider replacement preserves padded balance when multiplicities and +nonzero messages agree. A satisfying nonzero circuit provides an actual +return message before any operation or function-row interpretation. -/ + +namespace Aiur.AIR + +/-- Providers have the same contribution to every padded-message balance. +The raw message of a zero-weight provider has no effect. -/ +def Provider.PaddedEq (width : Nat) (left right : Provider (List G)) : Prop := + left.2 = right.2 ∧ (left.2 ≠ 0 → padMessage width left.1 = padMessage width right.1) + +theorem Provider.PaddedEq.refl (width : Nat) (provider : Provider (List G)) : + PaddedEq width provider provider := ⟨rfl, fun _ => rfl⟩ + +theorem Provider.PaddedEq.symm {width : Nat} {left right : Provider (List G)} + (same : PaddedEq width left right) : PaddedEq width right left := + ⟨same.1.symm, fun nonzero => (same.2 (same.1 ▸ nonzero)).symm⟩ + +theorem Provider.PaddedEq.trans {width : Nat} {left middle right : Provider (List G)} + (first : PaddedEq width left middle) (last : PaddedEq width middle right) : PaddedEq width left right := + ⟨first.1.trans last.1, fun nonzero => (first.2 nonzero).trans (last.2 (first.1 ▸ nonzero))⟩ + +theorem suppliedWeight_padded_congr {width : Nat} {left right : List (Provider (List G))} + (related : List.Forall₂ (Provider.PaddedEq width) left right) (message : List G) : + suppliedWeight message (mapProviders (padMessage width) left) = + suppliedWeight message (mapProviders (padMessage width) right) := by + induction related with + | nil => rfl + | @cons first last rest rest' head tail ih => + change (if padMessage width first.1 = message then + first.2 + suppliedWeight message (mapProviders (padMessage width) rest) + else suppliedWeight message (mapProviders (padMessage width) rest)) = + (if padMessage width last.1 = message then + last.2 + suppliedWeight message (mapProviders (padMessage width) rest') + else suppliedWeight message (mapProviders (padMessage width) rest')) + by_cases zero : first.2 = 0 + · have lastZero := head.1.symm.trans zero + simp only [zero, lastZero, G.zero_add, ite_self, ih] + · rw [head.2 zero, head.1, ih] + +theorem PaddedLookupBalance.congr_providers {width : Nat} {queries : List (List G)} + {left right : List (Provider (List G))} (balanced : PaddedLookupBalance width queries left) + (related : List.Forall₂ (Provider.PaddedEq width) left right) : + PaddedLookupBalance width queries right := fun message => + (balanced message).trans (suppliedWeight_padded_congr related message) + +theorem paddedProviders_refl (width : Nat) (providers : List (Provider (List G))) : + List.Forall₂ (Provider.PaddedEq width) providers providers := by + induction providers with + | nil => exact .nil + | cons provider rest ih => exact .cons (Provider.PaddedEq.refl width provider) ih + +def CircuitEmission.provider (emission : CircuitEmission) : Provider (List G) := + ((emission.lookup 0).2, emission.multiplicity) + +theorem CircuitEmission.provider_multiplicity (emission : CircuitEmission) : + (emission.lookup 0).1 = 0 - emission.provider.2 := rfl + +end Aiur.AIR + +namespace Aiur.Bytecode +open Aiur.AIR + +theorem Circuit.emitRow_provider (row : Nat → G) (program : Toplevel) (circuit : Circuit) + {emission : CircuitEmission} (emitted : circuit.emitRow row program = some emission) + (validated : circuit.validateRowCounts program = true) + (shape : ∀ part ∈ emission.members, part.function.body.lookupShapes program none = true) + (satisfied : ∀ equation ∈ emission.equations, equation = 0) + (nonzero : emission.multiplicity ≠ 0) (width : Nat) : + ∃ request : AIR.Call, (1, request) ∈ emission.returns ∧ + padMessage width (emission.lookup 0).2 = padMessage width (functionMessage request) := by + obtain ⟨bounded, _, returnBound, single⟩ := circuit.emitRow_count_bounds row program emitted validated satisfied + obtain ⟨description, indices, source⟩ := circuit.emitRow_spec row program emitted + have size := congrArg List.length indices + simp only [List.length_map, Array.length_toList] at size + have valid : ∀ equation ∈ (circuitEmission row circuit emission.members).equations, equation = 0 := by + rw [← description] + exact satisfied + have active : (circuitEmission row circuit emission.members).selector = 1 := + nonzero_multiplicity_selector_one (circuitEmission_activity valid) (by + rw [← description] + exact nonzero) + have count := circuitEmission_return_count source shape (by omega) returnBound valid active + rw [← description] at count + have present : (1 : G) ∈ emission.returns.map Prod.fst := List.count_pos_iff.mp (by rw [count]; decide) + obtain ⟨⟨gate, request⟩, member, gateEq⟩ := List.mem_map.mp present + change gate = 1 at gateEq + subst gate + refine ⟨request, member, ?_⟩ + have message := circuitEmission_return_message source shape (by omega) returnBound valid active width + (by rw [← description]; exact single) (by rw [← description]; exact member) + rw [← description] at message + exact message + +end Aiur.Bytecode diff --git a/Ix/Aiur/Proofs/PublicCircuitExecution.lean b/Ix/Aiur/Proofs/PublicCircuitExecution.lean new file mode 100644 index 000000000..5239dac92 --- /dev/null +++ b/Ix/Aiur/Proofs/PublicCircuitExecution.lean @@ -0,0 +1,78 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.CircuitTableExecution + +/-! Finite execution of the selected public success call from valued circuit +witnesses. Public rank-zero padding is normalized without changing lookup +balance. Native witness/lookup reflection and cryptographic reduction remain +separate obligations. -/ + +namespace Aiur.AIR + +theorem PaddedLookupBalance.congr_queries {width : Nat} {left right : List (List G)} + {providers : List (Provider (List G))} (balanced : PaddedLookupBalance width left providers) + (same : left.map (padMessage width) = right.map (padMessage width)) : + PaddedLookupBalance width right providers := by + change ExactLookupBalance _ _ at balanced ⊢ + rwa [← same] + +end Aiur.AIR + +namespace Aiur.BoundVerifier +open AIR Bytecode.AIR + +theorem claim_message (selection : Selection) (input : Array G) : + functionMessage ⟨selection.function, input, selection.success, 0⟩ = + (buildClaim selection.function input selection.success).toList ++ [0] := by + simp only [functionMessage, buildClaim, Array.toList_append, List.cons_append, + List.nil_append, functionChannel] + rfl + +/-- The selected public success call executes from valued circuit witnesses +and their physical provider balance. The public query has the actual claim +encoding, whose omitted rank is zero. Native witness extraction, lookup-slot +encoding/layout reflection and the cryptographic reduction remain separate. -/ +theorem Backend.public_circuit_execution {selection : Selection} (backend : Backend selection) + (tables : AuxiliaryTables) (witnesses : List CircuitWitness) (width : Nat) + (input : Array G) (arity : input.size = selection.inputSize) + (balanced : PaddedLookupBalance width + ((buildClaim selection.function input selection.success).toList :: + circuitQueryPool (witnesses.map (·.emission))) + (tables.circuitProviders (witnesses.map (·.emission)))) + (bounded : (circuitQueryPool (witnesses.map (·.emission))).length + 1 < gSize.toNat) + (publicWidth : (buildClaim selection.function input selection.success).size + 1 ≤ width) + (queryWidths : ∀ query ∈ circuitQueryPool (witnesses.map (·.emission)), query.length ≤ width) + (memoryValid : ∀ size, MemoryRowsValid size (tables.memory size)) + (canonical : ∀ size ∈ tables.memoryWidths, size < gSize.toNat) + (circuits : ∀ witness ∈ witnesses, witness.circuit ∈ backend.compiled.bytecode.circuits) + (emitted : ∀ witness ∈ witnesses, witness.Emitted backend.compiled.bytecode) + (satisfied : ∀ witness ∈ witnesses, witness.Satisfied) + (shapes : ∀ witness ∈ witnesses, witness.Shapes backend.compiled.bytecode) + (limits : ∀ witness ∈ witnesses, witness.LookupBounds) : + Execution backend.compiled.bytecode (memoryFacts tables.memory) + ⟨selection.function, input, selection.success, 0⟩ := by + let request : Call := ⟨selection.function, input, selection.success, 0⟩ + have normalized : PaddedLookupBalance width + (functionMessage request :: circuitQueryPool (witnesses.map (·.emission))) + (tables.circuitProviders (witnesses.map (·.emission))) := by + apply balanced.congr_queries + change padMessage width (buildClaim selection.function input selection.success).toList :: _ = + padMessage width (functionMessage request) :: _ + rw [show padMessage width (functionMessage request) = + padMessage width (buildClaim selection.function input selection.success).toList from + claim_padding selection width input] + apply circuitWitnesses_execute tables witnesses normalized bounded ?_ memoryValid canonical + backend.rowCounts backend.lookupShapes circuits emitted satisfied shapes limits + (fun _ member => List.mem_cons_of_mem _ member) (backend.root_lookupShape input arity) List.mem_cons_self + intro query member + rcases List.mem_cons.mp member with same | rest + · subst query + change (functionMessage ⟨selection.function, input, selection.success, 0⟩).length ≤ width + rw [claim_message, List.length_append, List.length_singleton, Array.length_toList] + exact publicWidth + · exact queryWidths query rest + +end Aiur.BoundVerifier diff --git a/Ix/Aiur/Proofs/QuerySlotMessages.lean b/Ix/Aiur/Proofs/QuerySlotMessages.lean new file mode 100644 index 000000000..2de72f2ce --- /dev/null +++ b/Ix/Aiur/Proofs/QuerySlotMessages.lean @@ -0,0 +1,216 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.BlockQuerySlots + +/-! +Decode the unique active query in each valued lookup slot. Its message +equals the native-style combined message after padding, and its multiplicity +is zero or one. The decoded list preserves exact padded lookup balance and +has at most one query per allocated slot. + +The single-writer premise for ungated branchless slots remains explicit. +The model-to-native and randomized-compression reductions are separate. +-/ + +namespace Aiur.AIR + +def activeQuerySlot (queries : List QueryPart) (slot : Nat) : List QueryPart := + queries.filter fun query => query.slot == slot && query.selector == 1 + +def querySlotParts (queries : List QueryPart) (slot : Nat) : List (G × List G) := + (queries.filter fun query => query.slot == slot).map fun query => (query.selector, query.message) + +def querySlotMultiplicity (queries : List QueryPart) (slot : Nat) : G := + selectorSum ((querySlotParts queries slot).map Prod.fst) + +def decodedQuery (queries : List QueryPart) (slot : Nat) : Option (List G) := + (activeQuerySlot queries slot).head?.map (·.message) + +def encodedQuery (branchless : Bool) (queries : List QueryPart) (slot : Nat) : Option (List G) := + if querySlotMultiplicity queries slot = 1 then some (slotMessage branchless (querySlotParts queries slot)) + else none + +def decodedQueries (queries : List QueryPart) (limit : Nat) : List (List G) := + (List.range limit).filterMap (decodedQuery queries) + +def encodedQueries (branchless : Bool) (queries : List QueryPart) (limit : Nat) : List (List G) := + (List.range limit).filterMap (encodedQuery branchless queries) + +theorem singleton_of_member_length_le_one {α : Type} {items : List α} {item : α} + (member : item ∈ items) (bound : items.length ≤ 1) : items = [item] := by + cases items with + | nil => cases member + | cons head tail => + have empty : tail = [] := List.length_eq_zero_iff.mp (by simp only [List.length_cons] at bound; omega) + subst tail + have equal := List.mem_singleton.mp member + subst item + rfl + +theorem selector_pair_chosen_count {α : Type} {parts : List (G × α)} + (individual : ∀ part ∈ parts, booleanConstraint part.1 = 0) + (count : (parts.map Prod.fst).count 1 = 1) + {chosen : G × α} (member : chosen ∈ parts) (active : chosen.1 = 1) : + ∃ before after, parts = before ++ chosen :: after ∧ + ∀ part ∈ before ++ after, part.1 = 0 := by + obtain ⟨before, after, equal⟩ := List.mem_iff_append.mp member + have counts := count + rw [equal, List.map_append, List.count_append, List.map_cons, active, List.count_cons_self] at counts + have empty : ((before ++ after).map Prod.fst).count 1 = 0 := by + rw [List.map_append, List.count_append] + omega + have absent := List.count_eq_zero.mp empty + refine ⟨before, after, equal, ?_⟩ + intro part present + have original : part ∈ parts := by + rw [equal] + rcases List.mem_append.mp present with left | right + · exact List.mem_append_left _ left + · exact List.mem_append_right _ (List.mem_cons_of_mem _ right) + rcases G.boolean_of_constraint (individual part original) with inactive | selected + · exact inactive + · exact False.elim (absent (List.mem_map.mpr ⟨part, present, selected⟩)) + +theorem slotMessage_chosen_count (width : Nat) (branchless : Bool) {parts : List (G × List G)} + (single : branchless = true → parts.length ≤ 1) + (individual : ∀ part ∈ parts, booleanConstraint part.1 = 0) + (count : (parts.map Prod.fst).count 1 = 1) + {chosen : G × List G} (member : chosen ∈ parts) (active : chosen.1 = 1) : + padMessage width (slotMessage branchless parts) = padMessage width chosen.2 := by + cases branchless with + | false => + obtain ⟨before, after, equal, zero⟩ := selector_pair_chosen_count individual count member active + rw [equal] + exact weightedMessage_split width before after chosen active zero + | true => + rw [singleton_of_member_length_le_one member (single rfl)] + rfl + +theorem querySlotParts_count (queries : List QueryPart) (slot : Nat) : + ((querySlotParts queries slot).map Prod.fst).count 1 = queryCount queries slot := by + rw [querySlotParts, List.map_map, List.count_eq_countP, List.countP_map, + List.countP_eq_length_filter, List.filter_filter] + simp only [Function.comp_def, queryCount, Bool.and_comm] + +theorem querySlotParts_member {queries : List QueryPart} {query : QueryPart} + (member : query ∈ queries) : (query.selector, query.message) ∈ querySlotParts queries query.slot := by + apply List.mem_map.mpr + exact ⟨query, List.mem_filter.mpr ⟨member, by simp⟩, rfl⟩ + +theorem QuerySlots.slot_boolean {gate : G} {start finish : Nat} {queries : List QueryPart} + (slots : QuerySlots gate start finish queries) (slot : Nat) : + ∀ part ∈ querySlotParts queries slot, booleanConstraint part.1 = 0 := by + intro part member + obtain ⟨query, queryMember, equal⟩ := List.mem_map.mp member + subst part + exact slots.boolean query (List.mem_filter.mp queryMember).1 + +theorem QuerySlots.slot_multiplicity {gate : G} {start finish : Nat} {queries : List QueryPart} + (slots : QuerySlots gate start finish queries) (slot : Nat) : + querySlotMultiplicity queries slot = G.ofNat (queryCount queries slot) := by + rw [querySlotMultiplicity, selectorSum_eq_count] + · rw [querySlotParts_count] + · intro value member + obtain ⟨part, partMember, equal⟩ := List.mem_map.mp member + subst value + exact G.boolean_of_constraint (slots.slot_boolean slot part partMember) + +theorem QuerySlots.multiplicity_boolean {gate : G} {start finish : Nat} {queries : List QueryPart} + (slots : QuerySlots gate start finish queries) (slot : Nat) : + querySlotMultiplicity queries slot = 0 ∨ querySlotMultiplicity queries slot = 1 := by + have bound := Nat.le_trans (slots.count slot) (gateCount_le_one gate) + have count : queryCount queries slot = 0 ∨ queryCount queries slot = 1 := by omega + rw [slots.slot_multiplicity slot] + rcases count with zero | one + · rw [zero] + exact Or.inl rfl + · rw [one] + exact Or.inr rfl + +theorem QuerySlots.active_singleton {gate : G} {start finish : Nat} {queries : List QueryPart} + (slots : QuerySlots gate start finish queries) {query : QueryPart} + (member : query ∈ queries) (active : query.selector = 1) : + activeQuerySlot queries query.slot = [query] := by + apply singleton_of_member_length_le_one + · exact List.mem_filter.mpr ⟨member, by simp only [Bool.and_eq_true, beq_iff_eq]; exact ⟨trivial, active⟩⟩ + · exact Nat.le_trans (slots.count _) (gateCount_le_one gate) + +theorem QuerySlots.decoded {gate : G} {start finish : Nat} {queries : List QueryPart} + (slots : QuerySlots gate start finish queries) {query : QueryPart} + (member : query ∈ queries) (active : query.selector = 1) : + decodedQuery queries query.slot = some query.message := by + rw [decodedQuery, slots.active_singleton member active] + rfl + +theorem QuerySlots.decoded_member {gate : G} {start finish : Nat} {queries : List QueryPart} + (slots : QuerySlots gate start finish queries) {query : QueryPart} + (member : query ∈ queries) (active : query.selector = 1) : + query.message ∈ decodedQueries queries finish := by + apply List.mem_filterMap.mpr + exact ⟨query.slot, List.mem_range.mpr (slots.range query member).2, slots.decoded member active⟩ + +theorem QuerySlots.slot_message {gate : G} {start finish : Nat} {queries : List QueryPart} + (slots : QuerySlots gate start finish queries) (width : Nat) (branchless : Bool) + (single : branchless = true → ∀ slot, (querySlotParts queries slot).length ≤ 1) + {query : QueryPart} (member : query ∈ queries) (active : query.selector = 1) : + padMessage width (slotMessage branchless (querySlotParts queries query.slot)) = padMessage width query.message := by + have count : queryCount queries query.slot = 1 := + congrArg List.length (slots.active_singleton member active) + exact slotMessage_chosen_count width branchless (fun enabled => single enabled query.slot) + (slots.slot_boolean _) ((querySlotParts_count _ _).trans count) + (querySlotParts_member member) active + +theorem QuerySlots.slot_reflects {gate : G} {start finish : Nat} {queries : List QueryPart} + (slots : QuerySlots gate start finish queries) (width : Nat) (branchless : Bool) + (single : branchless = true → ∀ slot, (querySlotParts queries slot).length ≤ 1) (slot : Nat) : + (encodedQuery branchless queries slot).map (padMessage width) = + (decodedQuery queries slot).map (padMessage width) := by + cases found : activeQuerySlot queries slot with + | nil => + have count : queryCount queries slot = 0 := congrArg List.length found + have inactive : querySlotMultiplicity queries slot = 0 := by rw [slots.slot_multiplicity slot, count]; rfl + simp only [encodedQuery, decodedQuery, found, inactive, Ne.symm G.one_ne_zero, if_false, + List.head?_nil, Option.map_none] + | cons query rest => + have member : query ∈ activeQuerySlot queries slot := by rw [found]; exact List.mem_cons_self + obtain ⟨original, same, active⟩ := by + simpa only [activeQuerySlot, List.mem_filter, Bool.and_eq_true, beq_iff_eq] using member + have singleton := slots.active_singleton original active + rw [same] at singleton + have count : queryCount queries slot = 1 := congrArg List.length singleton + have multiplicity : querySlotMultiplicity queries slot = 1 := by rw [slots.slot_multiplicity slot, count]; rfl + have message := slots.slot_message width branchless single original active + rw [same] at message + simp only [encodedQuery, decodedQuery, singleton, multiplicity, if_true, + List.head?_cons, Option.map_some] + exact congrArg some message + +theorem QuerySlots.queries_reflect {gate : G} {start finish : Nat} {queries : List QueryPart} + (slots : QuerySlots gate start finish queries) (width : Nat) (branchless : Bool) + (single : branchless = true → ∀ slot, (querySlotParts queries slot).length ≤ 1) (limit : Nat) : + (encodedQueries branchless queries limit).map (padMessage width) = + (decodedQueries queries limit).map (padMessage width) := by + simp only [encodedQueries, decodedQueries, List.map_filterMap] + apply congrArg (fun read : Nat → Option (List G) => (List.range limit).filterMap read) + funext slot + exact slots.slot_reflects width branchless single slot + +theorem QuerySlots.padded_balance {gate : G} {start finish : Nat} {queries : List QueryPart} + (slots : QuerySlots gate start finish queries) (width : Nat) (branchless : Bool) + (single : branchless = true → ∀ slot, (querySlotParts queries slot).length ≤ 1) + (limit : Nat) (providers : List (Provider (List G))) + (balanced : PaddedLookupBalance width (encodedQueries branchless queries limit) providers) : + PaddedLookupBalance width (decodedQueries queries limit) providers := by + unfold PaddedLookupBalance at balanced ⊢ + rw [← slots.queries_reflect width branchless single limit] + exact balanced + +theorem decodedQueries_length (queries : List QueryPart) (limit : Nat) : + (decodedQueries queries limit).length ≤ limit := by + simpa only [decodedQueries, List.length_range] using + List.length_filterMap_le (decodedQuery queries) (List.range limit) + +end Aiur.AIR diff --git a/Ix/Aiur/Proofs/QuerySlots.lean b/Ix/Aiur/Proofs/QuerySlots.lean new file mode 100644 index 000000000..0f9d6d5e4 --- /dev/null +++ b/Ix/Aiur/Proofs/QuerySlots.lean @@ -0,0 +1,203 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.FunctionRows + +/-! +Lookup-slot intervals and natural active-query counts. Sequential regions +are disjoint, while shared regions combine bounded selector families. The +count invariant excludes duplicate active contributions without requiring +the number of inactive writers in a slot to fit the field characteristic. +-/ + +namespace Aiur.AIR +open Bytecode + +def gateCount (gate : G) : Nat := if gate = 1 then 1 else 0 + +def queryCount (queries : List QueryPart) (slot : Nat) : Nat := + (queries.filter fun query => query.slot == slot && query.selector == 1).length + +structure QuerySlots (gate : G) (start finish : Nat) (queries : List QueryPart) : Prop where + extent : start ≤ finish + range : ∀ query ∈ queries, start ≤ query.slot ∧ query.slot < finish + boolean : ∀ query ∈ queries, booleanConstraint query.selector = 0 + count : ∀ slot, queryCount queries slot ≤ gateCount gate + +theorem gateCount_le_one (gate : G) : gateCount gate ≤ 1 := by + simp only [gateCount] + split <;> omega + +theorem gateCount_zero : gateCount 0 = 0 := by + simp [gateCount, Ne.symm G.one_ne_zero] + +theorem queryCount_append (first rest : List QueryPart) (slot : Nat) : + queryCount (first ++ rest) slot = queryCount first slot + queryCount rest slot := by + simp only [queryCount, List.filter_append, List.length_append] + +theorem QuerySlots.empty (gate : G) (start : Nat) : QuerySlots gate start start [] := + ⟨Nat.le_refl _, by simp, by simp, by simp [queryCount]⟩ + +theorem QuerySlots.outside {gate : G} {start finish : Nat} {queries : List QueryPart} + (slots : QuerySlots gate start finish queries) (slot : Nat) + (outside : slot < start ∨ finish ≤ slot) : queryCount queries slot = 0 := by + apply List.length_eq_zero_iff.mpr + apply List.filter_eq_nil_iff.mpr + intro query member + have range := slots.range query member + simp only [Bool.and_eq_true, beq_iff_eq] + intro same + omega + +theorem QuerySlots.weaken {first last : G} {start finish : Nat} {queries : List QueryPart} + (slots : QuerySlots first start finish queries) (bound : gateCount first ≤ gateCount last) : + QuerySlots last start finish queries := + ⟨slots.extent, slots.range, slots.boolean, fun slot => Nat.le_trans (slots.count slot) bound⟩ + +theorem QuerySlots.append {gate : G} {start middle finish : Nat} {first rest : List QueryPart} + (left : QuerySlots gate start middle first) (right : QuerySlots gate middle finish rest) : + QuerySlots gate start finish (first ++ rest) := by + refine ⟨Nat.le_trans left.extent right.extent, ?_, ?_, ?_⟩ + · intro query member + rcases List.mem_append.mp member with before | after + · have range := left.range query before + exact ⟨range.1, Nat.lt_of_lt_of_le range.2 right.extent⟩ + · have range := right.range query after + exact ⟨Nat.le_trans left.extent range.1, range.2⟩ + · intro query member + rcases List.mem_append.mp member with before | after + · exact left.boolean query before + · exact right.boolean query after + · intro slot + rw [queryCount_append] + by_cases before : slot < middle + · rw [right.outside slot (Or.inl before), Nat.add_zero] + exact left.count slot + · rw [left.outside slot (Or.inr (by omega)), Nat.zero_add] + exact right.count slot + +theorem QuerySlots.single (gate : G) (slot : Nat) (message : List G) + (boolean : booleanConstraint gate = 0) : + QuerySlots gate slot (slot + 1) [⟨slot, gate, message⟩] := by + refine ⟨by omega, ?_, ?_, ?_⟩ + · intro query member + have same := List.mem_singleton.mp member + subst query + exact ⟨Nat.le_refl _, Nat.lt_succ_self slot⟩ + · intro query member + have same := List.mem_singleton.mp member + subst query + exact boolean + · intro index + simp only [queryCount, gateCount, List.filter_cons, List.filter_nil, + Bool.and_eq_true, beq_iff_eq] + split + · rename_i selected + rw [selected.2] + exact Nat.le_refl 1 + · exact Nat.zero_le _ + +theorem queryParts_cons (slot : Nat) (gate : G) (message : List G) (queries : List (List G)) : + queryParts slot gate (message :: queries) = + ⟨slot, gate, message⟩ :: queryParts (slot + 1) gate queries := by + simp [queryParts, List.mapIdx_cons, Nat.add_comm, Nat.add_left_comm] + +theorem QuerySlots.indexed (gate : G) (slot : Nat) (queries : List (List G)) + (boolean : booleanConstraint gate = 0) : + QuerySlots gate slot (slot + queries.length) (queryParts slot gate queries) := by + induction queries generalizing slot with + | nil => exact QuerySlots.empty gate slot + | cons message queries ih => + rw [queryParts_cons] + have result := (QuerySlots.single gate slot message boolean).append (ih (slot + 1)) + simpa only [List.singleton_append, List.length_cons, Nat.add_assoc, + Nat.add_comm 1 queries.length] using result + +theorem fold_lookup_start (emissions : List BlockEmission) (start : Nat) : + start ≤ emissions.foldl (fun current emission => max current emission.lookup) start := by + induction emissions generalizing start with + | nil => exact Nat.le_refl _ + | cons emission emissions ih => + exact Nat.le_trans (Nat.le_max_left start emission.lookup) (ih _) + +theorem fold_lookup_member {emissions : List BlockEmission} {emission : BlockEmission} + (member : emission ∈ emissions) (start : Nat) : + emission.lookup ≤ emissions.foldl (fun current emission => max current emission.lookup) start := by + induction emissions generalizing start with + | nil => cases member + | cons head rest ih => + rcases List.mem_cons.mp member with equal | tail + · subst emission + exact Nat.le_trans (Nat.le_max_right start head.lookup) (fold_lookup_start rest _) + · exact ih tail _ + +theorem gateCount_list (gates : List G) : (gates.map gateCount).sum = gates.count 1 := by + induction gates with + | nil => rfl + | cons gate gates ih => + by_cases active : gate = 1 + · subst gate + simp [gateCount, ih, List.count_cons_self, Nat.add_comm] + · simp [gateCount, active, ih] + +theorem selector_gateCount {gates : List G} + (individual : ∀ gate ∈ gates, booleanConstraint gate = 0) + (bounded : gates.length < gSize.toNat) + (combined : booleanConstraint (selectorSum gates) = 0) : + gates.count 1 = gateCount (selectorSum gates) := by + have count := selectorSum_n_eq_count + (fun gate member => G.boolean_of_constraint (individual gate member)) bounded + rcases G.boolean_of_constraint combined with inactive | active + · rw [inactive, gateCount_zero] + exact count.symm.trans (congrArg G.n inactive) + · rw [active] + exact count.symm.trans (congrArg G.n active) + +theorem queryCount_flatMap_le {α : Type} {source : List α} {emissions : List BlockEmission} + (gate : α → G) (start : Nat) + (related : List.Forall₂ (fun item emission => + QuerySlots (gate item) start emission.lookup emission.queries) source emissions) (slot : Nat) : + queryCount (emissions.flatMap (·.queries)) slot ≤ ((source.map gate).map gateCount).sum := by + induction related with + | nil => exact Nat.le_refl 0 + | @cons item emission items emissions first rest ih => + simp only [List.flatMap_cons, queryCount_append, List.map_cons, List.sum_cons] + exact Nat.add_le_add (first.count slot) ih + +theorem forall₂_right_member {α β : Type} {source : List α} {target : List β} + {relation : α → β → Prop} (related : List.Forall₂ relation source target) + {item : β} (member : item ∈ target) : ∃ original ∈ source, relation original item := by + induction related with + | nil => cases member + | @cons head result heads results first rest ih => + rcases List.mem_cons.mp member with equal | tail + · subst item + exact ⟨head, List.mem_cons_self, first⟩ + · obtain ⟨original, present, evidence⟩ := ih tail + exact ⟨original, List.mem_cons_of_mem _ present, evidence⟩ + +theorem QuerySlots.join {α : Type} {source : List α} {emissions : List BlockEmission} + (gate : α → G) (parent : G) (values : Array RowValue) (column lookup : Nat) + (related : List.Forall₂ (fun item emission => + QuerySlots (gate item) lookup emission.lookup emission.queries) source emissions) + (count : (source.map gate).count 1 ≤ gateCount parent) : + QuerySlots parent lookup (joinBlockEmissions values column lookup emissions).lookup + (joinBlockEmissions values column lookup emissions).queries := by + refine ⟨fold_lookup_start emissions lookup, ?_, ?_, ?_⟩ + · intro query member + obtain ⟨emission, emissionMember, queryMember⟩ := List.mem_flatMap.mp member + obtain ⟨item, _, evidence⟩ := forall₂_right_member related emissionMember + have range := evidence.range query queryMember + exact ⟨range.1, Nat.lt_of_lt_of_le range.2 (fold_lookup_member emissionMember lookup)⟩ + · intro query member + obtain ⟨emission, emissionMember, queryMember⟩ := List.mem_flatMap.mp member + obtain ⟨item, _, evidence⟩ := forall₂_right_member related emissionMember + exact evidence.boolean query queryMember + · intro slot + have bounded := queryCount_flatMap_le gate lookup related slot + rw [gateCount_list] at bounded + exact Nat.le_trans bounded count + +end Aiur.AIR diff --git a/Ix/Aiur/Proofs/Renaming.lean b/Ix/Aiur/Proofs/Renaming.lean new file mode 100644 index 000000000..ac1117f3d --- /dev/null +++ b/Ix/Aiur/Proofs/Renaming.lean @@ -0,0 +1,284 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Compiler.Dedup +import Ix.Aiur.Semantics.BytecodeEval + +/-! Exact successful-execution equivalence under checked function renaming. +The relation retains memory, I/O and the early-return escape channel. -/ + +namespace Aiur.Bytecode.Eval + +/-- Function renaming preserves the call domain, every rewritten body and +the input arity. It may merge multiple old functions into one target. -/ +structure RenamedCode (a b : Toplevel) (rename : FunIdx → FunIdx) : Prop where + domain : ∀ i, i < a.functions.size ↔ rename i < b.functions.size + body : ∀ i (ha : i < a.functions.size) (hb : rename i < b.functions.size), + rewriteBlock rename a.functions[i].body = b.functions[rename i].body + inputSize : ∀ i (ha : i < a.functions.size) (hb : rename i < b.functions.size), + a.functions[i].layout.inputSize = b.functions[rename i].layout.inputSize + +/-- Errors may contain function indices changed by renaming. Successful +results and the evaluator's early-return channel retain their full values. -/ +def returnObservation : BytecodeError → Option (Array G × EvalState) + | .earlyReturn outs st => some (outs, st) + | _ => none + +def observe (result : Except BytecodeError α) : Except (Option (Array G × EvalState)) α := + result.mapError returnObservation + +theorem observe_ok_iff {result : Except BytecodeError α} {value : α} : + observe result = .ok value ↔ result = .ok value := by + cases result <;> simp [observe, Except.mapError] + +theorem observe_bind {x y : Except BytecodeError α} + (h : observe x = observe y) {f g : α → Except BytecodeError β} + (hf : ∀ value, observe (f value) = observe (g value)) : + observe (match x with | .error e => .error e | .ok value => f value) = + observe (match y with | .error e => .error e | .ok value => g value) := by + cases x <;> cases y <;> simp_all [observe, Except.mapError] + +theorem observe_pairBind {x y : Except BytecodeError (Array G × EvalState)} + (h : observe x = observe y) {f g : Array G → EvalState → Except BytecodeError β} + (hf : ∀ outs st, observe (f outs st) = observe (g outs st)) : + observe (match x with | .error e => .error e | .ok (outs, st) => f outs st) = + observe (match y with | .error e => .error e | .ok (outs, st) => g outs st) := by + cases x <;> cases y <;> simp_all [observe, Except.mapError] + +private def finishCall (st : EvalState) (outputSize : Nat) + (result : Except BytecodeError (Array G × EvalState)) : Except BytecodeError EvalState := + match result with + | .error (.earlyReturn outs innerSt) | .ok (outs, innerSt) => + if outs.size != outputSize then .error .callOutputSizeMismatch + else .ok (appendMap (setIoBuffer { st with memory := innerSt.memory } innerSt.ioBuffer) outs) + | .error e => .error e + +private def finishObservedCall (st : EvalState) (outputSize : Nat) + (result : Except (Option (Array G × EvalState)) (Array G × EvalState)) : + Except (Option (Array G × EvalState)) EvalState := + match result with + | .error (some (outs, innerSt)) | .ok (outs, innerSt) => + if outs.size != outputSize then .error none + else .ok (appendMap (setIoBuffer { st with memory := innerSt.memory } innerSt.ioBuffer) outs) + | .error none => .error none + +private theorem observe_finishCall (st : EvalState) (outputSize : Nat) + (result : Except BytecodeError (Array G × EvalState)) : + observe (finishCall st outputSize result) = + finishObservedCall st outputSize (observe result) := by + cases result with + | ok value => + rcases value with ⟨outs, innerSt⟩ + by_cases h : outs.size != outputSize <;> + simp [finishCall, finishObservedCall, observe, Except.mapError, returnObservation, h] + | error error => + cases error <;> try rfl + case earlyReturn outs innerSt => + by_cases h : outs.size != outputSize <;> + simp [finishCall, finishObservedCall, observe, Except.mapError, returnObservation, h] + +private theorem ops_lt (b : Block) : sizeOf b.ops < sizeOf b := by + cases b; simp; omega + +private theorem ctrl_lt (b : Block) : sizeOf b.ctrl < sizeOf b := by + cases b; simp; omega + +private theorem case_lt (cases : Array (G × Block)) (fallback : Option Block) + (i : Nat) (h : i < cases.size) : + sizeOf cases[i].2 < sizeOf cases + sizeOf fallback := by + have h1 := Array.sizeOf_get cases i h + have h2 : sizeOf cases[i].2 < sizeOf cases[i] := by + cases cases[i]; simp; omega + omega + +mutual + +theorem evalOp_renamed {a b : Toplevel} {rename : FunIdx → FunIdx} + (code : RenamedCode a b rename) (fuel : Nat) (op : Op) (st : EvalState) : + observe (evalOp a fuel op st) = observe (evalOp b fuel (rewriteOp rename op) st) := by + cases op <;> simp only [rewriteOp, evalOp] + all_goals try rfl + case call fi args outputSize unconstrained => + cases hg : readIdxs st args with + | error e => rfl + | ok gs => + simp only [bind, Except.bind] + by_cases ha : fi < a.functions.size + · have hb := (code.domain fi).mp ha + simp only [dif_pos ha, dif_pos hb, code.inputSize fi ha hb] + split + · rfl + · cases fuel with + | zero => rfl + | succ fuel => + change observe (finishCall st outputSize (evalBlock a fuel a.functions[fi].body _)) = + observe (finishCall st outputSize (evalBlock b fuel b.functions[rename fi].body _)) + rw [observe_finishCall, observe_finishCall, + ← code.body fi ha hb, evalBlock_renamed code] + · have hb : ¬ rename fi < b.functions.size := by simpa [← code.domain fi] using ha + simp only [dif_neg ha, dif_neg hb] + rfl +termination_by (fuel, sizeOf op, 0) +decreasing_by all_goals first | decreasing_tactic | omega + +theorem runOps_renamed {a b : Toplevel} {rename : FunIdx → FunIdx} + (code : RenamedCode a b rename) (fuel : Nat) (ops : Array Op) (st : EvalState) (i : Nat) : + observe (runOps a fuel ops st i) = + observe (runOps b fuel (ops.map (rewriteOp rename)) st i) := by + rw [runOps.eq_1 a, runOps.eq_1 b] + simp only [Array.size_map] + by_cases h : i < ops.size + · simp only [dif_pos h, Array.getElem_map] + have related := observe_bind (f := fun st' => runOps a fuel ops st' (i + 1)) + (g := fun st' => runOps b fuel (ops.map (rewriteOp rename)) st' (i + 1)) + (evalOp_renamed code fuel ops[i] st) (fun st' => runOps_renamed code fuel ops st' (i + 1)) + cases hleft : evalOp a fuel ops[i] st <;> + cases hright : evalOp b fuel (rewriteOp rename ops[i]) st <;> + simpa only [hleft, hright] using related + · simp only [dif_neg h] +termination_by (fuel, sizeOf ops, 1 + (ops.size - i)) +decreasing_by all_goals first | decreasing_tactic | omega + +theorem evalBlock_renamed {a b : Toplevel} {rename : FunIdx → FunIdx} + (code : RenamedCode a b rename) (fuel : Nat) (block : Block) (st : EvalState) : + observe (evalBlock a fuel block st) = + observe (evalBlock b fuel (rewriteBlock rename block) st) := by + rw [evalBlock.eq_1 a, evalBlock.eq_1 b] + simp only [rewriteBlock] + have related := observe_bind (f := fun st' => evalCtrl a fuel block.ctrl st') + (g := fun st' => evalCtrl b fuel (rewriteCtrl rename block.ctrl) st') + (runOps_renamed code fuel block.ops st 0) (fun st' => evalCtrl_renamed code fuel block.ctrl st') + cases hleft : runOps a fuel block.ops st 0 <;> + cases hright : runOps b fuel (block.ops.map (rewriteOp rename)) st 0 <;> + simpa only [hleft, hright] using related +termination_by (fuel, sizeOf block, 4) +decreasing_by + all_goals first + | decreasing_tactic + | (apply Prod.Lex.right; apply Prod.Lex.left; exact ops_lt _) + | (apply Prod.Lex.right; apply Prod.Lex.left; exact ctrl_lt _) + | omega + +theorem evalCtrl_renamed {a b : Toplevel} {rename : FunIdx → FunIdx} + (code : RenamedCode a b rename) (fuel : Nat) (ctrl : Ctrl) (st : EvalState) : + observe (evalCtrl a fuel ctrl st) = + observe (evalCtrl b fuel (rewriteCtrl rename ctrl) st) := by + cases ctrl with + | «return» sel outs => simp only [rewriteCtrl, evalCtrl] + | «yield» sel outs => simp only [rewriteCtrl, evalCtrl] + | «match» idx cases fallback => + rw [rewriteCtrl.eq_def] + simp only [evalCtrl] + cases readIdx st idx with + | error e => rfl + | ok scrut => + cases fallback <;> + simpa only [Option.map] using evalMatchArm_renamed code fuel cases _ scrut st 0 + | matchContinue idx cases fallback out aux lookups cont => + rw [rewriteCtrl.eq_def] + simp only [evalCtrl] + cases readIdx st idx with + | error e => rfl + | ok scrut => + cases fallback + all_goals + with_unfolding_all + apply observe_pairBind + (f := fun outs st' => evalBlock a fuel cont { st' with map := st.map ++ outs }) + (g := fun outs st' => evalBlock b fuel (rewriteBlock rename cont) + { st' with map := st.map ++ outs }) + (evalMatchArm_renamed code fuel cases _ scrut st 0) + all_goals intro outs st' + all_goals exact evalBlock_renamed code fuel cont _ +termination_by (fuel, sizeOf ctrl, 3) +decreasing_by all_goals first | decreasing_tactic | omega + +theorem evalMatchArm_renamed {a b : Toplevel} {rename : FunIdx → FunIdx} + (code : RenamedCode a b rename) (fuel : Nat) (cases : Array (G × Block)) + (fallback : Option Block) (scrut : G) (st : EvalState) (i : Nat) : + observe (evalMatchArm a fuel cases fallback scrut st i) = + observe (evalMatchArm b fuel + (cases.attach.map fun pair => (pair.val.1, rewriteBlock rename pair.val.2)) + (fallback.map (rewriteBlock rename)) scrut st i) := by + rw [evalMatchArm.eq_1 a, evalMatchArm.eq_1 b] + simp only [Array.size_map, Array.size_attach] + by_cases h : i < cases.size + · simp only [dif_pos h, Array.getElem_map, Array.getElem_attach] + split + · exact evalBlock_renamed code fuel cases[i].2 st + · exact evalMatchArm_renamed code fuel cases fallback scrut st (i + 1) + · simp only [dif_neg h] + exact evalDefaultBlock_renamed code fuel fallback st +termination_by (fuel, sizeOf cases + sizeOf fallback, 2 + (cases.size - i)) +decreasing_by + all_goals + clean_wf + first + | decreasing_tactic + | (apply Prod.Lex.right; apply Prod.Lex.left; exact case_lt cases fallback i ‹_›) + | (apply Prod.Lex.right; apply Prod.Lex.left + cases cases; simp; omega) + | omega + +theorem evalDefaultBlock_renamed {a b : Toplevel} {rename : FunIdx → FunIdx} + (code : RenamedCode a b rename) (fuel : Nat) (fallback : Option Block) (st : EvalState) : + observe (evalDefaultBlock a fuel fallback st) = + observe (evalDefaultBlock b fuel (fallback.map (rewriteBlock rename)) st) := by + cases fallback with + | none => simp only [Option.map, evalDefaultBlock] + | some block => simpa only [Option.map, evalDefaultBlock] using evalBlock_renamed code fuel block st +termination_by (fuel, sizeOf fallback, 1) +decreasing_by all_goals first | decreasing_tactic | (simp_wf; omega) + +end + +private def finishFunction (result : Except BytecodeError (Array G × EvalState)) : + Except BytecodeError (Array G × IOBuffer) := + match result with + | .error (.earlyReturn outs st) | .ok (outs, st) => .ok (outs, st.ioBuffer) + | .error error => .error error + +private def finishObservedFunction + (result : Except (Option (Array G × EvalState)) (Array G × EvalState)) : + Except (Option (Array G × EvalState)) (Array G × IOBuffer) := + match result with + | .error (some (outs, st)) | .ok (outs, st) => .ok (outs, st.ioBuffer) + | .error none => .error none + +private theorem observe_finishFunction (result : Except BytecodeError (Array G × EvalState)) : + observe (finishFunction result) = finishObservedFunction (observe result) := by + cases result with + | ok value => cases value; rfl + | error error => cases error <;> rfl + +theorem runFunction_renamed {a b : Toplevel} {rename : FunIdx → FunIdx} + (code : RenamedCode a b rename) (function : FunIdx) (args : Array G) (io : IOBuffer) (fuel : Nat) : + observe (runFunction a function args io fuel) = + observe (runFunction b (rename function) args io fuel) := by + rw [runFunction.eq_1 a, runFunction.eq_1 b] + by_cases ha : function < a.functions.size + · have hb := (code.domain function).mp ha + simp only [dif_pos ha, dif_pos hb, code.inputSize function ha hb] + split + · rfl + · change observe (finishFunction (evalBlock a fuel a.functions[function].body _)) = + observe (finishFunction (evalBlock b fuel b.functions[rename function].body _)) + rw [observe_finishFunction, observe_finishFunction, ← code.body function ha hb, + evalBlock_renamed code] + · have hb : ¬ rename function < b.functions.size := by + simpa [← code.domain function] using ha + simp only [dif_neg ha, dif_neg hb] + rfl + +/-- Renaming preserves and reflects every successful result and final I/O +state at the same fuel. Failures may report different function indices. -/ +theorem runFunction_renamed_iff {a b : Toplevel} {rename : FunIdx → FunIdx} + (code : RenamedCode a b rename) (function : FunIdx) (args : Array G) (io : IOBuffer) (fuel : Nat) + (result : Array G × IOBuffer) : + runFunction a function args io fuel = .ok result ↔ + runFunction b (rename function) args io fuel = .ok result := by + rw [← observe_ok_iff, ← observe_ok_iff, runFunction_renamed code] + +end Aiur.Bytecode.Eval diff --git a/Ix/Aiur/Proofs/ReturnGates.lean b/Ix/Aiur/Proofs/ReturnGates.lean new file mode 100644 index 000000000..d9102f296 --- /dev/null +++ b/Ix/Aiur/Proofs/ReturnGates.lean @@ -0,0 +1,214 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.SelectorControl + +/-! +The emitter gates a continuation with its yield sum. Its continuation-link +equation identifies that sum with the continuation block's selector. These +definitions retain the distinction on arbitrary field assignments and prove +that satisfying selector equations identify all return gates with their leaf +selectors. A nonzero provider's combined message then recovers one return. + +Reflection of native argument values and layout remains an obligation. The +branchless single-writer property and terminal-count bound are explicit. +-/ + +namespace Aiur.Bytecode +open Aiur.AIR + +private theorem return_gate_block_smaller (block : Block) : sizeOf block.ctrl < sizeOf block := by + cases block + simp + omega + +mutual + +/-- Return arguments are gated by the selector passed to the emitter. At a +continuation this is the yield sum, equal to the block selector only when +the emitted continuation-link equation is satisfied. -/ +def Ctrl.returnGates (selector : SelIdx → G) (incoming : G) : Ctrl → List G + | .return .. => [incoming] + | .yield .. => [] + | .match _ branches fallback => + (branches.attach.toList.flatMap fun ⟨pair, _⟩ => + pair.2.returnGates selector (pair.2.selectorFlow selector).entry) ++ + (match fallback with + | none => [] + | some block => block.returnGates selector (block.selectorFlow selector).entry) + | .matchContinue _ branches fallback _ _ _ continuation => + (branches.attach.toList.flatMap fun ⟨pair, _⟩ => + pair.2.returnGates selector (pair.2.selectorFlow selector).entry) ++ + (match fallback with + | none => [] + | some block => block.returnGates selector (block.selectorFlow selector).entry) ++ + continuation.returnGates selector + (selectorSum (SelectorFlow.join (branchSelectorFlows selector branches fallback)).yields) +termination_by ctrl => sizeOf ctrl +decreasing_by + all_goals first + | decreasing_tactic + | (have := Array.sizeOf_lt_of_mem ‹_ ∈ _›; grind) + +def Block.returnGates (selector : SelIdx → G) (incoming : G) (block : Block) : List G := + block.ctrl.returnGates selector incoming +termination_by sizeOf block +decreasing_by exact return_gate_block_smaller block + +end + +def branchReturnGates (selector : SelIdx → G) (branches : Array (G × Block)) + (fallback : Option Block) : List G := + branches.toList.flatMap (fun pair => pair.2.returnGates selector (pair.2.selectorFlow selector).entry) ++ + fallback.toList.flatMap (fun block => block.returnGates selector (block.selectorFlow selector).entry) + +private theorem flatMap_attachWith_val {α β : Type} (items : List α) (p : α → Prop) + (h : ∀ item ∈ items, p item) (f : α → List β) : + (items.attachWith p h).flatMap (fun item => f item.val) = items.flatMap f := by + rw [List.flatMap, List.flatMap, List.attachWith_map_val] + +theorem Ctrl.returnGates_match (selector : SelIdx → G) (incoming : G) (index : ValIdx) + (branches : Array (G × Block)) (fallback : Option Block) : + (Ctrl.match index branches fallback).returnGates selector incoming = + branchReturnGates selector branches fallback := by + rw [Ctrl.returnGates.eq_def] + simp only [branchReturnGates, Array.toList_attach] + rw [flatMap_attachWith_val _ _ _ (fun pair : G × Block => + pair.2.returnGates selector (pair.2.selectorFlow selector).entry)] + cases fallback <;> simp + +theorem Ctrl.returnGates_matchContinue (selector : SelIdx → G) (incoming : G) (index : ValIdx) + (branches : Array (G × Block)) (fallback : Option Block) + (outputs aux lookups : Nat) (continuation : Block) : + (Ctrl.matchContinue index branches fallback outputs aux lookups continuation).returnGates selector incoming = + branchReturnGates selector branches fallback ++ continuation.returnGates selector + (selectorSum (SelectorFlow.join (branchSelectorFlows selector branches fallback)).yields) := by + rw [Ctrl.returnGates.eq_def] + simp only [branchReturnGates, Array.toList_attach] + rw [flatMap_attachWith_val _ _ _ (fun pair : G × Block => + pair.2.returnGates selector (pair.2.selectorFlow selector).entry)] + cases fallback <;> simp + +private theorem flatMap_congr_mem {α β : Type} (items : List α) (left right : α → List β) + (equal : ∀ item ∈ items, left item = right item) : items.flatMap left = items.flatMap right := by + rw [List.flatMap, List.flatMap] + exact congrArg List.flatten (List.map_congr_left equal) + +theorem branchReturnGates_reflects (selector : SelIdx → G) (branches : Array (G × Block)) + (fallback : Option Block) + (casesEqual : ∀ pair ∈ branches.toList, + pair.2.returnGates selector (pair.2.selectorFlow selector).entry = + (pair.2.selectorFlow selector).returns) + (fallbackEqual : ∀ block, fallback = some block → + block.returnGates selector (block.selectorFlow selector).entry = + (block.selectorFlow selector).returns) : + branchReturnGates selector branches fallback = + (SelectorFlow.join (branchSelectorFlows selector branches fallback)).returns := by + simp only [branchReturnGates, branchSelectorFlows, SelectorFlow.join, + List.flatMap_append, List.flatMap_map] + congr 1 + · exact flatMap_congr_mem _ _ _ casesEqual + · apply flatMap_congr_mem + intro block member + exact fallbackEqual block (by simpa using member) + +theorem branchSelectorFlows_satisfied (selector : SelIdx → G) (branches : Array (G × Block)) + (fallback : Option Block) + (valid : (SelectorFlow.join (branchSelectorFlows selector branches fallback)).Satisfied) : + (∀ pair ∈ branches.toList, (pair.2.selectorFlow selector).Satisfied) ∧ + (∀ block, fallback = some block → (block.selectorFlow selector).Satisfied) := by + refine ⟨?_, ?_⟩ + · intro pair member + apply SelectorFlow.join_satisfied valid + exact List.mem_append_left _ (List.mem_map.mpr ⟨pair, member, rfl⟩) + · intro block present + apply SelectorFlow.join_satisfied valid + apply List.mem_append_right + rw [present] + exact List.mem_cons_self + +mutual + +theorem Ctrl.returnGates_reflects (selector : SelIdx → G) (incoming : G) (ctrl : Ctrl) + (valid : (ctrl.selectorFlow selector).Satisfied) + (linked : incoming = (ctrl.selectorFlow selector).entry) : + ctrl.returnGates selector incoming = (ctrl.selectorFlow selector).returns := by + cases ctrl with + | «return» index values => + rw [Ctrl.returnGates.eq_def, linked, Ctrl.selectorFlow.eq_def] + rfl + | yield index values => rw [Ctrl.returnGates.eq_def, Ctrl.selectorFlow.eq_def]; rfl + | «match» index branches fallback => + rw [Ctrl.selectorFlow_match] at valid ⊢ + rw [Ctrl.returnGates_match] + obtain ⟨casesValid, fallbackValid⟩ := + branchSelectorFlows_satisfied selector branches fallback (SelectorFlow.guard_satisfied valid) + apply branchReturnGates_reflects + · intro pair member + exact Block.returnGates_reflects selector _ pair.2 (casesValid pair member) rfl + · intro block present + exact Block.returnGates_reflects selector _ block (fallbackValid block present) rfl + | matchContinue index branches fallback outputs aux lookups continuation => + rw [Ctrl.selectorFlow_matchContinue] at valid ⊢ + rw [Ctrl.returnGates_matchContinue] + obtain ⟨branchesValid, contValid, link⟩ := + SelectorFlow.continue_satisfied (SelectorFlow.guard_satisfied valid) + obtain ⟨casesValid, fallbackValid⟩ := branchSelectorFlows_satisfied selector branches fallback branchesValid + change _ ++ _ = _ ++ _ + congr 1 + · apply branchReturnGates_reflects + · intro pair member + exact Block.returnGates_reflects selector _ pair.2 (casesValid pair member) rfl + · intro block present + exact Block.returnGates_reflects selector _ block (fallbackValid block present) rfl + · exact Block.returnGates_reflects selector _ continuation contValid link.symm +termination_by sizeOf ctrl +decreasing_by + all_goals first + | decreasing_tactic + | (have := Array.sizeOf_lt_of_mem (Array.mem_def.mpr member); grind) + +theorem Block.returnGates_reflects (selector : SelIdx → G) (incoming : G) (block : Block) + (valid : (block.selectorFlow selector).Satisfied) + (linked : incoming = (block.selectorFlow selector).entry) : + block.returnGates selector incoming = (block.selectorFlow selector).returns := by + rw [Block.returnGates, Block.selectorFlow] at * + exact Ctrl.returnGates_reflects selector incoming block.ctrl valid linked +termination_by sizeOf block +decreasing_by exact return_gate_block_smaller block + +end + +theorem Block.return_message (selector : SelIdx → G) (block : Block) (program : Toplevel) + (shape : block.lookupShapes program none = true) + (valid : (block.selectorFlow selector).Satisfied) + (bounded : (block.selectorFlow selector).returns.length < gSize.toNat) + (multiplicity : G) (nonzero : multiplicity ≠ 0) + (activity : activityConstraint multiplicity (block.selectorFlow selector).entry = 0) + (width : Nat) (branchless : Bool) (parts : List (G × List G)) + (gates : parts.map Prod.fst = block.returnGates selector (block.selectorFlow selector).entry) + (single : branchless = true → parts.length = 1) : + ∃ chosen ∈ parts, chosen.1 = 1 ∧ + padMessage width (slotMessage branchless parts) = padMessage width chosen.2 := by + have reflected := block.returnGates_reflects selector _ valid rfl + rw [reflected] at gates + have empty := block.selectorFlow_yields_empty selector program shape + have conservation := (block.selectorFlow_sound selector valid).conservation + have active := nonzero_multiplicity_selector_one activity nonzero + rw [empty] at conservation + change _ = selectorSum (block.selectorFlow selector).returns + 0 at conservation + rw [G.add_zero, active] at conservation + apply slotMessage_active width branchless single + · intro part member + apply (block.selectorFlow_sound selector valid).returned part.1 + rw [← gates] + exact List.mem_map.mpr ⟨part, member, rfl⟩ + · have lengths := congrArg List.length gates + simp only [List.length_map] at lengths + omega + · rw [gates] + exact conservation.symm + +end Aiur.Bytecode diff --git a/Ix/Aiur/Proofs/RowCounts.lean b/Ix/Aiur/Proofs/RowCounts.lean new file mode 100644 index 000000000..d947d4f2b --- /dev/null +++ b/Ix/Aiur/Proofs/RowCounts.lean @@ -0,0 +1,236 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.RowCounts +import Ix.Aiur.Proofs.CircuitRowExecution + +/-! Control counts bound the selector flow of every field assignment. +The node count also bounds all branch arities and nested continuation joins. +Consumed yields contribute to the leaf count even after leaving the flow. -/ + +namespace Aiur.Bytecode +open Aiur.AIR + +structure ControlCounts.Describes (counts : ControlCounts) (flow : SelectorFlow) : Prop where + returned : flow.returns.length = counts.returns + yielded : flow.yields.length = counts.yields + terminals : counts.returns + counts.yields ≤ counts.leaves + leaves : counts.leaves ≤ counts.nodes + +theorem ControlCounts.Describes.unguard {counts : ControlCounts} {flow : SelectorFlow} + (describes : counts.Describes flow.guard) : counts.Describes flow := + ⟨describes.returned, describes.yielded, describes.terminals, describes.leaves⟩ + +theorem ControlCounts.sum_describes {counts : List ControlCounts} {flows : List SelectorFlow} + (related : List.Forall₂ Describes counts flows) : + (sum counts).Describes (SelectorFlow.join flows) := by + induction related with + | nil => exact ⟨rfl, rfl, Nat.le_refl _, Nat.le_refl _⟩ + | @cons first firstFlow rest restFlows head tail ih => + obtain ⟨hr, hy, ht, hl⟩ := head + obtain ⟨tr, ty, tt, tl⟩ := ih + refine ⟨?_, ?_, ?_, ?_⟩ <;> + dsimp only [sum, SelectorFlow.join] at * <;> + simp only [List.map_cons, List.sum_cons, List.flatMap_cons, List.length_append] at * <;> omega + +theorem ControlCounts.branch_describes {counts : List ControlCounts} {flows : List SelectorFlow} + (related : List.Forall₂ Describes counts flows) : + (branch counts).Describes (SelectorFlow.join flows).guard := by + obtain ⟨returned, yielded, terminals, leaves⟩ := sum_describes related + exact ⟨returned, yielded, terminals, by change (sum counts).leaves ≤ (sum counts).nodes + 1; omega⟩ + +theorem ControlCounts.continue_describes {branches continuation : ControlCounts} + {branchFlow contFlow : SelectorFlow} (first : branches.Describes branchFlow) + (last : continuation.Describes contFlow) : + (branches.continue continuation).Describes (branchFlow.continue contFlow).guard := by + obtain ⟨fr, fy, ft, fl⟩ := first + obtain ⟨lr, ly, lt, ll⟩ := last + refine ⟨?_, ly, ?_, ?_⟩ + · change (branchFlow.returns ++ contFlow.returns).length = _ + rw [List.length_append, fr, lr] + rfl + · change branches.returns + continuation.returns + continuation.yields ≤ branches.leaves + continuation.leaves + omega + · change branches.leaves + continuation.leaves ≤ branches.nodes + continuation.nodes + omega + +theorem ControlCounts.member_nodes_le {items : List ControlCounts} {item : ControlCounts} + (member : item ∈ items) : item.nodes ≤ (sum items).nodes := by + induction items with + | nil => cases member + | cons first rest ih => + rcases List.mem_cons.mp member with equal | member + · subst item + change first.nodes ≤ first.nodes + (sum rest).nodes + omega + · have bounded := ih member + change item.nodes ≤ first.nodes + (sum rest).nodes + omega + +theorem ControlCounts.length_le_nodes {items : List ControlCounts} + (positive : ∀ item ∈ items, 0 < item.nodes) : items.length ≤ (sum items).nodes := by + induction items with + | nil => exact Nat.le_refl _ + | cons first rest ih => + have head := positive first List.mem_cons_self + have tail := ih (fun item member => positive item (List.mem_cons_of_mem _ member)) + change rest.length + 1 ≤ first.nodes + (sum rest).nodes + omega + +theorem branchControlCounts_all {branches : Array (G × Block)} {fallback : Option Block} + (property : ControlCounts → Prop) + (casesValid : ∀ pair ∈ branches.toList, property pair.2.controlCounts) + (fallbackValid : ∀ block, fallback = some block → property block.controlCounts) : + ∀ counts ∈ branchControlCounts branches fallback, property counts := by + intro counts member + rcases List.mem_append.mp member with first | last + · obtain ⟨pair, pairMember, equal⟩ := List.mem_map.mp first + subst counts + exact casesValid pair pairMember + · obtain ⟨block, blockMember, equal⟩ := List.mem_map.mp last + subst counts + exact fallbackValid block (by simpa using blockMember) + +theorem branchControlCounts_describes (selector : SelIdx → G) + (branches : Array (G × Block)) (fallback : Option Block) + (casesValid : ∀ pair ∈ branches.toList, pair.2.controlCounts.Describes (pair.2.selectorFlow selector)) + (fallbackValid : ∀ block, fallback = some block → + block.controlCounts.Describes (block.selectorFlow selector)) : + List.Forall₂ ControlCounts.Describes (branchControlCounts branches fallback) + (branchSelectorFlows selector branches fallback) := by + apply forall₂_append + · apply forall₂_map_left + exact forall₂_self_map _ _ _ casesValid + · apply forall₂_map_left + apply forall₂_self_map + intro block member + exact fallbackValid block (by simpa using member) + +theorem branchControlCounts_case_le (branches : Array (G × Block)) (fallback : Option Block) + {pair : G × Block} (member : pair ∈ branches.toList) : + pair.2.controlCounts.nodes ≤ (ControlCounts.sum (branchControlCounts branches fallback)).nodes := + ControlCounts.member_nodes_le (List.mem_append_left _ (List.mem_map.mpr ⟨pair, member, rfl⟩)) + +theorem branchControlCounts_default_le (branches : Array (G × Block)) (fallback : Option Block) + {block : Block} (present : fallback = some block) : + block.controlCounts.nodes ≤ (ControlCounts.sum (branchControlCounts branches fallback)).nodes := by + apply ControlCounts.member_nodes_le + apply List.mem_append_right + rw [present] + exact List.mem_cons_self + +private theorem counts_spec_block_smaller (block : Block) : sizeOf block.ctrl < sizeOf block := by + cases block + simp + omega + +mutual + +theorem Ctrl.controlCounts_spec (selector : SelIdx → G) (ctrl : Ctrl) : + ctrl.controlCounts.Describes (ctrl.selectorFlow selector) ∧ + 0 < ctrl.controlCounts.nodes ∧ + (ctrl.controlCounts.nodes < gSize.toNat → ctrl.rowBounds selector) := by + cases ctrl with + | «return» index values => + rw [Ctrl.controlCounts.eq_def, Ctrl.selectorFlow.eq_def, Ctrl.rowBounds.eq_def] + exact ⟨⟨rfl, rfl, Nat.le_refl _, Nat.le_refl _⟩, Nat.zero_lt_succ 0, fun _ => True.intro⟩ + | yield index values => + rw [Ctrl.controlCounts.eq_def, Ctrl.selectorFlow.eq_def, Ctrl.rowBounds.eq_def] + exact ⟨⟨rfl, rfl, Nat.le_refl _, Nat.le_refl _⟩, Nat.zero_lt_succ 0, fun _ => True.intro⟩ + | «match» index branches fallback => + have casesSpec := fun pair (_ : pair ∈ branches.toList) => Block.controlCounts_spec selector pair.2 + have defaultSpec := fun block (_ : fallback = some block) => Block.controlCounts_spec selector block + have related := branchControlCounts_describes selector branches fallback + (fun pair member => (casesSpec pair member).1) (fun block present => (defaultSpec block present).1) + have positive := branchControlCounts_all (fun counts => 0 < counts.nodes) + (fun pair member => (casesSpec pair member).2.1) (fun block present => (defaultSpec block present).2.1) + have arity : branches.size + fallback.toList.length ≤ + (ControlCounts.sum (branchControlCounts branches fallback)).nodes := by + simpa only [branchControlCounts, List.length_append, List.length_map, Array.length_toList] + using ControlCounts.length_le_nodes positive + rw [Ctrl.controlCounts_match, Ctrl.selectorFlow_match, Ctrl.rowBounds.eq_def] + refine ⟨ControlCounts.branch_describes related, by change 0 < _ + 1; omega, ?_⟩ + intro bounded + change (ControlCounts.sum (branchControlCounts branches fallback)).nodes + 1 < gSize.toNat at bounded + refine ⟨?_, ?_, ?_⟩ + · omega + · intro pair member + apply (casesSpec pair member).2.2 + have le := branchControlCounts_case_le branches fallback member + omega + · cases fallback with + | none => exact True.intro + | some block => + apply (defaultSpec block rfl).2.2 + have le := branchControlCounts_default_le branches (some block) rfl + omega + | matchContinue index branches fallback outputs aux lookups continuation => + have casesSpec := fun pair (_ : pair ∈ branches.toList) => Block.controlCounts_spec selector pair.2 + have defaultSpec := fun block (_ : fallback = some block) => Block.controlCounts_spec selector block + have continued := Block.controlCounts_spec selector continuation + have related := branchControlCounts_describes selector branches fallback + (fun pair member => (casesSpec pair member).1) (fun block present => (defaultSpec block present).1) + have positive := branchControlCounts_all (fun counts => 0 < counts.nodes) + (fun pair member => (casesSpec pair member).2.1) (fun block present => (defaultSpec block present).2.1) + have arity : branches.size + fallback.toList.length ≤ + (ControlCounts.sum (branchControlCounts branches fallback)).nodes := by + simpa only [branchControlCounts, List.length_append, List.length_map, Array.length_toList] + using ControlCounts.length_le_nodes positive + rw [Ctrl.controlCounts_matchContinue, Ctrl.selectorFlow_matchContinue, Ctrl.rowBounds.eq_def] + refine ⟨ControlCounts.continue_describes (ControlCounts.branch_describes related).unguard continued.1, + by change 0 < _ + 1 + _; omega, ?_⟩ + intro bounded + change (ControlCounts.sum (branchControlCounts branches fallback)).nodes + 1 + + continuation.controlCounts.nodes < gSize.toNat at bounded + refine ⟨?_, ?_, ?_, ?_, ?_⟩ + · omega + · obtain ⟨returned, yielded, terminals, leaves⟩ := ControlCounts.sum_describes related + rw [returned, yielded] + omega + · intro pair member + apply (casesSpec pair member).2.2 + have le := branchControlCounts_case_le branches fallback member + omega + · cases fallback with + | none => exact True.intro + | some block => + apply (defaultSpec block rfl).2.2 + have le := branchControlCounts_default_le branches (some block) rfl + omega + · apply continued.2.2 + omega +termination_by sizeOf ctrl +decreasing_by + all_goals first + | decreasing_tactic + | (have := Array.sizeOf_lt_of_mem (Array.mem_def.mpr ‹_ ∈ _›); grind) + +theorem Block.controlCounts_spec (selector : SelIdx → G) (block : Block) : + block.controlCounts.Describes (block.selectorFlow selector) ∧ + 0 < block.controlCounts.nodes ∧ + (block.controlCounts.nodes < gSize.toNat → block.rowBounds selector) := by + rw [Block.controlCounts, Block.selectorFlow, Block.rowBounds] + exact Ctrl.controlCounts_spec selector block.ctrl +termination_by sizeOf block +decreasing_by exact counts_spec_block_smaller block + +end + +theorem Block.rowBounds_of_controlCounts (selector : SelIdx → G) (block : Block) + (bounded : block.controlCounts.nodes < gSize.toNat) : block.rowBounds selector := + (block.controlCounts_spec selector).2.2 bounded + +theorem Block.return_bound_of_controlCounts (selector : SelIdx → G) (block : Block) + (bounded : block.controlCounts.nodes < gSize.toNat) : + (block.selectorFlow selector).returns.length < gSize.toNat := by + obtain ⟨returned, _, terminals, leaves⟩ := (block.controlCounts_spec selector).1 + omega + +theorem Block.returns_le_selectors (selector : SelIdx → G) (block : Block) : + (block.selectorFlow selector).returns.length ≤ block.controlCounts.leaves := by + obtain ⟨returned, _, terminals, _⟩ := (block.controlCounts_spec selector).1 + omega + +end Aiur.Bytecode diff --git a/Ix/Aiur/Proofs/SelectorControl.lean b/Ix/Aiur/Proofs/SelectorControl.lean new file mode 100644 index 000000000..320ee7959 --- /dev/null +++ b/Ix/Aiur/Proofs/SelectorControl.lean @@ -0,0 +1,377 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.SelectorMessages +import Ix.Aiur.Proofs.LookupShapes + +/-! +Conservation and exclusivity for the selector portion of native control +constraints, computed over the actual bytecode tree. A continuation consumes +only its branches' escaping yields; early returns remain function returns. +The existing shape validator excludes yields escaping an entire function. + +Native-expression reflection, value-index and layout correctness, branch +matching and operation extraction remain separate obligations. The terminal +count bound is explicit; this module does not assume it follows from syntax. +-/ + +namespace Aiur.AIR + +/-- Selector-only projection of the native control emitter. `yields` lists +only yields escaping this block to its nearest enclosing continuation. -/ +structure SelectorFlow where + entry : G + returns : List G + yields : List G + equations : List G + deriving Repr + +def SelectorFlow.guard (flow : SelectorFlow) : SelectorFlow := + { flow with equations := oneSubBooleanConstraint flow.entry :: flow.equations } + +def SelectorFlow.join (flows : List SelectorFlow) : SelectorFlow := + ⟨selectorSum (flows.map (·.entry)), flows.flatMap (·.returns), + flows.flatMap (·.yields), flows.flatMap (·.equations)⟩ + +def SelectorFlow.continue (branches continuation : SelectorFlow) : SelectorFlow := + ⟨branches.entry, branches.returns ++ continuation.returns, continuation.yields, + branches.equations ++ + (continuation.entry - selectorSum branches.yields) :: continuation.equations⟩ + +def SelectorFlow.Satisfied (flow : SelectorFlow) : Prop := + ∀ equation ∈ flow.equations, equation = 0 + +structure SelectorFlow.Sound (flow : SelectorFlow) : Prop where + conservation : flow.entry = selectorSum flow.returns + selectorSum flow.yields + returned : ∀ value ∈ flow.returns, booleanConstraint value = 0 + yielded : ∀ value ∈ flow.yields, booleanConstraint value = 0 + +theorem SelectorFlow.guard_sound {flow : SelectorFlow} (sound : flow.Sound) : flow.guard.Sound := + ⟨sound.conservation, sound.returned, sound.yielded⟩ + +theorem SelectorFlow.guard_satisfied {flow : SelectorFlow} (valid : flow.guard.Satisfied) : + flow.Satisfied := fun equation member => valid equation (List.mem_cons_of_mem _ member) + +theorem SelectorFlow.guard_boolean {flow : SelectorFlow} (valid : flow.guard.Satisfied) : + booleanConstraint flow.entry = 0 := by + have boolean := G.boolean_of_one_sub_constraint (valid _ List.mem_cons_self) + rcases boolean with zero | one + · rw [zero]; rfl + · rw [one]; rfl + +theorem SelectorFlow.join_satisfied {flows : List SelectorFlow} (valid : (join flows).Satisfied) : + ∀ flow ∈ flows, flow.Satisfied := by + intro flow member equation equationMember + exact valid equation (List.mem_flatMap.mpr ⟨flow, member, equationMember⟩) + +theorem SelectorFlow.continue_satisfied {branches continuation : SelectorFlow} + (valid : (branches.continue continuation).Satisfied) : + branches.Satisfied ∧ continuation.Satisfied ∧ + continuation.entry = selectorSum branches.yields := by + refine ⟨?_, ?_, ?_⟩ + · exact fun equation member => valid _ (List.mem_append_left _ member) + · exact fun equation member => + valid _ (List.mem_append_right _ (List.mem_cons_of_mem _ member)) + · exact (G.sub_eq_zero_iff _ _).mp + (valid _ (List.mem_append_right _ List.mem_cons_self)) + +theorem SelectorFlow.join_sound {flows : List SelectorFlow} + (sound : ∀ flow ∈ flows, flow.Sound) : (join flows).Sound := by + induction flows with + | nil => exact ⟨rfl, by simp [join], by simp [join]⟩ + | cons flow flows ih => + have head := sound flow List.mem_cons_self + have tail := ih (fun flow member => sound flow (List.mem_cons_of_mem _ member)) + have tailEq := tail.conservation + dsimp only [join] at tailEq + refine ⟨?_, ?_, ?_⟩ + · change selectorSum (flow.entry :: flows.map (·.entry)) = + selectorSum (flow.returns ++ flows.flatMap (·.returns)) + + selectorSum (flow.yields ++ flows.flatMap (·.yields)) + rw [selectorSum_cons, selectorSum_append, selectorSum_append, + head.conservation, tailEq] + simp only [G.add_assoc] + apply congrArg (selectorSum flow.returns + ·) + rw [← G.add_assoc, G.add_comm (selectorSum flow.yields) + (selectorSum (flows.flatMap (·.returns))), G.add_assoc] + · intro value member + change value ∈ flow.returns ++ flows.flatMap (·.returns) at member + rcases List.mem_append.mp member with first | last + · exact head.returned _ first + · exact tail.returned _ last + · intro value member + change value ∈ flow.yields ++ flows.flatMap (·.yields) at member + rcases List.mem_append.mp member with first | last + · exact head.yielded _ first + · exact tail.yielded _ last + +theorem SelectorFlow.continue_sound {branches continuation : SelectorFlow} + (first : branches.Sound) (last : continuation.Sound) + (link : continuation.entry = selectorSum branches.yields) : + (branches.continue continuation).Sound := by + refine ⟨?_, ?_, last.yielded⟩ + · change branches.entry = selectorSum (branches.returns ++ continuation.returns) + + selectorSum continuation.yields + rw [selectorSum_append, G.add_assoc, ← last.conservation, link, ← first.conservation] + · intro value member + rcases List.mem_append.mp member with firstMember | lastMember + · exact first.returned _ firstMember + · exact last.returned _ lastMember + +theorem SelectorFlow.Sound.terminal_boolean {flow : SelectorFlow} (sound : flow.Sound) : + ∀ value ∈ flow.returns ++ flow.yields, booleanConstraint value = 0 := by + intro value member + rcases List.mem_append.mp member with returned | yielded + · exact sound.returned value returned + · exact sound.yielded value yielded + +theorem SelectorFlow.Sound.active_terminal {flow : SelectorFlow} (sound : flow.Sound) + (bounded : flow.returns.length + flow.yields.length < gSize.toNat) + (active : flow.entry = 1) : + ∃ before after, flow.returns ++ flow.yields = before ++ 1 :: after ∧ + ∀ value ∈ before ++ after, value = 0 := by + apply selectorSum_active_split sound.terminal_boolean + (by simpa only [List.length_append] using bounded) + rw [selectorSum_append, ← sound.conservation, active] + +theorem SelectorFlow.Sound.inactive_terminal {flow : SelectorFlow} (sound : flow.Sound) + (bounded : flow.returns.length + flow.yields.length < gSize.toNat) + (inactive : flow.entry = 0) : + ∀ value ∈ flow.returns ++ flow.yields, value = 0 := by + apply selectorSum_inactive sound.terminal_boolean + (by simpa only [List.length_append] using bounded) + rw [selectorSum_append, ← sound.conservation, inactive] + +theorem SelectorFlow.Sound.return_stops_continuation {flow : SelectorFlow} (sound : flow.Sound) + (bounded : flow.returns.length + flow.yields.length < gSize.toNat) + (active : flow.entry = 1) (returned : (1 : G) ∈ flow.returns) : + selectorSum flow.yields = 0 := by + have count := selectorSum_active_count sound.terminal_boolean + (by simpa only [List.length_append] using bounded) + (show selectorSum (flow.returns ++ flow.yields) = 1 by + rw [selectorSum_append, ← sound.conservation, active]) + have positive := List.count_pos_iff.mpr returned + rw [List.count_append] at count + have noYields : flow.yields.count 1 = 0 := by omega + rw [selectorSum_eq_count _ (fun value member => + G.boolean_of_constraint (sound.yielded value member)), noYields] + rfl + +theorem SelectorFlow.Sound.yield_starts_continuation {flow : SelectorFlow} (sound : flow.Sound) + (bounded : flow.returns.length + flow.yields.length < gSize.toNat) + (active : flow.entry = 1) (yielded : (1 : G) ∈ flow.yields) : + selectorSum flow.yields = 1 := by + have count := selectorSum_active_count sound.terminal_boolean + (by simpa only [List.length_append] using bounded) + (show selectorSum (flow.returns ++ flow.yields) = 1 by + rw [selectorSum_append, ← sound.conservation, active]) + have positive := List.count_pos_iff.mpr yielded + rw [List.count_append] at count + have oneYield : flow.yields.count 1 = 1 := by omega + rw [selectorSum_eq_count _ (fun value member => + G.boolean_of_constraint (sound.yielded value member)), oneYield] + rfl + +end Aiur.AIR + +namespace Aiur.Bytecode +open Aiur.AIR + +private theorem selector_block_smaller (block : Block) : sizeOf block.ctrl < sizeOf block := by + cases block + simp + omega + +mutual + +def Ctrl.selectorFlow (selector : SelIdx → G) : Ctrl → SelectorFlow + | .return index _ => (⟨selector index, [selector index], [], []⟩ : SelectorFlow).guard + | .yield index _ => (⟨selector index, [], [selector index], []⟩ : SelectorFlow).guard + | .match _ branches fallback => + (SelectorFlow.join ( + (branches.attach.toList.map fun ⟨pair, _⟩ => pair.2.selectorFlow selector) ++ + (match fallback with | none => [] | some block => [block.selectorFlow selector]))).guard + | .matchContinue _ branches fallback _ _ _ continuation => + ((SelectorFlow.join ( + (branches.attach.toList.map fun ⟨pair, _⟩ => pair.2.selectorFlow selector) ++ + (match fallback with | none => [] | some block => [block.selectorFlow selector]))).continue + (continuation.selectorFlow selector)).guard +termination_by ctrl => sizeOf ctrl +decreasing_by + all_goals first + | decreasing_tactic + | (have := Array.sizeOf_lt_of_mem ‹_ ∈ _›; grind) + +def Block.selectorFlow (selector : SelIdx → G) (block : Block) : SelectorFlow := + block.ctrl.selectorFlow selector +termination_by sizeOf block +decreasing_by exact selector_block_smaller block + +end + +def branchSelectorFlows (selector : SelIdx → G) (branches : Array (G × Block)) + (fallback : Option Block) : List SelectorFlow := + branches.toList.map (fun pair => pair.2.selectorFlow selector) ++ + fallback.toList.map (fun block => block.selectorFlow selector) + +theorem Ctrl.selectorFlow_match (selector : SelIdx → G) (index : ValIdx) + (branches : Array (G × Block)) (fallback : Option Block) : + (Ctrl.match index branches fallback).selectorFlow selector = + (SelectorFlow.join (branchSelectorFlows selector branches fallback)).guard := by + rw [Ctrl.selectorFlow.eq_def] + simp only [branchSelectorFlows, Array.toList_attach] + rw [List.attachWith_map_val (f := fun pair : G × Block => pair.2.selectorFlow selector)] + cases fallback <;> rfl + +theorem Ctrl.selectorFlow_matchContinue (selector : SelIdx → G) (index : ValIdx) + (branches : Array (G × Block)) (fallback : Option Block) + (outputs aux lookups : Nat) (continuation : Block) : + (Ctrl.matchContinue index branches fallback outputs aux lookups continuation).selectorFlow selector = + ((SelectorFlow.join (branchSelectorFlows selector branches fallback)).continue + (continuation.selectorFlow selector)).guard := by + rw [Ctrl.selectorFlow.eq_def] + simp only [branchSelectorFlows, Array.toList_attach] + rw [List.attachWith_map_val (f := fun pair : G × Block => pair.2.selectorFlow selector)] + cases fallback <;> rfl + +theorem branchSelectorFlows_sound (selector : SelIdx → G) (branches : Array (G × Block)) + (fallback : Option Block) + (valid : (SelectorFlow.join (branchSelectorFlows selector branches fallback)).Satisfied) + (casesSound : ∀ pair ∈ branches.toList, + (pair.2.selectorFlow selector).Satisfied → (pair.2.selectorFlow selector).Sound) + (fallbackSound : ∀ block, fallback = some block → + (block.selectorFlow selector).Satisfied → (block.selectorFlow selector).Sound) : + (SelectorFlow.join (branchSelectorFlows selector branches fallback)).Sound := by + apply SelectorFlow.join_sound + intro flow member + have flowValid := SelectorFlow.join_satisfied valid flow member + rcases List.mem_append.mp member with caseMember | defaultMember + · obtain ⟨pair, pairMember, equal⟩ := List.mem_map.mp caseMember + subst flow + exact casesSound pair pairMember flowValid + · obtain ⟨block, blockMember, equal⟩ := List.mem_map.mp defaultMember + subst flow + exact fallbackSound block (by simpa using blockMember) flowValid + +mutual + +theorem Ctrl.selectorFlow_sound (selector : SelIdx → G) (ctrl : Ctrl) + (valid : (ctrl.selectorFlow selector).Satisfied) : (ctrl.selectorFlow selector).Sound := by + cases ctrl with + | «return» index values => + rw [Ctrl.selectorFlow.eq_def] at valid ⊢ + have boolean := SelectorFlow.guard_boolean valid + exact ⟨by simp only [SelectorFlow.guard, + selectorSum, List.foldl_nil, List.foldl_cons, G.add_zero, G.zero_add], + fun value member => (List.mem_singleton.mp member).symm ▸ boolean, + by simp [SelectorFlow.guard]⟩ + | yield index values => + rw [Ctrl.selectorFlow.eq_def] at valid ⊢ + have boolean := SelectorFlow.guard_boolean valid + exact ⟨by simp only [SelectorFlow.guard, + selectorSum, List.foldl_nil, List.foldl_cons, G.zero_add], + by simp [SelectorFlow.guard], + fun value member => (List.mem_singleton.mp member).symm ▸ boolean⟩ + | «match» index branches fallback => + rw [Ctrl.selectorFlow_match] at valid ⊢ + apply SelectorFlow.guard_sound + apply branchSelectorFlows_sound selector branches fallback (SelectorFlow.guard_satisfied valid) + · intro pair member satisfied + exact Block.selectorFlow_sound selector pair.2 satisfied + · intro block present satisfied + exact Block.selectorFlow_sound selector block satisfied + | matchContinue index branches fallback outputs aux lookups continuation => + rw [Ctrl.selectorFlow_matchContinue] at valid ⊢ + obtain ⟨branchesValid, continuationValid, link⟩ := + SelectorFlow.continue_satisfied (SelectorFlow.guard_satisfied valid) + apply SelectorFlow.guard_sound + apply SelectorFlow.continue_sound _ (Block.selectorFlow_sound selector continuation continuationValid) link + apply branchSelectorFlows_sound selector branches fallback branchesValid + · intro pair member satisfied + exact Block.selectorFlow_sound selector pair.2 satisfied + · intro block present satisfied + exact Block.selectorFlow_sound selector block satisfied +termination_by sizeOf ctrl +decreasing_by + all_goals first + | decreasing_tactic + | (have := Array.sizeOf_lt_of_mem (Array.mem_def.mpr ‹_ ∈ _›); grind) + +theorem Block.selectorFlow_sound (selector : SelIdx → G) (block : Block) + (valid : (block.selectorFlow selector).Satisfied) : (block.selectorFlow selector).Sound := by + rw [Block.selectorFlow] at valid ⊢ + exact Ctrl.selectorFlow_sound selector block.ctrl valid +termination_by sizeOf block +decreasing_by exact selector_block_smaller block + +end + +mutual + +theorem Ctrl.selectorFlow_yields_empty (selector : SelIdx → G) (ctrl : Ctrl) + (program : Toplevel) (valid : ctrl.lookupShapes program none = true) : + (ctrl.selectorFlow selector).yields = [] := by + cases ctrl with + | «return» index values => rw [Ctrl.selectorFlow.eq_def]; rfl + | yield index values => simp only [Ctrl.lookupShapes, reduceCtorEq, beq_iff_eq] at valid + | «match» index branches fallback => + obtain ⟨casesValid, fallbackValid⟩ := (lookupShapes_match _ _ _ _ _).mp valid + rw [Ctrl.selectorFlow_match] + change (branchSelectorFlows selector branches fallback).flatMap (·.yields) = [] + apply List.flatMap_eq_nil_iff.mpr + intro flow member + rcases List.mem_append.mp member with caseMember | defaultMember + · obtain ⟨pair, pairMember, equal⟩ := List.mem_map.mp caseMember + subst flow + exact Block.selectorFlow_yields_empty selector pair.2 program (casesValid pair pairMember) + · obtain ⟨block, blockMember, equal⟩ := List.mem_map.mp defaultMember + subst flow + have present : fallback = some block := by simpa using blockMember + exact Block.selectorFlow_yields_empty selector block program (fallbackValid block present) + | matchContinue index branches fallback outputs aux lookups continuation => + obtain ⟨_, _, contValid⟩ := (lookupShapes_matchContinue _ _ _ _ _ _ _ _ _).mp valid + rw [Ctrl.selectorFlow_matchContinue] + exact Block.selectorFlow_yields_empty selector continuation program contValid +termination_by sizeOf ctrl +decreasing_by + all_goals first + | decreasing_tactic + | (have := Array.sizeOf_lt_of_mem (Array.mem_def.mpr pairMember); grind) + +theorem Block.selectorFlow_yields_empty (selector : SelIdx → G) (block : Block) + (program : Toplevel) (valid : block.lookupShapes program none = true) : + (block.selectorFlow selector).yields = [] := by + rw [Block.selectorFlow] + rw [Block.lookupShapes, Bool.and_eq_true] at valid + exact Ctrl.selectorFlow_yields_empty selector block.ctrl program valid.2 +termination_by sizeOf block +decreasing_by exact selector_block_smaller block + +end + +theorem Block.selectorFlow_active_return (selector : SelIdx → G) (block : Block) + (program : Toplevel) (shape : block.lookupShapes program none = true) + (valid : (block.selectorFlow selector).Satisfied) + (bounded : (block.selectorFlow selector).returns.length < gSize.toNat) + (active : (block.selectorFlow selector).entry = 1) : + ∃ before after, (block.selectorFlow selector).returns = before ++ 1 :: after ∧ + ∀ value ∈ before ++ after, value = 0 := by + have empty := block.selectorFlow_yields_empty selector program shape + have sound := block.selectorFlow_sound selector valid + have result := sound.active_terminal (by simpa only [empty, List.length_nil, Nat.add_zero] using bounded) active + simpa only [empty, List.append_nil] using result + +theorem Block.selectorFlow_provider_return (selector : SelIdx → G) (block : Block) + (program : Toplevel) (shape : block.lookupShapes program none = true) + (valid : (block.selectorFlow selector).Satisfied) + (bounded : (block.selectorFlow selector).returns.length < gSize.toNat) + (multiplicity : G) (nonzero : multiplicity ≠ 0) + (activity : activityConstraint multiplicity (block.selectorFlow selector).entry = 0) : + ∃ before after, (block.selectorFlow selector).returns = before ++ 1 :: after ∧ + ∀ value ∈ before ++ after, value = 0 := + block.selectorFlow_active_return selector program shape valid bounded + (nonzero_multiplicity_selector_one activity nonzero) + +end Aiur.Bytecode diff --git a/Ix/Aiur/Proofs/SelectorMessages.lean b/Ix/Aiur/Proofs/SelectorMessages.lean new file mode 100644 index 000000000..0a5efe53e --- /dev/null +++ b/Ix/Aiur/Proofs/SelectorMessages.lean @@ -0,0 +1,217 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Proofs.LookupMessages +import Ix.Aiur.Proofs.LocalConstraints + +/-! +Selector-weighted messages in the native shared lookup slots and continuation +merges. Adding variable-length messages retains the longer tail; zero padding +recovers the uniquely selected message without a common raw-length premise. + +The field-characteristic bound, selector equations, layout's single-writer +property and continuation parent activity remain explicit. These lemmas do +not by themselves reflect the Rust emitter or extract its satisfying rows. +-/ + +namespace Aiur.AIR + +/-- The native argument combiner adds overlapping fields and retains the +longer tail, so messages of different lengths share zero-padded slots. -/ +def addMessages : List G → List G → List G + | [], right => right + | left, [] => left + | x :: left, y :: right => (x + y) :: addMessages left right + +def scaleMessage (selector : G) (message : List G) : List G := + message.map (selector * ·) + +def weightedMessage (parts : List (G × List G)) : List G := + parts.foldl (fun combined part => addMessages combined (scaleMessage part.1 part.2)) [] + +theorem addMessages_read (left right : List G) (i : Nat) : + (addMessages left right)[i]?.getD 0 = left[i]?.getD 0 + right[i]?.getD 0 := by + induction left generalizing right i with + | nil => simp only [addMessages, List.getElem?_nil, Option.getD_none, G.zero_add] + | cons value left ih => + cases right with + | nil => simp only [addMessages, List.getElem?_nil, Option.getD_none, G.add_zero] + | cons other right => + cases i with + | zero => rfl + | succ i => exact ih right i + +theorem addMessages_length (left right : List G) : + (addMessages left right).length = max left.length right.length := by + induction left generalizing right with + | nil => simp only [addMessages, List.length_nil, Nat.zero_max] + | cons value left ih => + cases right with + | nil => simp only [addMessages, List.length_nil, Nat.max_zero] + | cons other right => simp only [addMessages, List.length_cons, ih, Nat.add_max_add_right] + +theorem scaleMessage_read (selector : G) (message : List G) (i : Nat) : + (scaleMessage selector message)[i]?.getD 0 = selector * message[i]?.getD 0 := by + induction message generalizing i with + | nil => simp only [scaleMessage, List.map_nil, List.getElem?_nil, Option.getD_none, G.mul_zero] + | cons value message ih => + cases i with + | zero => rfl + | succ i => exact ih i + +theorem weightedMessage_fold_read (parts : List (G × List G)) (start : List G) (i : Nat) : + (parts.foldl (fun combined part => addMessages combined (scaleMessage part.1 part.2)) start)[i]?.getD 0 = + (parts.map fun part => part.1 * part.2[i]?.getD 0).foldl (· + ·) (start[i]?.getD 0) := by + induction parts generalizing start with + | nil => rfl + | cons part parts ih => + simp only [List.foldl_cons, List.map_cons, ih, addMessages_read, scaleMessage_read] + +theorem weightedMessage_read (parts : List (G × List G)) (i : Nat) : + (weightedMessage parts)[i]?.getD 0 = selectorSum (parts.map fun part => part.1 * part.2[i]?.getD 0) := + weightedMessage_fold_read parts [] i + +theorem selectorSum_append (left right : List G) : + selectorSum (left ++ right) = selectorSum left + selectorSum right := by + change (left ++ right).foldl (· + ·) 0 = left.foldl (· + ·) 0 + selectorSum right + rw [List.foldl_append, foldl_add_eq] + +theorem weighted_value_zero {parts : List (G × List G)} + (zero : ∀ part ∈ parts, part.1 = 0) (i : Nat) : + selectorSum (parts.map fun part => part.1 * part.2[i]?.getD 0) = 0 := by + induction parts with + | nil => rfl + | cons part parts ih => + have tail := ih (fun p member => zero p (List.mem_cons_of_mem part member)) + simp only [List.map_cons, selectorSum_cons, zero part List.mem_cons_self, + G.mul_comm 0, G.mul_zero, G.zero_add, tail] + +theorem weightedMessage_split (width : Nat) (before after : List (G × List G)) (chosen : G × List G) + (active : chosen.1 = 1) (zero : ∀ part ∈ before ++ after, part.1 = 0) : + padMessage width (weightedMessage (before ++ chosen :: after)) = padMessage width chosen.2 := by + apply congrArg List.ofFn + funext i + have beforeZero := weighted_value_zero (fun p member => zero p (List.mem_append_left _ member)) i.val + have afterZero := weighted_value_zero (fun p member => zero p (List.mem_append_right _ member)) i.val + change (weightedMessage (before ++ chosen :: after))[i.val]?.getD 0 = chosen.2[i.val]?.getD 0 + rw [weightedMessage_read, List.map_append, selectorSum_append, beforeZero, G.zero_add, + List.map_cons, selectorSum_cons, afterZero, G.add_zero, active, G.mul_comm, G.mul_one] + +theorem selector_parts_active_split {parts : List (G × List G)} + (individual : ∀ part ∈ parts, booleanConstraint part.1 = 0) + (bounded : parts.length < gSize.toNat) + (active : selectorSum (parts.map Prod.fst) = 1) : + ∃ before chosen after, parts = before ++ chosen :: after ∧ chosen.1 = 1 ∧ + ∀ part ∈ before ++ after, part.1 = 0 := by + obtain ⟨before, after, split, zero⟩ := selectorSum_active_split + (fun value member => by + obtain ⟨part, partMember, equal⟩ := List.mem_map.mp member + subst value + exact individual part partMember) + (by simpa only [List.length_map] using bounded) active + obtain ⟨first, rest, partsEq, firstEq, restEq⟩ := List.map_eq_append_iff.mp split + obtain ⟨chosen, last, tailEq, activeChosen, lastEq⟩ := List.map_eq_cons_iff.mp restEq + refine ⟨first, chosen, last, by rw [partsEq, tailEq], activeChosen, ?_⟩ + intro part member + apply zero part.1 + rcases List.mem_append.mp member with firstMember | lastMember + · apply List.mem_append_left + rw [← firstEq] + exact List.mem_map.mpr ⟨part, firstMember, rfl⟩ + · apply List.mem_append_right + rw [← lastEq] + exact List.mem_map.mpr ⟨part, lastMember, rfl⟩ + +/-- A shared slot contains exactly the selected branch's padded message. +Inactive branches may have different lengths and arbitrary field values. -/ +theorem weightedMessage_active (width : Nat) {parts : List (G × List G)} + (individual : ∀ part ∈ parts, booleanConstraint part.1 = 0) + (bounded : parts.length < gSize.toNat) + (active : selectorSum (parts.map Prod.fst) = 1) : + ∃ chosen ∈ parts, chosen.1 = 1 ∧ + padMessage width (weightedMessage parts) = padMessage width chosen.2 := by + obtain ⟨before, chosen, after, partsEq, activeChosen, zero⟩ := + selector_parts_active_split individual bounded active + refine ⟨chosen, ?_, activeChosen, ?_⟩ + · rw [partsEq] + exact List.mem_append_right _ List.mem_cons_self + · rw [partsEq] + exact weightedMessage_split width before after chosen activeChosen zero + +theorem weightedMessage_inactive (width : Nat) {parts : List (G × List G)} + (individual : ∀ part ∈ parts, booleanConstraint part.1 = 0) + (bounded : parts.length < gSize.toNat) + (inactive : selectorSum (parts.map Prod.fst) = 0) : + padMessage width (weightedMessage parts) = padMessage width [] := by + have zero := selectorSum_inactive + (fun value member => by + obtain ⟨part, partMember, equal⟩ := List.mem_map.mp member + subst value + exact individual part partMember) + (by simpa only [List.length_map] using bounded) inactive + apply congrArg List.ofFn + funext i + change (weightedMessage parts)[i.val]?.getD 0 = 0 + rw [weightedMessage_read] + exact weighted_value_zero (fun part member => zero _ (List.mem_map.mpr ⟨part, member, rfl⟩)) i.val + +/-- Native lookup gating omits the selector product for a slot known to +have just one writer. Multiplicity still determines whether it is used. -/ +def gateMessage (branchless : Bool) (selector : G) (message : List G) : List G := + if branchless then message else scaleMessage selector message + +def slotMessage (branchless : Bool) (parts : List (G × List G)) : List G := + parts.foldl (fun combined part => addMessages combined (gateMessage branchless part.1 part.2)) [] + +theorem gateMessage_active (branchless : Bool) {selector : G} (message : List G) + (active : selector = 1) : gateMessage branchless selector message = message := by + cases branchless <;> simp [gateMessage, scaleMessage, active, G.mul_comm, G.mul_one] + +/-- The branchless optimization is sound on an active slot when its layout +actually gives it one writer. That layout property is an explicit premise. -/ +theorem slotMessage_active (width : Nat) (branchless : Bool) {parts : List (G × List G)} + (single : branchless = true → parts.length = 1) + (individual : ∀ part ∈ parts, booleanConstraint part.1 = 0) + (bounded : parts.length < gSize.toNat) + (active : selectorSum (parts.map Prod.fst) = 1) : + ∃ chosen ∈ parts, chosen.1 = 1 ∧ + padMessage width (slotMessage branchless parts) = padMessage width chosen.2 := by + cases branchless with + | false => exact weightedMessage_active width individual bounded active + | true => + obtain ⟨part, equal⟩ := List.length_eq_one_iff.mp (single rfl) + subst parts + have selected : part.1 = 1 := by + simpa only [List.map_cons, List.map_nil, selectorSum_cons, + selectorSum, List.foldl_nil, List.foldl_cons, G.zero_add, G.add_zero] using active + exact ⟨part, List.mem_cons_self, selected, rfl⟩ + +/-- A continuation's active merge columns equal the values of its unique +active yield. The caller must establish that the parent is active and that +the native continuation-link equation makes the yield sum one. -/ +theorem continuation_merge {parent : G} {parts : List (G × List G)} {merged : List G} + (parentActive : parent = 1) + (individual : ∀ part ∈ parts, booleanConstraint part.1 = 0) + (bounded : parts.length < gSize.toNat) + (active : selectorSum (parts.map Prod.fst) = 1) + (sizes : ∀ part ∈ parts, part.2.length = merged.length) + (equations : ∀ i, i < merged.length → + parent * (merged[i]?.getD 0 - + selectorSum (parts.map fun part => part.1 * part.2[i]?.getD 0)) = 0) : + ∃ chosen ∈ parts, chosen.1 = 1 ∧ merged = chosen.2 := by + obtain ⟨chosen, member, selected, message⟩ := + weightedMessage_active merged.length individual bounded active + refine ⟨chosen, member, selected, ?_⟩ + apply padMessage_injective_of_length (Nat.le_refl _) (sizes chosen member).symm + apply Eq.trans _ message + apply congrArg List.ofFn + funext i + change merged[i.val]?.getD 0 = (weightedMessage parts)[i.val]?.getD 0 + rw [weightedMessage_read] + have equation := equations i.val i.isLt + rw [parentActive, G.mul_comm, G.mul_one] at equation + exact (G.sub_eq_zero_iff _ _).mp equation + +end Aiur.AIR diff --git a/Ix/Aiur/Proofs/TailMatches.lean b/Ix/Aiur/Proofs/TailMatches.lean new file mode 100644 index 000000000..37c429ef7 --- /dev/null +++ b/Ix/Aiur/Proofs/TailMatches.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Aiur.Semantics.SourceEval + +/-! Tail-match restoration preserves the complete source evaluator result. +This covers the normalization helper used by inlining; expansion and let +hoisting require separate proofs. -/ + +namespace Aiur.Source.Eval + +private theorem evalMatchCases_map (decls : Decls) (fuel : Nat) + (transform : Term → Term) (arms : List (Pattern × Term)) + (equivalent : ∀ arm ∈ arms, ∀ bindings st, + interp decls fuel bindings arm.2 st = interp decls fuel bindings (transform arm.2) st) + (bindings : Bindings) (st : EvalState) (value : Value) : + evalMatchCases decls fuel bindings st value arms = + evalMatchCases decls fuel bindings st value (arms.map fun arm => (arm.1, transform arm.2)) := by + induction arms with + | nil => rfl + | cons arm arms ih => + rcases arm with ⟨pattern, body⟩ + simp only [List.map_cons, evalMatchCases] + cases matchPattern st.store pattern value with + | some bs => exact equivalent (pattern, body) (by simp) (bs ++ bindings) st + | none => exact ih (fun arm member => equivalent arm (by simp [member])) + +/-- All successes, errors and early returns are identical, including their +full memory and I/O states. Fuel is unchanged because it counts calls. -/ +theorem interp_restoreTailMatches (decls : Decls) (fuel : Nat) (term : Term) + (bindings : Bindings) (st : EvalState) : + interp decls fuel bindings term st = + interp decls fuel bindings term.restoreTailMatches st := by + induction term using Term.restoreTailMatches.induct generalizing bindings st with + | case1 x value y same ih => + simp only [Term.restoreTailMatches, if_pos same] + rw [← ih] + simp only [interp] + cases interp decls fuel bindings value st with + | error e => rfl + | ok result => + rcases result with ⟨v, st'⟩ + simp [matchPattern, same] + | case2 x value y different => simp only [Term.restoreTailMatches, if_neg different] + | case3 pattern value body notEta ih => + rw [Term.restoreTailMatches.eq_def] + split + next x value' y impossible => + cases impossible + exact False.elim (notEta x y rfl rfl) + next => + rename_i p v b _ heq + cases heq + simp only [interp] + cases interp decls fuel bindings value st with + | error e => rfl + | ok result => + rcases result with ⟨v, st'⟩ + dsimp only + cases matchPattern st'.store pattern v with + | none => rfl + | some bs => exact ih (bs ++ bindings) st' + next s arms impossible => cases impossible + next => rfl + | case4 scrut arms ih => + simp only [Term.restoreTailMatches, interp] + cases interp decls fuel bindings scrut st with + | error e => rfl + | ok result => + rcases result with ⟨v, st'⟩ + simpa only [List.attach_map_val (f := fun (arm : Pattern × Term) => + (arm.1, arm.2.restoreTailMatches))] using + evalMatchCases_map decls fuel Term.restoreTailMatches arms + (fun arm member => ih ⟨arm, member⟩) bindings st' v + | case5 term notEta notLet notMatch => + rw [Term.restoreTailMatches.eq_def] + split + · exact False.elim (notEta _ _ _ rfl) + · exact False.elim (notLet _ _ _ rfl) + · exact False.elim (notMatch _ _ rfl) + · rfl + +end Aiur.Source.Eval diff --git a/Ix/Aiur/RowCounts.lean b/Ix/Aiur/RowCounts.lean new file mode 100644 index 000000000..81e888c73 --- /dev/null +++ b/Ix/Aiur/RowCounts.lean @@ -0,0 +1,105 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +module +public import Ix.Aiur.Stages.Bytecode + +/-! Total control counts and circuit checks independent of witness values. +These checks bound branch/terminal counts and the number of raw return writers. +Physical columns, lookup cursors and value indices remain separate. -/ + +public section +@[expose] section + +namespace Aiur.Bytecode + +/-- Counts of control nodes, allocated leaf selectors, returns and escaping +yields. Consumed yields still allocate selectors. -/ +structure ControlCounts where + nodes : Nat + leaves : Nat + returns : Nat + yields : Nat + deriving Repr, DecidableEq + +def ControlCounts.sum (items : List ControlCounts) : ControlCounts := + ⟨(items.map (·.nodes)).sum, (items.map (·.leaves)).sum, + (items.map (·.returns)).sum, (items.map (·.yields)).sum⟩ + +def ControlCounts.branch (items : List ControlCounts) : ControlCounts := + { sum items with nodes := (sum items).nodes + 1 } + +def ControlCounts.continue (branches continuation : ControlCounts) : ControlCounts := + ⟨branches.nodes + continuation.nodes, branches.leaves + continuation.leaves, + branches.returns + continuation.returns, continuation.yields⟩ + +private theorem counts_block_smaller (block : Block) : sizeOf block.ctrl < sizeOf block := by + cases block + simp + omega + +mutual + +def Ctrl.controlCounts : Ctrl → ControlCounts + | .return .. => ⟨1, 1, 1, 0⟩ + | .yield .. => ⟨1, 1, 0, 1⟩ + | .match _ branches fallback => ControlCounts.branch ( + (branches.attach.toList.map fun ⟨pair, _⟩ => pair.2.controlCounts) ++ + (match fallback with | none => [] | some block => [block.controlCounts])) + | .matchContinue _ branches fallback _ _ _ continuation => (ControlCounts.branch ( + (branches.attach.toList.map fun ⟨pair, _⟩ => pair.2.controlCounts) ++ + (match fallback with | none => [] | some block => [block.controlCounts]))).continue + continuation.controlCounts +termination_by ctrl => sizeOf ctrl +decreasing_by + all_goals first + | decreasing_tactic + | (have := Array.sizeOf_lt_of_mem ‹_ ∈ _›; grind) + +def Block.controlCounts (block : Block) : ControlCounts := block.ctrl.controlCounts +termination_by sizeOf block +decreasing_by exact counts_block_smaller block + +end + +def branchControlCounts (branches : Array (G × Block)) (fallback : Option Block) : List ControlCounts := + branches.toList.map (fun pair => pair.2.controlCounts) ++ + fallback.toList.map (fun block => block.controlCounts) + +/-- Syntax-only count checks for the functions actually named by a circuit. +The allocated selector count bounds all return/yield leaves, including yields +consumed by continuations. Other layout and value-index checks are separate. -/ +def Circuit.validateRowCounts (program : Toplevel) (circuit : Circuit) : Bool := + circuit.members.size < gSize.toNat && + match circuit.members.toList.mapM (fun index => program.functions[index]?) with + | none => false + | some functions => + functions.all (fun function => function.body.controlCounts.nodes < gSize.toNat) && + (functions.map (fun function => function.body.controlCounts.leaves)).sum ≤ circuit.layout.selectors + +def Toplevel.validateRowCounts (program : Toplevel) : Bool := + program.circuits.all (Circuit.validateRowCounts program) + +theorem Ctrl.controlCounts_match (index : ValIdx) (branches : Array (G × Block)) (fallback : Option Block) : + (Ctrl.match index branches fallback).controlCounts = + ControlCounts.branch (branchControlCounts branches fallback) := by + rw [Ctrl.controlCounts.eq_def] + simp only [branchControlCounts, Array.toList_attach] + rw [List.attachWith_map_val (f := fun pair : G × Block => pair.2.controlCounts)] + cases fallback <;> rfl + +theorem Ctrl.controlCounts_matchContinue (index : ValIdx) (branches : Array (G × Block)) + (fallback : Option Block) (outputs aux lookups : Nat) (continuation : Block) : + (Ctrl.matchContinue index branches fallback outputs aux lookups continuation).controlCounts = + (ControlCounts.branch (branchControlCounts branches fallback)).continue continuation.controlCounts := by + rw [Ctrl.controlCounts.eq_def] + simp only [branchControlCounts, Array.toList_attach] + rw [List.attachWith_map_val (f := fun pair : G × Block => pair.2.controlCounts)] + cases fallback <;> rfl + +end Aiur.Bytecode + +end +end diff --git a/Ix/Aiur/Semantics/AIR.lean b/Ix/Aiur/Semantics/AIR.lean new file mode 100644 index 000000000..f3acc5df8 --- /dev/null +++ b/Ix/Aiur/Semantics/AIR.lean @@ -0,0 +1,214 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +module +public import Ix.Aiur.Stages.Bytecode + +/-! +Relational bytecode semantics for AIR extraction. + +Each local execution records its constrained call requests. Advice is chosen +at each operation, including I/O reads and unconstrained calls. I/O writes, +key insertion and debugging impose no relation, as in the native constraint +emitter. Memory is a shared relation between width, pointer and contents; +its functionality is a separate memory-table obligation. + +`Execution` closes local executions into finite call derivations. It neither +replays the runtime cache nor identifies advice with native hint results. +Proving that arbitrary native AIR rows have these local semantics, and that +the selected certified program checks the advice it needs, remain obligations. +-/ + +public section +@[expose] section + +namespace Aiur.Bytecode.AIR + +/-- Immutable memory facts supplied by the memory tables. -/ +abbrev Memory := Nat → G → Array G → Prop + +/-- A full function lookup, before channel encoding or compression. -/ +structure Call where + function : FunIdx + inputs : Array G + outputs : Array G + rank : G + deriving DecidableEq + +/-- Read all indexed values, rejecting an invalid index. -/ +def readValues (values : Array G) (indices : Array ValIdx) : Option (Array G) := + indices.mapM fun index => values[index]? + +/-- Little-endian packing as field arithmetic. The caller checks length four. -/ +def packWord (bytes : Array G) : G := + bytes.toList.zipIdx.foldl (fun value (byte, index) => + value + byte * G.ofNat (256 ^ index)) 0 + +def adviceOfSize (size : Nat) (advice : Array G) : Option (Array G) := + if advice.size = size then some advice else none + +def unaryByte (values : Array G) (index : ValIdx) + (compute : G → Array G) : Option (Array G) := do + let value ← values[index]? + if value.n < 256 then some (compute value) else none + +def binaryByte (values : Array G) (left right : ValIdx) + (compute : G → G → Array G) : Option (Array G) := do + let x ← values[left]? + let y ← values[right]? + if x.n < 256 ∧ y.n < 256 then some (compute x y) else none + +def pairValues (pair : G × G) : Array G := #[pair.1, pair.2] + +def readWord (values : Array G) (indices : Array ValIdx) : Option G := do + if indices.size ≠ 4 then none else do + let bytes ← readValues values indices + some (packWord bytes) + +/-- Local operation outputs. Calls constrained by function lookups and +memory operations have separate `Step` constructors. All other constructors +are covered here, including the virtual carry of an unconstrained u32 sum. +Byte gadgets require their table input ranges; advice bytes do not. -/ +def primitive (op : Op) (values advice : Array G) : Option (Array G) := + match op with + | .const value => some #[value] + | .add a b => do return #[(← values[a]?) + (← values[b]?)] + | .sub a b => do return #[(← values[a]?) - (← values[b]?)] + | .mul a b => do return #[(← values[a]?) * (← values[b]?)] + | .eqZero a => do return #[G.eqZero (← values[a]?)] + | .call _ _ outputSize true => adviceOfSize outputSize advice + | .call _ _ _ false | .store _ | .load _ _ => none + | .assertEq xs ys _ => do + let left ← readValues values xs + let right ← readValues values ys + if left = right then some #[] else none + | .ioGetInfo _ _ => adviceOfSize 2 advice + | .ioRead _ _ size => adviceOfSize size advice + | .ioSetInfo _ _ _ _ | .ioWrite _ _ | .debug _ _ => some #[] + | .u8BitDecomposition a => unaryByte values a (Array.ofFn ∘ G.u8BitDecomposition) + | .u8ShiftLeft a => unaryByte values a fun x => #[G.u8ShiftLeft x] + | .u8ShiftRight a => unaryByte values a fun x => #[G.u8ShiftRight x] + | .u8Xor a b => binaryByte values a b fun x y => #[G.u8Xor x y] + | .u8Add a b => binaryByte values a b fun x y => pairValues (G.u8Add x y) + | .u8Mul a b => binaryByte values a b fun x y => pairValues (G.u8Mul x y) + | .u8Sub a b => binaryByte values a b fun x y => pairValues (G.u8Sub x y) + | .u8And a b => binaryByte values a b fun x y => #[G.u8And x y] + | .u8Or a b => binaryByte values a b fun x y => #[G.u8Or x y] + | .u8LessThan a b => binaryByte values a b fun x y => #[G.u8LessThan x y] + | .u8XorSplit7 a b => binaryByte values a b fun x y => + let z := x.n ^^^ y.n + #[G.ofNat (z / 128), G.ofNat ((z * 2) % 256)] + | .u8XorSplit4 a b => binaryByte values a b fun x y => + let z := x.n ^^^ y.n + #[G.ofNat (z / 16), G.ofNat ((z * 16) % 256)] + | .u8RangeCheck a b => binaryByte values a b fun _ _ => #[] + | .u32LessThan a b => do + let x ← values[a]? + let y ← values[b]? + if x.n < 2 ^ 32 ∧ y.n < 2 ^ 32 then some #[G.u32LessThan x y] else none + | .unconstrainedBigUintDivMod _ _ => adviceOfSize 2 advice + | .unconstrainedGToBytes _ => adviceOfSize 8 advice + | .unconstrainedGInverse _ => adviceOfSize 1 advice + | .unconstrainedU32Add a b => do + let x ← readWord values a + let y ← readWord values b + let bytes ← adviceOfSize 4 advice + return bytes.push ((x + y - packWord bytes) * 0xfffffffe00000002) + | .unconstrainedU32Add3 a b c => do + let x ← readWord values a + let y ← readWord values b + let z ← readWord values c + let bytes ← adviceOfSize 4 advice + return bytes.push ((x + y + z - packWord bytes) * 0xfffffffe00000002) + | .u32ToField bytes => do return #[← readWord values bytes] + +/-- One operation, with the constrained calls it requests. Advice is local +to this occurrence, even when the same operation appears in another row. -/ +inductive Step (memory : Memory) : Op → Array G → Array G → List Call → Prop + | primitive (evaluated : primitive op values advice = some outputs) : + Step memory op values (values ++ outputs) [] + | call (arguments : readValues values indices = some request.inputs) + (outputSize : request.outputs.size = size) : + Step memory (.call request.function indices size false) values + (values ++ request.outputs) [request] + | store (arguments : readValues values indices = some contents) + (stored : memory contents.size pointer contents) : + Step memory (.store indices) values (values.push pointer) [] + | load (address : values[index]? = some pointer) + (width : contents.size = size) (loaded : memory size pointer contents) : + Step memory (.load size index) values (values ++ contents) [] + +inductive RunOps (memory : Memory) : List Op → Array G → Array G → List Call → Prop + | nil : RunOps memory [] values values [] + | cons (first : Step memory op values intermediate firstCalls) + (rest : RunOps memory ops intermediate finalValues restCalls) : + RunOps memory (op :: ops) values finalValues (firstCalls ++ restCalls) + +/-- Returns escape the function; yields enter the nearest continuation. -/ +inductive Outcome where + | returned : Array G → Outcome + | yielded : Array G → Outcome + +/-- A matching branch, or the default when no discriminant matches. +Duplicate case keys remain nondeterministic here, as permitted by the +selector equations; compiler uniqueness is a separate obligation. -/ +inductive SelectArm (scrutinee : G) (cases : Array (G × Block)) + (fallback : Option Block) : Block → Prop + | case (member : (scrutinee, block) ∈ cases.toList) : + SelectArm scrutinee cases fallback block + | fallback (selected : fallback = some block) + (unmatched : ∀ pair ∈ cases.toList, pair.1 ≠ scrutinee) : + SelectArm scrutinee cases fallback block + +mutual + +inductive RunBlock (memory : Memory) : Block → Array G → Outcome → List Call → Prop + | block (operations : RunOps memory block.ops.toList values intermediate opCalls) + (control : RunCtrl memory block.ctrl intermediate outcome ctrlCalls) : + RunBlock memory block values outcome (opCalls ++ ctrlCalls) + +inductive RunCtrl (memory : Memory) : Ctrl → Array G → Outcome → List Call → Prop + | returned (result : readValues values indices = some outputs) : + RunCtrl memory (.return selector indices) values (.returned outputs) [] + | yielded (result : readValues values indices = some outputs) : + RunCtrl memory (.yield selector indices) values (.yielded outputs) [] + | match (value : values[index]? = some scrutinee) + (selected : SelectArm scrutinee cases fallback arm) + (branch : RunBlock memory arm values outcome calls) : + RunCtrl memory (.match index cases fallback) values outcome calls + | matchContinueReturn (value : values[index]? = some scrutinee) + (selected : SelectArm scrutinee cases fallback arm) + (branch : RunBlock memory arm values (.returned outputs) calls) : + RunCtrl memory (.matchContinue index cases fallback size aux lookups continuation) + values (.returned outputs) calls + | matchContinueYield (value : values[index]? = some scrutinee) + (selected : SelectArm scrutinee cases fallback arm) + (branch : RunBlock memory arm values (.yielded yielded) branchCalls) + (outputSize : yielded.size = size) + (continued : RunBlock memory continuation (values ++ yielded) outcome contCalls) : + RunCtrl memory (.matchContinue index cases fallback size aux lookups continuation) + values outcome (branchCalls ++ contCalls) + +end + +/-- Local meaning of one function row, before resolving its call requests. -/ +inductive RunFunction (program : Toplevel) (memory : Memory) : Call → List Call → Prop + | function (selected : program.functions[request.function]? = some function) + (arity : function.layout.inputSize = request.inputs.size) + (body : RunBlock memory function.body request.inputs (.returned request.outputs) calls) : + RunFunction program memory request calls + +/-- A finite derivation: every constrained call has its own finite derivation. +Rows may be reused by several callers. Advice and immutable memory facts are +retained by the local relations, without asserting sequential cache effects. -/ +inductive Execution (program : Toplevel) (memory : Memory) : Call → Prop + | function (row : RunFunction program memory request calls) + (children : ∀ child ∈ calls, Execution program memory child) : + Execution program memory request + +end Aiur.Bytecode.AIR + +end +end diff --git a/Ix/Aiur/Semantics/BytecodeEval.lean b/Ix/Aiur/Semantics/BytecodeEval.lean index 7656bcec9..987fc6c6f 100644 --- a/Ix/Aiur/Semantics/BytecodeEval.lean +++ b/Ix/Aiur/Semantics/BytecodeEval.lean @@ -6,17 +6,18 @@ public import Ix.IndexMap /-! Lean-native bytecode reference evaluator. -Mirrors `src/aiur/execute.rs` in big-step form: +Uncached big-step model of bytecode operations: - No `QueryRecord` (trace-side bookkeeping). - No call cache. -- No `unconstrained` branching (both branches of every `if unconstrained` produce - the same value; they differ only in whether a query is logged). +- No `unconstrained` branching or constrained promotion. - No stack machine — direct big-step. - Call-only fuel decrement at `Op.call`. - Errors return, never panic. -Per-width memory buckets mirror Rust's `QueryRecord.memory_queries` -(`execute.rs:36-40`). Each `Op.store values` uses `values.size` as the width key. +Runtime cache hits and promotion can change effect multiplicity. Relating this +model to native execution requires a separate refinement argument. Per-width +memory buckets mirror Rust's `QueryRecord.memory_queries`; each +`Op.store values` uses `values.size` as the width key. -/ public section diff --git a/Ix/Aiur/Semantics/Flatten.lean b/Ix/Aiur/Semantics/Flatten.lean index 81c643912..91344179c 100644 --- a/Ix/Aiur/Semantics/Flatten.lean +++ b/Ix/Aiur/Semantics/Flatten.lean @@ -26,12 +26,33 @@ inductive Value : Type where | array : Array Value → Value | ctor : Global → Array Value → Value | fn : Global → Value - /-- `width, index` — width is the flat size of the stored element's type. In the - Source-form evaluator only `index` is meaningful; in the Concrete-form - evaluator `width` selects the per-width memory bucket to match Rust's + /-- `width, index` — width selects the memory bucket and index selects an + entry within that bucket in both reference evaluators, matching Rust's `memory_queries`. -/ | pointer : (width : Nat) → (index : Nat) → Value - deriving Repr, Hashable, Inhabited + deriving Repr, Inhabited + +/-- Total structural hashing for reference-evaluator memory keys. Tags, +array seed and traversal order retain the original native derivation. -/ +def Value.hash : Value → UInt64 + | .unit => 0 + | .field g => mixHash 1 (Hashable.hash g) + | .tuple values => mixHash 2 (values.attach.foldl + (fun acc value => mixHash acc (Value.hash value.val)) 7) + | .array values => mixHash 3 (values.attach.foldl + (fun acc value => mixHash acc (Value.hash value.val)) 7) + | .ctor global values => mixHash (mixHash 4 (Hashable.hash global)) (values.attach.foldl + (fun acc value => mixHash acc (Value.hash value.val)) 7) + | .fn global => mixHash 5 (Hashable.hash global) + | .pointer width index => mixHash (mixHash 6 (Hashable.hash width)) (Hashable.hash index) +termination_by value => sizeOf value +decreasing_by + all_goals + have bound := Array.sizeOf_lt_of_mem value.property + simp_all + omega + +instance : Hashable Value := ⟨Value.hash⟩ deriving instance DecidableEq for Global diff --git a/Ix/Aiur/Semantics/SourceEval.lean b/Ix/Aiur/Semantics/SourceEval.lean index c0ce18fc6..198d84dd2 100644 --- a/Ix/Aiur/Semantics/SourceEval.lean +++ b/Ix/Aiur/Semantics/SourceEval.lean @@ -7,17 +7,18 @@ public import Ix.Aiur.Protocol Source-form reference evaluator — proof-bearing semantics on `Source.Term`. Design: -- **No cache.** The cache is a debug-interpreter optimization (`Ix/Aiur/Interpret.lean`) - and a Rust trace-multiplicity device, not part of the semantic model. +- **Uncached calls.** Runtime and interpreter cache hits can change the I/O of + repeated effectful calls. Relating this model to those engines requires a + separate refinement argument with explicit conditions on the program. - **No stack trace.** Errors are tagged; debugging is the debug interpreter's job. - **Fuel-indexed, call-only accounting.** `fuel : Nat` decrements only at `applyGlobal`. Intra-body recursion is structural. - **Errors return, never panic.** `ioSetInfo` on existing key, `ioRead` OOB, pattern failure, type mismatch, etc. all produce `Except.error`. -This source-level evaluator does not yet distinguish pointer widths — source -pointers are a single global store. The width-bucketed `Concrete.Eval` -evaluator fixes that divergence with Rust. +Memory uses width buckets computed by flattening source values. Relating +these widths to the concrete evaluator's type layouts remains a compiler +reflection obligation. -/ public section @@ -619,7 +620,11 @@ def interp (decls : Decls) (fuel : Nat) (bindings : Bindings) -- `toField` / `u8FromFieldUnsafe` are erased coercions: value unchanged. | .toField t | .u8FromFieldUnsafe t => interp decls fuel bindings t st | .u8Lit n => .ok (.field (G.ofNat n), st) - | .debug _ _ ret => interp decls fuel bindings ret st + | .debug _ none ret => interp decls fuel bindings ret st + | .debug _ (some value) ret => + match interp decls fuel bindings value st with + | .error error => .error error + | .ok (_, st') => interp decls fuel bindings ret st' | .ioGetInfo channel key => match interp decls fuel bindings channel st with | .error e => .error e diff --git a/Ix/Aiur/Stages/Bytecode.lean b/Ix/Aiur/Stages/Bytecode.lean index 21c52fd66..887939f8a 100644 --- a/Ix/Aiur/Stages/Bytecode.lean +++ b/Ix/Aiur/Stages/Bytecode.lean @@ -72,7 +72,12 @@ inductive Op | unconstrainedU32Add3 : Array ValIdx → Array ValIdx → Array ValIdx → Op /-- Virtual LE-byte packing expression; allocates no auxiliary column. -/ | u32ToField : Array ValIdx → Op - deriving Repr, BEq, Hashable + deriving Repr, BEq, ReflBEq, Hashable + +instance : LawfulBEq Op := ⟨by + deriving_LawfulEq_tactic + intro h + exact congrArg Op.const (eq_of_beq h)⟩ mutual inductive Ctrl where @@ -90,8 +95,204 @@ mutual deriving Inhabited, Repr end -deriving instance BEq, Hashable for Ctrl, Block +/-! Total recursive comparison and hashing for deduplication. The ordinary +mutual deriving handlers produce partial opaque logical defaults with +separate native workers. These definitions expose the actual algorithms to +proofs while retaining the native comparison order, hash tags and seeds. -/ + +private theorem Block.ctrl_lt (block : Block) : sizeOf block.ctrl < sizeOf block := by + cases block + simp + omega + +mutual + +/-- Compare all control fields, including layout metadata and continuations. -/ +def Ctrl.beq : Ctrl → Ctrl → Bool + | .match idx cases fallback, .match idx' cases' fallback' => + idx == idx' && (beqBranches cases cases' && beqFallback fallback fallback') + | .return sel outs, .return sel' outs' => sel == sel' && outs == outs' + | .yield sel outs, .yield sel' outs' => sel == sel' && outs == outs' + | .matchContinue idx cases fallback outputs aux lookups cont, + .matchContinue idx' cases' fallback' outputs' aux' lookups' cont' => + idx == idx' && (beqBranches cases cases' && (beqFallback fallback fallback' && + (outputs == outputs' && (aux == aux' && (lookups == lookups' && Block.beq cont cont'))))) + | _, _ => false +termination_by left _ => (sizeOf left, 0) +decreasing_by all_goals decreasing_tactic + +def Block.beq (left right : Block) : Bool := + left.ops == right.ops && Ctrl.beq left.ctrl right.ctrl +termination_by (sizeOf left, 0) +decreasing_by + apply Prod.Lex.left + exact Block.ctrl_lt left + +def beqFallback : Option Block → Option Block → Bool + | none, none => true + | some left, some right => Block.beq left right + | _, _ => false +termination_by left _ => (sizeOf left, 0) +decreasing_by all_goals decreasing_tactic + +def beqBranches (left right : Array (G × Block)) : Bool := + if h : left.size = right.size then beqBranchesAux left right h left.size (Nat.le_refl _) + else false +termination_by (sizeOf left, left.size + 1) +decreasing_by all_goals decreasing_tactic + +/-- Match `Array.isEqvAux`'s reverse traversal without hiding recursive +block comparisons behind an unbounded callback. -/ +def beqBranchesAux (left right : Array (G × Block)) (hsz : left.size = right.size) : + (n : Nat) → n ≤ left.size → Bool + | 0, _ => true + | n + 1, h => + (left[n].1 == (right[n]'(hsz ▸ h)).1 && Block.beq left[n].2 (right[n]'(hsz ▸ h)).2) && + beqBranchesAux left right hsz n (by omega) +termination_by n _ => (sizeOf left, n) +decreasing_by + all_goals first + | decreasing_tactic + | (apply Prod.Lex.left + have arrayBound := Array.sizeOf_get left n (by omega) + have pairBound : sizeOf left[n].2 < sizeOf left[n] := by + cases left[n]; simp; omega + omega) + +end + +instance : BEq Ctrl := ⟨Ctrl.beq⟩ +instance : BEq Block := ⟨Block.beq⟩ + +mutual + +/-- Boolean comparison reflects exact syntax equality. -/ +theorem Ctrl.beq_eq_true_iff (left right : Ctrl) : Ctrl.beq left right = true ↔ left = right := by + cases left <;> cases right <;> + simp only [Ctrl.beq, Bool.and_eq_true, beq_iff_eq, reduceCtorEq, Bool.false_eq_true, + Ctrl.match.injEq, Ctrl.return.injEq, Ctrl.yield.injEq, Ctrl.matchContinue.injEq] + all_goals rw [beqBranches_eq_true_iff, beqFallback_eq_true_iff] + all_goals rw [Block.beq_eq_true_iff] +termination_by (sizeOf left, 0) +decreasing_by all_goals decreasing_tactic + +theorem Block.beq_eq_true_iff (left right : Block) : Block.beq left right = true ↔ left = right := by + cases left + cases right + simp only [Block.beq, Bool.and_eq_true, beq_iff_eq, Block.mk.injEq] + rw [Ctrl.beq_eq_true_iff] +termination_by (sizeOf left, 0) +decreasing_by all_goals decreasing_tactic + +theorem beqFallback_eq_true_iff (left right : Option Block) : + beqFallback left right = true ↔ left = right := by + cases left <;> cases right <;> + simp only [beqFallback, reduceCtorEq, Bool.false_eq_true, Option.some.injEq] + rw [Block.beq_eq_true_iff] +termination_by (sizeOf left, 0) +decreasing_by all_goals decreasing_tactic + +theorem beqBranches_eq_true_iff (left right : Array (G × Block)) : + beqBranches left right = true ↔ left = right := by + unfold beqBranches + split + next hsz => + rw [beqBranchesAux_eq_true_iff] + constructor + · intro h + exact Array.ext hsz (fun i hi _ => h i hi) + · intro h + subst right + intros + rfl + next hsz => + simp only [Bool.false_eq_true, false_iff] + intro h + exact hsz (congrArg Array.size h) +termination_by (sizeOf left, left.size + 1) +decreasing_by all_goals decreasing_tactic + +theorem beqBranchesAux_eq_true_iff (left right : Array (G × Block)) + (hsz : left.size = right.size) (n : Nat) (hn : n ≤ left.size) : + beqBranchesAux left right hsz n hn = true ↔ + ∀ i (hi : i < n), (left[i]'(by omega)) = (right[i]'(by omega)) := by + cases n with + | zero => simp [beqBranchesAux] + | succ n => + rw [beqBranchesAux, Bool.and_eq_true, Bool.and_eq_true, + beq_iff_eq, Block.beq_eq_true_iff, beqBranchesAux_eq_true_iff] + constructor + · rintro ⟨⟨hg, hb⟩, tail⟩ i hi + by_cases h : i < n + · exact tail i h + · have : i = n := by omega + subst i + exact Prod.ext hg hb + · intro h + refine ⟨⟨congrArg Prod.fst (h n (by omega)), congrArg Prod.snd (h n (by omega))⟩, ?_⟩ + intro i hi + exact h i (by omega) +termination_by (sizeOf left, n) +decreasing_by + all_goals first + | decreasing_tactic + | (apply Prod.Lex.left + have arrayBound := Array.sizeOf_get left n (by omega) + have pairBound : sizeOf left[n].2 < sizeOf left[n] := by + cases left[n]; simp; omega + omega) + +end + +instance : LawfulBEq Ctrl where + eq_of_beq {left right} h := (Ctrl.beq_eq_true_iff left right).mp h + rfl {value} := (Ctrl.beq_eq_true_iff value value).mpr rfl + +instance : LawfulBEq Block where + eq_of_beq {left right} h := (Block.beq_eq_true_iff left right).mp h + rfl {value} := (Block.beq_eq_true_iff value value).mpr rfl + +mutual + +/-- Preserve the derived hash algorithm: constructor tags 0–3, array seed +7, option tags 11/13 and the original left-to-right field mixing. -/ +def Ctrl.hash : Ctrl → UInt64 + | .match idx branches fallback => + let branchesHash := branches.attach.foldl (fun acc pair => + mixHash acc (mixHash (hash pair.val.1) (Block.hash pair.val.2))) 7 + let fallbackHash := match fallback with + | none => 11 + | some block => mixHash (Block.hash block) 13 + mixHash (mixHash (mixHash 0 (hash idx)) branchesHash) fallbackHash + | .return sel outs => mixHash (mixHash 1 (hash sel)) (hash outs) + | .yield sel outs => mixHash (mixHash 2 (hash sel)) (hash outs) + | .matchContinue idx branches fallback outputs aux lookups cont => + let branchesHash := branches.attach.foldl (fun acc pair => + mixHash acc (mixHash (hash pair.val.1) (Block.hash pair.val.2))) 7 + let fallbackHash := match fallback with + | none => 11 + | some block => mixHash (Block.hash block) 13 + mixHash (mixHash (mixHash (mixHash (mixHash (mixHash (mixHash 3 (hash idx)) + branchesHash) fallbackHash) (hash outputs)) (hash aux)) (hash lookups)) (Block.hash cont) +termination_by ctrl => sizeOf ctrl +decreasing_by + all_goals first + | decreasing_tactic + | (have arrayBound := Array.sizeOf_lt_of_mem pair.property + have pairBound : sizeOf pair.val.2 < sizeOf pair.val := by + cases pair.val; simp; omega + simp_all + omega) + +def Block.hash (block : Block) : UInt64 := + mixHash (mixHash 0 (hash block.ops)) (Ctrl.hash block.ctrl) +termination_by sizeOf block +decreasing_by exact Block.ctrl_lt block + +end +instance : Hashable Ctrl := ⟨Ctrl.hash⟩ +instance : Hashable Block := ⟨Block.hash⟩ /-- The circuit layout of a function (non-semantic; the bytecode evaluator ignores it). -/ structure FunctionLayout where @@ -99,7 +300,7 @@ structure FunctionLayout where selectors : Nat auxiliaries : Nat lookups : Nat - deriving Inhabited, Repr, BEq, Hashable, DecidableEq + deriving Inhabited, Repr, BEq, ReflBEq, LawfulBEq, Hashable, DecidableEq def FunctionLayout.width (l : FunctionLayout) : Nat := l.inputSize + l.selectors + l.auxiliaries diff --git a/Ix/Aiur/Stages/Source.lean b/Ix/Aiur/Stages/Source.lean index 52c0c7426..2b5779af5 100644 --- a/Ix/Aiur/Stages/Source.lean +++ b/Ix/Aiur/Stages/Source.lean @@ -379,8 +379,9 @@ namespace Source output columns at the call site). * `unconstrained` — a call whose callee is trusted (no lookup / circuit constraint); the old `unconstrained := true`. -* `inlined` — the callee's body is spliced into the caller at compile - time (no separate circuit, no interface columns). Eliminated by +* `inlined` — request that the callee's body be spliced into the caller. + Callees with explicit returns retain a normal function-call boundary. + Eliminated by `Toplevel.inlineCalls` before typechecking; forbidden for callees that are (transitively) inline-recursive. -/ inductive CallMode @@ -575,40 +576,40 @@ where result := result.push item pure (globals, result) -/-- Rename every local bound in a pattern to a fresh `.str "inl#N"` name, -extending `subst` for the pattern's scope and advancing the fresh counter. --/ -def Pattern.freshen (cnt : Nat) (subst : Std.HashMap Local Local) : +/-- Allocate one fresh name per binder in a pattern. Alternative arms +reuse the same renaming for names they bind in common. -/ +def Pattern.freshenBindings (stem : String) (cnt : Nat) (subst : Std.HashMap Local Local) : Pattern → Nat × Std.HashMap Local Local × Pattern | .var x => - let x' : Local := .str s!"inl#{cnt}" + if let some x' := subst[x]? then (cnt, subst, .var x') else + let x' : Local := .str (stem ++ toString cnt) (cnt + 1, subst.insert x x', .var x') | .wildcard => (cnt, subst, .wildcard) | .field g => (cnt, subst, .field g) | .ref g ps => let (cnt, subst, ps') := ps.attach.foldl (init := (cnt, subst, ([] : List Pattern))) fun (cnt, subst, acc) ⟨p, _⟩ => - let (cnt, subst, p') := Pattern.freshen cnt subst p + let (cnt, subst, p') := Pattern.freshenBindings stem cnt subst p (cnt, subst, acc ++ [p']) (cnt, subst, .ref g ps') | .tuple ps => let (cnt, subst, ps') := ps.attach.foldl (init := (cnt, subst, (#[] : Array Pattern))) fun (cnt, subst, acc) ⟨p, _⟩ => - let (cnt, subst, p') := Pattern.freshen cnt subst p + let (cnt, subst, p') := Pattern.freshenBindings stem cnt subst p (cnt, subst, acc.push p') (cnt, subst, .tuple ps') | .array ps => let (cnt, subst, ps') := ps.attach.foldl (init := (cnt, subst, (#[] : Array Pattern))) fun (cnt, subst, acc) ⟨p, _⟩ => - let (cnt, subst, p') := Pattern.freshen cnt subst p + let (cnt, subst, p') := Pattern.freshenBindings stem cnt subst p (cnt, subst, acc.push p') (cnt, subst, .array ps') | .or p q => - let (cnt, subst, p') := Pattern.freshen cnt subst p - let (cnt, subst, q') := Pattern.freshen cnt subst q + let (cnt, subst, p') := Pattern.freshenBindings stem cnt subst p + let (cnt, subst, q') := Pattern.freshenBindings stem cnt subst q (cnt, subst, .or p' q') | .pointer p => - let (cnt, subst, p') := Pattern.freshen cnt subst p + let (cnt, subst, p') := Pattern.freshenBindings stem cnt subst p (cnt, subst, .pointer p') termination_by p => sizeOf p decreasing_by @@ -617,97 +618,105 @@ decreasing_by | (have := Array.sizeOf_lt_of_mem ‹_ ∈ _›; grind) | (have := List.sizeOf_lt_of_mem ‹_ ∈ _›; grind) -/-- Consistently α-rename the locals bound inside `t` to fresh names, -following `subst` for the currently-renamed variables. Used before -splicing an inlined body so its locals cannot collide with the caller's -(the `Simple` pass floats nested `let`s outward, which would otherwise -capture reused names). Only bound occurrences are rewritten; free -variables that are the callee's inputs are handled by `subst` seeded at -the call site. -/ -def Term.freshen (cnt : Nat) (subst : Std.HashMap Local Local) : + +def Pattern.freshenWith (stem : String) (cnt : Nat) + (subst : Std.HashMap Local Local) (pattern : Pattern) : + Nat × Std.HashMap Local Local × Pattern := + let (cnt, names, pattern) := Pattern.freshenBindings stem cnt ∅ pattern + (cnt, names.fold (init := subst) (fun subst old fresh => subst.insert old fresh), pattern) + +def renameLocalCall (subst : Std.HashMap Local Local) (global : Global) : Global := + match global.toName with + | .str .anonymous name => + match subst[Local.str name]? with + | some (.str fresh) => Global.init fresh + | _ => global + | _ => global + +def Term.freshenWith (stem : String) (cnt : Nat) (subst : Std.HashMap Local Local) : Term → Nat × Term := fun t => match t with | .var x => (cnt, .var (subst.getD x x)) | .unit | .ref _ | .field _ | .u8Lit _ => (cnt, t) | .let p v b => - let (cnt, v') := Term.freshen cnt subst v - let (cnt, subst', p') := Pattern.freshen cnt subst p - let (cnt, b') := Term.freshen cnt subst' b + let (cnt, v') := Term.freshenWith stem cnt subst v + let (cnt, subst', p') := Pattern.freshenWith stem cnt subst p + let (cnt, b') := Term.freshenWith stem cnt subst' b (cnt, .let p' v' b') | .match s arms => - let (cnt, s') := Term.freshen cnt subst s + let (cnt, s') := Term.freshenWith stem cnt subst s let (cnt, arms') := arms.attach.foldl (init := (cnt, ([] : List (Pattern × Term)))) fun (cnt, acc) ⟨(p, a), _⟩ => - let (cnt, subst', p') := Pattern.freshen cnt subst p - let (cnt, a') := Term.freshen cnt subst' a + let (cnt, subst', p') := Pattern.freshenWith stem cnt subst p + let (cnt, a') := Term.freshenWith stem cnt subst' a (cnt, acc ++ [(p', a')]) (cnt, .match s' arms') | .tuple ts => let (cnt, ts') := ts.attach.foldl (init := (cnt, #[])) fun (cnt, acc) ⟨x, _⟩ => - let (cnt, x') := Term.freshen cnt subst x; (cnt, acc.push x') + let (cnt, x') := Term.freshenWith stem cnt subst x; (cnt, acc.push x') (cnt, .tuple ts') | .array ts => let (cnt, ts') := ts.attach.foldl (init := (cnt, #[])) fun (cnt, acc) ⟨x, _⟩ => - let (cnt, x') := Term.freshen cnt subst x; (cnt, acc.push x') + let (cnt, x') := Term.freshenWith stem cnt subst x; (cnt, acc.push x') (cnt, .array ts') | .app g args mode => let (cnt, args') := args.attach.foldl (init := (cnt, ([] : List Term))) fun (cnt, acc) ⟨x, _⟩ => - let (cnt, x') := Term.freshen cnt subst x; (cnt, acc ++ [x']) - (cnt, .app g args' mode) - | .ret a => let (cnt, a') := Term.freshen cnt subst a; (cnt, .ret a') - | .add a b => let (cnt, a') := Term.freshen cnt subst a; let (cnt, b') := Term.freshen cnt subst b; (cnt, .add a' b') - | .sub a b => let (cnt, a') := Term.freshen cnt subst a; let (cnt, b') := Term.freshen cnt subst b; (cnt, .sub a' b') - | .mul a b => let (cnt, a') := Term.freshen cnt subst a; let (cnt, b') := Term.freshen cnt subst b; (cnt, .mul a' b') - | .eqZero a => let (cnt, a') := Term.freshen cnt subst a; (cnt, .eqZero a') - | .proj a n => let (cnt, a') := Term.freshen cnt subst a; (cnt, .proj a' n) - | .get a n => let (cnt, a') := Term.freshen cnt subst a; (cnt, .get a' n) - | .slice a i j => let (cnt, a') := Term.freshen cnt subst a; (cnt, .slice a' i j) - | .set a n v => let (cnt, a') := Term.freshen cnt subst a; let (cnt, v') := Term.freshen cnt subst v; (cnt, .set a' n v') - | .store a => let (cnt, a') := Term.freshen cnt subst a; (cnt, .store a') - | .load a => let (cnt, a') := Term.freshen cnt subst a; (cnt, .load a') - | .ptrVal a => let (cnt, a') := Term.freshen cnt subst a; (cnt, .ptrVal a') - | .ann τ a => let (cnt, a') := Term.freshen cnt subst a; (cnt, .ann τ a') + let (cnt, x') := Term.freshenWith stem cnt subst x; (cnt, acc ++ [x']) + (cnt, .app (renameLocalCall subst g) args' mode) + | .ret a => let (cnt, a') := Term.freshenWith stem cnt subst a; (cnt, .ret a') + | .add a b => let (cnt, a') := Term.freshenWith stem cnt subst a; let (cnt, b') := Term.freshenWith stem cnt subst b; (cnt, .add a' b') + | .sub a b => let (cnt, a') := Term.freshenWith stem cnt subst a; let (cnt, b') := Term.freshenWith stem cnt subst b; (cnt, .sub a' b') + | .mul a b => let (cnt, a') := Term.freshenWith stem cnt subst a; let (cnt, b') := Term.freshenWith stem cnt subst b; (cnt, .mul a' b') + | .eqZero a => let (cnt, a') := Term.freshenWith stem cnt subst a; (cnt, .eqZero a') + | .proj a n => let (cnt, a') := Term.freshenWith stem cnt subst a; (cnt, .proj a' n) + | .get a n => let (cnt, a') := Term.freshenWith stem cnt subst a; (cnt, .get a' n) + | .slice a i j => let (cnt, a') := Term.freshenWith stem cnt subst a; (cnt, .slice a' i j) + | .set a n v => let (cnt, a') := Term.freshenWith stem cnt subst a; let (cnt, v') := Term.freshenWith stem cnt subst v; (cnt, .set a' n v') + | .store a => let (cnt, a') := Term.freshenWith stem cnt subst a; (cnt, .store a') + | .load a => let (cnt, a') := Term.freshenWith stem cnt subst a; (cnt, .load a') + | .ptrVal a => let (cnt, a') := Term.freshenWith stem cnt subst a; (cnt, .ptrVal a') + | .ann τ a => let (cnt, a') := Term.freshenWith stem cnt subst a; (cnt, .ann τ a') | .assertEq a b msg c => - let (cnt, a') := Term.freshen cnt subst a; let (cnt, b') := Term.freshen cnt subst b; let (cnt, c') := Term.freshen cnt subst c + let (cnt, a') := Term.freshenWith stem cnt subst a; let (cnt, b') := Term.freshenWith stem cnt subst b; let (cnt, c') := Term.freshenWith stem cnt subst c (cnt, .assertEq a' b' msg c') - | .ioGetInfo c k => let (cnt, c') := Term.freshen cnt subst c; let (cnt, k') := Term.freshen cnt subst k; (cnt, .ioGetInfo c' k') + | .ioGetInfo c k => let (cnt, c') := Term.freshenWith stem cnt subst c; let (cnt, k') := Term.freshenWith stem cnt subst k; (cnt, .ioGetInfo c' k') | .ioSetInfo c k i l rv => - let (cnt, c') := Term.freshen cnt subst c; let (cnt, k') := Term.freshen cnt subst k; let (cnt, i') := Term.freshen cnt subst i - let (cnt, l') := Term.freshen cnt subst l; let (cnt, rv') := Term.freshen cnt subst rv + let (cnt, c') := Term.freshenWith stem cnt subst c; let (cnt, k') := Term.freshenWith stem cnt subst k; let (cnt, i') := Term.freshenWith stem cnt subst i + let (cnt, l') := Term.freshenWith stem cnt subst l; let (cnt, rv') := Term.freshenWith stem cnt subst rv (cnt, .ioSetInfo c' k' i' l' rv') - | .ioRead c i n => let (cnt, c') := Term.freshen cnt subst c; let (cnt, i') := Term.freshen cnt subst i; (cnt, .ioRead c' i' n) + | .ioRead c i n => let (cnt, c') := Term.freshenWith stem cnt subst c; let (cnt, i') := Term.freshenWith stem cnt subst i; (cnt, .ioRead c' i' n) | .ioWrite c d rv => - let (cnt, c') := Term.freshen cnt subst c; let (cnt, d') := Term.freshen cnt subst d; let (cnt, rv') := Term.freshen cnt subst rv + let (cnt, c') := Term.freshenWith stem cnt subst c; let (cnt, d') := Term.freshenWith stem cnt subst d; let (cnt, rv') := Term.freshenWith stem cnt subst rv (cnt, .ioWrite c' d' rv') - | .u8BitDecomposition a => let (cnt, a') := Term.freshen cnt subst a; (cnt, .u8BitDecomposition a') - | .u8ShiftLeft a => let (cnt, a') := Term.freshen cnt subst a; (cnt, .u8ShiftLeft a') - | .u8ShiftRight a => let (cnt, a') := Term.freshen cnt subst a; (cnt, .u8ShiftRight a') - | .u8Xor a b => let (cnt, a') := Term.freshen cnt subst a; let (cnt, b') := Term.freshen cnt subst b; (cnt, .u8Xor a' b') - | .u8Add a b => let (cnt, a') := Term.freshen cnt subst a; let (cnt, b') := Term.freshen cnt subst b; (cnt, .u8Add a' b') - | .u8Mul a b => let (cnt, a') := Term.freshen cnt subst a; let (cnt, b') := Term.freshen cnt subst b; (cnt, .u8Mul a' b') - | .u8Sub a b => let (cnt, a') := Term.freshen cnt subst a; let (cnt, b') := Term.freshen cnt subst b; (cnt, .u8Sub a' b') - | .u8And a b => let (cnt, a') := Term.freshen cnt subst a; let (cnt, b') := Term.freshen cnt subst b; (cnt, .u8And a' b') - | .u8Or a b => let (cnt, a') := Term.freshen cnt subst a; let (cnt, b') := Term.freshen cnt subst b; (cnt, .u8Or a' b') - | .u8LessThan a b => let (cnt, a') := Term.freshen cnt subst a; let (cnt, b') := Term.freshen cnt subst b; (cnt, .u8LessThan a' b') - | .u32LessThan a b => let (cnt, a') := Term.freshen cnt subst a; let (cnt, b') := Term.freshen cnt subst b; (cnt, .u32LessThan a' b') - | .u8XorSplit7 a b => let (cnt, a') := Term.freshen cnt subst a; let (cnt, b') := Term.freshen cnt subst b; (cnt, .u8XorSplit7 a' b') - | .u8XorSplit4 a b => let (cnt, a') := Term.freshen cnt subst a; let (cnt, b') := Term.freshen cnt subst b; (cnt, .u8XorSplit4 a' b') - | .unconstrainedU32Add a b => let (cnt, a') := Term.freshen cnt subst a; let (cnt, b') := Term.freshen cnt subst b; (cnt, .unconstrainedU32Add a' b') - | .unconstrainedU32Add3 a b c => let (cnt, a') := Term.freshen cnt subst a; let (cnt, b') := Term.freshen cnt subst b; let (cnt, c') := Term.freshen cnt subst c; (cnt, .unconstrainedU32Add3 a' b' c') - | .u32ToField a => let (cnt, a') := Term.freshen cnt subst a; (cnt, .u32ToField a') + | .u8BitDecomposition a => let (cnt, a') := Term.freshenWith stem cnt subst a; (cnt, .u8BitDecomposition a') + | .u8ShiftLeft a => let (cnt, a') := Term.freshenWith stem cnt subst a; (cnt, .u8ShiftLeft a') + | .u8ShiftRight a => let (cnt, a') := Term.freshenWith stem cnt subst a; (cnt, .u8ShiftRight a') + | .u8Xor a b => let (cnt, a') := Term.freshenWith stem cnt subst a; let (cnt, b') := Term.freshenWith stem cnt subst b; (cnt, .u8Xor a' b') + | .u8Add a b => let (cnt, a') := Term.freshenWith stem cnt subst a; let (cnt, b') := Term.freshenWith stem cnt subst b; (cnt, .u8Add a' b') + | .u8Mul a b => let (cnt, a') := Term.freshenWith stem cnt subst a; let (cnt, b') := Term.freshenWith stem cnt subst b; (cnt, .u8Mul a' b') + | .u8Sub a b => let (cnt, a') := Term.freshenWith stem cnt subst a; let (cnt, b') := Term.freshenWith stem cnt subst b; (cnt, .u8Sub a' b') + | .u8And a b => let (cnt, a') := Term.freshenWith stem cnt subst a; let (cnt, b') := Term.freshenWith stem cnt subst b; (cnt, .u8And a' b') + | .u8Or a b => let (cnt, a') := Term.freshenWith stem cnt subst a; let (cnt, b') := Term.freshenWith stem cnt subst b; (cnt, .u8Or a' b') + | .u8LessThan a b => let (cnt, a') := Term.freshenWith stem cnt subst a; let (cnt, b') := Term.freshenWith stem cnt subst b; (cnt, .u8LessThan a' b') + | .u32LessThan a b => let (cnt, a') := Term.freshenWith stem cnt subst a; let (cnt, b') := Term.freshenWith stem cnt subst b; (cnt, .u32LessThan a' b') + | .u8XorSplit7 a b => let (cnt, a') := Term.freshenWith stem cnt subst a; let (cnt, b') := Term.freshenWith stem cnt subst b; (cnt, .u8XorSplit7 a' b') + | .u8XorSplit4 a b => let (cnt, a') := Term.freshenWith stem cnt subst a; let (cnt, b') := Term.freshenWith stem cnt subst b; (cnt, .u8XorSplit4 a' b') + | .unconstrainedU32Add a b => let (cnt, a') := Term.freshenWith stem cnt subst a; let (cnt, b') := Term.freshenWith stem cnt subst b; (cnt, .unconstrainedU32Add a' b') + | .unconstrainedU32Add3 a b c => let (cnt, a') := Term.freshenWith stem cnt subst a; let (cnt, b') := Term.freshenWith stem cnt subst b; let (cnt, c') := Term.freshenWith stem cnt subst c; (cnt, .unconstrainedU32Add3 a' b' c') + | .u32ToField a => let (cnt, a') := Term.freshenWith stem cnt subst a; (cnt, .u32ToField a') | .unconstrainedBigUintDivMod a b => - let (cnt, a') := Term.freshen cnt subst a; let (cnt, b') := Term.freshen cnt subst b; (cnt, .unconstrainedBigUintDivMod a' b') - | .u8RangeCheck a b => let (cnt, a') := Term.freshen cnt subst a; let (cnt, b') := Term.freshen cnt subst b; (cnt, .u8RangeCheck a' b') - | .toField a => let (cnt, a') := Term.freshen cnt subst a; (cnt, .toField a') - | .u8FromFieldUnsafe a => let (cnt, a') := Term.freshen cnt subst a; (cnt, .u8FromFieldUnsafe a') - | .unconstrainedGToBytes a => let (cnt, a') := Term.freshen cnt subst a; (cnt, .unconstrainedGToBytes a') - | .unconstrainedGInverse a => let (cnt, a') := Term.freshen cnt subst a; (cnt, .unconstrainedGInverse a') + let (cnt, a') := Term.freshenWith stem cnt subst a; let (cnt, b') := Term.freshenWith stem cnt subst b; (cnt, .unconstrainedBigUintDivMod a' b') + | .u8RangeCheck a b => let (cnt, a') := Term.freshenWith stem cnt subst a; let (cnt, b') := Term.freshenWith stem cnt subst b; (cnt, .u8RangeCheck a' b') + | .toField a => let (cnt, a') := Term.freshenWith stem cnt subst a; (cnt, .toField a') + | .u8FromFieldUnsafe a => let (cnt, a') := Term.freshenWith stem cnt subst a; (cnt, .u8FromFieldUnsafe a') + | .unconstrainedGToBytes a => let (cnt, a') := Term.freshenWith stem cnt subst a; (cnt, .unconstrainedGToBytes a') + | .unconstrainedGInverse a => let (cnt, a') := Term.freshenWith stem cnt subst a; (cnt, .unconstrainedGInverse a') | .debug s o a => let (cnt, o') := match o with | none => (cnt, none) - | some x => let (cnt, x') := Term.freshen cnt subst x; (cnt, some x') - let (cnt, a') := Term.freshen cnt subst a + | some x => let (cnt, x') := Term.freshenWith stem cnt subst x; (cnt, some x') + let (cnt, a') := Term.freshenWith stem cnt subst a (cnt, .debug s o' a') termination_by t => sizeOf t decreasing_by @@ -716,6 +725,16 @@ decreasing_by | (have := Array.sizeOf_lt_of_mem ‹_ ∈ _›; grind) | (have := List.sizeOf_lt_of_mem ‹_ ∈ _›; grind) + +/-- Freshen an inlined pattern with the inline-expansion name stem. -/ +def Pattern.freshen (cnt : Nat) (subst : Std.HashMap Local Local) (pattern : Pattern) : + Nat × Std.HashMap Local Local × Pattern := + Pattern.freshenWith "inl#" cnt subst pattern + +/-- Freshen an inlined body, including local function-call names. -/ +def Term.freshen (cnt : Nat) (subst : Std.HashMap Local Local) (term : Term) : Nat × Term := + Term.freshenWith "inl#" cnt subst term + /-- Peel the leading `let` bindings off a term: returns the binding frames (outermost first) and the non-`let` core. -/ def Term.peelLets : Term → List (Pattern × Term) × Term @@ -765,9 +784,47 @@ decreasing_by | (have := Array.sizeOf_lt_of_mem ‹_ ∈ _›; grind) | (have := List.sizeOf_lt_of_mem ‹_ ∈ _›; grind) -/-- Structurally splice every `.app g args .inlined` in `t`, given `done`, +/-- Explicit returns require a function-call boundary when considering +inlining. Splicing them would let a callee return from its caller. -/ +def Term.hasExplicitReturn : Term → Bool + | .ret _ => true + | .var _ | .unit | .field _ | .u8Lit _ | .ref _ => false + | .app _ args _ => args.attach.any fun arg => Term.hasExplicitReturn arg.val + | .tuple terms | .array terms => terms.attach.any fun term => Term.hasExplicitReturn term.val + | .let _ value body => Term.hasExplicitReturn value || Term.hasExplicitReturn body + | .match scrut arms => Term.hasExplicitReturn scrut || + arms.attach.any fun arm => Term.hasExplicitReturn arm.val.2 + | .eqZero a | .proj a _ | .get a _ | .slice a _ _ + | .store a | .load a | .ptrVal a | .ann _ a + | .u8BitDecomposition a | .u8ShiftLeft a | .u8ShiftRight a + | .u32ToField a | .unconstrainedGToBytes a | .unconstrainedGInverse a + | .toField a | .u8FromFieldUnsafe a => Term.hasExplicitReturn a + | .add a b | .sub a b | .mul a b | .set a _ b | .ioGetInfo a b | .ioRead a b _ + | .u8Xor a b | .u8Add a b | .u8Mul a b | .u8Sub a b | .u8And a b | .u8Or a b + | .u8LessThan a b | .u32LessThan a b | .u8XorSplit7 a b | .u8XorSplit4 a b + | .unconstrainedU32Add a b | .unconstrainedBigUintDivMod a b | .u8RangeCheck a b => + Term.hasExplicitReturn a || Term.hasExplicitReturn b + | .assertEq a b _ c | .ioWrite a b c | .unconstrainedU32Add3 a b c => + Term.hasExplicitReturn a || Term.hasExplicitReturn b || Term.hasExplicitReturn c + | .ioSetInfo a b c d e => Term.hasExplicitReturn a || Term.hasExplicitReturn b || + Term.hasExplicitReturn c || Term.hasExplicitReturn d || Term.hasExplicitReturn e + | .debug _ none continuation => Term.hasExplicitReturn continuation + | .debug _ (some value) continuation => + Term.hasExplicitReturn value || Term.hasExplicitReturn continuation +termination_by term => sizeOf term +decreasing_by + all_goals first + | decreasing_tactic + | (have := Array.sizeOf_lt_of_mem term.property; grind) + | (have := List.sizeOf_lt_of_mem arg.property; grind) + | (have := List.sizeOf_lt_of_mem arm.property + have : sizeOf arm.val.2 < sizeOf arm.val := by cases arm.val; simp; omega + simp_all; omega) + +/-- Structurally splice `.app g args .inlined` in `t`, given `done`, which maps each already-expanded callee to its input locals and its (already -inline-free) body. At an inline site the callee's inputs and body are +inline-free) body. Callees containing an explicit return become normal calls +so their return cannot escape the caller. At other inline sites the inputs and body are α-renamed to fresh `inl#N` names (`Term.freshen`, seeded with the inputs), then each fresh input is bound to its argument via a `let`. Freshening the inputs BEFORE binding the arguments is essential: arguments are caller terms, @@ -787,6 +844,7 @@ def Term.expandOnce (done : Std.HashMap Global (List Local × Term)) (cnt : Nat) match done[g]? with | none => (cnt, .app g args' .inlined) | some (ins, body) => + if body.hasExplicitReturn then (cnt, .app g args' .normal) else let (cnt, subst, freshInputs) := ins.foldl (init := (cnt, (∅ : Std.HashMap Local Local), ([] : List Local))) fun (cnt, subst, acc) inp => @@ -890,9 +948,8 @@ decreasing_by | (have := Array.sizeOf_lt_of_mem ‹_ ∈ _›; grind) | (have := List.sizeOf_lt_of_mem ‹_ ∈ _›; grind) -/-- Peel leading lets off each of `ts` (already hoisted), collecting the -frames left-to-right so evaluation order is preserved, and returning the -frame chain plus the cores. -/ +/-- Collect leading let frames in argument order and retain their cores. +Callers must also sequence each core before later frames and avoid capture. -/ def Term.peelListLets (ts : List Term) : List (Pattern × Term) × List Term := ts.foldr (fun t (fs, cs) => let (f, c) := Term.peelLets t; (f ++ fs, c :: cs)) @@ -902,115 +959,267 @@ def Term.peelArrayLets (ts : Array Term) : List (Pattern × Term) × Array Term let (fs, cs) := Term.peelListLets ts.toList (fs, cs.toArray) -/-- Hoist every `let`-chain out of a strict argument position into a -wrapping `let`. Inlining splices a callee body (a `let`-chain ending in a -value) wherever the `@`-call appeared; in a `let`-RHS or tail position the -`Simple` pass already floats those lets outward, but in an argument -position (a `set`/array element, an operator operand, …) they would stay -nested, which the lowering cannot handle. This normalizes all such -positions. `let`-RHS, `match` arm bodies, and `ret`/`debug` continuations -are already handled downstream, so their lets are left in place. -/ -def Term.hoistLets : Term → Term := - fun t => - -- Hoist a construct's argument terms: peel each arg's lets and wrap. - match t with - | .unit | .var _ | .ref _ | .field _ | .u8Lit _ => t - | .let p v b => .let p (Term.hoistLets v) (Term.hoistLets b) - | .match s arms => - let (fs, sc) := Term.peelLets (Term.hoistLets s) - Term.wrapLets fs (.match sc (arms.attach.map fun ⟨(p, a), _⟩ => (p, Term.hoistLets a))) - | .ret a => .ret (Term.hoistLets a) - | .debug s o a => - .debug s (match o with | none => none | some x => some (Term.hoistLets x)) (Term.hoistLets a) - | .tuple ts => - let (fs, cs) := Term.peelArrayLets (ts.attach.map fun ⟨x, _⟩ => Term.hoistLets x) - Term.wrapLets fs (.tuple cs) - | .array ts => - let (fs, cs) := Term.peelArrayLets (ts.attach.map fun ⟨x, _⟩ => Term.hoistLets x) - Term.wrapLets fs (.array cs) - | .app g args mode => - let (fs, cs) := Term.peelListLets (args.attach.map fun ⟨x, _⟩ => Term.hoistLets x) - Term.wrapLets fs (.app g cs mode) - | .assertEq a b msg c => - let (fs, cs) := Term.peelListLets [Term.hoistLets a, Term.hoistLets b, Term.hoistLets c] - match cs with - | [a, b, c] => Term.wrapLets fs (.assertEq a b msg c) - | _ => t - | .ioSetInfo a b c d e => - let (fs, cs) := Term.peelListLets [Term.hoistLets a, Term.hoistLets b, Term.hoistLets c, Term.hoistLets d, Term.hoistLets e] - match cs with - | [a, b, c, d, e] => Term.wrapLets fs (.ioSetInfo a b c d e) - | _ => t - | .ioWrite a b c => - let (fs, cs) := Term.peelListLets [Term.hoistLets a, Term.hoistLets b, Term.hoistLets c] - match cs with - | [a, b, c] => Term.wrapLets fs (.ioWrite a b c) - | _ => t +/-! Argument normalization uses a fresh name stem and evaluates each +argument completely before the next one. Continuations stay after their +operation; array updates evaluate the new value before the array. -/ + +def Pattern.maxNameLength : Pattern → Nat + | .var (.str name) => name.length + | .var (.idx _) | .wildcard | .field _ => 0 + | .ref global ps => ps.attach.foldl + (fun n p => max n (Pattern.maxNameLength p.val)) global.toName.toString.length + | .tuple ps | .array ps => ps.attach.foldl + (fun n p => max n (Pattern.maxNameLength p.val)) 0 + | .or p q => max (Pattern.maxNameLength p) (Pattern.maxNameLength q) + | .pointer p => Pattern.maxNameLength p +termination_by p => sizeOf p +decreasing_by + all_goals first + | decreasing_tactic + | (have := Array.sizeOf_lt_of_mem p.property; grind) + | (have := List.sizeOf_lt_of_mem p.property; grind) + +def Term.maxNameLength : Term → Nat + | .var (.str name) => name.length + | .var (.idx _) | .unit | .field _ | .u8Lit _ => 0 + | .ref global => global.toName.toString.length + | .app global args _ => args.attach.foldl + (fun n arg => max n (Term.maxNameLength arg.val)) global.toName.toString.length + | .tuple terms | .array terms => terms.attach.foldl + (fun n term => max n (Term.maxNameLength term.val)) 0 + | .let pattern value body => + max (Pattern.maxNameLength pattern) (max (Term.maxNameLength value) (Term.maxNameLength body)) + | .match scrut arms => arms.attach.foldl + (fun n arm => max n (max (Pattern.maxNameLength arm.val.1) (Term.maxNameLength arm.val.2))) + (Term.maxNameLength scrut) + | .ret a | .eqZero a | .proj a _ | .get a _ | .slice a _ _ + | .store a | .load a | .ptrVal a | .ann _ a + | .u8BitDecomposition a | .u8ShiftLeft a | .u8ShiftRight a + | .u32ToField a | .unconstrainedGToBytes a | .unconstrainedGInverse a + | .toField a | .u8FromFieldUnsafe a => Term.maxNameLength a + | .add a b | .sub a b | .mul a b | .set a _ b | .ioGetInfo a b | .ioRead a b _ + | .u8Xor a b | .u8Add a b | .u8Mul a b | .u8Sub a b | .u8And a b | .u8Or a b + | .u8LessThan a b | .u32LessThan a b | .u8XorSplit7 a b | .u8XorSplit4 a b + | .unconstrainedU32Add a b | .unconstrainedBigUintDivMod a b | .u8RangeCheck a b => + max (Term.maxNameLength a) (Term.maxNameLength b) + | .assertEq a b _ c | .ioWrite a b c | .unconstrainedU32Add3 a b c => + max (Term.maxNameLength a) (max (Term.maxNameLength b) (Term.maxNameLength c)) + | .ioSetInfo a b c d e => max (Term.maxNameLength a) + (max (Term.maxNameLength b) (max (Term.maxNameLength c) + (max (Term.maxNameLength d) (Term.maxNameLength e)))) + | .debug _ none continuation => Term.maxNameLength continuation + | .debug _ (some value) continuation => max (Term.maxNameLength value) (Term.maxNameLength continuation) +termination_by term => sizeOf term +decreasing_by + all_goals first + | decreasing_tactic + | (have := Array.sizeOf_lt_of_mem term.property; grind) + | (have := List.sizeOf_lt_of_mem arg.property; grind) + | (have := List.sizeOf_lt_of_mem arm.property + have : sizeOf arm.val.2 < sizeOf arm.val := by cases arm.val; simp; omega + simp_all; omega) + +def freshTemporary (stem : String) : StateM Nat Local := do + let n ← get + modify Nat.succ + return .str (stem ++ toString n) + +def Term.bindArguments (stem : String) : + List Term → StateM Nat (List (Pattern × Term) × List Term) + | [] => pure ([], []) + | arg :: args => do + let name ← freshTemporary stem + let (leading, core) := arg.peelLets + let (frames, values) ← Term.bindArguments stem args + return (leading ++ [(.var name, core)] ++ frames, .var name :: values) + +def buildWithArguments (stem : String) (args : List Term) + (build : List Term → Term) : StateM Nat Term := do + let (frames, values) ← Term.bindArguments stem args + return Term.wrapLets frames (build values) + +def Term.hoistLetsAux (stem : String) (term : Term) : StateM Nat Term := do + match term with + | .unit | .var _ | .ref _ | .field _ | .u8Lit _ => return term + | .let pattern value body => + let value ← Term.hoistLetsAux stem value + let body ← Term.hoistLetsAux stem body + let (frames, core) := value.peelLets + return Term.wrapLets frames (.let pattern core body) + | .match scrut arms => + let scrut ← Term.hoistLetsAux stem scrut + let arms ← arms.attach.mapM fun arm => do + return (arm.val.1, ← Term.hoistLetsAux stem arm.val.2) + buildWithArguments stem [scrut] fun + | [scrut] => .match scrut arms + | _ => term + | .ret value => + let value ← Term.hoistLetsAux stem value + let (frames, core) := value.peelLets + return Term.wrapLets frames (.ret core) + | .debug label value continuation => + let continuation ← Term.hoistLetsAux stem continuation + return .let .wildcard (.debug label value .unit) continuation + | .tuple terms => + let terms ← terms.attach.mapM fun t => Term.hoistLetsAux stem t.val + buildWithArguments stem terms.toList (.tuple ∘ List.toArray) + | .array terms => + let terms ← terms.attach.mapM fun t => Term.hoistLetsAux stem t.val + buildWithArguments stem terms.toList (.array ∘ List.toArray) + | .app global args mode => + let args ← args.attach.mapM fun t => Term.hoistLetsAux stem t.val + buildWithArguments stem args (.app global · mode) + | .assertEq a b msg continuation => + let a ← Term.hoistLetsAux stem a + let b ← Term.hoistLetsAux stem b + let continuation ← Term.hoistLetsAux stem continuation + buildWithArguments stem [a, b] fun + | [a, b] => .let .wildcard (.assertEq a b msg .unit) continuation + | _ => term + | .ioWrite channel data continuation => + let channel ← Term.hoistLetsAux stem channel + let data ← Term.hoistLetsAux stem data + let continuation ← Term.hoistLetsAux stem continuation + buildWithArguments stem [channel, data] fun + | [channel, data] => .let .wildcard (.ioWrite channel data .unit) continuation + | _ => term + | .ioSetInfo channel key idx len continuation => + let channel ← Term.hoistLetsAux stem channel + let key ← Term.hoistLetsAux stem key + let idx ← Term.hoistLetsAux stem idx + let len ← Term.hoistLetsAux stem len + let continuation ← Term.hoistLetsAux stem continuation + buildWithArguments stem [channel, key, idx, len] fun + | [channel, key, idx, len] => .let .wildcard (.ioSetInfo channel key idx len .unit) continuation + | _ => term + | .set arr index value => + let value ← Term.hoistLetsAux stem value + let arr ← Term.hoistLetsAux stem arr + buildWithArguments stem [value, arr] fun + | [value, arr] => .set arr index value + | _ => term + | .add a b => + let a ← Term.hoistLetsAux stem a; let b ← Term.hoistLetsAux stem b + buildWithArguments stem [a, b] fun | [a, b] => .add a b | _ => term + | .sub a b => + let a ← Term.hoistLetsAux stem a; let b ← Term.hoistLetsAux stem b + buildWithArguments stem [a, b] fun | [a, b] => .sub a b | _ => term + | .mul a b => + let a ← Term.hoistLetsAux stem a; let b ← Term.hoistLetsAux stem b + buildWithArguments stem [a, b] fun | [a, b] => .mul a b | _ => term | .ioGetInfo a b => - let (fs, cs) := Term.peelListLets [Term.hoistLets a, Term.hoistLets b] - match cs with | [a, b] => Term.wrapLets fs (.ioGetInfo a b) | _ => t - | .ioRead a b n => - let (fs, cs) := Term.peelListLets [Term.hoistLets a, Term.hoistLets b] - match cs with | [a, b] => Term.wrapLets fs (.ioRead a b n) | _ => t - | .add a b => let (fs, cs) := Term.peelListLets [Term.hoistLets a, Term.hoistLets b] - match cs with | [a, b] => Term.wrapLets fs (.add a b) | _ => t - | .sub a b => let (fs, cs) := Term.peelListLets [Term.hoistLets a, Term.hoistLets b] - match cs with | [a, b] => Term.wrapLets fs (.sub a b) | _ => t - | .mul a b => let (fs, cs) := Term.peelListLets [Term.hoistLets a, Term.hoistLets b] - match cs with | [a, b] => Term.wrapLets fs (.mul a b) | _ => t - | .eqZero a => let (fs, c) := Term.peelLets (Term.hoistLets a); Term.wrapLets fs (.eqZero c) - | .proj a n => let (fs, c) := Term.peelLets (Term.hoistLets a); Term.wrapLets fs (.proj c n) - | .get a n => let (fs, c) := Term.peelLets (Term.hoistLets a); Term.wrapLets fs (.get c n) - | .slice a i j => let (fs, c) := Term.peelLets (Term.hoistLets a); Term.wrapLets fs (.slice c i j) - | .set a n v => - let (fs, cs) := Term.peelListLets [Term.hoistLets a, Term.hoistLets v] - match cs with | [a, v] => Term.wrapLets fs (.set a n v) | _ => t - | .store a => let (fs, c) := Term.peelLets (Term.hoistLets a); Term.wrapLets fs (.store c) - | .load a => let (fs, c) := Term.peelLets (Term.hoistLets a); Term.wrapLets fs (.load c) - | .ptrVal a => let (fs, c) := Term.peelLets (Term.hoistLets a); Term.wrapLets fs (.ptrVal c) - | .ann τ a => let (fs, c) := Term.peelLets (Term.hoistLets a); Term.wrapLets fs (.ann τ c) - | .u8BitDecomposition a => let (fs, c) := Term.peelLets (Term.hoistLets a); Term.wrapLets fs (.u8BitDecomposition c) - | .u8ShiftLeft a => let (fs, c) := Term.peelLets (Term.hoistLets a); Term.wrapLets fs (.u8ShiftLeft c) - | .u8ShiftRight a => let (fs, c) := Term.peelLets (Term.hoistLets a); Term.wrapLets fs (.u8ShiftRight c) - | .toField a => let (fs, c) := Term.peelLets (Term.hoistLets a); Term.wrapLets fs (.toField c) - | .u8FromFieldUnsafe a => let (fs, c) := Term.peelLets (Term.hoistLets a); Term.wrapLets fs (.u8FromFieldUnsafe c) - | .unconstrainedGToBytes a => let (fs, c) := Term.peelLets (Term.hoistLets a); Term.wrapLets fs (.unconstrainedGToBytes c) - | .unconstrainedGInverse a => let (fs, c) := Term.peelLets (Term.hoistLets a); Term.wrapLets fs (.unconstrainedGInverse c) - | .u8Xor a b => let (fs, cs) := Term.peelListLets [Term.hoistLets a, Term.hoistLets b] - match cs with | [a, b] => Term.wrapLets fs (.u8Xor a b) | _ => t - | .u8Add a b => let (fs, cs) := Term.peelListLets [Term.hoistLets a, Term.hoistLets b] - match cs with | [a, b] => Term.wrapLets fs (.u8Add a b) | _ => t - | .u8Mul a b => let (fs, cs) := Term.peelListLets [Term.hoistLets a, Term.hoistLets b] - match cs with | [a, b] => Term.wrapLets fs (.u8Mul a b) | _ => t - | .u8Sub a b => let (fs, cs) := Term.peelListLets [Term.hoistLets a, Term.hoistLets b] - match cs with | [a, b] => Term.wrapLets fs (.u8Sub a b) | _ => t - | .u8And a b => let (fs, cs) := Term.peelListLets [Term.hoistLets a, Term.hoistLets b] - match cs with | [a, b] => Term.wrapLets fs (.u8And a b) | _ => t - | .u8Or a b => let (fs, cs) := Term.peelListLets [Term.hoistLets a, Term.hoistLets b] - match cs with | [a, b] => Term.wrapLets fs (.u8Or a b) | _ => t - | .u8LessThan a b => let (fs, cs) := Term.peelListLets [Term.hoistLets a, Term.hoistLets b] - match cs with | [a, b] => Term.wrapLets fs (.u8LessThan a b) | _ => t - | .u32LessThan a b => let (fs, cs) := Term.peelListLets [Term.hoistLets a, Term.hoistLets b] - match cs with | [a, b] => Term.wrapLets fs (.u32LessThan a b) | _ => t - | .u8XorSplit7 a b => let (fs, cs) := Term.peelListLets [Term.hoistLets a, Term.hoistLets b] - match cs with | [a, b] => Term.wrapLets fs (.u8XorSplit7 a b) | _ => t - | .u8XorSplit4 a b => let (fs, cs) := Term.peelListLets [Term.hoistLets a, Term.hoistLets b] - match cs with | [a, b] => Term.wrapLets fs (.u8XorSplit4 a b) | _ => t - | .unconstrainedU32Add a b => let (fs, cs) := Term.peelListLets [Term.hoistLets a, Term.hoistLets b] - match cs with | [a, b] => Term.wrapLets fs (.unconstrainedU32Add a b) | _ => t - | .unconstrainedU32Add3 a b c => let (fs, cs) := Term.peelListLets [Term.hoistLets a, Term.hoistLets b, Term.hoistLets c] - match cs with | [a, b, c] => Term.wrapLets fs (.unconstrainedU32Add3 a b c) | _ => t - | .u32ToField a => let (fs, c) := Term.peelLets (Term.hoistLets a); Term.wrapLets fs (.u32ToField c) - | .unconstrainedBigUintDivMod a b => let (fs, cs) := Term.peelListLets [Term.hoistLets a, Term.hoistLets b] - match cs with | [a, b] => Term.wrapLets fs (.unconstrainedBigUintDivMod a b) | _ => t - | .u8RangeCheck a b => let (fs, cs) := Term.peelListLets [Term.hoistLets a, Term.hoistLets b] - match cs with | [a, b] => Term.wrapLets fs (.u8RangeCheck a b) | _ => t -termination_by t => sizeOf t + let a ← Term.hoistLetsAux stem a; let b ← Term.hoistLetsAux stem b + buildWithArguments stem [a, b] fun | [a, b] => .ioGetInfo a b | _ => term + | .ioRead a b len => + let a ← Term.hoistLetsAux stem a; let b ← Term.hoistLetsAux stem b + buildWithArguments stem [a, b] fun | [a, b] => .ioRead a b len | _ => term + | .u8Xor a b => + let a ← Term.hoistLetsAux stem a; let b ← Term.hoistLetsAux stem b + buildWithArguments stem [a, b] fun | [a, b] => .u8Xor a b | _ => term + | .u8Add a b => + let a ← Term.hoistLetsAux stem a; let b ← Term.hoistLetsAux stem b + buildWithArguments stem [a, b] fun | [a, b] => .u8Add a b | _ => term + | .u8Mul a b => + let a ← Term.hoistLetsAux stem a; let b ← Term.hoistLetsAux stem b + buildWithArguments stem [a, b] fun | [a, b] => .u8Mul a b | _ => term + | .u8Sub a b => + let a ← Term.hoistLetsAux stem a; let b ← Term.hoistLetsAux stem b + buildWithArguments stem [a, b] fun | [a, b] => .u8Sub a b | _ => term + | .u8And a b => + let a ← Term.hoistLetsAux stem a; let b ← Term.hoistLetsAux stem b + buildWithArguments stem [a, b] fun | [a, b] => .u8And a b | _ => term + | .u8Or a b => + let a ← Term.hoistLetsAux stem a; let b ← Term.hoistLetsAux stem b + buildWithArguments stem [a, b] fun | [a, b] => .u8Or a b | _ => term + | .u8LessThan a b => + let a ← Term.hoistLetsAux stem a; let b ← Term.hoistLetsAux stem b + buildWithArguments stem [a, b] fun | [a, b] => .u8LessThan a b | _ => term + | .u32LessThan a b => + let a ← Term.hoistLetsAux stem a; let b ← Term.hoistLetsAux stem b + buildWithArguments stem [a, b] fun | [a, b] => .u32LessThan a b | _ => term + | .u8XorSplit7 a b => + let a ← Term.hoistLetsAux stem a; let b ← Term.hoistLetsAux stem b + buildWithArguments stem [a, b] fun | [a, b] => .u8XorSplit7 a b | _ => term + | .u8XorSplit4 a b => + let a ← Term.hoistLetsAux stem a; let b ← Term.hoistLetsAux stem b + buildWithArguments stem [a, b] fun | [a, b] => .u8XorSplit4 a b | _ => term + | .unconstrainedU32Add a b => + let a ← Term.hoistLetsAux stem a; let b ← Term.hoistLetsAux stem b + buildWithArguments stem [a, b] fun | [a, b] => .unconstrainedU32Add a b | _ => term + | .unconstrainedBigUintDivMod a b => + let a ← Term.hoistLetsAux stem a; let b ← Term.hoistLetsAux stem b + buildWithArguments stem [a, b] fun | [a, b] => .unconstrainedBigUintDivMod a b | _ => term + | .u8RangeCheck a b => + let a ← Term.hoistLetsAux stem a; let b ← Term.hoistLetsAux stem b + buildWithArguments stem [a, b] fun | [a, b] => .u8RangeCheck a b | _ => term + | .unconstrainedU32Add3 a b c => + let a ← Term.hoistLetsAux stem a; let b ← Term.hoistLetsAux stem b + let c ← Term.hoistLetsAux stem c + buildWithArguments stem [a, b, c] fun | [a, b, c] => .unconstrainedU32Add3 a b c | _ => term + | .eqZero a => + let a ← Term.hoistLetsAux stem a + buildWithArguments stem [a] fun | [a] => .eqZero a | _ => term + | .proj a index => + let a ← Term.hoistLetsAux stem a + buildWithArguments stem [a] fun | [a] => .proj a index | _ => term + | .get a index => + let a ← Term.hoistLetsAux stem a + buildWithArguments stem [a] fun | [a] => .get a index | _ => term + | .slice a start stop => + let a ← Term.hoistLetsAux stem a + buildWithArguments stem [a] fun | [a] => .slice a start stop | _ => term + | .store a => + let a ← Term.hoistLetsAux stem a + buildWithArguments stem [a] fun | [a] => .store a | _ => term + | .load a => + let a ← Term.hoistLetsAux stem a + buildWithArguments stem [a] fun | [a] => .load a | _ => term + | .ptrVal a => + let a ← Term.hoistLetsAux stem a + buildWithArguments stem [a] fun | [a] => .ptrVal a | _ => term + | .ann typ a => + let a ← Term.hoistLetsAux stem a + buildWithArguments stem [a] fun | [a] => .ann typ a | _ => term + | .u8BitDecomposition a => + let a ← Term.hoistLetsAux stem a + buildWithArguments stem [a] fun | [a] => .u8BitDecomposition a | _ => term + | .u8ShiftLeft a => + let a ← Term.hoistLetsAux stem a + buildWithArguments stem [a] fun | [a] => .u8ShiftLeft a | _ => term + | .u8ShiftRight a => + let a ← Term.hoistLetsAux stem a + buildWithArguments stem [a] fun | [a] => .u8ShiftRight a | _ => term + | .u32ToField a => + let a ← Term.hoistLetsAux stem a + buildWithArguments stem [a] fun | [a] => .u32ToField a | _ => term + | .unconstrainedGToBytes a => + let a ← Term.hoistLetsAux stem a + buildWithArguments stem [a] fun | [a] => .unconstrainedGToBytes a | _ => term + | .unconstrainedGInverse a => + let a ← Term.hoistLetsAux stem a + buildWithArguments stem [a] fun | [a] => .unconstrainedGInverse a | _ => term + | .toField a => + let a ← Term.hoistLetsAux stem a + buildWithArguments stem [a] fun | [a] => .toField a | _ => term + | .u8FromFieldUnsafe a => + let a ← Term.hoistLetsAux stem a + buildWithArguments stem [a] fun | [a] => .u8FromFieldUnsafe a | _ => term +termination_by sizeOf term decreasing_by all_goals first | decreasing_tactic - | (have := Array.sizeOf_lt_of_mem ‹_ ∈ _›; grind) - | (have := List.sizeOf_lt_of_mem ‹_ ∈ _›; grind) + | (have := Array.sizeOf_lt_of_mem t.property; grind) + | (have := List.sizeOf_lt_of_mem t.property; grind) + | (have := List.sizeOf_lt_of_mem arm.property + have : sizeOf arm.val.2 < sizeOf arm.val := by cases arm.val; simp; omega + simp_all; omega) + +/-- Normalize argument evaluation into let bindings with distinct local +names. The name stem is longer than every original local or global name. -/ +def Term.hoistLets (term : Term) : Term := + let stem := String.ofList (List.replicate (term.maxNameLength + 1) '#') + let (next, renamed) := Term.freshenWith stem 0 ∅ term + (Term.hoistLetsAux stem renamed).run' next /-- Kahn-style topological sort of the inline-dependency graph: each pass emits every function whose inline-callees are already emitted, so callees @@ -1045,14 +1254,22 @@ context; left in tail position it turns a legal tail match into a lowering rejects ("non-tail match in arbitrary position"). The rewrite is the eta step `let x = v; x → v`, applied only through tail positions (let bodies and match arms), so non-tail wraps are untouched. -/ -partial def Term.restoreTailMatches : Term → Term - | .let p v b => - match p, b with - | .var x, .var y => - if x == y then Term.restoreTailMatches v else .let p v b - | _, _ => .let p v (Term.restoreTailMatches b) - | .match s arms => .match s (arms.map fun (p, a) => (p, Term.restoreTailMatches a)) +def Term.restoreTailMatches : Term → Term + | .let (.var x) v (.var y) => + if x == y then Term.restoreTailMatches v else .let (.var x) v (.var y) + | .let p v b => .let p v (Term.restoreTailMatches b) + | .match s arms => + .match s (arms.attach.map fun arm => (arm.val.1, Term.restoreTailMatches arm.val.2)) | t => t +termination_by term => sizeOf term +decreasing_by + all_goals first + | decreasing_tactic + | (have listBound := List.sizeOf_lt_of_mem arm.property + have pairBound : sizeOf arm.val.2 < sizeOf arm.val := by + cases arm.val; simp; omega + simp_all + omega) /-- Inline-expand every function body in the toplevel, eliminating all `.inlined` applications. Run before typechecking. diff --git a/Ix/AuxGen/ExprUtils.lean b/Ix/AuxGen/ExprUtils.lean index 9f2a14ffa..fc6618a79 100644 --- a/Ix/AuxGen/ExprUtils.lean +++ b/Ix/AuxGen/ExprUtils.lean @@ -13,7 +13,7 @@ The kernel-backed half of expr_utils.rs (TcScope, kenv ingress, `decompose_inductive_type`, `kexpr_to_lean`, `to_kexpr_static`, the WHNF source-name restore machinery) is intentionally NOT here — it is a - separate milestone that bridges to `Ix.Tc`. + separate milestone that bridges to `Ix.Kernel`. PARITY RULE: every constructed node goes through the hash-maintaining smart constructors in `Ix.Environment` (`Expr.mkApp`, `Level.mkMax`, ...) diff --git a/Ix/AuxGen/Kernel.lean b/Ix/AuxGen/Kernel.lean index 5de7681e6..10604ae7b 100644 --- a/Ix/AuxGen/Kernel.lean +++ b/Ix/AuxGen/Kernel.lean @@ -6,7 +6,7 @@ compile-side entry points of `crates/kernel/src/ingress.rs` (:2097-2270). aux_gen needs exactly four kernel operations — `whnf`, `infer` + `ensureSort`, `isDefEq`, `isLargeEliminator` — over Meta-mode `KExpr`; - the pure-Lean kernel `Ix.Tc` exposes all four (Knot.lean), so this file + the pure-Lean kernel `Ix.Kernel` exposes all four (Knot.lean), so this file only supplies the VALUE bridge: - `Ix.Expr → KExpr .meta` (`toKexprStatic` for open terms in an FVar @@ -16,13 +16,13 @@ `ensureInKenvOf` family) under PROVISIONAL addresses (`resolveLeanNameAddr`: compiled address if known, else the name hash — mirrors KernelCtx's "addresses may shift" model); - - `TcScope`: a scoped view running `Ix.Tc.TcM` actions against the + - `TcScope`: a scoped view running `Ix.Kernel.TcM` actions against the bridge state, with the fault-in retry loop and WHNF source-name restoration. State model: Rust's `KernelCtx { kenv }` + `KEnv.ingress_cache` become `AuxKernelCtx { tcState, ingressCache }` — the cache lives HERE, not in - `Ix.Tc.KEnv` (`Ix/Tc` is consumed, never modified). Rust's fresh + `Ix.Kernel.KEnv` (`Ix/Kernel` is consumed, never modified). Rust's fresh `TypeChecker::new(&mut kenv)` per scope = fresh `TcState.new` carrying over the persistent `KEnv` (whose whnf/infer caches live inside it, matching the Rust split of TC-transient vs kenv-persistent state). @@ -32,7 +32,7 @@ public import Ix.Common public import Ix.Address public import Ix.Environment public import Ix.CompileM -public import Ix.Tc +public import Ix.Kernel public import Ix.AuxGen.Types public import Ix.AuxGen.ExprUtils public import Ix.AuxGen.Levels @@ -43,16 +43,16 @@ namespace Ix.AuxGen open Ix.CompileM (CompileM CompileError) -abbrev MKExpr := Ix.Tc.KExpr .meta -abbrev MKUniv := Ix.Tc.KUniv .meta -abbrev MKId := Ix.Tc.KId .meta -abbrev MKConst := Ix.Tc.KConst .meta +abbrev MKExpr := Ix.Kernel.KExpr .meta +abbrev MKUniv := Ix.Kernel.KUniv .meta +abbrev MKId := Ix.Kernel.KId .meta +abbrev MKConst := Ix.Kernel.KConst .meta -/-- Inverse of `Ix.Tc.EgressLean.safetyToLean`. -/ +/-- Inverse of `Ix.Kernel.EgressLean.safetyToLean`. -/ def safetyOfLean : Lean.DefinitionSafety → Ix.DefinitionSafety | .unsafe => .unsaf | .safe => .safe | .partial => .part -/-- Inverse of `Ix.Tc.EgressLean.quotKindToLean`. -/ +/-- Inverse of `Ix.Kernel.EgressLean.quotKindToLean`. -/ def quotKindOfLean : Lean.QuotKind → Ix.QuotKind | .type => .type | .ctor => .ctor | .lift => .lift | .ind => .ind @@ -98,17 +98,17 @@ def AddrMaps.ofCompileEnv (cenv : Ix.CompileM.CompileEnv) SMART `mkMax`/`mkIMax` (Rust `KUniv::max/imax` normalize). -/ partial def leanLevelToKuniv (lvl : Level) (paramNames : Array Name) : MKUniv := match lvl with - | .zero _ => Ix.Tc.KUniv.mkZero - | .succ l _ => Ix.Tc.KUniv.mkSucc (leanLevelToKuniv l paramNames) + | .zero _ => Ix.Kernel.KUniv.mkZero + | .succ l _ => Ix.Kernel.KUniv.mkSucc (leanLevelToKuniv l paramNames) | .max a b _ => - Ix.Tc.KUniv.mkMax (leanLevelToKuniv a paramNames) + Ix.Kernel.KUniv.mkMax (leanLevelToKuniv a paramNames) (leanLevelToKuniv b paramNames) | .imax a b _ => - Ix.Tc.KUniv.mkIMax (leanLevelToKuniv a paramNames) + Ix.Kernel.KUniv.mkIMax (leanLevelToKuniv a paramNames) (leanLevelToKuniv b paramNames) | .param name _ => match paramNames.findIdx? (· == name) with - | some idx => Ix.Tc.KUniv.mkParam idx.toUInt64 name + | some idx => Ix.Kernel.KUniv.mkParam idx.toUInt64 name | none => panic! s!"unknown level param `{name.pretty}` not found in param_names \ {paramNames.toList.map (·.pretty)}" @@ -135,7 +135,7 @@ partial def kunivToLevel (u : MKUniv) (paramNames : Array Name) : Level := /-- Rust `KernelCtx` + `KEnv.ingress_cache`. The cache key is `(expr contentHash, paramNamesHash)` — Rust ingress.rs:2216. -/ structure AuxKernelCtx where - tcState : Ix.Tc.TcState .meta + tcState : Ix.Kernel.TcState .meta ingressCache : Std.HashMap (Address × Address) MKExpr := {} /-- Mirrors Rust `KernelCtx.aux_ingress_seen`: ids whose `ingressAuxGenDep` dispatch already ran against this kenv. The @@ -152,16 +152,16 @@ structure AuxKernelCtx where simply never match the provisional-address constants — same shape as the Rust bridge, whose static prim addresses don't match either). -/ def AuxKernelCtx.new : AuxKernelCtx := - { tcState := Ix.Tc.TcState.new {} - (Ix.Tc.Primitives.ofResolve .canonical fun _ => none) } + { tcState := Ix.Kernel.TcState.new {} + (Ix.Kernel.Primitives.ofResolve .canonical fun _ => none) } /-- Bridge monad: aux kernel state over CompileM. -/ abbrev KBridgeM := StateT AuxKernelCtx CompileM -/-- Run an `Ix.Tc.TcM` action against the bridge's kernel state, +/-- Run an `Ix.Kernel.TcM` action against the bridge's kernel state, threading the state back in BOTH outcomes (Rust's `&mut` semantics — caches warmed by a failing call stay warm). -/ -def runTc (act : Ix.Tc.TcM .meta α) : KBridgeM (Except (Ix.Tc.TcError .meta) α) := do +def runTc (act : Ix.Kernel.TcM .meta α) : KBridgeM (Except (Ix.Kernel.TcError .meta) α) := do let kctx ← get match act kctx.tcState with | .ok a st' => @@ -214,7 +214,7 @@ partial def leanExprToKexprCached (e : Expr) (paramNames : Array Name) return hit -- Accumulate consecutive mdata wrappers. - let mut mdataLayers : Array Ix.Tc.MData := #[] + let mut mdataLayers : Array Ix.Kernel.MData := #[] let mut cur := e let mut go := true while go do @@ -230,50 +230,50 @@ partial def leanExprToKexprCached (e : Expr) (paramNames : Array Name) if idx < binderNames.size then return binderNames[binderNames.size - 1 - idx]! return Name.mkAnon - pure (Ix.Tc.KExpr.mkVar (UInt64.ofNat idx) name mdataLayers) + pure (Ix.Kernel.KExpr.mkVar (UInt64.ofNat idx) name mdataLayers) | .sort lvl _ => - pure (Ix.Tc.KExpr.mkSort (leanLevelToKuniv lvl paramNames) mdataLayers) + pure (Ix.Kernel.KExpr.mkSort (leanLevelToKuniv lvl paramNames) mdataLayers) | .const name us _ => let zid : MKId := ⟨maps.resolve name, name⟩ let zus := us.map (leanLevelToKuniv · paramNames) - pure (Ix.Tc.KExpr.mkConst zid zus mdataLayers) + pure (Ix.Kernel.KExpr.mkConst zid zus mdataLayers) | .app f a _ => let fk ← leanExprToKexprCached f paramNames binderNames pnHash maps let ak ← leanExprToKexprCached a paramNames binderNames pnHash maps - pure (Ix.Tc.KExpr.mkApp fk ak mdataLayers) + pure (Ix.Kernel.KExpr.mkApp fk ak mdataLayers) | .forallE binderName dom body bi _ => let dk ← leanExprToKexprCached dom paramNames binderNames pnHash maps let bk ← leanExprToKexprCached body paramNames (binderNames.push binderName) pnHash maps - pure (Ix.Tc.KExpr.mkAll binderName bi dk bk mdataLayers) + pure (Ix.Kernel.KExpr.mkAll binderName bi dk bk mdataLayers) | .lam binderName dom body bi _ => let dk ← leanExprToKexprCached dom paramNames binderNames pnHash maps let bk ← leanExprToKexprCached body paramNames (binderNames.push binderName) pnHash maps - pure (Ix.Tc.KExpr.mkLam binderName bi dk bk mdataLayers) + pure (Ix.Kernel.KExpr.mkLam binderName bi dk bk mdataLayers) | .letE binderName ty val body nd _ => let tk ← leanExprToKexprCached ty paramNames binderNames pnHash maps let vk ← leanExprToKexprCached val paramNames binderNames pnHash maps let bk ← leanExprToKexprCached body paramNames (binderNames.push binderName) pnHash maps - pure (Ix.Tc.KExpr.mkLet binderName tk vk bk nd mdataLayers) + pure (Ix.Kernel.KExpr.mkLet binderName tk vk bk nd mdataLayers) | .proj pname idx s _ => let zid : MKId := ⟨maps.resolve pname, pname⟩ let sk ← leanExprToKexprCached s paramNames binderNames pnHash maps - pure (Ix.Tc.KExpr.mkPrj zid (UInt64.ofNat idx) sk mdataLayers) + pure (Ix.Kernel.KExpr.mkPrj zid (UInt64.ofNat idx) sk mdataLayers) | .lit (.natVal n) _ => -- Compile-side blob convention: 8-byte u64 LE (Rust to_kexpr_static -- / ingress use `nat_to_u64(n).to_le_bytes()`), NOT the kernel's -- trimmed `natBlob`. - pure (Ix.Tc.KExpr.mkNat n (Address.blake3 (UInt64.ofNat n).toLEBytes) mdataLayers) + pure (Ix.Kernel.KExpr.mkNat n (Address.blake3 (UInt64.ofNat n).toLEBytes) mdataLayers) | .lit (.strVal s) _ => - pure (Ix.Tc.KExpr.mkStr s (Address.blake3 s.toUTF8) mdataLayers) + pure (Ix.Kernel.KExpr.mkStr s (Address.blake3 s.toUTF8) mdataLayers) | .fvar _ _ => -- Closed-term converter: fvars have no meaning here (Rust `_raw` -- has no Fvar arm reachable from ensure-in-kenv callers). - pure (Ix.Tc.KExpr.mkSort Ix.Tc.KUniv.mkZero) + pure (Ix.Kernel.KExpr.mkSort Ix.Kernel.KUniv.mkZero) | .mvar _ _ => - pure (Ix.Tc.KExpr.mkSort Ix.Tc.KUniv.mkZero) + pure (Ix.Kernel.KExpr.mkSort Ix.Kernel.KUniv.mkZero) | .mdata .. => unreachable! let result ← internK raw @@ -303,11 +303,11 @@ def ensurePreludeInKenvOf (maps : AddrMaps) : KBridgeM Unit := do let uName := Name.mkStr .mkAnon "u" -- PUnit.{u} : Sort u ; PUnit.unit : PUnit.{u} - let u0 : MKUniv := Ix.Tc.KUniv.mkParam 0 uName - let punitTy := Ix.Tc.KExpr.mkSort u0 + let u0 : MKUniv := Ix.Kernel.KUniv.mkParam 0 uName + let punitTy := Ix.Kernel.KExpr.mkSort u0 let unitName := Name.mkStr punitName "unit" let unitId : MKId := ⟨maps.resolve unitName, unitName⟩ - let unitTy := Ix.Tc.KExpr.mkConst punitId #[Ix.Tc.KUniv.mkParam 0 uName] + let unitTy := Ix.Kernel.KExpr.mkConst punitId #[Ix.Kernel.KUniv.mkParam 0 uName] kenvInsert unitId (.ctor unitName #[uName] false 1 punitId 0 0 0 unitTy) kenvInsert punitId (.indc punitName #[uName] 1 0 0 false punitId 0 punitTy #[unitId] #[]) @@ -320,28 +320,28 @@ def ensurePreludeInKenvOf (maps : AddrMaps) : KBridgeM Unit := do let betaName := Name.mkStr .mkAnon "β" let fstName := Name.mkStr .mkAnon "fst" let sndName := Name.mkStr .mkAnon "snd" - let u0' : MKUniv := Ix.Tc.KUniv.mkParam 0 uName - let u1 : MKUniv := Ix.Tc.KUniv.mkParam 1 vName - let sortU := Ix.Tc.KExpr.mkSort u0' - let sortV := Ix.Tc.KExpr.mkSort u1 + let u0' : MKUniv := Ix.Kernel.KUniv.mkParam 0 uName + let u1 : MKUniv := Ix.Kernel.KUniv.mkParam 1 vName + let sortU := Ix.Kernel.KExpr.mkSort u0' + let sortV := Ix.Kernel.KExpr.mkSort u1 -- Lean stores `max 1 u v` LEFT-associated: max(max(1,u),v). Essential: -- after substitution the normalizing max collapses differently for the -- right-associated form (expr_utils.rs:1813-1821). - let max1uv := Ix.Tc.KUniv.mkMax - (Ix.Tc.KUniv.mkMax (Ix.Tc.KUniv.mkSucc Ix.Tc.KUniv.mkZero) u0') u1 - let pprodTy := Ix.Tc.KExpr.mkAll alphaName Lean.BinderInfo.default sortU - (Ix.Tc.KExpr.mkAll betaName Lean.BinderInfo.default sortV (Ix.Tc.KExpr.mkSort max1uv)) + let max1uv := Ix.Kernel.KUniv.mkMax + (Ix.Kernel.KUniv.mkMax (Ix.Kernel.KUniv.mkSucc Ix.Kernel.KUniv.mkZero) u0') u1 + let pprodTy := Ix.Kernel.KExpr.mkAll alphaName Lean.BinderInfo.default sortU + (Ix.Kernel.KExpr.mkAll betaName Lean.BinderInfo.default sortV (Ix.Kernel.KExpr.mkSort max1uv)) -- PProd.mk : {α : Sort u} → {β : Sort v} → α → β → PProd.{u,v} α β let mkName := Name.mkStr pprodName "mk" let mkId : MKId := ⟨maps.resolve mkName, mkName⟩ - let pprodApp := Ix.Tc.KExpr.mkApp - (Ix.Tc.KExpr.mkApp (Ix.Tc.KExpr.mkConst pprodId #[u0', u1]) - (Ix.Tc.KExpr.mkVar 3 Name.mkAnon)) - (Ix.Tc.KExpr.mkVar 2 Name.mkAnon) - let mkTy := Ix.Tc.KExpr.mkAll alphaName Lean.BinderInfo.implicit sortU - (Ix.Tc.KExpr.mkAll betaName Lean.BinderInfo.implicit sortV - (Ix.Tc.KExpr.mkAll fstName Lean.BinderInfo.default (Ix.Tc.KExpr.mkVar 1 Name.mkAnon) - (Ix.Tc.KExpr.mkAll sndName Lean.BinderInfo.default (Ix.Tc.KExpr.mkVar 1 Name.mkAnon) + let pprodApp := Ix.Kernel.KExpr.mkApp + (Ix.Kernel.KExpr.mkApp (Ix.Kernel.KExpr.mkConst pprodId #[u0', u1]) + (Ix.Kernel.KExpr.mkVar 3 Name.mkAnon)) + (Ix.Kernel.KExpr.mkVar 2 Name.mkAnon) + let mkTy := Ix.Kernel.KExpr.mkAll alphaName Lean.BinderInfo.implicit sortU + (Ix.Kernel.KExpr.mkAll betaName Lean.BinderInfo.implicit sortV + (Ix.Kernel.KExpr.mkAll fstName Lean.BinderInfo.default (Ix.Kernel.KExpr.mkVar 1 Name.mkAnon) + (Ix.Kernel.KExpr.mkAll sndName Lean.BinderInfo.default (Ix.Kernel.KExpr.mkVar 1 Name.mkAnon) pprodApp))) kenvInsert mkId (.ctor mkName #[uName, vName] false 2 pprodId 0 2 2 mkTy) kenvInsert pprodId @@ -451,41 +451,41 @@ partial def toKexprStatic (e : Expr) (fvarLevels : Std.HashMap Name Nat) match e with | .fvar fname _ => match fvarLevels.get? fname with - | some level => Ix.Tc.KExpr.mkVar (UInt64.ofNat (ctxDepth - level - 1)) .mkAnon - | none => Ix.Tc.KExpr.mkSort Ix.Tc.KUniv.mkZero - | .bvar idx _ => Ix.Tc.KExpr.mkVar (UInt64.ofNat idx) .mkAnon - | .sort lvl _ => Ix.Tc.KExpr.mkSort (leanLevelToKuniv lvl paramNames) + | some level => Ix.Kernel.KExpr.mkVar (UInt64.ofNat (ctxDepth - level - 1)) .mkAnon + | none => Ix.Kernel.KExpr.mkSort Ix.Kernel.KUniv.mkZero + | .bvar idx _ => Ix.Kernel.KExpr.mkVar (UInt64.ofNat idx) .mkAnon + | .sort lvl _ => Ix.Kernel.KExpr.mkSort (leanLevelToKuniv lvl paramNames) | .const cname us _ => let zid : MKId := ⟨maps.resolve cname, cname⟩ - Ix.Tc.KExpr.mkConst zid (us.map (leanLevelToKuniv · paramNames)) + Ix.Kernel.KExpr.mkConst zid (us.map (leanLevelToKuniv · paramNames)) | .app f a _ => - Ix.Tc.KExpr.mkApp (toKexprStatic f fvarLevels ctxDepth paramNames maps) + Ix.Kernel.KExpr.mkApp (toKexprStatic f fvarLevels ctxDepth paramNames maps) (toKexprStatic a fvarLevels ctxDepth paramNames maps) | .forallE binderName dom body bi _ => - Ix.Tc.KExpr.mkAll binderName bi + Ix.Kernel.KExpr.mkAll binderName bi (toKexprStatic dom fvarLevels ctxDepth paramNames maps) (toKexprStatic body fvarLevels (ctxDepth + 1) paramNames maps) | .lam binderName dom body bi _ => - Ix.Tc.KExpr.mkLam binderName bi + Ix.Kernel.KExpr.mkLam binderName bi (toKexprStatic dom fvarLevels ctxDepth paramNames maps) (toKexprStatic body fvarLevels (ctxDepth + 1) paramNames maps) | .letE binderName ty val body nd _ => - Ix.Tc.KExpr.mkLet binderName + Ix.Kernel.KExpr.mkLet binderName (toKexprStatic ty fvarLevels ctxDepth paramNames maps) (toKexprStatic val fvarLevels ctxDepth paramNames maps) (toKexprStatic body fvarLevels (ctxDepth + 1) paramNames maps) nd | .proj pname idx s _ => let zid : MKId := ⟨maps.resolve pname, pname⟩ - Ix.Tc.KExpr.mkPrj zid (UInt64.ofNat idx) + Ix.Kernel.KExpr.mkPrj zid (UInt64.ofNat idx) (toKexprStatic s fvarLevels ctxDepth paramNames maps) | .lit (.natVal n) _ => -- 8-byte u64 LE blob convention (see leanExprToKexprCached). - Ix.Tc.KExpr.mkNat n (Address.blake3 (UInt64.ofNat n).toLEBytes) + Ix.Kernel.KExpr.mkNat n (Address.blake3 (UInt64.ofNat n).toLEBytes) | .lit (.strVal s) _ => - Ix.Tc.KExpr.mkStr s (Address.blake3 s.toUTF8) + Ix.Kernel.KExpr.mkStr s (Address.blake3 s.toUTF8) | .mdata _ inner _ => toKexprStatic inner fvarLevels ctxDepth paramNames maps - | .mvar _ _ => Ix.Tc.KExpr.mkSort Ix.Tc.KUniv.mkZero + | .mvar _ _ => Ix.Kernel.KExpr.mkSort Ix.Kernel.KUniv.mkZero /-- `KExpr .meta → Ix.Expr` reconstructing FVars from de-Bruijn `Var`s: indices below `localDepth` stay BVars; above, level = @@ -683,7 +683,7 @@ def new (outerFvarCtx : Array LocalDecl) (paramNames : Array Name) (maps : AddrMaps) : KBridgeM TcScopeSt := do -- Fresh TC portions, persistent env (caches live in KEnv). modify fun kctx => { kctx with tcState := - { Ix.Tc.TcState.new kctx.tcState.env kctx.tcState.prims with + { Ix.Kernel.TcState.new kctx.tcState.env kctx.tcState.prims with inferOnly := true } } let mut fvarLevels : Std.HashMap Name Nat := {} for (decl, i) in outerFvarCtx.zipIdx do @@ -692,7 +692,7 @@ def new (outerFvarCtx : Array LocalDecl) (paramNames : Array Name) { fvarLevels, baseDepth := outerFvarCtx.size, paramNames, maps } for (decl, i) in outerFvarCtx.zipIdx do let kty := toKexprStatic decl.domain fvarLevels i paramNames maps - discard <| runTc (Ix.Tc.TcM.pushLocal kty) + discard <| runTc (Ix.Kernel.TcM.pushLocal kty) return scope /-- Push additional locals (e.g. minor-premise binders); balance with @@ -706,7 +706,7 @@ def pushLocals (scope : TcScopeSt) (decls : Array LocalDecl) fvarLevels := scope.fvarLevels.insert decl.fvarName (depth0 + i) } let kty := toKexprStatic decl.domain scope.fvarLevels (depth0 + i) scope.paramNames scope.maps - discard <| runTc (Ix.Tc.TcM.pushLocal kty) + discard <| runTc (Ix.Kernel.TcM.pushLocal kty) return { scope with extraLocals := scope.extraLocals + decls.size } /-- Mirrors Rust `pop_locals` (expr_utils.rs:2274). -/ @@ -714,7 +714,7 @@ def popLocals (scope : TcScopeSt) (decls : Array LocalDecl) : KBridgeM TcScopeSt := do let mut scope := scope for decl in decls.reverse do - discard <| runTc Ix.Tc.TcM.popLocal + discard <| runTc Ix.Kernel.TcM.popLocal scope := { scope with fvarLevels := scope.fvarLevels.erase decl.fvarName } return { scope with extraLocals := scope.extraLocals - decls.size } @@ -829,7 +829,7 @@ partial def getLevel (scope : TcScopeSt) (ty : Expr) : KBridgeM Level := do let mut faultedAddrs : Std.HashSet Address := {} let mut inferred? : Option MKExpr := none while inferred?.isNone do - match ← runTc (Ix.Tc.TcM.infer kexpr) with + match ← runTc (Ix.Kernel.TcM.infer kexpr) with | .ok e => inferred? := some e | .error (.unknownConst addr) => if !faultedAddrs.contains addr then @@ -847,7 +847,7 @@ partial def getLevel (scope : TcScopeSt) (ty : Expr) : KBridgeM Level := do s!"TcScope::get_level: tc.infer failed: {e}") let inferred := inferred?.get! - let ku ← match ← runTc (Ix.Tc.TcM.ensureSort inferred) with + let ku ← match ← runTc (Ix.Kernel.TcM.ensureSort inferred) with | .ok u => pure u | .error e => throw (.unsupportedExpr s!"TcScope::get_level: ensure_sort failed: {e}") @@ -865,7 +865,7 @@ def whnfLean (scope : TcScopeSt) (ty : Expr) : KBridgeM Expr := do let depth := scope.depth let kexpr := toKexprStatic ty scope.fvarLevels depth scope.paramNames scope.maps - let whnfed ← match ← runTc (Ix.Tc.TcM.whnf kexpr) with + let whnfed ← match ← runTc (Ix.Kernel.TcM.whnf kexpr) with | .ok k => pure k | .error _ => return ty let out := kexprToLean whnfed depth scope.fvarLevels 0 scope.paramNames @@ -883,7 +883,7 @@ def isDefEq (scope : TcScopeSt) (a b : Expr) : KBridgeM Bool := do let depth := scope.depth let ka := toKexprStatic a scope.fvarLevels depth scope.paramNames scope.maps let kb := toKexprStatic b scope.fvarLevels depth scope.paramNames scope.maps - match ← runTc (Ix.Tc.TcM.isDefEq ka kb) with + match ← runTc (Ix.Kernel.TcM.isDefEq ka kb) with | .ok r => return r | .error _ => return false @@ -896,7 +896,7 @@ def isDefEq (scope : TcScopeSt) (a b : Expr) : KBridgeM Bool := do def inferLean (scope : TcScopeSt) (e : Expr) : KBridgeM (Option Expr) := do let depth := scope.depth let ke := toKexprStatic e scope.fvarLevels depth scope.paramNames scope.maps - match ← runTc (Ix.Tc.TcM.infer ke) with + match ← runTc (Ix.Kernel.TcM.infer ke) with | .ok ty => return some (kexprToLean ty depth scope.fvarLevels 0 scope.paramNames) | .error _ => return none diff --git a/Ix/AuxGen/Nested.lean b/Ix/AuxGen/Nested.lean index eeb21a566..b4542ecfb 100644 --- a/Ix/AuxGen/Nested.lean +++ b/Ix/AuxGen/Nested.lean @@ -18,7 +18,7 @@ `AuxLayout {perm, sourceCtorCounts}` metadata. The kernel re-derives this order via blake3 `AUX_INDC_VIEW` / - `AUX_MARKER_VIEW` seed addresses (`Ix/Tc/Inductive.lean:canonicalAuxOrder`, + `AUX_MARKER_VIEW` seed addresses (`Ix/Kernel/Inductive.lean:canonicalAuxOrder`, `crates/kernel/src/inductive.rs:canonical_aux_order`) — those seed strings are the CONSUMER's reconstruction and must not appear here: the compile side orders purely by marker ctor + `sortConsts`. diff --git a/Ix/AuxGen/Recursor.lean b/Ix/AuxGen/Recursor.lean index 72e62ed9f..edff092e3 100644 --- a/Ix/AuxGen/Recursor.lean +++ b/Ix/AuxGen/Recursor.lean @@ -1606,12 +1606,12 @@ def computeIsLargeAndK (classes : Array FlatInfo) (nClasses nParams : Nat) -- Fresh TypeChecker over the persistent kenv (Rust -- `TypeChecker::new(&mut kctx.kenv)`). modify fun kctx => { kctx with - tcState := Ix.Tc.TcState.new kctx.tcState.env kctx.tcState.prims } + tcState := Ix.Kernel.TcState.new kctx.tcState.env kctx.tcState.prims } -- WHNF-reduced result sort level via the kernel. let resultKuniv ← - match ← runTc (Ix.Tc.TcM.runRec - (Ix.Tc.RecM.getResultSortLevel firstTyZ + match ← runTc (Ix.Kernel.TcM.runRec + (Ix.Kernel.RecM.getResultSortLevel firstTyZ (nParams + firstNIndices.toNat))) with | .ok u => pure u | .error e => @@ -1620,8 +1620,8 @@ def computeIsLargeAndK (classes : Array FlatInfo) (nClasses nParams : Nat) {classes[0]!.ind.cnst.name.pretty}: {e}") let isLarge ← - match ← runTc (Ix.Tc.TcM.runRec - (Ix.Tc.RecM.isLargeEliminator resultKuniv indInfos)) with + match ← runTc (Ix.Kernel.TcM.runRec + (Ix.Kernel.RecM.isLargeEliminator resultKuniv indInfos)) with | .ok b => pure b | .error e => throw (.invalidMutualBlock diff --git a/Ix/BenchConstants.lean b/Ix/BenchConstants.lean index cee6bc26a..434f499ad 100644 --- a/Ix/BenchConstants.lean +++ b/Ix/BenchConstants.lean @@ -1,7 +1,7 @@ /- The shared benchmark constant set: the single source of truth for which - constants every per-constant benchmark backend (aiur, zisk, sp1, ooc, - lean4lean) runs. Every backend runs this same set — spanning the cheap → + constants every per-constant benchmark backend (aiur, zisk, sp1, ooc) + runs. Every backend runs this same set — spanning the cheap → heavy cost range across the registry envs — so their numbers stay comparable per constant; the only per-backend carve-outs are the hard feasibility exclusions in `Ix.Cli.BenchCmd.benchExclusions`. diff --git a/Ix/Certified.lean b/Ix/Certified.lean new file mode 100644 index 000000000..05cb4f0ef --- /dev/null +++ b/Ix/Certified.lean @@ -0,0 +1,13 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.Command +import Ix.Certified.ClaimCommand + +/-! Source and claim adapters for the explicit certified profile. +Their validation receipts connect authenticated Ixon inputs to the set model. +The production checker's general inference path and Aiur public acceptance +have separate refinement obligations. +-/ diff --git a/Ix/Certified/Audit.lean b/Ix/Certified/Audit.lean new file mode 100644 index 000000000..c5e47e3c9 --- /dev/null +++ b/Ix/Certified/Audit.lean @@ -0,0 +1,28 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.AuditSupport +import Ix.Certified.Bytes + +/-! +The serialized host adapter has its own audit. This is not the pure model's +import boundary or an Aiur compiler/AIR soundness theorem. Foreign hashing and +its output contract remain explicit runtime dependencies. +-/ + +open Lean Lean.Elab Command + +namespace Ix.Certified.Audit + +def roots : Array Lean.Name := #[ + `Ix.Certified.decodeObject?, `Ix.Certified.decodeNatural?, + `Ix.Certified.readSignature?, `Ix.Certified.prepare?, + `Ix.Certified.acceptsSerialized_prepared, + `Ix.Certified.accepted_serialized_has_model, + `Ix.Certified.no_serialized_proof_of_False] + +run_cmd AuditSupport.report "serialized" roots #[] + +end Ix.Certified.Audit diff --git a/Ix/Certified/AuditAll.lean b/Ix/Certified/AuditAll.lean new file mode 100644 index 000000000..a6f8b020c --- /dev/null +++ b/Ix/Certified/AuditAll.lean @@ -0,0 +1,25 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.Audit +import Ix.Certified.TcAudit +import Ix.Certified.SourceAudit +import Ix.Certified.ClaimAudit +import Ix.Certified.ModeledAudit + +/-! The union of the five historical adapter boundaries, without duplicate +root, premise or worker reports. Each component remains independently audited. -/ + +namespace Ix.Certified.AuditAll + +def roots : Array Lean.Name := AuditSupport.distinct + (Audit.roots ++ TcAudit.roots ++ SourceAudit.roots ++ ClaimAudit.roots ++ ModeledAudit.roots) + +def premises : Array Lean.Name := AuditSupport.distinct + (TcAudit.premises ++ SourceAudit.premises ++ ClaimAudit.premises ++ ModeledAudit.premises) + +run_cmd AuditSupport.report "Certified host adapters" roots premises + +end Ix.Certified.AuditAll diff --git a/Ix/Certified/AuditSupport.lean b/Ix/Certified/AuditSupport.lean new file mode 100644 index 000000000..f27c6ff67 --- /dev/null +++ b/Ix/Certified/AuditSupport.lean @@ -0,0 +1,162 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Lean + +/-! Checked declaration traversal for the certified host adapters. Runtime +workers and foreign interfaces are inventoried separately from proof axioms. -/ + +open Lean Lean.Elab Command + +namespace Ix.Certified.AuditSupport + +private def constants (info : ConstantInfo) : Array Name := + info.type.getUsedConstants ++ match info with + | .thmInfo value => value.value.getUsedConstants + | .defnInfo value => value.value.getUsedConstants + | .opaqueInfo value => value.value.getUsedConstants + | .inductInfo value => value.ctors.toArray + | _ => #[] + +private partial def closure (env : Environment) (runtime : Bool) (pending : List Name) + (seen : NameSet := {}) : NameSet := + match pending with + | [] => seen + | name :: rest => + if seen.contains name then closure env runtime rest seen + else match env.checked.get.find? name with + | none => closure env runtime rest (seen.insert name) + | some info => + let extras := if runtime then Id.run do + let mut names := #[] + let worker := Lean.Compiler.mkUnsafeRecName name + if (env.checked.get.find? worker).isSome then names := names.push worker + if let some other := Lean.Compiler.getImplementedBy? env name then + names := names.push other + if let some other := (Lean.Compiler.CSimp.ext.getState env).map.find? name then + names := names.push other.toDeclName + return names + else #[] + closure env runtime ((constants info ++ extras).toList ++ rest) (seen.insert name) + +private def projectConstant (env : Environment) (name : Name) : Bool := + match env.getModuleIdxFor? name with + | none => false + | some idx => + let moduleName := env.allImportedModuleNames[idx.toNat]! + (`Ix).isPrefixOf moduleName || (`Blake3).isPrefixOf moduleName + +/-- Include constructor types and full checked bodies instead of relying on +imported axiom summaries. Both added and removed assumptions require review. -/ +def checkAxioms (env : Environment) (root : Name) (expected : Array Name) : + CommandElabM (Array Name) := do + let mut actual := #[] + for name in closure env false [root] do + let some info := env.checked.get.find? name + | throwError "certified adapter has an unavailable checked dependency: {name}" + if info.isAxiom then actual := actual.push name + let sorted := actual.qsort Name.lt + unless sorted == expected.qsort Name.lt do + throwError "certified axiom boundary changed for {root}: expected {expected.qsort Name.lt}, actual {sorted}" + return sorted + +private def expectedAxioms (root : Name) : Array Name := + if #[`Ix.Certified.readLevel_value, `Ix.Certified.treeLeaves_join].contains root then + #[``propext] + else if #[`Ix.Certified.readSignature?, `Ix.Certified.constantBytes?, + `Ix.Certified.resolveReference_iff, `Ix.Certified.readExpr_sound, + `Ix.Certified.ExprReading.unique, `Ix.Certified.readExpr_fuel_independent, + `Ix.Certified.readBlock_sourceHeader, `Ix.Certified.readStore_sourceHeader, + `Ix.Certified.readSignature_sound, `Ix.Theory.Certificate.Modeled.witness?, + `Ix.Theory.Certificate.sourceGroup?, `Ix.Theory.Certificate.proofWitness?, + `Ix.Certified.modelCandidate?, `Ix.Certified.modelCandidates?].contains root then + #[``propext, ``Quot.sound] + else #[``propext, ``Classical.choice, ``Quot.sound] + +def distinct (names : Array Name) : Array Name := + names.foldl (fun result name => if result.contains name then result else result.push name) #[] + +/-- Freeze theorem types, premise definitions, and transitive execution +dependencies. This does not establish correctness of native execution. -/ +def report (label : String) (roots premises : Array Name) : CommandElabM Unit := do + let env ← getEnv + for root in roots do + let some info := env.checked.get.find? root + | throwError "certified audit: missing root {root}" + let axioms ← checkAxioms env root (expectedAxioms root) + liftTermElabM do logInfo m!"ROOT {root}\n{← Meta.ppExpr info.type}\nAXIOMS {axioms}" + for name in premises do + let some info := env.checked.get.find? name + | throwError "certified audit: missing premise {name}" + liftTermElabM do + logInfo m!"PREMISE {name}\n{← Meta.ppExpr info.type}" + if let .defnInfo value := info then logInfo m!"DEFINITION\n{← Meta.ppExpr value.value}" + let logical := closure env false roots.toList + let reachable := (closure env true roots.toList).toList.mergeSort (fun a b => a.toString < b.toString) + let mut workers : Array Name := #[] + let mut externs : Array Name := #[] + let mut replacements : Array (Name × Name) := #[] + for name in reachable do + let some info := env.checked.get.find? name + | throwError "certified adapter has an unavailable checked runtime dependency: {name}" + if projectConstant env name then + if let some parent := Lean.Compiler.isUnsafeRecName? name then + match env.checked.get.find? parent with + | some (.defnInfo original) => + unless original.safety == .safe do + throwError "certified recursion worker source is not safe: {name}" + | _ => throwError "certified recursion worker has no safe source definition: {name}" + workers := workers.push name + if Lean.isExtern env name then externs := externs.push name + if let some other := Lean.Compiler.getImplementedBy? env name then + replacements := replacements.push (name, other) + if let some other := (Lean.Compiler.CSimp.ext.getState env).map.find? name then + replacements := replacements.push (name, other.toDeclName) + if let .defnInfo definition := info then + unless definition.safety == .safe || (Lean.Compiler.isUnsafeRecName? name).isSome do + throwError "certified adapter has an unreviewed unsafe runtime: {name}" + if let .opaqueInfo definition := info then + if definition.isUnsafe then throwError "certified adapter has an unsafe opaque runtime: {name}" + if Lean.Elab.ComputedFields.computedFieldAttr.hasTag env name then + throwError "certified adapter has an unreviewed computed field: {name}" + unless externs == #[`Blake3.Rust.hasherFinalize, `Blake3.Rust.hasherInit, + `Blake3.Rust.hasherInitDeriveKey, `Blake3.Rust.hasherInitKeyed, + `Blake3.Rust.hasherUpdate] do + throwError "certified runtime extern inventory changed: {externs}" + unless replacements.isEmpty do + throwError "certified runtime replacements changed: {replacements}" + for name in externs do + let some info := env.checked.get.find? name + | throwError "certified runtime extern is missing: {name}" + liftTermElabM do logInfo m!"RUNTIME EXTERN {name}\n{← Meta.ppExpr info.type}" + for name in workers.qsort Name.lt do + let some (.defnInfo value) := env.checked.get.find? name + | throwError "certified recursion worker is missing: {name}" + liftTermElabM do + logInfo m!"RECURSION WORKER {name}\n{← Meta.ppExpr value.type}\nIMPLEMENTATION\n{← Meta.ppExpr value.value}" + logInfo m!"{label} ROOTS {roots.size}; LOGICAL DECLARATIONS {logical.size}; WITH RUNTIME {reachable.length}" + logInfo m!"RUNTIME EXTERNS {externs}\nRECURSION WORKERS {workers.size}" + logInfo "All inventoried recursion workers have safe logical sources; no partial opaque source or executable replacement is permitted. Runtime diagnostics cover Ix and Blake3 modules, including private constants. Lean/Std execution and the BLAKE3 foreign interface remain external runtime boundaries." + logInfo "These host-adapter roots establish semantic claims under the enforced profile and explicit model premises. They do not establish full production-checker refinement or Aiur compiler/AIR soundness." + +private inductive ConstructorAuditFixture where + | plain + | withProof (proof : propext (Iff.refl True) = rfl) + +run_cmd do + let _ ← checkAxioms (← getEnv) ``ConstructorAuditFixture.plain #[``propext] + let _ ← checkAxioms (← getEnv) ``Eq.refl #[] + +/-- error: certified axiom boundary changed for Eq.refl: expected [propext], actual [] -/ +#guard_msgs in +run_cmd do + let _ ← checkAxioms (← getEnv) ``Eq.refl #[``propext] + +/-- error: certified axiom boundary changed for propext: expected [], actual [propext] -/ +#guard_msgs in +run_cmd do + let _ ← checkAxioms (← getEnv) ``propext #[] + +end Ix.Certified.AuditSupport diff --git a/Ix/Certified/Bytes.lean b/Ix/Certified/Bytes.lean new file mode 100644 index 000000000..01107d4e7 --- /dev/null +++ b/Ix/Certified/Bytes.lean @@ -0,0 +1,151 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.Ixon + +namespace Ix.Certified + +open Ix.Theory Ix.Theory.Certified +open Ix.Theory.Model Ix.Theory.Model.SetTheory + +universe v + +/-- These external constant addresses are part of the selected public profile, +not fields supplied by an annotation or typing witness. -/ +structure Profile where + falseType : Address + falseElim : Address + natType : Option Address := none + deriving DecidableEq + +abbrev ConstantBlobs := List (Address × ByteArray) + +abbrev DecodedObject (address : Address) (bytes : ByteArray) := + { value : Ixon.Constant // + address.hash.size = 32 ∧ Address.blake3 bytes = address ∧ + Ixon.runGetExact Ixon.getConstant bytes = .ok value ∧ Ixon.serConstant value = bytes } + +/-- Check canonical re-encoding after a single parse. Keeping the parser's +result as a separate argument makes the cache reflection equation explicit. -/ +def canonicalObject? (address : Address) (bytes : ByteArray) + (auth : address.hash.size = 32 ∧ Address.blake3 bytes = address) + (result : Except String Ixon.Constant) + (parsed : Ixon.runGetExact Ixon.getConstant bytes = result) : Option (DecodedObject address bytes) := + match result, parsed with + | .error _, _ => none + | .ok source, hp => + if hc : Ixon.serConstant source = bytes then some ⟨source, auth.1, auth.2, hp, hc⟩ else none + +/-- The accepted byte domain consists of complete canonical Ixon constants. +The returned proof records authentication, exact consumption, and re-encoding +of the same bytes. It grants no typing or semantic acceptance by itself. -/ +def decodeObject? (address : Address) (bytes : ByteArray) : Option (DecodedObject address bytes) := + if h : address.hash.size = 32 ∧ Address.blake3 bytes = address then + canonicalObject? address bytes h (Ixon.runGetExact Ixon.getConstant bytes) rfl + else none + +def decodeObjects? (blobs : ConstantBlobs) : Option Objects := + blobs.mapM fun (address, bytes) => do + let source ← decodeObject? address bytes + return (address, source.val) + +/-- Natural blobs use Ix's unsigned little-endian encoding, with authentication +and canonical re-encoding checked before any literal is read. -/ +def decodeNatural? (address : Address) (bytes : ByteArray) : + Option { value : Nat // + address.hash.size = 32 ∧ Address.blake3 bytes = address ∧ + Nat.fromBytesLE bytes.data = value ∧ ByteArray.mk value.toBytesLE = bytes } := + if h : address.hash.size = 32 ∧ Address.blake3 bytes = address then + let value := Nat.fromBytesLE bytes.data + if hc : ByteArray.mk value.toBytesLE = bytes then some ⟨value, h.1, h.2, rfl, hc⟩ else none + else none + +def decodeNaturals? (blobs : ConstantBlobs) : Option Naturals := + blobs.mapM fun (address, bytes) => do + let value ← decodeNatural? address bytes + return (address, value.val) + +def readSignature? (profile : Profile) (objects : Objects) : + Option (PrimitiveSignature Address) := do + let falseType ← resolveReference? objects profile.falseType + let falseElim ← resolveReference? objects profile.falseElim + let natType ← match profile.natType with + | none => some none + | some address => (resolveReference? objects address).map some + if h : falseType ≠ falseElim then + return ⟨falseType, falseElim, h, natType⟩ + else none + +structure PreparedInput where + signature : PrimitiveSignature Address + input : ProofInput Address + +def prepare? (fuel : Nat) (profile : Profile) (target : Address) (blobs : ConstantBlobs) + (literalBlobs : ConstantBlobs := []) : Option PreparedInput := do + if !((blobs ++ literalBlobs).map Prod.fst).Nodup then none else do + let naturals ← decodeNaturals? literalBlobs + let objects ← decodeObjects? blobs + let signature ← readSignature? profile objects + let input ← readProofInput? fuel objects target naturals + return ⟨signature, input⟩ + +/-- The actual serialized-input gate invokes the mathematical validator after +authentication and decoding. The byte/statement preservation and compiled +execution theorems remain separate obligations. -/ +def acceptsSerialized (fuel : Nat) (profile : Profile) (target : Address) + (blobs : ConstantBlobs) (witness : ProofWitness Address) + (literalBlobs : ConstantBlobs := []) : Bool := + match prepare? fuel profile target blobs literalBlobs with + | none => false + | some prepared => + acceptsCertified.{0,v} fuel prepared.signature prepared.input witness + +theorem acceptsSerialized_prepared {fuel : Nat} {profile : Profile} {target : Address} + {blobs literalBlobs : ConstantBlobs} {witness : ProofWitness Address} + (h : acceptsSerialized.{v} fuel profile target blobs witness literalBlobs = true) : + ∃ prepared, prepare? fuel profile target blobs literalBlobs = some prepared ∧ + acceptsCertified.{0,v} fuel prepared.signature prepared.input witness = true := by + unfold acceptsSerialized at h + cases hp : prepare? fuel profile target blobs literalBlobs with + | none => simp [hp] at h + | some prepared => exact ⟨prepared, rfl, by simpa only [hp] using h⟩ + +/-- A successful serialized host check constructs the model of its decoded +input. Relating that input to a public cryptographic proposition is C6/C8. -/ +theorem accepted_serialized_has_model {fuel : Nat} {profile : Profile} {target : Address} + {blobs literalBlobs : ConstantBlobs} {witness : ProofWitness Address} + (h : acceptsSerialized.{v} fuel profile target blobs witness literalBlobs = true) + (V : Type v) [SetTheory V] (levels : List Nat) (env : Nat → V) : + ∃ prepared, prepare? fuel profile target blobs literalBlobs = some prepared ∧ + ∃ result : CheckedProof.{0,v} prepared.signature prepared.input, + checkProofCertified fuel prepared.signature prepared.input witness = some result ∧ + ∃ constants : Assignment Address V, + prepared.signature.Compatible result.environment.entries constants ∧ + WellDenoted constants levels env result.proof.val ∧ + WellDenoted constants levels env result.proposition.val ∧ + interp constants levels env result.proof.val ∈ˢ + interp constants levels env result.proposition.val := by + obtain ⟨prepared, hp, ha⟩ := acceptsSerialized_prepared h + exact ⟨prepared, hp, accepted_has_model ha V levels env⟩ + +/-- This checks the decoded target statement against the profile's exact +empty proposition. It performs no theorem or semantic witness search. -/ +def isFalseStatement (fuel : Nat) (profile : Profile) (target : Address) + (blobs : ConstantBlobs) (literalBlobs : ConstantBlobs := []) : Bool := + match prepare? fuel profile target blobs literalBlobs with + | none => false + | some prepared => decide (prepared.input.proposition = prepared.signature.falseExpr) + +theorem no_serialized_proof_of_False {fuel : Nat} {profile : Profile} {target : Address} + {blobs literalBlobs : ConstantBlobs} {witness : ProofWitness Address} + (V : Type v) [SetTheory V] + (hf : isFalseStatement fuel profile target blobs literalBlobs = true) + (h : acceptsSerialized.{v} fuel profile target blobs witness literalBlobs = true) : False := by + obtain ⟨prepared, hp, ha⟩ := acceptsSerialized_prepared h + have he : prepared.input.proposition = prepared.signature.falseExpr := by + simpa only [isFalseStatement, hp, decide_eq_true_eq] using hf + exact no_proof_of_False V he ha + +end Ix.Certified diff --git a/Ix/Certified/ClaimAccept.lean b/Ix/Certified/ClaimAccept.lean new file mode 100644 index 000000000..7e5203f5d --- /dev/null +++ b/Ix/Certified/ClaimAccept.lean @@ -0,0 +1,164 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.Reveal + +namespace Ix.Certified + +open Ix.Theory Ix.Theory.Certified Ix.Theory.Model Ix.Theory.Model.SetTheory + +universe v + +def LogicalKind : Ix.Claim → Prop + | .check .. | .checkEnv .. | .catalog .. => True + | _ => False + +theorem LogicalReceipt.kind (receipt : LogicalReceipt.{v} source fuel envelope witness) : + LogicalKind envelope.claim := by + have h := receipt.checked.content.meaning + cases hc : envelope.claim <;> simp_all [LogicalKind] + +/-- Meaning of the exact source declarations selected by the public claim. +The annotated readings remain tied to their original type fields and tables. -/ +def SubjectsInterpreted (receipt : LogicalReceipt.{v} source fuel envelope witness) + (V : Type v) [SetTheory V] (constants : Assignment Address V) : Prop := + ∀ ref ∈ receipt.checked.subjects, ∃ entry, + SourceDeclarationReading source receipt.snapshot.decodedObjects receipt.snapshot.decodedNaturals ref entry ∧ + ∀ levels, levels.length = entry.universes → ∀ env, + WellDenoted constants levels env entry.type ∧ + constants ref levels ∈ˢ interp constants levels env entry.type + +def LogicalMeaning (source : Ixon.Env) (fuel : Nat) (envelope : Envelope) : Prop := + ∃ witness : LogicalWitness, ∃ receipt : LogicalReceipt.{v} source fuel envelope witness, + SignatureReading envelope.profile receipt.snapshot.decodedObjects receipt.checked.signature ∧ + (∀ ref ∈ receipt.checked.frontierRefs, ∃ entry, + receipt.checked.batch.receipt.frontier.interface.entries ref = some entry ∧ + SourceDeclarationReading source receipt.snapshot.decodedObjects receipt.snapshot.decodedNaturals ref entry) ∧ + (∀ ref ∈ receipt.checked.axiomRefs, ∃ entry, + Standard.EntrySource receipt.checked.store ref entry ∨ Quotient.EntrySource receipt.checked.store ref entry) ∧ + (∀ (V : Type v) [SetTheory V] (constants : Assignment Address V), + receipt.checked.signature.Compatible receipt.checked.batch.receipt.frontier.interface.entries constants → + ∃ constants' : Assignment Address V, + receipt.checked.signature.Compatible receipt.checked.batch.receipt.checked.result.entries constants' ∧ + Assignment.AgreesOn receipt.checked.batch.receipt.frontier.interface.entries constants constants' ∧ + SubjectsInterpreted receipt V constants') ∧ + (claimFrontier envelope.claim = none → ∀ (V : Type v) [SetTheory V], + ∃ constants : Assignment Address V, + receipt.checked.signature.Compatible receipt.checked.batch.receipt.checked.result.entries constants ∧ + SubjectsInterpreted receipt V constants) + +theorem LogicalReceipt.meaning (receipt : LogicalReceipt.{v} source fuel envelope witness) : + LogicalMeaning.{v} source fuel envelope := + ⟨witness, receipt, readSignature_sound receipt.checked.signatureReading, + fun _ h => receipt.checked.original_frontier h, + fun _ h => receipt.checked.logical_policy h, + fun V _ constants hM => receipt.subject_meaning V constants hM, + fun closed V _ => receipt.closed_subject_meaning closed V⟩ + +/-- One contract for the versioned claim protocol. Structural membership and +revelation remain structural. Evaluation is excluded until a separate +execution/result interpretation has been proved and bound to the profile. -/ +def SemanticClaimMeaning (source : Ixon.Env) (fuel : Nat) (envelope : Envelope) : Prop := + envelope.protocol = Protocol.current ∧ + match envelope.claim with + | .check .. | .checkEnv .. | .catalog .. => LogicalMeaning.{v} source fuel envelope + | .contains root target => envelope.logicalAxioms = none ∧ TreeMembership root target + | .reveal commitment info => envelope.logicalAxioms = none ∧ RevealMeaning source commitment info + | .eval .. => False + +inductive ClaimWitness where + | logical (witness : LogicalWitness) + | contains (tree : ByteArray) + | reveal (witness : RevealWitness) + +inductive ClaimAction (source : Ixon.Env) (fuel : Nat) (envelope : Envelope) where + | logical {witness : LogicalWitness} (receipt : LogicalReceipt.{v} source fuel envelope witness) + | contains {root target : Address} {bytes : ByteArray} + (claim : envelope.claim = .contains root target) + (noAxioms : envelope.logicalAxioms = none) (opening : TreeOpening fuel root bytes) + (member : target ∈ treeLeaves opening.tree) + | reveal {commitment : Address} {info : Ix.RevealConstantInfo} {witness : RevealWitness} + (claim : envelope.claim = .reveal commitment info) + (noAxioms : envelope.logicalAxioms = none) (receipt : RevealReceipt source commitment info witness) + +structure ClaimReceipt (source : Ixon.Env) (fuel : Nat) (address : Address) (bytes : ByteArray) where + reading : EnvelopeReading address bytes + action : ClaimAction.{v} source fuel reading.envelope + +def checkClaimAction? (fuel : Nat) (source : Ixon.Env) (envelope : Envelope) (witness : ClaimWitness) : + Read source (ClaimAction.{v} source fuel envelope) := + match hc : envelope.claim, witness with + | .check .., .logical witness | .checkEnv .., .logical witness | .catalog .., .logical witness => do + let receipt ← checkLogicalSource?.{v} fuel source envelope witness + return .logical receipt + | .contains root target, .contains bytes => + if ha : envelope.logicalAxioms = none then + match readTree? fuel root bytes with + | none => failure + | some opening => + if hm : (treeLeaves opening.tree).contains target = true then + pure (.contains hc ha opening (List.contains_iff_mem.mp hm)) else failure + else failure + | .reveal commitment info, .reveal witness => + if ha : envelope.logicalAxioms = none then do + let receipt ← checkReveal? source commitment info witness + return .reveal hc ha receipt + else failure + | _, _ => failure + +/-- Public source acceptance starts with exact authenticated claim bytes. +Protocol and policy versions are checked before any dispatcher branch. -/ +def checkClaimBytes? (fuel : Nat) (source : Ixon.Env) (address : Address) (bytes : ByteArray) + (witness : ClaimWitness) : Read source (ClaimReceipt.{v} source fuel address bytes) := + match readEnvelope? fuel address bytes with + | none => failure + | some reading => do + let action ← checkClaimAction?.{v} fuel source reading.envelope witness + return ⟨reading, action⟩ + +def acceptsClaimBytes (fuel : Nat) (source : Ixon.Env) (address : Address) (bytes : ByteArray) + (witness : ClaimWitness) : Bool := + (checkClaimBytes?.{v} fuel source address bytes witness {}).isSome + +theorem ClaimReceipt.meaning (receipt : ClaimReceipt.{v} source fuel address bytes) : + SemanticClaimMeaning.{v} source fuel receipt.reading.envelope := by + refine ⟨receipt.reading.supported, ?_⟩ + cases receipt.action with + | logical logical => + have kind := logical.kind + have meaning := logical.meaning + cases hc : receipt.reading.envelope.claim <;> simp_all [LogicalKind] + | contains claim noAxioms opening member => + rw [claim] + exact ⟨noAxioms, opening.membership member⟩ + | reveal claim noAxioms revealed => + rw [claim] + exact ⟨noAxioms, revealed.meaning⟩ + +/-- Successful source checking yields the meaning of the exact authenticated +public envelope, including profile, statement, frontier and logical-use root. -/ +theorem accepted_claim_meaning {fuel : Nat} {source : Ixon.Env} {address : Address} {bytes : ByteArray} + {witness : ClaimWitness} (h : acceptsClaimBytes.{v} fuel source address bytes witness = true) : + ∃ receipt : ClaimReceipt.{v} source fuel address bytes, ∃ cache, + checkClaimBytes? fuel source address bytes witness {} = some (receipt, cache) ∧ + Address.blake3 bytes = address ∧ envelopeBytes receipt.reading.envelope = bytes ∧ + SemanticClaimMeaning.{v} source fuel receipt.reading.envelope := by + unfold acceptsClaimBytes at h + obtain ⟨⟨receipt, cache⟩, hc⟩ := Option.isSome_iff_exists.mp h + exact ⟨receipt, cache, hc, receipt.reading.authenticated, receipt.reading.canonical, receipt.meaning⟩ + +theorem evaluation_not_semantic {source : Ixon.Env} {fuel : Nat} {envelope : Envelope} + {input output : Address} {frontier : Option Address} + (h : envelope.claim = .eval input output frontier) : ¬ SemanticClaimMeaning.{v} source fuel envelope := by + simp [SemanticClaimMeaning, h] + +theorem membership_not_leaf {fuel : Nat} {root target : Address} {bytes : Option ByteArray} : + readSubjectView? fuel (.contains root target) bytes = none := by cases bytes <;> rfl + +theorem revelation_not_leaf {fuel : Nat} {commitment : Address} {info : Ix.RevealConstantInfo} + {bytes : Option ByteArray} : readSubjectView? fuel (.reveal commitment info) bytes = none := by + cases bytes <;> rfl + +end Ix.Certified diff --git a/Ix/Certified/ClaimAudit.lean b/Ix/Certified/ClaimAudit.lean new file mode 100644 index 000000000..23b9676b7 --- /dev/null +++ b/Ix/Certified/ClaimAudit.lean @@ -0,0 +1,49 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.AuditSupport +import Ix.Certified.ClaimCommand + +/-! Trust, runtime and premise inventory of the versioned semantic claim +checker, source command and actual TcM acceptance boundary. -/ + +open Lean Lean.Elab Command + +namespace Ix.Certified.ClaimAudit + +def roots : Array Lean.Name := #[ + `Ix.Certified.TreeOpening.membership, `Ix.Certified.TreeOpening.unique, + `Ix.Certified.treeLeaves_join, `Ix.Certified.EnvelopeReading.unique, + `Ix.Certified.readEnvelope?, `Ix.Certified.readTree?, + `Ix.Certified.LogicalChecking.original_subject, `Ix.Certified.LogicalChecking.original_frontier, + `Ix.Certified.LogicalChecking.logical_policy, `Ix.Certified.LogicalChecking.closed_frontier, + `Ix.Certified.LogicalReceipt.subject_meaning, `Ix.Certified.LogicalReceipt.closed_subject_meaning, + `Ix.Certified.LogicalReceipt.no_False, + `Ix.Certified.RevealReceipt.meaning, `Ix.Certified.ClaimReceipt.meaning, + `Ix.Certified.accepted_claim_meaning, `Ix.Certified.evaluation_not_semantic, + `Ix.Certified.membership_not_leaf, `Ix.Certified.revelation_not_leaf, + `Ix.Kernel.TcM.checkClaimCertified_success, + `Ix.Kernel.certifiedClaimStep_failure, `Ix.Kernel.certifiedClaimStep_success, + `Ix.Kernel.accepted_tc_claim_meaning, + `Ix.Certified.ClaimCommand.readRequest, + `Ix.Certified.ClaimCommand.run_success, `Ix.Certified.ClaimCommand.run_meaning] + +def premises : Array Lean.Name := #[ + `Ix.Certified.Protocol.current, `Ix.Certified.envelopeMagic, + `Ix.Certified.putEnvelope, `Ix.Certified.getEnvelope, + `Ix.Certified.EnvelopeReading.mk, `Ix.Certified.TreeOpening.mk, + `Ix.Certified.OptionalTreeOpening.mk, `Ix.Certified.SubjectView.mk, + `Ix.Certified.PreparedLeaf.mk, `Ix.Certified.ContentView.mk, + `Ix.Certified.ownedReferences, `Ix.Certified.claimFrontier, + `Ix.Certified.LogicalChecking.mk, `Ix.Certified.LogicalReceipt.mk, + `Ix.Certified.SubjectsInterpreted, `Ix.Certified.LogicalMeaning, + `Ix.Certified.RevealMatches, `Ix.Certified.ConstructorMatches, + `Ix.Certified.ConstructorsMatch, `Ix.Certified.MutMatches, + `Ix.Certified.ComponentsMatch, `Ix.Certified.RulesMatch, + `Ix.Certified.RevealMeaning, `Ix.Certified.SemanticClaimMeaning] + +run_cmd AuditSupport.report "claim meaning" roots premises + +end Ix.Certified.ClaimAudit diff --git a/Ix/Certified/ClaimCheck.lean b/Ix/Certified/ClaimCheck.lean new file mode 100644 index 000000000..7a8b8cb43 --- /dev/null +++ b/Ix/Certified/ClaimCheck.lean @@ -0,0 +1,104 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.ClaimInput + +namespace Ix.Certified + +open Ix.Theory Ix.Theory.Certified Ix.Theory.Model Ix.Theory.Model.SetTheory + +universe v + +structure LogicalWitness where + selection : InputSelection + leaves : List LeafWitness + subjects : Option ByteArray + members : Option ByteArray + frontierTree : Option ByteArray + frontier : List (FrontierWitness Address) + axiomTree : Option ByteArray + +structure LogicalChecking {source : Ixon.Env} (snapshot : SourceSnapshot source) + (fuel : Nat) (envelope : Envelope) (witness : LogicalWitness) where + uniqueSource : ((snapshot.blobs ++ snapshot.literalBlobs).map Prod.fst).Nodup + signature : PrimitiveSignature Address + signatureReading : readSignature? envelope.profile snapshot.decodedObjects = some signature + store : Store Address + storeReading : readStore? fuel snapshot.decodedObjects snapshot.decodedNaturals = some store + leaves : List (LeafInput fuel snapshot.decodedObjects) + leavesReading : witness.leaves.mapM (readLeafInput? fuel snapshot.decodedObjects) = some leaves + content : ContentView fuel envelope.claim witness.subjects witness.members leaves + subjects : List (ConstRef Address) + subjectsReading : content.addresses.flatMapM (subjectReferences? snapshot.decodedObjects) = some subjects + frontier : OptionalTreeOpening fuel (claimFrontier envelope.claim) witness.frontierTree + frontierRefs : List (ConstRef Address) + frontierReading : frontier.leaves.flatMapM (subjectReferences? snapshot.decodedObjects) = some frontierRefs + batch : CheckedBatch.{0,v} fuel signature store (leaves.map (fun leaf => leaf.prepared.node signature)) + batchChecking : checkBatch? fuel signature store witness.frontier + (leaves.map (fun leaf => leaf.prepared.node signature)) = some batch + exactSubjects : ∀ ref, ref ∈ nodeSubjects batch.nodes ↔ ref ∈ ownedReferences signature subjects + exactFrontier : ∀ ref, ref ∈ batch.receipt.frontier.refs ↔ ref ∈ frontierRefs + axioms : OptionalTreeOpening fuel envelope.logicalAxioms witness.axiomTree + axiomRefs : List (ConstRef Address) + axiomsReading : axioms.leaves.flatMapM (subjectReferences? snapshot.decodedObjects) = some axiomRefs + exactAxioms : ∀ ref, ref ∈ batch.logicalUses ↔ ref ∈ axiomRefs + +def checkLogicalSnapshot? {source : Ixon.Env} (snapshot : SourceSnapshot source) + (fuel : Nat) (envelope : Envelope) (witness : LogicalWitness) : + Option (LogicalChecking.{v} snapshot fuel envelope witness) := + if hu : ((snapshot.blobs ++ snapshot.literalBlobs).map Prod.fst).Nodup then + match hs : readSignature? envelope.profile snapshot.decodedObjects with + | none => none + | some signature => + match ht : readStore? fuel snapshot.decodedObjects snapshot.decodedNaturals with + | none => none + | some store => + match hl : witness.leaves.mapM (readLeafInput? fuel snapshot.decodedObjects) with + | none => none + | some leaves => do + let content ← readContentView? fuel envelope.claim witness.subjects witness.members leaves + match htargets : content.addresses.flatMapM (subjectReferences? snapshot.decodedObjects) with + | none => none + | some subjects => do + let frontier ← readOptionalTree? fuel (claimFrontier envelope.claim) witness.frontierTree + match hfrontier : frontier.leaves.flatMapM (subjectReferences? snapshot.decodedObjects) with + | none => none + | some frontierRefs => + match hc : checkBatch?.{0,v} fuel signature store witness.frontier + (leaves.map (fun leaf => leaf.prepared.node signature)) with + | none => none + | some batch => + if hsubjects : sameMembers (nodeSubjects batch.nodes) (ownedReferences signature subjects) = true then + if hf : sameMembers batch.receipt.frontier.refs frontierRefs = true then do + let axioms ← readOptionalTree? fuel envelope.logicalAxioms witness.axiomTree + match haxioms : axioms.leaves.flatMapM (subjectReferences? snapshot.decodedObjects) with + | none => none + | some axiomRefs => + if ha : sameMembers batch.logicalUses axiomRefs = true then + some ⟨hu, signature, hs, store, ht, leaves, hl, content, subjects, htargets, + frontier, frontierRefs, hfrontier, batch, hc, sameMembers_iff.mp hsubjects, + sameMembers_iff.mp hf, axioms, axiomRefs, haxioms, sameMembers_iff.mp ha⟩ + else none + else none + else none + else none + +structure LogicalReceipt (source : Ixon.Env) (fuel : Nat) (envelope : Envelope) (witness : LogicalWitness) where + snapshot : SourceSnapshot source + checked : LogicalChecking.{v} snapshot fuel envelope witness + supported : envelope.protocol = Protocol.current + +/-- Every cache hit revalidates the actual complete claim. Only authenticated +data is reused; claim, policy, frontier and model checks run on every request. -/ +def checkLogicalSource? (fuel : Nat) (source : Ixon.Env) (envelope : Envelope) (witness : LogicalWitness) : + Read source (LogicalReceipt.{v} source fuel envelope witness) := + if hp : envelope.protocol = Protocol.current then do + let snapshot ← readSnapshot? fuel source witness.selection + match checkLogicalSnapshot?.{v} snapshot fuel envelope witness with + | none => failure + | some checked => return ⟨snapshot, checked, hp⟩ + else failure + +end Ix.Certified diff --git a/Ix/Certified/ClaimCommand.lean b/Ix/Certified/ClaimCommand.lean new file mode 100644 index 000000000..659c87de0 --- /dev/null +++ b/Ix/Certified/ClaimCommand.lean @@ -0,0 +1,117 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.ClaimSuggest +import Ix.Kernel.CertifiedClaims + +/-! Generic command for the versioned public claim protocol. Public bytes +and their expected address are inputs; JSON supplies only untrusted search +hints. Each successful command ends in the certified TcM claim checker. -/ + +namespace Ix.Certified.ClaimCommand + +universe v + +inductive Hint where + | logical (hint : LogicalHint) + | contains (tree : ByteArray) + | reveal (witness : RevealWitness) + +structure Request where + address : Address + hint : Hint + +def readAddress (value : String) : Except String Address := + match Address.fromString value with + | none => .error "expected a 32-byte hexadecimal address" + | some address => .ok address + +def readHex (value : String) : Except String ByteArray := + match bytesOfHex value with + | none => .error "expected an even-length hexadecimal byte string" + | some bytes => .ok bytes + +def readOptionalHex (json : Lean.Json) (field : String) : Except String (Option ByteArray) := do + (← json.getObjValAs? (Option String) field).mapM readHex + +def readLeaf (json : Lean.Json) : Except String LeafHint := do + let bytes ← readHex (← json.getObjValAs? String "claim") + let claim ← Ixon.runGetExact Ix.Claim.get bytes + if Ix.Claim.ser claim != bytes then throw "noncanonical leaf claim bytes" + return ⟨claim, ← readOptionalHex json "subjects", ← readOptionalHex json "frontier"⟩ + +def readLogicalHint (json : Lean.Json) : Except String LogicalHint := do + let objects ← (← json.getObjValAs? (List String) "objects").mapM readAddress + let naturals ← (← json.getObjValAs? (List String) "naturals").mapM readAddress + let leaves ← (← json.getObjValAs? (List Lean.Json) "leaves").mapM readLeaf + return ⟨⟨objects, naturals⟩, leaves, ← readOptionalHex json "subjects", + ← readOptionalHex json "members", ← readOptionalHex json "frontier", ← readOptionalHex json "axioms", + ← ModelHint.readOptional json⟩ + +def readRequest (json : Lean.Json) : Except String Request := do + let address ← readAddress (← json.getObjValAs? String "address") + let kind ← json.getObjValAs? String "kind" + let hint : Hint ← if kind = "logical" then do pure (Hint.logical (← readLogicalHint json)) + else if kind = "contains" then do pure (Hint.contains (← readHex (← json.getObjValAs? String "tree"))) + else if kind = "reveal" then do + let secret ← readAddress (← json.getObjValAs? String "secret") + let payload ← readAddress (← json.getObjValAs? String "payload") + pure (Hint.reveal ⟨⟨secret, payload⟩⟩) + else throw "kind must be logical, contains or reveal" + return ⟨address, hint⟩ + +def suggestWitness? (fuel : Nat) (source : Ixon.Env) (bytes : ByteArray) (request : Request) : + Option ClaimWitness := do + let reading ← readEnvelope? fuel request.address bytes + match request.hint with + | .logical hint => return .logical (← suggestLogical? fuel source reading.envelope hint) + | .contains tree => return .contains tree + | .reveal witness => return .reveal witness + +def run (fuel : Nat) (source : Ixon.Env) (bytes : ByteArray) (request : Request) : Except String Unit := do + let some witness := suggestWitness? fuel source bytes request + | throw "certified envelope or witness search declined" + if Kernel.acceptsCertifiedClaim.{v} fuel source request.address bytes witness then return () + else throw "certified claim validation rejected the witness" + +theorem run_success {fuel : Nat} {source : Ixon.Env} {bytes : ByteArray} {request : Request} + (h : run.{v} fuel source bytes request = .ok ()) : + ∃ witness, Kernel.acceptsCertifiedClaim.{v} fuel source request.address bytes witness = true := by + cases hw : suggestWitness? fuel source bytes request with + | none => simp [run, hw] at h + | some witness => + by_cases ha : Kernel.acceptsCertifiedClaim.{v} fuel source request.address bytes witness = true + · exact ⟨witness, ha⟩ + · simp [run, hw, ha] at h + +theorem run_meaning {fuel : Nat} {source : Ixon.Env} {bytes : ByteArray} {request : Request} + (h : run.{v} fuel source bytes request = .ok ()) : + ∃ receipt : ClaimReceipt.{v} source fuel request.address bytes, + Address.blake3 bytes = request.address ∧ envelopeBytes receipt.reading.envelope = bytes ∧ + SemanticClaimMeaning.{v} source fuel receipt.reading.envelope := by + obtain ⟨witness, hw⟩ := run_success h + obtain ⟨receipt, _, ha, hb, hm⟩ := Kernel.accepted_tc_claim_meaning hw + exact ⟨receipt, ha, hb, hm⟩ + +def main (args : List String) : IO UInt32 := do + let [sourcePath, envelopePath, requestPath] := args | do + IO.eprintln "usage: certified-claim-check SOURCE.ixe ENVELOPE.bin REQUEST.json" + return 2 + let sourceBytes ← IO.FS.readBinFile sourcePath + let envelope ← IO.FS.readBinFile envelopePath + let requestText ← IO.FS.readFile requestPath + let result := do + let request ← readRequest (← Lean.Json.parse requestText) + let parts ← Ixon.deEnvVerifiedLazy sourceBytes + run.{0} 6400 parts.env envelope request + return request.address + match result with + | .error error => IO.eprintln error; return 1 + | .ok address => + IO.println <| (Lean.Json.mkObj [("accepted", Lean.toJson true), + ("address", Lean.toJson (hexOfBytes address.hash))]).compress + return 0 + +end Ix.Certified.ClaimCommand diff --git a/Ix/Certified/ClaimInput.lean b/Ix/Certified/ClaimInput.lean new file mode 100644 index 000000000..c5497b8a5 --- /dev/null +++ b/Ix/Certified/ClaimInput.lean @@ -0,0 +1,145 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.Envelope +import Ix.Theory.Certified.ClaimComposition + +namespace Ix.Certified + +open Ix.Theory Ix.Theory.Certified Ix.Theory.Model + +def sameMembers {α : Type _} [DecidableEq α] (a b : List α) : Bool := + a.all (b.contains ·) && b.all (a.contains ·) + +theorem sameMembers_iff {α : Type _} [DecidableEq α] {a b : List α} : + sameMembers a b = true ↔ ∀ x, x ∈ a ↔ x ∈ b := by + simp only [sameMembers, Bool.and_eq_true, List.all_eq_true, List.contains_iff_mem] + exact ⟨fun h x => ⟨h.1 x, h.2 x⟩, fun h => ⟨fun x => (h x).mp, fun x => (h x).mpr⟩⟩ + +def claimFrontier : Ix.Claim → Option Address + | .check _ frontier | .checkEnv _ frontier | .catalog _ _ frontier | .eval _ _ frontier => frontier + | _ => none + +structure SubjectView (fuel : Nat) (claim : Ix.Claim) (bytes : Option ByteArray) where + addresses : List Address + meaning : match claim with + | .check address _ => bytes = none ∧ addresses = [address] + | .checkEnv root _ => ∃ raw, bytes = some raw ∧ + ∃ opening : TreeOpening fuel root raw, treeLeaves opening.tree = addresses + | _ => False + +def readSubjectView? (fuel : Nat) (claim : Ix.Claim) (bytes : Option ByteArray) : + Option (SubjectView fuel claim bytes) := + match claim, bytes with + | .check address _, none => some ⟨[address], rfl, rfl⟩ + | .checkEnv root _, some raw => do + let opening ← readTree? fuel root raw + return ⟨treeLeaves opening.tree, raw, rfl, opening, rfl⟩ + | _, _ => none + +def ownedReferences (signature : PrimitiveSignature Address) (refs : List (ConstRef Address)) : + List (ConstRef Address) := + (refs.filter fun ref => ref != signature.falseType && ref != signature.falseElim).eraseDups + +theorem mem_ownedReferences {signature : PrimitiveSignature Address} {refs : List (ConstRef Address)} + {ref : ConstRef Address} : ref ∈ ownedReferences signature refs ↔ + ref ∈ refs ∧ ref ≠ signature.falseType ∧ ref ≠ signature.falseElim := by + simp [ownedReferences] + +structure LeafWitness where + claim : Ix.Claim + subjects : Option ByteArray + frontierTree : Option ByteArray + frontier : List (FrontierWitness Address) + declarations : List (DeclarationWitness Address) + +structure PreparedLeaf (fuel : Nat) (objects : Objects) (witness : LeafWitness) where + subjectView : SubjectView fuel witness.claim witness.subjects + subjectRefs : List (ConstRef Address) + subjectsResolved : subjectView.addresses.flatMapM (subjectReferences? objects) = some subjectRefs + frontierView : OptionalTreeOpening fuel (claimFrontier witness.claim) witness.frontierTree + frontierRefs : List (ConstRef Address) + frontierResolved : frontierView.leaves.flatMapM (subjectReferences? objects) = some frontierRefs + frontierExact : ∀ ref, ref ∈ witness.frontier.map (·.ref) ↔ ref ∈ frontierRefs + +def prepareLeaf? (fuel : Nat) (objects : Objects) (witness : LeafWitness) : + Option (PreparedLeaf fuel objects witness) := do + let subjectView ← readSubjectView? fuel witness.claim witness.subjects + match hs : subjectView.addresses.flatMapM (subjectReferences? objects) with + | none => none + | some subjectRefs => do + let frontierView ← readOptionalTree? fuel (claimFrontier witness.claim) witness.frontierTree + match hf : frontierView.leaves.flatMapM (subjectReferences? objects) with + | none => none + | some frontierRefs => + if he : sameMembers (witness.frontier.map (·.ref)) frontierRefs = true then + some ⟨subjectView, subjectRefs, hs, frontierView, frontierRefs, hf, sameMembers_iff.mp he⟩ + else none + +def PreparedLeaf.node {fuel : Nat} {objects : Objects} {witness : LeafWitness} + (leaf : PreparedLeaf fuel objects witness) (signature : PrimitiveSignature Address) : ClaimNode Address := + ⟨ownedReferences signature leaf.subjectRefs, witness.frontier, witness.declarations⟩ + +structure LeafInput (fuel : Nat) (objects : Objects) where + witness : LeafWitness + prepared : PreparedLeaf fuel objects witness + +def readLeafInput? (fuel : Nat) (objects : Objects) (witness : LeafWitness) : + Option (LeafInput fuel objects) := do + let prepared ← prepareLeaf? fuel objects witness + return ⟨witness, prepared⟩ + +def leafAddresses {fuel : Nat} {objects : Objects} (leaves : List (LeafInput fuel objects)) : List Address := + leaves.flatMap (·.prepared.subjectView.addresses) + +def environmentRoot? : Ix.Claim → Option Address + | .checkEnv root _ => some root + | _ => none + +structure ContentView (fuel : Nat) (claim : Ix.Claim) (subjects members : Option ByteArray) + {objects : Objects} (leaves : List (LeafInput fuel objects)) where + addresses : List Address + exactLeaves : ∀ address, address ∈ addresses ↔ address ∈ leafAddresses leaves + meaning : match claim with + | .check address _ => subjects = none ∧ members = none ∧ addresses = [address] + | .checkEnv root _ => members = none ∧ ∃ raw, subjects = some raw ∧ + ∃ opening : TreeOpening fuel root raw, treeLeaves opening.tree = addresses + | .catalog memberRoot contentRoot _ => ∃ rawContent rawMembers, + subjects = some rawContent ∧ members = some rawMembers ∧ + ∃ content : TreeOpening fuel contentRoot rawContent, + ∃ membership : TreeOpening fuel memberRoot rawMembers, + treeLeaves content.tree = addresses ∧ + ∃ roots, leaves.mapM (fun leaf => environmentRoot? leaf.witness.claim) = some roots ∧ + ∀ root, root ∈ treeLeaves membership.tree ↔ root ∈ roots + | _ => False + +def readContentView? (fuel : Nat) (claim : Ix.Claim) (subjects members : Option ByteArray) + {objects : Objects} (leaves : List (LeafInput fuel objects)) : + Option (ContentView fuel claim subjects members leaves) := + match claim, subjects, members with + | .check address _, none, none => + if he : sameMembers [address] (leafAddresses leaves) = true then + some ⟨[address], sameMembers_iff.mp he, rfl, rfl, rfl⟩ + else none + | .checkEnv root _, some raw, none => do + let opening ← readTree? fuel root raw + if he : sameMembers (treeLeaves opening.tree) (leafAddresses leaves) = true then + some ⟨treeLeaves opening.tree, sameMembers_iff.mp he, rfl, raw, rfl, opening, rfl⟩ + else none + | .catalog memberRoot contentRoot _, some rawContent, some rawMembers => do + let content ← readTree? fuel contentRoot rawContent + let membership ← readTree? fuel memberRoot rawMembers + match hr : leaves.mapM (fun leaf => environmentRoot? leaf.witness.claim) with + | none => none + | some roots => + if he : sameMembers (treeLeaves content.tree) (leafAddresses leaves) = true then + if hm : sameMembers (treeLeaves membership.tree) roots = true then + some ⟨treeLeaves content.tree, sameMembers_iff.mp he, rawContent, rawMembers, rfl, rfl, + content, membership, rfl, roots, hr, sameMembers_iff.mp hm⟩ + else none + else none + | _, _, _ => none + +end Ix.Certified diff --git a/Ix/Certified/ClaimMain.lean b/Ix/Certified/ClaimMain.lean new file mode 100644 index 000000000..2028b1f52 --- /dev/null +++ b/Ix/Certified/ClaimMain.lean @@ -0,0 +1,8 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.ClaimCommand + +def main := Ix.Certified.ClaimCommand.main diff --git a/Ix/Certified/ClaimMeaning.lean b/Ix/Certified/ClaimMeaning.lean new file mode 100644 index 000000000..08158bd8f --- /dev/null +++ b/Ix/Certified/ClaimMeaning.lean @@ -0,0 +1,151 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.ClaimCheck + +namespace Ix.Certified + +open Ix.Theory Ix.Theory.Certified Ix.Theory.Model Ix.Theory.Model.SetTheory + +universe v +variable {source : Ixon.Env} {snapshot : SourceSnapshot source} + {fuel : Nat} {envelope : Envelope} {witness : LogicalWitness} + +theorem OptionalTreeOpening.none_leaves (opening : OptionalTreeOpening fuel none bytes) : + opening.leaves = [] := by + cases bytes with + | none => exact opening.evidence + | some => exact False.elim opening.evidence + +theorem OptionalTreeOpening.closed_leaves (opening : OptionalTreeOpening fuel root bytes) + (closed : root = none) : opening.leaves = [] := by + subst root + exact opening.none_leaves + +theorem LogicalChecking.target_entry + (checked : LogicalChecking.{v} snapshot fuel envelope witness) + {ref : ConstRef Address} (hr : ref ∈ checked.subjects) : + ∃ entry, checked.batch.receipt.checked.result.entries ref = some entry ∧ + EntrySource checked.signature checked.store ref entry := by + have validated := (checked.signature.validate_iff checked.store).mp checked.batch.receipt.frontier.validated + by_cases hF : ref = checked.signature.falseType + · subst ref + exact ⟨PrimitiveSignature.falseEntry, checked.batch.receipt.checked.result.present.1, + Or.inl ⟨rfl, rfl, validated.1⟩⟩ + · by_cases hE : ref = checked.signature.falseElim + · subst ref + exact ⟨checked.signature.falseElimEntry, checked.batch.receipt.checked.result.present.2, + Or.inr (Or.inl ⟨rfl, rfl, validated.2⟩)⟩ + · have owned := (checked.exactSubjects ref).mpr (mem_ownedReferences.mpr ⟨hr, hF, hE⟩) + have hp := checked.batch.receipt.present ref owned + obtain ⟨entry, he⟩ := Option.isSome_iff_exists.mp hp + refine ⟨entry, he, ?_⟩ + rcases checked.batch.receipt.checked.source ref entry he with old | new + · rw [checked.batch.receipt.fresh ref owned] at old + cases old + · exact new + +theorem LogicalChecking.original_subject + (checked : LogicalChecking.{v} snapshot fuel envelope witness) + {ref : ConstRef Address} (hr : ref ∈ checked.subjects) : + ∃ entry, checked.batch.receipt.checked.result.entries ref = some entry ∧ + SourceDeclarationReading source snapshot.decodedObjects snapshot.decodedNaturals ref entry := by + obtain ⟨entry, he, hs⟩ := checked.target_entry hr + exact ⟨entry, he, snapshot.declaration_reading checked.storeReading hs.header⟩ + +theorem LogicalChecking.original_frontier + (checked : LogicalChecking.{v} snapshot fuel envelope witness) + {ref : ConstRef Address} (hr : ref ∈ checked.frontierRefs) : + ∃ entry, checked.batch.receipt.frontier.interface.entries ref = some entry ∧ + SourceDeclarationReading source snapshot.decodedObjects snapshot.decodedNaturals ref entry := by + have hm := (checked.exactFrontier ref).mpr hr + obtain ⟨header, hh, rfl⟩ := List.mem_map.mp hm + exact ⟨header.entry, checked.batch.receipt.frontier.formed.lookup hh, + snapshot.declaration_reading checked.storeReading (checked.batch.receipt.frontier.header_source hh)⟩ + +/-- The claim's public axiom tree contains every use, including uses retained +from leaves. Each address resolves to an exactly realized source schema. -/ +theorem LogicalChecking.logical_policy + (checked : LogicalChecking.{v} snapshot fuel envelope witness) + {ref : ConstRef Address} (hr : ref ∈ checked.axiomRefs) : + ∃ entry, Standard.EntrySource checked.store ref entry ∨ Quotient.EntrySource checked.store ref entry := + checked.batch.logicalUses_authorized ((checked.exactAxioms ref).mpr hr) + +theorem LogicalChecking.closed_frontier + (checked : LogicalChecking.{v} snapshot fuel envelope witness) + (closed : claimFrontier envelope.claim = none) : checked.batch.receipt.frontier.refs = [] := by + have hl : checked.frontier.leaves = [] := by + exact checked.frontier.closed_leaves closed + have hr : checked.frontierRefs = [] := by + have h := checked.frontierReading + rw [hl] at h + simpa using h.symm + apply List.eq_nil_iff_forall_not_mem.mpr + intro ref hm + have h := (checked.exactFrontier ref).mp hm + rw [hr] at h + cases h + +/-- Conditional soundness of every original source member or constructor in +the exact committed subject set. All declared frontier values are preserved +at every universe instance while the shared interpretation is extended. -/ +theorem LogicalReceipt.subject_meaning + (receipt : LogicalReceipt.{v} source fuel envelope witness) + (V : Type v) [SetTheory V] (constants : Assignment Address V) + (hM : receipt.checked.signature.Compatible receipt.checked.batch.receipt.frontier.interface.entries constants) : + ∃ constants' : Assignment Address V, + receipt.checked.signature.Compatible receipt.checked.batch.receipt.checked.result.entries constants' ∧ + Assignment.AgreesOn receipt.checked.batch.receipt.frontier.interface.entries constants constants' ∧ + ∀ ref ∈ receipt.checked.subjects, ∃ entry, + SourceDeclarationReading source receipt.snapshot.decodedObjects receipt.snapshot.decodedNaturals ref entry ∧ + ∀ levels, levels.length = entry.universes → ∀ env, + WellDenoted constants' levels env entry.type ∧ + constants' ref levels ∈ˢ interp constants' levels env entry.type := by + obtain ⟨constants', hm, ha⟩ := receipt.checked.batch.receipt.checked.extension.models V constants hM + refine ⟨constants', hm, ha, ?_⟩ + intro ref hr + obtain ⟨entry, he, hs⟩ := receipt.checked.original_subject hr + refine ⟨entry, hs, ?_⟩ + intro levels hl env + exact ⟨hm.realizes.typeValid ref entry he levels hl env, + hm.realizes.member ref entry he levels hl env⟩ + +/-- A public claim with no structural frontier constructs its model. This +does not assert that its separately recorded logical-axiom set is empty. -/ +theorem LogicalReceipt.closed_subject_meaning + (receipt : LogicalReceipt.{v} source fuel envelope witness) + (closed : claimFrontier envelope.claim = none) (V : Type v) [SetTheory V] : + ∃ constants : Assignment Address V, + receipt.checked.signature.Compatible receipt.checked.batch.receipt.checked.result.entries constants ∧ + ∀ ref ∈ receipt.checked.subjects, ∃ entry, + SourceDeclarationReading source receipt.snapshot.decodedObjects receipt.snapshot.decodedNaturals ref entry ∧ + ∀ levels, levels.length = entry.universes → ∀ env, + WellDenoted constants levels env entry.type ∧ + constants ref levels ∈ˢ interp constants levels env entry.type := by + have hf := receipt.checked.closed_frontier closed + have initial : receipt.checked.signature.Compatible receipt.checked.batch.receipt.frontier.interface.entries + (receipt.checked.signature.assignment (V := V)) := by + rw [receipt.checked.batch.receipt.frontier.empty_interface hf] + exact receipt.checked.signature.compatible_assignment + obtain ⟨constants, hm, _, subjects⟩ := receipt.subject_meaning V receipt.checked.signature.assignment initial + exact ⟨constants, hm, subjects⟩ + +theorem LogicalReceipt.no_False + (receipt : LogicalReceipt.{v} source fuel envelope witness) + (closed : claimFrontier envelope.claim = none) {ref : ConstRef Address} + (subject : ref ∈ receipt.checked.subjects) + (type : receipt.checked.store.type ref = some receipt.checked.signature.falseExpr) + (V : Type v) [SetTheory V] : False := by + have hf := receipt.checked.closed_frontier closed + obtain ⟨constants, hm, _⟩ := receipt.checked.batch.closed_has_model hf V + obtain ⟨entry, he, hs⟩ := receipt.checked.target_entry subject + have hc : entry.type = .const receipt.checked.signature.falseType [] := + AExpr.eq_const_of_erase_eq (Option.some.inj (hs.header.type.symm.trans type)) + have hmem := hm.realizes.member ref entry he (List.replicate entry.universes 0) (by simp) (fun _ => empty) + rw [hc] at hmem + simp only [interp, List.map_nil, hm.falseValue] at hmem + exact not_mem_empty _ hmem + +end Ix.Certified diff --git a/Ix/Certified/ClaimSuggest.lean b/Ix/Certified/ClaimSuggest.lean new file mode 100644 index 000000000..4052efd7c --- /dev/null +++ b/Ix/Certified/ClaimSuggest.lean @@ -0,0 +1,75 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Theory.Certificate.Claims +import Ix.Certified.ClaimAccept +import Ix.Certified.ModelHints + +/-! Untrusted witness construction. The acceptance path imports none of +these search functions and checks the public envelope and complete returned +witness again. Trees are hints whose public Merkle roots are checked. -/ + +namespace Ix.Certified + +open Ix.Theory Ix.Theory.Certified Ix.Theory.Model + +structure LeafHint where + claim : Ix.Claim + subjects : Option ByteArray + frontierTree : Option ByteArray + +structure LogicalHint where + selection : InputSelection + leaves : List LeafHint + subjects : Option ByteArray + members : Option ByteArray + frontierTree : Option ByteArray + axiomTree : Option ByteArray + models : List ModelHint := [] + +/-- Header dependency order is independent of the Merkle tree's leaf order. -/ +def frontierOrder? (fuel : Nat) (signature : PrimitiveSignature Address) (store : Store Address) + (allowed pending visited active : List (ConstRef Address)) : Option (List (ConstRef Address)) := + match fuel, pending with + | _, [] => some visited + | 0, _ :: _ => none + | fuel + 1, ref :: rest => + if ref = signature.falseType ∨ ref = signature.falseElim ∨ ref ∈ visited then + frontierOrder? fuel signature store allowed rest visited active + else if ref ∈ active ∨ ref ∉ allowed then none + else do + let type ← store.type ref + let visited ← frontierOrder? fuel signature store allowed type.refs visited (ref :: active) + frontierOrder? fuel signature store allowed rest (visited ++ [ref]) active + +def frontierSuggestion? (fuel : Nat) (signature : PrimitiveSignature Address) (store : Store Address) + (objects : Objects) (root : Option Address) (bytes : Option ByteArray) : + Option (List (ConstRef Address) × List (FrontierWitness Address)) := do + let opening ← readOptionalTree? fuel root bytes + let refs ← opening.leaves.flatMapM (subjectReferences? objects) + let ordered ← frontierOrder? fuel signature store refs refs [] [] + let (_, witnesses) ← Certificate.frontierWitnesses? fuel store signature.environment ordered + return (ordered, witnesses) + +def leafSuggestion? (fuel : Nat) (signature : PrimitiveSignature Address) (store : Store Address) + (objects : Objects) (hint : LeafHint) (models : List (Certificate.Modeled.Candidate Address) := []) : Option LeafWitness := do + let subjects ← readSubjectView? fuel hint.claim hint.subjects + let refs ← subjects.addresses.flatMapM (subjectReferences? objects) + let (frontier, _) ← frontierSuggestion? fuel signature store objects (claimFrontier hint.claim) hint.frontierTree + let node ← Certificate.claimNode? fuel signature store frontier (ownedReferences signature refs) models + return ⟨hint.claim, hint.subjects, hint.frontierTree, node.frontier, node.declarations⟩ + +def suggestLogical? (fuel : Nat) (source : Ixon.Env) (envelope : Envelope) (hint : LogicalHint) : + Option LogicalWitness := do + let (snapshot, _) ← readSnapshot? fuel source hint.selection {} + let signature ← readSignature? envelope.profile snapshot.decodedObjects + let store ← readStore? fuel snapshot.decodedObjects snapshot.decodedNaturals + let models ← modelCandidates? snapshot.decodedObjects store hint.models + let leaves ← hint.leaves.mapM (fun leaf => leafSuggestion? fuel signature store snapshot.decodedObjects leaf models) + let (_, frontier) ← frontierSuggestion? fuel signature store snapshot.decodedObjects + (claimFrontier envelope.claim) hint.frontierTree + return ⟨hint.selection, leaves, hint.subjects, hint.members, hint.frontierTree, frontier, hint.axiomTree⟩ + +end Ix.Certified diff --git a/Ix/Certified/Command.lean b/Ix/Certified/Command.lean new file mode 100644 index 000000000..0ad2ba24c --- /dev/null +++ b/Ix/Certified/Command.lean @@ -0,0 +1,96 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.Suggest +import Ix.Kernel.Certified + +/-! Generic source-file driver for the certified profile. The JSON request +selects the expected target/subjects, primitive signature and finite source +closure. Witness search is untrusted and always followed by certified TcM +validation. There is no inference-only or unchecked fallback command. -/ + +namespace Ix.Certified.Command + +universe v + +structure Request where + profile : Profile + target : Address + subjects : List Address + selection : InputSelection + models : List ModelHint := [] + +def readAddress (value : String) : Except String Address := + match Address.fromString value with + | none => .error "expected a 32-byte hexadecimal address" + | some address => .ok address + +def readRequest (json : Lean.Json) : Except String Request := do + let falseType ← readAddress (← json.getObjValAs? String "falseType") + let falseElim ← readAddress (← json.getObjValAs? String "falseElim") + let natural ← json.getObjValAs? (Option String) "natType" + let natType ← natural.mapM readAddress + let target ← readAddress (← json.getObjValAs? String "target") + let subjects ← (← json.getObjValAs? (List String) "subjects").mapM readAddress + let objects ← (← json.getObjValAs? (List String) "objects").mapM readAddress + let naturals ← (← json.getObjValAs? (List String) "naturals").mapM readAddress + return ⟨⟨falseType, falseElim, natType⟩, target, subjects, ⟨objects, naturals⟩, ← ModelHint.readOptional json⟩ + +def run (mode : String) (fuel : Nat) (source : Ixon.Env) (request : Request) : Except String Unit := do + if mode = "proof" then + let some witness := suggestSource? fuel source request.profile request.target request.selection request.models + | throw "certified proof witness search declined" + if Kernel.acceptsCertifiedSource.{v} fuel source request.profile request.target request.selection witness then + return () + else throw "certified proof validation rejected the witness" + else if mode = "store" then + let some witness := suggestStore? fuel source request.profile request.subjects request.selection request.models + | throw "certified declaration witness search declined" + if Kernel.acceptsCertifiedStoreSource.{v} fuel source request.profile request.subjects request.selection witness then + return () + else throw "certified declaration validation rejected the witness" + else throw "mode must be proof or store" + +/-- The generic command can report success only after an actual certified +source run. Witness search is not an alternate acceptance path. -/ +theorem run_success {mode : String} {fuel : Nat} {source : Ixon.Env} {request : Request} + (h : run.{v} mode fuel source request = .ok ()) : + (mode = "proof" ∧ ∃ witness, Kernel.acceptsCertifiedSource.{v} fuel source + request.profile request.target request.selection witness = true) ∨ + (mode = "store" ∧ ∃ witness, Kernel.acceptsCertifiedStoreSource.{v} fuel source + request.profile request.subjects request.selection witness = true) := by + by_cases hp : mode = "proof" + · cases hw : suggestSource? fuel source request.profile request.target request.selection request.models with + | none => simp [run, hp, hw] at h + | some witness => + by_cases ha : Kernel.acceptsCertifiedSource.{v} fuel source request.profile request.target request.selection witness = true + · exact .inl ⟨hp, witness, ha⟩ + · simp [run, hp, hw, ha] at h + · by_cases hs : mode = "store" + · cases hw : suggestStore? fuel source request.profile request.subjects request.selection request.models with + | none => simp [run, hs, hw] at h + | some witness => + by_cases ha : Kernel.acceptsCertifiedStoreSource.{v} fuel source request.profile request.subjects request.selection witness = true + · exact .inr ⟨hs, witness, ha⟩ + · simp [run, hs, hw, ha] at h + · simp [run, hp, hs] at h + +def main (args : List String) : IO UInt32 := do + let [mode, sourcePath, requestPath] := args | do + IO.eprintln "usage: certified-check proof|store SOURCE.ixe REQUEST.json" + return 2 + let bytes ← IO.FS.readBinFile sourcePath + let requestText ← IO.FS.readFile requestPath + let result := do + let request ← readRequest (← Lean.Json.parse requestText) + let parts ← Ixon.deEnvVerifiedLazy bytes + run.{0} mode 6400 parts.env request + match result with + | .error error => IO.eprintln error; return 1 + | .ok () => + IO.println <| (Lean.Json.mkObj [("accepted", Lean.toJson true), ("mode", Lean.toJson mode)]).compress + return 0 + +end Ix.Certified.Command diff --git a/Ix/Certified/Corpus.lean b/Ix/Certified/Corpus.lean new file mode 100644 index 000000000..688c899db --- /dev/null +++ b/Ix/Certified/Corpus.lean @@ -0,0 +1,123 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.Fixtures + +namespace Ix.Certified.Corpus + +open Fixtures + +def idType (level : UInt64) : Ixon.Expr := + .leanAll (.sort level) (.leanAll (.var 0) (.var 1)) + +def idBody (level : UInt64) : Ixon.Expr := + .leanLam (.sort level) (.leanLam (.var 0) (.var 0)) + +def polyId (kind : Ix.DefKind) : Ixon.Constant := { + info := .defn { + kind, safety := .safe, lvls := 1, typ := idType 0, value := idBody 0 } + sharing := #[], refs := #[], univs := #[.var 0] +} + +def polyUse (kind : Ix.DefKind) (large : Bool) : Ixon.Constant := { + info := .defn { + kind := .thm, safety := .safe, lvls := 0, typ := idType 0, + value := if large then + .app (.leanLam (idType 1) (idBody 0)) (.ref 0 #[1]) + else .ref 0 #[0] } + sharing := #[], refs := #[(encode (polyId kind)).1], + univs := #[.zero, .succ .zero] +} + +def dependent (n : UInt64) (u : Ixon.Univ) : Ixon.Constant := { + info := .defn { + kind := .thm, safety := .safe, lvls := n, + typ := .leanAll (.sort 0) + (.leanAll (.leanAll (.var 0) (.sort 1)) + (.leanAll (.leanAll (.var 1) (.app (.var 1) (.var 0))) + (.leanAll (.var 2) (.app (.var 2) (.var 0))))), + value := .leanLam (.sort 0) + (.leanLam (.leanAll (.var 0) (.sort 1)) + (.leanLam (.leanAll (.var 1) (.app (.var 1) (.var 0))) + (.leanLam (.var 2) (.app (.var 1) (.var 0))))) } + sharing := #[], refs := #[], univs := #[u, .zero] +} + +-- The declared proposition contains a beta redex. The body is checked +-- against that original proposition through a beta conversion certificate. +def betaStatement : Ixon.Constant := { + info := .defn { + kind := .thm, safety := .safe, lvls := 0, + typ := .app (.leanLam (.sort 0) (.var 0)) (idType 0), + value := idBody 0 } + sharing := #[], refs := #[], univs := #[.zero] +} + +-- ∀ A : Prop, ∀ F : (A → A) → Prop, ∀ f, F f → F (fun x => f x). +-- The supplied proof returns its last argument, so admission needs eta +-- beneath a dependent application and a telescope of products. +def etaStatement : Ixon.Constant := { + info := .defn { + kind := .thm, safety := .safe, lvls := 0, + typ := .leanAll (.sort 0) + (.leanAll (.leanAll (.leanAll (.var 0) (.var 1)) (.sort 0)) + (.leanAll (.leanAll (.var 1) (.var 2)) + (.leanAll (.app (.var 1) (.var 0)) + (.app (.var 2) (.leanLam (.var 3) (.app (.var 2) (.var 0))))))), + value := .leanLam (.sort 0) + (.leanLam (.leanAll (.leanAll (.var 0) (.var 1)) (.sort 0)) + (.leanLam (.leanAll (.var 1) (.var 2)) + (.leanLam (.app (.var 1) (.var 0)) (.var 0)))) } + sharing := #[], refs := #[], univs := #[.zero] +} + +def eliminatorStatement : Ixon.Constant := { + info := .defn { + kind := .thm, safety := .safe, lvls := 0, + typ := .leanAll (.leanAll (.ref 0 #[]) (.sort 0)) + (.leanAll (.ref 0 #[]) (.app (.var 1) (.var 0))), + value := .ref 1 #[0] } + sharing := #[], refs := #[falseObject.1, falseElimObject.1], univs := #[.zero] +} + +structure Case where + name : String + target : Address + blobs : ConstantBlobs + +def one (name : String) (source : Ixon.Constant) + (dependencies : List Ixon.Constant := []) : Case := + let object := encode source + ⟨name, object.1, prelude ++ dependencies.map encode ++ [object]⟩ + +def positive : List Case := [ + one "identity" identity, + one "dependent-polymorphic" (dependent 1 (.var 0)), + one "dependent-Prop" (dependent 0 .zero), + one "dependent-Type" (dependent 0 (.succ .zero)), + one "dependent-Type1" (dependent 0 (.succ (.succ .zero))), + one "definition-at-Prop" (polyUse .defn false) [polyId .defn], + one "definition-at-Type" (polyUse .defn true) [polyId .defn], + one "theorem-at-Prop" (polyUse .thm false) [polyId .thm], + one "opaque-at-Type" (polyUse .opaq true) [polyId .opaq], + one "beta-statement" betaStatement, + one "eta-statement" etaStatement, + one "False-eliminator" eliminatorStatement +] + +#guard positive.all fun c => accepted c.blobs c.target + +/-- Syntactic exclusions measured separately from failed witness generation. +The selected profile never enables literals or linear binder flags. -/ +def declined : List Case := [ + one "linear-binder-profile" linearIdentity, + one "literal-profile" { identity with info := .defn { + kind := .thm, safety := .safe, lvls := 0, + typ := idType 0, value := .nat 0 } } +] + +#guard declined.all fun c => (prepare? 300 profile c.target c.blobs).isNone + +end Ix.Certified.Corpus diff --git a/Ix/Certified/Envelope.lean b/Ix/Certified/Envelope.lean new file mode 100644 index 000000000..c88cb93e9 --- /dev/null +++ b/Ix/Certified/Envelope.lean @@ -0,0 +1,92 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.Trees +import Ix.Claim + +/-! Versioned public claims for the certified source checker. This envelope +binds the original Ix claim, primitive addresses, modeled logical policy and +axiom-use root. The thin-frontier convention is distinct from the legacy +whole-environment convention. A backend still has to bind its actual program +and permitted keys to this source program version. -/ + +namespace Ix.Certified + +structure Protocol where + format : UInt64 := 1 + codec : UInt64 := 1 + checker : UInt64 := 1 + policy : UInt64 := 1 + aggregation : UInt64 := 1 + deriving DecidableEq + +/-- Checker version 2 includes checked model companions for mutual and +nested declarations. Older checker identities do not select this program. -/ +def Protocol.current : Protocol := { checker := 2 } + +structure Envelope where + protocol : Protocol + profile : Profile + claim : Ix.Claim + logicalAxioms : Option Address + +def envelopeMagic : ByteArray := "IX-CERTIFIED-CLAIM".toUTF8 ++ ⟨#[0]⟩ + +def putEnvelope (envelope : Envelope) : Ixon.PutM Unit := do + Ixon.putBytes envelopeMagic + Ixon.putTag0 ⟨envelope.protocol.format⟩ + Ixon.putTag0 ⟨envelope.protocol.codec⟩ + Ixon.putTag0 ⟨envelope.protocol.checker⟩ + Ixon.putTag0 ⟨envelope.protocol.policy⟩ + Ixon.putTag0 ⟨envelope.protocol.aggregation⟩ + Ixon.Serialize.put envelope.profile.falseType + Ixon.Serialize.put envelope.profile.falseElim + Ix.Claim.putOptAddr envelope.profile.natType + Ix.Claim.put envelope.claim + Ix.Claim.putOptAddr envelope.logicalAxioms + +def envelopeBytes (envelope : Envelope) : ByteArray := Ixon.runPut (putEnvelope envelope) + +def getEnvelope : Ixon.GetM Envelope := do + if (← Ixon.getBytes envelopeMagic.size) != envelopeMagic then throw "invalid certified claim magic" + let format := (← Ixon.getTag0).size + let codec := (← Ixon.getTag0).size + let checker := (← Ixon.getTag0).size + let policy := (← Ixon.getTag0).size + let aggregation := (← Ixon.getTag0).size + let falseType ← Ixon.Serialize.get + let falseElim ← Ixon.Serialize.get + let natType ← Ix.Claim.getOptAddr + let claim ← Ix.Claim.get + let logicalAxioms ← Ix.Claim.getOptAddr + return ⟨⟨format, codec, checker, policy, aggregation⟩, ⟨falseType, falseElim, natType⟩, claim, logicalAxioms⟩ + +structure EnvelopeReading (address : Address) (bytes : ByteArray) where + envelope : Envelope + addressSize : address.hash.size = 32 + authenticated : Address.blake3 bytes = address + parsing : Ixon.runGetExact getEnvelope bytes = .ok envelope + canonical : envelopeBytes envelope = bytes + supported : envelope.protocol = Protocol.current + +def readEnvelope? (fuel : Nat) (address : Address) (bytes : ByteArray) : + Option (EnvelopeReading address bytes) := + if bytes.size > fuel then none else + if ha : address.hash.size = 32 ∧ Address.blake3 bytes = address then + match hp : Ixon.runGetExact getEnvelope bytes with + | .error _ => none + | .ok envelope => + if hc : envelopeBytes envelope = bytes then + if hs : envelope.protocol = Protocol.current then some ⟨envelope, ha.1, ha.2, hp, hc, hs⟩ + else none + else none + else none + +/-- Exact parsing fixes the complete public claim and profile. Semantic or +expression equality is never used to recover the authenticated bytes. -/ +theorem EnvelopeReading.unique {a b : EnvelopeReading address bytes} : a.envelope = b.envelope := + Except.ok.inj (a.parsing.symm.trans b.parsing) + +end Ix.Certified diff --git a/Ix/Certified/Fixtures.lean b/Ix/Certified/Fixtures.lean new file mode 100644 index 000000000..e7306ffd3 --- /dev/null +++ b/Ix/Certified/Fixtures.lean @@ -0,0 +1,141 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.Bytes +import Ix.Theory.Certificate.Build + +namespace Ix.Certified.Fixtures + +open Ix.Theory Ix.Theory.Certified + +def encode (source : Ixon.Constant) : Address × ByteArray := + let bytes := Ixon.serConstant source + (Address.blake3 bytes, bytes) + +def falseBlock : Ixon.Constant := { + info := .muts #[.indc { + isUnsafe := false, lvls := 0, params := 0, indices := 0, + typ := .sort 0, ctors := #[] + }] + sharing := #[] + refs := #[] + univs := #[.zero] +} + +def falseBlockObject := encode falseBlock + +def falseProjection : Ixon.Constant := + ⟨.iPrj ⟨0, falseBlockObject.1⟩, #[], #[], #[]⟩ + +def falseObject := encode falseProjection + +def falseElim : Ixon.Constant := { + info := .recr { + k := false, isUnsafe := false, lvls := 1, params := 0, indices := 0, + motives := 1, minors := 0, + typ := .leanAll (.leanAll (.ref 0 #[]) (.sort 0)) + (.leanAll (.ref 0 #[]) (.app (.var 1) (.var 0))), + rules := #[] + } + sharing := #[] + refs := #[falseObject.1] + univs := #[.var 0] +} + +def falseElimObject := encode falseElim + +def profile : Profile := ⟨falseObject.1, falseElimObject.1, none⟩ +def prelude : ConstantBlobs := [falseBlockObject, falseObject, falseElimObject] + +def identity : Ixon.Constant := { + info := .defn { + kind := .thm, safety := .safe, lvls := 0, + typ := .leanAll (.sort 0) (.leanAll (.var 0) (.var 1)), + value := .leanLam (.sort 0) (.leanLam (.var 0) (.var 0)) + } + sharing := #[] + refs := #[] + univs := #[.zero] +} + +def identityObject := encode identity +def identityBlobs : ConstantBlobs := prelude ++ [identityObject] + +def witness? (blobs : ConstantBlobs) (target : Address) : Option (ProofWitness Address) := do + let prepared ← prepare? 300 profile target blobs + Ix.Theory.Certificate.proofWitness? 300 prepared.signature prepared.input + +def accepted (blobs : ConstantBlobs) (target : Address) : Bool := + (witness? blobs target).any (acceptsSerialized.{0} 300 profile target blobs) + +#guard accepted identityBlobs identityObject.1 + +-- A new valid hash cannot license trailing data outside the constant grammar. +def trailingIdentity : Address × ByteArray := + let bytes := identityObject.2.push 0 + (Address.blake3 bytes, bytes) +#guard (prepare? 300 profile trailingIdentity.1 (prelude ++ [trailingIdentity])).isNone + +-- Changed bytes under an old address fail authentication. +#guard (prepare? 300 profile identityObject.1 + (prelude ++ [(identityObject.1, identityObject.2.push 0)])).isNone + +-- Duplicate object addresses are not silently overwritten. +#guard (prepare? 300 profile identityObject.1 (identityBlobs ++ [identityObject])).isNone + +def linearIdentity : Ixon.Constant := + { identity with info := .defn { + kind := .thm, safety := .safe, lvls := 0, + typ := .leanAll (.sort 0) (.leanAll (.var 0) (.var 1)), + value := .lam .linear (.sort 0) (.leanLam (.var 0) (.var 0)) + } } + +def linearIdentityObject := encode linearIdentity +#guard (prepare? 300 profile linearIdentityObject.1 + (prelude ++ [linearIdentityObject])).isNone + +def wrongTable : Ixon.Constant := { identity with univs := #[] } +def wrongTableObject := encode wrongTable +#guard (prepare? 300 profile wrongTableObject.1 (prelude ++ [wrongTableObject])).isNone + +def cyclicSharing : Ixon.Constant := { + identity with + info := .defn { + kind := .thm, safety := .safe, lvls := 0, + typ := .leanAll (.sort 0) (.leanAll (.var 0) (.var 1)), value := .share 0 } + sharing := #[.share 0] +} +def cyclicSharingObject := encode cyclicSharing +#guard (prepare? 30 profile cyclicSharingObject.1 (prelude ++ [cyclicSharingObject])).isNone + +def axiomIdentity : Ixon.Constant := { + identity with + info := .axio { + isUnsafe := false, lvls := 0, + typ := .leanAll (.sort 0) (.leanAll (.var 0) (.var 1)) } +} +def axiomIdentityObject := encode axiomIdentity + +-- Force an untrusted proof witness through the actual acceptance gate. This +-- is a policy rejection, not merely a failure of the suggestion producer. +def axiomRejected : Bool := + match witness? identityBlobs identityObject.1 with + | none => false + | some witness => + let forged := { witness with declarations := witness.declarations.map fun declaration => + match declaration with + | .definition definition => .definition { definition with ref := .member axiomIdentityObject.1 0 } + | .ordinary block => .ordinary block + | .standard witness => .standard witness + | .quotient witness => .quotient witness + | .structure witness => .structure witness + | .natural witness => .natural witness + | .modeled witness => .modeled witness } + !acceptsSerialized.{0} 300 profile axiomIdentityObject.1 + (prelude ++ [axiomIdentityObject]) forged + +#guard axiomRejected + +end Ix.Certified.Fixtures diff --git a/Ix/Certified/Ingress.lean b/Ix/Certified/Ingress.lean new file mode 100644 index 000000000..8e799407f --- /dev/null +++ b/Ix/Certified/Ingress.lean @@ -0,0 +1,315 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.Store + +/-! Certified lazy reads from the actual Ixon environment. Only selected +addresses are visited. Materialized source caches and kernel judgment caches +cannot replace authenticated bytes. The reusable cache stores decoded data; +each hit also compares the exact current source bytes. -/ + +namespace Ix.Certified + +open Ix.Theory Ix.Theory.Certified Ix.Theory.Model Ix.Theory.Model.SetTheory + +universe v + +/-- A constant window must be wholly inside its backing buffer. The cached +materialization in `LazyConstant` is intentionally not an input to this read. -/ +def constantBytes? (source : Ixon.Env) (address : Address) : Option ByteArray := do + let entry ← source.consts.get? address + if entry.off ≤ entry.buf.size ∧ entry.len ≤ entry.buf.size - entry.off then + some entry.rawBytes + else none + +abbrev DecodedNatural (address : Address) (bytes : ByteArray) := + { value : Nat // + address.hash.size = 32 ∧ Address.blake3 bytes = address ∧ + Nat.fromBytesLE bytes.data = value ∧ ByteArray.mk value.toBytesLE = bytes } + +theorem decodeObject_complete {address : Address} {bytes : ByteArray} + (value : DecodedObject address bytes) : decodeObject? address bytes = some value := by + rcases value with ⟨value, hs, hh, hp, hc⟩ + unfold decodeObject? + split + · rename_i auth + have he : canonicalObject? address bytes auth (Ixon.runGetExact Ixon.getConstant bytes) rfl = + canonicalObject? address bytes auth (.ok value) hp := by congr 1 + rw [he] + simp [canonicalObject?, hc] + · rename_i h + exact False.elim (h ⟨hs, hh⟩) + +theorem decodeNatural_complete {address : Address} {bytes : ByteArray} + (value : DecodedNatural address bytes) : decodeNatural? address bytes = some value := by + rcases value with ⟨value, hs, hh, hp, hc⟩ + simp [decodeNatural?, hs, hh, hp, hc] + +structure CachedObject where + address : Address + bytes : ByteArray + decoded : DecodedObject address bytes + +structure CachedNatural where + address : Address + bytes : ByteArray + decoded : DecodedNatural address bytes + +/-- The public driver starts with this empty cache. Entries contain only +canonical, authenticated data; no typing, conversion or admission verdicts. -/ +structure InputCache where + objects : List CachedObject := [] + naturals : List CachedNatural := [] + hits : Nat := 0 + misses : Nat := 0 + +namespace InputCache + +def object? (address : Address) (bytes : ByteArray) : + List CachedObject → Option (DecodedObject address bytes) + | [] => none + | entry :: rest => + if ha : entry.address = address then + if hb : entry.bytes = bytes then some (by simpa only [← ha, ← hb] using entry.decoded) + else object? address bytes rest + else object? address bytes rest + +def natural? (address : Address) (bytes : ByteArray) : + List CachedNatural → Option (DecodedNatural address bytes) + | [] => none + | entry :: rest => + if ha : entry.address = address then + if hb : entry.bytes = bytes then some (by simpa only [← ha, ← hb] using entry.decoded) + else natural? address bytes rest + else natural? address bytes rest + +end InputCache + +structure SourceObject (source : Ixon.Env) extends CachedObject where + fromSource : constantBytes? source address = some bytes + +structure SourceNatural (source : Ixon.Env) extends CachedNatural where + fromSource : source.getBlob? address = some bytes + +abbrev Read (_source : Ixon.Env) := StateT InputCache Option + +def readObject? (source : Ixon.Env) (address : Address) : Read source (SourceObject source) := fun cache => + match hs : constantBytes? source address with + | none => none + | some bytes => + match InputCache.object? address bytes cache.objects with + | some decoded => some (⟨⟨address, bytes, decoded⟩, hs⟩, { cache with hits := cache.hits + 1 }) + | none => do + let decoded ← decodeObject? address bytes + let entry : CachedObject := ⟨address, bytes, decoded⟩ + return (⟨entry, hs⟩, { cache with objects := entry :: cache.objects, misses := cache.misses + 1 }) + +def readNatural? (source : Ixon.Env) (address : Address) : Read source (SourceNatural source) := fun cache => + match hs : source.getBlob? address with + | none => none + | some bytes => + match InputCache.natural? address bytes cache.naturals with + | some decoded => some (⟨⟨address, bytes, decoded⟩, hs⟩, { cache with hits := cache.hits + 1 }) + | none => do + let decoded ← decodeNatural? address bytes + let entry : CachedNatural := ⟨address, bytes, decoded⟩ + return (⟨entry, hs⟩, { cache with naturals := entry :: cache.naturals, misses := cache.misses + 1 }) + +/-- An untrusted finite selection of source addresses. It must include all +source groups and raw blobs required by the independently checked witness. -/ +structure InputSelection where + objects : List Address + naturals : List Address := [] + +structure SourceSnapshot (source : Ixon.Env) where + objects : List (SourceObject source) + naturals : List (SourceNatural source) + +namespace SourceSnapshot + +def blobs (snapshot : SourceSnapshot source) : ConstantBlobs := + snapshot.objects.map fun entry => (entry.address, entry.bytes) + +def literalBlobs (snapshot : SourceSnapshot source) : ConstantBlobs := + snapshot.naturals.map fun entry => (entry.address, entry.bytes) + +def decodedObjects (snapshot : SourceSnapshot source) : Objects := + snapshot.objects.map fun entry => (entry.address, entry.decoded.val) + +def decodedNaturals (snapshot : SourceSnapshot source) : Naturals := + snapshot.naturals.map fun entry => (entry.address, entry.decoded.val) + +theorem objects_decode (snapshot : SourceSnapshot source) : + decodeObjects? snapshot.blobs = some snapshot.decodedObjects := by + rcases snapshot with ⟨objects, naturals⟩ + simp only [blobs, decodedObjects, decodeObjects?] + induction objects with + | nil => rfl + | cons entry rest ih => + dsimp only [bind, pure] at ih + simp only [List.map_cons, List.mapM_cons, decodeObject_complete entry.decoded, + bind, Option.bind_some, ih, pure] + +theorem naturals_decode (snapshot : SourceSnapshot source) : + decodeNaturals? snapshot.literalBlobs = some snapshot.decodedNaturals := by + rcases snapshot with ⟨objects, naturals⟩ + simp only [literalBlobs, decodedNaturals, decodeNaturals?] + induction naturals with + | nil => rfl + | cons entry rest ih => + dsimp only [bind, pure] at ih + simp only [List.map_cons, List.mapM_cons, decodeNatural_complete entry.decoded, + bind, Option.bind_some, ih, pure] + +/-- Reusing decoded data saves hashing/parsing. Scope, source metadata, +primitive selection, dependency order and semantic validation still run. -/ +def prepare? (fuel : Nat) (profile : Profile) (target : Address) + (snapshot : SourceSnapshot source) : Option PreparedInput := do + if !((snapshot.blobs ++ snapshot.literalBlobs).map Prod.fst).Nodup then none else do + let signature ← readSignature? profile snapshot.decodedObjects + let input ← readProofInput? fuel snapshot.decodedObjects target snapshot.decodedNaturals + return ⟨signature, input⟩ + +theorem prepare_eq (fuel : Nat) (profile : Profile) (target : Address) + (snapshot : SourceSnapshot source) : + Ix.Certified.prepare? fuel profile target snapshot.blobs snapshot.literalBlobs = + snapshot.prepare? fuel profile target := by + simp only [Ix.Certified.prepare?, prepare?, snapshot.objects_decode, snapshot.naturals_decode, + bind, Option.bind_some] + +/-- Each byte string consumed by the cached checker comes from the current +source environment, even when that address occurred in an earlier request. -/ +theorem objects_from_source (snapshot : SourceSnapshot source) {address : Address} {bytes : ByteArray} + (h : (address, bytes) ∈ snapshot.blobs) : constantBytes? source address = some bytes := by + obtain ⟨entry, _, he⟩ := List.mem_map.mp h + cases he + exact entry.fromSource + +theorem naturals_from_source (snapshot : SourceSnapshot source) {address : Address} {bytes : ByteArray} + (h : (address, bytes) ∈ snapshot.literalBlobs) : source.getBlob? address = some bytes := by + obtain ⟨entry, _, he⟩ := List.mem_map.mp h + cases he + exact entry.fromSource + +end SourceSnapshot + +/-- Failure returns no partially loaded snapshot or semantic verdict. -/ +def readSnapshot? (fuel : Nat) (source : Ixon.Env) (selection : InputSelection) : + Read source (SourceSnapshot source) := do + if selection.objects.length + selection.naturals.length > fuel then failure else do + let objects ← selection.objects.mapM (readObject? source) + let naturals ← selection.naturals.mapM (readNatural? source) + return ⟨objects, naturals⟩ + +/-- A receipt is produced only after complete checking against the snapshot. +All semantic fields are computed by the validator; they are not input data. -/ +structure SourceReceipt (source : Ixon.Env) (fuel : Nat) (profile : Profile) (target : Address) + (witness : ProofWitness Address) where + snapshot : SourceSnapshot source + prepared : PreparedInput + preparation : snapshot.prepare? fuel profile target = some prepared + proof : CheckedProof.{0,v} prepared.signature prepared.input + checked : checkProofCertified fuel prepared.signature prepared.input witness = some proof + +def checkSource? (fuel : Nat) (source : Ixon.Env) (profile : Profile) (target : Address) + (selection : InputSelection) (witness : ProofWitness Address) : + Read source (SourceReceipt.{v} source fuel profile target witness) := do + let snapshot ← readSnapshot? fuel source selection + match hp : snapshot.prepare? fuel profile target with + | none => failure + | some prepared => + match hc : checkProofCertified fuel prepared.signature prepared.input witness with + | none => failure + | some proof => return ⟨snapshot, prepared, hp, proof, hc⟩ + +namespace SourceReceipt + +theorem serialized (receipt : SourceReceipt.{v} source fuel profile target witness) : + acceptsSerialized.{v} fuel profile target receipt.snapshot.blobs witness receipt.snapshot.literalBlobs = true := by + have hp := receipt.snapshot.prepare_eq fuel profile target + rw [receipt.preparation] at hp + simp only [acceptsSerialized, hp, acceptsCertified, receipt.checked, Option.isSome_some] + +theorem has_model (receipt : SourceReceipt.{v} source fuel profile target witness) + (V : Type v) [SetTheory V] (levels : List Nat) (env : Nat → V) : + ∃ constants : Assignment Address V, + receipt.prepared.signature.Compatible receipt.proof.environment.entries constants ∧ + WellDenoted constants levels env receipt.proof.proof.val ∧ + WellDenoted constants levels env receipt.proof.proposition.val ∧ + interp constants levels env receipt.proof.proof.val ∈ˢ + interp constants levels env receipt.proof.proposition.val := by + have ha : acceptsCertified.{0,v} fuel receipt.prepared.signature receipt.prepared.input witness = true := by + simp only [acceptsCertified, receipt.checked, Option.isSome_some] + obtain ⟨result, hr, constants, hM, hW, hP, hm⟩ := accepted_has_model ha V levels env + have he : result = receipt.proof := Option.some.inj (hr.symm.trans receipt.checked) + subst result + exact ⟨constants, hM, hW, hP, hm⟩ + +end SourceReceipt + + +namespace SourceSnapshot + +def prepareStore? (fuel : Nat) (profile : Profile) (subjects : List Address) + (snapshot : SourceSnapshot source) : Option PreparedStore := do + if !((snapshot.blobs ++ snapshot.literalBlobs).map Prod.fst).Nodup then none else + prepareStoreObjects? fuel profile subjects snapshot.decodedObjects snapshot.decodedNaturals + +theorem prepareStore_eq (fuel : Nat) (profile : Profile) (subjects : List Address) + (snapshot : SourceSnapshot source) : + Ix.Certified.prepareStore? fuel profile subjects snapshot.blobs snapshot.literalBlobs = + snapshot.prepareStore? fuel profile subjects := by + simp only [Ix.Certified.prepareStore?, prepareStore?, snapshot.objects_decode, snapshot.naturals_decode, + bind, Option.bind_some] + +end SourceSnapshot + +structure StoreReceipt (source : Ixon.Env) (fuel : Nat) (profile : Profile) (subjects : List Address) + (witness : List (DeclarationWitness Address)) where + snapshot : SourceSnapshot source + prepared : PreparedStore + preparation : snapshot.prepareStore? fuel profile subjects = some prepared + result : CheckedStore.{0,v} prepared.signature prepared.store prepared.targets + checked : checkStoreCertified fuel prepared.signature prepared.store prepared.targets witness = some result + +def checkSourceStore? (fuel : Nat) (source : Ixon.Env) (profile : Profile) (subjects : List Address) + (selection : InputSelection) (witness : List (DeclarationWitness Address)) : + Read source (StoreReceipt.{v} source fuel profile subjects witness) := do + let snapshot ← readSnapshot? fuel source selection + match hp : snapshot.prepareStore? fuel profile subjects with + | none => failure + | some prepared => + match hc : checkStoreCertified fuel prepared.signature prepared.store prepared.targets witness with + | none => failure + | some result => return ⟨snapshot, prepared, hp, result, hc⟩ + +namespace StoreReceipt + +theorem serialized (receipt : StoreReceipt.{v} source fuel profile subjects witness) : + acceptsSerializedStore.{v} fuel profile subjects receipt.snapshot.blobs witness receipt.snapshot.literalBlobs = true := by + have hp := receipt.snapshot.prepareStore_eq fuel profile subjects + rw [receipt.preparation] at hp + simp only [acceptsSerializedStore, hp, acceptsStoreCertified, receipt.checked, Option.isSome_some] + +theorem has_model (receipt : StoreReceipt.{v} source fuel profile subjects witness) + (V : Type v) [SetTheory V] : + ∃ constants : Assignment Address V, + receipt.prepared.signature.Compatible receipt.result.environment.entries constants ∧ + ∀ r ∈ receipt.prepared.targets, ∃ entry, receipt.result.environment.entries r = some entry ∧ + EntrySource receipt.prepared.signature receipt.prepared.store r entry ∧ + ∀ levels, levels.length = entry.universes → ∀ env : Nat → V, + WellDenoted constants levels env entry.type ∧ + constants r levels ∈ˢ interp constants levels env entry.type := by + have ha : acceptsStoreCertified.{0,v} fuel receipt.prepared.signature receipt.prepared.store + receipt.prepared.targets witness = true := by + simp only [acceptsStoreCertified, receipt.checked, Option.isSome_some] + obtain ⟨result, hr, hM⟩ := accepted_store_has_model ha V + have he : result = receipt.result := Option.some.inj (hr.symm.trans receipt.checked) + subst result + exact hM + +end StoreReceipt + +end Ix.Certified diff --git a/Ix/Certified/Ixon.lean b/Ix/Certified/Ixon.lean new file mode 100644 index 000000000..303d1f328 --- /dev/null +++ b/Ix/Certified/Ixon.lean @@ -0,0 +1,225 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Ixon +import Ix.Theory.Certified + +/-! +# Ixon input adapter for the certified profile + +This adapter checks table indices, projection ownership/kinds, ordinary Lean +binder modes, and bounded sharing expansion. It preserves block/member +positions and constructor metadata, including checked constructor positions. +Natural literals use a separately authenticated canonical blob table. +Lets and strings are not enabled here. Semantic admission independently +restricts inductive shapes. Byte authentication and the public claim binding +are separate from this structural adapter. +-/ + +namespace Ix.Certified + +open Ix.Theory +open Ix.Theory.Certified + +instance addressDecidableEq : DecidableEq Address := fun a b => + if h : a.hash = b.hash then + .isTrue (by cases a; cases b; cases h; rfl) + else .isFalse (fun he => h (congrArg Address.hash he)) + +def lookup (entries : List (Address × α)) (address : Address) : Option α := + match entries with + | [] => none + | (key, value) :: rest => if address = key then some value else lookup rest address + +theorem lookup_isSome (entries : List (Address × α)) (address : Address) : + (lookup entries address).isSome ↔ address ∈ entries.map Prod.fst := by + induction entries with + | nil => simp [lookup] + | cons entry rest ih => + obtain ⟨key, value⟩ := entry + by_cases h : address = key <;> simp_all [lookup] + +def readLevel : Ixon.Univ → VLevel + | .zero => .zero + | .succ u => .succ (readLevel u) + | .max u v => .max (readLevel u) (readLevel v) + | .imax u v => .imax (readLevel u) (readLevel v) + | .var i => .param i.toNat + +abbrev Objects := List (Address × Ixon.Constant) +abbrev Naturals := List (Address × Nat) + +def mutMember? (objects : Objects) (block : Address) (index : UInt64) : Option Ixon.MutConst := do + let source ← lookup objects block + let .muts members := source.info | none + members[index.toNat]? + +/-- Projection wrappers must refer to the matching source member kind. -/ +def resolveReference? (objects : Objects) (address : Address) : Option (ConstRef Address) := do + let source ← lookup objects address + match source.info with + | .defn _ | .recr _ | .axio _ | .quot _ => some (.member address 0) + | .iPrj projection => do + let .indc _ ← mutMember? objects projection.block projection.idx | none + return .member projection.block projection.idx.toNat + | .rPrj projection => do + let .recr _ ← mutMember? objects projection.block projection.idx | none + return .member projection.block projection.idx.toNat + | .dPrj projection => do + let .defn _ ← mutMember? objects projection.block projection.idx | none + return .member projection.block projection.idx.toNat + | .cPrj projection => do + let .indc family ← mutMember? objects projection.block projection.idx | none + let _ ← family.ctors[projection.cidx.toNat]? + return .ctor projection.block projection.idx.toNat projection.cidx.toNat + | .muts _ => none + +def readLevels? (source : Ixon.Constant) (indices : Array UInt64) : Option (List VLevel) := + indices.toList.mapM fun index => (source.univs[index.toNat]?).map readLevel + +def readExpr? (fuel : Nat) (objects : Objects) (naturals : Naturals) (block : Address) (source : Ixon.Constant) : + Ixon.Expr → Option (VExpr Address) := + match fuel with + | 0 => fun _ => none + | fuel + 1 => fun expression => + match expression with + | .var index => some (.bvar index.toNat) + | .sort index => (source.univs[index.toNat]?).map (VExpr.sort ∘ readLevel) + | .ref index levels => do + let address ← source.refs[index.toNat]? + let reference ← resolveReference? objects address + let levels ← readLevels? source levels + return .const reference levels + | .recur index levels => do + let levels ← readLevels? source levels + return .const (.member block index.toNat) levels + | .app f a => do + let f ← readExpr? fuel objects naturals block source f + let a ← readExpr? fuel objects naturals block source a + return .app f a + | .lam .many A b => do + let A ← readExpr? fuel objects naturals block source A + let b ← readExpr? fuel objects naturals block source b + return .lam A b + | .all .many .shared A B => do + let A ← readExpr? fuel objects naturals block source A + let B ← readExpr? fuel objects naturals block source B + return .forallE A B + | .prj owner field value => do + let address ← source.refs[owner.toNat]? + let ownerSource ← lookup objects address + let .iPrj _ := ownerSource.info | none + let reference ← resolveReference? objects address + let value ← readExpr? fuel objects naturals block source value + return .proj reference field.toNat value + | .nat index => do + let address ← source.refs[index.toNat]? + return .natLit (← lookup naturals address) + | .share index => do + let shared ← source.sharing[index.toNat]? + readExpr? fuel objects naturals block source shared + | _ => none + +def readSafety : Ix.DefinitionSafety → Safety + | .safe => .safe + | .unsaf => .unsafe + | .part => .partial + +def readDefKind : Ix.DefKind → Ix.Theory.DefKind + | .defn => .definition + | .thm => .theorem + | .opaq => .opaque + +def readQuotKind : Ix.QuotKind → Ix.Theory.QuotKind + | .type => .type + | .ctor => .ctor + | .lift => .lift + | .ind => .ind + +def readDefinition? (fuel : Nat) (objects : Objects) (naturals : Naturals) (block : Address) + (source : Ixon.Constant) (definition : Ixon.Definition) : Option (Const Address) := do + let type ← readExpr? fuel objects naturals block source definition.typ + let body ← readExpr? fuel objects naturals block source definition.value + return .defn definition.lvls.toNat (readDefKind definition.kind) type body + (readSafety definition.safety) + +def readRecursor? (fuel : Nat) (objects : Objects) (naturals : Naturals) (block : Address) + (source : Ixon.Constant) (recursor : Ixon.Recursor) : Option (Const Address) := do + let type ← readExpr? fuel objects naturals block source recursor.typ + let rules ← recursor.rules.toList.mapM fun rule => do + let rhs ← readExpr? fuel objects naturals block source rule.rhs + return (⟨rule.fields.toNat, rhs⟩ : RecRule Address) + return .recursor recursor.lvls.toNat recursor.params.toNat recursor.indices.toNat + recursor.motives.toNat recursor.minors.toNat type rules recursor.k + (if recursor.isUnsafe then .unsafe else .safe) + +def readInductive? (fuel : Nat) (objects : Objects) (naturals : Naturals) (block : Address) + (source : Ixon.Constant) (family : Ixon.Inductive) : Option (Const Address) := do + let type ← readExpr? fuel objects naturals block source family.typ + let constructors ← family.ctors.toList.zipIdx.mapM fun (ctor, index) => do + if ctor.cidx.toNat != index then none else do + let type ← readExpr? fuel objects naturals block source ctor.typ + return (⟨ctor.lvls.toNat, ctor.params.toNat, ctor.fields.toNat, type, + if ctor.isUnsafe then .unsafe else .safe⟩ : Ctor Address) + return .induct family.lvls.toNat family.params.toNat family.indices.toNat + type constructors (if family.isUnsafe then .unsafe else .safe) + +def readMutualMember? (fuel : Nat) (objects : Objects) (naturals : Naturals) (block : Address) + (source : Ixon.Constant) : Ixon.MutConst → Option (Const Address) + | .defn definition => readDefinition? fuel objects naturals block source definition + | .recr recursor => readRecursor? fuel objects naturals block source recursor + | .indc family => readInductive? fuel objects naturals block source family + +def readBlock? (fuel : Nat) (objects : Objects) (naturals : Naturals) (block : Address) + (source : Ixon.Constant) : Option (Block Address) := + match source.info with + | .defn definition => do return ⟨[← readDefinition? fuel objects naturals block source definition]⟩ + | .recr recursor => do return ⟨[← readRecursor? fuel objects naturals block source recursor]⟩ + | .axio declaration => do + let type ← readExpr? fuel objects naturals block source declaration.typ + return ⟨[.axiom declaration.lvls.toNat type (if declaration.isUnsafe then .unsafe else .safe)]⟩ + | .quot quotient => do + let type ← readExpr? fuel objects naturals block source quotient.typ + return ⟨[.quot (readQuotKind quotient.kind) quotient.lvls.toNat type]⟩ + | .muts members => do + return ⟨← members.toList.mapM (readMutualMember? fuel objects naturals block source)⟩ + | _ => none + +def isProjection : Ixon.ConstantInfo → Bool + | .iPrj _ | .rPrj _ | .dPrj _ | .cPrj _ => true + | _ => false + +def readBlocks? (fuel : Nat) (objects : Objects) (naturals : Naturals) : + Objects → Option (List (Address × Block Address)) + | [] => some [] + | (address, source) :: rest => do + if isProjection source.info then + let _ ← resolveReference? objects address + readBlocks? fuel objects naturals rest + else + let block ← readBlock? fuel objects naturals address source + let rest ← readBlocks? fuel objects naturals rest + return (address, block) :: rest + +def readStore? (fuel : Nat) (objects : Objects) (naturals : Naturals := []) : Option (Store Address) := do + if (objects.map Prod.fst).Nodup then + let blocks ← readBlocks? fuel objects naturals objects + if h : (blocks.map Prod.fst).Nodup then + return ⟨blocks.map Prod.fst, h, lookup blocks, lookup_isSome blocks⟩ + else none + else none + +def readProofInput? (fuel : Nat) (objects : Objects) (target : Address) + (naturals : Naturals := []) : + Option (ProofInput Address) := do + let store ← readStore? fuel objects naturals + let reference ← resolveReference? objects target + let declaration ← store.lookup reference + if declaration.uvars ≤ fuel then + return ⟨store, declaration.uvars, .const reference (VLevel.params declaration.uvars), + declaration.type⟩ + else none + +end Ix.Certified diff --git a/Ix/Certified/Main.lean b/Ix/Certified/Main.lean new file mode 100644 index 000000000..0570b7cec --- /dev/null +++ b/Ix/Certified/Main.lean @@ -0,0 +1,8 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.Command + +def main := Ix.Certified.Command.main diff --git a/Ix/Certified/ModelHints.lean b/Ix/Certified/ModelHints.lean new file mode 100644 index 000000000..4d65dec82 --- /dev/null +++ b/Ix/Certified/ModelHints.lean @@ -0,0 +1,104 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.Bytes +import Ix.Theory.Certificate.Modeled + +/-! Optional untrusted model-package hints refer to actual stored objects. +No mathematical declaration is imported from JSON: model definitions and +equation proofs come from the selected authenticated source store and are +admitted before the original block by the ordinary certified checker. -/ + +namespace Ix.Certified + +open Ix.Theory + +structure ModelProofHint where + equality : Address + reflexivity : Address + eliminator : Address + proof : Address + +structure ModelRuleHints where + owner : Address + proofs : List (Option ModelProofHint) + +structure ModelHint where + source : Address + recursors : List Address + targets : List Address + proofs : List ModelRuleHints := [] + +def modelCandidate? (objects : Objects) (store : Store Address) (hint : ModelHint) : + Option (Certificate.Modeled.Candidate Address) := do + let recursors ← hint.recursors.mapM (resolveReference? objects) + let targets ← hint.targets.mapM (resolveReference? objects) + let proofs ← hint.proofs.mapM fun rules => do + let owner ← resolveReference? objects rules.owner + let universes ← store.uvars owner + let proofs ← rules.proofs.mapM fun proof => proof.mapM fun proof => do + let equality ← resolveReference? objects proof.equality + let reflexivity ← resolveReference? objects proof.reflexivity + let eliminator ← resolveReference? objects proof.eliminator + let ref ← resolveReference? objects proof.proof + return (⟨equality, reflexivity, eliminator, + .const ref ((List.range universes).map VLevel.param)⟩ : Certificate.Modeled.ProofHint Address) + return (owner, proofs) + return ⟨hint.source, recursors, targets, proofs⟩ + +def modelCandidates? (objects : Objects) (store : Store Address) (hints : List ModelHint) : + Option (List (Certificate.Modeled.Candidate Address)) := hints.mapM (modelCandidate? objects store) + +namespace ModelHint + +def address (value : String) : Except String Address := + match Address.fromString value with + | none => .error "expected a 32-byte hexadecimal model address" + | some address => .ok address + +def readProof (json : Lean.Json) : Except String ModelProofHint := do + return ⟨← address (← json.getObjValAs? String "equality"), + ← address (← json.getObjValAs? String "reflexivity"), + ← address (← json.getObjValAs? String "eliminator"), + ← address (← json.getObjValAs? String "proof")⟩ + +def readRules (json : Lean.Json) : Except String ModelRuleHints := do + let owner ← address (← json.getObjValAs? String "owner") + let values ← json.getObjValAs? (List (Option Lean.Json)) "proofs" + let proofs ← values.mapM (Option.mapM readProof) + return ⟨owner, proofs⟩ + +def read (json : Lean.Json) : Except String ModelHint := do + let source ← address (← json.getObjValAs? String "source") + let recursors ← (← json.getObjValAs? (List String) "recursors").mapM address + let targets ← (← json.getObjValAs? (List String) "targets").mapM address + let proofs ← match json.getObjVal? "proofs" with + | .error _ => pure [] + | .ok values => (← values.getArr?).toList.mapM readRules + return ⟨source, recursors, targets, proofs⟩ + +def readOptional (json : Lean.Json) : Except String (List ModelHint) := do + match json.getObjVal? "models" with + | .error _ => pure [] + | .ok models => (← models.getArr?).toList.mapM read + +def proofJson (hint : ModelProofHint) : Lean.Json := Lean.Json.mkObj [ + ("equality", Lean.toJson (hexOfBytes hint.equality.hash)), + ("reflexivity", Lean.toJson (hexOfBytes hint.reflexivity.hash)), + ("eliminator", Lean.toJson (hexOfBytes hint.eliminator.hash)), + ("proof", Lean.toJson (hexOfBytes hint.proof.hash))] + +def rulesJson (hint : ModelRuleHints) : Lean.Json := Lean.Json.mkObj [ + ("owner", Lean.toJson (hexOfBytes hint.owner.hash)), + ("proofs", Lean.toJson (hint.proofs.map (Option.map proofJson)))] + +def json (hint : ModelHint) : Lean.Json := Lean.Json.mkObj [ + ("source", Lean.toJson (hexOfBytes hint.source.hash)), + ("recursors", Lean.toJson (hint.recursors.map (hexOfBytes ·.hash))), + ("targets", Lean.toJson (hint.targets.map (hexOfBytes ·.hash))), + ("proofs", Lean.toJson (hint.proofs.map rulesJson))] + +end ModelHint +end Ix.Certified diff --git a/Ix/Certified/ModeledAudit.lean b/Ix/Certified/ModeledAudit.lean new file mode 100644 index 000000000..738fe740b --- /dev/null +++ b/Ix/Certified/ModeledAudit.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.AuditSupport +import Ix.Certified.ClaimCommand +import Ix.Certified.Command + +/-! Trust, runtime and premise inventory of the versioned semantic claim +checker, source command and actual TcM acceptance boundary. -/ + +open Lean Lean.Elab Command + +namespace Ix.Certified.ModeledAudit + +def roots : Array Lean.Name := #[ + `Ix.Theory.Certified.Modeled.check?_sound, + `Ix.Theory.Certified.Modeled.checkEquation?_sound, + `Ix.Theory.Certified.Modeled.assignment_realizes, + `Ix.Theory.Certified.Modeled.assignment_agrees, + `Ix.Theory.Certified.checkModeledExtension?, + `Ix.Theory.Certificate.Modeled.witness?, + `Ix.Theory.Certificate.sourceGroup?, + `Ix.Theory.Certificate.proofWitness?, + `Ix.Certified.modelCandidate?, `Ix.Certified.modelCandidates?, + `Ix.Certified.ModelHint.readOptional, `Ix.Certified.ModelHint.read, + `Ix.Certified.suggestSource?, `Ix.Certified.suggestStore?, + `Ix.Certified.Command.readRequest, `Ix.Certified.Command.run_success, + `Ix.Certified.suggestLogical?, `Ix.Certified.ClaimCommand.readRequest, + `Ix.Certified.ClaimCommand.run_meaning, + `Ix.Kernel.acceptsCertifiedSource, `Ix.Kernel.acceptsCertifiedStoreSource, + `Ix.Kernel.accepted_tc_claim_meaning] + +def premises : Array Lean.Name := #[ + `Ix.Certified.Protocol.current, + `Ix.Certified.ModelHint.mk, `Ix.Certified.ModelRuleHints.mk, + `Ix.Certified.ModelProofHint.mk, + `Ix.Theory.Certificate.Modeled.Candidate.mk, + `Ix.Theory.Certificate.Modeled.ProofHint.mk, + `Ix.Theory.Certified.Modeled.Witness.mk, + `Ix.Theory.Certified.Modeled.Checked.mk, + `Ix.Theory.Certified.Modeled.SourceMatches, + `Ix.Theory.Certified.Modeled.sourceRefs?, + `Ix.Theory.Certified.Modeled.recursorSource?, + `Ix.Theory.Certified.Modeled.majorSource?, + `Ix.Theory.Certified.Modeled.ruleSource?, + `Ix.Theory.Certified.Modeled.Companion.entry, + `Ix.Theory.Certified.Modeled.CompanionChecked.mk, + `Ix.Theory.Certified.Modeled.CheckedCompanions.mk, + `Ix.Theory.Certified.Modeled.CheckedEquation.mk, + `Ix.Theory.Certified.Modeled.checkEquation?] + +run_cmd AuditSupport.report "modeled source" roots premises + +end Ix.Certified.ModeledAudit diff --git a/Ix/Certified/NOTICE b/Ix/Certified/NOTICE new file mode 100644 index 000000000..5f678355b --- /dev/null +++ b/Ix/Certified/NOTICE @@ -0,0 +1,22 @@ +Certified source and claim adapters + +Copyright (c) 2026 Argument Computer Corporation. +Licensed under MIT OR Apache-2.0; see LICENSE-MIT and LICENSE-APACHE at the +repository root. + +The cumulative C2-C7 adapters were reconstructed from the authenticated +ix-pilot.patch and ix-c3.patch through ix-c7.patch supplied with the former +Lean4Ix consistency work. Original adapter files, patches, source identities, +reports, licenses and differential fixtures are retained in +Tests/Fixtures/Certified/c7-handoff.tar.gz. Individual source and maintained +file identities appear in Tests/Certified/ImportManifest.lean. + +Maintained theory imports use Ix.Theory, and the checker wrappers use +Ix.Kernel. The five historical audits now traverse full checked declaration +graphs and transitive runtime workers. The unused historical native profiling +counter module is preserved in the archive but is not maintained or linked. + +The set model and its separate attribution are maintained under Ix/Theory. +The old checkout is not a build or test dependency. This handoff archive +contains the selected adapter sources and regression evidence, not the +complete historical Ix base checkout. diff --git a/Ix/Certified/Packet.lean b/Ix/Certified/Packet.lean new file mode 100644 index 000000000..7a3c8466e --- /dev/null +++ b/Ix/Certified/Packet.lean @@ -0,0 +1,185 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.Bytes +import Ix.Aiur.Semantics.BytecodeFfi + +/-! +Untrusted certificate packet producer for the C2 Aiur pilot. It reads source +declarations from the decoded input store and transports the exact proposed +rule witnesses. It does not run the semantic checker. All words are checked +before field conversion, and the VM independently checks the same bounds. +-/ + +namespace Ix.Certified.Packet + +open Ix.Theory Ix.Theory.Certified Model + +abbrev Emit := StateT (Array Nat) (Except String) + +def nat (n : Nat) : Emit Unit := do + if n ≥ 65536 then throw "certificate scalar exceeds the pilot bound" + modify (·.push n) + +def bool (b : Bool) : Emit Unit := nat (if b then 1 else 0) + +def address (a : Address) : Emit Unit := do + if a.hash.size != 32 then throw "certificate address is not 32 bytes" + for byte in a.hash.data do nat byte.toNat + +def ref : ConstRef Address → Emit Unit + | .member a i => nat 0 *> address a *> nat i + | .ctor a i j => nat 1 *> address a *> nat i *> nat j + +def list (emit : α → Emit Unit) (xs : List α) : Emit Unit := do + nat xs.length + xs.forM emit + +def condition : PropWhen → Emit Unit + | .never => nat 0 + | .allZero xs _ => nat 1 *> list nat xs + +def level : VLevel → Emit Unit + | .zero => nat 0 + | .succ l => nat 1 *> level l + | .max a b => nat 2 *> level a *> level b + | .imax a b => nat 3 *> level a *> level b + | .param i => nat 4 *> nat i + +def expr : AExpr Address → Emit Unit + | .sort l => nat 0 *> level l + | .bvar i => nat 1 *> nat i + | .const r ls => nat 2 *> ref r *> list level ls + | .app f a => nat 3 *> expr f *> expr a + | .lam p a b => nat 4 *> condition p *> expr a *> expr b + | .forallE p a b => nat 5 *> condition p *> expr a *> expr b + | .proj .. | .natLit .. => throw "unsupported expression in the C2 pilot" + +def sourceExpr : VExpr Address → Emit Unit + | .sort l => nat 0 *> level l + | .bvar i => nat 1 *> nat i + | .const r ls => nat 2 *> ref r *> list level ls + | .app f a => nat 3 *> sourceExpr f *> sourceExpr a + | .lam a b => nat 4 *> nat 0 *> sourceExpr a *> sourceExpr b + | .forallE a b => nat 5 *> nat 0 *> sourceExpr a *> sourceExpr b + | .proj .. | .natLit .. => throw "unsupported source expression in the C2 pilot" + +mutual +def typing : TypingWitness Address → Emit Unit + | .sort => nat 0 + | .bvar => nat 1 + | .const => nat 2 + | .app p d b wf wa => + nat 3 *> condition p *> expr d *> expr b *> typing wf *> typing wa + | .lam ld lb b wd wb wt => + nat 4 *> level ld *> level lb *> expr b *> typing wd *> typing wb *> typing wt + | .forallE ld lb wd wb => nat 5 *> level ld *> level lb *> typing wd *> typing wb + | .fact .. | .natLit .. | .betaResult .. => throw "semantic facts require the expanded VM profile" + | .conv b la we wa wc => nat 6 *> expr b *> level la *> typing we *> typing wa *> conversion wc + +def conversion : ConversionWitness Address → Emit Unit + | .refl => nat 0 + | .symm w => nat 1 *> conversion w + | .trans c wl wr => nat 2 *> expr c *> conversion wl *> conversion wr + | .app wf wa => nat 3 *> conversion wf *> conversion wa + | .lam ld wd wa wb => nat 4 *> level ld *> typing wd *> conversion wa *> conversion wb + | .forallE ld wd wa wb => nat 5 *> level ld *> typing wd *> conversion wa *> conversion wb + | .beta t wl wa => nat 6 *> expr t *> typing wl *> typing wa + | .eta b wf => nat 7 *> expr b *> typing wf + | .proofIrrel a wt wa wb => nat 8 *> expr a *> typing wt *> typing wa *> typing wb + | .delta => nat 9 + | .sort => nat 10 + | .proj .. | .natLiteral .. => throw "projection and literal conversions require the expanded VM profile" + | .equation .. => throw "ordinary equations require the expanded VM profile" +end + +def safety : Safety → Emit Unit + | .safe => nat 0 + | .unsafe => nat 1 + | .partial => nat 2 + +def kind : Ix.Theory.DefKind → Emit Unit + | .definition => nat 0 + | .theorem => nat 1 + | .opaque => nat 2 + +def source : Const Address → Emit Unit + | .axiom n t s => nat 0 *> nat n *> sourceExpr t *> safety s + | .defn n k t b s => nat 1 *> nat n *> kind k *> sourceExpr t *> sourceExpr b *> safety s + | .induct n p i t cs s => + nat 2 *> nat n *> nat p *> nat i *> sourceExpr t *> nat cs.length *> safety s + | .recursor n p i m b t rs k s => + nat 3 *> nat n *> nat p *> nat i *> nat m *> nat b *> sourceExpr t *> + nat rs.length *> bool k *> safety s + | .quot .. => nat 4 + +def lookup (input : ProofInput Address) (r : ConstRef Address) : Emit (Const Address) := do + match input.store.lookup r with + | none => throw "missing source declaration" + | some declaration => pure declaration + +def definition (input : ProofInput Address) (w : DefinitionWitness Address) : Emit Unit := do + ref w.ref + let declaration ← lookup input w.ref + source declaration + -- Reading only connects occurrence annotations to source syntax. All + -- semantic rule checks still run in Aiur, including unsafe/kind rejection. + let .defn n _ t b _ := declaration + | throw "a definition packet requires a source body" + let some t ← pure (readAnnotations? n 0 t w.typeAnnotations) + | throw "cannot read the proposed type annotations" + let some b ← pure (readAnnotations? n 0 b w.bodyAnnotations) + | throw "cannot read the proposed body annotations" + expr t.val + expr b.val + level w.typeLevel + typing w.typeWitness + typing w.bodyWitness + +def emit (signature : PrimitiveSignature Address) (input : ProofInput Address) + (w : ProofWitness Address) : Emit Unit := do + if signature.natType.isSome then throw "natural primitives require the expanded VM profile" + nat 1 + source (← lookup input signature.falseType) + source (← lookup input signature.falseElim) + list (fun declaration => match declaration with + | .definition witness => definition input witness + | .ordinary _ => throw "ordinary blocks require the expanded VM profile" + | .standard _ => throw "standard axioms require the expanded VM profile" + | .quotient _ => throw "quotients require the expanded VM profile" + | .structure _ => throw "structures require the expanded VM profile" + | .natural _ => throw "natural primitives require the expanded VM profile" + | .modeled _ => throw "modeled blocks require the expanded VM profile") w.declarations + nat input.universes + sourceExpr input.proof + sourceExpr input.proposition + let some e ← pure (readAnnotations? input.universes 0 input.proof w.proofAnnotations) + | throw "cannot read the proposed proof annotations" + let some p ← pure (readAnnotations? input.universes 0 input.proposition w.propositionAnnotations) + | throw "cannot read the proposed proposition annotations" + expr e.val + expr p.val + typing w.proofWitness + typing w.propositionWitness + +def words (signature : PrimitiveSignature Address) (input : ProofInput Address) + (w : ProofWitness Address) : Except String (Array Nat) := do + let (_, result) ← emit signature input w #[] + if result.size ≥ 65536 then throw "certificate packet exceeds the pilot bound" + return result + +def args (signature : PrimitiveSignature Address) : Except String (Array Aiur.G) := do + if signature.natType.isSome then throw "natural primitives require the expanded VM profile" + let .member f i := signature.falseType | throw "False must be a block member" + let .member e j := signature.falseElim | throw "False.elim must be a block member" + if f.hash.size != 32 || e.hash.size != 32 || i ≥ 65536 || j ≥ 65536 then + throw "primitive signature exceeds the pilot bounds" + return (f.hash.data.map (.ofNat ∘ UInt8.toNat)).push (.ofNat i) ++ + (e.hash.data.map (.ofNat ∘ UInt8.toNat)).push (.ofNat j) + +def ioBuffer (words : Array Nat) : Aiur.IOBuffer := + (default : Aiur.IOBuffer).extend 17 #[0] (words.map Aiur.G.ofNat) + +end Ix.Certified.Packet diff --git a/Ix/Certified/Reveal.lean b/Ix/Certified/Reveal.lean new file mode 100644 index 000000000..993a492ca --- /dev/null +++ b/Ix/Certified/Reveal.lean @@ -0,0 +1,155 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.ClaimMeaning + +namespace Ix.Certified + +def Selected {α : Type _} (expected : Option α) (actual : α) : Prop := + match expected with + | none => True + | some value => value = actual + +instance {α : Type _} [DecidableEq α] (expected : Option α) (actual : α) : + Decidable (Selected expected actual) := by + unfold Selected + split <;> infer_instance + +/-- The structural reveal protocol commits to the exact serialized raw +expression, including its original table indices and sharing references. -/ +def expressionAddress (expression : Ixon.Expr) : Address := + Address.blake3 (Ixon.runPut (Ixon.putExpr expression)) + +def ConstructorMatches (expected : Ix.RevealConstructorInfo) (actual : Ixon.Constructor) : Prop := + Selected expected.isUnsafe actual.isUnsafe ∧ Selected expected.lvls actual.lvls ∧ + Selected expected.cidx actual.cidx ∧ Selected expected.params actual.params ∧ + Selected expected.fields actual.fields ∧ Selected expected.typ (expressionAddress actual.typ) + +instance (expected : Ix.RevealConstructorInfo) (actual : Ixon.Constructor) : + Decidable (ConstructorMatches expected actual) := inferInstanceAs (Decidable (_ ∧ _ ∧ _ ∧ _ ∧ _ ∧ _)) + +def ConstructorsMatch (expected : Option (Array (UInt64 × Ix.RevealConstructorInfo))) + (actual : Array Ixon.Constructor) : Prop := + match expected with + | none => True + | some constructors => ∀ pair ∈ constructors.toList, + match actual[pair.1.toNat]? with + | none => False + | some constructor => ConstructorMatches pair.2 constructor + +instance (expected : Option (Array (UInt64 × Ix.RevealConstructorInfo))) (actual : Array Ixon.Constructor) : + Decidable (ConstructorsMatch expected actual) := by + unfold ConstructorsMatch + split + · infer_instance + · apply @List.decidableBAll _ _ (fun pair => by split <;> infer_instance) + +def RulesMatch (expected : Option (Array Ix.RevealRecursorRule)) (actual : Array Ixon.RecursorRule) : Prop := + match expected with + | none => True + | some rules => ∀ rule ∈ rules.toList, + match actual[rule.ruleIdx.toNat]? with + | none => False + | some actual => rule.fields = actual.fields ∧ rule.rhs = expressionAddress actual.rhs + +instance (expected : Option (Array Ix.RevealRecursorRule)) (actual : Array Ixon.RecursorRule) : + Decidable (RulesMatch expected actual) := by + unfold RulesMatch + split + · infer_instance + · apply @List.decidableBAll _ _ (fun rule => by split <;> infer_instance) + +def MutMatches (expected : Ix.RevealMutConstInfo) (actual : Ixon.MutConst) : Prop := + match expected, actual with + | .defn kind safety levels type value, .defn actual => + Selected kind actual.kind ∧ Selected safety actual.safety ∧ Selected levels actual.lvls ∧ + Selected type (expressionAddress actual.typ) ∧ Selected value (expressionAddress actual.value) + | .indc safety levels params indices type ctors, .indc actual => + Selected safety actual.isUnsafe ∧ Selected levels actual.lvls ∧ Selected params actual.params ∧ + Selected indices actual.indices ∧ Selected type (expressionAddress actual.typ) ∧ ConstructorsMatch ctors actual.ctors + | .recr k safety levels params indices motives minors type rules, .recr actual => + Selected k actual.k ∧ Selected safety actual.isUnsafe ∧ Selected levels actual.lvls ∧ + Selected params actual.params ∧ Selected indices actual.indices ∧ Selected motives actual.motives ∧ + Selected minors actual.minors ∧ Selected type (expressionAddress actual.typ) ∧ RulesMatch rules actual.rules + | _, _ => False + +instance (expected : Ix.RevealMutConstInfo) (actual : Ixon.MutConst) : Decidable (MutMatches expected actual) := by + unfold MutMatches + cases expected <;> cases actual <;> infer_instance + +def ComponentsMatch (expected : Array (UInt64 × Ix.RevealMutConstInfo)) (actual : Array Ixon.MutConst) : Prop := + ∀ pair ∈ expected.toList, match actual[pair.1.toNat]? with + | none => False + | some member => MutMatches pair.2 member + +instance (expected : Array (UInt64 × Ix.RevealMutConstInfo)) (actual : Array Ixon.MutConst) : + Decidable (ComponentsMatch expected actual) := by + unfold ComponentsMatch + apply @List.decidableBAll _ _ (fun pair => by split <;> infer_instance) + +def RevealMatches (expected : Ix.RevealConstantInfo) (actual : Ixon.ConstantInfo) : Prop := + match expected, actual with + | .defn kind safety levels type value, .defn actual => + Selected kind actual.kind ∧ Selected safety actual.safety ∧ Selected levels actual.lvls ∧ + Selected type (expressionAddress actual.typ) ∧ Selected value (expressionAddress actual.value) + | .recr k safety levels params indices motives minors type rules, .recr actual => + Selected k actual.k ∧ Selected safety actual.isUnsafe ∧ Selected levels actual.lvls ∧ + Selected params actual.params ∧ Selected indices actual.indices ∧ Selected motives actual.motives ∧ + Selected minors actual.minors ∧ Selected type (expressionAddress actual.typ) ∧ RulesMatch rules actual.rules + | .axio safety levels type, .axio actual => + Selected safety actual.isUnsafe ∧ Selected levels actual.lvls ∧ Selected type (expressionAddress actual.typ) + | .quot kind levels type, .quot actual => + Selected kind actual.kind ∧ Selected levels actual.lvls ∧ Selected type (expressionAddress actual.typ) + | .cPrj index constructor block, .cPrj actual => + Selected index actual.idx ∧ Selected constructor actual.cidx ∧ Selected block actual.block + | .iPrj index block, .iPrj actual | .rPrj index block, .rPrj actual | .dPrj index block, .dPrj actual => + Selected index actual.idx ∧ Selected block actual.block + | .muts components, .muts actual => ComponentsMatch components actual + | _, _ => False + +instance (expected : Ix.RevealConstantInfo) (actual : Ixon.ConstantInfo) : Decidable (RevealMatches expected actual) := by + unfold RevealMatches + cases expected <;> cases actual <;> infer_instance + +structure RevealWitness where + opening : Ixon.Comm + +structure RevealReceipt (source : Ixon.Env) (commitment : Address) (info : Ix.RevealConstantInfo) + (witness : RevealWitness) where + secretSize : witness.opening.secret.hash.size = 32 + payloadSize : witness.opening.payload.hash.size = 32 + bound : witness.opening.commit = commitment + object : SourceObject source + payload : object.address = witness.opening.payload + fields : RevealMatches info object.decoded.val.info + +def checkReveal? (source : Ixon.Env) (commitment : Address) (info : Ix.RevealConstantInfo) + (witness : RevealWitness) : Read source (RevealReceipt source commitment info witness) := + if hs : witness.opening.secret.hash.size = 32 then + if hp : witness.opening.payload.hash.size = 32 then + if hb : witness.opening.commit = commitment then do + let object ← readObject? source witness.opening.payload + if ha : object.address = witness.opening.payload then + if hf : RevealMatches info object.decoded.val.info then + return ⟨hs, hp, hb, object, ha, hf⟩ + else failure + else failure + else failure + else failure + else failure + +def RevealMeaning (source : Ixon.Env) (commitment : Address) (info : Ix.RevealConstantInfo) : Prop := + ∃ opening : Ixon.Comm, opening.secret.hash.size = 32 ∧ opening.payload.hash.size = 32 ∧ + opening.commit = commitment ∧ ∃ bytes object, ObjectBytes source opening.payload bytes object ∧ + RevealMatches info object.info + +theorem RevealReceipt.meaning (receipt : RevealReceipt source commitment info witness) : + RevealMeaning source commitment info := by + refine ⟨witness.opening, receipt.secretSize, receipt.payloadSize, receipt.bound, + receipt.object.bytes, receipt.object.decoded.val, ?_, receipt.fields⟩ + rw [← receipt.payload] + exact ⟨receipt.object.fromSource, receipt.object.decoded.property⟩ + +end Ix.Certified diff --git a/Ix/Certified/SourceAudit.lean b/Ix/Certified/SourceAudit.lean new file mode 100644 index 000000000..110acf5d1 --- /dev/null +++ b/Ix/Certified/SourceAudit.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.AuditSupport +import Ix.Certified.SourceMeaning + +/-! The C6 source audit freezes original expression/statement meaning and +its connection to the actual canonical source bytes. Claim composition and +backend execution are audited by their separate roots when connected. -/ + +open Lean Lean.Elab Command + +namespace Ix.Certified.SourceAudit + +def roots : Array Lean.Name := #[ + `Ix.Certified.resolveReference_iff, `Ix.Certified.readLevel_value, + `Ix.Certified.readExpr_sound, `Ix.Certified.ExprReading.unique, + `Ix.Certified.readExpr_fuel_independent, + `Ix.Certified.readBlock_sourceHeader, `Ix.Certified.readStore_sourceHeader, + `Ix.Certified.SourceSnapshot.object_bytes, `Ix.Certified.SourceSnapshot.natural_bytes, + `Ix.Certified.readSignature_sound, + `Ix.Certified.StoreReceipt.subject_meaning, `Ix.Certified.SourceReceipt.proposition_meaning, + `Ix.Certified.StoreReceipt.subject_coverage] + +def premises : Array Lean.Name := #[ + `Ix.Certified.MemberMeaning, `Ix.Certified.ReferenceTarget, `Ix.Certified.ReferenceMeaning, + `Ix.Certified.LevelsReading.nil, `Ix.Certified.LevelsReading.cons, + `Ix.Certified.ExprReading.var, `Ix.Certified.ExprReading.sort, `Ix.Certified.ExprReading.ref, + `Ix.Certified.ExprReading.recur, `Ix.Certified.ExprReading.app, `Ix.Certified.ExprReading.lam, + `Ix.Certified.ExprReading.all, `Ix.Certified.ExprReading.prj, `Ix.Certified.ExprReading.nat, + `Ix.Certified.ExprReading.share, `Ix.Certified.rawHeader?, + `Ix.Certified.ObjectBytes, `Ix.Certified.NaturalBytes, + `Ix.Certified.SignatureReading, `Ix.Certified.SourceDeclarationReading, `Ix.Certified.SubjectReading] + +run_cmd AuditSupport.report "source meaning" roots premises + +end Ix.Certified.SourceAudit diff --git a/Ix/Certified/SourceExpr.lean b/Ix/Certified/SourceExpr.lean new file mode 100644 index 000000000..5f29a49e9 --- /dev/null +++ b/Ix/Certified/SourceExpr.lean @@ -0,0 +1,274 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.Ixon + +/-! Structural meaning of original Ixon expressions. References retain their +actual table positions and wrapper ownership; sharing expands only through +the original constant's sharing table. This relation has no typing premise. -/ + +namespace Ix.Certified + +open Ix.Theory + +def MemberMeaning (objects : Objects) (block : Address) (index : UInt64) + (member : Ixon.MutConst) : Prop := + ∃ source members, lookup objects block = some source ∧ source.info = .muts members ∧ + members[index.toNat]? = some member + +theorem mutMember_iff {objects : Objects} {block : Address} {index : UInt64} {member : Ixon.MutConst} : + mutMember? objects block index = some member ↔ MemberMeaning objects block index member := by + constructor + · intro h + unfold mutMember? at h + cases hs : lookup objects block with + | none => simp [hs] at h + | some source => + cases hi : source.info <;> simp [hs, hi] at h + exact ⟨source, _, hs, hi, h⟩ + · rintro ⟨source, members, hs, hi, hm⟩ + simp [mutMember?, hs, hi, hm] + +def ReferenceTarget (objects : Objects) (address : Address) (source : Ixon.Constant) + (ref : ConstRef Address) : Prop := + match source.info with + | .defn _ | .recr _ | .axio _ | .quot _ => ref = .member address 0 + | .iPrj projection => + (∃ family, MemberMeaning objects projection.block projection.idx (.indc family)) ∧ + ref = .member projection.block projection.idx.toNat + | .rPrj projection => + (∃ recursor, MemberMeaning objects projection.block projection.idx (.recr recursor)) ∧ + ref = .member projection.block projection.idx.toNat + | .dPrj projection => + (∃ definition, MemberMeaning objects projection.block projection.idx (.defn definition)) ∧ + ref = .member projection.block projection.idx.toNat + | .cPrj projection => + (∃ family ctor, MemberMeaning objects projection.block projection.idx (.indc family) ∧ + family.ctors[projection.cidx.toNat]? = some ctor) ∧ + ref = .ctor projection.block projection.idx.toNat projection.cidx.toNat + | .muts _ => False + +def ReferenceMeaning (objects : Objects) (address : Address) (ref : ConstRef Address) : Prop := + ∃ source, lookup objects address = some source ∧ ReferenceTarget objects address source ref + +theorem resolveReference_iff {objects : Objects} {address : Address} {ref : ConstRef Address} : + resolveReference? objects address = some ref ↔ ReferenceMeaning objects address ref := by + cases hs : lookup objects address with + | none => simp [resolveReference?, ReferenceMeaning, hs] + | some source => + simp only [ReferenceMeaning, hs, Option.some.injEq] + unfold resolveReference? + simp only [hs, bind, Option.bind_some] + unfold ReferenceTarget + rcases source with ⟨info, sharing, references, universes⟩ + cases info + all_goals dsimp only + all_goals try solve | simp [eq_comm] + all_goals simp only [← mutMember_iff] + all_goals rename_i projection + all_goals cases hm : mutMember? objects projection.block projection.idx with + | none => simp [hm] + | some member => + cases member <;> simp [hm, eq_comm, exists_and_left] + + all_goals rename_i family + all_goals cases hf : family.ctors[projection.cidx.toNat]? <;> simp [eq_comm] + +theorem ReferenceMeaning.unique {objects : Objects} {address : Address} {left right : ConstRef Address} + (hl : ReferenceMeaning objects address left) (hr : ReferenceMeaning objects address right) : left = right := + Option.some.inj ((resolveReference_iff.mpr hl).symm.trans (resolveReference_iff.mpr hr)) + +def sourceLevelValue (levels : List Nat) : Ixon.Univ → Nat + | .zero => 0 + | .succ level => sourceLevelValue levels level + 1 + | .max left right => max (sourceLevelValue levels left) (sourceLevelValue levels right) + | .imax left right => + if sourceLevelValue levels right = 0 then 0 else max (sourceLevelValue levels left) (sourceLevelValue levels right) + | .var index => levels.getD index.toNat 0 + +theorem readLevel_value (level : Ixon.Univ) (levels : List Nat) : + (readLevel level).eval levels = sourceLevelValue levels level := by + induction level <;> simp_all [readLevel, VLevel.eval, VLevel.natIMax, sourceLevelValue] + +inductive LevelsReading (source : Ixon.Constant) : List UInt64 → List VLevel → Prop where + | nil : LevelsReading source [] [] + | cons {index indices level levels} : source.univs[index.toNat]? = some level → + LevelsReading source indices levels → + LevelsReading source (index :: indices) (readLevel level :: levels) + +theorem readLevelsList_sound {source : Ixon.Constant} {indices : List UInt64} {levels : List VLevel} + (h : indices.mapM (fun index => (source.univs[index.toNat]?).map readLevel) = some levels) : + LevelsReading source indices levels := by + induction indices generalizing levels with + | nil => + simp at h + subst levels + exact .nil + | cons index indices ih => + cases hi : source.univs[index.toNat]? with + | none => simp [List.mapM_cons, hi] at h + | some level => + cases ht : indices.mapM (fun index => (source.univs[index.toNat]?).map readLevel) with + | none => simp [List.mapM_cons, hi, ht] at h + | some tail => + simp [List.mapM_cons, hi, ht] at h + subst levels + exact .cons hi (ih ht) + +theorem readLevels_sound {source : Ixon.Constant} {indices : Array UInt64} {levels : List VLevel} + (h : readLevels? source indices = some levels) : LevelsReading source indices.toList levels := + readLevelsList_sound h + +theorem LevelsReading.unique {source : Ixon.Constant} {indices : List UInt64} {left right : List VLevel} + (hl : LevelsReading source indices left) (hr : LevelsReading source indices right) : left = right := by + induction hl generalizing right with + | nil => cases hr; rfl + | cons hs _ ih => + cases hr with + | cons ht hr => + cases Option.some.inj (hs.symm.trans ht) + exact congrArg (_ :: ·) (ih hr) + +/-- A reading of the original source syntax, including all reference and +sharing-table lookups. Unsupported binder modes and literal forms have no +constructor in this relation. -/ +inductive ExprReading (objects : Objects) (naturals : Naturals) (block : Address) (source : Ixon.Constant) : + Ixon.Expr → VExpr Address → Prop where + | var (index) : ExprReading objects naturals block source (.var index) (.bvar index.toNat) + | sort {index level} : source.univs[index.toNat]? = some level → + ExprReading objects naturals block source (.sort index) (.sort (readLevel level)) + | ref {index indices address ref levels} : source.refs[index.toNat]? = some address → + ReferenceMeaning objects address ref → LevelsReading source indices.toList levels → + ExprReading objects naturals block source (.ref index indices) (.const ref levels) + | recur {index indices levels} : LevelsReading source indices.toList levels → + ExprReading objects naturals block source (.recur index indices) (.const (.member block index.toNat) levels) + | app {f a fr ar} : ExprReading objects naturals block source f fr → + ExprReading objects naturals block source a ar → + ExprReading objects naturals block source (.app f a) (.app fr ar) + | lam {A b Ar br} : ExprReading objects naturals block source A Ar → + ExprReading objects naturals block source b br → + ExprReading objects naturals block source (.lam .many A b) (.lam Ar br) + | all {A B Ar Br} : ExprReading objects naturals block source A Ar → + ExprReading objects naturals block source B Br → + ExprReading objects naturals block source (.all .many .shared A B) (.forallE Ar Br) + | prj {owner field value address ownerSource projection ref reading} : + source.refs[owner.toNat]? = some address → lookup objects address = some ownerSource → + ownerSource.info = .iPrj projection → ReferenceMeaning objects address ref → + ExprReading objects naturals block source value reading → + ExprReading objects naturals block source (.prj owner field value) (.proj ref field.toNat reading) + | nat {index address value} : source.refs[index.toNat]? = some address → lookup naturals address = some value → + ExprReading objects naturals block source (.nat index) (.natLit value) + | share {index shared reading} : source.sharing[index.toNat]? = some shared → + ExprReading objects naturals block source shared reading → + ExprReading objects naturals block source (.share index) reading + +theorem readExpr_sound {fuel : Nat} {objects : Objects} {naturals : Naturals} {block : Address} + {source : Ixon.Constant} {expression : Ixon.Expr} {reading : VExpr Address} + (h : readExpr? fuel objects naturals block source expression = some reading) : + ExprReading objects naturals block source expression reading := by + induction fuel generalizing expression reading with + | zero => simp [readExpr?] at h + | succ fuel ih => + cases expression with + | var index => + simp [readExpr?] at h + subst reading + exact .var index + | sort index => + simp only [readExpr?, Option.map_eq_some_iff] at h + obtain ⟨level, hl, rfl⟩ := h + exact .sort hl + | ref index indices => + simp only [readExpr?, bind, Option.bind_eq_some_iff, pure, Option.some.injEq] at h + obtain ⟨address, ha, ref, hr, levels, hl, rfl⟩ := h + exact .ref ha (resolveReference_iff.mp hr) (readLevels_sound hl) + | recur index indices => + simp only [readExpr?, bind, Option.bind_eq_some_iff, pure, Option.some.injEq] at h + obtain ⟨levels, hl, rfl⟩ := h + exact .recur (readLevels_sound hl) + | app f a => + simp only [readExpr?, bind, Option.bind_eq_some_iff, pure, Option.some.injEq] at h + obtain ⟨fr, hf, ar, ha, rfl⟩ := h + exact .app (ih hf) (ih ha) + | lam uses A b => + cases uses <;> simp only [readExpr?, bind, Option.bind_eq_some_iff, pure, Option.some.injEq] at h + all_goals try contradiction + obtain ⟨Ar, hA, br, hb, rfl⟩ := h + exact .lam (ih hA) (ih hb) + | all uses owned A B => + cases uses <;> cases owned <;> + simp only [readExpr?, bind, Option.bind_eq_some_iff, pure, Option.some.injEq] at h + all_goals try contradiction + obtain ⟨Ar, hA, Br, hB, rfl⟩ := h + exact .all (ih hA) (ih hB) + | prj owner field value => + simp only [readExpr?, bind, Option.bind_eq_some_iff] at h + obtain ⟨address, ha, ownerSource, hs, h⟩ := h + cases hp : ownerSource.info <;> simp only [hp] at h + all_goals try contradiction + simp only [Option.bind_eq_some_iff, pure, Option.some.injEq] at h + obtain ⟨ref, hr, reading, hv, rfl⟩ := h + exact .prj ha hs hp (resolveReference_iff.mp hr) (ih hv) + | nat index => + simp only [readExpr?, bind, Option.bind_eq_some_iff, pure, Option.some.injEq] at h + obtain ⟨address, ha, value, hv, rfl⟩ := h + exact .nat ha hv + | share index => + simp only [readExpr?, bind, Option.bind_eq_some_iff] at h + obtain ⟨shared, hs, hr⟩ := h + exact .share hs (ih hr) + | str | letE => simp [readExpr?] at h + +/-- The original tables determine one expanded expression. Neither fuel nor +a different sharing-expansion derivation can change the statement. -/ +theorem ExprReading.unique {objects : Objects} {naturals : Naturals} {block : Address} + {source : Ixon.Constant} {expression : Ixon.Expr} {left right : VExpr Address} + (hl : ExprReading objects naturals block source expression left) + (hr : ExprReading objects naturals block source expression right) : left = right := by + induction hl generalizing right with + | var => cases hr; rfl + | sort hs => + cases hr with + | sort ht => cases Option.some.inj (hs.symm.trans ht); rfl + | ref ha hm hl => + cases hr with + | ref hb hn hr => + cases Option.some.inj (ha.symm.trans hb) + exact congr (congrArg VExpr.const (hm.unique hn)) (hl.unique hr) + | recur hl => + cases hr with + | recur hr => exact congrArg (VExpr.const _) (hl.unique hr) + | app _ _ ihf iha => + cases hr with + | app hf ha => exact congr (congrArg VExpr.app (ihf hf)) (iha ha) + | lam _ _ ihA ihb => + cases hr with + | lam hA hb => exact congr (congrArg VExpr.lam (ihA hA)) (ihb hb) + | all _ _ ihA ihB => + cases hr with + | all hA hB => exact congr (congrArg VExpr.forallE (ihA hA)) (ihB hB) + | prj ha _ _ hm _ ih => + cases hr with + | prj hb _ _ hn hv => + cases Option.some.inj (ha.symm.trans hb) + exact congr (congrArg (fun r e => VExpr.proj r _ e) (hm.unique hn)) (ih hv) + | nat ha hv => + cases hr with + | nat hb hw => + cases Option.some.inj (ha.symm.trans hb) + exact congrArg VExpr.natLit (Option.some.inj (hv.symm.trans hw)) + | share hs _ ih => + cases hr with + | share ht hr => + cases Option.some.inj (hs.symm.trans ht) + exact ih hr + +theorem readExpr_fuel_independent {fuel₁ fuel₂ : Nat} {objects : Objects} {naturals : Naturals} + {block : Address} {source : Ixon.Constant} {expression : Ixon.Expr} {left right : VExpr Address} + (hl : readExpr? fuel₁ objects naturals block source expression = some left) + (hr : readExpr? fuel₂ objects naturals block source expression = some right) : left = right := + (readExpr_sound hl).unique (readExpr_sound hr) + +end Ix.Certified diff --git a/Ix/Certified/SourceMeaning.lean b/Ix/Certified/SourceMeaning.lean new file mode 100644 index 000000000..4f8aae276 --- /dev/null +++ b/Ix/Certified/SourceMeaning.lean @@ -0,0 +1,245 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.SourceStore +import Ix.Kernel.Certified + +/-! Authenticated source-statement meaning for successful certified source +runs. The original bytes, raw type and table-resolved reading occur together +in the contract; semantic equality never substitutes for byte identity. -/ + +namespace Ix.Certified + +open Ix.Theory Ix.Theory.Certified Ix.Theory.Model Ix.Theory.Model.SetTheory + +universe v + +def ObjectBytes (source : Ixon.Env) (address : Address) (bytes : ByteArray) (value : Ixon.Constant) : Prop := + constantBytes? source address = some bytes ∧ address.hash.size = 32 ∧ + Address.blake3 bytes = address ∧ Ixon.runGetExact Ixon.getConstant bytes = .ok value ∧ + Ixon.serConstant value = bytes + +def NaturalBytes (source : Ixon.Env) (address : Address) (bytes : ByteArray) (value : Nat) : Prop := + source.getBlob? address = some bytes ∧ address.hash.size = 32 ∧ + Address.blake3 bytes = address ∧ Nat.fromBytesLE bytes.data = value ∧ + ByteArray.mk value.toBytesLE = bytes + +theorem SourceSnapshot.object_bytes (snapshot : SourceSnapshot source) {address : Address} {value : Ixon.Constant} + (h : lookup snapshot.decodedObjects address = some value) : ∃ bytes, ObjectBytes source address bytes value := by + obtain ⟨entry, _, he⟩ := List.mem_map.mp (lookup_mem h) + rcases Prod.mk.inj he with ⟨rfl, rfl⟩ + exact ⟨entry.bytes, entry.fromSource, entry.decoded.property⟩ + +theorem SourceSnapshot.natural_bytes (snapshot : SourceSnapshot source) {address : Address} {value : Nat} + (h : lookup snapshot.decodedNaturals address = some value) : ∃ bytes, NaturalBytes source address bytes value := by + obtain ⟨entry, _, he⟩ := List.mem_map.mp (lookup_mem h) + rcases Prod.mk.inj he with ⟨rfl, rfl⟩ + exact ⟨entry.bytes, entry.fromSource, entry.decoded.property⟩ + +def SignatureReading (profile : Profile) (objects : Objects) (signature : PrimitiveSignature Address) : Prop := + ReferenceMeaning objects profile.falseType signature.falseType ∧ + ReferenceMeaning objects profile.falseElim signature.falseElim ∧ + match profile.natType, signature.natType with + | none, none => True + | some address, some ref => ReferenceMeaning objects address ref + | _, _ => False + +theorem readSignature_sound {profile : Profile} {objects : Objects} {signature : PrimitiveSignature Address} + (h : readSignature? profile objects = some signature) : SignatureReading profile objects signature := by + rcases profile with ⟨falseAddress, elimAddress, natural⟩ + cases natural with + | none => + simp only [readSignature?, bind, Option.bind_some, Option.bind_eq_some_iff] at h + obtain ⟨falseType, hF, falseElim, hE, h⟩ := h + split at h + · cases Option.some.inj h + exact ⟨resolveReference_iff.mp hF, resolveReference_iff.mp hE, trivial⟩ + · cases h + | some address => + simp only [readSignature?, bind, Option.bind_eq_some_iff, Option.map_eq_some_iff] at h + obtain ⟨falseType, hF, falseElim, hE, _, ⟨ref, hn, rfl⟩, h⟩ := h + split at h + · cases Option.some.inj h + exact ⟨resolveReference_iff.mp hF, resolveReference_iff.mp hE, resolveReference_iff.mp hn⟩ + · cases h + +theorem SourceSnapshot.prepareStore_parts {source : Ixon.Env} (snapshot : SourceSnapshot source) + {fuel : Nat} {profile : Profile} {subjects : List Address} {prepared : PreparedStore} + (h : snapshot.prepareStore? fuel profile subjects = some prepared) : + readSignature? profile snapshot.decodedObjects = some prepared.signature ∧ + readStore? fuel snapshot.decodedObjects snapshot.decodedNaturals = some prepared.store ∧ + subjects.flatMapM (subjectReferences? snapshot.decodedObjects) = some prepared.targets := by + unfold SourceSnapshot.prepareStore? at h + split at h + · cases h + · simp only [prepareStoreObjects?, bind, Option.bind_eq_some_iff] at h + obtain ⟨signature, hs, store, hstore, targets, ht, h⟩ := h + split at h + · cases h + · cases Option.some.inj h + exact ⟨hs, hstore, ht⟩ + +theorem SourceSnapshot.prepare_parts {source : Ixon.Env} (snapshot : SourceSnapshot source) + {fuel : Nat} {profile : Profile} {target : Address} {prepared : PreparedInput} + (h : snapshot.prepare? fuel profile target = some prepared) : + readSignature? profile snapshot.decodedObjects = some prepared.signature ∧ + readProofInput? fuel snapshot.decodedObjects target snapshot.decodedNaturals = some prepared.input := by + unfold SourceSnapshot.prepare? at h + split at h + · cases h + · simp only [bind, Option.bind_eq_some_iff, pure, Option.some.injEq] at h + obtain ⟨signature, hs, input, hi, rfl⟩ := h + exact ⟨hs, hi⟩ + +def SourceDeclarationReading (source : Ixon.Env) (objects : Objects) (naturals : Naturals) + (ref : ConstRef Address) (entry : ConstantEntry Address) : Prop := + ∃ bytes declaration rawType, + ObjectBytes source ref.block bytes declaration ∧ lookup objects ref.block = some declaration ∧ + rawHeader? declaration ref = some (entry.universes, rawType) ∧ + ExprReading objects naturals ref.block declaration rawType entry.type.erase + +theorem SourceSnapshot.declaration_reading {source : Ixon.Env} (snapshot : SourceSnapshot source) + {fuel : Nat} {store : Store Address} {ref : ConstRef Address} {entry : ConstantEntry Address} + (h : readStore? fuel snapshot.decodedObjects snapshot.decodedNaturals = some store) + (hh : SourceHeader store ref entry) : + SourceDeclarationReading source snapshot.decodedObjects snapshot.decodedNaturals ref entry := by + obtain ⟨declaration, rawType, hs, ht, hr⟩ := readStore_sourceHeader h hh + obtain ⟨bytes, hb⟩ := snapshot.object_bytes hs + exact ⟨bytes, declaration, rawType, hb, hs, ht, hr⟩ + +/-- Every original requested source declaration is realized in every compatible +model, with its complete canonical bytes and its original raw type retained. -/ +theorem StoreReceipt.subject_meaning + (receipt : StoreReceipt.{v} source fuel profile subjects witness) + {ref : ConstRef Address} (hr : ref ∈ receipt.prepared.targets) : + ∃ entry, receipt.result.environment.entries ref = some entry ∧ + SourceDeclarationReading source receipt.snapshot.decodedObjects receipt.snapshot.decodedNaturals ref entry ∧ + ∀ (V : Type v) [SetTheory V] (constants : Assignment Address V), + receipt.prepared.signature.Compatible receipt.result.environment.entries constants → + ∀ levels, levels.length = entry.universes → ∀ env, + WellDenoted constants levels env entry.type ∧ + constants ref levels ∈ˢ interp constants levels env entry.type := by + obtain ⟨entry, he, hh, hm⟩ := receipt.result.subject_sound hr + exact ⟨entry, he, receipt.snapshot.declaration_reading + (receipt.snapshot.prepareStore_parts receipt.preparation).2.1 hh, hm⟩ + +theorem readProofInput_parts {fuel : Nat} {objects : Objects} {naturals : Naturals} {target : Address} + {input : ProofInput Address} (h : readProofInput? fuel objects target naturals = some input) : + readStore? fuel objects naturals = some input.store ∧ + ∃ ref declaration, resolveReference? objects target = some ref ∧ + input.store.lookup ref = some declaration ∧ input.universes = declaration.uvars ∧ + input.proof = .const ref (VLevel.params input.universes) ∧ input.proposition = declaration.type := by + unfold readProofInput? at h + simp only [bind, Option.bind_eq_some_iff] at h + obtain ⟨store, hs, ref, hr, declaration, hd, h⟩ := h + split at h + · cases Option.some.inj h + exact ⟨hs, ref, declaration, hr, hd, rfl, rfl, rfl⟩ + · cases h + +theorem SourceReceipt.target_entry + (receipt : SourceReceipt.{v} source fuel profile target witness) : + ∃ ref entry, ReferenceMeaning receipt.snapshot.decodedObjects target ref ∧ + receipt.proof.environment.entries ref = some entry ∧ + SourceDeclarationReading source receipt.snapshot.decodedObjects receipt.snapshot.decodedNaturals ref entry ∧ + receipt.prepared.input.universes = entry.universes ∧ + receipt.prepared.input.proposition = entry.type.erase := by + have hp := receipt.snapshot.prepare_parts receipt.preparation + obtain ⟨hs, ref, declaration, hr, hd, hu, he, ht⟩ := readProofInput_parts hp.2 + have hproof : receipt.proof.proof.val = .const ref (VLevel.params receipt.prepared.input.universes) := + AExpr.eq_const_of_erase_eq (receipt.proof.proof.property.1.trans he) + have hmem : (receipt.proof.environment.entries ref).isSome = true := by + simpa [hproof, AExpr.ReferencesIn, AExpr.references] using receipt.proof.proofReferences + cases hf : receipt.proof.environment.entries ref with + | none => simp [hf] at hmem + | some entry => + have hh := receipt.proof.environment.sourceHeader hf + have hu' : declaration.uvars = entry.universes := by simpa [Store.uvars, hd] using hh.universes + have ht' : declaration.type = entry.type.erase := by simpa [Store.type, hd] using hh.type + exact ⟨ref, entry, resolveReference_iff.mp hr, hf, + receipt.snapshot.declaration_reading hs hh, hu.trans hu', ht.trans ht'⟩ + +/-- This is the original serialized proposition's type field, with its exact +source bytes and a validated reading of the original tables. The proposition +is inhabited in every compatible interpretation, not just a chosen model. -/ +theorem SourceReceipt.proposition_meaning + (receipt : SourceReceipt.{v} source fuel profile target witness) : + SignatureReading profile receipt.snapshot.decodedObjects receipt.prepared.signature ∧ + ∃ ref bytes declaration rawType, + ReferenceMeaning receipt.snapshot.decodedObjects target ref ∧ + ObjectBytes source ref.block bytes declaration ∧ + rawHeader? declaration ref = some (receipt.prepared.input.universes, rawType) ∧ + ExprReading receipt.snapshot.decodedObjects receipt.snapshot.decodedNaturals ref.block declaration + rawType receipt.proof.proposition.val.erase ∧ + ∀ (V : Type v) [SetTheory V] (constants : Assignment Address V), + receipt.prepared.signature.Compatible receipt.proof.environment.entries constants → ∀ levels env, + WellDenoted constants levels env receipt.proof.proposition.val ∧ + interp constants levels env receipt.proof.proposition.val ∈ˢ univ 0 ∧ + interp constants levels env receipt.proof.proof.val ∈ˢ + interp constants levels env receipt.proof.proposition.val := by + refine ⟨readSignature_sound (receipt.snapshot.prepare_parts receipt.preparation).1, ?_⟩ + obtain ⟨ref, entry, hr, _, ⟨bytes, declaration, rawType, hb, _, ht, hread⟩, hu, hp⟩ := receipt.target_entry + refine ⟨ref, bytes, declaration, rawType, hr, hb, hu ▸ ht, ?_, ?_⟩ + · rw [receipt.proof.proposition.property.1, hp] + exact hread + · intro V _ constants hM levels env + have hs := receipt.proof.isProp V constants hM.realizes levels env (Context.valid_nil constants levels env) + exact ⟨hs.1, hs.2.2, (receipt.proof.typing V constants hM.realizes levels env + (Context.valid_nil constants levels env)).2.2⟩ + +def SubjectReading (objects : Objects) (subject : Address) (refs : List (ConstRef Address)) : Prop := + ∃ source, lookup objects subject = some source ∧ + match source.info with + | .muts members => members.isEmpty = false ∧ refs = + (members.toList.zipIdx.flatMap fun (member, index) => + .member subject index :: match member with + | .indc family => (List.range family.ctors.size).map (.ctor subject index ·) + | _ => []) + | _ => ∃ ref, ReferenceMeaning objects subject ref ∧ refs = [ref] + +theorem subjectReferences_iff {objects : Objects} {subject : Address} {refs : List (ConstRef Address)} : + subjectReferences? objects subject = some refs ↔ SubjectReading objects subject refs := by + cases hs : lookup objects subject with + | none => simp [subjectReferences?, SubjectReading, hs] + | some source => + rcases source with ⟨info, sharing, references, levels⟩ + cases info <;> + simp only [subjectReferences?, SubjectReading, hs, ← resolveReference_iff, bind, + Option.bind_some, Option.bind_eq_some_iff, pure, Option.some.injEq, exists_eq_left'] + all_goals try solve | simp only [eq_comm] + rename_i members + cases he : members.isEmpty <;> simp [eq_comm] + rfl + +theorem flatMapM_mem_iff {α β : Type} {f : α → Option (List β)} {xs : List α} {ys : List β} + (h : xs.flatMapM f = some ys) (value : β) : + value ∈ ys ↔ ∃ source ∈ xs, ∃ values, f source = some values ∧ value ∈ values := by + induction xs generalizing ys with + | nil => simp at h; subst ys; simp + | cons x xs ih => + simp only [List.flatMapM_cons, bind, Option.bind_eq_some_iff, pure, Option.some.injEq] at h + obtain ⟨values, hv, tail, ht, rfl⟩ := h + constructor + · intro hm + rcases List.mem_append.mp hm with hm | hm + · exact ⟨x, List.mem_cons_self .., values, hv, hm⟩ + · obtain ⟨source, hs, values, hf, hm⟩ := (ih ht).mp hm + exact ⟨source, List.mem_cons_of_mem _ hs, values, hf, hm⟩ + · rintro ⟨source, hs, result, hf, hm⟩ + rcases List.mem_cons.mp hs with rfl | hs + · cases Option.some.inj (hv.symm.trans hf) + exact List.mem_append_left _ hm + · exact List.mem_append_right _ ((ih ht).mpr ⟨source, hs, result, hf, hm⟩) + +/-- Exact subject coverage: projection owners, every block member and every +constructor are retained. No unrelated declaration is silently discharged. -/ +theorem StoreReceipt.subject_coverage + (receipt : StoreReceipt.{v} source fuel profile subjects witness) (ref : ConstRef Address) : + ref ∈ receipt.prepared.targets ↔ + ∃ subject ∈ subjects, ∃ refs, SubjectReading receipt.snapshot.decodedObjects subject refs ∧ ref ∈ refs := by + have h := flatMapM_mem_iff (receipt.snapshot.prepareStore_parts receipt.preparation).2.2 ref + simpa only [subjectReferences_iff] using h + +end Ix.Certified diff --git a/Ix/Certified/SourceStore.lean b/Ix/Certified/SourceStore.lean new file mode 100644 index 000000000..2555a34fd --- /dev/null +++ b/Ix/Certified/SourceStore.lean @@ -0,0 +1,318 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.SourceExpr +import Ix.Theory.Certified.Source + +/-! Exact original declaration headers through the source block reader. -/ + +namespace Ix.Certified + +open Ix.Theory Ix.Theory.Certified + +theorem mapM_get_right {α β : Type} {f : α → Option β} {xs : List α} {ys : List β} + {index : Nat} {value : β} (h : xs.mapM f = some ys) (hy : ys[index]? = some value) : + ∃ source, xs[index]? = some source ∧ f source = some value := by + induction xs generalizing ys index with + | nil => simp at h; subst ys; simp at hy + | cons x xs ih => + simp only [List.mapM_cons, bind, Option.bind_eq_some_iff, pure, Option.some.injEq] at h + obtain ⟨y, hf, tail, ht, rfl⟩ := h + cases index with + | zero => simp at hy; subst value; exact ⟨x, rfl, hf⟩ + | succ index => + obtain ⟨source, hs, hf⟩ := ih ht hy + exact ⟨source, hs, hf⟩ + +def memberRawHeader : Ixon.MutConst → Nat × Ixon.Expr + | .defn value => (value.lvls.toNat, value.typ) + | .recr value => (value.lvls.toNat, value.typ) + | .indc value => (value.lvls.toNat, value.typ) + +def rawHeader? (source : Ixon.Constant) : ConstRef Address → Option (Nat × Ixon.Expr) + | .member _ index => + match source.info with + | .muts members => members[index]?.map memberRawHeader + | .defn value => if index = 0 then some (value.lvls.toNat, value.typ) else none + | .recr value => if index = 0 then some (value.lvls.toNat, value.typ) else none + | .axio value => if index = 0 then some (value.lvls.toNat, value.typ) else none + | .quot value => if index = 0 then some (value.lvls.toNat, value.typ) else none + | _ => none + | .ctor _ index field => do + let .muts members := source.info | none + let .indc family ← members[index]? | none + let ctor ← family.ctors[field]? + return (ctor.lvls.toNat, ctor.typ) + +def blockHeader? (block : Block Address) : ConstRef Address → Option (Nat × VExpr Address) + | .member _ index => block.members[index]?.map fun declaration => (declaration.uvars, declaration.type) + | .ctor _ index field => do + let .induct _ _ _ _ ctors _ ← block.members[index]? | none + let ctor ← ctors[field]? + return (ctor.uvars, ctor.type) + +theorem readMember_header {fuel : Nat} {objects : Objects} {naturals : Naturals} {block : Address} + {source : Ixon.Constant} {member : Ixon.MutConst} {declaration : Const Address} + (h : readMutualMember? fuel objects naturals block source member = some declaration) : + declaration.uvars = (memberRawHeader member).1 ∧ + readExpr? fuel objects naturals block source (memberRawHeader member).2 = some declaration.type := by + cases member with + | defn value => + simp only [readMutualMember?, readDefinition?, bind, Option.bind_eq_some_iff, pure, Option.some.injEq] at h + obtain ⟨type, ht, body, _, rfl⟩ := h + exact ⟨rfl, ht⟩ + | recr value => + simp only [readMutualMember?, readRecursor?, bind, Option.bind_eq_some_iff, pure, Option.some.injEq] at h + obtain ⟨type, ht, rules, _, rfl⟩ := h + exact ⟨rfl, ht⟩ + | indc value => + simp only [readMutualMember?, readInductive?, bind, Option.bind_eq_some_iff, pure, Option.some.injEq] at h + obtain ⟨type, ht, constructors, _, rfl⟩ := h + exact ⟨rfl, ht⟩ + +theorem readInductive_constructor {fuel : Nat} {objects : Objects} {naturals : Naturals} {block : Address} + {source : Ixon.Constant} {family : Ixon.Inductive} {declaration : Const Address} + {index : Nat} {universes : Nat} {type : VExpr Address} + (h : readInductive? fuel objects naturals block source family = some declaration) + (hc : blockHeader? ⟨[declaration]⟩ (.ctor block 0 index) = some (universes, type)) : + ∃ ctor, family.ctors[index]? = some ctor ∧ ctor.lvls.toNat = universes ∧ + readExpr? fuel objects naturals block source ctor.typ = some type := by + simp only [readInductive?, bind, Option.bind_eq_some_iff, pure, Option.some.injEq] at h + obtain ⟨familyType, _, ctors, hm, rfl⟩ := h + simp only [blockHeader?, List.getElem?_cons_zero, bind, Option.bind_some, + Option.bind_eq_some_iff, pure, Option.some.injEq, Prod.mk.injEq] at hc + obtain ⟨ctor, hc, hn, ht⟩ := hc + obtain ⟨⟨raw, position⟩, hr, hp⟩ := mapM_get_right hm hc + simp only [List.getElem?_zipIdx, Array.getElem?_toList, Nat.zero_add, + Option.map_eq_some_iff, Prod.mk.injEq] at hr + obtain ⟨raw', hs, rfl, rfl⟩ := hr + split at hp + · contradiction + · simp only [Option.bind_eq_some_iff, Option.some.injEq] at hp + obtain ⟨reading, ht', he⟩ := hp + cases he + exact ⟨raw', hs, hn, ht ▸ ht'⟩ + +theorem readBlock_sourceHeader {fuel : Nat} {objects : Objects} {naturals : Naturals} {block : Address} + {source : Ixon.Constant} {result : Block Address} {ref : ConstRef Address} + {universes : Nat} {type : VExpr Address} + (h : readBlock? fuel objects naturals block source = some result) + (hh : blockHeader? result ref = some (universes, type)) : + ∃ raw, rawHeader? source ref = some (universes, raw) ∧ + ExprReading objects naturals block source raw type := by + rcases source with ⟨info, sharing, references, levels⟩ + cases info with + | defn value => + simp only [readBlock?, readDefinition?, bind, Option.bind_eq_some_iff, pure, Option.some.injEq] at h + obtain ⟨_, ⟨type, ht, body, _, rfl⟩, rfl⟩ := h + cases ref with + | member owner index => + cases index with + | zero => + simp only [blockHeader?, List.getElem?_cons_zero, Option.map_some, + Const.uvars, Const.type, Option.some.injEq, Prod.mk.injEq] at hh + rcases hh with ⟨rfl, rfl⟩ + exact ⟨_, rfl, readExpr_sound ht⟩ + | succ index => simp [blockHeader?] at hh + | ctor owner index field => cases index <;> simp [blockHeader?] at hh + | recr value => + simp only [readBlock?, readRecursor?, bind, Option.bind_eq_some_iff, pure, Option.some.injEq] at h + obtain ⟨_, ⟨type, ht, rules, _, rfl⟩, rfl⟩ := h + cases ref with + | member owner index => + cases index with + | zero => + simp only [blockHeader?, List.getElem?_cons_zero, Option.map_some, + Const.uvars, Const.type, Option.some.injEq, Prod.mk.injEq] at hh + rcases hh with ⟨rfl, rfl⟩ + exact ⟨_, rfl, readExpr_sound ht⟩ + | succ index => simp [blockHeader?] at hh + | ctor owner index field => cases index <;> simp [blockHeader?] at hh + | axio value => + simp only [readBlock?, bind, Option.bind_eq_some_iff, pure, Option.some.injEq] at h + obtain ⟨type, ht, rfl⟩ := h + cases ref with + | member owner index => + cases index with + | zero => + simp only [blockHeader?, List.getElem?_cons_zero, Option.map_some, + Const.uvars, Const.type, Option.some.injEq, Prod.mk.injEq] at hh + rcases hh with ⟨rfl, rfl⟩ + exact ⟨_, rfl, readExpr_sound ht⟩ + | succ index => simp [blockHeader?] at hh + | ctor owner index field => cases index <;> simp [blockHeader?] at hh + | quot value => + simp only [readBlock?, bind, Option.bind_eq_some_iff, pure, Option.some.injEq] at h + obtain ⟨type, ht, rfl⟩ := h + cases ref with + | member owner index => + cases index with + | zero => + simp only [blockHeader?, List.getElem?_cons_zero, Option.map_some, + Const.uvars, Const.type, Option.some.injEq, Prod.mk.injEq] at hh + rcases hh with ⟨rfl, rfl⟩ + exact ⟨_, rfl, readExpr_sound ht⟩ + | succ index => simp [blockHeader?] at hh + | ctor owner index field => cases index <;> simp [blockHeader?] at hh + | muts rawMembers => + simp only [readBlock?, bind, Option.bind_eq_some_iff, pure, Option.some.injEq] at h + obtain ⟨members, hm, rfl⟩ := h + cases ref with + | member owner index => + simp only [blockHeader?, Option.map_eq_some_iff, Prod.mk.injEq] at hh + obtain ⟨declaration, hd, hn, ht⟩ := hh + obtain ⟨raw, hr, hread⟩ := mapM_get_right hm hd + have ⟨hu, htype⟩ := readMember_header hread + refine ⟨(memberRawHeader raw).2, ?_, readExpr_sound (ht ▸ htype)⟩ + simp only [rawHeader?, ← Array.getElem?_toList, hr, Option.map_some] + exact congrArg some (congrArg (·, (memberRawHeader raw).2) (hu.symm.trans hn)) + | ctor owner index field => + simp only [blockHeader?, bind, Option.bind_eq_some_iff] at hh + obtain ⟨declaration, hd, hc⟩ := hh + obtain ⟨raw, hr, hread⟩ := mapM_get_right hm hd + have hc' : blockHeader? ⟨[declaration]⟩ (.ctor block 0 field) = some (universes, type) := by + simpa only [blockHeader?, List.getElem?_cons_zero, bind, Option.bind_some] using hc + cases raw with + | defn value => + simp only [readMutualMember?, readDefinition?, bind, Option.bind_eq_some_iff, pure, Option.some.injEq] at hread + obtain ⟨type, _, body, _, rfl⟩ := hread + simp [blockHeader?] at hc' + | recr value => + simp only [readMutualMember?, readRecursor?, bind, Option.bind_eq_some_iff, pure, Option.some.injEq] at hread + obtain ⟨type, _, rules, _, rfl⟩ := hread + simp [blockHeader?] at hc' + | indc family => + obtain ⟨ctor, hctor, hn, htype⟩ := readInductive_constructor hread hc' + refine ⟨ctor.typ, ?_, readExpr_sound htype⟩ + have hr' : rawMembers[index]? = some (.indc family) := by simpa using hr + simp [rawHeader?, hr', hctor, hn] + | cPrj | rPrj | iPrj | dPrj => simp [readBlock?] at h + +theorem lookup_mem {α : Type} {entries : List (Address × α)} {address : Address} {value : α} + (h : lookup entries address = some value) : (address, value) ∈ entries := by + induction entries with + | nil => cases h + | cons entry rest ih => + obtain ⟨key, data⟩ := entry + unfold lookup at h + split at h + · rename_i hk + subst address + cases Option.some.inj h + exact List.mem_cons_self .. + · exact List.mem_cons_of_mem _ (ih h) + +theorem lookup_of_mem {α : Type} {entries : List (Address × α)} {address : Address} {value : α} + (hn : (entries.map Prod.fst).Nodup) (h : (address, value) ∈ entries) : + lookup entries address = some value := by + induction entries with + | nil => cases h + | cons entry rest ih => + obtain ⟨key, data⟩ := entry + have hn := List.nodup_cons.mp hn + rcases List.mem_cons.mp h with he | hr + · cases he + simp [lookup] + · have hk : address ≠ key := by + intro he + apply hn.1 + exact List.mem_map.mpr ⟨(address, value), hr, he⟩ + simp only [lookup, hk, ↓reduceIte] + exact ih hn.2 hr + +theorem readBlocks_mem {fuel : Nat} {objects pending : Objects} {naturals : Naturals} + {blocks : List (Address × Block Address)} {address : Address} {block : Block Address} + (h : readBlocks? fuel objects naturals pending = some blocks) (hm : (address, block) ∈ blocks) : + ∃ source, (address, source) ∈ pending ∧ readBlock? fuel objects naturals address source = some block := by + induction pending generalizing blocks with + | nil => simp [readBlocks?] at h; subst blocks; cases hm + | cons entry rest ih => + obtain ⟨key, source⟩ := entry + unfold readBlocks? at h + split at h + · simp only [bind, Option.bind_eq_some_iff] at h + obtain ⟨_, _, h⟩ := h + obtain ⟨source, hs, hb⟩ := ih h hm + exact ⟨source, List.mem_cons_of_mem _ hs, hb⟩ + · simp only [bind, Option.bind_eq_some_iff, pure, Option.some.injEq] at h + obtain ⟨decoded, hd, tail, ht, rfl⟩ := h + rcases List.mem_cons.mp hm with he | hr + · rcases Prod.mk.inj he with ⟨rfl, rfl⟩ + exact ⟨source, List.mem_cons_self .., hd⟩ + · obtain ⟨source, hs, hb⟩ := ih ht hr + exact ⟨source, List.mem_cons_of_mem _ hs, hb⟩ + +theorem readStore_sourceBlock {fuel : Nat} {objects : Objects} {naturals : Naturals} + {store : Store Address} {address : Address} {block : Block Address} + (h : readStore? fuel objects naturals = some store) (hb : store.blocks address = some block) : + ∃ source, lookup objects address = some source ∧ readBlock? fuel objects naturals address source = some block := by + unfold readStore? at h + split at h + · rename_i hn + simp only [bind, Option.bind_eq_some_iff] at h + obtain ⟨blocks, hblocks, h⟩ := h + split at h + · cases Option.some.inj h + obtain ⟨source, hs, hr⟩ := readBlocks_mem hblocks (lookup_mem hb) + exact ⟨source, lookup_of_mem hn hs, hr⟩ + · cases h + · cases h + +def storeHeader? (store : Store Address) (ref : ConstRef Address) : Option (Nat × VExpr Address) := do + let block ← store.blocks ref.block + blockHeader? block ref + +theorem storeHeader_maps (store : Store Address) (ref : ConstRef Address) : + (storeHeader? store ref).map Prod.fst = store.uvars ref ∧ + (storeHeader? store ref).map Prod.snd = store.type ref := by + cases ref with + | member address index => + cases hs : store.blocks address with + | none => simp [storeHeader?, ConstRef.block, Store.type, Store.uvars, Store.lookup, Store.lookupCtor, hs] + | some block => + cases hm : block.members[index]? <;> + simp [storeHeader?, ConstRef.block, blockHeader?, Store.type, Store.uvars, Store.lookup, Store.lookupCtor, hs, hm] + | ctor address index field => + cases hs : store.blocks address with + | none => simp [storeHeader?, ConstRef.block, Store.type, Store.uvars, Store.lookup, Store.lookupCtor, hs] + | some block => + cases hm : block.members[index]? with + | none => simp [storeHeader?, ConstRef.block, blockHeader?, Store.type, Store.uvars, Store.lookup, Store.lookupCtor, hs, hm] + | some declaration => + cases declaration <;> + simp [storeHeader?, ConstRef.block, blockHeader?, Store.type, Store.uvars, Store.lookup, Store.lookupCtor, hs, hm] + rename_i ctors _ + cases hc : ctors[field]? <;> simp + +theorem sourceHeader_pair {store : Store Address} {ref : ConstRef Address} {entry : Ix.Theory.Model.ConstantEntry Address} + (h : SourceHeader store ref entry) : storeHeader? store ref = some (entry.universes, entry.type.erase) := by + have ⟨hu, ht⟩ := storeHeader_maps store ref + rw [h.universes] at hu + rw [h.type] at ht + cases hh : storeHeader? store ref with + | none => simp [hh] at ht + | some header => + rcases header with ⟨universes, type⟩ + simp only [hh, Option.map_some, Option.some.injEq] at hu ht + cases hu + cases ht + rfl + +/-- Exact source type, source universe arity and a unique structural reading +of that original type, for every admitted source member or constructor. -/ +theorem readStore_sourceHeader {fuel : Nat} {objects : Objects} {naturals : Naturals} + {store : Store Address} {ref : ConstRef Address} {entry : Ix.Theory.Model.ConstantEntry Address} + (h : readStore? fuel objects naturals = some store) (hh : SourceHeader store ref entry) : + ∃ source raw, lookup objects ref.block = some source ∧ + rawHeader? source ref = some (entry.universes, raw) ∧ + ExprReading objects naturals ref.block source raw entry.type.erase := by + have hp := sourceHeader_pair hh + simp only [storeHeader?, bind, Option.bind_eq_some_iff] at hp + obtain ⟨block, hb, hp⟩ := hp + obtain ⟨source, hs, hr⟩ := readStore_sourceBlock h hb + obtain ⟨raw, hraw, hread⟩ := readBlock_sourceHeader hr hp + exact ⟨source, raw, hs, hraw, hread⟩ + +end Ix.Certified diff --git a/Ix/Certified/Store.lean b/Ix/Certified/Store.lean new file mode 100644 index 000000000..40d9d5cba --- /dev/null +++ b/Ix/Certified/Store.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.Bytes +import Ix.Theory.Certified.Store + +namespace Ix.Certified + +open Ix.Theory Ix.Theory.Certified Ix.Theory.Model Ix.Theory.Model.SetTheory + +universe v + +/-- A block subject requests every member and constructor. A projection +subject must resolve to its actual matching source kind and position. -/ +def subjectReferences? (objects : Objects) (subject : Address) : Option (List (ConstRef Address)) := do + let source ← lookup objects subject + match source.info with + | .muts members => + if members.isEmpty then none else + return members.toList.zipIdx.flatMap fun (member, index) => + .member subject index :: match member with + | .indc family => (List.range family.ctors.size).map (.ctor subject index ·) + | _ => [] + | _ => return [← resolveReference? objects subject] + +structure PreparedStore where + signature : PrimitiveSignature Address + store : Store Address + targets : List (ConstRef Address) + +def prepareStoreObjects? (fuel : Nat) (profile : Profile) (subjects : List Address) + (objects : Objects) (naturals : Naturals) : Option PreparedStore := do + let signature ← readSignature? profile objects + let store ← readStore? fuel objects naturals + let targets ← subjects.flatMapM (subjectReferences? objects) + if targets.length > fuel then none else return ⟨signature, store, targets⟩ + +def prepareStore? (fuel : Nat) (profile : Profile) (subjects : List Address) + (blobs : ConstantBlobs) (literalBlobs : ConstantBlobs := []) : Option PreparedStore := do + if !((blobs ++ literalBlobs).map Prod.fst).Nodup then none else do + let naturals ← decodeNaturals? literalBlobs + let objects ← decodeObjects? blobs + prepareStoreObjects? fuel profile subjects objects naturals + +def acceptsSerializedStore (fuel : Nat) (profile : Profile) (subjects : List Address) + (blobs : ConstantBlobs) (witness : List (DeclarationWitness Address)) + (literalBlobs : ConstantBlobs := []) : Bool := + match prepareStore? fuel profile subjects blobs literalBlobs with + | none => false + | some prepared => acceptsStoreCertified.{0,v} fuel prepared.signature prepared.store prepared.targets witness + +theorem accepted_serialized_store_has_model {fuel : Nat} {profile : Profile} {subjects : List Address} + {blobs literalBlobs : ConstantBlobs} {witness : List (DeclarationWitness Address)} + (h : acceptsSerializedStore.{v} fuel profile subjects blobs witness literalBlobs = true) + (V : Type v) [SetTheory V] : + ∃ prepared, prepareStore? fuel profile subjects blobs literalBlobs = some prepared ∧ + ∃ result : CheckedStore.{0,v} prepared.signature prepared.store prepared.targets, + checkStoreCertified fuel prepared.signature prepared.store prepared.targets witness = some result ∧ + ∃ constants : Assignment Address V, + prepared.signature.Compatible result.environment.entries constants ∧ + ∀ r ∈ prepared.targets, ∃ entry, result.environment.entries r = some entry ∧ + EntrySource prepared.signature prepared.store r entry ∧ + ∀ levels, levels.length = entry.universes → ∀ env : Nat → V, + WellDenoted constants levels env entry.type ∧ + constants r levels ∈ˢ interp constants levels env entry.type := by + unfold acceptsSerializedStore at h + cases hp : prepareStore? fuel profile subjects blobs literalBlobs with + | none => simp [hp] at h + | some prepared => + exact ⟨prepared, rfl, accepted_store_has_model (by simpa only [hp] using h) V⟩ + +end Ix.Certified diff --git a/Ix/Certified/Suggest.lean b/Ix/Certified/Suggest.lean new file mode 100644 index 000000000..6a1340edb --- /dev/null +++ b/Ix/Certified/Suggest.lean @@ -0,0 +1,31 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.Ingress +import Ix.Theory.Certificate.Build +import Ix.Certified.ModelHints + +namespace Ix.Certified + +open Ix.Theory.Certified + +/-- Untrusted witness search from selected addresses in the actual source +store. A returned witness still has to pass the certified TcM entry point. -/ +def suggestSource? (fuel : Nat) (source : Ixon.Env) (profile : Profile) (target : Address) + (selection : InputSelection) (hints : List ModelHint := []) : Option (ProofWitness Address) := do + let (snapshot, _) ← readSnapshot? fuel source selection {} + let prepared ← snapshot.prepare? fuel profile target + let models ← modelCandidates? snapshot.decodedObjects prepared.input.store hints + Ix.Theory.Certificate.proofWitness? fuel prepared.signature prepared.input models + +/-- Search for complete declaration groups for every requested source subject. -/ +def suggestStore? (fuel : Nat) (source : Ixon.Env) (profile : Profile) (subjects : List Address) + (selection : InputSelection) (hints : List ModelHint := []) : Option (List (DeclarationWitness Address)) := do + let (snapshot, _) ← readSnapshot? fuel source selection {} + let prepared ← snapshot.prepareStore? fuel profile subjects + let models ← modelCandidates? snapshot.decodedObjects prepared.store hints + Ix.Theory.Certificate.storeWitness? fuel prepared.signature prepared.store prepared.targets models + +end Ix.Certified diff --git a/Ix/Certified/TcAudit.lean b/Ix/Certified/TcAudit.lean new file mode 100644 index 000000000..768d38a30 --- /dev/null +++ b/Ix/Certified/TcAudit.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.AuditSupport +import Ix.Kernel.Certified +import Ix.Certified.Command + +/-! The C5 audit covers the actual TcM certified entry points, the decoder +cache and source receipts. It does not promote legacy TcM successes. -/ + +open Lean Lean.Elab Command + +namespace Ix.Certified.TcAudit + +def roots : Array Lean.Name := #[ + `Ix.Certified.constantBytes?, `Ix.Certified.decodeObject_complete, + `Ix.Certified.decodeNatural_complete, + `Ix.Certified.SourceSnapshot.prepare_eq, `Ix.Certified.SourceSnapshot.prepareStore_eq, + `Ix.Certified.SourceSnapshot.objects_from_source, `Ix.Certified.SourceSnapshot.naturals_from_source, + `Ix.Certified.SourceReceipt.serialized, `Ix.Certified.StoreReceipt.serialized, + `Ix.Certified.accepted_serialized_store_has_model, + `Ix.Kernel.TcM.checkCertified_success, `Ix.Kernel.TcM.checkCertified_failure, + `Ix.Kernel.TcM.checkStoreCertified_success, + `Ix.Kernel.certifiedStep_success, `Ix.Kernel.certifiedStep_failure, + `Ix.Kernel.certifiedStoreStep_success, `Ix.Kernel.certifiedStoreStep_failure, + `Ix.Kernel.initialCertifiedState, `Ix.Kernel.accepted_tc_has_model, + `Ix.Kernel.accepted_tc_store_has_model, `Ix.Kernel.no_tc_proof_of_False, + `Ix.Certified.Command.run_success] + +def premises : Array Lean.Name := #[ + `Ix.Certified.InputCache.mk, `Ix.Certified.CachedObject.mk, `Ix.Certified.CachedNatural.mk, + `Ix.Certified.DecodedObject, `Ix.Certified.DecodedNatural, + `Ix.Certified.SourceObject.mk, `Ix.Certified.SourceNatural.mk, + `Ix.Certified.SourceReceipt.mk, `Ix.Certified.StoreReceipt.mk, + `Ix.Certified.InputSelection.mk, `Ix.Certified.subjectReferences?, + `Ix.Kernel.CertifiedState.mk] + +run_cmd AuditSupport.report "certified checker" roots premises + +end Ix.Certified.TcAudit diff --git a/Ix/Certified/Trees.lean b/Ix/Certified/Trees.lean new file mode 100644 index 000000000..59276b734 --- /dev/null +++ b/Ix/Certified/Trees.lean @@ -0,0 +1,117 @@ +/- +Copyright (c) 2026 Argument Computer Corporation. +SPDX-License-Identifier: MIT OR Apache-2.0 +-/ + +import Ix.Certified.SourceMeaning +import Ix.AssumptionTree + +/-! Total checking of Ix's existing Merkle-tree wire representation. The +public slot determines whether leaves mean constant addresses, environment +roots, or logical-axiom addresses. Padding is never a declaration. -/ + +namespace Ix.Certified + +instance addressLawfulBEq : LawfulBEq Address where + eq_of_beq := by + intro a b h + change (a.hash.data == b.hash.data) = true at h + cases a + cases b + exact congrArg Address.mk (congrArg ByteArray.mk (eq_of_beq h)) + rfl := by + intro a + change (a.hash.data == a.hash.data) = true + exact beq_self_eq_true _ + +def treeRoot : AssumptionTree → Address + | .leaf address => Merkle.leafHash address + | .padding => Merkle.zeroAddress + | .node left right => Merkle.nodeHash (treeRoot left) (treeRoot right) + +def treeLeaves : AssumptionTree → List Address + | .leaf address => [address] + | .padding => [] + | .node left right => treeLeaves left ++ treeLeaves right + +def putTreeBody : AssumptionTree → Ixon.PutM Unit + | .leaf address => do Ixon.putU8 0; Ixon.Serialize.put address + | .padding => Ixon.putU8 1 + | .node left right => do + Ixon.putU8 2 + putTreeBody left + putTreeBody right + +def treeBytes (tree : AssumptionTree) : ByteArray := Ixon.runPut do + Ixon.putTag4 ⟨AssumptionTree.FLAG, AssumptionTree.VARIANT⟩ + putTreeBody tree + +def getTreeBody : Nat → Ixon.GetM AssumptionTree + | 0 => throw "certified tree depth limit" + | fuel + 1 => do + match ← Ixon.getU8 with + | 0 => return .leaf (← Ixon.Serialize.get) + | 1 => return .padding + | 2 => return .node (← getTreeBody fuel) (← getTreeBody fuel) + | _ => throw "invalid certified tree node" + +def getTree (fuel : Nat) : Ixon.GetM AssumptionTree := do + let tag ← Ixon.getTag4 + if tag.flag != AssumptionTree.FLAG || tag.size != AssumptionTree.VARIANT then + throw "invalid certified tree tag" + getTreeBody fuel + +structure TreeOpening (fuel : Nat) (root : Address) (bytes : ByteArray) where + tree : AssumptionTree + parsing : Ixon.runGetExact (getTree fuel) bytes = .ok tree + canonical : treeBytes tree = bytes + rootBound : treeRoot tree = root + addresses : ∀ address ∈ treeLeaves tree, address.hash.size = 32 + +def readTree? (fuel : Nat) (root : Address) (bytes : ByteArray) : + Option (TreeOpening fuel root bytes) := + match hp : Ixon.runGetExact (getTree fuel) bytes with + | .error _ => none + | .ok tree => + if hc : treeBytes tree = bytes then + if hr : treeRoot tree = root then + if ha : (treeLeaves tree).all (fun address => address.hash.size == 32) = true then + some ⟨tree, hp, hc, hr, by simpa using List.all_eq_true.mp ha⟩ + else none + else none + else none + +structure OptionalTreeOpening (fuel : Nat) (root : Option Address) (bytes : Option ByteArray) where + leaves : List Address + evidence : match root, bytes with + | none, none => leaves = [] + | some root, some bytes => ∃ opening : TreeOpening fuel root bytes, treeLeaves opening.tree = leaves + | _, _ => False + +def readOptionalTree? (fuel : Nat) (root : Option Address) (bytes : Option ByteArray) : + Option (OptionalTreeOpening fuel root bytes) := + match root, bytes with + | none, none => some ⟨[], rfl⟩ + | some root, some bytes => do + let opening ← readTree? fuel root bytes + return ⟨treeLeaves opening.tree, ⟨opening, rfl⟩⟩ + | _, _ => none + +def TreeMembership (root target : Address) : Prop := + ∃ tree, treeRoot tree = root ∧ target ∈ treeLeaves tree ∧ + ∀ address ∈ treeLeaves tree, address.hash.size = 32 + +/-- Membership is a structural assertion only. No environment or typing +judgment occurs in its conclusion. -/ +theorem TreeOpening.membership (opening : TreeOpening fuel root bytes) {target : Address} + (h : target ∈ treeLeaves opening.tree) : TreeMembership root target := + ⟨opening.tree, opening.rootBound, h, opening.addresses⟩ + +theorem treeLeaves_join (left right : AssumptionTree) (address : Address) : + address ∈ treeLeaves (.node left right) ↔ address ∈ treeLeaves left ∨ address ∈ treeLeaves right := + List.mem_append + +theorem TreeOpening.unique {a b : TreeOpening fuel root bytes} : a.tree = b.tree := + Except.ok.inj (a.parsing.symm.trans b.parsing) + +end Ix.Certified diff --git a/Ix/Cli/BenchCmd.lean b/Ix/Cli/BenchCmd.lean index 139154378..0fd410ed6 100644 --- a/Ix/Cli/BenchCmd.lean +++ b/Ix/Cli/BenchCmd.lean @@ -12,7 +12,6 @@ the benchmark); 3. spawns the run's measured tool — `bench-typecheck` (aiur), `zisk-host`/`sp1-host` (zkVM execute), `ix check-rs` (ooc), - `bench-lean4lean` (lean4lean; olean-driven, no `.ixe`), `ix compile` (compile) — wrapped in the RAM watchdog (`Ix.Watchdog`: cgroup `memory.max` via a systemd user scope; the kernel OOM-kills at the ceiling). The per-constant backends (aiur, zkVM) spawn @@ -335,22 +334,6 @@ def backendSpecs : List BackendSpec := [ metrics := [("execute", ["check-time", "throughput", "peak-rss"])], thresholds := [("constants", "0", "0"), ("check-time", "0.10", "_"), ("throughput", "_", "0.10"), ("peak-rss", "0.10", "_")] }, - -- lean4lean (github.com/digama0/lean4lean, required by the lakefile at a - -- pinned rev): the reference Lean4-in-Lean4 kernel, the external - -- yardstick for the Ix kernels (`ooc` / `ix check-lean`) on the same - -- libraries. Checks the env's library from its oleans (no `.ixe`): - -- whole-library row (module-parallel replay of the import closure) plus - -- one full-closure row per constant, mirroring ooc's row shape and - -- metric names so cross-kernel tables line up. Disabled in CI until a - -- bencher testbed exists — `ix bench run --backend lean4lean` works - -- locally regardless (`disabled` only gates the CI matrix and - -- `!benchmark` scheduling). - { name := "lean4lean", defaultMode := "execute", - inputs := .perConstantWithEnv, - disabled := some "local-only: no bencher testbed yet", - testbeds := [("execute", "lean4lean-check-x64-32x")], - metrics := [("execute", ["check-time", "throughput", "peak-rss", - "constants"])] }, -- AnthropicFLT remains on-demand: its from-scratch upstream build needs -- substantially more than the per-push workflow's one-hour budget. An -- explicit `--env AnthropicFLT` or `BENCH_ENVS=AnthropicFLT` still runs it. @@ -804,27 +787,6 @@ is not a benchmark run" "--json", out, "--json-name", info.name] if exit != 0 && exit != exitRejected then IO.eprintln s!"[bench] whole-env aiur check failed (exit {exit})" - | "lean4lean" => - -- The reference Lean4-in-Lean4 kernel checks the env's library from - -- its oleans, so no `.ixe` is resolved. The tool takes the same - -- registry `module` path `ix compile` does (its lake project supplies - -- the search path; the tool builds the module itself, outside every - -- timed window). Whole-library row keyed by the env name … - let bl ← resolveBin repo "bench-lean4lean" - let modulePath := s!"{repo}/{info.module}" - let exit ← runGuarded watchdog ceilingGb bl - #[modulePath, "--json", out, "--json-name", info.name] - if exit != 0 && exit != exitRejected then - IO.eprintln s!"[bench] whole-library replay failed (exit {exit})" - -- … plus one full-closure row per constant. ONE process for all names - -- (the ooc pattern): the imported env is shared across the closure - -- replays instead of re-paying the library import per name. - if !names.isEmpty then - IO.FS.writeFile namesFile ("\n".intercalate names.toList ++ "\n") - let exit ← runGuarded watchdog ceilingGb bl - #[modulePath, "--no-build", "--consts-file", namesFile, "--json", out] - if exit != 0 && exit != exitRejected then - IO.eprintln s!"[bench] per-constant closures failed (exit {exit})" | "aiur" => -- prove runs the whole pipeline (`bench-typecheck --recursive`): -- every stage per constant, closed by the pipeline ledger. One process @@ -891,7 +853,7 @@ is not a benchmark run" let expected := match backend with | "compile" => #[info.name] | "decompile" => #[info.name] - | "ooc" | "lean4lean" => #[info.name] ++ names + | "ooc" => #[info.name] ++ names | _ => names let code ← gate out expected if code == 0 || code == exitRejected then @@ -930,7 +892,7 @@ def benchRunCmd : Cli.Cmd := `[Cli| "Execute one benchmark run (backend × env × mode), writing benchmark results JSON. Exits 0 on success (rows saved as the local baseline), 3 when the kernel rejected any constant, 1 when no rows were produced." FLAGS: - backend : String; "aiur | aiur-sharded-env | zisk | sp1 | ooc | lean4lean | compile | decompile" + backend : String; "aiur | aiur-sharded-env | zisk | sp1 | ooc | compile | decompile" env : String; "Benchmark env from the registry (default: InitStd)" mode : String; "prove | execute (default: the backend's defaultMode)" out : String; "Benchmark results JSON output path (default: bench.json)" diff --git a/Ix/Cli/CheckLeanCmd.lean b/Ix/Cli/CheckLeanCmd.lean index af1c420be..298b992f1 100644 --- a/Ix/Cli/CheckLeanCmd.lean +++ b/Ix/Cli/CheckLeanCmd.lean @@ -1,6 +1,6 @@ /- `ix check-lean `: typecheck a serialized `.ixe` environment - through the pure-Lean `Ix.Tc` kernel — the reference-kernel counterpart + through the pure-Lean `Ix.Kernel` kernel — the reference-kernel counterpart of `ix check-rs`, with matching mode default, live progress, and exit codes. Correctness-first: expect the Rust kernel to be much faster. @@ -17,7 +17,7 @@ subject-only but still reads dependencies' declared types, so every constant must be present. `--max` therefore bounds the check phase only, never ingress. Checking then runs work-stealing parallel workers - over the shared env (see `Ix.Tc.ParCheck`). + over the shared env (see `Ix.Kernel.ParCheck`). Progress mirrors `check-rs`: a periodic aggregate line (done/total, rate, eta, oldest in-flight) on stderr, persistent lines only for @@ -38,14 +38,14 @@ module public import Cli public import Ix.Common public import Ix.Cli.ConstsFile -public import Ix.Tc +public import Ix.Kernel public import Ix.Benchmark.Results public section namespace Ix.Cli.CheckLeanCmd -open Ix.Tc +open Ix.Kernel /-- First set env var wins; else the default. Zero is a valid setting. -/ def envNat (names : List String) (dflt : Nat) : IO Nat := do @@ -222,7 +222,7 @@ def runCheckLeanCmd (p : Cli.Parsed) : IO UInt32 := do maxRecFuel? := ((← IO.getEnv "IX_MAX_REC_FUEL").bind (·.trimAscii.toString.toNat?)).map (·.toUInt64) } - IO.println s!"Running Ix.Tc kernel check \ + IO.println s!"Running Ix.Kernel kernel check \ ({if anon then "anon" else "meta"} mode) on {envPath}" let t0 ← IO.monoMsNow let bytes ← IO.FS.readBinFile envPath @@ -271,7 +271,7 @@ end Ix.Cli.CheckLeanCmd open Ix.Cli.CheckLeanCmd in def checkLeanCmd : Cli.Cmd := `[Cli| "check-lean" VIA runCheckLeanCmd; - "Typecheck a `.ixe` through the pure-Lean Ix.Tc kernel (meta mode by default; parallel)" + "Typecheck a `.ixe` through the pure-Lean Ix.Kernel kernel (meta mode by default; parallel)" FLAGS: anon; "Run in anon mode (metadata never reaches the kernel; `#hex` labels)" diff --git a/Ix/Cli/ValidateLeanCmd.lean b/Ix/Cli/ValidateLeanCmd.lean index 8441d1711..9f8359a99 100644 --- a/Ix/Cli/ValidateLeanCmd.lean +++ b/Ix/Cli/ValidateLeanCmd.lean @@ -1,6 +1,6 @@ /- `ix validate-lean `: run the pure-Lean Ix pipeline validation - against the Lean environment for any file — the `Ix.Tc` counterpart to + against the Lean environment for any file — the `Ix.Kernel` counterpart to `ix validate` (which drives the Rust implementation's 8-phase pipeline). Phases (all pure-Lean): @@ -44,7 +44,7 @@ public import Ix.DecompileM public import Ix.DecompileDriver public import Ix.DecompileRoundtrip public import Ix.Meta -public import Ix.Tc +public import Ix.Kernel public import Ix.Cli.ValidateCmd public section @@ -54,7 +54,7 @@ open Ix.EnvScope namespace Ix.Cli.ValidateLeanCmd -open Ix.Tc +open Ix.Kernel /-- Phase outcome for the final report. -/ inductive PhaseResult where diff --git a/Ix/Compile/Verify/Audit/SorryFrontier.lean b/Ix/Compile/Verify/Audit/SorryFrontier.lean index db3ee1f65..0595ae8b1 100644 --- a/Ix/Compile/Verify/Audit/SorryFrontier.lean +++ b/Ix/Compile/Verify/Audit/SorryFrontier.lean @@ -4,7 +4,7 @@ import Ix.Compile.Verify.Audit.Statements # Compiler-verification source sorry frontier Fail the build if any declaration emitted from an `Ix.Compile.Verify` source -module directly references `sorryAx`. Upstream Lean4Lean debt is handled by +module directly references `sorryAx`. Named-specification debt is handled by per-root transitive manifests rather than being confused with local source placeholders. -/ diff --git a/Ix/Compile/Verify/Audit/Statements.lean b/Ix/Compile/Verify/Audit/Statements.lean index 4bee84cf0..d30f4c7a4 100644 --- a/Ix/Compile/Verify/Audit/Statements.lean +++ b/Ix/Compile/Verify/Audit/Statements.lean @@ -1,4 +1,4 @@ -import Ix.Tc.Verify.Audit.Basic +import Ix.Kernel.Verify.Audit.Basic import Ix.Compile.Verify.Statements /-! @@ -13,25 +13,20 @@ a premise. namespace Ix.Compile.Verify.Audit.Statements -open Ix.Tc.Verify.Audit +open Ix.Kernel.Verify.Audit private def standard : Array Lean.Name := #[``propext, ``Classical.choice, ``Quot.sound] private def noChoice : Array Lean.Name := #[``propext, ``Quot.sound] -private def blake3Native : Array Lean.Name := #[ - nativeAxiom `Blake3 - `Blake3.HasherOps.hash._native.native_decide.ax_1 -] - private def nameNative : Array Lean.Name := #[ nativeAxiom `Ix.Environment `Ix.Name.mkStr._native.native_decide.ax_1 ] private def singletonDriverNative : Array Lean.Name := - blake3Native ++ nameNative + nameNative private def roots : Array RootAllowance := #[ { root := ``Ix.Compile.Verify.IxonExprRel.eraseModes_iff, @@ -71,7 +66,7 @@ private def roots : Array RootAllowance := #[ standardAxioms := standard }, { root := ``Ix.Compile.Verify.ExprTableWF.mono }, { root := ``Ix.Compile.Verify.Catalog.empty_wf, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.Catalog.ofEnv_finite, standardAxioms := noChoice }, { root := ``Ix.Compile.Verify.BlockState.internRef_wf, @@ -91,24 +86,24 @@ private def roots : Array RootAllowance := #[ { root := ``Ix.Compile.Verify.compileAndInternUnivCanon_run_refines, standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileAndInternUnivCanon_array_refines, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileUniv_run_value, standardAxioms := standard }, { root := ``Ix.Compile.Verify.canonPreseedUnivs_run_refines, standardAxioms := standard }, { root := ``Ix.Compile.Verify.collectExprTablesStructural_run_ready, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.collectExprTablesStructural_run_ready_covers, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.collectPreseedExprs_singleton_run_ready_covers, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.collectPreseedExprs_pair_run_ready_covers, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.singletonPreseedCovers_of_ready, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.singletonPreseedCapacity_of_ready, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.internPreseedRefs_run_wf, standardAxioms := standard }, { root := ``Ix.Compile.Verify.internPreseedRefs_run_total, @@ -129,130 +124,130 @@ private def roots : Array RootAllowance := #[ standardAxioms := standard }, { root := ``Ix.Compile.Verify.PreseedCollectionCovers.compileExprRef_of_indexed, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.BlockWireTablesWF.of_preseed, standardAxioms := noChoice }, { root := ``Ix.Compile.Verify.preseedExprTables_singleton_run_ready, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.preseedExprTables_singleton_run_ready_wireWF, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.preseedExprTables_singleton_run_ready_frozenRef, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.preseedExprTables_of_collect_run_ready_wireWF, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.preseedExprTables_pair_run_ready_wireWF, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.preseedExprTables_pair_run_ready_frozenRefs, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.preseedExprTables_roots_run_ready_frozenRefs, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.collectPreseedExprs_inputs_run_ready_covers, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.preseedExprTables_inputs_run_ready_frozenRefs, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.heterogeneousPreseedSeenSafe_of_uniform, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.preseedExprTables_inputs_run_uniform_ready_frozenRefs, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.preseedExprTables_run_univsFinal, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.serializeIxSyntax_run_refines, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.KVMapSupported.all, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileKVMap_run_refines, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.metaCompileSupport_finite, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.BlockState_compileName_strict, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.serializeIxSyntax_run_strictStores, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileDataValue_run_strictStores, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileKVMap_run_strictStores, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.StructuralExprCacheWF.insert, standardAxioms := standard }, { root := ``Ix.Compile.Verify.OrdinaryExprCacheWF.insert, standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileExpr_run_surgeryFree, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileExprNoSurgeryFuel_structural_refines, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileExpr_run_structural_refines, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileExpr_run_structural_value, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileExpr_run_sort_value, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileExpr_run_constEmpty_recur_value, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileExpr_run_constEmpty_ref_value, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileExpr_run_lit_value, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileExprNoSurgeryFuel_ordinary_refines, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileExpr_run_ordinary_refines, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileExpr_run_ordinary_wireWF, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileExpr_run_ordinary_codec_roundtrip, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.deConstant_serUnsharedAxiomConstant, standardAxioms := standard }, { root := ``Ix.Compile.Verify.deConstant_serUnsharedDefinitionConstant, standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileExpr_run_ordinary_axiomConstant_roundtrip, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileExpr_run_ordinary_definitionConstant_roundtrip, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.BlockResult.mk'_codec_roundtrip, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.buildConstantWithSharing_wireWF, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.BlockResult.constantInfo_codec_roundtrip, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.constantInfoRootExprs_toList, standardAxioms := #[``propext] }, { root := ``Ix.Compile.Verify.finishConstantInfoWithSharing_run_codecWF, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileAxiom_run_ordinary_wireWF, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.finishQuotientCompilation_run, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileQuotient_run_ordinary_wireWF, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileRecursorRules_run_ordinary_wireWF, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.finishRecursorCompilation_run, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileRecursor_run_ordinary_wireWF, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileConstructor_run_ordinary_wireWF, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileInductiveConstructors_run_ordinary_wireWF, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.finishInductiveCompilation_run, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileInductive_run_ordinary_wireWF, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileInductiveData_run_ordinary_wireWF, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileMutConsts_run_ordinary_wireWF, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.buildCompiledMutualBlock_codecWF, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileMutualBlock_run_of_preseed_ordinary_codecWF, standardAxioms := standard, nativeAxioms := singletonDriverNative }, @@ -281,20 +276,20 @@ private def roots : Array RootAllowance := #[ ``Ix.Compile.Verify.compileConstant_run_mutual_of_lookup_sorted_codecWF, standardAxioms := standard, nativeAxioms := singletonDriverNative }, { root := ``Ix.Compile.Verify.finishInductiveFamilyBlock_run_codecWF, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.lookupInductiveConstructors_run_of_lookup, standardAxioms := standard, nativeAxioms := nameNative }, { root := ``Ix.Compile.Verify.compileDefinition_run_ordinary_wireWF, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.finishDefinitionDataCompilation_run, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileDefinitionData_run_ordinary_wireWF, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileDefinitionDataInfo_run_ready_codecWF, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.axiomCompileStartState_frozen, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileConstantInfo_axiom_run_ordinary_codecWF, standardAxioms := standard, nativeAxioms := singletonDriverNative }, @@ -325,30 +320,30 @@ private def roots : Array RootAllowance := #[ { root := ``Ix.Compile.Verify.rewriteWithSharing_wireWF, standardAxioms := standard }, { root := ``Ix.Compile.Verify.applySharing_wireWF, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileExpr_run_ordinary_axiomBlock_noSharing_roundtrip, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileExpr_run_ordinary_definitionBlock_noSharing_roundtrip, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileExpr_run_ordinary_axiomBlock_roundtrip, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileExpr_run_ordinary_definitionBlock_roundtrip, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileExpr_run_ordinary_value, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileExprNoSurgeryFuel_ordinary_arena_refines, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileExpr_run_ordinary_arena_refines, - standardAxioms := standard, nativeAxioms := blake3Native }, + standardAxioms := standard }, { root := ``Ix.Compile.Verify.compileExpr_run_ordinary_arena_value, - standardAxioms := standard, nativeAxioms := blake3Native } + standardAxioms := standard } ] -run_cmd Ix.Tc.Verify.Audit.check roots +run_cmd Ix.Kernel.Verify.Audit.check roots end Ix.Compile.Verify.Audit.Statements diff --git a/Ix/Compile/Verify/Catalog.lean b/Ix/Compile/Verify/Catalog.lean index 3ff230550..4eafad6c1 100644 --- a/Ix/Compile/Verify/Catalog.lean +++ b/Ix/Compile/Verify/Catalog.lean @@ -5,7 +5,7 @@ import Std.Data.HashMap.Lemmas /-! # Immutable compiler catalog and representation well-formedness -This module states the X1 representation boundary without running Ix.Tc. It +This module states the X1 representation boundary without running Ix.Kernel. It separates content-address integrity, finite immutable lookup support, logical environment views, wire representability, and expression-table resolution. @@ -393,7 +393,7 @@ structure Catalog.Finite (catalog : Catalog) : Prop where memberAddrs : FinitelySupported catalog.memberAddrs /-- X1 in-memory catalog integrity. This is representation -well-formedness, not Lean4Lean `VEnv.WF`. -/ +well-formedness, not Ix.Theory.Named `VEnv.WF`. -/ structure Catalog.WF (catalog : Catalog) : Prop where finite : catalog.Finite constants : ∀ {addr constant}, catalog.constants addr = some constant → @@ -434,7 +434,7 @@ theorem Catalog.empty_wf : Catalog.empty.WF := by /-- Immutable view of a concrete `Ixon.Env`. `nameOf` and mutual member addresses remain explicit semantic inputs because the wire environment stores -Ix names and projection constants, not Lean4Lean names or a redundant member +Ix names and projection constants, not Ix.Theory.Named names or a redundant member array. -/ def Catalog.ofEnv (env : Ixon.Env) (nameOf : Address → Option Lean.Name) diff --git a/Ix/Compile/Verify/CompileExpr.lean b/Ix/Compile/Verify/CompileExpr.lean index 8d2cf06a9..85347ceab 100644 --- a/Ix/Compile/Verify/CompileExpr.lean +++ b/Ix/Compile/Verify/CompileExpr.lean @@ -24,7 +24,7 @@ closes the complete ordinary-expression tree: sorts, arbitrary-universe local and external constants, recursive projections, literals, structural composition, and arbitrary metadata maps including recursive syntax values. The proof covers warm caches, universe spelling patches, blob/name commits, -and independent Lean4Lean values. Its strengthened frontier also relates the +and independent Ix.Theory.Named values. Its strengthened frontier also relates the returned `UInt64` root, including the encoded KV map, to the append-only presentation arena under an explicit no-wrap capacity premise. -/ @@ -1309,11 +1309,11 @@ theorem compileExpr_run_sort_refines exact hrun /-- The production sort result therefore denotes the same independent -Lean4Lean value as the source sort. -/ +Ix.Theory.Named value as the source sort. -/ theorem compileExpr_run_sort_value - {venv : Lean4Lean.VEnv} {sctx : SourceCtx} {catalog : Catalog} + {venv : Ix.Theory.Named.VEnv} {sctx : SourceCtx} {catalog : Catalog} {dctx : DecodeCtx} {trProj : ProjectionRel} - {uvars : Nat} {locals : List Lean4Lean.VExpr} + {uvars : Nat} {locals : List Ix.Theory.Named.VExpr} (compileEnv : Ix.CompileM.CompileEnv) (blockEnv : Ix.CompileM.BlockEnv) (snapshot : Ix.CompileM.BlockState) {levelSupport : Ix.Level → Prop} @@ -1324,7 +1324,7 @@ theorem compileExpr_run_sort_value (hctx : RefCompileCtxRel (frozenRefCompileCtx compileEnv blockEnv snapshot) sctx catalog dctx) {state : Ix.CompileM.BlockState} {level : Ix.Level} {hash : Address} - {raw : Ixon.Univ} {idx : UInt64} {value : Lean4Lean.VExpr} + {raw : Ixon.Univ} {idx : UInt64} {value : Ix.Theory.Named.VExpr} (hlevel : levelSupport level) (hstate : FrozenExprStateWF compileEnv blockEnv levelSupport snapshot state) (hraw : compileUnivRef (univParamIndex blockEnv.univCtx) level = some raw) @@ -2097,9 +2097,9 @@ theorem compileExpr_run_constEmpty_ref_refines Ix.CompileM.exprCompileDepth] using hrun theorem compileExpr_run_constEmpty_recur_value - {venv : Lean4Lean.VEnv} {sctx : SourceCtx} {catalog : Catalog} + {venv : Ix.Theory.Named.VEnv} {sctx : SourceCtx} {catalog : Catalog} {dctx : DecodeCtx} {trProj : ProjectionRel} - {uvars : Nat} {locals : List Lean4Lean.VExpr} + {uvars : Nat} {locals : List Ix.Theory.Named.VExpr} (compileEnv : Ix.CompileM.CompileEnv) (blockEnv : Ix.CompileM.BlockEnv) (snapshot : Ix.CompileM.BlockState) {levelSupport : Ix.Level → Prop} @@ -2108,7 +2108,7 @@ theorem compileExpr_run_constEmpty_recur_value (hctx : RefCompileCtxRel (frozenRefCompileCtx compileEnv blockEnv snapshot) sctx catalog dctx) {state : Ix.CompileM.BlockState} {name : Ix.Name} {hash : Address} - {recIdx : Nat} {value : Lean4Lean.VExpr} + {recIdx : Nat} {value : Ix.Theory.Named.VExpr} (hstate : FrozenExprStateWF compileEnv blockEnv levelSupport snapshot state) (hmut : blockEnv.mutCtx.get? name = some recIdx) (hsource : SourceExprRel (uvars := uvars) venv sctx trProj locals @@ -2138,9 +2138,9 @@ theorem compileExpr_run_constEmpty_recur_value compileExprRef_value hctx hsource href⟩ theorem compileExpr_run_constEmpty_ref_value - {venv : Lean4Lean.VEnv} {sctx : SourceCtx} {catalog : Catalog} + {venv : Ix.Theory.Named.VEnv} {sctx : SourceCtx} {catalog : Catalog} {dctx : DecodeCtx} {trProj : ProjectionRel} - {uvars : Nat} {locals : List Lean4Lean.VExpr} + {uvars : Nat} {locals : List Ix.Theory.Named.VExpr} (compileEnv : Ix.CompileM.CompileEnv) (blockEnv : Ix.CompileM.BlockEnv) (snapshot : Ix.CompileM.BlockState) {levelSupport : Ix.Level → Prop} @@ -2149,7 +2149,7 @@ theorem compileExpr_run_constEmpty_ref_value (hctx : RefCompileCtxRel (frozenRefCompileCtx compileEnv blockEnv snapshot) sctx catalog dctx) {state : Ix.CompileM.BlockState} {name : Ix.Name} {hash addr : Address} - {refIdx : UInt64} {value : Lean4Lean.VExpr} + {refIdx : UInt64} {value : Ix.Theory.Named.VExpr} (hstate : FrozenExprStateWF compileEnv blockEnv levelSupport snapshot state) (hmut : blockEnv.mutCtx.get? name = none) (hresolve : resolveConstAddr? compileEnv snapshot name = some addr) @@ -2317,9 +2317,9 @@ theorem compileExpr_run_lit_refines Ix.CompileM.exprCompileDepth] using hrun theorem compileExpr_run_lit_value - {venv : Lean4Lean.VEnv} {sctx : SourceCtx} {catalog : Catalog} + {venv : Ix.Theory.Named.VEnv} {sctx : SourceCtx} {catalog : Catalog} {dctx : DecodeCtx} {trProj : ProjectionRel} - {uvars : Nat} {locals : List Lean4Lean.VExpr} + {uvars : Nat} {locals : List Ix.Theory.Named.VExpr} (compileEnv : Ix.CompileM.CompileEnv) (blockEnv : Ix.CompileM.BlockEnv) (snapshot : Ix.CompileM.BlockState) {levelSupport : Ix.Level → Prop} @@ -2328,7 +2328,7 @@ theorem compileExpr_run_lit_value (hctx : RefCompileCtxRel (frozenRefCompileCtx compileEnv blockEnv snapshot) sctx catalog dctx) {state : Ix.CompileM.BlockState} {literal : Lean.Literal} {hash : Address} - {refIdx : UInt64} {value : Lean4Lean.VExpr} + {refIdx : UInt64} {value : Ix.Theory.Named.VExpr} (hstate : FrozenExprStateWF compileEnv blockEnv levelSupport snapshot state) (hpreseed : snapshot.refsIndex.get? (literalAddress literal) = some refIdx) (hsource : SourceExprRel (uvars := uvars) venv sctx trProj locals @@ -2460,18 +2460,18 @@ theorem compileExpr_run_structural_refines exact hrun /-- The production result in the structural fragment therefore denotes the -same independent Lean4Lean value as its named Ix source. -/ +same independent Ix.Theory.Named value as its named Ix source. -/ theorem compileExpr_run_structural_value - {venv : Lean4Lean.VEnv} {sctx : SourceCtx} {catalog : Catalog} + {venv : Ix.Theory.Named.VEnv} {sctx : SourceCtx} {catalog : Catalog} {dctx : DecodeCtx} {ctx : RefCompileCtx} {trProj : ProjectionRel} - {uvars : Nat} {locals : List Lean4Lean.VExpr} + {uvars : Nat} {locals : List Ix.Theory.Named.VExpr} (compileEnv : Ix.CompileM.CompileEnv) (blockEnv : Ix.CompileM.BlockEnv) (hfree : compileEnv.surgeryFree = true) (hfaithful : ExprKeyFaithfulOn StructuralExpr) (hctx : RefCompileCtxRel ctx sctx catalog dctx) {state : Ix.CompileM.BlockState} {source : Ix.Expr} - {target : Ixon.Expr} {value : Lean4Lean.VExpr} + {target : Ixon.Expr} {value : Ix.Theory.Named.VExpr} (hstruct : StructuralExpr source) (hstate : StructuralExprCacheWF ctx state) (hsource : SourceExprRel (uvars := uvars) venv sctx trProj locals source value) @@ -4140,12 +4140,12 @@ theorem compileExpr_run_ordinary_wireWF hlevelFaithful hexprFaithful hsource hstate href exact ⟨root, state', hrun, hstate', compileExprRef_wireWF hbound href⟩ -/-- Complete ordinary compilation preserves the independent Lean4Lean value +/-- Complete ordinary compilation preserves the independent Ix.Theory.Named value assigned to the source expression. -/ theorem compileExpr_run_ordinary_value - {venv : Lean4Lean.VEnv} {sctx : SourceCtx} {catalog : Catalog} + {venv : Ix.Theory.Named.VEnv} {sctx : SourceCtx} {catalog : Catalog} {dctx : DecodeCtx} {trProj : ProjectionRel} - {uvars : Nat} {locals : List Lean4Lean.VExpr} + {uvars : Nat} {locals : List Ix.Theory.Named.VExpr} (compileEnv : Ix.CompileM.CompileEnv) (blockEnv : Ix.CompileM.BlockEnv) (snapshot : Ix.CompileM.BlockState) {levelSupport : Ix.Level → Prop} @@ -4156,7 +4156,7 @@ theorem compileExpr_run_ordinary_value (hctx : RefCompileCtxRel (frozenRefCompileCtx compileEnv blockEnv snapshot) sctx catalog dctx) {state : Ix.CompileM.BlockState} {source : Ix.Expr} - {target : Ixon.Expr} {value : Lean4Lean.VExpr} + {target : Ixon.Expr} {value : Ix.Theory.Named.VExpr} (hordinary : SupportedOrdinaryExpr levelSupport source) (hstate : FrozenExprStateWF compileEnv blockEnv levelSupport snapshot state) (hsource : SourceExprRel (uvars := uvars) venv sctx trProj locals source value) @@ -4320,9 +4320,9 @@ theorem compileExpr_run_ordinary_arena_refines /-- The strengthened public theorem exposes canonical value preservation and the faithful presentation sidecar in one result. -/ theorem compileExpr_run_ordinary_arena_value - {venv : Lean4Lean.VEnv} {sctx : SourceCtx} {catalog : Catalog} + {venv : Ix.Theory.Named.VEnv} {sctx : SourceCtx} {catalog : Catalog} {dctx : DecodeCtx} {trProj : ProjectionRel} - {uvars : Nat} {locals : List Lean4Lean.VExpr} + {uvars : Nat} {locals : List Ix.Theory.Named.VExpr} (compileEnv : Ix.CompileM.CompileEnv) (blockEnv : Ix.CompileM.BlockEnv) (snapshot : Ix.CompileM.BlockState) {levelSupport : Ix.Level → Prop} @@ -4333,7 +4333,7 @@ theorem compileExpr_run_ordinary_arena_value (hctx : RefCompileCtxRel (frozenRefCompileCtx compileEnv blockEnv snapshot) sctx catalog dctx) {state : Ix.CompileM.BlockState} {source : Ix.Expr} - {target : Ixon.Expr} {value : Lean4Lean.VExpr} + {target : Ixon.Expr} {value : Ix.Theory.Named.VExpr} (hordinary : SupportedOrdinaryExpr levelSupport source) (hstate : FrozenExprStateWF compileEnv blockEnv levelSupport snapshot state) (harena : ArenaCacheWF state) diff --git a/Ix/Compile/Verify/CompilePreseed.lean b/Ix/Compile/Verify/CompilePreseed.lean index 2611fa215..5fee400be 100644 --- a/Ix/Compile/Verify/CompilePreseed.lean +++ b/Ix/Compile/Verify/CompilePreseed.lean @@ -1,5 +1,5 @@ import Ix.Compile.Verify.CompileConstantCodec -import Lean4Lean.Verify.QSort +import Ix.Theory.Named.Verify.QSort /-! # Production expression-table preseeding @@ -350,7 +350,9 @@ theorem PreseedCollectionWireWF.pushUniv theorem addressBlake3_wire (bytes : ByteArray) : (Address.blake3 bytes).hash.size = 32 := by - exact (Blake3.Rust.hash bytes).property + exact (Blake3.HasherOps.finalizeWithLength + (Blake3.Rust.hasherUpdate (Blake3.Rust.hasherInit ()) bytes) 32 (by + rcases System.Platform.numBits_eq with bits | bits <;> rw [bits] <;> decide)).property /-- Conservative number of reference payloads a source walk can append. Seen-set deduplication can only decrease this cost. -/ diff --git a/Ix/Compile/Verify/CompileUniv.lean b/Ix/Compile/Verify/CompileUniv.lean index 6f5fe1e58..f548ee31b 100644 --- a/Ix/Compile/Verify/CompileUniv.lean +++ b/Ix/Compile/Verify/CompileUniv.lean @@ -2,6 +2,8 @@ import Ix.Compile.Verify.CompileState import Ix.Compile.Verify.Reference import Std.Data.HashMap.Lemmas +open Ix.Theory (VLevel) + /-! # Production universe-compiler refinement @@ -689,7 +691,7 @@ theorem compileAndInternUnivCanon_run_refines rw [run_bind compileEnv blockEnv canonState _ _, horiginalRun] rfl -/-- The production result therefore has the independent Lean4Lean universe +/-- The production result therefore has the independent Ix.Theory.Named universe value assigned to the named source level. -/ theorem compileUniv_run_value (compileEnv : Ix.CompileM.CompileEnv) (blockEnv : Ix.CompileM.BlockEnv) diff --git a/Ix/Compile/Verify/IxonValue.lean b/Ix/Compile/Verify/IxonValue.lean index 84358438e..41f25cd50 100644 --- a/Ix/Compile/Verify/IxonValue.lean +++ b/Ix/Compile/Verify/IxonValue.lean @@ -1,12 +1,14 @@ import Ix.Ixon -import Lean4Lean.Theory.Literals -import Lean4Lean.Theory.Typing.Env +import Ix.Theory.Named.Literals +import Ix.Theory.Named.Typing.Env + +open Ix.Theory (VLevel) /-! -# Ixon v2 expressions and Lean4Lean values +# Ixon v2 expressions and Ix.Theory.Named values This is the first compiler-facing semantic boundary. It interprets an Ixon -expression directly as a Lean4Lean `VExpr`; it does not run Ix.Tc and does not +expression directly as a Ix.Theory.Named `VExpr`; it does not run Ix.Kernel and does not use checker acceptance as a specification. The relation is table-aware. It resolves universe, reference, mutual-member, @@ -19,7 +21,7 @@ available to later substructural passes without changing the Lean meaning. namespace Ix.Compile.Verify -open Lean4Lean (VConstant VEnv VExpr VLevel) +open Ix.Theory.Named (VConstant VEnv VExpr) /-- Immutable semantic views needed to interpret an Ixon expression. -/ structure Catalog where @@ -70,7 +72,7 @@ def DecodeCtx.univArgs? (ctx : DecodeCtx) (idxs : Array UInt64) : /-- Projection interpretation is supplied by the surrounding declaration model. Its universe/local-context indices match the existing raw Theory -boundary, while this module remains independent of Ix.Tc. -/ +boundary, while this module remains independent of Ix.Kernel. -/ abbrev ProjectionRel := Nat → List VExpr → Lean.Name → Nat → VExpr → VExpr → Prop @@ -81,7 +83,7 @@ def none : ProjectionRel := fun _ _ _ _ _ _ => False end ProjectionRel -/-- Direct semantic relation from table-indexed Ixon syntax to Lean4Lean +/-- Direct semantic relation from table-indexed Ixon syntax to Ix.Theory.Named syntax. This is a raw representation relation: typing and source-kernel well-formedness are separate obligations. -/ inductive IxonExprRel (venv : VEnv) (catalog : Catalog) (dctx : DecodeCtx) @@ -307,7 +309,7 @@ theorem eraseModes_iff {venv : VEnv} {catalog : Catalog} {dctx : DecodeCtx} end IxonExprRel -/-- Honest boundary for source-kernel meaning while upstream Lean4Lean +/-- Honest boundary for source-kernel meaning while upstream Ix.Theory.Named construction remains incomplete. Compiler theorems consume this explicit witness; no axiom is needed for the structural Ixon conversion itself. -/ structure KernelSourceWitness where diff --git a/Ix/Compile/Verify/Reference.lean b/Ix/Compile/Verify/Reference.lean index 9a5610c02..327e47377 100644 --- a/Ix/Compile/Verify/Reference.lean +++ b/Ix/Compile/Verify/Reference.lean @@ -1,6 +1,8 @@ import Ix.Compile.Verify.Catalog import Ix.Environment -import Lean4Lean.Std.Basic +import Ix.Theory.Named.Std.Basic + +open Ix.Theory (VLevel) /-! # Total ordinary-fragment compiler specification @@ -35,7 +37,7 @@ def compileUnivRef (paramIndex : Ix.Name → Option UInt64) : /-- Independent Theory reading of a named Ix universe under the same positional parameter assignment. -/ def sourceUnivValue (paramIndex : Ix.Name → Option UInt64) : - Ix.Level → Option Lean4Lean.VLevel + Ix.Level → Option Ix.Theory.VLevel | .zero _ => some .zero | .succ level _ => return .succ (← sourceUnivValue paramIndex level) | .max left right _ => @@ -161,8 +163,8 @@ private theorem array_mapM_size_of_eq_some {f : α → Option β} have hmapped := congrArg (Option.map Array.toList) h change Array.toList <$> xs.mapM f = Option.map Array.toList (some ys) at hmapped rw [Array.toList_mapM] at hmapped - have hlength := Lean4Lean.List.Forall₂.length_eq - (Lean4Lean.List.mapM_eq_some.mp hmapped) + have hlength := Ix.Theory.Named.List.Forall₂.length_eq + (Ix.Theory.Named.List.mapM_eq_some.mp hmapped) simpa using hlength.symm /-- Reference compilation preserves the three root-spine lengths used by the diff --git a/Ix/Compile/Verify/SourceValue.lean b/Ix/Compile/Verify/SourceValue.lean index 04fe77053..54051328a 100644 --- a/Ix/Compile/Verify/SourceValue.lean +++ b/Ix/Compile/Verify/SourceValue.lean @@ -1,10 +1,12 @@ import Ix.Compile.Verify.Reference +open Ix.Theory (VLevel) + /-! # Source-to-Ixon value preservation This module closes the first expression-level compiler square. `SourceExprRel` -gives a named `Ix.Expr` an independent Lean4Lean meaning. `RefCompileCtxRel` +gives a named `Ix.Expr` an independent Ix.Theory.Named meaning. `RefCompileCtxRel` states that the finite indices chosen by `compileExprRef` point at the same universes, names, and literal bytes in the target tables. The preservation theorem then constructs `IxonExprRel` for the exact compiler result. @@ -12,7 +14,7 @@ theorem then constructs `IxonExprRel` for the exact compiler result. namespace Ix.Compile.Verify -open Lean4Lean (VConstant VEnv VExpr VLevel) +open Ix.Theory.Named (VConstant VEnv VExpr) /-- Independent semantic interpretation choices for named source syntax. -/ structure SourceCtx where @@ -114,7 +116,7 @@ structure RefCompileCtxRel (compile : RefCompileCtx) (source : SourceCtx) String.fromUTF8? bytes = some value /-- Ordinary reference compilation preserves the independently stated -Lean4Lean value. -/ +Ix.Theory.Named value. -/ theorem compileExprRef_value {venv : VEnv} {sctx : SourceCtx} {catalog : Catalog} {dctx : DecodeCtx} {compile : RefCompileCtx} {trProj : ProjectionRel} {uvars : Nat} {locals : List VExpr} diff --git a/Ix/Compile/Verify/Statements.lean b/Ix/Compile/Verify/Statements.lean index 83c9d5cbe..5e53765a5 100644 --- a/Ix/Compile/Verify/Statements.lean +++ b/Ix/Compile/Verify/Statements.lean @@ -27,7 +27,7 @@ import Ix.Compile.Verify.SourceValue /-! # Public compiler-verification frontier -The first slice exports a direct, table-aware Ixon-to-Lean4Lean relation, the +The first slice exports a direct, table-aware Ixon-to-Ix.Theory.Named relation, the constructive theorem that v2 binder modes do not change the related Theory value, a total ordinary-fragment reference compiler, and proofs that its universe values are preserved and its expression outputs inhabit the @@ -158,14 +158,14 @@ digest-key faithfulness, well-addressed v2 expression tables and constants, and refinement proofs for the production reference/universe interning operations through `CompileM.run`. Production `compileUniv` is structurally total and refines the reference compiler while preserving both memo-cache -soundness and the independent Lean4Lean universe value. In surgery-free +soundness and the independent Ix.Theory.Named universe value. In surgery-free environments, production `compileExpr` now selects a kernel-visible total path; its recursive structural fragment refines `compileExprRef`, preserves a sound collision-disciplined expression cache, retains flattened App-spine -semantics, and composes with the independent Lean4Lean expression value. A +semantics, and composes with the independent Ix.Theory.Named expression value. A frozen-preseed state relation now closes the complete ordinary-expression tree through the actual production dispatcher, including arbitrary-universe -local and external constants, recursive projections, and their Lean4Lean +local and external constants, recursive projections, and their Ix.Theory.Named value corollary. The strengthened theorem also exposes a structural `ArenaRel` for the returned metadata root, preserves every warm-cache root under append-only growth, and makes the `UInt64` arena-capacity boundary @@ -211,6 +211,6 @@ for every variant in the explicit wire domain, with arbitrary canonical application, lambda, and forall spines in every expression payload. `KernelSourceWitness` is the sole upstream source-semantics boundary; later compiler-preservation slices take it -as an explicit hypothesis until Lean4Lean can construct it for a replayed Lean +as an explicit hypothesis until Ix.Theory.Named can construct it for a replayed Lean environment. -/ diff --git a/Ix/Compiler.lean b/Ix/Compiler.lean new file mode 100644 index 000000000..ad9dfb818 --- /dev/null +++ b/Ix/Compiler.lean @@ -0,0 +1,164 @@ +import Ix.Compiler.Fuel +import Ix.Compiler.X86.NatCallsSim +import Ix.Compiler.X86.NatCallsExamples +import Ix.Compiler.Ixon.Serialize +import Ix.Compiler.Ixon.Uses +import Ix.Compiler.Ixon.Address +import Ix.Compiler.Ixon.Univ +import Ix.Compiler.Ixon.Expr +import Ix.Compiler.Ixon.Const +import Ix.Compiler.Ixon.Work +import Ix.Compiler.Ixon.Sharing +import Ix.Compiler.Ixon.DecodeCheck +import Ix.Compiler.Ixon.UsageCheck +import Ix.Compiler.Ixon.Eval +import Ix.Compiler.Ixon.Sharing.Eval +import Ix.Compiler.Ixon.Hash +import Ix.Compiler.Ixon.Merkle +import Ix.Compiler.Ixon.Catalog +import Ix.Compiler.Ixon.CatalogIO +import Ix.Compiler.DurableSync +import Ix.Compiler.AddressEnv +import Ix.Compiler.IxIR.Encoding +import Ix.Compiler.IxIR.Decode +import Ix.Compiler.IxIR0.Basic +import Ix.Compiler.IxIR0.Serialize +import Ix.Compiler.IxIR0.Decode +import Ix.Compiler.IxIR0.MutualBlock +import Ix.Compiler.IxIR0.Readdress +import Ix.Compiler.IxIR0.Eval +import Ix.Compiler.IxIR0.ReaddressSim +import Ix.Compiler.IxIR0.ProjectionSafe +import Ix.Compiler.IxIR0.ProjectionFree +import Ix.Compiler.IxIR0.DynamicCost +import Ix.Compiler.IxIR0.ReaddressProjectionSafe +import Ix.Compiler.IxIR0.ReaddressOracle +import Ix.Compiler.IxIR0.Examples +import Ix.Compiler.IxIR0.ReaddressOracleExamples +import Ix.Compiler.IxIR0.Mono +import Ix.Compiler.Erase +import Ix.Compiler.EraseAddressed +import Ix.Compiler.EraseAddressedSim +import Ix.Compiler.Sim +import Ix.Compiler.EraseValidator +import Ix.Compiler.SimInstance +import Ix.Compiler.UsageSound +import Ix.Compiler.IxIR1.Basic +import Ix.Compiler.IxIR1.Serialize +import Ix.Compiler.IxIR1.Decode +import Ix.Compiler.IxIR1.Readdress +import Ix.Compiler.IxIR1.MutualBlock +import Ix.Compiler.IxIR1.ReaddressAll +import Ix.Compiler.IxIR1.ReaddressSim +import Ix.Compiler.IxIR1.ReaddressOwnership +import Ix.Compiler.IxIR1.ReaddressAllSim +import Ix.Compiler.IxIR1.Eval +import Ix.Compiler.IxIR1.HPT +import Ix.Compiler.IxIR1.HPTSound +import Ix.Compiler.IxIR1.HPTProduce +import Ix.Compiler.IxIR1.HPTCache +import Ix.Compiler.IxIR1.HPTCacheIO +import Ix.Compiler.IxIR1.HPTCacheDirIO +import Ix.Compiler.IxIR1.HPTCasePrune +import Ix.Compiler.IxIR1.HPTCasePruneProgram +import Ix.Compiler.IxIR1.HPTPAPFuse +import Ix.Compiler.IxIR1.Reachability +import Ix.Compiler.IxIR1.HPTPAPFuseProgram +import Ix.Compiler.IxIR1.Optimizer +import Ix.Compiler.IxIR1.Mono +import Ix.Compiler.IxIR1.EvalHistory +import Ix.Compiler.IxIR1.Progress +import Ix.Compiler.IxIR1.Reclamation +import Ix.Compiler.IxIR1.Examples +import Ix.Compiler.IxIR1.Lower +import Ix.Compiler.IxIR1.LowerAddressed +import Ix.Compiler.IxIR1.LowerFullyAddressed +import Ix.Compiler.IxIR1.LowerFullyAddressedSim +import Ix.Compiler.IxIR1.WellModedGen +import Ix.Compiler.IxIR1.ThesisBench +import Ix.Compiler.IxIR1.Sim +import Ix.Compiler.IxIR1.EvalIso +import Ix.Compiler.IxIR1.LowerSim +import Ix.Compiler.IxIR1.LowerStateSim +import Ix.Compiler.IxIR1.NoReuse +import Ix.Compiler.IxIR1.NoReuseAddressed +import Ix.Compiler.IxIR1.CostInstance +import Ix.Compiler.IxIR1.CostModel +import Ix.Compiler.IxIR1.CostTrace +import Ix.Compiler.IxIR1.LowerProgress +import Ix.Compiler.IxIR1.LowerAddressedSim +import Ix.Compiler.IxIR1.LowerMutualAddressedSim +import Ix.Compiler.IxIR1.LowerMutualAddressedProgress +import Ix.Compiler.IxIR2.Basic +import Ix.Compiler.IxIR2.Validate +import Ix.Compiler.IxIR2.ValidateExamples +import Ix.Compiler.IxIR2.Liveness +import Ix.Compiler.IxIR2.LivenessExamples +import Ix.Compiler.IxIR2.Eval +import Ix.Compiler.IxIR2.EvalFuel +import Ix.Compiler.IxIR2.CreditFree +import Ix.Compiler.IxIR2.Interpretation +import Ix.Compiler.IxIR2.EvalCounter +import Ix.Compiler.IxIR2.EvalExamples +import Ix.Compiler.IxIR2.Lower +import Ix.Compiler.IxIR2.LowerExamples +import Ix.Compiler.IxIR2.LowerSim +import Ix.Compiler.Pipeline +import Ix.Compiler.IxIR2.Pipeline +import Ix.Compiler.IxIR2.PipelineSim +import Ix.Compiler.IxIR2.PipelinePhysical +import Ix.Compiler.IxIR2.Reuse +import Ix.Compiler.IxIR2.ReuseSim +import Ix.Compiler.IxIR2.ReuseLiveSim +import Ix.Compiler.IxIR2.ReuseSimExamples +import Ix.Compiler.IxIR2.ReuseExamples +import Ix.Compiler.X86.Basic +import Ix.Compiler.X86.Eval +import Ix.Compiler.X86.EvalExamples +import Ix.Compiler.X86.ScalarApply +import Ix.Compiler.X86.Select +import Ix.Compiler.X86.PipelineSim +import Ix.Compiler.X86.ValidatedScalar +import Ix.Compiler.X86.ScalarSourceObject +import Ix.Compiler.X86.ScalarSources +import Ix.Compiler.X86.PhysicalScalarExport +import Ix.Compiler.X86.PhysicalScalarSourceObject +import Ix.Compiler.X86.PhysicalScalarCapturedSourceObject +import Ix.Compiler.X86.PhysicalScalarSources +import Ix.Compiler.X86.PhysicalScalarExamples +import Ix.Compiler.Coverage.StdContact +import Ix.Compiler.X86.SelectExamples +import Ix.Compiler.X86.Encode +import Ix.Compiler.X86.EncodeExamples +import Ix.Compiler.X86.ByteExamples +import Ix.Compiler.X86.StreamExamples +import Ix.Compiler.X86.ELF +import Ix.Compiler.X86.ELFExamples +import Ix.Compiler.PipelineSound +import Ix.Compiler.IxIR0.Recursion +import Ix.Compiler.IxIR0.RecursionSim +import Ix.Compiler.Recursion.Pipeline +import Ix.Compiler.Recursion.Sim +import Ix.Compiler.Recursion.PhysicalSim +import Ix.Compiler.Recursion.Resources +import Ix.Compiler.Recursion.Allocation +import Ix.Compiler.Recursion.Costs +import Ix.Compiler.Recursion.Rejections +import Ix.Compiler.CallReuse.Sim +import Ix.Compiler.CallReuse.MapSim +import Ix.Compiler.CallReuse.Rejections +import Ix.Compiler.UniqueReuse.PipelineSim +import Ix.Compiler.UniqueReuse.Rejections +import Ix.Compiler.UniqueReuse.NativeSim +import Ix.Compiler.UniqueReuse.NativeObject +import Ix.Compiler.UniqueReuse.RuntimeNativeSim +import Ix.Compiler.UniqueReuse.RuntimeObjectSim +import Ix.Compiler.X86.RuntimeReject +import Ix.Compiler.IxIR2.CreditRefinement +import Ix.Compiler.IxIR2.CreditExamples +import Ix.Compiler.Borrow.Pipeline +import Ix.Compiler.IxIR2.Borrow.Examples +import Ix.Compiler.Borrow.RuntimeSim +import Ix.Compiler.Borrow.RuntimeInput +import Ix.Compiler.IxIR2.Borrow.OpenExamples +import Ix.Compiler.Fence diff --git a/Ix/Compiler/AddressEnv.lean b/Ix/Compiler/AddressEnv.lean new file mode 100644 index 000000000..c3af5ffcb --- /dev/null +++ b/Ix/Compiler/AddressEnv.lean @@ -0,0 +1,58 @@ +import Ix.Compiler.Ixon.Address +import Std.Data.HashMap.Lemmas + +/-! +# Indexed address environments + +Proof-facing IR environments are functions whose list constructor uses +`List.find?`. That definition is intentionally transparent and convenient in +the kernel, but repeated global lookup is linear in the size of a corpus. + +This module supplies an extensionally equal two-stage implementation: build a +hash index once, preserving `List.find?`'s first-binding-wins behavior, and +then close over its lookup function. Keeping those stages explicit matters: +a curried `List → Address → Option α` implementation can otherwise rebuild the +index at every saturated call after compiler arity analysis. +-/ + +namespace Ix.Compiler.AddressEnv + +open Ixon (Address) + +abbrev Index (α : Type) := Std.HashMap Address α + +/-- Build from right to left so an earlier duplicate overwrites a later one, +exactly matching `List.find?`. Lean's proved `List.foldr` compiler rewrite +uses its stack-safe implementation in generated code. -/ +def build (entries : List (Address × α)) : Index α := + entries.foldr (fun entry index => index.insert entry.1 entry.2) {} + +/-- Turn an already-built index into the proof model's function type. Partial +application captures the index; it never rebuilds it during lookup. -/ +def lookup (index : Index α) : Address → Option α := + fun address => index.get? address + +theorem get?_build (entries : List (Address × α)) (address : Address) : + (build entries).get? address = + (entries.find? (fun entry => entry.1 == address)).map (·.2) := by + induction entries with + | nil => simp [build] + | cons entry rest ih => + rw [show build (entry :: rest) = (build rest).insert entry.1 entry.2 by + rfl] + rw [Std.HashMap.get?_insert, ih] + by_cases h : entry.1 = address <;> simp [h] + +/-- Lookup equivalence, including duplicate-key precedence and misses. -/ +theorem lookup_build_apply (entries : List (Address × α)) (address : Address) : + lookup (build entries) address = + (entries.find? (fun entry => entry.1 == address)).map (·.2) := by + exact get?_build entries address + +theorem lookup_build (entries : List (Address × α)) : + lookup (build entries) = fun address => + (entries.find? (fun entry => entry.1 == address)).map (·.2) := by + funext address + exact lookup_build_apply entries address + +end Ix.Compiler.AddressEnv diff --git a/Ix/Compiler/Borrow/Pipeline.lean b/Ix/Compiler/Borrow/Pipeline.lean new file mode 100644 index 000000000..32c6cd487 --- /dev/null +++ b/Ix/Compiler/Borrow/Pipeline.lean @@ -0,0 +1,141 @@ +import Ix.Compiler.IxIR2.Pipeline +import Ix.Compiler.IxIR2.Borrow.Replay + +/-! Attach the optional borrowed-call pass to the actual validated Ixon +compiler. In addition to the exact baseline/rewrite replay, selection checks +the source evaluation internally. A failed optional check retains the entire +checked baseline attachment. Invalid source is still a compiler error. -/ + +namespace Ix.Compiler.Borrow + +open Ix.Compiler.Ixon (Address Owned) + +structure Options where + maxCandidates : Nat := 32 + maxRounds : Nat := 16 + maxAttempts : Nat := 256 + sourceFuel : Nat := 1000 + budget : IxIR2.Borrow.Budget := {} + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr + +def Options.limits (options : Options) : IxIR2.Borrow.Limits := + { maxCandidates := options.maxCandidates, maxRounds := options.maxRounds + maxAttempts := options.maxAttempts } + +structure SourceExecution (constants : List (Address × Ixon.Constant)) + (root : Address) (config : Pipeline.Config) (fuel : Nat) where + number : Nat + ran : Ixon.Eval.eval (Pipeline.validatedEvalCtx constants config) fuel + (Pipeline.validatedMainFrame root) [] Pipeline.validatedMainSource = + .ok (.litV (.natL number)) + +def executeSource (constants : List (Address × Ixon.Constant)) + (root : Address) (config : Pipeline.Config) (fuel : Nat) : + Except String (SourceExecution constants root config fuel) := + match ran : Ixon.Eval.eval (Pipeline.validatedEvalCtx constants config) fuel + (Pipeline.validatedMainFrame root) [] Pipeline.validatedMainSource with + | .ok (.litV (.natL number)) => .ok ⟨number, ran⟩ + | .ok _ => .error "source result is outside the closed scalar borrow boundary" + | .error error => .error s!"source replay failed: {repr error}" + +structure Improved {constants root config world eraseFuel lowerFuel} + (attached : IxIR2.Pipeline.Attached constants root config world eraseFuel lowerFuel) + (options : Options) where + target : IxIR2.Borrow.Improved options.limits attached.target.artifact.validationContext + options.budget attached.target.artifact.program + source : SourceExecution constants root config options.sourceFuel + agrees : source.number = target.before.number + +inductive Fallback where + | target (reason : IxIR2.Borrow.Fallback) + | source (message : String) + | sourceMismatch + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr + +structure Selection {constants root config world eraseFuel lowerFuel} + (attached : IxIR2.Pipeline.Attached constants root config world eraseFuel lowerFuel) + (options : Options) where + inference : IxIR2.Borrow.Inference + attempt : Except Fallback (Improved attached options) + +def select {constants root config world eraseFuel lowerFuel} + (attached : IxIR2.Pipeline.Attached constants root config world eraseFuel lowerFuel) + (options : Options := {}) : Selection attached options := + let baselineChecked : IxIR2.Validate.Checked options.limits.validator + attached.target.artifact.validationContext attached.target.artifact.program := + ⟨attached.target.stats, attached.target.accepted⟩ + let selected := IxIR2.Borrow.optimize baselineChecked options.budget + let attempt := match selected.decision with + | .baseline reason => .error (.target reason) + | .improved target => + match executeSource constants root config options.sourceFuel with + | .error message => .error (.source message) + | .ok source => + if agrees : source.number = target.before.number then + .ok ⟨target, source, agrees⟩ + else .error .sourceMismatch + ⟨selected.inference, attempt⟩ + +def Selection.program {constants root config world eraseFuel lowerFuel options} + {attached : IxIR2.Pipeline.Attached constants root config world eraseFuel lowerFuel} + (selection : Selection attached options) : IxIR2.Program := + match selection.attempt with + | .error _ => attached.target.artifact.program + | .ok improved => improved.target.rewrite.program + +structure Compilation (constants : List (Address × Ixon.Constant)) (root : Address) + (config : Pipeline.Config) (world : Owned) (eraseFuel lowerFuel : Nat) + (options : Options) where + baseline : IxIR2.Pipeline.Attached constants root config world eraseFuel lowerFuel + selection : Selection baseline options + +def compileValidated (constants : List (Address × Ixon.Constant)) (root : Address) + (config : Pipeline.Config) (world : Owned) (checkFuel eraseFuel validateFuel lowerFuel maxDepth : Nat) + (options : Options := {}) : + Except IxIR2.Pipeline.Error (Compilation constants root config world eraseFuel lowerFuel options) := do + let baseline ← IxIR2.Pipeline.compileValidated constants root config world + checkFuel eraseFuel validateFuel lowerFuel maxDepth + pure ⟨baseline, select baseline options⟩ + +theorem Improved.sourcePreservation {constants root config world eraseFuel lowerFuel options} + {attached : IxIR2.Pipeline.Attached constants root config world eraseFuel lowerFuel} + (result : Improved attached options) : + Ixon.Eval.eval (Pipeline.validatedEvalCtx constants config) options.sourceFuel + (Pipeline.validatedMainFrame root) [] Pipeline.validatedMainSource = + .ok (.litV (.natL result.source.number)) ∧ + IxIR2.Borrow.run attached.target.artifact.validationContext options.budget + result.target.rewrite.program = .ok result.target.after.result ∧ + result.target.after.result.value = .lit (.nat result.source.number) := by + refine ⟨result.source.ran, result.target.after.ran, ?_⟩ + rw [result.target.after.scalar, result.agrees, result.target.same] + +theorem Improved.resources {constants root config world eraseFuel lowerFuel options} + {attached : IxIR2.Pipeline.Attached constants root config world eraseFuel lowerFuel} + (result : Improved attached options) : + IxIR2.Borrow.Reclaimed result.target.before.result.store ∧ + IxIR2.Borrow.Reclaimed result.target.after.result.store ∧ + result.target.after.result.store.heap.rcops < result.target.before.result.store.heap.rcops ∧ + result.target.after.result.store.peakLiveNodes ≤ result.target.before.result.store.peakLiveNodes := + result.target.resources + +theorem Selection.valid {constants root config world eraseFuel lowerFuel options} + {attached : IxIR2.Pipeline.Attached constants root config world eraseFuel lowerFuel} + (selection : Selection attached options) : + IxIR2.Validate.Valid attached.target.artifact.validationContext selection.program := by + cases h : selection.attempt with + | error _ => + simpa [Selection.program, h] using + (show IxIR2.Validate.Valid attached.target.artifact.validationContext + attached.target.artifact.program from ⟨attached.target.stats, attached.target.accepted⟩) + | ok improved => + simpa [Selection.program, h, Options.limits, IxIR2.Validate.Valid] using + improved.target.rewrite.valid + +theorem Selection.fallbackExact {constants root config world eraseFuel lowerFuel options} + {attached : IxIR2.Pipeline.Attached constants root config world eraseFuel lowerFuel} + (selection : Selection attached options) {reason : Fallback} + (fallback : selection.attempt = .error reason) : + selection.program = attached.target.artifact.program := by + simp [Selection.program, fallback] + +end Ix.Compiler.Borrow diff --git a/Ix/Compiler/Borrow/Report.lean b/Ix/Compiler/Borrow/Report.lean new file mode 100644 index 000000000..e718e7ce3 --- /dev/null +++ b/Ix/Compiler/Borrow/Report.lean @@ -0,0 +1,148 @@ +import Ix.Compiler.Borrow.Pipeline +import Ix.Compiler.Borrow.Sources +import Ix.Compiler.IxIR2.Borrow.Examples +import Ix.Compiler.Coverage.Run +import Ix.Compiler.Coverage.HeapSnapshot + +namespace Ix.Compiler.Borrow + +open Lean Ix.Compiler.Ixon + +deriving instance ToJson for IxIR2.Borrow.Summary +deriving instance ToJson for IxIR2.Borrow.Inference +deriving instance ToJson for IxIR2.Borrow.Budget +deriving instance ToJson for Options + +def resultJson (result : IxIR2.Eval.Result) : Json := + Json.mkObj [("value", toJson result.value), ("store", toJson result.store), + ("control_remaining", toJson result.controlRemaining), ("heap_remaining", toJson result.heapRemaining)] + +def programSize (program : IxIR2.Program) : Json := + let functions := program.main :: program.declarations.filterMap fun + | (_, .fn definition) => some definition + | _ => none + Json.mkObj [("declarations", toJson program.declarations.length), + ("blocks", toJson (functions.foldl (fun n f => n + f.blocks.size) 0)), + ("instructions", toJson (functions.foldl (fun n f => + n + f.blocks.foldl (fun n b => n + b.instructions.size) 0) 0))] + +private def controlJson (program : IxIR2.Program) (control : IxIR2.Eval.Control) : + Except String Json := do + match control with + | .halted value => pure (Json.mkObj [("halted", toJson value)]) + | .running frame stack => + let owner ← if frame.definition == program.main then pure "main" else do + let some entry := program.declarations.find? fun entry => + match entry.2 with | .fn definition => definition == frame.definition | _ => false + | throw "execution frame does not belong to the compiled program" + pure entry.1.toHex + pure (Json.mkObj [("owner", toJson owner), ("block", toJson frame.block), + ("pc", toJson frame.pc), ("values", toJson frame.values), ("stack_depth", toJson stack.length)]) + +/-- Complete heap slots and frame values at every actual evaluator step. +The terminal state must agree with the proof-carrying replay result. -/ +def prefixesFrom (context : IxIR2.Validate.Context) (budget : IxIR2.Borrow.Budget) + (program : IxIR2.Program) (initial : IxIR2.Eval.Machine) (result : IxIR2.Eval.Result) : Except String Json := do + let mut machine := initial + let mut rows := #[] + for step in [:budget.control + 1] do + rows := rows.push (Json.mkObj [("step", toJson step), ("store", toJson machine.store), + ("heap_remaining", toJson machine.heapFuel), ("control", ← controlJson program machine.control)]) + match machine.control with + | .halted value => + if toJson machine.store != toJson result.store || toJson value != toJson result.value || + machine.heapFuel != result.heapRemaining || step + result.controlRemaining != budget.control then + throw "execution-prefix terminal state differs from the checked replay" + return Json.arr rows + | .running .. => + machine ← (IxIR2.Eval.step (IxIR2.Eval.Context.ofProgram program context.schemas) + .physical machine).mapError (fun error => s!"prefix execution: {repr error}") + throw "execution-prefix budget exhausted" + +def prefixes (context : IxIR2.Validate.Context) (budget : IxIR2.Borrow.Budget) + (program : IxIR2.Program) (result : IxIR2.Eval.Result) : Except String Json := + prefixesFrom context budget program (IxIR2.Eval.initialMachine program.main #[] budget.heap) result + +def nativeBoundary (program : IxIR2.Program) : Except String String := + match X86.Select.select program with + | .error (.invalidSource (.invalid _ .schema "missing constructor schema")) => + .ok "missingConstructorSchema" + | .error error => .error s!"unexpected scalar selector boundary: {repr error}" + | .ok _ => .error "borrowed heap chain unexpectedly became natively selectable" + +structure CaseResult where + name : String + row : Json + snapshot : Json + compileMs : Nat + borrowMs : Nat + +private def checked {α : Type} (value : Except String α) : IO α := + match value with + | .ok result => pure result + | .error message => throw (IO.userError message) + +private def fallbacks (source : Coverage.Source) (attached : source.Attached) : + Except String Json := do + let mut rows := #[] + for (name, options) in [ + ("inference-budget", ({ maxAttempts := 0 } : Options)), + ("target-replay-budget", { budget := { control := 0 } }), + ("source-replay-budget", { sourceFuel := 0 })] do + let selected := select attached options + let .error reason := selected.attempt | throw s!"{name}: missing checked fallback" + if selected.program != attached.target.artifact.program then + throw s!"{name}: fallback changed the checked baseline" + rows := rows.push (Json.mkObj [("name", toJson name), ("options", toJson options), + ("reason", toJson (reprStr reason)), ("program", toJson selected.program)]) + return Json.arr rows + +def runCase (depth : Nat) (successorCase : Bool) : IO CaseResult := do + let source ← checked (Examples.source depth successorCase) + let number := if successorCase then 22 else 11 + let start ← IO.monoMsNow + let attached ← checked (source.compile.mapError (fun error => s!"source compilation: {repr error}")) + let compiled ← IO.monoMsNow + let selection := select attached + let improved ← checked (selection.attempt.mapError (fun error => s!"borrow selection: {repr error}")) + let borrowed ← IO.monoMsNow + let before := improved.target.before.result + let after := improved.target.after.result + let program := improved.target.rewrite.program + let baseline := attached.target.artifact.program + let context := attached.target.artifact.validationContext + let observations ← checked (source.observe attached number) + if improved.source.number != number || before.store.heap.rcops != 5 || after.store.heap.rcops != 3 || + before.store.heap.allocs != 3 || after.store.heap.allocs != 3 || + before.store.peakLiveNodes != 2 || after.store.peakLiveNodes != 2 || + improved.target.rewrite.summaries.length != depth + 3 then + throw (IO.userError "borrow witness result, RC, peak, or inferred ABI count drifted") + let nativeBefore ← checked (nativeBoundary baseline) + let nativeAfter ← checked (nativeBoundary program) + let fallback ← if depth == 0 && !successorCase then checked (fallbacks source attached) + else pure (toJson (#[] : Array Json)) + let beforePrefixes ← checked (prefixes context {} baseline before) + let afterPrefixes ← checked (prefixes context {} program after) + let row := Json.mkObj [ + ("name", toJson source.name), ("depth", toJson depth), ("successor", toJson successorCase), + ("origin", toJson "synthetic-ixon"), ("source_root", toJson source.root), + ("number", toJson number), ("snapshot", toJson s!"{source.name}.json"), + ("baseline", toJson before.store.counters), ("borrowed", toJson after.store.counters), + ("baseline_size", programSize baseline), ("borrowed_size", programSize program), + ("inference", toJson selection.inference), + ("baseline_control_steps", toJson (1000 - before.controlRemaining)), + ("borrowed_control_steps", toJson (1000 - after.controlRemaining)), + ("baseline_heap_work", toJson (1000 - before.heapRemaining)), + ("borrowed_heap_work", toJson (1000 - after.heapRemaining)), + ("native_baseline", toJson nativeBefore), ("native_borrowed", toJson nativeAfter)] + let snapshot := Json.mkObj [ + ("format", toJson "compilatrix/source-borrow-case/1"), ("summary", row), + ("compilation", source.compilationSnapshot attached), ("options", toJson ({} : Options)), + ("rewritten", toJson program), ("validation_stats", toJson improved.target.rewrite.checked.stats), + ("observations", observations.stages), ("baseline_execution", resultJson before), + ("borrowed_execution", resultJson after), ("baseline_prefixes", beforePrefixes), + ("borrowed_prefixes", afterPrefixes), ("fallbacks", fallback)] + return { name := source.name, row, snapshot + compileMs := compiled - start, borrowMs := borrowed - compiled } + +end Ix.Compiler.Borrow diff --git a/Ix/Compiler/Borrow/Runtime.lean b/Ix/Compiler/Borrow/Runtime.lean new file mode 100644 index 000000000..644e32951 --- /dev/null +++ b/Ix/Compiler/Borrow/Runtime.lean @@ -0,0 +1,92 @@ +import Ix.Compiler.Borrow.RuntimeSource + +/-! Ordinary validated source compilation followed by optional structural +borrow certification. Options contain only compiler/checker work limits; +runtime arguments and evaluation fuel are absent from selection. -/ + +namespace Ix.Compiler.Borrow.Runtime + +open Ix.Compiler.Ixon (Address) + +structure Options where + maxCandidates : Nat := 32 + maxRounds : Nat := 16 + maxAttempts : Nat := 256 + maxSourceDepth : Nat := 32 + policy : IxIR2.Borrow.Open.Policy := {} + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr + +def Options.limits (options : Options) : IxIR2.Borrow.Limits := + { maxCandidates := options.maxCandidates, maxRounds := options.maxRounds, maxAttempts := options.maxAttempts } + +structure Certified {constants root config eraseFuel lowerFuel} + (attached : IxIR2.Pipeline.Attached constants root config .shared eraseFuel lowerFuel) (options : Options) where + target : IxIR2.Borrow.Open.Certificate options.limits attached.target.artifact.validationContext attached.target.artifact.program + source : Source.Shape attached.source.erasure.result.raw (.ref root) target.schema.zeroResult target.schema.succResult + sameDepth : source.chain.depth = target.entry.beforeBody.depth + +inductive Rejection where + | target (reason : IxIR2.Borrow.Open.Rejection) + | source + | depth + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr + +structure Selection {constants root config eraseFuel lowerFuel} + (attached : IxIR2.Pipeline.Attached constants root config .shared eraseFuel lowerFuel) (options : Options) where + inference : IxIR2.Borrow.Inference + attempt : Except Rejection (Certified attached options) + +def select {constants root config eraseFuel lowerFuel} + (attached : IxIR2.Pipeline.Attached constants root config .shared eraseFuel lowerFuel) + (options : Options := {}) : Selection attached options := + let checked : IxIR2.Validate.Checked options.limits.validator + attached.target.artifact.validationContext attached.target.artifact.program := + ⟨attached.target.stats, attached.target.accepted⟩ + let target := IxIR2.Borrow.Open.optimize checked options.policy + let attempt := do + let target ← target.attempt.mapError Rejection.target + let some source := Source.recognize attached.source.erasure.result.raw (.ref root) + target.schema.zeroResult target.schema.succResult options.maxSourceDepth | throw .source + if sameDepth : source.chain.depth = target.entry.beforeBody.depth then + pure (⟨target, source, sameDepth⟩ : Certified attached options) + else throw .depth + ⟨target.inference, attempt⟩ + +def Selection.program {constants root config eraseFuel lowerFuel options} + {attached : IxIR2.Pipeline.Attached constants root config .shared eraseFuel lowerFuel} + (selection : Selection attached options) : IxIR2.Program := + match selection.attempt with + | .ok certified => certified.target.rewrite.program + | .error _ => attached.target.artifact.program + +structure Compilation (constants : List (Address × Ixon.Constant)) (root : Address) (config : Pipeline.Config) + (eraseFuel lowerFuel : Nat) (options : Options) where + baseline : IxIR2.Pipeline.Attached constants root config .shared eraseFuel lowerFuel + selection : Selection baseline options + +def compileValidated (constants : List (Address × Ixon.Constant)) (root : Address) (config : Pipeline.Config) + (checkFuel eraseFuel validateFuel lowerFuel maxDepth : Nat) (options : Options := {}) : + Except IxIR2.Pipeline.Error (Compilation constants root config eraseFuel lowerFuel options) := do + let baseline ← IxIR2.Pipeline.compileValidated constants root config .shared + checkFuel eraseFuel validateFuel lowerFuel maxDepth + return ⟨baseline, select baseline options⟩ + +theorem Selection.valid {constants root config eraseFuel lowerFuel options} + {attached : IxIR2.Pipeline.Attached constants root config .shared eraseFuel lowerFuel} + (selection : Selection attached options) : + IxIR2.Validate.Valid attached.target.artifact.validationContext selection.program := by + cases h : selection.attempt with + | error _ => + simpa [Selection.program, h] using + (show IxIR2.Validate.Valid attached.target.artifact.validationContext attached.target.artifact.program from + ⟨attached.target.stats, attached.target.accepted⟩) + | ok result => + simpa [Selection.program, h, Options.limits, IxIR2.Validate.Valid] using result.target.rewrite.valid + +theorem Selection.fallbackExact {constants root config eraseFuel lowerFuel options} + {attached : IxIR2.Pipeline.Attached constants root config .shared eraseFuel lowerFuel} + (selection : Selection attached options) {reason : Rejection} + (fallback : selection.attempt = .error reason) : selection.program = attached.target.artifact.program := by + simp [Selection.program, fallback] + +end Ix.Compiler.Borrow.Runtime diff --git a/Ix/Compiler/Borrow/RuntimeInput.lean b/Ix/Compiler/Borrow/RuntimeInput.lean new file mode 100644 index 000000000..fbf865c16 --- /dev/null +++ b/Ix/Compiler/Borrow/RuntimeInput.lean @@ -0,0 +1,132 @@ +import Ix.Compiler.Borrow.RuntimeSim + +/-! Caller-side input construction, separate from the compiler and selector. +The construction proof covers every finite constructor chain and scalar +payload, not only the regression matrix. -/ + +namespace Ix.Compiler.Borrow.Runtime + +open Ix.Compiler.Ixon (Address) +open IxIR2.Eval +open IxIR2.Borrow.Open (Schema Major Input) +open Ix.Compiler.IxIR1.Sim (RootOwnership rootsFor nodeChildren) +open Ix.Compiler.IxIR1.Reclamation (AllocationOrderInvariant) + +inductive Tree where + | scalar (value : Nat) + | zero + | succ (tail : Tree) + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr + +def Tree.nodes : Tree → Nat + | .scalar _ => 0 + | .zero => 1 + | .succ tail => tail.nodes + 1 + +def Tree.nested : Nat → Tree → Tree + | 0, tail => tail + | count + 1, tail => .succ (nested count tail) + +def Tree.make (schema : Schema) : Tree → Store × RVal + | .scalar value => ({}, .lit (.nat value)) + | .zero => + let allocated := ({} : Store).allocNode .shared (.ctorN schema.zero #[]) + (allocated.1, .loc allocated.2) + | .succ tail => + let input := tail.make schema + let allocated := input.1.allocNode .shared (.ctorN schema.succ #[input.2]) + (allocated.1, .loc allocated.2) + +def Tree.sourceValue (block : Address) : Tree → Ixon.Eval.Value + | .scalar value => .litV (.natL value) + | .zero => .ctorV block 0 0 [] + | .succ tail => .ctorV block 0 1 [tail.sourceValue block] + +def Tree.rawValue (schema : Schema) : Tree → IxIR0.Value + | .scalar value => .lit (.nat value) + | .zero => .ctor schema.zero.block 0 [] + | .succ tail => .ctor schema.succ.block 1 [tail.rawValue schema] + +structure Ready (store : Store) (value : RVal) : Prop where + owned : RootOwnership store.heap [⟨.shared, value⟩] + ordered : AllocationOrderInvariant store.heap + accounted : store.heap.allocs = store.live + store.heap.frees + peak : store.live ≤ store.peakLiveNodes + +private theorem allocatedReady (store : Store) (cid : IxIR2.CtorId) (values : Array RVal) + (owned : RootOwnership store.heap (rootsFor .shared values.toList)) + (ordered : AllocationOrderInvariant store.heap) + (accounted : store.heap.allocs = store.live + store.heap.frees) : + Ready (store.allocNode .shared (.ctorN cid values)).1 (.loc (store.allocNode .shared (.ctorN cid values)).2) := by + have children : ∀ child ∈ nodeChildren (.ctorN cid values), IxIR1.Sim.LiveRVal store.heap child := by + intro child member + exact IxIR2.CreditRefinement.live_of_world + (owned.roots_world ⟨.shared, child⟩ (by simpa [rootsFor, nodeChildren] using member)) + refine ⟨?_, ordered.allocNode children, ?_, ?_⟩ + · exact RootOwnership.allocNode (rest := []) (by simpa [nodeChildren] using owned) trivial + · rw [Store.live_allocNode] + simp only [Store.allocNode_heap, IxIR1.Store.allocNode] + omega + · rw [Store.peakLive_allocNode] + exact Nat.le_max_right _ _ + +theorem Tree.ready (schema : Schema) (tree : Tree) : Ready (tree.make schema).1 (tree.make schema).2 := by + induction tree with + | scalar value => + exact ⟨RootOwnership.addNoLocation rfl RootOwnership.empty, .empty, rfl, Nat.le_refl _⟩ + | zero => + exact allocatedReady {} schema.zero #[] RootOwnership.empty .empty rfl + | succ tail ih => + exact allocatedReady (tail.make schema).1 schema.succ #[(tail.make schema).2] + (by simpa [rootsFor] using ih.owned) ih.ordered ih.accounted + +theorem Tree.counts (schema : Schema) (tree : Tree) : + (tree.make schema).1.heap.allocs = tree.nodes ∧ + (tree.make schema).1.heap.frees = 0 ∧ + (tree.make schema).1.heap.rcops = 0 ∧ + (tree.make schema).1.live = tree.nodes ∧ + (tree.make schema).1.peakLiveNodes = tree.nodes := by + induction tree with + | scalar => exact ⟨rfl, rfl, rfl, rfl, rfl⟩ + | zero => exact ⟨rfl, rfl, rfl, rfl, rfl⟩ + | succ tail ih => + rcases ih with ⟨allocs, frees, rcops, live, peak⟩ + refine ⟨?_, frees, rcops, ?_, ?_⟩ + · simp [Tree.make, Tree.nodes, IxIR1.Store.allocNode, allocs] + · simpa [Tree.make, Tree.nodes, Store.live_allocNode] using live + · simp only [Tree.make, Store.peakLive_allocNode, Store.live_allocNode, peak, live, Tree.nodes] + omega + +inductive Argument where + | zero + | succ (payload : Tree) + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr + +def Argument.tree : Argument → Tree + | .zero => .zero + | .succ payload => .succ payload + +def Argument.make (schema : Schema) : Argument → Store × Nat + | .zero => ({} : Store).allocNode .shared (.ctorN schema.zero #[]) + | .succ payload => + let input := payload.make schema + input.1.allocNode .shared (.ctorN schema.succ #[input.2]) + +def Argument.major (schema : Schema) : Argument → Major + | .zero => .zero + | .succ payload => .succ (payload.make schema).2 + +def Argument.source (schema : Schema) : Argument → Source.Argument + | .zero => .zero schema.zero.block + | .succ payload => .succ schema.succ.block (payload.rawValue schema) + +theorem Argument.input (schema : Schema) (argument : Argument) : + Input schema (argument.major schema) (argument.make schema).1 (argument.make schema).2 1 := by + have ready := argument.tree.ready schema + cases argument with + | zero => + exact ⟨IxIR1.Sim.HeapIso.get?_allocNode_new .., ready.owned, ready.ordered, ready.accounted, ready.peak⟩ + | succ payload => + exact ⟨IxIR1.Sim.HeapIso.get?_allocNode_new .., ready.owned, ready.ordered, ready.accounted, ready.peak⟩ + +end Ix.Compiler.Borrow.Runtime diff --git a/Ix/Compiler/Borrow/RuntimeReport.lean b/Ix/Compiler/Borrow/RuntimeReport.lean new file mode 100644 index 000000000..dd9240d11 --- /dev/null +++ b/Ix/Compiler/Borrow/RuntimeReport.lean @@ -0,0 +1,199 @@ +import Ix.Compiler.Borrow.RuntimeInput +import Ix.Compiler.Borrow.Report + +namespace Ix.Compiler.Borrow.Runtime + +open Lean +open Ix.Compiler.Ixon (Address) +open IxIR2.Eval +open IxIR2.Borrow.Open (Schema) + +deriving instance ToJson for IxIR2.Borrow.Open.Schema +deriving instance ToJson for IxIR2.Borrow.Open.Policy +deriving instance ToJson for Options +deriving instance ToJson for Tree +deriving instance ToJson for Argument + +def inputs : Array (String × Argument) := #[ + ("zero", .zero), + ("succ-0", .succ (.scalar 0)), + ("succ-1", .succ (.scalar 1)), + ("succ-wide", .succ (.scalar (2 ^ 256 + 19))), + ("nested-zero-1", .succ .zero), + ("nested-zero-8", .succ (Tree.nested 7 .zero)), + ("nested-zero-32", .succ (Tree.nested 31 .zero)), + ("nested-scalar-17", .succ (Tree.nested 16 (.scalar 4096)))] + +/-- A caller adapter exercises exact PAP saturation of the preserved owned +export. Its construction is separate from source compilation and selection. -/ +def dynamicCaller (entry : Address) : IxIR2.Function := + { signature := { params := #[{ world := .shared, passing := .owned }], result := .shared, papSafe := false } + blocks := #[{ + valueParams := #[.owned .shared], creditParams := #[] + instructions := #[.papp entry #[], .apply (.reg 1) #[.reg 0]] + terminator := .ret (.reg 2) }] } + +def callerAddress : Address := .replicate 240 + +def withCaller (program : IxIR2.Program) (entry : Address) : IxIR2.Program := + { program with declarations := program.declarations ++ [(callerAddress, .fn (dynamicCaller entry))] } + +private def checked {α : Type} (value : Except String α) : IO α := + match value with + | .ok result => pure result + | .error message => throw (IO.userError message) + +private def run (validation : IxIR2.Validate.Context) (program : IxIR2.Program) + (definition : IxIR2.Function) (argument : RVal) (store : Store) : Except String Result := + (runFunction (.ofProgram program validation.schemas) .physical definition #[argument] 1000 1000 store).mapError reprStr + +private def sourceNumber (source : Coverage.Source) (block : Address) (argument : Argument) : Except String Nat := do + let ctx := Pipeline.validatedEvalCtx source.constants source.config + let function ← (Ixon.Eval.eval ctx 1000 (Pipeline.validatedMainFrame source.root) [] Pipeline.validatedMainSource).mapError reprStr + let result ← (Ixon.Eval.apply ctx 1000 function (argument.tree.sourceValue block)).mapError reprStr + let .litV (.natL number) := result | throw "runtime Ixon application did not return a Nat literal" + return number + +private def rawNumber {constants root config eraseFuel lowerFuel options} + {attached : IxIR2.Pipeline.Attached constants root config .shared eraseFuel lowerFuel} + (certified : Certified attached options) (argument : Argument) : Except String Nat := do + let ctx : IxIR0.Ctx := { env := IxIR0.Env.ofList attached.source.erasure.result.raw } + let function ← (IxIR0.eval ctx 1000 [] (.ref root)).mapError reprStr + let result ← (IxIR0.apply ctx 1000 function (argument.source certified.target.schema).value).mapError reprStr + let .lit (.nat number) := result | throw "runtime raw IxIR0 application did not return a Nat literal" + return number + +private def executeInput {constants root config eraseFuel lowerFuel options} + {attached : IxIR2.Pipeline.Attached constants root config .shared eraseFuel lowerFuel} + (certified : Certified attached options) (source : Coverage.Source) + (dataBlock : Address) (name : String) (argument : Argument) : Except String Json := do + let schema := certified.target.schema + let input := argument.make schema + let value : RVal := .loc input.2 + let expected := (argument.major schema).result schema + let ixon ← sourceNumber source dataBlock argument + let raw ← rawNumber certified argument + if ixon != expected || raw != expected then throw "runtime source result disagrees with the structural certificate" + let validation := attached.target.artifact.validationContext + let baseline := attached.target.artifact.program + let rewritten := certified.target.rewrite.program + let entry := certified.target.entry + let mut paths := #[] + for dynamic in [false, true] do + let beforeProgram := if dynamic then withCaller baseline entry.summary.owner else baseline + let afterProgram := if dynamic then withCaller rewritten entry.summary.owner else rewritten + if dynamic then + let _ ← (IxIR2.Validate.validate validation beforeProgram).mapError reprStr + let _ ← (IxIR2.Validate.validate validation afterProgram).mapError reprStr + let beforeDefinition := if dynamic then dynamicCaller entry.summary.owner else entry.before + let afterDefinition := if dynamic then dynamicCaller entry.summary.owner else IxIR2.Borrow.ownedWrapper entry.summary.borrowed entry.before + let before ← run validation beforeProgram beforeDefinition value input.1 + let after ← run validation afterProgram afterDefinition value input.1 + let beforePrefixes ← Borrow.prefixesFrom validation {} beforeProgram + (initialMachine beforeDefinition #[value] 1000 input.1) before + let afterPrefixes ← Borrow.prefixesFrom validation {} afterProgram + (initialMachine afterDefinition #[value] 1000 input.1) after + let allocations := argument.tree.nodes + (if dynamic then 1 else 0) + let extra := if dynamic then 3 else 0 + if before.value != .lit (.nat expected) || after.value != before.value || + before.store.heap.rcops != after.store.heap.rcops + 2 || + before.store.heap.allocs != allocations || after.store.heap.allocs != allocations || + before.store.heap.frees != allocations || after.store.heap.frees != allocations || + before.store.live != 0 || after.store.live != 0 || + before.store.peakLiveNodes != allocations || after.store.peakLiveNodes != allocations || + 1000 - before.controlRemaining != entry.beforeBody.ownedCost (argument.major schema).fieldCost + extra || + 1000 - after.controlRemaining != entry.afterBody.readCost (argument.major schema).fieldCost + 3 + extra || + before.heapRemaining + 1 != after.heapRemaining then + throw "open borrowed execution drifted from its structural cost/resource laws" + paths := paths.push (Json.mkObj [ + ("kind", toJson (if dynamic then "dynamic" else "direct")), + ("baseline", Borrow.resultJson before), ("borrowed", Borrow.resultJson after), + ("baseline_prefixes", beforePrefixes), ("borrowed_prefixes", afterPrefixes)]) + return Json.mkObj [ + ("name", toJson name), ("argument", toJson argument), ("input_store", toJson input.1), + ("input_value", toJson value), ("nodes", toJson argument.tree.nodes), ("number", toJson expected), + ("ixon", toJson ixon), ("raw_ixir0", toJson raw), ("paths", toJson paths)] + +private def lender {constants root config eraseFuel lowerFuel options} + {attached : IxIR2.Pipeline.Attached constants root config .shared eraseFuel lowerFuel} + (certified : Certified attached options) : Except String Json := do + let argument : Argument := .succ (Tree.nested 7 .zero) + let input := argument.make certified.target.schema + let value : RVal := .loc input.2 + let retained ← (retainShared input.1 value >>= (retainShared · value)).mapError reprStr + let validation := attached.target.artifact.validationContext + let program := certified.target.rewrite.program + let result ← run validation program certified.target.entry.after value retained + let trace ← Borrow.prefixesFrom validation {} program + (initialMachine certified.target.entry.after #[value] 1000 retained) result + if toJson result.store != toJson retained || result.value != .lit (.nat certified.target.schema.succResult) then + throw "borrowed entry changed the caller's aliased lender" + let mut cleanup := result.store + let mut fuel := result.heapRemaining + for _ in [:3] do + let released ← (releaseShared fuel cleanup value).mapError reprStr + cleanup := released.1 + fuel := released.2 + if cleanup.live != 0 || cleanup.heap.allocs != cleanup.heap.frees then + throw "caller could not reclaim the returned lender" + return Json.mkObj [ + ("argument", toJson argument), ("owners", toJson (3 : Nat)), + ("input_store", toJson retained), ("input_value", toJson value), + ("execution", Borrow.resultJson result), ("prefixes", trace), + ("cleanup_store", toJson cleanup), ("cleanup_remaining", toJson fuel)] + +private def fallbacks {constants root config eraseFuel lowerFuel} + (attached : IxIR2.Pipeline.Attached constants root config .shared eraseFuel lowerFuel) : Except String Json := do + let mut rows := #[] + for (name, options) in [ + ("disabled", ({ policy := { enabled := false } } : Options)), + ("inference-budget", { maxAttempts := 0 }), + ("target-structure-budget", { policy := { maxDepth := 0 } }), + ("source-structure-budget", { maxSourceDepth := 0 })] do + let selected := select attached options + let .error reason := selected.attempt | throw s!"{name}: fallback was not selected" + if selected.program != attached.target.artifact.program then throw s!"{name}: fallback changed baseline" + rows := rows.push (Json.mkObj [("name", toJson name), ("options", toJson options), + ("reason", toJson (reprStr reason)), ("program", toJson selected.program)]) + return toJson rows + +structure CaseResult where + name : String + row : Json + snapshot : Json + compileMs : Nat + checkMs : Nat + +def runCase (depth : Nat) : IO CaseResult := do + let source ← checked (Runtime.source depth) + let started ← IO.monoMsNow + let attached ← checked (source.compile.mapError reprStr) + let compiled ← IO.monoMsNow + let selection := select attached + let certified ← checked (selection.attempt.mapError reprStr) + let selected ← IO.monoMsNow + if certified.target.rewrite.summaries.length != depth + 2 || certified.source.chain.depth != depth then + throw (IO.userError "runtime summary or source chain depth drifted") + let some block := source.constants[0]? | throw (IO.userError "missing source declaration group") + let observations ← checked (inputs.mapM fun (name, argument) => executeInput certified source block.1 name argument) + let lender ← checked (lender certified) + let fallbacks ← checked (fallbacks attached) + let nativeBefore ← checked (Borrow.nativeBoundary attached.target.artifact.program) + let nativeAfter ← checked (Borrow.nativeBoundary certified.target.rewrite.program) + let row := Json.mkObj [ + ("name", toJson source.name), ("depth", toJson depth), ("source_root", toJson source.root), + ("snapshot", toJson s!"{source.name}.json"), ("origin", toJson "synthetic-ixon"), + ("entry", toJson certified.target.entry.summary.owner), ("borrowed_entry", toJson certified.target.entry.summary.borrowed), + ("factory", toJson certified.target.exported.factoryAddress), ("schema", toJson certified.target.schema), + ("inference", toJson selection.inference), + ("baseline_size", Borrow.programSize attached.target.artifact.program), + ("borrowed_size", Borrow.programSize certified.target.rewrite.program), + ("runtime_inputs", toJson observations.size), ("native_baseline", toJson nativeBefore), ("native_borrowed", toJson nativeAfter)] + let snapshot := Json.mkObj [ + ("format", toJson "compilatrix/source-borrow-runtime-case/1"), ("summary", row), + ("compilation", source.compilationSnapshot attached), ("rewritten", toJson certified.target.rewrite.program), + ("options", toJson ({} : Options)), ("validation_stats", toJson certified.target.rewrite.checked.stats), + ("observations", toJson observations), ("lender", lender), ("fallbacks", fallbacks)] + return { name := source.name, row, snapshot, compileMs := compiled - started, checkMs := selected - compiled } + +end Ix.Compiler.Borrow.Runtime diff --git a/Ix/Compiler/Borrow/RuntimeSim.lean b/Ix/Compiler/Borrow/RuntimeSim.lean new file mode 100644 index 000000000..55afa7cd4 --- /dev/null +++ b/Ix/Compiler/Borrow/RuntimeSim.lean @@ -0,0 +1,166 @@ +import Ix.Compiler.Borrow.Runtime +import Ix.Compiler.SimApply + +namespace Ix.Compiler.Borrow.Runtime + +open Ix.Compiler.Ixon (Address) +open Ix.Compiler.IxIR0.Recursion (Evaluates Applies) + +private theorem frameWF (root : Address) : (Pipeline.validatedMainFrame root).SharingWF := by + constructor + · rfl + · intro index member found + simp [Pipeline.validatedMainFrame] at found + +/-- Project the actual source compiler's erasure certificate, including its +mutual-member scope. No source execution is performed by selection. -/ +theorem erasureFunction {constants root config eraseFuel lowerFuel} + (attached : IxIR2.Pipeline.Attached constants root config .shared eraseFuel lowerFuel) + {fuel : Nat} {function : Ixon.Eval.Value} + (oracles : @Sim.OracleRel attached.source.memberScope + (Pipeline.validatedEvalCtx constants config).inlineSharing + { env := IxIR0.Env.ofList attached.source.erasure.result.raw }) + (contextWF : (Pipeline.validatedEvalCtx constants config).SharingWF) + (evaluated : Ixon.Eval.eval (Pipeline.validatedEvalCtx constants config) fuel + (Pipeline.validatedMainFrame root) [] Pipeline.validatedMainSource = .ok function) : + ∃ targetFuel targetFunction, + IxIR0.eval { env := IxIR0.Env.ofList attached.source.erasure.result.raw } + targetFuel [] (.ref root) = .ok targetFunction ∧ + @Sim.InlinedValRel (Pipeline.validatedEvalCtx constants config) + { env := IxIR0.Env.ofList attached.source.erasure.result.raw } + function targetFunction attached.source.memberScope := by + letI : Sim.MemberScope := attached.source.memberScope + have inlined := Ixon.Eval.eval_inlineSharing contextWF (frameWF root) .nil + (by rfl) evaluated + have entry := attached.source.entry.related + rw [EraseValidator.inlineTables_tablesOfFrame] at entry + obtain ⟨fuel, value, run, related⟩ := Sim.erasure_sim_with_members + attached.source.members oracles inlined.1 entry (by + simpa [Ixon.Eval.valuesInlineSharing] using + (Sim.EnvRel.nil (ectx := (Pipeline.validatedEvalCtx constants config).inlineSharing) + (ictx := { env := IxIR0.Env.ofList attached.source.erasure.result.raw }) + (refs := (Pipeline.validatedMainFrame root).inlineSharing.refs) + (muts := (Pipeline.validatedMainFrame root).inlineSharing.selfMuts) + (sa := (Pipeline.validatedMainFrame root).inlineSharing.selfAddr))) + rw [attached.source.entryTarget] at run + exact ⟨fuel, value, run, related⟩ + +private theorem applies_unique {ctx : IxIR0.Ctx} {function argument left right : IxIR0.Value} + (first : Applies ctx function argument left) (second : Applies ctx function argument right) : left = right := by + obtain ⟨a, ha⟩ := first + obtain ⟨b, hb⟩ := second + have ha' := IxIR0.apply_mono (fuel' := a + b) (by omega) ha + have hb' := IxIR0.apply_mono (fuel' := a + b) (by omega) hb + exact Except.ok.inj (ha'.symm.trans hb') + +/-- Source preservation on every represented argument. Sharing and oracle +premises are the existing erasure boundary; the function/application proof +comes from the checked source graph and never from a supplied callback. -/ +theorem Certified.sourcePreservation {constants root config eraseFuel lowerFuel options} + {attached : IxIR2.Pipeline.Attached constants root config .shared eraseFuel lowerFuel} + (certified : Certified attached options) (argument : Source.Argument) + {functionFuel applyFuel : Nat} {function sourceArgument result : Ixon.Eval.Value} + (oracles : @Sim.OracleRel attached.source.memberScope + (Pipeline.validatedEvalCtx constants config).inlineSharing + { env := IxIR0.Env.ofList attached.source.erasure.result.raw }) + (contextWF : (Pipeline.validatedEvalCtx constants config).SharingWF) + (evaluated : Ixon.Eval.eval (Pipeline.validatedEvalCtx constants config) functionFuel + (Pipeline.validatedMainFrame root) [] Pipeline.validatedMainSource = .ok function) + (argumentWF : sourceArgument.SharingWF) + (argumentRel : @Sim.InlinedValRel (Pipeline.validatedEvalCtx constants config) + { env := IxIR0.Env.ofList attached.source.erasure.result.raw } + sourceArgument argument.value attached.source.memberScope) + (applied : Ixon.Eval.apply (Pipeline.validatedEvalCtx constants config) + applyFuel function sourceArgument = .ok result) : + @Sim.InlinedValRel (Pipeline.validatedEvalCtx constants config) + { env := IxIR0.Env.ofList attached.source.erasure.result.raw } + result (.lit (.nat (argument.result certified.target.schema.zeroResult certified.target.schema.succResult))) + attached.source.memberScope := by + letI : Sim.MemberScope := attached.source.memberScope + obtain ⟨_, _, functionRun, functionRel⟩ := erasureFunction attached oracles contextWF evaluated + have functionEq := Evaluates.unique ⟨_, functionRun⟩ certified.source.evaluates + rw [functionEq] at functionRel + have functionWF := (Ixon.Eval.eval_inlineSharing contextWF (frameWF root) .nil (by rfl) evaluated).2 + obtain ⟨_, _, resultRun, resultRel⟩ := Sim.apply_sim_inlineSharing attached.source.members + oracles contextWF functionWF argumentWF applied functionRel argumentRel + have resultEq := applies_unique ⟨_, resultRun⟩ (certified.source.applies argument) + simpa only [resultEq] using resultRel + +/-- The same accepted source function has two actual target executions on +every owned runtime heap in the stated domain. Their scalar results agree, +both reclaim the whole input, and borrowing removes exactly two RC ticks. -/ +theorem Certified.runtimePreservation {constants root config eraseFuel lowerFuel options} + {attached : IxIR2.Pipeline.Attached constants root config .shared eraseFuel lowerFuel} + (certified : Certified attached options) (argument : Source.Argument) (field : IxIR2.Eval.RVal) + {store : IxIR2.Eval.Store} {location rc : Nat} + (input : IxIR2.Borrow.Open.Input certified.target.schema (argument.target field) store location rc) + (mode : IxIR2.Eval.Interpretation) (exit : IxIR2.Borrow.Open.Exit) : + let target := certified.target + let number := argument.result target.schema.zeroResult target.schema.succResult + ∃ fuel output, + IxIR2.Eval.Steps (IxIR2.Borrow.Open.context attached.target.artifact.validationContext attached.target.artifact.program) + mode (target.entry.beforeBody.ownedCost (argument.target field).fieldCost) + (IxIR2.Borrow.Open.start target.entry.before location store (fuel + 2) exit) + (IxIR2.Borrow.Open.finish (IxIR2.Borrow.Open.bump output 2) 0 number exit) ∧ + IxIR2.Eval.Steps (IxIR2.Borrow.Open.context attached.target.artifact.validationContext target.rewrite.program) + mode (target.entry.afterBody.readCost (argument.target field).fieldCost + 3) + (IxIR2.Borrow.Open.start (IxIR2.Borrow.ownedWrapper target.entry.summary.borrowed target.entry.before) + location store (fuel + 1) exit) + (IxIR2.Borrow.Open.finish output 0 number exit) ∧ + IxIR2.Borrow.Open.FullyReleased output ∧ IxIR2.Borrow.Open.FullyReleased (IxIR2.Borrow.Open.bump output 2) ∧ + output.peakLiveNodes = store.peakLiveNodes ∧ output.heap.rcops < (IxIR2.Borrow.Open.bump output 2).heap.rcops := by + simpa only [Source.Argument.target_result] using + certified.target.strictImprovement mode (argument.target field) input exit + +/-- Compose the actual source erasure/application certificate with the two +public target runners. The input relation needs only the observed outer tag; +the ownership contract governs reclamation of the entire target payload. -/ +theorem Certified.sourceToRuntime {constants root config eraseFuel lowerFuel options} + {attached : IxIR2.Pipeline.Attached constants root config .shared eraseFuel lowerFuel} + (certified : Certified attached options) (argument : Source.Argument) (field : IxIR2.Eval.RVal) + {functionFuel applyFuel : Nat} {function sourceArgument result : Ixon.Eval.Value} + (oracles : @Sim.OracleRel attached.source.memberScope + (Pipeline.validatedEvalCtx constants config).inlineSharing + { env := IxIR0.Env.ofList attached.source.erasure.result.raw }) + (contextWF : (Pipeline.validatedEvalCtx constants config).SharingWF) + (evaluated : Ixon.Eval.eval (Pipeline.validatedEvalCtx constants config) functionFuel + (Pipeline.validatedMainFrame root) [] Pipeline.validatedMainSource = .ok function) + (argumentWF : sourceArgument.SharingWF) + (argumentRel : @Sim.InlinedValRel (Pipeline.validatedEvalCtx constants config) + { env := IxIR0.Env.ofList attached.source.erasure.result.raw } + sourceArgument argument.value attached.source.memberScope) + (applied : Ixon.Eval.apply (Pipeline.validatedEvalCtx constants config) + applyFuel function sourceArgument = .ok result) + {store : IxIR2.Eval.Store} {location rc : Nat} + (input : IxIR2.Borrow.Open.Input certified.target.schema (argument.target field) store location rc) + (mode : IxIR2.Eval.Interpretation) : + let target := certified.target + let major := argument.target field + let number := argument.result target.schema.zeroResult target.schema.succResult + ∃ fuel output, + @Sim.InlinedValRel (Pipeline.validatedEvalCtx constants config) + { env := IxIR0.Env.ofList attached.source.erasure.result.raw } + result (.lit (.nat number)) attached.source.memberScope ∧ + IxIR2.Eval.runFunction + (IxIR2.Borrow.Open.context attached.target.artifact.validationContext attached.target.artifact.program) + mode target.entry.before #[.loc location] (target.entry.beforeBody.ownedCost major.fieldCost) + (fuel + 2) store = .ok { + store := IxIR2.Borrow.Open.bump output 2, value := .lit (.nat number) + controlRemaining := 0, heapRemaining := 0 } ∧ + IxIR2.Eval.runFunction + (IxIR2.Borrow.Open.context attached.target.artifact.validationContext target.rewrite.program) + mode (IxIR2.Borrow.ownedWrapper target.entry.summary.borrowed target.entry.before) #[.loc location] + (target.entry.afterBody.readCost major.fieldCost + 3) (fuel + 1) store = .ok { + store := output, value := .lit (.nat number), controlRemaining := 0, heapRemaining := 0 } ∧ + IxIR2.Borrow.Open.FullyReleased output ∧ + IxIR2.Borrow.Open.FullyReleased (IxIR2.Borrow.Open.bump output 2) ∧ + output.peakLiveNodes = store.peakLiveNodes ∧ + (IxIR2.Borrow.Open.bump output 2).heap.rcops = output.heap.rcops + 2 := by + have source := certified.sourcePreservation argument oracles contextWF evaluated argumentWF argumentRel applied + obtain ⟨fuel, output, before, after, clean, beforeClean, peak⟩ := + certified.target.runFunctions mode (argument.target field) input + refine ⟨fuel, output, source, ?_, ?_, clean, beforeClean, peak, rfl⟩ + · simpa only [Source.Argument.target_result] using before + · simpa only [Source.Argument.target_result] using after + +end Ix.Compiler.Borrow.Runtime diff --git a/Ix/Compiler/Borrow/RuntimeSource.lean b/Ix/Compiler/Borrow/RuntimeSource.lean new file mode 100644 index 000000000..efc9037eb --- /dev/null +++ b/Ix/Compiler/Borrow/RuntimeSource.lean @@ -0,0 +1,151 @@ +import Ix.Compiler.Borrow.Sources +import Ix.Compiler.IxIR0.RecursionSim +import Ix.Compiler.IxIR2.Borrow.OpenResources + +namespace Ix.Compiler.Borrow.Runtime + +open Ix.Compiler.Ixon (Address) +open Ix.Compiler.IxIR0 +open Ix.Compiler.IxIR0.Recursion (Evaluates Applies evaluatesDef evaluatesLam evaluatesVar + evaluatesApp evaluatesLet evaluatesLit evaluatesRecursor appliesClosure appliesRecursor) + +/-- The canonical function and constructor declarations contain no runtime +input. Removing B1's closed application also removes its literal payload. -/ +def source (depth : Nat) : Except String Coverage.Source := do + let closed ← Examples.source depth true + let some worker := closed.constants[2]? | throw "borrow source worker is missing" + return { closed with + name := s!"read-tag-runtime-{depth}" + constants := closed.constants.take 5 + root := worker.1 + literals := [11, 22] } + +namespace Source + +def reader (zeroResult succResult : Nat) : Decl := + .recursor 0 false #[{ fields := 0, rhs := .lit (.nat zeroResult) }, + { fields := 1, rhs := .lit (.nat succResult) }] + +def forwardBody (callee : Address) : Expr := .app (.ref callee) (.var 0) + +def twiceBody (callee : Address) : Expr := + .letE .many (.app (.ref callee) (.var 0)) (.app (.ref callee) (.var 1)) + +inductive Chain (env : Env) (zeroResult succResult : Nat) : Address → Type where + | reader (address : Address) (found : env address = some (reader zeroResult succResult)) : + Chain env zeroResult succResult address + | forward (address callee : Address) + (found : env address = some (.defn .shared (.lam .many (forwardBody callee)))) + (tail : Chain env zeroResult succResult callee) : Chain env zeroResult succResult address + +def Chain.depth {env zeroResult succResult address} : Chain env zeroResult succResult address → Nat + | .reader .. => 0 + | .forward _ _ _ tail => tail.depth + 1 + +def Chain.value {env zeroResult succResult address} : Chain env zeroResult succResult address → Value + | .reader address _ => .pap (.rec_ address 1) [] + | .forward _ callee .. => .clos .many [] (forwardBody callee) + +def recognizeChain (env : Env) (zeroResult succResult : Nat) : + Nat → (address : Address) → Option (Chain env zeroResult succResult address) + | 0, _ => none + | fuel + 1, address => + if found : env address = some (reader zeroResult succResult) then + some (.reader address found) + else do + let some (.defn .shared (.lam .many (.app (.ref callee) (.var 0)))) := env address | none + let tail ← recognizeChain env zeroResult succResult fuel callee + if found : env address = some (.defn .shared (.lam .many (forwardBody callee))) then + some (.forward address callee found tail) + else none + +structure Shape (declarations : List (Address × Decl)) (main : Expr) (zeroResult succResult : Nat) where + root : Address + worker : Address + callee : Address + mainEq : main = .ref root + rootAt : Env.ofList declarations root = some (.defn .shared (.ref worker)) + workerAt : Env.ofList declarations worker = some (.defn .shared (.lam .many (twiceBody callee))) + chain : Chain (Env.ofList declarations) zeroResult succResult callee + +def recognize (declarations : List (Address × Decl)) (main : Expr) + (zeroResult succResult fuel : Nat) : Option (Shape declarations main zeroResult succResult) := do + let .ref root := main | none + let env := Env.ofList declarations + let some (.defn .shared (.ref worker)) := env root | none + let some (.defn .shared (.lam .many (.letE .many + (.app (.ref callee) (.var 0)) (.app (.ref _) (.var 1))))) := env worker | none + let chain ← recognizeChain env zeroResult succResult fuel callee + if mainEq : main = .ref root then + if rootAt : env root = some (.defn .shared (.ref worker)) then + if workerAt : env worker = some (.defn .shared (.lam .many (twiceBody callee))) then + some ⟨root, worker, callee, mainEq, rootAt, workerAt, chain⟩ + else none + else none + else none + +/-- Constructor payloads are unrestricted. The reader observes only the +outer tag and arity; the successor field may itself represent a large heap. -/ +inductive Argument where + | zero (constructor : Address) + | succ (constructor : Address) (field : Value) + +def Argument.value : Argument → Value + | .zero constructor => .ctor constructor 0 [] + | .succ constructor field => .ctor constructor 1 [field] + +def Argument.target (field : IxIR2.Eval.RVal) : Argument → IxIR2.Borrow.Open.Major + | .zero _ => .zero + | .succ .. => .succ field + +def Argument.result (zeroResult succResult : Nat) : Argument → Nat + | .zero _ => zeroResult + | .succ .. => succResult + +theorem Chain.evaluates {ctx : Ctx} {zeroResult succResult address} + (chain : Chain ctx.env zeroResult succResult address) (env : List Value) : + Evaluates ctx env (.ref address) chain.value := by + cases chain with + | reader _ found => exact evaluatesRecursor found + | forward _ _ found _ => exact evaluatesDef found (evaluatesLam ctx [] .many _) + +theorem Chain.applies {ctx : Ctx} {zeroResult succResult address} + (chain : Chain ctx.env zeroResult succResult address) (argument : Argument) : + Applies ctx chain.value argument.value (.lit (.nat (argument.result zeroResult succResult))) := by + induction chain with + | reader address found => + cases argument with + | zero constructor => + exact appliesRecursor found rfl rfl rfl (evaluatesLit ctx _ _) + | succ constructor field => + exact appliesRecursor found rfl rfl rfl (evaluatesLit ctx _ _) + | forward address callee found tail ih => + exact appliesClosure (evaluatesApp (tail.evaluates _) (evaluatesVar rfl) ih) + +def Shape.value {declarations main zeroResult succResult} + (shape : Shape declarations main zeroResult succResult) : Value := + .clos .many [] (twiceBody shape.callee) + +theorem Shape.evaluates {declarations main zeroResult succResult} + (shape : Shape declarations main zeroResult succResult) : + Evaluates { env := Env.ofList declarations } [] main shape.value := by + simpa only [shape.mainEq, Shape.value] using + (evaluatesDef shape.rootAt (evaluatesDef shape.workerAt + (evaluatesLam { env := Env.ofList declarations } [] .many _))) + +theorem Shape.applies {declarations main zeroResult succResult} + (shape : Shape declarations main zeroResult succResult) (argument : Argument) : + Applies { env := Env.ofList declarations } shape.value argument.value + (.lit (.nat (argument.result zeroResult succResult))) := by + have applied := Chain.applies (ctx := { env := Env.ofList declarations }) shape.chain argument + apply appliesClosure + apply evaluatesLet + · exact evaluatesApp (shape.chain.evaluates _) (evaluatesVar rfl) applied + · exact evaluatesApp (shape.chain.evaluates _) (evaluatesVar rfl) applied + +theorem Argument.target_result (schema : IxIR2.Borrow.Open.Schema) (argument : Argument) (field : IxIR2.Eval.RVal) : + (argument.target field).result schema = argument.result schema.zeroResult schema.succResult := by + cases argument <;> rfl + +end Source +end Ix.Compiler.Borrow.Runtime diff --git a/Ix/Compiler/Borrow/Sources.lean b/Ix/Compiler/Borrow/Sources.lean new file mode 100644 index 000000000..9614fcf35 --- /dev/null +++ b/Ix/Compiler/Borrow/Sources.lean @@ -0,0 +1,72 @@ +import Ix.Compiler.Coverage.Sources + +/-! Canonical synthetic Ixon inputs for borrowed direct calls. A shared Nat +constructor is inspected twice through named functions in one source group. +The group permits known calls to the recursor, whose tag read returns 11 or +22. No intermediate IR is provided. -/ + +namespace Ix.Compiler.Borrow.Examples + +open Ix.Compiler.Ixon + +private def definition (value typ : Expr) (refs : Array Address) : Constant := + { info := .defn { kind := .defn, safety := .safe, lvls := 0, typ, value } + sharing := #[], refs, univs := #[.zero] } + +private def projection (info : ConstantInfo) : Constant := + { info, sharing := #[], refs := #[], univs := #[] } + +private def ghost (value : Expr) : Expr := + .app (.lam .erased (.sort 0) value) (.sort 0) + +private def natInductive : Inductive := + { isUnsafe := false, lvls := 0, params := 0, indices := 0, typ := .sort 0 + ctors := #[ + { isUnsafe := false, lvls := 0, cidx := 0, params := 0, fields := 0 + typ := .recur 0 #[] }, + { isUnsafe := false, lvls := 0, cidx := 1, params := 0, fields := 1 + typ := .all .many .shared (.recur 0 #[]) (.recur 0 #[]) }] } + +/-- `depth` forwarding functions precede a caller that reads the same value + twice. Zero and successor cases both perform a constructor dispatch. -/ +def source (depth : Nat) (successorCase : Bool) : Except String Coverage.Source := do + if depth > 8 then throw "borrow fixture exceeds eight forwarding functions" + let natT := Expr.recur 0 #[] + let typ := Expr.all .many .shared natT natT + let reader : Recursor := + { k := false, isUnsafe := false, lvls := 0, params := 0, indices := 0 + motives := 0, minors := 0, typ + rules := #[ + { fields := 0, rhs := .nat 0 }, + { fields := 1, rhs := .lam .many natT (.nat 1) }] } + let mut members : Array MutConst := #[.indc natInductive, .recr reader] + for index in [:depth] do + members := members.push (.defn + { kind := .defn, safety := .safe, lvls := 0, typ + value := .lam .many natT (.app (.recur (index + 1).toUInt64 #[]) (.var 0)) }) + let call := fun value => Expr.app (.recur (depth + 1).toUInt64 #[]) value + members := members.push (.defn + { kind := .defn, safety := .safe, lvls := 0, typ + value := .lam .many natT + (.letE false natT (call (.var 0)) (call (.var 1))) }) + let block ← Coverage.addressed + { info := .muts members, sharing := #[], univs := #[.zero] + refs := #[X86.ValidatedScalar.literalAddress 11, X86.ValidatedScalar.literalAddress 22] } + let natType ← Coverage.addressed (projection (.iPrj { idx := 0, block := block.1 })) + let worker ← Coverage.addressed + (projection (.dPrj { idx := (depth + 2).toUInt64, block := block.1 })) + let zero ← Coverage.addressed (projection (.cPrj { idx := 0, cidx := 0, block := block.1 })) + let successor ← Coverage.addressed + (projection (.cPrj { idx := 0, cidx := 1, block := block.1 })) + let major := if successorCase then .app (.ref 2 #[]) (ghost (.nat 4)) + else ghost (.ref 1 #[]) + let entry ← Coverage.addressed (definition (.app (.ref 0 #[]) major) + (.ref 3 #[]) #[worker.1, zero.1, successor.1, natType.1, + X86.ValidatedScalar.literalAddress 42]) + return { + name := s!"read-tag-{depth}-{if successorCase then "succ" else "zero"}" + constants := [block, natType, worker, zero, successor, entry] + root := entry.1, literals := [11, 22, 42] + expected := .scalar (if successorCase then 22 else 11) false } + +end Ix.Compiler.Borrow.Examples diff --git a/Ix/Compiler/CallReuse/MapPipeline.lean b/Ix/Compiler/CallReuse/MapPipeline.lean new file mode 100644 index 000000000..8547c4f8d --- /dev/null +++ b/Ix/Compiler/CallReuse/MapPipeline.lean @@ -0,0 +1,105 @@ +import Ix.Compiler.CallReuse.Pipeline +import Ix.Compiler.IxIR0.MapRecovery + +/-! Optional exact map specialization feeds the ordinary ownership compiler +and common checked backend. Every failure keeps the validated literal source +artifact. The v1 reuse selection itself retains checked baseline fallback. -/ + +namespace Ix.Compiler.CallReuse + +open Ix.Compiler.Ixon (Address Constant) + +def mapInput (result : IxIR1.ReaddressAll.Result) : IxIR2.Lower.Input := + { declarations := result.artifacts.flatMap IxIR1.ReaddressAll.Artifact.declarations + main := result.main, mainResult := .shared } + +def mapSidecars {fuel : Nat} (plan : IxIR0.MapRecovery.Plan) + (source : Pipeline.LoweredCompilation .shared fuel) : + Except IxIR2.Pipeline.Error (IxIR2.Pipeline.BuiltCompiledSidecars source) := do + let hpt ← (IxIR1.HPT.produce source.lowering.result.artifacts).mapError .hpt + let constructors : List IxIR2.Pipeline.ConstructorInfo := + [{ identity := IxIR1.Lower.ctorIdOf plan.schema.nil 0, arity := 0 }, + { identity := IxIR1.Lower.ctorIdOf plan.schema.cons 1, arity := 2 }] ++ + plan.retainedAlias.toList.map fun pair => { identity := IxIR1.Lower.ctorIdOf pair 0, arity := 2 } + let sidecars : IxIR2.Pipeline.Sidecars := { + input := mapInput source.lowering.result + parameterEntries := source.targetDecls.filterMap fun (address, declaration) => match declaration with + | .fn definition => some (address, Array.replicate definition.arity .shared) + | .extern _ => none + constructors + hptCertificate := hpt.certificate } + return { sidecars, hpt, certificateProduced := rfl, inputProduced := rfl } + +structure MapLowered {declarations : List (Address × IxIR0.Decl)} {main : IxIR0.Expr} + (recovery : IxIR0.MapRecovery.Recovered declarations main) (fuel : Nat) where + lowering : IxIR1.Lower.FullyAddressedTrace + (IxIR0.MapRecovery.targetDeclarations recovery.checked.plan recovery.address) + (recovery.checked.plan.directMain recovery.address) .shared fuel + certificate : Pipeline.LoweringCertificate + (IxIR0.MapRecovery.targetDeclarations recovery.checked.plan recovery.address) + (lowering.result.artifacts.flatMap IxIR1.ReaddressAll.Artifact.declarations) + backend : IxIR2.Pipeline.CompiledRun (Pipeline.LoweredCompilation.ofTrace lowering certificate) + reuse : IxIR2.CallReuse.Selection IxIR2.Validate.defaultLimits + backend.val.target.artifact.validationContext backend.val.target.artifact.program + +def MapLowered.compilation {declarations : List (Address × IxIR0.Decl)} {main : IxIR0.Expr} + {recovery : IxIR0.MapRecovery.Recovered declarations main} {fuel : Nat} + (lowered : MapLowered recovery fuel) : Pipeline.LoweredCompilation .shared fuel := + Pipeline.LoweredCompilation.ofTrace lowered.lowering lowered.certificate +def MapLowered.attached {declarations : List (Address × IxIR0.Decl)} {main : IxIR0.Expr} + {recovery : IxIR0.MapRecovery.Recovered declarations main} {fuel : Nat} + (lowered : MapLowered recovery fuel) : IxIR2.Pipeline.CompiledAttachment .shared fuel := lowered.backend.val +theorem MapLowered.sourceProduced {declarations : List (Address × IxIR0.Decl)} {main : IxIR0.Expr} + {recovery : IxIR0.MapRecovery.Recovered declarations main} {fuel : Nat} + (lowered : MapLowered recovery fuel) : lowered.attached.source = lowered.compilation := lowered.backend.property + +inductive MapSkip where + | recovery (reason : IxIR0.Recursion.Skip) + | lowering (message : String) + | attachment (error : IxIR2.Pipeline.Error) + deriving Repr + +def lowerMap {declarations : List (Address × IxIR0.Decl)} {main : IxIR0.Expr} + (recovery : IxIR0.MapRecovery.Recovered declarations main) (fuel : Nat) (maxDepth : Nat) : + Except MapSkip (MapLowered recovery fuel) := do + let lowering ← (IxIR1.Lower.lowerAllIndexedFullyAddressedWithTrace + (IxIR0.MapRecovery.targetDeclarations recovery.checked.plan recovery.address) + (recovery.checked.plan.directMain recovery.address) .shared fuel).mapError .lowering + let certificate ← (Pipeline.checkLoweringCertificate + (IxIR0.MapRecovery.targetDeclarations recovery.checked.plan recovery.address) + (lowering.result.artifacts.flatMap IxIR1.ReaddressAll.Artifact.declarations)).mapError .lowering + let compilation := Pipeline.LoweredCompilation.ofTrace lowering certificate.down + let built ← (mapSidecars recovery.checked.plan compilation).mapError .attachment + let backend ← (IxIR2.Pipeline.attachCompiled compilation built maxDepth).mapError .attachment + let reuse := IxIR2.CallReuse.selectChecked IxIR2.Validate.defaultLimits + backend.val.target.artifact.validationContext backend.val.target.artifact.program + ⟨backend.val.target.stats, backend.val.target.accepted⟩ + return { lowering, certificate := certificate.down, backend, reuse } + +inductive MapOutcome (declarations : List (Address × IxIR0.Decl)) (main : IxIR0.Expr) (fuel : Nat) where + | literal (reason : MapSkip) + | recovered (recovery : IxIR0.MapRecovery.Recovered declarations main) (lowered : MapLowered recovery fuel) +def MapOutcome.selected {declarations : List (Address × IxIR0.Decl)} {main : IxIR0.Expr} {fuel : Nat} : + MapOutcome declarations main fuel → IxIR0.MapRecovery.Selection declarations main + | .literal (.recovery reason) => .literal reason + | .literal _ => .literal .rejectedTarget + | .recovered recovery _ => .recovered recovery + +structure MapCompilation (constants : List (Address × Constant)) (root : Address) + (config : Pipeline.Config) (eraseFuel lowerFuel : Nat) where + source : Pipeline.ValidatedCompilation constants root config .shared eraseFuel lowerFuel + outcome : MapOutcome source.erasure.result.raw (.ref root) lowerFuel + +def compileMap (constants : List (Address × Constant)) (root : Address) (config : Pipeline.Config := {}) + (checkFuel : Nat := 1000) (eraseFuel : Nat := 1000) (validateFuel : Nat := 1000) + (lowerFuel : Nat := 1000) (maxDepth : Nat := 1000) : + Except Pipeline.Error (MapCompilation constants root config eraseFuel lowerFuel) := do + let source ← Pipeline.compileValidatedWithTrace constants root config .shared checkFuel eraseFuel validateFuel lowerFuel + let outcome := match IxIR0.MapRecovery.select source.erasure.result.raw (.ref root) with + | .literal reason => MapOutcome.literal (.recovery reason) + | .recovered recovery => match lowerMap recovery lowerFuel maxDepth with + | .error reason => .literal reason + | .ok lowered => .recovered recovery lowered + return { source, outcome } + +end Ix.Compiler.CallReuse diff --git a/Ix/Compiler/CallReuse/MapSim.lean b/Ix/Compiler/CallReuse/MapSim.lean new file mode 100644 index 000000000..b836e0017 --- /dev/null +++ b/Ix/Compiler/CallReuse/MapSim.lean @@ -0,0 +1,130 @@ +import Ix.Compiler.CallReuse.MapPipeline +import Ix.Compiler.IxIR0.MapRecoverySim +import Ix.Compiler.Recursion.Resources +import Ix.Compiler.IxIR2.PipelineCallReuse + +/-! The valid Ixon map, exact checked specialization, ordinary ownership +lowering, and selected call-credit execution compose with the original source +contracts. Optional specialization/backend failure retains literal owned +execution and reclamation; successful attachment carries all R4 cost laws. -/ + +namespace Ix.Compiler.CallReuse + +open Ix.Compiler.Ixon (Address Constant) + +namespace MapLowered + +variable {declarations : List (Address × IxIR0.Decl)} {main : IxIR0.Expr} + {recovery : IxIR0.MapRecovery.Recovered declarations main} {fuel : Nat} + +def PhysicalValueRel (lowered : MapLowered recovery fuel) (sourceValue : IxIR0.Value) + (result : IxIR2.Eval.Result) : Prop := + ∃ store value baseline locRel, + IxIR1.LowerSim.AddressedValueGraph + (lowered.lowering.result.rebuildRename lowered.lowering.raw) + lowered.compilation.functionRel store sourceValue value ∧ + IxIR2.Lower.Sim.OutcomeRel (store, value) baseline ∧ + IxIR2.ReuseSim.StableHeapRel baseline.store result.store locRel ∧ + IxIR1.Sim.RValIso locRel baseline.value result.value + +theorem physicalMainCostLaws (lowered : MapLowered recovery fuel) + {sourceFuel : Nat} {sourceValue : IxIR0.Value} + (sourceRun : IxIR0.eval lowered.compilation.sourceCtx sourceFuel [] + lowered.compilation.main = .ok sourceValue) : + ∃ controlFuel heapFuel result, + IxIR2.Eval.Policy.runMain lowered.reuse.policy + (IxIR2.Eval.Context.ofProgram lowered.reuse.target lowered.attached.target.artifact.validationContext.schemas) + .physical lowered.reuse.target controlFuel heapFuel = .ok result ∧ + lowered.PhysicalValueRel sourceValue result ∧ result.SharedResources ∧ + lowered.attached.CallCostComparison lowered.reuse heapFuel result := by + have trace : IxIR0.ProjectionSafe.Eval lowered.compilation.sourceCtx sourceFuel [] + lowered.compilation.main sourceValue := recovery.projectionSafe sourceRun + obtain ⟨ir1Fuel, rawStore, store, value, ownedRun, addressImage, graph⟩ := + lowered.compilation.addressedOwnedMain trace + have attachedRun : IxIR1.runOwnedMain lowered.attached.simulationSourceContext + lowered.attached.target.artifact.source.mainResult + lowered.attached.target.artifact.source.main ir1Fuel = .ok (store, value) := by + rw [lowered.attached.simulationSourceContext_eq_addressedCtx, + lowered.attached.targetSourceProduced, lowered.attached.inputProduced, lowered.sourceProduced] + exact ownedRun + obtain ⟨baselineControl, controlFuel, heapFuel, baseline, result, locRel, + baselineRun, run, baselineRelation, heaps, values, baselineResources, resources, + allocations, costs, reclaimed, prefixes⟩ := + lowered.attached.selectedCallPhysicalMainCostLaws lowered.reuse attachedRun + exact ⟨controlFuel, heapFuel, result, run, + ⟨store, value, baseline, locRel, ⟨rawStore, addressImage, graph⟩, baselineRelation, heaps, values⟩, + resources, baselineControl, heapFuel, baseline, baselineRun, baselineResources, + allocations, costs, reclaimed, prefixes⟩ + +end MapLowered + +namespace MapCompilation + +variable {constants : List (Address × Constant)} {root : Address} + {config : Pipeline.Config} {eraseFuel lowerFuel : Nat} + +/-- A proof-only view reuses the established literal source/owned endpoint. +It contains the same validated compilation and performs no transformation. -/ +def literalView (compilation : MapCompilation constants root config eraseFuel lowerFuel) : + Recursion.Compilation constants root config eraseFuel lowerFuel := + { source := compilation.source, outcome := .literal (.recovery .unrecognized) } + +abbrev SourceValueRel (compilation : MapCompilation constants root config eraseFuel lowerFuel) + (sourceValue : Ixon.Eval.Value) (rawValue : IxIR0.Value) : Prop := + compilation.literalView.SourceValueRel sourceValue rawValue + +theorem sourceRefines (compilation : MapCompilation constants root config eraseFuel lowerFuel) + {sourceFuel : Nat} {sourceValue : Ixon.Eval.Value} + (horacles : @Ix.Compiler.Sim.OracleRel compilation.source.memberScope + (Pipeline.validatedEvalCtx constants config).inlineSharing + { env := IxIR0.Env.ofList compilation.source.erasure.result.raw }) + (hctx : (Pipeline.validatedEvalCtx constants config).SharingWF) + (hsource : Ixon.Eval.eval (Pipeline.validatedEvalCtx constants config) sourceFuel + (Pipeline.validatedMainFrame root) [] Pipeline.validatedMainSource = .ok sourceValue) : + ∃ targetFuel rawValue, + IxIR0.eval { env := IxIR0.Env.ofList compilation.outcome.selected.declarations } + targetFuel [] compilation.outcome.selected.main = .ok rawValue ∧ + compilation.SourceValueRel sourceValue rawValue := by + obtain ⟨rawFuel, rawValue, rawRun, sourceRelation⟩ := compilation.literalView.sourceRefines horacles hctx hsource + obtain ⟨targetFuel, targetRun⟩ := compilation.outcome.selected.forwardSimulation rawRun + exact ⟨targetFuel, rawValue, targetRun, sourceRelation⟩ + +def SelectedExecutionWithCostLaws (compilation : MapCompilation constants root config eraseFuel lowerFuel) + (sourceValue : Ixon.Eval.Value) : Prop := + match compilation.outcome with + | .literal _ => compilation.literalView.SelectedExecutionWithResources sourceValue + | .recovered _ lowered => + ∃ rawValue controlFuel heapFuel result, + compilation.SourceValueRel sourceValue rawValue ∧ + IxIR2.Eval.Policy.runMain lowered.reuse.policy + (IxIR2.Eval.Context.ofProgram lowered.reuse.target lowered.attached.target.artifact.validationContext.schemas) + .physical lowered.reuse.target controlFuel heapFuel = .ok result ∧ + lowered.PhysicalValueRel rawValue result ∧ result.SharedResources ∧ + lowered.attached.CallCostComparison lowered.reuse heapFuel result + +/-- Composed source correctness, checked fallback, full result reclamation, +and allocation/free/RC/peak laws. The only caller premises are the original +source sharing/oracle contracts and successful Ixon evaluation. -/ +theorem sourceRefinesWithCostLaws (compilation : MapCompilation constants root config eraseFuel lowerFuel) + {sourceFuel : Nat} {sourceValue : Ixon.Eval.Value} + (horacles : @Ix.Compiler.Sim.OracleRel compilation.source.memberScope + (Pipeline.validatedEvalCtx constants config).inlineSharing + { env := IxIR0.Env.ofList compilation.source.erasure.result.raw }) + (hctx : (Pipeline.validatedEvalCtx constants config).SharingWF) + (hsource : Ixon.Eval.eval (Pipeline.validatedEvalCtx constants config) sourceFuel + (Pipeline.validatedMainFrame root) [] Pipeline.validatedMainSource = .ok sourceValue) : + compilation.SelectedExecutionWithCostLaws sourceValue := by + cases selected : compilation.outcome with + | literal reason => + simpa only [SelectedExecutionWithCostLaws, selected] using + compilation.literalView.sourceRefinesSelectedWithResources horacles hctx hsource + | recovered recovery lowered => + obtain ⟨rawFuel, rawValue, rawRun, sourceRelation⟩ := compilation.sourceRefines horacles hctx hsource + rw [selected] at rawRun + obtain ⟨controlFuel, heapFuel, result, run, related, resources, costs⟩ := lowered.physicalMainCostLaws rawRun + simp only [SelectedExecutionWithCostLaws, selected] + exact ⟨rawValue, controlFuel, heapFuel, result, sourceRelation, run, related, resources, costs⟩ + +end MapCompilation + +end Ix.Compiler.CallReuse diff --git a/Ix/Compiler/CallReuse/Observations.lean b/Ix/Compiler/CallReuse/Observations.lean new file mode 100644 index 000000000..e5ac6e8a3 --- /dev/null +++ b/Ix/Compiler/CallReuse/Observations.lean @@ -0,0 +1,340 @@ +import Ix.Compiler.CallReuse.Sources +import Ix.Compiler.CallReuse.Provenance +import Ix.Compiler.Coverage.HeapSnapshot +import Ix.Compiler.IxIR2.ReservationOwnership + +/-! Source-driven map execution, full heap release, and actual prefix +observations. Every constructor observation checks its complete identity. -/ + +namespace Ix.Compiler.CallReuse.Examples + +open Lean Ix.Compiler.Ixon + +deriving instance ToJson for IxIR2.CallReuse.Report +deriving instance ToJson for IxIR0.MapRecovery.Schema +deriving instance ToJson for IxIR0.MapRecovery.Plan + +inductive Observation where + | list (values : List Nat) + | pair (mapped retained : List Nat) + deriving BEq, Repr, ToJson + +private def need (condition : Bool) (message : String) : Except String Unit := + if condition then .ok () else .error message + +private def sourceList? (source : Source) : Nat → Ixon.Eval.Value → Option (List Nat) + | 0, _ => none + | fuel + 1, .ctorV block 1 tag fields => + if block != source.dataBlock then none + else match tag, fields with + | 0, [] => some [] + | 1, [.litV (.natL n), tail] => (n :: ·) <$> sourceList? source fuel tail + | _, _ => none + | _, _ => none + +private def sourceObservation? (source : Source) (value : Ixon.Eval.Value) : Option Observation := + if source.aliased then + match value with + | .ctorV block 2 0 [left, right] => do + if block != source.dataBlock then none + else return .pair (← sourceList? source 1000 left) (← sourceList? source 1000 right) + | _ => none + else .list <$> sourceList? source 1000 value + +private def list0? (source : Source) : Nat → IxIR0.Value → Option (List Nat) + | 0, _ => none + | fuel + 1, .ctor address tag fields => + if address == source.nil && tag == 0 && fields.isEmpty then some [] + else if address == source.cons && tag == 1 then + match fields with + | [.lit (.nat n), tail] => (n :: ·) <$> list0? source fuel tail + | _ => none + else none + | _, _ => none + +private def observation0? (source : Source) (value : IxIR0.Value) : Option Observation := + if source.aliased then + match value with + | .ctor address 0 [left, right] => do + if address != source.pair then none + else return .pair (← list0? source 1000 left) (← list0? source 1000 right) + | _ => none + else .list <$> list0? source 1000 value + +private def list1? (source : Source) : Nat → IxIR1.Store → IxIR1.RVal → Option (List Nat) + | 0, _, _ => none + | fuel + 1, store, .loc location => do + let box ← store.get? location + let .ctorN identity fields := box.node | none + if identity == IxIR1.Lower.ctorIdOf source.nil 0 && fields.isEmpty then some [] + else if identity == IxIR1.Lower.ctorIdOf source.cons 1 then + match fields.toList with + | [.lit (.nat n), tail] => (n :: ·) <$> list1? source fuel store tail + | _ => none + else none + | _, _, _ => none + +private def observation1? (source : Source) (store : IxIR1.Store) + (value : IxIR1.RVal) : Option Observation := + if source.aliased then do + let .loc location := value | none + let box ← store.get? location + let .ctorN identity fields := box.node | none + if identity != IxIR1.Lower.ctorIdOf source.pair 0 then none + else match fields.toList with + | [left, right] => return .pair (← list1? source 1000 store left) (← list1? source 1000 store right) + | _ => none + else .list <$> list1? source 1000 store value + +private def expected (source : Source) : Observation := + let mapped := source.values.map (fun _ => source.replacement) + if source.aliased then .pair mapped (source.values.drop source.uniquePrefix) else .list mapped + +private def agree (source : Source) (stage : String) (actual : Option Observation) : Except String Unit := + need (actual == some (expected source)) s!"{stage}: expected {repr (expected source)}, got {repr actual}" + +private def observe0 (source : Source) (stage : String) (declarations : List (Address × IxIR0.Decl)) + (main : IxIR0.Expr) : Except String Unit := do + let value ← (IxIR0.eval { env := IxIR0.Env.ofList declarations } 10000 [] main).mapError + (fun error => s!"{stage}: {repr error}") + agree source stage (observation0? source value) + +private def observe1 (source : Source) (stage : String) (context : IxIR1.Ctx) + (main : IxIR1.Code) : Except String (IxIR1.Store × Json) := do + let (store, value) ← (IxIR1.runOwnedMain context .shared main 10000).mapError + (fun error => s!"{stage}: {repr error}") + agree source stage (observation1? source store value) + need (store.live + store.frees == store.allocs) s!"{stage}: terminal allocation balance" + let reclaimed ← (IxIR1.dropVal context 10000 store value).mapError (fun error => s!"{stage}: {repr error}") + need (reclaimed.live == 0 && reclaimed.allocs == reclaimed.frees) s!"{stage}: incomplete reclamation" + return (store, Json.mkObj [("value", toJson (expected source)), ("store", toJson store), + ("reclaimed", toJson reclaimed)]) + +private def observe2 (source : Source) (stage : String) (context : IxIR2.Validate.Context) + (program : IxIR2.Program) (policy : IxIR2.CreditPolicy) (mode : IxIR2.Eval.Interpretation) : + Except String (IxIR2.Eval.Result × IxIR2.Eval.Store × Json) := do + let result ← (IxIR2.Eval.Policy.runMain policy (IxIR2.Eval.Context.ofProgram program context.schemas) + mode program 10000 10000).mapError (fun error => s!"{stage}: {repr error}") + agree source stage (observation1? source result.store.heap result.value) + need (result.store.live + result.store.heap.frees == result.store.heap.allocs) s!"{stage}: terminal allocation balance" + let (reclaimed, remaining) ← (IxIR2.Eval.releaseShared 10000 result.store result.value).mapError + (fun error => s!"{stage} reclamation: {repr error}") + need (reclaimed.live == 0 && reclaimed.heap.allocs == reclaimed.heap.frees) s!"{stage}: incomplete reclamation" + return (result, reclaimed, Json.mkObj [ + ("value", toJson (expected source)), ("store", toJson result.store), + ("control_remaining", toJson result.controlRemaining), ("heap_remaining", toJson result.heapRemaining), + ("reclaimed", toJson reclaimed), ("reclamation_remaining", toJson remaining)]) + +/-- Inspect every actual physical prefix, including the states between reset, +call entry, nested return, and credit consumption. -/ +def prefixObservations (context : IxIR2.Validate.Context) (program : IxIR2.Program) + (policy : IxIR2.CreditPolicy) (baseline final : IxIR2.Eval.Result) : + Except String (Array Json × Nat × Nat) := do + let context := IxIR2.Eval.Context.ofProgram program context.schemas + let mut machine := IxIR2.Eval.initialMachine program.main #[] 10000 + let mut rows := #[] + let mut maximum := 0 + let mut suspendedCalls := 0 + for index in [:10001] do + let (active, saved, creditCounts) : List Nat × List (List Nat) × List Nat := match machine.control with + | .halted _ => ([], [], []) + | .running frame stack => (frame.reservations, stack.map IxIR2.Eval.Continuation.reservations, + frame.liveCredits.length :: stack.map (fun (continuation : IxIR2.Eval.Continuation) => match continuation with + | .resume frame | .applyMore _ frame => frame.liveCredits.length)) + let reservations := active ++ saved.flatten + let emptySlots := (List.range machine.store.heap.nodes.size).filter fun location => + match machine.store.heap.nodes[location]? with | some none => true | _ => false + need (reservations.eraseDups.length == reservations.length && reservations.all emptySlots.contains) + "prefix reservation duplicated or aliases a live heap slot" + need (machine.store.live + machine.store.heap.frees + reservations.length == machine.store.heap.allocs) + "prefix physical allocation balance" + need (machine.store.heap.rcops ≤ baseline.store.heap.rcops && + machine.store.peakLiveNodes ≤ baseline.store.peakLiveNodes && + machine.store.live ≤ machine.store.peakLiveNodes) "prefix RC or peak-live bound" + maximum := max maximum creditCounts.sum + rows := rows.push (Json.mkObj [("step", toJson index), ("counters", toJson machine.store.counters), + ("live", toJson machine.store.live), ("owners", toJson (active :: saved)), + ("empty_slots", toJson emptySlots), ("credit_counts", toJson creditCounts)]) + match machine.control with + | .halted value => + need (toJson machine.store == toJson final.store && value == final.value && + machine.heapFuel == final.heapRemaining) "prefix traversal disagrees with runMain" + return (rows, maximum, suspendedCalls) + | .running frame _ => + let next ← (IxIR2.Eval.Policy.step policy context .physical machine).mapError reprStr + if (IxIR2.Eval.Policy.directCall? frame).isSome then + let .running callee (.resume caller :: _) := next.control + | throw "direct call did not suspend exactly one caller" + need (callee.credits.isEmpty && caller.credits == frame.credits && + toJson machine.store == toJson next.store) "direct-call credit ownership changed" + if !frame.liveCredits.isEmpty then suspendedCalls := suspendedCalls + 1 + machine := next + throw "prefix traversal exceeded execution budget" + +private def costGate (source : Source) (baseline logical physical : IxIR2.Eval.Result) + (baselineReleased physicalReleased : IxIR2.Eval.Store) : Except String Unit := do + for (label, base, selected) in [("terminal", baseline.store, physical.store), + ("reclaimed", baselineReleased, physicalReleased)] do + let b := base.counters + let p := selected.counters + need (b.reuses == 0 && b.allocs == p.allocs + p.reuses && b.frees == p.frees + p.reuses) + s!"{label}: baseline/selected allocation or free law" + need (p.rcops ≤ b.rcops && p.peakLiveNodes ≤ b.peakLiveNodes) s!"{label}: RC or peak-live bound" + let l := logical.store.counters + let p := physical.store.counters + need (l.allocs == p.allocs + p.reuses && l.frees == p.frees + p.reuses && l.rcops == p.rcops && + logical.store.live == physical.store.live && l.resetAttempts == p.resetAttempts && + l.hotResets == p.hotResets && l.coldResets == p.coldResets) "logical/physical allocation accounting" + let hot := if source.aliased then source.uniquePrefix else source.values.length + need (p.resetAttempts == source.values.length && p.hotResets == hot && + p.coldResets == source.values.length - hot && p.reuses == hot && p.reusedPayloadUnits == 2 * hot) + "reset/reuse count differs from source alias structure" + +structure CaseResult where + name : String + summary : Json + snapshot : Json + +def runCase (name : String) (values : List Nat) (replacement : Nat) (aliased : Bool) + (uniquePrefix : Nat := 0) : Except String CaseResult := do + let source ← Examples.source values replacement aliased uniquePrefix + let sourceValue ← (Ixon.Eval.eval (Pipeline.validatedEvalCtx source.constants source.config) 10000 + (Pipeline.validatedMainFrame source.root) [] Pipeline.validatedMainSource).mapError + (fun error => s!"Ixon: {repr error}") + agree source "Ixon" (sourceObservation? source sourceValue) + let compilation ← source.compile.mapError (fun error => s!"validated compilation: {repr error}") + let .recovered recovery lowered := compilation.outcome + | throw s!"map specialization did not reach the checked backend" + let attached := lowered.attached + let baseline := attached.target + let context := baseline.artifact.validationContext + let selected := lowered.reuse + let .optimized output _ := selected | throw "ordinary source unexpectedly used baseline fallback" + let report := IxIR2.CallReuse.report IxIR2.Validate.defaultLimits context baseline.artifact.program + need (report.rewritten == 1 && report.suspendedCallSites == 2) "compiler did not expose both map calls" + need (match IxIR2.Validate.validate context selected.target with | .error _ => true | .ok _ => false) + "v0 accepted live credits across map calls" + let erasure := compilation.source.erasure.result + let lowering := lowered.lowering + observe0 source "raw IxIR0" erasure.raw (.ref source.root) + observe0 source "addressed IxIR0" erasure.declarations erasure.main + observe0 source "specialized IxIR0" + (IxIR0.MapRecovery.targetDeclarations recovery.checked.plan recovery.address) + (recovery.checked.plan.directMain recovery.address) + let (_, literalRawJson) ← observe1 source "literal raw IxIR1" + { decls := IxIR1.Env.ofList compilation.source.lowering.raw } compilation.source.lowering.mainCode + let (_, literalJson) ← observe1 source "literal IxIR1" + { decls := compilation.source.artifact.targetDeclEnv } compilation.source.artifact.main + let (rawStore, rawJson) ← observe1 source "raw IxIR1" { decls := IxIR1.Env.ofList lowering.raw } lowering.mainCode + let (store, ir1Json) ← observe1 source "addressed IxIR1" + { decls := IxIR1.HPT.programDeclEnv lowering.result.artifacts } lowering.result.main + let (baseLogical, _, baseLogicalJson) ← observe2 source "baseline logical" context baseline.artifact.program .callLocalV0 .logical + let (base, baseReleased, baseJson) ← observe2 source "baseline physical" context baseline.artifact.program .callLocalV0 .physical + need (toJson rawStore == toJson store && toJson store == toJson base.store.heap && + toJson baseLogical.store == toJson base.store) "ordinary lowering or baseline interpretation drifted" + let (logical, _, logicalJson) ← observe2 source "selected logical" context selected.target selected.policy .logical + let (physical, released, physicalJson) ← observe2 source "selected physical" context selected.target selected.policy .physical + costGate source base logical physical baseReleased released + let (prefixes, maximumCredits, suspendedCalls) ← prefixObservations context selected.target selected.policy base physical + need (suspendedCalls == 2 * values.length && maximumCredits == values.length) + "nested calls did not suspend the expected independent caller credits" + need (IxIR2.CallReuse.rewriteProgram IxIR2.Validate.defaultLimits context selected.target == selected.target) + "call reuse is not idempotent" + let provenance := lowered.provenance source.root + need (({ provenance with execution := .callLocalV0 }).bytes != provenance.bytes && + ({ provenance with execution := .callLocalV0 }).identity != provenance.identity) + "execution policy did not change provenance" + let summary := Json.mkObj [ + ("name", toJson name), ("snapshot", toJson s!"{name}.json"), + ("source_root", toJson source.root), ("source_constants", toJson source.constants.length), + ("input", toJson values), ("replacement", toJson replacement), + ("aliased", toJson aliased), ("unique_prefix", toJson uniquePrefix), ("value", toJson (expected source)), + ("ixir1_root", toJson provenance.ir1Root), ("provenance", toJson provenance.identity), + ("map_specialization", toJson recovery.address), + ("literal_ixir1_root", toJson (IxIR1.Optimizer.graphRoot + compilation.source.lowering.result.artifacts compilation.source.lowering.result.main)), + ("policy", toJson selected.policy.tag), ("pass", toJson IxIR2.CallReuse.policyTag), + ("hpt_roots", toJson provenance.hptRoots), ("reuse", toJson report), + ("baseline", toJson base.store.counters), ("logical", toJson logical.store.counters), + ("physical", toJson physical.store.counters), ("maximum_credits", toJson maximumCredits), + ("suspended_calls", toJson suspendedCalls), ("prefixes", toJson prefixes.size), + ("all_heaps_reclaimed", toJson true)] + let sidecars := attached.sidecars + let common := attached.source + let snapshot := Json.mkObj [ + ("format", toJson "compilatrix/source-call-reuse-case/1"), ("summary", summary), + ("source", Json.mkObj [("root", toJson source.root), ("limits", toJson source.config.limits), + ("fuel", Json.mkObj [("usage", toJson (1000 : Nat)), ("erasure", toJson (1000 : Nat)), + ("validation", toJson (1000 : Nat)), ("ownership_lowering", toJson (1000 : Nat)), + ("evaluation", toJson (10000 : Nat)), ("control", toJson (10000 : Nat)), + ("heap", toJson (10000 : Nat)), ("reclamation", toJson (10000 : Nat))]), + ("constants", toJson (source.constants.map fun (address, constant) => + Json.mkObj [("key", toJson address), ("bytes", Coverage.byteJson (ser constant))])), + ("literals", toJson ((replacement :: values).eraseDups.map fun n => + Json.mkObj [("key", toJson (X86.ValidatedScalar.literalAddress n)), ("nat", toJson n)]))]), + ("ixir0", Json.mkObj [("raw", Coverage.ir0Entries erasure.raw), + ("raw_main", Coverage.byteJson (IxIR0.Expr.ref source.root).bytes), + ("groups", toJson (erasure.groups.map Coverage.ir0Group)), + ("declarations", Coverage.ir0Entries erasure.declarations), ("main", Coverage.byteJson erasure.main.bytes), + ("blocks", toJson (erasure.addressed.blocks.map Coverage.ir0Block)), ("address_map", toJson erasure.addressMap)]), + ("ixir1", Json.mkObj [("root", toJson provenance.ir1Root), + ("raw_declarations", Coverage.ir1Entries lowering.raw), ("raw_main", Coverage.byteJson lowering.mainCode.bytes), + ("artifacts", toJson (lowering.result.artifacts.map Coverage.ir1Artifact)), + ("declarations", Coverage.ir1Entries common.targetDecls), + ("main", Coverage.byteJson lowering.result.main.bytes), ("address_map", toJson lowering.result.addressMap), + ("reserved", toJson lowering.result.reserved)]), + ("literal_ixir1", Json.mkObj [ + ("root", toJson (IxIR1.Optimizer.graphRoot compilation.source.lowering.result.artifacts + compilation.source.lowering.result.main)), + ("raw_declarations", Coverage.ir1Entries compilation.source.lowering.raw), + ("raw_main", Coverage.byteJson compilation.source.lowering.mainCode.bytes), + ("artifacts", toJson (compilation.source.lowering.result.artifacts.map Coverage.ir1Artifact)), + ("declarations", Coverage.ir1Entries compilation.source.artifact.targetDecls), + ("main", Coverage.byteJson compilation.source.artifact.main.bytes), + ("address_map", toJson compilation.source.lowering.result.addressMap), + ("reserved", toJson compilation.source.lowering.result.reserved)]), + ("map_specialization", Json.mkObj [("policy", toJson IxIR0.MapRecovery.policyTag), + ("plan", toJson recovery.checked.plan), ("derived_key", toJson recovery.address), + ("declarations", Coverage.ir0Entries (IxIR0.MapRecovery.targetDeclarations recovery.checked.plan recovery.address)), + ("main", Coverage.byteJson (recovery.checked.plan.directMain recovery.address).bytes)]), + ("ownership_lowering", Json.mkObj [("declarations", Coverage.ir0Entries common.declarations), + ("main", Coverage.byteJson common.main.bytes), + ("source_rows_selected", toJson (Pipeline.sourceRowsSelected common.declarations)), + ("source_externs_rejected", toJson (Pipeline.firstValidatedExtern? common.declarations).isNone), + ("target_externs_rejected", toJson (Pipeline.firstValidatedTargetExtern? common.targetDecls).isNone)]), + ("hpt", Json.mkObj [("producer_limits", toJson IxIR1.HPT.defaultProducerLimits), + ("producer_stats", toJson attached.hpt.stats), + ("candidate", toJson (attached.hpt.certificate.artifacts.map Coverage.hptCandidate)), + ("artifacts", toJson (attached.hpt.result.artifacts.map Coverage.hptArtifact))]), + ("sidecars", Json.mkObj [("input_declarations", Coverage.ir1Entries sidecars.input.declarations), + ("input_main", Coverage.byteJson sidecars.input.main.bytes), ("main_world", toJson sidecars.input.mainResult), + ("parameter_worlds", toJson sidecars.parameterEntries), ("constructors", toJson sidecars.constructors), + ("recursor_origins", toJson sidecars.recursorOrigins), + ("hpt_certificate", toJson (sidecars.hptCertificate.artifacts.map Coverage.hptCandidate))]), + ("provenance", Json.mkObj [("kind", toJson "ixir1-plus-policy"), ("identity", toJson provenance.identity), + ("bytes", Coverage.byteJson provenance.bytes), ("lowering_version", toJson provenance.loweringVersion), + ("pass", toJson provenance.pass), ("execution_policy", toJson provenance.execution.tag), + ("specialization", toJson provenance.specialization), + ("optimized", toJson provenance.optimized)]), + ("ixir2_diagnostic", Json.mkObj [("baseline", toJson baseline.artifact.program), + ("baseline_stats", toJson baseline.stats), ("selected", toJson output.target), + ("selected_stats", toJson output.targetChecked.stats), ("reuse", toJson report), + ("max_depth", toJson attached.maxDepth), + ("schemas", toJson (sidecars.constructors.map fun c => + (c.identity, attached.loweringContext.schemas .shared c.identity)))]), + ("observations", Json.mkObj [("literal_raw_ixir1", literalRawJson), ("literal_ixir1", literalJson), + ("raw_ixir1", rawJson), ("ixir1", ir1Json), + ("baseline_logical", baseLogicalJson), ("baseline_physical", baseJson), + ("selected_logical", logicalJson), ("selected_physical", physicalJson)]), + ("prefixes", toJson prefixes)] + return { name, summary, snapshot } + +def cases : List (String × List Nat × Nat × Bool × Nat) := + [("empty-hot", [], 42, false, 0), ("empty-cold", [], 42, true, 0), + ("singleton-hot", [17], 42, false, 0), ("singleton-cold", [17], 42, true, 0), + ("three-hot", [1, 2, 3], 42, false, 0), ("three-cold", [1, 2, 3], 42, true, 0), + ("mixed-values-hot", [0, 3, 3, UInt64.size, 1, 42, 0], UInt64.size + 7, false, 0), + ("mixed-values-cold", [0, 3, 3, UInt64.size, 1, 42, 0], UInt64.size + 7, true, 0), + ("mixed-ownership", [5, 4, 3, 2, 1], 0, true, 2)] + +end Ix.Compiler.CallReuse.Examples diff --git a/Ix/Compiler/CallReuse/Pipeline.lean b/Ix/Compiler/CallReuse/Pipeline.lean new file mode 100644 index 000000000..3bb250c2f --- /dev/null +++ b/Ix/Compiler/CallReuse/Pipeline.lean @@ -0,0 +1,32 @@ +import Ix.Compiler.IxIR2.Pipeline +import Ix.Compiler.IxIR2.CallReuse + +/-! Ordinary validated Ixon compilation with the versioned direct-call pass. +The selection retains either the checked rewrite or the checked baseline and +its rejection reason. No fixture-specific IR is supplied to this boundary. -/ + +namespace Ix.Compiler.CallReuse + +open Ix.Compiler.Ixon (Address Constant) + +structure Compilation (constants : List (Address × Constant)) (root : Address) + (config : Pipeline.Config) (eraseFuel lowerFuel : Nat) where + attached : IxIR2.Pipeline.Attached constants root config .shared eraseFuel lowerFuel + selection : IxIR2.CallReuse.Selection IxIR2.Validate.defaultLimits + attached.target.artifact.validationContext attached.target.artifact.program + +def compileValidated (constants : List (Address × Constant)) (root : Address) + (config : Pipeline.Config := {}) + (checkFuel : Nat := Ixon.UsageCheck.defaultFuel) + (eraseFuel : Nat := Erase.defaultFuel) (validateFuel : Nat := Erase.defaultFuel) + (lowerFuel : Nat := 10000) (maxDepth : Nat := 100000) : + Except IxIR2.Pipeline.Error (Compilation constants root config eraseFuel lowerFuel) := do + let attached ← IxIR2.Pipeline.compileValidated constants root config .shared + checkFuel eraseFuel validateFuel lowerFuel maxDepth + return { + attached + selection := IxIR2.CallReuse.selectChecked IxIR2.Validate.defaultLimits + attached.target.artifact.validationContext attached.target.artifact.program + ⟨attached.target.stats, attached.target.accepted⟩ } + +end Ix.Compiler.CallReuse diff --git a/Ix/Compiler/CallReuse/PolicyExamples.lean b/Ix/Compiler/CallReuse/PolicyExamples.lean new file mode 100644 index 000000000..0e95d3249 --- /dev/null +++ b/Ix/Compiler/CallReuse/PolicyExamples.lean @@ -0,0 +1,200 @@ +import Ix.Compiler.CallReuse.Observations + +/-! Independent policy and rejection witnesses. These hand-built boundary +tests supplement the source-produced map matrix; they are not compiler input +fixtures for the source theorem or its artifact gate. -/ + +namespace Ix.Compiler.CallReuse.PolicyExamples + +open Ix.Compiler.Ixon (Address Owned) +open Ix.Compiler.IxIR2 +open Lean + +private def layout : Address := Address.replicate 0x91 +private def node : CtorId := { block := Address.replicate 0x92, indIdx := 0, cidx := 0 } +private def other : CtorId := { node with cidx := 1 } +private def leafAddress : Address := Address.replicate 0x93 +private def childAddress : Address := Address.replicate 0x94 + +private def schemas (world : Owned) (ctor : CtorId) : Option CtorSchema := + if ctor == node then some { layout, fields := #[world] } + else if ctor == other then some { layout := Address.replicate 0x95, fields := #[world] } + else none + +private def validation : Validate.Context := { schemas } +private def signature (world : Owned := .shared) : Signature := + { params := #[], result := world, papSafe := world == .shared } +private def block (instructions : Array Instr) (terminator : Terminator) : Block := + { valueParams := #[], creditParams := #[], instructions, terminator } +private def leaf : Function := + { signature := signature, blocks := #[block #[] (.ret (.lit (.nat 23)))] } + +private def prefixInstructions (world : Owned := .shared) : Array Instr := + #[.alloc world node #[.lit (.nat 7)], + match world with | .shared => .resetShared (.reg 0) node | .unique => .takeUnique (.reg 0) node] + +private def reuseBody (world : Owned := .shared) (callee : Address := leafAddress) : Function := + { signature := signature world + blocks := #[block (prefixInstructions world ++ + #[.call callee #[], .releaseShared (.reg 2), .allocWith 0 world node #[.reg 1]]) (.ret (.reg 3))] } + +private def reuseProgram (world : Owned := .shared) : Program := + { declarations := [(leafAddress, .fn leaf)], main := reuseBody world } + +private def discardProgram (world : Owned := .shared) : Program := + { declarations := [(leafAddress, .fn leaf)] + main := { + signature := signature + blocks := #[block (prefixInstructions world ++ #[.call leafAddress #[], .discardCredit 0, + match world with | .shared => .releaseShared (.reg 1) | .unique => .dropUnique (.reg 1)]) + (.ret (.reg 2))] } } + +private def coldProgram : Program := + { declarations := [(leafAddress, .fn leaf)] + main := { + signature := signature + blocks := #[block #[.alloc .shared node #[.lit (.nat 7)], .retainShared (.reg 0), + .resetShared (.reg 0) node, .call leafAddress #[], .releaseShared (.reg 3), + .allocWith 0 .shared node #[.reg 2], .releaseShared (.reg 1)] (.ret (.reg 4))] } } + +private def nestedProgram : Program := + { declarations := [(leafAddress, .fn leaf), (childAddress, .fn (reuseBody))] + main := reuseBody .shared childAddress } + +private def edgeProgram (credits : Array Nat) (targetCredits : Array CreditCap) + (targetInstructions : Array Instr) : Program := + { declarations := [(leafAddress, .fn leaf)] + main := { + signature := signature + blocks := #[ + block (prefixInstructions ++ #[.call leafAddress #[], .releaseShared (.reg 1), .releaseShared (.reg 2)]) + (.jump { target := 1, values := #[], credits }), + { valueParams := #[], creditParams := targetCredits, instructions := targetInstructions + terminator := .ret (.lit (.nat 9)) }] } } + +private def need (condition : Bool) (message : String) : Except String Unit := + if condition then .ok () else .error message + +private def accepted (program : Program) : Except String Unit := do + let _ ← (Validate.validateWithPolicy .suspendedCallsV1 Validate.defaultLimits validation program).mapError + (fun error => s!"v1 rejected: {repr error}") + match Validate.validate validation program with + | .ok _ => throw "v0 accepted a live call credit" + | .error (.invalid _ .credit _) => pure () + | .error error => throw s!"v0 rejected at the wrong boundary: {repr error}" + +private def rejected (name : String) (program : Program) (violation : Validate.Violation := .credit) : + Except String String := do + match Validate.validateWithPolicy .suspendedCallsV1 Validate.defaultLimits validation program with + | .ok _ => throw s!"{name}: v1 unexpectedly accepted" + | .error (.invalid _ actual _) => need (actual == violation) s!"{name}: rejected for {repr actual}" + | .error error => throw s!"{name}: wrong rejection {repr error}" + return name + +private def run (program : Program) (mode : Eval.Interpretation) : Except String Eval.Result := + (Eval.Policy.runMain .suspendedCallsV1 (Eval.Context.ofProgram program schemas) + mode program 10000 10000).mapError reprStr + +private def releaseResult (program : Program) (result : Eval.Result) : Except String Eval.Store := do + let (released, _) ← (match program.main.signature.result with + | .shared => Eval.releaseShared 10000 result.store result.value + | .unique => Eval.dropUniqueWork 10000 result.store [result.value]).mapError reprStr + need (released.live == 0 && released.heap.allocs == released.heap.frees) "policy result did not reclaim fully" + return released + +private def execution (name : String) (program : Program) (expectedReuses expectedCredits : Nat) : + Except String String := do + accepted program + let logical ← run program .logical + let physical ← run program .physical + let (_, maximum, _) ← Examples.prefixObservations validation program .suspendedCallsV1 physical physical + need (physical.store.heap.reuses == expectedReuses && maximum == expectedCredits) s!"{name}: credit/reuse counts" + need (logical.store.heap.allocs == physical.store.heap.allocs + physical.store.heap.reuses && + logical.store.heap.frees == physical.store.heap.frees + physical.store.heap.reuses && + logical.store.heap.rcops == physical.store.heap.rcops) s!"{name}: logical/physical counters" + let _ ← releaseResult program logical + let _ ← releaseResult program physical + match Eval.runMain (Eval.Context.ofProgram program schemas) .physical program 10000 10000 with + | .ok _ => throw s!"{name}: original evaluator crossed a live call credit" + | .error (.mem detail) => need (detail.contains "credit") s!"{name}: wrong original error" + | .error error => throw s!"{name}: wrong original rejection {repr error}" + return name + +private def withSuffix (instructions : Array Instr) (terminator : Terminator) : Program := + { declarations := [(leafAddress, .fn leaf)] + main := { signature := signature, blocks := #[block (prefixInstructions ++ instructions) terminator] } } + +/-- Policy v1 permits only direct non-tail calls at a live-credit boundary; +linear consumption, frame isolation, and every other boundary remain checked. -/ +def checks : Except String (List String) := do + let mut names := [] + for (name, program, reuses, maximum) in [ + ("optional-hot-call", reuseProgram, 1, 1), + ("optional-cold-call", coldProgram, 0, 1), + ("required-call", reuseProgram .unique, 1, 1), + ("optional-discard-after-return", discardProgram, 0, 1), + ("required-discard-after-return", discardProgram .unique, 0, 1), + ("nested-independent-callers", nestedProgram, 2, 2), + ("edge-transfer-after-return", edgeProgram #[0] #[.optional layout] #[.discardCredit 0], 0, 1)] do + names := names ++ [← (execution name program reuses maximum).mapError (fun message => s!"{name}: {message}")] + let self := withSuffix #[.callSelf #[], .releaseShared (.reg 2), .allocWith 0 .shared node #[.reg 1]] (.ret (.reg 3)) + accepted self + names := names ++ ["callSelf-policy-boundary"] + let malformed := [ + ("double-consumption", withSuffix #[.call leafAddress #[], .discardCredit 0, .discardCredit 0] (.ret (.reg 2)), Validate.Violation.credit), + ("unconsumed-return", withSuffix #[.call leafAddress #[], .releaseShared (.reg 1)] (.ret (.reg 2)), .resources), + ("tail-call-live-credit", withSuffix #[] (.tailCall leafAddress #[]), .credit), + ("tail-self-live-credit", withSuffix #[] (.tailCallSelf #[]), .credit), + ("papp-live-credit", withSuffix #[.papp leafAddress #[]] (.ret (.reg 2)), .credit), + ("apply-live-credit", withSuffix #[.apply (.lit (.nat 0)) #[]] (.ret (.reg 2)), .credit), + ("extern-live-credit", withSuffix #[.extern leafAddress #[]] (.ret (.reg 2)), .credit), + ("layout-mismatch-after-return", withSuffix #[.call leafAddress #[], .releaseShared (.reg 2), + .allocWith 0 .shared other #[.reg 1]] (.ret (.reg 3)), .credit), + ("duplicate-edge-credit", edgeProgram #[0, 0] #[.optional layout, .optional layout] + #[.discardCredit 0, .discardCredit 1], .credit), + ("omitted-edge-credit", edgeProgram #[] #[] #[], .resources)] + for (name, program, violation) in malformed do names := names ++ [← rejected name program violation] + let thief := { reuseProgram with + declarations := [(leafAddress, .fn { leaf with blocks := #[block #[.discardCredit 0] (.ret (.lit (.nat 0)))] })] } + names := names ++ [← rejected "callee-cannot-consume-ancestor-credit" thief .register] + match run thief .physical with + | .ok _ => throw "callee accessed its ancestor's credit register" + | .error message => need (message.contains "credit") "callee failed for unrelated reason" + let fallback : Program := { + declarations := [] + main := { + signature := signature .unique + blocks := #[block (prefixInstructions .unique ++ #[.allocWith 0 .unique node #[.reg 1]]) (.ret (.reg 2))] } } + match sourceAccepted : Validate.validateWith Validate.defaultLimits validation fallback with + | .error error => throw s!"fallback baseline invalid: {repr error}" + | .ok stats => + let selected := CallReuse.selectChecked Validate.defaultLimits validation fallback ⟨stats, sourceAccepted⟩ + match selected with + | .optimized .. => throw "credit-bearing source escaped the source-ready check" + | .baseline _ (.unsupportedSource) _ => + need (selected.target == fallback && selected.policy == .callLocalV0) "fallback changed its program or policy" + let actual ← (Eval.Policy.runMain selected.policy (Eval.Context.ofProgram selected.target schemas) + .physical selected.target 10000 10000).mapError reprStr + let original ← (Eval.runMain (Eval.Context.ofProgram fallback schemas) + .physical fallback 10000 10000).mapError reprStr + need (toJson actual.store == toJson original.store && actual.value == original.value) + "checked fallback changed execution" + | .baseline _ error _ => throw s!"unexpected fallback reason {repr error}" + names := names ++ ["checked-baseline-fallback"] + let shape : CallReuse.Shape := { + valueParams := #[.owned .shared], source := 0, sourceConstructor := node, fieldCount := 1 + calls := #[.call leafAddress #[]], allocationConstructor := node + allocationArguments := #[.reg 2], result := .reg 4 } + need ((CallReuse.inspect Validate.defaultLimits validation shape.baseline).isSome) "canonical site was not recognized" + for (name, changed) in [ + ("site-indirect-call", { shape with calls := #[.papp leafAddress #[]] }), + ("site-no-call", { shape with calls := #[] }), + ("site-live-owner", { shape with calls := #[.call leafAddress #[.reg 0]] }), + ("site-layout-mismatch", { shape with allocationConstructor := other })] do + need ((CallReuse.inspect Validate.defaultLimits validation changed.baseline).isNone && + CallReuse.rewriteBlock Validate.defaultLimits validation changed.baseline == changed.baseline) + s!"{name}: unsupported site was rewritten" + names := names ++ [name] + return names + +end Ix.Compiler.CallReuse.PolicyExamples diff --git a/Ix/Compiler/CallReuse/Provenance.lean b/Ix/Compiler/CallReuse/Provenance.lean new file mode 100644 index 000000000..bf080060a --- /dev/null +++ b/Ix/Compiler/CallReuse/Provenance.lean @@ -0,0 +1,63 @@ +import Ix.Compiler.CallReuse.Pipeline +import Ix.Compiler.CallReuse.MapPipeline +import Ix.Compiler.IxIR1.Optimizer + +/-! +# IxIR₁ and policy provenance for call reuse + +This identity commits to the canonical addressed IxIR₁ graph and the source, +HPT, and versioned policies that determine its lowering. It is provenance for +rebuilding the selected program, not a content address of serialized IxIR₂. +The diagnostic JSON has no cache or wire-format role. +-/ + +namespace Ix.Compiler.CallReuse + +open Ix.Compiler.Ixon (Address Constant) +open Ix.Compiler.IxIR + +structure Provenance where + sourceRoot : Address + ir1Root : Address + hptRoots : List Address + maxDepth : Nat + loweringVersion : Nat := 1 + pass : String := IxIR2.CallReuse.policyTag + execution : IxIR2.CreditPolicy + optimized : Bool + specialization : Option (String × Address) := none + +def Provenance.bytes (provenance : Provenance) : ByteArray := + "compilatrix/call-reuse-provenance/1\x00".toUTF8 ++ + Encoding.address provenance.sourceRoot ++ Encoding.address provenance.ir1Root ++ + Encoding.list Encoding.address provenance.hptRoots ++ Encoding.nat provenance.maxDepth ++ + Encoding.nat provenance.loweringVersion ++ Encoding.blob provenance.pass.toUTF8 ++ + Encoding.blob provenance.execution.tag.toUTF8 ++ Encoding.tag (if provenance.optimized then 1 else 0) ++ + Encoding.list (fun (policy, address) => Encoding.string policy ++ Encoding.address address) + provenance.specialization.toList + +def Provenance.identity (provenance : Provenance) : Address := Address.blake3 provenance.bytes + +def Compilation.provenance {constants : List (Address × Constant)} {root : Address} + {config : Pipeline.Config} {eraseFuel lowerFuel : Nat} + (compilation : Compilation constants root config eraseFuel lowerFuel) : Provenance := + { sourceRoot := root + ir1Root := IxIR1.Optimizer.graphRoot compilation.attached.source.artifact.targetArtifacts + compilation.attached.source.artifact.main + hptRoots := compilation.attached.hpt.result.artifacts.map (·.address) + maxDepth := compilation.attached.maxDepth + execution := compilation.selection.policy + optimized := match compilation.selection with | .optimized .. => true | .baseline .. => false } + +def MapLowered.provenance {declarations : List (Address × IxIR0.Decl)} {main : IxIR0.Expr} + {recovery : IxIR0.MapRecovery.Recovered declarations main} {fuel : Nat} + (lowered : MapLowered recovery fuel) (root : Address) : Provenance := + { sourceRoot := root + ir1Root := IxIR1.Optimizer.graphRoot lowered.lowering.result.artifacts lowered.lowering.result.main + hptRoots := lowered.attached.hpt.result.artifacts.map (·.address) + maxDepth := lowered.attached.maxDepth + execution := lowered.reuse.policy + optimized := match lowered.reuse with | .optimized .. => true | .baseline .. => false + specialization := some (IxIR0.MapRecovery.policyTag, recovery.address) } + +end Ix.Compiler.CallReuse diff --git a/Ix/Compiler/CallReuse/Rejections.lean b/Ix/Compiler/CallReuse/Rejections.lean new file mode 100644 index 000000000..bab0d18bb --- /dev/null +++ b/Ix/Compiler/CallReuse/Rejections.lean @@ -0,0 +1,71 @@ +import Ix.Compiler.CallReuse.PolicyExamples + +/-! Fail-closed map specialization and policy regression matrix. -/ + +namespace Ix.Compiler.CallReuse.Examples + +open Lean Ix.Compiler.Ixon + +private def need (condition : Bool) (message : String) : Except String Unit := + if condition then .ok () else .error message + +private def replace (entries : List (Address × IxIR0.Decl)) (address : Address) + (declaration : IxIR0.Decl) : List (Address × IxIR0.Decl) := + entries.map fun entry => if entry.1 == address then (address, declaration) else entry + +def rejectionChecks : Except String (List String) := do + let mut names ← PolicyExamples.checks + let source ← Examples.source [1, 2, 3] 42 false + let compilation ← source.compile.mapError reprStr + let .recovered recovery _ := compilation.outcome | throw "rejection fixture did not specialize" + let p := recovery.checked.plan + let s := p.schema + let entries := compilation.source.erasure.result.raw + for (name, changed) in [ + ("map-wrong-worker", replace entries s.worker (.defn .shared (.lam .many (.var 0)))), + ("map-wrong-step", replace entries s.step (.defn .shared (.lam .many (.lam .many (.lam .many (.var 0)))))), + ("map-wrong-base", replace entries s.base (.defn .shared .erased)), + ("map-wrong-recursor", replace entries s.recursor (.recursor 2 true #[])), + ("map-wrong-cons-arity", replace entries s.cons (.ctor 1 1)), + ("map-wrong-nil-tag", replace entries s.nil (.ctor 1 0)), + ("map-wrong-alias", replace entries s.alias (.defn .unique (.ref s.recursor))), + ("map-wrong-entry", replace entries source.root (.defn .shared (.ref s.base)))] do + need ((IxIR0.MapRecovery.check changed (.ref source.root) p).isNone) s!"{name}: proposal accepted" + match IxIR0.MapRecovery.select changed (.ref source.root) with + | .recovered _ => throw s!"{name}: automatic recovery accepted" + | .literal _ => pure () + names := names ++ [name] + let collision := (recovery.address, .defn .shared .erased) :: entries + match IxIR0.MapRecovery.selectWith collision (.ref source.root) (some p) with + | .literal .addressConflict => pure () + | _ => throw "map specialization reused an existing declaration identity" + names := names ++ ["map-address-conflict"] + match lowerMap recovery 1000 0 with + | .error (.attachment (.lowering _)) => pure () + | .error error => throw s!"map backend fallback failed for wrong reason: {repr error}" + | .ok _ => throw "map backend depth limit was ignored" + names := names ++ ["map-backend-fallback"] + let skipped ← (compileMap source.constants source.root source.config 1000 1000 1000 1000 0).mapError reprStr + match skipped.outcome with + | .literal (.attachment (.lowering _)) => + need (skipped.source.artifact.main.bytes == compilation.source.artifact.main.bytes && + Coverage.ir1Entries skipped.source.artifact.targetDecls == Coverage.ir1Entries compilation.source.artifact.targetDecls) + "map fallback changed the literal compiler artifact" + let (store, value) ← (IxIR1.runOwnedMain + { decls := skipped.source.artifact.targetDeclEnv } .shared skipped.source.artifact.main 10000).mapError reprStr + let released ← (IxIR1.dropVal { decls := skipped.source.artifact.targetDeclEnv } 10000 store value).mapError reprStr + need (released.live == 0 && released.frees == released.allocs) "literal map fallback did not reclaim" + | _ => throw "map compilation did not select its literal fallback" + names := names ++ ["map-literal-fallback-execution"] + return names + +def runAll : Except String (List CaseResult × List String) := do + let results ← cases.mapM fun (name, values, replacement, aliased, uniquePrefix) => + (runCase name values replacement aliased uniquePrefix).mapError (fun message => s!"{name}: {message}") + return (results, ← rejectionChecks) + +def report (results : List CaseResult) (checks : List String) : Json := + Json.mkObj [("format", toJson "compilatrix/source-call-reuse-report/1"), + ("cases", toJson (results.map (·.summary))), ("policy_and_rejection_checks", toJson checks)] + +end Ix.Compiler.CallReuse.Examples diff --git a/Ix/Compiler/CallReuse/Sim.lean b/Ix/Compiler/CallReuse/Sim.lean new file mode 100644 index 000000000..62e5f0a2f --- /dev/null +++ b/Ix/Compiler/CallReuse/Sim.lean @@ -0,0 +1,98 @@ +import Ix.Compiler.CallReuse.Pipeline +import Ix.Compiler.LoweredCompilationSim +import Ix.Compiler.IxIR2.PipelineCallReuse + +/-! +# Source refinement with suspended call credits + +The original shared-source certificate supplies a call-aware erasure trace. +The ordinary ownership compiler and exact checked attachment supply execution, +ownership, and the physical baseline. The versioned selection then supplies +the same semantic heap/value relations and R4 resource and cost laws. +-/ + +namespace Ix.Compiler.CallReuse.Compilation + +open Ix.Compiler.Ixon (Address Constant) + +variable {constants : List (Address × Constant)} {root : Address} + {config : Pipeline.Config} {eraseFuel lowerFuel : Nat} + +abbrev SourceValueRel (compilation : Compilation constants root config eraseFuel lowerFuel) + (sourceValue : Ixon.Eval.Value) (rawValue : IxIR0.Value) : Prop := + @Ix.Compiler.Sim.InlinedValRel (Pipeline.validatedEvalCtx constants config) + { env := IxIR0.Env.ofList compilation.attached.source.erasure.result.raw } + sourceValue rawValue compilation.attached.source.memberScope + +/-- The existing source, address, baseline, and live-heap relations composed +without any counter condition in their semantic meaning. -/ +def PhysicalValueRel (compilation : Compilation constants root config eraseFuel lowerFuel) + (sourceValue : Ixon.Eval.Value) (result : IxIR2.Eval.Result) : Prop := + ∃ rawValue store value baseline locRel, + compilation.SourceValueRel sourceValue rawValue ∧ + IxIR1.LowerSim.MutualAddressedValueGraph + (IxIR0.MutualBlock.Renaming.apply compilation.attached.source.erasure.result.addressMap) + (compilation.attached.source.lowering.result.rebuildRename compilation.attached.source.lowering.raw) + compilation.attached.source.lowered.functionRel store rawValue value ∧ + IxIR2.Lower.Sim.OutcomeRel (store, value) baseline ∧ + IxIR2.ReuseSim.StableHeapRel baseline.store result.store locRel ∧ + IxIR1.Sim.RValIso locRel baseline.value result.value + +/-- Source correctness, full shared-result reclamation, allocation/free laws, +RC and peak bounds for every accepted shared compilation and either selection +branch. Only the original source sharing/oracle contracts and evaluation are +premises; ownership and all compiler/heap/cost facts are derived internally. -/ +theorem sourceRefinesWithCostLaws + (compilation : Compilation constants root config eraseFuel lowerFuel) + {sourceFuel : Nat} {sourceValue : Ixon.Eval.Value} + (horacles : @Ix.Compiler.Sim.OracleRel compilation.attached.source.memberScope + (Pipeline.validatedEvalCtx constants config).inlineSharing + { env := IxIR0.Env.ofList compilation.attached.source.erasure.result.raw }) + (hctx : (Pipeline.validatedEvalCtx constants config).SharingWF) + (hsource : Ixon.Eval.eval (Pipeline.validatedEvalCtx constants config) sourceFuel + (Pipeline.validatedMainFrame root) [] Pipeline.validatedMainSource = .ok sourceValue) : + ∃ controlFuel heapFuel result, + IxIR2.Eval.Policy.runMain compilation.selection.policy + (IxIR2.Eval.Context.ofProgram compilation.selection.target + compilation.attached.target.artifact.validationContext.schemas) + .physical compilation.selection.target controlFuel heapFuel = .ok result ∧ + compilation.PhysicalValueRel sourceValue result ∧ result.SharedResources ∧ + compilation.attached.compiled.CallCostComparison compilation.selection heapFuel result := by + let source := compilation.attached.source + letI : Ix.Compiler.Sim.MemberScope := source.memberScope + have hframe : (Pipeline.validatedMainFrame root).SharingWF := by + constructor + · rfl + · intro index member found + simp [Pipeline.validatedMainFrame] at found + have hbelow : Ixon.Sharing.sharesBelow (Pipeline.validatedMainFrame root).sharing.size + Pipeline.validatedMainSource = true := rfl + have herase : EraseAddressed.run + (EraseValidator.eraseCtxOf (Pipeline.validatedEvalCtx constants config)) constants + source.entry.target eraseFuel = .ok source.erasure.result := by + rw [source.entryTarget] + exact source.erasure.runEq + obtain ⟨traceFuel, addressedValue, trace, rawValue, sourceRelation, addressedEq⟩ := + IxIR1.LowerSim.CallAwareProjectionSafe.of_certifiedSharedClosed_addressed_with_members + (fun _ _ => none) (fun _ _ => none) source.members source.entry herase + (by intro address arguments; rfl) horacles hctx hframe hbelow hsource + subst addressedValue + obtain ⟨ir1Fuel, rawStore, store, value, ownedRun, addressImage, graph⟩ := + source.lowered.addressedOwnedMain trace + have attachedRun : IxIR1.runOwnedMain compilation.attached.compiled.simulationSourceContext + compilation.attached.compiled.target.artifact.source.mainResult + compilation.attached.compiled.target.artifact.source.main ir1Fuel = .ok (store, value) := by + rw [compilation.attached.compiled.simulationSourceContext_eq_addressedCtx, + compilation.attached.compiled.targetSourceProduced, compilation.attached.compiled.inputProduced] + exact ownedRun + obtain ⟨baselineControl, controlFuel, heapFuel, baseline, result, locRel, + baselineRun, run, baselineRelation, heaps, values, baselineResources, resources, + allocations, costs, reclaimed, prefixes⟩ := + compilation.attached.compiled.selectedCallPhysicalMainCostLaws compilation.selection attachedRun + exact ⟨controlFuel, heapFuel, result, run, + ⟨rawValue, store, value, baseline, locRel, sourceRelation, + ⟨rawStore, addressImage, graph⟩, baselineRelation, heaps, values⟩, + resources, baselineControl, heapFuel, baseline, baselineRun, baselineResources, + allocations, costs, reclaimed, prefixes⟩ + +end Ix.Compiler.CallReuse.Compilation diff --git a/Ix/Compiler/CallReuse/Sources.lean b/Ix/Compiler/CallReuse/Sources.lean new file mode 100644 index 000000000..a6da9e0a7 --- /dev/null +++ b/Ix/Compiler/CallReuse/Sources.lean @@ -0,0 +1,135 @@ +import Ix.Compiler.Coverage.Sources +import Ix.Compiler.CallReuse.MapPipeline + +/-! +# Ixon map inputs for suspended-credit reuse + +These synthetic sources map a constant-valued direct function over a list. +The constructor wraps a non-tail recursive call. Inputs contain only canonical +Ixon constants; the ordinary validated compiler produces both intermediate IRs. +-/ + +namespace Ix.Compiler.CallReuse.Examples + +open Ix.Compiler.Ixon + +private def definition (value typ : Expr) (refs : Array Address) : Constant := + { info := .defn { kind := .defn, safety := .safe, lvls := 0, typ, value } + sharing := #[], refs, univs := #[.zero] } + +private def projection (info : ConstantInfo) : Constant := + { info, sharing := #[], refs := #[], univs := #[] } + +private def ghost (value : Expr) : Expr := + .app (.lam .erased (.sort 0) value) (.sort 0) + +private def app2 (f x y : Expr) : Expr := .app (.app f x) y + +private def inductiveType (types : Array (Nat × Expr)) : Inductive := + { isUnsafe := false, lvls := 0, params := 0, indices := 0, typ := .sort 0 + ctors := types.mapIdx fun i row => + { isUnsafe := false, lvls := 0, cidx := i.toUInt64, params := 0 + fields := row.1.toUInt64, typ := row.2 } } + +structure Source where + constants : List (Address × Constant) + root : Address + values : List Nat + replacement : Nat + aliased : Bool + uniquePrefix : Nat + dataBlock : Address + nil : Address + cons : Address + pair : Address + +def Source.config (source : Source) : Pipeline.Config := + { blobs := fun address => ((source.replacement :: source.values).find? fun value => + X86.ValidatedScalar.literalAddress value == address).map .natB + limits := + { maxConstants := 32, maxExpressionUnits := 4096, maxExpandedExpressionUnits := 4096 + maxLayer1NodeVisits := 262144, maxErasedDeclarations := 128 + maxErasureAppendCells := 8192, maxCertificateCandidates := 64 + maxCertificateValidationAttempts := 4160, maxCertificateSourceNodeWork := 1048576 + maxUsageFuel := 1000, maxErasureFuel := 1000 + maxValidationFuel := 1000, maxLoweringFuel := 1000 } } + +abbrev Source.Compilation (source : Source) := + CallReuse.MapCompilation source.constants source.root source.config 1000 1000 + +def Source.compile (source : Source) : Except Pipeline.Error source.Compilation := + CallReuse.compileMap source.constants source.root source.config + 1000 1000 1000 1000 1000 + +def source (values : List Nat) (replacement : Nat) (aliased : Bool) (uniquePrefix : Nat := 0) : + Except String Source := do + if values.length > 64 then throw "map fixture exceeds 64 list elements" + if uniquePrefix > values.length || (!aliased && uniquePrefix != 0) then + throw "map alias prefix is outside the input" + let natT := Expr.recur 0 #[] + let listT := Expr.recur 1 #[] + let stepT := .all .many .shared natT + (.all .many .shared listT (.all .many .shared listT listT)) + let recursor : Recursor := + { k := false, isUnsafe := false, lvls := 0, params := 0, indices := 0 + motives := 0, minors := 2 + typ := .all .many .shared listT + (.all .many .shared stepT (.all .many .shared listT listT)) + rules := #[ + { fields := 0, rhs := .lam .many listT (.lam .many stepT (.var 1)) }, + { fields := 2 + rhs := .lam .many listT (.lam .many stepT (.lam .many natT (.lam .many listT + (.app (app2 (.var 2) (.var 1) (.var 0)) + (.app (app2 (.recur 3 #[]) (.var 3) (.var 2)) (.var 0)))))) }] } + let dataBlock ← Coverage.addressed + { info := .muts #[ + .indc (inductiveType #[(0, .recur 0 #[]), + (1, .all .many .shared (.recur 0 #[]) (.recur 0 #[]))]), + .indc (inductiveType #[(0, .recur 1 #[]), + (2, .all .many .shared (.recur 0 #[]) + (.all .many .shared (.recur 1 #[]) (.recur 1 #[])))]), + .indc (inductiveType #[(2, .all .many .shared (.recur 1 #[]) + (.all .many .shared (.recur 1 #[]) (.recur 2 #[])))]), + .recr recursor] + sharing := #[], refs := #[], univs := #[.zero] } + let nil ← Coverage.addressed (projection (.cPrj { idx := 1, cidx := 0, block := dataBlock.1 })) + let cons ← Coverage.addressed (projection (.cPrj { idx := 1, cidx := 1, block := dataBlock.1 })) + let pair ← Coverage.addressed (projection (.cPrj { idx := 2, cidx := 0, block := dataBlock.1 })) + let natType ← Coverage.addressed (projection (.iPrj { idx := 0, block := dataBlock.1 })) + let listType ← Coverage.addressed (projection (.iPrj { idx := 1, block := dataBlock.1 })) + let pairType ← Coverage.addressed (projection (.iPrj { idx := 2, block := dataBlock.1 })) + let worker ← Coverage.addressed (definition + (.lam .many (.ref 0 #[]) (ghost (.nat 1))) + (.all .many .shared (.ref 0 #[]) (.ref 0 #[])) + #[natType.1, X86.ValidatedScalar.literalAddress replacement]) + let base ← Coverage.addressed (definition (ghost (.ref 0 #[])) (.ref 1 #[]) #[nil.1, listType.1]) + let step ← Coverage.addressed (definition + (.lam .many (.ref 2 #[]) (.lam .many (.ref 3 #[]) (.lam .many (.ref 3 #[]) + (app2 (.ref 0 #[]) (.app (.ref 1 #[]) (.var 2)) (.var 0))))) + (.all .many .shared (.ref 2 #[]) + (.all .many .shared (.ref 3 #[]) (.all .many .shared (.ref 3 #[]) (.ref 3 #[])))) + #[cons.1, worker.1, natType.1, listType.1]) + let map ← Coverage.addressed (projection (.rPrj { idx := 3, block := dataBlock.1 })) + let call := fun major => .app (app2 (.ref 0 #[]) (.ref 6 #[]) (.ref 7 #[])) major + let heads := values.mapIdx fun index _ => ghost (.nat (index + 8).toUInt64) + let input := heads.foldr (fun head tail => app2 (.ref 2 #[]) head tail) + (ghost (.ref 1 #[])) + let body := if aliased then + let suffix := (heads.drop uniquePrefix).foldr (fun head tail => app2 (.ref 2 #[]) head tail) + (ghost (.ref 1 #[])) + let withPrefix := (heads.take uniquePrefix).foldr (fun head tail => app2 (.ref 2 #[]) head tail) + (.var 0) + .letE false (.ref 3 #[]) suffix + (app2 (.ref 4 #[]) (call withPrefix) (.var 0)) + else call input + let entry ← Coverage.addressed (definition body + (if aliased then .ref 5 #[] else .ref 3 #[]) + (#[map.1, nil.1, cons.1, listType.1, pair.1, pairType.1, base.1, step.1] ++ + (values.map X86.ValidatedScalar.literalAddress).toArray)) + return { + constants := [dataBlock, nil, cons, pair, natType, listType, pairType, + worker, map, base, step, entry] + root := entry.1, values, replacement, aliased, uniquePrefix + dataBlock := dataBlock.1, nil := nil.1, cons := cons.1, pair := pair.1 } + +end Ix.Compiler.CallReuse.Examples diff --git a/Ix/Compiler/Coverage/HeapSnapshot.lean b/Ix/Compiler/Coverage/HeapSnapshot.lean new file mode 100644 index 000000000..abef39a70 --- /dev/null +++ b/Ix/Compiler/Coverage/HeapSnapshot.lean @@ -0,0 +1,16 @@ +import Ix.Compiler.Coverage.Snapshot + +/-! Shared JSON observations for source-driven heap fixtures. -/ + +namespace Ix.Compiler.Coverage + +open Lean + +deriving instance ToJson for IxIR1.RVal +deriving instance ToJson for IxIR1.Node +deriving instance ToJson for IxIR1.NodeBox +deriving instance ToJson for IxIR1.Store +deriving instance ToJson for IxIR2.Eval.Counters +deriving instance ToJson for IxIR2.Eval.Store + +end Ix.Compiler.Coverage diff --git a/Ix/Compiler/Coverage/Report.lean b/Ix/Compiler/Coverage/Report.lean new file mode 100644 index 000000000..e7b454f4c --- /dev/null +++ b/Ix/Compiler/Coverage/Report.lean @@ -0,0 +1,120 @@ +import Ix.Compiler.Coverage.Run +import Ix.Compiler.Coverage.StdContact +import Ix.Compiler.Coverage.Upstream +import Ix.Compiler.IxIR1.WellModedGen + +/-! The production negative boundary and the pre-existing generated IR corpus +accompany the positive synthetic Ixon cases in one deterministic report. -/ + +namespace Ix.Compiler.Coverage + +open Lean Ix.Compiler.Ixon + +deriving instance ToJson for Catalog.Stats +deriving instance ToJson for IxIR1.WellModedGen.Summary + +private def productionInput (loaded : Catalog.Loaded) + (constants : List (Address × Constant)) (root : Address) : Except String Json := do + let stored := loaded.pieces.toList.flatMap (·.constants.toList) + let records ← constants.mapM fun (address, constant) => do + let some record := stored.find? (·.address == address) + | throw "production source snapshot lost an original byte record" + if record.constant != constant then throw "production source snapshot changed a constant" + return Json.mkObj [("key", toJson address), ("bytes", byteJson record.bytes)] + let references := constants.flatMap (fun entry => CatalogContactFixture.dependencies entry.2) + let blobs := loaded.blobs.filter (fun entry => references.contains entry.1) + return Json.mkObj [ + ("root", toJson root), ("constants", toJson records), + ("blob_inputs", toJson (blobs.map fun (address, bytes) => + Json.mkObj [("key", toJson address), ("bytes", byteJson bytes)])), + ("provenance", Json.mkObj [ + ("members_root", toJson loaded.manifest.membersRoot), + ("content_root", toJson loaded.manifest.contentRoot), + ("piece_hash", toJson CatalogContactFixture.expectedPieceHash), + ("toolchain", toJson "leanprover/lean4:v4.33.1"), + ("source_pin", toJson "git:ix@6f18ea907b78d06f7dc0917c43beb385561c35f4")]), + ("check_fuel", toJson UsageCheck.defaultFuel), ("limits", toJson Pipeline.defaultLimits)] + +private def productionCase (loaded : Catalog.Loaded) (name rootKind : String) + (constants : List (Address × Constant)) (root : Address) (stage : String) (failure : Json) + (details : Json) (partialCompilation : Json := Json.null) : Except String CaseResult := do + let input ← productionInput loaded constants root + return { + name + row := Json.mkObj [ + ("name", toJson name), ("origin", toJson "production-ixon"), + ("root_kind", toJson rootKind), ("root", toJson root), + ("source_constants", toJson constants.length), ("last_accepted_stage", toJson stage), + ("rejection", failure), ("observation", Json.null), + ("ir1_root", Json.null), ("hpt_roots", Json.null), ("features", Json.null), + ("snapshot", toJson s!"{name}.json"), ("object", Json.null)] + snapshot := Json.mkObj [("format", toJson "compilatrix/source-case/1"), + ("input", input), ("compilation", partialCompilation), ("observations", failure), ("details", details)] } + +def productionCases (loaded : Catalog.Loaded) : Except String (List CaseResult) := do + let some rejected := loaded.constants.find? (fun entry => + entry.1.toHex == CatalogContactFixture.expectedPipelineAddress) + | throw "production contact lost the rejected constant" + let closure := CatalogContactFixture.dependencyClosure loaded.constants rejected.1 + if closure.length != 17 || !CatalogContactFixture.isClosed loaded.constants closure || + CatalogContactFixture.dependencyClosure closure rejected.1 != closure then + throw "production dependency closure drifted" + for entry in closure do + if entry.1 != rejected.1 && CatalogContactFixture.isClosed loaded.constants + (closure.filter (fun candidate => candidate.1 != entry.1)) then + throw "production dependency closure contains a removable constant" + -- Missing definitions alter telescope/erasure decisions, so deleting all + -- dependencies is not a valid minimization of this production failure. + match Pipeline.checkProgram [rejected] with + | .error (.usage root (.typeBinderRuntimeUse .linear)) => + if root != rejected.1 then throw "isolated production rejection changed root" + | _ => throw "isolated production context diagnostic drifted" + let some remaining := loaded.constants.find? (fun entry => + entry.1.toHex == CatalogContactFixture.expectedRemainingFreezeAddress) + | throw "production contact lost the remaining freeze root" + if !CatalogContactFixture.freezesAt loaded.constants remaining.1 then + throw "production contact remaining freezeNeeded rejection drifted" + match Pipeline.checkProgram closure with + | .ok () => pure () + | .error error => throw s!"original closed production slice no longer passes usage: {repr error}" + match Pipeline.compileValidated closure rejected.1 with + | .error (.validate address message) => + if address != rejected.1 || message != "reference lacks a Covered certificate" then + throw "production slice Covered diagnostic drifted" + | _ => throw "production slice no longer reaches its checked erasure boundary" + let partialCompilation ← addressedSnapshot closure rejected.1 {} Erase.defaultFuel + let full ← productionCase loaded "std-contact" "environment" loaded.constants + loaded.manifest.contentRoot "ixon" + (Json.mkObj [("stage", toJson "usage"), ("code", toJson "freezeNeeded"), + ("root", toJson remaining.1), ("message", Json.null)]) (toJson loaded.stats) + let minimized ← productionCase loaded "std-failure-closure" "constant" closure rejected.1 "addressed-ixir0" + (Json.mkObj [("stage", toJson "validated-erasure"), ("code", toJson "missingCovered"), + ("root", toJson rejected.1), ("message", toJson "reference lacks a Covered certificate")]) + (Json.mkObj [ + ("parent_environment", toJson loaded.manifest.contentRoot), + ("original_constants", toJson loaded.constants.length), + ("closure_keys", toJson (closure.map (·.1))), + ("closed", toJson true), ("single_deletion_minimal", toJson true), + ("previous_rejection", toJson "reservedIdentityCollision"), ("usage_now_accepted", toJson true), + ("isolated_rejection", Json.mkObj [ + ("code", toJson "typeBinderRuntimeUse"), ("uses", toJson "linear")])]) partialCompilation + return [full, minimized] + +def generatedCorpus : Except String Json := do + match IxIR1.WellModedGen.checkCorpus with + | some failure => throw s!"generated IxIR0 corpus failed: {repr failure}" + | none => + return Json.mkObj [ + ("origin", toJson "generated-ixir0"), + ("seed", toJson IxIR1.WellModedGen.defaultSeed), + ("summary", toJson (IxIR1.WellModedGen.summarize)), + ("property", toJson "IxIR0/IxIR1 value agreement and result reclamation, or exact lowering rejection")] + +def report (results : List CaseResult) (corpus : Json) : Json := + Json.mkObj [ + ("format", toJson "compilatrix/source-coverage/1"), + ("policy_version", toJson (2 : Nat)), + ("source_cases", toJson (results.map (·.row))), + ("generated_ir_corpus", corpus)] + +end Ix.Compiler.Coverage diff --git a/Ix/Compiler/Coverage/Run.lean b/Ix/Compiler/Coverage/Run.lean new file mode 100644 index 000000000..600eb8972 --- /dev/null +++ b/Ix/Compiler/Coverage/Run.lean @@ -0,0 +1,218 @@ +import Ix.Compiler.Coverage.Snapshot +import Ix.Compiler.X86.ELFValidate + +/-! Run each fixed Ixon input through the actual compiler and independently +observe each executable stage. Expected rejection is part of the coverage +matrix; any other rejection or observation drift fails the gate. -/ + +namespace Ix.Compiler.Coverage + +open Lean Ix.Compiler.Ixon + +structure Features where + directCalls : Nat := 0 + tailCalls : Nat := 0 + papps : Nat := 0 + applies : Nat := 0 + constructorSwitches : Nat := 0 + natSwitches : Nat := 0 + deriving ToJson + +def features (program : IxIR2.Program) : Features := Id.run do + let functions := program.main :: program.declarations.filterMap fun + | (_, .fn function) => some function + | _ => none + let mut result : Features := {} + for function in functions do + for block in function.blocks do + for instruction in block.instructions do + result := match instruction with + | .call .. | .callSelf .. => { result with directCalls := result.directCalls + 1 } + | .papp .. => { result with papps := result.papps + 1 } + | .apply .. => { result with applies := result.applies + 1 } + | _ => result + result := match block.terminator with + | .tailCall .. | .tailCallSelf .. => { result with tailCalls := result.tailCalls + 1 } + | .switchValue _ constructors natPeel => + { result with + constructorSwitches := result.constructorSwitches + (if constructors.isEmpty then 0 else 1) + natSwitches := result.natSwitches + (if natPeel.isSome then 1 else 0) } + | _ => result + return result + +private def scalar0 (name : String) : Except IxIR0.Err IxIR0.Value → Except String Nat + | .ok (.lit (.nat number)) => .ok number + | .ok _ => .error s!"{name} returned a non-Nat value" + | .error error => .error s!"{name} failed: {repr error}" + +private def scalar1 (name : String) (value : IxIR1.RVal) : Except String Nat := + match value with + | .lit (.nat number) => .ok number + | _ => .error s!"{name} returned a non-Nat value" + +private def heapCounters (store : IxIR1.Store) : Json := + Json.mkObj [("allocs", toJson store.allocs), ("frees", toJson store.frees), + ("rcops", toJson store.rcops), ("reuses", toJson store.reuses), ("live", toJson store.live)] + +private def sameCounters (first second : IxIR1.Store) : Bool := + first.allocs == second.allocs && first.frees == second.frees && + first.rcops == second.rcops && first.reuses == second.reuses && first.live == second.live + +private def sameStore (first second : IxIR2.Eval.Store) : Bool := + first.counters == second.counters && first.heap.nodes.size == second.heap.nodes.size && + (first.heap.nodes.zip second.heap.nodes).all fun + | (none, none) => true + | (some left, some right) => + left.world == right.world && left.rc == right.rc && left.node == right.node + | _ => false + +private def physicalObservation (source : Source) (number : Nat) + (result : IxIR2.Eval.Result) : Json := + Json.mkObj [ + ("nat", toJson number), ("heap", heapCounters result.store.heap), + ("peak_live_nodes", toJson result.store.peakLiveNodes), + ("control_steps", toJson (source.policy.controlFuel - result.controlRemaining)), + ("heap_work", toJson (source.policy.heapFuel - result.heapRemaining)), + ("reset_attempts", toJson result.store.resetAttempts), + ("hot_resets", toJson result.store.hotResets), ("cold_resets", toJson result.store.coldResets), + ("reused_payload_units", toJson result.store.reusedPayloadUnits)] + +structure Observation where + summary : Json + stages : Json + +def Source.observe (source : Source) (attached : source.Attached) + (number : Nat) : Except String Observation := do + let sourceNumber ← + match Ixon.Eval.eval (Pipeline.validatedEvalCtx source.constants source.config) + source.policy.evalFuel (Pipeline.validatedMainFrame source.root) [] Pipeline.validatedMainSource with + | .ok (.litV (.natL number)) => pure number + | .ok _ => throw "Ixon returned a non-Nat value" + | .error error => throw s!"Ixon execution failed: {repr error}" + let artifact := attached.source.artifact + let raw0 ← scalar0 "raw IxIR0" (IxIR0.eval { env := IxIR0.Env.ofList artifact.rawErasedDecls } + source.policy.evalFuel [] (.ref source.root)) + let addressed0 ← scalar0 "addressed IxIR0" (IxIR0.eval { env := IxIR0.Env.ofList artifact.erasedDecls } + source.policy.evalFuel [] attached.source.erasure.result.main) + let (rawStore, rawValue) ← + (IxIR1.runOwnedMain { decls := IxIR1.Env.ofList attached.source.lowering.raw } + .shared attached.source.lowering.mainCode source.policy.evalFuel).mapError + (fun error => s!"raw IxIR1 failed: {repr error}") + let raw1 ← scalar1 "raw IxIR1" rawValue + let (store, value) ← + (IxIR1.runOwnedMain { decls := artifact.targetDeclEnv } .shared artifact.main source.policy.evalFuel).mapError + (fun error => s!"addressed IxIR1 failed: {repr error}") + let addressed1 ← scalar1 "addressed IxIR1" value + let context := IxIR2.Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas + let logical ← (IxIR2.Eval.runMain context .logical attached.target.artifact.program + source.policy.controlFuel source.policy.heapFuel).mapError (fun error => s!"logical IxIR2 failed: {repr error}") + let physical ← (IxIR2.Eval.runMain context .physical attached.target.artifact.program + source.policy.controlFuel source.policy.heapFuel).mapError (fun error => s!"physical IxIR2 failed: {repr error}") + let logicalNumber ← scalar1 "logical IxIR2" logical.value + let physicalNumber ← scalar1 "physical IxIR2" physical.value + if [sourceNumber, raw0, addressed0, raw1, addressed1, logicalNumber, physicalNumber].any (· != number) then + throw "source and intermediate Nat observations disagree" + if !sameCounters rawStore store || !sameCounters store logical.store.heap || + !sameCounters store physical.store.heap || !sameStore logical.store physical.store || + logical.controlRemaining != physical.controlRemaining || logical.heapRemaining != physical.heapRemaining || + store.live != 0 then + throw "intermediate counters, complete baseline stores, or execution budgets disagree" + let summary := physicalObservation source number physical + return { + summary + stages := Json.mkObj [ + ("ixon", toJson sourceNumber), ("raw_ixir0", toJson raw0), ("ixir0", toJson addressed0), + ("raw_ixir1", Json.mkObj [("nat", toJson raw1), ("heap", heapCounters rawStore)]), + ("ixir1", Json.mkObj [("nat", toJson addressed1), ("heap", heapCounters store)]), + ("logical_ixir2", physicalObservation source logicalNumber logical), + ("physical_ixir2", summary)] } + +structure CaseResult where + name : String + row : Json + snapshot : Json + object : Option ByteArray := none + +private def rejection (stage code : String) (root : Address) + (message : Option String := none) : Json := + Json.mkObj [("stage", toJson stage), ("code", toJson code), + ("root", toJson root), ("message", toJson message)] + +private def sourceRow (source : Source) (stage : String) (failure observation : Json) + (compiled : Option source.Attached := none) (hasObject : Bool := false) : Json := + Json.mkObj [ + ("name", toJson source.name), ("origin", toJson "synthetic-ixon"), + ("root_kind", toJson "constant"), ("root", toJson source.root), + ("source_constants", toJson source.constants.length), ("last_accepted_stage", toJson stage), + ("rejection", failure), ("observation", observation), + ("ir1_root", match compiled with + | none => Json.null + | some attached => toJson (IxIR1.Optimizer.graphRoot attached.source.artifact.targetArtifacts + attached.source.artifact.main)), + ("hpt_roots", match compiled with | none => Json.null | some attached => toJson attached.hpt.result.addresses), + ("features", match compiled with | none => Json.null | some attached => toJson (features attached.target.artifact.program)), + ("snapshot", toJson s!"{source.name}.json"), + ("object", if hasObject then toJson s!"{source.name}.o" else Json.null)] + +private def caseSnapshot (source : Source) (compilation observations : Json) : Json := + Json.mkObj [("format", toJson "compilatrix/source-case/1"), + ("input", source.inputSnapshot), ("compilation", compilation), ("observations", observations)] + +def runSource (source : Source) : Except String CaseResult := do + match source.compile with + | .error (.pipeline (.usage root .freezeNeeded)) => + if source.expected != .usageFreeze || root != source.root then + throw "unexpected source freezeNeeded rejection" + let failure := rejection "usage" "freezeNeeded" root + return { name := source.name, row := sourceRow source "ixon" failure Json.null + snapshot := caseSnapshot source Json.null failure } + | .error (.pipeline (.validate root message)) => + if source.expected != .externRejected || root != source.root || + message != "validated extern ownership ABI rejects this declaration" then + throw s!"unexpected erasure-validation rejection: {root}: {message}" + let failure := rejection "validated-erasure" "extern-ownership" root (some message) + return { name := source.name, row := sourceRow source "usage" failure Json.null + snapshot := caseSnapshot source Json.null failure } + | .error error => throw s!"compiler rejected {source.name}: {repr error}" + | .ok attached => + let .scalar number shouldSelect := source.expected | throw "compiler accepted a negative source case" + let observation ← source.observe attached number + let compilation := source.compilationSnapshot attached + match X86.Select.select attached.target.artifact.program with + | .error .unsupportedScalarShape => + if shouldSelect then throw "source scalar failed selection" + let failure := rejection "x86-selection" "unsupportedScalarShape" source.root + return { name := source.name + row := sourceRow source "ixir2" failure observation.summary (some attached) + snapshot := caseSnapshot source compilation observation.stages } + | .error (.invalidSource (.invalid _ .schema "missing constructor schema")) => + if shouldSelect || !(source.name.startsWith "ctor-" || source.name.startsWith "nat-") then + throw "unexpected constructor-schema boundary in scalar selection" + let failure := rejection "x86-selection" "missingConstructorSchema" source.root + return { name := source.name + row := sourceRow source "ixir2" failure observation.summary (some attached) + snapshot := caseSnapshot source compilation observation.stages } + | .error error => throw s!"unexpected selector error: {repr error}" + | .ok selected => + if !shouldSelect || selected.word.toNat != number then + throw "selector accepted an unexpected graph or truncated its Nat" + let targetRun := X86.runFrom X86.Runtime.rejecting selected.target 2 (X86.Core.empty 0x1008) + if targetRun.status != .halted selected.word || targetRun.core.readReg .rsp != 0x1008 then + throw "typed x86 observation disagrees with the source" + let stream ← (X86.Stream.encode selected.target).mapError (fun error => reprStr error) + let encoded := stream.output + let provenance : X86.ELF.Provenance := + .ixir1Policy (IxIR1.Optimizer.graphRoot attached.source.artifact.targetArtifacts + attached.source.artifact.main) X86.ValidatedScalar.loweringVersion X86.ValidatedScalar.passPolicyVersion + let object ← (X86.ELF.writeChecked + { encoded, entryBlock := selected.target.program.entry, provenance }).mapError (fun error => reprStr error) + return { + name := source.name + row := sourceRow source "elf" Json.null observation.summary (some attached) true + snapshot := caseSnapshot source compilation + (Json.mkObj [("intermediate", observation.stages), ("typed_x86", toJson selected.word), + ("text", byteJson encoded.text), ("provenance", byteJson provenance.bytes)]) + object := some object.bytes } + +end Ix.Compiler.Coverage diff --git a/Ix/Compiler/Coverage/Snapshot.lean b/Ix/Compiler/Coverage/Snapshot.lean new file mode 100644 index 000000000..68ad4382e --- /dev/null +++ b/Ix/Compiler/Coverage/Snapshot.lean @@ -0,0 +1,164 @@ +import Lean +import Ix.Compiler.Coverage.Sources +import Ix.Compiler.IxIR1.HPTCache + +/-! Complete diagnostic snapshots for comparing fresh compiler processes. +Ixon, IxIR₀, IxIR₁, and HPT records use their existing canonical bytes and +identities. The IxIR₂ JSON is a structural diagnostic only: it has no decoder, +content address, persistent cache role, or claim to be an IxIR₂ wire format. +Proof terms are erased; their retained executable artifacts are compared. -/ + +namespace Ix.Compiler.Coverage + +open Lean Ix.Compiler.Ixon + +instance : ToJson Address := ⟨fun address => toJson address.toHex⟩ +deriving instance ToJson for Owned +deriving instance ToJson for Pipeline.Limits +deriving instance ToJson for Policy +deriving instance ToJson for IxIR1.HPT.Limits +deriving instance ToJson for IxIR1.HPT.ProducerLimits +deriving instance ToJson for IxIR1.HPT.ProducerStats +deriving instance ToJson for IxIR0.Literal +deriving instance ToJson for IxIR1.CtorId +deriving instance ToJson for IxIR2.Atom +deriving instance ToJson for IxIR2.ParamPassing +deriving instance ToJson for IxIR2.Param +deriving instance ToJson for IxIR2.Signature +deriving instance ToJson for IxIR2.BorrowLender +deriving instance ToJson for IxIR2.ValueCap +deriving instance ToJson for IxIR2.CreditCap +deriving instance ToJson for IxIR2.CtorSchema +deriving instance ToJson for IxIR2.Instr +deriving instance ToJson for IxIR2.Edge +deriving instance ToJson for IxIR2.CtorAlt +deriving instance ToJson for IxIR2.NatPeel +deriving instance ToJson for IxIR2.Terminator +deriving instance ToJson for IxIR2.Block +deriving instance ToJson for IxIR2.Function +deriving instance ToJson for IxIR2.Decl +deriving instance ToJson for IxIR2.Program +deriving instance ToJson for IxIR2.Validate.Stats +deriving instance ToJson for IxIR2.Pipeline.ConstructorInfo +deriving instance ToJson for IxIR2.Pipeline.RecursorOrigin + +def hex (bytes : ByteArray) : String := Id.run do + let digits := "0123456789abcdef".toList.toArray + let mut chars : Array Char := #[] + for byte in bytes do + chars := chars.push digits[byte.toNat / 16]! + chars := chars.push digits[byte.toNat % 16]! + return String.ofList chars.toList + +def byteJson (bytes : ByteArray) : Json := toJson (hex bytes) + +def ir0Entries (entries : List (Address × IxIR0.Decl)) : Json := + toJson (entries.map fun (address, declaration) => + Json.mkObj [("key", toJson address), ("preimage", byteJson declaration.preimage)]) + +def ir1Entries (entries : List (Address × IxIR1.Decl)) : Json := + toJson (entries.map fun (address, declaration) => + Json.mkObj [("key", toJson address), ("preimage", byteJson declaration.preimage)]) + +def ir0Block (block : IxIR0.MutualBlock.Result) : Json := + Json.mkObj [ + ("root", toJson block.blockAddress), + ("preimage", byteJson (IxIR0.MutualBlock.Block.preimage block.blockMembers)), + ("members", ir0Entries block.members), ("address_map", toJson block.addressMap)] + +def ir0Group (group : IxIR0.Readdress.Group) : Json := + Json.mkObj [ + ("kind", toJson (match group with | .stable _ => "stable" | .mutual _ => "mutual")), + ("entries", ir0Entries group.entries)] + +/-- Complete eraser/addressing output, before the source erasure certificate +has been accepted. This is useful even when the next validator rejects. -/ +def erasedSnapshot (root : Address) (erasure : EraseAddressed.Result) : Json := + Json.mkObj [ + ("raw_declarations", ir0Entries erasure.raw), + ("raw_main", byteJson (IxIR0.Expr.bytes (.ref root))), + ("groups", toJson (erasure.groups.map ir0Group)), + ("declarations", ir0Entries erasure.declarations), + ("main", byteJson erasure.main.bytes), + ("blocks", toJson (erasure.addressed.blocks.map ir0Block)), + ("address_map", toJson erasure.addressMap)] + +def addressedSnapshot (constants : List (Address × Constant)) (root : Address) + (config : Pipeline.Config) (fuel : Nat) : Except String Json := do + let ctx := EraseValidator.eraseCtxOf (Pipeline.validatedEvalCtx constants config) + let erasure ← (EraseAddressed.run ctx constants (.ref root) fuel).mapError reprStr + return Json.mkObj [ + ("format", toJson "compilatrix/addressed-erasure/1"), + ("source_erasure_certified", toJson false), + ("ixir0", erasedSnapshot root erasure)] + +def ir1Artifact : IxIR1.ReaddressAll.Artifact → Json + | .stable address declaration => + Json.mkObj [("kind", toJson "stable"), ("root", toJson address), + ("preimage", byteJson declaration.preimage)] + | .ordinary address declaration => + Json.mkObj [("kind", toJson "ordinary"), ("root", toJson address), + ("preimage", byteJson declaration.preimage)] + | .mutual block => + Json.mkObj [("kind", toJson "mutual"), ("root", toJson block.blockAddress), + ("preimage", byteJson (IxIR1.MutualBlock.Block.preimage block.blockMembers)), + ("members", ir1Entries block.members), ("address_map", toJson block.addressMap)] + +private def hptMembers (members : List (Address × IxIR1.HPT.Fact)) : Json := + toJson (members.map fun (address, fact) => + Json.mkObj [("key", toJson address), ("fact_bytes", byteJson fact.bytes)]) + +def hptCandidate (candidate : IxIR1.HPT.CandidateArtifact) : Json := + Json.mkObj [("program_root", toJson candidate.programIdentity), + ("members", hptMembers candidate.members)] + +def hptArtifact (artifact : IxIR1.HPT.Artifact) : Json := + Json.mkObj [ + ("program_root", toJson artifact.programIdentity), + ("cache_key", toJson artifact.cacheKey), ("root", toJson artifact.address), + ("dependencies", toJson artifact.dependencies), ("members", hptMembers artifact.members), + ("bytes", byteJson (IxIR1.HPT.Cache.encodeArtifact artifact))] + +def Source.inputSnapshot (source : Source) : Json := + Json.mkObj [ + ("root", toJson source.root), + ("constants", toJson (source.constants.map fun (address, constant) => + Json.mkObj [("key", toJson address), ("bytes", byteJson (ser constant))])), + ("literal_inputs", toJson (source.literals.map fun number => + Json.mkObj [("key", toJson (X86.ValidatedScalar.literalAddress number)), + ("nat", toJson number)])), + ("nat_block", toJson source.natBlock), ("policy", toJson source.policy)] + +/-- Compare both pre-address and final graphs, every renaming map and mutual +artifact, the actual checked HPT certificate and summary records, and the +finite IxIR₂ sidecars. No `repr` digest stands in for any of these artifacts. -/ +def Source.compilationSnapshot (source : Source) (attached : source.Attached) : Json := + let erasure := attached.source.erasure.result + let lowering := attached.source.lowering + let artifact := attached.source.artifact + Json.mkObj [ + ("format", toJson "compilatrix/compiler-snapshot/1"), + ("source", source.inputSnapshot), + ("ixir0", erasedSnapshot source.root erasure), + ("ixir1", Json.mkObj [ + ("root", toJson (IxIR1.Optimizer.graphRoot artifact.targetArtifacts artifact.main)), + ("raw_declarations", ir1Entries lowering.raw), + ("raw_main", byteJson lowering.mainCode.bytes), + ("artifacts", toJson (artifact.targetArtifacts.map ir1Artifact)), + ("declarations", ir1Entries artifact.targetDecls), + ("main", byteJson artifact.main.bytes), + ("address_map", toJson artifact.targetAddressMap), + ("reserved", toJson lowering.result.reserved)]), + ("hpt", Json.mkObj [ + ("producer_limits", toJson IxIR1.HPT.defaultProducerLimits), + ("producer_stats", toJson attached.hpt.stats), + ("candidate", toJson (attached.hpt.certificate.artifacts.map hptCandidate)), + ("artifacts", toJson (attached.hpt.result.artifacts.map hptArtifact))]), + ("ixir2_diagnostic", Json.mkObj [ + ("program", toJson attached.target.artifact.program), + ("validation_stats", toJson attached.target.stats), + ("parameter_worlds", toJson attached.sidecars.parameterEntries), + ("constructors", toJson attached.sidecars.constructors), + ("recursor_origins", toJson attached.sidecars.recursorOrigins)])] + +end Ix.Compiler.Coverage diff --git a/Ix/Compiler/Coverage/Sources.lean b/Ix/Compiler/Coverage/Sources.lean new file mode 100644 index 000000000..4979cc43e --- /dev/null +++ b/Ix/Compiler/Coverage/Sources.lean @@ -0,0 +1,169 @@ +import Ix.Compiler.X86.ValidatedScalar + +/-! Fixed, bounded Ixon inputs for the source-coverage gate. These inputs are +synthetic; the production-writer contact is loaded separately without rewriting +its bytes. Every constructed constant crosses the canonical source address gate. +No intermediate IR is supplied by these fixtures. -/ + +namespace Ix.Compiler.Coverage + +open Ix.Compiler.Ixon + +structure Policy where + limits : Pipeline.Limits + checkFuel : Nat := 500 + eraseFuel : Nat := 500 + validateFuel : Nat := 500 + lowerFuel : Nat := 500 + maxDepth : Nat := 500 + evalFuel : Nat := 1000 + controlFuel : Nat := 1000 + heapFuel : Nat := 1000 + +def sourcePolicy : Policy := + { limits := + { maxConstants := 16, maxExpressionUnits := 512, maxExpandedExpressionUnits := 512 + maxLayer1NodeVisits := 65536, maxErasedDeclarations := 128, maxErasureAppendCells := 8192 + maxCertificateCandidates := 32, maxCertificateValidationAttempts := 1024 + maxCertificateSourceNodeWork := 524288, maxUsageFuel := 500, maxErasureFuel := 500 + maxValidationFuel := 500, maxLoweringFuel := 500 } } + +inductive Expected where + | scalar (number : Nat) (selected : Bool) + | usageFreeze + | externRejected + deriving BEq, Repr + +structure Source where + name : String + constants : List (Address × Constant) + root : Address + literals : List Nat + natBlock : Option Address := none + policy : Policy := sourcePolicy + expected : Expected + +def Source.config (source : Source) : Pipeline.Config := + { blobs := fun address => + (source.literals.find? fun number => + address == X86.ValidatedScalar.literalAddress number).map .natB + natBlock := source.natBlock + limits := source.policy.limits } + +abbrev Source.Attached (source : Source) := + IxIR2.Pipeline.Attached source.constants source.root source.config .shared + source.policy.eraseFuel source.policy.lowerFuel + +def Source.compile (source : Source) : Except IxIR2.Pipeline.Error source.Attached := + IxIR2.Pipeline.compileValidated source.constants source.root source.config .shared + source.policy.checkFuel source.policy.eraseFuel source.policy.validateFuel + source.policy.lowerFuel source.policy.maxDepth + +/-- Canonicalize the synthetic expression table before crossing the ordinary +bounded semantic address gate. Production contact bytes never use this helper. -/ +def addressed (constant : Constant) : Except String (Address × Constant) := do + let some compressed := Sharing.compress? (Sharing.inlineBodies constant) + | throw "synthetic source compression failed" + let some info := ConstantIdentityLaws.replaceInfoExprs? constant.info compressed.bodies.toList + | throw "synthetic source body restoration failed" + let canonical := { constant with info, sharing := compressed.table } + match canonical.addressChecked with + | .error error => throw s!"synthetic source address rejected: {repr error}" + | .ok address => return (address, canonical) + +private def definition (value : Expr) (refs : Array Address := #[]) + (typ : Expr := .sort 0) : Constant := + { info := .defn { kind := .defn, safety := .safe, lvls := 0, typ, value } + sharing := #[], refs, univs := #[.zero] } + +private def ghost (value : Expr) : Expr := + .app (.lam .erased (.sort 0) value) (.sort 0) + +private def projection (info : ConstantInfo) : Constant := + { info, sharing := #[], refs := #[], univs := #[] } + +private def natInductive : Ixon.Inductive := + { isUnsafe := false, lvls := 0, params := 0, indices := 0 + typ := .sort 0 + ctors := #[ + { isUnsafe := false, lvls := 0, cidx := 0, params := 0, fields := 0 + typ := .recur 0 #[] }, + { isUnsafe := false, lvls := 0, cidx := 1, params := 0, fields := 1 + typ := .all .many .shared (.recur 0 #[]) (.recur 0 #[]) }] } + +/-- A two-way recursor returns 11 for zero and 22 for successor. Its field +is intentionally unused; both alternatives must still execute through the +checked constructor/Nat dispatch path. -/ +private def tagRecursor : Recursor := + { k := false, isUnsafe := false, lvls := 0 + params := 0, indices := 0, motives := 0, minors := 0 + typ := .all .many .shared (.recur 0 #[]) (.sort 0) + rules := #[ + { fields := 0, rhs := .nat 0 }, + { fields := 1, rhs := .lam .many (.recur 0 #[]) (.nat 1) }] } + +def scalar (name : String) (number : Nat) (selected : Bool) : Except String Source := do + let entry ← addressed (X86.ValidatedScalar.constant number) + return { + name, constants := [entry], root := entry.1, literals := [number] + policy := { limits := (X86.ValidatedScalar.config number).limits + checkFuel := 100, eraseFuel := 100, validateFuel := 100 + lowerFuel := 100, maxDepth := 100 } + expected := .scalar number selected } + +/-- Two uses of a known identity force an ordinary direct call followed by a +tail call. Its Nat argument is computed through the shared PAP path. -/ +def directCall : Except String Source := do + let block ← addressed + { info := .muts #[.indc natInductive], sharing := #[], refs := #[], univs := #[.zero] } + let natType ← addressed (projection (.iPrj { idx := 0, block := block.1 })) + let worker ← addressed (definition (.lam .many (.ref 0 #[]) (.var 0)) + #[natType.1] (.all .many .shared (.ref 0 #[]) (.ref 0 #[]))) + let entry ← addressed (definition + (.app (.ref 0 #[]) (.app (.ref 0 #[]) (ghost (.nat 1)))) + #[worker.1, X86.ValidatedScalar.literalAddress 42, natType.1] (.ref 2 #[])) + return { + name := "direct-call", constants := [block, natType, worker, entry] + root := entry.1, literals := [42], expected := .scalar 42 false } + +def dispatch (literal successorCase : Bool) : Except String Source := do + let block ← addressed + { info := .muts #[.indc natInductive, .recr tagRecursor] + sharing := #[] + refs := #[X86.ValidatedScalar.literalAddress 11, X86.ValidatedScalar.literalAddress 22] + univs := #[.zero] } + let recursor ← addressed (projection (.rPrj { idx := 1, block := block.1 })) + let zero ← addressed (projection (.cPrj { idx := 0, cidx := 0, block := block.1 })) + let successor ← addressed (projection (.cPrj { idx := 0, cidx := 1, block := block.1 })) + let number := if successorCase then 3 else 0 + let major := if literal then ghost (.nat 1) + else if successorCase then .app (.ref 3 #[]) (ghost (.nat 1)) + else ghost (.ref 2 #[]) + let entry ← addressed (definition (.app (.ref 0 #[]) major) + #[recursor.1, X86.ValidatedScalar.literalAddress number, zero.1, successor.1]) + return { + name := s!"{if literal then "nat" else "ctor"}-{if successorCase then "succ" else "zero"}" + constants := [block, recursor, zero, successor, entry], root := entry.1 + literals := [number, 11, 22], natBlock := if literal then some block.1 else none + expected := .scalar (if successorCase then 22 else 11) false } + +def bareLiteral : Except String Source := do + let entry ← addressed (X86.ValidatedScalar.constant 42 false) + return { name := "bare-literal", constants := [entry], root := entry.1 + literals := [42], expected := .usageFreeze } + +def externSource : Except String Source := do + let entry ← addressed + { info := .axio { isUnsafe := false, lvls := 0, typ := .sort 0 } + sharing := #[], refs := #[], univs := #[.zero] } + return { name := "extern", constants := [entry], root := entry.1 + literals := [], expected := .externRejected } + +def sources : Except String (List Source) := do + return [← scalar "scalar-zero" 0 true, ← scalar "scalar-42" 42 true, + ← scalar "scalar-max" (UInt64.size - 1) true, + ← scalar "scalar-overflow" UInt64.size false, + ← directCall, ← dispatch false false, ← dispatch false true, + ← dispatch true false, ← dispatch true true, ← bareLiteral, ← externSource] + +end Ix.Compiler.Coverage diff --git a/Ix/Compiler/Coverage/StdContact.lean b/Ix/Compiler/Coverage/StdContact.lean new file mode 100644 index 000000000..ae790e013 --- /dev/null +++ b/Ix/Compiler/Coverage/StdContact.lean @@ -0,0 +1,136 @@ +import Ix.Compiler.Ixon.Catalog +import Ix.Compiler.Pipeline + +/-! Shared byte-exact production-writer fixture data for runtime tests and the +source-coverage gate. Loading never rewrites or reencodes the captured input. -/ + +open Ix.Compiler.Ixon + +namespace CatalogContactFixture + +def directory : String := "Tests/Fixtures/Compiler/ixon-std-contact" + +def isWhitespace (c : Char) : Bool := + c == ' ' || c == '\n' || c == '\r' || c == '\t' + +def hexNibble? (c : Char) : Option UInt8 := + if '0' ≤ c && c ≤ '9' then some (c.toNat - '0'.toNat).toUInt8 + else if 'a' ≤ c && c ≤ 'f' then some (c.toNat - 'a'.toNat + 10).toUInt8 + else if 'A' ≤ c && c ≤ 'F' then some (c.toNat - 'A'.toNat + 10).toUInt8 + else none + +def decodeHex (text : String) : Except String ByteArray := do + let digits := (text.toList.filter fun c => !isWhitespace c).toArray + if digits.size % 2 != 0 then + throw s!"odd hex digit count {digits.size}" + let mut bytes := ByteArray.empty + for index in [:digits.size / 2] do + let some high := hexNibble? digits[2 * index]! + | throw s!"invalid hex digit at {2 * index}" + let some low := hexNibble? digits[2 * index + 1]! + | throw s!"invalid hex digit at {2 * index + 1}" + bytes := bytes.push (high * 16 + low) + return bytes + +def readHexAt (root : System.FilePath) (filename : String) : IO (Except String ByteArray) := do + try + let path := root / filename + if (← path.metadata).byteSize > 65536 then + return .error s!"contact hex file exceeds the 64 KiB fixture limit: {filename}" + return decodeHex (← IO.FS.readFile path) + catch error => + return .error error.toString + +def readHex (filename : String) : IO (Except String ByteArray) := + readHexAt directory filename + +def expectedStats : Catalog.Stats := + { manifestBytes := 267 + members := 1 + dependencyEdges := 0 + storageUnits := 1 + pieceBytes := 14600 + constantEntries := 54 + constantBytes := 8828 + blobEntries := 91 + blobBytes := 819 + assumptions := 0 + hints := 30 + expressionUnits := 2143 + expandedExpressionUnits := 3877 + layer1NodeVisits := 34656 + unionConstants := 54 } + +def expectedMembersRoot : String := + "4585514401609ffa79ea09af28a0e1eb87be6b3306fe357511bc59323e18e18e" + +def expectedContentRoot : String := + "1bc7e2215a1967d8c937f48526facdc7006cd4c9b7b6ef4f1063bb55c50dee02" + +def expectedPieceHash : String := + "688985515005111bde0e25969181c649ada8b77d70287a71e18751f36b495988" + +def expectedPipelineAddress : String := + "131533e96baa7f50ba89d01892243e11a1221c8831e2f394eb14f89e9a54c6c4" + +/-- C2 admits the original closed failure slice. The unchanged full catalog +then encounters this later unique-to-shared sink. -/ +def expectedRemainingFreezeAddress : String := + "a3b83ad0799bcd3d1c70c01df44141d79e7358e1f23d7d7e5cf9e01dbdc73c85" + +def load (root : System.FilePath) : IO (Except String Catalog.Loaded) := do + let manifest ← readHexAt root "manifest.hex" + let piece ← readHexAt root "CompilatrixStdContact.ixe.hex" + return do + let manifest ← manifest + let piece ← piece + if manifest.size != 267 || piece.size != 14600 || + (Address.blake3 piece).toHex != expectedPieceHash then + throw "production contact byte sizes or hash drifted" + let loaded ← (Catalog.load manifest #[piece]).mapError (fun error => reprStr error) + if loaded.manifest.membersRoot.toHex != expectedMembersRoot || + loaded.manifest.contentRoot.toHex != expectedContentRoot || + loaded.stats != expectedStats then + throw "production contact commitments or counters drifted" + let some member := loaded.manifest.members[0]? | throw "production contact member is absent" + if member.label != "CompilatrixStdContact" || member.toolchain != "leanprover/lean4:v4.33.1" || + member.sourcePin != "git:ix@6f18ea907b78d06f7dc0917c43beb385561c35f4" || + member.constCount != 54 then + throw "production contact provenance drifted" + return loaded + +/-- The dependency closure uses all reference-table entries and projection +block keys. Blob references remain in the loaded catalog; no constant bytes +or references are edited while shrinking the compilation unit. -/ +def dependencies (constant : Constant) : List Address := + constant.refs.toList ++ match constant.info with + | .iPrj projection => [projection.block] + | .cPrj projection => [projection.block] + | .rPrj projection => [projection.block] + | .dPrj projection => [projection.block] + | _ => [] + +def dependencyClosure (constants : List (Address × Constant)) (root : Address) : + List (Address × Constant) := Id.run do + let available := constants.map (·.1) + let mut reachable := [root] + for _ in [:constants.length] do + for entry in constants do + if reachable.contains entry.1 then + for address in dependencies entry.2 do + if available.contains address && !reachable.contains address then + reachable := reachable ++ [address] + return constants.filter fun entry => reachable.contains entry.1 + +def isClosed (available subset : List (Address × Constant)) : Bool := + let allKeys := available.map (·.1) + let subsetKeys := subset.map (·.1) + subset.all fun entry => (dependencies entry.2).all fun address => + !allKeys.contains address || subsetKeys.contains address + +def freezesAt (constants : List (Address × Constant)) (root : Address) : Bool := + match Ix.Compiler.Pipeline.checkProgram constants with + | .error (.usage rejected .freezeNeeded) => rejected == root + | _ => false + +end CatalogContactFixture diff --git a/Ix/Compiler/Coverage/Upstream.lean b/Ix/Compiler/Coverage/Upstream.lean new file mode 100644 index 000000000..417eb01ee --- /dev/null +++ b/Ix/Compiler/Coverage/Upstream.lean @@ -0,0 +1,289 @@ +import Ix.Compiler.Coverage.Run +import Ix.Compiler.Coverage.HeapSnapshot +import Ix.Compiler.Coverage.StdContact + +/-! Byte-exact exports from the pinned upstream Lean-to-Ixon writer. Every +positive case enters the public checked pipeline with its complete original +constant closure. The observations follow constructor identities through both +address maps and reclaim the actual returned heaps. -/ + +namespace Ix.Compiler.Coverage.Upstream + +open Lean Ix.Compiler.Ixon + +def directory : String := "Tests/Fixtures/Compiler/ixon-upstream" + +def writerPin : String := "git:ix@6f18ea907b78d06f7dc0917c43beb385561c35f4" + +inductive Expected where + | nat (number : Nat) + | missingCovered (address : String) + +structure Fixture where + name : String + pieceBytes : Nat + pieceHash : String + root : String + count : Nat + expected : Expected + +def fixtures : List Fixture := [ + ⟨"applyClosed", 662, "2e4873546afd7558d5c02b244d2713229c02f6f684c298739f0b7431e7b8df02", + "b81b754f02c1b63279a609ab4b55b609fd6f87fab7b14879f4021c3327c2eb40", 6, .nat 3⟩, + ⟨"captureClosed", 666, "280ab6f15706a3c0ed76511604abd5653a524dba4b5893b193c904db2f66f852", + "5628cfe1b4f959fb116661fc50ae8e9e4bfa470ac5d0e639a75b9d23aed12953", 6, .nat 2⟩, + ⟨"letClosed", 670, "717c04ee467799465d08c0e624f312fe619badbe7394c7fa0637f1b0c975744b", + "6c737171f1a3c482ba96cbe4998ea660fda824c578fe668ab9fdc4aae1b9754f", 6, .nat 4⟩, + ⟨"addClosed", 3072, "ce2cc4e16ffbe9166b9be201c524cbc7530705fdc5b8ff7602627aba70f5f4d0", + "799b7939dcc3c158620a49e645c9fee367674251e5298594bf8801747e49f990", 19, + .missingCovered "1ce12e12485a4793aa5baf4f197f5d5ceb5fb8e166f1a06640b87f9c91dad725"⟩, + ⟨"recClosed", 796, "4c0c64ad2997001a63b5d6a70475f656cd27eb8dd30ba8c3acb8bd87564b3f49", + "1248f5d1b9eb3c50a6818d4d6d1e2413a7e9587e0990de2421e997d756da7aa1", 6, + .missingCovered "1248f5d1b9eb3c50a6818d4d6d1e2413a7e9587e0990de2421e997d756da7aa1"⟩] + +def policy : Policy := + { sourcePolicy with + limits := { sourcePolicy.limits with + maxConstants := 32, maxExpressionUnits := 4096, maxExpandedExpressionUnits := 8192 + maxLayer1NodeVisits := 262144, maxErasedDeclarations := 256 + maxErasureAppendCells := 16384, maxCertificateCandidates := 64 + maxCertificateSourceNodeWork := 2097152 } + evalFuel := 10000, controlFuel := 10000, heapFuel := 10000 } + +structure Input where + source : Source + snapshot : Json + provenance : Json + expected : Expected + +def load (path : System.FilePath) (fixture : Fixture) : IO (Except String Input) := do + let manifest ← CatalogContactFixture.readHexAt path s!"{fixture.name}.manifest.hex" + let piece ← CatalogContactFixture.readHexAt path s!"{fixture.name}.ixe.hex" + if (← (path / "CompilatrixUpstream.lean").metadata).byteSize > 4096 then + return .error "upstream source module exceeds the 4 KiB fixture limit" + let moduleBytes ← IO.FS.readBinFile (path / "CompilatrixUpstream.lean") + return do + let manifest ← manifest + let piece ← piece + if piece.size != fixture.pieceBytes || (Address.blake3 piece).toHex != fixture.pieceHash then + throw "upstream original piece bytes drifted" + let loaded ← (Catalog.load manifest #[piece]).mapError (fun error => reprStr error) + let some member := loaded.manifest.members[0]? | throw "upstream member missing" + let some stored := loaded.pieces[0]? | throw "upstream piece missing" + let some root := stored.main | throw "upstream MAIN missing" + if member.label != s!"CompilatrixUpstream.{fixture.name}" || + member.toolchain != "leanprover/lean4:v4.33.1" || member.sourcePin != writerPin || + root.toHex != fixture.root || loaded.constants.length != fixture.count || + !stored.assumptions.isEmpty || loaded.manifest.members.size != 1 then + throw "upstream provenance, root, or complete closure drifted" + if CatalogContactFixture.dependencyClosure loaded.constants root != loaded.constants then + throw "upstream pack is not the exact reachable dependency closure" + let constants ← stored.constants.toList.mapM fun record => do + if ser record.constant != record.bytes then throw "upstream constant bytes changed after decoding" + return Json.mkObj [("key", toJson record.address), ("bytes", byteJson record.bytes)] + let provenance := Json.mkObj [ + ("members_root", toJson loaded.manifest.membersRoot), + ("content_root", toJson loaded.manifest.contentRoot), ("piece_hash", toJson fixture.pieceHash), + ("toolchain", toJson member.toolchain), ("source_pin", toJson member.sourcePin), + ("source_module_hash", toJson (Address.blake3 moduleBytes)), + ("source_module", byteJson moduleBytes)] + let source : Source := + { name := s!"upstream-{fixture.name}", constants := loaded.constants + root, literals := [], policy, expected := .scalar 0 false } + return { + source, provenance, expected := fixture.expected + snapshot := Json.mkObj [ + ("root", toJson root), ("constants", toJson constants), + ("manifest_bytes", byteJson manifest), ("piece_bytes", byteJson piece), + ("blob_inputs", toJson (loaded.blobs.map fun (address, bytes) => + Json.mkObj [("key", toJson address), ("bytes", byteJson bytes)])), + ("policy", toJson policy), ("provenance", provenance)] } + +structure NatIds where + block : Address + zero : Address + succ : Address + +def natIds (source : Source) : Except String NatIds := do + let some zero := source.constants.find? (fun (_, constant) => match constant.info with + | .cPrj projection => projection.idx == 0 && projection.cidx == 0 + | _ => false) + | throw "missing upstream Nat.zero" + let some succ := source.constants.find? (fun (_, constant) => match constant.info with + | .cPrj projection => projection.idx == 0 && projection.cidx == 1 + | _ => false) + | throw "missing upstream Nat.succ" + let .cPrj zeroInfo := zero.2.info | throw "Nat.zero projection changed" + let .cPrj succInfo := succ.2.info | throw "Nat.succ projection changed" + if zeroInfo.block != succInfo.block then throw "upstream Nat constructor blocks disagree" + return { block := zeroInfo.block, zero := zero.1, succ := succ.1 } + +private def sourceNat? (ids : NatIds) : Nat → Ixon.Eval.Value → Option Nat + | 0, _ => none + | fuel + 1, .ctorV block 0 tag fields => + if block != ids.block then none else + match tag, fields with + | 0, [] => some 0 + | 1, [tail] => (· + 1) <$> sourceNat? ids fuel tail + | _, _ => none + | _, _ => none + +private def nat0? (zero succ : Address) : Nat → IxIR0.Value → Option Nat + | 0, _ => none + | fuel + 1, .ctor address tag fields => + if address == zero && tag == 0 && fields.isEmpty then some 0 + else if address == succ && tag == 1 then + match fields with + | [tail] => (· + 1) <$> nat0? zero succ fuel tail + | _ => none + else none + | _, _ => none + +private def nat1? (zero succ : Address) : Nat → IxIR1.Store → IxIR1.RVal → Option Nat + | 0, _, _ => none + | fuel + 1, store, .loc location => do + let box ← store.get? location + if box.world != .shared then none else do + let .ctorN identity fields := box.node | none + if identity == IxIR1.Lower.ctorIdOf zero 0 && fields.isEmpty then some 0 + else if identity == IxIR1.Lower.ctorIdOf succ 1 then + match fields.toList with + | [tail] => (· + 1) <$> nat1? zero succ fuel store tail + | _ => none + else none + | _, _, _ => none + +private def agree (stage : String) (expected : Nat) (actual : Option Nat) : Except String Unit := + if actual == some expected then .ok () + else .error s!"{stage}: expected Nat {expected}, observed {repr actual}" + +private def counters (store : IxIR1.Store) : Json := + Json.mkObj [("allocs", toJson store.allocs), ("frees", toJson store.frees), + ("rcops", toJson store.rcops), ("live", toJson store.live), ("reuses", toJson store.reuses)] + +def observe (source : Source) (attached : source.Attached) (number : Nat) : + Except String Observation := do + let ids ← natIds source + let value ← (Ixon.Eval.eval (Pipeline.validatedEvalCtx source.constants source.config) + policy.evalFuel (Pipeline.validatedMainFrame source.root) [] Pipeline.validatedMainSource).mapError + (fun error => s!"Ixon: {repr error}") + agree "Ixon" number (sourceNat? ids policy.evalFuel value) + let artifact := attached.source.artifact + let rename0 := IxIR0.MutualBlock.Renaming.apply attached.source.erasure.result.addressMap + let rename1 := IxIR1.Readdress.Renaming.apply artifact.targetAddressMap + let mut stages := [("ixon", toJson number)] + for (stage, declarations, main, zero, succ) in [ + ("raw_ixir0", artifact.rawErasedDecls, IxIR0.Expr.ref source.root, ids.zero, ids.succ), + ("ixir0", artifact.erasedDecls, attached.source.erasure.result.main, rename0 ids.zero, rename0 ids.succ)] do + let value ← (IxIR0.eval { env := IxIR0.Env.ofList declarations } policy.evalFuel [] main).mapError + (fun error => s!"{stage}: {repr error}") + agree stage number (nat0? zero succ policy.evalFuel value) + stages := stages ++ [(stage, toJson number)] + let mut stores : List IxIR1.Store := [] + let mut released : List IxIR1.Store := [] + for (stage, declarations, main, zero, succ) in [ + ("raw_ixir1", attached.source.lowering.raw, attached.source.lowering.mainCode, + rename0 ids.zero, rename0 ids.succ), + ("ixir1", artifact.targetDecls, artifact.main, rename1 (rename0 ids.zero), rename1 (rename0 ids.succ))] do + let context : IxIR1.Ctx := { decls := IxIR1.Env.ofList declarations } + let (store, value) ← (IxIR1.runOwnedMain context .shared main policy.evalFuel).mapError + (fun error => s!"{stage}: {repr error}") + agree stage number (nat1? zero succ policy.evalFuel store value) + let reclaimed ← (IxIR1.dropVal context policy.heapFuel store value).mapError + (fun error => s!"{stage} reclamation: {repr error}") + stores := stores ++ [store] + released := released ++ [reclaimed] + stages := stages ++ [(stage, Json.mkObj [("nat", toJson number), + ("value", toJson value), ("store", toJson store), ("reclaimed", toJson reclaimed)])] + let program := attached.target.artifact.program + let context := IxIR2.Eval.Context.ofProgram program attached.target.artifact.validationContext.schemas + let mut physicalStores : List Json := [] + let mut summary := Json.null + for (stage, mode) in [("logical_ixir2", IxIR2.Eval.Interpretation.logical), ("physical_ixir2", .physical)] do + let result ← (IxIR2.Eval.runMain context mode program policy.controlFuel policy.heapFuel).mapError + (fun error => s!"{stage}: {repr error}") + agree stage number (nat1? (rename1 (rename0 ids.zero)) (rename1 (rename0 ids.succ)) + policy.evalFuel result.store.heap result.value) + let (reclaimed, remaining) ← (IxIR2.Eval.releaseShared policy.heapFuel result.store result.value).mapError + (fun error => s!"{stage} reclamation: {repr error}") + stores := stores ++ [result.store.heap] + released := released ++ [reclaimed.heap] + let stageObservation := Json.mkObj [("nat", toJson number), ("value", toJson result.value), + ("store", toJson result.store), ("reclaimed", toJson reclaimed), + ("control_remaining", toJson result.controlRemaining), ("heap_remaining", toJson result.heapRemaining), + ("reclamation_remaining", toJson remaining)] + physicalStores := physicalStores ++ [stageObservation] + stages := stages ++ [(stage, stageObservation)] + summary := Json.mkObj [("nat", toJson number), ("heap", counters result.store.heap), + ("reclaimed", counters reclaimed.heap), ("peak_live_nodes", toJson result.store.peakLiveNodes), + ("control_steps", toJson (policy.controlFuel - result.controlRemaining)), + ("heap_work", toJson (policy.heapFuel - result.heapRemaining))] + if stores.any (fun store => store.allocs != store.frees + store.live) || + released.any (fun store => store.live != 0 || store.allocs != store.frees) || + (stores.map counters).any (· != (stores.map counters).head!) || + (released.map counters).any (· != (released.map counters).head!) || + physicalStores[0]? != physicalStores[1]? then + throw "upstream stage counters, complete baseline stores, budgets, or reclamation disagree" + return { summary, stages := Json.mkObj stages } + +def result (input : Input) (stage : String) (failure observation : Json) + (compiled : Option input.source.Attached := none) (stages : Json := Json.null) + (partialCompilation : Json := Json.null) (native : Json := Json.null) + (object : Option ByteArray := none) : CaseResult := + let source := input.source + { name := source.name + row := Json.mkObj [ + ("name", toJson source.name), ("origin", toJson "upstream-lean"), ("root_kind", toJson "constant"), + ("root", toJson source.root), ("source_constants", toJson source.constants.length), + ("last_accepted_stage", toJson stage), ("rejection", failure), ("observation", observation), + ("optimization_policy", toJson (if object.isSome then "baseline-ixir2; " ++ + (native.getObjValAs? String "selector").toOption.getD "unknown" else "baseline-only")), + ("provenance", input.provenance), + ("ir1_root", match compiled with + | none => Json.null + | some attached => toJson (IxIR1.Optimizer.graphRoot + attached.source.artifact.targetArtifacts attached.source.artifact.main)), + ("hpt_roots", match compiled with | none => Json.null | some attached => toJson attached.hpt.result.addresses), + ("features", match compiled with | none => Json.null | some attached => toJson (features attached.target.artifact.program)), + ("snapshot", toJson s!"{source.name}.json"), + ("object", if object.isSome then toJson s!"{source.name}.o" else Json.null)] + snapshot := Json.mkObj ([("format", toJson "compilatrix/source-case/1"), ("input", input.snapshot), + ("compilation", match compiled with | none => partialCompilation | some attached => source.compilationSnapshot attached), + ("observations", if compiled.isSome then stages else failure)] ++ + (if native == Json.null then [] else [("native", native)])) + object } + +def run (input : Input) : Except String CaseResult := do + let source := input.source + match source.compile, input.expected with + | .ok attached, .nat number => + let observation ← observe source attached number + let code ← match X86.Select.select attached.target.artifact.program with + | .error .unsupportedScalarShape => pure "unsupportedScalarShape" + | .error (.invalidSource (.invalid _ .schema "missing constructor schema")) => + pure "missingConstructorSchema" + | .error error => throw s!"upstream native selection diagnostic drifted: {repr error}" + | .ok _ => throw "upstream constructor graph unexpectedly passed scalar selection" + let failure := Json.mkObj [("stage", toJson "x86-selection"), ("code", toJson code), + ("root", toJson source.root), ("message", Json.null)] + return result input "ixir2" failure observation.summary (some attached) observation.stages + | .error (.pipeline (.validate address message)), .missingCovered expectedAddress => + if address.toHex != expectedAddress || message != "reference lacks a Covered certificate" then + throw "upstream Covered diagnostic drifted" + let partialCompilation ← addressedSnapshot source.constants source.root source.config source.policy.eraseFuel + return result input "addressed-ixir0" (Json.mkObj [ + ("stage", toJson "validated-erasure"), ("code", toJson "missingCovered"), + ("root", toJson address), ("message", toJson message)]) Json.null + (partialCompilation := partialCompilation) + | .error error, _ => throw s!"unexpected upstream compilation error: {repr error}" + | .ok _, _ => throw "upstream negative case unexpectedly compiled" + +def cases (path : System.FilePath := directory) : IO (Except String (List CaseResult)) := do + let mut results := [] + for fixture in fixtures do + match (← load path fixture).bind run with + | .error message => return .error s!"{fixture.name}: {message}" + | .ok result => results := results ++ [result] + return .ok results + +end Ix.Compiler.Coverage.Upstream diff --git a/Ix/Compiler/Coverage/UpstreamNative.lean b/Ix/Compiler/Coverage/UpstreamNative.lean new file mode 100644 index 000000000..f481d3f64 --- /dev/null +++ b/Ix/Compiler/Coverage/UpstreamNative.lean @@ -0,0 +1,147 @@ +import Ix.Compiler.Coverage.Upstream +import Ix.Compiler.X86.NatCallsSim + +namespace Ix.Compiler.Coverage.UpstreamNative +open Lean Ix.Compiler.X86 Ix.Compiler.X86.NatCalls + +def policy : String := "upstream-closed-nat/2" + +def schema (source : Source) (attached : source.Attached) : Except String NatCalls.Schema := do + let ids ← Upstream.natIds source + let rename0 := IxIR0.MutualBlock.Renaming.apply attached.source.erasure.result.addressMap + let rename1 := IxIR1.Readdress.Renaming.apply attached.source.artifact.targetAddressMap + return { + zero := IxIR1.Lower.ctorIdOf (rename1 (rename0 ids.zero)) 0 + succ := IxIR1.Lower.ctorIdOf (rename1 (rename0 ids.succ)) 1 } + +def expressionJson : NatCalls.Expr → Json + | .argument => Json.mkObj [("op", toJson "argument")] + | .constant value => Json.mkObj [("op", toJson "constant"), ("value", toJson value.toNat)] + | .successor value => Json.mkObj [("op", toJson "successor"), ("value", expressionJson value)] + | .call function value => Json.mkObj [("op", toJson "call"), ("function", toJson function), ("value", expressionJson value)] + +def parameterJson : NatCalls.Param → Json + | .nat => Json.mkObj [("kind", toJson "nat")] + | .closure address none => Json.mkObj [("kind", toJson "known-capture-free-pap"), ("function", toJson address)] + | .closure address (some expression) => Json.mkObj [("kind", toJson "known-static-capture-pap"), + ("function", toJson address), ("capture", expressionJson expression)] + | .staticNat expression => Json.mkObj [("kind", toJson "static-nat"), ("value", expressionJson expression)] + | .erased => Json.mkObj [("kind", toJson "erased")] + +def residualJson (residual : NatCalls.Residual) : Json := + Json.mkObj [("entry", toJson residual.entry), ("functions", toJson (residual.functions.map fun function => + Json.mkObj [("origin", toJson function.origin), ("parameters", toJson (function.parameters.map parameterJson)), + ("body", expressionJson function.body)]))] + +/-- A finite readable stack, with writes confined below the caller's return +slot. Distinct saved registers and nonzero initial bytes expose frame errors. -/ +def core (stack : Word) (seed : Word) (capacity : Word := 64) : Core := + let registers := fun register => seed + (SysV.calleeSaved.toList.idxOf register + 1).toUInt64 * 0x102030405060708 + let memory : Memory := { + bytes := fun address => (address ^^^ seed).toUInt8 + readable := fun address => decide (stack - capacity ≤ address && address < stack + 8) + writable := fun address => decide (stack - capacity ≤ address && address < stack) } + { registers := Registers.set registers .rsp stack, memory := memory.write64 stack 0x12345678 } + +def executionJson {source context schema} (object : NatCalls.Object source context schema) + (stack seed base : Word) : Except String Json := do + let initial := core stack seed + let execution ← certifyExecution object initial 100 + let mut machine := Machine.initial object.selected.target initial + let mut steps := 0 + let mut calls := 0 + let mut minimum := stack + for _ in [:100] do + if machine.status != .running then break + if let some block := object.selected.target.program.blocks[machine.pc.block.toNat]? then + if let some (.call _) := block.instructions[machine.pc.offset.toNat]? then calls := calls + 1 + machine := X86.step Runtime.rejecting object.selected.target machine + minimum := min minimum (machine.core.readReg .rsp) + steps := steps + 1 + let final ← (ObjectEval.run object.object.bytes object.input.exportName base steps initial).mapError reprStr + if final.rip != execution.returnAddress || final.core.readReg .rax != object.selected.word || + final.core.readReg .rsp != stack + 8 || + !final.core.calleeSavedMatch initial.calleeSavedSnapshot then + throw "actual object-byte execution disagrees with typed execution" + return Json.mkObj [("stack", toJson stack.toNat), ("seed", toJson seed.toNat), ("text_base", toJson base.toNat), + ("value", toJson (final.core.readReg .rax).toNat), ("return_address", toJson final.rip.toNat), + ("typed_steps", toJson steps), ("byte_steps", toJson steps), ("direct_calls", toJson calls), + ("stack_written_bytes", toJson (stack - minimum).toNat), ("stack_capacity_bytes", toJson (64 : Nat)), + ("saved_registers_preserved", toJson true), ("stack_restored_before_ret", toJson true), + ("call_trace_certified", toJson true), ("object_entry_certified", toJson true)] + +def snapshot {source context schema} (object : NatCalls.Object source context schema) : Except String Json := do + let mut executions := #[] + for (stack, seed, base) in [(0x4008, 0xabcdef01, 0x100000), (0x8008, 0x12345678, 0x400000), + (0x100000008, 0xffffffffffffffff, 0x100000000), (0x7fffffffe008, 0x1020304050607080, 0x7fff00000000)] do + executions := executions.push (← executionJson object stack seed base) + let selected := object.selected + let mut fallback := #[] + for (name, limits) in [("zero-depth", { depth := 0 : NatCalls.Limits }), + ("zero-functions", { functions := 0 : NatCalls.Limits }), + ("zero-instructions", { instructions := 0 : NatCalls.Limits })] do + match NatCalls.select source context schema limits selected.captureMode with + | .error (.lowering .budget) => fallback := fallback.push (Json.mkObj [ + ("name", toJson name), ("reason", toJson "budget"), ("path", toJson "checked-baseline-ixir2")]) + | _ => throw "native budget fallback changed" + if selected.captureMode == .staticNat then + match NatCalls.select source context schema { captureFuel := 0 } .staticNat with + | .error (.lowering .budget) => fallback := fallback.push (Json.mkObj [ + ("name", toJson "zero-capture-fuel"), ("reason", toJson "budget"), ("path", toJson "checked-baseline-ixir2")]) + | _ => throw "native capture budget fallback changed" + match NatCalls.select source context schema with + | .error (.lowering .capturedPap) => fallback := fallback.push (Json.mkObj [ + ("name", toJson "capture-free-policy"), ("reason", toJson "capturedPap"), ("path", toJson "checked-baseline-ixir2")]) + | _ => throw "capture-free policy boundary changed" + for (name, initial) in [("misaligned-stack", core 0x8000 1), ("insufficient-stack", core 0x8008 1 32)] do + match certifyExecution object initial 100 with + | .error _ => fallback := fallback.push (Json.mkObj [("name", toJson name), + ("reason", toJson "execution-condition"), ("path", toJson "no-native-execution-certificate")]) + | .ok _ => throw "invalid native stack admitted" + return Json.mkObj [ + ("format", toJson "compilatrix/upstream-native/1"), ("selector", toJson selected.captureMode.policy), + ("representation", toJson "closed shared unary Nat constructors to exact UInt64"), + ("runtime_arguments", toJson (0 : Nat)), ("schema", Json.mkObj [("zero", toJson schema.zero), ("succ", toJson schema.succ)]), + ("residual", residualJson selected.residual), ("typed_program_diagnostic", toJson (reprStr selected.target.program)), + ("value", toJson selected.number), ("word_exact", toJson true), + ("physical_store", toJson selected.physical.store), ("physical_value", toJson selected.physical.value), + ("reclaimed_store", toJson selected.reclaimed), + ("native_heap", Json.mkObj [("allocs", toJson (0 : Nat)), ("frees", toJson (0 : Nat)), + ("rcops", toJson (0 : Nat)), ("result_bytes", toJson (8 : Nat)), ("result_release", toJson "unboxed word; no heap root")]), + ("text", byteJson object.stream.output.text), ("text_bytes", toJson object.stream.output.text.size), + ("block_offsets", toJson (object.stream.output.blockOffsets.map id)), + ("symbol", toJson object.input.exportName), ("lowering_version", toJson selected.captureMode.loweringVersion.toNat), ("pass_policy_version", toJson (1 : Nat)), + ("object", byteJson object.object.bytes), ("object_bytes", toJson object.object.bytes.size), + ("object_identity", toJson (Ixon.Address.blake3 object.object.bytes)), + ("executions", Json.arr executions), ("fallbacks_and_rejections", Json.arr fallback)] + +def run (input : Upstream.Input) : Except String CaseResult := do + let source := input.source + match source.compile, input.expected with + | .ok attached, .nat number => + let observed ← Upstream.observe source attached number + let schema ← schema source attached + let selected := match NatCalls.select attached.target.artifact.program attached.target.artifact.validationContext schema with + | .error (.lowering .capturedPap) => NatCalls.select attached.target.artifact.program attached.target.artifact.validationContext schema {} .staticNat + | result => result + match selected with + | .error error => throw s!"upstream computational native selection failed: {repr error}" + | .ok selected => + if selected.number != number || !["upstream-applyClosed", "upstream-captureClosed", "upstream-letClosed"].contains source.name then + throw "upstream native accepted inventory or source value drifted" + let root := IxIR1.Optimizer.graphRoot attached.source.artifact.targetArtifacts attached.source.artifact.main + let object ← selected.emit root "compilatrix_main" + let native ← snapshot object + return Upstream.result input "elf" Json.null observed.summary (some attached) observed.stages + (native := native) (object := some object.object.bytes) + | _, _ => Upstream.run input + +def cases (path : System.FilePath := Upstream.directory) : IO (Except String (List CaseResult)) := do + let mut results := [] + for fixture in Upstream.fixtures do + match (← Upstream.load path fixture).bind run with + | .error message => return .error s!"{fixture.name}: {message}" + | .ok result => results := results ++ [result] + return .ok results + +end Ix.Compiler.Coverage.UpstreamNative diff --git a/Ix/Compiler/DurableSync.lean b/Ix/Compiler/DurableSync.lean new file mode 100644 index 000000000..c01edc3e1 --- /dev/null +++ b/Ix/Compiler/DurableSync.lean @@ -0,0 +1,23 @@ +/-! +# Narrow durable-filesystem boundary + +Lean's portable `IO.FS.Handle.flush` empties the runtime buffer but does not +request stable storage. These two operations are the intentionally small native +boundary used by the persistent HPT cache around its atomic rename. + +Both functions reject a path of the wrong kind. Their filesystem and hardware +semantics remain assumptions recorded in the trusted-extern ledger; they do +not participate in any logical theorem or bless cache bytes as valid. +-/ + +namespace Ix.Compiler.DurableSync + +/-- Request stable storage for one regular file. -/ +@[extern "compilatrix_durable_sync_file"] +opaque file (path : @& System.FilePath) : IO Unit + +/-- Request stable storage for one directory's entries. -/ +@[extern "compilatrix_durable_sync_directory"] +opaque directory (path : @& System.FilePath) : IO Unit + +end Ix.Compiler.DurableSync diff --git a/Ix/Compiler/Erase.lean b/Ix/Compiler/Erase.lean new file mode 100644 index 000000000..ea2798bd7 --- /dev/null +++ b/Ix/Compiler/Erase.lean @@ -0,0 +1,930 @@ +import Ix.Compiler.Ixon.Eval +import Ix.Compiler.IxIR0.Eval + +/-! +# The erasure pass: Ixon → IxIR₀ + +The middle of the certification spine. Executable, total (fueled), +and **arity-preserving**: erased binders keep their lambda (and their +argument slot), but + +- arguments in erased **positions** are replaced by the unevaluated + `◻` literal — dropping their *evaluation* is the semantic content + of erasure (gate A); +- occurrences of dropped binders erase to `◻` (never to a variable + read — dropped slots are dead by construction); +- types (`sort`, `all`) erase to `◻` wholesale; +- recursor **index** arguments and constructor **param** arguments + are removed from spines outright — the two deliberate arity + changes. Constructor values carry kept fields only (the IxIR₀ + object-model contract); complete visible indexed recursor spines + and protected partial spines whose remaining indices are supplied later + are covered by the simulation theorem. Arity *trimming* of ghost + slots is a later IxIR₀ˢ optimization, not erasure's job. + +A binder/position is erased when its mode is 0 **or** its domain is +syntactically sort-like (`Sort`, or a Π-chain into one, through +shares) — Coq-extraction-style type-scheme erasure, no typing needed. +The approximation degrades safely: an undetected type flows as a +value and meets `◻` only where syntax reveals it. + +Recursors erase **structurally** (their stored counts, not modes): +motives are ghost positions, indices are dropped, minors and value +params are kept. A rule's right-hand side (a kernel-shaped closed +lambda chain over params/motives/minors/fields) is peeled and +re-expressed in the `RecRule` environment convention; the source's +`recur`-self becomes the recSelf slot — `var mask.length`, the index +just past all peeled binders, exactly where IxIR₀'s ι binds the +unapplied recursor. + +Addresses survive erasure as environment keys. Members of a `muts` +block get fixed-width synthetic addresses (`memberAddr`; scaffolding +until erased IR is content-addressed); +projection constants become indirections (`defn (ref member)`), ctor +projections become `Decl.ctor` directly, inductive-type constants +become `defn ◻`, opaque/partial definitions and axioms become +`Decl.extern` (the ledger boundary), and quotients compile away +(`mk ↦ λλλ.v₀`, `lift ↦ λ⁶. f q`, `ind ↦ λ⁵. mk q`). + +Known v1 boundaries (recorded): unknown-telescope **ghost** positions +(higher-order heads) keep their arguments — sound but unerased; first-class +unfoldable definition and recursor mutual-member references are certified only +when named by a finite simultaneous member plan. Configured opaque mutual +members use their synthetic member address as both source-oracle identity and +target extern key; broader dropped-variable reads remain outside the certified +relation. Split +**constructor-parameter** spines are protected by ignored target closures: a +visible prefix drops the parameters it consumes and wraps the target +constructor for exactly the remaining source parameters. Split **indexed +recursor** spines use a let-captured pre-major target pap plus one ignored +closure binder per remaining source-only index. Either wrapper may escape +through variables or lets; later generic applications consume it before the +target constructor or recursor becomes fireable, so source and target cannot +fire at different points. The indexed wrapper applies both to projection heads +and rule-local recursive self heads. Literal +blobs are resolved and inlined at erase time; `natLit` peeling is +enabled by well-known-address comparison against the Nat block. + +The pass is validated two ways: differential `#guard`s below run the +same programs through the Ixon reference evaluator and the erased +IxIR₀ interpreter, and `Ix/Compiler/Sim.lean` proves the simulation +theorem against a proof-producing relational erasure certificate. +-/ + +namespace Ix.Compiler.Erase + +open Ix.Compiler.Ixon (Address Uses Owned Constant ConstantInfo MutConst + Recursor RecursorRule Constructor Definition Univ) +open Ix.Compiler.Ixon.Eval (Blob unfoldable) + +inductive EraseErr where + | fuel + | unsupported (msg : String) + | unknownBlob (adr : Address) + deriving BEq, Repr + +structure EraseCtx where + resolve : Address → Option Constant + blobs : Address → Option Blob := fun _ => none + /-- Well-known address of the `Nat` block: sets `natLit` on its + recursor's erasure. -/ + natBlock : Option Address := none + +/-- Tables of the constant being erased, plus rule-erasure state. -/ +structure ETables where + sharing : Array Ix.Compiler.Ixon.Expr := #[] + refs : Array Address := #[] + selfMuts : Array MutConst := #[] + curBlock : Option Address := none + /-- When erasing a recursor rule: the member index whose `recur` + occurrences map to the recSelf slot. -/ + recSelf : Option Nat := none + +/-! Keep the historical eraser-qualified name while sharing the constructor +with the source evaluator's opaque-member semantics. -/ +abbrev memberAddr := Address.memberAddr + +@[simp] theorem memberAddr_get (block : Address) (idx : Nat) (i : Fin 32) : + (memberAddr block idx).get i = + if i.val < 24 then block.get i + else block.get i ^^^ + UInt8.ofNat (((idx + 1) >>> (8 * (i.val - 24))) % 256) := by + exact Address.memberAddr_get block idx i + +def defaultFuel : Nat := 100000 + +/-! ## Syntactic classification -/ + +def expandShare (sharing : Array Ix.Compiler.Ixon.Expr) : + Nat → Ix.Compiler.Ixon.Expr → Except EraseErr Ix.Compiler.Ixon.Expr + | 0, _ => .error .fuel + | fuel + 1, e => + match e with + | .share i => + match sharing[i.toNat]? with + | some e' => expandShare sharing fuel e' + | none => .error (.unsupported s!"share {i.toNat} out of range") + | e => .ok e + +/-- Is this type expression a type *scheme* — `Sort`, or a Π-chain +into one (through shares)? Binders with sort-like domains are erased. -/ +def sortLike (sharing : Array Ix.Compiler.Ixon.Expr) : + Nat → Ix.Compiler.Ixon.Expr → Bool + | 0, _ => false + | fuel + 1, e => + match e with + | .sort _ => true + | .all _ _ _ cod => sortLike sharing fuel cod + | .share i => + match sharing[i.toNat]? with + | some e' => sortLike sharing fuel e' + | none => false + | _ => false + +/-- Telescope binders (uses, domain) of a type, through shares. -/ +def teleBinders (sharing : Array Ix.Compiler.Ixon.Expr) : + Nat → Ix.Compiler.Ixon.Expr → List (Uses × Ix.Compiler.Ixon.Expr) + | 0, _ => [] + | fuel + 1, e => + match e with + | .all u _ dom cod => (u, dom) :: teleBinders sharing fuel cod + | .share i => + match sharing[i.toNat]? with + | some e' => teleBinders sharing fuel e' + | none => [] + | _ => [] + +/-- The result world promised by the innermost arrow in a definition +type. A non-function (or an unresolved type share) defaults to shared, +matching `UsageCheck.peelDefn`; fuel exhaustion retains the last visible +arrow rather than inventing a stronger promise. -/ +private def teleResultOwned? (sharing : Array Ix.Compiler.Ixon.Expr) : + Nat → Ix.Compiler.Ixon.Expr → Option Owned + | 0, _ => none + | fuel + 1, e => + match e with + | .all _ result _ cod => + match teleResultOwned? sharing fuel cod with + | some inner => some inner + | none => some result + | .share i => + match sharing[i.toNat]? with + | some e' => teleResultOwned? sharing fuel e' + | none => none + | _ => none + +def teleResultOwned (sharing : Array Ix.Compiler.Ixon.Expr) (fuel : Nat) + (typ : Ix.Compiler.Ixon.Expr) : Owned := + (teleResultOwned? sharing fuel typ).getD .shared + +/-- Should a binder with this mode and domain be erased? -/ +def dropBinder (sharing : Array Ix.Compiler.Ixon.Expr) (fuel : Nat) + (u : Uses) (dom : Ix.Compiler.Ixon.Expr) : Bool := + u == .erased || sortLike sharing fuel dom + +/-! ## Argument policies -/ + +/-- What erasure does to an argument at a given telescope position. -/ +inductive ArgPolicy where + | keep + | ghost + | drop + deriving BEq, Repr + +def telePolicies (sharing : Array Ix.Compiler.Ixon.Expr) (fuel : Nat) + (typ : Ix.Compiler.Ixon.Expr) : List ArgPolicy := + (teleBinders sharing fuel typ).map fun (u, dom) => + if dropBinder sharing fuel u dom then .ghost else .keep + +/-- Structural policies for a recursor's applications: value params +kept, type params ghost, motives ghost, minors kept, indices dropped. -/ +def recPolicies (sharing : Array Ix.Compiler.Ixon.Expr) (fuel : Nat) + (r : Recursor) : List ArgPolicy := + let doms := (teleBinders sharing fuel r.typ).take r.params.toNat + let pPol := doms.map fun (u, dom) => + if dropBinder sharing fuel u dom then ArgPolicy.ghost else .keep + let pPol := pPol ++ List.replicate (r.params.toNat - pPol.length) .keep + pPol ++ List.replicate r.motives.toNat .ghost + ++ List.replicate r.minors.toNat .keep + ++ List.replicate r.indices.toNat .drop + +def ctorPolicies (ct : Constructor) : List ArgPolicy := + List.replicate ct.params.toNat .drop + ++ List.replicate ct.fields.toNat .keep + +private def mutMember (ctx : EraseCtx) (block : Address) (idx : Nat) : + Option (Constant × MutConst) := do + let bc ← ctx.resolve block + match bc.info with + | .muts ms => do + let m ← ms[idx]? + some (bc, m) + | _ => none + +def memberPolicies (ctx : EraseCtx) (fuel : Nat) + (sharing : Array Ix.Compiler.Ixon.Expr) : MutConst → List ArgPolicy + | .defn d => telePolicies sharing fuel d.typ + | .recr r => recPolicies sharing fuel r + | .indc _ => [] + +/-- Argument policies for a reference to a resolved constant. Unknown +resolution degrades to keep-everything (sound, unerased). -/ +def constPolicies (ctx : EraseCtx) (fuel : Nat) (c : Constant) : + List ArgPolicy := + match c.info with + | .defn d => telePolicies c.sharing fuel d.typ + | .axio a => telePolicies c.sharing fuel a.typ + | .quot q => telePolicies c.sharing fuel q.typ + | .recr r => recPolicies c.sharing fuel r + | .cPrj p => + match mutMember ctx p.block p.idx.toNat with + | some (_, .indc ind) => + match ind.ctors[p.cidx.toNat]? with + | some ct => ctorPolicies ct + | none => [] + | _ => [] + | .rPrj p => + match mutMember ctx p.block p.idx.toNat with + | some (bc, .recr r) => recPolicies bc.sharing fuel r + | _ => [] + | .dPrj p => + match mutMember ctx p.block p.idx.toNat with + | some (bc, .defn d) => telePolicies bc.sharing fuel d.typ + | _ => [] + | .iPrj _ => [] + | .muts _ => [] + +/-- Build `n` ignored, unrestricted target binders around `body`. -/ +def lamManyN : Nat → IxIR0.Expr → IxIR0.Expr + | 0, body => body + | n + 1, body => .lam .many (lamManyN n body) + +/-- Evaluate `value` before exposing `n` ignored binders, then return the +captured value after those binders have been consumed. The let is important: +`value` may mention the surrounding environment, so wrapping it directly in +lambdas would capture its de Bruijn variables. -/ +def captureThenIgnoreN (n : Nat) (value : IxIR0.Expr) : IxIR0.Expr := + .letE .many value (lamManyN n (.var n)) + +/-- Number of source-only recursor indices still missing from a visible +reference spine, once every parameter/motive/minor argument has been supplied. +Outside that half-open index window no protection is required. -/ +def refRecIndicesRemaining (ctx : EraseCtx) (T : ETables) (idx : UInt64) + (visibleArgs : Nat) : Nat := + match T.refs[idx.toNat]? with + | some address => + match ctx.resolve address with + | some c => + match c.info with + | .rPrj p => + match mutMember ctx p.block p.idx.toNat with + | some (_, .recr r) => + let ruleArgs := r.params.toNat + r.motives.toNat + r.minors.toNat + let preMajor := ruleArgs + r.indices.toNat + if ruleArgs ≤ visibleArgs && visibleArgs < preMajor then + preMajor - visibleArgs + else 0 + | _ => 0 + | _ => 0 + | none => 0 + | none => 0 + +/-- `recur`-head counterpart of `refRecIndicesRemaining`. -/ +def selfRecIndicesRemaining (T : ETables) (idx visibleArgs : Nat) : Nat := + match T.selfMuts[idx]? with + | some (.recr r) => + let ruleArgs := r.params.toNat + r.motives.toNat + r.minors.toNat + let preMajor := ruleArgs + r.indices.toNat + if ruleArgs ≤ visibleArgs && visibleArgs < preMajor then + preMajor - visibleArgs + else 0 + | _ => 0 + +/-- Protect a target pre-major recursor value while its source still owes +source-only indices. -/ +def protectRecIndices (ctx : EraseCtx) (T : ETables) + (base : Ix.Compiler.Ixon.Expr) (visibleArgs : Nat) + (target : IxIR0.Expr) : IxIR0.Expr := + let remaining := match base with + | .ref idx _ => refRecIndicesRemaining ctx T idx visibleArgs + | .recur idx _ => selfRecIndicesRemaining T idx.toNat visibleArgs + | _ => 0 + if remaining = 0 then target else captureThenIgnoreN remaining target + +/-- Dropped-parameter count of reference `idx` when it resolves to a +known constructor (`cPrj`); `0` for anything else or unresolved. -/ +def refCtorParams (ctx : EraseCtx) (T : ETables) (idx : UInt64) : Nat := + match T.refs[idx.toNat]? with + | none => 0 + | some a => + match ctx.resolve a with + | none => 0 + | some c => + match c.info with + | .cPrj p => + match mutMember ctx p.block p.idx.toNat with + | some (_, .indc ind) => + match ind.ctors[p.cidx.toNat]? with + | some ct => ct.params.toNat + | none => 0 + | _ => 0 + | _ => 0 + +/-- Erase a visible reference head. A parameterized constructor whose visible +spine has not consumed every dropped source parameter becomes a chain of +ignored target closures around the real constructor reference. Once the +complete prefix is visible, the wrappers are unnecessary and the head erases +directly to the target constructor. -/ +def eraseRefHead (ctx : EraseCtx) (T : ETables) (idx : UInt64) + (visibleArgs : Nat) : Except EraseErr IxIR0.Expr := + match T.refs[idx.toNat]? with + | none => .error (.unsupported s!"ref {idx.toNat} out of range") + | some address => + let params := refCtorParams ctx T idx + if visibleArgs < params then + .ok (lamManyN (params - visibleArgs) (.ref address)) + else .ok (.ref address) + +/-- Target of a `recur` reference: the recSelf slot when erasing the +recursor's own rules, a member address otherwise. -/ +def recurTarget (T : ETables) (mask : List Bool) (idx : Nat) : + Except EraseErr IxIR0.Expr := + if T.recSelf == some idx then .ok (.var mask.length) + else + match T.curBlock with + | some blk => .ok (.ref (memberAddr blk idx)) + | none => .error (.unsupported "recur reference outside a mutual block") + +def headPolicies (ctx : EraseCtx) (fuel : Nat) (T : ETables) : + Ix.Compiler.Ixon.Expr → List ArgPolicy + | .ref idx _ => + match T.refs[idx.toNat]? with + | some a => + match ctx.resolve a with + | some c => constPolicies ctx fuel c + | none => [] + | none => [] + | .recur idx _ => + match T.selfMuts[idx.toNat]? with + | some m => memberPolicies ctx fuel T.sharing m + | none => [] + | e@(.lam ..) => + (Ix.Compiler.Ixon.Expr.collectLam e).1.map fun (u, dom) => + if dropBinder T.sharing fuel u dom then ArgPolicy.ghost else .keep + | _ => [] + +/-! ## Expression erasure -/ + +mutual + +def eraseExpr (ctx : EraseCtx) (fuel : Nat) (T : ETables) + (mask : List Bool) (e : Ix.Compiler.Ixon.Expr) : + Except EraseErr IxIR0.Expr := + match fuel with + | 0 => .error .fuel + | fuel + 1 => + match e with + | .var i => + match mask[i.toNat]? with + | some true => .ok (.var i.toNat) + | some false => .ok .erased + | none => .error (.unsupported s!"unbound variable {i.toNat}") + | .sort _ => .ok .erased + | .all _ _ _ _ => .ok .erased + | .lam u dom body => + let dropped := dropBinder T.sharing fuel u dom + let u' := if dropped then Uses.many else u + (.lam u' ·) <$> eraseExpr ctx fuel T ((!dropped) :: mask) body + | .letE _ _ val body => do + let val' ← eraseExpr ctx fuel T mask val + let body' ← eraseExpr ctx fuel T (true :: mask) body + .ok (.letE .many val' body') + | .prj _ fieldIdx val => + (.proj fieldIdx.toNat ·) <$> eraseExpr ctx fuel T mask val + | .nat idx => + match T.refs[idx.toNat]? with + | none => .error (.unsupported s!"nat literal ref {idx.toNat} out of range") + | some a => + match ctx.blobs a with + | some (.natB n) => .ok (.lit (.nat n)) + | some (.strB _) => .error (.unsupported "nat literal address holds a string") + | none => .error (.unknownBlob a) + | .str idx => + match T.refs[idx.toNat]? with + | none => .error (.unsupported s!"str literal ref {idx.toNat} out of range") + | some a => + match ctx.blobs a with + | some (.strB s) => .ok (.lit (.str s)) + | some (.natB _) => .error (.unsupported "str literal address holds a nat") + | none => .error (.unknownBlob a) + | .share i => + match T.sharing[i.toNat]? with + | none => .error (.unsupported s!"share {i.toNat} out of range") + | some e' => eraseExpr ctx fuel T mask e' + | e@(.ref idx _) => do + let head ← eraseRefHead ctx T idx 0 + .ok (protectRecIndices ctx T e 0 head) + | e@(.recur idx _) => do + let head ← recurTarget T mask idx.toNat + .ok (protectRecIndices ctx T e 0 head) + | .app f a => do + let (args, base₀) := Ix.Compiler.Ixon.Expr.collectApp (.app f a) + let base ← expandShare T.sharing fuel base₀ + let pols := headPolicies ctx fuel T base + let head : IxIR0.Expr ← + match base with + | .ref idx _ => eraseRefHead ctx T idx args.length + | .recur idx _ => recurTarget T mask idx.toNat + | _ => eraseExpr ctx fuel T mask base + let target ← eraseArgs ctx fuel T mask pols 0 args head + .ok (protectRecIndices ctx T base args.length target) + termination_by fuel + +/-- Fold spine arguments over their policies onto the erased head. -/ +def eraseArgs (ctx : EraseCtx) (fuel : Nat) (T : ETables) + (mask : List Bool) (pols : List ArgPolicy) (i : Nat) + (args : List Ix.Compiler.Ixon.Expr) (head : IxIR0.Expr) : + Except EraseErr IxIR0.Expr := + match fuel with + | 0 => .error .fuel + | fuel + 1 => + match args with + | [] => .ok head + | a :: rest => + match pols[i]? with + | some .ghost => + eraseArgs ctx fuel T mask pols (i + 1) rest (.app head .erased) + | some .drop => eraseArgs ctx fuel T mask pols (i + 1) rest head + | _ => do + let a' ← eraseExpr ctx fuel T mask a + eraseArgs ctx fuel T mask pols (i + 1) rest (.app head a') + termination_by fuel + +end + +/-! ## Constant erasure -/ + +/-- Peel a kernel-shaped lambda chain against outermost-first keep +flags, accumulating the (innermost-first) mask. -/ +def peelRule (sharing : Array Ix.Compiler.Ixon.Expr) : + Nat → List Bool → List Bool → Ix.Compiler.Ixon.Expr → + Except EraseErr (List Bool × Ix.Compiler.Ixon.Expr) + | 0, _, _, _ => .error .fuel + | _ + 1, [], mask, e => .ok (mask, e) + | fuel + 1, flag :: flags, mask, e => do + match ← expandShare sharing fuel e with + | .lam _ _ body => peelRule sharing fuel flags (flag :: mask) body + | _ => .error (.unsupported "recursor rule is not a kernel-shaped lambda chain") + +def eraseRecursor (ctx : EraseCtx) (fuel : Nat) (T : ETables) + (blockAddr : Address) (selfIdx : Nat) (r : Recursor) : + Except EraseErr IxIR0.Decl := do + let p := r.params.toNat + let m := r.motives.toNat + let mi := r.minors.toNat + let doms := (teleBinders T.sharing fuel r.typ).take p + let pFlags := doms.map fun (u, dom) => !dropBinder T.sharing fuel u dom + let pFlags := pFlags ++ List.replicate (p - pFlags.length) true + let flags := pFlags ++ List.replicate m false ++ List.replicate mi true + let rules ← r.rules.mapM fun rule => do + let fl := flags ++ List.replicate rule.fields.toNat true + let (mask, body) ← peelRule T.sharing fuel fl [] rule.rhs + let rhs ← eraseExpr ctx fuel { T with recSelf := some selfIdx } mask body + pure ({ fields := rule.fields.toNat, rhs } : IxIR0.RecRule) + pure (.recursor (p + m + mi) (ctx.natBlock == some blockAddr) rules) + +def quotientCore : Ixon.QuotKind → IxIR0.Expr + | Ixon.QuotKind.type => .erased + | Ixon.QuotKind.ctor => .var 0 + | Ixon.QuotKind.lift => .app (.var 2) (.var 0) + | Ixon.QuotKind.ind => .app (.var 1) (.var 0) + +def quotMkBody : IxIR0.Expr := + lamManyN (Ixon.Eval.quotArity Ixon.QuotKind.ctor) + (quotientCore Ixon.QuotKind.ctor) + +def quotLiftBody : IxIR0.Expr := + lamManyN (Ixon.Eval.quotArity Ixon.QuotKind.lift) + (quotientCore Ixon.QuotKind.lift) + +def quotIndBody : IxIR0.Expr := + lamManyN (Ixon.Eval.quotArity Ixon.QuotKind.ind) + (quotientCore Ixon.QuotKind.ind) + +def quotientBody : Ixon.QuotKind → IxIR0.Expr + | Ixon.QuotKind.type => .erased + | Ixon.QuotKind.ctor => quotMkBody + | Ixon.QuotKind.lift => quotLiftBody + | Ixon.QuotKind.ind => quotIndBody + +/-- Erase one constant into environment entries (a block yields one +entry per member). -/ +def eraseConstant (ctx : EraseCtx) (adr : Address) (c : Constant) + (fuel : Nat := defaultFuel) : + Except EraseErr (List (Address × IxIR0.Decl)) := do + let T : ETables := + { sharing := c.sharing, refs := c.refs + selfMuts := Ixon.selfMutsOf c.info } + match c.info with + | .defn d => + if unfoldable d then do + let body ← eraseExpr ctx fuel T [] d.value + pure [(adr, .defn (teleResultOwned c.sharing fuel d.typ) body)] + else + pure [(adr, .extern (teleBinders c.sharing fuel d.typ).length)] + | .axio a => pure [(adr, .extern (teleBinders c.sharing fuel a.typ).length)] + | .quot q => + let result := teleResultOwned c.sharing fuel q.typ + pure [(adr, .defn result (quotientBody q.kind))] + | .recr r => do + let d ← eraseRecursor ctx fuel { T with curBlock := some adr } adr 0 r + pure [(adr, d)] + | .cPrj p => + match mutMember ctx p.block p.idx.toNat with + | some (_, .indc ind) => + match ind.ctors[p.cidx.toNat]? with + | some ct => pure [(adr, .ctor p.cidx.toNat ct.fields.toNat)] + | none => .error (.unsupported "constructor projection out of range") + | _ => .error (.unsupported "unresolvable constructor projection") + | .iPrj _ => pure [(adr, .defn .shared .erased)] + | .rPrj p => pure [(adr, .defn .shared (.ref (memberAddr p.block p.idx.toNat)))] + | .dPrj p => + let result := match mutMember ctx p.block p.idx.toNat with + | some (bc, .defn d) => teleResultOwned bc.sharing fuel d.typ + | _ => .shared + pure [(adr, .defn result (.ref (memberAddr p.block p.idx.toNat)))] + | .muts ms => do + let T := { T with curBlock := some adr } + let mut out := [] + for hi : i in [0:ms.size] do + match ms[i]! with + | .defn d => + if unfoldable d then do + let body ← eraseExpr ctx fuel T [] d.value + let result := teleResultOwned c.sharing fuel d.typ + out := out ++ [(memberAddr adr i, IxIR0.Decl.defn result body)] + else + out := out ++ [(memberAddr adr i, + IxIR0.Decl.extern (teleBinders c.sharing fuel d.typ).length)] + | .indc _ => + out := out ++ [(memberAddr adr i, IxIR0.Decl.defn .shared .erased)] + | .recr r => do + let d ← eraseRecursor ctx fuel T adr i r + out := out ++ [(memberAddr adr i, d)] + pure out + +/-- Erase a set of constants into an IxIR₀ environment listing. -/ +def eraseProgram (ctx : EraseCtx) + (consts : List (Address × Constant)) (fuel : Nat := defaultFuel) : + Except EraseErr (List (Address × IxIR0.Decl)) := do + let mut out := [] + for (adr, c) in consts do + out := out ++ (← eraseConstant ctx adr c fuel) + pure out + +/-! ## Differential tests + +The same store as the reference-evaluator suite (Nat block with +kernel-shaped rules, projection constants, unerased `add`, literal +blobs, a two-param `Pair`), erased and run on **both** interpreters — +an independent executable check of recursors, ghost motives, dropped +constructor parameters, and literal peeling alongside the simulation theorem. +-/ + +section Tests + +open Ix.Compiler.Ixon.Eval + +private def addrOf (n : UInt8) : Address := + Address.replicate n + +private def aNatBlock := addrOf 0x10 +private def aNat := addrOf 0x11 +private def aZero := addrOf 0x12 +private def aSucc := addrOf 0x13 +private def aNatRec := addrOf 0x14 +private def aAdd := addrOf 0x15 +private def aTwo := addrOf 0x16 +private def aThree := addrOf 0x17 +private def aPairBlock := addrOf 0x20 +private def aMk := addrOf 0x21 +private def aPair := addrOf 0x23 + +private def natInd : Ix.Compiler.Ixon.Inductive := + { isUnsafe := false, lvls := 0, params := 0, indices := 0 + typ := .sort 0 + ctors := #[ + { isUnsafe := false, lvls := 0, cidx := 0, params := 0, fields := 0 + typ := .recur 0 #[] }, + { isUnsafe := false, lvls := 0, cidx := 1, params := 0, fields := 1 + typ := .all .many .shared (.recur 0 #[]) (.recur 0 #[]) }] } + +private def natRec : Recursor := + { k := false, isUnsafe := false, lvls := 1, params := 0, indices := 0 + motives := 1, minors := 2, typ := .sort 0 + rules := #[ + { fields := 0 + rhs := .lam .many (.sort 0) (.lam .many (.sort 0) + (.lam .many (.sort 0) (.var 1))) }, + { fields := 1 + rhs := .lam .many (.sort 0) (.lam .many (.sort 0) + (.lam .many (.sort 0) (.lam .many (.recur 0 #[]) + (.app (.app (.var 1) (.var 0)) + (.app (.app (.app (.app (.recur 1 #[0]) (.var 3)) (.var 2)) + (.var 1)) (.var 0)))))) }] } + +private def cNatBlock : Constant := + { info := .muts #[.indc natInd, .recr natRec] + sharing := #[], refs := #[], univs := #[.var 0] } + +private def prjConst (info : ConstantInfo) : Constant := + { info, sharing := #[], refs := #[], univs := #[] } + +private def cNat := prjConst (.iPrj { idx := 0, block := aNatBlock }) +private def cZero := prjConst (.cPrj { idx := 0, cidx := 0, block := aNatBlock }) +private def cSucc := prjConst (.cPrj { idx := 0, cidx := 1, block := aNatBlock }) +private def cNatRec := prjConst (.rPrj { idx := 1, block := aNatBlock }) + +private def cAdd : Constant := + { info := .defn + { kind := .defn, safety := .safe, lvls := 0 + typ := .all .many .shared (.ref 0 #[]) + (.all .many .shared (.ref 0 #[]) (.ref 0 #[])) + value := .lam .many (.ref 0 #[]) (.lam .many (.ref 0 #[]) + (.app + (.app (.app (.app (.ref 3 #[0]) + (.lam .many (.ref 0 #[]) (.ref 0 #[]))) + (.var 1)) + (.lam .many (.ref 0 #[]) (.lam .many (.ref 0 #[]) + (.app (.ref 2 #[]) (.var 0))))) + (.var 0))) } + sharing := #[], refs := #[aNat, aZero, aSucc, aNatRec] + univs := #[.succ .zero] } + +/-- A focused non-Lean-fragment declaration proving that result ownership +is read from the source arrow rather than defaulted by erasure. -/ +private def cUniqueIdentity : Constant := + { info := .defn + { kind := .defn, safety := .safe, lvls := 0 + typ := .all .affine .unique (.ref 0 #[]) (.ref 0 #[]) + value := .lam .affine (.ref 0 #[]) (.var 0) } + sharing := #[], refs := #[aNat], univs := #[] } + +private def pairInd : Ix.Compiler.Ixon.Inductive := + { isUnsafe := false, lvls := 0, params := 2, indices := 0 + typ := .sort 0 + ctors := #[{ isUnsafe := false, lvls := 0, cidx := 0, params := 2 + fields := 2, typ := .sort 0 }] } + +private def cPairBlock : Constant := + { info := .muts #[.indc pairInd] + sharing := #[], refs := #[], univs := #[.zero] } + +private def cMk := prjConst (.cPrj { idx := 0, cidx := 0, block := aPairBlock }) +private def cPair := prjConst (.iPrj { idx := 0, block := aPairBlock }) + +private def program : List (Address × Constant) := + [(aNatBlock, cNatBlock), (aNat, cNat), (aZero, cZero), (aSucc, cSucc), + (aNatRec, cNatRec), (aAdd, cAdd), (aPairBlock, cPairBlock), (aMk, cMk), + (aPair, cPair)] + +private def resolver : Address → Option Constant := fun a => + (program.find? (fun p => p.1 == a)).map (·.2) + +private def testBlobs : Address → Option Blob := fun a => + if a == aTwo then some (.natB 2) + else if a == aThree then some (.natB 3) + else none + +private def sctx : EvalCtx := + { resolve := resolver, blobs := testBlobs, natBlock := some aNatBlock } + +private def ectx : EraseCtx := + { resolve := resolver, blobs := testBlobs, natBlock := some aNatBlock } + +/-- Test frame refs: 0 = add, 1 = zero, 2 = succ, 3 = blob 2, +4 = blob 3, 5 = mk, 6 = Pair. -/ +private def testF : Frame := + { refs := #[aAdd, aZero, aSucc, aTwo, aThree, aMk, aPair] + univs := #[.succ (.succ .zero)] } + +private def testT : ETables := + { refs := #[aAdd, aZero, aSucc, aTwo, aThree, aMk, aPair] } + +private def ienv : IxIR0.Env := + IxIR0.Env.ofList ((eraseProgram ectx program).toOption.getD []) + +private def ictx : IxIR0.Ctx := { env := ienv } + +private def sToNatGo : Nat → Value → Option Nat + | 0, _ => none + | _, .litV (.natL n) => some n + | _, .ctorV _ _ 0 [] => some 0 + | f + 1, .ctorV _ _ 1 [v] => (sToNatGo f v).map (· + 1) + | _, _ => none + +private def iToNatGo : Nat → IxIR0.Value → Option Nat + | 0, _ => none + | _, .lit (.nat n) => some n + | _, .ctor _ 0 [] => some 0 + | f + 1, .ctor _ 1 [v] => (iToNatGo f v).map (· + 1) + | _, _ => none + +/-- The differential oracle: source-evaluate, erase, target-evaluate, +compare through the numeral decoders. Demands source success. -/ +private def diffNat (e : Ix.Compiler.Ixon.Expr) : Bool := + let sv := match evalClosed sctx testF e with + | .ok v => sToNatGo 1000000 v + | .error _ => none + let tv := match eraseExpr ectx defaultFuel testT [] e with + | .ok e' => + match IxIR0.eval ictx 100000 [] e' with + | .ok v => iToNatGo 1000000 v + | .error _ => none + | .error _ => none + sv.isSome && sv == tv + +private def natE : Nat → Ix.Compiler.Ixon.Expr + | 0 => .ref 1 #[] + | n + 1 => .app (.ref 2 #[]) (natE n) + +-- β, let, ctor numerals through the erased env +#guard diffNat (natE 5) +#guard diffNat (.app (.lam .many (.ref 1 #[]) (.var 0)) (natE 4)) +#guard diffNat (.letE false (.sort 0) (natE 2) (.app (.ref 2 #[]) (.var 0))) + +-- recursor ι with ghost motive slots, both numeral forms +#guard diffNat (.app (.app (.ref 0 #[]) (natE 2)) (natE 3)) +#guard diffNat (.app (.app (.ref 0 #[]) (natE 0)) (natE 0)) +#guard diffNat (.app (.app (.ref 0 #[]) (natE 7)) (natE 0)) +#guard diffNat (.app (.app (.ref 0 #[]) (.nat 3)) (.nat 4)) +#guard diffNat (.app (.app (.ref 0 #[]) (natE 1)) (.nat 4)) + +-- dropped ctor params + projections: mk A B x y, prj skips params on +-- the source side and params are gone on the target side +#guard diffNat (.prj 6 0 (.app (.app (.app (.app (.ref 5 #[]) (.sort 0)) + (.sort 0)) (natE 1)) (natE 2))) +#guard diffNat (.prj 6 1 (.app (.app (.app (.app (.ref 5 #[]) (.sort 0)) + (.sort 0)) (natE 1)) (natE 2))) + +-- an erased-binder redex: the argument slot gets ◻ on the target side +#guard diffNat (.app (.app (.lam .many (.sort 0) + (.lam .many (.ref 1 #[]) (.var 0))) (.sort 0)) (natE 3)) + +-- structural expectations on the erased declarations +#guard teleResultOwned #[] 100 + (.all .many .shared (.sort 0) + (.all .affine .unique (.sort 0) (.sort 0))) == .unique +#guard teleResultOwned + #[.all .many .unique (.sort 0) (.sort 0)] 100 (.share 0) == .unique +#guard + match eraseConstant ectx (addrOf 0x22) cUniqueIdentity with + | .ok [(_, .defn .unique (.lam .affine (.var 0)))] => true + | _ => false +#guard (match ienv aSucc with | some (.ctor 1 1) => true | _ => false) +#guard (match ienv aZero with | some (.ctor 0 0) => true | _ => false) +#guard (match ienv (memberAddr aNatBlock 1) with + | some (.recursor 3 true _) => true | _ => false) +#guard (match ienv aNat with + | some (.defn .shared .erased) => true | _ => false) +#guard (match ienv aNatRec with + | some (.defn .shared (.ref _)) => true | _ => false) + +/-! Split/under-saturated constructor-parameter spines lower through ignored +target wrappers. The formerly silent early-fire miscompile stays closed while +partial constructor values may now escape and be applied later. -/ + +/-- `(let f := mk A in f) B x y`: the dropped-parameter prefix escapes +the visible spine. The source saturates fine through the binding. -/ +private def splitSpine : Ix.Compiler.Ixon.Expr := + .app (.app (.app (.letE false (.sort 0) + (.app (.ref 5 #[]) (.sort 0)) (.var 0)) (.sort 0)) (natE 1)) (natE 2) + +-- The source and the newly wrapped target both evaluate to the full pair. +#guard (match evalClosed sctx testF splitSpine with + | .ok (.ctorV _ 0 0 [_, _, _, _]) => true + | _ => false) + +#guard (match eraseExpr ectx defaultFuel testT [] splitSpine with + | .ok target => + match IxIR0.eval ictx 100000 [] target with + | .ok (.ctor address 0 [_, _]) => address == aMk + | _ => false + | .error _ => false) + +-- A bare head gets two wrappers; one visible parameter leaves one wrapper. +#guard (match eraseExpr ectx defaultFuel testT [] (.ref 5 #[]) with + | .ok (.lam .many (.lam .many (.ref address))) => address == aMk + | _ => false) +#guard (match eraseExpr ectx defaultFuel testT [] + (.app (.ref 5 #[]) (.sort 0)) with + | .ok (.lam .many (.ref address)) => address == aMk + | _ => false) + +-- A bare head may escape through a let and consume both wrappers later. +#guard (match eraseExpr ectx defaultFuel testT [] + (.letE false (.sort 0) (.ref 5 #[]) + (.app (.app (.app (.app (.var 0) (.sort 0)) (.sort 0)) (natE 1)) + (natE 2))) with + | .ok target => + match IxIR0.eval ictx 100000 [] target with + | .ok (.ctor address 0 [_, _]) => address == aMk + | _ => false + | .error _ => false) + +-- the complete parameter prefix still erases to the first-class head +#guard (match eraseExpr ectx defaultFuel testT [] + (.app (.app (.ref 5 #[]) (.sort 0)) (.sort 0)) with + | .ok (.ref a) => a == aMk + | _ => false) + +/-! Configured quotient primitives use their real source arities and the +fixed erased definitions above. These deliberately small, all-kept +telescopes isolate the semantic seam: both `lift` and `ind` must open the +representative stored by `mk`, while the target runs the emitted lambda +bodies. -/ + +private def aQuotCtor := addrOf 0x30 +private def aQuotLift := addrOf 0x31 +private def aQuotInd := addrOf 0x32 +private def aQuotPayload := addrOf 0x33 + +private def quotTestType : Nat → Ix.Compiler.Ixon.Expr + | 0 => .var 0 + | n + 1 => .all .many .shared (.var 0) (quotTestType n) + +private def quotConst (kind : Ix.Compiler.Ixon.QuotKind) + (arity : Nat) : Constant := + { info := .quot { kind, lvls := 0, typ := quotTestType arity } + sharing := #[], refs := #[], univs := #[] } + +private def quotProgram : List (Address × Constant) := + [(aQuotCtor, quotConst Ix.Compiler.Ixon.QuotKind.ctor 3), + (aQuotLift, quotConst Ix.Compiler.Ixon.QuotKind.lift 6), + (aQuotInd, quotConst Ix.Compiler.Ixon.QuotKind.ind 5)] + +private def quotResolver : Address → Option Constant := fun a => + (quotProgram.find? (fun p => p.1 == a)).map (·.2) + +private def quotKindAt : Address → Option Ix.Compiler.Ixon.QuotKind := fun a => + if a == aQuotCtor then some Ix.Compiler.Ixon.QuotKind.ctor + else if a == aQuotLift then some Ix.Compiler.Ixon.QuotKind.lift + else if a == aQuotInd then some Ix.Compiler.Ixon.QuotKind.ind + else none + +private def quotSctx : EvalCtx := + { resolve := quotResolver + blobs := fun a => if a == aQuotPayload then some (.natB 37) else none + quotientKind := quotKindAt } + +private def quotEctx : EraseCtx := + { resolve := quotResolver + blobs := fun a => if a == aQuotPayload then some (.natB 37) else none } + +private def quotF : Frame := + { refs := #[aQuotCtor, aQuotLift, aQuotInd, aQuotPayload] + univs := #[.zero] } + +private def quotT : ETables := + { refs := #[aQuotCtor, aQuotLift, aQuotInd, aQuotPayload] } + +private def quotIctx : IxIR0.Ctx := + { env := IxIR0.Env.ofList + ((eraseProgram quotEctx quotProgram).toOption.getD []) } + +private def ixApps (head : Ix.Compiler.Ixon.Expr) + (args : List Ix.Compiler.Ixon.Expr) : Ix.Compiler.Ixon.Expr := + args.foldl .app head + +private def quotMk37 : Ix.Compiler.Ixon.Expr := + ixApps (.ref 0 #[]) [.sort 0, .sort 0, .nat 3] + +private def quotLift37 : Ix.Compiler.Ixon.Expr := + ixApps (.ref 1 #[]) + [.sort 0, .sort 0, .sort 0, + .lam .many (.var 0) (.var 0), .sort 0, quotMk37] + +private def quotInd37 : Ix.Compiler.Ixon.Expr := + ixApps (.ref 2 #[]) + [.sort 0, .sort 0, .sort 0, + .lam .many (.var 0) (.var 0), quotMk37] + +private def diffQuotNat (source : Ix.Compiler.Ixon.Expr) : Bool := + let sourceResult := match evalClosed quotSctx quotF source with + | .ok (.litV (.natL n)) => some n + | _ => none + let targetResult := + match eraseExpr quotEctx defaultFuel quotT [] source with + | .ok target => + match IxIR0.eval quotIctx 100000 [] target with + | .ok (.lit (.nat n)) => some n + | _ => none + | .error _ => none + sourceResult == some 37 && sourceResult == targetResult + +#guard diffQuotNat quotLift37 +#guard diffQuotNat quotInd37 + +end Tests + +end Ix.Compiler.Erase diff --git a/Ix/Compiler/EraseAddressed.lean b/Ix/Compiler/EraseAddressed.lean new file mode 100644 index 000000000..998c0f81b --- /dev/null +++ b/Ix/Compiler/EraseAddressed.lean @@ -0,0 +1,144 @@ +import Ix.Compiler.Erase +import Ix.Compiler.IxIR0.Readdress + +/-! +# Artifact-facing addressed erasure + +The proof-facing eraser still emits transient mutual-member keys. This module +preserves that exact intermediate result, records constant boundaries, and +then applies the certified whole-IxIR₀ block readdresser. It is the migration +seam for later evaluator transport and pipeline adoption; no existing erasure +theorem is weakened or silently retargeted. +-/ + +namespace Ix.Compiler.EraseAddressed + +open Ix.Compiler.Ixon (Address Constant ConstantInfo) + +inductive Error where + | erase (error : Erase.EraseErr) + | readdress (message : String) + deriving Repr + +/-- Erase each source constant while retaining whether its output is one +stable group or one mutual block. -/ +def eraseGroups (ctx : Erase.EraseCtx) + (consts : List (Address × Constant)) + (fuel : Nat := Erase.defaultFuel) : + Except Error (List IxIR0.Readdress.Group) := do + let mut groups := [] + for (address, constant) in consts do + let entries ← + match Erase.eraseConstant ctx address constant fuel with + | .ok entries => pure entries + | .error error => throw (.erase error) + let group := + match constant.info with + | .muts _ => IxIR0.Readdress.Group.mutual entries + | _ => IxIR0.Readdress.Group.stable entries + groups := groups ++ [group] + return groups + +/-- Complete artifact-facing erasure result. `raw` is exactly the old eraser +output; `addressed` is its collision-checked block-address image. -/ +structure Result where + raw : List (Address × IxIR0.Decl) + groups : List IxIR0.Readdress.Group + addressed : IxIR0.Readdress.Result + +namespace Result + +def addressMap (result : Result) : IxIR0.MutualBlock.Renaming := + result.addressed.addressMap + +def declarations (result : Result) : List (Address × IxIR0.Decl) := + result.addressed.declarations + +def main (result : Result) : IxIR0.Expr := + result.addressed.main + +/-- Executable bridge pinning both seams: group flattening equals the existing +eraser's exact output, and the addressed result is the certified image of +that grouping. -/ +def semanticAudit (result : Result) (ctx : Erase.EraseCtx) + (consts : List (Address × Constant)) (main : IxIR0.Expr) + (fuel : Nat) : Bool := + result.raw == IxIR0.Readdress.rawDeclarations result.groups && + (match Erase.eraseProgram ctx consts fuel with + | .ok raw => raw == result.raw + | .error _ => false) && + result.addressed.semanticAudit (consts.map (·.1)) result.groups main + +end Result + +abbrev CertifiedResult (ctx : Erase.EraseCtx) + (consts : List (Address × Constant)) (main : IxIR0.Expr) (fuel : Nat) := + { result : Result // result.semanticAudit ctx consts main fuel = true } + +private def certify (ctx : Erase.EraseCtx) + (consts : List (Address × Constant)) (main : IxIR0.Expr) (fuel : Nat) + (result : Result) : Except Error (CertifiedResult ctx consts main fuel) := + if haudit : result.semanticAudit ctx consts main fuel then + .ok ⟨result, haudit⟩ + else + .error (.readdress + "internal: addressed erasure failed its exact-output audit") + +/-- Run the existing eraser, then readdress every `.muts` output as a +cycle-safe block. Every source constant address is protected, including the +Ixon identity of each mutual block. -/ +def runCertified (ctx : Erase.EraseCtx) + (consts : List (Address × Constant)) (main : IxIR0.Expr) + (fuel : Nat := Erase.defaultFuel) : + Except Error (CertifiedResult ctx consts main fuel) := do + let groups ← eraseGroups ctx consts fuel + let raw := IxIR0.Readdress.rawDeclarations groups + let addressed ← + match IxIR0.Readdress.run (consts.map (·.1)) groups main with + | .ok result => pure result + | .error message => throw (.readdress message) + certify ctx consts main fuel { raw, groups, addressed } + +/-- Artifact-facing projection of `runCertified`. -/ +def run (ctx : Erase.EraseCtx) + (consts : List (Address × Constant)) (main : IxIR0.Expr) + (fuel : Nat := Erase.defaultFuel) : Except Error Result := do + return (← runCertified ctx consts main fuel).1 + +/-- Proof-facing execution record for addressed erasure. The ordinary API +returns the same `Result`; this companion retains the exact successful run +equation needed to compose the validator and lowering simulations. -/ +structure RunTrace (ctx : Erase.EraseCtx) + (consts : List (Address × Constant)) (main : IxIR0.Expr) + (fuel : Nat) where + result : Result + runEq : run ctx consts main fuel = .ok result + +/-- Execute addressed erasure once and retain its successful equation. -/ +def runWithTrace (ctx : Erase.EraseCtx) + (consts : List (Address × Constant)) (main : IxIR0.Expr) + (fuel : Nat := Erase.defaultFuel) : + Except Error (RunTrace ctx consts main fuel) := + match hrun : run ctx consts main fuel with + | .error error => .error error + | .ok result => .ok { result, runEq := hrun } + +/-- Successful addressed erasure retains the exact-output/address-image +audit. -/ +theorem semanticAudit_of_run_eq_ok + {ctx : Erase.EraseCtx} {consts : List (Address × Constant)} + {main : IxIR0.Expr} {fuel : Nat} {result : Result} + (hrun : run ctx consts main fuel = .ok result) : + result.semanticAudit ctx consts main fuel = true := by + unfold run at hrun + cases hcertified : runCertified ctx consts main fuel with + | error error => + rw [hcertified] at hrun + contradiction + | ok certified => + rw [hcertified] at hrun + have hvalue : certified.1 = result := by injection hrun + subst result + exact certified.2 + +end Ix.Compiler.EraseAddressed diff --git a/Ix/Compiler/EraseAddressedSim.lean b/Ix/Compiler/EraseAddressedSim.lean new file mode 100644 index 000000000..3dcd31b0e --- /dev/null +++ b/Ix/Compiler/EraseAddressedSim.lean @@ -0,0 +1,229 @@ +import Ix.Compiler.EraseAddressed +import Ix.Compiler.IxIR0.ReaddressOracle + +/-! +# Semantic boundary for addressed erasure + +`EraseAddressed.run` deliberately retains the legacy eraser output and then +applies the certified cycle-safe IxIR₀ readdresser. This module exposes both +halves of that executable audit as ordinary equalities and composes the +IxIR₀ evaluator-equivariance theorem with the artifact-facing erasure API. + +The source evaluator context contains the legacy declarations plus stable +aliases for derived keys. It therefore agrees exactly with every lookup in +the legacy environment while being total enough for closures or recursor +values that already contain a derived address. +-/ + +namespace Ix.Compiler.EraseAddressed + +open Ix.Compiler.Ixon (Address Constant) + +namespace Result + +/-- The exact legacy declaration environment consumed by the erasure +validator before block readdressing. -/ +def rawCtx (result : Result) + (oracle : IxIR0.Oracle := fun _ _ => none) : IxIR0.Ctx := + { env := IxIR0.Env.ofList result.raw, oracle } + +/-- The recorded raw declarations are exactly the grouped eraser output. -/ +theorem raw_eq_grouped {result : Result} {ctx : Erase.EraseCtx} + {consts : List (Address × Constant)} {main : IxIR0.Expr} {fuel : Nat} + (haudit : result.semanticAudit ctx consts main fuel = true) : + result.raw = IxIR0.Readdress.rawDeclarations result.groups := by + simp only [semanticAudit, Bool.and_eq_true] at haudit + exact (beq_iff_eq).mp haudit.1.1 + +/-- The legacy eraser succeeded with exactly the raw declarations retained in +the addressed artifact. -/ +theorem eraseProgram_eq_ok {result : Result} {ctx : Erase.EraseCtx} + {consts : List (Address × Constant)} {main : IxIR0.Expr} {fuel : Nat} + (haudit : result.semanticAudit ctx consts main fuel = true) : + Erase.eraseProgram ctx consts fuel = .ok result.raw := by + simp only [semanticAudit, Bool.and_eq_true] at haudit + cases herase : Erase.eraseProgram ctx consts fuel with + | error error => simp [herase] at haudit + | ok raw => + have hequal : raw = result.raw := + (beq_iff_eq).mp (by simpa [herase] using haudit.1.2) + exact congrArg Except.ok hequal + +/-- The addressed half retains the complete whole-program semantic audit. -/ +theorem addressed_audit {result : Result} {ctx : Erase.EraseCtx} + {consts : List (Address × Constant)} {main : IxIR0.Expr} {fuel : Nat} + (haudit : result.semanticAudit ctx consts main fuel = true) : + result.addressed.semanticAudit (consts.map (·.1)) result.groups main = + true := by + simp only [semanticAudit, Bool.and_eq_true] at haudit + exact haudit.2 + +end Result + +/-- Successful addressed erasure transports closed IxIR₀ evaluation through +the certified mutual-block map. Extern behavior is parameterized by the +same structural oracle-equivariance condition as the generic evaluator +theorem. -/ +theorem run_semantics_of_run_eq_ok + {ctx : Erase.EraseCtx} {consts : List (Address × Constant)} + {main : IxIR0.Expr} {eraseFuel : Nat} {result : Result} + (hrun : run ctx consts main eraseFuel = .ok result) + (beforeOracle afterOracle : IxIR0.Oracle) + (horacle : ∀ address arguments, + afterOracle + (IxIR0.MutualBlock.Renaming.apply result.addressMap address) + (IxIR0.Readdress.ValueList.mapAddresses + (IxIR0.MutualBlock.Renaming.apply result.addressMap) arguments) = + (beforeOracle address arguments).map + (IxIR0.Readdress.Value.mapAddresses + (IxIR0.MutualBlock.Renaming.apply result.addressMap))) + (evalFuel : Nat := 100000) : + (result.addressed.addressedCtx afterOracle).run result.main evalFuel = + IxIR0.Readdress.mapResult + (IxIR0.MutualBlock.Renaming.apply result.addressMap) + ((result.addressed.preAddressCtx result.groups beforeOracle).run + main evalFuel) := by + have haudit := semanticAudit_of_run_eq_ok hrun + have haddressed := result.addressed_audit haudit + simp only [Result.main, Result.addressMap] + rw [result.addressed.main_eq_mapAddresses haddressed] + exact IxIR0.Readdress.Ctx.run_mapAddresses + (result.addressed.renames_preAddressCtx haddressed + beforeOracle afterOracle horacle) + main evalFuel + +/-- Pure addressed programs require no oracle premise. -/ +theorem run_emptyOracle_semantics_of_run_eq_ok + {ctx : Erase.EraseCtx} {consts : List (Address × Constant)} + {main : IxIR0.Expr} {eraseFuel : Nat} {result : Result} + (hrun : run ctx consts main eraseFuel = .ok result) + (evalFuel : Nat := 100000) : + (result.addressed.addressedCtx).run result.main evalFuel = + IxIR0.Readdress.mapResult + (IxIR0.MutualBlock.Renaming.apply result.addressMap) + ((result.addressed.preAddressCtx result.groups).run main evalFuel) := by + apply run_semantics_of_run_eq_ok hrun + (fun _ _ => none) (fun _ _ => none) _ evalFuel + intro address arguments + rfl + +/-- A successful legacy-side run yields the address-renamed value in the +addressed artifact. -/ +theorem run_success_of_run_eq_ok + {ctx : Erase.EraseCtx} {consts : List (Address × Constant)} + {main : IxIR0.Expr} {eraseFuel : Nat} {result : Result} + (hrun : run ctx consts main eraseFuel = .ok result) + (beforeOracle afterOracle : IxIR0.Oracle) + (horacle : ∀ address arguments, + afterOracle + (IxIR0.MutualBlock.Renaming.apply result.addressMap address) + (IxIR0.Readdress.ValueList.mapAddresses + (IxIR0.MutualBlock.Renaming.apply result.addressMap) arguments) = + (beforeOracle address arguments).map + (IxIR0.Readdress.Value.mapAddresses + (IxIR0.MutualBlock.Renaming.apply result.addressMap))) + {evalFuel : Nat} {value : IxIR0.Value} + (hsource : + (result.addressed.preAddressCtx result.groups beforeOracle).run + main evalFuel = .ok value) : + (result.addressed.addressedCtx afterOracle).run result.main evalFuel = + .ok (IxIR0.Readdress.Value.mapAddresses + (IxIR0.MutualBlock.Renaming.apply result.addressMap) value) := by + rw [run_semantics_of_run_eq_ok hrun beforeOracle afterOracle horacle + evalFuel, hsource] + rfl + +/-- A successful addressed erasure transports the validator's exact +call-aware main trace from its literal raw environment to the final emitted +environment. -/ +theorem run_projectionSafeMain_of_run_eq_ok + {ctx : Erase.EraseCtx} {consts : List (Address × Constant)} + {main : IxIR0.Expr} {eraseFuel : Nat} {result : Result} + (hrun : run ctx consts main eraseFuel = .ok result) + (beforeOracle afterOracle : IxIR0.Oracle) + (horacle : ∀ address arguments, + afterOracle + (IxIR0.MutualBlock.Renaming.apply result.addressMap address) + (IxIR0.Readdress.ValueList.mapAddresses + (IxIR0.MutualBlock.Renaming.apply result.addressMap) arguments) = + (beforeOracle address arguments).map + (IxIR0.Readdress.Value.mapAddresses + (IxIR0.MutualBlock.Renaming.apply result.addressMap))) + {traceFuel : Nat} {value : IxIR0.Value} + (trace : IxIR0.ProjectionSafe.Eval (result.rawCtx beforeOracle) + traceFuel [] main value) : + IxIR0.ProjectionSafe.Eval + (result.addressed.addressedCtx afterOracle) traceFuel [] result.main + (IxIR0.Readdress.Value.mapAddresses + (IxIR0.MutualBlock.Renaming.apply result.addressMap) value) := by + have haudit := semanticAudit_of_run_eq_ok hrun + have hraw := result.raw_eq_grouped haudit + have haddressed := result.addressed_audit haudit + have trace' : IxIR0.ProjectionSafe.Eval + (result.addressed.rawCtx result.groups beforeOracle) + traceFuel [] main value := by + simpa [Result.rawCtx, IxIR0.Readdress.Result.rawCtx, hraw] using trace + exact result.addressed.projectionSafeMain_of_audit haddressed + beforeOracle afterOracle horacle trace' + +/-- Pure addressed programs transport their exact main trace without an +oracle premise. -/ +theorem run_emptyOracle_projectionSafeMain_of_run_eq_ok + {ctx : Erase.EraseCtx} {consts : List (Address × Constant)} + {main : IxIR0.Expr} {eraseFuel : Nat} {result : Result} + (hrun : run ctx consts main eraseFuel = .ok result) + {traceFuel : Nat} {value : IxIR0.Value} + (trace : IxIR0.ProjectionSafe.Eval result.rawCtx traceFuel [] main value) : + IxIR0.ProjectionSafe.Eval result.addressed.addressedCtx traceFuel [] + result.main + (IxIR0.Readdress.Value.mapAddresses + (IxIR0.MutualBlock.Renaming.apply result.addressMap) value) := by + apply run_projectionSafeMain_of_run_eq_ok hrun + (fun _ _ => none) (fun _ _ => none) _ trace + intro address arguments + rfl + +/-- Executable-oracle specialization of closed evaluator transport. The +caller proves only the compact legacy-oracle coherence law; the addressed +oracle and the full evaluator compatibility equation are constructed here. -/ +theorem run_readdressOracle_semantics_of_run_eq_ok + {ctx : Erase.EraseCtx} {consts : List (Address × Constant)} + {main : IxIR0.Expr} {eraseFuel : Nat} {result : Result} + (hrun : run ctx consts main eraseFuel = .ok result) + (beforeOracle : IxIR0.Oracle) + (horacle : IxIR0.Readdress.Oracle.Readdressable result.addressMap + beforeOracle) + (evalFuel : Nat := 100000) : + (result.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress result.addressMap beforeOracle)).run + result.main evalFuel = + IxIR0.Readdress.mapResult + (IxIR0.MutualBlock.Renaming.apply result.addressMap) + ((result.addressed.preAddressCtx result.groups beforeOracle).run + main evalFuel) := + run_semantics_of_run_eq_ok hrun beforeOracle + (IxIR0.Readdress.Oracle.readdress result.addressMap beforeOracle) + (IxIR0.Readdress.Oracle.readdress_compatible horacle) evalFuel + +/-- Executable-oracle specialization of exact call-aware trace transport. -/ +theorem run_readdressOracle_projectionSafeMain_of_run_eq_ok + {ctx : Erase.EraseCtx} {consts : List (Address × Constant)} + {main : IxIR0.Expr} {eraseFuel : Nat} {result : Result} + (hrun : run ctx consts main eraseFuel = .ok result) + (beforeOracle : IxIR0.Oracle) + (horacle : IxIR0.Readdress.Oracle.Readdressable result.addressMap + beforeOracle) + {traceFuel : Nat} {value : IxIR0.Value} + (trace : IxIR0.ProjectionSafe.Eval (result.rawCtx beforeOracle) + traceFuel [] main value) : + IxIR0.ProjectionSafe.Eval + (result.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress result.addressMap beforeOracle)) + traceFuel [] result.main + (IxIR0.Readdress.Value.mapAddresses + (IxIR0.MutualBlock.Renaming.apply result.addressMap) value) := + run_projectionSafeMain_of_run_eq_ok hrun beforeOracle + (IxIR0.Readdress.Oracle.readdress result.addressMap beforeOracle) + (IxIR0.Readdress.Oracle.readdress_compatible horacle) trace + +end Ix.Compiler.EraseAddressed diff --git a/Ix/Compiler/EraseValidator.lean b/Ix/Compiler/EraseValidator.lean new file mode 100644 index 000000000..642be9cee --- /dev/null +++ b/Ix/Compiler/EraseValidator.lean @@ -0,0 +1,1538 @@ +import Ix.Compiler.Sim + +/-! +# Proof-producing executable-erasure validator + +`Erase.eraseExpr` intentionally accepts more syntax than the core fragment +covered directly by `Sim.PErase`: general dropped-variable reads still need +their simulation machinery. Unfoldable definition projections and non-self +inductive members are checked structurally. Non-self unfoldable-definition and +recursor heads are admitted through a finite `MemberScope`; after public +coverage succeeds, `validateMemberCoverage` checks every named body/rule set +against that same plan, closing cyclic blocks without recursive validator +calls. Configured opaque mutual projections and members are admitted only when +the source extern arity and target declaration agree at the exact synthetic +member address; semantic oracle agreement remains a theorem premise. +Constructor parameter prefixes are certified by `CtorParamSpine`; partial and +split prefixes use ignored target wrappers, while complete visible prefixes +expose the field-arity constructor. Indexed recursor spines use +`RecEraseSpine`; a spine that stops in its source-only index suffix is +certified by structurally reconstructing the let-captured ignored continuation +(`PErase.recW`), including after escape through a variable or let. Rule-local +indexed `recur` heads use the environment's already-certified self member, so +rule validation does not recurse through its own member oracle. +Ordinary unfoldable definition heads use `DefSpine`: declaration-type policy +must agree with the literal implementation binder before a ghost argument is +certified. Definition coverage also reconstructs the fuel-free +`TeleResultOwned` relation, so the emitted declaration's ownership cannot +drift from the source telescope. Configured quotient coverage checks the +address/kind identity, exact compiler-generated lambda body, and the same +result-ownership relation. Opaque definitions and axioms are certified only +when the source evaluator is configured at the compiler-emitted extern arity; +their semantic oracle correspondence remains an explicit theorem premise. Raw +`.share` syntax also stays out of `PErase`, but the +`certifyShared*` entry points validate the real eraser output against the +semantically inlined source. This module provides the roadmap-approved +bridge between the executable pass and the theorem: run the real eraser, +check its exact output against the relation, and return the `PErase` proof +as part of the result. + +The validator is deliberately partial in the proof sense, not in Lean's +termination sense. It rejects an executable erasure that lies outside the +current simulation fragment. A successful result cannot drift from the +compiler output: `CertifiedExpr.erased` records the actual `eraseExpr` +equation and `CertifiedExpr.related` records the kernel-checked relational +witness for that same target expression. `CertifiedSharedExpr` adds the +inlining/evaluator-coherence bridge while retaining the original erasure +equation. +-/ + +namespace Ix.Compiler.EraseValidator + +open Ix.Compiler.Ixon (Address Constant MutConst Owned Recursor RecursorRule Uses) +open Ix.Compiler.Sim + +/-- Use exactly the evaluator's resolver, blob store, and Nat identity when +running the executable eraser for a simulation certificate. Quotient identity +is not an eraser input: it remains on `ectx` and is checked by +`validateCovered` before a quotient reference receives a certificate. + +Parameterized constructor heads use the same ignored-wrapper lowering as the +executable eraser. The validator reconstructs that wrapper structurally; no +configuration switch separates raw and certified erasure. -/ +def eraseCtxOf (ectx : Ixon.Eval.EvalCtx) : Erase.EraseCtx := + { resolve := ectx.resolve, blobs := ectx.blobs, natBlock := ectx.natBlock } + +/-- Eraser tables corresponding to semantic full inlining. Reference and +rule-state metadata are unchanged; source roots in mutual members are inlined +against the same table as the enclosing expression, and the table is cleared. -/ +def inlineTables (T : Erase.ETables) : Erase.ETables := + { sharing := #[] + refs := T.refs + selfMuts := T.selfMuts.map + (MutConst.mapExprs (Ixon.Sharing.inlineExpr T.sharing)) + curBlock := T.curBlock + recSelf := T.recSelf } + +/-- The eraser-table view of an evaluator frame for a closed expression. +`recSelf` is absent outside an individual recursor-rule certificate. -/ +def tablesOfFrame (F : Ixon.Eval.Frame) : Erase.ETables := + { sharing := F.sharing + refs := F.refs + selfMuts := F.selfMuts + curBlock := F.selfAddr } + +/-- Normalizing eraser tables built from a frame is exactly the eraser-table +view of the normalized evaluator frame. -/ +@[simp] theorem inlineTables_tablesOfFrame (F : Ixon.Eval.Frame) : + inlineTables (tablesOfFrame F) = tablesOfFrame F.inlineSharing := by + rfl + +@[simp] theorem inlineTables_refs (T : Erase.ETables) : + (inlineTables T).refs = T.refs := rfl + +@[simp] theorem inlineTables_curBlock (T : Erase.ETables) : + (inlineTables T).curBlock = T.curBlock := rfl + +@[simp] theorem inlineTables_recSelf (T : Erase.ETables) : + (inlineTables T).recSelf = T.recSelf := rfl + +section MemberScoped + +variable [scope : MemberScope] + +/-- Program-level facts are supplied independently of expression checking. +This is the usual CompCert split: environment validation establishes +`Covered`; expression validation consumes those facts at references. -/ +abbrev CoverOracle (ectx : Ixon.Eval.EvalCtx) (ictx : IxIR0.Ctx) := + (a : Address) → Option (PLift (Covered ectx ictx a)) + +/-- Indexed recursor spines cannot use `Covered`, because their bare target +head has fewer visible arguments than the source head. An entry-expression +certificate instead supplies the already checked member fact directly. -/ +abbrev RecMemberOracle (ectx : Ixon.Eval.EvalCtx) (ictx : IxIR0.Ctx) := + (block : Address) → (idx : Nat) → (bc : Constant) → (r : Recursor) → + Ixon.Eval.resolveMut ectx block idx = .ok (bc, .recr r) → + Option (PLift (RecMember ectx ictx block idx r)) + +/-- The index-free default used by the existing public validator API. -/ +def noRecMembers {ectx : Ixon.Eval.EvalCtx} {ictx : IxIR0.Ctx} : + RecMemberOracle ectx ictx := + fun _ _ _ _ _ => none + +/-- A proof that `e` is an index-free recursor prefix, when it can be +reconstructed directly from the current source frame. -/ +def recPrefix? (ectx : Ixon.Eval.EvalCtx) (refs : Array Address) + (muts : Array MutConst) (sa : Option Address) (e : Ixon.Expr) : + Option (Σ r : Recursor, PLift (RecPrefix ectx refs muts sa e r)) := + match e with + | .ref refIdx _ => + match href : refs[refIdx.toNat]? with + | some a => + match hc : ectx.resolve a with + | some c => + match hi : c.info with + | .rPrj p => + match hm : Ixon.Eval.resolveMut ectx p.block p.idx.toNat with + | .ok (_bc, .recr r) => + if hx : r.indices.toNat = 0 then + some ⟨r, ⟨.refH href hc hi hm hx⟩⟩ + else none + | _ => none + | _ => none + | none => none + | none => none + | .recur recIdx _ => + match sa with + | some _block => + match hm : muts[recIdx.toNat]? with + | some (.recr r) => + if hx : r.indices.toNat = 0 then + some ⟨r, ⟨.recurH rfl hm hx⟩⟩ + else none + | _ => none + | none => none + | _ => none + +/-- Reconstruct a guarded recursor spine and its number of supplied +pre-major arguments. The step constructor prevents walking past the +parameter/motive/minor policy. -/ +def recSpine? (ectx : Ixon.Eval.EvalCtx) (refs : Array Address) + (muts : Array MutConst) (sa : Option Address) : + Nat → (e : Ixon.Expr) → + Option (Σ r : Recursor, Σ j : Nat, + PLift (RecSpine ectx refs muts sa e r j)) + | 0, _ => none + | fuel + 1, e => + match recPrefix? ectx refs muts sa e with + | some ⟨r, h⟩ => some ⟨r, 0, ⟨.head h.down⟩⟩ + | none => + match e with + | .app f _ => + match recSpine? ectx refs muts sa fuel f with + | some ⟨r, j, h⟩ => + if hj : j < (recRulePolicy r).length then + some ⟨r, j + 1, ⟨.step h.down hj⟩⟩ + else none + | none => none + | _ => none + +/-- Dependent package returned while following an unfoldable ordinary +definition through its literal implementation telescope. -/ +structure DefSpineCert (ectx : Ixon.Eval.EvalCtx) + (refs : Array Address) (e : Ixon.Expr) where + residual : Ixon.Expr + spine : DefSpine ectx refs e residual + +/-- Reconstruct the implementation-side definition spine used to justify a +ghost application. Declaration-type policy drives executable erasure; this +second check ensures the lambda actually reached at run time drops the same +argument. -/ +def defSpine? (ectx : Ixon.Eval.EvalCtx) (refs : Array Address) : + Nat → (e : Ixon.Expr) → Option (DefSpineCert ectx refs e) + | 0, _ => none + | fuel + 1, e => + match e with + | .ref refIdx univIdxs => + match hr : refs[refIdx.toNat]? with + | some address => + match hc : ectx.resolve address with + | some constant => + match hi : constant.info with + | .defn definition => + match hu : Ixon.Eval.unfoldable definition with + | true => some + { residual := definition.value + spine := .head hr hc hi hu } + | false => none + | _ => none + | none => none + | none => none + | .app function argument => + match defSpine? ectx refs fuel function with + | some cert => + match hr : cert.residual with + | .lam uses domain body => by + have hspine := cert.spine + rw [hr] at hspine + exact some + { residual := body + spine := .step hspine } + | _ => none + | none => none + | _ => none + +/-- Dependent package returned while reconstructing a syntactically visible +constructor parameter spine. -/ +structure CtorParamSpineCert (ectx : Ixon.Eval.EvalCtx) + (refs : Array Address) (e : Ixon.Expr) where + address : Address + block : Address + indIdx : Nat + cidx : Nat + params : Nat + fields : Nat + consumed : Nat + spine : CtorParamSpine ectx refs e address block indIdx cidx params fields + consumed + +/-- Reconstruct a constructor head and the dropped-parameter prefix consumed +so far. Walking stops before the first runtime field. -/ +def ctorParamSpine? (ectx : Ixon.Eval.EvalCtx) (refs : Array Address) : + Nat → (e : Ixon.Expr) → Option (CtorParamSpineCert ectx refs e) + | 0, _ => none + | fuel + 1, e => + match e with + | .ref refIdx _univIdxs => + match hr : refs[refIdx.toNat]? with + | some a => + match hc : ectx.resolve a with + | some c => + match hi : c.info with + | .cPrj p => + match hm : Ixon.Eval.resolveMut ectx p.block p.idx.toNat with + | .ok (bc, .indc ind) => + match ht : ind.ctors[p.cidx.toNat]? with + | some ct => + if hp : ind.params.toNat = ct.params.toNat then + some + { address := a + block := p.block + indIdx := p.idx.toNat + cidx := p.cidx.toNat + params := ct.params.toNat + fields := ct.fields.toNat + consumed := 0 + spine := .head hr hc hi + ⟨bc, ind, ct, hm, ht, hp, rfl, rfl⟩ } + else none + | none => none + | _ => none + | _ => none + | none => none + | none => none + | .app f _arg => + match ctorParamSpine? ectx refs fuel f with + | some cert => + if hj : cert.consumed < cert.params then + some + { address := cert.address + block := cert.block + indIdx := cert.indIdx + cidx := cert.cidx + params := cert.params + fields := cert.fields + consumed := cert.consumed + 1 + spine := .step cert.spine hj } + else none + | none => none + | _ => none + +private def fail {P : Prop} (msg : String) : Except String (PLift P) := + .error msg + +/-- Construct the fuel-free result-ownership relation. Fuel controls only +checker termination: exhaustion rejects instead of manufacturing the shared +default, so a successful certificate is independent of the chosen bound. -/ +def validateTeleResultOwned (sharing : Array Ixon.Expr) : + Nat → (typ : Ixon.Expr) → + Except String (Σ candidate : Option Owned, + PLift (TeleResultOwned sharing typ candidate)) + | 0, _ => .error "result-ownership validation fuel exhausted" + | fuel + 1, typ => + match typ with + | .all _uses result _domain codomain => do + let cert ← validateTeleResultOwned sharing fuel codomain + match cert with + | ⟨none, proof⟩ => + pure ⟨some result, ⟨.allHere proof.down⟩⟩ + | ⟨some inner, proof⟩ => + pure ⟨some inner, ⟨.allInner proof.down⟩⟩ + | .share index => + match hlookup : sharing[index.toNat]? with + | none => .ok ⟨none, ⟨.shareMissing hlookup⟩⟩ + | some target => do + let cert ← validateTeleResultOwned sharing fuel target + pure ⟨cert.1, ⟨.share hlookup cert.2.down⟩⟩ + | .sort _ => .ok ⟨none, ⟨.terminal rfl⟩⟩ + | .var _ => .ok ⟨none, ⟨.terminal rfl⟩⟩ + | .ref _ _ => .ok ⟨none, ⟨.terminal rfl⟩⟩ + | .recur _ _ => .ok ⟨none, ⟨.terminal rfl⟩⟩ + | .prj _ _ _ => .ok ⟨none, ⟨.terminal rfl⟩⟩ + | .str _ => .ok ⟨none, ⟨.terminal rfl⟩⟩ + | .nat _ => .ok ⟨none, ⟨.terminal rfl⟩⟩ + | .app _ _ => .ok ⟨none, ⟨.terminal rfl⟩⟩ + | .lam _ _ _ => .ok ⟨none, ⟨.terminal rfl⟩⟩ + | .letE _ _ _ _ => .ok ⟨none, ⟨.terminal rfl⟩⟩ + +/-- Recognize the four closed quotient definitions emitted by the eraser. +Keeping this structural avoids assuming a global decidable-equality law for +IxIR₀ expressions merely to validate these fixed compiler-generated bodies. -/ +private def validateQuotientBody (kind : Ixon.QuotKind) + (body : IxIR0.Expr) : + Except String (PLift (body = Erase.quotientBody kind)) := + match kind, body with + | .type, .erased => .ok ⟨rfl⟩ + | .ctor, .lam .many (.lam .many (.lam .many (.var 0))) => .ok ⟨rfl⟩ + | .lift, + .lam .many (.lam .many (.lam .many (.lam .many (.lam .many + (.lam .many (.app (.var 2) (.var 0))))))) => .ok ⟨rfl⟩ + | .ind, + .lam .many (.lam .many (.lam .many (.lam .many + (.lam .many (.app (.var 1) (.var 0)))))) => .ok ⟨rfl⟩ + | _, _ => .error "erased quotient body mismatch" + +/-- Check an ignored constructor-parameter wrapper without assuming global +decidable equality for target expressions. -/ +private def validateCtorWrapper : (remaining : Nat) → (address : Address) → + (body : IxIR0.Expr) → + Except String (PLift (body = Erase.lamManyN remaining (.ref address))) + | 0, address, .ref target => + if haddress : target = address then by + subst target + exact .ok ⟨rfl⟩ + else .error "constructor wrapper address mismatch" + | remaining + 1, address, .lam .many body => + match validateCtorWrapper remaining address body with + | .ok hbody => by + rw [hbody.down] + exact .ok ⟨rfl⟩ + | .error message => .error message + | _ + 1, _, .lam _ _ => .error "constructor wrapper binder mode mismatch" + | _, _, _ => .error "constructor wrapper body mismatch" + +/-- Check the body of an indexed-recursor continuation. `anchor` remains +constant while ignored binders are peeled because it names the let-captured +pre-major pap below the entire wrapper telescope. -/ +private def validateRecIndexWrapper : (remaining anchor : Nat) → + (body : IxIR0.Expr) → + Except String + (PLift (body = Erase.lamManyN remaining (.var anchor))) + | 0, anchor, .var target => + if hindex : target = anchor then by + subst target + exact .ok ⟨rfl⟩ + else .error "indexed recursor wrapper capture mismatch" + | remaining + 1, anchor, .lam .many body => + match validateRecIndexWrapper remaining anchor body with + | .ok hbody => by + rw [hbody.down] + exact .ok ⟨rfl⟩ + | .error message => .error message + | _ + 1, _, .lam _ _ => + .error "indexed recursor wrapper binder mode mismatch" + | _, _, _ => .error "indexed recursor wrapper body mismatch" + +/-- Certify that a pending recursor-policy suffix contains only source drops. -/ +private def validateDropSuffix : (rest : List Erase.ArgPolicy) → + Except String + (PLift (rest = List.replicate rest.length Erase.ArgPolicy.drop)) + | [] => .ok ⟨rfl⟩ + | .drop :: rest => + match validateDropSuffix rest with + | .ok hrest => by + rw [hrest.down] + exact .ok ⟨by simp [List.replicate_succ]⟩ + | .error message => .error message + | _ :: _ => .error "indexed recursor wrapper begins before the index suffix" + +private def validateRecurSafety (muts : Array MutConst) (recIdx : UInt64) : + Except String (PLift (∀ r, muts[recIdx.toNat]? = some (.recr r) → + r.indices.toNat = 0)) := + match hm : muts[recIdx.toNat]? with + | some (.recr r) => + if hx : r.indices.toNat = 0 then + .ok ⟨by + intro r' hr + injection hr with heq + cases heq + exact hx⟩ + else .error "indexed recursive self calls are outside the proved fragment" + | none => .ok ⟨by + intro r hr + simp at hr⟩ + | some (.defn d) => .ok ⟨by + intro r hr + simp at hr⟩ + | some (.indc ind) => .ok ⟨by + intro r hr + simp at hr⟩ + +mutual + /-- Validate one source/target expression pair and construct its `PErase` + derivation. This checks the relation rather than merely reimplementing an + equality test; the return type is the soundness theorem. -/ + def validateExprWithRec (ectx : Ixon.Eval.EvalCtx) (ictx : IxIR0.Ctx) + (cover : CoverOracle ectx ictx) (recMembers : RecMemberOracle ectx ictx) + (sc : Option (Address × Nat)) (refs : Array Address) + (muts : Array MutConst) (sa : Option Address) (mask : List Bool) : + Nat → (e : Ixon.Expr) → (e' : IxIR0.Expr) → + Except String (PLift (PErase ectx ictx sc refs muts sa mask e e')) + | 0, _, _ => fail "validation fuel exhausted" + | fuel + 1, e, e' => + match validateRecSpine ectx ictx cover recMembers sc refs muts sa mask + fuel e e' with + | .ok ⟨r, [], hs⟩ => .ok ⟨.recP hs.down⟩ + | _ => + match e, e' with + | .var i, .var j => + if hij : i.toNat = j then + match hm : mask[i.toNat]? with + | some true => by + subst j + exact .ok ⟨.var hm⟩ + | _ => fail s!"variable {i.toNat} is not a kept slot" + else fail "variable index mismatch" + | .sort _, .erased => .ok ⟨.sortE⟩ + | .all _ _ _ _, .erased => .ok ⟨.allE⟩ + | .lam u dom body, .lam u' body' => + match hd : dropB u dom with + | true => + if hu : u' = .many then by + subst u' + match validateExprWithRec ectx ictx cover recMembers sc refs muts sa + (false :: mask) fuel body body' with + | .ok hb => exact .ok ⟨.lamD hd hb.down⟩ + | .error msg => exact .error msg + else fail "dropped lambda binder did not lower to many" + | false => + if hu : u' = u then by + subst u' + match validateExprWithRec ectx ictx cover recMembers sc refs muts sa + (true :: mask) fuel body body' with + | .ok hb => exact .ok ⟨.lamK hd hb.down⟩ + | .error msg => exact .error msg + else fail "kept lambda binder mode changed" + | source, .lam .many body' => + match ctorParamSpine? ectx refs (fuel + 1) source with + | some cert => + if hj : cert.consumed < cert.params then + match validateCtorWrapper + (cert.params - cert.consumed - 1) cert.address body' with + | .error message => .error message + | .ok hbody => by + rw [hbody.down] + exact match he : ictx.env cert.address with + | some (.ctor tag fields) => + if ht : cert.cidx = tag then by + subst tag + exact if hf : cert.fields = fields then by + subst fields + exact .ok ⟨.ctorW cert.spine hj he⟩ + else fail "constructor field count mismatch" + else fail "constructor tag mismatch" + | _ => fail "erased constructor declaration is missing" + else fail "constructor wrapper has no remaining parameters" + | none => fail "source is not a partial constructor parameter spine" + | .app f a, .app f' .erased => + let normal (f₀ a₀ : Ixon.Expr) (f₀' a₀' : IxIR0.Expr) : + Except String (PLift (PErase ectx ictx sc refs muts sa mask + (.app f₀ a₀) (.app f₀' a₀'))) := do + let hf ← validateExprWithRec ectx ictx cover recMembers sc refs muts sa + mask fuel f₀ f₀' + let ha ← validateExprWithRec ectx ictx cover recMembers sc refs muts sa + mask fuel a₀ a₀' + pure ⟨.app hf.down ha.down⟩ + let fallback : Except String + (PLift (PErase ectx ictx sc refs muts sa mask + (.app f a) (.app f' .erased))) := + match f with + | .lam u dom body => + match hd : dropB u dom with + | true => do + let hf ← validateExprWithRec ectx ictx cover recMembers sc refs muts sa mask + fuel (.lam u dom body) f' + pure ⟨.appE hd hf.down⟩ + | false => normal (.lam u dom body) a f' .erased + | other => normal other a f' .erased + let definitionFallback : Except String + (PLift (PErase ectx ictx sc refs muts sa mask + (.app f a) (.app f' .erased))) := + match defSpine? ectx refs (fuel + 1) f with + | some cert => + match hr : cert.residual with + | .lam uses domain body => + match hd : dropB uses domain with + | true => by + have hspine := cert.spine + rw [hr] at hspine + exact do + let hf ← validateExprWithRec ectx ictx cover recMembers sc + refs muts sa mask fuel f f' + pure ⟨.appDG hspine hd hf.down⟩ + | false => fallback + | _ => fallback + | none => fallback + match recSpine? ectx refs muts sa (fuel + 1) f with + | some ⟨r, j, hs⟩ => + match hj : (recRulePolicy r)[j]? with + | some .ghost => do + let hf ← validateExprWithRec ectx ictx cover recMembers sc refs muts sa mask + fuel f f' + pure ⟨.appG hs.down hj hf.down⟩ + | _ => definitionFallback + | none => definitionFallback + | .app f a, .app f' a' => do + let hf ← validateExprWithRec ectx ictx cover recMembers sc refs muts sa + mask fuel f f' + let ha ← validateExprWithRec ectx ictx cover recMembers sc refs muts sa + mask fuel a a' + pure ⟨.app hf.down ha.down⟩ + | .app f a, .ref a' => + match ctorParamSpine? ectx refs (fuel + 1) (.app f a) with + | some cert => + if ha : cert.address = a' then by + subst a' + exact if hp : 0 < cert.params then + if hj : cert.consumed = cert.params then + match he : ictx.env cert.address with + | some (.ctor tag fields) => + if ht : cert.cidx = tag then by + subst tag + exact if hf : cert.fields = fields then by + subst fields + have hspine := cert.spine + rw [hj] at hspine + exact .ok ⟨.ctorP hp hspine he⟩ + else fail "constructor field count mismatch" + else fail "constructor tag mismatch" + | _ => fail "erased constructor declaration is missing" + else fail "constructor parameter prefix is incomplete" + else fail "constructor drop spine has no parameters" + else fail "constructor address mismatch" + | none => fail "source is not a visible constructor parameter spine" + | source, .letE .many val' body' => + match validateRecSpine ectx ictx cover recMembers sc refs muts sa mask + fuel source val' with + | .ok ⟨r, rest, hs⟩ => + if hpositive : 0 < rest.length then + match validateDropSuffix rest with + | .error message => .error message + | .ok hrest => + match validateRecIndexWrapper rest.length rest.length body' with + | .error message => .error message + | .ok hbody => by + rw [hrest.down] at hs + rw [hbody.down] + simpa [Erase.captureThenIgnoreN] using + (.ok ⟨PErase.recW hs.down hpositive⟩ : + Except String (PLift (PErase ectx ictx sc refs muts sa + mask source + (Erase.captureThenIgnoreN rest.length val')))) + else fail "indexed recursor wrapper has no pending indices" + | .error _ => + match source with + | .letE _ _ val body => do + let hv ← validateExprWithRec ectx ictx cover recMembers sc refs + muts sa mask fuel val val' + let hb ← validateExprWithRec ectx ictx cover recMembers sc refs + muts sa (true :: mask) fuel body body' + pure ⟨.letE hv.down hb.down⟩ + | _ => fail "target let is not an indexed recursor wrapper" + | .ref idx us, .ref a' => + match hr : refs[idx.toNat]? with + | some a => + if ha : a = a' then by + subst a' + match hc : cover a with + | some cov => exact .ok ⟨.ref hr cov.down⟩ + | none => exact fail "reference lacks a Covered certificate" + else fail "reference address mismatch" + | none => fail s!"reference {idx.toNat} is out of range" + | .recur recIdx us, .ref member => + match sa with + | some block => + if hmember : member = + Erase.memberAddr block recIdx.toNat then by + subst member + exact match hm : Ixon.Eval.resolveMut ectx block + recIdx.toNat with + | .ok (bc, .defn d) => + if hrefs : refs = bc.refs then + if hmuts : muts = Ixon.selfMutsOf bc.info then + match hu : Ixon.Eval.unfoldable d with + | true => + if hplan : (⟨block, recIdx.toNat⟩ : MemberKey) ∈ + scope.plan then + .ok ⟨.recurD rfl hm hrefs hmuts hu hplan⟩ + else fail + "definition member is absent from the simultaneous plan" + | false => + match hconfigured : ectx.externArity + (Erase.memberAddr block recIdx.toNat) with + | none => fail + "opaque definition member extern is not configured" + | some arity => + if hplan : (⟨block, recIdx.toNat⟩ : MemberKey) ∈ + scope.plan then + .ok ⟨.recurO rfl hm hrefs hmuts hu hconfigured hplan⟩ + else fail + "opaque definition member is absent from the simultaneous plan" + else fail "definition-member frame table mismatch" + else fail "definition-member refs mismatch" + | .ok (bc, .recr r) => + if hrefs : refs = bc.refs then + if hmuts : muts = Ixon.selfMutsOf bc.info then + if hi : r.indices.toNat = 0 then + if hplan : (⟨block, recIdx.toNat⟩ : MemberKey) ∈ + scope.plan then + .ok ⟨.recurR rfl hm hrefs hmuts hi hplan⟩ + else fail + "recursor member is absent from the simultaneous plan" + else fail + "indexed recursor member requires protected-spine validation" + else fail "recursor-member frame table mismatch" + else fail "recursor-member refs mismatch" + | .ok (bc, .indc ind) => + if hrefs : refs = bc.refs then + match hi : muts[recIdx.toNat]? with + | some (.indc frameInd) => + if hind : frameInd = ind then by + subst frameInd + exact match he : ictx.env + (Erase.memberAddr block recIdx.toNat) with + | some (.defn .shared .erased) => + .ok ⟨.recurI rfl hm hrefs hi he⟩ + | _ => fail "erased inductive member is missing" + else fail "non-self recur mutual member mismatch" + | _ => fail + "non-self recur does not target an inductive member" + else fail "non-self recur refs mismatch" + | .error _ => fail "non-self recur member is unresolved" + else fail "non-self recur member address mismatch" + | none => fail "non-self recur is outside a mutual block" + | .recur recIdx us, .var j => + match sc with + | some (block, idx) => + if hi : recIdx.toNat = idx then + if hj : mask.length = j then by + subst j + match validateRecurSafety muts recIdx with + | .ok hs => exact .ok ⟨.recurS hi hs.down⟩ + | .error msg => exact .error msg + else fail "recursor-self slot mismatch" + else fail "recursor-self member mismatch" + | none => fail "non-self recur is outside the proved fragment" + | .nat idx, .lit (.nat n') => + match hr : refs[idx.toNat]? with + | some a => + match hb : ectx.blobs a with + | some (.natB n) => + if hn : n = n' then by + subst n' + exact .ok ⟨.natE hr hb⟩ + else fail "nat literal value mismatch" + | _ => fail "nat literal blob mismatch" + | none => fail s!"nat literal ref {idx.toNat} is out of range" + | .str idx, .lit (.str s') => + match hr : refs[idx.toNat]? with + | some a => + match hb : ectx.blobs a with + | some (.strB s) => + if hs : s = s' then by + subst s' + exact .ok ⟨.strE hr hb⟩ + else fail "string literal value mismatch" + | _ => fail "string literal blob mismatch" + | none => fail s!"string literal ref {idx.toNat} is out of range" + | .prj _ fieldIdx val, .proj fieldIdx' val' => + if hi : fieldIdx.toNat = fieldIdx' then by + subst fieldIdx' + match validateExprWithRec ectx ictx cover recMembers sc refs muts sa mask + fuel val val' with + | .ok hv => exact .ok ⟨.prjE hv.down⟩ + | .error msg => exact .error msg + else fail "projection field mismatch" + | .share _, _ => + fail "raw shares require sharing-aware inlining before PErase validation" + | _, _ => fail "source and target erasure shapes do not match" + + /-- Reconstruct the exact visible prefix of an indexed recursor. A `drop` + step consumes only the source argument; `keep` and `ghost` steps follow the + target application spine. -/ + def validateRecSpine (ectx : Ixon.Eval.EvalCtx) (ictx : IxIR0.Ctx) + (cover : CoverOracle ectx ictx) (recMembers : RecMemberOracle ectx ictx) + (sc : Option (Address × Nat)) (refs : Array Address) + (muts : Array MutConst) (sa : Option Address) (mask : List Bool) : + Nat → (e : Ixon.Expr) → (e' : IxIR0.Expr) → + Except String (Σ r : Recursor, Σ rest : List Erase.ArgPolicy, + PLift (RecEraseSpine ectx ictx sc refs muts sa mask e e' r rest)) + | 0, _, _ => .error "indexed recursor-spine validation fuel exhausted" + | fuel + 1, e, e' => + match e with + | .ref refIdx univIdxs => + match e' with + | .ref a' => + match hr : refs[refIdx.toNat]? with + | some a => + if ha : a = a' then + match hc : ectx.resolve a with + | some c => + match hi : c.info with + | .rPrj p => + match hm : Ixon.Eval.resolveMut ectx p.block p.idx.toNat with + | .ok (bc, .recr r) => + if hx : 0 < r.indices.toNat then + match hd : ictx.env a with + | some (.defn .shared (.ref member)) => + if hmember : member = + Erase.memberAddr p.block p.idx.toNat then + match ho : recMembers p.block p.idx.toNat bc r hm with + | some hrec => by + subst a' + subst member + exact .ok ⟨r, recPolicy r, + ⟨.head hr hc hi hm hx hd hrec.down⟩⟩ + | none => + .error + "indexed recursor member lacks a certificate" + else .error + "indexed recursor projection points at the wrong member" + | _ => .error + "indexed recursor projection declaration is missing" + else .error "recursor has no source-only indices" + | _ => .error + "recursor projection does not resolve to a recursor" + | _ => .error + "source reference is not a recursor projection" + | none => .error "recursor projection address is unresolved" + else .error "indexed recursor projection address mismatch" + | none => .error "indexed recursor source reference is out of range" + | _ => .error "indexed recursor head did not erase to a reference" + | .recur recIdx univIdxs => + match e' with + | .var targetIndex => + match sc with + | some (block, idx) => + if hself : recIdx.toNat = idx then + if hslot : mask.length = targetIndex then by + subst targetIndex + exact if hsa : sa = some block then + match hm : Ixon.Eval.resolveMut ectx block idx with + | .ok (bc, .recr r) => + if hx : 0 < r.indices.toNat then + if hrefs : refs = bc.refs then + match hlookup : muts[recIdx.toNat]? with + | some (.recr selfR) => + if hrecur : selfR = r then by + subst selfR + exact .ok ⟨r, recPolicy r, + ⟨.selfHead rfl hsa hself hm hrefs hlookup hx⟩⟩ + else .error + "indexed recursive self recursor mismatch" + | _ => .error + "indexed recursive self mutual slot mismatch" + else .error "indexed recursive self refs mismatch" + else .error "recursive self has no source-only indices" + | _ => .error "indexed recursive self does not resolve" + else .error "indexed recursive self block mismatch" + else .error "indexed recursive self slot mismatch" + else .error "indexed recursive self member mismatch" + | none => .error "indexed recursive self lacks a self context" + | .ref member => + match sa with + | some block => + if hmember : member = + Erase.memberAddr block recIdx.toNat then by + subst member + exact match hm : Ixon.Eval.resolveMut ectx block + recIdx.toNat with + | .ok (bc, .recr r) => + if hx : 0 < r.indices.toNat then + if hrefs : refs = bc.refs then + if hmuts : muts = Ixon.selfMutsOf bc.info then + if hplan : (⟨block, recIdx.toNat⟩ : MemberKey) ∈ + scope.plan then + .ok ⟨r, recPolicy r, + ⟨.memberHead rfl hm hrefs hmuts hx hplan⟩⟩ + else .error + "indexed recursor is absent from the simultaneous plan" + else .error "indexed recursor frame table mismatch" + else .error "indexed recursor refs mismatch" + else .error "recursor has no source-only indices" + | _ => .error "mutual member is not an indexed recursor" + else .error "indexed mutual recursor member address mismatch" + | none => .error "indexed mutual recursor is outside a block" + | _ => .error "indexed recursive self head did not erase to its slot" + | .app f a => + match validateRecSpine ectx ictx cover recMembers sc refs muts sa mask + fuel f e' with + | .ok ⟨r, .drop :: rest, hs⟩ => + .ok ⟨r, rest, ⟨.drop hs.down⟩⟩ + | _ => + match e' with + | .app f' a' => + match validateRecSpine ectx ictx cover recMembers sc refs muts sa + mask fuel f f' with + | .ok ⟨r, .keep :: rest, hs⟩ => + match validateExprWithRec ectx ictx cover recMembers sc refs muts + sa mask fuel a a' with + | .ok ha => .ok ⟨r, rest, ⟨.keep hs.down ha.down⟩⟩ + | .error msg => .error msg + | .ok ⟨r, .ghost :: rest, hs⟩ => + match a' with + | .erased => .ok ⟨r, rest, ⟨.ghost hs.down⟩⟩ + | _ => .error "recursor ghost argument is not erased" + | .ok ⟨_, .drop :: _, _⟩ => + .error "recursor drop unexpectedly emitted a target argument" + | .ok ⟨_, [], _⟩ => + .error "recursor spine extends past the pre-major policy" + | .error msg => .error msg + | _ => .error "recursor keep/ghost step lacks a target application" + | _ => .error "source is not a visible indexed recursor spine" +end + +/-- Backward-compatible index-free validator entry point. -/ +def validateExpr (ectx : Ixon.Eval.EvalCtx) (ictx : IxIR0.Ctx) + (cover : CoverOracle ectx ictx) + (sc : Option (Address × Nat)) (refs : Array Address) + (muts : Array MutConst) (sa : Option Address) (mask : List Bool) + (fuel : Nat) (e : Ixon.Expr) (e' : IxIR0.Expr) : + Except String (PLift (PErase ectx ictx sc refs muts sa mask e e')) := + validateExprWithRec ectx ictx cover noRecMembers sc refs muts sa mask + fuel e e' + +/-- Extract the relation proof from a successful validation. Concrete +programs normally discharge `h` by reduction (`rfl`/`decide`), replacing a +hand-written `PErase` constructor tree with one checked computation. -/ +theorem related_of_validateExprWithRec + {ectx : Ixon.Eval.EvalCtx} {ictx : IxIR0.Ctx} + {cover : CoverOracle ectx ictx} + {recMembers : RecMemberOracle ectx ictx} + {sc : Option (Address × Nat)} {refs : Array Address} + {muts : Array MutConst} {sa : Option Address} + {mask : List Bool} {fuel : Nat} {e : Ixon.Expr} {e' : IxIR0.Expr} + (h : (validateExprWithRec ectx ictx cover recMembers sc refs muts sa + mask fuel e e').toOption.isSome) : + PErase ectx ictx sc refs muts sa mask e e' := + ((validateExprWithRec ectx ictx cover recMembers sc refs muts sa mask + fuel e e').toOption.get h).down + +theorem related_of_validateExpr + {ectx : Ixon.Eval.EvalCtx} {ictx : IxIR0.Ctx} + {cover : CoverOracle ectx ictx} {sc : Option (Address × Nat)} + {refs : Array Address} {muts : Array MutConst} {sa : Option Address} + {mask : List Bool} {fuel : Nat} {e : Ixon.Expr} {e' : IxIR0.Expr} + (h : (validateExpr ectx ictx cover sc refs muts sa mask fuel e e').toOption.isSome) : + PErase ectx ictx sc refs muts sa mask e e' := + ((validateExpr ectx ictx cover sc refs muts sa mask fuel e e').toOption.get h).down + +/-! ## Program coverage validation + +Expression validation consumes `Covered` facts. The finite database and +validators below construct those facts from the source resolver and target +environment. Dependencies are supplied in topological order; this is an +explicit certificate schedule, not trusted graph analysis. -/ + +structure CoveredEntry (ectx : Ixon.Eval.EvalCtx) (ictx : IxIR0.Ctx) where + address : Address + covered : Covered ectx ictx address + +abbrev CoverageDB (ectx : Ixon.Eval.EvalCtx) (ictx : IxIR0.Ctx) := + List (CoveredEntry ectx ictx) + +def CoverageDB.lookup {ectx : Ixon.Eval.EvalCtx} {ictx : IxIR0.Ctx} : + CoverageDB ectx ictx → (a : Address) → Option (PLift (Covered ectx ictx a)) + | [], _ => none + | entry :: rest, a => + if h : entry.address = a then + some ⟨by cases h; exact entry.covered⟩ + else lookup rest a + +def CoverageDB.oracle {ectx : Ixon.Eval.EvalCtx} {ictx : IxIR0.Ctx} + (db : CoverageDB ectx ictx) : CoverOracle ectx ictx := + db.lookup + +/-- Validate the finite mutual-block parameter layout stored by `RecMember`. +Only inductive members constrain the common count. -/ +def validateBlockParams (params : Nat) : + (members : List MutConst) → + Except String (PLift (BlockParams params members)) + | [] => .ok ⟨.nil⟩ + | .defn _ :: rest => do + let hrest ← validateBlockParams params rest + pure ⟨.defn hrest.down⟩ + | .recr _ :: rest => do + let hrest ← validateBlockParams params rest + pure ⟨.recr hrest.down⟩ + | .indc ind :: rest => + if hp : ind.params.toNat = params then do + let hrest ← validateBlockParams params rest + pure ⟨.indc hp hrest.down⟩ + else fail "mutual-block inductive parameter count disagrees with recursor" + +/-- Validate corresponding recursor rules, including each peeled body. -/ +def validateRules (ectx : Ixon.Eval.EvalCtx) (ictx : IxIR0.Ctx) + (db : CoverageDB ectx ictx) (block : Address) (idx : Nat) + (r : Recursor) (refs : Array Address) (muts : Array MutConst) : + Nat → (rules : List RecursorRule) → (trules : List IxIR0.RecRule) → + Except String (PLift + (RulesRel ectx ictx block idx r refs muts rules trules)) + | 0, _, _ => fail "rule validation fuel exhausted" + | _ + 1, [], [] => .ok ⟨.nil⟩ + | fuel + 1, rule :: rest, trule :: trest => + if hf : trule.fields = rule.fields.toNat then + match hp : peelChain + (r.params.toNat + r.motives.toNat + r.minors.toNat + + rule.fields.toNat) + rule.rhs with + | some body => do + let hb ← validateExpr ectx ictx db.oracle (some (block, idx)) + refs muts (some block) + (recRuleMask r rule.fields.toNat) + fuel body trule.rhs + let hr ← validateRules ectx ictx db block idx r refs muts + fuel rest trest + pure ⟨.cons hf hp hb.down hr.down⟩ + | none => fail "recursor rule is not a literal lambda chain" + else fail "recursor rule field count mismatch" + | _ + 1, _, _ => fail "recursor rule list length mismatch" + +/-- Validate the member-level declaration and rules for one recursor. -/ +def validateRecMember (ectx : Ixon.Eval.EvalCtx) (ictx : IxIR0.Ctx) + (db : CoverageDB ectx ictx) (block : Address) (idx : Nat) + (bc : Constant) (r : Recursor) + (hm : Ixon.Eval.resolveMut ectx block idx = .ok (bc, .recr r)) + (fuel : Nat) : Except String (PLift (RecMember ectx ictx block idx r)) := + match validateBlockParams r.params.toNat + (Ixon.selfMutsOf bc.info).toList with + | .error msg => .error msg + | .ok hparams => + match he : ictx.env (Erase.memberAddr block idx) with + | some (.recursor n natLit trules) => + if hn : n = r.params.toNat + r.motives.toNat + + r.minors.toNat then + if hl : natLit = (ectx.natBlock == some block) then + match validateRules ectx ictx db block idx r bc.refs + (Ixon.selfMutsOf bc.info) fuel r.rules.toList + trules.toList with + | .ok hrs => by + subst n + subst natLit + exact .ok ⟨.mk hm hparams.down he hrs.down⟩ + | .error msg => .error msg + else fail "recursor natLit identity mismatch" + else fail "recursor erased arity mismatch" + | _ => fail "erased recursor member declaration is missing" + +/-- Extract a member certificate from one successful checked computation. -/ +theorem recMember_of_validate + {ectx : Ixon.Eval.EvalCtx} {ictx : IxIR0.Ctx} + {db : CoverageDB ectx ictx} {block : Address} {idx : Nat} + {bc : Constant} {r : Recursor} + {hm : Ixon.Eval.resolveMut ectx block idx = .ok (bc, .recr r)} + {fuel : Nat} + (h : (validateRecMember ectx ictx db block idx bc r hm fuel).toOption.isSome) : + RecMember ectx ictx block idx r := + ((validateRecMember ectx ictx db block idx bc r hm fuel).toOption.get h).down + +/-- Validate one address against the source resolver and erased target +environment, constructing the corresponding `Covered` proof. -/ +def validateCovered (ectx : Ixon.Eval.EvalCtx) (ictx : IxIR0.Ctx) + (db : CoverageDB ectx ictx) (fuel : Nat) (a : Address) : + Except String (PLift (Covered ectx ictx a)) := + match fuel with + | 0 => fail "coverage validation fuel exhausted" + | fuel + 1 => + match hc : ectx.resolve a with + | none => fail "coverage address is absent from the source resolver" + | some c => + match hi : c.info with + | .defn d => + match hu : Ixon.Eval.unfoldable d with + | true => + match he : ictx.env a with + | some (.defn result body') => do + let hresult ← validateTeleResultOwned c.sharing fuel d.typ + if heq : result = hresult.1.getD .shared then + let hb ← validateExpr ectx ictx db.oracle none c.refs + (Ixon.selfMutsOf c.info) none [] fuel d.value body' + let howned : DefinitionResultOwned c.sharing d.typ result := + ⟨hresult.1, hresult.2.down, heq⟩ + pure ⟨.defn hc hi hu he howned hb.down⟩ + else fail "definition result ownership mismatch" + | _ => fail "erased definition is missing" + | false => + match hconfigured : ectx.externArity a with + | none => fail "extern address is not configured" + | some arity => + match he : ictx.env a with + | some (.extern targetArity) => + if harity : targetArity = arity then by + subst targetArity + exact .ok ⟨.externDefn hc hi hu hconfigured he⟩ + else fail "configured extern arity mismatch" + | _ => fail "erased extern declaration is missing" + | .axio ax => + match hconfigured : ectx.externArity a with + | none => fail "extern address is not configured" + | some arity => + match he : ictx.env a with + | some (.extern targetArity) => + if harity : targetArity = arity then by + subst targetArity + exact .ok ⟨.externAxio hc hi hconfigured he⟩ + else fail "configured extern arity mismatch" + | _ => fail "erased extern declaration is missing" + | .cPrj p => + match hm : Ixon.Eval.resolveMut ectx p.block p.idx.toNat with + | .ok (bc, .indc ind) => + match ht : ind.ctors[p.cidx.toNat]? with + | some ct => + if hip : ind.params.toNat = 0 then + if hcp : ct.params.toNat = 0 then + match he : ictx.env a with + | some (.ctor tag fields) => + if htag : p.cidx.toNat = tag then + if hfields : ct.fields.toNat = fields then by + subst tag + subst fields + let shape : CtorShape ectx p.block p.idx.toNat + p.cidx.toNat 0 ct.fields.toNat := + ⟨bc, ind, ct, hm, ht, hip, hcp, rfl⟩ + exact .ok ⟨.ctor hc hi shape he⟩ + else fail "constructor field count mismatch" + else fail "constructor tag mismatch" + | _ => fail "erased constructor declaration is missing" + else fail "bare parameterized constructor heads are outside Covered" + else fail "inductive parameters are outside the current simulation fragment" + | none => fail "constructor projection is out of range" + | _ => fail "constructor projection does not resolve to an inductive" + | .iPrj p => + match he : ictx.env a with + | some (.defn .shared .erased) => .ok ⟨.tyf hc hi he⟩ + | _ => fail "erased inductive-type projection is missing" + | .quot q => + match hconfigured : ectx.quotientKind a with + | none => fail "quotient address is not configured" + | some kind => + if hkind : kind = q.kind then by + subst kind + exact match he : ictx.env a with + | some (.defn result body) => + match validateQuotientBody q.kind body with + | .error msg => .error msg + | .ok hbody => by + rw [hbody.down] at he + exact do + let hresult ← validateTeleResultOwned c.sharing fuel q.typ + if heq : result = hresult.1.getD .shared then + let howned : DefinitionResultOwned c.sharing q.typ result := + ⟨hresult.1, hresult.2.down, heq⟩ + pure ⟨.quot hc hi hconfigured he howned⟩ + else fail "quotient result ownership mismatch" + | _ => fail "erased quotient declaration is missing" + else fail "configured quotient kind mismatch" + | .dPrj p => + match hm : Ixon.Eval.resolveMut ectx p.block p.idx.toNat with + | .ok (bc, .defn d) => + match hu : Ixon.Eval.unfoldable d with + | true => + match ha : ictx.env a with + | some (.defn aliasResult (.ref member)) => + if hmember : member = + Erase.memberAddr p.block p.idx.toNat then by + subst member + exact match he : ictx.env + (Erase.memberAddr p.block p.idx.toNat) with + | some (.defn result body') => + if hresult : aliasResult = result then + match ho : validateTeleResultOwned bc.sharing fuel d.typ with + | .error message => .error message + | .ok ⟨candidate, howned⟩ => + if heq : result = candidate.getD .shared then + match hb : validateExpr ectx ictx db.oracle none bc.refs + (Ixon.selfMutsOf bc.info) (some p.block) [] + fuel d.value body' with + | .error message => .error message + | .ok hbody => by + have halias : ictx.env a = some (.defn result + (.ref (Erase.memberAddr p.block + p.idx.toNat))) := by + simpa [hresult] using ha + exact .ok ⟨Covered.defnProj hc hi hm hu halias he + ⟨candidate, howned.down, heq⟩ hbody.down⟩ + else fail + "definition-projection result ownership mismatch" + else fail "definition-projection alias ownership mismatch" + | _ => fail "erased definition member is missing" + else fail "definition projection points at the wrong member" + | _ => fail "erased definition projection is missing" + | false => + match ha : ictx.env a with + | some (.defn aliasResult (.ref member)) => + if hmember : member = + Erase.memberAddr p.block p.idx.toNat then by + subst member + exact match hconfigured : ectx.externArity + (Erase.memberAddr p.block p.idx.toNat) with + | none => fail + "opaque definition member extern is not configured" + | some arity => + match he : ictx.env + (Erase.memberAddr p.block p.idx.toNat) with + | some (.extern targetArity) => + if harity : targetArity = arity then by + subst targetArity + exact match ho : validateTeleResultOwned bc.sharing fuel + d.typ with + | .error message => .error message + | .ok ⟨candidate, howned⟩ => + if heq : aliasResult = candidate.getD .shared then + let hresult : DefinitionResultOwned bc.sharing d.typ + aliasResult := ⟨candidate, howned.down, heq⟩ + .ok ⟨Covered.externDefnProj hc hi hm hu hconfigured + ha he hresult⟩ + else fail + "definition-projection result ownership mismatch" + else fail "opaque definition member extern arity mismatch" + | _ => fail "erased opaque definition member extern is missing" + else fail "definition projection points at the wrong member" + | _ => fail "erased opaque definition projection is missing" + | _ => fail "definition projection does not resolve to a definition" + | .rPrj p => + match hm : Ixon.Eval.resolveMut ectx p.block p.idx.toNat with + | .ok (bc, .recr r) => + if hx : r.indices.toNat = 0 then + match he : ictx.env a with + | some (.defn .shared (.ref member)) => + if ha : member = Erase.memberAddr p.block p.idx.toNat then by + subst member + match validateRecMember ectx ictx db p.block p.idx.toNat + bc r hm fuel with + | .ok hr => exact .ok ⟨.recrP hc hi hm hx he hr.down⟩ + | .error msg => exact .error msg + else fail "recursor projection points at the wrong member" + | _ => fail "erased recursor projection is missing" + else fail "bare indexed recursor projections are outside Covered" + | _ => fail "recursor projection does not resolve to a recursor" + | _ => fail "constant kind is outside the current Covered fragment" + +/-- Check a dependency-ordered address plan, extending the proof database +after each successful entry. -/ +def validateCoveragePlan (ectx : Ixon.Eval.EvalCtx) (ictx : IxIR0.Ctx) : + Nat → CoverageDB ectx ictx → List Address → + Except String (CoverageDB ectx ictx) + | 0, _, _ => .error "coverage-plan validation fuel exhausted" + | _ + 1, db, [] => .ok db + | fuel + 1, db, a :: rest => do + let ha ← validateCovered ectx ictx db fuel a + validateCoveragePlan ectx ictx fuel + ({ address := a, covered := ha.down } :: db) rest + +/-- Extract a `Covered` proof from one successful checked computation. -/ +theorem covered_of_validate + {ectx : Ixon.Eval.EvalCtx} {ictx : IxIR0.Ctx} + {db : CoverageDB ectx ictx} {fuel : Nat} {a : Address} + (h : (validateCovered ectx ictx db fuel a).toOption.isSome) : + Covered ectx ictx a := + ((validateCovered ectx ictx db fuel a).toOption.get h).down + +/-- Validate one entry of a simultaneous mutual-member plan. The expression +and rule bodies are checked against the already completed public coverage +database, but recursive member edges close through `scope.plan` rather than +recursing in the validator. -/ +def validateMemberRel (ectx : Ixon.Eval.EvalCtx) (ictx : IxIR0.Ctx) + (db : CoverageDB ectx ictx) : + Nat → (key : MemberKey) → + Except String (PLift (MemberRel ectx ictx key)) + | 0, _ => fail "member validation fuel exhausted" + | fuel + 1, ⟨block, idx⟩ => + match hm : Ixon.Eval.resolveMut ectx block idx with + | .ok (bc, .defn d) => + match hu : Ixon.Eval.unfoldable d with + | false => + match hconfigured : ectx.externArity + (Erase.memberAddr block idx) with + | none => fail "opaque definition member extern is not configured" + | some arity => + match he : ictx.env (Erase.memberAddr block idx) with + | some (.extern targetArity) => + if harity : targetArity = arity then by + subst targetArity + exact .ok ⟨MemberRel.externDefn hm hu hconfigured he⟩ + else fail "opaque definition member extern arity mismatch" + | _ => fail "erased opaque definition member extern is missing" + | true => + match he : ictx.env (Erase.memberAddr block idx) with + | some (.defn result body') => do + let hresult ← validateTeleResultOwned bc.sharing fuel d.typ + if heq : result = hresult.1.getD .shared then + let hbody ← validateExpr ectx ictx db.oracle none bc.refs + (Ixon.selfMutsOf bc.info) (some block) [] fuel d.value body' + let howned : DefinitionResultOwned bc.sharing d.typ result := + ⟨hresult.1, hresult.2.down, heq⟩ + pure ⟨MemberRel.defn hm hu he howned hbody.down⟩ + else fail "mutual-definition result ownership mismatch" + | _ => fail "erased mutual-definition member is missing" + | .ok (bc, .recr r) => do + let hmember ← validateRecMember ectx ictx db block idx bc r hm fuel + pure ⟨MemberRel.recr hmember.down⟩ + | .ok (_, .indc _) => + fail "inductive members do not require simultaneous body coverage" + | .error _ => fail "simultaneous member is unresolved" + +/-- Close every open member edge with one finite certificate. -/ +def validateMemberCoverage (ectx : Ixon.Eval.EvalCtx) (ictx : IxIR0.Ctx) + (db : CoverageDB ectx ictx) : + Nat → (keys : List MemberKey) → + Except String (PLift (MemberCoverage ectx ictx keys)) + | 0, _ => fail "member-plan validation fuel exhausted" + | _ + 1, [] => + if hneutral : ectx.preserveNeutralElims = false then + if hstrings : ectx.stringLiteral = none then + .ok ⟨.nil ⟨hneutral, hstrings⟩⟩ + else + fail "certified erasure requires String-literal expansion disabled" + else + fail "certified erasure requires strict neutral-elimination mode" + | fuel + 1, key :: rest => do + let hkey ← validateMemberRel ectx ictx db fuel key + let hrest ← validateMemberCoverage ectx ictx db fuel rest + pure ⟨.cons hkey.down hrest.down⟩ + +/-- Extract simultaneous coverage from a successful checked computation. -/ +theorem memberCoverage_of_validate + {ectx : Ixon.Eval.EvalCtx} {ictx : IxIR0.Ctx} + {db : CoverageDB ectx ictx} {fuel : Nat} {keys : List MemberKey} + (h : (validateMemberCoverage ectx ictx db fuel keys).toOption.isSome) : + MemberCoverage ectx ictx keys := + ((validateMemberCoverage ectx ictx db fuel keys).toOption.get h).down + +inductive CertErr where + | erase (err : Erase.EraseErr) + | relation (msg : String) + deriving BEq, Repr + +/-- A whole executable-erasure result plus a database of `Covered` proofs +checked against the target environment built from that exact result. -/ +structure CertifiedProgram (ectx : Ixon.Eval.EvalCtx) + (consts : List (Address × Constant)) (eraseFuel : Nat) where + target : List (Address × IxIR0.Decl) + erased : Erase.eraseProgram (eraseCtxOf ectx) consts eraseFuel = .ok target + coverage : CoverageDB ectx { env := IxIR0.Env.ofList target } + members : MemberCoverage ectx { env := IxIR0.Env.ofList target } scope.plan + +/-- Run the real program eraser and validate a dependency-ordered list of +addresses against its exact output. The returned database is a reusable +`CoverOracle` for certifying entry expressions. -/ +def certifyProgram (ectx : Ixon.Eval.EvalCtx) + (consts : List (Address × Constant)) (coverageOrder : List Address) + (eraseFuel : Nat := Erase.defaultFuel) + (validateFuel : Nat := Erase.defaultFuel) : + Except CertErr (CertifiedProgram ectx consts eraseFuel) := + match he : Erase.eraseProgram (eraseCtxOf ectx) consts eraseFuel with + | .error err => .error (.erase err) + | .ok target => + let targetIndex := IxIR0.Env.Index.ofList target + let ictx : IxIR0.Ctx := { env := targetIndex.toEnv } + match validateCoveragePlan ectx ictx validateFuel [] coverageOrder with + | .error msg => .error (.relation msg) + | .ok coverage => + match validateMemberCoverage ectx ictx coverage validateFuel + scope.plan with + | .error msg => .error (.relation msg) + | .ok members => + have hictx : ictx = { env := IxIR0.Env.ofList target } := by + simp [ictx, targetIndex] + .ok ⟨target, he, hictx ▸ coverage, hictx ▸ members.down⟩ + +end MemberScoped + +/-- A real erasure of the original shared program, paired with coverage facts +for the semantically inlined resolver. The target environment is shared by +both facts, so no unproved eraser/inliner equality is assumed. -/ +structure CertifiedSharedProgram (ectx : Ixon.Eval.EvalCtx) + (consts : List (Address × Constant)) (eraseFuel : Nat) + [scope : MemberScope] where + target : List (Address × IxIR0.Decl) + erased : Erase.eraseProgram (eraseCtxOf ectx) consts eraseFuel = .ok target + coverage : CoverageDB ectx.inlineSharing + { env := IxIR0.Env.ofList target } + members : MemberCoverage ectx.inlineSharing + { env := IxIR0.Env.ofList target } scope.plan + +/-- Run the executable eraser on the original shared constants, then validate +its exact output against fully inlined constants obtained through the source +resolver. Success produces the `Covered` database needed by sharing-aware +entry-expression certificates. -/ +def certifySharedProgram [scope : MemberScope] + (ectx : Ixon.Eval.EvalCtx) + (consts : List (Address × Constant)) (coverageOrder : List Address) + (eraseFuel : Nat := Erase.defaultFuel) + (validateFuel : Nat := Erase.defaultFuel) : + Except CertErr (CertifiedSharedProgram ectx consts eraseFuel) := + match he : Erase.eraseProgram (eraseCtxOf ectx) consts eraseFuel with + | .error err => .error (.erase err) + | .ok target => + let targetIndex := IxIR0.Env.Index.ofList target + let ictx : IxIR0.Ctx := { env := targetIndex.toEnv } + match validateCoveragePlan ectx.inlineSharing ictx validateFuel [] + coverageOrder with + | .error msg => .error (.relation msg) + | .ok coverage => + match validateMemberCoverage ectx.inlineSharing ictx coverage + validateFuel scope.plan with + | .error msg => .error (.relation msg) + | .ok members => + have hictx : ictx = { env := IxIR0.Env.ofList target } := by + simp [ictx, targetIndex] + .ok ⟨target, he, hictx ▸ coverage, hictx ▸ members.down⟩ + +section MemberScopedExpr + +variable [scope : MemberScope] + +/-- An executable result and its relational proof, tied to exactly the same +source expression, tables, mask, and eraser invocation. -/ +structure CertifiedExpr (ectx : Ixon.Eval.EvalCtx) (ictx : IxIR0.Ctx) + (sc : Option (Address × Nat)) (T : Erase.ETables) (sa : Option Address) + (mask : List Bool) (eraseFuel : Nat) (source : Ixon.Expr) where + target : IxIR0.Expr + erased : Erase.eraseExpr (eraseCtxOf ectx) eraseFuel T mask source = .ok target + related : PErase ectx ictx sc T.refs T.selfMuts sa mask source target + +/-- Run the real executable eraser, then validate its exact result, with +member certificates available for projection-headed indexed recursor spines. -/ +def certifyExprWithRec (ectx : Ixon.Eval.EvalCtx) (ictx : IxIR0.Ctx) + (cover : CoverOracle ectx ictx) (recMembers : RecMemberOracle ectx ictx) + (sc : Option (Address × Nat)) (T : Erase.ETables) (sa : Option Address) + (mask : List Bool) (source : Ixon.Expr) + (eraseFuel : Nat := Erase.defaultFuel) + (validateFuel : Nat := Erase.defaultFuel) : + Except CertErr (CertifiedExpr ectx ictx sc T sa mask eraseFuel source) := + match he : Erase.eraseExpr (eraseCtxOf ectx) eraseFuel T mask source with + | .error err => .error (.erase err) + | .ok target => + match validateExprWithRec ectx ictx cover recMembers sc T.refs T.selfMuts + sa mask validateFuel source target with + | .error msg => .error (.relation msg) + | .ok related => .ok ⟨target, he, related.down⟩ + +/-- Index-free compatibility wrapper for existing entry certificates. -/ +def certifyExpr (ectx : Ixon.Eval.EvalCtx) (ictx : IxIR0.Ctx) + (cover : CoverOracle ectx ictx) + (sc : Option (Address × Nat)) (T : Erase.ETables) (sa : Option Address) + (mask : List Bool) (source : Ixon.Expr) + (eraseFuel : Nat := Erase.defaultFuel) + (validateFuel : Nat := Erase.defaultFuel) : + Except CertErr (CertifiedExpr ectx ictx sc T sa mask eraseFuel source) := + certifyExprWithRec ectx ictx cover noRecMembers sc T sa mask source + eraseFuel validateFuel + +end MemberScopedExpr + +/-- An executable erasure of an original shared expression and a `PErase` +proof for the fully inlined expression, both tied to the exact same target. -/ +structure CertifiedSharedExpr (ectx : Ixon.Eval.EvalCtx) + (ictx : IxIR0.Ctx) (sc : Option (Address × Nat)) + (T : Erase.ETables) (sa : Option Address) (mask : List Bool) + (eraseFuel : Nat) (source : Ixon.Expr) [scope : MemberScope] where + target : IxIR0.Expr + erased : Erase.eraseExpr (eraseCtxOf ectx) eraseFuel T mask source = + .ok target + related : PErase ectx.inlineSharing ictx sc (inlineTables T).refs + (inlineTables T).selfMuts sa mask + (Ixon.Sharing.inlineExpr T.sharing source) target + +/-- Run the real eraser before inlining, then validate its exact output against +the fully inlined expression and resolver. This is the executable bridge to +`Sim.erasure_sim_inlineSharing`; malformed sharing still fails either erasure +or relation validation. -/ +def certifySharedExpr [scope : MemberScope] + (ectx : Ixon.Eval.EvalCtx) (ictx : IxIR0.Ctx) + (cover : CoverOracle ectx.inlineSharing ictx) + (sc : Option (Address × Nat)) (T : Erase.ETables) + (sa : Option Address) (mask : List Bool) (source : Ixon.Expr) + (eraseFuel : Nat := Erase.defaultFuel) + (validateFuel : Nat := Erase.defaultFuel) : + Except CertErr + (CertifiedSharedExpr ectx ictx sc T sa mask eraseFuel source) := + match he : Erase.eraseExpr (eraseCtxOf ectx) eraseFuel T mask source with + | .error err => .error (.erase err) + | .ok target => + match validateExpr ectx.inlineSharing ictx cover sc + (inlineTables T).refs (inlineTables T).selfMuts sa mask validateFuel + (Ixon.Sharing.inlineExpr T.sharing source) target with + | .error msg => .error (.relation msg) + | .ok related => .ok ⟨target, he, related.down⟩ + +/-- Closed-frame specialization of `certifySharedExpr`. Its result indexes +the relation by exactly the normalized frame consumed by the semantic +composition theorem. -/ +def certifySharedClosedExpr [scope : MemberScope] + (ectx : Ixon.Eval.EvalCtx) + (ictx : IxIR0.Ctx) (cover : CoverOracle ectx.inlineSharing ictx) + (F : Ixon.Eval.Frame) (source : Ixon.Expr) + (eraseFuel : Nat := Erase.defaultFuel) + (validateFuel : Nat := Erase.defaultFuel) : + Except CertErr (CertifiedSharedExpr ectx ictx none (tablesOfFrame F) + F.selfAddr [] eraseFuel source) := + certifySharedExpr ectx ictx cover none (tablesOfFrame F) F.selfAddr [] + source eraseFuel validateFuel + +/-- A successful closed sharing-aware expression certificate plugs directly +into the composed semantic theorem. The conclusion refers to the certificate's +exact executable target, not a separately reconstructed expression. -/ +theorem CertifiedSharedExpr.simulatesClosed + {ectx : Ixon.Eval.EvalCtx} {ictx : IxIR0.Ctx} + {F : Ixon.Eval.Frame} {source : Ixon.Expr} {eraseFuel fuel : Nat} + {value : Ixon.Eval.Value} + (cert : CertifiedSharedExpr ectx ictx none (tablesOfFrame F) + F.selfAddr [] eraseFuel source) + (hstrict : ectx.Strict) + (hctx : ectx.SharingWF) (hF : F.SharingWF) + (horacles : OracleRel ectx.inlineSharing ictx) + (hsource : Ixon.Sharing.sharesBelow F.sharing.size source = true) + (heval : Ixon.Eval.eval ectx fuel F [] source = .ok value) : + ∃ fuel' targetValue, + IxIR0.eval ictx fuel' [] cert.target = .ok targetValue ∧ + InlinedValRel ectx ictx value targetValue := by + apply erasure_sim_inlineSharing_closed hstrict hctx hF horacles hsource heval + have hrelated := cert.related + rw [inlineTables_tablesOfFrame] at hrelated + exact hrelated + +/-! Small boundary guards: the validator accepts kept and ghost applications +that `PErase` covers, while rejecting a successful erasure which reads a +dropped slot (the exact obligation reserved for usage-checker soundness). -/ + +private def emptyEctx : Ixon.Eval.EvalCtx := + { resolve := fun _ => none } + +private def openEctx : Ixon.Eval.EvalCtx := + { emptyEctx with preserveNeutralElims := true } + +private def stringOpenEctx : Ixon.Eval.EvalCtx := + { emptyEctx with + stringLiteral := some + { charType := Address.replicate 0xE0 + charOfNat := Address.replicate 0xE1 + stringOfList := Address.replicate 0xE2 + listNil := Address.replicate 0xE3 + listCons := Address.replicate 0xE4 } } + +private def emptyIctx : IxIR0.Ctx := + { env := fun _ => none } + +private def noCover : CoverOracle emptyEctx emptyIctx := fun _ => none + +private def noInlineCover : CoverOracle emptyEctx.inlineSharing emptyIctx := + fun _ => none + +-- Whole-program certification seals the strict runtime boundary used by the +-- constructor-only projection simulation theorem. +#guard (match certifyProgram openEctx [] [] 100 100 with + | .error (.relation + "certified erasure requires strict neutral-elimination mode") => true + | _ => false) + +#guard (match certifyProgram stringOpenEctx [] [] 100 100 with + | .error (.relation + "certified erasure requires String-literal expansion disabled") => true + | _ => false) + +private def certifies (e : Ixon.Expr) : Bool := + match certifyExpr emptyEctx emptyIctx noCover none {} none [] e 100 100 with + | .ok _ => true + | .error _ => false + +#guard certifies (.app (.lam .many (.var 99) (.var 0)) (.sort 0)) +#guard certifies (.app (.lam .erased (.sort 0) (.sort 0)) (.share 99)) +#guard !certifies (.lam .erased (.var 99) (.var 0)) + +-- The ordinary relation still has no `.share` constructor. The sharing-aware +-- certificate runs the original eraser, inlines semantically, and validates +-- both paths against the same emitted expression. +private def oneShareTables : Erase.ETables := + { sharing := #[.sort 0] } + +#guard (match certifySharedExpr emptyEctx emptyIctx noInlineCover none + oneShareTables none [] (.share 0) 100 100 with + | .ok cert => cert.target == .erased + | .error _ => false) + +private def sharedAddress : Address := Address.replicate 0xE1 + +private def sharedConstant : Constant := + { info := .defn + { kind := .defn, safety := .safe, lvls := 0 + typ := .share 0, value := .share 0 } + sharing := #[.sort 0], refs := #[], univs := #[] } + +private def sharedEctx : Ixon.Eval.EvalCtx := + { resolve := fun address => + if address == sharedAddress then some sharedConstant else none } + +-- Both authoritative roots use the entry, so this is decoder-level layer 1, +-- not merely a raw table accepted by the expression fixture above. +#guard sharedConstant.sharingWF + +#guard (match certifySharedProgram sharedEctx + [(sharedAddress, sharedConstant)] [sharedAddress] 100 100 with + | .ok cert => + cert.target == [(sharedAddress, .defn .shared .erased)] && + cert.coverage.length == 1 + | .error _ => false) + +end Ix.Compiler.EraseValidator diff --git a/Ix/Compiler/Fence.lean b/Ix/Compiler/Fence.lean new file mode 100644 index 000000000..88e3830ee --- /dev/null +++ b/Ix/Compiler/Fence.lean @@ -0,0 +1,7405 @@ +import Ix.Compiler.Sim +import Ix.Compiler.X86.NatCallsSim +import Ix.Compiler.X86.ScalarSourceObject +import Ix.Compiler.X86.PhysicalScalarSourceObject +import Ix.Compiler.X86.PhysicalScalarCapturedSourceObject +import Ix.Compiler.UniqueReuse.PipelineSim +import Ix.Compiler.UniqueReuse.NativeSim +import Ix.Compiler.UniqueReuse.RuntimeNativeSim +import Ix.Compiler.UniqueReuse.RuntimeObjectSim +import Ix.Compiler.X86.RuntimeReject +import Ix.Compiler.X86.ByteBranch +import Ix.Compiler.X86.ByteCall +import Ix.Compiler.X86.StreamExamples +import Ix.Compiler.IxIR2.CreditRefinement +import Ix.Compiler.Borrow.Pipeline +import Ix.Compiler.Borrow.RuntimeSim +import Ix.Compiler.Borrow.RuntimeInput +import Ix.Compiler.IxIR1.Sim +import Ix.Compiler.IxIR1.Reclamation +import Ix.Compiler.IxIR1.LowerSim +import Ix.Compiler.IxIR1.LowerProgress +import Ix.Compiler.IxIR1.LowerAddressedSim +import Ix.Compiler.IxIR1.LowerFullyAddressedSim +import Ix.Compiler.IxIR1.NoReuseAddressed +import Ix.Compiler.IxIR1.CostInstance +import Ix.Compiler.IxIR1.CostModel +import Ix.Compiler.IxIR1.CostTrace +import Ix.Compiler.IxIR1.LowerMutualAddressedSim +import Ix.Compiler.IxIR1.LowerMutualAddressedProgress +import Ix.Compiler.IxIR0.Decode +import Ix.Compiler.IxIR0.MutualBlock +import Ix.Compiler.IxIR0.ReaddressSim +import Ix.Compiler.IxIR0.ProjectionFree +import Ix.Compiler.IxIR0.DynamicCost +import Ix.Compiler.IxIR0.ReaddressProjectionSafe +import Ix.Compiler.IxIR0.ReaddressOracle +import Ix.Compiler.IxIR0.ReaddressOracleExamples +import Ix.Compiler.EraseAddressedSim +import Ix.Compiler.IxIR1.Decode +import Ix.Compiler.IxIR1.MutualBlock +import Ix.Compiler.IxIR1.ReaddressAll +import Ix.Compiler.IxIR1.HPT +import Ix.Compiler.IxIR1.HPTSound +import Ix.Compiler.IxIR1.HPTProduce +import Ix.Compiler.IxIR1.HPTCache +import Ix.Compiler.IxIR1.HPTCasePrune +import Ix.Compiler.IxIR1.HPTCasePruneProgram +import Ix.Compiler.IxIR1.HPTPAPFuse +import Ix.Compiler.IxIR1.HPTFetchForward +import Ix.Compiler.IxIR1.HPTDestroy +import Ix.Compiler.IxIR1.Reachability +import Ix.Compiler.IxIR1.HPTPAPFuseProgram +import Ix.Compiler.SimInstance +import Ix.Compiler.UsageSound +import Ix.Compiler.Ixon.Address +import Ix.Compiler.Ixon.Const +import Ix.Compiler.IxIR2.EvalCounter +import Ix.Compiler.IxIR2.Lower +import Ix.Compiler.IxIR2.LowerSim +import Ix.Compiler.IxIR2.Pipeline +import Ix.Compiler.IxIR2.PipelineSim +import Ix.Compiler.IxIR2.LivenessExamples +import Ix.Compiler.IxIR2.Reuse +import Ix.Compiler.IxIR2.ReuseSim +import Ix.Compiler.IxIR2.ReuseLiveSim +import Ix.Compiler.IxIR2.ReuseSimExamples +import Ix.Compiler.IxIR2.ReuseExamples +import Ix.Compiler.X86.Basic +import Ix.Compiler.X86.Eval +import Ix.Compiler.X86.EvalExamples +import Ix.Compiler.X86.Select +import Ix.Compiler.X86.PipelineSim +import Ix.Compiler.X86.SelectExamples +import Ix.Compiler.X86.Encode +import Ix.Compiler.X86.EncodeExamples +import Ix.Compiler.X86.ELF +import Ix.Compiler.X86.ELFExamples +import Ix.Compiler.Pipeline +import Ix.Compiler.PipelineSound +import Ix.Compiler.Recursion.Sim +import Ix.Compiler.Recursion.PhysicalSim +import Ix.Compiler.Recursion.Resources +import Ix.Compiler.Recursion.Allocation +import Ix.Compiler.Recursion.Costs +import Ix.Compiler.CallReuse.Sim +import Ix.Compiler.CallReuse.MapSim + +/-! +# Sorry/axiom fence (roadmap M0) + +The mechanical fence for the roadmap's M0 "sorry/axiom fence" row: each +flagship theorem's axiom set is pinned with a `#guard_msgs`-checked +`#print axioms`, so `lake build` fails if a `sorryAx` or any new axiom +enters its dependency cone. Pure theorem sets are subsets of the intended +triple `propext`/`Classical.choice`/`Quot.sound`, spelled exactly as +reported (`invoke_fn_result_hasWorld` happens not to use +`Classical.choice`; a pin that widens is as much a diff as one that +breaks). The production content-addressing pins additionally expose the one +native BLAKE3 axiom already inventoried in the trusted-extern ledger; their +generic evaluator-renaming core remains inside the pure set. + +The codec proof layer is pinned too: `Address`, `Univ`, `Expr`, +`ConstantInfo`, and `Constant` each contribute their roundtrip and +canonical-decoding laws, while IxIR₀ and IxIR₁ declarations contribute +framed roundtrip, accepted-byte canonicality, and preimage injectivity. The +two cycle-safe block codecs contribute the same three laws. Their proofs use +kernel-checked extensionality and arithmetic, so all twenty-two laws +stay inside the same intended axiom triple. +-/ + +/-! ## Erasure simulation (`Ix/Compiler/Sim.lean`) -/ + +/-- info: 'Ix.Compiler.Ixon.Eval.projectValue_ok_of_strict' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.Ixon.Eval.projectValue_ok_of_strict + +/-- info: 'Ix.Compiler.Sim.erasure_sim' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.Sim.erasure_sim + +/-- info: 'Ix.Compiler.Sim.erasure_sim_with_members' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.Sim.erasure_sim_with_members + +/-- info: 'Ix.Compiler.Sim.erasure_sim_projectionSafe_with_members' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.Sim.erasure_sim_projectionSafe_with_members + +/-- info: 'Ix.Compiler.Sim.erasure_sim_closed' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.Sim.erasure_sim_closed + +/-- info: 'Ix.Compiler.Sim.erasure_sim_inlineSharing' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.Sim.erasure_sim_inlineSharing + +/-- info: 'Ix.Compiler.Sim.erasure_sim_inlineSharing_closed' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.Sim.erasure_sim_inlineSharing_closed + +/-- info: 'Ix.Compiler.Sim.erasure_proj_sim' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.Sim.erasure_proj_sim + +/-- info: 'Ix.Compiler.Sim.erasure_proj_sim_inlineSharing' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.Sim.erasure_proj_sim_inlineSharing + +/-- info: 'Ix.Compiler.SimInstance.ghostDefinitionHeadSim' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.SimInstance.ghostDefinitionHeadSim + +/-- info: 'Ix.Compiler.SimInstance.quotientIndSim' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.SimInstance.quotientIndSim + +/-- info: 'Ix.Compiler.SimInstance.externAnswerSim' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.SimInstance.externAnswerSim + +/-- info: 'Ix.Compiler.SimInstance.pairSplitProjectionSim' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.SimInstance.pairSplitProjectionSim + +/-- info: 'Ix.Compiler.SimInstance.indexedRecSplitSim' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.SimInstance.indexedRecSplitSim + +/-- info: 'Ix.Compiler.SimInstance.indexedRecSelfSim' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.SimInstance.indexedRecSelfSim + +/-- info: 'Ix.Compiler.SimInstance.definitionProjectionSim' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.SimInstance.definitionProjectionSim + +/-- info: 'Ix.Compiler.SimInstance.mutualInductiveMemberSim' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.SimInstance.mutualInductiveMemberSim + +/-- info: 'Ix.Compiler.SimInstance.cyclicDefinitionMembersSim' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.SimInstance.cyclicDefinitionMembersSim + +/-- info: 'Ix.Compiler.SimInstance.cyclicRecursorMembersSim' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.SimInstance.cyclicRecursorMembersSim + +/-- info: 'Ix.Compiler.SimInstance.opaqueMutualMemberSim' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.SimInstance.opaqueMutualMemberSim + +/-- info: 'Ix.Compiler.SimInstance.opaqueMutualProjectionSim' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.SimInstance.opaqueMutualProjectionSim + +/-! ## Usage-checker non-interference (`Ix/Compiler/UsageSound.lean`) + +Pin the generic common-erasure observation theorem, its contentful checked +and certified dropped-variable instance, and the corresponding whole-entry +forward simulation. -/ + +/-- info: 'Ix.Compiler.Ixon.UsageCheck.closureWorld_shared_iff' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.Ixon.UsageCheck.closureWorld_shared_iff + +/-- info: 'Ix.Compiler.Ixon.UsageCheck.check_lam_shared' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.Ixon.UsageCheck.check_lam_shared + +/-- info: 'Ix.Compiler.UsageSound.computedErased_eval_noninterference' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.UsageSound.computedErased_eval_noninterference + +/-- info: 'Ix.Compiler.UsageSound.DroppedVariableFixture.droppedVariableOccurrenceNoninterference' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.UsageSound.DroppedVariableFixture.droppedVariableOccurrenceNoninterference + +/-- info: 'Ix.Compiler.UsageSound.DroppedVariableFixture.droppedVariableOccurrenceSim' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.UsageSound.DroppedVariableFixture.droppedVariableOccurrenceSim + +/-! ## IxIR₀ → IxIR₁ lowering soundness (`Ix/Compiler/IxIR1/Sim.lean`) -/ + +/-- info: 'Ix.Compiler.IxIR1.Sim.reuse_sound' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Sim.reuse_sound + +/-- info: 'Ix.Compiler.IxIR1.Sim.reuse_shared_sound' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Sim.reuse_shared_sound + +/-- info: 'Ix.Compiler.IxIR1.Sim.invoke_fn_result_hasWorld' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Sim.invoke_fn_result_hasWorld + +/-! ## IxIR₁ reclamation (`Ix/Compiler/IxIR1/Reclamation.lean`, +`Ix/Compiler/IxIR1/NoReuse.lean`, and +`Ix/Compiler/IxIR1/NoReuseAddressed.lean`) + +Pin the finite empty-root theorem, the public semantic bridge, the actual +no-`reuse` compiler proof, and its pure address-transport boundary. The +production SCC corollary additionally carries the already-ledgered native +BLAKE3 audit axiom. -/ + +/-- info: 'Ix.Compiler.IxIR1.Reclamation.live_eq_zero_of_empty_roots' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Reclamation.live_eq_zero_of_empty_roots + +/-- info: 'Ix.Compiler.IxIR1.Reclamation.shared_reclamation' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Reclamation.shared_reclamation + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.reclamation_of_run_invariants' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.reclamation_of_run_invariants + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.reclamation_of_run_ownership_and_zero_reuses' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.reclamation_of_run_ownership_and_zero_reuses + +/-- info: 'Ix.Compiler.IxIR1.Reclamation.runMain_order_of_reuses_eq_zero' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Reclamation.runMain_order_of_reuses_eq_zero + +/-- info: 'Ix.Compiler.IxIR1.Reclamation.runOp_order_of_reuses_eq' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Reclamation.runOp_order_of_reuses_eq + +/-- info: 'Ix.Compiler.IxIR1.NoReuse.runMain_reuses_eq_zero' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.NoReuse.runMain_reuses_eq_zero + +/-- info: 'Ix.Compiler.IxIR1.NoReuse.runOp_reuses_eq' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.NoReuse.runOp_reuses_eq + +/-- info: 'Ix.Compiler.IxIR1.NoReuse.invoke_reuses_eq' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.NoReuse.invoke_reuses_eq + +/-- info: 'Ix.Compiler.IxIR1.NoReuse.applyGo_reuses_eq' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.NoReuse.applyGo_reuses_eq + +/-- info: 'Ix.Compiler.IxIR1.Sim.runOwnedMain_ok' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Sim.runOwnedMain_ok + +/-- info: 'Ix.Compiler.IxIR1.NoReuse.checkCode_eq_true_iff' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.NoReuse.checkCode_eq_true_iff + +/-- info: 'Ix.Compiler.IxIR1.NoReuse.checkDeclarations_eq_true_iff' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.NoReuse.checkDeclarations_eq_true_iff + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllAction_main_owned' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllAction_main_owned + +/-- info: 'Ix.Compiler.IxIR1.NoReuse.lowerAllAction_noReuse' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.NoReuse.lowerAllAction_noReuse + +/-- info: 'Ix.Compiler.IxIR1.NoReuse.lowerAllAction_reclamation' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.NoReuse.lowerAllAction_reclamation + +/-- info: 'Ix.Compiler.IxIR1.NoReuse.reclamation_mapAddresses' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.NoReuse.reclamation_mapAddresses + +/-- info: 'Ix.Compiler.IxIR1.NoReuse.lowerAllIndexedFullyAddressed_reclamation_of_raw' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.NoReuse.lowerAllIndexedFullyAddressed_reclamation_of_raw + +/-- info: 'Ix.Compiler.IxIR1.NoReuse.lowerAllIndexedFullyAddressed_reclamation_of_exact_raw' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.NoReuse.lowerAllIndexedFullyAddressed_reclamation_of_exact_raw + +/-! ## IxIR₁ cost refinement (`Ix/Compiler/IxIR1/LowerSim.lean`, +`Ix/Compiler/IxIR1/NoReuse.lean`, and +`Ix/Compiler/IxIR1/NoReuseAddressed.lean`, and +`Ix/Compiler/IxIR1/CostInstance.lean`, and +`Ix/Compiler/IxIR1/CostModel.lean`, +`Ix/Compiler/IxIR0/DynamicCost.lean`, +`Ix/Compiler/IxIR0/ProjectionFree.lean`, and +`Ix/Compiler/IxIR1/CostTrace.lean`) + +Pin the target-only counter interface, the first concrete whole-pass equation +(`reuses = 0`), both pure and production address transport, and a +nonvacuous exact `(allocs, reuses, frees, rcops) = (1, 0, 0, 0)` compiler +instance. The general runtime balance additionally pins +`nodes.size = allocs` and `live + frees = allocs`; its counter-facing +consequence is `frees ≤ allocs`. The parametric unary-constructor fragment +then connects actual whole-pass lowering to the exact source-result equation +`allocs = constructorNodes`, with zero reuse/free/RC traffic. The dynamic +extension pins additive call/recursor profiles, structural trace recovery for +projection-free executions, and the generic profile-to-counter bridge. Its +retain-width extension and counter-growth algebra expose the unbounded PAP/ +closure dimension needed by a compiler-derived RC tariff; the first runtime +producer bounds `dupVals` by the retained prefix length. The shared-RC +potential then makes arbitrary recursive shared and unique release locally +free: every shared drop exchanges one outstanding-count unit for one RC +instruction. The primitive classifier covers every non-recursive append-only +operation and lifts its allowance through identity, operation emission, +emitter composition, and return sealing while preserving allocation order and +environment bounds. A generic run certificate combines that potential bound +with allocation/reuse facts and the existing heap balance to recover the +public four-counter tariff. -/ + +/-- info: 'Ix.Compiler.IxIR1.Reclamation.runMain_nodes_size_eq_allocs' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Reclamation.runMain_nodes_size_eq_allocs + +/-- info: 'Ix.Compiler.IxIR1.Reclamation.runMain_live_add_frees_eq_allocs' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Reclamation.runMain_live_add_frees_eq_allocs + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.RunCostInvariant.costRefinement' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.RunCostInvariant.costRefinement + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.CostRefinement.and' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.CostRefinement.and + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.allocationFreeCostRefinement' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.allocationFreeCostRefinement + +/-- info: 'Ix.Compiler.IxIR1.NoReuse.lowerAllAction_reuseCostRefinement' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.NoReuse.lowerAllAction_reuseCostRefinement + +/-- info: 'Ix.Compiler.IxIR1.NoReuse.lowerAllAction_costRefinement' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.NoReuse.lowerAllAction_costRefinement + +/-- info: 'Ix.Compiler.IxIR1.NoReuse.runCostInvariant_mapAddresses' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.NoReuse.runCostInvariant_mapAddresses + +/-- info: 'Ix.Compiler.IxIR1.NoReuse.lowerAllIndexedFullyAddressed_runCostInvariant_of_exact_raw' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.NoReuse.lowerAllIndexedFullyAddressed_runCostInvariant_of_exact_raw + +/-- info: 'Ix.Compiler.IxIR1.NoReuse.lowerAllIndexedFullyAddressed_reuseCostRefinement' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.NoReuse.lowerAllIndexedFullyAddressed_reuseCostRefinement + +/-- info: 'Ix.Compiler.IxIR1.NoReuse.lowerAllIndexedFullyAddressed_costRefinement' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.NoReuse.lowerAllIndexedFullyAddressed_costRefinement + +/-- info: 'Ix.Compiler.IxIR1.CostInstance.exactCostRefinement' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostInstance.exactCostRefinement + +/-- info: 'Ix.Compiler.IxIR1.CostInstance.loweringCostWitness' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostInstance.loweringCostWitness + +/-- info: 'Ix.Compiler.IxIR1.CostModel.lowerAllAction_run' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostModel.lowerAllAction_run + +/-- info: 'Ix.Compiler.IxIR1.CostModel.sourceSensitiveCostRefinement' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostModel.sourceSensitiveCostRefinement + +/-- info: 'Ix.Compiler.IxIR1.CostModel.sourceSensitiveBoundsCostRefinement' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostModel.sourceSensitiveBoundsCostRefinement + +/-- info: 'Ix.Compiler.IxIR1.CostModel.loweringCostWitness' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostModel.loweringCostWitness + +/-- info: 'Ix.Compiler.IxIR0.DynamicCost.Eval.ofTrace' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.DynamicCost.Eval.ofTrace + +/-- info: 'Ix.Compiler.IxIR0.DynamicCost.Applies.append' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.DynamicCost.Applies.append + +/-- info: 'Ix.Compiler.IxIR0.ProjectionFree.Eval.of_run' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.ProjectionFree.Eval.of_run + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.ProfileCostRefinement.of_witness' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.ProfileCostRefinement.of_witness + +/-- info: 'Ix.Compiler.IxIR0.DynamicCost.Eval.surfaceEvals_le' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.DynamicCost.Eval.surfaceEvals_le + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.ObservationGrowthLE.trans' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.ObservationGrowthLE.trans + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.dupVals_growth' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.dupVals_growth + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.withinBudget_ownershipAmortized_iff' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.withinBudget_ownershipAmortized_iff + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.RcPotentialGrowthLE.trans' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.RcPotentialGrowthLE.trans + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.dupVals_rcPotential_growth' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.dupVals_rcPotential_growth + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.dropVal_amortizedRc' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.dropVal_amortizedRc + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.dropUVal_amortizedRc' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.dropUVal_amortizedRc + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.runOp_localRcPotential_growth' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.runOp_localRcPotential_growth + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.OpRcPotentialSound.of_local' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.OpRcPotentialSound.of_local + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.EmitRcPotentialSound.comp' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.EmitRcPotentialSound.comp + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.EmitRcPotentialSound.localOp' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.EmitRcPotentialSound.localOp + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.dropVal_allocs' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.dropVal_allocs + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.runOp_localOwnership_growth' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.runOp_localOwnership_growth + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.OpOwnershipCostSound.of_local' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.OpOwnershipCostSound.of_local + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.EmitOwnershipCostSound.comp' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.EmitOwnershipCostSound.comp + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.EmitOwnershipCostSound.localOp' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.EmitOwnershipCostSound.localOp + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.ProfileFundedEmitStateRunSound.ofOp' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.ProfileFundedEmitStateRunSound.ofOp + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.ProfileFundedApplyRun.papOver' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.ProfileFundedApplyRun.papOver + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.LowerResultProfileSound.installThen' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.LowerResultProfileSound.installThen + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.lowerE_let_run_profile_sound' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.lowerE_let_run_profile_sound + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.lowerBorrow_run_profile_sound' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.lowerBorrow_run_profile_sound + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.projectionSlotReleased_profileFundedEmitStateRunSound' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.projectionSlotReleased_profileFundedEmitStateRunSound + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.lowerE_proj_run_profile_sound' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.lowerE_proj_run_profile_sound + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.papp_graph_op' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.papp_graph_op + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.LowerResultProfileSound.consArgs' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.LowerResultProfileSound.consArgs + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.lowerCaptures_run_profile_sound' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.lowerCaptures_run_profile_sound + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.lowerLam_run_profile_sound' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.lowerLam_run_profile_sound + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.lowerE_lam_run_profile_sound' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.lowerE_lam_run_profile_sound + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.sourceProfileOwnershipAllowance_add' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.sourceProfileOwnershipAllowance_add + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.CodeOwnershipCostSound.runCertificate' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.CodeOwnershipCostSound.runCertificate + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.CodeOwnershipCostSound.withinBudget' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.CodeOwnershipCostSound.withinBudget + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.OwnershipAmortizedRunCertificate.spec' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.OwnershipAmortizedRunCertificate.spec + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.ProfileCostRefinement.of_ownershipAmortizedCertificate' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.ProfileCostRefinement.of_ownershipAmortizedCertificate + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.lowerAllAction_compilerProfileContracts' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.lowerAllAction_compilerProfileContracts + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.lowerAllAction_main_ownershipAmortizedCertificate_sealed' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.lowerAllAction_main_ownershipAmortizedCertificate_sealed + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.lowerAllAction_profileCostRefinement_sealed' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.lowerAllAction_profileCostRefinement_sealed + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.lowerAllIndexedFullyAddressed_profileCostRefinement_sealed' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.lowerAllIndexedFullyAddressed_profileCostRefinement_sealed + +/-- info: 'Ix.Compiler.IxIR1.CostTrace.lowerAllIndexedFullyAddressed_profileCostRefinement_exact_sealed' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.CostTrace.lowerAllIndexedFullyAddressed_profileCostRefinement_exact_sealed + +/-! ## Whole-pass lowering instance (`Ix/Compiler/SimInstance.lean`) + +The four boundaries the M2b ledger claims for the actual compiled +`add 2̂ 3̂` output: exact ownership contracts, the source-to-target +`ValueGraph` forward simulation, all-fuel memory-error exclusion, and the +call/recursion-sensitive source-profile cost refinement. +Pinning them here is what makes +"without `native_decide`" mechanical rather than editorial. -/ + +/-- info: 'Ix.Compiler.SimInstance.addIxIR1CompilerContracts' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.SimInstance.addIxIR1CompilerContracts + +/-- info: 'Ix.Compiler.SimInstance.addIxIR1SemanticForwardSimulation' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.SimInstance.addIxIR1SemanticForwardSimulation + +/-- info: 'Ix.Compiler.SimInstance.addIxIR1MemoryErrorUnreachable' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.SimInstance.addIxIR1MemoryErrorUnreachable + +/-- info: 'Ix.Compiler.SimInstance.addIxIR1DynamicCostRefinement' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.SimInstance.addIxIR1DynamicCostRefinement + +/-! ## Generic whole-pass target safety +(`Ix/Compiler/IxIR1/LowerProgress.lean`) -/ + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllAction_memoryErrorUnreachable_sealed' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllAction_memoryErrorUnreachable_sealed + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllAction_unknownRefUnreachable_sealed' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllAction_unknownRefUnreachable_sealed + +/-! ## Content-addressed lowering transport +(`Ix/Compiler/IxIR1/ReaddressSim.lean`, +`Ix/Compiler/IxIR1/ReaddressOwnership.lean`, +`Ix/Compiler/IxIR1/LowerAddressedSim.lean`) + +The generic evaluator proof is independent of hashing. The production +corollaries consume a successful native BLAKE3 post-pass run, so the exact +native implementation axiom is an intentional, mechanically visible member +of those cones. Pin the indexed artifact boundary used by `Pipeline` across +identity protection, exact runs, addressed value graphs, all three dynamic +error classes, and cost counters. -/ + +/-- info: 'Ix.Compiler.IxIR1.Readdress.evalTransportAt' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Readdress.evalTransportAt + +/-- info: 'Ix.Compiler.IxIR1.Readdress.applyGo_mapAddresses' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Readdress.applyGo_mapAddresses + +/-- info: 'Ix.Compiler.IxIR1.Readdress.dupVals_success_preimage' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Readdress.dupVals_success_preimage + +/-- info: 'Ix.Compiler.IxIR1.Readdress.dropVal_success_preimage' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Readdress.dropVal_success_preimage + +/-- info: 'Ix.Compiler.IxIR1.Readdress.runOp_success_preimage' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Readdress.runOp_success_preimage + +/-- info: 'Ix.Compiler.IxIR1.Sim.rootOwnership_mapAddresses_iff' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Sim.rootOwnership_mapAddresses_iff + +/-- info: 'Ix.Compiler.IxIR1.Readdress.runMain_mapAddresses' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Readdress.runMain_mapAddresses + +/-! IxIR₀ now has the corresponding full-value transport: closures, +constructor identities, PAP heads, oracle calls, and address-bearing errors +all commute with the map. -/ + +/-- info: 'Ix.Compiler.IxIR0.Readdress.evalTransportAt' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.Readdress.evalTransportAt + +/-- info: 'Ix.Compiler.IxIR0.Readdress.Ctx.run_mapAddresses' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.Readdress.Ctx.run_mapAddresses + +/-- info: 'Ix.Compiler.IxIR0.Readdress.ProjectionSafe.Eval.mapAddresses' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.Readdress.ProjectionSafe.Eval.mapAddresses + +/-! The executable oracle view reverse-resolves only declaration keys and +maps returned values forward. Its compatibility theorem remains independent +of hashing; the successful production wrapper below exposes the native hash +boundary used to construct the recorded program map. -/ + +/-- info: 'Ix.Compiler.IxIR0.Readdress.Oracle.readdress_compatible' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.Readdress.Oracle.readdress_compatible + +/-- info: 'Ix.Compiler.EraseAddressed.run_readdressOracle_semantics_of_run_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.EraseAddressed.run_readdressOracle_semantics_of_run_eq_ok + +/-! The cycle-safe IxIR₀ block codec is pure, while successful transient-name +materialization intentionally crosses the same native BLAKE3 boundary. -/ + +/-- info: 'Ix.Compiler.IxIR0.MutualBlock.semanticAudit_of_run_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.MutualBlock.semanticAudit_of_run_eq_ok + +/-- info: 'Ix.Compiler.IxIR1.MutualBlock.semanticAudit_of_run_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.MutualBlock.semanticAudit_of_run_eq_ok + +/-- info: 'Ix.Compiler.IxIR1.ReaddressAll.semanticAudit_of_run_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.ReaddressAll.semanticAudit_of_run_eq_ok + +/-- info: 'Ix.Compiler.IxIR1.ReaddressAll.reserved_of_run_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.ReaddressAll.reserved_of_run_eq_ok + +/-- info: 'Ix.Compiler.IxIR1.ReaddressAll.rebuildSemanticAudit_of_run_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.ReaddressAll.rebuildSemanticAudit_of_run_eq_ok + +/-- info: 'Ix.Compiler.IxIR1.ReaddressAll.Result.raw_lookup_of_mem_of_rebuildSemanticAudit' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.ReaddressAll.Result.raw_lookup_of_mem_of_rebuildSemanticAudit + +/-- info: 'Ix.Compiler.IxIR1.ReaddressAll.Result.declaration_preimage_of_lookup_of_rebuildSemanticAudit' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.ReaddressAll.Result.declaration_preimage_of_lookup_of_rebuildSemanticAudit + +/-! Checked HPT summaries expose both the untrusted candidate's post-fixpoint +condition and the exact cache/content-address audit. Materialization uses the +same ledgered BLAKE3 boundary as the program artifacts. -/ + +/-- info: 'Ix.Compiler.IxIR1.HPT.postFixpoint_of_runWith_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.postFixpoint_of_runWith_eq_ok + +/-- info: 'Ix.Compiler.IxIR1.HPT.semanticAudit_of_runWith_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.semanticAudit_of_runWith_eq_ok + +/-- info: 'Ix.Compiler.IxIR1.HPT.postFixpoint_of_run_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.postFixpoint_of_run_eq_ok + +/-- info: 'Ix.Compiler.IxIR1.HPT.semanticAudit_of_run_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.semanticAudit_of_run_eq_ok + +/-! The abstract interpreter's evaluator concretization is pure. Composing +that theorem with accepted native-addressed certificates exposes exactly the +same ledgered BLAKE3 axiom as the existing post-fixpoint/materialization +boundary, including through the pipeline API. -/ + +/-! Recursive field refinement itself is hash-independent. These pins cover +the mutually recursive order transport and both directions of the bounded +root/field conversion used by allocation, fetch, and case binders. -/ + +/-- info: 'Ix.Compiler.IxIR1.HPT.FieldShape.holds_of_le' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.FieldShape.holds_of_le + +/-- info: 'Ix.Compiler.IxIR1.HPT.FieldFact.holds_of_le' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.FieldFact.holds_of_le + +/-- info: 'Ix.Compiler.IxIR1.HPT.FieldFactsHold.holds_of_listLe' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.FieldFactsHold.holds_of_listLe + +/-- info: 'Ix.Compiler.IxIR1.HPT.HeapShape.toFieldShape_holds' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.HeapShape.toFieldShape_holds + +/-- info: 'Ix.Compiler.IxIR1.HPT.FieldShape.toHeapShape_holds' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.FieldShape.toHeapShape_holds + +/-- info: 'Ix.Compiler.IxIR1.HPT.FieldFact.ofFact_holds' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.FieldFact.ofFact_holds + +/-- info: 'Ix.Compiler.IxIR1.HPT.FieldFact.toFact_holds' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.FieldFact.toFact_holds + +/-- info: 'Ix.Compiler.IxIR1.HPT.Fact.exactConstructor?_eq_some' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.Fact.exactConstructor?_eq_some + +/-- info: 'Ix.Compiler.IxIR1.HPT.Fact.exactConstructor?_holds_loc' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.Fact.exactConstructor?_holds_loc + +/-- info: 'Ix.Compiler.IxIR1.HPT.Fact.caseFields_ctor_holds' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.Fact.caseFields_ctor_holds + +/-- info: 'Ix.Compiler.IxIR1.HPT.Fact.caseFields_natSucc_holds' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.Fact.caseFields_natSucc_holds + +/-- info: 'Ix.Compiler.IxIR1.HPT.analyzeOp_sound' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.analyzeOp_sound + +/-- info: 'Ix.Compiler.IxIR1.HPT.invoke_sound' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.invoke_sound + +/-- info: 'Ix.Compiler.IxIR1.HPT.functionSummary_sound_of_runWith_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.functionSummary_sound_of_runWith_eq_ok + +/-- info: 'Ix.Compiler.IxIR1.HPT.functionSummary_sound_of_run_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.functionSummary_sound_of_run_eq_ok + +/-- info: 'Ix.Compiler.Pipeline.Artifact.functionSummary_sound_of_checkHPTWith_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.Artifact.functionSummary_sound_of_checkHPTWith_eq_ok + +/-- info: 'Ix.Compiler.Pipeline.Artifact.functionSummary_sound_of_checkHPT_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.Artifact.functionSummary_sound_of_checkHPT_eq_ok + +/-! Deterministic production remains outside the trust boundary: its output +stores an equality showing that the ordinary checker accepted it. These pins +make the resulting post-fixpoint, audit, and evaluator guarantees expose the +same native materialization dependency and nothing further. -/ + +/-- info: 'Ix.Compiler.IxIR1.HPT.Production.postFixpoint' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.Production.postFixpoint + +/-- info: 'Ix.Compiler.IxIR1.HPT.Production.semanticAudit' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.Production.semanticAudit + +/-- info: 'Ix.Compiler.IxIR1.HPT.Production.functionSummary_sound' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.Production.functionSummary_sound + +/-- info: 'Ix.Compiler.Pipeline.Artifact.functionSummary_sound_of_producedHPT' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.Artifact.functionSummary_sound_of_producedHPT + +/-! Persistent-cache hits and artifact-local rebuilds are likewise outside the +trust boundary: the returned value stores the exact ordinary checker equality. +The filesystem adapter carries no theorem and cannot weaken these cones. -/ + +/-- info: 'Ix.Compiler.IxIR1.HPT.Cache.Production.postFixpoint' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.Cache.Production.postFixpoint + +/-- info: 'Ix.Compiler.IxIR1.HPT.Cache.Production.semanticAudit' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.Cache.Production.semanticAudit + +/-- info: 'Ix.Compiler.IxIR1.HPT.Cache.Production.functionSummary_sound' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.Cache.Production.functionSummary_sound + +/-- info: 'Ix.Compiler.Pipeline.Artifact.functionSummary_sound_of_cachedHPT' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.Artifact.functionSummary_sound_of_cachedHPT + +/-! The first HPT consumer, including owner-sensitive whole-function fact +propagation, recursive supplied-code traversal, self-call-aware rewriting, and +declaration-graph rebuilding, is pure through its logical old-keyed layer. +Checked, directly produced, cached, and content-address rebuild wrappers add +exactly the already-ledgered native digest dependency, and no +transformation-specific assumption. -/ + +/-- info: 'Ix.Compiler.IxIR1.HPT.CasePrune.runCode_runWithFacts_eq' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.CasePrune.runCode_runWithFacts_eq + +/-- info: 'Ix.Compiler.IxIR1.HPT.CasePrune.runCode_rewriteCurrentAt_body_eq' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.CasePrune.runCode_rewriteCurrentAt_body_eq + +/-- info: 'Ix.Compiler.IxIR1.HPT.CasePrune.runCode_run_eq' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.CasePrune.runCode_run_eq + +/-- info: 'Ix.Compiler.IxIR1.HPT.CasePrune.runCode_run_eq_of_runWith_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.CasePrune.runCode_run_eq_of_runWith_eq_ok + +/-- info: 'Ix.Compiler.Pipeline.Artifact.runCode_pruneCase_of_checkHPTWith_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.Artifact.runCode_pruneCase_of_checkHPTWith_eq_ok + +/-- info: 'Ix.Compiler.Pipeline.Artifact.runCode_pruneCaseWithProducedHPT_eq' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.Artifact.runCode_pruneCaseWithProducedHPT_eq + +/-- info: 'Ix.Compiler.Pipeline.Artifact.runCode_pruneCaseWithCachedHPT_eq' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.Artifact.runCode_pruneCaseWithCachedHPT_eq + +/-- info: 'Ix.Compiler.IxIR1.HPT.CasePrune.runCode_runRecursive_eq' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.CasePrune.runCode_runRecursive_eq + +/-- info: 'Ix.Compiler.IxIR1.HPT.CasePrune.runCode_runRecursive_eq_of_runWith_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.CasePrune.runCode_runRecursive_eq_of_runWith_eq_ok + +/-- info: 'Ix.Compiler.Pipeline.Artifact.runCode_pruneCasesRecursive_of_checkHPTWith_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.Artifact.runCode_pruneCasesRecursive_of_checkHPTWith_eq_ok + +/-- info: 'Ix.Compiler.Pipeline.Artifact.runCode_pruneCasesRecursiveWithProducedHPT_eq' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.Artifact.runCode_pruneCasesRecursiveWithProducedHPT_eq + +/-- info: 'Ix.Compiler.Pipeline.Artifact.runCode_pruneCasesRecursiveWithCachedHPT_eq' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.Artifact.runCode_pruneCasesRecursiveWithCachedHPT_eq + +/-- info: 'Ix.Compiler.IxIR1.HPT.CasePrune.runMain_runRecursive_eq' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.CasePrune.runMain_runRecursive_eq + +/-- info: 'Ix.Compiler.IxIR1.HPT.CasePrune.runMain_runRecursive_eq_of_runWith_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.CasePrune.runMain_runRecursive_eq_of_runWith_eq_ok + +/-- info: 'Ix.Compiler.Pipeline.Artifact.runMain_pruneMain_of_checkHPTWith_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.Artifact.runMain_pruneMain_of_checkHPTWith_eq_ok + +/-- info: 'Ix.Compiler.Pipeline.Artifact.runMain_pruneMainWithProducedHPT_eq' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.Artifact.runMain_pruneMainWithProducedHPT_eq + +/-- info: 'Ix.Compiler.Pipeline.Artifact.runMain_pruneMainWithCachedHPT_eq' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.Artifact.runMain_pruneMainWithCachedHPT_eq + +/-- info: 'Ix.Compiler.IxIR1.HPT.CasePrune.runMain_rewriteProgram_eq' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.CasePrune.runMain_rewriteProgram_eq + +/-- info: 'Ix.Compiler.IxIR1.ReaddressAll.runMain_exact_of_rebuild_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.ReaddressAll.runMain_exact_of_rebuild_eq_ok + +/-- info: 'Ix.Compiler.IxIR1.ReaddressAll.runMain_exact_of_run_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.ReaddressAll.runMain_exact_of_run_eq_ok + +/-- info: 'Ix.Compiler.IxIR1.HPT.CasePrune.runMain_rebuild_rewriteProgram' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.CasePrune.runMain_rebuild_rewriteProgram + +/-! Scalar fetch forwarding is exact both at one accepted constructor/fetch +pair and through its owner-sensitive recursive traversal. -/ + +/-- info: 'Ix.Compiler.IxIR1.HPT.FetchForward.runCode_forwardHead?_eq' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.FetchForward.runCode_forwardHead?_eq + +/-- info: 'Ix.Compiler.IxIR1.HPT.FetchForward.runCode_runWithFacts_eq_ownerCompatible' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.FetchForward.runCode_runWithFacts_eq_ownerCompatible + +/-! Shape-specialized destruction is pure at both the accepted local +decision and the complete owner-sensitive fact traversal. -/ + +/-- info: 'Ix.Compiler.IxIR1.HPT.Destroy.runOp_specialize?_success' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.Destroy.runOp_specialize?_success + +/-- info: 'Ix.Compiler.IxIR1.HPT.Destroy.runCode_runWithFacts_success_ownerCompatible' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.Destroy.runCode_runWithFacts_success_ownerCompatible + +/-! Rooted reachability is exact after validation and through its fail-soft +produce/check/apply wrapper. Both public theorems expose the native BLAKE3 +axiom because validation commits to the exact input graph digest. -/ + +/-- info: 'Ix.Compiler.IxIR1.Reachability.runMain_filterEntries_eq_of_validate' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Reachability.runMain_filterEntries_eq_of_validate + +/-- info: 'Ix.Compiler.IxIR1.Reachability.runMain_run_eq' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Reachability.runMain_run_eq + +/-! The first allocation-shrinking consumer is pure through both the generic +heap-history evaluator congruence and its executable local decision theorem. -/ + +/-- info: 'Ix.Compiler.IxIR1.Sim.HeapHistoryIso.toHeapIso' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Sim.HeapHistoryIso.toHeapIso + +/-- info: 'Ix.Compiler.IxIR1.Sim.HeapHistoryIso.toHeapIso_rel' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Sim.HeapHistoryIso.toHeapIso_rel + +/-- info: 'Ix.Compiler.IxIR1.Sim.HeapHistoryIso.of_toHeapIso_rel' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Sim.HeapHistoryIso.of_toHeapIso_rel + +/-- info: 'Ix.Compiler.IxIR1.Sim.runCode_historyIso' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Sim.runCode_historyIso + +/-- info: 'Ix.Compiler.IxIR1.HPT.PAPFuse.fusePair?_refines' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.PAPFuse.fusePair?_refines + +/-- info: 'Ix.Compiler.IxIR1.Sim.runCode_abstractEnvironment' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Sim.runCode_abstractEnvironment + +/-- info: 'Ix.Compiler.IxIR1.Sim.runCode_exactEnvironment_eq' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Sim.runCode_exactEnvironment_eq + +/-- info: 'Ix.Compiler.IxIR1.HPT.OptimizeProgram.runMain_rebuildProgram_of_runWith_eq_ok_defaultOracle' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.HPT.OptimizeProgram.runMain_rebuildProgram_of_runWith_eq_ok_defaultOracle + +/-! Fail-soft optimizer reclamation uses one forwarded execution, evaluator +determinism, allocation-history release transport, and the exact final rebuild. +The produced and cached wrappers expose the same native digest boundary as the +checked HPT and rebuild inputs. -/ + +/-- info: 'Ix.Compiler.IxIR1.Optimizer.Outcome.reclamation_of_witness' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Optimizer.Outcome.reclamation_of_witness + +/-- info: 'Ix.Compiler.IxIR1.Optimizer.reclamation_of_runWithProducedHPT_eq' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Optimizer.reclamation_of_runWithProducedHPT_eq + +/-- info: 'Ix.Compiler.IxIR1.Optimizer.reclamation_of_runWithCachedHPT_eq' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Optimizer.reclamation_of_runWithCachedHPT_eq + +/-- info: 'Ix.Compiler.Pipeline.Artifact.runMain_pruneProgram_of_checkAndPruneProgramWith_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.Artifact.runMain_pruneProgram_of_checkAndPruneProgramWith_eq_ok + +/-- info: 'Ix.Compiler.IxIR0.Readdress.semanticAudit_of_run_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.Readdress.semanticAudit_of_run_eq_ok + +/-- info: 'Ix.Compiler.IxIR0.Readdress.Result.declaration_lookup_of_mem_of_semanticAudit' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.Readdress.Result.declaration_lookup_of_mem_of_semanticAudit + +/-- info: 'Ix.Compiler.IxIR0.Readdress.isolates_of_run_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.Readdress.isolates_of_run_eq_ok + +/-- info: 'Ix.Compiler.IxIR0.Readdress.Oracle.Readdressable.examples_of_isolates' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.Readdress.Oracle.Readdressable.examples_of_isolates + +/-- info: 'Ix.Compiler.IxIR0.Readdress.Oracle.Readdressable.examples_of_run_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.Readdress.Oracle.Readdressable.examples_of_run_eq_ok + +/-- info: 'Ix.Compiler.EraseAddressed.semanticAudit_of_run_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.EraseAddressed.semanticAudit_of_run_eq_ok + +/-- info: 'Ix.Compiler.EraseAddressed.run_semantics_of_run_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.EraseAddressed.run_semantics_of_run_eq_ok + +/-- info: 'Ix.Compiler.EraseAddressed.run_projectionSafeMain_of_run_eq_ok' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.EraseAddressed.run_projectionSafeMain_of_run_eq_ok + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.AddressedSemanticForwardSimulation.precomposeIxIR0' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.AddressedSemanticForwardSimulation.precomposeIxIR0 + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedAddressed_after_addressedErasure' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedAddressed_after_addressedErasure + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedAddressed_protectsSourceAddresses' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedAddressed_protectsSourceAddresses + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedAddressed_runMain' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedAddressed_runMain + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedAddressed_semanticForwardSimulation' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedAddressed_semanticForwardSimulation + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedAddressed_memoryErrorUnreachable' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedAddressed_memoryErrorUnreachable + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedAddressed_ordinaryStuckUnreachable' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedAddressed_ordinaryStuckUnreachable + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedAddressed_unknownRefUnreachable' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedAddressed_unknownRefUnreachable + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedAddressed_runMain_cost' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedAddressed_runMain_cost + +/-! The SCC-aware production boundary carries the same native digest axiom +and now permits source-function rekeying while auditing constructor stability. -/ + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_runMain' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_runMain + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_runMain_exact' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_runMain_exact + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_runMain_exact_success' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_runMain_exact_success + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_apply_constructorIdentity' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_apply_constructorIdentity + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_semanticForwardSimulation' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_semanticForwardSimulation + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_semanticForwardSimulation_exact' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_semanticForwardSimulation_exact + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_memoryErrorUnreachable' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_memoryErrorUnreachable + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_ordinaryStuckUnreachable' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_ordinaryStuckUnreachable + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_unknownRefUnreachable' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_unknownRefUnreachable + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_runMain_cost' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_runMain_cost + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_after_addressedErasure' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_after_addressedErasure + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_exact_after_addressedErasure' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_exact_after_addressedErasure + +/-! ## Erasure-safe whole-pass progress +(`Ix/Compiler/IxIR1/LowerProgress.lean`) + +The certified-erasure route rules out the raw lowering's erased-projection +absorber. Pin both the source-side projection-safety bridge and the resulting +whole-main progress/simulation boundaries. The call-aware pins additionally +ensure that callable target progress is reconstructed from exact source-fuel +traces and whole-pass provenance, rather than from `CompilerProgressContracts`. +-/ + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.ProjectionSafeEval.of_erasure' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.ProjectionSafeEval.of_erasure + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.ProjectionSafeEval.of_erasure_with_members' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.ProjectionSafeEval.of_erasure_with_members + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.ProjectionSafeEval.of_erasure_inlineSharing' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.ProjectionSafeEval.of_erasure_inlineSharing + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.ProjectionSafeEval.of_certifiedSharedClosed' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.ProjectionSafeEval.of_certifiedSharedClosed + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.CallAwareProjectionSafe.of_certifiedSharedClosed' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.CallAwareProjectionSafe.of_certifiedSharedClosed + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.CallAwareProjectionSafe.of_erasure_inlineSharing_with_members' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.CallAwareProjectionSafe.of_erasure_inlineSharing_with_members + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.CallAwareProjectionSafe.of_certifiedSharedClosed_with_members' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.CallAwareProjectionSafe.of_certifiedSharedClosed_with_members + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.CallAwareProjectionSafe.of_erasure_with_members' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.CallAwareProjectionSafe.of_erasure_with_members + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.CallAwareProjectionSafe.of_certifiedSharedClosed_addressed' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.CallAwareProjectionSafe.of_certifiedSharedClosed_addressed + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.CallAwareProjectionSafe.of_certifiedSharedClosed_addressed_with_members' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.CallAwareProjectionSafe.of_certifiedSharedClosed_addressed_with_members + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedAddressed_main_progress_of_certificate_sealed' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedAddressed_main_progress_of_certificate_sealed + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedAddressed_semanticForwardSimulation_of_certificate_sealed' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedAddressed_semanticForwardSimulation_of_certificate_sealed + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_main_progress_of_certificate_sealed' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_main_progress_of_certificate_sealed + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_semanticForwardSimulation_of_certificate_sealed' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_semanticForwardSimulation_of_certificate_sealed + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedAction_main_progress_of_addressed_certificate_with_members_sealed' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedAction_main_progress_of_addressed_certificate_with_members_sealed + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_semanticForwardSimulation_of_certificate_with_members_sealed' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_semanticForwardSimulation_of_certificate_with_members_sealed + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_main_progress_of_addressed_certificate_with_members_exact_sealed' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_main_progress_of_addressed_certificate_with_members_exact_sealed + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_semanticForwardSimulation_of_certificate_with_members_exact_sealed' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllIndexedFullyAddressed_semanticForwardSimulation_of_certificate_with_members_exact_sealed + +/-! The validated pipeline retains the exact member scope, erasure certificate, +member coverage, and both address-pass equations consumed by the production +semantic endpoint. Its O1 projection pins semantic preservation, progress, +memory-error exclusion, reclamation, and the evaluator-universal allocation/ +free law directly on the artifact selected by the fail-soft optimizer. -/ + +/-- info: 'Ix.Compiler.Pipeline.ValidatedCompilation.targetDeclEnv_ne_extern' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.ValidatedCompilation.targetDeclEnv_ne_extern + +/-- info: 'Ix.Compiler.Pipeline.ValidatedCompilation.externValueContract' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.ValidatedCompilation.externValueContract + +/-- info: 'Ix.Compiler.Pipeline.ValidatedCompilation.externTraceProgressContract' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.ValidatedCompilation.externTraceProgressContract + +/-- info: 'Ix.Compiler.Pipeline.ValidatedCompilation.semanticForwardSimulation' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.ValidatedCompilation.semanticForwardSimulation + +/-- info: 'Ix.Compiler.Pipeline.ValidatedCompilation.semanticForwardSimulationOfProducedOptimizedArtifact' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.ValidatedCompilation.semanticForwardSimulationOfProducedOptimizedArtifact + +/-- info: 'Ix.Compiler.Pipeline.ValidatedCompilation.targetProgressAfterProducedOptimization' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.ValidatedCompilation.targetProgressAfterProducedOptimization + +/-- info: 'Ix.Compiler.Pipeline.ValidatedCompilation.memoryErrorUnreachableAfterProducedOptimization' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.ValidatedCompilation.memoryErrorUnreachableAfterProducedOptimization + +/-- info: 'Ix.Compiler.Pipeline.ValidatedCompilation.reclamationAfterProducedOptimization' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.ValidatedCompilation.reclamationAfterProducedOptimization + +/-- info: 'Ix.Compiler.Pipeline.ValidatedCompilation.allocationFreeCostInvariantAfterProducedOptimization' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.ValidatedCompilation.allocationFreeCostInvariantAfterProducedOptimization + +/-- info: 'Ix.Compiler.Pipeline.ValidatedCompilation.sourceCallableRowsSelected' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.ValidatedCompilation.sourceCallableRowsSelected + +/-- info: 'Ix.Compiler.Pipeline.ValidatedCompilation.sourceDeclLayout' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.ValidatedCompilation.sourceDeclLayout + +/-- info: 'Ix.Compiler.Pipeline.ValidatedCompilation.sourcePapSafe' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.ValidatedCompilation.sourcePapSafe + +/-- info: 'Ix.Compiler.Pipeline.ValidatedCompilation.fnDeclCovered' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.ValidatedCompilation.fnDeclCovered + +/-- info: 'Ix.Compiler.Pipeline.ValidatedCompilation.exactExtraRepresented' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.ValidatedCompilation.exactExtraRepresented + +/-- info: 'Ix.Compiler.Pipeline.ValidatedCompilation.exactCompilerContracts' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.ValidatedCompilation.exactCompilerContracts + +/-- info: 'Ix.Compiler.Pipeline.ValidatedCompilation.targetProgress' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.ValidatedCompilation.targetProgress + +/-- info: 'Ix.Compiler.Pipeline.ValidatedCompilation.memoryErrorUnreachable' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.ValidatedCompilation.memoryErrorUnreachable + +/-- info: 'Ix.Compiler.Pipeline.ValidatedCompilation.reclamation' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.ValidatedCompilation.reclamation + +/-- info: 'Ix.Compiler.Pipeline.ValidatedCompilation.costRefinement' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.ValidatedCompilation.costRefinement + +/-- info: 'Ix.Compiler.Pipeline.ValidatedCompilation.ownershipAmortizedCostRefinement' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.ValidatedCompilation.ownershipAmortizedCostRefinement + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllAction_compilerTraceProgressContracts' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllAction_compilerTraceProgressContracts + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllAction_main_progress_of_certificate_sealed' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllAction_main_progress_of_certificate_sealed + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllAction_main_progress_of_projectionSafe' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllAction_main_progress_of_projectionSafe + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllAction_ordinaryStuckUnreachable_of_erasure_inlineSharing_sealed' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllAction_ordinaryStuckUnreachable_of_erasure_inlineSharing_sealed + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllAction_semanticForwardSimulation_of_erasure_inlineSharing_sealed' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllAction_semanticForwardSimulation_of_erasure_inlineSharing_sealed + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllAction_semanticForwardSimulation_of_certificate_sealed' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllAction_semanticForwardSimulation_of_certificate_sealed + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllAction_semanticForwardSimulation_of_certificate_trace_sealed' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllAction_semanticForwardSimulation_of_certificate_trace_sealed + +/-! ## Owner-sensitive dynamic application + +Dynamic PAP entry is guarded by declaration metadata, while saturated direct +calls retain heterogeneous ownership boundaries. These pins keep the computed +metadata, whole-pass provenance, strictly-weaker mixed-mode premise, and joint +contract seal inside the ordinary proof axiom envelope. -/ + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllAction_sourceDeclLayout' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllAction_sourceDeclLayout + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllAction_sourcePapSafe' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllAction_sourcePapSafe + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllAction_fnDeclCovered' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllAction_fnDeclCovered + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllAction_extraProvenance_empty' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllAction_extraProvenance_empty + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.GeneratedDeclProvenance.fnPreservesAt' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.GeneratedDeclProvenance.fnPreservesAt + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllAction_sourceFnPreservesAt' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllAction_sourceFnPreservesAt + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllAction_compilerContracts' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllAction_compilerContracts + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerDecl_defn_papSafe_of_run' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerDecl_defn_papSafe_of_run + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerDecl_recursor_papSafe_of_run' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerDecl_recursor_papSafe_of_run + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerAllAction_compilerFunction_declPapSafe' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerAllAction_compilerFunction_declPapSafe + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.SourceAllShared.papSafe' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.SourceAllShared.papSafe + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.sourcePapSafe_not_sourceAllShared' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.sourcePapSafe_not_sourceAllShared + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.papSafeDeclContractsBelow_of_source_extra' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.papSafeDeclContractsBelow_of_source_extra + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.compilerContracts_of_source_extra_below_step' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.compilerContracts_of_source_extra_below_step + +/-- info: 'Ix.Compiler.IxIR1.Sim.applyOwnershipContract_of_papSafeDecls' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Sim.applyOwnershipContract_of_papSafeDecls + +/-! ## Semantic projection (`Ix/Compiler/IxIR1/LowerSim.lean`) + +The premise-free member of the projection value pipeline: variable-target +projection needs no compiler-induction hypothesis, so its cone is the whole +borrow/fetch/retain/release argument. -/ + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerE_proj_var_run_value_sound' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerE_proj_var_run_value_sound + +/-- info: 'Ix.Compiler.IxIR1.LowerSim.lowerE_proj_erasure_run_value_progress_within' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.LowerSim.lowerE_proj_erasure_run_value_progress_within + +/-! ## Indexed address environments (`Ix/Compiler/AddressEnv.lean`) + +The corpus path builds each hash index once, while these equalities retain the +transparent first-binding-wins list semantics as the proof specification. -/ + +/-- info: 'Ix.Compiler.AddressEnv.lookup_build' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.AddressEnv.lookup_build + +/-- info: 'Ix.Compiler.IxIR1.Lower.lowerAllIndexed_eq_lowerAll' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Lower.lowerAllIndexed_eq_lowerAll + +/-- info: 'Ix.Compiler.Pipeline.ResolverIndex.resolve_ofList' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.ResolverIndex.resolve_ofList + +/-! ## Codec laws -/ + +/-- info: 'Ix.Compiler.Ixon.Address.roundtripLaw' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.Ixon.Address.roundtripLaw + +/-- info: 'Ix.Compiler.Ixon.Address.canonicalLaw' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.Ixon.Address.canonicalLaw + +/-- info: 'Ix.Compiler.Ixon.Univ.roundtripLaw' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.Ixon.Univ.roundtripLaw + +/-- info: 'Ix.Compiler.Ixon.Univ.canonicalLaw' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.Ixon.Univ.canonicalLaw + +/-- info: 'Ix.Compiler.Ixon.Expr.roundtripLaw' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.Ixon.Expr.roundtripLaw + +/-- info: 'Ix.Compiler.Ixon.Expr.canonicalLaw' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.Ixon.Expr.canonicalLaw + +/-- info: 'Ix.Compiler.Ixon.ConstantInfo.roundtripLaw' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.Ixon.ConstantInfo.roundtripLaw + +/-- info: 'Ix.Compiler.Ixon.ConstantInfo.canonicalLaw' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.Ixon.ConstantInfo.canonicalLaw + +/-- info: 'Ix.Compiler.Ixon.Constant.roundtripLaw' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.Ixon.Constant.roundtripLaw + +/-- info: 'Ix.Compiler.Ixon.Constant.canonicalLaw' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.Ixon.Constant.canonicalLaw + +/-- info: 'Ix.Compiler.IxIR0.Decl.decodePreimage_roundtrip' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.Decl.decodePreimage_roundtrip + +/-- info: 'Ix.Compiler.IxIR0.Decl.decodePreimage_canonical' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.Decl.decodePreimage_canonical + +/-- info: 'Ix.Compiler.IxIR0.Decl.preimage_injective' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.Decl.preimage_injective + +/-- info: 'Ix.Compiler.IxIR1.Decl.decodePreimage_roundtrip' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Decl.decodePreimage_roundtrip + +/-- info: 'Ix.Compiler.IxIR1.Decl.decodePreimage_canonical' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Decl.decodePreimage_canonical + +/-- info: 'Ix.Compiler.IxIR1.Decl.preimage_injective' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Decl.preimage_injective + +/-- info: 'Ix.Compiler.IxIR0.MutualBlock.Block.decodePreimage_roundtrip' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.MutualBlock.Block.decodePreimage_roundtrip + +/-- info: 'Ix.Compiler.IxIR0.MutualBlock.Block.decodePreimage_canonical' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.MutualBlock.Block.decodePreimage_canonical + +/-- info: 'Ix.Compiler.IxIR0.MutualBlock.Block.preimage_injective' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.MutualBlock.Block.preimage_injective + +/-- info: 'Ix.Compiler.IxIR1.MutualBlock.Block.decodePreimage_roundtrip' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.MutualBlock.Block.decodePreimage_roundtrip + +/-- info: 'Ix.Compiler.IxIR1.MutualBlock.Block.decodePreimage_canonical' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.MutualBlock.Block.decodePreimage_canonical + +/-- info: 'Ix.Compiler.IxIR1.MutualBlock.Block.preimage_injective' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.MutualBlock.Block.preimage_injective + +/-! ## IxIR₂ credit-counter algebra -/ + +/-- info: 'Ix.Compiler.IxIR2.Eval.CounterLaw.afterHotReset' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.CounterLaw.afterHotReset + +/-- info: 'Ix.Compiler.IxIR2.Eval.CounterLaw.afterReuse' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.CounterLaw.afterReuse + +/-- info: 'Ix.Compiler.IxIR2.Eval.CounterLaw.afterDiscard' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.CounterLaw.afterDiscard + +/-- info: 'Ix.Compiler.IxIR2.Eval.CounterLaw.terminalFrees' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.CounterLaw.terminalFrees + +/-! ## IxIR₂ structured-lowering acceptance -/ + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.headBlock_mem_blocks' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.headBlock_mem_blocks + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.blocks_subset_of_child' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.blocks_subset_of_child + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.Descendant.blocks_subset' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.Descendant.blocks_subset + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.entryValueCountMatches' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.entryValueCountMatches + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.entryValueCountsMatch' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.entryValueCountsMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.entryValueCountMatches_of_match' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.entryValueCountMatches_of_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.entryValueCount_eq_headParams_of_match' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.entryValueCount_eq_headParams_of_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.entryValueCountsMatch_of_child' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.entryValueCountsMatch_of_child + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.Descendant.entryValueCountsMatch' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.Descendant.entryValueCountsMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.inductTree' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.inductTree + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.letOpSyntax_of_match' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.letOpSyntax_of_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.operationSyntax_of_match' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.operationSyntax_of_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.letOpOperationSyntax_of_match' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.letOpOperationSyntax_of_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.retSyntax_of_match' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.retSyntax_of_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.tailCallSyntax_of_match' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.tailCallSyntax_of_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.tailCallSelfSyntax_of_match' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.tailCallSelfSyntax_of_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.switchSyntax_of_match' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.switchSyntax_of_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.syntaxMatches_of_child' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.syntaxMatches_of_child + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.Descendant.syntaxMatches' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.Descendant.syntaxMatches + +/-- info: 'Ix.Compiler.IxIR2.Lower.fetchPrologueAt_of_match' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.fetchPrologueAt_of_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.sourceAlternativeAtTag?_getElem?' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.sourceAlternativeAtTag?_getElem? + +/-- info: 'Ix.Compiler.IxIR2.Lower.sourceAlternativeAtTag?_tag' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.sourceAlternativeAtTag?_tag + +/-- info: 'Ix.Compiler.IxIR2.Lower.constructorBranchMatchAt_of_switch_match' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.constructorBranchMatchAt_of_switch_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.natZeroBranchMatchAt_of_switch_match' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.natZeroBranchMatchAt_of_switch_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.natBranchPairMatch_of_switch_match' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.natBranchPairMatch_of_switch_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.switchBranchShape_of_match' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.switchBranchShape_of_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.Descendant.switchBranchesMatch' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.Descendant.switchBranchesMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.FunctionTrace.descendantSwitchBranchesMatch' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.FunctionTrace.descendantSwitchBranchesMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.letOpMatch_of_match' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.letOpMatch_of_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.instructionAt_of_match' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.instructionAt_of_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.headBlock_eq_sourceBlock_of_match' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.headBlock_eq_sourceBlock_of_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.InputMap.forgets_of_check' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.InputMap.forgets_of_check + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.inputMapForgets_of_match' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.inputMapForgets_of_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.inputMapSize_of_match' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.inputMapSize_of_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.instructionsMatch_of_child' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.instructionsMatch_of_child + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.Descendant.instructionsMatch' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.Descendant.instructionsMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.inputMapsMatch_of_child' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.inputMapsMatch_of_child + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.Descendant.inputMapsMatch' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.Descendant.inputMapsMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.functionSourceMatch_of_match' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.functionSourceMatch_of_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.functionSourceEq_eq_true_iff' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.functionSourceEq_eq_true_iff + +/-- info: 'Ix.Compiler.IxIR2.Lower.inputEq_eq_true_iff' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.inputEq_eq_true_iff + +/-- info: 'Ix.Compiler.IxIR2.Lower.functionTraceMatch_of_match' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.functionTraceMatch_of_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.FunctionTrace.rootSourceCode' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.FunctionTrace.rootSourceCode + +/-- info: 'Ix.Compiler.IxIR2.Lower.FunctionTrace.sourceArity' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.FunctionTrace.sourceArity + +/-- info: 'Ix.Compiler.IxIR2.Lower.FunctionTrace.sourceResult' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.FunctionTrace.sourceResult + +/-- info: 'Ix.Compiler.IxIR2.Lower.FunctionTrace.sourcePapSafe' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.FunctionTrace.sourcePapSafe + +/-- info: 'Ix.Compiler.IxIR2.Lower.FunctionTrace.entryBlock' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.FunctionTrace.entryBlock + +/-- info: 'Ix.Compiler.IxIR2.Lower.FunctionTrace.entryPc' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.FunctionTrace.entryPc + +/-- info: 'Ix.Compiler.IxIR2.Lower.FunctionTrace.entryValueCount' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.FunctionTrace.entryValueCount + +/-- info: 'Ix.Compiler.IxIR2.Lower.FunctionTrace.entryInput' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.FunctionTrace.entryInput + +/-- info: 'Ix.Compiler.IxIR2.Lower.FunctionTrace.rootHeadBlock' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.FunctionTrace.rootHeadBlock + +/-- info: 'Ix.Compiler.IxIR2.Lower.Artifact.mainOwner' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Artifact.mainOwner + +/-- info: 'Ix.Compiler.IxIR2.Lower.Artifact.mainSource' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Artifact.mainSource + +/-- info: 'Ix.Compiler.IxIR2.Lower.Artifact.mainGenerated' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Artifact.mainGenerated + +/-- info: 'Ix.Compiler.IxIR2.Lower.Artifact.mainArity' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Artifact.mainArity + +/-- info: 'Ix.Compiler.IxIR2.Lower.Artifact.mainRootSourceCode' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Artifact.mainRootSourceCode + +/-- info: 'Ix.Compiler.IxIR2.Lower.Artifact.mainEntryInput' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Artifact.mainEntryInput + +/-- info: 'Ix.Compiler.IxIR2.Lower.Artifact.mainHeadBlockAt' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Artifact.mainHeadBlockAt + +/-- info: 'Ix.Compiler.IxIR2.Lower.Artifact.mainNonempty' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Artifact.mainNonempty + +/-- info: 'Ix.Compiler.IxIR2.Lower.FunctionTrace.blockAt' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.FunctionTrace.blockAt + +/-- info: 'Ix.Compiler.IxIR2.Lower.FunctionTrace.blockAt_of_mem' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.FunctionTrace.blockAt_of_mem + +/-- info: 'Ix.Compiler.IxIR2.Lower.FunctionTrace.headBlockAt' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.FunctionTrace.headBlockAt + +/-- info: 'Ix.Compiler.IxIR2.Lower.FunctionTrace.descendantHeadBlockAt' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.FunctionTrace.descendantHeadBlockAt + +/-- info: 'Ix.Compiler.IxIR2.Lower.FunctionTrace.descendantInstructionsMatch' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.FunctionTrace.descendantInstructionsMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.FunctionTrace.descendantInputMapsMatch' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.FunctionTrace.descendantInputMapsMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.FunctionTrace.descendantEntryValueCount' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.FunctionTrace.descendantEntryValueCount + +/-- info: 'Ix.Compiler.IxIR2.Lower.FunctionTrace.descendantSyntaxMatches' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.FunctionTrace.descendantSyntaxMatches + +/-- info: 'Ix.Compiler.IxIR2.Lower.FunctionTrace.descendantOperationSyntax' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.FunctionTrace.descendantOperationSyntax + +/-- info: 'Ix.Compiler.IxIR2.Lower.FunctionTrace.generatedNonempty' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.FunctionTrace.generatedNonempty + +/-- info: 'Ix.Compiler.IxIR2.Lower.FunctionTrace.descendantLetOpMatch' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.FunctionTrace.descendantLetOpMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.programTraceOrder_of_match' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.programTraceOrder_of_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.Artifact.functionTrace_of_source_mem' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Artifact.functionTrace_of_source_mem + +/-- info: 'Ix.Compiler.IxIR2.Lower.Checked.valid' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Checked.valid + +/-- info: 'Ix.Compiler.IxIR2.Lower.CheckedRun.valid' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CheckedRun.valid + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.resolveAtom_of_envRel' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.resolveAtom_of_envRel + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.resolveAtom_of_envRel_target' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.resolveAtom_of_envRel_target + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.StoreRel.initial' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.StoreRel.initial + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.EnvRel.empty' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.EnvRel.empty + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.CodeStateRel.blockAt' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.CodeStateRel.blockAt + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.CodeStateRel.instructionAt' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.CodeStateRel.instructionAt + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.CodeStateRel.letOpNext' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.CodeStateRel.letOpNext + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.EnvRel.forget' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.EnvRel.forget + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.EnvRel.forgetTracedValue' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.EnvRel.forgetTracedValue + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.EnvRel.forgetTracedErased' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.EnvRel.forgetTracedErased + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.EnvRel.entry' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.EnvRel.entry + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.functionEntryCodeState' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.functionEntryCodeState + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.initialMainState' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.initialMainState + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.initialMainCodeState' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.initialMainCodeState + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.runMain_eq_initialMainMachine' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.runMain_eq_initialMainMachine + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.resolveAtom_shift' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.resolveAtom_shift + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.EnvRel.sourceMapOf' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.EnvRel.sourceMapOf + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.EnvRel.constructorFields' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.EnvRel.constructorFields + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_edge_transfer' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_edge_transfer + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.resolvedAtoms_of_resolveAtoms' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.resolvedAtoms_of_resolveAtoms + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.resolveAtoms_exists_of_pointwise' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.resolveAtoms_exists_of_pointwise + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.ResolvedAtomsList.getElem?' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.ResolvedAtomsList.getElem? + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.EnvRel.of_edge_arguments' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.EnvRel.of_edge_arguments + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_edge_transfer_from_parent' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_edge_transfer_from_parent + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.EdgeArgsRel.canonical' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.EdgeArgsRel.canonical + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_generated_edge_transfer' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_generated_edge_transfer + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.edgeRuntimeReady_of_envRel' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.edgeRuntimeReady_of_envRel + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.move' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.move + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.resolveAtoms_of_envRel' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.resolveAtoms_of_envRel + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.resolveAtoms_of_envRel_target' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.resolveAtoms_of_envRel_target + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.atomsRel_of_translateAtoms' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.atomsRel_of_translateAtoms + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.EnvRel.bindValue' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.EnvRel.bindValue + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.CodeStateRel.letOpValueNext' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.CodeStateRel.letOpValueNext + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_pure_move' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_pure_move + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_pure_move' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_pure_move + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_pure_move_state' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_pure_move_state + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_pure_move_success_step' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_pure_move_success_step + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.alloc' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.alloc + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.StoreRel.alloc' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.StoreRel.alloc + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_alloc' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_alloc + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_alloc_state' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_alloc_state + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.pappFn' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.pappFn + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_papp_fn' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_papp_fn + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_papp_fn_state' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_papp_fn_state + +/-- info: 'Ix.Compiler.IxIR2.Eval.RetainSharedMany.empty' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.RetainSharedMany.empty + +/-- info: 'Ix.Compiler.IxIR2.Eval.RetainSharedMany.cons' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.RetainSharedMany.cons + +/-- info: 'Ix.Compiler.IxIR2.Eval.RetainSharedMany.cons_inv' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.RetainSharedMany.cons_inv + +/-- info: 'Ix.Compiler.IxIR2.Eval.ApplyTransfer.erased' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.ApplyTransfer.erased + +/-- info: 'Ix.Compiler.IxIR2.Eval.ApplyTransfer.papUnder' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.ApplyTransfer.papUnder + +/-- info: 'Ix.Compiler.IxIR2.Eval.ApplyTransfer.papFn' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.ApplyTransfer.papFn + +/-- info: 'Ix.Compiler.IxIR2.Eval.ApplyTransfer.papExtern' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.ApplyTransfer.papExtern + +/-- info: 'Ix.Compiler.IxIR2.Eval.ApplyTransferCase.transfer' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.ApplyTransferCase.transfer + +/-- info: 'Ix.Compiler.IxIR2.Eval.ApplyTransfer.classify' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.ApplyTransfer.classify + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.apply' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.apply + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.retApplyMore' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.retApplyMore + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.dupVals_simulates_retainSharedMany' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.dupVals_simulates_retainSharedMany + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.empty' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.empty + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.positiveSharedRC' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.positiveSharedRC + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.resolveAtom' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.resolveAtom + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.resolveAtoms' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.resolveAtoms + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.resolveAtomsReverse' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.resolveAtomsReverse + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.constructorBranch' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.constructorBranch + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.natSuccessor' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.natSuccessor + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.runCode' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.runCode + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.runOp' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.runOp + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.invoke' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.invoke + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.applyGo' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.applyGo + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.runCodeNoReuse' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.runCodeNoReuse + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.runOpNoReuse' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.runOpNoReuse + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.invokeNoReuse' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.invokeNoReuse + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.applyGoNoReuse' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceRuntimeInvariant.applyGoNoReuse + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.PositiveSharedRC.dupVals' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.PositiveSharedRC.dupVals + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_apply_pap_prepare' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_apply_pap_prepare + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_applyGo_erased' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_applyGo_erased + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_applyGo_pap_under' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_applyGo_pap_under + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_applyGo_pap_saturated_enter' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_applyGo_pap_saturated_enter + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_applyGo_pap_over_enter' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_applyGo_pap_over_enter + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_apply_pap_under' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_apply_pap_under + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_apply_pap_saturated_enter' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_apply_pap_saturated_enter + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_apply_pap_over_enter' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_apply_pap_over_enter + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_apply_transfer_state' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_apply_transfer_state + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_apply_pap_saturated_enter_state' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_apply_pap_saturated_enter_state + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_apply_pap_over_enter_state' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_apply_pap_over_enter_state + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_ret_apply_more' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_ret_apply_more + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_ret_apply_more_state' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_ret_apply_more_state + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.source_runOp_call_eq' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.source_runOp_call_eq + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.source_runOp_callSelf_eq' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.source_runOp_callSelf_eq + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.source_runCode_tail_call_eq' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.source_runCode_tail_call_eq + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.source_runCode_tail_callSelf_eq' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.source_runCode_tail_callSelf_eq + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_call_fn_enter' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_call_fn_enter + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_call_fn_enter_state' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_call_fn_enter_state + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_call_self_enter' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_call_self_enter + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_tail_call_fn_enter' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_tail_call_fn_enter + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_tail_call_fn_enter_state' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_tail_call_fn_enter_state + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_tail_call_self_enter' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_tail_call_self_enter + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_call_fn_enter_source_state' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_call_fn_enter_source_state + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_call_self_enter_source_state' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_call_self_enter_source_state + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_tail_call_fn_enter_source_state' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_tail_call_fn_enter_source_state + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_tail_call_self_enter_source_state' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_tail_call_self_enter_source_state + +/-- info: 'Ix.Compiler.IxIR2.Eval.Steps.trans' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Steps.trans + +/-- info: 'Ix.Compiler.IxIR2.Eval.initialMachine_store_empty' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.initialMachine_store_empty + +/-- info: 'Ix.Compiler.IxIR2.Eval.runFunction_eq_runMachine' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.runFunction_eq_runMachine + +/-- info: 'Ix.Compiler.IxIR2.Eval.runMain_eq_runMachine' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.runMain_eq_runMachine + +/-- info: 'Ix.Compiler.IxIR2.Eval.Steps.runMachine' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Steps.runMachine + +/-- info: 'Ix.Compiler.IxIR2.Eval.Steps.runMachine_halted' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Steps.runMachine_halted + +/-! The credit-aware evaluator proof seam used by reuse-insertion proofs. -/ + +/-- info: 'Ix.Compiler.IxIR2.Eval.CreditLookup.of_getElem' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.CreditLookup.of_getElem + +/-- info: 'Ix.Compiler.IxIR2.Eval.CreditTake.of_lookup' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.CreditTake.of_lookup + +/-- info: 'Ix.Compiler.IxIR2.Eval.CreditTakeMany.single' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.CreditTakeMany.single + +/-- info: 'Ix.Compiler.IxIR2.Eval.ConstructorView.of_box' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.ConstructorView.of_box + +/-- info: 'Ix.Compiler.IxIR2.Eval.ConstructorView.parts' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.ConstructorView.parts + +/-- info: 'Ix.Compiler.IxIR2.Eval.EdgeTransfer.of_parts' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.EdgeTransfer.of_parts + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.branchCreditPresent' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.branchCreditPresent + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.branchCreditAbsent' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.branchCreditAbsent + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.allocWithAbsent' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.allocWithAbsent + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.allocWithLogical' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.allocWithLogical + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.allocWithPhysical' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.allocWithPhysical + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.discardCreditAbsent' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.discardCreditAbsent + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.discardCreditLogical' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.discardCreditLogical + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.discardCreditPhysical' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.discardCreditPhysical + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.takeUniqueLogical' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.takeUniqueLogical + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.takeUniquePhysical' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.takeUniquePhysical + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.resetSharedLogicalHot' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.resetSharedLogicalHot + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.resetSharedPhysicalHot' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.resetSharedPhysicalHot + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.resetSharedCold' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.resetSharedCold + +/-- info: 'Ix.Compiler.IxIR2.Eval.EdgeTransfer.baseline' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.EdgeTransfer.baseline + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.jump' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.jump + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.switchCtor' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.switchCtor + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.switchNatZero' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.switchNatZero + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.switchNatSucc' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.switchNatSucc + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.callFn' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.callFn + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.callSelf' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.callSelf + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.tailCallFn' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.tailCallFn + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.tailCallSelf' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.tailCallSelf + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.tailCallSelfCleared' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.tailCallSelfCleared + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.retResumeCleared' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.retResumeCleared + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.retHaltCleared' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.retHaltCleared + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.retApplyMoreCleared' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.retApplyMoreCleared + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.tailCallFnCleared' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.tailCallFnCleared + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.callFnCleared' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.callFnCleared + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.callSelfCleared' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.callSelfCleared + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.pappFnCleared' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.pappFnCleared + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.pappExternCleared' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.pappExternCleared + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.externCleared' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.externCleared + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.applyCleared' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.applyCleared + +/-- info: 'Ix.Compiler.IxIR2.Eval.InstructionTransferCase.step' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.InstructionTransferCase.step + +/-- info: 'Ix.Compiler.IxIR2.Eval.InstructionTransfer.classify' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.InstructionTransfer.classify + +/-- info: 'Ix.Compiler.IxIR2.Eval.TerminatorTransferCase.step' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.TerminatorTransferCase.step + +/-- info: 'Ix.Compiler.IxIR2.Eval.TerminatorTransfer.classify' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.TerminatorTransfer.classify + +/-- info: 'Ix.Compiler.IxIR2.Eval.StepCase.step' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.StepCase.step + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.classify' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.classify + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.retResume' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.retResume + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_letOp_continuation' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_letOp_continuation + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_case_ctor_branch' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_case_ctor_branch + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_case_nat_zero_branch' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_case_nat_zero_branch + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_case_nat_succ_branch' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_case_nat_succ_branch + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_fetch_prologue' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_fetch_prologue + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_switch_ctor_state' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_switch_ctor_state + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_switch_nat_zero_state' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_switch_nat_zero_state + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_switch_nat_succ_state' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_switch_nat_succ_state + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_ret_resume' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_ret_resume + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_ret_resume_state' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_ret_resume_state + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_return_to_letOp_state' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_return_to_letOp_state + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.retHalt' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.retHalt + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_ret_halt' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_ret_halt + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_ret_halt_state' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_ret_halt_state + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_ret_halt_success' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_ret_halt_success + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_ret_halt_runMachine' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_ret_halt_runMachine + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.retainShared' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.retainShared + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.StoreRel.rcTick' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.StoreRel.rcTick + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_dup_retain_scalar' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_dup_retain_scalar + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_dup_retain_shared' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_dup_retain_shared + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.fetch' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.fetch + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_fetch' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_fetch + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_fetch_state' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_fetch_state + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.releaseShared' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.releaseShared + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.freeUnique' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.freeUnique + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.StoreRel.kill' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.StoreRel.kill + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.releaseShared_of_scalar' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.releaseShared_of_scalar + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.EnvRel.bindErased' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.EnvRel.bindErased + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_drop_release_scalar' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_drop_release_scalar + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_free_freeUnique' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_free_freeUnique + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_free_freeUnique_state' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_free_freeUnique_state + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.dropUnique' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.dropUnique + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.dropUnique_of_scalar' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.dropUnique_of_scalar + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_dropU_dropUnique_scalar' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_dropU_dropUnique_scalar + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_drop_release_shared_nonunit' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_drop_release_shared_nonunit + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.sourceDropMany_of_scalars' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.sourceDropMany_of_scalars + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.sourceDropManyU_of_scalars' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.sourceDropManyU_of_scalars + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.releaseSharedWork_of_scalars' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.releaseSharedWork_of_scalars + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.dropUniqueWork_of_scalars' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.dropUniqueWork_of_scalars + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_dropU_dropUnique_scalar_ctor' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_dropU_dropUnique_scalar_ctor + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_drop_release_shared_unit_scalar_ctor' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_drop_release_shared_unit_scalar_ctor + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.dropUniqueWork_append' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.dropUniqueWork_append + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.uniqueDropWork_simulation' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.uniqueDropWork_simulation + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.dropUVal_simulates_dropUniqueWork' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.dropUVal_simulates_dropUniqueWork + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.dropManyU_simulates_dropUniqueWork' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.dropManyU_simulates_dropUniqueWork + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_dropU_dropUnique_recursive' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_dropU_dropUnique_recursive + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_dropU_dropUnique_recursive_state' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_dropU_dropUnique_recursive_state + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.releaseSharedWork_append' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.releaseSharedWork_append + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.releaseSharedWork_success_unique' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.releaseSharedWork_success_unique + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.sharedReleaseWork_simulation' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.sharedReleaseWork_simulation + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.dropVal_simulates_releaseSharedWork' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.dropVal_simulates_releaseSharedWork + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.dropMany_simulates_releaseSharedWork' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.dropMany_simulates_releaseSharedWork + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_drop_release_recursive' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_drop_release_recursive + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_drop_release_recursive_state' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_drop_release_recursive_state + +/-- info: 'Ix.Compiler.IxIR2.Eval.FieldWorlds.of_replicate' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.FieldWorlds.of_replicate + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.StoreRel.hasWorld_eq_true_iff' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.StoreRel.hasWorld_eq_true_iff + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.StoreRel.fieldWorlds_replicate' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.StoreRel.fieldWorlds_replicate + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.StoreRel.fieldWorlds_replicate_of_ownership' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.StoreRel.fieldWorlds_replicate_of_ownership + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.CodeStateRel.resultWorld' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.CodeStateRel.resultWorld + +/-- info: 'Ix.Compiler.IxIR2.Lower.ProgramTraceOrder.main_of_mem_owner' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.ProgramTraceOrder.main_of_mem_owner + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.functionTraceSource_eq_of_match' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.functionTraceSource_eq_of_match + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.codeScalarLeavesMatch_of_child' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.codeScalarLeavesMatch_of_child + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.codeScalarLeavesMatch_descendant' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.codeScalarLeavesMatch_descendant + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.functionCodeScalarLeavesMatch' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.functionCodeScalarLeavesMatch + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.scalarLeafAt?_of_codeScalarLeavesMatch' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.scalarLeafAt?_of_codeScalarLeavesMatch + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.codeExactFetchesMatch_of_child' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.codeExactFetchesMatch_of_child + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.codeExactFetchesMatch_descendant' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.codeExactFetchesMatch_descendant + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.functionCodeExactFetchesMatch' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.functionCodeExactFetchesMatch + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.exactConstructorAt?_of_codeExactFetchesMatch' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.exactConstructorAt?_of_codeExactFetchesMatch + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.mainAnalysisCurrentCompatible' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.mainAnalysisCurrentCompatible + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.functionTraceAnalysisCurrentCompatible' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.functionTraceAnalysisCurrentCompatible + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.functionTraceAnalysisCurrent' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.functionTraceAnalysisCurrent + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.exactConstructorAt?_of_fetch_descendant' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.exactConstructorAt?_of_fetch_descendant + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.scalarLeafAt?_of_free_descendant' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.scalarLeafAt?_of_free_descendant + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.schema_fields_replicate' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.schema_fields_replicate + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.schema_fields_replicate' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.schema_fields_replicate + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.siteFacts?_next' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.siteFacts?_next + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.sourceCodeAt?_next' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.sourceCodeAt?_next + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.sourceCodeAt?_alternative' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.sourceCodeAt?_alternative + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.sourceCodeAt?_root' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.sourceCodeAt?_root + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.sourceCodeAt?_main' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.sourceCodeAt?_main + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.siteFacts?_sourceCodeAt' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.siteFacts?_sourceCodeAt + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.siteFacts?_alternative_of_sourceCodeAt' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.siteFacts?_alternative_of_sourceCodeAt + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.siteEnvironmentHolds_root' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.siteEnvironmentHolds_root + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.siteEnvironmentHolds_main' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.siteEnvironmentHolds_main + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.siteEnvironmentHolds_alternative_ctor' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.siteEnvironmentHolds_alternative_ctor + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.siteEnvironmentHolds_alternative_natZero' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.siteEnvironmentHolds_alternative_natZero + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.siteEnvironmentHolds_alternative_natSucc' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.siteEnvironmentHolds_alternative_natSucc + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.siteEnvironmentHolds_next' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.siteEnvironmentHolds_next + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.siteEnvironmentHolds_next_of_currentCompatible' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.siteEnvironmentHolds_next_of_currentCompatible + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.exactConstructorAt?_eq_some' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.exactConstructorAt?_eq_some + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.exactConstructorAt?_runtime' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.exactConstructorAt?_runtime + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.exactConstructorAt?_matches_node' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.exactConstructorAt?_matches_node + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.scalarLeafAt?_eq_some' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.scalarLeafAt?_eq_some + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.scalarLeafAt?_runtime' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.scalarLeafAt?_runtime + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.scalarLeafAt?_matches_node' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.scalarLeafAt?_matches_node + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.simulate_traced_free_freeUnique_state_hpt' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.simulate_traced_free_freeUnique_state_hpt + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.simulate_traced_fetch_state_hpt' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.simulate_traced_fetch_state_hpt + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.simulate_traced_fetch_state_of_run_hpt' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.simulate_traced_fetch_state_of_run_hpt + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.simulate_traced_free_freeUnique_state_of_run_hpt' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.simulate_traced_free_freeUnique_state_of_run_hpt + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.sourceCodeAt?_functionRoot' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.sourceCodeAt?_functionRoot + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.functionEntryTraceState' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.functionEntryTraceState + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.declarationFunctionEntryTraceState' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.declarationFunctionEntryTraceState + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.mainFunctionEntryTraceState' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.mainFunctionEntryTraceState + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.functionEntryTraceState' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.functionEntryTraceState + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.initialMainTraceState' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.initialMainTraceState + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.initialMainSourceOwnership' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.initialMainSourceOwnership + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.traceState_next' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.traceState_next + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.traceState_next_of_member' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.traceState_next_of_member + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.mainTraceState_next' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.mainTraceState_next + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_apply_transfer_state' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_apply_transfer_state + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_apply_erased_state' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_apply_erased_state + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_apply_pap_under_state' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_apply_pap_under_state + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_apply_pap_saturated_enter_state' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_apply_pap_saturated_enter_state + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_apply_pap_over_enter_state' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_apply_pap_over_enter_state + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_ret_apply_more_success' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_ret_apply_more_success + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_ret_apply_more_pap_saturated_enter_state' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_ret_apply_more_pap_saturated_enter_state + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_ret_apply_more_pap_over_enter_state' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_ret_apply_more_pap_over_enter_state + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_ret_apply_more_pap_under_state' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_ret_apply_more_pap_under_state + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_ret_apply_more_erased_state' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_ret_apply_more_erased_state + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_call_fn_enter_state' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_call_fn_enter_state + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_call_self_enter_state' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_call_self_enter_state + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_tail_call_fn_enter_state' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_tail_call_fn_enter_state + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_tail_call_self_enter_state' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_tail_call_self_enter_state + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_return_to_letOp_state' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_return_to_letOp_state + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_ret_halt_success' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_ret_halt_success + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_pure_move_state' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_pure_move_state + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_pure_move_success_step' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_pure_move_success_step + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_alloc_checked_state' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_alloc_checked_state + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_alloc_checked_success_step' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_alloc_checked_success_step + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_dup_retain_scalar_state' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_dup_retain_scalar_state + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_dup_retain_shared_state' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_dup_retain_shared_state + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_drop_release_scalar_state' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_drop_release_scalar_state + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_dropU_dropUnique_scalar_state' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_dropU_dropUnique_scalar_state + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_dropU_dropUnique_recursive_state' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_dropU_dropUnique_recursive_state + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_drop_release_recursive_state' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_drop_release_recursive_state + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_papp_fn_state' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_papp_fn_state + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_fetch_state_of_run_hpt' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_fetch_state_of_run_hpt + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_free_freeUnique_state_of_run_hpt' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_free_freeUnique_state_of_run_hpt + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.TraceStateRel.next' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.TraceStateRel.next + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.TraceStateRel.constructorChild' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.TraceStateRel.constructorChild + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.TraceStateRel.natZeroChild' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.TraceStateRel.natZeroChild + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.TraceStateRel.natSuccChild' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.TraceStateRel.natSuccChild + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.simulate_traced_switch_ctor_state_hpt' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.simulate_traced_switch_ctor_state_hpt + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.simulate_traced_switch_nat_zero_state_hpt' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.simulate_traced_switch_nat_zero_state_hpt + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.simulate_traced_switch_nat_succ_state_hpt' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.simulate_traced_switch_nat_succ_state_hpt + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.hptPostFixpoint' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.hptPostFixpoint + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.hptLocalPostFixpoint' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.hptLocalPostFixpoint + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.sidecarDeclarationEnvironment' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.sidecarDeclarationEnvironment + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.hptSidecarLocalPostFixpoint' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.hptSidecarLocalPostFixpoint + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.siteEnvironmentHolds_next' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.siteEnvironmentHolds_next + +/-- info: 'Ix.Compiler.IxIR1.resolveAtoms_length' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.resolveAtoms_length + +/-- info: 'Ix.Compiler.IxIR1.runCode_ret_success' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.runCode_ret_success + +/-- info: 'Ix.Compiler.IxIR1.runCode_letOp_success' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.runCode_letOp_success + +/-- info: 'Ix.Compiler.IxIR1.runOp_pure_success' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.runOp_pure_success + +/-- info: 'Ix.Compiler.IxIR1.runOp_alloc_success' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.runOp_alloc_success + +/-- info: 'Ix.Compiler.IxIR1.runOp_free_success' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.runOp_free_success + +/-- info: 'Ix.Compiler.IxIR1.runOp_fetch_success' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.runOp_fetch_success + +/-- info: 'Ix.Compiler.IxIR1.runOp_reuse_success' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.runOp_reuse_success + +/-- info: 'Ix.Compiler.IxIR1.runOp_dup_success' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.runOp_dup_success + +/-- info: 'Ix.Compiler.IxIR1.runOp_drop_success' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.runOp_drop_success + +/-- info: 'Ix.Compiler.IxIR1.runOp_dropU_success' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.runOp_dropU_success + +/-- info: 'Ix.Compiler.IxIR1.runOp_call_success' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.runOp_call_success + +/-- info: 'Ix.Compiler.IxIR1.runOp_callSelf_success' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.runOp_callSelf_success + +/-- info: 'Ix.Compiler.IxIR1.runOp_papp_success' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.runOp_papp_success + +/-- info: 'Ix.Compiler.IxIR1.runOp_apply_success' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.runOp_apply_success + +/-- info: 'Ix.Compiler.IxIR1.runOp_extern_success' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.runOp_extern_success + +/-- info: 'Ix.Compiler.IxIR1.invoke_success' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.invoke_success + +/-- info: 'Ix.Compiler.IxIR1.runCode_case_success' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.runCode_case_success + +/-- info: 'Ix.Compiler.IxIR2.Lower.sourceAlternativeAtTag?_map_fst' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.sourceAlternativeAtTag?_map_fst + +/-- info: 'Ix.Compiler.IxIR2.Lower.sourceAlternativeAtTag?_of_find?' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.sourceAlternativeAtTag?_of_find? + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.indexedCaseSuccess_of_run' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.indexedCaseSuccess_of_run + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.allocationSchema_of_match' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.allocationSchema_of_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.Descendant.allocationSchemasMatch' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.Descendant.allocationSchemasMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.Trace.functionAllocationSchemasMatch' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Trace.functionAllocationSchemasMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.Checked.allocationSchema' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Checked.allocationSchema + +/-- info: 'Ix.Compiler.IxIR2.Lower.Checked.allocationSchemaFields' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Checked.allocationSchemaFields + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.allocationPosition_of_capabilities_match' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.allocationPosition_of_capabilities_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.PositionTrace.sourceCapabilities_size_of_coordinateMatch' depends on axioms: [propext, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.PositionTrace.sourceCapabilities_size_of_coordinateMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.positionMatches_of_positionsMatch' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.positionMatches_of_positionsMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.position_of_positionsMatch' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.position_of_positionsMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.positionsMatch_of_child' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.positionsMatch_of_child + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.Descendant.positionsMatch' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.Descendant.positionsMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.Trace.functionPositionsMatch' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Trace.functionPositionsMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.Checked.position' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Checked.position + +/-- info: 'Ix.Compiler.IxIR2.Lower.BindingCap.matchesParameter' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.BindingCap.matchesParameter + +/-- info: 'Ix.Compiler.IxIR2.Lower.PositionTrace.parameterCapabilitiesMatch' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.PositionTrace.parameterCapabilitiesMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.PositionTrace.capability_of_parameterCapabilitiesMatch' depends on axioms: [propext, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.PositionTrace.capability_of_parameterCapabilitiesMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.PositionTrace.owned_of_parameterCapabilitiesMatch' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.PositionTrace.owned_of_parameterCapabilitiesMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.parameterCapabilitiesMatch' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.parameterCapabilitiesMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.positionParameterCapabilitiesMatch_of_match' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.positionParameterCapabilitiesMatch_of_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.positionParameterCapabilities_of_match' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.positionParameterCapabilities_of_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.parameterCapabilitiesMatch_of_child' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.parameterCapabilitiesMatch_of_child + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.Descendant.parameterCapabilitiesMatch' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.Descendant.parameterCapabilitiesMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.Trace.functionParameterCapabilitiesMatch' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Trace.functionParameterCapabilitiesMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.Checked.ownedParameterCapability' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Checked.ownedParameterCapability + +/-- info: 'Ix.Compiler.IxIR2.Lower.Checked.parameterCapability' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Checked.parameterCapability + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.pureTransition_of_match' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.pureTransition_of_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.pureCapabilitiesMatch_of_child' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.pureCapabilitiesMatch_of_child + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.Descendant.pureCapabilitiesMatch' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.Descendant.pureCapabilitiesMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.Trace.functionPureCapabilitiesMatch' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Trace.functionPureCapabilitiesMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.Checked.pureTransition' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Checked.pureTransition + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.dupTransition_of_match' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.dupTransition_of_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.dupCapabilitiesMatch_of_child' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.dupCapabilitiesMatch_of_child + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.Descendant.dupCapabilitiesMatch' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.Descendant.dupCapabilitiesMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.Trace.functionDupCapabilitiesMatch' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Trace.functionDupCapabilitiesMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.Checked.dupTransition' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Checked.dupTransition + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.fetchTransition_of_match' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.fetchTransition_of_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.fetchCapabilitiesMatch_of_child' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.fetchCapabilitiesMatch_of_child + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.Descendant.fetchCapabilitiesMatch' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.Descendant.fetchCapabilitiesMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.Trace.functionFetchCapabilitiesMatch' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Trace.functionFetchCapabilitiesMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.Checked.fetchTransition' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Checked.fetchTransition + +/-- info: 'Ix.Compiler.IxIR2.Lower.retireOwnerCapabilities?_size' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.retireOwnerCapabilities?_size + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.destructionTransition_of_match' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.destructionTransition_of_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.Checked.destructionTransition' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Checked.destructionTransition + +/-- info: 'Ix.Compiler.IxIR2.Lower.consumeCapability?_size' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.consumeCapability?_size + +/-- info: 'Ix.Compiler.IxIR2.Lower.consumeCapabilitiesList?_size' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.consumeCapabilitiesList?_size + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.allocationTransition_of_capabilities_match' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.allocationTransition_of_capabilities_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.Checked.allocationTransition' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Checked.allocationTransition + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.pappTransition_of_capabilities_match' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.pappTransition_of_capabilities_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.Checked.pappTransition' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Checked.pappTransition + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.callTransition_of_capabilities_match' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.callTransition_of_capabilities_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.callSelfTransition_of_capabilities_match' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.callSelfTransition_of_capabilities_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.Checked.callTransition' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Checked.callTransition + +/-- info: 'Ix.Compiler.IxIR2.Lower.Checked.callSelfTransition' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Checked.callSelfTransition + +/-- info: 'Ix.Compiler.IxIR2.Lower.PositionTrace.sourceCapabilities_size_of_allocationMatch' depends on axioms: [propext, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.PositionTrace.sourceCapabilities_size_of_allocationMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.PositionTrace.coordinateMatches_of_allocationMatch' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.PositionTrace.coordinateMatches_of_allocationMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.PositionTrace.sourceCapability_canConsume_of_allocationMatch' depends on axioms: [propext, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.PositionTrace.sourceCapability_canConsume_of_allocationMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.allocationCapabilitiesMatch_of_child' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.allocationCapabilitiesMatch_of_child + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.Descendant.allocationCapabilitiesMatch' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.Descendant.allocationCapabilitiesMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.Trace.functionAllocationCapabilitiesMatch' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Trace.functionAllocationCapabilitiesMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.Checked.allocationPosition' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Checked.allocationPosition + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.empty' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.empty + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.empty' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.empty + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.rootsForCapabilities_setDead_perm' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.rootsForCapabilities_setDead_perm + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.rootsForCapabilities_owned_mem' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.rootsForCapabilities_owned_mem + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.focusOwned' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.focusOwned + +/-- info: 'Ix.Compiler.IxIR2.Lower.PositionTrace.inputReg_of_owned_coordinateMatch' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.PositionTrace.inputReg_of_owned_coordinateMatch + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.OwnedInputRegisters.ofCoordinate' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.OwnedInputRegisters.ofCoordinate + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.BorrowSupport.hasWorld' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.BorrowSupport.hasWorld + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.BorrowSupport.monoStore' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.BorrowSupport.monoStore + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.BorrowSupport.ofRestricts' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.BorrowSupport.ofRestricts + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.BorrowProvenance.hasWorld' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.BorrowProvenance.hasWorld + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.BorrowProvenance.ofRestricts' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.BorrowProvenance.ofRestricts + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.move' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.move + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.pure' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.pure + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.CapabilityHolds.incRcStore' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.CapabilityHolds.incRcStore + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.dup' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.dup + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.dup' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.dup + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.fetch' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.fetch + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.fetch' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.fetch + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.CapabilityHolds.allocNode' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.CapabilityHolds.allocNode + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.allocationReadyOwnership' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.allocationReadyOwnership + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.alloc' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.alloc + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.alloc' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.alloc + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.papp' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.papp + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.papp' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.papp + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.drop' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.drop + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.dropU' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.dropU + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.free' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.free + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.drop' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.drop + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.dropU' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.dropU + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.free' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.free + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.RootOwnership_reworldHead' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.RootOwnership_reworldHead + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.callEntryInvariant' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.callEntryInvariant + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.callResultInvariant' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.callResultInvariant + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.callEntry' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.callEntry + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.callSelfEntry' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.callSelfEntry + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.tailCallEntry' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.tailCallEntry + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.tailCallSelfEntry' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.tailCallSelfEntry + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.returnRoot' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.returnRoot + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.callResult' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.callResult + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.callSelfResult' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipAt.callSelfResult + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.hasWorld_of_canConsume' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.hasWorld_of_canConsume + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.resolveAtom_hasWorld' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.resolveAtom_hasWorld + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.resolveAtoms_hasWorld' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.resolveAtoms_hasWorld + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.StoreRel.fieldWorlds_of_checked_allocation' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.StoreRel.fieldWorlds_of_checked_allocation + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.StoreRel.fieldWorlds_of_checked_allocation_capabilities' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.StoreRel.fieldWorlds_of_checked_allocation_capabilities + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_alloc_checked_state' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_alloc_checked_state + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_alloc_checked_success_step' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.simulate_traced_alloc_checked_success_step + +/-! The continuation-passing whole-trace worker layer stays on the same +audited attachment boundary. Its finite-step algebra itself needs only +propositional extensionality; attachment-facing cases additionally inherit +the already fenced checked-hash and HPT dependencies. -/ + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.ReachesPost.refl' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.ReachesPost.refl + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.ReachesPost.prepend' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.ReachesPost.prepend + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.ReachesPost.step' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.ReachesPost.step + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.BudgetedReachesPost.prependPreserving' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.BudgetedReachesPost.prependPreserving + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.BudgetedReachesPost.prependFramed' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.BudgetedReachesPost.prependFramed + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.successfulTraceSimulationAt_zero' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.successfulTraceSimulationAt_zero + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.haltReturnHandler' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.haltReturnHandler + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_pure_move_cps' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_pure_move_cps + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_dup_retain_cps' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_dup_retain_cps + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_fetch_cps' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_fetch_cps + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_free_freeUnique_cps' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_free_freeUnique_cps + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_alloc_checked_cps' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_alloc_checked_cps + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_papp_fn_cps' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_papp_fn_cps + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_call_fn_cps' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_call_fn_cps + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_call_self_cps' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_call_self_cps + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_tail_call_fn_cps' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_tail_call_fn_cps + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_tail_call_self_cps' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_tail_call_self_cps + +/-! Recursive dynamic application composes every return-time dispatcher shape +through the smaller-fuel trace worker. -/ + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.functionTrace_of_source_declaration' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.functionTrace_of_source_declaration + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.applyMorePlan_of_applyGo' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.applyMorePlan_of_applyGo + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_ret_apply_more_pap_over_cps' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_ret_apply_more_pap_over_cps + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_apply_pap_over_cps' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_apply_pap_over_cps + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.applyMoreReturnHandler_of_plan' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.applyMoreReturnHandler_of_plan + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.applyMoreReturnHandler_of_applyGo' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.applyMoreReturnHandler_of_applyGo + +/-! The validated raw ownership contract crosses final readdressing for the +exact heap image generated by compiled executions. Syntax reflection and the +worker's `SourceStoreImage` invariant retain that image through every source +operation and PAP-entry intermediate, so no arbitrary-final-heap contract is +exposed by the end-to-end interface. -/ + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulationSourceContext_eq_addressedCtx' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulationSourceContext_eq_addressedCtx + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.sourceContextRenames' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.sourceContextRenames + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.rawApplyOwnership' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.rawApplyOwnership + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.applyGo_exactImage' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.applyGo_exactImage + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.sourceRebuildSemanticAudit' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.sourceRebuildSemanticAudit + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.sourceCodeAddressImage' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.sourceCodeAddressImage + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.runOp_preservesSourceStoreImage' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.runOp_preservesSourceStoreImage + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.applyOwnershipPreservesFrom_sourceStoreImage_of_declarations' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.applyOwnershipPreservesFrom_sourceStoreImage_of_declarations + +/-! Exact path-local HPT case facts are checked against emitted constructor +targets and reconstruct the runtime switch selection inside the attachment. -/ + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.exactCaseTarget_of_switch_descendant' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.exactCaseTarget_of_switch_descendant + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.constructorSwitchSelection_of_exactHPT_nonempty' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.constructorSwitchSelection_of_exactHPT_nonempty + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.constructorSwitchSelection_of_exactHPT' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.constructorSwitchSelection_of_exactHPT + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.constructorSwitchSelection_of_exactHPT_runtime' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.constructorSwitchSelection_of_exactHPT_runtime + +/-! Recursive heap traversal is framed by the continuation's independently +selected suffix budget. -/ + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.releaseSharedWork_add_suffix' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.releaseSharedWork_add_suffix + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.releaseShared_add_suffix' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.releaseShared_add_suffix + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.dropUniqueWork_add_suffix' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.dropUniqueWork_add_suffix + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.dropUnique_add_suffix' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.dropUnique_add_suffix + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_drop_release_recursive_state_framed' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_drop_release_recursive_state_framed + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_dropU_dropUnique_recursive_state_framed' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_dropU_dropUnique_recursive_state_framed + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_drop_release_cps' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_drop_release_cps + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_dropU_dropUnique_cps' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_dropU_dropUnique_cps + +/-! The exhaustive attached worker and whole-main endpoint stay within the +same explicit native-hash trust boundary as the checked attachment. -/ + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Sidecars.SourceConstructorsValid.runOp' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Sidecars.SourceConstructorsValid.runOp + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.runOp_preservesSourceStoreImage' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.runOp_preservesSourceStoreImage + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.constructorSwitchSelection_of_residual_nonempty' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.constructorSwitchSelection_of_residual_nonempty + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.constructorSwitchSelection_of_residual' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.constructorSwitchSelection_of_residual + +/-- info: 'Ix.Compiler.IxIR2.Lower.Artifact.mainTraceMember' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Artifact.mainTraceMember + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.simulate_traced_letOp_cps_of_run' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.simulate_traced_letOp_cps_of_run + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.successfulTraceSimulation' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.successfulTraceSimulation + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.successfulMainSimulation' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.successfulMainSimulation + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.sourceContextNoReuse' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.sourceContextNoReuse + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.pappSafe' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.pappSafe + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.successfulSimulationContracts' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.successfulSimulationContracts + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.successfulCanonicalMainSimulation' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.successfulCanonicalMainSimulation + +/-! ## Checked block-local liveness + +The liveness checker retains its accepted coverage equation, and its public +projections turn that equation into per-use coverage and a no-later-use fact. +The executable fixture's proof wrapper must remain reflection-axiom free. -/ + +/-- info: 'Ix.Compiler.IxIR2.Liveness.CheckedBlock.coversAt' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Liveness.CheckedBlock.coversAt + +/-- info: 'Ix.Compiler.IxIR2.Liveness.CheckedBlock.no_use_after' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Liveness.CheckedBlock.no_use_after + +/-- info: 'Ix.Compiler.IxIR2.Liveness.Examples.registerTwoNoUseAfter' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Liveness.Examples.registerTwoNoUseAfter + +/-- info: 'Ix.Compiler.IxIR2.Liveness.Examples.CheckedSuite.accepted' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Liveness.Examples.CheckedSuite.accepted + +/-! ## Validator-gated dynamic shared reuse insertion + +The first compiler-emitted reversal rewrite retains ordinary validation +witnesses for both sides. Its bounded benchmark checker packages the exact +executed source/baseline/logical/physical Boolean without reflection axioms. -/ + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Placement.noUseAfter' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Placement.noUseAfter + +/-- info: 'Ix.Compiler.IxIR2.Reuse.inferPlacementWith_sound' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.inferPlacementWith_sound + +/-- info: 'Ix.Compiler.IxIR2.Reuse.representation?_sound' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.representation?_sound + +/-- info: 'Ix.Compiler.IxIR2.Reuse.reuseShape?_sound' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.reuseShape?_sound + +/-- info: 'Ix.Compiler.IxIR2.Reuse.candidate?_sound' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.candidate?_sound + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Site.fits' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Site.fits + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Site.placementCoordinates' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Site.placementCoordinates + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Site.noUseAfter' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Site.noUseAfter + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Site.instructionCases' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Site.instructionCases + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Site.noCall' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Site.noCall + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Site.noCallSelf' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Site.noCallSelf + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Site.noApply' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Site.noApply + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Site.noMove' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Site.noMove + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Site.noFreeUnique' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Site.noFreeUnique + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Site.noPapp' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Site.noPapp + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Site.noDropUnique' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Site.noDropUnique + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Site.noAllocUnique' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Site.noAllocUnique + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Site.ne_resetBlock' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Site.ne_resetBlock + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Site.candidateCore' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Site.candidateCore + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Site.candidateVectors' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Site.candidateVectors + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Site.resetBlock_eq' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Site.resetBlock_eq + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Site.creditBlock_eq' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Site.creditBlock_eq + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Site.schemas' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Site.schemas + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Site.runtimeSchemas' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Site.runtimeSchemas + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Site.allocationArgumentsFound' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Site.allocationArgumentsFound + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Site.tailArgumentsFound' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Site.tailArgumentsFound + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Output.sourceValid' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Output.sourceValid + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Output.targetValid' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Output.targetValid + +/-- info: 'Ix.Compiler.IxIR2.Reuse.FunctionRewrite.decisionAt' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.FunctionRewrite.decisionAt + +/-- info: 'Ix.Compiler.IxIR2.Reuse.FunctionRewrite.acceptedAt' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.FunctionRewrite.acceptedAt + +/-- info: 'Ix.Compiler.IxIR2.Reuse.FunctionRewrite.accepted_target_ne_source' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.FunctionRewrite.accepted_target_ne_source + +/-- info: 'Ix.Compiler.IxIR2.Reuse.DeclarationDecisions.related' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.DeclarationDecisions.related + +/-- info: 'Ix.Compiler.IxIR2.Reuse.DeclarationsRel.find?_fn' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.DeclarationsRel.find?_fn + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Trace.context_fn' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Trace.context_fn + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Output.trace_target' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Output.trace_target + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Output.trace_report' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Output.trace_report + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.translateRegister?_range' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.translateRegister?_range + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.ValuesRel.pushResult' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.ValuesRel.pushResult + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.valuesRel_helperEntry' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.valuesRel_helperEntry + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.valuesRel_afterAllocation' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.valuesRel_afterAllocation + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.helperEntryValues_size' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.helperEntryValues_size + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.branchValues_resolve' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.branchValues_resolve + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.helperEdgeTransfer' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.helperEdgeTransfer + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.resolveAtom_translate' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.resolveAtom_translate + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.resolveAtoms_translate' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.resolveAtoms_translate + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.resolveAllocationArguments' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.resolveAllocationArguments + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.resolveTailArguments' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.resolveTailArguments + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.hotLogicalControlPrefix' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.hotLogicalControlPrefix + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.hotPhysicalControlPrefix' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.hotPhysicalControlPrefix + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.coldControlPrefix' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.coldControlPrefix + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.absentHelperControl' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.absentHelperControl + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.logicalPresentHelperControl' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.logicalPresentHelperControl + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.physicalPresentHelperControl' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.physicalPresentHelperControl + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.hotReuse_sound' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.hotReuse_sound + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.coldPrefix_commutes' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.coldPrefix_commutes + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.hotPrefix_contents' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.hotPrefix_contents + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.hotPrefixReuse_sound' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.hotPrefixReuse_sound + +/-- info: 'Ix.Compiler.IxIR1.Sim.reuse_shared_sound_with_survivors' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Sim.reuse_shared_sound_with_survivors + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.PlannerValueRelevant' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.PlannerValueRelevant + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.PlannerAtomRelevant' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.PlannerAtomRelevant + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.PlannerValueInRoots' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.PlannerValueInRoots + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.MappedValuesInRoots.selfRelated' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.MappedValuesInRoots.selfRelated + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.ValuesRel.toTranslatedValuesIso' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.ValuesRel.toTranslatedValuesIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.TranslatedValuesIso.pushResult' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.TranslatedValuesIso.pushResult + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.resolveAtom_translate_iso' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.resolveAtom_translate_iso + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.resolveAtoms_translate_iso' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.resolveAtoms_translate_iso + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.resolveAtom_iso' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.resolveAtom_iso + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.resolveAtoms_iso' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.resolveAtoms_iso + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.resolveAllocationArguments_iso' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.resolveAllocationArguments_iso + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.resolveTailArguments_iso' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.resolveTailArguments_iso + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.translatedValuesIso_helperEntry' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.translatedValuesIso_helperEntry + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.translatedValuesIso_afterAllocation' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.translatedValuesIso_afterAllocation + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.evalRuntimeSchemas' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.evalRuntimeSchemas + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.physicalPresentHelperControlIso' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.physicalPresentHelperControlIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.hotPhysicalAcceptedControlIso' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.hotPhysicalAcceptedControlIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.physicalPresentHelperControlTranslated' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.physicalPresentHelperControlTranslated + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.hotPhysicalAcceptedControlTranslated' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.hotPhysicalAcceptedControlTranslated + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.hotLogicalAcceptedControl' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.hotLogicalAcceptedControl + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.coldAcceptedControl' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.coldAcceptedControl + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.fetchPrefixControl' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.fetchPrefixControl + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.retainPrefixControl' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.retainPrefixControl + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.baselineAcceptedControl' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.baselineAcceptedControl + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.hotReuse_sound_with_survivors' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.hotReuse_sound_with_survivors + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.hotPrefixReuse_sound_with_survivors' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.hotPrefixReuse_sound_with_survivors + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.hotPrefixReuse_sound_under_iso' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.hotPrefixReuse_sound_under_iso + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.hotLogicalAcceptedPrefix' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.hotLogicalAcceptedPrefix + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.coldAcceptedPrefix' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.coldAcceptedPrefix + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.hotPhysicalAcceptedPrefixIso' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.hotPhysicalAcceptedPrefixIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.acceptedHotLogicalSimulation' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.acceptedHotLogicalSimulation + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.acceptedColdSimulation' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.acceptedColdSimulation + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.acceptedHotPhysicalSimulationIso' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.acceptedHotPhysicalSimulationIso + +/-! The whole-program lift keeps its structural lookup, evaluator transport, +heap congruence, and stable lockstep interfaces inside the ordinary logical +axiom envelope. -/ + +/-- info: 'Ix.Compiler.IxIR1.Sim.RValIso.eq_of_location_eq' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Sim.RValIso.eq_of_location_eq + +/-- info: 'Ix.Compiler.IxIR1.Sim.RValsIso.refl' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Sim.RValsIso.refl + +/-- info: 'Ix.Compiler.IxIR1.Sim.RValsIso.eq_of_location_eq' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Sim.RValsIso.eq_of_location_eq + +/-- info: 'Ix.Compiler.IxIR2.Eval.FieldWorlds.to_replicate' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.FieldWorlds.to_replicate + +/-- info: 'Ix.Compiler.IxIR2.Eval.FieldWorlds.congrStore' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.FieldWorlds.congrStore + +/-- info: 'Ix.Compiler.IxIR2.Eval.FieldValuesWorldEq.length_eq' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.FieldValuesWorldEq.length_eq + +/-- info: 'Ix.Compiler.IxIR2.Eval.FieldWorlds.transport' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.FieldWorlds.transport + +/-- info: 'Ix.Compiler.IxIR2.Eval.ConstructorView.congrStore' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.ConstructorView.congrStore + +/-- info: 'Ix.Compiler.IxIR2.Eval.ScalarOracleCall.congrOracle' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.ScalarOracleCall.congrOracle + +/-- info: 'Ix.Compiler.IxIR2.Eval.ScalarOracleCall.scalar' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.ScalarOracleCall.scalar + +/-- info: 'Ix.Compiler.IxIR2.Eval.CreditLookup.congrDefinition' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.CreditLookup.congrDefinition + +/-- info: 'Ix.Compiler.IxIR2.Eval.CreditTake.congrDefinition' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.CreditTake.congrDefinition + +/-- info: 'Ix.Compiler.IxIR2.Eval.CreditTake.target_eq' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.CreditTake.target_eq + +/-- info: 'Ix.Compiler.IxIR2.Eval.CreditTakeMany.definition' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.CreditTakeMany.definition + +/-- info: 'Ix.Compiler.IxIR2.Eval.CreditTakeMany.sequence' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.CreditTakeMany.sequence + +/-- info: 'Ix.Compiler.IxIR2.Eval.CreditTakeSequence.toMany' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.CreditTakeSequence.toMany + +/-- info: 'Ix.Compiler.IxIR2.Eval.EdgeTransfer.parts' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.EdgeTransfer.parts + +/-- info: 'Ix.Compiler.IxIR2.Eval.EdgeTransfer.congrDefinition' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.EdgeTransfer.congrDefinition + +/-- info: 'Ix.Compiler.IxIR2.Eval.EdgeTransfer.targetBlock' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.EdgeTransfer.targetBlock + +/-- info: 'Ix.Compiler.IxIR2.Eval.EdgeTransfer.definition' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.EdgeTransfer.definition + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.deterministic' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.deterministic + +/-- info: 'Ix.Compiler.IxIR2.Eval.Steps.cancelPrefixToHalted' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Steps.cancelPrefixToHalted + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.extern' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.extern + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Decision.replacement_valueParams' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Decision.replacement_valueParams + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Decision.replacement_creditParams' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Decision.replacement_creditParams + +/-- info: 'Ix.Compiler.IxIR2.Reuse.FunctionRewrite.blockCase' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.FunctionRewrite.blockCase + +/-- info: 'Ix.Compiler.IxIR2.Reuse.FunctionRewrite.blockCaseOfLookup' depends on axioms: [propext, Classical.choice] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.FunctionRewrite.blockCaseOfLookup + +/-- info: 'Ix.Compiler.IxIR2.Reuse.FunctionRewrite.targetBlockAbi' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.FunctionRewrite.targetBlockAbi + +/-- info: 'Ix.Compiler.IxIR2.Reuse.FunctionRewrite.definition_blocks_nonempty' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.FunctionRewrite.definition_blocks_nonempty + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Trace.context_extern' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Trace.context_extern + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.rvalHasWorld_eq' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.rvalHasWorld_eq + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.fieldWorlds' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.fieldWorlds + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.fieldWorlds_iff' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.fieldWorlds_iff + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.constructorView' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.constructorView + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.retainShared' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.retainShared + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.retainSharedMany' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.retainSharedMany + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.reserve' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.reserve + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.tickResetAttempt' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.tickResetAttempt + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.tickHotReset' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.tickHotReset + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.tickColdReset' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.tickColdReset + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.releaseReservation' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.releaseReservation + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.reuseReservation' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.reuseReservation + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.heapIsoKillShared' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.heapIsoKillShared + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.heapIsoKillShared_rel' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.heapIsoKillShared_rel + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.heapIso_rvalHasWorld_eq' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.heapIso_rvalHasWorld_eq + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.heapIso_fieldWorlds_of_replicate' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.heapIso_fieldWorlds_of_replicate + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.FieldWorlds.avoidsMissing' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.FieldWorlds.avoidsMissing + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.releaseShared' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.releaseShared + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.releaseSharedWork_addFuel' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.releaseSharedWork_addFuel + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.releaseSharedWork_remaining_le' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.releaseSharedWork_remaining_le + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.releaseSharedWork_of_le' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.releaseSharedWork_of_le + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.releaseShared_remaining_le' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.releaseShared_remaining_le + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.releaseShared_addFuel' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.releaseShared_addFuel + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.releaseShared_of_le' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.releaseShared_of_le + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.dropUniqueWork_contents_congr' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.dropUniqueWork_contents_congr + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.dropUnique' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.dropUnique + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.dropUniqueWork_addFuel' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.dropUniqueWork_addFuel + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.dropUniqueWork_remaining_le' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.dropUniqueWork_remaining_le + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.dropUnique_addFuel' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.dropUnique_addFuel + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.dropUnique_of_le' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.HeapContentsEq.dropUnique_of_le + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.entry' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.entry + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.atPosition' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.atPosition + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.blockCase' depends on axioms: [propext, Classical.choice] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.blockCase + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.advancePush' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.advancePush + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.push' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.push + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.advance' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.advance + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.advanceAppendCredit' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.advanceAppendCredit + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.values_eq' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.values_eq + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.rewritten_eq' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.rewritten_eq + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.advanceTake' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.advanceTake + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.edgeTransfer' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.edgeTransfer + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.takeIso' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.takeIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.takeManyIso' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.takeManyIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.edgeTransferIso' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.edgeTransferIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableFrameRel.entry' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableFrameRel.entry + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableFrameRel.push' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableFrameRel.push + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.transportRelation' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableFrameIso.transportRelation + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableFrameRel.transportRelation' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableFrameRel.transportRelation + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableContinuationIso.transportRelation' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableContinuationIso.transportRelation + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableStackIso.transportRelation' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableStackIso.transportRelation + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableControlIso.recursiveCall' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableControlIso.recursiveCall + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableMachineRel.contentsRecursiveCall' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableMachineRel.contentsRecursiveCall + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableMachineRel.isomorphicRecursiveCall' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableMachineRel.isomorphicRecursiveCall + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableContinuationIso.applyMoreOrResume' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableContinuationIso.applyMoreOrResume + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.acceptedHotLogicalStableSimulation' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.acceptedHotLogicalStableSimulation + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.acceptedColdStableSimulation' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.acceptedColdStableSimulation + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.acceptedHotPhysicalStableSimulationIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.acceptedHotPhysicalStableSimulationIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedApplyTransferErased' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedApplyTransferErased + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedApplyTransferPapUnder' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedApplyTransferPapUnder + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedApplyTransferPapFn' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedApplyTransferPapFn + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedApplyTransferPapExtern' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedApplyTransferPapExtern + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedApplyTransfer' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedApplyTransfer + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedApplyStep' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedApplyStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedApplyStepOfTrace' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedApplyStepOfTrace + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedRetApplyMoreStep' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedRetApplyMoreStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedRetApplyMoreStepOfTrace' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedRetApplyMoreStepOfTrace + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedMoveStep' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedMoveStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedFetchStep' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedFetchStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedFreeUniqueStep' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedFreeUniqueStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedAllocStep' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedAllocStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedAllocWithAbsentStep' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedAllocWithAbsentStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedAllocWithLogicalStep' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedAllocWithLogicalStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedAllocWithPhysicalStep' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedAllocWithPhysicalStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedDiscardCreditAbsentStep' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedDiscardCreditAbsentStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedDiscardCreditLogicalStep' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedDiscardCreditLogicalStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedDiscardCreditPhysicalStep' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedDiscardCreditPhysicalStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedTakeUniqueLogicalStep' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedTakeUniqueLogicalStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedTakeUniquePhysicalStep' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedTakeUniquePhysicalStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedResetSharedLogicalHotStep' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedResetSharedLogicalHotStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedResetSharedPhysicalHotStep' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedResetSharedPhysicalHotStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedResetSharedColdStep' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedResetSharedColdStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedCallSelfStep' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedCallSelfStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedCallFnStep' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedCallFnStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedPappFnStep' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedPappFnStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedPappExternStep' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedPappExternStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedExternStep' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedExternStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedTailCallSelfStep' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedTailCallSelfStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedTailCallFnStep' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedTailCallFnStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedRetResumeStep' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedRetResumeStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedRetHaltStep' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedRetHaltStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedJumpStep' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedJumpStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedSwitchCtorStep' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedSwitchCtorStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedSwitchNatZeroStep' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedSwitchNatZeroStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedSwitchNatSuccStep' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedSwitchNatSuccStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedBranchCreditPresentStep' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedBranchCreditPresentStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedBranchCreditAbsentStep' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedBranchCreditAbsentStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedRetainSharedStep' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedRetainSharedStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedReleaseSharedStep' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedReleaseSharedStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedDropUniqueStep' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedDropUniqueStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedInstructionStepOfTrace' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedInstructionStepOfTrace + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedInstructionStepOfTraceIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedInstructionStepOfTraceIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedTerminatorStepOfTrace' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedTerminatorStepOfTrace + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedTerminatorStepOfTraceIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedTerminatorStepOfTraceIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedStepOfTrace' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedStepOfTrace + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.unchangedStepOfTraceIso' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.unchangedStepOfTraceIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableMacroSimulation' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableMacroSimulation + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableMacroSimulation.ofStepsOne' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableMacroSimulation.ofStepsOne + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableMachineRel.haltedParts' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableMachineRel.haltedParts + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableMacroInvariantStep' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableMacroInvariantStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableMacroInvariantStep.simulation' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableMacroInvariantStep.simulation + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableMacroSimulation.preserveInvariant' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableMacroSimulation.preserveInvariant + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.acceptedHotLogicalStableMacroSimulation' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.acceptedHotLogicalStableMacroSimulation + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.acceptedColdStableMacroSimulation' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.acceptedColdStableMacroSimulation + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.acceptedHotPhysicalStableMacroSimulationIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.acceptedHotPhysicalStableMacroSimulationIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.acceptedColdStableMacroSimulationIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.acceptedColdStableMacroSimulationIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.stableMacroStepOfTrace' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.stableMacroStepOfTrace + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.stableMacroStepOfTraceIso' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.stableMacroStepOfTraceIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.stableMacroStepOfTraceRel' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.stableMacroStepOfTraceRel + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.stableFiniteExecutionOfMacroInvariant' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.stableFiniteExecutionOfMacroInvariant + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.stableRunMachineOfMacroInvariant' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.stableRunMachineOfMacroInvariant + +/-! ## Liveness-indexed reuse/compiler attachment -/ + +/-- info: 'Ix.Compiler.IxIR2.Liveness.instruction_reg_mem_blockUses' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Liveness.instruction_reg_mem_blockUses + +/-- info: 'Ix.Compiler.IxIR2.Liveness.terminator_reg_mem_blockUses' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Liveness.terminator_reg_mem_blockUses + +/-- info: 'Ix.Compiler.IxIR2.Liveness.mem_blockUses' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Liveness.mem_blockUses + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.callRemainingHolds' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.callRemainingHolds + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.applyRemainingHolds' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.applyRemainingHolds + +/-- info: 'Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.applyInputOwnership' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Sim.SourceOwnershipInvariant.applyInputOwnership + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.AtomLiveFrom.mono' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.AtomLiveFrom.mono + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.AtomLiveFrom.instruction' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.AtomLiveFrom.instruction + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.AtomLiveFrom.terminator' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.AtomLiveFrom.terminator + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.AtomsLiveFrom.mono' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.AtomsLiveFrom.mono + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.plannerValueLiveAtAllocation' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.plannerValueLiveAtAllocation + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.plannerValueLiveAtEntry' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.plannerValueLiveAtEntry + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.Reuse.Site.entryLiveParameterCases' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.Reuse.Site.entryLiveParameterCases + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.LiveValuesIso.ofRValsIso' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.LiveValuesIso.ofRValsIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.LiveValuesIso.advance' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.LiveValuesIso.advance + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.LiveValuesIso.mono' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.LiveValuesIso.mono + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.LiveValuesIso.push' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.LiveValuesIso.push + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.LiveValuesIso.append' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.LiveValuesIso.append + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.LiveValuesIso.resolveAtom' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.LiveValuesIso.resolveAtom + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.LiveValuesIso.resolveAtoms' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.LiveValuesIso.resolveAtoms + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveFrameIso' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveFrameIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveFrameIso.ofStable' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveFrameIso.ofStable + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveFrameIso.advance' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveFrameIso.advance + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveFrameIso.takeManyIso' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveFrameIso.takeManyIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveFrameIso.edgeTransferIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveFrameIso.edgeTransferIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveFrameIso.transportRelation' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveFrameIso.transportRelation + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveContinuationAvoids.transportRelation' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveContinuationAvoids.transportRelation + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveStackAvoids.transportRelation' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveStackAvoids.transportRelation + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableContinuationIso.toLive' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableContinuationIso.toLive + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableStackIso.toLive' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableStackIso.toLive + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveMachineRel' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveMachineRel + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.AcceptedPrefixInstruction' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.AcceptedPrefixInstruction + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.AcceptedPrefixInstructionAt' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.AcceptedPrefixInstructionAt + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveFrameIso.AcceptedEntry' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveFrameIso.AcceptedEntry + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveAcceptedEntry' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveAcceptedEntry + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveAcceptedEntry.ofPcZero' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveAcceptedEntry.ofPcZero + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveAcceptedEntry.halted' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveAcceptedEntry.halted + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveAcceptedEntry.ofSameBlock' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveAcceptedEntry.ofSameBlock + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveAcceptedEntry.ofSourceBlockExcluded' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveAcceptedEntry.ofSourceBlockExcluded + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveAcceptedEntry.ofCallResume' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveAcceptedEntry.ofCallResume + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveAcceptedEntry.ofCallSelfResume' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveAcceptedEntry.ofCallSelfResume + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveAcceptedEntry.ofApplyResume' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveAcceptedEntry.ofApplyResume + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveAcceptedEntry.ofMoveAdvance' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveAcceptedEntry.ofMoveAdvance + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveAcceptedEntry.ofFreeUniqueAdvance' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveAcceptedEntry.ofFreeUniqueAdvance + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveAcceptedEntry.ofPappAdvance' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveAcceptedEntry.ofPappAdvance + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveAcceptedEntry.ofDropUniqueAdvance' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveAcceptedEntry.ofDropUniqueAdvance + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveAcceptedEntry.ofAllocUniqueAdvance' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveAcceptedEntry.ofAllocUniqueAdvance + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveAcceptedEntry.valuesAtEntry' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveAcceptedEntry.valuesAtEntry + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableMachineRel.toLive' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableMachineRel.toLive + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveControlIso.recursiveCall' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveControlIso.recursiveCall + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveMachineRel.contentsRecursiveCall' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveMachineRel.contentsRecursiveCall + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveMachineRel.isomorphicRecursiveCall' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveMachineRel.isomorphicRecursiveCall + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedMoveStepLiveIso' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedMoveStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedFetchStepLiveIso' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedFetchStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedFetchPrologueStepsLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedFetchPrologueStepsLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedCallSelfStepLiveIso' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedCallSelfStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedCallFnStepLiveIso' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedCallFnStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedJumpStepLiveIso' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedJumpStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedSwitchNatZeroStepLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedSwitchNatZeroStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedSwitchNatSuccStepLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedSwitchNatSuccStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedSwitchCtorStepLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedSwitchCtorStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedSwitchCtorPrologueStepsLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedSwitchCtorPrologueStepsLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedBranchCreditPresentStepLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedBranchCreditPresentStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedBranchCreditAbsentStepLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedBranchCreditAbsentStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedTailCallSelfStepLiveIso' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedTailCallSelfStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedTailCallFnStepLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedTailCallFnStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedRetResumeStepLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedRetResumeStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedRetHaltStepLiveIso' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedRetHaltStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.AtomsLiveFrom.instruction' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.AtomsLiveFrom.instruction + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveContinuationIso.applyMoreOrResumeIso' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveContinuationIso.applyMoreOrResumeIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedFreeUniqueStepLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedFreeUniqueStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedAllocStepLiveIso' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedAllocStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedAllocWithAbsentStepLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedAllocWithAbsentStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedAllocWithLogicalStepLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedAllocWithLogicalStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedAllocWithPhysicalStepLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedAllocWithPhysicalStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedTakeUniqueLogicalStepLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedTakeUniqueLogicalStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedTakeUniquePhysicalStepLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedTakeUniquePhysicalStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedResetSharedLogicalHotStepLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedResetSharedLogicalHotStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedResetSharedPhysicalHotStepLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedResetSharedPhysicalHotStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedResetSharedColdStepLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedResetSharedColdStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedRetainSharedStepLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedRetainSharedStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedReleaseSharedStepLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedReleaseSharedStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedDropUniqueStepLiveIso' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedDropUniqueStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedDiscardCreditAbsentStepLiveIso' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedDiscardCreditAbsentStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedDiscardCreditLogicalStepLiveIso' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedDiscardCreditLogicalStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedDiscardCreditPhysicalStepLiveIso' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedDiscardCreditPhysicalStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedPappFnStepLiveIso' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedPappFnStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedPappExternStepLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedPappExternStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedExternStepLiveIso' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedExternStepLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedApplyTransferErasedLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedApplyTransferErasedLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedApplyTransferPapUnderLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedApplyTransferPapUnderLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedApplyTransferPapFnLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedApplyTransferPapFnLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedApplyTransferPapExternLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedApplyTransferPapExternLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedApplyTransferLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedApplyTransferLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedApplyStepOfTraceLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedApplyStepOfTraceLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedRetApplyMoreStepOfTraceLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedRetApplyMoreStepOfTraceLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedInstructionStepOfTraceLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedInstructionStepOfTraceLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedAcceptedPrefixInstructionStepOfTraceLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedAcceptedPrefixInstructionStepOfTraceLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedTerminatorStepOfTraceLiveIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedTerminatorStepOfTraceLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedStepOfTraceLiveIso' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedStepOfTraceLiveIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.acceptedHotLogicalStableLiveSimulation' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.acceptedHotLogicalStableLiveSimulation + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.acceptedColdStableLiveSimulation' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.acceptedColdStableLiveSimulation + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.acceptedHotPhysicalStableLiveSimulationIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.acceptedHotPhysicalStableLiveSimulationIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.acceptedHotLogicalStableLiveMacroSimulation' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.acceptedHotLogicalStableLiveMacroSimulation + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.acceptedColdStableLiveMacroSimulation' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.acceptedColdStableLiveMacroSimulation + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.acceptedHotPhysicalStableLiveMacroSimulationIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.acceptedHotPhysicalStableLiveMacroSimulationIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.acceptedHotPhysicalStableLiveMacroSimulationIsoOfAccounting' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.acceptedHotPhysicalStableLiveMacroSimulationIsoOfAccounting + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.acceptedHotPhysicalStableLiveMacroSimulationIsoOfAccountingAt' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.acceptedHotPhysicalStableLiveMacroSimulationIsoOfAccountingAt + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.acceptedColdStableLiveMacroSimulationIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.acceptedColdStableLiveMacroSimulationIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.acceptedColdStableLiveMacroSimulationIsoAt' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.acceptedColdStableLiveMacroSimulationIsoAt + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.stableLiveMacroStepOfTraceIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.stableLiveMacroStepOfTraceIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveMacroSimulationAt' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveMacroSimulationAt + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveMacroSimulationAt.simulation' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveMacroSimulationAt.simulation + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveMacroInvariantStep' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveMacroInvariantStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveMacroInvariantStep.simulation' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveMacroInvariantStep.simulation + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveMacroSimulation.preserveInvariant' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveMacroSimulation.preserveInvariant + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveMacroSimulation.ofStepsOne' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveMacroSimulation.ofStepsOne + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableMacroSimulation.toLive' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableMacroSimulation.toLive + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.stableLiveFiniteExecutionOfMacroInvariant' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.stableLiveFiniteExecutionOfMacroInvariant + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.stableLiveFiniteExecutionOfGuidedMacroInvariant' depends on axioms: [propext, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.stableLiveFiniteExecutionOfGuidedMacroInvariant + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.stableLiveRunMachineOfMacroInvariant' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.stableLiveRunMachineOfMacroInvariant + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.stableLiveRunMachineOfGuidedMacroInvariant' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.stableLiveRunMachineOfGuidedMacroInvariant + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.retainSharedMany_of_rootOwnership' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.retainSharedMany_of_rootOwnership + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.retainCtorFields_of_rootOwnership' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.retainCtorFields_of_rootOwnership + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.balanceInertRoots' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.balanceInertRoots + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.addInertRoots' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.addInertRoots + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.fieldRootPartition' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.fieldRootPartition + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.hotPrefixFieldRootPartition' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.hotPrefixFieldRootPartition + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.hotPrefixFieldRootAccounting' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.hotPrefixFieldRootAccounting + +/-- info: 'Ix.Compiler.IxIR1.Sim.RootsIso.permuteRight' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Sim.RootsIso.permuteRight + +/-- info: 'Ix.Compiler.IxIR1.Sim.HeapIso.rootOwnership' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Sim.HeapIso.rootOwnership + +/-- info: 'Ix.Compiler.IxIR1.Sim.HeapIso.rootOwnershipPreimageAppend' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.Sim.HeapIso.rootOwnershipPreimageAppend + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.hotPrefixFieldRootAccountingIso' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.hotPrefixFieldRootAccountingIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.ValueSupportedByRoots.mono' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.ValueSupportedByRoots.mono + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.ValueSupportedByRoots.inBounds' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.ValueSupportedByRoots.inBounds + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.LiveValuesIso.identityOfInBounds' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.LiveValuesIso.identityOfInBounds + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveFrameIso.identityOfInBounds' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveFrameIso.identityOfInBounds + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveContinuationIso.identityOfSupported' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveContinuationIso.identityOfSupported + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveStackIso.identityOfSupported' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveStackIso.identityOfSupported + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.ValueSupportedByRoots.avoidsUnitShared' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.ValueSupportedByRoots.avoidsUnitShared + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.LiveFrameInputCoverage.ofCodeState' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.LiveFrameInputCoverage.ofCodeState + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.LiveFrameSupportedByRoots.ofNoBorrows' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.LiveFrameSupportedByRoots.ofNoBorrows + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.LiveFrameSupportedByRoots.ofCallSuspension' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.LiveFrameSupportedByRoots.ofCallSuspension + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.LiveFrameSupportedByRoots.ofCallSelfSuspension' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.LiveFrameSupportedByRoots.ofCallSelfSuspension + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.LiveFrameSupportedByRoots.applyPapEntry' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.LiveFrameSupportedByRoots.applyPapEntry + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.LiveFrameSupportedByRoots.mono' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.LiveFrameSupportedByRoots.mono + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.LiveFrameSupportedByRoots.mappedValuesInRoots' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.LiveFrameSupportedByRoots.mappedValuesInRoots + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.LiveFrameSupportedByRoots.mappedValuesAtPlannerAllocation' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.LiveFrameSupportedByRoots.mappedValuesAtPlannerAllocation + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.MappedValuesInRoots.preimage' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.MappedValuesInRoots.preimage + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.LiveContinuationSupportedByRoots.mono' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.LiveContinuationSupportedByRoots.mono + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.LiveStackSupportedByRoots.mono' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.LiveStackSupportedByRoots.mono + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.LiveValuesIso.toHeapIsoOfLive' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.LiveValuesIso.toHeapIsoOfLive + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.LiveValuesIso.toHeapIsoOfSupported' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.LiveValuesIso.toHeapIsoOfSupported + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveFrameIso.toHeapIsoOfSupported' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveFrameIso.toHeapIsoOfSupported + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveContinuationIso.toHeapIsoOfSupported' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveContinuationIso.toHeapIsoOfSupported + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveStackIso.toHeapIsoOfSupported' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveStackIso.toHeapIsoOfSupported + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveStackIso.avoidsOfSupportedUnit' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveStackIso.avoidsOfSupportedUnit + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.OptimizedAttachment' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.OptimizedAttachment + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.optimizeAttachment' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.optimizeAttachment + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerStackState' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerStackState + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerStackReturn' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerStackReturn + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerApplyMoreReturn' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerApplyMoreReturn + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.currentOwnership' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.currentOwnership + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.ownedParameterRoot' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.ownedParameterRoot + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedSiteSourceRoot' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedSiteSourceRoot + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedSiteSourceRootIso' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedSiteSourceRootIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.coverage' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.coverage + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.activeFrameSupportedAt' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.activeFrameSupportedAt + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.mappedValuesAtPlannerAllocationOfNoBorrows' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.mappedValuesAtPlannerAllocationOfNoBorrows + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.withHeapFuel' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.withHeapFuel + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.compilerStateOfStep' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.compilerStateOfStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedPrefixInstructionAt' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedPrefixInstructionAt + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepPure' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepPure + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepFetch' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepFetch + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepFreeUnique' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepFreeUnique + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepRetainScalar' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepRetainScalar + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepRetainShared' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepRetainShared + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.allocationReadyOwnership' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.allocationReadyOwnership + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.allocationFieldWorlds' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.allocationFieldWorlds + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepAlloc' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepAlloc + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepPapp' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepPapp + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepDropUniqueScalar' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepDropUniqueScalar + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepDropUnique' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepDropUnique + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepReleaseScalar' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepReleaseScalar + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepReleaseShared' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepReleaseShared + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepApplyErased' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepApplyErased + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.externImpossible' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.externImpossible + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepApplyPapUnder' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepApplyPapUnder + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.enterApplyPapExact' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.enterApplyPapExact + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.enterApplyPapOver' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.enterApplyPapOver + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.currentApply' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.currentApply + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.applyInputOwnership' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.applyInputOwnership + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.applyPapPreparation' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.applyPapPreparation + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepApplyErasedOfTarget' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepApplyErasedOfTarget + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepApplyPapUnderOfTarget' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepApplyPapUnderOfTarget + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepApplyOfTarget' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepApplyOfTarget + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.AttachedCompilerInstructionCase.resolve' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.AttachedCompilerInstructionCase.resolve + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.attachedPhysicalInstructionCase' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.attachedPhysicalInstructionCase + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.attachedPhysicalInstructionAdvance' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.attachedPhysicalInstructionAdvance + +/-- info: 'Ix.Compiler.IxIR2.Lower.edgeCapabilities?_size' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.edgeCapabilities?_size + +/-- info: 'Ix.Compiler.IxIR2.Lower.Checked.constructorBranchSchemaArity' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Checked.constructorBranchSchemaArity + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.CompilerSwitchCtorCase' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.CompilerSwitchCtorCase + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.CompilerSwitchCtorCase.compilerMacro' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.CompilerSwitchCtorCase.compilerMacro + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.switchCtorCaseOfTarget' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.switchCtorCaseOfTarget + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.switchCtorMacroOfTarget' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.switchCtorMacroOfTarget + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.attachedStableSwitchCtorMacroOfTarget' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.attachedStableSwitchCtorMacroOfTarget + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerTerminatorSyntax' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerTerminatorSyntax + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.currentTerminatorSyntax' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.currentTerminatorSyntax + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.AttachedCompilerTerminatorCase' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.AttachedCompilerTerminatorCase + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.attachedPhysicalTerminatorCase' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.attachedPhysicalTerminatorCase + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.AttachedCompilerTerminatorCase.resolve' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.AttachedCompilerTerminatorCase.resolve + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.Reuse.Site.entryLiveParameterBeforeRelease' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.Reuse.Site.entryLiveParameterBeforeRelease + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.Reuse.Site.fetchPrologueBound' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.Reuse.Site.fetchPrologueBound + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.Reuse.Site.fetchPrologueHead' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.Reuse.Site.fetchPrologueHead + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedPrefixCompilerMacroAtOfFetched' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedPrefixCompilerMacroAtOfFetched + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedParameterValueLive' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedParameterValueLive + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedCtorChildSource' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedCtorChildSource + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedHotPhysicalStableLiveMacroSimulationHistoryAtOfParameters' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedHotPhysicalStableLiveMacroSimulationHistoryAtOfParameters + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedPhysicalStableLiveMacroSimulationHistoryAtOfParameters' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedPhysicalStableLiveMacroSimulationHistoryAtOfParameters + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedPhysicalStableMacroStepHistoryOfFetched' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedPhysicalStableMacroStepHistoryOfFetched + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedPhysicalStableMacroStepHistoryOfFetchedExecution' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedPhysicalStableMacroStepHistoryOfFetchedExecution + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.acceptedCtorChildPhysicalMacroOfExecution' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.acceptedCtorChildPhysicalMacroOfExecution + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.attachedPhysicalSwitchCtorMacroOfCompilerState' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.attachedPhysicalSwitchCtorMacroOfCompilerState + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.attachedPhysicalSwitchCtorMacroOfTarget' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.attachedPhysicalSwitchCtorMacroOfTarget + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.attachedPhysicalTerminatorAdvanceHistory' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.attachedPhysicalTerminatorAdvanceHistory + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.enterCall' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.enterCall + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.enterCallSelf' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.enterCallSelf + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.enterTailCall' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.enterTailCall + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.enterTailCallSelf' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.enterTailCallSelf + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepSwitchNatZero' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepSwitchNatZero + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepSwitchNatSucc' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepSwitchNatSucc + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepsSwitchCtor' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stepsSwitchCtor + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.switchCtorMacro' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.switchCtorMacro + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.returnHalt' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.returnHalt + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.returnResume' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.returnResume + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.returnApplyMore' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.returnApplyMore + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.heap_eq' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.heap_eq + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.heapClosed' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.heapClosed + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedSiteRetainedFields' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedSiteRetainedFields + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedSiteParameterCount' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedSiteParameterCount + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.liveValueInBounds' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.liveValueInBounds + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedEntryValueLive' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedEntryValueLive + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stackToHeapIso' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stackToHeapIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.historyOfContents' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.historyOfContents + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stackAvoidsOfSupportedUnit' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.stackAvoidsOfSupportedUnit + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedSiteStackAvoidsOfUnit' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedSiteStackAvoidsOfUnit + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedHotPhysicalStableLiveMacroSimulationHistory' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedHotPhysicalStableLiveMacroSimulationHistory + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedHotPhysicalStableLiveMacroSimulationHistoryAt' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedHotPhysicalStableLiveMacroSimulationHistoryAt + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedPhysicalStableLiveMacroSimulationHistory' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedPhysicalStableLiveMacroSimulationHistory + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedPhysicalStableLiveMacroSimulationHistoryAt' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedPhysicalStableLiveMacroSimulationHistoryAt + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.initial' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.initial + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerState' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerState + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerMacroStep' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerMacroStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerAcceptedMacroStepAt' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerAcceptedMacroStepAt + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerAcceptedMacroStepAt.compilerMacro' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerAcceptedMacroStepAt.compilerMacro + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedPrefixCompilerMacroAt' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedPrefixCompilerMacroAt + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedPrefixCompilerMacro' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedPrefixCompilerMacro + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.Steps.deterministic' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.Steps.deterministic + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.AttachedStableState' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.AttachedStableState + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.AttachedStableMacroStep' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.AttachedStableMacroStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.AttachedStableMacroStep.simulation' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.AttachedStableMacroStep.simulation + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerAcceptedMacroStepAt.attach' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerAcceptedMacroStepAt.attach + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedPhysicalStableMacroStepHistory' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedPhysicalStableMacroStepHistory + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.AttachedStableMacroStep.ofStepsOne' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.AttachedStableMacroStep.ofStepsOne + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.AttachedStableMacroStep.prependStepsOne' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.AttachedStableMacroStep.prependStepsOne + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.AttachedStableMacroStep.ofUnchangedSwitchCtorPrologue' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.AttachedStableMacroStep.ofUnchangedSwitchCtorPrologue + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.AttachedStableMacroStep.ofSwitchCtorChildBlockCase' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.AttachedStableMacroStep.ofSwitchCtorChildBlockCase + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.attachedStableSwitchCtorMacroOfCompilerState' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.attachedStableSwitchCtorMacroOfCompilerState + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.AttachedCompilerAdvance' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.AttachedCompilerAdvance + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.AttachedCompilerAdvance.prefixStepOfLetOp' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.AttachedCompilerAdvance.prefixStepOfLetOp + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.AttachedCompilerAdvance.stepOfPcZero' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.AttachedCompilerAdvance.stepOfPcZero + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.AttachedCompilerAdvance.stepOfHalted' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.AttachedCompilerAdvance.stepOfHalted + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.AttachedCompilerAdvance.stepOfCallResume' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.AttachedCompilerAdvance.stepOfCallResume + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.AttachedCompilerAdvance.stepOfCallSelfResume' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.AttachedCompilerAdvance.stepOfCallSelfResume + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.AttachedCompilerAdvance.stepOfApplyResume' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.AttachedCompilerAdvance.stepOfApplyResume + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerMacroStep.attach' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerMacroStep.attach + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.attachedStableMacroStepOfTraceIsoOfStep' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.attachedStableMacroStepOfTraceIsoOfStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.attachedStableMacroStepOfTraceIsoOfPrefixStep' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.attachedStableMacroStepOfTraceIsoOfPrefixStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.attachedStableMacroStepOfTraceIso' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.attachedStableMacroStepOfTraceIso + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.attachedStableMacroStepOfTraceRel' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.attachedStableMacroStepOfTraceRel + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.AttachedStableMacroStep.invariantStep' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.AttachedStableMacroStep.invariantStep + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveMacroSimulation.preserveCompiler' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveMacroSimulation.preserveCompiler + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.AttachedStableState.advanceInvariant' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.AttachedStableState.advanceInvariant + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.attachedStableFiniteExecution' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.attachedStableFiniteExecution + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.attachedStableFiniteExecutionGuided' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.attachedStableFiniteExecutionGuided + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.attachedStableRunMachine' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.attachedStableRunMachine + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.attachedStableRunMachineGuided' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.attachedStableRunMachineGuided + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.MappedValuesInRoots.transportOwnership' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.MappedValuesInRoots.transportOwnership + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedSiteSourceFieldCount' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedSiteSourceFieldCount + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.currentTerminalAllocation' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.currentTerminalAllocation + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedPhysicalStableMacroStepHistoryOfExecution' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.acceptedPhysicalStableMacroStepHistoryOfExecution + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.attachedPhysicalStableMacroStepOfTraceRelGuided' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.attachedPhysicalStableMacroStepOfTraceRelGuided + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveMachineRel.rewrittenRunning' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.StableLiveMachineRel.rewrittenRunning + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.attachedPhysicalStableMacroStepGuided' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.attachedPhysicalStableMacroStepGuided + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.attachedPhysicalStableFiniteExecution' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.attachedPhysicalStableFiniteExecution + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.attachedPhysicalStableRunMachine' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.attachedPhysicalStableRunMachine + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.OptimizedAttachment.initial' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.OptimizedAttachment.initial + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.Examples.leafHotReuseProducesRelatedHeaps' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.Examples.leafHotReuseProducesRelatedHeaps + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.Examples.linkedHotPrefixProducesRelatedHeaps' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.Examples.linkedHotPrefixProducesRelatedHeaps + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Examples.CheckedBenchmark.accepted' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Examples.CheckedBenchmark.accepted + +/-! ## Typed x86-64 v0 semantic skeleton + +The target AST's closed-fragment theorems must remain free of ISA or encoder +assumptions. The executable local step is likewise an ordinary Lean +definition; its stability theorem stays inside the standard logical fence. -/ + +/-- info: 'Ix.Compiler.X86.Instr.inV0' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Instr.inV0 + +/-- info: 'Ix.Compiler.X86.Terminator.inV0' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Terminator.inV0 + +/-- info: 'Ix.Compiler.X86.Program.inV0' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Program.inV0 + +/-- info: 'Ix.Compiler.X86.Checked.inV0' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Checked.inV0 + +/-- info: 'Ix.Compiler.X86.step_of_not_running' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.step_of_not_running + +/-- info: 'Ix.Compiler.X86.Core.applyIntrinsicResult_rsp' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Core.applyIntrinsicResult_rsp + +/-- info: 'Ix.Compiler.X86.Core.applyIntrinsicResult_calleeSaved' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Core.applyIntrinsicResult_calleeSaved + +/-! ## First IxIR₂ scalar selection refinement + +Successful selector outputs retain their source-validation witness. The first +physical IxIR₂ move/alias family then refines the System V `rax` leaf result +without adding any ISA, encoder, native-reflection, or FFI axiom. -/ + +/-- info: 'Ix.Compiler.X86.Select.Output.sourceValid' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Select.Output.sourceValid + +/-- info: 'Ix.Compiler.X86.Select.select_scalarMoveProgram' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Select.select_scalarMoveProgram + +/-- info: 'Ix.Compiler.X86.Select.scalarMoveRefines' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Select.scalarMoveRefines + +/-- info: 'Ix.Compiler.X86.Select.selectScalarMoveRefines' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Select.selectScalarMoveRefines + +/-! Source execution history through suspended calls and tail transfers. -/ + +/-- info: 'Ix.Compiler.IxIR1.ExecutionHistory.refl' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.ExecutionHistory.refl + +/-- info: 'Ix.Compiler.IxIR1.ExecutionHistory.trans' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.ExecutionHistory.trans + +/-- info: 'Ix.Compiler.IxIR1.ExecutionHistory.stepOp' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.ExecutionHistory.stepOp + +/-- info: 'Ix.Compiler.IxIR1.ExecutionHistory.caseCtor' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.ExecutionHistory.caseCtor + +/-- info: 'Ix.Compiler.IxIR1.ExecutionHistory.caseNatZero' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.ExecutionHistory.caseNatZero + +/-- info: 'Ix.Compiler.IxIR1.ExecutionHistory.caseNatSucc' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.ExecutionHistory.caseNatSucc + +/-- info: 'Ix.Compiler.IxIR1.ExecutionHistory.tailCall' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.ExecutionHistory.tailCall + +/-- info: 'Ix.Compiler.IxIR1.ExecutionHistory.tailCallSelf' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.ExecutionHistory.tailCallSelf + +/-- info: 'Ix.Compiler.IxIR1.invoke_of_body_run' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.invoke_of_body_run + +/-- info: 'Ix.Compiler.IxIR1.runOp_call_of_body_run' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.runOp_call_of_body_run + +/-- info: 'Ix.Compiler.IxIR1.runOp_callSelf_of_body_run' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.runOp_callSelf_of_body_run + +/-- info: 'Ix.Compiler.IxIR1.applyGo_exact_of_invoke' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.applyGo_exact_of_invoke + +/-- info: 'Ix.Compiler.IxIR1.applyGo_over_of_invoke' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.applyGo_over_of_invoke + +/-- info: 'Ix.Compiler.IxIR1.runOp_apply_exact_of_invoke' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.runOp_apply_exact_of_invoke + +/-- info: 'Ix.Compiler.IxIR1.runOp_apply_over_of_invoke' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.runOp_apply_over_of_invoke + +/-- info: 'Ix.Compiler.IxIR1.runOp_immediate_ctx_eq' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.runOp_immediate_ctx_eq + +/-- info: 'Ix.Compiler.IxIR1.runOp_apply_erased_ctx_eq' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.runOp_apply_erased_ctx_eq + +/-- info: 'Ix.Compiler.IxIR1.runOp_apply_under_ctx_eq' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR1.runOp_apply_under_ctx_eq + +/-- info: 'Ix.Compiler.IxIR2.Lower.CodeTrace.tailCallResult_of_capabilities_match' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.CodeTrace.tailCallResult_of_capabilities_match + +/-- info: 'Ix.Compiler.IxIR2.Lower.Checked.tailCallResult' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Lower.Checked.tailCallResult + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.ApplyMorePlan.sourceRun' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.ApplyMorePlan.sourceRun + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerStackHistory.advance' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerStackHistory.advance + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerStackHistory.complete' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerStackHistory.complete + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerStackCompletion.ordinary' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerStackCompletion.ordinary + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.historyStepOp' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.historyStepOp + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.historyImmediateOp' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.historyImmediateOp + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.returnCompletion' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.returnCompletion + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.returnResumeOfTarget' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.returnResumeOfTarget + +/-! Residual dispatch, whole-main physical reuse, and checked production selection. -/ + +/-- info: 'Ix.Compiler.IxIR2.Eval.runMachine_steps' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.runMachine_steps + +/-- info: 'Ix.Compiler.IxIR2.Reuse.sourceValid_of_invalidTarget' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.sourceValid_of_invalidTarget + +/-- info: 'Ix.Compiler.IxIR2.Reuse.sourceRejected_of_invalidSource' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.sourceRejected_of_invalidSource + +/-- info: 'Ix.Compiler.IxIR2.Reuse.Selection.valid' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.Selection.valid + +/-- info: 'Ix.Compiler.IxIR2.Reuse.selectCheckedWith' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Reuse.selectCheckedWith + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.selectAttachment' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.selectAttachment + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.returnApplyMoreTransfer' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.returnApplyMoreTransfer + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.returnApplyMoreOfTarget' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.CompilerRunningState.returnApplyMoreOfTarget + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.attachedPhysicalCompilerAdvance' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.attachedPhysicalCompilerAdvance + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.OptimizedAttachment.physicalMainSimulation' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.OptimizedAttachment.physicalMainSimulation + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.selectedPhysicalMainSimulation' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.selectedPhysicalMainSimulation + +/-! Baseline interpretation transport and validated source-to-scalar selection. -/ + +/-- info: 'Ix.Compiler.IxIR2.CreditFree.instructionAt' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.CreditFree.instructionAt + +/-- info: 'Ix.Compiler.IxIR2.Eval.runMain_creditFree' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.runMain_creditFree + +/-- info: 'Ix.Compiler.IxIR2.Eval.runMain_success_unique' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.runMain_success_unique + +/-- info: 'Ix.Compiler.IxIR2.Eval.Steps.addHeapFuel' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Steps.addHeapFuel + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.mainInterpretation' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.mainInterpretation + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.successfulPhysicalMainSimulation' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.successfulPhysicalMainSimulation + +/-- info: 'Ix.Compiler.X86.Select.ScalarApply.runs' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Select.ScalarApply.runs + +/-- info: 'Ix.Compiler.X86.Select.sourceWord?_sound' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Select.sourceWord?_sound + +/-- info: 'Ix.Compiler.X86.Select.Output.refinesSuccessfulRun' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Select.Output.refinesSuccessfulRun + +/-- info: 'Ix.Compiler.X86.Select.sourceRefines' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Select.sourceRefines + +/-- info: 'Ix.Compiler.X86.Select.sourceScalarRefines' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Select.sourceScalarRefines + +/-! Immediate-list source recursion recovery. The local evaluator theorem +uses the ordinary Lean basis; the addressed wrappers retain the existing +BLAKE3 hash assumption through the canonical derived declaration identity. -/ + +/-- info: 'Ix.Compiler.IxIR0.Recursion.sourceTuple' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.Recursion.sourceTuple + +/-- info: 'Ix.Compiler.IxIR0.Recursion.recursorForwardSimulation' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.Recursion.recursorForwardSimulation + +/-- info: 'Ix.Compiler.IxIR0.Recursion.Recovered.forwardSimulation' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.Recursion.Recovered.forwardSimulation + +/-- info: 'Ix.Compiler.IxIR0.Recursion.Selection.forwardSimulation' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.Recursion.Selection.forwardSimulation + +/-- info: 'Ix.Compiler.Recursion.Compilation.sourceRefines' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Recursion.Compilation.sourceRefines + +/-! Common ownership lowering and source recursion through selected physical +execution. These compose the existing addressed compiler and reuse proofs; +the existing BLAKE3 assumption is unchanged. -/ + +/-- info: 'Ix.Compiler.Pipeline.LoweredCompilation.exactCompilerContracts' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.LoweredCompilation.exactCompilerContracts + +/-- info: 'Ix.Compiler.Pipeline.LoweredCompilation.addressedOwnedMain' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.LoweredCompilation.addressedOwnedMain + +/-- info: 'Ix.Compiler.IxIR0.Recursion.Recovered.projectionSafe' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.Recursion.Recovered.projectionSafe + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.successfulPhysicalMainSimulation' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.successfulPhysicalMainSimulation + +/-- info: 'Ix.Compiler.Recursion.Lowered.physicalMainSimulation' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Recursion.Lowered.physicalMainSimulation + +/-- info: 'Ix.Compiler.Recursion.Compilation.literalSourceRefines' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Recursion.Compilation.literalSourceRefines + +/-- info: 'Ix.Compiler.Recursion.Compilation.sourceRefinesSelected' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Recursion.Compilation.sourceRefinesSelected + +/-! Physical allocation accounting and selected shared-result reclamation. +The machine and heap-transport lemmas use the ordinary Lean basis; source +composition retains exactly the existing addressed BLAKE3 assumption. -/ + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.allocationAccounting' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.allocationAccounting + +/-- info: 'Ix.Compiler.IxIR2.Eval.runMain_allocationAccounting' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.runMain_allocationAccounting + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableHeapRel.sharedReclamation' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableHeapRel.sharedReclamation + +/-- info: 'Ix.Compiler.Pipeline.LoweredCompilation.reclamation' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.LoweredCompilation.reclamation + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.baselineSharedReclamation' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.baselineSharedReclamation + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.selectedPhysicalMainResources' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.selectedPhysicalMainResources + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.selectedSuccessfulSharedResources' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.selectedSuccessfulSharedResources + +/-- info: 'Ix.Compiler.Recursion.Lowered.physicalMainResources' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Recursion.Lowered.physicalMainResources + +/-- info: 'Ix.Compiler.Recursion.Compilation.sourceRefinesSelectedWithResources' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Recursion.Compilation.sourceRefinesSelectedWithResources + +/-! Comparative allocation/free laws. Counters remain separate from the +semantic relations; source composition retains the existing axiom basis. -/ + +/-- info: 'Ix.Compiler.IxIR2.Eval.InstructionTransferCase.allocationEvents' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.InstructionTransferCase.allocationEvents + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedStep_allocationDelta' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedStep_allocationDelta + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableHeapRel.live_eq' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableHeapRel.live_eq + +/-- info: 'Ix.Compiler.IxIR2.Eval.Result.AllocationLaws.of_accounting' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Result.AllocationLaws.of_accounting + +/-- info: 'Ix.Compiler.IxIR2.Eval.Result.AllocationLaws.reclaimed' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Result.AllocationLaws.reclaimed + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.OptimizedAttachment.physicalMainSimulationWithAllocationEvents' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.OptimizedAttachment.physicalMainSimulationWithAllocationEvents + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.selectedPhysicalMainSimulationWithAllocationEvents' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.selectedPhysicalMainSimulationWithAllocationEvents + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.baselineNoReuses' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.baselineNoReuses + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.selectedPhysicalMainAllocationLaws' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.selectedPhysicalMainAllocationLaws + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.successfulPhysicalAllocationLaws' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.successfulPhysicalAllocationLaws + +/-- info: 'Ix.Compiler.Recursion.Lowered.physicalMainAllocationLaws' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Recursion.Lowered.physicalMainAllocationLaws + +/-- info: 'Ix.Compiler.Recursion.Compilation.sourceRefinesSelectedWithAllocationLaws' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Recursion.Compilation.sourceRefinesSelectedWithAllocationLaws + +/-! Comparative RC and peak-live bounds, including every selected prefix and +complete shared reclamation. The existing axiom basis is unchanged. -/ + +/-- info: 'Ix.Compiler.IxIR2.Eval.releaseSharedWork_observations' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.releaseSharedWork_observations + +/-- info: 'Ix.Compiler.IxIR2.Eval.InstructionTransferCase.rcCharge' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.InstructionTransferCase.rcCharge + +/-- info: 'Ix.Compiler.IxIR2.Eval.Step.peakRecords' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Step.peakRecords + +/-- info: 'Ix.Compiler.IxIR2.Eval.runMachine_prefix_costs' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.runMachine_prefix_costs + +/-- info: 'Ix.Compiler.IxIR2.ReuseSim.StableHeapRel.pendingRC_eq' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseSim.StableHeapRel.pendingRC_eq + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.unchangedStep_costDelta' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.unchangedStep_costDelta + +/-- info: 'Ix.Compiler.IxIR2.Eval.CostDelta.hot' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.CostDelta.hot + +/-- info: 'Ix.Compiler.IxIR2.Eval.CostDelta.cold' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.CostDelta.cold + +/-- info: 'Ix.Compiler.IxIR2.Eval.Result.CostBounds.reclaimed' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Result.CostBounds.reclaimed + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.OptimizedAttachment.physicalMainSimulationWithCosts' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.OptimizedAttachment.physicalMainSimulationWithCosts + +/-- info: 'Ix.Compiler.IxIR2.ReuseLiveSim.selectedPhysicalMainSimulationWithCosts' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.ReuseLiveSim.selectedPhysicalMainSimulationWithCosts + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.successfulPhysicalCostBounds' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.successfulPhysicalCostBounds + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.selectedPrefixCostBounds' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.selectedPrefixCostBounds + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.selectedPhysicalMainCostLaws' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.selectedPhysicalMainCostLaws + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.successfulPhysicalCostLaws' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.successfulPhysicalCostLaws + +/-- info: 'Ix.Compiler.Recursion.Lowered.physicalMainCostLaws' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Recursion.Lowered.physicalMainCostLaws + +/-- info: 'Ix.Compiler.Recursion.Compilation.sourceRefinesSelectedWithCostLaws' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Recursion.Compilation.sourceRefinesSelectedWithCostLaws + +/-! R5: direct-call credit suspension, reservation ownership, actual selected +compiler execution, and closed source-map specialization. -/ + +/-- info: 'Ix.Compiler.IxIR2.Eval.Policy.runMain_v0' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Policy.runMain_v0 + +/-- info: 'Ix.Compiler.IxIR2.Eval.Policy.suspendCall_iff' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Policy.suspendCall_iff + +/-- info: 'Ix.Compiler.IxIR2.Eval.Policy.Step.reservationOwnership' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Policy.Step.reservationOwnership + +/-- info: 'Ix.Compiler.IxIR2.Eval.Policy.Steps.reservationOwnership' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Policy.Steps.reservationOwnership + +/-- info: 'Ix.Compiler.IxIR2.Eval.Policy.runMain_prefix_reservationOwnership' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Policy.runMain_prefix_reservationOwnership + +/-- info: 'Ix.Compiler.IxIR2.Eval.Policy.runMain_allocationAccounting' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Policy.runMain_allocationAccounting + +/-- info: 'Ix.Compiler.IxIR2.Eval.Policy.runMachine_prefix_costs' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Policy.runMachine_prefix_costs + +/-- info: 'Ix.Compiler.IxIR2.Eval.Policy.runMain_success_unique' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.Policy.runMain_success_unique + +/-- info: 'Ix.Compiler.IxIR2.CallReuse.Selection.valid' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.CallReuse.Selection.valid + +/-- info: 'Ix.Compiler.IxIR2.CallReuse.Sim.simulate_to_halt' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.CallReuse.Sim.simulate_to_halt + +/-- info: 'Ix.Compiler.IxIR2.CallReuse.Output.mainSimulation' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.CallReuse.Output.mainSimulation + +/-- info: 'Ix.Compiler.IxIR2.CallReuse.Selection.mainSimulation' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.CallReuse.Selection.mainSimulation + +/-- info: 'Ix.Compiler.Pipeline.LoweredCompilation.owned' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.LoweredCompilation.owned + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.baselineClosed' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.baselineClosed + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.selectedCallPrefixCostBounds' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.selectedCallPrefixCostBounds + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.selectedCallPhysicalMainCostLaws' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.selectedCallPhysicalMainCostLaws + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.successfulCallPhysicalCostLaws' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.successfulCallPhysicalCostLaws + +/-- info: 'Ix.Compiler.CallReuse.Compilation.sourceRefinesWithCostLaws' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.CallReuse.Compilation.sourceRefinesWithCostLaws + +/-- info: 'Ix.Compiler.IxIR0.MapRecovery.sourceMap' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.MapRecovery.sourceMap + +/-- info: 'Ix.Compiler.IxIR0.MapRecovery.targetMap' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.MapRecovery.targetMap + +/-- info: 'Ix.Compiler.IxIR0.MapRecovery.Recovered.forwardSimulation' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.MapRecovery.Recovered.forwardSimulation + +/-- info: 'Ix.Compiler.IxIR0.MapRecovery.Selection.forwardSimulation' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.MapRecovery.Selection.forwardSimulation + +/-- info: 'Ix.Compiler.IxIR0.MapRecovery.Recovered.projectionSafe' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.MapRecovery.Recovered.projectionSafe + +/-- info: 'Ix.Compiler.CallReuse.MapLowered.physicalMainCostLaws' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.CallReuse.MapLowered.physicalMainCostLaws + +/-- info: 'Ix.Compiler.CallReuse.MapCompilation.sourceRefinesWithCostLaws' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.CallReuse.MapCompilation.sourceRefinesWithCostLaws + +/-! Static unique source reversal: saturated source modes, consuming emission, +actual SSA execution, every physical prefix, exact costs, and full release. -/ + +/-- info: 'Ix.Compiler.Pipeline.CertifiedErasure.sourceRefines' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.CertifiedErasure.sourceRefines + +/-- info: 'Ix.Compiler.IxIR0.RecursorInstance.address_eq_iff_bytes_eq' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.RecursorInstance.address_eq_iff_bytes_eq + +/-- info: 'Ix.Compiler.IxIR0.UniqueReverse.Checked.sourceEvaluates' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.UniqueReverse.Checked.sourceEvaluates + +/-- info: 'Ix.Compiler.IxIR0.UniqueReverse.Recovered.forwardSimulation' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.UniqueReverse.Recovered.forwardSimulation + +/-- info: 'Ix.Compiler.UniqueReuse.CheckedSource.sourceValue' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.CheckedSource.sourceValue + +/-- info: 'Ix.Compiler.UniqueReuse.ListAt.hasWorld' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.ListAt.hasWorld + +/-- info: 'Ix.Compiler.UniqueReuse.ListAt.graph' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.ListAt.graph + +/-- info: 'Ix.Compiler.UniqueReuse.consumingLoop' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.consumingLoop + +/-- info: 'Ix.Compiler.UniqueReuse.mainExists' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.mainExists + +/-- info: 'Ix.Compiler.UniqueReuse.consumingMainResult' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.consumingMainResult + +/-- info: 'Ix.Compiler.UniqueReuse.release1' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.release1 + +/-- info: 'Ix.Compiler.UniqueReuse.release2_complete' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.release2_complete + +/-- info: 'Ix.Compiler.UniqueReuse.Target.reserveReuse' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.Target.reserveReuse + +/-- info: 'Ix.Compiler.UniqueReuse.Target.reuseAt_peak' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.Target.reuseAt_peak + +/-- info: 'Ix.Compiler.UniqueReuse.Target.loopSteps' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.Target.loopSteps + +/-- info: 'Ix.Compiler.UniqueReuse.Target.mainSteps' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.Target.mainSteps + +/-- info: 'Ix.Compiler.UniqueReuse.Target.mainRuns' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.Target.mainRuns + +/-- info: 'Ix.Compiler.UniqueReuse.Target.MainResult.reclaims' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.Target.MainResult.reclaims + +/-- info: 'Ix.Compiler.UniqueReuse.Target.prefixResources' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.Target.prefixResources + +/-- info: 'Ix.Compiler.UniqueReuse.Target.costLaws' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.Target.costLaws + +/-- info: 'Ix.Compiler.IxIR2.UniqueLower.Translation.forwardSimulation' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.UniqueLower.Translation.forwardSimulation + +/-- info: 'Ix.Compiler.UniqueReuse.ownedSemantics' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.ownedSemantics + +/-- info: 'Ix.Compiler.UniqueReuse.backendSemantics' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.backendSemantics + +/-- info: 'Ix.Compiler.UniqueReuse.Compilation.sourceRefinesWithCostLaws' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.Compilation.sourceRefinesWithCostLaws + +/-! Bounded native unique reversal: byte-memory realization, full emitted +entry and release runs, and unchanged source-contract/axiom boundaries. -/ + +/-- info: 'Ix.Compiler.X86.Memory.read64_write64' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Memory.read64_write64 + +/-- info: 'Ix.Compiler.X86.UniqueExecution.mainAndRelease' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.UniqueExecution.mainAndRelease + +/-- info: 'Ix.Compiler.X86.UniqueExecution.NativeList.nodup' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.UniqueExecution.NativeList.nodup + +/-- info: 'Ix.Compiler.UniqueReuse.Native.Output.executes' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.Native.Output.executes + +/-- info: 'Ix.Compiler.UniqueReuse.Native.Output.costsAgree' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.Native.Output.costsAgree + +/-- info: 'Ix.Compiler.UniqueReuse.Native.Output.sourceRefines' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.Native.Output.sourceRefines + +/-- info: 'Ix.Compiler.UniqueReuse.Native.SourceNativeResult.witness' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.Native.SourceNativeResult.witness + +/-- info: 'Ix.Compiler.UniqueReuse.Native.Execution.mainSafe' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.Native.Execution.mainSafe + +/-- info: 'Ix.Compiler.UniqueReuse.Native.Execution.releaseSafe' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.Native.Execution.releaseSafe + +/-! General logical/physical credit refinement, both policies and the whole +instruction language. These bridges add no native hashing or new axioms. -/ + +/-- info: 'Ix.Compiler.IxIR2.CreditRefinement.step_related' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.CreditRefinement.step_related + +/-- info: 'Ix.Compiler.IxIR2.CreditRefinement.prefix_resources' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.CreditRefinement.prefix_resources + +/-- info: 'Ix.Compiler.IxIR2.CreditRefinement.runMain_prefix_resources' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.CreditRefinement.runMain_prefix_resources + +/-- info: 'Ix.Compiler.IxIR2.CreditRefinement.checked_runMain_refines' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.CreditRefinement.checked_runMain_refines + +/-- info: 'Ix.Compiler.IxIR2.CreditRefinement.runMain_v0_refines' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.CreditRefinement.runMain_v0_refines + +/-- info: 'Ix.Compiler.IxIR2.CreditRefinement.runMain_refines_independent' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.CreditRefinement.runMain_refines_independent + +/-- info: 'Ix.Compiler.IxIR2.CreditRefinement.OutcomeRel.ownership' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.CreditRefinement.OutcomeRel.ownership + +/-- info: 'Ix.Compiler.IxIR2.CreditRefinement.OutcomeRel.valueGraph' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.CreditRefinement.OutcomeRel.valueGraph + +/-- info: 'Ix.Compiler.IxIR2.CreditRefinement.OutcomeRel.reclamation' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.CreditRefinement.OutcomeRel.reclamation + +/-- info: 'Ix.Compiler.IxIR2.CreditRefinement.checked_runMain_owned' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.CreditRefinement.checked_runMain_owned + +/-! Runtime source application and a single native reversal function. The +native input, validation, execution, and rejection proofs add no semantic +axiom; addressed compiler certificates retain the existing hash axiom. -/ + +/-- info: 'Ix.Compiler.Sim.apply_sim_inlineSharing' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.Sim.apply_sim_inlineSharing + +/-- info: 'Ix.Compiler.UniqueReuse.Runtime.Compilation.sourceRefines' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.Runtime.Compilation.sourceRefines + +/-- info: 'Ix.Compiler.UniqueReuse.Runtime.Compilation.targetRuns' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.Runtime.Compilation.targetRuns + +/-- info: 'Ix.Compiler.UniqueReuse.Runtime.Target.makeInput_valid' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.Runtime.Target.makeInput_valid + +/-- info: 'Ix.Compiler.X86.RuntimeExecution.validationSteps' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.RuntimeExecution.validationSteps + +/-- info: 'Ix.Compiler.X86.RuntimeExecution.executes' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.RuntimeExecution.executes + +/-- info: 'Ix.Compiler.X86.RuntimeExecution.canonical_executes' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.RuntimeExecution.canonical_executes + +/-- info: 'Ix.Compiler.X86.RuntimeExecution.Execution.mainSafe' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.RuntimeExecution.Execution.mainSafe + +/-- info: 'Ix.Compiler.X86.RuntimeExecution.Execution.releaseSafe' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.RuntimeExecution.Execution.releaseSafe + +/-- info: 'Ix.Compiler.X86.RuntimeExecution.lengthRejects' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.RuntimeExecution.lengthRejects + +/-- info: 'Ix.Compiler.X86.RuntimeExecution.capacityRejects' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.RuntimeExecution.capacityRejects + +/-- info: 'Ix.Compiler.UniqueReuse.Runtime.Native.ArgumentRel.graph' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.Runtime.Native.ArgumentRel.graph + +/-- info: 'Ix.Compiler.UniqueReuse.Runtime.Native.Output.sourceRefines' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.Runtime.Native.Output.sourceRefines + +/-- info: 'Ix.Compiler.UniqueReuse.Runtime.Native.costsAgree' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.Runtime.Native.costsAgree + +/-- info: 'Ix.Compiler.UniqueReuse.Runtime.Native.ofNats_exact' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.Runtime.Native.ofNats_exact + +/-- info: 'Ix.Compiler.X86.RuntimeExecution.inputWordsStep_eq' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.X86.RuntimeExecution.inputWordsStep_eq + +/-! Adjacent reserve/reuse counter folding preserves final general-purpose +registers, arena words, and the source-to-object contract without a new semantic axiom. -/ + +/-- info: 'Ix.Compiler.X86.UniqueCounterFold.state_eq' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.UniqueCounterFold.state_eq + +/-- info: 'Ix.Compiler.X86.UniqueCounterFold.trace' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.UniqueCounterFold.trace + +/-- info: 'Ix.Compiler.X86.UniqueCounterFold.instruction_saving' does not depend on any axioms -/ +#guard_msgs in #print axioms Ix.Compiler.X86.UniqueCounterFold.instruction_saving + +/-- info: 'Ix.Compiler.X86.RuntimeTarget.controlCost_saving' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.RuntimeTarget.controlCost_saving + +/-! Borrowed ABI checking, finite closed-program execution certificates, +source agreement, actual RC/peak laws, and checked baseline fallback. -/ + +/-- info: 'Ix.Compiler.IxIR2.Borrow.Checked.valid' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Borrow.Checked.valid + +/-- info: 'Ix.Compiler.IxIR2.Borrow.Checked.exactRewrite' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Borrow.Checked.exactRewrite + +/-- info: 'Ix.Compiler.IxIR2.Borrow.Execution.steps' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Borrow.Execution.steps + +/-- info: 'Ix.Compiler.IxIR2.Borrow.Improved.preservation' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Borrow.Improved.preservation + +/-- info: 'Ix.Compiler.IxIR2.Borrow.Improved.resources' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Borrow.Improved.resources + +/-- info: 'Ix.Compiler.IxIR2.Borrow.Selection.fallbackExact' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Borrow.Selection.fallbackExact + +/-- info: 'Ix.Compiler.Borrow.Improved.sourcePreservation' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Borrow.Improved.sourcePreservation + +/-- info: 'Ix.Compiler.Borrow.Improved.resources' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Borrow.Improved.resources + +/-- info: 'Ix.Compiler.Borrow.Selection.valid' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Borrow.Selection.valid + +/-- info: 'Ix.Compiler.Borrow.Selection.fallbackExact' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Borrow.Selection.fallbackExact + +/-! Open borrowed functions: structurally derived calls and continuations, +exact lender-store preservation, arbitrary owned input reclamation, and +the actual source-to-runtime composition. No input replay selects a variant. -/ + +/-- info: 'Ix.Compiler.IxIR2.Borrow.Open.retain_release_cancel' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Borrow.Open.retain_release_cancel + +/-- info: 'Ix.Compiler.IxIR2.Borrow.Open.Entry.steps' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Borrow.Open.Entry.steps + +/-- info: 'Ix.Compiler.IxIR2.Borrow.Open.Entry.lenderLifetime' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Borrow.Open.Entry.lenderLifetime + +/-- info: 'Ix.Compiler.IxIR2.Borrow.Open.Entry.total' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Borrow.Open.Entry.total + +/-- info: 'Ix.Compiler.IxIR2.Borrow.Open.Certificate.strictImprovement' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Borrow.Open.Certificate.strictImprovement + +/-- info: 'Ix.Compiler.IxIR2.Borrow.Open.Certificate.controlCost' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Borrow.Open.Certificate.controlCost + +/-- info: 'Ix.Compiler.IxIR2.Borrow.Open.Certificate.runFunctions' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Borrow.Open.Certificate.runFunctions + +/-- info: 'Ix.Compiler.Borrow.Runtime.Source.Shape.applies' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.Borrow.Runtime.Source.Shape.applies + +/-- info: 'Ix.Compiler.Borrow.Runtime.Tree.counts' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.Borrow.Runtime.Tree.counts + +/-- info: 'Ix.Compiler.Borrow.Runtime.Argument.input' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.Borrow.Runtime.Argument.input + +/-- info: 'Ix.Compiler.Borrow.Runtime.Certified.sourcePreservation' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Borrow.Runtime.Certified.sourcePreservation + +/-- info: 'Ix.Compiler.Borrow.Runtime.Certified.runtimePreservation' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Borrow.Runtime.Certified.runtimePreservation + +/-- info: 'Ix.Compiler.Borrow.Runtime.Certified.sourceToRuntime' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Borrow.Runtime.Certified.sourceToRuntime + +/-- info: 'Ix.Compiler.Borrow.Runtime.Selection.valid' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Borrow.Runtime.Selection.valid + +/-- info: 'Ix.Compiler.Borrow.Runtime.Selection.fallbackExact' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Borrow.Runtime.Selection.fallbackExact + +/-! E1 consumes actual emitted bytes through an independent parser. All local +encoding, flag, memory-fault and control laws use only the ordinary logical +axioms; whole-stream layout and reference ISA agreement remain separate. -/ + +/-- info: 'Ix.Compiler.X86.Encode.instruction_decodeAt' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Encode.instruction_decodeAt + +/-- info: 'Ix.Compiler.X86.Encode.terminator_decode' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Encode.terminator_decode + +/-- info: 'Ix.Compiler.X86.Encode.encoded_instruction_execution' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Encode.encoded_instruction_execution + +/-- info: 'Ix.Compiler.X86.Encode.compare_execution' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Encode.compare_execution + +/-- info: 'Ix.Compiler.X86.Encode.branch_bytes_execution' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Encode.branch_bytes_execution + +/-- info: 'Ix.Compiler.X86.Encode.branch_patch' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Encode.branch_patch + +/-- info: 'Ix.Compiler.X86.Encode.call_pair' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Encode.call_pair + +/-- info: 'Ix.Compiler.X86.Encode.call_fault' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Encode.call_fault + +/-- info: 'Ix.Compiler.X86.Encode.ret_pair' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Encode.ret_pair + +/-- info: 'Ix.Compiler.X86.Encode.relative_resolves_base' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Encode.relative_resolves_base + +/-- info: 'Ix.Compiler.X86.Encode.patchSigned32_splice' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Encode.patchSigned32_splice + +/-- info: 'Ix.Compiler.X86.Encode.signed32_checked' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Encode.signed32_checked + +/-! E2 composes complete streams, explicit call-slot memory correspondence, +independent ELF interpretation, PC32 relocation and the emitted N2 source +endpoint. Only indexed source claims retain the existing native hash axiom. -/ + +/-- info: 'Ix.Compiler.X86.Stream.pcOffset_injective' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Stream.pcOffset_injective + +/-- info: 'Ix.Compiler.X86.Stream.check_sound' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Stream.check_sound + +/-- info: 'Ix.Compiler.X86.Stream.linear_step' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Stream.linear_step + +/-- info: 'Ix.Compiler.X86.Stream.branch_at' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Stream.branch_at + +/-- info: 'Ix.Compiler.X86.Stream.call_progress' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Stream.call_progress + +/-- info: 'Ix.Compiler.X86.Stream.ret_progress' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Stream.ret_progress + +/-- info: 'Ix.Compiler.X86.Stream.run_to_return' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Stream.run_to_return + +/-- info: 'Ix.Compiler.X86.Stream.run_with_calls' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Stream.run_with_calls + +/-- info: 'Ix.Compiler.X86.Stream.run_permissions' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Stream.run_permissions + +/-- info: 'Ix.Compiler.X86.StreamExamples.reused_safe' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.StreamExamples.reused_safe + +/-- info: 'Ix.Compiler.X86.StreamExamples.nested_safe' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.StreamExamples.nested_safe + +/-- info: 'Ix.Compiler.X86.ELF.check_sound' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.ELF.check_sound + +/-- info: 'Ix.Compiler.X86.ELF.Valid.text' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.ELF.Valid.text + +/-- info: 'Ix.Compiler.X86.ELF.Valid.entry' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.ELF.Valid.entry + +/-- info: 'Ix.Compiler.X86.ELFLink.pc32_call' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.ELFLink.pc32_call + +/-- info: 'Ix.Compiler.X86.ELFLink.Applied.resolves' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.ELFLink.Applied.resolves + +/-- info: 'Ix.Compiler.X86.ELFLink.runtime_call_transfer' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.ELFLink.runtime_call_transfer + +/-- info: 'Ix.Compiler.X86.ObjectEval.run_from_typed' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.ObjectEval.run_from_typed + +/-- info: 'Ix.Compiler.X86.ObjectEval.run_with_calls' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.ObjectEval.run_with_calls + +/-- info: 'Ix.Compiler.UniqueReuse.Runtime.Native.Output.emit_spec' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.Runtime.Native.Output.emit_spec + +/-- info: 'Ix.Compiler.UniqueReuse.Runtime.Native.role_callFree' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.Runtime.Native.role_callFree + +/-- info: 'Ix.Compiler.UniqueReuse.Runtime.Native.Object.provenance_parsed' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.Runtime.Native.Object.provenance_parsed + +/-- info: 'Ix.Compiler.UniqueReuse.Runtime.Native.Output.sourceRefinesObjects' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.UniqueReuse.Runtime.Native.Output.sourceRefinesObjects + +/-! C3 reuses only equal erased preimages. Closed Nat translation validation +and explicit execution certificates compose with the original source bridge. -/ + +/-- info: 'Ix.Compiler.IxIR0.Readdress.blockMembers_eq_of_compatibleBlocks' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.Readdress.blockMembers_eq_of_compatibleBlocks + +/-- info: 'Ix.Compiler.IxIR0.Readdress.members_eq_of_compatibleBlocks' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.Readdress.members_eq_of_compatibleBlocks + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.Attached.sourcePhysical' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.Attached.sourcePhysical + +/-- info: 'Ix.Compiler.X86.NatCalls.Output.refinesSuccessfulRun' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.NatCalls.Output.refinesSuccessfulRun + +/-- info: 'Ix.Compiler.X86.NatCalls.Execution.objectReturns' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.NatCalls.Execution.objectReturns + +/-- info: 'Ix.Compiler.X86.NatCalls.sourceObjectRefines' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.NatCalls.sourceObjectRefines + +/-! C3's static Nat captures preserve exact initializer values and complete +baseline reclamation under the existing closed translation-validation contract. -/ + +/-- info: 'Ix.Compiler.X86.NatCalls.Expr.closed_evaluate' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.NatCalls.Expr.closed_evaluate + +/-- info: 'Ix.Compiler.X86.NatCalls.checkCapture' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.NatCalls.checkCapture + +/-- info: 'Ix.Compiler.X86.NatCalls.StaticCapture.evaluates' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.NatCalls.StaticCapture.evaluates + +/-- info: 'Ix.Compiler.X86.NatCalls.Output.reclaimsSuccessfulRun' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.NatCalls.Output.reclaimsSuccessfulRun + +/-- info: 'Ix.Compiler.X86.NatCalls.sourceObjectReclaims' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.NatCalls.sourceObjectReclaims + +/-! N3's first scalar slice uses universal source/body, frame, call and +object contracts. Source-indexed theorems retain the existing hash boundary. -/ + +/-- info: 'Ix.Compiler.X86.ExactNat.encode_some_iff' depends on axioms: [propext] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.ExactNat.encode_some_iff + +/-- info: 'Ix.Compiler.X86.ExactNat.add_some_iff' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.ExactNat.add_some_iff + +/-- info: 'Ix.Compiler.X86.ExactNat.sub_toNat' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.ExactNat.sub_toNat + +/-- info: 'Ix.Compiler.IxIR0.NatArithmetic.body_applies' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.NatArithmetic.body_applies + +/-- info: 'Ix.Compiler.IxIR0.NatArithmetic.sub_applies' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR0.NatArithmetic.sub_applies + +/-- info: 'Ix.Compiler.X86.Scalar.Evaluates.native' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Scalar.Evaluates.native + +/-- info: 'Ix.Compiler.X86.Scalar.Checked.function_total' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Scalar.Checked.function_total + +/-- info: 'Ix.Compiler.X86.Scalar.Stack.rank_capacity' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Scalar.Stack.rank_capacity + +/-- info: 'Ix.Compiler.X86.ObjectEval.run_safeSteps' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.ObjectEval.run_safeSteps + +/-- info: 'Ix.Compiler.X86.Scalar.RootRun.objectResult' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Scalar.RootRun.objectResult + +/-- info: 'Ix.Compiler.X86.Scalar.Source.programMatches_sound' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Scalar.Source.programMatches_sound + +/-- info: 'Ix.Compiler.X86.Scalar.Source.raw_evaluates' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Scalar.Source.raw_evaluates + +/-- info: 'Ix.Compiler.X86.Scalar.Source.Selected.sourceApplies' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Scalar.Source.Selected.sourceApplies + +/-- info: 'Ix.Compiler.X86.Scalar.Source.Compiled.nativeReturns' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Scalar.Source.Compiled.nativeReturns + +/-- info: 'Ix.Compiler.X86.Scalar.Source.Compiled.sourceReturns' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Scalar.Source.Compiled.sourceReturns + +/-! Compositional selection of actual physical scalar CFGs. -/ + +/-- info: 'Ix.Compiler.X86.PhysicalScalar.atom_sound' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.PhysicalScalar.atom_sound + +/-- info: 'Ix.Compiler.X86.PhysicalScalar.edge_transfer' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.PhysicalScalar.edge_transfer + +/-- info: 'Ix.Compiler.X86.PhysicalScalar.Runs.call' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.PhysicalScalar.Runs.call + +/-- info: 'Ix.Compiler.X86.PhysicalScalar.Code.simulate' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.PhysicalScalar.Code.simulate + +/-- info: 'Ix.Compiler.X86.PhysicalScalar.Selected.contract' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.PhysicalScalar.Selected.contract + +/-- info: 'Ix.Compiler.X86.PhysicalScalar.Runs.agrees' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.PhysicalScalar.Runs.agrees + +/-- info: 'Ix.Compiler.X86.PhysicalScalar.ExportPath.runMain' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.PhysicalScalar.ExportPath.runMain + +/-- info: 'Ix.Compiler.X86.PhysicalScalar.Compiled.nativeReturns' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.PhysicalScalar.Compiled.nativeReturns + +/-- info: 'Ix.Compiler.X86.PhysicalScalar.Compiled.physicalReturns' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.PhysicalScalar.Compiled.physicalReturns + +/-! Runtime source application through actual physical CFG selection. +Source-indexed contracts retain the existing hash boundary. -/ + +/-- info: 'Ix.Compiler.Sim.apply_sim_projectionSafe_with_members' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.Sim.apply_sim_projectionSafe_with_members + +/-- info: 'Ix.Compiler.Sim.applyMany_sim_projectionSafe_inlineSharing' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.Sim.applyMany_sim_projectionSafe_inlineSharing + +/-- info: 'Ix.Compiler.Pipeline.ValidatedCompilation.runtimeApply' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.ValidatedCompilation.runtimeApply + +/-- info: 'Ix.Compiler.Pipeline.ValidatedCompilation.runtimeTraceRenames' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.Pipeline.ValidatedCompilation.runtimeTraceRenames + +/-- info: 'Ix.Compiler.IxIR2.Eval.runFunction_creditFree' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Eval.runFunction_creditFree + +/-- info: 'Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.successfulFunctionSimulation' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.IxIR2.Pipeline.CompiledAttachment.successfulFunctionSimulation + +/-- info: 'Ix.Compiler.X86.PhysicalScalar.closureStore.applied' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.PhysicalScalar.closureStore.applied + +/-- info: 'Ix.Compiler.X86.PhysicalScalar.Exported.sourceFunction' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.PhysicalScalar.Exported.sourceFunction + +/-- info: 'Ix.Compiler.X86.PhysicalScalar.Exported.sourceRun' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.PhysicalScalar.Exported.sourceRun + +/-- info: 'Ix.Compiler.X86.PhysicalScalar.Exported.sourceReturns' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.PhysicalScalar.Exported.sourceReturns + +/-- info: 'Ix.Compiler.X86.PhysicalScalar.Exported.sourceNatReturns' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.PhysicalScalar.Exported.sourceNatReturns + +/-! Captured scalar exports: checked closed initialization, capture binding, +complete reclamation, and universal source-to-object composition. -/ + +/-- info: 'Ix.Compiler.X86.Scalar.Bound.evaluates' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.Scalar.Bound.evaluates + +/-- info: 'Ix.Compiler.X86.PhysicalScalar.Captured.Heap.owned' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.PhysicalScalar.Captured.Heap.owned + +/-- info: 'Ix.Compiler.X86.PhysicalScalar.Captured.Heap.spent_empty' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.PhysicalScalar.Captured.Heap.spent_empty + +/-- info: 'Ix.Compiler.X86.PhysicalScalar.Captured.Heap.applied' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.PhysicalScalar.Captured.Heap.applied + +/-- info: 'Ix.Compiler.X86.PhysicalScalar.Captured.checkInitializer' depends on axioms: [propext, Classical.choice, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.PhysicalScalar.Captured.checkInitializer + +/-- info: 'Ix.Compiler.X86.PhysicalScalar.Captured.Initialized.reclaimed' depends on axioms: [propext, Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.PhysicalScalar.Captured.Initialized.reclaimed + +/-- info: 'Ix.Compiler.X86.PhysicalScalar.Captured.Compiled.nativeReturns' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.PhysicalScalar.Captured.Compiled.nativeReturns + +/-- info: 'Ix.Compiler.X86.PhysicalScalar.Captured.Compiled.physicalReturns' depends on axioms: [propext, + Classical.choice, + Quot.sound] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.PhysicalScalar.Captured.Compiled.physicalReturns + +/-- info: 'Ix.Compiler.X86.PhysicalScalar.Captured.Compiled.sourceFunction' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.PhysicalScalar.Captured.Compiled.sourceFunction + +/-- info: 'Ix.Compiler.X86.PhysicalScalar.Captured.Compiled.sourceRun' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.PhysicalScalar.Captured.Compiled.sourceRun + +/-- info: 'Ix.Compiler.X86.PhysicalScalar.Captured.Compiled.sourceReturns' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.PhysicalScalar.Captured.Compiled.sourceReturns + +/-- info: 'Ix.Compiler.X86.PhysicalScalar.Captured.Compiled.sourceNatReturns' depends on axioms: [propext, + Classical.choice, + Quot.sound, + Blake3.HasherOps.hash._native.native_decide.ax_1✝] -/ +#guard_msgs in #print axioms Ix.Compiler.X86.PhysicalScalar.Captured.Compiled.sourceNatReturns diff --git a/Ix/Compiler/Fuel.lean b/Ix/Compiler/Fuel.lean new file mode 100644 index 000000000..0c8844020 --- /dev/null +++ b/Ix/Compiler/Fuel.lean @@ -0,0 +1,22 @@ +namespace Ix.Compiler + +/-! +# Fuel-order proof utilities + +Evaluator-specific proofs establish stability across one successor step. This +module contains the single order traversal that lifts such a step theorem +across an arbitrary fuel increase. +-/ + +/-- A result preserved by every successor step is preserved by any increase in +fuel. -/ +theorem fuel_mono_of_succ {α : Sort u} {run : Nat → α} {result : α} + {fuel larger : Nat} + (hsucc : ∀ current, run current = result → run (current + 1) = result) + (hle : fuel ≤ larger) (hrun : run fuel = result) : + run larger = result := by + induction hle with + | refl => exact hrun + | step _ ih => exact hsucc _ ih + +end Ix.Compiler diff --git a/Ix/Compiler/IxIR/Decode.lean b/Ix/Compiler/IxIR/Decode.lean new file mode 100644 index 000000000..a7c9a0a79 --- /dev/null +++ b/Ix/Compiler/IxIR/Decode.lean @@ -0,0 +1,470 @@ +import Ix.Compiler.IxIR.Encoding + +/-! +# Strict readers for the addressed IxIR grammar + +These readers are the inverse-facing half of `IxIR.Encoding`. Recursive and +counted inputs are fueled by the enclosing byte array, so malformed input +cannot create a logical nontermination. The raw readers deliberately accept a +slightly wider LEB128 language; declaration entry points call `runCanonical`, +which re-encodes the parsed value and rejects every noncanonical spelling. +-/ + +namespace Ix.Compiler.IxIR.Decode + +open Ix.Compiler.Ixon +open Ix.Compiler.Ixon (Address) + +/-- Decode one arbitrary-precision unsigned LEB128 value. The fuel is supplied +by the enclosing byte array and decreases for every consumed chunk. -/ +def getNatFuel : Nat → GetM Nat + | 0 => throw "natural: recursion limit" + | fuel + 1 => do + let byte ← getU8 + let low := byte.toNat % 128 + if byte.toNat < 128 then + return low + return low + 128 * (← getNatFuel fuel) + +/-- Input-fueled arbitrary-precision unsigned LEB128 reader. -/ +def getNat : GetM Nat := do + let state ← get + getNatFuel (state.bytes.size + 1) + +/-- Decode a one-byte Boolean, rejecting every value other than zero or one. -/ +def getBool : GetM Bool := + getDecodedU8 "boolean" boolOfByte? + +/-- Decode a length-prefixed byte string. -/ +def getBlob : GetM ByteArray := do + let size ← getNat + getBytes size + +/-- Decode canonical UTF-8 beneath the length-prefixed byte grammar. -/ +def getString : GetM String := do + let bytes ← getBlob + match String.fromUTF8? bytes with + | some value => return value + | none => throw "string: invalid UTF-8" + +/-- Decode one fixed-width content address. -/ +def getAddress : GetM Address := + Serialize.get + +/-- Decode exactly `count` values. -/ +def getListN (getOne : GetM α) : Nat → GetM (List α) + | 0 => pure [] + | count + 1 => do + let head ← getOne + return head :: (← getListN getOne count) + +/-- Decode a LEB128-counted list in source order. -/ +def getList (getOne : GetM α) : GetM (List α) := do + let count ← getNat + getListN getOne count + +/-- Decode a LEB128-counted array in source order. -/ +def getArray (getOne : GetM α) : GetM (Array α) := do + let count ← getNat + return (← getListN getOne count).toArray + +/-- Consume an exact fixed byte sequence. -/ +def expectBytes (expected : ByteArray) : GetM Unit := do + let actual ← getBytes expected.size + if actual = expected then + return () + throw "unexpected framing bytes" + +/-- Strict top-level decoder wrapper. Besides full consumption from `runGet`, +successful values must reproduce the complete input byte-for-byte. -/ +def runCanonical (getValue : GetM α) (encode : α → ByteArray) + (bytes : ByteArray) : Except String α := do + let value ← runGet getValue bytes + if encode value = bytes then + return value + throw "noncanonical encoding" + +/-! ## Generic proof layer -/ + +theorem tag_eq_u8Bytes (value : UInt8) : + Encoding.tag value = u8Bytes value := by + apply ByteArray.ext + simp [Encoding.tag, u8Bytes] + +theorem getU8_tag_spec (value : UInt8) : + GetSpec getU8 (Encoding.tag value) value := by + rw [tag_eq_u8Bytes] + exact getU8_spec value + +@[simp] theorem tag_size (value : UInt8) : + (Encoding.tag value).size = 1 := by + rw [tag_eq_u8Bytes] + simp [u8Bytes] + +theorem nat_size_pos (value : Nat) : 0 < (Encoding.nat value).size := by + rw [Encoding.nat] + split + · simp + · simp only [ByteArray.size_append, tag_size] + omega + +theorem getNatFuel_spec (value fuel : Nat) + (hfuel : (Encoding.nat value).size < fuel) : + GetSpec (getNatFuel fuel) (Encoding.nat value) value := by + induction value using Nat.strongRecOn generalizing fuel with + | ind value ih => + by_cases hsmall : value < 128 + · rw [Encoding.nat, dif_pos hsmall] at hfuel ⊢ + cases fuel with + | zero => simp at hfuel + | succ fuel => + let byte := UInt8.ofNat value + let next : UInt8 → GetM Nat := fun decoded => + let low := decoded.toNat % 128 + if decoded.toNat < 128 then pure low + else do return low + 128 * (← getNatFuel fuel) + have hbyte : byte.toNat = value := by + exact UInt8.toNat_ofNat_of_lt' + (show value < 256 by omega) + have hnext : GetSpec (next byte) ByteArray.empty value := by + simp [next, byte, hbyte, hsmall, Nat.mod_eq_of_lt] + exact GetSpec.pure value + have htotal := GetSpec.bind (next := next) + (getU8_tag_spec byte) hnext + simpa [getNatFuel, byte, next] using htotal + · have hlarge : 128 ≤ value := Nat.le_of_not_gt hsmall + rw [Encoding.nat, dif_neg hsmall] at hfuel ⊢ + cases fuel with + | zero => simp at hfuel + | succ fuel => + let quotient := value / 128 + let byte := UInt8.ofNat (128 + value % 128) + have hquotient : quotient < value := by + dsimp [quotient] + exact Nat.div_lt_self (by omega) (by omega) + have hchildFuel : (Encoding.nat quotient).size < fuel := by + dsimp [quotient] + simp only [ByteArray.size_append, tag_size] at hfuel + omega + have hrecursive := ih quotient hquotient fuel hchildFuel + have hbyte : byte.toNat = 128 + value % 128 := by + exact UInt8.toNat_ofNat_of_lt' (show + 128 + value % 128 < 256 by + have := Nat.mod_lt value (by omega : 0 < 128) + omega) + let next : UInt8 → GetM Nat := fun decoded => + let low := decoded.toNat % 128 + if decoded.toNat < 128 then pure low + else do return low + 128 * (← getNatFuel fuel) + have hmapped : + GetSpec + ((fun high => value % 128 + 128 * high) <$> + getNatFuel fuel) + (Encoding.nat quotient) value := by + have hmap := Ixon.ExprLaws.GetSpec.map hrecursive + (fun high => value % 128 + 128 * high) + have hdecompose : value % 128 + 128 * quotient = value := by + exact Nat.mod_add_div value 128 + simpa [hdecompose] using hmap + have hnext : + GetSpec (next byte) (Encoding.nat quotient) value := by + have hnotSmall : ¬byte.toNat < 128 := by + rw [hbyte] + omega + have hlow : byte.toNat % 128 = value % 128 := by + rw [hbyte] + omega + simpa [next, hnotSmall, hlow] using hmapped + have htotal := GetSpec.bind (next := next) + (getU8_tag_spec byte) hnext + simpa [getNatFuel, byte, quotient, next] using htotal + +theorem getNat_spec (value : Nat) : + GetSpec getNat (Encoding.nat value) value := by + intro pre suffix + let fuel := (pre ++ Encoding.nat value ++ suffix).size + 1 + have hfuel : (Encoding.nat value).size < fuel := by + dsimp [fuel] + simp only [ByteArray.size_append] + omega + have hspec := getNatFuel_spec value fuel hfuel pre suffix + simpa [getNat, fuel] using hspec + +theorem getBlob_spec (value : ByteArray) : + GetSpec getBlob (Encoding.blob value) value := by + have htotal := GetSpec.bind (next := getBytes) + (getNat_spec value.size) (getBytes_spec value) + simpa [getBlob, Encoding.blob] using htotal + +theorem string_fromUTF8_toUTF8 (value : String) : + String.fromUTF8? value.toUTF8 = some value := by + unfold String.fromUTF8? + have hvalid : value.toUTF8.IsValidUTF8 := by + simpa using value.isValidUTF8 + rw [dif_pos hvalid] + congr + +theorem toUTF8_of_fromUTF8 {bytes : ByteArray} {value : String} + (hdecode : String.fromUTF8? bytes = some value) : + value.toUTF8 = bytes := by + unfold String.fromUTF8? at hdecode + split at hdecode + · cases hdecode + rfl + · contradiction + +theorem getString_spec (value : String) : + GetSpec getString (Encoding.string value) value := by + let finish : ByteArray → GetM String := fun bytes => + match String.fromUTF8? bytes with + | some decoded => pure decoded + | none => throw "string: invalid UTF-8" + have hfinish : GetSpec (finish value.toUTF8) ByteArray.empty value := by + unfold finish + rw [string_fromUTF8_toUTF8] + exact GetSpec.pure value + have htotal := GetSpec.bind (next := finish) + (getBlob_spec value.toUTF8) hfinish + simpa [getString, Encoding.string, finish] using htotal + +theorem expectBytes_spec (expected : ByteArray) : + GetSpec (expectBytes expected) expected () := by + intro pre suffix + simp only [expectBytes, StateT.run_bind] + rw [getBytes_spec expected pre suffix] + simp only [bind, Except.bind] + simp + change (Except.ok ((), + (⟨pre ++ expected ++ suffix, pre.size + expected.size⟩ : GetState)) : + Except String (Unit × GetState)) = _ + rfl + +theorem getBool_spec (value : Bool) : + GetSpec getBool (Encoding.bool value) value := by + cases value with + | false => + simpa [getBool, Encoding.bool, tag_eq_u8Bytes, boolOfByte?] using + (Ixon.ConstLaws.getDecodedU8_spec "boolean" boolOfByte? + (fun value : Bool => if value then 1 else 0) + (by intro value; cases value <;> rfl) false) + | true => + simpa [getBool, Encoding.bool, tag_eq_u8Bytes, boolOfByte?] using + (Ixon.ConstLaws.getDecodedU8_spec "boolean" boolOfByte? + (fun value : Bool => if value then 1 else 0) + (by intro value; cases value <;> rfl) true) + +theorem getAddress_spec (value : Address) : + GetSpec getAddress (Encoding.address value) value := by + simpa [getAddress, Encoding.address] using Address.get_spec value + +theorem getSpecMap {getValue : GetM α} {input : ByteArray} {value : α} + (hspec : GetSpec getValue input value) (map : α → β) : + GetSpec (map <$> getValue) input (map value) := + Ixon.ExprLaws.GetSpec.map hspec map + +theorem getSpecMap2 {getLeft : GetM α} {getRight : GetM β} + {leftBytes rightBytes : ByteArray} {left : α} {right : β} + (hleft : GetSpec getLeft leftBytes left) + (hright : GetSpec getRight rightBytes right) (map : α → β → γ) : + GetSpec (do + let decodedLeft ← getLeft + let decodedRight ← getRight + return map decodedLeft decodedRight) + (leftBytes ++ rightBytes) (map left right) := by + let next : α → GetM γ := fun decodedLeft => + map decodedLeft <$> getRight + have hnext := getSpecMap hright (map left) + have htotal := GetSpec.bind (next := next) hleft hnext + simpa [next] using htotal + +theorem getSpecMap3 {getFirst : GetM α} {getSecond : GetM β} + {getThird : GetM γ} {firstBytes secondBytes thirdBytes : ByteArray} + {first : α} {second : β} {third : γ} + (hfirst : GetSpec getFirst firstBytes first) + (hsecond : GetSpec getSecond secondBytes second) + (hthird : GetSpec getThird thirdBytes third) + (map : α → β → γ → δ) : + GetSpec (do + let decodedFirst ← getFirst + let decodedSecond ← getSecond + let decodedThird ← getThird + return map decodedFirst decodedSecond decodedThird) + (firstBytes ++ secondBytes ++ thirdBytes) + (map first second third) := by + let afterFirst : α → GetM δ := fun decodedFirst => do + let decodedSecond ← getSecond + let decodedThird ← getThird + return map decodedFirst decodedSecond decodedThird + have htail := getSpecMap2 hsecond hthird (map first) + have htotal := GetSpec.bind (next := afterFirst) hfirst htail + simpa [afterFirst, ByteArray.append_assoc] using htotal + +theorem getSpecMap4 {getFirst : GetM α} {getSecond : GetM β} + {getThird : GetM γ} {getFourth : GetM δ} + {firstBytes secondBytes thirdBytes fourthBytes : ByteArray} + {first : α} {second : β} {third : γ} {fourth : δ} + (hfirst : GetSpec getFirst firstBytes first) + (hsecond : GetSpec getSecond secondBytes second) + (hthird : GetSpec getThird thirdBytes third) + (hfourth : GetSpec getFourth fourthBytes fourth) + (map : α → β → γ → δ → ε) : + GetSpec (do + let decodedFirst ← getFirst + let decodedSecond ← getSecond + let decodedThird ← getThird + let decodedFourth ← getFourth + return map decodedFirst decodedSecond decodedThird decodedFourth) + (firstBytes ++ secondBytes ++ thirdBytes ++ fourthBytes) + (map first second third fourth) := by + let afterFirst : α → GetM ε := fun decodedFirst => do + let decodedSecond ← getSecond + let decodedThird ← getThird + let decodedFourth ← getFourth + return map decodedFirst decodedSecond decodedThird decodedFourth + have htail := getSpecMap3 hsecond hthird hfourth (map first) + have htotal := GetSpec.bind (next := afterFirst) hfirst htail + simpa [afterFirst, ByteArray.append_assoc] using htotal + +/-- Concatenated element payload beneath a counted sequence. -/ +def listBytes (encode : α → ByteArray) : List α → ByteArray + | [] => ByteArray.empty + | head :: tail => encode head ++ listBytes encode tail + +theorem foldl_append_eq (encode : α → ByteArray) (values : List α) + (initial : ByteArray) : + values.foldl (fun output value => output ++ encode value) initial = + initial ++ listBytes encode values := by + induction values generalizing initial with + | nil => simp [listBytes] + | cons head tail ih => + simp only [List.foldl_cons, listBytes] + rw [ih] + simp [ByteArray.append_assoc] + +theorem listBytes_eq_foldl (encode : α → ByteArray) (values : List α) : + listBytes encode values = + values.foldl (fun output value => output ++ encode value) + ByteArray.empty := by + rw [foldl_append_eq] + simp + +theorem getListN_spec (getOne : GetM α) (encode : α → ByteArray) + (hone : ∀ value, GetSpec getOne (encode value) value) + (values : List α) : + GetSpec (getListN getOne values.length) + (listBytes encode values) values := by + induction values with + | nil => exact GetSpec.pure [] + | cons head tail ih => + have htail := Ixon.ExprLaws.GetSpec.map ih (head :: ·) + let next : α → GetM (List α) := fun decoded => + (decoded :: ·) <$> getListN getOne tail.length + have htotal := GetSpec.bind (next := next) (hone head) htail + simpa [next, getListN, listBytes] using htotal + +theorem getListN_spec_of (getOne : GetM α) (encode : α → ByteArray) + (property : α → Prop) + (hone : ∀ value, property value → GetSpec getOne (encode value) value) + (values : List α) (hvalues : ∀ value ∈ values, property value) : + GetSpec (getListN getOne values.length) + (listBytes encode values) values := by + induction values with + | nil => exact GetSpec.pure [] + | cons head tail ih => + have hhead : property head := hvalues head (by simp) + have htailProperty : ∀ value ∈ tail, property value := by + intro value hvalue + exact hvalues value (by simp [hvalue]) + have htail := Ixon.ExprLaws.GetSpec.map (ih htailProperty) (head :: ·) + let next : α → GetM (List α) := fun decoded => + (decoded :: ·) <$> getListN getOne tail.length + have htotal := GetSpec.bind (next := next) (hone head hhead) htail + simpa [next, getListN, listBytes] using htotal + +theorem list_eq_counted (encode : α → ByteArray) (values : List α) : + Encoding.list encode values = + Encoding.nat values.length ++ listBytes encode values := by + simp only [Encoding.list] + rw [listBytes_eq_foldl] + +theorem getList_spec (getOne : GetM α) (encode : α → ByteArray) + (hone : ∀ value, GetSpec getOne (encode value) value) + (values : List α) : + GetSpec (getList getOne) (Encoding.list encode values) values := by + have hlist := getListN_spec getOne encode hone values + let next : Nat → GetM (List α) := fun count => getListN getOne count + have htotal := GetSpec.bind (next := next) + (getNat_spec values.length) hlist + simpa [getList, list_eq_counted, next] using htotal + +theorem getList_spec_of (getOne : GetM α) (encode : α → ByteArray) + (property : α → Prop) + (hone : ∀ value, property value → GetSpec getOne (encode value) value) + (values : List α) (hvalues : ∀ value ∈ values, property value) : + GetSpec (getList getOne) (Encoding.list encode values) values := by + have hlist := getListN_spec_of getOne encode property hone values hvalues + let next : Nat → GetM (List α) := fun count => getListN getOne count + have htotal := GetSpec.bind (next := next) + (getNat_spec values.length) hlist + simpa [getList, list_eq_counted, next] using htotal + +theorem array_eq_counted (encode : α → ByteArray) (values : Array α) : + Encoding.array encode values = + Encoding.nat values.size ++ listBytes encode values.toList := by + simp only [Encoding.array] + rw [listBytes_eq_foldl] + rw [Array.foldl_toList] + +theorem getArray_spec (getOne : GetM α) (encode : α → ByteArray) + (hone : ∀ value, GetSpec getOne (encode value) value) + (values : Array α) : + GetSpec (getArray getOne) (Encoding.array encode values) values := by + have hlist := getListN_spec getOne encode hone values.toList + have harray := Ixon.ExprLaws.GetSpec.map hlist List.toArray + let next : Nat → GetM (Array α) := fun count => + List.toArray <$> getListN getOne count + have htotal := GetSpec.bind (next := next) + (getNat_spec values.size) harray + simpa [getArray, array_eq_counted, next] using htotal + +theorem getArray_spec_of (getOne : GetM α) (encode : α → ByteArray) + (property : α → Prop) + (hone : ∀ value, property value → GetSpec getOne (encode value) value) + (values : Array α) + (hvalues : ∀ value ∈ values.toList, property value) : + GetSpec (getArray getOne) (Encoding.array encode values) values := by + have hlist := getListN_spec_of getOne encode property hone values.toList hvalues + have harray := Ixon.ExprLaws.GetSpec.map hlist List.toArray + let next : Nat → GetM (Array α) := fun count => + List.toArray <$> getListN getOne count + have htotal := GetSpec.bind (next := next) + (getNat_spec values.size) harray + simpa [getArray, array_eq_counted, next] using htotal + +theorem runCanonical_of_spec (getValue : GetM α) (encode : α → ByteArray) + (value : α) (hspec : GetSpec getValue (encode value) value) : + runCanonical getValue encode (encode value) = .ok value := by + unfold runCanonical + rw [runGet_eq_ok_of_spec hspec] + simp only [bind, Except.bind] + simp + change (Except.ok value : Except String α) = .ok value + rfl + +theorem runCanonical_canonical (getValue : GetM α) + (encode : α → ByteArray) {bytes : ByteArray} {value : α} + (hdecode : runCanonical getValue encode bytes = .ok value) : + encode value = bytes := by + simp only [runCanonical] at hdecode + cases hrun : runGet getValue bytes with + | error error => rw [hrun] at hdecode; contradiction + | ok decoded => + rw [hrun] at hdecode + simp only [bind, Except.bind] at hdecode + split at hdecode + · rename_i heq + cases hdecode + exact heq + · contradiction + +end Ix.Compiler.IxIR.Decode diff --git a/Ix/Compiler/IxIR/Encoding.lean b/Ix/Compiler/IxIR/Encoding.lean new file mode 100644 index 000000000..1a3b96e48 --- /dev/null +++ b/Ix/Compiler/IxIR/Encoding.lean @@ -0,0 +1,78 @@ +import Ix.Compiler.Ixon.Hash + +/-! +# Canonical byte primitives for addressed IR artifacts + +IxIR₀ and IxIR₁ use a small private grammar for hash preimages. It is not the +Ixon wire format: domains are versioned independently so changing a backend IR +cannot silently preserve an old artifact identity. + +Natural numbers use canonical unsigned LEB128 over arbitrary-precision Lean +`Nat`; unlike a `Nat.toUInt64` shortcut, this is total and cannot truncate. +Variable-length byte strings and arrays carry a LEB128 length, addresses are +exactly 32 raw bytes, and every sum constructor has a one-byte tag. These +rules make every concatenation boundary explicit. +-/ + +namespace Ix.Compiler.IxIR.Encoding + +/-- One tag byte. -/ +def tag (value : UInt8) : ByteArray := + ByteArray.mk #[value] + +/-- Canonical unsigned LEB128 for an arbitrary natural number. -/ +def nat (value : Nat) : ByteArray := + if _h : value < 128 then + tag (UInt8.ofNat value) + else + tag (UInt8.ofNat (128 + value % 128)) ++ nat (value / 128) +termination_by value +decreasing_by + apply Nat.div_lt_self + · omega + · omega + +/-- A Boolean as exactly one byte. -/ +def bool : Bool → ByteArray + | false => tag 0 + | true => tag 1 + +/-- Length-prefixed raw bytes. -/ +def blob (bytes : ByteArray) : ByteArray := + nat bytes.size ++ bytes + +/-- Length-prefixed UTF-8. -/ +def string (value : String) : ByteArray := + blob value.toUTF8 + +/-- A content address in its fixed-width raw representation. -/ +def address (value : Ixon.Address) : ByteArray := + value.hash + +/-- Length-prefixed array preserving source order. -/ +def array (encode : α → ByteArray) (values : Array α) : ByteArray := + nat values.size ++ + values.foldl (fun output value => output ++ encode value) ByteArray.empty + +/-- Length-prefixed list preserving source order. -/ +def list (encode : α → ByteArray) (values : List α) : ByteArray := + nat values.length ++ + values.foldl (fun output value => output ++ encode value) ByteArray.empty + +/-- A versioned ASCII domain prefix. Callers use a trailing NUL to keep the +domain boundary visible to non-Lean implementations. -/ +def domain (name : String) : ByteArray := + name.toUTF8 + +/-! Frozen primitive spellings. -/ + +#guard nat 0 == ByteArray.mk #[0] +#guard nat 127 == ByteArray.mk #[127] +#guard nat 128 == ByteArray.mk #[128, 1] +#guard nat 255 == ByteArray.mk #[255, 1] +#guard nat 16384 == ByteArray.mk #[128, 128, 1] +#guard nat (2 ^ 64) == + ByteArray.mk #[128, 128, 128, 128, 128, 128, 128, 128, 128, 2] +#guard array nat #[1, 128] == ByteArray.mk #[2, 1, 128, 1] + +end Ix.Compiler.IxIR.Encoding diff --git a/Ix/Compiler/IxIR0/Basic.lean b/Ix/Compiler/IxIR0/Basic.lean new file mode 100644 index 000000000..0be933412 --- /dev/null +++ b/Ix/Compiler/IxIR0/Basic.lean @@ -0,0 +1,187 @@ +import Ix.Compiler.Ixon.Uses +import Ix.Compiler.AddressEnv + +/-! +# IxIR₀: the erased core IR + +The first IR after erasure and the semantic anchor of the backend +pipeline: every later stage (IxIR₀ˢ, IxIR₁, IxIR₂) refines IxIR₀'s +big-step semantics (`Eval.lean`), and the first theorem target is the +erasure simulation Ixon → IxIR₀. + +Shape: an untyped, pure, **curried** λ-calculus (environment +semantics, no store — the heap appears at IxIR₁) with literals and +content-addressed globals: definitions, constructors, recursors, and +trusted externs. The IR boundaries are recorded in `docs/compiler/compiler-design.md`; +the key choices encoded here are: + +- **Functional big-step + fuel** (CakeML-style): executable and + proof-ergonomic; relational wrappers are derived, and termination + claims are ∃-fuel statements. +- **CBV, strict lets**; left-to-right application order. +- **Curried** application mirroring Ixon; saturation/arity analysis + arrives at IxIR₁ (the `papp`/`apply` vocabulary). +- **Recursor ι from day one**: recursors are declarations carrying + rules; see `RecRule` for the environment convention that replaces + self-reference. +- **Externs as oracle**: an extern declaration is just an arity; its + semantics is a parametric oracle keyed by address — the + trusted-extern ledger's formal hook (`docs/compiler/trusted-extern-ledger.md`). +- **No cost model here**: cost instrumentation attaches to IxIR₁ + memory ops, never to IxIR₀ steps or fuel. + +## The erasure contract + +What the erasure pass Ixon → IxIR₀ (`Ix/Compiler/Erase.lean`) must +produce; hand-written examples must obey the same discipline: + +- 0-mode (`Uses.erased`) binders and arguments are **dropped**, not + boxed. Sound because 0-positions must be kernel-total (gate decision + (a): references to opaque/`partial`/extern constants at mode 0 are + rejected upstream). +- Types, sorts, Pi's, motives, and index arguments are erased. A + type-valued *occurrence* in a relevant position becomes + `Expr.erased` (Coq extraction's ◻); it absorbs application and + projection. +- **Constructor values carry kept fields only** — never parameters. + Params are not projectable, so they need no runtime representation + (Lean's own object model agrees). A `Decl.ctor`'s arity is its + kept-field count; erasure drops param arguments at application + sites. +- Quotients are compiled away (`Quot.mk r a ↦ a`, `Quot.lift f h q ↦ + f q`) — no IxIR₀ support needed. +- Binder modes (`Uses` on `lam`/`letE`) survive erasure with the + invariant uses ≠ erased. They are **semantically inert** at this + level — the interpreter ignores them — and exist so IxIR₁'s + mode-directed memory lowering never re-runs usage analysis. (Ixon + lets carry no mode; the erasure pass synthesizes it.) + +## Deliberately absent (recorded, not forgotten) + +- Mutual blocks / Ixon `rec_`: self-recursive recursors (`Nat.rec`, + `List.rec`) are covered by the `RecRule` environment convention; + *mutually-inductive* recursor families need block references and + arrive when real corpora do (via the ix merge — the standalone + importer is skipped, JCB 2026-08-12). +- Literal↔constructor coherence beyond `natLit` major-peeling. The source + evaluator has opt-in, address-configured String constructor expansion, but + certified erasure disables it until this target has a representation-aware + counterpart. The GMP-extern vs unary-ctor story remains a separate gate. +- K-like reduction, structure eta, and `False.rec`-style + unreachability (erasure will need an answer; candidates: `erased`, + or an explicit `unreachable` extern on the ledger). +- Canonical declaration preimages and BLAKE3 address APIs live in + `IxIR0/Serialize.lean`; strict declaration decoding lives in `Decode.lean`, + and the cycle-safe symbolic block envelope plus final-key materializer live + in `MutualBlock.lean`. Threading that block map through erasure and its + simulations remains active before cached fixpoints can consume every key. +-/ + +namespace Ix.Compiler.IxIR0 + +open Ix.Compiler.Ixon (Uses Address Owned) + +/-- Scalar literals surviving erasure (Ixon `natl`/`strl`). Machine +scalars (`UInt64`, …) appear only from IxIR₀ˢ on, as unboxings of +these. -/ +inductive Literal where + | nat (n : Nat) + | str (s : String) + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- IxIR₀ expressions: nameless (de Bruijn), erased, curried. -/ +inductive Expr where + /-- de Bruijn index into the evaluation environment. -/ + | var (idx : Nat) + /-- Reference to a global declaration by content address. -/ + | ref (adr : Address) + | app (fn arg : Expr) + /-- One binder; `uses ≠ erased` (erased binders are dropped by + erasure). The mode is semantically inert here. -/ + | lam (uses : Uses) (body : Expr) + /-- Strict let. Not sugar for a β-redex because IxIR₁'s + let-normalized (GRIN-style) world wants it explicit. -/ + | letE (uses : Uses) (val body : Expr) + /-- Projection of the `idx`-th **kept** field of a structure value. -/ + | proj (idx : Nat) (struct : Expr) + | lit (l : Literal) + /-- ◻: an erased occurrence in a relevant position. Absorbs + application and projection. -/ + | erased + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- One ι-rule of a recursor, selected by the major premise's +constructor tag. `rhs` is an open term evaluated in the environment + + fields.reverse ++ preMajor.reverse ++ [recursorValue] + +i.e. de Bruijn 0 is the **last** constructor field, then earlier +fields, then the recursor's pre-major arguments last-to-first, and +finally (deepest) the recursor itself as an unapplied value — the +content-addressing-safe replacement for a self-`ref`, since a +recursor's rules cannot address the recursor without a hash cycle. + +A kernel rule `fun params motives minors fields => …` erases to this +shape by dropping motives (and erased params/fields) and mapping +recursive occurrences of the recursor constant to the deepest +variable. `fields` is the kept-field count of the matching +constructor, checked at ι-time. -/ +structure RecRule where + fields : Nat + rhs : Expr + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- Global declarations, keyed by content address in an `Env`. The +inductive *type* itself has no declaration — types are erased; only +its constructors and recursor survive. -/ +inductive Decl where + /-- A definition whose returned heap value lives in `result`; + scalars are ownership-polymorphic. `body` must be closed. Evaluated + at each `ref` (call-by-name at globals — spec-grade; the backend + compiles, it never interprets). -/ + | defn (result : Owned) (body : Expr) + /-- A constructor: `tag` is its index in the inductive, `arity` its + kept-field count (params are never stored). -/ + | ctor (tag arity : Nat) + /-- A recursor: `numArgs` kept arguments *before* the major premise + (post-erasure: kept params + minors; motives and indices are + erased), so the firing arity is `numArgs + 1`. `natLit` enables + Nat-literal peeling of the major (`0 ↦ tag 0 []`, `n+1 ↦ tag 1 + [lit n]`) — set only on `Nat.rec` by the lowering; general + literal↔ctor coherence is a recorded gate. `rules` is indexed by + constructor tag. -/ + | recursor (numArgs : Nat) (natLit : Bool) (rules : Array RecRule) + /-- A trusted extern of the given arity; semantics supplied by the + evaluation oracle (the ledger's formal hook). -/ + | extern (arity : Nat) + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- The closed world: a Merkle-DAG of declarations as a partial map. The +kernel-facing representation stays a proof-friendly function; its list +constructor has a proved hash-index implementation for generated code. -/ +abbrev Env := Address → Option Decl + +def Env.empty : Env := fun _ => none + +def Env.ofList (l : List (Address × Decl)) : Env := + fun a => (l.find? (fun p => p.1 == a)).map (·.2) + +namespace Env + +/-- The explicitly staged runtime representation of an environment. -/ +abbrev Index := AddressEnv.Index Decl + +def Index.ofList (l : List (Address × Decl)) : Index := + AddressEnv.build l + +def Index.toEnv (index : Index) : Env := + AddressEnv.lookup index + +/-- The runtime index implements the transparent first-binding-wins model. -/ +@[simp] theorem Index.toEnv_ofList (l : List (Address × Decl)) : + (Index.ofList l).toEnv = Env.ofList l := by + exact AddressEnv.lookup_build l + +end Env + +end Ix.Compiler.IxIR0 diff --git a/Ix/Compiler/IxIR0/Decode.lean b/Ix/Compiler/IxIR0/Decode.lean new file mode 100644 index 000000000..3e5d26c1c --- /dev/null +++ b/Ix/Compiler/IxIR0/Decode.lean @@ -0,0 +1,357 @@ +import Ix.Compiler.IxIR.Decode +import Ix.Compiler.IxIR0.Serialize + +/-! +# Strict IxIR₀ declaration decoding + +The public entry point consumes the complete versioned declaration preimage, +requires full input consumption, and re-encodes the result before accepting it. +The raw recursive expression reader is input-fueled; the proofs below show the +fuel is sufficient for every encoded declaration. +-/ + +namespace Ix.Compiler.IxIR0 + +open Ix.Compiler.Ixon +open Ix.Compiler.IxIR +open Ix.Compiler.IxIR.Decode + +def getLiteralTag : UInt8 → GetM Literal + | 0 => do return .nat (← Decode.getNat) + | 1 => do return .str (← Decode.getString) + | tag => throw s!"IxIR0 literal: invalid tag {tag}" + +def getLiteral : GetM Literal := do + getLiteralTag (← getU8) + +def getUses : GetM Uses := + getDecodedU8 "IxIR0 uses" Uses.ofBits? + +def getOwned : GetM Owned := + getDecodedU8 "IxIR0 ownership" Owned.ofBits? + +def getExprTag (recur : GetM Expr) : UInt8 → GetM Expr + | 0 => do return .var (← Decode.getNat) + | 1 => do return .ref (← Decode.getAddress) + | 2 => do return .app (← recur) (← recur) + | 3 => do return .lam (← getUses) (← recur) + | 4 => do + let uses ← getUses + let value ← recur + return .letE uses value (← recur) + | 5 => do return .proj (← Decode.getNat) (← recur) + | 6 => do return .lit (← getLiteral) + | 7 => pure .erased + | tag => throw s!"IxIR0 expression: invalid tag {tag}" + +def getExprFuel : Nat → GetM Expr + | 0 => throw "IxIR0 expression: recursion limit" + | fuel + 1 => do + getExprTag (getExprFuel fuel) (← getU8) + +def getExpr : GetM Expr := do + let state ← get + getExprFuel (state.bytes.size + 1) + +def getRecRule : GetM RecRule := do + return ⟨← Decode.getNat, ← getExpr⟩ + +def getDeclTag : UInt8 → GetM Decl + | 0 => do return .defn (← getOwned) (← getExpr) + | 1 => do return .ctor (← Decode.getNat) (← Decode.getNat) + | 2 => do + let numArgs ← Decode.getNat + let natLit ← Decode.getBool + return .recursor numArgs natLit (← Decode.getArray getRecRule) + | 3 => do return .extern (← Decode.getNat) + | tag => throw s!"IxIR0 declaration: invalid tag {tag}" + +def getDeclPayload : GetM Decl := do + getDeclTag (← getU8) + +def getDeclPreimage : GetM Decl := do + Decode.expectBytes Decl.addressDomain + getDeclPayload + +/-- Decode one complete canonical IxIR₀ declaration preimage. -/ +def Decl.decodePreimage (bytes : ByteArray) : Except String Decl := + Decode.runCanonical getDeclPreimage Decl.preimage bytes + +/-! ## Cursor-relative roundtrip proofs -/ + +theorem getLiteral_spec : ∀ value : Literal, + GetSpec getLiteral value.bytes value + | .nat number => by + have hpayload := Decode.getSpecMap (Decode.getNat_spec number) Literal.nat + have htotal := GetSpec.bind (next := getLiteralTag) + (Decode.getU8_tag_spec 0) hpayload + simpa only [getLiteral, Literal.bytes] using htotal + | .str string => by + have hpayload := Decode.getSpecMap (Decode.getString_spec string) Literal.str + have htotal := GetSpec.bind (next := getLiteralTag) + (Decode.getU8_tag_spec 1) hpayload + simpa only [getLiteral, Literal.bytes] using htotal + +theorem getUses_spec (value : Uses) : + GetSpec getUses (Encoding.tag value.toBits) value := by + rw [Decode.tag_eq_u8Bytes] + exact Ixon.ConstLaws.getDecodedU8_spec "IxIR0 uses" Uses.ofBits? + Uses.toBits Uses.ofBits?_toBits value + +theorem getOwned_spec (value : Owned) : + GetSpec getOwned (Encoding.tag value.toBits) value := by + rw [Decode.tag_eq_u8Bytes] + exact Ixon.ConstLaws.getDecodedU8_spec "IxIR0 ownership" Owned.ofBits? + Owned.toBits Owned.ofBits?_toBits value + +/-- Recursive parser depth; every encoded expression has at least this many +constructor-tag bytes along its deepest branch. -/ +def Expr.decodeDepth : Expr → Nat + | .var _ | .ref _ | .lit _ | .erased => 1 + | .app function argument => + 1 + Nat.max function.decodeDepth argument.decodeDepth + | .lam _ body => 1 + body.decodeDepth + | .letE _ value body => + 1 + Nat.max value.decodeDepth body.decodeDepth + | .proj _ target => 1 + target.decodeDepth + +theorem Expr.decodeDepth_pos (expression : Expr) : + 0 < expression.decodeDepth := by + cases expression <;> simp only [Expr.decodeDepth] <;> omega + +theorem Expr.decodeDepth_le_bytes (expression : Expr) : + expression.decodeDepth ≤ expression.bytes.size := by + induction expression with + | var index => simp [Expr.decodeDepth, Expr.bytes] + | ref address => simp [Expr.decodeDepth, Expr.bytes] + | app function argument hfunction hargument => + simp only [Expr.decodeDepth, Expr.bytes, ByteArray.size_append, + Decode.tag_size] + have hleft : function.decodeDepth ≤ + function.bytes.size + argument.bytes.size := by omega + have hright : argument.decodeDepth ≤ + function.bytes.size + argument.bytes.size := by omega + have hmax : Nat.max function.decodeDepth argument.decodeDepth ≤ + function.bytes.size + argument.bytes.size := + Nat.max_le.mpr ⟨hleft, hright⟩ + omega + | lam uses body hbody => + simp only [Expr.decodeDepth, Expr.bytes, ByteArray.size_append, + Decode.tag_size] + omega + | letE uses value body hvalue hbody => + simp only [Expr.decodeDepth, Expr.bytes, ByteArray.size_append, + Decode.tag_size] + have hleft : value.decodeDepth ≤ value.bytes.size + body.bytes.size := by + omega + have hright : body.decodeDepth ≤ value.bytes.size + body.bytes.size := by + omega + have hmax : Nat.max value.decodeDepth body.decodeDepth ≤ + value.bytes.size + body.bytes.size := + Nat.max_le.mpr ⟨hleft, hright⟩ + omega + | proj index target htarget => + simp only [Expr.decodeDepth, Expr.bytes, ByteArray.size_append, + Decode.tag_size] + omega + | lit literal => + simp only [Expr.decodeDepth, Expr.bytes, ByteArray.size_append, + Decode.tag_size] + omega + | erased => simp [Expr.decodeDepth, Expr.bytes] + +theorem getExprFuel_spec (expression : Expr) (fuel : Nat) + (hfuel : expression.decodeDepth < fuel) : + GetSpec (getExprFuel fuel) expression.bytes expression := by + induction expression generalizing fuel with + | var index => + cases fuel with + | zero => omega + | succ fuel => + have hpayload := Decode.getSpecMap (Decode.getNat_spec index) Expr.var + have htotal := GetSpec.bind + (next := getExprTag (getExprFuel fuel)) + (Decode.getU8_tag_spec 0) hpayload + simpa only [getExprFuel, Expr.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | ref address => + cases fuel with + | zero => omega + | succ fuel => + have hpayload := Decode.getSpecMap + (Decode.getAddress_spec address) Expr.ref + have htotal := GetSpec.bind + (next := getExprTag (getExprFuel fuel)) + (Decode.getU8_tag_spec 1) hpayload + simpa only [getExprFuel, Expr.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | app function argument hfunction hargument => + cases fuel with + | zero => omega + | succ fuel => + simp only [Expr.decodeDepth] at hfuel + have hmax : Nat.max function.decodeDepth argument.decodeDepth < fuel := by + omega + have hfunctionFuel : function.decodeDepth < fuel := + Nat.lt_of_le_of_lt (Nat.le_max_left _ _) hmax + have hargumentFuel : argument.decodeDepth < fuel := + Nat.lt_of_le_of_lt (Nat.le_max_right _ _) hmax + have hpayload := Decode.getSpecMap2 + (hfunction fuel hfunctionFuel) (hargument fuel hargumentFuel) + Expr.app + have htotal := GetSpec.bind + (next := getExprTag (getExprFuel fuel)) + (Decode.getU8_tag_spec 2) hpayload + simpa only [getExprFuel, Expr.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | lam uses body hbody => + cases fuel with + | zero => omega + | succ fuel => + simp only [Expr.decodeDepth] at hfuel + have hbodyFuel : body.decodeDepth < fuel := by omega + have hpayload := Decode.getSpecMap2 (getUses_spec uses) + (hbody fuel hbodyFuel) Expr.lam + have htotal := GetSpec.bind + (next := getExprTag (getExprFuel fuel)) + (Decode.getU8_tag_spec 3) hpayload + simpa only [getExprFuel, Expr.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | letE uses value body hvalue hbody => + cases fuel with + | zero => omega + | succ fuel => + simp only [Expr.decodeDepth] at hfuel + have hmax : Nat.max value.decodeDepth body.decodeDepth < fuel := by + omega + have hvalueFuel : value.decodeDepth < fuel := + Nat.lt_of_le_of_lt (Nat.le_max_left _ _) hmax + have hbodyFuel : body.decodeDepth < fuel := + Nat.lt_of_le_of_lt (Nat.le_max_right _ _) hmax + have hpayload := Decode.getSpecMap3 (getUses_spec uses) + (hvalue fuel hvalueFuel) (hbody fuel hbodyFuel) Expr.letE + have htotal := GetSpec.bind + (next := getExprTag (getExprFuel fuel)) + (Decode.getU8_tag_spec 4) hpayload + simpa only [getExprFuel, Expr.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | proj index target htarget => + cases fuel with + | zero => omega + | succ fuel => + simp only [Expr.decodeDepth] at hfuel + have htargetFuel : target.decodeDepth < fuel := by omega + have hpayload := Decode.getSpecMap2 (Decode.getNat_spec index) + (htarget fuel htargetFuel) Expr.proj + have htotal := GetSpec.bind + (next := getExprTag (getExprFuel fuel)) + (Decode.getU8_tag_spec 5) hpayload + simpa only [getExprFuel, Expr.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | lit literal => + cases fuel with + | zero => omega + | succ fuel => + have hpayload := Decode.getSpecMap (getLiteral_spec literal) Expr.lit + have htotal := GetSpec.bind + (next := getExprTag (getExprFuel fuel)) + (Decode.getU8_tag_spec 6) hpayload + simpa only [getExprFuel, Expr.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | erased => + cases fuel with + | zero => omega + | succ fuel => + have hpayload : GetSpec (getExprTag (getExprFuel fuel) 7) + ByteArray.empty Expr.erased := by + exact GetSpec.pure Expr.erased + have htotal := GetSpec.bind + (next := getExprTag (getExprFuel fuel)) + (Decode.getU8_tag_spec 7) hpayload + simpa only [getExprFuel, Expr.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + +theorem getExpr_spec (expression : Expr) : + GetSpec getExpr expression.bytes expression := by + intro pre suffix + let fuel := (pre ++ expression.bytes ++ suffix).size + 1 + have hfuel : expression.decodeDepth < fuel := by + have hdepth := expression.decodeDepth_le_bytes + dsimp [fuel] + simp only [ByteArray.size_append] + omega + have hspec := getExprFuel_spec expression fuel hfuel pre suffix + simpa [getExpr, fuel] using hspec + +theorem getRecRule_spec (rule : RecRule) : + GetSpec getRecRule rule.bytes rule := by + have hspec := Decode.getSpecMap2 (Decode.getNat_spec rule.fields) + (getExpr_spec rule.rhs) RecRule.mk + simpa [getRecRule, RecRule.bytes] using hspec + +theorem getDeclPayload_spec : ∀ declaration : Decl, + GetSpec getDeclPayload declaration.payloadBytes declaration + | .defn result body => by + have hpayload := Decode.getSpecMap2 (getOwned_spec result) + (getExpr_spec body) Decl.defn + have htotal := GetSpec.bind (next := getDeclTag) + (Decode.getU8_tag_spec 0) hpayload + simpa only [getDeclPayload, Decl.payloadBytes, + ByteArray.append_assoc, ByteArray.append_empty] using htotal + | .ctor tag arity => by + have hpayload := Decode.getSpecMap2 (Decode.getNat_spec tag) + (Decode.getNat_spec arity) Decl.ctor + have htotal := GetSpec.bind (next := getDeclTag) + (Decode.getU8_tag_spec 1) hpayload + simpa only [getDeclPayload, Decl.payloadBytes, + ByteArray.append_assoc, ByteArray.append_empty] using htotal + | .recursor numArgs natLit rules => by + have hpayload := Decode.getSpecMap3 (Decode.getNat_spec numArgs) + (Decode.getBool_spec natLit) + (Decode.getArray_spec getRecRule RecRule.bytes getRecRule_spec rules) + Decl.recursor + have htotal := GetSpec.bind (next := getDeclTag) + (Decode.getU8_tag_spec 2) hpayload + simpa only [getDeclPayload, Decl.payloadBytes, + ByteArray.append_assoc, ByteArray.append_empty] using htotal + | .extern arity => by + have hpayload := Decode.getSpecMap (Decode.getNat_spec arity) Decl.extern + have htotal := GetSpec.bind (next := getDeclTag) + (Decode.getU8_tag_spec 3) hpayload + simpa only [getDeclPayload, Decl.payloadBytes, + ByteArray.append_assoc, ByteArray.append_empty] using htotal + +theorem getDeclPreimage_spec (declaration : Decl) : + GetSpec getDeclPreimage declaration.preimage declaration := by + let next : Unit → GetM Decl := fun _ => getDeclPayload + have htotal := GetSpec.bind (next := next) + (Decode.expectBytes_spec Decl.addressDomain) + (getDeclPayload_spec declaration) + simpa [getDeclPreimage, Decl.preimage, next] using htotal + +/-! ## Strict top-level laws -/ + +/-- Every declaration decodes from its canonical framed preimage. -/ +theorem Decl.decodePreimage_roundtrip (declaration : Decl) : + Decl.decodePreimage declaration.preimage = .ok declaration := by + exact Decode.runCanonical_of_spec getDeclPreimage Decl.preimage declaration + (getDeclPreimage_spec declaration) + +/-- Every accepted byte string is the canonical preimage of its result. -/ +theorem Decl.decodePreimage_canonical {bytes : ByteArray} {declaration : Decl} + (hdecode : Decl.decodePreimage bytes = .ok declaration) : + declaration.preimage = bytes := by + exact Decode.runCanonical_canonical getDeclPreimage Decl.preimage hdecode + +/-- Canonical declaration preimages are injective. -/ +theorem Decl.preimage_injective : Function.Injective Decl.preimage := by + intro left right hbytes + have hok : (Except.ok left : Except String Decl) = .ok right := by + calc + .ok left = Decl.decodePreimage left.preimage := + (Decl.decodePreimage_roundtrip left).symm + _ = Decl.decodePreimage right.preimage := congrArg Decl.decodePreimage hbytes + _ = .ok right := Decl.decodePreimage_roundtrip right + exact Except.ok.inj hok + +end Ix.Compiler.IxIR0 diff --git a/Ix/Compiler/IxIR0/DynamicCost.lean b/Ix/Compiler/IxIR0/DynamicCost.lean new file mode 100644 index 000000000..45737ccf8 --- /dev/null +++ b/Ix/Compiler/IxIR0/DynamicCost.lean @@ -0,0 +1,615 @@ +import Ix.Compiler.IxIR0.ProjectionSafe + +/-! +# Dynamic IxIR₀ execution profiles + +Evaluator fuel is a totality index, not a cost. This module instead records +the semantic events that actually occur along a successful execution. The +profile is additive across expression subcomputations, application spines, +closure entry, and recursor-rule entry, so recursion contributes once per +dynamically selected rule rather than once per source syntax occurrence. + +The event vocabulary is intentionally source-facing. A lowering proof may +relate it to IxIR₁ allocation and reference-count counters without asserting +that one source event is intrinsically one target instruction. +-/ + +namespace Ix.Compiler.IxIR0.DynamicCost + +/-- Source events retained by the dynamic cost model. -/ +inductive Event where + | evalVar + | evalLit + | evalErased + | evalLam + | evalLet + | evalApp + | evalProj + | evalRefDefn + | evalRefCtor + | evalRefRecursor + | evalRefExtern + | applyClosure + | applyPap + | applyErased + | saturatePending + | saturateFull + | fireConstructor + | fireExtern + | fireRecursor + deriving BEq, DecidableEq, Repr + +/-- A compact additive summary of one dynamic source trace. -/ +@[ext] structure Profile where + evals : Nat := 0 + applies : Nat := 0 + saturations : Nat := 0 + constructorFires : Nat := 0 + closureValues : Nat := 0 + papValues : Nat := 0 + recursorFires : Nat := 0 + externFires : Nat := 0 + projections : Nat := 0 + /-- A conservative count of source-owned roots that lowering may have to + retain explicitly. Unlike the event counters, this quantity carries the + dynamic width of closure environments, PAP prefixes, and recursor fields. -/ + retains : Nat := 0 + deriving BEq, DecidableEq, Repr + +instance : Zero Profile := ⟨{}⟩ + +instance : Add Profile where + add left right := + { evals := left.evals + right.evals + applies := left.applies + right.applies + saturations := left.saturations + right.saturations + constructorFires := left.constructorFires + right.constructorFires + closureValues := left.closureValues + right.closureValues + papValues := left.papValues + right.papValues + recursorFires := left.recursorFires + right.recursorFires + externFires := left.externFires + right.externFires + projections := left.projections + right.projections + retains := left.retains + right.retains } + +@[simp] theorem Profile.zero_evals : (0 : Profile).evals = 0 := rfl +@[simp] theorem Profile.zero_applies : (0 : Profile).applies = 0 := rfl +@[simp] theorem Profile.zero_saturations : + (0 : Profile).saturations = 0 := rfl +@[simp] theorem Profile.zero_constructorFires : + (0 : Profile).constructorFires = 0 := rfl +@[simp] theorem Profile.zero_closureValues : + (0 : Profile).closureValues = 0 := rfl +@[simp] theorem Profile.zero_papValues : + (0 : Profile).papValues = 0 := rfl +@[simp] theorem Profile.zero_recursorFires : + (0 : Profile).recursorFires = 0 := rfl +@[simp] theorem Profile.zero_externFires : + (0 : Profile).externFires = 0 := rfl +@[simp] theorem Profile.zero_projections : + (0 : Profile).projections = 0 := rfl +@[simp] theorem Profile.zero_retains : (0 : Profile).retains = 0 := rfl + +@[simp] theorem Profile.add_evals (left right : Profile) : + (left + right).evals = left.evals + right.evals := rfl +@[simp] theorem Profile.add_applies (left right : Profile) : + (left + right).applies = left.applies + right.applies := rfl +@[simp] theorem Profile.add_saturations (left right : Profile) : + (left + right).saturations = + left.saturations + right.saturations := rfl +@[simp] theorem Profile.add_constructorFires (left right : Profile) : + (left + right).constructorFires = + left.constructorFires + right.constructorFires := rfl +@[simp] theorem Profile.add_closureValues (left right : Profile) : + (left + right).closureValues = + left.closureValues + right.closureValues := rfl +@[simp] theorem Profile.add_papValues (left right : Profile) : + (left + right).papValues = left.papValues + right.papValues := rfl +@[simp] theorem Profile.add_recursorFires (left right : Profile) : + (left + right).recursorFires = + left.recursorFires + right.recursorFires := rfl +@[simp] theorem Profile.add_externFires (left right : Profile) : + (left + right).externFires = + left.externFires + right.externFires := rfl +@[simp] theorem Profile.add_projections (left right : Profile) : + (left + right).projections = + left.projections + right.projections := rfl +@[simp] theorem Profile.add_retains (left right : Profile) : + (left + right).retains = left.retains + right.retains := rfl + +theorem Profile.zero_add (profile : Profile) : 0 + profile = profile := by + ext <;> simp + +theorem Profile.add_zero (profile : Profile) : profile + 0 = profile := by + ext <;> simp + +theorem Profile.add_assoc (left middle right : Profile) : + left + middle + right = left + (middle + right) := by + ext <;> simp [Nat.add_assoc] + +theorem Profile.add_comm (left right : Profile) : + left + right = right + left := by + ext <;> simp [Nat.add_comm] + +/-- The one-event contribution to a dynamic profile. -/ +def tick : Event → Profile + | .evalVar | .evalLit | .evalErased | .evalLet | .evalApp | + .evalRefDefn | .evalRefCtor | .evalRefExtern => + { evals := 1 } + | .evalLam => + { evals := 1, closureValues := 1 } + | .evalProj => + { evals := 1, projections := 1 } + | .evalRefRecursor => + { evals := 1, papValues := 1 } + | .applyClosure | .applyPap | .applyErased => + { applies := 1 } + | .saturatePending => + { saturations := 1, papValues := 1 } + | .saturateFull => + { saturations := 1 } + | .fireConstructor => + { constructorFires := 1 } + | .fireExtern => + { externFires := 1 } + | .fireRecursor => + { recursorFires := 1 } + +/-- Dynamic-width contribution for operations that may become one target +`dup` per retained source root. Counting candidates is conservative: +scalars and ownership moves may execute without an RC instruction. -/ +def retain (count : Nat) : Profile := { retains := count } + +/-! ## Costed call-aware traces -/ + +mutual + + /-- A projection-safe expression trace annotated with its additive dynamic + profile. -/ + inductive Eval (ctx : Ctx) : + Nat → List Value → Expr → Value → Profile → Prop where + | var {fuel env index value} : + env[index]? = some value → + Eval ctx (fuel + 1) env (.var index) value + (tick .evalVar + retain 1) + | lit {fuel env literal} : + Eval ctx (fuel + 1) env (.lit literal) (.lit literal) + (tick .evalLit) + | erased {fuel env} : + Eval ctx (fuel + 1) env .erased .erased (tick .evalErased) + | lam {fuel env uses body} : + Eval ctx (fuel + 1) env (.lam uses body) (.clos uses env body) + (tick .evalLam + retain env.length) + | letE {fuel env uses value body bound result valueCost bodyCost} : + Eval ctx fuel env value bound valueCost → + Eval ctx fuel (bound :: env) body result bodyCost → + Eval ctx (fuel + 1) env (.letE uses value body) result + (valueCost + bodyCost + tick .evalLet) + | app {fuel env function argument functionValue argumentValue result + functionCost argumentCost applyCost} : + Eval ctx fuel env function functionValue functionCost → + Eval ctx fuel env argument argumentValue argumentCost → + Apply ctx fuel functionValue argumentValue result applyCost → + Eval ctx (fuel + 1) env (.app function argument) result + (functionCost + argumentCost + applyCost + tick .evalApp) + | proj {fuel env index source address tag fields result sourceCost} : + Eval ctx fuel env source (.ctor address tag fields) sourceCost → + fields[index]? = some result → + Eval ctx (fuel + 1) env (.proj index source) result + (sourceCost + tick .evalProj + retain 1) + | refDefn {fuel env address world body result bodyCost} : + ctx.env address = some (.defn world body) → + Eval ctx fuel [] body result bodyCost → + Eval ctx (fuel + 1) env (.ref address) result + (bodyCost + tick .evalRefDefn) + | refCtor {fuel env address tag arity result saturateCost} : + ctx.env address = some (.ctor tag arity) → + Saturate ctx fuel (.ctor address tag arity) [] result saturateCost → + Eval ctx (fuel + 1) env (.ref address) result + (saturateCost + tick .evalRefCtor) + | refRecursor {fuel env address numArgs natLit rules} : + ctx.env address = some (.recursor numArgs natLit rules) → + Eval ctx (fuel + 1) env (.ref address) + (.pap (.rec_ address (numArgs + 1)) []) (tick .evalRefRecursor) + | refExtern {fuel env address arity result saturateCost} : + ctx.env address = some (.extern arity) → + Saturate ctx fuel (.ext address arity) [] result saturateCost → + Eval ctx (fuel + 1) env (.ref address) result + (saturateCost + tick .evalRefExtern) + + /-- One dynamically entered source application. -/ + inductive Apply (ctx : Ctx) : + Nat → Value → Value → Value → Profile → Prop where + | clos {fuel uses env body argument result bodyCost} : + Eval ctx fuel (argument :: env) body result bodyCost → + Apply ctx (fuel + 1) (.clos uses env body) argument result + (bodyCost + tick .applyClosure + retain env.length) + | pap {fuel head captured argument result saturateCost} : + Saturate ctx fuel head (captured ++ [argument]) result + saturateCost → + Apply ctx (fuel + 1) (.pap head captured) argument result + (saturateCost + tick .applyPap + retain captured.length) + | erased {fuel argument} : + Apply ctx (fuel + 1) .erased argument .erased (tick .applyErased) + + /-- One source saturation decision. -/ + inductive Saturate (ctx : Ctx) : + Nat → Head → List Value → Value → Profile → Prop where + | pending {fuel head args} : + args.length ≠ head.arity → + Saturate ctx (fuel + 1) head args (.pap head args) + (tick .saturatePending) + | full {fuel head args result fireCost} : + args.length = head.arity → + Fire ctx fuel head args result fireCost → + Saturate ctx (fuel + 1) head args result + (fireCost + tick .saturateFull) + + /-- A fired constructor, extern, or recursor head. The recursor case + includes the complete profile of the selected rule body. -/ + inductive Fire (ctx : Ctx) : + Nat → Head → List Value → Value → Profile → Prop where + | ctor {fuel address tag arity args} : + Fire ctx (fuel + 1) (.ctor address tag arity) args + (.ctor address tag args) (tick .fireConstructor) + | extern {fuel address arity args result} : + ctx.oracle address args = some result → + Fire ctx (fuel + 1) (.ext address arity) args result + (tick .fireExtern) + | recursor {fuel address arity numArgs natLit rules args major tag fields + rule result bodyCost} : + ctx.env address = some (.recursor numArgs natLit rules) → + args.getLast? = some major → + majorCtor natLit major = .ok (tag, fields) → + rules[tag]? = some rule → + fields.length = rule.fields → + Eval ctx fuel + (fields.reverse ++ args.dropLast.reverse ++ + [.pap (.rec_ address arity) []]) + rule.rhs result bodyCost → + Fire ctx (fuel + 1) (.rec_ address arity) args result + (bodyCost + tick .fireRecursor + retain fields.length) + +end + +mutual + + /-- Every existing call-aware expression trace admits an additive dynamic + profile. -/ + theorem Eval.ofTrace {ctx : Ctx} {fuel : Nat} {env : List Value} + {expr : Expr} {value : Value} + (htrace : ProjectionSafe.Eval ctx fuel env expr value) : + ∃ profile, Eval ctx fuel env expr value profile := by + cases htrace with + | var hlookup => exact ⟨tick .evalVar + retain 1, .var hlookup⟩ + | lit => exact ⟨tick .evalLit, .lit⟩ + | erased => exact ⟨tick .evalErased, .erased⟩ + | lam => exact ⟨tick .evalLam + retain _, .lam⟩ + | letE hvalue hbody => + obtain ⟨valueCost, hvalueCost⟩ := Eval.ofTrace hvalue + obtain ⟨bodyCost, hbodyCost⟩ := Eval.ofTrace hbody + exact ⟨valueCost + bodyCost + tick .evalLet, + .letE hvalueCost hbodyCost⟩ + | app hfunction hargument happly => + obtain ⟨functionCost, hfunctionCost⟩ := Eval.ofTrace hfunction + obtain ⟨argumentCost, hargumentCost⟩ := Eval.ofTrace hargument + obtain ⟨applyCost, happlyCost⟩ := Apply.ofTrace happly + exact ⟨functionCost + argumentCost + applyCost + tick .evalApp, + .app hfunctionCost hargumentCost happlyCost⟩ + | proj hsource hfield => + obtain ⟨sourceCost, hsourceCost⟩ := Eval.ofTrace hsource + exact ⟨sourceCost + tick .evalProj + retain 1, + .proj hsourceCost hfield⟩ + | refDefn hdecl hbody => + obtain ⟨bodyCost, hbodyCost⟩ := Eval.ofTrace hbody + exact ⟨bodyCost + tick .evalRefDefn, .refDefn hdecl hbodyCost⟩ + | refCtor hdecl hsaturate => + obtain ⟨saturateCost, hsaturateCost⟩ := + Saturate.ofTrace hsaturate + exact ⟨saturateCost + tick .evalRefCtor, + .refCtor hdecl hsaturateCost⟩ + | refRecursor hdecl => + exact ⟨tick .evalRefRecursor, .refRecursor hdecl⟩ + | refExtern hdecl hsaturate => + obtain ⟨saturateCost, hsaturateCost⟩ := + Saturate.ofTrace hsaturate + exact ⟨saturateCost + tick .evalRefExtern, + .refExtern hdecl hsaturateCost⟩ + + theorem Apply.ofTrace {ctx : Ctx} {fuel : Nat} + {function argument result : Value} + (htrace : ProjectionSafe.Apply ctx fuel function argument result) : + ∃ profile, Apply ctx fuel function argument result profile := by + cases htrace with + | clos hbody => + obtain ⟨bodyCost, hbodyCost⟩ := Eval.ofTrace hbody + exact ⟨bodyCost + tick .applyClosure + retain _, .clos hbodyCost⟩ + | pap hsaturate => + obtain ⟨saturateCost, hsaturateCost⟩ := + Saturate.ofTrace hsaturate + exact ⟨saturateCost + tick .applyPap + retain _, + .pap hsaturateCost⟩ + | erased => exact ⟨tick .applyErased, .erased⟩ + + theorem Saturate.ofTrace {ctx : Ctx} {fuel : Nat} {head : Head} + {args : List Value} {result : Value} + (htrace : ProjectionSafe.Saturate ctx fuel head args result) : + ∃ profile, Saturate ctx fuel head args result profile := by + cases htrace with + | pending hlength => + exact ⟨tick .saturatePending, .pending hlength⟩ + | full hlength hfire => + obtain ⟨fireCost, hfireCost⟩ := Fire.ofTrace hfire + exact ⟨fireCost + tick .saturateFull, .full hlength hfireCost⟩ + + theorem Fire.ofTrace {ctx : Ctx} {fuel : Nat} {head : Head} + {args : List Value} {result : Value} + (htrace : ProjectionSafe.Fire ctx fuel head args result) : + ∃ profile, Fire ctx fuel head args result profile := by + cases htrace with + | ctor => exact ⟨tick .fireConstructor, .ctor⟩ + | extern horacle => exact ⟨tick .fireExtern, .extern horacle⟩ + | recursor hdecl hlast hmajor hrule hfields hbody => + obtain ⟨bodyCost, hbodyCost⟩ := Eval.ofTrace hbody + exact ⟨bodyCost + tick .fireRecursor + retain _, + .recursor hdecl hlast hmajor hrule hfields hbodyCost⟩ + +end + +/-! ## Forgetting and constructing profiles -/ + +mutual + + /-- Forget the cost annotation and recover the existing call-aware trace. -/ + theorem Eval.toTrace {ctx : Ctx} {fuel : Nat} {env : List Value} + {expr : Expr} {value : Value} {profile : Profile} + (hcost : Eval ctx fuel env expr value profile) : + ProjectionSafe.Eval ctx fuel env expr value := by + cases hcost with + | var hlookup => exact .var hlookup + | lit => exact .lit + | erased => exact .erased + | lam => exact .lam + | letE hvalue hbody => exact .letE hvalue.toTrace hbody.toTrace + | app hfunction hargument happly => + exact .app hfunction.toTrace hargument.toTrace happly.toTrace + | proj hsource hfield => exact .proj hsource.toTrace hfield + | refDefn hdecl hbody => exact .refDefn hdecl hbody.toTrace + | refCtor hdecl hsaturate => exact .refCtor hdecl hsaturate.toTrace + | refRecursor hdecl => exact .refRecursor hdecl + | refExtern hdecl hsaturate => exact .refExtern hdecl hsaturate.toTrace + + theorem Apply.toTrace {ctx : Ctx} {fuel : Nat} + {function argument result : Value} {profile : Profile} + (hcost : Apply ctx fuel function argument result profile) : + ProjectionSafe.Apply ctx fuel function argument result := by + cases hcost with + | clos hbody => exact .clos hbody.toTrace + | pap hsaturate => exact .pap hsaturate.toTrace + | erased => exact .erased + + theorem Saturate.toTrace {ctx : Ctx} {fuel : Nat} {head : Head} + {args : List Value} {result : Value} {profile : Profile} + (hcost : Saturate ctx fuel head args result profile) : + ProjectionSafe.Saturate ctx fuel head args result := by + cases hcost with + | pending hlength => exact .pending hlength + | full hlength hfire => exact .full hlength hfire.toTrace + + theorem Fire.toTrace {ctx : Ctx} {fuel : Nat} {head : Head} + {args : List Value} {result : Value} {profile : Profile} + (hcost : Fire ctx fuel head args result profile) : + ProjectionSafe.Fire ctx fuel head args result := by + cases hcost with + | ctor => exact .ctor + | extern horacle => exact .extern horacle + | recursor hdecl hlast hmajor hrule hfields hbody => + exact .recursor hdecl hlast hmajor hrule hfields hbody.toTrace + +end + + +theorem Eval.run {ctx : Ctx} {fuel : Nat} {env : List Value} + {expr : Expr} {value : Value} {profile : Profile} + (hcost : Eval ctx fuel env expr value profile) : + eval ctx fuel env expr = .ok value := + hcost.toTrace.run + +theorem Apply.run {ctx : Ctx} {fuel : Nat} + {function argument result : Value} {profile : Profile} + (hcost : Apply ctx fuel function argument result profile) : + apply ctx fuel function argument = .ok result := + hcost.toTrace.run + +theorem Saturate.run {ctx : Ctx} {fuel : Nat} {head : Head} + {args : List Value} {result : Value} {profile : Profile} + (hcost : Saturate ctx fuel head args result profile) : + saturate ctx fuel head args = .ok result := + hcost.toTrace.run + +theorem Fire.run {ctx : Ctx} {fuel : Nat} {head : Head} + {args : List Value} {result : Value} {profile : Profile} + (hcost : Fire ctx fuel head args result profile) : + fire ctx fuel head args = .ok result := + hcost.toTrace.run + +/-- Every expression execution contributes one `eval` event independently of +the evaluator fuel used to justify termination. -/ +theorem Eval.evals_pos {ctx : Ctx} {fuel : Nat} {env : List Value} + {expr : Expr} {value : Value} {profile : Profile} + (hcost : Eval ctx fuel env expr value profile) : + 0 < profile.evals := by + cases hcost <;> simp [tick] <;> omega + +/-- Surface evaluator sites in an expression. Lambda bodies and referenced +declarations are counted when they are dynamically entered, rather than at +the site that merely creates or names them. -/ +def surfaceEvals : Expr → Nat + | .var _ | .ref _ | .lit _ | .erased | .lam _ _ => 1 + | .letE _ value body => surfaceEvals value + surfaceEvals body + 1 + | .app function argument => + surfaceEvals function + surfaceEvals argument + 1 + | .proj _ source => surfaceEvals source + 1 + +/-- A dynamic trace contains at least the surface evaluation sites of the +expression it enters. Called closure and recursor bodies can only add to +this lower bound. -/ +theorem Eval.surfaceEvals_le {ctx : Ctx} {fuel : Nat} {env : List Value} + {expr : Expr} {value : Value} {profile : Profile} + (hcost : Eval ctx fuel env expr value profile) : + surfaceEvals expr ≤ profile.evals := by + induction expr generalizing fuel env value profile with + | var index => + cases hcost + simp [surfaceEvals, tick, retain] + | ref address => + cases hcost <;> simp [surfaceEvals, tick] + | app function argument ihFunction ihArgument => + cases hcost with + | app hfunction hargument happly => + have hfunctionBound := ihFunction hfunction + have hargumentBound := ihArgument hargument + simp [surfaceEvals, tick] at * + omega + | lam uses body => + cases hcost + simp [surfaceEvals, tick, retain] + | letE uses bound body ihBound ihBody => + cases hcost with + | letE hbound hbody => + have hboundBound := ihBound hbound + have hbodyBound := ihBody hbody + simp [surfaceEvals, tick] at * + omega + | proj index source ihSource => + cases hcost with + | proj hsource hfield => + have hsourceBound := ihSource hsource + simp [surfaceEvals, tick, retain] at * + omega + | lit literal => + cases hcost + simp [surfaceEvals, tick] + | erased => + cases hcost + simp [surfaceEvals, tick] + +/-- A closed source expression has `profile` when some exact call-aware +successful trace has that annotation. Fuel is existential and remains +separate from the profile. -/ +def Profiled (ctx : Ctx) (expr : Expr) (value : Value) + (profile : Profile) : Prop := + ∃ fuel, Eval ctx fuel [] expr value profile + +theorem Profiled.run {ctx : Ctx} {expr : Expr} {value : Value} + {profile : Profile} (hprofile : Profiled ctx expr value profile) : + ∃ fuel, eval ctx fuel [] expr = .ok value := by + obtain ⟨fuel, hcost⟩ := hprofile + exact ⟨fuel, hcost.run⟩ + +theorem Profiled.evals_pos {ctx : Ctx} {expr : Expr} {value : Value} + {profile : Profile} (hprofile : Profiled ctx expr value profile) : + 0 < profile.evals := by + obtain ⟨_, hcost⟩ := hprofile + exact hcost.evals_pos + +theorem Profiled.ofTrace {ctx : Ctx} {fuel : Nat} {expr : Expr} + {value : Value} + (htrace : ProjectionSafe.Eval ctx fuel [] expr value) : + ∃ profile, Profiled ctx expr value profile := by + obtain ⟨profile, hcost⟩ := Eval.ofTrace htrace + exact ⟨profile, fuel, hcost⟩ + +/-! ## Additive application spines -/ + +/-- A dynamically executed curried application spine. Each entered body is +represented by its `Apply` profile, and the spine profile is their sum. -/ +inductive Applies (ctx : Ctx) : + Value → List Value → Value → Profile → Prop where + | nil {value : Value} : Applies ctx value [] value 0 + | cons {fuel : Nat} {function argument middle result : Value} + {arguments : List Value} {stepCost restCost : Profile} : + Apply ctx fuel function argument middle stepCost → + Applies ctx middle arguments result restCost → + Applies ctx function (argument :: arguments) result + (stepCost + restCost) + +/-- Dependent state-threaded traversal of a dynamically costed application +spine. Clients receive the exact head application profile, the original +profiled tail derivation, and the recursively produced result while the +initial value, remaining arguments, final value, and additive profile stay +synchronized. -/ +theorem Applies.traverse + {ctx : Ctx} + {Result : Value → List Value → Value → Profile → Prop} + (hnil : ∀ value, Result value [] value 0) + (hcons : ∀ {fuel : Nat} {function argument middle result : Value} + {arguments : List Value} {stepCost restCost : Profile}, + Apply ctx fuel function argument middle stepCost → + Applies ctx middle arguments result restCost → + Result middle arguments result restCost → + Result function (argument :: arguments) result + (stepCost + restCost)) + {function result : Value} {arguments : List Value} {cost : Profile} + (happly : Applies ctx function arguments result cost) : + Result function arguments result cost := by + induction happly with + | nil => exact hnil _ + | cons hstep htail ih => exact hcons hstep htail ih + +/-- Application-spine concatenation is profile addition. -/ +theorem Applies.append {ctx : Ctx} + {function middle result : Value} {left right : List Value} + {leftCost rightCost : Profile} + (hleft : Applies ctx function left middle leftCost) + (hright : Applies ctx middle right result rightCost) : + Applies ctx function (left ++ right) result (leftCost + rightCost) := by + exact (Applies.traverse + (Result := fun currentFunction currentArguments currentMiddle currentCost => + ∀ {currentResult : Value} {rightArguments : List Value} + {rightCost : Profile}, + Applies ctx currentMiddle rightArguments currentResult rightCost → + Applies ctx currentFunction (currentArguments ++ rightArguments) + currentResult (currentCost + rightCost)) + (hnil := by + intro value currentResult rightArguments currentCost hright + simpa [Profile.zero_add] using hright) + (hcons := by + intro fuel currentFunction argument currentMiddle currentResult + currentArguments stepCost restCost hstep htail ih finalResult + rightArguments rightCost hright + simpa only [List.cons_append, Profile.add_assoc] using + Applies.cons hstep (ih hright)) + hleft) hright + +/-- One final application contributes exactly its own profile. -/ +theorem Applies.snoc {ctx : Ctx} + {function middle result argument : Value} {arguments : List Value} + {spineCost stepCost : Profile} {fuel : Nat} + (hspine : Applies ctx function arguments middle spineCost) + (hstep : Apply ctx fuel middle argument result stepCost) : + Applies ctx function (arguments ++ [argument]) result + (spineCost + stepCost) := by + apply hspine.append + simpa [Profile.add_zero] using (Applies.cons hstep Applies.nil) + +/-- Every bounded call-aware application trace receives an additive profile; +the fuel bound remains only the termination measure. -/ +theorem Applies.ofTrace {ctx : Ctx} {limit : Nat} + {function result : Value} {arguments : List Value} + (htrace : ProjectionSafe.AppliesBelow ctx limit function arguments + result) : + ∃ profile, Applies ctx function arguments result profile := by + exact ProjectionSafe.AppliesBelow.traverse + (Result := fun currentFunction currentArguments currentResult => + ∃ profile, + Applies ctx currentFunction currentArguments currentResult profile) + (hnil := fun _ => ⟨0, .nil⟩) + (hcons := by + intro currentFunction argument currentMiddle currentResult + currentArguments fuel hfuel hstep htail ih + obtain ⟨stepCost, hstepCost⟩ := Apply.ofTrace hstep + obtain ⟨restCost, hrestCost⟩ := ih + exact ⟨stepCost + restCost, .cons hstepCost hrestCost⟩) + htrace + +end Ix.Compiler.IxIR0.DynamicCost diff --git a/Ix/Compiler/IxIR0/Eval.lean b/Ix/Compiler/IxIR0/Eval.lean new file mode 100644 index 000000000..9fd2d9d50 --- /dev/null +++ b/Ix/Compiler/IxIR0/Eval.lean @@ -0,0 +1,197 @@ +import Ix.Compiler.IxIR0.Basic + +/-! +# IxIR₀ functional big-step interpreter + +`eval` is the definitional semantics of IxIR₀ — the anchor every +backend pass is proved against. Fuel is a pure totality device, +uniformly decremented at the entry of each of the four mutual +functions (`eval`/`apply`/`saturate`/`fire`), which makes termination +trivial and keeps the induction uniform. It is NOT a cost model — +cost lands at IxIR₁. "`e` terminates with `v`" is +`∃ fuel, eval ctx fuel ρ e = .ok v`; fuel-monotonicity is the first +lemma of the erasure-simulation work. + +Error taxonomy: `Err.fuel` is the only non-answer (more fuel may +succeed). `Err.stuck` is unreachable on well-typed, well-usaged +inputs — a future theorem. `Err.oracleMissing` marks the +trusted-extern boundary (the `docs/compiler/trusted-extern-ledger.md` ledger). +`Err.unknownRef` is a hole in the closed world; the Merkle-DAG env of +a real program is total over its reachable addresses by construction. +-/ + +namespace Ix.Compiler.IxIR0 + +open Ix.Compiler.Ixon (Uses Address) + +/-- A global awaiting saturation: values of the form +`pap head [a₁, …, aₖ]` with `k < head.arity`. Carries the arity so +application never re-consults the environment; recursor rules are +looked up only at ι-time. -/ +inductive Head where + | ctor (adr : Address) (tag arity : Nat) + | rec_ (adr : Address) (arity : Nat) + | ext (adr : Address) (arity : Nat) + deriving BEq, Repr + +def Head.arity : Head → Nat + | .ctor _ _ a | .rec_ _ a | .ext _ a => a + +/-- Values. Constructor values hold **kept fields only** (never +params); `args` lists are in application order. The `adr` on `ctor` +distinguishes same-tag constructors of different inductives in output +and in the future differential harness — ι matches on `tag` alone. -/ +inductive Value where + | clos (uses : Uses) (env : List Value) (body : Expr) + | pap (head : Head) (args : List Value) + | ctor (adr : Address) (tag : Nat) (args : List Value) + | lit (l : Literal) + | erased + +inductive Err where + | fuel + | stuck (msg : String) + | oracleMissing (adr : Address) + | unknownRef (adr : Address) + deriving BEq, Repr + +/-- The extern semantics: pure, partial, keyed by address. Each ledger +entry axiomatizes one address's behavior. IO arrives later as +state-token threading through this same interface. -/ +abbrev Oracle := Address → List Value → Option Value + +structure Ctx where + env : Env + oracle : Oracle := fun _ _ => none + +/-- View the major premise as a constructor application, peeling Nat +literals when the recursor allows it. -/ +def majorCtor (natLit : Bool) : Value → Except Err (Nat × List Value) + | .ctor _ tag args => .ok (tag, args) + | .lit (.nat n) => + if natLit then + match n with + | 0 => .ok (0, []) + | n + 1 => .ok (1, [.lit (.nat n)]) + else .error (.stuck "literal major premise (natLit disabled)") + | _ => .error (.stuck "recursor major premise is not a constructor") + +mutual + +/-- Evaluate `e` under environment `ρ` (de Bruijn: `var i = ρ[i]`, +binding conses). -/ +def eval (ctx : Ctx) (fuel : Nat) (ρ : List Value) (e : Expr) : + Except Err Value := + match fuel with + | 0 => .error .fuel + | fuel + 1 => + match e with + | .var i => + match ρ[i]? with + | some v => .ok v + | none => .error (.stuck s!"unbound de Bruijn index {i}") + | .lit l => .ok (.lit l) + | .erased => .ok .erased + | .lam u body => .ok (.clos u ρ body) + | .letE _ val body => do + let v ← eval ctx fuel ρ val + eval ctx fuel (v :: ρ) body + | .app fn arg => do + let f ← eval ctx fuel ρ fn + let a ← eval ctx fuel ρ arg + apply ctx fuel f a + | .proj i s => do + match ← eval ctx fuel ρ s with + | .ctor _ _ args => + match args[i]? with + | some v => .ok v + | none => .error (.stuck s!"projection {i} out of bounds") + | .erased => .ok .erased + | _ => .error (.stuck "projection from a non-constructor value") + | .ref a => + match ctx.env a with + | none => .error (.unknownRef a) + | some (.defn _ body) => eval ctx fuel [] body + | some (.ctor tag arity) => saturate ctx fuel (.ctor a tag arity) [] + | some (.recursor numArgs _ _) => .ok (.pap (.rec_ a (numArgs + 1)) []) + | some (.extern arity) => saturate ctx fuel (.ext a arity) [] + termination_by fuel + +def apply (ctx : Ctx) (fuel : Nat) (f a : Value) : Except Err Value := + match fuel with + | 0 => .error .fuel + | fuel + 1 => + match f with + | .clos _ ρ body => eval ctx fuel (a :: ρ) body + | .pap h args => saturate ctx fuel h (args ++ [a]) + | .erased => .ok .erased + | _ => .error (.stuck "application of a non-function value") + termination_by fuel + +/-- Fire a head at arity, else fold into a partial application. +Called with fresh heads (arity-0 ctors/externs fire at `ref`-time) +and after every argument. -/ +def saturate (ctx : Ctx) (fuel : Nat) (h : Head) (args : List Value) : + Except Err Value := + match fuel with + | 0 => .error .fuel + | fuel + 1 => + if args.length == h.arity then fire ctx fuel h args + else .ok (.pap h args) + termination_by fuel + +def fire (ctx : Ctx) (fuel : Nat) (h : Head) (args : List Value) : + Except Err Value := + match fuel with + | 0 => .error .fuel + | fuel + 1 => + match h with + | .ctor a tag _ => .ok (.ctor a tag args) + | .ext a _ => + match ctx.oracle a args with + | some v => .ok v + | none => .error (.oracleMissing a) + | .rec_ a arity => + match ctx.env a with + | some (.recursor _ natLit rules) => + match args.getLast? with + | none => .error (.stuck "recursor fired with no arguments") + | some major => do + let (tag, fields) ← majorCtor natLit major + match rules[tag]? with + | none => .error (.stuck s!"no recursor rule for constructor tag {tag}") + | some rule => + if fields.length != rule.fields then + .error (.stuck "constructor field count does not match recursor rule") + else + eval ctx fuel + (fields.reverse ++ args.dropLast.reverse + ++ [.pap (.rec_ a arity) []]) + rule.rhs + | _ => .error (.stuck "recursor head does not resolve to a recursor declaration") + termination_by fuel + +end + +/-- Evaluate a closed expression. -/ +def Ctx.run (ctx : Ctx) (e : Expr) (fuel : Nat := 100000) : + Except Err Value := + eval ctx fuel [] e + +/-! Elaboration-time smoke tests (pure — no FFI, so `#guard` is fine +here; contrast `Tests.lean`). The full example suite lives in +`Examples.lean`. -/ + +private def emptyCtx : Ctx := { env := Env.empty } + +#guard + match emptyCtx.run (.app (.lam .many (.var 0)) (.lit (.nat 7))) with + | .ok (.lit (.nat 7)) => true + | _ => false + +#guard + match emptyCtx.run (.app .erased (.lit (.nat 1))) with + | .ok .erased => true + | _ => false + +end Ix.Compiler.IxIR0 diff --git a/Ix/Compiler/IxIR0/Examples.lean b/Ix/Compiler/IxIR0/Examples.lean new file mode 100644 index 000000000..b9013d567 --- /dev/null +++ b/Ix/Compiler/IxIR0/Examples.lean @@ -0,0 +1,282 @@ +import Ix.Compiler.IxIR0.Eval + +/-! +# Hand-written IxIR₀ environments + +The test corpus until real inputs arrive. The standalone ix-importer +is **skipped** (JCB 2026-08-12): Ixon v2 merges into ix directly when +we're ready for real corpora; until then these hand-written +environments — built exactly as the erasure contract in `Basic.lean` +prescribes — exercise the semantics. Everything here is pure (no +FFI), so the tests are elaboration-time `#guard`s and run on every +build. + +The encodings mirror what erasure produces from the kernel +declarations: `Nat.rec`/`List.rec` with motives dropped and minors +kept (`numArgs = 2`), constructors carrying kept fields only +(`List.cons` has arity 2 — the `α` param is gone), and rule +right-hand sides in the `RecRule` environment convention. +-/ + +namespace Ix.Compiler.IxIR0.Examples + +open Ix.Compiler.Ixon (Uses Address) + +private def addrOf (n : UInt8) : Address := + Address.replicate n + +/-! ## Addresses (arbitrary — content addressing of IxIR₀ comes later) -/ + +def natZero := addrOf 0x10 +def natSucc := addrOf 0x11 +def natRec := addrOf 0x12 +def natAddDef := addrOf 0x13 +def listNil := addrOf 0x20 +def listCons := addrOf 0x21 +def listRec := addrOf 0x22 +def appendDef := addrOf 0x23 +def lengthDef := addrOf 0x24 +def pairMk := addrOf 0x30 +def natAddExt := addrOf 0x40 +def dropFstDef := addrOf 0x50 +def dropSndDef := addrOf 0x51 + +/-! ## Nat: zero/succ constructors, `Nat.rec`, addition -/ + +/-- Zero rule. Rule env is `[s, z, rec]`: no fields, pre-major args +`[z, s]` reversed, recursor deepest. `⊢ z`. -/ +private def natRecZero : RecRule := { fields := 0, rhs := .var 1 } + +/-- Succ rule. Rule env is `[n, s, z, rec]`. `⊢ s n (rec z s n)` — +the kernel rule with the motive dropped and `Nat.rec` mapped to the +deepest variable. -/ +private def natRecSucc : RecRule where + fields := 1 + rhs := .app (.app (.var 1) (.var 0)) + (.app (.app (.app (.var 3) (.var 2)) (.var 1)) (.var 0)) + +/-- `fun m n => Nat.rec (z := m) (s := fun _ ih => succ ih) n` -/ +private def addBody : Expr := + .lam .many (.lam .many + (.app + (.app (.app (.ref natRec) (.var 1)) + (.lam .many (.lam .many (.app (.ref natSucc) (.var 0))))) + (.var 0))) + +/-! ## List: nil/cons, `List.rec`, append, length -/ + +/-- Nil rule. Rule env `[c, n, rec]`. `⊢ n`. -/ +private def listRecNil : RecRule := { fields := 0, rhs := .var 1 } + +/-- Cons rule. Rule env `[t, h, c, n, rec]` (fields `[h, t]` +reversed first). `⊢ c h t (rec n c t)`. -/ +private def listRecCons : RecRule where + fields := 2 + rhs := .app + (.app (.app (.var 2) (.var 1)) (.var 0)) + (.app (.app (.app (.var 4) (.var 3)) (.var 2)) (.var 0)) + +/-- `fun xs ys => List.rec (n := ys) (c := fun h _ ih => cons h ih) xs` -/ +private def appendBody : Expr := + .lam .many (.lam .many + (.app + (.app (.app (.ref listRec) (.var 0)) + (.lam .many (.lam .many (.lam .many + (.app (.app (.ref listCons) (.var 2)) (.var 0)))))) + (.var 1))) + +/-- `fun xs => List.rec (n := zero) (c := fun _ _ ih => succ ih) xs` -/ +private def lengthBody : Expr := + .lam .many + (.app + (.app (.app (.ref listRec) (.ref natZero)) + (.lam .many (.lam .many (.lam .many + (.app (.ref natSucc) (.var 0)))))) + (.var 0)) + +/-! ## Mixed-mode telescopes: affine and many binders in both orders. +Modes are inert in this IR's semantics; the IxIR₁ lowering reads its +per-parameter worlds off them, so the corpus must not be uniformly +`many` (a reversed mode telescope is invisible on uniform modes). -/ + +/-- `fun (x :ᵃ _) (y :ω _) => y` — drops its affine first argument. -/ +private def dropFstBody : Expr := .lam .affine (.lam .many (.var 0)) + +/-- `fun (x :ω _) (y :ᵃ _) => x` — drops its affine second argument. -/ +private def dropSndBody : Expr := .lam .many (.lam .affine (.var 1)) + +/-! ## The environment and oracle -/ + +/-- The declarations as a list — the IxIR₀ → IxIR₁ lowering consumes +this form (an `Env` function can't be enumerated). -/ +def declList : List (Address × Decl) := [ + (natZero, .ctor 0 0), + (natSucc, .ctor 1 1), + (natRec, .recursor 2 true #[natRecZero, natRecSucc]), + (natAddDef, .defn .shared addBody), + (listNil, .ctor 0 0), + (listCons, .ctor 1 2), + (listRec, .recursor 2 false #[listRecNil, listRecCons]), + (appendDef, .defn .shared appendBody), + (lengthDef, .defn .shared lengthBody), + (pairMk, .ctor 0 2), + (dropFstDef, .defn .shared dropFstBody), + (dropSndDef, .defn .shared dropSndBody), + (natAddExt, .extern 2) +] + +def env : Env := Env.ofList declList + +/-- Demo ledger entry: `natAddExt` is `Nat.add` on literals (the +GMP-shaped extern), refusing anything else. -/ +def oracle : Oracle := fun a args => + if a == natAddExt then + match args with + | [.lit (.nat m), .lit (.nat n)] => some (.lit (.nat (m + n))) + | _ => none + else none + +def ctx : Ctx := { env, oracle } + +/-! ## Expression and value helpers -/ + +/-- Church-style numeral over the `Nat` constructors. -/ +def natE : Nat → Expr + | 0 => .ref natZero + | n + 1 => .app (.ref natSucc) (natE n) + +def listE (f : α → Expr) : List α → Expr + | [] => .ref listNil + | x :: xs => .app (.app (.ref listCons) (f x)) (listE f xs) + +/-- Read a `Nat` back out of a value, accepting literal tails so +`natLit`-peeled results (`succ (succ (lit 3))`) decode too. Fueled +only to keep the recursion structurally obvious. -/ +private def valNatGo : Nat → Value → Option Nat + | 0, _ => none + | _, .lit (.nat n) => some n + | _, .ctor _ 0 [] => some 0 + | fuel + 1, .ctor _ 1 [v] => (valNatGo fuel v).map (· + 1) + | _, _ => none + +def valNat? (v : Value) : Option Nat := valNatGo 1000000 v + +private def valNatListGo : Nat → Value → Option (List Nat) + | 0, _ => none + | _, .ctor _ 0 [] => some [] + | fuel + 1, .ctor _ 1 [h, t] => do + let n ← valNat? h + let rest ← valNatListGo fuel t + pure (n :: rest) + | _, _ => none + +def valNatList? (v : Value) : Option (List Nat) := valNatListGo 1000000 v + +def run (e : Expr) (fuel : Nat := 100000) : Except Err Value := + eval ctx fuel [] e + +def runNat? (e : Expr) : Option Nat := + match run e with + | .ok v => valNat? v + | .error _ => none + +def runNatList? (e : Expr) : Option (List Nat) := + match run e with + | .ok v => valNatList? v + | .error _ => none + +/-! ## β, let, projection -/ + +#guard runNat? (.app (.lam .many (.var 0)) (natE 4)) == some 4 +#guard runNat? (.letE .many (natE 2) (.app (.ref natSucc) (.var 0))) == some 3 +#guard runNat? (.proj 0 (.app (.app (.ref pairMk) (natE 1)) (natE 2))) == some 1 +#guard runNat? (.proj 1 (.app (.app (.ref pairMk) (natE 1)) (natE 2))) == some 2 + +-- Under-applied constructors are first-class partial applications. +#guard + match run (.app (.ref pairMk) (natE 1)) with + | .ok (.pap _ [_]) => true + | _ => false + +/-! ## Mixed-mode telescopes evaluate as plain curried functions -/ + +#guard runNat? (.app (.app (.ref dropFstDef) (natE 1)) (natE 2)) == some 2 +#guard runNat? (.app (.app (.ref dropSndDef) (natE 2)) (natE 1)) == some 2 + +/-! ## Recursor ι: addition via `Nat.rec`, on constructors and on +peeled literals -/ + +#guard runNat? (.app (.app (.ref natAddDef) (natE 2)) (natE 3)) == some 5 +#guard runNat? (.app (.app (.ref natAddDef) (natE 0)) (natE 0)) == some 0 +#guard runNat? (.app (.app (.ref natAddDef) (natE 7)) (natE 0)) == some 7 +#guard runNat? (.app (.app (.ref natAddDef) (.lit (.nat 2))) (.lit (.nat 3))) + == some 5 +#guard runNat? (.app (.app (.ref natAddDef) (natE 1)) (.lit (.nat 3))) + == some 4 + +/-! ## `List.rec`: append and length -/ + +#guard runNatList? + (.app (.app (.ref appendDef) (listE natE [1, 2])) (listE natE [3])) + == some [1, 2, 3] +#guard runNatList? (.app (.app (.ref appendDef) (listE natE [])) (listE natE [])) + == some [] +#guard runNat? (.app (.ref lengthDef) (listE natE [5, 6, 7])) == some 3 + +/-! ## Externs and the oracle boundary -/ + +#guard runNat? (.app (.app (.ref natAddExt) (.lit (.nat 20))) (.lit (.nat 22))) + == some 42 + +-- The oracle refuses constructor-form arguments: the ledger entry is +-- literals-only, and refusal is observable as `oracleMissing`. +#guard + match run (.app (.app (.ref natAddExt) (natE 1)) (.lit (.nat 1))) with + | .error (.oracleMissing _) => true + | _ => false + +/-! ## ◻ absorption -/ + +#guard + match run (.app .erased (natE 1)) with + | .ok .erased => true + | _ => false +#guard + match run (.proj 0 .erased) with + | .ok .erased => true + | _ => false + +/-! ## Error taxonomy -/ + +#guard + match run (.ref (addrOf 0xFF)) with + | .error (.unknownRef _) => true + | _ => false +#guard + match run (.app (.lit (.nat 1)) (.lit (.nat 2))) with + | .error (.stuck _) => true + | _ => false +#guard + match run (.proj 5 (.app (.app (.ref pairMk) (natE 1)) (natE 2))) with + | .error (.stuck _) => true + | _ => false + +/-! ## Fuel: divergence and monotonicity -/ + +private def delta : Expr := .lam .many (.app (.var 0) (.var 0)) + +-- Ω runs out of any finite fuel — the untyped IR expresses divergence +-- even without fixpoints. +#guard + match run (.app delta delta) with + | .error .fuel => true + | _ => false + +-- The same term that succeeds above fails as `.fuel` (not `.stuck`) +-- when starved: fuel exhaustion is the only non-answer. +#guard + match eval ctx 5 [] (.app (.app (.ref natAddDef) (natE 2)) (natE 3)) with + | .error .fuel => true + | _ => false + +end Ix.Compiler.IxIR0.Examples diff --git a/Ix/Compiler/IxIR0/MapRecovery.lean b/Ix/Compiler/IxIR0/MapRecovery.lean new file mode 100644 index 000000000..42e88f7f0 --- /dev/null +++ b/Ix/Compiler/IxIR0/MapRecovery.lean @@ -0,0 +1,217 @@ +import Ix.Compiler.IxIR0.Recursion + +/-! +# Checked specialization of a closed source map + +The ordinary list recursor receives a nil minor and a step minor that calls a +constant-valued worker before constructing the result cons. Specialization +exposes that worker and the recursive call in one rule. Recognition checks +every declaration and the complete entry; no replacement body is supplied by +the caller. Constructor and worker identities remain those of the source. +-/ + +namespace Ix.Compiler.IxIR0.MapRecovery + +open Ix.Compiler.Ixon (Address) +open Recursion (app2 ghost) + +def policyTag : String := "closed-map-specialize/1" + +structure Schema where + nil : Address + cons : Address + recursor : Address + alias : Address + base : Address + step : Address + worker : Address + replacement : Nat + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr + +def workerExpr (s : Schema) : Expr := .lam .many (ghost (.lit (.nat s.replacement))) +def baseExpr (s : Schema) : Expr := ghost (.ref s.nil) +def stepExpr (s : Schema) : Expr := + .lam .many (.lam .many (.lam .many + (app2 (.ref s.cons) (.app (.ref s.worker) (.var 2)) (.var 0)))) + +def literalRecursor : Decl := + .recursor 2 false #[ + { fields := 0, rhs := .var 1 }, + { fields := 2 + rhs := .app (app2 (.var 2) (.var 1) (.var 0)) + (.app (app2 (.var 4) (.var 3) (.var 2)) (.var 0)) }] + +def directRecursor (s : Schema) : Decl := + .recursor 0 false #[ + { fields := 0, rhs := .ref s.nil }, + { fields := 2 + rhs := app2 (.ref s.cons) (.app (.ref s.worker) (.var 1)) (.app (.var 2) (.var 0)) }] + +def listOnto (s : Schema) (literal : Bool) : List Nat → Expr → Expr + | [], tail => tail + | n :: ns, tail => app2 (.ref s.cons) + (if literal then ghost (.lit (.nat n)) else .lit (.nat n)) (listOnto s literal ns tail) + +def listExpr (s : Schema) (literal : Bool) (values : List Nat) : Expr := + listOnto s literal values (if literal then ghost (.ref s.nil) else .ref s.nil) + +def literalCall (s : Schema) (major : Expr) : Expr := + .app (app2 (.ref s.alias) (.ref s.base) (.ref s.step)) major + +structure Plan where + schema : Schema + values : List Nat + retainedAlias : Option Address := none + uniquePrefix : Nat := 0 + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr + +def Plan.main (p : Plan) (literal : Bool) (call : Expr → Expr) : Expr := + match p.retainedAlias with + | none => call (listExpr p.schema literal p.values) + | some pair => + .letE .many (listExpr p.schema literal (p.values.drop p.uniquePrefix)) + (app2 (.ref pair) + (call (listOnto p.schema literal (p.values.take p.uniquePrefix) (.var 0))) (.var 0)) + +def Plan.literalMain (p : Plan) : Expr := p.main true (literalCall p.schema) +def Plan.directMain (p : Plan) (address : Address) : Expr := p.main false (.app (.ref address)) + +structure SourceMatches (env : Env) (s : Schema) : Prop where + nil : env s.nil = some (.ctor 0 0) + cons : env s.cons = some (.ctor 1 2) + recursor : env s.recursor = some literalRecursor + alias : env s.alias = some (.defn .shared (.ref s.recursor)) + base : env s.base = some (.defn .shared (baseExpr s)) + step : env s.step = some (.defn .shared (stepExpr s)) + worker : env s.worker = some (.defn .shared (workerExpr s)) + +instance (env : Env) (s : Schema) : Decidable (SourceMatches env s) := + decidable_of_iff + (env s.nil = some (.ctor 0 0) ∧ env s.cons = some (.ctor 1 2) ∧ + env s.recursor = some literalRecursor ∧ + env s.alias = some (.defn .shared (.ref s.recursor)) ∧ + env s.base = some (.defn .shared (baseExpr s)) ∧ + env s.step = some (.defn .shared (stepExpr s)) ∧ + env s.worker = some (.defn .shared (workerExpr s))) + ⟨fun h => ⟨h.1, h.2.1, h.2.2.1, h.2.2.2.1, h.2.2.2.2.1, h.2.2.2.2.2.1, h.2.2.2.2.2.2⟩, + fun h => ⟨h.nil, h.cons, h.recursor, h.alias, h.base, h.step, h.worker⟩⟩ + +def Plan.aliasMatches (p : Plan) (env : Env) : Prop := + match p.retainedAlias with | none => True | some pair => env pair = some (.ctor 0 2) +instance (p : Plan) (env : Env) : Decidable (p.aliasMatches env) := by + unfold Plan.aliasMatches + split <;> infer_instance + +structure Checked (declarations : List (Address × Decl)) (main : Expr) where + plan : Plan + root : Address + mainEq : main = .ref root + source : SourceMatches (Env.ofList declarations) plan.schema + entry : Env.ofList declarations root = some (.defn .shared plan.literalMain) + alias : plan.aliasMatches (Env.ofList declarations) + +def check (declarations : List (Address × Decl)) (main : Expr) (plan : Plan) : + Option (Checked declarations main) := + match main with + | .ref root => + if hs : SourceMatches (Env.ofList declarations) plan.schema then + if he : Env.ofList declarations root = some (.defn .shared plan.literalMain) then + if ha : plan.aliasMatches (Env.ofList declarations) then + some { plan, root, mainEq := rfl, source := hs, entry := he, alias := ha } + else none + else none + else none + | _ => none + +private def call? : Expr → Option (Address × Address × Address × Expr) + | .app (.app (.app (.ref alias) (.ref base)) (.ref step)) major => some (alias, base, step, major) + | _ => none + +private def listParts? (s : Schema) : Expr → Option (List Nat × Expr) + | .app (.app (.ref address) (.app (.lam .many (.lit (.nat n))) .erased)) tail => do + if address != s.cons then none else + let (ns, endExpr) ← listParts? s tail + return (n :: ns, endExpr) + | expr => some ([], expr) + +def propose (declarations : List (Address × Decl)) (main : Expr) : Option Plan := do + let .ref root := main | none + let env := Env.ofList declarations + let some (.defn .shared body) := env root | none + let (call, retainedAlias, suffix) ← match body with + | .letE .many suffix (.app (.app (.ref pair) call) (.var 0)) => pure (call, some pair, suffix) + | body => pure (body, none, .erased) + let (alias, base, step, major) ← call? call + let some (.defn .shared (.ref recursor)) := env alias | none + let some (.defn .shared (.app (.lam .many (.ref nil)) .erased)) := env base | none + let some (.defn .shared (.lam .many (.lam .many (.lam .many + (.app (.app (.ref cons) (.app (.ref worker) (.var 2))) (.var 0)))))) := env step | none + let some (.defn .shared (.lam .many (.app (.lam .many (.lit (.nat replacement))) .erased))) := env worker | none + let schema : Schema := { nil, cons, recursor, alias, base, step, worker, replacement } + match retainedAlias with + | none => + let (values, endExpr) ← listParts? schema major + if endExpr != ghost (.ref nil) then none else return { schema, values } + | some pair => + let (heads, .var 0) ← listParts? schema major | none + let (tail, endExpr) ← listParts? schema suffix + if endExpr != ghost (.ref nil) then none else + return { schema, values := heads ++ tail, retainedAlias := some pair, uniquePrefix := heads.length } + +def targetDeclarations (p : Plan) (address : Address) : List (Address × Decl) := + [(p.schema.nil, .ctor 0 0), (p.schema.cons, .ctor 1 2), + (p.schema.worker, .defn .shared (workerExpr p.schema)), (address, directRecursor p.schema)] ++ + p.retainedAlias.toList.map (fun pair => (pair, .ctor 0 2)) + +structure TargetMatches (env : Env) (p : Plan) (address : Address) : Prop where + nil : env p.schema.nil = some (.ctor 0 0) + cons : env p.schema.cons = some (.ctor 1 2) + worker : env p.schema.worker = some (.defn .shared (workerExpr p.schema)) + recursor : env address = some (directRecursor p.schema) + alias : p.aliasMatches env +instance (env : Env) (p : Plan) (address : Address) : Decidable (TargetMatches env p address) := + decidable_of_iff + (env p.schema.nil = some (.ctor 0 0) ∧ env p.schema.cons = some (.ctor 1 2) ∧ + env p.schema.worker = some (.defn .shared (workerExpr p.schema)) ∧ + env address = some (directRecursor p.schema) ∧ p.aliasMatches env) + ⟨fun h => ⟨h.1, h.2.1, h.2.2.1, h.2.2.2.1, h.2.2.2.2⟩, + fun h => ⟨h.nil, h.cons, h.worker, h.recursor, h.alias⟩⟩ + +structure Recovered (declarations : List (Address × Decl)) (main : Expr) where + checked : Checked declarations main + address : Address + addressed : address = (directRecursor checked.plan.schema).address + fresh : address ∉ declarations.map (·.1) + target : TargetMatches (Env.ofList (targetDeclarations checked.plan address)) checked.plan address + +inductive Selection (declarations : List (Address × Decl)) (main : Expr) where + | literal (reason : Recursion.Skip) + | recovered (result : Recovered declarations main) + +def Selection.declarations {declarations : List (Address × Decl)} {main : Expr} : + Selection declarations main → List (Address × Decl) + | .literal _ => declarations + | .recovered result => targetDeclarations result.checked.plan result.address +def Selection.main {declarations : List (Address × Decl)} {main : Expr} : Selection declarations main → Expr + | .literal _ => main + | .recovered result => result.checked.plan.directMain result.address + +def selectWith (declarations : List (Address × Decl)) (main : Expr) (proposal : Option Plan) : + Selection declarations main := + match proposal with + | none => .literal .unrecognized + | some plan => + match check declarations main plan with + | none => .literal .rejectedProposal + | some checked => + let address := (directRecursor checked.plan.schema).address + if hfresh : address ∉ declarations.map (·.1) then + if ht : TargetMatches (Env.ofList (targetDeclarations checked.plan address)) checked.plan address then + .recovered { checked, address, addressed := rfl, fresh := hfresh, target := ht } + else .literal .rejectedTarget + else .literal .addressConflict + +def select (declarations : List (Address × Decl)) (main : Expr) : Selection declarations main := + selectWith declarations main (propose declarations main) + +end Ix.Compiler.IxIR0.MapRecovery diff --git a/Ix/Compiler/IxIR0/MapRecoverySim.lean b/Ix/Compiler/IxIR0/MapRecoverySim.lean new file mode 100644 index 000000000..66f46833f --- /dev/null +++ b/Ix/Compiler/IxIR0/MapRecoverySim.lean @@ -0,0 +1,216 @@ +import Ix.Compiler.IxIR0.MapRecovery +import Ix.Compiler.IxIR0.RecursionSim +import Ix.Compiler.IxIR0.ProjectionFree + +/-! The actual eager source fold and its direct map both evaluate to the same +list. Fuel witnesses termination; uniqueness transports any successful source +run. The checked target also supplies projection-safe trace completeness. -/ + +namespace Ix.Compiler.IxIR0.MapRecovery + +open Ix.Compiler.Ixon (Address) +open Recursion + +def listOntoValue (s : Schema) : List Nat → Value → Value + | [], tail => tail + | n :: ns, tail => .ctor s.cons 1 [.lit (.nat n), listOntoValue s ns tail] +def listValue (s : Schema) (ns : List Nat) : Value := listOntoValue s ns (.ctor s.nil 0 []) +def mappedValue (s : Schema) (ns : List Nat) : Value := listValue s (ns.map (fun _ => s.replacement)) +def baseValue (s : Schema) : Value := .ctor s.nil 0 [] +def stepBody (s : Schema) : Expr := app2 (.ref s.cons) (.app (.ref s.worker) (.var 2)) (.var 0) +def stepValue (s : Schema) : Value := .clos .many [] (.lam .many (.lam .many (stepBody s))) + +theorem workerRun {ctx : Ctx} {s : Schema} {env : List Value} {argument : Expr} {value : Value} + (worker : ctx.env s.worker = some (.defn .shared (workerExpr s))) + (arg : Evaluates ctx env argument value) : + Evaluates ctx env (.app (.ref s.worker) argument) (.lit (.nat s.replacement)) := + evaluatesApp (evaluatesDef worker (evaluatesLam ..)) arg + (appliesClosure (evaluatesGhost (evaluatesLit ..))) + +theorem stepRun {ctx : Ctx} {s : Schema} (hs : SourceMatches ctx.env s) + (head tail mapped : Value) : + Applies ctx (.clos .many [tail, head] (stepBody s)) mapped + (.ctor s.cons 1 [.lit (.nat s.replacement), mapped]) := by + apply appliesClosure + exact evaluatesCtor2 hs.cons (workerRun hs.worker (evaluatesVar (by rfl))) + (evaluatesVar (by rfl)) + +theorem sourceMap {ctx : Ctx} {s : Schema} (hs : SourceMatches ctx.env s) (ns : List Nat) : + Applies ctx (.pap (.rec_ s.recursor 3) [baseValue s, stepValue s]) + (listValue s ns) (mappedValue s ns) := by + induction ns with + | nil => + apply appliesRecursor hs.recursor (by rfl) (by rfl) (by rfl) + exact evaluatesVar (by rfl) + | cons n ns ih => + apply appliesRecursor hs.recursor (by rfl) (by rfl) (by rfl) + have recursive : Evaluates ctx + [listValue s ns, .lit (.nat n), stepValue s, baseValue s, .pap (.rec_ s.recursor 3) []] + (.app (app2 (.var 4) (.var 3) (.var 2)) (.var 0)) (mappedValue s ns) := evaluatesApp + (evaluatesApp + (evaluatesApp (evaluatesVar (by rfl)) (evaluatesVar (by rfl)) + (appliesTernaryFirst ctx s.recursor (baseValue s))) + (evaluatesVar (by rfl)) (appliesTernaryNext ctx s.recursor (baseValue s) (stepValue s))) + (evaluatesVar (by rfl)) ih + have first : Applies ctx (stepValue s) (.lit (.nat n)) + (.clos .many [.lit (.nat n)] (.lam .many (stepBody s))) := + appliesClosure (evaluatesLam ..) + have second : Applies ctx (.clos .many [.lit (.nat n)] (.lam .many (stepBody s))) + (listValue s ns) (.clos .many [listValue s ns, .lit (.nat n)] (stepBody s)) := + appliesClosure (evaluatesLam ..) + exact evaluatesApp + (evaluatesApp (evaluatesApp (evaluatesVar (by rfl)) (evaluatesVar (by rfl)) first) + (evaluatesVar (by rfl)) second) + recursive (stepRun hs _ _ _) + +theorem targetMap {ctx : Ctx} {p : Plan} {address : Address} + (hs : TargetMatches ctx.env p address) (ns : List Nat) : + Applies ctx (.pap (.rec_ address 1) []) (listValue p.schema ns) (mappedValue p.schema ns) := by + induction ns with + | nil => + apply appliesRecursor hs.recursor (by rfl) (by rfl) (by rfl) + exact evaluatesNullary hs.nil + | cons n ns ih => + apply appliesRecursor hs.recursor (by rfl) (by rfl) (by rfl) + exact evaluatesCtor2 hs.cons (workerRun hs.worker (evaluatesVar (by rfl))) + (evaluatesApp (evaluatesVar (by rfl)) (evaluatesVar (by rfl)) ih) + +theorem literalCallRun {ctx : Ctx} {s : Schema} {env : List Value} {major : Expr} {ns : List Nat} + (hs : SourceMatches ctx.env s) (majorRun : Evaluates ctx env major (listValue s ns)) : + Evaluates ctx env (literalCall s major) (mappedValue s ns) := + evaluatesApp + (evaluatesApp + (evaluatesApp (evaluatesDef hs.alias (evaluatesRecursor hs.recursor)) + (evaluatesDef hs.base (evaluatesGhost (evaluatesNullary hs.nil))) + (appliesTernaryFirst ctx s.recursor (baseValue s))) + (evaluatesDef hs.step (evaluatesLam ..)) + (appliesTernaryNext ctx s.recursor (baseValue s) (stepValue s))) majorRun (sourceMap hs ns) + +theorem directCallRun {ctx : Ctx} {p : Plan} {address : Address} {env : List Value} + {major : Expr} {ns : List Nat} (hs : TargetMatches ctx.env p address) + (majorRun : Evaluates ctx env major (listValue p.schema ns)) : + Evaluates ctx env (.app (.ref address) major) (mappedValue p.schema ns) := + evaluatesApp (evaluatesRecursor hs.recursor) majorRun (targetMap hs ns) + +theorem listOntoRun {ctx : Ctx} {s : Schema} {env : List Value} {tail : Expr} {value : Value} + (cons : ctx.env s.cons = some (.ctor 1 2)) (literal : Bool) (ns : List Nat) + (tailRun : Evaluates ctx env tail value) : + Evaluates ctx env (listOnto s literal ns tail) (listOntoValue s ns value) := by + induction ns with + | nil => exact tailRun + | cons n ns ih => + apply evaluatesCtor2 cons + · cases literal with + | false => exact evaluatesLit .. + | true => exact evaluatesGhost (evaluatesLit ..) + · exact ih + +theorem listRun {ctx : Ctx} {s : Schema} (nil : ctx.env s.nil = some (.ctor 0 0)) + (cons : ctx.env s.cons = some (.ctor 1 2)) (literal : Bool) (ns : List Nat) (env : List Value) : + Evaluates ctx env (listExpr s literal ns) (listValue s ns) := by + apply listOntoRun cons literal ns + cases literal with + | false => exact evaluatesNullary nil + | true => exact evaluatesGhost (evaluatesNullary nil) + +theorem listOntoValue_append (s : Schema) (xs ys : List Nat) (tail : Value) : + listOntoValue s xs (listOntoValue s ys tail) = listOntoValue s (xs ++ ys) tail := by + induction xs with + | nil => rfl + | cons n ns ih => simp only [listOntoValue, List.cons_append, ih] + +def Plan.value (p : Plan) : Value := + match p.retainedAlias with + | none => mappedValue p.schema p.values + | some pair => .ctor pair 0 [mappedValue p.schema p.values, + listValue p.schema (p.values.drop p.uniquePrefix)] + +theorem mainRun {ctx : Ctx} {p : Plan} (literal : Bool) (call : Expr → Expr) + (nil : ctx.env p.schema.nil = some (.ctor 0 0)) (cons : ctx.env p.schema.cons = some (.ctor 1 2)) + (alias : p.aliasMatches ctx.env) + (callRun : ∀ {env major ns}, Evaluates ctx env major (listValue p.schema ns) → + Evaluates ctx env (call major) (mappedValue p.schema ns)) : + Evaluates ctx [] (p.main literal call) p.value := by + cases retained : p.retainedAlias with + | none => + simp only [Plan.main, Plan.value, retained] + exact callRun (listRun nil cons literal p.values []) + | some pair => + simp only [Plan.main, Plan.value, retained] + have pairAt : ctx.env pair = some (.ctor 0 2) := by + simpa only [Plan.aliasMatches, retained] using alias + apply evaluatesLet (listRun nil cons literal (p.values.drop p.uniquePrefix) []) + apply evaluatesCtor2 pairAt + · apply callRun + have parts := listOntoRun cons literal (p.values.take p.uniquePrefix) + (evaluatesVar (ctx := ctx) + (env := [listValue p.schema (p.values.drop p.uniquePrefix)]) (i := 0) (by rfl)) + simpa only [listValue, listOntoValue_append, List.take_append_drop] using parts + · exact evaluatesVar (by rfl) + +theorem Checked.sourceEvaluates {declarations : List (Address × Decl)} {main : Expr} + (checked : Checked declarations main) : + Evaluates { env := Env.ofList declarations } [] main checked.plan.value := by + have body := mainRun (ctx := { env := Env.ofList declarations }) + true (literalCall checked.plan.schema) checked.source.nil checked.source.cons checked.alias + (literalCallRun checked.source) + simpa only [checked.mainEq] using evaluatesDef (env := []) checked.entry body + +theorem Recovered.forwardSimulation {declarations : List (Address × Decl)} {main : Expr} + (recovered : Recovered declarations main) {fuel : Nat} {value : Value} + (run : eval { env := Env.ofList declarations } fuel [] main = .ok value) : + ∃ targetFuel, eval { env := Env.ofList (targetDeclarations recovered.checked.plan recovered.address) } + targetFuel [] (recovered.checked.plan.directMain recovered.address) = .ok value := by + have values := (recovered.checked.sourceEvaluates).unique ⟨fuel, run⟩ + rw [← values] + exact mainRun false (.app (.ref recovered.address)) recovered.target.nil recovered.target.cons + recovered.target.alias (directCallRun recovered.target) + +theorem Selection.forwardSimulation {declarations : List (Address × Decl)} {main : Expr} + (selection : Selection declarations main) {fuel : Nat} {value : Value} + (run : eval { env := Env.ofList declarations } fuel [] main = .ok value) : + ∃ targetFuel, eval { env := Env.ofList selection.declarations } targetFuel [] selection.main = .ok value := by + cases selection with + | literal reason => exact ⟨fuel, run⟩ + | recovered recovered => exact recovered.forwardSimulation run + +open ProjectionFree + +theorem listOntoSafe (s : Schema) (ns : List Nat) {tail : Expr} (safe : ExprSafe tail) : + ExprSafe (listOnto s false ns tail) := by + induction ns with + | nil => exact safe + | cons n ns ih => simpa only [ExprSafe, listOnto, Bool.false_eq_true, ite_false, + app2, syntaxSafe, Bool.true_and] using ih + +theorem Plan.directMainSafe (plan : Plan) (address : Address) : ExprSafe (plan.directMain address) := by + have lists : ∀ ns, ExprSafe (listExpr plan.schema false ns) := + fun ns => listOntoSafe plan.schema ns (by rfl) + have heads := listOntoSafe plan.schema (plan.values.take plan.uniquePrefix) (tail := .var 0) (by rfl) + cases alias : plan.retainedAlias <;> + simp [ExprSafe, Plan.directMain, Plan.main, alias, app2, syntaxSafe, lists, heads] + +theorem Plan.targetContextSafe (plan : Plan) (address : Address) : + CtxSafe { env := Env.ofList (targetDeclarations plan address) } := by + constructor + · intro key declaration lookup + have rows : (targetDeclarations plan address).all (fun row => declSafe row.2) = true := by + cases alias : plan.retainedAlias <;> + simp [targetDeclarations, alias, directRecursor, workerExpr, ghost, app2, declSafe, syntaxSafe] + unfold Env.ofList at lookup + obtain ⟨row, found, value⟩ := Option.map_eq_some_iff.mp lookup + have safe := List.all_eq_true.mp rows row (List.mem_of_find?_eq_some found) + simpa only [value] using safe + · intro key arguments result _ oracle + cases oracle + +theorem Recovered.projectionSafe {declarations : List (Address × Decl)} {main : Expr} + (recovery : Recovered declarations main) {fuel : Nat} {value : Value} + (run : eval { env := Env.ofList (targetDeclarations recovery.checked.plan recovery.address) } + fuel [] (recovery.checked.plan.directMain recovery.address) = .ok value) : + ProjectionSafe.Eval { env := Env.ofList (targetDeclarations recovery.checked.plan recovery.address) } + fuel [] (recovery.checked.plan.directMain recovery.address) value := + ProjectionFree.Eval.of_run (recovery.checked.plan.targetContextSafe recovery.address) + ValuesSafe.nil (recovery.checked.plan.directMainSafe recovery.address) run + +end Ix.Compiler.IxIR0.MapRecovery diff --git a/Ix/Compiler/IxIR0/Mono.lean b/Ix/Compiler/IxIR0/Mono.lean new file mode 100644 index 000000000..76957ce66 --- /dev/null +++ b/Ix/Compiler/IxIR0/Mono.lean @@ -0,0 +1,166 @@ +import Ix.Compiler.Fuel +import Ix.Compiler.IxIR0.Eval + +/-! +# Fuel monotonicity for the IxIR₀ interpreter + +The workhorse lemma of the erasure-simulation work: a successful +evaluation stays successful (with the same value) under more fuel. +This is what lets a proof combine sub-derivations obtained at +different fuels — lift everything to the max. Proved for all four +mutual functions at once by induction on fuel; the uniform +decrement-at-entry discipline keeps the induction shape trivial. +-/ + +namespace Ix.Compiler.IxIR0 + +/-- `Except`-bind reduction on a success (definitional; core has no +named lemma for it). -/ +private theorem bindOk {α β : Type} (a : α) (f : α → Except Err β) : + (Except.ok a >>= f) = f a := rfl + +/-- `Except`-bind reduction on an error. -/ +private theorem bindErr {α β : Type} (e : Err) (f : α → Except Err β) : + ((Except.error e : Except Err α) >>= f) = Except.error e := rfl + +private def MonoAt (fuel : Nat) : Prop := + (∀ ctx ρ e v, eval ctx fuel ρ e = .ok v → eval ctx (fuel + 1) ρ e = .ok v) ∧ + (∀ ctx f a v, apply ctx fuel f a = .ok v → apply ctx (fuel + 1) f a = .ok v) ∧ + (∀ ctx h args v, saturate ctx fuel h args = .ok v → + saturate ctx (fuel + 1) h args = .ok v) ∧ + (∀ ctx h args v, fire ctx fuel h args = .ok v → + fire ctx (fuel + 1) h args = .ok v) + +private theorem monoAt : ∀ fuel, MonoAt fuel := by + intro fuel + induction fuel with + | zero => + refine ⟨?_, ?_, ?_, ?_⟩ + · intro ctx ρ e v h; rw [eval.eq_def] at h; simp at h + · intro ctx f a v h; rw [apply.eq_def] at h; simp at h + · intro ctx hd args v h; rw [saturate.eq_def] at h; simp at h + · intro ctx hd args v h; rw [fire.eq_def] at h; simp at h + | succ n ihn => + obtain ⟨ihE, ihA, ihS, ihF⟩ := ihn + refine ⟨?_, ?_, ?_, ?_⟩ + -- eval + · intro ctx ρ e v h + cases e with + | var i => + rw [eval.eq_def] at h; rw [eval.eq_def]; dsimp only at h ⊢; exact h + | lit l => + rw [eval.eq_def] at h; rw [eval.eq_def]; dsimp only at h ⊢; exact h + | erased => + rw [eval.eq_def] at h; rw [eval.eq_def]; dsimp only at h ⊢; exact h + | lam u body => + rw [eval.eq_def] at h; rw [eval.eq_def]; dsimp only at h ⊢; exact h + | letE u val body => + rw [eval.eq_def] at h; rw [eval.eq_def]; dsimp only at h ⊢ + cases hval : eval ctx n ρ val with + | error err => rw [hval, bindErr] at h; simp at h + | ok w => + rw [hval, bindOk] at h + rw [ihE _ _ _ _ hval, bindOk] + exact ihE _ _ _ _ h + | app fn arg => + rw [eval.eq_def] at h; rw [eval.eq_def]; dsimp only at h ⊢ + cases hf : eval ctx n ρ fn with + | error err => rw [hf, bindErr] at h; simp at h + | ok fv => + rw [hf, bindOk] at h + rw [ihE _ _ _ _ hf, bindOk] + cases ha : eval ctx n ρ arg with + | error err => rw [ha, bindErr] at h; simp at h + | ok av => + rw [ha, bindOk] at h + rw [ihE _ _ _ _ ha, bindOk] + exact ihA _ _ _ _ h + | proj i s => + rw [eval.eq_def] at h; rw [eval.eq_def]; dsimp only at h ⊢ + cases hs : eval ctx n ρ s with + | error err => rw [hs, bindErr] at h; simp at h + | ok w => + rw [hs, bindOk] at h + rw [ihE _ _ _ _ hs, bindOk] + exact h + | ref a => + rw [eval.eq_def] at h; rw [eval.eq_def]; dsimp only at h ⊢ + split at h + · exact h + · exact ihE _ _ _ _ h + · exact ihS _ _ _ _ h + · exact h + · exact ihS _ _ _ _ h + -- apply + · intro ctx f a v h + cases f with + | clos u ρ body => + rw [apply.eq_def] at h; rw [apply.eq_def]; dsimp only at h ⊢ + exact ihE _ _ _ _ h + | pap hd args => + rw [apply.eq_def] at h; rw [apply.eq_def]; dsimp only at h ⊢ + exact ihS _ _ _ _ h + | erased => + rw [apply.eq_def] at h; rw [apply.eq_def]; dsimp only at h ⊢; exact h + | ctor adr tag args => + rw [apply.eq_def] at h; rw [apply.eq_def]; dsimp only at h ⊢; exact h + | lit l => + rw [apply.eq_def] at h; rw [apply.eq_def]; dsimp only at h ⊢; exact h + -- saturate + · intro ctx hd args v h + rw [saturate.eq_def] at h; rw [saturate.eq_def]; dsimp only at h ⊢ + cases hc : args.length == hd.arity + · simp only [hc] at h ⊢ + simp at h ⊢ + exact h + · simp only [hc] at h ⊢ + simp at h ⊢ + exact ihF _ _ _ _ h + -- fire + · intro ctx hd args v h + cases hd with + | ctor a tag ar => + rw [fire.eq_def] at h; rw [fire.eq_def]; dsimp only at h ⊢; exact h + | ext a ar => + rw [fire.eq_def] at h; rw [fire.eq_def]; dsimp only at h ⊢; exact h + | rec_ a ar => + rw [fire.eq_def] at h; rw [fire.eq_def]; dsimp only at h ⊢ + split at h + · rename_i natLit rules heq + split at h + · exact h + · rename_i major heq' + cases hmc : majorCtor natLit major with + | error err => rw [hmc, bindErr] at h; simp at h + | ok tf => + obtain ⟨tag, fields⟩ := tf + rw [hmc, bindOk] at h + rw [bindOk] + dsimp only at h ⊢ + split at h + · exact h + · rename_i rule heq'' + split at h + · rename_i hc + rw [if_pos hc] + exact h + · rename_i hc + rw [if_neg hc] + exact ihE _ _ _ _ h + · exact h + +/-- Success is stable under raising fuel (`eval`). -/ +theorem eval_mono {ctx : Ctx} {fuel fuel' : Nat} {ρ : List Value} {e : Expr} + {v : Value} (hle : fuel ≤ fuel') (h : eval ctx fuel ρ e = .ok v) : + eval ctx fuel' ρ e = .ok v := by + exact fuel_mono_of_succ + (fun current hrun => (monoAt current).1 _ _ _ _ hrun) hle h + +/-- Success is stable under raising fuel (`apply`). -/ +theorem apply_mono {ctx : Ctx} {fuel fuel' : Nat} {f a v : Value} + (hle : fuel ≤ fuel') (h : apply ctx fuel f a = .ok v) : + apply ctx fuel' f a = .ok v := by + exact fuel_mono_of_succ + (fun current hrun => (monoAt current).2.1 _ _ _ _ hrun) hle h + +end Ix.Compiler.IxIR0 diff --git a/Ix/Compiler/IxIR0/MutualBlock.lean b/Ix/Compiler/IxIR0/MutualBlock.lean new file mode 100644 index 000000000..d5a5a32e2 --- /dev/null +++ b/Ix/Compiler/IxIR0/MutualBlock.lean @@ -0,0 +1,986 @@ +import Ix.Compiler.IxIR0.Decode + +/-! +# Cycle-safe IxIR₀ mutual-block identities + +An ordinary declaration preimage spells every global edge as a 32-byte +address. That representation cannot independently content-address two +declarations which refer to each other. This module supplies the artifact +boundary for such a strongly connected component: + +* references inside the ordered block are represented by a local member + index; +* references outside the block retain their full address; +* the complete ordered symbolic block is hashed once; and +* each executable environment key is derived, with a separate domain, from + the block hash and its member index. + +`runCertified` converts transiently keyed IxIR₀ declarations to this form, +derives the final keys, materializes local edges, rejects every observed +namespace/hash collision, and retains an erased executable audit relating the +result to the input. The hash calls are native, so successful runs belong at +compiled artifact boundaries and in `Tests.lean`, not elaboration-time +`#guard`s. +-/ + +namespace Ix.Compiler.IxIR0 + +open Ix.Compiler.Ixon (Address Owned Uses) +open Ix.Compiler.IxIR + +namespace MutualBlock + +/-! ## Symbolic block syntax -/ + +/-- A global edge in a mutual-block preimage. -/ +inductive Ref where + | local (index : Nat) + | external (address : Address) + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- IxIR₀ expressions with block-local references made explicit. -/ +inductive Expr where + | var (index : Nat) + | ref (target : Ref) + | app (fn arg : Expr) + | lam (uses : Uses) (body : Expr) + | letE (uses : Uses) (value body : Expr) + | proj (index : Nat) (struct : Expr) + | lit (literal : IxIR0.Literal) + | erased + deriving BEq, ReflBEq, LawfulBEq, Repr, Inhabited + +/-- A recursor rule in a symbolic mutual block. -/ +structure RecRule where + fields : Nat + rhs : Expr + deriving BEq, ReflBEq, LawfulBEq, Repr, Inhabited + +/-- A declaration in a symbolic mutual block. -/ +inductive Decl where + | defn (result : Owned) (body : Expr) + | ctor (tag arity : Nat) + | recursor (numArgs : Nat) (natLit : Bool) (rules : Array RecRule) + | extern (arity : Nat) + deriving BEq, ReflBEq, LawfulBEq, Repr, Inhabited + +/-! ## Temporary-name abstraction -/ + +/-- Return the first zero-based position of an address. Successful block +construction rejects duplicate keys, so the first position is the unique +position at that boundary. -/ +def localIndex? (keys : List Address) (address : Address) : Option Nat := + let rec loop : Nat → List Address → Option Nat + | _, [] => none + | index, key :: rest => + if key == address then some index else loop (index + 1) rest + loop 0 keys + +namespace Ref + +/-- Classify one concrete address against the ordered temporary namespace. -/ +def abstract (keys : List Address) (address : Address) : Ref := + match localIndex? keys address with + | some index => .local index + | none => .external address + +/-- Concrete external references carried by a symbolic edge. -/ +def externalReferences : Ref → List Address + | .local _ => [] + | .external address => [address] + +/-- Whether every local edge lies within the block. -/ +def wellScoped (memberCount : Nat) : Ref → Bool + | .local index => index < memberCount + | .external _ => true + +/-- Resolve a symbolic edge against the final ordered member keys. -/ +def materialize (memberKeys : Array Address) : Ref → Except String Address + | .local index => + match memberKeys[index]? with + | some address => .ok address + | none => .error s!"mutual-block local reference {index} is out of range" + | .external address => .ok address + +end Ref + +namespace Expr + +/-- Replace concrete references by local indices whenever they name a member +of the same block. -/ +def abstract (keys : List Address) : IxIR0.Expr → Expr + | .var index => .var index + | .ref address => .ref (Ref.abstract keys address) + | .app fn arg => .app (abstract keys fn) (abstract keys arg) + | .lam uses body => .lam uses (abstract keys body) + | .letE uses value body => + .letE uses (abstract keys value) (abstract keys body) + | .proj index struct => .proj index (abstract keys struct) + | .lit literal => .lit literal + | .erased => .erased + +/-- Materialize every local edge using the final member-key array. -/ +def materialize (memberKeys : Array Address) : Expr → Except String IxIR0.Expr + | .var index => .ok (.var index) + | .ref target => return .ref (← target.materialize memberKeys) + | .app fn arg => + return .app (← materialize memberKeys fn) + (← materialize memberKeys arg) + | .lam uses body => return .lam uses (← materialize memberKeys body) + | .letE uses value body => + return .letE uses (← materialize memberKeys value) + (← materialize memberKeys body) + | .proj index struct => + return .proj index (← materialize memberKeys struct) + | .lit literal => .ok (.lit literal) + | .erased => .ok .erased + +/-- Concrete external references carried anywhere in a symbolic expression. -/ +def externalReferences : Expr → List Address + | .var _ => [] + | .ref target => target.externalReferences + | .app fn arg => externalReferences fn ++ externalReferences arg + | .lam _ body => externalReferences body + | .letE _ value body => + externalReferences value ++ externalReferences body + | .proj _ struct => externalReferences struct + | .lit _ | .erased => [] + +/-- Executable local-scope check. -/ +def wellScoped (memberCount : Nat) : Expr → Bool + | .var _ => true + | .ref target => target.wellScoped memberCount + | .app fn arg => wellScoped memberCount fn && wellScoped memberCount arg + | .lam _ body => wellScoped memberCount body + | .letE _ value body => + wellScoped memberCount value && wellScoped memberCount body + | .proj _ struct => wellScoped memberCount struct + | .lit _ | .erased => true + +end Expr + +namespace RecRule + +def abstract (keys : List Address) (rule : IxIR0.RecRule) : RecRule := + { fields := rule.fields, rhs := Expr.abstract keys rule.rhs } + +def materialize (memberKeys : Array Address) + (rule : RecRule) : Except String IxIR0.RecRule := + return { fields := rule.fields, rhs := ← rule.rhs.materialize memberKeys } + +def externalReferences (rule : RecRule) : List Address := + rule.rhs.externalReferences + +def wellScoped (memberCount : Nat) (rule : RecRule) : Bool := + rule.rhs.wellScoped memberCount + +end RecRule + +namespace Decl + +/-- Abstract one ordinary IxIR₀ declaration against an ordered member-key +namespace. -/ +def abstract (keys : List Address) : IxIR0.Decl → Decl + | .defn result body => .defn result (Expr.abstract keys body) + | .ctor tag arity => .ctor tag arity + | .recursor numArgs natLit rules => + .recursor numArgs natLit (rules.map (RecRule.abstract keys)) + | .extern arity => .extern arity + +/-- Materialize one symbolic declaration using final member keys. -/ +def materialize (memberKeys : Array Address) : Decl → Except String IxIR0.Decl + | .defn result body => return .defn result (← body.materialize memberKeys) + | .ctor tag arity => .ok (.ctor tag arity) + | .recursor numArgs natLit rules => + return .recursor numArgs natLit + (← rules.mapM (RecRule.materialize memberKeys)) + | .extern arity => .ok (.extern arity) + +def externalReferences : Decl → List Address + | .defn _ body => body.externalReferences + | .ctor _ _ | .extern _ => [] + | .recursor _ _ rules => + rules.toList.flatMap RecRule.externalReferences + +def wellScoped (memberCount : Nat) : Decl → Bool + | .defn _ body => body.wellScoped memberCount + | .ctor _ _ | .extern _ => true + | .recursor _ _ rules => + rules.all (RecRule.wellScoped memberCount) + +end Decl + +/-- Abstract the declarations of a transiently keyed ordered block. Keys are +not serialized; they are used only to recognize local edges. -/ +def abstractMembers (members : List (Address × IxIR0.Decl)) : List Decl := + let keys := members.map (·.1) + members.map fun member => Decl.abstract keys member.2 + +/-! ## Canonical bytes and cryptographic identities -/ + +namespace Ref + +/-- Canonical reference payload. The tag distinguishes local indices from +full external addresses. -/ +def bytes : Ref → ByteArray + | .local index => Encoding.tag 0 ++ Encoding.nat index + | .external address => Encoding.tag 1 ++ Encoding.address address + +end Ref + +namespace Expr + +/-- Canonical symbolic expression payload. -/ +def bytes : Expr → ByteArray + | .var index => Encoding.tag 0 ++ Encoding.nat index + | .ref target => Encoding.tag 1 ++ target.bytes + | .app fn arg => Encoding.tag 2 ++ bytes fn ++ bytes arg + | .lam uses body => + Encoding.tag 3 ++ Encoding.tag uses.toBits ++ bytes body + | .letE uses value body => + Encoding.tag 4 ++ Encoding.tag uses.toBits ++ + bytes value ++ bytes body + | .proj index struct => + Encoding.tag 5 ++ Encoding.nat index ++ bytes struct + | .lit literal => Encoding.tag 6 ++ IxIR0.Literal.bytes literal + | .erased => Encoding.tag 7 + +end Expr + +namespace RecRule + +def bytes (rule : RecRule) : ByteArray := + Encoding.nat rule.fields ++ rule.rhs.bytes + +end RecRule + +namespace Decl + +/-- Canonical symbolic declaration payload. -/ +def bytes : Decl → ByteArray + | .defn result body => + Encoding.tag 0 ++ Encoding.tag result.toBits ++ body.bytes + | .ctor tag arity => + Encoding.tag 1 ++ Encoding.nat tag ++ Encoding.nat arity + | .recursor numArgs natLit rules => + Encoding.tag 2 ++ Encoding.nat numArgs ++ Encoding.bool natLit ++ + Encoding.array RecRule.bytes rules + | .extern arity => Encoding.tag 3 ++ Encoding.nat arity + +end Decl + +namespace Block + +/-- Versioned domain for a complete ordered IxIR₀ mutual block. -/ +def addressDomain : ByteArray := + Encoding.domain "compilatrix/ixir0/mutual-block/1" ++ Encoding.tag 0 + +/-- Complete canonical mutual-block hash preimage. -/ +def preimage (members : List Decl) : ByteArray := + addressDomain ++ Encoding.list Decl.bytes members + +/-- Content identity of a complete symbolic mutual block. -/ +def address (members : List Decl) : Address := + Address.blake3 (preimage members) + +/-- Block-address equality exposes exact preimage equality under the one +pairwise cryptographic premise actually needed. -/ +theorem address_eq_iff_preimage_eq (left right : List Decl) + (hcollision : Address.Blake3NoCollision (preimage left) (preimage right)) : + address left = address right ↔ preimage left = preimage right := by + constructor + · exact hcollision + · intro h + simp only [address] + rw [h] + +end Block + +namespace Member + +/-- Versioned domain for a member key derived from a mutual-block identity. -/ +def addressDomain : ByteArray := + Encoding.domain "compilatrix/ixir0/mutual-member/1" ++ Encoding.tag 0 + +/-- Canonical member-key preimage. -/ +def preimage (block : Address) (index : Nat) : ByteArray := + addressDomain ++ Encoding.address block ++ Encoding.nat index + +/-- Derive one executable declaration key from its block and local index. -/ +def address (block : Address) (index : Nat) : Address := + Address.blake3 (preimage block index) + +/-- Member-address equality exposes exact preimage equality under the one +pairwise cryptographic premise actually needed. -/ +theorem address_eq_iff_preimage_eq (leftBlock rightBlock : Address) + (leftIndex rightIndex : Nat) + (hcollision : Address.Blake3NoCollision + (preimage leftBlock leftIndex) (preimage rightBlock rightIndex)) : + address leftBlock leftIndex = address rightBlock rightIndex ↔ + preimage leftBlock leftIndex = preimage rightBlock rightIndex := by + constructor + · exact hcollision + · intro h + simp only [address] + rw [h] + +end Member + +/-! ## Strict block-preimage decoder -/ + +open Ix.Compiler.IxIR.Decode +open Ix.Compiler.Ixon + +def getRefTag : UInt8 → GetM Ref + | 0 => do return .local (← Decode.getNat) + | 1 => do return .external (← Decode.getAddress) + | tag => throw s!"IxIR0 mutual-block reference: invalid tag {tag}" + +def getRef : GetM Ref := do + getRefTag (← getU8) + +def getExprTag (recur : GetM Expr) : UInt8 → GetM Expr + | 0 => do return .var (← Decode.getNat) + | 1 => do return .ref (← getRef) + | 2 => do return .app (← recur) (← recur) + | 3 => do return .lam (← IxIR0.getUses) (← recur) + | 4 => do + let uses ← IxIR0.getUses + let value ← recur + return .letE uses value (← recur) + | 5 => do return .proj (← Decode.getNat) (← recur) + | 6 => do return .lit (← IxIR0.getLiteral) + | 7 => pure .erased + | tag => throw s!"IxIR0 mutual-block expression: invalid tag {tag}" + +def getExprFuel : Nat → GetM Expr + | 0 => throw "IxIR0 mutual-block expression: recursion limit" + | fuel + 1 => do + getExprTag (getExprFuel fuel) (← getU8) + +def getExpr : GetM Expr := do + let state ← get + getExprFuel (state.bytes.size + 1) + +def getRecRule : GetM RecRule := do + return ⟨← Decode.getNat, ← getExpr⟩ + +def getDeclTag : UInt8 → GetM Decl + | 0 => do return .defn (← IxIR0.getOwned) (← getExpr) + | 1 => do return .ctor (← Decode.getNat) (← Decode.getNat) + | 2 => do + let numArgs ← Decode.getNat + let natLit ← Decode.getBool + return .recursor numArgs natLit (← Decode.getArray getRecRule) + | 3 => do return .extern (← Decode.getNat) + | tag => throw s!"IxIR0 mutual-block declaration: invalid tag {tag}" + +def getDecl : GetM Decl := do + getDeclTag (← getU8) + +def getBlockPreimage : GetM (List Decl) := do + Decode.expectBytes Block.addressDomain + Decode.getList getDecl + +/-- Decode one complete canonical symbolic block preimage. This is the codec +layer and therefore accepts an empty list or a syntactically valid +out-of-range local edge; `decodeArtifact` applies those semantic checks. -/ +def Block.decodePreimage (bytes : ByteArray) : Except String (List Decl) := + Decode.runCanonical getBlockPreimage Block.preimage bytes + +/-- Decode and validate an artifact-shaped block. -/ +def Block.decodeArtifact (bytes : ByteArray) : Except String (List Decl) := do + let members ← Block.decodePreimage bytes + if members.isEmpty then + throw "mutual block must contain at least one member" + unless members.all (Decl.wellScoped members.length) do + throw "mutual block contains an out-of-range local reference" + return members + +/-! ### Cursor-relative decoder proofs -/ + +theorem getRef_spec : ∀ target : Ref, GetSpec getRef target.bytes target + | .local index => by + have hpayload := Decode.getSpecMap (Decode.getNat_spec index) Ref.local + have htotal := GetSpec.bind (next := getRefTag) + (Decode.getU8_tag_spec 0) hpayload + simpa only [getRef, Ref.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .external address => by + have hpayload := Decode.getSpecMap + (Decode.getAddress_spec address) Ref.external + have htotal := GetSpec.bind (next := getRefTag) + (Decode.getU8_tag_spec 1) hpayload + simpa only [getRef, Ref.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + +/-- Recursive parser depth. Every encoded symbolic expression has at least +this many constructor-tag bytes along its deepest branch. -/ +def Expr.decodeDepth : Expr → Nat + | .var _ | .ref _ | .lit _ | .erased => 1 + | .app function argument => + 1 + Nat.max function.decodeDepth argument.decodeDepth + | .lam _ body => 1 + body.decodeDepth + | .letE _ value body => + 1 + Nat.max value.decodeDepth body.decodeDepth + | .proj _ target => 1 + target.decodeDepth + +theorem Expr.decodeDepth_le_bytes (expression : Expr) : + expression.decodeDepth ≤ expression.bytes.size := by + induction expression with + | var index => simp [Expr.decodeDepth, Expr.bytes] + | ref target => simp [Expr.decodeDepth, Expr.bytes] + | app function argument hfunction hargument => + simp only [Expr.decodeDepth, Expr.bytes, ByteArray.size_append, + Decode.tag_size] + have hleft : function.decodeDepth ≤ + function.bytes.size + argument.bytes.size := by omega + have hright : argument.decodeDepth ≤ + function.bytes.size + argument.bytes.size := by omega + have hmax : Nat.max function.decodeDepth argument.decodeDepth ≤ + function.bytes.size + argument.bytes.size := + Nat.max_le.mpr ⟨hleft, hright⟩ + omega + | lam uses body hbody => + simp only [Expr.decodeDepth, Expr.bytes, ByteArray.size_append, + Decode.tag_size] + omega + | letE uses value body hvalue hbody => + simp only [Expr.decodeDepth, Expr.bytes, ByteArray.size_append, + Decode.tag_size] + have hleft : value.decodeDepth ≤ value.bytes.size + body.bytes.size := by + omega + have hright : body.decodeDepth ≤ value.bytes.size + body.bytes.size := by + omega + have hmax : Nat.max value.decodeDepth body.decodeDepth ≤ + value.bytes.size + body.bytes.size := + Nat.max_le.mpr ⟨hleft, hright⟩ + omega + | proj index target htarget => + simp only [Expr.decodeDepth, Expr.bytes, ByteArray.size_append, + Decode.tag_size] + omega + | lit literal => + simp only [Expr.decodeDepth, Expr.bytes, ByteArray.size_append, + Decode.tag_size] + omega + | erased => simp [Expr.decodeDepth, Expr.bytes] + +theorem getExprFuel_spec (expression : Expr) (fuel : Nat) + (hfuel : expression.decodeDepth < fuel) : + GetSpec (getExprFuel fuel) expression.bytes expression := by + induction expression generalizing fuel with + | var index => + cases fuel with + | zero => omega + | succ fuel => + have hpayload := Decode.getSpecMap (Decode.getNat_spec index) Expr.var + have htotal := GetSpec.bind + (next := getExprTag (getExprFuel fuel)) + (Decode.getU8_tag_spec 0) hpayload + simpa only [getExprFuel, Expr.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | ref target => + cases fuel with + | zero => omega + | succ fuel => + have hpayload := Decode.getSpecMap (getRef_spec target) Expr.ref + have htotal := GetSpec.bind + (next := getExprTag (getExprFuel fuel)) + (Decode.getU8_tag_spec 1) hpayload + simpa only [getExprFuel, Expr.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | app function argument hfunction hargument => + cases fuel with + | zero => omega + | succ fuel => + simp only [Expr.decodeDepth] at hfuel + have hmax : Nat.max function.decodeDepth argument.decodeDepth < fuel := by + omega + have hfunctionFuel : function.decodeDepth < fuel := + Nat.lt_of_le_of_lt (Nat.le_max_left _ _) hmax + have hargumentFuel : argument.decodeDepth < fuel := + Nat.lt_of_le_of_lt (Nat.le_max_right _ _) hmax + have hpayload := Decode.getSpecMap2 + (hfunction fuel hfunctionFuel) (hargument fuel hargumentFuel) + Expr.app + have htotal := GetSpec.bind + (next := getExprTag (getExprFuel fuel)) + (Decode.getU8_tag_spec 2) hpayload + simpa only [getExprFuel, Expr.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | lam uses body hbody => + cases fuel with + | zero => omega + | succ fuel => + simp only [Expr.decodeDepth] at hfuel + have hbodyFuel : body.decodeDepth < fuel := by omega + have hpayload := Decode.getSpecMap2 (IxIR0.getUses_spec uses) + (hbody fuel hbodyFuel) Expr.lam + have htotal := GetSpec.bind + (next := getExprTag (getExprFuel fuel)) + (Decode.getU8_tag_spec 3) hpayload + simpa only [getExprFuel, Expr.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | letE uses value body hvalue hbody => + cases fuel with + | zero => omega + | succ fuel => + simp only [Expr.decodeDepth] at hfuel + have hmax : Nat.max value.decodeDepth body.decodeDepth < fuel := by + omega + have hvalueFuel : value.decodeDepth < fuel := + Nat.lt_of_le_of_lt (Nat.le_max_left _ _) hmax + have hbodyFuel : body.decodeDepth < fuel := + Nat.lt_of_le_of_lt (Nat.le_max_right _ _) hmax + have hpayload := Decode.getSpecMap3 (IxIR0.getUses_spec uses) + (hvalue fuel hvalueFuel) (hbody fuel hbodyFuel) Expr.letE + have htotal := GetSpec.bind + (next := getExprTag (getExprFuel fuel)) + (Decode.getU8_tag_spec 4) hpayload + simpa only [getExprFuel, Expr.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | proj index target htarget => + cases fuel with + | zero => omega + | succ fuel => + simp only [Expr.decodeDepth] at hfuel + have htargetFuel : target.decodeDepth < fuel := by omega + have hpayload := Decode.getSpecMap2 (Decode.getNat_spec index) + (htarget fuel htargetFuel) Expr.proj + have htotal := GetSpec.bind + (next := getExprTag (getExprFuel fuel)) + (Decode.getU8_tag_spec 5) hpayload + simpa only [getExprFuel, Expr.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | lit literal => + cases fuel with + | zero => omega + | succ fuel => + have hpayload := Decode.getSpecMap + (IxIR0.getLiteral_spec literal) Expr.lit + have htotal := GetSpec.bind + (next := getExprTag (getExprFuel fuel)) + (Decode.getU8_tag_spec 6) hpayload + simpa only [getExprFuel, Expr.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | erased => + cases fuel with + | zero => omega + | succ fuel => + have hpayload : GetSpec (getExprTag (getExprFuel fuel) 7) + ByteArray.empty Expr.erased := GetSpec.pure Expr.erased + have htotal := GetSpec.bind + (next := getExprTag (getExprFuel fuel)) + (Decode.getU8_tag_spec 7) hpayload + simpa only [getExprFuel, Expr.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + +theorem getExpr_spec (expression : Expr) : + GetSpec getExpr expression.bytes expression := by + intro pre suffix + let fuel := (pre ++ expression.bytes ++ suffix).size + 1 + have hfuel : expression.decodeDepth < fuel := by + have hdepth := expression.decodeDepth_le_bytes + dsimp [fuel] + simp only [ByteArray.size_append] + omega + have hspec := getExprFuel_spec expression fuel hfuel pre suffix + simpa [getExpr, fuel] using hspec + +theorem getRecRule_spec (rule : RecRule) : + GetSpec getRecRule rule.bytes rule := by + have hspec := Decode.getSpecMap2 (Decode.getNat_spec rule.fields) + (getExpr_spec rule.rhs) RecRule.mk + simpa [getRecRule, RecRule.bytes] using hspec + +theorem getDecl_spec : ∀ declaration : Decl, + GetSpec getDecl declaration.bytes declaration + | .defn result body => by + have hpayload := Decode.getSpecMap2 (IxIR0.getOwned_spec result) + (getExpr_spec body) Decl.defn + have htotal := GetSpec.bind (next := getDeclTag) + (Decode.getU8_tag_spec 0) hpayload + simpa only [getDecl, Decl.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .ctor tag arity => by + have hpayload := Decode.getSpecMap2 (Decode.getNat_spec tag) + (Decode.getNat_spec arity) Decl.ctor + have htotal := GetSpec.bind (next := getDeclTag) + (Decode.getU8_tag_spec 1) hpayload + simpa only [getDecl, Decl.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .recursor numArgs natLit rules => by + have hpayload := Decode.getSpecMap3 (Decode.getNat_spec numArgs) + (Decode.getBool_spec natLit) + (Decode.getArray_spec getRecRule RecRule.bytes getRecRule_spec rules) + Decl.recursor + have htotal := GetSpec.bind (next := getDeclTag) + (Decode.getU8_tag_spec 2) hpayload + simpa only [getDecl, Decl.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .extern arity => by + have hpayload := Decode.getSpecMap (Decode.getNat_spec arity) Decl.extern + have htotal := GetSpec.bind (next := getDeclTag) + (Decode.getU8_tag_spec 3) hpayload + simpa only [getDecl, Decl.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + +theorem getBlockPreimage_spec (members : List Decl) : + GetSpec getBlockPreimage (Block.preimage members) members := by + let next : Unit → GetM (List Decl) := fun _ => Decode.getList getDecl + have htotal := GetSpec.bind (next := next) + (Decode.expectBytes_spec Block.addressDomain) + (Decode.getList_spec getDecl Decl.bytes getDecl_spec members) + simpa [getBlockPreimage, Block.preimage, next] using htotal + +/-! ### Strict top-level codec laws -/ + +/-- Every symbolic block decodes from its canonical framed preimage. -/ +theorem Block.decodePreimage_roundtrip (members : List Decl) : + Block.decodePreimage (Block.preimage members) = .ok members := by + exact Decode.runCanonical_of_spec getBlockPreimage Block.preimage members + (getBlockPreimage_spec members) + +/-- Every accepted byte string is the canonical preimage of its result. -/ +theorem Block.decodePreimage_canonical {bytes : ByteArray} + {members : List Decl} + (hdecode : Block.decodePreimage bytes = .ok members) : + Block.preimage members = bytes := by + exact Decode.runCanonical_canonical getBlockPreimage Block.preimage hdecode + +/-- Canonical symbolic block preimages are injective. -/ +theorem Block.preimage_injective : Function.Injective Block.preimage := by + intro left right hbytes + have hok : (Except.ok left : Except String (List Decl)) = .ok right := by + calc + .ok left = Block.decodePreimage (Block.preimage left) := + (Block.decodePreimage_roundtrip left).symm + _ = Block.decodePreimage (Block.preimage right) := + congrArg Block.decodePreimage hbytes + _ = .ok right := Block.decodePreimage_roundtrip right + exact Except.ok.inj hok + +/-! ## Materializing a transient block -/ + +/-- Old transient member key to final derived member key. -/ +abbrev Renaming := List (Address × Address) + +namespace Renaming + +def lookup (mapping : Renaming) (address : Address) : Option Address := + (mapping.find? fun entry => entry.1 == address).map (·.2) + +def apply (mapping : Renaming) (address : Address) : Address := + (mapping.lookup address).getD address + +def contains (mapping : Renaming) (address : Address) : Bool := + mapping.any fun entry => entry.1 == address + +end Renaming + +namespace Concrete + +namespace Expr + +/-- Rename every concrete global edge in an ordinary IxIR₀ expression. -/ +def mapAddresses (rename : Address → Address) : IxIR0.Expr → IxIR0.Expr + | .var index => .var index + | .ref address => .ref (rename address) + | .app fn arg => .app (mapAddresses rename fn) (mapAddresses rename arg) + | .lam uses body => .lam uses (mapAddresses rename body) + | .letE uses value body => + .letE uses (mapAddresses rename value) (mapAddresses rename body) + | .proj index struct => .proj index (mapAddresses rename struct) + | .lit literal => .lit literal + | .erased => .erased + +def references : IxIR0.Expr → List Address + | .var _ => [] + | .ref address => [address] + | .app fn arg => references fn ++ references arg + | .lam _ body => references body + | .letE _ value body => references value ++ references body + | .proj _ struct => references struct + | .lit _ | .erased => [] + +end Expr + +namespace RecRule + +def mapAddresses (rename : Address → Address) + (rule : IxIR0.RecRule) : IxIR0.RecRule := + { rule with rhs := Expr.mapAddresses rename rule.rhs } + +def references (rule : IxIR0.RecRule) : List Address := + Expr.references rule.rhs + +end RecRule + +namespace Decl + +def mapAddresses (rename : Address → Address) : IxIR0.Decl → IxIR0.Decl + | .defn result body => .defn result (Expr.mapAddresses rename body) + | .ctor tag arity => .ctor tag arity + | .recursor numArgs natLit rules => + .recursor numArgs natLit (rules.map (RecRule.mapAddresses rename)) + | .extern arity => .extern arity + +def references : IxIR0.Decl → List Address + | .defn _ body => Expr.references body + | .ctor _ _ | .extern _ => [] + | .recursor _ _ rules => rules.toList.flatMap RecRule.references + +end Decl + +end Concrete + +/-- A completely materialized mutual-block result. -/ +structure Result where + blockAddress : Address + blockMembers : List Decl + members : List (Address × IxIR0.Decl) + addressMap : Renaming + +namespace Result + +def transientAddresses (result : Result) : List Address := + result.addressMap.map (·.1) + +def derivedAddresses (result : Result) : List Address := + result.addressMap.map (·.2) + +/-- Every recorded destination is the domain-separated derivation at its +position, and the emitted key list is exactly that destination list. -/ +def memberKeysDerived (result : Result) : Bool := + let rec loop : Nat → Renaming → Bool + | _, [] => true + | index, entry :: rest => + entry.2 == Member.address result.blockAddress index && + loop (index + 1) rest + loop 0 result.addressMap && + result.members.map (·.1) == result.derivedAddresses + +/-- Re-abstracting the final declarations recovers the exact canonical +symbolic block. -/ +def blockStable (result : Result) : Bool := + abstractMembers result.members == result.blockMembers + +def noTransientKeys (result : Result) : Bool := + !(result.members.map (·.1)).any result.transientAddresses.contains + +def noTransientReferences (result : Result) : Bool := + let references := result.members.flatMap fun member => + Concrete.Decl.references member.2 + !references.any result.transientAddresses.contains + +/-- Executable certificate that the materialized environment is exactly the +address-renamed image of the transient environment and that the symbolic +artifact remains stable after materialization. -/ +def semanticAudit (result : Result) + (raw : List (Address × IxIR0.Decl)) : Bool := + let rename := Renaming.apply result.addressMap + let original := IxIR0.Env.ofList raw + let emitted := IxIR0.Env.ofList result.members + result.blockMembers == abstractMembers raw && + result.blockAddress == Block.address result.blockMembers && + result.memberKeysDerived && result.blockStable && + result.noTransientKeys && result.noTransientReferences && + raw.all (fun entry => + match original entry.1, emitted (rename entry.1) with + | some before, some after => + after == Concrete.Decl.mapAddresses rename before + | _, _ => false) && + result.members.all (fun entry => + match emitted entry.1 with + | some declaration => + Concrete.Decl.mapAddresses rename declaration == declaration + | none => false) + +end Result + +/-- A successful block construction carries its runtime-erased audit. -/ +abbrev CertifiedResult (raw : List (Address × IxIR0.Decl)) := + { result : Result // result.semanticAudit raw = true } + +private def firstDuplicate? : List Address → Option Address + | [] => none + | address :: rest => + if rest.contains address then some address else firstDuplicate? rest + +private def firstOverlap? (left right : List Address) : Option Address := + left.find? right.contains + +private def deriveMap (block : Address) : + Nat → List (Address × IxIR0.Decl) → Renaming + | _, [] => [] + | index, member :: rest => + (member.1, Member.address block index) :: deriveMap block (index + 1) rest + +/-- A decoded and materialized block artifact, independent of any transient +producer namespace. -/ +structure Artifact where + blockAddress : Address + blockMembers : List Decl + members : List (Address × IxIR0.Decl) + +namespace Artifact + +def memberKeysDerived (artifact : Artifact) : Bool := + let rec loop : Nat → List (Address × IxIR0.Decl) → Bool + | _, [] => true + | index, member :: rest => + member.1 == Member.address artifact.blockAddress index && + loop (index + 1) rest + loop 0 artifact.members + +def stable (artifact : Artifact) : Bool := + abstractMembers artifact.members == artifact.blockMembers + +def audit (artifact : Artifact) : Bool := + artifact.blockAddress == Block.address artifact.blockMembers && + artifact.members.length == artifact.blockMembers.length && + artifact.blockMembers.all + (Decl.wellScoped artifact.blockMembers.length) && + artifact.memberKeysDerived && artifact.stable + +end Artifact + +private def deriveKeys (block : Address) : Nat → Nat → List Address + | _, 0 => [] + | index, count + 1 => + Member.address block index :: deriveKeys block (index + 1) count + +/-- Validate and materialize already-symbolic members, as used after decoding +a stored block. -/ +def Block.materializeArtifact (reserved : List Address) + (blockMembers : List Decl) : Except String Artifact := do + if blockMembers.isEmpty then + throw "mutual block must contain at least one member" + unless blockMembers.all (Decl.wellScoped blockMembers.length) do + throw "mutual block contains an out-of-range local reference" + let blockAddress := Block.address blockMembers + if reserved.contains blockAddress then + throw s!"mutual-block identity collides with reserved identity {Address.toHex blockAddress}" + let external := blockMembers.flatMap Decl.externalReferences + if external.contains blockAddress then + throw s!"mutual-block identity collides with an external reference {Address.toHex blockAddress}" + let derived := deriveKeys blockAddress 0 blockMembers.length + if let some duplicate := firstDuplicate? derived then + throw s!"BLAKE3 collision between mutual-block member keys {Address.toHex duplicate}" + if derived.contains blockAddress then + throw s!"mutual-block member key collides with its block identity {Address.toHex blockAddress}" + if let some overlap := firstOverlap? derived reserved then + throw s!"mutual-block member key collides with reserved identity {Address.toHex overlap}" + if let some overlap := firstOverlap? derived external then + throw s!"mutual-block member key captures an external reference {Address.toHex overlap}" + let declarations ← blockMembers.mapM + (Decl.materialize derived.toArray) + let artifact : Artifact := + { blockAddress, blockMembers, members := derived.zip declarations } + unless artifact.audit do + throw "internal: decoded mutual block failed materialization audit" + return artifact + +/-- Strictly decode, scope-check, collision-check, and materialize a stored +mutual block. -/ +def Block.decodeMaterialized (reserved : List Address) + (bytes : ByteArray) : Except String Artifact := do + Block.materializeArtifact reserved (← Block.decodeArtifact bytes) + +private def certify (raw : List (Address × IxIR0.Decl)) + (result : Result) : Except String (CertifiedResult raw) := + if haudit : result.semanticAudit raw then .ok ⟨result, haudit⟩ + else .error "internal: mutual-block materialization failed semantic audit" + +/-- Construct and certify a cycle-safe block while protecting all caller-owned +address identities. `reserved` should contain every non-member declaration +or artifact key in the surrounding closed world. + +The function rejects empty blocks, duplicate/overlapping temporary keys, +observed BLAKE3 collisions between derived members, and capture of any +temporary, external, reserved, or block-artifact identity. -/ +def runCertified (reserved : List Address) + (raw : List (Address × IxIR0.Decl)) : + Except String (CertifiedResult raw) := do + if raw.isEmpty then + throw "mutual block must contain at least one member" + let transient := raw.map (·.1) + if let some duplicate := firstDuplicate? transient then + throw s!"duplicate mutual-block temporary address {Address.toHex duplicate}" + if let some overlap := firstOverlap? transient reserved then + throw s!"mutual-block temporary address overlaps reserved identity {Address.toHex overlap}" + let blockMembers := abstractMembers raw + unless blockMembers.all (Decl.wellScoped blockMembers.length) do + throw "internal: abstracted mutual block contains an out-of-range local reference" + let blockAddress := Block.address blockMembers + if transient.contains blockAddress then + throw s!"mutual-block identity overlaps temporary namespace {Address.toHex blockAddress}" + if reserved.contains blockAddress then + throw s!"mutual-block identity collides with reserved identity {Address.toHex blockAddress}" + let external := blockMembers.flatMap Decl.externalReferences + if external.contains blockAddress then + throw s!"mutual-block identity collides with an external reference {Address.toHex blockAddress}" + let addressMap := deriveMap blockAddress 0 raw + let derived := addressMap.map (·.2) + if let some duplicate := firstDuplicate? derived then + throw s!"BLAKE3 collision between mutual-block member keys {Address.toHex duplicate}" + if derived.contains blockAddress then + throw s!"mutual-block member key collides with its block identity {Address.toHex blockAddress}" + if let some overlap := firstOverlap? derived transient then + throw s!"mutual-block member key overlaps temporary namespace {Address.toHex overlap}" + if let some overlap := firstOverlap? derived reserved then + throw s!"mutual-block member key collides with reserved identity {Address.toHex overlap}" + if let some overlap := firstOverlap? derived external then + throw s!"mutual-block member key captures an external reference {Address.toHex overlap}" + let memberKeys := derived.toArray + let materialized ← blockMembers.mapM (Decl.materialize memberKeys) + let members := derived.zip materialized + let result : Result := + { blockAddress, blockMembers, members, addressMap } + certify raw result + +/-- Artifact-facing projection of `runCertified`. -/ +def run (reserved : List Address) + (raw : List (Address × IxIR0.Decl)) : Except String Result := do + return (← runCertified reserved raw).1 + +/-- Every successful artifact-facing run retains the erased semantic audit +constructed by `runCertified`. -/ +theorem semanticAudit_of_run_eq_ok + {reserved : List Address} {raw : List (Address × IxIR0.Decl)} + {result : Result} (hrun : run reserved raw = .ok result) : + result.semanticAudit raw = true := by + unfold run at hrun + cases hcertified : runCertified reserved raw with + | error message => + rw [hcertified] at hrun + contradiction + | ok certified => + rw [hcertified] at hrun + have hvalue : certified.1 = result := by injection hrun + subst result + exact certified.2 + +/-! Pure structural format guards. Digest and executable construction +fixtures live in the compiled test executable. -/ + +private def fixtureA : Address := Address.replicate 0xfa +private def fixtureB : Address := Address.replicate 0xfb +private def fixtureExternal : Address := Address.replicate 0xee + +#guard Ref.bytes (.local 128) == ByteArray.mk #[0, 128, 1] +#guard (Ref.bytes (.external fixtureExternal)).size == 33 +#guard Expr.bytes (.ref (.local 1)) == ByteArray.mk #[1, 0, 1] +#guard Decl.bytes (.defn .shared (.ref (.local 1))) == + ByteArray.mk #[0, 1, 1, 0, 1] +#guard + abstractMembers + [(fixtureA, .defn .shared (.ref fixtureB)), + (fixtureB, .defn .shared (.ref fixtureA))] == + [.defn .shared (.ref (.local 1)), + .defn .shared (.ref (.local 0))] + +end MutualBlock + +end Ix.Compiler.IxIR0 diff --git a/Ix/Compiler/IxIR0/NatArithmetic.lean b/Ix/Compiler/IxIR0/NatArithmetic.lean new file mode 100644 index 000000000..a45d6af3b --- /dev/null +++ b/Ix/Compiler/IxIR0/NatArithmetic.lean @@ -0,0 +1,144 @@ +import Ix.Compiler.IxIR0.RecursionSim + +/-! A mathematical summary of the canonical Nat recursor used for addition. +The summary is proved in the ordinary evaluator, including literal peeling; +there is no arithmetic extern or replacement source oracle. -/ + +namespace Ix.Compiler.IxIR0.NatArithmetic + +open Ix.Compiler.Ixon (Address) +open Recursion + +structure Schema where + successor : Address + recursor : Address + alias : Address + deriving DecidableEq, Repr + +def rules : Array RecRule := #[ + { fields := 0, rhs := .var 1 }, + { fields := 1, rhs := .app (.app (.var 1) (.var 0)) + (.app (.app (.app (.var 3) (.var 2)) (.var 1)) (.var 0)) }] + +def stepBody (schema : Schema) : Expr := + .lam .many (.lam .many (.app (.ref schema.successor) (.var 0))) + +def body (schema : Schema) : Expr := + .lam .many (.lam .many + (.app (.app (.app (.ref schema.alias) (.var 1)) (stepBody schema)) (.var 0))) + +structure Matches (ctx : Ctx) (schema : Schema) : Prop where + successor : ctx.env schema.successor = some (.ctor 1 1) + recursor : ctx.env schema.recursor = some (.recursor 2 true rules) + alias : ctx.env schema.alias = some (.defn .shared (.ref schema.recursor)) + +instance (ctx : Ctx) (schema : Schema) : Decidable (Matches ctx schema) := + decidable_of_iff + (ctx.env schema.successor = some (.ctor 1 1) ∧ + ctx.env schema.recursor = some (.recursor 2 true rules) ∧ + ctx.env schema.alias = some (.defn .shared (.ref schema.recursor))) + ⟨fun h => ⟨h.1, h.2.1, h.2.2⟩, fun h => ⟨h.successor, h.recursor, h.alias⟩⟩ + +/-- Runtime arguments can be literals; previous source additions can also +have constructed successor spines. Both denote the same unbounded Nat. -/ +inductive Represents (schema : Schema) : Value → Nat → Prop where + | literal (value : Nat) : Represents schema (.lit (.nat value)) value + | successor {value : Value} {number : Nat} (tail : Represents schema value number) : + Represents schema (.ctor schema.successor 1 [value]) (number + 1) + +theorem appliesRecursorView {ctx : Ctx} {address : Address} + {pre : List Value} {major : Value} {tag : Nat} {fields : List Value} + {recRules : Array RecRule} {rule : RecRule} {result : Value} + (declaration : ctx.env address = some (.recursor 2 true recRules)) + (arity : pre.length = 2) + (view : majorCtor true major = .ok (tag, fields)) + (found : recRules[tag]? = some rule) (fieldCount : fields.length = rule.fields) + (evaluated : Evaluates ctx + (fields.reverse ++ pre.reverse ++ [.pap (.rec_ address 3) []]) rule.rhs result) : + Applies ctx (.pap (.rec_ address 3) pre) major result := by + obtain ⟨fuel, evaluated⟩ := evaluated + refine ⟨fuel + 3, ?_⟩ + rw [apply.eq_def] + dsimp only + rw [saturate.eq_def] + simp only [Head.arity, List.length_append, List.length_singleton, arity, + beq_self_eq_true, ite_true] + rw [fire.eq_def] + simpa [declaration, view, found, fieldCount] using evaluated + +theorem appliesRecursorFirst (ctx : Ctx) (address : Address) (value : Value) : + Applies ctx (.pap (.rec_ address 3) []) value (.pap (.rec_ address 3) [value]) := by + exact ⟨2, by simp [apply, saturate, Head.arity]⟩ + +theorem appliesRecursorSecond (ctx : Ctx) (address : Address) (left right : Value) : + Applies ctx (.pap (.rec_ address 3) [left]) right (.pap (.rec_ address 3) [left, right]) := by + exact ⟨2, by simp [apply, saturate, Head.arity]⟩ + +def stepValue (schema : Schema) (environment : List Value) : Value := + .clos .many environment (.lam .many (.app (.ref schema.successor) (.var 0))) + +theorem step_applies {ctx : Ctx} {schema : Schema} (matched : Matches ctx schema) + (environment : List Value) (predecessor argument : Value) : + ∃ closure, Applies ctx (stepValue schema environment) predecessor closure ∧ + Applies ctx closure argument (.ctor schema.successor 1 [argument]) := by + refine ⟨.clos .many (predecessor :: environment) (.app (.ref schema.successor) (.var 0)), + appliesClosure (evaluatesLam _ _ _ _), ?_⟩ + apply appliesClosure + refine evaluatesApp (f := .pap (.ctor schema.successor 1 1) []) ?_ (evaluatesVar rfl) ?_ + · exact ⟨2, by simp [eval, matched.successor, saturate, Head.arity]⟩ + · exact ⟨3, by simp [apply, saturate, fire, Head.arity]⟩ + +theorem recursor_add {ctx : Ctx} {schema : Schema} (matched : Matches ctx schema) + (environment : List Value) {left right : Value} {m n : Nat} + (leftValue : Represents schema left m) (rightValue : Represents schema right n) : + ∃ result, Applies ctx (.pap (.rec_ schema.recursor 3) [left, stepValue schema environment]) right result ∧ + Represents schema result (m + n) := by + have zero : Applies ctx (.pap (.rec_ schema.recursor 3) [left, stepValue schema environment]) + (.lit (.nat 0)) left := by + apply appliesRecursorView matched.recursor rfl (by rfl) (by rfl) (by rfl) + exact evaluatesVar rfl + have successor {major predecessor result : Value} {number : Nat} + (view : majorCtor true major = .ok (1, [predecessor])) + (recursive : Applies ctx (.pap (.rec_ schema.recursor 3) + [left, stepValue schema environment]) predecessor result) + (represented : Represents schema result (m + number)) : + ∃ result, Applies ctx (.pap (.rec_ schema.recursor 3) [left, stepValue schema environment]) + major result ∧ Represents schema result (m + (number + 1)) := by + obtain ⟨closure, first, second⟩ := step_applies matched environment predecessor result + refine ⟨.ctor schema.successor 1 [result], ?_, ?_⟩ + · apply appliesRecursorView matched.recursor rfl view (by rfl) (by rfl) + refine evaluatesApp (evaluatesApp (evaluatesVar rfl) (evaluatesVar rfl) first) ?_ second + exact evaluatesApp + (evaluatesApp + (evaluatesApp (evaluatesVar rfl) (evaluatesVar rfl) (appliesRecursorFirst _ _ _)) + (evaluatesVar rfl) (appliesRecursorSecond _ _ _ _)) + (evaluatesVar rfl) recursive + · simpa only [Nat.add_assoc] using Represents.successor represented + induction rightValue with + | literal n => + induction n with + | zero => exact ⟨left, zero, by simpa using leftValue⟩ + | succ n ih => + obtain ⟨result, recursive, represented⟩ := ih + exact successor (by rfl) recursive represented + | successor tail ih => + obtain ⟨result, recursive, represented⟩ := ih + exact successor (by rfl) recursive represented + +theorem body_applies {ctx : Ctx} {schema : Schema} (matched : Matches ctx schema) + {left right : Value} {m n : Nat} + (leftValue : Represents schema left m) (rightValue : Represents schema right n) : + ∃ closure result, + Applies ctx (.clos .many [] (match body schema with | .lam _ body => body | _ => .erased)) left closure ∧ + Applies ctx closure right result ∧ Represents schema result (m + n) := by + obtain ⟨result, recursive, represented⟩ := recursor_add matched [right, left] leftValue rightValue + refine ⟨_, result, appliesClosure (evaluatesLam _ _ _ _), ?_, represented⟩ + apply appliesClosure + refine evaluatesApp + (evaluatesApp + (evaluatesApp ?_ (evaluatesVar rfl) (appliesRecursorFirst _ _ _)) + (evaluatesLam _ _ _ _) (appliesRecursorSecond _ _ _ _)) + (evaluatesVar rfl) recursive + exact evaluatesDef matched.alias (evaluatesRecursor matched.recursor) + +end Ix.Compiler.IxIR0.NatArithmetic diff --git a/Ix/Compiler/IxIR0/NatRecursors.lean b/Ix/Compiler/IxIR0/NatRecursors.lean new file mode 100644 index 000000000..0a5bb6e1e --- /dev/null +++ b/Ix/Compiler/IxIR0/NatRecursors.lean @@ -0,0 +1,150 @@ +import Ix.Compiler.IxIR0.NatArithmetic + +namespace Ix.Compiler.IxIR0.NatArithmetic +open Ix.Compiler.Ixon (Address) +open Recursion + +/-- The ordinary usage checker requires a shared literal producer at these +shared call sites. Erasure retains this constant closure application. -/ +def sharedLiteral (number : Nat) : Expr := .app (.lam .many (.lit (.nat number))) .erased + +theorem sharedLiteral_evaluates (ctx : Ctx) (environment : List Value) (number : Nat) : + Evaluates ctx environment (sharedLiteral number) (.lit (.nat number)) := + evaluatesApp (evaluatesLam _ _ _ _) (evaluatesErased _ _) (appliesClosure (evaluatesLit _ _ _)) + +def fold (step : Nat → Nat → Nat) (initial : Nat) : Nat → Nat + | 0 => initial + | n + 1 => step n (fold step initial n) + +/-- A reusable mathematical contract for the canonical recursor. Its step +is an ordinary source closure and may itself call other proved functions. -/ +theorem recursor_fold {ctx : Ctx} {schema : Schema} (matched : Matches ctx schema) + (step : Nat → Nat → Nat) (function : Value) + (stepApplies : ∀ predecessor argument m n, Represents schema predecessor m → Represents schema argument n → + ∃ closure result, Applies ctx function predecessor closure ∧ Applies ctx closure argument result ∧ + Represents schema result (step m n)) + {initial major : Value} {m n : Nat} (initialValue : Represents schema initial m) (majorValue : Represents schema major n) : + ∃ result, Applies ctx (.pap (.rec_ schema.recursor 3) [initial, function]) major result ∧ + Represents schema result (fold step m n) := by + have zero : Applies ctx (.pap (.rec_ schema.recursor 3) [initial, function]) (.lit (.nat 0)) initial := by + apply appliesRecursorView matched.recursor rfl rfl rfl rfl + exact evaluatesVar rfl + have successor {major predecessor result : Value} {number : Nat} + (view : majorCtor true major = .ok (1, [predecessor])) (predecessorValue : Represents schema predecessor number) + (recursive : Applies ctx (.pap (.rec_ schema.recursor 3) [initial, function]) predecessor result) + (represented : Represents schema result (fold step m number)) : + ∃ result, Applies ctx (.pap (.rec_ schema.recursor 3) [initial, function]) major result ∧ + Represents schema result (fold step m (number + 1)) := by + obtain ⟨closure, result, first, second, represented⟩ := stepApplies predecessor result number _ predecessorValue represented + refine ⟨result, ?_, represented⟩ + apply appliesRecursorView matched.recursor rfl view rfl rfl + refine evaluatesApp (evaluatesApp (evaluatesVar rfl) (evaluatesVar rfl) first) ?_ second + exact evaluatesApp + (evaluatesApp (evaluatesApp (evaluatesVar rfl) (evaluatesVar rfl) (appliesRecursorFirst _ _ _)) + (evaluatesVar rfl) (appliesRecursorSecond _ _ _ _)) + (evaluatesVar rfl) recursive + induction majorValue with + | literal n => + induction n with + | zero => exact ⟨initial, zero, initialValue⟩ + | succ n ih => + obtain ⟨result, recursive, represented⟩ := ih + exact successor rfl (.literal n) recursive represented + | successor predecessor ih => + obtain ⟨result, recursive, represented⟩ := ih + exact successor rfl predecessor recursive represented + +def predStep : Expr := .lam .many (.lam .many (.var 1)) +def predExpression (schema : Schema) : Expr := + .app (.app (.app (.ref schema.alias) (sharedLiteral 0)) predStep) (.var 0) +def predBody (schema : Schema) : Expr := .lam .many (predExpression schema) +def predValue (schema : Schema) : Value := .clos .many [] (predExpression schema) + +theorem fold_predecessor (value : Nat) : fold (fun predecessor _ => predecessor) 0 value = value - 1 := by + cases value <;> rfl + +theorem pred_applies {ctx : Ctx} {schema : Schema} (matched : Matches ctx schema) + {value : Value} {number : Nat} (represented : Represents schema value number) : + ∃ result, Applies ctx (predValue schema) value result ∧ Represents schema result (number - 1) := by + let stepFunction : Value := .clos .many [value] (.lam .many (.var 1)) + have stepApplies : ∀ predecessor argument m n, Represents schema predecessor m → Represents schema argument n → + ∃ closure result, Applies ctx stepFunction predecessor closure ∧ Applies ctx closure argument result ∧ Represents schema result m := by + intro predecessor argument m n predRep argRep + exact ⟨_, predecessor, appliesClosure (evaluatesLam _ _ _ _), appliesClosure (evaluatesVar rfl), predRep⟩ + obtain ⟨result, recursive, resultRep⟩ := recursor_fold matched (fun predecessor _ => predecessor) stepFunction + stepApplies (.literal 0) represented + refine ⟨result, ?_, by simpa only [fold_predecessor] using resultRep⟩ + apply appliesClosure + exact evaluatesApp + (evaluatesApp (evaluatesApp (evaluatesDef matched.alias (evaluatesRecursor matched.recursor)) + (sharedLiteral_evaluates _ _ _) (appliesRecursorFirst _ _ _)) + (evaluatesLam _ _ _ _) (appliesRecursorSecond _ _ _ _)) + (evaluatesVar rfl) recursive + +def subStep (predecessor : Address) : Expr := .lam .many (.lam .many (.app (.ref predecessor) (.var 0))) +def subExpression (schema : Schema) (predecessor : Address) : Expr := + .app (.app (.app (.ref schema.alias) (.var 1)) (subStep predecessor)) (.var 0) +def subBody (schema : Schema) (predecessor : Address) : Expr := .lam .many (.lam .many (subExpression schema predecessor)) +def subValue (schema : Schema) (predecessor : Address) : Value := .clos .many [] (.lam .many (subExpression schema predecessor)) + +theorem fold_subtract (left right : Nat) : fold (fun _ result => result - 1) left right = left - right := by + induction right with + | zero => rfl + | succ right ih => simp only [fold, ih, Nat.sub_sub] + +theorem sub_applies {ctx : Ctx} {schema : Schema} (matched : Matches ctx schema) {predecessor : Address} + (predDeclaration : ctx.env predecessor = some (.defn .shared (predBody schema))) + {left right : Value} {m n : Nat} (leftValue : Represents schema left m) (rightValue : Represents schema right n) : + ∃ closure result, Applies ctx (subValue schema predecessor) left closure ∧ Applies ctx closure right result ∧ + Represents schema result (m - n) := by + let stepFunction : Value := .clos .many [right, left] (.lam .many (.app (.ref predecessor) (.var 0))) + have stepApplies : ∀ pred argument a b, Represents schema pred a → Represents schema argument b → + ∃ closure result, Applies ctx stepFunction pred closure ∧ Applies ctx closure argument result ∧ + Represents schema result (b - 1) := by + intro pred argument a b predRep argRep + obtain ⟨result, applied, resultRep⟩ := pred_applies matched argRep + refine ⟨_, result, appliesClosure (evaluatesLam _ _ _ _), ?_, resultRep⟩ + exact appliesClosure (evaluatesApp (evaluatesDef predDeclaration (evaluatesLam _ _ _ _)) (evaluatesVar rfl) applied) + obtain ⟨result, recursive, resultRep⟩ := recursor_fold matched (fun _ result => result - 1) stepFunction stepApplies leftValue rightValue + refine ⟨_, result, appliesClosure (evaluatesLam _ _ _ _), ?_, by simpa only [fold_subtract] using resultRep⟩ + apply appliesClosure + exact evaluatesApp + (evaluatesApp (evaluatesApp (evaluatesDef matched.alias (evaluatesRecursor matched.recursor)) + (evaluatesVar rfl) (appliesRecursorFirst _ _ _)) + (evaluatesLam _ _ _ _) (appliesRecursorSecond _ _ _ _)) + (evaluatesVar rfl) recursive + +theorem Represents.zero_view {schema : Schema} {value : Value} (represented : Represents schema value 0) : + majorCtor true value = .ok (0, []) := by + cases represented + rfl + +theorem Represents.successor_view {schema : Schema} {value : Value} {number : Nat} + (represented : Represents schema value number) (positive : number ≠ 0) : + ∃ predecessor, majorCtor true value = .ok (1, [predecessor]) ∧ Represents schema predecessor (number - 1) := by + cases represented with + | literal number => + cases number with + | zero => contradiction + | succ number => exact ⟨.lit (.nat number), rfl, .literal _⟩ + | successor tail => exact ⟨_, rfl, tail⟩ + +def caseRules : Array RecRule := #[ + { fields := 0, rhs := .app (.var 1) (sharedLiteral 0) }, + { fields := 1, rhs := .app (.var 1) (.var 0) }] + +theorem case_zero {ctx : Ctx} {schema : Schema} {address : Address} {major zero successor result : Value} + (declaration : ctx.env address = some (.recursor 2 true caseRules)) + (represented : Represents schema major 0) (selected : Applies ctx zero (.lit (.nat 0)) result) : + Applies ctx (.pap (.rec_ address 3) [zero, successor]) major result := by + apply appliesRecursorView declaration rfl represented.zero_view rfl rfl + exact evaluatesApp (evaluatesVar rfl) (sharedLiteral_evaluates _ _ _) selected + +theorem case_successor {ctx : Ctx} {address : Address} {major predecessor zero successor result : Value} + (declaration : ctx.env address = some (.recursor 2 true caseRules)) + (view : majorCtor true major = .ok (1, [predecessor])) (selected : Applies ctx successor predecessor result) : + Applies ctx (.pap (.rec_ address 3) [zero, successor]) major result := by + apply appliesRecursorView declaration rfl view rfl rfl + exact evaluatesApp (evaluatesVar rfl) (evaluatesVar rfl) selected + +end Ix.Compiler.IxIR0.NatArithmetic diff --git a/Ix/Compiler/IxIR0/ProjectionFree.lean b/Ix/Compiler/IxIR0/ProjectionFree.lean new file mode 100644 index 000000000..ee3ef5889 --- /dev/null +++ b/Ix/Compiler/IxIR0/ProjectionFree.lean @@ -0,0 +1,429 @@ +import Ix.Compiler.IxIR0.ProjectionSafe + +/-! +# Projection-free completeness for call-aware traces + +`ProjectionSafe.Eval` intentionally rejects the erased evaluator's absorbing +`proj erased` case. This module supplies the complementary structural route: +when every reachable expression is syntactically projection-free, every +successful ordinary evaluation admits a call-aware trace. Closure bodies and +recursor rules are covered through an explicit value/context invariant, so the +result includes dynamically entered calls rather than only the surface term. +-/ + +namespace Ix.Compiler.IxIR0.ProjectionFree + +/-- Executable syntax check used by the structural completeness theorem. -/ +def syntaxSafe : IxIR0.Expr → Bool + | .var _ | .ref _ | .lit _ | .erased => true + | .app function argument => syntaxSafe function && syntaxSafe argument + | .lam _ body => syntaxSafe body + | .letE _ value body => syntaxSafe value && syntaxSafe body + | .proj _ _ => false + +/-- A source expression contains no projection node. -/ +abbrev ExprSafe (expr : IxIR0.Expr) : Prop := syntaxSafe expr = true + +/-- Every executable body stored by a declaration is projection-free. -/ +def declSafe : IxIR0.Decl → Bool + | .defn _ body => syntaxSafe body + | .ctor _ _ | .extern _ => true + | .recursor _ _ rules => rules.all fun rule => syntaxSafe rule.rhs + +/-- Runtime values retain the projection-free invariant on captured closure +environments and bodies. Constructor and PAP arguments are checked +recursively. -/ +inductive ValueSafe : IxIR0.Value → Prop where + | clos {uses env body} : + (∀ value ∈ env, ValueSafe value) → + ExprSafe body → + ValueSafe (.clos uses env body) + | pap {head args} : + (∀ value ∈ args, ValueSafe value) → + ValueSafe (.pap head args) + | ctor {address tag args} : + (∀ value ∈ args, ValueSafe value) → + ValueSafe (.ctor address tag args) + | lit {literal} : ValueSafe (.lit literal) + | erased : ValueSafe .erased + +/-- Pointwise projection-freedom for a runtime environment or argument list. -/ +def ValuesSafe (values : List IxIR0.Value) : Prop := + ∀ value ∈ values, ValueSafe value + +namespace ValuesSafe + +theorem nil : ValuesSafe [] := by simp [ValuesSafe] + +theorem cons {value : IxIR0.Value} {values : List IxIR0.Value} + (hvalue : ValueSafe value) (hvalues : ValuesSafe values) : + ValuesSafe (value :: values) := by + intro candidate hmem + simp only [List.mem_cons] at hmem + rcases hmem with rfl | hmem + · exact hvalue + · exact hvalues candidate hmem + +theorem append {left right : List IxIR0.Value} + (hleft : ValuesSafe left) (hright : ValuesSafe right) : + ValuesSafe (left ++ right) := by + intro value hmem + rw [List.mem_append] at hmem + exact hmem.elim (hleft value) (hright value) + +theorem reverse {values : List IxIR0.Value} (hvalues : ValuesSafe values) : + ValuesSafe values.reverse := by + intro value hmem + exact hvalues value (List.mem_reverse.mp hmem) + +theorem drop {values : List IxIR0.Value} (hvalues : ValuesSafe values) + (count : Nat) : ValuesSafe (values.drop count) := by + intro value hmem + exact hvalues value (List.mem_of_mem_drop hmem) + +theorem dropLast {values : List IxIR0.Value} + (hvalues : ValuesSafe values) : ValuesSafe values.dropLast := by + intro value hmem + exact hvalues value (List.dropLast_subset values hmem) + +theorem getLast? {values : List IxIR0.Value} {value : IxIR0.Value} + (hvalues : ValuesSafe values) (hlast : values.getLast? = some value) : + ValueSafe value := by + obtain ⟨initial, heq⟩ := List.getLast?_eq_some_iff.mp hlast + apply hvalues value + rw [heq] + simp + +end ValuesSafe + +namespace ValueSafe + +/-- Constructor fields exposed by `majorCtor` inherit the runtime value +invariant. Nat-literal peeling creates only another safe literal. -/ +theorem majorCtor {natLit : Bool} {major : IxIR0.Value} {tag : Nat} + {fields : List IxIR0.Value} (hvalue : ValueSafe major) + (hrun : IxIR0.majorCtor natLit major = .ok (tag, fields)) : + ValuesSafe fields := by + cases hvalue with + | clos _ _ => simp [IxIR0.majorCtor] at hrun + | pap _ => simp [IxIR0.majorCtor] at hrun + | ctor hargs => + simp only [IxIR0.majorCtor] at hrun + cases Except.ok.inj hrun + exact hargs + | lit => + rename_i literal + cases literal with + | str string => simp [IxIR0.majorCtor] at hrun + | nat number => + cases number with + | zero => + cases natLit with + | false => simp [IxIR0.majorCtor] at hrun + | true => + simp [IxIR0.majorCtor] at hrun + rcases hrun with ⟨rfl, rfl⟩ + exact ValuesSafe.nil + | succ number => + cases natLit with + | false => simp [IxIR0.majorCtor] at hrun + | true => + simp [IxIR0.majorCtor] at hrun + rcases hrun with ⟨rfl, rfl⟩ + exact ValuesSafe.cons .lit ValuesSafe.nil + | erased => simp [IxIR0.majorCtor] at hrun + +end ValueSafe + +/-- Projection-free declarations and safe oracle results form the closed-world +invariant needed to follow references, recursor rules, and extern calls. -/ +structure CtxSafe (ctx : IxIR0.Ctx) : Prop where + env : ∀ address declaration, + ctx.env address = some declaration → declSafe declaration = true + oracle : ∀ address args result, + ValuesSafe args → + ctx.oracle address args = some result → + ValueSafe result + +private def CompleteAt (ctx : IxIR0.Ctx) (fuel : Nat) : Prop := + (∀ env expr result, + ValuesSafe env → ExprSafe expr → + IxIR0.eval ctx fuel env expr = .ok result → + IxIR0.ProjectionSafe.Eval ctx fuel env expr result ∧ ValueSafe result) ∧ + (∀ function argument result, + ValueSafe function → ValueSafe argument → + IxIR0.apply ctx fuel function argument = .ok result → + IxIR0.ProjectionSafe.Apply ctx fuel function argument result ∧ + ValueSafe result) ∧ + (∀ head args result, + ValuesSafe args → + IxIR0.saturate ctx fuel head args = .ok result → + IxIR0.ProjectionSafe.Saturate ctx fuel head args result ∧ + ValueSafe result) ∧ + (∀ head args result, + ValuesSafe args → + IxIR0.fire ctx fuel head args = .ok result → + IxIR0.ProjectionSafe.Fire ctx fuel head args result ∧ ValueSafe result) + +private theorem bindOk {error alpha beta : Type} (value : alpha) + (next : alpha → Except error beta) : + (Except.ok value >>= next) = next value := rfl + +private theorem completeAt {ctx : IxIR0.Ctx} (hctx : CtxSafe ctx) : + ∀ fuel, CompleteAt ctx fuel := by + intro fuel + induction fuel with + | zero => + refine ⟨?_, ?_, ?_, ?_⟩ + · intro env expr result henv hexpr hrun + simp [IxIR0.eval.eq_def] at hrun + · intro function argument result hfunction hargument hrun + simp [IxIR0.apply.eq_def] at hrun + · intro head args result hargs hrun + simp [IxIR0.saturate.eq_def] at hrun + · intro head args result hargs hrun + simp [IxIR0.fire.eq_def] at hrun + | succ fuel ih => + obtain ⟨ihEval, ihApply, ihSaturate, ihFire⟩ := ih + refine ⟨?_, ?_, ?_, ?_⟩ + · intro env expr result henv hexpr hrun + cases expr with + | var index => + rw [IxIR0.eval.eq_def] at hrun + dsimp only at hrun + cases hlookup : env[index]? with + | none => rw [hlookup] at hrun; contradiction + | some value => + rw [hlookup] at hrun + injection hrun with hresult + subst result + obtain ⟨hindex, hget⟩ := + List.getElem?_eq_some_iff.mp hlookup + exact ⟨.var hlookup, + henv value (List.mem_iff_getElem.mpr + ⟨index, hindex, hget⟩)⟩ + | lit literal => + rw [IxIR0.eval.eq_def] at hrun + injection hrun with hresult + subst result + exact ⟨.lit, .lit⟩ + | erased => + rw [IxIR0.eval.eq_def] at hrun + injection hrun with hresult + subst result + exact ⟨.erased, .erased⟩ + | lam uses body => + rw [IxIR0.eval.eq_def] at hrun + injection hrun with hresult + subst result + exact ⟨.lam, .clos henv hexpr⟩ + | letE uses value body => + have hparts := Bool.and_eq_true_iff.mp hexpr + rw [IxIR0.eval.eq_def] at hrun + dsimp only at hrun + cases hvalueRun : IxIR0.eval ctx fuel env value with + | error error => rw [hvalueRun] at hrun; contradiction + | ok bound => + rw [hvalueRun] at hrun + obtain ⟨hvalueTrace, hbound⟩ := + ihEval env value bound henv hparts.1 hvalueRun + obtain ⟨hbodyTrace, hresult⟩ := + ihEval (bound :: env) body result + (ValuesSafe.cons hbound henv) hparts.2 hrun + exact ⟨.letE hvalueTrace hbodyTrace, hresult⟩ + | app function argument => + have hparts := Bool.and_eq_true_iff.mp hexpr + rw [IxIR0.eval.eq_def] at hrun + dsimp only at hrun + cases hfunctionRun : IxIR0.eval ctx fuel env function with + | error error => rw [hfunctionRun] at hrun; contradiction + | ok functionValue => + rw [hfunctionRun] at hrun + cases hargumentRun : IxIR0.eval ctx fuel env argument with + | error error => rw [hargumentRun] at hrun; contradiction + | ok argumentValue => + rw [hargumentRun] at hrun + obtain ⟨hfunctionTrace, hfunction⟩ := + ihEval env function functionValue henv hparts.1 + hfunctionRun + obtain ⟨hargumentTrace, hargument⟩ := + ihEval env argument argumentValue henv hparts.2 + hargumentRun + obtain ⟨happlyTrace, hresult⟩ := + ihApply functionValue argumentValue result hfunction + hargument hrun + exact ⟨.app hfunctionTrace hargumentTrace happlyTrace, + hresult⟩ + | proj index source => cases hexpr + | ref address => + rw [IxIR0.eval.eq_def] at hrun + dsimp only at hrun + cases hlookup : ctx.env address with + | none => rw [hlookup] at hrun; contradiction + | some declaration => + rw [hlookup] at hrun + have hdeclaration := hctx.env address declaration hlookup + cases declaration with + | defn world body => + obtain ⟨hbodyTrace, hresult⟩ := + ihEval [] body result ValuesSafe.nil hdeclaration hrun + exact ⟨.refDefn hlookup hbodyTrace, hresult⟩ + | ctor tag arity => + obtain ⟨hsaturateTrace, hresult⟩ := + ihSaturate (.ctor address tag arity) [] result + ValuesSafe.nil hrun + exact ⟨.refCtor hlookup hsaturateTrace, hresult⟩ + | recursor numArgs natLit rules => + injection hrun with hresult + subst result + exact ⟨.refRecursor hlookup, .pap ValuesSafe.nil⟩ + | extern arity => + obtain ⟨hsaturateTrace, hresult⟩ := + ihSaturate (.ext address arity) [] result + ValuesSafe.nil hrun + exact ⟨.refExtern hlookup hsaturateTrace, hresult⟩ + · intro function argument result hfunction hargument hrun + cases hfunction with + | clos henv hbody => + rw [IxIR0.apply.eq_def] at hrun + obtain ⟨hbodyTrace, hresult⟩ := + ihEval _ _ _ (ValuesSafe.cons hargument henv) hbody hrun + exact ⟨.clos hbodyTrace, hresult⟩ + | pap hargs => + rw [IxIR0.apply.eq_def] at hrun + obtain ⟨hsaturateTrace, hresult⟩ := + ihSaturate _ _ _ + (ValuesSafe.append hargs + (ValuesSafe.cons hargument ValuesSafe.nil)) hrun + exact ⟨.pap hsaturateTrace, hresult⟩ + | ctor hargs => + rw [IxIR0.apply.eq_def] at hrun + contradiction + | lit => + rw [IxIR0.apply.eq_def] at hrun + contradiction + | erased => + rw [IxIR0.apply.eq_def] at hrun + injection hrun with hresult + subst result + exact ⟨.erased, .erased⟩ + · intro head args result hargs hrun + rw [IxIR0.saturate.eq_def] at hrun + dsimp only at hrun + by_cases hlength : args.length = head.arity + · simp only [beq_iff_eq.mpr hlength, if_true] at hrun + obtain ⟨hfireTrace, hresult⟩ := ihFire head args result hargs hrun + exact ⟨.full hlength hfireTrace, hresult⟩ + · have hbeq : (args.length == head.arity) = false := by + exact Bool.eq_false_iff.mpr fun htrue => + hlength (beq_iff_eq.mp htrue) + simp only [hbeq, Bool.false_eq_true, if_false] at hrun + injection hrun with hresult + subst result + exact ⟨.pending hlength, .pap hargs⟩ + · intro head args result hargs hrun + cases head with + | ctor address tag arity => + rw [IxIR0.fire.eq_def] at hrun + injection hrun with hresult + subst result + exact ⟨.ctor, .ctor hargs⟩ + | ext address arity => + rw [IxIR0.fire.eq_def] at hrun + dsimp only at hrun + cases horacle : ctx.oracle address args with + | none => rw [horacle] at hrun; contradiction + | some value => + rw [horacle] at hrun + injection hrun with hresult + subst result + exact ⟨.extern horacle, + hctx.oracle address args value hargs horacle⟩ + | rec_ address arity => + rw [IxIR0.fire.eq_def] at hrun + dsimp only at hrun + cases hlookup : ctx.env address with + | none => rw [hlookup] at hrun; contradiction + | some declaration => + rw [hlookup] at hrun + have hdeclaration := hctx.env address declaration hlookup + cases declaration with + | defn world body => contradiction + | ctor tag ctorArity => contradiction + | extern externArity => contradiction + | recursor numArgs natLit rules => + dsimp only at hrun + cases hlast : args.getLast? with + | none => rw [hlast] at hrun; contradiction + | some major => + rw [hlast] at hrun + dsimp only at hrun + cases hmajor : IxIR0.majorCtor natLit major with + | error error => + rw [hmajor] at hrun + contradiction + | ok pair => + rcases pair with ⟨tag, fields⟩ + rw [hmajor, bindOk] at hrun + dsimp only at hrun + cases hrule : rules[tag]? with + | none => rw [hrule] at hrun; contradiction + | some rule => + rw [hrule] at hrun + dsimp only at hrun + by_cases hfields : fields.length = rule.fields + · have hfieldBeq : + (fields.length != rule.fields) = false := by + simp [hfields] + rw [hfieldBeq] at hrun + obtain ⟨hruleIndex, hruleGet⟩ := + Array.getElem?_eq_some_iff.mp hrule + have hruleSafe := + (Array.all_eq_true.mp hdeclaration) + tag hruleIndex + rw [hruleGet] at hruleSafe + have hmajorSafe := + ValuesSafe.getLast? hargs hlast + have hfieldsSafe := + hmajorSafe.majorCtor hmajor + have hbodyEnv : ValuesSafe + (fields.reverse ++ + args.dropLast.reverse ++ + [.pap (.rec_ address arity) []]) := + by + simpa only [List.append_assoc] using + ValuesSafe.append hfieldsSafe.reverse + (ValuesSafe.append + hargs.dropLast.reverse + (ValuesSafe.cons + (.pap ValuesSafe.nil) + ValuesSafe.nil)) + obtain ⟨hbodyTrace, hresult⟩ := + ihEval _ rule.rhs result hbodyEnv + hruleSafe hrun + exact ⟨.recursor hlookup hlast hmajor hrule + hfields hbodyTrace, hresult⟩ + · have hfieldBne : + (fields.length != rule.fields) = true := by + simp [hfields] + rw [hfieldBne] at hrun + contradiction + +/-- Every successful evaluation of a projection-free closed-world state has +an exact call-aware trace at the same fuel. -/ +theorem Eval.of_run {ctx : IxIR0.Ctx} (hctx : CtxSafe ctx) + {fuel : Nat} {env : List IxIR0.Value} {expr : IxIR0.Expr} + {result : IxIR0.Value} (henv : ValuesSafe env) (hexpr : ExprSafe expr) + (hrun : IxIR0.eval ctx fuel env expr = .ok result) : + IxIR0.ProjectionSafe.Eval ctx fuel env expr result := + (completeAt hctx fuel).1 env expr result henv hexpr hrun |>.1 + +/-- The completeness construction also records that its result preserves the +runtime projection-free invariant. -/ +theorem Eval.resultSafe {ctx : IxIR0.Ctx} (hctx : CtxSafe ctx) + {fuel : Nat} {env : List IxIR0.Value} {expr : IxIR0.Expr} + {result : IxIR0.Value} (henv : ValuesSafe env) (hexpr : ExprSafe expr) + (hrun : IxIR0.eval ctx fuel env expr = .ok result) : ValueSafe result := + (completeAt hctx fuel).1 env expr result henv hexpr hrun |>.2 + +end Ix.Compiler.IxIR0.ProjectionFree diff --git a/Ix/Compiler/IxIR0/ProjectionSafe.lean b/Ix/Compiler/IxIR0/ProjectionSafe.lean new file mode 100644 index 000000000..0febdaa0d --- /dev/null +++ b/Ix/Compiler/IxIR0/ProjectionSafe.lean @@ -0,0 +1,642 @@ +import Ix.Compiler.IxIR0.Eval + +/-! +# Call-aware projection-safe IxIR₀ execution + +`IxIR0.eval` deliberately maps projection from `erased` to `erased`. That is +the right erasure semantics, but IxIR₁ lowers a runtime projection to a +concrete fetch, where the same shape is ordinary stuckness. Successful target +progress therefore needs more than an `IxIR0.eval = .ok` equation. + +The four mutually inductive traces below mirror the four mutually recursive +IxIR₀ evaluator functions at their exact fuel. They retain every executed +expression body, including closure bodies and recursor rules reached through +`apply`/`saturate`/`fire`, and intentionally have no constructor for projection +from `erased`. This makes source evaluator fuel available as the well-founded +measure for total-correctness proofs whose target fuel is existential. +-/ + +namespace Ix.Compiler.IxIR0.ProjectionSafe + +open Ix.Compiler.Ixon (Address Uses) + +mutual + + /-- A successful `eval` trace in which every dynamically reached projection + scrutinizes a constructor. -/ + inductive Eval (ctx : Ctx) : + Nat → List Value → Expr → Value → Prop where + | var {fuel : Nat} {env : List Value} {index : Nat} {value : Value} : + env[index]? = some value → + Eval ctx (fuel + 1) env (.var index) value + | lit {fuel : Nat} {env : List Value} {literal : Literal} : + Eval ctx (fuel + 1) env (.lit literal) (.lit literal) + | erased {fuel : Nat} {env : List Value} : + Eval ctx (fuel + 1) env .erased .erased + | lam {fuel : Nat} {env : List Value} {uses : Uses} {body : Expr} : + Eval ctx (fuel + 1) env (.lam uses body) (.clos uses env body) + | letE {fuel : Nat} {env : List Value} {uses : Uses} + {value body : Expr} {bound result : Value} : + Eval ctx fuel env value bound → + Eval ctx fuel (bound :: env) body result → + Eval ctx (fuel + 1) env (.letE uses value body) result + | app {fuel : Nat} {env : List Value} {function argument : Expr} + {functionValue argumentValue result : Value} : + Eval ctx fuel env function functionValue → + Eval ctx fuel env argument argumentValue → + Apply ctx fuel functionValue argumentValue result → + Eval ctx (fuel + 1) env (.app function argument) result + | proj {fuel : Nat} {env : List Value} {index : Nat} {source : Expr} + {address : Address} {tag : Nat} {fields : List Value} + {result : Value} : + Eval ctx fuel env source (.ctor address tag fields) → + fields[index]? = some result → + Eval ctx (fuel + 1) env (.proj index source) result + | refDefn {fuel : Nat} {env : List Value} {address : Address} + {world : Ix.Compiler.Ixon.Owned} {body : Expr} {result : Value} : + ctx.env address = some (.defn world body) → + Eval ctx fuel [] body result → + Eval ctx (fuel + 1) env (.ref address) result + | refCtor {fuel : Nat} {env : List Value} {address : Address} + {tag arity : Nat} {result : Value} : + ctx.env address = some (.ctor tag arity) → + Saturate ctx fuel (.ctor address tag arity) [] result → + Eval ctx (fuel + 1) env (.ref address) result + | refRecursor {fuel : Nat} {env : List Value} {address : Address} + {numArgs : Nat} {natLit : Bool} {rules : Array RecRule} : + ctx.env address = some (.recursor numArgs natLit rules) → + Eval ctx (fuel + 1) env (.ref address) + (.pap (.rec_ address (numArgs + 1)) []) + | refExtern {fuel : Nat} {env : List Value} {address : Address} + {arity : Nat} {result : Value} : + ctx.env address = some (.extern arity) → + Saturate ctx fuel (.ext address arity) [] result → + Eval ctx (fuel + 1) env (.ref address) result + + /-- A successful call-aware `apply` trace. Closure entry is where the + dynamically selected body re-enters `Eval`. -/ + inductive Apply (ctx : Ctx) : Nat → Value → Value → Value → Prop where + | clos {fuel : Nat} {uses : Uses} {env : List Value} {body : Expr} + {argument result : Value} : + Eval ctx fuel (argument :: env) body result → + Apply ctx (fuel + 1) (.clos uses env body) argument result + | pap {fuel : Nat} {head : Head} {captured : List Value} + {argument result : Value} : + Saturate ctx fuel head (captured ++ [argument]) result → + Apply ctx (fuel + 1) (.pap head captured) argument result + | erased {fuel : Nat} {argument : Value} : + Apply ctx (fuel + 1) .erased argument .erased + + /-- A successful `saturate` trace. -/ + inductive Saturate (ctx : Ctx) : + Nat → Head → List Value → Value → Prop where + | pending {fuel : Nat} {head : Head} {args : List Value} : + args.length ≠ head.arity → + Saturate ctx (fuel + 1) head args (.pap head args) + | full {fuel : Nat} {head : Head} {args : List Value} + {result : Value} : + args.length = head.arity → + Fire ctx fuel head args result → + Saturate ctx (fuel + 1) head args result + + /-- A successful `fire` trace. The recursor constructor retains the exact + selected rule-body execution and hence any projections reached inside it. -/ + inductive Fire (ctx : Ctx) : + Nat → Head → List Value → Value → Prop where + | ctor {fuel : Nat} {address : Address} {tag arity : Nat} + {args : List Value} : + Fire ctx (fuel + 1) (.ctor address tag arity) args + (.ctor address tag args) + | extern {fuel : Nat} {address : Address} {arity : Nat} + {args : List Value} {result : Value} : + ctx.oracle address args = some result → + Fire ctx (fuel + 1) (.ext address arity) args result + | recursor {fuel : Nat} {address : Address} {arity numArgs : Nat} + {natLit : Bool} {rules : Array RecRule} {args : List Value} + {major : Value} {tag : Nat} {fields : List Value} + {rule : RecRule} {result : Value} : + ctx.env address = some (.recursor numArgs natLit rules) → + args.getLast? = some major → + majorCtor natLit major = .ok (tag, fields) → + rules[tag]? = some rule → + fields.length = rule.fields → + Eval ctx fuel + (fields.reverse ++ args.dropLast.reverse ++ + [.pap (.rec_ address arity) []]) + rule.rhs result → + Fire ctx (fuel + 1) (.rec_ address arity) args result + +end + +private theorem bindOk {error alpha beta : Type} (value : alpha) + (next : alpha → Except error beta) : + (Except.ok value >>= next) = next value := rfl + +mutual + + /-- A safe evaluation trace executes successfully at its recorded fuel. -/ + theorem Eval.run {ctx : Ctx} {fuel : Nat} {env : List Value} + {expr : Expr} {value : Value} + (htrace : Eval ctx fuel env expr value) : + eval ctx fuel env expr = .ok value := by + cases htrace with + | var hlookup => + rw [eval.eq_def] + dsimp only + rw [hlookup] + | lit => rw [eval.eq_def] + | erased => rw [eval.eq_def] + | lam => rw [eval.eq_def] + | letE hvalue hbody => + rw [eval.eq_def] + dsimp only + rw [hvalue.run, bindOk] + exact hbody.run + | app hfunction hargument happly => + rw [eval.eq_def] + dsimp only + rw [hfunction.run, bindOk, hargument.run, bindOk] + exact happly.run + | proj hsource hfield => + rw [eval.eq_def] + dsimp only + rw [hsource.run, bindOk] + simp only + rw [hfield] + | refDefn hdecl hbody => + rw [eval.eq_def] + dsimp only + rw [hdecl] + exact hbody.run + | refCtor hdecl hsaturate => + rw [eval.eq_def] + dsimp only + rw [hdecl] + exact hsaturate.run + | refRecursor hdecl => + rw [eval.eq_def] + dsimp only + rw [hdecl] + | refExtern hdecl hsaturate => + rw [eval.eq_def] + dsimp only + rw [hdecl] + exact hsaturate.run + + /-- A safe application trace executes successfully at its recorded fuel. -/ + theorem Apply.run {ctx : Ctx} {fuel : Nat} {function argument result : Value} + (htrace : Apply ctx fuel function argument result) : + apply ctx fuel function argument = .ok result := by + cases htrace with + | clos hbody => + rw [apply.eq_def] + exact hbody.run + | pap hsaturate => + rw [apply.eq_def] + exact hsaturate.run + | erased => rw [apply.eq_def] + + /-- A safe saturation trace executes successfully at its recorded fuel. -/ + theorem Saturate.run {ctx : Ctx} {fuel : Nat} {head : Head} + {args : List Value} {result : Value} + (htrace : Saturate ctx fuel head args result) : + saturate ctx fuel head args = .ok result := by + cases htrace with + | pending hlength => + rw [saturate.eq_def] + dsimp only + simp [hlength] + | full hlength hfire => + rw [saturate.eq_def] + dsimp only + simp only [beq_iff_eq.mpr hlength, if_true] + exact hfire.run + + /-- A safe firing trace executes successfully at its recorded fuel. -/ + theorem Fire.run {ctx : Ctx} {fuel : Nat} {head : Head} + {args : List Value} {result : Value} + (htrace : Fire ctx fuel head args result) : + fire ctx fuel head args = .ok result := by + cases htrace with + | ctor => rw [fire.eq_def] + | extern horacle => + rw [fire.eq_def] + dsimp only + rw [horacle] + | recursor hdecl hlast hmajor hrule hfields hbody => + rw [fire.eq_def] + dsimp only + rw [hdecl] + dsimp only + rw [hlast] + dsimp only + rw [hmajor, bindOk] + dsimp only + rw [hrule] + dsimp only + simp only [hfields, bne_self_eq_false] + exact hbody.run + +end + +/-- A reference trace is independent of the ambient local environment: every +reference constructor evaluates its declaration from the closed environment. -/ +theorem Eval.ref_closed {ctx : Ctx} {fuel : Nat} {env : List Value} + {address : Address} {value : Value} + (htrace : Eval ctx fuel env (.ref address) value) : + Eval ctx fuel [] (.ref address) value := by + cases htrace with + | refDefn hdecl hbody => exact .refDefn hdecl hbody + | refCtor hdecl hsaturate => exact .refCtor hdecl hsaturate + | refRecursor hdecl => exact .refRecursor hdecl + | refExtern hdecl hsaturate => exact .refExtern hdecl hsaturate + +mutual + + /-- Projection-safe evaluation is monotone in fuel. -/ + theorem Eval.mono {ctx : Ctx} {fuel : Nat} {env : List Value} + {expr : Expr} {value : Value} + (htrace : Eval ctx fuel env expr value) : + Eval ctx (fuel + 1) env expr value := by + cases htrace with + | var hlookup => exact .var hlookup + | lit => exact .lit + | erased => exact .erased + | lam => exact .lam + | letE hvalue hbody => exact .letE hvalue.mono hbody.mono + | app hfunction hargument happly => + exact .app hfunction.mono hargument.mono happly.mono + | proj hsource hfield => exact .proj hsource.mono hfield + | refDefn hdecl hbody => exact .refDefn hdecl hbody.mono + | refCtor hdecl hsaturate => exact .refCtor hdecl hsaturate.mono + | refRecursor hdecl => exact .refRecursor hdecl + | refExtern hdecl hsaturate => exact .refExtern hdecl hsaturate.mono + + /-- Projection-safe application is monotone in fuel. -/ + theorem Apply.mono {ctx : Ctx} {fuel : Nat} + {function argument result : Value} + (htrace : Apply ctx fuel function argument result) : + Apply ctx (fuel + 1) function argument result := by + cases htrace with + | clos hbody => exact .clos hbody.mono + | pap hsaturate => exact .pap hsaturate.mono + | erased => exact .erased + + /-- Projection-safe saturation is monotone in fuel. -/ + theorem Saturate.mono {ctx : Ctx} {fuel : Nat} {head : Head} + {args : List Value} {result : Value} + (htrace : Saturate ctx fuel head args result) : + Saturate ctx (fuel + 1) head args result := by + cases htrace with + | pending hlength => exact .pending hlength + | full hlength hfire => exact .full hlength hfire.mono + + /-- Projection-safe firing is monotone in fuel. -/ + theorem Fire.mono {ctx : Ctx} {fuel : Nat} {head : Head} + {args : List Value} {result : Value} + (htrace : Fire ctx fuel head args result) : + Fire ctx (fuel + 1) head args result := by + cases htrace with + | ctor => exact .ctor + | extern horacle => exact .extern horacle + | recursor hdecl hlast hmajor hrule hfields hbody => + exact .recursor hdecl hlast hmajor hrule hfields hbody.mono + +end + +theorem Eval.mono_le {ctx : Ctx} {smaller larger : Nat} + {env : List Value} {expr : Expr} {value : Value} + (hbound : smaller ≤ larger) (htrace : Eval ctx smaller env expr value) : + Eval ctx larger env expr value := by + induction hbound with + | refl => exact htrace + | step hbound ih => exact ih.mono + +theorem Apply.mono_le {ctx : Ctx} {smaller larger : Nat} + {function argument result : Value} + (hbound : smaller ≤ larger) + (htrace : Apply ctx smaller function argument result) : + Apply ctx larger function argument result := by + induction hbound with + | refl => exact htrace + | step hbound ih => exact ih.mono + +theorem Saturate.mono_le {ctx : Ctx} {smaller larger : Nat} + {head : Head} {args : List Value} {result : Value} + (hbound : smaller ≤ larger) + (htrace : Saturate ctx smaller head args result) : + Saturate ctx larger head args result := by + induction hbound with + | refl => exact htrace + | step hbound ih => exact ih.mono + +theorem Fire.mono_le {ctx : Ctx} {smaller larger : Nat} + {head : Head} {args : List Value} {result : Value} + (hbound : smaller ≤ larger) + (htrace : Fire ctx smaller head args result) : + Fire ctx larger head args result := by + induction hbound with + | refl => exact htrace + | step hbound ih => exact ih.mono + +/-- A call-aware n-ary application spine whose every individual application +executes strictly below one enclosing source-evaluator fuel. The common +bound is the well-founded index used by lowering progress: entering a closure +or recursor rule exposes an `Eval` trace at a strictly smaller fuel. -/ +inductive AppliesBelow (ctx : Ctx) (limit : Nat) : + Value → List Value → Value → Prop where + | nil {value : Value} : AppliesBelow ctx limit value [] value + | cons {fuel : Nat} {function argument middle result : Value} + {arguments : List Value} : + fuel < limit → + Apply ctx fuel function argument middle → + AppliesBelow ctx limit middle arguments result → + AppliesBelow ctx limit function (argument :: arguments) result + +/-- Dependent traversal of a bounded application spine. Clients receive the +exact head fuel bound and application trace, the original tail derivation, +and the recursively produced result while the initial value, remaining +arguments, and final value stay synchronized. -/ +theorem AppliesBelow.traverse {ctx : Ctx} {limit : Nat} + {Result : Value → List Value → Value → Prop} + (hnil : ∀ value, Result value [] value) + (hcons : ∀ {function argument middle result : Value} + {arguments : List Value} {fuel : Nat}, + fuel < limit → + Apply ctx fuel function argument middle → + AppliesBelow ctx limit middle arguments result → + Result middle arguments result → + Result function (argument :: arguments) result) + {function result : Value} {arguments : List Value} + (hspine : AppliesBelow ctx limit function arguments result) : + Result function arguments result := by + induction hspine with + | nil => exact hnil _ + | cons hfuel hstep htail ih => exact hcons hfuel hstep htail ih + +/-- Increasing the enclosing source-fuel bound preserves a safe spine. -/ +theorem AppliesBelow.mono_limit {ctx : Ctx} {smaller larger : Nat} + {function result : Value} {arguments : List Value} + (hspine : AppliesBelow ctx smaller function arguments result) + (hbound : smaller ≤ larger) : + AppliesBelow ctx larger function arguments result := by + exact AppliesBelow.traverse + (Result := fun currentFunction currentArguments currentResult => + AppliesBelow ctx larger currentFunction currentArguments currentResult) + (hnil := fun _ => .nil) + (hcons := by + intro currentFunction argument currentMiddle currentResult + currentArguments fuel hfuel hstep htail ih + exact .cons (Nat.lt_of_lt_of_le hfuel hbound) hstep ih) + hspine + +/-- Applying one safe prefix and then another applies their concatenation. -/ +theorem AppliesBelow.append {ctx : Ctx} {limit : Nat} + {function middle result : Value} {left right : List Value} + (hleft : AppliesBelow ctx limit function left middle) + (hright : AppliesBelow ctx limit middle right result) : + AppliesBelow ctx limit function (left ++ right) result := by + exact (AppliesBelow.traverse + (Result := fun currentFunction currentArguments currentResult => + ∀ {remaining final}, + AppliesBelow ctx limit currentResult remaining final → + AppliesBelow ctx limit currentFunction + (currentArguments ++ remaining) final) + (hnil := by + intro value remaining final hremaining + simpa using hremaining) + (hcons := by + intro currentFunction argument currentMiddle currentResult + currentArguments fuel hfuel hstep htail ih remaining final hremaining + exact .cons hfuel hstep (ih hremaining)) + hleft) hright + +/-- Add one final safe application to a completed spine. -/ +theorem AppliesBelow.snoc {ctx : Ctx} {limit fuel : Nat} + {function middle result argument : Value} {arguments : List Value} + (hspine : AppliesBelow ctx limit function arguments middle) + (hfuel : fuel < limit) + (hstep : Apply ctx fuel middle argument result) : + AppliesBelow ctx limit function (arguments ++ [argument]) result := + hspine.append (.cons hfuel hstep .nil) + +/-- Split at the same numeric boundary used by `take`/`drop` call lowering. -/ +theorem AppliesBelow.splitAt {ctx : Ctx} {limit : Nat} + {function result : Value} {arguments : List Value} + (hspine : AppliesBelow ctx limit function arguments result) + (count : Nat) : + ∃ middle, + AppliesBelow ctx limit function (arguments.take count) middle ∧ + AppliesBelow ctx limit middle (arguments.drop count) result := by + exact (AppliesBelow.traverse + (Result := fun currentFunction currentArguments currentResult => + ∀ currentCount, + ∃ middle, + AppliesBelow ctx limit currentFunction + (currentArguments.take currentCount) middle ∧ + AppliesBelow ctx limit middle + (currentArguments.drop currentCount) currentResult) + (hnil := by + intro value currentCount + simp + exact ⟨value, .nil, .nil⟩) + (hcons := by + intro currentFunction argument currentMiddle currentResult + currentArguments fuel hfuel hstep htail ih currentCount + cases currentCount with + | zero => exact ⟨currentFunction, .nil, .cons hfuel hstep htail⟩ + | succ currentCount => + obtain ⟨middle, hprefix, hsuffix⟩ := ih currentCount + exact ⟨middle, .cons hfuel hstep hprefix, hsuffix⟩) + hspine) count + +/-- Split a bounded safe application spine at an arbitrary list boundary. -/ +theorem AppliesBelow.split {ctx : Ctx} {limit : Nat} + {function result : Value} : + ∀ {left right : List Value}, + AppliesBelow ctx limit function (left ++ right) result → + ∃ middle, + AppliesBelow ctx limit function left middle ∧ + AppliesBelow ctx limit middle right result := by + intro left right hspine + simpa using AppliesBelow.splitAt hspine left.length + +/-- A single safe application below the enclosing fuel is a singleton +application spine. -/ +theorem Apply.toAppliesBelow {ctx : Ctx} {limit fuel : Nat} + {function argument result : Value} + (htrace : Apply ctx fuel function argument result) + (hbound : fuel < limit) : + AppliesBelow ctx limit function [argument] result := + .cons hbound htrace .nil + +/-- Pointwise argument evaluations below one enclosing expression fuel. -/ +inductive EvalsBelow (ctx : Ctx) (limit : Nat) (env : List Value) : + List Expr → List Value → Prop where + | nil : EvalsBelow ctx limit env [] [] + | cons {fuel : Nat} {expr : Expr} {value : Value} + {expressions : List Expr} {values : List Value} : + fuel < limit → + Eval ctx fuel env expr value → + EvalsBelow ctx limit env expressions values → + EvalsBelow ctx limit env (expr :: expressions) (value :: values) + +/-- Dependent lockstep traversal of bounded projection-safe argument traces. +Each callback receives the exact fuel bound, head trace, and original tail +derivation together with the recursively produced result. -/ +theorem EvalsBelow.traverse {ctx : Ctx} {limit : Nat} {env : List Value} + {Result : List Expr → List Value → Prop} + (hnil : Result [] []) + (hcons : ∀ {fuel : Nat} {expr : Expr} {value : Value} + {expressions : List Expr} {values : List Value}, + fuel < limit → + Eval ctx fuel env expr value → + EvalsBelow ctx limit env expressions values → + Result expressions values → + Result (expr :: expressions) (value :: values)) + {expressions : List Expr} {values : List Value} + (hargs : EvalsBelow ctx limit env expressions values) : + Result expressions values := by + induction hargs with + | nil => exact hnil + | cons hfuel heval htail ih => exact hcons hfuel heval htail ih + +theorem EvalsBelow.mono_limit {ctx : Ctx} {smaller larger : Nat} + {env : List Value} {expressions : List Expr} {values : List Value} + (hargs : EvalsBelow ctx smaller env expressions values) + (hbound : smaller ≤ larger) : + EvalsBelow ctx larger env expressions values := by + exact EvalsBelow.traverse + (Result := fun currentExpressions currentValues => + EvalsBelow ctx larger env currentExpressions currentValues) + (hnil := .nil) + (hcons := by + intro fuel expr value currentExpressions currentValues hfuel heval + htail ih + exact .cons (Nat.lt_of_lt_of_le hfuel hbound) heval ih) + hargs + +@[simp] theorem EvalsBelow.lengths {ctx : Ctx} {limit : Nat} + {env : List Value} {expressions : List Expr} {values : List Value} + (hargs : EvalsBelow ctx limit env expressions values) : + expressions.length = values.length := by + exact EvalsBelow.traverse + (Result := fun currentExpressions currentValues => + currentExpressions.length = currentValues.length) + (hnil := rfl) + (hcons := by + intro fuel expr value currentExpressions currentValues hfuel heval + htail ih + simp [ih]) + hargs + +/-- Exact-fuel argument safety is inherited by every prefix. -/ +theorem EvalsBelow.take {ctx : Ctx} {limit : Nat} + {env : List Value} {expressions : List Expr} {values : List Value} + (hargs : EvalsBelow ctx limit env expressions values) (count : Nat) : + EvalsBelow ctx limit env (expressions.take count) (values.take count) := by + exact (EvalsBelow.traverse + (Result := fun currentExpressions currentValues => + ∀ currentCount, + EvalsBelow ctx limit env (currentExpressions.take currentCount) + (currentValues.take currentCount)) + (hnil := by + intro currentCount + simp + exact .nil) + (hcons := by + intro fuel expr value currentExpressions currentValues hfuel heval + htail ih currentCount + cases currentCount with + | zero => exact .nil + | succ currentCount => + simpa using EvalsBelow.cons hfuel heval (ih currentCount)) + hargs) count + +/-- Exact-fuel argument safety is inherited by every suffix. -/ +theorem EvalsBelow.drop {ctx : Ctx} {limit : Nat} + {env : List Value} {expressions : List Expr} {values : List Value} + (hargs : EvalsBelow ctx limit env expressions values) (count : Nat) : + EvalsBelow ctx limit env (expressions.drop count) (values.drop count) := by + exact (EvalsBelow.traverse + (Result := fun currentExpressions currentValues => + ∀ currentCount, + EvalsBelow ctx limit env (currentExpressions.drop currentCount) + (currentValues.drop currentCount)) + (hnil := by + intro currentCount + simp + exact .nil) + (hcons := by + intro fuel expr value currentExpressions currentValues hfuel heval + htail ih currentCount + cases currentCount with + | zero => exact .cons hfuel heval htail + | succ currentCount => simpa using ih currentCount) + hargs) count + +/-- A flattened expression spine at one enclosing source-evaluator fuel. +Every application and argument trace is strictly below `limit`; the head may +itself use exactly `limit` when the spine is empty. -/ +inductive Spine (ctx : Ctx) (limit : Nat) (env : List Value) : + Expr → List Expr → Value → Prop where + | intro {headFuel : Nat} {headValue : Value} + {head : Expr} {arguments : List Expr} {result : Value} + {argumentValues : List Value} : + headFuel ≤ limit → + Eval ctx headFuel env head headValue → + EvalsBelow ctx limit env arguments argumentValues → + AppliesBelow ctx limit headValue argumentValues result → + Spine ctx limit env head arguments result + +/-- Invert a safe application expression without forgetting any predecessor +trace or its exact one-step fuel equation. -/ +theorem Eval.app_inv {ctx : Ctx} {fuel : Nat} {env : List Value} + {function argument : Expr} {result : Value} + (htrace : Eval ctx fuel env (.app function argument) result) : + ∃ previous functionValue argumentValue, + fuel = previous + 1 ∧ + Eval ctx previous env function functionValue ∧ + Eval ctx previous env argument argumentValue ∧ + Apply ctx previous functionValue argumentValue result := by + cases htrace with + | app hfunction hargument happly => + exact ⟨_, _, _, rfl, hfunction, hargument, happly⟩ + +/-- Any safe expression is the empty-argument spine at its exact fuel. -/ +theorem Spine.of_eval_nil {ctx : Ctx} {fuel : Nat} {env : List Value} + {expr : Expr} {value : Value} + (htrace : Eval ctx fuel env expr value) : + Spine ctx fuel env expr [] value := + .intro (Nat.le_refl _) htrace .nil .nil + +/-- Flatten one more left-associated application while preserving the common +source-fuel bound and the exact dynamically entered `Apply` trace. -/ +theorem Spine.flattenApp {ctx : Ctx} {limit : Nat} {env : List Value} + {function argument : Expr} {arguments : List Expr} {result : Value} + (hspine : Spine ctx limit env (.app function argument) arguments result) : + Spine ctx limit env function (argument :: arguments) result := by + cases hspine with + | @intro headFuel headValue _ _ _ argumentValues hheadBound hhead + harguments happlies => + obtain ⟨previous, functionValue, argumentValue, hfuel, hfunction, + hargument, happly⟩ := hhead.app_inv + subst headFuel + exact .intro (by omega) hfunction + (.cons (by omega) hargument harguments) + (.cons (by omega) happly happlies) + +/-- Singleton specialization used by the expression-lowering application +branch. -/ +theorem Spine.of_eval_app {ctx : Ctx} {fuel : Nat} {env : List Value} + {function argument : Expr} {result : Value} + (htrace : Eval ctx fuel env (.app function argument) result) : + Spine ctx fuel env function [argument] result := + (Spine.of_eval_nil htrace).flattenApp + +/-- Fuel-free call-aware projection-safe termination. -/ +def Terminates (ctx : Ctx) (env : List Value) (expr : Expr) + (value : Value) : Prop := + ∃ fuel, Eval ctx fuel env expr value + +end Ix.Compiler.IxIR0.ProjectionSafe diff --git a/Ix/Compiler/IxIR0/Readdress.lean b/Ix/Compiler/IxIR0/Readdress.lean new file mode 100644 index 000000000..24d600a7e --- /dev/null +++ b/Ix/Compiler/IxIR0/Readdress.lean @@ -0,0 +1,420 @@ +import Ix.Compiler.IxIR0.MutualBlock + +/-! +# Whole-program IxIR₀ mutual-block readdressing + +`MutualBlock.run` handles one strongly connected declaration block. This +module lifts that operation to an entire erased program: stable declarations +and the main expression are rewritten through the union of every block map, +while cross-block temporary edges and all global namespace captures fail +closed. + +The pass deliberately leaves the existing erasure theorem boundary intact. +That boundary may continue to produce transient `memberAddr` keys; a later +evaluator-renaming theorem can transport its result through the certified map +returned here. +-/ + +namespace Ix.Compiler.IxIR0 + +open Ix.Compiler.Ixon (Address) + +namespace Readdress + +/-- One ordered erasure-output group. Stable groups retain their keys; mutual +groups are addressed as a complete local-edge artifact. -/ +inductive Group where + | stable (entries : List (Address × Decl)) + | mutual (entries : List (Address × Decl)) + deriving Repr + +namespace Group + +def entries : Group → List (Address × Decl) + | .stable entries | .mutual entries => entries + +def mutualEntries? : Group → Option (List (Address × Decl)) + | .stable _ => none + | .mutual entries => some entries + +end Group + +/-- Flatten groups in producer order. -/ +def rawDeclarations (groups : List Group) : List (Address × Decl) := + groups.flatMap Group.entries + +/-- Ordered mutual-block inputs in producer order. -/ +def rawBlocks (groups : List Group) : List (List (Address × Decl)) := + groups.filterMap Group.mutualEntries? + +/-- All stable environment keys. -/ +def stableKeys (groups : List Group) : List Address := + groups.flatMap fun group => + match group with + | .stable entries => entries.map (·.1) + | .mutual _ => [] + +/-- Every transient mutual-member key. -/ +def transientKeys (groups : List Group) : List Address := + groups.flatMap fun group => + match group with + | .stable _ => [] + | .mutual entries => entries.map (·.1) + +namespace Renaming + +/-- First source key whose recorded image is `address`. Readdressing is not +globally invertible; this operation is deliberately restricted to resolving a +called final producer key back to its legacy name. -/ +def reverseLookup (mapping : MutualBlock.Renaming) + (address : Address) : Option Address := + (List.find? (fun entry => entry.2 == address) mapping).map (·.1) + +/-- Reverse a recorded image key, leaving every other key unchanged. -/ +def reverseApply (mapping : MutualBlock.Renaming) (address : Address) : Address := + (reverseLookup mapping address).getD address + +/-- An identity is absent from both the producer and image sides of a map. +This is stronger than merely being a fixed point and is the namespace fact +needed by a key-sensitive oracle adapter. -/ +def isolates (mapping : MutualBlock.Renaming) (address : Address) : Bool := + mapping.all fun entry => entry.1 != address && entry.2 != address + +end Renaming + +/-- Concrete references in the raw program which are not transient member +edges. Stable declarations may refer to transient members and are rewritten; +inside a mutual block, own-member edges are local while another block's +temporary key is rejected separately. -/ +def externalReferences (groups : List Group) (main : Expr) : List Address := + let transient := transientKeys groups + ((rawDeclarations groups).flatMap (fun entry => + MutualBlock.Concrete.Decl.references entry.2) ++ + MutualBlock.Concrete.Expr.references main).filter fun address => + !transient.contains address + +/-- Identities whose external meaning must not be captured by either side of +the member-address map. -/ +def oracleIdentities (reserved : List Address) (groups : List Group) + (main : Expr) : List Address := + reserved ++ stableKeys groups ++ externalReferences groups main + +/-- Result of addressing every mutual block and applying their combined map +to the complete program. -/ +structure Result where + declarations : List (Address × Decl) + main : Expr + blocks : List MutualBlock.Result + addressMap : MutualBlock.Renaming + +namespace Result + +def transientAddresses (result : Result) : List Address := + result.addressMap.map (·.1) + +def derivedAddresses (result : Result) : List Address := + result.addressMap.map (·.2) + +def blockAddresses (result : Result) : List Address := + result.blocks.map (·.blockAddress) + +def noTransientKeys (result : Result) : Bool := + !(result.declarations.map (·.1)).any result.transientAddresses.contains + +def noTransientReferences (result : Result) : Bool := + let declarationReferences := result.declarations.flatMap fun entry => + MutualBlock.Concrete.Decl.references entry.2 + !(declarationReferences ++ + MutualBlock.Concrete.Expr.references result.main).any + result.transientAddresses.contains + +private def blockAudits : + List MutualBlock.Result → List (List (Address × Decl)) → Bool + | [], [] => true + | result :: results, raw :: raws => + result.semanticAudit raw && blockAudits results raws + | _, _ => false + +/-- Every block result retains its own producer audit. -/ +def blocksAudited (result : Result) (groups : List Group) : Bool := + blockAudits result.blocks (rawBlocks groups) + +/-- Every caller-protected identity is fixed by the completed map. -/ +def protects (result : Result) (reserved : List Address) : Bool := + reserved.all fun address => + MutualBlock.Renaming.apply result.addressMap address == address + +/-- Stable, caller-owned, and externally referenced identities occur on +neither side of the member renaming. In particular, reverse oracle dispatch +cannot mistake a final member key for an opaque ABI key. -/ +def oracleIdentityAudit (result : Result) (reserved : List Address) + (groups : List Group) (main : Expr) : Bool := + (oracleIdentities reserved groups main).all fun address => + Renaming.isolates result.addressMap address + +/-- Exact list/main image under the completed address map. -/ +def imageAudit (result : Result) (groups : List Group) + (rawMain : Expr) : Bool := + let rename := MutualBlock.Renaming.apply result.addressMap + result.declarations == + (rawDeclarations groups).map (fun entry => + (rename entry.1, + MutualBlock.Concrete.Decl.mapAddresses rename entry.2)) && + result.main == MutualBlock.Concrete.Expr.mapAddresses rename rawMain + +/-- Every emitted declaration row is the row selected by the transparent +first-binding-wins environment. This makes producer-key collision freedom +available to proof clients without re-running the private collision check. -/ +def declarationRowsSelected (result : Result) : Bool := + result.declarations.all fun entry => + match Env.ofList result.declarations entry.1 with + | some declaration => declaration == entry.2 + | none => false + +/-- Global block, namespace, and fixed-point checks. -/ +def safetyAudit (result : Result) (reserved : List Address) + (groups : List Group) (rawMain : Expr) : Bool := + let rename := MutualBlock.Renaming.apply result.addressMap + result.blocksAudited groups && result.protects reserved && + result.noTransientKeys && result.noTransientReferences && + result.declarations.all (fun entry => + MutualBlock.Concrete.Decl.mapAddresses rename entry.2 == entry.2) && + result.oracleIdentityAudit reserved groups rawMain && + result.declarationRowsSelected + +/-- Exact forward environment lookup check. -/ +def lookupAudit (result : Result) (groups : List Group) : Bool := + let rename := MutualBlock.Renaming.apply result.addressMap + let original := Env.ofList (rawDeclarations groups) + let emitted := Env.ofList result.declarations + (rawDeclarations groups).all (fun entry => + match original entry.1, emitted (rename entry.1) with + | some before, some after => + after == MutualBlock.Concrete.Decl.mapAddresses rename before + | _, _ => false) + +/-- Every successful emitted lookup is stable under the completed map. -/ +def stableLookupAudit (result : Result) : Bool := + let rename := MutualBlock.Renaming.apply result.addressMap + let emitted := Env.ofList result.declarations + result.declarations.all (fun entry => + match emitted entry.1 with + | some declaration => + MutualBlock.Concrete.Decl.mapAddresses rename declaration == + declaration + | none => false) + +/-- Exact structural audit for the whole address image. -/ +def semanticAudit (result : Result) (reserved : List Address) + (groups : List Group) (rawMain : Expr) : Bool := + result.imageAudit groups rawMain && + result.safetyAudit reserved groups rawMain && + result.lookupAudit groups && result.stableLookupAudit + +/-- Extract the bidirectional oracle-identity namespace certificate from the +whole-program audit. -/ +theorem oracleIdentityAudit_of_semanticAudit {result : Result} + {reserved : List Address} {groups : List Group} {main : Expr} + (haudit : result.semanticAudit reserved groups main = true) : + result.oracleIdentityAudit reserved groups main = true := by + simp only [semanticAudit, Bool.and_eq_true] at haudit + have hsafety : result.safetyAudit reserved groups main = true := + haudit.1.1.2 + simp only [safetyAudit, Bool.and_eq_true] at hsafety + exact hsafety.1.2 + +/-- Pointwise producer-key selection exposed by the whole-program audit. -/ +theorem declaration_lookup_of_mem_of_semanticAudit {result : Result} + {reserved : List Address} {groups : List Group} {main : Expr} + (haudit : result.semanticAudit reserved groups main = true) + {address : Address} {declaration : Decl} + (hmember : (address, declaration) ∈ result.declarations) : + Env.ofList result.declarations address = some declaration := by + simp only [semanticAudit, Bool.and_eq_true] at haudit + have hsafety : result.safetyAudit reserved groups main = true := + haudit.1.1.2 + simp only [safetyAudit, Bool.and_eq_true] at hsafety + have hrows : result.declarationRowsSelected = true := hsafety.2 + simp only [declarationRowsSelected] at hrows + have hrow := (List.all_eq_true.mp hrows) + (address, declaration) hmember + cases hlookup : Env.ofList result.declarations address with + | none => simp [hlookup] at hrow + | some selected => + have hselected : selected = declaration := + (beq_iff_eq).mp (by simpa [hlookup] using hrow) + simpa [hlookup, hselected] + +/-- Pointwise form consumed by concrete key-sensitive oracle proofs. -/ +theorem addressMap_isolates_of_semanticAudit {result : Result} + {reserved : List Address} {groups : List Group} {main : Expr} + (haudit : result.semanticAudit reserved groups main = true) + {address : Address} + (haddress : address ∈ oracleIdentities reserved groups main) : + Renaming.isolates result.addressMap address = true := + (List.all_eq_true.mp + (result.oracleIdentityAudit_of_semanticAudit haudit)) address haddress + +end Result + +/-- A successful program readdressing carries its runtime-erased audit. -/ +abbrev CertifiedResult (reserved : List Address) (groups : List Group) + (main : Expr) := + { result : Result // result.semanticAudit reserved groups main = true } + +private def firstDuplicate? : List Address → Option Address + | [] => none + | address :: rest => + if rest.contains address then some address else firstDuplicate? rest + +private def firstOverlap? (left right : List Address) : Option Address := + left.find? right.contains + +/-- Previously produced identities may be reused only by the same complete +symbolic and materialized artifact. Producer names deliberately do not enter +this comparison: each producer retains its independently audited map. A block +identity can never stand for a member, and members of different blocks cannot +alias even when their materialized declarations happen to agree. -/ +def compatibleBlocks (left right : MutualBlock.Result) : Bool := + !left.derivedAddresses.contains right.blockAddress && + !right.derivedAddresses.contains left.blockAddress && + if left.blockAddress == right.blockAddress then + left.blockMembers == right.blockMembers && + left.members == right.members && + left.derivedAddresses == right.derivedAddresses + else + !left.derivedAddresses.any right.derivedAddresses.contains + +/-- Reusing a block identity requires equal symbolic preimages, without any +assumption that the hash function is injective. -/ +theorem blockMembers_eq_of_compatibleBlocks + {left right : MutualBlock.Result} + (hcompatible : compatibleBlocks left right = true) + (haddress : left.blockAddress = right.blockAddress) : + left.blockMembers = right.blockMembers := by + simp only [compatibleBlocks, haddress, beq_self_eq_true, ite_true, + Bool.and_eq_true] at hcompatible + exact (beq_iff_eq).mp hcompatible.2.1.1 + +/-- Reuse also preserves the complete ordered member environment. -/ +theorem members_eq_of_compatibleBlocks + {left right : MutualBlock.Result} + (hcompatible : compatibleBlocks left right = true) + (haddress : left.blockAddress = right.blockAddress) : + left.members = right.members := by + simp only [compatibleBlocks, haddress, beq_self_eq_true, ite_true, + Bool.and_eq_true] at hcompatible + exact (beq_iff_eq).mp hcompatible.2.1.2 + +private structure BuildState where + blocks : List MutualBlock.Result := [] + addressMap : MutualBlock.Renaming := [] + +private def buildBlocks (baseProtected allTransient : List Address) : + List Group → BuildState → Except String BuildState + | [], state => .ok state + | .stable _ :: rest, state => + buildBlocks baseProtected allTransient rest state + | .mutual raw :: rest, state => do + let ownTransient := raw.map (·.1) + let otherTransient := allTransient.filter fun address => + !ownTransient.contains address + let protectedKeys := baseProtected ++ otherTransient + let result ← MutualBlock.run protectedKeys raw + unless state.blocks.all (compatibleBlocks · result) do + throw s!"conflicting generated mutual-block or member identity {Address.toHex result.blockAddress}" + buildBlocks baseProtected allTransient rest + { blocks := state.blocks ++ [result] + addressMap := state.addressMap ++ result.addressMap } + +private def crossBlockTemporary? (allTransient : List Address) : + List Group → Option Address + | [] => none + | .stable _ :: rest => crossBlockTemporary? allTransient rest + | .mutual raw :: rest => + let external := (MutualBlock.abstractMembers raw).flatMap + MutualBlock.Decl.externalReferences + match external.find? allTransient.contains with + | some address => some address + | none => crossBlockTemporary? allTransient rest + +private def certify (reserved : List Address) (groups : List Group) + (main : Expr) (result : Result) : + Except String (CertifiedResult reserved groups main) := + if haudit : result.semanticAudit reserved groups main then + .ok ⟨result, haudit⟩ + else + .error "internal: whole-program IxIR0 readdressing failed semantic audit" + +/-- Address every mutual group, union the maps, and rewrite the complete +program and main expression. + +`reserved` is the caller-owned namespace not represented by stable group +keys—for erasure this includes every source constant address, notably the +Ixon address of each mutual block itself. -/ +def runCertified (reserved : List Address) (groups : List Group) + (main : Expr) : Except String (CertifiedResult reserved groups main) := do + let declarations := rawDeclarations groups + let allKeys := declarations.map (·.1) + if let some duplicate := firstDuplicate? allKeys then + throw s!"duplicate raw IxIR0 declaration key {Address.toHex duplicate}" + let transient := transientKeys groups + let stable := stableKeys groups + let baseProtected := reserved ++ stable + if let some overlap := firstOverlap? transient baseProtected then + throw s!"mutual-block temporary address overlaps stable or reserved identity {Address.toHex overlap}" + if let some cross := crossBlockTemporary? transient groups then + throw s!"cross-block reference uses another mutual block's temporary address {Address.toHex cross}" + let state ← buildBlocks baseProtected transient groups {} + let derived := state.addressMap.map (·.2) + let blockAddresses := state.blocks.map (·.blockAddress) + let external := externalReferences groups main + if let some overlap := firstOverlap? derived external then + throw s!"derived mutual-member key captures a program external reference {Address.toHex overlap}" + if let some overlap := firstOverlap? blockAddresses external then + throw s!"mutual-block identity captures a program external reference {Address.toHex overlap}" + let rename := MutualBlock.Renaming.apply state.addressMap + let result : Result := + { declarations := declarations.map fun entry => + (rename entry.1, + MutualBlock.Concrete.Decl.mapAddresses rename entry.2) + main := MutualBlock.Concrete.Expr.mapAddresses rename main + blocks := state.blocks + addressMap := state.addressMap } + certify reserved groups main result + +/-- Artifact-facing projection of `runCertified`. -/ +def run (reserved : List Address) (groups : List Group) + (main : Expr) : Except String Result := do + return (← runCertified reserved groups main).1 + +/-- Every successful artifact-facing run retains the whole-program audit. -/ +theorem semanticAudit_of_run_eq_ok + {reserved : List Address} {groups : List Group} {main : Expr} + {result : Result} (hrun : run reserved groups main = .ok result) : + result.semanticAudit reserved groups main = true := by + unfold run at hrun + cases hcertified : runCertified reserved groups main with + | error message => + rw [hcertified] at hrun + contradiction + | ok certified => + rw [hcertified] at hrun + have hvalue : certified.1 = result := by injection hrun + subst result + exact certified.2 + +/-- Every protected/stable/external identity is absent from both sides of the +map returned by a successful pass. -/ +theorem isolates_of_run_eq_ok + {reserved : List Address} {groups : List Group} {main : Expr} + {result : Result} (hrun : run reserved groups main = .ok result) + {address : Address} + (haddress : address ∈ oracleIdentities reserved groups main) : + Renaming.isolates result.addressMap address = true := + result.addressMap_isolates_of_semanticAudit + (semanticAudit_of_run_eq_ok hrun) haddress + +end Readdress + +end Ix.Compiler.IxIR0 diff --git a/Ix/Compiler/IxIR0/ReaddressOracle.lean b/Ix/Compiler/IxIR0/ReaddressOracle.lean new file mode 100644 index 000000000..78d59562b --- /dev/null +++ b/Ix/Compiler/IxIR0/ReaddressOracle.lean @@ -0,0 +1,263 @@ +import Ix.Compiler.IxIR0.ReaddressProjectionSafe + +/-! +# Executable oracle adaptation for IxIR₀ readdressing + +The forward address action is intentionally not a global bijection: a newly +derived member key is fixed, while the corresponding transient key maps to it. +Consequently an addressed oracle must not pretend it can invert arbitrary +runtime values. + +This module uses the narrower operation actually needed at the oracle +boundary. It reverse-resolves only the called declaration key, passes the +already-addressed arguments to the legacy oracle, and maps any returned value +forward. `Oracle.Readdressable` is the exact coherence condition ensuring +that this executable adapter commutes with the evaluator address action. +-/ + +namespace Ix.Compiler.IxIR0.Readdress + +open Ix.Compiler.Ixon (Address) + +namespace Renaming + +private theorem source_ne_of_isolates + {mapping : MutualBlock.Renaming} {identity : Address} + (hisolated : isolates mapping identity = true) + {entry : Address × Address} (hentry : entry ∈ mapping) : + entry.1 ≠ identity := by + have hpair := (List.all_eq_true.mp hisolated) entry hentry + simp only [Bool.and_eq_true] at hpair + exact bne_iff_ne.mp hpair.1 + +private theorem target_ne_of_isolates + {mapping : MutualBlock.Renaming} {identity : Address} + (hisolated : isolates mapping identity = true) + {entry : Address × Address} (hentry : entry ∈ mapping) : + entry.2 ≠ identity := by + have hpair := (List.all_eq_true.mp hisolated) entry hentry + simp only [Bool.and_eq_true] at hpair + exact bne_iff_ne.mp hpair.2 + +theorem lookup_eq_none_of_isolates + {mapping : MutualBlock.Renaming} {identity : Address} + (hisolated : isolates mapping identity = true) : + mapping.lookup identity = none := by + have hnone : + List.find? (fun entry => entry.1 == identity) mapping = none := + List.find?_eq_none.mpr fun entry hentry hequal => + source_ne_of_isolates hisolated hentry + (Address.eq_of_beq hequal) + simp [MutualBlock.Renaming.lookup, hnone] + +theorem reverseLookup_eq_none_of_isolates + {mapping : MutualBlock.Renaming} {identity : Address} + (hisolated : isolates mapping identity = true) : + reverseLookup mapping identity = none := by + have hnone : + List.find? (fun entry => entry.2 == identity) mapping = none := + List.find?_eq_none.mpr fun entry hentry hequal => + target_ne_of_isolates hisolated hentry + (Address.eq_of_beq hequal) + simp [reverseLookup, hnone] + +@[simp] theorem apply_eq_self_of_isolates + {mapping : MutualBlock.Renaming} {identity : Address} + (hisolated : isolates mapping identity = true) : + MutualBlock.Renaming.apply mapping identity = identity := by + simp [MutualBlock.Renaming.apply, + lookup_eq_none_of_isolates hisolated] + +@[simp] theorem reverseApply_eq_self_of_isolates + {mapping : MutualBlock.Renaming} {identity : Address} + (hisolated : isolates mapping identity = true) : + reverseApply mapping identity = identity := by + simp [reverseApply, reverseLookup_eq_none_of_isolates hisolated] + +theorem apply_ne_of_ne_of_isolates + {mapping : MutualBlock.Renaming} {identity address : Address} + (hisolated : isolates mapping identity = true) + (haddress : address ≠ identity) : + MutualBlock.Renaming.apply mapping address ≠ identity := by + unfold MutualBlock.Renaming.apply + cases hlookup : mapping.lookup address with + | none => simpa [hlookup] using haddress + | some target => + obtain ⟨entry, hfind, hvalue⟩ := Option.map_eq_some_iff.mp hlookup + have htarget : entry.2 = target := by simpa using hvalue + subst target + simpa [hlookup] using target_ne_of_isolates hisolated + (List.mem_of_find?_eq_some hfind) + +theorem reverseApply_ne_of_ne_of_isolates + {mapping : MutualBlock.Renaming} {identity address : Address} + (hisolated : isolates mapping identity = true) + (haddress : address ≠ identity) : + reverseApply mapping address ≠ identity := by + unfold reverseApply + cases hlookup : reverseLookup mapping address with + | none => simpa [hlookup] using haddress + | some source => + unfold reverseLookup at hlookup + obtain ⟨entry, hfind, hvalue⟩ := Option.map_eq_some_iff.mp hlookup + have hsource : entry.1 = source := by simpa using hvalue + subst source + simpa [hlookup] using source_ne_of_isolates hisolated + (List.mem_of_find?_eq_some hfind) + +end Renaming + +namespace Oracle + +/-- Executable addressed view of a legacy oracle. Arguments have already been +renamed by evaluator transport; only the call key is reverse-resolved. Any +result is mapped back into the addressed value universe. -/ +def readdress (mapping : MutualBlock.Renaming) (before : IxIR0.Oracle) : + IxIR0.Oracle := + let rename := MutualBlock.Renaming.apply mapping + fun address arguments => + (before (Renaming.reverseApply mapping address) arguments).map + (Value.mapAddresses rename) + +/-- Exact observable coherence required by `readdress`: after reverse-resolving +the mapped call key, the legacy oracle's answer on addressed arguments must +have the same forward image as its answer on the original call and arguments. +This admits the scalar ABI and deliberately rejects an address-sensitive +oracle unless it provides its own coherent implementation. -/ +def Readdressable (mapping : MutualBlock.Renaming) + (before : IxIR0.Oracle) : Prop := + let rename := MutualBlock.Renaming.apply mapping + ∀ address arguments, + (before + (Renaming.reverseApply mapping (rename address)) + (ValueList.mapAddresses rename arguments)).map + (Value.mapAddresses rename) = + (before address arguments).map (Value.mapAddresses rename) + +/-- The executable adapter satisfies the exact oracle equation consumed by +evaluator and trace transport. -/ +theorem readdress_compatible {mapping : MutualBlock.Renaming} + {before : IxIR0.Oracle} (hbefore : Readdressable mapping before) + (address : Address) (arguments : List Value) : + readdress mapping before + (MutualBlock.Renaming.apply mapping address) + (ValueList.mapAddresses + (MutualBlock.Renaming.apply mapping) arguments) = + (before address arguments).map + (Value.mapAddresses (MutualBlock.Renaming.apply mapping)) := by + exact hbefore address arguments + +/-- The empty oracle is readdressable for every map. -/ +theorem Readdressable.empty (mapping : MutualBlock.Renaming) : + Readdressable mapping (fun _ _ => none) := by + intro address arguments + rfl + +/-- Split the coherence proof into independent key and argument conditions. +This is convenient for scalar oracles: their argument condition usually +follows from length preservation. -/ +theorem Readdressable.of_key_and_arguments + {mapping : MutualBlock.Renaming} {before : IxIR0.Oracle} + (hkey : ∀ address arguments, + before + (Renaming.reverseApply mapping + (MutualBlock.Renaming.apply mapping address)) + arguments = before address arguments) + (harguments : ∀ address arguments, + before address + (ValueList.mapAddresses + (MutualBlock.Renaming.apply mapping) arguments) = + before address arguments) : + Readdressable mapping before := by + intro address arguments + rw [hkey, harguments] + +/-- A single-key oracle is coherent whenever the member map isolates that ABI +identity and structurally renamed arguments do not change its answer. -/ +theorem Readdressable.of_isolated_key + {mapping : MutualBlock.Renaming} {before : IxIR0.Oracle} + {key : Address} + (hisolated : Renaming.isolates mapping key = true) + (hoffKey : ∀ address arguments, address ≠ key → + before address arguments = none) + (harguments : ∀ address arguments, + before address + (ValueList.mapAddresses + (MutualBlock.Renaming.apply mapping) arguments) = + before address arguments) : + Readdressable mapping before := by + apply Readdressable.of_key_and_arguments + · intro address arguments + by_cases haddress : address = key + · subst address + simp [Renaming.apply_eq_self_of_isolates hisolated, + Renaming.reverseApply_eq_self_of_isolates hisolated] + · have happly : + MutualBlock.Renaming.apply mapping address ≠ key := + Renaming.apply_ne_of_ne_of_isolates hisolated haddress + have hreverse : + Renaming.reverseApply mapping + (MutualBlock.Renaming.apply mapping address) ≠ key := + Renaming.reverseApply_ne_of_ne_of_isolates hisolated happly + rw [hoffKey _ _ hreverse, hoffKey _ _ haddress] + · exact harguments + +end Oracle + +namespace Result + +/-- The executable oracle adapter discharges the context-renaming premise +from its compact coherence law. -/ +theorem renames_preAddressCtx_readdressOracle {result : Result} + {reserved : List Address} {groups : List Group} {main : Expr} + (haudit : result.semanticAudit reserved groups main = true) + (beforeOracle : IxIR0.Oracle) + (horacle : Oracle.Readdressable result.addressMap beforeOracle) : + Ctx.Renames (MutualBlock.Renaming.apply result.addressMap) + (result.preAddressCtx groups beforeOracle) + (result.addressedCtx + (Oracle.readdress result.addressMap beforeOracle)) := + result.renames_preAddressCtx haudit beforeOracle + (Oracle.readdress result.addressMap beforeOracle) + (Oracle.readdress_compatible horacle) + +/-- Exact evaluator transport using the executable addressed oracle. -/ +theorem run_readdressOracle_of_run_eq_ok + {reserved : List Address} {groups : List Group} {main : Expr} + {result : Result} + (hrun : Readdress.run reserved groups main = .ok result) + (beforeOracle : IxIR0.Oracle) + (horacle : Oracle.Readdressable result.addressMap beforeOracle) + (fuel : Nat := 100000) : + (result.addressedCtx + (Oracle.readdress result.addressMap beforeOracle)).run + result.main fuel = + mapResult (MutualBlock.Renaming.apply result.addressMap) + ((result.preAddressCtx groups beforeOracle).run main fuel) := + run_of_run_eq_ok hrun beforeOracle + (Oracle.readdress result.addressMap beforeOracle) + (Oracle.readdress_compatible horacle) fuel + +/-- Exact call-aware main-trace transport using the executable addressed +oracle. -/ +theorem projectionSafeMain_readdressOracle_of_audit {result : Result} + {reserved : List Address} {groups : List Group} {main : Expr} + (haudit : result.semanticAudit reserved groups main = true) + (beforeOracle : IxIR0.Oracle) + (horacle : Oracle.Readdressable result.addressMap beforeOracle) + {traceFuel : Nat} {value : Value} + (trace : IxIR0.ProjectionSafe.Eval + (result.rawCtx groups beforeOracle) traceFuel [] main value) : + IxIR0.ProjectionSafe.Eval + (result.addressedCtx + (Oracle.readdress result.addressMap beforeOracle)) + traceFuel [] result.main + (Value.mapAddresses + (MutualBlock.Renaming.apply result.addressMap) value) := + result.projectionSafeMain_of_audit haudit beforeOracle + (Oracle.readdress result.addressMap beforeOracle) + (Oracle.readdress_compatible horacle) trace + +end Result + +end Ix.Compiler.IxIR0.Readdress diff --git a/Ix/Compiler/IxIR0/ReaddressOracleExamples.lean b/Ix/Compiler/IxIR0/ReaddressOracleExamples.lean new file mode 100644 index 000000000..fa64984be --- /dev/null +++ b/Ix/Compiler/IxIR0/ReaddressOracleExamples.lean @@ -0,0 +1,63 @@ +import Ix.Compiler.IxIR0.Examples +import Ix.Compiler.IxIR0.ReaddressOracle + +/-! +# Coherence for the modeled IxIR₀ Nat-add oracle + +The trusted-extern ledger records `IxIR0.Examples.oracle` as the concrete +test-only scalar ABI at `Examples.natAddExt`. This module discharges the +generic readdressing adapter's coherence law for that exact implementation. +The only namespace premise is the executable isolation certificate carried by +successful whole-program readdressing. +-/ + +namespace Ix.Compiler.IxIR0.Readdress.Oracle + +open Ix.Compiler.Ixon (Address) + +private theorem examplesOracle_mapArguments + (mapping : MutualBlock.Renaming) (address : Address) + (arguments : List Value) : + Examples.oracle address + (ValueList.mapAddresses + (MutualBlock.Renaming.apply mapping) arguments) = + Examples.oracle address arguments := by + by_cases haddress : address = Examples.natAddExt + · subst address + simp only [Examples.oracle, BEq.rfl, if_true] + cases arguments with + | nil => simp + | cons first rest => + cases rest with + | nil => simp + | cons second tail => + cases tail with + | nil => + cases first <;> cases second <;> + simp [Value.mapAddresses] + | cons _ _ => simp + · simp [Examples.oracle, haddress] + +/-- The concrete literal-Nat addition model is coherent with every member map +that isolates its ledger identity. -/ +theorem Readdressable.examples_of_isolates + {mapping : MutualBlock.Renaming} + (hisolated : Renaming.isolates mapping Examples.natAddExt = true) : + Readdressable mapping Examples.oracle := by + apply Readdressable.of_isolated_key hisolated + · intro address arguments haddress + simp [Examples.oracle, haddress] + · exact examplesOracle_mapArguments mapping + +/-- Successful whole-program addressing supplies the isolation premise when +the Nat-add ABI key is stable, reserved, or externally referenced. -/ +theorem Readdressable.examples_of_run_eq_ok + {reserved : List Address} {groups : List Group} {main : Expr} + {result : Result} (hrun : Readdress.run reserved groups main = .ok result) + (hidentity : Examples.natAddExt ∈ + oracleIdentities reserved groups main) : + Readdressable result.addressMap Examples.oracle := + Readdressable.examples_of_isolates + (Readdress.isolates_of_run_eq_ok hrun hidentity) + +end Ix.Compiler.IxIR0.Readdress.Oracle diff --git a/Ix/Compiler/IxIR0/ReaddressProjectionSafe.lean b/Ix/Compiler/IxIR0/ReaddressProjectionSafe.lean new file mode 100644 index 000000000..b35f7e61f --- /dev/null +++ b/Ix/Compiler/IxIR0/ReaddressProjectionSafe.lean @@ -0,0 +1,397 @@ +import Ix.Compiler.IxIR0.ProjectionSafe +import Ix.Compiler.IxIR0.ReaddressSim + +/-! +# Projection-safe trace transport across IxIR₀ readdressing + +Evaluator equivariance transports the observable `Except` result of a run. +The lowering progress proof consumes a stronger witness: the mutually +inductive `ProjectionSafe.Eval`/`Apply`/`Saturate`/`Fire` trace retaining every +dynamically entered body. This module transports that witness structurally. + +Unlike full evaluator equivalence, a successful trace only observes successful +declaration and oracle lookups. `Ctx.TraceRenames` therefore states exactly +that one-way requirement. In particular it relates the validator's literal +raw environment directly to the final addressed environment; no stable alias +has to be inserted on the proof-facing side. +-/ + +namespace Ix.Compiler.IxIR0.Readdress + +open Ix.Compiler.Ixon (Address) + +namespace Ctx + +/-- One-way context compatibility sufficient to rename a successful +projection-safe trace. -/ +structure TraceRenames (rename : Address → Address) + (before after : IxIR0.Ctx) : Prop where + env : ∀ {address declaration}, + before.env address = some declaration → + after.env (rename address) = + some (MutualBlock.Concrete.Decl.mapAddresses rename declaration) + oracle : ∀ {address arguments result}, + before.oracle address arguments = some result → + after.oracle (rename address) + (ValueList.mapAddresses rename arguments) = + some (Value.mapAddresses rename result) + +/-- Exact evaluator-context renaming entails the one-way trace relation. -/ +theorem Renames.toTraceRenames {rename : Address → Address} + {before after : IxIR0.Ctx} + (contexts : Renames rename before after) : + TraceRenames rename before after := by + constructor + · intro address declaration hlookup + rw [contexts.env address, hlookup] + rfl + · intro address arguments result horacle + rw [contexts.oracle address arguments, horacle] + rfl + +end Ctx + +namespace ProjectionSafe + +mutual + + /-- Rename every address retained by an exact projection-safe evaluation + trace. -/ + theorem Eval.mapAddresses {rename : Address → Address} + {before after : IxIR0.Ctx} + (contexts : Ctx.TraceRenames rename before after) + {fuel : Nat} {environment : List Value} {expression : Expr} + {result : Value} + (trace : IxIR0.ProjectionSafe.Eval before fuel environment expression + result) : + IxIR0.ProjectionSafe.Eval after fuel + (ValueList.mapAddresses rename environment) + (MutualBlock.Concrete.Expr.mapAddresses rename expression) + (Value.mapAddresses rename result) := by + cases trace with + | var hlookup => + simp only [MutualBlock.Concrete.Expr.mapAddresses] + apply IxIR0.ProjectionSafe.Eval.var + simpa using congrArg (Option.map (Value.mapAddresses rename)) hlookup + | lit => + simp only [MutualBlock.Concrete.Expr.mapAddresses, + Value.mapAddresses] + exact .lit + | erased => + simp only [MutualBlock.Concrete.Expr.mapAddresses, + Value.mapAddresses] + exact .erased + | lam => + simp only [MutualBlock.Concrete.Expr.mapAddresses, + Value.mapAddresses] + exact .lam + | letE hvalue hbody => + simp only [MutualBlock.Concrete.Expr.mapAddresses] + exact .letE (Eval.mapAddresses contexts hvalue) + (by simpa using Eval.mapAddresses contexts hbody) + | app hfunction hargument happly => + simp only [MutualBlock.Concrete.Expr.mapAddresses] + exact .app (Eval.mapAddresses contexts hfunction) + (Eval.mapAddresses contexts hargument) + (Apply.mapAddresses contexts happly) + | proj hsource hfield => + simp only [MutualBlock.Concrete.Expr.mapAddresses] + have hsource' := Eval.mapAddresses contexts hsource + simp only [Value.mapAddresses] at hsource' + apply IxIR0.ProjectionSafe.Eval.proj hsource' + simpa using congrArg (Option.map (Value.mapAddresses rename)) hfield + | refDefn hlookup hbody => + simp only [MutualBlock.Concrete.Expr.mapAddresses] + exact .refDefn + (by simpa [MutualBlock.Concrete.Decl.mapAddresses] using + contexts.env hlookup) + (by simpa using Eval.mapAddresses contexts hbody) + | refCtor hlookup hsaturate => + simp only [MutualBlock.Concrete.Expr.mapAddresses] + exact .refCtor + (by simpa [MutualBlock.Concrete.Decl.mapAddresses] using + contexts.env hlookup) + (by simpa [Head.mapAddresses, ValueList.mapAddresses] using + Saturate.mapAddresses contexts hsaturate) + | refRecursor hlookup => + simp only [MutualBlock.Concrete.Expr.mapAddresses, + Value.mapAddresses, Head.mapAddresses, ValueList.mapAddresses] + exact .refRecursor + (by simpa [MutualBlock.Concrete.Decl.mapAddresses] using + contexts.env hlookup) + | refExtern hlookup hsaturate => + simp only [MutualBlock.Concrete.Expr.mapAddresses] + exact .refExtern + (by simpa [MutualBlock.Concrete.Decl.mapAddresses] using + contexts.env hlookup) + (by simpa [Head.mapAddresses, ValueList.mapAddresses] using + Saturate.mapAddresses contexts hsaturate) + + /-- Rename every address retained by an exact projection-safe application + trace. -/ + theorem Apply.mapAddresses {rename : Address → Address} + {before after : IxIR0.Ctx} + (contexts : Ctx.TraceRenames rename before after) + {fuel : Nat} {function argument result : Value} + (trace : IxIR0.ProjectionSafe.Apply before fuel function argument + result) : + IxIR0.ProjectionSafe.Apply after fuel + (Value.mapAddresses rename function) + (Value.mapAddresses rename argument) + (Value.mapAddresses rename result) := by + cases trace with + | clos hbody => + simp only [Value.mapAddresses] + exact .clos (by simpa using Eval.mapAddresses contexts hbody) + | pap hsaturate => + simp only [Value.mapAddresses] + exact .pap (by simpa using Saturate.mapAddresses contexts hsaturate) + | erased => + simp only [Value.mapAddresses] + exact .erased + + /-- Rename every address retained by an exact projection-safe saturation + trace. -/ + theorem Saturate.mapAddresses {rename : Address → Address} + {before after : IxIR0.Ctx} + (contexts : Ctx.TraceRenames rename before after) + {fuel : Nat} {head : Head} {arguments : List Value} {result : Value} + (trace : IxIR0.ProjectionSafe.Saturate before fuel head arguments + result) : + IxIR0.ProjectionSafe.Saturate after fuel + (Head.mapAddresses rename head) + (ValueList.mapAddresses rename arguments) + (Value.mapAddresses rename result) := by + cases trace with + | pending hlength => + simp only [Value.mapAddresses] + exact .pending (by simpa using hlength) + | full hlength hfire => + exact .full (by simpa using hlength) + (Fire.mapAddresses contexts hfire) + + /-- Rename every address retained by an exact projection-safe firing + trace. -/ + theorem Fire.mapAddresses {rename : Address → Address} + {before after : IxIR0.Ctx} + (contexts : Ctx.TraceRenames rename before after) + {fuel : Nat} {head : Head} {arguments : List Value} {result : Value} + (trace : IxIR0.ProjectionSafe.Fire before fuel head arguments result) : + IxIR0.ProjectionSafe.Fire after fuel + (Head.mapAddresses rename head) + (ValueList.mapAddresses rename arguments) + (Value.mapAddresses rename result) := by + cases trace with + | ctor => + simp only [Head.mapAddresses, Value.mapAddresses] + exact .ctor + | extern horacle => exact .extern (contexts.oracle horacle) + | @recursor fuel address arity numArgs natLit rules arguments major tag + fields rule result hlookup hlast hmajor hrule hfields hbody => + apply IxIR0.ProjectionSafe.Fire.recursor (contexts.env hlookup) + · simpa using congrArg (Option.map (Value.mapAddresses rename)) hlast + · simpa [mapMajorResult] using + congrArg (mapMajorResult rename) hmajor + · simpa using congrArg + (Option.map (MutualBlock.Concrete.RecRule.mapAddresses rename)) + hrule + · simpa [MutualBlock.Concrete.RecRule.mapAddresses] using hfields + · simpa [MutualBlock.Concrete.RecRule.mapAddresses, + Value.mapAddresses, Head.mapAddresses] using + Eval.mapAddresses contexts hbody + +end + +/-- Transport a bounded safe application spine pointwise. -/ +theorem AppliesBelow.mapAddresses {rename : Address → Address} + {before after : IxIR0.Ctx} + (contexts : Ctx.TraceRenames rename before after) + {limit : Nat} {function result : Value} {arguments : List Value} + (trace : IxIR0.ProjectionSafe.AppliesBelow before limit function + arguments result) : + IxIR0.ProjectionSafe.AppliesBelow after limit + (Value.mapAddresses rename function) + (ValueList.mapAddresses rename arguments) + (Value.mapAddresses rename result) := by + exact IxIR0.ProjectionSafe.AppliesBelow.traverse + (Result := fun currentFunction currentArguments currentResult => + IxIR0.ProjectionSafe.AppliesBelow after limit + (Value.mapAddresses rename currentFunction) + (ValueList.mapAddresses rename currentArguments) + (Value.mapAddresses rename currentResult)) + (hnil := by + intro value + simp only [ValueList.mapAddresses] + exact .nil) + (hcons := by + intro currentFunction argument currentMiddle currentResult + currentArguments fuel hfuel hstep htail ih + simpa only [ValueList.mapAddresses] using + IxIR0.ProjectionSafe.AppliesBelow.cons hfuel + (Apply.mapAddresses contexts hstep) ih) + trace + +/-- Transport pointwise bounded argument-evaluation traces. -/ +theorem EvalsBelow.mapAddresses {rename : Address → Address} + {before after : IxIR0.Ctx} + (contexts : Ctx.TraceRenames rename before after) + {limit : Nat} {environment : List Value} + {expressions : List Expr} {values : List Value} + (trace : IxIR0.ProjectionSafe.EvalsBelow before limit environment + expressions values) : + IxIR0.ProjectionSafe.EvalsBelow after limit + (ValueList.mapAddresses rename environment) + (expressions.map (MutualBlock.Concrete.Expr.mapAddresses rename)) + (ValueList.mapAddresses rename values) := by + exact IxIR0.ProjectionSafe.EvalsBelow.traverse + (Result := fun currentExpressions currentValues => + IxIR0.ProjectionSafe.EvalsBelow after limit + (ValueList.mapAddresses rename environment) + (currentExpressions.map + (MutualBlock.Concrete.Expr.mapAddresses rename)) + (ValueList.mapAddresses rename currentValues)) + (hnil := by + simp only [List.map, ValueList.mapAddresses] + exact .nil) + (hcons := by + intro fuel expr value currentExpressions currentValues hfuel heval + htail ih + simpa only [List.map, ValueList.mapAddresses] using + IxIR0.ProjectionSafe.EvalsBelow.cons hfuel + (Eval.mapAddresses contexts heval) ih) + trace + +/-- Transport a flattened call-aware expression spine. -/ +theorem Spine.mapAddresses {rename : Address → Address} + {before after : IxIR0.Ctx} + (contexts : Ctx.TraceRenames rename before after) + {limit : Nat} {environment : List Value} + {head : Expr} {arguments : List Expr} {result : Value} + (trace : IxIR0.ProjectionSafe.Spine before limit environment head + arguments result) : + IxIR0.ProjectionSafe.Spine after limit + (ValueList.mapAddresses rename environment) + (MutualBlock.Concrete.Expr.mapAddresses rename head) + (arguments.map (MutualBlock.Concrete.Expr.mapAddresses rename)) + (Value.mapAddresses rename result) := by + cases trace with + | intro hbound hhead harguments happlies => + exact .intro hbound (Eval.mapAddresses contexts hhead) + (EvalsBelow.mapAddresses contexts harguments) + (AppliesBelow.mapAddresses contexts happlies) + +/-- Fuel-free projection-safe termination is invariant under a trace +renaming. -/ +theorem Terminates.mapAddresses {rename : Address → Address} + {before after : IxIR0.Ctx} + (contexts : Ctx.TraceRenames rename before after) + {environment : List Value} {expression : Expr} {result : Value} + (trace : IxIR0.ProjectionSafe.Terminates before environment expression + result) : + IxIR0.ProjectionSafe.Terminates after + (ValueList.mapAddresses rename environment) + (MutualBlock.Concrete.Expr.mapAddresses rename expression) + (Value.mapAddresses rename result) := by + obtain ⟨fuel, trace⟩ := trace + exact ⟨fuel, Eval.mapAddresses contexts trace⟩ + +end ProjectionSafe + +namespace Result + +/-- Literal proof-facing context emitted by the legacy eraser, with no +derived-key aliases. -/ +def rawCtx (_result : Result) (groups : List Group) + (oracle : Oracle := fun _ _ => none) : IxIR0.Ctx := + { env := Env.ofList (rawDeclarations groups), oracle } + +/-- A successful whole-program audit relates the literal raw environment +directly to the emitted addressed environment for every successful lookup. -/ +theorem traceRenames_rawCtx {result : Result} + {reserved : List Address} {groups : List Group} {main : Expr} + (haudit : result.semanticAudit reserved groups main = true) + (beforeOracle afterOracle : Oracle) + (horacle : ∀ address arguments, + afterOracle + (MutualBlock.Renaming.apply result.addressMap address) + (ValueList.mapAddresses + (MutualBlock.Renaming.apply result.addressMap) arguments) = + (beforeOracle address arguments).map + (Value.mapAddresses + (MutualBlock.Renaming.apply result.addressMap))) : + Ctx.TraceRenames (MutualBlock.Renaming.apply result.addressMap) + (result.rawCtx groups beforeOracle) + (result.addressedCtx afterOracle) := by + constructor + · intro address declaration hlookup + change Env.ofList (rawDeclarations groups) address = some declaration at hlookup + change Env.ofList result.declarations + (MutualBlock.Renaming.apply result.addressMap address) = _ + exact result.lookup_eq_mapAddresses haudit hlookup + · intro address arguments value hlookup + change beforeOracle address arguments = some value at hlookup + change afterOracle + (MutualBlock.Renaming.apply result.addressMap address) + (ValueList.mapAddresses + (MutualBlock.Renaming.apply result.addressMap) arguments) = _ + rw [horacle address arguments, hlookup] + rfl + +/-- The exact call-aware trace consumed by lowering progress survives a +successful whole-program readdressing. -/ +theorem projectionSafeEval_of_audit {result : Result} + {reserved : List Address} {groups : List Group} {main : Expr} + (haudit : result.semanticAudit reserved groups main = true) + (beforeOracle afterOracle : Oracle) + (horacle : ∀ address arguments, + afterOracle + (MutualBlock.Renaming.apply result.addressMap address) + (ValueList.mapAddresses + (MutualBlock.Renaming.apply result.addressMap) arguments) = + (beforeOracle address arguments).map + (Value.mapAddresses + (MutualBlock.Renaming.apply result.addressMap))) + {traceFuel : Nat} {environment : List Value} {expression : Expr} + {value : Value} + (trace : IxIR0.ProjectionSafe.Eval + (result.rawCtx groups beforeOracle) traceFuel environment expression + value) : + IxIR0.ProjectionSafe.Eval (result.addressedCtx afterOracle) traceFuel + (ValueList.mapAddresses + (MutualBlock.Renaming.apply result.addressMap) environment) + (MutualBlock.Concrete.Expr.mapAddresses + (MutualBlock.Renaming.apply result.addressMap) expression) + (Value.mapAddresses + (MutualBlock.Renaming.apply result.addressMap) value) := + ProjectionSafe.Eval.mapAddresses + (result.traceRenames_rawCtx haudit beforeOracle afterOracle horacle) + trace + +/-- Closed main specialization, rewriting the structural image to the exact +main retained by the addressed result. -/ +theorem projectionSafeMain_of_audit {result : Result} + {reserved : List Address} {groups : List Group} {main : Expr} + (haudit : result.semanticAudit reserved groups main = true) + (beforeOracle afterOracle : Oracle) + (horacle : ∀ address arguments, + afterOracle + (MutualBlock.Renaming.apply result.addressMap address) + (ValueList.mapAddresses + (MutualBlock.Renaming.apply result.addressMap) arguments) = + (beforeOracle address arguments).map + (Value.mapAddresses + (MutualBlock.Renaming.apply result.addressMap))) + {traceFuel : Nat} {value : Value} + (trace : IxIR0.ProjectionSafe.Eval + (result.rawCtx groups beforeOracle) traceFuel [] main value) : + IxIR0.ProjectionSafe.Eval (result.addressedCtx afterOracle) traceFuel [] + result.main + (Value.mapAddresses + (MutualBlock.Renaming.apply result.addressMap) value) := by + rw [result.main_eq_mapAddresses haudit] + simpa using result.projectionSafeEval_of_audit haudit beforeOracle + afterOracle horacle trace + +end Result + +end Ix.Compiler.IxIR0.Readdress diff --git a/Ix/Compiler/IxIR0/ReaddressSim.lean b/Ix/Compiler/IxIR0/ReaddressSim.lean new file mode 100644 index 000000000..b0735634c --- /dev/null +++ b/Ix/Compiler/IxIR0/ReaddressSim.lean @@ -0,0 +1,676 @@ +import Ix.Compiler.IxIR0.Eval +import Ix.Compiler.IxIR0.Readdress + +/-! +# Semantic transport for IxIR₀ address renaming + +Cycle-safe mutual blocks replace transient declaration keys with keys derived +from the canonical symbolic block. IxIR₀ runtime values retain global +addresses in constructors, partial applications, closures, and errors, so the +semantic statement maps the entire evaluator state rather than only source +expressions. + +`Ctx.Renames` isolates the two assumptions the evaluator needs: exact forward +declaration lookup and an oracle that commutes with the same structural map. +The concrete theorem at the end obtains the declaration half directly from a +successful whole-program readdressing audit. +-/ + +namespace Ix.Compiler.IxIR0 + +open Ix.Compiler.Ixon (Address) + +namespace Readdress + +namespace Head + +/-- Rename every declaration identity retained by a global head. -/ +def mapAddresses (rename : Address → Address) : Head → Head + | .ctor address tag arity => .ctor (rename address) tag arity + | .rec_ address arity => .rec_ (rename address) arity + | .ext address arity => .ext (rename address) arity + +end Head + +/-! Values and value lists are mutually recursive because closures and +constructor/PAP payloads contain further values. -/ + +mutual + +/-- Structural address action on an IxIR₀ runtime value. -/ +def Value.mapAddresses (rename : Address → Address) (value : Value) : Value := + match value with + | .clos uses environment body => + .clos uses (ValueList.mapAddresses rename environment) + (MutualBlock.Concrete.Expr.mapAddresses rename body) + | .pap head arguments => + .pap (Head.mapAddresses rename head) + (ValueList.mapAddresses rename arguments) + | .ctor address tag arguments => + .ctor (rename address) tag (ValueList.mapAddresses rename arguments) + | .lit literal => .lit literal + | .erased => .erased +termination_by sizeOf value + +/-- Structural address action on a runtime environment or argument list. -/ +def ValueList.mapAddresses (rename : Address → Address) + (values : List Value) : List Value := + match values with + | [] => [] + | value :: rest => + Value.mapAddresses rename value :: ValueList.mapAddresses rename rest +termination_by sizeOf values + +end + +namespace Err + +/-- Rename the address payload of evaluator failures. -/ +def mapAddresses (rename : Address → Address) : Err → Err + | .fuel => .fuel + | .stuck message => .stuck message + | .oracleMissing address => .oracleMissing (rename address) + | .unknownRef address => .unknownRef (rename address) + +end Err + +/-- Structural address action on an evaluator result. -/ +def mapResult (rename : Address → Address) : + Except Err Value → Except Err Value + | .ok value => .ok (Value.mapAddresses rename value) + | .error error => .error (Err.mapAddresses rename error) + +/-- Structural address action on the result of viewing a recursor major. -/ +def mapMajorResult (rename : Address → Address) : + Except Err (Nat × List Value) → Except Err (Nat × List Value) + | .ok (tag, fields) => .ok (tag, ValueList.mapAddresses rename fields) + | .error error => .error (Err.mapAddresses rename error) + +namespace Ctx + +/-- Exact evaluator-context compatibility for an address renaming. -/ +structure Renames (rename : Address → Address) + (before after : Ctx) : Prop where + env : ∀ address, + after.env (rename address) = + (before.env address).map + (MutualBlock.Concrete.Decl.mapAddresses rename) + oracle : ∀ address arguments, + after.oracle (rename address) + (ValueList.mapAddresses rename arguments) = + (before.oracle address arguments).map + (Value.mapAddresses rename) + +end Ctx + +/-! ## Structural laws used by evaluator transport -/ + +@[simp] theorem Head.arity_mapAddresses (rename : Address → Address) + (head : Head) : + (Head.mapAddresses rename head).arity = head.arity := by + cases head <;> rfl + +@[simp] theorem ValueList.mapAddresses_nil (rename : Address → Address) : + ValueList.mapAddresses rename [] = [] := by + simp [ValueList.mapAddresses] + +@[simp] theorem ValueList.mapAddresses_cons (rename : Address → Address) + (value : Value) (rest : List Value) : + ValueList.mapAddresses rename (value :: rest) = + Value.mapAddresses rename value :: ValueList.mapAddresses rename rest := + by simp [ValueList.mapAddresses] + +@[simp] theorem ValueList.mapAddresses_eq_map (rename : Address → Address) + (values : List Value) : + ValueList.mapAddresses rename values = + values.map (Value.mapAddresses rename) := by + induction values with + | nil => simp + | cons value rest ih => simp [ih] + +@[simp] theorem ValueList.length_mapAddresses (rename : Address → Address) + (values : List Value) : + (ValueList.mapAddresses rename values).length = values.length := by + simp [ValueList.mapAddresses_eq_map] + +@[simp] theorem ValueList.mapAddresses_append (rename : Address → Address) + (left right : List Value) : + ValueList.mapAddresses rename (left ++ right) = + ValueList.mapAddresses rename left ++ + ValueList.mapAddresses rename right := by + simp [ValueList.mapAddresses_eq_map] + +@[simp] theorem ValueList.mapAddresses_reverse (rename : Address → Address) + (values : List Value) : + ValueList.mapAddresses rename values.reverse = + (ValueList.mapAddresses rename values).reverse := by + simp [ValueList.mapAddresses_eq_map] + +@[simp] theorem ValueList.mapAddresses_dropLast + (rename : Address → Address) (values : List Value) : + ValueList.mapAddresses rename values.dropLast = + (ValueList.mapAddresses rename values).dropLast := by + simp [ValueList.mapAddresses_eq_map] + +@[simp] theorem ValueList.getElem?_mapAddresses + (rename : Address → Address) (values : List Value) (index : Nat) : + (ValueList.mapAddresses rename values)[index]? = + (values[index]?).map (Value.mapAddresses rename) := by + simp [ValueList.mapAddresses_eq_map] + +@[simp] theorem ValueList.getLast?_mapAddresses + (rename : Address → Address) (values : List Value) : + (ValueList.mapAddresses rename values).getLast? = + values.getLast?.map (Value.mapAddresses rename) := by + induction values with + | nil => simp + | cons value rest ih => + cases rest with + | nil => simp + | cons next tail => simpa using ih + +@[simp] theorem majorCtor_mapAddresses (rename : Address → Address) + (natLit : Bool) (value : Value) : + majorCtor natLit (Value.mapAddresses rename value) = + mapMajorResult rename (majorCtor natLit value) := by + cases value with + | clos uses environment body => simp [Value.mapAddresses, majorCtor, + mapMajorResult, Err.mapAddresses] + | pap head arguments => simp [Value.mapAddresses, majorCtor, + mapMajorResult, Err.mapAddresses] + | ctor address tag arguments => + simp [Value.mapAddresses, majorCtor, mapMajorResult] + | lit literal => + cases literal with + | str string => simp [Value.mapAddresses, majorCtor, mapMajorResult, + Err.mapAddresses] + | nat number => + cases natLit <;> cases number <;> + simp [Value.mapAddresses, majorCtor, mapMajorResult, + Err.mapAddresses] + | erased => simp [Value.mapAddresses, majorCtor, mapMajorResult, + Err.mapAddresses] + +@[simp] theorem mapResult_ok (rename : Address → Address) (value : Value) : + mapResult rename (.ok value) = .ok (Value.mapAddresses rename value) := rfl + +@[simp] theorem mapResult_error (rename : Address → Address) (error : Err) : + mapResult rename (.error error) = .error (Err.mapAddresses rename error) := + rfl + +@[simp] theorem Err.mapAddresses_fuel (rename : Address → Address) : + Err.mapAddresses rename .fuel = .fuel := rfl + +@[simp] theorem Err.mapAddresses_stuck (rename : Address → Address) + (message : String) : + Err.mapAddresses rename (.stuck message) = .stuck message := rfl + +@[simp] theorem Err.mapAddresses_oracleMissing + (rename : Address → Address) (address : Address) : + Err.mapAddresses rename (.oracleMissing address) = + .oracleMissing (rename address) := rfl + +@[simp] theorem Err.mapAddresses_unknownRef + (rename : Address → Address) (address : Address) : + Err.mapAddresses rename (.unknownRef address) = + .unknownRef (rename address) := rfl + +@[simp] private theorem except_ok_bind {Error Value Result : Type} + (value : Value) (next : Value → Except Error Result) : + (Except.ok value >>= next) = next value := rfl + +@[simp] private theorem except_error_bind {Error Value Result : Type} + (error : Error) (next : Value → Except Error Result) : + (Except.error error >>= next) = Except.error error := rfl + +/-! ## Fueled evaluator equivariance -/ + +/-- All four mutually recursive evaluator entries commute with an address map +at one common fuel index. -/ +structure EvalTransportAt (rename : Address → Address) + (before after : Ctx) (fuel : Nat) : Prop where + eval : ∀ (environment : List Value) (expression : Expr), + IxIR0.eval after fuel (ValueList.mapAddresses rename environment) + (MutualBlock.Concrete.Expr.mapAddresses rename expression) = + mapResult rename (IxIR0.eval before fuel environment expression) + applyValue : ∀ (function argument : Value), + IxIR0.apply after fuel (Value.mapAddresses rename function) + (Value.mapAddresses rename argument) = + mapResult rename (IxIR0.apply before fuel function argument) + saturate : ∀ (head : Head) (arguments : List Value), + IxIR0.saturate after fuel (Head.mapAddresses rename head) + (ValueList.mapAddresses rename arguments) = + mapResult rename (IxIR0.saturate before fuel head arguments) + fire : ∀ (head : Head) (arguments : List Value), + IxIR0.fire after fuel (Head.mapAddresses rename head) + (ValueList.mapAddresses rename arguments) = + mapResult rename (IxIR0.fire before fuel head arguments) + +/-- Exact evaluator equivariance at every fuel. -/ +theorem evalTransportAt {rename : Address → Address} {before after : Ctx} + (contexts : Ctx.Renames rename before after) : + ∀ fuel, EvalTransportAt rename before after fuel := by + intro fuel + induction fuel with + | zero => + constructor <;> intros <;> + simp [IxIR0.eval, IxIR0.apply, IxIR0.saturate, IxIR0.fire, + mapResult, Err.mapAddresses] + | succ fuel smaller => + refine { + eval := ?_ + applyValue := ?_ + saturate := ?_ + fire := ?_ } + · intro environment expression + cases expression with + | var index => + cases hlookup : environment[index]? with + | none => + simp [IxIR0.eval, + MutualBlock.Concrete.Expr.mapAddresses, hlookup, + mapResult, Err.mapAddresses] + | some value => + simp [IxIR0.eval, + MutualBlock.Concrete.Expr.mapAddresses, hlookup, + mapResult] + | ref address => + simp only [IxIR0.eval, + MutualBlock.Concrete.Expr.mapAddresses, contexts.env address] + cases hdeclaration : before.env address with + | none => simp [mapResult, Err.mapAddresses] + | some declaration => + simp only [Option.map_some] + cases declaration with + | defn result body => + simpa [MutualBlock.Concrete.Decl.mapAddresses] using + smaller.eval [] body + | ctor tag arity => + simpa [MutualBlock.Concrete.Decl.mapAddresses, + Head.mapAddresses] using + smaller.saturate (.ctor address tag arity) [] + | recursor numArgs natLit rules => + simp [MutualBlock.Concrete.Decl.mapAddresses, + Value.mapAddresses, Head.mapAddresses, mapResult] + | extern arity => + simpa [MutualBlock.Concrete.Decl.mapAddresses, + Head.mapAddresses] using + smaller.saturate (.ext address arity) [] + | app function argument => + simp only [IxIR0.eval, + MutualBlock.Concrete.Expr.mapAddresses] + rw [smaller.eval environment function] + cases hfunction : IxIR0.eval before fuel environment function with + | error error => simp [mapResult] + | ok functionValue => + simp only [mapResult, except_ok_bind] + rw [smaller.eval environment argument] + cases hargument : IxIR0.eval before fuel environment argument with + | error error => simp [mapResult] + | ok argumentValue => + simp only [mapResult, except_ok_bind] + exact smaller.applyValue functionValue argumentValue + | lam uses body => + simp [IxIR0.eval, MutualBlock.Concrete.Expr.mapAddresses, + Value.mapAddresses, mapResult] + | letE uses value body => + simp only [IxIR0.eval, + MutualBlock.Concrete.Expr.mapAddresses] + rw [smaller.eval environment value] + cases hvalue : IxIR0.eval before fuel environment value with + | error error => simp [mapResult] + | ok result => + simp only [mapResult, except_ok_bind] + simpa only [ValueList.mapAddresses_cons, mapResult] using + smaller.eval (result :: environment) body + | proj index struct => + simp only [IxIR0.eval, + MutualBlock.Concrete.Expr.mapAddresses] + rw [smaller.eval environment struct] + cases hstruct : IxIR0.eval before fuel environment struct with + | error error => simp [mapResult] + | ok value => + simp only [mapResult, except_ok_bind] + cases value with + | clos uses captured body => + simp [Value.mapAddresses, Err.mapAddresses] + | pap head arguments => + simp [Value.mapAddresses, Err.mapAddresses] + | ctor address tag arguments => + cases hfield : arguments[index]? with + | none => + simp [Value.mapAddresses, hfield, + Err.mapAddresses] + | some field => + simp [Value.mapAddresses, hfield] + | lit literal => + simp [Value.mapAddresses, Err.mapAddresses] + | erased => simp [Value.mapAddresses] + | lit literal => + simp [IxIR0.eval, MutualBlock.Concrete.Expr.mapAddresses, + Value.mapAddresses, mapResult] + | erased => + simp [IxIR0.eval, MutualBlock.Concrete.Expr.mapAddresses, + Value.mapAddresses, mapResult] + · intro function argument + cases function with + | clos uses environment body => + simpa [IxIR0.apply, Value.mapAddresses] using + smaller.eval (argument :: environment) body + | pap head arguments => + simpa [IxIR0.apply, Value.mapAddresses] using + smaller.saturate head (arguments ++ [argument]) + | ctor address tag arguments => + simp [IxIR0.apply, Value.mapAddresses, mapResult, + Err.mapAddresses] + | lit literal => + simp [IxIR0.apply, Value.mapAddresses, mapResult, + Err.mapAddresses] + | erased => simp [IxIR0.apply, Value.mapAddresses, mapResult] + · intro head arguments + simp only [IxIR0.saturate, Head.arity_mapAddresses, + ValueList.length_mapAddresses] + split + · exact smaller.fire head arguments + · simp [Value.mapAddresses, mapResult] + · intro head arguments + cases head with + | ctor address tag arity => + simp [IxIR0.fire, Head.mapAddresses, Value.mapAddresses, + mapResult] + | ext address arity => + simp only [IxIR0.fire, Head.mapAddresses, + contexts.oracle address arguments] + cases horacle : before.oracle address arguments with + | none => simp [mapResult, Err.mapAddresses] + | some value => simp [mapResult] + | rec_ address arity => + simp only [IxIR0.fire, Head.mapAddresses, contexts.env address] + cases hdeclaration : before.env address with + | none => simp [mapResult, Err.mapAddresses] + | some declaration => + simp only [Option.map_some] + cases declaration with + | defn result body => + simp [MutualBlock.Concrete.Decl.mapAddresses, + mapResult, Err.mapAddresses] + | ctor tag declarationArity => + simp [MutualBlock.Concrete.Decl.mapAddresses, + mapResult, Err.mapAddresses] + | extern declarationArity => + simp [MutualBlock.Concrete.Decl.mapAddresses, + mapResult, Err.mapAddresses] + | recursor numArgs natLit rules => + simp only [MutualBlock.Concrete.Decl.mapAddresses, + ValueList.getLast?_mapAddresses] + cases hlast : arguments.getLast? with + | none => + simp [mapResult, Err.mapAddresses] + | some major => + simp only [Option.map_some] + rw [majorCtor_mapAddresses] + cases hmajor : majorCtor natLit major with + | error error => + simp [mapMajorResult, mapResult] + | ok taggedFields => + rcases taggedFields with ⟨tag, fields⟩ + simp only [mapMajorResult, + except_ok_bind, Array.getElem?_map] + cases hrule : rules[tag]? with + | none => + simp [mapResult, Err.mapAddresses] + | some rule => + simp only [Option.map_some, + MutualBlock.Concrete.RecRule.mapAddresses] + by_cases hfields : fields.length != rule.fields + · simp [hfields, mapResult, Err.mapAddresses] + · have heq : fields.length = rule.fields := by + simpa using hfields + simp only [ValueList.length_mapAddresses] + simp only [heq, bne_self_eq_false, + Bool.false_eq_true, if_false] + have henvironment : + ValueList.mapAddresses rename + (fields.reverse ++ + arguments.dropLast.reverse ++ + [.pap (.rec_ address arity) []]) = + (ValueList.mapAddresses rename fields).reverse ++ + (ValueList.mapAddresses rename arguments).dropLast.reverse ++ + [.pap (.rec_ (rename address) arity) []] := by + simp [Value.mapAddresses, + Head.mapAddresses] + rw [← henvironment] + exact smaller.eval + (fields.reverse ++ + arguments.dropLast.reverse ++ + [.pap (.rec_ address arity) []]) + rule.rhs + +/-! ## Public evaluator transport interface -/ + +/-- Expression evaluation is equivariant under every compatible context +renaming. -/ +theorem eval_mapAddresses {rename : Address → Address} + {before after : Ctx} (contexts : Ctx.Renames rename before after) + (fuel : Nat) (environment : List Value) (expression : Expr) : + IxIR0.eval after fuel (ValueList.mapAddresses rename environment) + (MutualBlock.Concrete.Expr.mapAddresses rename expression) = + mapResult rename (IxIR0.eval before fuel environment expression) := + (evalTransportAt contexts fuel).eval environment expression + +/-- Closed evaluation is the structural address image of source evaluation. -/ +theorem Ctx.run_mapAddresses {rename : Address → Address} + {before after : Ctx} (contexts : Ctx.Renames rename before after) + (expression : Expr) (fuel : Nat := 100000) : + after.run (MutualBlock.Concrete.Expr.mapAddresses rename expression) fuel = + mapResult rename (before.run expression fuel) := by + simpa [Ctx.run] using eval_mapAddresses contexts fuel [] expression + +/-! ## Certified whole-program readdressing contexts -/ + +private theorem envOfList_some_mem + {entries : List (Address × Decl)} {address : Address} + {declaration : Decl} + (hlookup : Env.ofList entries address = some declaration) : + (address, declaration) ∈ entries := by + unfold Env.ofList at hlookup + obtain ⟨entry, hfind, hvalue⟩ := Option.map_eq_some_iff.mp hlookup + rcases entry with ⟨entryAddress, entryDeclaration⟩ + have hbeq : entryAddress == address := + List.find?_some + (p := fun entry : Address × Decl => entry.1 == address) hfind + have haddress : entryAddress = address := Address.eq_of_beq hbeq + have hdeclaration : entryDeclaration = declaration := by + simpa using hvalue + subst entryAddress + subst entryDeclaration + exact List.mem_of_find?_eq_some hfind + +/-- The audited main is exactly the address-map image of the raw main. -/ +theorem Result.main_eq_mapAddresses {result : Result} + {reserved : List Address} {groups : List Group} {main : Expr} + (haudit : result.semanticAudit reserved groups main = true) : + result.main = + MutualBlock.Concrete.Expr.mapAddresses + (MutualBlock.Renaming.apply result.addressMap) main := by + simp only [Result.semanticAudit, Bool.and_eq_true] at haudit + have himage : result.imageAudit groups main = true := haudit.1.1.1 + simp only [Result.imageAudit, Bool.and_eq_true] at himage + exact (beq_iff_eq).mp himage.2 + +/-- Every successful raw environment lookup has the certified renamed lookup +in the emitted environment. -/ +theorem Result.lookup_eq_mapAddresses {result : Result} + {reserved : List Address} {groups : List Group} {main : Expr} + (haudit : result.semanticAudit reserved groups main = true) + {address : Address} {declaration : Decl} + (hlookup : Env.ofList (rawDeclarations groups) address = + some declaration) : + Env.ofList result.declarations + (MutualBlock.Renaming.apply result.addressMap address) = + some (MutualBlock.Concrete.Decl.mapAddresses + (MutualBlock.Renaming.apply result.addressMap) declaration) := by + simp only [Result.semanticAudit, Bool.and_eq_true] at haudit + have hmember : (address, declaration) ∈ rawDeclarations groups := + envOfList_some_mem hlookup + have hlookupAudit : result.lookupAudit groups = true := haudit.1.2 + simp only [Result.lookupAudit] at hlookupAudit + have hentry := (List.all_eq_true.mp hlookupAudit) + (address, declaration) hmember + cases hemitted : Env.ofList result.declarations + (MutualBlock.Renaming.apply result.addressMap address) with + | none => simp [hlookup, hemitted] at hentry + | some emitted => + have hequal : emitted = + MutualBlock.Concrete.Decl.mapAddresses + (MutualBlock.Renaming.apply result.addressMap) declaration := + (beq_iff_eq).mp (by simpa [hlookup, hemitted] using hentry) + simp [hequal] + +/-- Every successful emitted lookup is already a fixed point of the completed +address map. -/ +theorem Result.lookup_stable {result : Result} + {reserved : List Address} {groups : List Group} {main : Expr} + (haudit : result.semanticAudit reserved groups main = true) + {address : Address} {declaration : Decl} + (hlookup : Env.ofList result.declarations address = some declaration) : + MutualBlock.Concrete.Decl.mapAddresses + (MutualBlock.Renaming.apply result.addressMap) declaration = + declaration := by + simp only [Result.semanticAudit, Bool.and_eq_true] at haudit + have hmember : (address, declaration) ∈ result.declarations := + envOfList_some_mem hlookup + have hstableAudit : result.stableLookupAudit = true := haudit.2 + simp only [Result.stableLookupAudit] at hstableAudit + have hentry := (List.all_eq_true.mp hstableAudit) + (address, declaration) hmember + exact (beq_iff_eq).mp (by simpa [hlookup] using hentry) + +/-- The theorem-facing source environment retains every raw lookup and adds +only stable aliases for newly derived keys. These aliases make the forward +context relation total without changing any lookup the raw evaluator could +already perform. -/ +def Result.preAddressEnv (result : Result) (groups : List Group) : Env := + fun address => + match Env.ofList (rawDeclarations groups) address with + | some declaration => some declaration + | none => + Env.ofList result.declarations + (MutualBlock.Renaming.apply result.addressMap address) + +/-- Evaluator context for the emitted content-addressed declarations. -/ +def Result.addressedCtx (result : Result) + (oracle : Oracle := fun _ _ => none) : Ctx := + { env := Env.ofList result.declarations, oracle } + +/-- Evaluator context for the raw declarations and their stable aliases. -/ +def Result.preAddressCtx (result : Result) (groups : List Group) + (oracle : Oracle := fun _ _ => none) : Ctx := + { env := result.preAddressEnv groups, oracle } + +@[simp] theorem Result.preAddressCtx_env_of_lookup + (result : Result) (groups : List Group) (oracle : Oracle) + {address : Address} {declaration : Decl} + (hlookup : Env.ofList (rawDeclarations groups) address = + some declaration) : + (result.preAddressCtx groups oracle).env address = some declaration := by + simp [Result.preAddressCtx, Result.preAddressEnv, hlookup] + +/-- A successful audit plus an oracle-equivariance premise constructs the +complete context relation consumed by evaluator transport. -/ +theorem Result.renames_preAddressCtx {result : Result} + {reserved : List Address} {groups : List Group} {main : Expr} + (haudit : result.semanticAudit reserved groups main = true) + (beforeOracle afterOracle : Oracle) + (horacle : ∀ address arguments, + afterOracle + (MutualBlock.Renaming.apply result.addressMap address) + (ValueList.mapAddresses + (MutualBlock.Renaming.apply result.addressMap) arguments) = + (beforeOracle address arguments).map + (Value.mapAddresses + (MutualBlock.Renaming.apply result.addressMap))) : + Ctx.Renames (MutualBlock.Renaming.apply result.addressMap) + (result.preAddressCtx groups beforeOracle) + (result.addressedCtx afterOracle) := by + constructor + · intro address + simp only [Result.preAddressCtx, Result.addressedCtx, + Result.preAddressEnv] + cases hraw : Env.ofList (rawDeclarations groups) address with + | some declaration => + simpa [hraw] using result.lookup_eq_mapAddresses haudit hraw + | none => + simp only + cases hemitted : Env.ofList result.declarations + (MutualBlock.Renaming.apply result.addressMap address) with + | none => simp + | some declaration => + have hstable := result.lookup_stable haudit hemitted + simp [hstable] + · exact horacle + +/-- A concrete successful readdressing preserves a closed run exactly. -/ +theorem run_of_run_eq_ok + {reserved : List Address} {groups : List Group} {main : Expr} + {result : Result} + (hrun : Readdress.run reserved groups main = .ok result) + (beforeOracle afterOracle : Oracle) + (horacle : ∀ address arguments, + afterOracle + (MutualBlock.Renaming.apply result.addressMap address) + (ValueList.mapAddresses + (MutualBlock.Renaming.apply result.addressMap) arguments) = + (beforeOracle address arguments).map + (Value.mapAddresses + (MutualBlock.Renaming.apply result.addressMap))) + (fuel : Nat := 100000) : + (result.addressedCtx afterOracle).run result.main fuel = + mapResult (MutualBlock.Renaming.apply result.addressMap) + ((result.preAddressCtx groups beforeOracle).run main fuel) := by + have haudit := semanticAudit_of_run_eq_ok hrun + rw [result.main_eq_mapAddresses haudit] + exact Ctx.run_mapAddresses + (result.renames_preAddressCtx haudit beforeOracle afterOracle horacle) + main fuel + +/-- Closed programs with no extern oracle need no compatibility premise. -/ +theorem run_emptyOracle_of_run_eq_ok + {reserved : List Address} {groups : List Group} {main : Expr} + {result : Result} + (hrun : Readdress.run reserved groups main = .ok result) + (fuel : Nat := 100000) : + (result.addressedCtx).run result.main fuel = + mapResult (MutualBlock.Renaming.apply result.addressMap) + ((result.preAddressCtx groups).run main fuel) := by + apply run_of_run_eq_ok hrun (fun _ _ => none) (fun _ _ => none) _ fuel + intro address arguments + rfl + +/-- Successful raw execution therefore yields the structurally renamed value +under the emitted declarations. -/ +theorem run_success_of_run_eq_ok + {reserved : List Address} {groups : List Group} {main : Expr} + {result : Result} + (hrun : Readdress.run reserved groups main = .ok result) + (beforeOracle afterOracle : Oracle) + (horacle : ∀ address arguments, + afterOracle + (MutualBlock.Renaming.apply result.addressMap address) + (ValueList.mapAddresses + (MutualBlock.Renaming.apply result.addressMap) arguments) = + (beforeOracle address arguments).map + (Value.mapAddresses + (MutualBlock.Renaming.apply result.addressMap))) + {fuel : Nat} {value : Value} + (hsource : + (result.preAddressCtx groups beforeOracle).run main fuel = .ok value) : + (result.addressedCtx afterOracle).run result.main fuel = + .ok (Value.mapAddresses + (MutualBlock.Renaming.apply result.addressMap) value) := by + rw [run_of_run_eq_ok hrun beforeOracle afterOracle horacle fuel, hsource] + rfl + +end Readdress + +end Ix.Compiler.IxIR0 diff --git a/Ix/Compiler/IxIR0/Recursion.lean b/Ix/Compiler/IxIR0/Recursion.lean new file mode 100644 index 000000000..4b280ec80 --- /dev/null +++ b/Ix/Compiler/IxIR0/Recursion.lean @@ -0,0 +1,286 @@ +import Ix.Compiler.IxIR0.Serialize +import Ix.Compiler.IxIR0.Eval + +/-! +# Checked recovery of a list accumulator recursor + +The first recovery schema recognizes an eager, immediate-tail `below` fold. +Each source step constructs a tuple containing a function and the recursively +computed tuple. Only its function projection is used by the selected entry. +The replacement absorbs the accumulator before the major premise and invokes +the recursor value directly in the cons rule. + +Recognition is deliberately bounded to closed Nat-list entries, optionally +retaining the input in a returned pair. The recursor simulation itself covers +arbitrary list elements and accumulators. This is a first schema, not a generic +`brecOn` specializer. Every declaration, binder, projection, and entry use is +checked against the exact erased input; an unrecognized input is unchanged. +-/ + +namespace Ix.Compiler.IxIR0.Recursion + +open Ix.Compiler.Ixon (Address) + +structure Schema where + nil : Address + cons : Address + pack : Address + unit : Address + recursor : Address + alias : Address + base : Address + step : Address + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr + +def app2 (f x y : Expr) : Expr := .app (.app f x) y + +/-- The source gate's erased-argument application. For an open `e`, indices +must already include this binder. The templates below spell those indices out. +-/ +def ghost (e : Expr) : Expr := .app (.lam .many e) .erased + +def consExpr (s : Schema) (head tail : Expr) : Expr := + app2 (.ref s.cons) head tail + +def packExpr (s : Schema) (fn below : Expr) : Expr := + app2 (.ref s.pack) fn below + +/-- Environment after applying the captured function: +`accumulator, erased argument, below, tail, head`. -/ +def stepBody (s : Schema) : Expr := + .app (.proj 0 (.var 2)) (consExpr s (.var 4) (.var 0)) + +def baseExpr (s : Schema) : Expr := + packExpr s (ghost (.lam .many (.var 0))) (ghost (.ref s.unit)) + +def stepExpr (s : Schema) : Expr := + .lam .many (.lam .many (.lam .many + (packExpr s (ghost (.lam .many (stepBody s))) (.var 0)))) + +/-- Ordinary immediate-tail structural recursion, with base and step minors. +The cons rule evaluates its recursive argument eagerly before the step. +Its environment is `tail, head, step, base, recursive self`. -/ +def literalRecursor (_s : Schema) : Decl := + .recursor 2 false #[ + { fields := 0, rhs := .var 1 }, + { fields := 2 + rhs := .app (app2 (.var 2) (.var 1) (.var 0)) + (.app (app2 (.var 4) (.var 3) (.var 2)) (.var 0)) }] + +/-- The accumulator precedes the major. The recursive call is saturated and +in tail position, which the existing ownership and CFG lowerers preserve. -/ +def directRecursor (s : Schema) : Decl := + .recursor 1 false #[ + { fields := 0, rhs := .var 0 }, + { fields := 2 + rhs := app2 (.var 3) (consExpr s (.var 1) (.var 2)) (.var 0) }] + +def literalList (s : Schema) : List Nat → Expr + | [] => ghost (.ref s.nil) + | n :: ns => consExpr s (ghost (.lit (.nat n))) (literalList s ns) + +def directList (s : Schema) : List Nat → Expr + | [] => .ref s.nil + | n :: ns => consExpr s (.lit (.nat n)) (directList s ns) + +def literalCall (s : Schema) (major accumulator : Expr) : Expr := + .app (.proj 0 (.app (app2 (.ref s.alias) (.ref s.base) (.ref s.step)) major)) accumulator + +def directCall (address : Address) (major accumulator : Expr) : Expr := + app2 (.ref address) accumulator major + +structure Plan where + schema : Schema + values : List Nat + /-- A returned pair retains an alias to the input and makes every reset + cold. `none` returns just the reversed list. -/ + retainedAlias : Option Address := none + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr + +def Plan.literalMain (p : Plan) : Expr := + let s := p.schema + match p.retainedAlias with + | none => literalCall s (literalList s p.values) (ghost (.ref s.nil)) + | some pair => + .letE .many (literalList s p.values) + (app2 (.ref pair) (literalCall s (.var 0) (ghost (.ref s.nil))) (.var 0)) + +def Plan.directMain (p : Plan) (address : Address) : Expr := + let s := p.schema + match p.retainedAlias with + | none => directCall address (directList s p.values) (.ref s.nil) + | some pair => + .letE .many (directList s p.values) + (app2 (.ref pair) (directCall address (.var 0) (.ref s.nil)) (.var 0)) + +/-- All facts read by the recursor simulation, checked against first-binding +wins lookup in the actual source environment. -/ +structure SourceMatches (env : Env) (s : Schema) : Prop where + nil : env s.nil = some (.ctor 0 0) + cons : env s.cons = some (.ctor 1 2) + pack : env s.pack = some (.ctor 0 2) + unit : env s.unit = some (.ctor 1 0) + recursor : env s.recursor = some (literalRecursor s) + alias : env s.alias = some (.defn .shared (.ref s.recursor)) + base : env s.base = some (.defn .shared (baseExpr s)) + step : env s.step = some (.defn .shared (stepExpr s)) + +instance (env : Env) (s : Schema) : Decidable (SourceMatches env s) := + decidable_of_iff + (env s.nil = some (.ctor 0 0) ∧ env s.cons = some (.ctor 1 2) ∧ + env s.pack = some (.ctor 0 2) ∧ env s.unit = some (.ctor 1 0) ∧ + env s.recursor = some (literalRecursor s) ∧ + env s.alias = some (.defn .shared (.ref s.recursor)) ∧ + env s.base = some (.defn .shared (baseExpr s)) ∧ + env s.step = some (.defn .shared (stepExpr s))) + ⟨fun h => ⟨h.1, h.2.1, h.2.2.1, h.2.2.2.1, h.2.2.2.2.1, + h.2.2.2.2.2.1, h.2.2.2.2.2.2.1, h.2.2.2.2.2.2.2⟩, + fun h => ⟨h.nil, h.cons, h.pack, h.unit, h.recursor, h.alias, h.base, h.step⟩⟩ + +def Plan.aliasMatches (p : Plan) (env : Env) : Prop := + match p.retainedAlias with + | none => True + | some pair => env pair = some (.ctor 0 2) + +instance (p : Plan) (env : Env) : Decidable (p.aliasMatches env) := by + unfold Plan.aliasMatches + split <;> infer_instance + +/-- A proposal cannot supply a replacement body. Checking fixes both source +and target to the proved schema. Proof fields erase from generated code. -/ +structure Checked (declarations : List (Address × Decl)) (main : Expr) where + plan : Plan + root : Address + mainEq : main = .ref root + source : SourceMatches (Env.ofList declarations) plan.schema + entry : Env.ofList declarations root = some (.defn .shared plan.literalMain) + alias : plan.aliasMatches (Env.ofList declarations) + +def check (declarations : List (Address × Decl)) (main : Expr) + (plan : Plan) : Option (Checked declarations main) := + match main with + | .ref root => + if hs : SourceMatches (Env.ofList declarations) plan.schema then + if he : Env.ofList declarations root = some (.defn .shared plan.literalMain) then + if ha : plan.aliasMatches (Env.ofList declarations) then + some { plan, root, mainEq := rfl, source := hs, entry := he, alias := ha } + else none + else none + else none + | _ => none + +private def ghostRef? : Expr → Option Address + | .app (.lam .many (.ref a)) .erased => some a + | _ => none + +private def literalList? (s : Schema) : Expr → Option (List Nat) + | .app (.lam .many (.ref a)) .erased => + if a == s.nil then some [] else none + | .app (.app (.ref a) (.app (.lam .many (.lit (.nat n))) .erased)) tail => + if a == s.cons then (n :: ·) <$> literalList? s tail else none + | _ => none + +private def call? : Expr → Option (Address × Address × Address × Expr × Address) + | .app (.proj 0 (.app (.app (.app (.ref alias) (.ref base)) (.ref step)) major)) acc => do + return (alias, base, step, major, ← ghostRef? acc) + | _ => none + +/-- The recognizer only proposes addresses and a parsed input. `check` then +compares the complete rules and entry, including every use of `below`. -/ +def propose (declarations : List (Address × Decl)) (main : Expr) : Option Plan := do + let .ref root := main | none + let env := Env.ofList declarations + let some (.defn .shared body) := env root | none + let (alias, base, step, major, nil, retainedAlias) ← match body with + | .letE .many major (.app (.app (.ref pair) call) (.var 0)) => do + let (alias, base, step, .var 0, nil) ← call? call | none + pure (alias, base, step, major, nil, some pair) + | body => do + let (alias, base, step, major, nil) ← call? body + pure (alias, base, step, major, nil, none) + let some (.defn .shared (.ref recursor)) := env alias | none + let some (.recursor 2 false _) := env recursor | none + let some (.defn .shared (.app (.app (.ref pack) _) unitExpr)) := env base | none + let unit ← ghostRef? unitExpr + let some (.defn .shared (.lam .many (.lam .many (.lam .many + (.app (.app _ fn) _))))) := env step | none + let .app (.lam .many (.lam .many body)) .erased := fn | none + let .app _ (.app (.app (.ref cons) _) _) := body | none + let schema : Schema := { nil, cons, pack, unit, recursor, alias, base, step } + let values ← literalList? schema major + return { schema, values, retainedAlias } + +inductive Skip where + | unrecognized + | rejectedProposal + | addressConflict + | rejectedTarget + deriving BEq, Repr + +/-- The generated declaration has its own canonical IxIR₀ identity. Source +constructor identities are stable; source recursor and entry keys are never +reused for changed bodies. -/ +def targetDeclarations (p : Plan) (address : Address) : List (Address × Decl) := + [(p.schema.nil, .ctor 0 0), (p.schema.cons, .ctor 1 2), + (address, directRecursor p.schema)] ++ + p.retainedAlias.toList.map (fun pair => (pair, .ctor 0 2)) + +structure TargetMatches (env : Env) (p : Plan) (address : Address) : Prop where + nil : env p.schema.nil = some (.ctor 0 0) + cons : env p.schema.cons = some (.ctor 1 2) + recursor : env address = some (directRecursor p.schema) + alias : p.aliasMatches env + +instance (env : Env) (p : Plan) (address : Address) : + Decidable (TargetMatches env p address) := + decidable_of_iff + (env p.schema.nil = some (.ctor 0 0) ∧ env p.schema.cons = some (.ctor 1 2) ∧ + env address = some (directRecursor p.schema) ∧ p.aliasMatches env) + ⟨fun h => ⟨h.1, h.2.1, h.2.2.1, h.2.2.2⟩, + fun h => ⟨h.nil, h.cons, h.recursor, h.alias⟩⟩ + +structure Recovered (declarations : List (Address × Decl)) (main : Expr) where + checked : Checked declarations main + address : Address + addressed : address = (directRecursor checked.plan.schema).address + fresh : address ∉ declarations.map (·.1) + target : TargetMatches (Env.ofList (targetDeclarations checked.plan address)) + checked.plan address + +inductive Selection (declarations : List (Address × Decl)) (main : Expr) where + | literal (reason : Skip) + | recovered (result : Recovered declarations main) + +def Selection.declarations {declarations : List (Address × Decl)} {main : Expr} : + Selection declarations main → List (Address × Decl) + | .literal _ => declarations + | .recovered result => targetDeclarations result.checked.plan result.address + +def Selection.main {declarations : List (Address × Decl)} {main : Expr} : + Selection declarations main → Expr + | .literal _ => main + | .recovered result => result.checked.plan.directMain result.address + +/-- Untrusted proposals cross the exact checker; failures preserve the input +literally. Canonical naming and target lookup are checked independently. -/ +def selectWith (declarations : List (Address × Decl)) (main : Expr) + (proposal : Option Plan) : Selection declarations main := + match proposal with + | none => .literal .unrecognized + | some plan => + match check declarations main plan with + | none => .literal .rejectedProposal + | some checked => + let address := (directRecursor checked.plan.schema).address + if hfresh : address ∉ declarations.map (·.1) then + if ht : TargetMatches + (Env.ofList (targetDeclarations checked.plan address)) checked.plan address then + .recovered { checked, address, addressed := rfl, fresh := hfresh, target := ht } + else .literal .rejectedTarget + else .literal .addressConflict + +def select (declarations : List (Address × Decl)) (main : Expr) : + Selection declarations main := + selectWith declarations main (propose declarations main) + +end Ix.Compiler.IxIR0.Recursion diff --git a/Ix/Compiler/IxIR0/RecursionSim.lean b/Ix/Compiler/IxIR0/RecursionSim.lean new file mode 100644 index 000000000..4ea570de7 --- /dev/null +++ b/Ix/Compiler/IxIR0/RecursionSim.lean @@ -0,0 +1,451 @@ +import Ix.Compiler.IxIR0.Recursion +import Ix.Compiler.IxIR0.Mono + +/-! +# Forward simulation for the first recovered recursor + +Fuel only witnesses termination. The proof constructs successful executions +of the eager tuple fold and the derived accumulator recursor for every finite +list, then uses determinism to transport any successful literal execution. +No evaluator, cost counter, or ownership rule is changed by recovery. +-/ + +namespace Ix.Compiler.IxIR0.Recursion + +open Ix.Compiler.Ixon (Address Uses) + +def Evaluates (ctx : Ctx) (env : List Value) (expr : Expr) (value : Value) : Prop := + ∃ fuel, eval ctx fuel env expr = .ok value + +def Applies (ctx : Ctx) (fn arg value : Value) : Prop := + ∃ fuel, apply ctx fuel fn arg = .ok value + +@[simp] private theorem bindOk {α β : Type} (a : α) (f : α → Except Err β) : + (Except.ok a >>= f) = f a := rfl + +theorem Evaluates.unique {ctx : Ctx} {env : List Value} {expr : Expr} {v w : Value} + (hv : Evaluates ctx env expr v) (hw : Evaluates ctx env expr w) : v = w := by + obtain ⟨fv, hv⟩ := hv + obtain ⟨fw, hw⟩ := hw + have hv' := eval_mono (fuel' := fv + fw) (by omega) hv + have hw' := eval_mono (fuel' := fv + fw) (by omega) hw + exact Except.ok.inj (hv'.symm.trans hw') + +theorem evaluatesVar {ctx : Ctx} {env : List Value} {i : Nat} {v : Value} + (h : env[i]? = some v) : Evaluates ctx env (.var i) v := by + refine ⟨1, ?_⟩ + simp [eval, h] + +theorem evaluatesLam (ctx : Ctx) (env : List Value) (u : Uses) (body : Expr) : + Evaluates ctx env (.lam u body) (.clos u env body) := + ⟨1, by simp [eval]⟩ + +theorem evaluatesErased (ctx : Ctx) (env : List Value) : + Evaluates ctx env .erased .erased := ⟨1, by simp [eval]⟩ + +theorem evaluatesLit (ctx : Ctx) (env : List Value) (l : Literal) : + Evaluates ctx env (.lit l) (.lit l) := ⟨1, by simp [eval]⟩ + +theorem evaluatesDef {ctx : Ctx} {env : List Value} {address : Address} + {world : Ixon.Owned} {body : Expr} {v : Value} + (hdecl : ctx.env address = some (.defn world body)) + (hbody : Evaluates ctx [] body v) : Evaluates ctx env (.ref address) v := by + obtain ⟨fuel, hbody⟩ := hbody + refine ⟨fuel + 1, ?_⟩ + rw [eval.eq_def] + simpa only [hdecl] using hbody + +theorem evaluatesRecursor {ctx : Ctx} {env : List Value} {address : Address} + {arity : Nat} {natLit : Bool} {rules : Array RecRule} + (hdecl : ctx.env address = some (.recursor arity natLit rules)) : + Evaluates ctx env (.ref address) (.pap (.rec_ address (arity + 1)) []) := by + refine ⟨1, ?_⟩ + simp [eval, hdecl] + +theorem evaluatesNullary {ctx : Ctx} {env : List Value} {address : Address} {tag : Nat} + (hdecl : ctx.env address = some (.ctor tag 0)) : + Evaluates ctx env (.ref address) (.ctor address tag []) := by + refine ⟨4, ?_⟩ + simp [eval, saturate, fire, Head.arity, hdecl] + +theorem evaluatesBinary {ctx : Ctx} {env : List Value} {address : Address} {tag : Nat} + (hdecl : ctx.env address = some (.ctor tag 2)) : + Evaluates ctx env (.ref address) (.pap (.ctor address tag 2) []) := by + refine ⟨2, ?_⟩ + simp [eval, saturate, Head.arity, hdecl] + +theorem appliesBinaryFirst (ctx : Ctx) (address : Address) (tag : Nat) (v : Value) : + Applies ctx (.pap (.ctor address tag 2) []) v + (.pap (.ctor address tag 2) [v]) := by + refine ⟨2, ?_⟩ + simp [apply, saturate, Head.arity] + +theorem appliesBinaryLast (ctx : Ctx) (address : Address) (tag : Nat) (v w : Value) : + Applies ctx (.pap (.ctor address tag 2) [v]) w (.ctor address tag [v, w]) := by + refine ⟨4, ?_⟩ + simp [apply, saturate, fire, Head.arity] + +theorem appliesClosure {ctx : Ctx} {env : List Value} {u : Uses} {body : Expr} + {arg v : Value} (h : Evaluates ctx (arg :: env) body v) : + Applies ctx (.clos u env body) arg v := by + obtain ⟨fuel, h⟩ := h + refine ⟨fuel + 1, ?_⟩ + rw [apply.eq_def] + exact h + +theorem evaluatesApp {ctx : Ctx} {env : List Value} {fn arg : Expr} {f a v : Value} + (hf : Evaluates ctx env fn f) (ha : Evaluates ctx env arg a) + (happly : Applies ctx f a v) : Evaluates ctx env (.app fn arg) v := by + obtain ⟨ff, hf⟩ := hf + obtain ⟨fa, ha⟩ := ha + obtain ⟨fp, happly⟩ := happly + have hf' := eval_mono (fuel' := ff + fa + fp) (by omega) hf + have ha' := eval_mono (fuel' := ff + fa + fp) (by omega) ha + have hp' := apply_mono (fuel' := ff + fa + fp) (by omega) happly + refine ⟨ff + fa + fp + 1, ?_⟩ + rw [eval.eq_def] + simp only [hf', ha', hp', bindOk] + +theorem evaluatesLet {ctx : Ctx} {env : List Value} {u : Uses} {val body : Expr} + {w v : Value} (hv : Evaluates ctx env val w) + (hb : Evaluates ctx (w :: env) body v) : Evaluates ctx env (.letE u val body) v := by + obtain ⟨fv, hv⟩ := hv + obtain ⟨fb, hb⟩ := hb + have hv' := eval_mono (fuel' := fv + fb) (by omega) hv + have hb' := eval_mono (fuel' := fv + fb) (by omega) hb + refine ⟨fv + fb + 1, ?_⟩ + rw [eval.eq_def] + simp only [hv', hb', bindOk] + +theorem evaluatesFirst {ctx : Ctx} {env : List Value} {expr : Expr} + {address : Address} {tag : Nat} {v w : Value} + (h : Evaluates ctx env expr (.ctor address tag [v, w])) : + Evaluates ctx env (.proj 0 expr) v := by + obtain ⟨fuel, h⟩ := h + refine ⟨fuel + 1, ?_⟩ + rw [eval.eq_def] + simp only [h, bindOk, List.getElem?_cons_zero] + +theorem evaluatesGhost {ctx : Ctx} {env : List Value} {body : Expr} {v : Value} + (h : Evaluates ctx (.erased :: env) body v) : + Evaluates ctx env (ghost body) v := + evaluatesApp (evaluatesLam ctx env .many body) (evaluatesErased ctx env) + (appliesClosure h) + +theorem evaluatesCtor2 {ctx : Ctx} {env : List Value} {address : Address} + {tag : Nat} {left right : Expr} {v w : Value} + (hdecl : ctx.env address = some (.ctor tag 2)) + (hv : Evaluates ctx env left v) (hw : Evaluates ctx env right w) : + Evaluates ctx env (app2 (.ref address) left right) (.ctor address tag [v, w]) := + evaluatesApp + (evaluatesApp (evaluatesBinary hdecl) hv (appliesBinaryFirst ctx address tag v)) + hw (appliesBinaryLast ctx address tag v w) + +/-- One actual recursor dispatch, with the evaluator's field and pre-major +environment order. This lemma does not assume any recursive progress. -/ +theorem appliesRecursor {ctx : Ctx} {address majorAddress : Address} + {numArgs tag : Nat} {rules : Array RecRule} {rule : RecRule} + {pre fields : List Value} {v : Value} + (hdecl : ctx.env address = some (.recursor numArgs false rules)) + (hpre : pre.length = numArgs) (hrule : rules[tag]? = some rule) + (hfields : fields.length = rule.fields) + (hbody : Evaluates ctx + (fields.reverse ++ pre.reverse ++ [.pap (.rec_ address (numArgs + 1)) []]) rule.rhs v) : + Applies ctx (.pap (.rec_ address (numArgs + 1)) pre) + (.ctor majorAddress tag fields) v := by + obtain ⟨fuel, hbody⟩ := hbody + refine ⟨fuel + 3, ?_⟩ + rw [apply.eq_def] + dsimp only + rw [saturate.eq_def] + simp only [Head.arity, List.length_append, List.length_singleton, hpre, + beq_self_eq_true, ite_true] + rw [fire.eq_def] + simpa [hdecl, majorCtor, hrule, hfields] using hbody + +theorem appliesAccumulator (ctx : Ctx) (address : Address) (v : Value) : + Applies ctx (.pap (.rec_ address 2) []) v (.pap (.rec_ address 2) [v]) := by + refine ⟨2, ?_⟩ + simp [apply, saturate, Head.arity] + +def listValue (s : Schema) : List Value → Value + | [] => .ctor s.nil 0 [] + | v :: vs => .ctor s.cons 1 [v, listValue s vs] + +def baseValue (s : Schema) : Value := + .ctor s.pack 0 [.clos .many [.erased] (.var 0), .ctor s.unit 1 []] + +def stepValue (s : Schema) : Value := + .clos .many [] (.lam .many (.lam .many + (packExpr s (ghost (.lam .many (stepBody s))) (.var 0)))) + +/-- The literal evaluator retains every recursively built below tuple in +the next tuple and in the function's closure environment. -/ +def belowValue (s : Schema) : List Value → Value + | [] => baseValue s + | v :: vs => + let below := belowValue s vs + .ctor s.pack 0 + [.clos .many [.erased, below, listValue s vs, v] (stepBody s), below] + +def belowFunction (s : Schema) : List Value → Value + | [] => .clos .many [.erased] (.var 0) + | v :: vs => + .clos .many [.erased, belowValue s vs, listValue s vs, v] (stepBody s) + +def belowTail (s : Schema) : List Value → Value + | [] => .ctor s.unit 1 [] + | _ :: vs => belowValue s vs + +theorem belowValue_eq (s : Schema) (vs : List Value) : + belowValue s vs = .ctor s.pack 0 [belowFunction s vs, belowTail s vs] := by + cases vs <;> rfl + +def reverseOnto (s : Schema) : List Value → Value → Value + | [], acc => acc + | v :: vs, acc => reverseOnto s vs (.ctor s.cons 1 [v, acc]) + +theorem reverseOnto_listValue (s : Schema) (vs acc : List Value) : + reverseOnto s vs (listValue s acc) = listValue s (vs.reverse ++ acc) := by + induction vs generalizing acc with + | nil => rfl + | cons v vs ih => + change reverseOnto s vs (listValue s (v :: acc)) = _ + rw [ih] + simp [List.reverse_cons, List.append_assoc] + +theorem evaluatesBase {ctx : Ctx} {s : Schema} (hs : SourceMatches ctx.env s) + (env : List Value) : Evaluates ctx env (.ref s.base) (baseValue s) := + evaluatesDef hs.base (evaluatesCtor2 hs.pack + (evaluatesGhost (evaluatesLam _ _ _ _)) (evaluatesGhost (evaluatesNullary hs.unit))) + +theorem evaluatesStep {ctx : Ctx} {s : Schema} (hs : SourceMatches ctx.env s) + (env : List Value) : Evaluates ctx env (.ref s.step) (stepValue s) := + evaluatesDef hs.step (evaluatesLam _ _ _ _) + +theorem appliesTernaryFirst (ctx : Ctx) (address : Address) (v : Value) : + Applies ctx (.pap (.rec_ address 3) []) v (.pap (.rec_ address 3) [v]) := by + refine ⟨2, ?_⟩ + simp [apply, saturate, Head.arity] + +theorem appliesTernaryNext (ctx : Ctx) (address : Address) (v w : Value) : + Applies ctx (.pap (.rec_ address 3) [v]) w (.pap (.rec_ address 3) [v, w]) := by + refine ⟨2, ?_⟩ + simp [apply, saturate, Head.arity] + +theorem appliesStepFirst (ctx : Ctx) (s : Schema) (head : Value) : + Applies ctx (stepValue s) head + (.clos .many [head] (.lam .many + (packExpr s (ghost (.lam .many (stepBody s))) (.var 0)))) := + appliesClosure (evaluatesLam _ _ _ _) + +theorem appliesStepNext (ctx : Ctx) (s : Schema) (head tail : Value) : + Applies ctx (.clos .many [head] (.lam .many + (packExpr s (ghost (.lam .many (stepBody s))) (.var 0)))) tail + (.clos .many [tail, head] (packExpr s (ghost (.lam .many (stepBody s))) (.var 0))) := + appliesClosure (evaluatesLam _ _ _ _) + +theorem appliesStepLast {ctx : Ctx} {s : Schema} (hs : SourceMatches ctx.env s) + (head tail below : Value) : + Applies ctx (.clos .many [tail, head] + (packExpr s (ghost (.lam .many (stepBody s))) (.var 0))) below + (.ctor s.pack 0 [.clos .many [.erased, below, tail, head] (stepBody s), below]) := + appliesClosure (evaluatesCtor2 hs.pack + (evaluatesGhost (evaluatesLam _ _ _ _)) (evaluatesVar (by rfl))) + +/-- The literal fold is total on finite constructor lists. Every recursive +call in this proof is the evaluator's actual eager call on the tail. -/ +theorem sourceTuple {ctx : Ctx} {s : Schema} (hs : SourceMatches ctx.env s) + (vs : List Value) : + Applies ctx (.pap (.rec_ s.recursor 3) [baseValue s, stepValue s]) + (listValue s vs) (belowValue s vs) := by + induction vs with + | nil => + apply appliesRecursor hs.recursor (pre := [baseValue s, stepValue s]) + (tag := 0) (by rfl) (by rfl) (by rfl) + exact evaluatesVar (by rfl) + | cons v vs ih => + apply appliesRecursor hs.recursor (pre := [baseValue s, stepValue s]) + (tag := 1) (by rfl) (by rfl) (by rfl) + exact evaluatesApp + (evaluatesApp + (evaluatesApp (evaluatesVar (by rfl)) (evaluatesVar (by rfl)) + (appliesStepFirst ctx s v)) + (evaluatesVar (by rfl)) (appliesStepNext ctx s v (listValue s vs))) + (evaluatesApp + (evaluatesApp + (evaluatesApp (evaluatesVar (by rfl)) (evaluatesVar (by rfl)) + (appliesTernaryFirst ctx s.recursor (baseValue s))) + (evaluatesVar (by rfl)) (appliesTernaryNext ctx s.recursor (baseValue s) (stepValue s))) + (evaluatesVar (by rfl)) ih) + (appliesStepLast hs v (listValue s vs) (belowValue s vs)) + +/-- Applying the literal function demands only the immediate tail's function +projection. Its other below data remains observationally irrelevant. -/ +theorem sourceFunction {ctx : Ctx} {s : Schema} (hs : SourceMatches ctx.env s) + (vs : List Value) (acc : Value) : + Applies ctx (belowFunction s vs) acc (reverseOnto s vs acc) := by + induction vs generalizing acc with + | nil => exact appliesClosure (evaluatesVar (by rfl)) + | cons v vs ih => + apply appliesClosure + apply evaluatesApp + (evaluatesFirst (address := s.pack) (tag := 0) (w := belowTail s vs) ?_) + (evaluatesCtor2 hs.cons (evaluatesVar (by rfl)) (evaluatesVar (by rfl))) + (ih (.ctor s.cons 1 [v, acc])) + rw [← belowValue_eq] + exact evaluatesVar (by rfl) + +/-- The derived recursor computes the same accumulator fold by direct self +application. No tuple or function value is allocated by its rules. -/ +theorem directLoop {ctx : Ctx} {s : Schema} {address : Address} + (hcons : ctx.env s.cons = some (.ctor 1 2)) + (hrec : ctx.env address = some (directRecursor s)) + (vs : List Value) (acc : Value) : + Applies ctx (.pap (.rec_ address 2) [acc]) (listValue s vs) + (reverseOnto s vs acc) := by + induction vs generalizing acc with + | nil => + apply appliesRecursor hrec (pre := [acc]) (tag := 0) (by rfl) (by rfl) (by rfl) + exact evaluatesVar (by rfl) + | cons v vs ih => + apply appliesRecursor hrec (pre := [acc]) (tag := 1) (by rfl) (by rfl) (by rfl) + exact evaluatesApp + (evaluatesApp (evaluatesVar (by rfl)) + (evaluatesCtor2 hcons (evaluatesVar (by rfl)) (evaluatesVar (by rfl))) + (appliesAccumulator ctx address (.ctor s.cons 1 [v, acc]))) + (evaluatesVar (by rfl)) (ih (.ctor s.cons 1 [v, acc])) + +theorem literalRun {ctx : Ctx} {s : Schema} {env : List Value} + {major accumulator : Expr} {vs : List Value} {acc : Value} + (hs : SourceMatches ctx.env s) + (hmajor : Evaluates ctx env major (listValue s vs)) + (hacc : Evaluates ctx env accumulator acc) : + Evaluates ctx env (literalCall s major accumulator) (reverseOnto s vs acc) := by + have htuple := evaluatesApp + (evaluatesApp + (evaluatesApp (evaluatesDef hs.alias (evaluatesRecursor hs.recursor)) + (evaluatesBase hs env) (appliesTernaryFirst ctx s.recursor (baseValue s))) + (evaluatesStep hs env) (appliesTernaryNext ctx s.recursor (baseValue s) (stepValue s))) + hmajor (sourceTuple hs vs) + rw [belowValue_eq] at htuple + exact evaluatesApp (evaluatesFirst htuple) hacc (sourceFunction hs vs acc) + +theorem directRun {ctx : Ctx} {s : Schema} {address : Address} {env : List Value} + {major accumulator : Expr} {vs : List Value} {acc : Value} + (hcons : ctx.env s.cons = some (.ctor 1 2)) + (hrec : ctx.env address = some (directRecursor s)) + (hmajor : Evaluates ctx env major (listValue s vs)) + (hacc : Evaluates ctx env accumulator acc) : + Evaluates ctx env (directCall address major accumulator) (reverseOnto s vs acc) := + evaluatesApp + (evaluatesApp (evaluatesRecursor hrec) hacc (appliesAccumulator ctx address acc)) + hmajor (directLoop hcons hrec vs acc) + +/-- The schema theorem is independent of ground input syntax: it covers +arbitrary element values, arbitrary accumulators, and every successful +literal fuel. Source and target execute the actual IxIR₀ evaluator. -/ +theorem recursorForwardSimulation {source target : Ctx} {s : Schema} {address : Address} + (hs : SourceMatches source.env s) + (hcons : target.env s.cons = some (.ctor 1 2)) + (hrec : target.env address = some (directRecursor s)) + (vs : List Value) (acc : Value) {sourceFuel : Nat} {value : Value} + (hsource : eval source sourceFuel [acc, listValue s vs] + (literalCall s (.var 1) (.var 0)) = .ok value) : + ∃ targetFuel, eval target targetFuel [acc, listValue s vs] + (directCall address (.var 1) (.var 0)) = .ok value := by + have hliteral := literalRun hs (vs := vs) (acc := acc) + (evaluatesVar (env := [acc, listValue s vs]) (i := 1) (by rfl)) + (evaluatesVar (i := 0) (by rfl)) + have hvalue := Evaluates.unique ⟨sourceFuel, hsource⟩ hliteral + rw [hvalue] + exact directRun hcons hrec (evaluatesVar (by rfl)) (evaluatesVar (by rfl)) + +def natValues (ns : List Nat) : List Value := ns.map (fun n => .lit (.nat n)) + +theorem literalListRun {ctx : Ctx} {s : Schema} (hs : SourceMatches ctx.env s) + (env : List Value) (ns : List Nat) : + Evaluates ctx env (literalList s ns) (listValue s (natValues ns)) := by + induction ns with + | nil => exact evaluatesGhost (evaluatesNullary hs.nil) + | cons n ns ih => + exact evaluatesCtor2 hs.cons (evaluatesGhost (evaluatesLit _ _ _)) ih + +theorem directListRun {ctx : Ctx} {s : Schema} + (hnil : ctx.env s.nil = some (.ctor 0 0)) + (hcons : ctx.env s.cons = some (.ctor 1 2)) (env : List Value) (ns : List Nat) : + Evaluates ctx env (directList s ns) (listValue s (natValues ns)) := by + induction ns with + | nil => exact evaluatesNullary hnil + | cons n ns ih => exact evaluatesCtor2 hcons (evaluatesLit _ _ _) ih + +def Plan.value (p : Plan) : Value := + let reversed := reverseOnto p.schema (natValues p.values) (.ctor p.schema.nil 0 []) + match p.retainedAlias with + | none => reversed + | some pair => .ctor pair 0 [reversed, listValue p.schema (natValues p.values)] + +theorem literalMainRun {ctx : Ctx} {p : Plan} + (hs : SourceMatches ctx.env p.schema) (ha : p.aliasMatches ctx.env) : + Evaluates ctx [] p.literalMain p.value := by + cases hpair : p.retainedAlias with + | none => + simpa only [Plan.literalMain, Plan.value, hpair] using + literalRun hs (literalListRun hs [] p.values) (evaluatesGhost (evaluatesNullary hs.nil)) + | some pair => + have hp : ctx.env pair = some (.ctor 0 2) := by + simpa only [Plan.aliasMatches, hpair] using ha + simp only [Plan.literalMain, Plan.value, hpair] + exact evaluatesLet (literalListRun hs [] p.values) + (evaluatesCtor2 hp + (literalRun hs (evaluatesVar (by rfl)) (evaluatesGhost (evaluatesNullary hs.nil))) + (evaluatesVar (by rfl))) + +theorem directMainRun {ctx : Ctx} {p : Plan} {address : Address} + (ht : TargetMatches ctx.env p address) : + Evaluates ctx [] (p.directMain address) p.value := by + cases hpair : p.retainedAlias with + | none => + simpa only [Plan.directMain, Plan.value, hpair] using + directRun ht.cons ht.recursor (directListRun ht.nil ht.cons [] p.values) + (evaluatesNullary ht.nil) + | some pair => + have hp : ctx.env pair = some (.ctor 0 2) := by + simpa only [Plan.aliasMatches, hpair] using ht.alias + simp only [Plan.directMain, Plan.value, hpair] + exact evaluatesLet (directListRun ht.nil ht.cons [] p.values) + (evaluatesCtor2 hp + (directRun ht.cons ht.recursor (evaluatesVar (by rfl)) (evaluatesNullary ht.nil)) + (evaluatesVar (by rfl))) + +theorem Checked.sourceEvaluates {declarations : List (Address × Decl)} {main : Expr} + (checked : Checked declarations main) : + Evaluates { env := Env.ofList declarations } [] main checked.plan.value := by + simpa only [checked.mainEq] using + evaluatesDef (env := []) checked.entry (literalMainRun checked.source checked.alias) + +/-- Exact checked whole-entry preservation, including removal of the +source-only argument wrappers and optional retention of the input alias. -/ +theorem Recovered.forwardSimulation {declarations : List (Address × Decl)} {main : Expr} + (result : Recovered declarations main) {sourceFuel : Nat} {value : Value} + (hsource : eval { env := Env.ofList declarations } sourceFuel [] main = .ok value) : + ∃ targetFuel, + eval { env := Env.ofList (targetDeclarations result.checked.plan result.address) } + targetFuel [] (result.checked.plan.directMain result.address) = .ok value := by + have hvalue := Evaluates.unique ⟨sourceFuel, hsource⟩ result.checked.sourceEvaluates + rw [hvalue] + exact directMainRun result.target + +/-- Failed or unsupported proposals keep the literal execution; successful +proposals use the exact checked replacement. Callers supply no rewrite facts. +-/ +theorem Selection.forwardSimulation {declarations : List (Address × Decl)} {main : Expr} + (selection : Selection declarations main) {sourceFuel : Nat} {value : Value} + (hsource : eval { env := Env.ofList declarations } sourceFuel [] main = .ok value) : + ∃ targetFuel, eval { env := Env.ofList selection.declarations } + targetFuel [] selection.main = .ok value := by + cases selection with + | literal reason => exact ⟨sourceFuel, hsource⟩ + | recovered result => exact result.forwardSimulation hsource + +end Ix.Compiler.IxIR0.Recursion diff --git a/Ix/Compiler/IxIR0/RecursorModes.lean b/Ix/Compiler/IxIR0/RecursorModes.lean new file mode 100644 index 000000000..1a6c3c582 --- /dev/null +++ b/Ix/Compiler/IxIR0/RecursorModes.lean @@ -0,0 +1,44 @@ +import Ix.Compiler.IxIR0.Serialize + +/-! Explicit recursor instantiation metadata. Ordinary IxIR₀ declarations +retain their existing syntax and evaluator. The instantiation identity commits +to both that declaration and every argument, field, and result world. -/ + +namespace Ix.Compiler.IxIR0 + +open Ix.Compiler.Ixon (Address Owned) +open Ix.Compiler.IxIR + +structure RecursorInstance where + declaration : Decl + arguments : List Owned + fields : List (List Owned) + result : Owned + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr + +def RecursorInstance.wellShaped (instantiation : RecursorInstance) : Bool := + match instantiation.declaration with + | .recursor numArgs _ rules => + instantiation.arguments.length == numArgs + 1 && + instantiation.fields.length == rules.size && + (instantiation.fields.zip rules.toList).all fun (worlds, rule) => worlds.length == rule.fields + | _ => false + +def RecursorInstance.bytes (instantiation : RecursorInstance) : ByteArray := + Encoding.domain "compilatrix/ixir0/recursor-instance/1" ++ Encoding.tag 0 ++ + Encoding.blob instantiation.declaration.preimage ++ + Encoding.list (fun world => Encoding.tag world.toBits) instantiation.arguments ++ + Encoding.list (Encoding.list fun world => Encoding.tag world.toBits) instantiation.fields ++ + Encoding.tag instantiation.result.toBits + +def RecursorInstance.address (instantiation : RecursorInstance) : Address := + Address.blake3 instantiation.bytes + +theorem RecursorInstance.address_eq_iff_bytes_eq (left right : RecursorInstance) + (hcollision : Address.Blake3NoCollision left.bytes right.bytes) : + left.address = right.address ↔ left.bytes = right.bytes := by + constructor + · exact hcollision + · intro h; simp only [address]; rw [h] + +end Ix.Compiler.IxIR0 diff --git a/Ix/Compiler/IxIR0/Serialize.lean b/Ix/Compiler/IxIR0/Serialize.lean new file mode 100644 index 000000000..5f860ca54 --- /dev/null +++ b/Ix/Compiler/IxIR0/Serialize.lean @@ -0,0 +1,115 @@ +import Ix.Compiler.IxIR.Encoding +import Ix.Compiler.IxIR0.Basic + +/-! +# IxIR₀ canonical hash preimages + +Every constructor of the erased semantic IR has an explicit byte spelling. +The top-level declaration preimage is domain-separated as +`compilatrix/ixir0/decl/1`, followed by NUL and the declaration payload. +References retain their exact 32-byte address; recursive recursor calls remain +cycle-free because `RecRule.rhs` uses the rule environment's self binder. + +This module defines artifact identity, not an ingress decoder. A later store +format may frame the same payloads, but changing these bytes requires an +explicit address-version roll. +-/ + +namespace Ix.Compiler.IxIR0 + +open Ix.Compiler.Ixon (Address) +open Ix.Compiler.IxIR + +namespace Literal + +/-- Canonical literal payload. -/ +def bytes : Literal → ByteArray + | .nat value => Encoding.tag 0 ++ Encoding.nat value + | .str value => Encoding.tag 1 ++ Encoding.string value + +end Literal + +namespace Expr + +/-- Canonical recursive expression payload. -/ +def bytes : Expr → ByteArray + | .var index => Encoding.tag 0 ++ Encoding.nat index + | .ref address => Encoding.tag 1 ++ Encoding.address address + | .app fn arg => Encoding.tag 2 ++ bytes fn ++ bytes arg + | .lam uses body => + Encoding.tag 3 ++ Encoding.tag uses.toBits ++ bytes body + | .letE uses value body => + Encoding.tag 4 ++ Encoding.tag uses.toBits ++ bytes value ++ bytes body + | .proj index struct => Encoding.tag 5 ++ Encoding.nat index ++ bytes struct + | .lit literal => Encoding.tag 6 ++ literal.bytes + | .erased => Encoding.tag 7 + +end Expr + +namespace RecRule + +/-- Canonical recursor-rule payload. -/ +def bytes (rule : RecRule) : ByteArray := + Encoding.nat rule.fields ++ rule.rhs.bytes + +end RecRule + +namespace Decl + +/-- The versioned domain prefix for IxIR₀ declaration identities. -/ +def addressDomain : ByteArray := + Encoding.domain "compilatrix/ixir0/decl/1" ++ Encoding.tag 0 + +/-- Canonical declaration payload, without the address domain. -/ +def payloadBytes : Decl → ByteArray + | .defn result body => + Encoding.tag 0 ++ Encoding.tag result.toBits ++ body.bytes + | .ctor tag arity => + Encoding.tag 1 ++ Encoding.nat tag ++ Encoding.nat arity + | .recursor numArgs natLit rules => + Encoding.tag 2 ++ Encoding.nat numArgs ++ Encoding.bool natLit ++ + Encoding.array RecRule.bytes rules + | .extern arity => Encoding.tag 3 ++ Encoding.nat arity + +/-- Complete canonical hash preimage for one IxIR₀ declaration. -/ +def preimage (decl : Decl) : ByteArray := + addressDomain ++ payloadBytes decl + +/-- BLAKE3 content address of an IxIR₀ declaration. -/ +def address (decl : Decl) : Address := + Address.blake3 decl.preimage + +/-- Pair a declaration with its computed content address. -/ +def addressed (decl : Decl) : Address × Decl := + (decl.address, decl) + +/-- Address equality exposes byte identity under exactly the pairwise +collision premise for these two preimages. -/ +theorem address_eq_iff_preimage_eq (left right : Decl) + (hcollision : Address.Blake3NoCollision left.preimage right.preimage) : + left.address = right.address ↔ left.preimage = right.preimage := by + constructor + · exact hcollision + · intro h + simp only [address] + rw [h] + +@[simp] theorem addressed_fst (decl : Decl) : decl.addressed.1 = decl.address := + rfl + +@[simp] theorem addressed_snd (decl : Decl) : decl.addressed.2 = decl := + rfl + +end Decl + +/-! Small format-freezing structural vectors; BLAKE3 vectors live in the +compiled test executable because the current hash implementation is FFI. -/ + +#guard Literal.bytes (.nat 128) == ByteArray.mk #[0, 128, 1] +#guard Expr.bytes (.lam .many (.var 0)) == ByteArray.mk #[3, 3, 0, 0] +#guard Decl.payloadBytes (.defn .shared (.lam .many (.var 0))) == + ByteArray.mk #[0, 1, 3, 3, 0, 0] +#guard Decl.payloadBytes (.recursor 1 true #[⟨0, .erased⟩]) == + ByteArray.mk #[2, 1, 1, 1, 0, 7] + +end Ix.Compiler.IxIR0 diff --git a/Ix/Compiler/IxIR0/UniqueReverse.lean b/Ix/Compiler/IxIR0/UniqueReverse.lean new file mode 100644 index 000000000..90c6ed2ba --- /dev/null +++ b/Ix/Compiler/IxIR0/UniqueReverse.lean @@ -0,0 +1,158 @@ +import Ix.Compiler.IxIR0.RecursorModes +import Ix.Compiler.IxIR0.Recursion + +/-! Exact recognition of a closed unique-list accumulator recursor. The known +constructor-building minor is specialized away only after its entire body and +every recursor rule match. Ownership metadata is checked separately against +the original Ixon declarations; erasure alone does not supply the worlds. -/ + +namespace Ix.Compiler.IxIR0.UniqueReverse + +open Ix.Compiler.Ixon (Address) +open Recursion (app2) + +def policyTag : String := "unique-reverse-specialize/1" + +structure Schema where + nil : Address + cons : Address + recursor : Address + alias : Address + builder : Address + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr + +def builderExpr (s : Schema) : Expr := + .lam .linear (.lam .linear (app2 (.ref s.cons) (.var 1) (.var 0))) + +def literalRecursor : Decl := + .recursor 2 false #[ + { fields := 0, rhs := .var 0 }, + { fields := 2, rhs := .app (app2 (.var 4) (.var 3) + (app2 (.var 3) (.var 1) (.var 2))) (.var 0) }] + +def directRecursor (s : Schema) : Decl := + .recursor 1 false #[ + { fields := 0, rhs := .var 0 }, + { fields := 2, rhs := app2 (.var 3) + (app2 (.ref s.cons) (.var 1) (.var 2)) (.var 0) }] + +def sourceInstance : RecursorInstance := + { declaration := literalRecursor, arguments := [.shared, .unique, .unique] + fields := [[], [.unique, .unique]], result := .unique } + +def directInstance (s : Schema) : RecursorInstance := + { declaration := directRecursor s, arguments := [.unique, .unique] + fields := [[], [.unique, .unique]], result := .unique } + +@[simp] theorem sourceInstance_wellShaped : sourceInstance.wellShaped = true := rfl +@[simp] theorem directInstance_wellShaped (s : Schema) : (directInstance s).wellShaped = true := rfl + +def listExpr (s : Schema) : List Nat → Expr + | [] => .ref s.nil + | n :: ns => app2 (.ref s.cons) (.lit (.nat n)) (listExpr s ns) + +def literalCall (s : Schema) (major accumulator : Expr) : Expr := + .app (app2 (.ref s.alias) (.ref s.builder) accumulator) major + +structure Plan where + schema : Schema + values : List Nat + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr + +def Plan.literalBody (plan : Plan) : Expr := + literalCall plan.schema (listExpr plan.schema plan.values) (.ref plan.schema.nil) + +def Plan.directMain (plan : Plan) (address : Address) : Expr := + app2 (.ref address) (.ref plan.schema.nil) (listExpr plan.schema plan.values) + +structure SourceMatches (env : Env) (s : Schema) : Prop where + nil : env s.nil = some (.ctor 0 0) + cons : env s.cons = some (.ctor 1 2) + recursor : env s.recursor = some literalRecursor + alias : env s.alias = some (.defn .shared (.ref s.recursor)) + builder : env s.builder = some (.defn .unique (builderExpr s)) + +instance (env : Env) (s : Schema) : Decidable (SourceMatches env s) := + decidable_of_iff + (env s.nil = some (.ctor 0 0) ∧ env s.cons = some (.ctor 1 2) ∧ + env s.recursor = some literalRecursor ∧ + env s.alias = some (.defn .shared (.ref s.recursor)) ∧ + env s.builder = some (.defn .unique (builderExpr s))) + ⟨fun h => ⟨h.1, h.2.1, h.2.2.1, h.2.2.2.1, h.2.2.2.2⟩, + fun h => ⟨h.nil, h.cons, h.recursor, h.alias, h.builder⟩⟩ + +structure Checked (declarations : List (Address × Decl)) (main : Expr) where + plan : Plan + root : Address + mainEq : main = .app (.ref root) .erased + source : SourceMatches (Env.ofList declarations) plan.schema + entry : Env.ofList declarations root = some (.defn .unique (.lam .many plan.literalBody)) + +def check (declarations : List (Address × Decl)) (main : Expr) (plan : Plan) : + Option (Checked declarations main) := + match main with + | .app (.ref root) .erased => + if hs : SourceMatches (Env.ofList declarations) plan.schema then + if he : Env.ofList declarations root = some (.defn .unique (.lam .many plan.literalBody)) then + some { plan, root, mainEq := rfl, source := hs, entry := he } + else none + else none + | _ => none + +private def list? (s : Schema) : Expr → Option (List Nat) + | .ref address => if address == s.nil then some [] else none + | .app (.app (.ref address) (.lit (.nat n))) tail => + if address == s.cons then (list? s tail).map (n :: ·) else none + | _ => none + +def propose (declarations : List (Address × Decl)) (main : Expr) : Option Plan := do + let .app (.ref root) .erased := main | none + let env := Env.ofList declarations + let some (.defn .unique (.lam .many + (.app (.app (.app (.ref alias) (.ref builder)) (.ref nil)) major))) := env root | none + let some (.defn .shared (.ref recursor)) := env alias | none + let some (.defn .unique (.lam .linear (.lam .linear + (.app (.app (.ref cons) (.var 1)) (.var 0))))) := env builder | none + let schema : Schema := { nil, cons, recursor, alias, builder } + let values ← list? schema major + return { schema, values } + +def recognize (declarations : List (Address × Decl)) (main : Expr) : + Option (Checked declarations main) := do + let plan ← propose declarations main + check declarations main plan + +def targetDeclarations (plan : Plan) (address : Address) : List (Address × Decl) := + [(plan.schema.nil, .ctor 0 0), (plan.schema.cons, .ctor 1 2), + (address, directRecursor plan.schema)] + +structure TargetMatches (env : Env) (s : Schema) (address : Address) : Prop where + nil : env s.nil = some (.ctor 0 0) + cons : env s.cons = some (.ctor 1 2) + recursor : env address = some (directRecursor s) + +instance (env : Env) (s : Schema) (address : Address) : Decidable (TargetMatches env s address) := + decidable_of_iff + (env s.nil = some (.ctor 0 0) ∧ env s.cons = some (.ctor 1 2) ∧ + env address = some (directRecursor s)) + ⟨fun h => ⟨h.1, h.2.1, h.2.2⟩, fun h => ⟨h.nil, h.cons, h.recursor⟩⟩ + +structure Recovered (declarations : List (Address × Decl)) (main : Expr) where + checked : Checked declarations main + address : Address + addressed : address = (directInstance checked.plan.schema).address + fresh : address ∉ declarations.map (·.1) + target : TargetMatches (Env.ofList (targetDeclarations checked.plan address)) + checked.plan.schema address + +def recover (declarations : List (Address × Decl)) (main : Expr) : + Option (Recovered declarations main) := do + let checked ← recognize declarations main + let address := (directInstance checked.plan.schema).address + if hf : address ∉ declarations.map (·.1) then + if ht : TargetMatches (Env.ofList (targetDeclarations checked.plan address)) checked.plan.schema address then + some { checked, address, addressed := rfl, fresh := hf, target := ht } + else none + else none + +end Ix.Compiler.IxIR0.UniqueReverse diff --git a/Ix/Compiler/IxIR0/UniqueReverseSim.lean b/Ix/Compiler/IxIR0/UniqueReverseSim.lean new file mode 100644 index 000000000..c7808dfa5 --- /dev/null +++ b/Ix/Compiler/IxIR0/UniqueReverseSim.lean @@ -0,0 +1,154 @@ +import Ix.Compiler.IxIR0.UniqueReverse +import Ix.Compiler.IxIR0.RecursionSim + +/-! Exact evaluator simulation for every checked finite unique-list source. +Both the literal builder-minor recursion and the direct instantiation evaluate +to the same accumulator reversal. No ownership or heap premise is assumed. -/ + +namespace Ix.Compiler.IxIR0.UniqueReverse + +open Ix.Compiler.Ixon (Address) +open Recursion (Evaluates Applies evaluatesVar evaluatesLam evaluatesErased evaluatesLit + evaluatesDef evaluatesRecursor evaluatesNullary appliesClosure evaluatesApp evaluatesCtor2 + appliesRecursor appliesTernaryFirst appliesTernaryNext appliesAccumulator) + +def listValue (schema : Schema) : List Nat → Value + | [] => .ctor schema.nil 0 [] + | n :: ns => .ctor schema.cons 1 [.lit (.nat n), listValue schema ns] + +def reverseOnto (schema : Schema) : List Nat → Value → Value + | [], accumulator => accumulator + | n :: ns, accumulator => reverseOnto schema ns (.ctor schema.cons 1 [.lit (.nat n), accumulator]) + +theorem reverseOnto_listValue (schema : Schema) (values accumulator : List Nat) : + reverseOnto schema values (listValue schema accumulator) = + listValue schema (values.reverse ++ accumulator) := by + induction values generalizing accumulator with + | nil => rfl + | cons n ns ih => + change reverseOnto schema ns (listValue schema (n :: accumulator)) = _ + rw [ih] + simp [List.reverse_cons, List.append_assoc] + +theorem reverseOnto_nil (schema : Schema) (values : List Nat) : + reverseOnto schema values (.ctor schema.nil 0 []) = listValue schema values.reverse := by + simpa only [listValue, List.append_nil] using reverseOnto_listValue schema values [] + +def builderValue (schema : Schema) : Value := + .clos .linear [] (.lam .linear (Recursion.app2 (.ref schema.cons) (.var 1) (.var 0))) + +theorem evaluatesBuilder {ctx : Ctx} {schema : Schema} + (hs : SourceMatches ctx.env schema) (env : List Value) : + Evaluates ctx env (.ref schema.builder) (builderValue schema) := + evaluatesDef hs.builder (evaluatesLam ctx [] .linear _) + +theorem appliesBuilderFirst (ctx : Ctx) (schema : Schema) (head : Value) : + Applies ctx (builderValue schema) head + (.clos .linear [head] (Recursion.app2 (.ref schema.cons) (.var 1) (.var 0))) := + appliesClosure (evaluatesLam ctx [head] .linear _) + +theorem appliesBuilderLast {ctx : Ctx} {schema : Schema} + (hcons : ctx.env schema.cons = some (.ctor 1 2)) (head tail : Value) : + Applies ctx (.clos .linear [head] (Recursion.app2 (.ref schema.cons) (.var 1) (.var 0))) + tail (.ctor schema.cons 1 [head, tail]) := + appliesClosure (evaluatesCtor2 hcons (evaluatesVar (by rfl)) (evaluatesVar (by rfl))) + +theorem literalLoop {ctx : Ctx} {schema : Schema} (hs : SourceMatches ctx.env schema) + (values : List Nat) (accumulator : Value) : + Applies ctx (.pap (.rec_ schema.recursor 3) [builderValue schema, accumulator]) + (listValue schema values) (reverseOnto schema values accumulator) := by + induction values generalizing accumulator with + | nil => + apply appliesRecursor hs.recursor (pre := [builderValue schema, accumulator]) + (tag := 0) (by rfl) (by rfl) (by rfl) + exact evaluatesVar (by rfl) + | cons n ns ih => + apply appliesRecursor hs.recursor (pre := [builderValue schema, accumulator]) + (tag := 1) (by rfl) (by rfl) (by rfl) + exact evaluatesApp + (evaluatesApp + (evaluatesApp (evaluatesVar (by rfl)) (evaluatesVar (by rfl)) + (appliesTernaryFirst ctx schema.recursor (builderValue schema))) + (evaluatesApp + (evaluatesApp (evaluatesVar (by rfl)) (evaluatesVar (by rfl)) + (appliesBuilderFirst ctx schema (.lit (.nat n)))) + (evaluatesVar (by rfl)) (appliesBuilderLast hs.cons (.lit (.nat n)) accumulator)) + (appliesTernaryNext ctx schema.recursor (builderValue schema) + (.ctor schema.cons 1 [.lit (.nat n), accumulator]))) + (evaluatesVar (by rfl)) (ih (.ctor schema.cons 1 [.lit (.nat n), accumulator])) + +theorem directLoop {ctx : Ctx} {schema : Schema} {address : Address} + (hcons : ctx.env schema.cons = some (.ctor 1 2)) + (hrec : ctx.env address = some (directRecursor schema)) + (values : List Nat) (accumulator : Value) : + Applies ctx (.pap (.rec_ address 2) [accumulator]) (listValue schema values) + (reverseOnto schema values accumulator) := by + induction values generalizing accumulator with + | nil => + apply appliesRecursor hrec (pre := [accumulator]) (tag := 0) (by rfl) (by rfl) (by rfl) + exact evaluatesVar (by rfl) + | cons n ns ih => + apply appliesRecursor hrec (pre := [accumulator]) (tag := 1) (by rfl) (by rfl) (by rfl) + exact evaluatesApp + (evaluatesApp (evaluatesVar (by rfl)) + (evaluatesCtor2 hcons (evaluatesVar (by rfl)) (evaluatesVar (by rfl))) + (appliesAccumulator ctx address (.ctor schema.cons 1 [.lit (.nat n), accumulator]))) + (evaluatesVar (by rfl)) (ih (.ctor schema.cons 1 [.lit (.nat n), accumulator])) + +theorem evaluatesList {ctx : Ctx} {schema : Schema} + (hnil : ctx.env schema.nil = some (.ctor 0 0)) + (hcons : ctx.env schema.cons = some (.ctor 1 2)) (env : List Value) (values : List Nat) : + Evaluates ctx env (listExpr schema values) (listValue schema values) := by + induction values with + | nil => exact evaluatesNullary hnil + | cons n ns ih => exact evaluatesCtor2 hcons (evaluatesLit ctx env _) ih + +theorem literalRun {ctx : Ctx} {schema : Schema} {env : List Value} + {major accumulator : Expr} {values : List Nat} {acc : Value} + (hs : SourceMatches ctx.env schema) + (hmajor : Evaluates ctx env major (listValue schema values)) + (hacc : Evaluates ctx env accumulator acc) : + Evaluates ctx env (literalCall schema major accumulator) (reverseOnto schema values acc) := + evaluatesApp + (evaluatesApp + (evaluatesApp (evaluatesDef hs.alias (evaluatesRecursor hs.recursor)) + (evaluatesBuilder hs env) (appliesTernaryFirst ctx schema.recursor (builderValue schema))) + hacc (appliesTernaryNext ctx schema.recursor (builderValue schema) acc)) + hmajor (literalLoop hs values acc) + +def Plan.value (plan : Plan) : Value := listValue plan.schema plan.values.reverse + +theorem literalBodyRun {ctx : Ctx} {plan : Plan} + (hs : SourceMatches ctx.env plan.schema) (env : List Value) : + Evaluates ctx env plan.literalBody plan.value := by + have h := literalRun hs (evaluatesList hs.nil hs.cons env plan.values) (evaluatesNullary hs.nil) + simpa only [Plan.literalBody, Plan.value, reverseOnto_nil] using h + +theorem directMainRun {ctx : Ctx} {plan : Plan} {address : Address} + (ht : TargetMatches ctx.env plan.schema address) : + Evaluates ctx [] (plan.directMain address) plan.value := by + have h := evaluatesApp + (evaluatesApp (evaluatesRecursor (env := []) ht.recursor) (evaluatesNullary ht.nil) + (appliesAccumulator ctx address (.ctor plan.schema.nil 0 []))) + (evaluatesList ht.nil ht.cons [] plan.values) + (directLoop ht.cons ht.recursor plan.values (.ctor plan.schema.nil 0 [])) + simpa only [Plan.directMain, Plan.value, reverseOnto_nil, Recursion.app2] using h + +theorem Checked.sourceEvaluates {declarations : List (Address × Decl)} {main : Expr} + (checked : Checked declarations main) : + Evaluates { env := Env.ofList declarations } [] main checked.plan.value := by + simpa only [checked.mainEq] using evaluatesApp + (evaluatesDef checked.entry (evaluatesLam _ [] .many _)) (evaluatesErased _ []) + (appliesClosure (literalBodyRun checked.source [.erased])) + +theorem Recovered.forwardSimulation {declarations : List (Address × Decl)} {main : Expr} + (recovery : Recovered declarations main) {sourceFuel : Nat} {value : Value} + (hsource : eval { env := Env.ofList declarations } sourceFuel [] main = .ok value) : + ∃ targetFuel, + eval { env := Env.ofList (targetDeclarations recovery.checked.plan recovery.address) } + targetFuel [] (recovery.checked.plan.directMain recovery.address) = .ok value := by + have heq := Evaluates.unique ⟨sourceFuel, hsource⟩ recovery.checked.sourceEvaluates + rw [heq] + exact directMainRun recovery.target + +end Ix.Compiler.IxIR0.UniqueReverse diff --git a/Ix/Compiler/IxIR1/Basic.lean b/Ix/Compiler/IxIR1/Basic.lean new file mode 100644 index 000000000..b59abe603 --- /dev/null +++ b/Ix/Compiler/IxIR1/Basic.lean @@ -0,0 +1,172 @@ +import Ix.Compiler.IxIR0.Basic + +/-! +# IxIR₁: the first-order, store-based IR + +The level where memory becomes explicit and modes start paying rent +(`docs/compiler/compiler-design.md`, architecture and proof boundaries). Shape, per +the recorded gate decisions: + +- **Let-normalized and saturated** (gate C): code is a sequence of + primitive operations binding one variable each, ending in `ret` or a + `case`. Known calls carry exact arities; partial application is a + reified `pap` node; unknown calls go through `apply` — the GRIN + eval/apply vocabulary, with the interpreter as its semantic + specification (generated closed-world dispatchers must refine it). +- **First-order**: no lambdas. Functions are top-level declarations; + recursors are *gone* — the IxIR₀ → IxIR₁ lowering compiles their ι + to `case` plus `callSelf` (content-addressing-safe self-reference, + the recSelf idea one level down). Mutual blocks are deferred exactly + as at IxIR₀. +- **Explicit store** (gate A): values are scalars or locations; nodes + live in a heap. Every allocation, projection, in-place reuse, + deallocation, and refcount operation is an instruction. +- **Mode-directed memory ops**: the unique world gets `reuse`/`free` + (moves are implicit — a location is just consumed); the shared + world gets `dup`/`drop` with Perceus-style deep drop at refcount + zero. `dup`/`drop` on unique values and `reuse`/`free` on shared + ones are *memory errors* — the interpreter is a dynamic checker for + the discipline the static judgment will later prove unnecessary. + Arena/locality ops arrive with the regions axis (frozen-deferred); + reuse-token *pairing* is IxIR₂'s optimization — the `reuse` + instruction itself is IxIR₁'s, since `reuse_sound` is an IxIR₁ + statement. +- **Cost lives here** (gate A): the store carries instruction-level + counters (allocations, reuses, frees, RC ops), so claims like + "reversal of a unique list allocates nothing" are `#guard`s in + `Examples.lean`, and the zk cost model has its hook. + +De Bruijn conventions: `letOp` binds one variable (index 0 in the +rest); a `case` alternative pushes the scrutinee's fields in order +(index 0 = *last* field, matching IxIR₀'s ι environment); a function +body starts with its arguments pushed in order (index 0 = last +argument). +-/ + +namespace Ix.Compiler.IxIR1 + +open Ix.Compiler.Ixon (Address Owned) +open Ix.Compiler.IxIR0 (Literal) + +/-- Operands: everything is a variable, a scalar literal, or ◻. +Locations are runtime values only — code never names a location. -/ +inductive Atom where + | var (idx : Nat) + | lit (l : Literal) + | erased + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- Constructor identity: the inductive's block address + member +index, and the constructor index — matching the source-side `ctorV`. -/ +structure CtorId where + block : Address + indIdx : Nat + cidx : Nat + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +mutual + +/-- One primitive operation; each binds exactly one variable. -/ +inductive Op where + /-- Rebind an atom (lowering convenience). -/ + | pure (a : Atom) + /-- Allocate a constructor node in the given world. -/ + | alloc (world : Owned) (cid : CtorId) (args : Array Atom) + /-- Overwrite a **live, unique** node in place: the FBIP payoff. + Returns the same location; counts as a reuse, not an allocation. -/ + | reuse (target : Atom) (cid : CtorId) (args : Array Atom) + /-- Shallow-free a **live, unique** node. -/ + | free (target : Atom) + /-- Increment a **shared** node's refcount (no-op on scalars). -/ + | dup (target : Atom) + /-- Decrement a **shared** node's refcount; at zero, free and + recursively drop the fields (Perceus-style deep drop). -/ + | drop (target : Atom) + /-- Deep-free a **live, unique** tree: kill the node and recurse + into its fields (which must be unique — whole-value modes, gate B). + The unique dual of `drop`'s rc-zero path, and the compilation of + affine death; no refcounts are touched. No-op on scalars. -/ + | dropU (target : Atom) + /-- Project field `i` of a constructor node (non-consuming). -/ + | fetch (target : Atom) (field : Nat) + /-- Saturated call of a known function (exact arity). -/ + | call (f : Address) (args : Array Atom) + /-- Saturated self-call: recursion without an address cycle. -/ + | callSelf (args : Array Atom) + /-- Build a partial-application node: known `f`, strictly fewer + arguments than its arity. -/ + | papp (f : Address) (args : Array Atom) + /-- Apply an unknown function value (a `pap` node) to further + arguments; may saturate (call), under-fill (new `pap`), or + over-fill (call, then apply the rest to the result). Consumes the + function value: the pap's stored arguments are dup'd for their new + owner and the pap itself is dropped. -/ + | apply (f : Atom) (args : Array Atom) + /-- Trusted extern. The v1 boundary is scalar-only in both directions: + heap locations are rejected before or after consulting the oracle. -/ + | extern (f : Address) (args : Array Atom) + +/-- A case alternative: constructor index, its field count, and the +continuation with the fields bound. -/ +inductive Alt where + | mk (cidx : Nat) (fields : Nat) (body : Code) + +/-- Code: a let-sequence ending in a return or a branch. -/ +inductive Code where + | ret (a : Atom) + | letOp (op : Op) (rest : Code) + /-- Branch on a constructor node's tag. `peelNat` additionally + accepts `Nat` literals (`0 ↦ cidx 0`, `n+1 ↦ cidx 1` binding + `lit n`) — the IxIR₀ `natLit` story at this level. Non-consuming: + frees and drops are explicit instructions. -/ + | case (scrut : Atom) (peelNat : Bool) (alts : Array Alt) + +end + +/-- A saturated top-level function. -/ +structure FnDef where + arity : Nat + /-- Ownership world of a returned heap location. Scalars satisfy + either result world. -/ + result : Owned + /-- Whether this declaration may be entered through a shared PAP. The + production lowerer sets this exactly when the result and every parameter + live in the shared world; saturated direct calls remain valid either way. -/ + papSafe : Bool + body : Code + +/-- Top-level declarations. No constructor declarations (`alloc` +carries identity; first-class constructor use is eta-expanded by the +lowering) and no recursors (lowered to `case` + `callSelf`). -/ +inductive Decl where + | fn (d : FnDef) + | extern (arity : Nat) + +/-- The closed world of declarations. The transparent list model is retained +for proofs and compiled through the proved hash-index implementation below. -/ +abbrev Env := Address → Option Decl + +def Env.empty : Env := fun _ => none + +def Env.ofList (l : List (Address × Decl)) : Env := + fun a => (l.find? (fun p => p.1 == a)).map (·.2) + +namespace Env + +/-- The explicitly staged runtime representation of an environment. -/ +abbrev Index := AddressEnv.Index Decl + +def Index.ofList (l : List (Address × Decl)) : Index := + AddressEnv.build l + +def Index.toEnv (index : Index) : Env := + AddressEnv.lookup index + +/-- The runtime index implements the transparent first-binding-wins model. -/ +@[simp] theorem Index.toEnv_ofList (l : List (Address × Decl)) : + (Index.ofList l).toEnv = Env.ofList l := by + exact AddressEnv.lookup_build l + +end Env + +end Ix.Compiler.IxIR1 diff --git a/Ix/Compiler/IxIR1/CostInstance.lean b/Ix/Compiler/IxIR1/CostInstance.lean new file mode 100644 index 000000000..a1257ca86 --- /dev/null +++ b/Ix/Compiler/IxIR1/CostInstance.lean @@ -0,0 +1,135 @@ +import Ix.Compiler.IxIR1.NoReuse + +/-! +# Exact cost instance for a real IxIR₀ → IxIR₁ lowering + +This module pins one nondegenerate whole-pass cost observation. A closed +reference to a nullary constructor lowers to one shared allocation, and the +resulting target run has exactly one allocation and no reuse, free, or +reference-count operation. `RunCostInvariant.of_witness` promotes the exact +kernel-checked run to every successful fuel and then to `CostRefinement`. +-/ + +namespace Ix.Compiler.IxIR1.CostInstance + +open Ix.Compiler.Ixon (Address) +open Ix.Compiler.IxIR1.Lower +open Ix.Compiler.IxIR1.LowerSim + +/-- Stable source identity for the exact cost fixture. -/ +def constructor : Address := Address.replicate 0xc7 + +/-- A single nullary constructor declaration. -/ +def sourceDeclarations : List (Address × IxIR0.Decl) := + [(constructor, .ctor 0 0)] + +/-- The closed source program constructs that nullary value. -/ +def sourceMain : IxIR0.Expr := .ref constructor + +/-- The declaration environment used to execute the source fixture. -/ +def sourceCtx : IxIR0.Ctx := + { env := IxIR0.Env.ofList sourceDeclarations } + +/-- The pure value produced by the source fixture. -/ +def sourceValue : IxIR0.Value := .ctor constructor 0 [] + +/-- The exact target code emitted by the whole-pass lowerer. -/ +def targetCode : Code := + .letOp (.alloc .shared (ctorIdOf constructor 0) #[]) + (.ret (.var 0)) + +/-- Constructors do not need target declarations: their identity is carried +by `Op.alloc`. -/ +def targetCtx : Ctx := { decls := Env.empty } + +/-- The target store after the fixture's sole allocation. -/ +def targetStore : Store := + (({} : Store).allocNode .shared + (.ctorN (ctorIdOf constructor 0) #[])).1 + +/-- The exact four-counter observation for the fixture. -/ +def exactCost : CostObservation := + { allocs := 1, reuses := 0, frees := 0, rcops := 0 } + +@[simp] private theorem estateMapGet_run {error state result : Type} + (f : state → result) (initial : state) : + EStateM.run (f <$> (get : EStateM error state state)) initial = + .ok (f initial) initial := by + rfl + +/-- The executable whole-program lowerer emits exactly the fixture code and +no declarations or generated state. -/ +theorem lowerAllAction_run : + (lowerAllAction sourceDeclarations sourceMain .shared 10).run {} = + .ok ([], targetCode) {} := by + simp [sourceDeclarations, sourceMain, targetCode, lowerAllAction, + lowerDecl, lowerFnBody, releaseSlots, lowerE, ctorIdOf, + AVal.toAtom, VEnv.rel, VEnv.bump, emitOp, IxIR0.Env.ofList, + constructor, List.filterMapM, + List.filterMapM.loop] + +/-- The source reference evaluates to the declared nullary constructor. -/ +theorem sourceEval_exact : + IxIR0.eval sourceCtx 3 [] sourceMain = .ok sourceValue := by + simp [sourceCtx, sourceDeclarations, sourceMain, sourceValue, + IxIR0.eval, IxIR0.saturate, IxIR0.fire, IxIR0.Env.ofList, + IxIR0.Head.arity, constructor] + +/-- Two evaluator ticks execute the allocation and final return. -/ +theorem runMain_exact : + runMain targetCtx targetCode 2 = .ok (targetStore, .loc 0) := by + unfold runMain targetCode + rw [runCode.eq_def] + dsimp only + rw [Sim.runOp_alloc (by rfl)] + simp only [bind, Except.bind] + rw [runCode.eq_def] + dsimp only + rfl + +/-- The exact run changes only the allocation counter. -/ +theorem targetStore_cost : costObservation targetStore = exactCost := by + rfl + +/-- The allocated target node realizes the exact source constructor value. -/ +theorem valueGraph_exact (funRel : Sim.FunctionRel) : + Sim.ValueGraph funRel targetStore sourceValue (.loc 0) := by + refine .ctor (by rfl) (by rfl) (by rfl) ?_ + exact .nil + +/-- Every successful execution of the emitted target code has the same exact +four-counter observation. -/ +theorem exactRunCost : + RunCostInvariant targetCtx targetCode (fun observation => + observation = exactCost) := by + refine RunCostInvariant.of_witness + (spec := fun observation => observation = exactCost) + (witnessFuel := 2) (witnessStore := targetStore) + (witnessValue := .loc 0) runMain_exact ?_ + exact targetStore_cost + +/-- The exact target observation is a semantic cost refinement for the source +fixture, independently of the chosen function relation. -/ +theorem exactCostRefinement (funRel : Sim.FunctionRel) : + CostRefinement + sourceCtx + targetCtx sourceMain targetCode funRel + (fun _ observation => observation = exactCost) := + exactRunCost.costRefinement + +/-- One theorem joins the real lowering result, successful source and target +runs, their semantic value graph, and the exact counter refinement. This is +the nonvacuous executable witness for the generic cost interface. -/ +theorem loweringCostWitness (funRel : Sim.FunctionRel) : + (lowerAllAction sourceDeclarations sourceMain .shared 10).run {} = + .ok ([], targetCode) {} ∧ + IxIR0.eval sourceCtx 3 [] sourceMain = .ok sourceValue ∧ + runMain targetCtx targetCode 2 = .ok (targetStore, .loc 0) ∧ + Sim.ValueGraph funRel targetStore sourceValue (.loc 0) ∧ + costObservation targetStore = exactCost := by + refine ⟨lowerAllAction_run, sourceEval_exact, runMain_exact, + valueGraph_exact funRel, ?_⟩ + exact (exactCostRefinement funRel) sourceEval_exact runMain_exact + (valueGraph_exact funRel) + +end Ix.Compiler.IxIR1.CostInstance diff --git a/Ix/Compiler/IxIR1/CostModel.lean b/Ix/Compiler/IxIR1/CostModel.lean new file mode 100644 index 000000000..50cf9d4f9 --- /dev/null +++ b/Ix/Compiler/IxIR1/CostModel.lean @@ -0,0 +1,336 @@ +import Ix.Compiler.IxIR1.CostInstance + +/-! +# A source-sensitive constructor cost model + +IxIR₀ evaluator fuel remains only a totality witness. This module instead +attaches cost to the IxIR₁ operations emitted for a parametric family of +closed source programs. The source numeral `n` is a unary constructor tree; +its actual whole-pass lowering performs exactly `n + 1` allocations and no +reuse, free, or reference-count operation. + +This is deliberately a first proved fragment, not a global syntax bound: +calls and recursion require a dynamic source trace or a compositional +lowering certificate before the same statement can cover arbitrary programs. +-/ + +namespace Ix.Compiler.IxIR1.CostModel + +open Ix.Compiler.Ixon (Address) +open Ix.Compiler.IxIR1.Lower +open Ix.Compiler.IxIR1.LowerSim + +/-- Stable constructor identities for the unary source family. -/ +def zeroConstructor : Address := Address.replicate 0xc8 + +def succConstructor : Address := Address.replicate 0xc9 + +@[simp] theorem zeroConstructor_ne_succConstructor : + zeroConstructor ≠ succConstructor := by + intro heq + have hbyte := congrArg (fun address => + address.get (⟨0, by omega⟩ : Fin 32)) heq + simp [zeroConstructor, succConstructor] at hbyte + +/-- The complete source declaration set for unary constructor values. -/ +def sourceDeclarations : List (Address × IxIR0.Decl) := + [(zeroConstructor, .ctor 0 0), (succConstructor, .ctor 1 1)] + +def sourceCtx : IxIR0.Ctx := + { env := IxIR0.Env.ofList sourceDeclarations } + +@[simp] theorem sourceCtx_zero : + sourceCtx.env zeroConstructor = some (.ctor 0 0) := by + simp [sourceCtx, sourceDeclarations, IxIR0.Env.ofList] + +@[simp] theorem sourceCtx_succ : + sourceCtx.env succConstructor = some (.ctor 1 1) := by + simp [sourceCtx, sourceDeclarations, IxIR0.Env.ofList, + zeroConstructor_ne_succConstructor] + +/-- A closed unary numeral. Its parameter is source structure, not fuel. -/ +def sourceNat : Nat → IxIR0.Expr + | 0 => .ref zeroConstructor + | n + 1 => .app (.ref succConstructor) (sourceNat n) + +/-- The pure unary value denoted by `sourceNat`. -/ +def sourceValue : Nat → IxIR0.Value + | 0 => .ctor zeroConstructor 0 [] + | n + 1 => .ctor succConstructor 1 [sourceValue n] + +/-- Constructor occurrences in a pure source value. This is the +source-result component of the fragment's cost specification. -/ +def constructorNodes : IxIR0.Value → Nat + | .ctor _ _ fields => 1 + (fields.map constructorNodes).sum + | .clos .. | .pap .. | .lit .. | .erased => 0 + +@[simp] theorem constructorNodes_sourceValue (n : Nat) : + constructorNodes (sourceValue n) = n + 1 := by + induction n with + | zero => simp [sourceValue, constructorNodes] + | succ n ih => + simp [sourceValue, constructorNodes, ih] + omega + +/-- The target prefix emitted for a unary numeral. -/ +def targetEmit : Nat → Emit + | 0 => emitOp (.alloc .shared (ctorIdOf zeroConstructor 0) #[]) + | n + 1 => + targetEmit n ∘ + emitOp (.alloc .shared (ctorIdOf succConstructor 1) #[.var 0]) + +def targetCode (n : Nat) : Code := + targetEmit n (.ret (.var 0)) + +def targetCtx : Ctx := { decls := Env.empty } + +/-- The exact instruction-counter model for source numeral `n`. -/ +def exactCost (n : Nat) : CostObservation := + { allocs := n + 1, reuses := 0, frees := 0, rcops := 0 } + +/-- The semantic cost relation: allocations equal the constructor size of +the source result, and the remaining memory counters are zero. -/ +def SourceSensitiveCostSpec + (value : IxIR0.Value) (observation : CostObservation) : Prop := + observation.allocs = constructorNodes value ∧ + observation.reuses = 0 ∧ observation.frees = 0 ∧ + observation.rcops = 0 + +theorem sourceEval_exact (n : Nat) : + IxIR0.eval sourceCtx (n + 3) [] (sourceNat n) = + .ok (sourceValue n) := by + induction n with + | zero => + simp [sourceNat, sourceValue, IxIR0.eval, IxIR0.saturate, + IxIR0.fire, IxIR0.Head.arity] + | succ n ih => + simp [sourceNat, sourceValue, IxIR0.eval, IxIR0.saturate, + IxIR0.Head.arity, ih, Nat.add_assoc] + simp only [bind, Except.bind] + rw [IxIR0.apply.eq_def] + dsimp only + rw [IxIR0.saturate.eq_def] + dsimp only + simp [IxIR0.Head.arity, IxIR0.fire] + +/-! ## Exact target execution -/ + +/-- The concrete heap built by the target allocation chain. -/ +def targetStore : Nat → Store + | 0 => + (({} : Store).allocNode .shared + (.ctorN (ctorIdOf zeroConstructor 0) #[])).1 + | n + 1 => + ((targetStore n).allocNode .shared + (.ctorN (ctorIdOf succConstructor 1) #[.loc n])).1 + +/-- Runtime binders after the chain, newest unary node first. -/ +def targetEnv : Nat → List RVal + | 0 => [.loc 0] + | n + 1 => .loc (n + 1) :: targetEnv n + +@[simp] theorem targetEnv_head (n : Nat) : + (targetEnv n)[0]? = some (.loc n) := by + cases n <;> rfl + +@[simp] theorem targetStore_nodes_size (n : Nat) : + (targetStore n).nodes.size = n + 1 := by + induction n with + | zero => simp [targetStore, Store.allocNode] + | succ n ih => simp [targetStore, Store.allocNode, ih, Nat.add_assoc] + +theorem targetStore_counters (n : Nat) : + (targetStore n).allocs = n + 1 ∧ + (targetStore n).reuses = 0 ∧ (targetStore n).frees = 0 ∧ + (targetStore n).rcops = 0 := by + induction n with + | zero => simp [targetStore, Store.allocNode] + | succ n ih => + rcases ih with ⟨hallocs, hreuses, hfrees, hrcops⟩ + simp [targetStore, Store.allocNode, hallocs, hreuses, hfrees, + hrcops] + +@[simp] theorem targetStore_cost (n : Nat) : + costObservation (targetStore n) = exactCost n := by + rcases targetStore_counters n with ⟨hallocs, hreuses, hfrees, hrcops⟩ + simp only [costObservation, exactCost] + rw [hallocs, hreuses, hfrees, hrcops] + +/-- Executing the allocation prefix leaves exactly `targetStore n` and its +newest-to-oldest runtime environment for an arbitrary continuation. -/ +theorem runCode_targetEmit (cur : FnDef) (n k : Nat) (rest : Code) : + runCode targetCtx (k + n + 2) cur {} [] (targetEmit n rest) = + runCode targetCtx (k + 1) cur (targetStore n) (targetEnv n) rest := by + induction n generalizing k rest with + | zero => + rw [runCode.eq_def] + dsimp only [targetEmit, emitOp] + rw [Sim.runOp_alloc (by rfl)] + rfl + | succ n ih => + rw [targetEmit] + simp only [Function.comp_apply, emitOp] + rw [show k + (n + 1) + 2 = (k + 1) + n + 2 by omega] + rw [ih (k + 1)] + rw [runCode.eq_def] + dsimp only + rw [Sim.runOp_alloc (values := [.loc n]) (by + unfold resolveAtoms + rw [← Array.foldlM_toList] + simp [resolveAtom] + rfl)] + simp only [bind, Except.bind] + simp [targetStore, targetEnv, Store.allocNode, + targetStore_nodes_size] + +/-- The exact successful target trace for every unary source size. -/ +theorem runMain_exact (n : Nat) : + runMain targetCtx (targetCode n) (n + 2) = + .ok (targetStore n, .loc n) := by + unfold runMain targetCode + have hprefix := runCode_targetEmit + { arity := 0, result := .shared, papSafe := false, + body := targetEmit n (.ret (.var 0)) } + n 0 (.ret (.var 0)) + simp only [Nat.zero_add] at hprefix + rw [hprefix] + rw [runCode.eq_def] + simp [resolveAtom, bind, Except.bind] + +/-! ## Exact whole-pass lowering -/ + +/-- The recursive lowering core emits precisely the unary allocation prefix. +The compiler-fuel expression is only a sufficient termination witness. -/ +theorem lowerE_exact (n : Nat) (state : LowSt) : + (lowerE sourceCtx.env (4 * n + 1) ⟨[], 0⟩ .shared + (sourceNat n)).run state = + .ok (⟨[], n + 1⟩, targetEmit n, .slotA n) state := by + induction n generalizing state with + | zero => + simp [sourceNat, lowerE, VEnv.bump, targetEmit] + | succ n ih => + simp [sourceNat, lowerE, lowerSpine, knownCall, lowerArgs, + padWorlds, sourceCtx_succ, VEnv.bump, VEnv.rel, AVal.toAtom, + targetEmit, emitOp, Function.comp_def, Nat.mul_succ] + have hih := ih state + simp only [EStateM.run] at hih + simp only [Functor.map, EStateM.map, EStateM.run] + rw [hih] + simp + +theorem lowerFnBody_exact (n : Nat) (state : LowSt) : + (lowerFnBody sourceCtx.env (4 * n + 2) ⟨[], 0⟩ [] .shared + (sourceNat n)).run state = .ok (targetCode n) state := by + simp [lowerFnBody, releaseSlots] + have hlower := lowerE_exact n state + simp only [EStateM.run] at hlower + simp only [Functor.map, EStateM.map, EStateM.run] + rw [hlower] + simp [targetCode, VEnv.rel, AVal.toAtom] + +/-- The executable whole-pass lowering, including declaration traversal and +generated-state observation, emits no declarations and exactly `targetCode`. +-/ +theorem lowerAllAction_run (n : Nat) : + (lowerAllAction sourceDeclarations (sourceNat n) .shared + (4 * n + 2)).run {} = .ok ([], targetCode n) {} := by + simp [lowerAllAction, sourceDeclarations, lowerDecl, List.filterMapM, + List.filterMapM.loop] + have hmain := lowerFnBody_exact n ({} : LowSt) + simp only [sourceCtx, sourceDeclarations] at hmain + simp only [EStateM.run] at hmain + simp only [EStateM.run] + rw [hmain] + +/-! ## Source-sensitive cost refinement -/ + +/-- The target heap realizes the complete unary source result at its newest +allocation. -/ +theorem valueGraph_exact (funRel : Sim.FunctionRel) (n : Nat) : + Sim.ValueGraph funRel (targetStore n) (sourceValue n) (.loc n) := by + induction n with + | zero => + refine .ctor (by rfl) (by rfl) (by rfl) ?_ + exact .nil + | succ n ih => + let node : Node := + .ctorN (ctorIdOf succConstructor 1) #[.loc n] + have hextends : Sim.StoreGraphExtends (targetStore n) + ((targetStore n).allocNode .shared node).1 := + Sim.StoreGraphExtends.allocNode (targetStore n) .shared node + have hfield : Sim.ValueGraph funRel + ((targetStore n).allocNode .shared node).1 + (sourceValue n) (.loc n) := + ih.monoStore hextends + have hget : (targetStore (n + 1)).get? (n + 1) = + some ⟨.shared, 1, + .ctorN (ctorIdOf succConstructor 1) #[.loc n]⟩ := by + have hnew : + ((targetStore n).allocNode .shared node).1.get? (n + 1) = + some ⟨.shared, 1, node⟩ := by + rw [← targetStore_nodes_size n] + exact Sim.HeapIso.get?_allocNode_new + (targetStore n) .shared node + simpa only [targetStore, node] using hnew + refine .ctor hget (by rfl) (by rfl) (.cons ?_ .nil) + simpa [targetStore, node] using hfield + +/-- Every successful execution of the emitted numeral code has the exact +counter vector predicted by the source parameter. -/ +theorem exactRunCost (n : Nat) : + RunCostInvariant targetCtx (targetCode n) + (fun observation => observation = exactCost n) := by + refine RunCostInvariant.of_witness + (spec := fun observation => observation = exactCost n) + (witnessFuel := n + 2) (witnessStore := targetStore n) + (witnessValue := .loc n) (runMain_exact n) ?_ + exact targetStore_cost n + +/-- Exact source-sensitive cost refinement for the unary constructor +fragment. In particular, allocation is bounded (indeed equal) by source +result size, and RC traffic is bounded by zero. -/ +theorem sourceSensitiveCostRefinement (funRel : Sim.FunctionRel) (n : Nat) : + CostRefinement sourceCtx targetCtx (sourceNat n) (targetCode n) funRel + SourceSensitiveCostSpec := by + intro sourceFuel result targetFuel store runtimeValue hsource htarget + _hgraph + have hresult : result = sourceValue n := + sourceEval_ok_unique hsource (sourceEval_exact n) + subst result + have hcost : costObservation store = exactCost n := + exactRunCost n htarget + rw [hcost] + simp [SourceSensitiveCostSpec, exactCost] + +def SourceSensitiveBoundsSpec + (value : IxIR0.Value) (observation : CostObservation) : Prop := + observation.allocs ≤ constructorNodes value ∧ observation.rcops ≤ 0 + +/-- The exact model exposed in conventional upper-bound form. -/ +theorem sourceSensitiveBoundsCostRefinement + (funRel : Sim.FunctionRel) (n : Nat) : + CostRefinement sourceCtx targetCtx (sourceNat n) (targetCode n) funRel + SourceSensitiveBoundsSpec := by + intro sourceFuel result targetFuel store runtimeValue hsource htarget hgraph + have hexact := sourceSensitiveCostRefinement funRel n + hsource htarget hgraph + exact ⟨Nat.le_of_eq hexact.1, Nat.le_of_eq hexact.2.2.2⟩ + +/-- One parametric theorem joins actual whole-pass output, both semantics, +their value graph, and the source-sensitive instruction-cost relation. -/ +theorem loweringCostWitness (funRel : Sim.FunctionRel) (n : Nat) : + (lowerAllAction sourceDeclarations (sourceNat n) .shared + (4 * n + 2)).run {} = .ok ([], targetCode n) {} ∧ + IxIR0.eval sourceCtx (n + 3) [] (sourceNat n) = + .ok (sourceValue n) ∧ + runMain targetCtx (targetCode n) (n + 2) = + .ok (targetStore n, .loc n) ∧ + Sim.ValueGraph funRel (targetStore n) (sourceValue n) (.loc n) ∧ + SourceSensitiveCostSpec (sourceValue n) + (costObservation (targetStore n)) := by + refine ⟨lowerAllAction_run n, sourceEval_exact n, runMain_exact n, + valueGraph_exact funRel n, ?_⟩ + exact (sourceSensitiveCostRefinement funRel n) + (sourceEval_exact n) (runMain_exact n) (valueGraph_exact funRel n) + +end Ix.Compiler.IxIR1.CostModel diff --git a/Ix/Compiler/IxIR1/CostTrace.lean b/Ix/Compiler/IxIR1/CostTrace.lean new file mode 100644 index 000000000..7e8f9c24c --- /dev/null +++ b/Ix/Compiler/IxIR1/CostTrace.lean @@ -0,0 +1,26091 @@ +import Ix.Compiler.IxIR1.RcPotential +import Ix.Compiler.IxIR0.DynamicCost +import Ix.Compiler.IxIR1.LowerFullyAddressedSim +import Ix.Compiler.IxIR1.LowerSim +import Ix.Compiler.IxIR1.NoReuse + +/-! +# Dynamic source profiles as IxIR₁ cost specifications + +This module is the bridge between the call-aware dynamic source profile and +the four counters maintained by IxIR₁. A `ProfileWeights` value is an +explicit lowering cost model: each source event class receives a four-counter +charge, and the resulting componentwise linear combination is a target +budget. The model is deliberately supplied by the lowering proof rather than +baked into source semantics. The source profile also records dynamic retain +widths, since one closure or partial-application event may retain arbitrarily +many values. `ObservationGrowthLE` provides the compositional target-side +counter algebra used to justify those charges operation by operation. +-/ + +namespace Ix.Compiler.IxIR1.CostTrace + +open Ix.Compiler.IxIR1.LowerSim +open Ix.Compiler.IxIR1.Lower +open Ix.Compiler.IxIR1.Reclamation +abbrev SourceProfile := IxIR0.DynamicCost.Profile + +private theorem bindErr {error alpha beta : Type} (err : error) + (next : alpha → Except error beta) : + ((Except.error err : Except error alpha) >>= next) = .error err := rfl + +private theorem bindOk {error alpha beta : Type} (value : alpha) + (next : alpha → Except error beta) : + ((Except.ok value : Except error alpha) >>= next) = next value := rfl + +private theorem permExtractRoot (root : Sim.Root) + (before after rest : List Sim.Root) : + ((before ++ root :: after) ++ rest).Perm + (root :: (before ++ after) ++ rest) := by + induction before with + | nil => rfl + | cons head before ih => + simp only [List.cons_append] + exact (ih.cons head).trans (List.Perm.swap root head _) + +theorem Sim.HasWorld.valueInBounds + {store : Store} {world : Ixon.Owned} {value : RVal} + (hworld : Sim.HasWorld store world value) : + ValueInBounds store value := by + cases value with + | loc location => + obtain ⟨box, hget, _⟩ := hworld + exact RVal.inBounds_of_get? hget + | lit literal => trivial + | erased => trivial + +theorem rootOwnership_valueInBounds_of_mem + {store : Store} {roots : List Sim.Root} {root : Sim.Root} + (hown : Sim.RootOwnership store roots) (hmember : root ∈ roots) : + ValueInBounds store root.value := + Sim.HasWorld.valueInBounds (hown.roots_world root hmember) + +private theorem stateBindRun {error state alpha beta : Type} + (action : EStateM error state alpha) + (next : alpha → EStateM error state beta) (initial : state) : + (action >>= next).run initial = + match action.run initial with + | .ok value nextState => (next value).run nextState + | .error err nextState => .error err nextState := rfl + +private theorem stateBindRun_ok_inv {error state alpha beta : Type} + {action : EStateM error state alpha} + {next : alpha → EStateM error state beta} + {initial final : state} {result : beta} + (hrun : (action >>= next).run initial = .ok result final) : + ∃ value middle, + action.run initial = .ok value middle ∧ + (next value).run middle = .ok result final := by + rw [stateBindRun] at hrun + cases haction : action.run initial with + | ok value middle => + rw [haction] at hrun + exact ⟨value, middle, rfl, hrun⟩ + | error err middle => + rw [haction] at hrun + contradiction + +private theorem stateThrowRun_not_ok {error state alpha : Type} + {err : error} {initial final : state} {value : alpha} + (hrun : (throw err : EStateM error state alpha).run initial = + .ok value final) : False := by + change EStateM.Result.error err initial = .ok value final at hrun + contradiction + +/-- Counterwise addition used by linear source-profile budgets. -/ +def observationAdd (left right : CostObservation) : CostObservation := + { allocs := left.allocs + right.allocs + reuses := left.reuses + right.reuses + frees := left.frees + right.frees + rcops := left.rcops + right.rcops } + +/-- Scale one four-counter charge by an event count. -/ +def observationScale (count : Nat) + (observation : CostObservation) : CostObservation := + { allocs := count * observation.allocs + reuses := count * observation.reuses + frees := count * observation.frees + rcops := count * observation.rcops } + +/-- Componentwise target-counter ordering. -/ +def ObservationLE (actual budget : CostObservation) : Prop := + actual.allocs ≤ budget.allocs ∧ + actual.reuses ≤ budget.reuses ∧ + actual.frees ≤ budget.frees ∧ actual.rcops ≤ budget.rcops + +/-- Componentwise counter growth from an arbitrary input store. Addition on +the right avoids truncated subtraction and composes directly across emitted +code segments and calls. -/ +def ObservationGrowthLE (before after allowance : CostObservation) : Prop := + after.allocs ≤ before.allocs + allowance.allocs ∧ + after.reuses ≤ before.reuses + allowance.reuses ∧ + after.frees ≤ before.frees + allowance.frees ∧ + after.rcops ≤ before.rcops + allowance.rcops + +theorem ObservationGrowthLE.refl (observation : CostObservation) : + ObservationGrowthLE observation observation ⟨0, 0, 0, 0⟩ := by + simp [ObservationGrowthLE] + +theorem ObservationGrowthLE.trans {first middle last left right} + (hleft : ObservationGrowthLE first middle left) + (hright : ObservationGrowthLE middle last right) : + ObservationGrowthLE first last (observationAdd left right) := by + rcases hleft with ⟨ha₁, hr₁, hf₁, hc₁⟩ + rcases hright with ⟨ha₂, hr₂, hf₂, hc₂⟩ + simp only [ObservationGrowthLE, observationAdd] + omega + +/-- Store-level spelling of counter growth. -/ +def StoreGrowthLE (before after : Store) (allowance : CostObservation) : + Prop := + ObservationGrowthLE (costObservation before) (costObservation after) + allowance + +def rcAllowance (count : Nat) : CostObservation := ⟨0, 0, 0, count⟩ + +def allocationAllowance (count : Nat) : CostObservation := + ⟨count, 0, 0, 0⟩ + +def freeAllowance (count : Nat) : CostObservation := ⟨0, 0, count, 0⟩ + +theorem StoreGrowthLE.refl (store : Store) : + StoreGrowthLE store store ⟨0, 0, 0, 0⟩ := + ObservationGrowthLE.refl _ + +theorem StoreGrowthLE.trans {first middle last : Store} {left right} + (hleft : StoreGrowthLE first middle left) + (hright : StoreGrowthLE middle last right) : + StoreGrowthLE first last (observationAdd left right) := + ObservationGrowthLE.trans hleft hright + +theorem StoreGrowthLE.allocNode (store : Store) (world : Ixon.Owned) + (node : Node) : + StoreGrowthLE store (store.allocNode world node).1 + (allocationAllowance 1) := by + simp [StoreGrowthLE, ObservationGrowthLE, costObservation, + allocationAllowance, Store.allocNode] + +theorem StoreGrowthLE.setBox (store : Store) (location : Nat) + (box : NodeBox) : + StoreGrowthLE store (store.setBox location box) ⟨0, 0, 0, 0⟩ := by + simp [StoreGrowthLE, ObservationGrowthLE, costObservation, Store.setBox] + +theorem StoreGrowthLE.kill (store : Store) (location : Nat) : + StoreGrowthLE store (store.kill location) (freeAllowance 1) := by + simp [StoreGrowthLE, ObservationGrowthLE, costObservation, + freeAllowance, Store.kill] + +theorem StoreGrowthLE.rcTick (store : Store) : + StoreGrowthLE store store.rcTick (rcAllowance 1) := by + simp [StoreGrowthLE, ObservationGrowthLE, costObservation, + rcAllowance, Store.rcTick] + +/-- Retaining a PAP prefix performs at most one RC increment per supplied +runtime value; scalar entries cost zero, so list length is a conservative +bound. This is the first runtime producer for the source profile's dynamic +`retains` quantity. -/ +theorem dupVals_growth {store store' : Store} {values : List RVal} + (hrun : dupVals store values = .ok store') : + StoreGrowthLE store store' (rcAllowance values.length) := by + induction values generalizing store with + | nil => + change (.ok store : Except Err Store) = .ok store' at hrun + injection hrun with hstore + subst store' + simp [StoreGrowthLE, ObservationGrowthLE, costObservation, + rcAllowance] + | cons value rest ih => + cases value with + | lit literal => + simp only [dupVals, List.foldlM_cons] at hrun + have htail := ih hrun + simp [StoreGrowthLE, ObservationGrowthLE, costObservation, + rcAllowance] at htail ⊢ + omega + | erased => + simp only [dupVals, List.foldlM_cons] at hrun + have htail := ih hrun + simp [StoreGrowthLE, ObservationGrowthLE, costObservation, + rcAllowance] at htail ⊢ + omega + | loc location => + simp only [dupVals, List.foldlM_cons] at hrun + cases hget : store.get? location with + | none => simp [hget, bindErr] at hrun + | some box => + cases box with + | mk world rc node => + cases world with + | unique => simp [hget, bindErr] at hrun + | shared => + simp only [hget] at hrun + have htail := ih hrun + simp [StoreGrowthLE, ObservationGrowthLE, + costObservation, rcAllowance, Store.setBox, + Store.rcTick] at htail ⊢ + omega + +/-- Retaining a list grows the amortized RC measure by at most two per +runtime value: one instruction now and one unit of future-drop potential. +Scalars use neither unit. -/ +theorem dupVals_rcPotential_growth {store store' : Store} + {values : List RVal} (hrun : dupVals store values = .ok store') : + RcPotentialGrowthLE store store' (2 * values.length) := by + induction values generalizing store with + | nil => + change (.ok store : Except Err Store) = .ok store' at hrun + injection hrun with hstore + subst store' + exact RcPotentialGrowthLE.refl store + | cons value rest ih => + cases value with + | lit literal => + simp only [dupVals, List.foldlM_cons] at hrun + have htail := ih hrun + simp [RcPotentialGrowthLE] at htail ⊢ + omega + | erased => + simp only [dupVals, List.foldlM_cons] at hrun + have htail := ih hrun + simp [RcPotentialGrowthLE] at htail ⊢ + omega + | loc location => + simp only [dupVals, List.foldlM_cons] at hrun + cases hget : store.get? location with + | none => simp [hget, bindErr] at hrun + | some box => + cases box with + | mk world rc node => + cases world with + | unique => simp [hget, bindErr] at hrun + | shared => + simp only [hget] at hrun + have hstep := amortizedRc_incRcStore hget + have htail := ih hrun + simp only [RcPotentialGrowthLE, List.length_cons] + at htail ⊢ + simp only [Sim.incRcStore] at hstep + omega + +private def DropAmortizedRcAt (ctx : Ctx) (fuel : Nat) : Prop := + (∀ store value store', + AllocationOrderInvariant store → + dropVal ctx fuel store value = .ok store' → + amortizedRc store' = amortizedRc store ∧ + store'.allocs = store.allocs) ∧ + (∀ store values store', + AllocationOrderInvariant store → + dropMany ctx fuel store values = .ok store' → + amortizedRc store' = amortizedRc store ∧ + store'.allocs = store.allocs) ∧ + (∀ store value store', + AllocationOrderInvariant store → + dropUVal ctx fuel store value = .ok store' → + amortizedRc store' = amortizedRc store ∧ + store'.allocs = store.allocs) ∧ + (∀ store values store', + AllocationOrderInvariant store → + dropManyU ctx fuel store values = .ok store' → + amortizedRc store' = amortizedRc store ∧ + store'.allocs = store.allocs) + +/-- Shared and unique deep release conserve `rcops + sharedRcPotential` and +never allocate. The positivity premise rules out corrupt live slots with +count zero; the append-only lowerer establishes it for every successful +fresh run. -/ +private theorem dropAmortizedRcAt (ctx : Ctx) : + ∀ fuel, DropAmortizedRcAt ctx fuel := by + intro fuel + induction fuel with + | zero => + refine ⟨?_, ?_, ?_, ?_⟩ + · intro store value store' horder hrun + rw [dropVal.eq_def] at hrun + simp at hrun + · intro store values store' horder hrun + rw [dropMany.eq_def] at hrun + simp at hrun + · intro store value store' horder hrun + rw [dropUVal.eq_def] at hrun + simp at hrun + · intro store values store' horder hrun + rw [dropManyU.eq_def] at hrun + simp at hrun + | succ fuel ih => + obtain ⟨ihVal, ihMany, ihUVal, ihManyU⟩ := ih + refine ⟨?_, ?_, ?_, ?_⟩ + · intro store value store' horder hrun + cases value with + | lit literal => + rw [dropVal.eq_def] at hrun + dsimp only at hrun + injection hrun with hstore + subst store' + exact ⟨rfl, rfl⟩ + | erased => + rw [dropVal.eq_def] at hrun + dsimp only at hrun + injection hrun with hstore + subst store' + exact ⟨rfl, rfl⟩ + | loc location => + rw [dropVal.eq_def] at hrun + dsimp only at hrun + cases hget : store.get? location with + | none => simp [hget] at hrun + | some box => + rw [hget] at hrun + cases box with + | mk world rc node => + cases world with + | unique => simp at hrun + | shared => + dsimp only at hrun + by_cases hrc : rc = 1 + · subst rc + have hbeq : ((1 : Nat) == 1) = true := by decide + rw [hbeq] at hrun + have hgetTick : + store.rcTick.get? location = + some ⟨.shared, 1, node⟩ := by + simpa using hget + have hprefixOrder := + horder.rcTick.kill hgetTick + cases node with + | ctorN cid fields => + constructor + · calc + amortizedRc store' = + amortizedRc + (store.rcTick.kill location) := + (ihMany _ _ _ hprefixOrder hrun).1 + _ = amortizedRc store := + amortizedRc_tickKillSharedOne hget + · calc + store'.allocs = + (store.rcTick.kill location).allocs := + (ihMany _ _ _ hprefixOrder hrun).2 + _ = store.allocs := by rfl + | papN address arity args => + constructor + · calc + amortizedRc store' = + amortizedRc + (store.rcTick.kill location) := + (ihMany _ _ _ hprefixOrder hrun).1 + _ = amortizedRc store := + amortizedRc_tickKillSharedOne hget + · calc + store'.allocs = + (store.rcTick.kill location).allocs := + (ihMany _ _ _ hprefixOrder hrun).2 + _ = store.allocs := by rfl + · have hpos : 0 < rc := horder.rc_pos hget + have hmany : 1 < rc := by omega + have hbeq : (rc == 1) = false := by simp [hrc] + rw [hbeq] at hrun + injection hrun with hstore + subst store' + constructor + · simpa only [Sim.decRcStore] using + amortizedRc_decRcStore hmany hget + · rfl + · intro store values store' horder hrun + cases values with + | nil => + rw [dropMany.eq_def] at hrun + dsimp only at hrun + injection hrun with hstore + subst store' + exact ⟨rfl, rfl⟩ + | cons value values => + rw [dropMany.eq_def] at hrun + dsimp only at hrun + cases hfirst : dropVal ctx fuel store value with + | error err => rw [hfirst, bindErr] at hrun; contradiction + | ok middle => + rw [hfirst] at hrun + constructor + · calc + amortizedRc store' = amortizedRc middle := + (ihMany _ _ _ (horder.dropVal hfirst) hrun).1 + _ = amortizedRc store := + (ihVal _ _ _ horder hfirst).1 + · calc + store'.allocs = middle.allocs := + (ihMany _ _ _ (horder.dropVal hfirst) hrun).2 + _ = store.allocs := + (ihVal _ _ _ horder hfirst).2 + · intro store value store' horder hrun + cases value with + | lit literal => + rw [dropUVal.eq_def] at hrun + dsimp only at hrun + injection hrun with hstore + subst store' + exact ⟨rfl, rfl⟩ + | erased => + rw [dropUVal.eq_def] at hrun + dsimp only at hrun + injection hrun with hstore + subst store' + exact ⟨rfl, rfl⟩ + | loc location => + rw [dropUVal.eq_def] at hrun + dsimp only at hrun + cases hget : store.get? location with + | none => simp [hget] at hrun + | some box => + rw [hget] at hrun + cases box with + | mk world rc node => + cases world with + | shared => simp at hrun + | unique => + cases node with + | ctorN cid fields => + constructor + · calc + amortizedRc store' = + amortizedRc (store.kill location) := + (ihManyU _ _ _ (horder.kill hget) hrun).1 + _ = amortizedRc store := + amortizedRc_killUnique hget + · calc + store'.allocs = + (store.kill location).allocs := + (ihManyU _ _ _ + (horder.kill hget) hrun).2 + _ = store.allocs := by rfl + | papN address arity args => simp at hrun + · intro store values store' horder hrun + cases values with + | nil => + rw [dropManyU.eq_def] at hrun + dsimp only at hrun + injection hrun with hstore + subst store' + exact ⟨rfl, rfl⟩ + | cons value values => + rw [dropManyU.eq_def] at hrun + dsimp only at hrun + cases hfirst : dropUVal ctx fuel store value with + | error err => rw [hfirst, bindErr] at hrun; contradiction + | ok middle => + rw [hfirst] at hrun + constructor + · calc + amortizedRc store' = amortizedRc middle := + (ihManyU _ _ _ (horder.dropUVal hfirst) hrun).1 + _ = amortizedRc store := + (ihUVal _ _ _ horder hfirst).1 + · calc + store'.allocs = middle.allocs := + (ihManyU _ _ _ (horder.dropUVal hfirst) hrun).2 + _ = store.allocs := + (ihUVal _ _ _ horder hfirst).2 + +theorem dropVal_amortizedRc {ctx : Ctx} {fuel : Nat} + {store store' : Store} {value : RVal} + (horder : AllocationOrderInvariant store) + (hrun : dropVal ctx fuel store value = .ok store') : + amortizedRc store' = amortizedRc store := + ((dropAmortizedRcAt ctx fuel).1 store value store' horder hrun).1 + +theorem dropMany_amortizedRc {ctx : Ctx} {fuel : Nat} + {store store' : Store} {values : List RVal} + (horder : AllocationOrderInvariant store) + (hrun : dropMany ctx fuel store values = .ok store') : + amortizedRc store' = amortizedRc store := + ((dropAmortizedRcAt ctx fuel).2.1 store values store' horder hrun).1 + +theorem dropUVal_amortizedRc {ctx : Ctx} {fuel : Nat} + {store store' : Store} {value : RVal} + (horder : AllocationOrderInvariant store) + (hrun : dropUVal ctx fuel store value = .ok store') : + amortizedRc store' = amortizedRc store := + ((dropAmortizedRcAt ctx fuel).2.2.1 store value store' horder hrun).1 + +theorem dropManyU_amortizedRc {ctx : Ctx} {fuel : Nat} + {store store' : Store} {values : List RVal} + (horder : AllocationOrderInvariant store) + (hrun : dropManyU ctx fuel store values = .ok store') : + amortizedRc store' = amortizedRc store := + ((dropAmortizedRcAt ctx fuel).2.2.2 store values store' horder hrun).1 + +theorem dropVal_allocs {ctx : Ctx} {fuel : Nat} + {store store' : Store} {value : RVal} + (horder : AllocationOrderInvariant store) + (hrun : dropVal ctx fuel store value = .ok store') : + store'.allocs = store.allocs := + ((dropAmortizedRcAt ctx fuel).1 store value store' horder hrun).2 + +theorem dropMany_allocs {ctx : Ctx} {fuel : Nat} + {store store' : Store} {values : List RVal} + (horder : AllocationOrderInvariant store) + (hrun : dropMany ctx fuel store values = .ok store') : + store'.allocs = store.allocs := + ((dropAmortizedRcAt ctx fuel).2.1 store values store' horder hrun).2 + +theorem dropUVal_allocs {ctx : Ctx} {fuel : Nat} + {store store' : Store} {value : RVal} + (horder : AllocationOrderInvariant store) + (hrun : dropUVal ctx fuel store value = .ok store') : + store'.allocs = store.allocs := + ((dropAmortizedRcAt ctx fuel).2.2.1 store value store' horder hrun).2 + +theorem dropManyU_allocs {ctx : Ctx} {fuel : Nat} + {store store' : Store} {values : List RVal} + (horder : AllocationOrderInvariant store) + (hrun : dropManyU ctx fuel store values = .ok store') : + store'.allocs = store.allocs := + ((dropAmortizedRcAt ctx fuel).2.2.2 store values store' horder hrun).2 + +theorem dropVal_rcPotential_growth {ctx : Ctx} {fuel : Nat} + {store store' : Store} {value : RVal} + (horder : AllocationOrderInvariant store) + (hrun : dropVal ctx fuel store value = .ok store') : + RcPotentialGrowthLE store store' 0 := by + simp [RcPotentialGrowthLE, dropVal_amortizedRc horder hrun] + +theorem dropUVal_rcPotential_growth {ctx : Ctx} {fuel : Nat} + {store store' : Store} {value : RVal} + (horder : AllocationOrderInvariant store) + (hrun : dropUVal ctx fuel store value = .ok store') : + RcPotentialGrowthLE store store' 0 := by + simp [RcPotentialGrowthLE, dropUVal_amortizedRc horder hrun] + +/-! ## Primitive-operation potential contracts -/ + +/-- Amortized RC allowance for every non-recursive operation emitted by the +current append-only lowering. `reuse` is excluded because it can invalidate +allocation order; calls and `apply` require separate recursive contracts. +Allocating a shared node creates one unit of pending RC potential, while a +successful shared `dup` both executes an RC instruction and creates one unit +of potential. -/ +def localOpRcAllowance : Op → Option Nat + | .pure _ => some 0 + | .alloc _ _ _ => some 1 + | .reuse _ _ _ => none + | .free _ => some 0 + | .dup _ => some 2 + | .drop _ => some 0 + | .dropU _ => some 0 + | .fetch _ _ => some 0 + | .call _ _ => none + | .callSelf _ => none + | .papp _ _ => some 1 + | .apply _ _ => none + | .extern _ _ => some 0 + +/-- Heap-allocation allowance for a primitive operation. Only constructor +and PAP creation append a node; the RC classifier above excludes the +recursive operations and `reuse` before this value is consumed. -/ +def localOpAllocationAllowance : Op → Nat + | .alloc _ _ _ | .papp _ _ => 1 + | _ => 0 + +/-- Every classified primitive stays within its allocation and amortized RC +allowances and leaves the reuse counter unchanged. Deep shared and unique +release use the fuel-inductive theorem above, so both of their allowances are +exactly zero regardless of the size of the released value. -/ +private theorem runOp_localOwnership_components + {ctx : Ctx} {fuel : Nat} {cur : FnDef} {store store' : Store} + {env : List RVal} {op : Op} {value : RVal} {allowance : Nat} + (hlocal : localOpRcAllowance op = some allowance) + (horder : AllocationOrderInvariant store) + (hrun : runOp ctx fuel cur store env op = .ok (store', value)) : + store'.allocs ≤ store.allocs + localOpAllocationAllowance op ∧ + store'.reuses = store.reuses ∧ + RcPotentialGrowthLE store store' allowance := by + cases fuel with + | zero => + simp [runOp] at hrun + | succ fuel => + cases op with + | pure atom => + simp only [localOpRcAllowance, Option.some.injEq] at hlocal + subst allowance + rw [runOp.eq_def] at hrun + dsimp only at hrun + cases hresolve : resolveAtom env atom with + | error err => rw [hresolve, bindErr] at hrun; contradiction + | ok result => + rw [hresolve, bindOk] at hrun + have hpair := Except.ok.inj hrun + cases hpair + exact ⟨by simp [localOpAllocationAllowance], rfl, + RcPotentialGrowthLE.refl store⟩ + | alloc world cid atoms => + simp only [localOpRcAllowance, Option.some.injEq] at hlocal + subst allowance + rw [runOp.eq_def] at hrun + dsimp only at hrun + cases hresolve : resolveAtoms env atoms with + | error err => rw [hresolve, bindErr] at hrun; contradiction + | ok values => + rw [hresolve, bindOk] at hrun + have hpair := Except.ok.inj hrun + cases hpair + exact ⟨by simp [localOpAllocationAllowance, Store.allocNode], + by simp [Store.allocNode], + RcPotentialGrowthLE.allocNode store world + (.ctorN cid values.toArray)⟩ + | reuse target cid atoms => + simp [localOpRcAllowance] at hlocal + | free target => + simp only [localOpRcAllowance, Option.some.injEq] at hlocal + subst allowance + rw [runOp.eq_def] at hrun + dsimp only at hrun + cases htarget : resolveAtom env target with + | error err => rw [htarget, bindErr] at hrun; contradiction + | ok targetValue => + rw [htarget, bindOk] at hrun + cases targetValue with + | lit literal => simp at hrun + | erased => simp at hrun + | loc location => + cases hbox : store.get? location with + | none => simp [hbox] at hrun + | some box => + simp only [hbox] at hrun + cases box with + | mk world rc node => + cases world with + | shared => simp at hrun + | unique => + have hpair := Except.ok.inj hrun + cases hpair + exact ⟨by + simp [localOpAllocationAllowance, + Store.kill], rfl, by + simp [RcPotentialGrowthLE, + amortizedRc_killUnique hbox]⟩ + | dup target => + simp only [localOpRcAllowance, Option.some.injEq] at hlocal + subst allowance + rw [runOp.eq_def] at hrun + dsimp only at hrun + cases htarget : resolveAtom env target with + | error err => rw [htarget, bindErr] at hrun; contradiction + | ok targetValue => + rw [htarget, bindOk] at hrun + cases targetValue with + | lit literal => + have hpair := Except.ok.inj hrun + cases hpair + exact ⟨by simp [localOpAllocationAllowance], rfl, by + simp [RcPotentialGrowthLE]⟩ + | erased => + have hpair := Except.ok.inj hrun + cases hpair + exact ⟨by simp [localOpAllocationAllowance], rfl, by + simp [RcPotentialGrowthLE]⟩ + | loc location => + cases hbox : store.get? location with + | none => simp [hbox] at hrun + | some box => + simp only [hbox] at hrun + cases box with + | mk world rc node => + cases world with + | unique => simp at hrun + | shared => + have hpair := Except.ok.inj hrun + cases hpair + have hstep := amortizedRc_incRcStore hbox + refine ⟨?_, rfl, ?_⟩ + · simp [localOpAllocationAllowance, + Store.setBox, Store.rcTick] + · simp only [RcPotentialGrowthLE] + simpa only [Sim.incRcStore] using + Nat.le_of_eq hstep + | drop target => + simp only [localOpRcAllowance, Option.some.injEq] at hlocal + subst allowance + rw [runOp.eq_def] at hrun + dsimp only at hrun + cases htarget : resolveAtom env target with + | error err => rw [htarget, bindErr] at hrun; contradiction + | ok targetValue => + rw [htarget, bindOk] at hrun + cases targetValue with + | lit literal => + have hpair := Except.ok.inj hrun + cases hpair + exact ⟨by simp [localOpAllocationAllowance], rfl, + RcPotentialGrowthLE.refl store⟩ + | erased => + have hpair := Except.ok.inj hrun + cases hpair + exact ⟨by simp [localOpAllocationAllowance], rfl, + RcPotentialGrowthLE.refl store⟩ + | loc location => + dsimp only at hrun + cases hdrop : dropVal ctx fuel store (.loc location) with + | error err => rw [hdrop, bindErr] at hrun; contradiction + | ok dropped => + rw [hdrop, bindOk] at hrun + have hpair := Except.ok.inj hrun + cases hpair + exact ⟨by + simpa [localOpAllocationAllowance] using + Nat.le_of_eq (dropVal_allocs horder hdrop), + NoReuse.dropVal_reuses hdrop, + dropVal_rcPotential_growth horder hdrop⟩ + | dropU target => + simp only [localOpRcAllowance, Option.some.injEq] at hlocal + subst allowance + rw [runOp.eq_def] at hrun + dsimp only at hrun + cases htarget : resolveAtom env target with + | error err => rw [htarget, bindErr] at hrun; contradiction + | ok targetValue => + rw [htarget, bindOk] at hrun + cases targetValue with + | lit literal => + have hpair := Except.ok.inj hrun + cases hpair + exact ⟨by simp [localOpAllocationAllowance], rfl, + RcPotentialGrowthLE.refl store⟩ + | erased => + have hpair := Except.ok.inj hrun + cases hpair + exact ⟨by simp [localOpAllocationAllowance], rfl, + RcPotentialGrowthLE.refl store⟩ + | loc location => + dsimp only at hrun + cases hdrop : dropUVal ctx fuel store (.loc location) with + | error err => rw [hdrop, bindErr] at hrun; contradiction + | ok dropped => + rw [hdrop, bindOk] at hrun + have hpair := Except.ok.inj hrun + cases hpair + exact ⟨by + simpa [localOpAllocationAllowance] using + Nat.le_of_eq (dropUVal_allocs horder hdrop), + NoReuse.dropUVal_reuses hdrop, + dropUVal_rcPotential_growth horder hdrop⟩ + | fetch target field => + simp only [localOpRcAllowance, Option.some.injEq] at hlocal + subst allowance + rw [runOp.eq_def] at hrun + dsimp only at hrun + cases htarget : resolveAtom env target with + | error err => rw [htarget, bindErr] at hrun; contradiction + | ok targetValue => + rw [htarget, bindOk] at hrun + cases targetValue with + | lit literal => simp at hrun + | erased => simp at hrun + | loc location => + cases hbox : store.get? location with + | none => simp [hbox] at hrun + | some box => + simp only [hbox] at hrun + cases box with + | mk world rc node => + cases node with + | papN address arity args => simp at hrun + | ctorN cid fields => + cases hfield : fields[field]? with + | none => simp [hfield] at hrun + | some result => + simp only [hfield] at hrun + have hpair := Except.ok.inj hrun + cases hpair + exact ⟨by + simp [localOpAllocationAllowance], rfl, + RcPotentialGrowthLE.refl store⟩ + | call address atoms => + simp [localOpRcAllowance] at hlocal + | callSelf atoms => + simp [localOpRcAllowance] at hlocal + | papp address atoms => + simp only [localOpRcAllowance, Option.some.injEq] at hlocal + subst allowance + rw [runOp.eq_def] at hrun + dsimp only at hrun + cases hresolve : resolveAtoms env atoms with + | error err => rw [hresolve, bindErr] at hrun; contradiction + | ok values => + rw [hresolve, bindOk] at hrun + cases hdecl : ctx.decls address with + | none => simp [hdecl] at hrun + | some decl => + simp only [hdecl] at hrun + by_cases hlen : values.length < declArity decl + · simp only [hlen, if_true] at hrun + have hpair := Except.ok.inj hrun + cases hpair + exact ⟨by + simp [localOpAllocationAllowance, Store.allocNode], + by simp [Store.allocNode], + RcPotentialGrowthLE.allocNode store .shared + (.papN address (declArity decl) values.toArray)⟩ + · simp [hlen] at hrun + | apply function atoms => + simp [localOpRcAllowance] at hlocal + | extern address atoms => + simp only [localOpRcAllowance, Option.some.injEq] at hlocal + subst allowance + rw [runOp.eq_def] at hrun + dsimp only at hrun + cases hresolve : resolveAtoms env atoms with + | error err => rw [hresolve, bindErr] at hrun; contradiction + | ok values => + rw [hresolve, bindOk] at hrun + cases hcall : callScalarOracle ctx address values with + | error err => rw [hcall, bindErr] at hrun; contradiction + | ok result => + rw [hcall, bindOk] at hrun + have hpair := Except.ok.inj hrun + cases hpair + exact ⟨by simp [localOpAllocationAllowance], rfl, + RcPotentialGrowthLE.refl store⟩ + +/-- RC-only projection retained for callers that do not yet need allocation +accounting. -/ +theorem runOp_localRcPotential_growth + {ctx : Ctx} {fuel : Nat} {cur : FnDef} {store store' : Store} + {env : List RVal} {op : Op} {value : RVal} {allowance : Nat} + (hlocal : localOpRcAllowance op = some allowance) + (horder : AllocationOrderInvariant store) + (hrun : runOp ctx fuel cur store env op = .ok (store', value)) : + store'.reuses = store.reuses ∧ + RcPotentialGrowthLE store store' allowance := + (runOp_localOwnership_components hlocal horder hrun).2 + +/-- The two resources needed by the retain-aware ownership tariff. Keeping +them paired prevents a lowering proof from composing an allocation estimate +that came from a different primitive decomposition than its RC estimate. -/ +@[ext] structure OwnershipAllowance where + allocations : Nat + rcPotential : Nat + deriving BEq, DecidableEq, Repr + +/-- Componentwise addition of ownership allowances. -/ +def OwnershipAllowance.add (left right : OwnershipAllowance) : + OwnershipAllowance := + { allocations := left.allocations + right.allocations + rcPotential := left.rcPotential + right.rcPotential } + +/-- Componentwise ordering of paired ownership allowances. -/ +def OwnershipAllowanceLE (actual budget : OwnershipAllowance) : Prop := + actual.allocations ≤ budget.allocations ∧ + actual.rcPotential ≤ budget.rcPotential + +theorem OwnershipAllowanceLE.refl (allowance : OwnershipAllowance) : + OwnershipAllowanceLE allowance allowance := by + simp [OwnershipAllowanceLE] + +theorem OwnershipAllowanceLE.trans {first middle last : OwnershipAllowance} + (hfirst : OwnershipAllowanceLE first middle) + (hsecond : OwnershipAllowanceLE middle last) : + OwnershipAllowanceLE first last := by + simp only [OwnershipAllowanceLE] at hfirst hsecond ⊢ + omega + +theorem OwnershipAllowanceLE.add {leftActual leftBudget rightActual + rightBudget : OwnershipAllowance} + (hleft : OwnershipAllowanceLE leftActual leftBudget) + (hright : OwnershipAllowanceLE rightActual rightBudget) : + OwnershipAllowanceLE (leftActual.add rightActual) + (leftBudget.add rightBudget) := by + simp only [OwnershipAllowanceLE, OwnershipAllowance.add] at hleft hright ⊢ + omega + +/-- Allocation and potential growth carried by one target transition. Local +operations preserve the reuse counter; this both excludes reuse-based heap +mutation and supplies the allocation-order premise needed for sequencing. -/ +def OwnershipGrowthLE (before after : Store) + (allowance : OwnershipAllowance) : Prop := + after.allocs ≤ before.allocs + allowance.allocations ∧ + after.reuses = before.reuses ∧ + RcPotentialGrowthLE before after allowance.rcPotential + +theorem OwnershipGrowthLE.refl (store : Store) : + OwnershipGrowthLE store store ⟨0, 0⟩ := by + exact ⟨by simp, rfl, RcPotentialGrowthLE.refl store⟩ + +theorem OwnershipGrowthLE.trans {first middle last : Store} + {left right : OwnershipAllowance} + (hleft : OwnershipGrowthLE first middle left) + (hright : OwnershipGrowthLE middle last right) : + OwnershipGrowthLE first last (left.add right) := by + rcases hleft with ⟨hallocLeft, hreusesLeft, hrcLeft⟩ + rcases hright with ⟨hallocRight, hreusesRight, hrcRight⟩ + refine ⟨?_, hreusesRight.trans hreusesLeft, ?_⟩ + · simp only [OwnershipAllowance.add] + omega + · exact hrcLeft.trans hrcRight + +theorem OwnershipGrowthLE.monoAllowance {before after : Store} + {smaller larger : OwnershipAllowance} + (hgrowth : OwnershipGrowthLE before after smaller) + (hle : OwnershipAllowanceLE smaller larger) : + OwnershipGrowthLE before after larger := by + rcases hgrowth with ⟨halloc, hreuses, hrc⟩ + exact ⟨by + simp only [OwnershipAllowanceLE] at hle + omega, + hreuses, hrc.monoAllowance hle.2⟩ + +/-- Amortized allowance for retaining a dynamic list of runtime values. -/ +def retainedOwnershipAllowance (count : Nat) : OwnershipAllowance := + ⟨0, 2 * count⟩ + +theorem OwnershipGrowthLE.allocNode (store : Store) (world : Ixon.Owned) + (node : Node) : + OwnershipGrowthLE store (store.allocNode world node).1 ⟨1, 1⟩ := by + exact ⟨by simp [Store.allocNode], by simp [Store.allocNode], + RcPotentialGrowthLE.allocNode store world node⟩ + +/-- Retaining a runtime list changes no allocation/reuse counter and costs at +most two amortized RC units per entry. -/ +theorem dupVals_ownership_growth {store store' : Store} + {values : List RVal} (hrun : dupVals store values = .ok store') : + OwnershipGrowthLE store store' + (retainedOwnershipAllowance values.length) := by + have hcounters := dupVals_growth hrun + simp only [StoreGrowthLE, ObservationGrowthLE, costObservation, + rcAllowance, Nat.add_zero] at hcounters + exact ⟨hcounters.1, NoReuse.dupVals_reuses hrun, + dupVals_rcPotential_growth hrun⟩ + +theorem dropVal_ownership_growth {ctx : Ctx} {fuel : Nat} + {store store' : Store} {value : RVal} + (horder : AllocationOrderInvariant store) + (hrun : dropVal ctx fuel store value = .ok store') : + OwnershipGrowthLE store store' ⟨0, 0⟩ := + ⟨by simpa using Nat.le_of_eq (dropVal_allocs horder hrun), + NoReuse.dropVal_reuses hrun, dropVal_rcPotential_growth horder hrun⟩ + +theorem dropMany_ownership_growth {ctx : Ctx} {fuel : Nat} + {store store' : Store} {values : List RVal} + (horder : AllocationOrderInvariant store) + (hrun : dropMany ctx fuel store values = .ok store') : + OwnershipGrowthLE store store' ⟨0, 0⟩ := + ⟨by simpa using Nat.le_of_eq (dropMany_allocs horder hrun), + NoReuse.dropMany_reuses hrun, by + simp [RcPotentialGrowthLE, dropMany_amortizedRc horder hrun]⟩ + +theorem dropUVal_ownership_growth {ctx : Ctx} {fuel : Nat} + {store store' : Store} {value : RVal} + (horder : AllocationOrderInvariant store) + (hrun : dropUVal ctx fuel store value = .ok store') : + OwnershipGrowthLE store store' ⟨0, 0⟩ := + ⟨by simpa using Nat.le_of_eq (dropUVal_allocs horder hrun), + NoReuse.dropUVal_reuses hrun, dropUVal_rcPotential_growth horder hrun⟩ + +theorem dropManyU_ownership_growth {ctx : Ctx} {fuel : Nat} + {store store' : Store} {values : List RVal} + (horder : AllocationOrderInvariant store) + (hrun : dropManyU ctx fuel store values = .ok store') : + OwnershipGrowthLE store store' ⟨0, 0⟩ := + ⟨by simpa using Nat.le_of_eq (dropManyU_allocs horder hrun), + NoReuse.dropManyU_reuses hrun, by + simp [RcPotentialGrowthLE, dropManyU_amortizedRc horder hrun]⟩ + +/-- Complete paired allowance table for non-recursive primitive operations. +Constructor and PAP allocation each append one shared node and create one +unit of pending RC potential; a shared retain costs one RC instruction and +creates one potential unit. -/ +def localOpOwnershipAllowance : Op → Option OwnershipAllowance + | .pure _ => some ⟨0, 0⟩ + | .alloc _ _ _ => some ⟨1, 1⟩ + | .reuse _ _ _ => none + | .free _ => some ⟨0, 0⟩ + | .dup _ => some ⟨0, 2⟩ + | .drop _ => some ⟨0, 0⟩ + | .dropU _ => some ⟨0, 0⟩ + | .fetch _ _ => some ⟨0, 0⟩ + | .call _ _ => none + | .callSelf _ => none + | .papp _ _ => some ⟨1, 1⟩ + | .apply _ _ => none + | .extern _ _ => some ⟨0, 0⟩ + +private theorem localOpOwnershipAllowance_components + {op : Op} {allowance : OwnershipAllowance} + (hlocal : localOpOwnershipAllowance op = some allowance) : + localOpAllocationAllowance op = allowance.allocations ∧ + localOpRcAllowance op = some allowance.rcPotential := by + cases op <;> + simp [localOpOwnershipAllowance, localOpAllocationAllowance, + localOpRcAllowance] at hlocal ⊢ + all_goals cases hlocal + all_goals exact ⟨rfl, rfl⟩ + +/-- A successful paired lookup is a proof-producing primitive cost contract. +The evaluator induction is shared with the legacy RC-only projection above. -/ +theorem runOp_localOwnership_growth + {ctx : Ctx} {fuel : Nat} {cur : FnDef} {store store' : Store} + {env : List RVal} {op : Op} {value : RVal} + {allowance : OwnershipAllowance} + (hlocal : localOpOwnershipAllowance op = some allowance) + (horder : AllocationOrderInvariant store) + (hrun : runOp ctx fuel cur store env op = .ok (store', value)) : + OwnershipGrowthLE store store' allowance := by + obtain ⟨hallocAllowance, hrcAllowance⟩ := + localOpOwnershipAllowance_components hlocal + obtain ⟨halloc, hreuses, hrc⟩ := + runOp_localOwnership_components hrcAllowance horder hrun + exact ⟨by simpa only [hallocAllowance] using halloc, hreuses, hrc⟩ + +/-- State-transformer contract for one operation. Besides its amortized RC +bound, the contract carries exactly the append-order and environment-bounds +facts needed to sequence a following `Code.letOp`. -/ +def OpRcPotentialSound (ctx : Ctx) (cur : FnDef) (op : Op) + (allowance : Nat) : Prop := + ∀ {fuel store env store' value}, + AllocationOrderInvariant store → + ValuesInBounds store env → + runOp ctx fuel cur store env op = .ok (store', value) → + AllocationOrderInvariant store' ∧ + ValuesInBounds store' (value :: env) ∧ + store'.reuses = store.reuses ∧ + RcPotentialGrowthLE store store' allowance + +/-- The local allowance table is a complete proof-producing classifier: a +successful lookup yields the full operation contract, not merely a numeric +estimate. -/ +theorem OpRcPotentialSound.of_local + {ctx : Ctx} {cur : FnDef} {op : Op} {allowance : Nat} + (hlocal : localOpRcAllowance op = some allowance) : + OpRcPotentialSound ctx cur op allowance := by + intro fuel store env store' value horder henv hrun + obtain ⟨hreuses, hgrowth⟩ := + runOp_localRcPotential_growth hlocal horder hrun + obtain ⟨horder', hvalue⟩ := + runOp_order_of_reuses_eq horder henv hreuses hrun + have henv' : ValuesInBounds store' env := + henv.mono (runOp_footprint hrun).nodes_size + exact ⟨horder', henv'.cons hvalue, hreuses, hgrowth⟩ + +/-- Whole-code counterpart of `OpRcPotentialSound`. A code contract records +its final value bound, unchanged reuse count, and total amortized RC growth. +This is deliberately independent of source profiles, so compiler inductions +can first compose target instructions and attach source-event charges later. -/ +def CodeRcPotentialSound (ctx : Ctx) (cur : FnDef) (code : Code) + (allowance : Nat) : Prop := + ∀ {fuel store env store' value}, + AllocationOrderInvariant store → + ValuesInBounds store env → + runCode ctx fuel cur store env code = .ok (store', value) → + AllocationOrderInvariant store' ∧ + ValueInBounds store' value ∧ + store'.reuses = store.reuses ∧ + RcPotentialGrowthLE store store' allowance + +theorem CodeRcPotentialSound.ret {ctx : Ctx} {cur : FnDef} (atom : Atom) : + CodeRcPotentialSound ctx cur (.ret atom) 0 := by + intro fuel store env store' value horder henv hrun + cases fuel with + | zero => simp [runCode] at hrun + | succ fuel => + rw [runCode.eq_def] at hrun + dsimp only at hrun + cases hresolve : resolveAtom env atom with + | error err => rw [hresolve, bindErr] at hrun; contradiction + | ok result => + rw [hresolve, bindOk] at hrun + have hpair := Except.ok.inj hrun + cases hpair + exact ⟨horder, resolveAtom_inBounds henv hresolve, rfl, + RcPotentialGrowthLE.refl store⟩ + +/-- A difference-list emitter adds `allowance` in front of every already +certified continuation. Quantifying over the continuation budget makes the +judgment close under ordinary emitter composition. -/ +def EmitRcPotentialSound (ctx : Ctx) (cur : FnDef) (emit : Emit) + (allowance : Nat) : Prop := + ∀ {continuation : Code} {continuationAllowance : Nat}, + CodeRcPotentialSound ctx cur continuation continuationAllowance → + CodeRcPotentialSound ctx cur (emit continuation) + (allowance + continuationAllowance) + +theorem EmitRcPotentialSound.id {ctx : Ctx} {cur : FnDef} : + EmitRcPotentialSound ctx cur (_root_.id : Emit) 0 := by + intro continuation continuationAllowance hcontinuation + intro fuel store env store' value horder henv hrun + obtain ⟨horder', hvalue, hreuses, hgrowth⟩ := + hcontinuation horder henv hrun + exact ⟨horder', hvalue, hreuses, by + simpa only [Nat.zero_add] using hgrowth⟩ + +theorem EmitRcPotentialSound.comp {ctx : Ctx} {cur : FnDef} + {first second : Emit} {firstAllowance secondAllowance : Nat} + (hfirst : EmitRcPotentialSound ctx cur first firstAllowance) + (hsecond : EmitRcPotentialSound ctx cur second secondAllowance) : + EmitRcPotentialSound ctx cur (first ∘ second) + (firstAllowance + secondAllowance) := by + intro continuation continuationAllowance hcontinuation + have hsecondCode : + CodeRcPotentialSound ctx cur (second continuation) + (secondAllowance + continuationAllowance) := + hsecond (continuation := continuation) + (continuationAllowance := continuationAllowance) hcontinuation + have hfirstCode : + CodeRcPotentialSound ctx cur (first (second continuation)) + (firstAllowance + (secondAllowance + continuationAllowance)) := + hfirst (continuation := second continuation) + (continuationAllowance := secondAllowance + continuationAllowance) + hsecondCode + intro fuel store env store' value horder henv hrun + change runCode ctx fuel cur store env (first (second continuation)) = + .ok (store', value) at hrun + obtain ⟨horder', hvalue, hreuses, hgrowth⟩ := + hfirstCode horder henv hrun + exact ⟨horder', hvalue, hreuses, by + simpa only [Nat.add_assoc] using hgrowth⟩ + +/-- Lift one operation contract through `Code.letOp`. The operation result +and old environment are precisely the continuation environment promised by +`OpRcPotentialSound`; potential growth then composes transitively. -/ +theorem OpRcPotentialSound.emit {ctx : Ctx} {cur : FnDef} {op : Op} + {allowance : Nat} (hop : OpRcPotentialSound ctx cur op allowance) : + EmitRcPotentialSound ctx cur (emitOp op) allowance := by + intro continuation continuationAllowance hcontinuation + intro fuel store env finalStore finalValue horder henv hrun + cases fuel with + | zero => simp [runCode] at hrun + | succ fuel => + rw [runCode.eq_def] at hrun + dsimp only [emitOp] at hrun + cases hopEval : runOp ctx fuel cur store env op with + | error err => + rw [hopEval] at hrun + change (Except.error err : Except Err (Store × RVal)) = + .ok (finalStore, finalValue) at hrun + contradiction + | ok out => + rcases out with ⟨middle, opValue⟩ + rw [hopEval] at hrun + change runCode ctx fuel cur middle (opValue :: env) continuation = + .ok (finalStore, finalValue) at hrun + obtain ⟨hmiddleOrder, hmiddleEnv, hstepReuse, hstepGrowth⟩ := + hop horder henv hopEval + obtain ⟨hfinalOrder, hfinalValue, hcontinuationReuse, + hcontinuationGrowth⟩ := + hcontinuation hmiddleOrder hmiddleEnv hrun + exact ⟨hfinalOrder, hfinalValue, + hcontinuationReuse.trans hstepReuse, + hstepGrowth.trans hcontinuationGrowth⟩ + +/-- Direct compiler-facing rule for one classified emitted operation. -/ +theorem EmitRcPotentialSound.localOp + {ctx : Ctx} {cur : FnDef} {op : Op} {allowance : Nat} + (hlocal : localOpRcAllowance op = some allowance) : + EmitRcPotentialSound ctx cur (emitOp op) allowance := + OpRcPotentialSound.emit + (OpRcPotentialSound.of_local (ctx := ctx) (cur := cur) hlocal) + +/-- Seal a certified emitter with a return continuation. -/ +theorem EmitRcPotentialSound.closeRet {ctx : Ctx} {cur : FnDef} + {emit : Emit} {allowance : Nat} + (hemit : EmitRcPotentialSound ctx cur emit allowance) (atom : Atom) : + CodeRcPotentialSound ctx cur (emit (.ret atom)) allowance := by + have hcode : CodeRcPotentialSound ctx cur (emit (.ret atom)) + (allowance + 0) := + hemit (continuation := .ret atom) (continuationAllowance := 0) + (CodeRcPotentialSound.ret atom) + intro fuel store env store' value horder henv hrun + obtain ⟨horder', hvalue, hreuses, hgrowth⟩ := + hcode horder henv hrun + exact ⟨horder', hvalue, hreuses, by + simpa only [Nat.add_zero] using hgrowth⟩ + +/-! ## Paired ownership-cost contracts -/ + +/-- State-transformer contract for one operation, pairing append allocation +with amortized RC potential. This is the compiler-facing refinement of the +RC-only contract above. -/ +def OpOwnershipCostSound (ctx : Ctx) (cur : FnDef) (op : Op) + (allowance : OwnershipAllowance) : Prop := + ∀ {fuel store env store' value}, + AllocationOrderInvariant store → + ValuesInBounds store env → + runOp ctx fuel cur store env op = .ok (store', value) → + AllocationOrderInvariant store' ∧ + ValuesInBounds store' (value :: env) ∧ + OwnershipGrowthLE store store' allowance + +/-- Every successful lookup in the paired primitive table yields the full +sequencing contract. -/ +theorem OpOwnershipCostSound.of_local + {ctx : Ctx} {cur : FnDef} {op : Op} + {allowance : OwnershipAllowance} + (hlocal : localOpOwnershipAllowance op = some allowance) : + OpOwnershipCostSound ctx cur op allowance := by + intro fuel store env store' value horder henv hrun + have hgrowth := runOp_localOwnership_growth hlocal horder hrun + obtain ⟨horder', hvalue⟩ := + runOp_order_of_reuses_eq horder henv hgrowth.2.1 hrun + have henv' : ValuesInBounds store' env := + henv.mono (runOp_footprint hrun).nodes_size + exact ⟨horder', henv'.cons hvalue, hgrowth⟩ + +/-- Whole-code paired ownership contract. -/ +def CodeOwnershipCostSound (ctx : Ctx) (cur : FnDef) (code : Code) + (allowance : OwnershipAllowance) : Prop := + ∀ {fuel store env store' value}, + AllocationOrderInvariant store → + ValuesInBounds store env → + runCode ctx fuel cur store env code = .ok (store', value) → + AllocationOrderInvariant store' ∧ + ValueInBounds store' value ∧ + OwnershipGrowthLE store store' allowance + +theorem CodeOwnershipCostSound.ret {ctx : Ctx} {cur : FnDef} + (atom : Atom) : + CodeOwnershipCostSound ctx cur (.ret atom) ⟨0, 0⟩ := by + intro fuel store env store' value horder henv hrun + cases fuel with + | zero => simp [runCode] at hrun + | succ fuel => + rw [runCode.eq_def] at hrun + dsimp only at hrun + cases hresolve : resolveAtom env atom with + | error err => rw [hresolve, bindErr] at hrun; contradiction + | ok result => + rw [hresolve, bindOk] at hrun + have hpair := Except.ok.inj hrun + cases hpair + exact ⟨horder, resolveAtom_inBounds henv hresolve, + OwnershipGrowthLE.refl store⟩ + +/-- A difference-list emitter contributes one paired allowance in front of +every certified continuation. -/ +def EmitOwnershipCostSound (ctx : Ctx) (cur : FnDef) (emit : Emit) + (allowance : OwnershipAllowance) : Prop := + ∀ {continuation : Code} + {continuationAllowance : OwnershipAllowance}, + CodeOwnershipCostSound ctx cur continuation continuationAllowance → + CodeOwnershipCostSound ctx cur (emit continuation) + (allowance.add continuationAllowance) + +theorem EmitOwnershipCostSound.id {ctx : Ctx} {cur : FnDef} : + EmitOwnershipCostSound ctx cur (_root_.id : Emit) ⟨0, 0⟩ := by + intro continuation continuationAllowance hcontinuation + intro fuel store env store' value horder henv hrun + obtain ⟨horder', hvalue, hgrowth⟩ := + hcontinuation horder henv hrun + exact ⟨horder', hvalue, by + simpa [OwnershipAllowance.add] using hgrowth⟩ + +theorem EmitOwnershipCostSound.comp {ctx : Ctx} {cur : FnDef} + {first second : Emit} + {firstAllowance secondAllowance : OwnershipAllowance} + (hfirst : EmitOwnershipCostSound ctx cur first firstAllowance) + (hsecond : EmitOwnershipCostSound ctx cur second secondAllowance) : + EmitOwnershipCostSound ctx cur (first ∘ second) + (firstAllowance.add secondAllowance) := by + intro continuation continuationAllowance hcontinuation + have hsecondCode : + CodeOwnershipCostSound ctx cur (second continuation) + (secondAllowance.add continuationAllowance) := + hsecond (continuation := continuation) + (continuationAllowance := continuationAllowance) hcontinuation + have hfirstCode : + CodeOwnershipCostSound ctx cur (first (second continuation)) + (firstAllowance.add + (secondAllowance.add continuationAllowance)) := + hfirst (continuation := second continuation) + (continuationAllowance := + secondAllowance.add continuationAllowance) hsecondCode + intro fuel store env store' value horder henv hrun + change runCode ctx fuel cur store env (first (second continuation)) = + .ok (store', value) at hrun + obtain ⟨horder', hvalue, hgrowth⟩ := + hfirstCode horder henv hrun + exact ⟨horder', hvalue, by + simpa [OwnershipAllowance.add, Nat.add_assoc] using hgrowth⟩ + +/-- Lift one paired operation contract through `Code.letOp`. -/ +theorem OpOwnershipCostSound.emit {ctx : Ctx} {cur : FnDef} {op : Op} + {allowance : OwnershipAllowance} + (hop : OpOwnershipCostSound ctx cur op allowance) : + EmitOwnershipCostSound ctx cur (emitOp op) allowance := by + intro continuation continuationAllowance hcontinuation + intro fuel store env finalStore finalValue horder henv hrun + cases fuel with + | zero => simp [runCode] at hrun + | succ fuel => + rw [runCode.eq_def] at hrun + dsimp only [emitOp] at hrun + cases hopEval : runOp ctx fuel cur store env op with + | error err => + rw [hopEval] at hrun + change (Except.error err : Except Err (Store × RVal)) = + .ok (finalStore, finalValue) at hrun + contradiction + | ok out => + rcases out with ⟨middle, opValue⟩ + rw [hopEval] at hrun + change runCode ctx fuel cur middle (opValue :: env) continuation = + .ok (finalStore, finalValue) at hrun + obtain ⟨hmiddleOrder, hmiddleEnv, hstepGrowth⟩ := + hop horder henv hopEval + obtain ⟨hfinalOrder, hfinalValue, hcontinuationGrowth⟩ := + hcontinuation hmiddleOrder hmiddleEnv hrun + exact ⟨hfinalOrder, hfinalValue, + hstepGrowth.trans hcontinuationGrowth⟩ + +/-- Direct compiler-facing rule for one classified emitted operation. -/ +theorem EmitOwnershipCostSound.localOp + {ctx : Ctx} {cur : FnDef} {op : Op} + {allowance : OwnershipAllowance} + (hlocal : localOpOwnershipAllowance op = some allowance) : + EmitOwnershipCostSound ctx cur (emitOp op) allowance := + OpOwnershipCostSound.emit + (OpOwnershipCostSound.of_local (ctx := ctx) (cur := cur) hlocal) + +/-- Seal a paired-cost emitter with a return continuation. -/ +theorem EmitOwnershipCostSound.closeRet {ctx : Ctx} {cur : FnDef} + {emit : Emit} {allowance : OwnershipAllowance} + (hemit : EmitOwnershipCostSound ctx cur emit allowance) (atom : Atom) : + CodeOwnershipCostSound ctx cur (emit (.ret atom)) allowance := by + have hcode : CodeOwnershipCostSound ctx cur (emit (.ret atom)) + (allowance.add ⟨0, 0⟩) := + hemit (continuation := .ret atom) + (continuationAllowance := ⟨0, 0⟩) + (CodeOwnershipCostSound.ret atom) + intro fuel store env store' value horder henv hrun + obtain ⟨horder', hvalue, hgrowth⟩ := + hcode horder henv hrun + exact ⟨horder', hvalue, by + simpa [OwnershipAllowance.add] using hgrowth⟩ + +/-- A paired code contract remains valid when its componentwise allowance is +enlarged. -/ +theorem CodeOwnershipCostSound.monoAllowance + {ctx : Ctx} {cur : FnDef} {code : Code} + {smaller larger : OwnershipAllowance} + (hsound : CodeOwnershipCostSound ctx cur code smaller) + (hle : OwnershipAllowanceLE smaller larger) : + CodeOwnershipCostSound ctx cur code larger := by + intro fuel store env store' value horder henv hrun + obtain ⟨horder', hvalue, hgrowth⟩ := hsound horder henv hrun + exact ⟨horder', hvalue, hgrowth.monoAllowance hle⟩ + +/-- Difference-list emitter contracts are likewise monotone in their local +allowance. -/ +theorem EmitOwnershipCostSound.monoAllowance + {ctx : Ctx} {cur : FnDef} {emit : Emit} + {smaller larger : OwnershipAllowance} + (hsound : EmitOwnershipCostSound ctx cur emit smaller) + (hle : OwnershipAllowanceLE smaller larger) : + EmitOwnershipCostSound ctx cur emit larger := by + intro continuation continuationAllowance hcontinuation + intro fuel store env store' value horder henv hrun + obtain ⟨horder', hvalue, hgrowth⟩ := + hsound hcontinuation horder henv hrun + exact ⟨horder', hvalue, hgrowth.monoAllowance + (hle.add (OwnershipAllowanceLE.refl continuationAllowance))⟩ + +/-- Every compiler-generated parameter-release plan has zero local paired +cost: deep release is paid from the potential already stored in the heap. -/ +theorem ReleasePlan.ownershipCostSound + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {drops : List SlotDrop} {emit : Emit} + (hplan : ReleasePlan input drops output emit) : + EmitOwnershipCostSound ctx cur emit ⟨0, 0⟩ := by + apply ReleasePlan.traverse (hplan := hplan) + · intro Γ + exact EmitOwnershipCostSound.id + · intro Γ output i abs drops tailEmit hentry ih + have hhead : EmitOwnershipCostSound ctx cur + (emitOp (.drop (.var (Γ.rel abs)))) ⟨0, 0⟩ := + EmitOwnershipCostSound.localOp (by + simp [localOpOwnershipAllowance]) + intro continuation continuationAllowance hcontinuation + have htail : CodeOwnershipCostSound ctx cur (tailEmit continuation) + ((⟨0, 0⟩ : OwnershipAllowance).add continuationAllowance) := + ih hcontinuation + have hcode : CodeOwnershipCostSound ctx cur + (emitOp (.drop (.var (Γ.rel abs))) (tailEmit continuation)) + ((⟨0, 0⟩ : OwnershipAllowance).add + ((⟨0, 0⟩ : OwnershipAllowance).add + continuationAllowance)) := + hhead htail + have hallowance : + (⟨0, 0⟩ : OwnershipAllowance).add continuationAllowance = + (⟨0, 0⟩ : OwnershipAllowance).add + ((⟨0, 0⟩ : OwnershipAllowance).add + continuationAllowance) := by + apply OwnershipAllowance.ext <;> + simp [OwnershipAllowance.add] + rw [hallowance] + change CodeOwnershipCostSound ctx cur + (emitOp (.drop (.var (Γ.rel abs))) (tailEmit continuation)) _ + exact hcode + · intro Γ output i abs drops tailEmit hentry ih + have hhead : EmitOwnershipCostSound ctx cur + (emitOp (.dropU (.var (Γ.rel abs)))) ⟨0, 0⟩ := + EmitOwnershipCostSound.localOp (by + simp [localOpOwnershipAllowance]) + intro continuation continuationAllowance hcontinuation + have htail : CodeOwnershipCostSound ctx cur (tailEmit continuation) + ((⟨0, 0⟩ : OwnershipAllowance).add continuationAllowance) := + ih hcontinuation + have hcode : CodeOwnershipCostSound ctx cur + (emitOp (.dropU (.var (Γ.rel abs))) (tailEmit continuation)) + ((⟨0, 0⟩ : OwnershipAllowance).add + ((⟨0, 0⟩ : OwnershipAllowance).add + continuationAllowance)) := + hhead htail + have hallowance : + (⟨0, 0⟩ : OwnershipAllowance).add continuationAllowance = + (⟨0, 0⟩ : OwnershipAllowance).add + ((⟨0, 0⟩ : OwnershipAllowance).add + continuationAllowance) := by + apply OwnershipAllowance.ext <;> + simp [OwnershipAllowance.add] + rw [hallowance] + change CodeOwnershipCostSound ctx cur + (emitOp (.dropU (.var (Γ.rel abs))) (tailEmit continuation)) _ + exact hcode +/-- The recursor field-retain plan consumes exactly one paired retain charge +per emitted `dup`. -/ +theorem FieldRetainPlan.ownershipCostSound + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {retains : List RecursorFieldRetain} {emit : Emit} + (hplan : FieldRetainPlan input retains output emit) : + EmitOwnershipCostSound ctx cur emit + (retainedOwnershipAllowance retains.length) := by + apply FieldRetainPlan.traverse (hplan := hplan) + · intro Γ + change EmitOwnershipCostSound ctx cur (_root_.id : Emit) ⟨0, 0⟩ + exact EmitOwnershipCostSound.id + · intro Γ output i placeholderAbs fieldAbs remaining retains tailEmit + hentry ih + have hhead : EmitOwnershipCostSound ctx cur + (emitOp (.dup (.var (Γ.rel fieldAbs)))) ⟨0, 2⟩ := + EmitOwnershipCostSound.localOp (by + simp [localOpOwnershipAllowance]) + intro continuation continuationAllowance hcontinuation + have htail : CodeOwnershipCostSound ctx cur (tailEmit continuation) + ((retainedOwnershipAllowance retains.length).add + continuationAllowance) := + ih hcontinuation + have hcode : CodeOwnershipCostSound ctx cur + (emitOp (.dup (.var (Γ.rel fieldAbs))) (tailEmit continuation)) + ((⟨0, 2⟩ : OwnershipAllowance).add + ((retainedOwnershipAllowance retains.length).add + continuationAllowance)) := + hhead htail + have hallowance : + (retainedOwnershipAllowance + (List.length (⟨i, fieldAbs, remaining⟩ :: retains))).add + continuationAllowance = + (⟨0, 2⟩ : OwnershipAllowance).add + ((retainedOwnershipAllowance retains.length).add + continuationAllowance) := by + apply OwnershipAllowance.ext <;> + simp [retainedOwnershipAllowance, OwnershipAllowance.add] <;> + omega + rw [hallowance] + change CodeOwnershipCostSound ctx cur + (emitOp (.dup (.var (Γ.rel fieldAbs))) (tailEmit continuation)) _ + exact hcode +/-- The erased-application cleanup helper emits only deep shared releases, +so its complete difference-list emitter has zero local paired cost. -/ +theorem releaseAll_ownershipCostSound (ctx : Ctx) (cur : FnDef) + (input : VEnv) (values : List AVal) : + EmitOwnershipCostSound ctx cur (releaseAll input values).2 ⟨0, 0⟩ := by + apply releaseAll_traverse + (Result := fun _ _ _ emit => + EmitOwnershipCostSound ctx cur emit ⟨0, 0⟩) + · intro Γ + exact EmitOwnershipCostSound.id + · intro Γ atom avs output emit ih + exact ih + · intro Γ abs avs output tailEmit ih + have hhead : EmitOwnershipCostSound ctx cur + (emitOp (.drop (.var (Γ.rel abs)))) ⟨0, 0⟩ := + EmitOwnershipCostSound.localOp (by + simp [localOpOwnershipAllowance]) + intro continuation continuationAllowance hcontinuation + have htailCode : CodeOwnershipCostSound ctx cur + (tailEmit continuation) + ((⟨0, 0⟩ : OwnershipAllowance).add + continuationAllowance) := + ih hcontinuation + have hcode : CodeOwnershipCostSound ctx cur + (emitOp (.drop (.var (Γ.rel abs))) + (tailEmit continuation)) + ((⟨0, 0⟩ : OwnershipAllowance).add + ((⟨0, 0⟩ : OwnershipAllowance).add + continuationAllowance)) := + hhead htailCode + have hallowance : + (⟨0, 0⟩ : OwnershipAllowance).add continuationAllowance = + (⟨0, 0⟩ : OwnershipAllowance).add + ((⟨0, 0⟩ : OwnershipAllowance).add + continuationAllowance) := by + apply OwnershipAllowance.ext <;> + simp [OwnershipAllowance.add] + rw [hallowance] + change CodeOwnershipCostSound ctx cur + (emitOp (.drop (.var (Γ.rel abs))) + (tailEmit continuation)) _ + exact hcode + +/-- One successful compiler capture emits either no instruction (ownership +move) or one `dup`; one source retain candidate therefore funds the step. -/ +theorem lowerCapture_ownershipCostSound + {ctx : Ctx} {cur : FnDef} {expr : IxIR0.Expr} + {input output : VEnv} {index : Nat} {emit : Emit} {value : AVal} + {state finalState : LowSt} + (hrun : (lowerCapture expr input index).run state = + .ok (output, emit, value) finalState) : + EmitOwnershipCostSound ctx cur emit (retainedOwnershipAllowance 1) := by + intro continuation continuationAllowance hcontinuation + intro runFuel before runtimeEnv after result horder hbounds hcodeRun + cases hentry : input.entries[index]? with + | none => + exact (stateThrowRun_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | some entry => + cases entry with + | recSelf arity => + exact (stateThrowRun_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | slot abs remaining uses held => + cases held with + | false => + exact (stateThrowRun_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | true => + by_cases hunique : worldOfUses uses = .unique + · have huuEq : + (Ixon.Owned.unique == Ixon.Owned.unique) = true := by + decide + exact (stateThrowRun_not_ok (by + simpa [lowerCapture, hentry, hunique, huuEq] + using hrun)).elim + · have huniqueEq : + (worldOfUses uses == Ixon.Owned.unique) = false := by + cases uses <;> simp_all [worldOfUses] <;> decide + by_cases hmore : remaining > countUses index expr + · let next := input.setEntry index + (.slot abs (remaining - countUses index expr) uses true) + have hpure : + (next.bump, + emitOp (.dup (.var (next.rel abs))), + AVal.slotA next.depth) = (output, emit, value) ∧ + state = finalState := by + simpa [lowerCapture, hentry, huniqueEq, hmore, next] + using hrun + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + have hlocal : EmitOwnershipCostSound ctx cur + (emitOp (.dup (.var (next.rel abs)))) ⟨0, 2⟩ := + EmitOwnershipCostSound.localOp (by + simp [localOpOwnershipAllowance]) + have hcode : CodeOwnershipCostSound ctx cur + (emitOp (.dup (.var (next.rel abs))) continuation) + ((⟨0, 2⟩ : OwnershipAllowance).add + continuationAllowance) := + hlocal hcontinuation + have hallowance : + (retainedOwnershipAllowance 1).add + continuationAllowance = + (⟨0, 2⟩ : OwnershipAllowance).add + continuationAllowance := by + apply OwnershipAllowance.ext <;> + simp [retainedOwnershipAllowance, + OwnershipAllowance.add] + rw [hallowance] + exact hcode horder hbounds hcodeRun + · by_cases hequal : remaining = countUses index expr + · let next := input.setEntry index + (.slot abs 0 uses false) + have hpure : + (next, (_root_.id : Emit), AVal.slotA abs) = + (output, emit, value) ∧ state = finalState := by + simpa [lowerCapture, hentry, huniqueEq, hmore, + hequal, next] using hrun + obtain ⟨hresult, hstate⟩ := hpure + have hemit : (_root_.id : Emit) = emit := + congrArg + (fun result : VEnv × Emit × AVal => result.2.1) + hresult + subst emit + subst finalState + have hid : CodeOwnershipCostSound ctx cur continuation + ((⟨0, 0⟩ : OwnershipAllowance).add + continuationAllowance) := + EmitOwnershipCostSound.id hcontinuation + have hle : OwnershipAllowanceLE + ((⟨0, 0⟩ : OwnershipAllowance).add + continuationAllowance) + ((retainedOwnershipAllowance 1).add + continuationAllowance) := by + simp [OwnershipAllowanceLE, + retainedOwnershipAllowance, OwnershipAllowance.add] + exact (hid.monoAllowance hle) horder hbounds hcodeRun + · exact (stateThrowRun_not_ok (by + simpa [lowerCapture, hentry, huniqueEq, hmore, + hequal] using hrun)).elim + +/-- The structurally recursive capture traversal consumes at most one source +retain allowance per selected capture, in the same left-to-right order as +its emitted `dup` prefix. -/ +theorem lowerCaptures_ownershipCostSound + {ctx : Ctx} {cur : FnDef} (expr : IxIR0.Expr) (captures : List Nat) + {input output : VEnv} {emit : Emit} {values : List AVal} + {state finalState : LowSt} + (hrun : (lowerCaptures expr input captures).run state = + .ok (output, emit, values) finalState) : + EmitOwnershipCostSound ctx cur emit + (retainedOwnershipAllowance captures.length) := by + refine lowerCaptures_run_core + (Result := fun _ _ captures emit _ => + EmitOwnershipCostSound ctx cur emit + (retainedOwnershipAllowance captures.length)) + (e := expr) (hrun := hrun) ?_ ?_ + · intro input + change EmitOwnershipCostSound ctx cur (_root_.id : Emit) ⟨0, 0⟩ + exact EmitOwnershipCostSound.id + · intro index rest input middle output headEmit tailEmit headValue + tailValues state middleState hheadRun htail + have hhead : EmitOwnershipCostSound ctx cur headEmit + (retainedOwnershipAllowance 1) := + lowerCapture_ownershipCostSound hheadRun + intro continuation continuationAllowance hcontinuation + intro targetFuel before runtimeEnv after result horder hbounds hcodeRun + have htailCode : CodeOwnershipCostSound ctx cur + (tailEmit continuation) + ((retainedOwnershipAllowance rest.length).add + continuationAllowance) := + htail hcontinuation + have hfull : CodeOwnershipCostSound ctx cur + (headEmit (tailEmit continuation)) + ((retainedOwnershipAllowance 1).add + ((retainedOwnershipAllowance rest.length).add + continuationAllowance)) := + hhead htailCode + have hallowance : + (retainedOwnershipAllowance (List.length (index :: rest))).add + continuationAllowance = + (retainedOwnershipAllowance 1).add + ((retainedOwnershipAllowance rest.length).add + continuationAllowance) := by + apply OwnershipAllowance.ext <;> + simp [retainedOwnershipAllowance, OwnershipAllowance.add] <;> + omega + rw [hallowance] + exact hfull horder hbounds hcodeRun + +/-! ## Run-indexed recursive ownership costs -/ + +/-- Cost certificate for one particular successful code execution. Unlike +`CodeOwnershipCostSound`, this judgment may carry the allowance of a dynamic +source trace, so recursive executions are not forced into a finite static +syntax bound. -/ +structure CodeOwnershipRunCost (ctx : Ctx) (fuel : Nat) (cur : FnDef) + (before : Store) (env : List RVal) (code : Code) (after : Store) + (value : RVal) (allowance : OwnershipAllowance) : Prop where + startOrder : AllocationOrderInvariant before + envBounds : ValuesInBounds before env + run : runCode ctx fuel cur before env code = .ok (after, value) + growth : OwnershipGrowthLE before after allowance + +/-- Run-indexed counterpart for one operation. -/ +structure OpOwnershipRunCost (ctx : Ctx) (fuel : Nat) (cur : FnDef) + (before : Store) (env : List RVal) (op : Op) (after : Store) + (value : RVal) (allowance : OwnershipAllowance) : Prop where + startOrder : AllocationOrderInvariant before + envBounds : ValuesInBounds before env + run : runOp ctx fuel cur before env op = .ok (after, value) + growth : OwnershipGrowthLE before after allowance + +/-- Run-indexed declared-call certificate. -/ +structure InvokeOwnershipRunCost (ctx : Ctx) (fuel : Nat) + (address : Ixon.Address) (args : List RVal) (before after : Store) + (value : RVal) (allowance : OwnershipAllowance) : Prop where + startOrder : AllocationOrderInvariant before + argsBounds : ValuesInBounds before args + run : invoke ctx fuel address args before = .ok (after, value) + growth : OwnershipGrowthLE before after allowance + +/-- Run-indexed higher-order application certificate. -/ +structure ApplyOwnershipRunCost (ctx : Ctx) (fuel : Nat) + (before : Store) (function : RVal) (args : List RVal) (after : Store) + (value : RVal) (allowance : OwnershipAllowance) : Prop where + startOrder : AllocationOrderInvariant before + functionBound : ValueInBounds before function + argsBounds : ValuesInBounds before args + run : applyGo ctx fuel before function args = .ok (after, value) + growth : OwnershipGrowthLE before after allowance + +theorem CodeOwnershipRunCost.finalOrderAndValue + {ctx : Ctx} {fuel : Nat} {cur : FnDef} {before after : Store} + {env : List RVal} {code : Code} {value : RVal} + {allowance : OwnershipAllowance} + (hcost : CodeOwnershipRunCost ctx fuel cur before env code after value + allowance) : + AllocationOrderInvariant after ∧ ValueInBounds after value := + runCode_order_of_reuses_eq hcost.startOrder hcost.envBounds + hcost.growth.2.1 hcost.run + +theorem OpOwnershipRunCost.finalOrderAndValue + {ctx : Ctx} {fuel : Nat} {cur : FnDef} {before after : Store} + {env : List RVal} {op : Op} {value : RVal} + {allowance : OwnershipAllowance} + (hcost : OpOwnershipRunCost ctx fuel cur before env op after value + allowance) : + AllocationOrderInvariant after ∧ ValueInBounds after value := + runOp_order_of_reuses_eq hcost.startOrder hcost.envBounds + hcost.growth.2.1 hcost.run + +theorem InvokeOwnershipRunCost.finalOrderAndValue + {ctx : Ctx} {fuel : Nat} {address : Ixon.Address} {args : List RVal} + {before after : Store} {value : RVal} + {allowance : OwnershipAllowance} + (hcost : InvokeOwnershipRunCost ctx fuel address args before after value + allowance) : + AllocationOrderInvariant after ∧ ValueInBounds after value := + invoke_order_of_reuses_eq hcost.startOrder hcost.argsBounds + hcost.growth.2.1 hcost.run + +theorem ApplyOwnershipRunCost.finalOrderAndValue + {ctx : Ctx} {fuel : Nat} {before after : Store} {function : RVal} + {args : List RVal} {value : RVal} {allowance : OwnershipAllowance} + (hcost : ApplyOwnershipRunCost ctx fuel before function args after value + allowance) : + AllocationOrderInvariant after ∧ ValueInBounds after value := + applyGo_order_of_reuses_eq hcost.startOrder hcost.functionBound + hcost.argsBounds hcost.growth.2.1 hcost.run + +/-- A static whole-code contract can always certify a particular run. -/ +theorem CodeOwnershipCostSound.runCost + {ctx : Ctx} {fuel : Nat} {cur : FnDef} {before after : Store} + {env : List RVal} {code : Code} {value : RVal} + {allowance : OwnershipAllowance} + (hsound : CodeOwnershipCostSound ctx cur code allowance) + (horder : AllocationOrderInvariant before) + (henv : ValuesInBounds before env) + (hrun : runCode ctx fuel cur before env code = .ok (after, value)) : + CodeOwnershipRunCost ctx fuel cur before env code after value allowance := + ⟨horder, henv, hrun, (hsound horder henv hrun).2.2⟩ + +/-- A classified local operation can certify its particular execution. -/ +theorem OpOwnershipRunCost.of_local + {ctx : Ctx} {fuel : Nat} {cur : FnDef} {before after : Store} + {env : List RVal} {op : Op} {value : RVal} + {allowance : OwnershipAllowance} + (hlocal : localOpOwnershipAllowance op = some allowance) + (horder : AllocationOrderInvariant before) + (henv : ValuesInBounds before env) + (hrun : runOp ctx fuel cur before env op = .ok (after, value)) : + OpOwnershipRunCost ctx fuel cur before env op after value allowance := + ⟨horder, henv, hrun, runOp_localOwnership_growth hlocal horder hrun⟩ + +theorem CodeOwnershipRunCost.ret + {ctx : Ctx} {fuel : Nat} {cur : FnDef} {store : Store} + {env : List RVal} {atom : Atom} {value : RVal} + (horder : AllocationOrderInvariant store) + (henv : ValuesInBounds store env) + (hresolve : resolveAtom env atom = .ok value) : + CodeOwnershipRunCost ctx (fuel + 1) cur store env (.ret atom) store value + ⟨0, 0⟩ := by + refine ⟨horder, henv, ?_, OwnershipGrowthLE.refl store⟩ + rw [runCode.eq_def] + dsimp only + rw [hresolve, bindOk] + +/-- Sequence one run-indexed operation with its exact continuation. -/ +theorem CodeOwnershipRunCost.letOp + {ctx : Ctx} {fuel : Nat} {cur : FnDef} {before middle after : Store} + {env : List RVal} {op : Op} {opValue value : RVal} {rest : Code} + {opAllowance restAllowance : OwnershipAllowance} + (hop : OpOwnershipRunCost ctx fuel cur before env op middle opValue + opAllowance) + (hrest : CodeOwnershipRunCost ctx fuel cur middle (opValue :: env) rest + after value restAllowance) : + CodeOwnershipRunCost ctx (fuel + 1) cur before env (.letOp op rest) + after value (opAllowance.add restAllowance) := by + refine ⟨hop.startOrder, hop.envBounds, ?_, + hop.growth.trans hrest.growth⟩ + rw [runCode.eq_def] + dsimp only + rw [hop.run, bindOk] + exact hrest.run + +/-- A declared function invocation adds no cost beyond its executed body. -/ +theorem InvokeOwnershipRunCost.fn + {ctx : Ctx} {fuel : Nat} {address : Ixon.Address} {args : List RVal} + {before after : Store} {value : RVal} {decl : FnDef} + {allowance : OwnershipAllowance} + (hdecl : ctx.decls address = some (.fn decl)) + (harity : args.length = decl.arity) + (hbody : CodeOwnershipRunCost ctx fuel decl before args.reverse decl.body + after value allowance) + (hresult : checkResultWorld decl.result (after, value) = + .ok (after, value)) : + InvokeOwnershipRunCost ctx (fuel + 1) address args before after value + allowance := by + refine ⟨hbody.startOrder, ?_, ?_, hbody.growth⟩ + · simpa using hbody.envBounds.reverse + · rw [invoke.eq_def] + dsimp only + simp only [hdecl] + have hbne : (args.length != decl.arity) = false := by + simp [harity] + rw [hbne] + simp only [Bool.false_eq_true, if_false] + rw [hbody.run, bindOk] + exact hresult + +/-- A scalar extern invocation leaves ownership cost unchanged. -/ +theorem InvokeOwnershipRunCost.extern + {ctx : Ctx} {fuel : Nat} {address : Ixon.Address} {args : List RVal} + {store : Store} {value : RVal} {arity : Nat} + (horder : AllocationOrderInvariant store) + (hargs : ValuesInBounds store args) + (hdecl : ctx.decls address = some (.extern arity)) + (harity : args.length = arity) + (hcall : callScalarOracle ctx address args = .ok value) : + InvokeOwnershipRunCost ctx (fuel + 1) address args store store value + ⟨0, 0⟩ := by + refine ⟨horder, hargs, ?_, OwnershipGrowthLE.refl store⟩ + simp [invoke, hdecl, harity, hcall] + +/-- Direct calls consume the exact run-indexed callee certificate. -/ +theorem OpOwnershipRunCost.call + {ctx : Ctx} {fuel : Nat} {cur : FnDef} {before after : Store} + {env : List RVal} {address : Ixon.Address} {atoms : Array Atom} + {args : List RVal} {value : RVal} {allowance : OwnershipAllowance} + (henv : ValuesInBounds before env) + (hresolve : resolveAtoms env atoms = .ok args) + (hinvoke : InvokeOwnershipRunCost ctx fuel address args before after value + allowance) : + OpOwnershipRunCost ctx (fuel + 1) cur before env (.call address atoms) + after value allowance := by + refine ⟨hinvoke.startOrder, henv, ?_, hinvoke.growth⟩ + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + exact hinvoke.run + +/-- Recursive self calls consume the exact smaller-fuel body certificate. -/ +theorem OpOwnershipRunCost.callSelf + {ctx : Ctx} {fuel : Nat} {cur : FnDef} {before after : Store} + {env : List RVal} {atoms : Array Atom} {args : List RVal} + {value : RVal} {allowance : OwnershipAllowance} + (henv : ValuesInBounds before env) + (hresolve : resolveAtoms env atoms = .ok args) + (harity : args.length = cur.arity) + (hbody : CodeOwnershipRunCost ctx fuel cur before args.reverse cur.body + after value allowance) + (hresult : checkResultWorld cur.result (after, value) = + .ok (after, value)) : + OpOwnershipRunCost ctx (fuel + 1) cur before env (.callSelf atoms) + after value allowance := by + refine ⟨hbody.startOrder, henv, ?_, hbody.growth⟩ + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + have hbne : (args.length != cur.arity) = false := by + simp [harity] + rw [hbne] + simp only [Bool.false_eq_true, if_false] + rw [hbody.run, bindOk] + exact hresult + +/-- Higher-order application consumes the exact `applyGo` certificate. -/ +theorem OpOwnershipRunCost.apply + {ctx : Ctx} {fuel : Nat} {cur : FnDef} {before after : Store} + {env : List RVal} {functionAtom : Atom} {function value : RVal} + {atoms : Array Atom} {args : List RVal} + {allowance : OwnershipAllowance} + (henv : ValuesInBounds before env) + (hfunction : resolveAtom env functionAtom = .ok function) + (hargs : resolveAtoms env atoms = .ok args) + (happly : ApplyOwnershipRunCost ctx fuel before function args after value + allowance) : + OpOwnershipRunCost ctx (fuel + 1) cur before env + (.apply functionAtom atoms) after value allowance := by + refine ⟨happly.startOrder, henv, ?_, happly.growth⟩ + rw [runOp.eq_def] + dsimp only + rw [hfunction, bindOk, hargs, bindOk] + exact happly.run + +/-- Applying an erased function only releases its supplied arguments; deep +release is free in the amortized ownership measure. -/ +theorem ApplyOwnershipRunCost.erased + {ctx : Ctx} {fuel : Nat} {before after : Store} {args : List RVal} + (horder : AllocationOrderInvariant before) + (hargs : ValuesInBounds before args) + (hdrop : dropMany ctx fuel before args = .ok after) : + ApplyOwnershipRunCost ctx (fuel + 1) before .erased args after .erased + ⟨0, 0⟩ := by + refine ⟨horder, by trivial, hargs, ?_, + dropMany_ownership_growth horder hdrop⟩ + rw [applyGo.eq_def] + dsimp only + rw [hdrop, bindOk] + +/-- Under-applying a PAP retains its captured prefix, releases the consumed +PAP, and allocates one successor PAP. -/ +theorem ApplyOwnershipRunCost.papUnder + {ctx : Ctx} {fuel : Nat} {before duplicated ready : Store} + {location arity rc : Nat} {address : Ixon.Address} + {world : Ixon.Owned} + {captured : Array RVal} {args : List RVal} + (horder : AllocationOrderInvariant before) + (hargs : ValuesInBounds before args) + (hbox : before.get? location = + some ⟨world, rc, .papN address arity captured⟩) + (hdup : dupVals before captured.toList = .ok duplicated) + (hdrop : dropVal ctx fuel duplicated (.loc location) = .ok ready) + (hunder : (captured.toList ++ args).length < arity) : + ApplyOwnershipRunCost ctx (fuel + 1) before (.loc location) args + (ready.allocNode .shared + (.papN address arity (captured.toList ++ args).toArray)).1 + (.loc (ready.allocNode .shared + (.papN address arity (captured.toList ++ args).toArray)).2) + ((retainedOwnershipAllowance captured.toList.length).add ⟨1, 1⟩) := by + have hdupGrowth := dupVals_ownership_growth hdup + have hduplicatedOrder := horder.dupVals hdup + have hdropGrowth := dropVal_ownership_growth hduplicatedOrder hdrop + have hgrowth := (hdupGrowth.trans hdropGrowth).trans + (OwnershipGrowthLE.allocNode ready .shared + (.papN address arity (captured.toList ++ args).toArray)) + refine ⟨horder, RVal.inBounds_of_get? hbox, hargs, ?_, ?_⟩ + · rw [applyGo.eq_def] + dsimp only + rw [hbox] + dsimp only + rw [hdup, bindOk, hdrop, bindOk] + simp only [hunder, if_true] + · simpa [OwnershipAllowance.add] using hgrowth + +/-- Exact PAP saturation pays only for retaining the captured prefix; the +callee's dynamic allowance is supplied by its run-indexed invocation +certificate. -/ +theorem ApplyOwnershipRunCost.papExact + {ctx : Ctx} {fuel : Nat} {before duplicated ready after : Store} + {location arity rc : Nat} {address : Ixon.Address} + {world : Ixon.Owned} {captured : Array RVal} {args : List RVal} + {value : RVal} {invokeAllowance : OwnershipAllowance} + {declaration : Decl} + (horder : AllocationOrderInvariant before) + (hargs : ValuesInBounds before args) + (hbox : before.get? location = + some ⟨world, rc, .papN address arity captured⟩) + (hdup : dupVals before captured.toList = .ok duplicated) + (hdrop : dropVal ctx fuel duplicated (.loc location) = .ok ready) + (hexact : (captured.toList ++ args).length = arity) + (hdecl : ctx.decls address = some declaration) + (hpapsafe : declPapSafe declaration = true) + (hinvoke : InvokeOwnershipRunCost ctx fuel address + (captured.toList ++ args) ready after value invokeAllowance) : + ApplyOwnershipRunCost ctx (fuel + 1) before (.loc location) args after + value + ((retainedOwnershipAllowance captured.toList.length).add + invokeAllowance) := by + have hdupGrowth := dupVals_ownership_growth hdup + have hduplicatedOrder := horder.dupVals hdup + have hdropGrowth := dropVal_ownership_growth hduplicatedOrder hdrop + have hgrowth := (hdupGrowth.trans hdropGrowth).trans hinvoke.growth + refine ⟨horder, RVal.inBounds_of_get? hbox, hargs, ?_, ?_⟩ + · rw [applyGo.eq_def] + dsimp only + rw [hbox] + dsimp only + rw [hdup, bindOk, hdrop, bindOk] + have hunder : ¬(captured.toList ++ args).length < arity := by + omega + simp only [hunder, if_false] + rw [hdecl] + simp only [hpapsafe, if_true] + simpa [hexact] using hinvoke.run + · simpa [OwnershipAllowance.add] using hgrowth + +/-- PAP over-application composes prefix retains, the saturated invocation, +and the recursive application of the remaining arguments. Both recursive +certificates are at the evaluator's strictly smaller fuel. -/ +theorem ApplyOwnershipRunCost.papOver + {ctx : Ctx} {fuel : Nat} + {before duplicated ready called after : Store} + {location arity rc : Nat} {address : Ixon.Address} + {world : Ixon.Owned} {captured : Array RVal} {args : List RVal} + {calledValue value : RVal} {declaration : Decl} + {invokeAllowance applyAllowance : OwnershipAllowance} + (horder : AllocationOrderInvariant before) + (hargs : ValuesInBounds before args) + (hbox : before.get? location = + some ⟨world, rc, .papN address arity captured⟩) + (hdup : dupVals before captured.toList = .ok duplicated) + (hdrop : dropVal ctx fuel duplicated (.loc location) = .ok ready) + (hover : arity < (captured.toList ++ args).length) + (hdecl : ctx.decls address = some declaration) + (hpapsafe : declPapSafe declaration = true) + (hinvoke : InvokeOwnershipRunCost ctx fuel address + ((captured.toList ++ args).take arity) ready called calledValue + invokeAllowance) + (happly : ApplyOwnershipRunCost ctx fuel called calledValue + ((captured.toList ++ args).drop arity) after value applyAllowance) : + ApplyOwnershipRunCost ctx (fuel + 1) before (.loc location) args after + value + (((retainedOwnershipAllowance captured.toList.length).add + invokeAllowance).add applyAllowance) := by + have hdupGrowth := dupVals_ownership_growth hdup + have hduplicatedOrder := horder.dupVals hdup + have hdropGrowth := dropVal_ownership_growth hduplicatedOrder hdrop + have hgrowth := ((hdupGrowth.trans hdropGrowth).trans hinvoke.growth).trans + happly.growth + refine ⟨horder, RVal.inBounds_of_get? hbox, hargs, ?_, ?_⟩ + · rw [applyGo.eq_def] + dsimp only + rw [hbox] + dsimp only + rw [hdup, bindOk, hdrop, bindOk] + have hunder : ¬(captured.toList ++ args).length < arity := by + omega + have hne : (captured.toList ++ args).length ≠ arity := by + omega + simp only [hunder, if_false] + simp only [hne, beq_iff_eq, if_false] + rw [hdecl] + simp only [hpapsafe, if_true] + rw [hinvoke.run, bindOk] + exact happly.run + · simpa [OwnershipAllowance.add] using hgrowth + +/-- Per-event target charges. This is the explicit, reviewable seam at which +a compiler proof chooses how source events pay for target instructions. -/ +structure ProfileWeights where + eval : CostObservation + apply : CostObservation + saturation : CostObservation + constructor : CostObservation + closure : CostObservation + pap : CostObservation + recursor : CostObservation + extern : CostObservation + projection : CostObservation + /-- Charge per dynamically retained ownership candidate. This is separate + from event counts because closure and PAP widths are unbounded. -/ + retain : CostObservation + deriving BEq, Repr + +/-- A non-calibrated ownership-amortized tariff for the current lowerer. +One dynamic source evaluation funds at most one heap-value lifetime, while a +retained root funds a target `dup` and its eventual matching `drop`. The +definition is the stable statement of the intended local tariff; proving it +for every successful compiler output remains an explicit lowering theorem, +not an assumption hidden in this value. -/ +def ownershipAmortizedWeights : ProfileWeights := + { eval := ⟨1, 0, 1, 2⟩ + apply := ⟨0, 0, 0, 0⟩ + saturation := ⟨0, 0, 0, 0⟩ + constructor := ⟨0, 0, 0, 0⟩ + closure := ⟨0, 0, 0, 0⟩ + pap := ⟨0, 0, 0, 0⟩ + recursor := ⟨0, 0, 0, 0⟩ + extern := ⟨0, 0, 0, 0⟩ + projection := ⟨0, 0, 0, 0⟩ + retain := ⟨0, 0, 0, 2⟩ } + +/-- Paired charge made available by one dynamic source evaluation. -/ +def evalOwnershipAllowance : OwnershipAllowance := ⟨1, 2⟩ + +/-- Paired charge made available by one dynamically retained root. -/ +def retainOwnershipAllowance : OwnershipAllowance := ⟨0, 2⟩ + +/-- Projection of the public retain-aware tariff onto the paired resources +tracked by compiler emitters. -/ +def sourceProfileOwnershipAllowance + (profile : SourceProfile) : OwnershipAllowance := + { allocations := profile.evals + rcPotential := profile.retains * 2 + profile.evals * 2 } + +/-- Source-profile allowance is additive, so a profiled evaluator induction +can compose the target contracts of its subtraces without reassociating the +tariff by hand. -/ +theorem sourceProfileOwnershipAllowance_add + (left right : SourceProfile) : + sourceProfileOwnershipAllowance (left + right) = + (sourceProfileOwnershipAllowance left).add + (sourceProfileOwnershipAllowance right) := by + apply OwnershipAllowance.ext <;> + simp [sourceProfileOwnershipAllowance, OwnershipAllowance.add] <;> + omega + +@[simp] theorem sourceProfileOwnershipAllowance_retain (count : Nat) : + sourceProfileOwnershipAllowance (IxIR0.DynamicCost.retain count) = + retainedOwnershipAllowance count := by + simp [sourceProfileOwnershipAllowance, IxIR0.DynamicCost.retain, + retainedOwnershipAllowance, Nat.mul_comm] + +/-- Every source event carrying one evaluation tick projects to the same +paired tariff; the other profile coordinates are intentionally irrelevant to +this ownership projection. -/ +theorem sourceProfileOwnershipAllowance_tick_of_evals_eq_one + (event : IxIR0.DynamicCost.Event) + (heval : (IxIR0.DynamicCost.tick event).evals = 1) : + sourceProfileOwnershipAllowance (IxIR0.DynamicCost.tick event) = + evalOwnershipAllowance := by + cases event <;> + simp [IxIR0.DynamicCost.tick, sourceProfileOwnershipAllowance, + evalOwnershipAllowance] at heval ⊢ + +theorem zeroOwnershipAllowance_le_profile (profile : SourceProfile) : + OwnershipAllowanceLE ⟨0, 0⟩ + (sourceProfileOwnershipAllowance profile) := by + simp [OwnershipAllowanceLE, sourceProfileOwnershipAllowance] + +/-- Any nonempty source evaluation profile can fund one fresh target node. +The public tariff supplies one allocation and two units of RC potential per +source evaluation. -/ +theorem allocatedNodeAllowance_le_profile_of_evals_pos + {profile : SourceProfile} (hpos : 0 < profile.evals) : + OwnershipAllowanceLE ⟨1, 1⟩ + (sourceProfileOwnershipAllowance profile) := by + simp [OwnershipAllowanceLE, sourceProfileOwnershipAllowance] + omega + +/-- A compiler difference-list emitter together with a paired allowance paid +by a source-profile fragment. This is the non-recursive primitive judgment +composed by the source-trace lowering induction. -/ +def ProfileFundedEmitOwnershipCostSound (ctx : Ctx) (cur : FnDef) + (emit : Emit) (profile : SourceProfile) : Prop := + ∃ allowance, + EmitOwnershipCostSound ctx cur emit allowance ∧ + OwnershipAllowanceLE allowance + (sourceProfileOwnershipAllowance profile) + +theorem ProfileFundedEmitOwnershipCostSound.of_profile_eq + {ctx : Ctx} {cur : FnDef} {emit : Emit} {left right : SourceProfile} + (hcost : ProfileFundedEmitOwnershipCostSound ctx cur emit left) + (hprofile : left = right) : + ProfileFundedEmitOwnershipCostSound ctx cur emit right := by + subst right + exact hcost + +/-- A compiler emitter funded by one source fragment remains funded by any +source fragment whose paired ownership projection is larger. This is the +transport used when lowering retains only the live subset of a source +closure environment. -/ +theorem ProfileFundedEmitOwnershipCostSound.monoProfile + {ctx : Ctx} {cur : FnDef} {emit : Emit} {smaller larger : SourceProfile} + (hcost : ProfileFundedEmitOwnershipCostSound ctx cur emit smaller) + (hle : OwnershipAllowanceLE + (sourceProfileOwnershipAllowance smaller) + (sourceProfileOwnershipAllowance larger)) : + ProfileFundedEmitOwnershipCostSound ctx cur emit larger := by + obtain ⟨allowance, hcost, hfunded⟩ := hcost + exact ⟨allowance, hcost, hfunded.trans hle⟩ + +/-- Profile-funded emitters compose in the same order as source-profile +addition. -/ +theorem ProfileFundedEmitOwnershipCostSound.comp + {ctx : Ctx} {cur : FnDef} {leftEmit rightEmit : Emit} + {leftProfile rightProfile : SourceProfile} + (hleft : ProfileFundedEmitOwnershipCostSound ctx cur leftEmit + leftProfile) + (hright : ProfileFundedEmitOwnershipCostSound ctx cur rightEmit + rightProfile) : + ProfileFundedEmitOwnershipCostSound ctx cur (leftEmit ∘ rightEmit) + (leftProfile + rightProfile) := by + obtain ⟨leftAllowance, hleftCost, hleftFunded⟩ := hleft + obtain ⟨rightAllowance, hrightCost, hrightFunded⟩ := hright + refine ⟨leftAllowance.add rightAllowance, + EmitOwnershipCostSound.comp hleftCost hrightCost, ?_⟩ + rw [sourceProfileOwnershipAllowance_add] + exact hleftFunded.add hrightFunded + +/-- A zero-cost compiler emitter may be assigned to any enclosing source +profile fragment. -/ +theorem ProfileFundedEmitOwnershipCostSound.of_zero + {ctx : Ctx} {cur : FnDef} {emit : Emit} {profile : SourceProfile} + (hcost : EmitOwnershipCostSound ctx cur emit ⟨0, 0⟩) : + ProfileFundedEmitOwnershipCostSound ctx cur emit profile := + ⟨⟨0, 0⟩, hcost, zeroOwnershipAllowance_le_profile profile⟩ + +theorem ReleasePlan.profileFundedOwnershipCostSound + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {drops : List SlotDrop} {emit : Emit} {profile : SourceProfile} + (hplan : ReleasePlan input drops output emit) : + ProfileFundedEmitOwnershipCostSound ctx cur emit profile := + ProfileFundedEmitOwnershipCostSound.of_zero + (Ix.Compiler.IxIR1.CostTrace.ReleasePlan.ownershipCostSound hplan) + +theorem FieldRetainPlan.profileFundedOwnershipCostSound + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {retains : List RecursorFieldRetain} {emit : Emit} + (hplan : FieldRetainPlan input retains output emit) : + ProfileFundedEmitOwnershipCostSound ctx cur emit + (IxIR0.DynamicCost.retain retains.length) := by + refine ⟨retainedOwnershipAllowance retains.length, + Ix.Compiler.IxIR1.CostTrace.FieldRetainPlan.ownershipCostSound hplan, + ?_⟩ + rw [sourceProfileOwnershipAllowance_retain] + exact OwnershipAllowanceLE.refl _ + +theorem releaseAll_profileFundedOwnershipCostSound + (ctx : Ctx) (cur : FnDef) (input : VEnv) (values : List AVal) + (profile : SourceProfile) : + ProfileFundedEmitOwnershipCostSound ctx cur + (releaseAll input values).2 profile := + ProfileFundedEmitOwnershipCostSound.of_zero + (releaseAll_ownershipCostSound ctx cur input values) + +theorem lowerCapture_profileFundedOwnershipCostSound + {ctx : Ctx} {cur : FnDef} {expr : IxIR0.Expr} + {input output : VEnv} {index : Nat} {emit : Emit} {value : AVal} + {state finalState : LowSt} + (hrun : (lowerCapture expr input index).run state = + .ok (output, emit, value) finalState) : + ProfileFundedEmitOwnershipCostSound ctx cur emit + (IxIR0.DynamicCost.retain 1) := by + refine ⟨retainedOwnershipAllowance 1, + lowerCapture_ownershipCostSound hrun, ?_⟩ + rw [sourceProfileOwnershipAllowance_retain] + exact OwnershipAllowanceLE.refl _ + +theorem lowerCaptures_profileFundedOwnershipCostSound + {ctx : Ctx} {cur : FnDef} (expr : IxIR0.Expr) (captures : List Nat) + {input output : VEnv} {emit : Emit} {values : List AVal} + {state finalState : LowSt} + (hrun : (lowerCaptures expr input captures).run state = + .ok (output, emit, values) finalState) : + ProfileFundedEmitOwnershipCostSound ctx cur emit + (IxIR0.DynamicCost.retain captures.length) := by + refine ⟨retainedOwnershipAllowance captures.length, + lowerCaptures_ownershipCostSound expr captures hrun, ?_⟩ + rw [sourceProfileOwnershipAllowance_retain] + exact OwnershipAllowanceLE.refl _ + +/-- A particular target code run together with evidence that its dynamic +allowance is funded by the matching source profile. This is the judgment the +source evaluator induction composes. -/ +def ProfileFundedCodeRun (ctx : Ctx) (fuel : Nat) (cur : FnDef) + (before : Store) (env : List RVal) (code : Code) (after : Store) + (value : RVal) (profile : SourceProfile) : Prop := + ∃ allowance, + CodeOwnershipRunCost ctx fuel cur before env code after value allowance ∧ + OwnershipAllowanceLE allowance + (sourceProfileOwnershipAllowance profile) + +def ProfileFundedOpRun (ctx : Ctx) (fuel : Nat) (cur : FnDef) + (before : Store) (env : List RVal) (op : Op) (after : Store) + (value : RVal) (profile : SourceProfile) : Prop := + ∃ allowance, + OpOwnershipRunCost ctx fuel cur before env op after value allowance ∧ + OwnershipAllowanceLE allowance + (sourceProfileOwnershipAllowance profile) + +def ProfileFundedInvokeRun (ctx : Ctx) (fuel : Nat) + (address : Ixon.Address) (args : List RVal) (before after : Store) + (value : RVal) (profile : SourceProfile) : Prop := + ∃ allowance, + InvokeOwnershipRunCost ctx fuel address args before after value allowance ∧ + OwnershipAllowanceLE allowance + (sourceProfileOwnershipAllowance profile) + +def ProfileFundedApplyRun (ctx : Ctx) (fuel : Nat) + (before : Store) (function : RVal) (args : List RVal) (after : Store) + (value : RVal) (profile : SourceProfile) : Prop := + ∃ allowance, + ApplyOwnershipRunCost ctx fuel before function args after value allowance ∧ + OwnershipAllowanceLE allowance + (sourceProfileOwnershipAllowance profile) + +/-- A saturated residual-function invocation separates the target PAP's +stored-prefix duplication from the core declaration run. The enclosing +source application profile funds their sum without assigning the same +source retain twice. -/ +def RetainedProfileFundedInvokeRun (ctx : Ctx) (fuel : Nat) + (address : Ixon.Address) (args : List RVal) (before after : Store) + (value : RVal) (reserve : Nat) (profile : SourceProfile) : Prop := + ∃ invokeProfile, + ProfileFundedInvokeRun ctx fuel address args before after value + invokeProfile ∧ + OwnershipAllowanceLE + (sourceProfileOwnershipAllowance + (IxIR0.DynamicCost.retain reserve + invokeProfile)) + (sourceProfileOwnershipAllowance profile) + +/-- Universal, but run-indexed, cost soundness for one target code fragment. +Each successful run may choose the allowance induced by its particular +recursive source trace; every such allowance must fit the fixed profile +given to this judgment. -/ +def ProfileFundedCodeCostSound (ctx : Ctx) (cur : FnDef) + (code : Code) (profile : SourceProfile) : Prop := + ∀ {fuel before env after value}, + AllocationOrderInvariant before → + ValuesInBounds before env → + runCode ctx fuel cur before env code = .ok (after, value) → + ProfileFundedCodeRun ctx fuel cur before env code after value profile + +/-- A profile-funded run-indexed code judgment can be conservatively viewed +as an ordinary static code contract by choosing the complete projected +source allowance for every successful run. -/ +theorem ProfileFundedCodeCostSound.toOwnershipCostSound + {ctx : Ctx} {cur : FnDef} {code : Code} {profile : SourceProfile} + (hsound : ProfileFundedCodeCostSound ctx cur code profile) : + CodeOwnershipCostSound ctx cur code + (sourceProfileOwnershipAllowance profile) := by + intro fuel before env after value horder henv hrun + obtain ⟨allowance, hcost, hfunded⟩ := + hsound horder henv hrun + obtain ⟨hfinalOrder, hvalue⟩ := hcost.finalOrderAndValue + exact ⟨hfinalOrder, hvalue, hcost.growth.monoAllowance hfunded⟩ + +/-- Any ordinary code contract whose allowance is profile-funded supplies +the corresponding universal run-indexed judgment. -/ +theorem ProfileFundedCodeCostSound.of_static + {ctx : Ctx} {cur : FnDef} {code : Code} + {allowance : OwnershipAllowance} {profile : SourceProfile} + (hsound : CodeOwnershipCostSound ctx cur code allowance) + (hfunded : OwnershipAllowanceLE allowance + (sourceProfileOwnershipAllowance profile)) : + ProfileFundedCodeCostSound ctx cur code profile := by + intro fuel before env after value horder henv hrun + exact ⟨allowance, + CodeOwnershipCostSound.runCost hsound horder henv hrun, + hfunded⟩ + +theorem ProfileFundedCodeCostSound.of_profile_eq + {ctx : Ctx} {cur : FnDef} {code : Code} + {left right : SourceProfile} + (hsound : ProfileFundedCodeCostSound ctx cur code left) + (hprofile : left = right) : + ProfileFundedCodeCostSound ctx cur code right := by + subst right + exact hsound + +theorem ProfileFundedCodeCostSound.monoProfile + {ctx : Ctx} {cur : FnDef} {code : Code} + {smaller larger : SourceProfile} + (hsound : ProfileFundedCodeCostSound ctx cur code smaller) + (hle : OwnershipAllowanceLE + (sourceProfileOwnershipAllowance smaller) + (sourceProfileOwnershipAllowance larger)) : + ProfileFundedCodeCostSound ctx cur code larger := by + intro fuel before env after value horder henv hrun + obtain ⟨allowance, hcost, hfunded⟩ := + hsound horder henv hrun + exact ⟨allowance, hcost, hfunded.trans hle⟩ + +/-- Return code is ownership-free and may therefore close any available +source fragment. -/ +theorem ProfileFundedCodeCostSound.ret + {ctx : Ctx} {cur : FnDef} (atom : Atom) (profile : SourceProfile) : + ProfileFundedCodeCostSound ctx cur (.ret atom) profile := + ProfileFundedCodeCostSound.of_static + (CodeOwnershipCostSound.ret atom) + (zeroOwnershipAllowance_le_profile profile) + +/-- Prepend a statically certified local emitter to a continuation whose +cost is run-indexed. The continuation can be converted to one conservative +static allowance because its fixed source profile bounds every particular +run; the local emitter contract can then be applied without losing the +dynamic recursive boundary. -/ +theorem ProfileFundedEmitOwnershipCostSound.prepend + {ctx : Ctx} {cur : FnDef} {emit : Emit} {continuation : Code} + {emitProfile continuationProfile : SourceProfile} + (hemit : ProfileFundedEmitOwnershipCostSound ctx cur emit emitProfile) + (hcontinuation : ProfileFundedCodeCostSound ctx cur continuation + continuationProfile) : + ProfileFundedCodeCostSound ctx cur (emit continuation) + (emitProfile + continuationProfile) := by + obtain ⟨emitAllowance, hemitStatic, hemitFunded⟩ := hemit + have hcontinuationStatic : CodeOwnershipCostSound ctx cur continuation + (sourceProfileOwnershipAllowance continuationProfile) := + ProfileFundedCodeCostSound.toOwnershipCostSound hcontinuation + have hcodeStatic : CodeOwnershipCostSound ctx cur (emit continuation) + (emitAllowance.add + (sourceProfileOwnershipAllowance continuationProfile)) := + hemitStatic hcontinuationStatic + apply ProfileFundedCodeCostSound.of_static hcodeStatic + rw [sourceProfileOwnershipAllowance_add] + exact hemitFunded.add (OwnershipAllowanceLE.refl _) + +/-- Seal a profile-funded local emitter with a return. -/ +theorem ProfileFundedEmitOwnershipCostSound.closeRet + {ctx : Ctx} {cur : FnDef} {emit : Emit} {profile : SourceProfile} + (hemit : ProfileFundedEmitOwnershipCostSound ctx cur emit profile) + (atom : Atom) : + ProfileFundedCodeCostSound ctx cur (emit (.ret atom)) profile := by + exact ProfileFundedCodeCostSound.of_profile_eq + (hemit.prepend (ProfileFundedCodeCostSound.ret atom 0)) + (IxIR0.DynamicCost.Profile.add_zero profile) + +/-- Profile equality is a harmless transport for funded run certificates; +this is useful because source profiles form a commutative additive summary +while target execution is sequenced. -/ +theorem ProfileFundedCodeRun.of_profile_eq + {ctx : Ctx} {fuel : Nat} {cur : FnDef} {before after : Store} + {env : List RVal} {code : Code} {value : RVal} + {left right : SourceProfile} + (hcost : ProfileFundedCodeRun ctx fuel cur before env code after value + left) + (hprofile : left = right) : + ProfileFundedCodeRun ctx fuel cur before env code after value right := by + subst right + exact hcost + +theorem ProfileFundedCodeRun.monoProfile + {ctx : Ctx} {fuel : Nat} {cur : FnDef} {before after : Store} + {env : List RVal} {code : Code} {value : RVal} + {smaller larger : SourceProfile} + (hcost : ProfileFundedCodeRun ctx fuel cur before env code after value + smaller) + (hle : OwnershipAllowanceLE + (sourceProfileOwnershipAllowance smaller) + (sourceProfileOwnershipAllowance larger)) : + ProfileFundedCodeRun ctx fuel cur before env code after value larger := by + obtain ⟨allowance, hrunCost, hfunded⟩ := hcost + exact ⟨allowance, hrunCost, hfunded.trans hle⟩ + +/-- Source-profile counterpart of target `letOp` sequencing. -/ +theorem ProfileFundedCodeRun.letOp + {ctx : Ctx} {fuel : Nat} {cur : FnDef} {before middle after : Store} + {env : List RVal} {op : Op} {opValue value : RVal} {rest : Code} + {opProfile restProfile : SourceProfile} + (hop : ProfileFundedOpRun ctx fuel cur before env op middle opValue + opProfile) + (hrest : ProfileFundedCodeRun ctx fuel cur middle (opValue :: env) rest + after value restProfile) : + ProfileFundedCodeRun ctx (fuel + 1) cur before env (.letOp op rest) + after value (opProfile + restProfile) := by + obtain ⟨opAllowance, hopCost, hopFunded⟩ := hop + obtain ⟨restAllowance, hrestCost, hrestFunded⟩ := hrest + refine ⟨opAllowance.add restAllowance, + CodeOwnershipRunCost.letOp hopCost hrestCost, ?_⟩ + rw [sourceProfileOwnershipAllowance_add] + exact hopFunded.add hrestFunded + +/-- Dynamic continuation transformer for a compiler difference-list +emitter. Unlike the uniform static emitter interface, the continuation +certificate is requested only for the exact sub-run reached after executing +this prefix. Recursive calls may therefore carry the profile of that +particular source trace. -/ +def ProfileFundedEmitRunSound (ctx : Ctx) (cur : FnDef) + (emit : Emit) (emitProfile : SourceProfile) : Prop := + ∀ {continuation : Code} {continuationProfile : SourceProfile} + {fuel : Nat} {before after : Store} {env : List RVal} + {value : RVal}, + AllocationOrderInvariant before → + ValuesInBounds before env → + runCode ctx fuel cur before env (emit continuation) = + .ok (after, value) → + (∀ {restFuel : Nat} {restBefore : Store} {restEnv : List RVal}, + AllocationOrderInvariant restBefore → + ValuesInBounds restBefore restEnv → + runCode ctx restFuel cur restBefore restEnv continuation = + .ok (after, value) → + ProfileFundedCodeRun ctx restFuel cur restBefore restEnv continuation + after value continuationProfile) → + ProfileFundedCodeRun ctx fuel cur before env (emit continuation) + after value (emitProfile + continuationProfile) + +theorem ProfileFundedEmitRunSound.of_profile_eq + {ctx : Ctx} {cur : FnDef} {emit : Emit} + {left right : SourceProfile} + (hsound : ProfileFundedEmitRunSound ctx cur emit left) + (hprofile : left = right) : + ProfileFundedEmitRunSound ctx cur emit right := by + subst right + exact hsound + +theorem ProfileFundedEmitRunSound.id {ctx : Ctx} {cur : FnDef} : + ProfileFundedEmitRunSound ctx cur (_root_.id : Emit) 0 := by + intro continuation continuationProfile fuel before after env value horder + henv hrun hcontinuation + exact ProfileFundedCodeRun.of_profile_eq + (hcontinuation horder henv hrun) + (IxIR0.DynamicCost.Profile.zero_add continuationProfile).symm + +/-- Lift any run-indexed operation producer through the compiler's one-op +difference-list emitter. Recursive call and application producers use this +rule; the local table is one specialization below. -/ +theorem ProfileFundedEmitRunSound.ofOp + {ctx : Ctx} {cur : FnDef} {op : Op} {profile : SourceProfile} + (hop : ∀ {fuel : Nat} {before after : Store} {env : List RVal} + {value : RVal}, + AllocationOrderInvariant before → + ValuesInBounds before env → + runOp ctx fuel cur before env op = .ok (after, value) → + ProfileFundedOpRun ctx fuel cur before env op after value profile) : + ProfileFundedEmitRunSound ctx cur (emitOp op) profile := by + intro continuation continuationProfile fuel before after env value horder + henv hrun hcontinuation + cases fuel with + | zero => + simp [runCode] at hrun + | succ fuel => + rw [runCode.eq_def] at hrun + dsimp only [emitOp] at hrun + cases hopRun : runOp ctx fuel cur before env op with + | error err => + rw [hopRun] at hrun + contradiction + | ok result => + rcases result with ⟨middle, opValue⟩ + rw [hopRun] at hrun + change runCode ctx fuel cur middle (opValue :: env) continuation = + .ok (after, value) at hrun + obtain ⟨opAllowance, hopRunCost, hopFunded⟩ := + hop horder henv hopRun + obtain ⟨hmiddleOrder, hopValue⟩ := + hopRunCost.finalOrderAndValue + have hmiddleEnv : ValuesInBounds middle (opValue :: env) := + (henv.mono (runOp_footprint hopRun).nodes_size).cons hopValue + exact ProfileFundedCodeRun.letOp + ⟨opAllowance, hopRunCost, hopFunded⟩ + (hcontinuation hmiddleOrder hmiddleEnv hrun) + +/-- One classified non-recursive operation is a dynamic emitter prefix. +Its target run is inverted once, then the exact reached continuation run is +passed to the recursive callback. -/ +theorem ProfileFundedEmitRunSound.localOp + {ctx : Ctx} {cur : FnDef} {op : Op} + {allowance : OwnershipAllowance} {profile : SourceProfile} + (hlocal : localOpOwnershipAllowance op = some allowance) + (hfunded : OwnershipAllowanceLE allowance + (sourceProfileOwnershipAllowance profile)) : + ProfileFundedEmitRunSound ctx cur (emitOp op) profile := by + intro continuation continuationProfile fuel before after env value horder + henv hrun hcontinuation + cases fuel with + | zero => + simp [runCode] at hrun + | succ fuel => + rw [runCode.eq_def] at hrun + dsimp only [emitOp] at hrun + cases hopRun : runOp ctx fuel cur before env op with + | error err => + rw [hopRun] at hrun + contradiction + | ok result => + rcases result with ⟨middle, opValue⟩ + rw [hopRun] at hrun + change runCode ctx fuel cur middle (opValue :: env) continuation = + .ok (after, value) at hrun + obtain ⟨hmiddleOrder, hmiddleEnv, hopGrowth⟩ := + (OpOwnershipCostSound.of_local hlocal) horder henv hopRun + have hopCost : ProfileFundedOpRun ctx fuel cur before env op + middle opValue profile := + ⟨allowance, ⟨horder, henv, hopRun, hopGrowth⟩, hfunded⟩ + exact ProfileFundedCodeRun.letOp hopCost + (hcontinuation hmiddleOrder hmiddleEnv hrun) + +theorem ProfileFundedEmitRunSound.monoProfile + {ctx : Ctx} {cur : FnDef} {emit : Emit} + {smaller larger : SourceProfile} + (hsound : ProfileFundedEmitRunSound ctx cur emit smaller) + (hle : OwnershipAllowanceLE + (sourceProfileOwnershipAllowance smaller) + (sourceProfileOwnershipAllowance larger)) : + ProfileFundedEmitRunSound ctx cur emit larger := by + intro continuation continuationProfile fuel before after env value horder + henv hrun hcontinuation + have hcost := hsound horder henv hrun hcontinuation + apply hcost.monoProfile + rw [sourceProfileOwnershipAllowance_add, + sourceProfileOwnershipAllowance_add] + exact hle.add (OwnershipAllowanceLE.refl _) + +/-- Dynamic emitter transformers compose without requiring a static bound +for the recursively executed continuation. -/ +theorem ProfileFundedEmitRunSound.comp + {ctx : Ctx} {cur : FnDef} {first second : Emit} + {firstProfile secondProfile : SourceProfile} + (hfirst : ProfileFundedEmitRunSound ctx cur first firstProfile) + (hsecond : ProfileFundedEmitRunSound ctx cur second secondProfile) : + ProfileFundedEmitRunSound ctx cur (first ∘ second) + (firstProfile + secondProfile) := by + intro continuation continuationProfile fuel before after env value horder + henv hrun hcontinuation + have hcost := hfirst horder henv hrun (by + intro restFuel restBefore restEnv hrestOrder hrestEnv hrestRun + exact hsecond hrestOrder hrestEnv hrestRun hcontinuation) + exact ProfileFundedCodeRun.of_profile_eq hcost + (IxIR0.DynamicCost.Profile.add_assoc _ _ _).symm + +/-- Close a dynamic emitter transformer with the ownership-free return +continuation. -/ +theorem ProfileFundedEmitRunSound.closeRet + {ctx : Ctx} {cur : FnDef} {emit : Emit} {profile : SourceProfile} + (hemit : ProfileFundedEmitRunSound ctx cur emit profile) + (atom : Atom) {fuel : Nat} {before after : Store} {env : List RVal} + {value : RVal} + (horder : AllocationOrderInvariant before) + (henv : ValuesInBounds before env) + (hrun : runCode ctx fuel cur before env (emit (.ret atom)) = + .ok (after, value)) : + ProfileFundedCodeRun ctx fuel cur before env (emit (.ret atom)) after + value profile := by + have hcost := hemit horder henv hrun (by + intro restFuel restBefore restEnv hrestOrder hrestEnv hrestRun + exact ⟨⟨0, 0⟩, + CodeOwnershipCostSound.runCost (CodeOwnershipCostSound.ret atom) + hrestOrder hrestEnv hrestRun, + zeroOwnershipAllowance_le_profile 0⟩) + exact ProfileFundedCodeRun.of_profile_eq hcost + (IxIR0.DynamicCost.Profile.add_zero profile) + +/-- State-indexed dynamic emitter transformer used by the source/target +cost simulation. The universal `ProfileFundedEmitRunSound` above is ideal +for local prefixes, but a recursive operation can only be bounded by one +particular source trace when its runtime state represents that source state. +This judgment carries precisely that `pre`/`mid` relation through the exact +continuation run reached by the prefix. -/ +def ProfileFundedEmitStateRunSound (ctx : Ctx) (cur : FnDef) + (emit : Emit) (pre mid : StatePred) (emitProfile : SourceProfile) : + Prop := + ∀ {continuation : Code} {continuationProfile : SourceProfile} + {fuel : Nat} {before after : Store} {env : List RVal} + {value : RVal}, + AllocationOrderInvariant before → + ValuesInBounds before env → + pre before env → + runCode ctx fuel cur before env (emit continuation) = + .ok (after, value) → + (∀ {restFuel : Nat} {restBefore : Store} {restEnv : List RVal}, + AllocationOrderInvariant restBefore → + ValuesInBounds restBefore restEnv → + mid restBefore restEnv → + runCode ctx restFuel cur restBefore restEnv continuation = + .ok (after, value) → + ProfileFundedCodeRun ctx restFuel cur restBefore restEnv continuation + after value continuationProfile) → + ProfileFundedCodeRun ctx fuel cur before env (emit continuation) + after value (emitProfile + continuationProfile) + +theorem ProfileFundedEmitStateRunSound.of_profile_eq + {ctx : Ctx} {cur : FnDef} {emit : Emit} {pre mid : StatePred} + {left right : SourceProfile} + (hsound : ProfileFundedEmitStateRunSound ctx cur emit pre mid left) + (hprofile : left = right) : + ProfileFundedEmitStateRunSound ctx cur emit pre mid right := by + subst right + exact hsound + +/-- The identity prefix transports any state implication without spending +source allowance. -/ +theorem ProfileFundedEmitStateRunSound.id + {ctx : Ctx} {cur : FnDef} {pre mid : StatePred} + (himp : ∀ {store env}, pre store env → mid store env) : + ProfileFundedEmitStateRunSound ctx cur (_root_.id : Emit) pre mid 0 := by + intro continuation continuationProfile fuel before after env value horder + henv hpre hrun hcontinuation + exact ProfileFundedCodeRun.of_profile_eq + (hcontinuation horder henv (himp hpre) hrun) + (IxIR0.DynamicCost.Profile.zero_add continuationProfile).symm + +/-- An impossible indexed precondition validates any emitter and profile. +This is the exact-run counterpart of `EmitSound.ofFalse`. -/ +theorem ProfileFundedEmitStateRunSound.ofFalse + {ctx : Ctx} {cur : FnDef} {emit : Emit} {mid : StatePred} + {profile : SourceProfile} : + ProfileFundedEmitStateRunSound ctx cur emit (fun _ _ => False) mid + profile := by + intro continuation continuationProfile fuel before after env value horder + henv hfalse hrun hcontinuation + exact hfalse.elim + +theorem ProfileFundedEmitStateRunSound.monoProfile + {ctx : Ctx} {cur : FnDef} {emit : Emit} {pre mid : StatePred} + {smaller larger : SourceProfile} + (hsound : ProfileFundedEmitStateRunSound ctx cur emit pre mid smaller) + (hle : OwnershipAllowanceLE + (sourceProfileOwnershipAllowance smaller) + (sourceProfileOwnershipAllowance larger)) : + ProfileFundedEmitStateRunSound ctx cur emit pre mid larger := by + intro continuation continuationProfile fuel before after env value horder + henv hpre hrun hcontinuation + have hcost := hsound horder henv hpre hrun hcontinuation + apply hcost.monoProfile + rw [sourceProfileOwnershipAllowance_add, + sourceProfileOwnershipAllowance_add] + exact hle.add (OwnershipAllowanceLE.refl _) + +/-- State-indexed dynamic emitter transformers compose, passing the exact +intermediate state relation to the second transformer. -/ +theorem ProfileFundedEmitStateRunSound.comp + {ctx : Ctx} {cur : FnDef} {first second : Emit} + {pre middle post : StatePred} + {firstProfile secondProfile : SourceProfile} + (hfirst : ProfileFundedEmitStateRunSound ctx cur first pre middle + firstProfile) + (hsecond : ProfileFundedEmitStateRunSound ctx cur second middle post + secondProfile) : + ProfileFundedEmitStateRunSound ctx cur (first ∘ second) pre post + (firstProfile + secondProfile) := by + intro continuation continuationProfile fuel before after env value horder + henv hpre hrun hcontinuation + have hcost := hfirst horder henv hpre hrun (by + intro restFuel restBefore restEnv hrestOrder hrestEnv hmiddle hrestRun + exact hsecond hrestOrder hrestEnv hmiddle hrestRun hcontinuation) + exact ProfileFundedCodeRun.of_profile_eq hcost + (IxIR0.DynamicCost.Profile.add_assoc _ _ _).symm + +/-- Lift an exact operation producer that establishes both the semantic +midpoint and the source-funded paired operation cost. -/ +theorem ProfileFundedEmitStateRunSound.ofOp + {ctx : Ctx} {cur : FnDef} {op : Op} {pre mid : StatePred} + {profile : SourceProfile} + (hop : ∀ {fuel : Nat} {before after : Store} {env : List RVal} + {value : RVal}, + AllocationOrderInvariant before → + ValuesInBounds before env → + pre before env → + runOp ctx fuel cur before env op = .ok (after, value) → + mid after (value :: env) ∧ + ProfileFundedOpRun ctx fuel cur before env op after value profile) : + ProfileFundedEmitStateRunSound ctx cur (emitOp op) pre mid profile := by + intro continuation continuationProfile fuel before after env value horder + henv hpre hrun hcontinuation + cases fuel with + | zero => + simp [runCode] at hrun + | succ fuel => + rw [runCode.eq_def] at hrun + dsimp only [emitOp] at hrun + cases hopRun : runOp ctx fuel cur before env op with + | error err => + rw [hopRun] at hrun + contradiction + | ok result => + rcases result with ⟨middleStore, opValue⟩ + rw [hopRun] at hrun + change runCode ctx fuel cur middleStore (opValue :: env) + continuation = .ok (after, value) at hrun + obtain ⟨hmiddle, opAllowance, hopRunCost, hopFunded⟩ := + hop horder henv hpre hopRun + obtain ⟨hmiddleOrder, hopValue⟩ := + hopRunCost.finalOrderAndValue + have hmiddleEnv : ValuesInBounds middleStore (opValue :: env) := + (henv.mono (runOp_footprint hopRun).nodes_size).cons hopValue + exact ProfileFundedCodeRun.letOp + ⟨opAllowance, hopRunCost, hopFunded⟩ + (hcontinuation hmiddleOrder hmiddleEnv hmiddle hrun) + +/-- Local primitive specialization of the state-indexed operation rule. -/ +theorem ProfileFundedEmitStateRunSound.localOp + {ctx : Ctx} {cur : FnDef} {op : Op} {pre mid : StatePred} + {allowance : OwnershipAllowance} {profile : SourceProfile} + (hsemantic : OpSound ctx cur op pre mid) + (hlocal : localOpOwnershipAllowance op = some allowance) + (hfunded : OwnershipAllowanceLE allowance + (sourceProfileOwnershipAllowance profile)) : + ProfileFundedEmitStateRunSound ctx cur (emitOp op) pre mid profile := by + apply ProfileFundedEmitStateRunSound.ofOp + intro fuel before after env value horder henv hpre hrun + obtain ⟨_, _, hgrowth⟩ := + (OpOwnershipCostSound.of_local hlocal) horder henv hrun + exact ⟨hsemantic hpre hrun, allowance, + ⟨horder, henv, hrun, hgrowth⟩, hfunded⟩ + +/-- A semantically indexed zero-cost primitive may be funded by any source +profile fragment. -/ +theorem ProfileFundedEmitStateRunSound.localZero + {ctx : Ctx} {cur : FnDef} {op : Op} {pre mid : StatePred} + {profile : SourceProfile} + (hsemantic : OpSound ctx cur op pre mid) + (hlocal : localOpOwnershipAllowance op = some ⟨0, 0⟩) : + ProfileFundedEmitStateRunSound ctx cur (emitOp op) pre mid profile := + ProfileFundedEmitStateRunSound.localOp hsemantic hlocal + (zeroOwnershipAllowance_le_profile profile) + +/-- A semantically indexed retain primitive consumes one source retain +candidate. -/ +theorem ProfileFundedEmitStateRunSound.localRetain + {ctx : Ctx} {cur : FnDef} {op : Op} {pre mid : StatePred} + (hsemantic : OpSound ctx cur op pre mid) + (hlocal : localOpOwnershipAllowance op = some ⟨0, 2⟩) : + ProfileFundedEmitStateRunSound ctx cur (emitOp op) pre mid + (IxIR0.DynamicCost.retain 1) := by + apply ProfileFundedEmitStateRunSound.localOp hsemantic hlocal + rw [sourceProfileOwnershipAllowance_retain] + simp [OwnershipAllowanceLE, retainedOwnershipAllowance] + +/-- Close a state-indexed emitter with the ownership-free return +continuation. -/ +theorem ProfileFundedEmitStateRunSound.closeRet + {ctx : Ctx} {cur : FnDef} {emit : Emit} {pre mid : StatePred} + {profile : SourceProfile} + (hemit : ProfileFundedEmitStateRunSound ctx cur emit pre mid profile) + (atom : Atom) {fuel : Nat} {before after : Store} {env : List RVal} + {value : RVal} + (horder : AllocationOrderInvariant before) + (henv : ValuesInBounds before env) + (hpre : pre before env) + (hrun : runCode ctx fuel cur before env (emit (.ret atom)) = + .ok (after, value)) : + ProfileFundedCodeRun ctx fuel cur before env (emit (.ret atom)) after + value profile := by + have hcost := hemit horder henv hpre hrun (by + intro restFuel restBefore restEnv hrestOrder hrestEnv _ hrestRun + exact ⟨⟨0, 0⟩, + CodeOwnershipCostSound.runCost (CodeOwnershipCostSound.ret atom) + hrestOrder hrestEnv hrestRun, + zeroOwnershipAllowance_le_profile 0⟩) + exact ProfileFundedCodeRun.of_profile_eq hcost + (IxIR0.DynamicCost.Profile.add_zero profile) + +/-! ### Fuel-bounded state-indexed profile transformers -/ + +/-- Contractive counterpart of `ProfileFundedEmitStateRunSound`. The +complete emitted-code run and every continuation run are restricted to the +same target evaluator bound. Unfolding one `runCode` step therefore exposes +an operation at a strictly smaller index, exactly matching +`CompilerProfileContractsBelow`. -/ +def ProfileFundedEmitStateRunSoundBelow (ctx : Ctx) (cur : FnDef) + (limit : Nat) (emit : Emit) (pre mid : StatePred) + (emitProfile : SourceProfile) : Prop := + ∀ bound, bound ≤ limit → + ∀ {continuation : Code} {continuationProfile : SourceProfile} + {fuel : Nat} {before after : Store} {env : List RVal} + {value : RVal}, + fuel ≤ bound → + AllocationOrderInvariant before → + ValuesInBounds before env → + pre before env → + runCode ctx fuel cur before env (emit continuation) = + .ok (after, value) → + (∀ {restFuel : Nat} {restBefore : Store} {restEnv : List RVal}, + restFuel ≤ bound → + AllocationOrderInvariant restBefore → + ValuesInBounds restBefore restEnv → + mid restBefore restEnv → + runCode ctx restFuel cur restBefore restEnv continuation = + .ok (after, value) → + ProfileFundedCodeRun ctx restFuel cur restBefore restEnv continuation + after value continuationProfile) → + ProfileFundedCodeRun ctx fuel cur before env (emit continuation) + after value (emitProfile + continuationProfile) + +/-- Uniform bounded transformers recover the unbounded interface. -/ +theorem ProfileFundedEmitStateRunSound.of_below + {ctx : Ctx} {cur : FnDef} {emit : Emit} {pre mid : StatePred} + {profile : SourceProfile} + (hsound : ∀ limit, + ProfileFundedEmitStateRunSoundBelow ctx cur limit emit pre mid + profile) : + ProfileFundedEmitStateRunSound ctx cur emit pre mid profile := by + intro continuation continuationProfile fuel before after env value horder + henv hpre hrun hcontinuation + exact (hsound fuel) fuel (Nat.le_refl _) (Nat.le_refl _) horder henv hpre + hrun (by + intro restFuel restBefore restEnv _ hrestOrder hrestEnv hmid hrestRun + exact hcontinuation hrestOrder hrestEnv hmid hrestRun) + +theorem ProfileFundedEmitStateRunSoundBelow.mono + {ctx : Ctx} {cur : FnDef} {emit : Emit} {pre mid : StatePred} + {profile : SourceProfile} {smaller larger : Nat} + (hsound : ProfileFundedEmitStateRunSoundBelow ctx cur larger emit pre + mid profile) + (hbound : smaller ≤ larger) : + ProfileFundedEmitStateRunSoundBelow ctx cur smaller emit pre mid + profile := by + intro bound hsmall continuation continuationProfile fuel before after env + value hfuel horder henv hpre hrun hcontinuation + exact hsound bound (Nat.le_trans hsmall hbound) hfuel horder henv hpre + hrun hcontinuation + +theorem ProfileFundedEmitStateRunSoundBelow.of_profile_eq + {ctx : Ctx} {cur : FnDef} {limit : Nat} {emit : Emit} + {pre mid : StatePred} {left right : SourceProfile} + (hsound : ProfileFundedEmitStateRunSoundBelow ctx cur limit emit pre mid + left) + (hprofile : left = right) : + ProfileFundedEmitStateRunSoundBelow ctx cur limit emit pre mid right := by + subst right + exact hsound + +theorem ProfileFundedEmitStateRunSoundBelow.monoProfile + {ctx : Ctx} {cur : FnDef} {limit : Nat} {emit : Emit} + {pre mid : StatePred} {smaller larger : SourceProfile} + (hsound : ProfileFundedEmitStateRunSoundBelow ctx cur limit emit pre mid + smaller) + (hle : OwnershipAllowanceLE + (sourceProfileOwnershipAllowance smaller) + (sourceProfileOwnershipAllowance larger)) : + ProfileFundedEmitStateRunSoundBelow ctx cur limit emit pre mid larger := + by + intro bound hbound continuation continuationProfile fuel before after + env value hfuel horder henv hpre hrun hcontinuation + have hcost := hsound bound hbound hfuel horder henv hpre hrun + hcontinuation + apply hcost.monoProfile + rw [sourceProfileOwnershipAllowance_add, + sourceProfileOwnershipAllowance_add] + exact hle.add (OwnershipAllowanceLE.refl _) + +/-- The identity prefix transports an indexed state implication at every +bounded fuel. -/ +theorem ProfileFundedEmitStateRunSoundBelow.id + {ctx : Ctx} {cur : FnDef} {limit : Nat} {pre mid : StatePred} + (himp : ∀ {store env}, pre store env → mid store env) : + ProfileFundedEmitStateRunSoundBelow ctx cur limit (_root_.id : Emit) + pre mid 0 := by + intro bound _ continuation continuationProfile fuel before after env value + hfuel horder henv hpre hrun hcontinuation + exact ProfileFundedCodeRun.of_profile_eq + (hcontinuation hfuel horder henv (himp hpre) hrun) + (IxIR0.DynamicCost.Profile.zero_add continuationProfile).symm + +/-- An impossible indexed precondition validates every bounded prefix. -/ +theorem ProfileFundedEmitStateRunSoundBelow.ofFalse + {ctx : Ctx} {cur : FnDef} {limit : Nat} {emit : Emit} + {mid : StatePred} {profile : SourceProfile} : + ProfileFundedEmitStateRunSoundBelow ctx cur limit emit + (fun _ _ => False) mid profile := by + intro bound _ continuation continuationProfile fuel before after env value + hfuel horder henv hfalse hrun hcontinuation + exact hfalse.elim + +/-- Bounded state-indexed profile transformers compose at a common target +fuel ceiling. -/ +theorem ProfileFundedEmitStateRunSoundBelow.comp + {ctx : Ctx} {cur : FnDef} {limit : Nat} {first second : Emit} + {pre middle post : StatePred} + {firstProfile secondProfile : SourceProfile} + (hfirst : ProfileFundedEmitStateRunSoundBelow ctx cur limit first pre + middle firstProfile) + (hsecond : ProfileFundedEmitStateRunSoundBelow ctx cur limit second + middle post secondProfile) : + ProfileFundedEmitStateRunSoundBelow ctx cur limit (first ∘ second) pre + post (firstProfile + secondProfile) := by + intro bound hbound continuation continuationProfile fuel before after env + value hfuel horder henv hpre hrun hcontinuation + have hcost := hfirst bound hbound hfuel horder henv hpre hrun (by + intro restFuel restBefore restEnv hrestFuel hrestOrder hrestEnv hmiddle + hrestRun + exact hsecond bound hbound hrestFuel hrestOrder hrestEnv hmiddle + hrestRun hcontinuation) + exact ProfileFundedCodeRun.of_profile_eq hcost + (IxIR0.DynamicCost.Profile.add_assoc _ _ _).symm + +/-- Bounded operation bridge. A successful enclosing `letOp` run at or +below `limit` executes its operation strictly below `limit`. -/ +theorem ProfileFundedEmitStateRunSoundBelow.ofOp + {ctx : Ctx} {cur : FnDef} {limit : Nat} {op : Op} + {pre mid : StatePred} {profile : SourceProfile} + (hop : ∀ {fuel : Nat} {before after : Store} {env : List RVal} + {value : RVal}, + fuel < limit → + AllocationOrderInvariant before → + ValuesInBounds before env → + pre before env → + runOp ctx fuel cur before env op = .ok (after, value) → + mid after (value :: env) ∧ + ProfileFundedOpRun ctx fuel cur before env op after value profile) : + ProfileFundedEmitStateRunSoundBelow ctx cur limit (emitOp op) pre mid + profile := by + intro bound hbound continuation continuationProfile outerFuel before + after env value houter horder henv hpre hrun hcontinuation + cases outerFuel with + | zero => + simp [runCode] at hrun + | succ fuel => + have hfuelBound : fuel < bound := by omega + have hfuel : fuel < limit := Nat.lt_of_lt_of_le hfuelBound hbound + rw [runCode.eq_def] at hrun + dsimp only [emitOp] at hrun + cases hopRun : runOp ctx fuel cur before env op with + | error err => + rw [hopRun] at hrun + contradiction + | ok result => + rcases result with ⟨middleStore, opValue⟩ + rw [hopRun] at hrun + change runCode ctx fuel cur middleStore (opValue :: env) + continuation = .ok (after, value) at hrun + obtain ⟨hmiddle, opAllowance, hopRunCost, hopFunded⟩ := + hop hfuel horder henv hpre hopRun + obtain ⟨hmiddleOrder, hopValue⟩ := + hopRunCost.finalOrderAndValue + have hmiddleEnv : ValuesInBounds middleStore (opValue :: env) := + (henv.mono (runOp_footprint hopRun).nodes_size).cons hopValue + exact ProfileFundedCodeRun.letOp + ⟨opAllowance, hopRunCost, hopFunded⟩ + (hcontinuation (Nat.le_of_lt hfuelBound) hmiddleOrder hmiddleEnv + hmiddle hrun) + +/-- A semantically indexed local operation lifts through the bounded +profile transformer using the same primitive allowance table. -/ +theorem ProfileFundedEmitStateRunSoundBelow.localOp + {ctx : Ctx} {cur : FnDef} {limit : Nat} {op : Op} + {pre mid : StatePred} {allowance : OwnershipAllowance} + {profile : SourceProfile} + (hsemantic : OpSound ctx cur op pre mid) + (hlocal : localOpOwnershipAllowance op = some allowance) + (hfunded : OwnershipAllowanceLE allowance + (sourceProfileOwnershipAllowance profile)) : + ProfileFundedEmitStateRunSoundBelow ctx cur limit (emitOp op) pre mid + profile := by + apply ProfileFundedEmitStateRunSoundBelow.ofOp + intro fuel before after env value _ horder henv hpre hrun + obtain ⟨_, _, hgrowth⟩ := + (OpOwnershipCostSound.of_local hlocal) horder henv hrun + exact ⟨hsemantic hpre hrun, allowance, + ⟨horder, henv, hrun, hgrowth⟩, hfunded⟩ + +/-- Attach a local paired charge to an operation whose semantic contract is +itself available only below the current evaluator bound. This is the +contractive bridge used by generated recursor prefixes. -/ +theorem ProfileFundedEmitStateRunSoundBelow.localOpBelow + {ctx : Ctx} {cur : FnDef} {limit : Nat} {op : Op} + {pre mid : StatePred} {allowance : OwnershipAllowance} + {profile : SourceProfile} + (hsemantic : OpSoundBelow ctx cur limit op pre mid) + (hlocal : localOpOwnershipAllowance op = some allowance) + (hfunded : OwnershipAllowanceLE allowance + (sourceProfileOwnershipAllowance profile)) : + ProfileFundedEmitStateRunSoundBelow ctx cur limit (emitOp op) pre mid + profile := by + apply ProfileFundedEmitStateRunSoundBelow.ofOp + intro fuel before after env value hbound horder henv hpre hrun + obtain ⟨_, _, hgrowth⟩ := + (OpOwnershipCostSound.of_local hlocal) horder henv hrun + exact ⟨hsemantic hbound hpre hrun, allowance, + ⟨horder, henv, hrun, hgrowth⟩, hfunded⟩ + +theorem ProfileFundedEmitStateRunSoundBelow.localZeroBelow + {ctx : Ctx} {cur : FnDef} {limit : Nat} {op : Op} + {pre mid : StatePred} {profile : SourceProfile} + (hsemantic : OpSoundBelow ctx cur limit op pre mid) + (hlocal : localOpOwnershipAllowance op = some ⟨0, 0⟩) : + ProfileFundedEmitStateRunSoundBelow ctx cur limit (emitOp op) pre mid + profile := + ProfileFundedEmitStateRunSoundBelow.localOpBelow hsemantic hlocal + (zeroOwnershipAllowance_le_profile profile) + +theorem ProfileFundedEmitStateRunSoundBelow.localRetainBelow + {ctx : Ctx} {cur : FnDef} {limit : Nat} {op : Op} + {pre mid : StatePred} + (hsemantic : OpSoundBelow ctx cur limit op pre mid) + (hlocal : localOpOwnershipAllowance op = some ⟨0, 2⟩) : + ProfileFundedEmitStateRunSoundBelow ctx cur limit (emitOp op) pre mid + (IxIR0.DynamicCost.retain 1) := by + apply ProfileFundedEmitStateRunSoundBelow.localOpBelow hsemantic hlocal + rw [sourceProfileOwnershipAllowance_retain] + simp [OwnershipAllowanceLE, retainedOwnershipAllowance] + +theorem ProfileFundedEmitStateRunSoundBelow.localZero + {ctx : Ctx} {cur : FnDef} {limit : Nat} {op : Op} + {pre mid : StatePred} {profile : SourceProfile} + (hsemantic : OpSound ctx cur op pre mid) + (hlocal : localOpOwnershipAllowance op = some ⟨0, 0⟩) : + ProfileFundedEmitStateRunSoundBelow ctx cur limit (emitOp op) pre mid + profile := + ProfileFundedEmitStateRunSoundBelow.localOp hsemantic hlocal + (zeroOwnershipAllowance_le_profile profile) + +theorem ProfileFundedEmitStateRunSoundBelow.localRetain + {ctx : Ctx} {cur : FnDef} {limit : Nat} {op : Op} + {pre mid : StatePred} + (hsemantic : OpSound ctx cur op pre mid) + (hlocal : localOpOwnershipAllowance op = some ⟨0, 2⟩) : + ProfileFundedEmitStateRunSoundBelow ctx cur limit (emitOp op) pre mid + (IxIR0.DynamicCost.retain 1) := by + apply ProfileFundedEmitStateRunSoundBelow.localOp hsemantic hlocal + rw [sourceProfileOwnershipAllowance_retain] + simp [OwnershipAllowanceLE, retainedOwnershipAllowance] + +/-- Close a bounded state transformer with the ownership-free return +continuation. -/ +theorem ProfileFundedEmitStateRunSoundBelow.closeRet + {ctx : Ctx} {cur : FnDef} {limit : Nat} {emit : Emit} + {pre mid : StatePred} {profile : SourceProfile} + (hemit : ProfileFundedEmitStateRunSoundBelow ctx cur limit emit pre mid + profile) + (atom : Atom) {fuel : Nat} {before after : Store} {env : List RVal} + {value : RVal} + (hfuel : fuel ≤ limit) + (horder : AllocationOrderInvariant before) + (henv : ValuesInBounds before env) + (hpre : pre before env) + (hrun : runCode ctx fuel cur before env (emit (.ret atom)) = + .ok (after, value)) : + ProfileFundedCodeRun ctx fuel cur before env (emit (.ret atom)) after + value profile := by + have hcost := hemit limit (Nat.le_refl _) (by + exact hfuel) horder henv hpre hrun (by + intro restFuel restBefore restEnv _ hrestOrder hrestEnv _ hrestRun + exact ⟨⟨0, 0⟩, + CodeOwnershipCostSound.runCost (CodeOwnershipCostSound.ret atom) + hrestOrder hrestEnv hrestRun, + zeroOwnershipAllowance_le_profile 0⟩) + exact ProfileFundedCodeRun.of_profile_eq hcost + (IxIR0.DynamicCost.Profile.add_zero profile) + +/-- Cost companion to `LowerResultValueSound`. Its state predicates are +the same graph-and-ownership boundary as the semantic theorem, preventing a +single source trace from being applied to unrelated target inputs. -/ +structure LowerResultProfileSound + (funRel : Sim.FunctionRel) (recSelfRel : RecSelfRel) + (ctx : Ctx) (cur : FnDef) (input output : VEnv) + (sourceInput sourceOutput : List IxIR0.Value) + (sourceValue : IxIR0.Value) (world : Ixon.Owned) + (emit : Emit) (av : AVal) (profile : SourceProfile) : Prop + extends LowerResultValueSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue world emit av where + profileEmits : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSound ctx cur emit + (GraphOwnsVEnvProtected funRel recSelfRel input sourceInput + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output sourceOutput + sourceValue world av sourceRest rest slots) + profile + +/-- State-indexed cost companion to `LowerBorrowValueSound`. It records the +same pending-owner convention as the semantic borrow judgment while funding +the exact emitter prefix from the source expression profile. -/ +structure LowerBorrowProfileSound + (funRel : Sim.FunctionRel) (recSelfRel : RecSelfRel) + (ctx : Ctx) (cur : FnDef) (input output : VEnv) + (sourceInput sourceOutput : List IxIR0.Value) + (sourceValue : IxIR0.Value) (emit : Emit) (av : AVal) + (release : Bool) (profile : SourceProfile) : Prop + extends LowerBorrowValueSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue emit av release where + profileEmits : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSound ctx cur emit + (GraphOwnsVEnvProtected funRel recSelfRel input sourceInput + sourceRest rest slots) + (GraphOwnsBorrowResultProtected funRel recSelfRel output sourceOutput + sourceValue av release sourceRest rest slots) + profile + +theorem LowerBorrowProfileSound.of_profile_eq + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {av : AVal} + {release : Bool} {left right : SourceProfile} + (hsound : LowerBorrowProfileSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceValue emit av release left) + (hprofile : left = right) : + LowerBorrowProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue emit av release right := by + subst right + exact hsound + +/-- State-indexed cost companion to semantic left-to-right argument +lowering. The single profile is the additive trace of the complete argument +prefix. -/ +structure LowerArgsProfileSound + (funRel : Sim.FunctionRel) (recSelfRel : RecSelfRel) + (ctx : Ctx) (cur : FnDef) (input output : VEnv) + (sourceInput sourceOutput sourceValues : List IxIR0.Value) + (worlds : List Ixon.Owned) (emit : Emit) (avs : List AVal) + (profile : SourceProfile) : Prop + extends LowerArgsValueSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValues worlds emit avs where + profileEmits : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSound ctx cur emit + (GraphOwnsVEnvProtected funRel recSelfRel input sourceInput + sourceRest rest slots) + (GraphOwnsArgsResultProtected funRel recSelfRel output sourceOutput + sourceValues worlds avs sourceRest rest slots) + profile + +/-! ### Fuel-bounded semantic/profile lowering results -/ + +/-- A semantic lowering result whose profile transformer is valid through +one target evaluator bound. The semantic component remains unbounded: value +contracts are sealed independently before the cost-contract fixed point. -/ +structure LowerResultProfileSoundBelow + (funRel : Sim.FunctionRel) (recSelfRel : RecSelfRel) + (ctx : Ctx) (cur : FnDef) (limit : Nat) (input output : VEnv) + (sourceInput sourceOutput : List IxIR0.Value) + (sourceValue : IxIR0.Value) (world : Ixon.Owned) + (emit : Emit) (av : AVal) (profile : SourceProfile) : Prop + extends LowerResultValueSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue world emit av where + profileEmits : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSoundBelow ctx cur limit emit + (GraphOwnsVEnvProtected funRel recSelfRel input sourceInput + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output sourceOutput + sourceValue world av sourceRest rest slots) + profile + +structure LowerBorrowProfileSoundBelow + (funRel : Sim.FunctionRel) (recSelfRel : RecSelfRel) + (ctx : Ctx) (cur : FnDef) (limit : Nat) (input output : VEnv) + (sourceInput sourceOutput : List IxIR0.Value) + (sourceValue : IxIR0.Value) (emit : Emit) (av : AVal) + (release : Bool) (profile : SourceProfile) : Prop + extends LowerBorrowValueSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue emit av release where + profileEmits : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSoundBelow ctx cur limit emit + (GraphOwnsVEnvProtected funRel recSelfRel input sourceInput + sourceRest rest slots) + (GraphOwnsBorrowResultProtected funRel recSelfRel output sourceOutput + sourceValue av release sourceRest rest slots) + profile + +structure LowerArgsProfileSoundBelow + (funRel : Sim.FunctionRel) (recSelfRel : RecSelfRel) + (ctx : Ctx) (cur : FnDef) (limit : Nat) (input output : VEnv) + (sourceInput sourceOutput sourceValues : List IxIR0.Value) + (worlds : List Ixon.Owned) (emit : Emit) (avs : List AVal) + (profile : SourceProfile) : Prop + extends LowerArgsValueSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValues worlds emit avs where + profileEmits : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSoundBelow ctx cur limit emit + (GraphOwnsVEnvProtected funRel recSelfRel input sourceInput + sourceRest rest slots) + (GraphOwnsArgsResultProtected funRel recSelfRel output sourceOutput + sourceValues worlds avs sourceRest rest slots) + profile + +/-- Results proved at every target bound recover the public unbounded +profile interface. -/ +theorem LowerResultProfileSound.of_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {world : Ixon.Owned} + {emit : Emit} {av : AVal} {profile : SourceProfile} + (hsound : ∀ limit, + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + output sourceInput sourceOutput sourceValue world emit av profile) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue world emit av profile := by + refine + { toLowerResultValueSound := (hsound 0).toLowerResultValueSound + profileEmits := ?_ } + intro sourceRest rest slots + exact ProfileFundedEmitStateRunSound.of_below fun limit => + (hsound limit).profileEmits sourceRest rest slots + +theorem LowerBorrowProfileSound.of_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {av : AVal} + {release : Bool} {profile : SourceProfile} + (hsound : ∀ limit, + LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit input + output sourceInput sourceOutput sourceValue emit av release profile) : + LowerBorrowProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue emit av release profile := by + refine + { toLowerBorrowValueSound := (hsound 0).toLowerBorrowValueSound + profileEmits := ?_ } + intro sourceRest rest slots + exact ProfileFundedEmitStateRunSound.of_below fun limit => + (hsound limit).profileEmits sourceRest rest slots + +theorem LowerArgsProfileSound.of_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput sourceValues : List IxIR0.Value} + {worlds : List Ixon.Owned} {emit : Emit} {avs : List AVal} + {profile : SourceProfile} + (hsound : ∀ limit, + LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit input + output sourceInput sourceOutput sourceValues worlds emit avs + profile) : + LowerArgsProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValues worlds emit avs profile := by + refine + { toLowerArgsValueSound := (hsound 0).toLowerArgsValueSound + profileEmits := ?_ } + intro sourceRest rest slots + exact ProfileFundedEmitStateRunSound.of_below fun limit => + (hsound limit).profileEmits sourceRest rest slots + +theorem LowerResultProfileSoundBelow.mono + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {smaller larger : Nat} + {input output : VEnv} {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {world : Ixon.Owned} + {emit : Emit} {av : AVal} {profile : SourceProfile} + (hsound : LowerResultProfileSoundBelow funRel recSelfRel ctx cur larger + input output sourceInput sourceOutput sourceValue world emit av profile) + (hbound : smaller ≤ larger) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur smaller input + output sourceInput sourceOutput sourceValue world emit av profile := by + refine + { toLowerResultValueSound := hsound.toLowerResultValueSound + profileEmits := ?_ } + intro sourceRest rest slots + exact (hsound.profileEmits sourceRest rest slots).mono hbound + +theorem LowerBorrowProfileSoundBelow.mono + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {smaller larger : Nat} + {input output : VEnv} {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {av : AVal} + {release : Bool} {profile : SourceProfile} + (hsound : LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur larger + input output sourceInput sourceOutput sourceValue emit av release + profile) + (hbound : smaller ≤ larger) : + LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur smaller input + output sourceInput sourceOutput sourceValue emit av release profile := by + refine + { toLowerBorrowValueSound := hsound.toLowerBorrowValueSound + profileEmits := ?_ } + intro sourceRest rest slots + exact (hsound.profileEmits sourceRest rest slots).mono hbound + +theorem LowerArgsProfileSoundBelow.mono + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {smaller larger : Nat} + {input output : VEnv} + {sourceInput sourceOutput sourceValues : List IxIR0.Value} + {worlds : List Ixon.Owned} {emit : Emit} {avs : List AVal} + {profile : SourceProfile} + (hsound : LowerArgsProfileSoundBelow funRel recSelfRel ctx cur larger + input output sourceInput sourceOutput sourceValues worlds emit avs + profile) + (hbound : smaller ≤ larger) : + LowerArgsProfileSoundBelow funRel recSelfRel ctx cur smaller input output + sourceInput sourceOutput sourceValues worlds emit avs profile := by + refine + { toLowerArgsValueSound := hsound.toLowerArgsValueSound + profileEmits := ?_ } + intro sourceRest rest slots + exact (hsound.profileEmits sourceRest rest slots).mono hbound + +theorem LowerResultProfileSoundBelow.of_profile_eq + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {world : Ixon.Owned} + {emit : Emit} {av : AVal} {left right : SourceProfile} + (hsound : LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceValue world emit av left) + (hprofile : left = right) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceInput sourceOutput sourceValue world emit av right := by + subst right + exact hsound + +theorem LowerBorrowProfileSoundBelow.of_profile_eq + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {av : AVal} + {release : Bool} {left right : SourceProfile} + (hsound : LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceValue emit av release left) + (hprofile : left = right) : + LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceInput sourceOutput sourceValue emit av release right := by + subst right + exact hsound + +theorem LowerArgsProfileSoundBelow.of_profile_eq + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} + {sourceInput sourceOutput sourceValues : List IxIR0.Value} + {worlds : List Ixon.Owned} {emit : Emit} {avs : List AVal} + {left right : SourceProfile} + (hsound : LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceValues worlds emit avs left) + (hprofile : left = right) : + LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceInput sourceOutput sourceValues worlds emit avs right := by + subst right + exact hsound + +theorem LowerResultProfileSoundBelow.monoProfile + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {world : Ixon.Owned} + {emit : Emit} {av : AVal} {smaller larger : SourceProfile} + (hsound : LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceValue world emit av smaller) + (hle : OwnershipAllowanceLE + (sourceProfileOwnershipAllowance smaller) + (sourceProfileOwnershipAllowance larger)) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceInput sourceOutput sourceValue world emit av larger := by + refine + { toLowerResultValueSound := hsound.toLowerResultValueSound + profileEmits := ?_ } + intro sourceRest rest slots + exact (hsound.profileEmits sourceRest rest slots).monoProfile hle + +theorem LowerBorrowProfileSoundBelow.monoProfile + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {av : AVal} + {release : Bool} {smaller larger : SourceProfile} + (hsound : LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceValue emit av release + smaller) + (hle : OwnershipAllowanceLE + (sourceProfileOwnershipAllowance smaller) + (sourceProfileOwnershipAllowance larger)) : + LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceInput sourceOutput sourceValue emit av release larger := by + refine + { toLowerBorrowValueSound := hsound.toLowerBorrowValueSound + profileEmits := ?_ } + intro sourceRest rest slots + exact (hsound.profileEmits sourceRest rest slots).monoProfile hle + +theorem LowerArgsProfileSoundBelow.monoProfile + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} + {sourceInput sourceOutput sourceValues : List IxIR0.Value} + {worlds : List Ixon.Owned} {emit : Emit} {avs : List AVal} + {smaller larger : SourceProfile} + (hsound : LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceValues worlds emit avs + smaller) + (hle : OwnershipAllowanceLE + (sourceProfileOwnershipAllowance smaller) + (sourceProfileOwnershipAllowance larger)) : + LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceInput sourceOutput sourceValues worlds emit avs larger := by + refine + { toLowerArgsValueSound := hsound.toLowerArgsValueSound + profileEmits := ?_ } + intro sourceRest rest slots + exact (hsound.profileEmits sourceRest rest slots).monoProfile hle + +theorem LowerResultProfileSoundBelow.addProfileLeft + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {world : Ixon.Owned} + {emit : Emit} {av : AVal} {profile : SourceProfile} + (hsound : LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceValue world emit av profile) + (extra : SourceProfile) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceInput sourceOutput sourceValue world emit av (extra + profile) := by + apply hsound.monoProfile + rw [sourceProfileOwnershipAllowance_add] + simp [OwnershipAllowanceLE, OwnershipAllowance.add] + +/-- Close a bounded lowering prefix with its generated return and obtain the +exact run-indexed target cost certificate. -/ +theorem LowerResultProfileSoundBelow.closeCost + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {world : Ixon.Owned} + {emit : Emit} {av : AVal} {profile : SourceProfile} + (hsound : LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceValue world emit av profile) + (sourceRest : List (Ixon.Owned × IxIR0.Value)) + (rest : List Sim.Root) {fuel : Nat} {before after : Store} + {env : List RVal} {value : RVal} + (hfuel : fuel ≤ limit) + (horder : AllocationOrderInvariant before) + (henv : ValuesInBounds before env) + (hpre : GraphOwnsVEnv funRel recSelfRel input sourceInput sourceRest + rest before env) + (hrun : runCode ctx fuel cur before env + (emit (.ret (av.toAtom output))) = .ok (after, value)) : + ProfileFundedCodeRun ctx fuel cur before env + (emit (.ret (av.toAtom output))) after value profile := by + exact (hsound.profileEmits sourceRest rest []).closeRet + (av.toAtom output) hfuel horder henv + ⟨hpre, SlotsRealize.nil⟩ hrun + +theorem LowerArgsProfileSound.of_profile_eq + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput sourceValues : List IxIR0.Value} + {worlds : List Ixon.Owned} {emit : Emit} {avs : List AVal} + {left right : SourceProfile} + (hsound : LowerArgsProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValues worlds emit avs left) + (hprofile : left = right) : + LowerArgsProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValues worlds emit avs right := by + subst right + exact hsound + +theorem LowerArgsProfileSound.monoProfile + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput sourceValues : List IxIR0.Value} + {worlds : List Ixon.Owned} {emit : Emit} {avs : List AVal} + {smaller larger : SourceProfile} + (hsound : LowerArgsProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValues worlds emit avs smaller) + (hle : OwnershipAllowanceLE + (sourceProfileOwnershipAllowance smaller) + (sourceProfileOwnershipAllowance larger)) : + LowerArgsProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValues worlds emit avs larger := by + refine + { toLowerArgsValueSound := hsound.toLowerArgsValueSound + profileEmits := ?_ } + intro sourceRest rest slots + exact ProfileFundedEmitStateRunSound.monoProfile + (hsound.profileEmits sourceRest rest slots) hle + +/-- The empty argument prefix preserves the indexed source/target state and +spends no source allowance. -/ +theorem lowerArgs_nil_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} : + LowerArgsProfileSound funRel recSelfRel ctx cur Γ Γ + sourceEnv sourceEnv [] [] (_root_.id : Emit) [] 0 := by + refine + { toLowerArgsValueSound := lowerArgs_nil_value_sound + profileEmits := ?_ } + intro sourceRest rest slots + apply ProfileFundedEmitStateRunSound.id + intro store env hpre + obtain ⟨⟨roots, hΓ, hrestGraph, hown⟩, hslots⟩ := hpre + exact ⟨⟨roots, [], hΓ, .nil, .nil, hrestGraph, + by simpa [Sim.rootsForWorlds] using hown⟩, hslots⟩ + +/-- Profiled left-to-right argument sequencing. The head result is moved +into the semantic root frame while the tail runs, then restored as the first +argument result at the continuation boundary. -/ +theorem LowerResultProfileSound.consArgs + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {input middle output : VEnv} + {sourceInput sourceMiddle sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {sourceValues : List IxIR0.Value} + {world : Ixon.Owned} {worlds : List Ixon.Owned} + {emitHead emitTail : Emit} {av : AVal} {avs : List AVal} + {headProfile tailProfile : SourceProfile} + (head : LowerResultProfileSound funRel recSelfRel ctx cur input middle + sourceInput sourceMiddle sourceValue world emitHead av headProfile) + (tail : LowerArgsProfileSound funRel recSelfRel ctx cur middle output + sourceMiddle sourceOutput sourceValues worlds emitTail avs tailProfile) : + LowerArgsProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput (sourceValue :: sourceValues) + (world :: worlds) (emitHead ∘ emitTail) (av :: avs) + (headProfile + tailProfile) := by + refine + { toLowerArgsValueSound := + head.toLowerResultValueSound.consArgs tail.toLowerArgsValueSound + profileEmits := ?_ } + intro sourceRest rest slots + intro continuation continuationProfile fuel before after env value horder + henv hpre hrun hcontinuation + have hcost : ProfileFundedCodeRun ctx fuel cur before env + ((emitHead ∘ emitTail) continuation) after value + (headProfile + (tailProfile + continuationProfile)) := by + exact (head.profileEmits sourceRest rest slots) horder henv hpre hrun (by + intro restFuel headStore headEnv hheadOrder hheadBounds hmid htailRun + obtain ⟨⟨envRoots, headValue, hmiddle, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hmid + let root : Sim.Root := ⟨world, headValue⟩ + have hrootWorld : Sim.HasWorld headStore world headValue := by + apply hown.roots_world root + simp [root] + have hframeGraph : Sim.RootsGraph funRel headStore + ((world, sourceValue) :: sourceRest) (root :: rest) := + .cons rfl hrootWorld hvalueGraph hrestGraph + have hprotect : SlotsRealize middle headEnv + (aValProtection av headValue) := + head.stable.protection_realized hav + have htailOwn : Sim.RootOwnership headStore + (envRoots ++ root :: rest) := by + apply hown.perm + simpa [root] using + (permExtractRoot root envRoots [] rest).symm + have htailPre : GraphOwnsVEnvProtected funRel recSelfRel middle + sourceMiddle ((world, sourceValue) :: sourceRest) (root :: rest) + (aValProtection av headValue ++ slots) headStore headEnv := + ⟨⟨envRoots, hmiddle, hframeGraph, htailOwn⟩, + hprotect.append hslots⟩ + exact + (tail.profileEmits + ((world, sourceValue) :: sourceRest) (root :: rest) + (aValProtection av headValue ++ slots)) + hheadOrder hheadBounds htailPre htailRun (by + intro finalFuel finalStore finalEnv hfinalOrder hfinalBounds + htailPost hcontRun + obtain ⟨⟨outRoots, values, houtput, havs, hvalueGraphs, + hframeGraphFinal, hownTail⟩, hslotsTail⟩ := htailPost + cases hframeGraphFinal with + | cons _ _ hheadGraph hrestGraphFinal => + have havFinal : AValRealizes output finalEnv av headValue := + head.stable.realize_of_protection hav + hslotsTail.left_of_append + have hheadGraph' : + Sim.ValueGraph funRel finalStore sourceValue headValue := by + simpa [root] using hheadGraph + have hownFinal : Sim.RootOwnership finalStore + (Sim.rootsForWorlds (world :: worlds) + (headValue :: values) ++ outRoots ++ rest) := by + apply hownTail.perm + simpa [root, List.append_assoc] using + (permExtractRoot root + (Sim.rootsForWorlds worlds values ++ outRoots) [] rest) + have hfinalPost : GraphOwnsArgsResultProtected funRel + recSelfRel output sourceOutput + (sourceValue :: sourceValues) (world :: worlds) + (av :: avs) sourceRest rest slots finalStore finalEnv := + ⟨⟨outRoots, headValue :: values, houtput, + .cons havFinal havs, .cons hheadGraph' hvalueGraphs, + hrestGraphFinal, hownFinal⟩, + hslotsTail.right_of_append⟩ + exact hcontinuation hfinalOrder hfinalBounds hfinalPost + hcontRun)) + exact ProfileFundedCodeRun.of_profile_eq hcost + (IxIR0.DynamicCost.Profile.add_assoc + headProfile tailProfile continuationProfile).symm + +/-- Bounded empty argument prefix. -/ +theorem lowerArgs_nil_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} : + LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit Γ Γ + sourceEnv sourceEnv [] [] (_root_.id : Emit) [] 0 := by + refine + { toLowerArgsValueSound := lowerArgs_nil_value_sound + profileEmits := ?_ } + intro sourceRest rest slots + apply ProfileFundedEmitStateRunSoundBelow.id + intro store env hpre + obtain ⟨⟨roots, hΓ, hrestGraph, hown⟩, hslots⟩ := hpre + exact ⟨⟨roots, [], hΓ, .nil, .nil, hrestGraph, + by simpa [Sim.rootsForWorlds] using hown⟩, hslots⟩ + +/-- Fuel-bounded left-to-right argument sequencing. -/ +theorem LowerResultProfileSoundBelow.consArgs + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input middle output : VEnv} + {sourceInput sourceMiddle sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {sourceValues : List IxIR0.Value} + {world : Ixon.Owned} {worlds : List Ixon.Owned} + {emitHead emitTail : Emit} {av : AVal} {avs : List AVal} + {headProfile tailProfile : SourceProfile} + (head : LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit + input middle sourceInput sourceMiddle sourceValue world emitHead av + headProfile) + (tail : LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit + middle output sourceMiddle sourceOutput sourceValues worlds emitTail + avs tailProfile) : + LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceInput sourceOutput (sourceValue :: sourceValues) + (world :: worlds) (emitHead ∘ emitTail) (av :: avs) + (headProfile + tailProfile) := by + refine + { toLowerArgsValueSound := + head.toLowerResultValueSound.consArgs tail.toLowerArgsValueSound + profileEmits := ?_ } + intro sourceRest rest slots + intro bound hbound continuation continuationProfile fuel before after env + value hfuel horder henv hpre hrun hcontinuation + have hcost : ProfileFundedCodeRun ctx fuel cur before env + ((emitHead ∘ emitTail) continuation) after value + (headProfile + (tailProfile + continuationProfile)) := by + exact (head.profileEmits sourceRest rest slots) bound hbound hfuel + horder henv hpre hrun (by + intro restFuel headStore headEnv hrestFuel hheadOrder hheadBounds + hmid htailRun + obtain ⟨⟨envRoots, headValue, hmiddle, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hmid + let root : Sim.Root := ⟨world, headValue⟩ + have hrootWorld : Sim.HasWorld headStore world headValue := by + apply hown.roots_world root + simp [root] + have hframeGraph : Sim.RootsGraph funRel headStore + ((world, sourceValue) :: sourceRest) (root :: rest) := + .cons rfl hrootWorld hvalueGraph hrestGraph + have hprotect : SlotsRealize middle headEnv + (aValProtection av headValue) := + head.stable.protection_realized hav + have htailOwn : Sim.RootOwnership headStore + (envRoots ++ root :: rest) := by + apply hown.perm + simpa [root] using + (permExtractRoot root envRoots [] rest).symm + have htailPre : GraphOwnsVEnvProtected funRel recSelfRel middle + sourceMiddle ((world, sourceValue) :: sourceRest) (root :: rest) + (aValProtection av headValue ++ slots) headStore headEnv := + ⟨⟨envRoots, hmiddle, hframeGraph, htailOwn⟩, + hprotect.append hslots⟩ + exact + (tail.profileEmits + ((world, sourceValue) :: sourceRest) (root :: rest) + (aValProtection av headValue ++ slots)) + bound hbound hrestFuel hheadOrder hheadBounds htailPre htailRun + (by + intro finalFuel finalStore finalEnv hfinalFuel hfinalOrder + hfinalBounds htailPost hcontRun + obtain ⟨⟨outRoots, values, houtput, havs, hvalueGraphs, + hframeGraphFinal, hownTail⟩, hslotsTail⟩ := htailPost + cases hframeGraphFinal with + | cons _ _ hheadGraph hrestGraphFinal => + have havFinal : AValRealizes output finalEnv av headValue := + head.stable.realize_of_protection hav + hslotsTail.left_of_append + have hheadGraph' : + Sim.ValueGraph funRel finalStore sourceValue + headValue := by + simpa [root] using hheadGraph + have hownFinal : Sim.RootOwnership finalStore + (Sim.rootsForWorlds (world :: worlds) + (headValue :: values) ++ outRoots ++ rest) := by + apply hownTail.perm + simpa [root, List.append_assoc] using + (permExtractRoot root + (Sim.rootsForWorlds worlds values ++ outRoots) [] + rest) + have hfinalPost : GraphOwnsArgsResultProtected funRel + recSelfRel output sourceOutput + (sourceValue :: sourceValues) (world :: worlds) + (av :: avs) sourceRest rest slots finalStore finalEnv := + ⟨⟨outRoots, headValue :: values, houtput, + .cons havFinal havs, .cons hheadGraph' hvalueGraphs, + hrestGraphFinal, hownFinal⟩, + hslotsTail.right_of_append⟩ + exact hcontinuation hfinalFuel hfinalOrder hfinalBounds + hfinalPost hcontRun)) + exact ProfileFundedCodeRun.of_profile_eq hcost + (IxIR0.DynamicCost.Profile.add_assoc + headProfile tailProfile continuationProfile).symm + +/-- Cost-carrying left-to-right source argument evaluation. Unlike the +fuel-free semantic `SourceArgsEval`, this relation retains the exact additive +profile needed by the target-cost induction. -/ +inductive SourceArgsProfile (sourceCtx : IxIR0.Ctx) + (sourceEnv : List IxIR0.Value) : + List IxIR0.Expr → List IxIR0.Value → SourceProfile → Prop where + | nil : SourceArgsProfile sourceCtx sourceEnv [] [] 0 + | cons {expr : IxIR0.Expr} {sourceValue : IxIR0.Value} + {expressions : List IxIR0.Expr} {sourceValues : List IxIR0.Value} + {fuel : Nat} {headProfile tailProfile : SourceProfile} : + IxIR0.DynamicCost.Eval sourceCtx fuel sourceEnv expr sourceValue + headProfile → + SourceArgsProfile sourceCtx sourceEnv expressions sourceValues + tailProfile → + SourceArgsProfile sourceCtx sourceEnv (expr :: expressions) + (sourceValue :: sourceValues) (headProfile + tailProfile) + +/-- Dependent lockstep traversal of a profiled source argument vector. +Clients receive the exact head evaluation profile, the original profiled +tail derivation, and the recursively produced result while expressions, +values, and their additive profile stay synchronized. -/ +theorem SourceArgsProfile.traverse + {sourceCtx : IxIR0.Ctx} {sourceEnv : List IxIR0.Value} + {Result : List IxIR0.Expr → List IxIR0.Value → SourceProfile → Prop} + (hnil : Result [] [] 0) + (hcons : ∀ {expr : IxIR0.Expr} {sourceValue : IxIR0.Value} + {expressions : List IxIR0.Expr} + {sourceValues : List IxIR0.Value} {fuel : Nat} + {headProfile tailProfile : SourceProfile}, + IxIR0.DynamicCost.Eval sourceCtx fuel sourceEnv expr sourceValue + headProfile → + SourceArgsProfile sourceCtx sourceEnv expressions sourceValues + tailProfile → + Result expressions sourceValues tailProfile → + Result (expr :: expressions) (sourceValue :: sourceValues) + (headProfile + tailProfile)) + {expressions : List IxIR0.Expr} {sourceValues : List IxIR0.Value} + {profile : SourceProfile} + (hargs : SourceArgsProfile sourceCtx sourceEnv expressions sourceValues + profile) : + Result expressions sourceValues profile := by + induction hargs with + | nil => exact hnil + | cons hhead htail ih => exact hcons hhead htail ih + +theorem SourceArgsProfile.toSourceArgsEval + {sourceCtx : IxIR0.Ctx} {sourceEnv : List IxIR0.Value} + {expressions : List IxIR0.Expr} {sourceValues : List IxIR0.Value} + {profile : SourceProfile} + (hargs : SourceArgsProfile sourceCtx sourceEnv expressions sourceValues + profile) : + SourceArgsEval sourceCtx sourceEnv expressions sourceValues := by + exact SourceArgsProfile.traverse + (Result := fun currentExpressions currentValues _ => + SourceArgsEval sourceCtx sourceEnv currentExpressions currentValues) + (hnil := .nil) + (hcons := by + intro expr sourceValue currentExpressions currentValues fuel + headProfile tailProfile hhead htail ih + exact .cons hhead.run ih) + hargs + +@[simp] theorem SourceArgsProfile.lengths + {sourceCtx : IxIR0.Ctx} {sourceEnv : List IxIR0.Value} + {expressions : List IxIR0.Expr} {sourceValues : List IxIR0.Value} + {profile : SourceProfile} + (hargs : SourceArgsProfile sourceCtx sourceEnv expressions sourceValues + profile) : + expressions.length = sourceValues.length := by + exact SourceArgsProfile.traverse + (Result := fun currentExpressions currentValues _ => + currentExpressions.length = currentValues.length) + (hnil := rfl) + (hcons := by + intro expr sourceValue currentExpressions currentValues fuel + headProfile tailProfile hhead htail ih + simp [ih]) + hargs + +/-- Split a costed argument vector at the compiler's `take`/`drop` +boundary, retaining exact profiles for both pieces. -/ +theorem SourceArgsProfile.splitAt + {sourceCtx : IxIR0.Ctx} {sourceEnv : List IxIR0.Value} + {expressions : List IxIR0.Expr} {sourceValues : List IxIR0.Value} + {profile : SourceProfile} + (hargs : SourceArgsProfile sourceCtx sourceEnv expressions sourceValues + profile) (count : Nat) : + ∃ prefixProfile tailProfile, + SourceArgsProfile sourceCtx sourceEnv (expressions.take count) + (sourceValues.take count) prefixProfile ∧ + SourceArgsProfile sourceCtx sourceEnv (expressions.drop count) + (sourceValues.drop count) tailProfile ∧ + prefixProfile + tailProfile = profile := by + exact (SourceArgsProfile.traverse + (Result := fun currentExpressions currentValues currentProfile => + ∀ currentCount, + ∃ prefixProfile tailProfile, + SourceArgsProfile sourceCtx sourceEnv + (currentExpressions.take currentCount) + (currentValues.take currentCount) prefixProfile ∧ + SourceArgsProfile sourceCtx sourceEnv + (currentExpressions.drop currentCount) + (currentValues.drop currentCount) tailProfile ∧ + prefixProfile + tailProfile = currentProfile) + (hnil := by + intro currentCount + simpa using + (show ∃ prefixProfile tailProfile, + SourceArgsProfile sourceCtx sourceEnv [] [] prefixProfile ∧ + SourceArgsProfile sourceCtx sourceEnv [] [] tailProfile ∧ + prefixProfile + tailProfile = 0 from + ⟨0, 0, .nil, .nil, + IxIR0.DynamicCost.Profile.zero_add 0⟩)) + (hcons := by + intro expr sourceValue currentExpressions currentValues fuel + headProfile tailProfile hhead htail ih currentCount + cases currentCount with + | zero => + exact ⟨0, headProfile + tailProfile, .nil, .cons hhead htail, + IxIR0.DynamicCost.Profile.zero_add _⟩ + | succ currentCount => + obtain ⟨prefixProfile, suffixProfile, hprefix, hsuffix, + hprofile⟩ := ih currentCount + refine ⟨headProfile + prefixProfile, suffixProfile, ?_, ?_, ?_⟩ + · exact .cons hhead hprefix + · exact hsuffix + · calc + (headProfile + prefixProfile) + suffixProfile = + headProfile + (prefixProfile + suffixProfile) := + IxIR0.DynamicCost.Profile.add_assoc _ _ _ + _ = headProfile + tailProfile := + congrArg (headProfile + ·) hprofile) + hargs) count + +/-- Cost-carrying n-ary source application. Each step includes the source +`.app` evaluation event in addition to the entered `DynamicCost.Apply` +profile, so a flattened spine retains the profile of the original nested +application syntax. -/ +inductive SourceAppliesProfile (sourceCtx : IxIR0.Ctx) : + IxIR0.Value → List IxIR0.Value → IxIR0.Value → SourceProfile → Prop where + | nil {sourceValue : IxIR0.Value} : + SourceAppliesProfile sourceCtx sourceValue [] sourceValue 0 + | cons {sourceFunction sourceArgument sourceMiddle sourceResult : + IxIR0.Value} + {sourceArguments : List IxIR0.Value} {fuel : Nat} + {stepProfile tailProfile : SourceProfile} : + IxIR0.DynamicCost.Apply sourceCtx fuel sourceFunction sourceArgument + sourceMiddle stepProfile → + SourceAppliesProfile sourceCtx sourceMiddle sourceArguments + sourceResult tailProfile → + SourceAppliesProfile sourceCtx sourceFunction + (sourceArgument :: sourceArguments) sourceResult + ((stepProfile + IxIR0.DynamicCost.tick .evalApp) + tailProfile) + +/-- Dependent state-threaded traversal of a profiled source application +spine. Clients receive the exact head application profile, the original +profiled tail derivation, and the recursively produced result while the +initial value, remaining arguments, final value, and additive profile stay +synchronized. -/ +theorem SourceAppliesProfile.traverse + {sourceCtx : IxIR0.Ctx} + {Result : IxIR0.Value → List IxIR0.Value → IxIR0.Value → + SourceProfile → Prop} + (hnil : ∀ sourceValue, Result sourceValue [] sourceValue 0) + (hcons : ∀ {sourceFunction sourceArgument sourceMiddle sourceResult : + IxIR0.Value} + {sourceArguments : List IxIR0.Value} {fuel : Nat} + {stepProfile tailProfile : SourceProfile}, + IxIR0.DynamicCost.Apply sourceCtx fuel sourceFunction sourceArgument + sourceMiddle stepProfile → + SourceAppliesProfile sourceCtx sourceMiddle sourceArguments + sourceResult tailProfile → + Result sourceMiddle sourceArguments sourceResult tailProfile → + Result sourceFunction (sourceArgument :: sourceArguments) sourceResult + ((stepProfile + IxIR0.DynamicCost.tick .evalApp) + tailProfile)) + {sourceFunction sourceResult : IxIR0.Value} + {sourceArguments : List IxIR0.Value} {profile : SourceProfile} + (happly : SourceAppliesProfile sourceCtx sourceFunction sourceArguments + sourceResult profile) : + Result sourceFunction sourceArguments sourceResult profile := by + induction happly with + | nil => exact hnil _ + | cons hstep htail ih => exact hcons hstep htail ih + +theorem SourceAppliesProfile.toSourceApplies + {sourceCtx : IxIR0.Ctx} {sourceFunction sourceResult : IxIR0.Value} + {sourceArguments : List IxIR0.Value} {profile : SourceProfile} + (happly : SourceAppliesProfile sourceCtx sourceFunction sourceArguments + sourceResult profile) : + SourceApplies sourceCtx sourceFunction sourceArguments sourceResult := by + exact SourceAppliesProfile.traverse + (Result := fun currentFunction currentArguments currentResult _ => + SourceApplies sourceCtx currentFunction currentArguments currentResult) + (hnil := fun _ => .nil) + (hcons := by + intro currentFunction argument currentMiddle currentResult + currentArguments fuel stepProfile tailProfile hstep htail ih + exact .cons hstep.run ih) + happly + +/-- Costed counterpart of stripping a saturated leading-lambda telescope. +The final body trace is funded by the initial expression trace together with +the profiled application chain; administrative apply events only add slack. -/ +theorem dynamicEval_stripLams_of_appliesProfile + (sourceCtx : IxIR0.Ctx) : + ∀ {sourceEnv : List IxIR0.Value} {expr : IxIR0.Expr} + {function result : IxIR0.Value} {args : List IxIR0.Value} + {evalFuel : Nat} {evalProfile applyProfile : SourceProfile}, + IxIR0.DynamicCost.Eval sourceCtx evalFuel sourceEnv expr function + evalProfile → + args.length = lamArity expr → + SourceAppliesProfile sourceCtx function args result applyProfile → + ∃ bodyFuel bodyProfile, + IxIR0.DynamicCost.Eval sourceCtx bodyFuel + (args.reverse ++ sourceEnv) (stripLams expr) result bodyProfile ∧ + OwnershipAllowanceLE + (sourceProfileOwnershipAllowance bodyProfile) + (sourceProfileOwnershipAllowance (evalProfile + applyProfile)) := by + intro sourceEnv expr + induction expr generalizing sourceEnv with + | var index => + intro function result args evalFuel evalProfile applyProfile heval + hlength happlies + have hnil : args = [] := + List.eq_nil_of_length_eq_zero (by + simpa [lamArity] using hlength) + subst args + cases happlies + refine ⟨evalFuel, evalProfile, by simpa [stripLams] using heval, ?_⟩ + rw [IxIR0.DynamicCost.Profile.add_zero] + exact OwnershipAllowanceLE.refl _ + + | ref address => + intro function result args evalFuel evalProfile applyProfile heval + hlength happlies + have hnil : args = [] := + List.eq_nil_of_length_eq_zero (by + simpa [lamArity] using hlength) + subst args + cases happlies + refine ⟨evalFuel, evalProfile, by simpa [stripLams] using heval, ?_⟩ + rw [IxIR0.DynamicCost.Profile.add_zero] + exact OwnershipAllowanceLE.refl _ + | app fn arg => + intro function result args evalFuel evalProfile applyProfile heval + hlength happlies + have hnil : args = [] := + List.eq_nil_of_length_eq_zero (by + simpa [lamArity] using hlength) + subst args + cases happlies + refine ⟨evalFuel, evalProfile, by simpa [stripLams] using heval, ?_⟩ + rw [IxIR0.DynamicCost.Profile.add_zero] + exact OwnershipAllowanceLE.refl _ + | lam uses body ih => + intro function result args evalFuel evalProfile applyProfile heval + hlength happlies + cases heval with + | lam => + cases args with + | nil => simp [lamArity] at hlength + | cons argument arguments => + have htailLength : arguments.length = lamArity body := by + simpa [lamArity] using hlength + cases happlies with + | @cons _ _ middle _ _ _ stepProfile tailProfile hstep htail => + cases hstep with + | clos hbody => + obtain ⟨finalFuel, finalProfile, hfinal, hfunded⟩ := + ih hbody htailLength htail + refine ⟨finalFuel, finalProfile, ?_, ?_⟩ + · simpa [stripLams, List.reverse_cons, + List.append_assoc] using hfinal + · apply hfunded.trans + simp [OwnershipAllowanceLE, + sourceProfileOwnershipAllowance, + IxIR0.DynamicCost.tick, + IxIR0.DynamicCost.retain] + omega + | letE uses value body => + intro function result args evalFuel evalProfile applyProfile heval + hlength happlies + have hnil : args = [] := + List.eq_nil_of_length_eq_zero (by + simpa [lamArity] using hlength) + subst args + cases happlies + refine ⟨evalFuel, evalProfile, by simpa [stripLams] using heval, ?_⟩ + rw [IxIR0.DynamicCost.Profile.add_zero] + exact OwnershipAllowanceLE.refl _ + | proj index value => + intro function result args evalFuel evalProfile applyProfile heval + hlength happlies + have hnil : args = [] := + List.eq_nil_of_length_eq_zero (by + simpa [lamArity] using hlength) + subst args + cases happlies + refine ⟨evalFuel, evalProfile, by simpa [stripLams] using heval, ?_⟩ + rw [IxIR0.DynamicCost.Profile.add_zero] + exact OwnershipAllowanceLE.refl _ + | lit literal => + intro function result args evalFuel evalProfile applyProfile heval + hlength happlies + have hnil : args = [] := + List.eq_nil_of_length_eq_zero (by + simpa [lamArity] using hlength) + subst args + cases happlies + refine ⟨evalFuel, evalProfile, by simpa [stripLams] using heval, ?_⟩ + rw [IxIR0.DynamicCost.Profile.add_zero] + exact OwnershipAllowanceLE.refl _ + | erased => + intro function result args evalFuel evalProfile applyProfile heval + hlength happlies + have hnil : args = [] := + List.eq_nil_of_length_eq_zero (by + simpa [lamArity] using hlength) + subst args + cases happlies + refine ⟨evalFuel, evalProfile, by simpa [stripLams] using heval, ?_⟩ + rw [IxIR0.DynamicCost.Profile.add_zero] + exact OwnershipAllowanceLE.refl _ + +/-- Completing a residual lifted-closure prefix reserves an arbitrary +subwidth of its closure environment for target PAP duplication. The final +stripped body profile is funded by the remainder of the current, nonempty +source application chain. -/ +theorem LambdaPrefix.saturateProfile + {sourceCtx : IxIR0.Ctx} {sourceEnv : List IxIR0.Value} + {expr : IxIR0.Expr} {supplied remaining : List IxIR0.Value} + {function result : IxIR0.Value} {profile : SourceProfile} + {reserve : Nat} + (hprefix : LambdaPrefix sourceEnv expr supplied function) + (hreserve : reserve ≤ sourceEnv.length + supplied.length) + (hlength : (supplied ++ remaining).length = lamArity expr) + (happlies : SourceAppliesProfile sourceCtx function remaining result + profile) + (hnonempty : remaining ≠ []) : + ∃ bodyFuel bodyProfile, + IxIR0.DynamicCost.Eval sourceCtx bodyFuel + ((supplied ++ remaining).reverse ++ sourceEnv) + (stripLams expr) result bodyProfile ∧ + OwnershipAllowanceLE + (sourceProfileOwnershipAllowance + (IxIR0.DynamicCost.retain reserve + bodyProfile)) + (sourceProfileOwnershipAllowance profile) := by + exact (LambdaPrefix.traverse + (Result := fun currentEnv currentExpr currentSupplied currentFunction => + reserve ≤ currentEnv.length + currentSupplied.length → + (currentSupplied ++ remaining).length = lamArity currentExpr → + SourceAppliesProfile sourceCtx currentFunction remaining result + profile → + remaining ≠ [] → + ∃ bodyFuel bodyProfile, + IxIR0.DynamicCost.Eval sourceCtx bodyFuel + ((currentSupplied ++ remaining).reverse ++ currentEnv) + (stripLams currentExpr) result bodyProfile ∧ + OwnershipAllowanceLE + (sourceProfileOwnershipAllowance + (IxIR0.DynamicCost.retain reserve + bodyProfile)) + (sourceProfileOwnershipAllowance profile)) + (hnil := by + intro currentEnv uses body hreserve hlength happlies hnonempty + cases remaining with + | nil => exact (hnonempty rfl).elim + | cons argument arguments => + have htailLength : arguments.length = lamArity body := by + simpa [lamArity] using hlength + cases happlies with + | @cons _ _ middle _ _ _ stepProfile tailProfile hstep htail => + cases hstep with + | clos hbody => + obtain ⟨bodyFuel, bodyProfile, hbodyProfile, hfunded⟩ := + dynamicEval_stripLams_of_appliesProfile sourceCtx hbody + htailLength htail + refine ⟨bodyFuel, bodyProfile, ?_, ?_⟩ + · simpa [stripLams, List.reverse_cons, + List.append_assoc] using hbodyProfile + · simp only [List.length_nil, Nat.add_zero] at hreserve + simp [OwnershipAllowanceLE, + sourceProfileOwnershipAllowance, + IxIR0.DynamicCost.tick, + IxIR0.DynamicCost.retain] at hfunded ⊢ + omega) + (hcons := by + intro currentEnv uses body argument currentSupplied currentFunction + hinner ih hreserve hlength happlies hnonempty + have hreserve' : reserve ≤ + (argument :: currentEnv).length + currentSupplied.length := by + simp only [List.length_cons] + simp only [List.length_cons] at hreserve + omega + have hlength' : (currentSupplied ++ remaining).length = + lamArity body := by + simpa [lamArity] using hlength + obtain ⟨bodyFuel, bodyProfile, hbodyProfile, hfunded⟩ := + ih hreserve' hlength' happlies hnonempty + refine ⟨bodyFuel, bodyProfile, ?_, hfunded⟩ + simpa [stripLams, List.reverse_cons, List.append_assoc] using + hbodyProfile) + (h := hprefix)) hreserve hlength happlies hnonempty + +/-- Any nonempty application of a residual closure funds duplication of a +chosen subwidth of its current environment and the successor-PAP allocation. +This is the under-application half of the no-double-spend split. -/ +theorem LambdaPrefix.underApplyProfileFunding + {sourceCtx : IxIR0.Ctx} {sourceEnv : List IxIR0.Value} + {expr : IxIR0.Expr} {supplied remaining : List IxIR0.Value} + {function result : IxIR0.Value} {profile : SourceProfile} + {reserve : Nat} + (hprefix : LambdaPrefix sourceEnv expr supplied function) + (hreserve : reserve ≤ sourceEnv.length + supplied.length) + (happlies : SourceAppliesProfile sourceCtx function remaining result + profile) + (hnonempty : remaining ≠ []) : + OwnershipAllowanceLE + (sourceProfileOwnershipAllowance + (IxIR0.DynamicCost.retain reserve + + IxIR0.DynamicCost.tick .evalApp)) + (sourceProfileOwnershipAllowance profile) := by + exact (LambdaPrefix.traverse + (Result := fun currentEnv currentExpr currentSupplied currentFunction => + reserve ≤ currentEnv.length + currentSupplied.length → + SourceAppliesProfile sourceCtx currentFunction remaining result + profile → + remaining ≠ [] → + OwnershipAllowanceLE + (sourceProfileOwnershipAllowance + (IxIR0.DynamicCost.retain reserve + + IxIR0.DynamicCost.tick .evalApp)) + (sourceProfileOwnershipAllowance profile)) + (hnil := by + intro currentEnv uses body hreserve happlies hnonempty + cases remaining with + | nil => exact (hnonempty rfl).elim + | cons argument arguments => + cases happlies with + | @cons _ _ middle _ _ _ stepProfile tailProfile hstep htail => + cases hstep with + | clos hbody => + simp only [List.length_nil, Nat.add_zero] at hreserve + simp [OwnershipAllowanceLE, + sourceProfileOwnershipAllowance, + IxIR0.DynamicCost.tick, + IxIR0.DynamicCost.retain] + omega) + (hcons := by + intro currentEnv uses body argument currentSupplied currentFunction + hinner ih hreserve happlies hnonempty + have hreserve' : reserve ≤ + (argument :: currentEnv).length + currentSupplied.length := by + simp only [List.length_cons] + simp only [List.length_cons] at hreserve + omega + exact ih hreserve' happlies hnonempty) + (h := hprefix)) hreserve happlies hnonempty + +/-- A nonempty application of a source PAP exposes its stored-prefix retain +and one source `.app` evaluation, enough to fund the target successor PAP. -/ +theorem SourceAppliesProfile.papUnderFunding + {sourceCtx : IxIR0.Ctx} {head : IxIR0.Head} + {captured remaining : List IxIR0.Value} + {result : IxIR0.Value} {profile : SourceProfile} {reserve : Nat} + (hreserve : reserve ≤ captured.length) + (happlies : SourceAppliesProfile sourceCtx (.pap head captured) + remaining result profile) + (hnonempty : remaining ≠ []) : + OwnershipAllowanceLE + (sourceProfileOwnershipAllowance + (IxIR0.DynamicCost.retain reserve + + IxIR0.DynamicCost.tick .evalApp)) + (sourceProfileOwnershipAllowance profile) := by + cases remaining with + | nil => exact (hnonempty rfl).elim + | cons argument arguments => + cases happlies with + | @cons _ _ middle _ _ _ stepProfile tailProfile hstep htail => + cases hstep with + | pap hsaturate => + simp [OwnershipAllowanceLE, + sourceProfileOwnershipAllowance, + IxIR0.DynamicCost.tick, + IxIR0.DynamicCost.retain] + omega + +private theorem sourceRef_lambdaPrefix_nil + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {address : Ixon.Address} {result : Ixon.Owned} + {body : IxIR0.Expr} {sourceFunction : IxIR0.Value} + (henv : sourceCtx.env = src) + (hsrc : src address = some (.defn result body)) + (hpositive : 0 < lamArity body) + (href : SourceRefValue sourceCtx address sourceFunction) : + LambdaPrefix [] body [] sourceFunction := by + cases body with + | lam uses body => + obtain ⟨fuel, href⟩ := href + cases fuel with + | zero => simp [IxIR0.eval] at href + | succ fuel => + cases fuel with + | zero => simp [IxIR0.eval, henv, hsrc] at href + | succ fuel => + have hvalue : sourceFunction = .clos uses [] body := by + simpa [IxIR0.eval, henv, hsrc] using href.symm + subst sourceFunction + exact .nil + | var => simp [lamArity] at hpositive + | ref => simp [lamArity] at hpositive + | app => simp [lamArity] at hpositive + | letE => simp [lamArity] at hpositive + | proj => simp [lamArity] at hpositive + | lit => simp [lamArity] at hpositive + | erased => simp [lamArity] at hpositive + +private theorem sourceRef_ctorPap + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {address : Ixon.Address} {tag arity : Nat} + {sourceFunction : IxIR0.Value} + (henv : sourceCtx.env = src) + (hsrc : src address = some (.ctor tag arity)) + (hpositive : 0 < arity) + (href : SourceRefValue sourceCtx address sourceFunction) : + sourceFunction = .pap (.ctor address tag arity) [] := by + obtain ⟨fuel, href⟩ := href + cases fuel with + | zero => simp [IxIR0.eval] at href + | succ fuel => + cases fuel with + | zero => simp [IxIR0.eval, henv, hsrc, IxIR0.saturate] at href + | succ fuel => + have hne : 0 ≠ arity := Nat.ne_of_lt hpositive + simpa [IxIR0.eval, henv, hsrc, IxIR0.saturate, + IxIR0.Head.arity, hne] using href.symm + +private theorem sourceRef_externPap + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {address : Ixon.Address} {arity : Nat} + {sourceFunction : IxIR0.Value} + (henv : sourceCtx.env = src) + (hsrc : src address = some (.extern arity)) + (hpositive : 0 < arity) + (href : SourceRefValue sourceCtx address sourceFunction) : + sourceFunction = .pap (.ext address arity) [] := by + obtain ⟨fuel, href⟩ := href + cases fuel with + | zero => simp [IxIR0.eval] at href + | succ fuel => + cases fuel with + | zero => simp [IxIR0.eval, henv, hsrc, IxIR0.saturate] at href + | succ fuel => + have hne : 0 ≠ arity := Nat.ne_of_lt hpositive + simpa [IxIR0.eval, henv, hsrc, IxIR0.saturate, + IxIR0.Head.arity, hne] using href.symm + +/-- Every compiler-related residual function exposes enough of any current, +nonempty source application profile to duplicate its stored target prefix +and allocate an under-applied successor PAP. This is independent of target +fuel and is shared by all five admitted PAP origins. -/ +theorem CompilerFunctionRel.underApplyProfileFunding + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {state : LowSt} + {function result : IxIR0.Value} {address : Ixon.Address} + {arity : Nat} {captures arguments : List IxIR0.Value} + {profile : SourceProfile} + (henv : sourceCtx.env = src) + (hrel : CompilerFunctionRel sourceCtx src state function address arity + captures) + (happlies : SourceAppliesProfile sourceCtx function arguments result + profile) + (hnonempty : arguments ≠ []) : + OwnershipAllowanceLE + (sourceProfileOwnershipAllowance + (IxIR0.DynamicCost.retain captures.length + + IxIR0.DynamicCost.tick .evalApp)) + (sourceProfileOwnershipAllowance profile) := by + cases hrel with + | @source value baseFunction targetAddress targetArity storedSources + source hsrc heligible harity href hprefix hunder => + cases source with + | defn sourceResult body => + have hpositive : 0 < lamArity body := by + simp only [sourceDeclArity] at harity + omega + have hstoredUnder : captures.length < lamArity body := by + simp only [sourceDeclArity] at harity + omega + have hinitial := sourceRef_lambdaPrefix_nil henv hsrc hpositive href + have hresidual : LambdaPrefix [] body captures function := by + simpa using hinitial.append_of_applies hprefix (by + simpa using hstoredUnder) + exact LambdaPrefix.underApplyProfileFunding hresidual (by simp) + happlies hnonempty + | ctor tag ctorArity => exact heligible.elim + | recursor numArgs natLit rules => + have hlookup : sourceCtx.env address = + some (.recursor numArgs natLit rules) := by + rw [henv] + exact hsrc + have hbase := href.recursorValue hlookup + subst baseFunction + have hstoredUnder : captures.length < numArgs + 1 := by + simp only [sourceDeclArity] at harity + omega + have hcanonical : SourceApplies sourceCtx + (.pap (.rec_ address (numArgs + 1)) []) captures + (.pap (.rec_ address (numArgs + 1)) captures) := + sourcePap_underfills (by + simpa [IxIR0.Head.arity] using hstoredUnder) + have hvalue : function = + .pap (.rec_ address (numArgs + 1)) captures := + hprefix.deterministic hcanonical + subst function + exact happlies.papUnderFunding (Nat.le_refl _) hnonempty + | extern externArity => + have hpositive : 0 < externArity := by + simp only [sourceDeclArity] at harity + omega + have hbase := sourceRef_externPap henv hsrc hpositive href + subst baseFunction + have hstoredUnder : captures.length < externArity := by + simp only [sourceDeclArity] at harity + omega + have hcanonical : SourceApplies sourceCtx + (.pap (.ext address externArity) []) captures + (.pap (.ext address externArity) captures) := + sourcePap_underfills (by + simpa [IxIR0.Head.arity] using hstoredUnder) + have hvalue : function = + .pap (.ext address externArity) captures := + hprefix.deterministic hcanonical + subst function + exact happlies.papUnderFunding (Nat.le_refl _) hnonempty + | @wrapper value baseFunction storedSources memo hmember hsrc href + hprefix hunder => + have hpositive : 0 < memo.arity := by omega + have hbase := sourceRef_ctorPap henv hsrc hpositive href + subst baseFunction + have hcanonical : SourceApplies sourceCtx + (.pap (.ctor memo.source memo.tag memo.arity) []) captures + (.pap (.ctor memo.source memo.tag memo.arity) captures) := + sourcePap_underfills (by + simpa [IxIR0.Head.arity] using hunder) + have hvalue : function = + .pap (.ctor memo.source memo.tag memo.arity) captures := + hprefix.deterministic hcanonical + subst function + exact happlies.papUnderFunding (Nat.le_refl _) hnonempty + | lifted hlifted => + obtain ⟨sourceEnv, expr, selected, supplied, hlift, hselected, + hcaptures, harity, hprefix⟩ := hlifted + subst captures + have hselectedLe : selected.length ≤ sourceEnv.length := by + rw [hselected.length] + simpa [liftCaptureIndices] using List.length_filter_le + (fun index => countUses index expr > 0) + (List.range sourceEnv.length) + have hreserve : (selected ++ supplied).length ≤ + sourceEnv.length + supplied.length := by + simp only [List.length_append] + omega + exact LambdaPrefix.underApplyProfileFunding hprefix hreserve happlies + hnonempty + +/-- Split an exact profiled source application chain at an arbitrary +argument boundary. -/ +theorem SourceAppliesProfile.splitAt + {sourceCtx : IxIR0.Ctx} {sourceFunction sourceResult : IxIR0.Value} + {sourceArguments : List IxIR0.Value} {profile : SourceProfile} + (happly : SourceAppliesProfile sourceCtx sourceFunction sourceArguments + sourceResult profile) (count : Nat) : + ∃ sourceMiddle prefixProfile tailProfile, + SourceAppliesProfile sourceCtx sourceFunction + (sourceArguments.take count) sourceMiddle prefixProfile ∧ + SourceAppliesProfile sourceCtx sourceMiddle + (sourceArguments.drop count) sourceResult tailProfile ∧ + prefixProfile + tailProfile = profile := by + exact (SourceAppliesProfile.traverse + (Result := fun currentFunction currentArguments currentResult + currentProfile => + ∀ currentCount, + ∃ sourceMiddle prefixProfile tailProfile, + SourceAppliesProfile sourceCtx currentFunction + (currentArguments.take currentCount) sourceMiddle + prefixProfile ∧ + SourceAppliesProfile sourceCtx sourceMiddle + (currentArguments.drop currentCount) currentResult + tailProfile ∧ + prefixProfile + tailProfile = currentProfile) + (hnil := by + intro sourceValue currentCount + simpa using + (show ∃ sourceMiddle prefixProfile tailProfile, + SourceAppliesProfile sourceCtx sourceValue [] sourceMiddle + prefixProfile ∧ + SourceAppliesProfile sourceCtx sourceMiddle [] sourceValue + tailProfile ∧ + prefixProfile + tailProfile = 0 from + ⟨sourceValue, 0, 0, .nil, .nil, + IxIR0.DynamicCost.Profile.zero_add 0⟩)) + (hcons := by + intro currentFunction argument currentMiddle currentResult + currentArguments fuel stepProfile tailProfile hstep htail ih + currentCount + cases currentCount with + | zero => + exact ⟨currentFunction, 0, + (stepProfile + IxIR0.DynamicCost.tick .evalApp) + tailProfile, + .nil, .cons hstep htail, + IxIR0.DynamicCost.Profile.zero_add _⟩ + | succ currentCount => + obtain ⟨sourceMiddle, prefixProfile, suffixProfile, hprefix, + hsuffix, hprofile⟩ := ih currentCount + refine ⟨sourceMiddle, + (stepProfile + IxIR0.DynamicCost.tick .evalApp) + prefixProfile, + suffixProfile, ?_, ?_, ?_⟩ + · exact .cons hstep hprefix + · exact hsuffix + · calc + ((stepProfile + IxIR0.DynamicCost.tick .evalApp) + + prefixProfile) + suffixProfile = + (stepProfile + IxIR0.DynamicCost.tick .evalApp) + + (prefixProfile + suffixProfile) := + IxIR0.DynamicCost.Profile.add_assoc _ _ _ + _ = (stepProfile + IxIR0.DynamicCost.tick .evalApp) + + tailProfile := + congrArg + ((stepProfile + IxIR0.DynamicCost.tick .evalApp) + ·) + hprofile) + happly) count + +/-- The exact source reference fragment available at a static function-entry +boundary. Keeping the profile, rather than only `SourceRefValue`, is +essential for nullary definitions: their body executes while evaluating the +reference, before there is any source application step. -/ +def SourceRefProfile (sourceCtx : IxIR0.Ctx) (address : Ixon.Address) + (sourceFunction : IxIR0.Value) (profile : SourceProfile) : Prop := + ∃ fuel sourceEnv, + IxIR0.DynamicCost.Eval sourceCtx fuel sourceEnv (.ref address) + sourceFunction profile + +/-- The source fragment that funds one entered target function body. +Nonempty calls use the exact n-ary application profile. A nullary call uses +the exact closed-reference profile that already contains the source body +evaluation. -/ +inductive SourceFnEntryProfile (sourceCtx : IxIR0.Ctx) + (address : Ixon.Address) (sourceFunction : IxIR0.Value) : + List IxIR0.Value → IxIR0.Value → SourceProfile → Prop where + | applied {sourceArgument : IxIR0.Value} + {sourceArguments : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} : + SourceAppliesProfile sourceCtx sourceFunction + (sourceArgument :: sourceArguments) sourceResult profile → + SourceFnEntryProfile sourceCtx address sourceFunction + (sourceArgument :: sourceArguments) sourceResult profile + | nullary {profile : SourceProfile} : + SourceRefProfile sourceCtx address sourceFunction profile → + SourceFnEntryProfile sourceCtx address sourceFunction [] + sourceFunction profile + +theorem SourceFnEntryProfile.toSourceApplies + {sourceCtx : IxIR0.Ctx} {address : Ixon.Address} + {sourceFunction sourceResult : IxIR0.Value} + {sourceArgs : List IxIR0.Value} {profile : SourceProfile} + (hentry : SourceFnEntryProfile sourceCtx address sourceFunction + sourceArgs sourceResult profile) : + SourceApplies sourceCtx sourceFunction sourceArgs sourceResult := by + cases hentry with + | applied happly => exact happly.toSourceApplies + | nullary _ => exact .nil + +theorem SourceAppliesProfile.toFnEntryProfile + {sourceCtx : IxIR0.Ctx} {address : Ixon.Address} + {sourceFunction sourceResult : IxIR0.Value} + {sourceArgs : List IxIR0.Value} {profile : SourceProfile} + (happly : SourceAppliesProfile sourceCtx sourceFunction sourceArgs + sourceResult profile) (hne : sourceArgs ≠ []) : + SourceFnEntryProfile sourceCtx address sourceFunction sourceArgs + sourceResult profile := by + cases sourceArgs with + | nil => exact (hne rfl).elim + | cons sourceArgument sourceArguments => + exact .applied happly + +/-- Exact target-fuel cost preservation for a compiled function body. The +source entry identifies both the entered source computation and the complete +profile available to fund the target body. -/ +def FnProfilePreservesAt (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (ctx : Ctx) + (address : Ixon.Address) + (d : FnDef) (argWorlds : List Ixon.Owned) + (sourceFunction : IxIR0.Value) (fuel : Nat) : Prop := + ∀ {before after : Store} {args : List RVal} {value : RVal} + {sourceArgs : List IxIR0.Value} {sourceResult : IxIR0.Value} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} {profile : SourceProfile}, + AllocationOrderInvariant before → + args.length = argWorlds.length → + sourceArgs.length = argWorlds.length → + Sim.ValuesGraph funRel before sourceArgs args → + SourceFnEntryProfile sourceCtx address sourceFunction sourceArgs + sourceResult profile → + Sim.RootsGraph funRel before sourceRest rest → + Sim.RootOwnership before (Sim.rootsForWorlds argWorlds args ++ rest) → + runCode ctx fuel d before args.reverse d.body = .ok (after, value) → + ProfileFundedCodeRun ctx fuel d before args.reverse d.body after value + profile + +/-- Whole-fuel exact-profile contract for one compiled function. -/ +structure FnProfileContract (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (ctx : Ctx) + (address : Ixon.Address) (d : FnDef) (argWorlds : List Ixon.Owned) + (sourceFunction : IxIR0.Value) : Prop where + arity_eq : argWorlds.length = d.arity + preserves : ∀ {fuel : Nat}, + FnProfilePreservesAt funRel sourceCtx ctx address d argWorlds + sourceFunction fuel + +/-- Function profile preservation below one target evaluator-fuel bound. -/ +structure FnProfileContractBelow (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (ctx : Ctx) + (address : Ixon.Address) (d : FnDef) (argWorlds : List Ixon.Owned) + (sourceFunction : IxIR0.Value) (limit : Nat) : Prop where + arity_eq : argWorlds.length = d.arity + preserves : ∀ {fuel : Nat}, fuel < limit → + FnProfilePreservesAt funRel sourceCtx ctx address d argWorlds + sourceFunction fuel + +theorem FnProfileContract.below + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + {address : Ixon.Address} {d : FnDef} + {argWorlds : List Ixon.Owned} {sourceFunction : IxIR0.Value} + (hcontract : FnProfileContract funRel sourceCtx ctx address d argWorlds + sourceFunction) + (limit : Nat) : + FnProfileContractBelow funRel sourceCtx ctx address d argWorlds + sourceFunction limit := + ⟨hcontract.arity_eq, fun _ => hcontract.preserves⟩ + +theorem FnProfileContractBelow.mono + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + {address : Ixon.Address} {d : FnDef} + {argWorlds : List Ixon.Owned} {sourceFunction : IxIR0.Value} + {smaller larger : Nat} + (hcontract : FnProfileContractBelow funRel sourceCtx ctx address d + argWorlds sourceFunction larger) + (hbound : smaller ≤ larger) : + FnProfileContractBelow funRel sourceCtx ctx address d argWorlds + sourceFunction smaller := + ⟨hcontract.arity_eq, + fun hfuel => hcontract.preserves (Nat.lt_of_lt_of_le hfuel hbound)⟩ + +/-- Exact target-fuel cost preservation for higher-order application. The +source relation carries the complete profile of the n-ary source apply +chain; the target run may recurse through PAP saturation and over-application +at the independently chosen target evaluator fuel. -/ +def ApplyProfilePreservesAt (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (ctx : Ctx) (fuel : Nat) : Prop := + ∀ {before after : Store} {function : RVal} {args : List RVal} + {value : RVal} {sourceFunction sourceResult : IxIR0.Value} + {sourceArgs : List IxIR0.Value} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} {profile : SourceProfile}, + AllocationOrderInvariant before → + Sim.ValueGraph funRel before sourceFunction function → + Sim.ValuesGraph funRel before sourceArgs args → + SourceAppliesProfile sourceCtx sourceFunction sourceArgs sourceResult + profile → + Sim.RootsGraph funRel before sourceRest rest → + Sim.RootOwnership before + (⟨.shared, function⟩ :: Sim.rootsFor .shared args ++ rest) → + sourceArgs ≠ [] → + applyGo ctx fuel before function args = .ok (after, value) → + ProfileFundedApplyRun ctx fuel before function args after value profile + +/-- Whole-context cost contract for higher-order application. -/ +structure ApplyProfileContract (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (ctx : Ctx) : Prop where + preserves : ∀ {fuel : Nat}, + ApplyProfilePreservesAt funRel sourceCtx ctx fuel + +/-- Higher-order cost preservation below one target evaluator-fuel bound. -/ +structure ApplyProfileContractBelow (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (ctx : Ctx) (limit : Nat) : Prop where + preserves : ∀ {fuel : Nat}, fuel < limit → + ApplyProfilePreservesAt funRel sourceCtx ctx fuel + +theorem ApplyProfileContract.below + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + (hcontract : ApplyProfileContract funRel sourceCtx ctx) (limit : Nat) : + ApplyProfileContractBelow funRel sourceCtx ctx limit := + ⟨fun _ => hcontract.preserves⟩ + +theorem ApplyProfileContractBelow.mono + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + {smaller larger : Nat} + (hcontract : ApplyProfileContractBelow funRel sourceCtx ctx larger) + (hbound : smaller ≤ larger) : + ApplyProfileContractBelow funRel sourceCtx ctx smaller := + ⟨fun hfuel => hcontract.preserves + (Nat.lt_of_lt_of_le hfuel hbound)⟩ + +/-- Exact target-fuel profile preservation for invoking a function selected +through `funRel` after its stored PAP prefix has been duplicated. The +source profile starts at the residual source function, so the conclusion +returns a core invocation profile and reserves the stored prefix exactly +once. -/ +def ResidualFnProfilePreservesAt (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (ctx : Ctx) (fuel : Nat) : Prop := + ∀ {before after : Store} {sourceFunction sourceResult : IxIR0.Value} + {address : Ixon.Address} {arity : Nat} + {sourceCaptures sourceArgs : List IxIR0.Value} + {captures args : List RVal} {value : RVal} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} {profile : SourceProfile}, + AllocationOrderInvariant before → + funRel sourceFunction address arity sourceCaptures → + Sim.ValuesGraph funRel before sourceCaptures captures → + Sim.ValuesGraph funRel before sourceArgs args → + SourceAppliesProfile sourceCtx sourceFunction sourceArgs sourceResult + profile → + sourceArgs ≠ [] → + (sourceCaptures ++ sourceArgs).length = arity → + Sim.RootsGraph funRel before sourceRest rest → + Sim.RootOwnership before + (Sim.rootsFor .shared (captures ++ args) ++ rest) → + invoke ctx fuel address (captures ++ args) before = .ok (after, value) → + RetainedProfileFundedInvokeRun ctx fuel address (captures ++ args) + before after value sourceCaptures.length profile + +structure ResidualFnProfileContract (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (ctx : Ctx) : Prop where + preserves : ∀ {fuel : Nat}, + ResidualFnProfilePreservesAt funRel sourceCtx ctx fuel + +structure ResidualFnProfileContractBelow (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (ctx : Ctx) (limit : Nat) : Prop where + preserves : ∀ {fuel : Nat}, fuel < limit → + ResidualFnProfilePreservesAt funRel sourceCtx ctx fuel + +theorem ResidualFnProfileContract.below + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + (hcontract : ResidualFnProfileContract funRel sourceCtx ctx) + (limit : Nat) : + ResidualFnProfileContractBelow funRel sourceCtx ctx limit := + ⟨fun _ => hcontract.preserves⟩ + +theorem ResidualFnProfileContractBelow.mono + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + {smaller larger : Nat} + (hcontract : ResidualFnProfileContractBelow funRel sourceCtx ctx larger) + (hbound : smaller ≤ larger) : + ResidualFnProfileContractBelow funRel sourceCtx ctx smaller := + ⟨fun hfuel => hcontract.preserves + (Nat.lt_of_lt_of_le hfuel hbound)⟩ + +/-- Pointwise exact-profile preservation for every source-backed target +function at one evaluator-fuel index. Source lookup and reference evaluation +pin the body contract to the declaration from which it was compiled. -/ +def SourceFnProfilePreservesAt (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) + (src : IxIR0.Env) (ctx : Ctx) (fuel : Nat) : Prop := + ∀ {address : Ixon.Address} {source : IxIR0.Decl} + {worlds : List Ixon.Owned} {result : Ixon.Owned} {d : FnDef} + {sourceFunction : IxIR0.Value}, + src address = some source → + sourceCallableSignature source = some (worlds, result) → + ctx.decls address = some (.fn d) → + SourceRefValue sourceCtx address sourceFunction → + FnProfilePreservesAt funRel sourceCtx ctx address d worlds + sourceFunction fuel + +/-- Declaration profile contracts below one target evaluator-fuel bound. -/ +structure SourceDeclProfileContractsBelow (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) + (src : IxIR0.Env) (ctx : Ctx) (limit : Nat) : Prop where + fn_preserves : ∀ {fuel : Nat}, fuel < limit → + SourceFnProfilePreservesAt funRel sourceCtx src ctx fuel + +/-- Public exact-profile contracts for every source-backed target function. -/ +structure SourceDeclProfileContracts (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) + (src : IxIR0.Env) (ctx : Ctx) : Prop where + fn_preserves : ∀ {fuel : Nat}, + SourceFnProfilePreservesAt funRel sourceCtx src ctx fuel + +/-- Select one unbounded function profile contract from the declaration +environment once the static layout supplies its arity equality. -/ +theorem SourceDeclProfileContracts.fnContract + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} + {src : IxIR0.Env} {ctx : Ctx} + (hcontracts : SourceDeclProfileContracts funRel sourceCtx src ctx) + {address : Ixon.Address} {source : IxIR0.Decl} + {worlds : List Ixon.Owned} {result : Ixon.Owned} {d : FnDef} + {sourceFunction : IxIR0.Value} + (hsrc : src address = some source) + (hsignature : sourceCallableSignature source = some (worlds, result)) + (hdecl : ctx.decls address = some (.fn d)) + (href : SourceRefValue sourceCtx address sourceFunction) + (harity : worlds.length = d.arity) : + FnProfileContract funRel sourceCtx ctx address d worlds + sourceFunction := by + refine ⟨harity, ?_⟩ + intro fuel + exact hcontracts.fn_preserves hsrc hsignature hdecl href + +/-- Bounded declaration-environment lookup for a function profile +contract. -/ +theorem SourceDeclProfileContractsBelow.fnContract + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} + {src : IxIR0.Env} {ctx : Ctx} {limit : Nat} + (hcontracts : SourceDeclProfileContractsBelow funRel sourceCtx src ctx + limit) + {address : Ixon.Address} {source : IxIR0.Decl} + {worlds : List Ixon.Owned} {result : Ixon.Owned} {d : FnDef} + {sourceFunction : IxIR0.Value} + (hsrc : src address = some source) + (hsignature : sourceCallableSignature source = some (worlds, result)) + (hdecl : ctx.decls address = some (.fn d)) + (href : SourceRefValue sourceCtx address sourceFunction) + (harity : worlds.length = d.arity) : + FnProfileContractBelow funRel sourceCtx ctx address d worlds + sourceFunction limit := by + refine ⟨harity, ?_⟩ + intro fuel hfuel + exact hcontracts.fn_preserves hfuel hsrc hsignature hdecl href + +theorem SourceDeclProfileContracts.below + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} + {src : IxIR0.Env} {ctx : Ctx} + (hcontracts : SourceDeclProfileContracts funRel sourceCtx src ctx) + (limit : Nat) : + SourceDeclProfileContractsBelow funRel sourceCtx src ctx limit := + ⟨fun _ => hcontracts.fn_preserves⟩ + +theorem SourceDeclProfileContractsBelow.mono + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} + {src : IxIR0.Env} {ctx : Ctx} + {smaller larger : Nat} + (hcontracts : SourceDeclProfileContractsBelow funRel sourceCtx src ctx + larger) + (hbound : smaller ≤ larger) : + SourceDeclProfileContractsBelow funRel sourceCtx src ctx smaller := + ⟨fun hfuel => hcontracts.fn_preserves + (Nat.lt_of_lt_of_le hfuel hbound)⟩ + +/-- Exact-profile contracts needed by source-aware lowering: direct +declaration calls and higher-order application are sealed together because +PAP saturation moves recursively between the two evaluator judgments. -/ +structure CompilerProfileContracts (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (src : IxIR0.Env) (ctx : Ctx) : Prop where + decls : SourceDeclProfileContracts funRel sourceCtx src ctx + residual : ResidualFnProfileContract funRel sourceCtx ctx + apply : ApplyProfileContract funRel sourceCtx ctx + +structure CompilerProfileContractsBelow (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (src : IxIR0.Env) (ctx : Ctx) + (limit : Nat) : Prop where + decls : SourceDeclProfileContractsBelow funRel sourceCtx src ctx limit + residual : ResidualFnProfileContractBelow funRel sourceCtx ctx limit + apply : ApplyProfileContractBelow funRel sourceCtx ctx limit + +theorem CompilerProfileContracts.below + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} + {src : IxIR0.Env} {ctx : Ctx} + (hcontracts : CompilerProfileContracts funRel sourceCtx src ctx) + (limit : Nat) : + CompilerProfileContractsBelow funRel sourceCtx src ctx limit := + ⟨hcontracts.decls.below limit, hcontracts.residual.below limit, + hcontracts.apply.below limit⟩ + +theorem CompilerProfileContractsBelow.mono + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} + {src : IxIR0.Env} {ctx : Ctx} {smaller larger : Nat} + (hcontracts : CompilerProfileContractsBelow funRel sourceCtx src ctx + larger) + (hbound : smaller ≤ larger) : + CompilerProfileContractsBelow funRel sourceCtx src ctx smaller := + ⟨hcontracts.decls.mono hbound, hcontracts.residual.mono hbound, + hcontracts.apply.mono hbound⟩ + +/-- Seal declaration-body and higher-order exact-profile contracts by strong +induction on the target evaluator fuel. -/ +theorem compilerProfileContracts_of_below_step + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} + {src : IxIR0.Env} {ctx : Ctx} + (hstep : ∀ limit, + CompilerProfileContractsBelow funRel sourceCtx src ctx limit → + SourceFnProfilePreservesAt funRel sourceCtx src ctx limit ∧ + ResidualFnProfilePreservesAt funRel sourceCtx ctx limit ∧ + ApplyProfilePreservesAt funRel sourceCtx ctx limit) : + CompilerProfileContracts funRel sourceCtx src ctx := by + have hall : ∀ index, + SourceFnProfilePreservesAt funRel sourceCtx src ctx index ∧ + ResidualFnProfilePreservesAt funRel sourceCtx ctx index ∧ + ApplyProfilePreservesAt funRel sourceCtx ctx index := by + intro index + induction index using Nat.strongRecOn with + | ind index ih => + apply hstep index + refine ⟨⟨?_⟩, ⟨?_⟩, ⟨?_⟩⟩ + · intro prior hprior + exact (ih prior hprior).1 + · intro prior hprior + exact (ih prior hprior).2.1 + · intro prior hprior + exact (ih prior hprior).2.2 + refine ⟨⟨?_⟩, ⟨?_⟩, ⟨?_⟩⟩ + · intro fuel + exact (hall fuel).1 + · intro fuel + exact (hall fuel).2.1 + · intro fuel + exact (hall fuel).2.2 + +/-- A direct-call operation simultaneously establishes its semantic graph +midpoint and consumes the exact source application profile assigned to the +callee body. -/ +theorem call_graph_profile_op + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur d : FnDef} + {output : VEnv} {sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Ixon.Owned} {avs : List AVal} {f : Ixon.Address} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} {slots : List (Nat × RVal)} + {profile : SourceProfile} + (hdecl : ctx.decls f = some (.fn d)) + (hownership : Sim.FnOwnershipContract ctx d worlds) + (hvalue : FnValueContract funRel sourceCtx ctx d worlds sourceFunction) + (hcost : FnProfileContract funRel sourceCtx ctx f d worlds sourceFunction) + (hsource : SourceFnEntryProfile sourceCtx f sourceFunction sourceArgs + sourceResult profile) : + ProfileFundedEmitStateRunSound ctx cur + (emitOp (.call f (avs.map (·.toAtom output)).toArray)) + (GraphOwnsArgsResultProtected funRel recSelfRel output sourceOutput + sourceArgs worlds avs sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult d.result (.slotA output.depth) sourceRest rest slots) + profile := by + apply ProfileFundedEmitStateRunSound.ofOp + intro opFuel before after env value horder henv hpre hrun + have hsemantic := + call_graph_op hdecl hownership hvalue hsource.toSourceApplies hpre hrun + obtain ⟨⟨roots, values, hinput, havs, hvalueGraphs, hrestGraph, + hown⟩, _⟩ := hpre + have hvaluesWorlds : values.length = worlds.length := + havs.lengths.2.symm.trans havs.lengths.1.symm + have hsourceWorlds : sourceArgs.length = worlds.length := + hvalueGraphs.length.trans hvaluesWorlds + have hvaluesArity : values.length = d.arity := + hvaluesWorlds.trans hcost.arity_eq + cases opFuel with + | zero => simp [runOp] at hrun + | succ invokeFuel => + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [havs.resolveAtoms, bindOk] at hrun + cases invokeFuel with + | zero => simp [invoke] at hrun + | succ bodyFuel => + have hbne : (values.length != d.arity) = false := by + simp [hvaluesArity] + simp only [invoke, hdecl, hbne, Bool.false_eq_true, if_false] at hrun + cases hbodyRun : runCode ctx bodyFuel d before values.reverse d.body with + | error error => + rw [hbodyRun] at hrun + contradiction + | ok out => + rcases out with ⟨bodyAfter, bodyValue⟩ + rw [hbodyRun] at hrun + have hpair : (bodyAfter, bodyValue) = (after, value) := + (Sim.checkResultWorld_ok hrun).1.symm + cases hpair + obtain ⟨sourceRoots, hrootsGraph⟩ := hinput.rootsGraph + have hcallerGraph : Sim.RootsGraph funRel before + (sourceRoots ++ sourceRest) (roots ++ rest) := + hrootsGraph.append hrestGraph + have hcallerOwn : Sim.RootOwnership before + (Sim.rootsForWorlds worlds values ++ (roots ++ rest)) := by + simpa [List.append_assoc] using hown + obtain ⟨allowance, hbodyCost, hfunded⟩ := + hcost.preserves horder hvaluesWorlds hsourceWorlds hvalueGraphs + hsource hcallerGraph hcallerOwn hbodyRun + exact ⟨hsemantic, + ⟨allowance, + OpOwnershipRunCost.call henv havs.resolveAtoms + (InvokeOwnershipRunCost.fn hdecl hvaluesArity hbodyCost + hrun), + hfunded⟩⟩ + +/-- Recursive-self counterpart of `call_graph_profile_op`. The successful +operation exposes the strictly smaller current-body run certified by the +same exact source application prefix. -/ +theorem callSelf_graph_profile_op + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {sourceAddress : Ixon.Address} + {output : VEnv} {sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Ixon.Owned} {avs : List AVal} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} {slots : List (Nat × RVal)} + {profile : SourceProfile} + (hownership : Sim.FnOwnershipContract ctx cur worlds) + (hvalue : FnValueContract funRel sourceCtx ctx cur worlds sourceFunction) + (hcost : FnProfileContract funRel sourceCtx ctx sourceAddress cur worlds + sourceFunction) + (hsource : SourceFnEntryProfile sourceCtx sourceAddress sourceFunction + sourceArgs sourceResult profile) : + ProfileFundedEmitStateRunSound ctx cur + (emitOp (.callSelf (avs.map (·.toAtom output)).toArray)) + (GraphOwnsArgsResultProtected funRel recSelfRel output sourceOutput + sourceArgs worlds avs sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult cur.result (.slotA output.depth) sourceRest rest slots) + profile := by + apply ProfileFundedEmitStateRunSound.ofOp + intro opFuel before after env value horder henv hpre hrun + have hsemantic := + callSelf_graph_op hownership hvalue hsource.toSourceApplies hpre hrun + obtain ⟨⟨roots, values, hinput, havs, hvalueGraphs, hrestGraph, + hown⟩, _⟩ := hpre + have hvaluesWorlds : values.length = worlds.length := + havs.lengths.2.symm.trans havs.lengths.1.symm + have hsourceWorlds : sourceArgs.length = worlds.length := + hvalueGraphs.length.trans hvaluesWorlds + have hvaluesArity : values.length = cur.arity := + hvaluesWorlds.trans hcost.arity_eq + cases opFuel with + | zero => simp [runOp] at hrun + | succ bodyFuel => + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [havs.resolveAtoms, bindOk] at hrun + have hbne : (values.length != cur.arity) = false := by + simp [hvaluesArity] + rw [hbne] at hrun + simp only [Bool.false_eq_true, if_false] at hrun + cases hbodyRun : runCode ctx bodyFuel cur before values.reverse cur.body + with + | error error => + rw [hbodyRun] at hrun + contradiction + | ok out => + rcases out with ⟨bodyAfter, bodyValue⟩ + rw [hbodyRun] at hrun + have hpair : (bodyAfter, bodyValue) = (after, value) := + (Sim.checkResultWorld_ok hrun).1.symm + cases hpair + obtain ⟨sourceRoots, hrootsGraph⟩ := hinput.rootsGraph + have hcallerGraph : Sim.RootsGraph funRel before + (sourceRoots ++ sourceRest) (roots ++ rest) := + hrootsGraph.append hrestGraph + have hcallerOwn : Sim.RootOwnership before + (Sim.rootsForWorlds worlds values ++ (roots ++ rest)) := by + simpa [List.append_assoc] using hown + obtain ⟨allowance, hbodyCost, hfunded⟩ := + hcost.preserves horder hvaluesWorlds hsourceWorlds hvalueGraphs + hsource hcallerGraph hcallerOwn hbodyRun + exact ⟨hsemantic, + ⟨allowance, + OpOwnershipRunCost.callSelf henv havs.resolveAtoms + hvaluesArity hbodyCost hrun, + hfunded⟩⟩ + +/-- Fuel-bounded direct-call operation. The selected function-body run is +strictly below the enclosing operation index. -/ +theorem call_graph_profile_op_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur d : FnDef} {limit : Nat} + {output : VEnv} {sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Ixon.Owned} {avs : List AVal} {f : Ixon.Address} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} {slots : List (Nat × RVal)} + {profile : SourceProfile} + (hdecl : ctx.decls f = some (.fn d)) + (hownership : Sim.FnOwnershipContract ctx d worlds) + (hvalue : FnValueContract funRel sourceCtx ctx d worlds sourceFunction) + (hcost : FnProfileContractBelow funRel sourceCtx ctx f d worlds sourceFunction + limit) + (hsource : SourceFnEntryProfile sourceCtx f sourceFunction sourceArgs + sourceResult profile) : + ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.call f (avs.map (·.toAtom output)).toArray)) + (GraphOwnsArgsResultProtected funRel recSelfRel output sourceOutput + sourceArgs worlds avs sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult d.result (.slotA output.depth) sourceRest rest slots) + profile := by + apply ProfileFundedEmitStateRunSoundBelow.ofOp + intro opFuel before after env value hopFuel horder henv hpre hrun + have hsemantic := + call_graph_op hdecl hownership hvalue hsource.toSourceApplies hpre hrun + obtain ⟨⟨roots, values, hinput, havs, hvalueGraphs, hrestGraph, + hown⟩, _⟩ := hpre + have hvaluesWorlds : values.length = worlds.length := + havs.lengths.2.symm.trans havs.lengths.1.symm + have hsourceWorlds : sourceArgs.length = worlds.length := + hvalueGraphs.length.trans hvaluesWorlds + have hvaluesArity : values.length = d.arity := + hvaluesWorlds.trans hcost.arity_eq + cases opFuel with + | zero => simp [runOp] at hrun + | succ invokeFuel => + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [havs.resolveAtoms, bindOk] at hrun + cases invokeFuel with + | zero => simp [invoke] at hrun + | succ bodyFuel => + have hbodyFuel : bodyFuel < limit := by omega + have hbne : (values.length != d.arity) = false := by + simp [hvaluesArity] + simp only [invoke, hdecl, hbne, Bool.false_eq_true, if_false] at hrun + cases hbodyRun : runCode ctx bodyFuel d before values.reverse d.body + with + | error error => + rw [hbodyRun] at hrun + contradiction + | ok out => + rcases out with ⟨bodyAfter, bodyValue⟩ + rw [hbodyRun] at hrun + have hpair : (bodyAfter, bodyValue) = (after, value) := + (Sim.checkResultWorld_ok hrun).1.symm + cases hpair + obtain ⟨sourceRoots, hrootsGraph⟩ := hinput.rootsGraph + have hcallerGraph : Sim.RootsGraph funRel before + (sourceRoots ++ sourceRest) (roots ++ rest) := + hrootsGraph.append hrestGraph + have hcallerOwn : Sim.RootOwnership before + (Sim.rootsForWorlds worlds values ++ (roots ++ rest)) := by + simpa [List.append_assoc] using hown + obtain ⟨allowance, hbodyCost, hfunded⟩ := + hcost.preserves hbodyFuel horder hvaluesWorlds hsourceWorlds + hvalueGraphs hsource hcallerGraph hcallerOwn hbodyRun + exact ⟨hsemantic, + ⟨allowance, + OpOwnershipRunCost.call henv havs.resolveAtoms + (InvokeOwnershipRunCost.fn hdecl hvaluesArity hbodyCost + hrun), + hfunded⟩⟩ + +/-- Fuel-bounded recursive-self operation. -/ +theorem callSelf_graph_profile_op_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {sourceAddress : Ixon.Address} + {output : VEnv} {sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Ixon.Owned} {avs : List AVal} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} {slots : List (Nat × RVal)} + {profile : SourceProfile} + (hownership : Sim.FnOwnershipContract ctx cur worlds) + (hvalue : FnValueContract funRel sourceCtx ctx cur worlds sourceFunction) + (hcost : FnProfileContractBelow funRel sourceCtx ctx sourceAddress cur worlds + sourceFunction limit) + (hsource : SourceFnEntryProfile sourceCtx sourceAddress sourceFunction + sourceArgs sourceResult profile) : + ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.callSelf (avs.map (·.toAtom output)).toArray)) + (GraphOwnsArgsResultProtected funRel recSelfRel output sourceOutput + sourceArgs worlds avs sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult cur.result (.slotA output.depth) sourceRest rest slots) + profile := by + apply ProfileFundedEmitStateRunSoundBelow.ofOp + intro opFuel before after env value hopFuel horder henv hpre hrun + have hsemantic := + callSelf_graph_op hownership hvalue hsource.toSourceApplies hpre hrun + obtain ⟨⟨roots, values, hinput, havs, hvalueGraphs, hrestGraph, + hown⟩, _⟩ := hpre + have hvaluesWorlds : values.length = worlds.length := + havs.lengths.2.symm.trans havs.lengths.1.symm + have hsourceWorlds : sourceArgs.length = worlds.length := + hvalueGraphs.length.trans hvaluesWorlds + have hvaluesArity : values.length = cur.arity := + hvaluesWorlds.trans hcost.arity_eq + cases opFuel with + | zero => simp [runOp] at hrun + | succ bodyFuel => + have hbodyFuel : bodyFuel < limit := by omega + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [havs.resolveAtoms, bindOk] at hrun + have hbne : (values.length != cur.arity) = false := by + simp [hvaluesArity] + rw [hbne] at hrun + simp only [Bool.false_eq_true, if_false] at hrun + cases hbodyRun : runCode ctx bodyFuel cur before values.reverse cur.body + with + | error error => + rw [hbodyRun] at hrun + contradiction + | ok out => + rcases out with ⟨bodyAfter, bodyValue⟩ + rw [hbodyRun] at hrun + have hpair : (bodyAfter, bodyValue) = (after, value) := + (Sim.checkResultWorld_ok hrun).1.symm + cases hpair + obtain ⟨sourceRoots, hrootsGraph⟩ := hinput.rootsGraph + have hcallerGraph : Sim.RootsGraph funRel before + (sourceRoots ++ sourceRest) (roots ++ rest) := + hrootsGraph.append hrestGraph + have hcallerOwn : Sim.RootOwnership before + (Sim.rootsForWorlds worlds values ++ (roots ++ rest)) := by + simpa [List.append_assoc] using hown + obtain ⟨allowance, hbodyCost, hfunded⟩ := + hcost.preserves hbodyFuel horder hvaluesWorlds hsourceWorlds + hvalueGraphs hsource hcallerGraph hcallerOwn hbodyRun + exact ⟨hsemantic, + ⟨allowance, + OpOwnershipRunCost.callSelf henv havs.resolveAtoms + hvaluesArity hbodyCost hrun, + hfunded⟩⟩ + +/-- Profiled argument evaluation followed by one exact direct call. -/ +theorem LowerArgsProfileSound.call_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur d : FnDef} + {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Ixon.Owned} {emit : Emit} {avs : List AVal} + {f : Ixon.Address} {argsProfile callProfile : SourceProfile} + (hargs : LowerArgsProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceArgs worlds emit avs argsProfile) + (hdecl : ctx.decls f = some (.fn d)) + (hownership : Sim.FnOwnershipContract ctx d worlds) + (hvalue : FnValueContract funRel sourceCtx ctx d worlds sourceFunction) + (hcost : FnProfileContract funRel sourceCtx ctx f d worlds sourceFunction) + (hsource : SourceFnEntryProfile sourceCtx f sourceFunction sourceArgs + sourceResult callProfile) : + LowerResultProfileSound funRel recSelfRel ctx cur input output.bump + sourceInput sourceOutput sourceResult d.result + (emit ∘ emitOp (.call f (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) (argsProfile + callProfile) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.call_graph hdecl hownership hvalue + hsource.toSourceApplies + profileEmits := ?_ } + intro sourceRest rest slots + exact ProfileFundedEmitStateRunSound.comp + (hargs.profileEmits sourceRest rest slots) + (call_graph_profile_op hdecl hownership hvalue hcost hsource) + +/-- Profiled argument evaluation followed by one exact recursive self call. -/ +theorem LowerArgsProfileSound.callSelf_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {sourceAddress : Ixon.Address} + {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Ixon.Owned} {emit : Emit} {avs : List AVal} + {argsProfile callProfile : SourceProfile} + (hargs : LowerArgsProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceArgs worlds emit avs argsProfile) + (hownership : Sim.FnOwnershipContract ctx cur worlds) + (hvalue : FnValueContract funRel sourceCtx ctx cur worlds sourceFunction) + (hcost : FnProfileContract funRel sourceCtx ctx sourceAddress cur worlds + sourceFunction) + (hsource : SourceFnEntryProfile sourceCtx sourceAddress sourceFunction + sourceArgs sourceResult callProfile) : + LowerResultProfileSound funRel recSelfRel ctx cur input output.bump + sourceInput sourceOutput sourceResult cur.result + (emit ∘ emitOp + (.callSelf (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) (argsProfile + callProfile) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.callSelf_graph hownership hvalue + hsource.toSourceApplies + profileEmits := ?_ } + intro sourceRest rest slots + exact ProfileFundedEmitStateRunSound.comp + (hargs.profileEmits sourceRest rest slots) + (callSelf_graph_profile_op hownership hvalue hcost hsource) + +theorem LowerArgsProfileSoundBelow.call_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur d : FnDef} {limit : Nat} + {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Ixon.Owned} {emit : Emit} {avs : List AVal} + {f : Ixon.Address} {argsProfile callProfile : SourceProfile} + (hargs : LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceArgs worlds emit avs + argsProfile) + (hdecl : ctx.decls f = some (.fn d)) + (hownership : Sim.FnOwnershipContract ctx d worlds) + (hvalue : FnValueContract funRel sourceCtx ctx d worlds sourceFunction) + (hcost : FnProfileContractBelow funRel sourceCtx ctx f d worlds sourceFunction + limit) + (hsource : SourceFnEntryProfile sourceCtx f sourceFunction sourceArgs + sourceResult callProfile) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + output.bump sourceInput sourceOutput sourceResult d.result + (emit ∘ emitOp (.call f (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) (argsProfile + callProfile) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.call_graph hdecl hownership hvalue + hsource.toSourceApplies + profileEmits := ?_ } + intro sourceRest rest slots + exact ProfileFundedEmitStateRunSoundBelow.comp + (hargs.profileEmits sourceRest rest slots) + (call_graph_profile_op_below hdecl hownership hvalue hcost hsource) + +theorem LowerArgsProfileSoundBelow.callSelf_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {sourceAddress : Ixon.Address} + {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Ixon.Owned} {emit : Emit} {avs : List AVal} + {argsProfile callProfile : SourceProfile} + (hargs : LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceArgs worlds emit avs + argsProfile) + (hownership : Sim.FnOwnershipContract ctx cur worlds) + (hvalue : FnValueContract funRel sourceCtx ctx cur worlds sourceFunction) + (hcost : FnProfileContractBelow funRel sourceCtx ctx sourceAddress cur worlds + sourceFunction limit) + (hsource : SourceFnEntryProfile sourceCtx sourceAddress sourceFunction + sourceArgs sourceResult callProfile) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + output.bump sourceInput sourceOutput sourceResult cur.result + (emit ∘ emitOp + (.callSelf (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) (argsProfile + callProfile) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.callSelf_graph hownership hvalue + hsource.toSourceApplies + profileEmits := ?_ } + intro sourceRest rest slots + exact ProfileFundedEmitStateRunSoundBelow.comp + (hargs.profileEmits sourceRest rest slots) + (callSelf_graph_profile_op_below hownership hvalue hcost hsource) + +theorem LowerResultProfileSound.of_profile_eq + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {world : Ixon.Owned} + {emit : Emit} {av : AVal} {left right : SourceProfile} + (hsound : LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue world emit av left) + (hprofile : left = right) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue world emit av right := by + subst right + exact hsound + +theorem LowerResultProfileSound.monoProfile + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {world : Ixon.Owned} + {emit : Emit} {av : AVal} {smaller larger : SourceProfile} + (hsound : LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue world emit av smaller) + (hle : OwnershipAllowanceLE + (sourceProfileOwnershipAllowance smaller) + (sourceProfileOwnershipAllowance larger)) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue world emit av larger := by + refine + { toLowerResultValueSound := hsound.toLowerResultValueSound + profileEmits := ?_ } + intro sourceRest rest slots + have hrun : ProfileFundedEmitStateRunSound ctx cur emit + (GraphOwnsVEnvProtected funRel recSelfRel input sourceInput + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output sourceOutput + sourceValue world av sourceRest rest slots) + smaller := + hsound.profileEmits sourceRest rest slots + intro continuation continuationProfile fuel before after env value horder + henv hpre hcodeRun hcontinuation + exact (ProfileFundedEmitStateRunSound.monoProfile hrun hle) + horder henv hpre hcodeRun hcontinuation + +/-- A semantically inert source-profile fragment may be added to the left +of an already-funded result. This accounts for source work that static +lowering erases, such as evaluation of a statically known spine head. -/ +theorem LowerResultProfileSound.addProfileLeft + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {world : Ixon.Owned} + {emit : Emit} {av : AVal} {profile : SourceProfile} + (hsound : LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue world emit av profile) + (extra : SourceProfile) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue world emit av (extra + profile) := by + apply hsound.monoProfile + rw [sourceProfileOwnershipAllowance_add] + simp [OwnershipAllowanceLE, OwnershipAllowance.add] + +/-- A static direct call assigns the source head fragment to a nullary body +and the source application fragment to a positive-arity body. In both cases +the resulting profile is the same canonical head/arguments/applications +sum used by flattened spines. -/ +theorem LowerArgsProfileSound.call_graph_from_ref + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur d : FnDef} + {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Ixon.Owned} {emit : Emit} {avs : List AVal} + {f : Ixon.Address} {argsProfile headProfile callProfile : SourceProfile} + (hargs : LowerArgsProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceArgs worlds emit avs argsProfile) + (hdecl : ctx.decls f = some (.fn d)) + (hownership : Sim.FnOwnershipContract ctx d worlds) + (hvalue : FnValueContract funRel sourceCtx ctx d worlds sourceFunction) + (hcost : FnProfileContract funRel sourceCtx ctx f d worlds sourceFunction) + (hhead : SourceRefProfile sourceCtx f sourceFunction headProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceArgs + sourceResult callProfile) : + LowerResultProfileSound funRel recSelfRel ctx cur input output.bump + sourceInput sourceOutput sourceResult d.result + (emit ∘ emitOp (.call f (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) (headProfile + argsProfile + callProfile) := by + cases hsource with + | nil => + have hcalled := hargs.call_graph hdecl hownership hvalue hcost + (SourceFnEntryProfile.nullary hhead) + apply LowerResultProfileSound.of_profile_eq hcalled + ext <;> simp [Nat.add_comm] + | cons hstep htail => + have hcalled := hargs.call_graph hdecl hownership hvalue hcost + (SourceFnEntryProfile.applied + (SourceAppliesProfile.cons hstep htail)) + apply LowerResultProfileSound.of_profile_eq + (hcalled.addProfileLeft headProfile) + exact (IxIR0.DynamicCost.Profile.add_assoc _ _ _).symm + +/-- Target-fuel-bounded counterpart of `call_graph_from_ref`. -/ +theorem LowerArgsProfileSoundBelow.call_graph_from_ref + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur d : FnDef} {limit : Nat} + {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Ixon.Owned} {emit : Emit} {avs : List AVal} + {f : Ixon.Address} {argsProfile headProfile callProfile : SourceProfile} + (hargs : LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceArgs worlds emit avs + argsProfile) + (hdecl : ctx.decls f = some (.fn d)) + (hownership : Sim.FnOwnershipContract ctx d worlds) + (hvalue : FnValueContract funRel sourceCtx ctx d worlds sourceFunction) + (hcost : FnProfileContractBelow funRel sourceCtx ctx f d worlds sourceFunction + limit) + (hhead : SourceRefProfile sourceCtx f sourceFunction headProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceArgs + sourceResult callProfile) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + output.bump sourceInput sourceOutput sourceResult d.result + (emit ∘ emitOp (.call f (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) (headProfile + argsProfile + callProfile) := by + cases hsource with + | nil => + have hcalled := hargs.call_graph hdecl hownership hvalue hcost + (SourceFnEntryProfile.nullary hhead) + apply LowerResultProfileSoundBelow.of_profile_eq hcalled + ext <;> simp [Nat.add_comm] + | cons hstep htail => + have hcalled := hargs.call_graph hdecl hownership hvalue hcost + (SourceFnEntryProfile.applied + (SourceAppliesProfile.cons hstep htail)) + apply LowerResultProfileSoundBelow.of_profile_eq + (hcalled.addProfileLeft headProfile) + exact (IxIR0.DynamicCost.Profile.add_assoc _ _ _).symm + +/-- Recursive-self call where the semantic and profile contracts are both +selected by the synthetic `recSelf` witness stored in the input relation. -/ +theorem LowerArgsProfileSound.callSelf_entry_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {input output : VEnv} {index arity : Nat} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Ixon.Owned} {emit : Emit} {avs : List AVal} + {argsProfile callProfile : SourceProfile} + (hargs : LowerArgsProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceArgs worlds emit avs argsProfile) + (hentry : input.entries[index]? = some (.recSelf arity)) + (hhead : sourceInput[index]? = some sourceFunction) + (hownership : Sim.FnOwnershipContract ctx cur worlds) + (hvalue : recSelfRel sourceFunction arity → + FnValueContract funRel sourceCtx ctx cur worlds sourceFunction) + (hcost : recSelfRel sourceFunction arity → + ∃ sourceAddress, + FnProfileContract funRel sourceCtx ctx sourceAddress cur worlds + sourceFunction) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceArgs + sourceResult callProfile) + (hnonempty : sourceArgs ≠ []) : + LowerResultProfileSound funRel recSelfRel ctx cur input output.bump + sourceInput sourceOutput sourceResult cur.result + (emit ∘ emitOp + (.callSelf (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) (argsProfile + callProfile) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.callSelf_entry_graph hentry hhead + hownership hvalue hsource.toSourceApplies + profileEmits := ?_ } + intro sourceRest rest slots + intro continuation continuationProfile fuel before after env value horder + henv hpre hrun hcontinuation + have hpreData := hpre + obtain ⟨⟨envRoots, hinput, hrestGraph, hown⟩, hslots⟩ := hpreData + obtain ⟨source, hsourceLookup, hself⟩ := hinput.getRecSelf hentry + have hsourceEq : source = sourceFunction := by + rw [hhead] at hsourceLookup + exact (Option.some.inj hsourceLookup).symm + subst source + obtain ⟨sourceAddress, hcost⟩ := hcost hself + have hentryProfile : SourceFnEntryProfile sourceCtx sourceAddress + sourceFunction sourceArgs sourceResult callProfile := + hsource.toFnEntryProfile hnonempty + have hcomposed : ProfileFundedEmitStateRunSound ctx cur + (emit ∘ emitOp + (.callSelf (avs.map (·.toAtom output)).toArray)) + (GraphOwnsVEnvProtected funRel recSelfRel input sourceInput + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult cur.result (.slotA output.depth) sourceRest rest slots) + (argsProfile + callProfile) := + ProfileFundedEmitStateRunSound.comp + (hargs.profileEmits sourceRest rest slots) + (callSelf_graph_profile_op hownership (hvalue hself) hcost + hentryProfile) + exact hcomposed horder henv hpre hrun hcontinuation + +/-- Fuel-bounded recursive-self call whose semantic and profile contracts +are selected by the synthetic `recSelf` witness in the input relation. -/ +theorem LowerArgsProfileSoundBelow.callSelf_entry_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} {index arity : Nat} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Ixon.Owned} {emit : Emit} {avs : List AVal} + {argsProfile callProfile : SourceProfile} + (hargs : LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceArgs worlds emit avs + argsProfile) + (hentry : input.entries[index]? = some (.recSelf arity)) + (hhead : sourceInput[index]? = some sourceFunction) + (hownership : Sim.FnOwnershipContract ctx cur worlds) + (hvalue : recSelfRel sourceFunction arity → + FnValueContract funRel sourceCtx ctx cur worlds sourceFunction) + (hcost : recSelfRel sourceFunction arity → + ∃ sourceAddress, + FnProfileContractBelow funRel sourceCtx ctx sourceAddress cur worlds + sourceFunction limit) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceArgs + sourceResult callProfile) + (hnonempty : sourceArgs ≠ []) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + output.bump sourceInput sourceOutput sourceResult cur.result + (emit ∘ emitOp + (.callSelf (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) (argsProfile + callProfile) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.callSelf_entry_graph hentry hhead + hownership hvalue hsource.toSourceApplies + profileEmits := ?_ } + intro sourceRest rest slots + intro bound hbound continuation continuationProfile fuel before after env + value hfuel horder henv hpre hrun hcontinuation + have hpreData := hpre + obtain ⟨⟨envRoots, hinput, hrestGraph, hown⟩, hslots⟩ := hpreData + obtain ⟨source, hsourceLookup, hself⟩ := hinput.getRecSelf hentry + have hsourceEq : source = sourceFunction := by + rw [hhead] at hsourceLookup + exact (Option.some.inj hsourceLookup).symm + subst source + obtain ⟨sourceAddress, hcost⟩ := hcost hself + have hentryProfile : SourceFnEntryProfile sourceCtx sourceAddress + sourceFunction sourceArgs sourceResult callProfile := + hsource.toFnEntryProfile hnonempty + have hcomposed : ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emit ∘ emitOp + (.callSelf (avs.map (·.toAtom output)).toArray)) + (GraphOwnsVEnvProtected funRel recSelfRel input sourceInput + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult cur.result (.slotA output.depth) sourceRest rest slots) + (argsProfile + callProfile) := + ProfileFundedEmitStateRunSoundBelow.comp + (hargs.profileEmits sourceRest rest slots) + (callSelf_graph_profile_op_below hownership (hvalue hself) + hcost hentryProfile) + exact hcomposed bound hbound hfuel horder henv hpre hrun hcontinuation + +/-- A PAP allocation at the profiled operation midpoint. Any profile with +at least one source evaluation funds the single fresh shared node. -/ +theorem papp_graph_profile_op_of_evals_pos + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {output : VEnv} {sourceOutput sourceValues : List IxIR0.Value} + {sourceValue : IxIR0.Value} {avs : List AVal} + {f : Ixon.Address} {d : Decl} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} {slots : List (Nat × RVal)} + {profile : SourceProfile} + (hdecl : ctx.decls f = some d) + (hfun : funRel sourceValue f (declArity d) sourceValues) + (hunder : avs.length < declArity d) + (hpos : 0 < profile.evals) : + ProfileFundedEmitStateRunSound ctx cur + (emitOp (.papp f (avs.map (·.toAtom output)).toArray)) + (GraphOwnsArgsResultProtected funRel recSelfRel output sourceOutput + sourceValues (List.replicate avs.length .shared) avs sourceRest rest + slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceValue .shared (.slotA output.depth) sourceRest rest slots) + profile := by + apply ProfileFundedEmitStateRunSound.localOp (allowance := ⟨1, 1⟩) + (papp_graph_op hdecl hfun hunder) + · simp [localOpOwnershipAllowance] + · exact allocatedNodeAllowance_le_profile_of_evals_pos hpos + +/-- Profiled shared arguments followed by PAP allocation, funded by any +nonempty enclosing source-evaluation profile. -/ +theorem LowerArgsProfileSound.papp_graph_of_evals_pos + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput sourceValues : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {avs : List AVal} + {f : Ixon.Address} {d : Decl} + {argsProfile opProfile : SourceProfile} + (hargs : LowerArgsProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValues + (List.replicate avs.length .shared) emit avs argsProfile) + (hdecl : ctx.decls f = some d) + (hfun : funRel sourceValue f (declArity d) sourceValues) + (hunder : avs.length < declArity d) + (hpos : 0 < opProfile.evals) : + LowerResultProfileSound funRel recSelfRel ctx cur input output.bump + sourceInput sourceOutput sourceValue .shared + (emit ∘ emitOp (.papp f (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) (argsProfile + opProfile) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.papp_graph hdecl hfun hunder + profileEmits := ?_ } + intro sourceRest rest slots + exact ProfileFundedEmitStateRunSound.comp + (hargs.profileEmits sourceRest rest slots) + (papp_graph_profile_op_of_evals_pos hdecl hfun hunder hpos) + +/-- Fuel-bounded PAP allocation at the profiled operation midpoint. -/ +theorem papp_graph_profile_op_of_evals_pos_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {output : VEnv} {sourceOutput sourceValues : List IxIR0.Value} + {sourceValue : IxIR0.Value} {avs : List AVal} + {f : Ixon.Address} {d : Decl} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} {slots : List (Nat × RVal)} + {profile : SourceProfile} + (hdecl : ctx.decls f = some d) + (hfun : funRel sourceValue f (declArity d) sourceValues) + (hunder : avs.length < declArity d) + (hpos : 0 < profile.evals) : + ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.papp f (avs.map (·.toAtom output)).toArray)) + (GraphOwnsArgsResultProtected funRel recSelfRel output sourceOutput + sourceValues (List.replicate avs.length .shared) avs sourceRest rest + slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceValue .shared (.slotA output.depth) sourceRest rest slots) + profile := by + apply ProfileFundedEmitStateRunSoundBelow.localOp + (allowance := ⟨1, 1⟩) (papp_graph_op hdecl hfun hunder) + · simp [localOpOwnershipAllowance] + · exact allocatedNodeAllowance_le_profile_of_evals_pos hpos + +/-- Fuel-bounded profiled shared arguments followed by PAP allocation. -/ +theorem LowerArgsProfileSoundBelow.papp_graph_of_evals_pos + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input output : VEnv} + {sourceInput sourceOutput sourceValues : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {avs : List AVal} + {f : Ixon.Address} {d : Decl} + {argsProfile opProfile : SourceProfile} + (hargs : LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceValues + (List.replicate avs.length .shared) emit avs argsProfile) + (hdecl : ctx.decls f = some d) + (hfun : funRel sourceValue f (declArity d) sourceValues) + (hunder : avs.length < declArity d) + (hpos : 0 < opProfile.evals) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + output.bump sourceInput sourceOutput sourceValue .shared + (emit ∘ emitOp (.papp f (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) (argsProfile + opProfile) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.papp_graph hdecl hfun hunder + profileEmits := ?_ } + intro sourceRest rest slots + exact ProfileFundedEmitStateRunSoundBelow.comp + (hargs.profileEmits sourceRest rest slots) + (papp_graph_profile_op_of_evals_pos_below hdecl hfun hunder hpos) + +/-- Constructor allocation at the profiled operation midpoint. -/ +theorem alloc_graph_profile_op_of_evals_pos + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {output : VEnv} + {sourceOutput sourceValues : List IxIR0.Value} + {sourceAddress : Ixon.Address} {sourceTag : Nat} + {world : Ixon.Owned} {avs : List AVal} {cid : CtorId} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} {slots : List (Nat × RVal)} + {profile : SourceProfile} + (haddress : cid.block = sourceAddress) + (htag : cid.cidx = sourceTag) + (hpos : 0 < profile.evals) : + ProfileFundedEmitStateRunSound ctx cur + (emitOp (.alloc world cid (avs.map (·.toAtom output)).toArray)) + (GraphOwnsArgsResultProtected funRel recSelfRel output sourceOutput + sourceValues (List.replicate avs.length world) avs sourceRest rest + slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + (.ctor sourceAddress sourceTag sourceValues) world + (.slotA output.depth) sourceRest rest slots) + profile := by + apply ProfileFundedEmitStateRunSound.localOp (allowance := ⟨1, 1⟩) + (alloc_graph_op haddress htag) + · simp [localOpOwnershipAllowance] + · exact allocatedNodeAllowance_le_profile_of_evals_pos hpos + +/-- Profiled arguments followed by constructor allocation. -/ +theorem LowerArgsProfileSound.alloc_graph_of_evals_pos + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput sourceValues : List IxIR0.Value} + {sourceAddress : Ixon.Address} {sourceTag : Nat} + {world : Ixon.Owned} {emit : Emit} {avs : List AVal} {cid : CtorId} + {argsProfile opProfile : SourceProfile} + (hargs : LowerArgsProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValues + (List.replicate avs.length world) emit avs argsProfile) + (haddress : cid.block = sourceAddress) + (htag : cid.cidx = sourceTag) + (hpos : 0 < opProfile.evals) : + LowerResultProfileSound funRel recSelfRel ctx cur input output.bump + sourceInput sourceOutput (.ctor sourceAddress sourceTag sourceValues) + world + (emit ∘ emitOp + (.alloc world cid (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) (argsProfile + opProfile) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.alloc_graph haddress htag + profileEmits := ?_ } + intro sourceRest rest slots + exact ProfileFundedEmitStateRunSound.comp + (hargs.profileEmits sourceRest rest slots) + (alloc_graph_profile_op_of_evals_pos haddress htag hpos) + +/-- Fuel-bounded constructor allocation at the profiled operation +midpoint. -/ +theorem alloc_graph_profile_op_of_evals_pos_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {output : VEnv} + {sourceOutput sourceValues : List IxIR0.Value} + {sourceAddress : Ixon.Address} {sourceTag : Nat} + {world : Ixon.Owned} {avs : List AVal} {cid : CtorId} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} {slots : List (Nat × RVal)} + {profile : SourceProfile} + (haddress : cid.block = sourceAddress) + (htag : cid.cidx = sourceTag) + (hpos : 0 < profile.evals) : + ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.alloc world cid (avs.map (·.toAtom output)).toArray)) + (GraphOwnsArgsResultProtected funRel recSelfRel output sourceOutput + sourceValues (List.replicate avs.length world) avs sourceRest rest + slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + (.ctor sourceAddress sourceTag sourceValues) world + (.slotA output.depth) sourceRest rest slots) + profile := by + apply ProfileFundedEmitStateRunSoundBelow.localOp + (allowance := ⟨1, 1⟩) (alloc_graph_op haddress htag) + · simp [localOpOwnershipAllowance] + · exact allocatedNodeAllowance_le_profile_of_evals_pos hpos + +/-- Fuel-bounded profiled arguments followed by constructor allocation. -/ +theorem LowerArgsProfileSoundBelow.alloc_graph_of_evals_pos + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input output : VEnv} + {sourceInput sourceOutput sourceValues : List IxIR0.Value} + {sourceAddress : Ixon.Address} {sourceTag : Nat} + {world : Ixon.Owned} {emit : Emit} {avs : List AVal} {cid : CtorId} + {argsProfile opProfile : SourceProfile} + (hargs : LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceValues + (List.replicate avs.length world) emit avs argsProfile) + (haddress : cid.block = sourceAddress) + (htag : cid.cidx = sourceTag) + (hpos : 0 < opProfile.evals) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + output.bump sourceInput sourceOutput + (.ctor sourceAddress sourceTag sourceValues) world + (emit ∘ emitOp + (.alloc world cid (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) (argsProfile + opProfile) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.alloc_graph haddress htag + profileEmits := ?_ } + intro sourceRest rest slots + exact ProfileFundedEmitStateRunSoundBelow.comp + (hargs.profileEmits sourceRest rest slots) + (alloc_graph_profile_op_of_evals_pos_below haddress htag hpos) + +/-- A scalar extern operation is ownership-free; its semantic result is +paired with any exact source profile assigned to the saturated prefix. -/ +theorem extern_graph_profile_op + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {output : VEnv} {sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {avs : List AVal} {f : Ixon.Address} {arity : Nat} + {resultWorld : Ixon.Owned} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} {slots : List (Nat × RVal)} + {profile : SourceProfile} + (hcontract : ExternValueContract funRel sourceCtx ctx) + (hlookup : sourceCtx.env f = some (.extern arity)) + (href : SourceRefValue sourceCtx f sourceFunction) + (hlength : sourceArgs.length = arity) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceArgs + sourceResult profile) : + ProfileFundedEmitStateRunSound ctx cur + (emitOp (.extern f (avs.map (·.toAtom output)).toArray)) + (GraphOwnsArgsResultProtected funRel recSelfRel output sourceOutput + sourceArgs (List.replicate avs.length .shared) avs sourceRest rest + slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult resultWorld (.slotA output.depth) sourceRest rest + slots) + profile := by + apply ProfileFundedEmitStateRunSound.localZero + (extern_graph_op hcontract hlookup href hlength hsource.toSourceApplies) + simp [localOpOwnershipAllowance] + +/-- Profiled arguments followed by a scalar extern operation. -/ +theorem LowerArgsProfileSound.extern_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {emit : Emit} {avs : List AVal} {f : Ixon.Address} + {arity : Nat} {resultWorld : Ixon.Owned} + {argsProfile externProfile : SourceProfile} + (hargs : LowerArgsProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceArgs + (List.replicate avs.length .shared) emit avs argsProfile) + (hcontract : ExternValueContract funRel sourceCtx ctx) + (hlookup : sourceCtx.env f = some (.extern arity)) + (href : SourceRefValue sourceCtx f sourceFunction) + (hlength : sourceArgs.length = arity) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceArgs + sourceResult externProfile) : + LowerResultProfileSound funRel recSelfRel ctx cur input output.bump + sourceInput sourceOutput sourceResult resultWorld + (emit ∘ emitOp (.extern f (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) (argsProfile + externProfile) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.extern_graph hcontract hlookup href + hlength hsource.toSourceApplies + profileEmits := ?_ } + intro sourceRest rest slots + exact ProfileFundedEmitStateRunSound.comp + (hargs.profileEmits sourceRest rest slots) + (extern_graph_profile_op hcontract hlookup href hlength hsource) + +/-- Fuel-bounded scalar extern operation. -/ +theorem extern_graph_profile_op_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {output : VEnv} {sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {avs : List AVal} {f : Ixon.Address} {arity : Nat} + {resultWorld : Ixon.Owned} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} {slots : List (Nat × RVal)} + {profile : SourceProfile} + (hcontract : ExternValueContract funRel sourceCtx ctx) + (hlookup : sourceCtx.env f = some (.extern arity)) + (href : SourceRefValue sourceCtx f sourceFunction) + (hlength : sourceArgs.length = arity) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceArgs + sourceResult profile) : + ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.extern f (avs.map (·.toAtom output)).toArray)) + (GraphOwnsArgsResultProtected funRel recSelfRel output sourceOutput + sourceArgs (List.replicate avs.length .shared) avs sourceRest rest + slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult resultWorld (.slotA output.depth) sourceRest rest + slots) + profile := by + apply ProfileFundedEmitStateRunSoundBelow.localZero + (extern_graph_op hcontract hlookup href hlength hsource.toSourceApplies) + simp [localOpOwnershipAllowance] + +/-- Fuel-bounded profiled arguments followed by a scalar extern. -/ +theorem LowerArgsProfileSoundBelow.extern_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {emit : Emit} {avs : List AVal} {f : Ixon.Address} + {arity : Nat} {resultWorld : Ixon.Owned} + {argsProfile externProfile : SourceProfile} + (hargs : LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceArgs + (List.replicate avs.length .shared) emit avs argsProfile) + (hcontract : ExternValueContract funRel sourceCtx ctx) + (hlookup : sourceCtx.env f = some (.extern arity)) + (href : SourceRefValue sourceCtx f sourceFunction) + (hlength : sourceArgs.length = arity) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceArgs + sourceResult externProfile) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + output.bump sourceInput sourceOutput sourceResult resultWorld + (emit ∘ emitOp (.extern f (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) (argsProfile + externProfile) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.extern_graph hcontract hlookup href + hlength hsource.toSourceApplies + profileEmits := ?_ } + intro sourceRest rest slots + exact ProfileFundedEmitStateRunSoundBelow.comp + (hargs.profileEmits sourceRest rest slots) + (extern_graph_profile_op_below hcontract hlookup href hlength hsource) + +/-- The dynamic target `apply` primitive, indexed by the protected +post-argument semantic state and funded by its exact source apply chain. -/ +theorem apply_graph_profile_op + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {functionInput output : VEnv} {functionEnv : List RVal} + {sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {avs : List AVal} {function : AVal} {functionValue : RVal} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} + {slots : List (Nat × RVal)} {profile : SourceProfile} + (hfunctionStable : AValStable function) + (hfunction : AValRealizes functionInput functionEnv function + functionValue) + (hownership : Sim.ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hcost : ApplyProfileContract funRel sourceCtx ctx) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceArgs + sourceResult profile) + (hnonempty : sourceArgs ≠ []) : + ProfileFundedEmitStateRunSound ctx cur + (emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (GraphOwnsArgsResultProtected funRel recSelfRel output + sourceOutput sourceArgs (List.replicate avs.length .shared) avs + ((.shared, sourceFunction) :: sourceRest) + (⟨.shared, functionValue⟩ :: rest) + (aValProtection function functionValue ++ slots)) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult .shared (.slotA output.depth) sourceRest rest slots) + profile := by + apply ProfileFundedEmitStateRunSound.ofOp + intro opFuel before after env value horder henv hpre hrun + cases opFuel with + | zero => simp [runOp] at hrun + | succ fuel => + have hsemantic := + apply_graph_op hfunctionStable hfunction hownership hvalue + hsource.toSourceApplies hpre hrun + obtain ⟨⟨outRoots, values, houtput, havs, hvalueGraphs, + hframeGraph, hownArgs⟩, hslots⟩ := hpre + cases hframeGraph with + | cons _ _ hfunctionGraph hrestGraph => + have hfunctionFinal : + AValRealizes output env function functionValue := + hfunctionStable.realize_of_protection hfunction + hslots.left_of_append + have hvaluesLength : values.length = avs.length := + havs.lengths.2.symm + have hroots : + Sim.rootsForWorlds (List.replicate avs.length .shared) values = + Sim.rootsFor .shared values := + rootsForWorlds_replicate_eq_rootsFor .shared hvaluesLength + have hownApply : Sim.RootOwnership before + (⟨.shared, functionValue⟩ :: Sim.rootsFor .shared values ++ + (outRoots ++ rest)) := by + apply hownArgs.perm + simpa [hroots, List.append_assoc] using + (permExtractRoot ⟨.shared, functionValue⟩ + (Sim.rootsForWorlds (List.replicate avs.length .shared) values ++ + outRoots) [] rest) + have henvFrame : Sim.RootsGraph funRel before + (entrySourceRoots output.entries sourceOutput) outRoots := + houtput.entries.rootsGraphExact + have hcombinedFrame : Sim.RootsGraph funRel before + (entrySourceRoots output.entries sourceOutput ++ sourceRest) + (outRoots ++ rest) := + henvFrame.append hrestGraph + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [hfunctionFinal.resolveAtom, bindOk, havs.resolveAtoms, bindOk] + at hrun + obtain ⟨allowance, happlyCost, happlyFunded⟩ := + hcost.preserves horder + (by simpa using hfunctionGraph) hvalueGraphs hsource + hcombinedFrame hownApply hnonempty hrun + exact ⟨hsemantic, + ⟨allowance, + OpOwnershipRunCost.apply henv hfunctionFinal.resolveAtom + havs.resolveAtoms happlyCost, + happlyFunded⟩⟩ + +/-- Fuel-bounded dynamic application operation. The selected `applyGo` +run is strictly below the enclosing operation index. -/ +theorem apply_graph_profile_op_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {functionInput output : VEnv} {functionEnv : List RVal} + {sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {avs : List AVal} {function : AVal} {functionValue : RVal} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} + {slots : List (Nat × RVal)} {profile : SourceProfile} + (hfunctionStable : AValStable function) + (hfunction : AValRealizes functionInput functionEnv function + functionValue) + (hownership : Sim.ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hcost : ApplyProfileContractBelow funRel sourceCtx ctx limit) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceArgs + sourceResult profile) + (hnonempty : sourceArgs ≠ []) : + ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (GraphOwnsArgsResultProtected funRel recSelfRel output + sourceOutput sourceArgs (List.replicate avs.length .shared) avs + ((.shared, sourceFunction) :: sourceRest) + (⟨.shared, functionValue⟩ :: rest) + (aValProtection function functionValue ++ slots)) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult .shared (.slotA output.depth) sourceRest rest slots) + profile := by + apply ProfileFundedEmitStateRunSoundBelow.ofOp + intro opFuel before after env value hopFuel horder henv hpre hrun + cases opFuel with + | zero => simp [runOp] at hrun + | succ fuel => + have hfuel : fuel < limit := by omega + have hsemantic := + apply_graph_op hfunctionStable hfunction hownership hvalue + hsource.toSourceApplies hpre hrun + obtain ⟨⟨outRoots, values, houtput, havs, hvalueGraphs, + hframeGraph, hownArgs⟩, hslots⟩ := hpre + cases hframeGraph with + | cons _ _ hfunctionGraph hrestGraph => + have hfunctionFinal : + AValRealizes output env function functionValue := + hfunctionStable.realize_of_protection hfunction + hslots.left_of_append + have hvaluesLength : values.length = avs.length := + havs.lengths.2.symm + have hroots : + Sim.rootsForWorlds (List.replicate avs.length .shared) values = + Sim.rootsFor .shared values := + rootsForWorlds_replicate_eq_rootsFor .shared hvaluesLength + have hownApply : Sim.RootOwnership before + (⟨.shared, functionValue⟩ :: Sim.rootsFor .shared values ++ + (outRoots ++ rest)) := by + apply hownArgs.perm + simpa [hroots, List.append_assoc] using + (permExtractRoot ⟨.shared, functionValue⟩ + (Sim.rootsForWorlds (List.replicate avs.length .shared) values ++ + outRoots) [] rest) + have henvFrame : Sim.RootsGraph funRel before + (entrySourceRoots output.entries sourceOutput) outRoots := + houtput.entries.rootsGraphExact + have hcombinedFrame : Sim.RootsGraph funRel before + (entrySourceRoots output.entries sourceOutput ++ sourceRest) + (outRoots ++ rest) := + henvFrame.append hrestGraph + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [hfunctionFinal.resolveAtom, bindOk, havs.resolveAtoms, bindOk] + at hrun + obtain ⟨allowance, happlyCost, happlyFunded⟩ := + hcost.preserves hfuel horder + (by simpa using hfunctionGraph) hvalueGraphs hsource + hcombinedFrame hownApply hnonempty hrun + exact ⟨hsemantic, + ⟨allowance, + OpOwnershipRunCost.apply henv hfunctionFinal.resolveAtom + havs.resolveAtoms happlyCost, + happlyFunded⟩⟩ + +/-- Profiled argument lowering while framing an already-produced function, +followed by one exact source-funded higher-order application. -/ +theorem LowerArgsProfileSound.apply_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {emit : Emit} {avs : List AVal} {function : AVal} + {argsProfile applyProfile : SourceProfile} + (hargs : LowerArgsProfileSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceArgs + (List.replicate avs.length .shared) emit avs argsProfile) + (hfunctionStable : AValStable function) + (hownership : Sim.ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hcost : ApplyProfileContract funRel sourceCtx ctx) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceArgs + sourceResult applyProfile) + (hnonempty : sourceArgs ≠ []) : + ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSound ctx cur + (emit ∘ emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (GraphOwnsResultProtected funRel recSelfRel input sourceInput + sourceFunction .shared function sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult .shared (.slotA output.depth) + sourceRest rest slots) + (argsProfile + applyProfile) := by + intro sourceRest rest slots + intro continuation continuationProfile fuel before after env value horder + henv hpre hrun hcontinuation + obtain ⟨⟨envRoots, functionValue, hinput, hfunction, + hfunctionGraph, hrestGraph, hownFunction⟩, hslots⟩ := hpre + let functionRoot : Sim.Root := ⟨.shared, functionValue⟩ + have hfunctionWorld : Sim.HasWorld before .shared functionValue := + hownFunction.roots_world functionRoot (by simp [functionRoot]) + have hframeGraph : Sim.RootsGraph funRel before + ((.shared, sourceFunction) :: sourceRest) (functionRoot :: rest) := + .cons rfl hfunctionWorld hfunctionGraph hrestGraph + have hfunctionProtection : + SlotsRealize input env (aValProtection function functionValue) := + hfunctionStable.protection_realized hfunction + have hargsOwn : Sim.RootOwnership before + (envRoots ++ functionRoot :: rest) := by + apply hownFunction.perm + simpa [functionRoot] using + (permExtractRoot functionRoot envRoots [] rest).symm + have hargsPre : GraphOwnsVEnvProtected funRel recSelfRel input + sourceInput ((.shared, sourceFunction) :: sourceRest) + (functionRoot :: rest) + (aValProtection function functionValue ++ slots) before env := + ⟨⟨envRoots, hinput, hframeGraph, hargsOwn⟩, + hfunctionProtection.append hslots⟩ + have happly : ProfileFundedEmitStateRunSound ctx cur + (emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (GraphOwnsArgsResultProtected funRel recSelfRel output + sourceOutput sourceArgs (List.replicate avs.length .shared) avs + ((.shared, sourceFunction) :: sourceRest) (functionRoot :: rest) + (aValProtection function functionValue ++ slots)) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult .shared (.slotA output.depth) sourceRest rest slots) + applyProfile := by + dsimp only [functionRoot] + exact apply_graph_profile_op + (funRel := funRel) (recSelfRel := recSelfRel) + (sourceCtx := sourceCtx) (ctx := ctx) (cur := cur) + (functionInput := input) (output := output) + (functionEnv := env) (sourceOutput := sourceOutput) + (sourceArgs := sourceArgs) (sourceFunction := sourceFunction) + (sourceResult := sourceResult) (avs := avs) + (function := function) (functionValue := functionValue) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + (profile := applyProfile) hfunctionStable hfunction hownership + hvalue hcost hsource hnonempty + have hrunCost : ProfileFundedCodeRun ctx fuel cur before env + ((emit ∘ emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) continuation) + after value (argsProfile + (applyProfile + continuationProfile)) := by + exact (hargs.profileEmits + ((.shared, sourceFunction) :: sourceRest) (functionRoot :: rest) + (aValProtection function functionValue ++ slots)) + horder henv hargsPre hrun (by + intro restFuel restBefore restEnv hrestOrder hrestBounds hargsPost + hrestRun + exact happly hrestOrder hrestBounds hargsPost hrestRun + hcontinuation) + exact ProfileFundedCodeRun.of_profile_eq hrunCost + (IxIR0.DynamicCost.Profile.add_assoc + argsProfile applyProfile continuationProfile).symm + +/-- Fuel-bounded profiled argument lowering while framing an +already-produced function, followed by one exact source-funded dynamic +application. -/ +theorem LowerArgsProfileSoundBelow.apply_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {emit : Emit} {avs : List AVal} {function : AVal} + {argsProfile applyProfile : SourceProfile} + (hargs : LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceArgs + (List.replicate avs.length .shared) emit avs argsProfile) + (hfunctionStable : AValStable function) + (hownership : Sim.ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hcost : ApplyProfileContractBelow funRel sourceCtx ctx limit) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceArgs + sourceResult applyProfile) + (hnonempty : sourceArgs ≠ []) : + ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emit ∘ emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (GraphOwnsResultProtected funRel recSelfRel input sourceInput + sourceFunction .shared function sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult .shared (.slotA output.depth) + sourceRest rest slots) + (argsProfile + applyProfile) := by + intro sourceRest rest slots + intro bound hbound continuation continuationProfile fuel before after env + value hfuel horder henv hpre hrun hcontinuation + obtain ⟨⟨envRoots, functionValue, hinput, hfunction, + hfunctionGraph, hrestGraph, hownFunction⟩, hslots⟩ := hpre + let functionRoot : Sim.Root := ⟨.shared, functionValue⟩ + have hfunctionWorld : Sim.HasWorld before .shared functionValue := + hownFunction.roots_world functionRoot (by simp [functionRoot]) + have hframeGraph : Sim.RootsGraph funRel before + ((.shared, sourceFunction) :: sourceRest) (functionRoot :: rest) := + .cons rfl hfunctionWorld hfunctionGraph hrestGraph + have hfunctionProtection : + SlotsRealize input env (aValProtection function functionValue) := + hfunctionStable.protection_realized hfunction + have hargsOwn : Sim.RootOwnership before + (envRoots ++ functionRoot :: rest) := by + apply hownFunction.perm + simpa [functionRoot] using + (permExtractRoot functionRoot envRoots [] rest).symm + have hargsPre : GraphOwnsVEnvProtected funRel recSelfRel input + sourceInput ((.shared, sourceFunction) :: sourceRest) + (functionRoot :: rest) + (aValProtection function functionValue ++ slots) before env := + ⟨⟨envRoots, hinput, hframeGraph, hargsOwn⟩, + hfunctionProtection.append hslots⟩ + have happly : ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (GraphOwnsArgsResultProtected funRel recSelfRel output + sourceOutput sourceArgs (List.replicate avs.length .shared) avs + ((.shared, sourceFunction) :: sourceRest) (functionRoot :: rest) + (aValProtection function functionValue ++ slots)) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult .shared (.slotA output.depth) sourceRest rest slots) + applyProfile := by + dsimp only [functionRoot] + exact apply_graph_profile_op_below + (funRel := funRel) (recSelfRel := recSelfRel) + (sourceCtx := sourceCtx) (ctx := ctx) (cur := cur) + (limit := limit) (functionInput := input) (output := output) + (functionEnv := env) (sourceOutput := sourceOutput) + (sourceArgs := sourceArgs) (sourceFunction := sourceFunction) + (sourceResult := sourceResult) (avs := avs) + (function := function) (functionValue := functionValue) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + (profile := applyProfile) hfunctionStable hfunction hownership + hvalue hcost hsource hnonempty + have hrunCost : ProfileFundedCodeRun ctx fuel cur before env + ((emit ∘ emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) continuation) + after value (argsProfile + (applyProfile + continuationProfile)) := by + exact (hargs.profileEmits + ((.shared, sourceFunction) :: sourceRest) (functionRoot :: rest) + (aValProtection function functionValue ++ slots)) + bound hbound hfuel horder henv hargsPre hrun (by + intro restFuel restBefore restEnv hrestFuel hrestOrder hrestBounds + hargsPost hrestRun + exact happly bound hbound hrestFuel hrestOrder hrestBounds hargsPost + hrestRun hcontinuation) + exact ProfileFundedCodeRun.of_profile_eq hrunCost + (IxIR0.DynamicCost.Profile.add_assoc + argsProfile applyProfile continuationProfile).symm + +/-- Full profiled non-erased application: produce the function, evaluate +shared arguments left-to-right, and consume the exact profiled source apply +chain through target `apply`. -/ +theorem LowerResultProfileSound.applyArgs_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {start input output : VEnv} + {sourceStart sourceMiddle sourceOutput sourceArgs : + List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {emitFunction emitArgs : Emit} {function : AVal} {avs : List AVal} + {functionProfile argsProfile applyProfile : SourceProfile} + (hfunction : LowerResultProfileSound funRel recSelfRel ctx cur + start input sourceStart sourceMiddle sourceFunction .shared + emitFunction function functionProfile) + (hargs : LowerArgsProfileSound funRel recSelfRel ctx cur + input output sourceMiddle sourceOutput sourceArgs + (List.replicate avs.length .shared) emitArgs avs argsProfile) + (hownership : Sim.ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hcost : ApplyProfileContract funRel sourceCtx ctx) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceArgs + sourceResult applyProfile) + (hnonempty : sourceArgs ≠ []) : + LowerResultProfileSound funRel recSelfRel ctx cur + start output.bump sourceStart sourceOutput sourceResult .shared + ((emitFunction ∘ emitArgs) ∘ + emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) + (functionProfile + argsProfile + applyProfile) := by + refine + { toLowerResultValueSound := + hfunction.toLowerResultValueSound.applyArgs_graph + hargs.toLowerArgsValueSound hownership hvalue + hsource.toSourceApplies + profileEmits := ?_ } + intro sourceRest rest slots + intro continuation continuationProfile fuel before after env value horder + henv hpre hrun hcontinuation + have hcomposed : ProfileFundedEmitStateRunSound ctx cur + (emitFunction ∘ (emitArgs ∘ + emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray))) + (GraphOwnsVEnvProtected funRel recSelfRel start sourceStart + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult .shared (.slotA output.depth) sourceRest rest slots) + (functionProfile + (argsProfile + applyProfile)) := + ProfileFundedEmitStateRunSound.comp + (hfunction.profileEmits sourceRest rest slots) + (hargs.apply_graph hfunction.stable hownership hvalue hcost hsource + hnonempty sourceRest rest slots) + have hcostRun := hcomposed horder henv hpre hrun hcontinuation + apply ProfileFundedCodeRun.of_profile_eq hcostRun + exact congrArg (fun profile => profile + continuationProfile) + (IxIR0.DynamicCost.Profile.add_assoc + functionProfile argsProfile applyProfile).symm + +/-- Fuel-bounded full non-erased application: function prefix, strict +arguments, and the recursive target `apply` operation share one target-fuel +ceiling. -/ +theorem LowerResultProfileSoundBelow.applyArgs_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {start input output : VEnv} + {sourceStart sourceMiddle sourceOutput sourceArgs : + List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {emitFunction emitArgs : Emit} {function : AVal} {avs : List AVal} + {functionProfile argsProfile applyProfile : SourceProfile} + (hfunction : LowerResultProfileSoundBelow funRel recSelfRel ctx cur + limit start input sourceStart sourceMiddle sourceFunction .shared + emitFunction function functionProfile) + (hargs : LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceMiddle sourceOutput sourceArgs + (List.replicate avs.length .shared) emitArgs avs argsProfile) + (hownership : Sim.ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hcost : ApplyProfileContractBelow funRel sourceCtx ctx limit) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceArgs + sourceResult applyProfile) + (hnonempty : sourceArgs ≠ []) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit start + output.bump sourceStart sourceOutput sourceResult .shared + ((emitFunction ∘ emitArgs) ∘ + emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) + (functionProfile + argsProfile + applyProfile) := by + refine + { toLowerResultValueSound := + hfunction.toLowerResultValueSound.applyArgs_graph + hargs.toLowerArgsValueSound hownership hvalue + hsource.toSourceApplies + profileEmits := ?_ } + intro sourceRest rest slots + have hcomposed : ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitFunction ∘ (emitArgs ∘ + emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray))) + (GraphOwnsVEnvProtected funRel recSelfRel start sourceStart + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult .shared (.slotA output.depth) sourceRest rest slots) + (functionProfile + (argsProfile + applyProfile)) := + ProfileFundedEmitStateRunSoundBelow.comp + (hfunction.profileEmits sourceRest rest slots) + (hargs.apply_graph hfunction.stable hownership hvalue hcost hsource + hnonempty sourceRest rest slots) + exact ProfileFundedEmitStateRunSoundBelow.of_profile_eq hcomposed + (IxIR0.DynamicCost.Profile.add_assoc + functionProfile argsProfile applyProfile).symm + +/-- Forget an ownership-inert constant result at the exact semantic +boundary. The identity target prefix has zero paired ownership cost. -/ +theorem discard_const_result_profile_state + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {world : Ixon.Owned} {atom : Atom} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} {slots : List (Nat × RVal)} + (hstable : AValStable (.constA atom)) : + ProfileFundedEmitStateRunSound ctx cur (_root_.id : Emit) + (GraphOwnsResultProtected funRel recSelfRel Γ sourceEnv + sourceValue world (.constA atom) sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel Γ sourceEnv + sourceRest rest slots) 0 := by + apply ProfileFundedEmitStateRunSound.id + intro store env hpre + obtain ⟨⟨roots, value, hΓ, hav, _, hrestGraph, hown⟩, + hslots⟩ := hpre + exact ⟨⟨roots, hΓ, hrestGraph, + hown.dropNoLocation (hstable.const_noLocation hav)⟩, hslots⟩ + +/-- Drop an inert constant from the front of an argument vector without a +runtime operation or paired ownership charge. -/ +theorem discard_const_arg_profile_state + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {source : IxIR0.Value} + {sources : List IxIR0.Value} {atom : Atom} + {worlds : List Ixon.Owned} {avs : List AVal} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} {slots : List (Nat × RVal)} + (hstable : AValStable (.constA atom)) : + ProfileFundedEmitStateRunSound ctx cur (_root_.id : Emit) + (GraphOwnsArgsResultProtected funRel recSelfRel Γ sourceEnv + (source :: sources) (.shared :: worlds) (.constA atom :: avs) + sourceRest rest slots) + (GraphOwnsArgsResultProtected funRel recSelfRel Γ sourceEnv + sources worlds avs sourceRest rest slots) 0 := by + apply ProfileFundedEmitStateRunSound.id + intro store env hpre + obtain ⟨⟨roots, values, hΓ, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + cases havs with + | @cons _ _ _ _ value tailValues hav htail => + cases hvalueGraphs with + | cons _ htailGraphs => + have howned : Sim.RootOwnership store + (⟨.shared, value⟩ :: + (Sim.rootsForWorlds worlds tailValues ++ roots ++ rest)) := by + simpa [Sim.rootsForWorlds] using hown + exact ⟨⟨roots, tailValues, hΓ, htail, htailGraphs, + hrestGraph, + howned.dropNoLocation (hstable.const_noLocation hav)⟩, hslots⟩ + +/-- One slot-backed argument release uses the semantic destructive-drop +midpoint and the local zero allowance assigned to `drop`. -/ +theorem discard_slot_arg_profile_state + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {source : IxIR0.Value} + {sources : List IxIR0.Value} {abs : Nat} + {worlds : List Ixon.Owned} {avs : List AVal} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} {slots : List (Nat × RVal)} + (htailStable : AValsStable avs) : + ProfileFundedEmitStateRunSound ctx cur + (emitOp (.drop (.var (Γ.rel abs)))) + (GraphOwnsArgsResultProtected funRel recSelfRel Γ sourceEnv + (source :: sources) (.shared :: worlds) (.slotA abs :: avs) + sourceRest rest slots) + (GraphOwnsArgsResultProtected funRel recSelfRel Γ.bump sourceEnv + sources worlds avs sourceRest rest slots) 0 := by + apply ProfileFundedEmitStateRunSound.localZero + · exact discard_slot_arg_value_op htailStable + · simp [localOpOwnershipAllowance] + +/-- Re-introduce the erased scalar result after an absorbed application has +released all temporary argument owners. -/ +theorem erased_result_profile_state + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {world : Ixon.Owned} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} {slots : List (Nat × RVal)} : + ProfileFundedEmitStateRunSound ctx cur (_root_.id : Emit) + (GraphOwnsVEnvProtected funRel recSelfRel Γ sourceEnv + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel Γ sourceEnv .erased + world (.constA .erased) sourceRest rest slots) 0 := by + apply ProfileFundedEmitStateRunSound.id + intro store env hpre + obtain ⟨⟨roots, hΓ, hrestGraph, hown⟩, hslots⟩ := hpre + exact ⟨⟨roots, .erased, hΓ, .const rfl, .erased, hrestGraph, + hown.addNoLocation rfl⟩, hslots⟩ + +/-- At a fixed target-fuel ceiling, forget an ownership-inert constant result at the exact semantic +boundary. The identity target prefix has zero paired ownership cost. -/ +theorem discard_const_result_profile_state_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {world : Ixon.Owned} {atom : Atom} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} {slots : List (Nat × RVal)} + (hstable : AValStable (.constA atom)) : + ProfileFundedEmitStateRunSoundBelow ctx cur limit (_root_.id : Emit) + (GraphOwnsResultProtected funRel recSelfRel Γ sourceEnv + sourceValue world (.constA atom) sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel Γ sourceEnv + sourceRest rest slots) 0 := by + apply ProfileFundedEmitStateRunSoundBelow.id + intro store env hpre + obtain ⟨⟨roots, value, hΓ, hav, _, hrestGraph, hown⟩, + hslots⟩ := hpre + exact ⟨⟨roots, hΓ, hrestGraph, + hown.dropNoLocation (hstable.const_noLocation hav)⟩, hslots⟩ + +/-- Drop an inert constant from the front of an argument vector without a +runtime operation or paired ownership charge. -/ +theorem discard_const_arg_profile_state_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {source : IxIR0.Value} + {sources : List IxIR0.Value} {atom : Atom} + {worlds : List Ixon.Owned} {avs : List AVal} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} {slots : List (Nat × RVal)} + (hstable : AValStable (.constA atom)) : + ProfileFundedEmitStateRunSoundBelow ctx cur limit (_root_.id : Emit) + (GraphOwnsArgsResultProtected funRel recSelfRel Γ sourceEnv + (source :: sources) (.shared :: worlds) (.constA atom :: avs) + sourceRest rest slots) + (GraphOwnsArgsResultProtected funRel recSelfRel Γ sourceEnv + sources worlds avs sourceRest rest slots) 0 := by + apply ProfileFundedEmitStateRunSoundBelow.id + intro store env hpre + obtain ⟨⟨roots, values, hΓ, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + cases havs with + | @cons _ _ _ _ value tailValues hav htail => + cases hvalueGraphs with + | cons _ htailGraphs => + have howned : Sim.RootOwnership store + (⟨.shared, value⟩ :: + (Sim.rootsForWorlds worlds tailValues ++ roots ++ rest)) := by + simpa [Sim.rootsForWorlds] using hown + exact ⟨⟨roots, tailValues, hΓ, htail, htailGraphs, + hrestGraph, + howned.dropNoLocation (hstable.const_noLocation hav)⟩, hslots⟩ + +/-- One slot-backed argument release uses the semantic destructive-drop +midpoint and the local zero allowance assigned to `drop`. -/ +theorem discard_slot_arg_profile_state_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {source : IxIR0.Value} + {sources : List IxIR0.Value} {abs : Nat} + {worlds : List Ixon.Owned} {avs : List AVal} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} {slots : List (Nat × RVal)} + (htailStable : AValsStable avs) : + ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.drop (.var (Γ.rel abs)))) + (GraphOwnsArgsResultProtected funRel recSelfRel Γ sourceEnv + (source :: sources) (.shared :: worlds) (.slotA abs :: avs) + sourceRest rest slots) + (GraphOwnsArgsResultProtected funRel recSelfRel Γ.bump sourceEnv + sources worlds avs sourceRest rest slots) 0 := by + apply ProfileFundedEmitStateRunSoundBelow.localZero + · exact discard_slot_arg_value_op htailStable + · simp [localOpOwnershipAllowance] + +/-- Single bounded induction for releasing a stable shared argument vector. +Source-length inversion, slot/literal/erased dispatch, environment threading, +and zero-profile emitter composition are independent of whether the caller +needs an exact or target-fuel-bounded interface. -/ +private theorem releaseAll_profile_state_sound_at + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv sourceValues : List IxIR0.Value} {avs : List AVal} + (hstable : AValsStable avs) + (hsourceLength : sourceValues.length = avs.length) + (profile : SourceProfile) : + ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSoundBelow ctx cur limit (releaseAll Γ avs).2 + (GraphOwnsArgsResultProtected funRel recSelfRel Γ sourceEnv + sourceValues (List.replicate avs.length .shared) avs + sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel (releaseAll Γ avs).1 + sourceEnv sourceRest rest slots) profile := by + intro sourceRest rest slots + apply ProfileFundedEmitStateRunSoundBelow.monoProfile + (smaller := 0) (larger := profile) + · exact AValsStable.traverseAligned + (Result := fun current currentSources currentAvs => + ProfileFundedEmitStateRunSoundBelow ctx cur limit + (releaseAll current currentAvs).2 + (GraphOwnsArgsResultProtected funRel recSelfRel current sourceEnv + currentSources (List.replicate currentAvs.length .shared) + currentAvs sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel + (releaseAll current currentAvs).1 sourceEnv sourceRest rest slots) + 0) + (hnil := by + intro current + change ProfileFundedEmitStateRunSoundBelow ctx cur limit + (_root_.id : Emit) + (GraphOwnsArgsResultProtected funRel recSelfRel current + sourceEnv [] [] [] sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel current sourceEnv + sourceRest rest slots) 0 + apply ProfileFundedEmitStateRunSoundBelow.id + intro store env hpre + obtain ⟨⟨roots, values, hcurrent, havs, hgraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + cases havs + cases hgraphs + exact ⟨⟨roots, hcurrent, hrestGraph, + by simpa [Sim.rootsForWorlds] using hown⟩, hslots⟩) + (hslot := by + intro current source sources abs currentAvs htail ih + change ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.drop (.var (current.rel abs))) ∘ + (releaseAll current.bump currentAvs).2) + (GraphOwnsArgsResultProtected funRel recSelfRel current + sourceEnv (source :: sources) + (.shared :: List.replicate currentAvs.length .shared) + (.slotA abs :: currentAvs) sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel + (releaseAll current.bump currentAvs).1 sourceEnv sourceRest rest + slots) 0 + apply ProfileFundedEmitStateRunSoundBelow.of_profile_eq + (ProfileFundedEmitStateRunSoundBelow.comp + (discard_slot_arg_profile_state_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := current) + (sourceEnv := sourceEnv) (source := source) + (sources := sources) (abs := abs) + (worlds := List.replicate currentAvs.length .shared) + (avs := currentAvs) (sourceRest := sourceRest) (rest := rest) + (slots := slots) htail) + ih) + exact IxIR0.DynamicCost.Profile.zero_add 0) + (hlit := by + intro current source sources literal currentAvs htail ih + change ProfileFundedEmitStateRunSoundBelow ctx cur limit + ((_root_.id : Emit) ∘ (releaseAll current currentAvs).2) + (GraphOwnsArgsResultProtected funRel recSelfRel current + sourceEnv (source :: sources) + (.shared :: List.replicate currentAvs.length .shared) + (.constA (.lit literal) :: currentAvs) sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel + (releaseAll current currentAvs).1 sourceEnv sourceRest rest slots) + 0 + apply ProfileFundedEmitStateRunSoundBelow.of_profile_eq + (ProfileFundedEmitStateRunSoundBelow.comp + (discard_const_arg_profile_state_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := current) + (sourceEnv := sourceEnv) (source := source) + (sources := sources) (atom := .lit literal) + (worlds := List.replicate currentAvs.length .shared) + (avs := currentAvs) (sourceRest := sourceRest) (rest := rest) + (slots := slots) .lit) + ih) + exact IxIR0.DynamicCost.Profile.zero_add 0) + (herased := by + intro current source sources currentAvs htail ih + change ProfileFundedEmitStateRunSoundBelow ctx cur limit + ((_root_.id : Emit) ∘ (releaseAll current currentAvs).2) + (GraphOwnsArgsResultProtected funRel recSelfRel current + sourceEnv (source :: sources) + (.shared :: List.replicate currentAvs.length .shared) + (.constA .erased :: currentAvs) sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel + (releaseAll current currentAvs).1 sourceEnv sourceRest rest slots) + 0 + apply ProfileFundedEmitStateRunSoundBelow.of_profile_eq + (ProfileFundedEmitStateRunSoundBelow.comp + (discard_const_arg_profile_state_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := current) + (sourceEnv := sourceEnv) (source := source) + (sources := sources) (atom := .erased) + (worlds := List.replicate currentAvs.length .shared) + (avs := currentAvs) (sourceRest := sourceRest) (rest := rest) + (slots := slots) .erased) + ih) + exact IxIR0.DynamicCost.Profile.zero_add 0) + (hstable := hstable) (hlength := hsourceLength) + · exact zeroOwnershipAllowance_le_profile profile + +/-- Releasing a complete shared argument vector preserves the semantic +environment/frame boundary. Its destructive drops are amortized at zero, and +the exact interface is recovered uniformly from the bounded induction. -/ +theorem releaseAll_profile_state_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv sourceValues : List IxIR0.Value} {avs : List AVal} + (hstable : AValsStable avs) + (hsourceLength : sourceValues.length = avs.length) + (profile : SourceProfile) : + ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSound ctx cur (releaseAll Γ avs).2 + (GraphOwnsArgsResultProtected funRel recSelfRel Γ sourceEnv + sourceValues (List.replicate avs.length .shared) avs + sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel (releaseAll Γ avs).1 + sourceEnv sourceRest rest slots) profile := by + intro sourceRest rest slots + apply ProfileFundedEmitStateRunSound.of_below + intro limit + exact releaseAll_profile_state_sound_at + (limit := limit) hstable hsourceLength profile sourceRest rest slots + +/-- Target-fuel-bounded public interface for stable shared-argument release. -/ +theorem releaseAll_profile_state_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv sourceValues : List IxIR0.Value} {avs : List AVal} + (hstable : AValsStable avs) + (hsourceLength : sourceValues.length = avs.length) + (profile : SourceProfile) : + ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSoundBelow ctx cur limit (releaseAll Γ avs).2 + (GraphOwnsArgsResultProtected funRel recSelfRel Γ sourceEnv + sourceValues (List.replicate avs.length .shared) avs + sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel (releaseAll Γ avs).1 + sourceEnv sourceRest rest slots) profile := by + exact releaseAll_profile_state_sound_at hstable hsourceLength profile + +/-- Re-introduce the erased scalar result after an absorbed application has +released all temporary argument owners. -/ +theorem erased_result_profile_state_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {world : Ixon.Owned} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} {slots : List (Nat × RVal)} : + ProfileFundedEmitStateRunSoundBelow ctx cur limit (_root_.id : Emit) + (GraphOwnsVEnvProtected funRel recSelfRel Γ sourceEnv + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel Γ sourceEnv .erased + world (.constA .erased) sourceRest rest slots) 0 := by + apply ProfileFundedEmitStateRunSoundBelow.id + intro store env hpre + obtain ⟨⟨roots, hΓ, hrestGraph, hown⟩, hslots⟩ := hpre + exact ⟨⟨roots, .erased, hΓ, .const rfl, .erased, hrestGraph, + hown.addNoLocation rfl⟩, hslots⟩ + +/-- Profiled erased-function application. Arguments remain strict, their +temporary shared owners are released at zero amortized target cost, and the +source apply-chain profile conservatively funds that release suffix. -/ +theorem LowerResultProfileSound.discardArgs + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {start input output : VEnv} + {sourceStart sourceMiddle sourceOutput sourceValues : + List IxIR0.Value} + {resultWorld : Ixon.Owned} {emitFunction emitArgs : Emit} + {avs : List AVal} + {functionProfile argsProfile applyProfile : SourceProfile} + (hfunction : LowerResultProfileSound funRel recSelfRel ctx cur + start input sourceStart sourceMiddle .erased .shared + emitFunction (.constA .erased) functionProfile) + (hargs : LowerArgsProfileSound funRel recSelfRel ctx cur input output + sourceMiddle sourceOutput sourceValues + (List.replicate avs.length .shared) emitArgs avs argsProfile) + (hsourceLength : sourceValues.length = avs.length) : + LowerResultProfileSound funRel recSelfRel ctx cur start + (releaseAll output avs).1 sourceStart sourceOutput .erased + resultWorld + ((emitFunction ∘ emitArgs) ∘ (releaseAll output avs).2) + (.constA .erased) + (functionProfile + argsProfile + applyProfile) := by + refine + { toLowerResultValueSound := + hfunction.toLowerResultValueSound.discardArgs + hargs.toLowerArgsValueSound hsourceLength + profileEmits := ?_ } + intro sourceRest rest slots + intro continuation continuationProfile fuel before after env value horder + henv hpre hrun hcontinuation + have hall : ProfileFundedEmitStateRunSound ctx cur + (emitFunction ∘ ((_root_.id : Emit) ∘ + (emitArgs ∘ ((releaseAll output avs).2 ∘ + (_root_.id : Emit))))) + (GraphOwnsVEnvProtected funRel recSelfRel start sourceStart + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel + (releaseAll output avs).1 sourceOutput .erased resultWorld + (.constA .erased) sourceRest rest slots) + (functionProfile + (0 + (argsProfile + (applyProfile + 0)))) := + ProfileFundedEmitStateRunSound.comp + (hfunction.profileEmits sourceRest rest slots) + (ProfileFundedEmitStateRunSound.comp + (discard_const_result_profile_state + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := input) + (sourceEnv := sourceMiddle) (sourceValue := .erased) + (world := .shared) (atom := .erased) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + .erased) + (ProfileFundedEmitStateRunSound.comp + (hargs.profileEmits sourceRest rest slots) + (ProfileFundedEmitStateRunSound.comp + (releaseAll_profile_state_sound hargs.stable hsourceLength + applyProfile sourceRest rest slots) + (erased_result_profile_state + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) + (Γ := (releaseAll output avs).1) + (sourceEnv := sourceOutput) (world := resultWorld) + (sourceRest := sourceRest) (rest := rest) + (slots := slots))))) + have hcostRun := hall horder henv hpre (by + simpa [Function.comp_def] using hrun) hcontinuation + apply ProfileFundedCodeRun.of_profile_eq hcostRun + apply congrArg (fun profile => profile + continuationProfile) + ext <;> simp <;> omega + +/-- Fuel-bounded profiled erased-function application. Arguments remain strict, their +temporary shared owners are released at zero amortized target cost, and the +source apply-chain profile conservatively funds that release suffix. -/ +theorem LowerResultProfileSoundBelow.discardArgs + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {start input output : VEnv} + {sourceStart sourceMiddle sourceOutput sourceValues : + List IxIR0.Value} + {resultWorld : Ixon.Owned} {emitFunction emitArgs : Emit} + {avs : List AVal} + {functionProfile argsProfile applyProfile : SourceProfile} + (hfunction : LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit + start input sourceStart sourceMiddle .erased .shared + emitFunction (.constA .erased) functionProfile) + (hargs : LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceMiddle sourceOutput sourceValues + (List.replicate avs.length .shared) emitArgs avs argsProfile) + (hsourceLength : sourceValues.length = avs.length) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit start + (releaseAll output avs).1 sourceStart sourceOutput .erased + resultWorld + ((emitFunction ∘ emitArgs) ∘ (releaseAll output avs).2) + (.constA .erased) + (functionProfile + argsProfile + applyProfile) := by + refine + { toLowerResultValueSound := + hfunction.toLowerResultValueSound.discardArgs + hargs.toLowerArgsValueSound hsourceLength + profileEmits := ?_ } + intro sourceRest rest slots + intro bound hbound continuation continuationProfile fuel before after env + value hfuel horder henv hpre hrun hcontinuation + have hall : ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitFunction ∘ ((_root_.id : Emit) ∘ + (emitArgs ∘ ((releaseAll output avs).2 ∘ + (_root_.id : Emit))))) + (GraphOwnsVEnvProtected funRel recSelfRel start sourceStart + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel + (releaseAll output avs).1 sourceOutput .erased resultWorld + (.constA .erased) sourceRest rest slots) + (functionProfile + (0 + (argsProfile + (applyProfile + 0)))) := + ProfileFundedEmitStateRunSoundBelow.comp + (hfunction.profileEmits sourceRest rest slots) + (ProfileFundedEmitStateRunSoundBelow.comp + (discard_const_result_profile_state_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := input) + (sourceEnv := sourceMiddle) (sourceValue := .erased) + (world := .shared) (atom := .erased) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + .erased) + (ProfileFundedEmitStateRunSoundBelow.comp + (hargs.profileEmits sourceRest rest slots) + (ProfileFundedEmitStateRunSoundBelow.comp + (releaseAll_profile_state_sound_below hargs.stable hsourceLength + applyProfile sourceRest rest slots) + (erased_result_profile_state_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) + (Γ := (releaseAll output avs).1) + (sourceEnv := sourceOutput) (world := resultWorld) + (sourceRest := sourceRest) (rest := rest) + (slots := slots))))) + have hcostRun := hall bound hbound hfuel horder henv hpre (by + simpa [Function.comp_def] using hrun) hcontinuation + apply ProfileFundedCodeRun.of_profile_eq hcostRun + apply congrArg (fun profile => profile + continuationProfile) + ext <;> simp <;> omega + +/-- Canonical cost decomposition of a flattened source application spine: +head evaluation, argument evaluations, then entered applications. Profile +addition is commutative, so this canonical compiler order is propositionally +equal to the source evaluator's nested order. The existential cost split is +kept proof-irrelevant, just as in `SourceSpineEval`. -/ +inductive SourceSpineProfile (sourceCtx : IxIR0.Ctx) + (sourceEnv : List IxIR0.Value) (head : IxIR0.Expr) + (arguments : List IxIR0.Expr) (sourceResult : IxIR0.Value) + (profile : SourceProfile) : Prop where + | intro {headValue : IxIR0.Value} + {argumentValues : List IxIR0.Value} + {headProfile argumentProfile applyProfile : SourceProfile} : + (∃ fuel, IxIR0.DynamicCost.Eval sourceCtx fuel sourceEnv head + headValue headProfile) → + SourceArgsProfile sourceCtx sourceEnv arguments argumentValues + argumentProfile → + SourceAppliesProfile sourceCtx headValue argumentValues sourceResult + applyProfile → + headProfile + argumentProfile + applyProfile = profile → + SourceSpineProfile sourceCtx sourceEnv head arguments sourceResult + profile + +/-- Dependent eliminator for the canonical source-spine profile split. +Clients receive the exact head value, argument values, three component +profiles, and all constructor evidence while this theorem remains the sole +destruction site for the indexed wrapper. -/ +theorem SourceSpineProfile.eliminate + {sourceCtx : IxIR0.Ctx} {sourceEnv : List IxIR0.Value} + {head : IxIR0.Expr} {arguments : List IxIR0.Expr} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {Result : Prop} + (hspine : SourceSpineProfile sourceCtx sourceEnv head arguments + sourceResult profile) + (hintro : ∀ {headValue : IxIR0.Value} + {argumentValues : List IxIR0.Value} + {headProfile argumentProfile applyProfile : SourceProfile}, + (∃ fuel, IxIR0.DynamicCost.Eval sourceCtx fuel sourceEnv head + headValue headProfile) → + SourceArgsProfile sourceCtx sourceEnv arguments argumentValues + argumentProfile → + SourceAppliesProfile sourceCtx headValue argumentValues sourceResult + applyProfile → + headProfile + argumentProfile + applyProfile = profile → + Result) : + Result := by + cases hspine with + | intro hhead harguments happlies hprofile => + exact hintro hhead harguments happlies hprofile + +theorem SourceSpineProfile.toSourceSpineEval + {sourceCtx : IxIR0.Ctx} {sourceEnv : List IxIR0.Value} + {head : IxIR0.Expr} {arguments : List IxIR0.Expr} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + (hspine : SourceSpineProfile sourceCtx sourceEnv head arguments + sourceResult profile) : + SourceSpineEval sourceCtx sourceEnv head arguments sourceResult := by + apply hspine.eliminate + · intro _ _ _ _ _ hhead harguments happlies _ + obtain ⟨fuel, hcost⟩ := hhead + exact .intro ⟨fuel, hcost.run⟩ + harguments.toSourceArgsEval happlies.toSourceApplies + +/-- Expose the exact canonical profile split of a reference-headed spine. +Every source reference evaluation contributes one evaluation event, so the +head fragment is nonempty and can fund a static PAP or constructor node. -/ +theorem SourceSpineProfile.refData + {sourceCtx : IxIR0.Ctx} {sourceEnv : List IxIR0.Value} + {address : Ixon.Address} {arguments : List IxIR0.Expr} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + (hspine : SourceSpineProfile sourceCtx sourceEnv (.ref address) + arguments sourceResult profile) : + ∃ sourceFunction sourceArguments headProfile argumentProfile + applyProfile, + SourceRefValue sourceCtx address sourceFunction ∧ + SourceArgsProfile sourceCtx sourceEnv arguments sourceArguments + argumentProfile ∧ + SourceAppliesProfile sourceCtx sourceFunction sourceArguments + sourceResult applyProfile ∧ + headProfile + argumentProfile + applyProfile = profile ∧ + 0 < headProfile.evals := by + apply hspine.eliminate + · intro sourceFunction sourceArguments headProfile argumentProfile + applyProfile hhead harguments happlies hprofile + obtain ⟨fuel, hhead⟩ := hhead + refine ⟨sourceFunction, sourceArguments, headProfile, argumentProfile, + applyProfile, ⟨fuel, sourceEval_ref_closed hhead.run⟩, harguments, + happlies, hprofile, ?_⟩ + exact hhead.evals_pos + +/-- Expose the exact reference evaluation as well as its closed semantic +value. Direct calls need the former to distinguish a nullary function body, +which is evaluated by the source reference itself, from a positive-arity +body funded by source application steps. -/ +theorem SourceSpineProfile.refProfileData + {sourceCtx : IxIR0.Ctx} {sourceEnv : List IxIR0.Value} + {address : Ixon.Address} {arguments : List IxIR0.Expr} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + (hspine : SourceSpineProfile sourceCtx sourceEnv (.ref address) + arguments sourceResult profile) : + ∃ sourceFunction sourceArguments headProfile argumentProfile + applyProfile, + SourceRefValue sourceCtx address sourceFunction ∧ + SourceRefProfile sourceCtx address sourceFunction headProfile ∧ + SourceArgsProfile sourceCtx sourceEnv arguments sourceArguments + argumentProfile ∧ + SourceAppliesProfile sourceCtx sourceFunction sourceArguments + sourceResult applyProfile ∧ + headProfile + argumentProfile + applyProfile = profile ∧ + 0 < headProfile.evals := by + apply hspine.eliminate + · intro sourceFunction sourceArguments headProfile argumentProfile + applyProfile hhead harguments happlies hprofile + obtain ⟨fuel, hhead⟩ := hhead + refine ⟨sourceFunction, sourceArguments, headProfile, argumentProfile, + applyProfile, ⟨fuel, sourceEval_ref_closed hhead.run⟩, + ⟨fuel, sourceEnv, hhead⟩, harguments, happlies, hprofile, ?_⟩ + exact hhead.evals_pos + +/-- Any costed head evaluation is the corresponding empty flattened spine. -/ +theorem SourceSpineProfile.of_eval_nil + {sourceCtx : IxIR0.Ctx} {sourceFuel : Nat} + {sourceEnv : List IxIR0.Value} {head : IxIR0.Expr} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + (hcost : IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv head + sourceResult profile) : + SourceSpineProfile sourceCtx sourceEnv head [] sourceResult profile := by + refine .intro ⟨sourceFuel, hcost⟩ .nil .nil ?_ + ext <;> simp + +/-- Flatten one additional syntactic application while retaining the exact +source profile. -/ +theorem SourceSpineProfile.flattenApp + {sourceCtx : IxIR0.Ctx} {sourceEnv : List IxIR0.Value} + {function argument : IxIR0.Expr} {arguments : List IxIR0.Expr} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + (hspine : SourceSpineProfile sourceCtx sourceEnv + (.app function argument) arguments sourceResult profile) : + SourceSpineProfile sourceCtx sourceEnv function + (argument :: arguments) sourceResult profile := by + apply hspine.eliminate + · intro _ _ _ _ _ hhead harguments happlies hprofile + obtain ⟨sourceFuel, hhead⟩ := hhead + cases hhead with + | app hfunction hargument happly => + refine .intro ⟨_, hfunction⟩ (.cons hargument harguments) + (.cons happly happlies) ?_ + rw [← hprofile] + ext <;> simp [IxIR0.DynamicCost.tick] <;> omega + +/-- One costed source application is the singleton flattened spine consumed +by the compiler's expression-level `.app` branch. -/ +theorem SourceSpineProfile.of_eval_app + {sourceCtx : IxIR0.Ctx} {sourceFuel : Nat} + {sourceEnv : List IxIR0.Value} {function argument : IxIR0.Expr} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + (hcost : IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv + (.app function argument) sourceResult profile) : + SourceSpineProfile sourceCtx sourceEnv function [argument] + sourceResult profile := + (SourceSpineProfile.of_eval_nil hcost).flattenApp + +/-- Successful expression lowering funded by the exact source trace supplied +at the same compiler-fuel index. -/ +def LowerEProfilePreserves (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {world : Ixon.Owned} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {sourceProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal}, + IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv expr sourceValue + sourceProfile → + (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState → + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue world emit av sourceProfile + +/-- Successful borrowing-position lowering funded by the exact source +expression profile at one compiler-fuel index. -/ +def LowerBorrowProfilePreserves (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {sourceProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + {release : Bool}, + IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv expr sourceValue + sourceProfile → + (lowerBorrow src fuel input expr).run state = + .ok (output, emit, av, release) finalState → + LowerBorrowProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue emit av release sourceProfile + +/-- Successful argument lowering funded by the sum of its exact source +argument traces. -/ +def LowerArgsProfilePreserves (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {sourceEnv sourceValues : List IxIR0.Value} + {args : List (IxIR0.Expr × Ixon.Owned)} + {sourceProfile : SourceProfile} {state finalState : LowSt} + {emit : Emit} {avs : List AVal}, + SourceArgsProfile sourceCtx sourceEnv (args.map Prod.fst) sourceValues + sourceProfile → + (lowerArgs src fuel input args).run state = + .ok (output, emit, avs) finalState → + LowerArgsProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValues (args.map Prod.snd) emit avs + sourceProfile + +/-- No successful argument-lowering run exists at zero compiler fuel. -/ +theorem lowerArgsProfilePreserves_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) : + LowerArgsProfilePreserves funRel recSelfRel sourceCtx ctx cur src 0 := by + intro input output sourceEnv sourceValues args sourceProfile state + finalState emit avs _ hrun + simp only [lowerArgs] at hrun + exact (stateThrowRun_not_ok hrun).elim + +/-- Profile-source adapter for `lowerArgs_run_core`. Exact source-profile +inversion is shared across ordinary, bounded, and reachable clients while the +source-neutral core owns successful-run sequencing and output recovery. -/ +private theorem lowerArgs_run_profile_core + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {sourceEnv sourceValues : List IxIR0.Value} + {args : List (IxIR0.Expr × Ixon.Owned)} + {sourceProfile : SourceProfile} {state finalState : LowSt} + {emit : Emit} {avs : List AVal} + {Result : VEnv → List IxIR0.Value → List Ixon.Owned → Emit → + List AVal → SourceProfile → LowSt → Prop} + (hnil : Result input [] [] (_root_.id : Emit) [] 0 state) + (hcons : ∀ (expr : IxIR0.Expr) (world : Ixon.Owned) + (tail : List (IxIR0.Expr × Ixon.Owned)) + {sourceFuel : Nat} {sourceValue : IxIR0.Value} + {sourceTail : List IxIR0.Value} + {headProfile tailProfile : SourceProfile} + {middle actualOutput : VEnv} {emitHead emitTail : Emit} + {av : AVal} {tailAVals : List AVal} + {middleState tailState : LowSt}, + IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv expr sourceValue + headProfile → + SourceArgsProfile sourceCtx sourceEnv (tail.map Prod.fst) sourceTail + tailProfile → + (lowerE src fuel input world expr).run state = + .ok (middle, emitHead, av) middleState → + (lowerArgs src fuel middle tail).run middleState = + .ok (actualOutput, emitTail, tailAVals) tailState → + Result actualOutput (sourceValue :: sourceTail) + (world :: tail.map Prod.snd) (emitHead ∘ emitTail) + (av :: tailAVals) (headProfile + tailProfile) tailState) + (hsource : SourceArgsProfile sourceCtx sourceEnv (args.map Prod.fst) + sourceValues sourceProfile) + (hrun : (lowerArgs src (fuel + 1) input args).run state = + .ok (output, emit, avs) finalState) : + Result output sourceValues (args.map Prod.snd) emit avs sourceProfile + finalState := by + exact (lowerArgs_run_core + (Result := fun actualArgs actualOutput actualEmit actualAVals + actualState => + ∀ {actualSourceValues : List IxIR0.Value} + {actualProfile : SourceProfile}, + SourceArgsProfile sourceCtx sourceEnv (actualArgs.map Prod.fst) + actualSourceValues actualProfile → + Result actualOutput actualSourceValues (actualArgs.map Prod.snd) + actualEmit actualAVals actualProfile actualState) + (hnil := by + intro actualSourceValues actualProfile hactualSource + cases hactualSource + exact hnil) + (hcons := by + intro expr world tail middle actualOutput emitHead emitTail av + tailAVals middleState tailState hheadRun htailRun + actualSourceValues actualProfile hactualSource + change SourceArgsProfile sourceCtx sourceEnv + (expr :: tail.map Prod.fst) actualSourceValues actualProfile at hactualSource + cases hactualSource with + | cons hsourceHead hsourceTail => + exact hcons expr world tail hsourceHead hsourceTail hheadRun htailRun) + hrun) hsource + +/-- Profiled argument induction step. The source profile and executable +lowerer split in the same list order; `consArgs` supplies both the semantic +frame transport and additive exact-run cost composition. -/ +theorem lowerArgsProfilePreserves_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEProfilePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + (htail : LowerArgsProfilePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) : + LowerArgsProfilePreserves funRel recSelfRel sourceCtx ctx cur src + (fuel + 1) := by + intro input output sourceEnv sourceValues args sourceProfile state + finalState emit avs hsource hrun + exact lowerArgs_run_profile_core + (Result := fun actualOutput actualSourceValues worlds actualEmit + actualAVals actualProfile _ => + LowerArgsProfileSound funRel recSelfRel ctx cur input actualOutput + sourceEnv sourceEnv actualSourceValues worlds actualEmit actualAVals + actualProfile) + (hnil := lowerArgs_nil_profile_sound) + (hcons := by + intro _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ hsourceHead + hsourceTail hheadRun htailRun + exact (hexpr hsourceHead hheadRun).consArgs + (htail hsourceTail htailRun)) + hsource hrun + +/-- Argument-profile preservation at arbitrary compiler fuel follows from +all strictly smaller expression hypotheses. -/ +theorem lowerArgsProfilePreserves_of_expr + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} (fuel : Nat) + (hexpr : ∀ prior, prior < fuel → + LowerEProfilePreserves funRel recSelfRel sourceCtx ctx cur src prior) : + LowerArgsProfilePreserves funRel recSelfRel sourceCtx ctx cur src + fuel := + lowerArgsPreserves_of_expr_core + (Expr := LowerEProfilePreserves funRel recSelfRel sourceCtx ctx cur src) + (Args := LowerArgsProfilePreserves funRel recSelfRel sourceCtx ctx cur + src) + (hzero := lowerArgsProfilePreserves_zero src) + (hsucc := fun hexpr htail => + lowerArgsProfilePreserves_succ hexpr htail) + fuel hexpr + +/-- Dropping a strict prefix from a genuinely longer list leaves at least +one argument. This is the compiler-side reachability fact used by every +over-application path. -/ +theorem drop_nonempty_of_lt_length {α : Type} {xs : List α} {count : Nat} + (hcount : count < xs.length) : xs.drop count ≠ [] := by + intro hnil + have hlength := congrArg List.length hnil + simp only [List.length_drop, List.length_nil] at hlength + omega + +/-- Profile preservation for the genuine non-erased `applyRest` branch. +The already-produced function profile, strict argument profile, and source +apply-chain profile are retained as the compiler's three execution phases. -/ +def ApplyRestNonErasedProfilePreserves (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {start input output : VEnv} + {sourceStart sourceMiddle sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {resultWorld : Ixon.Owned} {emitFunction emit : Emit} + {function av : AVal} {args : List IxIR0.Expr} + {functionProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt}, + function ≠ .constA .erased → + args ≠ [] → + SourceArgsProfile sourceCtx sourceMiddle args sourceArgs argsProfile → + SourceAppliesProfile sourceCtx sourceFunction sourceArgs sourceResult + applyProfile → + LowerResultProfileSound funRel recSelfRel ctx cur start input + sourceStart sourceMiddle sourceFunction .shared emitFunction function + functionProfile → + (applyRest src fuel input resultWorld emitFunction function args).run + state = .ok (output, emit, av) finalState → + LowerResultProfileSound funRel recSelfRel ctx cur start output + sourceStart sourceMiddle sourceResult resultWorld emit av + (functionProfile + argsProfile + applyProfile) + +/-- Profile-source adapter for `applyRest_nonErased_run_core`. Exact source +profiling and source-argument nonemptiness are recovered once, while exact, +bounded, and reachable clients retain only their argument and application +composition judgments. -/ +private theorem applyRest_nonErased_run_profile_core + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {sourceMiddle sourceArgs : List IxIR0.Value} + {resultWorld : Ixon.Owned} {pre emit : Emit} {function av : AVal} + {args : List IxIR0.Expr} {argsProfile : SourceProfile} + {state finalState : LowSt} + {Result : Ixon.Owned → VEnv → Emit → AVal → LowSt → Prop} + (hfinish : ∀ (argsOutput : VEnv) (emitArgs : Emit) + (avs : List AVal) (argsState : LowSt), + SourceArgsProfile sourceCtx sourceMiddle + ((args.map (fun arg => (arg, Ixon.Owned.shared))).map Prod.fst) + sourceArgs argsProfile → + sourceArgs ≠ [] → + (lowerArgs src fuel input + (args.map (fun arg => (arg, Ixon.Owned.shared)))).run state = + .ok (argsOutput, emitArgs, avs) argsState → + ((args.map (fun arg => (arg, Ixon.Owned.shared))).map Prod.snd) = + List.replicate avs.length .shared → + Result .shared argsOutput.bump + ((pre ∘ emitArgs) ∘ + emitOp (.apply (function.toAtom argsOutput) + (avs.map (·.toAtom argsOutput)).toArray)) + (.slotA argsOutput.depth) argsState) + (hfunctionNe : function ≠ .constA .erased) + (hargsNonempty : args ≠ []) + (hsourceArgs : SourceArgsProfile sourceCtx sourceMiddle args sourceArgs + argsProfile) + (hrun : (applyRest src (fuel + 1) input resultWorld pre function + args).run state = .ok (output, emit, av) finalState) : + Result resultWorld output emit av finalState := by + exact applyRest_nonErased_run_core + (Result := Result) + (hfinish := fun argsOutput emitArgs avs argsState hargsRun + hworldsHomogeneous => by + have hsourcePaired : SourceArgsProfile sourceCtx sourceMiddle + ((args.map (fun arg => (arg, Ixon.Owned.shared))).map Prod.fst) + sourceArgs argsProfile := by + simpa [Function.comp_def] using hsourceArgs + have hsourceNonempty : sourceArgs ≠ [] := by + intro hnil + apply hargsNonempty + exact List.eq_nil_of_length_eq_zero (by + rw [hsourceArgs.lengths, hnil] + rfl) + exact hfinish argsOutput emitArgs avs argsState hsourcePaired + hsourceNonempty hargsRun hworldsHomogeneous) + hfunctionNe hrun + +/-- Exact inversion of a successful non-erased `applyRest` run, combining +profiled argument lowering with the semantic, ownership, and cost contracts +for dynamic application. -/ +theorem applyRest_nonErased_run_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsProfilePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + (hownership : Sim.ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hcost : ApplyProfileContract funRel sourceCtx ctx) + {start input output : VEnv} + {sourceStart sourceMiddle sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {resultWorld : Ixon.Owned} {emitFunction emit : Emit} + {function av : AVal} {args : List IxIR0.Expr} + {functionProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} + (hfunctionNe : function ≠ .constA .erased) + (hargsNonempty : args ≠ []) + (hsourceArgs : SourceArgsProfile sourceCtx sourceMiddle args sourceArgs + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceArgs + sourceResult applyProfile) + (hfunction : LowerResultProfileSound funRel recSelfRel ctx cur + start input sourceStart sourceMiddle sourceFunction .shared + emitFunction function functionProfile) + (hrun : (applyRest src (fuel + 1) input resultWorld emitFunction + function args).run state = .ok (output, emit, av) finalState) : + LowerResultProfileSound funRel recSelfRel ctx cur start output + sourceStart sourceMiddle sourceResult resultWorld emit av + (functionProfile + argsProfile + applyProfile) := by + exact applyRest_nonErased_run_profile_core + (Result := fun actualWorld actualOutput actualEmit actualAv _ => + LowerResultProfileSound funRel recSelfRel ctx cur start actualOutput + sourceStart sourceMiddle sourceResult actualWorld actualEmit actualAv + (functionProfile + argsProfile + applyProfile)) + (hfinish := fun argsOutput emitArgs avs _ hsourcePaired + hsourceNonempty hargsRun hworldsHomogeneous => by + have hargsSound := hargs hsourcePaired hargsRun + have hhomogeneous : LowerArgsProfileSound funRel recSelfRel ctx cur + input argsOutput sourceMiddle sourceMiddle sourceArgs + (List.replicate avs.length .shared) emitArgs avs argsProfile := by + simpa [hworldsHomogeneous] using hargsSound + simpa [Function.comp_def] using + hfunction.applyArgs_graph hhomogeneous hownership hvalue hcost + hsource hsourceNonempty) + hfunctionNe hargsNonempty hsourceArgs hrun + +/-- Profile-source adapter for `applyRest_erased_run_core`. Source-profile +pairing and source/target argument-length agreement are recovered once while +exact, bounded, and reachable clients retain only their argument-discard +composition judgments. -/ +private theorem applyRest_erased_run_profile_core + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {sourceMiddle sourceArgs : List IxIR0.Value} + {resultWorld : Ixon.Owned} {pre emit : Emit} {args : List IxIR0.Expr} + {argsProfile : SourceProfile} {state finalState : LowSt} {av : AVal} + {Result : Ixon.Owned → VEnv → Emit → AVal → LowSt → Prop} + (hfinish : ∀ (argsOutput : VEnv) (emitArgs : Emit) + (avs : List AVal) (argsState : LowSt), + SourceArgsProfile sourceCtx sourceMiddle + ((args.map (fun arg => (arg, Ixon.Owned.shared))).map Prod.fst) + sourceArgs argsProfile → + (lowerArgs src fuel input + (args.map (fun arg => (arg, Ixon.Owned.shared)))).run state = + .ok (argsOutput, emitArgs, avs) argsState → + ((args.map (fun arg => (arg, Ixon.Owned.shared))).map Prod.snd) = + List.replicate avs.length .shared → + sourceArgs.length = avs.length → + Result resultWorld (releaseAll argsOutput avs).1 + ((pre ∘ emitArgs) ∘ (releaseAll argsOutput avs).2) + (.constA .erased) argsState) + (hsourceArgs : SourceArgsProfile sourceCtx sourceMiddle args sourceArgs + argsProfile) + (hrun : (applyRest src (fuel + 1) input resultWorld pre + (.constA .erased) args).run state = + .ok (output, emit, av) finalState) : + Result resultWorld output emit av finalState := by + exact applyRest_erased_run_core + (Result := Result) + (hfinish := fun argsOutput emitArgs avs argsState hargsRun havsLength + hworldsHomogeneous => by + have hsourcePaired : SourceArgsProfile sourceCtx sourceMiddle + ((args.map (fun arg => (arg, Ixon.Owned.shared))).map Prod.fst) + sourceArgs argsProfile := by + simpa [Function.comp_def] using hsourceArgs + have hsourceLength : sourceArgs.length = avs.length := by + rw [← hsourceArgs.lengths, ← havsLength] + exact hfinish argsOutput emitArgs avs argsState hsourcePaired hargsRun + hworldsHomogeneous hsourceLength) + hrun + +/-- The erased `applyRest` branch is also fully profiled: strict arguments +are lowered normally and their owners are discarded using the source +application fragment as zero-cost funding. -/ +theorem applyRest_erased_run_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsProfilePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + {start input output : VEnv} + {sourceStart sourceMiddle sourceArgs : List IxIR0.Value} + {resultWorld : Ixon.Owned} {emitFunction emit : Emit} + {args : List IxIR0.Expr} {av : AVal} + {functionProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} + (hsourceArgs : SourceArgsProfile sourceCtx sourceMiddle args sourceArgs + argsProfile) + (_hsource : SourceAppliesProfile sourceCtx .erased sourceArgs .erased + applyProfile) + (hfunction : LowerResultProfileSound funRel recSelfRel ctx cur + start input sourceStart sourceMiddle .erased .shared emitFunction + (.constA .erased) functionProfile) + (hrun : (applyRest src (fuel + 1) input resultWorld emitFunction + (.constA .erased) args).run state = + .ok (output, emit, av) finalState) : + LowerResultProfileSound funRel recSelfRel ctx cur start output + sourceStart sourceMiddle .erased resultWorld emit av + (functionProfile + argsProfile + applyProfile) := by + exact applyRest_erased_run_profile_core + (Result := fun actualWorld actualOutput actualEmit actualAv _ => + LowerResultProfileSound funRel recSelfRel ctx cur start actualOutput + sourceStart sourceMiddle .erased actualWorld actualEmit actualAv + (functionProfile + argsProfile + applyProfile)) + (hfinish := fun argsOutput emitArgs avs _ hsourcePaired hargsRun + hworldsHomogeneous hsourceLength => by + have hargsSound := hargs hsourcePaired hargsRun + have hhomogeneous : LowerArgsProfileSound funRel recSelfRel ctx cur + input argsOutput sourceMiddle sourceMiddle sourceArgs + (List.replicate avs.length .shared) emitArgs avs argsProfile := by + simpa [hworldsHomogeneous] using hargsSound + simpa [Function.comp_def] using + hfunction.discardArgs (applyProfile := applyProfile) hhomogeneous + hsourceLength) + hsourceArgs hrun + +/-- No successful non-erased `applyRest` run exists at zero compiler fuel. -/ +theorem applyRestNonErasedProfilePreserves_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) : + ApplyRestNonErasedProfilePreserves funRel recSelfRel sourceCtx ctx cur + src 0 := by + intro start input output sourceStart sourceMiddle sourceArgs + sourceFunction sourceResult resultWorld emitFunction emit function av + args functionProfile argsProfile applyProfile state finalState + _ _ _ _ _ hrun + simp only [applyRest] at hrun + exact (stateThrowRun_not_ok hrun).elim + +/-- One non-erased `applyRest` compiler-fuel step follows from profiled +argument lowering and the completed dynamic application contracts. -/ +theorem applyRestNonErasedProfilePreserves_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsProfilePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + (hownership : Sim.ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hcost : ApplyProfileContract funRel sourceCtx ctx) : + ApplyRestNonErasedProfilePreserves funRel recSelfRel sourceCtx ctx cur + src (fuel + 1) := by + intro start input output sourceStart sourceMiddle sourceArgs + sourceFunction sourceResult resultWorld emitFunction emit function av + args functionProfile argsProfile applyProfile state finalState + hfunctionNe hargsNonempty hsourceArgs hsource hfunction hrun + exact applyRest_nonErased_run_profile_sound hargs hownership hvalue hcost + hfunctionNe hargsNonempty hsourceArgs hsource hfunction hrun + +/-- Close non-erased `applyRest` profile preservation from all strictly +smaller expression-level profile hypotheses. -/ +theorem applyRestNonErasedProfilePreserves_of_expr + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} (fuel : Nat) + (hexpr : ∀ prior, prior < fuel → + LowerEProfilePreserves funRel recSelfRel sourceCtx ctx cur src prior) + (hownership : Sim.ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hcost : ApplyProfileContract funRel sourceCtx ctx) : + ApplyRestNonErasedProfilePreserves funRel recSelfRel sourceCtx ctx cur + src fuel := + applyRestNonErasedPreserves_of_expr_core + (Expr := LowerEProfilePreserves funRel recSelfRel sourceCtx ctx cur src) + (Args := LowerArgsProfilePreserves funRel recSelfRel sourceCtx ctx cur + src) + (ApplyRest := ApplyRestNonErasedProfilePreserves funRel recSelfRel + sourceCtx ctx cur src) + (hargsOfExpr := fun fuel hexpr => + lowerArgsProfilePreserves_of_expr fuel hexpr) + (hzero := applyRestNonErasedProfilePreserves_zero src) + (hsucc := fun hargs => + applyRestNonErasedProfilePreserves_succ hargs hownership hvalue hcost) + fuel hexpr + +/-- Successful flattened-spine lowering funded by the exact decomposed +source profile at one compiler-fuel index. -/ +def LowerSpineProfilePreserves (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {world : Ixon.Owned} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {state finalState : LowSt} + {emit : Emit} {av : AVal}, + args ≠ [] → + SourceSpineProfile sourceCtx sourceEnv head args sourceResult profile → + (lowerSpine src fuel input world head args).run state = + .ok (output, emit, av) finalState → + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av profile + +/-! ### Target-fuel-bounded compiler profile interfaces -/ + +/-- Expression profile preservation at one compiler-fuel index and one +independent target evaluator-fuel ceiling. -/ +def LowerEProfilePreservesBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) + (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {world : Ixon.Owned} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {sourceProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal}, + IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv expr sourceValue + sourceProfile → + (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState → + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + output sourceEnv sourceEnv sourceValue world emit av sourceProfile + +def LowerBorrowProfilePreservesBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) + (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {sourceProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + {release : Bool}, + IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv expr sourceValue + sourceProfile → + (lowerBorrow src fuel input expr).run state = + .ok (output, emit, av, release) finalState → + LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit input + output sourceEnv sourceEnv sourceValue emit av release sourceProfile + +def LowerArgsProfilePreservesBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) + (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {sourceEnv sourceValues : List IxIR0.Value} + {args : List (IxIR0.Expr × Ixon.Owned)} + {sourceProfile : SourceProfile} {state finalState : LowSt} + {emit : Emit} {avs : List AVal}, + SourceArgsProfile sourceCtx sourceEnv (args.map Prod.fst) sourceValues + sourceProfile → + (lowerArgs src fuel input args).run state = + .ok (output, emit, avs) finalState → + LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValues (args.map Prod.snd) emit avs + sourceProfile + +def ApplyRestNonErasedProfilePreservesBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) + (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {start input output : VEnv} + {sourceStart sourceMiddle sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {resultWorld : Ixon.Owned} {emitFunction emit : Emit} + {function av : AVal} {args : List IxIR0.Expr} + {functionProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt}, + function ≠ .constA .erased → + args ≠ [] → + SourceArgsProfile sourceCtx sourceMiddle args sourceArgs argsProfile → + SourceAppliesProfile sourceCtx sourceFunction sourceArgs sourceResult + applyProfile → + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit start input + sourceStart sourceMiddle sourceFunction .shared emitFunction function + functionProfile → + (applyRest src fuel input resultWorld emitFunction function args).run + state = .ok (output, emit, av) finalState → + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit start output + sourceStart sourceMiddle sourceResult resultWorld emit av + (functionProfile + argsProfile + applyProfile) + +def LowerSpineProfilePreservesBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) + (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {world : Ixon.Owned} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {state finalState : LowSt} + {emit : Emit} {av : AVal}, + args ≠ [] → + SourceSpineProfile sourceCtx sourceEnv head args sourceResult profile → + (lowerSpine src fuel input world head args).run state = + .ok (output, emit, av) finalState → + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult world emit av profile + +theorem lowerEProfilePreservesBelow_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (src : IxIR0.Env) : + LowerEProfilePreservesBelow funRel recSelfRel sourceCtx ctx cur limit + src 0 := by + intro input output world expr sourceEnv sourceFuel sourceValue + sourceProfile state finalState emit av _ hrun + exact (lowerE_noSuccess_zero src input world expr hrun).elim + +theorem lowerBorrowProfilePreservesBelow_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (src : IxIR0.Env) : + LowerBorrowProfilePreservesBelow funRel recSelfRel sourceCtx ctx cur + limit src 0 := by + intro input output expr sourceEnv sourceFuel sourceValue sourceProfile + state finalState emit av release _ hrun + exact (lowerBorrow_noSuccess_zero src input expr hrun).elim + +theorem lowerArgsProfilePreservesBelow_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (src : IxIR0.Env) : + LowerArgsProfilePreservesBelow funRel recSelfRel sourceCtx ctx cur limit + src 0 := by + intro input output sourceEnv sourceValues args sourceProfile state + finalState emit avs _ hrun + exact (lowerArgs_noSuccess_zero src input args hrun).elim + +theorem applyRestNonErasedProfilePreservesBelow_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (src : IxIR0.Env) : + ApplyRestNonErasedProfilePreservesBelow funRel recSelfRel sourceCtx ctx + cur limit src 0 := by + intro start input output sourceStart sourceMiddle sourceArgs + sourceFunction sourceResult resultWorld emitFunction emit function av + args functionProfile argsProfile applyProfile state finalState + _ _ _ _ _ hrun + exact (applyRest_noSuccess_zero src input resultWorld emitFunction function + args hrun).elim + +theorem lowerSpineProfilePreservesBelow_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (src : IxIR0.Env) : + LowerSpineProfilePreservesBelow funRel recSelfRel sourceCtx ctx cur + limit src 0 := by + intro input output world head args sourceEnv sourceResult profile state + finalState emit av _ _ hrun + exact (lowerSpine_noSuccess_zero src input world head args hrun).elim + +theorem lowerSpineProfilePreservesBelow_one + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (src : IxIR0.Env) : + LowerSpineProfilePreservesBelow funRel recSelfRel sourceCtx ctx cur + limit src 1 := by + intro input output world head args sourceEnv sourceResult profile state + finalState emit av _ _ hrun + exact (lowerSpine_noSuccess_one src input world head args hrun).elim + +theorem lowerArgsProfilePreservesBelow_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEProfilePreservesBelow funRel recSelfRel sourceCtx ctx cur + limit src fuel) + (htail : LowerArgsProfilePreservesBelow funRel recSelfRel sourceCtx ctx + cur limit src fuel) : + LowerArgsProfilePreservesBelow funRel recSelfRel sourceCtx ctx cur limit + src (fuel + 1) := by + intro input output sourceEnv sourceValues args sourceProfile state + finalState emit avs hsource hrun + exact lowerArgs_run_profile_core + (Result := fun actualOutput actualSourceValues worlds actualEmit + actualAVals actualProfile _ => + LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit input + actualOutput sourceEnv sourceEnv actualSourceValues worlds actualEmit + actualAVals actualProfile) + (hnil := lowerArgs_nil_profile_sound_below) + (hcons := by + intro _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ hsourceHead + hsourceTail hheadRun htailRun + exact (hexpr hsourceHead hheadRun).consArgs + (htail hsourceTail htailRun)) + hsource hrun + +theorem lowerArgsProfilePreservesBelow_of_expr + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} (fuel : Nat) + (hexpr : ∀ prior, prior < fuel → + LowerEProfilePreservesBelow funRel recSelfRel sourceCtx ctx cur limit + src prior) : + LowerArgsProfilePreservesBelow funRel recSelfRel sourceCtx ctx cur limit + src fuel := + lowerArgsPreserves_of_expr_core + (Expr := LowerEProfilePreservesBelow funRel recSelfRel sourceCtx ctx cur + limit src) + (Args := LowerArgsProfilePreservesBelow funRel recSelfRel sourceCtx ctx + cur limit src) + (hzero := lowerArgsProfilePreservesBelow_zero src) + (hsucc := fun hexpr htail => + lowerArgsProfilePreservesBelow_succ hexpr htail) + fuel hexpr + +/-- Fuel-bounded inversion of a successful non-erased `applyRest` run. -/ +theorem applyRest_nonErased_run_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsProfilePreservesBelow funRel recSelfRel sourceCtx ctx + cur limit src fuel) + (hownership : Sim.ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hcost : ApplyProfileContractBelow funRel sourceCtx ctx limit) + {start input output : VEnv} + {sourceStart sourceMiddle sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {resultWorld : Ixon.Owned} {emitFunction emit : Emit} + {function av : AVal} {args : List IxIR0.Expr} + {functionProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} + (hfunctionNe : function ≠ .constA .erased) + (hargsNonempty : args ≠ []) + (hsourceArgs : SourceArgsProfile sourceCtx sourceMiddle args sourceArgs + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceArgs + sourceResult applyProfile) + (hfunction : LowerResultProfileSoundBelow funRel recSelfRel ctx cur + limit start input sourceStart sourceMiddle sourceFunction .shared + emitFunction function functionProfile) + (hrun : (applyRest src (fuel + 1) input resultWorld emitFunction + function args).run state = .ok (output, emit, av) finalState) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit start output + sourceStart sourceMiddle sourceResult resultWorld emit av + (functionProfile + argsProfile + applyProfile) := by + exact applyRest_nonErased_run_profile_core + (Result := fun actualWorld actualOutput actualEmit actualAv _ => + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit start + actualOutput sourceStart sourceMiddle sourceResult actualWorld + actualEmit actualAv (functionProfile + argsProfile + applyProfile)) + (hfinish := fun argsOutput emitArgs avs _ hsourcePaired + hsourceNonempty hargsRun hworldsHomogeneous => by + have hargsSound := hargs hsourcePaired hargsRun + have hhomogeneous : LowerArgsProfileSoundBelow funRel recSelfRel ctx + cur limit input argsOutput sourceMiddle sourceMiddle sourceArgs + (List.replicate avs.length .shared) emitArgs avs argsProfile := by + simpa [hworldsHomogeneous] using hargsSound + simpa [Function.comp_def] using + hfunction.applyArgs_graph hhomogeneous hownership hvalue hcost + hsource hsourceNonempty) + hfunctionNe hargsNonempty hsourceArgs hrun + +theorem applyRestNonErasedProfilePreservesBelow_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsProfilePreservesBelow funRel recSelfRel sourceCtx ctx + cur limit src fuel) + (hownership : Sim.ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hcost : ApplyProfileContractBelow funRel sourceCtx ctx limit) : + ApplyRestNonErasedProfilePreservesBelow funRel recSelfRel sourceCtx ctx + cur limit src (fuel + 1) := by + intro start input output sourceStart sourceMiddle sourceArgs + sourceFunction sourceResult resultWorld emitFunction emit function av + args functionProfile argsProfile applyProfile state finalState + hfunctionNe hargsNonempty hsourceArgs hsource hfunction hrun + exact applyRest_nonErased_run_profile_sound_below hargs hownership hvalue + hcost hfunctionNe hargsNonempty hsourceArgs hsource hfunction hrun + +theorem applyRestNonErasedProfilePreservesBelow_of_expr + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} (fuel : Nat) + (hexpr : ∀ prior, prior < fuel → + LowerEProfilePreservesBelow funRel recSelfRel sourceCtx ctx cur limit + src prior) + (hownership : Sim.ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hcost : ApplyProfileContractBelow funRel sourceCtx ctx limit) : + ApplyRestNonErasedProfilePreservesBelow funRel recSelfRel sourceCtx ctx + cur limit src fuel := + applyRestNonErasedPreserves_of_expr_core + (Expr := LowerEProfilePreservesBelow funRel recSelfRel sourceCtx ctx cur + limit src) + (Args := LowerArgsProfilePreservesBelow funRel recSelfRel sourceCtx ctx + cur limit src) + (ApplyRest := ApplyRestNonErasedProfilePreservesBelow funRel recSelfRel + sourceCtx ctx cur limit src) + (hargsOfExpr := fun fuel hexpr => + lowerArgsProfilePreservesBelow_of_expr fuel hexpr) + (hzero := applyRestNonErasedProfilePreservesBelow_zero src) + (hsucc := fun hargs => + applyRestNonErasedProfilePreservesBelow_succ hargs hownership hvalue + hcost) + fuel hexpr + +/-- The fuel-bounded erased `applyRest` branch is also fully profiled: strict arguments +are lowered normally and their owners are discarded using the source +application fragment as zero-cost funding. -/ +theorem applyRest_erased_run_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsProfilePreservesBelow funRel recSelfRel sourceCtx ctx cur limit + src fuel) + {start input output : VEnv} + {sourceStart sourceMiddle sourceArgs : List IxIR0.Value} + {resultWorld : Ixon.Owned} {emitFunction emit : Emit} + {args : List IxIR0.Expr} {av : AVal} + {functionProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} + (hsourceArgs : SourceArgsProfile sourceCtx sourceMiddle args sourceArgs + argsProfile) + (_hsource : SourceAppliesProfile sourceCtx .erased sourceArgs .erased + applyProfile) + (hfunction : LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit + start input sourceStart sourceMiddle .erased .shared emitFunction + (.constA .erased) functionProfile) + (hrun : (applyRest src (fuel + 1) input resultWorld emitFunction + (.constA .erased) args).run state = + .ok (output, emit, av) finalState) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit start output + sourceStart sourceMiddle .erased resultWorld emit av + (functionProfile + argsProfile + applyProfile) := by + exact applyRest_erased_run_profile_core + (Result := fun actualWorld actualOutput actualEmit actualAv _ => + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit start + actualOutput sourceStart sourceMiddle .erased actualWorld actualEmit + actualAv (functionProfile + argsProfile + applyProfile)) + (hfinish := fun argsOutput emitArgs avs _ hsourcePaired hargsRun + hworldsHomogeneous hsourceLength => by + have hargsSound := hargs hsourcePaired hargsRun + have hhomogeneous : LowerArgsProfileSoundBelow funRel recSelfRel ctx + cur limit input argsOutput sourceMiddle sourceMiddle sourceArgs + (List.replicate avs.length .shared) emitArgs avs argsProfile := by + simpa [hworldsHomogeneous] using hargsSound + simpa [Function.comp_def] using + hfunction.discardArgs (applyProfile := applyProfile) hhomogeneous + hsourceLength) + hsourceArgs hrun + +/-- A flattened application head delegates to the predecessor-fuel spine +proof with the same cost-preserving source flattening. -/ +theorem lowerSpine_app_run_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel : Nat} + (hspine : LowerSpineProfilePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + {input output : VEnv} {world : Ixon.Owned} + {function argument : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hsource : SourceSpineProfile sourceCtx sourceEnv + (.app function argument) args sourceResult profile) + (hrun : (lowerSpine src (fuel + 1) input world + (.app function argument) args).run state = + .ok (output, emit, av) finalState) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av profile := by + apply hspine (by simp) hsource.flattenApp + simpa [lowerSpine] using hrun + +/-- The expression-level application constructor is a singleton profiled +spine, so its branch is closed by the profiled spine induction hypothesis. -/ +theorem lowerE_app_run_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel sourceFuel : Nat} + (hspine : LowerSpineProfilePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + {input output : VEnv} {world : Ixon.Owned} + {function argument : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hsource : IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv + (.app function argument) sourceResult profile) + (hrun : (lowerE src (fuel + 1) input world + (.app function argument)).run state = + .ok (output, emit, av) finalState) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av profile := by + apply hspine (by simp) (SourceSpineProfile.of_eval_app hsource) + simpa [lowerE] using hrun + +/-- Fuel-bounded flattened application-head delegation. -/ +theorem lowerSpine_app_run_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {fuel : Nat} + (hspine : LowerSpineProfilePreservesBelow funRel recSelfRel sourceCtx + ctx cur limit src fuel) + {input output : VEnv} {world : Ixon.Owned} + {function argument : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hsource : SourceSpineProfile sourceCtx sourceEnv + (.app function argument) args sourceResult profile) + (hrun : (lowerSpine src (fuel + 1) input world + (.app function argument) args).run state = + .ok (output, emit, av) finalState) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult world emit av profile := by + apply hspine (by simp) hsource.flattenApp + simpa [lowerSpine] using hrun + +/-- Fuel-bounded expression-level singleton application spine. -/ +theorem lowerE_app_run_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {fuel sourceFuel : Nat} + (hspine : LowerSpineProfilePreservesBelow funRel recSelfRel sourceCtx + ctx cur limit src fuel) + {input output : VEnv} {world : Ixon.Owned} + {function argument : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hsource : IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv + (.app function argument) sourceResult profile) + (hrun : (lowerE src (fuel + 1) input world + (.app function argument)).run state = + .ok (output, emit, av) finalState) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult world emit av profile := by + apply hspine (by simp) (SourceSpineProfile.of_eval_app hsource) + simpa [lowerE] using hrun + +/-- Compose a bounded profiled result with a bounded state-indexed result +suffix. -/ +theorem LowerResultProfileSoundBelow.thenResult + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input middle output : VEnv} + {sourceInput sourceMiddle sourceOutput : List IxIR0.Value} + {sourceMiddleValue sourceValue : IxIR0.Value} + {middleWorld world : Ixon.Owned} + {first second : Emit} {middleValue result : AVal} + {firstProfile secondProfile : SourceProfile} + (hsound : LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit + input middle sourceInput sourceMiddle sourceMiddleValue middleWorld + first middleValue firstProfile) + (hvalue : LowerResultValueSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue world (first ∘ second) result) + (hsecond : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSoundBelow ctx cur limit second + (GraphOwnsResultProtected funRel recSelfRel middle sourceMiddle + sourceMiddleValue middleWorld middleValue sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output sourceOutput + sourceValue world result sourceRest rest slots) + secondProfile) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceInput sourceOutput sourceValue world (first ∘ second) result + (firstProfile + secondProfile) := by + refine + { toLowerResultValueSound := hvalue + profileEmits := ?_ } + intro sourceRest rest slots + exact ProfileFundedEmitStateRunSoundBelow.comp + (hsound.profileEmits sourceRest rest slots) + (hsecond sourceRest rest slots) + +/-- Compose a bounded profiled result with a bounded state-indexed borrow +suffix. -/ +theorem LowerResultProfileSoundBelow.thenBorrow + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input middle output : VEnv} + {sourceInput sourceMiddle sourceOutput : List IxIR0.Value} + {sourceMiddleValue sourceValue : IxIR0.Value} + {middleWorld : Ixon.Owned} + {first second : Emit} {middleValue result : AVal} {release : Bool} + {firstProfile secondProfile : SourceProfile} + (hsound : LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit + input middle sourceInput sourceMiddle sourceMiddleValue middleWorld + first middleValue firstProfile) + (hvalue : LowerBorrowValueSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue (first ∘ second) result release) + (hsecond : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSoundBelow ctx cur limit second + (GraphOwnsResultProtected funRel recSelfRel middle sourceMiddle + sourceMiddleValue middleWorld middleValue sourceRest rest slots) + (GraphOwnsBorrowResultProtected funRel recSelfRel output sourceOutput + sourceValue result release sourceRest rest slots) + secondProfile) : + LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceInput sourceOutput sourceValue (first ∘ second) result release + (firstProfile + secondProfile) := by + refine + { toLowerBorrowValueSound := hvalue + profileEmits := ?_ } + intro sourceRest rest slots + exact ProfileFundedEmitStateRunSoundBelow.comp + (hsound.profileEmits sourceRest rest slots) + (hsecond sourceRest rest slots) + +/-- Compose a bounded profiled borrow with a bounded state-indexed result +suffix. -/ +theorem LowerBorrowProfileSoundBelow.thenResult + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input middle output : VEnv} + {sourceInput sourceMiddle sourceOutput : List IxIR0.Value} + {sourceTarget sourceValue : IxIR0.Value} + {borrowEmit suffix : Emit} {borrowed result : AVal} {release : Bool} + {world : Ixon.Owned} {prefixProfile suffixProfile : SourceProfile} + (hsound : LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit + input middle sourceInput sourceMiddle sourceTarget borrowEmit borrowed + release prefixProfile) + (hvalue : LowerResultValueSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue world (borrowEmit ∘ suffix) + result) + (hsuffix : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSoundBelow ctx cur limit suffix + (GraphOwnsBorrowResultProtected funRel recSelfRel middle + sourceMiddle sourceTarget borrowed release sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output sourceOutput + sourceValue world result sourceRest rest slots) + suffixProfile) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceInput sourceOutput sourceValue world (borrowEmit ∘ suffix) + result (prefixProfile + suffixProfile) := by + refine + { toLowerResultValueSound := hvalue + profileEmits := ?_ } + intro sourceRest rest slots + exact ProfileFundedEmitStateRunSoundBelow.comp + (hsound.profileEmits sourceRest rest slots) + (hsuffix sourceRest rest slots) + +/-- Compose a profiled borrowing prefix with a state-indexed suffix that +turns the pending borrow into a complete semantic expression result. -/ +theorem LowerBorrowProfileSound.thenResult + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input middle output : VEnv} + {sourceInput sourceMiddle sourceOutput : List IxIR0.Value} + {sourceTarget sourceValue : IxIR0.Value} + {borrowEmit suffix : Emit} {borrowed result : AVal} {release : Bool} + {world : Ixon.Owned} {prefixProfile suffixProfile : SourceProfile} + (hsound : LowerBorrowProfileSound funRel recSelfRel ctx cur + input middle sourceInput sourceMiddle sourceTarget borrowEmit borrowed + release prefixProfile) + (hvalue : LowerResultValueSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue world (borrowEmit ∘ suffix) result) + (hsuffix : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSound ctx cur suffix + (GraphOwnsBorrowResultProtected funRel recSelfRel middle + sourceMiddle sourceTarget borrowed release sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output sourceOutput + sourceValue world result sourceRest rest slots) + suffixProfile) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue world (borrowEmit ∘ suffix) result + (prefixProfile + suffixProfile) := by + refine + { toLowerResultValueSound := hvalue + profileEmits := ?_ } + intro sourceRest rest slots + exact ProfileFundedEmitStateRunSound.comp + (hsound.profileEmits sourceRest rest slots) + (hsuffix sourceRest rest slots) + +/-- Cost companion to semantic let-binder installation. As with expression +results, the source profile and the graph transition are proved for the same +exact runtime midpoint. -/ +structure InstallBinderProfileSound + (funRel : Sim.FunctionRel) (recSelfRel : RecSelfRel) + (ctx : Ctx) (cur : FnDef) (input output : VEnv) + (sourceEnv : List IxIR0.Value) (boundSource : IxIR0.Value) + (boundWorld : Ixon.Owned) (boundValue : AVal) + (emit : Emit) (profile : SourceProfile) : Prop + extends InstallBinderValueSound funRel recSelfRel ctx cur input output + sourceEnv boundSource boundWorld boundValue emit where + profileEmits : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSound ctx cur emit + (GraphOwnsResultProtected funRel recSelfRel input sourceEnv + boundSource boundWorld boundValue sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel output + (boundSource :: sourceEnv) sourceRest rest slots) + profile + +/-- Binder installation whose exact-profile transformer is valid through +one target evaluator-fuel ceiling. -/ +structure InstallBinderProfileSoundBelow + (funRel : Sim.FunctionRel) (recSelfRel : RecSelfRel) + (ctx : Ctx) (cur : FnDef) (limit : Nat) (input output : VEnv) + (sourceEnv : List IxIR0.Value) (boundSource : IxIR0.Value) + (boundWorld : Ixon.Owned) (boundValue : AVal) + (emit : Emit) (profile : SourceProfile) : Prop + extends InstallBinderValueSound funRel recSelfRel ctx cur input output + sourceEnv boundSource boundWorld boundValue emit where + profileEmits : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSoundBelow ctx cur limit emit + (GraphOwnsResultProtected funRel recSelfRel input sourceEnv + boundSource boundWorld boundValue sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel output + (boundSource :: sourceEnv) sourceRest rest slots) + profile + +theorem InstallBinderProfileSoundBelow.of_profile_eq + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input output : VEnv} + {sourceEnv : List IxIR0.Value} {boundSource : IxIR0.Value} + {boundWorld : Ixon.Owned} {boundValue : AVal} {emit : Emit} + {left right : SourceProfile} + (hsound : InstallBinderProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceEnv boundSource boundWorld boundValue emit left) + (hprofile : left = right) : + InstallBinderProfileSoundBelow funRel recSelfRel ctx cur limit input + output sourceEnv boundSource boundWorld boundValue emit right := by + subst right + exact hsound + +theorem InstallBinderProfileSound.of_profile_eq + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceEnv : List IxIR0.Value} {boundSource : IxIR0.Value} + {boundWorld : Ixon.Owned} {boundValue : AVal} {emit : Emit} + {left right : SourceProfile} + (hsound : InstallBinderProfileSound funRel recSelfRel ctx cur + input output sourceEnv boundSource boundWorld boundValue emit left) + (hprofile : left = right) : + InstallBinderProfileSound funRel recSelfRel ctx cur input output + sourceEnv boundSource boundWorld boundValue emit right := by + subst right + exact hsound + +/-- Append an environment-to-environment prefix after binder installation. +This is used by dead slot binders, whose alias installation is immediately +followed by a release operation. -/ +theorem InstallBinderProfileSound.compVEnv + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input middle output : VEnv} + {sourceEnv : List IxIR0.Value} {boundSource : IxIR0.Value} + {boundWorld : Ixon.Owned} {boundValue : AVal} + {first second : Emit} {firstProfile secondProfile : SourceProfile} + (hfirst : InstallBinderProfileSound funRel recSelfRel ctx cur + input middle sourceEnv boundSource boundWorld boundValue + first firstProfile) + (hsecondOwns : ∀ rest slots, + EmitSound ctx cur second + (OwnsVEnvProtected middle rest slots) + (OwnsVEnvProtected output rest slots)) + (hsecondGraph : ∀ sourceRest rest slots, + EmitSound ctx cur second + (GraphOwnsVEnvProtected funRel recSelfRel middle + (boundSource :: sourceEnv) sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel output + (boundSource :: sourceEnv) sourceRest rest slots)) + (hsecondProfile : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSound ctx cur second + (GraphOwnsVEnvProtected funRel recSelfRel middle + (boundSource :: sourceEnv) sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel output + (boundSource :: sourceEnv) sourceRest rest slots) + secondProfile) : + InstallBinderProfileSound funRel recSelfRel ctx cur input output + sourceEnv boundSource boundWorld boundValue (first ∘ second) + (firstProfile + secondProfile) := by + refine + { toInstallBinderValueSound := + { toInstallBinderSound := ?_ + graphEmits := ?_ } + profileEmits := ?_ } + · intro rest slots + exact EmitSound.comp + (hfirst.toInstallBinderValueSound.toInstallBinderSound rest slots) + (hsecondOwns rest slots) + · intro sourceRest rest slots + exact EmitSound.comp + (hfirst.toInstallBinderValueSound.graphEmits sourceRest rest slots) + (hsecondGraph sourceRest rest slots) + · intro sourceRest rest slots + exact ProfileFundedEmitStateRunSound.comp + (hfirst.profileEmits sourceRest rest slots) + (hsecondProfile sourceRest rest slots) + +theorem InstallBinderProfileSoundBelow.compVEnv + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input middle output : VEnv} + {sourceEnv : List IxIR0.Value} {boundSource : IxIR0.Value} + {boundWorld : Ixon.Owned} {boundValue : AVal} + {first second : Emit} {firstProfile secondProfile : SourceProfile} + (hfirst : InstallBinderProfileSoundBelow funRel recSelfRel ctx cur limit + input middle sourceEnv boundSource boundWorld boundValue + first firstProfile) + (hsecondOwns : ∀ rest slots, + EmitSound ctx cur second + (OwnsVEnvProtected middle rest slots) + (OwnsVEnvProtected output rest slots)) + (hsecondGraph : ∀ sourceRest rest slots, + EmitSound ctx cur second + (GraphOwnsVEnvProtected funRel recSelfRel middle + (boundSource :: sourceEnv) sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel output + (boundSource :: sourceEnv) sourceRest rest slots)) + (hsecondProfile : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSoundBelow ctx cur limit second + (GraphOwnsVEnvProtected funRel recSelfRel middle + (boundSource :: sourceEnv) sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel output + (boundSource :: sourceEnv) sourceRest rest slots) + secondProfile) : + InstallBinderProfileSoundBelow funRel recSelfRel ctx cur limit input + output sourceEnv boundSource boundWorld boundValue (first ∘ second) + (firstProfile + secondProfile) := by + refine + { toInstallBinderValueSound := + { toInstallBinderSound := ?_ + graphEmits := ?_ } + profileEmits := ?_ } + · intro rest slots + exact EmitSound.comp + (hfirst.toInstallBinderValueSound.toInstallBinderSound rest slots) + (hsecondOwns rest slots) + · intro sourceRest rest slots + exact EmitSound.comp + (hfirst.toInstallBinderValueSound.graphEmits sourceRest rest slots) + (hsecondGraph sourceRest rest slots) + · intro sourceRest rest slots + exact ProfileFundedEmitStateRunSoundBelow.comp + (hfirst.profileEmits sourceRest rest slots) + (hsecondProfile sourceRest rest slots) + +/-- Profile-source adapter for every spine that lowers its head at the shared +world and then delegates to `applyRest`. Source-profile inversion, executable +head/rest recovery, erased reflection, erased-result forcing, canonical +profile reconciliation, and erased/non-erased dispatch occur once; clients +retain only their exact/bounded and ordinary/reachable judgments. -/ +private theorem lowerSpine_apply_run_profile_core + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Ixon.Owned} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {state finalState : LowSt} + {emit : Emit} {av : AVal} + {HeadSound : IxIR0.Value → SourceProfile → VEnv → Emit → AVal → + LowSt → Prop} + {Result : IxIR0.Value → SourceProfile → Prop} + (hheadSound : ∀ {sourceFuel : Nat} + {sourceFunction : IxIR0.Value} {headProfile : SourceProfile} + {functionOutput : VEnv} {emitFunction : Emit} + {function : AVal} {middleState : LowSt}, + IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv head + sourceFunction headProfile → + (lowerE src (fuel + 1) input .shared head).run state = + .ok (functionOutput, emitFunction, function) middleState → + (applyRest src (fuel + 1) functionOutput world emitFunction + function args).run middleState = + .ok (output, emit, av) finalState → + HeadSound sourceFunction headProfile functionOutput emitFunction + function middleState) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (herasedFinish : ∀ {sourceArgs : List IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {functionOutput : VEnv} {emitFunction : Emit} + {middleState : LowSt}, + SourceArgsProfile sourceCtx sourceEnv args sourceArgs argsProfile → + SourceAppliesProfile sourceCtx .erased sourceArgs .erased + applyProfile → + HeadSound .erased headProfile functionOutput emitFunction + (.constA .erased) middleState → + (applyRest src (fuel + 1) functionOutput world emitFunction + (.constA .erased) args).run middleState = + .ok (output, emit, av) finalState → + Result .erased (headProfile + argsProfile + applyProfile)) + (hnonErasedFinish : ∀ {sourceFunction : IxIR0.Value} + {sourceArgs : List IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {functionOutput : VEnv} {emitFunction : Emit} + {function : AVal} {middleState : LowSt}, + function ≠ .constA .erased → + SourceArgsProfile sourceCtx sourceEnv args sourceArgs argsProfile → + SourceAppliesProfile sourceCtx sourceFunction sourceArgs sourceResult + applyProfile → + HeadSound sourceFunction headProfile functionOutput emitFunction + function middleState → + (applyRest src (fuel + 1) functionOutput world emitFunction + function args).run middleState = + .ok (output, emit, av) finalState → + Result sourceResult (headProfile + argsProfile + applyProfile)) + (hsource : SourceSpineProfile sourceCtx sourceEnv head args sourceResult + profile) + (hinvert : ∃ functionOutput emitFunction function middleState, + (lowerE src (fuel + 1) input .shared head).run state = + .ok (functionOutput, emitFunction, function) middleState ∧ + (applyRest src (fuel + 1) functionOutput world emitFunction + function args).run middleState = + .ok (output, emit, av) finalState) : + Result sourceResult profile := by + apply hsource.eliminate + · intro sourceFunction sourceArgs headProfile argsProfile applyProfile + hhead hsourceArgs hsourceApply hprofile + obtain ⟨sourceFuel, hhead⟩ := hhead + obtain ⟨functionOutput, emitFunction, function, middleState, + hfunctionRun, hrestRun⟩ := hinvert + have hfunctionSound := hheadSound hhead hfunctionRun hrestRun + rw [← hprofile] + by_cases herased : function = .constA .erased + · have hsourceErased : sourceFunction = .erased := + hreflect hhead.run hfunctionRun herased + subst sourceFunction + have hresult : sourceResult = .erased := + hsourceApply.toSourceApplies.deterministic + (SourceApplies.erased sourceCtx sourceArgs) + subst sourceResult + subst function + exact herasedFinish hsourceArgs hsourceApply hfunctionSound hrestRun + · exact hnonErasedFinish herased hsourceArgs hsourceApply + hfunctionSound hrestRun + +/-- Complete profiled dynamic-head spine rule. The canonical source profile +splits into the head evaluation, strict arguments, and entered applications; +the erased and genuine higher-order branches preserve that same split. -/ +theorem lowerSpine_dynamic_run_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEProfilePreserves funRel recSelfRel sourceCtx ctx cur src + (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsProfilePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + (hrest : ApplyRestNonErasedProfilePreserves funRel recSelfRel + sourceCtx ctx cur src (fuel + 1)) + {input output : VEnv} {world : Ixon.Owned} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hshape : DynamicSpineHead head) + (hargsNonempty : args ≠ []) + (hsource : SourceSpineProfile sourceCtx sourceEnv head args sourceResult + profile) + (hrun : (lowerSpine src (fuel + 2) input world head args).run state = + .ok (output, emit, av) finalState) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av profile := by + exact lowerSpine_apply_run_profile_core + (HeadSound := fun sourceFunction headProfile functionOutput + emitFunction function _ => + LowerResultProfileSound funRel recSelfRel ctx cur input functionOutput + sourceEnv sourceEnv sourceFunction .shared emitFunction function + headProfile) + (Result := fun actualResult actualProfile => + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv actualResult world emit av actualProfile) + (hheadSound := fun hhead hfunctionRun _ => + hexpr hhead hfunctionRun) + (hreflect := hreflect) + (herasedFinish := fun hsourceArgs hsourceApply hfunctionSound hrestRun => + applyRest_erased_run_profile_sound hargs hsourceArgs hsourceApply + hfunctionSound hrestRun) + (hnonErasedFinish := fun hfunctionNe hsourceArgs hsourceApply + hfunctionSound hrestRun => + hrest hfunctionNe hargsNonempty hsourceArgs hsourceApply hfunctionSound + hrestRun) + hsource (lowerSpine_dynamic_run_inv hshape hrun) + +/-- Profiled ordinary-variable spine. Once the dedicated recursor-self +descriptor is excluded, variable heads follow the same lower-then-apply +profile split as all other dynamic heads. -/ +theorem lowerSpine_var_dynamic_run_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEProfilePreserves funRel recSelfRel sourceCtx ctx cur src + (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsProfilePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + (hrest : ApplyRestNonErasedProfilePreserves funRel recSelfRel + sourceCtx ctx cur src (fuel + 1)) + {input output : VEnv} {world : Ixon.Owned} {index : Nat} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hnotSelf : ∀ arity, + input.entries[index]? ≠ some (.recSelf arity)) + (hargsNonempty : args ≠ []) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.var index) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.var index) args).run + state = .ok (output, emit, av) finalState) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av profile := by + exact lowerSpine_apply_run_profile_core + (HeadSound := fun sourceFunction headProfile functionOutput + emitFunction function _ => + LowerResultProfileSound funRel recSelfRel ctx cur input functionOutput + sourceEnv sourceEnv sourceFunction .shared emitFunction function + headProfile) + (Result := fun actualResult actualProfile => + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv actualResult world emit av actualProfile) + (hheadSound := fun hhead hfunctionRun _ => + hexpr hhead hfunctionRun) + (hreflect := hreflect) + (herasedFinish := fun hsourceArgs hsourceApply hfunctionSound hrestRun => + applyRest_erased_run_profile_sound hargs hsourceArgs hsourceApply + hfunctionSound hrestRun) + (hnonErasedFinish := fun hfunctionNe hsourceArgs hsourceApply + hfunctionSound hrestRun => + hrest hfunctionNe hargsNonempty hsourceArgs hsourceApply hfunctionSound + hrestRun) + hsource (lowerSpine_var_dynamic_run_inv hnotSelf hrun) + +/-- Complete target-fuel-bounded profiled dynamic-head spine rule. The canonical source profile +splits into the head evaluation, strict arguments, and entered applications; +the erased and genuine higher-order branches preserve that same split. -/ +theorem lowerSpine_dynamic_run_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEProfilePreservesBelow funRel recSelfRel sourceCtx ctx cur limit src + (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsProfilePreservesBelow funRel recSelfRel sourceCtx ctx cur + limit src fuel) + (hrest : ApplyRestNonErasedProfilePreservesBelow funRel recSelfRel + sourceCtx ctx cur limit src (fuel + 1)) + {input output : VEnv} {world : Ixon.Owned} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hshape : DynamicSpineHead head) + (hargsNonempty : args ≠ []) + (hsource : SourceSpineProfile sourceCtx sourceEnv head args sourceResult + profile) + (hrun : (lowerSpine src (fuel + 2) input world head args).run state = + .ok (output, emit, av) finalState) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult world emit av profile := by + exact lowerSpine_apply_run_profile_core + (HeadSound := fun sourceFunction headProfile functionOutput + emitFunction function _ => + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + functionOutput sourceEnv sourceEnv sourceFunction .shared emitFunction + function headProfile) + (Result := fun actualResult actualProfile => + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + output sourceEnv sourceEnv actualResult world emit av actualProfile) + (hheadSound := fun hhead hfunctionRun _ => + hexpr hhead hfunctionRun) + (hreflect := hreflect) + (herasedFinish := fun hsourceArgs hsourceApply hfunctionSound hrestRun => + applyRest_erased_run_profile_sound_below hargs hsourceArgs hsourceApply + hfunctionSound hrestRun) + (hnonErasedFinish := fun hfunctionNe hsourceArgs hsourceApply + hfunctionSound hrestRun => + hrest hfunctionNe hargsNonempty hsourceArgs hsourceApply hfunctionSound + hrestRun) + hsource (lowerSpine_dynamic_run_inv hshape hrun) + +/-- Target-fuel-bounded profiled ordinary-variable spine. Once the dedicated recursor-self +descriptor is excluded, variable heads follow the same lower-then-apply +profile split as all other dynamic heads. -/ +theorem lowerSpine_var_dynamic_run_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEProfilePreservesBelow funRel recSelfRel sourceCtx ctx cur limit src + (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsProfilePreservesBelow funRel recSelfRel sourceCtx ctx cur + limit src fuel) + (hrest : ApplyRestNonErasedProfilePreservesBelow funRel recSelfRel + sourceCtx ctx cur limit src (fuel + 1)) + {input output : VEnv} {world : Ixon.Owned} {index : Nat} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hnotSelf : ∀ arity, + input.entries[index]? ≠ some (.recSelf arity)) + (hargsNonempty : args ≠ []) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.var index) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.var index) args).run + state = .ok (output, emit, av) finalState) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult world emit av profile := by + exact lowerSpine_apply_run_profile_core + (HeadSound := fun sourceFunction headProfile functionOutput + emitFunction function _ => + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + functionOutput sourceEnv sourceEnv sourceFunction .shared emitFunction + function headProfile) + (Result := fun actualResult actualProfile => + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + output sourceEnv sourceEnv actualResult world emit av actualProfile) + (hheadSound := fun hhead hfunctionRun _ => + hexpr hhead hfunctionRun) + (hreflect := hreflect) + (herasedFinish := fun hsourceArgs hsourceApply hfunctionSound hrestRun => + applyRest_erased_run_profile_sound_below hargs hsourceArgs hsourceApply + hfunctionSound hrestRun) + (hnonErasedFinish := fun hfunctionNe hsourceArgs hsourceApply + hfunctionSound hrestRun => + hrest hfunctionNe hargsNonempty hsourceArgs hsourceApply hfunctionSound + hrestRun) + hsource (lowerSpine_var_dynamic_run_inv hnotSelf hrun) + +/-- Shared profiled sequencing for `knownCall`. Prefix execution, source and +profile splitting, terminal output recovery, and excess-tail dispatch are +independent of the exact/bounded and ordinary/reachable judgment carried by +the callbacks. -/ +private theorem knownCall_run_profile_core + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {fuel count : Nat} + {build : Array Atom → Op} {argWorlds : List Ixon.Owned} + {resultWorld : Ixon.Owned} {input output : VEnv} + {args : List IxIR0.Expr} {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + {Reach : LowSt → Prop} + {Result : VEnv → Emit → AVal → LowSt → Prop} + (hprefixBack : ∀ {prefixOutput : VEnv} {emitPrefix : Emit} + {prefixAVals : List AVal} {prefixState : LowSt}, + (applyRest src fuel prefixOutput.bump resultWorld + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) (args.drop count)).run prefixState = + .ok (output, emit, av) finalState → + Reach finalState → Reach prefixState) + (hterminal : ∀ {prefixOutput : VEnv} {emitPrefix : Emit} + {prefixAVals : List AVal} {sourceBuilt : IxIR0.Value} + {prefixArgsProfile prefixApplyProfile : SourceProfile} + {prefixState : LowSt}, + args.length ≤ count → + SourceArgsProfile sourceCtx sourceEnv + (((args.take count).zip + (padWorlds argWorlds count)).map Prod.fst) + (sourceValues.take count) prefixArgsProfile → + SourceAppliesProfile sourceCtx sourceFunction + (sourceValues.take count) sourceBuilt prefixApplyProfile → + (lowerArgs src fuel input + ((args.take count).zip + (padWorlds argWorlds count))).run state = + .ok (prefixOutput, emitPrefix, prefixAVals) prefixState → + prefixAVals.length = + ((args.take count).zip (padWorlds argWorlds count)).length → + sourceBuilt = sourceResult → + prefixArgsProfile = argsProfile → + prefixApplyProfile = applyProfile → + Reach prefixState → + Result prefixOutput.bump + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) prefixState) + (hoverFinish : ∀ {prefixOutput : VEnv} {emitPrefix : Emit} + {prefixAVals : List AVal} {sourceBuilt : IxIR0.Value} + {prefixArgsProfile tailArgsProfile prefixApplyProfile + tailApplyProfile : SourceProfile} {prefixState : LowSt}, + count < args.length → + SourceArgsProfile sourceCtx sourceEnv + (((args.take count).zip + (padWorlds argWorlds count)).map Prod.fst) + (sourceValues.take count) prefixArgsProfile → + SourceArgsProfile sourceCtx sourceEnv (args.drop count) + (sourceValues.drop count) tailArgsProfile → + SourceAppliesProfile sourceCtx sourceFunction + (sourceValues.take count) sourceBuilt prefixApplyProfile → + SourceAppliesProfile sourceCtx sourceBuilt (sourceValues.drop count) + sourceResult tailApplyProfile → + prefixArgsProfile + tailArgsProfile = argsProfile → + prefixApplyProfile + tailApplyProfile = applyProfile → + (lowerArgs src fuel input + ((args.take count).zip + (padWorlds argWorlds count))).run state = + .ok (prefixOutput, emitPrefix, prefixAVals) prefixState → + prefixAVals.length = + ((args.take count).zip (padWorlds argWorlds count)).length → + (applyRest src fuel prefixOutput.bump resultWorld + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) (args.drop count)).run prefixState = + .ok (output, emit, av) finalState → + Reach prefixState → Reach finalState → + Result output emit av finalState) + (hfinalReach : Reach finalState) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hrun : (knownCall src (fuel + 1) input build count argWorlds + resultWorld args).run state = .ok (output, emit, av) finalState) : + Result output emit av finalState := by + simp only [knownCall] at hrun + obtain ⟨prefixResult, prefixState, hprefixRun, hafterPrefix⟩ := + stateBindRun_ok_inv hrun + rcases prefixResult with ⟨prefixOutput, emitPrefix, prefixAVals⟩ + dsimp only at hafterPrefix + have hprefixLength := lowerArgs_success_length src hprefixRun + obtain ⟨prefixArgsProfile, tailArgsProfile, hprefixArgs, htailArgs, + hargsProfile⟩ := hsourceArgs.splitAt count + obtain ⟨sourceBuilt, prefixApplyProfile, tailApplyProfile, + hprefixApply, htailApply, happlyProfile⟩ := hsource.splitAt count + have hprefixSource : SourceArgsProfile sourceCtx sourceEnv + (((args.take count).zip + (padWorlds argWorlds count)).map Prod.fst) + (sourceValues.take count) prefixArgsProfile := by + rw [knownCall_prefix_exprs_eq] + exact hprefixArgs + by_cases hle : args.length ≤ count + · rw [if_pos hle] at hafterPrefix + have hpure : + (prefixOutput.bump, + emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray), + AVal.slotA prefixOutput.depth) = (output, emit, av) ∧ + prefixState = finalState := by + simpa using hafterPrefix + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + have hsourceLe : sourceValues.length ≤ count := by + simpa [← hsourceArgs.lengths] using hle + have hargsDrop : args.drop count = [] := + List.drop_eq_nil_of_le hle + have hvaluesDrop : sourceValues.drop count = [] := + List.drop_eq_nil_of_le hsourceLe + rw [hargsDrop, hvaluesDrop] at htailArgs + cases htailArgs + rw [hvaluesDrop] at htailApply + have hsourceBuiltEq : sourceBuilt = sourceResult := by + cases htailApply + rfl + cases htailApply + have hprefixArgsEq : prefixArgsProfile = argsProfile := + (IxIR0.DynamicCost.Profile.add_zero _).symm.trans hargsProfile + have hprefixApplyEq : prefixApplyProfile = applyProfile := + (IxIR0.DynamicCost.Profile.add_zero _).symm.trans happlyProfile + exact hterminal hle hprefixSource hprefixApply hprefixRun hprefixLength + hsourceBuiltEq hprefixArgsEq hprefixApplyEq hfinalReach + · have hover : count < args.length := Nat.lt_of_not_ge hle + rw [if_neg hle] at hafterPrefix + have hprefixReach := hprefixBack hafterPrefix hfinalReach + exact hoverFinish hover hprefixSource htailArgs hprefixApply htailApply + hargsProfile happlyProfile hprefixRun hprefixLength hafterPrefix + hprefixReach hfinalReach + +/-- Profiled counterpart of the generic `knownCall` splitter. Static head +evaluation, prefix arguments, the built operation, excess arguments, and +higher-order tail application are recombined into the exact canonical spine +profile. -/ +theorem knownCall_run_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel count : Nat} + {build : Array Atom → Op} {argWorlds : List Ixon.Owned} + {resultWorld buildWorld : Ixon.Owned} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + (hrest : ApplyRestNonErasedProfilePreserves funRel recSelfRel + sourceCtx ctx cur src fuel) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hbuild : ∀ {prefixOutput : VEnv} {emitPrefix : Emit} + {prefixAVals : List AVal} {sourceBuilt : IxIR0.Value} + {prefixArgsProfile prefixApplyProfile : SourceProfile}, + LowerArgsProfileSound funRel recSelfRel ctx cur input prefixOutput + sourceEnv sourceEnv (sourceValues.take count) + (((args.take count).zip (padWorlds argWorlds count)).map Prod.snd) + emitPrefix prefixAVals prefixArgsProfile → + SourceAppliesProfile sourceCtx sourceFunction + (sourceValues.take count) sourceBuilt prefixApplyProfile → + prefixAVals.length = + ((args.take count).zip (padWorlds argWorlds count)).length → + LowerResultProfileSound funRel recSelfRel ctx cur input + prefixOutput.bump sourceEnv sourceEnv sourceBuilt buildWorld + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) + (headProfile + prefixArgsProfile + prefixApplyProfile)) + (hterminalWorld : args.length ≤ count → buildWorld = resultWorld) + (hoverWorld : count < args.length → buildWorld = .shared) + (hrun : (knownCall src (fuel + 1) input build count argWorlds + resultWorld args).run state = .ok (output, emit, av) finalState) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult resultWorld emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_run_profile_core + (Reach := fun _ => True) + (Result := fun actualOutput actualEmit actualAV _ => + LowerResultProfileSound funRel recSelfRel ctx cur input actualOutput + sourceEnv sourceEnv sourceResult resultWorld actualEmit actualAV + (headProfile + argsProfile + applyProfile)) + ?_ ?_ ?_ trivial hsourceArgs hsource hrun + · intro _ _ _ _ _ _ + trivial + · intro prefixOutput emitPrefix prefixAVals sourceBuilt + prefixArgsProfile prefixApplyProfile _ hle hprefixSource hprefixApply + hprefixRun hprefixLength hsourceBuiltEq hprefixArgsEq hprefixApplyEq _ + cases hsourceBuiltEq + have hprefixSound := hargs hprefixSource hprefixRun + have hbuilt := hbuild hprefixSound hprefixApply hprefixLength + simpa [hterminalWorld hle, hprefixArgsEq, hprefixApplyEq] using hbuilt + · intro prefixOutput emitPrefix prefixAVals sourceBuilt + prefixArgsProfile tailArgsProfile prefixApplyProfile tailApplyProfile + _ hover _ htailArgs hprefixApply htailApply hargsProfile happlyProfile + hprefixRun hprefixLength hafterPrefix _ _ + have hprefixSound := hargs (by assumption) hprefixRun + have hbuilt := hbuild hprefixSound hprefixApply hprefixLength + have hbuiltShared : LowerResultProfileSound funRel recSelfRel ctx cur + input prefixOutput.bump sourceEnv sourceEnv sourceBuilt .shared + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) + (headProfile + prefixArgsProfile + prefixApplyProfile) := by + simpa [hoverWorld hover] using hbuilt + have htailSound := hrest (by simp) (drop_nonempty_of_lt_length hover) + htailArgs htailApply hbuiltShared hafterPrefix + apply LowerResultProfileSound.of_profile_eq htailSound + rw [← hargsProfile, ← happlyProfile] + ext <;> simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] + +/-- Direct-call specialization of profiled `knownCall`. -/ +theorem knownCall_call_run_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur d : FnDef} + {src : IxIR0.Env} {fuel count : Nat} + {argWorlds : List Ixon.Owned} {resultWorld : Ixon.Owned} + {f : Ixon.Address} {input output : VEnv} + {args : List IxIR0.Expr} {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + (hrest : ApplyRestNonErasedProfilePreserves funRel recSelfRel + sourceCtx ctx cur src fuel) + (hworlds : argWorlds.length = count) + (hcount : count ≤ args.length) + (hdecl : ctx.decls f = some (.fn d)) + (hownership : Sim.FnOwnershipContract ctx d argWorlds) + (hvalue : FnValueContract funRel sourceCtx ctx d argWorlds + sourceFunction) + (hcost : FnProfileContract funRel sourceCtx ctx f d argWorlds sourceFunction) + (hhead : SourceRefProfile sourceCtx f sourceFunction headProfile) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hterminalWorld : args.length ≤ count → d.result = resultWorld) + (hoverWorld : count < args.length → d.result = .shared) + (hrun : (knownCall src (fuel + 1) input (.call f ·) count + argWorlds resultWorld args).run state = + .ok (output, emit, av) finalState) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult resultWorld emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_run_profile_sound hargs hrest hsourceArgs hsource + ?_ hterminalWorld hoverWorld hrun + intro prefixOutput emitPrefix prefixAVals sourceBuilt prefixArgsProfile + prefixApplyProfile hprefixSound hprefixApply _ + have hshape := knownCall_prefix_worlds_eq args argWorlds count + hworlds hcount + have hprefix : LowerArgsProfileSound funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + argWorlds emitPrefix prefixAVals prefixArgsProfile := by + simpa only [hshape] using hprefixSound + exact hprefix.call_graph_from_ref hdecl hownership hvalue hcost hhead + hprefixApply + +/-- Explicit-contract recursive-self specialization of profiled +`knownCall`. -/ +theorem knownCall_callSelf_run_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {sourceAddress : Ixon.Address} + {src : IxIR0.Env} {fuel count : Nat} + {argWorlds : List Ixon.Owned} {resultWorld : Ixon.Owned} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + (hrest : ApplyRestNonErasedProfilePreserves funRel recSelfRel + sourceCtx ctx cur src fuel) + (hworlds : argWorlds.length = count) + (hcount : count ≤ args.length) + (hownership : Sim.FnOwnershipContract ctx cur argWorlds) + (hvalue : FnValueContract funRel sourceCtx ctx cur argWorlds + sourceFunction) + (hcost : FnProfileContract funRel sourceCtx ctx sourceAddress cur argWorlds + sourceFunction) + (hpositive : 0 < count) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hterminalWorld : args.length ≤ count → cur.result = resultWorld) + (hoverWorld : count < args.length → cur.result = .shared) + (hrun : (knownCall src (fuel + 1) input (.callSelf ·) count + argWorlds resultWorld args).run state = + .ok (output, emit, av) finalState) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult resultWorld emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_run_profile_sound hargs hrest hsourceArgs hsource + ?_ hterminalWorld hoverWorld hrun + intro prefixOutput emitPrefix prefixAVals sourceBuilt prefixArgsProfile + prefixApplyProfile hprefixSound hprefixApply _ + have hshape := knownCall_prefix_worlds_eq args argWorlds count + hworlds hcount + have hprefix : LowerArgsProfileSound funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + argWorlds emitPrefix prefixAVals prefixArgsProfile := by + simpa only [hshape] using hprefixSound + have hsourceCount : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hsourceCount] + have hnonempty : sourceValues.take count ≠ [] := by + intro hempty + rw [hempty] at htakeLength + simp at htakeLength + omega + have hcalled := hprefix.callSelf_graph hownership hvalue hcost + (hprefixApply.toFnEntryProfile hnonempty) + apply LowerResultProfileSound.of_profile_eq + (hcalled.addProfileLeft headProfile) + exact (IxIR0.DynamicCost.Profile.add_assoc _ _ _).symm + +/-- Recursive-self `knownCall` whose value and cost contracts are selected +from the synthetic self entry in the logical input environment. -/ +theorem knownCall_callSelf_entry_run_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel count index : Nat} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + (hrest : ApplyRestNonErasedProfilePreserves funRel recSelfRel + sourceCtx ctx cur src fuel) + (hcount : count ≤ args.length) + (hentry : input.entries[index]? = some (.recSelf count)) + (hhead : sourceEnv[index]? = some sourceFunction) + (hownership : Sim.FnOwnershipContract ctx cur + (List.replicate count .shared)) + (hvalue : recSelfRel sourceFunction count → + FnValueContract funRel sourceCtx ctx cur + (List.replicate count .shared) sourceFunction) + (hcost : recSelfRel sourceFunction count → + ∃ sourceAddress, + FnProfileContract funRel sourceCtx ctx sourceAddress cur + (List.replicate count .shared) sourceFunction) + (hpositive : 0 < count) + (hresult : cur.result = .shared) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hrun : (knownCall src (fuel + 1) input (.callSelf ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult .shared emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_run_profile_sound hargs hrest hsourceArgs hsource + ?_ (fun _ => by simpa [hresult]) (fun _ => by simpa [hresult]) hrun + intro prefixOutput emitPrefix prefixAVals sourceBuilt prefixArgsProfile + prefixApplyProfile hprefixSound hprefixApply _ + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hprefix : LowerArgsProfileSound funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate count .shared) emitPrefix prefixAVals + prefixArgsProfile := by + simpa only [hshape] using hprefixSound + have hsourceCount : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hsourceCount] + have hnonempty : sourceValues.take count ≠ [] := by + intro hempty + rw [hempty] at htakeLength + simp at htakeLength + omega + have hcalled := hprefix.callSelf_entry_graph hentry hhead hownership + hvalue hcost hprefixApply hnonempty + apply LowerResultProfileSound.of_profile_eq + (hcalled.addProfileLeft headProfile) + exact (IxIR0.DynamicCost.Profile.add_assoc _ _ _).symm + +/-- Constructor-allocation specialization of profiled `knownCall`. +Static evaluation of the constructor head funds the fresh constructor node; +the saturated source prefix identifies the constructor fields exactly. -/ +theorem knownCall_alloc_run_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel count : Nat} {world : Ixon.Owned} + {cid : CtorId} {sourceAddress : Ixon.Address} {sourceTag : Nat} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + (hrest : ApplyRestNonErasedProfilePreserves funRel recSelfRel + sourceCtx ctx cur src fuel) + (hcount : count ≤ args.length) + (haddress : cid.block = sourceAddress) + (htag : cid.cidx = sourceTag) + (hheadPos : 0 < headProfile.evals) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hctor : SourceApplies sourceCtx sourceFunction + (sourceValues.take count) + (.ctor sourceAddress sourceTag (sourceValues.take count))) + (hrun : (knownCall src (fuel + 1) input (.alloc world cid ·) count + (List.replicate count world) world args).run state = + .ok (output, emit, av) finalState) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_run_profile_sound hargs hrest hsourceArgs hsource + ?_ (fun _ => rfl) ?_ hrun + · intro prefixOutput emitPrefix prefixAVals sourceBuilt + prefixArgsProfile prefixApplyProfile hprefixSound hprefixApply + hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count world) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count world) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsProfileSound funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length world) + emitPrefix prefixAVals prefixArgsProfile := by + simpa only [hshape, havsLength] using hprefixSound + have hopPos : 0 < (headProfile + prefixApplyProfile).evals := by + change 0 < headProfile.evals + prefixApplyProfile.evals + omega + have hallocated := hprefix.alloc_graph_of_evals_pos haddress htag hopPos + rw [hprefixApply.toSourceApplies.deterministic hctor] + apply LowerResultProfileSound.of_profile_eq hallocated + ext <;> simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] + · intro hover + exact knownCall_over_run_world_shared hover hrun + +/-- Scalar-extern specialization of profiled `knownCall`. The target +extern operation is ownership-free, while the exact source prefix profile +and statically erased head profile remain in the canonical spine total. -/ +theorem knownCall_extern_run_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel count : Nat} {f : Ixon.Address} + {input output : VEnv} {resultWorld : Ixon.Owned} + {args : List IxIR0.Expr} {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + (hrest : ApplyRestNonErasedProfilePreserves funRel recSelfRel + sourceCtx ctx cur src fuel) + (hcontract : ExternValueContract funRel sourceCtx ctx) + (hcount : count ≤ args.length) + (hlookup : sourceCtx.env f = some (.extern count)) + (href : SourceRefValue sourceCtx f sourceFunction) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hrun : (knownCall src (fuel + 1) input (.extern f ·) count + (List.replicate count .shared) resultWorld args).run state = + .ok (output, emit, av) finalState) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult resultWorld emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_run_profile_sound hargs hrest hsourceArgs hsource + ?_ (fun _ => rfl) ?_ hrun + · intro prefixOutput emitPrefix prefixAVals sourceBuilt + prefixArgsProfile prefixApplyProfile hprefixSound hprefixApply + hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count .shared) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsProfileSound funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length .shared) + emitPrefix prefixAVals prefixArgsProfile := by + simpa only [hshape, havsLength] using hprefixSound + have hvalueCount : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hvalueCount] + have hextern := hprefix.extern_graph (resultWorld := resultWorld) + hcontract hlookup href htakeLength hprefixApply + apply LowerResultProfileSound.of_profile_eq + (hextern.addProfileLeft headProfile) + exact (IxIR0.DynamicCost.Profile.add_assoc _ _ _).symm + · intro hover + exact knownCall_over_run_world_shared hover hrun + +/-- Partial-application specialization of profiled `knownCall`. Static +head evaluation funds the fresh PAP node; the application prefix remains +available for the exact canonical spine profile. -/ +theorem knownCall_papp_run_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel count : Nat} {f : Ixon.Address} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + (hrest : ApplyRestNonErasedProfilePreserves funRel recSelfRel + sourceCtx ctx cur src fuel) + (hcount : count ≤ args.length) + (hdecl : ctx.decls f = some d) + (hunder : count < declArity d) + (hheadPos : 0 < headProfile.evals) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hfun : ∀ {sourceBuilt : IxIR0.Value}, + SourceApplies sourceCtx sourceFunction (sourceValues.take count) + sourceBuilt → + funRel sourceBuilt f (declArity d) (sourceValues.take count)) + (hrun : (knownCall src (fuel + 1) input (.papp f ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult .shared emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_run_profile_sound hargs hrest hsourceArgs hsource + ?_ (fun _ => rfl) (fun _ => rfl) hrun + intro prefixOutput emitPrefix prefixAVals sourceBuilt prefixArgsProfile + prefixApplyProfile hprefixSound hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count .shared) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsProfileSound funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length .shared) emitPrefix prefixAVals + prefixArgsProfile := by + simpa only [hshape, havsLength] using hprefixSound + have hopPos : 0 < (headProfile + prefixApplyProfile).evals := by + change 0 < headProfile.evals + prefixApplyProfile.evals + omega + have hpapp := hprefix.papp_graph_of_evals_pos hdecl + (hfun hprefixApply.toSourceApplies) (by simpa [havsLength] using hunder) + hopPos + apply LowerResultProfileSound.of_profile_eq hpapp + ext <;> simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] + +/-- Same-address static PAP allocation under the canonical compiler function +relation. -/ +theorem knownCall_papp_source_run_profile_sound + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel count : Nat} + {f : Ixon.Address} {source : IxIR0.Decl} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hrest : ApplyRestNonErasedProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hcount : count ≤ args.length) + (hsrc : src f = some source) + (heligible : SourcePapEligible source) + (harity : sourceDeclArity source = declArity d) + (href : SourceRefValue sourceCtx f sourceFunction) + (hdecl : ctx.decls f = some d) + (hunder : count < declArity d) + (hheadPos : 0 < headProfile.evals) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hrun : (knownCall src (fuel + 1) input (.papp f ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel ctx cur + input output sourceEnv sourceEnv sourceResult .shared emit av + (headProfile + argsProfile + applyProfile) := by + apply knownCall_papp_run_profile_sound hargs hrest hcount hdecl hunder + hheadPos hsourceArgs hsource + · intro sourceBuilt hprefixApply + apply CompilerFunctionRel.source hsrc heligible harity href hprefixApply + have hcountValues : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hcountValues] + simpa [htakeLength] using hunder + · exact hrun + +/-- Constructor-wrapper PAP allocation under the canonical compiler +function relation. -/ +theorem knownCall_papp_wrapper_run_profile_sound + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel count : Nat} + {memo : WrapperMemo} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hrest : ApplyRestNonErasedProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hcount : count ≤ args.length) + (hmember : memo ∈ relationState.wrappers) + (hsrc : src memo.source = some (.ctor memo.tag memo.arity)) + (href : SourceRefValue sourceCtx memo.source sourceFunction) + (hdecl : ctx.decls memo.wrapper = some d) + (harity : memo.arity = declArity d) + (hunder : count < declArity d) + (hheadPos : 0 < headProfile.evals) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hrun : (knownCall src (fuel + 1) input (.papp memo.wrapper ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel ctx cur + input output sourceEnv sourceEnv sourceResult .shared emit av + (headProfile + argsProfile + applyProfile) := by + apply knownCall_papp_run_profile_sound hargs hrest hcount hdecl hunder + hheadPos hsourceArgs hsource + · intro sourceBuilt hprefixApply + rw [← harity] + apply CompilerFunctionRel.wrapper hmember hsrc href hprefixApply + have hcountValues : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hcountValues] + rw [htakeLength] + simpa [harity] using hunder + · exact hrun + +/-- Target-fuel-bounded counterpart of the generic `knownCall` splitter. Static head +evaluation, prefix arguments, the built operation, excess arguments, and +higher-order tail application are recombined into the exact canonical spine +profile. -/ +theorem knownCall_run_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {fuel count : Nat} + {build : Array Atom → Op} {argWorlds : List Ixon.Owned} + {resultWorld buildWorld : Ixon.Owned} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreservesBelow funRel recSelfRel sourceCtx ctx cur limit + src fuel) + (hrest : ApplyRestNonErasedProfilePreservesBelow funRel recSelfRel + sourceCtx ctx cur limit src fuel) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hbuild : ∀ {prefixOutput : VEnv} {emitPrefix : Emit} + {prefixAVals : List AVal} {sourceBuilt : IxIR0.Value} + {prefixArgsProfile prefixApplyProfile : SourceProfile}, + LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit input prefixOutput + sourceEnv sourceEnv (sourceValues.take count) + (((args.take count).zip (padWorlds argWorlds count)).map Prod.snd) + emitPrefix prefixAVals prefixArgsProfile → + SourceAppliesProfile sourceCtx sourceFunction + (sourceValues.take count) sourceBuilt prefixApplyProfile → + prefixAVals.length = + ((args.take count).zip (padWorlds argWorlds count)).length → + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + prefixOutput.bump sourceEnv sourceEnv sourceBuilt buildWorld + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) + (headProfile + prefixArgsProfile + prefixApplyProfile)) + (hterminalWorld : args.length ≤ count → buildWorld = resultWorld) + (hoverWorld : count < args.length → buildWorld = .shared) + (hrun : (knownCall src (fuel + 1) input build count argWorlds + resultWorld args).run state = .ok (output, emit, av) finalState) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult resultWorld emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_run_profile_core + (Reach := fun _ => True) + (Result := fun actualOutput actualEmit actualAV _ => + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + actualOutput sourceEnv sourceEnv sourceResult resultWorld actualEmit + actualAV (headProfile + argsProfile + applyProfile)) + ?_ ?_ ?_ trivial hsourceArgs hsource hrun + · intro _ _ _ _ _ _ + trivial + · intro prefixOutput emitPrefix prefixAVals sourceBuilt + prefixArgsProfile prefixApplyProfile _ hle hprefixSource hprefixApply + hprefixRun hprefixLength hsourceBuiltEq hprefixArgsEq hprefixApplyEq _ + cases hsourceBuiltEq + have hprefixSound := hargs hprefixSource hprefixRun + have hbuilt := hbuild hprefixSound hprefixApply hprefixLength + simpa [hterminalWorld hle, hprefixArgsEq, hprefixApplyEq] using hbuilt + · intro prefixOutput emitPrefix prefixAVals sourceBuilt + prefixArgsProfile tailArgsProfile prefixApplyProfile tailApplyProfile + _ hover _ htailArgs hprefixApply htailApply hargsProfile happlyProfile + hprefixRun hprefixLength hafterPrefix _ _ + have hprefixSound := hargs (by assumption) hprefixRun + have hbuilt := hbuild hprefixSound hprefixApply hprefixLength + have hbuiltShared : LowerResultProfileSoundBelow funRel recSelfRel ctx cur + limit input prefixOutput.bump sourceEnv sourceEnv sourceBuilt .shared + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) + (headProfile + prefixArgsProfile + prefixApplyProfile) := by + simpa [hoverWorld hover] using hbuilt + have htailSound := hrest (by simp) (drop_nonempty_of_lt_length hover) + htailArgs htailApply hbuiltShared hafterPrefix + apply LowerResultProfileSoundBelow.of_profile_eq htailSound + rw [← hargsProfile, ← happlyProfile] + ext <;> simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] + +/-- Target-fuel-bounded direct-call specialization of profiled `knownCall`. -/ +theorem knownCall_call_run_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur d : FnDef} {limit : Nat} + {src : IxIR0.Env} {fuel count : Nat} + {argWorlds : List Ixon.Owned} {resultWorld : Ixon.Owned} + {f : Ixon.Address} {input output : VEnv} + {args : List IxIR0.Expr} {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreservesBelow funRel recSelfRel sourceCtx ctx cur limit + src fuel) + (hrest : ApplyRestNonErasedProfilePreservesBelow funRel recSelfRel + sourceCtx ctx cur limit src fuel) + (hworlds : argWorlds.length = count) + (hcount : count ≤ args.length) + (hdecl : ctx.decls f = some (.fn d)) + (hownership : Sim.FnOwnershipContract ctx d argWorlds) + (hvalue : FnValueContract funRel sourceCtx ctx d argWorlds + sourceFunction) + (hcost : FnProfileContractBelow funRel sourceCtx ctx f d argWorlds + sourceFunction limit) + (hhead : SourceRefProfile sourceCtx f sourceFunction headProfile) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hterminalWorld : args.length ≤ count → d.result = resultWorld) + (hoverWorld : count < args.length → d.result = .shared) + (hrun : (knownCall src (fuel + 1) input (.call f ·) count + argWorlds resultWorld args).run state = + .ok (output, emit, av) finalState) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult resultWorld emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_run_profile_sound_below hargs hrest hsourceArgs hsource + ?_ hterminalWorld hoverWorld hrun + intro prefixOutput emitPrefix prefixAVals sourceBuilt prefixArgsProfile + prefixApplyProfile hprefixSound hprefixApply _ + have hshape := knownCall_prefix_worlds_eq args argWorlds count + hworlds hcount + have hprefix : LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + argWorlds emitPrefix prefixAVals prefixArgsProfile := by + simpa only [hshape] using hprefixSound + exact hprefix.call_graph_from_ref hdecl hownership hvalue hcost hhead + hprefixApply + +/-- Target-fuel-bounded explicit-contract recursive-self specialization of profiled +`knownCall`. -/ +theorem knownCall_callSelf_run_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {sourceAddress : Ixon.Address} + {src : IxIR0.Env} {fuel count : Nat} + {argWorlds : List Ixon.Owned} {resultWorld : Ixon.Owned} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreservesBelow funRel recSelfRel sourceCtx ctx cur limit + src fuel) + (hrest : ApplyRestNonErasedProfilePreservesBelow funRel recSelfRel + sourceCtx ctx cur limit src fuel) + (hworlds : argWorlds.length = count) + (hcount : count ≤ args.length) + (hownership : Sim.FnOwnershipContract ctx cur argWorlds) + (hvalue : FnValueContract funRel sourceCtx ctx cur argWorlds + sourceFunction) + (hcost : FnProfileContractBelow funRel sourceCtx ctx sourceAddress cur argWorlds + sourceFunction limit) + (hpositive : 0 < count) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hterminalWorld : args.length ≤ count → cur.result = resultWorld) + (hoverWorld : count < args.length → cur.result = .shared) + (hrun : (knownCall src (fuel + 1) input (.callSelf ·) count + argWorlds resultWorld args).run state = + .ok (output, emit, av) finalState) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult resultWorld emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_run_profile_sound_below hargs hrest hsourceArgs hsource + ?_ hterminalWorld hoverWorld hrun + intro prefixOutput emitPrefix prefixAVals sourceBuilt prefixArgsProfile + prefixApplyProfile hprefixSound hprefixApply _ + have hshape := knownCall_prefix_worlds_eq args argWorlds count + hworlds hcount + have hprefix : LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + argWorlds emitPrefix prefixAVals prefixArgsProfile := by + simpa only [hshape] using hprefixSound + have hsourceCount : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hsourceCount] + have hnonempty : sourceValues.take count ≠ [] := by + intro hempty + rw [hempty] at htakeLength + simp at htakeLength + omega + have hcalled := hprefix.callSelf_graph hownership hvalue hcost + (hprefixApply.toFnEntryProfile hnonempty) + apply LowerResultProfileSoundBelow.of_profile_eq + (hcalled.addProfileLeft headProfile) + exact (IxIR0.DynamicCost.Profile.add_assoc _ _ _).symm + +/-- Target-fuel-bounded recursive-self `knownCall` whose value and cost contracts are selected +from the synthetic self entry in the logical input environment. -/ +theorem knownCall_callSelf_entry_run_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {fuel count index : Nat} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreservesBelow funRel recSelfRel sourceCtx ctx cur limit + src fuel) + (hrest : ApplyRestNonErasedProfilePreservesBelow funRel recSelfRel + sourceCtx ctx cur limit src fuel) + (hcount : count ≤ args.length) + (hentry : input.entries[index]? = some (.recSelf count)) + (hhead : sourceEnv[index]? = some sourceFunction) + (hownership : Sim.FnOwnershipContract ctx cur + (List.replicate count .shared)) + (hvalue : recSelfRel sourceFunction count → + FnValueContract funRel sourceCtx ctx cur + (List.replicate count .shared) sourceFunction) + (hcost : recSelfRel sourceFunction count → + ∃ sourceAddress, + FnProfileContractBelow funRel sourceCtx ctx sourceAddress cur + (List.replicate count .shared) sourceFunction limit) + (hpositive : 0 < count) + (hresult : cur.result = .shared) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hrun : (knownCall src (fuel + 1) input (.callSelf ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult .shared emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_run_profile_sound_below hargs hrest hsourceArgs hsource + ?_ (fun _ => by simpa [hresult]) (fun _ => by simpa [hresult]) hrun + intro prefixOutput emitPrefix prefixAVals sourceBuilt prefixArgsProfile + prefixApplyProfile hprefixSound hprefixApply _ + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hprefix : LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate count .shared) emitPrefix prefixAVals + prefixArgsProfile := by + simpa only [hshape] using hprefixSound + have hsourceCount : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hsourceCount] + have hnonempty : sourceValues.take count ≠ [] := by + intro hempty + rw [hempty] at htakeLength + simp at htakeLength + omega + have hcalled := hprefix.callSelf_entry_graph hentry hhead hownership + hvalue hcost hprefixApply hnonempty + apply LowerResultProfileSoundBelow.of_profile_eq + (hcalled.addProfileLeft headProfile) + exact (IxIR0.DynamicCost.Profile.add_assoc _ _ _).symm + +/-- Target-fuel-bounded constructor-allocation specialization of profiled `knownCall`. +Static evaluation of the constructor head funds the fresh constructor node; +the saturated source prefix identifies the constructor fields exactly. -/ +theorem knownCall_alloc_run_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {fuel count : Nat} {world : Ixon.Owned} + {cid : CtorId} {sourceAddress : Ixon.Address} {sourceTag : Nat} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreservesBelow funRel recSelfRel sourceCtx ctx cur limit + src fuel) + (hrest : ApplyRestNonErasedProfilePreservesBelow funRel recSelfRel + sourceCtx ctx cur limit src fuel) + (hcount : count ≤ args.length) + (haddress : cid.block = sourceAddress) + (htag : cid.cidx = sourceTag) + (hheadPos : 0 < headProfile.evals) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hctor : SourceApplies sourceCtx sourceFunction + (sourceValues.take count) + (.ctor sourceAddress sourceTag (sourceValues.take count))) + (hrun : (knownCall src (fuel + 1) input (.alloc world cid ·) count + (List.replicate count world) world args).run state = + .ok (output, emit, av) finalState) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult world emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_run_profile_sound_below hargs hrest hsourceArgs hsource + ?_ (fun _ => rfl) ?_ hrun + · intro prefixOutput emitPrefix prefixAVals sourceBuilt + prefixArgsProfile prefixApplyProfile hprefixSound hprefixApply + hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count world) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count world) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length world) + emitPrefix prefixAVals prefixArgsProfile := by + simpa only [hshape, havsLength] using hprefixSound + have hopPos : 0 < (headProfile + prefixApplyProfile).evals := by + change 0 < headProfile.evals + prefixApplyProfile.evals + omega + have hallocated := hprefix.alloc_graph_of_evals_pos haddress htag hopPos + rw [hprefixApply.toSourceApplies.deterministic hctor] + apply LowerResultProfileSoundBelow.of_profile_eq hallocated + ext <;> simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] + · intro hover + exact knownCall_over_run_world_shared hover hrun + +/-- Target-fuel-bounded scalar-extern specialization of profiled `knownCall`. The target +extern operation is ownership-free, while the exact source prefix profile +and statically erased head profile remain in the canonical spine total. -/ +theorem knownCall_extern_run_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {fuel count : Nat} {f : Ixon.Address} + {input output : VEnv} {resultWorld : Ixon.Owned} + {args : List IxIR0.Expr} {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreservesBelow funRel recSelfRel sourceCtx ctx cur limit + src fuel) + (hrest : ApplyRestNonErasedProfilePreservesBelow funRel recSelfRel + sourceCtx ctx cur limit src fuel) + (hcontract : ExternValueContract funRel sourceCtx ctx) + (hcount : count ≤ args.length) + (hlookup : sourceCtx.env f = some (.extern count)) + (href : SourceRefValue sourceCtx f sourceFunction) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hrun : (knownCall src (fuel + 1) input (.extern f ·) count + (List.replicate count .shared) resultWorld args).run state = + .ok (output, emit, av) finalState) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult resultWorld emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_run_profile_sound_below hargs hrest hsourceArgs hsource + ?_ (fun _ => rfl) ?_ hrun + · intro prefixOutput emitPrefix prefixAVals sourceBuilt + prefixArgsProfile prefixApplyProfile hprefixSound hprefixApply + hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count .shared) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length .shared) + emitPrefix prefixAVals prefixArgsProfile := by + simpa only [hshape, havsLength] using hprefixSound + have hvalueCount : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hvalueCount] + have hextern := hprefix.extern_graph (resultWorld := resultWorld) + hcontract hlookup href htakeLength hprefixApply + apply LowerResultProfileSoundBelow.of_profile_eq + (hextern.addProfileLeft headProfile) + exact (IxIR0.DynamicCost.Profile.add_assoc _ _ _).symm + · intro hover + exact knownCall_over_run_world_shared hover hrun + +/-- Target-fuel-bounded partial-application specialization of profiled `knownCall`. Static +head evaluation funds the fresh PAP node; the application prefix remains +available for the exact canonical spine profile. -/ +theorem knownCall_papp_run_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {fuel count : Nat} {f : Ixon.Address} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreservesBelow funRel recSelfRel sourceCtx ctx cur limit + src fuel) + (hrest : ApplyRestNonErasedProfilePreservesBelow funRel recSelfRel + sourceCtx ctx cur limit src fuel) + (hcount : count ≤ args.length) + (hdecl : ctx.decls f = some d) + (hunder : count < declArity d) + (hheadPos : 0 < headProfile.evals) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hfun : ∀ {sourceBuilt : IxIR0.Value}, + SourceApplies sourceCtx sourceFunction (sourceValues.take count) + sourceBuilt → + funRel sourceBuilt f (declArity d) (sourceValues.take count)) + (hrun : (knownCall src (fuel + 1) input (.papp f ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult .shared emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_run_profile_sound_below hargs hrest hsourceArgs hsource + ?_ (fun _ => rfl) (fun _ => rfl) hrun + intro prefixOutput emitPrefix prefixAVals sourceBuilt prefixArgsProfile + prefixApplyProfile hprefixSound hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count .shared) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length .shared) emitPrefix prefixAVals + prefixArgsProfile := by + simpa only [hshape, havsLength] using hprefixSound + have hopPos : 0 < (headProfile + prefixApplyProfile).evals := by + change 0 < headProfile.evals + prefixApplyProfile.evals + omega + have hpapp := hprefix.papp_graph_of_evals_pos hdecl + (hfun hprefixApply.toSourceApplies) (by simpa [havsLength] using hunder) + hopPos + apply LowerResultProfileSoundBelow.of_profile_eq hpapp + ext <;> simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] + +/-- Target-fuel-bounded same-address static PAP allocation under the canonical compiler function +relation. -/ +theorem knownCall_papp_source_run_profile_sound_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel count : Nat} + {f : Ixon.Address} {source : IxIR0.Decl} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src fuel) + (hrest : ApplyRestNonErasedProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src fuel) + (hcount : count ≤ args.length) + (hsrc : src f = some source) + (heligible : SourcePapEligible source) + (harity : sourceDeclArity source = declArity d) + (href : SourceRefValue sourceCtx f sourceFunction) + (hdecl : ctx.decls f = some d) + (hunder : count < declArity d) + (hheadPos : 0 < headProfile.evals) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hrun : (knownCall src (fuel + 1) input (.papp f ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel ctx cur limit + input output sourceEnv sourceEnv sourceResult .shared emit av + (headProfile + argsProfile + applyProfile) := by + apply knownCall_papp_run_profile_sound_below hargs hrest hcount hdecl hunder + hheadPos hsourceArgs hsource + · intro sourceBuilt hprefixApply + apply CompilerFunctionRel.source hsrc heligible harity href hprefixApply + have hcountValues : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hcountValues] + simpa [htakeLength] using hunder + · exact hrun + +/-- Target-fuel-bounded constructor-wrapper PAP allocation under the canonical compiler +function relation. -/ +theorem knownCall_papp_wrapper_run_profile_sound_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel count : Nat} + {memo : WrapperMemo} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src fuel) + (hrest : ApplyRestNonErasedProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src fuel) + (hcount : count ≤ args.length) + (hmember : memo ∈ relationState.wrappers) + (hsrc : src memo.source = some (.ctor memo.tag memo.arity)) + (href : SourceRefValue sourceCtx memo.source sourceFunction) + (hdecl : ctx.decls memo.wrapper = some d) + (harity : memo.arity = declArity d) + (hunder : count < declArity d) + (hheadPos : 0 < headProfile.evals) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hrun : (knownCall src (fuel + 1) input (.papp memo.wrapper ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel ctx cur limit + input output sourceEnv sourceEnv sourceResult .shared emit av + (headProfile + argsProfile + applyProfile) := by + apply knownCall_papp_run_profile_sound_below hargs hrest hcount hdecl hunder + hheadPos hsourceArgs hsource + · intro sourceBuilt hprefixApply + rw [← harity] + apply CompilerFunctionRel.wrapper hmember hsrc href hprefixApply + have hcountValues : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hcountValues] + rw [htakeLength] + simpa [harity] using hunder + · exact hrun + +/-- Saturated and over-applied definition references use the paired value, +ownership, and exact-profile declaration contracts selected at the source +address. -/ +theorem lowerSpine_ref_defn_call_run_profile_sound + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hrest : ApplyRestNonErasedProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hdecls : SourceDeclContracts src ctx) + (hvalues : SourceDeclValueContracts + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx) + (hprofiles : SourceDeclProfileContracts + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx) + {input output : VEnv} {world result : Ixon.Owned} + {f : Ixon.Address} {body : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.defn result body)) + (hcount : lamArity body ≤ args.length) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult world emit av + profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hrefProfile, hsourceArgs, hsourceApply, hprofile, + _⟩ := hsource.refProfileData + obtain ⟨d, hdecl, harity, hresult, hownership⟩ := hdecls.defn hsrc + have hvalue : FnValueContract + (CompilerFunctionRel sourceCtx src relationState) sourceCtx ctx d + ((lamUses body).map worldOfUses) sourceFunction := by + apply hvalues.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + have hcost : FnProfileContract + (CompilerFunctionRel sourceCtx src relationState) sourceCtx ctx f d + ((lamUses body).map worldOfUses) sourceFunction := by + apply hprofiles.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_neg (Nat.not_lt.mpr hcount)] at hrun + obtain ⟨checked, nextState, hrequireRun, hknownRun⟩ := + stateBindRun_ok_inv hrun + cases checked + obtain ⟨hguard, _⟩ := requireResultWorld_run_ok_inv hrequireRun + have hknownSound : LowerResultProfileSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult world emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_call_run_profile_sound hargs hrest (by simp) hcount + hdecl hownership hvalue hcost hrefProfile hsourceArgs hsourceApply ?_ ?_ + hknownRun + · intro hterminal + have heq : args.length = lamArity body := + Nat.le_antisymm hterminal hcount + simpa [hresult, heq] using hguard + · intro hover + have hne : args.length ≠ lamArity body := Nat.ne_of_gt hover + simpa [hresult, hne] using hguard + exact LowerResultProfileSound.of_profile_eq hknownSound hprofile + +/-- Under-applied definition references allocate a same-address PAP. The +nonempty static reference-head profile funds the node while the exact +argument/application fragments remain in the canonical spine total. -/ +theorem lowerSpine_ref_defn_partial_run_profile_sound + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hrest : ApplyRestNonErasedProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world result : Ixon.Owned} + {f : Ixon.Address} {body : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.defn result body)) + (hunder : args.length < lamArity body) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult world emit av + profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hsourceArgs, hsourceApply, hprofile, hheadPos⟩ := + hsource.refData + obtain ⟨d, hdecl, harity, _, _⟩ := hdecls.defn hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Ixon.Owned.unique == Ixon.Owned.unique) = true := by decide + have hsuEq : (Ixon.Owned.shared == Ixon.Owned.unique) = false := by decide + cases world with + | unique => + exact (stateThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + cases result with + | unique => + exact (stateThrowRun_not_ok + (by simpa [hsuEq, huuEq] using hrun)).elim + | shared => + cases hp : papSafe body with + | false => + exact (stateThrowRun_not_ok + (by simpa [hsuEq, hp] using hrun)).elim + | true => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq, hp] using hrun + have hknownSound : LowerResultProfileSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult .shared + emit av (headProfile + argsProfile + applyProfile) := by + apply knownCall_papp_source_run_profile_sound hargs hrest + (Nat.le_refl _) hsrc ⟨rfl, hp⟩ + (by simpa [sourceDeclArity, declArity] using harity.symm) + href hdecl (by simpa [declArity, harity] using hunder) + hheadPos hsourceArgs hsourceApply hknown + exact LowerResultProfileSound.of_profile_eq hknownSound hprofile + +/-- Saturated and over-applied recursor references use the generated direct +function's value, ownership, and exact-profile contracts. -/ +theorem lowerSpine_ref_recursor_call_run_profile_sound + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hrest : ApplyRestNonErasedProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hdecls : SourceDeclContracts src ctx) + (hvalues : SourceDeclValueContracts + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx) + (hprofiles : SourceDeclProfileContracts + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {numArgs : Nat} {natLit : Bool} {rules : Array IxIR0.RecRule} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsrc : src f = some (.recursor numArgs natLit rules)) + (hcount : numArgs + 1 ≤ args.length) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult world emit av + profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hrefProfile, hsourceArgs, hsourceApply, hprofile, + _⟩ := hsource.refProfileData + obtain ⟨d, hdecl, harity, hresult, hownership⟩ := + hdecls.recursor hsrc + have hvalue : FnValueContract + (CompilerFunctionRel sourceCtx src relationState) sourceCtx ctx d + (List.replicate (numArgs + 1) .shared) sourceFunction := by + apply hvalues.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + have hcost : FnProfileContract + (CompilerFunctionRel sourceCtx src relationState) sourceCtx ctx f d + (List.replicate (numArgs + 1) .shared) sourceFunction := by + apply hprofiles.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_neg (Nat.not_lt.mpr hcount)] at hrun + obtain ⟨checked, nextState, hrequireRun, hknownRun⟩ := + stateBindRun_ok_inv hrun + cases checked + obtain ⟨hguard, _⟩ := requireResultWorld_run_ok_inv hrequireRun + have hknownSound : LowerResultProfileSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult world emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_call_run_profile_sound hargs hrest (by simp) hcount + hdecl hownership hvalue hcost hrefProfile hsourceArgs hsourceApply ?_ ?_ + hknownRun + · intro hterminal + have heq : args.length = numArgs + 1 := + Nat.le_antisymm hterminal hcount + simpa [hresult, heq] using hguard + · intro _ + simpa [hresult] using hguard + exact LowerResultProfileSound.of_profile_eq hknownSound hprofile + +/-- Under-applied recursor references allocate ordinary same-address PAPs, +funded by the nonempty static head profile. -/ +theorem lowerSpine_ref_recursor_partial_run_profile_sound + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hrest : ApplyRestNonErasedProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {numArgs : Nat} {natLit : Bool} {rules : Array IxIR0.RecRule} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsrc : src f = some (.recursor numArgs natLit rules)) + (hunder : args.length < numArgs + 1) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult world emit av + profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hsourceArgs, hsourceApply, hprofile, hheadPos⟩ := + hsource.refData + obtain ⟨d, hdecl, harity, _, _⟩ := hdecls.recursor hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Ixon.Owned.unique == Ixon.Owned.unique) = true := by decide + have hsuEq : (Ixon.Owned.shared == Ixon.Owned.unique) = false := by decide + cases world with + | unique => + exact (stateThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + have hknownSound : LowerResultProfileSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult .shared emit av + (headProfile + argsProfile + applyProfile) := by + apply knownCall_papp_source_run_profile_sound hargs hrest + (Nat.le_refl _) hsrc (by simp [SourcePapEligible]) + (by simpa [sourceDeclArity, declArity] using harity.symm) + href hdecl (by simpa [declArity, harity] using hunder) + hheadPos hsourceArgs hsourceApply hknown + exact LowerResultProfileSound.of_profile_eq hknownSound hprofile + +/-- Saturated and over-applied constructor references allocate the target +node for the exact source saturation prefix. -/ +theorem lowerSpine_ref_ctor_alloc_run_profile_sound + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hrest : ApplyRestNonErasedProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {tag arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hlookup : sourceCtx.env f = some (.ctor tag arity)) + (hsrc : src f = some (.ctor tag arity)) + (hcount : arity ≤ args.length) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult world emit av + profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hsourceArgs, hsourceApply, hprofile, hheadPos⟩ := + hsource.refData + have hvalueCount : arity ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take arity).length = arity := by + simp [List.length_take, hvalueCount] + have hctor : SourceApplies sourceCtx sourceFunction + (sourceValues.take arity) + (.ctor f tag (sourceValues.take arity)) := + sourceCtorRef_saturates hlookup href htakeLength + have hknown : + (knownCall src (fuel + 1) input + (.alloc world (ctorIdOf f tag) ·) arity + (List.replicate arity world) world args).run state = + .ok (output, emit, av) finalState := by + simpa [lowerSpine, hsrc, Nat.not_lt.mpr hcount] using hrun + have hknownSound : LowerResultProfileSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult world emit av + (headProfile + argsProfile + applyProfile) := + knownCall_alloc_run_profile_sound hargs hrest hcount rfl rfl hheadPos + hsourceArgs hsourceApply hctor hknown + exact LowerResultProfileSound.of_profile_eq hknownSound hprofile + +/-- Under-applied constructor references use their memoized eta wrapper; +the final-state memo is transported to the ambient compiler relation before +the PAP profile rule is applied. -/ +theorem lowerSpine_ref_ctor_partial_run_profile_sound + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (hargs : LowerArgsProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hrest : ApplyRestNonErasedProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {tag arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {emit : Emit} {av : AVal} + (hsrc : src f = some (.ctor tag arity)) + (hunder : args.length < arity) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState relationState) + (hrepresented : ExtraRepresented ctx relationState) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult world emit av + profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hsourceArgs, hsourceApply, hprofile, hheadPos⟩ := + hsource.refData + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Ixon.Owned.unique == Ixon.Owned.unique) = true := by decide + have hsuEq : (Ixon.Owned.shared == Ixon.Owned.unique) = false := by decide + cases world with + | unique => + exact (stateThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hrun' : + ((wrapperFor f tag arity) >>= fun wrapper => + knownCall src (fuel + 1) input (.papp wrapper ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + obtain ⟨wrapper, wrapperState, hwrapperRun, hknownRun⟩ := + stateBindRun_ok_inv hrun' + let memo : WrapperMemo := ⟨f, tag, arity, wrapper⟩ + have hmemoFinal : memo ∈ finalState.wrappers := + (hknownExtra input (.papp wrapper ·) args.length + (List.replicate args.length .shared) .shared args + hknownRun).wrapper_mem (wrapperFor_memo_mem hwrapperRun) + have hmemo : memo ∈ relationState.wrappers := + hextends.wrapper_mem hmemoFinal + have hdecl := hrepresented.wrapper hmemo + have hknownSound : LowerResultProfileSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult .shared emit av + (headProfile + argsProfile + applyProfile) := by + apply knownCall_papp_wrapper_run_profile_sound hargs hrest + (Nat.le_refl _) hmemo hsrc href hdecl + (by simp [memo, ctorWrapperDecl, declArity]) + (by simpa [memo, ctorWrapperDecl, declArity] using hunder) + hheadPos hsourceArgs hsourceApply hknownRun + exact LowerResultProfileSound.of_profile_eq hknownSound hprofile + +/-- Saturated and over-applied extern references cross the explicit scalar +oracle value boundary while preserving the exact source profile. -/ +theorem lowerSpine_ref_extern_call_run_profile_sound + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hrest : ApplyRestNonErasedProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hcontract : ExternValueContract + (CompilerFunctionRel sourceCtx src relationState) sourceCtx ctx) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hlookup : sourceCtx.env f = some (.extern arity)) + (hsrc : src f = some (.extern arity)) + (hcount : arity ≤ args.length) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult world emit av + profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hsourceArgs, hsourceApply, hprofile, _⟩ := + hsource.refData + have hknown : + (knownCall src (fuel + 1) input (.extern f ·) arity + (List.replicate arity .shared) world args).run state = + .ok (output, emit, av) finalState := by + simpa [lowerSpine, hsrc, Nat.not_lt.mpr hcount] using hrun + have hknownSound : LowerResultProfileSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult world emit av + (headProfile + argsProfile + applyProfile) := + knownCall_extern_run_profile_sound hargs hrest hcontract hcount + hlookup href hsourceArgs hsourceApply hknown + exact LowerResultProfileSound.of_profile_eq hknownSound hprofile + +/-- Under-applied extern references are same-address PAPs funded by their +nonempty reference-head evaluation profile. -/ +theorem lowerSpine_ref_extern_partial_run_profile_sound + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hrest : ApplyRestNonErasedProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.extern arity)) + (hunder : args.length < arity) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult world emit av + profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hsourceArgs, hsourceApply, hprofile, hheadPos⟩ := + hsource.refData + have hdecl := hdecls.extern hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Ixon.Owned.unique == Ixon.Owned.unique) = true := by decide + have hsuEq : (Ixon.Owned.shared == Ixon.Owned.unique) = false := by decide + cases world with + | unique => + exact (stateThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + have hknownSound : LowerResultProfileSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult .shared emit av + (headProfile + argsProfile + applyProfile) := by + apply knownCall_papp_source_run_profile_sound hargs hrest + (Nat.le_refl _) hsrc (by simp [SourcePapEligible]) (by rfl) href + hdecl (by simpa [declArity] using hunder) hheadPos hsourceArgs + hsourceApply hknown + exact LowerResultProfileSound.of_profile_eq hknownSound hprofile + +/-- Complete profiled `.ref` dispatch for the canonical compiler function +relation. -/ +theorem lowerSpine_ref_run_profile_sound + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hargs : LowerArgsProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hrest : ApplyRestNonErasedProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx) + (hprofiles : CompilerProfileContracts + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {emit : Emit} {av : AVal} + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState relationState) + (hrepresented : ExtraRepresented ctx relationState) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult world emit av + profile := by + exact lowerSpine_ref_run_core + (Result := LowerResultProfileSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel ctx cur + input output sourceEnv sourceEnv sourceResult world emit av profile) + (hdefnPartial := by + intro _ _ hsrc hunder + exact lowerSpine_ref_defn_partial_run_profile_sound + hargs hrest hcontracts.decls hsrc hunder hsource hrun) + (hdefnCall := by + intro _ _ hsrc hcount + exact lowerSpine_ref_defn_call_run_profile_sound + hargs hrest hcontracts.decls hvalues.decls hprofiles.decls hsrc + hcount hsource hrun) + (hctorPartial := by + intro _ _ hsrc hunder + exact lowerSpine_ref_ctor_partial_run_profile_sound + hargs hrest hknownExtra hsrc hunder hsource hrun hextends + hrepresented) + (hctorAlloc := by + intro tag arity hsrc hcount + have hlookup : sourceCtx.env f = some (.ctor tag arity) := by + rw [henv] + exact hsrc + exact lowerSpine_ref_ctor_alloc_run_profile_sound + hargs hrest hlookup hsrc hcount hsource hrun) + (hrecursorPartial := by + intro _ _ _ hsrc hunder + exact lowerSpine_ref_recursor_partial_run_profile_sound + hargs hrest hcontracts.decls hsrc hunder hsource hrun) + (hrecursorCall := by + intro _ _ _ hsrc hcount + exact lowerSpine_ref_recursor_call_run_profile_sound + hargs hrest hcontracts.decls hvalues.decls hprofiles.decls hsrc + hcount hsource hrun) + (hexternPartial := by + intro _ hsrc hunder + exact lowerSpine_ref_extern_partial_run_profile_sound + hargs hrest hcontracts.decls hsrc hunder hsource hrun) + (hexternCall := by + intro arity hsrc hcount + have hlookup : sourceCtx.env f = some (.extern arity) := by + rw [henv] + exact hsrc + exact lowerSpine_ref_extern_call_run_profile_sound + hargs hrest hvalues.extern hlookup hsrc hcount hsource hrun) + hrun + +/-- Standalone profiled reference lowering is the empty flattened source +and target spine. -/ +theorem lowerE_ref_run_profile_sound + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hargs : LowerArgsProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src (fuel + 1)) + (hrest : ApplyRestNonErasedProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 2)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx) + (hprofiles : CompilerProfileContracts + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {emit : Emit} {av : AVal} + (hsource : IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv + (.ref f) sourceResult profile) + (hrun : (lowerE src (fuel + 1) input world (.ref f)).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState relationState) + (hrepresented : ExtraRepresented ctx relationState) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult world emit av + profile := by + apply lowerSpine_ref_run_profile_sound henv hargs hrest hknownExtra + hcontracts hvalues hprofiles (SourceSpineProfile.of_eval_nil hsource) + · exact lowerE_ref_run_to_lowerSpine_nil hrun + · exact hextends + · exact hrepresented + +/-- Profiled saturated/over-applied recursive-self spine. The synthetic +input entry selects both semantic and exact-cost contracts for the current +function; under-application remains rejected by the executable lowerer. -/ +theorem lowerSpine_recSelf_run_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsProfilePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + (hrest : ApplyRestNonErasedProfilePreserves funRel recSelfRel + sourceCtx ctx cur src fuel) + {input output : VEnv} {world : Ixon.Owned} {index arity : Nat} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hentry : input.entries[index]? = some (.recSelf arity)) + (hownership : Sim.FnOwnershipContract ctx cur + (List.replicate arity .shared)) + (hvalue : ∀ {sourceFunction : IxIR0.Value}, + recSelfRel sourceFunction arity → + FnValueContract funRel sourceCtx ctx cur + (List.replicate arity .shared) sourceFunction) + (hcost : ∀ {sourceFunction : IxIR0.Value}, + recSelfRel sourceFunction arity → + ∃ sourceAddress, + FnProfileContract funRel sourceCtx ctx sourceAddress cur + (List.replicate arity .shared) sourceFunction) + (hpositive : 0 < arity) + (hresult : cur.result = .shared) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.var index) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.var index) args).run + state = .ok (output, emit, av) finalState) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av profile := by + apply hsource.eliminate + · intro sourceFunction sourceValues headProfile argsProfile applyProfile + hhead hsourceArgs hsourceApply hprofile + obtain ⟨sourceFuel, hhead⟩ := hhead + have hsourceHead : sourceEnv[index]? = some sourceFunction := + sourceEval_var_inv hhead.run + simp only [lowerSpine] at hrun + rw [hentry] at hrun + simp only at hrun + by_cases hunder : args.length < arity + · rw [if_pos hunder] at hrun + exact (stateThrowRun_not_ok hrun).elim + · rw [if_neg hunder] at hrun + have hcount : arity ≤ args.length := Nat.le_of_not_gt hunder + cases world with + | unique => + have hrequire : + (requireResultWorld .shared .unique).run state = + .error "call result is shared at unique demand" state := by + rfl + rw [stateBindRun, hrequire] at hrun + contradiction + | shared => + have hrequire : + (requireResultWorld .shared .shared).run state = + .ok () state := by + rfl + rw [stateBindRun, hrequire] at hrun + simp only at hrun + have hknownSound : LowerResultProfileSound funRel recSelfRel ctx cur + input output sourceEnv sourceEnv sourceResult .shared emit av + (headProfile + argsProfile + applyProfile) := + knownCall_callSelf_entry_run_profile_sound hargs hrest hcount + hentry hsourceHead hownership hvalue hcost hpositive hresult + hsourceArgs hsourceApply hrun + exact LowerResultProfileSound.of_profile_eq hknownSound hprofile + +/-- Target-fuel-bounded saturated and over-applied definition references use the paired value, +ownership, and exact-profile declaration contracts selected at the source +address. -/ +theorem lowerSpine_ref_defn_call_run_profile_sound_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {fuel : Nat} + (hargs : LowerArgsProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src fuel) + (hrest : ApplyRestNonErasedProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src fuel) + (hdecls : SourceDeclContracts src ctx) + (hvalues : SourceDeclValueContracts + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx) + (hprofiles : SourceDeclProfileContractsBelow + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx + limit) + {input output : VEnv} {world result : Ixon.Owned} + {f : Ixon.Address} {body : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.defn result body)) + (hcount : lamArity body ≤ args.length) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur limit input output sourceEnv sourceEnv sourceResult world emit av + profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hrefProfile, hsourceArgs, hsourceApply, hprofile, + _⟩ := hsource.refProfileData + obtain ⟨d, hdecl, harity, hresult, hownership⟩ := hdecls.defn hsrc + have hvalue : FnValueContract + (CompilerFunctionRel sourceCtx src relationState) sourceCtx ctx d + ((lamUses body).map worldOfUses) sourceFunction := by + apply hvalues.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + have hcost : FnProfileContractBelow + (CompilerFunctionRel sourceCtx src relationState) sourceCtx ctx f d + ((lamUses body).map worldOfUses) sourceFunction limit := by + apply hprofiles.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_neg (Nat.not_lt.mpr hcount)] at hrun + obtain ⟨checked, nextState, hrequireRun, hknownRun⟩ := + stateBindRun_ok_inv hrun + cases checked + obtain ⟨hguard, _⟩ := requireResultWorld_run_ok_inv hrequireRun + have hknownSound : LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur limit input output sourceEnv sourceEnv sourceResult world emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_call_run_profile_sound_below hargs hrest (by simp) hcount + hdecl hownership hvalue hcost hrefProfile hsourceArgs hsourceApply ?_ ?_ + hknownRun + · intro hterminal + have heq : args.length = lamArity body := + Nat.le_antisymm hterminal hcount + simpa [hresult, heq] using hguard + · intro hover + have hne : args.length ≠ lamArity body := Nat.ne_of_gt hover + simpa [hresult, hne] using hguard + exact LowerResultProfileSoundBelow.of_profile_eq hknownSound hprofile + +/-- Target-fuel-bounded under-applied definition references allocate a same-address PAP. The +nonempty static reference-head profile funds the node while the exact +argument/application fragments remain in the canonical spine total. -/ +theorem lowerSpine_ref_defn_partial_run_profile_sound_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {fuel : Nat} + (hargs : LowerArgsProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src fuel) + (hrest : ApplyRestNonErasedProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world result : Ixon.Owned} + {f : Ixon.Address} {body : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.defn result body)) + (hunder : args.length < lamArity body) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur limit input output sourceEnv sourceEnv sourceResult world emit av + profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hsourceArgs, hsourceApply, hprofile, hheadPos⟩ := + hsource.refData + obtain ⟨d, hdecl, harity, _, _⟩ := hdecls.defn hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Ixon.Owned.unique == Ixon.Owned.unique) = true := by decide + have hsuEq : (Ixon.Owned.shared == Ixon.Owned.unique) = false := by decide + cases world with + | unique => + exact (stateThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + cases result with + | unique => + exact (stateThrowRun_not_ok + (by simpa [hsuEq, huuEq] using hrun)).elim + | shared => + cases hp : papSafe body with + | false => + exact (stateThrowRun_not_ok + (by simpa [hsuEq, hp] using hrun)).elim + | true => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq, hp] using hrun + have hknownSound : LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur limit input output sourceEnv sourceEnv sourceResult .shared + emit av (headProfile + argsProfile + applyProfile) := by + apply knownCall_papp_source_run_profile_sound_below hargs hrest + (Nat.le_refl _) hsrc ⟨rfl, hp⟩ + (by simpa [sourceDeclArity, declArity] using harity.symm) + href hdecl (by simpa [declArity, harity] using hunder) + hheadPos hsourceArgs hsourceApply hknown + exact LowerResultProfileSoundBelow.of_profile_eq hknownSound hprofile + +/-- Target-fuel-bounded saturated and over-applied recursor references use the generated direct +function's value, ownership, and exact-profile contracts. -/ +theorem lowerSpine_ref_recursor_call_run_profile_sound_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {fuel : Nat} + (hargs : LowerArgsProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src fuel) + (hrest : ApplyRestNonErasedProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src fuel) + (hdecls : SourceDeclContracts src ctx) + (hvalues : SourceDeclValueContracts + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx) + (hprofiles : SourceDeclProfileContractsBelow + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx + limit) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {numArgs : Nat} {natLit : Bool} {rules : Array IxIR0.RecRule} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsrc : src f = some (.recursor numArgs natLit rules)) + (hcount : numArgs + 1 ≤ args.length) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur limit input output sourceEnv sourceEnv sourceResult world emit av + profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hrefProfile, hsourceArgs, hsourceApply, hprofile, + _⟩ := hsource.refProfileData + obtain ⟨d, hdecl, harity, hresult, hownership⟩ := + hdecls.recursor hsrc + have hvalue : FnValueContract + (CompilerFunctionRel sourceCtx src relationState) sourceCtx ctx d + (List.replicate (numArgs + 1) .shared) sourceFunction := by + apply hvalues.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + have hcost : FnProfileContractBelow + (CompilerFunctionRel sourceCtx src relationState) sourceCtx ctx f d + (List.replicate (numArgs + 1) .shared) sourceFunction limit := by + apply hprofiles.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_neg (Nat.not_lt.mpr hcount)] at hrun + obtain ⟨checked, nextState, hrequireRun, hknownRun⟩ := + stateBindRun_ok_inv hrun + cases checked + obtain ⟨hguard, _⟩ := requireResultWorld_run_ok_inv hrequireRun + have hknownSound : LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur limit input output sourceEnv sourceEnv sourceResult world emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_call_run_profile_sound_below hargs hrest (by simp) hcount + hdecl hownership hvalue hcost hrefProfile hsourceArgs hsourceApply ?_ ?_ + hknownRun + · intro hterminal + have heq : args.length = numArgs + 1 := + Nat.le_antisymm hterminal hcount + simpa [hresult, heq] using hguard + · intro _ + simpa [hresult] using hguard + exact LowerResultProfileSoundBelow.of_profile_eq hknownSound hprofile + +/-- Target-fuel-bounded under-applied recursor references allocate ordinary same-address PAPs, +funded by the nonempty static head profile. -/ +theorem lowerSpine_ref_recursor_partial_run_profile_sound_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {fuel : Nat} + (hargs : LowerArgsProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src fuel) + (hrest : ApplyRestNonErasedProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {numArgs : Nat} {natLit : Bool} {rules : Array IxIR0.RecRule} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsrc : src f = some (.recursor numArgs natLit rules)) + (hunder : args.length < numArgs + 1) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur limit input output sourceEnv sourceEnv sourceResult world emit av + profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hsourceArgs, hsourceApply, hprofile, hheadPos⟩ := + hsource.refData + obtain ⟨d, hdecl, harity, _, _⟩ := hdecls.recursor hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Ixon.Owned.unique == Ixon.Owned.unique) = true := by decide + have hsuEq : (Ixon.Owned.shared == Ixon.Owned.unique) = false := by decide + cases world with + | unique => + exact (stateThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + have hknownSound : LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur limit input output sourceEnv sourceEnv sourceResult .shared emit av + (headProfile + argsProfile + applyProfile) := by + apply knownCall_papp_source_run_profile_sound_below hargs hrest + (Nat.le_refl _) hsrc (by simp [SourcePapEligible]) + (by simpa [sourceDeclArity, declArity] using harity.symm) + href hdecl (by simpa [declArity, harity] using hunder) + hheadPos hsourceArgs hsourceApply hknown + exact LowerResultProfileSoundBelow.of_profile_eq hknownSound hprofile + +/-- Target-fuel-bounded saturated and over-applied constructor references allocate the target +node for the exact source saturation prefix. -/ +theorem lowerSpine_ref_ctor_alloc_run_profile_sound_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {fuel : Nat} + (hargs : LowerArgsProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src fuel) + (hrest : ApplyRestNonErasedProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src fuel) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {tag arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hlookup : sourceCtx.env f = some (.ctor tag arity)) + (hsrc : src f = some (.ctor tag arity)) + (hcount : arity ≤ args.length) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur limit input output sourceEnv sourceEnv sourceResult world emit av + profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hsourceArgs, hsourceApply, hprofile, hheadPos⟩ := + hsource.refData + have hvalueCount : arity ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take arity).length = arity := by + simp [List.length_take, hvalueCount] + have hctor : SourceApplies sourceCtx sourceFunction + (sourceValues.take arity) + (.ctor f tag (sourceValues.take arity)) := + sourceCtorRef_saturates hlookup href htakeLength + have hknown : + (knownCall src (fuel + 1) input + (.alloc world (ctorIdOf f tag) ·) arity + (List.replicate arity world) world args).run state = + .ok (output, emit, av) finalState := by + simpa [lowerSpine, hsrc, Nat.not_lt.mpr hcount] using hrun + have hknownSound : LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur limit input output sourceEnv sourceEnv sourceResult world emit av + (headProfile + argsProfile + applyProfile) := + knownCall_alloc_run_profile_sound_below hargs hrest hcount rfl rfl hheadPos + hsourceArgs hsourceApply hctor hknown + exact LowerResultProfileSoundBelow.of_profile_eq hknownSound hprofile + +/-- Target-fuel-bounded under-applied constructor references use their memoized eta wrapper; +the final-state memo is transported to the ambient compiler relation before +the PAP profile rule is applied. -/ +theorem lowerSpine_ref_ctor_partial_run_profile_sound_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {fuel : Nat} + {state finalState : LowSt} + (hargs : LowerArgsProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src fuel) + (hrest : ApplyRestNonErasedProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src fuel) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {tag arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {emit : Emit} {av : AVal} + (hsrc : src f = some (.ctor tag arity)) + (hunder : args.length < arity) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState relationState) + (hrepresented : ExtraRepresented ctx relationState) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur limit input output sourceEnv sourceEnv sourceResult world emit av + profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hsourceArgs, hsourceApply, hprofile, hheadPos⟩ := + hsource.refData + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Ixon.Owned.unique == Ixon.Owned.unique) = true := by decide + have hsuEq : (Ixon.Owned.shared == Ixon.Owned.unique) = false := by decide + cases world with + | unique => + exact (stateThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hrun' : + ((wrapperFor f tag arity) >>= fun wrapper => + knownCall src (fuel + 1) input (.papp wrapper ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + obtain ⟨wrapper, wrapperState, hwrapperRun, hknownRun⟩ := + stateBindRun_ok_inv hrun' + let memo : WrapperMemo := ⟨f, tag, arity, wrapper⟩ + have hmemoFinal : memo ∈ finalState.wrappers := + (hknownExtra input (.papp wrapper ·) args.length + (List.replicate args.length .shared) .shared args + hknownRun).wrapper_mem (wrapperFor_memo_mem hwrapperRun) + have hmemo : memo ∈ relationState.wrappers := + hextends.wrapper_mem hmemoFinal + have hdecl := hrepresented.wrapper hmemo + have hknownSound : LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur limit input output sourceEnv sourceEnv sourceResult .shared emit av + (headProfile + argsProfile + applyProfile) := by + apply knownCall_papp_wrapper_run_profile_sound_below hargs hrest + (Nat.le_refl _) hmemo hsrc href hdecl + (by simp [memo, ctorWrapperDecl, declArity]) + (by simpa [memo, ctorWrapperDecl, declArity] using hunder) + hheadPos hsourceArgs hsourceApply hknownRun + exact LowerResultProfileSoundBelow.of_profile_eq hknownSound hprofile + +/-- Target-fuel-bounded saturated and over-applied extern references cross the explicit scalar +oracle value boundary while preserving the exact source profile. -/ +theorem lowerSpine_ref_extern_call_run_profile_sound_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {fuel : Nat} + (hargs : LowerArgsProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src fuel) + (hrest : ApplyRestNonErasedProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src fuel) + (hcontract : ExternValueContract + (CompilerFunctionRel sourceCtx src relationState) sourceCtx ctx) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hlookup : sourceCtx.env f = some (.extern arity)) + (hsrc : src f = some (.extern arity)) + (hcount : arity ≤ args.length) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur limit input output sourceEnv sourceEnv sourceResult world emit av + profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hsourceArgs, hsourceApply, hprofile, _⟩ := + hsource.refData + have hknown : + (knownCall src (fuel + 1) input (.extern f ·) arity + (List.replicate arity .shared) world args).run state = + .ok (output, emit, av) finalState := by + simpa [lowerSpine, hsrc, Nat.not_lt.mpr hcount] using hrun + have hknownSound : LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur limit input output sourceEnv sourceEnv sourceResult world emit av + (headProfile + argsProfile + applyProfile) := + knownCall_extern_run_profile_sound_below hargs hrest hcontract hcount + hlookup href hsourceArgs hsourceApply hknown + exact LowerResultProfileSoundBelow.of_profile_eq hknownSound hprofile + +/-- Target-fuel-bounded under-applied extern references are same-address PAPs funded by their +nonempty reference-head evaluation profile. -/ +theorem lowerSpine_ref_extern_partial_run_profile_sound_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {fuel : Nat} + (hargs : LowerArgsProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src fuel) + (hrest : ApplyRestNonErasedProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.extern arity)) + (hunder : args.length < arity) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur limit input output sourceEnv sourceEnv sourceResult world emit av + profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hsourceArgs, hsourceApply, hprofile, hheadPos⟩ := + hsource.refData + have hdecl := hdecls.extern hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Ixon.Owned.unique == Ixon.Owned.unique) = true := by decide + have hsuEq : (Ixon.Owned.shared == Ixon.Owned.unique) = false := by decide + cases world with + | unique => + exact (stateThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + have hknownSound : LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur limit input output sourceEnv sourceEnv sourceResult .shared emit av + (headProfile + argsProfile + applyProfile) := by + apply knownCall_papp_source_run_profile_sound_below hargs hrest + (Nat.le_refl _) hsrc (by simp [SourcePapEligible]) (by rfl) href + hdecl (by simpa [declArity] using hunder) hheadPos hsourceArgs + hsourceApply hknown + exact LowerResultProfileSoundBelow.of_profile_eq hknownSound hprofile + +/-- Complete target-fuel-bounded profiled `.ref` dispatch for the canonical compiler function +relation. -/ +theorem lowerSpine_ref_run_profile_sound_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hargs : LowerArgsProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src fuel) + (hrest : ApplyRestNonErasedProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src fuel) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx) + (hprofiles : CompilerProfileContractsBelow + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx limit) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {emit : Emit} {av : AVal} + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState relationState) + (hrepresented : ExtraRepresented ctx relationState) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur limit input output sourceEnv sourceEnv sourceResult world emit av + profile := by + exact lowerSpine_ref_run_core + (Result := LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel ctx cur + limit input output sourceEnv sourceEnv sourceResult world emit av profile) + (hdefnPartial := by + intro _ _ hsrc hunder + exact lowerSpine_ref_defn_partial_run_profile_sound_below + hargs hrest hcontracts.decls hsrc hunder hsource hrun) + (hdefnCall := by + intro _ _ hsrc hcount + exact lowerSpine_ref_defn_call_run_profile_sound_below + hargs hrest hcontracts.decls hvalues.decls hprofiles.decls hsrc + hcount hsource hrun) + (hctorPartial := by + intro _ _ hsrc hunder + exact lowerSpine_ref_ctor_partial_run_profile_sound_below + hargs hrest hknownExtra hsrc hunder hsource hrun hextends + hrepresented) + (hctorAlloc := by + intro tag arity hsrc hcount + have hlookup : sourceCtx.env f = some (.ctor tag arity) := by + rw [henv] + exact hsrc + exact lowerSpine_ref_ctor_alloc_run_profile_sound_below + hargs hrest hlookup hsrc hcount hsource hrun) + (hrecursorPartial := by + intro _ _ _ hsrc hunder + exact lowerSpine_ref_recursor_partial_run_profile_sound_below + hargs hrest hcontracts.decls hsrc hunder hsource hrun) + (hrecursorCall := by + intro _ _ _ hsrc hcount + exact lowerSpine_ref_recursor_call_run_profile_sound_below + hargs hrest hcontracts.decls hvalues.decls hprofiles.decls hsrc + hcount hsource hrun) + (hexternPartial := by + intro _ hsrc hunder + exact lowerSpine_ref_extern_partial_run_profile_sound_below + hargs hrest hcontracts.decls hsrc hunder hsource hrun) + (hexternCall := by + intro arity hsrc hcount + have hlookup : sourceCtx.env f = some (.extern arity) := by + rw [henv] + exact hsrc + exact lowerSpine_ref_extern_call_run_profile_sound_below + hargs hrest hvalues.extern hlookup hsrc hcount hsource hrun) + hrun + +/-- Target-fuel-bounded standalone profiled reference lowering is the empty flattened source +and target spine. -/ +theorem lowerE_ref_run_profile_sound_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hargs : LowerArgsProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src (fuel + 1)) + (hrest : ApplyRestNonErasedProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 2)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx) + (hprofiles : CompilerProfileContractsBelow + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx limit) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {emit : Emit} {av : AVal} + (hsource : IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv + (.ref f) sourceResult profile) + (hrun : (lowerE src (fuel + 1) input world (.ref f)).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState relationState) + (hrepresented : ExtraRepresented ctx relationState) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur limit input output sourceEnv sourceEnv sourceResult world emit av + profile := by + apply lowerSpine_ref_run_profile_sound_below henv hargs hrest hknownExtra + hcontracts hvalues hprofiles (SourceSpineProfile.of_eval_nil hsource) + · exact lowerE_ref_run_to_lowerSpine_nil hrun + · exact hextends + · exact hrepresented + +/-- Target-fuel-bounded profiled saturated/over-applied recursive-self spine. The synthetic +input entry selects both semantic and exact-cost contracts for the current +function; under-application remains rejected by the executable lowerer. -/ +theorem lowerSpine_recSelf_run_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {fuel : Nat} + (hargs : LowerArgsProfilePreservesBelow funRel recSelfRel sourceCtx ctx cur limit + src fuel) + (hrest : ApplyRestNonErasedProfilePreservesBelow funRel recSelfRel + sourceCtx ctx cur limit src fuel) + {input output : VEnv} {world : Ixon.Owned} {index arity : Nat} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hentry : input.entries[index]? = some (.recSelf arity)) + (hownership : Sim.FnOwnershipContract ctx cur + (List.replicate arity .shared)) + (hvalue : ∀ {sourceFunction : IxIR0.Value}, + recSelfRel sourceFunction arity → + FnValueContract funRel sourceCtx ctx cur + (List.replicate arity .shared) sourceFunction) + (hcost : ∀ {sourceFunction : IxIR0.Value}, + recSelfRel sourceFunction arity → + ∃ sourceAddress, + FnProfileContractBelow funRel sourceCtx ctx sourceAddress cur + (List.replicate arity .shared) sourceFunction limit) + (hpositive : 0 < arity) + (hresult : cur.result = .shared) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.var index) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.var index) args).run + state = .ok (output, emit, av) finalState) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult world emit av profile := by + apply hsource.eliminate + · intro sourceFunction sourceValues headProfile argsProfile applyProfile + hhead hsourceArgs hsourceApply hprofile + obtain ⟨sourceFuel, hhead⟩ := hhead + have hsourceHead : sourceEnv[index]? = some sourceFunction := + sourceEval_var_inv hhead.run + simp only [lowerSpine] at hrun + rw [hentry] at hrun + simp only at hrun + by_cases hunder : args.length < arity + · rw [if_pos hunder] at hrun + exact (stateThrowRun_not_ok hrun).elim + · rw [if_neg hunder] at hrun + have hcount : arity ≤ args.length := Nat.le_of_not_gt hunder + cases world with + | unique => + have hrequire : + (requireResultWorld .shared .unique).run state = + .error "call result is shared at unique demand" state := by + rfl + rw [stateBindRun, hrequire] at hrun + contradiction + | shared => + have hrequire : + (requireResultWorld .shared .shared).run state = + .ok () state := by + rfl + rw [stateBindRun, hrequire] at hrun + simp only at hrun + have hknownSound : LowerResultProfileSoundBelow funRel recSelfRel ctx cur + limit input output sourceEnv sourceEnv sourceResult .shared emit av + (headProfile + argsProfile + applyProfile) := + knownCall_callSelf_entry_run_profile_sound_below hargs hrest hcount + hentry hsourceHead hownership hvalue hcost hpositive hresult + hsourceArgs hsourceApply hrun + exact LowerResultProfileSoundBelow.of_profile_eq hknownSound hprofile + +/-- Forget a released leading let binder while preserving the exact source +profile. The logical `VEnv.pop` changes only the state relation; it emits no +target instruction and therefore contributes the zero profile. -/ +theorem LowerResultProfileSound.popFirstReleased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {boundSource sourceValue : IxIR0.Value} + {world : Ixon.Owned} {emit : Emit} {av : AVal} + {profile : SourceProfile} + (hsound : LowerResultProfileSound funRel recSelfRel ctx cur + input output sourceInput (boundSource :: sourceOutput) + sourceValue world emit av profile) + (hfirst : FirstEntryReleased output) : + LowerResultProfileSound funRel recSelfRel ctx cur input output.pop + sourceInput sourceOutput sourceValue world emit av profile := by + refine + { toLowerResultValueSound := + hsound.toLowerResultValueSound.popFirstReleased hfirst + profileEmits := ?_ } + intro sourceRest rest slots + have hpop : ProfileFundedEmitStateRunSound ctx cur (_root_.id : Emit) + (GraphOwnsResultProtected funRel recSelfRel output + (boundSource :: sourceOutput) sourceValue world av + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.pop + sourceOutput sourceValue world av sourceRest rest slots) + 0 := by + apply ProfileFundedEmitStateRunSound.id + intro store env hpre + obtain ⟨⟨roots, value, houtput, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + refine ⟨⟨roots, value, houtput.pop_firstReleased hfirst, + hav.of_depth_eq (by simp [VEnv.pop]), hvalueGraph, + hrestGraph, hown⟩, ?_⟩ + exact SlotsRealize.of_depth_eq (by simp [VEnv.pop]) hslots + have hcomposed : ProfileFundedEmitStateRunSound ctx cur + (emit ∘ (_root_.id : Emit)) + (GraphOwnsVEnvProtected funRel recSelfRel input sourceInput + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.pop + sourceOutput sourceValue world av sourceRest rest slots) + (profile + 0) := + ProfileFundedEmitStateRunSound.comp + (hsound.profileEmits sourceRest rest slots) hpop + have hnormalized : ProfileFundedEmitStateRunSound ctx cur + (emit ∘ (_root_.id : Emit)) + (GraphOwnsVEnvProtected funRel recSelfRel input sourceInput + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.pop + sourceOutput sourceValue world av sourceRest rest slots) + profile := + ProfileFundedEmitStateRunSound.of_profile_eq hcomposed + (IxIR0.DynamicCost.Profile.add_zero profile) + intro continuation continuationProfile fuel before after env value horder + henv hpre hrun hcontinuation + exact hnormalized horder henv hpre hrun hcontinuation + +/-- Reclassify a shared slot result as a pending borrow owner without an +additional target instruction or source charge. -/ +theorem LowerResultProfileSound.asBorrowSlot + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {abs : Nat} + {profile : SourceProfile} + (hsound : LowerResultProfileSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceValue .shared emit + (.slotA abs) profile) : + LowerBorrowProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue emit (.slotA abs) true + profile := by + refine + { toLowerBorrowValueSound := + hsound.toLowerResultValueSound.asBorrowSlot + profileEmits := ?_ } + intro sourceRest rest slots + have hconvert : ProfileFundedEmitStateRunSound ctx cur + (_root_.id : Emit) + (GraphOwnsResultProtected funRel recSelfRel output sourceOutput + sourceValue .shared (.slotA abs) sourceRest rest slots) + (GraphOwnsBorrowResultProtected funRel recSelfRel output sourceOutput + sourceValue (.slotA abs) true sourceRest rest slots) + 0 := by + apply ProfileFundedEmitStateRunSound.id + intro store env hpre + obtain ⟨⟨roots, value, houtput, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + have hworld : Sim.HasWorld store .shared value := + hown.roots_world ⟨.shared, value⟩ (by simp) + refine ⟨roots, value, houtput, hav, hworld, hvalueGraph, + hrestGraph, ?_, hslots⟩ + simpa [borrowResultRoots] using hown + have hcomposed : ProfileFundedEmitStateRunSound ctx cur + (emit ∘ (_root_.id : Emit)) + (GraphOwnsVEnvProtected funRel recSelfRel input sourceInput + sourceRest rest slots) + (GraphOwnsBorrowResultProtected funRel recSelfRel output sourceOutput + sourceValue (.slotA abs) true sourceRest rest slots) + (profile + 0) := + ProfileFundedEmitStateRunSound.comp + (hsound.profileEmits sourceRest rest slots) hconvert + have hnormalized : ProfileFundedEmitStateRunSound ctx cur + (emit ∘ (_root_.id : Emit)) + (GraphOwnsVEnvProtected funRel recSelfRel input sourceInput + sourceRest rest slots) + (GraphOwnsBorrowResultProtected funRel recSelfRel output sourceOutput + sourceValue (.slotA abs) true sourceRest rest slots) + profile := + ProfileFundedEmitStateRunSound.of_profile_eq hcomposed + (IxIR0.DynamicCost.Profile.add_zero profile) + intro continuation continuationProfile fuel before after env value horder + henv hpre hrun hcontinuation + exact hnormalized horder henv hpre hrun hcontinuation + +/-- Stable scalar results become non-releasing borrows. Their distinguished +ownership root is inert and can be forgotten at zero paired cost. -/ +theorem LowerResultProfileSound.asBorrowConst + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {atom : Atom} + {profile : SourceProfile} + (hsound : LowerResultProfileSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceValue .shared emit + (.constA atom) profile) : + LowerBorrowProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue emit (.constA atom) false + profile := by + refine + { toLowerBorrowValueSound := + hsound.toLowerResultValueSound.asBorrowConst + profileEmits := ?_ } + intro sourceRest rest slots + have hconvert : ProfileFundedEmitStateRunSound ctx cur + (_root_.id : Emit) + (GraphOwnsResultProtected funRel recSelfRel output sourceOutput + sourceValue .shared (.constA atom) sourceRest rest slots) + (GraphOwnsBorrowResultProtected funRel recSelfRel output sourceOutput + sourceValue (.constA atom) false sourceRest rest slots) + 0 := by + apply ProfileFundedEmitStateRunSound.id + intro store env hpre + obtain ⟨⟨roots, value, houtput, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + have hworld : Sim.HasWorld store .shared value := + hown.roots_world ⟨.shared, value⟩ (by simp) + refine ⟨roots, value, houtput, hav, hworld, hvalueGraph, + hrestGraph, ?_, hslots⟩ + simpa [borrowResultRoots] using + hown.dropNoLocation + (hsound.toLowerResultValueSound.stable.const_noLocation hav) + have hcomposed : ProfileFundedEmitStateRunSound ctx cur + (emit ∘ (_root_.id : Emit)) + (GraphOwnsVEnvProtected funRel recSelfRel input sourceInput + sourceRest rest slots) + (GraphOwnsBorrowResultProtected funRel recSelfRel output sourceOutput + sourceValue (.constA atom) false sourceRest rest slots) + (profile + 0) := + ProfileFundedEmitStateRunSound.comp + (hsound.profileEmits sourceRest rest slots) hconvert + have hnormalized : ProfileFundedEmitStateRunSound ctx cur + (emit ∘ (_root_.id : Emit)) + (GraphOwnsVEnvProtected funRel recSelfRel input sourceInput + sourceRest rest slots) + (GraphOwnsBorrowResultProtected funRel recSelfRel output sourceOutput + sourceValue (.constA atom) false sourceRest rest slots) + profile := + ProfileFundedEmitStateRunSound.of_profile_eq hcomposed + (IxIR0.DynamicCost.Profile.add_zero profile) + intro continuation continuationProfile fuel before after env value horder + henv hpre hrun hcontinuation + exact hnormalized horder henv hpre hrun hcontinuation + +/-- Fuel-bounded forgetting of a released leading let binder. -/ +theorem LowerResultProfileSoundBelow.popFirstReleased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {boundSource sourceValue : IxIR0.Value} + {world : Ixon.Owned} {emit : Emit} {av : AVal} + {profile : SourceProfile} + (hsound : LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput (boundSource :: sourceOutput) + sourceValue world emit av profile) + (hfirst : FirstEntryReleased output) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + output.pop sourceInput sourceOutput sourceValue world emit av + profile := by + have hvalue : LowerResultValueSound funRel recSelfRel ctx cur input + output.pop sourceInput sourceOutput sourceValue world + (emit ∘ (_root_.id : Emit)) av := by + simpa [Function.comp_def] using + hsound.toLowerResultValueSound.popFirstReleased hfirst + have hsuffix : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSoundBelow ctx cur limit (_root_.id : Emit) + (GraphOwnsResultProtected funRel recSelfRel output + (boundSource :: sourceOutput) sourceValue world av + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.pop + sourceOutput sourceValue world av sourceRest rest slots) + 0 := by + intro sourceRest rest slots + apply ProfileFundedEmitStateRunSoundBelow.id + intro store env hpre + obtain ⟨⟨roots, value, houtput, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + refine ⟨⟨roots, value, houtput.pop_firstReleased hfirst, + hav.of_depth_eq (by simp [VEnv.pop]), hvalueGraph, + hrestGraph, hown⟩, ?_⟩ + exact SlotsRealize.of_depth_eq (by simp [VEnv.pop]) hslots + have hcombined := hsound.thenResult hvalue hsuffix + have hnormalized := hcombined.of_profile_eq + (IxIR0.DynamicCost.Profile.add_zero profile) + simpa [Function.comp_def] using hnormalized + +/-- Fuel-bounded reclassification of a shared slot result as a pending +borrow owner. -/ +theorem LowerResultProfileSoundBelow.asBorrowSlot + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {abs : Nat} + {profile : SourceProfile} + (hsound : LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceValue .shared emit + (.slotA abs) profile) : + LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceInput sourceOutput sourceValue emit (.slotA abs) true + profile := by + have hvalue : LowerBorrowValueSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue (emit ∘ (_root_.id : Emit)) + (.slotA abs) true := by + simpa [Function.comp_def] using + hsound.toLowerResultValueSound.asBorrowSlot + have hsuffix : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSoundBelow ctx cur limit (_root_.id : Emit) + (GraphOwnsResultProtected funRel recSelfRel output sourceOutput + sourceValue .shared (.slotA abs) sourceRest rest slots) + (GraphOwnsBorrowResultProtected funRel recSelfRel output sourceOutput + sourceValue (.slotA abs) true sourceRest rest slots) + 0 := by + intro sourceRest rest slots + apply ProfileFundedEmitStateRunSoundBelow.id + intro store env hpre + obtain ⟨⟨roots, value, houtput, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + have hworld : Sim.HasWorld store .shared value := + hown.roots_world ⟨.shared, value⟩ (by simp) + refine ⟨roots, value, houtput, hav, hworld, hvalueGraph, + hrestGraph, ?_, hslots⟩ + simpa [borrowResultRoots] using hown + have hcombined := hsound.thenBorrow hvalue hsuffix + have hnormalized := hcombined.of_profile_eq + (IxIR0.DynamicCost.Profile.add_zero profile) + simpa [Function.comp_def] using hnormalized + +/-- Fuel-bounded conversion of a stable scalar result into a non-releasing +borrow. -/ +theorem LowerResultProfileSoundBelow.asBorrowConst + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {atom : Atom} + {profile : SourceProfile} + (hsound : LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceValue .shared emit + (.constA atom) profile) : + LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceInput sourceOutput sourceValue emit (.constA atom) false + profile := by + have hvalue : LowerBorrowValueSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue (emit ∘ (_root_.id : Emit)) + (.constA atom) false := by + simpa [Function.comp_def] using + hsound.toLowerResultValueSound.asBorrowConst + have hsuffix : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSoundBelow ctx cur limit (_root_.id : Emit) + (GraphOwnsResultProtected funRel recSelfRel output sourceOutput + sourceValue .shared (.constA atom) sourceRest rest slots) + (GraphOwnsBorrowResultProtected funRel recSelfRel output sourceOutput + sourceValue (.constA atom) false sourceRest rest slots) + 0 := by + intro sourceRest rest slots + apply ProfileFundedEmitStateRunSoundBelow.id + intro store env hpre + obtain ⟨⟨roots, value, houtput, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + have hworld : Sim.HasWorld store .shared value := + hown.roots_world ⟨.shared, value⟩ (by simp) + refine ⟨roots, value, houtput, hav, hworld, hvalueGraph, + hrestGraph, ?_, hslots⟩ + simpa [borrowResultRoots] using + hown.dropNoLocation + (hsound.toLowerResultValueSound.stable.const_noLocation hav) + have hcombined := hsound.thenBorrow hvalue hsuffix + have hnormalized := hcombined.of_profile_eq + (IxIR0.DynamicCost.Profile.add_zero profile) + simpa [Function.comp_def] using hnormalized + +/-- Source-profile let sequencing. The bound expression, binder +installation, and popped body share exact runtime midpoints. The compiler's +binder prefix is charged to the source `evalLet` event, and profile +commutativity puts that event in the canonical source-trace order. -/ +theorem LowerResultProfileSound.installThen + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {input middle installed output : VEnv} + {sourceInput sourceMiddle sourceOutput : List IxIR0.Value} + {boundSource sourceResult : IxIR0.Value} + {boundWorld resultWorld : Ixon.Owned} + {boundEmit installEmit bodyEmit : Emit} + {boundValue result : AVal} + {boundProfile bodyProfile : SourceProfile} + (hbound : LowerResultProfileSound funRel recSelfRel ctx cur + input middle sourceInput sourceMiddle boundSource boundWorld + boundEmit boundValue boundProfile) + (hinstall : InstallBinderProfileSound funRel recSelfRel ctx cur + middle installed sourceMiddle boundSource boundWorld boundValue + installEmit (IxIR0.DynamicCost.tick .evalLet)) + (hbody : LowerResultProfileSound funRel recSelfRel ctx cur + installed output (boundSource :: sourceMiddle) + (boundSource :: sourceOutput) sourceResult resultWorld + bodyEmit result bodyProfile) + (hreleased : FirstEntryReleased output) : + LowerResultProfileSound funRel recSelfRel ctx cur input output.pop + sourceInput sourceOutput sourceResult resultWorld + ((boundEmit ∘ installEmit) ∘ bodyEmit) result + (boundProfile + bodyProfile + IxIR0.DynamicCost.tick .evalLet) := by + have hpopped := hbody.popFirstReleased hreleased + refine + { toLowerResultValueSound := + hbound.toLowerResultValueSound.installThen + hinstall.toInstallBinderValueSound + hbody.toLowerResultValueSound hreleased + profileEmits := ?_ } + intro sourceRest rest slots + have hboundInstall : ProfileFundedEmitStateRunSound ctx cur + (boundEmit ∘ installEmit) + (GraphOwnsVEnvProtected funRel recSelfRel input sourceInput + sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel installed + (boundSource :: sourceMiddle) sourceRest rest slots) + (boundProfile + IxIR0.DynamicCost.tick .evalLet) := + ProfileFundedEmitStateRunSound.comp + (hbound.profileEmits sourceRest rest slots) + (hinstall.profileEmits sourceRest rest slots) + have hall : ProfileFundedEmitStateRunSound ctx cur + ((boundEmit ∘ installEmit) ∘ bodyEmit) + (GraphOwnsVEnvProtected funRel recSelfRel input sourceInput + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.pop sourceOutput + sourceResult resultWorld result sourceRest rest slots) + ((boundProfile + IxIR0.DynamicCost.tick .evalLet) + bodyProfile) := + ProfileFundedEmitStateRunSound.comp hboundInstall + (hpopped.profileEmits sourceRest rest slots) + have hprofile : + (boundProfile + IxIR0.DynamicCost.tick .evalLet) + bodyProfile = + boundProfile + bodyProfile + IxIR0.DynamicCost.tick .evalLet := by + ext <;> simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] + have hnormalized : ProfileFundedEmitStateRunSound ctx cur + ((boundEmit ∘ installEmit) ∘ bodyEmit) + (GraphOwnsVEnvProtected funRel recSelfRel input sourceInput + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.pop sourceOutput + sourceResult resultWorld result sourceRest rest slots) + (boundProfile + bodyProfile + IxIR0.DynamicCost.tick .evalLet) := + ProfileFundedEmitStateRunSound.of_profile_eq hall hprofile + intro continuation continuationProfile fuel before after env value horder + henv hpre hrun hcontinuation + exact hnormalized horder henv hpre hrun hcontinuation + +/-- Fuel-bounded source-profile let sequencing. -/ +theorem LowerResultProfileSoundBelow.installThen + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input middle installed output : VEnv} + {sourceInput sourceMiddle sourceOutput : List IxIR0.Value} + {boundSource sourceResult : IxIR0.Value} + {boundWorld resultWorld : Ixon.Owned} + {boundEmit installEmit bodyEmit : Emit} + {boundValue result : AVal} + {boundProfile bodyProfile : SourceProfile} + (hbound : LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit + input middle sourceInput sourceMiddle boundSource boundWorld + boundEmit boundValue boundProfile) + (hinstall : InstallBinderProfileSoundBelow funRel recSelfRel ctx cur + limit middle installed sourceMiddle boundSource boundWorld boundValue + installEmit (IxIR0.DynamicCost.tick .evalLet)) + (hbody : LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit + installed output (boundSource :: sourceMiddle) + (boundSource :: sourceOutput) sourceResult resultWorld + bodyEmit result bodyProfile) + (hreleased : FirstEntryReleased output) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + output.pop sourceInput sourceOutput sourceResult resultWorld + ((boundEmit ∘ installEmit) ∘ bodyEmit) result + (boundProfile + bodyProfile + IxIR0.DynamicCost.tick .evalLet) := by + have hpopped := hbody.popFirstReleased hreleased + refine + { toLowerResultValueSound := + hbound.toLowerResultValueSound.installThen + hinstall.toInstallBinderValueSound + hbody.toLowerResultValueSound hreleased + profileEmits := ?_ } + intro sourceRest rest slots + have hboundInstall : ProfileFundedEmitStateRunSoundBelow ctx cur limit + (boundEmit ∘ installEmit) + (GraphOwnsVEnvProtected funRel recSelfRel input sourceInput + sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel installed + (boundSource :: sourceMiddle) sourceRest rest slots) + (boundProfile + IxIR0.DynamicCost.tick .evalLet) := + ProfileFundedEmitStateRunSoundBelow.comp + (hbound.profileEmits sourceRest rest slots) + (hinstall.profileEmits sourceRest rest slots) + have hall : ProfileFundedEmitStateRunSoundBelow ctx cur limit + ((boundEmit ∘ installEmit) ∘ bodyEmit) + (GraphOwnsVEnvProtected funRel recSelfRel input sourceInput + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.pop sourceOutput + sourceResult resultWorld result sourceRest rest slots) + ((boundProfile + IxIR0.DynamicCost.tick .evalLet) + bodyProfile) := + ProfileFundedEmitStateRunSoundBelow.comp hboundInstall + (hpopped.profileEmits sourceRest rest slots) + have hprofile : + (boundProfile + IxIR0.DynamicCost.tick .evalLet) + bodyProfile = + boundProfile + bodyProfile + IxIR0.DynamicCost.tick .evalLet := by + ext <;> simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] + exact ProfileFundedEmitStateRunSoundBelow.of_profile_eq hall hprofile + +/-- Installing a live slot-backed binder aliases its existing physical slot. +The target prefix is the identity, so the source let event has its entire +paired allowance left unused. -/ +theorem installAliasBinder_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input : VEnv} + {sourceEnv : List IxIR0.Value} {boundSource : IxIR0.Value} + {abs remaining : Nat} {uses : Ixon.Uses} : + InstallBinderProfileSound funRel recSelfRel ctx cur input + (installAliasBinder input abs remaining uses true) + sourceEnv boundSource (worldOfUses uses) (.slotA abs) + (_root_.id : Emit) (IxIR0.DynamicCost.tick .evalLet) := by + refine + { toInstallBinderValueSound := + installAliasBinder_held_value_sound + profileEmits := ?_ } + intro sourceRest rest slots + apply ProfileFundedEmitStateRunSound.monoProfile + · apply ProfileFundedEmitStateRunSound.id + intro store env hpre + obtain ⟨⟨roots, value, hinput, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + cases hav with + | slot hbound hslot => + let output := installAliasBinder input abs remaining uses true + have htail : EntriesValueGraph funRel recSelfRel store output env + input.entries sourceEnv roots := + hinput.entries.of_depth_eq + (by simp [output, installAliasBinder]) + have hvalueWorld : Sim.HasWorld store (worldOfUses uses) value := + hown.roots_world ⟨worldOfUses uses, value⟩ (by simp) + have houtput : VEnvValueGraph funRel recSelfRel store output + (boundSource :: sourceEnv) env + (⟨worldOfUses uses, value⟩ :: roots) := by + refine ⟨by simpa [output, installAliasBinder] using + hinput.depth_eq, ?_⟩ + exact EntriesValueGraph.held + (by simpa [output, installAliasBinder] using hbound) + (by simpa [output, installAliasBinder, VEnv.rel] using hslot) + hvalueWorld hvalueGraph htail + refine ⟨⟨⟨worldOfUses uses, value⟩ :: roots, + houtput, hrestGraph, ?_⟩, ?_⟩ + · simpa using hown + · exact SlotsRealize.of_depth_eq + (by simp [output, installAliasBinder]) hslots + · exact zeroOwnershipAllowance_le_profile _ + +theorem installAliasBinder_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input : VEnv} + {sourceEnv : List IxIR0.Value} {boundSource : IxIR0.Value} + {abs remaining : Nat} {uses : Ixon.Uses} : + InstallBinderProfileSoundBelow funRel recSelfRel ctx cur limit input + (installAliasBinder input abs remaining uses true) + sourceEnv boundSource (worldOfUses uses) (.slotA abs) + (_root_.id : Emit) (IxIR0.DynamicCost.tick .evalLet) := by + refine + { toInstallBinderValueSound := + installAliasBinder_held_value_sound + profileEmits := ?_ } + intro sourceRest rest slots + apply ProfileFundedEmitStateRunSoundBelow.monoProfile + · apply ProfileFundedEmitStateRunSoundBelow.id + intro store env hpre + obtain ⟨⟨roots, value, hinput, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + cases hav with + | slot hbound hslot => + let output := installAliasBinder input abs remaining uses true + have htail : EntriesValueGraph funRel recSelfRel store output env + input.entries sourceEnv roots := + hinput.entries.of_depth_eq + (by simp [output, installAliasBinder]) + have hvalueWorld : Sim.HasWorld store (worldOfUses uses) value := + hown.roots_world ⟨worldOfUses uses, value⟩ (by simp) + have houtput : VEnvValueGraph funRel recSelfRel store output + (boundSource :: sourceEnv) env + (⟨worldOfUses uses, value⟩ :: roots) := by + refine ⟨by simpa [output, installAliasBinder] using + hinput.depth_eq, ?_⟩ + exact EntriesValueGraph.held + (by simpa [output, installAliasBinder] using hbound) + (by simpa [output, installAliasBinder, VEnv.rel] using hslot) + hvalueWorld hvalueGraph htail + refine ⟨⟨⟨worldOfUses uses, value⟩ :: roots, + houtput, hrestGraph, ?_⟩, ?_⟩ + · simpa using hown + · exact SlotsRealize.of_depth_eq + (by simp [output, installAliasBinder]) hslots + · exact zeroOwnershipAllowance_le_profile _ + +/-- Materializing a stable scalar binder emits one ownership-free `pure`. +The exact semantic push and the zero paired operation cost are certified at +the same continuation boundary. -/ +theorem materializeConstBinder_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input : VEnv} + {sourceEnv : List IxIR0.Value} {boundSource : IxIR0.Value} + {atom : Atom} {remaining : Nat} {uses : Ixon.Uses} {held : Bool} + (hstable : AValStable (.constA atom)) : + InstallBinderProfileSound funRel recSelfRel ctx cur input + (installPushedBinder input remaining uses held) + sourceEnv boundSource (worldOfUses uses) (.constA atom) + (emitOp (.pure atom)) (IxIR0.DynamicCost.tick .evalLet) := by + refine + { toInstallBinderValueSound := + materializeConstBinder_value_sound hstable + profileEmits := ?_ } + intro sourceRest rest slots + apply ProfileFundedEmitStateRunSound.localOp + (allowance := ⟨0, 0⟩) + · intro fuel store env store' result hpre hrun + obtain ⟨⟨roots, value, hinput, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + have hpure := Ix.Compiler.IxIR1.Sim.runOp_pure + (ctx := ctx) (cur := cur) + (fuel := fuel) (store := store) hav.resolveAtom + have hpair : (store, value) = (store', result) := + Except.ok.inj (hpure.symm.trans hrun) + cases hpair + let output := installPushedBinder input remaining uses held + have htail : EntriesValueGraph funRel recSelfRel store output + (result :: env) input.entries sourceEnv roots := + (hinput.entries.bump result).of_depth_eq + (by simp [output, installPushedBinder, VEnv.bump]) + have hdepth : (result :: env).length = output.depth := by + simpa [output, installPushedBinder] using + congrArg Nat.succ hinput.depth_eq + cases held with + | false => + have houtput : VEnvValueGraph funRel recSelfRel store output + (boundSource :: sourceEnv) (result :: env) roots := by + refine ⟨hdepth, ?_⟩ + exact EntriesValueGraph.released + (by simp [output, installPushedBinder]) htail + refine ⟨⟨roots, houtput, hrestGraph, ?_⟩, ?_⟩ + · exact hown.dropNoLocation + (hstable.const_noLocation hav) + · exact SlotsRealize.of_depth_eq + (by simp [output, installPushedBinder, VEnv.bump]) + (hslots.bump result) + | true => + have hvalueWorld : Sim.HasWorld store + (worldOfUses uses) result := + hown.roots_world ⟨worldOfUses uses, result⟩ (by simp) + have houtput : VEnvValueGraph funRel recSelfRel store output + (boundSource :: sourceEnv) (result :: env) + (⟨worldOfUses uses, result⟩ :: roots) := by + refine ⟨hdepth, ?_⟩ + exact EntriesValueGraph.held + (by simp [output, installPushedBinder]) + (by simp [output, installPushedBinder, VEnv.rel]) + hvalueWorld hvalueGraph htail + refine ⟨⟨⟨worldOfUses uses, result⟩ :: roots, + houtput, hrestGraph, ?_⟩, ?_⟩ + · simpa using hown + · exact SlotsRealize.of_depth_eq + (by simp [output, installPushedBinder, VEnv.bump]) + (hslots.bump result) + · simp [localOpOwnershipAllowance] + · exact zeroOwnershipAllowance_le_profile _ + +theorem materializeConstBinder_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input : VEnv} + {sourceEnv : List IxIR0.Value} {boundSource : IxIR0.Value} + {atom : Atom} {remaining : Nat} {uses : Ixon.Uses} {held : Bool} + (hstable : AValStable (.constA atom)) : + InstallBinderProfileSoundBelow funRel recSelfRel ctx cur limit input + (installPushedBinder input remaining uses held) + sourceEnv boundSource (worldOfUses uses) (.constA atom) + (emitOp (.pure atom)) (IxIR0.DynamicCost.tick .evalLet) := by + refine + { toInstallBinderValueSound := + materializeConstBinder_value_sound hstable + profileEmits := ?_ } + intro sourceRest rest slots + apply ProfileFundedEmitStateRunSoundBelow.localOp + (allowance := ⟨0, 0⟩) + · intro fuel store env store' result hpre hrun + obtain ⟨⟨roots, value, hinput, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + have hpure := Ix.Compiler.IxIR1.Sim.runOp_pure + (ctx := ctx) (cur := cur) + (fuel := fuel) (store := store) hav.resolveAtom + have hpair : (store, value) = (store', result) := + Except.ok.inj (hpure.symm.trans hrun) + cases hpair + let output := installPushedBinder input remaining uses held + have htail : EntriesValueGraph funRel recSelfRel store output + (result :: env) input.entries sourceEnv roots := + (hinput.entries.bump result).of_depth_eq + (by simp [output, installPushedBinder, VEnv.bump]) + have hdepth : (result :: env).length = output.depth := by + simpa [output, installPushedBinder] using + congrArg Nat.succ hinput.depth_eq + cases held with + | false => + have houtput : VEnvValueGraph funRel recSelfRel store output + (boundSource :: sourceEnv) (result :: env) roots := by + refine ⟨hdepth, ?_⟩ + exact EntriesValueGraph.released + (by simp [output, installPushedBinder]) htail + refine ⟨⟨roots, houtput, hrestGraph, ?_⟩, ?_⟩ + · exact hown.dropNoLocation + (hstable.const_noLocation hav) + · exact SlotsRealize.of_depth_eq + (by simp [output, installPushedBinder, VEnv.bump]) + (hslots.bump result) + | true => + have hvalueWorld : Sim.HasWorld store + (worldOfUses uses) result := + hown.roots_world ⟨worldOfUses uses, result⟩ (by simp) + have houtput : VEnvValueGraph funRel recSelfRel store output + (boundSource :: sourceEnv) (result :: env) + (⟨worldOfUses uses, result⟩ :: roots) := by + refine ⟨hdepth, ?_⟩ + exact EntriesValueGraph.held + (by simp [output, installPushedBinder]) + (by simp [output, installPushedBinder, VEnv.rel]) + hvalueWorld hvalueGraph htail + refine ⟨⟨⟨worldOfUses uses, result⟩ :: roots, + houtput, hrestGraph, ?_⟩, ?_⟩ + · simpa using hown + · exact SlotsRealize.of_depth_eq + (by simp [output, installPushedBinder, VEnv.bump]) + (hslots.bump result) + · simp [localOpOwnershipAllowance] + · exact zeroOwnershipAllowance_le_profile _ + +/-- Exact state-indexed cost rule for releasing one held environment slot. +The semantic callback abstracts over shared `drop` and affine `dropU`; both +have zero paired allowance in the local ownership table. -/ +theorem releaseSlot_profileFundedStateRunSound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input : VEnv} + {i abs : Nat} {uses : Ixon.Uses} {world : Ixon.Owned} + {releaseOp : Op} + (hworld : worldOfUses uses = world) + (hentry : input.entries[i]? = some (.slot abs 0 uses true)) + (hlocal : localOpOwnershipAllowance releaseOp = some ⟨0, 0⟩) + (hop : ∀ {fuel : Nat} {store store' : Store} {env : List RVal} + {value result : RVal} {tailRoots : List Sim.Root}, + resolveAtom env (.var (input.rel abs)) = .ok value → + Sim.RootOwnership store (⟨world, value⟩ :: tailRoots) → + runOp ctx (fuel + 1) cur store env releaseOp = + .ok (store', result) → + result = .erased ∧ Sim.StoreGraphRestricts store store' ∧ + Sim.RootOwnership store' tailRoots) : + ∀ sourceEnv sourceRest rest slots, + ProfileFundedEmitStateRunSound ctx cur (emitOp releaseOp) + (GraphOwnsVEnvProtected funRel recSelfRel input sourceEnv + sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel + ((input.setEntry i (.slot abs 0 uses false)).bump) + sourceEnv sourceRest rest slots) + 0 := by + intro sourceEnv sourceRest rest slots + apply ProfileFundedEmitStateRunSound.localOp + (allowance := ⟨0, 0⟩) + · intro fuel store env store' result hpre hrun + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + obtain ⟨⟨roots, hinput, hrestGraph, hown⟩, hslots⟩ := hpre + obtain ⟨_, value, beforeRoots, afterRoots, _, hbound, hslot, + _, _, hroots, hreleased⟩ := + hinput.entries.releaseAt hentry + let released := input.setEntry i (.slot abs 0 uses false) + let tailRoots := beforeRoots ++ afterRoots ++ rest + have hreleasedGraph : VEnvValueGraph funRel recSelfRel store + released sourceEnv env (beforeRoots ++ afterRoots) := + hinput.setEntry hreleased + have howned : Sim.RootOwnership store + (⟨world, value⟩ :: tailRoots) := by + rw [hroots] at hown + have hfront := hown.perm + (permExtractRoot ⟨worldOfUses uses, value⟩ + beforeRoots afterRoots rest) + simpa [tailRoots, hworld] using hfront + have hresolve : + resolveAtom env (.var (input.rel abs)) = .ok value := + (AValRealizes.slot hbound hslot).resolveAtom + obtain ⟨rfl, hrestrict, hownAfter⟩ := + hop hresolve howned hrun + have hinputAfter : VEnvValueGraph funRel recSelfRel store' + released sourceEnv env (beforeRoots ++ afterRoots) := + hreleasedGraph.ofRestricts hrestrict hownAfter + (fun root hmember => by + simpa [tailRoots] using + List.mem_append_left rest hmember) + have hrestAfter : Sim.RootsGraph funRel store' + sourceRest rest := + hrestGraph.ofRestrictsIn hrestrict hownAfter + (fun root hmember => by + simpa [tailRoots] using + List.mem_append_right (beforeRoots ++ afterRoots) hmember) + refine ⟨⟨beforeRoots ++ afterRoots, + hinputAfter.bump .erased, hrestAfter, ?_⟩, + (hslots.setEntry).bump .erased⟩ + simpa [tailRoots] using hownAfter + · exact hlocal + · exact OwnershipAllowanceLE.refl ⟨0, 0⟩ + +theorem releaseSlot_profileFundedStateRunSound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input : VEnv} + {i abs : Nat} {uses : Ixon.Uses} {world : Ixon.Owned} + {releaseOp : Op} + (hworld : worldOfUses uses = world) + (hentry : input.entries[i]? = some (.slot abs 0 uses true)) + (hlocal : localOpOwnershipAllowance releaseOp = some ⟨0, 0⟩) + (hop : ∀ {fuel : Nat} {store store' : Store} {env : List RVal} + {value result : RVal} {tailRoots : List Sim.Root}, + resolveAtom env (.var (input.rel abs)) = .ok value → + Sim.RootOwnership store (⟨world, value⟩ :: tailRoots) → + runOp ctx (fuel + 1) cur store env releaseOp = + .ok (store', result) → + result = .erased ∧ Sim.StoreGraphRestricts store store' ∧ + Sim.RootOwnership store' tailRoots) : + ∀ sourceEnv sourceRest rest slots, + ProfileFundedEmitStateRunSoundBelow ctx cur limit (emitOp releaseOp) + (GraphOwnsVEnvProtected funRel recSelfRel input sourceEnv + sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel + ((input.setEntry i (.slot abs 0 uses false)).bump) + sourceEnv sourceRest rest slots) + 0 := by + intro sourceEnv sourceRest rest slots + apply ProfileFundedEmitStateRunSoundBelow.localOp + (allowance := ⟨0, 0⟩) + · intro fuel store env store' result hpre hrun + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + obtain ⟨⟨roots, hinput, hrestGraph, hown⟩, hslots⟩ := hpre + obtain ⟨_, value, beforeRoots, afterRoots, _, hbound, hslot, + _, _, hroots, hreleased⟩ := + hinput.entries.releaseAt hentry + let released := input.setEntry i (.slot abs 0 uses false) + let tailRoots := beforeRoots ++ afterRoots ++ rest + have hreleasedGraph : VEnvValueGraph funRel recSelfRel store + released sourceEnv env (beforeRoots ++ afterRoots) := + hinput.setEntry hreleased + have howned : Sim.RootOwnership store + (⟨world, value⟩ :: tailRoots) := by + rw [hroots] at hown + have hfront := hown.perm + (permExtractRoot ⟨worldOfUses uses, value⟩ + beforeRoots afterRoots rest) + simpa [tailRoots, hworld] using hfront + have hresolve : + resolveAtom env (.var (input.rel abs)) = .ok value := + (AValRealizes.slot hbound hslot).resolveAtom + obtain ⟨rfl, hrestrict, hownAfter⟩ := + hop hresolve howned hrun + have hinputAfter : VEnvValueGraph funRel recSelfRel store' + released sourceEnv env (beforeRoots ++ afterRoots) := + hreleasedGraph.ofRestricts hrestrict hownAfter + (fun root hmember => by + simpa [tailRoots] using + List.mem_append_left rest hmember) + have hrestAfter : Sim.RootsGraph funRel store' + sourceRest rest := + hrestGraph.ofRestrictsIn hrestrict hownAfter + (fun root hmember => by + simpa [tailRoots] using + List.mem_append_right (beforeRoots ++ afterRoots) hmember) + refine ⟨⟨beforeRoots ++ afterRoots, + hinputAfter.bump .erased, hrestAfter, ?_⟩, + (hslots.setEntry).bump .erased⟩ + simpa [tailRoots] using hownAfter + · exact hlocal + · exact OwnershipAllowanceLE.refl ⟨0, 0⟩ + +theorem releaseSlotMany_profileFundedStateRunSound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input : VEnv} {i abs : Nat} + (hentry : input.entries[i]? = some (.slot abs 0 .many true)) : + ∀ sourceEnv sourceRest rest slots, + ProfileFundedEmitStateRunSound ctx cur + (emitOp (.drop (.var (input.rel abs)))) + (GraphOwnsVEnvProtected funRel recSelfRel input sourceEnv + sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel + ((input.setEntry i (.slot abs 0 .many false)).bump) + sourceEnv sourceRest rest slots) + 0 := by + apply releaseSlot_profileFundedStateRunSound rfl hentry + · simp [localOpOwnershipAllowance] + · exact Ix.Compiler.IxIR1.Sim.runOp_drop_value_owned_restricts + +theorem releaseSlotAffine_profileFundedStateRunSound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input : VEnv} {i abs : Nat} + (hentry : input.entries[i]? = some (.slot abs 0 .affine true)) : + ∀ sourceEnv sourceRest rest slots, + ProfileFundedEmitStateRunSound ctx cur + (emitOp (.dropU (.var (input.rel abs)))) + (GraphOwnsVEnvProtected funRel recSelfRel input sourceEnv + sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel + ((input.setEntry i (.slot abs 0 .affine false)).bump) + sourceEnv sourceRest rest slots) + 0 := by + apply releaseSlot_profileFundedStateRunSound rfl hentry + · simp [localOpOwnershipAllowance] + · exact Ix.Compiler.IxIR1.Sim.runOp_dropU_value_owned_restricts + +theorem releaseSlotMany_profileFundedStateRunSound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input : VEnv} {i abs : Nat} + (hentry : input.entries[i]? = some (.slot abs 0 .many true)) : + ∀ sourceEnv sourceRest rest slots, + ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.drop (.var (input.rel abs)))) + (GraphOwnsVEnvProtected funRel recSelfRel input sourceEnv + sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel + ((input.setEntry i (.slot abs 0 .many false)).bump) + sourceEnv sourceRest rest slots) + 0 := by + apply releaseSlot_profileFundedStateRunSound_below rfl hentry + · simp [localOpOwnershipAllowance] + · exact Ix.Compiler.IxIR1.Sim.runOp_drop_value_owned_restricts + +theorem releaseSlotAffine_profileFundedStateRunSound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input : VEnv} {i abs : Nat} + (hentry : input.entries[i]? = some (.slot abs 0 .affine true)) : + ∀ sourceEnv sourceRest rest slots, + ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.dropU (.var (input.rel abs)))) + (GraphOwnsVEnvProtected funRel recSelfRel input sourceEnv + sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel + ((input.setEntry i (.slot abs 0 .affine false)).bump) + sourceEnv sourceRest rest slots) + 0 := by + apply releaseSlot_profileFundedStateRunSound_below rfl hentry + · simp [localOpOwnershipAllowance] + · exact Ix.Compiler.IxIR1.Sim.runOp_dropU_value_owned_restricts + +/-- A dead affine slot binder aliases the bound result, immediately consumes +its unique root, and exposes a released logical entry to the body. -/ +theorem installAliasBinder_releasedAffine_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input : VEnv} + {sourceEnv : List IxIR0.Value} {boundSource : IxIR0.Value} + {abs : Nat} : + InstallBinderProfileSound funRel recSelfRel ctx cur input + (((installAliasBinder input abs 0 .affine true).setEntry 0 + (.slot abs 0 .affine false)).bump) + sourceEnv boundSource .unique (.slotA abs) + (emitOp (.dropU (.var (input.rel abs)))) + (IxIR0.DynamicCost.tick .evalLet) := by + let heldInput := installAliasBinder input abs 0 .affine true + have hentry : heldInput.entries[0]? = + some (.slot abs 0 .affine true) := by + simp [heldInput, installAliasBinder] + have halias : InstallBinderProfileSound funRel recSelfRel ctx cur input + heldInput sourceEnv boundSource .unique (.slotA abs) + (_root_.id : Emit) (IxIR0.DynamicCost.tick .evalLet) := by + simpa [heldInput, worldOfUses] using + (installAliasBinder_profile_sound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (input := input) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (abs := abs) (remaining := 0) (uses := Ixon.Uses.affine)) + have hcomposed : InstallBinderProfileSound funRel recSelfRel ctx cur + input ((heldInput.setEntry 0 (.slot abs 0 .affine false)).bump) + sourceEnv boundSource .unique (.slotA abs) + ((_root_.id : Emit) ∘ + emitOp (.dropU (.var (heldInput.rel abs)))) + (IxIR0.DynamicCost.tick .evalLet + 0) := + halias.compVEnv + (release_slot_affine_owned hentry) + (release_slot_affine_value_sound hentry + (boundSource :: sourceEnv)) + (releaseSlotAffine_profileFundedStateRunSound hentry + (boundSource :: sourceEnv)) + have hnormalized : InstallBinderProfileSound funRel recSelfRel ctx cur + input ((heldInput.setEntry 0 (.slot abs 0 .affine false)).bump) + sourceEnv boundSource .unique (.slotA abs) + ((_root_.id : Emit) ∘ + emitOp (.dropU (.var (heldInput.rel abs)))) + (IxIR0.DynamicCost.tick .evalLet) := + InstallBinderProfileSound.of_profile_eq hcomposed + (IxIR0.DynamicCost.Profile.add_zero _) + simpa [heldInput, installAliasBinder, VEnv.rel, Function.comp_def] using + hnormalized + +/-- Shared dead binders use the corresponding shallow `drop`; its amortized +paired cost is likewise zero after consuming the owned root. -/ +theorem installAliasBinder_releasedMany_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input : VEnv} + {sourceEnv : List IxIR0.Value} {boundSource : IxIR0.Value} + {abs : Nat} : + InstallBinderProfileSound funRel recSelfRel ctx cur input + (((installAliasBinder input abs 0 .many true).setEntry 0 + (.slot abs 0 .many false)).bump) + sourceEnv boundSource .shared (.slotA abs) + (emitOp (.drop (.var (input.rel abs)))) + (IxIR0.DynamicCost.tick .evalLet) := by + let heldInput := installAliasBinder input abs 0 .many true + have hentry : heldInput.entries[0]? = + some (.slot abs 0 .many true) := by + simp [heldInput, installAliasBinder] + have halias : InstallBinderProfileSound funRel recSelfRel ctx cur input + heldInput sourceEnv boundSource .shared (.slotA abs) + (_root_.id : Emit) (IxIR0.DynamicCost.tick .evalLet) := by + simpa [heldInput, worldOfUses] using + (installAliasBinder_profile_sound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (input := input) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (abs := abs) (remaining := 0) (uses := Ixon.Uses.many)) + have hcomposed : InstallBinderProfileSound funRel recSelfRel ctx cur + input ((heldInput.setEntry 0 (.slot abs 0 .many false)).bump) + sourceEnv boundSource .shared (.slotA abs) + ((_root_.id : Emit) ∘ + emitOp (.drop (.var (heldInput.rel abs)))) + (IxIR0.DynamicCost.tick .evalLet + 0) := + halias.compVEnv + (release_slot_many_owned hentry) + (release_slot_many_value_sound hentry + (boundSource :: sourceEnv)) + (releaseSlotMany_profileFundedStateRunSound hentry + (boundSource :: sourceEnv)) + have hnormalized : InstallBinderProfileSound funRel recSelfRel ctx cur + input ((heldInput.setEntry 0 (.slot abs 0 .many false)).bump) + sourceEnv boundSource .shared (.slotA abs) + ((_root_.id : Emit) ∘ + emitOp (.drop (.var (heldInput.rel abs)))) + (IxIR0.DynamicCost.tick .evalLet) := + InstallBinderProfileSound.of_profile_eq hcomposed + (IxIR0.DynamicCost.Profile.add_zero _) + simpa [heldInput, installAliasBinder, VEnv.rel, Function.comp_def] using + hnormalized + +theorem installAliasBinder_releasedAffine_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input : VEnv} + {sourceEnv : List IxIR0.Value} {boundSource : IxIR0.Value} + {abs : Nat} : + InstallBinderProfileSoundBelow funRel recSelfRel ctx cur limit input + (((installAliasBinder input abs 0 .affine true).setEntry 0 + (.slot abs 0 .affine false)).bump) + sourceEnv boundSource .unique (.slotA abs) + (emitOp (.dropU (.var (input.rel abs)))) + (IxIR0.DynamicCost.tick .evalLet) := by + let heldInput := installAliasBinder input abs 0 .affine true + have hentry : heldInput.entries[0]? = + some (.slot abs 0 .affine true) := by + simp [heldInput, installAliasBinder] + have halias : InstallBinderProfileSoundBelow funRel recSelfRel ctx cur + limit input heldInput sourceEnv boundSource .unique (.slotA abs) + (_root_.id : Emit) (IxIR0.DynamicCost.tick .evalLet) := by + simpa [heldInput, worldOfUses] using + (installAliasBinder_profile_sound_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) (input := input) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (abs := abs) (remaining := 0) (uses := Ixon.Uses.affine)) + have hcomposed : InstallBinderProfileSoundBelow funRel recSelfRel ctx cur + limit input + ((heldInput.setEntry 0 (.slot abs 0 .affine false)).bump) + sourceEnv boundSource .unique (.slotA abs) + ((_root_.id : Emit) ∘ + emitOp (.dropU (.var (heldInput.rel abs)))) + (IxIR0.DynamicCost.tick .evalLet + 0) := + halias.compVEnv + (release_slot_affine_owned hentry) + (release_slot_affine_value_sound hentry + (boundSource :: sourceEnv)) + (releaseSlotAffine_profileFundedStateRunSound_below hentry + (boundSource :: sourceEnv)) + have hnormalized : InstallBinderProfileSoundBelow funRel recSelfRel ctx + cur limit input + ((heldInput.setEntry 0 (.slot abs 0 .affine false)).bump) + sourceEnv boundSource .unique (.slotA abs) + ((_root_.id : Emit) ∘ + emitOp (.dropU (.var (heldInput.rel abs)))) + (IxIR0.DynamicCost.tick .evalLet) := + InstallBinderProfileSoundBelow.of_profile_eq hcomposed + (IxIR0.DynamicCost.Profile.add_zero _) + simpa [heldInput, installAliasBinder, VEnv.rel, Function.comp_def] using + hnormalized + +theorem installAliasBinder_releasedMany_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input : VEnv} + {sourceEnv : List IxIR0.Value} {boundSource : IxIR0.Value} + {abs : Nat} : + InstallBinderProfileSoundBelow funRel recSelfRel ctx cur limit input + (((installAliasBinder input abs 0 .many true).setEntry 0 + (.slot abs 0 .many false)).bump) + sourceEnv boundSource .shared (.slotA abs) + (emitOp (.drop (.var (input.rel abs)))) + (IxIR0.DynamicCost.tick .evalLet) := by + let heldInput := installAliasBinder input abs 0 .many true + have hentry : heldInput.entries[0]? = + some (.slot abs 0 .many true) := by + simp [heldInput, installAliasBinder] + have halias : InstallBinderProfileSoundBelow funRel recSelfRel ctx cur + limit input heldInput sourceEnv boundSource .shared (.slotA abs) + (_root_.id : Emit) (IxIR0.DynamicCost.tick .evalLet) := by + simpa [heldInput, worldOfUses] using + (installAliasBinder_profile_sound_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) (input := input) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (abs := abs) (remaining := 0) (uses := Ixon.Uses.many)) + have hcomposed : InstallBinderProfileSoundBelow funRel recSelfRel ctx cur + limit input + ((heldInput.setEntry 0 (.slot abs 0 .many false)).bump) + sourceEnv boundSource .shared (.slotA abs) + ((_root_.id : Emit) ∘ + emitOp (.drop (.var (heldInput.rel abs)))) + (IxIR0.DynamicCost.tick .evalLet + 0) := + halias.compVEnv + (release_slot_many_owned hentry) + (release_slot_many_value_sound hentry + (boundSource :: sourceEnv)) + (releaseSlotMany_profileFundedStateRunSound_below hentry + (boundSource :: sourceEnv)) + have hnormalized : InstallBinderProfileSoundBelow funRel recSelfRel ctx + cur limit input + ((heldInput.setEntry 0 (.slot abs 0 .many false)).bump) + sourceEnv boundSource .shared (.slotA abs) + ((_root_.id : Emit) ∘ + emitOp (.drop (.var (heldInput.rel abs)))) + (IxIR0.DynamicCost.tick .evalLet) := + InstallBinderProfileSoundBelow.of_profile_eq hcomposed + (IxIR0.DynamicCost.Profile.add_zero _) + simpa [heldInput, installAliasBinder, VEnv.rel, Function.comp_def] using + hnormalized + +/-- Any environment-independent scalar result enriches the existing +semantic lowering rule with a source-funded identity-prefix cost proof. -/ +theorem scalar_id_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {world : Ixon.Owned} {atom : Atom} {value : RVal} + (hstable : AValStable (.constA atom)) + (hresolve : ∀ env, resolveAtom env atom = .ok value) + (hnone : Sim.rvalLocation? value = none) + (hvalue : ∀ store, Sim.ValueGraph funRel store sourceValue value) + (profile : SourceProfile) : + LowerResultProfileSound funRel recSelfRel ctx cur input input + sourceEnv sourceEnv sourceValue world (_root_.id : Emit) + (.constA atom) profile := by + refine + { toLowerResultValueSound := + scalar_id_value_sound hstable hresolve hnone hvalue + profileEmits := ?_ } + intro sourceRest rest slots + apply ProfileFundedEmitStateRunSound.monoProfile + · apply ProfileFundedEmitStateRunSound.id + intro store env hpre + obtain ⟨⟨roots, hinput, hrestGraph, howned⟩, hslots⟩ := hpre + exact ⟨⟨roots, value, hinput, .const (hresolve env), hvalue store, + hrestGraph, howned.addNoLocation hnone⟩, hslots⟩ + · exact zeroOwnershipAllowance_le_profile profile + +/-- Moving a final variable occurrence emits no target operation, so the +same semantic transition can be assigned any enclosing source profile. -/ +theorem lower_held_move_profile_sound_of_profile + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {index abs remaining : Nat} {uses : Ixon.Uses} + (hsource : sourceEnv[index]? = some sourceValue) + (hentry : input.entries[index]? = + some (.slot abs remaining uses true)) (profile : SourceProfile) : + LowerResultProfileSound funRel recSelfRel ctx cur input + (input.setEntry index (.slot abs 0 uses false)) + sourceEnv sourceEnv sourceValue (worldOfUses uses) + (_root_.id : Emit) (.slotA abs) + profile := by + refine + { toLowerResultValueSound := + lower_held_move_value_sound hsource hentry + profileEmits := ?_ } + intro sourceRest rest slots + apply ProfileFundedEmitStateRunSound.monoProfile + · apply ProfileFundedEmitStateRunSound.id + intro store env hpre + obtain ⟨⟨roots, hinput, hrestGraph, howned⟩, hslots⟩ := hpre + obtain ⟨foundSource, value, beforeRoots, afterRoots, hfoundSource, + hbound, hslot, _, hvalue, hroots, houtput⟩ := + hinput.entries.releaseAt hentry + have hsourceEq : foundSource = sourceValue := + Option.some.inj (hfoundSource.symm.trans hsource) + subst foundSource + refine ⟨⟨beforeRoots ++ afterRoots, value, + hinput.setEntry houtput, ?_, hvalue, hrestGraph, ?_⟩, + hslots.setEntry⟩ + · apply AValRealizes.slot + · simpa [VEnv.setEntry] using hbound + · simpa [VEnv.setEntry, VEnv.rel] using hslot + · rw [hroots] at howned + exact howned.perm + (permExtractRoot ⟨worldOfUses uses, value⟩ + beforeRoots afterRoots rest) + · exact zeroOwnershipAllowance_le_profile profile + +/-- Ordinary final variable use specializes the arbitrary held-entry move to +remaining count one. -/ +theorem lower_var_move_profile_sound_of_profile + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {index abs : Nat} {uses : Ixon.Uses} + (hsource : sourceEnv[index]? = some sourceValue) + (hentry : input.entries[index]? = + some (.slot abs 1 uses true)) (profile : SourceProfile) : + LowerResultProfileSound funRel recSelfRel ctx cur input + (input.setEntry index (.slot abs 0 uses false)) + sourceEnv sourceEnv sourceValue (worldOfUses uses) + (_root_.id : Emit) (.slotA abs) profile := + lower_held_move_profile_sound_of_profile hsource hentry profile + +/-- Expression-variable specialization of the zero-cost final-use rule. -/ +theorem lower_var_move_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {index abs : Nat} {uses : Ixon.Uses} + (hsource : sourceEnv[index]? = some sourceValue) + (hentry : input.entries[index]? = + some (.slot abs 1 uses true)) : + LowerResultProfileSound funRel recSelfRel ctx cur input + (input.setEntry index (.slot abs 0 uses false)) + sourceEnv sourceEnv sourceValue (worldOfUses uses) + (_root_.id : Emit) (.slotA abs) + (IxIR0.DynamicCost.tick .evalVar + + IxIR0.DynamicCost.retain 1) := + lower_var_move_profile_sound_of_profile hsource hentry _ + +/-- A repeated shared variable use couples its semantic retain step with the +paired `(0,2)` cost of `dup`, under any source profile that funds that pair. -/ +theorem lower_held_retain_profile_sound_of_funding + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {index abs remaining newRemaining : Nat} {uses : Ixon.Uses} + {profile : SourceProfile} + (hsource : sourceEnv[index]? = some sourceValue) + (hworld : worldOfUses uses = .shared) + (hentry : input.entries[index]? = + some (.slot abs remaining uses true)) + (hfunded : OwnershipAllowanceLE ⟨0, 2⟩ + (sourceProfileOwnershipAllowance profile)) : + let output := input.setEntry index + (.slot abs newRemaining uses true) + LowerResultProfileSound funRel recSelfRel ctx cur input output.bump + sourceEnv sourceEnv sourceValue .shared + (emitOp (.dup (.var (output.rel abs)))) (.slotA output.depth) + profile := by + dsimp only + let output := input.setEntry index + (.slot abs newRemaining uses true) + refine + { toLowerResultValueSound := + lower_held_retain_value_sound hsource hworld hentry + profileEmits := ?_ } + intro sourceRest rest slots + apply ProfileFundedEmitStateRunSound.ofOp + intro fuel store store' env result horder hbounds hpre hrun + have hlocal : localOpOwnershipAllowance + (.dup (.var (output.rel abs))) = some ⟨0, 2⟩ := by + simp [localOpOwnershipAllowance] + obtain ⟨_, _, hgrowth⟩ := + (OpOwnershipCostSound.of_local hlocal) horder hbounds hrun + have hcost : ProfileFundedOpRun ctx fuel cur store env + (.dup (.var (output.rel abs))) store' result + profile := + ⟨⟨0, 2⟩, ⟨horder, hbounds, hrun, hgrowth⟩, hfunded⟩ + have hmid : GraphOwnsResultProtected funRel recSelfRel output.bump + sourceEnv sourceValue .shared (.slotA output.depth) + sourceRest rest slots store' (result :: env) := by + obtain ⟨⟨roots, hinput, hrestGraph, howned⟩, hslots⟩ := hpre + obtain ⟨foundSource, retained, hfoundSource, hbound, hslot, + hvalueWorld, hvalueGraph, _, hupdated⟩ := + hinput.entries.updateHeldAt newRemaining hentry + have hsourceEq : foundSource = sourceValue := + Option.some.inj (hfoundSource.symm.trans hsource) + subst foundSource + have houtput : VEnvValueGraph funRel recSelfRel store output + sourceEnv env roots := hinput.setEntry hupdated + have hav : AValRealizes output env (.slotA abs) retained := by + apply AValRealizes.slot + · simpa [output, VEnv.setEntry] using hbound + · simpa [output, VEnv.setEntry, VEnv.rel] using hslot + have hshared : Sim.HasWorld store .shared retained := by + simpa [hworld] using hvalueWorld + cases fuel with + | zero => + simp [runOp] at hrun + | succ fuel => + obtain ⟨middle, heval, hstore, hresultGraph, hmiddle⟩ := + Ix.Compiler.IxIR1.Sim.runOp_retain_borrowed_valueGraph + (ctx := ctx) (cur := cur) (fuel := fuel) + hav.resolveAtom hshared hvalueGraph howned + have hpair : (middle, retained) = (store', result) := + Except.ok.inj (heval.symm.trans hrun) + cases hpair + have houtputMiddle : VEnvValueGraph funRel recSelfRel store' + output sourceEnv env roots := houtput.monoStore hstore + have hrestMiddle : Sim.RootsGraph funRel store' sourceRest rest := + hrestGraph.monoStore hstore + refine ⟨⟨roots, result, houtputMiddle.bump result, ?_, + hresultGraph, hrestMiddle, hmiddle⟩, + hslots.setEntry.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + exact ⟨hmid, hcost⟩ + +/-- Expression-variable specialization of the funded retain rule. -/ +theorem lower_held_retain_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {index abs remaining newRemaining : Nat} {uses : Ixon.Uses} + (hsource : sourceEnv[index]? = some sourceValue) + (hworld : worldOfUses uses = .shared) + (hentry : input.entries[index]? = + some (.slot abs remaining uses true)) : + let output := input.setEntry index + (.slot abs newRemaining uses true) + LowerResultProfileSound funRel recSelfRel ctx cur input output.bump + sourceEnv sourceEnv sourceValue .shared + (emitOp (.dup (.var (output.rel abs)))) (.slotA output.depth) + (IxIR0.DynamicCost.tick .evalVar + + IxIR0.DynamicCost.retain 1) := by + apply lower_held_retain_profile_sound_of_funding hsource hworld hentry + rw [sourceProfileOwnershipAllowance_add, + sourceProfileOwnershipAllowance_tick_of_evals_eq_one .evalVar + (by rfl), + sourceProfileOwnershipAllowance_retain] + simp [OwnershipAllowanceLE, evalOwnershipAllowance, + retainedOwnershipAllowance, OwnershipAllowance.add] + +/-- A final shared variable borrow moves the existing owner into the pending +borrow position. The expression profile is unchanged and no target RC +operation is emitted. -/ +theorem lower_var_shared_move_borrow_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {index abs : Nat} {uses : Ixon.Uses} + (hsource : sourceEnv[index]? = some sourceValue) + (hworld : worldOfUses uses = .shared) + (hentry : input.entries[index]? = + some (.slot abs 1 uses true)) : + LowerBorrowProfileSound funRel recSelfRel ctx cur input + (input.setEntry index (.slot abs 0 uses false)) + sourceEnv sourceEnv sourceValue (_root_.id : Emit) + (.slotA abs) true + (IxIR0.DynamicCost.tick .evalVar + + IxIR0.DynamicCost.retain 1) := by + have hmove := lower_var_move_profile_sound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) hsource hentry + have hshared : LowerResultProfileSound funRel recSelfRel ctx cur input + (input.setEntry index (.slot abs 0 uses false)) + sourceEnv sourceEnv sourceValue .shared (_root_.id : Emit) + (.slotA abs) + (IxIR0.DynamicCost.tick .evalVar + + IxIR0.DynamicCost.retain 1) := by + simpa [hworld] using hmove + exact hshared.asBorrowSlot + +/-- Repeated shared borrowing decrements the static use count while retaining +the same runtime owner. Its identity target prefix is conservatively funded +by the source variable profile. -/ +theorem lower_var_shared_borrow_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {index abs remaining : Nat} {uses : Ixon.Uses} + (hsource : sourceEnv[index]? = some sourceValue) + (hworld : worldOfUses uses = .shared) + (hentry : input.entries[index]? = + some (.slot abs (Nat.succ (Nat.succ remaining)) uses true)) : + let output := input.setEntry index + (.slot abs (Nat.succ remaining) uses true) + LowerBorrowProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue (_root_.id : Emit) + (.slotA abs) false + (IxIR0.DynamicCost.tick .evalVar + + IxIR0.DynamicCost.retain 1) := by + dsimp only + let output := input.setEntry index + (.slot abs (Nat.succ remaining) uses true) + refine + { toLowerBorrowValueSound := + lower_var_shared_borrow_value_sound hsource hworld hentry + profileEmits := ?_ } + intro sourceRest rest slots + apply ProfileFundedEmitStateRunSound.monoProfile + · apply ProfileFundedEmitStateRunSound.id + intro store env hpre + obtain ⟨⟨roots, hinput, hrestGraph, hown⟩, hslots⟩ := hpre + obtain ⟨foundSource, value, hfoundSource, hbound, hslot, + hvalueWorld, hvalueGraph, _, hupdated⟩ := + hinput.entries.updateHeldAt (Nat.succ remaining) hentry + have hsourceEq : foundSource = sourceValue := + Option.some.inj (hfoundSource.symm.trans hsource) + subst foundSource + have houtput : VEnvValueGraph funRel recSelfRel store output + sourceEnv env roots := hinput.setEntry hupdated + have hav : AValRealizes output env (.slotA abs) value := by + apply AValRealizes.slot + · simpa [output, VEnv.setEntry] using hbound + · simpa [output, VEnv.setEntry, VEnv.rel] using hslot + have hshared : Sim.HasWorld store .shared value := by + simpa [hworld] using hvalueWorld + refine ⟨roots, value, houtput, hav, hshared, hvalueGraph, + hrestGraph, ?_, hslots.setEntry⟩ + simpa [borrowResultRoots] using hown + · exact zeroOwnershipAllowance_le_profile _ + +/-- At a fixed target-fuel ceiling, any environment-independent scalar result enriches the existing +semantic lowering rule with a source-funded identity-prefix cost proof. -/ +theorem scalar_id_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {world : Ixon.Owned} {atom : Atom} {value : RVal} + (hstable : AValStable (.constA atom)) + (hresolve : ∀ env, resolveAtom env atom = .ok value) + (hnone : Sim.rvalLocation? value = none) + (hvalue : ∀ store, Sim.ValueGraph funRel store sourceValue value) + (profile : SourceProfile) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input input + sourceEnv sourceEnv sourceValue world (_root_.id : Emit) + (.constA atom) profile := by + refine + { toLowerResultValueSound := + scalar_id_value_sound hstable hresolve hnone hvalue + profileEmits := ?_ } + intro sourceRest rest slots + apply ProfileFundedEmitStateRunSoundBelow.monoProfile + · apply ProfileFundedEmitStateRunSoundBelow.id + intro store env hpre + obtain ⟨⟨roots, hinput, hrestGraph, howned⟩, hslots⟩ := hpre + exact ⟨⟨roots, value, hinput, .const (hresolve env), hvalue store, + hrestGraph, howned.addNoLocation hnone⟩, hslots⟩ + · exact zeroOwnershipAllowance_le_profile profile + +/-- Moving a final variable occurrence emits no target operation, so the +same semantic transition can be assigned any enclosing source profile. -/ +theorem lower_held_move_profile_sound_of_profile_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {index abs remaining : Nat} {uses : Ixon.Uses} + (hsource : sourceEnv[index]? = some sourceValue) + (hentry : input.entries[index]? = + some (.slot abs remaining uses true)) (profile : SourceProfile) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + (input.setEntry index (.slot abs 0 uses false)) + sourceEnv sourceEnv sourceValue (worldOfUses uses) + (_root_.id : Emit) (.slotA abs) + profile := by + refine + { toLowerResultValueSound := + lower_held_move_value_sound hsource hentry + profileEmits := ?_ } + intro sourceRest rest slots + apply ProfileFundedEmitStateRunSoundBelow.monoProfile + · apply ProfileFundedEmitStateRunSoundBelow.id + intro store env hpre + obtain ⟨⟨roots, hinput, hrestGraph, howned⟩, hslots⟩ := hpre + obtain ⟨foundSource, value, beforeRoots, afterRoots, hfoundSource, + hbound, hslot, _, hvalue, hroots, houtput⟩ := + hinput.entries.releaseAt hentry + have hsourceEq : foundSource = sourceValue := + Option.some.inj (hfoundSource.symm.trans hsource) + subst foundSource + refine ⟨⟨beforeRoots ++ afterRoots, value, + hinput.setEntry houtput, ?_, hvalue, hrestGraph, ?_⟩, + hslots.setEntry⟩ + · apply AValRealizes.slot + · simpa [VEnv.setEntry] using hbound + · simpa [VEnv.setEntry, VEnv.rel] using hslot + · rw [hroots] at howned + exact howned.perm + (permExtractRoot ⟨worldOfUses uses, value⟩ + beforeRoots afterRoots rest) + · exact zeroOwnershipAllowance_le_profile profile + +/-- Ordinary final variable use specializes the arbitrary held-entry move to +remaining count one. -/ +theorem lower_var_move_profile_sound_of_profile_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {index abs : Nat} {uses : Ixon.Uses} + (hsource : sourceEnv[index]? = some sourceValue) + (hentry : input.entries[index]? = + some (.slot abs 1 uses true)) (profile : SourceProfile) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + (input.setEntry index (.slot abs 0 uses false)) + sourceEnv sourceEnv sourceValue (worldOfUses uses) + (_root_.id : Emit) (.slotA abs) profile := + lower_held_move_profile_sound_of_profile_below hsource hentry profile + +/-- Expression-variable specialization of the zero-cost final-use rule. -/ +theorem lower_var_move_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {index abs : Nat} {uses : Ixon.Uses} + (hsource : sourceEnv[index]? = some sourceValue) + (hentry : input.entries[index]? = + some (.slot abs 1 uses true)) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + (input.setEntry index (.slot abs 0 uses false)) + sourceEnv sourceEnv sourceValue (worldOfUses uses) + (_root_.id : Emit) (.slotA abs) + (IxIR0.DynamicCost.tick .evalVar + + IxIR0.DynamicCost.retain 1) := + lower_var_move_profile_sound_of_profile_below hsource hentry _ + +/-- A repeated shared variable use couples its semantic retain step with the +paired `(0,2)` cost of `dup`, under any source profile that funds that pair. -/ +theorem lower_held_retain_profile_sound_of_funding_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {index abs remaining newRemaining : Nat} {uses : Ixon.Uses} + {profile : SourceProfile} + (hsource : sourceEnv[index]? = some sourceValue) + (hworld : worldOfUses uses = .shared) + (hentry : input.entries[index]? = + some (.slot abs remaining uses true)) + (hfunded : OwnershipAllowanceLE ⟨0, 2⟩ + (sourceProfileOwnershipAllowance profile)) : + let output := input.setEntry index + (.slot abs newRemaining uses true) + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output.bump + sourceEnv sourceEnv sourceValue .shared + (emitOp (.dup (.var (output.rel abs)))) (.slotA output.depth) + profile := by + dsimp only + let output := input.setEntry index + (.slot abs newRemaining uses true) + refine + { toLowerResultValueSound := + lower_held_retain_value_sound hsource hworld hentry + profileEmits := ?_ } + intro sourceRest rest slots + apply ProfileFundedEmitStateRunSoundBelow.ofOp + intro fuel store store' env result _ horder hbounds hpre hrun + have hlocal : localOpOwnershipAllowance + (.dup (.var (output.rel abs))) = some ⟨0, 2⟩ := by + simp [localOpOwnershipAllowance] + obtain ⟨_, _, hgrowth⟩ := + (OpOwnershipCostSound.of_local hlocal) horder hbounds hrun + have hcost : ProfileFundedOpRun ctx fuel cur store env + (.dup (.var (output.rel abs))) store' result + profile := + ⟨⟨0, 2⟩, ⟨horder, hbounds, hrun, hgrowth⟩, hfunded⟩ + have hmid : GraphOwnsResultProtected funRel recSelfRel output.bump + sourceEnv sourceValue .shared (.slotA output.depth) + sourceRest rest slots store' (result :: env) := by + obtain ⟨⟨roots, hinput, hrestGraph, howned⟩, hslots⟩ := hpre + obtain ⟨foundSource, retained, hfoundSource, hbound, hslot, + hvalueWorld, hvalueGraph, _, hupdated⟩ := + hinput.entries.updateHeldAt newRemaining hentry + have hsourceEq : foundSource = sourceValue := + Option.some.inj (hfoundSource.symm.trans hsource) + subst foundSource + have houtput : VEnvValueGraph funRel recSelfRel store output + sourceEnv env roots := hinput.setEntry hupdated + have hav : AValRealizes output env (.slotA abs) retained := by + apply AValRealizes.slot + · simpa [output, VEnv.setEntry] using hbound + · simpa [output, VEnv.setEntry, VEnv.rel] using hslot + have hshared : Sim.HasWorld store .shared retained := by + simpa [hworld] using hvalueWorld + cases fuel with + | zero => + simp [runOp] at hrun + | succ fuel => + obtain ⟨middle, heval, hstore, hresultGraph, hmiddle⟩ := + Ix.Compiler.IxIR1.Sim.runOp_retain_borrowed_valueGraph + (ctx := ctx) (cur := cur) (fuel := fuel) + hav.resolveAtom hshared hvalueGraph howned + have hpair : (middle, retained) = (store', result) := + Except.ok.inj (heval.symm.trans hrun) + cases hpair + have houtputMiddle : VEnvValueGraph funRel recSelfRel store' + output sourceEnv env roots := houtput.monoStore hstore + have hrestMiddle : Sim.RootsGraph funRel store' sourceRest rest := + hrestGraph.monoStore hstore + refine ⟨⟨roots, result, houtputMiddle.bump result, ?_, + hresultGraph, hrestMiddle, hmiddle⟩, + hslots.setEntry.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + exact ⟨hmid, hcost⟩ + +/-- Expression-variable specialization of the funded retain rule. -/ +theorem lower_held_retain_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {index abs remaining newRemaining : Nat} {uses : Ixon.Uses} + (hsource : sourceEnv[index]? = some sourceValue) + (hworld : worldOfUses uses = .shared) + (hentry : input.entries[index]? = + some (.slot abs remaining uses true)) : + let output := input.setEntry index + (.slot abs newRemaining uses true) + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output.bump + sourceEnv sourceEnv sourceValue .shared + (emitOp (.dup (.var (output.rel abs)))) (.slotA output.depth) + (IxIR0.DynamicCost.tick .evalVar + + IxIR0.DynamicCost.retain 1) := by + apply lower_held_retain_profile_sound_of_funding_below hsource hworld hentry + rw [sourceProfileOwnershipAllowance_add, + sourceProfileOwnershipAllowance_tick_of_evals_eq_one .evalVar + (by rfl), + sourceProfileOwnershipAllowance_retain] + simp [OwnershipAllowanceLE, evalOwnershipAllowance, + retainedOwnershipAllowance, OwnershipAllowance.add] + +/-- A final shared variable borrow moves the existing owner into the pending +borrow position. The expression profile is unchanged and no target RC +operation is emitted. -/ +theorem lower_var_shared_move_borrow_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {index abs : Nat} {uses : Ixon.Uses} + (hsource : sourceEnv[index]? = some sourceValue) + (hworld : worldOfUses uses = .shared) + (hentry : input.entries[index]? = + some (.slot abs 1 uses true)) : + LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit input + (input.setEntry index (.slot abs 0 uses false)) + sourceEnv sourceEnv sourceValue (_root_.id : Emit) + (.slotA abs) true + (IxIR0.DynamicCost.tick .evalVar + + IxIR0.DynamicCost.retain 1) := by + have hmove := lower_var_move_profile_sound_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) hsource hentry + have hshared : LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + (input.setEntry index (.slot abs 0 uses false)) + sourceEnv sourceEnv sourceValue .shared (_root_.id : Emit) + (.slotA abs) + (IxIR0.DynamicCost.tick .evalVar + + IxIR0.DynamicCost.retain 1) := by + simpa [hworld] using hmove + exact hshared.asBorrowSlot + +/-- Repeated shared borrowing decrements the static use count while retaining +the same runtime owner. Its identity target prefix is conservatively funded +by the source variable profile. -/ +theorem lower_var_shared_borrow_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {index abs remaining : Nat} {uses : Ixon.Uses} + (hsource : sourceEnv[index]? = some sourceValue) + (hworld : worldOfUses uses = .shared) + (hentry : input.entries[index]? = + some (.slot abs (Nat.succ (Nat.succ remaining)) uses true)) : + let output := input.setEntry index + (.slot abs (Nat.succ remaining) uses true) + LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue (_root_.id : Emit) + (.slotA abs) false + (IxIR0.DynamicCost.tick .evalVar + + IxIR0.DynamicCost.retain 1) := by + dsimp only + let output := input.setEntry index + (.slot abs (Nat.succ remaining) uses true) + refine + { toLowerBorrowValueSound := + lower_var_shared_borrow_value_sound hsource hworld hentry + profileEmits := ?_ } + intro sourceRest rest slots + apply ProfileFundedEmitStateRunSoundBelow.monoProfile + · apply ProfileFundedEmitStateRunSoundBelow.id + intro store env hpre + obtain ⟨⟨roots, hinput, hrestGraph, hown⟩, hslots⟩ := hpre + obtain ⟨foundSource, value, hfoundSource, hbound, hslot, + hvalueWorld, hvalueGraph, _, hupdated⟩ := + hinput.entries.updateHeldAt (Nat.succ remaining) hentry + have hsourceEq : foundSource = sourceValue := + Option.some.inj (hfoundSource.symm.trans hsource) + subst foundSource + have houtput : VEnvValueGraph funRel recSelfRel store output + sourceEnv env roots := hinput.setEntry hupdated + have hav : AValRealizes output env (.slotA abs) value := by + apply AValRealizes.slot + · simpa [output, VEnv.setEntry] using hbound + · simpa [output, VEnv.setEntry, VEnv.rel] using hslot + have hshared : Sim.HasWorld store .shared value := by + simpa [hworld] using hvalueWorld + refine ⟨roots, value, houtput, hav, hshared, hvalueGraph, + hrestGraph, ?_, hslots.setEntry⟩ + simpa [borrowResultRoots] using hown + · exact zeroOwnershipAllowance_le_profile _ + +theorem ProfileFundedInvokeRun.fn + {ctx : Ctx} {fuel : Nat} {address : Ixon.Address} {args : List RVal} + {before after : Store} {value : RVal} {decl : FnDef} + {profile : SourceProfile} + (hdecl : ctx.decls address = some (.fn decl)) + (harity : args.length = decl.arity) + (hbody : ProfileFundedCodeRun ctx fuel decl before args.reverse decl.body + after value profile) + (hresult : checkResultWorld decl.result (after, value) = + .ok (after, value)) : + ProfileFundedInvokeRun ctx (fuel + 1) address args before after value + profile := by + obtain ⟨allowance, hbodyCost, hbodyFunded⟩ := hbody + exact ⟨allowance, + InvokeOwnershipRunCost.fn hdecl harity hbodyCost hresult, + hbodyFunded⟩ + +theorem ProfileFundedOpRun.call + {ctx : Ctx} {fuel : Nat} {cur : FnDef} {before after : Store} + {env : List RVal} {address : Ixon.Address} {atoms : Array Atom} + {args : List RVal} {value : RVal} {profile : SourceProfile} + (henv : ValuesInBounds before env) + (hresolve : resolveAtoms env atoms = .ok args) + (hinvoke : ProfileFundedInvokeRun ctx fuel address args before after value + profile) : + ProfileFundedOpRun ctx (fuel + 1) cur before env (.call address atoms) + after value profile := by + obtain ⟨allowance, hinvokeCost, hinvokeFunded⟩ := hinvoke + exact ⟨allowance, + OpOwnershipRunCost.call henv hresolve hinvokeCost, hinvokeFunded⟩ + +theorem ProfileFundedOpRun.callSelf + {ctx : Ctx} {fuel : Nat} {cur : FnDef} {before after : Store} + {env : List RVal} {atoms : Array Atom} {args : List RVal} + {value : RVal} {profile : SourceProfile} + (henv : ValuesInBounds before env) + (hresolve : resolveAtoms env atoms = .ok args) + (harity : args.length = cur.arity) + (hbody : ProfileFundedCodeRun ctx fuel cur before args.reverse cur.body + after value profile) + (hresult : checkResultWorld cur.result (after, value) = + .ok (after, value)) : + ProfileFundedOpRun ctx (fuel + 1) cur before env (.callSelf atoms) + after value profile := by + obtain ⟨allowance, hbodyCost, hbodyFunded⟩ := hbody + exact ⟨allowance, + OpOwnershipRunCost.callSelf henv hresolve harity hbodyCost hresult, + hbodyFunded⟩ + +theorem ProfileFundedOpRun.apply + {ctx : Ctx} {fuel : Nat} {cur : FnDef} {before after : Store} + {env : List RVal} {functionAtom : Atom} {function value : RVal} + {atoms : Array Atom} {args : List RVal} {profile : SourceProfile} + (henv : ValuesInBounds before env) + (hfunction : resolveAtom env functionAtom = .ok function) + (hargs : resolveAtoms env atoms = .ok args) + (happly : ProfileFundedApplyRun ctx fuel before function args after value + profile) : + ProfileFundedOpRun ctx (fuel + 1) cur before env + (.apply functionAtom atoms) after value profile := by + obtain ⟨allowance, happlyCost, happlyFunded⟩ := happly + exact ⟨allowance, + OpOwnershipRunCost.apply henv hfunction hargs happlyCost, + happlyFunded⟩ + +/-- A direct call is an exact-run emitter prefix when the caller can fund +the particular invocation exposed by the successful operation run. -/ +theorem ProfileFundedEmitRunSound.call + {ctx : Ctx} {cur : FnDef} {address : Ixon.Address} + {atoms : Array Atom} {profile : SourceProfile} + (hinvoke : ∀ {fuel : Nat} {before after : Store} + {env : List RVal} {args : List RVal} {value : RVal}, + AllocationOrderInvariant before → + ValuesInBounds before env → + resolveAtoms env atoms = .ok args → + invoke ctx fuel address args before = .ok (after, value) → + ProfileFundedInvokeRun ctx fuel address args before after value + profile) : + ProfileFundedEmitRunSound ctx cur (emitOp (.call address atoms)) + profile := by + apply ProfileFundedEmitRunSound.ofOp + intro opFuel before after env value horder henv hrun + cases opFuel with + | zero => + simp [runOp] at hrun + | succ fuel => + rw [runOp.eq_def] at hrun + dsimp only at hrun + cases hresolve : resolveAtoms env atoms with + | error err => + rw [hresolve] at hrun + contradiction + | ok args => + rw [hresolve, bindOk] at hrun + exact ProfileFundedOpRun.call henv hresolve + (hinvoke horder henv hresolve hrun) + +/-- A self call is an exact-run emitter prefix. The callback receives the +strictly smaller body run selected by the successful operation. -/ +theorem ProfileFundedEmitRunSound.callSelf + {ctx : Ctx} {cur : FnDef} {atoms : Array Atom} + {profile : SourceProfile} + (hbody : ∀ {fuel : Nat} {before after : Store} + {env args : List RVal} {value : RVal}, + AllocationOrderInvariant before → + ValuesInBounds before env → + resolveAtoms env atoms = .ok args → + args.length = cur.arity → + runCode ctx fuel cur before args.reverse cur.body = + .ok (after, value) → + checkResultWorld cur.result (after, value) = .ok (after, value) → + ProfileFundedCodeRun ctx fuel cur before args.reverse cur.body + after value profile) : + ProfileFundedEmitRunSound ctx cur (emitOp (.callSelf atoms)) + profile := by + apply ProfileFundedEmitRunSound.ofOp + intro opFuel before after env value horder henv hrun + cases opFuel with + | zero => + simp [runOp] at hrun + | succ fuel => + rw [runOp.eq_def] at hrun + dsimp only at hrun + cases hresolve : resolveAtoms env atoms with + | error err => + rw [hresolve] at hrun + contradiction + | ok args => + rw [hresolve, bindOk] at hrun + split at hrun + · contradiction + next hlength => + have harity : args.length = cur.arity := by + simpa using hlength + cases hcode : + runCode ctx fuel cur before args.reverse cur.body with + | error err => + rw [hcode] at hrun + change (.error err : Except Err (Store × RVal)) = + .ok (after, value) at hrun + contradiction + | ok out => + rw [hcode] at hrun + change checkResultWorld cur.result out = + .ok (after, value) at hrun + obtain ⟨hpair, _⟩ := + Ix.Compiler.IxIR1.Sim.checkResultWorld_ok hrun + subst out + exact ProfileFundedOpRun.callSelf henv hresolve harity + (hbody horder henv hresolve harity hcode hrun) hrun + +/-- Higher-order application is an exact-run emitter prefix when the +particular `applyGo` recursion selected at run time is profile-funded. -/ +theorem ProfileFundedEmitRunSound.apply + {ctx : Ctx} {cur : FnDef} {functionAtom : Atom} + {atoms : Array Atom} {profile : SourceProfile} + (happly : ∀ {fuel : Nat} {before after : Store} + {env : List RVal} {function : RVal} {args : List RVal} + {value : RVal}, + AllocationOrderInvariant before → + ValuesInBounds before env → + resolveAtom env functionAtom = .ok function → + resolveAtoms env atoms = .ok args → + applyGo ctx fuel before function args = .ok (after, value) → + ProfileFundedApplyRun ctx fuel before function args after value + profile) : + ProfileFundedEmitRunSound ctx cur + (emitOp (.apply functionAtom atoms)) profile := by + apply ProfileFundedEmitRunSound.ofOp + intro opFuel before after env value horder henv hrun + cases opFuel with + | zero => + simp [runOp] at hrun + | succ fuel => + rw [runOp.eq_def] at hrun + dsimp only at hrun + cases hfunction : resolveAtom env functionAtom with + | error err => + rw [hfunction] at hrun + contradiction + | ok function => + rw [hfunction, bindOk] at hrun + cases hresolve : resolveAtoms env atoms with + | error err => + rw [hresolve] at hrun + contradiction + | ok args => + rw [hresolve, bindOk] at hrun + exact ProfileFundedOpRun.apply henv hfunction hresolve + (happly horder henv hfunction hresolve hrun) + +/-- Constructor/PAP creation fits inside one source-evaluation charge. -/ +theorem allocatedNodeAllowance_le_eval : + OwnershipAllowanceLE ⟨1, 1⟩ evalOwnershipAllowance := by + simp [OwnershipAllowanceLE, evalOwnershipAllowance] + +/-- A target retain exactly consumes one source-retain charge. -/ +theorem dupAllowance_le_retain : + OwnershipAllowanceLE ⟨0, 2⟩ retainOwnershipAllowance := by + simp [OwnershipAllowanceLE, retainOwnershipAllowance] + +/-- A zero-cost entry in the primitive table may be charged to any source +profile fragment. -/ +theorem ProfileFundedEmitOwnershipCostSound.localZero + {ctx : Ctx} {cur : FnDef} {op : Op} {profile : SourceProfile} + (hlocal : localOpOwnershipAllowance op = some ⟨0, 0⟩) : + ProfileFundedEmitOwnershipCostSound ctx cur (emitOp op) profile := + ProfileFundedEmitOwnershipCostSound.of_zero + (EmitOwnershipCostSound.localOp hlocal) + +/-- A primitive classified as one `dup` consumes one source retain +candidate. -/ +theorem ProfileFundedEmitOwnershipCostSound.localRetain + {ctx : Ctx} {cur : FnDef} {op : Op} + (hlocal : localOpOwnershipAllowance op = some ⟨0, 2⟩) : + ProfileFundedEmitOwnershipCostSound ctx cur (emitOp op) + (IxIR0.DynamicCost.retain 1) := by + refine ⟨⟨0, 2⟩, EmitOwnershipCostSound.localOp hlocal, ?_⟩ + rw [sourceProfileOwnershipAllowance_retain] + simp [OwnershipAllowanceLE, retainedOwnershipAllowance] + +/-- Constructor and PAP allocation primitives consume one source event whose +evaluation coordinate is one. -/ +theorem ProfileFundedEmitOwnershipCostSound.localEval + {ctx : Ctx} {cur : FnDef} {op : Op} + (hlocal : localOpOwnershipAllowance op = some ⟨1, 1⟩) + (event : IxIR0.DynamicCost.Event) + (heval : (IxIR0.DynamicCost.tick event).evals = 1) : + ProfileFundedEmitOwnershipCostSound ctx cur (emitOp op) + (IxIR0.DynamicCost.tick event) := by + refine ⟨⟨1, 1⟩, EmitOwnershipCostSound.localOp hlocal, ?_⟩ + rw [sourceProfileOwnershipAllowance_tick_of_evals_eq_one event heval] + exact allocatedNodeAllowance_le_eval + +theorem ProfileFundedEmitRunSound.localZero + {ctx : Ctx} {cur : FnDef} {op : Op} {profile : SourceProfile} + (hlocal : localOpOwnershipAllowance op = some ⟨0, 0⟩) : + ProfileFundedEmitRunSound ctx cur (emitOp op) profile := + ProfileFundedEmitRunSound.localOp hlocal + (zeroOwnershipAllowance_le_profile profile) + +theorem ProfileFundedEmitRunSound.localRetain + {ctx : Ctx} {cur : FnDef} {op : Op} + (hlocal : localOpOwnershipAllowance op = some ⟨0, 2⟩) : + ProfileFundedEmitRunSound ctx cur (emitOp op) + (IxIR0.DynamicCost.retain 1) := by + apply ProfileFundedEmitRunSound.localOp hlocal + rw [sourceProfileOwnershipAllowance_retain] + simp [OwnershipAllowanceLE, retainedOwnershipAllowance] + +theorem ProfileFundedEmitRunSound.localEval + {ctx : Ctx} {cur : FnDef} {op : Op} + (hlocal : localOpOwnershipAllowance op = some ⟨1, 1⟩) + (event : IxIR0.DynamicCost.Event) + (heval : (IxIR0.DynamicCost.tick event).evals = 1) : + ProfileFundedEmitRunSound ctx cur (emitOp op) + (IxIR0.DynamicCost.tick event) := by + apply ProfileFundedEmitRunSound.localOp hlocal + rw [sourceProfileOwnershipAllowance_tick_of_evals_eq_one event heval] + exact allocatedNodeAllowance_le_eval + +/-- A dynamically zero-cost emitter prefix can be assigned to any enclosing +source fragment. -/ +theorem ProfileFundedEmitRunSound.of_zero + {ctx : Ctx} {cur : FnDef} {emit : Emit} {profile : SourceProfile} + (hsound : ProfileFundedEmitRunSound ctx cur emit 0) : + ProfileFundedEmitRunSound ctx cur emit profile := + hsound.monoProfile (zeroOwnershipAllowance_le_profile profile) + +theorem ReleasePlan.profileFundedEmitRunSound + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {drops : List SlotDrop} {emit : Emit} {profile : SourceProfile} + (hplan : ReleasePlan input drops output emit) : + ProfileFundedEmitRunSound ctx cur emit profile := by + apply ProfileFundedEmitRunSound.of_zero + apply ReleasePlan.traverse (hplan := hplan) + · intro Γ + exact ProfileFundedEmitRunSound.id + · intro Γ output index abs drops tailEmit hentry ih + exact ProfileFundedEmitRunSound.of_profile_eq + (ProfileFundedEmitRunSound.comp + (ProfileFundedEmitRunSound.localZero + (profile := 0) + (by simp [localOpOwnershipAllowance])) + ih) + (IxIR0.DynamicCost.Profile.zero_add 0) + · intro Γ output index abs drops tailEmit hentry ih + exact ProfileFundedEmitRunSound.of_profile_eq + (ProfileFundedEmitRunSound.comp + (ProfileFundedEmitRunSound.localZero + (profile := 0) + (by simp [localOpOwnershipAllowance])) + ih) + (IxIR0.DynamicCost.Profile.zero_add 0) +theorem FieldRetainPlan.profileFundedEmitRunSound + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {retains : List RecursorFieldRetain} {emit : Emit} + (hplan : FieldRetainPlan input retains output emit) : + ProfileFundedEmitRunSound ctx cur emit + (IxIR0.DynamicCost.retain retains.length) := by + apply FieldRetainPlan.traverse (hplan := hplan) + · intro Γ + change ProfileFundedEmitRunSound ctx cur (_root_.id : Emit) 0 + exact ProfileFundedEmitRunSound.id + · intro Γ output index placeholderAbs fieldAbs remaining retains tailEmit + hentry ih + apply ProfileFundedEmitRunSound.of_profile_eq + (ProfileFundedEmitRunSound.comp + (ProfileFundedEmitRunSound.localRetain + (by simp [localOpOwnershipAllowance])) + ih) + ext <;> simp [IxIR0.DynamicCost.retain] <;> omega +theorem releaseAll_profileFundedEmitRunSound + (ctx : Ctx) (cur : FnDef) (input : VEnv) (values : List AVal) + (profile : SourceProfile) : + ProfileFundedEmitRunSound ctx cur (releaseAll input values).2 profile := by + apply ProfileFundedEmitRunSound.of_zero + apply releaseAll_traverse + (Result := fun _ _ _ emit => + ProfileFundedEmitRunSound ctx cur emit 0) + · intro Γ + exact ProfileFundedEmitRunSound.id + · intro Γ atom avs output emit ih + exact ih + · intro Γ abs avs output tailEmit ih + exact ProfileFundedEmitRunSound.of_profile_eq + (ProfileFundedEmitRunSound.comp + (ProfileFundedEmitRunSound.localZero + (profile := 0) + (by simp [localOpOwnershipAllowance])) + ih) + (IxIR0.DynamicCost.Profile.zero_add 0) + +theorem lowerCapture_profileFundedEmitRunSound + {ctx : Ctx} {cur : FnDef} {expr : IxIR0.Expr} + {input output : VEnv} {index : Nat} {emit : Emit} {value : AVal} + {state finalState : LowSt} + (hrun : (lowerCapture expr input index).run state = + .ok (output, emit, value) finalState) : + ProfileFundedEmitRunSound ctx cur emit + (IxIR0.DynamicCost.retain 1) := by + cases hentry : input.entries[index]? with + | none => + exact (stateThrowRun_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | some entry => + cases entry with + | recSelf arity => + exact (stateThrowRun_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | slot abs remaining uses held => + cases held with + | false => + exact (stateThrowRun_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | true => + by_cases hunique : worldOfUses uses = .unique + · have huuEq : + (Ixon.Owned.unique == Ixon.Owned.unique) = true := by + decide + exact (stateThrowRun_not_ok (by + simpa [lowerCapture, hentry, hunique, huuEq] + using hrun)).elim + · have huniqueEq : + (worldOfUses uses == Ixon.Owned.unique) = false := by + cases uses <;> simp_all [worldOfUses] <;> decide + by_cases hmore : remaining > countUses index expr + · let next := input.setEntry index + (.slot abs (remaining - countUses index expr) uses true) + have hpure : + (next.bump, + emitOp (.dup (.var (next.rel abs))), + AVal.slotA next.depth) = + (output, emit, value) ∧ state = finalState := by + simpa [lowerCapture, hentry, huniqueEq, hmore, next] + using hrun + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + exact ProfileFundedEmitRunSound.localRetain + (by simp [localOpOwnershipAllowance]) + · by_cases hequal : remaining = countUses index expr + · let next := input.setEntry index + (.slot abs 0 uses false) + have hpure : + (next, (_root_.id : Emit), AVal.slotA abs) = + (output, emit, value) ∧ state = finalState := by + simpa [lowerCapture, hentry, huniqueEq, hmore, + hequal, next] using hrun + obtain ⟨hresult, hstate⟩ := hpure + have hemit : (_root_.id : Emit) = emit := + congrArg + (fun result : VEnv × Emit × AVal => result.2.1) + hresult + subst emit + subst finalState + exact ProfileFundedEmitRunSound.of_zero + ProfileFundedEmitRunSound.id + · exact (stateThrowRun_not_ok (by + simpa [lowerCapture, hentry, huniqueEq, hmore, + hequal] using hrun)).elim + +theorem lowerCaptures_profileFundedEmitRunSound + {ctx : Ctx} {cur : FnDef} (expr : IxIR0.Expr) (captures : List Nat) + {input output : VEnv} {emit : Emit} {values : List AVal} + {state finalState : LowSt} + (hrun : (lowerCaptures expr input captures).run state = + .ok (output, emit, values) finalState) : + ProfileFundedEmitRunSound ctx cur emit + (IxIR0.DynamicCost.retain captures.length) := by + refine lowerCaptures_run_core + (Result := fun _ _ captures emit _ => + ProfileFundedEmitRunSound ctx cur emit + (IxIR0.DynamicCost.retain captures.length)) + (e := expr) (hrun := hrun) ?_ ?_ + · intro input + change ProfileFundedEmitRunSound ctx cur (_root_.id : Emit) 0 + exact ProfileFundedEmitRunSound.id + · intro index rest input middle output headEmit tailEmit headValue + tailValues state middleState hheadRun htail + apply ProfileFundedEmitRunSound.of_profile_eq + (ProfileFundedEmitRunSound.comp + (lowerCapture_profileFundedEmitRunSound hheadRun) + htail) + ext <;> simp [IxIR0.DynamicCost.retain] <;> omega + +/-! The profile clients use the same successful-capture classifier as the +ownership, graph, and progress clients. Keeping the implementation bounded +lets both the exact and target-fuel-bounded public interfaces share the one +retain-versus-move adapter below. -/ +private theorem lowerCapture_run_profile_sound_at + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {expr : IxIR0.Expr} {input output : VEnv} {index : Nat} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {value : AVal} {state finalState : LowSt} + (hsource : sourceEnv[index]? = some sourceValue) + (hrun : (lowerCapture expr input index).run state = + .ok (output, emit, value) finalState) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue .shared emit value + (IxIR0.DynamicCost.retain 1) := by + apply lowerCapture_run_core + (Result := fun output emit value => + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceEnv sourceEnv sourceValue .shared emit value + (IxIR0.DynamicCost.retain 1)) + (hrun := hrun) + · intro abs remaining uses hshared hentry + let next := input.setEntry index + (.slot abs (remaining - countUses index expr) uses true) + have hsound := lower_held_retain_profile_sound_of_funding_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) + (newRemaining := remaining - countUses index expr) + (profile := IxIR0.DynamicCost.retain 1) + hsource hshared hentry (by + rw [sourceProfileOwnershipAllowance_retain] + exact dupAllowance_le_retain) + simpa [next] using hsound + · intro abs remaining uses hshared hentry + let next := input.setEntry index (.slot abs 0 uses false) + have hsound := lower_held_move_profile_sound_of_profile_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) hsource hentry + (IxIR0.DynamicCost.retain 1) + simpa [next, hshared] using hsound + +/-- State-indexed source/profile soundness for one successful closure +capture. A retained capture spends one retain event; a moved final capture +uses the same event as a conservative zero-cost allowance. -/ +theorem lowerCapture_run_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {expr : IxIR0.Expr} {input output : VEnv} {index : Nat} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {value : AVal} {state finalState : LowSt} + (hsource : sourceEnv[index]? = some sourceValue) + (hrun : (lowerCapture expr input index).run state = + .ok (output, emit, value) finalState) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue .shared emit value + (IxIR0.DynamicCost.retain 1) := by + exact LowerResultProfileSound.of_below fun limit => + lowerCapture_run_profile_sound_at (limit := limit) hsource hrun + +private theorem lowerCaptures_run_profile_sound_at + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + (expr : IxIR0.Expr) (captures : List Nat) + {sourceEnv sourceValues : List IxIR0.Value} + {input output : VEnv} {emit : Emit} {values : List AVal} + {state finalState : LowSt} + (hselected : ValuesAt sourceEnv captures sourceValues) + (hrun : (lowerCaptures expr input captures).run state = + .ok (output, emit, values) finalState) : + LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValues + (List.replicate captures.length .shared) emit values + (IxIR0.DynamicCost.retain captures.length) := by + apply ValuesAt.lowerCaptures_core + (e := expr) (hselected := hselected) (hrun := hrun) + · intro input + apply LowerArgsProfileSoundBelow.of_profile_eq + (lowerArgs_nil_profile_sound_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) (Γ := input) + (sourceEnv := sourceEnv)) + ext <;> rfl + · intro index sourceValue rest sourceValues input middle output + headEmit tailEmit headValue tailValues state middleState + hsource hheadRun htail + have hhead := lowerCapture_run_profile_sound_at + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) hsource hheadRun + have hcombined := hhead.consArgs htail + apply LowerArgsProfileSoundBelow.of_profile_eq + (by simpa [List.replicate_succ] using hcombined) + ext <;> simp [IxIR0.DynamicCost.retain] <;> omega + +/-- The full capture traversal is a profiled shared-argument prefix. Its +retain width is exactly the number of statically selected captures. -/ +theorem lowerCaptures_run_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + (expr : IxIR0.Expr) (captures : List Nat) + {sourceEnv sourceValues : List IxIR0.Value} + {input output : VEnv} {emit : Emit} {values : List AVal} + {state finalState : LowSt} + (hselected : ValuesAt sourceEnv captures sourceValues) + (hrun : (lowerCaptures expr input captures).run state = + .ok (output, emit, values) finalState) : + LowerArgsProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValues + (List.replicate captures.length .shared) emit values + (IxIR0.DynamicCost.retain captures.length) := by + exact LowerArgsProfileSound.of_below fun limit => + lowerCaptures_run_profile_sound_at (limit := limit) + expr captures hselected hrun + +/-- Allocate a fresh closure pap after a profiled shared-argument prefix. +The allocation is charged to the lambda-evaluation event. -/ +theorem LowerArgsProfileSound.papp_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput sourceValues : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {avs : List AVal} + {f : Ixon.Address} {d : Decl} {profile : SourceProfile} + (hargs : LowerArgsProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValues + (List.replicate avs.length .shared) emit avs profile) + (hdecl : ctx.decls f = some d) + (hfun : funRel sourceValue f (declArity d) sourceValues) + (hunder : avs.length < declArity d) : + LowerResultProfileSound funRel recSelfRel ctx cur input output.bump + sourceInput sourceOutput sourceValue .shared + (emit ∘ emitOp (.papp f (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) + (profile + IxIR0.DynamicCost.tick .evalLam) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.papp_graph hdecl hfun hunder + profileEmits := ?_ } + intro sourceRest rest slots + apply ProfileFundedEmitStateRunSound.comp + (hargs.profileEmits sourceRest rest slots) + apply ProfileFundedEmitStateRunSound.localOp (allowance := ⟨1, 1⟩) + (papp_graph_op hdecl hfun hunder) + · simp [localOpOwnershipAllowance] + · rw [sourceProfileOwnershipAllowance_tick_of_evals_eq_one .evalLam + (by rfl)] + exact allocatedNodeAllowance_le_eval + +/-- Target-fuel-bounded specialization of PAP allocation to the lambda +evaluation event. -/ +theorem LowerArgsProfileSoundBelow.papp_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} + {sourceInput sourceOutput sourceValues : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {avs : List AVal} + {f : Ixon.Address} {d : Decl} {profile : SourceProfile} + (hargs : LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceValues + (List.replicate avs.length .shared) emit avs profile) + (hdecl : ctx.decls f = some d) + (hfun : funRel sourceValue f (declArity d) sourceValues) + (hunder : avs.length < declArity d) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + output.bump sourceInput sourceOutput sourceValue .shared + (emit ∘ emitOp (.papp f (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) + (profile + IxIR0.DynamicCost.tick .evalLam) := + hargs.papp_graph_of_evals_pos hdecl hfun hunder + (by simp [IxIR0.DynamicCost.tick]) + +/-- State-indexed semantic/profile soundness for local-lambda lowering. The +exact live-capture width funds capture retains and the lambda event funds the +fresh partial-application node. -/ +theorem lowerLam_run_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {value : AVal} {state finalState : LowSt} + (hsourceLength : sourceEnv.length = input.entries.length) + (hprefix : LambdaPrefix sourceEnv expr [] sourceValue) + (hinclude : ∀ source address arity captures, + CompilerLiftedFunctionRel src finalState source address arity captures → + funRel source address arity captures) + (hrepresented : ExtraRepresented ctx finalState) + (hrun : (lowerLam src fuel input expr).run state = + .ok (output, emit, value) finalState) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue .shared emit value + (IxIR0.DynamicCost.retain + ((List.range input.entries.length).filter + (fun index => countUses index expr > 0)).length + + IxIR0.DynamicCost.tick .evalLam) := by + let captures := liftCaptureIndices input.entries.length expr + change LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue .shared emit value + (IxIR0.DynamicCost.retain captures.length + + IxIR0.DynamicCost.tick .evalLam) + apply lowerLam_run_value_core + (ArgsResult := fun selected captureOutput captureEmit captureValues => + LowerArgsProfileSound funRel recSelfRel ctx cur input captureOutput + sourceEnv sourceEnv selected + (List.replicate captureValues.length .shared) + captureEmit captureValues + (IxIR0.DynamicCost.retain captures.length)) + (Result := fun _ output emit value => + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue .shared emit value + (IxIR0.DynamicCost.retain captures.length + + IxIR0.DynamicCost.tick .evalLam)) + (hsourceLength := hsourceLength) (hprefix := hprefix) + (hinclude := hinclude) (hrepresented := hrepresented) (hrun := hrun) + · intro loweredCaptures selected captureOutput captureEmit captureValues + _captureState hcanonical hselected hcaptureRun hlength + have hcaptures := lowerCaptures_run_profile_sound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) expr loweredCaptures + hselected hcaptureRun + have hcapturesLength : loweredCaptures.length = captures.length := by + simpa [captures] using congrArg List.length hcanonical + simpa [hlength, hcapturesLength] using hcaptures + · intro _loweredCaptures _selected _captureOutput _captureEmit + _captureValues _fnAddr _code _bodyState _hcanonical hargs hdecl + hfun hunder + apply hargs.papp_graph hdecl + · simpa only [declArity] using hfun + · simpa only [declArity] using hunder + +/-- Complete state-indexed lambda-expression branch. The source profile +conservatively offers one retain candidate per source-environment entry, +which dominates the compiler's filtered live-capture prefix. -/ +theorem lowerE_lam_run_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Ixon.Owned} + {uses : Ixon.Uses} {body : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} + {emit : Emit} {value : AVal} {state finalState : LowSt} + (hsourceLength : sourceEnv.length = input.entries.length) + (hinclude : ∀ source address arity captures, + CompilerLiftedFunctionRel src finalState source address arity captures → + funRel source address arity captures) + (hrepresented : ExtraRepresented ctx finalState) + (hrun : (lowerE src (fuel + 1) input world + (.lam uses body)).run state = + .ok (output, emit, value) finalState) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv (.clos uses sourceEnv body) world emit value + (IxIR0.DynamicCost.tick .evalLam + + IxIR0.DynamicCost.retain sourceEnv.length) := by + have huuEq : + (Ixon.Owned.unique == Ixon.Owned.unique) = true := by decide + have hsuEq : + (Ixon.Owned.shared == Ixon.Owned.unique) = false := by decide + cases world with + | unique => + exact (stateThrowRun_not_ok (by + simpa [lowerE, huuEq] using hrun)).elim + | shared => + have hlam : + (lowerLam src fuel input (.lam uses body)).run state = + .ok (output, emit, value) finalState := by + simpa [lowerE, hsuEq] using hrun + let captures := (List.range input.entries.length).filter + (fun index => countUses index (.lam uses body) > 0) + have hcapturesLeInput : captures.length ≤ input.entries.length := by + simpa [captures] using List.length_filter_le + (fun index => countUses index (.lam uses body) > 0) + (List.range input.entries.length) + have hcapturesLeSource : captures.length ≤ sourceEnv.length := by + omega + have hlocal := lowerLam_run_profile_sound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) hsourceLength + (LambdaPrefix.nil (sourceEnv := sourceEnv) (uses := uses) + (body := body)) + hinclude hrepresented hlam + have hprofileLe : OwnershipAllowanceLE + (sourceProfileOwnershipAllowance + (IxIR0.DynamicCost.retain captures.length + + IxIR0.DynamicCost.tick .evalLam)) + (sourceProfileOwnershipAllowance + (IxIR0.DynamicCost.tick .evalLam + + IxIR0.DynamicCost.retain sourceEnv.length)) := by + simp [OwnershipAllowanceLE, sourceProfileOwnershipAllowance, + IxIR0.DynamicCost.retain, IxIR0.DynamicCost.tick] + omega + apply LowerResultProfileSound.monoProfile + (by simpa [captures] using hlocal) + exact hprofileLe + +/-- Premise-free profiled lambda semantics at the expression boundary. +A realizable graph input supplies the source/logical environment-length +equality; when it does not, both semantic and profile graph transformers are +vacuous. -/ +theorem lowerE_lam_run_profile_sound_any + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Ixon.Owned} + {uses : Ixon.Uses} {body : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} + {emit : Emit} {value : AVal} {state finalState : LowSt} + (hinclude : ∀ source address arity captures, + CompilerLiftedFunctionRel src finalState source address arity captures → + funRel source address arity captures) + (hrepresented : ExtraRepresented ctx finalState) + (hrun : (lowerE src (fuel + 1) input world + (.lam uses body)).run state = + .ok (output, emit, value) finalState) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv (.clos uses sourceEnv body) world emit value + (IxIR0.DynamicCost.tick .evalLam + + IxIR0.DynamicCost.retain sourceEnv.length) := by + by_cases hlength : sourceEnv.length = input.entries.length + · exact lowerE_lam_run_profile_sound hlength hinclude hrepresented hrun + · refine + { toLowerResultValueSound := + lowerE_lam_run_value_sound_any hinclude hrepresented hrun + profileEmits := ?_ } + intro sourceRest rest slots continuation continuationProfile fuel + before after env result horder henv hpre hcodeRun hcontinuation + obtain ⟨⟨roots, hgraph, _, _⟩, _⟩ := hpre + exact (hlength hgraph.entries.source_length).elim + +/-- Target-fuel-bounded state-indexed source/profile soundness for one successful closure +capture. A retained capture spends one retain event; a moved final capture +uses the same event as a conservative zero-cost allowance. -/ +theorem lowerCapture_run_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {expr : IxIR0.Expr} {input output : VEnv} {index : Nat} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {value : AVal} {state finalState : LowSt} + (hsource : sourceEnv[index]? = some sourceValue) + (hrun : (lowerCapture expr input index).run state = + .ok (output, emit, value) finalState) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue .shared emit value + (IxIR0.DynamicCost.retain 1) := by + exact lowerCapture_run_profile_sound_at hsource hrun + +/-- The target-fuel-bounded full capture traversal is a profiled shared-argument prefix. Its +retain width is exactly the number of statically selected captures. -/ +theorem lowerCaptures_run_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + (expr : IxIR0.Expr) (captures : List Nat) + {sourceEnv sourceValues : List IxIR0.Value} + {input output : VEnv} {emit : Emit} {values : List AVal} + {state finalState : LowSt} + (hselected : ValuesAt sourceEnv captures sourceValues) + (hrun : (lowerCaptures expr input captures).run state = + .ok (output, emit, values) finalState) : + LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValues + (List.replicate captures.length .shared) emit values + (IxIR0.DynamicCost.retain captures.length) := by + exact lowerCaptures_run_profile_sound_at expr captures hselected hrun + +/-- Target-fuel-bounded state-indexed semantic/profile soundness for local-lambda lowering. The +exact live-capture width funds capture retains and the lambda event funds the +fresh partial-application node. -/ +theorem lowerLam_run_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {value : AVal} {state finalState : LowSt} + (hsourceLength : sourceEnv.length = input.entries.length) + (hprefix : LambdaPrefix sourceEnv expr [] sourceValue) + (hinclude : ∀ source address arity captures, + CompilerLiftedFunctionRel src finalState source address arity captures → + funRel source address arity captures) + (hrepresented : ExtraRepresented ctx finalState) + (hrun : (lowerLam src fuel input expr).run state = + .ok (output, emit, value) finalState) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue .shared emit value + (IxIR0.DynamicCost.retain + ((List.range input.entries.length).filter + (fun index => countUses index expr > 0)).length + + IxIR0.DynamicCost.tick .evalLam) := by + let captures := liftCaptureIndices input.entries.length expr + change LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceEnv sourceEnv sourceValue .shared emit value + (IxIR0.DynamicCost.retain captures.length + + IxIR0.DynamicCost.tick .evalLam) + apply lowerLam_run_value_core + (ArgsResult := fun selected captureOutput captureEmit captureValues => + LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit + input captureOutput sourceEnv sourceEnv selected + (List.replicate captureValues.length .shared) + captureEmit captureValues + (IxIR0.DynamicCost.retain captures.length)) + (Result := fun _ output emit value => + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceEnv sourceEnv sourceValue .shared emit value + (IxIR0.DynamicCost.retain captures.length + + IxIR0.DynamicCost.tick .evalLam)) + (hsourceLength := hsourceLength) (hprefix := hprefix) + (hinclude := hinclude) (hrepresented := hrepresented) (hrun := hrun) + · intro loweredCaptures selected captureOutput captureEmit captureValues + _captureState hcanonical hselected hcaptureRun hlength + have hcaptures := lowerCaptures_run_profile_sound_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) expr loweredCaptures + hselected hcaptureRun + have hcapturesLength : loweredCaptures.length = captures.length := by + simpa [captures] using congrArg List.length hcanonical + simpa [hlength, hcapturesLength] using hcaptures + · intro _loweredCaptures _selected _captureOutput _captureEmit + _captureValues _fnAddr _code _bodyState _hcanonical hargs hdecl + hfun hunder + apply hargs.papp_graph hdecl + · simpa only [declArity] using hfun + · simpa only [declArity] using hunder + +/-- Complete target-fuel-bounded state-indexed lambda-expression branch. The source profile +conservatively offers one retain candidate per source-environment entry, +which dominates the compiler's filtered live-capture prefix. -/ +theorem lowerE_lam_run_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Ixon.Owned} + {uses : Ixon.Uses} {body : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} + {emit : Emit} {value : AVal} {state finalState : LowSt} + (hsourceLength : sourceEnv.length = input.entries.length) + (hinclude : ∀ source address arity captures, + CompilerLiftedFunctionRel src finalState source address arity captures → + funRel source address arity captures) + (hrepresented : ExtraRepresented ctx finalState) + (hrun : (lowerE src (fuel + 1) input world + (.lam uses body)).run state = + .ok (output, emit, value) finalState) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv (.clos uses sourceEnv body) world emit value + (IxIR0.DynamicCost.tick .evalLam + + IxIR0.DynamicCost.retain sourceEnv.length) := by + have huuEq : + (Ixon.Owned.unique == Ixon.Owned.unique) = true := by decide + have hsuEq : + (Ixon.Owned.shared == Ixon.Owned.unique) = false := by decide + cases world with + | unique => + exact (stateThrowRun_not_ok (by + simpa [lowerE, huuEq] using hrun)).elim + | shared => + have hlam : + (lowerLam src fuel input (.lam uses body)).run state = + .ok (output, emit, value) finalState := by + simpa [lowerE, hsuEq] using hrun + let captures := (List.range input.entries.length).filter + (fun index => countUses index (.lam uses body) > 0) + have hcapturesLeInput : captures.length ≤ input.entries.length := by + simpa [captures] using List.length_filter_le + (fun index => countUses index (.lam uses body) > 0) + (List.range input.entries.length) + have hcapturesLeSource : captures.length ≤ sourceEnv.length := by + omega + have hlocal := lowerLam_run_profile_sound_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) hsourceLength + (LambdaPrefix.nil (sourceEnv := sourceEnv) (uses := uses) + (body := body)) + hinclude hrepresented hlam + have hprofileLe : OwnershipAllowanceLE + (sourceProfileOwnershipAllowance + (IxIR0.DynamicCost.retain captures.length + + IxIR0.DynamicCost.tick .evalLam)) + (sourceProfileOwnershipAllowance + (IxIR0.DynamicCost.tick .evalLam + + IxIR0.DynamicCost.retain sourceEnv.length)) := by + simp [OwnershipAllowanceLE, sourceProfileOwnershipAllowance, + IxIR0.DynamicCost.retain, IxIR0.DynamicCost.tick] + omega + apply LowerResultProfileSoundBelow.monoProfile + (by simpa [captures] using hlocal) + exact hprofileLe + +/-- Premise-free target-fuel-bounded profiled lambda semantics at the expression boundary. +A realizable graph input supplies the source/logical environment-length +equality; when it does not, both semantic and profile graph transformers are +vacuous. -/ +theorem lowerE_lam_run_profile_sound_any_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Ixon.Owned} + {uses : Ixon.Uses} {body : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} + {emit : Emit} {value : AVal} {state finalState : LowSt} + (hinclude : ∀ source address arity captures, + CompilerLiftedFunctionRel src finalState source address arity captures → + funRel source address arity captures) + (hrepresented : ExtraRepresented ctx finalState) + (hrun : (lowerE src (fuel + 1) input world + (.lam uses body)).run state = + .ok (output, emit, value) finalState) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv (.clos uses sourceEnv body) world emit value + (IxIR0.DynamicCost.tick .evalLam + + IxIR0.DynamicCost.retain sourceEnv.length) := by + by_cases hlength : sourceEnv.length = input.entries.length + · exact lowerE_lam_run_profile_sound_below hlength hinclude hrepresented hrun + · refine + { toLowerResultValueSound := + lowerE_lam_run_value_sound_any hinclude hrepresented hrun + profileEmits := ?_ } + intro sourceRest rest slots bound hbound continuation continuationProfile fuel + before after env result hfuel horder henv hpre hcodeRun hcontinuation + obtain ⟨⟨roots, hgraph, _, _⟩, _⟩ := hpre + exact (hlength hgraph.entries.source_length).elim + +/-- The literal compiler branch emits no ownership operation and is funded +by its exact source evaluation event. -/ +theorem lowerE_lit_profileFundedOwnershipCostSound + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Ixon.Owned} + {literal : IxIR0.Literal} {emit : Emit} {value : AVal} + {state finalState : LowSt} + (hrun : (lowerE src (fuel + 1) input world (.lit literal)).run state = + .ok (output, emit, value) finalState) : + ProfileFundedEmitOwnershipCostSound ctx cur emit + (IxIR0.DynamicCost.tick .evalLit) := by + have hpure : + (input, (_root_.id : Emit), AVal.constA (.lit literal)) = + (output, emit, value) ∧ state = finalState := by + simpa [lowerE] using hrun + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + exact ProfileFundedEmitOwnershipCostSound.of_zero + EmitOwnershipCostSound.id + +/-- Dynamic exact-run counterpart of literal lowering. The compiler emits +no target operation, so the source event can fund the identity prefix in +front of an arbitrarily recursive continuation. -/ +theorem lowerE_lit_profileFundedEmitRunSound + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Ixon.Owned} + {literal : IxIR0.Literal} {emit : Emit} {value : AVal} + {state finalState : LowSt} + (hrun : (lowerE src (fuel + 1) input world (.lit literal)).run state = + .ok (output, emit, value) finalState) : + ProfileFundedEmitRunSound ctx cur emit + (IxIR0.DynamicCost.tick .evalLit) := by + have hpure : + (input, (_root_.id : Emit), AVal.constA (.lit literal)) = + (output, emit, value) ∧ state = finalState := by + simpa [lowerE] using hrun + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + apply ProfileFundedEmitRunSound.of_zero + exact ProfileFundedEmitRunSound.id + +/-- Literal lowering simultaneously preserves the semantic graph and funds +the exact source literal profile at the same state boundary. -/ +theorem lowerE_lit_run_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Ixon.Owned} + {literal : IxIR0.Literal} {emit : Emit} {value : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + (hrun : (lowerE src (fuel + 1) input world (.lit literal)).run state = + .ok (output, emit, value) finalState) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv (.lit literal) world emit value + (IxIR0.DynamicCost.tick .evalLit) := by + have hpure : + (input, (_root_.id : Emit), AVal.constA (.lit literal)) = + (output, emit, value) ∧ state = finalState := by + simpa [lowerE] using hrun + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + apply scalar_id_profile_sound (profile := + IxIR0.DynamicCost.tick .evalLit) .lit + · intro env + rfl + · rfl + · intro store + exact .lit + +/-- The erased compiler branch is the corresponding zero-cost source event. +-/ +theorem lowerE_erased_profileFundedOwnershipCostSound + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Ixon.Owned} + {emit : Emit} {value : AVal} {state finalState : LowSt} + (hrun : (lowerE src (fuel + 1) input world .erased).run state = + .ok (output, emit, value) finalState) : + ProfileFundedEmitOwnershipCostSound ctx cur emit + (IxIR0.DynamicCost.tick .evalErased) := by + have hpure : + (input, (_root_.id : Emit), AVal.constA .erased) = + (output, emit, value) ∧ state = finalState := by + simpa [lowerE] using hrun + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + exact ProfileFundedEmitOwnershipCostSound.of_zero + EmitOwnershipCostSound.id + +/-- Dynamic exact-run counterpart of erased-value lowering. -/ +theorem lowerE_erased_profileFundedEmitRunSound + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Ixon.Owned} + {emit : Emit} {value : AVal} {state finalState : LowSt} + (hrun : (lowerE src (fuel + 1) input world .erased).run state = + .ok (output, emit, value) finalState) : + ProfileFundedEmitRunSound ctx cur emit + (IxIR0.DynamicCost.tick .evalErased) := by + have hpure : + (input, (_root_.id : Emit), AVal.constA .erased) = + (output, emit, value) ∧ state = finalState := by + simpa [lowerE] using hrun + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + apply ProfileFundedEmitRunSound.of_zero + exact ProfileFundedEmitRunSound.id + +/-- Erased-value lowering simultaneously preserves the semantic graph and +funds its exact source event. -/ +theorem lowerE_erased_run_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Ixon.Owned} + {emit : Emit} {value : AVal} {state finalState : LowSt} + {sourceEnv : List IxIR0.Value} + (hrun : (lowerE src (fuel + 1) input world .erased).run state = + .ok (output, emit, value) finalState) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv .erased world emit value + (IxIR0.DynamicCost.tick .evalErased) := by + have hpure : + (input, (_root_.id : Emit), AVal.constA .erased) = + (output, emit, value) ∧ state = finalState := by + simpa [lowerE] using hrun + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + apply scalar_id_profile_sound (profile := + IxIR0.DynamicCost.tick .evalErased) .erased + · intro env + rfl + · rfl + · intro store + exact .erased + +/-- Fuel-bounded literal-expression profile soundness. -/ +theorem lowerE_lit_run_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Ixon.Owned} + {literal : IxIR0.Literal} {emit : Emit} {value : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + (hrun : (lowerE src (fuel + 1) input world (.lit literal)).run state = + .ok (output, emit, value) finalState) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv (.lit literal) world emit value + (IxIR0.DynamicCost.tick .evalLit) := by + have hpure : + (input, (_root_.id : Emit), AVal.constA (.lit literal)) = + (output, emit, value) ∧ state = finalState := by + simpa [lowerE] using hrun + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + apply scalar_id_profile_sound_below (limit := limit) (profile := + IxIR0.DynamicCost.tick .evalLit) .lit + · intro env + rfl + · rfl + · intro store + exact .lit + +/-- Fuel-bounded erased-expression profile soundness. -/ +theorem lowerE_erased_run_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Ixon.Owned} + {emit : Emit} {value : AVal} {state finalState : LowSt} + {sourceEnv : List IxIR0.Value} + (hrun : (lowerE src (fuel + 1) input world .erased).run state = + .ok (output, emit, value) finalState) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv .erased world emit value + (IxIR0.DynamicCost.tick .evalErased) := by + have hpure : + (input, (_root_.id : Emit), AVal.constA .erased) = + (output, emit, value) ∧ state = finalState := by + simpa [lowerE] using hrun + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + apply scalar_id_profile_sound_below (limit := limit) (profile := + IxIR0.DynamicCost.tick .evalErased) .erased + · intro env + rfl + · rfl + · intro store + exact .erased + +/-- Profile-source adapter for `lowerSpine_erased_run_core`. Erased-head +evaluation, erased-result forcing, the canonical head/argument/application +profile sum, and the reduction to erased `applyRest` are recovered once for +ordinary and reachable exact/bounded profile clients. -/ +private theorem lowerSpine_erased_run_profile_core + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Ixon.Owned} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + {Result : IxIR0.Value → SourceProfile → Prop} + (hfinish : ∀ {argumentValues : List IxIR0.Value} + {argumentProfile applyProfile : SourceProfile}, + SourceArgsProfile sourceCtx sourceEnv args argumentValues + argumentProfile → + SourceAppliesProfile sourceCtx .erased argumentValues .erased + applyProfile → + (applyRest src (fuel + 1) input world (_root_.id : Emit) + (.constA .erased) args).run state = + .ok (output, emit, av) finalState → + Result .erased + (IxIR0.DynamicCost.tick .evalErased + argumentProfile + + applyProfile)) + (hsource : SourceSpineProfile sourceCtx sourceEnv .erased args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world .erased args).run + state = .ok (output, emit, av) finalState) : + Result sourceResult profile := by + apply hsource.eliminate + · intro headValue argumentValues headProfile argumentProfile applyProfile + hhead harguments happlies hprofile + obtain ⟨_, hhead⟩ := hhead + cases hhead + have hresult : sourceResult = .erased := + happlies.toSourceApplies.deterministic + (SourceApplies.erased sourceCtx argumentValues) + subst sourceResult + rw [← hprofile] + exact hfinish harguments happlies (lowerSpine_erased_run_core hrun) + +/-- Complete profiled erased-head spine. The literal erased head consumes +its own source event, while strict arguments retain their profiles before +the target discards their owners and returns the erased scalar. -/ +theorem lowerSpine_erased_run_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsProfilePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + {input output : VEnv} {world : Ixon.Owned} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hsource : SourceSpineProfile sourceCtx sourceEnv .erased args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world .erased args).run + state = .ok (output, emit, av) finalState) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av profile := by + exact lowerSpine_erased_run_profile_core + (Result := fun actualResult actualProfile => + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv actualResult world emit av actualProfile) + (hfinish := by + intro argumentValues argumentProfile applyProfile harguments happlies + hrestRun + have hfunction : LowerResultProfileSound funRel recSelfRel ctx cur + input input sourceEnv sourceEnv .erased .shared + (_root_.id : Emit) (.constA .erased) + (IxIR0.DynamicCost.tick .evalErased) := by + apply scalar_id_profile_sound (profile := + IxIR0.DynamicCost.tick .evalErased) .erased + · intro env + rfl + · rfl + · intro store + exact .erased + exact applyRest_erased_run_profile_sound hargs harguments happlies + hfunction hrestRun) + hsource hrun + +/-- Complete fuel-bounded profiled erased-head spine. The literal erased head consumes +its own source event, while strict arguments retain their profiles before +the target discards their owners and returns the erased scalar. -/ +theorem lowerSpine_erased_run_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsProfilePreservesBelow funRel recSelfRel sourceCtx ctx cur limit + src fuel) + {input output : VEnv} {world : Ixon.Owned} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hsource : SourceSpineProfile sourceCtx sourceEnv .erased args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world .erased args).run + state = .ok (output, emit, av) finalState) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult world emit av profile := by + exact lowerSpine_erased_run_profile_core + (Result := fun actualResult actualProfile => + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + output sourceEnv sourceEnv actualResult world emit av actualProfile) + (hfinish := by + intro argumentValues argumentProfile applyProfile harguments happlies + hrestRun + have hfunction : LowerResultProfileSoundBelow funRel recSelfRel ctx cur + limit + input input sourceEnv sourceEnv .erased .shared + (_root_.id : Emit) (.constA .erased) + (IxIR0.DynamicCost.tick .evalErased) := by + apply scalar_id_profile_sound_below (limit := limit) (profile := + IxIR0.DynamicCost.tick .evalErased) .erased + · intro env + rfl + · rfl + · intro store + exact .erased + exact applyRest_erased_run_profile_sound_below hargs harguments + happlies hfunction hrestRun) + hsource hrun + +/-- One complete exact-profile `lowerSpine` step. Every executable head +family is covered, including static declaration dispatch and synthetic +recursive self calls. -/ +theorem lowerSpine_run_profile_sound + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hspine : LowerSpineProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src (fuel + 1)) + (hexpr : LowerEProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hrest : ApplyRestNonErasedProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hrestNext : ApplyRestNonErasedProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx) + (hprofiles : CompilerProfileContracts + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx) + {input output : VEnv} {world : Ixon.Owned} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {emit : Emit} {av : AVal} + (hselfOwnership : ∀ {index arity : Nat}, + input.entries[index]? = some (VEntry.recSelf arity) → + Sim.FnOwnershipContract ctx cur (List.replicate arity .shared)) + (hselfValue : ∀ {index arity : Nat} + {sourceFunction : IxIR0.Value}, + input.entries[index]? = some (VEntry.recSelf arity) → + recSelfRel sourceFunction arity → + FnValueContract + (CompilerFunctionRel sourceCtx src relationState) sourceCtx ctx cur + (List.replicate arity .shared) sourceFunction) + (hselfCost : ∀ {index arity : Nat} + {sourceFunction : IxIR0.Value}, + input.entries[index]? = some (VEntry.recSelf arity) → + recSelfRel sourceFunction arity → + ∃ sourceAddress, + FnProfileContract (CompilerFunctionRel sourceCtx src relationState) + sourceCtx ctx sourceAddress cur + (List.replicate arity .shared) sourceFunction) + (hselfPositive : ∀ {index arity : Nat}, + input.entries[index]? = some (VEntry.recSelf arity) → 0 < arity) + (hselfResult : ∀ {index arity : Nat}, + input.entries[index]? = some (VEntry.recSelf arity) → + cur.result = .shared) + (hargsNonempty : args ≠ []) + (hsource : SourceSpineProfile sourceCtx sourceEnv head args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world head args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState relationState) + (hrepresented : ExtraRepresented ctx relationState) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult world emit av + profile := by + exact lowerSpine_run_core + (Result := fun actualHead => + SourceSpineProfile sourceCtx sourceEnv actualHead args sourceResult + profile → + (lowerSpine src (fuel + 2) input world actualHead args).run state = + .ok (output, emit, av) finalState → + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel ctx cur + input output sourceEnv sourceEnv sourceResult world emit av profile) + (happ := by + intro _ _ hsource hrun + exact lowerSpine_app_run_profile_sound hspine hsource hrun) + (herased := by + intro hsource hrun + exact lowerSpine_erased_run_profile_sound hargs hsource hrun) + (hvar := by + intro _ hnotSelf hsource hrun + exact lowerSpine_var_dynamic_run_profile_sound hexpr hreflect hargs + hrestNext hnotSelf hargsNonempty hsource hrun) + (hrecSelf := by + intro _ _ hentry hsource hrun + exact lowerSpine_recSelf_run_profile_sound hargs hrest hentry + (hselfOwnership hentry) (fun hrel => hselfValue hentry hrel) + (fun hrel => hselfCost hentry hrel) (hselfPositive hentry) + (hselfResult hentry) hsource hrun) + (href := by + intro _ hsource hrun + exact lowerSpine_ref_run_profile_sound henv hargs hrest hknownExtra + hcontracts hvalues hprofiles hsource hrun hextends hrepresented) + (hdynamic := by + intro _ hshape hsource hrun + exact lowerSpine_dynamic_run_profile_sound hexpr hreflect hargs + hrestNext hshape hargsNonempty hsource hrun) + hsource hrun + +/-- One complete target-fuel-bounded exact-profile `lowerSpine` step. Every executable head +family is covered, including static declaration dispatch and synthetic +recursive self calls. -/ +theorem lowerSpine_run_profile_sound_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hspine : LowerSpineProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src (fuel + 1)) + (hexpr : LowerEProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src fuel) + (hrest : ApplyRestNonErasedProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src fuel) + (hrestNext : ApplyRestNonErasedProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx) + (hprofiles : CompilerProfileContractsBelow + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx limit) + {input output : VEnv} {world : Ixon.Owned} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {emit : Emit} {av : AVal} + (hselfOwnership : ∀ {index arity : Nat}, + input.entries[index]? = some (VEntry.recSelf arity) → + Sim.FnOwnershipContract ctx cur (List.replicate arity .shared)) + (hselfValue : ∀ {index arity : Nat} + {sourceFunction : IxIR0.Value}, + input.entries[index]? = some (VEntry.recSelf arity) → + recSelfRel sourceFunction arity → + FnValueContract + (CompilerFunctionRel sourceCtx src relationState) sourceCtx ctx cur + (List.replicate arity .shared) sourceFunction) + (hselfCost : ∀ {index arity : Nat} + {sourceFunction : IxIR0.Value}, + input.entries[index]? = some (VEntry.recSelf arity) → + recSelfRel sourceFunction arity → + ∃ sourceAddress, + FnProfileContractBelow + (CompilerFunctionRel sourceCtx src relationState) sourceCtx ctx + sourceAddress cur + (List.replicate arity .shared) sourceFunction limit) + (hselfPositive : ∀ {index arity : Nat}, + input.entries[index]? = some (VEntry.recSelf arity) → 0 < arity) + (hselfResult : ∀ {index arity : Nat}, + input.entries[index]? = some (VEntry.recSelf arity) → + cur.result = .shared) + (hargsNonempty : args ≠ []) + (hsource : SourceSpineProfile sourceCtx sourceEnv head args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world head args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState relationState) + (hrepresented : ExtraRepresented ctx relationState) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur limit input output sourceEnv sourceEnv sourceResult world emit av + profile := by + exact lowerSpine_run_core + (Result := fun actualHead => + SourceSpineProfile sourceCtx sourceEnv actualHead args sourceResult + profile → + (lowerSpine src (fuel + 2) input world actualHead args).run state = + .ok (output, emit, av) finalState → + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel ctx cur + limit input output sourceEnv sourceEnv sourceResult world emit av + profile) + (happ := by + intro _ _ hsource hrun + exact lowerSpine_app_run_profile_sound_below hspine hsource hrun) + (herased := by + intro hsource hrun + exact lowerSpine_erased_run_profile_sound_below hargs hsource hrun) + (hvar := by + intro _ hnotSelf hsource hrun + exact lowerSpine_var_dynamic_run_profile_sound_below hexpr hreflect + hargs hrestNext hnotSelf hargsNonempty hsource hrun) + (hrecSelf := by + intro _ _ hentry hsource hrun + exact lowerSpine_recSelf_run_profile_sound_below hargs hrest hentry + (hselfOwnership hentry) (fun hrel => hselfValue hentry hrel) + (fun hrel => hselfCost hentry hrel) (hselfPositive hentry) + (hselfResult hentry) hsource hrun) + (href := by + intro _ hsource hrun + exact lowerSpine_ref_run_profile_sound_below henv hargs hrest + hknownExtra hcontracts hvalues hprofiles hsource hrun hextends + hrepresented) + (hdynamic := by + intro _ hshape hsource hrun + exact lowerSpine_dynamic_run_profile_sound_below hexpr hreflect hargs + hrestNext hshape hargsNonempty hsource hrun) + hsource hrun + +/-- The repeated-variable target `dup` is paid by the retain coordinate of +the exact source variable profile; its evaluation coordinate remains +available to the enclosing compiler induction. -/ +theorem ProfileFundedEmitOwnershipCostSound.varDup + {ctx : Ctx} {cur : FnDef} (atom : Atom) : + ProfileFundedEmitOwnershipCostSound ctx cur (emitOp (.dup atom)) + (IxIR0.DynamicCost.tick .evalVar + IxIR0.DynamicCost.retain 1) := by + refine ⟨⟨0, 2⟩, EmitOwnershipCostSound.localOp (by + simp [localOpOwnershipAllowance]), ?_⟩ + rw [sourceProfileOwnershipAllowance_add, + sourceProfileOwnershipAllowance_tick_of_evals_eq_one .evalVar (by rfl), + sourceProfileOwnershipAllowance_retain] + simp [OwnershipAllowanceLE, evalOwnershipAllowance, + retainedOwnershipAllowance, OwnershipAllowance.add] + +/-- Dynamic exact-run variable duplication rule. -/ +theorem ProfileFundedEmitRunSound.varDup + {ctx : Ctx} {cur : FnDef} (atom : Atom) : + ProfileFundedEmitRunSound ctx cur (emitOp (.dup atom)) + (IxIR0.DynamicCost.tick .evalVar + IxIR0.DynamicCost.retain 1) := by + exact ProfileFundedEmitRunSound.monoProfile + (ProfileFundedEmitRunSound.localRetain + (by simp [localOpOwnershipAllowance])) + (by + rw [sourceProfileOwnershipAllowance_add, + sourceProfileOwnershipAllowance_tick_of_evals_eq_one .evalVar + (by rfl), + sourceProfileOwnershipAllowance_retain] + simp [OwnershipAllowanceLE, evalOwnershipAllowance, + retainedOwnershipAllowance, OwnershipAllowance.add]) + +/-- Every successful variable-lowering branch is funded by the exact source +variable profile. Final use moves for free; repeated shared use emits the +single `dup` certified above. -/ +theorem lowerE_var_profileFundedOwnershipCostSound + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Ixon.Owned} {index : Nat} + {emit : Emit} {value : AVal} {state finalState : LowSt} + (hrun : (lowerE src (fuel + 1) input world (.var index)).run state = + .ok (output, emit, value) finalState) : + ProfileFundedEmitOwnershipCostSound ctx cur emit + (IxIR0.DynamicCost.tick .evalVar + IxIR0.DynamicCost.retain 1) := by + have hssNe : + (Ixon.Owned.shared != Ixon.Owned.shared) = false := by decide + have huuNe : + (Ixon.Owned.unique != Ixon.Owned.unique) = false := by decide + have hsuNe : + (Ixon.Owned.shared != Ixon.Owned.unique) = true := by decide + have husNe : + (Ixon.Owned.unique != Ixon.Owned.shared) = true := by decide + have hsuEq : + (Ixon.Owned.shared == Ixon.Owned.unique) = false := by decide + have huuEq : + (Ixon.Owned.unique == Ixon.Owned.unique) = true := by decide + cases hentry : input.entries[index]? with + | none => + exact (stateThrowRun_not_ok (by + simpa [lowerE, hentry] using hrun)).elim + | some entry => + cases entry with + | recSelf arity => + exact (stateThrowRun_not_ok (by + simpa [lowerE, hentry] using hrun)).elim + | slot abs remaining uses held => + cases held with + | false => + exact (stateThrowRun_not_ok (by + simpa [lowerE, hentry] using hrun)).elim + | true => + by_cases hworld : worldOfUses uses = world + · subst world + have hsame : + (worldOfUses uses != worldOfUses uses) = false := by + cases uses <;> decide + cases remaining with + | zero => + exact (stateThrowRun_not_ok (by + simpa [lowerE, hentry, hsame] using hrun)).elim + | succ remaining => + cases remaining with + | zero => + have hpure : + (input.setEntry index + (.slot abs 0 uses false), + (_root_.id : Emit), AVal.slotA abs) = + (output, emit, value) ∧ + state = finalState := by + simpa [lowerE, hentry, hsame] using hrun + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + exact + ProfileFundedEmitOwnershipCostSound.of_zero + EmitOwnershipCostSound.id + | succ remaining => + cases uses with + | erased => + have heq : + (Ixon.Owned.shared == + Ixon.Owned.unique) = false := by + decide + let next := input.setEntry index + (.slot abs (Nat.succ remaining) .erased true) + have hpure : + (next.bump, + emitOp (.dup (.var (next.rel abs))), + AVal.slotA next.depth) = + (output, emit, value) ∧ + state = finalState := by + simpa [lowerE, hentry, worldOfUses, hsame, + heq, hssNe, huuNe, hsuNe, husNe, hsuEq, + huuEq, next] using hrun + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + exact + ProfileFundedEmitOwnershipCostSound.varDup _ + | linear => + have heq : + (Ixon.Owned.unique == + Ixon.Owned.unique) = true := by + decide + exact (stateThrowRun_not_ok (by + simpa [lowerE, hentry, worldOfUses, hsame, + heq, hssNe, huuNe, hsuNe, husNe, hsuEq, + huuEq] using hrun)).elim + | affine => + have heq : + (Ixon.Owned.unique == + Ixon.Owned.unique) = true := by + decide + exact (stateThrowRun_not_ok (by + simpa [lowerE, hentry, worldOfUses, hsame, + heq, hssNe, huuNe, hsuNe, husNe, hsuEq, + huuEq] using hrun)).elim + | many => + have heq : + (Ixon.Owned.shared == + Ixon.Owned.unique) = false := by + decide + let next := input.setEntry index + (.slot abs (Nat.succ remaining) .many true) + have hpure : + (next.bump, + emitOp (.dup (.var (next.rel abs))), + AVal.slotA next.depth) = + (output, emit, value) ∧ + state = finalState := by + simpa [lowerE, hentry, worldOfUses, hsame, + heq, hssNe, huuNe, hsuNe, husNe, hsuEq, + huuEq, next] using hrun + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + exact + ProfileFundedEmitOwnershipCostSound.varDup _ + · have hdiff : (worldOfUses uses != world) = true := by + cases uses <;> cases world <;> + simp_all [worldOfUses] <;> decide + cases uses <;> cases world + all_goals + try { exact (hworld (by rfl)).elim } + all_goals + exact (stateThrowRun_not_ok (by + simpa [lowerE, hentry, worldOfUses, hdiff, hssNe, + huuNe, hsuNe, husNe, hsuEq, huuEq] using hrun)).elim + +/-- Dynamic exact-run counterpart of variable lowering. Moving a final +use leaves the continuation untouched; a repeated shared use executes the +single certified `dup` before that exact continuation. -/ +theorem lowerE_var_profileFundedEmitRunSound + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Ixon.Owned} {index : Nat} + {emit : Emit} {value : AVal} {state finalState : LowSt} + (hrun : (lowerE src (fuel + 1) input world (.var index)).run state = + .ok (output, emit, value) finalState) : + ProfileFundedEmitRunSound ctx cur emit + (IxIR0.DynamicCost.tick .evalVar + IxIR0.DynamicCost.retain 1) := by + intro continuation continuationProfile runFuel before after runtimeEnv + result horder hbounds hcodeRun hcontinuation + have hssNe : + (Ixon.Owned.shared != Ixon.Owned.shared) = false := by decide + have huuNe : + (Ixon.Owned.unique != Ixon.Owned.unique) = false := by decide + have hsuNe : + (Ixon.Owned.shared != Ixon.Owned.unique) = true := by decide + have husNe : + (Ixon.Owned.unique != Ixon.Owned.shared) = true := by decide + have hsuEq : + (Ixon.Owned.shared == Ixon.Owned.unique) = false := by decide + have huuEq : + (Ixon.Owned.unique == Ixon.Owned.unique) = true := by decide + cases hentry : input.entries[index]? with + | none => + exact (stateThrowRun_not_ok (by + simpa [lowerE, hentry] using hrun)).elim + | some entry => + cases entry with + | recSelf arity => + exact (stateThrowRun_not_ok (by + simpa [lowerE, hentry] using hrun)).elim + | slot abs remaining uses held => + cases held with + | false => + exact (stateThrowRun_not_ok (by + simpa [lowerE, hentry] using hrun)).elim + | true => + by_cases hworld : worldOfUses uses = world + · subst world + have hsame : + (worldOfUses uses != worldOfUses uses) = false := by + cases uses <;> decide + cases remaining with + | zero => + exact (stateThrowRun_not_ok (by + simpa [lowerE, hentry, hsame] using hrun)).elim + | succ remaining => + cases remaining with + | zero => + have hpure : + (input.setEntry index + (.slot abs 0 uses false), + (_root_.id : Emit), AVal.slotA abs) = + (output, emit, value) ∧ + state = finalState := by + simpa [lowerE, hentry, hsame] using hrun + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + have hid : ProfileFundedEmitRunSound ctx cur + (_root_.id : Emit) + (IxIR0.DynamicCost.tick .evalVar + + IxIR0.DynamicCost.retain 1) := by + apply ProfileFundedEmitRunSound.of_zero + exact ProfileFundedEmitRunSound.id + exact hid horder hbounds hcodeRun hcontinuation + | succ remaining => + cases uses with + | erased => + have heq : + (Ixon.Owned.shared == + Ixon.Owned.unique) = false := by + decide + let next := input.setEntry index + (.slot abs (Nat.succ remaining) .erased true) + have hpure : + (next.bump, + emitOp (.dup (.var (next.rel abs))), + AVal.slotA next.depth) = + (output, emit, value) ∧ + state = finalState := by + simpa [lowerE, hentry, worldOfUses, hsame, + heq, hssNe, huuNe, hsuNe, husNe, hsuEq, + huuEq, next] using hrun + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + exact (ProfileFundedEmitRunSound.varDup _) + horder hbounds hcodeRun hcontinuation + | linear => + have heq : + (Ixon.Owned.unique == + Ixon.Owned.unique) = true := by + decide + exact (stateThrowRun_not_ok (by + simpa [lowerE, hentry, worldOfUses, hsame, + heq, hssNe, huuNe, hsuNe, husNe, hsuEq, + huuEq] using hrun)).elim + | affine => + have heq : + (Ixon.Owned.unique == + Ixon.Owned.unique) = true := by + decide + exact (stateThrowRun_not_ok (by + simpa [lowerE, hentry, worldOfUses, hsame, + heq, hssNe, huuNe, hsuNe, husNe, hsuEq, + huuEq] using hrun)).elim + | many => + have heq : + (Ixon.Owned.shared == + Ixon.Owned.unique) = false := by + decide + let next := input.setEntry index + (.slot abs (Nat.succ remaining) .many true) + have hpure : + (next.bump, + emitOp (.dup (.var (next.rel abs))), + AVal.slotA next.depth) = + (output, emit, value) ∧ + state = finalState := by + simpa [lowerE, hentry, worldOfUses, hsame, + heq, hssNe, huuNe, hsuNe, husNe, hsuEq, + huuEq, next] using hrun + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + exact (ProfileFundedEmitRunSound.varDup _) + horder hbounds hcodeRun hcontinuation + · have hdiff : (worldOfUses uses != world) = true := by + cases uses <;> cases world <;> + simp_all [worldOfUses] <;> decide + cases uses <;> cases world + all_goals + try { exact (hworld (by rfl)).elim } + all_goals + exact (stateThrowRun_not_ok (by + simpa [lowerE, hentry, worldOfUses, hdiff, hssNe, + huuNe, hsuNe, husNe, hsuEq, huuEq] using hrun)).elim + +/-- Complete semantic/profile variable branch. The source lookup restricts +the target state to the matching value graph, while the compiler run decides +between a zero-cost move and the single funded shared retain. -/ +theorem lowerE_var_run_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Ixon.Owned} {index : Nat} + {emit : Emit} {value : AVal} {state finalState : LowSt} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + (hsource : sourceEnv[index]? = some sourceValue) + (hrun : (lowerE src (fuel + 1) input world (.var index)).run state = + .ok (output, emit, value) finalState) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue world emit value + (IxIR0.DynamicCost.tick .evalVar + + IxIR0.DynamicCost.retain 1) := by + exact lowerE_var_run_sound_core + (Result := fun resultWorld resultOutput resultEmit resultValue _ => + LowerResultProfileSound funRel recSelfRel ctx cur input resultOutput + sourceEnv sourceEnv sourceValue resultWorld resultEmit resultValue + (IxIR0.DynamicCost.tick .evalVar + + IxIR0.DynamicCost.retain 1)) + (hmove := fun hentry => + lower_var_move_profile_sound hsource hentry) + (hdup := fun hworld hentry => + lower_held_retain_profile_sound hsource hworld hentry) + hrun + +/-- Complete semantic/profile variable-borrow branch. Both final-use owner +transfer and repeated borrowing emit the identity prefix, while retaining +the exact source variable profile for enclosing projection composition. -/ +theorem lowerBorrow_var_run_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {index : Nat} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {av : AVal} {release : Bool} + {state finalState : LowSt} + (hsource : sourceEnv[index]? = some sourceValue) + (hrun : (lowerBorrow src (fuel + 1) input (.var index)).run state = + .ok (output, emit, av, release) finalState) : + LowerBorrowProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue emit av release + (IxIR0.DynamicCost.tick .evalVar + + IxIR0.DynamicCost.retain 1) := by + exact lowerBorrow_var_run_sound_core + (Result := fun resultOutput resultEmit resultAv resultRelease _ => + LowerBorrowProfileSound funRel recSelfRel ctx cur input resultOutput + sourceEnv sourceEnv sourceValue resultEmit resultAv resultRelease + (IxIR0.DynamicCost.tick .evalVar + + IxIR0.DynamicCost.retain 1)) + (hmove := fun hworld hentry => + lower_var_shared_move_borrow_profile_sound + hsource hworld hentry) + (hrepeated := fun hworld hentry => + lower_var_shared_borrow_profile_sound hsource hworld hentry) + hrun + +/-- Non-variable borrowing delegates to the ordinary shared-expression +profile proof and changes only the pending-owner classification selected by +the returned descriptor. -/ +theorem lowerBorrow_dynamic_run_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {expr : IxIR0.Expr} + {emit : Emit} {av : AVal} {release : Bool} + {state finalState : LowSt} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {profile : SourceProfile} + (hexpr : ∀ {exprOutput : VEnv} {exprEmit : Emit} {exprAv : AVal} + {exprState : LowSt}, + (lowerE src fuel input .shared expr).run state = + .ok (exprOutput, exprEmit, exprAv) exprState → + LowerResultProfileSound funRel recSelfRel ctx cur input exprOutput + sourceEnv sourceEnv sourceValue .shared exprEmit exprAv profile) + (hshape : DynamicBorrowHead expr) + (hrun : (lowerBorrow src (fuel + 1) input expr).run state = + .ok (output, emit, av, release) finalState) : + LowerBorrowProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue emit av release profile := by + exact lowerBorrow_dynamic_run_core + (ExprResult := fun exprOutput exprEmit exprAv _ => + LowerResultProfileSound funRel recSelfRel ctx cur input exprOutput + sourceEnv sourceEnv sourceValue .shared exprEmit exprAv profile) + (BorrowResult := fun borrowOutput borrowEmit borrowAv borrowRelease _ => + LowerBorrowProfileSound funRel recSelfRel ctx cur input borrowOutput + sourceEnv sourceEnv sourceValue borrowEmit borrowAv borrowRelease + profile) + (hexpr := fun hsubrun => hexpr hsubrun) + (hslot := fun hsound => hsound.asBorrowSlot) + (hconst := fun hsound => hsound.asBorrowConst) + hshape hrun + +/-- One complete borrowing-position compiler step. A costed source trace +supplies the variable lookup/profile directly; every other syntax form uses +the ordinary shared-expression recursive proof at predecessor compiler fuel. +-/ +theorem lowerBorrow_run_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel sourceFuel : Nat} + {input output : VEnv} {expr : IxIR0.Expr} + {emit : Emit} {av : AVal} {release : Bool} + {state finalState : LowSt} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {profile : SourceProfile} + (hsource : IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv expr + sourceValue profile) + (hexpr : ∀ {exprOutput : VEnv} {exprEmit : Emit} {exprAv : AVal} + {exprState : LowSt}, + (lowerE src fuel input .shared expr).run state = + .ok (exprOutput, exprEmit, exprAv) exprState → + LowerResultProfileSound funRel recSelfRel ctx cur input exprOutput + sourceEnv sourceEnv sourceValue .shared exprEmit exprAv profile) + (hrun : (lowerBorrow src (fuel + 1) input expr).run state = + .ok (output, emit, av, release) finalState) : + LowerBorrowProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue emit av release profile := by + cases expr with + | var index => + cases hsource with + | var hlookup => + exact lowerBorrow_var_run_profile_sound hlookup hrun + | ref address => + exact lowerBorrow_dynamic_run_profile_sound hexpr (.ref address) hrun + | app function argument => + exact lowerBorrow_dynamic_run_profile_sound hexpr + (.app function argument) hrun + | lam uses body => + exact lowerBorrow_dynamic_run_profile_sound hexpr (.lam uses body) hrun + | letE uses value body => + exact lowerBorrow_dynamic_run_profile_sound hexpr + (.letE uses value body) hrun + | proj index value => + exact lowerBorrow_dynamic_run_profile_sound hexpr + (.proj index value) hrun + | lit literal => + exact lowerBorrow_dynamic_run_profile_sound hexpr (.lit literal) hrun + | erased => + exact lowerBorrow_dynamic_run_profile_sound hexpr .erased hrun + +/-- Target-fuel-bounded complete semantic/profile variable branch. The +source lookup restricts the target state to the matching value graph, while +the compiler run decides between a zero-cost move and the single funded +shared retain. -/ +theorem lowerE_var_run_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Ixon.Owned} {index : Nat} + {emit : Emit} {value : AVal} {state finalState : LowSt} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + (hsource : sourceEnv[index]? = some sourceValue) + (hrun : (lowerE src (fuel + 1) input world (.var index)).run state = + .ok (output, emit, value) finalState) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue world emit value + (IxIR0.DynamicCost.tick .evalVar + + IxIR0.DynamicCost.retain 1) := by + exact lowerE_var_run_sound_core + (Result := fun resultWorld resultOutput resultEmit resultValue _ => + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + resultOutput sourceEnv sourceEnv sourceValue resultWorld resultEmit + resultValue (IxIR0.DynamicCost.tick .evalVar + + IxIR0.DynamicCost.retain 1)) + (hmove := fun hentry => + lower_var_move_profile_sound_below hsource hentry) + (hdup := fun hworld hentry => + lower_held_retain_profile_sound_below hsource hworld hentry) + hrun + +/-- Target-fuel-bounded complete semantic/profile variable-borrow branch. +Both final-use owner transfer and repeated borrowing emit the identity prefix, +while retaining the exact source variable profile for enclosing projection +composition. -/ +theorem lowerBorrow_var_run_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {index : Nat} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {av : AVal} {release : Bool} + {state finalState : LowSt} + (hsource : sourceEnv[index]? = some sourceValue) + (hrun : (lowerBorrow src (fuel + 1) input (.var index)).run state = + .ok (output, emit, av, release) finalState) : + LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue emit av release + (IxIR0.DynamicCost.tick .evalVar + + IxIR0.DynamicCost.retain 1) := by + exact lowerBorrow_var_run_sound_core + (Result := fun resultOutput resultEmit resultAv resultRelease _ => + LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit input + resultOutput sourceEnv sourceEnv sourceValue resultEmit resultAv + resultRelease (IxIR0.DynamicCost.tick .evalVar + + IxIR0.DynamicCost.retain 1)) + (hmove := fun hworld hentry => + lower_var_shared_move_borrow_profile_sound_below + hsource hworld hentry) + (hrepeated := fun hworld hentry => + lower_var_shared_borrow_profile_sound_below + hsource hworld hentry) + hrun + +/-- Target-fuel-bounded non-variable borrowing delegates to the ordinary shared-expression +profile proof and changes only the pending-owner classification selected by +the returned descriptor. -/ +theorem lowerBorrow_dynamic_run_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {expr : IxIR0.Expr} + {emit : Emit} {av : AVal} {release : Bool} + {state finalState : LowSt} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {profile : SourceProfile} + (hexpr : ∀ {exprOutput : VEnv} {exprEmit : Emit} {exprAv : AVal} + {exprState : LowSt}, + (lowerE src fuel input .shared expr).run state = + .ok (exprOutput, exprEmit, exprAv) exprState → + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input exprOutput + sourceEnv sourceEnv sourceValue .shared exprEmit exprAv profile) + (hshape : DynamicBorrowHead expr) + (hrun : (lowerBorrow src (fuel + 1) input expr).run state = + .ok (output, emit, av, release) finalState) : + LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue emit av release profile := by + exact lowerBorrow_dynamic_run_core + (ExprResult := fun exprOutput exprEmit exprAv _ => + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + exprOutput sourceEnv sourceEnv sourceValue .shared exprEmit exprAv + profile) + (BorrowResult := fun borrowOutput borrowEmit borrowAv borrowRelease _ => + LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit input + borrowOutput sourceEnv sourceEnv sourceValue borrowEmit borrowAv + borrowRelease profile) + (hexpr := fun hsubrun => hexpr hsubrun) + (hslot := fun hsound => hsound.asBorrowSlot) + (hconst := fun hsound => hsound.asBorrowConst) + hshape hrun + +/-- One target-fuel-bounded complete borrowing-position compiler step. A costed source trace +supplies the variable lookup/profile directly; every other syntax form uses +the ordinary shared-expression recursive proof at predecessor compiler fuel. +-/ +theorem lowerBorrow_run_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel sourceFuel : Nat} + {input output : VEnv} {expr : IxIR0.Expr} + {emit : Emit} {av : AVal} {release : Bool} + {state finalState : LowSt} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {profile : SourceProfile} + (hsource : IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv expr + sourceValue profile) + (hexpr : ∀ {exprOutput : VEnv} {exprEmit : Emit} {exprAv : AVal} + {exprState : LowSt}, + (lowerE src fuel input .shared expr).run state = + .ok (exprOutput, exprEmit, exprAv) exprState → + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input exprOutput + sourceEnv sourceEnv sourceValue .shared exprEmit exprAv profile) + (hrun : (lowerBorrow src (fuel + 1) input expr).run state = + .ok (output, emit, av, release) finalState) : + LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue emit av release profile := by + cases expr with + | var index => + cases hsource with + | var hlookup => + exact lowerBorrow_var_run_profile_sound_below hlookup hrun + | ref address => + exact lowerBorrow_dynamic_run_profile_sound_below hexpr (.ref address) hrun + | app function argument => + exact lowerBorrow_dynamic_run_profile_sound_below hexpr + (.app function argument) hrun + | lam uses body => + exact lowerBorrow_dynamic_run_profile_sound_below hexpr (.lam uses body) hrun + | letE uses value body => + exact lowerBorrow_dynamic_run_profile_sound_below hexpr + (.letE uses value body) hrun + | proj index value => + exact lowerBorrow_dynamic_run_profile_sound_below hexpr + (.proj index value) hrun + | lit literal => + exact lowerBorrow_dynamic_run_profile_sound_below hexpr (.lit literal) hrun + | erased => + exact lowerBorrow_dynamic_run_profile_sound_below hexpr .erased hrun + +/-- Complete semantic/profile let branch. The recursive hypotheses fund the +bound expression and body at their exact source profiles; binder installation +is selected from the compiler result descriptor and charged to `evalLet`. -/ +theorem lowerE_let_run_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Ixon.Owned} {uses : Ixon.Uses} + {value body : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + {boundSource sourceValue : IxIR0.Value} + {valueProfile bodyProfile : SourceProfile} + (hrecursive : ∀ {middle bodyInput bodyOutput : VEnv} + {valueEmit bodyEmit : Emit} {boundValue resultValue : AVal} + {valueState bodyState bodyFinal : LowSt}, + (lowerE src fuel input (worldOfUses uses) value).run state = + .ok (middle, valueEmit, boundValue) valueState → + (lowerE src fuel bodyInput world body).run bodyState = + .ok (bodyOutput, bodyEmit, resultValue) bodyFinal → + bodyState = valueState → + ExtraExtends bodyFinal finalState → + (NoRecSelf middle → NoRecSelf bodyInput) → + LowerResultProfileSound funRel recSelfRel ctx cur input middle + sourceEnv sourceEnv boundSource (worldOfUses uses) + valueEmit boundValue valueProfile ∧ + LowerResultProfileSound funRel recSelfRel ctx cur + bodyInput bodyOutput (boundSource :: sourceEnv) + (boundSource :: sourceEnv) sourceValue world + bodyEmit resultValue bodyProfile) + (hreleases : LowerEReleasesTrackedFirst src fuel body) + (hrun : (lowerE src (fuel + 1) input world + (.letE uses value body)).run state = + .ok (output, emit, av) finalState) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue world emit av + (valueProfile + bodyProfile + IxIR0.DynamicCost.tick .evalLet) := by + exact (lowerE_let_run_sound_core + (Result := fun branchOutput branchEmit branchValue branchState => + ExtraExtends branchState finalState → + LowerResultProfileSound funRel recSelfRel ctx cur input branchOutput + sourceEnv sourceEnv sourceValue world branchEmit branchValue + (valueProfile + bodyProfile + + IxIR0.DynamicCost.tick .evalLet)) + (hslotAffine := by + intro middle valueEmit abs valueState bodyOutput bodyEmit resultValue + bodyState hvalueRun + intro huses + subst uses + dsimp only + intro hbodyRun hno htracked _ hwithin + let heldInput := installAliasBinder middle abs 0 .affine true + let bodyInput := + (heldInput.setEntry 0 (.slot abs 0 .affine false)).bump + obtain ⟨hvalueSound, hbodySound⟩ := + hrecursive hvalueRun hbodyRun rfl hwithin hno + have hreleased := hreleases htracked hbodyRun + have hinstall : InstallBinderProfileSound funRel recSelfRel ctx cur + middle bodyInput sourceEnv boundSource .unique (.slotA abs) + (emitOp (.dropU (.var (middle.rel abs)))) + (IxIR0.DynamicCost.tick .evalLet) := by + simpa [bodyInput, heldInput] using + (installAliasBinder_releasedAffine_profile_sound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (input := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (abs := abs)) + have hsound := + hvalueSound.installThen hinstall hbodySound hreleased + simpa [worldOfUses, Function.comp_def] using hsound) + (hslotMany := by + intro middle valueEmit abs valueState bodyOutput bodyEmit resultValue + bodyState hvalueRun + intro huses + subst uses + dsimp only + intro hbodyRun hno htracked _ hwithin + let heldInput := installAliasBinder middle abs 0 .many true + let bodyInput := + (heldInput.setEntry 0 (.slot abs 0 .many false)).bump + obtain ⟨hvalueSound, hbodySound⟩ := + hrecursive hvalueRun hbodyRun rfl hwithin hno + have hreleased := hreleases htracked hbodyRun + have hinstall : InstallBinderProfileSound funRel recSelfRel ctx cur + middle bodyInput sourceEnv boundSource .shared (.slotA abs) + (emitOp (.drop (.var (middle.rel abs)))) + (IxIR0.DynamicCost.tick .evalLet) := by + simpa [bodyInput, heldInput] using + (installAliasBinder_releasedMany_profile_sound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (input := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (abs := abs)) + have hsound := + hvalueSound.installThen hinstall hbodySound hreleased + simpa [worldOfUses, Function.comp_def] using hsound) + (hslotUsed := by + intro middle valueEmit abs valueState bodyOutput bodyEmit resultValue + bodyState hvalueRun + dsimp only + intro hbodyRun hno htracked hwithin + let bodyInput := installAliasBinder middle abs + (countUses 0 body) uses true + obtain ⟨hvalueSound, hbodySound⟩ := + hrecursive hvalueRun hbodyRun rfl hwithin hno + have hreleased := hreleases htracked hbodyRun + have hinstall := installAliasBinder_profile_sound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (input := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (abs := abs) (remaining := countUses 0 body) (uses := uses) + have hsound := + hvalueSound.installThen hinstall hbodySound hreleased + simpa [Function.comp_def] using hsound) + (hconstUnused := by + intro middle valueEmit atom valueState bodyOutput bodyEmit resultValue + bodyState hvalueRun + dsimp only + intro hbodyRun hno htracked hwithin + let bodyInput := installPushedBinder middle 0 uses false + obtain ⟨hvalueSound, hbodySound⟩ := + hrecursive hvalueRun hbodyRun rfl hwithin hno + have hreleased := hreleases htracked hbodyRun + have hinstall := materializeConstBinder_profile_sound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (input := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (atom := atom) (remaining := 0) (uses := uses) (held := false) + hvalueSound.stable + have hsound := + hvalueSound.installThen hinstall hbodySound hreleased + simpa [worldOfUses, Function.comp_def] using hsound) + (hconstUsed := by + intro middle valueEmit atom valueState bodyOutput bodyEmit resultValue + bodyState hvalueRun + dsimp only + intro hbodyRun hno htracked hwithin + let bodyInput := installPushedBinder middle (countUses 0 body) + uses true + obtain ⟨hvalueSound, hbodySound⟩ := + hrecursive hvalueRun hbodyRun rfl hwithin hno + have hreleased := hreleases htracked hbodyRun + have hinstall := materializeConstBinder_profile_sound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (input := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (atom := atom) (remaining := countUses 0 body) (uses := uses) + (held := true) hvalueSound.stable + have hsound := + hvalueSound.installThen hinstall hbodySound hreleased + simpa [worldOfUses, Function.comp_def] using hsound) + hrun) (ExtraExtends.refl _) +theorem lowerE_let_run_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Ixon.Owned} {uses : Ixon.Uses} + {value body : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + {boundSource sourceValue : IxIR0.Value} + {valueProfile bodyProfile : SourceProfile} + (hrecursive : ∀ {middle bodyInput bodyOutput : VEnv} + {valueEmit bodyEmit : Emit} {boundValue resultValue : AVal} + {valueState bodyState bodyFinal : LowSt}, + (lowerE src fuel input (worldOfUses uses) value).run state = + .ok (middle, valueEmit, boundValue) valueState → + (lowerE src fuel bodyInput world body).run bodyState = + .ok (bodyOutput, bodyEmit, resultValue) bodyFinal → + bodyState = valueState → + ExtraExtends bodyFinal finalState → + (NoRecSelf middle → NoRecSelf bodyInput) → + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input middle + sourceEnv sourceEnv boundSource (worldOfUses uses) + valueEmit boundValue valueProfile ∧ + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit + bodyInput bodyOutput (boundSource :: sourceEnv) + (boundSource :: sourceEnv) sourceValue world + bodyEmit resultValue bodyProfile) + (hreleases : LowerEReleasesTrackedFirst src fuel body) + (hrun : (lowerE src (fuel + 1) input world + (.letE uses value body)).run state = + .ok (output, emit, av) finalState) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue world emit av + (valueProfile + bodyProfile + IxIR0.DynamicCost.tick .evalLet) := by + exact (lowerE_let_run_sound_core + (Result := fun branchOutput branchEmit branchValue branchState => + ExtraExtends branchState finalState → + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + branchOutput sourceEnv sourceEnv sourceValue world branchEmit + branchValue (valueProfile + bodyProfile + + IxIR0.DynamicCost.tick .evalLet)) + (hslotAffine := by + intro middle valueEmit abs valueState bodyOutput bodyEmit resultValue + bodyState hvalueRun + intro huses + subst uses + dsimp only + intro hbodyRun hno htracked _ hwithin + let heldInput := installAliasBinder middle abs 0 .affine true + let bodyInput := + (heldInput.setEntry 0 (.slot abs 0 .affine false)).bump + obtain ⟨hvalueSound, hbodySound⟩ := + hrecursive hvalueRun hbodyRun rfl hwithin hno + have hreleased := hreleases htracked hbodyRun + have hinstall : InstallBinderProfileSoundBelow funRel recSelfRel + ctx cur limit middle bodyInput sourceEnv boundSource .unique + (.slotA abs) (emitOp (.dropU (.var (middle.rel abs)))) + (IxIR0.DynamicCost.tick .evalLet) := by + simpa [bodyInput, heldInput] using + (installAliasBinder_releasedAffine_profile_sound_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) (input := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (abs := abs)) + have hsound := + hvalueSound.installThen hinstall hbodySound hreleased + simpa [worldOfUses, Function.comp_def] using hsound) + (hslotMany := by + intro middle valueEmit abs valueState bodyOutput bodyEmit resultValue + bodyState hvalueRun + intro huses + subst uses + dsimp only + intro hbodyRun hno htracked _ hwithin + let heldInput := installAliasBinder middle abs 0 .many true + let bodyInput := + (heldInput.setEntry 0 (.slot abs 0 .many false)).bump + obtain ⟨hvalueSound, hbodySound⟩ := + hrecursive hvalueRun hbodyRun rfl hwithin hno + have hreleased := hreleases htracked hbodyRun + have hinstall : InstallBinderProfileSoundBelow funRel recSelfRel + ctx cur limit middle bodyInput sourceEnv boundSource .shared + (.slotA abs) (emitOp (.drop (.var (middle.rel abs)))) + (IxIR0.DynamicCost.tick .evalLet) := by + simpa [bodyInput, heldInput] using + (installAliasBinder_releasedMany_profile_sound_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) (input := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (abs := abs)) + have hsound := + hvalueSound.installThen hinstall hbodySound hreleased + simpa [worldOfUses, Function.comp_def] using hsound) + (hslotUsed := by + intro middle valueEmit abs valueState bodyOutput bodyEmit resultValue + bodyState hvalueRun + dsimp only + intro hbodyRun hno htracked hwithin + let bodyInput := installAliasBinder middle abs + (countUses 0 body) uses true + obtain ⟨hvalueSound, hbodySound⟩ := + hrecursive hvalueRun hbodyRun rfl hwithin hno + have hreleased := hreleases htracked hbodyRun + have hinstall := installAliasBinder_profile_sound_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) (input := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (abs := abs) (remaining := countUses 0 body) (uses := uses) + have hsound := + hvalueSound.installThen hinstall hbodySound hreleased + simpa [Function.comp_def] using hsound) + (hconstUnused := by + intro middle valueEmit atom valueState bodyOutput bodyEmit resultValue + bodyState hvalueRun + dsimp only + intro hbodyRun hno htracked hwithin + let bodyInput := installPushedBinder middle 0 uses false + obtain ⟨hvalueSound, hbodySound⟩ := + hrecursive hvalueRun hbodyRun rfl hwithin hno + have hreleased := hreleases htracked hbodyRun + have hinstall := materializeConstBinder_profile_sound_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) (input := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (atom := atom) (remaining := 0) (uses := uses) (held := false) + hvalueSound.stable + have hsound := + hvalueSound.installThen hinstall hbodySound hreleased + simpa [worldOfUses, Function.comp_def] using hsound) + (hconstUsed := by + intro middle valueEmit atom valueState bodyOutput bodyEmit resultValue + bodyState hvalueRun + dsimp only + intro hbodyRun hno htracked hwithin + let bodyInput := installPushedBinder middle (countUses 0 body) + uses true + obtain ⟨hvalueSound, hbodySound⟩ := + hrecursive hvalueRun hbodyRun rfl hwithin hno + have hreleased := hreleases htracked hbodyRun + have hinstall := materializeConstBinder_profile_sound_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) (input := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (atom := atom) (remaining := countUses 0 body) (uses := uses) + (held := true) hvalueSound.stable + have hsound := + hvalueSound.installThen hinstall hbodySound hreleased + simpa [worldOfUses, Function.comp_def] using hsound) + hrun) (ExtraExtends.refl _) +/-- Lambda lowering composes the exact live-capture retain budget with the +single PAP allocation emitted at the closure site. Fresh-address and lifted +body construction mutate only compiler state, not the returned emitter. -/ +theorem lowerLam_profileFundedOwnershipCostSound + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {expr : IxIR0.Expr} + {emit : Emit} {value : AVal} {state finalState : LowSt} + (hrun : (lowerLam src fuel input expr).run state = + .ok (output, emit, value) finalState) : + ProfileFundedEmitOwnershipCostSound ctx cur emit + (IxIR0.DynamicCost.retain + ((List.range input.entries.length).filter + (fun index => countUses index expr > 0)).length + + IxIR0.DynamicCost.tick .evalLam) := by + let captures := liftCaptureIndices input.entries.length expr + change ProfileFundedEmitOwnershipCostSound ctx cur emit + (IxIR0.DynamicCost.retain captures.length + + IxIR0.DynamicCost.tick .evalLam) + apply lowerLam_run_core + (Result := fun _ _ emit _ => + ProfileFundedEmitOwnershipCostSound ctx cur emit + (IxIR0.DynamicCost.retain captures.length + + IxIR0.DynamicCost.tick .evalLam)) + (hrun := hrun) + intro _bodyFuel captureOutput captureEmit captureValues _captureState + fnAddr _addressState _code _bodyState _hfuel _hp hcaptureRun + _hfreshRun _hbodyRun + have hcaptureCost := + lowerCaptures_profileFundedOwnershipCostSound + (ctx := ctx) (cur := cur) expr captures + (by simpa [captures] using hcaptureRun) + have hpappCost : + ProfileFundedEmitOwnershipCostSound ctx cur + (emitOp (.papp fnAddr + (captureValues.map + (·.toAtom captureOutput)).toArray)) + (IxIR0.DynamicCost.tick .evalLam) := + ProfileFundedEmitOwnershipCostSound.localEval + (by simp [localOpOwnershipAllowance]) .evalLam rfl + exact ProfileFundedEmitOwnershipCostSound.comp hcaptureCost hpappCost + +theorem lowerLam_profileFundedEmitRunSound + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {expr : IxIR0.Expr} + {emit : Emit} {value : AVal} {state finalState : LowSt} + (hrun : (lowerLam src fuel input expr).run state = + .ok (output, emit, value) finalState) : + ProfileFundedEmitRunSound ctx cur emit + (IxIR0.DynamicCost.retain + ((List.range input.entries.length).filter + (fun index => countUses index expr > 0)).length + + IxIR0.DynamicCost.tick .evalLam) := by + let captures := liftCaptureIndices input.entries.length expr + change ProfileFundedEmitRunSound ctx cur emit + (IxIR0.DynamicCost.retain captures.length + + IxIR0.DynamicCost.tick .evalLam) + refine lowerLam_run_core + (Result := fun _ _ emit _ => + ProfileFundedEmitRunSound ctx cur emit + (IxIR0.DynamicCost.retain captures.length + + IxIR0.DynamicCost.tick .evalLam)) + ?_ hrun + intro _bodyFuel captureOutput captureEmit captureValues _captureState + fnAddr _addressState _code _bodyState _hfuel _hp hcaptureRun + _hfreshRun _hbodyRun + have hcaptureCost : ProfileFundedEmitRunSound ctx cur captureEmit + (IxIR0.DynamicCost.retain captures.length) := + lowerCaptures_profileFundedEmitRunSound + (ctx := ctx) (cur := cur) expr captures + (by simpa [captures] using hcaptureRun) + have hpappCost : + ProfileFundedEmitRunSound ctx cur + (emitOp (.papp fnAddr + (captureValues.map + (·.toAtom captureOutput)).toArray)) + (IxIR0.DynamicCost.tick .evalLam) := + ProfileFundedEmitRunSound.localEval + (by simp [localOpOwnershipAllowance]) .evalLam rfl + intro continuation continuationProfile runFuel before after runtimeEnv + result horder hbounds hcodeRun hcontinuation + exact (ProfileFundedEmitRunSound.comp hcaptureCost hpappCost) + horder hbounds hcodeRun hcontinuation + +/-- The successful `lowerE` lambda branch is funded by the exact source +lambda profile. The source charges every environment entry conservatively; +the compiler retains only the filtered live captures. -/ +theorem lowerE_lam_profileFundedOwnershipCostSound + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Ixon.Owned} {uses : Ixon.Uses} + {body : IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {emit : Emit} {value : AVal} {state finalState : LowSt} + (hsourceLength : sourceEnv.length = input.entries.length) + (hrun : (lowerE src (fuel + 1) input world + (.lam uses body)).run state = + .ok (output, emit, value) finalState) : + ProfileFundedEmitOwnershipCostSound ctx cur emit + (IxIR0.DynamicCost.tick .evalLam + + IxIR0.DynamicCost.retain sourceEnv.length) := by + have huuEq : + (Ixon.Owned.unique == Ixon.Owned.unique) = true := by decide + have hsuEq : + (Ixon.Owned.shared == Ixon.Owned.unique) = false := by decide + cases world with + | unique => + exact (stateThrowRun_not_ok (by + simpa [lowerE, huuEq] using hrun)).elim + | shared => + have hlam : + (lowerLam src fuel input (.lam uses body)).run state = + .ok (output, emit, value) finalState := by + simpa [lowerE, hsuEq] using hrun + let captures := (List.range input.entries.length).filter + (fun index => countUses index (.lam uses body) > 0) + have hcaptureCost := + lowerLam_profileFundedOwnershipCostSound + (ctx := ctx) (cur := cur) hlam + change ProfileFundedEmitOwnershipCostSound ctx cur emit + (IxIR0.DynamicCost.retain captures.length + + IxIR0.DynamicCost.tick .evalLam) at hcaptureCost + have hcapturesLeInput : captures.length ≤ input.entries.length := by + simpa [captures] using List.length_filter_le + (fun index => countUses index (.lam uses body) > 0) + (List.range input.entries.length) + have hcapturesLeSource : captures.length ≤ sourceEnv.length := by + omega + apply ProfileFundedEmitOwnershipCostSound.monoProfile hcaptureCost + simp [OwnershipAllowanceLE, sourceProfileOwnershipAllowance, + IxIR0.DynamicCost.retain, IxIR0.DynamicCost.tick] + omega + +theorem lowerE_lam_profileFundedEmitRunSound + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Ixon.Owned} {uses : Ixon.Uses} + {body : IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {emit : Emit} {value : AVal} {state finalState : LowSt} + (hsourceLength : sourceEnv.length = input.entries.length) + (hrun : (lowerE src (fuel + 1) input world + (.lam uses body)).run state = + .ok (output, emit, value) finalState) : + ProfileFundedEmitRunSound ctx cur emit + (IxIR0.DynamicCost.tick .evalLam + + IxIR0.DynamicCost.retain sourceEnv.length) := by + intro continuation continuationProfile runFuel before after runtimeEnv + result horder hbounds hcodeRun hcontinuation + have huuEq : + (Ixon.Owned.unique == Ixon.Owned.unique) = true := by decide + have hsuEq : + (Ixon.Owned.shared == Ixon.Owned.unique) = false := by decide + cases world with + | unique => + exact (stateThrowRun_not_ok (by + simpa [lowerE, huuEq] using hrun)).elim + | shared => + have hlam : + (lowerLam src fuel input (.lam uses body)).run state = + .ok (output, emit, value) finalState := by + simpa [lowerE, hsuEq] using hrun + let captures := (List.range input.entries.length).filter + (fun index => countUses index (.lam uses body) > 0) + have hcapturesLeInput : captures.length ≤ input.entries.length := by + simpa [captures] using List.length_filter_le + (fun index => countUses index (.lam uses body) > 0) + (List.range input.entries.length) + have hcapturesLeSource : captures.length ≤ sourceEnv.length := by + omega + have hprofileLe : OwnershipAllowanceLE + (sourceProfileOwnershipAllowance + (IxIR0.DynamicCost.retain captures.length + + IxIR0.DynamicCost.tick .evalLam)) + (sourceProfileOwnershipAllowance + (IxIR0.DynamicCost.tick .evalLam + + IxIR0.DynamicCost.retain sourceEnv.length)) := by + simp [OwnershipAllowanceLE, sourceProfileOwnershipAllowance, + IxIR0.DynamicCost.retain, IxIR0.DynamicCost.tick] + omega + have hlocalRun : ProfileFundedCodeRun ctx runFuel cur before + runtimeEnv (emit continuation) after result + ((IxIR0.DynamicCost.retain captures.length + + IxIR0.DynamicCost.tick .evalLam) + continuationProfile) := by + simpa only [captures] using + ((lowerLam_profileFundedEmitRunSound + (ctx := ctx) (cur := cur) hlam) + horder hbounds hcodeRun hcontinuation) + apply hlocalRun.monoProfile + simpa only [sourceProfileOwnershipAllowance_add] using + hprofileLe.add (OwnershipAllowanceLE.refl + (sourceProfileOwnershipAllowance continuationProfile)) + +/-- A projection fetch known to be impossible closes any remaining suffix. +The fetch itself is ownership-free; the unreachable tail may consume the +source retain candidate without producing a target run. -/ +theorem falseAfterProjectionFetch_profileFundedEmitStateRunSound + {ctx : Ctx} {cur : FnDef} {op : Op} {tail : Emit} + {pre post : StatePred} + (hfalse : OpSound ctx cur op pre (fun _ _ => False)) + (hlocal : localOpOwnershipAllowance op = some ⟨0, 0⟩) : + ProfileFundedEmitStateRunSound ctx cur (emitOp op ∘ tail) pre post + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := + ProfileFundedEmitStateRunSound.comp + (ProfileFundedEmitStateRunSound.localZero + (profile := IxIR0.DynamicCost.tick .evalProj) hfalse hlocal) + (ProfileFundedEmitStateRunSound.ofFalse + (emit := tail) (profile := IxIR0.DynamicCost.retain 1)) + +/-- Exact state-indexed fetch/retain suffix for a repeated-use projection +target. The final identity step exposes the retained field as the result. -/ +theorem projectionSlotKept_profileFundedEmitStateRunSound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {address : Ixon.Address} + {tag : Nat} {sourceFields : List IxIR0.Value} + {sourceField : IxIR0.Value} {targetAbs index : Nat} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} {slots : List (Nat × RVal)} + (hsourceField : sourceFields[index]? = some sourceField) : + ProfileFundedEmitStateRunSound ctx cur + (emitOp (.fetch (.var (Γ.rel targetAbs)) index) ∘ + emitOp (.dup (.var (Γ.bump.rel Γ.depth)))) + (GraphOwnsBorrowResultProtected funRel recSelfRel Γ sourceEnv + (.ctor address tag sourceFields) (.slotA targetAbs) false + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel Γ.bump.bump sourceEnv + sourceField .shared (.slotA Γ.bump.depth) sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + have hfetch : ProfileFundedEmitStateRunSound ctx cur + (emitOp (.fetch (.var (Γ.rel targetAbs)) index)) + (GraphOwnsBorrowResultProtected funRel recSelfRel Γ sourceEnv + (.ctor address tag sourceFields) (.slotA targetAbs) false + sourceRest rest slots) + (GraphOwnsFetchedBorrowProtected funRel recSelfRel Γ.bump sourceEnv + (.ctor address tag sourceFields) sourceField + (.slotA targetAbs) (.slotA Γ.depth) false + sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj) := + ProfileFundedEmitStateRunSound.localZero + (fetchBorrowSlot_value_op + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := Γ) (sourceEnv := sourceEnv) + (address := address) (tag := tag) (targetAbs := targetAbs) + (index := index) (release := false) (sourceRest := sourceRest) + (rest := rest) (slots := slots) hsourceField) + (by simp [localOpOwnershipAllowance]) + have hretain : ProfileFundedEmitStateRunSound ctx cur + (emitOp (.dup (.var (Γ.bump.rel Γ.depth)))) + (GraphOwnsFetchedBorrowProtected funRel recSelfRel Γ.bump sourceEnv + (.ctor address tag sourceFields) sourceField + (.slotA targetAbs) (.slotA Γ.depth) false + sourceRest rest slots) + (GraphOwnsRetainedProjectionProtected funRel recSelfRel + Γ.bump.bump sourceEnv (.ctor address tag sourceFields) sourceField + (.slotA targetAbs) (.slotA Γ.bump.depth) false + sourceRest rest slots) + (IxIR0.DynamicCost.retain 1) := + ProfileFundedEmitStateRunSound.localRetain + (retainFetchedBorrow_value_op + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := Γ.bump) + (sourceEnv := sourceEnv) + (sourceTarget := .ctor address tag sourceFields) + (sourceField := sourceField) (targetAbs := targetAbs) + (fieldAbs := Γ.depth) (release := false) + (sourceRest := sourceRest) (rest := rest) (slots := slots)) + (by simp [localOpOwnershipAllowance]) + have hfinish : ProfileFundedEmitStateRunSound ctx cur + (_root_.id : Emit) + (GraphOwnsRetainedProjectionProtected funRel recSelfRel + Γ.bump.bump sourceEnv (.ctor address tag sourceFields) sourceField + (.slotA targetAbs) (.slotA Γ.bump.depth) false + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel Γ.bump.bump sourceEnv + sourceField .shared (.slotA Γ.bump.depth) sourceRest rest slots) + 0 := by + apply ProfileFundedEmitStateRunSound.id + intro store env hpre + obtain ⟨roots, targetValue, resultValue, hΓ, htarget, hresult, + htargetWorld, htargetGraph, hresultGraph, hrestGraph, + hown, hslots⟩ := hpre + refine ⟨⟨roots, resultValue, hΓ, hresult, hresultGraph, + hrestGraph, ?_⟩, hslots⟩ + simpa [borrowResultRoots] using hown + have hall : ProfileFundedEmitStateRunSound ctx cur + (emitOp (.fetch (.var (Γ.rel targetAbs)) index) ∘ + (emitOp (.dup (.var (Γ.bump.rel Γ.depth))) ∘ + (_root_.id : Emit))) + (GraphOwnsBorrowResultProtected funRel recSelfRel Γ sourceEnv + (.ctor address tag sourceFields) (.slotA targetAbs) false + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel Γ.bump.bump sourceEnv + sourceField .shared (.slotA Γ.bump.depth) sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj + + (IxIR0.DynamicCost.retain 1 + 0)) := + ProfileFundedEmitStateRunSound.comp hfetch + (ProfileFundedEmitStateRunSound.comp hretain hfinish) + have hnormalized : ProfileFundedEmitStateRunSound ctx cur + (emitOp (.fetch (.var (Γ.rel targetAbs)) index) ∘ + (emitOp (.dup (.var (Γ.bump.rel Γ.depth))) ∘ + (_root_.id : Emit))) + (GraphOwnsBorrowResultProtected funRel recSelfRel Γ sourceEnv + (.ctor address tag sourceFields) (.slotA targetAbs) false + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel Γ.bump.bump sourceEnv + sourceField .shared (.slotA Γ.bump.depth) sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := + ProfileFundedEmitStateRunSound.of_profile_eq hall (by + ext <;> simp) + intro continuation continuationProfile fuel before after env value horder + henv hpre hrun hcontinuation + exact hnormalized horder henv hpre hrun hcontinuation + +/-- Exact state-indexed fetch/retain/drop suffix for a final-use projection +target. The destructive drop transports every surviving graph through the +resulting store restriction. -/ +theorem projectionSlotReleased_profileFundedEmitStateRunSound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {address : Ixon.Address} + {tag : Nat} {sourceFields : List IxIR0.Value} + {sourceField : IxIR0.Value} {targetAbs index : Nat} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} {slots : List (Nat × RVal)} + (hsourceField : sourceFields[index]? = some sourceField) : + ProfileFundedEmitStateRunSound ctx cur + (emitOp (.fetch (.var (Γ.rel targetAbs)) index) ∘ + emitOp (.dup (.var (Γ.bump.rel Γ.depth))) ∘ + emitOp (.drop (.var (Γ.bump.bump.rel targetAbs)))) + (GraphOwnsBorrowResultProtected funRel recSelfRel Γ sourceEnv + (.ctor address tag sourceFields) (.slotA targetAbs) true + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel Γ.bump.bump.bump + sourceEnv sourceField .shared (.slotA Γ.bump.depth) + sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + have hfetch : ProfileFundedEmitStateRunSound ctx cur + (emitOp (.fetch (.var (Γ.rel targetAbs)) index)) + (GraphOwnsBorrowResultProtected funRel recSelfRel Γ sourceEnv + (.ctor address tag sourceFields) (.slotA targetAbs) true + sourceRest rest slots) + (GraphOwnsFetchedBorrowProtected funRel recSelfRel Γ.bump sourceEnv + (.ctor address tag sourceFields) sourceField + (.slotA targetAbs) (.slotA Γ.depth) true + sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj) := + ProfileFundedEmitStateRunSound.localZero + (fetchBorrowSlot_value_op + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := Γ) (sourceEnv := sourceEnv) + (address := address) (tag := tag) (targetAbs := targetAbs) + (index := index) (release := true) (sourceRest := sourceRest) + (rest := rest) (slots := slots) hsourceField) + (by simp [localOpOwnershipAllowance]) + have hretain : ProfileFundedEmitStateRunSound ctx cur + (emitOp (.dup (.var (Γ.bump.rel Γ.depth)))) + (GraphOwnsFetchedBorrowProtected funRel recSelfRel Γ.bump sourceEnv + (.ctor address tag sourceFields) sourceField + (.slotA targetAbs) (.slotA Γ.depth) true + sourceRest rest slots) + (GraphOwnsRetainedProjectionProtected funRel recSelfRel + Γ.bump.bump sourceEnv (.ctor address tag sourceFields) sourceField + (.slotA targetAbs) (.slotA Γ.bump.depth) true + sourceRest rest slots) + (IxIR0.DynamicCost.retain 1) := + ProfileFundedEmitStateRunSound.localRetain + (retainFetchedBorrow_value_op + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := Γ.bump) + (sourceEnv := sourceEnv) + (sourceTarget := .ctor address tag sourceFields) + (sourceField := sourceField) (targetAbs := targetAbs) + (fieldAbs := Γ.depth) (release := true) + (sourceRest := sourceRest) (rest := rest) (slots := slots)) + (by simp [localOpOwnershipAllowance]) + have hdrop : ProfileFundedEmitStateRunSound ctx cur + (emitOp (.drop (.var (Γ.bump.bump.rel targetAbs)))) + (GraphOwnsRetainedProjectionProtected funRel recSelfRel + Γ.bump.bump sourceEnv (.ctor address tag sourceFields) sourceField + (.slotA targetAbs) (.slotA Γ.bump.depth) true + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel Γ.bump.bump.bump + sourceEnv sourceField .shared (.slotA Γ.bump.depth) + sourceRest rest slots) + 0 := + ProfileFundedEmitStateRunSound.localZero + (releaseRetainedProjection_value_op + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := Γ.bump.bump) + (sourceEnv := sourceEnv) + (sourceTarget := .ctor address tag sourceFields) + (sourceField := sourceField) (targetAbs := targetAbs) + (resultAbs := Γ.bump.depth) (sourceRest := sourceRest) + (rest := rest) (slots := slots)) + (by simp [localOpOwnershipAllowance]) + have hall : ProfileFundedEmitStateRunSound ctx cur + (emitOp (.fetch (.var (Γ.rel targetAbs)) index) ∘ + (emitOp (.dup (.var (Γ.bump.rel Γ.depth))) ∘ + emitOp (.drop (.var (Γ.bump.bump.rel targetAbs))))) + (GraphOwnsBorrowResultProtected funRel recSelfRel Γ sourceEnv + (.ctor address tag sourceFields) (.slotA targetAbs) true + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel Γ.bump.bump.bump + sourceEnv sourceField .shared (.slotA Γ.bump.depth) + sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj + + (IxIR0.DynamicCost.retain 1 + 0)) := + ProfileFundedEmitStateRunSound.comp hfetch + (ProfileFundedEmitStateRunSound.comp hretain hdrop) + have hnormalized : ProfileFundedEmitStateRunSound ctx cur + (emitOp (.fetch (.var (Γ.rel targetAbs)) index) ∘ + (emitOp (.dup (.var (Γ.bump.rel Γ.depth))) ∘ + emitOp (.drop (.var (Γ.bump.bump.rel targetAbs))))) + (GraphOwnsBorrowResultProtected funRel recSelfRel Γ sourceEnv + (.ctor address tag sourceFields) (.slotA targetAbs) true + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel Γ.bump.bump.bump + sourceEnv sourceField .shared (.slotA Γ.bump.depth) + sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := + ProfileFundedEmitStateRunSound.of_profile_eq hall (by + ext <;> simp) + intro continuation continuationProfile fuel before after env value horder + henv hpre hrun hcontinuation + exact hnormalized horder henv hpre hrun hcontinuation + +/-- Profiled erased-borrow finish. The target identity suffix is free, while +the source projection event and conservative retain candidate remain in the +trace. -/ +theorem LowerBorrowProfileSound.returnErased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {emit : Emit} {release : Bool} {sourceProfile : SourceProfile} + (hsound : LowerBorrowProfileSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput .erased emit + (.constA .erased) release sourceProfile) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput .erased .shared emit (.constA .erased) + (sourceProfile + IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + have hvalue : LowerResultValueSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput .erased .shared + (emit ∘ (_root_.id : Emit)) (.constA .erased) := by + simpa [Function.comp_def] using + hsound.toLowerBorrowValueSound.returnErased + have hsuffix : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSound ctx cur (_root_.id : Emit) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput .erased (.constA .erased) release + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output sourceOutput + .erased .shared (.constA .erased) sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + intro sourceRest rest slots + apply ProfileFundedEmitStateRunSound.monoProfile + · apply ProfileFundedEmitStateRunSound.id + intro store env hpre + obtain ⟨roots, value, houtput, hav, hworld, hvalueGraph, + hrestGraph, hown, hslots⟩ := hpre + refine ⟨⟨roots, value, houtput, hav, hvalueGraph, + hrestGraph, ?_⟩, hslots⟩ + cases release with + | false => + simpa [borrowResultRoots] using + hown.addNoLocation + (hsound.stable.const_noLocation hav) + | true => simpa [borrowResultRoots] using hown + · exact zeroOwnershipAllowance_le_profile _ + have hcombined : LowerResultProfileSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput .erased .shared + (emit ∘ (_root_.id : Emit)) (.constA .erased) + (sourceProfile + + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1)) := + hsound.thenResult hvalue hsuffix + have hnormalized := hcombined.of_profile_eq + (IxIR0.DynamicCost.Profile.add_assoc sourceProfile + (IxIR0.DynamicCost.tick .evalProj) + (IxIR0.DynamicCost.retain 1)).symm + simpa [Function.comp_def] using hnormalized + +/-- A constructor source value cannot realize the erased scalar descriptor. +The profiled target identity branch is therefore vacuous at the exact state +boundary. -/ +theorem LowerBorrowProfileSound.projectCtorErased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {address : Ixon.Address} {tag : Nat} + {sourceFields : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {release : Bool} {sourceProfile : SourceProfile} + (hsound : LowerBorrowProfileSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput + (.ctor address tag sourceFields) emit (.constA .erased) release + sourceProfile) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue .shared emit (.constA .erased) + (sourceProfile + IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + have hvalue : LowerResultValueSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceValue .shared + (emit ∘ (_root_.id : Emit)) (.constA .erased) := by + simpa [Function.comp_def] using + hsound.toLowerBorrowValueSound.projectCtorErased + have hsuffix : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSound ctx cur (_root_.id : Emit) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput (.ctor address tag sourceFields) (.constA .erased) + release sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output sourceOutput + sourceValue .shared (.constA .erased) sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + intro sourceRest rest slots + apply ProfileFundedEmitStateRunSound.monoProfile + · apply ProfileFundedEmitStateRunSound.id + intro store env hpre + obtain ⟨roots, value, houtput, hav, hworld, htargetGraph, + hrestGraph, hown, hslots⟩ := hpre + cases hav with + | const hresolve => + simp only [resolveAtom] at hresolve + have hvalue : RVal.erased = value := Except.ok.inj hresolve + subst value + cases htargetGraph + · exact zeroOwnershipAllowance_le_profile _ + have hcombined : LowerResultProfileSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceValue .shared + (emit ∘ (_root_.id : Emit)) (.constA .erased) + (sourceProfile + + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1)) := + hsound.thenResult hvalue hsuffix + have hnormalized := hcombined.of_profile_eq + (IxIR0.DynamicCost.Profile.add_assoc sourceProfile + (IxIR0.DynamicCost.tick .evalProj) + (IxIR0.DynamicCost.retain 1)).symm + simpa [Function.comp_def] using hnormalized + +/-- Profiled scalar-target projection. Stable literals and erased constants +cannot satisfy `fetch`, so the exact state transformer closes by the exposed +operation-level contradiction. -/ +theorem LowerBorrowProfileSound.projectConst + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceTarget sourceValue : IxIR0.Value} + {emit : Emit} {atom : Atom} {index : Nat} {release : Bool} + {sourceProfile : SourceProfile} + (hsound : LowerBorrowProfileSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceTarget emit + (.constA atom) release sourceProfile) : + LowerResultProfileSound funRel recSelfRel ctx cur input output.bump + sourceInput sourceOutput sourceValue .shared + (emit ∘ emitOp (.fetch atom index)) (.slotA output.depth) + (sourceProfile + IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + have hvalue := hsound.toLowerBorrowValueSound.projectConst + (sourceValue := sourceValue) (index := index) + have hsuffix : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSound ctx cur + (emitOp (.fetch atom index)) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput sourceTarget (.constA atom) release + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump + sourceOutput sourceValue .shared (.slotA output.depth) + sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + intro sourceRest rest slots + apply ProfileFundedEmitStateRunSound.localZero + · intro fuel store env store' result hpre hrun + exact (fetchStableConst_false_op hsound.stable hpre hrun).elim + · simp [localOpOwnershipAllowance] + have hcombined : LowerResultProfileSound funRel recSelfRel ctx cur + input output.bump sourceInput sourceOutput sourceValue .shared + (emit ∘ emitOp (.fetch atom index)) (.slotA output.depth) + (sourceProfile + + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1)) := + hsound.thenResult hvalue hsuffix + exact hcombined.of_profile_eq + (IxIR0.DynamicCost.Profile.add_assoc sourceProfile + (IxIR0.DynamicCost.tick .evalProj) + (IxIR0.DynamicCost.retain 1)).symm + +/-- Profiled projection through a retained slot. -/ +theorem LowerBorrowProfileSound.projectSlotKept + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {address : Ixon.Address} {tag : Nat} + {sourceFields : List IxIR0.Value} {sourceField : IxIR0.Value} + {emit : Emit} {targetAbs index : Nat} {sourceProfile : SourceProfile} + (hsound : LowerBorrowProfileSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput + (.ctor address tag sourceFields) emit (.slotA targetAbs) false + sourceProfile) + (hsourceField : sourceFields[index]? = some sourceField) : + LowerResultProfileSound funRel recSelfRel ctx cur input + output.bump.bump sourceInput sourceOutput sourceField .shared + (emit ∘ emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth)))) + (.slotA output.bump.depth) + (sourceProfile + IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + have hvalue := hsound.toLowerBorrowValueSound.projectSlotKept + hsourceField + have hsuffix : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSound ctx cur + (emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth)))) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput (.ctor address tag sourceFields) + (.slotA targetAbs) false sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump.bump + sourceOutput sourceField .shared (.slotA output.bump.depth) + sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + intro sourceRest rest slots + exact projectionSlotKept_profileFundedEmitStateRunSound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output) + (sourceEnv := sourceOutput) (address := address) (tag := tag) + (targetAbs := targetAbs) (index := index) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + hsourceField + have hcombined : LowerResultProfileSound funRel recSelfRel ctx cur + input output.bump.bump sourceInput sourceOutput sourceField .shared + (emit ∘ + (emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth))))) + (.slotA output.bump.depth) + (sourceProfile + + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1)) := + hsound.thenResult hvalue hsuffix + exact hcombined.of_profile_eq + (IxIR0.DynamicCost.Profile.add_assoc sourceProfile + (IxIR0.DynamicCost.tick .evalProj) + (IxIR0.DynamicCost.retain 1)).symm + +/-- Profiled projection through a final-use slot. -/ +theorem LowerBorrowProfileSound.projectSlotReleased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {address : Ixon.Address} {tag : Nat} + {sourceFields : List IxIR0.Value} {sourceField : IxIR0.Value} + {emit : Emit} {targetAbs index : Nat} {sourceProfile : SourceProfile} + (hsound : LowerBorrowProfileSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput + (.ctor address tag sourceFields) emit (.slotA targetAbs) true + sourceProfile) + (hsourceField : sourceFields[index]? = some sourceField) : + LowerResultProfileSound funRel recSelfRel ctx cur input + output.bump.bump.bump sourceInput sourceOutput sourceField .shared + (emit ∘ emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth))) ∘ + emitOp (.drop (.var (output.bump.bump.rel targetAbs)))) + (.slotA output.bump.depth) + (sourceProfile + IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + have hvalue := hsound.toLowerBorrowValueSound.projectSlotReleased + hsourceField + have hsuffix : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSound ctx cur + (emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth))) ∘ + emitOp (.drop (.var (output.bump.bump.rel targetAbs)))) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput (.ctor address tag sourceFields) + (.slotA targetAbs) true sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump.bump.bump + sourceOutput sourceField .shared (.slotA output.bump.depth) + sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + intro sourceRest rest slots + exact projectionSlotReleased_profileFundedEmitStateRunSound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output) + (sourceEnv := sourceOutput) (address := address) (tag := tag) + (targetAbs := targetAbs) (index := index) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + hsourceField + have hcombined : LowerResultProfileSound funRel recSelfRel ctx cur + input output.bump.bump.bump sourceInput sourceOutput sourceField + .shared + (emit ∘ + (emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth))) ∘ + emitOp (.drop (.var (output.bump.bump.rel targetAbs))))) + (.slotA output.bump.depth) + (sourceProfile + + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1)) := + hsound.thenResult hvalue hsuffix + exact hcombined.of_profile_eq + (IxIR0.DynamicCost.Profile.add_assoc sourceProfile + (IxIR0.DynamicCost.tick .evalProj) + (IxIR0.DynamicCost.retain 1)).symm + +/-- Profiled erased-source projection through a retained slot. The fetch +cannot execute, so the exact-run suffix closes at its false midpoint. -/ +theorem LowerBorrowProfileSound.projectSlotKeptErased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} + {emit : Emit} {targetAbs index : Nat} {sourceProfile : SourceProfile} + (hsound : LowerBorrowProfileSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput .erased emit + (.slotA targetAbs) false sourceProfile) : + LowerResultProfileSound funRel recSelfRel ctx cur input + output.bump.bump sourceInput sourceOutput sourceValue .shared + (emit ∘ emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth)))) + (.slotA output.bump.depth) + (sourceProfile + IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + have hvalue := hsound.toLowerBorrowValueSound.projectSlotKeptErased + (sourceValue := sourceValue) (index := index) + have hsuffix : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSound ctx cur + (emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth)))) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput .erased (.slotA targetAbs) false + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump.bump + sourceOutput sourceValue .shared (.slotA output.bump.depth) + sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + intro sourceRest rest slots + apply falseAfterProjectionFetch_profileFundedEmitStateRunSound + · exact fetchErasedSlot_false_op + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output) + (sourceEnv := sourceOutput) (targetAbs := targetAbs) + (index := index) (release := false) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + · simp [localOpOwnershipAllowance] + have hcombined : LowerResultProfileSound funRel recSelfRel ctx cur + input output.bump.bump sourceInput sourceOutput sourceValue .shared + (emit ∘ + (emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth))))) + (.slotA output.bump.depth) + (sourceProfile + + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1)) := + hsound.thenResult hvalue hsuffix + exact hcombined.of_profile_eq + (IxIR0.DynamicCost.Profile.add_assoc sourceProfile + (IxIR0.DynamicCost.tick .evalProj) + (IxIR0.DynamicCost.retain 1)).symm + +/-- Profiled erased-source projection through a final-use slot. -/ +theorem LowerBorrowProfileSound.projectSlotReleasedErased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} + {emit : Emit} {targetAbs index : Nat} {sourceProfile : SourceProfile} + (hsound : LowerBorrowProfileSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput .erased emit + (.slotA targetAbs) true sourceProfile) : + LowerResultProfileSound funRel recSelfRel ctx cur input + output.bump.bump.bump sourceInput sourceOutput sourceValue .shared + (emit ∘ emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth))) ∘ + emitOp (.drop (.var (output.bump.bump.rel targetAbs)))) + (.slotA output.bump.depth) + (sourceProfile + IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + have hvalue := hsound.toLowerBorrowValueSound.projectSlotReleasedErased + (sourceValue := sourceValue) (index := index) + have hsuffix : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSound ctx cur + (emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth))) ∘ + emitOp (.drop (.var (output.bump.bump.rel targetAbs)))) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput .erased (.slotA targetAbs) true + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump.bump.bump + sourceOutput sourceValue .shared (.slotA output.bump.depth) + sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + intro sourceRest rest slots + apply falseAfterProjectionFetch_profileFundedEmitStateRunSound + · exact fetchErasedSlot_false_op + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output) + (sourceEnv := sourceOutput) (targetAbs := targetAbs) + (index := index) (release := true) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + · simp [localOpOwnershipAllowance] + have hcombined : LowerResultProfileSound funRel recSelfRel ctx cur + input output.bump.bump.bump sourceInput sourceOutput sourceValue + .shared + (emit ∘ + (emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth))) ∘ + emitOp (.drop (.var (output.bump.bump.rel targetAbs))))) + (.slotA output.bump.depth) + (sourceProfile + + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1)) := + hsound.thenResult hvalue hsuffix + exact hcombined.of_profile_eq + (IxIR0.DynamicCost.Profile.add_assoc sourceProfile + (IxIR0.DynamicCost.tick .evalProj) + (IxIR0.DynamicCost.retain 1)).symm + +/-- A target-fuel-bounded projection fetch known to be impossible closes any remaining suffix. +The fetch itself is ownership-free; the unreachable tail may consume the +source retain candidate without producing a target run. -/ +theorem falseAfterProjectionFetch_profileFundedEmitStateRunSound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {op : Op} {tail : Emit} + {pre post : StatePred} + (hfalse : OpSound ctx cur op pre (fun _ _ => False)) + (hlocal : localOpOwnershipAllowance op = some ⟨0, 0⟩) : + ProfileFundedEmitStateRunSoundBelow ctx cur limit (emitOp op ∘ tail) pre post + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := + ProfileFundedEmitStateRunSoundBelow.comp + (ProfileFundedEmitStateRunSoundBelow.localZero + (profile := IxIR0.DynamicCost.tick .evalProj) hfalse hlocal) + (ProfileFundedEmitStateRunSoundBelow.ofFalse + (emit := tail) (profile := IxIR0.DynamicCost.retain 1)) + +/-- Target-fuel-bounded exact state-indexed fetch/retain suffix for a repeated-use projection +target. The final identity step exposes the retained field as the result. -/ +theorem projectionSlotKept_profileFundedEmitStateRunSound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {address : Ixon.Address} + {tag : Nat} {sourceFields : List IxIR0.Value} + {sourceField : IxIR0.Value} {targetAbs index : Nat} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} {slots : List (Nat × RVal)} + (hsourceField : sourceFields[index]? = some sourceField) : + ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.fetch (.var (Γ.rel targetAbs)) index) ∘ + emitOp (.dup (.var (Γ.bump.rel Γ.depth)))) + (GraphOwnsBorrowResultProtected funRel recSelfRel Γ sourceEnv + (.ctor address tag sourceFields) (.slotA targetAbs) false + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel Γ.bump.bump sourceEnv + sourceField .shared (.slotA Γ.bump.depth) sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + have hfetch : ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.fetch (.var (Γ.rel targetAbs)) index)) + (GraphOwnsBorrowResultProtected funRel recSelfRel Γ sourceEnv + (.ctor address tag sourceFields) (.slotA targetAbs) false + sourceRest rest slots) + (GraphOwnsFetchedBorrowProtected funRel recSelfRel Γ.bump sourceEnv + (.ctor address tag sourceFields) sourceField + (.slotA targetAbs) (.slotA Γ.depth) false + sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj) := + ProfileFundedEmitStateRunSoundBelow.localZero + (fetchBorrowSlot_value_op + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := Γ) (sourceEnv := sourceEnv) + (address := address) (tag := tag) (targetAbs := targetAbs) + (index := index) (release := false) (sourceRest := sourceRest) + (rest := rest) (slots := slots) hsourceField) + (by simp [localOpOwnershipAllowance]) + have hretain : ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.dup (.var (Γ.bump.rel Γ.depth)))) + (GraphOwnsFetchedBorrowProtected funRel recSelfRel Γ.bump sourceEnv + (.ctor address tag sourceFields) sourceField + (.slotA targetAbs) (.slotA Γ.depth) false + sourceRest rest slots) + (GraphOwnsRetainedProjectionProtected funRel recSelfRel + Γ.bump.bump sourceEnv (.ctor address tag sourceFields) sourceField + (.slotA targetAbs) (.slotA Γ.bump.depth) false + sourceRest rest slots) + (IxIR0.DynamicCost.retain 1) := + ProfileFundedEmitStateRunSoundBelow.localRetain + (retainFetchedBorrow_value_op + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := Γ.bump) + (sourceEnv := sourceEnv) + (sourceTarget := .ctor address tag sourceFields) + (sourceField := sourceField) (targetAbs := targetAbs) + (fieldAbs := Γ.depth) (release := false) + (sourceRest := sourceRest) (rest := rest) (slots := slots)) + (by simp [localOpOwnershipAllowance]) + have hfinish : ProfileFundedEmitStateRunSoundBelow ctx cur limit + (_root_.id : Emit) + (GraphOwnsRetainedProjectionProtected funRel recSelfRel + Γ.bump.bump sourceEnv (.ctor address tag sourceFields) sourceField + (.slotA targetAbs) (.slotA Γ.bump.depth) false + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel Γ.bump.bump sourceEnv + sourceField .shared (.slotA Γ.bump.depth) sourceRest rest slots) + 0 := by + apply ProfileFundedEmitStateRunSoundBelow.id + intro store env hpre + obtain ⟨roots, targetValue, resultValue, hΓ, htarget, hresult, + htargetWorld, htargetGraph, hresultGraph, hrestGraph, + hown, hslots⟩ := hpre + refine ⟨⟨roots, resultValue, hΓ, hresult, hresultGraph, + hrestGraph, ?_⟩, hslots⟩ + simpa [borrowResultRoots] using hown + have hall : ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.fetch (.var (Γ.rel targetAbs)) index) ∘ + (emitOp (.dup (.var (Γ.bump.rel Γ.depth))) ∘ + (_root_.id : Emit))) + (GraphOwnsBorrowResultProtected funRel recSelfRel Γ sourceEnv + (.ctor address tag sourceFields) (.slotA targetAbs) false + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel Γ.bump.bump sourceEnv + sourceField .shared (.slotA Γ.bump.depth) sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj + + (IxIR0.DynamicCost.retain 1 + 0)) := + ProfileFundedEmitStateRunSoundBelow.comp hfetch + (ProfileFundedEmitStateRunSoundBelow.comp hretain hfinish) + have hnormalized : ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.fetch (.var (Γ.rel targetAbs)) index) ∘ + (emitOp (.dup (.var (Γ.bump.rel Γ.depth))) ∘ + (_root_.id : Emit))) + (GraphOwnsBorrowResultProtected funRel recSelfRel Γ sourceEnv + (.ctor address tag sourceFields) (.slotA targetAbs) false + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel Γ.bump.bump sourceEnv + sourceField .shared (.slotA Γ.bump.depth) sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := + ProfileFundedEmitStateRunSoundBelow.of_profile_eq hall (by + ext <;> simp) + intro bound hbound continuation continuationProfile fuel before after env + value hfuel horder henv hpre hrun hcontinuation + exact hnormalized bound hbound hfuel horder henv hpre hrun hcontinuation + +/-- Target-fuel-bounded exact state-indexed fetch/retain/drop suffix for a final-use projection +target. The destructive drop transports every surviving graph through the +resulting store restriction. -/ +theorem projectionSlotReleased_profileFundedEmitStateRunSound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {address : Ixon.Address} + {tag : Nat} {sourceFields : List IxIR0.Value} + {sourceField : IxIR0.Value} {targetAbs index : Nat} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} {slots : List (Nat × RVal)} + (hsourceField : sourceFields[index]? = some sourceField) : + ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.fetch (.var (Γ.rel targetAbs)) index) ∘ + emitOp (.dup (.var (Γ.bump.rel Γ.depth))) ∘ + emitOp (.drop (.var (Γ.bump.bump.rel targetAbs)))) + (GraphOwnsBorrowResultProtected funRel recSelfRel Γ sourceEnv + (.ctor address tag sourceFields) (.slotA targetAbs) true + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel Γ.bump.bump.bump + sourceEnv sourceField .shared (.slotA Γ.bump.depth) + sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + have hfetch : ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.fetch (.var (Γ.rel targetAbs)) index)) + (GraphOwnsBorrowResultProtected funRel recSelfRel Γ sourceEnv + (.ctor address tag sourceFields) (.slotA targetAbs) true + sourceRest rest slots) + (GraphOwnsFetchedBorrowProtected funRel recSelfRel Γ.bump sourceEnv + (.ctor address tag sourceFields) sourceField + (.slotA targetAbs) (.slotA Γ.depth) true + sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj) := + ProfileFundedEmitStateRunSoundBelow.localZero + (fetchBorrowSlot_value_op + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := Γ) (sourceEnv := sourceEnv) + (address := address) (tag := tag) (targetAbs := targetAbs) + (index := index) (release := true) (sourceRest := sourceRest) + (rest := rest) (slots := slots) hsourceField) + (by simp [localOpOwnershipAllowance]) + have hretain : ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.dup (.var (Γ.bump.rel Γ.depth)))) + (GraphOwnsFetchedBorrowProtected funRel recSelfRel Γ.bump sourceEnv + (.ctor address tag sourceFields) sourceField + (.slotA targetAbs) (.slotA Γ.depth) true + sourceRest rest slots) + (GraphOwnsRetainedProjectionProtected funRel recSelfRel + Γ.bump.bump sourceEnv (.ctor address tag sourceFields) sourceField + (.slotA targetAbs) (.slotA Γ.bump.depth) true + sourceRest rest slots) + (IxIR0.DynamicCost.retain 1) := + ProfileFundedEmitStateRunSoundBelow.localRetain + (retainFetchedBorrow_value_op + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := Γ.bump) + (sourceEnv := sourceEnv) + (sourceTarget := .ctor address tag sourceFields) + (sourceField := sourceField) (targetAbs := targetAbs) + (fieldAbs := Γ.depth) (release := true) + (sourceRest := sourceRest) (rest := rest) (slots := slots)) + (by simp [localOpOwnershipAllowance]) + have hdrop : ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.drop (.var (Γ.bump.bump.rel targetAbs)))) + (GraphOwnsRetainedProjectionProtected funRel recSelfRel + Γ.bump.bump sourceEnv (.ctor address tag sourceFields) sourceField + (.slotA targetAbs) (.slotA Γ.bump.depth) true + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel Γ.bump.bump.bump + sourceEnv sourceField .shared (.slotA Γ.bump.depth) + sourceRest rest slots) + 0 := + ProfileFundedEmitStateRunSoundBelow.localZero + (releaseRetainedProjection_value_op + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := Γ.bump.bump) + (sourceEnv := sourceEnv) + (sourceTarget := .ctor address tag sourceFields) + (sourceField := sourceField) (targetAbs := targetAbs) + (resultAbs := Γ.bump.depth) (sourceRest := sourceRest) + (rest := rest) (slots := slots)) + (by simp [localOpOwnershipAllowance]) + have hall : ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.fetch (.var (Γ.rel targetAbs)) index) ∘ + (emitOp (.dup (.var (Γ.bump.rel Γ.depth))) ∘ + emitOp (.drop (.var (Γ.bump.bump.rel targetAbs))))) + (GraphOwnsBorrowResultProtected funRel recSelfRel Γ sourceEnv + (.ctor address tag sourceFields) (.slotA targetAbs) true + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel Γ.bump.bump.bump + sourceEnv sourceField .shared (.slotA Γ.bump.depth) + sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj + + (IxIR0.DynamicCost.retain 1 + 0)) := + ProfileFundedEmitStateRunSoundBelow.comp hfetch + (ProfileFundedEmitStateRunSoundBelow.comp hretain hdrop) + have hnormalized : ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.fetch (.var (Γ.rel targetAbs)) index) ∘ + (emitOp (.dup (.var (Γ.bump.rel Γ.depth))) ∘ + emitOp (.drop (.var (Γ.bump.bump.rel targetAbs))))) + (GraphOwnsBorrowResultProtected funRel recSelfRel Γ sourceEnv + (.ctor address tag sourceFields) (.slotA targetAbs) true + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel Γ.bump.bump.bump + sourceEnv sourceField .shared (.slotA Γ.bump.depth) + sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := + ProfileFundedEmitStateRunSoundBelow.of_profile_eq hall (by + ext <;> simp) + intro bound hbound continuation continuationProfile fuel before after env + value hfuel horder henv hpre hrun hcontinuation + exact hnormalized bound hbound hfuel horder henv hpre hrun hcontinuation + +/-- Target-fuel-bounded profiled erased-borrow finish. The target identity suffix is free, while +the source projection event and conservative retain candidate remain in the +trace. -/ +theorem LowerBorrowProfileSoundBelow.returnErased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {emit : Emit} {release : Bool} {sourceProfile : SourceProfile} + (hsound : LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput .erased emit + (.constA .erased) release sourceProfile) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceInput sourceOutput .erased .shared emit (.constA .erased) + (sourceProfile + IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + have hvalue : LowerResultValueSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput .erased .shared + (emit ∘ (_root_.id : Emit)) (.constA .erased) := by + simpa [Function.comp_def] using + hsound.toLowerBorrowValueSound.returnErased + have hsuffix : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSoundBelow ctx cur limit (_root_.id : Emit) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput .erased (.constA .erased) release + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output sourceOutput + .erased .shared (.constA .erased) sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + intro sourceRest rest slots + apply ProfileFundedEmitStateRunSoundBelow.monoProfile + · apply ProfileFundedEmitStateRunSoundBelow.id + intro store env hpre + obtain ⟨roots, value, houtput, hav, hworld, hvalueGraph, + hrestGraph, hown, hslots⟩ := hpre + refine ⟨⟨roots, value, houtput, hav, hvalueGraph, + hrestGraph, ?_⟩, hslots⟩ + cases release with + | false => + simpa [borrowResultRoots] using + hown.addNoLocation + (hsound.stable.const_noLocation hav) + | true => simpa [borrowResultRoots] using hown + · exact zeroOwnershipAllowance_le_profile _ + have hcombined : LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput .erased .shared + (emit ∘ (_root_.id : Emit)) (.constA .erased) + (sourceProfile + + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1)) := + hsound.thenResult hvalue hsuffix + have hnormalized := hcombined.of_profile_eq + (IxIR0.DynamicCost.Profile.add_assoc sourceProfile + (IxIR0.DynamicCost.tick .evalProj) + (IxIR0.DynamicCost.retain 1)).symm + simpa [Function.comp_def] using hnormalized + +/-- At a target-fuel bound, a constructor source value cannot realize the erased scalar descriptor. +The profiled target identity branch is therefore vacuous at the exact state +boundary. -/ +theorem LowerBorrowProfileSoundBelow.projectCtorErased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {address : Ixon.Address} {tag : Nat} + {sourceFields : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {release : Bool} {sourceProfile : SourceProfile} + (hsound : LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput + (.ctor address tag sourceFields) emit (.constA .erased) release + sourceProfile) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceInput sourceOutput sourceValue .shared emit (.constA .erased) + (sourceProfile + IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + have hvalue : LowerResultValueSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceValue .shared + (emit ∘ (_root_.id : Emit)) (.constA .erased) := by + simpa [Function.comp_def] using + hsound.toLowerBorrowValueSound.projectCtorErased + have hsuffix : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSoundBelow ctx cur limit (_root_.id : Emit) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput (.ctor address tag sourceFields) (.constA .erased) + release sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output sourceOutput + sourceValue .shared (.constA .erased) sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + intro sourceRest rest slots + apply ProfileFundedEmitStateRunSoundBelow.monoProfile + · apply ProfileFundedEmitStateRunSoundBelow.id + intro store env hpre + obtain ⟨roots, value, houtput, hav, hworld, htargetGraph, + hrestGraph, hown, hslots⟩ := hpre + cases hav with + | const hresolve => + simp only [resolveAtom] at hresolve + have hvalue : RVal.erased = value := Except.ok.inj hresolve + subst value + cases htargetGraph + · exact zeroOwnershipAllowance_le_profile _ + have hcombined : LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceValue .shared + (emit ∘ (_root_.id : Emit)) (.constA .erased) + (sourceProfile + + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1)) := + hsound.thenResult hvalue hsuffix + have hnormalized := hcombined.of_profile_eq + (IxIR0.DynamicCost.Profile.add_assoc sourceProfile + (IxIR0.DynamicCost.tick .evalProj) + (IxIR0.DynamicCost.retain 1)).symm + simpa [Function.comp_def] using hnormalized + +/-- Target-fuel-bounded profiled scalar-target projection. Stable literals and erased constants +cannot satisfy `fetch`, so the exact state transformer closes by the exposed +operation-level contradiction. -/ +theorem LowerBorrowProfileSoundBelow.projectConst + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceTarget sourceValue : IxIR0.Value} + {emit : Emit} {atom : Atom} {index : Nat} {release : Bool} + {sourceProfile : SourceProfile} + (hsound : LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceTarget emit + (.constA atom) release sourceProfile) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output.bump + sourceInput sourceOutput sourceValue .shared + (emit ∘ emitOp (.fetch atom index)) (.slotA output.depth) + (sourceProfile + IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + have hvalue := hsound.toLowerBorrowValueSound.projectConst + (sourceValue := sourceValue) (index := index) + have hsuffix : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.fetch atom index)) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput sourceTarget (.constA atom) release + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump + sourceOutput sourceValue .shared (.slotA output.depth) + sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + intro sourceRest rest slots + apply ProfileFundedEmitStateRunSoundBelow.localZero + · intro fuel store env store' result hpre hrun + exact (fetchStableConst_false_op hsound.stable hpre hrun).elim + · simp [localOpOwnershipAllowance] + have hcombined : LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit + input output.bump sourceInput sourceOutput sourceValue .shared + (emit ∘ emitOp (.fetch atom index)) (.slotA output.depth) + (sourceProfile + + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1)) := + hsound.thenResult hvalue hsuffix + exact hcombined.of_profile_eq + (IxIR0.DynamicCost.Profile.add_assoc sourceProfile + (IxIR0.DynamicCost.tick .evalProj) + (IxIR0.DynamicCost.retain 1)).symm + +/-- Target-fuel-bounded profiled projection through a retained slot. -/ +theorem LowerBorrowProfileSoundBelow.projectSlotKept + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {address : Ixon.Address} {tag : Nat} + {sourceFields : List IxIR0.Value} {sourceField : IxIR0.Value} + {emit : Emit} {targetAbs index : Nat} {sourceProfile : SourceProfile} + (hsound : LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput + (.ctor address tag sourceFields) emit (.slotA targetAbs) false + sourceProfile) + (hsourceField : sourceFields[index]? = some sourceField) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + output.bump.bump sourceInput sourceOutput sourceField .shared + (emit ∘ emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth)))) + (.slotA output.bump.depth) + (sourceProfile + IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + have hvalue := hsound.toLowerBorrowValueSound.projectSlotKept + hsourceField + have hsuffix : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth)))) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput (.ctor address tag sourceFields) + (.slotA targetAbs) false sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump.bump + sourceOutput sourceField .shared (.slotA output.bump.depth) + sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + intro sourceRest rest slots + exact projectionSlotKept_profileFundedEmitStateRunSound_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output) + (sourceEnv := sourceOutput) (address := address) (tag := tag) + (targetAbs := targetAbs) (index := index) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + hsourceField + have hcombined : LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit + input output.bump.bump sourceInput sourceOutput sourceField .shared + (emit ∘ + (emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth))))) + (.slotA output.bump.depth) + (sourceProfile + + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1)) := + hsound.thenResult hvalue hsuffix + exact hcombined.of_profile_eq + (IxIR0.DynamicCost.Profile.add_assoc sourceProfile + (IxIR0.DynamicCost.tick .evalProj) + (IxIR0.DynamicCost.retain 1)).symm + +/-- Target-fuel-bounded profiled projection through a final-use slot. -/ +theorem LowerBorrowProfileSoundBelow.projectSlotReleased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {address : Ixon.Address} {tag : Nat} + {sourceFields : List IxIR0.Value} {sourceField : IxIR0.Value} + {emit : Emit} {targetAbs index : Nat} {sourceProfile : SourceProfile} + (hsound : LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput + (.ctor address tag sourceFields) emit (.slotA targetAbs) true + sourceProfile) + (hsourceField : sourceFields[index]? = some sourceField) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + output.bump.bump.bump sourceInput sourceOutput sourceField .shared + (emit ∘ emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth))) ∘ + emitOp (.drop (.var (output.bump.bump.rel targetAbs)))) + (.slotA output.bump.depth) + (sourceProfile + IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + have hvalue := hsound.toLowerBorrowValueSound.projectSlotReleased + hsourceField + have hsuffix : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth))) ∘ + emitOp (.drop (.var (output.bump.bump.rel targetAbs)))) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput (.ctor address tag sourceFields) + (.slotA targetAbs) true sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump.bump.bump + sourceOutput sourceField .shared (.slotA output.bump.depth) + sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + intro sourceRest rest slots + exact projectionSlotReleased_profileFundedEmitStateRunSound_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output) + (sourceEnv := sourceOutput) (address := address) (tag := tag) + (targetAbs := targetAbs) (index := index) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + hsourceField + have hcombined : LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit + input output.bump.bump.bump sourceInput sourceOutput sourceField + .shared + (emit ∘ + (emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth))) ∘ + emitOp (.drop (.var (output.bump.bump.rel targetAbs))))) + (.slotA output.bump.depth) + (sourceProfile + + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1)) := + hsound.thenResult hvalue hsuffix + exact hcombined.of_profile_eq + (IxIR0.DynamicCost.Profile.add_assoc sourceProfile + (IxIR0.DynamicCost.tick .evalProj) + (IxIR0.DynamicCost.retain 1)).symm + +/-- Target-fuel-bounded profiled erased-source projection through a retained slot. The fetch +cannot execute, so the exact-run suffix closes at its false midpoint. -/ +theorem LowerBorrowProfileSoundBelow.projectSlotKeptErased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} + {emit : Emit} {targetAbs index : Nat} {sourceProfile : SourceProfile} + (hsound : LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput .erased emit + (.slotA targetAbs) false sourceProfile) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + output.bump.bump sourceInput sourceOutput sourceValue .shared + (emit ∘ emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth)))) + (.slotA output.bump.depth) + (sourceProfile + IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + have hvalue := hsound.toLowerBorrowValueSound.projectSlotKeptErased + (sourceValue := sourceValue) (index := index) + have hsuffix : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth)))) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput .erased (.slotA targetAbs) false + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump.bump + sourceOutput sourceValue .shared (.slotA output.bump.depth) + sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + intro sourceRest rest slots + apply falseAfterProjectionFetch_profileFundedEmitStateRunSound_below + · exact fetchErasedSlot_false_op + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output) + (sourceEnv := sourceOutput) (targetAbs := targetAbs) + (index := index) (release := false) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + · simp [localOpOwnershipAllowance] + have hcombined : LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit + input output.bump.bump sourceInput sourceOutput sourceValue .shared + (emit ∘ + (emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth))))) + (.slotA output.bump.depth) + (sourceProfile + + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1)) := + hsound.thenResult hvalue hsuffix + exact hcombined.of_profile_eq + (IxIR0.DynamicCost.Profile.add_assoc sourceProfile + (IxIR0.DynamicCost.tick .evalProj) + (IxIR0.DynamicCost.retain 1)).symm + +/-- Target-fuel-bounded profiled erased-source projection through a final-use slot. -/ +theorem LowerBorrowProfileSoundBelow.projectSlotReleasedErased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} + {emit : Emit} {targetAbs index : Nat} {sourceProfile : SourceProfile} + (hsound : LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput .erased emit + (.slotA targetAbs) true sourceProfile) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + output.bump.bump.bump sourceInput sourceOutput sourceValue .shared + (emit ∘ emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth))) ∘ + emitOp (.drop (.var (output.bump.bump.rel targetAbs)))) + (.slotA output.bump.depth) + (sourceProfile + IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + have hvalue := hsound.toLowerBorrowValueSound.projectSlotReleasedErased + (sourceValue := sourceValue) (index := index) + have hsuffix : ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth))) ∘ + emitOp (.drop (.var (output.bump.bump.rel targetAbs)))) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput .erased (.slotA targetAbs) true + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump.bump.bump + sourceOutput sourceValue .shared (.slotA output.bump.depth) + sourceRest rest slots) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + intro sourceRest rest slots + apply falseAfterProjectionFetch_profileFundedEmitStateRunSound_below + · exact fetchErasedSlot_false_op + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output) + (sourceEnv := sourceOutput) (targetAbs := targetAbs) + (index := index) (release := true) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + · simp [localOpOwnershipAllowance] + have hcombined : LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit + input output.bump.bump.bump sourceInput sourceOutput sourceValue + .shared + (emit ∘ + (emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth))) ∘ + emitOp (.drop (.var (output.bump.bump.rel targetAbs))))) + (.slotA output.bump.depth) + (sourceProfile + + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1)) := + hsound.thenResult hvalue hsuffix + exact hcombined.of_profile_eq + (IxIR0.DynamicCost.Profile.add_assoc sourceProfile + (IxIR0.DynamicCost.tick .evalProj) + (IxIR0.DynamicCost.retain 1)).symm + +/-- A scalar projection emits only the zero-cost fetch. The projection +event and retain candidate are still kept in the source fragment so this +contract has the same interface as the slot-producing branches. -/ +theorem projectionFetch_profileFundedOwnershipCostSound + (ctx : Ctx) (cur : FnDef) (atom : Atom) (index : Nat) : + ProfileFundedEmitOwnershipCostSound ctx cur + (emitOp (.fetch atom index)) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := + ProfileFundedEmitOwnershipCostSound.localZero + (by simp [localOpOwnershipAllowance]) + +/-- Fetching a field and retaining its shared owner consumes precisely the +local ownership-relevant part of a source projection profile. -/ +theorem projectionSlotKept_profileFundedOwnershipCostSound + (ctx : Ctx) (cur : FnDef) (target field : Atom) (index : Nat) : + ProfileFundedEmitOwnershipCostSound ctx cur + (emitOp (.fetch target index) ∘ emitOp (.dup field)) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + exact ProfileFundedEmitOwnershipCostSound.comp + (ProfileFundedEmitOwnershipCostSound.localZero + (profile := IxIR0.DynamicCost.tick .evalProj) + (by simp [localOpOwnershipAllowance])) + (ProfileFundedEmitOwnershipCostSound.localRetain + (by simp [localOpOwnershipAllowance])) + +/-- Releasing a final-use projection target adds a zero-cost deep drop after +the fetch-and-retain suffix, so it needs no extra source charge. -/ +theorem projectionSlotReleased_profileFundedOwnershipCostSound + (ctx : Ctx) (cur : FnDef) (target field owner : Atom) (index : Nat) : + ProfileFundedEmitOwnershipCostSound ctx cur + (emitOp (.fetch target index) ∘ emitOp (.dup field) ∘ + emitOp (.drop owner)) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + have hfetch : ProfileFundedEmitOwnershipCostSound ctx cur + (emitOp (.fetch target index)) + (IxIR0.DynamicCost.tick .evalProj) := + ProfileFundedEmitOwnershipCostSound.localZero + (by simp [localOpOwnershipAllowance]) + have hdup : ProfileFundedEmitOwnershipCostSound ctx cur + (emitOp (.dup field)) (IxIR0.DynamicCost.retain 1) := + ProfileFundedEmitOwnershipCostSound.localRetain + (by simp [localOpOwnershipAllowance]) + have hdrop : ProfileFundedEmitOwnershipCostSound ctx cur + (emitOp (.drop owner)) 0 := + ProfileFundedEmitOwnershipCostSound.of_zero + (EmitOwnershipCostSound.localOp + (by simp [localOpOwnershipAllowance])) + have htail := ProfileFundedEmitOwnershipCostSound.of_profile_eq + (ProfileFundedEmitOwnershipCostSound.comp hdup hdrop) + (IxIR0.DynamicCost.Profile.add_zero _) + exact ProfileFundedEmitOwnershipCostSound.comp hfetch htail + +/-- Dynamic exact-run scalar-projection suffix. -/ +theorem projectionFetch_profileFundedEmitRunSound + (ctx : Ctx) (cur : FnDef) (atom : Atom) (index : Nat) : + ProfileFundedEmitRunSound ctx cur + (emitOp (.fetch atom index)) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := + ProfileFundedEmitRunSound.localZero + (by simp [localOpOwnershipAllowance]) + +/-- Dynamic exact-run retained-slot projection suffix. -/ +theorem projectionSlotKept_profileFundedEmitRunSound + (ctx : Ctx) (cur : FnDef) (target field : Atom) (index : Nat) : + ProfileFundedEmitRunSound ctx cur + (emitOp (.fetch target index) ∘ emitOp (.dup field)) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + exact ProfileFundedEmitRunSound.comp + (ProfileFundedEmitRunSound.localZero + (profile := IxIR0.DynamicCost.tick .evalProj) + (by simp [localOpOwnershipAllowance])) + (ProfileFundedEmitRunSound.localRetain + (by simp [localOpOwnershipAllowance])) + +/-- Dynamic exact-run released-slot projection suffix. -/ +theorem projectionSlotReleased_profileFundedEmitRunSound + (ctx : Ctx) (cur : FnDef) (target field owner : Atom) (index : Nat) : + ProfileFundedEmitRunSound ctx cur + (emitOp (.fetch target index) ∘ emitOp (.dup field) ∘ + emitOp (.drop owner)) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + have hfetch : ProfileFundedEmitRunSound ctx cur + (emitOp (.fetch target index)) + (IxIR0.DynamicCost.tick .evalProj) := + ProfileFundedEmitRunSound.localZero + (by simp [localOpOwnershipAllowance]) + have hdup : ProfileFundedEmitRunSound ctx cur + (emitOp (.dup field)) (IxIR0.DynamicCost.retain 1) := + ProfileFundedEmitRunSound.localRetain + (by simp [localOpOwnershipAllowance]) + have hdrop : ProfileFundedEmitRunSound ctx cur + (emitOp (.drop owner)) 0 := by + apply ProfileFundedEmitRunSound.of_zero + exact ProfileFundedEmitRunSound.localZero + (by simp [localOpOwnershipAllowance]) + have htail : ProfileFundedEmitRunSound ctx cur + (emitOp (.dup field) ∘ emitOp (.drop owner)) + (IxIR0.DynamicCost.retain 1) := by + apply ProfileFundedEmitRunSound.of_profile_eq + (ProfileFundedEmitRunSound.comp hdup hdrop) + exact IxIR0.DynamicCost.Profile.add_zero _ + intro continuation continuationProfile fuel before after env value horder + henv hrun hcontinuation + exact (ProfileFundedEmitRunSound.comp hfetch htail) + horder henv hrun hcontinuation + +/-- Projection lowering preserves an arbitrary recursively funded borrowing +prefix and appends the exact local source projection fragment. This mirrors +the compiler induction boundary: the caller supplies the cost proof for the +specific successful `lowerBorrow` sub-run. -/ +theorem lowerE_proj_profileFundedOwnershipCostSound + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Ixon.Owned} {index : Nat} + {source : IxIR0.Expr} {sourceProfile : SourceProfile} + {emit : Emit} {value : AVal} {state finalState : LowSt} + (hborrow : ∀ {borrowOutput : VEnv} {borrowEmit : Emit} + {borrowed : AVal} {release : Bool} {middleState : LowSt}, + (lowerBorrow src fuel input source).run state = + .ok (borrowOutput, borrowEmit, borrowed, release) middleState → + ProfileFundedEmitOwnershipCostSound ctx cur borrowEmit sourceProfile) + (hrun : (lowerE src (fuel + 1) input world + (.proj index source)).run state = + .ok (output, emit, value) finalState) : + ProfileFundedEmitOwnershipCostSound ctx cur emit + (sourceProfile + IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + have finish {borrowEmit suffix : Emit} + (hprefix : ProfileFundedEmitOwnershipCostSound ctx cur borrowEmit + sourceProfile) + (hsuffix : ProfileFundedEmitOwnershipCostSound ctx cur suffix + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1)) : + ProfileFundedEmitOwnershipCostSound ctx cur (borrowEmit ∘ suffix) + (sourceProfile + IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + exact ProfileFundedEmitOwnershipCostSound.of_profile_eq + (ProfileFundedEmitOwnershipCostSound.comp hprefix hsuffix) + (IxIR0.DynamicCost.Profile.add_assoc _ _ _).symm + cases world with + | unique => + have huuEq : + (Ixon.Owned.unique == Ixon.Owned.unique) = true := by decide + simp only [lowerE, huuEq, if_true] at hrun + exact (stateThrowRun_not_ok hrun).elim + | shared => + have hsuEq : + (Ixon.Owned.shared == Ixon.Owned.unique) = false := by decide + simp only [lowerE, hsuEq, Bool.false_eq_true, if_false] at hrun + obtain ⟨borrowResult, middleState, hborrowRun, hafterBorrow⟩ := + stateBindRun_ok_inv hrun + rcases borrowResult with + ⟨borrowOutput, borrowEmit, borrowed, release⟩ + have hprefix := hborrow hborrowRun + cases borrowed with + | constA atom => + cases atom with + | var relative => + have hpure : + (borrowOutput.bump, + borrowEmit ∘ + emitOp (.fetch (.var relative) index), + AVal.slotA borrowOutput.depth) = + (output, emit, value) ∧ + middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact finish hprefix + (projectionFetch_profileFundedOwnershipCostSound + ctx cur (.var relative) index) + | lit literal => + have hpure : + (borrowOutput.bump, + borrowEmit ∘ + emitOp (.fetch (.lit literal) index), + AVal.slotA borrowOutput.depth) = + (output, emit, value) ∧ + middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact finish hprefix + (projectionFetch_profileFundedOwnershipCostSound + ctx cur (.lit literal) index) + | erased => + have hpure : + (borrowOutput, borrowEmit, AVal.constA .erased) = + (output, emit, value) ∧ + middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + have hid : ProfileFundedEmitOwnershipCostSound ctx cur + (_root_.id : Emit) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := + ProfileFundedEmitOwnershipCostSound.of_zero + EmitOwnershipCostSound.id + simpa [Function.comp_def] using finish hprefix hid + | slotA targetAbs => + cases release with + | false => + have hpure : + (borrowOutput.bump.bump, + borrowEmit ∘ + emitOp (.fetch + (.var (borrowOutput.rel targetAbs)) index) ∘ + emitOp (.dup (.var + (borrowOutput.bump.rel borrowOutput.depth))), + AVal.slotA borrowOutput.bump.depth) = + (output, emit, value) ∧ + middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact finish hprefix + (projectionSlotKept_profileFundedOwnershipCostSound + ctx cur (.var (borrowOutput.rel targetAbs)) + (.var (borrowOutput.bump.rel borrowOutput.depth)) index) + | true => + have hpure : + (borrowOutput.bump.bump.bump, + borrowEmit ∘ + emitOp (.fetch + (.var (borrowOutput.rel targetAbs)) index) ∘ + emitOp (.dup (.var + (borrowOutput.bump.rel borrowOutput.depth))) ∘ + emitOp (.drop (.var + (borrowOutput.bump.bump.rel targetAbs))), + AVal.slotA borrowOutput.bump.depth) = + (output, emit, value) ∧ + middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact finish hprefix + (projectionSlotReleased_profileFundedOwnershipCostSound + ctx cur (.var (borrowOutput.rel targetAbs)) + (.var (borrowOutput.bump.rel borrowOutput.depth)) + (.var (borrowOutput.bump.bump.rel targetAbs)) index) + +/-- Exact-run projection lowering composes the recursively funded borrow +prefix with the local fetch/retain/drop suffix. Only the continuation run +actually reached by the generated prefix is required. -/ +theorem lowerE_proj_profileFundedEmitRunSound + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Ixon.Owned} {index : Nat} + {source : IxIR0.Expr} {sourceProfile : SourceProfile} + {emit : Emit} {value : AVal} {state finalState : LowSt} + (hborrow : ∀ {borrowOutput : VEnv} {borrowEmit : Emit} + {borrowed : AVal} {release : Bool} {middleState : LowSt}, + (lowerBorrow src fuel input source).run state = + .ok (borrowOutput, borrowEmit, borrowed, release) middleState → + ProfileFundedEmitRunSound ctx cur borrowEmit sourceProfile) + (hrun : (lowerE src (fuel + 1) input world + (.proj index source)).run state = + .ok (output, emit, value) finalState) : + ProfileFundedEmitRunSound ctx cur emit + (sourceProfile + IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + intro continuation continuationProfile runFuel before after runtimeEnv + result horder hbounds hcodeRun hcontinuation + have finish {borrowEmit suffix : Emit} + (hprefix : ProfileFundedEmitRunSound ctx cur borrowEmit sourceProfile) + (hsuffix : ProfileFundedEmitRunSound ctx cur suffix + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1)) + (hcomposedRun : runCode ctx runFuel cur before runtimeEnv + ((borrowEmit ∘ suffix) continuation) = .ok (after, result)) : + ProfileFundedCodeRun ctx runFuel cur before runtimeEnv + ((borrowEmit ∘ suffix) continuation) after result + ((sourceProfile + IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) + continuationProfile) := by + have hcombined : ProfileFundedEmitRunSound ctx cur + (borrowEmit ∘ suffix) + (sourceProfile + IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + apply ProfileFundedEmitRunSound.of_profile_eq + (ProfileFundedEmitRunSound.comp hprefix hsuffix) + exact (IxIR0.DynamicCost.Profile.add_assoc _ _ _).symm + exact hcombined horder hbounds hcomposedRun hcontinuation + cases world with + | unique => + have huuEq : + (Ixon.Owned.unique == Ixon.Owned.unique) = true := by decide + simp only [lowerE, huuEq, if_true] at hrun + exact (stateThrowRun_not_ok hrun).elim + | shared => + have hsuEq : + (Ixon.Owned.shared == Ixon.Owned.unique) = false := by decide + simp only [lowerE, hsuEq, Bool.false_eq_true, if_false] at hrun + obtain ⟨borrowResult, middleState, hborrowRun, hafterBorrow⟩ := + stateBindRun_ok_inv hrun + rcases borrowResult with + ⟨borrowOutput, borrowEmit, borrowed, release⟩ + have hprefix : ProfileFundedEmitRunSound ctx cur borrowEmit + sourceProfile := + hborrow hborrowRun + cases borrowed with + | constA atom => + cases atom with + | var relative => + have hpure : + (borrowOutput.bump, + borrowEmit ∘ + emitOp (.fetch (.var relative) index), + AVal.slotA borrowOutput.depth) = + (output, emit, value) ∧ + middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact finish hprefix + (projectionFetch_profileFundedEmitRunSound + ctx cur (.var relative) index) + hcodeRun + | lit literal => + have hpure : + (borrowOutput.bump, + borrowEmit ∘ + emitOp (.fetch (.lit literal) index), + AVal.slotA borrowOutput.depth) = + (output, emit, value) ∧ + middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact finish hprefix + (projectionFetch_profileFundedEmitRunSound + ctx cur (.lit literal) index) + hcodeRun + | erased => + have hpure : + (borrowOutput, borrowEmit, AVal.constA .erased) = + (output, emit, value) ∧ + middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + have hid : ProfileFundedEmitRunSound ctx cur + (_root_.id : Emit) + (IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + apply ProfileFundedEmitRunSound.of_zero + exact ProfileFundedEmitRunSound.id + have hcomposedRun : runCode ctx runFuel cur before runtimeEnv + ((emit ∘ (_root_.id : Emit)) continuation) = + .ok (after, result) := by + simpa [Function.comp_def] using hcodeRun + simpa [Function.comp_def] using + (finish hprefix hid hcomposedRun) + | slotA targetAbs => + cases release with + | false => + have hpure : + (borrowOutput.bump.bump, + borrowEmit ∘ + emitOp (.fetch + (.var (borrowOutput.rel targetAbs)) index) ∘ + emitOp (.dup (.var + (borrowOutput.bump.rel borrowOutput.depth))), + AVal.slotA borrowOutput.bump.depth) = + (output, emit, value) ∧ + middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact finish hprefix + (projectionSlotKept_profileFundedEmitRunSound + ctx cur (.var (borrowOutput.rel targetAbs)) + (.var (borrowOutput.bump.rel borrowOutput.depth)) index) + hcodeRun + | true => + have hpure : + (borrowOutput.bump.bump.bump, + borrowEmit ∘ + emitOp (.fetch + (.var (borrowOutput.rel targetAbs)) index) ∘ + emitOp (.dup (.var + (borrowOutput.bump.rel borrowOutput.depth))) ∘ + emitOp (.drop (.var + (borrowOutput.bump.bump.rel targetAbs))), + AVal.slotA borrowOutput.bump.depth) = + (output, emit, value) ∧ + middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact finish hprefix + (projectionSlotReleased_profileFundedEmitRunSound + ctx cur (.var (borrowOutput.rel targetAbs)) + (.var (borrowOutput.bump.rel borrowOutput.depth)) + (.var (borrowOutput.bump.bump.rel targetAbs)) index) + hcodeRun + +/-- Complete semantic/profile projection branch of the executable lowerer. +The recursive borrow premise and the source `SourceProject` witness are +consumed together, so every successful compiler branch carries its exact +state-indexed target cost. -/ +theorem lowerE_proj_run_profile_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Ixon.Owned} {index : Nat} + {source : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + {sourceTarget sourceValue : IxIR0.Value} + {sourceProfile : SourceProfile} + (hborrow : ∀ {borrowOutput : VEnv} {borrowEmit : Emit} + {borrowed : AVal} {release : Bool} {middleState : LowSt}, + (lowerBorrow src fuel input source).run state = + .ok (borrowOutput, borrowEmit, borrowed, release) middleState → + LowerBorrowProfileSound funRel recSelfRel ctx cur input borrowOutput + sourceEnv sourceEnv sourceTarget borrowEmit borrowed release + sourceProfile) + (hproject : SourceProject index sourceTarget sourceValue) + (hrun : (lowerE src (fuel + 1) input world + (.proj index source)).run state = + .ok (output, emit, av) finalState) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue world emit av + (sourceProfile + IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + exact lowerE_proj_run_sound_core + (BorrowResult := fun borrowOutput borrowEmit borrowed release _ => + LowerBorrowProfileSound funRel recSelfRel ctx cur input borrowOutput + sourceEnv sourceEnv sourceTarget borrowEmit borrowed release + sourceProfile) + (ProjectionResult := fun projectionWorld projectionOutput projectionEmit + projectionAv _ => + LowerResultProfileSound funRel recSelfRel ctx cur input projectionOutput + sourceEnv sourceEnv sourceValue projectionWorld projectionEmit + projectionAv (sourceProfile + IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1)) + (hborrow := fun hsubrun => hborrow hsubrun) + (hvar := fun hsound => by cases hsound.stable) + (hlit := fun hsound => hsound.projectConst) + (herased := fun hsound => by + cases hproject with + | ctor hfield => exact hsound.projectCtorErased + | erased => exact hsound.returnErased) + (hslotKept := fun hsound => by + cases hproject with + | ctor hfield => exact hsound.projectSlotKept hfield + | erased => exact hsound.projectSlotKeptErased) + (hslotReleased := fun hsound => by + cases hproject with + | ctor hfield => exact hsound.projectSlotReleased hfield + | erased => exact hsound.projectSlotReleasedErased) + hrun +theorem lowerE_proj_run_profile_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Ixon.Owned} {index : Nat} + {source : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + {sourceTarget sourceValue : IxIR0.Value} + {sourceProfile : SourceProfile} + (hborrow : ∀ {borrowOutput : VEnv} {borrowEmit : Emit} + {borrowed : AVal} {release : Bool} {middleState : LowSt}, + (lowerBorrow src fuel input source).run state = + .ok (borrowOutput, borrowEmit, borrowed, release) middleState → + LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit input borrowOutput + sourceEnv sourceEnv sourceTarget borrowEmit borrowed release + sourceProfile) + (hproject : SourceProject index sourceTarget sourceValue) + (hrun : (lowerE src (fuel + 1) input world + (.proj index source)).run state = + .ok (output, emit, av) finalState) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue world emit av + (sourceProfile + IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + exact lowerE_proj_run_sound_core + (BorrowResult := fun borrowOutput borrowEmit borrowed release _ => + LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit input + borrowOutput sourceEnv sourceEnv sourceTarget borrowEmit borrowed + release sourceProfile) + (ProjectionResult := fun projectionWorld projectionOutput projectionEmit + projectionAv _ => + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + projectionOutput sourceEnv sourceEnv sourceValue projectionWorld + projectionEmit projectionAv + (sourceProfile + IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1)) + (hborrow := fun hsubrun => hborrow hsubrun) + (hvar := fun hsound => by cases hsound.stable) + (hlit := fun hsound => hsound.projectConst) + (herased := fun hsound => by + cases hproject with + | ctor hfield => exact hsound.projectCtorErased + | erased => exact hsound.returnErased) + (hslotKept := fun hsound => by + cases hproject with + | ctor hfield => exact hsound.projectSlotKept hfield + | erased => exact hsound.projectSlotKeptErased) + (hslotReleased := fun hsound => by + cases hproject with + | ctor hfield => exact hsound.projectSlotReleased hfield + | erased => exact hsound.projectSlotReleasedErased) + hrun +/-- Shared source/run dispatcher for complete profiled expression semantics. +The dependent result family retains exact source profiles while variable, +lambda, let, projection, literal, and erased inversion plus standalone-ref +and application-to-spine conversion remain canonical. -/ +private theorem lowerE_run_profile_core + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {fuel : Nat} + {state finalState : LowSt} {input output : VEnv} + {world : Ixon.Owned} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {profile : SourceProfile} + {emit : Emit} {av : AVal} + {Result : IxIR0.Value → SourceProfile → Prop} + (hvar : ∀ (index : Nat) {result : IxIR0.Value}, + sourceEnv[index]? = some result → + (lowerE src (fuel + 1) input world (.var index)).run state = + .ok (output, emit, av) finalState → + Result result + (IxIR0.DynamicCost.tick .evalVar + IxIR0.DynamicCost.retain 1)) + (href : ∀ (address : Ixon.Address) {result : IxIR0.Value} + {sourceProfile : SourceProfile}, + SourceSpineProfile sourceCtx sourceEnv (.ref address) [] result + sourceProfile → + (lowerSpine src (fuel + 3) input world (.ref address) []).run state = + .ok (output, emit, av) finalState → + Result result sourceProfile) + (happ : ∀ (function argument : IxIR0.Expr) + {result : IxIR0.Value} {sourceProfile : SourceProfile}, + SourceSpineProfile sourceCtx sourceEnv function [argument] result + sourceProfile → + (lowerSpine src fuel input world function [argument]).run state = + .ok (output, emit, av) finalState → + Result result sourceProfile) + (hlam : ∀ (uses : Ixon.Uses) (body : IxIR0.Expr), + (lowerE src (fuel + 1) input world (.lam uses body)).run state = + .ok (output, emit, av) finalState → + Result (.clos uses sourceEnv body) + (IxIR0.DynamicCost.tick .evalLam + + IxIR0.DynamicCost.retain sourceEnv.length)) + (hlet : ∀ (uses : Ixon.Uses) (value body : IxIR0.Expr) + {sourceStep : Nat} {bound result : IxIR0.Value} + {valueProfile bodyProfile : SourceProfile}, + IxIR0.DynamicCost.Eval sourceCtx sourceStep sourceEnv value bound + valueProfile → + IxIR0.DynamicCost.Eval sourceCtx sourceStep (bound :: sourceEnv) body + result bodyProfile → + (lowerE src (fuel + 1) input world (.letE uses value body)).run state = + .ok (output, emit, av) finalState → + Result result + (valueProfile + bodyProfile + IxIR0.DynamicCost.tick .evalLet)) + (hproj : ∀ (index : Nat) (source : IxIR0.Expr) + {sourceStep : Nat} {address : Ixon.Address} {tag : Nat} + {fields : List IxIR0.Value} {result : IxIR0.Value} + {sourceProfile : SourceProfile}, + IxIR0.DynamicCost.Eval sourceCtx sourceStep sourceEnv source + (.ctor address tag fields) sourceProfile → + fields[index]? = some result → + (lowerE src (fuel + 1) input world (.proj index source)).run state = + .ok (output, emit, av) finalState → + Result result + (sourceProfile + IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1)) + (hlit : ∀ (literal : IxIR0.Literal), + (lowerE src (fuel + 1) input world (.lit literal)).run state = + .ok (output, emit, av) finalState → + Result (.lit literal) (IxIR0.DynamicCost.tick .evalLit)) + (herased : + (lowerE src (fuel + 1) input world .erased).run state = + .ok (output, emit, av) finalState → + Result .erased (IxIR0.DynamicCost.tick .evalErased)) + (hsource : IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv expr + sourceValue profile) + (hrun : (lowerE src (fuel + 1) input world expr).run state = + .ok (output, emit, av) finalState) : + Result sourceValue profile := by + cases expr with + | var index => + cases hsource with + | var hlookup => exact hvar index hlookup hrun + | ref address => + exact href address (SourceSpineProfile.of_eval_nil hsource) + (lowerE_ref_run_to_lowerSpine_nil hrun) + | app function argument => + apply happ function argument (SourceSpineProfile.of_eval_app hsource) + simpa [lowerE] using hrun + | lam uses body => + cases hsource with + | lam => exact hlam uses body hrun + | letE uses value body => + cases hsource with + | letE hvalueSource hbodySource => + exact hlet uses value body hvalueSource hbodySource hrun + | proj index source => + cases hsource with + | proj htarget hfield => + exact hproj index source htarget hfield hrun + | lit literal => + cases hsource + exact hlit literal hrun + | erased => + cases hsource + exact herased hrun + +/-- One complete exact-profile expression step. Costed source-evaluator +inversion supplies the recursive profiles for let and projection; application +and reference delegate to the completed spine routes. -/ +theorem lowerE_run_profile_sound + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hexpr : LowerEProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hspine : LowerSpineProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hborrow : LowerBorrowProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hargsNext : LowerArgsProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src (fuel + 1)) + (hrestNext : ApplyRestNonErasedProfilePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 2)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx) + (hprofiles : CompilerProfileContracts + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx) + (hreleases : ∀ body, LowerEReleasesTrackedFirst src fuel body) + {input output : VEnv} {world : Ixon.Owned} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {profile : SourceProfile} + {emit : Emit} {av : AVal} + (hsource : IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv expr + sourceValue profile) + (hrun : (lowerE src (fuel + 1) input world expr).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState relationState) + (hrepresented : ExtraRepresented ctx relationState) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceValue world emit av + profile := by + exact lowerE_run_profile_core + (Result := fun result sourceProfile => + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel ctx cur + input output sourceEnv sourceEnv result world emit av sourceProfile) + (hvar := by + intro _ _ hlookup hbranchRun + exact lowerE_var_run_profile_sound hlookup hbranchRun) + (href := by + intro _ _ _ hsourceSpine hspineRun + exact lowerSpine_ref_run_profile_sound henv hargsNext hrestNext + hknownExtra hcontracts hvalues hprofiles hsourceSpine hspineRun + hextends hrepresented) + (happ := by + intro _ _ _ _ hsourceSpine hspineRun + exact hspine (by simp) hsourceSpine hspineRun) + (hlam := by + intro _ _ hbranchRun + exact lowerE_lam_run_profile_sound_any + (fun value address arity captures hlifted => + CompilerFunctionRel.lifted (hlifted.monoState hextends)) + (hrepresented.of_extends hextends) hbranchRun) + (hlet := by + intro _ _ body _ _ _ _ _ hvalueSource hbodySource hbranchRun + exact lowerE_let_run_profile_sound + (fun hvalueRun hbodyRun _ _ _ => + ⟨hexpr hvalueSource hvalueRun, + hexpr hbodySource hbodyRun⟩) + (hreleases body) hbranchRun) + (hproj := by + intro _ _ _ _ _ _ _ _ htarget hfield hbranchRun + exact lowerE_proj_run_profile_sound + (fun hborrowRun => hborrow htarget hborrowRun) + (.ctor hfield) hbranchRun) + (hlit := by + intro _ hbranchRun + exact lowerE_lit_run_profile_sound hbranchRun) + (herased := by + intro hbranchRun + exact lowerE_erased_run_profile_sound hbranchRun) + hsource hrun + +/-- One complete target-fuel-bounded exact-profile expression step. Costed source-evaluator +inversion supplies the recursive profiles for let and projection; application +and reference delegate to the completed spine routes. -/ +theorem lowerE_run_profile_sound_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hexpr : LowerEProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src fuel) + (hspine : LowerSpineProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src fuel) + (hborrow : LowerBorrowProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src fuel) + (hargsNext : LowerArgsProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src (fuel + 1)) + (hrestNext : ApplyRestNonErasedProfilePreservesBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur limit src (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 2)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx) + (hprofiles : CompilerProfileContractsBelow + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx limit) + (hreleases : ∀ body, LowerEReleasesTrackedFirst src fuel body) + {input output : VEnv} {world : Ixon.Owned} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {profile : SourceProfile} + {emit : Emit} {av : AVal} + (hsource : IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv expr + sourceValue profile) + (hrun : (lowerE src (fuel + 1) input world expr).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState relationState) + (hrepresented : ExtraRepresented ctx relationState) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur limit input output sourceEnv sourceEnv sourceValue world emit av + profile := by + exact lowerE_run_profile_core + (Result := fun result sourceProfile => + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src relationState) recSelfRel ctx cur + limit input output sourceEnv sourceEnv result world emit av + sourceProfile) + (hvar := by + intro _ _ hlookup hbranchRun + exact lowerE_var_run_profile_sound_below hlookup hbranchRun) + (href := by + intro _ _ _ hsourceSpine hspineRun + exact lowerSpine_ref_run_profile_sound_below henv hargsNext hrestNext + hknownExtra hcontracts hvalues hprofiles hsourceSpine hspineRun + hextends hrepresented) + (happ := by + intro _ _ _ _ hsourceSpine hspineRun + exact hspine (by simp) hsourceSpine hspineRun) + (hlam := by + intro _ _ hbranchRun + exact lowerE_lam_run_profile_sound_any_below + (fun value address arity captures hlifted => + CompilerFunctionRel.lifted (hlifted.monoState hextends)) + (hrepresented.of_extends hextends) hbranchRun) + (hlet := by + intro _ _ body _ _ _ _ _ hvalueSource hbodySource hbranchRun + exact lowerE_let_run_profile_sound_below + (fun hvalueRun hbodyRun _ _ _ => + ⟨hexpr hvalueSource hvalueRun, + hexpr hbodySource hbodyRun⟩) + (hreleases body) hbranchRun) + (hproj := by + intro _ _ _ _ _ _ _ _ htarget hfield hbranchRun + exact lowerE_proj_run_profile_sound_below + (fun hborrowRun => hborrow htarget hborrowRun) + (.ctor hfield) hbranchRun) + (hlit := by + intro _ hbranchRun + exact lowerE_lit_run_profile_sound_below hbranchRun) + (herased := by + intro hbranchRun + exact lowerE_erased_run_profile_sound_below hbranchRun) + hsource hrun + +/-! ### Reachable-state exact-profile compiler interfaces -/ + +/-- The synthetic current function carries the same ownership and value +contract used by semantic lowering, together with an exact-profile contract +for every source function represented by the recursive-self relation. -/ +structure CurrentSelfProfileContract (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) : Prop where + result : cur.result = .shared + positive : 0 < cur.arity + ownership : Sim.FnOwnershipContract ctx cur + (List.replicate cur.arity .shared) + value : ∀ {sourceFunction : IxIR0.Value}, + recSelfRel sourceFunction cur.arity → + FnValueContract funRel sourceCtx ctx cur + (List.replicate cur.arity .shared) sourceFunction + profile : ∀ {sourceFunction : IxIR0.Value}, + recSelfRel sourceFunction cur.arity → + ∃ sourceAddress, + FnProfileContract funRel sourceCtx ctx sourceAddress cur + (List.replicate cur.arity .shared) sourceFunction + +theorem CurrentSelfProfileContract.toValueContract + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + (hcontract : CurrentSelfProfileContract funRel recSelfRel sourceCtx ctx + cur) : + CurrentSelfValueContract funRel recSelfRel sourceCtx ctx cur := + ⟨hcontract.result, hcontract.ownership, hcontract.value⟩ + +/-- Exact-profile current-self evidence is substantive for a recursor-rule +environment and vacuous for an ordinary environment with no self marker. -/ +def SelfProfileAvailable (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (input : VEnv) : Prop := + CurrentSelfProfileContract funRel recSelfRel sourceCtx ctx cur ∨ + NoRecSelf input + +theorem SelfProfileAvailable.of_contract + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {input : VEnv} + (hcontract : CurrentSelfProfileContract funRel recSelfRel sourceCtx ctx + cur) : + SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur input := + Or.inl hcontract + +theorem SelfProfileAvailable.of_noRecSelf + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {input : VEnv} + (hno : NoRecSelf input) : + SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur input := + Or.inr hno + +theorem SelfProfileAvailable.toSelfValueAvailable + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {input : VEnv} + (havailable : SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur + input) : + SelfValueAvailable funRel recSelfRel sourceCtx ctx cur input := by + cases havailable with + | inl hcontract => exact Or.inl hcontract.toValueContract + | inr hno => exact Or.inr hno + +theorem SelfProfileAvailable.mapNoRecSelf + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + (havailable : SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur + input) + (hpreserve : NoRecSelf input → NoRecSelf output) : + SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur output := by + cases havailable with + | inl hcontract => exact Or.inl hcontract + | inr hno => exact Or.inr (hpreserve hno) + +theorem SelfProfileAvailable.bump + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {input : VEnv} + (havailable : SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur + input) : + SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur input.bump := + havailable.mapNoRecSelf NoRecSelf.bump + +theorem SelfProfileAvailable.pop + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {input : VEnv} + (havailable : SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur + input) : + SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur input.pop := + havailable.mapNoRecSelf NoRecSelf.pop + +theorem SelfProfileAvailable.setSlot + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {input : VEnv} + (havailable : SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur + input) + (changed abs remaining : Nat) (uses : Ixon.Uses) (held : Bool) : + SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur + (input.setEntry changed (.slot abs remaining uses held)) := + havailable.mapNoRecSelf + (fun hno => hno.setSlot changed abs remaining uses held) + +theorem SelfProfileAvailable.consSlot + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {input : VEnv} + (havailable : SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur + input) + (abs remaining : Nat) (uses : Ixon.Uses) (held : Bool) : + SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur + { input with + entries := .slot abs remaining uses held :: input.entries } := + havailable.mapNoRecSelf + (fun hno => hno.consSlot abs remaining uses held) + +theorem SelfProfileAvailable.lowerE + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {world : Ixon.Owned} {expr : IxIR0.Expr} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (havailable : SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur + input) + (hrun : (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState) : + SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur output := + havailable.mapNoRecSelf + (fun hno => (lowerPreservesNoRecSelf src fuel).expr hrun hno) + +theorem SelfProfileAvailable.lowerBorrow + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {expr : IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {av : AVal} {release : Bool} + (havailable : SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur + input) + (hrun : (lowerBorrow src fuel input expr).run state = + .ok (output, emit, av, release) finalState) : + SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur output := + havailable.mapNoRecSelf + (fun hno => (lowerPreservesNoRecSelf src fuel).borrow hrun hno) + +theorem SelfProfileAvailable.lowerArgs + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {args : List (IxIR0.Expr × Ixon.Owned)} + {state finalState : LowSt} {emit : Emit} {avs : List AVal} + (havailable : SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur + input) + (hrun : (lowerArgs src fuel input args).run state = + .ok (output, emit, avs) finalState) : + SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur output := + havailable.mapNoRecSelf + (fun hno => (lowerPreservesNoRecSelf src fuel).args hrun hno) + +theorem SelfProfileAvailable.applyRest + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {resultWorld : Ixon.Owned} {pre : Emit} {function : AVal} + {args : List IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (havailable : SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur + input) + (hrun : (applyRest src fuel input resultWorld pre function args).run + state = .ok (output, emit, av) finalState) : + SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur output := + havailable.mapNoRecSelf + (fun hno => (lowerPreservesNoRecSelf src fuel).applyRest hrun hno) + +/-- At a target-fuel bound, the synthetic current function carries the same ownership and value +contract used by semantic lowering, together with an exact-profile contract +for every source function represented by the recursive-self relation. -/ +structure CurrentSelfProfileContractBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) : Prop where + result : cur.result = .shared + positive : 0 < cur.arity + ownership : Sim.FnOwnershipContract ctx cur + (List.replicate cur.arity .shared) + value : ∀ {sourceFunction : IxIR0.Value}, + recSelfRel sourceFunction cur.arity → + FnValueContract funRel sourceCtx ctx cur + (List.replicate cur.arity .shared) sourceFunction + profile : ∀ {sourceFunction : IxIR0.Value}, + recSelfRel sourceFunction cur.arity → + ∃ sourceAddress, + FnProfileContractBelow funRel sourceCtx ctx sourceAddress cur + (List.replicate cur.arity .shared) sourceFunction limit + +theorem CurrentSelfProfileContractBelow.toValueContract + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (hcontract : CurrentSelfProfileContractBelow funRel recSelfRel sourceCtx ctx + cur limit) : + CurrentSelfValueContract funRel recSelfRel sourceCtx ctx cur := + ⟨hcontract.result, hcontract.ownership, hcontract.value⟩ + +/-- Target-fuel-bounded exact-profile current-self evidence is substantive for a recursor-rule +environment and vacuous for an ordinary environment with no self marker. -/ +def SelfProfileAvailableBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) (input : VEnv) : Prop := + CurrentSelfProfileContractBelow funRel recSelfRel sourceCtx ctx cur limit ∨ + NoRecSelf input + +theorem SelfProfileAvailableBelow.of_contract + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} {input : VEnv} + (hcontract : CurrentSelfProfileContractBelow funRel recSelfRel sourceCtx ctx + cur limit) : + SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit input := + Or.inl hcontract + +theorem SelfProfileAvailableBelow.of_noRecSelf + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} {input : VEnv} + (hno : NoRecSelf input) : + SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit input := + Or.inr hno + +theorem SelfProfileAvailableBelow.toSelfValueAvailable + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} {input : VEnv} + (havailable : SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input) : + SelfValueAvailable funRel recSelfRel sourceCtx ctx cur input := by + cases havailable with + | inl hcontract => exact Or.inl hcontract.toValueContract + | inr hno => exact Or.inr hno + +theorem SelfProfileAvailableBelow.mapNoRecSelf + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} + (havailable : SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input) + (hpreserve : NoRecSelf input → NoRecSelf output) : + SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit output := by + cases havailable with + | inl hcontract => exact Or.inl hcontract + | inr hno => exact Or.inr (hpreserve hno) + +theorem SelfProfileAvailableBelow.bump + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} {input : VEnv} + (havailable : SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input) : + SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit input.bump := + havailable.mapNoRecSelf NoRecSelf.bump + +theorem SelfProfileAvailableBelow.pop + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} {input : VEnv} + (havailable : SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input) : + SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit input.pop := + havailable.mapNoRecSelf NoRecSelf.pop + +theorem SelfProfileAvailableBelow.setSlot + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} {input : VEnv} + (havailable : SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input) + (changed abs remaining : Nat) (uses : Ixon.Uses) (held : Bool) : + SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + (input.setEntry changed (.slot abs remaining uses held)) := + havailable.mapNoRecSelf + (fun hno => hno.setSlot changed abs remaining uses held) + +theorem SelfProfileAvailableBelow.consSlot + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} {input : VEnv} + (havailable : SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input) + (abs remaining : Nat) (uses : Ixon.Uses) (held : Bool) : + SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + { input with + entries := .slot abs remaining uses held :: input.entries } := + havailable.mapNoRecSelf + (fun hno => hno.consSlot abs remaining uses held) + +theorem SelfProfileAvailableBelow.lowerE + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {world : Ixon.Owned} {expr : IxIR0.Expr} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (havailable : SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input) + (hrun : (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState) : + SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit output := + havailable.mapNoRecSelf + (fun hno => (lowerPreservesNoRecSelf src fuel).expr hrun hno) + +theorem SelfProfileAvailableBelow.lowerBorrow + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {expr : IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {av : AVal} {release : Bool} + (havailable : SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input) + (hrun : (lowerBorrow src fuel input expr).run state = + .ok (output, emit, av, release) finalState) : + SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit output := + havailable.mapNoRecSelf + (fun hno => (lowerPreservesNoRecSelf src fuel).borrow hrun hno) + +theorem SelfProfileAvailableBelow.lowerArgs + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {args : List (IxIR0.Expr × Ixon.Owned)} + {state finalState : LowSt} {emit : Emit} {avs : List AVal} + (havailable : SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input) + (hrun : (lowerArgs src fuel input args).run state = + .ok (output, emit, avs) finalState) : + SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit output := + havailable.mapNoRecSelf + (fun hno => (lowerPreservesNoRecSelf src fuel).args hrun hno) + +theorem SelfProfileAvailableBelow.applyRest + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {resultWorld : Ixon.Owned} {pre : Emit} {function : AVal} + {args : List IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (havailable : SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input) + (hrun : (applyRest src fuel input resultWorld pre function args).run + state = .ok (output, emit, av) finalState) : + SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit output := + havailable.mapNoRecSelf + (fun hno => (lowerPreservesNoRecSelf src fuel).applyRest hrun hno) + +/-- Reachable-state expression profile preservation. The exact source trace +funds the result while the lowering subrun need only end inside the ambient +whole-pass state used by the generated-function relation. -/ +def LowerEProfilePreservesWithin (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {world : Ixon.Owned} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {sourceProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal}, + IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv expr sourceValue + sourceProfile → + (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState → + ExtraExtends finalState ambient → + SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue world emit av sourceProfile + +def LowerBorrowProfilePreservesWithin (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {sourceProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + {release : Bool}, + IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv expr sourceValue + sourceProfile → + (lowerBorrow src fuel input expr).run state = + .ok (output, emit, av, release) finalState → + ExtraExtends finalState ambient → + SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerBorrowProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue emit av release sourceProfile + +def LowerArgsProfilePreservesWithin (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {sourceEnv sourceValues : List IxIR0.Value} + {args : List (IxIR0.Expr × Ixon.Owned)} + {sourceProfile : SourceProfile} {state finalState : LowSt} + {emit : Emit} {avs : List AVal}, + SourceArgsProfile sourceCtx sourceEnv (args.map Prod.fst) sourceValues + sourceProfile → + (lowerArgs src fuel input args).run state = + .ok (output, emit, avs) finalState → + ExtraExtends finalState ambient → + SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerArgsProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValues (args.map Prod.snd) emit avs + sourceProfile + +def ApplyRestNonErasedProfilePreservesWithin (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {start input output : VEnv} + {sourceStart sourceMiddle sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {resultWorld : Ixon.Owned} {emitFunction emit : Emit} + {function av : AVal} {args : List IxIR0.Expr} + {functionProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt}, + function ≠ .constA .erased → + args ≠ [] → + SourceArgsProfile sourceCtx sourceMiddle args sourceArgs argsProfile → + SourceAppliesProfile sourceCtx sourceFunction sourceArgs sourceResult + applyProfile → + LowerResultProfileSound funRel recSelfRel ctx cur start input + sourceStart sourceMiddle sourceFunction .shared emitFunction function + functionProfile → + (applyRest src fuel input resultWorld emitFunction function args).run + state = .ok (output, emit, av) finalState → + ExtraExtends finalState ambient → + SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerResultProfileSound funRel recSelfRel ctx cur start output + sourceStart sourceMiddle sourceResult resultWorld emit av + (functionProfile + argsProfile + applyProfile) + +def LowerSpineProfilePreservesWithin (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {world : Ixon.Owned} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {state finalState : LowSt} + {emit : Emit} {av : AVal}, + args ≠ [] → + SourceSpineProfile sourceCtx sourceEnv head args sourceResult profile → + (lowerSpine src fuel input world head args).run state = + .ok (output, emit, av) finalState → + ExtraExtends finalState ambient → + SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av profile + +/-- Target-fuel-bounded reachable-state expression profile preservation. The exact source trace +funds the result while the lowering subrun need only end inside the ambient +whole-pass state used by the generated-function relation. -/ +def LowerEProfilePreservesWithinBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {world : Ixon.Owned} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {sourceProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal}, + IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv expr sourceValue + sourceProfile → + (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState → + ExtraExtends finalState ambient → + SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit input → + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue world emit av sourceProfile + +def LowerBorrowProfilePreservesWithinBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {sourceProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + {release : Bool}, + IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv expr sourceValue + sourceProfile → + (lowerBorrow src fuel input expr).run state = + .ok (output, emit, av, release) finalState → + ExtraExtends finalState ambient → + SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit input → + LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue emit av release sourceProfile + +def LowerArgsProfilePreservesWithinBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {sourceEnv sourceValues : List IxIR0.Value} + {args : List (IxIR0.Expr × Ixon.Owned)} + {sourceProfile : SourceProfile} {state finalState : LowSt} + {emit : Emit} {avs : List AVal}, + SourceArgsProfile sourceCtx sourceEnv (args.map Prod.fst) sourceValues + sourceProfile → + (lowerArgs src fuel input args).run state = + .ok (output, emit, avs) finalState → + ExtraExtends finalState ambient → + SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit input → + LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValues (args.map Prod.snd) emit avs + sourceProfile + +def ApplyRestNonErasedProfilePreservesWithinBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {start input output : VEnv} + {sourceStart sourceMiddle sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {resultWorld : Ixon.Owned} {emitFunction emit : Emit} + {function av : AVal} {args : List IxIR0.Expr} + {functionProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt}, + function ≠ .constA .erased → + args ≠ [] → + SourceArgsProfile sourceCtx sourceMiddle args sourceArgs argsProfile → + SourceAppliesProfile sourceCtx sourceFunction sourceArgs sourceResult + applyProfile → + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit start input + sourceStart sourceMiddle sourceFunction .shared emitFunction function + functionProfile → + (applyRest src fuel input resultWorld emitFunction function args).run + state = .ok (output, emit, av) finalState → + ExtraExtends finalState ambient → + SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit input → + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit start output + sourceStart sourceMiddle sourceResult resultWorld emit av + (functionProfile + argsProfile + applyProfile) + +def LowerSpineProfilePreservesWithinBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {world : Ixon.Owned} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {state finalState : LowSt} + {emit : Emit} {av : AVal}, + args ≠ [] → + SourceSpineProfile sourceCtx sourceEnv head args sourceResult profile → + (lowerSpine src fuel input world head args).run state = + .ok (output, emit, av) finalState → + ExtraExtends finalState ambient → + SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit input → + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult world emit av profile + +theorem lowerEProfilePreservesWithin_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (ambient : LowSt) : + LowerEProfilePreservesWithin funRel recSelfRel sourceCtx ctx cur src + ambient 0 := by + intro input output world expr sourceEnv sourceFuel sourceValue + sourceProfile state finalState emit av _ hrun _ _ + exact (lowerE_noSuccess_zero src input world expr hrun).elim + +theorem lowerBorrowProfilePreservesWithin_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (ambient : LowSt) : + LowerBorrowProfilePreservesWithin funRel recSelfRel sourceCtx ctx cur + src ambient 0 := by + intro input output expr sourceEnv sourceFuel sourceValue sourceProfile + state finalState emit av release _ hrun _ _ + exact (lowerBorrow_noSuccess_zero src input expr hrun).elim + +theorem lowerArgsProfilePreservesWithin_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (ambient : LowSt) : + LowerArgsProfilePreservesWithin funRel recSelfRel sourceCtx ctx cur src + ambient 0 := by + intro input output sourceEnv sourceValues args sourceProfile state + finalState emit avs _ hrun _ _ + exact (lowerArgs_noSuccess_zero src input args hrun).elim + +theorem applyRestNonErasedProfilePreservesWithin_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (ambient : LowSt) : + ApplyRestNonErasedProfilePreservesWithin funRel recSelfRel sourceCtx + ctx cur src ambient 0 := by + intro start input output sourceStart sourceMiddle sourceArgs + sourceFunction sourceResult resultWorld emitFunction emit function av + args functionProfile argsProfile applyProfile state finalState + _ _ _ _ _ hrun _ _ + exact (applyRest_noSuccess_zero src input resultWorld emitFunction function + args hrun).elim + +theorem lowerSpineProfilePreservesWithin_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (ambient : LowSt) : + LowerSpineProfilePreservesWithin funRel recSelfRel sourceCtx ctx cur src + ambient 0 := by + intro input output world head args sourceEnv sourceResult profile state + finalState emit av _ _ hrun _ _ + exact (lowerSpine_noSuccess_zero src input world head args hrun).elim + +theorem lowerSpineProfilePreservesWithin_one + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (ambient : LowSt) : + LowerSpineProfilePreservesWithin funRel recSelfRel sourceCtx ctx cur src + ambient 1 := by + intro input output world head args sourceEnv sourceResult profile state + finalState emit av _ _ hrun _ _ + exact (lowerSpine_noSuccess_one src input world head args hrun).elim + +/-- Reachable-state exact-profile argument sequencing. The successful tail +run places the head's intermediate state inside the ambient state, while +synthetic-self availability is transported through the head run. -/ +theorem lowerArgsProfilePreservesWithin_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEProfilePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (htail : LowerArgsProfilePreservesWithin funRel recSelfRel sourceCtx + ctx cur src ambient fuel) : + LowerArgsProfilePreservesWithin funRel recSelfRel sourceCtx ctx cur src + ambient (fuel + 1) := by + intro input output sourceEnv sourceValues args sourceProfile state + finalState emit avs hsource hrun hextends havailable + exact (lowerArgs_run_profile_core + (Result := fun actualOutput actualSourceValues worlds actualEmit + actualAVals actualProfile actualState => + ExtraExtends actualState ambient → + SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerArgsProfileSound funRel recSelfRel ctx cur input actualOutput + sourceEnv sourceEnv actualSourceValues worlds actualEmit actualAVals + actualProfile) + (hnil := by + intro _ _ + exact lowerArgs_nil_profile_sound) + (hcons := by + intro _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ hsourceHead + hsourceTail hheadRun htailRun hwithin hself + have hmiddleExtends := + (lowerArgs_extraExtends htailRun).trans hwithin + have hheadSound := + hexpr hsourceHead hheadRun hmiddleExtends hself + have htailSound := htail hsourceTail htailRun hwithin + (hself.lowerE hheadRun) + exact hheadSound.consArgs htailSound) + hsource hrun) hextends havailable + +/-- Reachable-state dynamic application uses the argument traversal ending +at the same lowering state, then discharges the paired semantic, ownership, +and exact-profile application contracts. -/ +theorem applyRestNonErasedProfilePreservesWithin_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hargs : LowerArgsProfilePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hownership : Sim.ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hcost : ApplyProfileContract funRel sourceCtx ctx) : + ApplyRestNonErasedProfilePreservesWithin funRel recSelfRel sourceCtx + ctx cur src ambient (fuel + 1) := by + intro start input output sourceStart sourceMiddle sourceArgs + sourceFunction sourceResult resultWorld emitFunction emit function av + args functionProfile argsProfile applyProfile state finalState + hfunctionNe hargsNonempty hsourceArgs hsource hfunction hrun hextends + havailable + exact (applyRest_nonErased_run_profile_core + (Result := fun actualWorld actualOutput actualEmit actualAv actualState => + ExtraExtends actualState ambient → + SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerResultProfileSound funRel recSelfRel ctx cur start actualOutput + sourceStart sourceMiddle sourceResult actualWorld actualEmit actualAv + (functionProfile + argsProfile + applyProfile)) + (hfinish := fun argsOutput emitArgs avs _ hsourcePaired + hsourceNonempty hargsRun hworldsHomogeneous hwithin hself => by + have hargsSound := hargs hsourcePaired hargsRun hwithin hself + have hhomogeneous : LowerArgsProfileSound funRel recSelfRel ctx cur + input argsOutput sourceMiddle sourceMiddle sourceArgs + (List.replicate avs.length .shared) emitArgs avs argsProfile := by + simpa [hworldsHomogeneous] using hargsSound + simpa [Function.comp_def] using + hfunction.applyArgs_graph hhomogeneous hownership hvalue hcost + hsource hsourceNonempty) + hfunctionNe hargsNonempty hsourceArgs hrun) hextends havailable + +/-- Reachable-state erased application retains exact strict-argument costs +while transporting both the ambient-state suffix and self availability to +the argument traversal. -/ +theorem applyRest_erased_run_profile_sound_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hargs : LowerArgsProfilePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + {start input output : VEnv} + {sourceStart sourceMiddle sourceArgs : List IxIR0.Value} + {resultWorld : Ixon.Owned} {emitFunction emit : Emit} + {args : List IxIR0.Expr} {av : AVal} + {functionProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} + (hsourceArgs : SourceArgsProfile sourceCtx sourceMiddle args sourceArgs + argsProfile) + (_hsource : SourceAppliesProfile sourceCtx .erased sourceArgs .erased + applyProfile) + (hfunction : LowerResultProfileSound funRel recSelfRel ctx cur + start input sourceStart sourceMiddle .erased .shared emitFunction + (.constA .erased) functionProfile) + (hrun : (applyRest src (fuel + 1) input resultWorld emitFunction + (.constA .erased) args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultProfileSound funRel recSelfRel ctx cur start output + sourceStart sourceMiddle .erased resultWorld emit av + (functionProfile + argsProfile + applyProfile) := by + exact (applyRest_erased_run_profile_core + (Result := fun actualWorld actualOutput actualEmit actualAv actualState => + ExtraExtends actualState ambient → + SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerResultProfileSound funRel recSelfRel ctx cur start actualOutput + sourceStart sourceMiddle .erased actualWorld actualEmit actualAv + (functionProfile + argsProfile + applyProfile)) + (hfinish := fun argsOutput emitArgs avs _ hsourcePaired hargsRun + hworldsHomogeneous hsourceLength hwithin hself => by + have hargsSound := hargs hsourcePaired hargsRun hwithin hself + have hhomogeneous : LowerArgsProfileSound funRel recSelfRel ctx cur + input argsOutput sourceMiddle sourceMiddle sourceArgs + (List.replicate avs.length .shared) emitArgs avs argsProfile := by + simpa [hworldsHomogeneous] using hargsSound + simpa [Function.comp_def] using + hfunction.discardArgs (applyProfile := applyProfile) hhomogeneous + hsourceLength) + hsourceArgs hrun) hextends havailable + +/-- Reachable-state profiled erased-head spine. -/ +theorem lowerSpine_erased_run_profile_sound_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hargs : LowerArgsProfilePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + {input output : VEnv} {world : Ixon.Owned} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hsource : SourceSpineProfile sourceCtx sourceEnv .erased args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world .erased args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av profile := by + exact lowerSpine_erased_run_profile_core + (Result := fun actualResult actualProfile => + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv actualResult world emit av actualProfile) + (hfinish := by + intro argumentValues argumentProfile applyProfile harguments happlies + hrestRun + have hfunction : LowerResultProfileSound funRel recSelfRel ctx cur + input input sourceEnv sourceEnv .erased .shared + (_root_.id : Emit) (.constA .erased) + (IxIR0.DynamicCost.tick .evalErased) := by + apply scalar_id_profile_sound (profile := + IxIR0.DynamicCost.tick .evalErased) .erased + · intro env + rfl + · rfl + · intro store + exact .erased + exact applyRest_erased_run_profile_sound_within hargs harguments + happlies hfunction hrestRun hextends havailable) + hsource hrun + +/-- Reachable-state profiled dynamic-head spine. The tail run witnesses that +the head's intermediate lowering state is represented by the ambient state. -/ +theorem lowerSpine_dynamic_run_profile_sound_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEProfilePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsProfilePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithin funRel recSelfRel + sourceCtx ctx cur src ambient (fuel + 1)) + {input output : VEnv} {world : Ixon.Owned} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hshape : DynamicSpineHead head) + (hargsNonempty : args ≠ []) + (hsource : SourceSpineProfile sourceCtx sourceEnv head args sourceResult + profile) + (hrun : (lowerSpine src (fuel + 2) input world head args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av profile := by + exact (lowerSpine_apply_run_profile_core + (HeadSound := fun sourceFunction headProfile functionOutput + emitFunction function middleState => + ExtraExtends middleState ambient → + SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur input → + (LowerResultProfileSound funRel recSelfRel ctx cur input + functionOutput sourceEnv sourceEnv sourceFunction .shared + emitFunction function headProfile ∧ + SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur + functionOutput)) + (Result := fun actualResult actualProfile => + ExtraExtends finalState ambient → + SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv actualResult world emit av actualProfile) + (hheadSound := fun hhead hfunctionRun _ hfunctionExtends hself => + ⟨hexpr hhead hfunctionRun hfunctionExtends hself, + hself.lowerE hfunctionRun⟩) + (hreflect := hreflect) + (herasedFinish := fun hsourceArgs hsourceApply hheadData hrestRun + hwithin hself => by + obtain ⟨hfunctionSound, hfunctionAvailable⟩ := + hheadData ((applyRest_extraExtends hrestRun).trans hwithin) hself + exact applyRest_erased_run_profile_sound_within hargs hsourceArgs + hsourceApply hfunctionSound hrestRun hwithin hfunctionAvailable) + (hnonErasedFinish := fun hfunctionNe hsourceArgs hsourceApply hheadData + hrestRun hwithin hself => by + obtain ⟨hfunctionSound, hfunctionAvailable⟩ := + hheadData ((applyRest_extraExtends hrestRun).trans hwithin) hself + exact hrest hfunctionNe hargsNonempty hsourceArgs hsourceApply + hfunctionSound hrestRun hwithin hfunctionAvailable) + hsource (lowerSpine_dynamic_run_inv hshape hrun)) hextends havailable + +/-- Reachable-state profiled ordinary-variable spine. -/ +theorem lowerSpine_var_dynamic_run_profile_sound_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEProfilePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsProfilePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithin funRel recSelfRel + sourceCtx ctx cur src ambient (fuel + 1)) + {input output : VEnv} {world : Ixon.Owned} {index : Nat} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hnotSelf : ∀ arity, + input.entries[index]? ≠ some (.recSelf arity)) + (hargsNonempty : args ≠ []) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.var index) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.var index) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av profile := by + exact (lowerSpine_apply_run_profile_core + (HeadSound := fun sourceFunction headProfile functionOutput + emitFunction function middleState => + ExtraExtends middleState ambient → + SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur input → + (LowerResultProfileSound funRel recSelfRel ctx cur input + functionOutput sourceEnv sourceEnv sourceFunction .shared + emitFunction function headProfile ∧ + SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur + functionOutput)) + (Result := fun actualResult actualProfile => + ExtraExtends finalState ambient → + SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv actualResult world emit av actualProfile) + (hheadSound := fun hhead hfunctionRun _ hfunctionExtends hself => + ⟨hexpr hhead hfunctionRun hfunctionExtends hself, + hself.lowerE hfunctionRun⟩) + (hreflect := hreflect) + (herasedFinish := fun hsourceArgs hsourceApply hheadData hrestRun + hwithin hself => by + obtain ⟨hfunctionSound, hfunctionAvailable⟩ := + hheadData ((applyRest_extraExtends hrestRun).trans hwithin) hself + exact applyRest_erased_run_profile_sound_within hargs hsourceArgs + hsourceApply hfunctionSound hrestRun hwithin hfunctionAvailable) + (hnonErasedFinish := fun hfunctionNe hsourceArgs hsourceApply hheadData + hrestRun hwithin hself => by + obtain ⟨hfunctionSound, hfunctionAvailable⟩ := + hheadData ((applyRest_extraExtends hrestRun).trans hwithin) hself + exact hrest hfunctionNe hargsNonempty hsourceArgs hsourceApply + hfunctionSound hrestRun hwithin hfunctionAvailable) + hsource (lowerSpine_var_dynamic_run_inv hnotSelf hrun)) hextends + havailable + +/-- Reachable-state profiled `knownCall`. Prefix argument lowering is placed +inside the ambient compiler state by either the terminal equality or the +excess-tail `applyRest` run. -/ +theorem lowerEProfilePreservesWithinBelow_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (src : IxIR0.Env) (ambient : LowSt) : + LowerEProfilePreservesWithinBelow funRel recSelfRel sourceCtx ctx cur limit src + ambient 0 := by + intro input output world expr sourceEnv sourceFuel sourceValue + sourceProfile state finalState emit av _ hrun _ _ + exact (lowerE_noSuccess_zero src input world expr hrun).elim + +theorem lowerBorrowProfilePreservesWithinBelow_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (src : IxIR0.Env) (ambient : LowSt) : + LowerBorrowProfilePreservesWithinBelow funRel recSelfRel sourceCtx ctx cur + limit src ambient 0 := by + intro input output expr sourceEnv sourceFuel sourceValue sourceProfile + state finalState emit av release _ hrun _ _ + exact (lowerBorrow_noSuccess_zero src input expr hrun).elim + +theorem lowerArgsProfilePreservesWithinBelow_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (src : IxIR0.Env) (ambient : LowSt) : + LowerArgsProfilePreservesWithinBelow funRel recSelfRel sourceCtx ctx cur limit src + ambient 0 := by + intro input output sourceEnv sourceValues args sourceProfile state + finalState emit avs _ hrun _ _ + exact (lowerArgs_noSuccess_zero src input args hrun).elim + +theorem applyRestNonErasedProfilePreservesWithinBelow_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (src : IxIR0.Env) (ambient : LowSt) : + ApplyRestNonErasedProfilePreservesWithinBelow funRel recSelfRel sourceCtx + ctx cur limit src ambient 0 := by + intro start input output sourceStart sourceMiddle sourceArgs + sourceFunction sourceResult resultWorld emitFunction emit function av + args functionProfile argsProfile applyProfile state finalState + _ _ _ _ _ hrun _ _ + exact (applyRest_noSuccess_zero src input resultWorld emitFunction function + args hrun).elim + +theorem lowerSpineProfilePreservesWithinBelow_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (src : IxIR0.Env) (ambient : LowSt) : + LowerSpineProfilePreservesWithinBelow funRel recSelfRel sourceCtx ctx cur limit src + ambient 0 := by + intro input output world head args sourceEnv sourceResult profile state + finalState emit av _ _ hrun _ _ + exact (lowerSpine_noSuccess_zero src input world head args hrun).elim + +theorem lowerSpineProfilePreservesWithinBelow_one + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (src : IxIR0.Env) (ambient : LowSt) : + LowerSpineProfilePreservesWithinBelow funRel recSelfRel sourceCtx ctx cur limit src + ambient 1 := by + intro input output world head args sourceEnv sourceResult profile state + finalState emit av _ _ hrun _ _ + exact (lowerSpine_noSuccess_one src input world head args hrun).elim + +/-- Reachable-state exact-profile argument sequencing. The successful tail +run places the head's intermediate state inside the ambient state, while +synthetic-self availability is transported through the head run. -/ +theorem lowerArgsProfilePreservesWithinBelow_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEProfilePreservesWithinBelow funRel recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (htail : LowerArgsProfilePreservesWithinBelow funRel recSelfRel sourceCtx + ctx cur limit src ambient fuel) : + LowerArgsProfilePreservesWithinBelow funRel recSelfRel sourceCtx ctx cur limit src + ambient (fuel + 1) := by + intro input output sourceEnv sourceValues args sourceProfile state + finalState emit avs hsource hrun hextends havailable + exact (lowerArgs_run_profile_core + (Result := fun actualOutput actualSourceValues worlds actualEmit + actualAVals actualProfile actualState => + ExtraExtends actualState ambient → + SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input → + LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit input + actualOutput sourceEnv sourceEnv actualSourceValues worlds actualEmit + actualAVals actualProfile) + (hnil := by + intro _ _ + exact lowerArgs_nil_profile_sound_below) + (hcons := by + intro _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ hsourceHead + hsourceTail hheadRun htailRun hwithin hself + have hmiddleExtends := + (lowerArgs_extraExtends htailRun).trans hwithin + have hheadSound := + hexpr hsourceHead hheadRun hmiddleExtends hself + have htailSound := htail hsourceTail htailRun hwithin + (hself.lowerE hheadRun) + exact hheadSound.consArgs htailSound) + hsource hrun) hextends havailable + +/-- Reachable-state dynamic application uses the argument traversal ending +at the same lowering state, then discharges the paired semantic, ownership, +and exact-profile application contracts. -/ +theorem applyRestNonErasedProfilePreservesWithinBelow_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hargs : LowerArgsProfilePreservesWithinBelow funRel recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hownership : Sim.ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hcost : ApplyProfileContractBelow funRel sourceCtx ctx limit) : + ApplyRestNonErasedProfilePreservesWithinBelow funRel recSelfRel sourceCtx + ctx cur limit src ambient (fuel + 1) := by + intro start input output sourceStart sourceMiddle sourceArgs + sourceFunction sourceResult resultWorld emitFunction emit function av + args functionProfile argsProfile applyProfile state finalState + hfunctionNe hargsNonempty hsourceArgs hsource hfunction hrun hextends + havailable + exact (applyRest_nonErased_run_profile_core + (Result := fun actualWorld actualOutput actualEmit actualAv actualState => + ExtraExtends actualState ambient → + SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input → + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit start + actualOutput sourceStart sourceMiddle sourceResult actualWorld + actualEmit actualAv (functionProfile + argsProfile + applyProfile)) + (hfinish := fun argsOutput emitArgs avs _ hsourcePaired + hsourceNonempty hargsRun hworldsHomogeneous hwithin hself => by + have hargsSound := hargs hsourcePaired hargsRun hwithin hself + have hhomogeneous : LowerArgsProfileSoundBelow funRel recSelfRel ctx + cur limit input argsOutput sourceMiddle sourceMiddle sourceArgs + (List.replicate avs.length .shared) emitArgs avs argsProfile := by + simpa [hworldsHomogeneous] using hargsSound + simpa [Function.comp_def] using + hfunction.applyArgs_graph hhomogeneous hownership hvalue hcost + hsource hsourceNonempty) + hfunctionNe hargsNonempty hsourceArgs hrun) hextends havailable + +/-- Reachable-state erased application retains exact strict-argument costs +while transporting both the ambient-state suffix and self availability to +the argument traversal. -/ +theorem applyRest_erased_run_profile_sound_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hargs : LowerArgsProfilePreservesWithinBelow funRel recSelfRel sourceCtx ctx + cur limit src ambient fuel) + {start input output : VEnv} + {sourceStart sourceMiddle sourceArgs : List IxIR0.Value} + {resultWorld : Ixon.Owned} {emitFunction emit : Emit} + {args : List IxIR0.Expr} {av : AVal} + {functionProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} + (hsourceArgs : SourceArgsProfile sourceCtx sourceMiddle args sourceArgs + argsProfile) + (_hsource : SourceAppliesProfile sourceCtx .erased sourceArgs .erased + applyProfile) + (hfunction : LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit + start input sourceStart sourceMiddle .erased .shared emitFunction + (.constA .erased) functionProfile) + (hrun : (applyRest src (fuel + 1) input resultWorld emitFunction + (.constA .erased) args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit start output + sourceStart sourceMiddle .erased resultWorld emit av + (functionProfile + argsProfile + applyProfile) := by + exact (applyRest_erased_run_profile_core + (Result := fun actualWorld actualOutput actualEmit actualAv actualState => + ExtraExtends actualState ambient → + SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input → + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit start + actualOutput sourceStart sourceMiddle .erased actualWorld actualEmit + actualAv (functionProfile + argsProfile + applyProfile)) + (hfinish := fun argsOutput emitArgs avs _ hsourcePaired hargsRun + hworldsHomogeneous hsourceLength hwithin hself => by + have hargsSound := hargs hsourcePaired hargsRun hwithin hself + have hhomogeneous : LowerArgsProfileSoundBelow funRel recSelfRel ctx + cur limit input argsOutput sourceMiddle sourceMiddle sourceArgs + (List.replicate avs.length .shared) emitArgs avs argsProfile := by + simpa [hworldsHomogeneous] using hargsSound + simpa [Function.comp_def] using + hfunction.discardArgs (applyProfile := applyProfile) hhomogeneous + hsourceLength) + hsourceArgs hrun) hextends havailable + +/-- Reachable-state profiled erased-head spine. -/ +theorem lowerSpine_erased_run_profile_sound_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hargs : LowerArgsProfilePreservesWithinBelow funRel recSelfRel sourceCtx ctx + cur limit src ambient fuel) + {input output : VEnv} {world : Ixon.Owned} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hsource : SourceSpineProfile sourceCtx sourceEnv .erased args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world .erased args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult world emit av profile := by + exact lowerSpine_erased_run_profile_core + (Result := fun actualResult actualProfile => + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + output sourceEnv sourceEnv actualResult world emit av actualProfile) + (hfinish := by + intro argumentValues argumentProfile applyProfile harguments happlies + hrestRun + have hfunction : LowerResultProfileSoundBelow funRel recSelfRel ctx cur + limit + input input sourceEnv sourceEnv .erased .shared + (_root_.id : Emit) (.constA .erased) + (IxIR0.DynamicCost.tick .evalErased) := by + apply scalar_id_profile_sound_below (limit := limit) (profile := + IxIR0.DynamicCost.tick .evalErased) .erased + · intro env + rfl + · rfl + · intro store + exact .erased + exact applyRest_erased_run_profile_sound_within_below hargs harguments + happlies hfunction hrestRun hextends havailable) + hsource hrun + +/-- Reachable-state profiled dynamic-head spine. The tail run witnesses that +the head's intermediate lowering state is represented by the ambient state. -/ +theorem lowerSpine_dynamic_run_profile_sound_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEProfilePreservesWithinBelow funRel recSelfRel sourceCtx ctx + cur limit src ambient (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsProfilePreservesWithinBelow funRel recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient (fuel + 1)) + {input output : VEnv} {world : Ixon.Owned} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hshape : DynamicSpineHead head) + (hargsNonempty : args ≠ []) + (hsource : SourceSpineProfile sourceCtx sourceEnv head args sourceResult + profile) + (hrun : (lowerSpine src (fuel + 2) input world head args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult world emit av profile := by + exact (lowerSpine_apply_run_profile_core + (HeadSound := fun sourceFunction headProfile functionOutput + emitFunction function middleState => + ExtraExtends middleState ambient → + SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit input → + (LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + functionOutput sourceEnv sourceEnv sourceFunction .shared + emitFunction function headProfile ∧ + SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + functionOutput)) + (Result := fun actualResult actualProfile => + ExtraExtends finalState ambient → + SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit input → + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + output sourceEnv sourceEnv actualResult world emit av actualProfile) + (hheadSound := fun hhead hfunctionRun _ hfunctionExtends hself => + ⟨hexpr hhead hfunctionRun hfunctionExtends hself, + hself.lowerE hfunctionRun⟩) + (hreflect := hreflect) + (herasedFinish := fun hsourceArgs hsourceApply hheadData hrestRun + hwithin hself => by + obtain ⟨hfunctionSound, hfunctionAvailable⟩ := + hheadData ((applyRest_extraExtends hrestRun).trans hwithin) hself + exact applyRest_erased_run_profile_sound_within_below hargs hsourceArgs + hsourceApply hfunctionSound hrestRun hwithin hfunctionAvailable) + (hnonErasedFinish := fun hfunctionNe hsourceArgs hsourceApply hheadData + hrestRun hwithin hself => by + obtain ⟨hfunctionSound, hfunctionAvailable⟩ := + hheadData ((applyRest_extraExtends hrestRun).trans hwithin) hself + exact hrest hfunctionNe hargsNonempty hsourceArgs hsourceApply + hfunctionSound hrestRun hwithin hfunctionAvailable) + hsource (lowerSpine_dynamic_run_inv hshape hrun)) hextends havailable + +/-- Reachable-state profiled ordinary-variable spine. -/ +theorem lowerSpine_var_dynamic_run_profile_sound_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEProfilePreservesWithinBelow funRel recSelfRel sourceCtx ctx + cur limit src ambient (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsProfilePreservesWithinBelow funRel recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient (fuel + 1)) + {input output : VEnv} {world : Ixon.Owned} {index : Nat} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hnotSelf : ∀ arity, + input.entries[index]? ≠ some (.recSelf arity)) + (hargsNonempty : args ≠ []) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.var index) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.var index) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult world emit av profile := by + exact (lowerSpine_apply_run_profile_core + (HeadSound := fun sourceFunction headProfile functionOutput + emitFunction function middleState => + ExtraExtends middleState ambient → + SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit input → + (LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + functionOutput sourceEnv sourceEnv sourceFunction .shared + emitFunction function headProfile ∧ + SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + functionOutput)) + (Result := fun actualResult actualProfile => + ExtraExtends finalState ambient → + SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit input → + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + output sourceEnv sourceEnv actualResult world emit av actualProfile) + (hheadSound := fun hhead hfunctionRun _ hfunctionExtends hself => + ⟨hexpr hhead hfunctionRun hfunctionExtends hself, + hself.lowerE hfunctionRun⟩) + (hreflect := hreflect) + (herasedFinish := fun hsourceArgs hsourceApply hheadData hrestRun + hwithin hself => by + obtain ⟨hfunctionSound, hfunctionAvailable⟩ := + hheadData ((applyRest_extraExtends hrestRun).trans hwithin) hself + exact applyRest_erased_run_profile_sound_within_below hargs hsourceArgs + hsourceApply hfunctionSound hrestRun hwithin hfunctionAvailable) + (hnonErasedFinish := fun hfunctionNe hsourceArgs hsourceApply hheadData + hrestRun hwithin hself => by + obtain ⟨hfunctionSound, hfunctionAvailable⟩ := + hheadData ((applyRest_extraExtends hrestRun).trans hwithin) hself + exact hrest hfunctionNe hargsNonempty hsourceArgs hsourceApply + hfunctionSound hrestRun hwithin hfunctionAvailable) + hsource (lowerSpine_var_dynamic_run_inv hnotSelf hrun)) hextends + havailable + +/-- Reachable-state profiled `knownCall`. Prefix argument lowering is placed +inside the ambient compiler state by either the terminal equality or the +excess-tail `applyRest` run. -/ + +theorem knownCall_run_profile_sound_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {build : Array Atom → Op} {argWorlds : List Ixon.Owned} + {resultWorld buildWorld : Ixon.Owned} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hbuild : ∀ {prefixOutput : VEnv} {emitPrefix : Emit} + {prefixAVals : List AVal} {sourceBuilt : IxIR0.Value} + {prefixArgsProfile prefixApplyProfile : SourceProfile}, + LowerArgsProfileSound funRel recSelfRel ctx cur input prefixOutput + sourceEnv sourceEnv (sourceValues.take count) + (((args.take count).zip (padWorlds argWorlds count)).map Prod.snd) + emitPrefix prefixAVals prefixArgsProfile → + SourceAppliesProfile sourceCtx sourceFunction + (sourceValues.take count) sourceBuilt prefixApplyProfile → + prefixAVals.length = + ((args.take count).zip (padWorlds argWorlds count)).length → + LowerResultProfileSound funRel recSelfRel ctx cur input + prefixOutput.bump sourceEnv sourceEnv sourceBuilt buildWorld + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) + (headProfile + prefixArgsProfile + prefixApplyProfile)) + (hterminalWorld : args.length ≤ count → buildWorld = resultWorld) + (hoverWorld : count < args.length → buildWorld = .shared) + (hrun : (knownCall src (fuel + 1) input build count argWorlds + resultWorld args).run state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult resultWorld emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_run_profile_core + (Reach := fun actualState => ExtraExtends actualState ambient) + (Result := fun actualOutput actualEmit actualAV _ => + LowerResultProfileSound funRel recSelfRel ctx cur input actualOutput + sourceEnv sourceEnv sourceResult resultWorld actualEmit actualAV + (headProfile + argsProfile + applyProfile)) + ?_ ?_ ?_ hextends hsourceArgs hsource hrun + · intro _ _ _ _ hafterPrefix hfinalExtends + exact (applyRest_extraExtends hafterPrefix).trans hfinalExtends + · intro prefixOutput emitPrefix prefixAVals sourceBuilt + prefixArgsProfile prefixApplyProfile _ hle hprefixSource hprefixApply + hprefixRun hprefixLength hsourceBuiltEq hprefixArgsEq hprefixApplyEq + hprefixExtends + cases hsourceBuiltEq + have hprefixSound := + hargs hprefixSource hprefixRun hprefixExtends havailable + have hbuilt := hbuild hprefixSound hprefixApply hprefixLength + simpa [hterminalWorld hle, hprefixArgsEq, hprefixApplyEq] using hbuilt + · intro prefixOutput emitPrefix prefixAVals sourceBuilt + prefixArgsProfile tailArgsProfile prefixApplyProfile tailApplyProfile + _ hover _ htailArgs hprefixApply htailApply hargsProfile happlyProfile + hprefixRun hprefixLength hafterPrefix hprefixExtends hfinalExtends + have hprefixSound := + hargs (by assumption) hprefixRun hprefixExtends havailable + have hbuilt := hbuild hprefixSound hprefixApply hprefixLength + have hbuiltShared : LowerResultProfileSound funRel recSelfRel ctx cur + input prefixOutput.bump sourceEnv sourceEnv sourceBuilt .shared + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) + (headProfile + prefixArgsProfile + prefixApplyProfile) := by + simpa [hoverWorld hover] using hbuilt + have htailSound := hrest (by simp) (drop_nonempty_of_lt_length hover) + htailArgs htailApply hbuiltShared hafterPrefix hfinalExtends + (havailable.lowerArgs hprefixRun).bump + apply LowerResultProfileSound.of_profile_eq htailSound + rw [← hargsProfile, ← happlyProfile] + ext <;> simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] + +/-- Reachable-state direct-call specialization of profiled `knownCall`. -/ +theorem knownCall_call_run_profile_sound_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur d : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {argWorlds : List Ixon.Owned} {resultWorld : Ixon.Owned} + {f : Ixon.Address} {input output : VEnv} + {args : List IxIR0.Expr} {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hworlds : argWorlds.length = count) + (hcount : count ≤ args.length) + (hdecl : ctx.decls f = some (.fn d)) + (hownership : Sim.FnOwnershipContract ctx d argWorlds) + (hvalue : FnValueContract funRel sourceCtx ctx d argWorlds + sourceFunction) + (hcost : FnProfileContract funRel sourceCtx ctx f d argWorlds sourceFunction) + (hhead : SourceRefProfile sourceCtx f sourceFunction headProfile) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hterminalWorld : args.length ≤ count → d.result = resultWorld) + (hoverWorld : count < args.length → d.result = .shared) + (hrun : (knownCall src (fuel + 1) input (.call f ·) count + argWorlds resultWorld args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult resultWorld emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_run_profile_sound_within hargs hrest hsourceArgs hsource + ?_ hterminalWorld hoverWorld hrun hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt prefixArgsProfile + prefixApplyProfile hprefixSound hprefixApply _ + have hshape := knownCall_prefix_worlds_eq args argWorlds count + hworlds hcount + have hprefix : LowerArgsProfileSound funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + argWorlds emitPrefix prefixAVals prefixArgsProfile := by + simpa only [hshape] using hprefixSound + exact hprefix.call_graph_from_ref hdecl hownership hvalue hcost hhead + hprefixApply + +/-- Reachable-state constructor-allocation specialization. -/ +theorem knownCall_alloc_run_profile_sound_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {world : Ixon.Owned} {cid : CtorId} + {sourceAddress : Ixon.Address} {sourceTag : Nat} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hcount : count ≤ args.length) + (haddress : cid.block = sourceAddress) + (htag : cid.cidx = sourceTag) + (hheadPos : 0 < headProfile.evals) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hctor : SourceApplies sourceCtx sourceFunction + (sourceValues.take count) + (.ctor sourceAddress sourceTag (sourceValues.take count))) + (hrun : (knownCall src (fuel + 1) input (.alloc world cid ·) count + (List.replicate count world) world args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_run_profile_sound_within hargs hrest hsourceArgs hsource + ?_ (fun _ => rfl) ?_ hrun hextends havailable + · intro prefixOutput emitPrefix prefixAVals sourceBuilt + prefixArgsProfile prefixApplyProfile hprefixSound hprefixApply + hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count world) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count world) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsProfileSound funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length world) + emitPrefix prefixAVals prefixArgsProfile := by + simpa only [hshape, havsLength] using hprefixSound + have hopPos : 0 < (headProfile + prefixApplyProfile).evals := by + change 0 < headProfile.evals + prefixApplyProfile.evals + omega + have hallocated := hprefix.alloc_graph_of_evals_pos haddress htag hopPos + rw [hprefixApply.toSourceApplies.deterministic hctor] + apply LowerResultProfileSound.of_profile_eq hallocated + ext <;> simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] + · intro hover + exact knownCall_over_run_world_shared hover hrun + +/-- Reachable-state scalar-extern specialization. -/ +theorem knownCall_extern_run_profile_sound_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {f : Ixon.Address} {input output : VEnv} + {resultWorld : Ixon.Owned} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hcontract : ExternValueContract funRel sourceCtx ctx) + (hcount : count ≤ args.length) + (hlookup : sourceCtx.env f = some (.extern count)) + (href : SourceRefValue sourceCtx f sourceFunction) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hrun : (knownCall src (fuel + 1) input (.extern f ·) count + (List.replicate count .shared) resultWorld args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult resultWorld emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_run_profile_sound_within hargs hrest hsourceArgs hsource + ?_ (fun _ => rfl) ?_ hrun hextends havailable + · intro prefixOutput emitPrefix prefixAVals sourceBuilt + prefixArgsProfile prefixApplyProfile hprefixSound hprefixApply + hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count .shared) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsProfileSound funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length .shared) + emitPrefix prefixAVals prefixArgsProfile := by + simpa only [hshape, havsLength] using hprefixSound + have hvalueCount : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hvalueCount] + have hextern := hprefix.extern_graph (resultWorld := resultWorld) + hcontract hlookup href htakeLength hprefixApply + apply LowerResultProfileSound.of_profile_eq + (hextern.addProfileLeft headProfile) + exact (IxIR0.DynamicCost.Profile.add_assoc _ _ _).symm + · intro hover + exact knownCall_over_run_world_shared hover hrun + +/-- Reachable-state partial-application specialization. -/ +theorem knownCall_papp_run_profile_sound_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {f : Ixon.Address} {d : Decl} {input output : VEnv} + {args : List IxIR0.Expr} {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hcount : count ≤ args.length) + (hdecl : ctx.decls f = some d) + (hunder : count < declArity d) + (hheadPos : 0 < headProfile.evals) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hfun : ∀ {sourceBuilt : IxIR0.Value}, + SourceApplies sourceCtx sourceFunction (sourceValues.take count) + sourceBuilt → + funRel sourceBuilt f (declArity d) (sourceValues.take count)) + (hrun : (knownCall src (fuel + 1) input (.papp f ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult .shared emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_run_profile_sound_within hargs hrest hsourceArgs hsource + ?_ (fun _ => rfl) (fun _ => rfl) hrun hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt prefixArgsProfile + prefixApplyProfile hprefixSound hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count .shared) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsProfileSound funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length .shared) emitPrefix prefixAVals + prefixArgsProfile := by + simpa only [hshape, havsLength] using hprefixSound + have hopPos : 0 < (headProfile + prefixApplyProfile).evals := by + change 0 < headProfile.evals + prefixApplyProfile.evals + omega + have hpapp := hprefix.papp_graph_of_evals_pos hdecl + (hfun hprefixApply.toSourceApplies) (by simpa [havsLength] using hunder) + hopPos + apply LowerResultProfileSound.of_profile_eq hpapp + ext <;> simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] + +/-- Reachable-state same-address static PAP allocation. -/ +theorem knownCall_papp_source_run_profile_sound_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel count : Nat} + {f : Ixon.Address} {source : IxIR0.Decl} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hcount : count ≤ args.length) + (hsrc : src f = some source) + (heligible : SourcePapEligible source) + (harity : sourceDeclArity source = declArity d) + (href : SourceRefValue sourceCtx f sourceFunction) + (hdecl : ctx.decls f = some d) + (hunder : count < declArity d) + (hheadPos : 0 < headProfile.evals) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hrun : (knownCall src (fuel + 1) input (.papp f ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur input + output sourceEnv sourceEnv sourceResult .shared emit av + (headProfile + argsProfile + applyProfile) := by + apply knownCall_papp_run_profile_sound_within hargs hrest hcount hdecl + hunder hheadPos hsourceArgs hsource + · intro sourceBuilt hprefixApply + apply CompilerFunctionRel.source hsrc heligible harity href hprefixApply + have hcountValues : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hcountValues] + simpa [htakeLength] using hunder + · exact hrun + · exact hextends + · exact havailable + +/-- Reachable-state constructor-wrapper PAP allocation. -/ +theorem knownCall_papp_wrapper_run_profile_sound_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel count : Nat} + {memo : WrapperMemo} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hcount : count ≤ args.length) + (hmember : memo ∈ ambient.wrappers) + (hsrc : src memo.source = some (.ctor memo.tag memo.arity)) + (href : SourceRefValue sourceCtx memo.source sourceFunction) + (hdecl : ctx.decls memo.wrapper = some d) + (harity : memo.arity = declArity d) + (hunder : count < declArity d) + (hheadPos : 0 < headProfile.evals) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hrun : (knownCall src (fuel + 1) input (.papp memo.wrapper ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur input + output sourceEnv sourceEnv sourceResult .shared emit av + (headProfile + argsProfile + applyProfile) := by + apply knownCall_papp_run_profile_sound_within hargs hrest hcount hdecl + hunder hheadPos hsourceArgs hsource + · intro sourceBuilt hprefixApply + rw [← harity] + apply CompilerFunctionRel.wrapper hmember hsrc href hprefixApply + have hcountValues : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hcountValues] + rw [htakeLength] + simpa [harity] using hunder + · exact hrun + · exact hextends + · exact havailable + +/-- A malformed recursive-self arity cannot execute its emitted call. The +argument prefix keeps its exact profile and the unreachable operation may be +assigned the remaining source fragments vacuously. -/ +theorem LowerArgsProfileSound.callSelf_arity_mismatch_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput sourceValues : List IxIR0.Value} + {sourceValue : IxIR0.Value} {worlds : List Ixon.Owned} + {emit : Emit} {avs : List AVal} + {argsProfile headProfile applyProfile : SourceProfile} + (hargs : LowerArgsProfileSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValues worlds emit avs argsProfile) + (harity : avs.length ≠ cur.arity) : + LowerResultProfileSound funRel recSelfRel ctx cur input output.bump + sourceInput sourceOutput sourceValue cur.result + (emit ∘ emitOp + (.callSelf (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) + (headProfile + argsProfile + applyProfile) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.callSelf_arity_mismatch_graph harity + profileEmits := ?_ } + intro sourceRest rest slots + have hcall : ProfileFundedEmitStateRunSound ctx cur + (emitOp (.callSelf (avs.map (·.toAtom output)).toArray)) + (GraphOwnsArgsResultProtected funRel recSelfRel output sourceOutput + sourceValues worlds avs sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceValue cur.result (.slotA output.depth) sourceRest rest slots) + (headProfile + applyProfile) := by + apply ProfileFundedEmitStateRunSound.ofOp + intro fuel before after env value horder henv hpre hrun + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [havs.resolveAtoms] at hrun + have hvaluesLength : values.length = avs.length := + havs.lengths.2.symm + have hne : values.length ≠ cur.arity := by + intro heq + exact harity (hvaluesLength.symm.trans heq) + change (if (values.length != cur.arity) = true then + .error (.stuck "callSelf arity mismatch") + else + (do + let out ← runCode ctx fuel cur before values.reverse cur.body + checkResultWorld cur.result out)) = + .ok (after, value) at hrun + have hbne : (values.length != cur.arity) = true := by + simp [hne] + rw [if_pos hbne] at hrun + contradiction + have hall : ProfileFundedEmitStateRunSound ctx cur + (emit ∘ emitOp (.callSelf (avs.map (·.toAtom output)).toArray)) + (GraphOwnsVEnvProtected funRel recSelfRel input sourceInput + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceValue cur.result (.slotA output.depth) sourceRest rest slots) + (argsProfile + (headProfile + applyProfile)) := + ProfileFundedEmitStateRunSound.comp + (hargs.profileEmits sourceRest rest slots) hcall + apply ProfileFundedEmitStateRunSound.of_profile_eq hall + ext <;> simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] + +/-- Reachable-state profiled recursive-self spine. Matching arities select +the current function's paired contracts; malformed arities use the stuck-call +profile lemma above. -/ +theorem lowerSpine_recSelf_run_profile_sound_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsProfilePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + {input output : VEnv} {world : Ixon.Owned} {index arity : Nat} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hentry : input.entries[index]? = some (.recSelf arity)) + (hself : CurrentSelfProfileContract funRel recSelfRel sourceCtx ctx cur) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.var index) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.var index) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av profile := by + apply hsource.eliminate + · intro sourceFunction sourceValues headProfile argsProfile applyProfile + hhead hsourceArgs hsourceApply hprofile + obtain ⟨sourceFuel, hhead⟩ := hhead + have hsourceHead : sourceEnv[index]? = some sourceFunction := + sourceEval_var_inv hhead.run + simp only [lowerSpine] at hrun + rw [hentry] at hrun + simp only at hrun + by_cases hunder : args.length < arity + · rw [if_pos hunder] at hrun + exact (stateThrowRun_not_ok hrun).elim + · rw [if_neg hunder] at hrun + have hcount : arity ≤ args.length := Nat.le_of_not_gt hunder + cases world with + | unique => + have hrequire : + (requireResultWorld .shared .unique).run state = + .error "call result is shared at unique demand" state := by + rfl + rw [stateBindRun, hrequire] at hrun + contradiction + | shared => + have hrequire : + (requireResultWorld .shared .shared).run state = + .ok () state := by + rfl + rw [stateBindRun, hrequire] at hrun + simp only at hrun + have hknownSound : LowerResultProfileSound funRel recSelfRel ctx + cur input output sourceEnv sourceEnv sourceResult .shared emit + av (headProfile + argsProfile + applyProfile) := by + refine knownCall_run_profile_sound_within + (build := .callSelf) (count := arity) + (argWorlds := List.replicate arity .shared) + (resultWorld := .shared) (buildWorld := cur.result) + hargs hrest hsourceArgs hsourceApply ?_ + (fun _ => by simpa [hself.result]) + (fun _ => by simpa [hself.result]) hrun hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt + prefixArgsProfile prefixApplyProfile hprefixSound + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate arity .shared) arity (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate arity .shared) arity (by simp) hcount + have havsLength : prefixAVals.length = arity := + hprefixLength.trans hzipLength + have hprefix : LowerArgsProfileSound funRel recSelfRel ctx cur + input prefixOutput sourceEnv sourceEnv + (sourceValues.take arity) (List.replicate arity .shared) + emitPrefix prefixAVals prefixArgsProfile := by + simpa only [hshape] using hprefixSound + by_cases harity : arity = cur.arity + · have hownership : Sim.FnOwnershipContract ctx cur + (List.replicate arity .shared) := by + simpa [harity] using hself.ownership + have hvalue : recSelfRel sourceFunction arity → + FnValueContract funRel sourceCtx ctx cur + (List.replicate arity .shared) sourceFunction := by + intro hrel + simpa [harity] using + hself.value (by simpa [harity] using hrel) + have hcost : recSelfRel sourceFunction arity → + ∃ sourceAddress, + FnProfileContract funRel sourceCtx ctx sourceAddress cur + (List.replicate arity .shared) sourceFunction := by + intro hrel + simpa [harity] using + hself.profile (by simpa [harity] using hrel) + have hsourceCount : arity ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take arity).length = arity := by + simp [List.length_take, hsourceCount] + have hnonempty : sourceValues.take arity ≠ [] := by + intro hempty + rw [hempty] at htakeLength + simp at htakeLength + have : 0 < arity := by simpa [harity] using hself.positive + omega + have hbuilt := hprefix.callSelf_entry_graph hentry + hsourceHead hownership hvalue hcost hprefixApply hnonempty + apply LowerResultProfileSound.of_profile_eq + (hbuilt.addProfileLeft headProfile) + exact (IxIR0.DynamicCost.Profile.add_assoc _ _ _).symm + · have hmismatch : prefixAVals.length ≠ cur.arity := by + intro heq + exact harity (havsLength.symm.trans heq) + simpa [hself.result] using + hprefix.callSelf_arity_mismatch_graph + (sourceValue := sourceBuilt) + (headProfile := headProfile) + (applyProfile := prefixApplyProfile) hmismatch + exact LowerResultProfileSound.of_profile_eq hknownSound hprofile + +/-- Reachable-state saturated/over-applied definition reference. -/ +theorem lowerSpine_ref_defn_call_run_profile_sound_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + (hvalues : SourceDeclValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprofiles : SourceDeclProfileContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {input output : VEnv} {world result : Ixon.Owned} + {f : Ixon.Address} {body : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.defn result body)) + (hcount : lamArity body ≤ args.length) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur input + output sourceEnv sourceEnv sourceResult world emit av profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hrefProfile, hsourceArgs, hsourceApply, hprofile, + _⟩ := hsource.refProfileData + obtain ⟨d, hdecl, harity, hresult, hownership⟩ := hdecls.defn hsrc + have hvalue : FnValueContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + ((lamUses body).map worldOfUses) sourceFunction := by + apply hvalues.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + have hcost : FnProfileContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx f d + ((lamUses body).map worldOfUses) sourceFunction := by + apply hprofiles.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_neg (Nat.not_lt.mpr hcount)] at hrun + obtain ⟨checked, nextState, hrequireRun, hknownRun⟩ := + stateBindRun_ok_inv hrun + cases checked + obtain ⟨hguard, _⟩ := requireResultWorld_run_ok_inv hrequireRun + have hknownSound : LowerResultProfileSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur input + output sourceEnv sourceEnv sourceResult world emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_call_run_profile_sound_within hargs hrest (by simp) + hcount hdecl hownership hvalue hcost hrefProfile hsourceArgs + hsourceApply ?_ ?_ + hknownRun hextends havailable + · intro hterminal + have heq : args.length = lamArity body := + Nat.le_antisymm hterminal hcount + simpa [hresult, heq] using hguard + · intro hover + have hne : args.length ≠ lamArity body := Nat.ne_of_gt hover + simpa [hresult, hne] using hguard + exact LowerResultProfileSound.of_profile_eq hknownSound hprofile + +/-- Reachable-state under-applied definition reference. -/ +theorem lowerSpine_ref_defn_partial_run_profile_sound_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world result : Ixon.Owned} + {f : Ixon.Address} {body : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.defn result body)) + (hunder : args.length < lamArity body) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur input + output sourceEnv sourceEnv sourceResult world emit av profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hsourceArgs, hsourceApply, hprofile, hheadPos⟩ := + hsource.refData + obtain ⟨d, hdecl, harity, _, _⟩ := hdecls.defn hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Ixon.Owned.unique == Ixon.Owned.unique) = true := by decide + have hsuEq : (Ixon.Owned.shared == Ixon.Owned.unique) = false := by decide + cases world with + | unique => + exact (stateThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + cases result with + | unique => + exact (stateThrowRun_not_ok + (by simpa [hsuEq, huuEq] using hrun)).elim + | shared => + cases hp : papSafe body with + | false => + exact (stateThrowRun_not_ok + (by simpa [hsuEq, hp] using hrun)).elim + | true => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run + state = .ok (output, emit, av) finalState := by + simpa [hsuEq, hp] using hrun + have hknownSound : LowerResultProfileSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx + cur input output sourceEnv sourceEnv sourceResult .shared + emit av (headProfile + argsProfile + applyProfile) := by + apply knownCall_papp_source_run_profile_sound_within hargs + hrest (Nat.le_refl _) hsrc ⟨rfl, hp⟩ + (by simpa [sourceDeclArity, declArity] using harity.symm) + href hdecl + (by simpa [declArity, harity] using hunder) + hheadPos hsourceArgs hsourceApply hknown hextends + havailable + exact LowerResultProfileSound.of_profile_eq hknownSound + hprofile + +/-- Reachable-state saturated/over-applied recursor reference. -/ +theorem lowerSpine_ref_recursor_call_run_profile_sound_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + (hvalues : SourceDeclValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprofiles : SourceDeclProfileContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {numArgs : Nat} {natLit : Bool} {rules : Array IxIR0.RecRule} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsrc : src f = some (.recursor numArgs natLit rules)) + (hcount : numArgs + 1 ≤ args.length) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur input + output sourceEnv sourceEnv sourceResult world emit av profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hrefProfile, hsourceArgs, hsourceApply, hprofile, + _⟩ := hsource.refProfileData + obtain ⟨d, hdecl, harity, hresult, hownership⟩ := + hdecls.recursor hsrc + have hvalue : FnValueContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + (List.replicate (numArgs + 1) .shared) sourceFunction := by + apply hvalues.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + have hcost : FnProfileContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx f d + (List.replicate (numArgs + 1) .shared) sourceFunction := by + apply hprofiles.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_neg (Nat.not_lt.mpr hcount)] at hrun + obtain ⟨checked, nextState, hrequireRun, hknownRun⟩ := + stateBindRun_ok_inv hrun + cases checked + obtain ⟨hguard, _⟩ := requireResultWorld_run_ok_inv hrequireRun + have hknownSound : LowerResultProfileSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur input + output sourceEnv sourceEnv sourceResult world emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_call_run_profile_sound_within hargs hrest (by simp) + hcount hdecl hownership hvalue hcost hrefProfile hsourceArgs + hsourceApply ?_ ?_ + hknownRun hextends havailable + · intro hterminal + have heq : args.length = numArgs + 1 := + Nat.le_antisymm hterminal hcount + simpa [hresult, heq] using hguard + · intro _ + simpa [hresult] using hguard + exact LowerResultProfileSound.of_profile_eq hknownSound hprofile + +/-- Reachable-state under-applied recursor reference. -/ +theorem lowerSpine_ref_recursor_partial_run_profile_sound_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {numArgs : Nat} {natLit : Bool} {rules : Array IxIR0.RecRule} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsrc : src f = some (.recursor numArgs natLit rules)) + (hunder : args.length < numArgs + 1) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur input + output sourceEnv sourceEnv sourceResult world emit av profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hsourceArgs, hsourceApply, hprofile, hheadPos⟩ := + hsource.refData + obtain ⟨d, hdecl, harity, _, _⟩ := hdecls.recursor hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Ixon.Owned.unique == Ixon.Owned.unique) = true := by decide + have hsuEq : (Ixon.Owned.shared == Ixon.Owned.unique) = false := by decide + cases world with + | unique => + exact (stateThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + have hknownSound : LowerResultProfileSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur + input output sourceEnv sourceEnv sourceResult .shared emit av + (headProfile + argsProfile + applyProfile) := by + apply knownCall_papp_source_run_profile_sound_within hargs hrest + (Nat.le_refl _) hsrc (by simp [SourcePapEligible]) + (by simpa [sourceDeclArity, declArity] using harity.symm) + href hdecl (by simpa [declArity, harity] using hunder) + hheadPos hsourceArgs hsourceApply hknown hextends havailable + exact LowerResultProfileSound.of_profile_eq hknownSound hprofile + +/-- Reachable-state saturated/over-applied constructor reference. -/ +theorem lowerSpine_ref_ctor_alloc_run_profile_sound_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {tag arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hlookup : sourceCtx.env f = some (.ctor tag arity)) + (hsrc : src f = some (.ctor tag arity)) + (hcount : arity ≤ args.length) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur input + output sourceEnv sourceEnv sourceResult world emit av profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hsourceArgs, hsourceApply, hprofile, hheadPos⟩ := + hsource.refData + have hvalueCount : arity ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take arity).length = arity := by + simp [List.length_take, hvalueCount] + have hctor : SourceApplies sourceCtx sourceFunction + (sourceValues.take arity) + (.ctor f tag (sourceValues.take arity)) := + sourceCtorRef_saturates hlookup href htakeLength + have hknown : + (knownCall src (fuel + 1) input + (.alloc world (ctorIdOf f tag) ·) arity + (List.replicate arity world) world args).run state = + .ok (output, emit, av) finalState := by + simpa [lowerSpine, hsrc, Nat.not_lt.mpr hcount] using hrun + have hknownSound : LowerResultProfileSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur input + output sourceEnv sourceEnv sourceResult world emit av + (headProfile + argsProfile + applyProfile) := + knownCall_alloc_run_profile_sound_within hargs hrest hcount rfl rfl + hheadPos hsourceArgs hsourceApply hctor hknown hextends havailable + exact LowerResultProfileSound.of_profile_eq hknownSound hprofile + +/-- Reachable-state under-applied constructor reference through its memoized +eta wrapper. -/ +theorem lowerSpine_ref_ctor_partial_run_profile_sound_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (hargs : LowerArgsProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {tag arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {emit : Emit} {av : AVal} + (hsrc : src f = some (.ctor tag arity)) + (hunder : args.length < arity) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfProfileAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur input + output sourceEnv sourceEnv sourceResult world emit av profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hsourceArgs, hsourceApply, hprofile, hheadPos⟩ := + hsource.refData + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Ixon.Owned.unique == Ixon.Owned.unique) = true := by decide + have hsuEq : (Ixon.Owned.shared == Ixon.Owned.unique) = false := by decide + cases world with + | unique => + exact (stateThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hrun' : + ((wrapperFor f tag arity) >>= fun wrapper => + knownCall src (fuel + 1) input (.papp wrapper ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + obtain ⟨wrapper, wrapperState, hwrapperRun, hknownRun⟩ := + stateBindRun_ok_inv hrun' + let memo : WrapperMemo := ⟨f, tag, arity, wrapper⟩ + have hmemoFinal : memo ∈ finalState.wrappers := + (hknownExtra input (.papp wrapper ·) args.length + (List.replicate args.length .shared) .shared args + hknownRun).wrapper_mem (wrapperFor_memo_mem hwrapperRun) + have hmemo : memo ∈ ambient.wrappers := + hextends.wrapper_mem hmemoFinal + have hdecl := hrepresented.wrapper hmemo + have hknownSound : LowerResultProfileSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur + input output sourceEnv sourceEnv sourceResult .shared emit av + (headProfile + argsProfile + applyProfile) := by + apply knownCall_papp_wrapper_run_profile_sound_within hargs hrest + (Nat.le_refl _) hmemo hsrc href hdecl + (by simp [memo, ctorWrapperDecl, declArity]) + (by simpa [memo, ctorWrapperDecl, declArity] using hunder) + hheadPos hsourceArgs hsourceApply hknownRun hextends havailable + exact LowerResultProfileSound.of_profile_eq hknownSound hprofile + +/-- Reachable-state saturated/over-applied extern reference. -/ +theorem lowerSpine_ref_extern_call_run_profile_sound_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hcontract : ExternValueContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hlookup : sourceCtx.env f = some (.extern arity)) + (hsrc : src f = some (.extern arity)) + (hcount : arity ≤ args.length) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur input + output sourceEnv sourceEnv sourceResult world emit av profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hsourceArgs, hsourceApply, hprofile, _⟩ := + hsource.refData + have hknown : + (knownCall src (fuel + 1) input (.extern f ·) arity + (List.replicate arity .shared) world args).run state = + .ok (output, emit, av) finalState := by + simpa [lowerSpine, hsrc, Nat.not_lt.mpr hcount] using hrun + have hknownSound : LowerResultProfileSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur input + output sourceEnv sourceEnv sourceResult world emit av + (headProfile + argsProfile + applyProfile) := + knownCall_extern_run_profile_sound_within hargs hrest hcontract hcount + hlookup href hsourceArgs hsourceApply hknown hextends havailable + exact LowerResultProfileSound.of_profile_eq hknownSound hprofile + +/-- Reachable-state under-applied extern reference. -/ +theorem lowerSpine_ref_extern_partial_run_profile_sound_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.extern arity)) + (hunder : args.length < arity) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur input + output sourceEnv sourceEnv sourceResult world emit av profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hsourceArgs, hsourceApply, hprofile, hheadPos⟩ := + hsource.refData + have hdecl := hdecls.extern hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Ixon.Owned.unique == Ixon.Owned.unique) = true := by decide + have hsuEq : (Ixon.Owned.shared == Ixon.Owned.unique) = false := by decide + cases world with + | unique => + exact (stateThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + have hknownSound : LowerResultProfileSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur + input output sourceEnv sourceEnv sourceResult .shared emit av + (headProfile + argsProfile + applyProfile) := by + apply knownCall_papp_source_run_profile_sound_within hargs hrest + (Nat.le_refl _) hsrc (by simp [SourcePapEligible]) (by rfl) href + hdecl (by simpa [declArity] using hunder) hheadPos hsourceArgs + hsourceApply hknown hextends havailable + exact LowerResultProfileSound.of_profile_eq hknownSound hprofile + +/-- Complete reachable-state profiled static-reference dispatch. -/ +theorem lowerSpine_ref_run_profile_sound_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hargs : LowerArgsProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprofiles : CompilerProfileContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {emit : Emit} {av : AVal} + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfProfileAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur input + output sourceEnv sourceEnv sourceResult world emit av profile := by + exact lowerSpine_ref_run_core + (Result := LowerResultProfileSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur input + output sourceEnv sourceEnv sourceResult world emit av profile) + (hdefnPartial := by + intro _ _ hsrc hunder + exact lowerSpine_ref_defn_partial_run_profile_sound_within + hargs hrest hcontracts.decls hsrc hunder hsource hrun hextends + havailable) + (hdefnCall := by + intro _ _ hsrc hcount + exact lowerSpine_ref_defn_call_run_profile_sound_within + hargs hrest hcontracts.decls hvalues.decls hprofiles.decls hsrc + hcount hsource hrun hextends havailable) + (hctorPartial := by + intro _ _ hsrc hunder + exact lowerSpine_ref_ctor_partial_run_profile_sound_within + hargs hrest hknownExtra hsrc hunder hsource hrun hextends + hrepresented havailable) + (hctorAlloc := by + intro tag arity hsrc hcount + have hlookup : sourceCtx.env f = some (.ctor tag arity) := by + rw [henv] + exact hsrc + exact lowerSpine_ref_ctor_alloc_run_profile_sound_within + hargs hrest hlookup hsrc hcount hsource hrun hextends havailable) + (hrecursorPartial := by + intro _ _ _ hsrc hunder + exact lowerSpine_ref_recursor_partial_run_profile_sound_within + hargs hrest hcontracts.decls hsrc hunder hsource hrun hextends + havailable) + (hrecursorCall := by + intro _ _ _ hsrc hcount + exact lowerSpine_ref_recursor_call_run_profile_sound_within + hargs hrest hcontracts.decls hvalues.decls hprofiles.decls hsrc + hcount hsource hrun hextends havailable) + (hexternPartial := by + intro _ hsrc hunder + exact lowerSpine_ref_extern_partial_run_profile_sound_within + hargs hrest hcontracts.decls hsrc hunder hsource hrun hextends + havailable) + (hexternCall := by + intro arity hsrc hcount + have hlookup : sourceCtx.env f = some (.extern arity) := by + rw [henv] + exact hsrc + exact lowerSpine_ref_extern_call_run_profile_sound_within + hargs hrest hvalues.extern hlookup hsrc hcount hsource hrun hextends + havailable) + hrun + +/-- One complete reachable-state exact-profile spine step. Every recursive +run is justified against the enclosing whole-pass state, and synthetic-self +contracts are requested only when the logical input exposes the marker. -/ +theorem lowerSpine_run_profile_sound_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hspine : LowerSpineProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hexpr : LowerEProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrestNext : ApplyRestNonErasedProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprofiles : CompilerProfileContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {input output : VEnv} {world : Ixon.Owned} {head : IxIR0.Expr} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {emit : Emit} {av : AVal} + (hargsNonempty : args ≠ []) + (hsource : SourceSpineProfile sourceCtx sourceEnv head args sourceResult + profile) + (hrun : (lowerSpine src (fuel + 2) input world head args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfProfileAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur input + output sourceEnv sourceEnv sourceResult world emit av profile := by + exact lowerSpine_run_core + (Result := fun actualHead => + SourceSpineProfile sourceCtx sourceEnv actualHead args sourceResult + profile → + (lowerSpine src (fuel + 2) input world actualHead args).run state = + .ok (output, emit, av) finalState → + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur input + output sourceEnv sourceEnv sourceResult world emit av profile) + (happ := by + intro _ _ hsource hrun + apply hspine (by simp) hsource.flattenApp + · simpa [lowerSpine] using hrun + · exact hextends + · exact havailable) + (herased := by + intro hsource hrun + exact lowerSpine_erased_run_profile_sound_within hargs hsource hrun + hextends havailable) + (hvar := by + intro _ hnotSelf hsource hrun + exact lowerSpine_var_dynamic_run_profile_sound_within hexpr hreflect + hargs hrestNext hnotSelf hargsNonempty hsource hrun hextends + havailable) + (hrecSelf := by + intro index arity hentry hsource hrun + cases havailable with + | inl hself => + exact lowerSpine_recSelf_run_profile_sound_within hargs hrest hentry + hself hsource hrun hextends + (SelfProfileAvailable.of_contract hself) + | inr hno => exact (hno index arity hentry).elim) + (href := by + intro _ hsource hrun + exact lowerSpine_ref_run_profile_sound_within henv hargs hrest + hknownExtra hcontracts hvalues hprofiles hsource hrun hextends + hrepresented havailable) + (hdynamic := by + intro _ hshape hsource hrun + exact lowerSpine_dynamic_run_profile_sound_within hexpr hreflect hargs + hrestNext hshape hargsNonempty hsource hrun hextends havailable) + hsource hrun + +/-! ### Target-fuel-bounded reachable known-call and spine steps -/ + +theorem knownCall_run_profile_sound_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {build : Array Atom → Op} {argWorlds : List Ixon.Owned} + {resultWorld buildWorld : Ixon.Owned} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreservesWithinBelow funRel recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hbuild : ∀ {prefixOutput : VEnv} {emitPrefix : Emit} + {prefixAVals : List AVal} {sourceBuilt : IxIR0.Value} + {prefixArgsProfile prefixApplyProfile : SourceProfile}, + LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit input prefixOutput + sourceEnv sourceEnv (sourceValues.take count) + (((args.take count).zip (padWorlds argWorlds count)).map Prod.snd) + emitPrefix prefixAVals prefixArgsProfile → + SourceAppliesProfile sourceCtx sourceFunction + (sourceValues.take count) sourceBuilt prefixApplyProfile → + prefixAVals.length = + ((args.take count).zip (padWorlds argWorlds count)).length → + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + prefixOutput.bump sourceEnv sourceEnv sourceBuilt buildWorld + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) + (headProfile + prefixArgsProfile + prefixApplyProfile)) + (hterminalWorld : args.length ≤ count → buildWorld = resultWorld) + (hoverWorld : count < args.length → buildWorld = .shared) + (hrun : (knownCall src (fuel + 1) input build count argWorlds + resultWorld args).run state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult resultWorld emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_run_profile_core + (Reach := fun actualState => ExtraExtends actualState ambient) + (Result := fun actualOutput actualEmit actualAV _ => + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + actualOutput sourceEnv sourceEnv sourceResult resultWorld actualEmit + actualAV (headProfile + argsProfile + applyProfile)) + ?_ ?_ ?_ hextends hsourceArgs hsource hrun + · intro _ _ _ _ hafterPrefix hfinalExtends + exact (applyRest_extraExtends hafterPrefix).trans hfinalExtends + · intro prefixOutput emitPrefix prefixAVals sourceBuilt + prefixArgsProfile prefixApplyProfile _ hle hprefixSource hprefixApply + hprefixRun hprefixLength hsourceBuiltEq hprefixArgsEq hprefixApplyEq + hprefixExtends + cases hsourceBuiltEq + have hprefixSound := + hargs hprefixSource hprefixRun hprefixExtends havailable + have hbuilt := hbuild hprefixSound hprefixApply hprefixLength + simpa [hterminalWorld hle, hprefixArgsEq, hprefixApplyEq] using hbuilt + · intro prefixOutput emitPrefix prefixAVals sourceBuilt + prefixArgsProfile tailArgsProfile prefixApplyProfile tailApplyProfile + _ hover _ htailArgs hprefixApply htailApply hargsProfile happlyProfile + hprefixRun hprefixLength hafterPrefix hprefixExtends hfinalExtends + have hprefixSound := + hargs (by assumption) hprefixRun hprefixExtends havailable + have hbuilt := hbuild hprefixSound hprefixApply hprefixLength + have hbuiltShared : LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit + input prefixOutput.bump sourceEnv sourceEnv sourceBuilt .shared + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) + (headProfile + prefixArgsProfile + prefixApplyProfile) := by + simpa [hoverWorld hover] using hbuilt + have htailSound := hrest (by simp) (drop_nonempty_of_lt_length hover) + htailArgs htailApply hbuiltShared hafterPrefix hfinalExtends + (havailable.lowerArgs hprefixRun).bump + apply LowerResultProfileSoundBelow.of_profile_eq htailSound + rw [← hargsProfile, ← happlyProfile] + ext <;> simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] + +/-- Reachable-state direct-call specialization of profiled `knownCall`. -/ +theorem knownCall_call_run_profile_sound_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur d : FnDef} {limit : Nat} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {argWorlds : List Ixon.Owned} {resultWorld : Ixon.Owned} + {f : Ixon.Address} {input output : VEnv} + {args : List IxIR0.Expr} {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreservesWithinBelow funRel recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + (hworlds : argWorlds.length = count) + (hcount : count ≤ args.length) + (hdecl : ctx.decls f = some (.fn d)) + (hownership : Sim.FnOwnershipContract ctx d argWorlds) + (hvalue : FnValueContract funRel sourceCtx ctx d argWorlds + sourceFunction) + (hcost : FnProfileContractBelow funRel sourceCtx ctx f d argWorlds + sourceFunction limit) + (hhead : SourceRefProfile sourceCtx f sourceFunction headProfile) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hterminalWorld : args.length ≤ count → d.result = resultWorld) + (hoverWorld : count < args.length → d.result = .shared) + (hrun : (knownCall src (fuel + 1) input (.call f ·) count + argWorlds resultWorld args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult resultWorld emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_run_profile_sound_within_below hargs hrest hsourceArgs hsource + ?_ hterminalWorld hoverWorld hrun hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt prefixArgsProfile + prefixApplyProfile hprefixSound hprefixApply _ + have hshape := knownCall_prefix_worlds_eq args argWorlds count + hworlds hcount + have hprefix : LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + argWorlds emitPrefix prefixAVals prefixArgsProfile := by + simpa only [hshape] using hprefixSound + exact hprefix.call_graph_from_ref hdecl hownership hvalue hcost hhead + hprefixApply + +/-- Reachable-state constructor-allocation specialization. -/ +theorem knownCall_alloc_run_profile_sound_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {world : Ixon.Owned} {cid : CtorId} + {sourceAddress : Ixon.Address} {sourceTag : Nat} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreservesWithinBelow funRel recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + (hcount : count ≤ args.length) + (haddress : cid.block = sourceAddress) + (htag : cid.cidx = sourceTag) + (hheadPos : 0 < headProfile.evals) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hctor : SourceApplies sourceCtx sourceFunction + (sourceValues.take count) + (.ctor sourceAddress sourceTag (sourceValues.take count))) + (hrun : (knownCall src (fuel + 1) input (.alloc world cid ·) count + (List.replicate count world) world args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult world emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_run_profile_sound_within_below hargs hrest hsourceArgs hsource + ?_ (fun _ => rfl) ?_ hrun hextends havailable + · intro prefixOutput emitPrefix prefixAVals sourceBuilt + prefixArgsProfile prefixApplyProfile hprefixSound hprefixApply + hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count world) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count world) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length world) + emitPrefix prefixAVals prefixArgsProfile := by + simpa only [hshape, havsLength] using hprefixSound + have hopPos : 0 < (headProfile + prefixApplyProfile).evals := by + change 0 < headProfile.evals + prefixApplyProfile.evals + omega + have hallocated := hprefix.alloc_graph_of_evals_pos haddress htag hopPos + rw [hprefixApply.toSourceApplies.deterministic hctor] + apply LowerResultProfileSoundBelow.of_profile_eq hallocated + ext <;> simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] + · intro hover + exact knownCall_over_run_world_shared hover hrun + +/-- Reachable-state scalar-extern specialization. -/ +theorem knownCall_extern_run_profile_sound_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {f : Ixon.Address} {input output : VEnv} + {resultWorld : Ixon.Owned} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreservesWithinBelow funRel recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + (hcontract : ExternValueContract funRel sourceCtx ctx) + (hcount : count ≤ args.length) + (hlookup : sourceCtx.env f = some (.extern count)) + (href : SourceRefValue sourceCtx f sourceFunction) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hrun : (knownCall src (fuel + 1) input (.extern f ·) count + (List.replicate count .shared) resultWorld args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult resultWorld emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_run_profile_sound_within_below hargs hrest hsourceArgs hsource + ?_ (fun _ => rfl) ?_ hrun hextends havailable + · intro prefixOutput emitPrefix prefixAVals sourceBuilt + prefixArgsProfile prefixApplyProfile hprefixSound hprefixApply + hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count .shared) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length .shared) + emitPrefix prefixAVals prefixArgsProfile := by + simpa only [hshape, havsLength] using hprefixSound + have hvalueCount : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hvalueCount] + have hextern := hprefix.extern_graph (resultWorld := resultWorld) + hcontract hlookup href htakeLength hprefixApply + apply LowerResultProfileSoundBelow.of_profile_eq + (hextern.addProfileLeft headProfile) + exact (IxIR0.DynamicCost.Profile.add_assoc _ _ _).symm + · intro hover + exact knownCall_over_run_world_shared hover hrun + +/-- Reachable-state partial-application specialization. -/ +theorem knownCall_papp_run_profile_sound_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {f : Ixon.Address} {d : Decl} {input output : VEnv} + {args : List IxIR0.Expr} {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreservesWithinBelow funRel recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + (hcount : count ≤ args.length) + (hdecl : ctx.decls f = some d) + (hunder : count < declArity d) + (hheadPos : 0 < headProfile.evals) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hfun : ∀ {sourceBuilt : IxIR0.Value}, + SourceApplies sourceCtx sourceFunction (sourceValues.take count) + sourceBuilt → + funRel sourceBuilt f (declArity d) (sourceValues.take count)) + (hrun : (knownCall src (fuel + 1) input (.papp f ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult .shared emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_run_profile_sound_within_below hargs hrest hsourceArgs hsource + ?_ (fun _ => rfl) (fun _ => rfl) hrun hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt prefixArgsProfile + prefixApplyProfile hprefixSound hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count .shared) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length .shared) emitPrefix prefixAVals + prefixArgsProfile := by + simpa only [hshape, havsLength] using hprefixSound + have hopPos : 0 < (headProfile + prefixApplyProfile).evals := by + change 0 < headProfile.evals + prefixApplyProfile.evals + omega + have hpapp := hprefix.papp_graph_of_evals_pos hdecl + (hfun hprefixApply.toSourceApplies) (by simpa [havsLength] using hunder) + hopPos + apply LowerResultProfileSoundBelow.of_profile_eq hpapp + ext <;> simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] + +/-- Reachable-state same-address static PAP allocation. -/ +theorem knownCall_papp_source_run_profile_sound_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {fuel count : Nat} + {f : Ixon.Address} {source : IxIR0.Decl} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hcount : count ≤ args.length) + (hsrc : src f = some source) + (heligible : SourcePapEligible source) + (harity : sourceDeclArity source = declArity d) + (href : SourceRefValue sourceCtx f sourceFunction) + (hdecl : ctx.decls f = some d) + (hunder : count < declArity d) + (hheadPos : 0 < headProfile.evals) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hrun : (knownCall src (fuel + 1) input (.papp f ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur limit input + output sourceEnv sourceEnv sourceResult .shared emit av + (headProfile + argsProfile + applyProfile) := by + apply knownCall_papp_run_profile_sound_within_below hargs hrest hcount hdecl + hunder hheadPos hsourceArgs hsource + · intro sourceBuilt hprefixApply + apply CompilerFunctionRel.source hsrc heligible harity href hprefixApply + have hcountValues : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hcountValues] + simpa [htakeLength] using hunder + · exact hrun + · exact hextends + · exact havailable + +/-- Reachable-state constructor-wrapper PAP allocation. -/ +theorem knownCall_papp_wrapper_run_profile_sound_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {fuel count : Nat} + {memo : WrapperMemo} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {headProfile argsProfile applyProfile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hcount : count ≤ args.length) + (hmember : memo ∈ ambient.wrappers) + (hsrc : src memo.source = some (.ctor memo.tag memo.arity)) + (href : SourceRefValue sourceCtx memo.source sourceFunction) + (hdecl : ctx.decls memo.wrapper = some d) + (harity : memo.arity = declArity d) + (hunder : count < declArity d) + (hheadPos : 0 < headProfile.evals) + (hsourceArgs : SourceArgsProfile sourceCtx sourceEnv args sourceValues + argsProfile) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceValues + sourceResult applyProfile) + (hrun : (knownCall src (fuel + 1) input (.papp memo.wrapper ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur limit input + output sourceEnv sourceEnv sourceResult .shared emit av + (headProfile + argsProfile + applyProfile) := by + apply knownCall_papp_run_profile_sound_within_below hargs hrest hcount hdecl + hunder hheadPos hsourceArgs hsource + · intro sourceBuilt hprefixApply + rw [← harity] + apply CompilerFunctionRel.wrapper hmember hsrc href hprefixApply + have hcountValues : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hcountValues] + rw [htakeLength] + simpa [harity] using hunder + · exact hrun + · exact hextends + · exact havailable + +/-- A malformed recursive-self arity cannot execute its emitted call. The +argument prefix keeps its exact profile and the unreachable operation may be +assigned the remaining source fragments vacuously. -/ +theorem LowerArgsProfileSoundBelow.callSelf_arity_mismatch_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input output : VEnv} + {sourceInput sourceOutput sourceValues : List IxIR0.Value} + {sourceValue : IxIR0.Value} {worlds : List Ixon.Owned} + {emit : Emit} {avs : List AVal} + {argsProfile headProfile applyProfile : SourceProfile} + (hargs : LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceInput sourceOutput sourceValues worlds emit avs argsProfile) + (harity : avs.length ≠ cur.arity) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output.bump + sourceInput sourceOutput sourceValue cur.result + (emit ∘ emitOp + (.callSelf (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) + (headProfile + argsProfile + applyProfile) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.callSelf_arity_mismatch_graph harity + profileEmits := ?_ } + intro sourceRest rest slots + have hcall : ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.callSelf (avs.map (·.toAtom output)).toArray)) + (GraphOwnsArgsResultProtected funRel recSelfRel output sourceOutput + sourceValues worlds avs sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceValue cur.result (.slotA output.depth) sourceRest rest slots) + (headProfile + applyProfile) := by + apply ProfileFundedEmitStateRunSoundBelow.ofOp + intro fuel before after env value _ horder henv hpre hrun + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [havs.resolveAtoms] at hrun + have hvaluesLength : values.length = avs.length := + havs.lengths.2.symm + have hne : values.length ≠ cur.arity := by + intro heq + exact harity (hvaluesLength.symm.trans heq) + change (if (values.length != cur.arity) = true then + .error (.stuck "callSelf arity mismatch") + else + (do + let out ← runCode ctx fuel cur before values.reverse cur.body + checkResultWorld cur.result out)) = + .ok (after, value) at hrun + have hbne : (values.length != cur.arity) = true := by + simp [hne] + rw [if_pos hbne] at hrun + contradiction + have hall : ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emit ∘ emitOp (.callSelf (avs.map (·.toAtom output)).toArray)) + (GraphOwnsVEnvProtected funRel recSelfRel input sourceInput + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceValue cur.result (.slotA output.depth) sourceRest rest slots) + (argsProfile + (headProfile + applyProfile)) := + ProfileFundedEmitStateRunSoundBelow.comp + (hargs.profileEmits sourceRest rest slots) hcall + apply ProfileFundedEmitStateRunSoundBelow.of_profile_eq hall + ext <;> simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] + +/-- Reachable-state profiled recursive-self spine. Matching arities select +the current function's paired contracts; malformed arities use the stuck-call +profile lemma above. -/ +theorem lowerSpine_recSelf_run_profile_sound_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {ctx : Ctx} {cur : FnDef} {limit : Nat} {fuel : Nat} + (hargs : LowerArgsProfilePreservesWithinBelow funRel recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + {input output : VEnv} {world : Ixon.Owned} {index arity : Nat} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hentry : input.entries[index]? = some (.recSelf arity)) + (hself : CurrentSelfProfileContractBelow funRel recSelfRel sourceCtx ctx cur limit) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.var index) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.var index) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult world emit av profile := by + apply hsource.eliminate + · intro sourceFunction sourceValues headProfile argsProfile applyProfile + hhead hsourceArgs hsourceApply hprofile + obtain ⟨sourceFuel, hhead⟩ := hhead + have hsourceHead : sourceEnv[index]? = some sourceFunction := + sourceEval_var_inv hhead.run + simp only [lowerSpine] at hrun + rw [hentry] at hrun + simp only at hrun + by_cases hunder : args.length < arity + · rw [if_pos hunder] at hrun + exact (stateThrowRun_not_ok hrun).elim + · rw [if_neg hunder] at hrun + have hcount : arity ≤ args.length := Nat.le_of_not_gt hunder + cases world with + | unique => + have hrequire : + (requireResultWorld .shared .unique).run state = + .error "call result is shared at unique demand" state := by + rfl + rw [stateBindRun, hrequire] at hrun + contradiction + | shared => + have hrequire : + (requireResultWorld .shared .shared).run state = + .ok () state := by + rfl + rw [stateBindRun, hrequire] at hrun + simp only at hrun + have hknownSound : LowerResultProfileSoundBelow funRel recSelfRel ctx + cur limit input output sourceEnv sourceEnv sourceResult .shared emit + av (headProfile + argsProfile + applyProfile) := by + refine knownCall_run_profile_sound_within_below + (build := .callSelf) (count := arity) + (argWorlds := List.replicate arity .shared) + (resultWorld := .shared) (buildWorld := cur.result) + hargs hrest hsourceArgs hsourceApply ?_ + (fun _ => by simpa [hself.result]) + (fun _ => by simpa [hself.result]) hrun hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt + prefixArgsProfile prefixApplyProfile hprefixSound + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate arity .shared) arity (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate arity .shared) arity (by simp) hcount + have havsLength : prefixAVals.length = arity := + hprefixLength.trans hzipLength + have hprefix : LowerArgsProfileSoundBelow funRel recSelfRel ctx cur limit + input prefixOutput sourceEnv sourceEnv + (sourceValues.take arity) (List.replicate arity .shared) + emitPrefix prefixAVals prefixArgsProfile := by + simpa only [hshape] using hprefixSound + by_cases harity : arity = cur.arity + · have hownership : Sim.FnOwnershipContract ctx cur + (List.replicate arity .shared) := by + simpa [harity] using hself.ownership + have hvalue : recSelfRel sourceFunction arity → + FnValueContract funRel sourceCtx ctx cur + (List.replicate arity .shared) sourceFunction := by + intro hrel + simpa [harity] using + hself.value (by simpa [harity] using hrel) + have hcost : recSelfRel sourceFunction arity → + ∃ sourceAddress, + FnProfileContractBelow funRel sourceCtx ctx sourceAddress cur + (List.replicate arity .shared) sourceFunction limit := by + intro hrel + simpa [harity] using + hself.profile (by simpa [harity] using hrel) + have hsourceCount : arity ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take arity).length = arity := by + simp [List.length_take, hsourceCount] + have hnonempty : sourceValues.take arity ≠ [] := by + intro hempty + rw [hempty] at htakeLength + simp at htakeLength + have : 0 < arity := by simpa [harity] using hself.positive + omega + have hbuilt := hprefix.callSelf_entry_graph hentry + hsourceHead hownership hvalue hcost hprefixApply hnonempty + apply LowerResultProfileSoundBelow.of_profile_eq + (hbuilt.addProfileLeft headProfile) + exact (IxIR0.DynamicCost.Profile.add_assoc _ _ _).symm + · have hmismatch : prefixAVals.length ≠ cur.arity := by + intro heq + exact harity (havsLength.symm.trans heq) + simpa [hself.result] using + hprefix.callSelf_arity_mismatch_graph + (sourceValue := sourceBuilt) + (headProfile := headProfile) + (applyProfile := prefixApplyProfile) hmismatch + exact LowerResultProfileSoundBelow.of_profile_eq hknownSound hprofile + +/-- Reachable-state saturated/over-applied definition reference. -/ +theorem lowerSpine_ref_defn_call_run_profile_sound_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {fuel : Nat} + (hargs : LowerArgsProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + (hvalues : SourceDeclValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprofiles : SourceDeclProfileContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + {input output : VEnv} {world result : Ixon.Owned} + {f : Ixon.Address} {body : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.defn result body)) + (hcount : lamArity body ≤ args.length) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur limit input + output sourceEnv sourceEnv sourceResult world emit av profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hrefProfile, hsourceArgs, hsourceApply, hprofile, + _⟩ := hsource.refProfileData + obtain ⟨d, hdecl, harity, hresult, hownership⟩ := hdecls.defn hsrc + have hvalue : FnValueContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + ((lamUses body).map worldOfUses) sourceFunction := by + apply hvalues.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + have hcost : FnProfileContractBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx f d + ((lamUses body).map worldOfUses) sourceFunction limit := by + apply hprofiles.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_neg (Nat.not_lt.mpr hcount)] at hrun + obtain ⟨checked, nextState, hrequireRun, hknownRun⟩ := + stateBindRun_ok_inv hrun + cases checked + obtain ⟨hguard, _⟩ := requireResultWorld_run_ok_inv hrequireRun + have hknownSound : LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur limit input + output sourceEnv sourceEnv sourceResult world emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_call_run_profile_sound_within_below hargs hrest (by simp) + hcount hdecl hownership hvalue hcost hrefProfile hsourceArgs + hsourceApply ?_ ?_ + hknownRun hextends havailable + · intro hterminal + have heq : args.length = lamArity body := + Nat.le_antisymm hterminal hcount + simpa [hresult, heq] using hguard + · intro hover + have hne : args.length ≠ lamArity body := Nat.ne_of_gt hover + simpa [hresult, hne] using hguard + exact LowerResultProfileSoundBelow.of_profile_eq hknownSound hprofile + +/-- Reachable-state under-applied definition reference. -/ +theorem lowerSpine_ref_defn_partial_run_profile_sound_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {fuel : Nat} + (hargs : LowerArgsProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world result : Ixon.Owned} + {f : Ixon.Address} {body : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.defn result body)) + (hunder : args.length < lamArity body) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur limit input + output sourceEnv sourceEnv sourceResult world emit av profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hsourceArgs, hsourceApply, hprofile, hheadPos⟩ := + hsource.refData + obtain ⟨d, hdecl, harity, _, _⟩ := hdecls.defn hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Ixon.Owned.unique == Ixon.Owned.unique) = true := by decide + have hsuEq : (Ixon.Owned.shared == Ixon.Owned.unique) = false := by decide + cases world with + | unique => + exact (stateThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + cases result with + | unique => + exact (stateThrowRun_not_ok + (by simpa [hsuEq, huuEq] using hrun)).elim + | shared => + cases hp : papSafe body with + | false => + exact (stateThrowRun_not_ok + (by simpa [hsuEq, hp] using hrun)).elim + | true => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run + state = .ok (output, emit, av) finalState := by + simpa [hsuEq, hp] using hrun + have hknownSound : LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx + cur limit input output sourceEnv sourceEnv sourceResult .shared + emit av (headProfile + argsProfile + applyProfile) := by + apply knownCall_papp_source_run_profile_sound_within_below hargs + hrest (Nat.le_refl _) hsrc ⟨rfl, hp⟩ + (by simpa [sourceDeclArity, declArity] using harity.symm) + href hdecl + (by simpa [declArity, harity] using hunder) + hheadPos hsourceArgs hsourceApply hknown hextends + havailable + exact LowerResultProfileSoundBelow.of_profile_eq hknownSound + hprofile + +/-- Reachable-state saturated/over-applied recursor reference. -/ +theorem lowerSpine_ref_recursor_call_run_profile_sound_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {fuel : Nat} + (hargs : LowerArgsProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + (hvalues : SourceDeclValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprofiles : SourceDeclProfileContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {numArgs : Nat} {natLit : Bool} {rules : Array IxIR0.RecRule} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsrc : src f = some (.recursor numArgs natLit rules)) + (hcount : numArgs + 1 ≤ args.length) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur limit input + output sourceEnv sourceEnv sourceResult world emit av profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hrefProfile, hsourceArgs, hsourceApply, hprofile, + _⟩ := hsource.refProfileData + obtain ⟨d, hdecl, harity, hresult, hownership⟩ := + hdecls.recursor hsrc + have hvalue : FnValueContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + (List.replicate (numArgs + 1) .shared) sourceFunction := by + apply hvalues.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + have hcost : FnProfileContractBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx f d + (List.replicate (numArgs + 1) .shared) sourceFunction limit := by + apply hprofiles.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_neg (Nat.not_lt.mpr hcount)] at hrun + obtain ⟨checked, nextState, hrequireRun, hknownRun⟩ := + stateBindRun_ok_inv hrun + cases checked + obtain ⟨hguard, _⟩ := requireResultWorld_run_ok_inv hrequireRun + have hknownSound : LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur limit input + output sourceEnv sourceEnv sourceResult world emit av + (headProfile + argsProfile + applyProfile) := by + refine knownCall_call_run_profile_sound_within_below hargs hrest (by simp) + hcount hdecl hownership hvalue hcost hrefProfile hsourceArgs + hsourceApply ?_ ?_ + hknownRun hextends havailable + · intro hterminal + have heq : args.length = numArgs + 1 := + Nat.le_antisymm hterminal hcount + simpa [hresult, heq] using hguard + · intro _ + simpa [hresult] using hguard + exact LowerResultProfileSoundBelow.of_profile_eq hknownSound hprofile + +/-- Reachable-state under-applied recursor reference. -/ +theorem lowerSpine_ref_recursor_partial_run_profile_sound_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {fuel : Nat} + (hargs : LowerArgsProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {numArgs : Nat} {natLit : Bool} {rules : Array IxIR0.RecRule} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsrc : src f = some (.recursor numArgs natLit rules)) + (hunder : args.length < numArgs + 1) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur limit input + output sourceEnv sourceEnv sourceResult world emit av profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hsourceArgs, hsourceApply, hprofile, hheadPos⟩ := + hsource.refData + obtain ⟨d, hdecl, harity, _, _⟩ := hdecls.recursor hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Ixon.Owned.unique == Ixon.Owned.unique) = true := by decide + have hsuEq : (Ixon.Owned.shared == Ixon.Owned.unique) = false := by decide + cases world with + | unique => + exact (stateThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + have hknownSound : LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur limit + input output sourceEnv sourceEnv sourceResult .shared emit av + (headProfile + argsProfile + applyProfile) := by + apply knownCall_papp_source_run_profile_sound_within_below hargs hrest + (Nat.le_refl _) hsrc (by simp [SourcePapEligible]) + (by simpa [sourceDeclArity, declArity] using harity.symm) + href hdecl (by simpa [declArity, harity] using hunder) + hheadPos hsourceArgs hsourceApply hknown hextends havailable + exact LowerResultProfileSoundBelow.of_profile_eq hknownSound hprofile + +/-- Reachable-state saturated/over-applied constructor reference. -/ +theorem lowerSpine_ref_ctor_alloc_run_profile_sound_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {fuel : Nat} + (hargs : LowerArgsProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {tag arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hlookup : sourceCtx.env f = some (.ctor tag arity)) + (hsrc : src f = some (.ctor tag arity)) + (hcount : arity ≤ args.length) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur limit input + output sourceEnv sourceEnv sourceResult world emit av profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hsourceArgs, hsourceApply, hprofile, hheadPos⟩ := + hsource.refData + have hvalueCount : arity ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take arity).length = arity := by + simp [List.length_take, hvalueCount] + have hctor : SourceApplies sourceCtx sourceFunction + (sourceValues.take arity) + (.ctor f tag (sourceValues.take arity)) := + sourceCtorRef_saturates hlookup href htakeLength + have hknown : + (knownCall src (fuel + 1) input + (.alloc world (ctorIdOf f tag) ·) arity + (List.replicate arity world) world args).run state = + .ok (output, emit, av) finalState := by + simpa [lowerSpine, hsrc, Nat.not_lt.mpr hcount] using hrun + have hknownSound : LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur limit input + output sourceEnv sourceEnv sourceResult world emit av + (headProfile + argsProfile + applyProfile) := + knownCall_alloc_run_profile_sound_within_below hargs hrest hcount rfl rfl + hheadPos hsourceArgs hsourceApply hctor hknown hextends havailable + exact LowerResultProfileSoundBelow.of_profile_eq hknownSound hprofile + +/-- Reachable-state under-applied constructor reference through its memoized +eta wrapper. -/ +theorem lowerSpine_ref_ctor_partial_run_profile_sound_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {fuel : Nat} + {state finalState : LowSt} + (hargs : LowerArgsProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {tag arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {emit : Emit} {av : AVal} + (hsrc : src f = some (.ctor tag arity)) + (hunder : args.length < arity) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfProfileAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur limit input + output sourceEnv sourceEnv sourceResult world emit av profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hsourceArgs, hsourceApply, hprofile, hheadPos⟩ := + hsource.refData + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Ixon.Owned.unique == Ixon.Owned.unique) = true := by decide + have hsuEq : (Ixon.Owned.shared == Ixon.Owned.unique) = false := by decide + cases world with + | unique => + exact (stateThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hrun' : + ((wrapperFor f tag arity) >>= fun wrapper => + knownCall src (fuel + 1) input (.papp wrapper ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + obtain ⟨wrapper, wrapperState, hwrapperRun, hknownRun⟩ := + stateBindRun_ok_inv hrun' + let memo : WrapperMemo := ⟨f, tag, arity, wrapper⟩ + have hmemoFinal : memo ∈ finalState.wrappers := + (hknownExtra input (.papp wrapper ·) args.length + (List.replicate args.length .shared) .shared args + hknownRun).wrapper_mem (wrapperFor_memo_mem hwrapperRun) + have hmemo : memo ∈ ambient.wrappers := + hextends.wrapper_mem hmemoFinal + have hdecl := hrepresented.wrapper hmemo + have hknownSound : LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur limit + input output sourceEnv sourceEnv sourceResult .shared emit av + (headProfile + argsProfile + applyProfile) := by + apply knownCall_papp_wrapper_run_profile_sound_within_below hargs hrest + (Nat.le_refl _) hmemo hsrc href hdecl + (by simp [memo, ctorWrapperDecl, declArity]) + (by simpa [memo, ctorWrapperDecl, declArity] using hunder) + hheadPos hsourceArgs hsourceApply hknownRun hextends havailable + exact LowerResultProfileSoundBelow.of_profile_eq hknownSound hprofile + +/-- Reachable-state saturated/over-applied extern reference. -/ +theorem lowerSpine_ref_extern_call_run_profile_sound_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {fuel : Nat} + (hargs : LowerArgsProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hcontract : ExternValueContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hlookup : sourceCtx.env f = some (.extern arity)) + (hsrc : src f = some (.extern arity)) + (hcount : arity ≤ args.length) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur limit input + output sourceEnv sourceEnv sourceResult world emit av profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hsourceArgs, hsourceApply, hprofile, _⟩ := + hsource.refData + have hknown : + (knownCall src (fuel + 1) input (.extern f ·) arity + (List.replicate arity .shared) world args).run state = + .ok (output, emit, av) finalState := by + simpa [lowerSpine, hsrc, Nat.not_lt.mpr hcount] using hrun + have hknownSound : LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur limit input + output sourceEnv sourceEnv sourceResult world emit av + (headProfile + argsProfile + applyProfile) := + knownCall_extern_run_profile_sound_within_below hargs hrest hcontract hcount + hlookup href hsourceArgs hsourceApply hknown hextends havailable + exact LowerResultProfileSoundBelow.of_profile_eq hknownSound hprofile + +/-- Reachable-state under-applied extern reference. -/ +theorem lowerSpine_ref_extern_partial_run_profile_sound_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {fuel : Nat} + (hargs : LowerArgsProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {profile : SourceProfile} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.extern arity)) + (hunder : args.length < arity) + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur limit input + output sourceEnv sourceEnv sourceResult world emit av profile := by + obtain ⟨sourceFunction, sourceValues, headProfile, argsProfile, + applyProfile, href, hsourceArgs, hsourceApply, hprofile, hheadPos⟩ := + hsource.refData + have hdecl := hdecls.extern hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Ixon.Owned.unique == Ixon.Owned.unique) = true := by decide + have hsuEq : (Ixon.Owned.shared == Ixon.Owned.unique) = false := by decide + cases world with + | unique => + exact (stateThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + have hknownSound : LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur limit + input output sourceEnv sourceEnv sourceResult .shared emit av + (headProfile + argsProfile + applyProfile) := by + apply knownCall_papp_source_run_profile_sound_within_below hargs hrest + (Nat.le_refl _) hsrc (by simp [SourcePapEligible]) (by rfl) href + hdecl (by simpa [declArity] using hunder) hheadPos hsourceArgs + hsourceApply hknown hextends havailable + exact LowerResultProfileSoundBelow.of_profile_eq hknownSound hprofile + +/-- Complete reachable-state profiled static-reference dispatch. -/ +theorem lowerSpine_ref_run_profile_sound_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hargs : LowerArgsProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprofiles : CompilerProfileContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + {input output : VEnv} {world : Ixon.Owned} {f : Ixon.Address} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {emit : Emit} {av : AVal} + (hsource : SourceSpineProfile sourceCtx sourceEnv (.ref f) args + sourceResult profile) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfProfileAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur limit input + output sourceEnv sourceEnv sourceResult world emit av profile := by + exact lowerSpine_ref_run_core + (Result := LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur limit + input output sourceEnv sourceEnv sourceResult world emit av profile) + (hdefnPartial := by + intro _ _ hsrc hunder + exact lowerSpine_ref_defn_partial_run_profile_sound_within_below + hargs hrest hcontracts.decls hsrc hunder hsource hrun hextends + havailable) + (hdefnCall := by + intro _ _ hsrc hcount + exact lowerSpine_ref_defn_call_run_profile_sound_within_below + hargs hrest hcontracts.decls hvalues.decls hprofiles.decls hsrc + hcount hsource hrun hextends havailable) + (hctorPartial := by + intro _ _ hsrc hunder + exact lowerSpine_ref_ctor_partial_run_profile_sound_within_below + hargs hrest hknownExtra hsrc hunder hsource hrun hextends + hrepresented havailable) + (hctorAlloc := by + intro tag arity hsrc hcount + have hlookup : sourceCtx.env f = some (.ctor tag arity) := by + rw [henv] + exact hsrc + exact lowerSpine_ref_ctor_alloc_run_profile_sound_within_below + hargs hrest hlookup hsrc hcount hsource hrun hextends havailable) + (hrecursorPartial := by + intro _ _ _ hsrc hunder + exact lowerSpine_ref_recursor_partial_run_profile_sound_within_below + hargs hrest hcontracts.decls hsrc hunder hsource hrun hextends + havailable) + (hrecursorCall := by + intro _ _ _ hsrc hcount + exact lowerSpine_ref_recursor_call_run_profile_sound_within_below + hargs hrest hcontracts.decls hvalues.decls hprofiles.decls hsrc + hcount hsource hrun hextends havailable) + (hexternPartial := by + intro _ hsrc hunder + exact lowerSpine_ref_extern_partial_run_profile_sound_within_below + hargs hrest hcontracts.decls hsrc hunder hsource hrun hextends + havailable) + (hexternCall := by + intro arity hsrc hcount + have hlookup : sourceCtx.env f = some (.extern arity) := by + rw [henv] + exact hsrc + exact lowerSpine_ref_extern_call_run_profile_sound_within_below + hargs hrest hvalues.extern hlookup hsrc hcount hsource hrun hextends + havailable) + hrun + +/-- One complete reachable-state exact-profile spine step. Every recursive +run is justified against the enclosing whole-pass state, and synthetic-self +contracts are requested only when the logical input exposes the marker. -/ +theorem lowerSpine_run_profile_sound_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hspine : LowerSpineProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient (fuel + 1)) + (hexpr : LowerEProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrestNext : ApplyRestNonErasedProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprofiles : CompilerProfileContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + {input output : VEnv} {world : Ixon.Owned} {head : IxIR0.Expr} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {profile : SourceProfile} + {emit : Emit} {av : AVal} + (hargsNonempty : args ≠ []) + (hsource : SourceSpineProfile sourceCtx sourceEnv head args sourceResult + profile) + (hrun : (lowerSpine src (fuel + 2) input world head args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfProfileAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur limit input + output sourceEnv sourceEnv sourceResult world emit av profile := by + exact lowerSpine_run_core + (Result := fun actualHead => + SourceSpineProfile sourceCtx sourceEnv actualHead args sourceResult + profile → + (lowerSpine src (fuel + 2) input world actualHead args).run state = + .ok (output, emit, av) finalState → + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur limit + input output sourceEnv sourceEnv sourceResult world emit av profile) + (happ := by + intro _ _ hsource hrun + apply hspine (by simp) hsource.flattenApp + · simpa [lowerSpine] using hrun + · exact hextends + · exact havailable) + (herased := by + intro hsource hrun + exact lowerSpine_erased_run_profile_sound_within_below hargs hsource + hrun hextends havailable) + (hvar := by + intro _ hnotSelf hsource hrun + exact lowerSpine_var_dynamic_run_profile_sound_within_below hexpr + hreflect hargs hrestNext hnotSelf hargsNonempty hsource hrun hextends + havailable) + (hrecSelf := by + intro index arity hentry hsource hrun + cases havailable with + | inl hself => + exact lowerSpine_recSelf_run_profile_sound_within_below hargs hrest + hentry hself hsource hrun hextends + (SelfProfileAvailableBelow.of_contract hself) + | inr hno => exact (hno index arity hentry).elim) + (href := by + intro _ hsource hrun + exact lowerSpine_ref_run_profile_sound_within_below henv hargs hrest + hknownExtra hcontracts hvalues hprofiles hsource hrun hextends + hrepresented havailable) + (hdynamic := by + intro _ hshape hsource hrun + exact lowerSpine_dynamic_run_profile_sound_within_below hexpr hreflect + hargs hrestNext hshape hargsNonempty hsource hrun hextends havailable) + hsource hrun + + +/-- Reachable-state exact-profile let sequencing. The body suffix transports +the earlier bound-value run, and the explicit no-self map rebuilds current +self availability for the installed binder environment. -/ +theorem lowerE_let_run_profile_sound_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEProfilePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + {input output : VEnv} {world : Ixon.Owned} {uses : Ixon.Uses} + {value body : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + {valueFuel bodyFuel : Nat} {boundSource sourceValue : IxIR0.Value} + {valueProfile bodyProfile : SourceProfile} + (hvalueSource : IxIR0.DynamicCost.Eval sourceCtx valueFuel sourceEnv + value boundSource valueProfile) + (hbodySource : IxIR0.DynamicCost.Eval sourceCtx bodyFuel + (boundSource :: sourceEnv) body sourceValue bodyProfile) + (hreleases : LowerEReleasesTrackedFirst src fuel body) + (hrun : (lowerE src (fuel + 1) input world + (.letE uses value body)).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue world emit av + (valueProfile + bodyProfile + IxIR0.DynamicCost.tick .evalLet) := by + apply lowerE_let_run_profile_sound + · intro middle bodyInput bodyOutput valueEmit bodyEmit boundValue + resultValue valueState bodyState bodyFinal hvalueRun hbodyRun + hbodyState hbodyFinal hbodyNo + subst bodyState + have hbodyExtends : ExtraExtends bodyFinal ambient := + hbodyFinal.trans hextends + have hvalueExtends : ExtraExtends valueState ambient := + (lowerE_extraExtends hbodyRun).trans hbodyExtends + have hmiddleAvailable := havailable.lowerE hvalueRun + exact ⟨hexpr hvalueSource hvalueRun hvalueExtends havailable, + hexpr hbodySource hbodyRun hbodyExtends + (hmiddleAvailable.mapNoRecSelf hbodyNo)⟩ + · exact hreleases + · exact hrun + +/-- Reachable-state exact-profile projection. Its borrow subrun ends in the +same compiler state as the pure fetch/retain/drop suffix. -/ +theorem lowerE_proj_run_profile_sound_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hborrow : LowerBorrowProfilePreservesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + {input output : VEnv} {world : Ixon.Owned} {index : Nat} + {source : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + {sourceFuel : Nat} {sourceTarget sourceValue : IxIR0.Value} + {sourceProfile : SourceProfile} + (htarget : IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv source + sourceTarget sourceProfile) + (hproject : SourceProject index sourceTarget sourceValue) + (hrun : (lowerE src (fuel + 1) input world + (.proj index source)).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue world emit av + (sourceProfile + IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + cases world with + | unique => + have huuEq : + (Ixon.Owned.unique == Ixon.Owned.unique) = true := by decide + simp only [lowerE, huuEq, if_true] at hrun + exact (stateThrowRun_not_ok hrun).elim + | shared => + have hsuEq : + (Ixon.Owned.shared == Ixon.Owned.unique) = false := by decide + simp only [lowerE, hsuEq, Bool.false_eq_true, if_false] at hrun + obtain ⟨borrowResult, middleState, hborrowRun, hafterBorrow⟩ := + stateBindRun_ok_inv hrun + rcases borrowResult with + ⟨borrowOutput, borrowEmit, borrowed, release⟩ + cases borrowed with + | constA atom => + cases atom with + | var relative => + have hpure : + (borrowOutput.bump, + borrowEmit ∘ emitOp (.fetch (.var relative) index), + AVal.slotA borrowOutput.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + cases (hborrow htarget hborrowRun hextends havailable).stable + | lit literal => + have hpure : + (borrowOutput.bump, + borrowEmit ∘ emitOp (.fetch (.lit literal) index), + AVal.slotA borrowOutput.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact (hborrow htarget hborrowRun hextends + havailable).projectConst + | erased => + have hpure : + (borrowOutput, borrowEmit, AVal.constA .erased) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + cases hproject with + | ctor hfield => + exact (hborrow htarget hborrowRun hextends + havailable).projectCtorErased + | erased => + exact (hborrow htarget hborrowRun hextends + havailable).returnErased + | slotA targetAbs => + cases release with + | false => + have hpure : + (borrowOutput.bump.bump, + borrowEmit ∘ + emitOp + (.fetch (.var (borrowOutput.rel targetAbs)) index) ∘ + emitOp (.dup (.var + (borrowOutput.bump.rel borrowOutput.depth))), + AVal.slotA borrowOutput.bump.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + cases hproject with + | ctor hfield => + exact (hborrow htarget hborrowRun hextends + havailable).projectSlotKept hfield + | erased => + exact (hborrow htarget hborrowRun hextends + havailable).projectSlotKeptErased + | true => + have hpure : + (borrowOutput.bump.bump.bump, + borrowEmit ∘ + emitOp + (.fetch (.var (borrowOutput.rel targetAbs)) index) ∘ + emitOp (.dup (.var + (borrowOutput.bump.rel borrowOutput.depth))) ∘ + emitOp (.drop (.var + (borrowOutput.bump.bump.rel targetAbs))), + AVal.slotA borrowOutput.bump.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + cases hproject with + | ctor hfield => + exact (hborrow htarget hborrowRun hextends + havailable).projectSlotReleased hfield + | erased => + exact (hborrow htarget hborrowRun hextends + havailable).projectSlotReleasedErased + +/-- One complete reachable-state exact-profile expression step. -/ +theorem lowerE_run_profile_sound_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hexpr : LowerEProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hspine : LowerSpineProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hborrow : LowerBorrowProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hargsNext : LowerArgsProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hrestNext : ApplyRestNonErasedProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 2)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprofiles : CompilerProfileContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hreleases : ∀ body, LowerEReleasesTrackedFirst src fuel body) + {input output : VEnv} {world : Ixon.Owned} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {profile : SourceProfile} + {emit : Emit} {av : AVal} + (hsource : IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv expr + sourceValue profile) + (hrun : (lowerE src (fuel + 1) input world expr).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfProfileAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur input + output sourceEnv sourceEnv sourceValue world emit av profile := by + exact lowerE_run_profile_core + (Result := fun result sourceProfile => + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur input + output sourceEnv sourceEnv result world emit av sourceProfile) + (hvar := by + intro _ _ hlookup hbranchRun + exact lowerE_var_run_profile_sound hlookup hbranchRun) + (href := by + intro _ _ _ hsourceSpine hspineRun + exact lowerSpine_ref_run_profile_sound_within henv hargsNext + hrestNext hknownExtra hcontracts hvalues hprofiles hsourceSpine + hspineRun hextends hrepresented havailable) + (happ := by + intro _ _ _ _ hsourceSpine hspineRun + exact hspine (by simp) hsourceSpine hspineRun hextends havailable) + (hlam := by + intro _ _ hbranchRun + exact lowerE_lam_run_profile_sound_any + (fun value address arity captures hlifted => + CompilerFunctionRel.lifted (hlifted.monoState hextends)) + (hrepresented.of_extends hextends) hbranchRun) + (hlet := by + intro _ _ body _ _ _ _ _ hvalueSource hbodySource hbranchRun + exact lowerE_let_run_profile_sound_within hexpr hvalueSource + hbodySource (hreleases body) hbranchRun hextends havailable) + (hproj := by + intro _ _ _ _ _ _ _ _ htarget hfield hbranchRun + exact lowerE_proj_run_profile_sound_within hborrow htarget + (.ctor hfield) hbranchRun hextends havailable) + (hlit := by + intro _ hbranchRun + exact lowerE_lit_run_profile_sound hbranchRun) + (herased := by + intro hbranchRun + exact lowerE_erased_run_profile_sound hbranchRun) + hsource hrun + +/-- Reachable-state dynamic borrowing exposes the expression subrun's final +state so its suffix proof can be threaded into the exact-profile result. -/ +theorem lowerBorrow_dynamic_run_profile_sound_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} + {ambient : LowSt} {fuel : Nat} + {input output : VEnv} {expr : IxIR0.Expr} + {emit : Emit} {av : AVal} {release : Bool} + {state finalState : LowSt} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {profile : SourceProfile} + (hexpr : ∀ {exprOutput : VEnv} {exprEmit : Emit} {exprAv : AVal} + {exprState : LowSt}, + (lowerE src fuel input .shared expr).run state = + .ok (exprOutput, exprEmit, exprAv) exprState → + ExtraExtends exprState ambient → + LowerResultProfileSound funRel recSelfRel ctx cur input exprOutput + sourceEnv sourceEnv sourceValue .shared exprEmit exprAv profile) + (hshape : DynamicBorrowHead expr) + (hrun : (lowerBorrow src (fuel + 1) input expr).run state = + .ok (output, emit, av, release) finalState) + (hextends : ExtraExtends finalState ambient) : + LowerBorrowProfileSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue emit av release profile := by + exact (lowerBorrow_dynamic_run_core + (ExprResult := fun exprOutput exprEmit exprAv exprState => + ExtraExtends exprState ambient → + LowerResultProfileSound funRel recSelfRel ctx cur input exprOutput + sourceEnv sourceEnv sourceValue .shared exprEmit exprAv profile) + (BorrowResult := fun borrowOutput borrowEmit borrowAv borrowRelease + borrowState => + ExtraExtends borrowState ambient → + LowerBorrowProfileSound funRel recSelfRel ctx cur input borrowOutput + sourceEnv sourceEnv sourceValue borrowEmit borrowAv borrowRelease + profile) + (hexpr := fun hsubrun hwithin => hexpr hsubrun hwithin) + (hslot := fun hsound hwithin => + (hsound hwithin).asBorrowSlot) + (hconst := fun hsound hwithin => + (hsound hwithin).asBorrowConst) + hshape hrun) hextends + +theorem lowerBorrowProfilePreservesWithin_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEProfilePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) : + LowerBorrowProfilePreservesWithin funRel recSelfRel sourceCtx ctx cur + src ambient (fuel + 1) := by + intro input output expr sourceEnv sourceFuel sourceValue sourceProfile + state finalState emit av release hsource hrun hextends havailable + cases expr with + | var index => + cases hsource with + | var hlookup => + exact lowerBorrow_var_run_profile_sound hlookup hrun + | ref address => + exact lowerBorrow_dynamic_run_profile_sound_within + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.ref address) hrun hextends + | app function argument => + exact lowerBorrow_dynamic_run_profile_sound_within + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.app function argument) hrun hextends + | lam uses body => + exact lowerBorrow_dynamic_run_profile_sound_within + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.lam uses body) hrun hextends + | letE uses value body => + exact lowerBorrow_dynamic_run_profile_sound_within + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.letE uses value body) hrun hextends + | proj index source => + exact lowerBorrow_dynamic_run_profile_sound_within + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.proj index source) hrun hextends + | lit literal => + exact lowerBorrow_dynamic_run_profile_sound_within + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.lit literal) hrun hextends + | erased => + exact lowerBorrow_dynamic_run_profile_sound_within + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + .erased hrun hextends + +/-! ### Target-fuel-bounded reachable expression and borrow steps -/ + +/-- Reachable-state exact-profile let sequencing. The body suffix transports +the earlier bound-value run, and the explicit no-self map rebuilds current +self availability for the installed binder environment. -/ +theorem lowerE_let_run_profile_sound_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEProfilePreservesWithinBelow funRel recSelfRel sourceCtx ctx + cur limit src ambient fuel) + {input output : VEnv} {world : Ixon.Owned} {uses : Ixon.Uses} + {value body : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + {valueFuel bodyFuel : Nat} {boundSource sourceValue : IxIR0.Value} + {valueProfile bodyProfile : SourceProfile} + (hvalueSource : IxIR0.DynamicCost.Eval sourceCtx valueFuel sourceEnv + value boundSource valueProfile) + (hbodySource : IxIR0.DynamicCost.Eval sourceCtx bodyFuel + (boundSource :: sourceEnv) body sourceValue bodyProfile) + (hreleases : LowerEReleasesTrackedFirst src fuel body) + (hrun : (lowerE src (fuel + 1) input world + (.letE uses value body)).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue world emit av + (valueProfile + bodyProfile + IxIR0.DynamicCost.tick .evalLet) := by + apply lowerE_let_run_profile_sound_below + · intro middle bodyInput bodyOutput valueEmit bodyEmit boundValue + resultValue valueState bodyState bodyFinal hvalueRun hbodyRun + hbodyState hbodyFinal hbodyNo + subst bodyState + have hbodyExtends : ExtraExtends bodyFinal ambient := + hbodyFinal.trans hextends + have hvalueExtends : ExtraExtends valueState ambient := + (lowerE_extraExtends hbodyRun).trans hbodyExtends + have hmiddleAvailable := havailable.lowerE hvalueRun + exact ⟨hexpr hvalueSource hvalueRun hvalueExtends havailable, + hexpr hbodySource hbodyRun hbodyExtends + (hmiddleAvailable.mapNoRecSelf hbodyNo)⟩ + · exact hreleases + · exact hrun + +/-- Reachable-state exact-profile projection. Its borrow subrun ends in the +same compiler state as the pure fetch/retain/drop suffix. -/ +theorem lowerE_proj_run_profile_sound_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hborrow : LowerBorrowProfilePreservesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + {input output : VEnv} {world : Ixon.Owned} {index : Nat} + {source : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + {sourceFuel : Nat} {sourceTarget sourceValue : IxIR0.Value} + {sourceProfile : SourceProfile} + (htarget : IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv source + sourceTarget sourceProfile) + (hproject : SourceProject index sourceTarget sourceValue) + (hrun : (lowerE src (fuel + 1) input world + (.proj index source)).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProfileAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input) : + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue world emit av + (sourceProfile + IxIR0.DynamicCost.tick .evalProj + + IxIR0.DynamicCost.retain 1) := by + cases world with + | unique => + have huuEq : + (Ixon.Owned.unique == Ixon.Owned.unique) = true := by decide + simp only [lowerE, huuEq, if_true] at hrun + exact (stateThrowRun_not_ok hrun).elim + | shared => + have hsuEq : + (Ixon.Owned.shared == Ixon.Owned.unique) = false := by decide + simp only [lowerE, hsuEq, Bool.false_eq_true, if_false] at hrun + obtain ⟨borrowResult, middleState, hborrowRun, hafterBorrow⟩ := + stateBindRun_ok_inv hrun + rcases borrowResult with + ⟨borrowOutput, borrowEmit, borrowed, release⟩ + cases borrowed with + | constA atom => + cases atom with + | var relative => + have hpure : + (borrowOutput.bump, + borrowEmit ∘ emitOp (.fetch (.var relative) index), + AVal.slotA borrowOutput.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + cases (hborrow htarget hborrowRun hextends havailable).stable + | lit literal => + have hpure : + (borrowOutput.bump, + borrowEmit ∘ emitOp (.fetch (.lit literal) index), + AVal.slotA borrowOutput.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact (hborrow htarget hborrowRun hextends + havailable).projectConst + | erased => + have hpure : + (borrowOutput, borrowEmit, AVal.constA .erased) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + cases hproject with + | ctor hfield => + exact (hborrow htarget hborrowRun hextends + havailable).projectCtorErased + | erased => + exact (hborrow htarget hborrowRun hextends + havailable).returnErased + | slotA targetAbs => + cases release with + | false => + have hpure : + (borrowOutput.bump.bump, + borrowEmit ∘ + emitOp + (.fetch (.var (borrowOutput.rel targetAbs)) index) ∘ + emitOp (.dup (.var + (borrowOutput.bump.rel borrowOutput.depth))), + AVal.slotA borrowOutput.bump.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + cases hproject with + | ctor hfield => + exact (hborrow htarget hborrowRun hextends + havailable).projectSlotKept hfield + | erased => + exact (hborrow htarget hborrowRun hextends + havailable).projectSlotKeptErased + | true => + have hpure : + (borrowOutput.bump.bump.bump, + borrowEmit ∘ + emitOp + (.fetch (.var (borrowOutput.rel targetAbs)) index) ∘ + emitOp (.dup (.var + (borrowOutput.bump.rel borrowOutput.depth))) ∘ + emitOp (.drop (.var + (borrowOutput.bump.bump.rel targetAbs))), + AVal.slotA borrowOutput.bump.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + cases hproject with + | ctor hfield => + exact (hborrow htarget hborrowRun hextends + havailable).projectSlotReleased hfield + | erased => + exact (hborrow htarget hborrowRun hextends + havailable).projectSlotReleasedErased + +/-- One complete reachable-state exact-profile expression step. -/ +theorem lowerE_run_profile_sound_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hexpr : LowerEProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hspine : LowerSpineProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hborrow : LowerBorrowProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hargsNext : LowerArgsProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient (fuel + 1)) + (hrestNext : ApplyRestNonErasedProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 2)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprofiles : CompilerProfileContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + (hreleases : ∀ body, LowerEReleasesTrackedFirst src fuel body) + {input output : VEnv} {world : Ixon.Owned} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {profile : SourceProfile} + {emit : Emit} {av : AVal} + (hsource : IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv expr + sourceValue profile) + (hrun : (lowerE src (fuel + 1) input world expr).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfProfileAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur limit input + output sourceEnv sourceEnv sourceValue world emit av profile := by + exact lowerE_run_profile_core + (Result := fun result sourceProfile => + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur limit + input output sourceEnv sourceEnv result world emit av sourceProfile) + (hvar := by + intro _ _ hlookup hbranchRun + exact lowerE_var_run_profile_sound_below hlookup hbranchRun) + (href := by + intro _ _ _ hsourceSpine hspineRun + exact lowerSpine_ref_run_profile_sound_within_below henv hargsNext + hrestNext hknownExtra hcontracts hvalues hprofiles hsourceSpine + hspineRun hextends hrepresented havailable) + (happ := by + intro _ _ _ _ hsourceSpine hspineRun + exact hspine (by simp) hsourceSpine hspineRun hextends havailable) + (hlam := by + intro _ _ hbranchRun + exact lowerE_lam_run_profile_sound_any_below + (fun value address arity captures hlifted => + CompilerFunctionRel.lifted (hlifted.monoState hextends)) + (hrepresented.of_extends hextends) hbranchRun) + (hlet := by + intro _ _ body _ _ _ _ _ hvalueSource hbodySource hbranchRun + exact lowerE_let_run_profile_sound_within_below hexpr hvalueSource + hbodySource (hreleases body) hbranchRun hextends havailable) + (hproj := by + intro _ _ _ _ _ _ _ _ htarget hfield hbranchRun + exact lowerE_proj_run_profile_sound_within_below hborrow htarget + (.ctor hfield) hbranchRun hextends havailable) + (hlit := by + intro _ hbranchRun + exact lowerE_lit_run_profile_sound_below hbranchRun) + (herased := by + intro hbranchRun + exact lowerE_erased_run_profile_sound_below hbranchRun) + hsource hrun + +/-- Reachable-state dynamic borrowing exposes the expression subrun's final +state so its suffix proof can be threaded into the exact-profile result. -/ +theorem lowerBorrow_dynamic_run_profile_sound_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {ambient : LowSt} {fuel : Nat} + {input output : VEnv} {expr : IxIR0.Expr} + {emit : Emit} {av : AVal} {release : Bool} + {state finalState : LowSt} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {profile : SourceProfile} + (hexpr : ∀ {exprOutput : VEnv} {exprEmit : Emit} {exprAv : AVal} + {exprState : LowSt}, + (lowerE src fuel input .shared expr).run state = + .ok (exprOutput, exprEmit, exprAv) exprState → + ExtraExtends exprState ambient → + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input exprOutput + sourceEnv sourceEnv sourceValue .shared exprEmit exprAv profile) + (hshape : DynamicBorrowHead expr) + (hrun : (lowerBorrow src (fuel + 1) input expr).run state = + .ok (output, emit, av, release) finalState) + (hextends : ExtraExtends finalState ambient) : + LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue emit av release profile := by + exact (lowerBorrow_dynamic_run_core + (ExprResult := fun exprOutput exprEmit exprAv exprState => + ExtraExtends exprState ambient → + LowerResultProfileSoundBelow funRel recSelfRel ctx cur limit input + exprOutput sourceEnv sourceEnv sourceValue .shared exprEmit exprAv + profile) + (BorrowResult := fun borrowOutput borrowEmit borrowAv borrowRelease + borrowState => + ExtraExtends borrowState ambient → + LowerBorrowProfileSoundBelow funRel recSelfRel ctx cur limit input + borrowOutput sourceEnv sourceEnv sourceValue borrowEmit borrowAv + borrowRelease profile) + (hexpr := fun hsubrun hwithin => hexpr hsubrun hwithin) + (hslot := fun hsound hwithin => + (hsound hwithin).asBorrowSlot) + (hconst := fun hsound hwithin => + (hsound hwithin).asBorrowConst) + hshape hrun) hextends + +theorem lowerBorrowProfilePreservesWithinBelow_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEProfilePreservesWithinBelow funRel recSelfRel sourceCtx ctx + cur limit src ambient fuel) : + LowerBorrowProfilePreservesWithinBelow funRel recSelfRel sourceCtx ctx cur + limit src ambient (fuel + 1) := by + intro input output expr sourceEnv sourceFuel sourceValue sourceProfile + state finalState emit av release hsource hrun hextends havailable + cases expr with + | var index => + cases hsource with + | var hlookup => + exact lowerBorrow_var_run_profile_sound_below hlookup hrun + | ref address => + exact lowerBorrow_dynamic_run_profile_sound_within_below + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.ref address) hrun hextends + | app function argument => + exact lowerBorrow_dynamic_run_profile_sound_within_below + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.app function argument) hrun hextends + | lam uses body => + exact lowerBorrow_dynamic_run_profile_sound_within_below + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.lam uses body) hrun hextends + | letE uses value body => + exact lowerBorrow_dynamic_run_profile_sound_within_below + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.letE uses value body) hrun hextends + | proj index source => + exact lowerBorrow_dynamic_run_profile_sound_within_below + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.proj index source) hrun hextends + | lit literal => + exact lowerBorrow_dynamic_run_profile_sound_within_below + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.lit literal) hrun hextends + | erased => + exact lowerBorrow_dynamic_run_profile_sound_within_below + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + .erased hrun hextends + + +/-! ### Closed reachable-state exact-profile induction -/ + +/-- The complete exact-profile invariant for the mutually recursive lowering +cluster at one compiler-fuel index. -/ +structure LowerProfileClusterWithin + (sourceCtx : IxIR0.Ctx) (src : IxIR0.Env) (ambient : LowSt) + (recSelfRel : RecSelfRel) (ctx : Ctx) (cur : FnDef) + (fuel : Nat) : Prop where + expr : LowerEProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel + borrow : LowerBorrowProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel + spine : LowerSpineProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel + args : LowerArgsProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel + applyRest : ApplyRestNonErasedProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel + +/-- Complete compiler-fuel induction for exact source-profile preservation, +assuming paired declaration and higher-order application profile contracts +for the final target context. -/ +theorem lowerProfileClusterWithin + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprofiles : CompilerProfileContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) : + ∀ fuel, + LowerProfileClusterWithin sourceCtx src ambient recSelfRel ctx cur + fuel + | 0 => by + exact { + expr := lowerEProfilePreservesWithin_zero src ambient + borrow := lowerBorrowProfilePreservesWithin_zero src ambient + spine := lowerSpineProfilePreservesWithin_zero src ambient + args := lowerArgsProfilePreservesWithin_zero src ambient + applyRest := + applyRestNonErasedProfilePreservesWithin_zero src ambient } + | fuel + 1 => by + have hprev := lowerProfileClusterWithin (recSelfRel := recSelfRel) + (cur := cur) henv hrepresented hcontracts hvalues hprofiles fuel + have hargs : LowerArgsProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx + ctx cur src ambient (fuel + 1) := + lowerArgsProfilePreservesWithin_succ hprev.expr hprev.args + have hrest : ApplyRestNonErasedProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx + ctx cur src ambient (fuel + 1) := + applyRestNonErasedProfilePreservesWithin_succ hprev.args + hcontracts.apply hvalues.apply hprofiles.apply + have hborrow : LowerBorrowProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx + ctx cur src ambient (fuel + 1) := + lowerBorrowProfilePreservesWithin_succ hprev.expr + cases fuel with + | zero => + have hspine : LowerSpineProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel + sourceCtx ctx cur src ambient 1 := + lowerSpineProfilePreservesWithin_one src ambient + have hexpr : LowerEProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel + sourceCtx ctx cur src ambient 1 := by + intro input output world expr sourceEnv sourceFuel sourceValue + sourceProfile state finalState emit av hsource hrun hextends + havailable + exact lowerE_run_profile_sound_within (fuel := 0) henv + hprev.expr hprev.spine hprev.borrow hargs hrest + (lowerExtraMonotone src 2).knownCall hcontracts hvalues + hprofiles (fun body => lowerE_releasesTrackedFirst src 0 body) + hsource hrun hextends hrepresented havailable + exact { + expr := hexpr + borrow := hborrow + spine := hspine + args := hargs + applyRest := hrest } + | succ fuel => + have hprior := lowerProfileClusterWithin + (recSelfRel := recSelfRel) (cur := cur) henv hrepresented + hcontracts hvalues hprofiles fuel + have hspine : LowerSpineProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel + sourceCtx ctx cur src ambient (fuel + 2) := by + intro input output world head args sourceEnv sourceResult + sourceProfile state finalState emit av hargsNonempty hsource hrun + hextends havailable + exact lowerSpine_run_profile_sound_within (fuel := fuel) henv + hprev.spine hprev.expr + (lowerE_reflectsErased sourceCtx src (fuel + 1)) hprior.args + hprior.applyRest hprev.applyRest + (lowerExtraMonotone src (fuel + 1)).knownCall hcontracts + hvalues hprofiles hargsNonempty hsource hrun hextends + hrepresented havailable + have hexpr : LowerEProfilePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel + sourceCtx ctx cur src ambient (fuel + 2) := by + intro input output world expr sourceEnv sourceFuel sourceValue + sourceProfile state finalState emit av hsource hrun hextends + havailable + exact lowerE_run_profile_sound_within (fuel := fuel + 1) henv + hprev.expr hprev.spine hprev.borrow hargs hrest + (lowerExtraMonotone src (fuel + 3)).knownCall hcontracts + hvalues hprofiles + (fun body => lowerE_releasesTrackedFirst src (fuel + 1) body) + hsource hrun hextends hrepresented havailable + exact { + expr := hexpr + borrow := hborrow + spine := hspine + args := hargs + applyRest := hrest } + +/-- Ordinary exact-profile expression lowering, with no synthetic recursive +self entry in the logical input environment. -/ +theorem lowerE_run_profile_sound_within_noRecSelf + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprofiles : CompilerProfileContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {fuel : Nat} {input output : VEnv} {world : Ixon.Owned} + {expr : IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceFuel : Nat} {sourceValue : IxIR0.Value} + {profile : SourceProfile} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hsource : IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv expr + sourceValue profile) + (hrun : (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hno : NoRecSelf input) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur input + output sourceEnv sourceEnv sourceValue world emit av profile := + (lowerProfileClusterWithin (recSelfRel := recSelfRel) (cur := cur) henv + hrepresented hcontracts hvalues hprofiles fuel).expr hsource hrun + hextends (SelfProfileAvailable.of_noRecSelf hno) + +/-- Recursor-rule exact-profile expression lowering with the generated +current function's paired value, ownership, and profile contract. -/ +theorem lowerE_run_profile_sound_within_currentSelf + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprofiles : CompilerProfileContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {fuel : Nat} {input output : VEnv} {world : Ixon.Owned} + {expr : IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceFuel : Nat} {sourceValue : IxIR0.Value} + {profile : SourceProfile} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hsource : IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv expr + sourceValue profile) + (hrun : (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hself : CurrentSelfProfileContract + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur) : + LowerResultProfileSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur input + output sourceEnv sourceEnv sourceValue world emit av profile := + (lowerProfileClusterWithin (recSelfRel := recSelfRel) (cur := cur) henv + hrepresented hcontracts hvalues hprofiles fuel).expr hsource hrun + hextends (SelfProfileAvailable.of_contract hself) + +/-! ### Target-fuel-bounded closed reachable profile induction -/ + +/-- The complete exact-profile invariant for the mutually recursive lowering +cluster at one compiler-fuel index. -/ +structure LowerProfileClusterWithinBelow + (sourceCtx : IxIR0.Ctx) (src : IxIR0.Env) (ambient : LowSt) + (recSelfRel : RecSelfRel) (ctx : Ctx) (cur : FnDef) + (limit fuel : Nat) : Prop where + expr : LowerEProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel + borrow : LowerBorrowProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel + spine : LowerSpineProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel + args : LowerArgsProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel + applyRest : ApplyRestNonErasedProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel + +/-- Complete compiler-fuel induction for exact source-profile preservation, +assuming paired declaration and higher-order application profile contracts +for the final target context. -/ +theorem lowerProfileClusterWithinBelow + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprofiles : CompilerProfileContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) : + ∀ fuel, + LowerProfileClusterWithinBelow sourceCtx src ambient recSelfRel ctx cur limit + fuel + | 0 => by + exact { + expr := lowerEProfilePreservesWithinBelow_zero src ambient + borrow := lowerBorrowProfilePreservesWithinBelow_zero src ambient + spine := lowerSpineProfilePreservesWithinBelow_zero src ambient + args := lowerArgsProfilePreservesWithinBelow_zero src ambient + applyRest := + applyRestNonErasedProfilePreservesWithinBelow_zero src ambient } + | fuel + 1 => by + have hprev := lowerProfileClusterWithinBelow (recSelfRel := recSelfRel) + (cur := cur) henv hrepresented hcontracts hvalues hprofiles fuel + have hargs : LowerArgsProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx + ctx cur limit src ambient (fuel + 1) := + lowerArgsProfilePreservesWithinBelow_succ hprev.expr hprev.args + have hrest : ApplyRestNonErasedProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx + ctx cur limit src ambient (fuel + 1) := + applyRestNonErasedProfilePreservesWithinBelow_succ hprev.args + hcontracts.apply hvalues.apply hprofiles.apply + have hborrow : LowerBorrowProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx + ctx cur limit src ambient (fuel + 1) := + lowerBorrowProfilePreservesWithinBelow_succ hprev.expr + cases fuel with + | zero => + have hspine : LowerSpineProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel + sourceCtx ctx cur limit src ambient 1 := + lowerSpineProfilePreservesWithinBelow_one src ambient + have hexpr : LowerEProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel + sourceCtx ctx cur limit src ambient 1 := by + intro input output world expr sourceEnv sourceFuel sourceValue + sourceProfile state finalState emit av hsource hrun hextends + havailable + exact lowerE_run_profile_sound_within_below (fuel := 0) henv + hprev.expr hprev.spine hprev.borrow hargs hrest + (lowerExtraMonotone src 2).knownCall hcontracts hvalues + hprofiles (fun body => lowerE_releasesTrackedFirst src 0 body) + hsource hrun hextends hrepresented havailable + exact { + expr := hexpr + borrow := hborrow + spine := hspine + args := hargs + applyRest := hrest } + | succ fuel => + have hprior := lowerProfileClusterWithinBelow + (recSelfRel := recSelfRel) (cur := cur) henv hrepresented + hcontracts hvalues hprofiles fuel + have hspine : LowerSpineProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel + sourceCtx ctx cur limit src ambient (fuel + 2) := by + intro input output world head args sourceEnv sourceResult + sourceProfile state finalState emit av hargsNonempty hsource hrun + hextends havailable + exact lowerSpine_run_profile_sound_within_below (fuel := fuel) henv + hprev.spine hprev.expr + (lowerE_reflectsErased sourceCtx src (fuel + 1)) hprior.args + hprior.applyRest hprev.applyRest + (lowerExtraMonotone src (fuel + 1)).knownCall hcontracts + hvalues hprofiles hargsNonempty hsource hrun hextends + hrepresented havailable + have hexpr : LowerEProfilePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel + sourceCtx ctx cur limit src ambient (fuel + 2) := by + intro input output world expr sourceEnv sourceFuel sourceValue + sourceProfile state finalState emit av hsource hrun hextends + havailable + exact lowerE_run_profile_sound_within_below (fuel := fuel + 1) henv + hprev.expr hprev.spine hprev.borrow hargs hrest + (lowerExtraMonotone src (fuel + 3)).knownCall hcontracts + hvalues hprofiles + (fun body => lowerE_releasesTrackedFirst src (fuel + 1) body) + hsource hrun hextends hrepresented havailable + exact { + expr := hexpr + borrow := hborrow + spine := hspine + args := hargs + applyRest := hrest } + +/-- Ordinary exact-profile expression lowering, with no synthetic recursive +self entry in the logical input environment. -/ +theorem lowerE_run_profile_sound_within_noRecSelf_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprofiles : CompilerProfileContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + {fuel : Nat} {input output : VEnv} {world : Ixon.Owned} + {expr : IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceFuel : Nat} {sourceValue : IxIR0.Value} + {profile : SourceProfile} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hsource : IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv expr + sourceValue profile) + (hrun : (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hno : NoRecSelf input) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur limit input + output sourceEnv sourceEnv sourceValue world emit av profile := + (lowerProfileClusterWithinBelow (recSelfRel := recSelfRel) (cur := cur) henv + hrepresented hcontracts hvalues hprofiles fuel).expr hsource hrun + hextends (SelfProfileAvailableBelow.of_noRecSelf hno) + +/-- Recursor-rule exact-profile expression lowering with the generated +current function's paired value, ownership, and profile contract. -/ +theorem lowerE_run_profile_sound_within_currentSelf_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprofiles : CompilerProfileContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + {fuel : Nat} {input output : VEnv} {world : Ixon.Owned} + {expr : IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceFuel : Nat} {sourceValue : IxIR0.Value} + {profile : SourceProfile} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hsource : IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceEnv expr + sourceValue profile) + (hrun : (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hself : CurrentSelfProfileContractBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit) : + LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur limit input + output sourceEnv sourceEnv sourceValue world emit av profile := + (lowerProfileClusterWithinBelow (recSelfRel := recSelfRel) (cur := cur) henv + hrepresented hcontracts hvalues hprofiles fuel).expr hsource hrun + hextends (SelfProfileAvailableBelow.of_contract hself) + +/-- Profile equality transports a funded higher-order application run. -/ +theorem ProfileFundedApplyRun.of_profile_eq + {ctx : Ctx} {fuel : Nat} {before after : Store} + {function : RVal} {args : List RVal} {value : RVal} + {left right : SourceProfile} + (hcost : ProfileFundedApplyRun ctx fuel before function args after value + left) + (hprofile : left = right) : + ProfileFundedApplyRun ctx fuel before function args after value right := by + subst right + exact hcost + +/-- Any larger source ownership allowance also funds an application run. -/ +theorem ProfileFundedApplyRun.monoProfile + {ctx : Ctx} {fuel : Nat} {before after : Store} + {function : RVal} {args : List RVal} {value : RVal} + {smaller larger : SourceProfile} + (hcost : ProfileFundedApplyRun ctx fuel before function args after value + smaller) + (hle : OwnershipAllowanceLE + (sourceProfileOwnershipAllowance smaller) + (sourceProfileOwnershipAllowance larger)) : + ProfileFundedApplyRun ctx fuel before function args after value larger := by + obtain ⟨allowance, hrunCost, hfunded⟩ := hcost + exact ⟨allowance, hrunCost, hfunded.trans hle⟩ + +/-- Profile equality transports a funded declaration invocation run. -/ +theorem ProfileFundedInvokeRun.of_profile_eq + {ctx : Ctx} {fuel : Nat} {address : Ixon.Address} + {args : List RVal} {before after : Store} {value : RVal} + {left right : SourceProfile} + (hcost : ProfileFundedInvokeRun ctx fuel address args before after value + left) + (hprofile : left = right) : + ProfileFundedInvokeRun ctx fuel address args before after value right := by + subst right + exact hcost + +/-- Any larger source ownership allowance also funds an invocation run. -/ +theorem ProfileFundedInvokeRun.monoProfile + {ctx : Ctx} {fuel : Nat} {address : Ixon.Address} + {args : List RVal} {before after : Store} {value : RVal} + {smaller larger : SourceProfile} + (hcost : ProfileFundedInvokeRun ctx fuel address args before after value + smaller) + (hle : OwnershipAllowanceLE + (sourceProfileOwnershipAllowance smaller) + (sourceProfileOwnershipAllowance larger)) : + ProfileFundedInvokeRun ctx fuel address args before after value larger := by + obtain ⟨allowance, hrunCost, hfunded⟩ := hcost + exact ⟨allowance, hrunCost, hfunded.trans hle⟩ + +/-- Scalar extern invocation is ownership-free and therefore can be funded +by any exact source fragment assigned to that fire. -/ +theorem ProfileFundedInvokeRun.extern + {ctx : Ctx} {fuel : Nat} {address : Ixon.Address} + {args : List RVal} {store : Store} {value : RVal} {arity : Nat} + {profile : SourceProfile} + (horder : AllocationOrderInvariant store) + (hargs : ValuesInBounds store args) + (hdecl : ctx.decls address = some (.extern arity)) + (harity : args.length = arity) + (hcall : callScalarOracle ctx address args = .ok value) : + ProfileFundedInvokeRun ctx (fuel + 1) address args store store value + profile := + ⟨⟨0, 0⟩, InvokeOwnershipRunCost.extern horder hargs hdecl harity hcall, + zeroOwnershipAllowance_le_profile profile⟩ + + +/-- Releasing arguments supplied to an erased function needs no ownership +allowance, so any enclosing source profile can fund the branch. -/ +theorem ProfileFundedApplyRun.erased + {ctx : Ctx} {fuel : Nat} {before after : Store} {args : List RVal} + {profile : SourceProfile} + (horder : AllocationOrderInvariant before) + (hargs : ValuesInBounds before args) + (hdrop : dropMany ctx fuel before args = .ok after) : + ProfileFundedApplyRun ctx (fuel + 1) before .erased args after .erased + profile := + ⟨⟨0, 0⟩, ApplyOwnershipRunCost.erased horder hargs hdrop, + zeroOwnershipAllowance_le_profile profile⟩ + +/-- A PAP under-application spends its captured-root retains and the +enclosing source application's evaluation charge on the successor PAP. -/ +theorem ProfileFundedApplyRun.papUnder + {ctx : Ctx} {fuel : Nat} {before duplicated ready : Store} + {location arity rc : Nat} {address : Ixon.Address} + {world : Ixon.Owned} + {captured : Array RVal} {args : List RVal} + (horder : AllocationOrderInvariant before) + (hargs : ValuesInBounds before args) + (hbox : before.get? location = + some ⟨world, rc, .papN address arity captured⟩) + (hdup : dupVals before captured.toList = .ok duplicated) + (hdrop : dropVal ctx fuel duplicated (.loc location) = .ok ready) + (hunder : (captured.toList ++ args).length < arity) : + ProfileFundedApplyRun ctx (fuel + 1) before (.loc location) args + (ready.allocNode .shared + (.papN address arity (captured.toList ++ args).toArray)).1 + (.loc (ready.allocNode .shared + (.papN address arity (captured.toList ++ args).toArray)).2) + (IxIR0.DynamicCost.retain captured.toList.length + + IxIR0.DynamicCost.tick .evalApp) := by + refine ⟨(retainedOwnershipAllowance captured.toList.length).add ⟨1, 1⟩, + ApplyOwnershipRunCost.papUnder horder hargs hbox hdup hdrop hunder, ?_⟩ + rw [sourceProfileOwnershipAllowance_add, + sourceProfileOwnershipAllowance_retain, + sourceProfileOwnershipAllowance_tick_of_evals_eq_one .evalApp (by rfl)] + exact (OwnershipAllowanceLE.refl _).add allocatedNodeAllowance_le_eval + +/-- Exact PAP saturation combines the captured-prefix retains with the +profile-funded dynamic invocation. -/ +theorem ProfileFundedApplyRun.papExact + {ctx : Ctx} {fuel : Nat} {before duplicated ready after : Store} + {location arity rc : Nat} {address : Ixon.Address} + {world : Ixon.Owned} {captured : Array RVal} {args : List RVal} + {value : RVal} {invokeProfile : SourceProfile} {declaration : Decl} + (horder : AllocationOrderInvariant before) + (hargs : ValuesInBounds before args) + (hbox : before.get? location = + some ⟨world, rc, .papN address arity captured⟩) + (hdup : dupVals before captured.toList = .ok duplicated) + (hdrop : dropVal ctx fuel duplicated (.loc location) = .ok ready) + (hexact : (captured.toList ++ args).length = arity) + (hdecl : ctx.decls address = some declaration) + (hpapsafe : declPapSafe declaration = true) + (hinvoke : ProfileFundedInvokeRun ctx fuel address + (captured.toList ++ args) ready after value invokeProfile) : + ProfileFundedApplyRun ctx (fuel + 1) before (.loc location) args after + value + (IxIR0.DynamicCost.retain captured.toList.length + invokeProfile) := by + obtain ⟨invokeAllowance, hinvokeCost, hinvokeFunded⟩ := hinvoke + refine ⟨(retainedOwnershipAllowance captured.toList.length).add + invokeAllowance, + ApplyOwnershipRunCost.papExact horder hargs hbox hdup hdrop hexact + hdecl hpapsafe hinvokeCost, ?_⟩ + rw [sourceProfileOwnershipAllowance_add, + sourceProfileOwnershipAllowance_retain] + exact (OwnershipAllowanceLE.refl _).add hinvokeFunded + +/-- PAP over-application composes the prefix retains, saturated invocation, +and recursively profiled application of the remaining arguments. -/ +theorem ProfileFundedApplyRun.papOver + {ctx : Ctx} {fuel : Nat} + {before duplicated ready called after : Store} + {location arity rc : Nat} {address : Ixon.Address} + {world : Ixon.Owned} {captured : Array RVal} {args : List RVal} + {calledValue value : RVal} {declaration : Decl} + {invokeProfile applyProfile : SourceProfile} + (horder : AllocationOrderInvariant before) + (hargs : ValuesInBounds before args) + (hbox : before.get? location = + some ⟨world, rc, .papN address arity captured⟩) + (hdup : dupVals before captured.toList = .ok duplicated) + (hdrop : dropVal ctx fuel duplicated (.loc location) = .ok ready) + (hover : arity < (captured.toList ++ args).length) + (hdecl : ctx.decls address = some declaration) + (hpapsafe : declPapSafe declaration = true) + (hinvoke : ProfileFundedInvokeRun ctx fuel address + ((captured.toList ++ args).take arity) ready called calledValue + invokeProfile) + (happly : ProfileFundedApplyRun ctx fuel called calledValue + ((captured.toList ++ args).drop arity) after value applyProfile) : + ProfileFundedApplyRun ctx (fuel + 1) before (.loc location) args after + value + ((IxIR0.DynamicCost.retain captured.toList.length + invokeProfile) + + applyProfile) := by + obtain ⟨invokeAllowance, hinvokeCost, hinvokeFunded⟩ := hinvoke + obtain ⟨applyAllowance, happlyCost, happlyFunded⟩ := happly + refine ⟨((retainedOwnershipAllowance captured.toList.length).add + invokeAllowance).add applyAllowance, + ApplyOwnershipRunCost.papOver horder hargs hbox hdup hdrop hover + hdecl hpapsafe hinvokeCost happlyCost, ?_⟩ + rw [sourceProfileOwnershipAllowance_add, + sourceProfileOwnershipAllowance_add, + sourceProfileOwnershipAllowance_retain] + exact ((OwnershipAllowanceLE.refl _).add hinvokeFunded).add happlyFunded + +/-- Exact profile preservation for `applyGo` at the current evaluator index. +Residual saturation and recursive over-application are requested only +strictly below this index. The source/runtime graph and ownership hypotheses +keep the profile split synchronized with the concrete PAP argument split. -/ +theorem applyProfilePreservesAt_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {ctx : Ctx} {limit : Nat} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + (hprofiles : CompilerProfileContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) : + ApplyProfilePreservesAt + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx limit := by + intro before after function args value sourceFunction sourceResult + sourceArgs sourceRest rest profile horder hfunction hargs hsource hframe + hown hnonempty hrun + have hargsBounds : ValuesInBounds before args := by + intro runtime hmember + have hroot : (⟨.shared, runtime⟩ : Sim.Root) ∈ + ⟨.shared, function⟩ :: Sim.rootsFor .shared args ++ rest := by + apply List.mem_cons_of_mem + apply List.mem_append_left rest + simpa [Sim.rootsFor] using hmember + exact rootOwnership_valueInBounds_of_mem hown hroot + cases limit with + | zero => simp [applyGo] at hrun + | succ fuel => + cases hfunction with + | lit => simp [applyGo] at hrun + | erased => + have hsourceResult : sourceResult = .erased := + hsource.toSourceApplies.deterministic + (SourceApplies.erased sourceCtx sourceArgs) + subst sourceResult + simp only [applyGo] at hrun + cases hdrop : dropMany ctx fuel before args with + | error error => + rw [hdrop, bindErr] at hrun + contradiction + | ok dropped => + rw [hdrop, bindOk] at hrun + injection hrun with hpair + cases hpair + exact ProfileFundedApplyRun.erased horder hargsBounds hdrop + | @ctor sourceAddress sourceTag sourceFields loc boxWorld rc cid fields + hget haddress htag hfields => + simp [applyGo, hget] at hrun + | @function relatedFunction address arity captures loc rc got hget hfun + hgot => + simp only [applyGo] at hrun + rw [hget] at hrun + dsimp only at hrun + cases hdup : dupVals before got.toList with + | error error => + rw [hdup, bindErr] at hrun + contradiction + | ok dupStore => + rw [hdup, bindOk] at hrun + cases hdrop : dropVal ctx fuel dupStore (.loc loc) with + | error error => + rw [hdrop, bindErr] at hrun + contradiction + | ok readyStore => + rw [hdrop, bindOk] at hrun + let total := got.toList ++ args + obtain ⟨hgotReady, hargsReady, hframeReady, hready⟩ := + applyGo_preparePap_valueGraphs hget hgot hargs hframe hown + hdup hdrop + have hreadyOrder : AllocationOrderInvariant readyStore := + (horder.dupVals hdup).dropVal hdrop + split at hrun + next hunder => + injection hrun with hpair + cases hpair + have hbase := ProfileFundedApplyRun.papUnder horder hargsBounds + hget hdup hdrop (by simpa [total] using hunder) + have hfunded := + CompilerFunctionRel.underApplyProfileFunding henv hfun hsource + hnonempty + have haligned : OwnershipAllowanceLE + (sourceProfileOwnershipAllowance + (IxIR0.DynamicCost.retain got.toList.length + + IxIR0.DynamicCost.tick .evalApp)) + (sourceProfileOwnershipAllowance profile) := by + rw [← hgotReady.length] + exact hfunded + simpa [total] using hbase.monoProfile haligned + next hnotUnder => + split at hrun + next hexact => + obtain ⟨declaration, hdeclaration, hpapsafe, hinvokeRun⟩ : + ∃ declaration, + ctx.decls address = some declaration ∧ + declPapSafe declaration = true ∧ + invoke ctx fuel address (got.toList ++ args) readyStore = + .ok (after, value) := by + cases hdecl : ctx.decls address with + | none => simp [hdecl] at hrun + | some declaration => + cases hpapsafe : declPapSafe declaration with + | false => simp [hdecl, hpapsafe] at hrun + | true => + refine ⟨declaration, rfl, hpapsafe, ?_⟩ + simpa [hdecl, hpapsafe, total] using hrun + have hfullSourceLength : + (captures ++ sourceArgs).length = arity := by + have htotalLength := (hgotReady.append hargsReady).length + have hexact' : (got.toList ++ args).length = arity := by + simpa [total] using hexact + simp only [List.length_append] at htotalLength hexact' ⊢ + omega + obtain ⟨invokeProfile, hinvokeCost, hfunded⟩ := + hprofiles.residual.preserves (Nat.lt_succ_self fuel) + hreadyOrder hfun hgotReady hargsReady hsource hnonempty + hfullSourceLength hframeReady hready hinvokeRun + have hbase := ProfileFundedApplyRun.papExact horder hargsBounds + hget hdup hdrop (by simpa [total] using hexact) + hdeclaration hpapsafe hinvokeCost + have haligned : OwnershipAllowanceLE + (sourceProfileOwnershipAllowance + (IxIR0.DynamicCost.retain got.toList.length + + invokeProfile)) + (sourceProfileOwnershipAllowance profile) := by + rw [← hgotReady.length] + exact hfunded + exact hbase.monoProfile haligned + next hover => + have hfunUnder := hfun.underfilled + have hgotUnder : got.toList.length < arity := by + have hlength := hgotReady.length + omega + have hgotLe : got.toList.length ≤ arity := + Nat.le_of_lt hgotUnder + have hoverLength : arity < total.length := by + have hnotExact : total.length ≠ arity := by + intro heq + apply hover + simpa [total] using heq + have hle : arity ≤ total.length := + Nat.le_of_not_gt hnotUnder + omega + let missing := arity - got.toList.length + have hmissing : got.toList.length + missing = arity := by + exact Nat.add_sub_of_le hgotLe + have hmissingLe : missing ≤ args.length := by + simp only [total, List.length_append] at hoverLength + omega + have hmissingPos : 0 < missing := by omega + have hmissingLt : missing < args.length := by + simp only [total, List.length_append] at hoverLength + omega + have htakeTotal : total.take arity = + got.toList ++ args.take missing := by + rw [List.take_append] + rw [List.take_of_length_le hgotLe] + have hdropTotal : total.drop arity = args.drop missing := by + rw [List.drop_append] + rw [List.drop_eq_nil_of_le hgotLe] + rfl + obtain ⟨middleSource, prefixProfile, tailProfile, + hprefixApply, htailApply, hprofileEq⟩ := + hsource.splitAt missing + have hsourceMissingLe : missing ≤ sourceArgs.length := by + have hlength := hargsReady.length + omega + have hsourceMissingLt : missing < sourceArgs.length := by + have hlength := hargsReady.length + omega + have hprefixLength : + (sourceArgs.take missing).length = missing := by + simp [List.length_take, hsourceMissingLe] + have hprefixNonempty : sourceArgs.take missing ≠ [] := by + intro hempty + rw [hempty] at hprefixLength + simp only [List.length_nil] at hprefixLength + omega + have htailNonempty : sourceArgs.drop missing ≠ [] := + drop_nonempty_of_lt_length hsourceMissingLt + have hfullPrefixLength : + (captures ++ sourceArgs.take missing).length = arity := by + have hcaptureLength := hgotReady.length + simp only [List.length_append, hprefixLength] + omega + have hprefixGraph := hargsReady.take missing + have htailGraph := hargsReady.drop missing + have htailWorld : ∀ runtime, + runtime ∈ args.drop missing → + Sim.HasWorld readyStore .shared runtime := by + intro runtime hmember + apply hready.roots_world ⟨.shared, runtime⟩ + apply List.mem_append_left rest + have hmemberArgs : runtime ∈ args := + List.mem_of_mem_drop hmember + have hmemberTotal : runtime ∈ total := + List.mem_append_right got.toList hmemberArgs + simpa [total, Sim.rootsFor] using hmemberTotal + let tailSourceRest : List (Ixon.Owned × IxIR0.Value) := + (sourceArgs.drop missing).map + (fun source => (.shared, source)) + let tailRoots : List Sim.Root := + Sim.rootsFor .shared (args.drop missing) + have htailFrame : Sim.RootsGraph + (CompilerFunctionRel sourceCtx src ambient) readyStore + tailSourceRest tailRoots := by + exact htailGraph.rootsGraph .shared htailWorld + have hcombinedFrame : Sim.RootsGraph + (CompilerFunctionRel sourceCtx src ambient) readyStore + (tailSourceRest ++ sourceRest) (tailRoots ++ rest) := + htailFrame.append hframeReady + have hrootsSplit : Sim.rootsFor .shared total = + Sim.rootsFor .shared (total.take arity) ++ + Sim.rootsFor .shared (total.drop arity) := by + unfold Sim.rootsFor + rw [← List.map_append] + exact congrArg _ (List.take_append_drop arity total).symm + have hpartition : Sim.RootOwnership readyStore + (Sim.rootsFor .shared + (got.toList ++ args.take missing) ++ + (tailRoots ++ rest)) := by + have hsplit := hready + rw [hrootsSplit] at hsplit + rw [htakeTotal, hdropTotal] at hsplit + simpa [tailRoots, List.append_assoc] using hsplit + obtain ⟨declaration, hdeclaration, hpapsafe, hguardRun⟩ : + ∃ declaration, + ctx.decls address = some declaration ∧ + declPapSafe declaration = true ∧ + (invoke ctx fuel address (total.take arity) readyStore >>= + fun called => applyGo ctx fuel called.1 called.2 + (total.drop arity)) = .ok (after, value) := by + cases hdecl : ctx.decls address with + | none => simp [hdecl] at hrun + | some declaration => + cases hpapsafe : declPapSafe declaration with + | false => simp [hdecl, hpapsafe] at hrun + | true => + refine ⟨declaration, rfl, hpapsafe, ?_⟩ + simpa [hdecl, hpapsafe, total] using hrun + cases hinvoke : invoke ctx fuel address + (total.take arity) readyStore with + | error error => + rw [hinvoke, bindErr] at hguardRun + contradiction + | ok called => + rcases called with ⟨calledStore, calledValue⟩ + rw [hinvoke, bindOk] at hguardRun + have hinvokePrefix : invoke ctx fuel address + (got.toList ++ args.take missing) readyStore = + .ok (calledStore, calledValue) := by + rw [← htakeTotal] + exact hinvoke + obtain ⟨invokeProfile, hinvokeCost, hprefixFunded⟩ := + hprofiles.residual.preserves (Nat.lt_succ_self fuel) + hreadyOrder hfun hgotReady hprefixGraph hprefixApply + hprefixNonempty hfullPrefixLength hcombinedFrame + hpartition hinvokePrefix + have hcalled := invoke_compilerFunction_value_owned_below + henv hrepresented hcontracts hvalues + (fun memo baseFunction hlookup href => + ctorWrapper_fnValueContract + (funRel := CompilerFunctionRel sourceCtx src ambient) + sourceCtx ctx memo.source memo.tag memo.arity + baseFunction hlookup href) + (fun memo => ctorWrapper_fnOwnershipContract ctx + memo.source memo.tag memo.arity) + hfun hgotReady hprefixGraph hprefixApply.toSourceApplies + hcombinedFrame hpartition (Nat.le_succ fuel) hinvokePrefix + have htailLength : tailSourceRest.length = tailRoots.length := by + simp [tailSourceRest, tailRoots, Sim.rootsFor, + hargsReady.length] + obtain ⟨htailFrameAfter, hframeAfter⟩ := + hcalled.2.1.splitAppend htailLength + have htailGraphAfter : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) calledStore + (sourceArgs.drop missing) (args.drop missing) := + htailFrameAfter.valuesGraph + have hrecursiveRun : applyGo ctx fuel calledStore calledValue + (args.drop missing) = .ok (after, value) := by + rw [hdropTotal] at hguardRun + exact hguardRun + have hcalledOrder : AllocationOrderInvariant calledStore := by + obtain ⟨allowance, hinvokeRunCost, _⟩ := hinvokeCost + exact hinvokeRunCost.finalOrderAndValue.1 + have htailCost := + hprofiles.apply.preserves (Nat.lt_succ_self fuel) + hcalledOrder hcalled.1 htailGraphAfter htailApply + hframeAfter hcalled.2.2 htailNonempty hrecursiveRun + have hinvokeCostTotal : ProfileFundedInvokeRun ctx fuel + address (total.take arity) readyStore calledStore + calledValue invokeProfile := by + rw [htakeTotal] + exact hinvokeCost + have htailCostTotal : ProfileFundedApplyRun ctx fuel + calledStore calledValue (total.drop arity) after value + tailProfile := by + rw [hdropTotal] + exact htailCost + have hcomposed := ProfileFundedApplyRun.papOver horder + hargsBounds hget hdup hdrop hoverLength hdeclaration + hpapsafe hinvokeCostTotal htailCostTotal + have hprefixFundedAligned : OwnershipAllowanceLE + (sourceProfileOwnershipAllowance + (IxIR0.DynamicCost.retain got.toList.length + + invokeProfile)) + (sourceProfileOwnershipAllowance prefixProfile) := by + rw [← hgotReady.length] + exact hprefixFunded + have hcombined : OwnershipAllowanceLE + (sourceProfileOwnershipAllowance + ((IxIR0.DynamicCost.retain got.toList.length + + invokeProfile) + tailProfile)) + (sourceProfileOwnershipAllowance + (prefixProfile + tailProfile)) := by + simpa only [sourceProfileOwnershipAllowance_add] using + hprefixFundedAligned.add (OwnershipAllowanceLE.refl + (sourceProfileOwnershipAllowance tailProfile)) + exact (hcomposed.monoProfile hcombined).of_profile_eq + hprofileEq + +/-- A proof-relevant release plan is a zero-profile state transformer for +the complete logical environment graph. This is the paired-cost analogue +of `ReleasePlan.valueSoundBelow`; every released root decreases ownership, +so the prefix needs no positive source allowance. -/ +theorem releasePlan_profileFundedValueStateRunSoundBelow + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} {drops : List SlotDrop} {emit : Emit} + (hplan : ReleasePlan input drops output emit) + (sourceEnv : List IxIR0.Value) : + ∀ sourceRest rest slots, + ProfileFundedEmitStateRunSoundBelow ctx cur limit emit + (GraphOwnsVEnvProtected funRel recSelfRel input sourceEnv + sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel output sourceEnv + sourceRest rest slots) + 0 := by + intro sourceRest rest slots + apply ReleasePlan.traverse (hplan := hplan) + · intro Γ + exact ProfileFundedEmitStateRunSoundBelow.id (fun hpre => hpre) + · intro Γ output i abs drops tailEmit hentry ih + exact ProfileFundedEmitStateRunSoundBelow.comp + (releaseSlotMany_profileFundedStateRunSound_below hentry sourceEnv + sourceRest rest slots) + ih + · intro Γ output i abs drops tailEmit hentry ih + exact ProfileFundedEmitStateRunSoundBelow.comp + (releaseSlotAffine_profileFundedStateRunSound_below hentry sourceEnv + sourceRest rest slots) + ih + +/-- The retained-field phase of a generated recursor branch carries its +complete semantic graph while spending exactly one source retain candidate +per selected field. -/ +theorem FieldRetainPlan.profileFundedValueStateRunSoundBelow + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} {retains : List RecursorFieldRetain} + {emit : Emit} (hplan : FieldRetainPlan input retains output emit) : + ∀ sourceEnv sourceRest rest extra slots borrowed, + ProfileFundedEmitStateRunSoundBelow ctx cur limit emit + (GraphOwnsVEnvRetains funRel recSelfRel input sourceEnv + sourceRest rest extra slots borrowed retains) + (GraphOwnsVEnvRetains funRel recSelfRel output sourceEnv + sourceRest rest extra slots borrowed []) + (IxIR0.DynamicCost.retain retains.length) := by + apply FieldRetainPlan.traverse (hplan := hplan) + · intro Γ sourceEnv sourceRest rest extra slots borrowed + change ProfileFundedEmitStateRunSoundBelow ctx cur limit + (_root_.id : Emit) _ _ 0 + exact ProfileFundedEmitStateRunSoundBelow.id (fun hpre => hpre) + · intro Γ output i placeholderAbs fieldAbs remaining retains tailEmit + hentry ih sourceEnv sourceRest rest extra slots borrowed + have hhead := + ProfileFundedEmitStateRunSoundBelow.localRetainBelow + (retain_borrowed_into_entry_value_opSoundBelow + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) + (sourceEnv := sourceEnv) (sourceRest := sourceRest) + (rest := rest) (extra := extra) (slots := slots) + (borrowed := borrowed) (retains := retains) + (fieldAbs := fieldAbs) (remaining := remaining) hentry) + (by simp [localOpOwnershipAllowance]) + have htail := ih sourceEnv sourceRest rest extra slots borrowed + apply ProfileFundedEmitStateRunSoundBelow.of_profile_eq + (ProfileFundedEmitStateRunSoundBelow.comp hhead htail) + ext <;> simp [IxIR0.DynamicCost.retain] <;> omega + +/-- Paired-cost composition of the three generated recursor-prefix phases: +retain live fields, release the major, and release dead parameters. -/ +theorem recursorPrefixPlans_profileFundedValueStateRunSoundBelow + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + (numArgs nf : Nat) (rhs : IxIR0.Expr) + {fieldOutput rhsInput : VEnv} {fieldEmit parameterEmit : Emit} + (hfieldPlan : FieldRetainPlan + ⟨List.replicate nf (.slot 0 0 .many false), + (numArgs + 1) + nf⟩ + (recursorFieldRetains (numArgs + 1) rhs nf) + fieldOutput fieldEmit) + (hparameterPlan : ReleasePlan + ⟨fieldOutput.entries ++ + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (nf + i) rhs) ++ + [.recSelf (numArgs + 1)], + fieldOutput.depth + 1⟩ + ((parameterDrops 0 (List.replicate numArgs .many) + (fun i => countUses (nf + i) rhs)).map + (SlotDrop.offsetEntry nf)) + rhsInput parameterEmit) : + ∀ sourceEnv sourceRest rest major fields, + ProfileFundedEmitStateRunSoundBelow ctx cur limit + (fieldEmit ∘ + emitOp (.drop (.var (fieldOutput.rel numArgs))) ∘ + parameterEmit) + (GraphOwnsVEnvRetains funRel recSelfRel + (recursorInitialVEnv numArgs nf rhs) sourceEnv + sourceRest rest [⟨.shared, major⟩] + (recursorFieldSlots numArgs (major :: fields)) fields + (recursorFieldRetains (numArgs + 1) rhs nf)) + (GraphOwnsVEnv funRel recSelfRel rhsInput sourceEnv + sourceRest rest) + (IxIR0.DynamicCost.retain + (recursorFieldRetains (numArgs + 1) rhs nf).length) := by + intro sourceEnv sourceRest rest major fields + let frame := + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (nf + i) rhs) ++ + [.recSelf (numArgs + 1)] + have hfieldFramed := hfieldPlan.frameEntries frame + have hfield := + FieldRetainPlan.profileFundedValueStateRunSoundBelow hfieldFramed + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) + sourceEnv sourceRest rest [⟨.shared, major⟩] + (recursorFieldSlots numArgs (major :: fields)) fields + have hfield' : ProfileFundedEmitStateRunSoundBelow ctx cur limit fieldEmit + (GraphOwnsVEnvRetains funRel recSelfRel + (recursorInitialVEnv numArgs nf rhs) sourceEnv + sourceRest rest [⟨.shared, major⟩] + (recursorFieldSlots numArgs (major :: fields)) fields + (recursorFieldRetains (numArgs + 1) rhs nf)) + (GraphOwnsVEnvRetains funRel recSelfRel + (frameVEnvEntries fieldOutput frame) sourceEnv + sourceRest rest [⟨.shared, major⟩] + (recursorFieldSlots numArgs (major :: fields)) fields []) + (IxIR0.DynamicCost.retain + (recursorFieldRetains (numArgs + 1) rhs nf).length) := by + simpa [frame, recursorInitialVEnv, frameVEnvEntries, + List.append_assoc] using hfield + have hmajor : ProfileFundedEmitStateRunSoundBelow ctx cur limit + (emitOp (.drop (.var + ((frameVEnvEntries fieldOutput frame).rel numArgs)))) + (GraphOwnsVEnvRetains funRel recSelfRel + (frameVEnvEntries fieldOutput frame) sourceEnv + sourceRest rest [⟨.shared, major⟩] + (recursorFieldSlots numArgs (major :: fields)) fields []) + (GraphOwnsVEnvProtected funRel recSelfRel + (frameVEnvEntries fieldOutput frame).bump sourceEnv + sourceRest rest + (recursorFieldSlots numArgs (major :: fields))) + 0 := by + apply ProfileFundedEmitStateRunSoundBelow.localZeroBelow + (profile := (0 : SourceProfile)) + · exact drop_major_value_opSoundBelow + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) + (Γ := frameVEnvEntries fieldOutput frame) + (sourceEnv := sourceEnv) (sourceRest := sourceRest) + (rest := rest) + (slots := recursorFieldSlots numArgs (major :: fields)) + (borrowed := fields) + (majorAbs := numArgs) (major := major) + (by simp [recursorFieldSlots]) + · simp [localOpOwnershipAllowance] + have hparameters := + releasePlan_profileFundedValueStateRunSoundBelow hparameterPlan + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) sourceEnv + sourceRest rest (recursorFieldSlots numArgs (major :: fields)) + have hparameters' : ProfileFundedEmitStateRunSoundBelow ctx cur limit + parameterEmit + (GraphOwnsVEnvProtected funRel recSelfRel + (frameVEnvEntries fieldOutput frame).bump sourceEnv + sourceRest rest + (recursorFieldSlots numArgs (major :: fields))) + (GraphOwnsVEnvProtected funRel recSelfRel rhsInput sourceEnv + sourceRest rest + (recursorFieldSlots numArgs (major :: fields))) + 0 := by + simpa [frameVEnvEntries, VEnv.bump, frame, List.append_assoc] + using hparameters + have hforget : ProfileFundedEmitStateRunSoundBelow ctx cur limit + (_root_.id : Emit) + (GraphOwnsVEnvProtected funRel recSelfRel rhsInput sourceEnv + sourceRest rest (recursorFieldSlots numArgs (major :: fields))) + (GraphOwnsVEnv funRel recSelfRel rhsInput sourceEnv sourceRest rest) + 0 := + ProfileFundedEmitStateRunSoundBelow.id (fun hpre => hpre.1) + have hcomposed := ProfileFundedEmitStateRunSoundBelow.comp hfield' + (ProfileFundedEmitStateRunSoundBelow.comp hmajor + (ProfileFundedEmitStateRunSoundBelow.comp hparameters' hforget)) + simpa [frameVEnvEntries, VEnv.rel, Function.comp_def, + IxIR0.DynamicCost.Profile.add_zero, + IxIR0.DynamicCost.Profile.zero_add] using hcomposed + +/-- The compiler retains at most one entry for each constructor field. -/ +theorem recursorFieldRetains_length_le + (fieldAbs : Nat) (rhs : IxIR0.Expr) (fieldCount : Nat) : + (recursorFieldRetains fieldAbs rhs fieldCount).length ≤ fieldCount := by + exact recursorFieldRetains_traverse rhs + (Result := fun _ currentCount retains => + retains.length ≤ currentCount) + (hnil := fun _ => Nat.le_refl 0) + (hskip := by + intro _ currentCount _ _ htail + exact Nat.le_trans htail (Nat.le_succ currentCount)) + (hretain := by + intro _ _ _ _ htail + simpa using Nat.succ_le_succ htail) + fieldAbs fieldCount + +/-- Profiled inversion of a saturated source recursor reference. Besides +the selected source rule and exact RHS trace, the conclusion isolates the +paired allowance contributed by that rule body and all of its fields. -/ +theorem sourceRecursorRef_saturatesProfile_inv + {sourceCtx : IxIR0.Ctx} {address : Ixon.Address} + {numArgs : Nat} {natLit : Bool} {rules : Array IxIR0.RecRule} + {sourceFunction sourceResult major : IxIR0.Value} + {pre : List IxIR0.Value} {profile : SourceProfile} + (hlookup : sourceCtx.env address = + some (.recursor numArgs natLit rules)) + (href : SourceRefValue sourceCtx address sourceFunction) + (hpreLength : pre.length = numArgs) + (happlies : SourceAppliesProfile sourceCtx sourceFunction + (pre ++ [major]) sourceResult profile) : + ∃ tag fields rule bodyFuel bodyProfile, + IxIR0.majorCtor natLit major = .ok (tag, fields) ∧ + rules[tag]? = some rule ∧ + fields.length = rule.fields ∧ + IxIR0.DynamicCost.Eval sourceCtx bodyFuel + (fields.reverse ++ pre.reverse ++ + [.pap (.rec_ address (numArgs + 1)) []]) + rule.rhs sourceResult bodyProfile ∧ + OwnershipAllowanceLE + (sourceProfileOwnershipAllowance + (IxIR0.DynamicCost.retain fields.length + bodyProfile)) + (sourceProfileOwnershipAllowance profile) := by + have hfunction := href.recursorValue hlookup + subst sourceFunction + obtain ⟨middle, prefixProfile, tailProfile, hleft, hright, hprofile⟩ := + happlies.splitAt pre.length + have htake : (pre ++ [major]).take pre.length = pre := by simp + have hdrop : (pre ++ [major]).drop pre.length = [major] := by simp + rw [htake] at hleft + rw [hdrop] at hright + have hunder : ([] ++ pre).length < + (IxIR0.Head.rec_ address (numArgs + 1)).arity := by + simp [IxIR0.Head.arity, hpreLength] + have hcanonical : SourceApplies sourceCtx + (.pap (.rec_ address (numArgs + 1)) []) pre + (.pap (.rec_ address (numArgs + 1)) pre) := + sourcePap_underfills hunder + have hmiddle : middle = .pap (.rec_ address (numArgs + 1)) pre := + hleft.toSourceApplies.deterministic hcanonical + subst middle + cases hright with + | cons hstep htail => + cases htail + cases hstep with + | pap hsaturate => + cases hsaturate with + | pending hne => + exact (hne (by simp [IxIR0.Head.arity, hpreLength])).elim + | full hlength hfire => + cases hfire with + | recursor hlookup' hlast hmajor hrule hfields hbody => + rw [hlookup] at hlookup' + cases hlookup' + have hlast' : (pre ++ [major]).getLast? = some major := by + simp + rw [hlast'] at hlast + cases hlast + have hdropLast : (pre ++ [major]).dropLast = pre := by + simp + rw [hdropLast] at hbody + refine ⟨_, _, _, _, _, hmajor, hrule, hfields, hbody, ?_⟩ + rw [← hprofile] + simp [OwnershipAllowanceLE, + sourceProfileOwnershipAllowance, + IxIR0.DynamicCost.tick, + IxIR0.DynamicCost.retain] + omega + +/-- Execute one selected generated recursor branch with the exact profiled +RHS trace. The static retain plan consumes only the live-field subset; the +source recursor fire funds all fields, so the difference is allowance slack. -/ +theorem lowerRecursorRule_branch_profile_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {fuel numArgs : Nat} {rule : IxIR0.RecRule} + {headState nextState : LowSt} + {fieldOutput rhsInput output : VEnv} + {fieldEmit parameterEmit bodyEmit : Emit} {av : AVal} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprofiles : CompilerProfileContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + (hself : CurrentSelfProfileContractBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit) + (hfieldPlan : FieldRetainPlan + ⟨List.replicate rule.fields (.slot 0 0 .many false), + (numArgs + 1) + rule.fields⟩ + (recursorFieldRetains (numArgs + 1) rule.rhs rule.fields) + fieldOutput fieldEmit) + (hparameterPlan : ReleasePlan + ⟨fieldOutput.entries ++ + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (rule.fields + i) rule.rhs) ++ + [.recSelf (numArgs + 1)], + fieldOutput.depth + 1⟩ + ((parameterDrops 0 (List.replicate numArgs .many) + (fun i => countUses (rule.fields + i) rule.rhs)).map + (SlotDrop.offsetEntry rule.fields)) + rhsInput parameterEmit) + (hbodyRun : (lowerE src fuel rhsInput .shared rule.rhs).run headState = + .ok (output, bodyEmit, av) nextState) + (hextends : ExtraExtends nextState ambient) + {sourcePre : List IxIR0.Value} {pre : List RVal} + {sourceFields : List IxIR0.Value} {fields : List RVal} + {sourceSelf sourceValue : IxIR0.Value} {major : RVal} + {sourceFuel : Nat} {bodyProfile profile : SourceProfile} + (hsource : IxIR0.DynamicCost.Eval sourceCtx sourceFuel + (sourceFields.reverse ++ sourcePre.reverse ++ [sourceSelf]) + rule.rhs sourceValue bodyProfile) + (hprofileFunded : OwnershipAllowanceLE + (sourceProfileOwnershipAllowance + (IxIR0.DynamicCost.retain sourceFields.length + bodyProfile)) + (sourceProfileOwnershipAllowance profile)) + (hpreLength : pre.length = numArgs) + (hfieldsLength : fields.length = rule.fields) + {store store' : Store} {value : RVal} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} + (hpreGraphs : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store sourcePre pre) + (hfieldGraphs : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store sourceFields fields) + (hsourceSelf : recSelfRel sourceSelf (numArgs + 1)) + (horder : AllocationOrderInvariant store) + (hframe : Sim.RootsGraph + (CompilerFunctionRel sourceCtx src ambient) store sourceRest rest) + (hown : Sim.RootOwnership store + (Sim.rootsFor .shared (pre ++ [major]) ++ rest)) + (hfieldWorld : ∀ field ∈ fields, + Sim.HasWorld store .shared field) + {branchFuel : Nat} (hbound : branchFuel ≤ limit) + (hbranchRun : runCode ctx branchFuel cur store + (fields.reverse ++ major :: pre.reverse) + (fieldEmit + (emitOp (.drop (.var (fieldOutput.rel numArgs))) + (parameterEmit + (bodyEmit (.ret (av.toAtom output)))))) = + .ok (store', value)) : + ProfileFundedCodeRun ctx branchFuel cur store + (fields.reverse ++ major :: pre.reverse) + (fieldEmit + (emitOp (.drop (.var (fieldOutput.rel numArgs))) + (parameterEmit + (bodyEmit (.ret (av.toAtom output)))))) + store' value profile := by + have hentry := recursorAltEntry_value_state + (funRel := CompilerFunctionRel sourceCtx src ambient) + (recSelfRel := recSelfRel) numArgs rule.fields rule.rhs + hpreLength hfieldsLength hpreGraphs hfieldGraphs hsourceSelf hframe hown + hfieldWorld + have hprefix := + recursorPrefixPlans_profileFundedValueStateRunSoundBelow + (funRel := CompilerFunctionRel sourceCtx src ambient) + (recSelfRel := recSelfRel) (ctx := ctx) (cur := cur) + (limit := limit) numArgs rule.fields rule.rhs hfieldPlan + hparameterPlan + (sourceFields.reverse ++ sourcePre.reverse ++ [sourceSelf]) + sourceRest rest major fields + have hprotect : ProfileFundedEmitStateRunSoundBelow ctx cur limit + (_root_.id : Emit) + (GraphOwnsVEnv + (CompilerFunctionRel sourceCtx src ambient) recSelfRel rhsInput + (sourceFields.reverse ++ sourcePre.reverse ++ [sourceSelf]) + sourceRest rest) + (GraphOwnsVEnvProtected + (CompilerFunctionRel sourceCtx src ambient) recSelfRel rhsInput + (sourceFields.reverse ++ sourcePre.reverse ++ [sourceSelf]) + sourceRest rest []) + 0 := + ProfileFundedEmitStateRunSoundBelow.id + (fun hpre => ⟨hpre, SlotsRealize.nil⟩) + have hbodySound := lowerE_run_profile_sound_within_currentSelf_below + henv hrepresented hcontracts hvalues hprofiles hsource hbodyRun + hextends hself + have hbodyCost := hbodySound.profileEmits sourceRest rest [] + have hcombined := ProfileFundedEmitStateRunSoundBelow.comp hprefix + (ProfileFundedEmitStateRunSoundBelow.comp hprotect hbodyCost) + have hcombined' : ProfileFundedEmitStateRunSoundBelow ctx cur limit + (fieldEmit ∘ + emitOp (.drop (.var (fieldOutput.rel numArgs))) ∘ + parameterEmit ∘ bodyEmit) + (GraphOwnsVEnvRetains + (CompilerFunctionRel sourceCtx src ambient) recSelfRel + (recursorInitialVEnv numArgs rule.fields rule.rhs) + (sourceFields.reverse ++ sourcePre.reverse ++ [sourceSelf]) + sourceRest rest [⟨.shared, major⟩] + (recursorFieldSlots numArgs (major :: fields)) fields + (recursorFieldRetains (numArgs + 1) rule.rhs rule.fields)) + (GraphOwnsResultProtected + (CompilerFunctionRel sourceCtx src ambient) recSelfRel output + (sourceFields.reverse ++ sourcePre.reverse ++ [sourceSelf]) + sourceValue .shared av sourceRest rest []) + (IxIR0.DynamicCost.retain + (recursorFieldRetains + (numArgs + 1) rule.rhs rule.fields).length + bodyProfile) := by + simpa [Function.comp_def, IxIR0.DynamicCost.Profile.add_zero, + IxIR0.DynamicCost.Profile.zero_add, + IxIR0.DynamicCost.Profile.add_assoc] using hcombined + have hargsBounds : ValuesInBounds store (pre ++ [major]) := by + intro runtime hmember + have hroot : (⟨.shared, runtime⟩ : Sim.Root) ∈ + Sim.rootsFor .shared (pre ++ [major]) := by + simpa [Sim.rootsFor] using hmember + exact rootOwnership_valueInBounds_of_mem hown + (List.mem_append_left rest hroot) + have hfieldsBounds : ValuesInBounds store fields := by + intro field hmember + exact Sim.HasWorld.valueInBounds (hfieldWorld field hmember) + have hbranchBounds : ValuesInBounds store + (fields.reverse ++ major :: pre.reverse) := by + apply ValuesInBounds.append hfieldsBounds.reverse + simpa [List.reverse_append] using hargsBounds.reverse + have hcost := hcombined'.closeRet (av.toAtom output) hbound horder + hbranchBounds hentry (by + simpa [Function.comp_def] using hbranchRun) + apply hcost.monoProfile + have hlive : + (recursorFieldRetains + (numArgs + 1) rule.rhs rule.fields).length ≤ sourceFields.length := by + have hsourceFieldsLength : sourceFields.length = rule.fields := by + exact hfieldGraphs.length.trans hfieldsLength + rw [hsourceFieldsLength] + exact recursorFieldRetains_length_le _ _ _ + have hsubset : OwnershipAllowanceLE + (sourceProfileOwnershipAllowance + (IxIR0.DynamicCost.retain + (recursorFieldRetains + (numArgs + 1) rule.rhs rule.fields).length + bodyProfile)) + (sourceProfileOwnershipAllowance + (IxIR0.DynamicCost.retain sourceFields.length + bodyProfile)) := by + simp [OwnershipAllowanceLE, sourceProfileOwnershipAllowance, + IxIR0.DynamicCost.retain] + omega + exact hsubset.trans hprofileFunded + +private theorem costTraceExceptBindOk {error α β : Type} + (value : α) (next : α → Except error β) : + (Except.ok value >>= next) = next value := rfl + +/-- A generated recursor body preserves the exact source entry profile at +the current target evaluator index. Dispatch itself has no ownership +growth; the selected branch carries the dynamically funded certificate. -/ +theorem lowerRecursor_profilePreservesAt_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {ctx : Ctx} {limit compilerFuel numArgs : Nat} + {natLit : Bool} {rules : Array IxIR0.RecRule} + {address : Ixon.Address} {sourceFunction : IxIR0.Value} + {state finalState : LowSt} {d : FnDef} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprofiles : CompilerProfileContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + (hsrc : src address = some (.recursor numArgs natLit rules)) + (hdecl : ctx.decls address = some (.fn d)) + (href : SourceRefValue sourceCtx address sourceFunction) + (hrun : (lowerRecursor src compilerFuel numArgs natLit rules).run state = + .ok d finalState) + (hextends : ExtraExtends finalState ambient) : + FnProfilePreservesAt + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx address d + (List.replicate (numArgs + 1) .shared) sourceFunction limit := by + simp only [lowerRecursor] at hrun + obtain ⟨alts, rulesState, hrulesRun, hafterRules⟩ := + trackedBindRun_ok_inv hrun + have hpure : + (⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩ : FnDef) = d ∧ + rulesState = finalState := by + simpa using hafterRules + obtain ⟨hd, hstate⟩ := hpure + subst d + subst rulesState + have hsourceLookup : sourceCtx.env address = + some (.recursor numArgs natLit rules) := by + rw [henv] + exact hsrc + have hsourceFunction := href.recursorValue hsourceLookup + subst sourceFunction + let recSelfRel : RecSelfRel := fun value arity => + value = .pap (.rec_ address (numArgs + 1)) [] ∧ + arity = numArgs + 1 + obtain ⟨ownedD, hownedDecl, _, _, hownedContract⟩ := + hcontracts.decls.recursor hsrc + have hownedD : ownedD = + (⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩ : FnDef) := by + have hsame : some (Decl.fn ownedD) = some + (.fn ⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩) := + hownedDecl.symm.trans hdecl + exact Decl.fn.inj (Option.some.inj hsame) + subst ownedD + have hvalueContract : FnValueContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx + ⟨numArgs + 1, .shared, true, .case (.var 0) natLit alts.toArray⟩ + (List.replicate (numArgs + 1) .shared) + (.pap (.rec_ address (numArgs + 1)) []) := by + apply hvalues.decls.fnContract hsrc (by rfl) hdecl href + simp + have hprofileContract : FnProfileContractBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx address + ⟨numArgs + 1, .shared, true, .case (.var 0) natLit alts.toArray⟩ + (List.replicate (numArgs + 1) .shared) + (.pap (.rec_ address (numArgs + 1)) []) limit := by + apply hprofiles.decls.fnContract hsrc (by rfl) hdecl href + simp + have hself : CurrentSelfProfileContractBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + ⟨numArgs + 1, .shared, true, .case (.var 0) natLit alts.toArray⟩ + limit := by + refine ⟨rfl, by omega, hownedContract, ?_, ?_⟩ + · intro candidate hcandidate + change candidate = .pap (.rec_ address (numArgs + 1)) [] ∧ + numArgs + 1 = numArgs + 1 at hcandidate + rcases hcandidate with ⟨rfl, _⟩ + exact hvalueContract + · intro candidate hcandidate + change candidate = .pap (.rec_ address (numArgs + 1)) [] ∧ + numArgs + 1 = numArgs + 1 at hcandidate + rcases hcandidate with ⟨rfl, _⟩ + exact ⟨address, hprofileContract⟩ + have hfinalRepresented : ExtraRepresented ctx finalState := + hrepresented.of_extends hextends + have hownershipSelf : CurrentSelfContractBelow ctx + ⟨numArgs + 1, .shared, true, .case (.var 0) natLit alts.toArray⟩ + limit := ⟨hself.result, hself.ownership.below limit⟩ + have hplan : RecursorRulesPlanBelow ctx + ⟨numArgs + 1, .shared, true, .case (.var 0) natLit alts.toArray⟩ + limit src compilerFuel numArgs state rules.toList.zipIdx + finalState alts := + recursorRulesPlanBelow_of_run (hcontracts.below limit).apply + (hcontracts.below limit).decls hownershipSelf rfl + compilerFuel numArgs hrulesRun hfinalRepresented + intro store store' args value sourceArgs sourceResult sourceRest rest + profile horder hruntimeLength hsourceLength hargs hentry hframe hown + htarget + have hsourceApply : SourceAppliesProfile sourceCtx + (.pap (.rec_ address (numArgs + 1)) []) sourceArgs sourceResult + profile := by + cases hentry with + | applied happly => exact happly + | nullary _ => + have : (0 : Nat) = numArgs + 1 := by + simpa using hsourceLength + omega + have hargsArity : args.length = numArgs + 1 := by + simpa using hruntimeLength + have hrootShape : + Sim.rootsForWorlds (List.replicate (numArgs + 1) .shared) args = + Sim.rootsFor .shared args := + rootsForWorlds_replicate_eq_rootsFor .shared hargsArity + rw [hrootShape] at hown + cases limit with + | zero => simp [runCode] at htarget + | succ branchFuel => + cases hreverse : args.reverse with + | nil => + have hargsNil : args = [] := by + have h := congrArg List.reverse hreverse + simpa using h + simp [hargsNil] at hargsArity + | cons major runtimePre => + have hargsForm : args = runtimePre.reverse ++ [major] := by + have h := congrArg List.reverse hreverse + simpa [List.reverse_cons] using h + have hruntimePreLength : runtimePre.length = numArgs := by + rw [hargsForm] at hargsArity + simp only [List.length_append, List.length_reverse, + List.length_singleton] at hargsArity + omega + obtain ⟨sourcePre, sourceMajor, hsourceArgsForm, + hsourcePreLength, hpreGraphs, hmajorGraph⟩ := + valuesGraph_splitLast hargs hargsForm hruntimePreLength + rw [hsourceArgsForm] at hsourceApply + obtain ⟨sourceTag, sourceFields, sourceRule, sourceFuel, bodyProfile, + hsourceMajor, hsourceRule, hsourceFieldsLength, hsourceEval, + hsourceFunded⟩ := + sourceRecursorRef_saturatesProfile_inv hsourceLookup href + hsourcePreLength hsourceApply + have hmajorWorld : Sim.HasWorld store .shared major := by + apply hown.roots_world ⟨.shared, major⟩ + apply List.mem_append_left rest + simp [Sim.rootsFor, hargsForm] + have hentryOwn : Sim.RootOwnership store + (Sim.rootsFor .shared (runtimePre.reverse ++ [major]) ++ rest) := by + simpa [hargsForm] using hown + rw [hreverse] at htarget + change runCode ctx (branchFuel + 1) + ⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩ + store (major :: runtimePre) + (.case (.var 0) natLit alts.toArray) = + .ok (store', value) at htarget + have hdispatch := htarget + rw [runCode.eq_def] at hdispatch + dsimp only at hdispatch + rw [show resolveAtom (major :: runtimePre) (.var 0) = .ok major + from rfl, costTraceExceptBindOk] at hdispatch + have finish {cidx selectedTag fieldCount : Nat} {body : Code} + (halt : alts.toArray.find? (fun alt => alt.cidx == cidx) = + some (.mk selectedTag fieldCount body)) + (hcidx : cidx = sourceTag) + {targetFields : List RVal} + (hfieldGraphs : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store + sourceFields targetFields) + (htargetFieldsLength : targetFields.length = fieldCount) + (hfieldWorld : ∀ field ∈ targetFields, + Sim.HasWorld store .shared field) + (hbranchRun : runCode ctx branchFuel + ⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩ + store (targetFields.reverse ++ major :: runtimePre) body = + .ok (store', value)) : + ProfileFundedCodeRun ctx (branchFuel + 1) + ⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩ + store (major :: runtimePre) + (.case (.var 0) natLit alts.toArray) store' value profile := by + obtain ⟨rule, headState, nextState, tailRules, tailAlts, + fieldOutput, fieldEmit, rhsInput, parameterEmit, + output, bodyEmit, av, hrule, _, hfieldCount, + hfieldPlan, hparameterPlan, hbodyRun, hbody, htailPlan⟩ := + hplan.find?_run_plan_inv halt + have hsourceRuleAt : rules[cidx]? = some sourceRule := by + rw [hcidx] + exact hsourceRule + have hruleEq : rule = sourceRule := + Option.some.inj (hrule.symm.trans hsourceRuleAt) + subst rule + have htargetRuleLength : targetFields.length = sourceRule.fields := + htargetFieldsLength.trans hfieldCount + have htailExtends : ExtraExtends nextState finalState := + (ExtraMonotone.listMapM + (lowerRecursorRule src compilerFuel numArgs) + (lowerRecursorRule_extraMonotone src compilerFuel numArgs) + tailRules) htailPlan.run + have hnextExtends : ExtraExtends nextState ambient := + htailExtends.trans hextends + rw [hbody] at hbranchRun + obtain ⟨allowance, hbranchCost, hfunded⟩ := + lowerRecursorRule_branch_profile_below + (recSelfRel := recSelfRel) (limit := branchFuel + 1) + (branchFuel := branchFuel) + henv hrepresented hcontracts hvalues hprofiles hself + hfieldPlan hparameterPlan hbodyRun hnextExtends + (sourcePre := sourcePre) (pre := runtimePre.reverse) + (sourceFields := sourceFields) (fields := targetFields) + (sourceSelf := .pap (.rec_ address (numArgs + 1)) []) + (sourceValue := sourceResult) (major := major) + hsourceEval hsourceFunded + (by simpa using hruntimePreLength) + htargetRuleLength hpreGraphs hfieldGraphs ⟨rfl, rfl⟩ + horder hframe hentryOwn hfieldWorld (by omega) + (by simpa using hbranchRun) + refine ⟨allowance, ?_, hfunded⟩ + refine + { startOrder := horder + envBounds := ?_ + run := htarget + growth := hbranchCost.growth } + have hsuffix := hbranchCost.envBounds.drop targetFields.reverse.length + simpa using hsuffix + cases hmajorGraph with + | @lit literal => + cases literal with + | str string => simp [IxIR0.majorCtor] at hsourceMajor + | nat n => + cases hpeel : natLit with + | false => simp [IxIR0.majorCtor, hpeel] at hsourceMajor + | true => + cases n with + | zero => + have hmajorPair : + 0 = sourceTag ∧ sourceFields = [] := by + simpa [IxIR0.majorCtor, hpeel] using hsourceMajor + have htag : sourceTag = 0 := hmajorPair.1.symm + have hfields : sourceFields = [] := hmajorPair.2 + subst sourceTag + subst sourceFields + cases halt : alts.toArray.find? + (fun alt => alt.cidx == 0) with + | none => simp [hpeel, halt] at hdispatch + | some alt => + cases alt with + | mk selectedTag fieldCount body => + cases fieldCount with + | zero => + have hbranch := hdispatch + simp [hpeel, halt] at hbranch + simpa [hpeel] using + (finish halt rfl Sim.ValuesGraph.nil rfl + (by simp) (by simpa [hpeel] using hbranch)) + | succ fieldCount => + simp [hpeel, halt] at hdispatch + | succ n => + have hmajorPair : + 1 = sourceTag ∧ + [.lit (.nat n)] = sourceFields := by + simpa [IxIR0.majorCtor, hpeel] using hsourceMajor + have htag : sourceTag = 1 := hmajorPair.1.symm + have hfields : sourceFields = [.lit (.nat n)] := + hmajorPair.2.symm + subst sourceTag + subst sourceFields + cases halt : alts.toArray.find? + (fun alt => alt.cidx == 1) with + | none => simp [hpeel, halt] at hdispatch + | some alt => + cases alt with + | mk selectedTag fieldCount body => + by_cases hfieldCount : fieldCount = 1 + · subst fieldCount + have hbranch := hdispatch + simp [hpeel, halt] at hbranch + simpa [hpeel] using + (finish halt rfl (.cons .lit .nil) rfl + (by simp [Sim.HasWorld]) + (by simpa [hpeel] using hbranch)) + · simp [hpeel, halt, hfieldCount] at hdispatch + | erased => simp [IxIR0.majorCtor] at hsourceMajor + | @ctor sourceAddress sourceCtorTag sourceCtorFields loc + world rc cid targetFields hget haddress htag hfieldGraphs => + have hmajorPair : + sourceCtorTag = sourceTag ∧ + sourceCtorFields = sourceFields := by + simpa [IxIR0.majorCtor] using hsourceMajor + have hsourceTagEq : sourceTag = sourceCtorTag := + hmajorPair.1.symm + have hsourceFieldsEq : sourceFields = sourceCtorFields := + hmajorPair.2.symm + subst sourceTag + subst sourceFields + obtain ⟨ownedBox, hownedBox, hownedWorld⟩ := hmajorWorld + rw [hget] at hownedBox + have hboxEq : + (⟨world, rc, .ctorN cid targetFields⟩ : NodeBox) = ownedBox := + Option.some.inj hownedBox + subst ownedBox + dsimp only [NodeBox.world] at hownedWorld + subst world + cases halt : alts.toArray.find? + (fun alt => alt.cidx == cid.cidx) with + | none => simp [hget, halt] at hdispatch + | some alt => + cases alt with + | mk selectedTag fieldCount body => + by_cases hsize : targetFields.size = fieldCount + · have hbranch := htarget + rw [Sim.runCode_case_ctor rfl hget halt hsize] at hbranch + rw [Array.foldl_cons_eq_reverse_append] at hbranch + exact finish halt htag (by simpa using hfieldGraphs) + (by simpa using hsize) (hown.caseFieldsBorrowed hget) + hbranch + · simp [hget, halt, hsize] at hdispatch + | function hget hfun hcaptures => + simp [hget] at hdispatch + +/-- Declaration-facing adapter for the exact-profile recursor theorem. -/ +theorem lowerDecl_recursor_profilePreservesAt_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {ctx : Ctx} {limit compilerFuel numArgs : Nat} + {natLit : Bool} {rules : Array IxIR0.RecRule} + {address : Ixon.Address} {sourceFunction : IxIR0.Value} + {state finalState : LowSt} {d : FnDef} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprofiles : CompilerProfileContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + (hsrc : src address = some (.recursor numArgs natLit rules)) + (hdecl : ctx.decls address = some (.fn d)) + (href : SourceRefValue sourceCtx address sourceFunction) + (hrun : (lowerDecl src compilerFuel + (address, .recursor numArgs natLit rules)).run state = + .ok (some (address, .fn d)) finalState) + (hextends : ExtraExtends finalState ambient) : + FnProfilePreservesAt + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx address d + (List.replicate (numArgs + 1) .shared) sourceFunction limit := by + simp only [lowerDecl] at hrun + obtain ⟨actual, recursorState, hrecursorRun, hafterRecursor⟩ := + trackedBindRun_ok_inv hrun + have hpure : + some (address, Decl.fn actual) = some (address, Decl.fn d) ∧ + recursorState = finalState := by + simpa using hafterRecursor + have hd : actual = d := by + have hp := Option.some.inj hpure.1 + exact Decl.fn.inj (Prod.mk.inj hp).2 + have hrecursorState : recursorState = finalState := hpure.2 + subst actual + subst recursorState + intro before after args value sourceArgs sourceResult sourceRest rest + profile horder hruntimeLength hsourceLength hargs hentry hframe hown + hcodeRun + exact lowerRecursor_profilePreservesAt_within_below + henv hrepresented hcontracts hvalues hprofiles hsrc hdecl href + hrecursorRun hextends horder hruntimeLength hsourceLength hargs hentry + hframe hown hcodeRun + +/-- Contractive paired-cost adapter for a generated function body. The +source-entry callback may expose a smaller stripped-body profile; its +allowance is transported to the complete call/reference profile after the +zero-growth declaration-entry releases are composed. -/ +theorem lowerFnBody_parameterEntries_profileRun_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} + {compilerFuel limit targetFuel : Nat} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprofiles : CompilerProfileContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + (modes : List Ixon.Uses) (world : Ixon.Owned) (body : IxIR0.Expr) + {state finalState : LowSt} {code : Code} {papSafeFlag : Bool} + (hadmissible : ParameterDropsAdmissible modes + (fun index => countUses index body)) + (hrun : (lowerFnBody src (compilerFuel + 1) + ⟨parameterEntries 0 modes (fun index => countUses index body), + modes.length⟩ + (parameterDrops 0 modes (fun index => countUses index body)) + world body).run state = .ok code finalState) + (hextends : ExtraExtends finalState ambient) + {sourceArgs : List IxIR0.Value} {sourceResult : IxIR0.Value} + {bodyProfile profile : SourceProfile} {sourceFuel : Nat} + (hsource : IxIR0.DynamicCost.Eval sourceCtx sourceFuel + sourceArgs.reverse body sourceResult bodyProfile) + (hbodyFunded : OwnershipAllowanceLE + (sourceProfileOwnershipAllowance bodyProfile) + (sourceProfileOwnershipAllowance profile)) + {before after : Store} {args : List RVal} {value : RVal} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} + (horder : AllocationOrderInvariant before) + (hruntimeLength : args.length = modes.length) + (hargs : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) before sourceArgs args) + (hframe : Sim.RootsGraph + (CompilerFunctionRel sourceCtx src ambient) before sourceRest rest) + (hown : Sim.RootOwnership before + (Sim.rootsForWorlds (modes.map worldOfUses) args ++ rest)) + (htarget : targetFuel ≤ limit) + (hcodeRun : runCode ctx targetFuel + ⟨modes.length, world, papSafeFlag, code⟩ before args.reverse code = + .ok (after, value)) : + ProfileFundedCodeRun ctx targetFuel + ⟨modes.length, world, papSafeFlag, code⟩ before args.reverse code after value + profile := by + let remaining : Nat → Nat := fun index => countUses index body + let input : VEnv := + ⟨parameterEntries 0 modes remaining, modes.length⟩ + let drops := parameterDrops 0 modes remaining + have hrun' : + (lowerFnBody src (compilerFuel + 1) input drops world body).run state = + .ok code finalState := by + simpa [input, drops, remaining] using hrun + simp only [lowerFnBody] at hrun' + obtain ⟨releaseResult, releaseState, hreleaseRun, hafterRelease⟩ := + trackedBindRun_ok_inv hrun' + rcases releaseResult with ⟨middle, releaseEmit⟩ + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + trackedBindRun_ok_inv hafterRelease + rcases bodyResult with ⟨output, emit, av⟩ + have hpure : + (releaseEmit ∘ emit) (.ret (av.toAtom output)) = code ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨hcode, hbodyState⟩ := hpure + subst bodyState + have hmiddleNo : NoRecSelf middle := + releaseSlots_noRecSelf input hreleaseRun (by + simpa [input, remaining] using + parameterEntries_noRecSelf 0 modes remaining modes.length) + obtain ⟨plannedMiddle, plannedEmit, hplan, _⟩ := + parameterDrops_releasePlan_tracked 0 modes remaining + (by simpa [remaining] using hadmissible) + have hplan' : ReleasePlan input drops plannedMiddle plannedEmit := by + simpa [input, drops] using hplan + have hplanRun : (releaseSlots input drops).run state = + .ok (plannedMiddle, plannedEmit) state := hplan'.run state + have heq : + (plannedMiddle, plannedEmit) = (middle, releaseEmit) ∧ + state = releaseState := by + simpa using hplanRun.symm.trans hreleaseRun + have hmiddle : plannedMiddle = middle := congrArg Prod.fst heq.1 + have hemit : plannedEmit = releaseEmit := congrArg Prod.snd heq.1 + subst middle + subst releaseEmit + cases heq.2 + have hbodySound : LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx + ⟨modes.length, world, papSafeFlag, code⟩ limit plannedMiddle output + sourceArgs.reverse sourceArgs.reverse sourceResult world emit av + bodyProfile := + lowerE_run_profile_sound_within_noRecSelf_below + (recSelfRel := recSelfRel) + (cur := (⟨modes.length, world, papSafeFlag, code⟩ : FnDef)) + henv hrepresented hcontracts hvalues hprofiles hsource hbodyRun + hextends hmiddleNo + have hbodySound' := hbodySound.monoProfile hbodyFunded + have hpre : GraphOwnsVEnv + (CompilerFunctionRel sourceCtx src ambient) recSelfRel input + sourceArgs.reverse sourceRest rest before args.reverse := by + refine ⟨(Sim.rootsForWorlds (modes.map worldOfUses) args).reverse, + ?_, hframe, ?_⟩ + · simpa [input] using VEnvValueGraph.parameterEntries + (recSelfRel := recSelfRel) modes remaining hruntimeLength hargs hown + · exact hown.perm + ((List.reverse_perm + (Sim.rootsForWorlds (modes.map worldOfUses) args)).symm.append_right + rest) + have hargsBounds : ValuesInBounds before args := by + intro runtime hmember + obtain ⟨runtimeWorld, hroot⟩ := + Sim.exists_root_mem_rootsForWorlds + (worlds := modes.map worldOfUses) (values := args) + (by simpa using hruntimeLength.symm) hmember + exact rootOwnership_valueInBounds_of_mem hown + (List.mem_append_left rest hroot) + have hreleaseCost := + releasePlan_profileFundedValueStateRunSoundBelow hplan' + (funRel := CompilerFunctionRel sourceCtx src ambient) + (recSelfRel := recSelfRel) (ctx := ctx) + (cur := (⟨modes.length, world, papSafeFlag, code⟩ : FnDef)) + (limit := limit) sourceArgs.reverse sourceRest rest [] + have hbodyCost := hbodySound'.profileEmits sourceRest rest [] + have hcombined := ProfileFundedEmitStateRunSoundBelow.comp + hreleaseCost hbodyCost + have hcombined' : ProfileFundedEmitStateRunSoundBelow ctx + ⟨modes.length, world, papSafeFlag, code⟩ limit (plannedEmit ∘ emit) + (GraphOwnsVEnvProtected + (CompilerFunctionRel sourceCtx src ambient) recSelfRel input + sourceArgs.reverse sourceRest rest []) + (GraphOwnsResultProtected + (CompilerFunctionRel sourceCtx src ambient) recSelfRel output + sourceArgs.reverse sourceResult world av sourceRest rest []) + profile := + ProfileFundedEmitStateRunSoundBelow.of_profile_eq hcombined + (IxIR0.DynamicCost.Profile.zero_add profile) + have hcost := hcombined'.closeRet (av.toAtom output) htarget horder + hargsBounds.reverse ⟨hpre, SlotsRealize.nil⟩ (by + rw [hcode] + exact hcodeRun) + change plannedEmit (emit (.ret (av.toAtom output))) = code at hcode + simp only [Function.comp_apply] at hcost + rw [hcode] at hcost + exact hcost + +/-- Contractive paired-cost adapter for a generated function body. The +source-entry callback may expose a smaller stripped-body profile; its +allowance is transported to the complete call/reference profile after the +zero-growth declaration-entry releases are composed. -/ +theorem lowerFnBody_parameterEntries_profilePreservesAt_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} + {compilerFuel limit : Nat} {address : Ixon.Address} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprofiles : CompilerProfileContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + (modes : List Ixon.Uses) (world : Ixon.Owned) (body : IxIR0.Expr) + {state finalState : LowSt} {code : Code} {papSafeFlag : Bool} + (hadmissible : ParameterDropsAdmissible modes + (fun index => countUses index body)) + (hrun : (lowerFnBody src (compilerFuel + 1) + ⟨parameterEntries 0 modes (fun index => countUses index body), + modes.length⟩ + (parameterDrops 0 modes (fun index => countUses index body)) + world body).run state = .ok code finalState) + (hextends : ExtraExtends finalState ambient) + {sourceFunction : IxIR0.Value} + (hsaturates : ∀ {sourceArgs : List IxIR0.Value} + {sourceResult : IxIR0.Value} {profile : SourceProfile}, + sourceArgs.length = modes.length → + SourceFnEntryProfile sourceCtx address sourceFunction sourceArgs + sourceResult profile → + ∃ sourceFuel bodyProfile, + IxIR0.DynamicCost.Eval sourceCtx sourceFuel sourceArgs.reverse body + sourceResult bodyProfile ∧ + OwnershipAllowanceLE + (sourceProfileOwnershipAllowance bodyProfile) + (sourceProfileOwnershipAllowance profile)) : + FnProfilePreservesAt + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx address + ⟨modes.length, world, papSafeFlag, code⟩ (modes.map worldOfUses) + sourceFunction limit := by + let remaining : Nat → Nat := fun index => countUses index body + let input : VEnv := + ⟨parameterEntries 0 modes remaining, modes.length⟩ + let drops := parameterDrops 0 modes remaining + have hrun' : + (lowerFnBody src (compilerFuel + 1) input drops world body).run state = + .ok code finalState := by + simpa [input, drops, remaining] using hrun + simp only [lowerFnBody] at hrun' + obtain ⟨releaseResult, releaseState, hreleaseRun, hafterRelease⟩ := + trackedBindRun_ok_inv hrun' + rcases releaseResult with ⟨middle, releaseEmit⟩ + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + trackedBindRun_ok_inv hafterRelease + rcases bodyResult with ⟨output, emit, av⟩ + have hpure : + (releaseEmit ∘ emit) (.ret (av.toAtom output)) = code ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨hcode, hbodyState⟩ := hpure + subst bodyState + have hmiddleNo : NoRecSelf middle := + releaseSlots_noRecSelf input hreleaseRun (by + simpa [input, remaining] using + parameterEntries_noRecSelf 0 modes remaining modes.length) + obtain ⟨plannedMiddle, plannedEmit, hplan, _⟩ := + parameterDrops_releasePlan_tracked 0 modes remaining + (by simpa [remaining] using hadmissible) + have hplan' : ReleasePlan input drops plannedMiddle plannedEmit := by + simpa [input, drops] using hplan + have hplanRun : (releaseSlots input drops).run state = + .ok (plannedMiddle, plannedEmit) state := hplan'.run state + have heq : + (plannedMiddle, plannedEmit) = (middle, releaseEmit) ∧ + state = releaseState := by + simpa using hplanRun.symm.trans hreleaseRun + have hmiddle : plannedMiddle = middle := congrArg Prod.fst heq.1 + have hemit : plannedEmit = releaseEmit := congrArg Prod.snd heq.1 + subst middle + subst releaseEmit + cases heq.2 + intro before after args value sourceArgs sourceResult sourceRest rest + profile horder hruntimeLength hsourceLength hargs hentry hframe hown + hcodeRun + obtain ⟨sourceFuel, bodyProfile, hsource, hbodyFunded⟩ := + hsaturates (by simpa using hsourceLength) hentry + have hbodySound : LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx + ⟨modes.length, world, papSafeFlag, code⟩ limit plannedMiddle output + sourceArgs.reverse sourceArgs.reverse sourceResult world emit av + bodyProfile := + lowerE_run_profile_sound_within_noRecSelf_below + (recSelfRel := recSelfRel) + (cur := (⟨modes.length, world, papSafeFlag, code⟩ : FnDef)) + henv hrepresented hcontracts hvalues hprofiles hsource hbodyRun + hextends hmiddleNo + have hbodySound' := hbodySound.monoProfile hbodyFunded + have hargsLength : args.length = modes.length := by + simpa using hruntimeLength + have hpre : GraphOwnsVEnv + (CompilerFunctionRel sourceCtx src ambient) recSelfRel input + sourceArgs.reverse sourceRest rest before args.reverse := by + refine ⟨(Sim.rootsForWorlds (modes.map worldOfUses) args).reverse, + ?_, hframe, ?_⟩ + · simpa [input] using VEnvValueGraph.parameterEntries + (recSelfRel := recSelfRel) modes remaining hargsLength hargs hown + · exact hown.perm + ((List.reverse_perm + (Sim.rootsForWorlds (modes.map worldOfUses) args)).symm.append_right + rest) + have hargsBounds : ValuesInBounds before args := by + intro runtime hmember + obtain ⟨runtimeWorld, hroot⟩ := + Sim.exists_root_mem_rootsForWorlds hruntimeLength.symm hmember + exact rootOwnership_valueInBounds_of_mem hown + (List.mem_append_left rest hroot) + have hreleaseCost := + releasePlan_profileFundedValueStateRunSoundBelow hplan' + (funRel := CompilerFunctionRel sourceCtx src ambient) + (recSelfRel := recSelfRel) (ctx := ctx) + (cur := (⟨modes.length, world, papSafeFlag, code⟩ : FnDef)) + (limit := limit) sourceArgs.reverse sourceRest rest [] + have hbodyCost := hbodySound'.profileEmits sourceRest rest [] + have hcombined := ProfileFundedEmitStateRunSoundBelow.comp + hreleaseCost hbodyCost + have hcombined' : ProfileFundedEmitStateRunSoundBelow ctx + ⟨modes.length, world, papSafeFlag, code⟩ limit (plannedEmit ∘ emit) + (GraphOwnsVEnvProtected + (CompilerFunctionRel sourceCtx src ambient) recSelfRel input + sourceArgs.reverse sourceRest rest []) + (GraphOwnsResultProtected + (CompilerFunctionRel sourceCtx src ambient) recSelfRel output + sourceArgs.reverse sourceResult world av sourceRest rest []) + profile := + ProfileFundedEmitStateRunSoundBelow.of_profile_eq hcombined + (IxIR0.DynamicCost.Profile.zero_add profile) + have hrun' : runCode ctx limit + ⟨modes.length, world, papSafeFlag, code⟩ before args.reverse + ((plannedEmit ∘ emit) (.ret (av.toAtom output))) = + .ok (after, value) := by + rw [hcode] + exact hcodeRun + have hcost := hcombined'.closeRet (av.toAtom output) + (Nat.le_refl _) horder hargsBounds.reverse ⟨hpre, SlotsRealize.nil⟩ + hrun' + change plannedEmit (emit (.ret (av.toAtom output))) = code at hcode + simp only [Function.comp_apply] at hcost + rw [hcode] at hcost + exact hcost + +/-- A profiled entry into an ordinary source definition exposes a stripped +body trace funded by that entry. Nonempty entries consume the residual +lambda prefix; nullary entries recover the body trace already executed by +the profiled source reference. -/ +theorem sourceDefn_entryProfile_stripLams + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {address : Ixon.Address} {result : Ixon.Owned} + {body : IxIR0.Expr} {sourceFunction sourceResult : IxIR0.Value} + {sourceArgs : List IxIR0.Value} {profile : SourceProfile} + (henv : sourceCtx.env = src) + (hsrc : src address = some (.defn result body)) + (href : SourceRefValue sourceCtx address sourceFunction) + (hlength : sourceArgs.length = (lamUses body).length) + (hentry : SourceFnEntryProfile sourceCtx address sourceFunction + sourceArgs sourceResult profile) : + ∃ bodyFuel bodyProfile, + IxIR0.DynamicCost.Eval sourceCtx bodyFuel sourceArgs.reverse + (stripLams body) sourceResult bodyProfile ∧ + OwnershipAllowanceLE + (sourceProfileOwnershipAllowance bodyProfile) + (sourceProfileOwnershipAllowance profile) := by + cases hentry with + | @applied sourceArgument sourceArguments sourceResult profile happly => + have hpositive : 0 < lamArity body := by + have hargPositive : + 0 < (sourceArgument :: sourceArguments).length := by simp + rw [hlength, lamUses_length] at hargPositive + exact hargPositive + have hprefix := sourceRef_lambdaPrefix_nil henv hsrc hpositive href + have hfullLength : + (([] : List IxIR0.Value) ++ + (sourceArgument :: sourceArguments)).length = lamArity body := by + simpa [lamUses_length] using hlength + obtain ⟨bodyFuel, bodyProfile, hbody, hfunded⟩ := + LambdaPrefix.saturateProfile hprefix (reserve := 0) (by simp) + hfullLength happly (by simp) + refine ⟨bodyFuel, bodyProfile, ?_, ?_⟩ + · simpa using hbody + · change OwnershipAllowanceLE + (sourceProfileOwnershipAllowance (0 + bodyProfile)) + (sourceProfileOwnershipAllowance profile) at hfunded + rw [IxIR0.DynamicCost.Profile.zero_add] at hfunded + exact hfunded + | @nullary profile hrefProfile => + obtain ⟨refFuel, sourceEnv, hrefEval⟩ := hrefProfile + cases hrefEval with + | @refDefn fuel env _ world declaredBody sourceValue bodyCost + hlookup hbody => + rw [henv, hsrc] at hlookup + cases hlookup + have hzeroArity : ([] : List IxIR0.Value).length = + lamArity body := by + rw [← lamUses_length] + simpa using hlength + obtain ⟨bodyFuel, bodyProfile, hstripped, hfunded⟩ := + dynamicEval_stripLams_of_appliesProfile sourceCtx hbody + hzeroArity (SourceAppliesProfile.nil) + refine ⟨bodyFuel, bodyProfile, by simpa using hstripped, ?_⟩ + apply hfunded.trans + simp [OwnershipAllowanceLE, sourceProfileOwnershipAllowance, + IxIR0.DynamicCost.tick] <;> omega + | @refCtor fuel env _ tag arity sourceValue saturateCost hlookup + hsaturate => + rw [henv, hsrc] at hlookup + simp at hlookup + | @refRecursor fuel env _ numArgs natLit rules hlookup => + rw [henv, hsrc] at hlookup + simp at hlookup + | @refExtern fuel env _ arity sourceValue saturateCost hlookup + hsaturate => + rw [henv, hsrc] at hlookup + simp at hlookup + +/-- An ordinary definition emitted by a reachable lowering run satisfies +its paired source-profile contract at the current evaluator index. -/ +theorem lowerDecl_defn_profilePreservesAt_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {ctx : Ctx} {compilerFuel limit : Nat} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprofiles : CompilerProfileContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + {address : Ixon.Address} {result : Ixon.Owned} {body : IxIR0.Expr} + {state finalState : LowSt} {d : FnDef} + {sourceFunction : IxIR0.Value} + (hsrc : src address = some (.defn result body)) + (href : SourceRefValue sourceCtx address sourceFunction) + (hadmissible : ParameterDropsAdmissible (lamUses body) + (fun index => countUses index (stripLams body))) + (hrun : (lowerDecl src (compilerFuel + 1) + (address, .defn result body)).run state = + .ok (some (address, .fn d)) finalState) + (hextends : ExtraExtends finalState ambient) : + FnProfilePreservesAt + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx address d + ((lamUses body).map worldOfUses) sourceFunction limit := by + simp only [lowerDecl] at hrun + obtain ⟨code, bodyState, hbodyRun, hpureRun⟩ := + trackedBindRun_ok_inv hrun + have hpure : + some (address, Decl.fn ⟨lamArity body, result, result == .shared && papSafe body, code⟩) = + some (address, Decl.fn d) ∧ + bodyState = finalState := by + simpa using hpureRun + have hd : d = ⟨lamArity body, result, result == .shared && papSafe body, code⟩ := by + have hp := Option.some.inj hpure.1 + exact Decl.fn.inj (Prod.mk.inj hp).2.symm + cases hpure.2 + subst d + have hpreserves : FnProfilePreservesAt + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx address + ⟨(lamUses body).length, result, result == .shared && papSafe body, code⟩ + ((lamUses body).map worldOfUses) sourceFunction limit := + lowerFnBody_parameterEntries_profilePreservesAt_within_below + (recSelfRel := fun _ _ => False) + (compilerFuel := compilerFuel) (limit := limit) (address := address) + henv hrepresented hcontracts hvalues hprofiles (lamUses body) result + (stripLams body) hadmissible (by simpa using hbodyRun) hextends + (by + intro sourceArgs sourceResult profile hlength hentry + exact sourceDefn_entryProfile_stripLams henv hsrc href hlength + hentry) + have hfn : (⟨(lamUses body).length, result, result == .shared && papSafe body, code⟩ : FnDef) = + ⟨lamArity body, result, result == .shared && papSafe body, code⟩ := by + rw [lamUses_length] + rw [← hfn] + intro before after args value sourceArgs sourceResult sourceRest rest + profile horder hruntimeLength hsourceLength hargs hentry hframe hown + hcodeRun + exact hpreserves horder hruntimeLength hsourceLength hargs hentry hframe + hown hcodeRun + +/-- Run-level ordinary-definition adapter for residual PAP saturation. It +uses the exact stripped-body trace exposed by the residual closure rather +than rebuilding the already-consumed lambda-prefix profile. -/ +theorem lowerDecl_defn_profileRun_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {ctx : Ctx} {compilerFuel limit targetFuel : Nat} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprofiles : CompilerProfileContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + {address : Ixon.Address} {result : Ixon.Owned} {body : IxIR0.Expr} + {state finalState : LowSt} {d : FnDef} + (hadmissible : ParameterDropsAdmissible (lamUses body) + (fun index => countUses index (stripLams body))) + (hrun : (lowerDecl src (compilerFuel + 1) + (address, .defn result body)).run state = + .ok (some (address, .fn d)) finalState) + (hextends : ExtraExtends finalState ambient) + {sourceArgs : List IxIR0.Value} {sourceResult : IxIR0.Value} + {bodyProfile profile : SourceProfile} {sourceFuel : Nat} + (hsource : IxIR0.DynamicCost.Eval sourceCtx sourceFuel + sourceArgs.reverse (stripLams body) sourceResult bodyProfile) + (hbodyFunded : OwnershipAllowanceLE + (sourceProfileOwnershipAllowance bodyProfile) + (sourceProfileOwnershipAllowance profile)) + {before after : Store} {args : List RVal} {value : RVal} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} + (horder : AllocationOrderInvariant before) + (hruntimeLength : args.length = (lamUses body).length) + (hargs : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) before sourceArgs args) + (hframe : Sim.RootsGraph + (CompilerFunctionRel sourceCtx src ambient) before sourceRest rest) + (hown : Sim.RootOwnership before + (Sim.rootsForWorlds ((lamUses body).map worldOfUses) args ++ rest)) + (htarget : targetFuel ≤ limit) + (hcodeRun : runCode ctx targetFuel d before args.reverse d.body = + .ok (after, value)) : + ProfileFundedCodeRun ctx targetFuel d before args.reverse d.body after + value profile := by + simp only [lowerDecl] at hrun + obtain ⟨code, bodyState, hbodyRun, hpureRun⟩ := + trackedBindRun_ok_inv hrun + have hpure : + some (address, Decl.fn ⟨lamArity body, result, result == .shared && papSafe body, code⟩) = + some (address, Decl.fn d) ∧ + bodyState = finalState := by + simpa using hpureRun + have hd : d = ⟨lamArity body, result, result == .shared && papSafe body, code⟩ := by + have hp := Option.some.inj hpure.1 + exact Decl.fn.inj (Prod.mk.inj hp).2.symm + cases hpure.2 + subst d + have hfn : (⟨(lamUses body).length, result, result == .shared && papSafe body, code⟩ : FnDef) = + ⟨lamArity body, result, result == .shared && papSafe body, code⟩ := by + rw [lamUses_length] + rw [← hfn] at hcodeRun ⊢ + exact lowerFnBody_parameterEntries_profileRun_below + (recSelfRel := fun _ _ => False) + (compilerFuel := compilerFuel) (limit := limit) + (targetFuel := targetFuel) henv hrepresented hcontracts hvalues + hprofiles (lamUses body) result (stripLams body) hadmissible + (by simpa using hbodyRun) hextends hsource hbodyFunded horder + hruntimeLength hargs hframe hown htarget hcodeRun + +/-! ### Whole-pass exact-profile contract sealing -/ + +/-- At one target evaluator index, every callable source declaration emitted +by an actual whole-pass run satisfies its exact-profile contract. The proof +uses only profile contracts strictly below the current index. -/ +theorem lowerAllAction_sourceFnProfilePreservesAt_within_below + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Ixon.Owned} {compilerFuel limit : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htarget : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hprofiles : CompilerProfileContractsBelow + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx limit) : + SourceFnProfilePreservesAt + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx limit := by + intro address source worlds result d sourceFunction + hsrc hsignature hdecl href + obtain ⟨itemInitial, itemFinal, hrun, hextends⟩ := + lowerAllAction_callable_decl_trace hlower htarget hsrc hsignature hdecl + cases source with + | defn sourceResult body => + simp only [sourceCallableSignature, Option.some.injEq, + Prod.mk.injEq] at hsignature + obtain ⟨rfl, rfl⟩ := hsignature + cases compilerFuel with + | zero => + simp only [lowerDecl] at hrun + obtain ⟨code, bodyState, hbodyRun, _⟩ := + trackedBindRun_ok_inv hrun + exact (trackedThrowRun_not_ok (by + simpa [lowerFnBody] using hbodyRun)).elim + | succ bodyFuel => + have hadmissible := lowerDecl_defn_parameterDropsAdmissible hrun + intro before after args value sourceArgs sourceValue sourceRest rest + profile horder hruntimeLength hsourceLength hargs hentry hframe hown + hcodeRun + exact lowerDecl_defn_profilePreservesAt_within_below + (compilerFuel := bodyFuel) (limit := limit) + henv hrepresented hcontracts hvalues hprofiles hsrc href hadmissible + (by simpa [Nat.succ_eq_add_one] using hrun) hextends + horder hruntimeLength hsourceLength hargs hentry hframe hown hcodeRun + | ctor tag arity => + simp [sourceCallableSignature] at hsignature + | recursor numArgs natLit rules => + simp only [sourceCallableSignature, Option.some.injEq, + Prod.mk.injEq] at hsignature + obtain ⟨rfl, rfl⟩ := hsignature + intro before after args value sourceArgs sourceValue sourceRest rest + profile horder hruntimeLength hsourceLength hargs hentry hframe hown + hcodeRun + exact lowerDecl_recursor_profilePreservesAt_within_below + (compilerFuel := compilerFuel) (limit := limit) + henv hrepresented hcontracts hvalues hprofiles hsrc hdecl href hrun + hextends horder hruntimeLength hsourceLength hargs hentry hframe hown + hcodeRun + | extern arity => + simp [sourceCallableSignature] at hsignature + +/-- Residual saturation of an ordinary source definition. The source +closure trace funds the stripped body and reserves exactly the already +stored target prefix; the target `invoke` wrapper adds no further cost. -/ +theorem lowerAllAction_sourceDefnResidual_profile_below + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Ixon.Owned} {compilerFuel limit : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htarget : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hprofiles : CompilerProfileContractsBelow + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx limit) + {relatedFunction baseFunction sourceResult : IxIR0.Value} + {address : Ixon.Address} {arity : Nat} + {sourceCaptures sourceArgs : List IxIR0.Value} + {captures args : List RVal} {result : Ixon.Owned} + {body : IxIR0.Expr} + (hsrc : IxIR0.Env.ofList decls address = some (.defn result body)) + (heligible : SourcePapEligible (.defn result body)) + (harity : sourceDeclArity (.defn result body) = arity) + (href : SourceRefValue sourceCtx address baseFunction) + (hprefix : SourceApplies sourceCtx baseFunction sourceCaptures + relatedFunction) + (hunder : sourceCaptures.length < arity) + {before after : Store} {value : RVal} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} {profile : SourceProfile} + (horder : AllocationOrderInvariant before) + (hcaptures : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + before sourceCaptures captures) + (hargs : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + before sourceArgs args) + (hsource : SourceAppliesProfile sourceCtx relatedFunction sourceArgs + sourceResult profile) + (hnonempty : sourceArgs ≠ []) + (hfullLength : (sourceCaptures ++ sourceArgs).length = arity) + (hframe : Sim.RootsGraph + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + before sourceRest rest) + (hown : Sim.RootOwnership before + (Sim.rootsFor .shared (captures ++ args) ++ rest)) + (hinvoke : invoke ctx limit address (captures ++ args) before = + .ok (after, value)) : + RetainedProfileFundedInvokeRun ctx limit address (captures ++ args) + before after value sourceCaptures.length profile := by + obtain ⟨hresultShared, hsafe⟩ := heligible + subst result + obtain ⟨d, hdecl, harityDef, hresultDef, _⟩ := + hcontracts.decls.defn hsrc + obtain ⟨itemInitial, itemFinal, hdeclRun, hextends⟩ := + lowerAllAction_callable_decl_trace hlower htarget hsrc (by rfl) hdecl + have harity' : lamArity body = arity := by + simpa [sourceDeclArity] using harity + have hstoredUnder : sourceCaptures.length < lamArity body := by + rw [harity'] + exact hunder + have hpositive : 0 < lamArity body := by omega + have hinitial := sourceRef_lambdaPrefix_nil henv hsrc hpositive href + have hresidual : LambdaPrefix [] body sourceCaptures relatedFunction := by + simpa using hinitial.append_of_applies hprefix (by + simpa using hstoredUnder) + have hfullLength' : (sourceCaptures ++ sourceArgs).length = + lamArity body := by + rw [harity'] + exact hfullLength + obtain ⟨sourceFuel, bodyProfile, hbody, hfunded⟩ := + LambdaPrefix.saturateProfile hresidual + (reserve := sourceCaptures.length) + (by simp) hfullLength' hsource hnonempty + have hfullGraph : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + before (sourceCaptures ++ sourceArgs) (captures ++ args) := + hcaptures.append hargs + have hmodes := papSafe_lamUses_eq_replicate hsafe + have hworlds : (lamUses body).map worldOfUses = + List.replicate (lamUses body).length .shared := by + rw [hmodes] + simp [worldOfUses] + have hruntimeLength : (captures ++ args).length = + (lamUses body).length := by + calc + (captures ++ args).length = + (sourceCaptures ++ sourceArgs).length := hfullGraph.length.symm + _ = lamArity body := hfullLength' + _ = (lamUses body).length := (lamUses_length body).symm + have hown' : Sim.RootOwnership before + (Sim.rootsForWorlds ((lamUses body).map worldOfUses) + (captures ++ args) ++ rest) := by + rw [hworlds] + rw [rootsForWorlds_replicate_eq_rootsFor .shared hruntimeLength] + exact hown + cases compilerFuel with + | zero => + simp only [lowerDecl] at hdeclRun + obtain ⟨code, bodyState, hbodyRun, _⟩ := + trackedBindRun_ok_inv hdeclRun + exact (trackedThrowRun_not_ok (by + simpa [lowerFnBody] using hbodyRun)).elim + | succ bodyCompilerFuel => + have hadmissible := lowerDecl_defn_parameterDropsAdmissible hdeclRun + cases limit with + | zero => simp [invoke] at hinvoke + | succ innerFuel => + simp only [invoke, hdecl] at hinvoke + split at hinvoke + · contradiction + next hlength => + cases hcodeEval : runCode ctx innerFuel d before + (captures ++ args).reverse d.body with + | error error => + rw [hcodeEval] at hinvoke + contradiction + | ok out => + rw [hcodeEval] at hinvoke + change checkResultWorld d.result out = .ok (after, value) at hinvoke + obtain ⟨hpair, _⟩ := Sim.checkResultWorld_ok hinvoke + subst out + have hbody' : IxIR0.DynamicCost.Eval sourceCtx sourceFuel + (sourceCaptures ++ sourceArgs).reverse (stripLams body) + sourceResult bodyProfile := by + simpa using hbody + have hbodyCost := lowerDecl_defn_profileRun_below + (compilerFuel := bodyCompilerFuel) (limit := innerFuel) + (targetFuel := innerFuel) henv hrepresented hcontracts hvalues + (hprofiles.mono (by omega)) hadmissible + (by simpa [Nat.succ_eq_add_one] using hdeclRun) hextends + hbody' (OwnershipAllowanceLE.refl _) + horder hruntimeLength hfullGraph hframe hown' (Nat.le_refl _) + hcodeEval + have hinvokeCost : ProfileFundedInvokeRun ctx (innerFuel + 1) + address (captures ++ args) before after value bodyProfile := + ProfileFundedInvokeRun.fn hdecl + (by simpa [declArity] using hlength) hbodyCost hinvoke + exact ⟨bodyProfile, hinvokeCost, hfunded⟩ + +/-- A saturated extern PAP has a zero-cost invocation core. The first +source application still exposes the stored-prefix retain charge; its +`evalApp` allocation allowance is harmless slack. -/ +theorem extern_retainedProfileFundedInvokeRun + {ctx : Ctx} {limit arity reserve : Nat} {address : Ixon.Address} + {args : List RVal} {before after : Store} {value : RVal} + {rest : List Sim.Root} {profile : SourceProfile} + (hdecl : ctx.decls address = some (.extern arity)) + (harity : args.length = arity) + (horder : AllocationOrderInvariant before) + (hown : Sim.RootOwnership before + (Sim.rootsFor .shared args ++ rest)) + (hinvoke : invoke ctx limit address args before = .ok (after, value)) + (hfunded : OwnershipAllowanceLE + (sourceProfileOwnershipAllowance + (IxIR0.DynamicCost.retain reserve + + IxIR0.DynamicCost.tick .evalApp)) + (sourceProfileOwnershipAllowance profile)) : + RetainedProfileFundedInvokeRun ctx limit address args before after value + reserve profile := by + have hargsBounds : ValuesInBounds before args := by + intro runtime hmember + have hroot : (⟨.shared, runtime⟩ : Sim.Root) ∈ + Sim.rootsFor .shared args ++ rest := by + apply List.mem_append_left rest + simpa [Sim.rootsFor] using hmember + exact rootOwnership_valueInBounds_of_mem hown hroot + have hprefixFunded : OwnershipAllowanceLE + (sourceProfileOwnershipAllowance + (IxIR0.DynamicCost.retain reserve + 0)) + (sourceProfileOwnershipAllowance profile) := by + apply (show OwnershipAllowanceLE + (sourceProfileOwnershipAllowance + (IxIR0.DynamicCost.retain reserve + 0)) + (sourceProfileOwnershipAllowance + (IxIR0.DynamicCost.retain reserve + + IxIR0.DynamicCost.tick .evalApp)) by + simp [OwnershipAllowanceLE, sourceProfileOwnershipAllowance, + IxIR0.DynamicCost.retain, IxIR0.DynamicCost.tick]).trans + exact hfunded + cases limit with + | zero => simp [invoke] at hinvoke + | succ innerFuel => + simp only [invoke, hdecl] at hinvoke + split at hinvoke + · contradiction + next hlength => + cases horacle : callScalarOracle ctx address args with + | error error => + rw [horacle] at hinvoke + contradiction + | ok runtimeResult => + rw [horacle] at hinvoke + have hpair : (before, runtimeResult) = (after, value) := + Except.ok.inj hinvoke + cases hpair + exact ⟨0, + ProfileFundedInvokeRun.extern horder hargsBounds hdecl harity + horacle, + hprefixFunded⟩ + +/-- Saturating a generated constructor wrapper spends exactly one fresh-node +allowance in its declaration body. That core charge is the source +`evalApp` tick, while the enclosing retained certificate accounts for the +already stored PAP prefix. -/ +theorem ctorWrapper_retainedProfileFundedInvokeRun + {ctx : Ctx} {limit tag arity reserve : Nat} + {source wrapper : Ixon.Address} + {args : List RVal} {before after : Store} {value : RVal} + {rest : List Sim.Root} {profile : SourceProfile} + (hdecl : ctx.decls wrapper = some (.fn + ⟨arity, .shared, true, + .letOp (.alloc .shared (ctorIdOf source tag) + (descendingVars arity).toArray) (.ret (.var 0))⟩)) + (harity : args.length = arity) + (horder : AllocationOrderInvariant before) + (hown : Sim.RootOwnership before + (Sim.rootsFor .shared args ++ rest)) + (hinvoke : invoke ctx limit wrapper args before = .ok (after, value)) + (hfunded : OwnershipAllowanceLE + (sourceProfileOwnershipAllowance + (IxIR0.DynamicCost.retain reserve + + IxIR0.DynamicCost.tick .evalApp)) + (sourceProfileOwnershipAllowance profile)) : + RetainedProfileFundedInvokeRun ctx limit wrapper args before after value + reserve profile := by + let wrapperDef : FnDef := + ⟨arity, .shared, true, + .letOp (.alloc .shared (ctorIdOf source tag) + (descendingVars arity).toArray) (.ret (.var 0))⟩ + have hdecl' : ctx.decls wrapper = some (.fn wrapperDef) := by + simpa [wrapperDef] using hdecl + have hargsBounds : ValuesInBounds before args := by + intro runtime hmember + have hroot : (⟨.shared, runtime⟩ : Sim.Root) ∈ + Sim.rootsFor .shared args ++ rest := by + apply List.mem_append_left rest + simpa [Sim.rootsFor] using hmember + exact rootOwnership_valueInBounds_of_mem hown hroot + cases limit with + | zero => simp [invoke] at hinvoke + | succ innerFuel => + simp only [invoke, hdecl'] at hinvoke + split at hinvoke + · contradiction + next hlength => + cases hcode : runCode ctx innerFuel wrapperDef before args.reverse + wrapperDef.body with + | error error => + rw [hcode] at hinvoke + contradiction + | ok out => + rw [hcode] at hinvoke + change checkResultWorld wrapperDef.result out = + .ok (after, value) at hinvoke + obtain ⟨hpair, _⟩ := Sim.checkResultWorld_ok hinvoke + subst out + have hbody : ProfileFundedCodeRun ctx innerFuel wrapperDef before + args.reverse wrapperDef.body after value + (IxIR0.DynamicCost.tick .evalApp) := by + exact ProfileFundedEmitRunSound.closeRet + (ProfileFundedEmitRunSound.localEval + (op := .alloc .shared (ctorIdOf source tag) + (descendingVars arity).toArray) + (by simp [localOpOwnershipAllowance]) .evalApp rfl) + (.var 0) horder hargsBounds.reverse (by + simpa [wrapperDef, emitOp] using hcode) + have hcore : ProfileFundedInvokeRun ctx (innerFuel + 1) wrapper args + before after value (IxIR0.DynamicCost.tick .evalApp) := + ProfileFundedInvokeRun.fn hdecl' + (by simpa [wrapperDef] using harity) hbody hinvoke + exact ⟨IxIR0.DynamicCost.tick .evalApp, hcore, hfunded⟩ + +/-- Run-level paired-cost adapter for a lifted lambda declaration. Selected +outer captures inhabit target argument slots but remain part of the source +environment; only the supplied lambda parameters are prepended to that +environment for the exact stripped-body trace. -/ +theorem lowerFnBody_liftedEntries_profileRun_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {ctx : Ctx} {limit compilerFuel targetFuel : Nat} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprofiles : CompilerProfileContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + (entryCount : Nat) (modes : List Ixon.Uses) (body : IxIR0.Expr) + (selected : Nat → Bool) + {state finalState : LowSt} {code : Code} + (hadmissible : ParameterDropsAdmissible modes + (fun index => countUses index body)) + (hselectDef : ∀ index, index < entryCount → + selected index = (countUses (modes.length + index) body != 0)) + (hpositive : 0 < modes.length) + (hshared : modes.map worldOfUses = + List.replicate modes.length .shared) + (hrun : (lowerFnBody src (compilerFuel + 1) + (let captures := (List.range entryCount).filter selected + ⟨parameterEntries captures.length modes + (fun index => countUses index body) ++ + selectedEntriesFrom selected + (fun index => countUses (modes.length + index) body) + (List.range entryCount) 0, + captures.length + modes.length⟩) + (let captures := (List.range entryCount).filter selected + parameterDrops captures.length modes + (fun index => countUses index body)) + .shared body).run state = .ok code finalState) + (hextends : ExtraExtends finalState ambient) + {sourceEnv selectedSources parameterSources : List IxIR0.Value} + {sourceResult : IxIR0.Value} {sourceFuel : Nat} + {bodyProfile profile : SourceProfile} + {store store' : Store} {captureArgs parameterArgs : List RVal} + {value : RVal} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} + (hsourceLength : sourceEnv.length = entryCount) + (hselectedValues : ValuesAt sourceEnv + ((List.range entryCount).filter selected) selectedSources) + (hcaptureLength : captureArgs.length = + ((List.range entryCount).filter selected).length) + (hparameterLength : parameterArgs.length = modes.length) + (hcaptureGraph : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store selectedSources + captureArgs) + (hparameterGraph : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store parameterSources + parameterArgs) + (hsource : IxIR0.DynamicCost.Eval sourceCtx sourceFuel + (parameterSources.reverse ++ sourceEnv) body sourceResult bodyProfile) + (hbodyFunded : OwnershipAllowanceLE + (sourceProfileOwnershipAllowance bodyProfile) + (sourceProfileOwnershipAllowance profile)) + (horder : AllocationOrderInvariant store) + (hframe : Sim.RootsGraph + (CompilerFunctionRel sourceCtx src ambient) store sourceRest rest) + (hown : Sim.RootOwnership store + (Sim.rootsFor .shared (captureArgs ++ parameterArgs) ++ rest)) + (htarget : targetFuel ≤ limit) + (hcodeRun : runCode ctx targetFuel + ⟨((List.range entryCount).filter selected).length + modes.length, + .shared, true, code⟩ store (captureArgs ++ parameterArgs).reverse code = + .ok (store', value)) : + ProfileFundedCodeRun ctx targetFuel + ⟨((List.range entryCount).filter selected).length + modes.length, + .shared, true, code⟩ store (captureArgs ++ parameterArgs).reverse code + store' value profile := by + let captures := (List.range entryCount).filter selected + let parameterRemaining : Nat → Nat := fun index => countUses index body + let captureRemaining : Nat → Nat := + fun index => countUses (modes.length + index) body + let outerEntries := selectedEntriesFrom selected captureRemaining + (List.range entryCount) 0 + let input : VEnv := + ⟨parameterEntries captures.length modes parameterRemaining ++ outerEntries, + captures.length + modes.length⟩ + let drops := parameterDrops captures.length modes parameterRemaining + have hrun' : + (lowerFnBody src (compilerFuel + 1) input drops .shared body).run state = + .ok code finalState := by + simpa [input, drops, outerEntries, parameterRemaining, captureRemaining, + captures] using hrun + simp only [lowerFnBody] at hrun' + obtain ⟨releaseResult, releaseState, hreleaseRun, hafterRelease⟩ := + trackedBindRun_ok_inv hrun' + rcases releaseResult with ⟨middle, releaseEmit⟩ + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + trackedBindRun_ok_inv hafterRelease + rcases bodyResult with ⟨output, emit, av⟩ + have hpure : + (releaseEmit ∘ emit) (.ret (av.toAtom output)) = code ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨hcode, hbodyState⟩ := hpure + subst bodyState + have hinputNo : NoRecSelf input := by + apply NoRecSelf.appendEntries + · exact parameterEntries_noRecSelf captures.length modes + parameterRemaining (captures.length + modes.length) + · simpa [outerEntries] using + selectedEntriesFrom_noRecSelf selected captureRemaining + (List.range entryCount) 0 (captures.length + modes.length) + have hmiddleNo : NoRecSelf middle := + releaseSlots_noRecSelf input hreleaseRun hinputNo + obtain ⟨parameterOutput, plannedEmit, hparameterPlan, _⟩ := + parameterDrops_releasePlan_tracked_atDepth captures.length + (captures.length + modes.length) modes parameterRemaining + (by simpa [parameterRemaining] using hadmissible) + let plannedMiddle := frameVEnvEntries parameterOutput outerEntries + have hplan : ReleasePlan input drops plannedMiddle plannedEmit := by + have hframed := hparameterPlan.frameEntries outerEntries + simpa [input, drops, plannedMiddle, outerEntries, frameVEnvEntries] + using hframed + have hplanRun : (releaseSlots input drops).run state = + .ok (plannedMiddle, plannedEmit) state := hplan.run state + have heq : + (plannedMiddle, plannedEmit) = (middle, releaseEmit) ∧ + state = releaseState := by + simpa using hplanRun.symm.trans hreleaseRun + have hmiddle : plannedMiddle = middle := congrArg Prod.fst heq.1 + have hemit : plannedEmit = releaseEmit := congrArg Prod.snd heq.1 + subst middle + subst releaseEmit + cases heq.2 + have hbodySound : LowerResultProfileSoundBelow + (CompilerFunctionRel sourceCtx src ambient) (fun _ _ => False) ctx + ⟨captures.length + modes.length, .shared, true, code⟩ limit plannedMiddle + output (parameterSources.reverse ++ sourceEnv) + (parameterSources.reverse ++ sourceEnv) sourceResult .shared emit av + bodyProfile := + lowerE_run_profile_sound_within_noRecSelf_below + (recSelfRel := fun _ _ => False) + (cur := (⟨captures.length + modes.length, .shared, true, code⟩ : FnDef)) + henv hrepresented hcontracts hvalues hprofiles hsource hbodyRun + hextends hmiddleNo + have hbodySound' := hbodySound.monoProfile hbodyFunded + have hentryGraph : VEnvValueGraph + (CompilerFunctionRel sourceCtx src ambient) (fun _ _ => False) store + input (parameterSources.reverse ++ sourceEnv) + (captureArgs ++ parameterArgs).reverse + ((Sim.rootsForWorlds (modes.map worldOfUses) parameterArgs).reverse ++ + Sim.rootsFor .shared captureArgs) := by + simpa [input, outerEntries, parameterRemaining, captureRemaining, + captures] using + VEnvValueGraph.lifted (recSelfRel := fun _ _ => False) + entryCount modes parameterRemaining selected captureRemaining + hsourceLength hselectedValues hcaptureLength hparameterLength + hcaptureGraph hparameterGraph hpositive hshared hown + have hparameterRoots : + Sim.rootsForWorlds (modes.map worldOfUses) parameterArgs = + Sim.rootsFor .shared parameterArgs := by + rw [hshared] + exact rootsForWorlds_replicate_eq_rootsFor .shared hparameterLength + have hpre : GraphOwnsVEnv + (CompilerFunctionRel sourceCtx src ambient) (fun _ _ => False) input + (parameterSources.reverse ++ sourceEnv) sourceRest rest store + (captureArgs ++ parameterArgs).reverse := by + refine ⟨(Sim.rootsForWorlds + (modes.map worldOfUses) parameterArgs).reverse ++ + Sim.rootsFor .shared captureArgs, hentryGraph, hframe, ?_⟩ + have hrootPerm : + (Sim.rootsFor .shared (captureArgs ++ parameterArgs) ++ rest).Perm + (((Sim.rootsForWorlds + (modes.map worldOfUses) parameterArgs).reverse ++ + Sim.rootsFor .shared captureArgs) ++ rest) := by + rw [hparameterRoots] + simp only [Sim.rootsFor, List.map_append] + exact (List.perm_append_comm.trans + ((List.reverse_perm + (parameterArgs.map fun value => + (⟨.shared, value⟩ : Sim.Root))).symm + |>.append_right (captureArgs.map fun value => + (⟨.shared, value⟩ : Sim.Root)))).append_right rest + exact hown.perm hrootPerm + have hargsBounds : ValuesInBounds store + (captureArgs ++ parameterArgs) := by + intro runtime hmember + have hroot : (⟨.shared, runtime⟩ : Sim.Root) ∈ + Sim.rootsFor .shared (captureArgs ++ parameterArgs) ++ rest := by + apply List.mem_append_left rest + simpa [Sim.rootsFor] using hmember + exact rootOwnership_valueInBounds_of_mem hown hroot + have hreleaseCost := + releasePlan_profileFundedValueStateRunSoundBelow hplan + (funRel := CompilerFunctionRel sourceCtx src ambient) + (recSelfRel := fun _ _ => False) (ctx := ctx) + (cur := (⟨captures.length + modes.length, .shared, true, code⟩ : FnDef)) + (limit := limit) (parameterSources.reverse ++ sourceEnv) + sourceRest rest [] + have hbodyCost := hbodySound'.profileEmits sourceRest rest [] + have hcombined := ProfileFundedEmitStateRunSoundBelow.comp + hreleaseCost hbodyCost + have hcombined' : ProfileFundedEmitStateRunSoundBelow ctx + ⟨captures.length + modes.length, .shared, true, code⟩ limit + (plannedEmit ∘ emit) + (GraphOwnsVEnvProtected + (CompilerFunctionRel sourceCtx src ambient) (fun _ _ => False) input + (parameterSources.reverse ++ sourceEnv) sourceRest rest []) + (GraphOwnsResultProtected + (CompilerFunctionRel sourceCtx src ambient) (fun _ _ => False) + output (parameterSources.reverse ++ sourceEnv) sourceResult .shared + av sourceRest rest []) profile := + ProfileFundedEmitStateRunSoundBelow.of_profile_eq hcombined + (IxIR0.DynamicCost.Profile.zero_add profile) + have hcost := hcombined'.closeRet (av.toAtom output) htarget horder + hargsBounds.reverse ⟨hpre, SlotsRealize.nil⟩ (by + rw [hcode] + simpa [captures] using hcodeRun) + change plannedEmit (emit (.ret (av.toAtom output))) = code at hcode + simp only [Function.comp_apply] at hcost + rw [hcode] at hcost + simpa [captures] using hcost + +/-- Exact paired-cost certificate for saturating a compiler-provenanced +lifted PAP. Selected outer captures are split from stored lambda arguments; +the residual source profile reserves both target portions and funds the +stripped generated body. -/ +theorem invoke_lifted_retainedProfile_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {ctx : Ctx} {limit : Nat} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprofiles : CompilerProfileContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + {sourceFunction sourceResult : IxIR0.Value} + {address : Ixon.Address} {arity : Nat} + {captures sourceArgs : List IxIR0.Value} + {store store' : Store} {got args : List RVal} {value : RVal} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} {profile : SourceProfile} + (hlifted : CompilerLiftedFunctionRel src ambient sourceFunction address + arity captures) + (hgot : Sim.ValuesGraph (CompilerFunctionRel sourceCtx src ambient) + store captures got) + (hargs : Sim.ValuesGraph (CompilerFunctionRel sourceCtx src ambient) + store sourceArgs args) + (hsource : SourceAppliesProfile sourceCtx sourceFunction sourceArgs + sourceResult profile) + (hnonempty : sourceArgs ≠ []) + (hfullLength : (captures ++ sourceArgs).length = arity) + (horder : AllocationOrderInvariant store) + (hframe : Sim.RootsGraph (CompilerFunctionRel sourceCtx src ambient) + store sourceRest rest) + (hown : Sim.RootOwnership store + (Sim.rootsFor .shared (got ++ args) ++ rest)) + (hinvoke : invoke ctx limit address (got ++ args) store = + .ok (store', value)) : + RetainedProfileFundedInvokeRun ctx limit address (got ++ args) store + store' value captures.length profile := by + obtain ⟨sourceEnv, expr, selectedSources, suppliedSources, hliftCode, + hselectedValues, hcaptures, harity, hprefix⟩ := hlifted + subst captures + subst arity + obtain ⟨bodyCompilerFuel, bodyInitial, bodyFinal, code, hsafe, + hbodyRun, hbodyExtends, hmember⟩ := hliftCode + have hselectedLength := hselectedValues.length + rw [← hselectedLength] at hmember + have hdecl : ctx.decls address = some (.fn + ⟨selectedSources.length + lamArity expr, .shared, true, code⟩) := + hrepresented.decl hmember + have hmodes := papSafe_lamUses_eq_replicate hsafe + have hadmissible : ParameterDropsAdmissible (lamUses expr) + (fun index => countUses index (stripLams expr)) := by + rw [hmodes] + exact parameterDropsAdmissible_replicate_many _ _ + have hselectDef : ∀ index, index < sourceEnv.length → + decide (0 < countUses index expr) = + (countUses ((lamUses expr).length + index) (stripLams expr) != 0) := by + intro index _ + rw [lamUses_length] + rw [← countUses_eq_stripLams_shift expr index] + cases countUses index expr <;> rfl + have hshared : (lamUses expr).map worldOfUses = + List.replicate (lamUses expr).length .shared := by + rw [hmodes] + simp [worldOfUses] + have hpositive : 0 < (lamUses expr).length := by + have hunder := hprefix.length_lt_lamArity + rw [lamUses_length] + omega + have hselectedLe : selectedSources.length ≤ sourceEnv.length := by + rw [hselectedValues.length] + simpa [liftCaptureIndices] using List.length_filter_le + (fun index => countUses index expr > 0) (List.range sourceEnv.length) + have hreserve : (selectedSources ++ suppliedSources).length ≤ + sourceEnv.length + suppliedSources.length := by + simp only [List.length_append] + omega + cases bodyCompilerFuel with + | zero => + exact (trackedThrowRun_not_ok + (by simpa [lowerFnBody] using hbodyRun)).elim + | succ compilerFuel => + let selectedArgs := got.take selectedSources.length + let suppliedArgs := got.drop selectedSources.length + have hgotSplit : selectedArgs ++ suppliedArgs = got := + List.take_append_drop selectedSources.length got + have hselectedGraph : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store selectedSources + selectedArgs := by + simpa [selectedArgs] using hgot.take selectedSources.length + have hsuppliedGraph : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store suppliedSources + suppliedArgs := by + simpa [suppliedArgs] using hgot.drop selectedSources.length + have hparameterGraph : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store + (suppliedSources ++ sourceArgs) (suppliedArgs ++ args) := + hsuppliedGraph.append hargs + have hselectedArgsLength : selectedArgs.length = + (liftCaptureIndices sourceEnv.length expr).length := by + calc + selectedArgs.length = selectedSources.length := by + simpa [selectedArgs] using hselectedGraph.length.symm + _ = (liftCaptureIndices sourceEnv.length expr).length := + hselectedValues.length + have htotalSplit : selectedArgs ++ (suppliedArgs ++ args) = + got ++ args := by + rw [← List.append_assoc, hgotSplit] + have hownSplit : Sim.RootOwnership store + (Sim.rootsFor .shared + (selectedArgs ++ (suppliedArgs ++ args)) ++ rest) := by + rw [htotalSplit] + exact hown + have hbodyRun' : + (lowerFnBody src (compilerFuel + 1) + (liftedBodyVEnv sourceEnv.length expr) + (liftedBodyDrops sourceEnv.length expr) .shared + (stripLams expr)).run bodyInitial = .ok code bodyFinal := by + simpa using hbodyRun + cases limit with + | zero => simp [invoke] at hinvoke + | succ innerFuel => + simp only [invoke, hdecl] at hinvoke + split at hinvoke + · contradiction + next hlength => + have htotalLength : (got ++ args).length = + selectedSources.length + lamArity expr := by + simpa using hlength + have hparameterLength : (suppliedArgs ++ args).length = + (lamUses expr).length := by + have hgotLength : got.length = + selectedSources.length + suppliedSources.length := by + simpa using hgot.length.symm + have hsuppliedLength : suppliedArgs.length = + suppliedSources.length := hsuppliedGraph.length.symm + simp only [List.length_append] at htotalLength ⊢ + rw [lamUses_length] + omega + have hlambdaLength : (suppliedSources ++ sourceArgs).length = + lamArity expr := by + calc + (suppliedSources ++ sourceArgs).length = + (suppliedArgs ++ args).length := hparameterGraph.length + _ = (lamUses expr).length := hparameterLength + _ = lamArity expr := lamUses_length expr + obtain ⟨sourceFuel, bodyProfile, hsourceEval, hfunded⟩ := + LambdaPrefix.saturateProfile hprefix + (reserve := (selectedSources ++ suppliedSources).length) + hreserve hlambdaLength hsource hnonempty + cases hcodeEval : runCode ctx innerFuel + ⟨selectedSources.length + lamArity expr, .shared, true, code⟩ store + (got ++ args).reverse code with + | error error => + rw [hcodeEval] at hinvoke + contradiction + | ok out => + rw [hcodeEval] at hinvoke + change checkResultWorld .shared out = + .ok (store', value) at hinvoke + obtain ⟨hpair, _⟩ := Sim.checkResultWorld_ok hinvoke + subst out + have hcodeEval' : runCode ctx innerFuel + ⟨(liftCaptureIndices sourceEnv.length expr).length + + (lamUses expr).length, + .shared, true, code⟩ store + (selectedArgs ++ (suppliedArgs ++ args)).reverse code = + .ok (store', value) := by + rw [htotalSplit, ← hselectedLength, lamUses_length] + exact hcodeEval + have hbodyCost := lowerFnBody_liftedEntries_profileRun_below + (compilerFuel := compilerFuel) (limit := innerFuel) + (targetFuel := innerFuel) henv hrepresented hcontracts hvalues + (hprofiles.mono (by omega)) sourceEnv.length (lamUses expr) + (stripLams expr) (fun index => countUses index expr > 0) + hadmissible hselectDef hpositive hshared + (by simpa [liftedBodyVEnv, liftedBodyDrops, + liftCaptureIndices] using hbodyRun') + hbodyExtends (sourceEnv := sourceEnv) + (selectedSources := selectedSources) + (parameterSources := suppliedSources ++ sourceArgs) + (captureArgs := selectedArgs) + (parameterArgs := suppliedArgs ++ args) + (sourceResult := sourceResult) rfl + (by simpa [liftCaptureIndices] using hselectedValues) + (by simpa [liftCaptureIndices] using hselectedArgsLength) + hparameterLength hselectedGraph hparameterGraph + hsourceEval (OwnershipAllowanceLE.refl _) horder hframe + hownSplit (Nat.le_refl _) hcodeEval' + have hbodyCost' : ProfileFundedCodeRun ctx innerFuel + ⟨selectedSources.length + lamArity expr, .shared, true, code⟩ store + (got ++ args).reverse code store' value bodyProfile := by + rw [hselectedLength, ← lamUses_length, ← htotalSplit] + exact hbodyCost + have hcore : ProfileFundedInvokeRun ctx (innerFuel + 1) address + (got ++ args) store store' value bodyProfile := + ProfileFundedInvokeRun.fn hdecl + (by simpa using hlength) hbodyCost' hinvoke + exact ⟨bodyProfile, hcore, by simpa using hfunded⟩ + +/-- Profiled inversion of a residual recursor PAP at its final major +argument. Historical PAP arguments are not replayed: the current source +profile itself funds one retain of the stored prefix plus the selected +recursor rule's fields and exact RHS body. -/ +theorem sourceRecursorPap_saturatesProfile_inv + {sourceCtx : IxIR0.Ctx} {address : Ixon.Address} + {numArgs : Nat} {natLit : Bool} {rules : Array IxIR0.RecRule} + {sourceResult major : IxIR0.Value} + {captured remainingPre : List IxIR0.Value} + {profile : SourceProfile} + (hlookup : sourceCtx.env address = + some (.recursor numArgs natLit rules)) + (hpreLength : (captured ++ remainingPre).length = numArgs) + (happlies : SourceAppliesProfile sourceCtx + (.pap (.rec_ address (numArgs + 1)) captured) + (remainingPre ++ [major]) sourceResult profile) : + ∃ tag fields rule bodyFuel bodyProfile, + IxIR0.majorCtor natLit major = .ok (tag, fields) ∧ + rules[tag]? = some rule ∧ + fields.length = rule.fields ∧ + IxIR0.DynamicCost.Eval sourceCtx bodyFuel + (fields.reverse ++ (captured ++ remainingPre).reverse ++ + [.pap (.rec_ address (numArgs + 1)) []]) + rule.rhs sourceResult bodyProfile ∧ + OwnershipAllowanceLE + (sourceProfileOwnershipAllowance + (IxIR0.DynamicCost.retain captured.length + + (IxIR0.DynamicCost.retain fields.length + bodyProfile))) + (sourceProfileOwnershipAllowance profile) := by + obtain ⟨middle, prefixProfile, tailProfile, hleft, hright, hprofile⟩ := + happlies.splitAt remainingPre.length + have htake : (remainingPre ++ [major]).take remainingPre.length = + remainingPre := by simp + have hdrop : (remainingPre ++ [major]).drop remainingPre.length = + [major] := by simp + rw [htake] at hleft + rw [hdrop] at hright + have hunder : (captured ++ remainingPre).length < + (IxIR0.Head.rec_ address (numArgs + 1)).arity := by + simp [IxIR0.Head.arity, hpreLength] + have hcanonical : SourceApplies sourceCtx + (.pap (.rec_ address (numArgs + 1)) captured) remainingPre + (.pap (.rec_ address (numArgs + 1)) + (captured ++ remainingPre)) := + sourcePap_underfills hunder + have hmiddle : middle = .pap (.rec_ address (numArgs + 1)) + (captured ++ remainingPre) := + hleft.toSourceApplies.deterministic hcanonical + subst middle + cases hright with + | cons hstep htail => + cases htail + cases hstep with + | pap hsaturate => + cases hsaturate with + | pending hne => + exact (hne (by + simp only [List.length_append, List.length_singleton, + IxIR0.Head.arity] + simp only [List.length_append] at hpreLength + omega)).elim + | full hlength hfire => + cases hfire with + | recursor hlookup' hlast hmajor hrule hfields hbody => + rw [hlookup] at hlookup' + cases hlookup' + have hlast' : + ((captured ++ remainingPre) ++ [major]).getLast? = + some major := by simp + rw [hlast'] at hlast + cases hlast + have hdropLast : + ((captured ++ remainingPre) ++ [major]).dropLast = + captured ++ remainingPre := by simp + rw [hdropLast] at hbody + refine ⟨_, _, _, _, _, hmajor, hrule, hfields, hbody, ?_⟩ + rw [← hprofile] + simp [OwnershipAllowanceLE, sourceProfileOwnershipAllowance, + IxIR0.DynamicCost.tick, IxIR0.DynamicCost.retain] + omega + +/-- Saturating a residual source recursor PAP executes the generated case +dispatcher with a core profile consisting only of selected-field retains +and the exact rule body. The current application profile separately funds +the already stored PAP prefix. -/ +theorem lowerRecursor_residual_profile_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {ctx : Ctx} {limit compilerFuel numArgs : Nat} + {natLit : Bool} {rules : Array IxIR0.RecRule} + {address : Ixon.Address} {sourceFunction : IxIR0.Value} + {state finalState : LowSt} {d : FnDef} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprofiles : CompilerProfileContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + (hsrc : src address = some (.recursor numArgs natLit rules)) + (hdecl : ctx.decls address = some (.fn d)) + (href : SourceRefValue sourceCtx address sourceFunction) + (hrun : (lowerRecursor src compilerFuel numArgs natLit rules).run state = + .ok d finalState) + (hextends : ExtraExtends finalState ambient) + {sourceCaptures sourceArgs : List IxIR0.Value} + {sourceResult : IxIR0.Value} {captures args : List RVal} + {store store' : Store} {value : RVal} + {sourceRest : List (Ixon.Owned × IxIR0.Value)} + {rest : List Sim.Root} {profile : SourceProfile} + (hcaptures : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store sourceCaptures + captures) + (hargs : Sim.ValuesGraph (CompilerFunctionRel sourceCtx src ambient) + store sourceArgs args) + (hsource : SourceAppliesProfile sourceCtx + (.pap (.rec_ address (numArgs + 1)) sourceCaptures) + sourceArgs sourceResult profile) + (hnonempty : sourceArgs ≠ []) + (hfullLength : (sourceCaptures ++ sourceArgs).length = numArgs + 1) + (horder : AllocationOrderInvariant store) + (hframe : Sim.RootsGraph (CompilerFunctionRel sourceCtx src ambient) + store sourceRest rest) + (hown : Sim.RootOwnership store + (Sim.rootsFor .shared (captures ++ args) ++ rest)) + (hinvoke : invoke ctx limit address (captures ++ args) store = + .ok (store', value)) : + RetainedProfileFundedInvokeRun ctx limit address (captures ++ args) + store store' value sourceCaptures.length profile := by + simp only [lowerRecursor] at hrun + obtain ⟨alts, rulesState, hrulesRun, hafterRules⟩ := + trackedBindRun_ok_inv hrun + have hpure : + (⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩ : FnDef) = d ∧ + rulesState = finalState := by + simpa using hafterRules + obtain ⟨hd, hstate⟩ := hpure + subst d + subst rulesState + have hsourceLookup : sourceCtx.env address = + some (.recursor numArgs natLit rules) := by + rw [henv] + exact hsrc + have hsourceFunction := href.recursorValue hsourceLookup + subst sourceFunction + let recSelfRel : RecSelfRel := fun candidate candidateArity => + candidate = .pap (.rec_ address (numArgs + 1)) [] ∧ + candidateArity = numArgs + 1 + obtain ⟨ownedD, hownedDecl, _, _, hownedContract⟩ := + hcontracts.decls.recursor hsrc + have hownedD : ownedD = + (⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩ : FnDef) := by + have hsame : some (Decl.fn ownedD) = some + (.fn ⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩) := + hownedDecl.symm.trans hdecl + exact Decl.fn.inj (Option.some.inj hsame) + subst ownedD + have hvalueContract : FnValueContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx + ⟨numArgs + 1, .shared, true, .case (.var 0) natLit alts.toArray⟩ + (List.replicate (numArgs + 1) .shared) + (.pap (.rec_ address (numArgs + 1)) []) := by + apply hvalues.decls.fnContract hsrc (by rfl) hdecl href + simp + have hprofileContract : FnProfileContractBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx address + ⟨numArgs + 1, .shared, true, .case (.var 0) natLit alts.toArray⟩ + (List.replicate (numArgs + 1) .shared) + (.pap (.rec_ address (numArgs + 1)) []) limit := by + apply hprofiles.decls.fnContract hsrc (by rfl) hdecl href + simp + have hself : CurrentSelfProfileContractBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + ⟨numArgs + 1, .shared, true, .case (.var 0) natLit alts.toArray⟩ + limit := by + refine ⟨rfl, by omega, hownedContract, ?_, ?_⟩ + · intro candidate hcandidate + change candidate = .pap (.rec_ address (numArgs + 1)) [] ∧ + numArgs + 1 = numArgs + 1 at hcandidate + rcases hcandidate with ⟨rfl, _⟩ + exact hvalueContract + · intro candidate hcandidate + change candidate = .pap (.rec_ address (numArgs + 1)) [] ∧ + numArgs + 1 = numArgs + 1 at hcandidate + rcases hcandidate with ⟨rfl, _⟩ + exact ⟨address, hprofileContract⟩ + have hfinalRepresented : ExtraRepresented ctx finalState := + hrepresented.of_extends hextends + have hownershipSelf : CurrentSelfContractBelow ctx + ⟨numArgs + 1, .shared, true, .case (.var 0) natLit alts.toArray⟩ + limit := ⟨hself.result, hself.ownership.below limit⟩ + have hplan : RecursorRulesPlanBelow ctx + ⟨numArgs + 1, .shared, true, .case (.var 0) natLit alts.toArray⟩ + limit src compilerFuel numArgs state rules.toList.zipIdx + finalState alts := + recursorRulesPlanBelow_of_run (hcontracts.below limit).apply + (hcontracts.below limit).decls hownershipSelf rfl + compilerFuel numArgs hrulesRun hfinalRepresented + have hfullGraph : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store + (sourceCaptures ++ sourceArgs) (captures ++ args) := + hcaptures.append hargs + have hargsArity : (captures ++ args).length = numArgs + 1 := + hfullGraph.length.symm.trans hfullLength + cases limit with + | zero => simp [invoke] at hinvoke + | succ branchFuel => + simp only [invoke, hdecl] at hinvoke + split at hinvoke + · contradiction + next hlength => + cases hcodeEval : runCode ctx branchFuel + ⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩ + store (captures ++ args).reverse + (.case (.var 0) natLit alts.toArray) with + | error error => + rw [hcodeEval] at hinvoke + contradiction + | ok out => + rw [hcodeEval] at hinvoke + change checkResultWorld .shared out = + .ok (store', value) at hinvoke + obtain ⟨hpair, _⟩ := Sim.checkResultWorld_ok hinvoke + subst out + cases hreverseArgs : args.reverse with + | nil => + have hargsNil : args = [] := by + have h := congrArg List.reverse hreverseArgs + simpa using h + have hsourceArgsNil : sourceArgs = [] := by + have hlength := hargs.length + simpa [hargsNil] using hlength + exact (hnonempty hsourceArgsNil).elim + | cons major runtimeNewPre => + have hargsForm : args = runtimeNewPre.reverse ++ [major] := by + have h := congrArg List.reverse hreverseArgs + simpa [List.reverse_cons] using h + obtain ⟨sourceRemainingPre, sourceMajor, hsourceArgsForm, + hsourceRemainingPreLength, hremainingGraphs, + hmajorGraph⟩ := + valuesGraph_splitLast hargs hargsForm rfl + rw [hsourceArgsForm] at hsource + have hsourcePreLength : + (sourceCaptures ++ sourceRemainingPre).length = numArgs := by + rw [hsourceArgsForm] at hfullLength + simp only [List.length_append, List.length_singleton] + at hfullLength ⊢ + omega + obtain ⟨sourceTag, sourceFields, sourceRule, sourceFuel, + bodyProfile, hsourceMajor, hsourceRule, + hsourceFieldsLength, hsourceEval, hsourceFunded⟩ := + sourceRecursorPap_saturatesProfile_inv hsourceLookup + hsourcePreLength hsource + let runtimePre := runtimeNewPre ++ captures.reverse + have hfullArgsForm : captures ++ args = + runtimePre.reverse ++ [major] := by + simp [runtimePre, hargsForm, List.reverse_append] + have hpreGraphs : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store + (sourceCaptures ++ sourceRemainingPre) runtimePre.reverse := by + simpa [runtimePre, List.reverse_append] using + hcaptures.append hremainingGraphs + have hruntimePreLength : runtimePre.length = numArgs := by + have hlength := hpreGraphs.length.symm.trans hsourcePreLength + simpa using hlength + have hmajorWorld : Sim.HasWorld store .shared major := by + apply hown.roots_world ⟨.shared, major⟩ + apply List.mem_append_left rest + simp [Sim.rootsFor, hfullArgsForm] + have hentryOwn : Sim.RootOwnership store + (Sim.rootsFor .shared + (runtimePre.reverse ++ [major]) ++ rest) := by + simpa [hfullArgsForm] using hown + obtain ⟨caseFuel, rfl⟩ : ∃ caseFuel, branchFuel = caseFuel + 1 := by + cases branchFuel with + | zero => simp [runCode] at hcodeEval + | succ caseFuel => exact ⟨caseFuel, by omega⟩ + have htarget : runCode ctx (caseFuel + 1) + ⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩ + store (major :: runtimePre) + (.case (.var 0) natLit alts.toArray) = + .ok (store', value) := by + have hcodeEval' := hcodeEval + rw [hfullArgsForm] at hcodeEval' + simpa using hcodeEval' + have hdispatch := htarget + rw [runCode.eq_def] at hdispatch + dsimp only at hdispatch + rw [show resolveAtom (major :: runtimePre) (.var 0) = .ok major + from rfl, costTraceExceptBindOk] at hdispatch + let coreProfile := + IxIR0.DynamicCost.retain sourceFields.length + bodyProfile + have finish {cidx selectedTag fieldCount : Nat} {body : Code} + (halt : alts.toArray.find? (fun alt => alt.cidx == cidx) = + some (.mk selectedTag fieldCount body)) + (hcidx : cidx = sourceTag) + {targetFields : List RVal} + (hfieldGraphs : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store + sourceFields targetFields) + (htargetFieldsLength : targetFields.length = fieldCount) + (hfieldWorld : ∀ field ∈ targetFields, + Sim.HasWorld store .shared field) + (hbranchRun : runCode ctx caseFuel + ⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩ + store (targetFields.reverse ++ major :: runtimePre) body = + .ok (store', value)) : + ProfileFundedCodeRun ctx (caseFuel + 1) + ⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩ + store (major :: runtimePre) + (.case (.var 0) natLit alts.toArray) store' value + coreProfile := by + obtain ⟨rule, headState, nextState, tailRules, tailAlts, + fieldOutput, fieldEmit, rhsInput, parameterEmit, + output, bodyEmit, av, hrule, _, hfieldCount, + hfieldPlan, hparameterPlan, hbodyRun, hbody, + htailPlan⟩ := hplan.find?_run_plan_inv halt + have hsourceRuleAt : rules[cidx]? = some sourceRule := by + rw [hcidx] + exact hsourceRule + have hruleEq : rule = sourceRule := + Option.some.inj (hrule.symm.trans hsourceRuleAt) + subst rule + have htargetRuleLength : targetFields.length = + sourceRule.fields := + htargetFieldsLength.trans hfieldCount + have htailExtends : ExtraExtends nextState finalState := + (ExtraMonotone.listMapM + (lowerRecursorRule src compilerFuel numArgs) + (lowerRecursorRule_extraMonotone src compilerFuel numArgs) + tailRules) htailPlan.run + have hnextExtends : ExtraExtends nextState ambient := + htailExtends.trans hextends + rw [hbody] at hbranchRun + obtain ⟨allowance, hbranchCost, hfunded⟩ := + lowerRecursorRule_branch_profile_below + (recSelfRel := recSelfRel) (limit := (caseFuel + 1) + 1) + (branchFuel := caseFuel) + henv hrepresented hcontracts hvalues hprofiles hself + hfieldPlan hparameterPlan hbodyRun hnextExtends + (sourcePre := sourceCaptures ++ sourceRemainingPre) + (pre := runtimePre.reverse) + (sourceFields := sourceFields) (fields := targetFields) + (sourceSelf := .pap (.rec_ address (numArgs + 1)) []) + (sourceValue := sourceResult) (major := major) + (profile := coreProfile) hsourceEval + (OwnershipAllowanceLE.refl _) + (by simpa using hruntimePreLength) + htargetRuleLength hpreGraphs hfieldGraphs ⟨rfl, rfl⟩ + horder hframe hentryOwn hfieldWorld (by omega) + (by simpa using hbranchRun) + refine ⟨allowance, ?_, hfunded⟩ + refine + { startOrder := horder + envBounds := ?_ + run := ?_ + growth := hbranchCost.growth } + · have hsuffix := + hbranchCost.envBounds.drop targetFields.reverse.length + simpa using hsuffix + · simpa using htarget + have hbodyCost : ProfileFundedCodeRun ctx (caseFuel + 1) + ⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩ + store (major :: runtimePre) + (.case (.var 0) natLit alts.toArray) store' value + coreProfile := by + cases hmajorGraph with + | @lit literal => + cases literal with + | str string => simp [IxIR0.majorCtor] at hsourceMajor + | nat n => + cases hpeel : natLit with + | false => + simp [IxIR0.majorCtor, hpeel] at hsourceMajor + | true => + cases n with + | zero => + have hmajorPair : + 0 = sourceTag ∧ sourceFields = [] := by + simpa [IxIR0.majorCtor, hpeel] using hsourceMajor + have htag : sourceTag = 0 := hmajorPair.1.symm + have hfields : sourceFields = [] := hmajorPair.2 + subst sourceTag + subst sourceFields + cases halt : alts.toArray.find? + (fun alt => alt.cidx == 0) with + | none => simp [hpeel, halt] at hdispatch + | some alt => + cases alt with + | mk selectedTag fieldCount body => + cases fieldCount with + | zero => + have hbranch := hdispatch + simp [hpeel, halt] at hbranch + simpa [hpeel] using + (finish halt rfl Sim.ValuesGraph.nil rfl + (by simp) + (by simpa [hpeel] using hbranch)) + | succ fieldCount => + simp [hpeel, halt] at hdispatch + | succ n => + have hmajorPair : + 1 = sourceTag ∧ + [.lit (.nat n)] = sourceFields := by + simpa [IxIR0.majorCtor, hpeel] using hsourceMajor + have htag : sourceTag = 1 := hmajorPair.1.symm + have hfields : sourceFields = [.lit (.nat n)] := + hmajorPair.2.symm + subst sourceTag + subst sourceFields + cases halt : alts.toArray.find? + (fun alt => alt.cidx == 1) with + | none => simp [hpeel, halt] at hdispatch + | some alt => + cases alt with + | mk selectedTag fieldCount body => + by_cases hfieldCount : fieldCount = 1 + · subst fieldCount + have hbranch := hdispatch + simp [hpeel, halt] at hbranch + simpa [hpeel] using + (finish halt rfl (.cons .lit .nil) rfl + (by simp [Sim.HasWorld]) + (by simpa [hpeel] using hbranch)) + · simp [hpeel, halt, hfieldCount] at hdispatch + | erased => simp [IxIR0.majorCtor] at hsourceMajor + | @ctor sourceAddress sourceCtorTag sourceCtorFields loc + world rc cid targetFields hget haddress htag hfieldGraphs => + have hmajorPair : + sourceCtorTag = sourceTag ∧ + sourceCtorFields = sourceFields := by + simpa [IxIR0.majorCtor] using hsourceMajor + have hsourceTagEq : sourceTag = sourceCtorTag := + hmajorPair.1.symm + have hsourceFieldsEq : sourceFields = sourceCtorFields := + hmajorPair.2.symm + subst sourceTag + subst sourceFields + obtain ⟨ownedBox, hownedBox, hownedWorld⟩ := hmajorWorld + rw [hget] at hownedBox + have hboxEq : + (⟨world, rc, .ctorN cid targetFields⟩ : NodeBox) = + ownedBox := + Option.some.inj hownedBox + subst ownedBox + dsimp only [NodeBox.world] at hownedWorld + subst world + cases halt : alts.toArray.find? + (fun alt => alt.cidx == cid.cidx) with + | none => simp [hget, halt] at hdispatch + | some alt => + cases alt with + | mk selectedTag fieldCount body => + by_cases hsize : targetFields.size = fieldCount + · have hbranch := htarget + rw [Sim.runCode_case_ctor rfl hget halt hsize] at hbranch + rw [Array.foldl_cons_eq_reverse_append] at hbranch + exact finish halt htag (by simpa using hfieldGraphs) + (by simpa using hsize) (hown.caseFieldsBorrowed hget) + hbranch + · simp [hget, halt, hsize] at hdispatch + | function hget hfun hcaptured => + simp [hget] at hdispatch + have hcore : ProfileFundedInvokeRun ctx ((caseFuel + 1) + 1) address + (captures ++ args) store store' value coreProfile := + ProfileFundedInvokeRun.fn hdecl (by simpa using hlength) + (by simpa [hfullArgsForm] using hbodyCost) hinvoke + exact ⟨coreProfile, hcore, by + simpa [coreProfile] using hsourceFunded⟩ + +/-- At one evaluator index, every residual function represented by an +actual whole-pass run preserves its exact source profile. Static source +PAPs, generated constructor wrappers, and lifted lambdas are discharged by +their respective run-level adapters. -/ +theorem lowerAllAction_residualFnProfilePreservesAt_within_below + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Ixon.Owned} {compilerFuel limit : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htarget : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hprofiles : CompilerProfileContractsBelow + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx limit) : + ResidualFnProfilePreservesAt + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx limit := by + intro before after sourceFunction sourceResult address arity + sourceCaptures sourceArgs captures args value sourceRest rest profile + horder hrel hcaptures hargs hsource hnonempty hfullLength hframe hown + hinvoke + have hprefixFunded := + CompilerFunctionRel.underApplyProfileFunding henv hrel hsource hnonempty + cases hrel with + | @source relatedFunction baseFunction sourceAddress targetArity + storedSources source hsrc heligible harity href hprefix hunder => + cases source with + | defn result body => + exact lowerAllAction_sourceDefnResidual_profile_below + henv hlower htarget hrepresented hcontracts hvalues hprofiles + hsrc heligible harity href hprefix hunder horder hcaptures hargs + hsource hnonempty hfullLength hframe hown hinvoke + | ctor tag ctorArity => exact heligible.elim + | recursor numArgs natLit rules => + have hlookup : sourceCtx.env address = + some (.recursor numArgs natLit rules) := by + rw [henv] + exact hsrc + have hbase := href.recursorValue hlookup + subst baseFunction + have harity' : numArgs + 1 = arity := by + simpa [sourceDeclArity] using harity + have hstoredUnder : sourceCaptures.length < numArgs + 1 := by + omega + have hcanonical : SourceApplies sourceCtx + (.pap (.rec_ address (numArgs + 1)) []) sourceCaptures + (.pap (.rec_ address (numArgs + 1)) sourceCaptures) := + sourcePap_underfills (by + simpa [IxIR0.Head.arity] using hstoredUnder) + have hrelated : sourceFunction = + .pap (.rec_ address (numArgs + 1)) sourceCaptures := + hprefix.deterministic hcanonical + subst sourceFunction + obtain ⟨d, hdecl, _, _, _⟩ := hcontracts.decls.recursor hsrc + obtain ⟨itemInitial, itemFinal, hdeclRun, hextends⟩ := + lowerAllAction_callable_decl_trace hlower htarget hsrc (by rfl) + hdecl + simp only [lowerDecl] at hdeclRun + obtain ⟨actual, recursorState, hrecursorRun, hafterRecursor⟩ := + trackedBindRun_ok_inv hdeclRun + have hpure : + some (address, Decl.fn actual) = + some (address, Decl.fn d) ∧ + recursorState = itemFinal := by + simpa using hafterRecursor + have hd : actual = d := by + have hp := Option.some.inj hpure.1 + exact Decl.fn.inj (Prod.mk.inj hp).2 + have hrecursorState : recursorState = itemFinal := hpure.2 + subst actual + subst recursorState + have hfullLength' : + (sourceCaptures ++ sourceArgs).length = numArgs + 1 := by + exact hfullLength.trans harity'.symm + exact lowerRecursor_residual_profile_below + henv hrepresented hcontracts hvalues hprofiles hsrc hdecl href + hrecursorRun hextends hcaptures hargs hsource hnonempty + hfullLength' horder hframe hown hinvoke + | extern externArity => + have hdecl := hcontracts.decls.extern hsrc + have hruntimeLength : (captures ++ args).length = externArity := by + have hgraphLength := (hcaptures.append hargs).length + have harity' : arity = externArity := by + simpa [sourceDeclArity] using harity.symm + exact hgraphLength.symm.trans (hfullLength.trans harity') + exact extern_retainedProfileFundedInvokeRun hdecl hruntimeLength + horder hown hinvoke hprefixFunded + | @wrapper relatedFunction baseFunction storedSources memo hmember hsrc + href hprefix hunder => + have hdecl : ctx.decls memo.wrapper = some (.fn + ⟨memo.arity, .shared, true, + .letOp (.alloc .shared (ctorIdOf memo.source memo.tag) + (descendingVars memo.arity).toArray) (.ret (.var 0))⟩) := by + simpa [ctorWrapperDecl] using hrepresented.wrapper hmember + have hruntimeLength : (captures ++ args).length = memo.arity := + (hcaptures.append hargs).length.symm.trans hfullLength + exact ctorWrapper_retainedProfileFundedInvokeRun hdecl hruntimeLength + horder hown hinvoke hprefixFunded + | @lifted relatedFunction address arity storedSources hlifted => + exact invoke_lifted_retainedProfile_below henv hrepresented hcontracts + hvalues hprofiles hlifted hcaptures hargs hsource hnonempty + hfullLength horder hframe hown hinvoke + +/-- Seal the exact-profile contracts generated by an actual whole-pass run. +The three-way strong induction simultaneously closes direct declaration +calls, residual PAP saturation, and higher-order application. -/ +theorem lowerAllAction_compilerProfileContracts + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Ixon.Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htarget : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hextern : ExternValueContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx) : + CompilerProfileContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx := by + have hvalues := lowerAllAction_compilerValueContracts + henv hlower htarget hrepresented hcontracts hextern + apply compilerProfileContracts_of_below_step + intro limit hprofiles + refine ⟨?_, ?_, ?_⟩ + · exact lowerAllAction_sourceFnProfilePreservesAt_within_below + henv hlower htarget hrepresented hcontracts hvalues hprofiles + · exact lowerAllAction_residualFnProfilePreservesAt_within_below + henv hlower htarget hrepresented hcontracts hvalues hprofiles + · exact applyProfilePreservesAt_within_below henv hrepresented + hcontracts (hvalues.below limit) hprofiles + +/-- A successful source-profile trace for the closed main funds the exact +successful target execution produced by the same whole-pass run. All +recursive declaration and PAP obligations are supplied by the sealed +compiler-profile environment above. -/ +theorem lowerAllAction_main_profileFundedCodeRun_sealed + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Ixon.Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} {sourceFuel targetFuel : Nat} + {sourceValue : IxIR0.Value} {profile : SourceProfile} + {targetStore : Store} {targetValue : RVal} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htargetDecls : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hextern : ExternValueContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx) + (hsource : IxIR0.DynamicCost.Eval sourceCtx sourceFuel [] main + sourceValue profile) + (htarget : runMain ctx mainCode targetFuel = + .ok (targetStore, targetValue)) : + ProfileFundedCodeRun ctx targetFuel ⟨0, .shared, false, mainCode⟩ + ({} : Store) [] mainCode targetStore targetValue profile := by + have hvalues := lowerAllAction_compilerValueContracts + henv hlower htargetDecls hrepresented hcontracts hextern + have hprofiles := lowerAllAction_compilerProfileContracts + henv hlower htargetDecls hrepresented hcontracts hextern + obtain ⟨mainInitial, hmain⟩ := lowerAllAction_main_trace hlower + cases compilerFuel with + | zero => + simp only [lowerFnBody] at hmain + exact (trackedThrowRun_not_ok hmain).elim + | succ bodyFuel => + simp only [lowerFnBody] at hmain + obtain ⟨releaseResult, releaseState, hrelease, hafterRelease⟩ := + trackedBindRun_ok_inv hmain + rcases releaseResult with ⟨middle, releaseEmit⟩ + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + trackedBindRun_ok_inv hafterRelease + rcases bodyResult with ⟨output, emit, av⟩ + have hpure : + (releaseEmit ∘ emit) (.ret (av.toAtom output)) = mainCode ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨hcode, hbodyState⟩ := hpure + subst bodyState + let input : VEnv := ⟨[], 0⟩ + have hplan : ReleasePlan input [] input (_root_.id : Emit) := .nil + have hplanRun : (releaseSlots input []).run mainInitial = + .ok (input, (_root_.id : Emit)) mainInitial := + hplan.run mainInitial + have heq : + (input, (_root_.id : Emit)) = (middle, releaseEmit) ∧ + mainInitial = releaseState := by + simpa [input] using hplanRun.symm.trans hrelease + have hmiddle : input = middle := congrArg Prod.fst heq.1 + have hemitting : (_root_.id : Emit) = releaseEmit := + congrArg Prod.snd heq.1 + subst middle + subst releaseEmit + cases heq.2 + let cur : FnDef := ⟨0, .shared, false, mainCode⟩ + have hbodySound : LowerResultProfileSound + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + (fun _ _ => False) ctx cur input output [] [] sourceValue + mainWorld emit av profile := + lowerE_run_profile_sound_within_noRecSelf + (recSelfRel := fun _ _ => False) (cur := cur) henv hrepresented + hcontracts hvalues hprofiles hsource hbodyRun + (ExtraExtends.refl _) + (by intro index arity hentry; simp [input] at hentry) + have hpre : GraphOwnsVEnvProtected + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + (fun _ _ => False) input [] [] [] [] ({} : Store) [] := by + refine ⟨?_, SlotsRealize.nil⟩ + refine ⟨[], ?_, Sim.RootsGraph.nil, Sim.RootOwnership.empty⟩ + exact ⟨by simp [input], EntriesValueGraph.nil⟩ + have htarget' : runCode ctx targetFuel cur ({} : Store) [] + (emit (.ret (av.toAtom output))) = + .ok (targetStore, targetValue) := by + unfold runMain at htarget + change runCode ctx targetFuel cur ({} : Store) [] mainCode = + .ok (targetStore, targetValue) at htarget + rw [← hcode] at htarget + simpa using htarget + have hcost := ProfileFundedEmitStateRunSound.closeRet + (hbodySound.profileEmits [] [] []) (av.toAtom output) + AllocationOrderInvariant.empty (ValuesInBounds.nil ({} : Store)) + hpre htarget' + have hcode' : emit (.ret (av.toAtom output)) = mainCode := by + simpa using hcode + rw [hcode'] at hcost + simpa [cur] using hcost + +/-- The linear four-counter budget induced by an executed source profile. -/ +def ProfileWeights.budget (weights : ProfileWeights) + (profile : SourceProfile) : CostObservation := + observationAdd (observationScale profile.retains weights.retain) + (observationAdd (observationScale profile.evals weights.eval) + (observationAdd (observationScale profile.applies weights.apply) + (observationAdd + (observationScale profile.saturations weights.saturation) + (observationAdd + (observationScale profile.constructorFires weights.constructor) + (observationAdd + (observationScale profile.closureValues weights.closure) + (observationAdd + (observationScale profile.papValues weights.pap) + (observationAdd + (observationScale profile.recursorFires weights.recursor) + (observationAdd + (observationScale profile.externFires weights.extern) + (observationScale profile.projections + weights.projection))))))))) + +/-- A target observation fits the budget predicted by the source profile. -/ +def WithinBudget (weights : ProfileWeights) (profile : SourceProfile) + (observation : CostObservation) : Prop := + ObservationLE observation (weights.budget profile) + +/-- The concrete inequalities exposed by `ownershipAmortizedWeights`. +This names the compiler proof obligation independently of the nested linear +combination used to compute the budget. -/ +def OwnershipAmortizedSpec (profile : SourceProfile) + (observation : CostObservation) : Prop := + observation.allocs ≤ profile.evals ∧ + observation.reuses = 0 ∧ + observation.frees ≤ profile.evals ∧ + observation.rcops ≤ profile.retains * 2 + profile.evals * 2 + +theorem withinBudget_ownershipAmortized_iff + (profile : SourceProfile) (observation : CostObservation) : + WithinBudget ownershipAmortizedWeights profile observation ↔ + OwnershipAmortizedSpec profile observation := by + simp [WithinBudget, ObservationLE, ProfileWeights.budget, + observationAdd, observationScale, ownershipAmortizedWeights, + OwnershipAmortizedSpec] + +/-- The target-side certificate needed from the lowering proof for one +successful profiled run. Allocation and reuse are ordinary counters; RC +traffic is stated in the potential-aware form so arbitrary deep drops cost +zero locally. -/ +structure OwnershipAmortizedRunCertificate (profile : SourceProfile) + (store : Store) : Prop where + allocations : store.allocs ≤ profile.evals + reuses : store.reuses = 0 + rcPotential : RcPotentialGrowthLE ({} : Store) store + (profile.retains * 2 + profile.evals * 2) + +/-- Close a fresh run-indexed code certificate against its source-profile +allowance. This is the recursive production seam: the allowance belongs to +the particular dynamic trace rather than to the finite target syntax. -/ +theorem CodeOwnershipRunCost.runCertificate + {ctx : Ctx} {code : Code} {allowance : OwnershipAllowance} + {profile : SourceProfile} {fuel : Nat} {store : Store} {value : RVal} + (hcost : CodeOwnershipRunCost ctx fuel ⟨0, .shared, false, code⟩ + ({} : Store) [] code store value allowance) + (hfunded : OwnershipAllowanceLE allowance + (sourceProfileOwnershipAllowance profile)) : + OwnershipAmortizedRunCertificate profile store := by + obtain ⟨halloc, hreuses, hrc⟩ := hcost.growth + simp only [OwnershipAllowanceLE, sourceProfileOwnershipAllowance] + at hfunded + refine ⟨?_, ?_, ?_⟩ + · simp at halloc + exact Nat.le_trans halloc hfunded.1 + · simpa using hreuses + · exact hrc.monoAllowance hfunded.2 + +/-- A source-funded fresh code run directly exposes the public amortized +certificate, including when its allowance was assembled recursively. -/ +theorem ProfileFundedCodeRun.runCertificate + {ctx : Ctx} {code : Code} {profile : SourceProfile} {fuel : Nat} + {store : Store} {value : RVal} + (hcost : ProfileFundedCodeRun ctx fuel ⟨0, .shared, false, code⟩ + ({} : Store) [] code store value profile) : + OwnershipAmortizedRunCertificate profile store := by + obtain ⟨_allowance, hrunCost, hfunded⟩ := hcost + exact hrunCost.runCertificate hfunded + +/-- Public run-certificate corollary for an actual whole-pass output. -/ +theorem lowerAllAction_main_ownershipAmortizedCertificate_sealed + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Ixon.Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} {sourceFuel targetFuel : Nat} + {sourceValue : IxIR0.Value} {profile : SourceProfile} + {targetStore : Store} {targetValue : RVal} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htargetDecls : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hextern : ExternValueContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx) + (hsource : IxIR0.DynamicCost.Eval sourceCtx sourceFuel [] main + sourceValue profile) + (htarget : runMain ctx mainCode targetFuel = + .ok (targetStore, targetValue)) : + OwnershipAmortizedRunCertificate profile targetStore := + (lowerAllAction_main_profileFundedCodeRun_sealed henv hlower + htargetDecls hrepresented hcontracts hextern hsource htarget) + |>.runCertificate + +/-- A universal run-indexed code proof closes a particular successful fresh +main execution directly into the public certificate. -/ +theorem ProfileFundedCodeCostSound.runCertificate + {ctx : Ctx} {code : Code} {profile : SourceProfile} {fuel : Nat} + {store : Store} {value : RVal} + (hsound : ProfileFundedCodeCostSound ctx ⟨0, .shared, false, code⟩ code + profile) + (hrun : runMain ctx code fuel = .ok (store, value)) : + OwnershipAmortizedRunCertificate profile store := by + simp only [runMain] at hrun + exact (hsound AllocationOrderInvariant.empty + (ValuesInBounds.nil ({} : Store)) hrun).runCertificate + +/-- Close the compiler's paired code contract against a source-profile +allowance. This is the production seam for the forthcoming lowering +induction: once emitted code is funded componentwise by its source trace, the +public run certificate follows without another evaluator proof. -/ +theorem CodeOwnershipCostSound.runCertificate + {ctx : Ctx} {code : Code} {allowance : OwnershipAllowance} + {profile : SourceProfile} {fuel : Nat} {store : Store} {value : RVal} + (hsound : CodeOwnershipCostSound ctx ⟨0, .shared, false, code⟩ code allowance) + (hfunded : OwnershipAllowanceLE allowance + (sourceProfileOwnershipAllowance profile)) + (hrun : runMain ctx code fuel = .ok (store, value)) : + OwnershipAmortizedRunCertificate profile store := by + simp only [runMain] at hrun + exact (hsound.runCost AllocationOrderInvariant.empty + (ValuesInBounds.nil ({} : Store)) hrun).runCertificate hfunded + +/-- The potential-aware compiler certificate implies the public four-counter +specification. Exact heap accounting supplies `frees ≤ allocs`; discarding +the final nonnegative potential supplies the raw RC bound. -/ +theorem OwnershipAmortizedRunCertificate.spec + {profile : SourceProfile} {ctx : Ctx} {code : Code} {fuel : Nat} + {store : Store} {value : RVal} + (hcertificate : OwnershipAmortizedRunCertificate profile store) + (hrun : runMain ctx code fuel = .ok (store, value)) : + OwnershipAmortizedSpec profile (costObservation store) := by + simp only [OwnershipAmortizedSpec, costObservation] + refine ⟨hcertificate.allocations, hcertificate.reuses, ?_, ?_⟩ + · exact Nat.le_trans + (Ix.Compiler.IxIR1.Reclamation.runMain_frees_le_allocs hrun) + hcertificate.allocations + · have hrc := hcertificate.rcPotential.rcops_of_initial_zero + (by rfl) + simpa using hrc + +theorem OwnershipAmortizedRunCertificate.withinBudget + {profile : SourceProfile} {ctx : Ctx} {code : Code} {fuel : Nat} + {store : Store} {value : RVal} + (hcertificate : OwnershipAmortizedRunCertificate profile store) + (hrun : runMain ctx code fuel = .ok (store, value)) : + WithinBudget ownershipAmortizedWeights profile + (costObservation store) := + (withinBudget_ownershipAmortized_iff _ _).2 + (hcertificate.spec hrun) + +/-- Direct public four-counter corollary of a closed paired code contract. -/ +theorem CodeOwnershipCostSound.withinBudget + {ctx : Ctx} {code : Code} {allowance : OwnershipAllowance} + {profile : SourceProfile} {fuel : Nat} {store : Store} {value : RVal} + (hsound : CodeOwnershipCostSound ctx ⟨0, .shared, false, code⟩ code allowance) + (hfunded : OwnershipAllowanceLE allowance + (sourceProfileOwnershipAllowance profile)) + (hrun : runMain ctx code fuel = .ok (store, value)) : + WithinBudget ownershipAmortizedWeights profile + (costObservation store) := + (hsound.runCertificate hfunded hrun).withinBudget hrun + +/-- Lift a source-profile/target-counter relation into the existing semantic +`CostRefinement` interface. -/ +def ProfileCostSpec (sourceCtx : IxIR0.Ctx) (source : IxIR0.Expr) + (relation : IxIR0.Value → SourceProfile → CostObservation → Prop) + (value : IxIR0.Value) (observation : CostObservation) : Prop := + ∃ profile, + IxIR0.DynamicCost.Profiled sourceCtx source value profile ∧ + relation value profile observation + +def ProfileCostRefinement (sourceCtx : IxIR0.Ctx) (targetCtx : Ctx) + (source : IxIR0.Expr) (target : Code) (funRel : Sim.FunctionRel) + (relation : IxIR0.Value → SourceProfile → CostObservation → Prop) : + Prop := + CostRefinement sourceCtx targetCtx source target funRel + (ProfileCostSpec sourceCtx source relation) + +/-- Generic lifting boundary for the retain-aware tariff. A source-profile +producer and a compiler proof of the target certificate suffice; semantic +`ValueGraph` evidence remains available to stronger certificates but is not +needed to extract the four counters. -/ +theorem ProfileCostRefinement.of_ownershipAmortizedCertificate + {sourceCtx : IxIR0.Ctx} {targetCtx : Ctx} + {source : IxIR0.Expr} {target : Code} {funRel : Sim.FunctionRel} + (hprofile : ∀ {sourceFuel sourceValue}, + IxIR0.eval sourceCtx sourceFuel [] source = .ok sourceValue → + ∃ profile, IxIR0.DynamicCost.Profiled sourceCtx source + sourceValue profile) + (hcost : ∀ {sourceValue profile targetFuel targetStore targetValue}, + IxIR0.DynamicCost.Profiled sourceCtx source sourceValue profile → + runMain targetCtx target targetFuel = + .ok (targetStore, targetValue) → + OwnershipAmortizedRunCertificate profile targetStore) : + ProfileCostRefinement sourceCtx targetCtx source target funRel + (fun _ profile observation => + WithinBudget ownershipAmortizedWeights profile observation) := by + intro sourceFuel sourceValue targetFuel targetStore targetValue + hsource htarget _hgraph + obtain ⟨profile, hprofiled⟩ := hprofile hsource + exact ⟨profile, hprofiled, + (hcost hprofiled htarget).withinBudget htarget⟩ + +/-- Production profile-sensitive cost refinement for a successful raw +whole-pass output. Source-profile completeness is kept explicit because +ordinary IxIR₀ evaluation admits a call-aware profile only under the +appropriate projection-safety hypothesis; every target cost obligation is +constructed from the lowering run itself. -/ +theorem lowerAllAction_profileCostRefinement_sealed + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Ixon.Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htargetDecls : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hextern : ExternValueContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx) + (hprofile : ∀ {sourceFuel sourceValue}, + IxIR0.eval sourceCtx sourceFuel [] main = .ok sourceValue → + ∃ profile, IxIR0.DynamicCost.Profiled sourceCtx main + sourceValue profile) : + ProfileCostRefinement sourceCtx ctx main mainCode + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + (fun _ profile observation => + WithinBudget ownershipAmortizedWeights profile observation) := by + apply ProfileCostRefinement.of_ownershipAmortizedCertificate hprofile + intro sourceValue profile targetFuel targetStore targetValue hprofiled + htarget + obtain ⟨sourceFuel, hsource⟩ := hprofiled + exact lowerAllAction_main_ownershipAmortizedCertificate_sealed + henv hlower htargetDecls hrepresented hcontracts hextern hsource htarget + +/-- The indexed, fully content-addressed production artifact preserves the +same profile-sensitive budget. Complete readdressing changes only stored +addresses, so its exact evaluator transport preserves all four public cost +counters. -/ +theorem lowerAllIndexedFullyAddressed_profileCostRefinement_sealed + {sourceCtx : IxIR0.Ctx} {funRel : Sim.FunctionRel} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Ixon.Owned} {compilerFuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : ReaddressAll.Result} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllIndexedAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedFullyAddressed decls main mainWorld compilerFuel = + .ok result) + (oracle : Ixon.Address → List RVal → Option RVal) + (htargetDecls : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ raw → + (result.preAddressCtx raw oracle).decls targetAddress = + some targetDecl) + (hrepresented : ExtraRepresented + (result.preAddressCtx raw oracle) finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) + (result.preAddressCtx raw oracle)) + (hextern : ExternValueContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (result.preAddressCtx raw oracle)) + (hprofile : ∀ {sourceFuel sourceValue}, + IxIR0.eval sourceCtx sourceFuel [] main = .ok sourceValue → + ∃ profile, IxIR0.DynamicCost.Profiled sourceCtx main + sourceValue profile) : + ProfileCostRefinement sourceCtx (result.addressedCtx oracle) main + result.main funRel + (fun _ profile observation => + WithinBudget ownershipAmortizedWeights profile observation) := by + have hlowerRaw : + (lowerAllAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState := by + simpa only [lowerAllIndexedAction_eq_lowerAllAction] using hlower + intro sourceFuel sourceValue targetFuel addressedStore targetValue + hsource htarget _hgraph + obtain ⟨profile, hprofiled⟩ := hprofile hsource + obtain ⟨profileFuel, hsourceProfile⟩ := hprofiled + have htransport := lowerAllIndexedFullyAddressed_runMain + hlower haddressed oracle targetFuel + rw [htarget] at htransport + cases hraw : runMain (result.preAddressCtx raw oracle) mainCode targetFuel + with + | error error => + rw [hraw] at htransport + cases error <;> simp at htransport + | ok output => + rcases output with ⟨rawStore, rawValue⟩ + rw [hraw] at htransport + have hresult : + (addressedStore, targetValue) = + (Readdress.Store.mapAddresses + (Readdress.Renaming.apply result.addressMap) rawStore, + rawValue) := + Except.ok.inj htransport + have hstore := congrArg Prod.fst hresult + change addressedStore = Readdress.Store.mapAddresses + (Readdress.Renaming.apply result.addressMap) rawStore at hstore + have hcertificate := + lowerAllAction_main_ownershipAmortizedCertificate_sealed + henv hlowerRaw htargetDecls hrepresented hcontracts hextern + hsourceProfile hraw + refine ⟨profile, ⟨profileFuel, hsourceProfile⟩, ?_⟩ + rw [hstore] + rw [costObservation_mapAddresses] + exact hcertificate.withinBudget hraw + +/-- Alias-free production profile refinement. The lowering contracts and +source profile are established in the literal raw declaration context, then +the certified total rebuild renaming preserves the four target counters. -/ +theorem lowerAllIndexedFullyAddressed_profileCostRefinement_exact_sealed + {sourceCtx : IxIR0.Ctx} {funRel : Sim.FunctionRel} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Ixon.Owned} {compilerFuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : ReaddressAll.Result} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllIndexedAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedFullyAddressed decls main mainWorld compilerFuel = + .ok result) + (oracle : Ixon.Address → List RVal → Option RVal) + (htargetDecls : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ raw → + (result.rebuildSourceCtx raw oracle).decls targetAddress = + some targetDecl) + (hrepresented : ExtraRepresented + (result.rebuildSourceCtx raw oracle) finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) + (result.rebuildSourceCtx raw oracle)) + (hextern : ExternValueContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (result.rebuildSourceCtx raw oracle)) + (hprofile : ∀ {sourceFuel sourceValue}, + IxIR0.eval sourceCtx sourceFuel [] main = .ok sourceValue → + ∃ profile, IxIR0.DynamicCost.Profiled sourceCtx main + sourceValue profile) : + ProfileCostRefinement sourceCtx (result.addressedCtx oracle) main + result.main funRel + (fun _ profile observation => + WithinBudget ownershipAmortizedWeights profile observation) := by + have hlowerRaw : + (lowerAllAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState := by + simpa only [lowerAllIndexedAction_eq_lowerAllAction] using hlower + intro sourceFuel sourceValue targetFuel addressedStore targetValue + hsource htarget _hgraph + obtain ⟨profile, hprofiled⟩ := hprofile hsource + obtain ⟨profileFuel, hsourceProfile⟩ := hprofiled + have htransport := lowerAllIndexedFullyAddressed_runMain_exact + hlower haddressed oracle targetFuel + rw [htarget] at htransport + cases hraw : runMain (result.rebuildSourceCtx raw oracle) mainCode targetFuel + with + | error error => + rw [hraw] at htransport + cases error <;> simp at htransport + | ok output => + rcases output with ⟨rawStore, rawValue⟩ + rw [hraw] at htransport + have hresult : + (addressedStore, targetValue) = + (Readdress.Store.mapAddresses (result.rebuildRename raw) rawStore, + rawValue) := + Except.ok.inj htransport + have hstore := congrArg Prod.fst hresult + change addressedStore = + Readdress.Store.mapAddresses (result.rebuildRename raw) rawStore at hstore + have hcertificate := + lowerAllAction_main_ownershipAmortizedCertificate_sealed + henv hlowerRaw htargetDecls hrepresented hcontracts hextern + hsourceProfile hraw + refine ⟨profile, ⟨profileFuel, hsourceProfile⟩, ?_⟩ + rw [hstore] + rw [costObservation_mapAddresses] + exact hcertificate.withinBudget hraw + +/-- One exact profiled source trace and one exact target run establish a +profile-sensitive refinement for every successful source and target fuel. +Determinism transports both results; evaluator fuel never enters the budget. +-/ +theorem ProfileCostRefinement.of_witness + {sourceCtx : IxIR0.Ctx} {targetCtx : Ctx} + {source : IxIR0.Expr} {target : Code} {funRel : Sim.FunctionRel} + {relation : IxIR0.Value → SourceProfile → CostObservation → Prop} + {sourceFuel : Nat} {sourceValue : IxIR0.Value} + {profile : SourceProfile} {targetFuel : Nat} + {targetStore : Store} {targetValue : RVal} + (hsource : IxIR0.DynamicCost.Eval sourceCtx sourceFuel [] source + sourceValue profile) + (htarget : runMain targetCtx target targetFuel = + .ok (targetStore, targetValue)) + (hrelation : relation sourceValue profile + (costObservation targetStore)) : + ProfileCostRefinement sourceCtx targetCtx source target funRel + relation := by + intro otherSourceFuel otherSourceValue otherTargetFuel otherTargetStore + otherTargetValue hotherSource hotherTarget _hgraph + have hsourceValue : otherSourceValue = sourceValue := + sourceEval_ok_unique hotherSource hsource.run + subst otherSourceValue + have htargetResult : + (otherTargetStore, otherTargetValue) = (targetStore, targetValue) := + runMain_success_unique hotherTarget htarget + cases htargetResult + exact ⟨profile, ⟨sourceFuel, hsource⟩, hrelation⟩ + +end Ix.Compiler.IxIR1.CostTrace diff --git a/Ix/Compiler/IxIR1/Decode.lean b/Ix/Compiler/IxIR1/Decode.lean new file mode 100644 index 000000000..2ae001a8d --- /dev/null +++ b/Ix/Compiler/IxIR1/Decode.lean @@ -0,0 +1,441 @@ +import Ix.Compiler.IxIR0.Decode +import Ix.Compiler.IxIR1.Serialize + +/-! +# Strict IxIR₁ declaration decoding + +The public reader consumes a complete versioned declaration preimage and +accepts only bytes reproduced exactly by the canonical encoder. Recursive +code bodies are input-fueled; case alternatives reuse the strictly smaller +fuel supplied to their enclosing `case` node. +-/ + +namespace Ix.Compiler.IxIR1 + +open Ix.Compiler.Ixon +open Ix.Compiler.IxIR +open Ix.Compiler.IxIR.Decode + +def getAtomTag : UInt8 → GetM Atom + | 0 => do return .var (← Decode.getNat) + | 1 => do return .lit (← IxIR0.getLiteral) + | 2 => pure .erased + | tag => throw s!"IxIR1 atom: invalid tag {tag}" + +def getAtom : GetM Atom := do + getAtomTag (← getU8) + +def getCtorId : GetM CtorId := do + return ⟨← Decode.getAddress, ← Decode.getNat, ← Decode.getNat⟩ + +def getOpTag : UInt8 → GetM Op + | 0 => do return .pure (← getAtom) + | 1 => do + let world ← IxIR0.getOwned + let cid ← getCtorId + return .alloc world cid (← Decode.getArray getAtom) + | 2 => do + let target ← getAtom + let cid ← getCtorId + return .reuse target cid (← Decode.getArray getAtom) + | 3 => do return .free (← getAtom) + | 4 => do return .dup (← getAtom) + | 5 => do return .drop (← getAtom) + | 6 => do return .dropU (← getAtom) + | 7 => do return .fetch (← getAtom) (← Decode.getNat) + | 8 => do + return .call (← Decode.getAddress) (← Decode.getArray getAtom) + | 9 => do return .callSelf (← Decode.getArray getAtom) + | 10 => do + return .papp (← Decode.getAddress) (← Decode.getArray getAtom) + | 11 => do return .apply (← getAtom) (← Decode.getArray getAtom) + | 12 => do + return .extern (← Decode.getAddress) (← Decode.getArray getAtom) + | tag => throw s!"IxIR1 operation: invalid tag {tag}" + +def getOp : GetM Op := do + getOpTag (← getU8) + +def getAlt (recur : GetM Code) : GetM Alt := do + return .mk (← Decode.getNat) (← Decode.getNat) (← recur) + +def getCodeTag (recur : GetM Code) : UInt8 → GetM Code + | 0 => do return .ret (← getAtom) + | 1 => do return .letOp (← getOp) (← recur) + | 2 => do + let scrut ← getAtom + let peelNat ← Decode.getBool + return .case scrut peelNat (← Decode.getArray (getAlt recur)) + | tag => throw s!"IxIR1 code: invalid tag {tag}" + +def getCodeFuel : Nat → GetM Code + | 0 => throw "IxIR1 code: recursion limit" + | fuel + 1 => do + getCodeTag (getCodeFuel fuel) (← getU8) + +def getCode : GetM Code := do + let state ← get + getCodeFuel (state.bytes.size + 1) + +def getFnDef : GetM FnDef := do + return ⟨← Decode.getNat, ← IxIR0.getOwned, ← Decode.getBool, + ← getCode⟩ + +def getDeclTag : UInt8 → GetM Decl + | 0 => do return .fn (← getFnDef) + | 1 => do return .extern (← Decode.getNat) + | tag => throw s!"IxIR1 declaration: invalid tag {tag}" + +def getDeclPayload : GetM Decl := do + getDeclTag (← getU8) + +def getDeclPreimage : GetM Decl := do + Decode.expectBytes Decl.addressDomain + getDeclPayload + +/-- Decode one complete canonical IxIR₁ declaration preimage. -/ +def Decl.decodePreimage (bytes : ByteArray) : Except String Decl := + Decode.runCanonical getDeclPreimage Decl.preimage bytes + +/-! ## Nonrecursive cursor-relative specifications -/ + +theorem getAtom_spec : ∀ atom : Atom, GetSpec getAtom atom.bytes atom + | .var index => by + have hpayload := Decode.getSpecMap (Decode.getNat_spec index) Atom.var + have htotal := GetSpec.bind (next := getAtomTag) + (Decode.getU8_tag_spec 0) hpayload + simpa only [getAtom, Atom.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .lit literal => by + have hpayload := Decode.getSpecMap + (IxIR0.getLiteral_spec literal) Atom.lit + have htotal := GetSpec.bind (next := getAtomTag) + (Decode.getU8_tag_spec 1) hpayload + simpa only [getAtom, Atom.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .erased => by + have hpayload : GetSpec (getAtomTag 2) ByteArray.empty Atom.erased := + GetSpec.pure Atom.erased + have htotal := GetSpec.bind (next := getAtomTag) + (Decode.getU8_tag_spec 2) hpayload + simpa only [getAtom, Atom.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + +theorem getCtorId_spec (cid : CtorId) : + GetSpec getCtorId cid.bytes cid := by + have hspec := Decode.getSpecMap3 (Decode.getAddress_spec cid.block) + (Decode.getNat_spec cid.indIdx) (Decode.getNat_spec cid.cidx) CtorId.mk + simpa [getCtorId, CtorId.bytes] using hspec + +private theorem getAtomArray_spec (atoms : Array Atom) : + GetSpec (Decode.getArray getAtom) (Encoding.array Atom.bytes atoms) atoms := + Decode.getArray_spec getAtom Atom.bytes getAtom_spec atoms + +theorem getOp_spec : ∀ operation : Op, GetSpec getOp operation.bytes operation + | .pure atom => by + have hpayload := Decode.getSpecMap (getAtom_spec atom) Op.pure + have htotal := GetSpec.bind (next := getOpTag) + (Decode.getU8_tag_spec 0) hpayload + simpa only [getOp, Op.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .alloc world cid args => by + have hpayload := Decode.getSpecMap3 (IxIR0.getOwned_spec world) + (getCtorId_spec cid) (getAtomArray_spec args) Op.alloc + have htotal := GetSpec.bind (next := getOpTag) + (Decode.getU8_tag_spec 1) hpayload + simpa only [getOp, Op.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .reuse target cid args => by + have hpayload := Decode.getSpecMap3 (getAtom_spec target) + (getCtorId_spec cid) (getAtomArray_spec args) Op.reuse + have htotal := GetSpec.bind (next := getOpTag) + (Decode.getU8_tag_spec 2) hpayload + simpa only [getOp, Op.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .free target => by + have hpayload := Decode.getSpecMap (getAtom_spec target) Op.free + have htotal := GetSpec.bind (next := getOpTag) + (Decode.getU8_tag_spec 3) hpayload + simpa only [getOp, Op.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .dup target => by + have hpayload := Decode.getSpecMap (getAtom_spec target) Op.dup + have htotal := GetSpec.bind (next := getOpTag) + (Decode.getU8_tag_spec 4) hpayload + simpa only [getOp, Op.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .drop target => by + have hpayload := Decode.getSpecMap (getAtom_spec target) Op.drop + have htotal := GetSpec.bind (next := getOpTag) + (Decode.getU8_tag_spec 5) hpayload + simpa only [getOp, Op.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .dropU target => by + have hpayload := Decode.getSpecMap (getAtom_spec target) Op.dropU + have htotal := GetSpec.bind (next := getOpTag) + (Decode.getU8_tag_spec 6) hpayload + simpa only [getOp, Op.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .fetch target field => by + have hpayload := Decode.getSpecMap2 (getAtom_spec target) + (Decode.getNat_spec field) Op.fetch + have htotal := GetSpec.bind (next := getOpTag) + (Decode.getU8_tag_spec 7) hpayload + simpa only [getOp, Op.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .call function args => by + have hpayload := Decode.getSpecMap2 (Decode.getAddress_spec function) + (getAtomArray_spec args) Op.call + have htotal := GetSpec.bind (next := getOpTag) + (Decode.getU8_tag_spec 8) hpayload + simpa only [getOp, Op.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .callSelf args => by + have hpayload := Decode.getSpecMap (getAtomArray_spec args) Op.callSelf + have htotal := GetSpec.bind (next := getOpTag) + (Decode.getU8_tag_spec 9) hpayload + simpa only [getOp, Op.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .papp function args => by + have hpayload := Decode.getSpecMap2 (Decode.getAddress_spec function) + (getAtomArray_spec args) Op.papp + have htotal := GetSpec.bind (next := getOpTag) + (Decode.getU8_tag_spec 10) hpayload + simpa only [getOp, Op.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .apply function args => by + have hpayload := Decode.getSpecMap2 (getAtom_spec function) + (getAtomArray_spec args) Op.apply + have htotal := GetSpec.bind (next := getOpTag) + (Decode.getU8_tag_spec 11) hpayload + simpa only [getOp, Op.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .extern function args => by + have hpayload := Decode.getSpecMap2 (Decode.getAddress_spec function) + (getAtomArray_spec args) Op.extern + have htotal := GetSpec.bind (next := getOpTag) + (Decode.getU8_tag_spec 12) hpayload + simpa only [getOp, Op.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + +theorem AltList.bytes_eq_listBytes (alternatives : List Alt) : + AltList.bytes alternatives = Decode.listBytes Alt.bytes alternatives := by + induction alternatives with + | nil => rfl + | cons head tail ih => simp [AltList.bytes, Decode.listBytes, ih] + +theorem AltList.member_size_le {alternative : Alt} {alternatives : List Alt} + (hmember : alternative ∈ alternatives) : + alternative.bytes.size ≤ (AltList.bytes alternatives).size := by + induction alternatives with + | nil => simp at hmember + | cons head tail ih => + simp only [List.mem_cons] at hmember + simp only [AltList.bytes, ByteArray.size_append] + rcases hmember with rfl | hmember + · omega + · have htail := ih hmember + omega + +theorem Alt.body_size_lt_bytes (cidx fields : Nat) (body : Code) : + body.bytes.size < (Alt.mk cidx fields body).bytes.size := by + simp only [Alt.bytes, ByteArray.size_append] + have hcidx := Decode.nat_size_pos cidx + have hfields := Decode.nat_size_pos fields + omega + +/-- Structural induction for code that exposes hypotheses for every case body +stored beneath an alternative array. -/ +theorem Code.nested_induction (property : Code → Prop) + (hret : ∀ atom, property (.ret atom)) + (hlet : ∀ operation rest, property rest → + property (.letOp operation rest)) + (hcase : ∀ scrut peelNat alternatives, + (∀ cidx fields body, + Alt.mk cidx fields body ∈ alternatives.toList → property body) → + property (.case scrut peelNat alternatives)) + (code : Code) : property code := by + apply Code.rec + (motive_1 := fun _ => True) + (motive_2 := fun alternative => match alternative with + | .mk _ _ body => property body) + (motive_3 := property) + (motive_4 := fun alternatives => ∀ cidx fields body, + Alt.mk cidx fields body ∈ alternatives.toList → property body) + (motive_5 := fun alternatives => ∀ cidx fields body, + Alt.mk cidx fields body ∈ alternatives → property body) + (pure := by intros; trivial) + (alloc := by intros; trivial) + (reuse := by intros; trivial) + (free := by intros; trivial) + (dup := by intros; trivial) + (drop := by intros; trivial) + (dropU := by intros; trivial) + (fetch := by intros; trivial) + (call := by intros; trivial) + (callSelf := by intros; trivial) + (papp := by intros; trivial) + (apply := by intros; trivial) + (extern := by intros; trivial) + (mk := by intro cidx fields body hbody; exact hbody) + (ret := hret) + (letOp := by + intro operation rest _ hrest + exact hlet operation rest hrest) + (case := hcase) + (by intro alternatives halternatives; exact halternatives) + (by simp) + (by + intro head tail hhead htail cidx fields body hmember + simp only [List.mem_cons] at hmember + rcases hmember with hheadEq | htailMem + · cases hheadEq + exact hhead + · exact htail cidx fields body htailMem) + +/-! ## Input-fueled recursive code specification -/ + +theorem getCodeFuel_spec (code : Code) (fuel : Nat) + (hfuel : code.bytes.size < fuel) : + GetSpec (getCodeFuel fuel) code.bytes code := by + apply Code.nested_induction + (property := fun code => ∀ fuel, code.bytes.size < fuel → + GetSpec (getCodeFuel fuel) code.bytes code) + (code := code) + · intro atom fuel hfuel + cases fuel with + | zero => omega + | succ fuel => + have hpayload := Decode.getSpecMap (getAtom_spec atom) Code.ret + have htotal := GetSpec.bind + (next := getCodeTag (getCodeFuel fuel)) + (Decode.getU8_tag_spec 0) hpayload + simpa only [getCodeFuel, Code.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + · intro operation rest hrest fuel hfuel + cases fuel with + | zero => omega + | succ fuel => + have hrestFuel : rest.bytes.size < fuel := by + simp only [Code.bytes, ByteArray.size_append, + Decode.tag_size] at hfuel + omega + have hpayload := Decode.getSpecMap2 (getOp_spec operation) + (hrest fuel hrestFuel) Code.letOp + have htotal := GetSpec.bind + (next := getCodeTag (getCodeFuel fuel)) + (Decode.getU8_tag_spec 1) hpayload + simpa only [getCodeFuel, Code.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + · intro scrut peelNat alternatives hchildren fuel hfuel + cases fuel with + | zero => omega + | succ fuel => + let admissible : Alt → Prop := fun alternative => + alternative ∈ alternatives.toList ∧ + match alternative with + | .mk _ _ body => body.bytes.size < fuel + have hadmissible : ∀ alternative ∈ alternatives.toList, + admissible alternative := by + intro alternative hmember + cases alternative with + | mk cidx fields body => + refine ⟨hmember, ?_⟩ + have hbody := Alt.body_size_lt_bytes cidx fields body + have halternative := AltList.member_size_le hmember + simp only [Code.bytes, ByteArray.size_append, + Decode.tag_size] at hfuel + omega + have hone : ∀ alternative, admissible alternative → + GetSpec (getAlt (getCodeFuel fuel)) + alternative.bytes alternative := by + intro alternative halternative + rcases halternative with ⟨hmember, hbodyFuel⟩ + cases alternative with + | mk cidx fields body => + have hspec := Decode.getSpecMap3 + (Decode.getNat_spec cidx) (Decode.getNat_spec fields) + (hchildren cidx fields body hmember fuel hbodyFuel) Alt.mk + simpa [getAlt, Alt.bytes] using hspec + have harray := Decode.getArray_spec_of + (getAlt (getCodeFuel fuel)) Alt.bytes admissible hone + alternatives hadmissible + rw [Decode.array_eq_counted, + ← AltList.bytes_eq_listBytes alternatives.toList] at harray + have hpayload := Decode.getSpecMap3 (getAtom_spec scrut) + (Decode.getBool_spec peelNat) harray Code.case + have htotal := GetSpec.bind + (next := getCodeTag (getCodeFuel fuel)) + (Decode.getU8_tag_spec 2) hpayload + simpa only [getCodeFuel, Code.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + · exact hfuel + +theorem getCode_spec (code : Code) : + GetSpec getCode code.bytes code := by + intro pre suffix + let fuel := (pre ++ code.bytes ++ suffix).size + 1 + have hfuel : code.bytes.size < fuel := by + dsimp [fuel] + simp only [ByteArray.size_append] + omega + have hspec := getCodeFuel_spec code fuel hfuel pre suffix + simpa [getCode, fuel] using hspec + +theorem getFnDef_spec (definition : FnDef) : + GetSpec getFnDef definition.bytes definition := by + have hspec := Decode.getSpecMap4 (Decode.getNat_spec definition.arity) + (IxIR0.getOwned_spec definition.result) + (Decode.getBool_spec definition.papSafe) (getCode_spec definition.body) + FnDef.mk + simpa [getFnDef, FnDef.bytes] using hspec + +theorem getDeclPayload_spec : ∀ declaration : Decl, + GetSpec getDeclPayload declaration.payloadBytes declaration + | .fn definition => by + have hpayload := Decode.getSpecMap (getFnDef_spec definition) Decl.fn + have htotal := GetSpec.bind (next := getDeclTag) + (Decode.getU8_tag_spec 0) hpayload + simpa only [getDeclPayload, Decl.payloadBytes, + ByteArray.append_assoc, ByteArray.append_empty] using htotal + | .extern arity => by + have hpayload := Decode.getSpecMap (Decode.getNat_spec arity) Decl.extern + have htotal := GetSpec.bind (next := getDeclTag) + (Decode.getU8_tag_spec 1) hpayload + simpa only [getDeclPayload, Decl.payloadBytes, + ByteArray.append_assoc, ByteArray.append_empty] using htotal + +theorem getDeclPreimage_spec (declaration : Decl) : + GetSpec getDeclPreimage declaration.preimage declaration := by + let next : Unit → GetM Decl := fun _ => getDeclPayload + have htotal := GetSpec.bind (next := next) + (Decode.expectBytes_spec Decl.addressDomain) + (getDeclPayload_spec declaration) + simpa [getDeclPreimage, Decl.preimage, next] using htotal + +/-! ## Strict top-level laws -/ + +/-- Every declaration decodes from its canonical framed preimage. -/ +theorem Decl.decodePreimage_roundtrip (declaration : Decl) : + Decl.decodePreimage declaration.preimage = .ok declaration := by + exact Decode.runCanonical_of_spec getDeclPreimage Decl.preimage declaration + (getDeclPreimage_spec declaration) + +/-- Every accepted byte string is the canonical preimage of its result. -/ +theorem Decl.decodePreimage_canonical {bytes : ByteArray} {declaration : Decl} + (hdecode : Decl.decodePreimage bytes = .ok declaration) : + declaration.preimage = bytes := by + exact Decode.runCanonical_canonical getDeclPreimage Decl.preimage hdecode + +/-- Canonical declaration preimages are injective. -/ +theorem Decl.preimage_injective : Function.Injective Decl.preimage := by + intro left right hbytes + have hok : (Except.ok left : Except String Decl) = .ok right := by + calc + .ok left = Decl.decodePreimage left.preimage := + (Decl.decodePreimage_roundtrip left).symm + _ = Decl.decodePreimage right.preimage := congrArg Decl.decodePreimage hbytes + _ = .ok right := Decl.decodePreimage_roundtrip right + exact Except.ok.inj hok + +end Ix.Compiler.IxIR1 diff --git a/Ix/Compiler/IxIR1/Eval.lean b/Ix/Compiler/IxIR1/Eval.lean new file mode 100644 index 000000000..58feab460 --- /dev/null +++ b/Ix/Compiler/IxIR1/Eval.lean @@ -0,0 +1,1295 @@ +import Ix.Compiler.IxIR1.Basic + +/-! +# The IxIR₁ store semantics + +Fueled big-step interpreter in the house style, now state-passing: a +`Store` of nodes threads through everything. Two jobs at once: + +1. **Semantic anchor**: the specification `reuse_sound` and both + IxIR₀ → IxIR₁ lowerings (no-RC and RC-fallback) are proved + against. Fuel is the usual totality device. +2. **Dynamic discipline checker**: the mode rules are enforced at + runtime — `dup`/`drop` demand a live *shared* node, `reuse`/`free` + a live *unique* one, every access demands liveness — with + violations reported as `Err.mem`, distinct from ordinary + stuckness. Well-moded lowered code never trips them; that + unstuckness claim is the future static well-formedness theorem. + +The store also counts: allocations, in-place reuses, frees (explicit +and refcount-zero), and RC operations. Cost attaches to IxIR₁ +instructions (gate A), and the counters make memory-behavior claims +checkable — see `Examples.lean` for "reversing a unique list +allocates nothing" as a `#guard`. + +Conventions: `pap` nodes are allocated shared (function values are +freely copyable; `dup`/`drop` manage them, `reuse`/`free` reject +them). Deep drop expects shared children under shared nodes +(whole-value modes — gate B); a unique child under a shared node is a +memory error. Scalars (`lit`, `◻`) are inert everywhere. + +Ownership calling convention (what the lowering's RC insertion is +built against): every heap-bearing argument position **consumes** one +ownership of its value — `alloc`/`reuse` fields, `call`/`callSelf`/ +`papp` arguments, `ret`, and `pure` all take their operands' references +with them. The v1 `extern` ABI is scalar-only in both directions, so no +heap ownership crosses it; locations are rejected before or after the +oracle call. `apply` consumes its function value *and* its +arguments: `applyGo` first dups the pap's stored arguments (they gain +a new owner — the successor pap or the callee) and then drops the +applied pap itself, so under/over-fill chains reclaim intermediate +paps without caller-side bookkeeping. The borrowing exceptions are +`fetch` (project without consuming — dup the field to own it) and +`case` scrutiny; `dup`/`drop` are the explicit ownership adjustments +in the shared world, `free` (shallow) and `dropU` (deep, the affine +death compilation) the reclamations in the unique one. +-/ + +namespace Ix.Compiler.IxIR1 + +open Ix.Compiler.Ixon (Address Owned) +open Ix.Compiler.IxIR0 (Literal) + +/-- Runtime values: scalars or locations. -/ +inductive RVal where + | loc (l : Nat) + | lit (l : Literal) + | erased + deriving BEq, Repr, Inhabited + +/-- The v1 extern ABI admits no heap ownership: literals and `◻` cross +the boundary, locations do not. -/ +def RVal.isScalar : RVal → Bool + | .loc _ => false + | .lit _ | .erased => true + +inductive Node where + | ctorN (cid : CtorId) (fields : Array RVal) + | papN (f : Address) (arity : Nat) (args : Array RVal) + deriving BEq, Repr, Inhabited + +structure NodeBox where + world : Owned + rc : Nat + node : Node + deriving Repr + +structure Store where + nodes : Array (Option NodeBox) := #[] + allocs : Nat := 0 + reuses : Nat := 0 + frees : Nat := 0 + rcops : Nat := 0 + deriving Repr + +def Store.allocNode (s : Store) (world : Owned) (n : Node) : Store × Nat := + ({ s with nodes := s.nodes.push (some ⟨world, 1, n⟩) + allocs := s.allocs + 1 }, + s.nodes.size) + +def Store.get? (s : Store) (l : Nat) : Option NodeBox := + (s.nodes[l]?).bind id + +def Store.setBox (s : Store) (l : Nat) (b : NodeBox) : Store := + { s with nodes := s.nodes.set! l (some b) } + +def Store.kill (s : Store) (l : Nat) : Store := + { s with nodes := s.nodes.set! l none, frees := s.frees + 1 } + +def Store.rcTick (s : Store) : Store := { s with rcops := s.rcops + 1 } + +/-- Number of live nodes — `0` at the end of a run is leak-freedom. -/ +def Store.live (s : Store) : Nat := + s.nodes.foldl (fun n b => if b.isSome then n + 1 else n) 0 + +inductive Err where + | fuel + | stuck (msg : String) + /-- A memory-discipline violation: the dynamic mode checker fired. -/ + | mem (msg : String) + | unknownRef (adr : Address) + deriving BEq, Repr + +structure Ctx where + decls : Env + oracle : Address → List RVal → Option RVal := fun _ _ => none + +/-- Invoke the v1 scalar-only oracle. Rejecting locations on both sides makes +the ownership convention explicit: no heap root is silently consumed or +created by an extern call. -/ +def callScalarOracle (ctx : Ctx) (f : Address) (args : List RVal) : + Except Err RVal := + if !args.all RVal.isScalar then + .error (.mem "extern heap arguments require an ownership policy") + else + match ctx.oracle f args with + | none => .error (.unknownRef f) + | some v => + if v.isScalar then .ok v + else .error (.mem "extern heap results require an ownership policy") + +def resolveAtom (env : List RVal) : Atom → Except Err RVal + | .var i => + match env[i]? with + | some v => .ok v + | none => .error (.stuck s!"unbound variable {i}") + | .lit l => .ok (.lit l) + | .erased => .ok .erased + +def resolveAtoms (env : List RVal) (as' : Array Atom) : + Except Err (List RVal) := + as'.foldlM (fun acc a => do pure (acc ++ [← resolveAtom env a])) [] + +private theorem List.resolveAtomsFrom_length (environment : List RVal) : + ∀ (atoms : List Atom) (accumulator output : List RVal), + atoms.foldlM + (fun values atom => do + pure (values ++ [← resolveAtom environment atom])) + accumulator = .ok output → + output.length = accumulator.length + atoms.length := by + intro atoms + induction atoms with + | nil => + intro accumulator output run + simp only [List.foldlM_nil] at run + cases run + simp + | cons atom atoms ih => + intro accumulator output run + simp only [List.foldlM_cons] at run + cases resolved : resolveAtom environment atom with + | error error => + rw [resolved] at run + simp only [bind, Except.bind] at run + contradiction + | ok value => + rw [resolved] at run + simp only [bind, Except.bind] at run + have tail := ih (accumulator ++ [value]) output run + simp only [List.length_append, List.length_singleton] at tail + simp only [List.length_cons] + omega + +/-- Successful simultaneous operand resolution preserves vector length. -/ +theorem resolveAtoms_length {environment : List RVal} + {atoms : Array Atom} {values : List RVal} + (run : resolveAtoms environment atoms = .ok values) : + values.length = atoms.size := by + unfold resolveAtoms at run + rw [← Array.foldlM_toList] at run + have length := + List.resolveAtomsFrom_length environment atoms.toList [] values run + simpa using length + +def Alt.cidx : Alt → Nat + | .mk c _ _ => c + +/-- Add one owner to each value: the internal half of `applyGo`'s +convention (the pap's stored arguments gain the successor pap or the +callee as a new owner). Mirrors `Op.dup`: shared and live demanded, +scalars inert. -/ +def dupVals (store : Store) (vs : List RVal) : Except Err Store := + vs.foldlM (init := store) fun store v => + match v with + | .loc l => + match store.get? l with + | none => .error (.mem s!"dup of a dead location {l}") + | some box => + match box.world with + | .unique => .error (.mem "dup of a unique node") + | .shared => + .ok ((store.setBox l { box with rc := box.rc + 1 }).rcTick) + | _ => .ok store + +def declArity : Decl → Nat + | .fn d => d.arity + | .extern ar => ar + +/-- Dynamic PAP entry is valid for compiler functions explicitly marked safe +and for scalar-only externs. Saturated direct calls do not consult this bit. -/ +def declPapSafe : Decl → Bool + | .fn d => d.papSafe + | .extern _ => true + +/-- Executable result-world check. Scalars are ownership-polymorphic; +a returned location must be live in the function's declared world. -/ +def RVal.hasWorld (store : Store) (world : Owned) : RVal → Bool + | .loc l => + match store.get? l with + | some box => box.world == world + | none => false + | .lit _ | .erased => true + +/-- Enforce a function declaration's result ownership at its dynamic +boundary. This catches malformed hand-written IxIR₁ even though lowered +programs establish the same fact statically. -/ +def checkResultWorld (world : Owned) (out : Store × RVal) : + Except Err (Store × RVal) := + if out.2.hasWorld out.1 world then .ok out + else .error (.mem "function result ownership mismatch") + +mutual + +def runCode (ctx : Ctx) (fuel : Nat) (cur : FnDef) (store : Store) + (env : List RVal) (c : Code) : Except Err (Store × RVal) := + match fuel with + | 0 => .error .fuel + | fuel + 1 => + match c with + | .ret a => do + let v ← resolveAtom env a + .ok (store, v) + | .letOp op rest => do + let (store', v) ← runOp ctx fuel cur store env op + runCode ctx fuel cur store' (v :: env) rest + | .case scrut peelNat alts => do + match ← resolveAtom env scrut with + | .loc l => + match store.get? l with + | none => .error (.mem s!"case on a dead location {l}") + | some box => + match box.node with + | .ctorN cid fields => + match alts.find? (fun alt => alt.cidx == cid.cidx) with + | none => .error (.stuck s!"no case alternative for tag {cid.cidx}") + | some (.mk _ nf body) => + if fields.size != nf then + .error (.stuck "case field-count mismatch") + else + runCode ctx fuel cur store + (fields.foldl (fun e f => f :: e) env) body + | .papN .. => .error (.stuck "case on a pap node") + | .lit (.nat n) => + if peelNat then + match n with + | 0 => + match alts.find? (fun alt => alt.cidx == 0) with + | some (.mk _ 0 body) => runCode ctx fuel cur store env body + | _ => .error (.stuck "nat-peel: missing nullary 0-alternative") + | n + 1 => + match alts.find? (fun alt => alt.cidx == 1) with + | some (.mk _ 1 body) => + runCode ctx fuel cur store (.lit (.nat n) :: env) body + | _ => .error (.stuck "nat-peel: missing unary 1-alternative") + else .error (.stuck "case on a literal (peelNat disabled)") + | _ => .error (.stuck "case on a non-node value") + termination_by fuel + +def runOp (ctx : Ctx) (fuel : Nat) (cur : FnDef) (store : Store) + (env : List RVal) (op : Op) : Except Err (Store × RVal) := + match fuel with + | 0 => .error .fuel + | fuel + 1 => + match op with + | .pure a => do + let v ← resolveAtom env a + .ok (store, v) + | .alloc world cid args => do + let vs ← resolveAtoms env args + let (store', l) := store.allocNode world (.ctorN cid vs.toArray) + .ok (store', .loc l) + | .reuse target cid args => do + let vs ← resolveAtoms env args + match ← resolveAtom env target with + | .loc l => + match store.get? l with + | none => .error (.mem s!"reuse of a dead location {l}") + | some box => + match box.world with + | .shared => .error (.mem "reuse of a shared node") + | .unique => + let store' := store.setBox l ⟨.unique, 1, .ctorN cid vs.toArray⟩ + .ok ({ store' with reuses := store'.reuses + 1 }, .loc l) + | _ => .error (.mem "reuse of a non-location") + | .free target => do + match ← resolveAtom env target with + | .loc l => + match store.get? l with + | none => .error (.mem s!"free of a dead location {l}") + | some box => + match box.world with + | .shared => .error (.mem "free of a shared node") + | .unique => .ok (store.kill l, .erased) + | _ => .error (.mem "free of a non-location") + | .dup target => do + match ← resolveAtom env target with + | .loc l => + match store.get? l with + | none => .error (.mem s!"dup of a dead location {l}") + | some box => + match box.world with + | .unique => .error (.mem "dup of a unique node") + | .shared => + .ok ((store.setBox l { box with rc := box.rc + 1 }).rcTick, + .loc l) + | v => .ok (store, v) + | .drop target => do + match ← resolveAtom env target with + | v@(.loc _) => do + let store' ← dropVal ctx fuel store v + .ok (store', .erased) + | _ => .ok (store, .erased) + | .dropU target => do + match ← resolveAtom env target with + | v@(.loc _) => do + let store' ← dropUVal ctx fuel store v + .ok (store', .erased) + | _ => .ok (store, .erased) + | .fetch target i => do + match ← resolveAtom env target with + | .loc l => + match store.get? l with + | none => .error (.mem s!"fetch from a dead location {l}") + | some box => + match box.node with + | .ctorN _ fields => + match fields[i]? with + | some v => .ok (store, v) + | none => .error (.stuck s!"fetch field {i} out of range") + | .papN .. => .error (.stuck "fetch from a pap node") + | _ => .error (.stuck "fetch from a non-location") + | .call f args => do + let vs ← resolveAtoms env args + invoke ctx fuel f vs store + | .callSelf args => do + let vs ← resolveAtoms env args + if vs.length != cur.arity then + .error (.stuck "callSelf arity mismatch") + else do + let out ← runCode ctx fuel cur store vs.reverse cur.body + checkResultWorld cur.result out + | .papp f args => do + let vs ← resolveAtoms env args + match ctx.decls f with + | none => .error (.unknownRef f) + | some d => + if vs.length < declArity d then + let (store', l) := + store.allocNode .shared (.papN f (declArity d) vs.toArray) + .ok (store', .loc l) + else .error (.stuck "papp with saturating arguments (use call)") + | .apply f args => do + let fv ← resolveAtom env f + let vs ← resolveAtoms env args + applyGo ctx fuel store fv vs + | .extern f args => do + let vs ← resolveAtoms env args + let v ← callScalarOracle ctx f vs + .ok (store, v) + termination_by fuel + +/-- Enter a known declaration with saturated arguments. -/ +def invoke (ctx : Ctx) (fuel : Nat) (f : Address) (args : List RVal) + (store : Store) : Except Err (Store × RVal) := + match fuel with + | 0 => .error .fuel + | fuel + 1 => + match ctx.decls f with + | none => .error (.unknownRef f) + | some (.fn d) => + if args.length != d.arity then + .error (.stuck "call arity mismatch") + else do + let out ← runCode ctx fuel d store args.reverse d.body + checkResultWorld d.result out + | some (.extern ar) => + if args.length != ar then + .error (.stuck "extern arity mismatch") + else + match callScalarOracle ctx f args with + | .ok v => .ok (store, v) + | .error e => .error e + termination_by fuel + +/-- The apply chain: under-fill builds a new pap, saturation calls, +over-fill calls then applies the rest to the result. Consuming: the +stored arguments are dup'd (their new owner is the successor pap or +the callee) and the applied pap itself is dropped, so chains reclaim +their intermediates. -/ +def applyGo (ctx : Ctx) (fuel : Nat) (store : Store) (fv : RVal) + (args : List RVal) : Except Err (Store × RVal) := + match fuel with + | 0 => .error .fuel + | fuel + 1 => + match fv with + | .loc l => + match store.get? l with + | none => .error (.mem s!"apply of a dead location {l}") + | some box => + match box.node with + | .papN f ar got => do + let store ← dupVals store got.toList + let store ← dropVal ctx fuel store (.loc l) + let total := got.toList ++ args + if total.length < ar then + let (store', l') := + store.allocNode .shared (.papN f ar total.toArray) + .ok (store', .loc l') + else if total.length == ar then + match ctx.decls f with + | none => .error (.unknownRef f) + | some declaration => + if declPapSafe declaration then + invoke ctx fuel f total store + else + .error (.stuck + "shared pap targets a non-pap-safe declaration") + else do + match ctx.decls f with + | none => .error (.unknownRef f) + | some declaration => + if declPapSafe declaration then + let (store', r) ← invoke ctx fuel f (total.take ar) store + applyGo ctx fuel store' r (total.drop ar) + else + .error (.stuck + "shared pap targets a non-pap-safe declaration") + | .ctorN .. => .error (.stuck "apply of a constructor node") + | .erased => do + let store ← dropMany ctx fuel store args + .ok (store, .erased) + | .lit _ => .error (.stuck "apply of a non-node value") + termination_by fuel + +/-- Perceus-style deep drop of a shared value: decrement, and at zero +free the node and drop its children. -/ +def dropVal (ctx : Ctx) (fuel : Nat) (store : Store) (v : RVal) : + Except Err Store := + match fuel with + | 0 => .error .fuel + | fuel + 1 => + match v with + | .lit _ => .ok store + | .erased => .ok store + | .loc l => + match store.get? l with + | none => .error (.mem s!"drop of a dead location {l}") + | some box => + match box.world with + | .unique => .error (.mem "drop of a unique node") + | .shared => + let store := store.rcTick + if box.rc == 1 then + let store := store.kill l + match box.node with + | .ctorN _ fields => dropMany ctx fuel store fields.toList + | .papN _ _ args => dropMany ctx fuel store args.toList + else + .ok (store.setBox l { box with rc := box.rc - 1 }) + termination_by fuel + +def dropMany (ctx : Ctx) (fuel : Nat) (store : Store) (vs : List RVal) : + Except Err Store := + match fuel with + | 0 => .error .fuel + | fuel + 1 => + match vs with + | [] => .ok store + | v :: rest => do + let store' ← dropVal ctx fuel store v + dropMany ctx fuel store' rest + termination_by fuel + +/-- Deep-free of a unique tree: kill the node, recurse into fields. +Whole-value modes are enforced (a shared child under a unique node is +a memory error, symmetric to deep drop's unique-under-shared); no +refcounts are touched. Pap nodes are always shared, so a unique pap +is corrupt by construction and faults. -/ +def dropUVal (ctx : Ctx) (fuel : Nat) (store : Store) (v : RVal) : + Except Err Store := + match fuel with + | 0 => .error .fuel + | fuel + 1 => + match v with + | .lit _ => .ok store + | .erased => .ok store + | .loc l => + match store.get? l with + | none => .error (.mem s!"dropU of a dead location {l}") + | some box => + match box.world with + | .shared => .error (.mem "dropU of a shared node") + | .unique => + match box.node with + | .ctorN _ fields => dropManyU ctx fuel (store.kill l) fields.toList + | .papN .. => .error (.mem "dropU of a pap node") + termination_by fuel + +def dropManyU (ctx : Ctx) (fuel : Nat) (store : Store) (vs : List RVal) : + Except Err Store := + match fuel with + | 0 => .error .fuel + | fuel + 1 => + match vs with + | [] => .ok store + | v :: rest => do + let store' ← dropUVal ctx fuel store v + dropManyU ctx fuel store' rest + termination_by fuel + +end + +/-- A successful source return exposes the resolved value and confirms that +the store is unchanged. This is the terminal inversion rule used by later +small-step simulations. -/ +theorem runCode_ret_success {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {atom : Atom} + {output : Store × RVal} + (run : runCode ctx (fuel + 1) cur store env (.ret atom) = .ok output) : + ∃ value, + resolveAtom env atom = .ok value ∧ output = (store, value) := by + rw [runCode.eq_def] at run + dsimp only at run + cases resolved : resolveAtom env atom with + | error error => + rw [resolved] at run + simp only [bind, Except.bind] at run + contradiction + | ok value => + rw [resolved] at run + simp only [bind, Except.bind] at run + exact ⟨value, rfl, (Except.ok.inj run).symm⟩ + +/-- A successful source `letOp` splits at the exact evaluator boundary: +first the operation succeeds, then the continuation succeeds at the same +smaller fuel. -/ +theorem runCode_letOp_success {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {operation : Op} {rest : Code} + {output : Store × RVal} + (run : runCode ctx (fuel + 1) cur store env (.letOp operation rest) = + .ok output) : + ∃ middle value, + runOp ctx fuel cur store env operation = .ok (middle, value) ∧ + runCode ctx fuel cur middle (value :: env) rest = .ok output := by + rw [runCode.eq_def] at run + dsimp only at run + cases operationRun : runOp ctx fuel cur store env operation with + | error error => + rw [operationRun] at run + simp only [bind, Except.bind] at run + contradiction + | ok operationOutput => + obtain ⟨middle, value⟩ := operationOutput + rw [operationRun] at run + simp only [bind, Except.bind] at run + exact ⟨middle, value, rfl, run⟩ + +/-- A successful `pure` operation is exactly atom resolution and cannot +change the store. -/ +theorem runOp_pure_success {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {atom : Atom} + {output : Store × RVal} + (run : runOp ctx (fuel + 1) cur store env (.pure atom) = .ok output) : + ∃ value, + resolveAtom env atom = .ok value ∧ output = (store, value) := by + rw [runOp.eq_def] at run + dsimp only at run + cases resolved : resolveAtom env atom with + | error error => + rw [resolved] at run + simp only [bind, Except.bind] at run + contradiction + | ok value => + rw [resolved] at run + simp only [bind, Except.bind] at run + exact ⟨value, rfl, (Except.ok.inj run).symm⟩ + +/-- A successful ordinary allocation exposes its resolved field vector and +the exact fresh-node result chosen by the source store. -/ +theorem runOp_alloc_success {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {world : Owned} {cid : CtorId} + {arguments : Array Atom} {output : Store × RVal} + (run : runOp ctx (fuel + 1) cur store env + (.alloc world cid arguments) = .ok output) : + ∃ values, + resolveAtoms env arguments = .ok values ∧ + output = + ((store.allocNode world (.ctorN cid values.toArray)).1, + .loc (store.allocNode world (.ctorN cid values.toArray)).2) := by + rw [runOp.eq_def] at run + dsimp only at run + cases resolved : resolveAtoms env arguments with + | error error => + rw [resolved] at run + simp only [bind, Except.bind] at run + contradiction + | ok values => + rw [resolved] at run + simp only [bind, Except.bind] at run + exact ⟨values, rfl, (Except.ok.inj run).symm⟩ + +/-- A successful in-place reuse exposes all three dynamic checks and the +exact rewritten unique node selected by the source store. -/ +theorem runOp_reuse_success {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {target : Atom} {cid : CtorId} + {arguments : Array Atom} {output : Store × RVal} + (run : runOp ctx (fuel + 1) cur store env + (.reuse target cid arguments) = .ok output) : + ∃ values location box, + resolveAtoms env arguments = .ok values ∧ + resolveAtom env target = .ok (.loc location) ∧ + store.get? location = some box ∧ + box.world = .unique ∧ + output = + ({ store.setBox location + ⟨.unique, 1, .ctorN cid values.toArray⟩ with + reuses := + (store.setBox location + ⟨.unique, 1, .ctorN cid values.toArray⟩).reuses + 1 }, + .loc location) := by + rw [runOp.eq_def] at run + dsimp only at run + cases argumentsResolved : resolveAtoms env arguments with + | error error => + rw [argumentsResolved] at run + simp only [bind, Except.bind] at run + contradiction + | ok values => + rw [argumentsResolved] at run + simp only [bind, Except.bind] at run + cases targetResolved : resolveAtom env target with + | error error => + rw [targetResolved] at run + contradiction + | ok value => + rw [targetResolved] at run + cases value with + | lit literal => contradiction + | erased => contradiction + | loc location => + simp only at run + cases found : store.get? location with + | none => + rw [found] at run + contradiction + | some box => + rw [found] at run + simp only at run + cases worldEq : box.world with + | shared => + rw [worldEq] at run + contradiction + | unique => + rw [worldEq] at run + exact ⟨values, location, box, rfl, rfl, found, + worldEq, (Except.ok.inj run).symm⟩ + +/-- A successful shallow free exposes the live unique box selected by its +operand and the exact killed-store result. -/ +theorem runOp_free_success {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {target : Atom} + {output : Store × RVal} + (run : runOp ctx (fuel + 1) cur store env (.free target) = .ok output) : + ∃ location box, + resolveAtom env target = .ok (.loc location) ∧ + store.get? location = some box ∧ + box.world = .unique ∧ + output = (store.kill location, .erased) := by + rw [runOp.eq_def] at run + dsimp only at run + cases resolved : resolveAtom env target with + | error error => + rw [resolved] at run + simp only [bind, Except.bind] at run + contradiction + | ok value => + rw [resolved] at run + simp only [bind, Except.bind] at run + cases value with + | lit literal => contradiction + | erased => contradiction + | loc location => + simp only at run + cases found : store.get? location with + | none => + rw [found] at run + contradiction + | some box => + rw [found] at run + simp only at run + cases worldEq : box.world with + | shared => + rw [worldEq] at run + contradiction + | unique => + rw [worldEq] at run + exact ⟨location, box, rfl, found, worldEq, + (Except.ok.inj run).symm⟩ + +/-- A successful projection exposes the selected live constructor node and +the exact field returned without changing the store. -/ +theorem runOp_fetch_success {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {target : Atom} {field : Nat} + {output : Store × RVal} + (run : runOp ctx (fuel + 1) cur store env (.fetch target field) = + .ok output) : + ∃ location box identity fields value, + resolveAtom env target = .ok (.loc location) ∧ + store.get? location = some box ∧ + box.node = .ctorN identity fields ∧ + fields[field]? = some value ∧ + output = (store, value) := by + rw [runOp.eq_def] at run + dsimp only at run + cases resolved : resolveAtom env target with + | error error => + rw [resolved] at run + simp only [bind, Except.bind] at run + contradiction + | ok resolvedValue => + rw [resolved] at run + simp only [bind, Except.bind] at run + cases resolvedValue with + | lit literal => contradiction + | erased => contradiction + | loc location => + simp only at run + cases found : store.get? location with + | none => + rw [found] at run + contradiction + | some box => + rw [found] at run + simp only at run + cases nodeEq : box.node with + | papN function supplied => + rw [nodeEq] at run + contradiction + | ctorN identity fields => + rw [nodeEq] at run + simp only at run + cases fieldEq : fields[field]? with + | none => + rw [fieldEq] at run + contradiction + | some value => + rw [fieldEq] at run + exact ⟨location, box, identity, fields, value, + rfl, found, nodeEq, fieldEq, + (Except.ok.inj run).symm⟩ + +/-- A successful `dup` exposes either the live shared node whose reference +count was incremented or the inert scalar that passed through unchanged. -/ +theorem runOp_dup_success {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {target : Atom} + {output : Store × RVal} + (run : runOp ctx (fuel + 1) cur store env (.dup target) = .ok output) : + ∃ value, + resolveAtom env target = .ok value ∧ + match value with + | .loc location => + ∃ box, + store.get? location = some box ∧ + box.world = .shared ∧ + output = + ((store.setBox location { box with rc := box.rc + 1 }).rcTick, + .loc location) + | .lit _ | .erased => output = (store, value) := by + rw [runOp.eq_def] at run + dsimp only at run + cases resolved : resolveAtom env target with + | error error => + rw [resolved] at run + simp only [bind, Except.bind] at run + contradiction + | ok value => + rw [resolved] at run + simp only [bind, Except.bind] at run + cases value with + | lit literal => + exact ⟨.lit literal, rfl, (Except.ok.inj run).symm⟩ + | erased => + exact ⟨.erased, rfl, (Except.ok.inj run).symm⟩ + | loc location => + simp only at run + cases found : store.get? location with + | none => + rw [found] at run + contradiction + | some box => + rw [found] at run + simp only at run + cases worldEq : box.world with + | unique => + rw [worldEq] at run + contradiction + | shared => + rw [worldEq] at run + refine ⟨.loc location, rfl, box, found, worldEq, ?_⟩ + simpa [worldEq] using (Except.ok.inj run).symm + +/-- A successful shared drop either delegates the selected location to +`dropVal` or leaves the store unchanged for an inert scalar. -/ +theorem runOp_drop_success {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {target : Atom} + {output : Store × RVal} + (run : runOp ctx (fuel + 1) cur store env (.drop target) = .ok output) : + ∃ value, + resolveAtom env target = .ok value ∧ + match value with + | .loc location => + ∃ store', + dropVal ctx fuel store (.loc location) = .ok store' ∧ + output = (store', .erased) + | .lit _ | .erased => output = (store, .erased) := by + rw [runOp.eq_def] at run + dsimp only at run + cases resolved : resolveAtom env target with + | error error => + rw [resolved] at run + simp only [bind, Except.bind] at run + contradiction + | ok value => + rw [resolved] at run + simp only [bind, Except.bind] at run + cases value with + | lit literal => + exact ⟨.lit literal, rfl, (Except.ok.inj run).symm⟩ + | erased => + exact ⟨.erased, rfl, (Except.ok.inj run).symm⟩ + | loc location => + simp only at run + cases dropped : dropVal ctx fuel store (.loc location) with + | error error => + rw [dropped] at run + contradiction + | ok store' => + rw [dropped] at run + exact ⟨.loc location, rfl, store', dropped, + (Except.ok.inj run).symm⟩ + +/-- A successful unique drop either delegates the selected location to +`dropUVal` or leaves the store unchanged for an inert scalar. -/ +theorem runOp_dropU_success {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {target : Atom} + {output : Store × RVal} + (run : runOp ctx (fuel + 1) cur store env (.dropU target) = .ok output) : + ∃ value, + resolveAtom env target = .ok value ∧ + match value with + | .loc location => + ∃ store', + dropUVal ctx fuel store (.loc location) = .ok store' ∧ + output = (store', .erased) + | .lit _ | .erased => output = (store, .erased) := by + rw [runOp.eq_def] at run + dsimp only at run + cases resolved : resolveAtom env target with + | error error => + rw [resolved] at run + simp only [bind, Except.bind] at run + contradiction + | ok value => + rw [resolved] at run + simp only [bind, Except.bind] at run + cases value with + | lit literal => + exact ⟨.lit literal, rfl, (Except.ok.inj run).symm⟩ + | erased => + exact ⟨.erased, rfl, (Except.ok.inj run).symm⟩ + | loc location => + simp only at run + cases dropped : dropUVal ctx fuel store (.loc location) with + | error error => + rw [dropped] at run + contradiction + | ok store' => + rw [dropped] at run + exact ⟨.loc location, rfl, store', dropped, + (Except.ok.inj run).symm⟩ + +/-- A successful direct call exposes argument resolution and the exact +`invoke` boundary used by the source evaluator. -/ +theorem runOp_call_success {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {function : Address} + {arguments : Array Atom} {output : Store × RVal} + (run : runOp ctx (fuel + 1) cur store env + (.call function arguments) = .ok output) : + ∃ values, + resolveAtoms env arguments = .ok values ∧ + invoke ctx fuel function values store = .ok output := by + rw [runOp.eq_def] at run + dsimp only at run + cases resolved : resolveAtoms env arguments with + | error error => + rw [resolved] at run + simp only [bind, Except.bind] at run + contradiction + | ok values => + rw [resolved] at run + simp only [bind, Except.bind] at run + exact ⟨values, rfl, run⟩ + +/-- A successful self call exposes the exact recursive body run and its +result-world boundary check. -/ +theorem runOp_callSelf_success {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {arguments : Array Atom} + {output : Store × RVal} + (run : runOp ctx (fuel + 1) cur store env (.callSelf arguments) = + .ok output) : + ∃ values bodyOutput, + resolveAtoms env arguments = .ok values ∧ + values.length = cur.arity ∧ + runCode ctx fuel cur store values.reverse cur.body = .ok bodyOutput ∧ + checkResultWorld cur.result bodyOutput = .ok output := by + rw [runOp.eq_def] at run + dsimp only at run + cases resolved : resolveAtoms env arguments with + | error error => + rw [resolved] at run + simp only [bind, Except.bind] at run + contradiction + | ok values => + rw [resolved] at run + simp only [bind, Except.bind] at run + by_cases arity : values.length = cur.arity + · simp [arity] at run + cases bodyRun : runCode ctx fuel cur store values.reverse cur.body with + | error error => + rw [bodyRun] at run + contradiction + | ok bodyOutput => + rw [bodyRun] at run + exact ⟨values, bodyOutput, rfl, arity, bodyRun, run⟩ + · simp [arity] at run + +/-- A successful partial application exposes the retained declaration, +strict under-saturation, and the exact allocated pap node. -/ +theorem runOp_papp_success {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {function : Address} + {arguments : Array Atom} {output : Store × RVal} + (run : runOp ctx (fuel + 1) cur store env + (.papp function arguments) = .ok output) : + ∃ values declaration, + resolveAtoms env arguments = .ok values ∧ + ctx.decls function = some declaration ∧ + values.length < declArity declaration ∧ + output = + ((store.allocNode .shared + (.papN function (declArity declaration) values.toArray)).1, + .loc (store.allocNode .shared + (.papN function (declArity declaration) values.toArray)).2) := by + rw [runOp.eq_def] at run + dsimp only at run + cases resolved : resolveAtoms env arguments with + | error error => + rw [resolved] at run + simp only [bind, Except.bind] at run + contradiction + | ok values => + rw [resolved] at run + simp only [bind, Except.bind] at run + cases found : ctx.decls function with + | none => + rw [found] at run + contradiction + | some declaration => + rw [found] at run + by_cases undersaturated : values.length < declArity declaration + · simp only [undersaturated, ↓reduceIte] at run + exact ⟨values, declaration, rfl, rfl, undersaturated, + (Except.ok.inj run).symm⟩ + · simp only [undersaturated, ↓reduceIte] at run + contradiction + +/-- A successful dynamic application exposes both resolver boundaries and +the exact `applyGo` computation delegated to by `runOp`. -/ +theorem runOp_apply_success {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {function : Atom} + {arguments : Array Atom} {output : Store × RVal} + (run : runOp ctx (fuel + 1) cur store env + (.apply function arguments) = .ok output) : + ∃ functionValue values, + resolveAtom env function = .ok functionValue ∧ + resolveAtoms env arguments = .ok values ∧ + applyGo ctx fuel store functionValue values = .ok output := by + rw [runOp.eq_def] at run + dsimp only at run + cases functionResolved : resolveAtom env function with + | error error => + rw [functionResolved] at run + simp only [bind, Except.bind] at run + contradiction + | ok functionValue => + rw [functionResolved] at run + simp only [bind, Except.bind] at run + cases argumentsResolved : resolveAtoms env arguments with + | error error => + rw [argumentsResolved] at run + contradiction + | ok values => + rw [argumentsResolved] at run + exact ⟨functionValue, values, rfl, rfl, run⟩ + +/-- A successful trusted extern call exposes scalar-oracle evaluation and +confirms that the source store is unchanged. -/ +theorem runOp_extern_success {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {function : Address} + {arguments : Array Atom} {output : Store × RVal} + (run : runOp ctx (fuel + 1) cur store env + (.extern function arguments) = .ok output) : + ∃ values value, + resolveAtoms env arguments = .ok values ∧ + callScalarOracle ctx function values = .ok value ∧ + output = (store, value) := by + rw [runOp.eq_def] at run + dsimp only at run + cases argumentsResolved : resolveAtoms env arguments with + | error error => + rw [argumentsResolved] at run + simp only [bind, Except.bind] at run + contradiction + | ok values => + rw [argumentsResolved] at run + simp only [bind, Except.bind] at run + cases oracleRun : callScalarOracle ctx function values with + | error error => + rw [oracleRun] at run + contradiction + | ok value => + rw [oracleRun] at run + exact ⟨values, value, rfl, oracleRun, + (Except.ok.inj run).symm⟩ + +/-- The successful branches of a known-address source invocation, indexed by +the smaller fuel used for a function body. -/ +inductive InvokeSuccess (ctx : Ctx) (fuel : Nat) (function : Address) + (arguments : List RVal) (store : Store) (output : Store × RVal) : Prop + | fn {definition : FnDef} {bodyOutput : Store × RVal} + (declaration : ctx.decls function = some (.fn definition)) + (arity : arguments.length = definition.arity) + (bodyRun : runCode ctx fuel definition store arguments.reverse + definition.body = .ok bodyOutput) + (resultRun : checkResultWorld definition.result bodyOutput = .ok output) + | extern {arity : Nat} {value : RVal} + (declaration : ctx.decls function = some (.extern arity)) + (argumentsArity : arguments.length = arity) + (oracleRun : callScalarOracle ctx function arguments = .ok value) + (outputEq : output = (store, value)) + +/-- Every successful `invoke` has positive fuel and selects exactly one of +the function-body or scalar-extern branches above. -/ +theorem invoke_success {ctx : Ctx} {fuel : Nat} {function : Address} + {arguments : List RVal} {store : Store} {output : Store × RVal} + (run : invoke ctx fuel function arguments store = .ok output) : + ∃ bodyFuel, + fuel = bodyFuel + 1 ∧ + InvokeSuccess ctx bodyFuel function arguments store output := by + cases fuel with + | zero => + rw [invoke.eq_def] at run + contradiction + | succ bodyFuel => + rw [invoke.eq_def] at run + dsimp only at run + cases found : ctx.decls function with + | none => + rw [found] at run + contradiction + | some declaration => + rw [found] at run + cases declaration with + | fn definition => + by_cases arity : arguments.length = definition.arity + · simp [arity] at run + cases bodyRun : runCode ctx bodyFuel definition store + arguments.reverse definition.body with + | error error => + rw [bodyRun] at run + simp only [bind, Except.bind] at run + contradiction + | ok bodyOutput => + rw [bodyRun] at run + simp only [bind, Except.bind] at run + exact ⟨bodyFuel, rfl, + .fn found arity bodyRun run⟩ + · simp [arity] at run + | extern expectedArity => + by_cases arity : arguments.length = expectedArity + · simp [arity] at run + cases oracleRun : callScalarOracle ctx function arguments with + | error error => + rw [oracleRun] at run + contradiction + | ok value => + rw [oracleRun] at run + exact ⟨bodyFuel, rfl, + .extern found arity oracleRun + (Except.ok.inj run).symm⟩ + · simp [arity] at run + +/-- The three successful source-case shapes. The relation retains the exact +selected source alternative and the recursive branch run, while ruling out +all stuck scrutinee, tag, and field-arity paths. -/ +inductive RunCodeCaseSuccess (ctx : Ctx) (fuel : Nat) (cur : FnDef) + (store : Store) (env : List RVal) (scrutinee : Atom) (peelNat : Bool) + (alternatives : Array Alt) (output : Store × RVal) : Prop + | ctorBranch {location : Nat} {box : NodeBox} {cid : CtorId} + {fields : Array RVal} {fieldCount : Nat} {body : Code} + (resolved : resolveAtom env scrutinee = .ok (.loc location)) + (found : store.get? location = some box) + (node : box.node = .ctorN cid fields) + (selected : alternatives.find? (fun alternative => + alternative.cidx == cid.cidx) = + some (.mk cid.cidx fieldCount body)) + (fieldArity : fields.size = fieldCount) + (branchRun : runCode ctx fuel cur store + (fields.toList.reverse ++ env) body = .ok output) + | natZero {body : Code} + (peels : peelNat = true) + (resolved : resolveAtom env scrutinee = .ok (.lit (.nat 0))) + (selected : alternatives.find? (fun alternative => + alternative.cidx == 0) = some (.mk 0 0 body)) + (branchRun : runCode ctx fuel cur store env body = .ok output) + | natSucc {predecessor : Nat} {body : Code} + (peels : peelNat = true) + (resolved : resolveAtom env scrutinee = + .ok (.lit (.nat (predecessor + 1)))) + (selected : alternatives.find? (fun alternative => + alternative.cidx == 1) = some (.mk 1 1 body)) + (branchRun : runCode ctx fuel cur store + (.lit (.nat predecessor) :: env) body = .ok output) + +/-- A successful source `case` determines one exact recursive branch at the +same smaller fuel. -/ +theorem runCode_case_success {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {scrutinee : Atom} {peelNat : Bool} + {alternatives : Array Alt} {output : Store × RVal} + (run : runCode ctx (fuel + 1) cur store env + (.case scrutinee peelNat alternatives) = .ok output) : + RunCodeCaseSuccess ctx fuel cur store env scrutinee peelNat alternatives + output := by + rw [runCode.eq_def] at run + dsimp only at run + cases resolved : resolveAtom env scrutinee with + | error error => + rw [resolved] at run + simp only [bind, Except.bind] at run + contradiction + | ok value => + rw [resolved] at run + simp only [bind, Except.bind] at run + cases value with + | erased => contradiction + | loc location => + simp only at run + cases found : store.get? location with + | none => + rw [found] at run + contradiction + | some box => + rw [found] at run + simp only at run + cases nodeEq : box.node with + | papN function arity captured => + rw [nodeEq] at run + contradiction + | ctorN cid fields => + rw [nodeEq] at run + simp only at run + cases selected : alternatives.find? (fun alternative => + alternative.cidx == cid.cidx) with + | none => + rw [selected] at run + contradiction + | some alternative => + rw [selected] at run + cases alternative with + | mk tag fieldCount body => + simp only at run + by_cases fieldArity : fields.size = fieldCount + · simp [fieldArity] at run + have matched : + ((.mk tag fieldCount body : Alt).cidx == + cid.cidx) = true := + Array.find?_some + (p := fun alternative : Alt => + alternative.cidx == cid.cidx) + (a := .mk tag fieldCount body) + (xs := alternatives) selected + have tagEq : tag = cid.cidx := + beq_iff_eq.mp matched + subst tag + exact .ctorBranch resolved found nodeEq selected + fieldArity run + · simp [fieldArity] at run + | lit literal => + cases literal with + | str string => contradiction + | nat number => + cases peelNat with + | false => contradiction + | true => + simp only at run + cases number with + | zero => + cases selected : alternatives.find? (fun alternative => + alternative.cidx == 0) with + | none => + rw [selected] at run + contradiction + | some alternative => + rw [selected] at run + cases alternative with + | mk tag fieldCount body => + cases fieldCount with + | zero => + have matched : + ((.mk tag 0 body : Alt).cidx == 0) = + true := + Array.find?_some + (p := fun alternative : Alt => + alternative.cidx == 0) + (a := .mk tag 0 body) + (xs := alternatives) selected + have tagEq : tag = 0 := + beq_iff_eq.mp matched + subst tag + exact .natZero rfl resolved selected run + | succ fieldCount => contradiction + | succ predecessor => + cases selected : alternatives.find? (fun alternative => + alternative.cidx == 1) with + | none => + rw [selected] at run + contradiction + | some alternative => + rw [selected] at run + cases alternative with + | mk tag fieldCount body => + cases fieldCount with + | zero => contradiction + | succ remaining => + cases remaining with + | zero => + have matched : + ((.mk tag 1 body : Alt).cidx == 1) = + true := + Array.find?_some + (p := fun alternative : Alt => + alternative.cidx == 1) + (a := .mk tag 1 body) + (xs := alternatives) selected + have tagEq : tag = 1 := + beq_iff_eq.mp matched + subst tag + exact .natSucc rfl resolved selected run + | succ remaining => contradiction + +/-- Run a top-level code sequence in a fresh store (the `cur` frame is +the code itself, so `callSelf` at top level re-enters it). -/ +def runMain (ctx : Ctx) (c : Code) (fuel : Nat := 100000) : + Except Err (Store × RVal) := + runCode ctx fuel ⟨0, .shared, false, c⟩ {} [] c + +/-- Run a closed top-level code sequence at its declared result world and +check that world at the public boundary. Unlike `runMain`, this form also +installs the declared world in the synthetic current function, so a +top-level `callSelf` observes the same result contract as the enclosing +entry. -/ +def runOwnedMain (ctx : Ctx) (result : Owned) (c : Code) + (fuel : Nat := 100000) : Except Err (Store × RVal) := do + let out ← runCode ctx fuel ⟨0, result, false, c⟩ {} [] c + checkResultWorld result out + +end Ix.Compiler.IxIR1 diff --git a/Ix/Compiler/IxIR1/EvalHistory.lean b/Ix/Compiler/IxIR1/EvalHistory.lean new file mode 100644 index 000000000..412abfe8d --- /dev/null +++ b/Ix/Compiler/IxIR1/EvalHistory.lean @@ -0,0 +1,371 @@ +import Ix.Compiler.IxIR1.Mono +import Ix.Compiler.IxIR1.EvalRewrite + +/-! +# Composable source execution history + +A machine proof visits a callee before it knows the callee's eventual result. +`ExecutionHistory` records enough source execution to reconstruct that result +later. Its completion implication composes across ordinary operations, case +selection, and tail calls, while keeping the result ownership check explicit. +Fuel is existential: independent prefixes and suffixes are joined by raising +their successful runs to a common bound. +-/ + +namespace Ix.Compiler.IxIR1 + +open Ix.Compiler.Ixon (Owned Address) + +/-- A source evaluator position, including its dynamic self-call frame. -/ +structure CodePoint where + current : FnDef + store : Store + environment : List RVal + code : Code + +/-- Successful completion at some finite evaluator fuel. -/ +def CodePoint.Runs (ctx : Ctx) (point : CodePoint) (out : Store × RVal) : Prop := + ∃ fuel, runCode ctx fuel point.current point.store point.environment + point.code = .ok out + +/-- A completed suffix reconstructs the earlier source computation. Result +ownership is preserved across frame replacement, including tail calls. -/ +structure ExecutionHistory (ctx : Ctx) (before after : CodePoint) : Prop where + resultWorld : before.current.result = after.current.result + complete : ∀ {out : Store × RVal}, after.Runs ctx out → + Sim.HasWorld out.1 after.current.result out.2 → before.Runs ctx out + +namespace ExecutionHistory + +theorem refl (ctx : Ctx) (point : CodePoint) : + ExecutionHistory ctx point point := ⟨rfl, fun run _ => run⟩ + +theorem trans {ctx : Ctx} {before middle after : CodePoint} + (earlier : ExecutionHistory ctx before middle) + (suffix : ExecutionHistory ctx middle after) : + ExecutionHistory ctx before after := by + refine ⟨earlier.resultWorld.trans suffix.resultWorld, ?_⟩ + intro out run world + exact earlier.complete (suffix.complete run world) + (suffix.resultWorld.symm ▸ world) + +/-- Consume one successful operation without fixing the suffix fuel. -/ +theorem stepOp {ctx : Ctx} {current : FnDef} + {store nextStore : Store} {environment : List RVal} + {operation : Op} {next : Code} {value : RVal} {fuel : Nat} + (run : runOp ctx fuel current store environment operation = + .ok (nextStore, value)) : + ExecutionHistory ctx ⟨current, store, environment, .letOp operation next⟩ + ⟨current, nextStore, value :: environment, next⟩ := by + refine ⟨rfl, ?_⟩ + rintro out ⟨suffixFuel, suffix⟩ _world + let bound := max fuel suffixFuel + have prefixRun := runOp_mono (Nat.le_max_left fuel suffixFuel) run + have suffixRun := runCode_mono (Nat.le_max_right fuel suffixFuel) suffix + exact ⟨bound + 1, by simpa [bind, Except.bind, runCode, bound, prefixRun] using suffixRun⟩ + +theorem caseCtor {ctx : Ctx} {current : FnDef} {store : Store} + {environment : List RVal} {scrutinee : Atom} {peelNat : Bool} + {alternatives : Array Alt} {location : Nat} {box : NodeBox} + {identity : CtorId} {fields : Array RVal} {tag fieldCount : Nat} + {body : Code} + (resolved : resolveAtom environment scrutinee = .ok (.loc location)) + (found : store.get? location = some box) + (node : box.node = .ctorN identity fields) + (selected : alternatives.find? (fun alt => alt.cidx == identity.cidx) = + some (.mk tag fieldCount body)) + (count : fields.size = fieldCount) : + ExecutionHistory ctx + ⟨current, store, environment, .case scrutinee peelNat alternatives⟩ + ⟨current, store, fields.foldl (fun env value => value :: env) environment, + body⟩ := by + refine ⟨rfl, ?_⟩ + rintro out ⟨fuel, run⟩ _world + exact ⟨fuel + 1, by + simpa [bind, Except.bind, runCode, resolved, found, node, selected, count] using run⟩ + +theorem caseNatZero {ctx : Ctx} {current : FnDef} {store : Store} + {environment : List RVal} {scrutinee : Atom} {alternatives : Array Alt} + {tag : Nat} {body : Code} + (resolved : resolveAtom environment scrutinee = .ok (.lit (.nat 0))) + (selected : alternatives.find? (fun alt => alt.cidx == 0) = + some (.mk tag 0 body)) : + ExecutionHistory ctx + ⟨current, store, environment, .case scrutinee true alternatives⟩ + ⟨current, store, environment, body⟩ := by + refine ⟨rfl, ?_⟩ + rintro out ⟨fuel, run⟩ _world + exact ⟨fuel + 1, by simpa [bind, Except.bind, runCode, resolved, selected] using run⟩ + +theorem caseNatSucc {ctx : Ctx} {current : FnDef} {store : Store} + {environment : List RVal} {scrutinee : Atom} {alternatives : Array Alt} + {predecessor tag : Nat} {body : Code} + (resolved : resolveAtom environment scrutinee = + .ok (.lit (.nat (predecessor + 1)))) + (selected : alternatives.find? (fun alt => alt.cidx == 1) = + some (.mk tag 1 body)) : + ExecutionHistory ctx + ⟨current, store, environment, .case scrutinee true alternatives⟩ + ⟨current, store, .lit (.nat predecessor) :: environment, body⟩ := by + refine ⟨rfl, ?_⟩ + rintro out ⟨fuel, run⟩ _world + exact ⟨fuel + 1, by simpa [bind, Except.bind, runCode, resolved, selected] using run⟩ + +end ExecutionHistory + +/-- Reassemble a function invocation from its completed body and the checked +result world. -/ +theorem invoke_of_body_run {ctx : Ctx} {address : Address} + {definition : FnDef} {store : Store} {arguments : List RVal} + {fuel : Nat} {out : Store × RVal} + (declaration : ctx.decls address = some (.fn definition)) + (arity : arguments.length = definition.arity) + (run : runCode ctx fuel definition store arguments.reverse definition.body = + .ok out) + (world : Sim.HasWorld out.1 definition.result out.2) : + invoke ctx (fuel + 1) address arguments store = .ok out := by + have checked := Sim.rval_hasWorld_eq_true_iff.mpr world + simp [bind, Except.bind, invoke, declaration, arity, run, checkResultWorld, checked] + +theorem runOp_call_of_body_run {ctx : Ctx} {current definition : FnDef} + {store : Store} {environment arguments : List RVal} {address : Address} + {atoms : Array Atom} {fuel : Nat} {out : Store × RVal} + (resolved : resolveAtoms environment atoms = .ok arguments) + (declaration : ctx.decls address = some (.fn definition)) + (arity : arguments.length = definition.arity) + (run : runCode ctx fuel definition store arguments.reverse definition.body = + .ok out) + (world : Sim.HasWorld out.1 definition.result out.2) : + runOp ctx (fuel + 2) current store environment (.call address atoms) = + .ok out := by + simpa [bind, Except.bind, runOp, resolved] using invoke_of_body_run declaration arity run world + +theorem runOp_callSelf_of_body_run {ctx : Ctx} {current : FnDef} + {store : Store} {environment arguments : List RVal} + {atoms : Array Atom} {fuel : Nat} {out : Store × RVal} + (resolved : resolveAtoms environment atoms = .ok arguments) + (arity : arguments.length = current.arity) + (run : runCode ctx fuel current store arguments.reverse current.body = + .ok out) + (world : Sim.HasWorld out.1 current.result out.2) : + runOp ctx (fuel + 1) current store environment (.callSelf atoms) = + .ok out := by + have checked := Sim.rval_hasWorld_eq_true_iff.mpr world + simp [bind, Except.bind, runOp, resolved, arity, run, checkResultWorld, checked] + +namespace ExecutionHistory + +theorem tailCall {ctx : Ctx} {current definition : FnDef} + {store : Store} {environment arguments : List RVal} {address : Address} + {atoms : Array Atom} + (resolved : resolveAtoms environment atoms = .ok arguments) + (declaration : ctx.decls address = some (.fn definition)) + (arity : arguments.length = definition.arity) + (resultWorld : current.result = definition.result) : + ExecutionHistory ctx + ⟨current, store, environment, .letOp (.call address atoms) (.ret (.var 0))⟩ + ⟨definition, store, arguments.reverse, definition.body⟩ := by + refine ⟨resultWorld, ?_⟩ + rintro out ⟨fuel, run⟩ world + have call := runOp_call_of_body_run (current := current) resolved declaration + arity run world + exact ⟨fuel + 3, by + simp [bind, Except.bind, runCode, call, resolveAtom]⟩ + +theorem tailCallSelf {ctx : Ctx} {current : FnDef} + {store : Store} {environment arguments : List RVal} {atoms : Array Atom} + (resolved : resolveAtoms environment atoms = .ok arguments) + (arity : arguments.length = current.arity) : + ExecutionHistory ctx + ⟨current, store, environment, .letOp (.callSelf atoms) (.ret (.var 0))⟩ + ⟨current, store, arguments.reverse, current.body⟩ := by + refine ⟨rfl, ?_⟩ + rintro out ⟨fuel, run⟩ world + have call := runOp_callSelf_of_body_run resolved arity run world + exact ⟨fuel + 2, by simp [bind, Except.bind, runCode, call, resolveAtom]⟩ + +end ExecutionHistory + +/-- A saturated PAP prefix and its eventual invocation can use different +fuel bounds. Retaining captures and consuming the PAP are replayed exactly. -/ +theorem applyGo_exact_of_invoke {ctx : Ctx} + {store retained released : Store} {arguments : List RVal} + {location : Nat} {box : NodeBox} + {address : Address} {arity : Nat} {captured : Array RVal} + {declaration : Decl} {releaseFuel invokeFuel : Nat} {out : Store × RVal} + (found : store.get? location = some box) + (node : box.node = .papN address arity captured) + (retain : dupVals store captured.toList = .ok retained) + (release : dropVal ctx releaseFuel retained (.loc location) = .ok released) + (exactCount : (captured.toList ++ arguments).length = arity) + (declared : ctx.decls address = some declaration) + (papSafe : declPapSafe declaration = true) + (called : invoke ctx invokeFuel address (captured.toList ++ arguments) + released = .ok out) : + ∃ fuel, applyGo ctx (fuel + 1) store (.loc location) arguments = .ok out := by + let bound := max releaseFuel invokeFuel + have releasedAtBound := dropVal_mono + (Nat.le_max_left releaseFuel invokeFuel) release + have calledAtBound := invoke_mono + (Nat.le_max_right releaseFuel invokeFuel) called + refine ⟨bound, ?_⟩ + simp [applyGo, found, node, + retain, releasedAtBound, exactCount, declared, papSafe, calledAtBound, + bound, bind, Except.bind] + +/-- Reconstruct the suspended source operation after joining the PAP prefix +with its successful application. -/ +theorem runOp_apply_exact_of_invoke {ctx : Ctx} {current : FnDef} + {store retained released : Store} {environment arguments : List RVal} + {function : Atom} {atoms : Array Atom} {location : Nat} {box : NodeBox} + {address : Address} {arity : Nat} {captured : Array RVal} + {declaration : Decl} {releaseFuel invokeFuel : Nat} {out : Store × RVal} + (functionResolved : resolveAtom environment function = .ok (.loc location)) + (argumentsResolved : resolveAtoms environment atoms = .ok arguments) + (found : store.get? location = some box) + (node : box.node = .papN address arity captured) + (retain : dupVals store captured.toList = .ok retained) + (release : dropVal ctx releaseFuel retained (.loc location) = .ok released) + (exactCount : (captured.toList ++ arguments).length = arity) + (declared : ctx.decls address = some declaration) + (papSafe : declPapSafe declaration = true) + (called : invoke ctx invokeFuel address (captured.toList ++ arguments) + released = .ok out) : + ∃ fuel, runOp ctx (fuel + 2) current store environment + (.apply function atoms) = .ok out := by + obtain ⟨fuel, applied⟩ := applyGo_exact_of_invoke + found node retain release exactCount declared papSafe called + exact ⟨fuel, by simp [runOp, functionResolved, argumentsResolved, + applied, bind, Except.bind]⟩ + +/-- An over-applied PAP prefix composes with the first callee and the whole +residual application. Repeated use handles arbitrary over-application depth. -/ +theorem applyGo_over_of_invoke {ctx : Ctx} + {store retained released : Store} {arguments : List RVal} + {location : Nat} {box : NodeBox} + {address : Address} {arity : Nat} {captured : Array RVal} + {declaration : Decl} {releaseFuel invokeFuel residualFuel : Nat} + {middle out : Store × RVal} + (found : store.get? location = some box) + (node : box.node = .papN address arity captured) + (retain : dupVals store captured.toList = .ok retained) + (release : dropVal ctx releaseFuel retained (.loc location) = .ok released) + (overCount : arity < (captured.toList ++ arguments).length) + (declared : ctx.decls address = some declaration) + (papSafe : declPapSafe declaration = true) + (called : invoke ctx invokeFuel address + ((captured.toList ++ arguments).take arity) released = .ok middle) + (residual : applyGo ctx residualFuel middle.1 middle.2 + ((captured.toList ++ arguments).drop arity) = .ok out) : + ∃ fuel, applyGo ctx (fuel + 1) store (.loc location) arguments = .ok out := by + let bound := max releaseFuel (max invokeFuel residualFuel) + have releasedAtBound := dropVal_mono + (Nat.le_max_left releaseFuel (max invokeFuel residualFuel)) release + have calledAtBound := invoke_mono (Nat.le_trans + (Nat.le_max_left invokeFuel residualFuel) + (Nat.le_max_right releaseFuel (max invokeFuel residualFuel))) called + have residualAtBound := applyGo_mono (Nat.le_trans + (Nat.le_max_right invokeFuel residualFuel) + (Nat.le_max_right releaseFuel (max invokeFuel residualFuel))) residual + have notUnder : ¬ captured.size + arguments.length < arity := by + simpa using Nat.not_lt.mpr (Nat.le_of_lt overCount) + have notExact : ¬ captured.size + arguments.length = arity := by + simpa using Nat.ne_of_gt overCount + refine ⟨bound, ?_⟩ + simp [applyGo, found, node, + retain, releasedAtBound, notUnder, notExact, declared, papSafe, + calledAtBound, residualAtBound, bound, bind, Except.bind] + +/-- Reconstruct the suspended source operation after joining the PAP prefix +with its successful application. -/ +theorem runOp_apply_over_of_invoke {ctx : Ctx} {current : FnDef} + {store retained released : Store} {environment arguments : List RVal} + {function : Atom} {atoms : Array Atom} {location : Nat} {box : NodeBox} + {address : Address} {arity : Nat} {captured : Array RVal} + {declaration : Decl} {releaseFuel invokeFuel residualFuel : Nat} + {middle out : Store × RVal} + (functionResolved : resolveAtom environment function = .ok (.loc location)) + (argumentsResolved : resolveAtoms environment atoms = .ok arguments) + (found : store.get? location = some box) + (node : box.node = .papN address arity captured) + (retain : dupVals store captured.toList = .ok retained) + (release : dropVal ctx releaseFuel retained (.loc location) = .ok released) + (overCount : arity < (captured.toList ++ arguments).length) + (declared : ctx.decls address = some declaration) + (papSafe : declPapSafe declaration = true) + (called : invoke ctx invokeFuel address + ((captured.toList ++ arguments).take arity) released = .ok middle) + (residual : applyGo ctx residualFuel middle.1 middle.2 + ((captured.toList ++ arguments).drop arity) = .ok out) : + ∃ fuel, runOp ctx (fuel + 2) current store environment + (.apply function atoms) = .ok out := by + obtain ⟨fuel, applied⟩ := applyGo_over_of_invoke + found node retain release overCount declared papSafe called residual + exact ⟨fuel, by simp [runOp, functionResolved, argumentsResolved, + applied, bind, Except.bind]⟩ + +/-- Operations which cannot call source code or the scalar oracle. PAP +allocation is included: it inspects declarations but does not enter them. -/ +def Op.isImmediate : Op → Bool + | .call .. | .callSelf .. | .apply .. | .extern .. => false + | _ => true + +/-- Immediate source steps can be recorded in the canonical compiler +context, independently of the ambient oracle. -/ +theorem runOp_immediate_ctx_eq (before after : Ctx) + (declarations : after.decls = before.decls) (fuel : Nat) + (current : FnDef) (store : Store) (environment : List RVal) + (operation : Op) (immediate : operation.isImmediate = true) : + runOp after fuel current store environment operation = + runOp before fuel current store environment operation := by + cases fuel with + | zero => simp [runOp] + | succ fuel => + cases operation <;> simp only [Op.isImmediate] at immediate + all_goals try contradiction + all_goals simp only [runOp] + all_goals try rfl + · simp only [Sim.dropVal_ctx_eq before after] + · simp only [Sim.dropUVal_ctx_eq before after] + · rw [declarations] + +/-- Erased application only consumes its arguments, so its oracle is inert. -/ +theorem runOp_apply_erased_ctx_eq (before after : Ctx) (fuel : Nat) + (current : FnDef) (store : Store) (environment : List RVal) + (function : Atom) (atoms : Array Atom) + (resolved : resolveAtom environment function = .ok .erased) : + runOp after fuel current store environment (.apply function atoms) = + runOp before fuel current store environment (.apply function atoms) := by + cases fuel with + | zero => simp [runOp] + | succ fuel => + simp only [runOp, resolved, bind, Except.bind] + cases fuel with + | zero => simp [applyGo] + | succ fuel => simp only [applyGo, Sim.dropMany_ctx_eq before after] + +/-- Under-application only rebuilds a PAP after retaining and releasing its +captures; declaration lookup and the oracle are both inert. -/ +theorem runOp_apply_under_ctx_eq (before after : Ctx) (fuel : Nat) + (current : FnDef) (store : Store) (environment : List RVal) + (function : Atom) (atoms : Array Atom) + {location : Nat} {box : NodeBox} {address : Address} {arity : Nat} + {captured : Array RVal} {arguments : List RVal} + (functionResolved : resolveAtom environment function = .ok (.loc location)) + (argumentsResolved : resolveAtoms environment atoms = .ok arguments) + (found : store.get? location = some box) + (node : box.node = .papN address arity captured) + (under : (captured.toList ++ arguments).length < arity) : + runOp after fuel current store environment (.apply function atoms) = + runOp before fuel current store environment (.apply function atoms) := by + cases fuel with + | zero => simp [runOp] + | succ fuel => + simp only [runOp, functionResolved, argumentsResolved, bind, Except.bind] + cases fuel with + | zero => simp [applyGo] + | succ fuel => + simp only [applyGo, found, node, under, if_true, + Sim.dropVal_ctx_eq before after] + +end Ix.Compiler.IxIR1 diff --git a/Ix/Compiler/IxIR1/EvalIso.lean b/Ix/Compiler/IxIR1/EvalIso.lean new file mode 100644 index 000000000..0e08edb68 --- /dev/null +++ b/Ix/Compiler/IxIR1/EvalIso.lean @@ -0,0 +1,2692 @@ +import Ix.Compiler.IxIR1.Mono +import Ix.Compiler.IxIR1.Reclamation +import Ix.Compiler.IxIR1.Sim + +/-! +# IxIR₁ evaluation modulo allocation history + +Shrinking heap optimizations deliberately change cost counters, leave +different dead holes, and consequently assign different numeric locations to +later allocations. Literal equality of `Store × RVal` is therefore too +strong for those passes. + +`HeapHistoryIso` is the evaluator-facing relation for that boundary. It is a +finite partial bijection which covers every live location, may retain pairs of +dead locations, and may omit unmatched dead holes. Corresponding live boxes +agree in world, reference count, node identity, and recursively in their +children. Cost counters are intentionally absent. + +Retaining dead/dead pairs is important: recursive destruction may kill a +parent before traversing its saved children, and stale environment slots may +still name a consumed value even though well-moded code never uses it again. +The relation can preserve those historical names without pretending that a +dead slot is live. +-/ + +namespace Ix.Compiler.IxIR1.Sim + +open Ix.Compiler.Ixon (Owned) + +/-- A location relation covering all live nodes and optionally remembering +dead/dead location pairs. Every related location is an already allocated +slot, which makes extension by fresh allocations unambiguous. -/ +structure HeapHistoryIso (left right : Store) where + locRel : Nat → Nat → Prop + left_unique : ∀ {l r₁ r₂}, locRel l r₁ → locRel l r₂ → r₁ = r₂ + right_unique : ∀ {l₁ l₂ r}, locRel l₁ r → locRel l₂ r → l₁ = l₂ + left_bound : ∀ {l r}, locRel l r → l < left.nodes.size + right_bound : ∀ {l r}, locRel l r → r < right.nodes.size + left_total : ∀ {loc box}, left.get? loc = some box → + ∃ rightLoc, locRel loc rightLoc + right_total : ∀ {loc box}, right.get? loc = some box → + ∃ leftLoc, locRel leftLoc loc + related : ∀ {leftLoc rightLoc}, locRel leftLoc rightLoc → + (left.get? leftLoc = none ∧ right.get? rightLoc = none) ∨ + ∃ leftBox rightBox, + left.get? leftLoc = some leftBox ∧ + right.get? rightLoc = some rightBox ∧ + NodeBoxIso locRel leftBox rightBox + +namespace HeapHistoryIso + +/-- Canonical self-history: every already allocated slot is paired with +itself, including dead slots. Closure supplies the corresponding relation +for children of live nodes. -/ +def refl (store : Store) (closed : StoreClosed store) : + HeapHistoryIso store store where + locRel := fun left right => left = right ∧ left < store.nodes.size + left_unique := by + intro left right₁ right₂ h₁ h₂ + exact h₁.1.symm.trans h₂.1 + right_unique := by + intro left₁ left₂ right h₁ h₂ + exact h₁.1.trans h₂.1.symm + left_bound := fun h => h.2 + right_bound := by + intro left right h + simpa [h.1] using h.2 + left_total := by + intro location box hget + have hbound : location < store.nodes.size := by + unfold Store.get? at hget + rw [Option.bind_eq_some_iff] at hget + obtain ⟨slot, hslot, _⟩ := hget + exact (Array.getElem?_eq_some_iff.mp hslot).1 + exact ⟨location, rfl, hbound⟩ + right_total := by + intro location box hget + have hbound : location < store.nodes.size := by + unfold Store.get? at hget + rw [Option.bind_eq_some_iff] at hget + obtain ⟨slot, hslot, _⟩ := hget + exact (Array.getElem?_eq_some_iff.mp hslot).1 + exact ⟨location, rfl, hbound⟩ + related := by + intro left right hrel + obtain ⟨rfl, hbound⟩ := hrel + cases hget : store.get? left with + | none => exact .inl ⟨rfl, rfl⟩ + | some box => + let live := HeapIso.refl store closed + have hlive : live.locRel left left := by + exact ⟨rfl, box, hget⟩ + obtain ⟨leftBox, rightBox, hleft, hright, hbox⟩ := + live.related_live hlive + have hleftBox : leftBox = box := Option.some.inj (hleft.symm.trans hget) + have hrightBox : rightBox = box := + Option.some.inj (hright.symm.trans hget) + subst leftBox + subst rightBox + refine .inr ⟨box, box, rfl, rfl, hbox.mono ?_⟩ + intro childLeft childRight hchild + obtain ⟨heq, childBox, hchildGet⟩ := hchild + subst childRight + have hchildBound : childLeft < store.nodes.size := by + unfold Store.get? at hchildGet + rw [Option.bind_eq_some_iff] at hchildGet + obtain ⟨slot, hslot, _⟩ := hchildGet + exact (Array.getElem?_eq_some_iff.mp hslot).1 + exact ⟨rfl, hchildBound⟩ + +private theorem get?_setBox_eq {store : Store} {loc other : Nat} + {old new : NodeBox} (hget : store.get? loc = some old) : + (store.setBox loc new).get? other = + if other = loc then some new else store.get? other := by + have hlt : loc < store.nodes.size := by + exact (Array.getElem?_eq_some_iff.mp (nodes_get?_of_get? hget)).1 + by_cases hsame : other = loc + · subst other + simp [Store.setBox, Store.get?, Array.set!_eq_setIfInBounds, hlt] + · have hne : loc ≠ other := Ne.symm hsame + simp [Store.setBox, Store.get?, Array.set!_eq_setIfInBounds, + Array.getElem?_setIfInBounds, hlt, hne, hsame] + +private theorem get?_setBox_eq_of_bound {store : Store} {loc other : Nat} + {new : NodeBox} (hlt : loc < store.nodes.size) : + (store.setBox loc new).get? other = + if other = loc then some new else store.get? other := by + by_cases hsame : other = loc + · subst other + simp [Store.setBox, Store.get?, Array.set!_eq_setIfInBounds, hlt] + · have hne : loc ≠ other := Ne.symm hsame + simp [Store.setBox, Store.get?, Array.set!_eq_setIfInBounds, + Array.getElem?_setIfInBounds, hlt, hne, hsame] + +private theorem get?_kill_eq {store : Store} {loc other : Nat} + {box : NodeBox} (hget : store.get? loc = some box) : + (store.kill loc).get? other = + if other = loc then none else store.get? other := by + have hlt : loc < store.nodes.size := by + exact (Array.getElem?_eq_some_iff.mp (nodes_get?_of_get? hget)).1 + by_cases hsame : other = loc + · subst other + simp [Store.kill, Store.get?, Array.set!_eq_setIfInBounds, hlt] + · have hne : loc ≠ other := Ne.symm hsame + simp [Store.kill, Store.get?, Array.set!_eq_setIfInBounds, + Array.getElem?_setIfInBounds, hlt, hne, hsame] + +private theorem get?_allocNode_eq (store : Store) (world : Owned) + (node : Node) (loc : Nat) : + (store.allocNode world node).1.get? loc = + if loc = store.nodes.size then some ⟨world, 1, node⟩ + else store.get? loc := by + by_cases hsame : loc = store.nodes.size + · subst loc + simp [Store.allocNode, Store.get?] + · simp [Store.allocNode, Store.get?, Array.getElem?_push, hsame] + +/-- Corresponding live boxes can be recovered from a related live location. -/ +theorem boxes {left right : Store} (iso : HeapHistoryIso left right) + {leftLoc rightLoc : Nat} (hrel : iso.locRel leftLoc rightLoc) + {leftBox : NodeBox} (hleft : left.get? leftLoc = some leftBox) : + ∃ rightBox, + right.get? rightLoc = some rightBox ∧ + NodeBoxIso iso.locRel leftBox rightBox := by + rcases iso.related hrel with hdead | hlive + · exact False.elim (Option.some_ne_none leftBox (hleft.symm.trans hdead.1)) + · obtain ⟨foundLeft, rightBox, hfound, hright, hbox⟩ := hlive + have : foundLeft = leftBox := Option.some.inj (hfound.symm.trans hleft) + subst foundLeft + exact ⟨rightBox, hright, hbox⟩ + +private def liveRel {left right : Store} + (iso : HeapHistoryIso left right) (leftLoc rightLoc : Nat) : Prop := + iso.locRel leftLoc rightLoc ∧ + ∃ leftBox, left.get? leftLoc = some leftBox + +private theorem RValsIso.liveMono {left right : Store} + (iso : HeapHistoryIso left right) : + ∀ {leftValues rightValues : List RVal}, + RValsIso iso.locRel leftValues rightValues → + (∀ value ∈ leftValues, LiveRVal left value) → + RValsIso (liveRel iso) leftValues rightValues + | _, _, .nil, _ => .nil + | _, _, .cons head tail, live => by + refine .cons ?_ (RValsIso.liveMono iso tail fun value member => + live value (by simp [member])) + cases head with + | @loc leftLoc rightLoc related => + exact .loc ⟨related, live (.loc leftLoc) (by simp)⟩ + | lit => exact .lit + | erased => exact .erased + +private theorem NodeIso.liveMono {left right : Store} + (iso : HeapHistoryIso left right) : + ∀ {leftNode rightNode : Node}, + NodeIso iso.locRel leftNode rightNode → + (∀ value ∈ nodeChildren leftNode, LiveRVal left value) → + NodeIso (liveRel iso) leftNode rightNode + | _, _, .ctor fields, live => + .ctor (RValsIso.liveMono iso fields fun value member => + live value (by simpa [nodeChildren] using member)) + | _, _, .pap arguments, live => + .pap (RValsIso.liveMono iso arguments fun value member => + live value (by simpa [nodeChildren] using member)) + +private theorem NodeBoxIso.liveMono {left right : Store} + (iso : HeapHistoryIso left right) (closed : StoreClosed left) + {leftLoc : Nat} {leftBox rightBox : NodeBox} + (leftAt : left.get? leftLoc = some leftBox) + (boxes : NodeBoxIso iso.locRel leftBox rightBox) : + NodeBoxIso (liveRel iso) leftBox rightBox := + ⟨boxes.world, boxes.rc, + NodeIso.liveMono iso boxes.node (closed leftAt)⟩ + +/-- Forget historical dead/dead rows, retaining the exact bijection on live +locations. Closure ensures every child relation of a live node also belongs +to the restricted live relation. -/ +def toHeapIso {left right : Store} (iso : HeapHistoryIso left right) + (closed : StoreClosed left) : HeapIso left right where + locRel := liveRel iso + left_unique := fun first second => iso.left_unique first.1 second.1 + right_unique := fun first second => iso.right_unique first.1 second.1 + left_total := by + intro leftLoc leftBox leftAt + obtain ⟨rightLoc, related⟩ := iso.left_total leftAt + exact ⟨rightLoc, related, leftBox, leftAt⟩ + right_total := by + intro rightLoc rightBox rightAt + obtain ⟨leftLoc, related⟩ := iso.right_total rightAt + rcases iso.related related with dead | live + · exact False.elim + (Option.some_ne_none rightBox (rightAt.symm.trans dead.2)) + · obtain ⟨leftBox, _foundRight, leftAt, _foundRightAt, _boxes⟩ := live + exact ⟨leftLoc, related, leftBox, leftAt⟩ + related_live := by + intro leftLoc rightLoc related + obtain ⟨historyRelated, leftBox, leftAt⟩ := related + obtain ⟨rightBox, rightAt, boxes⟩ := iso.boxes historyRelated leftAt + exact ⟨leftBox, rightBox, leftAt, rightAt, + NodeBoxIso.liveMono iso closed leftAt boxes⟩ + +/-- A live historical pair is retained by `toHeapIso`. -/ +theorem toHeapIso_rel {left right : Store} + (iso : HeapHistoryIso left right) (closed : StoreClosed left) + {leftLoc rightLoc : Nat} (related : iso.locRel leftLoc rightLoc) + {leftBox : NodeBox} (leftAt : left.get? leftLoc = some leftBox) : + (iso.toHeapIso closed).locRel leftLoc rightLoc := + ⟨related, leftBox, leftAt⟩ + +/-- Restricting a history relation does not invent location pairs. -/ +theorem of_toHeapIso_rel {left right : Store} + (iso : HeapHistoryIso left right) (closed : StoreClosed left) + {leftLoc rightLoc : Nat} + (related : (iso.toHeapIso closed).locRel leftLoc rightLoc) : + iso.locRel leftLoc rightLoc := + related.1 + +/-- The symmetric evaluator relation. -/ +def symm {left right : Store} (iso : HeapHistoryIso left right) : + HeapHistoryIso right left where + locRel := fun r l => iso.locRel l r + left_unique := iso.right_unique + right_unique := iso.left_unique + left_bound := iso.right_bound + right_bound := iso.left_bound + left_total := iso.right_total + right_total := iso.left_total + related := by + intro rightLoc leftLoc hrel + rcases iso.related hrel with ⟨hl, hr⟩ | hlive + · exact .inl ⟨hr, hl⟩ + · obtain ⟨leftBox, rightBox, hl, hr, hbox⟩ := hlive + exact .inr ⟨rightBox, leftBox, hr, hl, hbox.symm⟩ + +/-- A heap-history isomorphism cannot introduce a live node on the right when +the left heap has none. Dead historical slots may differ, so this is stated +through the public live-node observation rather than array equality. -/ +theorem right_live_eq_zero {left right : Store} + (iso : HeapHistoryIso left right) (hleft : left.live = 0) : + right.live = 0 := by + apply (Reclamation.Store.live_eq_zero_iff_no_live_slot right).2 + intro rightBox hrightMember + obtain ⟨rightLoc, hrightSlot⟩ := + (Array.mem_iff_getElem?).mp hrightMember + have hright : right.get? rightLoc = some rightBox := by + rw [Store.get?, hrightSlot] + rfl + obtain ⟨leftLoc, hrel⟩ := iso.right_total hright + rcases iso.related hrel with hdead | hlive + · exact Option.some_ne_none rightBox (hright.symm.trans hdead.2) + · obtain ⟨leftBox, foundRight, hleftGet, hrightGet, _⟩ := hlive + have hleftMember : some leftBox ∈ left.nodes := by + apply (Array.mem_iff_getElem?).2 + exact ⟨leftLoc, nodes_get?_of_get? hleftGet⟩ + exact (Reclamation.Store.live_eq_zero_iff_no_live_slot left).1 hleft + leftBox hleftMember + +/-- Symmetric empty-live transport. -/ +theorem left_live_eq_zero {left right : Store} + (iso : HeapHistoryIso left right) (hright : right.live = 0) : + left.live = 0 := + iso.symm.right_live_eq_zero hright + +/-- Composition of allocation histories. A dead/dead row composes only with +another dead/dead row; a live middle location forces both sides to expose the +same middle box, so node isomorphisms compose. -/ +def trans {left middle right : Store} + (first : HeapHistoryIso left middle) + (second : HeapHistoryIso middle right) : HeapHistoryIso left right where + locRel := fun leftLoc rightLoc => + ∃ middleLoc, first.locRel leftLoc middleLoc ∧ + second.locRel middleLoc rightLoc + left_unique := by + intro leftLoc right₁ right₂ h₁ h₂ + obtain ⟨middle₁, hleft₁, hright₁⟩ := h₁ + obtain ⟨middle₂, hleft₂, hright₂⟩ := h₂ + have hmiddle : middle₁ = middle₂ := + first.left_unique hleft₁ hleft₂ + subst middle₂ + exact second.left_unique hright₁ hright₂ + right_unique := by + intro left₁ left₂ rightLoc h₁ h₂ + obtain ⟨middle₁, hleft₁, hright₁⟩ := h₁ + obtain ⟨middle₂, hleft₂, hright₂⟩ := h₂ + have hmiddle : middle₁ = middle₂ := + second.right_unique hright₁ hright₂ + subst middle₂ + exact first.right_unique hleft₁ hleft₂ + left_bound := by + intro leftLoc rightLoc hrel + exact first.left_bound hrel.choose_spec.1 + right_bound := by + intro leftLoc rightLoc hrel + exact second.right_bound hrel.choose_spec.2 + left_total := by + intro leftLoc leftBox hleft + obtain ⟨middleLoc, hmiddleRel⟩ := first.left_total hleft + rcases first.related hmiddleRel with hdead | hlive + · exact False.elim + (Option.some_ne_none leftBox (hleft.symm.trans hdead.1)) + · obtain ⟨foundLeft, middleBox, hfoundLeft, hmiddle, _⟩ := hlive + obtain ⟨rightLoc, hrightRel⟩ := second.left_total hmiddle + exact ⟨rightLoc, middleLoc, hmiddleRel, hrightRel⟩ + right_total := by + intro rightLoc rightBox hright + obtain ⟨middleLoc, hmiddleRel⟩ := second.right_total hright + rcases second.related hmiddleRel with hdead | hlive + · exact False.elim + (Option.some_ne_none rightBox (hright.symm.trans hdead.2)) + · obtain ⟨middleBox, foundRight, hmiddle, hfoundRight, _⟩ := hlive + obtain ⟨leftLoc, hleftRel⟩ := first.right_total hmiddle + exact ⟨leftLoc, middleLoc, hleftRel, hmiddleRel⟩ + related := by + intro leftLoc rightLoc hrel + obtain ⟨middleLoc, hleftRel, hrightRel⟩ := hrel + rcases first.related hleftRel with hfirstDead | hfirstLive + · rcases second.related hrightRel with hsecondDead | hsecondLive + · exact .inl ⟨hfirstDead.1, hsecondDead.2⟩ + · obtain ⟨middleBox, rightBox, hmiddle, _, _⟩ := hsecondLive + exact False.elim + (Option.some_ne_none middleBox (hmiddle.symm.trans hfirstDead.2)) + · obtain ⟨leftBox, middleBox₁, hleft, hmiddle₁, hbox₁⟩ := + hfirstLive + rcases second.related hrightRel with hsecondDead | hsecondLive + · exact False.elim + (Option.some_ne_none middleBox₁ + (hmiddle₁.symm.trans hsecondDead.1)) + · obtain ⟨middleBox₂, rightBox, hmiddle₂, hright, hbox₂⟩ := + hsecondLive + have hmiddleBox : middleBox₁ = middleBox₂ := + Option.some.inj (hmiddle₁.symm.trans hmiddle₂) + subst middleBox₂ + exact .inr ⟨leftBox, rightBox, hleft, hright, + hbox₁.trans hbox₂⟩ + +/-- Updating corresponding live boxes preserves allocation history. -/ +def setBox {left right : Store} (iso : HeapHistoryIso left right) + {leftLoc rightLoc : Nat} (hrel : iso.locRel leftLoc rightLoc) + {oldLeft oldRight newLeft newRight : NodeBox} + (hleft : left.get? leftLoc = some oldLeft) + (hright : right.get? rightLoc = some oldRight) + (hnew : NodeBoxIso iso.locRel newLeft newRight) : + HeapHistoryIso (left.setBox leftLoc newLeft) + (right.setBox rightLoc newRight) where + locRel := iso.locRel + left_unique := iso.left_unique + right_unique := iso.right_unique + left_bound := by + intro l r hrel + simpa [Store.setBox] using iso.left_bound hrel + right_bound := by + intro l r hrel + simpa [Store.setBox] using iso.right_bound hrel + left_total := by + intro loc box hbox + rw [get?_setBox_eq hleft] at hbox + by_cases hsame : loc = leftLoc + · exact ⟨rightLoc, hsame ▸ hrel⟩ + · simp only [hsame, if_false] at hbox + exact iso.left_total hbox + right_total := by + intro loc box hbox + rw [get?_setBox_eq hright] at hbox + by_cases hsame : loc = rightLoc + · exact ⟨leftLoc, hsame ▸ hrel⟩ + · simp only [hsame, if_false] at hbox + exact iso.right_total hbox + related := by + intro l r hlr + have hlEq := get?_setBox_eq (new := newLeft) hleft (other := l) + have hrEq := get?_setBox_eq (new := newRight) hright (other := r) + by_cases hll : l = leftLoc + · have hrr : r = rightLoc := iso.left_unique hlr (hll ▸ hrel) + subst l + subst r + simp only [if_pos, hlEq, hrEq] + exact .inr ⟨newLeft, newRight, rfl, rfl, hnew⟩ + · have hrr : r ≠ rightLoc := by + intro heq + have := iso.right_unique hlr (heq ▸ hrel) + exact hll this + simp only [hll, hrr, if_false, hlEq, hrEq] + exact iso.related hlr + +/-- Reviving corresponding dead historical slots preserves allocation +history. Physical reuse credits exercise this operation: the pair remains +the same, but its observation changes from dead/dead to related live boxes. -/ +def revive {left right : Store} (iso : HeapHistoryIso left right) + {leftLoc rightLoc : Nat} (hrel : iso.locRel leftLoc rightLoc) + (hleft : left.get? leftLoc = none) + (hright : right.get? rightLoc = none) + {newLeft newRight : NodeBox} + (hnew : NodeBoxIso iso.locRel newLeft newRight) : + HeapHistoryIso (left.setBox leftLoc newLeft) + (right.setBox rightLoc newRight) where + locRel := iso.locRel + left_unique := iso.left_unique + right_unique := iso.right_unique + left_bound := by + intro l r related + simpa [Store.setBox] using iso.left_bound related + right_bound := by + intro l r related + simpa [Store.setBox] using iso.right_bound related + left_total := by + intro loc box live + rw [get?_setBox_eq_of_bound (iso.left_bound hrel)] at live + by_cases same : loc = leftLoc + · exact ⟨rightLoc, same ▸ hrel⟩ + · simp only [same, if_false] at live + exact iso.left_total live + right_total := by + intro loc box live + rw [get?_setBox_eq_of_bound (iso.right_bound hrel)] at live + by_cases same : loc = rightLoc + · exact ⟨leftLoc, same ▸ hrel⟩ + · simp only [same, if_false] at live + exact iso.right_total live + related := by + intro l r related + have leftEq := get?_setBox_eq_of_bound + (new := newLeft) (iso.left_bound hrel) (other := l) + have rightEq := get?_setBox_eq_of_bound + (new := newRight) (iso.right_bound hrel) (other := r) + by_cases leftSame : l = leftLoc + · have rightSame : r = rightLoc := + iso.left_unique related (leftSame ▸ hrel) + subst l + subst r + simp only [if_pos, leftEq, rightEq] + exact .inr ⟨newLeft, newRight, rfl, rfl, hnew⟩ + · have rightDifferent : r ≠ rightLoc := by + intro same + have := iso.right_unique related (same ▸ hrel) + exact leftSame this + simp only [leftSame, rightDifferent, if_false, leftEq, rightEq] + exact iso.related related + +/-- Killing corresponding live locations retains their historical pair as a +dead/dead row. This is the operation for which live-only heap isomorphism is +not compositional. -/ +def kill {left right : Store} (iso : HeapHistoryIso left right) + {leftLoc rightLoc : Nat} (hrel : iso.locRel leftLoc rightLoc) + {leftBox rightBox : NodeBox} + (hleft : left.get? leftLoc = some leftBox) + (hright : right.get? rightLoc = some rightBox) : + HeapHistoryIso (left.kill leftLoc) (right.kill rightLoc) where + locRel := iso.locRel + left_unique := iso.left_unique + right_unique := iso.right_unique + left_bound := by + intro l r hrel + simpa [Store.kill] using iso.left_bound hrel + right_bound := by + intro l r hrel + simpa [Store.kill] using iso.right_bound hrel + left_total := by + intro loc box hbox + rw [get?_kill_eq hleft] at hbox + by_cases hsame : loc = leftLoc + · simp [hsame] at hbox + · simp only [hsame, if_false] at hbox + exact iso.left_total hbox + right_total := by + intro loc box hbox + rw [get?_kill_eq hright] at hbox + by_cases hsame : loc = rightLoc + · simp [hsame] at hbox + · simp only [hsame, if_false] at hbox + exact iso.right_total hbox + related := by + intro l r hlr + have hlEq := get?_kill_eq hleft (other := l) + have hrEq := get?_kill_eq hright (other := r) + by_cases hll : l = leftLoc + · have hrr : r = rightLoc := iso.left_unique hlr (hll ▸ hrel) + subst l + subst r + exact .inl ⟨get?_kill_same hleft, get?_kill_same hright⟩ + · have hrr : r ≠ rightLoc := by + intro heq + have := iso.right_unique hlr (heq ▸ hrel) + exact hll this + simp only [hll, hrr, if_false, hlEq, hrEq] + exact iso.related hlr + +/-- Cost-counter ticks do not affect heap history. -/ +def rcTick {left right : Store} (iso : HeapHistoryIso left right) : + HeapHistoryIso left.rcTick right.rcTick where + locRel := iso.locRel + left_unique := iso.left_unique + right_unique := iso.right_unique + left_bound := by + intro l r hrel + simpa [Store.rcTick] using iso.left_bound hrel + right_bound := by + intro l r hrel + simpa [Store.rcTick] using iso.right_bound hrel + left_total := by + intro loc box hget + exact iso.left_total (by simpa [Store.rcTick, Store.get?] using hget) + right_total := by + intro loc box hget + exact iso.right_total (by simpa [Store.rcTick, Store.get?] using hget) + related := by + intro l r hrel + simpa [Store.rcTick, Store.get?] using iso.related hrel + +/-- Any update which leaves the node arrays unchanged is invisible to heap +history. Evaluator cost counters use this boundary. -/ +def nodesEq {left right nextLeft nextRight : Store} + (iso : HeapHistoryIso left right) + (hleft : nextLeft.nodes = left.nodes) + (hright : nextRight.nodes = right.nodes) : + HeapHistoryIso nextLeft nextRight where + locRel := iso.locRel + left_unique := iso.left_unique + right_unique := iso.right_unique + left_bound := by + intro l r hrel + simpa [hleft] using iso.left_bound hrel + right_bound := by + intro l r hrel + simpa [hright] using iso.right_bound hrel + left_total := by + intro loc box hget + apply iso.left_total + simpa [Store.get?, hleft] using hget + right_total := by + intro loc box hget + apply iso.right_total + simpa [Store.get?, hright] using hget + related := by + intro l r hrel + simpa [Store.get?, hleft, hright] using iso.related hrel + +/-- Corresponding fresh allocations extend the history bijection. -/ +def alloc {left right : Store} (iso : HeapHistoryIso left right) + {world : Owned} {leftNode rightNode : Node} + (hnode : NodeIso iso.locRel leftNode rightNode) : + HeapHistoryIso (left.allocNode world leftNode).1 + (right.allocNode world rightNode).1 := by + let leftLoc := left.nodes.size + let rightLoc := right.nodes.size + let extended : Nat → Nat → Prop := fun l r => + (l = leftLoc ∧ r = rightLoc) ∨ iso.locRel l r + have leftFresh : ∀ r, ¬ iso.locRel leftLoc r := by + intro r hrel + exact (Nat.lt_irrefl leftLoc) (iso.left_bound hrel) + have rightFresh : ∀ l, ¬ iso.locRel l rightLoc := by + intro l hrel + exact (Nat.lt_irrefl rightLoc) (iso.right_bound hrel) + refine + { locRel := extended + left_unique := ?_ + right_unique := ?_ + left_bound := ?_ + right_bound := ?_ + left_total := ?_ + right_total := ?_ + related := ?_ } + · intro l r₁ r₂ h₁ h₂ + rcases h₁ with h₁ | h₁ <;> rcases h₂ with h₂ | h₂ + · exact h₁.2.trans h₂.2.symm + · rw [h₁.1] at h₂ + exact False.elim (leftFresh r₂ h₂) + · rw [h₂.1] at h₁ + exact False.elim (leftFresh r₁ h₁) + · exact iso.left_unique h₁ h₂ + · intro l₁ l₂ r h₁ h₂ + rcases h₁ with h₁ | h₁ <;> rcases h₂ with h₂ | h₂ + · exact h₁.1.trans h₂.1.symm + · rw [h₁.2] at h₂ + exact False.elim (rightFresh l₂ h₂) + · rw [h₂.2] at h₁ + exact False.elim (rightFresh l₁ h₁) + · exact iso.right_unique h₁ h₂ + · intro l r hrel + rcases hrel with ⟨rfl, rfl⟩ | hold + · simp [leftLoc, Store.allocNode] + · exact Nat.lt_trans (iso.left_bound hold) (by simp [Store.allocNode]) + · intro l r hrel + rcases hrel with ⟨rfl, rfl⟩ | hold + · simp [rightLoc, Store.allocNode] + · exact Nat.lt_trans (iso.right_bound hold) (by simp [Store.allocNode]) + · intro loc box hbox + rw [get?_allocNode_eq] at hbox + by_cases hnew : loc = leftLoc + · exact ⟨rightLoc, .inl ⟨hnew, rfl⟩⟩ + · simp only [leftLoc, hnew, if_false] at hbox + obtain ⟨r, hr⟩ := iso.left_total hbox + exact ⟨r, .inr hr⟩ + · intro loc box hbox + rw [get?_allocNode_eq] at hbox + by_cases hnew : loc = rightLoc + · exact ⟨leftLoc, .inl ⟨rfl, hnew⟩⟩ + · simp only [rightLoc, hnew, if_false] at hbox + obtain ⟨l, hl⟩ := iso.right_total hbox + exact ⟨l, .inr hl⟩ + · intro l r hrel + rcases hrel with hnew | hold + · obtain ⟨rfl, rfl⟩ := hnew + refine .inr ⟨⟨world, 1, leftNode⟩, ⟨world, 1, rightNode⟩, + ?_, ?_, ?_⟩ + · simp [leftLoc, get?_allocNode_eq] + · simp [rightLoc, get?_allocNode_eq] + · exact ⟨rfl, rfl, hnode.mono (fun h => .inr h)⟩ + · have hleftOld := get?_allocNode_eq left world leftNode l + have hrightOld := get?_allocNode_eq right world rightNode r + have hln : l ≠ leftLoc := by + intro heq + exact leftFresh r (heq ▸ hold) + have hrn : r ≠ rightLoc := by + intro heq + exact rightFresh l (heq ▸ hold) + simp only [leftLoc, hln, if_false] at hleftOld + simp only [rightLoc, hrn, if_false] at hrightOld + rcases iso.related hold with hdead | hlive + · exact .inl ⟨hleftOld.trans hdead.1, + hrightOld.trans hdead.2⟩ + · obtain ⟨leftBox, rightBox, hl, hr, hbox⟩ := hlive + exact .inr ⟨leftBox, rightBox, hleftOld.trans hl, + hrightOld.trans hr, hbox.mono (fun h => .inr h)⟩ + +/-- The empty evaluator stores have the empty allocation history. -/ +def empty : HeapHistoryIso ({} : Store) ({} : Store) where + locRel := fun _ _ => False + left_unique h := False.elim h + right_unique h := False.elim h + left_bound h := False.elim h + right_bound h := False.elim h + left_total := by simp [Store.get?] + right_total := by simp [Store.get?] + related h := False.elim h + +/-- Allocate and immediately kill a node on the left only. The fresh dead +slot has no semantic counterpart, so the old history relation remains a +complete relation between the resulting live heaps. -/ +def omitDeadAllocLeft {left right : Store} + (iso : HeapHistoryIso left right) (world : Owned) (node : Node) : + let allocated := left.allocNode world node + HeapHistoryIso (allocated.1.kill allocated.2) right := by + let allocated := left.allocNode world node + let fresh := allocated.2 + have hfresh : allocated.1.get? fresh = some ⟨world, 1, node⟩ := by + exact HeapIso.get?_allocNode_new left world node + have hold (loc : Nat) (hne : loc ≠ fresh) : + (allocated.1.kill fresh).get? loc = left.get? loc := by + rw [get?_kill_eq hfresh] + simp only [hne, if_false] + rw [get?_allocNode_eq] + have hne' : loc ≠ left.nodes.size := by + simpa [fresh, allocated, Store.allocNode] using hne + simp [hne'] + refine + { locRel := iso.locRel + left_unique := iso.left_unique + right_unique := iso.right_unique + left_bound := ?_ + right_bound := iso.right_bound + left_total := ?_ + right_total := iso.right_total + related := ?_ } + · intro l r hrel + have hlt := iso.left_bound hrel + have hstep : l < left.nodes.size + 1 := Nat.lt_succ_of_lt hlt + simpa [allocated, Store.allocNode, Store.kill] using hstep + · intro loc box hbox + by_cases hnew : loc = fresh + · subst loc + rw [get?_kill_eq hfresh] at hbox + simp at hbox + · exact iso.left_total ((hold loc hnew).symm.trans hbox) + · intro l r hrel + have hne : l ≠ fresh := by + intro heq + have hlt := iso.left_bound hrel + subst l + exact (Nat.lt_irrefl left.nodes.size) hlt + rw [hold l hne] + exact iso.related hrel + +end HeapHistoryIso + +namespace RValsIso + +/-- An in-bounds environment is related to itself by the canonical +allocation-history relation. -/ +theorem refl_of_inBounds {store : Store} (closed : StoreClosed store) : + ∀ {values : List RVal}, + Reclamation.ValuesInBounds store values → + RValsIso (HeapHistoryIso.refl store closed).locRel values values + | [], _ => .nil + | value :: values, hbounds => by + have htail : Reclamation.ValuesInBounds store values := by + intro found hfound + exact hbounds found (by simp [hfound]) + cases value with + | loc location => + have hlocation : location < store.nodes.size := + hbounds (.loc location) (by simp) + exact .cons (.loc ⟨rfl, hlocation⟩) + (refl_of_inBounds closed htail) + | lit literal => + exact .cons .lit (refl_of_inBounds closed htail) + | erased => + exact .cons .erased (refl_of_inBounds closed htail) + +theorem mono {r₁ r₂ : Nat → Nat → Prop} + (hmono : ∀ {l r}, r₁ l r → r₂ l r) : + ∀ {left right : List RVal}, RValsIso r₁ left right → + RValsIso r₂ left right + | _, _, .nil => .nil + | _, _, .cons hhead htail => + .cons (hhead.mono hmono) (mono hmono htail) + +theorem symm {r : Nat → Nat → Prop} : + ∀ {left right : List RVal}, RValsIso r left right → + RValsIso (fun rightLoc leftLoc => r leftLoc rightLoc) right left + | _, _, .nil => .nil + | _, _, .cons hhead htail => .cons hhead.symm htail.symm + +theorem trans {r₁ r₂ : Nat → Nat → Prop} : + ∀ {left middle right : List RVal}, + RValsIso r₁ left middle → RValsIso r₂ middle right → + RValsIso (fun leftLoc rightLoc => + ∃ middleLoc, r₁ leftLoc middleLoc ∧ r₂ middleLoc rightLoc) + left right + | _, _, _, .nil, .nil => .nil + | _, _, _, .cons hleft hlefts, .cons hright hrights => + .cons (hleft.trans hright) (hlefts.trans hrights) + +@[simp] theorem lengths {r : Nat → Nat → Prop} + {left right : List RVal} (h : RValsIso r left right) : + left.length = right.length := by + induction h <;> simp_all + +theorem append {r : Nat → Nat → Prop} + {left₁ right₁ left₂ right₂ : List RVal} + (h₁ : RValsIso r left₁ right₁) + (h₂ : RValsIso r left₂ right₂) : + RValsIso r (left₁ ++ left₂) (right₁ ++ right₂) := by + induction h₁ with + | nil => exact h₂ + | cons hhead _ ih => exact .cons hhead ih + +theorem reverse {r : Nat → Nat → Prop} + {left right : List RVal} (h : RValsIso r left right) : + RValsIso r left.reverse right.reverse := by + induction h with + | nil => exact .nil + | cons hhead _ ih => + simpa only [List.reverse_cons] using + ih.append (.cons hhead .nil) + +theorem take {r : Nat → Nat → Prop} + {left right : List RVal} (h : RValsIso r left right) (count : Nat) : + RValsIso r (left.take count) (right.take count) := by + induction h generalizing count with + | nil => simpa using (RValsIso.nil (locRel := r)) + | cons hhead htail ih => + cases count with + | zero => exact .nil + | succ count => exact .cons hhead (ih count) + +theorem drop {r : Nat → Nat → Prop} + {left right : List RVal} (h : RValsIso r left right) (count : Nat) : + RValsIso r (left.drop count) (right.drop count) := by + induction h generalizing count with + | nil => simpa using (RValsIso.nil (locRel := r)) + | cons hhead htail ih => + cases count with + | zero => exact .cons hhead htail + | succ count => exact ih count + +theorem get? {r : Nat → Nat → Prop} {left right : List RVal} + (h : RValsIso r left right) {index : Nat} {value : RVal} + (hleft : left[index]? = some value) : + ∃ other, right[index]? = some other ∧ RValIso r value other := by + induction h generalizing index value with + | nil => simp at hleft + | cons hhead htail ih => + cases index with + | zero => + simp only [List.getElem?_cons_zero] at hleft ⊢ + injection hleft with heq + subst value + exact ⟨_, rfl, hhead⟩ + | succ index => + simp only [List.getElem?_cons_succ] at hleft ⊢ + exact ih hleft + +/-- Pointwise related scalar lists are literally equal; locations are the +only values whose spelling can differ. -/ +theorem eq_of_allScalar {r : Nat → Nat → Prop} + {left right : List RVal} (h : RValsIso r left right) + (hscalar : left.all RVal.isScalar = true) : left = right := by + induction h with + | nil => rfl + | @cons left right lefts rights hhead htail ih => + simp only [List.all_cons, Bool.and_eq_true] at hscalar + cases hhead with + | loc hrel => simp [RVal.isScalar] at hscalar + | lit => simp only [List.cons.injEq, true_and] + exact ih hscalar.2 + | erased => simp only [List.cons.injEq, true_and] + exact ih hscalar.2 + +end RValsIso + +namespace RValIso + +/-- A scalar is related to itself under every location relation. -/ +theorem refl_of_scalar {r : Nat → Nat → Prop} {value : RVal} + (hscalar : value.isScalar = true) : RValIso r value value := by + cases value with + | loc location => simp [RVal.isScalar] at hscalar + | lit literal => exact .lit + | erased => exact .erased + +end RValIso + +namespace HeapHistoryIso + +/-- The output history retains every location pair known on entry. -/ +def Extends {left right nextLeft nextRight : Store} + (before : HeapHistoryIso left right) + (after : HeapHistoryIso nextLeft nextRight) : Prop := + ∀ {l r}, before.locRel l r → after.locRel l r + +theorem Extends.refl {left right : Store} + {heap : HeapHistoryIso left right} : heap.Extends heap := + fun h => h + +theorem Extends.trans {left right middleLeft middleRight nextLeft nextRight : + Store} + {first : HeapHistoryIso left right} + {middle : HeapHistoryIso middleLeft middleRight} + {last : HeapHistoryIso nextLeft nextRight} + (h₁ : first.Extends middle) (h₂ : middle.Extends last) : + first.Extends last := + fun h => h₂ (h₁ h) + +theorem Extends.rval {left right nextLeft nextRight : Store} + {before : HeapHistoryIso left right} + {after : HeapHistoryIso nextLeft nextRight} + (h : before.Extends after) {leftValue rightValue : RVal} + (value : RValIso before.locRel leftValue rightValue) : + RValIso after.locRel leftValue rightValue := + value.mono h + +theorem Extends.rvals {left right nextLeft nextRight : Store} + {before : HeapHistoryIso left right} + {after : HeapHistoryIso nextLeft nextRight} + (h : before.Extends after) {leftValues rightValues : List RVal} + (values : RValsIso before.locRel leftValues rightValues) : + RValsIso after.locRel leftValues rightValues := + values.mono h + +end HeapHistoryIso + +/-- Successful evaluator results related modulo allocation history. The +extension field lets a caller keep using values from its older environment +after a callee has allocated or reclaimed nodes. -/ +def RunHistoryIso {left right : Store} + (before : HeapHistoryIso left right) + (leftOut rightOut : Store × RVal) : Prop := + ∃ heap : HeapHistoryIso leftOut.1 rightOut.1, + before.Extends heap ∧ + RValIso heap.locRel leftOut.2 rightOut.2 + +/-- Store-only counterpart used by recursive drop operations. -/ +def StoreHistoryIso {left right : Store} + (before : HeapHistoryIso left right) + (leftOut rightOut : Store) : Prop := + ∃ heap : HeapHistoryIso leftOut rightOut, before.Extends heap + +namespace StoreHistoryIso + +/-- Store-only history refinement preserves the absence of live nodes. -/ +theorem right_live_eq_zero {left right leftOut rightOut : Store} + {before : HeapHistoryIso left right} + (hstores : StoreHistoryIso before leftOut rightOut) + (hleft : leftOut.live = 0) : rightOut.live = 0 := by + obtain ⟨after, _⟩ := hstores + exact after.right_live_eq_zero hleft + +end StoreHistoryIso + +namespace RunHistoryIso + +/-- A result relation proved from a later entry history is also valid from +any earlier history whose location pairs the later history retains. -/ +theorem weaken {left right beforeLeft beforeRight : Store} + {earlier : HeapHistoryIso left right} + {before : HeapHistoryIso beforeLeft beforeRight} + {leftOut rightOut : Store × RVal} + (hextends : earlier.Extends before) + (hrun : RunHistoryIso before leftOut rightOut) : + RunHistoryIso earlier leftOut rightOut := by + obtain ⟨after, hbefore, hvalue⟩ := hrun + exact ⟨after, hextends.trans hbefore, hvalue⟩ + +/-- Sequentially related executions compose their output heaps and values. -/ +theorem trans {left middle right : Store} + {first : HeapHistoryIso left middle} + {second : HeapHistoryIso middle right} + {leftOut middleOut rightOut : Store × RVal} + (hfirst : RunHistoryIso first leftOut middleOut) + (hsecond : RunHistoryIso second middleOut rightOut) : + RunHistoryIso (first.trans second) leftOut rightOut := by + obtain ⟨firstHeap, hfirstExtends, hfirstValue⟩ := hfirst + obtain ⟨secondHeap, hsecondExtends, hsecondValue⟩ := hsecond + exact ⟨firstHeap.trans secondHeap, + (fun hrel => + ⟨hrel.choose, hfirstExtends hrel.choose_spec.1, + hsecondExtends hrel.choose_spec.2⟩), + hfirstValue.trans hsecondValue⟩ + +end RunHistoryIso + +theorem resolveAtom_historyIso + {rel : Nat → Nat → Prop} {left right : List RVal} + (henv : RValsIso rel left right) {atom : Atom} {leftValue : RVal} + (hleft : resolveAtom left atom = .ok leftValue) : + ∃ rightValue, resolveAtom right atom = .ok rightValue ∧ + RValIso rel leftValue rightValue := by + cases atom with + | var index => + simp only [resolveAtom] at hleft ⊢ + cases hget : left[index]? with + | none => simp [hget] at hleft + | some value => + simp only [hget, Except.ok.injEq] at hleft + subst value + obtain ⟨other, hother, hiso⟩ := henv.get? hget + exact ⟨other, by simp [hother], hiso⟩ + | lit literal => + simp only [resolveAtom, Except.ok.injEq] at hleft ⊢ + subst leftValue + exact ⟨.lit literal, rfl, .lit⟩ + | erased => + simp only [resolveAtom, Except.ok.injEq] at hleft ⊢ + subst leftValue + exact ⟨.erased, rfl, .erased⟩ + +private theorem List.resolveAtomsFrom_historyIso + {rel : Nat → Nat → Prop} {left right : List RVal} + (henv : RValsIso rel left right) : + ∀ (atoms : List Atom) + (leftAcc rightAcc leftOut : List RVal), + RValsIso rel leftAcc rightAcc → + atoms.foldlM + (fun acc atom => do pure (acc ++ [← resolveAtom left atom])) + leftAcc = .ok leftOut → + ∃ rightOut, + atoms.foldlM + (fun acc atom => do pure (acc ++ [← resolveAtom right atom])) + rightAcc = .ok rightOut ∧ + RValsIso rel leftOut rightOut + | [], leftAcc, rightAcc, leftOut, hacc, hleft => by + change (Except.ok leftAcc : Except Err (List RVal)) = .ok leftOut at hleft + injection hleft with heq + subst leftOut + change ∃ rightOut, + (Except.ok rightAcc : Except Err (List RVal)) = .ok rightOut ∧ + RValsIso rel leftAcc rightOut + exact ⟨rightAcc, rfl, hacc⟩ + | atom :: atoms, leftAcc, rightAcc, leftOut, hacc, hleft => by + simp only [List.foldlM_cons] at hleft ⊢ + cases hvalue : resolveAtom left atom with + | error error => + rw [hvalue] at hleft + simp only [bind, Except.bind] at hleft + contradiction + | ok leftValue => + simp only [hvalue, bind, Except.bind] at hleft + obtain ⟨rightValue, hrightValue, hvalueIso⟩ := + resolveAtom_historyIso henv hvalue + rw [hrightValue] + simp only [bind, Except.bind] + exact List.resolveAtomsFrom_historyIso henv atoms + (leftAcc ++ [leftValue]) (rightAcc ++ [rightValue]) leftOut + (hacc.append (.cons hvalueIso .nil)) hleft + +theorem resolveAtoms_historyIso + {rel : Nat → Nat → Prop} {left right : List RVal} + (henv : RValsIso rel left right) {atoms : Array Atom} + {leftValues : List RVal} + (hleft : resolveAtoms left atoms = .ok leftValues) : + ∃ rightValues, resolveAtoms right atoms = .ok rightValues ∧ + RValsIso rel leftValues rightValues := by + unfold resolveAtoms at hleft ⊢ + rw [← Array.foldlM_toList] at hleft ⊢ + exact List.resolveAtomsFrom_historyIso henv atoms.toList [] [] leftValues + .nil hleft + +private theorem RValIso.hasWorld_eq + {left right : Store} (iso : HeapHistoryIso left right) + {leftValue rightValue : RVal} (hvalue : RValIso iso.locRel + leftValue rightValue) (world : Owned) : + leftValue.hasWorld left world = rightValue.hasWorld right world := by + cases hvalue with + | lit => rfl + | erased => rfl + | @loc leftLoc rightLoc hrel => + simp only [RVal.hasWorld] + rcases iso.related hrel with hdead | hlive + · rw [hdead.1, hdead.2] + · obtain ⟨leftBox, rightBox, hleft, hright, hbox⟩ := hlive + rw [hleft, hright] + exact congrArg (fun found => found == world) hbox.world + +theorem checkResultWorld_historyIso + {left right : Store} (iso : HeapHistoryIso left right) + {leftValue rightValue : RVal} + (hvalue : RValIso iso.locRel leftValue rightValue) + (world : Owned) + (hleft : checkResultWorld world (left, leftValue) = + .ok (left, leftValue)) : + checkResultWorld world (right, rightValue) = + .ok (right, rightValue) := by + have heq := RValIso.hasWorld_eq iso hvalue world + unfold checkResultWorld at hleft ⊢ + by_cases hworld : leftValue.hasWorld left world = true + · have hright : rightValue.hasWorld right world = true := by + rw [← heq] + exact hworld + simp [hworld, hright] + · simp [hworld] at hleft + +theorem dupVals_historyIso + {left right : Store} (iso : HeapHistoryIso left right) : + ∀ {leftValues rightValues : List RVal}, + RValsIso iso.locRel leftValues rightValues → + ∀ {leftOut : Store}, dupVals left leftValues = .ok leftOut → + ∃ rightOut, dupVals right rightValues = .ok rightOut ∧ + StoreHistoryIso iso leftOut rightOut + | _, _, .nil, leftOut, hrun => by + change (Except.ok left : Except Err Store) = .ok leftOut at hrun + injection hrun with heq + subst leftOut + change ∃ rightOut, + (Except.ok right : Except Err Store) = .ok rightOut ∧ + StoreHistoryIso iso left rightOut + exact ⟨right, rfl, ⟨iso, fun h => h⟩⟩ + | leftHead :: leftTail, rightHead :: rightTail, + .cons hhead htail, leftOut, hrun => by + cases hhead with + | lit => + change dupVals left _ = .ok leftOut at hrun + change ∃ rightOut, dupVals right _ = .ok rightOut ∧ _ + exact dupVals_historyIso iso htail hrun + | erased => + change dupVals left _ = .ok leftOut at hrun + change ∃ rightOut, dupVals right _ = .ok rightOut ∧ _ + exact dupVals_historyIso iso htail hrun + | @loc leftLoc rightLoc hrel => + cases hleft : left.get? leftLoc with + | none => + simp [dupVals, hleft] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | some leftBox => + obtain ⟨rightBox, hright, hbox⟩ := iso.boxes hrel hleft + cases hworld : leftBox.world with + | unique => + simp [dupVals, hleft, hworld] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | shared => + have hrightWorld : rightBox.world = .shared := by + rw [← hbox.world, hworld] + let newLeft : NodeBox := + ⟨.shared, leftBox.rc + 1, leftBox.node⟩ + let newRight : NodeBox := + ⟨.shared, rightBox.rc + 1, rightBox.node⟩ + have hrun' : dupVals + (left.setBox leftLoc newLeft).rcTick + leftTail = .ok leftOut := by + have htemp := hrun + simp [dupVals, hleft, hworld] at htemp + simp only [bind, Except.bind] at htemp + simpa [newLeft, dupVals] using htemp + let nextLeft := + (left.setBox leftLoc newLeft).rcTick + let nextRight := + (right.setBox rightLoc newRight).rcTick + have hnew : NodeBoxIso iso.locRel + newLeft newRight := by + exact ⟨rfl, congrArg (fun n => n + 1) hbox.rc, + hbox.node⟩ + let nextIso : HeapHistoryIso nextLeft nextRight := + (iso.setBox hrel hleft hright hnew).rcTick + obtain ⟨rightOut, hrightOut, outIso, hout⟩ := + dupVals_historyIso nextIso + (htail.mono (fun h => h)) hrun' + have hrightOut' : dupVals right + (.loc rightLoc :: rightTail) = .ok rightOut := by + simp [dupVals, hright, hrightWorld] + simp only [bind, Except.bind] + simpa [nextRight, newRight, dupVals] using hrightOut + refine ⟨rightOut, hrightOut', outIso, ?_⟩ + exact fun h => hout h + +theorem callScalarOracle_historyIso + {ctx : Ctx} {function : Ix.Compiler.Ixon.Address} + {leftValues rightValues : List RVal} + {rel : Nat → Nat → Prop} (hvalues : RValsIso rel leftValues rightValues) + {leftValue : RVal} + (hleft : callScalarOracle ctx function leftValues = .ok leftValue) : + ∃ rightValue, callScalarOracle ctx function rightValues = .ok rightValue ∧ + RValIso rel leftValue rightValue := by + by_cases hscalar : leftValues.all RVal.isScalar = true + · have heq := hvalues.eq_of_allScalar hscalar + subst rightValues + exact ⟨leftValue, hleft, by + unfold callScalarOracle at hleft + simp only [hscalar, Bool.not_true, Bool.false_eq_true, if_false] at hleft + cases horacle : ctx.oracle function leftValues with + | none => simp [horacle] at hleft + | some value => + rw [horacle] at hleft + cases hvalue : value.isScalar with + | false => simp [hvalue] at hleft + | true => + simp only [hvalue, if_true, Except.ok.injEq] at hleft + subst leftValue + exact RValIso.refl_of_scalar hvalue⟩ + · unfold callScalarOracle at hleft + simp [hscalar] at hleft + +private theorem List.foldl_cons_eq_reverse_append + (values environment : List RVal) : + values.foldl (fun current value => value :: current) environment = + values.reverse ++ environment := by + induction values generalizing environment with + | nil => rfl + | cons value values ih => + simp only [List.foldl_cons] + rw [ih] + simp [List.reverse_cons, List.append_assoc] + +theorem Array.foldl_cons_historyIso + {rel : Nat → Nat → Prop} {left right : Array RVal} + (hvalues : RValsIso rel left.toList right.toList) + {leftEnvironment rightEnvironment : List RVal} + (henvironment : RValsIso rel leftEnvironment rightEnvironment) : + RValsIso rel + (left.foldl (fun current value => value :: current) leftEnvironment) + (right.foldl (fun current value => value :: current) rightEnvironment) := by + rw [← Array.foldl_toList, ← Array.foldl_toList, + List.foldl_cons_eq_reverse_append, + List.foldl_cons_eq_reverse_append] + exact hvalues.reverse.append henvironment + +/-- Successful evaluation is equivariant under allocation-history +isomorphism at one common fuel index. -/ +private structure EvalHistoryIsoAt (fuel : Nat) : Prop where + runCode : ∀ (ctx : Ctx) (current : FnDef) + (left right : Store) (heap : HeapHistoryIso left right) + (leftEnvironment rightEnvironment : List RVal), + RValsIso heap.locRel leftEnvironment rightEnvironment → + ∀ (input : Code) (leftOut : Store × RVal), + IxIR1.runCode ctx fuel current left leftEnvironment input = .ok leftOut → + ∃ rightOut, + IxIR1.runCode ctx fuel current right rightEnvironment input = + .ok rightOut ∧ + RunHistoryIso heap leftOut rightOut + runOp : ∀ (ctx : Ctx) (current : FnDef) + (left right : Store) (heap : HeapHistoryIso left right) + (leftEnvironment rightEnvironment : List RVal), + RValsIso heap.locRel leftEnvironment rightEnvironment → + ∀ (operation : Op) (leftOut : Store × RVal), + IxIR1.runOp ctx fuel current left leftEnvironment operation = .ok leftOut → + ∃ rightOut, + IxIR1.runOp ctx fuel current right rightEnvironment operation = + .ok rightOut ∧ + RunHistoryIso heap leftOut rightOut + invoke : ∀ (ctx : Ctx) (function : Ix.Compiler.Ixon.Address) + (leftArguments rightArguments : List RVal) + (left right : Store) (heap : HeapHistoryIso left right), + RValsIso heap.locRel leftArguments rightArguments → + ∀ (leftOut : Store × RVal), + IxIR1.invoke ctx fuel function leftArguments left = .ok leftOut → + ∃ rightOut, + IxIR1.invoke ctx fuel function rightArguments right = .ok rightOut ∧ + RunHistoryIso heap leftOut rightOut + applyGo : ∀ (ctx : Ctx) (left right : Store) + (heap : HeapHistoryIso left right) + (leftFunction rightFunction : RVal) + (leftArguments rightArguments : List RVal), + RValIso heap.locRel leftFunction rightFunction → + RValsIso heap.locRel leftArguments rightArguments → + ∀ (leftOut : Store × RVal), + IxIR1.applyGo ctx fuel left leftFunction leftArguments = .ok leftOut → + ∃ rightOut, + IxIR1.applyGo ctx fuel right rightFunction rightArguments = + .ok rightOut ∧ + RunHistoryIso heap leftOut rightOut + dropVal : ∀ (ctx : Ctx) (left right : Store) + (heap : HeapHistoryIso left right) (leftValue rightValue : RVal), + RValIso heap.locRel leftValue rightValue → + ∀ (leftOut : Store), + IxIR1.dropVal ctx fuel left leftValue = .ok leftOut → + ∃ rightOut, + IxIR1.dropVal ctx fuel right rightValue = .ok rightOut ∧ + StoreHistoryIso heap leftOut rightOut + dropMany : ∀ (ctx : Ctx) (left right : Store) + (heap : HeapHistoryIso left right) + (leftValues rightValues : List RVal), + RValsIso heap.locRel leftValues rightValues → + ∀ (leftOut : Store), + IxIR1.dropMany ctx fuel left leftValues = .ok leftOut → + ∃ rightOut, + IxIR1.dropMany ctx fuel right rightValues = .ok rightOut ∧ + StoreHistoryIso heap leftOut rightOut + dropUVal : ∀ (ctx : Ctx) (left right : Store) + (heap : HeapHistoryIso left right) (leftValue rightValue : RVal), + RValIso heap.locRel leftValue rightValue → + ∀ (leftOut : Store), + IxIR1.dropUVal ctx fuel left leftValue = .ok leftOut → + ∃ rightOut, + IxIR1.dropUVal ctx fuel right rightValue = .ok rightOut ∧ + StoreHistoryIso heap leftOut rightOut + dropManyU : ∀ (ctx : Ctx) (left right : Store) + (heap : HeapHistoryIso left right) + (leftValues rightValues : List RVal), + RValsIso heap.locRel leftValues rightValues → + ∀ (leftOut : Store), + IxIR1.dropManyU ctx fuel left leftValues = .ok leftOut → + ∃ rightOut, + IxIR1.dropManyU ctx fuel right rightValues = .ok rightOut ∧ + StoreHistoryIso heap leftOut rightOut + +private structure DropHistoryIsoAt (fuel : Nat) : Prop where + dropVal : ∀ (ctx : Ctx) (left right : Store) + (heap : HeapHistoryIso left right) (leftValue rightValue : RVal), + RValIso heap.locRel leftValue rightValue → + ∀ (leftOut : Store), + IxIR1.dropVal ctx fuel left leftValue = .ok leftOut → + ∃ rightOut, + IxIR1.dropVal ctx fuel right rightValue = .ok rightOut ∧ + StoreHistoryIso heap leftOut rightOut + dropMany : ∀ (ctx : Ctx) (left right : Store) + (heap : HeapHistoryIso left right) + (leftValues rightValues : List RVal), + RValsIso heap.locRel leftValues rightValues → + ∀ (leftOut : Store), + IxIR1.dropMany ctx fuel left leftValues = .ok leftOut → + ∃ rightOut, + IxIR1.dropMany ctx fuel right rightValues = .ok rightOut ∧ + StoreHistoryIso heap leftOut rightOut + dropUVal : ∀ (ctx : Ctx) (left right : Store) + (heap : HeapHistoryIso left right) (leftValue rightValue : RVal), + RValIso heap.locRel leftValue rightValue → + ∀ (leftOut : Store), + IxIR1.dropUVal ctx fuel left leftValue = .ok leftOut → + ∃ rightOut, + IxIR1.dropUVal ctx fuel right rightValue = .ok rightOut ∧ + StoreHistoryIso heap leftOut rightOut + dropManyU : ∀ (ctx : Ctx) (left right : Store) + (heap : HeapHistoryIso left right) + (leftValues rightValues : List RVal), + RValsIso heap.locRel leftValues rightValues → + ∀ (leftOut : Store), + IxIR1.dropManyU ctx fuel left leftValues = .ok leftOut → + ∃ rightOut, + IxIR1.dropManyU ctx fuel right rightValues = .ok rightOut ∧ + StoreHistoryIso heap leftOut rightOut + +private theorem dropHistoryIsoAt : ∀ fuel, DropHistoryIsoAt fuel := by + intro fuel + induction fuel with + | zero => + constructor <;> intros <;> + simp [IxIR1.dropVal, IxIR1.dropMany, IxIR1.dropUVal, + IxIR1.dropManyU] at * + | succ fuel smaller => + refine ⟨?_, ?_, ?_, ?_⟩ + · intro ctx left right heap leftValue rightValue hvalue leftOut hrun + rw [IxIR1.dropVal.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hvalue with + | lit => + injection hrun with hout + subst leftOut + exact ⟨right, rfl, heap, HeapHistoryIso.Extends.refl⟩ + | erased => + injection hrun with hout + subst leftOut + exact ⟨right, rfl, heap, HeapHistoryIso.Extends.refl⟩ + | @loc leftLoc rightLoc hrel => + cases hleft : left.get? leftLoc with + | none => simp [hleft] at hrun + | some leftBox => + obtain ⟨rightBox, hright, hbox⟩ := heap.boxes hrel hleft + rcases leftBox with ⟨leftWorld, leftRc, leftNode⟩ + rcases rightBox with ⟨rightWorld, rightRc, rightNode⟩ + rcases hbox with ⟨hworld, hrc, hnode⟩ + change leftWorld = rightWorld at hworld + change leftRc = rightRc at hrc + change NodeIso heap.locRel leftNode rightNode at hnode + subst rightWorld + subst rightRc + simp only [hleft] at hrun + simp only [hright] + cases leftWorld with + | unique => simp at hrun + | shared => + simp only + by_cases hone : leftRc == 1 + · simp only [hone, if_true] at hrun ⊢ + have hleftTick : + left.rcTick.get? leftLoc = + some ⟨.shared, leftRc, leftNode⟩ := by + simpa [Store.rcTick, Store.get?] using hleft + have hrightTick : + right.rcTick.get? rightLoc = + some ⟨.shared, leftRc, rightNode⟩ := by + simpa [Store.rcTick, Store.get?] using hright + let killed := (heap.rcTick).kill hrel + hleftTick hrightTick + cases hnode with + | ctor hfields => + obtain ⟨rightOut, hrightOut, final, + hext⟩ := + smaller.dropMany ctx + (left.rcTick.kill leftLoc) + (right.rcTick.kill rightLoc) killed + _ _ hfields leftOut hrun + exact ⟨rightOut, hrightOut, final, + HeapHistoryIso.Extends.trans + (fun h => h) hext⟩ + | pap harguments => + obtain ⟨rightOut, hrightOut, final, + hext⟩ := + smaller.dropMany ctx + (left.rcTick.kill leftLoc) + (right.rcTick.kill rightLoc) killed + _ _ harguments leftOut hrun + exact ⟨rightOut, hrightOut, final, + HeapHistoryIso.Extends.trans + (fun h => h) hext⟩ + · simp only [hone, Bool.false_eq_true, if_false] + at hrun ⊢ + injection hrun with hout + subst leftOut + have hleftTick : + left.rcTick.get? leftLoc = + some ⟨.shared, leftRc, leftNode⟩ := by + simpa [Store.rcTick, Store.get?] using hleft + have hrightTick : + right.rcTick.get? rightLoc = + some ⟨.shared, leftRc, rightNode⟩ := by + simpa [Store.rcTick, Store.get?] using hright + let next := (heap.rcTick).setBox hrel + hleftTick hrightTick + (⟨rfl, rfl, hnode⟩ : NodeBoxIso heap.locRel + ⟨.shared, leftRc - 1, leftNode⟩ + ⟨.shared, leftRc - 1, rightNode⟩) + exact ⟨_, rfl, next, fun h => h⟩ + · intro ctx left right heap leftValues rightValues hvalues + leftOut hrun + rw [IxIR1.dropMany.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hvalues with + | nil => + injection hrun with hout + subst leftOut + exact ⟨right, rfl, heap, HeapHistoryIso.Extends.refl⟩ + | @cons leftHead rightHead leftTail rightTail hhead htail => + dsimp only at hrun ⊢ + cases hfirst : IxIR1.dropVal ctx fuel left leftHead with + | error error => + rw [hfirst] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok middle => + rw [hfirst] at hrun + simp only [bind, Except.bind] at hrun + obtain ⟨rightMiddle, hrightFirst, middleHeap, + hentryMiddle⟩ := + smaller.dropVal ctx left right heap leftHead rightHead + hhead middle hfirst + obtain ⟨rightOut, hrightRest, finalHeap, + hmiddleFinal⟩ := + smaller.dropMany ctx middle rightMiddle middleHeap _ _ + (hentryMiddle.rvals htail) leftOut hrun + refine ⟨rightOut, ?_, finalHeap, + hentryMiddle.trans hmiddleFinal⟩ + rw [hrightFirst] + simp only [bind, Except.bind] + exact hrightRest + · intro ctx left right heap leftValue rightValue hvalue leftOut hrun + rw [IxIR1.dropUVal.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hvalue with + | lit => + injection hrun with hout + subst leftOut + exact ⟨right, rfl, heap, HeapHistoryIso.Extends.refl⟩ + | erased => + injection hrun with hout + subst leftOut + exact ⟨right, rfl, heap, HeapHistoryIso.Extends.refl⟩ + | @loc leftLoc rightLoc hrel => + cases hleft : left.get? leftLoc with + | none => simp [hleft] at hrun + | some leftBox => + obtain ⟨rightBox, hright, hbox⟩ := heap.boxes hrel hleft + rcases leftBox with ⟨leftWorld, leftRc, leftNode⟩ + rcases rightBox with ⟨rightWorld, rightRc, rightNode⟩ + rcases hbox with ⟨hworld, hrc, hnode⟩ + change leftWorld = rightWorld at hworld + change leftRc = rightRc at hrc + change NodeIso heap.locRel leftNode rightNode at hnode + subst rightWorld + subst rightRc + simp only [hleft] at hrun + simp only [hright] + cases leftWorld with + | shared => simp at hrun + | unique => + simp only + cases hnode with + | pap harguments => simp at hrun + | ctor hfields => + let killed := heap.kill hrel hleft hright + obtain ⟨rightOut, hrightOut, final, + hext⟩ := + smaller.dropManyU ctx (left.kill leftLoc) + (right.kill rightLoc) killed _ _ hfields + leftOut hrun + exact ⟨rightOut, hrightOut, final, + HeapHistoryIso.Extends.trans (fun h => h) hext⟩ + · intro ctx left right heap leftValues rightValues hvalues + leftOut hrun + rw [IxIR1.dropManyU.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hvalues with + | nil => + injection hrun with hout + subst leftOut + exact ⟨right, rfl, heap, HeapHistoryIso.Extends.refl⟩ + | @cons leftHead rightHead leftTail rightTail hhead htail => + dsimp only at hrun ⊢ + cases hfirst : IxIR1.dropUVal ctx fuel left leftHead with + | error error => + rw [hfirst] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok middle => + rw [hfirst] at hrun + simp only [bind, Except.bind] at hrun + obtain ⟨rightMiddle, hrightFirst, middleHeap, + hentryMiddle⟩ := + smaller.dropUVal ctx left right heap leftHead rightHead + hhead middle hfirst + obtain ⟨rightOut, hrightRest, finalHeap, + hmiddleFinal⟩ := + smaller.dropManyU ctx middle rightMiddle middleHeap _ _ + (hentryMiddle.rvals htail) leftOut hrun + refine ⟨rightOut, ?_, finalHeap, + hentryMiddle.trans hmiddleFinal⟩ + rw [hrightFirst] + simp only [bind, Except.bind] + exact hrightRest + +private theorem runCode_case_historyIso + {fuel : Nat} (smaller : EvalHistoryIsoAt fuel) + (ctx : Ctx) (current : FnDef) (left right : Store) + (heap : HeapHistoryIso left right) + (leftEnvironment rightEnvironment : List RVal) + (henvironment : RValsIso heap.locRel + leftEnvironment rightEnvironment) + (scrutinee : Atom) (peelNat : Bool) (alternatives : Array Alt) + (leftOut : Store × RVal) + (hrun : IxIR1.runCode ctx (fuel + 1) current left leftEnvironment + (.case scrutinee peelNat alternatives) = .ok leftOut) : + ∃ rightOut, + IxIR1.runCode ctx (fuel + 1) current right rightEnvironment + (.case scrutinee peelNat alternatives) = .ok rightOut ∧ + RunHistoryIso heap leftOut rightOut := by + rw [IxIR1.runCode.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hleftResolve : resolveAtom leftEnvironment scrutinee with + | error error => + rw [hleftResolve] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok leftValue => + obtain ⟨rightValue, hrightResolve, hvalue⟩ := + resolveAtom_historyIso henvironment hleftResolve + rw [hleftResolve] at hrun + rw [hrightResolve] + simp only [bind, Except.bind] at hrun ⊢ + cases hvalue with + | erased => simp at hrun + | @lit literal => + cases literal with + | str value => simp at hrun + | nat value => + cases peelNat with + | false => simp at hrun + | true => + cases value with + | zero => + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == 0) with + | none => simp [hfind] at hrun + | some alternative => + cases alternative with + | mk cidx fields body => + cases fields with + | zero => + simp only [hfind] at hrun ⊢ + exact smaller.runCode ctx current + left right heap leftEnvironment + rightEnvironment henvironment body + leftOut hrun + | succ fields => simp [hfind] at hrun + | succ value => + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == 1) with + | none => simp [hfind] at hrun + | some alternative => + cases alternative with + | mk cidx fields body => + cases fields with + | zero => simp [hfind] at hrun + | succ fields => + cases fields with + | zero => + simp only [hfind] at hrun ⊢ + exact smaller.runCode ctx current + left right heap + (.lit (.nat value) :: + leftEnvironment) + (.lit (.nat value) :: + rightEnvironment) + (.cons .lit henvironment) body + leftOut hrun + | succ fields => simp [hfind] at hrun + | @loc leftLoc rightLoc hrel => + cases hleft : left.get? leftLoc with + | none => simp [hleft] at hrun + | some leftBox => + obtain ⟨rightBox, hright, hbox⟩ := heap.boxes hrel hleft + rcases leftBox with ⟨leftWorld, leftRc, leftNode⟩ + rcases rightBox with ⟨rightWorld, rightRc, rightNode⟩ + rcases hbox with ⟨hworld, hrc, hnode⟩ + change leftWorld = rightWorld at hworld + change leftRc = rightRc at hrc + change NodeIso heap.locRel leftNode rightNode at hnode + subst rightWorld + subst rightRc + simp only [hleft] at hrun + simp only [hright] + cases hnode with + | pap harguments => simp at hrun + | @ctor cid leftFields rightFields hfields => + simp only + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == cid.cidx) with + | none => simp [hfind] at hrun + | some alternative => + cases alternative with + | mk cidx fieldCount body => + have hsizes : leftFields.size = rightFields.size := by + simpa using hfields.lengths + by_cases hcount : leftFields.size = fieldCount + · have hrightCount : + rightFields.size = fieldCount := by + rw [← hsizes] + exact hcount + simp [hfind, hcount, hrightCount] at hrun ⊢ + obtain ⟨rightOut, hrightOut, hout⟩ := + smaller.runCode ctx current left right heap + (leftFields.toList.reverse ++ leftEnvironment) + (rightFields.toList.reverse ++ rightEnvironment) + (hfields.reverse.append henvironment) + body leftOut hrun + rcases rightOut with ⟨rightStore, rightValue⟩ + exact ⟨rightStore, rightValue, hrightOut, hout⟩ + · have hrightCount : + rightFields.size ≠ fieldCount := by + intro heq + exact hcount (hsizes.trans heq) + simp [hfind, hcount, hrightCount] at hrun + +private theorem runCode_historyIsoStep {fuel : Nat} + (smaller : EvalHistoryIsoAt fuel) : + ∀ (ctx : Ctx) (current : FnDef) + (left right : Store) (heap : HeapHistoryIso left right) + (leftEnvironment rightEnvironment : List RVal), + RValsIso heap.locRel leftEnvironment rightEnvironment → + ∀ (input : Code) (leftOut : Store × RVal), + IxIR1.runCode ctx (fuel + 1) current left leftEnvironment input = + .ok leftOut → + ∃ rightOut, + IxIR1.runCode ctx (fuel + 1) current right rightEnvironment input = + .ok rightOut ∧ + RunHistoryIso heap leftOut rightOut := by + intro ctx current left right heap leftEnvironment rightEnvironment + henvironment input leftOut hrun + cases input with + | ret atom => + rw [IxIR1.runCode.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hleft : resolveAtom leftEnvironment atom with + | error error => + rw [hleft] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok leftValue => + obtain ⟨rightValue, hright, hvalue⟩ := + resolveAtom_historyIso henvironment hleft + rw [hleft] at hrun + simp only [bind, Except.bind, Except.ok.injEq] at hrun + subst leftOut + rw [hright] + exact ⟨(right, rightValue), rfl, heap, + HeapHistoryIso.Extends.refl, hvalue⟩ + | letOp operation rest => + rw [IxIR1.runCode.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hoperation : IxIR1.runOp ctx fuel current left leftEnvironment + operation with + | error error => + rw [hoperation] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok operationOut => + rcases operationOut with ⟨middle, leftValue⟩ + rw [hoperation] at hrun + simp only [bind, Except.bind] at hrun + obtain ⟨rightOperationOut, hrightOperation, + operationHeap, hentryOperation, hvalue⟩ := + smaller.runOp ctx current left right heap leftEnvironment + rightEnvironment henvironment operation (middle, leftValue) + hoperation + rcases rightOperationOut with ⟨rightMiddle, rightValue⟩ + obtain ⟨rightOut, hrightRest, finalHeap, + hoperationFinal, hresult⟩ := + smaller.runCode ctx current middle rightMiddle operationHeap + (leftValue :: leftEnvironment) + (rightValue :: rightEnvironment) + (.cons hvalue (hentryOperation.rvals henvironment)) rest + leftOut hrun + refine ⟨rightOut, ?_, finalHeap, + hentryOperation.trans hoperationFinal, hresult⟩ + rw [hrightOperation] + simp only [bind, Except.bind] + exact hrightRest + | case scrutinee peelNat alternatives => + exact runCode_case_historyIso smaller ctx current left right heap + leftEnvironment rightEnvironment henvironment scrutinee peelNat + alternatives leftOut hrun + +private theorem runOp_historyIsoStep {fuel : Nat} + (smaller : EvalHistoryIsoAt fuel) : + ∀ (ctx : Ctx) (current : FnDef) + (left right : Store) (heap : HeapHistoryIso left right) + (leftEnvironment rightEnvironment : List RVal), + RValsIso heap.locRel leftEnvironment rightEnvironment → + ∀ (operation : Op) (leftOut : Store × RVal), + IxIR1.runOp ctx (fuel + 1) current left leftEnvironment operation = + .ok leftOut → + ∃ rightOut, + IxIR1.runOp ctx (fuel + 1) current right rightEnvironment operation = + .ok rightOut ∧ + RunHistoryIso heap leftOut rightOut := by + intro ctx current left right heap leftEnvironment rightEnvironment + henvironment operation leftOut hrun + cases operation with + | pure atom => + rw [IxIR1.runOp.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hleft : resolveAtom leftEnvironment atom with + | error error => + rw [hleft] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok leftValue => + obtain ⟨rightValue, hright, hvalue⟩ := + resolveAtom_historyIso henvironment hleft + rw [hleft] at hrun + simp only [bind, Except.bind, Except.ok.injEq] at hrun + subst leftOut + rw [hright] + exact ⟨(right, rightValue), rfl, heap, + HeapHistoryIso.Extends.refl, hvalue⟩ + | alloc world identity arguments => + rw [IxIR1.runOp.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hleft : resolveAtoms leftEnvironment arguments with + | error error => + rw [hleft] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok leftValues => + obtain ⟨rightValues, hright, hvalues⟩ := + resolveAtoms_historyIso henvironment hleft + rw [hleft] at hrun + simp only [bind, Except.bind, Except.ok.injEq] at hrun + subst leftOut + rw [hright] + let next := heap.alloc (world := world) + (leftNode := .ctorN identity leftValues.toArray) + (rightNode := .ctorN identity rightValues.toArray) + (.ctor (by simpa using hvalues)) + exact ⟨_, rfl, next, (fun h => .inr h), + .loc (.inl ⟨rfl, rfl⟩)⟩ + | reuse target identity arguments => + rw [IxIR1.runOp.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hleftArgs : resolveAtoms leftEnvironment arguments with + | error error => + rw [hleftArgs] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok leftValues => + obtain ⟨rightValues, hrightArgs, hvalues⟩ := + resolveAtoms_historyIso henvironment hleftArgs + rw [hleftArgs] at hrun + rw [hrightArgs] + simp only [bind, Except.bind] at hrun ⊢ + cases hleftTarget : resolveAtom leftEnvironment target with + | error error => + rw [hleftTarget] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok leftTarget => + obtain ⟨rightTarget, hrightTarget, htarget⟩ := + resolveAtom_historyIso henvironment hleftTarget + rw [hleftTarget] at hrun + rw [hrightTarget] + simp only [bind, Except.bind] at hrun ⊢ + cases htarget with + | lit => simp at hrun + | erased => simp at hrun + | @loc leftLoc rightLoc hrel => + cases hleftBox : left.get? leftLoc with + | none => simp [hleftBox] at hrun + | some leftBox => + obtain ⟨rightBox, hrightBox, hbox⟩ := + heap.boxes hrel hleftBox + rcases leftBox with ⟨leftWorld, leftRc, leftNode⟩ + rcases rightBox with + ⟨rightWorld, rightRc, rightNode⟩ + rcases hbox with ⟨hworld, hrc, hnode⟩ + change leftWorld = rightWorld at hworld + change leftRc = rightRc at hrc + change NodeIso heap.locRel leftNode rightNode at hnode + subst rightWorld + subst rightRc + simp only [hleftBox] at hrun + simp only [hrightBox] + cases leftWorld with + | shared => simp at hrun + | unique => + simp only [Except.ok.injEq] at hrun + subst leftOut + let leftSet := left.setBox leftLoc + ⟨.unique, 1, .ctorN identity + leftValues.toArray⟩ + let rightSet := right.setBox rightLoc + ⟨.unique, 1, .ctorN identity + rightValues.toArray⟩ + let base := heap.setBox hrel hleftBox hrightBox + (⟨rfl, rfl, .ctor (by simpa using hvalues)⟩ : + NodeBoxIso heap.locRel + ⟨.unique, 1, + .ctorN identity leftValues.toArray⟩ + ⟨.unique, 1, + .ctorN identity rightValues.toArray⟩) + let next := base.nodesEq + (nextLeft := + { leftSet with + reuses := leftSet.reuses + 1 }) + (nextRight := + { rightSet with + reuses := rightSet.reuses + 1 }) rfl rfl + exact ⟨_, rfl, next, (fun h => h), .loc hrel⟩ + | free target => + rw [IxIR1.runOp.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hleft : resolveAtom leftEnvironment target with + | error error => + rw [hleft] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok leftTarget => + obtain ⟨rightTarget, hright, htarget⟩ := + resolveAtom_historyIso henvironment hleft + rw [hleft] at hrun + rw [hright] + simp only [bind, Except.bind] at hrun ⊢ + cases htarget with + | lit => simp at hrun + | erased => simp at hrun + | @loc leftLoc rightLoc hrel => + cases hleftBox : left.get? leftLoc with + | none => simp [hleftBox] at hrun + | some leftBox => + obtain ⟨rightBox, hrightBox, hbox⟩ := + heap.boxes hrel hleftBox + have hworld := hbox.world + simp only [hleftBox] at hrun + simp only [hrightBox] + cases hleftWorld : leftBox.world with + | shared => simp [hleftWorld] at hrun + | unique => + have hrightWorld : rightBox.world = .unique := by + rw [← hworld, hleftWorld] + simp only [hleftWorld, hrightWorld, + Except.ok.injEq] at hrun ⊢ + subst leftOut + let next := heap.kill hrel hleftBox hrightBox + exact ⟨_, rfl, next, (fun h => h), .erased⟩ + | dup target => + rw [IxIR1.runOp.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hleft : resolveAtom leftEnvironment target with + | error error => + rw [hleft] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok leftTarget => + obtain ⟨rightTarget, hright, htarget⟩ := + resolveAtom_historyIso henvironment hleft + rw [hleft] at hrun + rw [hright] + simp only [bind, Except.bind] at hrun ⊢ + cases htarget with + | lit => + simp only [Except.ok.injEq] at hrun + subst leftOut + exact ⟨_, rfl, heap, HeapHistoryIso.Extends.refl, .lit⟩ + | erased => + simp only [Except.ok.injEq] at hrun + subst leftOut + exact ⟨_, rfl, heap, HeapHistoryIso.Extends.refl, .erased⟩ + | @loc leftLoc rightLoc hrel => + cases hleftBox : left.get? leftLoc with + | none => simp [hleftBox] at hrun + | some leftBox => + obtain ⟨rightBox, hrightBox, hbox⟩ := + heap.boxes hrel hleftBox + rcases leftBox with ⟨leftWorld, leftRc, leftNode⟩ + rcases rightBox with ⟨rightWorld, rightRc, rightNode⟩ + rcases hbox with ⟨hworld, hrc, hnode⟩ + change leftWorld = rightWorld at hworld + change leftRc = rightRc at hrc + change NodeIso heap.locRel leftNode rightNode at hnode + subst rightWorld + subst rightRc + simp only [hleftBox] at hrun + simp only [hrightBox] + cases leftWorld with + | unique => simp at hrun + | shared => + simp only [Except.ok.injEq] at hrun + subst leftOut + let next := (heap.setBox hrel hleftBox hrightBox + (⟨rfl, rfl, hnode⟩ : NodeBoxIso heap.locRel + ⟨.shared, leftRc + 1, leftNode⟩ + ⟨.shared, leftRc + 1, rightNode⟩)).rcTick + exact ⟨_, rfl, next, (fun h => h), .loc hrel⟩ + | drop target => + rw [IxIR1.runOp.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hleft : resolveAtom leftEnvironment target with + | error error => + rw [hleft] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok leftTarget => + obtain ⟨rightTarget, hright, htarget⟩ := + resolveAtom_historyIso henvironment hleft + rw [hleft] at hrun + rw [hright] + simp only [bind, Except.bind] at hrun ⊢ + cases htarget with + | lit => + simp only [Except.ok.injEq] at hrun + subst leftOut + exact ⟨_, rfl, heap, HeapHistoryIso.Extends.refl, .erased⟩ + | erased => + simp only [Except.ok.injEq] at hrun + subst leftOut + exact ⟨_, rfl, heap, HeapHistoryIso.Extends.refl, .erased⟩ + | @loc leftLoc rightLoc hrel => + dsimp only at hrun ⊢ + cases hdrop : IxIR1.dropVal ctx fuel left (.loc leftLoc) with + | error error => + rw [hdrop] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok nextLeft => + rw [hdrop] at hrun + simp only [bind, Except.bind, Except.ok.injEq] at hrun + subst leftOut + obtain ⟨nextRight, hrightDrop, nextHeap, hext⟩ := + smaller.dropVal ctx left right heap _ _ (.loc hrel) + nextLeft hdrop + rw [hrightDrop] + exact ⟨_, rfl, nextHeap, hext, .erased⟩ + | dropU target => + rw [IxIR1.runOp.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hleft : resolveAtom leftEnvironment target with + | error error => + rw [hleft] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok leftTarget => + obtain ⟨rightTarget, hright, htarget⟩ := + resolveAtom_historyIso henvironment hleft + rw [hleft] at hrun + rw [hright] + simp only [bind, Except.bind] at hrun ⊢ + cases htarget with + | lit => + simp only [Except.ok.injEq] at hrun + subst leftOut + exact ⟨_, rfl, heap, HeapHistoryIso.Extends.refl, .erased⟩ + | erased => + simp only [Except.ok.injEq] at hrun + subst leftOut + exact ⟨_, rfl, heap, HeapHistoryIso.Extends.refl, .erased⟩ + | @loc leftLoc rightLoc hrel => + dsimp only at hrun ⊢ + cases hdrop : IxIR1.dropUVal ctx fuel left (.loc leftLoc) with + | error error => + rw [hdrop] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok nextLeft => + rw [hdrop] at hrun + simp only [bind, Except.bind, Except.ok.injEq] at hrun + subst leftOut + obtain ⟨nextRight, hrightDrop, nextHeap, hext⟩ := + smaller.dropUVal ctx left right heap _ _ (.loc hrel) + nextLeft hdrop + rw [hrightDrop] + exact ⟨_, rfl, nextHeap, hext, .erased⟩ + | fetch target field => + rw [IxIR1.runOp.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hleft : resolveAtom leftEnvironment target with + | error error => + rw [hleft] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok leftTarget => + obtain ⟨rightTarget, hright, htarget⟩ := + resolveAtom_historyIso henvironment hleft + rw [hleft] at hrun + rw [hright] + simp only [bind, Except.bind] at hrun ⊢ + cases htarget with + | lit => simp at hrun + | erased => simp at hrun + | @loc leftLoc rightLoc hrel => + cases hleftBox : left.get? leftLoc with + | none => simp [hleftBox] at hrun + | some leftBox => + obtain ⟨rightBox, hrightBox, hbox⟩ := + heap.boxes hrel hleftBox + rcases leftBox with ⟨leftWorld, leftRc, leftNode⟩ + rcases rightBox with ⟨rightWorld, rightRc, rightNode⟩ + rcases hbox with ⟨hworld, hrc, hnodeIso⟩ + change leftWorld = rightWorld at hworld + change leftRc = rightRc at hrc + change NodeIso heap.locRel leftNode rightNode at hnodeIso + subst rightWorld + subst rightRc + simp only [hleftBox] at hrun + simp only [hrightBox] + cases hnodeIso with + | pap harguments => simp at hrun + | @ctor identity leftFields rightFields hfields => + simp only + cases hfield : leftFields[field]? with + | none => simp [hfield] at hrun + | some leftValue => + obtain ⟨rightValue, hrightField, hvalue⟩ := + hfields.get? (by simpa using hfield) + simp only [hfield, Except.ok.injEq] at hrun + subst leftOut + refine ⟨(right, rightValue), ?_, heap, + HeapHistoryIso.Extends.refl, hvalue⟩ + have hrightFieldArray : + rightFields[field]? = some rightValue := by + simpa using hrightField + simp [hrightFieldArray] + | call function arguments => + rw [IxIR1.runOp.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hleft : resolveAtoms leftEnvironment arguments with + | error error => + rw [hleft] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok leftValues => + obtain ⟨rightValues, hright, hvalues⟩ := + resolveAtoms_historyIso henvironment hleft + rw [hleft] at hrun + rw [hright] + simp only [bind, Except.bind] at hrun ⊢ + exact smaller.invoke ctx function leftValues rightValues left right + heap hvalues leftOut hrun + | callSelf arguments => + rw [IxIR1.runOp.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hleft : resolveAtoms leftEnvironment arguments with + | error error => + rw [hleft] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok leftValues => + obtain ⟨rightValues, hright, hvalues⟩ := + resolveAtoms_historyIso henvironment hleft + rw [hleft] at hrun + rw [hright] + simp only [bind, Except.bind] at hrun ⊢ + have hlength := hvalues.lengths + by_cases harity : leftValues.length = current.arity + · have hrightArity : rightValues.length = current.arity := by + rw [← hlength] + exact harity + simp [harity] at hrun + cases hbody : IxIR1.runCode ctx fuel current left + leftValues.reverse current.body with + | error error => + rw [hbody] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok bodyOut => + rw [hbody] at hrun + simp only [bind, Except.bind] at hrun + have hout := (checkResultWorld_ok hrun).1 + subst leftOut + obtain ⟨rightBodyOut, hrightBody, bodyHeap, + hext, hvalue⟩ := + smaller.runCode ctx current left right heap + leftValues.reverse rightValues.reverse hvalues.reverse + current.body bodyOut hbody + rcases bodyOut with ⟨bodyStore, bodyValue⟩ + rcases rightBodyOut with + ⟨rightBodyStore, rightBodyValue⟩ + have hrightWorld := checkResultWorld_historyIso bodyHeap + hvalue current.result hrun + refine ⟨_, ?_, bodyHeap, hext, hvalue⟩ + simp [hrightArity, hrightBody, hrightWorld] + · have hrightArity : rightValues.length ≠ current.arity := by + intro heq + exact harity (hlength.trans heq) + simp [harity, hrightArity] at hrun + | papp function arguments => + rw [IxIR1.runOp.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hleft : resolveAtoms leftEnvironment arguments with + | error error => + rw [hleft] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok leftValues => + obtain ⟨rightValues, hright, hvalues⟩ := + resolveAtoms_historyIso henvironment hleft + rw [hleft] at hrun + rw [hright] + simp only [bind, Except.bind] at hrun ⊢ + cases hdecl : ctx.decls function with + | none => simp [hdecl] at hrun + | some declaration => + simp only [hdecl] at hrun ⊢ + by_cases hunder : leftValues.length < declArity declaration + · have hrightUnder : + rightValues.length < declArity declaration := by + rw [← hvalues.lengths] + exact hunder + simp only [hunder, hrightUnder, if_true, + Except.ok.injEq] at hrun ⊢ + subst leftOut + let next := heap.alloc (world := .shared) + (leftNode := .papN function (declArity declaration) + leftValues.toArray) + (rightNode := .papN function (declArity declaration) + rightValues.toArray) + (.pap (by simpa using hvalues)) + exact ⟨_, rfl, next, (fun h => .inr h), + .loc (.inl ⟨rfl, rfl⟩)⟩ + · simp [hunder] at hrun + | apply function arguments => + rw [IxIR1.runOp.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hleftFunction : resolveAtom leftEnvironment function with + | error error => + rw [hleftFunction] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok leftFunction => + obtain ⟨rightFunction, hrightFunction, hfunction⟩ := + resolveAtom_historyIso henvironment hleftFunction + rw [hleftFunction] at hrun + rw [hrightFunction] + simp only [bind, Except.bind] at hrun ⊢ + cases hleftArgs : resolveAtoms leftEnvironment arguments with + | error error => + rw [hleftArgs] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok leftValues => + obtain ⟨rightValues, hrightArgs, hvalues⟩ := + resolveAtoms_historyIso henvironment hleftArgs + rw [hleftArgs] at hrun + rw [hrightArgs] + simp only [bind, Except.bind] at hrun ⊢ + exact smaller.applyGo ctx left right heap leftFunction + rightFunction leftValues rightValues hfunction hvalues + leftOut hrun + | extern function arguments => + rw [IxIR1.runOp.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hleft : resolveAtoms leftEnvironment arguments with + | error error => + rw [hleft] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok leftValues => + obtain ⟨rightValues, hright, hvalues⟩ := + resolveAtoms_historyIso henvironment hleft + rw [hleft] at hrun + rw [hright] + simp only [bind, Except.bind] at hrun ⊢ + cases horacle : callScalarOracle ctx function leftValues with + | error error => + rw [horacle] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok leftValue => + rw [horacle] at hrun + simp only [bind, Except.bind, Except.ok.injEq] at hrun + subst leftOut + obtain ⟨rightValue, hrightOracle, hvalue⟩ := + callScalarOracle_historyIso hvalues horacle + rw [hrightOracle] + exact ⟨_, rfl, heap, HeapHistoryIso.Extends.refl, hvalue⟩ + +private theorem invoke_historyIsoStep {fuel : Nat} + (smaller : EvalHistoryIsoAt fuel) : + ∀ (ctx : Ctx) (function : Ix.Compiler.Ixon.Address) + (leftArguments rightArguments : List RVal) + (left right : Store) (heap : HeapHistoryIso left right), + RValsIso heap.locRel leftArguments rightArguments → + ∀ (leftOut : Store × RVal), + IxIR1.invoke ctx (fuel + 1) function leftArguments left = .ok leftOut → + ∃ rightOut, + IxIR1.invoke ctx (fuel + 1) function rightArguments right = + .ok rightOut ∧ + RunHistoryIso heap leftOut rightOut := by + intro ctx function leftArguments rightArguments left right heap + harguments leftOut hrun + rw [IxIR1.invoke.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hdecl : ctx.decls function with + | none => simp [hdecl] at hrun + | some declaration => + simp only [hdecl] at hrun ⊢ + cases declaration with + | extern arity => + have hlength := harguments.lengths + by_cases hsame : leftArguments.length = arity + · have hrightSame : rightArguments.length = arity := by + rw [← hlength] + exact hsame + simp [hsame] at hrun + cases horacle : callScalarOracle ctx function leftArguments with + | error error => + rw [horacle] at hrun + contradiction + | ok leftValue => + rw [horacle] at hrun + injection hrun with hout + subst leftOut + obtain ⟨rightValue, hrightOracle, hvalue⟩ := + callScalarOracle_historyIso harguments horacle + refine ⟨(right, rightValue), ?_, heap, + HeapHistoryIso.Extends.refl, hvalue⟩ + simp [hrightSame, hrightOracle] + · have hrightSame : rightArguments.length ≠ arity := by + intro heq + exact hsame (hlength.trans heq) + simp [hsame] at hrun + | fn definition => + have hlength := harguments.lengths + by_cases hsame : leftArguments.length = definition.arity + · have hrightSame : + rightArguments.length = definition.arity := by + rw [← hlength] + exact hsame + simp [hsame] at hrun + cases hbody : IxIR1.runCode ctx fuel definition left + leftArguments.reverse definition.body with + | error error => + rw [hbody] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok bodyOut => + rw [hbody] at hrun + simp only [bind, Except.bind] at hrun + have hout := (checkResultWorld_ok hrun).1 + subst leftOut + obtain ⟨rightBodyOut, hrightBody, bodyHeap, + hext, hvalue⟩ := + smaller.runCode ctx definition left right heap + leftArguments.reverse rightArguments.reverse + harguments.reverse definition.body bodyOut hbody + rcases bodyOut with ⟨bodyStore, bodyValue⟩ + rcases rightBodyOut with + ⟨rightBodyStore, rightBodyValue⟩ + have hrightWorld := checkResultWorld_historyIso bodyHeap + hvalue definition.result hrun + refine ⟨_, ?_, bodyHeap, hext, hvalue⟩ + simp [hrightSame, hrightBody] + simpa only [bind, Except.bind] using hrightWorld + · have hrightSame : + rightArguments.length ≠ definition.arity := by + intro heq + exact hsame (hlength.trans heq) + simp [hsame] at hrun + +private theorem applyGo_historyIsoStep {fuel : Nat} + (smaller : EvalHistoryIsoAt fuel) : + ∀ (ctx : Ctx) (left right : Store) + (heap : HeapHistoryIso left right) + (leftFunction rightFunction : RVal) + (leftArguments rightArguments : List RVal), + RValIso heap.locRel leftFunction rightFunction → + RValsIso heap.locRel leftArguments rightArguments → + ∀ (leftOut : Store × RVal), + IxIR1.applyGo ctx (fuel + 1) left leftFunction leftArguments = + .ok leftOut → + ∃ rightOut, + IxIR1.applyGo ctx (fuel + 1) right rightFunction rightArguments = + .ok rightOut ∧ + RunHistoryIso heap leftOut rightOut := by + intro ctx left right heap leftFunction rightFunction leftArguments + rightArguments hfunction harguments leftOut hrun + rw [IxIR1.applyGo.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hfunction with + | lit => simp at hrun + | erased => + cases hdrop : IxIR1.dropMany ctx fuel left leftArguments with + | error error => + rw [hdrop] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok nextLeft => + rw [hdrop] at hrun + simp only [bind, Except.bind, Except.ok.injEq] at hrun + subst leftOut + obtain ⟨nextRight, hrightDrop, nextHeap, hext⟩ := + smaller.dropMany ctx left right heap leftArguments rightArguments + harguments nextLeft hdrop + rw [hrightDrop] + exact ⟨_, rfl, nextHeap, hext, .erased⟩ + | @loc leftLoc rightLoc hrel => + cases hleftBox : left.get? leftLoc with + | none => simp [hleftBox] at hrun + | some leftBox => + obtain ⟨rightBox, hrightBox, hbox⟩ := + heap.boxes hrel hleftBox + rcases leftBox with ⟨leftWorld, leftRc, leftNode⟩ + rcases rightBox with ⟨rightWorld, rightRc, rightNode⟩ + rcases hbox with ⟨hworld, hrc, hnode⟩ + change leftWorld = rightWorld at hworld + change leftRc = rightRc at hrc + change NodeIso heap.locRel leftNode rightNode at hnode + subst rightWorld + subst rightRc + simp only [hleftBox] at hrun + simp only [hrightBox] + cases hnode with + | ctor hfields => simp at hrun + | @pap function arity leftCaptured rightCaptured hcaptured => + dsimp only at hrun ⊢ + cases hdup : dupVals left leftCaptured.toList with + | error error => + rw [hdup] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok duplicatedLeft => + rw [hdup] at hrun + simp only [bind, Except.bind] at hrun + obtain ⟨duplicatedRight, hrightDup, duplicateHeap, + hentryDuplicate⟩ := + dupVals_historyIso heap hcaptured hdup + cases hdrop : IxIR1.dropVal ctx fuel duplicatedLeft + (.loc leftLoc) with + | error error => + rw [hdrop] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok readyLeft => + rw [hdrop] at hrun + simp only [bind, Except.bind] at hrun + obtain ⟨readyRight, hrightDrop, readyHeap, + hduplicateReady⟩ := + smaller.dropVal ctx duplicatedLeft duplicatedRight + duplicateHeap (.loc leftLoc) (.loc rightLoc) + (hentryDuplicate.rval (.loc hrel)) readyLeft hdrop + let hentryReady : heap.Extends readyHeap := + HeapHistoryIso.Extends.trans hentryDuplicate + hduplicateReady + let leftTotal := leftCaptured.toList ++ leftArguments + let rightTotal := rightCaptured.toList ++ rightArguments + let htotal : RValsIso readyHeap.locRel + leftTotal rightTotal := + (hentryReady.rvals hcaptured).append + (hentryReady.rvals harguments) + have hlength : leftTotal.length = rightTotal.length := + htotal.lengths + by_cases hunder : leftTotal.length < arity + · have hrightUnder : rightTotal.length < arity := by + rw [← hlength] + exact hunder + have hunderRaw : + (leftCaptured.toList ++ leftArguments).length < + arity := by + simpa [leftTotal] using hunder + have hunderSize : + leftCaptured.size + leftArguments.length < + arity := by + simpa [leftTotal] using hunder + have hrightUnderRaw : + (rightCaptured.toList ++ rightArguments).length < + arity := by + simpa [rightTotal] using hrightUnder + have hrightUnderSize : + rightCaptured.size + rightArguments.length < + arity := by + simpa [rightTotal] using hrightUnder + simp only [hunderRaw, if_true, + Except.ok.injEq] at hrun + subst leftOut + let next := readyHeap.alloc (world := .shared) + (leftNode := .papN function arity + leftTotal.toArray) + (rightNode := .papN function arity + rightTotal.toArray) + (.pap (by simpa using htotal)) + have hreadyNext : readyHeap.Extends next := by + intro l r hknown + change (l = readyLeft.nodes.size ∧ + r = readyRight.nodes.size) ∨ + readyHeap.locRel l r + exact .inr hknown + have hfresh : RValIso next.locRel + (.loc readyLeft.nodes.size) + (.loc readyRight.nodes.size) := by + apply RValIso.loc + change (readyLeft.nodes.size = readyLeft.nodes.size ∧ + readyRight.nodes.size = readyRight.nodes.size) ∨ + readyHeap.locRel _ _ + exact .inl ⟨rfl, rfl⟩ + let rightAllocated := readyRight.allocNode .shared + (.papN function arity rightTotal.toArray) + refine ⟨(rightAllocated.1, + .loc rightAllocated.2), ?_, next, + hentryReady.trans hreadyNext, ?_⟩ + · rw [hrightDup] + simp only [bind, Except.bind] + rw [hrightDrop] + simp only [bind, Except.bind] + simp [rightTotal, rightAllocated, + hrightUnderSize] + · simpa [leftTotal, rightTotal, rightAllocated, + Store.allocNode] using hfresh + · have hrightUnder : ¬ rightTotal.length < arity := by + intro hlt + exact hunder (lt_of_eq_of_lt hlength hlt) + by_cases hexact : leftTotal.length = arity + · have hrightExact : rightTotal.length = arity := by + rw [← hlength] + exact hexact + have hunderRaw : + ¬ (leftCaptured.toList ++ + leftArguments).length < arity := by + simpa [leftTotal] using hunder + have hexactRaw : + (leftCaptured.toList ++ + leftArguments).length = arity := by + simpa [leftTotal] using hexact + have hrightUnderRaw : + ¬ (rightCaptured.toList ++ + rightArguments).length < arity := by + simpa [rightTotal] using hrightUnder + have hrightExactRaw : + (rightCaptured.toList ++ + rightArguments).length = arity := by + simpa [rightTotal] using hrightExact + have hunderSize : + ¬ leftCaptured.size + leftArguments.length < + arity := by + simpa [leftTotal] using hunder + have hexactSize : + leftCaptured.size + leftArguments.length = + arity := by + simpa [leftTotal] using hexact + have hrightUnderSize : + ¬ rightCaptured.size + rightArguments.length < + arity := by + simpa [rightTotal] using hrightUnder + have hrightExactSize : + rightCaptured.size + rightArguments.length = + arity := by + simpa [rightTotal] using hrightExact + obtain ⟨definition, hdecl, hpapsafe⟩ : + ∃ definition, + ctx.decls function = some definition ∧ + declPapSafe definition = true := by + cases hdecl : ctx.decls function with + | none => + simp [hunderSize, hexactSize, hdecl] at hrun + | some definition => + cases hpapsafe : declPapSafe definition with + | false => + simp [hunderSize, hexactSize, hdecl, + hpapsafe] at hrun + | true => exact ⟨definition, rfl, hpapsafe⟩ + simp [hunderSize, hexactSize, hdecl, + hpapsafe] at hrun + have hrunInvoke : IxIR1.invoke ctx fuel function + leftTotal readyLeft = .ok leftOut := by + simpa [leftTotal] using hrun + obtain ⟨rightOut, hrightInvoke, finalHeap, + hreadyFinal, hvalue⟩ := + smaller.invoke ctx function leftTotal rightTotal + readyLeft readyRight readyHeap htotal leftOut + hrunInvoke + refine ⟨rightOut, ?_, finalHeap, + hentryReady.trans hreadyFinal, hvalue⟩ + rw [hrightDup] + simp only [bind, Except.bind] + rw [hrightDrop] + simp only [bind, Except.bind] + simpa [rightTotal, hrightUnderSize, + hrightExactSize, hdecl, hpapsafe] using hrightInvoke + · have hrightExact : rightTotal.length ≠ arity := by + intro heq + exact hexact (hlength.trans heq) + have hunderRaw : + ¬ (leftCaptured.toList ++ + leftArguments).length < arity := by + simpa [leftTotal] using hunder + have hexactRaw : + (leftCaptured.toList ++ + leftArguments).length ≠ arity := by + simpa [leftTotal] using hexact + have hrightUnderRaw : + ¬ (rightCaptured.toList ++ + rightArguments).length < arity := by + simpa [rightTotal] using hrightUnder + have hrightExactRaw : + (rightCaptured.toList ++ + rightArguments).length ≠ arity := by + simpa [rightTotal] using hrightExact + have hunderSize : + ¬ leftCaptured.size + leftArguments.length < + arity := by + simpa [leftTotal] using hunder + have hexactSize : + leftCaptured.size + leftArguments.length ≠ + arity := by + simpa [leftTotal] using hexact + have hrightUnderSize : + ¬ rightCaptured.size + rightArguments.length < + arity := by + simpa [rightTotal] using hrightUnder + have hrightExactSize : + rightCaptured.size + rightArguments.length ≠ + arity := by + simpa [rightTotal] using hrightExact + obtain ⟨definition, hdecl, hpapsafe⟩ : + ∃ definition, + ctx.decls function = some definition ∧ + declPapSafe definition = true := by + cases hdecl : ctx.decls function with + | none => + simp [hunderSize, hexactSize, hdecl] at hrun + | some definition => + cases hpapsafe : declPapSafe definition with + | false => + simp [hunderSize, hexactSize, hdecl, + hpapsafe] at hrun + | true => exact ⟨definition, rfl, hpapsafe⟩ + simp [hunderSize, hexactSize, hdecl, + hpapsafe] at hrun + cases hinvoke : IxIR1.invoke ctx fuel function + (leftTotal.take arity) readyLeft with + | error error => + rw [hinvoke] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok calledLeft => + rw [hinvoke] at hrun + simp only [bind, Except.bind] at hrun + obtain ⟨calledRight, hrightInvoke, calledHeap, + hreadyCalled, hcalledValue⟩ := + smaller.invoke ctx function + (leftTotal.take arity) + (rightTotal.take arity) readyLeft readyRight + readyHeap (htotal.take arity) calledLeft + hinvoke + rcases calledLeft with + ⟨calledLeftStore, calledLeftValue⟩ + rcases calledRight with + ⟨calledRightStore, calledRightValue⟩ + have hrunApply : IxIR1.applyGo ctx fuel + calledLeftStore calledLeftValue + (leftTotal.drop arity) = .ok leftOut := by + simpa [leftTotal] using hrun + obtain ⟨rightOut, hrightApply, finalHeap, + hcalledFinal, hresult⟩ := + smaller.applyGo ctx calledLeftStore + calledRightStore calledHeap calledLeftValue + calledRightValue (leftTotal.drop arity) + (rightTotal.drop arity) hcalledValue + (hreadyCalled.rvals (htotal.drop arity)) + leftOut hrunApply + refine ⟨rightOut, ?_, finalHeap, + hentryReady.trans + (hreadyCalled.trans hcalledFinal), hresult⟩ + rw [hrightDup] + simp only [bind, Except.bind] + rw [hrightDrop] + simp only [bind, Except.bind] + simp [hrightUnderSize, hrightExactSize, hdecl, + hpapsafe] + rw [hrightInvoke] + simp only [bind, Except.bind] + exact hrightApply + +private theorem evalHistoryIsoAt : ∀ fuel, EvalHistoryIsoAt fuel := by + intro fuel + induction fuel with + | zero => + constructor <;> intros <;> + simp [IxIR1.runCode, IxIR1.runOp, IxIR1.invoke, IxIR1.applyGo, + IxIR1.dropVal, IxIR1.dropMany, IxIR1.dropUVal, + IxIR1.dropManyU] at * + | succ fuel smaller => + let drops := dropHistoryIsoAt (fuel + 1) + exact ⟨runCode_historyIsoStep smaller, + runOp_historyIsoStep smaller, + invoke_historyIsoStep smaller, + applyGo_historyIsoStep smaller, + drops.dropVal, drops.dropMany, drops.dropUVal, drops.dropManyU⟩ + +/-- Successful code evaluation commutes with a heap-history isomorphism. +Concrete allocation indices and cost counters may differ, while every live +result and every older related root remains paired. -/ +theorem runCode_historyIso {ctx : Ctx} {fuel : Nat} {current : FnDef} + {left right : Store} (heap : HeapHistoryIso left right) + {leftEnvironment rightEnvironment : List RVal} + (henvironment : RValsIso heap.locRel + leftEnvironment rightEnvironment) + {input : Code} {leftOut : Store × RVal} + (hrun : IxIR1.runCode ctx fuel current left leftEnvironment input = + .ok leftOut) : + ∃ rightOut, + IxIR1.runCode ctx fuel current right rightEnvironment input = + .ok rightOut ∧ + RunHistoryIso heap leftOut rightOut := + (evalHistoryIsoAt fuel).runCode ctx current left right heap leftEnvironment + rightEnvironment henvironment input leftOut hrun + +theorem runOp_historyIso {ctx : Ctx} {fuel : Nat} {current : FnDef} + {left right : Store} (heap : HeapHistoryIso left right) + {leftEnvironment rightEnvironment : List RVal} + (henvironment : RValsIso heap.locRel + leftEnvironment rightEnvironment) + {operation : Op} {leftOut : Store × RVal} + (hrun : IxIR1.runOp ctx fuel current left leftEnvironment operation = + .ok leftOut) : + ∃ rightOut, + IxIR1.runOp ctx fuel current right rightEnvironment operation = + .ok rightOut ∧ + RunHistoryIso heap leftOut rightOut := + (evalHistoryIsoAt fuel).runOp ctx current left right heap leftEnvironment + rightEnvironment henvironment operation leftOut hrun + +theorem invoke_historyIso {ctx : Ctx} {fuel : Nat} + {function : Ix.Compiler.Ixon.Address} + {leftArguments rightArguments : List RVal} + {left right : Store} (heap : HeapHistoryIso left right) + (harguments : RValsIso heap.locRel leftArguments rightArguments) + {leftOut : Store × RVal} + (hrun : IxIR1.invoke ctx fuel function leftArguments left = .ok leftOut) : + ∃ rightOut, + IxIR1.invoke ctx fuel function rightArguments right = .ok rightOut ∧ + RunHistoryIso heap leftOut rightOut := + (evalHistoryIsoAt fuel).invoke ctx function leftArguments rightArguments + left right heap harguments leftOut hrun + +theorem applyGo_historyIso {ctx : Ctx} {fuel : Nat} + {left right : Store} (heap : HeapHistoryIso left right) + {leftFunction rightFunction : RVal} + {leftArguments rightArguments : List RVal} + (hfunction : RValIso heap.locRel leftFunction rightFunction) + (harguments : RValsIso heap.locRel leftArguments rightArguments) + {leftOut : Store × RVal} + (hrun : IxIR1.applyGo ctx fuel left leftFunction leftArguments = + .ok leftOut) : + ∃ rightOut, + IxIR1.applyGo ctx fuel right rightFunction rightArguments = + .ok rightOut ∧ + RunHistoryIso heap leftOut rightOut := + (evalHistoryIsoAt fuel).applyGo ctx left right heap leftFunction + rightFunction leftArguments rightArguments hfunction harguments leftOut + hrun + +theorem dropVal_historyIso {ctx : Ctx} {fuel : Nat} + {left right : Store} (heap : HeapHistoryIso left right) + {leftValue rightValue : RVal} + (hvalue : RValIso heap.locRel leftValue rightValue) + {leftOut : Store} + (hrun : IxIR1.dropVal ctx fuel left leftValue = .ok leftOut) : + ∃ rightOut, + IxIR1.dropVal ctx fuel right rightValue = .ok rightOut ∧ + StoreHistoryIso heap leftOut rightOut := + (dropHistoryIsoAt fuel).dropVal ctx left right heap leftValue rightValue + hvalue leftOut hrun + +/-- Unique deep destruction commutes with allocation-history isomorphism. -/ +theorem dropUVal_historyIso {ctx : Ctx} {fuel : Nat} + {left right : Store} (heap : HeapHistoryIso left right) + {leftValue rightValue : RVal} + (hvalue : RValIso heap.locRel leftValue rightValue) + {leftOut : Store} + (hrun : IxIR1.dropUVal ctx fuel left leftValue = .ok leftOut) : + ∃ rightOut, + IxIR1.dropUVal ctx fuel right rightValue = .ok rightOut ∧ + StoreHistoryIso heap leftOut rightOut := + (dropHistoryIsoAt fuel).dropUVal ctx left right heap leftValue rightValue + hvalue leftOut hrun +end Ix.Compiler.IxIR1.Sim diff --git a/Ix/Compiler/IxIR1/EvalRewrite.lean b/Ix/Compiler/IxIR1/EvalRewrite.lean new file mode 100644 index 000000000..d7652f726 --- /dev/null +++ b/Ix/Compiler/IxIR1/EvalRewrite.lean @@ -0,0 +1,1857 @@ +import Ix.Compiler.IxIR1.EvalIso + +/-! +# Evaluator refinement under an abstract declaration environment + +An owner-sensitive optimization changes stored function bodies while leaving +the calling convention stable. This module isolates the recursive evaluator +argument needed to lift such a local body theorem through direct calls, +`callSelf`, PAP application, and arbitrary surrounding code. + +The abstraction is deliberately semantic. It does not require a particular +declaration map implementation or a syntactic rewrite function: each source +function lookup supplies a target function with the same arity, result world, +and PAP-entry policy, plus a local successful-run refinement in the source +context. The +common fuel induction below is therefore reusable by every body optimizer and +by the old-keyed logical environment that precedes content readdressing. +-/ + +namespace Ix.Compiler.IxIR1.Sim + +open Ix.Compiler.Ixon (Address) + +/-- Local semantic obligation for one rewritten function body. Both runs use +the source declaration context; the general evaluator traversal is responsible +for replacing recursive callees afterward. -/ +def FunctionBodyRefines (ctx : Ctx) (source target : FnDef) : Prop := + ∀ {fuel : Nat} {store : Store} {environment : List RVal} + {sourceOut : Store × RVal} + (base : HeapHistoryIso store store), + environment.length = source.arity → + RValsIso base.locRel environment environment → + runCode ctx fuel source store environment source.body = .ok sourceOut → + ∃ targetOut, + runCode ctx fuel target store environment target.body = .ok targetOut ∧ + RunHistoryIso base sourceOut targetOut + +/-- The non-recursive obligation supplied by a body optimizer. The rewritten +body still runs under the source current frame; `FunctionBodyRefines.ofStatic` +below closes the recursive `callSelf` fixed point and installs `target` as the +dynamic frame. -/ +def StaticFunctionBodyRefines (ctx : Ctx) (source target : FnDef) : Prop := + ∀ {fuel : Nat} {store : Store} {environment : List RVal} + {sourceOut : Store × RVal} + (base : HeapHistoryIso store store), + environment.length = source.arity → + RValsIso base.locRel environment environment → + runCode ctx fuel source store environment source.body = .ok sourceOut → + ∃ targetOut, + runCode ctx fuel source store environment target.body = .ok targetOut ∧ + RunHistoryIso base sourceOut targetOut + +/-- One-way logical relation between evaluator declaration environments. +Extra target declarations are harmless: only successful source lookups need a +matching target. -/ +structure AbstractEnvironment (before after : Ctx) : Prop where + oracle_eq : after.oracle = before.oracle + extern : ∀ {address : Address} {arity : Nat}, + before.decls address = some (.extern arity) → + after.decls address = some (.extern arity) + function : ∀ {address : Address} {source : FnDef}, + before.decls address = some (.fn source) → + ∃ target : FnDef, + after.decls address = some (.fn target) ∧ + target.arity = source.arity ∧ + target.result = source.result ∧ + target.papSafe = source.papSafe ∧ + FunctionBodyRefines before source target + +/-- Strong body obligation for rewrites which preserve the complete evaluator +result, including errors, stores, counters, and allocation identities. -/ +def FunctionBodyEq (ctx : Ctx) (source target : FnDef) : Prop := + ∀ {fuel : Nat} {store : Store} {environment : List RVal}, + environment.length = source.arity → + runCode ctx fuel target store environment target.body = + runCode ctx fuel source store environment source.body + +/-- Exact declaration-environment replacement. Source misses remain misses; +externs are unchanged; and every source function maps to a calling-convention +compatible target whose body is exactly equivalent in the source context. -/ +structure ExactEnvironment (before after : Ctx) : Prop where + oracle_eq : after.oracle = before.oracle + missing : ∀ {address : Address}, before.decls address = none → + after.decls address = none + extern : ∀ {address : Address} {arity : Nat}, + before.decls address = some (.extern arity) → + after.decls address = some (.extern arity) + function : ∀ {address : Address} {source : FnDef}, + before.decls address = some (.fn source) → + ∃ target : FnDef, + after.decls address = some (.fn target) ∧ + target.arity = source.arity ∧ + target.result = source.result ∧ + target.papSafe = source.papSafe ∧ + FunctionBodyEq before source target + +namespace AbstractEnvironment + +theorem declaration {before after : Ctx} + (environment : AbstractEnvironment before after) + {address : Address} {source : Decl} + (hsource : before.decls address = some source) : + ∃ target, + after.decls address = some target ∧ + declArity target = declArity source ∧ + declPapSafe target = declPapSafe source := by + cases source with + | extern arity => + exact ⟨.extern arity, environment.extern hsource, rfl, rfl⟩ + | fn source => + obtain ⟨target, htarget, harity, _, hpapsafe, _⟩ := + environment.function hsource + exact ⟨.fn target, htarget, harity, hpapsafe⟩ + +end AbstractEnvironment + +private structure DropCtxEqAt (before after : Ctx) (fuel : Nat) : Prop where + dropVal : ∀ (store : Store) (value : RVal), + dropVal after fuel store value = dropVal before fuel store value + dropMany : ∀ (store : Store) (values : List RVal), + dropMany after fuel store values = dropMany before fuel store values + dropUVal : ∀ (store : Store) (value : RVal), + dropUVal after fuel store value = dropUVal before fuel store value + dropManyU : ∀ (store : Store) (values : List RVal), + dropManyU after fuel store values = dropManyU before fuel store values + +private theorem dropCtxEqAt (before after : Ctx) : + ∀ fuel, DropCtxEqAt before after fuel := by + intro fuel + induction fuel with + | zero => + constructor <;> intros <;> + simp [dropVal, dropMany, dropUVal, dropManyU] + | succ fuel smaller => + constructor + · intro store value + cases value with + | lit literal => simp [dropVal] + | erased => simp [dropVal] + | loc location => + simp only [dropVal] + cases hbox : store.get? location with + | none => simp + | some box => + simp only + cases hworld : box.world with + | unique => simp + | shared => + simp only + by_cases hone : box.rc == 1 + · simp only [hone, if_true] + cases hnode : box.node with + | ctorN identity fields => + simpa [hnode] using smaller.dropMany + (store.rcTick.kill location) fields.toList + | papN function arity arguments => + simpa [hnode] using smaller.dropMany + (store.rcTick.kill location) arguments.toList + · simp [hone] + · intro store values + cases values with + | nil => simp [dropMany] + | cons value rest => + simp only [dropMany] + rw [smaller.dropVal store value] + cases hdrop : dropVal before fuel store value with + | error error => rfl + | ok next => exact smaller.dropMany next rest + · intro store value + cases value with + | lit literal => simp [dropUVal] + | erased => simp [dropUVal] + | loc location => + simp only [dropUVal] + cases hbox : store.get? location with + | none => simp + | some box => + simp only + cases hworld : box.world with + | shared => simp + | unique => + simp only + cases hnode : box.node with + | ctorN identity fields => + simpa [hnode] using smaller.dropManyU + (store.kill location) fields.toList + | papN function arity arguments => simp + · intro store values + cases values with + | nil => simp [dropManyU] + | cons value rest => + simp only [dropManyU] + rw [smaller.dropUVal store value] + cases hdrop : dropUVal before fuel store value with + | error error => rfl + | ok next => exact smaller.dropManyU next rest + +/-- Deep shared destruction is independent of the declaration environment and +oracle stored in the evaluator context. -/ +theorem dropVal_ctx_eq (before after : Ctx) (fuel : Nat) + (store : Store) (value : RVal) : + dropVal after fuel store value = dropVal before fuel store value := + (dropCtxEqAt before after fuel).dropVal store value + +/-- Pointwise shared destruction is independent of the evaluator context. -/ +theorem dropMany_ctx_eq (before after : Ctx) (fuel : Nat) + (store : Store) (values : List RVal) : + dropMany after fuel store values = dropMany before fuel store values := + (dropCtxEqAt before after fuel).dropMany store values + +/-- Deep unique destruction is independent of the declaration environment and +oracle stored in the evaluator context. -/ +theorem dropUVal_ctx_eq (before after : Ctx) (fuel : Nat) + (store : Store) (value : RVal) : + dropUVal after fuel store value = dropUVal before fuel store value := + (dropCtxEqAt before after fuel).dropUVal store value + +/-- Pointwise unique destruction is independent of the evaluator context. -/ +theorem dropManyU_ctx_eq (before after : Ctx) (fuel : Nat) + (store : Store) (values : List RVal) : + dropManyU after fuel store values = dropManyU before fuel store values := + (dropCtxEqAt before after fuel).dropManyU store values + +/-- The context-changing part of the evaluator theorem. Entry stores and +values are literally shared; `base` supplies the self-history needed when a +body rewrite removes allocations and later locations drift. -/ +private structure EvalRewriteAt (before after : Ctx) (fuel : Nat) : Prop where + runCode : ∀ (current : FnDef) (store : Store) + (base : HeapHistoryIso store store) (environment : List RVal), + RValsIso base.locRel environment environment → + ∀ (input : Code) (sourceOut : Store × RVal), + runCode before fuel current store environment input = .ok sourceOut → + ∃ targetOut, + runCode after fuel current store environment input = .ok targetOut ∧ + RunHistoryIso base sourceOut targetOut + runOp : ∀ (current : FnDef) (store : Store) + (base : HeapHistoryIso store store) (environment : List RVal), + RValsIso base.locRel environment environment → + ∀ (operation : Op) (sourceOut : Store × RVal), + runOp before fuel current store environment operation = .ok sourceOut → + ∃ targetOut, + runOp after fuel current store environment operation = .ok targetOut ∧ + RunHistoryIso base sourceOut targetOut + invoke : ∀ (function : Address) (arguments : List RVal) (store : Store) + (base : HeapHistoryIso store store), + RValsIso base.locRel arguments arguments → + ∀ (sourceOut : Store × RVal), + IxIR1.invoke before fuel function arguments store = .ok sourceOut → + ∃ targetOut, + IxIR1.invoke after fuel function arguments store = .ok targetOut ∧ + RunHistoryIso base sourceOut targetOut + applyGo : ∀ (store : Store) (base : HeapHistoryIso store store) + (function : RVal) (arguments : List RVal), + RValIso base.locRel function function → + RValsIso base.locRel arguments arguments → + ∀ (sourceOut : Store × RVal), + IxIR1.applyGo before fuel store function arguments = .ok sourceOut → + ∃ targetOut, + IxIR1.applyGo after fuel store function arguments = .ok targetOut ∧ + RunHistoryIso base sourceOut targetOut + +private theorem selfRight_extends_compose + {left right : Store} (heap : HeapHistoryIso left right) : + heap.Extends (heap.trans (heap.symm.trans heap)) := by + intro leftLoc rightLoc hrel + exact ⟨rightLoc, hrel, leftLoc, hrel, hrel⟩ + +private theorem selfLeft_compose_extends + {store : Store} (base : HeapHistoryIso store store) : + base.Extends ((base.trans base.symm).trans base) := by + intro leftLoc rightLoc hrel + exact ⟨leftLoc, ⟨rightLoc, hrel, hrel⟩, hrel⟩ + +private theorem runCode_crossOfSame + {before after : Ctx} {fuel : Nat} + (same : EvalRewriteAt before after fuel) + {current : FnDef} {left right : Store} + (heap : HeapHistoryIso left right) + {leftEnvironment rightEnvironment : List RVal} + (henvironments : RValsIso heap.locRel + leftEnvironment rightEnvironment) + {input : Code} {sourceOut : Store × RVal} + (hrun : runCode before fuel current left leftEnvironment input = + .ok sourceOut) : + ∃ targetOut, + runCode after fuel current right rightEnvironment input = .ok targetOut ∧ + RunHistoryIso heap sourceOut targetOut := by + obtain ⟨middleOut, hmiddle, hsourceMiddle⟩ := + runCode_historyIso heap henvironments hrun + let self := heap.symm.trans heap + have hselfEnvironment : RValsIso self.locRel + rightEnvironment rightEnvironment := by + exact henvironments.symm.trans henvironments + obtain ⟨targetOut, htarget, hmiddleTarget⟩ := + same.runCode current right self rightEnvironment hselfEnvironment input + middleOut hmiddle + exact ⟨targetOut, htarget, + RunHistoryIso.weaken (selfRight_extends_compose heap) + (hsourceMiddle.trans hmiddleTarget)⟩ + +private theorem applyGo_crossOfSame + {before after : Ctx} {fuel : Nat} + (same : EvalRewriteAt before after fuel) + {left right : Store} (heap : HeapHistoryIso left right) + {leftFunction rightFunction : RVal} + {leftArguments rightArguments : List RVal} + (hfunction : RValIso heap.locRel leftFunction rightFunction) + (harguments : RValsIso heap.locRel leftArguments rightArguments) + {sourceOut : Store × RVal} + (hrun : IxIR1.applyGo before fuel left leftFunction leftArguments = + .ok sourceOut) : + ∃ targetOut, + IxIR1.applyGo after fuel right rightFunction rightArguments = + .ok targetOut ∧ + RunHistoryIso heap sourceOut targetOut := by + obtain ⟨middleOut, hmiddle, hsourceMiddle⟩ := + applyGo_historyIso heap hfunction harguments hrun + let self := heap.symm.trans heap + have hselfFunction : RValIso self.locRel rightFunction rightFunction := + hfunction.symm.trans hfunction + have hselfArguments : RValsIso self.locRel + rightArguments rightArguments := harguments.symm.trans harguments + obtain ⟨targetOut, htarget, hmiddleTarget⟩ := + same.applyGo right self rightFunction rightArguments hselfFunction + hselfArguments middleOut hmiddle + exact ⟨targetOut, htarget, + RunHistoryIso.weaken (selfRight_extends_compose heap) + (hsourceMiddle.trans hmiddleTarget)⟩ + +private theorem resolveAtom_selfIso + {rel : Nat → Nat → Prop} {environment : List RVal} + (henvironment : RValsIso rel environment environment) + {atom : Atom} {value : RVal} + (hresolve : resolveAtom environment atom = .ok value) : + RValIso rel value value := by + obtain ⟨rightValue, hright, hvalue⟩ := + resolveAtom_historyIso henvironment hresolve + have heq : rightValue = value := Except.ok.inj (hright.symm.trans hresolve) + subst rightValue + exact hvalue + +private theorem resolveAtoms_selfIso + {rel : Nat → Nat → Prop} {environment : List RVal} + (henvironment : RValsIso rel environment environment) + {atoms : Array Atom} {values : List RVal} + (hresolve : resolveAtoms environment atoms = .ok values) : + RValsIso rel values values := by + obtain ⟨rightValues, hright, hvalues⟩ := + resolveAtoms_historyIso henvironment hresolve + have heq : rightValues = values := Except.ok.inj (hright.symm.trans hresolve) + subst rightValues + exact hvalues + +/-! ## Closing a rewritten current-frame fixed point -/ + +private structure CurrentFrameRefinesAt (ctx : Ctx) + (source target : FnDef) (fuel : Nat) : Prop where + runCode : ∀ (store : Store) (base : HeapHistoryIso store store) + (environment : List RVal), + RValsIso base.locRel environment environment → + ∀ (input : Code) (sourceOut : Store × RVal), + runCode ctx fuel source store environment input = .ok sourceOut → + ∃ targetOut, + runCode ctx fuel target store environment input = .ok targetOut ∧ + RunHistoryIso base sourceOut targetOut + runOp : ∀ (store : Store) (base : HeapHistoryIso store store) + (environment : List RVal), + RValsIso base.locRel environment environment → + ∀ (operation : Op) (sourceOut : Store × RVal), + runOp ctx fuel source store environment operation = .ok sourceOut → + ∃ targetOut, + runOp ctx fuel target store environment operation = .ok targetOut ∧ + RunHistoryIso base sourceOut targetOut + +private theorem runCode_currentFrameCrossOfSame + {ctx : Ctx} {source target : FnDef} {fuel : Nat} + (same : CurrentFrameRefinesAt ctx source target fuel) + {left right : Store} (heap : HeapHistoryIso left right) + {leftEnvironment rightEnvironment : List RVal} + (henvironments : RValsIso heap.locRel + leftEnvironment rightEnvironment) + {input : Code} {sourceOut : Store × RVal} + (hrun : runCode ctx fuel source left leftEnvironment input = + .ok sourceOut) : + ∃ targetOut, + runCode ctx fuel target right rightEnvironment input = .ok targetOut ∧ + RunHistoryIso heap sourceOut targetOut := by + obtain ⟨middleOut, hmiddle, hsourceMiddle⟩ := + runCode_historyIso heap henvironments hrun + let self := heap.symm.trans heap + have hselfEnvironment : RValsIso self.locRel + rightEnvironment rightEnvironment := + henvironments.symm.trans henvironments + obtain ⟨targetOut, htarget, hmiddleTarget⟩ := + same.runCode right self rightEnvironment hselfEnvironment input middleOut + hmiddle + exact ⟨targetOut, htarget, + RunHistoryIso.weaken (selfRight_extends_compose heap) + (hsourceMiddle.trans hmiddleTarget)⟩ + +private theorem runCode_currentFrameCaseStep + {ctx : Ctx} {source target : FnDef} {fuel : Nat} + (smaller : CurrentFrameRefinesAt ctx source target fuel) + (store : Store) (base : HeapHistoryIso store store) + (environment : List RVal) + (henvironment : RValsIso base.locRel environment environment) + (scrutinee : Atom) (peelNat : Bool) (alternatives : Array Alt) + (sourceOut : Store × RVal) + (hrun : runCode ctx (fuel + 1) source store environment + (.case scrutinee peelNat alternatives) = .ok sourceOut) : + ∃ targetOut, + runCode ctx (fuel + 1) target store environment + (.case scrutinee peelNat alternatives) = .ok targetOut ∧ + RunHistoryIso base sourceOut targetOut := by + rw [runCode.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hscrutinee : resolveAtom environment scrutinee with + | error error => + rw [hscrutinee] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok value => + rw [hscrutinee] at hrun + simp only [bind, Except.bind] at hrun ⊢ + have hvalue : RValIso base.locRel value value := + resolveAtom_selfIso henvironment hscrutinee + cases value with + | erased => simp at hrun + | lit literal => + cases literal with + | str value => simp at hrun + | nat value => + cases peelNat with + | false => simp at hrun + | true => + cases value with + | zero => + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == 0) with + | none => simp [hfind] at hrun + | some alternative => + simp only [hfind] at hrun ⊢ + cases alternative with + | mk cidx fields body => + cases fields with + | zero => + exact smaller.runCode store base environment + henvironment body sourceOut hrun + | succ fields => simp at hrun + | succ value => + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == 1) with + | none => simp [hfind] at hrun + | some alternative => + simp only [hfind] at hrun ⊢ + cases alternative with + | mk cidx fields body => + cases fields with + | zero => simp at hrun + | succ fields => + cases fields with + | zero => + exact smaller.runCode store base + (.lit (.nat value) :: environment) + (.cons .lit henvironment) body + sourceOut hrun + | succ fields => simp at hrun + | loc location => + cases hbox : store.get? location with + | none => simp [hbox] at hrun + | some box => + simp only [hbox] at hrun ⊢ + cases hnode : box.node with + | papN function arity arguments => simp [hnode] at hrun + | ctorN identity fields => + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == identity.cidx) with + | none => simp [hnode, hfind] at hrun + | some alternative => + simp only [hfind] at hrun ⊢ + cases alternative with + | mk cidx fieldCount body => + by_cases hcount : fields.size = fieldCount + · simp [hnode, hfind, hcount] at hrun ⊢ + cases hvalue with + | @loc _ _ hrel => + obtain ⟨rightBox, hrightBox, hboxIso⟩ := + base.boxes hrel hbox + have hrightBoxEq : rightBox = box := by + exact Option.some.inj + (hrightBox.symm.trans hbox) + subst rightBox + have hfields : RValsIso base.locRel + fields.toList fields.toList := by + have hnodeIso : NodeIso base.locRel + box.node box.node := hboxIso.node + rw [hnode] at hnodeIso + cases hnodeIso with + | ctor hfields => exact hfields + have hbranch : RValsIso base.locRel + (fields.toList.reverse ++ environment) + (fields.toList.reverse ++ environment) := + hfields.reverse.append henvironment + obtain ⟨targetOut, htarget, hiso⟩ := + smaller.runCode store base + (fields.toList.reverse ++ environment) + hbranch body sourceOut hrun + rcases targetOut with + ⟨targetStore, targetValue⟩ + exact ⟨targetStore, targetValue, + htarget, hiso⟩ + · simp [hnode, hfind, hcount] at hrun + +private theorem runCode_currentFrameStep + {ctx : Ctx} {source target : FnDef} {fuel : Nat} + (smaller : CurrentFrameRefinesAt ctx source target fuel) : + ∀ (store : Store) (base : HeapHistoryIso store store) + (environment : List RVal), + RValsIso base.locRel environment environment → + ∀ (input : Code) (sourceOut : Store × RVal), + runCode ctx (fuel + 1) source store environment input = .ok sourceOut → + ∃ targetOut, + runCode ctx (fuel + 1) target store environment input = .ok targetOut ∧ + RunHistoryIso base sourceOut targetOut := by + intro store base environment henvironment input sourceOut hrun + cases input with + | ret atom => + simpa [runCode] using + (runCode_historyIso base henvironment hrun) + | case scrutinee peelNat alternatives => + exact runCode_currentFrameCaseStep smaller store base environment + henvironment scrutinee peelNat alternatives sourceOut hrun + | letOp operation rest => + rw [runCode.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hoperation : runOp ctx fuel source store environment operation with + | error error => + rw [hoperation] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok operationOut => + rcases operationOut with ⟨middle, sourceValue⟩ + rw [hoperation] at hrun + simp only [bind, Except.bind] at hrun + obtain ⟨targetOperationOut, htargetOperation, + operationHeap, hbaseOperation, hvalue⟩ := + smaller.runOp store base environment henvironment operation + (middle, sourceValue) hoperation + rcases targetOperationOut with ⟨targetMiddle, targetValue⟩ + have hrestEnvironment : RValsIso operationHeap.locRel + (sourceValue :: environment) (targetValue :: environment) := + .cons hvalue (hbaseOperation.rvals henvironment) + obtain ⟨targetOut, htargetRest, hrestIso⟩ := + runCode_currentFrameCrossOfSame smaller operationHeap + hrestEnvironment hrun + refine ⟨targetOut, ?_, + RunHistoryIso.weaken hbaseOperation hrestIso⟩ + rw [htargetOperation] + simp only [bind, Except.bind] + exact htargetRest + +private theorem runOp_currentFrameStep + {ctx : Ctx} {source target : FnDef} + (bodyRewrite : StaticFunctionBodyRefines ctx source target) + (harity : target.arity = source.arity) + (hresult : target.result = source.result) + {fuel : Nat} (smaller : CurrentFrameRefinesAt ctx source target fuel) : + ∀ (store : Store) (base : HeapHistoryIso store store) + (environment : List RVal), + RValsIso base.locRel environment environment → + ∀ (operation : Op) (sourceOut : Store × RVal), + runOp ctx (fuel + 1) source store environment operation = .ok sourceOut → + ∃ targetOut, + runOp ctx (fuel + 1) target store environment operation = + .ok targetOut ∧ + RunHistoryIso base sourceOut targetOut := by + intro store base environment henvironment operation sourceOut hrun + cases operation with + | pure atom => + simpa [runOp] using (runOp_historyIso base henvironment hrun) + | alloc world identity arguments => + simpa [runOp] using (runOp_historyIso base henvironment hrun) + | reuse targetAtom identity arguments => + simpa [runOp] using (runOp_historyIso base henvironment hrun) + | free targetAtom => + simpa [runOp] using (runOp_historyIso base henvironment hrun) + | dup targetAtom => + simpa [runOp] using (runOp_historyIso base henvironment hrun) + | drop targetAtom => + simpa [runOp] using (runOp_historyIso base henvironment hrun) + | dropU targetAtom => + simpa [runOp] using (runOp_historyIso base henvironment hrun) + | fetch targetAtom field => + simpa [runOp] using (runOp_historyIso base henvironment hrun) + | call function arguments => + simpa [runOp] using (runOp_historyIso base henvironment hrun) + | papp function arguments => + simpa [runOp] using (runOp_historyIso base henvironment hrun) + | apply function arguments => + simpa [runOp] using (runOp_historyIso base henvironment hrun) + | extern function arguments => + simpa [runOp] using (runOp_historyIso base henvironment hrun) + | callSelf arguments => + rw [runOp.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases harguments : resolveAtoms environment arguments with + | error error => + rw [harguments] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok argumentValues => + rw [harguments] at hrun + simp only [bind, Except.bind] at hrun ⊢ + have hargumentValues : RValsIso base.locRel + argumentValues argumentValues := + resolveAtoms_selfIso henvironment harguments + by_cases hsourceArity : argumentValues.length = source.arity + · have htargetArity : argumentValues.length = target.arity := by + rw [harity] + exact hsourceArity + simp [hsourceArity] at hrun + cases hbody : runCode ctx fuel source store + argumentValues.reverse source.body with + | error error => + rw [hbody] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok bodyOut => + rw [hbody] at hrun + simp only [bind, Except.bind] at hrun + have hout := (checkResultWorld_ok hrun).1 + subst sourceOut + let self := base.trans base.symm + have hselfArguments : RValsIso self.locRel + argumentValues.reverse argumentValues.reverse := + (hargumentValues.trans hargumentValues.symm).reverse + obtain ⟨localOut, hlocalRun, hlocalIso⟩ := + bodyRewrite self (by simpa using hsourceArity) + hselfArguments hbody + obtain ⟨targetOut, htargetBody, hframeIso⟩ := + smaller.runCode store base argumentValues.reverse + hargumentValues.reverse target.body localOut hlocalRun + have hbodyIso : RunHistoryIso base bodyOut targetOut := + RunHistoryIso.weaken (selfLeft_compose_extends base) + (hlocalIso.trans hframeIso) + rcases bodyOut with ⟨bodyStore, bodyValue⟩ + rcases targetOut with ⟨targetStore, targetValue⟩ + obtain ⟨finalHeap, hbaseFinal, hvalue⟩ := hbodyIso + have htargetWorld := checkResultWorld_historyIso finalHeap + hvalue source.result hrun + refine ⟨(targetStore, targetValue), ?_, finalHeap, + hbaseFinal, hvalue⟩ + simp [htargetArity, htargetBody, hresult] + simpa only [bind, Except.bind] using htargetWorld + · have htargetDifferent : argumentValues.length ≠ target.arity := by + intro heq + exact hsourceArity (heq.trans harity) + simp [hsourceArity, htargetDifferent] at hrun + +private theorem currentFrameRefinesAt + {ctx : Ctx} {source target : FnDef} + (bodyRewrite : StaticFunctionBodyRefines ctx source target) + (harity : target.arity = source.arity) + (hresult : target.result = source.result) : + ∀ fuel, CurrentFrameRefinesAt ctx source target fuel := by + intro fuel + induction fuel with + | zero => + constructor <;> intros <;> + simp [runCode, runOp] at * + | succ fuel smaller => + exact ⟨runCode_currentFrameStep smaller, + runOp_currentFrameStep bodyRewrite harity hresult smaller⟩ + +/-- A pass-local body rewrite closes to a genuine function refinement once +the calling convention is stable. -/ +theorem FunctionBodyRefines.ofStatic + {ctx : Ctx} {source target : FnDef} + (bodyRewrite : StaticFunctionBodyRefines ctx source target) + (harity : target.arity = source.arity) + (hresult : target.result = source.result) : + FunctionBodyRefines ctx source target := by + intro fuel store environment sourceOut base hlength henvironment hrun + let self := base.trans base.symm + have hselfEnvironment : RValsIso self.locRel environment environment := + henvironment.trans henvironment.symm + obtain ⟨localOut, hlocalRun, hlocalIso⟩ := + bodyRewrite self hlength hselfEnvironment hrun + obtain ⟨targetOut, htargetRun, hframeIso⟩ := + (currentFrameRefinesAt bodyRewrite harity hresult fuel).runCode store base + environment henvironment target.body localOut hlocalRun + exact ⟨targetOut, htargetRun, + RunHistoryIso.weaken (selfLeft_compose_extends base) + (hlocalIso.trans hframeIso)⟩ + +/-- The same fixed-point closure lifted through arbitrary related entry heaps +and environments. -/ +theorem runCode_currentFrame_refines + {ctx : Ctx} {source target : FnDef} + (bodyRewrite : StaticFunctionBodyRefines ctx source target) + (harity : target.arity = source.arity) + (hresult : target.result = source.result) + {left right : Store} {fuel : Nat} + {leftEnvironment rightEnvironment : List RVal} + {input : Code} {sourceOut : Store × RVal} + (heap : HeapHistoryIso left right) + (henvironments : RValsIso heap.locRel + leftEnvironment rightEnvironment) + (hrun : runCode ctx fuel source left leftEnvironment input = + .ok sourceOut) : + ∃ targetOut, + runCode ctx fuel target right rightEnvironment input = .ok targetOut ∧ + RunHistoryIso heap sourceOut targetOut := + runCode_currentFrameCrossOfSame + (currentFrameRefinesAt bodyRewrite harity hresult fuel) heap henvironments + hrun + +private theorem runCode_caseRewriteAt + {before after : Ctx} {fuel : Nat} + (smaller : EvalRewriteAt before after fuel) + (current : FnDef) (store : Store) + (base : HeapHistoryIso store store) (environment : List RVal) + (henvironment : RValsIso base.locRel environment environment) + (scrutinee : Atom) (peelNat : Bool) (alternatives : Array Alt) + (sourceOut : Store × RVal) + (hrun : runCode before (fuel + 1) current store environment + (.case scrutinee peelNat alternatives) = .ok sourceOut) : + ∃ targetOut, + runCode after (fuel + 1) current store environment + (.case scrutinee peelNat alternatives) = .ok targetOut ∧ + RunHistoryIso base sourceOut targetOut := by + rw [runCode.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hscrutinee : resolveAtom environment scrutinee with + | error error => + rw [hscrutinee] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok value => + rw [hscrutinee] at hrun + simp only [bind, Except.bind] at hrun ⊢ + have hvalue := resolveAtom_selfIso henvironment hscrutinee + cases value with + | erased => simp at hrun + | lit literal => + cases literal with + | str value => simp at hrun + | nat value => + cases peelNat with + | false => simp at hrun + | true => + cases value with + | zero => + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == 0) with + | none => simp [hfind] at hrun + | some alternative => + simp only [hfind] at hrun ⊢ + cases alternative with + | mk cidx fields body => + cases fields with + | zero => + exact smaller.runCode current store base + environment henvironment body sourceOut + hrun + | succ fields => simp at hrun + | succ value => + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == 1) with + | none => simp [hfind] at hrun + | some alternative => + simp only [hfind] at hrun ⊢ + cases alternative with + | mk cidx fields body => + cases fields with + | zero => simp at hrun + | succ fields => + cases fields with + | zero => + exact smaller.runCode current store base + (.lit (.nat value) :: environment) + (.cons .lit henvironment) body + sourceOut hrun + | succ fields => simp at hrun + | loc location => + cases hbox : store.get? location with + | none => simp [hbox] at hrun + | some box => + simp only [hbox] at hrun ⊢ + cases hnode : box.node with + | papN function arity arguments => + simp [hnode] at hrun + | ctorN identity fields => + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == identity.cidx) with + | none => simp [hnode, hfind] at hrun + | some alternative => + simp only [hfind] at hrun ⊢ + cases alternative with + | mk cidx fieldCount body => + by_cases hcount : fields.size = fieldCount + · simp [hnode, hfind, hcount] at hrun ⊢ + cases hvalue with + | @loc _ _ hrel => + obtain ⟨rightBox, hrightBox, hboxIso⟩ := + base.boxes hrel hbox + have hrightBoxEq : rightBox = box := by + exact Option.some.inj + (hrightBox.symm.trans hbox) + subst rightBox + have hfields : RValsIso base.locRel + fields.toList fields.toList := by + have hnodeIso : NodeIso base.locRel + box.node box.node := hboxIso.node + rw [hnode] at hnodeIso + cases hnodeIso with + | ctor hfields => exact hfields + have hfold : RValsIso base.locRel + (fields.toList.reverse ++ environment) + (fields.toList.reverse ++ environment) := + hfields.reverse.append henvironment + obtain ⟨targetOut, htarget, hiso⟩ := + smaller.runCode current store base + (fields.toList.reverse ++ environment) + hfold body sourceOut hrun + rcases targetOut with + ⟨targetStore, targetValue⟩ + exact ⟨targetStore, targetValue, + htarget, hiso⟩ + · simp [hnode, hfind, hcount] at hrun + +private theorem runCode_rewriteStep + {before after : Ctx} {fuel : Nat} + (smaller : EvalRewriteAt before after fuel) : + ∀ (current : FnDef) (store : Store) + (base : HeapHistoryIso store store) (environment : List RVal), + RValsIso base.locRel environment environment → + ∀ (input : Code) (sourceOut : Store × RVal), + runCode before (fuel + 1) current store environment input = + .ok sourceOut → + ∃ targetOut, + runCode after (fuel + 1) current store environment input = + .ok targetOut ∧ + RunHistoryIso base sourceOut targetOut := by + intro current store base environment henvironment input sourceOut hrun + cases input with + | ret atom => + simpa [runCode] using + (runCode_historyIso base henvironment hrun) + | case scrutinee peelNat alternatives => + exact runCode_caseRewriteAt smaller current store base environment + henvironment scrutinee peelNat alternatives sourceOut hrun + | letOp operation rest => + rw [runCode.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hoperation : runOp before fuel current store environment + operation with + | error error => + rw [hoperation] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok operationOut => + rcases operationOut with ⟨middle, sourceValue⟩ + rw [hoperation] at hrun + simp only [bind, Except.bind] at hrun + obtain ⟨targetOperationOut, htargetOperation, + operationHeap, hbaseOperation, hvalue⟩ := + smaller.runOp current store base environment henvironment + operation (middle, sourceValue) hoperation + rcases targetOperationOut with ⟨targetMiddle, targetValue⟩ + have hrestEnvironment : RValsIso operationHeap.locRel + (sourceValue :: environment) (targetValue :: environment) := + .cons hvalue (hbaseOperation.rvals henvironment) + obtain ⟨targetOut, htargetRest, hrestIso⟩ := + runCode_crossOfSame smaller operationHeap hrestEnvironment hrun + refine ⟨targetOut, ?_, + RunHistoryIso.weaken hbaseOperation hrestIso⟩ + rw [htargetOperation] + simp only [bind, Except.bind] + exact htargetRest + +private theorem runOp_rewriteStep + {before after : Ctx} (abstract : AbstractEnvironment before after) + {fuel : Nat} (smaller : EvalRewriteAt before after fuel) : + ∀ (current : FnDef) (store : Store) + (base : HeapHistoryIso store store) (environment : List RVal), + RValsIso base.locRel environment environment → + ∀ (operation : Op) (sourceOut : Store × RVal), + runOp before (fuel + 1) current store environment operation = + .ok sourceOut → + ∃ targetOut, + runOp after (fuel + 1) current store environment operation = + .ok targetOut ∧ + RunHistoryIso base sourceOut targetOut := by + intro current store base values hvalues operation sourceOut hrun + have hsourceRun := hrun + let drops := dropCtxEqAt before after fuel + cases operation with + | pure atom => + simpa [runOp] using (runOp_historyIso base hvalues hrun) + | alloc world identity arguments => + simpa [runOp] using (runOp_historyIso base hvalues hrun) + | reuse target identity arguments => + simpa [runOp] using (runOp_historyIso base hvalues hrun) + | free target => + simpa [runOp] using (runOp_historyIso base hvalues hrun) + | dup target => + simpa [runOp] using (runOp_historyIso base hvalues hrun) + | drop target => + simpa [runOp, drops.dropVal] using + (runOp_historyIso base hvalues hrun) + | dropU target => + simpa [runOp, drops.dropUVal] using + (runOp_historyIso base hvalues hrun) + | fetch target field => + simpa [runOp] using (runOp_historyIso base hvalues hrun) + | call function arguments => + rw [runOp.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases harguments : resolveAtoms values arguments with + | error error => + rw [harguments] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok arguments => + rw [harguments] at hrun + simp only [bind, Except.bind] at hrun ⊢ + exact smaller.invoke function arguments store base + (resolveAtoms_selfIso hvalues harguments) sourceOut hrun + | callSelf arguments => + rw [runOp.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases harguments : resolveAtoms values arguments with + | error error => + rw [harguments] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok arguments => + rw [harguments] at hrun + simp only [bind, Except.bind] at hrun ⊢ + have hargumentValues := resolveAtoms_selfIso hvalues harguments + by_cases harity : arguments.length = current.arity + · simp [harity] at hrun + cases hbody : runCode before fuel current store arguments.reverse + current.body with + | error error => + rw [hbody] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok bodyOut => + rw [hbody] at hrun + simp only [bind, Except.bind] at hrun + have hout := (checkResultWorld_ok hrun).1 + subst sourceOut + obtain ⟨targetBodyOut, htargetBody, bodyHeap, + hbaseBody, hbodyValue⟩ := + smaller.runCode current store base arguments.reverse + hargumentValues.reverse current.body bodyOut hbody + rcases bodyOut with ⟨bodyStore, bodyValue⟩ + rcases targetBodyOut with + ⟨targetBodyStore, targetBodyValue⟩ + have htargetWorld := checkResultWorld_historyIso bodyHeap + hbodyValue current.result hrun + refine ⟨(targetBodyStore, targetBodyValue), ?_, bodyHeap, + hbaseBody, hbodyValue⟩ + simp [harity, htargetBody] + simpa only [bind, Except.bind] using htargetWorld + · have harityBool : (arguments.length != current.arity) = true := by + simpa using harity + simp [harityBool] at hrun + | papp function atoms => + rw [runOp.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases harguments : resolveAtoms values atoms with + | error error => + rw [harguments] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok arguments => + rw [harguments] at hrun + simp only [bind, Except.bind] at hrun ⊢ + cases hdeclaration : before.decls function with + | none => simp [hdeclaration] at hrun + | some declaration => + obtain ⟨targetDeclaration, htargetDeclaration, harity, _⟩ := + abstract.declaration hdeclaration + simp only [hdeclaration] at hrun + simp only [htargetDeclaration] + by_cases hless : arguments.length < declArity declaration + · have htargetLess : + arguments.length < declArity targetDeclaration := by + rw [harity] + exact hless + obtain ⟨selfOut, hselfRun, hiso⟩ := + runOp_historyIso base hvalues hsourceRun + have hout : selfOut = sourceOut := + Except.ok.inj (hselfRun.symm.trans hsourceRun) + subst selfOut + refine ⟨sourceOut, ?_, hiso⟩ + simp only [hless, if_true, Except.ok.injEq] at hrun + simpa [harity, hless] using + congrArg (fun output => + (Except.ok output : Except Err (Store × RVal))) hrun + · simp [hless] at hrun + | apply function arguments => + rw [runOp.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hfunction : resolveAtom values function with + | error error => + rw [hfunction] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok functionValue => + rw [hfunction] at hrun + simp only [bind, Except.bind] at hrun ⊢ + cases harguments : resolveAtoms values arguments with + | error error => + rw [harguments] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok argumentValues => + rw [harguments] at hrun + simp only [bind, Except.bind] at hrun ⊢ + exact smaller.applyGo store base functionValue argumentValues + (resolveAtom_selfIso hvalues hfunction) + (resolveAtoms_selfIso hvalues harguments) sourceOut hrun + | extern function arguments => + simpa [runOp, callScalarOracle, abstract.oracle_eq] using + (runOp_historyIso base hvalues hrun) + +private theorem invoke_rewriteStep + {before after : Ctx} (abstract : AbstractEnvironment before after) + {fuel : Nat} (smaller : EvalRewriteAt before after fuel) : + ∀ (function : Address) (arguments : List RVal) (store : Store) + (base : HeapHistoryIso store store), + RValsIso base.locRel arguments arguments → + ∀ (sourceOut : Store × RVal), + IxIR1.invoke before (fuel + 1) function arguments store = + .ok sourceOut → + ∃ targetOut, + IxIR1.invoke after (fuel + 1) function arguments store = + .ok targetOut ∧ + RunHistoryIso base sourceOut targetOut := by + intro function arguments store base harguments sourceOut hrun + have hsourceRun := hrun + rw [IxIR1.invoke.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hdeclaration : before.decls function with + | none => simp [hdeclaration] at hrun + | some declaration => + cases declaration with + | extern arity => + have htargetDeclaration := abstract.extern hdeclaration + simp only [hdeclaration] at hrun + simp only [htargetDeclaration] + obtain ⟨selfOut, hselfRun, hiso⟩ := + invoke_historyIso base harguments hsourceRun + have hout : selfOut = sourceOut := + Except.ok.inj (hselfRun.symm.trans hsourceRun) + subst selfOut + refine ⟨sourceOut, ?_, hiso⟩ + simpa [callScalarOracle, abstract.oracle_eq] using hrun + | fn source => + obtain ⟨target, htargetDeclaration, harity, hresult, _, + hbodyRefines⟩ := abstract.function hdeclaration + simp only [hdeclaration] at hrun + simp only [htargetDeclaration] + by_cases hsame : arguments.length = source.arity + · have htargetSame : arguments.length = target.arity := by + rw [harity] + exact hsame + simp [hsame] at hrun + cases hbody : runCode before fuel source store arguments.reverse + source.body with + | error error => + rw [hbody] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok bodyOut => + rw [hbody] at hrun + simp only [bind, Except.bind] at hrun + have hout := (checkResultWorld_ok hrun).1 + subst sourceOut + let self := base.trans base.symm + have hselfArguments : RValsIso self.locRel + arguments.reverse arguments.reverse := by + exact (harguments.trans harguments.symm).reverse + obtain ⟨localOut, hlocalRun, hlocalIso⟩ := + hbodyRefines self (by simpa using hsame) + hselfArguments hbody + obtain ⟨targetOut, htargetBody, hctxIso⟩ := + smaller.runCode target store base arguments.reverse + harguments.reverse target.body localOut hlocalRun + have hbodyIso : RunHistoryIso base bodyOut targetOut := + RunHistoryIso.weaken (selfLeft_compose_extends base) + (hlocalIso.trans hctxIso) + rcases bodyOut with ⟨bodyStore, bodyValue⟩ + rcases targetOut with ⟨targetStore, targetValue⟩ + obtain ⟨finalHeap, hbaseFinal, hvalue⟩ := hbodyIso + have htargetWorld := checkResultWorld_historyIso finalHeap + hvalue source.result hrun + refine ⟨(targetStore, targetValue), ?_, finalHeap, + hbaseFinal, hvalue⟩ + simp [htargetSame, htargetBody, hresult] + simpa only [bind, Except.bind] using htargetWorld + · have htargetDifferent : arguments.length ≠ target.arity := by + intro heq + exact hsame (heq.trans harity) + simp [hsame] at hrun + +private theorem applyGo_rewriteStep + {before after : Ctx} {fuel : Nat} + (abstract : AbstractEnvironment before after) + (smaller : EvalRewriteAt before after fuel) : + ∀ (store : Store) (base : HeapHistoryIso store store) + (function : RVal) (arguments : List RVal), + RValIso base.locRel function function → + RValsIso base.locRel arguments arguments → + ∀ (sourceOut : Store × RVal), + IxIR1.applyGo before (fuel + 1) store function arguments = + .ok sourceOut → + ∃ targetOut, + IxIR1.applyGo after (fuel + 1) store function arguments = + .ok targetOut ∧ + RunHistoryIso base sourceOut targetOut := by + intro store base function arguments hfunction harguments sourceOut hrun + have hsourceRun := hrun + let drops := dropCtxEqAt before after fuel + rw [IxIR1.applyGo.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases function with + | lit literal => simp at hrun + | erased => + cases hdrop : dropMany before fuel store arguments with + | error error => + rw [hdrop] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok next => + rw [hdrop] at hrun + simp only [bind, Except.bind, Except.ok.injEq] at hrun + subst sourceOut + rw [drops.dropMany store arguments, hdrop] + obtain ⟨selfOut, hselfRun, hiso⟩ := + applyGo_historyIso base hfunction harguments hsourceRun + have hselfOut : selfOut = (next, .erased) := + Except.ok.inj (hselfRun.symm.trans hsourceRun) + subst selfOut + exact ⟨(next, .erased), rfl, hiso⟩ + | loc location => + cases hbox : store.get? location with + | none => simp [hbox] at hrun + | some box => + simp only [hbox] at hrun ⊢ + cases hnode : box.node with + | ctorN identity fields => simp [hnode] at hrun + | papN called arity captured => + rw [hnode] at hrun + dsimp only at hrun ⊢ + cases hfunction with + | @loc _ _ hrel => + obtain ⟨rightBox, hrightBox, hboxIso⟩ := + base.boxes hrel hbox + have hrightBoxEq : rightBox = box := by + exact Option.some.inj (hrightBox.symm.trans hbox) + subst rightBox + have hcaptured : RValsIso base.locRel + captured.toList captured.toList := by + have hnodeIso : NodeIso base.locRel box.node box.node := + hboxIso.node + rw [hnode] at hnodeIso + cases hnodeIso with + | pap hcaptured => exact hcaptured + cases hdup : dupVals store captured.toList with + | error error => + rw [hdup] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok duplicated => + rw [hdup] at hrun + simp only [bind, Except.bind] at hrun ⊢ + obtain ⟨duplicatedRight, hrightDup, duplicateHeap, + hbaseDuplicate⟩ := + dupVals_historyIso base hcaptured hdup + have hduplicated : duplicatedRight = duplicated := + Except.ok.inj (hrightDup.symm.trans hdup) + subst duplicatedRight + rw [drops.dropVal duplicated (.loc location)] + cases hdrop : dropVal before fuel duplicated + (.loc location) with + | error error => + rw [hdrop] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok ready => + rw [hdrop] at hrun + simp only [bind, Except.bind] at hrun ⊢ + obtain ⟨readyRight, hrightDrop, readyHeap, + hduplicateReady⟩ := + dropVal_historyIso duplicateHeap + (hbaseDuplicate.rval (.loc hrel)) hdrop + have hready : readyRight = ready := + Except.ok.inj (hrightDrop.symm.trans hdrop) + subst readyRight + let hbaseReady : base.Extends readyHeap := + hbaseDuplicate.trans hduplicateReady + let total := captured.toList ++ arguments + have htotal : RValsIso readyHeap.locRel total total := + (hbaseReady.rvals hcaptured).append + (hbaseReady.rvals harguments) + by_cases hunder : total.length < arity + · have hunderRaw : + (captured.toList ++ arguments).length < + arity := by + simpa [total] using hunder + have hunderSize : + captured.size + arguments.length < arity := by + simpa [total] using hunder + simp only [hunderRaw, if_true, + Except.ok.injEq] at hrun + subst sourceOut + let next := readyHeap.alloc (world := .shared) + (leftNode := .papN called arity total.toArray) + (rightNode := .papN called arity total.toArray) + (.pap (by simpa [total] using htotal)) + have hreadyNext : readyHeap.Extends next := by + intro leftLoc rightLoc hknown + exact .inr hknown + have hfresh : RValIso next.locRel + (.loc ready.nodes.size) + (.loc ready.nodes.size) := by + exact .loc (.inl ⟨rfl, rfl⟩) + let allocated := ready.allocNode .shared + (.papN called arity total.toArray) + refine ⟨(allocated.1, .loc allocated.2), ?_, next, + hbaseReady.trans hreadyNext, ?_⟩ + · simpa [total, allocated, hunderSize] + · simpa [allocated, Store.allocNode] using hfresh + · by_cases hexact : total.length = arity + · have hunderRaw : + ¬(captured.toList ++ arguments).length < + arity := by + simpa [total] using hunder + have hexactRaw : + (captured.toList ++ arguments).length = + arity := by + simpa [total] using hexact + obtain ⟨sourceDeclaration, targetDeclaration, + hsourceDeclaration, htargetDeclaration, + hpapsafe, hsourceSafe⟩ : + ∃ sourceDeclaration targetDeclaration, + before.decls called = some sourceDeclaration ∧ + after.decls called = some targetDeclaration ∧ + declPapSafe targetDeclaration = + declPapSafe sourceDeclaration ∧ + declPapSafe sourceDeclaration = true := by + cases hsourceDeclaration : before.decls called with + | none => + simp [hunderRaw, hexactRaw, + hsourceDeclaration] at hrun + | some sourceDeclaration => + obtain ⟨targetDeclaration, + htargetDeclaration, _, hpapsafe⟩ := + abstract.declaration hsourceDeclaration + cases hsourceSafe : + declPapSafe sourceDeclaration with + | false => + simp [hunderRaw, hexactRaw, + hsourceDeclaration, hsourceSafe] + at hrun + | true => + exact ⟨sourceDeclaration, + targetDeclaration, rfl, + htargetDeclaration, hpapsafe, + hsourceSafe⟩ + have htargetSafe : + declPapSafe targetDeclaration = true := + hpapsafe.trans hsourceSafe + simp [hunderRaw, hexactRaw, hsourceDeclaration, + hsourceSafe] at hrun + obtain ⟨targetOut, htargetInvoke, hiso⟩ := + smaller.invoke called total ready readyHeap + htotal sourceOut (by simpa [total] using hrun) + refine ⟨targetOut, ?_, + RunHistoryIso.weaken hbaseReady hiso⟩ + simpa [total, hunderRaw, hexactRaw, + htargetDeclaration, htargetSafe] using htargetInvoke + · have hunderRaw : + ¬(captured.toList ++ arguments).length < + arity := by + simpa [total] using hunder + have hexactRaw : + (captured.toList ++ arguments).length ≠ + arity := by + simpa [total] using hexact + have hunderSize : + ¬captured.size + arguments.length < + arity := by + simpa [total] using hunder + have hexactSize : + captured.size + arguments.length ≠ + arity := by + simpa [total] using hexact + obtain ⟨sourceDeclaration, targetDeclaration, + hsourceDeclaration, htargetDeclaration, + hpapsafe, hsourceSafe⟩ : + ∃ sourceDeclaration targetDeclaration, + before.decls called = some sourceDeclaration ∧ + after.decls called = some targetDeclaration ∧ + declPapSafe targetDeclaration = + declPapSafe sourceDeclaration ∧ + declPapSafe sourceDeclaration = true := by + cases hsourceDeclaration : before.decls called with + | none => + simp [hunderSize, hexactSize, + hsourceDeclaration] at hrun + | some sourceDeclaration => + obtain ⟨targetDeclaration, + htargetDeclaration, _, hpapsafe⟩ := + abstract.declaration hsourceDeclaration + cases hsourceSafe : + declPapSafe sourceDeclaration with + | false => + simp [hunderSize, hexactSize, + hsourceDeclaration, hsourceSafe] + at hrun + | true => + exact ⟨sourceDeclaration, + targetDeclaration, rfl, + htargetDeclaration, hpapsafe, + hsourceSafe⟩ + have htargetSafe : + declPapSafe targetDeclaration = true := + hpapsafe.trans hsourceSafe + simp [hunderSize, hexactSize, hsourceDeclaration, + hsourceSafe] at hrun + cases hinvoke : IxIR1.invoke before fuel called + (total.take arity) ready with + | error error => + rw [hinvoke] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok calledOut => + rcases calledOut with + ⟨calledStore, calledValue⟩ + rw [hinvoke] at hrun + simp only [bind, Except.bind] at hrun + obtain ⟨targetCalledOut, htargetInvoke, + callHeap, hreadyCall, hcalledValue⟩ := + smaller.invoke called (total.take arity) + ready readyHeap (htotal.take arity) + (calledStore, calledValue) hinvoke + rcases targetCalledOut with + ⟨targetCalledStore, targetCalledValue⟩ + obtain ⟨targetOut, htargetApply, hiso⟩ := + applyGo_crossOfSame smaller callHeap + hcalledValue + (hreadyCall.rvals (htotal.drop arity)) + (by simpa [total] using hrun) + refine ⟨targetOut, ?_, + RunHistoryIso.weaken + (hbaseReady.trans hreadyCall) hiso⟩ + simp [hunderSize, hexactSize, + htargetDeclaration, htargetSafe] + rw [htargetInvoke] + simp only [bind, Except.bind] + exact htargetApply + +private theorem evalRewriteAt {before after : Ctx} + (abstract : AbstractEnvironment before after) : + ∀ fuel, EvalRewriteAt before after fuel := by + intro fuel + induction fuel with + | zero => + constructor <;> intros <;> + simp [runCode, runOp, IxIR1.invoke, IxIR1.applyGo] at * + | succ fuel smaller => + exact ⟨runCode_rewriteStep smaller, + runOp_rewriteStep abstract smaller, + invoke_rewriteStep abstract smaller, + applyGo_rewriteStep abstract smaller⟩ + +/-- A successful run in the source context is reproduced in any abstractly +related target environment. The theorem accepts arbitrary related entry +stores and environments; no closure or canonical-location assumption is +required. -/ +theorem runCode_abstractEnvironment + {before after : Ctx} (abstract : AbstractEnvironment before after) + {fuel : Nat} {current : FnDef} {left right : Store} + (heap : HeapHistoryIso left right) + {leftEnvironment rightEnvironment : List RVal} + (henvironments : RValsIso heap.locRel + leftEnvironment rightEnvironment) + {input : Code} {sourceOut : Store × RVal} + (hrun : runCode before fuel current left leftEnvironment input = + .ok sourceOut) : + ∃ targetOut, + runCode after fuel current right rightEnvironment input = .ok targetOut ∧ + RunHistoryIso heap sourceOut targetOut := + runCode_crossOfSame (evalRewriteAt abstract fuel) heap henvironments hrun + +/-- Dynamic application form of `runCode_abstractEnvironment`. -/ +theorem applyGo_abstractEnvironment + {before after : Ctx} (abstract : AbstractEnvironment before after) + {fuel : Nat} {left right : Store} + (heap : HeapHistoryIso left right) + {leftFunction rightFunction : RVal} + {leftArguments rightArguments : List RVal} + (hfunction : RValIso heap.locRel leftFunction rightFunction) + (harguments : RValsIso heap.locRel leftArguments rightArguments) + {sourceOut : Store × RVal} + (hrun : IxIR1.applyGo before fuel left leftFunction leftArguments = + .ok sourceOut) : + ∃ targetOut, + IxIR1.applyGo after fuel right rightFunction rightArguments = + .ok targetOut ∧ + RunHistoryIso heap sourceOut targetOut := + applyGo_crossOfSame (evalRewriteAt abstract fuel) heap hfunction harguments + hrun + +/-! ## Exact declaration-environment replacement -/ + +private theorem runCode_case_exactEnvironment_eq + {before after : Ctx} {fuel : Nat} + (ih : ∀ (current : FnDef) (store : Store) + (environment : List RVal) (input : Code), + runCode after fuel current store environment input = + runCode before fuel current store environment input) + (current : FnDef) (store : Store) (environment : List RVal) + (scrutinee : Atom) (peelNat : Bool) (alternatives : Array Alt) : + runCode after (fuel + 1) current store environment + (.case scrutinee peelNat alternatives) = + runCode before (fuel + 1) current store environment + (.case scrutinee peelNat alternatives) := by + simp only [runCode] + cases hscrutinee : resolveAtom environment scrutinee with + | error error => simp [bind, Except.bind] + | ok value => + simp only [bind, Except.bind] + cases value with + | erased => simp + | lit literal => + cases literal with + | str value => simp + | nat value => + simp only + cases peelNat with + | false => simp + | true => + simp only + cases value with + | zero => + simp only + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == 0) with + | none => simp + | some alternative => + cases alternative with + | mk cidx fields body => + cases fields with + | zero => + simpa using + ih current store environment body + | succ fields => simp + | succ value => + simp only + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == 1) with + | none => simp + | some alternative => + cases alternative with + | mk cidx fields body => + cases fields with + | zero => simp + | succ fields => + cases fields with + | zero => + simpa using ih current store + (.lit (.nat value) :: environment) + body + | succ fields => simp + | loc location => + simp only + cases hget : store.get? location with + | none => simp + | some box => + simp only + cases hnode : box.node with + | papN function arity arguments => simp + | ctorN identity fields => + simp only + cases hfind : alternatives.find? + (fun alternative => + alternative.cidx == identity.cidx) with + | none => simp + | some alternative => + cases alternative with + | mk cidx fieldCount body => + by_cases hfields : fields.size = fieldCount + · simpa [hfields] using + ih current store + (fields.foldl + (fun result field => field :: result) + environment) body + · simp [hfields] + +private structure ExactRewriteAt (before after : Ctx) (fuel : Nat) : Prop where + runCode : ∀ (current : FnDef) (store : Store) + (environment : List RVal) (input : Code), + runCode after fuel current store environment input = + runCode before fuel current store environment input + runOp : ∀ (current : FnDef) (store : Store) + (environment : List RVal) (operation : Op), + runOp after fuel current store environment operation = + runOp before fuel current store environment operation + invoke : ∀ (function : Address) (arguments : List RVal) (store : Store), + IxIR1.invoke after fuel function arguments store = + IxIR1.invoke before fuel function arguments store + applyGo : ∀ (store : Store) (function : RVal) (arguments : List RVal), + IxIR1.applyGo after fuel store function arguments = + IxIR1.applyGo before fuel store function arguments + dropVal : ∀ (store : Store) (value : RVal), + IxIR1.dropVal after fuel store value = + IxIR1.dropVal before fuel store value + dropMany : ∀ (store : Store) (values : List RVal), + IxIR1.dropMany after fuel store values = + IxIR1.dropMany before fuel store values + dropUVal : ∀ (store : Store) (value : RVal), + IxIR1.dropUVal after fuel store value = + IxIR1.dropUVal before fuel store value + dropManyU : ∀ (store : Store) (values : List RVal), + IxIR1.dropManyU after fuel store values = + IxIR1.dropManyU before fuel store values + +private theorem exactRewriteAt {before after : Ctx} + (exact : ExactEnvironment before after) : + ∀ fuel, ExactRewriteAt before after fuel := by + intro fuel + induction fuel with + | zero => + constructor <;> intros <;> + simp [runCode, runOp, IxIR1.invoke, IxIR1.applyGo, + IxIR1.dropVal, IxIR1.dropMany, IxIR1.dropUVal, + IxIR1.dropManyU] + | succ fuel smaller => + refine { + runCode := ?_ + runOp := ?_ + invoke := ?_ + applyGo := ?_ + dropVal := ?_ + dropMany := ?_ + dropUVal := ?_ + dropManyU := ?_ } + · intro current store environment input + cases input with + | ret atom => simp [runCode] + | letOp operation rest => + simp only [runCode] + rw [smaller.runOp current store environment operation] + cases hoperation : runOp before fuel current store environment + operation with + | error error => rfl + | ok output => + rcases output with ⟨next, value⟩ + exact smaller.runCode current next (value :: environment) rest + | case scrutinee peelNat alternatives => + exact runCode_case_exactEnvironment_eq smaller.runCode current + store environment scrutinee peelNat alternatives + · intro current store environment operation + cases operation with + | pure atom => simp [runOp] + | alloc world identity arguments => simp [runOp] + | reuse target identity arguments => simp [runOp] + | free target => simp [runOp] + | dup target => simp [runOp] + | drop target => + simp only [runOp] + cases htarget : resolveAtom environment target with + | error error => simp [bind, Except.bind] + | ok value => + simp only [bind, Except.bind] + cases value with + | lit literal => rfl + | erased => rfl + | loc location => + change (do + let next ← IxIR1.dropVal after fuel store + (.loc location) + .ok (next, RVal.erased)) = + (do + let next ← IxIR1.dropVal before fuel store + (.loc location) + .ok (next, RVal.erased)) + rw [smaller.dropVal store (.loc location)] + | dropU target => + simp only [runOp] + cases htarget : resolveAtom environment target with + | error error => simp [bind, Except.bind] + | ok value => + simp only [bind, Except.bind] + cases value with + | lit literal => rfl + | erased => rfl + | loc location => + change (do + let next ← IxIR1.dropUVal after fuel store + (.loc location) + .ok (next, RVal.erased)) = + (do + let next ← IxIR1.dropUVal before fuel store + (.loc location) + .ok (next, RVal.erased)) + rw [smaller.dropUVal store (.loc location)] + | fetch target field => simp [runOp] + | call function atoms => + simp only [runOp] + cases harguments : resolveAtoms environment atoms with + | error error => rfl + | ok arguments => exact smaller.invoke function arguments store + | callSelf atoms => + simp only [runOp] + cases harguments : resolveAtoms environment atoms with + | error error => simp [bind, Except.bind] + | ok arguments => + simp only [bind, Except.bind] + by_cases harity : arguments.length = current.arity + · simp only [harity] + rw [smaller.runCode current store arguments.reverse + current.body] + · simp [harity] + | papp function atoms => + simp only [runOp] + cases harguments : resolveAtoms environment atoms with + | error error => simp [bind, Except.bind] + | ok arguments => + simp only [bind, Except.bind] + cases hsource : before.decls function with + | none => + have htarget := exact.missing hsource + simp [htarget] + | some declaration => + cases declaration with + | extern arity => + have htarget := exact.extern hsource + simp [htarget] + | fn source => + obtain ⟨target, htarget, harity, _, _, _⟩ := + exact.function hsource + rw [htarget] + simp only [declArity] + simp [harity] + rfl + | apply function atoms => + simp only [runOp] + cases hfunction : resolveAtom environment function with + | error error => rfl + | ok value => + cases harguments : resolveAtoms environment atoms with + | error error => rfl + | ok arguments => exact smaller.applyGo store value arguments + | extern function atoms => + simp [runOp, callScalarOracle, exact.oracle_eq] + · intro function arguments store + simp only [IxIR1.invoke] + cases hsource : before.decls function with + | none => + have htarget := exact.missing hsource + simp [htarget] + | some declaration => + cases declaration with + | extern arity => + have htarget := exact.extern hsource + simp [htarget, callScalarOracle, exact.oracle_eq] + | fn source => + obtain ⟨target, htarget, harity, hresult, _, hbody⟩ := + exact.function hsource + by_cases hsourceArity : arguments.length = source.arity + · have htargetArity : arguments.length = target.arity := by + rw [harity] + exact hsourceArity + have hsourceArityBool : + (arguments.length != source.arity) = false := by + simp [hsourceArity] + have htargetArityBool : + (arguments.length != target.arity) = false := by + simp [htargetArity] + have hcombined : + runCode after fuel target store arguments.reverse + target.body = + runCode before fuel source store arguments.reverse + source.body := + (smaller.runCode target store arguments.reverse + target.body).trans + (hbody (by simpa using hsourceArity)) + have hchecked := congrArg + (fun output => output >>= checkResultWorld source.result) + hcombined + simpa only [hsource, htarget, hsourceArityBool, + htargetArityBool, Bool.false_eq_true, if_false, hresult] + using hchecked + · have htargetArity : + arguments.length ≠ target.arity := by + rwa [harity] + simp [htarget, hsourceArity, htargetArity] + · intro store function arguments + cases function with + | lit literal => simp [IxIR1.applyGo] + | erased => + simp only [IxIR1.applyGo] + rw [smaller.dropMany store arguments] + | loc location => + simp only [IxIR1.applyGo] + cases hbox : store.get? location with + | none => simp + | some box => + simp only + cases hnode : box.node with + | ctorN identity fields => simp + | papN called arity captured => + simp only + cases hdup : dupVals store captured.toList with + | error error => simp [bind, Except.bind] + | ok duplicated => + simp only [bind, Except.bind] + rw [smaller.dropVal duplicated (.loc location)] + cases hdrop : IxIR1.dropVal before fuel duplicated + (.loc location) with + | error error => rfl + | ok dropped => + let total := captured.toList ++ arguments + by_cases hless : total.length < arity + · have hlessSize : + captured.size + arguments.length < arity := by + simpa [total] using hless + simp [hlessSize] + · by_cases hequal : total.length = arity + · have hunderSize : + ¬captured.size + arguments.length < arity := by + simpa [total] using hless + have hequalSize : + captured.size + arguments.length = arity := by + simpa [total] using hequal + cases hsource : before.decls called with + | none => + have htarget := exact.missing hsource + simp [hunderSize, hequalSize, hsource, htarget] + | some declaration => + cases declaration with + | extern declarationArity => + have htarget := exact.extern hsource + simp [hunderSize, hequalSize, hsource, + htarget, smaller.invoke] + | fn source => + obtain ⟨target, htarget, _, _, hpapsafe, + _⟩ := exact.function hsource + simp [hunderSize, hequalSize, hsource, + htarget, declPapSafe, hpapsafe, + smaller.invoke] + rfl + · have hunderSize : + ¬captured.size + arguments.length < arity := by + simpa [total] using hless + have hnequalSize : + captured.size + arguments.length ≠ arity := by + simpa [total] using hequal + cases hsource : before.decls called with + | none => + have htarget := exact.missing hsource + simp [hunderSize, hnequalSize, hsource, + htarget] + | some declaration => + cases declaration with + | extern declarationArity => + have htarget := exact.extern hsource + simp [hunderSize, hnequalSize, hsource, + htarget, smaller.invoke, smaller.applyGo] + | fn source => + obtain ⟨target, htarget, _, _, hpapsafe, + _⟩ := exact.function hsource + simp [hunderSize, hnequalSize, hsource, + htarget, declPapSafe, hpapsafe, + smaller.invoke, smaller.applyGo] + rfl + · intro store value + cases value with + | lit literal => simp [IxIR1.dropVal] + | erased => simp [IxIR1.dropVal] + | loc location => + simp only [IxIR1.dropVal] + cases hbox : store.get? location with + | none => simp + | some box => + simp only + cases hworld : box.world with + | unique => simp + | shared => + simp only + by_cases hone : box.rc == 1 + · simp only [hone, ↓reduceIte] + cases hnode : box.node with + | ctorN identity fields => + simpa [hnode] using smaller.dropMany + (store.rcTick.kill location) fields.toList + | papN function arity arguments => + simpa [hnode] using smaller.dropMany + (store.rcTick.kill location) arguments.toList + · simp [hone] + · intro store values + cases values with + | nil => simp [IxIR1.dropMany] + | cons value rest => + simp only [IxIR1.dropMany] + rw [smaller.dropVal store value] + cases hdrop : IxIR1.dropVal before fuel store value with + | error error => rfl + | ok next => exact smaller.dropMany next rest + · intro store value + cases value with + | lit literal => simp [IxIR1.dropUVal] + | erased => simp [IxIR1.dropUVal] + | loc location => + simp only [IxIR1.dropUVal] + cases hbox : store.get? location with + | none => simp + | some box => + simp only + cases hworld : box.world with + | shared => simp + | unique => + simp only + cases hnode : box.node with + | ctorN identity fields => + simpa [hnode] using smaller.dropManyU + (store.kill location) fields.toList + | papN function arity arguments => simp + · intro store values + cases values with + | nil => simp [IxIR1.dropManyU] + | cons value rest => + simp only [IxIR1.dropManyU] + rw [smaller.dropUVal store value] + cases hdrop : IxIR1.dropUVal before fuel store value with + | error error => rfl + | ok next => exact smaller.dropManyU next rest + +/-- Exact declaration replacement preserves the complete evaluator result for +arbitrary surrounding code and dynamic current frames. -/ +theorem runCode_exactEnvironment_eq + {before after : Ctx} (exact : ExactEnvironment before after) + {fuel : Nat} {current : FnDef} {store : Store} + {environment : List RVal} {input : Code} : + runCode after fuel current store environment input = + runCode before fuel current store environment input := + (exactRewriteAt exact fuel).runCode current store environment input + +end Ix.Compiler.IxIR1.Sim diff --git a/Ix/Compiler/IxIR1/Examples.lean b/Ix/Compiler/IxIR1/Examples.lean new file mode 100644 index 000000000..0e2a831e3 --- /dev/null +++ b/Ix/Compiler/IxIR1/Examples.lean @@ -0,0 +1,375 @@ +import Ix.Compiler.IxIR1.Eval + +/-! +# Hand-written IxIR₁ programs + +The lowering targets, written by hand ahead of the lowering — exactly +the discipline that worked for IxIR₀. Everything is pure, so the +suite runs as elaboration-time `#guard`s, and the store counters turn +the memory claims into checked facts: + +- **FBIP reversal**: reversing a unique 3-list performs 3 in-place + reuses, 1 free (the input's nil), and **zero allocations** beyond + building the inputs. +- **Unique addition**: unary `add` consumes its recursion argument by + reuse — again no allocation beyond the inputs. +- **Shared world**: Perceus-style deep drop reclaims a shared list to + `live = 0` (leak-freedom as a `#guard`); `dup` defers reclamation + exactly one drop. +- **eval/apply**: pap under-fill, saturation, and over-fill chains. +- **The dynamic discipline**: `dup`/`drop` on unique, `free` on + shared, and use-after-free all fault as `Err.mem`. +-/ + +namespace Ix.Compiler.IxIR1.Examples + +open Ix.Compiler.Ixon (Address Owned) +open Ix.Compiler.IxIR0 (Literal) + +private def addrOf (n : UInt8) : Address := + Address.replicate n + +private def aListBlock := addrOf 0x60 +private def aNatBlock := addrOf 0x61 +private def aRev := addrOf 0x62 +private def aAdd := addrOf 0x63 +private def aAddLit := addrOf 0x64 +private def aIsZero := addrOf 0x65 +private def aKonstAdd := addrOf 0x66 +private def aNatAdd := addrOf 0x67 +private def aDirectOnly := addrOf 0x69 + +private def nilId : CtorId := ⟨aListBlock, 0, 0⟩ +private def consId : CtorId := ⟨aListBlock, 0, 1⟩ +private def zeroId : CtorId := ⟨aNatBlock, 0, 0⟩ +private def succId : CtorId := ⟨aNatBlock, 0, 1⟩ + +private def lets : List Op → Code → Code + | [], c => c + | op :: rest, c => .letOp op (lets rest c) + +/-- `rev (acc, xs)`: in-place list reversal. Entry env `[xs, acc]`. -/ +private def revBody : Code := + .case (.var 0) false #[ + -- nil: free the terminator, return acc + .mk 0 0 (lets [.free (.var 0)] (.ret (.var 2))), + -- cons(h, t): env [t, h, xs, acc]; reuse xs as cons(h, acc) + .mk 1 2 (lets + [ .reuse (.var 2) consId #[.var 1, .var 3], + .callSelf #[.var 0, .var 1] ] + (.ret (.var 0)))] + +/-- `add (m, n)`: unary addition, recursing and reusing on `n`. +Entry env `[n, m]`. -/ +private def addBody : Code := + .case (.var 0) false #[ + -- zero: free it, return m + .mk 0 0 (lets [.free (.var 0)] (.ret (.var 2))), + -- succ(p): env [p, n, m]; r := add(m, p); reuse n as succ(r) + .mk 1 1 (lets + [ .callSelf #[.var 2, .var 0], + .reuse (.var 2) succId #[.var 0] ] + (.ret (.var 0)))] + +/-- `addLit (a, b)`: scalar addition through the extern oracle. +Entry env `[b, a]`. -/ +private def addLitBody : Code := + lets [.extern aNatAdd #[.var 1, .var 0]] (.ret (.var 0)) + +/-- `isZero (x)`: nat-literal peeling. Entry env `[x]`. -/ +private def isZeroBody : Code := + .case (.var 0) true #[ + .mk 0 0 (.ret (.lit (.nat 1))), + .mk 1 1 (.ret (.lit (.nat 0)))] + +/-- `konstAdd (a)`: returns a pap — over-fill test material. -/ +private def konstAddBody : Code := + lets [.papp aAddLit #[.var 0]] (.ret (.var 0)) + +private def decls : List (Address × Decl) := + [(aRev, .fn ⟨2, .unique, false, revBody⟩), + (aAdd, .fn ⟨2, .unique, false, addBody⟩), + (aAddLit, .fn ⟨2, .shared, true, addLitBody⟩), + (aIsZero, .fn ⟨1, .shared, true, isZeroBody⟩), + (aKonstAdd, .fn ⟨1, .shared, true, konstAddBody⟩), + (aDirectOnly, .fn ⟨1, .shared, false, .ret (.var 0)⟩), + (aNatAdd, .extern 2)] + +private def oracle : Address → List RVal → Option RVal := fun a args => + if a == aNatAdd then + match args with + | [.lit (.nat m), .lit (.nat n)] => some (.lit (.nat (m + n))) + | _ => none + else none + +private def ctx : Ctx := { decls := Env.ofList decls, oracle } + +private def heapResultCtx : Ctx := + { decls := Env.ofList decls, oracle := fun _ _ => some (.loc 0) } + +private def run (c : Code) : Except Err (Store × RVal) := runMain ctx c + +/-! ## Decoders and guard helpers -/ + +private def natOf? (s : Store) : Nat → RVal → Option Nat + | 0, _ => none + | _, .lit (.nat n) => some n + | f + 1, .loc l => + match s.get? l with + | some box => + match box.node with + | .ctorN cid fields => + match cid.cidx, fields.toList with + | 0, [] => some 0 + | 1, [v] => (natOf? s f v).map (· + 1) + | _, _ => none + | _ => none + | none => none + | _, _ => none + +private def natsOf? (s : Store) : Nat → RVal → Option (List Nat) + | 0, _ => none + | f + 1, .loc l => + match s.get? l with + | some box => + match box.node with + | .ctorN cid fields => + match cid.cidx, fields.toList with + | 0, [] => some [] + | 1, [h, t] => do + let n ← natOf? s f h + let rest ← natsOf? s f t + pure (n :: rest) + | _, _ => none + | _ => none + | none => none + | _, _ => none + +private def checkRun (r : Except Err (Store × RVal)) + (p : Store → RVal → Bool) : Bool := + match r with + | .ok (s, v) => p s v + | .error _ => false + +private def errMem : Except Err (Store × RVal) → Bool + | .error (.mem _) => true + | _ => false + +private def errStuck : Except Err (Store × RVal) → Bool + | .error (.stuck _) => true + | _ => false + +/-! ## FBIP: reversal of a unique list allocates nothing -/ + +private def revDemo : Code := lets + [ .alloc .unique nilId #[], + .alloc .unique consId #[.lit (.nat 3), .var 0], + .alloc .unique consId #[.lit (.nat 2), .var 0], + .alloc .unique consId #[.lit (.nat 1), .var 0], + .alloc .unique nilId #[], + .call aRev #[.var 0, .var 1] ] + (.ret (.var 0)) + +#guard checkRun (run revDemo) fun s v => + natsOf? s 1000 v == some [3, 2, 1] + && s.allocs == 5 -- 4 building the input + 1 accumulator nil + && s.reuses == 3 -- every cons flipped in place + && s.frees == 1 -- the input's nil terminator + && s.live == 4 -- exactly the result list + +/-! ## Unique unary addition: reuse along the recursion spine -/ + +private def addDemo : Code := lets + [ .alloc .unique zeroId #[], + .alloc .unique succId #[.var 0], + .alloc .unique succId #[.var 0], -- m = 2̂ + .alloc .unique zeroId #[], + .alloc .unique succId #[.var 0], + .alloc .unique succId #[.var 0], + .alloc .unique succId #[.var 0], -- n = 3̂ + .call aAdd #[.var 4, .var 0] ] + (.ret (.var 0)) + +#guard checkRun (run addDemo) fun s v => + natOf? s 1000 v == some 5 + && s.allocs == 7 && s.reuses == 3 && s.frees == 1 && s.live == 6 + +/-! ## Shared world: deep drop is leak-free; dup defers it -/ + +private def sharedDrop : Code := lets + [ .alloc .shared nilId #[], + .alloc .shared consId #[.lit (.nat 2), .var 0], + .alloc .shared consId #[.lit (.nat 1), .var 0], + .drop (.var 0) ] + (.ret .erased) + +#guard checkRun (run sharedDrop) fun s _ => + s.live == 0 && s.frees == 3 && s.rcops == 3 + +private def sharedDupDrop : Code := lets + [ .alloc .shared nilId #[], + .alloc .shared consId #[.lit (.nat 2), .var 0], + .alloc .shared consId #[.lit (.nat 1), .var 0], + .dup (.var 0), + .drop (.var 0), -- rc 2 → 1: still live + .drop (.var 1) ] -- rc 1 → 0: deep free + (.ret .erased) + +#guard checkRun (run sharedDupDrop) fun s _ => + s.live == 0 && s.frees == 3 && s.rcops == 5 + +-- After only the first drop, everything must still be live. +private def sharedDupHold : Code := lets + [ .alloc .shared nilId #[], + .alloc .shared consId #[.lit (.nat 2), .var 0], + .alloc .shared consId #[.lit (.nat 1), .var 0], + .dup (.var 0), + .drop (.var 0) ] + (.ret (.var 1)) + +#guard checkRun (run sharedDupHold) fun s v => + s.live == 3 && natsOf? s 1000 v == some [1, 2] + +/-! ## eval/apply: under-fill, saturation, over-fill -/ + +private def papDemo : Code := lets + [ .papp aAddLit #[.lit (.nat 20)], + .apply (.var 0) #[.lit (.nat 22)] ] + (.ret (.var 0)) + +#guard checkRun (run papDemo) fun _ v => v == .lit (.nat 42) + +private def papChain : Code := lets + [ .papp aAddLit #[], + .apply (.var 0) #[.lit (.nat 20)], -- under-fill: new pap + .apply (.var 0) #[.lit (.nat 22)] ] -- saturates + (.ret (.var 0)) + +#guard checkRun (run papChain) fun s v => + v == .lit (.nat 42) && s.allocs == 2 + +private def papOverfill : Code := lets + [ .papp aKonstAdd #[], + .apply (.var 0) #[.lit (.nat 20), .lit (.nat 22)] ] + (.ret (.var 0)) + +#guard checkRun (run papOverfill) fun _ v => v == .lit (.nat 42) + +-- Direct entry remains available for declarations that do not opt into the +-- shared PAP calling convention. +#guard checkRun (run (lets + [.call aDirectOnly #[.lit (.nat 42)]] (.ret (.var 0)))) fun _ v => + v == .lit (.nat 42) + +-- The same declaration cannot be entered through a saturated PAP. +#guard + match run (lets + [.papp aDirectOnly #[], .apply (.var 0) #[.lit (.nat 42)]] + (.ret (.var 0))) with + | .error (.stuck "shared pap targets a non-pap-safe declaration") => true + | _ => false + +-- `apply` consumes its pap: the chain's intermediates are reclaimed +-- without caller-side drops… +#guard checkRun (run papChain) fun s _ => s.frees == 2 && s.live == 0 + +-- …so re-applying a consumed pap is a memory fault… +#guard errMem (run (lets + [ .papp aAddLit #[.lit (.nat 1)], + .apply (.var 0) #[.lit (.nat 2)], + .apply (.var 1) #[.lit (.nat 3)] ] + (.ret (.var 0)))) + +-- …and `dup` is how a pap survives one application: rc 2 → 1 at the +-- first apply, consumed for real at the second, leak-free overall. +#guard checkRun (run (lets + [ .papp aAddLit #[.lit (.nat 1)], + .dup (.var 0), + .apply (.var 0) #[.lit (.nat 2)], + .apply (.var 2) #[.lit (.nat 3)] ] + (.ret (.var 0)))) fun s v => v == .lit (.nat 4) && s.live == 0 + +/-! ## Nat-literal peeling -/ + +#guard checkRun (run (lets [.call aIsZero #[.lit (.nat 0)]] + (.ret (.var 0)))) fun _ v => v == .lit (.nat 1) +#guard checkRun (run (lets [.call aIsZero #[.lit (.nat 7)]] + (.ret (.var 0)))) fun _ v => v == .lit (.nat 0) +#guard errStuck (run (.case (.lit (.nat 3)) false #[])) + +/-! ## `dropU`: deep free of a unique tree -/ + +-- Three unique nodes reclaimed with zero refcount traffic. +#guard checkRun (run (lets + [ .alloc .unique nilId #[], + .alloc .unique consId #[.lit (.nat 2), .var 0], + .alloc .unique consId #[.lit (.nat 1), .var 0], + .dropU (.var 0) ] + (.ret .erased))) fun s _ => + s.live == 0 && s.frees == 3 && s.rcops == 0 + +-- dropU demands the unique world… +#guard errMem (run (lets + [.alloc .shared nilId #[], .dropU (.var 0)] (.ret .erased))) + +-- …and whole-value modes: a shared child under a unique node faults +-- (symmetric to deep drop's unique-under-shared check). +#guard errMem (run (lets + [ .alloc .shared nilId #[], + .alloc .unique consId #[.lit (.nat 1), .var 0], + .dropU (.var 0) ] + (.ret .erased))) + +/-! ## The dynamic memory discipline -/ + +#guard errMem (run (lets + [.alloc .unique nilId #[], .dup (.var 0)] (.ret .erased))) +#guard errMem (run (lets + [.alloc .unique nilId #[], .drop (.var 0)] (.ret .erased))) +#guard errMem (run (lets + [.alloc .shared nilId #[], .free (.var 0)] (.ret .erased))) +#guard errMem (run (lets + [.alloc .shared nilId #[], .reuse (.var 0) nilId #[]] (.ret .erased))) +#guard errMem (run (lets + [.alloc .unique nilId #[], .free (.var 0), .fetch (.var 1) 0] + (.ret .erased))) +#guard errMem (run (lets + [.alloc .unique nilId #[], .free (.var 0), .free (.var 1)] + (.ret .erased))) + +-- Function result signatures are checked at the dynamic call boundary too: +-- malformed hand-written code cannot return a unique node as `.shared`. +private def aBadResult := addrOf 0x68 +private def badResultCtx : Ctx := + { decls := Env.ofList [(aBadResult, .fn ⟨0, .shared, false, + lets [.alloc .unique nilId #[]] (.ret (.var 0))⟩)] } + +#guard + match invoke badResultCtx 10 aBadResult [] {} with + | .error (.mem "function result ownership mismatch") => true + | _ => false + +-- Structural stuckness stays distinct from memory faults. +#guard errStuck (run (.case .erased false #[])) +#guard errStuck (run (lets + [.papp aAddLit #[.lit (.nat 1), .lit (.nat 2)]] (.ret .erased))) + +/-! Externs are a scalar-only ownership boundary in v1. A location may +neither be passed to an oracle nor be manufactured by one. -/ + +#guard errMem (run (lets + [ .alloc .shared nilId #[], + .extern aNatAdd #[.var 0, .lit (.nat 1)] ] + (.ret .erased))) + +#guard errMem (runMain heapResultCtx (lets + [ .alloc .shared nilId #[], + .extern aNatAdd #[.lit (.nat 1), .lit (.nat 2)] ] + (.ret .erased))) + +-- Fuel: self-application-free divergence via callSelf at top level. +#guard (match runMain ctx (lets [.callSelf #[]] (.ret (.var 0))) 100 with + | .error .fuel => true + | _ => false) + +end Ix.Compiler.IxIR1.Examples diff --git a/Ix/Compiler/IxIR1/HPT.lean b/Ix/Compiler/IxIR1/HPT.lean new file mode 100644 index 000000000..842e6406f --- /dev/null +++ b/Ix/Compiler/IxIR1/HPT.lean @@ -0,0 +1,1735 @@ +import Ix.Compiler.IxIR1.ReaddressAll +import Ix.Compiler.IxIR1.Eval +import Ix.Compiler.Ixon.Merkle + +/-! +# Cached heap-points-to summary certificates for IxIR₁ + +This module introduces the first analysis-certificate boundary over the +content-addressed IxIR₁ program. The untrusted input is a finite result-shape +summary for every declaration. The checker interprets each function once +against the complete candidate environment and accepts only a post-fixpoint: +the locally inferred result shapes must be contained in the claimed summary. + +The abstract domain distinguishes scalar results, constructor identities, and +partial applications with an exact target and supplied-argument count. +Constructor results may additionally carry finite recursive field facts: +allocation records argument facts, fetch re-roots a selected subtree, and +case alternatives recover the same refined binder facts. Function parameters +begin at `top`, so accepted summaries are valid without a caller-specific +precondition. Unknown dynamic heap values and identity-only constructor facts +still widen on fetch. Explicit depth and total-payload limits keep untrusted +trees finite before normalization, interpretation, or hashing. + +Checked summaries are materialized at the same SCC granularity as +`ReaddressAll.Artifact`. An ordinary summary cache key commits to the +declaration address and the already-checked dependency-summary addresses; all +members of a recursive SCC share one cache key committed to the mutual-block +address. Thus recursive analysis facts have a finite spelling, while changes +outside a dependency cone do not perturb an unrelated cache key. +-/ + +namespace Ix.Compiler.IxIR1.HPT + +open Ix.Compiler.Ixon (Address) +open Ix.Compiler.IxIR + +/-! ## Abstract result and constructor-field shapes -/ + +private def compareNat (left right : Nat) : Ordering := + compare left right + +private def compareBool : Bool → Bool → Ordering + | false, false | true, true => .eq + | false, true => .lt + | true, false => .gt + +private def compareCtor (left right : CtorId) : Ordering := + match Ixon.Merkle.compareAddress left.block right.block with + | .lt => .lt + | .gt => .gt + | .eq => + match compareNat left.indIdx right.indIdx with + | .lt => .lt + | .gt => .gt + | .eq => compareNat left.cidx right.cidx + +private def compareList (compare : α → α → Ordering) : + List α → List α → Ordering + | [], [] => .eq + | [], _ :: _ => .lt + | _ :: _, [] => .gt + | left :: lefts, right :: rights => + match compare left right with + | .lt => .lt + | .gt => .gt + | .eq => compareList compare lefts rights + +/- A recursively refined heap shape retained inside a constructor field. +`none` keeps only a constructor identity; `some fields` describes the exact +field vector and may itself contain further refined constructor shapes. The +certificate preflight and cache decoder bound recursion depth and total +payload before normalization or interpretation. -/ +mutual + +inductive FieldShape where + | ctor (identity : CtorId) (fields : Option (List FieldFact)) + | pap (function : Address) (supplied : Nat) + deriving Repr, Inhabited + +/-- A finite recursive fact for one constructor field. -/ +structure FieldFact where + mayScalar : Bool + unknownHeap : Bool + shapes : List FieldShape + deriving Repr, Inhabited + +end + + +/-! `deriving LawfulBEq` does not support mutually recursive inductives. Keep +the executable equality explicit and prove its reflection below, so recursive +facts remain usable by canonicalization without introducing an axiom. -/ + +mutual + +def FieldShape.compare : FieldShape → FieldShape → Ordering + | .ctor left leftFields, .ctor right rightFields => + match compareCtor left right with + | .lt => .lt + | .gt => .gt + | .eq => FieldFact.compareOptions leftFields rightFields + | .ctor _ _, .pap _ _ => .lt + | .pap _ _, .ctor _ _ => .gt + | .pap leftFunction leftSupplied, .pap rightFunction rightSupplied => + match Ixon.Merkle.compareAddress leftFunction rightFunction with + | .lt => .lt + | .gt => .gt + | .eq => compareNat leftSupplied rightSupplied +termination_by left right => sizeOf left + sizeOf right +decreasing_by all_goals simp_wf <;> omega + +def FieldFact.compare (left right : FieldFact) : Ordering := + match compareBool left.mayScalar right.mayScalar with + | .lt => .lt + | .gt => .gt + | .eq => + match compareBool left.unknownHeap right.unknownHeap with + | .lt => .lt + | .gt => .gt + | .eq => FieldShape.compareLists left.shapes right.shapes +termination_by sizeOf left + sizeOf right +decreasing_by + cases left + cases right + simp_wf + omega + +def FieldShape.compareLists : List FieldShape → List FieldShape → Ordering + | [], [] => .eq + | [], _ :: _ => .lt + | _ :: _, [] => .gt + | left :: lefts, right :: rights => + match left.compare right with + | .lt => .lt + | .gt => .gt + | .eq => FieldShape.compareLists lefts rights +termination_by left right => sizeOf left + sizeOf right +decreasing_by all_goals simp_wf <;> omega + +def FieldFact.compareLists : List FieldFact → List FieldFact → Ordering + | [], [] => .eq + | [], _ :: _ => .lt + | _ :: _, [] => .gt + | left :: lefts, right :: rights => + match left.compare right with + | .lt => .lt + | .gt => .gt + | .eq => FieldFact.compareLists lefts rights +termination_by left right => sizeOf left + sizeOf right +decreasing_by all_goals simp_wf <;> omega + +def FieldFact.compareOptions : Option (List FieldFact) → + Option (List FieldFact) → Ordering + | none, none => .eq + | none, some _ => .lt + | some _, none => .gt + | some left, some right => FieldFact.compareLists left right +termination_by left right => sizeOf left + sizeOf right +decreasing_by all_goals simp_wf <;> omega + +end + + +mutual + +def FieldShape.beq : FieldShape → FieldShape → Bool + | .ctor left leftFields, .ctor right rightFields => + left == right && FieldFact.beqOptions leftFields rightFields + | .pap leftFunction leftSupplied, .pap rightFunction rightSupplied => + leftFunction == rightFunction && leftSupplied == rightSupplied + | _, _ => false +termination_by left right => sizeOf left + sizeOf right +decreasing_by all_goals simp_wf <;> omega + +def FieldFact.beq (left right : FieldFact) : Bool := + left.mayScalar == right.mayScalar && + left.unknownHeap == right.unknownHeap && + FieldShape.beqLists left.shapes right.shapes +termination_by sizeOf left + sizeOf right +decreasing_by + cases left + cases right + simp_wf + omega + +def FieldShape.beqLists : List FieldShape → List FieldShape → Bool + | [], [] => true + | left :: lefts, right :: rights => + left.beq right && FieldShape.beqLists lefts rights + | _, _ => false +termination_by left right => sizeOf left + sizeOf right +decreasing_by all_goals simp_wf <;> omega + +def FieldFact.beqLists : List FieldFact → List FieldFact → Bool + | [], [] => true + | left :: lefts, right :: rights => + left.beq right && FieldFact.beqLists lefts rights + | _, _ => false +termination_by left right => sizeOf left + sizeOf right +decreasing_by all_goals simp_wf <;> omega + +def FieldFact.beqOptions : Option (List FieldFact) → + Option (List FieldFact) → Bool + | none, none => true + | some left, some right => FieldFact.beqLists left right + | _, _ => false +termination_by left right => sizeOf left + sizeOf right +decreasing_by all_goals simp_wf <;> omega + +end + + +mutual + +theorem FieldShape.eq_of_beq {left right : FieldShape} + (h : left.beq right = true) : left = right := + match left, right with + | .ctor identity fields, .ctor identity' fields' => by + simp only [FieldShape.beq, Bool.and_eq_true] at h + have hidentity : identity = identity' := beq_iff_eq.mp h.1 + have hfields : fields = fields' := FieldFact.options_eq_of_beq h.2 + subst identity' + subst fields' + rfl + | .pap function supplied, .pap function' supplied' => by + simp only [FieldShape.beq, Bool.and_eq_true] at h + have hfunction : function = function' := beq_iff_eq.mp h.1 + have hsupplied : supplied = supplied' := beq_iff_eq.mp h.2 + subst function' + subst supplied' + rfl + | .ctor _ _, .pap _ _ | .pap _ _, .ctor _ _ => by + simp [FieldShape.beq] at h +termination_by sizeOf left + sizeOf right +decreasing_by all_goals simp_wf <;> omega + +theorem FieldFact.eq_of_beq {left right : FieldFact} + (h : left.beq right = true) : left = right := + match left, right with + | ⟨leftScalar, leftUnknown, leftShapes⟩, + ⟨rightScalar, rightUnknown, rightShapes⟩ => by + simp only [FieldFact.beq, Bool.and_eq_true] at h + have hscalar : leftScalar = rightScalar := beq_iff_eq.mp h.1.1 + have hunknown : leftUnknown = rightUnknown := beq_iff_eq.mp h.1.2 + have hshapes : leftShapes = rightShapes := + FieldShape.lists_eq_of_beq h.2 + subst rightScalar + subst rightUnknown + subst rightShapes + rfl +termination_by sizeOf left + sizeOf right +decreasing_by all_goals simp_wf <;> omega + +theorem FieldShape.lists_eq_of_beq {left right : List FieldShape} + (h : FieldShape.beqLists left right = true) : left = right := + match left, right with + | [], [] => rfl + | left :: lefts, right :: rights => by + simp only [FieldShape.beqLists, Bool.and_eq_true] at h + have hhead := FieldShape.eq_of_beq h.1 + have htail := FieldShape.lists_eq_of_beq h.2 + subst right + subst rights + rfl + | [], _ :: _ | _ :: _, [] => by simp [FieldShape.beqLists] at h +termination_by sizeOf left + sizeOf right +decreasing_by all_goals simp_wf <;> omega + +theorem FieldFact.lists_eq_of_beq {left right : List FieldFact} + (h : FieldFact.beqLists left right = true) : left = right := + match left, right with + | [], [] => rfl + | left :: lefts, right :: rights => by + simp only [FieldFact.beqLists, Bool.and_eq_true] at h + have hhead := FieldFact.eq_of_beq h.1 + have htail := FieldFact.lists_eq_of_beq h.2 + subst right + subst rights + rfl + | [], _ :: _ | _ :: _, [] => by simp [FieldFact.beqLists] at h +termination_by sizeOf left + sizeOf right +decreasing_by all_goals simp_wf <;> omega + +theorem FieldFact.options_eq_of_beq + {left right : Option (List FieldFact)} + (h : FieldFact.beqOptions left right = true) : left = right := + match left, right with + | none, none => rfl + | some left, some right => + congrArg some (FieldFact.lists_eq_of_beq + (by simpa [FieldFact.beqOptions] using h)) + | none, some _ | some _, none => by simp [FieldFact.beqOptions] at h +termination_by sizeOf left + sizeOf right +decreasing_by all_goals simp_wf <;> omega + +end + + +mutual + +theorem FieldShape.beq_refl (shape : FieldShape) : shape.beq shape = true := by + cases shape with + | ctor identity fields => + simp only [FieldShape.beq, beq_iff_eq.mpr rfl] + exact FieldFact.beqOptions_refl fields + | pap function supplied => simp [FieldShape.beq] +termination_by sizeOf shape +decreasing_by all_goals simp_wf <;> omega + +theorem FieldFact.beq_refl (fact : FieldFact) : fact.beq fact = true := by + cases fact with + | mk mayScalar unknownHeap shapes => + simp only [FieldFact.beq, beq_iff_eq.mpr rfl] + exact FieldShape.beqLists_refl shapes +termination_by sizeOf fact +decreasing_by all_goals simp_wf <;> omega + +theorem FieldShape.beqLists_refl (shapes : List FieldShape) : + FieldShape.beqLists shapes shapes = true := by + cases shapes with + | nil => simp [FieldShape.beqLists] + | cons head tail => + simp [FieldShape.beqLists, FieldShape.beq_refl head, + FieldShape.beqLists_refl tail] +termination_by sizeOf shapes +decreasing_by all_goals simp_wf <;> omega + +theorem FieldFact.beqLists_refl (facts : List FieldFact) : + FieldFact.beqLists facts facts = true := by + cases facts with + | nil => simp [FieldFact.beqLists] + | cons head tail => + simp [FieldFact.beqLists, FieldFact.beq_refl head, + FieldFact.beqLists_refl tail] +termination_by sizeOf facts +decreasing_by all_goals simp_wf <;> omega + +theorem FieldFact.beqOptions_refl (facts : Option (List FieldFact)) : + FieldFact.beqOptions facts facts = true := by + cases facts with + | none => simp [FieldFact.beqOptions] + | some facts => simpa [FieldFact.beqOptions] using + FieldFact.beqLists_refl facts +termination_by sizeOf facts +decreasing_by all_goals simp_wf <;> omega + +end + + +instance : BEq FieldShape := ⟨FieldShape.beq⟩ + +instance : ReflBEq FieldShape where + rfl := by intro shape; exact FieldShape.beq_refl shape + +instance : LawfulBEq FieldShape := ⟨FieldShape.eq_of_beq⟩ + +instance : DecidableEq FieldShape := instDecidableEqOfLawfulBEq + +instance : BEq FieldFact := ⟨FieldFact.beq⟩ + +instance : ReflBEq FieldFact where + rfl := by intro fact; exact FieldFact.beq_refl fact + +instance : LawfulBEq FieldFact := ⟨FieldFact.eq_of_beq⟩ + +instance : DecidableEq FieldFact := instDecidableEqOfLawfulBEq + +namespace FieldShape + +private def insert (shape : FieldShape) : List FieldShape → List FieldShape + | [] => [shape] + | head :: tail => + match compare shape head with + | .lt => shape :: head :: tail + | .eq => + if shape == head then head :: tail + else shape :: head :: tail + | .gt => head :: insert shape tail + +def normalize (shapes : List FieldShape) : List FieldShape := + shapes.foldr insert [] + +private theorem mem_insert_of_mem {needle shape : FieldShape} + {shapes : List FieldShape} (h : needle ∈ shapes) : + needle ∈ insert shape shapes := by + induction shapes with + | nil => contradiction + | cons head tail ih => + cases hcompare : compare shape head with + | lt => + rw [insert, hcompare] + exact List.mem_cons.mpr (Or.inr h) + | eq => + by_cases heq : shape = head + · rw [insert, hcompare, if_pos ((beq_iff_eq).mpr heq)] + exact h + · rw [insert, hcompare, if_neg (by simpa using heq)] + exact List.mem_cons.mpr (Or.inr h) + | gt => + rw [insert, hcompare] + rcases List.mem_cons.mp h with hhead | htail + · exact List.mem_cons.mpr (Or.inl hhead) + · exact List.mem_cons.mpr (Or.inr (ih htail)) + +private theorem mem_insert_self (shape : FieldShape) + (shapes : List FieldShape) : shape ∈ insert shape shapes := by + induction shapes with + | nil => simp [insert] + | cons head tail ih => + cases hcompare : compare shape head with + | lt => + rw [insert, hcompare] + exact List.mem_cons.mpr (Or.inl rfl) + | eq => + by_cases heq : shape = head + · rw [insert, hcompare, if_pos ((beq_iff_eq).mpr heq)] + exact List.mem_cons.mpr (Or.inl heq) + · rw [insert, hcompare, if_neg (by simpa using heq)] + exact List.mem_cons.mpr (Or.inl rfl) + | gt => + rw [insert, hcompare] + exact List.mem_cons.mpr (Or.inr ih) + +theorem mem_normalize_of_mem {shape : FieldShape} {shapes : List FieldShape} + (h : shape ∈ shapes) : shape ∈ normalize shapes := by + unfold normalize + induction shapes with + | nil => contradiction + | cons head tail ih => + simp only [List.foldr_cons] + rcases List.mem_cons.mp h with hhead | htail + · subst head + exact mem_insert_self shape _ + · exact mem_insert_of_mem (ih htail) + +end FieldShape + +namespace FieldFact + +def bottom : FieldFact := ⟨false, false, []⟩ +def scalar : FieldFact := ⟨true, false, []⟩ +def heap (shape : FieldShape) : FieldFact := ⟨false, false, [shape]⟩ +def top : FieldFact := ⟨true, true, []⟩ + +def normalize (fact : FieldFact) : FieldFact := + if fact.unknownHeap then + { fact with shapes := [] } + else + { fact with shapes := FieldShape.normalize fact.shapes } + +end FieldFact + +mutual + +def FieldShape.canonical : FieldShape → Bool + | .ctor _ none | .pap _ _ => true + | .ctor _ (some fields) => FieldFact.allCanonical fields +termination_by shape => sizeOf shape +decreasing_by all_goals simp_wf <;> omega + +def FieldFact.canonical (fact : FieldFact) : Bool := + fact == fact.normalize && FieldShape.allCanonical fact.shapes +termination_by sizeOf fact +decreasing_by + cases fact + simp_wf + +def FieldShape.allCanonical : List FieldShape → Bool + | [] => true + | shape :: shapes => shape.canonical && FieldShape.allCanonical shapes +termination_by shapes => sizeOf shapes +decreasing_by all_goals simp_wf <;> omega + +def FieldFact.allCanonical : List FieldFact → Bool + | [] => true + | fact :: facts => fact.canonical && FieldFact.allCanonical facts +termination_by facts => sizeOf facts +decreasing_by all_goals simp_wf <;> omega + +end + +mutual + +def FieldShape.le : FieldShape → FieldShape → Bool + | .ctor left leftFields, .ctor right rightFields => + left == right && + match rightFields with + | none => true + | some rightFacts => + match leftFields with + | none => false + | some leftFacts => FieldFact.listLe leftFacts rightFacts + | .pap leftFunction leftSupplied, .pap rightFunction rightSupplied => + leftFunction == rightFunction && leftSupplied == rightSupplied + | _, _ => false +termination_by left right => sizeOf left + sizeOf right +decreasing_by all_goals simp_wf <;> omega + +def FieldFact.le (left right : FieldFact) : Bool := + (!left.mayScalar || right.mayScalar) && + (right.unknownHeap || + (!left.unknownHeap && FieldShape.allLe left.shapes right.shapes)) +termination_by sizeOf left + sizeOf right +decreasing_by + cases left + cases right + simp_wf + omega + +def FieldShape.allLe : List FieldShape → List FieldShape → Bool + | [], _ => true + | left :: lefts, rights => + FieldShape.anyLe left rights && FieldShape.allLe lefts rights +termination_by left right => sizeOf left + sizeOf right +decreasing_by all_goals simp_wf <;> omega + +def FieldShape.anyLe (left : FieldShape) : List FieldShape → Bool + | [] => false + | right :: rights => left.le right || FieldShape.anyLe left rights +termination_by rights => sizeOf left + sizeOf rights +decreasing_by all_goals simp_wf <;> omega + +def FieldFact.listLe : List FieldFact → List FieldFact → Bool + | [], [] => true + | left :: lefts, right :: rights => + left.le right && FieldFact.listLe lefts rights + | _, _ => false +termination_by left right => sizeOf left + sizeOf right +decreasing_by all_goals simp_wf <;> omega + +end + +namespace FieldFact + +def join (left right : FieldFact) : FieldFact := + normalize + { mayScalar := left.mayScalar || right.mayScalar + unknownHeap := left.unknownHeap || right.unknownHeap + shapes := left.shapes ++ right.shapes } + +def forgetHeap (fact : FieldFact) : FieldFact := + if fact.unknownHeap || !fact.shapes.isEmpty then + { mayScalar := fact.mayScalar, unknownHeap := true, shapes := [] } + else + fact + +end FieldFact + +mutual + +def FieldShape.bytes : FieldShape → ByteArray + | .ctor identity fields => Encoding.tag 0 ++ + Encoding.address identity.block ++ Encoding.nat identity.indIdx ++ + Encoding.nat identity.cidx ++ FieldFact.optionBytes fields + | .pap function supplied => Encoding.tag 1 ++ + Encoding.address function ++ Encoding.nat supplied +termination_by shape => sizeOf shape +decreasing_by all_goals simp_wf <;> omega + +def FieldFact.bytes (fact : FieldFact) : ByteArray := + Encoding.bool fact.mayScalar ++ Encoding.bool fact.unknownHeap ++ + Encoding.nat fact.shapes.length ++ FieldShape.payloadBytes fact.shapes +termination_by sizeOf fact +decreasing_by + cases fact + simp_wf + +def FieldShape.payloadBytes : List FieldShape → ByteArray + | [] => ByteArray.empty + | shape :: shapes => shape.bytes ++ FieldShape.payloadBytes shapes +termination_by shapes => sizeOf shapes +decreasing_by all_goals simp_wf <;> omega + +def FieldFact.payloadBytes : List FieldFact → ByteArray + | [] => ByteArray.empty + | fact :: facts => fact.bytes ++ FieldFact.payloadBytes facts +termination_by facts => sizeOf facts +decreasing_by all_goals simp_wf <;> omega + +def FieldFact.optionBytes : Option (List FieldFact) → ByteArray + | none => Encoding.tag 0 + | some facts => Encoding.tag 1 ++ Encoding.nat facts.length ++ + FieldFact.payloadBytes facts +termination_by facts => sizeOf facts +decreasing_by all_goals simp_wf <;> omega + +end + +/-- One result heap shape. A constructor may carry exact recursively refined +field facts; `none` retains only its identity and deliberately means unknown +contents. -/ +inductive HeapShape where + | ctor (identity : CtorId) (fields : Option (List FieldFact)) + | pap (function : Address) (supplied : Nat) + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +namespace HeapShape + +private def compareFields : Option (List FieldFact) → + Option (List FieldFact) → Ordering + | none, none => .eq + | none, some _ => .lt + | some _, none => .gt + | some left, some right => compareList FieldFact.compare left right + +def compare : HeapShape → HeapShape → Ordering + | .ctor left leftFields, .ctor right rightFields => + match compareCtor left right with + | .lt => .lt + | .gt => .gt + | .eq => compareFields leftFields rightFields + | .ctor _ _, .pap _ _ => .lt + | .pap _ _, .ctor _ _ => .gt + | .pap leftFunction leftSupplied, .pap rightFunction rightSupplied => + match Ixon.Merkle.compareAddress leftFunction rightFunction with + | .lt => .lt + | .gt => .gt + | .eq => compareNat leftSupplied rightSupplied + +private def insert (shape : HeapShape) : List HeapShape → List HeapShape + | [] => [shape] + | head :: tail => + match compare shape head with + | .lt => shape :: head :: tail + | .eq => + if shape == head then head :: tail + else shape :: head :: tail + | .gt => head :: insert shape tail + +def normalize (shapes : List HeapShape) : List HeapShape := + shapes.foldr insert [] + +private theorem mem_insert_of_mem {needle shape : HeapShape} + {shapes : List HeapShape} (h : needle ∈ shapes) : + needle ∈ insert shape shapes := by + induction shapes with + | nil => contradiction + | cons head tail ih => + cases hcompare : compare shape head with + | lt => + rw [insert, hcompare] + exact List.mem_cons.mpr (Or.inr h) + | eq => + by_cases heq : shape = head + · rw [insert, hcompare, if_pos ((beq_iff_eq).mpr heq)] + exact h + · rw [insert, hcompare, if_neg (by simpa using heq)] + exact List.mem_cons.mpr (Or.inr h) + | gt => + rw [insert, hcompare] + rcases List.mem_cons.mp h with hhead | htail + · exact List.mem_cons.mpr (Or.inl hhead) + · exact List.mem_cons.mpr (Or.inr (ih htail)) + +private theorem mem_insert_self (shape : HeapShape) + (shapes : List HeapShape) : shape ∈ insert shape shapes := by + induction shapes with + | nil => simp [insert] + | cons head tail ih => + cases hcompare : compare shape head with + | lt => + rw [insert, hcompare] + exact List.mem_cons.mpr (Or.inl rfl) + | eq => + by_cases heq : shape = head + · rw [insert, hcompare, if_pos ((beq_iff_eq).mpr heq)] + exact List.mem_cons.mpr (Or.inl heq) + · rw [insert, hcompare, if_neg (by simpa using heq)] + exact List.mem_cons.mpr (Or.inl rfl) + | gt => + rw [insert, hcompare] + exact List.mem_cons.mpr (Or.inr ih) + +theorem mem_normalize_of_mem {shape : HeapShape} {shapes : List HeapShape} + (h : shape ∈ shapes) : shape ∈ normalize shapes := by + unfold normalize + induction shapes with + | nil => contradiction + | cons head tail ih => + simp only [List.foldr_cons] + rcases List.mem_cons.mp h with hhead | htail + · subst head + exact mem_insert_self shape _ + · exact mem_insert_of_mem (ih htail) + +def fieldFactsLe : List FieldFact → List FieldFact → Bool + | [], [] => true + | left :: lefts, right :: rights => + left.le right && fieldFactsLe lefts rights + | _, _ => false + +/-- One detailed constructor shape is below an identity-only shape; detailed +shapes compare field facts pointwise. -/ +def le : HeapShape → HeapShape → Bool + | .ctor left leftFields, .ctor right rightFields => + left == right && + match rightFields with + | none => true + | some rightFacts => + match leftFields with + | none => false + | some leftFacts => fieldFactsLe leftFacts rightFacts + | .pap leftFunction leftSupplied, .pap rightFunction rightSupplied => + leftFunction == rightFunction && leftSupplied == rightSupplied + | _, _ => false + +def canonical : HeapShape → Bool + | .ctor _ none | .pap _ _ => true + | .ctor _ (some fields) => fields.all FieldFact.canonical + +def bytes : HeapShape → ByteArray + | .ctor identity fields => Encoding.tag 0 ++ + Encoding.address identity.block ++ Encoding.nat identity.indIdx ++ + Encoding.nat identity.cidx ++ + match fields with + | none => Encoding.tag 0 + | some facts => Encoding.tag 1 ++ Encoding.list FieldFact.bytes facts + | .pap function supplied => Encoding.tag 1 ++ + Encoding.address function ++ Encoding.nat supplied + +def toFieldShape : HeapShape → FieldShape + | .ctor identity fields => .ctor identity fields + | .pap function supplied => .pap function supplied + +end HeapShape + +/-- A finite result-shape fact. `unknownHeap` means every constructor/PAP +shape is possible; canonical facts omit the then-redundant explicit list. -/ +structure Fact where + mayScalar : Bool + unknownHeap : Bool + shapes : List HeapShape + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +namespace Fact + +def bottom : Fact := ⟨false, false, []⟩ +def scalar : Fact := ⟨true, false, []⟩ +def heap (shape : HeapShape) : Fact := ⟨false, false, [shape]⟩ +def top : Fact := ⟨true, true, []⟩ + +/-- Recover a constructor identity only when the fact excludes scalars, +unknown heap values, PAPs, and every competing heap shape. Field detail is +irrelevant to identity provenance, so both identity-only and recursively +refined constructor shapes qualify. -/ +def exactConstructor? : Fact → Option CtorId + | ⟨false, false, [.ctor identity _]⟩ => some identity + | _ => none + +theorem exactConstructor?_eq_some {fact : Fact} {identity : CtorId} + (h : fact.exactConstructor? = some identity) : + ∃ fields, + fact = ⟨false, false, [.ctor identity fields]⟩ := by + unfold exactConstructor? at h + split at h <;> simp_all + +def normalize (fact : Fact) : Fact := + if fact.unknownHeap then + { fact with shapes := [] } + else + { fact with shapes := HeapShape.normalize fact.shapes } + +def canonical (fact : Fact) : Bool := + fact == fact.normalize && fact.shapes.all HeapShape.canonical + +/-- Executable subset on the abstract domain. -/ +def le (left right : Fact) : Bool := + (!left.mayScalar || right.mayScalar) && + (right.unknownHeap || + (!left.unknownHeap && + left.shapes.all fun leftShape => + right.shapes.any (HeapShape.le leftShape))) + +def join (left right : Fact) : Fact := + normalize + { mayScalar := left.mayScalar || right.mayScalar + unknownHeap := left.unknownHeap || right.unknownHeap + shapes := left.shapes ++ right.shapes } + +def joins : List Fact → Fact + | [] => bottom + | fact :: facts => fact.join (joins facts) + +/-- Forget the current identity of any heap result while preserving exact +scalar-only information. Primitive operations may mutate or consume a +location still named by an older environment slot; without a separate alias +domain, retaining that slot's finite constructor/PAP set is unsound. -/ +def forgetHeap (fact : Fact) : Fact := + if fact.unknownHeap || !fact.shapes.isEmpty then + { mayScalar := fact.mayScalar, unknownHeap := true, shapes := [] } + else + fact + +def bytes (fact : Fact) : ByteArray := + Encoding.bool fact.mayScalar ++ Encoding.bool fact.unknownHeap ++ + Encoding.list HeapShape.bytes fact.shapes + +end Fact + +namespace FieldFact + +/-- Preserve a result fact as one recursively refined constructor field. -/ +def ofFact (fact : Fact) : FieldFact := + normalize + { mayScalar := fact.mayScalar + unknownHeap := fact.unknownHeap + shapes := fact.shapes.map HeapShape.toFieldShape } + +end FieldFact + +namespace FieldShape + +def toHeapShape : FieldShape → HeapShape + | .ctor identity fields => .ctor identity fields + | .pap function supplied => .pap function supplied + +end FieldShape + +namespace FieldFact + +/-- Re-root a fetched field, preserving every bounded nested refinement. -/ +def toFact (fact : FieldFact) : Fact := + Fact.normalize + { mayScalar := fact.mayScalar + unknownHeap := fact.unknownHeap + shapes := fact.shapes.map FieldShape.toHeapShape } + +end FieldFact + +namespace HeapShape + +/-- Result fact for a successful fetch from this possible shape. Missing +detail widens; a known out-of-range field and PAP nodes cannot produce a +successful concrete fetch. -/ +def fetch (field : Nat) : HeapShape → Fact + | .ctor _ none => Fact.top + | .ctor _ (some fields) => + match fields[field]? with + | some fact => fact.toFact + | none => Fact.bottom + | .pap _ _ => Fact.bottom + +end HeapShape + +namespace Fact + +/-- Field-sensitive transfer for non-consuming constructor projection. -/ +def fetch (fact : Fact) (field : Nat) : Fact := + if fact.unknownHeap then top + else joins (fact.shapes.map (HeapShape.fetch field)) + +/-! ### Case-binder field recovery -/ + +end Fact + +namespace HeapShape + +/-- Abstract field vector contributed by one possible heap shape to a case +alternative. Constructor tags are filtered before their fields participate; +identity-only shapes retain no field information, and detailed vectors with a +different arity cannot reach a successful execution of this alternative. The +result is already reversed into the evaluator's de Bruijn binding order. -/ +def caseFields (cidx fieldCount : Nat) : HeapShape → List Fact + | .ctor identity none => + if identity.cidx == cidx then + List.replicate fieldCount Fact.top + else + List.replicate fieldCount Fact.bottom + | .ctor identity (some fields) => + if identity.cidx == cidx && fields.length == fieldCount then + (fields.map FieldFact.toFact).reverse + else + List.replicate fieldCount Fact.bottom + | .pap _ _ => List.replicate fieldCount Fact.bottom + +end HeapShape + +namespace Fact + +/-- Heads of the nonempty vectors in a candidate family. -/ +def vectorHeads : List (List Fact) → List Fact + | [] => [] + | [] :: vectors => vectorHeads vectors + | (fact :: _) :: vectors => fact :: vectorHeads vectors + +/-- Tails of the nonempty vectors in a candidate family. -/ +def vectorTails : List (List Fact) → List (List Fact) + | [] => [] + | [] :: vectors => vectorTails vectors + | (_ :: facts) :: vectors => facts :: vectorTails vectors + +/-- Pointwise join of equally sized case-field candidates. The explicit +length keeps the result arity exact even when the branch is abstractly +unreachable and the candidate family is empty. -/ +def joinFieldVectors : Nat → List (List Fact) → List Fact + | 0, _ => [] + | fieldCount + 1, vectors => + Fact.joins (vectorHeads vectors) :: + joinFieldVectors fieldCount (vectorTails vectors) + +/-- Scalar contribution to one case alternative. Only unary tag `1` can bind +a value through Nat peeling, and that predecessor is exactly scalar. -/ +def scalarCaseFields (peelNat : Bool) (cidx fieldCount : Nat) : List Fact := + if peelNat && cidx == 1 && fieldCount == 1 then + [Fact.scalar] + else + List.replicate fieldCount Fact.bottom + +/-- Facts installed for an alternative's field binders. Finite constructor +shapes contribute only when their tag and detailed arity match; multiple +possible shapes join pointwise. An identity-only matching constructor or an +unknown heap widens every binder, while a possible peeled successor joins its +precise scalar predecessor. -/ +def caseFields (fact : Fact) (peelNat : Bool) + (cidx fieldCount : Nat) : List Fact := + if fact.unknownHeap then + List.replicate fieldCount Fact.top + else + let heapCandidates := + fact.shapes.map (HeapShape.caseFields cidx fieldCount) + let candidates := + if fact.mayScalar then + scalarCaseFields peelNat cidx fieldCount :: heapCandidates + else + heapCandidates + joinFieldVectors fieldCount candidates + +#guard (heap (.pap (Address.replicate 0x11) 1)).canonical +#guard (join scalar + (heap (.ctor ⟨Address.replicate 0x22, 0, 1⟩ none))).canonical +#guard (join top (heap (.pap (Address.replicate 0x33) 2))) == top +#guard (heap (.pap (Address.replicate 0x44) 1)).le top +#guard !top.le scalar +#guard (heap (.ctor ⟨Address.replicate 0x55, 0, 0⟩ + (some [FieldFact.scalar]))).fetch 0 == scalar +#guard (heap (.ctor ⟨Address.replicate 0x55, 0, 0⟩ none)).fetch 0 == top +#guard (heap (.ctor ⟨Address.replicate 0x55, 0, 0⟩ none)).forgetHeap == + ⟨false, true, []⟩ +#guard scalar.forgetHeap == scalar +#guard (heap (.ctor ⟨Address.replicate 0x56, 0, 3⟩ + (some [FieldFact.scalar]))).caseFields false 3 1 == [scalar] +#guard (heap (.ctor ⟨Address.replicate 0x56, 0, 3⟩ + (some [FieldFact.scalar]))).caseFields false 4 1 == [bottom] +#guard (heap (.ctor ⟨Address.replicate 0x56, 0, 3⟩ none)).caseFields + false 3 2 == [top, top] +#guard scalar.caseFields true 1 1 == [scalar] +#guard scalar.caseFields false 1 1 == [bottom] + +end Fact + +/-! ## Untrusted certificate format -/ + +/-- Candidate facts for one stable/ordinary/mutual program artifact. Member +order is part of the certificate and must exactly match the program artifact. -/ +structure CandidateArtifact where + programIdentity : Address + members : List (Address × Fact) + deriving BEq, Repr, Inhabited + +/-- The complete untrusted post-fixpoint claim. -/ +structure Certificate where + artifacts : List CandidateArtifact + deriving BEq, Repr, Inhabited + +/-- Deterministic admission limits for the already-addressed graph and the +untrusted fact claim. Per-fact shape limits apply independently to result and +recursive field facts because canonicalization currently sorts finite shape +sets by insertion. Depth, total-shape, and total-field limits bound later +interpretation and content-addressing work. -/ +structure Limits where + maxProgramArtifacts : Nat := 32 * 1024 + maxProgramMembers : Nat := 32 * 1024 + maxCertificateArtifacts : Nat := 32 * 1024 + maxCertificateMembers : Nat := 32 * 1024 + maxShapesPerFact : Nat := 256 + maxShapes : Nat := 64 * 1024 + maxFieldsPerShape : Nat := 256 + maxFields : Nat := 64 * 1024 + maxFieldDepth : Nat := 64 + /-- Inclusive bound on constructor coordinates and PAP fill counts. The + default includes the canonical-encoding fixture at `2^64` while preventing + a candidate from forcing an effectively unbounded numeral encoding. -/ + maxShapeIndex : Nat := 2 ^ 64 + deriving BEq, Repr + +def defaultLimits : Limits := {} + +/-- Exact structural counts returned by successful HPT preflight. -/ +structure Stats where + programArtifacts : Nat := 0 + programMembers : Nat := 0 + certificateArtifacts : Nat := 0 + certificateMembers : Nat := 0 + shapes : Nat := 0 + fields : Nat := 0 + fieldDepth : Nat := 0 + deriving BEq, Repr + +namespace Certificate + +def summaries (certificate : Certificate) : List (Address × Fact) := + certificate.artifacts.flatMap fun artifact => artifact.members + +end Certificate + +/-! ## Abstract interpreter -/ + +abbrev DeclEnv := Address → Option Decl +abbrev SummaryEnv := Address → Option Fact + +def resolveAtomFact (environment : List Fact) : Atom → Except String Fact + | .var index => + match environment[index]? with + | some fact => .ok fact + | none => .error s!"HPT unbound variable {index}" + | .lit _ | .erased => .ok Fact.scalar + +def resolveAtomFacts (environment : List Fact) + (atoms : Array Atom) : Except String (List Fact) := + atoms.foldlM (fun accumulated atom => do + pure (accumulated ++ [← resolveAtomFact environment atom])) [] + +def callableResult (declarations : DeclEnv) + (summaries : SummaryEnv) (function : Address) : Except String Fact := + match declarations function with + | none => .error s!"HPT call target is absent: {Address.toHex function}" + | some (.extern _) => .ok Fact.scalar + | some (.fn _) => + match summaries function with + | some fact => .ok fact + | none => .error s!"HPT function summary is absent: {Address.toHex function}" + +/-- Transfer one possible callable shape. `recur` is the preceding-fuel +instance of `applyFact`; separating it makes the finite-shape fold transparent +to the semantic proof without changing the executable domain. -/ +def applyShapeFact (declarations : DeclEnv) (summaries : SummaryEnv) + (recur : Fact → Nat → Except String Fact) (argumentCount : Nat) : + HeapShape → Except String Fact + | .ctor _ _ => .ok Fact.bottom + | .pap function supplied => + match declarations function with + | none => + .error s!"HPT pap target is absent: {Address.toHex function}" + | some declaration => do + let arity := declArity declaration + if supplied < arity then + let total := supplied + argumentCount + if total < arity then + return Fact.heap (.pap function total) + else + let returned ← callableResult declarations summaries function + if total == arity then + return returned + else + recur returned (total - arity) + else + return Fact.bottom + +/-- Join the transfers of a finite shape set. -/ +def applyShapeFacts + (step : HeapShape → Except String Fact) : + List HeapShape → Except String Fact + | [] => .ok Fact.bottom + | shape :: shapes => do + let head ← step shape + let tail ← applyShapeFacts step shapes + return head.join tail + +/-- Conservative abstract execution of `applyGo`. Exact PAP fill counts make +under/exact/over-application finite; fuel is a fail-safe for junk over-approximate +facts and widens to `top` rather than rejecting a sound certificate. -/ +def applyFact (declarations : DeclEnv) (summaries : SummaryEnv) : + Nat → Fact → Nat → Except String Fact + | 0, _, _ => .ok Fact.top + | fuel + 1, functionFact, argumentCount => do + if functionFact.unknownHeap then + return Fact.top + let scalar := + if functionFact.mayScalar then Fact.scalar else Fact.bottom + let heap ← applyShapeFacts + (applyShapeFact declarations summaries + (applyFact declarations summaries fuel) argumentCount) + functionFact.shapes + return scalar.join heap + +mutual + +def analyzeCode (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Address) (current : FnDef) (environment : List Fact) : + Code → Except String Fact + | .ret atom => resolveAtomFact environment atom + | .letOp operation rest => do + let bound ← analyzeOp declarations summaries owner current environment + operation + analyzeCode declarations summaries owner current + (bound :: environment.map Fact.forgetHeap) rest + | .case scrutinee peelNat alternatives => do + let scrutineeFact ← resolveAtomFact environment scrutinee + analyzeAlternatives declarations summaries owner current scrutineeFact + peelNat environment alternatives.toList + +def analyzeAlternatives (declarations : DeclEnv) + (summaries : SummaryEnv) (owner : Address) (current : FnDef) + (scrutinee : Fact) (peelNat : Bool) + (environment : List Fact) : List Alt → Except String Fact + | [] => .ok Fact.bottom + | .mk cidx fields body :: rest => do + let branch ← analyzeCode declarations summaries owner current + (scrutinee.caseFields peelNat cidx fields ++ environment) body + let remaining ← analyzeAlternatives declarations summaries owner current + scrutinee peelNat environment rest + return branch.join remaining + +def analyzeOp (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Address) (current : FnDef) (environment : List Fact) : + Op → Except String Fact + | .pure atom => resolveAtomFact environment atom + | .alloc _ identity arguments => do + let fields ← resolveAtomFacts environment arguments + return Fact.heap (.ctor identity (some (fields.map FieldFact.ofFact))) + | .reuse target identity arguments => do + let fields ← resolveAtomFacts environment arguments + let _ ← resolveAtomFact environment target + return Fact.heap (.ctor identity + (some (fields.map fun fact => FieldFact.ofFact fact.forgetHeap))) + | .free target | .drop target | .dropU target => do + let _ ← resolveAtomFact environment target + return Fact.scalar + | .dup target => do + let _ ← resolveAtomFact environment target + return Fact.top + | .fetch target field => do + let fact ← resolveAtomFact environment target + return fact.fetch field + | .call function arguments => do + let _ ← resolveAtomFacts environment arguments + match declarations function with + | none => throw s!"HPT call target is absent: {Address.toHex function}" + | some declaration => + if arguments.size != declArity declaration then + throw s!"HPT call arity mismatch at {Address.toHex function}" + callableResult declarations summaries function + | .callSelf arguments => do + let _ ← resolveAtomFacts environment arguments + if arguments.size != current.arity then + throw s!"HPT callSelf arity mismatch at {Address.toHex owner}" + match summaries owner with + | some fact => return fact + | none => throw s!"HPT self summary is absent: {Address.toHex owner}" + | .papp function arguments => do + let _ ← resolveAtomFacts environment arguments + match declarations function with + | none => throw s!"HPT pap target is absent: {Address.toHex function}" + | some declaration => + if arguments.size < declArity declaration then + return Fact.heap (.pap function arguments.size) + throw s!"HPT saturating papp at {Address.toHex function}" + | .apply function arguments => do + let functionFact ← resolveAtomFact environment function + let _ ← resolveAtomFacts environment arguments + applyFact declarations summaries (arguments.size + 1) functionFact + arguments.size + | .extern _ arguments => do + let _ ← resolveAtomFacts environment arguments + return Fact.scalar + +end + +def inferFunction (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Address) (function : FnDef) : Except String Fact := + analyzeCode declarations summaries owner function + (List.replicate function.arity Fact.top) function.body + +/-! ## Executable post-fixpoint checker -/ + +private def allUnique (addresses : List Address) : Bool := + ((AddressEnv.build (addresses.map fun address => (address, ()))).size == + addresses.length) + +def programIdentity : ReaddressAll.Artifact → Address + | .stable address _ | .ordinary address _ => address + | .mutual block => block.blockAddress + +def programMembers (artifact : ReaddressAll.Artifact) : + List (Address × Decl) := + artifact.declarations + +/-- Flattened declaration rows used by both the checker and its semantic +interface. -/ +def declarationEntries (program : List ReaddressAll.Artifact) : + List (Address × Decl) := + program.flatMap programMembers + +/-- Runtime declaration environment committed to by an addressed program. -/ +def programDeclEnv (program : List ReaddressAll.Artifact) : DeclEnv := + AddressEnv.lookup (AddressEnv.build (declarationEntries program)) + +/-- Lookup form of the untrusted summary rows. It becomes trusted only under +`Certificate.postFixpoint`. -/ +def Certificate.summaryEnv (certificate : Certificate) : SummaryEnv := + AddressEnv.lookup (AddressEnv.build certificate.summaries) + +private def enforce (label : String) (actual limit : Nat) : + Except String Unit := + if actual ≤ limit then .ok () + else .error s!"HPT {label} budget exceeded: {actual} > {limit}" + +private def enforceShapeIndex (label : String) (actual limit : Nat) : + Except String Unit := + if actual ≤ limit then .ok () + else .error s!"HPT {label} exceeds the configured shape-index limit {limit}" + +structure PayloadStats where + shapes : Nat := 0 + fields : Nat := 0 + fieldDepth : Nat := 0 + deriving BEq, Repr, Inhabited + +mutual + +private def scanFieldFact (limits : Limits) (depth : Nat) + (fact : FieldFact) (state : PayloadStats) : Except String PayloadStats := do + enforce "field-depth" depth limits.maxFieldDepth + let state := { state with fieldDepth := max state.fieldDepth depth } + scanFieldShapes limits depth fact.shapes 0 state +termination_by sizeOf fact +decreasing_by + cases fact + simp_wf + +private def scanFieldShapes (limits : Limits) (depth : Nat) : + List FieldShape → Nat → PayloadStats → Except String PayloadStats + | [], _, state => .ok state + | shape :: shapes, localShapes, state => do + let localShapes := localShapes + 1 + enforce "shapes-per-field-fact" localShapes limits.maxShapesPerFact + let state := { state with shapes := state.shapes + 1 } + enforce "total-shape" state.shapes limits.maxShapes + let state ← scanFieldShape limits depth shape state + scanFieldShapes limits depth shapes localShapes state +termination_by shapes _ _ => sizeOf shapes +decreasing_by all_goals simp_wf <;> omega + +private def scanFieldShape (limits : Limits) (depth : Nat) : + FieldShape → PayloadStats → Except String PayloadStats + | .ctor identity fields, state => do + enforceShapeIndex "field constructor inductive index" identity.indIdx + limits.maxShapeIndex + enforceShapeIndex "field constructor index" identity.cidx + limits.maxShapeIndex + match fields with + | none => pure state + | some fields => scanFieldVector limits (depth + 1) fields 0 state + | .pap _ supplied, state => do + enforceShapeIndex "field PAP supplied-argument count" supplied + limits.maxShapeIndex + pure state +termination_by shape _ => sizeOf shape +decreasing_by all_goals simp_wf <;> omega + +private def scanFieldVector (limits : Limits) (depth : Nat) : + List FieldFact → Nat → PayloadStats → Except String PayloadStats + | [], _, state => .ok state + | fact :: facts, localFields, state => do + let localFields := localFields + 1 + enforce "fields-per-constructor-shape" localFields + limits.maxFieldsPerShape + let state := { state with fields := state.fields + 1 } + enforce "total-constructor-field" state.fields limits.maxFields + let state ← scanFieldFact limits depth fact state + scanFieldVector limits depth facts localFields state +termination_by facts _ _ => sizeOf facts +decreasing_by all_goals simp_wf <;> omega + +end + + +/-- Check and count one recursive result-fact payload independently of graph +coverage. The deterministic producer reuses this exact gate before accepting a +round, so producer widening and untrusted checker admission share one domain +boundary. -/ +def checkFactPayload (limits : Limits) (fact : Fact) : + Except String PayloadStats := do + let mut state : PayloadStats := {} + let mut factShapes := 0 + for shape in fact.shapes do + factShapes := factShapes + 1 + enforce "shapes-per-fact" factShapes limits.maxShapesPerFact + state := { state with shapes := state.shapes + 1 } + enforce "total-shape" state.shapes limits.maxShapes + match shape with + | .ctor identity fieldFacts => + enforceShapeIndex "constructor inductive index" identity.indIdx + limits.maxShapeIndex + enforceShapeIndex "constructor index" identity.cidx + limits.maxShapeIndex + match fieldFacts with + | none => pure () + | some fieldFacts => + state ← scanFieldVector limits 1 fieldFacts 0 state + | .pap _ supplied => + enforceShapeIndex "PAP supplied-argument count" supplied + limits.maxShapeIndex + return state + +/-- Linear, early-exit admission scan. It runs before canonicalization, +post-fixpoint interpretation, uniqueness checks, or hashing. -/ +def preflight (limits : Limits) (program : List ReaddressAll.Artifact) + (certificate : Certificate) : Except String Stats := do + let mut programArtifacts := 0 + let mut programMemberCount := 0 + for artifact in program do + programArtifacts := programArtifacts + 1 + enforce "program-artifact" programArtifacts limits.maxProgramArtifacts + for _ in programMembers artifact do + programMemberCount := programMemberCount + 1 + enforce "program-member" programMemberCount limits.maxProgramMembers + let mut certificateArtifacts := 0 + let mut certificateMembers := 0 + let mut shapes := 0 + let mut fields := 0 + let mut fieldDepth := 0 + for artifact in certificate.artifacts do + certificateArtifacts := certificateArtifacts + 1 + enforce "certificate-artifact" certificateArtifacts + limits.maxCertificateArtifacts + for member in artifact.members do + certificateMembers := certificateMembers + 1 + enforce "certificate-member" certificateMembers + limits.maxCertificateMembers + let payload ← checkFactPayload limits member.2 + shapes := shapes + payload.shapes + fields := fields + payload.fields + fieldDepth := max fieldDepth payload.fieldDepth + enforce "total-shape" shapes limits.maxShapes + enforce "total-constructor-field" fields limits.maxFields + return { programArtifacts + programMembers := programMemberCount + certificateArtifacts + certificateMembers + shapes + fields + fieldDepth } + +/-- Universal conservative candidate. It is useful as a fail-safe producer +and as a baseline for measuring whether an external analysis adds precision; +the ordinary checker still validates code well-formedness and coverage. -/ +def Certificate.top (program : List ReaddressAll.Artifact) : Certificate := + ⟨program.map fun artifact => + { programIdentity := programIdentity artifact + members := (programMembers artifact).map fun member => + (member.1, match member.2 with + | .extern _ => Fact.scalar + | .fn _ => Fact.top) }⟩ + +def checkMember (declarations : DeclEnv) (summaries : SummaryEnv) : + (Address × Decl) → (Address × Fact) → Bool + | (address, declaration), (claimedAddress, claimed) => + address == claimedAddress && claimed.canonical && + match declaration with + | .extern _ => claimed == Fact.scalar + | .fn function => + match inferFunction declarations summaries address function with + | .ok inferred => inferred.le claimed + | .error _ => false + +private def checkMembers (declarations : DeclEnv) (summaries : SummaryEnv) : + List (Address × Decl) → List (Address × Fact) → Bool + | [], [] => true + | declaration :: declarations', summary :: summaries' => + checkMember declarations summaries declaration summary && + checkMembers declarations summaries declarations' summaries' + | _, _ => false + +private def checkArtifacts (declarations : DeclEnv) (summaries : SummaryEnv) : + List ReaddressAll.Artifact → List CandidateArtifact → Bool + | [], [] => true + | program :: programs, candidate :: candidates => + candidate.programIdentity == programIdentity program && + checkMembers declarations summaries (programMembers program) + candidate.members && + checkArtifacts declarations summaries programs candidates + | _, _ => false + +namespace CandidateArtifact + +/-- Artifact-local post-fixpoint check against a summary environment that +already contains this candidate's own rows and all prior dependencies. This is +the cache-ingress primitive; the whole-program checker remains the final +authority for global uniqueness, ordering, and coverage. -/ +def localPostFixpoint (declarations : DeclEnv) (summaries : SummaryEnv) + (program : ReaddressAll.Artifact) (candidate : CandidateArtifact) : Bool := + candidate.programIdentity == Ix.Compiler.IxIR1.HPT.programIdentity program && + checkMembers declarations summaries (programMembers program) + candidate.members + +end CandidateArtifact + +/-- Redundant pointwise spelling of the local checks. Artifact alignment is +still checked separately; this row-indexed form gives the semantic theorem a +direct elimination principle for any successful environment lookup. -/ +def checkLocalRows (declarations : DeclEnv) (summaries : SummaryEnv) : + List (Address × Decl) → Bool + | [] => true + | (address, declaration) :: entries => + (match summaries address with + | none => false + | some claimed => + checkMember declarations summaries (address, declaration) + (address, claimed)) && + checkLocalRows declarations summaries entries + +/-- The complete executable certificate condition. Besides the local +post-fixpoint inclusions it requires exact artifact/member coverage, canonical +facts, and globally unique producer and summary keys. -/ +def Certificate.postFixpoint (program : List ReaddressAll.Artifact) + (certificate : Certificate) : Bool := + let declarationsList := declarationEntries program + let summariesList := certificate.summaries + let declarations := programDeclEnv program + let summaries := certificate.summaryEnv + program.all ReaddressAll.Artifact.contentAddressed && + allUnique (program.map programIdentity) && + allUnique (declarationsList.map (·.1)) && + allUnique (summariesList.map (·.1)) && + checkLocalRows declarations summaries declarationsList && + checkArtifacts declarations summaries program certificate.artifacts + +/-! ## Content-addressed checked summaries -/ + +inductive ArtifactKind where + | stable + | ordinary + | mutual + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +namespace ArtifactKind + +def tag : ArtifactKind → UInt8 + | .stable => 0 + | .ordinary => 1 + | .mutual => 2 + +def ofProgram : ReaddressAll.Artifact → ArtifactKind + | .stable _ _ => .stable + | .ordinary _ _ => .ordinary + | .mutual _ => .mutual + +end ArtifactKind + +def normalizeAddresses (addresses : List Address) : List Address := + Ixon.Merkle.dedupSorted + (Ixon.Merkle.sortAddresses addresses.toArray) |>.toList + +/-- One checked, cache-addressed SCC summary. -/ +structure Artifact where + kind : ArtifactKind + programIdentity : Address + members : List (Address × Fact) + /-- Sorted, deduplicated checked summary-artifact dependencies. -/ + dependencies : List Address + cacheKey : Address + address : Address + deriving BEq, Repr, Inhabited + +namespace Artifact + +def cacheKeyDomain : ByteArray := + Encoding.domain "compilatrix/ixir1/hpt-cache-key/3" ++ Encoding.tag 0 + +def summaryDomain : ByteArray := + Encoding.domain "compilatrix/ixir1/hpt-summary/3" ++ Encoding.tag 0 + +private def memberBytes (member : Address × Fact) : ByteArray := + Encoding.address member.1 ++ member.2.bytes + +def cacheKeyPreimage (kind : ArtifactKind) (programIdentity : Address) + (dependencies : List Address) : ByteArray := + cacheKeyDomain ++ Encoding.tag kind.tag ++ + Encoding.address programIdentity ++ + Encoding.list Encoding.address dependencies + +def summaryPreimage (cacheKey : Address) + (members : List (Address × Fact)) : ByteArray := + summaryDomain ++ Encoding.address cacheKey ++ + Encoding.list memberBytes members + +def expectedCacheKey (artifact : Artifact) : Address := + Address.blake3 + (cacheKeyPreimage artifact.kind artifact.programIdentity + artifact.dependencies) + +def expectedAddress (artifact : Artifact) : Address := + Address.blake3 (summaryPreimage artifact.cacheKey artifact.members) + +def graphShapeAudit (artifact : Artifact) : Bool := + match artifact.kind, artifact.members with + | .stable, [(address, _)] | .ordinary, [(address, _)] => + address == artifact.programIdentity + | .mutual, _ => + !artifact.members.isEmpty && + !artifact.members.any fun member => + member.1 == artifact.programIdentity + | _, _ => false + +def semanticAudit (artifact : Artifact) : Bool := + artifact.graphShapeAudit && + artifact.dependencies == normalizeAddresses artifact.dependencies && + artifact.members.all (fun member => member.2.canonical) && + artifact.cacheKey == artifact.expectedCacheKey && + artifact.address == artifact.expectedAddress + +end Artifact + +/-- Cache query determined solely by one program artifact and the checked +addresses of its already available dependency summaries. -/ +structure Query where + kind : ArtifactKind + programIdentity : Address + dependencies : List Address + cacheKey : Address + deriving BEq, Repr, Inhabited + +namespace Query + +def agreesWith (query : Query) (artifact : Artifact) : Bool := + artifact.kind == query.kind && + artifact.programIdentity == query.programIdentity && + artifact.dependencies == query.dependencies && + artifact.cacheKey == query.cacheKey + +end Query + +namespace Artifact + +/-- Materialize candidate members under an already-derived cache query. -/ +def ofQuery (query : Query) (members : List (Address × Fact)) : Artifact := + { kind := query.kind + programIdentity := query.programIdentity + members + dependencies := query.dependencies + cacheKey := query.cacheKey + address := Address.blake3 (summaryPreimage query.cacheKey members) } + +end Artifact + +/-- Checked summaries in dependency order. -/ +structure Result where + artifacts : List Artifact + deriving BEq, Repr, Inhabited + +namespace Result + +def summaries (result : Result) : List (Address × Fact) := + result.artifacts.flatMap fun artifact => artifact.members + +def cacheKeys (result : Result) : List Address := + result.artifacts.map (·.cacheKey) + +def addresses (result : Result) : List Address := + result.artifacts.map (·.address) + +private def dependencyOrderAudit : List Artifact → List Address → Bool + | [], _ => true + | artifact :: artifacts, available => + artifact.dependencies.all available.contains && + dependencyOrderAudit artifacts (artifact.address :: available) + +def semanticAudit (result : Result) : Bool := + result.artifacts.all Artifact.semanticAudit && + allUnique (result.artifacts.map (·.programIdentity)) && + allUnique (result.summaries.map (·.1)) && + allUnique result.cacheKeys && allUnique result.addresses && + dependencyOrderAudit result.artifacts [] + +end Result + +private def lookupOwner (owners : List (Address × Address)) + (address : Address) : Option Address := + (owners.find? fun entry => entry.1 == address).map (·.2) + +def dependencyAddresses (declarations : DeclEnv) + (owners : List (Address × Address)) + (members : List (Address × Decl)) : Except String (List Address) := do + let localKeys := members.map (·.1) + let references := members.flatMap fun member => + Readdress.Decl.references member.2 + let mut dependencies : List Address := [] + for reference in references do + if !localKeys.contains reference then + match declarations reference with + | none => pure () + | some _ => + match lookupOwner owners reference with + | some summary => dependencies := summary :: dependencies + | none => + throw s!"HPT dependency summary is unavailable: {Address.toHex reference}" + return normalizeAddresses dependencies + +/-- Derive the exact persistent-cache lookup key for the next dependency- +ordered program artifact. `owners` maps already checked member identities to +their enclosing summary artifact address. -/ +def Query.ofProgram (declarations : DeclEnv) + (owners : List (Address × Address)) + (program : ReaddressAll.Artifact) : Except String Query := do + let dependencies ← dependencyAddresses declarations owners + (programMembers program) + let kind := ArtifactKind.ofProgram program + let identity := Ix.Compiler.IxIR1.HPT.programIdentity program + pure (Query.mk kind identity dependencies + (Address.blake3 + (Artifact.cacheKeyPreimage kind identity dependencies))) + +private def sameCachePreimage (left right : Artifact) : Bool := + Artifact.cacheKeyPreimage left.kind left.programIdentity left.dependencies == + Artifact.cacheKeyPreimage right.kind right.programIdentity right.dependencies + +private def sameSummaryPreimage (left right : Artifact) : Bool := + Artifact.summaryPreimage left.cacheKey left.members == + Artifact.summaryPreimage right.cacheKey right.members + +def rejectCollision (built : List Artifact) + (candidate : Artifact) : Except String Unit := do + match built.find? fun artifact => artifact.cacheKey == candidate.cacheKey with + | some existing => + unless sameCachePreimage existing candidate do + throw s!"BLAKE3 collision between HPT cache keys {Address.toHex candidate.cacheKey}" + | none => pure () + match built.find? fun artifact => artifact.address == candidate.address with + | some existing => + unless sameSummaryPreimage existing candidate do + throw s!"BLAKE3 collision between HPT summaries {Address.toHex candidate.address}" + | none => pure () + +private structure BuildState where + artifacts : List Artifact := [] + /-- Program member to checked summary-artifact address. -/ + owners : List (Address × Address) := [] + +private def materializeOne (declarations : DeclEnv) (state : BuildState) + (program : ReaddressAll.Artifact) (candidate : CandidateArtifact) : + Except String BuildState := do + let query ← Query.ofProgram declarations state.owners program + let artifact := Artifact.ofQuery query candidate.members + let _ ← rejectCollision state.artifacts artifact + return { artifacts := state.artifacts ++ [artifact] + owners := state.owners ++ candidate.members.map (fun member => + (member.1, artifact.address)) } + +private def materialize (declarations : DeclEnv) : + List ReaddressAll.Artifact → List CandidateArtifact → BuildState → + Except String BuildState + | [], [], state => .ok state + | program :: programs, candidate :: candidates, state => do + let state ← materializeOne declarations state program candidate + materialize declarations programs candidates state + | _, _, _ => .error "internal: HPT certificate/program artifact arity drift" + +/-- Check an untrusted whole-program result-shape post-fixpoint, then assign +granular cache and summary identities in dependency order. This is the +resource-configurable form of `run`. -/ +def runWith (limits : Limits) (program : List ReaddressAll.Artifact) + (certificate : Certificate) : Except String Result := do + let _ ← preflight limits program certificate + unless certificate.postFixpoint program do + throw "HPT certificate is not a canonical whole-program post-fixpoint" + let declarations := programDeclEnv program + let state ← materialize declarations program certificate.artifacts {} + let result : Result := ⟨state.artifacts⟩ + unless result.semanticAudit do + throw "internal: checked HPT summaries failed their content-address audit" + return result + +/-- Check with the documented default structural limits. -/ +def run (program : List ReaddressAll.Artifact) + (certificate : Certificate) : Except String Result := + runWith defaultLimits program certificate + +/-- Successful configurable materialization exposes the exact post-fixpoint +condition that gated it; no trust is placed in the producer of the candidate +facts. -/ +theorem postFixpoint_of_runWith_eq_ok + {limits : Limits} {program : List ReaddressAll.Artifact} + {certificate : Certificate} {result : Result} + (hrun : runWith limits program certificate = .ok result) : + certificate.postFixpoint program = true := by + unfold runWith at hrun + simp only [bind, Except.bind] at hrun + split at hrun + · contradiction + split at hrun + · assumption + · contradiction + +/-- Every cache artifact returned under configurable limits passes the exact +content-address and dependency-order audit. -/ +theorem semanticAudit_of_runWith_eq_ok + {limits : Limits} {program : List ReaddressAll.Artifact} + {certificate : Certificate} {result : Result} + (hrun : runWith limits program certificate = .ok result) : + result.semanticAudit = true := by + unfold runWith at hrun + simp only [bind, Except.bind] at hrun + split at hrun + · contradiction + · split at hrun + · next hpost => + split at hrun + · contradiction + · next state hmaterialize => + split at hrun + · next haudit => + injection hrun with hresult + subst result + exact haudit + · contradiction + · contradiction + +/-- Default-limit specialization of `postFixpoint_of_runWith_eq_ok`. -/ +theorem postFixpoint_of_run_eq_ok + {program : List ReaddressAll.Artifact} {certificate : Certificate} + {result : Result} (hrun : run program certificate = .ok result) : + certificate.postFixpoint program = true := by + apply postFixpoint_of_runWith_eq_ok (limits := defaultLimits) + simpa [run] using hrun + +/-- Default-limit specialization of `semanticAudit_of_runWith_eq_ok`. -/ +theorem semanticAudit_of_run_eq_ok + {program : List ReaddressAll.Artifact} {certificate : Certificate} + {result : Result} (hrun : run program certificate = .ok result) : + result.semanticAudit = true := by + apply semanticAudit_of_runWith_eq_ok (limits := defaultLimits) + simpa [run] using hrun + +end Ix.Compiler.IxIR1.HPT diff --git a/Ix/Compiler/IxIR1/HPTCache.lean b/Ix/Compiler/IxIR1/HPTCache.lean new file mode 100644 index 000000000..1b7d0106f --- /dev/null +++ b/Ix/Compiler/IxIR1/HPTCache.lean @@ -0,0 +1,543 @@ +import Ix.Compiler.IxIR1.HPTProduce +import Ix.Compiler.IxIR.Decode + +/-! +# Persistent checked HPT cache ingress + +Cache bytes are untrusted. Each dependency-ordered lookup is keyed by the +current program artifact and the addresses of summaries already accepted in +this run. A hit must decode canonically, reproduce that exact query, pass its +content-address audit, fit the producer/checker resource envelope, and satisfy +the artifact-local post-fixpoint against the current summary environment. + +Missing or invalid records rebuild only that artifact with the canonical +producer. Downstream queries then see the accepted/rebuilt summary address, so +the existing dependency cone determines subsequent hits naturally. The final +assembled certificate crosses the ordinary whole-program `runWith` checker; +cache scheduling is not a new trust boundary. +-/ + +namespace Ix.Compiler.IxIR1.HPT.Cache + +open Ix.Compiler.Ixon +open Ix.Compiler.Ixon (Address) +open Ix.Compiler.IxIR + +/-- Versioned persistent record framing, independent of summary hash domains. -/ +def recordDomain : ByteArray := + Encoding.domain "compilatrix/ixir1/hpt-cache-record/2" ++ Encoding.tag 0 + +/-- Versioned framing for a deterministic collection of keyed records. -/ +def storeDomain : ByteArray := + Encoding.domain "compilatrix/ixir1/hpt-cache-store/1" ++ Encoding.tag 0 + +private def memberBytes (member : Address × Fact) : ByteArray := + Encoding.address member.1 ++ member.2.bytes + +/-- Canonical persistent spelling of one checked summary artifact. -/ +def encodeArtifact (artifact : Artifact) : ByteArray := + recordDomain ++ Encoding.tag artifact.kind.tag ++ + Encoding.address artifact.programIdentity ++ + Encoding.list Encoding.address artifact.dependencies ++ + Encoding.address artifact.cacheKey ++ + Encoding.list memberBytes artifact.members ++ + Encoding.address artifact.address + +/-- Cache-specific byte and entry controls around the producer/checker limits. +Oversized records in an already constructed in-memory store are invalid hits; +persistent ingress and publication reject them before allocation/output. The +aggregate input cap is a hard admission boundary before indexing. -/ +structure Limits where + producer : ProducerLimits := {} + maxEntries : Nat := 32 * 1024 + maxEntryBytes : Nat := 4 * 1024 * 1024 + maxBytes : Nat := 64 * 1024 * 1024 + maxWriteBytes : Nat := 64 * 1024 * 1024 + /-- Complete framed store-file bytes, including keys and length prefixes. -/ + maxStoreBytes : Nat := 72 * 1024 * 1024 + deriving BEq, Repr + +def defaultLimits : Limits := {} + +/-- Address-keyed persistent records. Extra stale keys are permitted; duplicate +keys are rejected before lookup so list order cannot choose a winner. -/ +structure Store where + entries : List (Address × ByteArray) + deriving BEq, Inhabited + +private def storeEntryBytes (entry : Address × ByteArray) : ByteArray := + Encoding.address entry.1 ++ Encoding.blob entry.2 + +private def storeEntrySize (entry : Address × ByteArray) : Nat := + (Encoding.address entry.1).size + + (Encoding.nat entry.2.size).size + entry.2.size + +/-- Sort lookup keys lexicographically without changing their record bytes. +This makes snapshots independent of insertion and rebuild history. -/ +def Store.canonicalize (store : Store) : Store := + ⟨(store.entries.toArray.qsort fun left right => + Ixon.Merkle.compareAddress left.1 right.1 == .lt).toList⟩ + +/-- Canonical deterministic spelling of a complete persistent store. -/ +def encodeStore (store : Store) : ByteArray := + storeDomain ++ Encoding.list storeEntryBytes store.canonicalize.entries + +/-- Exact size of the canonical complete-store spelling, computed without +materializing that spelling. Sorting does not affect this sum. Filesystem +adapters use it to enforce the complete-file budget before opening a staging +file. -/ +def Store.framedSize (store : Store) : Nat := + storeDomain.size + (Encoding.nat store.entries.length).size + + store.entries.foldl (fun total entry => total + storeEntrySize entry) 0 + +structure IngressStats where + entries : Nat := 0 + bytes : Nat := 0 + deriving BEq, Repr, Inhabited + +/-- Result of an untrusted cache lookup. Storage adapters may distinguish an +absent key from a present chunk whose outer framing could not be admitted, so +the latter is reported as a local rejection and rebuilt instead of aborting an +otherwise usable cache. -/ +inductive LookupResult where + | missing + | found (bytes : ByteArray) + | rejected (reason : String) + deriving BEq + +private def enforce (label : String) (actual limit : Nat) : + Except String Unit := + if actual ≤ limit then .ok () + else .error s!"HPT cache {label} budget exceeded: {actual} > {limit}" + +/-- Linear aggregate admission scan and duplicate-key rejection. -/ +def Store.preflight (limits : Limits) (store : Store) : + Except String IngressStats := do + let mut entries := 0 + let mut bytes := 0 + for entry in store.entries do + entries := entries + 1 + enforce "entry" entries limits.maxEntries + bytes := bytes + entry.2.size + enforce "input-byte" bytes limits.maxBytes + let index := AddressEnv.build (store.entries.map fun entry => (entry.1, ())) + if index.size != entries then + throw "HPT cache contains duplicate lookup keys" + return { entries, bytes } + +/-- Validate individual and aggregate payload policy, canonicalize lookup +order, and enforce the exact complete-file budget without constructing the +complete byte array. -/ +def prepareStoreWith (limits : Limits) (store : Store) : + Except String Store := do + let _ ← store.preflight limits + for entry in store.entries do + enforce "record-byte" entry.2.size limits.maxEntryBytes + let canonical := store.canonicalize + enforce "store-byte" canonical.framedSize limits.maxStoreBytes + return canonical + +/-- Validate individual/aggregate payload policy and produce the canonical +framed store. -/ +def encodeStoreWith (limits : Limits) (store : Store) : + Except String ByteArray := do + let canonical ← prepareStoreWith limits store + return storeDomain ++ Encoding.list storeEntryBytes canonical.entries + +private def Store.index (store : Store) : AddressEnv.Index ByteArray := + AddressEnv.build store.entries + +private def getNatBoundedFuel (label : String) : Nat → Nat → GetM Nat + | _, 0 => throw s!"HPT cache {label} numeral exceeds its bounded width" + | limit, fuel + 1 => do + let byte ← getU8 + let low := byte.toNat % 128 + if byte.toNat < 128 then + if low ≤ limit then return low + throw s!"HPT cache {label} value exceeds {limit}" + let high ← getNatBoundedFuel label (limit / 128) fuel + let value := low + 128 * high + if value ≤ limit then return value + throw s!"HPT cache {label} value exceeds {limit}" + +/-- Read no more chunks than the largest canonical numeral permitted by the +policy. Recursive quotients are capped before multiplication, so hostile LEB +input cannot first construct an effectively unbounded `Nat`. -/ +private def getNatBounded (label : String) (limit : Nat) : GetM Nat := + getNatBoundedFuel label limit (Encoding.nat limit).size + +private def getCount (label : String) (limit : Nat) : GetM Nat := do + getNatBounded s!"{label} count" limit + +private def getList (label : String) (limit : Nat) (getOne : GetM α) : + GetM (List α) := do + let count ← getCount label limit + let mut values : Array α := #[] + for _ in [:count] do + values := values.push (← getOne) + return values.toList + +private def getCtorId (limits : Limits) : GetM CtorId := do + let block ← Decode.getAddress + let indIdx ← getNatBounded "constructor inductive-index" + limits.producer.checker.maxShapeIndex + let cidx ← getNatBounded "constructor index" + limits.producer.checker.maxShapeIndex + return ⟨block, indIdx, cidx⟩ + +mutual + +private def getFieldShape (limits : Limits) (remainingDepth : Nat) : + GetM FieldShape := do + match (← getU8).toNat with + | 0 => + let identity ← getCtorId limits + match (← getU8).toNat with + | 0 => return .ctor identity none + | 1 => + let fields ← getList "nested-constructor-field" + limits.producer.checker.maxFieldsPerShape + (getFieldFact limits remainingDepth) + return .ctor identity (some fields) + | tag => throw s!"HPT cache nested-constructor-field option tag {tag}" + | 1 => + let function ← Decode.getAddress + let filled ← getNatBounded "PAP fill" + limits.producer.checker.maxShapeIndex + return .pap function filled + | tag => throw s!"HPT cache field-shape tag {tag}" +termination_by 2 * remainingDepth + 1 +decreasing_by omega + +private def getFieldFact (limits : Limits) : Nat → GetM FieldFact + | 0 => throw "HPT cache recursive field depth exceeds configured limit" + | remainingDepth + 1 => do + let mayScalar ← Decode.getBool + let unknownHeap ← Decode.getBool + let shapes ← getList "field-shape" + limits.producer.checker.maxShapesPerFact + (getFieldShape limits remainingDepth) + return ⟨mayScalar, unknownHeap, shapes⟩ +termination_by remainingDepth => 2 * remainingDepth +decreasing_by omega + +end + +private def getHeapShape (limits : Limits) : GetM HeapShape := do + match (← getU8).toNat with + | 0 => + let identity ← getCtorId limits + match (← getU8).toNat with + | 0 => return .ctor identity none + | 1 => + let fields ← getList "constructor-field" + limits.producer.checker.maxFieldsPerShape + (getFieldFact limits limits.producer.checker.maxFieldDepth) + return .ctor identity (some fields) + | tag => throw s!"HPT cache constructor-field option tag {tag}" + | 1 => + let function ← Decode.getAddress + let filled ← getNatBounded "PAP fill" + limits.producer.checker.maxShapeIndex + return .pap function filled + | tag => throw s!"HPT cache heap-shape tag {tag}" + +private def getFact (limits : Limits) : GetM Fact := do + let mayScalar ← Decode.getBool + let unknownHeap ← Decode.getBool + let shapes ← getList "result-shape" + limits.producer.checker.maxShapesPerFact (getHeapShape limits) + return ⟨mayScalar, unknownHeap, shapes⟩ + +private def getKind : GetM ArtifactKind := do + match (← getU8).toNat with + | 0 => return .stable + | 1 => return .ordinary + | 2 => return .mutual + | tag => throw s!"HPT cache artifact-kind tag {tag}" + +private def getMember (limits : Limits) : GetM (Address × Fact) := do + return (← Decode.getAddress, ← getFact limits) + +private def getArtifact (limits : Limits) : GetM Artifact := do + Decode.expectBytes recordDomain + let kind ← getKind + let programIdentity ← Decode.getAddress + let dependencies ← getList "dependency" + limits.producer.checker.maxProgramArtifacts Decode.getAddress + let cacheKey ← Decode.getAddress + let members ← getList "member" + limits.producer.checker.maxCertificateMembers (getMember limits) + let address ← Decode.getAddress + return ⟨kind, programIdentity, members, dependencies, cacheKey, address⟩ + +private def getStore (limits : Limits) : GetM Store := do + Decode.expectBytes storeDomain + let count ← getCount "store-entry" limits.maxEntries + let mut entries : Array (Address × ByteArray) := #[] + let mut totalBytes := 0 + for _ in [:count] do + let key ← Decode.getAddress + let size ← getNatBounded "record-byte count" limits.maxEntryBytes + totalBytes := totalBytes + size + if totalBytes > limits.maxBytes then + throw s!"HPT cache input-byte count exceeds {limits.maxBytes}" + let bytes ← getBytes size + entries := entries.push (key, bytes) + return ⟨entries.toList⟩ + +/-- Strict full-consumption, byte-for-byte canonical record decoder. -/ +def decodeArtifactWith (limits : Limits) (bytes : ByteArray) : + Except String Artifact := do + enforce "record-byte" bytes.size limits.maxEntryBytes + Decode.runCanonical (getArtifact limits) encodeArtifact bytes + +def decodeArtifact (bytes : ByteArray) : Except String Artifact := + decodeArtifactWith defaultLimits bytes + +/-- Strict, resource-bounded, canonical decoder for a complete store file. +The outer size gate runs before parsing; record lengths and their aggregate are +checked before the corresponding byte arrays are copied. -/ +def decodeStoreWith (limits : Limits) (bytes : ByteArray) : + Except String Store := do + enforce "store-byte" bytes.size limits.maxStoreBytes + let store ← Decode.runCanonical (getStore limits) encodeStore bytes + let _ ← store.preflight limits + return store + +def decodeStore (bytes : ByteArray) : Except String Store := + decodeStoreWith defaultLimits bytes + +/-- A complete store spelling for a checked result. -/ +def Store.ofResult (result : Result) : Store := + ⟨result.artifacts.map fun artifact => + (artifact.cacheKey, encodeArtifact artifact)⟩ + +/-- Replace or add rebuilt records. Keys not mentioned by the current program +remain available for other program versions sharing the same store. -/ +def Store.applyWrites (store : Store) (writes : List (Address × ByteArray)) : + Store := + let keys := writes.map (·.1) + ⟨store.entries.filter (fun entry => !keys.contains entry.1) ++ writes⟩ + +structure Rejection where + cacheKey : Address + reason : String + deriving BEq, Repr + +structure Stats where + ingressEntries : Nat := 0 + ingressBytes : Nat := 0 + hits : Nat := 0 + misses : Nat := 0 + rejected : Nat := 0 + rounds : Nat := 0 + widenedArtifacts : Nat := 0 + writes : Nat := 0 + writeBytes : Nat := 0 + deriving BEq, Repr, Inhabited + +/-- Proof-carrying cache schedule result. `writes` contains only missing or +rejected records; `completeStore` can be used for a compact exact snapshot. -/ +structure Production (limits : Limits) + (program : List ReaddressAll.Artifact) where + certificate : Certificate + result : Result + stats : Stats + rejections : List Rejection + writes : List (Address × ByteArray) + checked : runWith limits.producer.checker program certificate = .ok result + +namespace Production + +def completeStore {limits : Limits} {program : List ReaddressAll.Artifact} + (production : Production limits program) : Store := + Store.ofResult production.result + +theorem postFixpoint {limits : Limits} {program : List ReaddressAll.Artifact} + (production : Production limits program) : + production.certificate.postFixpoint program = true := + postFixpoint_of_runWith_eq_ok production.checked + +theorem semanticAudit {limits : Limits} {program : List ReaddressAll.Artifact} + (production : Production limits program) : + production.result.semanticAudit = true := + semanticAudit_of_runWith_eq_ok production.checked + +theorem functionSummary_sound + {limits : Limits} {program : List ReaddressAll.Artifact} + (production : Production limits program) + {ctx : Ctx} {address : Address} {function : FnDef} {claimed : Fact} + {arguments : List RVal} + {store outputStore : Ix.Compiler.IxIR1.Store} + {outputValue : RVal} {fuel : Nat} + (hctx : ctx.decls = programDeclEnv program) + (hdeclaration : programDeclEnv program address = some (.fn function)) + (hsummary : production.certificate.summaryEnv address = some claimed) + (hinvoke : invoke ctx fuel address arguments store = + .ok (outputStore, outputValue)) : + claimed.Holds (programDeclEnv program) outputStore outputValue := by + exact functionSummary_sound_of_runWith_eq_ok production.checked hctx + hdeclaration hsummary hinvoke + +end Production + +private structure AcceptedHit where + candidate : CandidateArtifact + artifact : Artifact + summaries : AddressEnv.Index Fact + totalShapes : Nat + totalFields : Nat + +private structure ScheduleState where + candidatesRev : List CandidateArtifact := [] + artifactsRev : List Artifact := [] + owners : List (Address × Address) := [] + summaries : AddressEnv.Index Fact := AddressEnv.build [] + totalShapes : Nat := 0 + totalFields : Nat := 0 + rounds : Nat := 0 + remainingRounds : Nat := 0 + widenedArtifacts : Nat := 0 + hits : Nat := 0 + misses : Nat := 0 + rejected : Nat := 0 + rejectionsRev : List Rejection := [] + writesRev : List (Address × ByteArray) := [] + writeBytes : Nat := 0 + +private def ownersFor (artifact : Artifact) : List (Address × Address) := + artifact.members.map fun member => (member.1, artifact.address) + +private def validateHit (limits : Limits) (declarations : DeclEnv) + (state : ScheduleState) (program : ReaddressAll.Artifact) + (query : Query) (bytes : ByteArray) : Except String AcceptedHit := do + let artifact ← decodeArtifactWith limits bytes + unless query.agreesWith artifact do + throw "record does not match the current cache query" + unless artifact.semanticAudit do + throw "record failed its content-address or canonicality audit" + let candidate : CandidateArtifact := + { programIdentity := artifact.programIdentity + members := artifact.members } + let summaries := Producer.extendSummaries state.summaries candidate.members + unless candidate.localPostFixpoint declarations + (AddressEnv.lookup summaries) program do + throw "record is not an artifact-local post-fixpoint" + let (totalShapes, totalFields) ← Producer.validatePayload + limits.producer.checker state.totalShapes state.totalFields candidate.members + return ⟨candidate, artifact, summaries, totalShapes, totalFields⟩ + +private def acceptHit (state : ScheduleState) (hit : AcceptedHit) : + ScheduleState := + { state with + candidatesRev := hit.candidate :: state.candidatesRev + artifactsRev := hit.artifact :: state.artifactsRev + owners := ownersFor hit.artifact ++ state.owners + summaries := hit.summaries + totalShapes := hit.totalShapes + totalFields := hit.totalFields + hits := state.hits + 1 } + +private def rebuild (limits : Limits) (declarations : DeclEnv) + (state : ScheduleState) (program : ReaddressAll.Artifact) + (query : Query) (rejection : Option String) : Except String ScheduleState := do + let produced ← Producer.produceArtifactWith limits.producer declarations + state.summaries program state.totalShapes state.totalFields + state.remainingRounds + let artifact := Artifact.ofQuery query produced.candidate.members + unless artifact.semanticAudit do + throw "internal: rebuilt HPT cache artifact failed its semantic audit" + rejectCollision state.artifactsRev artifact + let bytes := encodeArtifact artifact + enforce "record-byte" bytes.size limits.maxEntryBytes + let writeBytes := state.writeBytes + bytes.size + enforce "output-byte" writeBytes limits.maxWriteBytes + let rejected := state.rejected + if rejection.isSome then 1 else 0 + let rejectionsRev := match rejection with + | some reason => Rejection.mk query.cacheKey reason :: state.rejectionsRev + | none => state.rejectionsRev + pure ({ state with + candidatesRev := produced.candidate :: state.candidatesRev + artifactsRev := artifact :: state.artifactsRev + owners := ownersFor artifact ++ state.owners + summaries := produced.summaries + totalShapes := produced.totalShapes + totalFields := produced.totalFields + rounds := state.rounds + produced.rounds + remainingRounds := produced.remainingRounds + widenedArtifacts := state.widenedArtifacts + + (if produced.widened then 1 else 0) + misses := state.misses + 1 + rejected := rejected + rejectionsRev := rejectionsRev + writesRev := (query.cacheKey, bytes) :: state.writesRev + writeBytes := writeBytes } : ScheduleState) + +/-- Validate effectfully supplied cache hits and rebuild misses one dependency +artifact at a time, then submit the assembled candidate to the ordinary +whole-program checker. The lookup is untrusted: every returned record crosses +the same canonical decoder, exact-query audit, local post-fixpoint check, and +final checker as an in-memory store. -/ +def runLookupWithM {m : Type → Type} [Monad m] [MonadExceptOf String m] + (limits : Limits) (program : List ReaddressAll.Artifact) + (ingress : IngressStats) (lookup : Address → m LookupResult) : + m (Production limits program) := do + let _ ← ofExcept <| + preflight limits.producer.checker program (Certificate.top program) + let declarations := programDeclEnv program + let mut state : ScheduleState := + { remainingRounds := limits.producer.maxRounds } + for programArtifact in program do + let query ← ofExcept <| + Query.ofProgram declarations state.owners programArtifact + match ← lookup query.cacheKey with + | .missing => + state ← ofExcept <| + rebuild limits declarations state programArtifact query none + | .rejected reason => + state ← ofExcept <| + rebuild limits declarations state programArtifact query (some reason) + | .found bytes => + match validateHit limits declarations state programArtifact query bytes with + | .error reason => + state ← ofExcept <| rebuild limits declarations state programArtifact + query (some reason) + | .ok hit => + let _ ← ofExcept <| rejectCollision state.artifactsRev hit.artifact + state := acceptHit state hit + let certificate : Certificate := ⟨state.candidatesRev.reverse⟩ + match hrun : HPT.runWith limits.producer.checker program certificate with + | .error error => throw error + | .ok result => + if result.artifacts != state.artifactsRev.reverse then + throw "internal: cache schedule and final materialization diverged" + let stats : Stats := + { ingressEntries := ingress.entries + ingressBytes := ingress.bytes + hits := state.hits + misses := state.misses + rejected := state.rejected + rounds := state.rounds + widenedArtifacts := state.widenedArtifacts + writes := state.writesRev.length + writeBytes := state.writeBytes } + pure (⟨certificate, result, stats, state.rejectionsRev.reverse, + state.writesRev.reverse, hrun⟩ : Production limits program) + +/-- In-memory specialization of `runLookupWithM`. Its aggregate admission +statistics cover the complete supplied store, including stale records. -/ +def runWith (limits : Limits) (program : List ReaddressAll.Artifact) + (store : Store) : Except String (Production limits program) := do + let ingress ← store.preflight limits + let index := store.index + runLookupWithM limits program ingress fun key => + pure <| match index.get? key with + | none => .missing + | some bytes => .found bytes + +def run (program : List ReaddressAll.Artifact) (store : Store) : + Except String (Production defaultLimits program) := + runWith defaultLimits program store + +end Ix.Compiler.IxIR1.HPT.Cache diff --git a/Ix/Compiler/IxIR1/HPTCacheDirIO.lean b/Ix/Compiler/IxIR1/HPTCacheDirIO.lean new file mode 100644 index 000000000..32139dfb1 --- /dev/null +++ b/Ix/Compiler/IxIR1/HPTCacheDirIO.lean @@ -0,0 +1,262 @@ +import Ix.Compiler.IxIR1.HPTCacheIO + +/-! +# Indexed chunk-directory adapter for checked HPT caches + +The single-file adapter streams framing but ultimately returns one in-memory +`Cache.Store`. This adapter uses the filesystem namespace as a content-key +index: each lookup key names one canonical singleton-store file. Directory +ingress retains only key, length, and rejection metadata, while the cache +scheduler opens at most the records selected by the current dependency chain. + +Every selected payload remains untrusted and crosses `Cache.runLookupWithM`'s +ordinary record decoder, exact-query/content audits, local post-fixpoint check, +and final whole-program checker. Missing or malformed chunks are rebuilt and +published independently through `CacheIO.saveFileWith`, so a partial update is +safe and each successful replacement inherits the ledgered stable-storage +protocol. Recognizable orphan transaction directories are ignored. +-/ + +namespace Ix.Compiler.IxIR1.HPT.CacheDirIO + +open System (FilePath) +open Ix.Compiler.IxIR +open Ix.Compiler.Ixon (Address) + +/-- Independent controls for metadata-scale indexing and per-run lazy reads. +The embedded cache limits still bound every record, producer/checker work, and +new-record output. `maxIndexBytes` counts complete framed chunk files without +loading their payloads; `maxReadBytes` counts payloads selected in one run. -/ +structure Limits where + cache : Cache.Limits := {} + maxIndexEntries : Nat := 1024 * 1024 + maxIndexBytes : Nat := 256 * 1024 * 1024 * 1024 + maxReadBytes : Nat := 64 * 1024 * 1024 + deriving BEq, Repr + +def defaultLimits : Limits := {} + +def recordFileSuffix : String := ".hpt" + +def recordFileName (key : Address) : String := + key.toHex ++ recordFileSuffix + +private def hexNibble? (byte : UInt8) : Option Nat := + let value := byte.toNat + if 48 ≤ value && value ≤ 57 then some (value - 48) + else if 97 ≤ value && value ≤ 102 then some (value - 87) + else none + +/-- Inverse of `recordFileName`; only the canonical lowercase 64-hex spelling +with the exact suffix is accepted. -/ +def recordAddress? (name : String) : Option Address := do + let input := name.toUTF8 + let suffix := recordFileSuffix.toUTF8 + if input.size != 64 + suffix.size then none + else if input.extract 64 input.size != suffix then none + else + let mut output := ByteArray.empty + for index in [:32] do + let high ← hexNibble? input[2 * index]! + let low ← hexNibble? input[2 * index + 1]! + output := output.push (UInt8.ofNat (16 * high + low)) + Address.ofBytes? output + +/-- An admitted header or a locally repairable malformed chunk. Complete file +bytes are retained for directory-budget accounting without retaining payloads. -/ +inductive RecordMeta where + | admitted (payloadBytes framedBytes : Nat) + | rejected (reason : String) (framedBytes : Nat) + deriving BEq, Repr + +def RecordMeta.framedBytes : RecordMeta → Nat + | .admitted _ bytes => bytes + | .rejected _ bytes => bytes + +/-- Metadata-only directory index. `ingress.bytes` is framed on-disk bytes for +this adapter (the in-memory adapter reports raw record payload bytes). -/ +structure Index where + directory : FilePath + records : AddressEnv.Index RecordMeta + ingress : Cache.IngressStats + +private def enforce (label : String) (actual limit : Nat) : + Except CacheIO.Error Unit := + if actual ≤ limit then .ok () + else .error (.cache s!"indexed HPT cache {label} budget exceeded: \ + {actual} > {limit}") + +/-- Scan a cache directory into bounded metadata without retaining any record +payload. Malformed canonical-name chunks stay in the index as local +rejections; unknown names and non-regular record paths fail closed. -/ +def indexDirectoryWith (limits : Limits) (directory : FilePath) : + IO (Except CacheIO.Error Index) := do + try + let rootMetadata ← directory.symlinkMetadata + if rootMetadata.type != .dir then + return .error (.notDirectory directory.toString rootMetadata.type) + let entries ← directory.readDir + let mut records : Array (Address × RecordMeta) := #[] + let mut count := 0 + let mut bytes := 0 + for entry in entries do + let path := entry.path + let metadata ← path.symlinkMetadata + if CacheIO.isTransactionDirectoryName entry.fileName then + if metadata.type != .dir then + return .error (.notDirectory path.toString metadata.type) + else + let key ← match recordAddress? entry.fileName with + | some key => pure key + | none => + return .error (.cache s!"unexpected indexed HPT cache entry: \ + {path}") + if metadata.type != .file then + return .error (.notRegularFile path.toString metadata.type) + count := count + 1 + match enforce "entry" count limits.maxIndexEntries with + | .error error => return .error error + | .ok () => pure () + let framedBytes := metadata.byteSize.toNat + bytes := bytes + framedBytes + match enforce "framed-byte" bytes limits.maxIndexBytes with + | .error error => return .error error + | .ok () => pure () + let recordMeta ← match ← CacheIO.inspectSingletonFileWith + limits.cache path with + | .error error => pure (.rejected error.describe framedBytes) + | .ok header => + if header.key != key then + pure (.rejected + "chunk header key does not match its canonical filename" + framedBytes) + else + pure (.admitted header.payloadBytes framedBytes) + records := records.push (key, recordMeta) + let index := AddressEnv.build records.toList + if index.size != count then + return .error (.cache "indexed HPT cache contains duplicate keys") + return .ok ⟨directory, index, ⟨count, bytes⟩⟩ + catch error => + return .error (.io "index cache directory" directory.toString + error.toString) + +def indexDirectory (directory : FilePath) : + IO (Except CacheIO.Error Index) := + indexDirectoryWith defaultLimits directory + +private def transactionParent (path : FilePath) : FilePath := + path.parent.getD ("." : FilePath) + +private def syncDirectory (path : FilePath) : IO (Except CacheIO.Error Unit) := do + try + Ix.Compiler.DurableSync.directory path + return .ok () + catch error => + return .error (.io "durably sync directory" path.toString error.toString) + +/-- Create exactly the requested cache directory under an existing parent and +persist its own metadata plus the new parent entry. -/ +private def ensureDirectory (directory : FilePath) : + IO (Except CacheIO.Error Unit) := do + match ← directory.symlinkMetadata.toBaseIO with + | .ok metadata => + if metadata.type == .dir then return .ok () + return .error (.notDirectory directory.toString metadata.type) + | .error (.noFileOrDirectory ..) => + try + IO.FS.createDir directory + catch error => + return .error (.io "create cache directory" directory.toString + error.toString) + match ← syncDirectory directory with + | .error error => return .error error + | .ok () => syncDirectory (transactionParent directory) + | .error error => + return .error (.io "inspect cache directory" directory.toString + error.toString) + +private def chargeRead (limits : Limits) (readBytes : IO.Ref Nat) + (bytes : Nat) : ExceptT String IO Unit := do + let prior ← readBytes.get + if prior > limits.maxReadBytes || bytes > limits.maxReadBytes - prior then + throw s!"indexed HPT cache read-byte budget exceeded: \ + {prior + bytes} > {limits.maxReadBytes}" + readBytes.set (prior + bytes) + +private def lookupRecord (limits : Limits) (index : Index) + (readBytes : IO.Ref Nat) (key : Address) : + ExceptT String IO Cache.LookupResult := do + match index.records.get? key with + | none => return .missing + | some (.rejected reason _) => return .rejected reason + | some (.admitted expectedBytes _) => + chargeRead limits readBytes expectedBytes + let path := index.directory / recordFileName key + match ← CacheIO.loadFileWith limits.cache path with + | .error error => return .rejected error.describe + | .ok store => + match store.entries with + | [(storedKey, bytes)] => + if storedKey != key then + return .rejected + "chunk payload key does not match its canonical filename" + if bytes.size != expectedBytes then + return .rejected + "chunk payload size changed after directory indexing" + return .found bytes + | entries => + return .rejected s!"indexed HPT cache chunk contains \ + {entries.length} records; expected 1" + +private def projectedIndexWithinLimits (limits : Limits) (index : Index) + (writes : List (Address × ByteArray)) : Except CacheIO.Error Unit := do + let mut records := index.records + let mut count := index.ingress.entries + let mut bytes := index.ingress.bytes + for write in writes do + let framedBytes := (Cache.Store.mk [write]).framedSize + match records.get? write.1 with + | none => count := count + 1 + | some old => bytes := bytes - old.framedBytes + bytes := bytes + framedBytes + enforce "entry" count limits.maxIndexEntries + enforce "framed-byte" bytes limits.maxIndexBytes + records := records.insert write.1 (.admitted write.2.size framedBytes) + +/-- Lazily schedule the current program against a metadata-only directory +index, then durably publish only rebuilt records. Independent per-key commits +make an interrupted multi-record refresh a safe mixture of old and new cache +entries; dependency-addressed queries and the final checker determine reuse. -/ +def refreshDirectoryWith (limits : Limits) + (program : List ReaddressAll.Artifact) (directory : FilePath) : + IO (Except CacheIO.Error (Cache.Production limits.cache program)) := do + match ← ensureDirectory directory with + | .error error => return .error error + | .ok () => pure () + let index ← match ← indexDirectoryWith limits directory with + | .error error => return .error error + | .ok index => pure index + let readBytes ← IO.mkRef 0 + let scheduled ← (Cache.runLookupWithM limits.cache program index.ingress + (lookupRecord limits index readBytes)).run + let production ← match scheduled with + | .error message => return .error (.cache message) + | .ok production => pure production + match projectedIndexWithinLimits limits index production.writes with + | .error error => return .error error + | .ok () => pure () + for write in production.writes do + let path := directory / recordFileName write.1 + match ← CacheIO.saveFileWith limits.cache path ⟨[write]⟩ with + | .error error => return .error error + | .ok () => pure () + return .ok production + +def refreshDirectory (program : List ReaddressAll.Artifact) + (directory : FilePath) : + IO (Except CacheIO.Error + (Cache.Production defaultLimits.cache program)) := + refreshDirectoryWith defaultLimits program directory + +end Ix.Compiler.IxIR1.HPT.CacheDirIO diff --git a/Ix/Compiler/IxIR1/HPTCacheIO.lean b/Ix/Compiler/IxIR1/HPTCacheIO.lean new file mode 100644 index 000000000..06eedd401 --- /dev/null +++ b/Ix/Compiler/IxIR1/HPTCacheIO.lean @@ -0,0 +1,471 @@ +import Ix.Compiler.IxIR1.HPTCache +import Ix.Compiler.DurableSync + +/-! +# Filesystem adapter for checked HPT caches + +The analysis/cache scheduler remains pure. This module persists its `Store` as +one versioned, canonically ordered file. Reads reject symlinks and non-regular +files, gate the observed byte count before allocation, and stream the strict +outer grammar one bounded record at a time. A missing file is an empty cache +only through the explicitly named `loadFileOrEmptyWith` entry. + +Writes validate the aggregate store policy and canonicalize its outer framing +before touching the filesystem; record blobs deliberately remain untrusted +until a query consumes them. The adapter refuses an existing non-regular +destination, streams and verifies a fresh sibling staging file, flushes its +runtime buffer, requests stable storage for the staged file and transaction +directory, and commits with the runtime's POSIX-style atomic `rename`. It then +syncs both directories affected by that cross-directory rename. An interruption +before rename leaves the old cache intact; an orphan staging directory is never +considered by ingress. On the ledger's supported filesystem baseline, a +successful return makes the complete replacement power-loss durable. The small +native sync boundary and the storage device's reported guarantees remain +explicit trust assumptions. +-/ + +namespace Ix.Compiler.IxIR1.HPT.CacheIO + +open System (FilePath) +open Ix.Compiler.IxIR + +/-- Sibling transaction directories are deliberately recognizable so callers +can inspect crash leftovers without treating them as cache inputs. The adapter +removes only the directory created by its own invocation. -/ +def transactionDirectoryPrefix : String := ".compilatrix-hpt-" + +def transactionDirectorySuffix : String := ".txn" + +def isTransactionDirectoryName (name : String) : Bool := + name.startsWith transactionDirectoryPrefix && + name.endsWith transactionDirectorySuffix + +inductive Error where + | io (operation path message : String) + | notRegularFile (path : String) (actual : IO.FS.FileType) + | notDirectory (path : String) (actual : IO.FS.FileType) + | fileBytes (actual limit : Nat) + | cache (message : String) + deriving Repr + +private abbrev ReadM := StateT Nat (ExceptT Error IO) + +private partial def readExactLoop (handle : IO.FS.Handle) (label : String) + (remaining : Nat) (acc : ByteArray) : ReadM ByteArray := do + if remaining == 0 then + return acc + let request := min remaining 65536 + let chunk ← liftM (handle.read request.toUSize) + if chunk.isEmpty then + throw (.cache s!"truncated HPT cache {label}") + let consumed ← get + set (consumed + chunk.size) + readExactLoop handle label (remaining - chunk.size) (acc ++ chunk) + +/-- Read exactly one bounded grammar component. The caller's state is the +number of file bytes consumed, so a file that changes after the metadata gate +still cannot make this adapter allocate beyond `maxStoreBytes`. -/ +private def readExact (handle : IO.FS.Handle) (limit : Nat) (label : String) + (size : Nat) : ReadM ByteArray := do + let consumed ← get + if consumed > limit || size > limit - consumed then + throw (.fileBytes (consumed + size) limit) + readExactLoop handle label size .empty + +private def expectBytes (handle : IO.FS.Handle) (limit : Nat) + (label : String) (expected : ByteArray) : ReadM Unit := do + let actual ← readExact handle limit label expected.size + if actual != expected then + throw (.cache s!"unexpected HPT cache {label}") + +/-- Incremental canonical unsigned-LEB reader. Its width comes from the +largest policy value, and every contribution is checked before multiplication +can construct a value above that policy. -/ +private def readNatBounded (handle : IO.FS.Handle) (storeLimit : Nat) + (label : String) (limit : Nat) : ReadM Nat := do + let width := (Encoding.nat limit).size + let mut value := 0 + let mut multiplier := 1 + let mut spelling := ByteArray.empty + for _ in [:width] do + let bytes ← readExact handle storeLimit label 1 + let byte := bytes[0]! + spelling := spelling ++ bytes + let low := byte.toNat % 128 + if low > (limit - value) / multiplier then + throw (.cache s!"HPT cache {label} value exceeds {limit}") + value := value + low * multiplier + if byte.toNat < 128 then + if spelling != Encoding.nat value then + throw (.cache s!"noncanonical HPT cache {label}") + return value + multiplier := multiplier * 128 + throw (.cache s!"HPT cache {label} numeral exceeds its bounded width") + +private def readAddress (handle : IO.FS.Handle) (limit : Nat) + (label : String) : ReadM Ixon.Address := do + let bytes ← readExact handle limit label 32 + match Ixon.Address.ofBytes? bytes with + | some address => return address + | none => throw (.cache "internal: streamed address did not contain 32 bytes") + +private def finishRead (handle : IO.FS.Handle) (path : FilePath) + (observed limit : Nat) : ReadM Unit := do + let extra ← liftM (handle.read 1) + if !extra.isEmpty then + let consumed ← get + let actual := consumed + extra.size + set actual + if actual > limit then + throw (.fileBytes actual limit) + throw (.cache "trailing bytes after canonical HPT cache store") + let consumed ← get + if consumed != observed then + throw (.io "read" path.toString + s!"file size changed during ingress: observed {observed}, consumed {consumed}") + +private def readStore (limits : Cache.Limits) (path : FilePath) + (observed : Nat) (handle : IO.FS.Handle) : ReadM Cache.Store := do + expectBytes handle limits.maxStoreBytes "store domain" Cache.storeDomain + let count ← readNatBounded handle limits.maxStoreBytes + "store-entry count" limits.maxEntries + let mut entries : Array (Ixon.Address × ByteArray) := #[] + let mut previous : Option Ixon.Address := none + let mut totalBytes := 0 + for _ in [:count] do + let key ← readAddress handle limits.maxStoreBytes "lookup key" + match previous with + | some prior => + if Ixon.Merkle.compareAddress prior key != .lt then + throw (.cache "noncanonical HPT cache lookup-key order") + | none => pure () + let size ← readNatBounded handle limits.maxStoreBytes + "record-byte count" limits.maxEntryBytes + totalBytes := totalBytes + size + if totalBytes > limits.maxBytes then + throw (.cache s!"HPT cache input-byte count exceeds {limits.maxBytes}") + let bytes ← readExact handle limits.maxStoreBytes "record payload" size + entries := entries.push (key, bytes) + previous := some key + finishRead handle path observed limits.maxStoreBytes + let store : Cache.Store := ⟨entries.toList⟩ + match store.preflight limits with + | .ok _ => return store + | .error message => throw (.cache message) + +/-- Metadata retained by the chunk-directory index. Inspecting a singleton +store reads only its fixed framing and bounded length numeral; the record +payload remains on disk until the checked scheduler asks for that key. -/ +structure SingletonHeader where + key : Ixon.Address + payloadBytes : Nat + deriving BEq, Repr + +private def readSingletonHeader (limits : Cache.Limits) (_path : FilePath) + (observed : Nat) (handle : IO.FS.Handle) : ReadM SingletonHeader := do + expectBytes handle limits.maxStoreBytes "store domain" Cache.storeDomain + let count ← readNatBounded handle limits.maxStoreBytes + "store-entry count" limits.maxEntries + if count != 1 then + throw (.cache s!"indexed HPT cache chunk contains {count} records; expected 1") + let key ← readAddress handle limits.maxStoreBytes "lookup key" + let size ← readNatBounded handle limits.maxStoreBytes + "record-byte count" limits.maxEntryBytes + let consumed ← get + if consumed + size != observed then + throw (.cache s!"indexed HPT cache chunk declares {size} payload bytes, but \ + its framed file has {observed} bytes") + return ⟨key, size⟩ + +private def readKnownFileWith (limits : Cache.Limits) (path : FilePath) + (metadata : IO.FS.Metadata) : IO (Except Error Cache.Store) := do + if metadata.type != .file then + return .error (.notRegularFile path.toString metadata.type) + let observed := metadata.byteSize.toNat + if observed > limits.maxStoreBytes then + return .error (.fileBytes observed limits.maxStoreBytes) + try + let handle ← IO.FS.Handle.mk path .read + let result ← ((readStore limits path observed handle).run 0).run + return result.map Prod.fst + catch error => + return .error (.io "read" path.toString error.toString) + +/-- Read one existing cache file through metadata, byte, framing, aggregate, +and duplicate-key gates. Missing files are errors at this entry point. -/ +def loadFileWith (limits : Cache.Limits) (path : FilePath) : + IO (Except Error Cache.Store) := do + try + let metadata ← path.symlinkMetadata + readKnownFileWith limits path metadata + catch error => + return .error (.io "inspect" path.toString error.toString) + +def loadFile (path : FilePath) : IO (Except Error Cache.Store) := + loadFileWith Cache.defaultLimits path + +/-- Inspect a canonical one-record store without reading its record payload. +The full file is re-opened and validated if the lazy scheduler later selects +the key, so a concurrent change cannot make this header an acceptance proof. -/ +def inspectSingletonFileWith (limits : Cache.Limits) (path : FilePath) : + IO (Except Error SingletonHeader) := do + try + let metadata ← path.symlinkMetadata + if metadata.type != .file then + return .error (.notRegularFile path.toString metadata.type) + let observed := metadata.byteSize.toNat + if observed > limits.maxStoreBytes then + return .error (.fileBytes observed limits.maxStoreBytes) + let handle ← IO.FS.Handle.mk path .read + let result ← ((readSingletonHeader limits path observed handle).run 0).run + return result.map Prod.fst + catch error => + return .error (.io "inspect indexed chunk" path.toString error.toString) + +def inspectSingletonFile (path : FilePath) : + IO (Except Error SingletonHeader) := + inspectSingletonFileWith Cache.defaultLimits path + +/-- Cold-start entry: only an absent path denotes an empty store. Existing +malformed, oversized, duplicate-key, symlink, and non-file inputs still fail. -/ +def loadFileOrEmptyWith (limits : Cache.Limits) (path : FilePath) : + IO (Except Error Cache.Store) := do + match ← path.symlinkMetadata.toBaseIO with + | .ok metadata => readKnownFileWith limits path metadata + | .error (.noFileOrDirectory ..) => return .ok ⟨[]⟩ + | .error error => + return .error (.io "inspect" path.toString error.toString) + +def loadFileOrEmpty (path : FilePath) : IO (Except Error Cache.Store) := + loadFileOrEmptyWith Cache.defaultLimits path + +private def validateWriteTarget (path : FilePath) : IO (Except Error Unit) := do + match ← path.symlinkMetadata.toBaseIO with + | .ok metadata => + if metadata.type == .file then + return .ok () + return .error (.notRegularFile path.toString metadata.type) + | .error (.noFileOrDirectory ..) => return .ok () + | .error error => + return .error (.io "inspect output" path.toString error.toString) + +def Error.describe : Error → String + | .io operation path message => s!"{operation} {path}: {message}" + | .notRegularFile path actual => + s!"{path} is not a regular file ({repr actual})" + | .notDirectory path actual => + s!"{path} is not a directory ({repr actual})" + | .fileBytes actual limit => + s!"HPT cache store-byte budget exceeded: {actual} > {limit}" + | .cache message => message + +private def verifyExpectedStore (limits : Cache.Limits) (path : FilePath) + (observed : Nat) (handle : IO.FS.Handle) + (expected : Cache.Store) : ReadM Unit := do + expectBytes handle limits.maxStoreBytes "store domain" Cache.storeDomain + let count ← readNatBounded handle limits.maxStoreBytes + "store-entry count" limits.maxEntries + if count != expected.entries.length then + throw (.cache s!"staged store has {count} entries; expected \ + {expected.entries.length}") + for entry in expected.entries do + let key ← readAddress handle limits.maxStoreBytes "lookup key" + if key != entry.1 then + throw (.cache "staged HPT cache lookup key differs from canonical store") + let size ← readNatBounded handle limits.maxStoreBytes + "record-byte count" limits.maxEntryBytes + if size != entry.2.size then + throw (.cache s!"staged HPT cache record has {size} bytes; expected \ + {entry.2.size}") + let bytes ← readExact handle limits.maxStoreBytes "record payload" size + if bytes != entry.2 then + throw (.cache "staged HPT cache record differs from canonical store") + finishRead handle path observed limits.maxStoreBytes + +/-- Verify the staging file against the expected canonical store while +retaining at most one newly read record payload. -/ +private def verifyStreamedFile (limits : Cache.Limits) (operation : String) + (path : FilePath) (expectedSize : Nat) (expected : Cache.Store) : + IO (Except Error Unit) := do + try + let metadata ← path.symlinkMetadata + if metadata.type != .file then + return .error (.notRegularFile path.toString metadata.type) + let observed := metadata.byteSize.toNat + if observed != expectedSize then + return .error (.io operation path.toString + s!"observed {observed} bytes, expected {expectedSize}") + if observed > limits.maxStoreBytes then + return .error (.fileBytes observed limits.maxStoreBytes) + let handle ← IO.FS.Handle.mk path .read + match ← ((verifyExpectedStore limits path observed handle expected).run 0).run with + | .ok _ => return .ok () + | .error error => + return .error (.io operation path.toString error.describe) + catch error => + return .error (.io operation path.toString error.toString) + +private def writeChunk (handle : IO.FS.Handle) (limit : Nat) + (emitted : IO.Ref Nat) (bytes : ByteArray) : IO Unit := do + let count ← emitted.get + if count > limit || bytes.size > limit - count then + throw <| IO.userError + s!"HPT cache store-byte budget exceeded while writing: \ + {count + bytes.size} > {limit}" + handle.write bytes + emitted.set (count + bytes.size) + +/-- Write the canonical outer grammar without constructing its concatenated +byte array. Record payloads already belong to the in-memory `Store`; adapter +scratch space is limited to the small framing chunks. -/ +private def writeStore (limits : Cache.Limits) (handle : IO.FS.Handle) + (store : Cache.Store) : IO Nat := do + let emitted ← IO.mkRef 0 + writeChunk handle limits.maxStoreBytes emitted Cache.storeDomain + writeChunk handle limits.maxStoreBytes emitted + (Encoding.nat store.entries.length) + for entry in store.entries do + writeChunk handle limits.maxStoreBytes emitted entry.1.hash + writeChunk handle limits.maxStoreBytes emitted (Encoding.nat entry.2.size) + writeChunk handle limits.maxStoreBytes emitted entry.2 + let actual ← emitted.get + let expected := store.framedSize + if actual != expected then + throw <| IO.userError + s!"internal HPT cache framed-size mismatch: wrote {actual}, expected {expected}" + return actual + +private def transactionParent (path : FilePath) : FilePath := + path.parent.getD ("." : FilePath) + +private def createTransactionDirectory (path : FilePath) : + IO (Except Error FilePath) := do + let parent := transactionParent path + let rec loop : Nat → IO (Except Error FilePath) + | 0 => + pure (.error (.io "create transaction directory" parent.toString + "exhausted 32 collision-resistant sibling names")) + | attempts + 1 => do + let nonce ← IO.rand 0 (2 ^ 64 - 1) + let candidate := parent / + s!"{transactionDirectoryPrefix}{nonce}{transactionDirectorySuffix}" + match ← (IO.FS.createDir candidate).toBaseIO with + | .ok () => return .ok candidate + | .error (.alreadyExists ..) => loop attempts + | .error error => + return .error (.io "create transaction directory" + candidate.toString error.toString) + loop 32 + +private def cleanupTransaction (directory staged : FilePath) : IO Unit := do + try IO.FS.removeFile staged catch _ => pure () + try IO.FS.removeDir directory catch _ => pure () + +private def syncFile (path : FilePath) : IO (Except Error Unit) := do + try + Ix.Compiler.DurableSync.file path + return .ok () + catch error => + return .error (.io "durably sync file" path.toString error.toString) + +private def syncDirectory (path : FilePath) : IO (Except Error Unit) := do + try + Ix.Compiler.DurableSync.directory path + return .ok () + catch error => + return .error (.io "durably sync directory" path.toString error.toString) + +private def replaceFileAtomically (limits : Cache.Limits) (path : FilePath) + (store : Cache.Store) (expectedSize : Nat) : IO (Except Error Unit) := do + let directory ← match ← createTransactionDirectory path with + | .ok directory => pure directory + | .error error => return .error error + let staged := directory / "store" + let result ← try + let handle ← IO.FS.Handle.mk staged .write + let actualSize ← writeStore limits handle store + handle.flush + if actualSize != expectedSize then + pure (.error (.io "stage canonical store" staged.toString + s!"wrote {actualSize} bytes, expected {expectedSize}")) + else + match ← (verifyStreamedFile limits "verify staged write" staged + expectedSize store) with + | .error error => pure (.error error) + | .ok () => + match ← syncFile staged with + | .error error => pure (.error error) + | .ok () => + match ← syncDirectory directory with + | .error error => pure (.error error) + | .ok () => + match ← validateWriteTarget path with + | .error error => pure (.error error) + | .ok () => + IO.FS.rename staged path + let parent := transactionParent path + match ← syncDirectory parent with + | .error error => pure (.error error) + | .ok () => syncDirectory directory + catch error => + pure (.error (.io "atomic replace" path.toString error.toString)) + match result with + | .error error => + cleanupTransaction directory staged + return .error error + | .ok () => + -- A successful return guarantees both cleanup and persistence of that + -- final parent-directory change. Failed attempts still leave only a + -- recognizable orphan that cache ingress ignores. + try + IO.FS.removeDir directory + catch error => + return .error (.io "remove committed transaction directory" + directory.toString error.toString) + syncDirectory (transactionParent path) + +/-- Canonicalize and persist a complete store after its individual and +aggregate resource checks. Artifact records are checked on lookup, not blessed +by this writer. +The destination's parent directory must already exist. The commit is an atomic +rename within one filesystem: before it the prior destination remains intact, +and after it the complete staged bytes occupy the destination. A successful +return also includes the staged-file and affected-directory stable-storage +barriers required by the ledger's power-loss durability contract. -/ +def saveFileWith (limits : Cache.Limits) (path : FilePath) + (store : Cache.Store) : IO (Except Error Unit) := do + let canonical ← match Cache.prepareStoreWith limits store with + | .ok canonical => pure canonical + | .error message => return .error (.cache message) + let expectedSize := canonical.framedSize + match ← validateWriteTarget path with + | .error error => return .error error + | .ok () => pure () + replaceFileAtomically limits path canonical expectedSize + +def saveFile (path : FilePath) (store : Cache.Store) : + IO (Except Error Unit) := + saveFileWith Cache.defaultLimits path store + +/-- Load (or cold-start), validate/rebuild against the current program, merge +only the emitted writes, and persist the resulting store. The returned +`Production` still carries the ordinary whole-program checker equality. -/ +def refreshFileWith (limits : Cache.Limits) + (program : List ReaddressAll.Artifact) (path : FilePath) : + IO (Except Error (Cache.Production limits program)) := do + let store ← match ← loadFileOrEmptyWith limits path with + | .ok store => pure store + | .error error => return .error error + let production ← match Cache.runWith limits program store with + | .ok production => pure production + | .error message => return .error (.cache message) + let updated := store.applyWrites production.writes + match ← saveFileWith limits path updated with + | .ok () => return .ok production + | .error error => return .error error + +def refreshFile (program : List ReaddressAll.Artifact) (path : FilePath) : + IO (Except Error (Cache.Production Cache.defaultLimits program)) := + refreshFileWith Cache.defaultLimits program path + +end Ix.Compiler.IxIR1.HPT.CacheIO diff --git a/Ix/Compiler/IxIR1/HPTCasePrune.lean b/Ix/Compiler/IxIR1/HPTCasePrune.lean new file mode 100644 index 000000000..557f75af6 --- /dev/null +++ b/Ix/Compiler/IxIR1/HPTCasePrune.lean @@ -0,0 +1,1807 @@ +import Ix.Compiler.IxIR1.HPTSound + +/-! +# Checked HPT consumer: fact-driven case simplification + +This is the first transformation that consumes accepted HPT facts. Its +compatibility entry point `run` has the deliberately small rewrite window + +```text +let x := call f(args); case x of alternatives +``` + +When `f` has a finite heap-only result fact, alternatives whose constructor +index is absent from that fact are removed. If the accepted fact describes +exactly one unary constructor and filtering leaves exactly its unary branch, +the case is replaced by one checked `fetch`; this preserves both the branch +environment and exact evaluator fuel. Scalar, unknown-heap, identity-only, +and non-unary rows retain the conservative pruning behavior. The semantic +theorem below treats the summary as untrusted until it is backed by the same +local post-fixpoint used by the HPT checker. + +`runWithFacts` instead mirrors HPT transfer through a complete function body. +It propagates primitive results, forgets older heap identities at the same +mutation boundary as the analyzer, refines case binders, and simplifies every +case from the fact available at that program point. The function owner is +explicit because `callSelf` transfer is owner-sensitive. + +`runRecursive` remains the fixed-environment traversal for supplied fragments +such as a top-level main, which has no declaration owner. Stored declarations +use `runFunction` and `rewriteDeclarationAt`; changed bodies still require the +separate content-address rebuild stage. +-/ + +namespace Ix.Compiler.IxIR1.HPT.CasePrune + +/-- Only a finite, heap-only row can exclude a case alternative. -/ +def preciseHeapOnly (fact : Fact) : Bool := + !fact.mayScalar && !fact.unknownHeap + +/-- Whether a finite result row contains a constructor with this runtime case +index. Case dispatch observes `cidx`, not the constructor's block identity. -/ +def hasCtorIndex (fact : Fact) (index : Nat) : Bool := + fact.shapes.any fun + | .ctor identity _ => identity.cidx == index + | .pap _ _ => false + +def pruneAlternatives (fact : Fact) (alternatives : Array Alt) : Array Alt := + alternatives.filter fun alternative => hasCtorIndex fact alternative.cidx + +/-- The detailed singleton constructor fact required for exact unary case +collapse. Identity-only constructor facts deliberately return `none`: they +do not certify that field zero exists or that the branch arity is one. -/ +def exactUnaryConstructor? (fact : Fact) : Option CtorId := + match fact.shapes with + | [.ctor identity (some [_])] => some identity + | _ => none + +/-- Select the sole unary branch body when its dispatch index agrees with the +sole detailed unary constructor fact. -/ +def exactUnaryBody? (fact : Fact) (alternatives : Array Alt) : Option Code := + match exactUnaryConstructor? fact, alternatives.toList with + | some identity, [.mk cidx 1 body] => + if cidx == identity.cidx then some body else none + | _, _ => none + +private theorem exactUnaryConstructor?_eq_some + {fact : Fact} {identity : CtorId} + (h : exactUnaryConstructor? fact = some identity) : + ∃ fieldFact, + fact.shapes = [.ctor identity (some [fieldFact])] := by + unfold exactUnaryConstructor? at h + split at h <;> simp_all + +private theorem exactUnaryBody?_eq_some + {fact : Fact} {alternatives : Array Alt} {body : Code} + (h : exactUnaryBody? fact alternatives = some body) : + ∃ identity fieldFact, + fact.shapes = [.ctor identity (some [fieldFact])] ∧ + alternatives = #[.mk identity.cidx 1 body] := by + unfold exactUnaryBody? at h + split at h <;> simp_all + obtain ⟨fieldFact, hshapes⟩ := + exactUnaryConstructor?_eq_some (by assumption) + refine ⟨_, ⟨fieldFact, hshapes⟩, Array.toList_inj.mp ?_⟩ + simpa using (by assumption) + +/-- Observable output of the one-redex consumer. -/ +structure Outcome where + code : Code + removedAlternatives : Nat + collapsedCases : Nat + materializedFetches : Nat + +/-- Pass-attributed counters without the rewritten syntax payload. -/ +structure Changes where + removedAlternatives : Nat := 0 + collapsedCases : Nat := 0 + materializedFetches : Nat := 0 + +def Changes.add (left right : Changes) : Changes := + { removedAlternatives := + left.removedAlternatives + right.removedAlternatives + collapsedCases := left.collapsedCases + right.collapsedCases + materializedFetches := + left.materializedFetches + right.materializedFetches } + +def Outcome.changes (outcome : Outcome) : Changes := + { removedAlternatives := outcome.removedAlternatives + collapsedCases := outcome.collapsedCases + materializedFetches := outcome.materializedFetches } + +/-- Simplify one root `call`→`case` redex. Every other shape is returned +byte-for-byte at the inductive syntax level. -/ +def run (declarations : DeclEnv) (summaries : SummaryEnv) + (input : Code) : Outcome := + match input with + | .letOp (.call function arguments) + (.case (.var 0) peelNat alternatives) => + match declarations function, summaries function with + | some (.fn _), some fact => + if preciseHeapOnly fact then + let kept := pruneAlternatives fact alternatives + match exactUnaryBody? fact kept with + | some body => + ⟨.letOp (.call function arguments) + (.letOp (.fetch (.var 0) 0) body), + alternatives.size - kept.size, 1, 1⟩ + | none => + ⟨.letOp (.call function arguments) + (.case (.var 0) peelNat kept), + alternatives.size - kept.size, 0, 0⟩ + else + ⟨input, 0, 0, 0⟩ + | _, _ => ⟨input, 0, 0, 0⟩ + | _ => ⟨input, 0, 0, 0⟩ + +/-- Internal result for recursively rewriting an alternative body while +retaining its dispatch metadata. -/ +structure AlternativeOutcome where + alternative : Alt + removedAlternatives : Nat + collapsedCases : Nat + materializedFetches : Nat + +mutual + +/-- Recursively apply the one-redex consumer throughout one supplied code +fragment. This still does not rewrite declaration bodies or the evaluator's +current-function frame. -/ +def runRecursive (declarations : DeclEnv) (summaries : SummaryEnv) : + Code → Outcome + | .ret atom => ⟨.ret atom, 0, 0, 0⟩ + | .letOp operation rest => + let nested := runRecursive declarations summaries rest + let root := run declarations summaries (.letOp operation nested.code) + ⟨root.code, + nested.removedAlternatives + root.removedAlternatives, + nested.collapsedCases + root.collapsedCases, + nested.materializedFetches + root.materializedFetches⟩ + | .case scrutinee peelNat alternatives => + let nested := alternatives.map + (runAlternativeRecursive declarations summaries) + ⟨.case scrutinee peelNat (nested.map (fun result => result.alternative)), + nested.foldl + (fun total result => total + result.removedAlternatives) 0, + nested.foldl + (fun total result => total + result.collapsedCases) 0, + nested.foldl + (fun total result => total + result.materializedFetches) 0⟩ + +def runAlternativeRecursive (declarations : DeclEnv) + (summaries : SummaryEnv) : Alt → AlternativeOutcome + | .mk cidx fields body => + let nested := runRecursive declarations summaries body + ⟨.mk cidx fields nested.code, nested.removedAlternatives, + nested.collapsedCases, nested.materializedFetches⟩ + +end + +/-! ## Owner-sensitive whole-code fact propagation -/ + +/-- Simplify one case whose scrutinee fact has already been established by +the ambient HPT environment. Unlike `run`, this root does not require a +syntactically adjacent call and may fetch from any resolved scrutinee atom. -/ +def runKnownCase (fact : Fact) (scrutinee : Atom) (peelNat : Bool) + (alternatives : Array Alt) : Outcome := + let input := Code.case scrutinee peelNat alternatives + if preciseHeapOnly fact then + let kept := pruneAlternatives fact alternatives + match exactUnaryBody? fact kept with + | some body => + ⟨.letOp (.fetch scrutinee 0) body, + alternatives.size - kept.size, 1, 1⟩ + | none => + ⟨.case scrutinee peelNat kept, + alternatives.size - kept.size, 0, 0⟩ + else + ⟨input, 0, 0, 0⟩ + +mutual + +/-- Mirror `analyzeCode` while simplifying every case from the fact available +at that exact program point. Transfer failures are fail-soft: the affected +subtree is returned byte-for-byte with zero attributed changes. -/ +def runWithFacts (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Ix.Compiler.Ixon.Address) (current : FnDef) + (facts : List Fact) : Code → Outcome + | .ret atom => ⟨.ret atom, 0, 0, 0⟩ + | input@(.letOp operation rest) => + match analyzeOp declarations summaries owner current facts operation with + | .error _ => ⟨input, 0, 0, 0⟩ + | .ok bound => + let nested := runWithFacts declarations summaries owner current + (bound :: facts.map Fact.forgetHeap) rest + ⟨.letOp operation nested.code, + nested.removedAlternatives, nested.collapsedCases, + nested.materializedFetches⟩ + | input@(.case scrutinee peelNat alternatives) => + match resolveAtomFact facts scrutinee with + | .error _ => ⟨input, 0, 0, 0⟩ + | .ok fact => + let nested := alternatives.map + (runAlternativeWithFacts declarations summaries owner current + fact peelNat facts) + let rewritten := nested.map (fun result => result.alternative) + let root := runKnownCase fact scrutinee peelNat rewritten + ⟨root.code, + nested.foldl + (fun total result => total + result.removedAlternatives) 0 + + root.removedAlternatives, + nested.foldl + (fun total result => total + result.collapsedCases) 0 + + root.collapsedCases, + nested.foldl + (fun total result => total + result.materializedFetches) 0 + + root.materializedFetches⟩ + +/-- Rewrite one alternative under the exact HPT binder environment used by +`analyzeAlternatives`. -/ +def runAlternativeWithFacts (declarations : DeclEnv) + (summaries : SummaryEnv) (owner : Ix.Compiler.Ixon.Address) + (current : FnDef) (scrutineeFact : Fact) (peelNat : Bool) + (facts : List Fact) : Alt → AlternativeOutcome + | .mk cidx fields body => + let nested := runWithFacts declarations summaries owner current + (scrutineeFact.caseFields peelNat cidx fields ++ facts) body + ⟨.mk cidx fields nested.code, nested.removedAlternatives, + nested.collapsedCases, nested.materializedFetches⟩ + +end + +/-- Analyze and simplify a complete function from HPT's universal parameter +environment. -/ +def runFunction (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Ix.Compiler.Ixon.Address) (current : FnDef) : Outcome := + runWithFacts declarations summaries owner current + (List.replicate current.arity Fact.top) current.body + +/-- Owner-sensitive function rewrite used for stored declarations. -/ +def rewriteCurrentAt (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Ix.Compiler.Ixon.Address) (current : FnDef) : FnDef := + { current with body := + (runFunction declarations summaries owner current).code } + +/-- Owner-sensitive declaration rewrite. The address is semantically +relevant to `callSelf` transfer. -/ +def rewriteDeclarationAt (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Ix.Compiler.Ixon.Address) : Decl → Decl + | .fn function => .fn (rewriteCurrentAt declarations summaries owner function) + | .extern arity => .extern arity + +/-- Rewrite a current-function body while retaining the dynamic arity and +result-world contract used by `callSelf`. -/ +def rewriteCurrent (declarations : DeclEnv) (summaries : SummaryEnv) + (current : FnDef) : FnDef := + { current with body := + (runRecursive declarations summaries current.body).code } + +/-- Rewrite one declaration body without changing its calling convention. +Extern declarations are retained exactly. -/ +def rewriteDeclaration (declarations : DeclEnv) (summaries : SummaryEnv) : + Decl → Decl + | .fn function => .fn (rewriteCurrent declarations summaries function) + | .extern arity => .extern arity + +/-- Logical declaration environment obtained by rewriting every function +body under its existing key. This is an intermediate semantic object: a +stored artifact must subsequently readdress the changed declarations. -/ +def rewriteDeclEnv (declarations : DeclEnv) (summaries : SummaryEnv) : + DeclEnv := + fun address => (declarations address).map + (rewriteDeclarationAt declarations summaries address) + +/-- Retain a context's oracle while replacing its declaration environment by +the logical body-rewritten environment. -/ +def rewriteCtx (declarations : DeclEnv) (summaries : SummaryEnv) + (ctx : Ctx) : Ctx := + { ctx with decls := rewriteDeclEnv declarations summaries } + +/-- List form consumed by the content-address rebuild stage. -/ +def rewriteEntries (declarations : DeclEnv) (summaries : SummaryEnv) + (entries : List (Ix.Compiler.Ixon.Address × Decl)) : + List (Ix.Compiler.Ixon.Address × Decl) := + entries.map fun entry => + (entry.1, + rewriteDeclarationAt declarations summaries entry.1 entry.2) + +@[simp] theorem declArity_rewriteDeclaration + (declarations : DeclEnv) (summaries : SummaryEnv) (declaration : Decl) : + declArity (rewriteDeclaration declarations summaries declaration) = + declArity declaration := by + cases declaration <;> rfl + +@[simp] theorem declArity_rewriteDeclarationAt + (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Ix.Compiler.Ixon.Address) (declaration : Decl) : + declArity + (rewriteDeclarationAt declarations summaries owner declaration) = + declArity declaration := by + cases declaration <;> rfl + +/-! ## Semantic support -/ + +/-- A finite fact covering a live constructor necessarily retains its runtime +case index. Detailed field payloads do not affect dispatch. -/ +theorem hasCtorIndex_of_holds_ctor + {declarations : DeclEnv} {store : Store} {fact : Fact} + {location : Nat} {box : NodeBox} {identity : CtorId} + {fields : Array RVal} + (hfinite : fact.unknownHeap = false) + (hholds : fact.Holds declarations store (.loc location)) + (hget : store.get? location = some box) + (hnode : box.node = .ctorN identity fields) : + hasCtorIndex fact identity.cidx = true := by + simp only [Fact.Holds] at hholds + rcases hholds with hunknown | ⟨shape, hmember, hshape⟩ + · rw [hfinite] at hunknown + contradiction + · apply List.any_eq_true.mpr + refine ⟨shape, hmember, ?_⟩ + cases shape with + | ctor shapeIdentity fieldFacts => + simp only [HeapShape.Holds] at hshape + rcases hshape with + ⟨shapeBox, shapeFields, hshapeGet, hshapeNode, _⟩ + rw [hget] at hshapeGet + injection hshapeGet with hbox + subst shapeBox + rw [hnode] at hshapeNode + injection hshapeNode with hidentity + subst shapeIdentity + simp + | pap function supplied => + simp only [HeapShape.Holds] at hshape + rcases hshape with + ⟨shapeBox, arguments, declaration, hshapeGet, _, hshapeNode, _, _⟩ + rw [hget] at hshapeGet + injection hshapeGet with hbox + subst shapeBox + rw [hnode] at hshapeNode + contradiction + +/-- Filtering by the finite fact preserves the evaluator's first-match lookup +for every constructor index admitted by that fact. -/ +theorem find?_pruneAlternatives {fact : Fact} {alternatives : Array Alt} + {index : Nat} (hindex : hasCtorIndex fact index = true) : + (pruneAlternatives fact alternatives).find? + (fun alternative => alternative.cidx == index) = + alternatives.find? (fun alternative => alternative.cidx == index) := by + simp only [pruneAlternatives, Array.find?_filter] + apply congrArg (fun predicate => alternatives.find? predicate) + funext alternative + by_cases hsame : alternative.cidx = index + · subst index + simp [hindex] + · simp [hsame] + +private theorem mayScalar_eq_false_of_preciseHeapOnly {fact : Fact} + (hprecise : preciseHeapOnly fact = true) : fact.mayScalar = false := by + simp [preciseHeapOnly] at hprecise + exact hprecise.1 + +private theorem unknownHeap_eq_false_of_preciseHeapOnly {fact : Fact} + (hprecise : preciseHeapOnly fact = true) : fact.unknownHeap = false := by + simp [preciseHeapOnly] at hprecise + exact hprecise.2 + +/-- A detailed singleton unary result fact exposes one concrete constructor +field. This is the semantic fact that makes the replacement `fetch` total. -/ +private theorem exists_of_exactUnary_holds + {declarations : DeclEnv} {store : Store} {value : RVal} + {identity : CtorId} {fieldFact : FieldFact} + (hholds : (⟨false, false, + [.ctor identity (some [fieldFact])]⟩ : Fact).Holds + declarations store value) : + ∃ location box field, + value = .loc location ∧ + store.get? location = some box ∧ + box.node = .ctorN identity #[field] := by + cases value with + | lit literal => + change false = true at hholds + contradiction + | erased => + change false = true at hholds + contradiction + | loc location => + simp only [Fact.Holds] at hholds + rcases hholds with hunknown | ⟨shape, hmember, hshape⟩ + · contradiction + · simp only [List.mem_singleton] at hmember + subst shape + simp only [HeapShape.Holds] at hshape + rcases hshape with ⟨box, fields, hget, hnode, hfields⟩ + have hlength : fields.toList.length = 1 := by + simpa using (FieldFactsHold.length_eq hfields).symm + cases hlist : fields.toList with + | nil => simp [hlist] at hlength + | cons field tail => + cases tail with + | nil => + have harray : fields = #[field] := by + apply Array.toList_inj.mp + simpa using hlist + refine ⟨location, box, field, rfl, hget, ?_⟩ + simpa [harray] using hnode + | cons next tail => simp [hlist] at hlength + +/-- For a certified unary constructor, one checked fetch installs exactly the +environment that the matching case branch would have received, at the same +code fuel. -/ +private theorem runCode_fetch_eq_exactUnaryCase_of_holds + {declarations : DeclEnv} {ctx : Ctx} {current : FnDef} + {store : Store} {environment : List RVal} {value : RVal} + {identity : CtorId} {fieldFact : FieldFact} {body : Code} + {peelNat : Bool} {fuel : Nat} + (hholds : (⟨false, false, + [.ctor identity (some [fieldFact])]⟩ : Fact).Holds + declarations store value) : + runCode ctx fuel current store (value :: environment) + (.letOp (.fetch (.var 0) 0) body) = + runCode ctx fuel current store (value :: environment) + (.case (.var 0) peelNat #[.mk identity.cidx 1 body]) := by + obtain ⟨location, box, field, hvalue, hget, hnode⟩ := + exists_of_exactUnary_holds hholds + subst value + cases fuel with + | zero => simp [runCode] + | succ fuel => + cases fuel with + | zero => + simp [runCode, runOp, resolveAtom, Alt.cidx, bind, Except.bind, + hget, hnode] + | succ fuel => + simp [runCode, runOp, resolveAtom, Alt.cidx, bind, Except.bind, + hget, hnode] + +/-- Successful executable collapse selection supplies exactly the fact and +branch shape required by the concrete unary-fetch theorem. -/ +private theorem runCode_fetch_eq_of_exactUnaryBody + {declarations : DeclEnv} {ctx : Ctx} {current : FnDef} + {store : Store} {environment : List RVal} {value : RVal} + {fact : Fact} {alternatives : Array Alt} {body : Code} + {peelNat : Bool} {fuel : Nat} + (hprecise : preciseHeapOnly fact = true) + (hbody : exactUnaryBody? fact alternatives = some body) + (hholds : fact.Holds declarations store value) : + runCode ctx fuel current store (value :: environment) + (.letOp (.fetch (.var 0) 0) body) = + runCode ctx fuel current store (value :: environment) + (.case (.var 0) peelNat alternatives) := by + obtain ⟨identity, fieldFact, hshapes, halternatives⟩ := + exactUnaryBody?_eq_some hbody + have hscalar := mayScalar_eq_false_of_preciseHeapOnly hprecise + have hunknown := unknownHeap_eq_false_of_preciseHeapOnly hprecise + cases fact with + | mk mayScalar unknownHeap shapes => + change mayScalar = false at hscalar + change unknownHeap = false at hunknown + change shapes = [.ctor identity (some [fieldFact])] at hshapes + subst mayScalar + subst unknownHeap + subst shapes + subst alternatives + exact runCode_fetch_eq_exactUnaryCase_of_holds hholds + +/-- Once a concrete call result satisfies a finite heap-only row, pruning does +not change evaluation of the immediately following case. -/ +private theorem runCode_case_pruned_eq_of_holds + {declarations : DeclEnv} {ctx : Ctx} {current : FnDef} + {store : Store} {environment : List RVal} {value : RVal} + {fact : Fact} {peelNat : Bool} {alternatives : Array Alt} {fuel : Nat} + (hprecise : preciseHeapOnly fact = true) + (hholds : fact.Holds declarations store value) : + runCode ctx fuel current store (value :: environment) + (.case (.var 0) peelNat (pruneAlternatives fact alternatives)) = + runCode ctx fuel current store (value :: environment) + (.case (.var 0) peelNat alternatives) := by + cases fuel with + | zero => simp [runCode] + | succ fuel => + cases value with + | lit literal => + change fact.mayScalar = true at hholds + rw [mayScalar_eq_false_of_preciseHeapOnly hprecise] at hholds + contradiction + | erased => + change fact.mayScalar = true at hholds + rw [mayScalar_eq_false_of_preciseHeapOnly hprecise] at hholds + contradiction + | loc location => + cases hget : store.get? location with + | none => + simp [runCode, resolveAtom, bind, Except.bind, hget] + | some box => + cases hnode : box.node with + | papN function arity arguments => + simp [runCode, resolveAtom, bind, Except.bind, hget, hnode] + | ctorN identity fields => + have hfind := find?_pruneAlternatives + (fact := fact) (alternatives := alternatives) + (hasCtorIndex_of_holds_ctor + (unknownHeap_eq_false_of_preciseHeapOnly hprecise) + hholds hget hnode) + simp [runCode, resolveAtom, bind, Except.bind, hget, hnode, + hfind] + +/-- A successful concrete `.call` operation is covered by the row selected by +the same declaration and summary environments. -/ +private theorem holds_of_runOp_call + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {current currentFunction : FnDef} + {store outputStore : Store} + {environment : List RVal} {function : Ix.Compiler.Ixon.Address} + {arguments : Array Atom} {fact : Fact} {outputValue : RVal} {fuel : Nat} + (hctx : ctx.decls = declarations) + (hdeclaration : declarations function = some (.fn currentFunction)) + (hsummary : summaries function = some fact) + (hcall : runOp ctx fuel current store environment + (.call function arguments) = .ok (outputStore, outputValue)) : + fact.Holds declarations outputStore outputValue := by + cases fuel with + | zero => simp [runOp] at hcall + | succ fuel => + simp only [runOp] at hcall + cases harguments : resolveAtoms environment arguments with + | error error => + rw [harguments] at hcall + simp only [bind, Except.bind] at hcall + contradiction + | ok values => + have hinvoke : invoke ctx fuel function values store = + .ok (outputStore, outputValue) := by + rw [harguments] at hcall + simpa only [bind, Except.bind] using hcall + exact invoke_sound hpost hctx + (by simp [callableResult, hdeclaration, hsummary]) hinvoke + +/-- Exact evaluator equality for the single rewritten redex. The call itself +is untouched; on success, HPT soundness ensures the concrete constructor's +first matching branch survived the filter. -/ +private theorem runCode_prunedRedex_eq + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {current currentFunction : FnDef} {store : Store} + {environment : List RVal} {function : Ix.Compiler.Ixon.Address} + {arguments : Array Atom} {fact : Fact} {peelNat : Bool} + {alternatives : Array Alt} {fuel : Nat} + (hctx : ctx.decls = declarations) + (hdeclaration : declarations function = some (.fn currentFunction)) + (hsummary : summaries function = some fact) + (hprecise : preciseHeapOnly fact = true) : + runCode ctx fuel current store environment + (.letOp (.call function arguments) + (.case (.var 0) peelNat (pruneAlternatives fact alternatives))) = + runCode ctx fuel current store environment + (.letOp (.call function arguments) + (.case (.var 0) peelNat alternatives)) := by + cases fuel with + | zero => simp [runCode] + | succ fuel => + simp only [runCode] + cases hcall : runOp ctx fuel current store environment + (.call function arguments) with + | error error => + simp [bind, Except.bind] + | ok output => + rcases output with ⟨outputStore, outputValue⟩ + simp only [bind, Except.bind] + exact runCode_case_pruned_eq_of_holds hprecise + (holds_of_runOp_call hpost hctx hdeclaration hsummary hcall) + +/-- Exact evaluator equality between a selected unary-fetch collapse and its +already-pruned singleton case. -/ +private theorem runCode_collapsedRedex_eq + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {current currentFunction : FnDef} {store : Store} + {environment : List RVal} {function : Ix.Compiler.Ixon.Address} + {arguments : Array Atom} {fact : Fact} {peelNat : Bool} + {alternatives : Array Alt} {body : Code} {fuel : Nat} + (hctx : ctx.decls = declarations) + (hdeclaration : declarations function = some (.fn currentFunction)) + (hsummary : summaries function = some fact) + (hprecise : preciseHeapOnly fact = true) + (hcollapse : exactUnaryBody? fact alternatives = some body) : + runCode ctx fuel current store environment + (.letOp (.call function arguments) + (.letOp (.fetch (.var 0) 0) body)) = + runCode ctx fuel current store environment + (.letOp (.call function arguments) + (.case (.var 0) peelNat alternatives)) := by + cases fuel with + | zero => simp [runCode] + | succ fuel => + simp only [runCode] + cases hcall : runOp ctx fuel current store environment + (.call function arguments) with + | error error => + simp [bind, Except.bind] + | ok output => + rcases output with ⟨outputStore, outputValue⟩ + simp only [bind, Except.bind] + exact runCode_fetch_eq_of_exactUnaryBody hprecise hcollapse + (holds_of_runOp_call hpost hctx hdeclaration hsummary hcall) + +/-- The executable consumer preserves the exact evaluator result for every +fuel, store, environment, and current function whenever its summary +environment is a local post-fixpoint for the runtime declaration environment. +This includes every error result, not only successful executions. -/ +theorem runCode_run_eq + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {current : FnDef} {store : Store} + {environment : List RVal} {input : Code} {fuel : Nat} + (hctx : ctx.decls = declarations) : + runCode ctx fuel current store environment + (run declarations summaries input).code = + runCode ctx fuel current store environment input := by + cases input with + | ret atom => rfl + | case scrutinee peelNat alternatives => rfl + | letOp operation rest => + cases operation <;> try rfl + case call function arguments => + cases rest with + | ret atom => rfl + | letOp operation rest => rfl + | case scrutinee peelNat alternatives => + cases scrutinee with + | lit literal => rfl + | erased => rfl + | var index => + cases index with + | succ index => rfl + | zero => + cases hdeclaration : declarations function with + | none => simp [run, hdeclaration] + | some declaration => + cases declaration with + | extern arity => simp [run, hdeclaration] + | fn currentFunction => + cases hsummary : summaries function with + | none => simp [run, hdeclaration, hsummary] + | some fact => + cases hprecise : preciseHeapOnly fact with + | false => + simp [run, hdeclaration, hsummary, hprecise] + | true => + cases hcollapse : exactUnaryBody? fact + (pruneAlternatives fact alternatives) with + | none => + simpa [run, hdeclaration, hsummary, + hprecise, hcollapse] using + runCode_prunedRedex_eq hpost hctx + hdeclaration hsummary hprecise + | some body => + calc + runCode ctx fuel current store + environment + (run declarations summaries + (.letOp + (.call function arguments) + (.case (.var 0) peelNat + alternatives))).code = + runCode ctx fuel current store + environment + (.letOp + (.call function arguments) + (.letOp + (.fetch (.var 0) 0) body)) := by + simp [run, hdeclaration, + hsummary, hprecise, + hcollapse] + _ = runCode ctx fuel current store + environment + (.letOp + (.call function arguments) + (.case (.var 0) peelNat + (pruneAlternatives fact + alternatives))) := + runCode_collapsedRedex_eq hpost hctx + hdeclaration hsummary hprecise + hcollapse + _ = runCode ctx fuel current store + environment + (.letOp + (.call function arguments) + (.case (.var 0) peelNat + alternatives)) := + runCode_prunedRedex_eq hpost hctx + hdeclaration hsummary hprecise + +/-! ## Semantic support for propagated cases -/ + +/-- A checked fetch from an arbitrary resolved atom installs exactly the +environment of its matching detailed-unary case branch. -/ +private theorem runCode_fetchAtom_eq_exactUnaryCase_of_holds + {declarations : DeclEnv} {ctx : Ctx} {current : FnDef} + {store : Store} {environment : List RVal} {scrutinee : Atom} + {value : RVal} {identity : CtorId} {fieldFact : FieldFact} + {body : Code} {peelNat : Bool} {fuel : Nat} + (hresolve : resolveAtom environment scrutinee = .ok value) + (hholds : (⟨false, false, + [.ctor identity (some [fieldFact])]⟩ : Fact).Holds + declarations store value) : + runCode ctx fuel current store environment + (.letOp (.fetch scrutinee 0) body) = + runCode ctx fuel current store environment + (.case scrutinee peelNat #[.mk identity.cidx 1 body]) := by + obtain ⟨location, box, field, hvalue, hget, hnode⟩ := + exists_of_exactUnary_holds hholds + subst value + cases fuel with + | zero => simp [runCode] + | succ fuel => + cases fuel with + | zero => + simp [runCode, runOp, hresolve, Alt.cidx, bind, Except.bind, + hget, hnode] + | succ fuel => + simp [runCode, runOp, hresolve, Alt.cidx, bind, Except.bind, + hget, hnode] + +private theorem runCode_fetchAtom_eq_of_exactUnaryBody + {declarations : DeclEnv} {ctx : Ctx} {current : FnDef} + {store : Store} {environment : List RVal} {scrutinee : Atom} + {value : RVal} {fact : Fact} {alternatives : Array Alt} {body : Code} + {peelNat : Bool} {fuel : Nat} + (hresolve : resolveAtom environment scrutinee = .ok value) + (hprecise : preciseHeapOnly fact = true) + (hbody : exactUnaryBody? fact alternatives = some body) + (hholds : fact.Holds declarations store value) : + runCode ctx fuel current store environment + (.letOp (.fetch scrutinee 0) body) = + runCode ctx fuel current store environment + (.case scrutinee peelNat alternatives) := by + obtain ⟨identity, fieldFact, hshapes, halternatives⟩ := + exactUnaryBody?_eq_some hbody + have hscalar := mayScalar_eq_false_of_preciseHeapOnly hprecise + have hunknown := unknownHeap_eq_false_of_preciseHeapOnly hprecise + cases fact with + | mk mayScalar unknownHeap shapes => + change mayScalar = false at hscalar + change unknownHeap = false at hunknown + change shapes = [.ctor identity (some [fieldFact])] at hshapes + subst mayScalar + subst unknownHeap + subst shapes + subst alternatives + exact runCode_fetchAtom_eq_exactUnaryCase_of_holds hresolve hholds + +/-- Pruning from a fact resolved at an arbitrary program point preserves the +case evaluator, including its first-match behavior and all errors. -/ +private theorem runCode_caseAtom_pruned_eq_of_holds + {declarations : DeclEnv} {ctx : Ctx} {current : FnDef} + {store : Store} {environment : List RVal} {scrutinee : Atom} + {value : RVal} {fact : Fact} {peelNat : Bool} + {alternatives : Array Alt} {fuel : Nat} + (hresolve : resolveAtom environment scrutinee = .ok value) + (hprecise : preciseHeapOnly fact = true) + (hholds : fact.Holds declarations store value) : + runCode ctx fuel current store environment + (.case scrutinee peelNat (pruneAlternatives fact alternatives)) = + runCode ctx fuel current store environment + (.case scrutinee peelNat alternatives) := by + cases fuel with + | zero => simp [runCode] + | succ fuel => + simp only [runCode] + rw [hresolve] + simp only [bind, Except.bind] + cases value with + | lit literal => + change fact.mayScalar = true at hholds + rw [mayScalar_eq_false_of_preciseHeapOnly hprecise] at hholds + contradiction + | erased => + change fact.mayScalar = true at hholds + rw [mayScalar_eq_false_of_preciseHeapOnly hprecise] at hholds + | loc location => + cases hget : store.get? location with + | none => simp [hget] + | some box => + cases hnode : box.node with + | papN function arity arguments => simp [hget, hnode] + | ctorN identity fields => + have hfind := find?_pruneAlternatives + (fact := fact) (alternatives := alternatives) + (hasCtorIndex_of_holds_ctor + (unknownHeap_eq_false_of_preciseHeapOnly hprecise) + hholds hget hnode) + simp [hget, hnode, hfind] + +/-- The environment-driven case root is exact whenever its abstract +scrutinee resolution is backed by the concrete HPT environment. -/ +private theorem runCode_runKnownCase_eq + {declarations : DeclEnv} {ctx : Ctx} {current : FnDef} + {store : Store} {facts : List Fact} {environment : List RVal} + {fact : Fact} {scrutinee : Atom} {peelNat : Bool} + {alternatives : Array Alt} {fuel : Nat} + (henvironment : EnvironmentHolds declarations store facts environment) + (habstract : resolveAtomFact facts scrutinee = .ok fact) : + runCode ctx fuel current store environment + (runKnownCase fact scrutinee peelNat alternatives).code = + runCode ctx fuel current store environment + (.case scrutinee peelNat alternatives) := by + obtain ⟨value, hresolve⟩ := resolveAtom_complete henvironment habstract + have hholds := resolveAtom_sound henvironment habstract hresolve + cases hprecise : preciseHeapOnly fact with + | false => simp [runKnownCase, hprecise] + | true => + cases hcollapse : exactUnaryBody? fact + (pruneAlternatives fact alternatives) with + | none => + simpa [runKnownCase, hprecise, hcollapse] using + (runCode_caseAtom_pruned_eq_of_holds hresolve hprecise hholds) + | some body => + calc + runCode ctx fuel current store environment + (runKnownCase fact scrutinee peelNat alternatives).code = + runCode ctx fuel current store environment + (.letOp (.fetch scrutinee 0) body) := by + simp [runKnownCase, hprecise, hcollapse] + _ = runCode ctx fuel current store environment + (.case scrutinee peelNat + (pruneAlternatives fact alternatives)) := + runCode_fetchAtom_eq_of_exactUnaryBody hresolve hprecise + hcollapse hholds + _ = runCode ctx fuel current store environment + (.case scrutinee peelNat alternatives) := + runCode_caseAtom_pruned_eq_of_holds hresolve hprecise hholds + +@[simp] private theorem runAlternativeWithFacts_cidx + (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Ix.Compiler.Ixon.Address) (current : FnDef) + (scrutineeFact : Fact) (peelNat : Bool) (facts : List Fact) + (alternative : Alt) : + (runAlternativeWithFacts declarations summaries owner current + scrutineeFact peelNat facts alternative).alternative.cidx = + alternative.cidx := by + cases alternative + simp [runAlternativeWithFacts, Alt.cidx] + +private theorem runAlternativeWithFacts_predicate + (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Ix.Compiler.Ixon.Address) (current : FnDef) + (scrutineeFact : Fact) (peelNat : Bool) (facts : List Fact) + (index : Nat) : + ((fun alternative : Alt => alternative.cidx == index) ∘ + (fun result : AlternativeOutcome => result.alternative) ∘ + runAlternativeWithFacts declarations summaries owner current + scrutineeFact peelNat facts) = + (fun alternative => alternative.cidx == index) := by + funext alternative + cases alternative + simp [Function.comp_def, runAlternativeWithFacts, Alt.cidx] + +private theorem find?_runAlternativeWithFacts + (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Ix.Compiler.Ixon.Address) (current : FnDef) + (scrutineeFact : Fact) (peelNat : Bool) (facts : List Fact) + (alternatives : Array Alt) (index : Nat) : + ((alternatives.map + (runAlternativeWithFacts declarations summaries owner current + scrutineeFact peelNat facts)).map + (fun result => result.alternative)).find? + (fun alternative => alternative.cidx == index) = + (alternatives.find? (fun alternative => alternative.cidx == index)).map + (fun alternative => + (runAlternativeWithFacts declarations summaries owner current + scrutineeFact peelNat facts alternative).alternative) := by + rw [Array.map_map, Array.find?_map, + runAlternativeWithFacts_predicate declarations summaries owner current + scrutineeFact peelNat facts index] + simp [Function.comp_def] + +private theorem Array.foldl_cons_eq_reverse_append' + (fields : Array RVal) (environment : List RVal) : + fields.foldl (fun current field => field :: current) environment = + fields.toList.reverse ++ environment := by + rw [← Array.foldl_toList] + induction fields.toList generalizing environment with + | nil => rfl + | cons field fields ih => + simp only [List.foldl_cons] + rw [ih] + simp [List.reverse_cons, List.append_assoc] + +/-- The alternative-body half of propagated case rewriting. HPT's branch +facts are installed only after the concrete evaluator has selected a matching +alternative with the expected field count. -/ +private theorem runCode_caseWithFactsBodies_eq + {declarations : DeclEnv} {summaries : SummaryEnv} + {owner : Ix.Compiler.Ixon.Address} {current : FnDef} + {ctx : Ctx} {store : Store} {facts : List Fact} + {environment : List RVal} {scrutinee : Atom} {peelNat : Bool} + {alternatives : Array Alt} {scrutineeFact : Fact} {fuel : Nat} + (henvironment : EnvironmentHolds declarations store facts environment) + (habstract : resolveAtomFact facts scrutinee = .ok scrutineeFact) + (ih : ∀ {store : Store} {facts : List Fact} + {environment : List RVal} {input : Code}, + EnvironmentHolds declarations store facts environment → + runCode ctx fuel current store environment + (runWithFacts declarations summaries owner current facts input).code = + runCode ctx fuel current store environment input) : + runCode ctx (fuel + 1) current store environment + (.case scrutinee peelNat + ((alternatives.map + (runAlternativeWithFacts declarations summaries owner current + scrutineeFact peelNat facts)).map + (fun result => result.alternative))) = + runCode ctx (fuel + 1) current store environment + (.case scrutinee peelNat alternatives) := by + obtain ⟨scrutineeValue, hresolve⟩ := + resolveAtom_complete henvironment habstract + have hscrutineeHolds := + resolveAtom_sound henvironment habstract hresolve + simp only [runCode] + rw [hresolve] + simp only [bind, Except.bind] + cases scrutineeValue with + | erased => rfl + | lit literal => + cases literal with + | str value => rfl + | nat value => + simp only + cases peelNat with + | false => rfl + | true => + simp only + cases value with + | zero => + simp only + rw [find?_runAlternativeWithFacts] + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == 0) with + | none => simp + | some alternative => + cases alternative with + | mk cidx fields body => + cases fields with + | zero => + have hzero : + scrutineeFact.caseFields true cidx 0 = [] := by + unfold Fact.caseFields + split <;> rfl + simpa [runAlternativeWithFacts, hzero] using + (ih (input := body) henvironment) + | succ fields => simp [runAlternativeWithFacts] + | succ value => + simp only + rw [find?_runAlternativeWithFacts] + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == 1) with + | none => simp + | some alternative => + cases alternative with + | mk cidx fields body => + cases fields with + | zero => simp [runAlternativeWithFacts] + | succ fields => + cases fields with + | zero => + have hcidx : cidx = 1 := by + have hmatch := Array.find?_some + (p := fun alternative : Alt => + alternative.cidx == 1) + (a := .mk cidx 1 body) + (xs := alternatives) hfind + exact beq_iff_eq.mp hmatch + have hbinders : + EnvironmentHolds declarations store + (scrutineeFact.caseFields true cidx 1) + [.lit (.nat value)] := by + simpa [hcidx] using + (Fact.caseFields_natSucc_holds + hscrutineeHolds) + simpa [runAlternativeWithFacts] using + (ih (input := body) + (hbinders.append henvironment)) + | succ fields => + simp [runAlternativeWithFacts] + | loc location => + simp only + cases hget : store.get? location with + | none => simp + | some box => + simp only + cases hnode : box.node with + | papN function arity arguments => simp + | ctorN identity fields => + simp only + rw [find?_runAlternativeWithFacts] + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == identity.cidx) with + | none => simp + | some alternative => + cases alternative with + | mk cidx fieldCount body => + by_cases hfields : fields.size = fieldCount + · have hcidx : identity.cidx = cidx := by + have hmatch := Array.find?_some + (p := fun alternative : Alt => + alternative.cidx == identity.cidx) + (a := .mk cidx fieldCount body) + (xs := alternatives) hfind + exact (beq_iff_eq.mp hmatch).symm + have hbinders := Fact.caseFields_ctor_holds + peelNat cidx fieldCount hscrutineeHolds hget hnode + hcidx hfields + rw [Array.foldl_cons_eq_reverse_append'] + simpa [hfields, runAlternativeWithFacts] using + (ih (input := body) + (hbinders.append henvironment)) + · simp [hfields, runAlternativeWithFacts] + +/-- Exact evaluator equality for the owner-sensitive HPT traversal. This is +the reusable semantic boundary for subsequent fact-driven local consumers. -/ +theorem runCode_runWithFacts_eq + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {owner : Ix.Compiler.Ixon.Address} {current : FnDef} + {store : Store} {facts : List Fact} {environment : List RVal} + {input : Code} {fuel : Nat} + (hctx : ctx.decls = declarations) + (hcurrent : declarations owner = some (.fn current)) + (henvironment : EnvironmentHolds declarations store facts environment) : + runCode ctx fuel current store environment + (runWithFacts declarations summaries owner current facts input).code = + runCode ctx fuel current store environment input := by + induction fuel generalizing store facts environment input with + | zero => simp [runCode] + | succ fuel ih => + cases input with + | ret atom => simp [runWithFacts, runCode] + | letOp operation rest => + cases habstract : analyzeOp declarations summaries owner current + facts operation with + | error error => simp [runWithFacts, habstract] + | ok bound => + simp only [runWithFacts, habstract, runCode] + cases hoperation : runOp ctx fuel current store environment + operation with + | error error => simp [bind, Except.bind] + | ok output => + rcases output with ⟨outputStore, outputValue⟩ + simp only [bind, Except.bind] + have hbound := analyzeOp_sound hpost hctx hcurrent + henvironment habstract hoperation + have hold := EnvironmentHolds.forgetHeap + (after := outputStore) henvironment + exact ih (store := outputStore) + (facts := bound :: facts.map Fact.forgetHeap) + (environment := outputValue :: environment) + (input := rest) (.cons hbound hold) + | case scrutinee peelNat alternatives => + cases habstract : resolveAtomFact facts scrutinee with + | error error => simp [runWithFacts, habstract] + | ok scrutineeFact => + simp only [runWithFacts, habstract] + calc + runCode ctx (fuel + 1) current store environment + (runKnownCase scrutineeFact scrutinee peelNat + ((alternatives.map + (runAlternativeWithFacts declarations summaries owner + current scrutineeFact peelNat facts)).map + (fun result => result.alternative))).code = + runCode ctx (fuel + 1) current store environment + (.case scrutinee peelNat + ((alternatives.map + (runAlternativeWithFacts declarations summaries owner + current scrutineeFact peelNat facts)).map + (fun result => result.alternative))) := + runCode_runKnownCase_eq henvironment habstract + _ = runCode ctx (fuel + 1) current store environment + (.case scrutinee peelNat alternatives) := + runCode_caseWithFactsBodies_eq henvironment habstract + (fun henv => ih henv) + +/-- Changing one owner-sensitive current body preserves a case step whenever +the two current frames agree at the smaller fuel. -/ +private theorem runCode_case_rewriteCurrentAt_eq + (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Ix.Compiler.Ixon.Address) (current : FnDef) + {ctx : Ctx} {fuel : Nat} + (ih : ∀ {store : Store} {environment : List RVal} {input : Code}, + runCode ctx fuel + (rewriteCurrentAt declarations summaries owner current) + store environment input = + runCode ctx fuel current store environment input) + (store : Store) (environment : List RVal) + (scrutinee : Atom) (peelNat : Bool) (alternatives : Array Alt) : + runCode ctx (fuel + 1) + (rewriteCurrentAt declarations summaries owner current) + store environment (.case scrutinee peelNat alternatives) = + runCode ctx (fuel + 1) current store environment + (.case scrutinee peelNat alternatives) := by + simp only [runCode] + cases hscrutinee : resolveAtom environment scrutinee with + | error error => simp [bind, Except.bind] + | ok value => + simp only [bind, Except.bind] + cases value with + | erased => rfl + | lit literal => + cases literal with + | str value => rfl + | nat value => + simp only + cases peelNat with + | false => rfl + | true => + simp only + cases value with + | zero => + simp only + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == 0) with + | none => simp + | some alternative => + cases alternative with + | mk cidx fields body => + cases fields with + | zero => exact ih + | succ fields => simp + | succ value => + simp only + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == 1) with + | none => simp + | some alternative => + cases alternative with + | mk cidx fields body => + cases fields with + | zero => simp + | succ fields => + cases fields with + | zero => exact ih + | succ fields => simp + | loc location => + simp only + cases hget : store.get? location with + | none => simp + | some box => + simp only + cases hnode : box.node with + | papN function arity arguments => simp + | ctorN identity fields => + simp only + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == identity.cidx) with + | none => simp + | some alternative => + cases alternative with + | mk cidx fieldCount body => + by_cases hfields : fields.size = fieldCount + · simpa [hfields] using + ih (store := store) + (environment := fields.foldl + (fun result field => field :: result) + environment) + (input := body) + · simp [hfields] + +/-- At one positive operation fuel, changing the owner-sensitive current body +is invisible. `callSelf` uses both the smaller-fuel frame hypothesis and the +proved HPT traversal equality for the rewritten recursive body. -/ +private theorem runOp_rewriteCurrentAt_eq + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {owner : Ix.Compiler.Ixon.Address} {current : FnDef} + {fuel : Nat} + (ih : ∀ {store : Store} {environment : List RVal} {input : Code}, + runCode ctx fuel + (rewriteCurrentAt declarations summaries owner current) + store environment input = + runCode ctx fuel current store environment input) + (hctx : ctx.decls = declarations) + (hcurrent : declarations owner = some (.fn current)) + (store : Store) (environment : List RVal) (operation : Op) : + runOp ctx (fuel + 1) + (rewriteCurrentAt declarations summaries owner current) + store environment operation = + runOp ctx (fuel + 1) current store environment operation := by + cases operation <;> try simp [runOp, rewriteCurrentAt] + case callSelf arguments => + cases harguments : resolveAtoms environment arguments with + | error error => simp [bind, Except.bind] + | ok values => + by_cases harity : values.length = current.arity + · have henvironment : EnvironmentHolds declarations store + (List.replicate current.arity Fact.top) values.reverse := by + simpa [harity] using + (EnvironmentHolds.top_replicate declarations store + values.reverse) + have hbody : + runCode ctx fuel + (rewriteCurrentAt declarations summaries owner current) + store values.reverse + (rewriteCurrentAt declarations summaries owner current).body = + runCode ctx fuel current store values.reverse current.body := by + calc + runCode ctx fuel + (rewriteCurrentAt declarations summaries owner current) + store values.reverse + (rewriteCurrentAt declarations summaries owner current).body = + runCode ctx fuel current store values.reverse + (rewriteCurrentAt declarations summaries owner current).body := + ih + _ = runCode ctx fuel current store values.reverse current.body := by + simpa [rewriteCurrentAt, runFunction] using + (runCode_runWithFacts_eq hpost hctx hcurrent henvironment) + simp only [rewriteCurrentAt] at hbody + simp [harity, bind, Except.bind] + rw [hbody] + · simp [harity, bind, Except.bind] + +/-- Rewriting a stored function from its owner-aware HPT environment is +observationally irrelevant to arbitrary code executed under that current +frame. -/ +theorem runCode_rewriteCurrentAt_eq + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {owner : Ix.Compiler.Ixon.Address} {current : FnDef} + {store : Store} {environment : List RVal} {input : Code} {fuel : Nat} + (hctx : ctx.decls = declarations) + (hcurrent : declarations owner = some (.fn current)) : + runCode ctx fuel (rewriteCurrentAt declarations summaries owner current) + store environment input = + runCode ctx fuel current store environment input := by + induction fuel using Nat.strongRecOn generalizing store environment input with + | ind fuel ih => + cases fuel with + | zero => simp [runCode] + | succ fuel => + have hsmaller : ∀ {store : Store} {environment : List RVal} + {input : Code}, + runCode ctx fuel + (rewriteCurrentAt declarations summaries owner current) + store environment input = + runCode ctx fuel current store environment input := + ih fuel (Nat.lt_succ_self fuel) + cases input with + | ret atom => simp [runCode] + | case scrutinee peelNat alternatives => + exact runCode_case_rewriteCurrentAt_eq declarations summaries + owner current hsmaller store environment scrutinee peelNat + alternatives + | letOp operation rest => + cases fuel with + | zero => simp [runCode, runOp] + | succ smaller => + simp only [runCode] + rw [runOp_rewriteCurrentAt_eq hpost + (ih smaller (by omega)) hctx hcurrent] + cases hoperation : runOp ctx (smaller + 1) current store + environment operation with + | error error => simp [bind, Except.bind] + | ok output => + rcases output with ⟨outputStore, outputValue⟩ + simp only [bind, Except.bind] + exact ih (smaller + 1) (by omega) + (store := outputStore) + (environment := outputValue :: environment) + (input := rest) + +/-- Combined body-and-current equality used when invocation enters a rewritten +stored function. -/ +theorem runCode_rewriteCurrentAt_body_eq + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {owner : Ix.Compiler.Ixon.Address} {current : FnDef} + {store : Store} {environment : List RVal} {fuel : Nat} + (hctx : ctx.decls = declarations) + (hcurrent : declarations owner = some (.fn current)) + (henvironment : EnvironmentHolds declarations store + (List.replicate current.arity Fact.top) environment) : + runCode ctx fuel (rewriteCurrentAt declarations summaries owner current) + store environment + (rewriteCurrentAt declarations summaries owner current).body = + runCode ctx fuel current store environment current.body := by + calc + runCode ctx fuel (rewriteCurrentAt declarations summaries owner current) + store environment + (rewriteCurrentAt declarations summaries owner current).body = + runCode ctx fuel current store environment + (rewriteCurrentAt declarations summaries owner current).body := + runCode_rewriteCurrentAt_eq hpost hctx hcurrent + _ = runCode ctx fuel current store environment current.body := by + simpa [rewriteCurrentAt, runFunction] using + (runCode_runWithFacts_eq hpost hctx hcurrent henvironment) + +@[simp] private theorem runAlternativeRecursive_cidx + (declarations : DeclEnv) (summaries : SummaryEnv) (alternative : Alt) : + (runAlternativeRecursive declarations summaries + alternative).alternative.cidx = alternative.cidx := by + cases alternative + simp [runAlternativeRecursive, Alt.cidx] + +/-- Recursive body rewriting leaves the case-dispatch predicate unchanged. -/ +private theorem runAlternativeRecursive_predicate + (declarations : DeclEnv) (summaries : SummaryEnv) + (index : Nat) : + ((fun alternative : Alt => alternative.cidx == index) ∘ + (fun result : AlternativeOutcome => result.alternative) ∘ + runAlternativeRecursive declarations summaries) = + (fun alternative => alternative.cidx == index) := by + funext alternative + cases alternative + simp [Function.comp_def, runAlternativeRecursive, Alt.cidx] + +/-- Recursive body rewriting preserves first-match dispatch and returns the +rewritten version of the originally selected alternative. -/ +private theorem find?_runAlternativeRecursive + (declarations : DeclEnv) (summaries : SummaryEnv) + (alternatives : Array Alt) (index : Nat) : + ((alternatives.map (runAlternativeRecursive declarations summaries)).map + (fun result => result.alternative)).find? + (fun alternative => alternative.cidx == index) = + (alternatives.find? (fun alternative => alternative.cidx == index)).map + (fun alternative => + (runAlternativeRecursive declarations summaries + alternative).alternative) := by + rw [Array.map_map, Array.find?_map, + runAlternativeRecursive_predicate declarations summaries index] + simp [Function.comp_def] + +/-- If every recursively rewritten body is equivalent at the smaller fuel, +then a case whose alternative bodies were all rewritten is equivalent at the +successor fuel. -/ +private theorem runCode_recursiveCase_eq + (declarations : DeclEnv) (summaries : SummaryEnv) + {ctx : Ctx} {fuel : Nat} + (ih : ∀ {current : FnDef} {store : Store} {environment : List RVal} + {input : Code}, + runCode ctx fuel current store environment + (runRecursive declarations summaries input).code = + runCode ctx fuel current store environment input) + (current : FnDef) (store : Store) (environment : List RVal) + (scrutinee : Atom) (peelNat : Bool) (alternatives : Array Alt) : + runCode ctx (fuel + 1) current store environment + (runRecursive declarations summaries + (.case scrutinee peelNat alternatives)).code = + runCode ctx (fuel + 1) current store environment + (.case scrutinee peelNat alternatives) := by + simp only [runRecursive, runCode] + cases hscrutinee : resolveAtom environment scrutinee with + | error error => + simp [bind, Except.bind] + | ok value => + simp only [bind, Except.bind] + cases value with + | erased => rfl + | lit literal => + cases literal with + | str value => rfl + | nat value => + simp only + cases peelNat with + | false => rfl + | true => + simp only + cases value with + | zero => + simp only + rw [find?_runAlternativeRecursive] + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == 0) with + | none => + simp + | some alternative => + cases alternative with + | mk cidx fields body => + cases fields with + | zero => + simpa [runAlternativeRecursive] using + ih (current := current) (store := store) + (environment := environment) (input := body) + | succ fields => + simp [runAlternativeRecursive] + | succ value => + simp only + rw [find?_runAlternativeRecursive] + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == 1) with + | none => + simp + | some alternative => + cases alternative with + | mk cidx fields body => + cases fields with + | zero => + simp [runAlternativeRecursive] + | succ fields => + cases fields with + | zero => + simpa [runAlternativeRecursive] using + ih (current := current) (store := store) + (environment := + .lit (.nat value) :: environment) + (input := body) + | succ fields => + simp [runAlternativeRecursive] + | loc location => + simp only + cases hget : store.get? location with + | none => simp + | some box => + simp only + cases hnode : box.node with + | papN function arity arguments => simp + | ctorN identity fields => + simp only + rw [find?_runAlternativeRecursive] + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == identity.cidx) with + | none => + simp + | some alternative => + cases alternative with + | mk cidx fieldCount body => + by_cases hfields : fields.size = fieldCount + · simpa [hfields, runAlternativeRecursive] using + ih (current := current) (store := store) + (environment := fields.foldl + (fun result field => field :: result) + environment) + (input := body) + · simp [hfields, runAlternativeRecursive] + +/-- Recursive traversal preserves the exact evaluator result for every code +fragment under the same local post-fixpoint premise as the one-root pass. -/ +theorem runCode_runRecursive_eq + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {current : FnDef} {store : Store} + {environment : List RVal} {input : Code} {fuel : Nat} + (hctx : ctx.decls = declarations) : + runCode ctx fuel current store environment + (runRecursive declarations summaries input).code = + runCode ctx fuel current store environment input := by + induction fuel generalizing current store environment input with + | zero => simp [runCode] + | succ fuel ih => + cases input with + | ret atom => simp [runRecursive] + | case scrutinee peelNat alternatives => + exact runCode_recursiveCase_eq declarations summaries ih current + store environment scrutinee peelNat alternatives + | letOp operation rest => + let nested := runRecursive declarations summaries rest + calc + runCode ctx (fuel + 1) current store environment + (runRecursive declarations summaries + (.letOp operation rest)).code = + runCode ctx (fuel + 1) current store environment + (.letOp operation nested.code) := by + simpa only [runRecursive, nested] using + runCode_run_eq hpost (fuel := fuel + 1) hctx + (input := .letOp operation nested.code) + _ = runCode ctx (fuel + 1) current store environment + (.letOp operation rest) := by + simp only [runCode] + cases hoperation : runOp ctx fuel current store environment + operation with + | error error => simp [bind, Except.bind] + | ok output => + rcases output with ⟨outputStore, outputValue⟩ + simp only [bind, Except.bind] + exact ih (current := current) (store := outputStore) + (environment := outputValue :: environment) + (input := rest) + +/-- Changing only the current body preserves a case step whenever evaluation +under the two current frames agrees at the smaller fuel. -/ +private theorem runCode_case_rewriteCurrent_eq + (declarations : DeclEnv) (summaries : SummaryEnv) + {ctx : Ctx} {fuel : Nat} + (ih : ∀ {current : FnDef} {store : Store} {environment : List RVal} + {input : Code}, + runCode ctx fuel (rewriteCurrent declarations summaries current) + store environment input = + runCode ctx fuel current store environment input) + (current : FnDef) (store : Store) (environment : List RVal) + (scrutinee : Atom) (peelNat : Bool) (alternatives : Array Alt) : + runCode ctx (fuel + 1) (rewriteCurrent declarations summaries current) + store environment (.case scrutinee peelNat alternatives) = + runCode ctx (fuel + 1) current store environment + (.case scrutinee peelNat alternatives) := by + simp only [runCode] + cases hscrutinee : resolveAtom environment scrutinee with + | error error => simp [bind, Except.bind] + | ok value => + simp only [bind, Except.bind] + cases value with + | erased => rfl + | lit literal => + cases literal with + | str value => rfl + | nat value => + simp only + cases peelNat with + | false => rfl + | true => + simp only + cases value with + | zero => + simp only + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == 0) with + | none => simp + | some alternative => + cases alternative with + | mk cidx fields body => + cases fields with + | zero => + exact ih (current := current) (store := store) + (environment := environment) (input := body) + | succ fields => simp + | succ value => + simp only + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == 1) with + | none => simp + | some alternative => + cases alternative with + | mk cidx fields body => + cases fields with + | zero => simp + | succ fields => + cases fields with + | zero => + exact ih (current := current) + (store := store) + (environment := + .lit (.nat value) :: environment) + (input := body) + | succ fields => simp + | loc location => + simp only + cases hget : store.get? location with + | none => simp + | some box => + simp only + cases hnode : box.node with + | papN function arity arguments => simp + | ctorN identity fields => + simp only + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == identity.cidx) with + | none => simp + | some alternative => + cases alternative with + | mk cidx fieldCount body => + by_cases hfields : fields.size = fieldCount + · simpa [hfields] using + ih (current := current) (store := store) + (environment := fields.foldl + (fun result field => field :: result) + environment) + (input := body) + · simp [hfields] + +/-- At one positive operation fuel, rewriting the current body is invisible. +The only non-definitional case is `callSelf`, whose recursive body execution +is discharged by the smaller-fuel current-frame hypothesis. -/ +private theorem runOp_rewriteCurrent_eq + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {fuel : Nat} + (ih : ∀ {current : FnDef} {store : Store} {environment : List RVal} + {input : Code}, + runCode ctx fuel (rewriteCurrent declarations summaries current) + store environment input = + runCode ctx fuel current store environment input) + (hctx : ctx.decls = declarations) + (current : FnDef) (store : Store) (environment : List RVal) + (operation : Op) : + runOp ctx (fuel + 1) (rewriteCurrent declarations summaries current) + store environment operation = + runOp ctx (fuel + 1) current store environment operation := by + cases operation <;> try simp [runOp] + case callSelf arguments => + cases harguments : resolveAtoms environment arguments with + | error error => + simp [bind, Except.bind] + | ok values => + by_cases harity : values.length = current.arity + · have hbody : + runCode ctx fuel + (rewriteCurrent declarations summaries current) store + values.reverse + (rewriteCurrent declarations summaries current).body = + runCode ctx fuel current store values.reverse current.body := by + calc + runCode ctx fuel + (rewriteCurrent declarations summaries current) store + values.reverse + (rewriteCurrent declarations summaries current).body = + runCode ctx fuel + (rewriteCurrent declarations summaries current) store + values.reverse current.body := by + simpa only [rewriteCurrent] using + runCode_runRecursive_eq hpost (fuel := fuel) hctx + (current := rewriteCurrent declarations summaries current) + (store := store) (environment := values.reverse) + (input := current.body) + _ = runCode ctx fuel current store values.reverse current.body := + ih (current := current) (store := store) + (environment := values.reverse) (input := current.body) + simp only [rewriteCurrent] at hbody + simp [rewriteCurrent, harity, bind, Except.bind] + rw [hbody] + · simp [rewriteCurrent, harity, bind, Except.bind] + +/-- Rewriting a current-function body is observationally irrelevant when the +same current frame is used by `callSelf`. Strong induction supplies the +strictly smaller recursive self-call. -/ +theorem runCode_rewriteCurrent_eq + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {current : FnDef} {store : Store} + {environment : List RVal} {input : Code} {fuel : Nat} + (hctx : ctx.decls = declarations) : + runCode ctx fuel (rewriteCurrent declarations summaries current) + store environment input = + runCode ctx fuel current store environment input := by + induction fuel using Nat.strongRecOn generalizing current store + environment input with + | ind fuel ih => + cases fuel with + | zero => simp [runCode] + | succ fuel => + have hsmaller : ∀ {current : FnDef} {store : Store} + {environment : List RVal} {input : Code}, + runCode ctx fuel + (rewriteCurrent declarations summaries current) + store environment input = + runCode ctx fuel current store environment input := + ih fuel (Nat.lt_succ_self fuel) + cases input with + | ret atom => simp [runCode] + | case scrutinee peelNat alternatives => + exact runCode_case_rewriteCurrent_eq declarations summaries + hsmaller current store environment scrutinee peelNat + alternatives + | letOp operation rest => + cases fuel with + | zero => simp [runCode, runOp] + | succ smaller => + simp only [runCode] + rw [runOp_rewriteCurrent_eq hpost + (ih smaller (by omega)) hctx] + cases hoperation : runOp ctx (smaller + 1) current store + environment operation with + | error error => simp [bind, Except.bind] + | ok output => + rcases output with ⟨outputStore, outputValue⟩ + simp only [bind, Except.bind] + exact ih (smaller + 1) (by omega) + (current := current) (store := outputStore) + (environment := outputValue :: environment) + (input := rest) + +/-- Recursive pruning can update both a supplied fragment and the current +frame that `callSelf` re-enters. -/ +theorem runCode_runRecursive_rewriteCurrent_eq + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {current : FnDef} {store : Store} + {environment : List RVal} {input : Code} {fuel : Nat} + (hctx : ctx.decls = declarations) : + runCode ctx fuel (rewriteCurrent declarations summaries current) + store environment (runRecursive declarations summaries input).code = + runCode ctx fuel current store environment input := by + calc + runCode ctx fuel (rewriteCurrent declarations summaries current) + store environment (runRecursive declarations summaries input).code = + runCode ctx fuel (rewriteCurrent declarations summaries current) + store environment input := runCode_runRecursive_eq hpost hctx + _ = runCode ctx fuel current store environment input := + runCode_rewriteCurrent_eq hpost hctx + +/-- Recursive pruning of a top-level main is exact even when `callSelf` +re-enters that main. -/ +theorem runMain_runRecursive_eq + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {input : Code} {fuel : Nat} + (hctx : ctx.decls = declarations) : + runMain ctx (runRecursive declarations summaries input).code fuel = + runMain ctx input fuel := by + simpa [runMain, rewriteCurrent] using + (runCode_runRecursive_rewriteCurrent_eq hpost + (current := ⟨0, .shared, false, input⟩) (store := {}) (environment := []) + (input := input) (fuel := fuel) hctx) + +/-- Whole-program certificate specialization of `runCode_run_eq`. -/ +theorem runCode_run_eq_of_postFixpoint + {program : List ReaddressAll.Artifact} {certificate : Certificate} + (hcertificate : certificate.postFixpoint program = true) + {ctx : Ctx} {current : FnDef} {store : Store} + {environment : List RVal} {input : Code} {fuel : Nat} + (hctx : ctx.decls = programDeclEnv program) : + runCode ctx fuel current store environment + (run (programDeclEnv program) certificate.summaryEnv input).code = + runCode ctx fuel current store environment input := by + exact runCode_run_eq + (localPostFixpoint_of_postFixpoint hcertificate) hctx + +/-- A successful configurable HPT check is sufficient authority for the +consumer. The returned materialized summary identities are not trusted as a +substitute for the checked candidate's post-fixpoint evidence. -/ +theorem runCode_run_eq_of_runWith_eq_ok + {limits : Limits} {program : List ReaddressAll.Artifact} + {certificate : Certificate} {result : Result} + (hcheck : HPT.runWith limits program certificate = .ok result) + {ctx : Ctx} {current : FnDef} {store : Store} + {environment : List RVal} {input : Code} {fuel : Nat} + (hctx : ctx.decls = programDeclEnv program) : + runCode ctx fuel current store environment + (run (programDeclEnv program) certificate.summaryEnv input).code = + runCode ctx fuel current store environment input := by + exact runCode_run_eq_of_postFixpoint + (postFixpoint_of_runWith_eq_ok hcheck) hctx + +/-- Whole-program certificate specialization of `runCode_runRecursive_eq`. -/ +theorem runCode_runRecursive_eq_of_postFixpoint + {program : List ReaddressAll.Artifact} {certificate : Certificate} + (hcertificate : certificate.postFixpoint program = true) + {ctx : Ctx} {current : FnDef} {store : Store} + {environment : List RVal} {input : Code} {fuel : Nat} + (hctx : ctx.decls = programDeclEnv program) : + runCode ctx fuel current store environment + (runRecursive (programDeclEnv program) certificate.summaryEnv input).code = + runCode ctx fuel current store environment input := by + exact runCode_runRecursive_eq + (localPostFixpoint_of_postFixpoint hcertificate) hctx + +/-- A successful configurable HPT check is sufficient authority for recursive +pruning throughout the supplied code fragment. -/ +theorem runCode_runRecursive_eq_of_runWith_eq_ok + {limits : Limits} {program : List ReaddressAll.Artifact} + {certificate : Certificate} {result : Result} + (hcheck : HPT.runWith limits program certificate = .ok result) + {ctx : Ctx} {current : FnDef} {store : Store} + {environment : List RVal} {input : Code} {fuel : Nat} + (hctx : ctx.decls = programDeclEnv program) : + runCode ctx fuel current store environment + (runRecursive (programDeclEnv program) certificate.summaryEnv input).code = + runCode ctx fuel current store environment input := by + exact runCode_runRecursive_eq_of_postFixpoint + (postFixpoint_of_runWith_eq_ok hcheck) hctx + +/-- Whole-program certificate specialization of the self-call-aware main +theorem. The declaration environment remains the checked addressed graph. -/ +theorem runMain_runRecursive_eq_of_postFixpoint + {program : List ReaddressAll.Artifact} {certificate : Certificate} + (hcertificate : certificate.postFixpoint program = true) + {ctx : Ctx} {input : Code} {fuel : Nat} + (hctx : ctx.decls = programDeclEnv program) : + runMain ctx + (runRecursive (programDeclEnv program) certificate.summaryEnv + input).code fuel = + runMain ctx input fuel := by + exact runMain_runRecursive_eq + (localPostFixpoint_of_postFixpoint hcertificate) hctx + +/-- Successful configurable checking authorizes recursive main pruning, +including every dynamic re-entry through `callSelf`. -/ +theorem runMain_runRecursive_eq_of_runWith_eq_ok + {limits : Limits} {program : List ReaddressAll.Artifact} + {certificate : Certificate} {result : Result} + (hcheck : HPT.runWith limits program certificate = .ok result) + {ctx : Ctx} {input : Code} {fuel : Nat} + (hctx : ctx.decls = programDeclEnv program) : + runMain ctx + (runRecursive (programDeclEnv program) certificate.summaryEnv + input).code fuel = + runMain ctx input fuel := by + exact runMain_runRecursive_eq_of_postFixpoint + (postFixpoint_of_runWith_eq_ok hcheck) hctx + +end Ix.Compiler.IxIR1.HPT.CasePrune diff --git a/Ix/Compiler/IxIR1/HPTCasePruneProgram.lean b/Ix/Compiler/IxIR1/HPTCasePruneProgram.lean new file mode 100644 index 000000000..f641f343a --- /dev/null +++ b/Ix/Compiler/IxIR1/HPTCasePruneProgram.lean @@ -0,0 +1,360 @@ +import Ix.Compiler.IxIR1.HPTCasePrune +import Ix.Compiler.IxIR1.EvalRewrite +import Ix.Compiler.IxIR1.ReaddressAllSim + +/-! +# Whole-program semantic support for HPT case simplification + +`HPTCasePrune` proves supplied fragments equivalent in a fixed environment and +proves each owner-sensitive, fact-propagated function rewrite equivalent in +its original frame. Rewriting every stored function changes the environment +itself: direct calls and PAP application subsequently enter the rewritten +definitions. This module discharges the generic exact-environment contract; +`EvalRewrite` closes that recursive seam once by a common fuel induction over +every evaluator entry point. + +The result is still a logical, old-keyed environment. A production artifact +must readdress `rewriteEntries`; that content-address rebuild is kept separate +so no theorem silently treats changed declaration bytes as retaining their old +identity. +-/ + +namespace Ix.Compiler.IxIR1.HPT.CasePrune + +/-- The logical case-pruned declaration environment preserves misses, externs, +calling conventions, and exact source-context behavior for every function. -/ +theorem exactEnvironment_rewriteCtx + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} (hctx : ctx.decls = declarations) : + Sim.ExactEnvironment ctx (rewriteCtx declarations summaries ctx) := by + constructor + · rfl + · intro address hsource + have hdeclaration : declarations address = none := by + rw [← hctx] + exact hsource + simp [rewriteCtx, rewriteDeclEnv, hdeclaration] + · intro address arity hsource + have hdeclaration : declarations address = some (.extern arity) := by + rw [← hctx] + exact hsource + simp [rewriteCtx, rewriteDeclEnv, hdeclaration, rewriteDeclarationAt] + · intro address source hsource + have hdeclaration : declarations address = some (.fn source) := by + rw [← hctx] + exact hsource + refine ⟨rewriteCurrentAt declarations summaries address source, ?_, + rfl, rfl, rfl, ?_⟩ + · simp [rewriteCtx, rewriteDeclEnv, hdeclaration, rewriteDeclarationAt] + · intro fuel store environment hlength + have henvironment : EnvironmentHolds declarations store + (List.replicate source.arity Fact.top) environment := by + simpa [hlength] using + (EnvironmentHolds.top_replicate declarations store environment) + exact runCode_rewriteCurrentAt_body_eq hpost hctx hdeclaration + henvironment + +/-- Replacing every declaration body under the existing keys is evaluator +equivalent for arbitrary code and dynamic current frames. -/ +theorem runCode_rewriteCtx_eq + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {current : FnDef} {store : Store} + {environment : List RVal} {input : Code} {fuel : Nat} + (hctx : ctx.decls = declarations) : + runCode (rewriteCtx declarations summaries ctx) fuel current store + environment input = + runCode ctx fuel current store environment input := + Sim.runCode_exactEnvironment_eq (exactEnvironment_rewriteCtx hpost hctx) + +/-- Logical whole-program rewrite: declaration bodies and the main/current +frame are pruned together, with exact equality of successes and every error. -/ +theorem runMain_rewriteProgram_eq + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {input : Code} {fuel : Nat} + (hctx : ctx.decls = declarations) : + runMain (rewriteCtx declarations summaries ctx) + (runRecursive declarations summaries input).code fuel = + runMain ctx input fuel := by + calc + runMain (rewriteCtx declarations summaries ctx) + (runRecursive declarations summaries input).code fuel = + runMain ctx (runRecursive declarations summaries input).code fuel := by + simpa [runMain] using + (runCode_rewriteCtx_eq hpost + (current := ⟨0, .shared, false, + (runRecursive declarations summaries input).code⟩) + (store := {}) (environment := []) + (input := (runRecursive declarations summaries input).code) + (fuel := fuel) hctx) + _ = runMain ctx input fuel := runMain_runRecursive_eq hpost hctx + +private theorem find?_rewriteEntries + (declarations : DeclEnv) (summaries : SummaryEnv) + (address : Ix.Compiler.Ixon.Address) : + ∀ entries : List (Ix.Compiler.Ixon.Address × Decl), + (rewriteEntries declarations summaries entries).find? + (fun entry => entry.1 == address) = + (entries.find? (fun entry => entry.1 == address)).map + (fun entry => + (entry.1, + rewriteDeclarationAt declarations summaries entry.1 + entry.2)) := by + intro entries + induction entries with + | nil => rfl + | cons entry rest ih => + rcases entry with ⟨entryAddress, declaration⟩ + simp only [rewriteEntries, List.map_cons, List.find?_cons] + by_cases hsame : entryAddress == address + · simp [hsame] + · simp only [hsame] + exact ih + +/-- Mapping the declarations in a concrete list realizes exactly the logical +environment transformer used by the semantic theorem. -/ +theorem envOfList_rewriteEntries + (declarations : DeclEnv) (summaries : SummaryEnv) + (entries : List (Ix.Compiler.Ixon.Address × Decl)) : + Env.ofList (rewriteEntries declarations summaries entries) = + fun address => + (Env.ofList entries address).map + (rewriteDeclarationAt declarations summaries address) := by + funext address + unfold Env.ofList + rw [find?_rewriteEntries] + cases hentry : entries.find? (fun entry => entry.1 == address) with + | none => rfl + | some entry => + rcases entry with ⟨entryAddress, declaration⟩ + have hsame := List.find?_some hentry + have haddress : entryAddress = address := beq_iff_eq.mp hsame + subst entryAddress + rfl + +/-! ## Content-addressed program rebuild -/ + +/-- Collect all pass-attributed counters from one stored declaration with its +owner-sensitive fact traversal. -/ +def declarationChanges (declarations : DeclEnv) + (summaries : SummaryEnv) (owner : Ix.Compiler.Ixon.Address) : + Decl → Changes + | .fn function => + (runFunction declarations summaries owner function).changes + | .extern _ => {} + +/-- Sum declaration-body changes in original row order. -/ +def declarationsChanges (declarations : DeclEnv) + (summaries : SummaryEnv) + (entries : List (Ix.Compiler.Ixon.Address × Decl)) : Changes := + entries.foldl (fun total entry => + total.add + (declarationChanges declarations summaries entry.1 entry.2)) {} + +/-- Observable result of simplifying every function body and the main, then +rebuilding the complete content-addressed declaration graph. -/ +structure ProgramOutcome where + result : ReaddressAll.Result + removedAlternatives : Nat + collapsedCases : Nat + materializedFetches : Nat + +/-- Readdress a complete already-addressed program after recursive HPT case +simplification. This low-level operation consumes supplied summaries; checked +pipeline entry points first validate those summaries against `program`. -/ +def rebuildProgram (reserved : List Ix.Compiler.Ixon.Address) + (program : List ReaddressAll.Artifact) (summaries : SummaryEnv) + (main : Code) : Except String ProgramOutcome := do + let declarations := programDeclEnv program + let entries := declarationEntries program + let rewritten := rewriteEntries declarations summaries entries + let rewrittenMain := runRecursive declarations summaries main + let declarationChanges := declarationsChanges declarations summaries entries + let result ← ReaddressAll.rebuild reserved rewritten rewrittenMain.code + return ⟨result, rewrittenMain.removedAlternatives + + declarationChanges.removedAlternatives, + rewrittenMain.collapsedCases + + declarationChanges.collapsedCases, + rewrittenMain.materializedFetches + + declarationChanges.materializedFetches⟩ + +theorem rebuild_of_rebuildProgram_eq_ok + {reserved : List Ix.Compiler.Ixon.Address} + {program : List ReaddressAll.Artifact} {summaries : SummaryEnv} + {main : Code} {outcome : ProgramOutcome} + (hrun : rebuildProgram reserved program summaries main = .ok outcome) : + ReaddressAll.rebuild reserved + (rewriteEntries (programDeclEnv program) summaries + (declarationEntries program)) + (runRecursive (programDeclEnv program) summaries main).code = + .ok outcome.result := by + unfold rebuildProgram at hrun + simp only [bind, Except.bind] at hrun + cases hrebuild : ReaddressAll.rebuild reserved + (rewriteEntries (programDeclEnv program) summaries + (declarationEntries program)) + (runRecursive (programDeclEnv program) summaries main).code with + | error message => + rw [hrebuild] at hrun + contradiction + | ok result => + rw [hrebuild] at hrun + have houtcome : + (⟨result, + (runRecursive (programDeclEnv program) summaries main).removedAlternatives + + (declarationsChanges (programDeclEnv program) summaries + (declarationEntries program)).removedAlternatives, + (runRecursive (programDeclEnv program) summaries main).collapsedCases + + (declarationsChanges (programDeclEnv program) summaries + (declarationEntries program)).collapsedCases, + (runRecursive (programDeclEnv program) summaries main).materializedFetches + + (declarationsChanges (programDeclEnv program) summaries + (declarationEntries program)).materializedFetches⟩ : + ProgramOutcome) = + outcome := by + injection hrun + have hresult : result = outcome.result := + congrArg ProgramOutcome.result houtcome + exact congrArg Except.ok hresult + +/-- The HPT program environment is the transparent first-binding-wins lookup +of the same declaration rows passed to the rebuild. -/ +theorem envOfList_declarationEntries + (program : List ReaddressAll.Artifact) : + Env.ofList (declarationEntries program) = programDeclEnv program := by + exact (AddressEnv.lookup_build (declarationEntries program)).symm + +/-- Old-keyed context paired with the oracle pullback of an exact rebuild. +Its declaration environment is the unmodified program environment. -/ +def rebuildOriginalCtx (result : ReaddressAll.Result) + (rewritten : List (Ix.Compiler.Ixon.Address × Decl)) + (declarations : DeclEnv) + (oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal) : Ctx := + { decls := declarations + oracle := (result.rebuildSourceCtx rewritten oracle).oracle } + +/-- Rebuilding the logically rewritten graph transports the complete +evaluator result from the exact old-keyed program context. -/ +theorem runMain_rebuild_rewriteProgram + {reserved : List Ix.Compiler.Ixon.Address} + {entries : List (Ix.Compiler.Ixon.Address × Decl)} + {declarations : DeclEnv} {summaries : SummaryEnv} {main : Code} + {result : ReaddressAll.Result} + (hentries : Env.ofList entries = declarations) + (hpost : LocalPostFixpoint declarations summaries) + (hrebuild : ReaddressAll.rebuild reserved + (rewriteEntries declarations summaries entries) + (runRecursive declarations summaries main).code = .ok result) + (oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal := + fun _ _ => none) + (fuel : Nat := 100000) : + runMain (result.addressedCtx oracle) result.main fuel = + Readdress.mapRunResult + (result.rebuildRename + (rewriteEntries declarations summaries entries)) + (runMain + (rebuildOriginalCtx result + (rewriteEntries declarations summaries entries) + declarations oracle) + main fuel) := by + let rewritten := rewriteEntries declarations summaries entries + let before := rebuildOriginalCtx result rewritten declarations oracle + have hbefore : before.decls = declarations := rfl + have hctx : rewriteCtx declarations summaries before = + result.rebuildSourceCtx rewritten oracle := by + simp [rewriteCtx, before, rewritten, rebuildOriginalCtx, + ReaddressAll.Result.rebuildSourceCtx, + envOfList_rewriteEntries, hentries] + funext address + rfl + rw [ReaddressAll.runMain_exact_of_rebuild_eq_ok hrebuild oracle fuel] + apply congrArg (Readdress.mapRunResult + (result.rebuildRename rewritten)) + rw [← hctx] + exact runMain_rewriteProgram_eq hpost hbefore + +/-- Successful HPT checking plus successful graph rebuilding authorizes the +exact whole-program evaluator transport theorem. -/ +theorem runMain_rebuildProgram_of_runWith_eq_ok + {limits : Limits} {reserved : List Ix.Compiler.Ixon.Address} + {program : List ReaddressAll.Artifact} {certificate : Certificate} + {analysis : HPT.Result} {main : Code} {outcome : ProgramOutcome} + (hcheck : HPT.runWith limits program certificate = .ok analysis) + (hrebuild : rebuildProgram reserved program certificate.summaryEnv main = + .ok outcome) + (oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal := + fun _ _ => none) + (fuel : Nat := 100000) : + runMain (outcome.result.addressedCtx oracle) outcome.result.main fuel = + Readdress.mapRunResult + (outcome.result.rebuildRename + (rewriteEntries (programDeclEnv program) certificate.summaryEnv + (declarationEntries program))) + (runMain + (rebuildOriginalCtx outcome.result + (rewriteEntries (programDeclEnv program) certificate.summaryEnv + (declarationEntries program)) + (programDeclEnv program) oracle) + main fuel) := by + apply runMain_rebuild_rewriteProgram + · exact envOfList_declarationEntries program + · exact localPostFixpoint_of_postFixpoint + (postFixpoint_of_runWith_eq_ok hcheck) + · exact rebuild_of_rebuildProgram_eq_ok hrebuild + +/-- With the closed default oracle, the source side is exactly the ordinary +old addressed program context. -/ +theorem runMain_rebuildProgram_of_runWith_eq_ok_defaultOracle + {limits : Limits} {reserved : List Ix.Compiler.Ixon.Address} + {program : List ReaddressAll.Artifact} {certificate : Certificate} + {analysis : HPT.Result} {main : Code} {outcome : ProgramOutcome} + (hcheck : HPT.runWith limits program certificate = .ok analysis) + (hrebuild : rebuildProgram reserved program certificate.summaryEnv main = + .ok outcome) + (fuel : Nat := 100000) : + runMain (outcome.result.addressedCtx (fun _ _ => none)) + outcome.result.main fuel = + Readdress.mapRunResult + (outcome.result.rebuildRename + (rewriteEntries (programDeclEnv program) certificate.summaryEnv + (declarationEntries program))) + (runMain { decls := programDeclEnv program } main fuel) := by + simpa [rebuildOriginalCtx, ReaddressAll.Result.rebuildSourceCtx] using + (runMain_rebuildProgram_of_runWith_eq_ok hcheck hrebuild + (fun _ _ => none) fuel) + +/-- Checked whole-program specialization. The result is the exact logical +semantics of the old-keyed declaration list and pruned main, immediately +before content-address rebuilding. -/ +theorem runMain_rewriteProgram_eq_of_postFixpoint + {program : List ReaddressAll.Artifact} {certificate : Certificate} + (hcertificate : certificate.postFixpoint program = true) + {ctx : Ctx} {input : Code} {fuel : Nat} + (hctx : ctx.decls = programDeclEnv program) : + runMain + (rewriteCtx (programDeclEnv program) certificate.summaryEnv ctx) + (runRecursive (programDeclEnv program) certificate.summaryEnv + input).code fuel = + runMain ctx input fuel := by + exact runMain_rewriteProgram_eq + (localPostFixpoint_of_postFixpoint hcertificate) hctx + +/-- Successful configurable checking authorizes simultaneous rewriting of +the complete logical declaration environment and main/current frame. -/ +theorem runMain_rewriteProgram_eq_of_runWith_eq_ok + {limits : Limits} {program : List ReaddressAll.Artifact} + {certificate : Certificate} {result : Result} + (hcheck : HPT.runWith limits program certificate = .ok result) + {ctx : Ctx} {input : Code} {fuel : Nat} + (hctx : ctx.decls = programDeclEnv program) : + runMain + (rewriteCtx (programDeclEnv program) certificate.summaryEnv ctx) + (runRecursive (programDeclEnv program) certificate.summaryEnv + input).code fuel = + runMain ctx input fuel := by + exact runMain_rewriteProgram_eq_of_postFixpoint + (postFixpoint_of_runWith_eq_ok hcheck) hctx + +end Ix.Compiler.IxIR1.HPT.CasePrune diff --git a/Ix/Compiler/IxIR1/HPTDestroy.lean b/Ix/Compiler/IxIR1/HPTDestroy.lean new file mode 100644 index 000000000..15a22bb63 --- /dev/null +++ b/Ix/Compiler/IxIR1/HPTDestroy.lean @@ -0,0 +1,903 @@ +import Ix.Compiler.IxIR1.HPTFetchForward + +/-! +# Checked shape-specialized destruction + +This consumer specializes destruction only where the current HPT domain gives +enough ownership-neutral evidence: + +* a proven scalar `drop` or `dropU` becomes `pure erased`; +* a `dropU` of one exact constructor whose complete field vector is scalar + becomes a shallow `free`. + +The second rewrite is the first useful known-shape destructor. It preserves +the root free while removing the generic node dispatch and recursive field +walk. Heap-valued, widened, identity-only, multi-shape, and shared-root facts +remain on the generic path. The fuel-boundary guard below records why deeper +destruction needs a fuel-neutral primitive rather than an expansion in the +current `Code` language. +-/ + +namespace Ix.Compiler.IxIR1.HPT.Destroy + +open Ix.Compiler.IxIR1.Sim + +/-- A recursive field fact which can describe only scalar run-time values. +Bottom is admitted: it cannot justify a concrete successful path. -/ +def fieldScalarOnly (fact : FieldFact) : Bool := + !fact.unknownHeap && fact.shapes.isEmpty + +/-- The exact constructor payload retained by an accepted leaf decision. -/ +structure LeafShape where + identity : CtorId + fields : List FieldFact + deriving BEq, Repr + +/-- Recognize one exact, non-scalar constructor shape with a complete +scalar-only field vector. -/ +def exactLeaf? (fact : Fact) : Option LeafShape := + if fact.mayScalar || fact.unknownHeap then + none + else + match fact.shapes with + | [.ctor identity (some fields)] => + if fields.all fieldScalarOnly then some ⟨identity, fields⟩ else none + | _ => none + +inductive Kind where + | sharedScalar + | uniqueScalar + | uniqueLeaf + deriving BEq, Repr + +/-- One accepted replacement operation. Every replacement keeps the single +let binder and returns `erased`, exactly like the source destructor. -/ +structure Specialization where + operation : Op + kind : Kind + +def specialize? (facts : List Fact) : Op → Option Specialization + | .drop target => + match resolveAtomFact facts target with + | .error _ => none + | .ok fact => + if FetchForward.scalarOnly fact then + some ⟨.pure .erased, .sharedScalar⟩ + else + none + | .dropU target => + match resolveAtomFact facts target with + | .error _ => none + | .ok fact => + if FetchForward.scalarOnly fact then + some ⟨.pure .erased, .uniqueScalar⟩ + else if (exactLeaf? fact).isSome then + some ⟨.free target, .uniqueLeaf⟩ + else + none + | _ => none + +/-! The executable boundary is deliberately pinned independently of the +recursive traversal. Exact scalar leaves are admitted; any evidence that +could hide a heap child, another root shape, or an unresolved variable stays +on the generic destructor. -/ + +private def guardIdentity : CtorId := + { block := Ixon.Address.replicate 0xd1, indIdx := 0, cidx := 0 } + +private def guardChildIdentity : CtorId := + { block := Ixon.Address.replicate 0xd2, indIdx := 0, cidx := 1 } + +private def guardLeafFact : Fact := + .heap (.ctor guardIdentity (some [FieldFact.scalar])) + +private def guardHeapFieldFact : Fact := + .heap (.ctor guardIdentity + (some [.heap (.ctor guardChildIdentity (some []))])) + +private def guardIdentityOnlyFact : Fact := + .heap (.ctor guardIdentity none) + +private def guardMultiShapeFact : Fact := + { mayScalar := false + unknownHeap := false + shapes := + [.ctor guardIdentity (some [FieldFact.scalar]), + .ctor guardChildIdentity (some [])] } + +private def isPureErased (kind : Kind) : Option Specialization → Bool + | some ⟨.pure .erased, actualKind⟩ => actualKind == kind + | none => false + | _ => false + +private def isFreeVar (index : Nat) (kind : Kind) : + Option Specialization → Bool + | some ⟨.free (.var actualIndex), actualKind⟩ => + actualIndex == index && actualKind == kind + | none => false + | _ => false + +private def decisionBoundary : Bool := + isPureErased .sharedScalar + (specialize? [Fact.scalar] (.drop (.var 0))) && + isPureErased .uniqueScalar + (specialize? [Fact.scalar] (.dropU (.var 0))) && + isFreeVar 0 .uniqueLeaf + (specialize? [guardLeafFact] (.dropU (.var 0))) && + (specialize? [guardLeafFact] (.drop (.var 0))).isNone && + (specialize? [guardHeapFieldFact] (.dropU (.var 0))).isNone && + (specialize? [guardIdentityOnlyFact] (.dropU (.var 0))).isNone && + (specialize? [guardMultiShapeFact] (.dropU (.var 0))).isNone && + (specialize? [Fact.top] (.dropU (.var 0))).isNone && + (specialize? [] (.dropU (.var 0))).isNone && + (specialize? [guardLeafFact] (.free (.var 0))).isNone + +#guard decisionBoundary + +/-! ## Why recursive expansion is not an IxIR₁ `Code` rewrite + +The evaluator exposes `Code` nesting through fuel. Expanding one `dropU` +inline consumes extra continuation fuel; putting the same expansion behind a +call preserves continuation fuel but adds call/invoke fuel at the destructor's +minimum successful boundary. The two executable witnesses below pin both +failures on the smallest recursive unique tree (a unary root over a nullary +child). This is an IR constraint, independent of HPT precision or +owner-sensitive declaration rewriting. +-/ + +private def fuelChildIdentity : CtorId := + { block := Ixon.Address.replicate 0xd3, indIdx := 0, cidx := 0 } + +private def fuelRootIdentity : CtorId := + { block := Ixon.Address.replicate 0xd4, indIdx := 0, cidx := 0 } + +private def fuelHelperAddress : Ixon.Address := + Ixon.Address.replicate 0xd5 + +/-- Fetch the unary child, shallow-free the root, then shallow-free the +nullary child. Semantically this is the obvious exact recursive destructor. -/ +private def fuelHelperBody : Code := + .letOp (.fetch (.var 0) 0) + (.letOp (.free (.var 1)) + (.letOp (.free (.var 1)) + (.ret .erased))) + +private def fuelHelper : FnDef := + { arity := 1, result := .shared, papSafe := false, body := fuelHelperBody } + +private def fuelCtx : Ctx := + { decls := Env.ofList [(fuelHelperAddress, .fn fuelHelper)] } + +private def fuelInput : Store × RVal := + let (withChild, child) := ({} : Store).allocNode .unique + (.ctorN fuelChildIdentity #[]) + let (withRoot, root) := withChild.allocNode .unique + (.ctorN fuelRootIdentity #[.loc child]) + (withRoot, .loc root) + +private def pureContinuation : Nat → Code + | 0 => .ret .erased + | fuel + 1 => .letOp (.pure .erased) (pureContinuation fuel) + +private def genericRecursiveDrop (rest : Code) : Code := + .letOp (.dropU (.var 0)) rest + +private def inlineRecursiveDrop (rest : Code) : Code := + .letOp (.fetch (.var 0) 0) + (.letOp (.free (.var 1)) + (.letOp (.free (.var 1)) rest)) + +private def helperRecursiveDrop (rest : Code) : Code := + .letOp (.call fuelHelperAddress #[.var 0]) rest + +private def fuelCurrent : FnDef := + { arity := 1, result := .shared, papSafe := false, body := .ret .erased } + +private def recursiveExpansionFuelBoundary : Bool := + let (store, root) := fuelInput + let short := .ret .erased + let long := pureContinuation 5 + match + runCode fuelCtx 6 fuelCurrent store [root] + (genericRecursiveDrop short), + runCode fuelCtx 6 fuelCurrent store [root] + (helperRecursiveDrop short), + runCode fuelCtx 7 fuelCurrent store [root] + (genericRecursiveDrop long), + runCode fuelCtx 7 fuelCurrent store [root] + (inlineRecursiveDrop long) with + | .ok (shortStore, .erased), .error .fuel, + .ok (longStore, .erased), .error .fuel => + shortStore.live == 0 && longStore.live == 0 + | _, _, _, _ => false + +#guard recursiveExpansionFuelBoundary + +/-- Proof-facing view of an accepted executable decision. -/ +inductive Spec (facts : List Fact) : Op → Specialization → Prop where + | sharedScalar {target fact} + (hfact : resolveAtomFact facts target = .ok fact) + (hscalar : FetchForward.scalarOnly fact = true) : + Spec facts (.drop target) ⟨.pure .erased, .sharedScalar⟩ + | uniqueScalar {target fact} + (hfact : resolveAtomFact facts target = .ok fact) + (hscalar : FetchForward.scalarOnly fact = true) : + Spec facts (.dropU target) ⟨.pure .erased, .uniqueScalar⟩ + | uniqueLeaf {target fact leaf} + (hfact : resolveAtomFact facts target = .ok fact) + (hleaf : exactLeaf? fact = some leaf) : + Spec facts (.dropU target) ⟨.free target, .uniqueLeaf⟩ + +theorem spec_of_specialize?_eq_some + {facts : List Fact} {operation : Op} {specialization : Specialization} + (hspecialize : specialize? facts operation = some specialization) : + Spec facts operation specialization := by + cases operation with + | pure atom => simp [specialize?] at hspecialize + | alloc world identity fields => simp [specialize?] at hspecialize + | reuse location identity fields => simp [specialize?] at hspecialize + | free target => simp [specialize?] at hspecialize + | dup target => simp [specialize?] at hspecialize + | drop target => + simp only [specialize?] at hspecialize + cases hfact : resolveAtomFact facts target with + | error error => simp [hfact] at hspecialize + | ok fact => + rw [hfact] at hspecialize + by_cases hscalar : FetchForward.scalarOnly fact = true + · simp only [hscalar, if_true, Option.some.injEq] at hspecialize + rw [← hspecialize] + exact .sharedScalar hfact hscalar + · simp [hscalar] at hspecialize + | dropU target => + simp only [specialize?] at hspecialize + cases hfact : resolveAtomFact facts target with + | error error => simp [hfact] at hspecialize + | ok fact => + rw [hfact] at hspecialize + by_cases hscalar : FetchForward.scalarOnly fact = true + · simp only [hscalar, if_true, Option.some.injEq] at hspecialize + rw [← hspecialize] + exact .uniqueScalar hfact hscalar + · simp only [hscalar] at hspecialize + by_cases hleafSome : (exactLeaf? fact).isSome = true + · simp only [hleafSome, if_true] at hspecialize + cases hleaf : exactLeaf? fact with + | none => simp [hleaf] at hleafSome + | some leaf => + simp at hspecialize + rw [← hspecialize] + exact .uniqueLeaf hfact hleaf + · simp [hleafSome] at hspecialize + | fetch target field => simp [specialize?] at hspecialize + | call function arguments => simp [specialize?] at hspecialize + | callSelf arguments => simp [specialize?] at hspecialize + | papp function arguments => simp [specialize?] at hspecialize + | apply function arguments => simp [specialize?] at hspecialize + | extern name arguments => simp [specialize?] at hspecialize + +structure Changes where + elidedScalarDrops : Nat := 0 + specializedUniqueDrops : Nat := 0 + deriving BEq, Repr, Inhabited + +def Changes.add (left right : Changes) : Changes := + { elidedScalarDrops := + left.elidedScalarDrops + right.elidedScalarDrops + specializedUniqueDrops := + left.specializedUniqueDrops + right.specializedUniqueDrops } + +def Changes.ofKind : Kind → Changes + | .sharedScalar | .uniqueScalar => { elidedScalarDrops := 1 } + | .uniqueLeaf => { specializedUniqueDrops := 1 } + +structure Outcome where + code : Code + changes : Changes := {} + +structure AlternativeOutcome where + alternative : Alt + changes : Changes := {} + +mutual + +/-- Mirror HPT transfer through the whole owner-sensitive code tree, replacing +only one-binder destructor operations. -/ +def runWithFacts (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Ixon.Address) (current : FnDef) (facts : List Fact) : + Code → Outcome + | input@(.ret _) => ⟨input, {}⟩ + | input@(.letOp operation rest) => + match analyzeOp declarations summaries owner current facts operation with + | .error _ => ⟨input, {}⟩ + | .ok bound => + let nested := runWithFacts declarations summaries owner current + (bound :: facts.map Fact.forgetHeap) rest + match specialize? facts operation with + | none => ⟨.letOp operation nested.code, nested.changes⟩ + | some specialization => + ⟨.letOp specialization.operation nested.code, + nested.changes.add (.ofKind specialization.kind)⟩ + | input@(.case scrutinee peelNat alternatives) => + match resolveAtomFact facts scrutinee with + | .error _ => ⟨input, {}⟩ + | .ok fact => + let nested := alternatives.map + (runAlternativeWithFacts declarations summaries owner current + fact peelNat facts) + ⟨.case scrutinee peelNat + (nested.map fun result => result.alternative), + nested.foldl + (fun total result => total.add result.changes) {}⟩ + +def runAlternativeWithFacts (declarations : DeclEnv) + (summaries : SummaryEnv) (owner : Ixon.Address) (current : FnDef) + (scrutineeFact : Fact) (peelNat : Bool) (facts : List Fact) : + Alt → AlternativeOutcome + | .mk cidx fields body => + let nested := runWithFacts declarations summaries owner current + (scrutineeFact.caseFields peelNat cidx fields ++ facts) body + ⟨.mk cidx fields nested.code, nested.changes⟩ + +end + +def runFunction (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Ixon.Address) (current : FnDef) : Outcome := + runWithFacts declarations summaries owner current + (List.replicate current.arity Fact.top) current.body + +def rewriteFunction (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Ixon.Address) (current : FnDef) : FnDef := + { current with body := (runFunction declarations summaries owner current).code } + +/-! ## Semantic support for accepted decisions -/ + +theorem isScalar_of_fieldScalarOnly_holds + {declarations : DeclEnv} {store : Store} {fact : FieldFact} + {value : RVal} + (honly : fieldScalarOnly fact = true) + (hholds : fact.Holds declarations store value) : + value.isScalar = true := by + unfold fieldScalarOnly at honly + simp only [Bool.and_eq_true] at honly + cases hholds with + | lit hscalar => rfl + | erased hscalar => rfl + | unknown hunknown => + have hfalse : fact.unknownHeap = false := by simpa using honly.1 + rw [hfalse] at hunknown + contradiction + | heap hmember hshape => + have hempty : fact.shapes = [] := List.isEmpty_iff.mp honly.2 + rw [hempty] at hmember + contradiction + +theorem FieldFactsHold.all_isScalar + {declarations : DeclEnv} {store : Store} {facts : List FieldFact} + {values : List RVal} + (honly : facts.all fieldScalarOnly = true) + (hholds : FieldFactsHold declarations store facts values) : + values.all RVal.isScalar = true := by + cases hholds with + | nil => rfl + | @cons fact value facts values hhead htail => + simp only [List.all_cons, Bool.and_eq_true] at honly ⊢ + exact ⟨isScalar_of_fieldScalarOnly_holds honly.1 hhead, + FieldFactsHold.all_isScalar honly.2 htail⟩ +termination_by sizeOf facts +decreasing_by all_goals subst_vars <;> simp_wf <;> omega + +/-- An accepted exact-leaf decision determines the concrete constructor and +proves that every stored field is a scalar. -/ +theorem exactLeaf?_holds + {declarations : DeclEnv} {store : Store} {fact : Fact} + {value : RVal} {leaf : LeafShape} + (hleaf : exactLeaf? fact = some leaf) + (hholds : fact.Holds declarations store value) : + ∃ location box fields, + value = .loc location ∧ + store.get? location = some box ∧ + box.node = .ctorN leaf.identity fields ∧ + fields.toList.all RVal.isScalar = true := by + cases fact with + | mk mayScalar unknownHeap shapes => + unfold exactLeaf? at hleaf + cases hmay : mayScalar with + | true => simp [hmay] at hleaf + | false => + cases hunknown : unknownHeap with + | true => simp [hmay, hunknown] at hleaf + | false => + simp only [hmay, hunknown, Bool.false_or] at hleaf + cases shapes with + | nil => simp at hleaf + | cons shape tail => + cases tail with + | cons next tail => simp at hleaf + | nil => + cases shape with + | pap function supplied => simp at hleaf + | ctor identity fieldFacts => + cases fieldFacts with + | none => simp at hleaf + | some facts => + by_cases honly : + facts.all fieldScalarOnly = true + · simp only [honly, if_true] at hleaf + simp at hleaf + rw [← hleaf] + cases value with + | lit literal => + change mayScalar = true at hholds + rw [hmay] at hholds + contradiction + | erased => + change mayScalar = true at hholds + rw [hmay] at hholds + contradiction + | loc location => + simp only [Fact.Holds, hunknown, + Bool.false_eq_true, false_or] at hholds + rcases hholds with + ⟨heldShape, hmember, hshape⟩ + have hshapeEq : heldShape = + .ctor identity (some facts) := by + simpa using hmember + subst heldShape + rcases hshape with + ⟨box, fields, hget, hnode, hfields⟩ + exact ⟨location, box, fields, rfl, hget, + hnode, + FieldFactsHold.all_isScalar honly + hfields⟩ + · simp [honly] at hleaf + +private theorem dropUVal_eq_store_of_isScalar_success + {ctx : Ctx} {fuel : Nat} {store result : Store} {value : RVal} + (hscalar : value.isScalar = true) + (hrun : dropUVal ctx fuel store value = .ok result) : + result = store := by + cases fuel with + | zero => simp [dropUVal] at hrun + | succ fuel => + cases value with + | lit literal => + simp only [dropUVal] at hrun + exact (Except.ok.inj hrun).symm + | erased => + simp only [dropUVal] at hrun + exact (Except.ok.inj hrun).symm + | loc location => simp [RVal.isScalar] at hscalar + +private theorem dropManyU_eq_store_of_all_isScalar_success + {ctx : Ctx} {fuel : Nat} {store result : Store} {values : List RVal} + (hscalar : values.all RVal.isScalar = true) + (hrun : dropManyU ctx fuel store values = .ok result) : + result = store := by + induction fuel generalizing store result values with + | zero => simp [dropManyU] at hrun + | succ fuel ih => + cases values with + | nil => + simp only [dropManyU] at hrun + exact (Except.ok.inj hrun).symm + | cons value values => + simp only [List.all_cons, Bool.and_eq_true] at hscalar + rw [dropManyU.eq_def] at hrun + dsimp only at hrun + cases hfirst : dropUVal ctx fuel store value with + | error error => simp [hfirst, bind, Except.bind] at hrun + | ok middle => + simp only [hfirst, bind, Except.bind] at hrun + have hmiddle := + dropUVal_eq_store_of_isScalar_success hscalar.1 hfirst + subst middle + exact ih hscalar.2 hrun + +private theorem dropUVal_eq_kill_of_ctor_all_isScalar_success + {ctx : Ctx} {fuel : Nat} {store result : Store} {value : RVal} + {location : Nat} {box : NodeBox} {identity : CtorId} + {fields : Array RVal} + (hvalue : value = .loc location) + (hget : store.get? location = some box) + (hnode : box.node = .ctorN identity fields) + (hscalar : fields.toList.all RVal.isScalar = true) + (hrun : dropUVal ctx fuel store value = .ok result) : + box.world = .unique ∧ result = store.kill location := by + subst value + cases fuel with + | zero => simp [dropUVal] at hrun + | succ fuel => + rw [dropUVal.eq_def] at hrun + dsimp only at hrun + rw [hget] at hrun + cases hworld : box.world with + | shared => simp [hworld] at hrun + | unique => + refine ⟨rfl, ?_⟩ + simp only at hrun + rw [hworld, hnode] at hrun + exact dropManyU_eq_store_of_all_isScalar_success hscalar hrun + +/-- Every accepted local specialization preserves a successful operation +result exactly. The implication is intentionally one-way: a shallow free +can need less fuel than the generic deep-drop interpreter. -/ +theorem runOp_specialize?_success + {declarations : DeclEnv} {facts : List Fact} {operation : Op} + {specialization : Specialization} {ctx : Ctx} {fuel : Nat} + {current : FnDef} {store : Store} {environment : List RVal} + {output : Store × RVal} + (henvironment : EnvironmentHolds declarations store facts environment) + (hspecialize : specialize? facts operation = some specialization) + (hrun : runOp ctx fuel current store environment operation = .ok output) : + runOp ctx fuel current store environment specialization.operation = + .ok output := by + have hspec := spec_of_specialize?_eq_some hspecialize + cases hspec with + | @sharedScalar target fact hfact hscalar => + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + rw [runOp.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hresolve : resolveAtom environment target with + | error error => simp [hresolve, bind, Except.bind] at hrun + | ok value => + have hholds := resolveAtom_sound henvironment hfact hresolve + have hvalue := + FetchForward.scalar_of_scalarOnly_holds hscalar hholds + rw [hresolve] at hrun + simp only [bind, Except.bind] at hrun + cases value with + | lit literal => + dsimp only at hrun + change Except.ok (store, .erased) = .ok output + exact hrun + | erased => + dsimp only at hrun + change Except.ok (store, .erased) = .ok output + exact hrun + | loc location => simp [RVal.isScalar] at hvalue + | @uniqueScalar target fact hfact hscalar => + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + rw [runOp.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hresolve : resolveAtom environment target with + | error error => simp [hresolve, bind, Except.bind] at hrun + | ok value => + have hholds := resolveAtom_sound henvironment hfact hresolve + have hvalue := + FetchForward.scalar_of_scalarOnly_holds hscalar hholds + rw [hresolve] at hrun + simp only [bind, Except.bind] at hrun + cases value with + | lit literal => + dsimp only at hrun + change Except.ok (store, .erased) = .ok output + exact hrun + | erased => + dsimp only at hrun + change Except.ok (store, .erased) = .ok output + exact hrun + | loc location => simp [RVal.isScalar] at hvalue + | @uniqueLeaf target fact leaf hfact hleaf => + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + rw [runOp.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hresolve : resolveAtom environment target with + | error error => simp [hresolve, bind, Except.bind] at hrun + | ok value => + have hholds := resolveAtom_sound henvironment hfact hresolve + obtain ⟨location, box, fields, hvalue, hget, hnode, hscalar⟩ := + exactLeaf?_holds hleaf hholds + subst value + simp only [hresolve] at hrun ⊢ + simp only [bind, Except.bind] at hrun ⊢ + cases hdrop : dropUVal ctx fuel store (.loc location) with + | error error => simp [hdrop] at hrun + | ok dropped => + rw [hdrop] at hrun + obtain ⟨hworld, hkilled⟩ := + dropUVal_eq_kill_of_ctor_all_isScalar_success rfl hget + hnode hscalar hdrop + subst dropped + rw [hget] + simp only + rw [hworld] + simpa using hrun + +/-! ## Successful recursive traversal -/ + +@[simp] private theorem runAlternativeWithFacts_cidx + (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Ixon.Address) (current : FnDef) + (scrutineeFact : Fact) (peelNat : Bool) (facts : List Fact) + (alternative : Alt) : + (runAlternativeWithFacts declarations summaries owner current + scrutineeFact peelNat facts alternative).alternative.cidx = + alternative.cidx := by + cases alternative + simp [runAlternativeWithFacts, Alt.cidx] + +private theorem runAlternativeWithFacts_predicate + (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Ixon.Address) (current : FnDef) + (scrutineeFact : Fact) (peelNat : Bool) (facts : List Fact) + (index : Nat) : + ((fun alternative : Alt => alternative.cidx == index) ∘ + (fun result : AlternativeOutcome => result.alternative) ∘ + runAlternativeWithFacts declarations summaries owner current + scrutineeFact peelNat facts) = + (fun alternative => alternative.cidx == index) := by + funext alternative + cases alternative + simp [Function.comp_def, runAlternativeWithFacts, Alt.cidx] + +private theorem find?_runAlternativeWithFacts + (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Ixon.Address) (current : FnDef) + (scrutineeFact : Fact) (peelNat : Bool) (facts : List Fact) + (alternatives : Array Alt) (index : Nat) : + ((alternatives.map + (runAlternativeWithFacts declarations summaries owner current + scrutineeFact peelNat facts)).map + (fun result => result.alternative)).find? + (fun alternative => alternative.cidx == index) = + (alternatives.find? (fun alternative => alternative.cidx == index)).map + (fun alternative => + (runAlternativeWithFacts declarations summaries owner current + scrutineeFact peelNat facts alternative).alternative) := by + rw [Array.map_map, Array.find?_map, + runAlternativeWithFacts_predicate declarations summaries owner current + scrutineeFact peelNat facts index] + simp [Function.comp_def] + +private theorem Array.foldl_cons_eq_reverse_append + (fields : Array RVal) (environment : List RVal) : + fields.foldl (fun current field => field :: current) environment = + fields.toList.reverse ++ environment := by + rw [← Array.foldl_toList] + induction fields.toList generalizing environment with + | nil => rfl + | cons field fields ih => + simp only [List.foldl_cons] + rw [ih] + simp [List.reverse_cons, List.append_assoc] + +/-- Case traversal preserves a successful selected branch once its HPT +binders have been justified against the concrete scrutinee. -/ +private theorem runCode_caseWithFactsBodies_success + {declarations : DeclEnv} {summaries : SummaryEnv} + {owner : Ixon.Address} {current : FnDef} + {ctx : Ctx} {store : Store} {facts : List Fact} + {environment : List RVal} {scrutinee : Atom} {peelNat : Bool} + {alternatives : Array Alt} {scrutineeFact : Fact} {fuel : Nat} + {output : Store × RVal} + (henvironment : EnvironmentHolds declarations store facts environment) + (habstract : resolveAtomFact facts scrutinee = .ok scrutineeFact) + (ih : ∀ {store : Store} {facts : List Fact} + {environment : List RVal} {input : Code} {output : Store × RVal}, + EnvironmentHolds declarations store facts environment → + runCode ctx fuel current store environment input = .ok output → + runCode ctx fuel current store environment + (runWithFacts declarations summaries owner current facts input).code = + .ok output) + (hrun : runCode ctx (fuel + 1) current store environment + (.case scrutinee peelNat alternatives) = .ok output) : + runCode ctx (fuel + 1) current store environment + (.case scrutinee peelNat + ((alternatives.map + (runAlternativeWithFacts declarations summaries owner current + scrutineeFact peelNat facts)).map + (fun result => result.alternative))) = + .ok output := by + obtain ⟨scrutineeValue, hresolve⟩ := + resolveAtom_complete henvironment habstract + have hscrutineeHolds := + resolveAtom_sound henvironment habstract hresolve + simp only [runCode] at hrun ⊢ + rw [hresolve] at hrun ⊢ + simp only [bind, Except.bind] at hrun ⊢ + cases scrutineeValue with + | erased => contradiction + | lit literal => + cases literal with + | str value => contradiction + | nat value => + simp only at hrun ⊢ + cases peelNat with + | false => contradiction + | true => + simp only at hrun ⊢ + cases value with + | zero => + simp only at hrun ⊢ + rw [find?_runAlternativeWithFacts] + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == 0) with + | none => simp [hfind] at hrun + | some alternative => + cases alternative with + | mk cidx fields body => + cases fields with + | zero => + have hzero : + scrutineeFact.caseFields true cidx 0 = [] := by + unfold Fact.caseFields + split <;> rfl + have hbody : + runCode ctx fuel current store environment + body = .ok output := by + simpa [hfind] using hrun + simpa [runAlternativeWithFacts, hzero] + using (ih henvironment hbody) + | succ fields => simp [hfind] at hrun + | succ value => + simp only at hrun ⊢ + rw [find?_runAlternativeWithFacts] + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == 1) with + | none => simp [hfind] at hrun + | some alternative => + cases alternative with + | mk cidx fields body => + cases fields with + | zero => simp [hfind] at hrun + | succ fields => + cases fields with + | zero => + have hcidx : cidx = 1 := by + have hmatch := Array.find?_some + (p := fun alternative : Alt => + alternative.cidx == 1) + (a := .mk cidx 1 body) + (xs := alternatives) hfind + exact beq_iff_eq.mp hmatch + have hbinders : + EnvironmentHolds declarations store + (scrutineeFact.caseFields true cidx 1) + [.lit (.nat value)] := by + simpa [hcidx] using + (Fact.caseFields_natSucc_holds + hscrutineeHolds) + have hbody : + runCode ctx fuel current store + (.lit (.nat value) :: environment) + body = .ok output := by + simpa [hfind] using hrun + simpa [runAlternativeWithFacts] using + (ih (hbinders.append henvironment) hbody) + | succ fields => simp [hfind] at hrun + | loc location => + simp only at hrun ⊢ + cases hget : store.get? location with + | none => simp [hget] at hrun + | some box => + simp only at hrun ⊢ + cases hnode : box.node with + | papN function arity arguments => simp [hget, hnode] at hrun + | ctorN identity fields => + simp only at hrun ⊢ + rw [find?_runAlternativeWithFacts] + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == identity.cidx) with + | none => simp [hget, hnode, hfind] at hrun + | some alternative => + cases alternative with + | mk cidx fieldCount body => + by_cases hfields : fields.size = fieldCount + · have hcidx : identity.cidx = cidx := by + have hmatch := Array.find?_some + (p := fun alternative : Alt => + alternative.cidx == identity.cidx) + (a := .mk cidx fieldCount body) + (xs := alternatives) hfind + exact (beq_iff_eq.mp hmatch).symm + have hbinders := Fact.caseFields_ctor_holds + peelNat cidx fieldCount hscrutineeHolds hget hnode + hcidx hfields + have hbody : + runCode ctx fuel current store + (fields.foldl + (fun current field => field :: current) + environment) body = .ok output := by + simpa [hget, hnode, hfind, hfields] using hrun + rw [Array.foldl_cons_eq_reverse_append] + simpa [hfields, runAlternativeWithFacts] using + (ih (hbinders.append henvironment) (by + rw [← Array.foldl_cons_eq_reverse_append] + exact hbody)) + · simp [hget, hnode, hfind, hfields] at hrun + +/-- Successful evaluator refinement for the complete owner-sensitive +destruction traversal. -/ +theorem runCode_runWithFacts_success_ownerCompatible + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {owner : Ixon.Address} {current : FnDef} + {store : Store} {facts : List Fact} {environment : List RVal} + {input : Code} {fuel : Nat} {output : Store × RVal} + (hctx : ctx.decls = declarations) + (howner : AnalysisOwnerCompatible declarations summaries owner current) + (henvironment : EnvironmentHolds declarations store facts environment) + (hrun : runCode ctx fuel current store environment input = .ok output) : + runCode ctx fuel current store environment + (runWithFacts declarations summaries owner current facts input).code = + .ok output := by + induction fuel generalizing store facts environment input output with + | zero => simp [runCode] at hrun + | succ fuel ih => + cases input with + | ret atom => simpa [runWithFacts] using hrun + | letOp operation rest => + cases habstract : analyzeOp declarations summaries owner current + facts operation with + | error error => + simpa [runWithFacts, habstract] using hrun + | ok bound => + let nested := runWithFacts declarations summaries owner current + (bound :: facts.map Fact.forgetHeap) rest + simp only [runCode] at hrun + cases hoperation : runOp ctx fuel current store environment + operation with + | error error => simp [hoperation, bind, Except.bind] at hrun + | ok operationOutput => + rcases operationOutput with ⟨outputStore, outputValue⟩ + rw [hoperation] at hrun + simp only [bind, Except.bind] at hrun + have hbound := analyzeOp_sound_ownerCompatible hpost hctx + howner henvironment habstract hoperation + have hold := EnvironmentHolds.forgetHeap + (after := outputStore) henvironment + have hnested : + runCode ctx fuel current outputStore + (outputValue :: environment) nested.code = + .ok output := by + simpa [nested] using + (ih (store := outputStore) + (facts := bound :: facts.map Fact.forgetHeap) + (environment := outputValue :: environment) + (input := rest) (.cons hbound hold) hrun) + cases hspecialize : specialize? facts operation with + | none => + simp only [runWithFacts, habstract, hspecialize, runCode] + rw [hoperation] + simp only [bind, Except.bind] + exact hnested + | some specialization => + have hspecialized := runOp_specialize?_success + henvironment hspecialize hoperation + simp only [runWithFacts, habstract, hspecialize, runCode] + rw [hspecialized] + simp only [bind, Except.bind] + exact hnested + | case scrutinee peelNat alternatives => + cases habstract : resolveAtomFact facts scrutinee with + | error error => simpa [runWithFacts, habstract] using hrun + | ok scrutineeFact => + simpa [runWithFacts, habstract] using + (runCode_caseWithFactsBodies_success henvironment habstract + (fun henv hsuccess => ih henv hsuccess) hrun) + +/-- Stored-function specialization of successful destruction refinement. -/ +theorem runCode_runWithFacts_success + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {owner : Ixon.Address} {current : FnDef} + {store : Store} {facts : List Fact} {environment : List RVal} + {input : Code} {fuel : Nat} {output : Store × RVal} + (hctx : ctx.decls = declarations) + (hcurrent : declarations owner = some (.fn current)) + (henvironment : EnvironmentHolds declarations store facts environment) + (hrun : runCode ctx fuel current store environment input = .ok output) : + runCode ctx fuel current store environment + (runWithFacts declarations summaries owner current facts input).code = + .ok output := + runCode_runWithFacts_success_ownerCompatible hpost hctx (.inl hcurrent) + henvironment hrun + +end Ix.Compiler.IxIR1.HPT.Destroy diff --git a/Ix/Compiler/IxIR1/HPTFetchForward.lean b/Ix/Compiler/IxIR1/HPTFetchForward.lean new file mode 100644 index 000000000..be9333e88 --- /dev/null +++ b/Ix/Compiler/IxIR1/HPTFetchForward.lean @@ -0,0 +1,816 @@ +import Ix.Compiler.IxIR1.HPTPAPFuse + +/-! +# Checked scalar fetch forwarding + +This consumer recognizes an immediately projected constructor field: + +```text +let node := alloc/reuse constructor fields +let field := fetch node i +rest +``` + +When the selected source atom is HPT-proven scalar, the projection is replaced +by `pure` of that atom lifted across the node binder. Both binders and the +constructor operation remain in place, so the rewrite preserves evaluator +fuel, stores, allocation identities, and every continuation index exactly. + +The scalar restriction is the ownership boundary. Reusing a heap-valued +source atom after it was installed in a node could duplicate or revive an +owner in the validated syntax; scalars carry no heap ownership. +-/ + +namespace Ix.Compiler.IxIR1.HPT.FetchForward + +open Ix.Compiler.Ixon (Address) +open Ix.Compiler.IxIR1.Sim + +/-- Lift an atom across the constructor result binder retained by the rewrite. -/ +def liftAtom : Atom → Atom + | .var index => .var (index + 1) + | .lit literal => .lit literal + | .erased => .erased + +theorem resolveAtom_liftAtom_of_eq_ok {head : RVal} + {environment : List RVal} {atom : Atom} {value : RVal} + (hresolve : resolveAtom environment atom = .ok value) : + resolveAtom (head :: environment) (liftAtom atom) = .ok value := by + cases atom with + | lit literal => simpa [liftAtom, resolveAtom] using hresolve + | erased => simpa [liftAtom, resolveAtom] using hresolve + | var index => + simp only [resolveAtom] at hresolve ⊢ + cases hget : environment[index]? with + | none => simp [hget] at hresolve + | some found => simpa [liftAtom, hget] using hresolve + +/-- A fact which admits no heap value. Bottom is accepted because its +concrete interpretation cannot authorize a successful non-scalar execution. -/ +def scalarOnly (fact : Fact) : Bool := + !fact.unknownHeap && fact.shapes.isEmpty + +private def selectedScalarAtom? (facts : List Fact) (arguments : Array Atom) + (field : Nat) : Option Atom := + match arguments[field]? with + | none => none + | some atom => + match resolveAtomFact facts atom with + | .error _ => none + | .ok fact => if scalarOnly fact then some atom else none + +inductive Kind where + | allocation + | reuse + deriving BEq, Repr + +/-- One accepted forwarding decision and its source-side operand. -/ +structure Forwarding where + code : Code + source : Atom + kind : Kind + +/-- Try to replace the head fetch of an already recursively rewritten +continuation. Only the constructor-producing operation immediately outside +that continuation is considered. -/ +def forwardHead? (facts : List Fact) (operation : Op) + (continuation : Code) : Option Forwarding := + match continuation with + | .letOp (.fetch (.var 0) field) rest => + match operation with + | .alloc world identity arguments => do + let atom ← selectedScalarAtom? facts arguments field + return ⟨.letOp (.alloc world identity arguments) + (.letOp (.pure (liftAtom atom)) rest), atom, .allocation⟩ + | .reuse target identity arguments => do + let atom ← selectedScalarAtom? facts arguments field + return ⟨.letOp (.reuse target identity arguments) + (.letOp (.pure (liftAtom atom)) rest), atom, .reuse⟩ + | _ => none + | _ => none + +/-- Proof-facing view of an accepted executable decision. -/ +inductive ForwardSpec (facts : List Fact) : Op → Code → Forwarding → Prop where + | allocation {world identity arguments field rest atom fact} + (hfield : arguments[field]? = some atom) + (hfact : resolveAtomFact facts atom = .ok fact) + (hscalar : scalarOnly fact = true) : + ForwardSpec facts (.alloc world identity arguments) + (.letOp (.fetch (.var 0) field) rest) + ⟨.letOp (.alloc world identity arguments) + (.letOp (.pure (liftAtom atom)) rest), atom, .allocation⟩ + | reuse {target identity arguments field rest atom fact} + (hfield : arguments[field]? = some atom) + (hfact : resolveAtomFact facts atom = .ok fact) + (hscalar : scalarOnly fact = true) : + ForwardSpec facts (.reuse target identity arguments) + (.letOp (.fetch (.var 0) field) rest) + ⟨.letOp (.reuse target identity arguments) + (.letOp (.pure (liftAtom atom)) rest), atom, .reuse⟩ + +theorem forwardSpec_of_forwardHead?_eq_some + {facts : List Fact} {operation : Op} {continuation : Code} + {forwarding : Forwarding} + (hforward : forwardHead? facts operation continuation = some forwarding) : + ForwardSpec facts operation continuation forwarding := by + cases continuation with + | ret atom => simp [forwardHead?] at hforward + | case scrutinee peelNat alternatives => simp [forwardHead?] at hforward + | letOp next rest => + cases next with + | fetch target field => + cases target with + | var index => + cases index with + | zero => + cases operation with + | alloc world identity arguments => + simp only [forwardHead?, selectedScalarAtom?] at hforward + split at hforward + · simp at hforward + · rename_i atom hfield + split at hforward + · simp at hforward + · rename_i fact hfact + split at hforward + · rename_i hscalar + injection hforward with hforwarding + subst forwarding + exact .allocation hfield hfact hscalar + · simp at hforward + | reuse target identity arguments => + simp only [forwardHead?, selectedScalarAtom?] at hforward + split at hforward + · simp at hforward + · rename_i atom hfield + split at hforward + · simp at hforward + · rename_i fact hfact + split at hforward + · rename_i hscalar + injection hforward with hforwarding + subst forwarding + exact .reuse hfield hfact hscalar + · simp at hforward + | pure atom => simp [forwardHead?] at hforward + | free target => simp [forwardHead?] at hforward + | dup target => simp [forwardHead?] at hforward + | drop target => simp [forwardHead?] at hforward + | dropU target => simp [forwardHead?] at hforward + | fetch target field => simp [forwardHead?] at hforward + | call function arguments => simp [forwardHead?] at hforward + | callSelf arguments => simp [forwardHead?] at hforward + | papp function arguments => simp [forwardHead?] at hforward + | apply function arguments => simp [forwardHead?] at hforward + | extern function arguments => simp [forwardHead?] at hforward + | succ index => simp [forwardHead?] at hforward + | lit literal => simp [forwardHead?] at hforward + | erased => simp [forwardHead?] at hforward + | pure atom => simp [forwardHead?] at hforward + | alloc world identity arguments => simp [forwardHead?] at hforward + | reuse target identity arguments => simp [forwardHead?] at hforward + | free target => simp [forwardHead?] at hforward + | dup target => simp [forwardHead?] at hforward + | drop target => simp [forwardHead?] at hforward + | dropU target => simp [forwardHead?] at hforward + | call function arguments => simp [forwardHead?] at hforward + | callSelf arguments => simp [forwardHead?] at hforward + | papp function arguments => simp [forwardHead?] at hforward + | apply function arguments => simp [forwardHead?] at hforward + | extern function arguments => simp [forwardHead?] at hforward + +structure Changes where + forwardedFetches : Nat := 0 + afterAllocations : Nat := 0 + afterReuses : Nat := 0 + deriving BEq, Repr, Inhabited + +def Changes.add (left right : Changes) : Changes := + { forwardedFetches := left.forwardedFetches + right.forwardedFetches + afterAllocations := left.afterAllocations + right.afterAllocations + afterReuses := left.afterReuses + right.afterReuses } + +def Changes.ofKind : Kind → Changes + | .allocation => { forwardedFetches := 1, afterAllocations := 1 } + | .reuse => { forwardedFetches := 1, afterReuses := 1 } + +structure Outcome where + code : Code + changes : Changes := {} + +structure AlternativeOutcome where + alternative : Alt + changes : Changes := {} + +mutual + +/-- Mirror HPT transfer, recursively rewrite each continuation, and then +forward a scalar fetch at the current let boundary when possible. -/ +def runWithFacts (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Address) (current : FnDef) (facts : List Fact) : Code → Outcome + | input@(.ret _) => ⟨input, {}⟩ + | input@(.letOp operation rest) => + match analyzeOp declarations summaries owner current facts operation with + | .error _ => ⟨input, {}⟩ + | .ok bound => + let nested := runWithFacts declarations summaries owner current + (bound :: facts.map Fact.forgetHeap) rest + match forwardHead? facts operation nested.code with + | some forwarding => + ⟨forwarding.code, + nested.changes.add (.ofKind forwarding.kind)⟩ + | none => ⟨.letOp operation nested.code, nested.changes⟩ + | input@(.case scrutinee peelNat alternatives) => + match resolveAtomFact facts scrutinee with + | .error _ => ⟨input, {}⟩ + | .ok fact => + let nested := alternatives.map + (runAlternativeWithFacts declarations summaries owner current + fact peelNat facts) + ⟨.case scrutinee peelNat + (nested.map fun result => result.alternative), + nested.foldl + (fun total result => total.add result.changes) {}⟩ + +def runAlternativeWithFacts (declarations : DeclEnv) + (summaries : SummaryEnv) (owner : Address) (current : FnDef) + (scrutineeFact : Fact) (peelNat : Bool) (facts : List Fact) : + Alt → AlternativeOutcome + | .mk cidx fields body => + let nested := runWithFacts declarations summaries owner current + (scrutineeFact.caseFields peelNat cidx fields ++ facts) body + ⟨.mk cidx fields nested.code, nested.changes⟩ + +end + +def runFunction (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Address) (current : FnDef) : Outcome := + runWithFacts declarations summaries owner current + (List.replicate current.arity Fact.top) current.body + +def rewriteFunction (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Address) (current : FnDef) : FnDef := + { current with body := (runFunction declarations summaries owner current).code } + +/-! ## Semantic support for one forwarded field -/ + +theorem scalar_of_scalarOnly_holds + {declarations : DeclEnv} {store : Store} {fact : Fact} {value : RVal} + (honly : scalarOnly fact = true) + (hholds : fact.Holds declarations store value) : + value.isScalar = true := by + unfold scalarOnly at honly + simp only [Bool.and_eq_true] at honly + cases value with + | lit literal => rfl + | erased => rfl + | loc location => + simp only [Fact.Holds] at hholds + rcases hholds with hunknown | ⟨shape, hmember, _⟩ + · have hfalse : fact.unknownHeap = false := by + simpa using honly.1 + rw [hfalse] at hunknown + contradiction + · have hempty : fact.shapes = [] := List.isEmpty_iff.mp honly.2 + rw [hempty] at hmember + contradiction + +private def resolveStep (environment : List RVal) + (values : List RVal) (atom : Atom) : Except Err (List RVal) := do + pure (values ++ [← resolveAtom environment atom]) + +private inductive AtomsResolve (environment : List RVal) : + List Atom → List RVal → Prop where + | nil : AtomsResolve environment [] [] + | cons (hhead : resolveAtom environment atom = .ok value) + (htail : AtomsResolve environment atoms values) : + AtomsResolve environment (atom :: atoms) (value :: values) + +namespace AtomsResolve + +private theorem foldlM {environment : List RVal} : + ∀ {atoms values}, AtomsResolve environment atoms values → + ∀ accumulator, + atoms.foldlM (resolveStep environment) accumulator = + .ok (accumulator ++ values) + | [], [], .nil, accumulator => by + simp only [List.foldlM_nil, pure, Except.pure, List.append_nil] + | atom :: atoms, value :: values, .cons hhead htail, accumulator => by + have hstep : resolveStep environment accumulator atom = + .ok (accumulator ++ [value]) := by + simp [resolveStep, hhead, bind, Except.bind, pure, Except.pure] + rw [List.foldlM_cons, hstep] + simp only [bind, Except.bind] + rw [htail.foldlM (accumulator ++ [value])] + simp [List.append_assoc] + +private theorem ofFoldlM {environment : List RVal} : + ∀ atoms accumulator output, + atoms.foldlM (resolveStep environment) accumulator = .ok output → + ∃ values, AtomsResolve environment atoms values ∧ + output = accumulator ++ values := by + intro atoms + induction atoms with + | nil => + intro accumulator output hrun + simp only [List.foldlM_nil, pure, Except.pure] at hrun + injection hrun with houtput + subst output + exact ⟨[], .nil, by simp⟩ + | cons atom atoms ih => + intro accumulator output hrun + simp only [List.foldlM_cons] at hrun + cases hhead : resolveAtom environment atom with + | error error => + have hstep : resolveStep environment accumulator atom = + .error error := by + simp [resolveStep, hhead, bind, Except.bind] + rw [hstep] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok value => + have hstep : resolveStep environment accumulator atom = + .ok (accumulator ++ [value]) := by + simp [resolveStep, hhead, bind, Except.bind, pure, Except.pure] + rw [hstep] at hrun + simp only [bind, Except.bind] at hrun + obtain ⟨values, hvalues, houtput⟩ := + ih (accumulator ++ [value]) output hrun + refine ⟨value :: values, .cons hhead hvalues, ?_⟩ + rw [houtput] + simp [List.append_assoc] + +private theorem getElem? {environment : List RVal} : + ∀ {atoms values}, AtomsResolve environment atoms values → + ∀ {field : Nat} {atom : Atom}, atoms[field]? = some atom → + ∃ value, values[field]? = some value ∧ + resolveAtom environment atom = .ok value := by + intro atoms values hresolve + induction hresolve with + | nil => intro field atom hfield; simp at hfield + | @cons atom value atoms values hhead htail ih => + intro field selected hfield + cases field with + | zero => + simp only [List.getElem?_cons_zero] at hfield + injection hfield with hselected + subst selected + exact ⟨value, rfl, hhead⟩ + | succ field => + simp only [List.getElem?_cons_succ] at hfield + obtain ⟨selectedValue, hvalue, hatom⟩ := ih hfield + exact ⟨selectedValue, by simpa using hvalue, hatom⟩ + +end AtomsResolve + +private theorem atomsResolve_of_resolveAtoms {environment : List RVal} + {atoms : Array Atom} {values : List RVal} + (hrun : resolveAtoms environment atoms = .ok values) : + AtomsResolve environment atoms.toList values := by + unfold resolveAtoms at hrun + rw [← Array.foldlM_toList] at hrun + change atoms.toList.foldlM (resolveStep environment) [] = .ok values at hrun + obtain ⟨found, hfound, hvalues⟩ := + AtomsResolve.ofFoldlM atoms.toList [] values hrun + simp only [List.nil_append] at hvalues + subst found + exact hfound + +private theorem selectedAtom_resolves + {environment : List RVal} {arguments : Array Atom} {values : List RVal} + {field : Nat} {atom : Atom} + (harguments : resolveAtoms environment arguments = .ok values) + (hfield : arguments[field]? = some atom) : + ∃ value, resolveAtom environment atom = .ok value ∧ + values.toArray[field]? = some value := by + have hfieldList : arguments.toList[field]? = some atom := by + simpa using hfield + obtain ⟨value, hvalue, hresolve⟩ := + AtomsResolve.getElem? (atomsResolve_of_resolveAtoms harguments) hfieldList + exact ⟨value, hresolve, by simpa using hvalue⟩ + +/-- Once a constructor-producing operation has installed the selected field, +the retained-binder `pure` resolves to exactly the value that `fetch` returns. -/ +private theorem runOp_pure_eq_fetch_ctor + {ctx : Ctx} {fuel : Nat} {current : FnDef} {store : Store} + {environment : List RVal} {location : Nat} {world : Ixon.Owned} + {rc : Nat} {identity : CtorId} {arguments : Array Atom} + {values : List RVal} {field : Nat} {atom : Atom} + (hget : store.get? location = + some ⟨world, rc, .ctorN identity values.toArray⟩) + (harguments : resolveAtoms environment arguments = .ok values) + (hfield : arguments[field]? = some atom) : + runOp ctx fuel current store (.loc location :: environment) + (.pure (liftAtom atom)) = + runOp ctx fuel current store (.loc location :: environment) + (.fetch (.var 0) field) := by + cases fuel with + | zero => rw [runOp.eq_def, runOp.eq_def] + | succ fuel => + obtain ⟨value, hresolve, hvalue⟩ := + selectedAtom_resolves harguments hfield + simp only [runOp] + rw [resolveAtom_liftAtom_of_eq_ok hresolve] + simp only [bind, Except.bind, resolveAtom, List.getElem?_cons_zero] + rw [hget] + simp only + rw [hvalue] + +/-- Every accepted local decision preserves the complete evaluator result, +including errors, fuel behavior, stores, and instruction counters. -/ +theorem runCode_forwardHead?_eq + {facts : List Fact} {operation : Op} {continuation : Code} + {forwarding : Forwarding} {ctx : Ctx} {fuel : Nat} + {current : FnDef} {store : Store} {environment : List RVal} + (hforward : forwardHead? facts operation continuation = some forwarding) : + runCode ctx fuel current store environment forwarding.code = + runCode ctx fuel current store environment + (.letOp operation continuation) := by + have hspec := forwardSpec_of_forwardHead?_eq_some hforward + cases hspec with + | @allocation world identity arguments field rest atom fact hfield hfact + hscalar => + cases fuel with + | zero => rw [runCode.eq_def, runCode.eq_def] + | succ outerFuel => + cases outerFuel with + | zero => simp [runCode, runOp] + | succ operationFuel => + cases harguments : resolveAtoms environment arguments with + | error error => + simp [runCode, runOp, harguments, bind, Except.bind] + | ok values => + let allocated := + store.allocNode world (.ctorN identity values.toArray) + have hoperation : + runOp ctx (operationFuel + 1) current store environment + (.alloc world identity arguments) = + .ok (allocated.1, .loc allocated.2) := by + simp [runOp, harguments, allocated, bind, Except.bind] + have hget : allocated.1.get? allocated.2 = + some ⟨world, 1, .ctorN identity values.toArray⟩ := by + simp [allocated, Sim.HeapIso.get?_allocNode_new] + simp only [runCode] + rw [hoperation] + simp only [bind, Except.bind] + rw [runOp_pure_eq_fetch_ctor hget harguments hfield] + | @reuse target identity arguments field rest atom fact hfield hfact + hscalar => + cases fuel with + | zero => rw [runCode.eq_def, runCode.eq_def] + | succ outerFuel => + cases outerFuel with + | zero => simp [runCode, runOp] + | succ operationFuel => + cases harguments : resolveAtoms environment arguments with + | error error => + simp [runCode, runOp, harguments, bind, Except.bind] + | ok values => + cases htarget : resolveAtom environment target with + | error error => + simp [runCode, runOp, harguments, htarget, bind, + Except.bind] + | ok targetValue => + cases targetValue with + | lit literal => + simp [runCode, runOp, harguments, htarget, bind, + Except.bind] + | erased => + simp [runCode, runOp, harguments, htarget, bind, + Except.bind] + | loc location => + cases hbox : store.get? location with + | none => + simp [runCode, runOp, harguments, htarget, hbox, + bind, Except.bind] + | some box => + cases hworld : box.world with + | shared => + simp [runCode, runOp, harguments, htarget, + hbox, hworld, bind, Except.bind] + | unique => + let replacement : NodeBox := + ⟨.unique, 1, + .ctorN identity values.toArray⟩ + let updated := store.setBox location replacement + let next : Store := + { updated with reuses := updated.reuses + 1 } + have hoperation : + runOp ctx (operationFuel + 1) current + store environment + (.reuse target identity arguments) = + .ok (next, .loc location) := by + simp [runOp, harguments, htarget, hbox, + hworld, replacement, updated, next, bind, + Except.bind] + have hset : + (store.setBox location replacement).get? + location = some replacement := + Sim.get?_setBox_same hbox + have hget : next.get? location = + some ⟨.unique, 1, + .ctorN identity values.toArray⟩ := by + simpa [next, updated, replacement, + Store.get?] using hset + simp only [runCode] + rw [hoperation] + simp only [bind, Except.bind] + rw [runOp_pure_eq_fetch_ctor hget harguments + hfield] + +/-- The executable side condition proves that the reused source operand is a +runtime scalar whenever the checked HPT environment and concrete resolution +agree. This is the ownership justification beyond evaluator equality. -/ +theorem source_isScalar_of_forwardHead?_eq_some + {declarations : DeclEnv} {store : Store} {facts : List Fact} + {environment : List RVal} {operation : Op} {continuation : Code} + {forwarding : Forwarding} {value : RVal} + (henvironment : EnvironmentHolds declarations store facts environment) + (hforward : forwardHead? facts operation continuation = some forwarding) + (hresolve : resolveAtom environment forwarding.source = .ok value) : + value.isScalar = true := by + have hspec := forwardSpec_of_forwardHead?_eq_some hforward + cases hspec with + | allocation hfield hfact hscalar => + exact scalar_of_scalarOnly_holds hscalar + (resolveAtom_sound henvironment hfact hresolve) + | reuse hfield hfact hscalar => + exact scalar_of_scalarOnly_holds hscalar + (resolveAtom_sound henvironment hfact hresolve) + +/-! ## Exact recursive traversal -/ + +@[simp] private theorem runAlternativeWithFacts_cidx + (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Address) (current : FnDef) + (scrutineeFact : Fact) (peelNat : Bool) (facts : List Fact) + (alternative : Alt) : + (runAlternativeWithFacts declarations summaries owner current + scrutineeFact peelNat facts alternative).alternative.cidx = + alternative.cidx := by + cases alternative + simp [runAlternativeWithFacts, Alt.cidx] + +private theorem runAlternativeWithFacts_predicate + (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Address) (current : FnDef) + (scrutineeFact : Fact) (peelNat : Bool) (facts : List Fact) + (index : Nat) : + ((fun alternative : Alt => alternative.cidx == index) ∘ + (fun result : AlternativeOutcome => result.alternative) ∘ + runAlternativeWithFacts declarations summaries owner current + scrutineeFact peelNat facts) = + (fun alternative => alternative.cidx == index) := by + funext alternative + cases alternative + simp [Function.comp_def, runAlternativeWithFacts, Alt.cidx] + +private theorem find?_runAlternativeWithFacts + (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Address) (current : FnDef) + (scrutineeFact : Fact) (peelNat : Bool) (facts : List Fact) + (alternatives : Array Alt) (index : Nat) : + ((alternatives.map + (runAlternativeWithFacts declarations summaries owner current + scrutineeFact peelNat facts)).map + (fun result => result.alternative)).find? + (fun alternative => alternative.cidx == index) = + (alternatives.find? (fun alternative => alternative.cidx == index)).map + (fun alternative => + (runAlternativeWithFacts declarations summaries owner current + scrutineeFact peelNat facts alternative).alternative) := by + rw [Array.map_map, Array.find?_map, + runAlternativeWithFacts_predicate declarations summaries owner current + scrutineeFact peelNat facts index] + simp [Function.comp_def] + +private theorem Array.foldl_cons_eq_reverse_append + (fields : Array RVal) (environment : List RVal) : + fields.foldl (fun current field => field :: current) environment = + fields.toList.reverse ++ environment := by + rw [← Array.foldl_toList] + induction fields.toList generalizing environment with + | nil => rfl + | cons field fields ih => + simp only [List.foldl_cons] + rw [ih] + simp [List.reverse_cons, List.append_assoc] + +/-- The branch-body half of fetch forwarding. HPT case binders are installed +only after the concrete evaluator selects a matching alternative and arity. -/ +private theorem runCode_caseWithFactsBodies_eq + {declarations : DeclEnv} {summaries : SummaryEnv} + {owner : Address} {current : FnDef} + {ctx : Ctx} {store : Store} {facts : List Fact} + {environment : List RVal} {scrutinee : Atom} {peelNat : Bool} + {alternatives : Array Alt} {scrutineeFact : Fact} {fuel : Nat} + (henvironment : EnvironmentHolds declarations store facts environment) + (habstract : resolveAtomFact facts scrutinee = .ok scrutineeFact) + (ih : ∀ {store : Store} {facts : List Fact} + {environment : List RVal} {input : Code}, + EnvironmentHolds declarations store facts environment → + runCode ctx fuel current store environment + (runWithFacts declarations summaries owner current facts input).code = + runCode ctx fuel current store environment input) : + runCode ctx (fuel + 1) current store environment + (.case scrutinee peelNat + ((alternatives.map + (runAlternativeWithFacts declarations summaries owner current + scrutineeFact peelNat facts)).map + (fun result => result.alternative))) = + runCode ctx (fuel + 1) current store environment + (.case scrutinee peelNat alternatives) := by + obtain ⟨scrutineeValue, hresolve⟩ := + resolveAtom_complete henvironment habstract + have hscrutineeHolds := + resolveAtom_sound henvironment habstract hresolve + simp only [runCode] + rw [hresolve] + simp only [bind, Except.bind] + cases scrutineeValue with + | erased => rfl + | lit literal => + cases literal with + | str value => rfl + | nat value => + simp only + cases peelNat with + | false => rfl + | true => + simp only + cases value with + | zero => + simp only + rw [find?_runAlternativeWithFacts] + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == 0) with + | none => simp + | some alternative => + cases alternative with + | mk cidx fields body => + cases fields with + | zero => + have hzero : + scrutineeFact.caseFields true cidx 0 = [] := by + unfold Fact.caseFields + split <;> rfl + simpa [runAlternativeWithFacts, hzero] using + (ih (input := body) henvironment) + | succ fields => simp [runAlternativeWithFacts] + | succ value => + simp only + rw [find?_runAlternativeWithFacts] + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == 1) with + | none => simp + | some alternative => + cases alternative with + | mk cidx fields body => + cases fields with + | zero => simp [runAlternativeWithFacts] + | succ fields => + cases fields with + | zero => + have hcidx : cidx = 1 := by + have hmatch := Array.find?_some + (p := fun alternative : Alt => + alternative.cidx == 1) + (a := .mk cidx 1 body) + (xs := alternatives) hfind + exact beq_iff_eq.mp hmatch + have hbinders : + EnvironmentHolds declarations store + (scrutineeFact.caseFields true cidx 1) + [.lit (.nat value)] := by + simpa [hcidx] using + (Fact.caseFields_natSucc_holds + hscrutineeHolds) + simpa [runAlternativeWithFacts] using + (ih (input := body) + (hbinders.append henvironment)) + | succ fields => + simp [runAlternativeWithFacts] + | loc location => + simp only + cases hget : store.get? location with + | none => simp + | some box => + simp only + cases hnode : box.node with + | papN function arity arguments => simp + | ctorN identity fields => + simp only + rw [find?_runAlternativeWithFacts] + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == identity.cidx) with + | none => simp + | some alternative => + cases alternative with + | mk cidx fieldCount body => + by_cases hfields : fields.size = fieldCount + · have hcidx : identity.cidx = cidx := by + have hmatch := Array.find?_some + (p := fun alternative : Alt => + alternative.cidx == identity.cidx) + (a := .mk cidx fieldCount body) + (xs := alternatives) hfind + exact (beq_iff_eq.mp hmatch).symm + have hbinders := Fact.caseFields_ctor_holds + peelNat cidx fieldCount hscrutineeHolds hget hnode + hcidx hfields + rw [Array.foldl_cons_eq_reverse_append] + simpa [hfields, runAlternativeWithFacts] using + (ih (input := body) + (hbinders.append henvironment)) + · simp [hfields, runAlternativeWithFacts] + +/-- Exact evaluator equality for the owner-sensitive forwarding traversal. +The owner may name the current stored function or be absent from the summary, +which is the fail-closed top-level-main convention. -/ +theorem runCode_runWithFacts_eq_ownerCompatible + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {owner : Address} {current : FnDef} + {store : Store} {facts : List Fact} {environment : List RVal} + {input : Code} {fuel : Nat} + (hctx : ctx.decls = declarations) + (howner : AnalysisOwnerCompatible declarations summaries owner current) + (henvironment : EnvironmentHolds declarations store facts environment) : + runCode ctx fuel current store environment + (runWithFacts declarations summaries owner current facts input).code = + runCode ctx fuel current store environment input := by + induction fuel generalizing store facts environment input with + | zero => simp [runCode] + | succ fuel ih => + cases input with + | ret atom => simp [runWithFacts, runCode] + | letOp operation rest => + cases habstract : analyzeOp declarations summaries owner current + facts operation with + | error error => simp [runWithFacts, habstract] + | ok bound => + let nested := runWithFacts declarations summaries owner current + (bound :: facts.map Fact.forgetHeap) rest + have hordinary : + runCode ctx (fuel + 1) current store environment + (.letOp operation nested.code) = + runCode ctx (fuel + 1) current store environment + (.letOp operation rest) := by + simp only [runCode] + cases hoperation : runOp ctx fuel current store environment + operation with + | error error => simp [bind, Except.bind] + | ok output => + rcases output with ⟨outputStore, outputValue⟩ + simp only [bind, Except.bind] + have hbound := analyzeOp_sound_ownerCompatible hpost hctx + howner henvironment habstract hoperation + have hold := EnvironmentHolds.forgetHeap + (after := outputStore) henvironment + simpa [nested] using + (ih (store := outputStore) + (facts := bound :: facts.map Fact.forgetHeap) + (environment := outputValue :: environment) + (input := rest) (.cons hbound hold)) + cases hforward : forwardHead? facts operation nested.code with + | none => + simpa [runWithFacts, habstract, nested, hforward] using + hordinary + | some forwarding => + calc + runCode ctx (fuel + 1) current store environment + (runWithFacts declarations summaries owner current facts + (.letOp operation rest)).code = + runCode ctx (fuel + 1) current store environment + forwarding.code := by + simp [runWithFacts, habstract, nested, hforward] + _ = runCode ctx (fuel + 1) current store environment + (.letOp operation nested.code) := + runCode_forwardHead?_eq hforward + _ = runCode ctx (fuel + 1) current store environment + (.letOp operation rest) := hordinary + | case scrutinee peelNat alternatives => + cases habstract : resolveAtomFact facts scrutinee with + | error error => simp [runWithFacts, habstract] + | ok scrutineeFact => + simpa [runWithFacts, habstract] using + (runCode_caseWithFactsBodies_eq henvironment habstract + (fun henv => ih henv)) + +/-- Stored-function specialization of exact recursive fetch forwarding. -/ +theorem runCode_runWithFacts_eq + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {owner : Address} {current : FnDef} + {store : Store} {facts : List Fact} {environment : List RVal} + {input : Code} {fuel : Nat} + (hctx : ctx.decls = declarations) + (hcurrent : declarations owner = some (.fn current)) + (henvironment : EnvironmentHolds declarations store facts environment) : + runCode ctx fuel current store environment + (runWithFacts declarations summaries owner current facts input).code = + runCode ctx fuel current store environment input := + runCode_runWithFacts_eq_ownerCompatible hpost hctx (.inl hcurrent) + henvironment + +end Ix.Compiler.IxIR1.HPT.FetchForward diff --git a/Ix/Compiler/IxIR1/HPTPAPFuse.lean b/Ix/Compiler/IxIR1/HPTPAPFuse.lean new file mode 100644 index 000000000..521f62084 --- /dev/null +++ b/Ix/Compiler/IxIR1/HPTPAPFuse.lean @@ -0,0 +1,2770 @@ +import Ix.Compiler.IxIR1.EvalRewrite +import Ix.Compiler.IxIR1.HPTSound + +/-! +# Checked local PAP/application fusion + +The first PAP consumer is deliberately allocation-site local. It recognizes +two adjacent binders + +```text +let p := papp f captured +let y := apply p supplied +rest +``` + +and replaces them with a larger `papp`, a direct `call`, or a direct `call` +followed by the residual `apply`. Both binder slots are retained, so no +general de Bruijn substitution is needed. The checker establishes: + +- the target declaration and its arity; +- exact argument order across under-, exact-, and over-saturation; +- that supplied arguments do not refer to the consumed PAP; +- that the old PAP binder is absent from the continuation; and +- that every captured runtime value is scalar according to checked HPT facts. + +The scalar restriction is substantive rather than cosmetic. IxIR₁ function +definitions retain result ownership but no longer carry parameter modes, and +HPT does not infer heap worlds. A local checker can therefore prove that a +capture needs no retain/release traffic when it is scalar, but cannot certify +an arbitrary heap capture as shared. A later borrow/ownership artifact can +broaden this same rewrite without changing its syntax contract. +-/ + +namespace Ix.Compiler.IxIR1.HPT.PAPFuse + +open Ix.Compiler.Ixon (Address) +open Ix.Compiler.IxIR1.Sim + +/-- A fact which admits scalars and no heap value. Bottom also satisfies the +test; its concrete interpretation is empty, so it cannot authorize a +successful non-scalar capture. -/ +def scalarOnly (fact : Fact) : Bool := + !fact.unknownHeap && fact.shapes.isEmpty + +/-- Lower one operand across removal of the immediately preceding PAP binder. +`none` is exactly a use of that consumed binder. -/ +def lowerAtom? : Atom → Option Atom + | .var 0 => none + | .var (index + 1) => some (.var index) + | .lit literal => some (.lit literal) + | .erased => some .erased + +def lowerAtoms? (atoms : Array Atom) : Option (Array Atom) := + (atoms.toList.mapM lowerAtom?).map List.toArray + +def atomUsesVar (needle : Nat) : Atom → Bool + | .var index => index == needle + | .lit _ | .erased => false + +def atomsUseVar (needle : Nat) (atoms : Array Atom) : Bool := + atoms.any (atomUsesVar needle) + +def opUsesVar (needle : Nat) : Op → Bool + | .pure atom => atomUsesVar needle atom + | .alloc _ _ atoms | .call _ atoms | .papp _ atoms | + .extern _ atoms | .callSelf atoms => atomsUseVar needle atoms + | .reuse target _ atoms => + atomUsesVar needle target || atomsUseVar needle atoms + | .free target | .dup target | .drop target | .dropU target => + atomUsesVar needle target + | .fetch target _ => atomUsesVar needle target + | .apply function atoms => + atomUsesVar needle function || atomsUseVar needle atoms + +mutual + +private def codeUsesVarFuel : Nat → Code → Nat → Bool + | 0, _, _ => true + | _ + 1, .ret atom, needle => atomUsesVar needle atom + | fuel + 1, .letOp operation rest, needle => + opUsesVar needle operation || + codeUsesVarFuel fuel rest (needle + 1) + | fuel + 1, .case scrutinee _ alternatives, needle => + atomUsesVar needle scrutinee || + alternatives.any + (fun alternative => altUsesVarFuel fuel alternative needle) + +private def altUsesVarFuel : Nat → Alt → Nat → Bool + | 0, _, _ => true + | fuel + 1, .mk _ fields body, needle => + codeUsesVarFuel fuel body (needle + fields) + +end + +/-- Capture-aware occurrence check. `needle` is expressed in the entry +environment; let and case binders shift it on recursive descent. Fuel is the +syntax size and exhaustion conservatively reports a use. -/ +def codeUsesVar (input : Code) (needle : Nat) : Bool := + codeUsesVarFuel (input.bytes.size + 1) input needle + +/-! The executable occurrence check has a proof-oriented counterpart. A +false fuel result is enough to construct this evidence: exhaustion returns +`true`, so accepted code necessarily carries evidence down every path. -/ + +mutual + +inductive CodeNoUse : Nat → Code → Prop where + | ret {needle atom} (hnot : atomUsesVar needle atom = false) : + CodeNoUse needle (.ret atom) + | letOp {needle operation rest} + (hop : opUsesVar needle operation = false) + (hrest : CodeNoUse (needle + 1) rest) : + CodeNoUse needle (.letOp operation rest) + | case {needle scrutinee peelNat alternatives} + (hscrutinee : atomUsesVar needle scrutinee = false) + (halternatives : ∀ alternative, alternative ∈ alternatives → + AltNoUse needle alternative) : + CodeNoUse needle (.case scrutinee peelNat alternatives) + +inductive AltNoUse : Nat → Alt → Prop where + | mk {needle cidx fields body} + (hbody : CodeNoUse (needle + fields) body) : + AltNoUse needle (.mk cidx fields body) + +end + +mutual + +private theorem codeNoUse_of_fuel_false : ∀ fuel input needle, + codeUsesVarFuel fuel input needle = false → CodeNoUse needle input := by + intro fuel input needle hcheck + cases fuel with + | zero => simp [codeUsesVarFuel] at hcheck + | succ fuel => + cases input with + | ret atom => exact .ret hcheck + | letOp operation rest => + simp only [codeUsesVarFuel, Bool.or_eq_false_iff] at hcheck + exact .letOp hcheck.1 + (codeNoUse_of_fuel_false fuel rest (needle + 1) hcheck.2) + | case scrutinee peelNat alternatives => + simp only [codeUsesVarFuel, Bool.or_eq_false_iff] at hcheck + refine .case hcheck.1 ?_ + intro alternative halternative + apply altNoUse_of_fuel_false fuel alternative needle + have hnotTrue : + ¬ altUsesVarFuel fuel alternative needle = true := + (Array.any_eq_false'.mp hcheck.2) alternative halternative + exact Bool.eq_false_iff.mpr hnotTrue + +private theorem altNoUse_of_fuel_false : ∀ fuel alternative needle, + altUsesVarFuel fuel alternative needle = false → + AltNoUse needle alternative := by + intro fuel alternative needle hcheck + cases fuel with + | zero => simp [altUsesVarFuel] at hcheck + | succ fuel => + cases alternative with + | mk cidx fields body => + exact .mk + (codeNoUse_of_fuel_false fuel body (needle + fields) hcheck) + +end + + +theorem codeNoUse_of_codeUsesVar_eq_false {input : Code} {needle : Nat} + (hcheck : codeUsesVar input needle = false) : + CodeNoUse needle input := + codeNoUse_of_fuel_false (input.bytes.size + 1) input needle hcheck + +/-! ## Environment irrelevance + +The relation deliberately permits the distinguished slots to contain +arbitrary values. It is stable when an operation result or constructor +fields are pushed in front of both environments. -/ + +def EnvsAgreeExcept (needle : Nat) (left right : List RVal) : Prop := + ∀ index, index ≠ needle → left[index]? = right[index]? + +namespace EnvsAgreeExcept + +theorem cons {needle : Nat} {left right : List RVal} + (h : EnvsAgreeExcept needle left right) (value : RVal) : + EnvsAgreeExcept (needle + 1) (value :: left) (value :: right) := by + intro index hindex + cases index with + | zero => rfl + | succ index => + simp only [List.getElem?_cons_succ] + apply h index + omega + +theorem prepend {needle : Nat} {left right : List RVal} + (h : EnvsAgreeExcept needle left right) (values : List RVal) : + EnvsAgreeExcept (needle + values.length) + (values ++ left) (values ++ right) := by + induction values with + | nil => simpa using h + | cons value values ih => + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using + ih.cons value + +theorem second (head leftValue rightValue : RVal) (tail : List RVal) : + EnvsAgreeExcept 1 + (head :: leftValue :: tail) (head :: rightValue :: tail) := by + intro index hindex + cases index with + | zero => rfl + | succ index => + cases index with + | zero => omega + | succ index => rfl + +end EnvsAgreeExcept + +private theorem resolveAtom_env_eq {needle : Nat} {left right : List RVal} + (henvironment : EnvsAgreeExcept needle left right) {atom : Atom} + (hnot : atomUsesVar needle atom = false) : + resolveAtom left atom = resolveAtom right atom := by + cases atom with + | var index => + have hindex : index ≠ needle := by + simpa [atomUsesVar] using hnot + simp only [resolveAtom] + rw [henvironment index hindex] + | lit literal => rfl + | erased => rfl + +private theorem List.resolveAtomsFrom_env_eq {needle : Nat} + {left right : List RVal} (henvironment : EnvsAgreeExcept needle left right) : + ∀ (atoms : List Atom) (accumulator : List RVal), + (∀ atom, atom ∈ atoms → atomUsesVar needle atom = false) → + atoms.foldlM + (fun accumulated atom => do + pure (accumulated ++ [← resolveAtom left atom])) accumulator = + atoms.foldlM + (fun accumulated atom => do + pure (accumulated ++ [← resolveAtom right atom])) accumulator := by + intro atoms + induction atoms with + | nil => intro accumulator _; rfl + | cons atom atoms ih => + intro accumulator hnot + simp only [List.foldlM_cons] + rw [resolveAtom_env_eq henvironment (hnot atom (by simp))] + cases resolveAtom right atom with + | error error => rfl + | ok value => + simp only [bind, Except.bind] + apply ih + intro tail htail + exact hnot tail (by simp [htail]) + +private theorem resolveAtoms_env_eq {needle : Nat} {left right : List RVal} + (henvironment : EnvsAgreeExcept needle left right) {atoms : Array Atom} + (hnot : atomsUseVar needle atoms = false) : + resolveAtoms left atoms = resolveAtoms right atoms := by + unfold resolveAtoms + rw [← Array.foldlM_toList, ← Array.foldlM_toList] + apply List.resolveAtomsFrom_env_eq henvironment + intro atom hatom + have hnotTrue : ¬ atomUsesVar needle atom = true := + (Array.any_eq_false'.mp hnot) atom (by simpa using hatom) + exact Bool.eq_false_iff.mpr hnotTrue + +/-- An operation which does not mention the distinguished slot has exactly +the same behavior in environments which differ only there. -/ +theorem runOp_env_eq_of_noUse {ctx : Ctx} {fuel : Nat} {current : FnDef} + {store : Store} {needle : Nat} {left right : List RVal} + (henvironment : EnvsAgreeExcept needle left right) {operation : Op} + (hnot : opUsesVar needle operation = false) : + runOp ctx fuel current store left operation = + runOp ctx fuel current store right operation := by + cases fuel with + | zero => rw [runOp.eq_def, runOp.eq_def] + | succ fuel => + cases operation with + | pure atom => + simp only [runOp] + rw [resolveAtom_env_eq henvironment hnot] + | alloc world cidx atoms => + simp only [runOp] + rw [resolveAtoms_env_eq henvironment hnot] + | reuse target cidx atoms => + simp only [runOp] + simp only [opUsesVar, Bool.or_eq_false_iff] at hnot + rw [resolveAtoms_env_eq henvironment hnot.2, + resolveAtom_env_eq henvironment hnot.1] + | free target | dup target | drop target | dropU target | fetch target _ => + simp only [runOp] + rw [resolveAtom_env_eq henvironment hnot] + | call function atoms => + simp only [runOp] + rw [resolveAtoms_env_eq henvironment hnot] + | callSelf atoms => + simp only [runOp] + rw [resolveAtoms_env_eq henvironment hnot] + | papp function atoms => + simp only [runOp] + rw [resolveAtoms_env_eq henvironment hnot] + | extern function atoms => + simp only [runOp] + rw [resolveAtoms_env_eq henvironment hnot] + | apply function atoms => + simp only [runOp] + simp only [opUsesVar, Bool.or_eq_false_iff] at hnot + rw [resolveAtom_env_eq henvironment hnot.1, + resolveAtoms_env_eq henvironment hnot.2] + +private theorem List.foldl_cons_eq_reverse_append + (values environment : List RVal) : + values.foldl (fun accumulated value => value :: accumulated) environment = + values.reverse ++ environment := by + induction values generalizing environment with + | nil => rfl + | cons value values ih => + simp only [List.foldl_cons] + rw [ih] + simp [List.reverse_cons, List.append_assoc] + +private theorem Array.foldl_cons_eq_reverse_append + (values : Array RVal) (environment : List RVal) : + values.foldl (fun accumulated value => value :: accumulated) environment = + values.toList.reverse ++ environment := by + rw [← Array.foldl_toList] + exact List.foldl_cons_eq_reverse_append values.toList environment + +/-- Code certified not to use one slot is completely insensitive to that +slot, including errors and fuel behavior. -/ +theorem runCode_env_eq_of_noUse {ctx : Ctx} : + ∀ fuel current store needle left right input, + EnvsAgreeExcept needle left right → + CodeNoUse needle input → + runCode ctx fuel current store left input = + runCode ctx fuel current store right input := by + intro fuel + induction fuel with + | zero => + intro current store needle left right input henvironment hnot + rw [runCode.eq_def, runCode.eq_def] + | succ fuel smaller => + intro current store needle left right input henvironment hnot + cases hnot with + | ret hatom => + simp only [runCode] + rw [resolveAtom_env_eq henvironment hatom] + | @letOp _ operation rest hop hrest => + simp only [runCode] + rw [runOp_env_eq_of_noUse henvironment hop] + cases hoperation : runOp ctx fuel current store right operation with + | error error => rfl + | ok output => + rcases output with ⟨next, value⟩ + simp only [hoperation, bind, Except.bind] + exact smaller current next (needle + 1) + (value :: left) (value :: right) rest + (henvironment.cons value) hrest + | @case _ scrutinee peelNat alternatives hscrutinee halternatives => + rw [runCode.eq_def, runCode.eq_def] + dsimp only + rw [resolveAtom_env_eq henvironment hscrutinee] + cases hresolve : resolveAtom right scrutinee with + | error error => rfl + | ok scrutineeValue => + simp only [hresolve, bind, Except.bind] + cases scrutineeValue with + | erased => rfl + | loc location => + cases hbox : store.get? location with + | none => simp [hbox] + | some box => + simp only [hbox] + cases box.node with + | papN function arity captured => rfl + | ctorN identity fields => + dsimp only + cases halt : alternatives.find? + (fun alternative => + alternative.cidx == identity.cidx) with + | none => simp [halt] + | some alternative => + have haltNo := halternatives alternative + (Array.mem_of_find?_eq_some halt) + cases alternative with + | mk cidx fieldCount body => + cases haltNo with + | mk hbody => + cases hsize : fields.size != fieldCount + · simp only [halt, hsize, + Bool.false_eq_true, if_false] + rw [ + Array.foldl_cons_eq_reverse_append, + Array.foldl_cons_eq_reverse_append] + apply smaller current store + (needle + fieldCount) + (fields.toList.reverse ++ left) + (fields.toList.reverse ++ right) + body + · have hprefix := henvironment.prepend + fields.toList.reverse + have hfieldCount : + fields.size = fieldCount := by + simpa using hsize + simpa [hfieldCount] using hprefix + · exact hbody + · simp [halt, hsize] + | lit literal => + cases literal with + | str string => rfl + | nat value => + cases hpeel : peelNat with + | false => simp [hpeel] + | true => + cases value with + | zero => + cases halt : alternatives.find? + (fun alternative => + alternative.cidx == 0) with + | none => simp [hpeel, halt] + | some alternative => + have haltNo := halternatives alternative + (Array.mem_of_find?_eq_some halt) + cases alternative with + | mk cidx fieldCount body => + cases haltNo with + | mk hbody => + cases fieldCount with + | zero => + simp only [hpeel, halt] + exact smaller current store + needle left right body + henvironment (by simpa using hbody) + | succ fieldCount => + simp [hpeel, halt] + | succ value => + cases halt : alternatives.find? + (fun alternative => + alternative.cidx == 1) with + | none => simp [hpeel, halt] + | some alternative => + have haltNo := halternatives alternative + (Array.mem_of_find?_eq_some halt) + cases alternative with + | mk cidx fieldCount body => + cases haltNo with + | mk hbody => + cases fieldCount with + | zero => simp [hpeel, halt] + | succ fieldCount => + cases fieldCount with + | zero => + simp only [hpeel, halt] + exact smaller current store + (needle + 1) + (.lit (.nat value) :: left) + (.lit (.nat value) :: right) + body + (henvironment.cons + (.lit (.nat value))) + (by simpa using hbody) + | succ fieldCount => + simp [hpeel, halt] + +private def scalarCaptures (facts : List Fact) + (captured : Array Atom) : Bool := + match resolveAtomFacts facts captured with + | .error _ => false + | .ok captureFacts => captureFacts.all scalarOnly + +inductive Kind where + | under + | exact + | over + deriving BEq, Repr + +/-- One accepted local replacement, classified for deterministic reporting. -/ +structure Fusion where + code : Code + kind : Kind + +/-- Check and construct one adjacent PAP/application fusion. -/ +def fusePair? (declarations : DeclEnv) (facts : List Fact) + (function : Address) (captured supplied : Array Atom) + (rest : Code) : Option Fusion := do + let declaration ← declarations function + let arity := declArity declaration + if captured.size >= arity then none + else if !scalarCaptures facts captured then none + else if codeUsesVar rest 1 then none + else + let loweredSupplied ← lowerAtoms? supplied + let combined := captured.toList ++ loweredSupplied.toList + if combined.length < arity then + some ⟨.letOp (.papp function combined.toArray) + (.letOp (.pure (.var 0)) rest), .under⟩ + else if combined.length == arity then + some ⟨.letOp (.call function combined.toArray) + (.letOp (.pure (.var 0)) rest), .exact⟩ + else + let consumedSupplied := arity - captured.size + let first := combined.take arity |>.toArray + let remaining := supplied.toList.drop consumedSupplied |>.toArray + some ⟨.letOp (.call function first) + (.letOp (.apply (.var 0) remaining) rest), .over⟩ + +/-! A proof-facing view of an accepted executable decision. -/ + +inductive FuseSpec (declarations : DeclEnv) (facts : List Fact) + (function : Address) (captured supplied : Array Atom) (rest : Code) : + Fusion → Prop where + | under {declaration : Decl} {lowered : Array Atom} + (hdeclaration : declarations function = some declaration) + (hcaptureArity : captured.size < declArity declaration) + (hscalar : scalarCaptures facts captured = true) + (hrest : codeUsesVar rest 1 = false) + (hlowered : lowerAtoms? supplied = some lowered) + (hunder : (captured.toList ++ lowered.toList).length < + declArity declaration) : + FuseSpec declarations facts function captured supplied rest + ⟨.letOp + (.papp function (captured.toList ++ lowered.toList).toArray) + (.letOp (.pure (.var 0)) rest), .under⟩ + | exact {declaration : Decl} {lowered : Array Atom} + (hdeclaration : declarations function = some declaration) + (hcaptureArity : captured.size < declArity declaration) + (hscalar : scalarCaptures facts captured = true) + (hrest : codeUsesVar rest 1 = false) + (hlowered : lowerAtoms? supplied = some lowered) + (hexact : (captured.toList ++ lowered.toList).length = + declArity declaration) : + FuseSpec declarations facts function captured supplied rest + ⟨.letOp + (.call function (captured.toList ++ lowered.toList).toArray) + (.letOp (.pure (.var 0)) rest), .exact⟩ + | over {declaration : Decl} {lowered : Array Atom} + (hdeclaration : declarations function = some declaration) + (hcaptureArity : captured.size < declArity declaration) + (hscalar : scalarCaptures facts captured = true) + (hrest : codeUsesVar rest 1 = false) + (hlowered : lowerAtoms? supplied = some lowered) + (hover : declArity declaration < + (captured.toList ++ lowered.toList).length) : + FuseSpec declarations facts function captured supplied rest + ⟨.letOp + (.call function + ((captured.toList ++ lowered.toList).take + (declArity declaration)).toArray) + (.letOp + (.apply (.var 0) + (supplied.toList.drop + (declArity declaration - captured.size)).toArray) + rest), .over⟩ + +theorem fuseSpec_of_fusePair?_eq_some + {declarations : DeclEnv} {facts : List Fact} {function : Address} + {captured supplied : Array Atom} {rest : Code} {fusion : Fusion} + (hfusion : fusePair? declarations facts function captured supplied rest = + some fusion) : + FuseSpec declarations facts function captured supplied rest fusion := by + cases hdeclaration : declarations function with + | none => simp [fusePair?, hdeclaration] at hfusion + | some declaration => + by_cases hcapture : captured.size >= declArity declaration + · simp [fusePair?, hdeclaration, hcapture] at hfusion + · have hcapture' : captured.size < declArity declaration := by omega + by_cases hscalar : scalarCaptures facts captured = true + · by_cases hrest : codeUsesVar rest 1 = false + · cases hlowered : lowerAtoms? supplied with + | none => + simp [fusePair?, hdeclaration, hcapture, hscalar, hrest, + hlowered] at hfusion + | some lowered => + by_cases hunder : + (captured.toList ++ lowered.toList).length < + declArity declaration + · have heq : + (⟨.letOp + (.papp function + (captured.toList ++ lowered.toList).toArray) + (.letOp (.pure (.var 0)) rest), .under⟩ : Fusion) = + fusion := by + have hunderSize : + captured.size + lowered.size < + declArity declaration := by simpa using hunder + simpa [fusePair?, hdeclaration, hcapture, hscalar, + hrest, hlowered, hunderSize] using hfusion + subst fusion + exact .under hdeclaration hcapture' hscalar hrest hlowered + hunder + · by_cases hexact : + (captured.toList ++ lowered.toList).length = + declArity declaration + · have heq : + (⟨.letOp + (.call function + (captured.toList ++ lowered.toList).toArray) + (.letOp (.pure (.var 0)) rest), .exact⟩ : Fusion) = + fusion := by + have hnotUnderSize : + ¬ captured.size + lowered.size < + declArity declaration := by simpa using hunder + have hexactSize : captured.size + lowered.size = + declArity declaration := by simpa using hexact + simpa [fusePair?, hdeclaration, hcapture, hscalar, + hrest, hlowered, hnotUnderSize, hexactSize] using + hfusion + subst fusion + exact .exact hdeclaration hcapture' hscalar hrest hlowered + hexact + · have hover : declArity declaration < + (captured.toList ++ lowered.toList).length := by omega + have heq : + (⟨.letOp + (.call function + ((captured.toList ++ lowered.toList).take + (declArity declaration)).toArray) + (.letOp + (.apply (.var 0) + (supplied.toList.drop + (declArity declaration - captured.size)).toArray) + rest), .over⟩ : Fusion) = fusion := by + have hnotUnderSize : + ¬ captured.size + lowered.size < + declArity declaration := by simpa using hunder + have hnotExactSize : + captured.size + lowered.size ≠ + declArity declaration := by simpa using hexact + simpa [fusePair?, hdeclaration, hcapture, hscalar, + hrest, hlowered, hnotUnderSize, hnotExactSize] using + hfusion + subst fusion + exact .over hdeclaration hcapture' hscalar hrest hlowered + hover + · simp [fusePair?, hdeclaration, hcapture, hscalar, hrest] at hfusion + · simp [fusePair?, hdeclaration, hcapture, hscalar] at hfusion + +structure Changes where + fusedPaps : Nat := 0 + underSaturated : Nat := 0 + exactlySaturated : Nat := 0 + overSaturated : Nat := 0 + deriving BEq, Repr, Inhabited + +def Changes.add (left right : Changes) : Changes := + { fusedPaps := left.fusedPaps + right.fusedPaps + underSaturated := left.underSaturated + right.underSaturated + exactlySaturated := left.exactlySaturated + right.exactlySaturated + overSaturated := left.overSaturated + right.overSaturated } + +def Changes.ofKind : Kind → Changes + | .under => { fusedPaps := 1, underSaturated := 1 } + | .exact => { fusedPaps := 1, exactlySaturated := 1 } + | .over => { fusedPaps := 1, overSaturated := 1 } + +structure Outcome where + code : Code + changes : Changes := {} + +structure AlternativeOutcome where + alternative : Alt + changes : Changes := {} + +mutual + +/-- Mirror HPT transfer while fusing checked adjacent allocation sites. +Transfer failure is fail-soft for the affected subtree. -/ +def runWithFacts (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Address) (current : FnDef) (facts : List Fact) : + Code → Outcome + | input@(.ret _) => ⟨input, {}⟩ + | input@(.letOp (.papp function captured) + (.letOp (.apply (.var 0) supplied) rest)) => + let pap := Op.papp function captured + let apply := Op.apply (.var 0) supplied + match analyzeOp declarations summaries owner current facts pap with + | .error _ => ⟨input, {}⟩ + | .ok papFact => + let afterPap := papFact :: facts.map Fact.forgetHeap + match analyzeOp declarations summaries owner current afterPap apply with + | .error _ => ⟨input, {}⟩ + | .ok resultFact => + let afterApply := resultFact :: afterPap.map Fact.forgetHeap + let nested := runWithFacts declarations summaries owner current + afterApply rest + match fusePair? declarations facts function captured supplied + nested.code with + | some fusion => + ⟨fusion.code, nested.changes.add (.ofKind fusion.kind)⟩ + | none => + ⟨.letOp pap (.letOp apply nested.code), nested.changes⟩ + | input@(.letOp operation rest) => + match analyzeOp declarations summaries owner current facts operation with + | .error _ => ⟨input, {}⟩ + | .ok bound => + let nested := runWithFacts declarations summaries owner current + (bound :: facts.map Fact.forgetHeap) rest + ⟨.letOp operation nested.code, nested.changes⟩ + | input@(.case scrutinee peelNat alternatives) => + match resolveAtomFact facts scrutinee with + | .error _ => ⟨input, {}⟩ + | .ok fact => + let nested := alternatives.map + (runAlternativeWithFacts declarations summaries owner current + fact peelNat facts) + ⟨.case scrutinee peelNat + (nested.map fun result => result.alternative), + nested.foldl + (fun total result => total.add result.changes) {}⟩ + +def runAlternativeWithFacts (declarations : DeclEnv) + (summaries : SummaryEnv) (owner : Address) (current : FnDef) + (scrutineeFact : Fact) (peelNat : Bool) (facts : List Fact) : + Alt → AlternativeOutcome + | .mk cidx fields body => + let nested := runWithFacts declarations summaries owner current + (scrutineeFact.caseFields peelNat cidx fields ++ facts) body + ⟨.mk cidx fields nested.code, nested.changes⟩ + +end + +def runFunction (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Address) (current : FnDef) : Outcome := + runWithFacts declarations summaries owner current + (List.replicate current.arity Fact.top) current.body + +def rewriteFunction (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Address) (current : FnDef) : FnDef := + { current with body := (runFunction declarations summaries owner current).code } + +def rewriteDeclaration (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Address) : Decl → Decl + | .fn function => .fn (rewriteFunction declarations summaries owner function) + | declaration@(.extern _) => declaration + +@[simp] private theorem runAlternativeWithFacts_cidx + (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Address) (current : FnDef) + (scrutineeFact : Fact) (peelNat : Bool) (facts : List Fact) + (alternative : Alt) : + (runAlternativeWithFacts declarations summaries owner current + scrutineeFact peelNat facts alternative).alternative.cidx = + alternative.cidx := by + cases alternative + simp [runAlternativeWithFacts, Alt.cidx] + +private theorem runAlternativeWithFacts_predicate + (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Address) (current : FnDef) + (scrutineeFact : Fact) (peelNat : Bool) (facts : List Fact) + (index : Nat) : + ((fun alternative : Alt => alternative.cidx == index) ∘ + (fun result : AlternativeOutcome => result.alternative) ∘ + runAlternativeWithFacts declarations summaries owner current + scrutineeFact peelNat facts) = + (fun alternative => alternative.cidx == index) := by + funext alternative + cases alternative + simp [Function.comp_def, runAlternativeWithFacts, Alt.cidx] + +private theorem find?_runAlternativeWithFacts + (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Address) (current : FnDef) + (scrutineeFact : Fact) (peelNat : Bool) (facts : List Fact) + (alternatives : Array Alt) (index : Nat) : + ((alternatives.map + (runAlternativeWithFacts declarations summaries owner current + scrutineeFact peelNat facts)).map + (fun result => result.alternative)).find? + (fun alternative => alternative.cidx == index) = + (alternatives.find? (fun alternative => alternative.cidx == index)).map + (fun alternative => + (runAlternativeWithFacts declarations summaries owner current + scrutineeFact peelNat facts alternative).alternative) := by + rw [Array.map_map, Array.find?_map, + runAlternativeWithFacts_predicate declarations summaries owner current + scrutineeFact peelNat facts index] + simp [Function.comp_def] + +@[simp] theorem declArity_rewriteDeclaration + (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Address) (declaration : Decl) : + declArity (rewriteDeclaration declarations summaries owner declaration) = + declArity declaration := by + cases declaration <;> rfl + +/-! ## Checker facts used by the semantic layer -/ + +theorem scalar_of_scalarOnly_holds + {declarations : DeclEnv} {store : Store} {fact : Fact} {value : RVal} + (honly : scalarOnly fact = true) + (hholds : fact.Holds declarations store value) : + value.isScalar = true := by + unfold scalarOnly at honly + simp only [Bool.and_eq_true] at honly + cases value with + | lit literal => rfl + | erased => rfl + | loc location => + simp only [Fact.Holds] at hholds + rcases hholds with hunknown | ⟨shape, hmember, _⟩ + · have hfalse : fact.unknownHeap = false := by + simpa using honly.1 + rw [hfalse] at hunknown + contradiction + · have hempty : fact.shapes = [] := List.isEmpty_iff.mp honly.2 + rw [hempty] at hmember + contradiction + +private theorem environment_allScalar_of_all_scalarOnly + {declarations : DeclEnv} {store : Store} : + ∀ {facts : List Fact} {values : List RVal}, + EnvironmentHolds declarations store facts values → + facts.all scalarOnly = true → values.all RVal.isScalar = true + | [], [], .nil, _ => rfl + | fact :: facts, value :: values, .cons hhead htail, hall => by + simp only [List.all_cons, Bool.and_eq_true] at hall ⊢ + exact ⟨scalar_of_scalarOnly_holds hall.1 hhead, + environment_allScalar_of_all_scalarOnly htail hall.2⟩ + +private theorem allScalar_of_scalarCaptures + {declarations : DeclEnv} {store : Store} {facts : List Fact} + {environment : List RVal} {captured : Array Atom} + {values : List RVal} + (henvironment : EnvironmentHolds declarations store facts environment) + (hcheck : scalarCaptures facts captured = true) + (hresolve : resolveAtoms environment captured = .ok values) : + values.all RVal.isScalar = true := by + unfold scalarCaptures at hcheck + cases habstract : resolveAtomFacts facts captured with + | error error => simp [habstract] at hcheck + | ok captureFacts => + simp only [habstract] at hcheck + have hholds := resolveAtomFacts_sound henvironment habstract hresolve + exact environment_allScalar_of_all_scalarOnly hholds hcheck + +private theorem continue_historyIso {ctx : Ctx} {fuel : Nat} + {current : FnDef} {left right : Store} + (heap : HeapHistoryIso left right) + {leftValue rightValue retired alias : RVal} + {leftEnvironment rightEnvironment : List RVal} + (hvalue : RValIso heap.locRel leftValue rightValue) + (henvironment : RValsIso heap.locRel + leftEnvironment rightEnvironment) + {rest : Code} (hrest : CodeNoUse 1 rest) + {leftOut : Store × RVal} + (hrun : runCode ctx fuel current left + (leftValue :: retired :: leftEnvironment) rest = .ok leftOut) : + ∃ rightOut, + runCode ctx fuel current right + (rightValue :: alias :: rightEnvironment) rest = .ok rightOut ∧ + RunHistoryIso heap leftOut rightOut := by + have hleftAgree := EnvsAgreeExcept.second leftValue retired .erased + leftEnvironment + have hleftScrubbed : runCode ctx fuel current left + (leftValue :: .erased :: leftEnvironment) rest = .ok leftOut := by + rw [← runCode_env_eq_of_noUse fuel current left 1 + (leftValue :: retired :: leftEnvironment) + (leftValue :: .erased :: leftEnvironment) rest hleftAgree hrest] + exact hrun + have hscrubbedEnvironment : RValsIso heap.locRel + (leftValue :: .erased :: leftEnvironment) + (rightValue :: .erased :: rightEnvironment) := + .cons hvalue (.cons .erased henvironment) + obtain ⟨rightOut, hrightScrubbed, hresult⟩ := + runCode_historyIso heap hscrubbedEnvironment hleftScrubbed + have hrightAgree := EnvsAgreeExcept.second rightValue .erased alias + rightEnvironment + have hright : runCode ctx fuel current right + (rightValue :: alias :: rightEnvironment) rest = .ok rightOut := by + rw [← runCode_env_eq_of_noUse fuel current right 1 + (rightValue :: .erased :: rightEnvironment) + (rightValue :: alias :: rightEnvironment) rest hrightAgree hrest] + exact hrightScrubbed + exact ⟨rightOut, hright, hresult⟩ + +private theorem lowerAtom?_resolveAtom {head : RVal} {environment : List RVal} + {source target : Atom} {value : RVal} + (hlower : lowerAtom? source = some target) + (hresolve : resolveAtom (head :: environment) source = .ok value) : + resolveAtom environment target = .ok value := by + cases source with + | lit literal => + simp only [lowerAtom?, Option.some.injEq] at hlower + subst target + simpa [resolveAtom] using hresolve + | erased => + simp only [lowerAtom?, Option.some.injEq] at hlower + subst target + simpa [resolveAtom] using hresolve + | var index => + cases index with + | zero => simp [lowerAtom?] at hlower + | succ index => + simp only [lowerAtom?, Option.some.injEq] at hlower + subst target + simp only [resolveAtom] at hresolve ⊢ + cases hget : environment[index]? with + | none => simp [hget] at hresolve + | some found => simpa [hget] using hresolve + +private theorem List.resolveLoweredFrom_eq (head : RVal) + (environment : List RVal) : + ∀ (source target : List Atom) (accumulator output : List RVal), + source.mapM lowerAtom? = some target → + source.foldlM + (fun values atom => do + pure (values ++ [← resolveAtom (head :: environment) atom])) + accumulator = .ok output → + target.foldlM + (fun values atom => do + pure (values ++ [← resolveAtom environment atom])) + accumulator = .ok output := by + intro source + induction source with + | nil => + intro target accumulator output hlower hresolve + change some [] = some target at hlower + injection hlower with htarget + subst target + exact hresolve + | cons atom source ih => + intro target accumulator output hlower hresolve + simp only [List.mapM_cons] at hlower + cases hatom : lowerAtom? atom with + | none => simp [hatom] at hlower + | some lowered => + rw [hatom] at hlower + simp only [bind, Option.bind] at hlower + cases htail : source.mapM lowerAtom? with + | none => simp [htail] at hlower + | some loweredTail => + rw [htail] at hlower + change some (lowered :: loweredTail) = some target at hlower + injection hlower with htarget + subst target + simp only [List.foldlM_cons] at hresolve ⊢ + cases hsource : resolveAtom (head :: environment) atom with + | error error => + rw [hsource] at hresolve + simp only [bind, Except.bind] at hresolve + contradiction + | ok value => + rw [hsource] at hresolve + simp only [bind, Except.bind] at hresolve + have htargetResolve := lowerAtom?_resolveAtom hatom hsource + rw [htargetResolve] + simp only [bind, Except.bind] + exact ih loweredTail (accumulator ++ [value]) output htail + hresolve + +theorem lowerAtoms?_resolveAtoms {head : RVal} {environment : List RVal} + {source target : Array Atom} {values : List RVal} + (hlower : lowerAtoms? source = some target) + (hresolve : resolveAtoms (head :: environment) source = .ok values) : + resolveAtoms environment target = .ok values := by + unfold lowerAtoms? at hlower + cases hmap : source.toList.mapM lowerAtom? with + | none => simp [hmap] at hlower + | some lowered => + simp only [hmap, Option.map_some, Option.some.injEq] at hlower + subst target + unfold resolveAtoms at hresolve ⊢ + rw [← Array.foldlM_toList] at hresolve + rw [← Array.foldlM_toList] + simp only + exact List.resolveLoweredFrom_eq head environment source.toList lowered + [] values hmap hresolve + +private theorem lowerAtom?_notUseZero {source target : Atom} + (hlower : lowerAtom? source = some target) : + atomUsesVar 0 source = false := by + cases source with + | lit literal => rfl + | erased => rfl + | var index => + cases index with + | zero => simp [lowerAtom?] at hlower + | succ index => simp [atomUsesVar] + +private theorem List.all_notUseZero_of_mapM_lower : + ∀ {source target : List Atom}, source.mapM lowerAtom? = some target → + source.all (fun atom => !atomUsesVar 0 atom) = true := by + intro source + induction source with + | nil => intro target hlower; rfl + | cons atom source ih => + intro target hlower + simp only [List.mapM_cons] at hlower + cases hatom : lowerAtom? atom with + | none => simp [hatom] at hlower + | some lowered => + rw [hatom] at hlower + simp only [bind, Option.bind] at hlower + cases htail : source.mapM lowerAtom? with + | none => simp [htail] at hlower + | some loweredTail => + have hhead := lowerAtom?_notUseZero hatom + simp only [List.all_cons, Bool.and_eq_true] + exact ⟨by simp [hhead], ih htail⟩ + +theorem lowerAtoms?_notUseZero {source target : Array Atom} + (hlower : lowerAtoms? source = some target) : + atomsUseVar 0 source = false := by + unfold lowerAtoms? at hlower + cases hmap : source.toList.mapM lowerAtom? with + | none => simp [hmap] at hlower + | some lowered => + have hall := List.all_notUseZero_of_mapM_lower hmap + unfold atomsUseVar + rw [Array.any_eq_false'] + intro atom hatom huses + have hnot := List.all_eq_true.mp hall atom (by simpa using hatom) + simp [huses] at hnot + +private def resolveStep (environment : List RVal) + (values : List RVal) (atom : Atom) : Except Err (List RVal) := do + pure (values ++ [← resolveAtom environment atom]) + +private inductive AtomsResolve (environment : List RVal) : + List Atom → List RVal → Prop where + | nil : AtomsResolve environment [] [] + | cons (hhead : resolveAtom environment atom = .ok value) + (htail : AtomsResolve environment atoms values) : + AtomsResolve environment (atom :: atoms) (value :: values) + +namespace AtomsResolve + +private theorem foldlM {environment : List RVal} : + ∀ {atoms values}, AtomsResolve environment atoms values → + ∀ accumulator, + atoms.foldlM (resolveStep environment) accumulator = + .ok (accumulator ++ values) + | [], [], .nil, accumulator => by + simp only [List.foldlM_nil, pure, Except.pure, List.append_nil] + | atom :: atoms, value :: values, .cons hhead htail, accumulator => by + have hstep : resolveStep environment accumulator atom = + .ok (accumulator ++ [value]) := by + simp [resolveStep, hhead, bind, Except.bind, pure, Except.pure] + rw [List.foldlM_cons, hstep] + simp only [bind, Except.bind] + rw [htail.foldlM (accumulator ++ [value])] + simp [List.append_assoc] + +private theorem ofFoldlM {environment : List RVal} : + ∀ atoms accumulator output, + atoms.foldlM (resolveStep environment) accumulator = .ok output → + ∃ values, AtomsResolve environment atoms values ∧ + output = accumulator ++ values := by + intro atoms + induction atoms with + | nil => + intro accumulator output hrun + simp only [List.foldlM_nil, pure, Except.pure] at hrun + injection hrun with houtput + subst output + exact ⟨[], .nil, by simp⟩ + | cons atom atoms ih => + intro accumulator output hrun + simp only [List.foldlM_cons] at hrun + cases hhead : resolveAtom environment atom with + | error error => + have hstep : resolveStep environment accumulator atom = + .error error := by + simp [resolveStep, hhead, bind, Except.bind] + rw [hstep] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok value => + have hstep : resolveStep environment accumulator atom = + .ok (accumulator ++ [value]) := by + simp [resolveStep, hhead, bind, Except.bind, pure, Except.pure] + rw [hstep] at hrun + simp only [bind, Except.bind] at hrun + obtain ⟨values, hvalues, houtput⟩ := + ih (accumulator ++ [value]) output hrun + refine ⟨value :: values, .cons hhead hvalues, ?_⟩ + rw [houtput] + simp [List.append_assoc] + +theorem length {environment : List RVal} {atoms : List Atom} + {values : List RVal} (h : AtomsResolve environment atoms values) : + values.length = atoms.length := by + induction h <;> simp_all + +theorem append {environment : List RVal} + {leftAtoms rightAtoms : List Atom} {leftValues rightValues : List RVal} + (left : AtomsResolve environment leftAtoms leftValues) + (right : AtomsResolve environment rightAtoms rightValues) : + AtomsResolve environment (leftAtoms ++ rightAtoms) + (leftValues ++ rightValues) := by + induction left with + | nil => exact right + | cons hhead htail ih => exact .cons hhead ih + +theorem take {environment : List RVal} {atoms : List Atom} + {values : List RVal} (h : AtomsResolve environment atoms values) + (count : Nat) : + AtomsResolve environment (atoms.take count) (values.take count) := by + induction h generalizing count with + | nil => simpa using (AtomsResolve.nil (environment := environment)) + | cons hhead htail ih => + cases count with + | zero => exact .nil + | succ count => exact .cons hhead (ih count) + +theorem drop {environment : List RVal} {atoms : List Atom} + {values : List RVal} (h : AtomsResolve environment atoms values) + (count : Nat) : + AtomsResolve environment (atoms.drop count) (values.drop count) := by + induction h generalizing count with + | nil => simpa using (AtomsResolve.nil (environment := environment)) + | cons hhead htail ih => + cases count with + | zero => exact .cons hhead htail + | succ count => exact ih count + +end AtomsResolve + +private theorem atomsResolve_of_resolveAtoms {environment : List RVal} + {atoms : Array Atom} {values : List RVal} + (hrun : resolveAtoms environment atoms = .ok values) : + AtomsResolve environment atoms.toList values := by + unfold resolveAtoms at hrun + rw [← Array.foldlM_toList] at hrun + change atoms.toList.foldlM (resolveStep environment) [] = + .ok values at hrun + obtain ⟨found, hfound, hvalues⟩ := + AtomsResolve.ofFoldlM atoms.toList [] values hrun + simp only [List.nil_append] at hvalues + subst found + exact hfound + +private theorem resolveAtoms_of_atomsResolve {environment : List RVal} + {atoms : Array Atom} {values : List RVal} + (h : AtomsResolve environment atoms.toList values) : + resolveAtoms environment atoms = .ok values := by + unfold resolveAtoms + rw [← Array.foldlM_toList] + change atoms.toList.foldlM (resolveStep environment) [] = .ok values + simpa using h.foldlM [] + +private theorem resolveAtoms_length {environment : List RVal} + {atoms : Array Atom} {values : List RVal} + (hrun : resolveAtoms environment atoms = .ok values) : + values.length = atoms.size := by + simpa using (atomsResolve_of_resolveAtoms hrun).length + +private theorem resolveAtoms_take {environment : List RVal} + {atoms : List Atom} {values : List RVal} + (hrun : resolveAtoms environment atoms.toArray = .ok values) + (count : Nat) : + resolveAtoms environment (atoms.take count).toArray = + .ok (values.take count) := by + apply resolveAtoms_of_atomsResolve + simpa using (atomsResolve_of_resolveAtoms hrun).take count + +private theorem resolveAtoms_drop {environment : List RVal} + {atoms : List Atom} {values : List RVal} + (hrun : resolveAtoms environment atoms.toArray = .ok values) + (count : Nat) : + resolveAtoms environment (atoms.drop count).toArray = + .ok (values.drop count) := by + apply resolveAtoms_of_atomsResolve + simpa using (atomsResolve_of_resolveAtoms hrun).drop count + +private theorem resolveAtoms_append {environment : List RVal} + {left right : List Atom} {leftValues rightValues : List RVal} + (hleft : resolveAtoms environment left.toArray = .ok leftValues) + (hright : resolveAtoms environment right.toArray = .ok rightValues) : + resolveAtoms environment (left ++ right).toArray = + .ok (leftValues ++ rightValues) := by + apply resolveAtoms_of_atomsResolve + simpa using (atomsResolve_of_resolveAtoms hleft).append + (atomsResolve_of_resolveAtoms hright) + +private theorem resolveAtom_selfIso {rel : Nat → Nat → Prop} + {environment : List RVal} (henvironment : RValsIso rel environment environment) + {atom : Atom} {value : RVal} + (hresolve : resolveAtom environment atom = .ok value) : + RValIso rel value value := by + cases atom with + | lit literal => + simp only [resolveAtom, Except.ok.injEq] at hresolve + subst value + exact .lit + | erased => + simp only [resolveAtom, Except.ok.injEq] at hresolve + subst value + exact .erased + | var index => + simp only [resolveAtom] at hresolve + cases hget : environment[index]? with + | none => simp [hget] at hresolve + | some found => + simp only [hget, Except.ok.injEq] at hresolve + subst value + obtain ⟨other, hother, hiso⟩ := henvironment.get? hget + have hsame : other = found := Option.some.inj (hother.symm.trans hget) + subst other + exact hiso + +private theorem AtomsResolve.selfIso {rel : Nat → Nat → Prop} + {environment : List RVal} (henvironment : RValsIso rel environment environment) : + ∀ {atoms values}, AtomsResolve environment atoms values → + RValsIso rel values values + | [], [], .nil => .nil + | _ :: _, _ :: _, .cons hhead htail => + .cons (resolveAtom_selfIso henvironment hhead) + (selfIso henvironment htail) + +private theorem runHistoryIso_weaken + {earlierLeft earlierRight left right : Store} + {earlier : HeapHistoryIso earlierLeft earlierRight} + {before : HeapHistoryIso left right} + (hearlier : earlier.Extends before) + {leftOut rightOut : Store × RVal} + (hrun : RunHistoryIso before leftOut rightOut) : + RunHistoryIso earlier leftOut rightOut := by + obtain ⟨heap, hextends, hvalue⟩ := hrun + exact ⟨heap, hearlier.trans hextends, hvalue⟩ + +private structure PairRunAt (ctx : Ctx) (fuel : Nat) (current : FnDef) + (store : Store) (environment : List RVal) (function : Address) + (declaration : Decl) (captured supplied : Array Atom) (rest : Code) + (out : Store × RVal) where + capturedValues : List RVal + suppliedValues : List RVal + resultStore : Store + resultValue : RVal + capturedResolve : resolveAtoms environment captured = .ok capturedValues + suppliedResolve : + let allocated := store.allocNode .shared + (.papN function (declArity declaration) capturedValues.toArray) + resolveAtoms (.loc allocated.2 :: environment) supplied = + .ok suppliedValues + applyRun : + let allocated := store.allocNode .shared + (.papN function (declArity declaration) capturedValues.toArray) + applyGo ctx (fuel + 1) allocated.1 (.loc allocated.2) suppliedValues = + .ok (resultStore, resultValue) + restRun : + let allocated := store.allocNode .shared + (.papN function (declArity declaration) capturedValues.toArray) + runCode ctx (fuel + 2) current resultStore + (resultValue :: .loc allocated.2 :: environment) rest = .ok out + +private def pairRunAt_of_run + {ctx : Ctx} {fuel : Nat} {current : FnDef} {store : Store} + {environment : List RVal} {function : Address} + {captured supplied : Array Atom} {rest : Code} + {declaration : Decl} {out : Store × RVal} + (hdeclaration : ctx.decls function = some declaration) + (hcapture : captured.size < declArity declaration) + (hrun : runCode ctx (fuel + 4) current store environment + (.letOp (.papp function captured) + (.letOp (.apply (.var 0) supplied) rest)) = .ok out) : + PairRunAt ctx fuel current store environment function declaration captured + supplied rest out := by + rw [runCode.eq_def] at hrun + dsimp only at hrun + rw [runOp.eq_def] at hrun + dsimp only at hrun + cases hcaptured : resolveAtoms environment captured with + | error error => + rw [hcaptured] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok capturedValues => + rw [hcaptured] at hrun + simp only [bind, Except.bind] at hrun + rw [hdeclaration] at hrun + have hcapturedLength := resolveAtoms_length hcaptured + have hproper : capturedValues.length < declArity declaration := by + omega + simp only [hproper, if_true, bind, Except.bind] at hrun + rw [runCode.eq_def] at hrun + dsimp only at hrun + rw [runOp.eq_def] at hrun + dsimp only at hrun + simp only [resolveAtom, List.getElem?_cons_zero, bind, Except.bind] at hrun + let allocated := store.allocNode .shared + (.papN function (declArity declaration) capturedValues.toArray) + cases hsupplied : resolveAtoms (.loc allocated.2 :: environment) supplied with + | error error => + rw [hsupplied] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok suppliedValues => + rw [hsupplied] at hrun + simp only [bind, Except.bind] at hrun + cases happly : applyGo ctx (fuel + 1) allocated.1 + (.loc allocated.2) suppliedValues with + | error error => + rw [happly] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok result => + rcases result with ⟨resultStore, resultValue⟩ + rw [happly] at hrun + simp only [bind, Except.bind] at hrun + refine + { capturedValues := capturedValues + suppliedValues := suppliedValues + resultStore := resultStore + resultValue := resultValue + capturedResolve := hcaptured + suppliedResolve := ?_ + applyRun := ?_ + restRun := ?_ } + · simpa [allocated] using hsupplied + · simpa [allocated] using happly + · simpa [allocated] using hrun + +private theorem dupVals_eq_of_all_scalar {store : Store} : + ∀ {values : List RVal}, values.all RVal.isScalar = true → + dupVals store values = .ok store + | [], _ => rfl + | value :: values, hscalar => by + simp only [List.all_cons, Bool.and_eq_true] at hscalar + cases value with + | loc location => simp [RVal.isScalar] at hscalar + | lit literal => + simp only [dupVals, List.foldlM_cons] + exact dupVals_eq_of_all_scalar hscalar.2 + | erased => + simp only [dupVals, List.foldlM_cons] + exact dupVals_eq_of_all_scalar hscalar.2 + +private theorem dropMany_eq_of_all_scalar {ctx : Ctx} : + ∀ fuel store values out, + values.all RVal.isScalar = true → + dropMany ctx fuel store values = .ok out → out = store := by + intro fuel + induction fuel with + | zero => + intro store values out hscalar hrun + simp [dropMany] at hrun + | succ fuel smaller => + intro store values out hscalar hrun + cases values with + | nil => + simp only [dropMany, Except.ok.injEq] at hrun + exact hrun.symm + | cons value values => + simp only [List.all_cons, Bool.and_eq_true] at hscalar + cases value with + | loc location => simp [RVal.isScalar] at hscalar + | lit literal => + cases fuel with + | zero => + simp only [dropMany, dropVal, bind, Except.bind] at hrun + contradiction + | succ fuel => + simp only [dropMany, dropVal, bind, Except.bind] at hrun + exact smaller store values out hscalar.2 hrun + | erased => + cases fuel with + | zero => + simp only [dropMany, dropVal, bind, Except.bind] at hrun + contradiction + | succ fuel => + simp only [dropMany, dropVal, bind, Except.bind] at hrun + exact smaller store values out hscalar.2 hrun + +private theorem dropFreshPap_nodes {ctx : Ctx} {fuel : Nat} {store out : Store} + {function : Address} {arity : Nat} {arguments : List RVal} + (hscalar : arguments.all RVal.isScalar = true) + (hrun : + let allocated := store.allocNode .shared + (.papN function arity arguments.toArray) + dropVal ctx fuel allocated.1 (.loc allocated.2) = .ok out) : + out.nodes = + (let allocated := store.allocNode .shared + (.papN function arity arguments.toArray) + allocated.1.kill allocated.2).nodes := by + cases fuel with + | zero => simp [dropVal] at hrun + | succ fuel => + simp only [dropVal] at hrun + simp [Store.allocNode, Store.get?] at hrun + have hout := dropMany_eq_of_all_scalar fuel + ((store.allocNode .shared + (.papN function arity arguments.toArray)).1.rcTick.kill + (store.allocNode .shared + (.papN function arity arguments.toArray)).2) + arguments out hscalar hrun + subst out + rfl + +private structure FreshApplyReady (ctx : Ctx) (fuel : Nat) + (store : Store) (function : Address) (arity : Nat) + (capturedValues suppliedValues : List RVal) + (out : Store × RVal) where + ready : Store + dropRun : + let allocated := store.allocNode .shared + (.papN function arity capturedValues.toArray) + dropVal ctx fuel allocated.1 (.loc allocated.2) = .ok ready + readyNodes : + let allocated := store.allocNode .shared + (.papN function arity capturedValues.toArray) + ready.nodes = (allocated.1.kill allocated.2).nodes + remainderRun : + (let total := capturedValues ++ suppliedValues + if total.length < arity then + let (next, location) := ready.allocNode .shared + (.papN function arity total.toArray) + Except.ok (next, .loc location) + else if total.length == arity then + match ctx.decls function with + | none => Except.error (Err.unknownRef function) + | some declaration => + if declPapSafe declaration then + invoke ctx fuel function total ready + else Except.error (.stuck "shared pap targets a non-pap-safe declaration") + else + match ctx.decls function with + | none => Except.error (Err.unknownRef function) + | some declaration => + if declPapSafe declaration then do + let (called, value) ← invoke ctx fuel function (total.take arity) ready + applyGo ctx fuel called value (total.drop arity) + else Except.error (.stuck "shared pap targets a non-pap-safe declaration")) = + Except.ok out + +private def freshApplyReady_of_run + {ctx : Ctx} {fuel : Nat} {store : Store} {function : Address} + {arity : Nat} {capturedValues suppliedValues : List RVal} + {out : Store × RVal} + (hscalar : capturedValues.all RVal.isScalar = true) + (hrun : + let allocated := store.allocNode .shared + (.papN function arity capturedValues.toArray) + applyGo ctx (fuel + 1) allocated.1 (.loc allocated.2) suppliedValues = + .ok out) : + FreshApplyReady ctx fuel store function arity capturedValues suppliedValues + out := by + let allocated := store.allocNode .shared + (.papN function arity capturedValues.toArray) + change applyGo ctx (fuel + 1) allocated.1 (.loc allocated.2) + suppliedValues = .ok out at hrun + rw [applyGo.eq_def] at hrun + dsimp only at hrun + have hget : allocated.1.get? allocated.2 = + some ⟨.shared, 1, .papN function arity capturedValues.toArray⟩ := by + simp [allocated, Store.allocNode, Store.get?] + rw [hget] at hrun + dsimp only at hrun + rw [dupVals_eq_of_all_scalar hscalar] at hrun + simp only [bind, Except.bind] at hrun + cases hdrop : dropVal ctx fuel allocated.1 (.loc allocated.2) with + | error error => + rw [hdrop] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok ready => + rw [hdrop] at hrun + simp only [bind, Except.bind] at hrun + exact + { ready := ready + dropRun := by simpa [allocated] using hdrop + readyNodes := by + exact dropFreshPap_nodes hscalar (by simpa [allocated] using hdrop) + remainderRun := hrun } + +private theorem List.drop_append_after_prefix : + ∀ (front suffix : List α) (count : Nat), front.length ≤ count → + (front ++ suffix).drop count = suffix.drop (count - front.length) := by + intro front + induction front with + | nil => intro suffix count hle; simp + | cons head tail ih => + intro suffix count hle + cases count with + | zero => simp at hle + | succ count => + have htail : tail.length ≤ count := by + simpa using hle + simp only [List.cons_append, List.drop_succ_cons, List.length_cons, + Nat.succ_sub_succ_eq_sub] + exact ih suffix count htail + +/-! ## Local semantic refinement + +The source and replacement use the same outer fuel. The source's retired +PAP allocation is omitted from the right-hand heap history; subsequent +allocations and calls are related by the evaluator congruence theorem. -/ + +private theorem fuseSpec_refinesAt + {ctx : Ctx} {fuel : Nat} {current : FnDef} {store : Store} + {environment : List RVal} {declarations : DeclEnv} {facts : List Fact} + {function : Address} {captured supplied : Array Atom} {rest : Code} + {fusion : Fusion} {out : Store × RVal} + (hctx : ctx.decls = declarations) + (base : HeapHistoryIso store store) + (henvIso : RValsIso base.locRel environment environment) + (henvironment : EnvironmentHolds declarations store facts environment) + (hspec : FuseSpec declarations facts function captured supplied rest + fusion) + (hrun : runCode ctx (fuel + 4) current store environment + (.letOp (.papp function captured) + (.letOp (.apply (.var 0) supplied) rest)) = .ok out) : + ∃ targetOut, + runCode ctx (fuel + 4) current store environment fusion.code = + .ok targetOut ∧ + RunHistoryIso base out targetOut := by + cases hspec with + | @under declaration lowered hdeclaration hcaptureArity hscalar hrest + hlowered hunder => + have hctxDeclaration : ctx.decls function = some declaration := by + simpa [hctx] using hdeclaration + obtain ⟨capturedValues, suppliedValues, resultStore, resultValue, + hcaptured, hsupplied, happly, hrestRun⟩ := + pairRunAt_of_run hctxDeclaration hcaptureArity hrun + have hscalarValues := + allScalar_of_scalarCaptures henvironment hscalar hcaptured + obtain ⟨ready, hdrop, hreadyNodes, hremainder⟩ := + freshApplyReady_of_run hscalarValues happly + let allocated := store.allocNode .shared + (.papN function (declArity declaration) capturedValues.toArray) + have hsupplied' : resolveAtoms (.loc allocated.2 :: environment) + supplied = .ok suppliedValues := by + simpa [allocated] using hsupplied + have hloweredResolve : resolveAtoms environment lowered = + .ok suppliedValues := + lowerAtoms?_resolveAtoms hlowered hsupplied' + have hcombinedResolve : + resolveAtoms environment + (captured.toList ++ lowered.toList).toArray = + .ok (capturedValues ++ suppliedValues) := by + exact resolveAtoms_append (by simpa using hcaptured) + (by simpa using hloweredResolve) + have hcapturedLength : capturedValues.length = captured.size := + resolveAtoms_length hcaptured + have hloweredLength : suppliedValues.length = lowered.size := + resolveAtoms_length hloweredResolve + have htotalUnder : + (capturedValues ++ suppliedValues).length < + declArity declaration := by + simpa [List.length_append, hcapturedLength, hloweredLength] using hunder + have htotalUnder' : capturedValues.length + suppliedValues.length < + declArity declaration := by + simpa using htotalUnder + let sourceAllocated := ready.allocNode .shared + (.papN function (declArity declaration) + (capturedValues ++ suppliedValues).toArray) + have hremainder' : + (.ok (sourceAllocated.1, .loc sourceAllocated.2) : + Except Err (Store × RVal)) = + .ok (resultStore, resultValue) := by + simpa [sourceAllocated, htotalUnder'] using hremainder + have hresultPair : + (sourceAllocated.1, .loc sourceAllocated.2) = + (resultStore, resultValue) := Except.ok.inj hremainder' + have hresultStore : resultStore = sourceAllocated.1 := by + exact (congrArg Prod.fst hresultPair).symm + have hresultValue : resultValue = .loc sourceAllocated.2 := by + exact (congrArg Prod.snd hresultPair).symm + subst resultStore + subst resultValue + let omitted := base.omitDeadAllocLeft .shared + (.papN function (declArity declaration) capturedValues.toArray) + let readyHeap : HeapHistoryIso ready store := + omitted.nodesEq hreadyNodes rfl + have henvReady : RValsIso readyHeap.locRel environment environment := by + change RValsIso base.locRel environment environment + exact henvIso + have hcapturedIso : RValsIso readyHeap.locRel + capturedValues capturedValues := by + change RValsIso base.locRel capturedValues capturedValues + exact (atomsResolve_of_resolveAtoms hcaptured).selfIso henvIso + have hloweredIso : RValsIso readyHeap.locRel + suppliedValues suppliedValues := by + change RValsIso base.locRel suppliedValues suppliedValues + exact (atomsResolve_of_resolveAtoms hloweredResolve).selfIso henvIso + have htotalIso : RValsIso readyHeap.locRel + (capturedValues ++ suppliedValues) + (capturedValues ++ suppliedValues) := + hcapturedIso.append hloweredIso + let targetAllocated := store.allocNode .shared + (.papN function (declArity declaration) + (capturedValues ++ suppliedValues).toArray) + let finalHeap : HeapHistoryIso sourceAllocated.1 targetAllocated.1 := + readyHeap.alloc (.pap (by simpa using htotalIso)) + have hvalueIso : RValIso finalHeap.locRel + (.loc sourceAllocated.2) (.loc targetAllocated.2) := by + exact .loc (.inl ⟨rfl, rfl⟩) + have henvFinal : RValsIso finalHeap.locRel + environment environment := + henvReady.mono (fun h => .inr h) + obtain ⟨targetOut, htargetRest, hrestIso⟩ := + continue_historyIso finalHeap hvalueIso henvFinal + (codeNoUse_of_codeUsesVar_eq_false hrest) hrestRun + have htargetOuter : runOp ctx (fuel + 3) current store environment + (.papp function + (captured.toList ++ lowered.toList).toArray) = + .ok (targetAllocated.1, .loc targetAllocated.2) := by + rw [runOp.eq_def] + dsimp only + rw [hcombinedResolve] + simp only [bind, Except.bind] + rw [hctxDeclaration] + simp only [htotalUnder, if_true] + rfl + have htargetInner : runOp ctx (fuel + 2) current targetAllocated.1 + (.loc targetAllocated.2 :: environment) (.pure (.var 0)) = + .ok (targetAllocated.1, .loc targetAllocated.2) := by + rw [runOp.eq_def] + rfl + have htargetRun : runCode ctx (fuel + 4) current store environment + (.letOp + (.papp function + (captured.toList ++ lowered.toList).toArray) + (.letOp (.pure (.var 0)) rest)) = .ok targetOut := by + rw [runCode.eq_def] + dsimp only + rw [htargetOuter] + simp only [bind, Except.bind] + rw [runCode.eq_def] + dsimp only + rw [htargetInner] + simp only [bind, Except.bind] + exact htargetRest + refine ⟨targetOut, htargetRun, ?_⟩ + change RunHistoryIso base out targetOut + apply runHistoryIso_weaken (earlier := base) (before := finalHeap) + (hrun := hrestIso) + intro left right hrel + exact .inr hrel + | @exact declaration lowered hdeclaration hcaptureArity hscalar hrest + hlowered hexact => + have hctxDeclaration : ctx.decls function = some declaration := by + simpa [hctx] using hdeclaration + obtain ⟨capturedValues, suppliedValues, resultStore, resultValue, + hcaptured, hsupplied, happly, hrestRun⟩ := + pairRunAt_of_run hctxDeclaration hcaptureArity hrun + have hscalarValues := + allScalar_of_scalarCaptures henvironment hscalar hcaptured + obtain ⟨ready, hdrop, hreadyNodes, hremainder⟩ := + freshApplyReady_of_run hscalarValues happly + let allocated := store.allocNode .shared + (.papN function (declArity declaration) capturedValues.toArray) + have hsupplied' : resolveAtoms (.loc allocated.2 :: environment) + supplied = .ok suppliedValues := by + simpa [allocated] using hsupplied + have hloweredResolve : resolveAtoms environment lowered = + .ok suppliedValues := + lowerAtoms?_resolveAtoms hlowered hsupplied' + have hcombinedResolve : + resolveAtoms environment + (captured.toList ++ lowered.toList).toArray = + .ok (capturedValues ++ suppliedValues) := by + exact resolveAtoms_append (by simpa using hcaptured) + (by simpa using hloweredResolve) + have hcapturedLength : capturedValues.length = captured.size := + resolveAtoms_length hcaptured + have hloweredLength : suppliedValues.length = lowered.size := + resolveAtoms_length hloweredResolve + have htotalExact : + (capturedValues ++ suppliedValues).length = + declArity declaration := by + simpa [List.length_append, hcapturedLength, hloweredLength] using hexact + have htotalExact' : capturedValues.length + suppliedValues.length = + declArity declaration := by + simpa using htotalExact + have hpapsafe : declPapSafe declaration = true := by + cases hpapsafe : declPapSafe declaration with + | false => + simp [htotalExact', hctxDeclaration, hpapsafe] at hremainder + | true => rfl + have hremainder' : invoke ctx fuel function + (capturedValues ++ suppliedValues) ready = + .ok (resultStore, resultValue) := by + simpa [htotalExact', hctxDeclaration, hpapsafe] using hremainder + let omitted := base.omitDeadAllocLeft .shared + (.papN function (declArity declaration) capturedValues.toArray) + let readyHeap : HeapHistoryIso ready store := + omitted.nodesEq hreadyNodes rfl + have henvReady : RValsIso readyHeap.locRel environment environment := by + change RValsIso base.locRel environment environment + exact henvIso + have hcapturedIso : RValsIso readyHeap.locRel + capturedValues capturedValues := by + change RValsIso base.locRel capturedValues capturedValues + exact (atomsResolve_of_resolveAtoms hcaptured).selfIso henvIso + have hloweredIso : RValsIso readyHeap.locRel + suppliedValues suppliedValues := by + change RValsIso base.locRel suppliedValues suppliedValues + exact (atomsResolve_of_resolveAtoms hloweredResolve).selfIso henvIso + have htotalIso : RValsIso readyHeap.locRel + (capturedValues ++ suppliedValues) + (capturedValues ++ suppliedValues) := + hcapturedIso.append hloweredIso + obtain ⟨targetCallOut, htargetInvokeAt, hcallIso⟩ := + invoke_historyIso readyHeap htotalIso hremainder' + rcases targetCallOut with ⟨targetStore, targetValue⟩ + obtain ⟨callHeap, hreadyCall, hvalueIso⟩ := hcallIso + have htargetInvoke : invoke ctx (fuel + 2) function + (capturedValues ++ suppliedValues) store = + .ok (targetStore, targetValue) := + invoke_mono (by omega) htargetInvokeAt + have henvCall : RValsIso callHeap.locRel environment environment := + hreadyCall.rvals henvReady + obtain ⟨targetOut, htargetRest, hrestIso⟩ := + continue_historyIso callHeap hvalueIso henvCall + (codeNoUse_of_codeUsesVar_eq_false hrest) hrestRun + have htargetOuter : runOp ctx (fuel + 3) current store environment + (.call function + (captured.toList ++ lowered.toList).toArray) = + .ok (targetStore, targetValue) := by + rw [runOp.eq_def] + dsimp only + rw [hcombinedResolve] + simp only [bind, Except.bind] + exact htargetInvoke + have htargetInner : runOp ctx (fuel + 2) current targetStore + (targetValue :: environment) (.pure (.var 0)) = + .ok (targetStore, targetValue) := by + rw [runOp.eq_def] + rfl + have htargetRun : runCode ctx (fuel + 4) current store environment + (.letOp + (.call function + (captured.toList ++ lowered.toList).toArray) + (.letOp (.pure (.var 0)) rest)) = .ok targetOut := by + rw [runCode.eq_def] + dsimp only + rw [htargetOuter] + simp only [bind, Except.bind] + rw [runCode.eq_def] + dsimp only + rw [htargetInner] + simp only [bind, Except.bind] + exact htargetRest + refine ⟨targetOut, htargetRun, ?_⟩ + change RunHistoryIso base out targetOut + apply runHistoryIso_weaken (earlier := base) (before := callHeap) + (hrun := hrestIso) + exact (fun h => hreadyCall h) + | @over declaration lowered hdeclaration hcaptureArity hscalar hrest + hlowered hover => + have hctxDeclaration : ctx.decls function = some declaration := by + simpa [hctx] using hdeclaration + obtain ⟨capturedValues, suppliedValues, resultStore, resultValue, + hcaptured, hsupplied, happly, hrestRun⟩ := + pairRunAt_of_run hctxDeclaration hcaptureArity hrun + have hscalarValues := + allScalar_of_scalarCaptures henvironment hscalar hcaptured + obtain ⟨ready, hdrop, hreadyNodes, hremainder⟩ := + freshApplyReady_of_run hscalarValues happly + let allocated := store.allocNode .shared + (.papN function (declArity declaration) capturedValues.toArray) + have hsupplied' : resolveAtoms (.loc allocated.2 :: environment) + supplied = .ok suppliedValues := by + simpa [allocated] using hsupplied + have hloweredResolve : resolveAtoms environment lowered = + .ok suppliedValues := + lowerAtoms?_resolveAtoms hlowered hsupplied' + have hcombinedResolve : + resolveAtoms environment + (captured.toList ++ lowered.toList).toArray = + .ok (capturedValues ++ suppliedValues) := by + exact resolveAtoms_append (by simpa using hcaptured) + (by simpa using hloweredResolve) + have hcapturedLength : capturedValues.length = captured.size := + resolveAtoms_length hcaptured + have hloweredLength : suppliedValues.length = lowered.size := + resolveAtoms_length hloweredResolve + have htotalOver : declArity declaration < + (capturedValues ++ suppliedValues).length := by + simpa [List.length_append, hcapturedLength, hloweredLength] using hover + have htotalOver' : declArity declaration < + capturedValues.length + suppliedValues.length := by + simpa using htotalOver + have hnotUnder : ¬ capturedValues.length + suppliedValues.length < + declArity declaration := by + omega + have hnotExact : capturedValues.length + suppliedValues.length ≠ + declArity declaration := by + omega + have hpapsafe : declPapSafe declaration = true := by + cases hpapsafe : declPapSafe declaration with + | false => + simp [hnotUnder, hnotExact, hctxDeclaration, hpapsafe] + at hremainder + | true => rfl + have hremainder' : + (do + let (called, value) ← invoke ctx fuel function + ((capturedValues ++ suppliedValues).take + (declArity declaration)) ready + applyGo ctx fuel called value + ((capturedValues ++ suppliedValues).drop + (declArity declaration))) = .ok (resultStore, resultValue) := by + simpa [hnotUnder, hnotExact, hctxDeclaration, hpapsafe] using hremainder + let omitted := base.omitDeadAllocLeft .shared + (.papN function (declArity declaration) capturedValues.toArray) + let readyHeap : HeapHistoryIso ready store := + omitted.nodesEq hreadyNodes rfl + have henvReady : RValsIso readyHeap.locRel environment environment := by + change RValsIso base.locRel environment environment + exact henvIso + have hcapturedIso : RValsIso readyHeap.locRel + capturedValues capturedValues := by + change RValsIso base.locRel capturedValues capturedValues + exact (atomsResolve_of_resolveAtoms hcaptured).selfIso henvIso + have hloweredIso : RValsIso readyHeap.locRel + suppliedValues suppliedValues := by + change RValsIso base.locRel suppliedValues suppliedValues + exact (atomsResolve_of_resolveAtoms hloweredResolve).selfIso henvIso + have htotalIso : RValsIso readyHeap.locRel + (capturedValues ++ suppliedValues) + (capturedValues ++ suppliedValues) := + hcapturedIso.append hloweredIso + have hfirstResolve : resolveAtoms environment + ((captured.toList ++ lowered.toList).take + (declArity declaration)).toArray = + .ok ((capturedValues ++ suppliedValues).take + (declArity declaration)) := + resolveAtoms_take hcombinedResolve (declArity declaration) + have hprefixLe : capturedValues.length ≤ declArity declaration := by + omega + have hdropIdentity : + (capturedValues ++ suppliedValues).drop (declArity declaration) = + suppliedValues.drop + (declArity declaration - captured.size) := by + simpa [hcapturedLength] using + List.drop_append_after_prefix capturedValues suppliedValues + (declArity declaration) hprefixLe + cases hsourceInvoke : invoke ctx fuel function + ((capturedValues ++ suppliedValues).take + (declArity declaration)) ready with + | error error => + rw [hsourceInvoke] at hremainder' + simp only [bind, Except.bind] at hremainder' + contradiction + | ok sourceCallOut => + rcases sourceCallOut with ⟨sourceCallStore, sourceCallValue⟩ + rw [hsourceInvoke] at hremainder' + simp only [bind, Except.bind] at hremainder' + obtain ⟨targetCallOut, htargetInvokeAt, hcallIso⟩ := + invoke_historyIso readyHeap + (htotalIso.take (declArity declaration)) hsourceInvoke + rcases targetCallOut with ⟨targetCallStore, targetCallValue⟩ + obtain ⟨callHeap, hreadyCall, hcallValueIso⟩ := hcallIso + have htargetInvoke : invoke ctx (fuel + 2) function + ((capturedValues ++ suppliedValues).take + (declArity declaration)) store = + .ok (targetCallStore, targetCallValue) := + invoke_mono (by omega) htargetInvokeAt + have hheads : EnvsAgreeExcept 0 + (.loc allocated.2 :: environment) + (targetCallValue :: environment) := by + intro index hindex + cases index with + | zero => exact False.elim (hindex rfl) + | succ index => rfl + have hsuppliedTarget : + resolveAtoms (targetCallValue :: environment) supplied = + .ok suppliedValues := by + rw [← resolveAtoms_env_eq hheads + (lowerAtoms?_notUseZero hlowered)] + exact hsupplied' + have hremainingResolve : + resolveAtoms (targetCallValue :: environment) + (supplied.toList.drop + (declArity declaration - captured.size)).toArray = + .ok (suppliedValues.drop + (declArity declaration - captured.size)) := + resolveAtoms_drop (by simpa using hsuppliedTarget) + (declArity declaration - captured.size) + have hresidualIso : RValsIso callHeap.locRel + ((capturedValues ++ suppliedValues).drop + (declArity declaration)) + (suppliedValues.drop + (declArity declaration - captured.size)) := by + rw [← hdropIdentity] + exact hreadyCall.rvals + (htotalIso.drop (declArity declaration)) + obtain ⟨targetApplyOut, htargetApplyAt, happlyIso⟩ := + applyGo_historyIso callHeap hcallValueIso hresidualIso hremainder' + rcases targetApplyOut with ⟨targetStore, targetValue⟩ + obtain ⟨applyHeap, hcallApply, hvalueIso⟩ := happlyIso + have htargetApply : applyGo ctx (fuel + 1) targetCallStore + targetCallValue + (suppliedValues.drop + (declArity declaration - captured.size)) = + .ok (targetStore, targetValue) := + applyGo_mono (by omega) htargetApplyAt + have henvApply : RValsIso applyHeap.locRel + environment environment := + hcallApply.rvals (hreadyCall.rvals henvReady) + obtain ⟨targetOut, htargetRest, hrestIso⟩ := + continue_historyIso applyHeap hvalueIso henvApply + (codeNoUse_of_codeUsesVar_eq_false hrest) hrestRun + have htargetOuter : runOp ctx (fuel + 3) current store environment + (.call function + ((captured.toList ++ lowered.toList).take + (declArity declaration)).toArray) = + .ok (targetCallStore, targetCallValue) := by + rw [runOp.eq_def] + dsimp only + rw [hfirstResolve] + simp only [bind, Except.bind] + exact htargetInvoke + have htargetInner : runOp ctx (fuel + 2) current targetCallStore + (targetCallValue :: environment) + (.apply (.var 0) + (supplied.toList.drop + (declArity declaration - captured.size)).toArray) = + .ok (targetStore, targetValue) := by + rw [runOp.eq_def] + dsimp only + rw [hremainingResolve] + simp only [bind, Except.bind] + exact htargetApply + have htargetRun : runCode ctx (fuel + 4) current store environment + (.letOp + (.call function + ((captured.toList ++ lowered.toList).take + (declArity declaration)).toArray) + (.letOp + (.apply (.var 0) + (supplied.toList.drop + (declArity declaration - captured.size)).toArray) + rest)) = .ok targetOut := by + rw [runCode.eq_def] + dsimp only + rw [htargetOuter] + simp only [bind, Except.bind] + rw [runCode.eq_def] + dsimp only + rw [htargetInner] + simp only [bind, Except.bind] + exact htargetRest + refine ⟨targetOut, htargetRun, ?_⟩ + change RunHistoryIso base out targetOut + apply runHistoryIso_weaken (earlier := base) (before := applyHeap) + (hrun := hrestIso) + exact fun h => hcallApply (hreadyCall h) + +/-! The arbitrary-fuel adapter for an already supplied self-history. The two +source binders force four units before success is possible. -/ +private theorem fusePair?_refines_selfHistory + {ctx : Ctx} {fuel : Nat} {current : FnDef} {store : Store} + {environment : List RVal} {declarations : DeclEnv} {facts : List Fact} + {function : Address} {captured supplied : Array Atom} {rest : Code} + {fusion : Fusion} {out : Store × RVal} + (hctx : ctx.decls = declarations) + (base : HeapHistoryIso store store) + (henvIso : RValsIso base.locRel environment environment) + (henvironment : EnvironmentHolds declarations store facts environment) + (hfusion : fusePair? declarations facts function captured supplied rest = + some fusion) + (hrun : runCode ctx fuel current store environment + (.letOp (.papp function captured) + (.letOp (.apply (.var 0) supplied) rest)) = .ok out) : + ∃ targetOut, + runCode ctx fuel current store environment fusion.code = .ok targetOut ∧ + RunHistoryIso base out targetOut := by + have hspec := fuseSpec_of_fusePair?_eq_some hfusion + cases fuel with + | zero => simp [runCode] at hrun + | succ fuel => + cases fuel with + | zero => + rw [runCode.eq_def] at hrun + dsimp only at hrun + rw [runOp.eq_def] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | succ fuel => + cases fuel with + | zero => + rw [runCode.eq_def] at hrun + dsimp only at hrun + cases houter : runOp ctx 1 current store environment + (.papp function captured) with + | error error => + rw [houter] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok outerOut => + rcases outerOut with ⟨middle, value⟩ + rw [houter] at hrun + simp only [bind, Except.bind] at hrun + rw [runCode.eq_def] at hrun + dsimp only at hrun + rw [runOp.eq_def] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | succ fuel => + cases fuel with + | zero => + rw [runCode.eq_def] at hrun + dsimp only at hrun + cases houter : runOp ctx 2 current store environment + (.papp function captured) with + | error error => + rw [houter] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok outerOut => + rcases outerOut with ⟨middle, value⟩ + rw [houter] at hrun + simp only [bind, Except.bind] at hrun + rw [runCode.eq_def] at hrun + dsimp only at hrun + rw [runOp.eq_def] at hrun + dsimp only at hrun + simp only [resolveAtom, List.getElem?_cons_zero, bind, + Except.bind] at hrun + cases hargs : resolveAtoms (value :: environment) + supplied with + | error error => + rw [hargs] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok arguments => + rw [hargs] at hrun + simp only [bind, Except.bind] at hrun + rw [applyGo.eq_def] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | succ fuel => + exact fuseSpec_refinesAt hctx base henvIso henvironment + hspec hrun + +/-- Every accepted fusion commutes with an arbitrary incoming allocation +history. Facts need hold only for the source environment: evaluator +congruence transports the fused execution to the related target heap. -/ +theorem fusePair?_refines_historyIso + {ctx : Ctx} {fuel : Nat} {current : FnDef} {left right : Store} + {leftEnvironment rightEnvironment : List RVal} + {declarations : DeclEnv} {facts : List Fact} + {function : Address} {captured supplied : Array Atom} {rest : Code} + {fusion : Fusion} {leftOut : Store × RVal} + (hctx : ctx.decls = declarations) + (heap : HeapHistoryIso left right) + (henvironments : RValsIso heap.locRel + leftEnvironment rightEnvironment) + (henvironment : EnvironmentHolds declarations left facts leftEnvironment) + (hfusion : fusePair? declarations facts function captured supplied rest = + some fusion) + (hrun : runCode ctx fuel current left leftEnvironment + (.letOp (.papp function captured) + (.letOp (.apply (.var 0) supplied) rest)) = .ok leftOut) : + ∃ rightOut, + runCode ctx fuel current right rightEnvironment fusion.code = + .ok rightOut ∧ + RunHistoryIso heap leftOut rightOut := by + let self := heap.trans heap.symm + have hselfEnvironment : RValsIso self.locRel + leftEnvironment leftEnvironment := by + change RValsIso + (fun leftLoc rightLoc => + ∃ middleLoc, heap.locRel leftLoc middleLoc ∧ + heap.locRel rightLoc middleLoc) + leftEnvironment leftEnvironment + exact henvironments.trans henvironments.symm + obtain ⟨middleOut, hmiddleRun, hlocal⟩ := + fusePair?_refines_selfHistory hctx self hselfEnvironment henvironment + hfusion hrun + obtain ⟨rightOut, hrightRun, htransport⟩ := + runCode_historyIso heap henvironments hmiddleRun + refine ⟨rightOut, hrightRun, ?_⟩ + apply runHistoryIso_weaken (earlier := heap) + (before := self.trans heap) (hrun := hlocal.trans htransport) + intro leftLoc rightLoc hrel + exact ⟨leftLoc, ⟨rightLoc, hrel, hrel⟩, hrel⟩ + +/-! ## Recursive traversal refinement -/ + +/-- One unchanged primitive followed by a recursively rewritten +continuation. Operation congruence produces the history used by both HPT's +forget-heap transfer and the recursive hypothesis. -/ +private theorem runCode_letOpWithFacts_refines + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {owner : Address} {current : FnDef} + (hctx : ctx.decls = declarations) + (howner : AnalysisOwnerCompatible declarations summaries owner current) + {left right : Store} {facts : List Fact} + {leftEnvironment rightEnvironment : List RVal} + {operation : Op} {rest : Code} {bound : Fact} + {fuel : Nat} {leftOut : Store × RVal} + (heap : HeapHistoryIso left right) + (henvironments : RValsIso heap.locRel + leftEnvironment rightEnvironment) + (henvironment : EnvironmentHolds declarations left facts leftEnvironment) + (habstract : analyzeOp declarations summaries owner current facts operation = + .ok bound) + (hrun : runCode ctx (fuel + 1) current left leftEnvironment + (.letOp operation rest) = .ok leftOut) + (ih : ∀ {left right : Store} {facts : List Fact} + {leftEnvironment rightEnvironment : List RVal} + {input : Code} {leftOut : Store × RVal}, + (heap : HeapHistoryIso left right) → + RValsIso heap.locRel leftEnvironment rightEnvironment → + EnvironmentHolds declarations left facts leftEnvironment → + runCode ctx fuel current left leftEnvironment input = .ok leftOut → + ∃ rightOut, + runCode ctx fuel current right rightEnvironment + (runWithFacts declarations summaries owner current facts input).code = + .ok rightOut ∧ + RunHistoryIso heap leftOut rightOut) : + ∃ rightOut, + runCode ctx (fuel + 1) current right rightEnvironment + (.letOp operation + (runWithFacts declarations summaries owner current + (bound :: facts.map Fact.forgetHeap) rest).code) = .ok rightOut ∧ + RunHistoryIso heap leftOut rightOut := by + rw [runCode.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + cases hleftOperation : runOp ctx fuel current left leftEnvironment operation with + | error error => + rw [hleftOperation] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok leftOperationOut => + rcases leftOperationOut with ⟨leftNext, leftValue⟩ + rw [hleftOperation] at hrun + simp only [bind, Except.bind] at hrun + have hbound := analyzeOp_sound_ownerCompatible hpost hctx howner + henvironment + habstract hleftOperation + have hold := EnvironmentHolds.forgetHeap + (after := leftNext) henvironment + obtain ⟨rightOperationOut, hrightOperation, hoperationIso⟩ := + runOp_historyIso heap henvironments hleftOperation + rcases rightOperationOut with ⟨rightNext, rightValue⟩ + obtain ⟨nextHeap, hentryNext, hvalue⟩ := hoperationIso + rw [hrightOperation] + simp only [bind, Except.bind] + obtain ⟨rightOut, hrightRest, hrestIso⟩ := + ih nextHeap (.cons hvalue (hentryNext.rvals henvironments)) + (.cons hbound hold) hrun + exact ⟨rightOut, hrightRest, + runHistoryIso_weaken hentryNext hrestIso⟩ + +/-- Package the ordinary `let` equation so the main proof only has to +separate the one adjacent PAP/apply shape handled specially by the pass. -/ +private theorem runCode_ordinaryLetWithFacts_refines + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {owner : Address} {current : FnDef} + (hctx : ctx.decls = declarations) + (howner : AnalysisOwnerCompatible declarations summaries owner current) + {left right : Store} {facts : List Fact} + {leftEnvironment rightEnvironment : List RVal} + {operation : Op} {rest : Code} {fuel : Nat} + {leftOut : Store × RVal} + (heap : HeapHistoryIso left right) + (henvironments : RValsIso heap.locRel + leftEnvironment rightEnvironment) + (henvironment : EnvironmentHolds declarations left facts leftEnvironment) + (hrun : runCode ctx (fuel + 1) current left leftEnvironment + (.letOp operation rest) = .ok leftOut) + (ih : ∀ {left right : Store} {facts : List Fact} + {leftEnvironment rightEnvironment : List RVal} + {input : Code} {leftOut : Store × RVal}, + (heap : HeapHistoryIso left right) → + RValsIso heap.locRel leftEnvironment rightEnvironment → + EnvironmentHolds declarations left facts leftEnvironment → + runCode ctx fuel current left leftEnvironment input = .ok leftOut → + ∃ rightOut, + runCode ctx fuel current right rightEnvironment + (runWithFacts declarations summaries owner current facts input).code = + .ok rightOut ∧ + RunHistoryIso heap leftOut rightOut) + (hordinary : + (runWithFacts declarations summaries owner current facts + (.letOp operation rest)).code = + match analyzeOp declarations summaries owner current facts operation with + | .error _ => .letOp operation rest + | .ok bound => + .letOp operation + (runWithFacts declarations summaries owner current + (bound :: facts.map Fact.forgetHeap) rest).code) : + ∃ rightOut, + runCode ctx (fuel + 1) current right rightEnvironment + (runWithFacts declarations summaries owner current facts + (.letOp operation rest)).code = .ok rightOut ∧ + RunHistoryIso heap leftOut rightOut := by + cases habstract : analyzeOp declarations summaries owner current facts + operation with + | error error => + rw [hordinary, habstract] + exact runCode_historyIso heap henvironments hrun + | ok bound => + rw [hordinary, habstract] + exact runCode_letOpWithFacts_refines hpost hctx howner heap + henvironments henvironment habstract hrun ih + +/-- The branch-body half of recursive fusion. The source-side HPT facts are +installed only after the concrete evaluator has selected a matching branch; +the heap-history relation transports the selected fields to the target. -/ +private theorem runCode_caseWithFactsBodies_refines + {declarations : DeclEnv} {summaries : SummaryEnv} + {owner : Address} {current : FnDef} {ctx : Ctx} + {left right : Store} {facts : List Fact} + {leftEnvironment rightEnvironment : List RVal} + {scrutinee : Atom} {peelNat : Bool} {alternatives : Array Alt} + {scrutineeFact : Fact} {fuel : Nat} {leftOut : Store × RVal} + (heap : HeapHistoryIso left right) + (henvironments : RValsIso heap.locRel + leftEnvironment rightEnvironment) + (henvironment : EnvironmentHolds declarations left facts leftEnvironment) + (habstract : resolveAtomFact facts scrutinee = .ok scrutineeFact) + (hrun : runCode ctx (fuel + 1) current left leftEnvironment + (.case scrutinee peelNat alternatives) = .ok leftOut) + (ih : ∀ {left right : Store} {facts : List Fact} + {leftEnvironment rightEnvironment : List RVal} + {input : Code} {leftOut : Store × RVal}, + (heap : HeapHistoryIso left right) → + RValsIso heap.locRel leftEnvironment rightEnvironment → + EnvironmentHolds declarations left facts leftEnvironment → + runCode ctx fuel current left leftEnvironment input = .ok leftOut → + ∃ rightOut, + runCode ctx fuel current right rightEnvironment + (runWithFacts declarations summaries owner current facts input).code = + .ok rightOut ∧ + RunHistoryIso heap leftOut rightOut) : + ∃ rightOut, + runCode ctx (fuel + 1) current right rightEnvironment + (.case scrutinee peelNat + ((alternatives.map + (runAlternativeWithFacts declarations summaries owner current + scrutineeFact peelNat facts)).map + (fun result => result.alternative))) = .ok rightOut ∧ + RunHistoryIso heap leftOut rightOut := by + obtain ⟨leftValue, hleftResolve⟩ := + resolveAtom_complete henvironment habstract + have hscrutineeHolds := + resolveAtom_sound henvironment habstract hleftResolve + obtain ⟨rightValue, hrightResolve, hvalue⟩ := + resolveAtom_historyIso henvironments hleftResolve + rw [runCode.eq_def] at hrun ⊢ + dsimp only at hrun ⊢ + rw [hleftResolve] at hrun + rw [hrightResolve] + simp only [bind, Except.bind] at hrun ⊢ + cases hvalue with + | erased => simp at hrun + | @lit literal => + cases literal with + | str value => simp at hrun + | nat value => + cases peelNat with + | false => simp at hrun + | true => + cases value with + | zero => + simp only + rw [find?_runAlternativeWithFacts] + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == 0) with + | none => simp [hfind] at hrun + | some alternative => + cases alternative with + | mk cidx fields body => + cases fields with + | zero => + have hzero : + scrutineeFact.caseFields true cidx 0 = [] := by + unfold Fact.caseFields + split <;> rfl + simp [hfind] at hrun + simp only [Option.map_some] + obtain ⟨rightOut, hrightRun, hout⟩ := + ih heap henvironments henvironment hrun + exact ⟨rightOut, by + simpa [runAlternativeWithFacts, hzero] + using hrightRun, hout⟩ + | succ fields => + simp [hfind, runAlternativeWithFacts] at hrun + | succ value => + simp only + rw [find?_runAlternativeWithFacts] + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == 1) with + | none => simp [hfind] at hrun + | some alternative => + cases alternative with + | mk cidx fields body => + cases fields with + | zero => + simp [hfind, runAlternativeWithFacts] at hrun + | succ fields => + cases fields with + | zero => + have hcidx : cidx = 1 := by + have hmatch := Array.find?_some + (p := fun alternative : Alt => + alternative.cidx == 1) + (a := .mk cidx 1 body) + (xs := alternatives) hfind + exact beq_iff_eq.mp hmatch + have hbinders : + EnvironmentHolds declarations left + (scrutineeFact.caseFields true cidx 1) + [.lit (.nat value)] := by + simpa [hcidx] using + (Fact.caseFields_natSucc_holds + hscrutineeHolds) + simp [hfind] at hrun + simp only [Option.map_some] + obtain ⟨rightOut, hrightRun, hout⟩ := + ih heap (.cons .lit henvironments) + (hbinders.append henvironment) hrun + exact ⟨rightOut, by + simpa [runAlternativeWithFacts] + using hrightRun, hout⟩ + | succ fields => + simp [hfind, runAlternativeWithFacts] at hrun + | @loc leftLoc rightLoc hrel => + cases hleft : left.get? leftLoc with + | none => simp [hleft] at hrun + | some leftBox => + obtain ⟨rightBox, hright, hbox⟩ := heap.boxes hrel hleft + rcases leftBox with ⟨leftWorld, leftRc, leftNode⟩ + rcases rightBox with ⟨rightWorld, rightRc, rightNode⟩ + rcases hbox with ⟨hworld, hrc, hnode⟩ + change leftWorld = rightWorld at hworld + change leftRc = rightRc at hrc + change NodeIso heap.locRel leftNode rightNode at hnode + subst rightWorld + subst rightRc + simp only [hleft] at hrun + simp only [hright] + cases hnode with + | pap harguments => simp at hrun + | @ctor identity leftFields rightFields hfields => + simp only + rw [find?_runAlternativeWithFacts] + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == identity.cidx) with + | none => simp [hfind] at hrun + | some alternative => + cases alternative with + | mk cidx fieldCount body => + have hsizes : leftFields.size = rightFields.size := by + simpa using hfields.lengths + by_cases hcount : leftFields.size = fieldCount + · have hrightCount : + rightFields.size = fieldCount := by + rw [← hsizes] + exact hcount + have hcidx : identity.cidx = cidx := by + have hmatch := Array.find?_some + (p := fun alternative : Alt => + alternative.cidx == identity.cidx) + (a := .mk cidx fieldCount body) + (xs := alternatives) hfind + exact (beq_iff_eq.mp hmatch).symm + have hbinders := Fact.caseFields_ctor_holds + peelNat cidx fieldCount hscrutineeHolds hleft rfl + hcidx hcount + simp [hfind, hcount] at hrun + simp only [Option.map_some] + rw [Array.foldl_cons_eq_reverse_append] + obtain ⟨rightOut, hrightRun, hout⟩ := + ih heap (hfields.reverse.append henvironments) + (hbinders.append henvironment) hrun + exact ⟨rightOut, by + simpa [hrightCount, runAlternativeWithFacts] + using hrightRun, hout⟩ + · have hrightCount : + rightFields.size ≠ fieldCount := by + intro heq + exact hcount (hsizes.trans heq) + simp [hfind, hcount, hrightCount, + runAlternativeWithFacts] at hrun + +/-- Recursive HPT-guided PAP fusion preserves every successful run modulo +allocation history. The theorem is deliberately stated over an arbitrary +incoming heap relation, so it can be used beneath calls and inside another +owner-sensitive declaration rewrite. -/ +theorem runCode_runWithFacts_refines_ownerCompatible + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {owner : Address} {current : FnDef} + {left right : Store} {facts : List Fact} + {leftEnvironment rightEnvironment : List RVal} + {input : Code} {fuel : Nat} {leftOut : Store × RVal} + (hctx : ctx.decls = declarations) + (howner : AnalysisOwnerCompatible declarations summaries owner current) + (heap : HeapHistoryIso left right) + (henvironments : RValsIso heap.locRel + leftEnvironment rightEnvironment) + (henvironment : EnvironmentHolds declarations left facts leftEnvironment) + (hrun : runCode ctx fuel current left leftEnvironment input = .ok leftOut) : + ∃ rightOut, + runCode ctx fuel current right rightEnvironment + (runWithFacts declarations summaries owner current facts input).code = + .ok rightOut ∧ + RunHistoryIso heap leftOut rightOut := by + induction fuel generalizing left right facts leftEnvironment + rightEnvironment input leftOut with + | zero => simp [runCode] at hrun + | succ fuel ih => + cases input with + | ret atom => + simpa [runWithFacts] using + (runCode_historyIso heap henvironments hrun) + | case scrutinee peelNat alternatives => + cases habstract : resolveAtomFact facts scrutinee with + | error error => + simpa [runWithFacts, habstract] using + (runCode_historyIso heap henvironments hrun) + | ok scrutineeFact => + simpa [runWithFacts, habstract] using + (runCode_caseWithFactsBodies_refines heap henvironments + henvironment habstract hrun + (fun nextHeap nextEnvironments nextFacts nextRun => + ih nextHeap nextEnvironments nextFacts nextRun)) + | letOp operation rest => + have ordinary {operation : Op} {rest : Code} + (hordinaryRun : runCode ctx (fuel + 1) current left + leftEnvironment (.letOp operation rest) = .ok leftOut) + (hordinary : + (runWithFacts declarations summaries owner current facts + (.letOp operation rest)).code = + match analyzeOp declarations summaries owner current facts + operation with + | .error _ => .letOp operation rest + | .ok bound => + .letOp operation + (runWithFacts declarations summaries owner current + (bound :: facts.map Fact.forgetHeap) rest).code) := + runCode_ordinaryLetWithFacts_refines hpost hctx howner heap + henvironments henvironment hordinaryRun + (fun nextHeap nextEnvironments nextFacts nextRun => + ih nextHeap nextEnvironments nextFacts nextRun) + hordinary + by_cases hpair : ∃ function captured supplied tail, + operation = .papp function captured ∧ + rest = .letOp (.apply (.var 0) supplied) tail + · obtain ⟨function, captured, supplied, tail, rfl, rfl⟩ := hpair + let pap := Op.papp function captured + let applyOperation := Op.apply (.var 0) supplied + cases hpap : analyzeOp declarations summaries owner current facts + pap with + | error error => + simpa [runWithFacts, pap, applyOperation, hpap] using + (runCode_historyIso heap henvironments hrun) + | ok papFact => + let afterPap := papFact :: facts.map Fact.forgetHeap + cases happly : analyzeOp declarations summaries owner current + afterPap applyOperation with + | error error => + simpa [runWithFacts, pap, applyOperation, afterPap, hpap, + happly] using + (runCode_historyIso heap henvironments hrun) + | ok resultFact => + let afterApply := + resultFact :: afterPap.map Fact.forgetHeap + let nested := runWithFacts declarations summaries owner + current afterApply tail + have hpapConcrete : analyzeOp declarations summaries owner + current facts (.papp function captured) = + .ok papFact := by + simpa [pap] using hpap + have happlyConcrete : analyzeOp declarations summaries + owner current (papFact :: facts.map Fact.forgetHeap) + (.apply (.var 0) supplied) = .ok resultFact := by + simpa [afterPap, applyOperation] using happly + cases hfusion : fusePair? declarations facts function + captured supplied nested.code with + | none => + apply ordinary hrun + simp only [runWithFacts, hpapConcrete, + happlyConcrete] + rw [hfusion] + | some fusion => + rw [runCode.eq_def] at hrun + dsimp only at hrun + cases hleftPap : runOp ctx fuel current left + leftEnvironment pap with + | error error => + rw [hleftPap] at hrun + simp only [bind, Except.bind] at hrun + contradiction + | ok leftPapOut => + rcases leftPapOut with ⟨leftNext, leftValue⟩ + rw [hleftPap] at hrun + simp only [bind, Except.bind] at hrun + have hpapFact := analyzeOp_sound_ownerCompatible + hpost hctx howner henvironment hpap hleftPap + have hold := EnvironmentHolds.forgetHeap + (after := leftNext) henvironment + have hafterPap : EnvironmentHolds declarations + leftNext afterPap + (leftValue :: leftEnvironment) := by + exact .cons hpapFact hold + obtain ⟨rightPapOut, hrightPap, hpapIso⟩ := + runOp_historyIso heap henvironments hleftPap + rcases rightPapOut with ⟨rightNext, rightValue⟩ + obtain ⟨nextHeap, hentryNext, hvalue⟩ := hpapIso + have hnextEnvironments : RValsIso nextHeap.locRel + (leftValue :: leftEnvironment) + (rightValue :: rightEnvironment) := + .cons hvalue (hentryNext.rvals henvironments) + let self := nextHeap.trans nextHeap.symm + have hselfEnvironment : RValsIso self.locRel + (leftValue :: leftEnvironment) + (leftValue :: leftEnvironment) := by + change RValsIso + (fun leftLoc rightLoc => + ∃ middleLoc, + nextHeap.locRel leftLoc middleLoc ∧ + nextHeap.locRel rightLoc middleLoc) + (leftValue :: leftEnvironment) + (leftValue :: leftEnvironment) + exact hnextEnvironments.trans + hnextEnvironments.symm + obtain ⟨middleOut, hmiddleRun, hrewrite⟩ := + ih self hselfEnvironment hafterPap hrun + have hmiddleRun' : runCode ctx fuel current leftNext + (leftValue :: leftEnvironment) + (.letOp applyOperation nested.code) = + .ok middleOut := by + simpa [runWithFacts, applyOperation, afterPap, + afterApply, nested, happly] using hmiddleRun + have hsourceNested : runCode ctx (fuel + 1) current + left leftEnvironment + (.letOp pap + (.letOp applyOperation nested.code)) = + .ok middleOut := by + rw [runCode.eq_def] + dsimp only + rw [hleftPap] + simp only [bind, Except.bind] + exact hmiddleRun' + obtain ⟨rightOut, hrightRun, hfused⟩ := + fusePair?_refines_historyIso hctx heap + henvironments henvironment hfusion hsourceNested + obtain ⟨rewriteHeap, hselfRewrite, + hrewriteValue⟩ := hrewrite + obtain ⟨fusedHeap, hheapFused, hfusedValue⟩ := + hfused + refine ⟨rightOut, ?_, rewriteHeap.trans fusedHeap, + ?_, hrewriteValue.trans hfusedValue⟩ + · simp only [runWithFacts, hpapConcrete, + happlyConcrete] + rw [hfusion] + exact hrightRun + · intro leftLoc rightLoc hrel + refine ⟨leftLoc, hselfRewrite ?_, + hheapFused hrel⟩ + exact ⟨rightLoc, hentryNext hrel, + hentryNext hrel⟩ + · apply ordinary hrun + by_cases hpapp : ∃ function captured, + operation = .papp function captured + · obtain ⟨function, captured, rfl⟩ := hpapp + cases rest with + | ret atom => + simp only [runWithFacts] + split <;> rfl + | case scrutinee peelNat alternatives => + simp only [runWithFacts] + split <;> rfl + | letOp nextOperation tail => + by_cases happlyShape : ∃ applied supplied, + nextOperation = .apply applied supplied + · obtain ⟨applied, supplied, rfl⟩ := happlyShape + by_cases hvarZero : applied = .var 0 + · subst applied + exact False.elim + (hpair ⟨function, captured, supplied, tail, rfl, rfl⟩) + · cases applied with + | var index => + cases index with + | zero => exact False.elim (hvarZero rfl) + | succ index => + simp only [runWithFacts] + split <;> rfl + | lit literal => + simp only [runWithFacts] + split <;> rfl + | erased => + simp only [runWithFacts] + split <;> rfl + · cases nextOperation <;> + try { simp only [runWithFacts]; split <;> rfl } + rename_i applied supplied + exact False.elim + (happlyShape ⟨applied, supplied, rfl⟩) + · cases operation <;> + try { simp only [runWithFacts]; split <;> rfl } + rename_i function captured + exact False.elim (hpapp ⟨function, captured, rfl⟩) + +/-- Exact declaration ownership is the common stored-function specialization +of the owner-compatible recursive refinement theorem. -/ +theorem runCode_runWithFacts_refines + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {owner : Address} {current : FnDef} + {left right : Store} {facts : List Fact} + {leftEnvironment rightEnvironment : List RVal} + {input : Code} {fuel : Nat} {leftOut : Store × RVal} + (hctx : ctx.decls = declarations) + (hcurrent : declarations owner = some (.fn current)) + (heap : HeapHistoryIso left right) + (henvironments : RValsIso heap.locRel + leftEnvironment rightEnvironment) + (henvironment : EnvironmentHolds declarations left facts leftEnvironment) + (hrun : runCode ctx fuel current left leftEnvironment input = .ok leftOut) : + ∃ rightOut, + runCode ctx fuel current right rightEnvironment + (runWithFacts declarations summaries owner current facts input).code = + .ok rightOut ∧ + RunHistoryIso heap leftOut rightOut := + runCode_runWithFacts_refines_ownerCompatible hpost hctx (.inl hcurrent) + heap henvironments henvironment hrun + +/-- The owner-local traversal rewrites a body soundly while retaining the +source current frame. The generic evaluator fixed-point theorem is +responsible for installing the rewritten frame around recursive self-calls. -/ +theorem rewriteFunction_staticBodyRefines + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {owner : Address} {current : FnDef} + (hctx : ctx.decls = declarations) + (hcurrent : declarations owner = some (.fn current)) : + StaticFunctionBodyRefines ctx current + (rewriteFunction declarations summaries owner current) := by + intro fuel store environment sourceOut base hlength henvironment hrun + have htop : EnvironmentHolds declarations store + (List.replicate current.arity Fact.top) environment := by + simpa [hlength] using + (EnvironmentHolds.top_replicate declarations store environment) + obtain ⟨targetOut, htargetRun, hiso⟩ := + runCode_runWithFacts_refines hpost hctx hcurrent base henvironment htop hrun + exact ⟨targetOut, by + simpa [rewriteFunction, runFunction] using htargetRun, hiso⟩ + +/-- Rewriting the current frame preserves arbitrary surrounding code, +including recursive `callSelf` entries into its rewritten body. -/ +theorem runCode_rewriteFunction_refines + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {owner : Address} {current : FnDef} + {left right : Store} {fuel : Nat} + {leftEnvironment rightEnvironment : List RVal} + {input : Code} {sourceOut : Store × RVal} + (hctx : ctx.decls = declarations) + (hcurrent : declarations owner = some (.fn current)) + (heap : HeapHistoryIso left right) + (henvironments : RValsIso heap.locRel + leftEnvironment rightEnvironment) + (hrun : runCode ctx fuel current left leftEnvironment input = + .ok sourceOut) : + ∃ targetOut, + runCode ctx fuel + (rewriteFunction declarations summaries owner current) + right rightEnvironment input = .ok targetOut ∧ + RunHistoryIso heap sourceOut targetOut := + runCode_currentFrame_refines + (rewriteFunction_staticBodyRefines hpost hctx hcurrent) + rfl rfl heap henvironments hrun + +/-- The checked owner-local PAP traversal supplies the semantic function-body +obligation consumed by `AbstractEnvironment`. -/ +theorem rewriteFunction_bodyRefines + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {owner : Address} {current : FnDef} + (hctx : ctx.decls = declarations) + (hcurrent : declarations owner = some (.fn current)) : + FunctionBodyRefines ctx current + (rewriteFunction declarations summaries owner current) := + FunctionBodyRefines.ofStatic + (rewriteFunction_staticBodyRefines hpost hctx hcurrent) rfl rfl + +/-! ## Logical declaration environment + +The semantic traversal remains keyed by the source addresses. Artifact +readdressing is a later, separate transport step. -/ + +/-- Rewrite every stored function under its source owner while retaining the +old lookup keys. -/ +def rewriteDeclEnv (declarations : DeclEnv) (summaries : SummaryEnv) : + DeclEnv := + fun owner => (declarations owner).map + (rewriteDeclaration declarations summaries owner) + +/-- Retain the scalar oracle and replace only the declaration environment. -/ +def rewriteCtx (declarations : DeclEnv) (summaries : SummaryEnv) + (ctx : Ctx) : Ctx := + { ctx with decls := rewriteDeclEnv declarations summaries } + +/-- List form consumed by a subsequent content-address rebuild. -/ +def rewriteEntries (declarations : DeclEnv) (summaries : SummaryEnv) + (entries : List (Address × Decl)) : List (Address × Decl) := + entries.map fun entry => + (entry.1, rewriteDeclaration declarations summaries entry.1 entry.2) + +/-- PAP fusion's owner-local body theorem instantiates the generic declaration +environment interface for every successful source lookup. -/ +theorem abstractEnvironment_rewriteCtx + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} (hctx : ctx.decls = declarations) : + AbstractEnvironment ctx (rewriteCtx declarations summaries ctx) := by + constructor + · rfl + · intro address arity hsource + have hdeclaration : declarations address = some (.extern arity) := by + rw [← hctx] + exact hsource + simp [rewriteCtx, rewriteDeclEnv, hdeclaration, rewriteDeclaration] + · intro address source hsource + have hdeclaration : declarations address = some (.fn source) := by + rw [← hctx] + exact hsource + refine ⟨rewriteFunction declarations summaries address source, ?_, + rfl, rfl, rfl, ?_⟩ + · simp [rewriteCtx, rewriteDeclEnv, hdeclaration, + rewriteDeclaration] + · exact rewriteFunction_bodyRefines hpost hctx hdeclaration + +/-- Successful evaluation is preserved after logically replacing every +stored function by its owner-sensitive PAP-fused body. -/ +theorem runCode_rewriteCtx_refines + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {current : FnDef} {left right : Store} {fuel : Nat} + {leftEnvironment rightEnvironment : List RVal} + {input : Code} {sourceOut : Store × RVal} + (hctx : ctx.decls = declarations) + (heap : HeapHistoryIso left right) + (henvironments : RValsIso heap.locRel + leftEnvironment rightEnvironment) + (hrun : runCode ctx fuel current left leftEnvironment input = + .ok sourceOut) : + ∃ targetOut, + runCode (rewriteCtx declarations summaries ctx) fuel current right + rightEnvironment input = .ok targetOut ∧ + RunHistoryIso heap sourceOut targetOut := + runCode_abstractEnvironment + (abstractEnvironment_rewriteCtx hpost hctx) heap henvironments hrun + +/-- Closed self-heap specialization of the general history theorem. -/ +theorem fusePair?_refines + {ctx : Ctx} {fuel : Nat} {current : FnDef} {store : Store} + {environment : List RVal} {declarations : DeclEnv} {facts : List Fact} + {function : Address} {captured supplied : Array Atom} {rest : Code} + {fusion : Fusion} {out : Store × RVal} + (hctx : ctx.decls = declarations) + (hclosed : StoreClosed store) + (hbounds : Reclamation.ValuesInBounds store environment) + (henvironment : EnvironmentHolds declarations store facts environment) + (hfusion : fusePair? declarations facts function captured supplied rest = + some fusion) + (hrun : runCode ctx fuel current store environment + (.letOp (.papp function captured) + (.letOp (.apply (.var 0) supplied) rest)) = .ok out) : + ∃ targetOut, + runCode ctx fuel current store environment fusion.code = .ok targetOut ∧ + RunHistoryIso (HeapHistoryIso.refl store hclosed) out targetOut := by + let base := HeapHistoryIso.refl store hclosed + have henvIso : RValsIso base.locRel environment environment := by + simpa [base] using RValsIso.refl_of_inBounds hclosed hbounds + simpa [base] using + fusePair?_refines_selfHistory hctx base henvIso henvironment hfusion hrun + +end Ix.Compiler.IxIR1.HPT.PAPFuse diff --git a/Ix/Compiler/IxIR1/HPTPAPFuseProgram.lean b/Ix/Compiler/IxIR1/HPTPAPFuseProgram.lean new file mode 100644 index 000000000..521771897 --- /dev/null +++ b/Ix/Compiler/IxIR1/HPTPAPFuseProgram.lean @@ -0,0 +1,781 @@ +import Ix.Compiler.IxIR1.HPTCasePruneProgram +import Ix.Compiler.IxIR1.HPTDestroy +import Ix.Compiler.IxIR1.Reachability + +/-! +# One-rebuild composition of checked HPT consumers + +Case simplification, scalar fetch forwarding, shape-specialized destruction, +and local PAP fusion all consume the same old-keyed HPT certificate. +Readdressing between them would invalidate those keys. This module therefore +composes their logical declaration/main rewrites first and performs one +complete content-address rebuild. + +Case simplification runs first. Its unary collapse retains binder depth by +materializing a fetch. Fetch forwarding then replaces only certified scalar +allocation/reuse projections, destruction removes certified scalar work and +specializes exact unique leaves, and PAP fusion analyzes the resulting code +with the same owner, arity, and entry fact environment. +-/ + +namespace Ix.Compiler.IxIR1.HPT.OptimizeProgram + +open Ix.Compiler.Ixon (Address) +open Ix.Compiler.IxIR1.Sim + +structure Passes where + casePrune : Bool := true + fetchForward : Bool := true + destroy : Bool := true + papFuse : Bool := true + reachability : Bool := true + roots : List Address := [] + deriving BEq, Repr + +structure Changes where + casePrune : CasePrune.Changes := {} + fetchForward : FetchForward.Changes := {} + destroy : Destroy.Changes := {} + papFuse : PAPFuse.Changes := {} + removedDeclarations : Nat := 0 + +def Changes.add (left right : Changes) : Changes := + { casePrune := left.casePrune.add right.casePrune + fetchForward := left.fetchForward.add right.fetchForward + destroy := left.destroy.add right.destroy + papFuse := left.papFuse.add right.papFuse + removedDeclarations := + left.removedDeclarations + right.removedDeclarations } + +structure CodeOutcome where + code : Code + changes : Changes := {} + +def rewriteCode (passes : Passes) (declarations : DeclEnv) + (summaries : SummaryEnv) (owner : Address) (current : FnDef) + (facts : List Fact) (input : Code) : CodeOutcome := + let pruned : CasePrune.Outcome := + if passes.casePrune then + CasePrune.runWithFacts declarations summaries owner current facts input + else + { code := input, removedAlternatives := 0, collapsedCases := 0, + materializedFetches := 0 } + let forwarded : FetchForward.Outcome := + if passes.fetchForward then + FetchForward.runWithFacts declarations summaries owner current facts + pruned.code + else + { code := pruned.code, changes := {} } + let destroyed : Destroy.Outcome := + if passes.destroy then + Destroy.runWithFacts declarations summaries owner current facts + forwarded.code + else + { code := forwarded.code, changes := {} } + let fused : PAPFuse.Outcome := + if passes.papFuse then + PAPFuse.runWithFacts declarations summaries owner current facts + destroyed.code + else + { code := destroyed.code, changes := {} } + { code := fused.code + changes := + { casePrune := pruned.changes + fetchForward := forwarded.changes + destroy := destroyed.changes + papFuse := fused.changes } } + +def rewriteDeclaration (passes : Passes) + (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Address) : Decl → Decl × Changes + | .extern arity => (.extern arity, {}) + | .fn function => + let rewritten := rewriteCode passes declarations summaries owner function + (List.replicate function.arity Fact.top) function.body + (.fn { function with body := rewritten.code }, rewritten.changes) + +/-- Logical old-keyed declaration environment for the composed consumers. -/ +def rewriteDeclEnv (passes : Passes) (declarations : DeclEnv) + (summaries : SummaryEnv) : DeclEnv := + fun owner => (declarations owner).map fun declaration => + (rewriteDeclaration passes declarations summaries owner declaration).1 + +/-- Retain the oracle while installing the composed logical environment. -/ +def rewriteCtx (passes : Passes) (declarations : DeclEnv) + (summaries : SummaryEnv) (ctx : Ctx) : Ctx := + { ctx with decls := rewriteDeclEnv passes declarations summaries } + +@[simp] theorem declArity_rewriteDeclaration + (passes : Passes) (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Address) (declaration : Decl) : + declArity + (rewriteDeclaration passes declarations summaries owner declaration).1 = + declArity declaration := by + cases declaration <;> rfl + +/-- All checked consumers compose under the original owner/current analysis +frame. Case pruning and fetch forwarding are exact; destruction preserves +successful outcomes and PAP fusion may change allocation history. -/ +theorem rewriteCode_staticBodyRefines + {passes : Passes} {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {owner : Address} {current : FnDef} + (hctx : ctx.decls = declarations) + (hcurrent : declarations owner = some (.fn current)) : + StaticFunctionBodyRefines ctx current + { current with body := + (rewriteCode passes declarations summaries owner current + (List.replicate current.arity Fact.top) current.body).code } := by + intro fuel store environment sourceOut base hlength henvironment hrun + let facts := List.replicate current.arity Fact.top + let pruned : CasePrune.Outcome := + if passes.casePrune then + CasePrune.runWithFacts declarations summaries owner current facts + current.body + else + { code := current.body, removedAlternatives := 0, collapsedCases := 0, + materializedFetches := 0 } + have htop : EnvironmentHolds declarations store facts environment := by + simpa [facts, hlength] using + (EnvironmentHolds.top_replicate declarations store environment) + have hpruned : runCode ctx fuel current store environment pruned.code = + .ok sourceOut := by + cases hcase : passes.casePrune with + | false => simpa [pruned, hcase] using hrun + | true => + have heq := CasePrune.runCode_runWithFacts_eq hpost hctx hcurrent htop + (input := current.body) (fuel := fuel) + simpa [pruned, hcase] using heq.trans hrun + let forwarded : FetchForward.Outcome := + if passes.fetchForward then + FetchForward.runWithFacts declarations summaries owner current facts + pruned.code + else + { code := pruned.code, changes := {} } + have hforwarded : + runCode ctx fuel current store environment forwarded.code = + .ok sourceOut := by + cases hfetch : passes.fetchForward with + | false => simpa [forwarded, hfetch] using hpruned + | true => + have heq := FetchForward.runCode_runWithFacts_eq hpost hctx hcurrent + htop (input := pruned.code) (fuel := fuel) + simpa [forwarded, hfetch] using heq.trans hpruned + let destroyed : Destroy.Outcome := + if passes.destroy then + Destroy.runWithFacts declarations summaries owner current facts + forwarded.code + else + { code := forwarded.code, changes := {} } + have hdestroyed : + runCode ctx fuel current store environment destroyed.code = + .ok sourceOut := by + cases hdestroy : passes.destroy with + | false => simpa [destroyed, hdestroy] using hforwarded + | true => + have hrefines := Destroy.runCode_runWithFacts_success hpost hctx + hcurrent htop hforwarded + simpa [destroyed, hdestroy] using hrefines + cases hpap : passes.papFuse with + | false => + obtain ⟨targetOut, htargetRun, hiso⟩ := + runCode_historyIso base henvironment hdestroyed + exact ⟨targetOut, by + simpa [rewriteCode, facts, pruned, forwarded, destroyed, hpap] + using htargetRun, hiso⟩ + | true => + obtain ⟨targetOut, htargetRun, hiso⟩ := + PAPFuse.runCode_runWithFacts_refines hpost hctx hcurrent base + henvironment htop hdestroyed + exact ⟨targetOut, by + simpa [rewriteCode, facts, pruned, forwarded, destroyed, hpap] + using htargetRun, hiso⟩ + +/-- Closing the rewritten current-frame fixed point turns the composed local +rewrite into the function obligation required by `AbstractEnvironment`. -/ +theorem rewriteCode_bodyRefines + {passes : Passes} {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {owner : Address} {current : FnDef} + (hctx : ctx.decls = declarations) + (hcurrent : declarations owner = some (.fn current)) : + FunctionBodyRefines ctx current + { current with body := + (rewriteCode passes declarations summaries owner current + (List.replicate current.arity Fact.top) current.body).code } := + FunctionBodyRefines.ofStatic + (rewriteCode_staticBodyRefines hpost hctx hcurrent) rfl rfl + +/-- Every old-keyed declaration lookup is preserved by the composed logical +environment, with rewritten functions related by their local body theorem. -/ +theorem abstractEnvironment_rewriteCtx + {passes : Passes} {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} (hctx : ctx.decls = declarations) : + AbstractEnvironment ctx (rewriteCtx passes declarations summaries ctx) := by + constructor + · rfl + · intro address arity hsource + have hdeclaration : declarations address = some (.extern arity) := by + rw [← hctx] + exact hsource + simp [rewriteCtx, rewriteDeclEnv, hdeclaration, rewriteDeclaration] + · intro address source hsource + have hdeclaration : declarations address = some (.fn source) := by + rw [← hctx] + exact hsource + let target : FnDef := + { source with body := + (rewriteCode passes declarations summaries address source + (List.replicate source.arity Fact.top) source.body).code } + refine ⟨target, ?_, rfl, rfl, rfl, ?_⟩ + · simp [rewriteCtx, rewriteDeclEnv, hdeclaration, + rewriteDeclaration, target] + · exact rewriteCode_bodyRefines hpost hctx hdeclaration + +/-- Successful evaluation is preserved after logically replacing every +stored function by the composed owner-sensitive rewrite. -/ +theorem runCode_rewriteCtx_refines + {passes : Passes} {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {current : FnDef} {left right : Store} {fuel : Nat} + {leftEnvironment rightEnvironment : List RVal} + {input : Code} {sourceOut : Store × RVal} + (hctx : ctx.decls = declarations) + (heap : HeapHistoryIso left right) + (henvironments : RValsIso heap.locRel + leftEnvironment rightEnvironment) + (hrun : runCode ctx fuel current left leftEnvironment input = + .ok sourceOut) : + ∃ targetOut, + runCode (rewriteCtx passes declarations summaries ctx) fuel current right + rightEnvironment input = .ok targetOut ∧ + RunHistoryIso heap sourceOut targetOut := + runCode_abstractEnvironment + (abstractEnvironment_rewriteCtx hpost hctx) heap henvironments hrun + +def rewriteEntries (passes : Passes) (declarations : DeclEnv) + (summaries : SummaryEnv) (entries : List (Address × Decl)) : + List (Address × Decl) := + entries.map fun entry => + (entry.1, + (rewriteDeclaration passes declarations summaries entry.1 entry.2).1) + +def declarationsChanges (passes : Passes) (declarations : DeclEnv) + (summaries : SummaryEnv) (entries : List (Address × Decl)) : Changes := + entries.foldl + (fun total entry => + total.add + (rewriteDeclaration passes declarations summaries entry.1 entry.2).2) + {} + +private theorem find?_rewriteEntries + (passes : Passes) (declarations : DeclEnv) (summaries : SummaryEnv) + (address : Address) : + ∀ entries : List (Address × Decl), + (rewriteEntries passes declarations summaries entries).find? + (fun entry => entry.1 == address) = + (entries.find? (fun entry => entry.1 == address)).map + (fun entry => + (entry.1, + (rewriteDeclaration passes declarations summaries address + entry.2).1)) := by + intro entries + induction entries with + | nil => rfl + | cons entry rest ih => + rcases entry with ⟨entryAddress, declaration⟩ + simp only [rewriteEntries, List.map_cons, List.find?_cons] + by_cases hsame : entryAddress == address + · have haddress : entryAddress = address := beq_iff_eq.mp hsame + subst entryAddress + simp + · simp only [hsame] + exact ih + +/-- Mapping a concrete declaration list realizes the composed logical +old-keyed environment. -/ +theorem envOfList_rewriteEntries + (passes : Passes) (declarations : DeclEnv) (summaries : SummaryEnv) + (entries : List (Address × Decl)) : + Env.ofList (rewriteEntries passes declarations summaries entries) = + fun address => + (Env.ofList entries address).map + (fun declaration => + (rewriteDeclaration passes declarations summaries address + declaration).1) := by + funext address + unfold Env.ofList + rw [find?_rewriteEntries] + cases hentry : entries.find? (fun entry => entry.1 == address) with + | none => rfl + | some entry => + rcases entry with ⟨entryAddress, declaration⟩ + have hsame := List.find?_some hentry + have haddress : entryAddress = address := beq_iff_eq.mp hsame + subst entryAddress + rfl + +/-- Main code has no stored declaration owner. Case pruning retains its +fixed-environment compatibility traversal. Fetch forwarding, destruction, +and PAP fusion use the all-zero address only as the fail-soft `callSelf` +analysis owner; ordinary heap operations, direct calls, PAPs, and applies are +unaffected by that placeholder. -/ +def rewriteMain (passes : Passes) (declarations : DeclEnv) + (summaries : SummaryEnv) (main : Code) : CodeOutcome := + let pruned : CasePrune.Outcome := + if passes.casePrune then + CasePrune.runRecursive declarations summaries main + else + { code := main + removedAlternatives := 0 + collapsedCases := 0 + materializedFetches := 0 } + let current : FnDef := ⟨0, .shared, false, pruned.code⟩ + let forwarded : FetchForward.Outcome := + if passes.fetchForward && (summaries default).isNone then + FetchForward.runWithFacts declarations summaries default current [] + pruned.code + else + { code := pruned.code, changes := {} } + let destroyed : Destroy.Outcome := + if passes.destroy && (summaries default).isNone then + Destroy.runWithFacts declarations summaries default current [] + forwarded.code + else + { code := forwarded.code, changes := {} } + let fused : PAPFuse.Outcome := + if passes.papFuse && (summaries default).isNone then + PAPFuse.runWithFacts declarations summaries default current [] + destroyed.code + else + { code := destroyed.code, changes := {} } + { code := fused.code + changes := + { casePrune := pruned.changes + fetchForward := forwarded.changes + destroy := destroyed.changes + papFuse := fused.changes } } + +/-- The canonical entry history for a fresh top-level execution. -/ +def emptyHistoryIso : HeapHistoryIso ({} : Store) {} := + HeapHistoryIso.refl {} (by + intro location box hbox + simp [Store.get?] at hbox) + +/-- After recursive case pruning, the guarded owner-sensitive phases are +static rewrites of the zero-arity main frame. If the sentinel owner has a +summary, all three phases are skipped; otherwise successful self analysis is +impossible and their general owner-compatible theorems apply. -/ +theorem rewriteMain_staticBodyRefines + {passes : Passes} {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {main : Code} + (hctx : ctx.decls = declarations) : + let pruned : CasePrune.Outcome := + if passes.casePrune then + CasePrune.runRecursive declarations summaries main + else + { code := main + removedAlternatives := 0 + collapsedCases := 0 + materializedFetches := 0 } + let source : FnDef := ⟨0, .shared, false, pruned.code⟩ + StaticFunctionBodyRefines ctx source + { source with body := + (rewriteMain passes declarations summaries main).code } := by + let pruned : CasePrune.Outcome := + if passes.casePrune then + CasePrune.runRecursive declarations summaries main + else + { code := main + removedAlternatives := 0 + collapsedCases := 0 + materializedFetches := 0 } + let source : FnDef := ⟨0, .shared, false, pruned.code⟩ + change StaticFunctionBodyRefines ctx source + { source with body := + (rewriteMain passes declarations summaries main).code } + intro fuel store environment sourceOut base hlength henvironment hrun + have hempty : environment = [] := by + cases environment with + | nil => rfl + | cons value rest => simp at hlength + subst environment + cases hsummary : summaries default with + | some summary => + obtain ⟨targetOut, htargetRun, hiso⟩ := + runCode_historyIso base henvironment hrun + exact ⟨targetOut, by + simpa [rewriteMain, source, pruned, hsummary] using htargetRun, hiso⟩ + | none => + let forwarded : FetchForward.Outcome := + if passes.fetchForward then + FetchForward.runWithFacts declarations summaries default source [] + pruned.code + else + { code := pruned.code, changes := {} } + have hforwarded : + runCode ctx fuel source store [] forwarded.code = .ok sourceOut := by + cases hfetch : passes.fetchForward with + | false => simpa [forwarded, hfetch] using hrun + | true => + have heq := + FetchForward.runCode_runWithFacts_eq_ownerCompatible hpost hctx + (.inr hsummary) EnvironmentHolds.nil + (current := source) (store := store) + (input := pruned.code) (fuel := fuel) + simpa [forwarded, hfetch] using heq.trans hrun + let destroyed : Destroy.Outcome := + if passes.destroy then + Destroy.runWithFacts declarations summaries default source [] + forwarded.code + else + { code := forwarded.code, changes := {} } + have hdestroyed : + runCode ctx fuel source store [] destroyed.code = .ok sourceOut := by + cases hdestroy : passes.destroy with + | false => simpa [destroyed, hdestroy] using hforwarded + | true => + have hrefines := + Destroy.runCode_runWithFacts_success_ownerCompatible hpost hctx + (.inr hsummary) EnvironmentHolds.nil hforwarded + simpa [destroyed, hdestroy] using hrefines + cases hpap : passes.papFuse with + | false => + obtain ⟨targetOut, htargetRun, hiso⟩ := + runCode_historyIso base henvironment hdestroyed + exact ⟨targetOut, by + simpa [rewriteMain, source, pruned, forwarded, destroyed, hpap, + hsummary] using htargetRun, hiso⟩ + | true => + obtain ⟨targetOut, htargetRun, hiso⟩ := + PAPFuse.runCode_runWithFacts_refines_ownerCompatible hpost hctx + (.inr hsummary) base henvironment EnvironmentHolds.nil + hdestroyed + exact ⟨targetOut, by + simpa [rewriteMain, source, pruned, forwarded, destroyed, hpap, + hsummary] using htargetRun, hiso⟩ + +/-- Rewriting top-level main preserves every successful fresh execution, +including dynamic re-entry through `callSelf`. -/ +theorem runMain_rewriteMain_refines + {passes : Passes} {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {main : Code} {fuel : Nat} {sourceOut : Store × RVal} + (hctx : ctx.decls = declarations) + (hrun : runMain ctx main fuel = .ok sourceOut) : + ∃ targetOut, + runMain ctx (rewriteMain passes declarations summaries main).code fuel = + .ok targetOut ∧ + RunHistoryIso emptyHistoryIso sourceOut targetOut := by + let pruned : CasePrune.Outcome := + if passes.casePrune then + CasePrune.runRecursive declarations summaries main + else + { code := main + removedAlternatives := 0 + collapsedCases := 0 + materializedFetches := 0 } + have hpruned : runMain ctx pruned.code fuel = .ok sourceOut := by + cases hcase : passes.casePrune with + | false => simpa [pruned, hcase] using hrun + | true => + have heq := CasePrune.runMain_runRecursive_eq hpost + (input := main) (fuel := fuel) hctx + simpa [pruned, hcase] using heq.trans hrun + let source : FnDef := ⟨0, .shared, false, pruned.code⟩ + let target : FnDef := + { source with body := + (rewriteMain passes declarations summaries main).code } + have hstatic : StaticFunctionBodyRefines ctx source target := by + change StaticFunctionBodyRefines ctx source target + exact rewriteMain_staticBodyRefines (passes := passes) hpost + (main := main) hctx + have hbody : FunctionBodyRefines ctx source target := + FunctionBodyRefines.ofStatic hstatic rfl rfl + obtain ⟨targetOut, htargetRun, hiso⟩ := + hbody emptyHistoryIso rfl RValsIso.nil + (by simpa [runMain, source] using hpruned) + exact ⟨targetOut, by + simpa [runMain, target] using htargetRun, hiso⟩ + +private theorem emptyHistoryIso_compose_extends : + emptyHistoryIso.Extends (emptyHistoryIso.trans emptyHistoryIso) := by + intro left right hrel + have hbound := emptyHistoryIso.left_bound hrel + simp at hbound + +/-- Logical whole-program refinement before content readdressing. Main and +all stored declarations are rewritten together; successful results are +preserved modulo allocation history. -/ +theorem runMain_rewriteProgram_refines + {passes : Passes} {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {main : Code} {fuel : Nat} {sourceOut : Store × RVal} + (hctx : ctx.decls = declarations) + (hrun : runMain ctx main fuel = .ok sourceOut) : + ∃ targetOut, + runMain (rewriteCtx passes declarations summaries ctx) + (rewriteMain passes declarations summaries main).code fuel = + .ok targetOut ∧ + RunHistoryIso emptyHistoryIso sourceOut targetOut := by + obtain ⟨middleOut, hmiddleRun, hmainIso⟩ := + runMain_rewriteMain_refines (passes := passes) hpost hctx hrun + obtain ⟨targetOut, htargetRun, hctxIso⟩ := + runCode_rewriteCtx_refines (passes := passes) hpost hctx emptyHistoryIso + RValsIso.nil (by simpa [runMain] using hmiddleRun) + refine ⟨targetOut, by simpa [runMain] using htargetRun, ?_⟩ + exact RunHistoryIso.weaken emptyHistoryIso_compose_extends + (hmainIso.trans hctxIso) + +structure Outcome where + result : ReaddressAll.Result + changes : Changes + +/-- Apply checked rooted reachability after all body rewrites but before the +single content-address rebuild. A disabled pass retains every row. -/ +def selectReachable (passes : Passes) (entries : List (Address × Decl)) + (main : Code) : Reachability.Outcome := + if passes.reachability then + Reachability.run passes.roots entries main + else + { entries + certificate := Reachability.produce entries main passes.roots + accepted := false + removedDeclarations := 0 } + +/-- Checked reachability preserves the complete logical-program result; the +disabled branch is literal equality. -/ +theorem runMain_selectReachable_eq (passes : Passes) + (entries : List (Address × Decl)) (main : Code) + (oracle : Address → List RVal → Option RVal := fun _ _ => none) + (fuel : Nat := 100000) : + runMain + { decls := Env.ofList (selectReachable passes entries main).entries + oracle } + main fuel = + runMain { decls := Env.ofList entries, oracle } main fuel := by + cases hreach : passes.reachability with + | false => simp [selectReachable, hreach] + | true => + simpa [selectReachable, hreach] using + Reachability.runMain_run_eq passes.roots entries main oracle fuel + +/-- Compose enabled checked consumers and rebuild the addressed graph once. -/ +def rebuildProgram (passes : Passes) (reserved : List Address) + (program : List ReaddressAll.Artifact) (summaries : SummaryEnv) + (main : Code) : Except String Outcome := do + let declarations := declarationEntries program + let environment := programDeclEnv program + let rewritten := rewriteEntries passes environment summaries declarations + let declarationDelta := + declarationsChanges passes environment summaries declarations + let rewrittenMain := rewriteMain passes environment summaries main + let reachable := selectReachable passes rewritten rewrittenMain.code + let result ← ReaddressAll.rebuild reserved reachable.entries + rewrittenMain.code + return ⟨result, + (declarationDelta.add rewrittenMain.changes).add + { removedDeclarations := reachable.removedDeclarations }⟩ + +/-- Project the exact graph-rebuild equation from a successful composed pass. -/ +theorem rebuild_of_rebuildProgram_eq_ok + {passes : Passes} {reserved : List Address} + {program : List ReaddressAll.Artifact} {summaries : SummaryEnv} + {main : Code} {outcome : Outcome} + (hrun : rebuildProgram passes reserved program summaries main = + .ok outcome) : + ReaddressAll.rebuild reserved + (selectReachable passes + (rewriteEntries passes (programDeclEnv program) summaries + (declarationEntries program)) + (rewriteMain passes (programDeclEnv program) summaries main).code).entries + (rewriteMain passes (programDeclEnv program) summaries main).code = + .ok outcome.result := by + unfold rebuildProgram at hrun + simp only [bind, Except.bind] at hrun + cases hrebuild : ReaddressAll.rebuild reserved + (selectReachable passes + (rewriteEntries passes (programDeclEnv program) summaries + (declarationEntries program)) + (rewriteMain passes (programDeclEnv program) summaries main).code).entries + (rewriteMain passes (programDeclEnv program) summaries main).code with + | error message => + rw [hrebuild] at hrun + contradiction + | ok result => + rw [hrebuild] at hrun + have houtcome : + (⟨result, + ((declarationsChanges passes (programDeclEnv program) summaries + (declarationEntries program)).add + (rewriteMain passes (programDeclEnv program) summaries + main).changes).add + { removedDeclarations := + (selectReachable passes + (rewriteEntries passes (programDeclEnv program) summaries + (declarationEntries program)) + (rewriteMain passes (programDeclEnv program) summaries + main).code).removedDeclarations }⟩ : Outcome) = outcome := by + injection hrun + have hresult : result = outcome.result := + congrArg Outcome.result houtcome + exact congrArg Except.ok hresult + +/-- The concrete declaration rows used by rebuilding implement the HPT +program environment. -/ +theorem envOfList_declarationEntries + (program : List ReaddressAll.Artifact) : + Env.ofList (declarationEntries program) = programDeclEnv program := + CasePrune.envOfList_declarationEntries program + +/-- Old-keyed source context paired with the oracle pullback of an exact +rebuild. -/ +def rebuildOriginalCtx (result : ReaddressAll.Result) + (rewritten : List (Address × Decl)) (declarations : DeclEnv) + (oracle : Address → List RVal → Option RVal) : Ctx := + { decls := declarations + oracle := (result.rebuildSourceCtx rewritten oracle).oracle } + +/-- One successful logical rewrite followed by one exact content-address +rebuild preserves the source result modulo heap allocation history and maps +the rewritten store's embedded declaration addresses into the rebuilt graph. -/ +theorem runMain_rebuild_rewriteProgram + {passes : Passes} {reserved : List Address} + {entries : List (Address × Decl)} + {declarations : DeclEnv} {summaries : SummaryEnv} {main : Code} + {result : ReaddressAll.Result} {sourceOut : Store × RVal} + (hentries : Env.ofList entries = declarations) + (hpost : LocalPostFixpoint declarations summaries) + (hrebuild : ReaddressAll.rebuild reserved + (selectReachable passes + (rewriteEntries passes declarations summaries entries) + (rewriteMain passes declarations summaries main).code).entries + (rewriteMain passes declarations summaries main).code = .ok result) + (oracle : Address → List RVal → Option RVal := fun _ _ => none) + (fuel : Nat := 100000) + (hrun : runMain + (rebuildOriginalCtx result + (selectReachable passes + (rewriteEntries passes declarations summaries entries) + (rewriteMain passes declarations summaries main).code).entries + declarations oracle) + main fuel = .ok sourceOut) : + ∃ targetOut, + runMain (result.addressedCtx oracle) result.main fuel = + .ok + (Readdress.Store.mapAddresses + (result.rebuildRename + (selectReachable passes + (rewriteEntries passes declarations summaries entries) + (rewriteMain passes declarations summaries main).code).entries) + targetOut.1, + targetOut.2) ∧ + RunHistoryIso emptyHistoryIso sourceOut targetOut := by + let rewritten := rewriteEntries passes declarations summaries entries + let rewrittenMain := rewriteMain passes declarations summaries main + let reachable := selectReachable passes rewritten rewrittenMain.code + let before := rebuildOriginalCtx result reachable.entries declarations oracle + have hbefore : before.decls = declarations := rfl + have hctx : rewriteCtx passes declarations summaries before = + { decls := Env.ofList rewritten, oracle := before.oracle } := by + simp [rewriteCtx, before, rewritten, rebuildOriginalCtx, + envOfList_rewriteEntries, hentries] + funext address + rfl + obtain ⟨targetOut, htargetRun, hiso⟩ := + runMain_rewriteProgram_refines (passes := passes) hpost hbefore hrun + have hfullSource : + runMain { decls := Env.ofList rewritten, oracle := before.oracle } + rewrittenMain.code fuel = .ok targetOut := by + rw [← hctx] + simpa [rewrittenMain] using htargetRun + have hfilteredSource : + runMain + { decls := Env.ofList reachable.entries, oracle := before.oracle } + rewrittenMain.code fuel = .ok targetOut := by + exact (runMain_selectReachable_eq passes rewritten rewrittenMain.code + before.oracle fuel).trans hfullSource + have htargetSource : + runMain (result.rebuildSourceCtx reachable.entries oracle) + rewrittenMain.code fuel = .ok targetOut := by + simpa [before, reachable, rebuildOriginalCtx, + ReaddressAll.Result.rebuildSourceCtx] using hfilteredSource + refine ⟨targetOut, ?_, hiso⟩ + exact ReaddressAll.runMain_exact_success_of_rebuild_eq_ok hrebuild oracle + htargetSource + +/-- A successful HPT check and successful composed rebuild authorize the +whole-program refinement theorem exposed by the optimizer pipeline. -/ +theorem runMain_rebuildProgram_of_runWith_eq_ok + {passes : Passes} {limits : Limits} {reserved : List Address} + {program : List ReaddressAll.Artifact} {certificate : Certificate} + {analysis : HPT.Result} {main : Code} {outcome : Outcome} + {sourceOut : Store × RVal} + (hcheck : HPT.runWith limits program certificate = .ok analysis) + (hrebuild : rebuildProgram passes reserved program certificate.summaryEnv + main = .ok outcome) + (oracle : Address → List RVal → Option RVal := fun _ _ => none) + (fuel : Nat := 100000) + (hrun : runMain + (rebuildOriginalCtx outcome.result + (selectReachable passes + (rewriteEntries passes (programDeclEnv program) + certificate.summaryEnv (declarationEntries program)) + (rewriteMain passes (programDeclEnv program) + certificate.summaryEnv main).code).entries + (programDeclEnv program) oracle) + main fuel = .ok sourceOut) : + ∃ targetOut, + runMain (outcome.result.addressedCtx oracle) outcome.result.main fuel = + .ok + (Readdress.Store.mapAddresses + (outcome.result.rebuildRename + (selectReachable passes + (rewriteEntries passes (programDeclEnv program) + certificate.summaryEnv (declarationEntries program)) + (rewriteMain passes (programDeclEnv program) + certificate.summaryEnv main).code).entries) + targetOut.1, + targetOut.2) ∧ + RunHistoryIso emptyHistoryIso sourceOut targetOut := by + apply runMain_rebuild_rewriteProgram + · exact envOfList_declarationEntries program + · exact localPostFixpoint_of_postFixpoint + (postFixpoint_of_runWith_eq_ok hcheck) + · exact rebuild_of_rebuildProgram_eq_ok hrebuild + · exact hrun + +/-- Closed-oracle specialization: the source is the ordinary old addressed +program context. -/ +theorem runMain_rebuildProgram_of_runWith_eq_ok_defaultOracle + {passes : Passes} {limits : Limits} {reserved : List Address} + {program : List ReaddressAll.Artifact} {certificate : Certificate} + {analysis : HPT.Result} {main : Code} {outcome : Outcome} + {sourceOut : Store × RVal} + (hcheck : HPT.runWith limits program certificate = .ok analysis) + (hrebuild : rebuildProgram passes reserved program certificate.summaryEnv + main = .ok outcome) + (fuel : Nat := 100000) + (hrun : runMain { decls := programDeclEnv program } main fuel = + .ok sourceOut) : + ∃ targetOut, + runMain (outcome.result.addressedCtx (fun _ _ => none)) + outcome.result.main fuel = + .ok + (Readdress.Store.mapAddresses + (outcome.result.rebuildRename + (selectReachable passes + (rewriteEntries passes (programDeclEnv program) + certificate.summaryEnv (declarationEntries program)) + (rewriteMain passes (programDeclEnv program) + certificate.summaryEnv main).code).entries) + targetOut.1, + targetOut.2) ∧ + RunHistoryIso emptyHistoryIso sourceOut targetOut := by + simpa [rebuildOriginalCtx, ReaddressAll.Result.rebuildSourceCtx] using + (runMain_rebuildProgram_of_runWith_eq_ok hcheck hrebuild + (fun _ _ => none) fuel hrun) + +end Ix.Compiler.IxIR1.HPT.OptimizeProgram diff --git a/Ix/Compiler/IxIR1/HPTProduce.lean b/Ix/Compiler/IxIR1/HPTProduce.lean new file mode 100644 index 000000000..346ce5d69 --- /dev/null +++ b/Ix/Compiler/IxIR1/HPTProduce.lean @@ -0,0 +1,334 @@ +import Ix.Compiler.IxIR1.HPTSound + +/-! +# Deterministic bounded HPT certificate production + +The checker deliberately trusts no producer. This module supplies a canonical +in-process producer for callers that do not have an external analysis result. +It follows the dependency order already committed to by `ReaddressAll`: each +ordinary declaration or mutual SCC is solved from bottom against final prior +summaries, using synchronous inflationary rounds inside the artifact. + +Both local and whole-schedule round counts are explicit resources. Exhausting +either round budget, or exceeding a finite-shape, field-vector, or coordinate +budget during iteration, widens only the current artifact's function rows to +`top`. The finished certificate still crosses the ordinary untrusted `runWith` +checker, so the schedule and its fallback are outside the trusted proof +boundary. +-/ + +namespace Ix.Compiler.IxIR1.HPT + +open Ix.Compiler.Ixon (Address) + +/-- Independent resource controls for deterministic production and final +checking. `maxRounds` bounds the sum of transfer rounds across all artifacts; +`maxRoundsPerArtifact` prevents one recursive SCC from consuming it all. -/ +structure ProducerLimits where + checker : Limits := {} + maxRoundsPerArtifact : Nat := 256 + maxRounds : Nat := 64 * 1024 + deriving BEq, Repr + +def defaultProducerLimits : ProducerLimits := {} + +/-- Observable deterministic schedule statistics. `widenedArtifacts` counts +artifacts forced to their conservative function facts by a round, shape, field, +or coordinate budget; it does not count a naturally inferred `top`. -/ +structure ProducerStats where + rounds : Nat := 0 + widenedArtifacts : Nat := 0 + deriving BEq, Repr, Inhabited + +/-- A generated certificate together with the checked materialization and the +kernel equality witnessing that it crossed the same untrusted boundary as an +external candidate. The equality is erased at runtime. -/ +structure Production (limits : Limits) + (program : List ReaddressAll.Artifact) where + certificate : Certificate + result : Result + stats : ProducerStats + checked : runWith limits program certificate = .ok result + +private def seedFact : Decl → Fact + | .extern _ => Fact.scalar + | .fn _ => Fact.bottom + +private def fallbackFact : Decl → Fact + | .extern _ => Fact.scalar + | .fn _ => Fact.top + +private def seedMembers (members : List (Address × Decl)) : + List (Address × Fact) := + members.map fun member => (member.1, seedFact member.2) + +private def fallbackMembers (members : List (Address × Decl)) : + List (Address × Fact) := + members.map fun member => (member.1, fallbackFact member.2) + +private def hasFunction (members : List (Address × Decl)) : Bool := + members.any fun member => + match member.2 with + | .fn _ => true + | .extern _ => false + +private def insertMembers (index : AddressEnv.Index Fact) + (members : List (Address × Fact)) : AddressEnv.Index Fact := + members.foldl (fun current member => + current.insert member.1 member.2) index + +private def producerEnforce (label : String) (actual limit : Nat) : + Except String Unit := + if actual ≤ limit then .ok () + else .error s!"HPT producer {label} budget exceeded: {actual} > {limit}" + +private structure ProducedPayload where + shapes : Nat := 0 + fields : Nat := 0 + +private def checkProducedFact (limits : Limits) (fact : Fact) : + Except String ProducedPayload := do + let payload ← checkFactPayload limits fact + return { shapes := payload.shapes, fields := payload.fields } + +/-- Validate only the changing fact payload. Full program/certificate counts +are checked once before scheduling; rescanning the entire graph per round would +turn an SCC-local solver back into a whole-program quadratic loop. -/ +private def checkProducedMembers (limits : Limits) (priorShapes priorFields : Nat) + (members : List (Address × Fact)) : Except String ProducedPayload := do + let mut shapes := priorShapes + let mut fields := priorFields + for member in members do + let payload ← checkProducedFact limits member.2 + shapes := shapes + payload.shapes + fields := fields + payload.fields + producerEnforce "total-shape" shapes limits.maxShapes + producerEnforce "total-constructor-field" fields limits.maxFields + return { shapes, fields } + +private def stepMembers (declarations : DeclEnv) (summaries : SummaryEnv) : + List (Address × Decl) → List (Address × Fact) → + Except String (List (Address × Fact)) + | [], [] => .ok [] + | (address, declaration) :: declarations', + (claimedAddress, previous) :: previous' => do + if address != claimedAddress then + throw "internal: HPT producer member alignment drift" + let next ← match declaration with + | .extern _ => pure Fact.scalar + | .fn function => do + let inferred ← inferFunction declarations summaries address function + pure (previous.join inferred) + let rest ← stepMembers declarations summaries declarations' previous' + return (address, next) :: rest + | _, _ => .error "internal: HPT producer member arity drift" + +private structure ArtifactSolution where + members : List (Address × Fact) + summaries : AddressEnv.Index Fact + totalShapes : Nat + totalFields : Nat + rounds : Nat + remainingRounds : Nat + widened : Bool + +private def fallbackSolution (baseIndex : AddressEnv.Index Fact) + (members : List (Address × Decl)) (priorShapes priorFields rounds remaining : Nat) : + ArtifactSolution := + let facts := fallbackMembers members + { members := facts + summaries := insertMembers baseIndex facts + totalShapes := priorShapes + totalFields := priorFields + rounds + remainingRounds := remaining + widened := true } + +private def solveArtifactAux (limits : ProducerLimits) + (declarations : DeclEnv) (baseIndex : AddressEnv.Index Fact) + (declarationMembers : List (Address × Decl)) + (priorShapes priorFields : Nat) : + Nat → Nat → List (Address × Fact) → Nat → + Except String ArtifactSolution + | 0, remaining, _, rounds => + .ok (fallbackSolution baseIndex declarationMembers priorShapes priorFields rounds + remaining) + | _ + 1, 0, _, rounds => + .ok (fallbackSolution baseIndex declarationMembers priorShapes priorFields rounds 0) + | localRemaining + 1, totalRemaining + 1, current, rounds => do + let currentIndex := insertMembers baseIndex current + let next ← stepMembers declarations (AddressEnv.lookup currentIndex) + declarationMembers current + let rounds := rounds + 1 + match checkProducedMembers limits.checker priorShapes priorFields next with + | .error _ => + return fallbackSolution baseIndex declarationMembers priorShapes + priorFields rounds totalRemaining + | .ok payload => + if next == current then + return { members := next + summaries := insertMembers baseIndex next + totalShapes := payload.shapes + totalFields := payload.fields + rounds + remainingRounds := totalRemaining + widened := false } + else + solveArtifactAux limits declarations baseIndex declarationMembers + priorShapes priorFields localRemaining totalRemaining next rounds + +private def solveArtifact (limits : ProducerLimits) + (declarations : DeclEnv) (baseIndex : AddressEnv.Index Fact) + (members : List (Address × Decl)) (priorShapes priorFields remainingRounds : Nat) : + Except String ArtifactSolution := + let seed := seedMembers members + if hasFunction members then + solveArtifactAux limits declarations baseIndex members priorShapes priorFields + limits.maxRoundsPerArtifact remainingRounds seed 0 + else + .ok + { members := seed + summaries := insertMembers baseIndex seed + totalShapes := priorShapes + totalFields := priorFields + rounds := 0 + remainingRounds + widened := false } + +namespace Producer + +/-- Artifact-local producer output used by the persistent cache scheduler. +The summary index already contains the returned rows. -/ +structure ArtifactResult where + candidate : CandidateArtifact + summaries : AddressEnv.Index Fact + totalShapes : Nat + totalFields : Nat + rounds : Nat + remainingRounds : Nat + widened : Bool + +/-- Extend an already-built summary index with one exact artifact row set. -/ +def extendSummaries (summaries : AddressEnv.Index Fact) + (members : List (Address × Fact)) : AddressEnv.Index Fact := + insertMembers summaries members + +/-- Apply the producer's finite-payload gates to a cache hit while retaining +the totals accumulated by earlier dependency artifacts. -/ +def validatePayload (limits : Limits) (priorShapes priorFields : Nat) + (members : List (Address × Fact)) : Except String (Nat × Nat) := do + let payload ← checkProducedMembers limits priorShapes priorFields members + return (payload.shapes, payload.fields) + +/-- Produce exactly one dependency-ordered program artifact against fixed +prior summaries. This is the same solver used by whole-program production; it +is exposed so cache misses can rebuild locally instead of discarding unrelated +hits. -/ +def produceArtifactWith (limits : ProducerLimits) (declarations : DeclEnv) + (summaries : AddressEnv.Index Fact) (program : ReaddressAll.Artifact) + (priorShapes priorFields remainingRounds : Nat) : + Except String ArtifactResult := do + let solved ← solveArtifact limits declarations summaries + (programMembers program) priorShapes priorFields remainingRounds + let candidate : CandidateArtifact := + { programIdentity := Ix.Compiler.IxIR1.HPT.programIdentity program + members := solved.members } + pure ⟨candidate, solved.summaries, solved.totalShapes, solved.totalFields, + solved.rounds, solved.remainingRounds, solved.widened⟩ + +end Producer + +private structure ScheduleState where + artifactsRev : List CandidateArtifact := [] + summaries : AddressEnv.Index Fact := AddressEnv.build [] + totalShapes : Nat := 0 + totalFields : Nat := 0 + rounds : Nat := 0 + remainingRounds : Nat := 0 + widenedArtifacts : Nat := 0 + +private def solveArtifacts (limits : ProducerLimits) + (declarations : DeclEnv) : + List ReaddressAll.Artifact → ScheduleState → Except String ScheduleState + | [], state => .ok state + | artifact :: artifacts, state => do + let members := programMembers artifact + let solved ← solveArtifact limits declarations state.summaries members + state.totalShapes state.totalFields state.remainingRounds + let candidate : CandidateArtifact := + { programIdentity := programIdentity artifact + members := solved.members } + solveArtifacts limits declarations artifacts + { artifactsRev := candidate :: state.artifactsRev + summaries := solved.summaries + totalShapes := solved.totalShapes + totalFields := solved.totalFields + rounds := state.rounds + solved.rounds + remainingRounds := solved.remainingRounds + widenedArtifacts := state.widenedArtifacts + + (if solved.widened then 1 else 0) } + +/-- Produce the deterministic candidate and its schedule statistics. The +result has exact program/artifact/member layout but has not yet been assigned +cache identities; use `produceWith` at an external boundary. -/ +def produceCertificateWith (limits : ProducerLimits) + (program : List ReaddressAll.Artifact) : + Except String (Certificate × ProducerStats) := do + let _ ← preflight limits.checker program (Certificate.top program) + let declarations := programDeclEnv program + let state ← solveArtifacts limits declarations program + { remainingRounds := limits.maxRounds } + return (⟨state.artifactsRev.reverse⟩, + { rounds := state.rounds + widenedArtifacts := state.widenedArtifacts }) + +def produceCertificate (program : List ReaddressAll.Artifact) : + Except String (Certificate × ProducerStats) := + produceCertificateWith defaultProducerLimits program + +/-- Produce, validate, and content-address one deterministic HPT result. -/ +def produceWith (limits : ProducerLimits) + (program : List ReaddressAll.Artifact) : + Except String (Production limits.checker program) := do + let (certificate, stats) ← produceCertificateWith limits program + match hrun : runWith limits.checker program certificate with + | .error error => .error error + | .ok result => + .ok { certificate, result, stats, checked := hrun } + +def produce (program : List ReaddressAll.Artifact) : + Except String (Production defaultProducerLimits.checker program) := + produceWith defaultProducerLimits program + +namespace Production + +theorem postFixpoint {limits : Limits} {program : List ReaddressAll.Artifact} + (production : Production limits program) : + production.certificate.postFixpoint program = true := + postFixpoint_of_runWith_eq_ok production.checked + +theorem semanticAudit {limits : Limits} {program : List ReaddressAll.Artifact} + (production : Production limits program) : + production.result.semanticAudit = true := + semanticAudit_of_runWith_eq_ok production.checked + +/-- Every generated function row has the same concrete evaluator guarantee as +an externally supplied accepted certificate. -/ +theorem functionSummary_sound + {limits : Limits} {program : List ReaddressAll.Artifact} + (production : Production limits program) + {ctx : Ctx} {address : Address} {function : FnDef} {claimed : Fact} + {arguments : List RVal} {store outputStore : Store} + {outputValue : RVal} {fuel : Nat} + (hctx : ctx.decls = programDeclEnv program) + (hdeclaration : programDeclEnv program address = some (.fn function)) + (hsummary : production.certificate.summaryEnv address = some claimed) + (hinvoke : invoke ctx fuel address arguments store = + .ok (outputStore, outputValue)) : + claimed.Holds (programDeclEnv program) outputStore outputValue := by + exact functionSummary_sound_of_runWith_eq_ok production.checked hctx + hdeclaration hsummary hinvoke + +end Production + +end Ix.Compiler.IxIR1.HPT diff --git a/Ix/Compiler/IxIR1/HPTSound.lean b/Ix/Compiler/IxIR1/HPTSound.lean new file mode 100644 index 000000000..0d9fbd092 --- /dev/null +++ b/Ix/Compiler/IxIR1/HPTSound.lean @@ -0,0 +1,2989 @@ +import Ix.Compiler.IxIR1.HPT + +/-! +# Semantic soundness of IxIR₁ heap-points-to facts + +This module gives the executable HPT domain a concrete meaning over the +IxIR₁ evaluator's stores and runtime values. A finite constructor/PAP fact +describes a live node exactly; a detailed constructor additionally describes +its exact field vector recursively. `unknownHeap` deliberately accepts every +location, including a stale alias: primitive transfer forgets old finite heap +identities before interpreting the continuation, so store mutation cannot +invalidate an environment invariant. +-/ + +namespace Ix.Compiler.IxIR1.HPT + +open Ix.Compiler.Ixon (Address) + +mutual + +/-- Recursive concrete interpretation of one field heap shape. -/ +inductive FieldShape.Holds (declarations : DeclEnv) (store : Store) : + FieldShape → RVal → Prop where + | ctorIdentity + (hget : store.get? location = some box) + (hnode : box.node = .ctorN identity fields) : + FieldShape.Holds declarations store (.ctor identity none) (.loc location) + | ctorDetailed + (hget : store.get? location = some box) + (hnode : box.node = .ctorN identity fields) + (hfields : FieldFactsHold declarations store facts fields.toList) : + FieldShape.Holds declarations store + (.ctor identity (some facts)) (.loc location) + | pap + (hget : store.get? location = some box) + (hdeclaration : declarations function = some declaration) + (hnode : box.node = + .papN function (declArity declaration) arguments) + (hsize : arguments.size = supplied) + (hproper : supplied < declArity declaration) : + FieldShape.Holds declarations store + (.pap function supplied) (.loc location) + +/-- Recursive fact interpretation. Scalar and unknown cases remain explicit; +finite heap evidence points to one recursively interpreted shape. -/ +inductive FieldFact.Holds (declarations : DeclEnv) (store : Store) : + FieldFact → RVal → Prop where + | lit (hscalar : fact.mayScalar = true) : + FieldFact.Holds declarations store fact (.lit literal) + | erased (hscalar : fact.mayScalar = true) : + FieldFact.Holds declarations store fact .erased + | unknown (hunknown : fact.unknownHeap = true) : + FieldFact.Holds declarations store fact (.loc location) + | heap (hmember : shape ∈ fact.shapes) + (hshape : FieldShape.Holds declarations store shape (.loc location)) : + FieldFact.Holds declarations store fact (.loc location) + +/-- Pointwise interpretation of an exact recursive field vector. -/ +inductive FieldFactsHold (declarations : DeclEnv) (store : Store) : + List FieldFact → List RVal → Prop where + | nil : FieldFactsHold declarations store [] [] + | cons : fact.Holds declarations store value → + FieldFactsHold declarations store facts values → + FieldFactsHold declarations store (fact :: facts) (value :: values) + +end + +private theorem FieldFact.shape_size_lt {fact : FieldFact} + {shape : FieldShape} (h : shape ∈ fact.shapes) : + sizeOf shape < sizeOf fact := by + have hlist := List.sizeOf_lt_of_mem h + cases fact with + | mk mayScalar unknownHeap shapes => + exact Nat.lt_trans (by simpa using hlist) (by simp_wf) + +private theorem FieldShape.exists_le_of_anyLe {left : FieldShape} + {rights : List FieldShape} (h : FieldShape.anyLe left rights = true) : + ∃ right ∈ rights, left.le right = true := by + induction rights with + | nil => simp [FieldShape.anyLe] at h + | cons right rights ih => + simp only [FieldShape.anyLe, Bool.or_eq_true] at h + rcases h with hhead | htail + · exact ⟨right, by simp, hhead⟩ + · obtain ⟨found, hmember, hle⟩ := ih htail + exact ⟨found, by simp [hmember], hle⟩ + +private theorem FieldShape.exists_le_of_allLe + {lefts rights : List FieldShape} {left : FieldShape} + (hall : FieldShape.allLe lefts rights = true) (hleft : left ∈ lefts) : + ∃ right ∈ rights, left.le right = true := by + induction lefts with + | nil => contradiction + | cons head tail ih => + simp only [FieldShape.allLe, Bool.and_eq_true] at hall + rcases List.mem_cons.mp hleft with rfl | htail + · exact FieldShape.exists_le_of_anyLe hall.1 + · exact ih hall.2 htail + +mutual + +/-- Recursive field-shape subset preserves its full concrete tree. -/ +theorem FieldShape.holds_of_le {declarations : DeclEnv} {store : Store} + {left right : FieldShape} {value : RVal} + (hle : left.le right = true) + (hleft : left.Holds declarations store value) : + right.Holds declarations store value := by + cases hleft with + | @ctorIdentity location box identity fields hget hnode => + cases right with + | ctor rightIdentity rightFields => + cases rightFields with + | none => + have hidentity : identity = rightIdentity := by + simpa [FieldShape.le.eq_1] using hle + subst rightIdentity + exact .ctorIdentity hget hnode + | some rightFacts => + simp [FieldShape.le.eq_2] at hle + | pap _ _ => simp [FieldShape.le] at hle + | @ctorDetailed location box identity fields facts hget hnode hfields => + cases right with + | ctor rightIdentity rightFields => + cases rightFields with + | none => + have hidentity : identity = rightIdentity := by + simpa [FieldShape.le.eq_1] using hle + subst rightIdentity + exact .ctorIdentity hget hnode + | some rightFacts => + simp only [FieldShape.le.eq_3, Bool.and_eq_true] at hle + have hidentity : identity = rightIdentity := + beq_iff_eq.mp hle.1 + subst rightIdentity + exact .ctorDetailed hget hnode + (FieldFactsHold.holds_of_listLe hle.2 hfields) + | pap _ _ => simp [FieldShape.le] at hle + | @pap location box function declaration arguments supplied hget hdecl hnode + hsize hproper => + cases right with + | ctor _ _ => simp [FieldShape.le] at hle + | pap rightFunction rightSupplied => + simp only [FieldShape.le, Bool.and_eq_true] at hle + have hfunction : function = rightFunction := beq_iff_eq.mp hle.1 + have hsupplied : supplied = rightSupplied := beq_iff_eq.mp hle.2 + subst rightFunction + subst rightSupplied + exact .pap hget hdecl hnode hsize hproper +termination_by sizeOf left +decreasing_by all_goals subst_vars <;> simp_wf <;> omega + +/-- Recursive field-fact subset preserves scalar, unknown, and finite-shape +evidence. -/ +theorem FieldFact.holds_of_le {declarations : DeclEnv} {store : Store} + {left right : FieldFact} {value : RVal} + (hle : left.le right = true) + (hleft : left.Holds declarations store value) : + right.Holds declarations store value := by + cases hleft with + | lit hscalar => + simp [FieldFact.le, hscalar] at hle + exact .lit hle.1 + | erased hscalar => + simp [FieldFact.le, hscalar] at hle + exact .erased hle.1 + | unknown hunknown => + simp [FieldFact.le, hunknown] at hle + exact .unknown hle.2 + | heap hmember hshape => + simp only [FieldFact.le, Bool.and_eq_true] at hle + by_cases hunknown : right.unknownHeap = true + · exact .unknown hunknown + · have hall : FieldShape.allLe left.shapes right.shapes = true := by + have hbranch : left.unknownHeap = false ∧ + FieldShape.allLe left.shapes right.shapes = true := by + simpa [hunknown] using hle.2 + exact hbranch.2 + obtain ⟨rightShape, hright, hshapeLe⟩ := + FieldShape.exists_le_of_allLe hall hmember + exact .heap hright (FieldShape.holds_of_le hshapeLe hshape) +termination_by sizeOf left +decreasing_by + all_goals subst_vars + exact FieldFact.shape_size_lt hmember + +/-- Pointwise recursive field-vector subset. -/ +theorem FieldFactsHold.holds_of_listLe {declarations : DeclEnv} {store : Store} + {left right : List FieldFact} {values : List RVal} + (hle : FieldFact.listLe left right = true) + (hleft : FieldFactsHold declarations store left values) : + FieldFactsHold declarations store right values := by + cases hleft with + | nil => + cases right with + | nil => exact .nil + | cons _ _ => simp [FieldFact.listLe] at hle + | @cons leftFact value leftFacts values hhead htail => + cases right with + | nil => simp [FieldFact.listLe] at hle + | cons rightFact rightFacts => + simp only [FieldFact.listLe, Bool.and_eq_true] at hle + exact .cons (FieldFact.holds_of_le hle.1 hhead) + (FieldFactsHold.holds_of_listLe hle.2 htail) +termination_by sizeOf left +decreasing_by all_goals subst_vars <;> simp_wf <;> omega + +end + +namespace FieldFactsHold + +theorem length_eq {declarations : DeclEnv} {store : Store} + {facts : List FieldFact} {values : List RVal} + (h : FieldFactsHold declarations store facts values) : + facts.length = values.length := by + cases h with + | nil => rfl + | cons _ htail => simp [FieldFactsHold.length_eq htail] +termination_by sizeOf facts +decreasing_by all_goals subst_vars <;> simp_wf <;> omega + +theorem holds_of_le {declarations : DeclEnv} {store : Store} + {left right : List FieldFact} {values : List RVal} + (hle : HeapShape.fieldFactsLe left right = true) + (hleft : FieldFactsHold declarations store left values) : + FieldFactsHold declarations store right values := by + cases hleft with + | nil => + cases right with + | nil => exact .nil + | cons _ _ => simp [HeapShape.fieldFactsLe] at hle + | @cons leftFact value leftFacts values hhead htail => + cases right with + | nil => simp [HeapShape.fieldFactsLe] at hle + | cons rightFact rightFacts => + simp only [HeapShape.fieldFactsLe, Bool.and_eq_true] at hle + exact .cons (FieldFact.holds_of_le hle.1 hhead) + (FieldFactsHold.holds_of_le hle.2 htail) +termination_by sizeOf left +decreasing_by all_goals subst_vars <;> simp_wf <;> omega + +theorem getOfValue {declarations : DeclEnv} {store : Store} + {facts : List FieldFact} {values : List RVal} + (h : FieldFactsHold declarations store facts values) + {index : Nat} {value : RVal} (hvalue : values[index]? = some value) : + ∃ fact, facts[index]? = some fact ∧ fact.Holds declarations store value := by + cases h with + | nil => simp at hvalue + | @cons tailFacts tailValues headFact headValue hhead htail => + cases index with + | zero => + simp at hvalue + subst value + exact ⟨headFact, by simp, hhead⟩ + | succ index => + simp at hvalue + obtain ⟨fact, hfact, hholds⟩ := + FieldFactsHold.getOfValue htail hvalue + exact ⟨fact, by simpa, hholds⟩ +termination_by sizeOf facts +decreasing_by all_goals subst_vars <;> simp_wf <;> omega + +end FieldFactsHold + +namespace HeapShape + +/-- Concrete interpretation of one result heap shape. Detailed constructor +facts additionally validate every stored field in source order. PAP facts bind +the saturation arity to the declaration environment. -/ +def Holds (declarations : DeclEnv) (store : Store) (value : RVal) : + HeapShape → Prop + | .ctor identity fieldFacts => + match value with + | .loc location => + ∃ box fields, + store.get? location = some box ∧ + box.node = .ctorN identity fields ∧ + match fieldFacts with + | none => True + | some facts => + FieldFactsHold declarations store facts fields.toList + | _ => False + | .pap function supplied => + match value with + | .loc location => + ∃ box arguments declaration, + store.get? location = some box ∧ + declarations function = some declaration ∧ + box.node = .papN function (declArity declaration) arguments ∧ + arguments.size = supplied ∧ + supplied < declArity declaration + | _ => False + +/-- Shape-level subset preserves the detailed concrete interpretation. -/ +theorem holds_of_le {declarations : DeclEnv} {store : Store} + {left right : HeapShape} {value : RVal} + (hle : left.le right = true) + (hleft : left.Holds declarations store value) : + right.Holds declarations store value := by + cases left <;> cases right <;> cases value <;> + simp only [HeapShape.Holds] at hleft ⊢ + case ctor.ctor.loc leftIdentity leftFields rightIdentity rightFields location => + simp only [HeapShape.le, Bool.and_eq_true] at hle + have hidentity : leftIdentity = rightIdentity := (beq_iff_eq).mp hle.1 + subst rightIdentity + rcases hleft with ⟨box, values, hget, hnode, hfields⟩ + refine ⟨box, values, hget, hnode, ?_⟩ + cases rightFields with + | none => trivial + | some rightFacts => + cases leftFields with + | none => simp at hle + | some leftFacts => + exact FieldFactsHold.holds_of_le hle.2 hfields + case pap.pap.loc leftFunction leftSupplied rightFunction rightSupplied + location => + simp only [HeapShape.le, Bool.and_eq_true] at hle + have hfunction : leftFunction = rightFunction := (beq_iff_eq).mp hle.1 + have hsupplied : leftSupplied = rightSupplied := (beq_iff_eq).mp hle.2 + subst rightFunction + subst rightSupplied + exact hleft + all_goals simp [HeapShape.le] at hle + +end HeapShape + +namespace Fact + +/-- Concrete interpretation of a result-shape fact. Scalars are literals or +`erased`; a finite heap fact requires a matching live node. -/ +def Holds (declarations : DeclEnv) (store : Store) + (fact : Fact) (value : RVal) : Prop := + match value with + | .loc _ => + fact.unknownHeap = true ∨ + ∃ shape ∈ fact.shapes, shape.Holds declarations store value + | .lit _ | .erased => fact.mayScalar = true + +@[simp] theorem top_holds (declarations : DeclEnv) (store : Store) + (value : RVal) : Fact.top.Holds declarations store value := by + cases value <;> simp [Fact.Holds, Fact.top] + +@[simp] theorem scalar_holds_iff (declarations : DeclEnv) (store : Store) + (value : RVal) : + Fact.scalar.Holds declarations store value ↔ value.isScalar = true := by + cases value <;> simp [Fact.Holds, Fact.scalar, RVal.isScalar] + +theorem heap_holds {declarations : DeclEnv} {store : Store} + {shape : HeapShape} {value : RVal} + (h : shape.Holds declarations store value) : + (Fact.heap shape).Holds declarations store value := by + cases value with + | loc location => + exact Or.inr ⟨shape, by simp [Fact.heap], h⟩ + | lit literal => cases shape <;> contradiction + | erased => cases shape <;> contradiction + +/-- An exact-constructor fact identifies the concrete constructor stored at +the held location. This is the small provenance bridge used by consumers +whose emitted IxIR₂ instruction carries a concrete constructor identity. -/ +theorem exactConstructor?_holds_loc {declarations : DeclEnv} {store : Store} + {fact : Fact} {identity : CtorId} {location : Nat} + (hexact : fact.exactConstructor? = some identity) + (hholds : fact.Holds declarations store (.loc location)) : + ∃ box fields, + store.get? location = some box ∧ + box.node = .ctorN identity fields := by + obtain ⟨fieldFacts, rfl⟩ := Fact.exactConstructor?_eq_some hexact + simp only [Fact.Holds, Bool.false_eq_true, false_or] at hholds + obtain ⟨shape, hshape, hholds⟩ := hholds + simp only [List.mem_singleton] at hshape + subst shape + simp only [HeapShape.Holds] at hholds + obtain ⟨box, fields, hget, hnode, _⟩ := hholds + exact ⟨box, fields, hget, hnode⟩ + +/-- Executable subset is sound for the concrete interpretation. -/ +theorem holds_of_le {declarations : DeclEnv} {store : Store} + {left right : Fact} {value : RVal} + (hle : left.le right = true) + (hleft : left.Holds declarations store value) : + right.Holds declarations store value := by + cases value with + | lit literal => + simp [Fact.Holds] at hleft ⊢ + simp [Fact.le] at hle + exact hle.1.resolve_left (by simpa [hleft]) + | erased => + simp [Fact.Holds] at hleft ⊢ + simp [Fact.le] at hle + exact hle.1.resolve_left (by simpa [hleft]) + | loc location => + simp only [Fact.Holds] at hleft ⊢ + simp [Fact.le] at hle + rcases hleft with hunknown | ⟨shape, hshape, hholds⟩ + · exact Or.inl (hle.2.resolve_right (by simpa [hunknown])) + · rcases hle.2 with hright | ⟨_, hall⟩ + · exact Or.inl hright + · obtain ⟨rightShape, hrightShape, hshapeLe⟩ := hall shape hshape + exact Or.inr ⟨rightShape, hrightShape, + HeapShape.holds_of_le hshapeLe hholds⟩ + +private theorem holds_join_left {declarations : DeclEnv} {store : Store} + {left right : Fact} {value : RVal} + (hleft : left.Holds declarations store value) : + (left.join right).Holds declarations store value := by + cases value with + | lit literal => + change left.mayScalar = true at hleft + change (left.join right).mayScalar = true + unfold Fact.join Fact.normalize + split <;> simp [hleft] + | erased => + change left.mayScalar = true at hleft + change (left.join right).mayScalar = true + unfold Fact.join Fact.normalize + split <;> simp [hleft] + | loc location => + simp only [Fact.Holds] at hleft ⊢ + cases hleftUnknown : left.unknownHeap with + | true => simp [Fact.join, Fact.normalize, hleftUnknown] + | false => + cases hrightUnknown : right.unknownHeap with + | true => simp [Fact.join, Fact.normalize, hrightUnknown] + | false => + rcases hleft with hunknown | ⟨shape, hmem, hholds⟩ + · simp [hleftUnknown] at hunknown + · refine Or.inr ⟨shape, ?_, hholds⟩ + simpa [Fact.join, Fact.normalize, hleftUnknown, + hrightUnknown] using + HeapShape.mem_normalize_of_mem + (List.mem_append_left right.shapes hmem) + +private theorem holds_join_right {declarations : DeclEnv} {store : Store} + {left right : Fact} {value : RVal} + (hright : right.Holds declarations store value) : + (left.join right).Holds declarations store value := by + cases value with + | lit literal => + change right.mayScalar = true at hright + change (left.join right).mayScalar = true + unfold Fact.join Fact.normalize + split <;> simp [hright] + | erased => + change right.mayScalar = true at hright + change (left.join right).mayScalar = true + unfold Fact.join Fact.normalize + split <;> simp [hright] + | loc location => + simp only [Fact.Holds] at hright ⊢ + cases hleftUnknown : left.unknownHeap with + | true => simp [Fact.join, Fact.normalize, hleftUnknown] + | false => + cases hrightUnknown : right.unknownHeap with + | true => simp [Fact.join, Fact.normalize, hrightUnknown] + | false => + rcases hright with hunknown | ⟨shape, hmem, hholds⟩ + · simp [hrightUnknown] at hunknown + · refine Or.inr ⟨shape, ?_, hholds⟩ + simpa [Fact.join, Fact.normalize, hleftUnknown, + hrightUnknown] using + HeapShape.mem_normalize_of_mem + (List.mem_append_right left.shapes hmem) + +theorem holds_join {declarations : DeclEnv} {store : Store} + {left right : Fact} {value : RVal} : + left.Holds declarations store value ∨ + right.Holds declarations store value → + (left.join right).Holds declarations store value + | Or.inl h => holds_join_left h + | Or.inr h => holds_join_right h + +theorem holds_joins_of_mem {declarations : DeclEnv} {store : Store} + {facts : List Fact} {fact : Fact} {value : RVal} + (hmember : fact ∈ facts) + (hholds : fact.Holds declarations store value) : + (Fact.joins facts).Holds declarations store value := by + induction facts with + | nil => contradiction + | cons head tail ih => + simp only [Fact.joins] + rcases List.mem_cons.mp hmember with hsame | hmember + · subst head + exact Fact.holds_join (Or.inl hholds) + · exact Fact.holds_join (Or.inr (ih hmember)) + +/-- Forgetting heap identities transports a fact across an arbitrary store +change. This is the key alias-safety lemma for primitive operations. -/ +theorem forgetHeap_holds {declarations : DeclEnv} {before after : Store} + {fact : Fact} {value : RVal} + (h : fact.Holds declarations before value) : + fact.forgetHeap.Holds declarations after value := by + cases value with + | lit literal => + change fact.mayScalar = true at h + change fact.forgetHeap.mayScalar = true + unfold Fact.forgetHeap + split <;> simp [h] + | erased => + change fact.mayScalar = true at h + change fact.forgetHeap.mayScalar = true + unfold Fact.forgetHeap + split <;> simp [h] + | loc location => + cases fact with + | mk mayScalar unknownHeap shapes => + cases unknownHeap with + | true => simp [Fact.Holds, Fact.forgetHeap] + | false => + simp only [Fact.Holds, Bool.false_eq_true, false_or] at h + rcases h with ⟨shape, hmem, hholds⟩ + cases shapes with + | nil => contradiction + | cons head tail => simp [Fact.Holds, Fact.forgetHeap] + +end Fact + +namespace HeapShape + +/-- Converting a result heap shape into a field shape preserves every +recursive constructor refinement. -/ +theorem toFieldShape_holds {declarations : DeclEnv} {store : Store} + {shape : HeapShape} {value : RVal} + (h : shape.Holds declarations store value) : + shape.toFieldShape.Holds declarations store value := by + cases shape with + | ctor identity facts => + cases value with + | loc location => + rcases h with ⟨box, fields, hget, hnode, hfields⟩ + cases facts with + | none => exact .ctorIdentity hget hnode + | some facts => exact .ctorDetailed hget hnode hfields + | lit _ => contradiction + | erased => contradiction + | pap function supplied => + cases value with + | loc location => + rcases h with + ⟨box, arguments, declaration, hget, hdecl, hnode, hsize, hproper⟩ + exact .pap hget hdecl hnode hsize hproper + | lit _ => contradiction + | erased => contradiction + +end HeapShape + +namespace FieldShape + +theorem toHeapShape_holds {declarations : DeclEnv} {store : Store} + {shape : FieldShape} {value : RVal} + (h : shape.Holds declarations store value) : + shape.toHeapShape.Holds declarations store value := by + cases h with + | @ctorIdentity location box identity fields hget hnode => + exact ⟨box, fields, hget, hnode, trivial⟩ + | @ctorDetailed location box identity fields facts hget hnode hfields => + exact ⟨box, fields, hget, hnode, hfields⟩ + | @pap location box function declaration arguments supplied hget hdecl + hnode hsize hproper => + exact ⟨box, arguments, declaration, hget, hdecl, hnode, hsize, hproper⟩ + +end FieldShape + +namespace FieldFact + +/-- Storing a result in one constructor field preserves every bounded nested +refinement. -/ +theorem ofFact_holds {declarations : DeclEnv} {store : Store} + {fact : Fact} {value : RVal} + (h : fact.Holds declarations store value) : + (FieldFact.ofFact fact).Holds declarations store value := by + cases value with + | lit literal => + change fact.mayScalar = true at h + apply FieldFact.Holds.lit + cases hunknown : fact.unknownHeap <;> + simp [FieldFact.ofFact, FieldFact.normalize, h, hunknown] + | erased => + change fact.mayScalar = true at h + apply FieldFact.Holds.erased + cases hunknown : fact.unknownHeap <;> + simp [FieldFact.ofFact, FieldFact.normalize, h, hunknown] + | loc location => + simp only [Fact.Holds] at h + rcases h with hunknown | ⟨shape, hshape, hholds⟩ + · apply FieldFact.Holds.unknown + simp [FieldFact.ofFact, FieldFact.normalize, hunknown] + · cases hunknown : fact.unknownHeap with + | true => + apply FieldFact.Holds.unknown + simp [FieldFact.ofFact, FieldFact.normalize, hunknown] + | false => + apply FieldFact.Holds.heap + (shape := shape.toFieldShape) + · have hmapped : shape.toFieldShape ∈ + fact.shapes.map HeapShape.toFieldShape := + List.mem_map.mpr ⟨shape, hshape, rfl⟩ + simpa [FieldFact.ofFact, FieldFact.normalize, hunknown] using + FieldShape.mem_normalize_of_mem hmapped + · exact HeapShape.toFieldShape_holds hholds + +/-- A fetched field fact soundly re-roots its value while preserving every +bounded nested constructor refinement. -/ +theorem toFact_holds {declarations : DeclEnv} {store : Store} + {fact : FieldFact} {value : RVal} + (h : fact.Holds declarations store value) : + fact.toFact.Holds declarations store value := by + cases h with + | lit hscalar => + change fact.toFact.mayScalar = true + cases hunknown : fact.unknownHeap <;> + simp [FieldFact.toFact, Fact.normalize, hscalar, hunknown] + | erased hscalar => + change fact.toFact.mayScalar = true + cases hunknown : fact.unknownHeap <;> + simp [FieldFact.toFact, Fact.normalize, hscalar, hunknown] + | unknown hunknown => + simp only [Fact.Holds] + left + simp [FieldFact.toFact, Fact.normalize, hunknown] + | heap hmember hshape => + simp only [Fact.Holds] + cases hunknown : fact.unknownHeap with + | true => + left + simp [FieldFact.toFact, Fact.normalize, hunknown] + | false => + right + refine ⟨_, ?_, FieldShape.toHeapShape_holds hshape⟩ + simpa [FieldFact.toFact, Fact.normalize, hunknown] using + HeapShape.mem_normalize_of_mem + (List.mem_map.mpr ⟨_, hmember, rfl⟩) + +end FieldFact + +namespace Fact + +/-- A successful concrete constructor projection is covered by the executable +recursive-field fetch transfer. -/ +theorem fetch_holds {declarations : DeclEnv} {store : Store} + {fact : Fact} {location field : Nat} {box : NodeBox} + {identity : CtorId} {fields : Array RVal} {value : RVal} + (hfact : fact.Holds declarations store (.loc location)) + (hget : store.get? location = some box) + (hnode : box.node = .ctorN identity fields) + (hfield : fields[field]? = some value) : + (fact.fetch field).Holds declarations store value := by + cases hunknown : fact.unknownHeap with + | true => + simp [Fact.fetch, hunknown] + | false => + simp only [Fact.Holds, hunknown, Bool.false_eq_true, false_or] at hfact + obtain ⟨shape, hmember, hshape⟩ := hfact + have hmapped : shape.fetch field ∈ + fact.shapes.map (HeapShape.fetch field) := + List.mem_map.mpr ⟨shape, hmember, rfl⟩ + simp only [Fact.fetch, hunknown, Bool.false_eq_true, if_false] + apply Fact.holds_joins_of_mem hmapped + cases shape with + | pap function supplied => + rcases hshape with + ⟨shapeBox, arguments, declaration, hshapeGet, _, hshapeNode, _⟩ + have hboxEq : shapeBox = box := by + exact Option.some.inj (hshapeGet.symm.trans hget) + subst shapeBox + rw [hnode] at hshapeNode + contradiction + | ctor shapeIdentity fieldFacts => + rcases hshape with + ⟨shapeBox, shapeFields, hshapeGet, hshapeNode, hfields⟩ + have hboxEq : shapeBox = box := by + exact Option.some.inj (hshapeGet.symm.trans hget) + subst shapeBox + rw [hnode] at hshapeNode + injection hshapeNode with hidentity hshapeFields + subst shapeIdentity + subst shapeFields + cases fieldFacts with + | none => exact Fact.top_holds declarations store value + | some fieldFacts => + have hfieldList : fields.toList[field]? = some value := by + simpa using hfield + obtain ⟨fieldFact, hfieldFact, hfieldHolds⟩ := + FieldFactsHold.getOfValue hfields hfieldList + simp only [HeapShape.fetch, hfieldFact] + exact FieldFact.toFact_holds hfieldHolds + +end Fact + +/-! ## Abstract/concrete environments -/ + +/-- Pointwise interpretation of an abstract de Bruijn environment. -/ +inductive EnvironmentHolds (declarations : DeclEnv) (store : Store) : + List Fact → List RVal → Prop where + | nil : EnvironmentHolds declarations store [] [] + | cons : fact.Holds declarations store value → + EnvironmentHolds declarations store facts values → + EnvironmentHolds declarations store (fact :: facts) (value :: values) + +namespace EnvironmentHolds + +theorem top_replicate (declarations : DeclEnv) (store : Store) + (values : List RVal) : + EnvironmentHolds declarations store + (List.replicate values.length Fact.top) values := by + induction values with + | nil => exact .nil + | cons value values ih => + simpa [List.replicate_succ] using EnvironmentHolds.cons + (Fact.top_holds declarations store value) ih + +theorem forgetHeap {declarations : DeclEnv} {before after : Store} + {facts : List Fact} {values : List RVal} + (h : EnvironmentHolds declarations before facts values) : + EnvironmentHolds declarations after (facts.map Fact.forgetHeap) values := by + induction h with + | nil => exact .nil + | cons hhead htail ih => + exact .cons (Fact.forgetHeap_holds hhead) ih + +theorem get? {declarations : DeclEnv} {store : Store} + {facts : List Fact} {values : List RVal} + (h : EnvironmentHolds declarations store facts values) + {index : Nat} {fact : Fact} {value : RVal} + (hfact : facts[index]? = some fact) + (hvalue : values[index]? = some value) : + fact.Holds declarations store value := by + induction h generalizing index fact value with + | nil => simp at hfact + | @cons headFact headValue tailFacts tailValues hhead htail ih => + cases index with + | zero => + simp at hfact hvalue + subst fact + subst value + exact hhead + | succ index => + simp at hfact hvalue + exact ih hfact hvalue + +theorem append_top {declarations : DeclEnv} {store : Store} + {facts : List Fact} {values : List RVal} + (front : List RVal) + (h : EnvironmentHolds declarations store facts values) : + EnvironmentHolds declarations store + (List.replicate front.length Fact.top ++ facts) + (front ++ values) := by + induction front with + | nil => simpa using h + | cons value tail ih => + change EnvironmentHolds declarations store + (Fact.top :: (List.replicate tail.length Fact.top ++ facts)) + (value :: (tail ++ values)) + exact EnvironmentHolds.cons + (Fact.top_holds declarations store value) ih + +theorem append {declarations : DeclEnv} {store : Store} + {leftFacts rightFacts : List Fact} {leftValues rightValues : List RVal} + (left : EnvironmentHolds declarations store leftFacts leftValues) + (right : EnvironmentHolds declarations store rightFacts rightValues) : + EnvironmentHolds declarations store (leftFacts ++ rightFacts) + (leftValues ++ rightValues) := by + induction left with + | nil => simpa using right + | cons hhead htail ih => + exact .cons hhead ih + +theorem length_eq {declarations : DeclEnv} {store : Store} + {facts : List Fact} {values : List RVal} + (h : EnvironmentHolds declarations store facts values) : + facts.length = values.length := by + induction h with + | nil => rfl + | cons _ _ ih => simp [ih] + +/-- Reversing both sides preserves the pointwise environment relation. -/ +theorem reverse {declarations : DeclEnv} {store : Store} + {facts : List Fact} {values : List RVal} + (h : EnvironmentHolds declarations store facts values) : + EnvironmentHolds declarations store facts.reverse values.reverse := by + induction h with + | nil => exact .nil + | cons hhead htail ih => + simp only [List.reverse_cons] + exact ih.append (.cons hhead .nil) + +end EnvironmentHolds + +namespace FieldFactsHold + +/-- Re-root a detailed constructor's source-order field facts as ordinary +facts suitable for case binders. -/ +theorem toEnvironment {declarations : DeclEnv} {store : Store} + {facts : List FieldFact} {values : List RVal} + (h : FieldFactsHold declarations store facts values) : + EnvironmentHolds declarations store + (facts.map FieldFact.toFact) values := by + cases h with + | nil => exact .nil + | cons hhead htail => + exact .cons (FieldFact.toFact_holds hhead) + (FieldFactsHold.toEnvironment htail) +termination_by sizeOf facts +decreasing_by all_goals subst_vars <;> simp_wf <;> omega + +end FieldFactsHold + +namespace Fact + +private theorem mem_vectorHeads {vectors : List (List Fact)} + {fact : Fact} {facts : List Fact} + (h : fact :: facts ∈ vectors) : fact ∈ vectorHeads vectors := by + induction vectors with + | nil => contradiction + | cons vector vectors ih => + rcases List.mem_cons.mp h with hsame | htail + · subst vector + simp [vectorHeads] + · cases vector with + | nil => simpa [vectorHeads] using ih htail + | cons head tail => + exact List.mem_cons.mpr (Or.inr (ih htail)) + +private theorem mem_vectorTails {vectors : List (List Fact)} + {fact : Fact} {facts : List Fact} + (h : fact :: facts ∈ vectors) : facts ∈ vectorTails vectors := by + induction vectors with + | nil => contradiction + | cons vector vectors ih => + rcases List.mem_cons.mp h with hsame | htail + · subst vector + simp [vectorTails] + · cases vector with + | nil => simpa [vectorTails] using ih htail + | cons head tail => + exact List.mem_cons.mpr (Or.inr (ih htail)) + +end Fact + +namespace EnvironmentHolds + +/-- Any concrete candidate vector is covered by the executable pointwise join +of its equally sized candidate family. -/ +theorem joinFieldVectors_of_mem {declarations : DeclEnv} {store : Store} + {fieldCount : Nat} {vectors : List (List Fact)} + {facts : List Fact} {values : List RVal} + (hmember : facts ∈ vectors) (hlength : facts.length = fieldCount) + (hholds : EnvironmentHolds declarations store facts values) : + EnvironmentHolds declarations store + (Fact.joinFieldVectors fieldCount vectors) values := by + induction hholds generalizing fieldCount vectors with + | nil => + cases fieldCount with + | zero => exact .nil + | succ fieldCount => simp at hlength + | @cons fact value facts values hhead htail ih => + cases fieldCount with + | zero => simp at hlength + | succ fieldCount => + simp only [List.length_cons, Nat.succ.injEq] at hlength + exact .cons + (Fact.holds_joins_of_mem (Fact.mem_vectorHeads hmember) hhead) + (ih (Fact.mem_vectorTails hmember) hlength) + +end EnvironmentHolds + +namespace Fact + +/-- A successful constructor case receives the joined facts computed for its +actual field vector, in the evaluator's reversed binding order. -/ +theorem caseFields_ctor_holds {declarations : DeclEnv} {store : Store} + {fact : Fact} {location : Nat} {box : NodeBox} + {identity : CtorId} {fields : Array RVal} + (peelNat : Bool) (cidx fieldCount : Nat) + (hfact : fact.Holds declarations store (.loc location)) + (hget : store.get? location = some box) + (hnode : box.node = .ctorN identity fields) + (hcidx : identity.cidx = cidx) + (hfieldCount : fields.size = fieldCount) : + EnvironmentHolds declarations store + (fact.caseFields peelNat cidx fieldCount) fields.toList.reverse := by + cases hunknown : fact.unknownHeap with + | true => + have htop := EnvironmentHolds.top_replicate declarations store + fields.toList.reverse + have hlength : fields.toList.reverse.length = fieldCount := by + simpa using hfieldCount + simpa [Fact.caseFields, hunknown, hlength] using htop + | false => + simp only [Fact.Holds, hunknown, Bool.false_eq_true, false_or] at hfact + obtain ⟨shape, hshapeMember, hshapeHolds⟩ := hfact + let vector := shape.caseFields cidx fieldCount + have hvectorHolds : EnvironmentHolds declarations store vector + fields.toList.reverse := by + cases shape with + | pap function supplied => + rcases hshapeHolds with + ⟨shapeBox, arguments, declaration, hshapeGet, _, hshapeNode, _⟩ + have hboxEq : shapeBox = box := + Option.some.inj (hshapeGet.symm.trans hget) + subst shapeBox + rw [hnode] at hshapeNode + contradiction + | ctor shapeIdentity shapeFieldFacts => + rcases hshapeHolds with + ⟨shapeBox, shapeFields, hshapeGet, hshapeNode, hshapeFacts⟩ + have hboxEq : shapeBox = box := + Option.some.inj (hshapeGet.symm.trans hget) + subst shapeBox + rw [hnode] at hshapeNode + injection hshapeNode with hidentity hshapeFields + subst shapeIdentity + subst shapeFields + have hcidxBool : identity.cidx == cidx := + (beq_iff_eq).mpr hcidx + cases shapeFieldFacts with + | none => + have htop := EnvironmentHolds.top_replicate declarations + store fields.toList.reverse + have hlength : fields.toList.reverse.length = fieldCount := by + simpa using hfieldCount + simpa [vector, HeapShape.caseFields, hcidxBool, hlength] + using htop + | some fieldFacts => + have hfieldsLength : fields.toList.length = fieldCount := by + simpa using hfieldCount + have hfactLength : fieldFacts.length = fieldCount := + hshapeFacts.length_eq.trans hfieldsLength + have hfieldsEnvironment := hshapeFacts.toEnvironment.reverse + simpa [vector, HeapShape.caseFields, hcidxBool, hfactLength] + using hfieldsEnvironment + let heapCandidates := + fact.shapes.map (HeapShape.caseFields cidx fieldCount) + let candidates := + if fact.mayScalar then + scalarCaseFields peelNat cidx fieldCount :: heapCandidates + else + heapCandidates + have hheapMember : vector ∈ heapCandidates := + List.mem_map.mpr ⟨shape, hshapeMember, rfl⟩ + have hcandidate : vector ∈ candidates := by + dsimp [candidates] + split + · exact List.mem_cons.mpr (Or.inr hheapMember) + · exact hheapMember + have hlength : vector.length = fieldCount := by + rw [hvectorHolds.length_eq] + simpa using hfieldCount + have hjoined := EnvironmentHolds.joinFieldVectors_of_mem + hcandidate hlength hvectorHolds + simpa [Fact.caseFields, hunknown, heapCandidates, candidates] + using hjoined + +/-- A successfully peeled successor binds its predecessor as an exact scalar +even when heap shapes are also possible. -/ +theorem caseFields_natSucc_holds {declarations : DeclEnv} {store : Store} + {fact : Fact} {value : Nat} + (hfact : fact.Holds declarations store (.lit (.nat (value + 1)))) : + EnvironmentHolds declarations store + (fact.caseFields true 1 1) [.lit (.nat value)] := by + change fact.mayScalar = true at hfact + cases hunknown : fact.unknownHeap with + | true => + simpa [Fact.caseFields, hunknown] using + (EnvironmentHolds.cons + (Fact.top_holds declarations store (.lit (.nat value))) + EnvironmentHolds.nil) + | false => + have hscalar : EnvironmentHolds declarations store + [Fact.scalar] [.lit (.nat value)] := + .cons (by simp [Fact.Holds, Fact.scalar]) .nil + have hjoined := EnvironmentHolds.joinFieldVectors_of_mem + (vectors := [Fact.scalar] :: + fact.shapes.map (HeapShape.caseFields 1 1)) + (fieldCount := 1) (facts := [Fact.scalar]) + (by simp) (by simp) hscalar + simpa [Fact.caseFields, hunknown, hfact, scalarCaseFields] using hjoined + +end Fact + +/-! ## Resolution and store primitives -/ + +theorem resolveAtom_sound {declarations : DeclEnv} {store : Store} + {facts : List Fact} {values : List RVal} {atom : Atom} + {fact : Fact} {value : RVal} + (henvironment : EnvironmentHolds declarations store facts values) + (habstract : resolveAtomFact facts atom = .ok fact) + (hconcrete : resolveAtom values atom = .ok value) : + fact.Holds declarations store value := by + cases atom with + | var index => + unfold resolveAtomFact at habstract + unfold resolveAtom at hconcrete + cases hfact : facts[index]? with + | none => simp [hfact] at habstract + | some resolvedFact => + simp only [hfact] at habstract + cases hvalue : values[index]? with + | none => simp [hvalue] at hconcrete + | some resolvedValue => + simp only [hvalue] at hconcrete + injection habstract with hfactEq + injection hconcrete with hvalueEq + subst fact + subst value + exact henvironment.get? hfact hvalue + | lit literal => + simp only [resolveAtomFact, Except.ok.injEq] at habstract + simp only [resolveAtom, Except.ok.injEq] at hconcrete + subst fact + subst value + simp [Fact.Holds, Fact.scalar] + | erased => + simp only [resolveAtomFact, Except.ok.injEq] at habstract + simp only [resolveAtom, Except.ok.injEq] at hconcrete + subst fact + subst value + simp [Fact.Holds, Fact.scalar] + +/-- A well-formed abstract environment cannot resolve an atom that the +pointwise concrete environment fails to resolve. -/ +theorem resolveAtom_complete {declarations : DeclEnv} {store : Store} + {facts : List Fact} {values : List RVal} {atom : Atom} {fact : Fact} + (henvironment : EnvironmentHolds declarations store facts values) + (habstract : resolveAtomFact facts atom = .ok fact) : + ∃ value, resolveAtom values atom = .ok value := by + cases atom with + | lit literal => exact ⟨.lit literal, rfl⟩ + | erased => exact ⟨.erased, rfl⟩ + | var index => + induction henvironment generalizing index fact with + | nil => simp [resolveAtomFact] at habstract + | @cons tailFacts tailValues headFact headValue hhead htail ih => + cases index with + | zero => exact ⟨headValue, by simp [resolveAtom]⟩ + | succ index => + cases hfact : tailFacts[index]? with + | none => simp [resolveAtomFact, hfact] at habstract + | some resolved => + obtain ⟨value, hvalue⟩ := ih (fact := resolved) + (index := index) (by simp [resolveAtomFact, hfact]) + unfold resolveAtom at hvalue ⊢ + cases hconcrete : tailValues[index]? with + | none => simp [hconcrete] at hvalue + | some resolvedValue => + simp only [hconcrete, Except.ok.injEq] at hvalue + subst resolvedValue + exact ⟨value, by simp [hconcrete]⟩ + +private theorem List.resolveAtomFactsFrom_sound + {declarations : DeclEnv} {store : Store} + {facts : List Fact} {values : List RVal} + (henvironment : EnvironmentHolds declarations store facts values) : + ∀ (atoms : List Atom) (factAccumulator : List Fact) + (valueAccumulator : List RVal) (outputFacts : List Fact) + (outputValues : List RVal), + EnvironmentHolds declarations store factAccumulator valueAccumulator → + atoms.foldlM + (fun accumulated atom => do + pure (accumulated ++ [← resolveAtomFact facts atom])) + factAccumulator = .ok outputFacts → + atoms.foldlM + (fun accumulated atom => do + pure (accumulated ++ [← resolveAtom values atom])) + valueAccumulator = .ok outputValues → + EnvironmentHolds declarations store outputFacts outputValues := by + intro atoms + induction atoms with + | nil => + intro factAccumulator valueAccumulator outputFacts outputValues + haccumulator habstract hconcrete + simp only [List.foldlM_nil] at habstract hconcrete + injection habstract with hfacts + injection hconcrete with hvalues + subst outputFacts + subst outputValues + exact haccumulator + | cons atom atoms ih => + intro factAccumulator valueAccumulator outputFacts outputValues + haccumulator habstract hconcrete + simp only [List.foldlM_cons] at habstract hconcrete + cases hafact : resolveAtomFact facts atom with + | error error => + rw [hafact] at habstract + simp only [bind, Except.bind] at habstract + contradiction + | ok atomFact => + rw [hafact] at habstract + simp only [bind, Except.bind] at habstract + cases havalue : resolveAtom values atom with + | error error => + rw [havalue] at hconcrete + simp only [bind, Except.bind] at hconcrete + contradiction + | ok atomValue => + rw [havalue] at hconcrete + simp only [bind, Except.bind] at hconcrete + apply ih (factAccumulator ++ [atomFact]) + (valueAccumulator ++ [atomValue]) outputFacts outputValues + · exact haccumulator.append (.cons + (resolveAtom_sound henvironment hafact havalue) .nil) + · exact habstract + · exact hconcrete + +theorem resolveAtomFacts_sound + {declarations : DeclEnv} {store : Store} + {facts : List Fact} {values : List RVal} {atoms : Array Atom} + {argumentFacts : List Fact} {argumentValues : List RVal} + (henvironment : EnvironmentHolds declarations store facts values) + (habstract : resolveAtomFacts facts atoms = .ok argumentFacts) + (hconcrete : resolveAtoms values atoms = .ok argumentValues) : + EnvironmentHolds declarations store argumentFacts argumentValues := by + unfold resolveAtomFacts at habstract + unfold resolveAtoms at hconcrete + rw [← Array.foldlM_toList] at habstract hconcrete + exact List.resolveAtomFactsFrom_sound henvironment atoms.toList [] [] + argumentFacts argumentValues .nil habstract hconcrete + +private theorem List.resolveAtomsFrom_length (environment : List RVal) : + ∀ (atoms : List Atom) (accumulator output : List RVal), + atoms.foldlM + (fun accumulated atom => do + pure (accumulated ++ [← resolveAtom environment atom])) + accumulator = .ok output → + output.length = accumulator.length + atoms.length := by + intro atoms + induction atoms with + | nil => + intro accumulator output h + simp only [List.foldlM_nil] at h + change Except.ok accumulator = Except.ok output at h + injection h with houtput + subst output + simp + | cons atom atoms ih => + intro accumulator output h + simp only [List.foldlM_cons] at h + cases hatom : resolveAtom environment atom with + | error error => + rw [hatom] at h + simp only [bind, Except.bind] at h + contradiction + | ok value => + rw [hatom] at h + simp only [bind, Except.bind] at h + have htail := ih (accumulator ++ [value]) output h + simp only [List.length_append, List.length_singleton] at htail + simp only [List.length_cons] + omega + +private theorem resolveAtoms_length {environment : List RVal} + {atoms : Array Atom} {values : List RVal} + (h : resolveAtoms environment atoms = .ok values) : + values.length = atoms.size := by + unfold resolveAtoms at h + rw [← Array.foldlM_toList] at h + have := List.resolveAtomsFrom_length environment atoms.toList [] values h + simpa using this + +private theorem get?_allocNode_new (store : Store) + (world : Ixon.Owned) (node : Node) : + (store.allocNode world node).1.get? (store.allocNode world node).2 = + some ⟨world, 1, node⟩ := by + simp [Store.allocNode, Store.get?] + +private theorem get?_allocNode_old {store : Store} {world : Ixon.Owned} + {node : Node} {location : Nat} {box : NodeBox} + (h : store.get? location = some box) : + (store.allocNode world node).1.get? location = some box := by + have hne : location ≠ store.nodes.size := by + intro heq + subst location + simp [Store.get?] at h + simpa [Store.allocNode, Store.get?, Array.getElem?_push, hne] using h + +mutual + +theorem FieldShape.holds_allocNode {declarations : DeclEnv} {store : Store} + {shape : FieldShape} {value : RVal} {world : Ixon.Owned} {node : Node} + (h : shape.Holds declarations store value) : + shape.Holds declarations (store.allocNode world node).1 value := by + cases h with + | ctorIdentity hget hnode => + exact .ctorIdentity (get?_allocNode_old hget) hnode + | ctorDetailed hget hnode hfields => + exact .ctorDetailed (get?_allocNode_old hget) hnode + (FieldFactsHold.allocNode hfields) + | pap hget hdecl hnode hsize hproper => + exact .pap (get?_allocNode_old hget) hdecl hnode hsize hproper +termination_by sizeOf shape +decreasing_by all_goals subst_vars <;> simp_wf <;> omega + +theorem FieldFact.holds_allocNode {declarations : DeclEnv} {store : Store} + {fact : FieldFact} {value : RVal} {world : Ixon.Owned} {node : Node} + (h : fact.Holds declarations store value) : + fact.Holds declarations (store.allocNode world node).1 value := by + cases h with + | lit hscalar => exact .lit hscalar + | erased hscalar => exact .erased hscalar + | unknown hunknown => exact .unknown hunknown + | heap hmember hshape => + exact .heap hmember (FieldShape.holds_allocNode hshape) +termination_by sizeOf fact +decreasing_by + all_goals subst_vars + exact FieldFact.shape_size_lt hmember + +theorem FieldFactsHold.allocNode {declarations : DeclEnv} {store : Store} + {facts : List FieldFact} {values : List RVal} + {world : Ixon.Owned} {node : Node} + (h : FieldFactsHold declarations store facts values) : + FieldFactsHold declarations (store.allocNode world node).1 facts values := by + cases h with + | nil => exact .nil + | cons hhead htail => + exact .cons (FieldFact.holds_allocNode hhead) + (FieldFactsHold.allocNode htail) +termination_by sizeOf facts +decreasing_by all_goals subst_vars <;> simp_wf <;> omega + +end + +namespace EnvironmentHolds + +theorem toFieldFactsAllocNode {declarations : DeclEnv} {store : Store} + {facts : List Fact} {values : List RVal} + {world : Ixon.Owned} {node : Node} + (h : EnvironmentHolds declarations store facts values) : + FieldFactsHold declarations (store.allocNode world node).1 + (facts.map FieldFact.ofFact) values := by + induction h with + | nil => exact .nil + | cons hhead htail ih => + exact .cons (FieldFact.holds_allocNode (FieldFact.ofFact_holds hhead)) ih + +theorem toFieldFactsForget {declarations : DeclEnv} {before after : Store} + {facts : List Fact} {values : List RVal} + (h : EnvironmentHolds declarations before facts values) : + FieldFactsHold declarations after + (facts.map fun fact => FieldFact.ofFact fact.forgetHeap) values := by + induction h with + | nil => exact .nil + | cons hhead htail ih => + exact .cons + (FieldFact.ofFact_holds (Fact.forgetHeap_holds (after := after) hhead)) + ih + +end EnvironmentHolds + +private theorem nodes_get?_of_get? {store : Store} {location : Nat} + {box : NodeBox} (h : store.get? location = some box) : + store.nodes[location]? = some (some box) := by + rw [Store.get?, Option.bind_eq_some_iff] at h + obtain ⟨slot, hslot, hid⟩ := h + change slot = some box at hid + subst slot + exact hslot + +private theorem get?_setBox_same {store : Store} {location : Nat} + {old new : NodeBox} (h : store.get? location = some old) : + (store.setBox location new).get? location = some new := by + have hnodes := nodes_get?_of_get? h + obtain ⟨hlt, _⟩ := Array.getElem?_eq_some_iff.mp hnodes + simp [Store.setBox, Store.get?, Array.set!_eq_setIfInBounds, hlt] + +private theorem scalar_of_callScalarOracle_eq_ok {ctx : Ctx} {function : Address} + {arguments : List RVal} {value : RVal} + (h : callScalarOracle ctx function arguments = .ok value) : + value.isScalar = true := by + unfold callScalarOracle at h + split at h + · contradiction + · split at h + · contradiction + · split at h + · injection h + subst value + assumption + · contradiction + +private theorem eq_of_checkResultWorld_eq_ok {world : Ixon.Owned} + {input output : Store × RVal} + (h : checkResultWorld world input = .ok output) : input = output := by + unfold checkResultWorld at h + split at h + · injection h + · contradiction + +private theorem List.foldl_cons_eq_reverse_append + (values environment : List RVal) : + values.foldl (fun current value => value :: current) environment = + values.reverse ++ environment := by + induction values generalizing environment with + | nil => rfl + | cons value values ih => + simp only [List.foldl_cons] + rw [ih] + simp [List.reverse_cons, List.append_assoc] + +private theorem Array.foldl_cons_eq_reverse_append + (fields : Array RVal) (environment : List RVal) : + fields.foldl (fun current field => field :: current) environment = + fields.toList.reverse ++ environment := by + rw [← Array.foldl_toList] + exact List.foldl_cons_eq_reverse_append fields.toList environment + +/-! ## Local certificate assumption -/ + +/-- Propositional reading of the function rows in a post-fixpoint. Every +claimed function summary contains the result inferred with the same complete +summary environment. -/ +def LocalPostFixpoint (declarations : DeclEnv) (summaries : SummaryEnv) : Prop := + ∀ address function claimed, + declarations address = some (.fn function) → + summaries address = some claimed → + ∃ inferred, + inferFunction declarations summaries address function = .ok inferred ∧ + inferred.le claimed = true + +/-- An analysis owner is semantically usable either when it names the exact +dynamic current function, or when it has no summary and every attempted +`callSelf` transfer therefore fails closed. The second form is the natural +contract for a top-level main, which has a current frame but no declaration +row. -/ +def AnalysisOwnerCompatible (declarations : DeclEnv) (summaries : SummaryEnv) + (owner : Address) (current : FnDef) : Prop := + declarations owner = some (.fn current) ∨ summaries owner = none + +/-! ## Finite shape-fold coverage -/ + +theorem holds_of_applyShapeFacts_member + {declarations : DeclEnv} {store : Store} + {step : HeapShape → Except String Fact} {shapes : List HeapShape} + {shape : HeapShape} {shapeFact result : Fact} {value : RVal} + (hmember : shape ∈ shapes) + (hshape : step shape = .ok shapeFact) + (hresult : applyShapeFacts step shapes = .ok result) + (hholds : shapeFact.Holds declarations store value) : + result.Holds declarations store value := by + induction shapes generalizing result with + | nil => contradiction + | cons head tail ih => + simp only [applyShapeFacts, bind, Except.bind] at hresult + cases hhead : step head with + | error error => simp [hhead, Except.map] at hresult + | ok headFact => + cases htail : applyShapeFacts step tail with + | error error => simp [hhead, htail, Except.map] at hresult + | ok tailFact => + simp [hhead, htail, Except.map] at hresult + change Except.ok (headFact.join tailFact) = + Except.ok result at hresult + injection hresult with hresultEq + subst result + rcases List.mem_cons.mp hmember with hsame | hmember + · subst head + have : headFact = shapeFact := by + rw [hhead] at hshape + injection hshape + subst headFact + exact Fact.holds_join (Or.inl hholds) + · exact Fact.holds_join (Or.inr + (ih hmember htail)) + +theorem applyShapeFacts_ne_ok_of_member_error + {step : HeapShape → Except String Fact} {shapes : List HeapShape} + {shape : HeapShape} {error : String} {result : Fact} + (hmember : shape ∈ shapes) + (hshape : step shape = .error error) + (hresult : applyShapeFacts step shapes = .ok result) : False := by + induction shapes generalizing result with + | nil => contradiction + | cons head tail ih => + simp only [applyShapeFacts, bind, Except.bind] at hresult + cases hhead : step head with + | error headError => simp [hhead] at hresult + | ok headFact => + rw [hhead] at hresult + simp only [bind, Except.bind] at hresult + rcases List.mem_cons.mp hmember with hsame | hmember + · subst head + rw [hhead] at hshape + contradiction + · cases htail : applyShapeFacts step tail with + | error tailError => simp [htail] at hresult + | ok tailFact => exact ih hmember htail + +/-! ## Fuel-indexed semantic theorem -/ + +private def CodeSoundAt (declarations : DeclEnv) (summaries : SummaryEnv) + (fuel : Nat) : Prop := + ∀ ctx owner current store facts values code outputStore outputValue inferred, + ctx.decls = declarations → + AnalysisOwnerCompatible declarations summaries owner current → + EnvironmentHolds declarations store facts values → + analyzeCode declarations summaries owner current facts code = .ok inferred → + runCode ctx fuel current store values code = + .ok (outputStore, outputValue) → + inferred.Holds declarations outputStore outputValue + +private theorem analyzeAlternatives_sound + {declarations : DeclEnv} {summaries : SummaryEnv} {fuel : Nat} + (hcode : CodeSoundAt declarations summaries fuel) + {ctx : Ctx} {owner : Address} {current : FnDef} {store : Store} + {scrutineeFact : Fact} {peelNat : Bool} + {facts : List Fact} {values : List RVal} {alternatives : List Alt} + {cidx fieldCount : Nat} {body : Code} {fieldValues : List RVal} + {outputStore : Store} {outputValue : RVal} {inferred : Fact} + (hctx : ctx.decls = declarations) + (hcurrent : AnalysisOwnerCompatible declarations summaries owner current) + (henvironment : EnvironmentHolds declarations store facts values) + (hmember : Alt.mk cidx fieldCount body ∈ alternatives) + (hbinders : EnvironmentHolds declarations store + (scrutineeFact.caseFields peelNat cidx fieldCount) fieldValues) + (habstract : analyzeAlternatives declarations summaries owner current + scrutineeFact peelNat facts alternatives = .ok inferred) + (hconcrete : runCode ctx fuel current store (fieldValues ++ values) body = + .ok (outputStore, outputValue)) : + inferred.Holds declarations outputStore outputValue := by + induction alternatives generalizing inferred with + | nil => contradiction + | cons head tail ih => + cases head with + | mk headCidx headFields headBody => + simp only [analyzeAlternatives, bind, Except.bind] at habstract + cases hhead : analyzeCode declarations summaries owner current + (scrutineeFact.caseFields peelNat headCidx headFields ++ facts) + headBody with + | error error => simp [hhead] at habstract + | ok headFact => + rw [hhead] at habstract + simp only [bind, Except.bind] at habstract + cases htail : analyzeAlternatives declarations summaries owner + current scrutineeFact peelNat facts tail with + | error error => simp [htail] at habstract + | ok tailFact => + rw [htail] at habstract + change Except.ok (headFact.join tailFact) = + Except.ok inferred at habstract + injection habstract with hinferred + subst inferred + rcases List.mem_cons.mp hmember with hsame | hmember + · injection hsame with hcidx hfields hbody + subst headCidx + subst headFields + subst headBody + have hfront := hbinders.append henvironment + exact Fact.holds_join (Or.inl + (hcode ctx owner current store + (scrutineeFact.caseFields peelNat cidx fieldCount ++ facts) + (fieldValues ++ values) body outputStore outputValue + headFact hctx hcurrent hfront hhead hconcrete)) + · exact Fact.holds_join (Or.inr + (ih hmember htail)) + +private def SoundAt (declarations : DeclEnv) (summaries : SummaryEnv) + (fuel : Nat) : Prop := + CodeSoundAt declarations summaries fuel ∧ + (∀ ctx owner current store facts values operation outputStore outputValue inferred, + ctx.decls = declarations → + AnalysisOwnerCompatible declarations summaries owner current → + EnvironmentHolds declarations store facts values → + analyzeOp declarations summaries owner current facts operation = .ok inferred → + runOp ctx fuel current store values operation = + .ok (outputStore, outputValue) → + inferred.Holds declarations outputStore outputValue) ∧ + (∀ ctx address arguments store outputStore outputValue fact, + ctx.decls = declarations → + callableResult declarations summaries address = .ok fact → + invoke ctx fuel address arguments store = .ok (outputStore, outputValue) → + fact.Holds declarations outputStore outputValue) ∧ + (∀ ctx store function arguments outputStore outputValue functionFact + resultFact abstractFuel, + ctx.decls = declarations → + functionFact.Holds declarations store function → + applyFact declarations summaries abstractFuel functionFact + arguments.length = .ok resultFact → + applyGo ctx fuel store function arguments = .ok (outputStore, outputValue) → + resultFact.Holds declarations outputStore outputValue) + +private theorem soundAt {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) : + ∀ fuel, SoundAt declarations summaries fuel := by + intro fuel + induction fuel with + | zero => + refine ⟨?_, ?_, ?_, ?_⟩ + · intro ctx owner current store facts values code outputStore outputValue + inferred hctx hcurrent henvironment habstract hconcrete + rw [runCode.eq_def] at hconcrete + simp at hconcrete + · intro ctx owner current store facts values operation outputStore + outputValue inferred hctx hcurrent henvironment habstract hconcrete + rw [runOp.eq_def] at hconcrete + simp at hconcrete + · intro ctx address arguments store outputStore outputValue fact hctx + habstract hconcrete + rw [invoke.eq_def] at hconcrete + simp at hconcrete + · intro ctx store function arguments outputStore outputValue functionFact + resultFact abstractFuel hctx hfunction habstract hconcrete + rw [applyGo.eq_def] at hconcrete + simp at hconcrete + | succ fuel ih => + obtain ⟨ihCode, ihOp, ihInvoke, ihApply⟩ := ih + refine ⟨?_, ?_, ?_, ?_⟩ + · intro ctx owner current store facts values code outputStore outputValue + inferred hctx hcurrent henvironment habstract hconcrete + cases code with + | ret atom => + have habstract' : resolveAtomFact facts atom = .ok inferred := by + simpa only [analyzeCode] using habstract + rw [runCode.eq_def] at hconcrete + dsimp only at hconcrete + cases hresolve : resolveAtom values atom with + | error error => + rw [hresolve] at hconcrete + simp only [bind, Except.bind] at hconcrete + contradiction + | ok value => + rw [hresolve] at hconcrete + simp only [bind, Except.bind] at hconcrete + change Except.ok (store, value) = + Except.ok (outputStore, outputValue) at hconcrete + injection hconcrete with houtput + cases houtput + exact resolveAtom_sound henvironment habstract' hresolve + | letOp operation rest => + simp only [analyzeCode, bind, Except.bind] at habstract + cases haop : analyzeOp declarations summaries owner current facts + operation with + | error error => + rw [haop] at habstract + contradiction + | ok bound => + rw [haop] at habstract + simp only [bind, Except.bind] at habstract + rw [runCode.eq_def] at hconcrete + dsimp only at hconcrete + cases hop : runOp ctx fuel current store values operation with + | error error => + rw [hop] at hconcrete + simp only [bind, Except.bind] at hconcrete + contradiction + | ok operationOutput => + rcases operationOutput with ⟨middleStore, middleValue⟩ + rw [hop] at hconcrete + simp only [bind, Except.bind] at hconcrete + have hbound := ihOp ctx owner current store facts values + operation middleStore middleValue bound hctx hcurrent + henvironment haop hop + have hold := EnvironmentHolds.forgetHeap + (after := middleStore) henvironment + exact ihCode ctx owner current middleStore + (bound :: facts.map Fact.forgetHeap) + (middleValue :: values) rest outputStore outputValue + inferred hctx hcurrent (.cons hbound hold) habstract + hconcrete + | case scrutinee peelNat alternatives => + simp only [analyzeCode, bind, Except.bind] at habstract + cases hascrut : resolveAtomFact facts scrutinee with + | error error => + rw [hascrut] at habstract + contradiction + | ok scrutineeFact => + rw [hascrut] at habstract + simp only [bind, Except.bind] at habstract + rw [runCode.eq_def] at hconcrete + dsimp only at hconcrete + cases hscrut : resolveAtom values scrutinee with + | error error => + rw [hscrut] at hconcrete + simp only [bind, Except.bind] at hconcrete + contradiction + | ok scrutineeValue => + rw [hscrut] at hconcrete + simp only [bind, Except.bind] at hconcrete + have hscrutineeHolds : scrutineeFact.Holds declarations + store scrutineeValue := + resolveAtom_sound henvironment hascrut hscrut + cases scrutineeValue with + | loc location => + dsimp only at hconcrete + cases hbox : store.get? location with + | none => simp [hbox] at hconcrete + | some box => + simp only [hbox] at hconcrete + cases box with + | mk world rc node => + cases node with + | papN function arity captured => + simp at hconcrete + | ctorN identity fields => + cases halt : alternatives.find? + (fun alternative => + alternative.cidx == identity.cidx) with + | none => simp [halt] at hconcrete + | some alternative => + cases alternative with + | mk cidx fieldCount body => + cases hsize : fields.size != fieldCount + · simp only [halt, hsize, + Bool.false_eq_true, if_false] + at hconcrete + rw [Array.foldl_cons_eq_reverse_append] + at hconcrete + have hmember : Alt.mk cidx fieldCount body ∈ + alternatives.toList := by + simpa using + Array.mem_of_find?_eq_some halt + have hcidx : identity.cidx = cidx := by + have hmatch := Array.find?_some + (p := fun alternative : Alt => + alternative.cidx == + identity.cidx) + (a := .mk cidx fieldCount body) + (xs := alternatives) halt + exact (beq_iff_eq.mp hmatch).symm + have hfieldCount : + fields.size = fieldCount := by + simpa using hsize + have hbinders := + Fact.caseFields_ctor_holds + peelNat cidx fieldCount + hscrutineeHolds hbox rfl hcidx + hfieldCount + exact analyzeAlternatives_sound ihCode + hctx hcurrent henvironment hmember + hbinders habstract hconcrete + · simp [halt, hsize] at hconcrete + | lit literal => + cases literal with + | str string => simp at hconcrete + | nat value => + cases hpeel : peelNat with + | false => simp [hpeel] at hconcrete + | true => + cases value with + | zero => + cases halt : alternatives.find? + (fun alternative => + alternative.cidx == 0) with + | none => simp [hpeel, halt] at hconcrete + | some alternative => + cases alternative with + | mk cidx fieldCount body => + cases fieldCount with + | zero => + simp only [hpeel, halt] + at hconcrete + have hmember : Alt.mk cidx 0 body ∈ + alternatives.toList := by + simpa using + Array.mem_of_find?_eq_some halt + have hbinders : + EnvironmentHolds declarations + store + (scrutineeFact.caseFields + peelNat cidx 0) [] := by + simpa [Fact.caseFields, + Fact.joinFieldVectors] using + (EnvironmentHolds.nil : + EnvironmentHolds + declarations store [] []) + exact analyzeAlternatives_sound ihCode + hctx hcurrent henvironment + (fieldValues := []) hmember + hbinders + habstract (by + simpa using hconcrete) + | succ fieldCount => + simp [hpeel, halt] at hconcrete + | succ value => + cases halt : alternatives.find? + (fun alternative => + alternative.cidx == 1) with + | none => simp [hpeel, halt] at hconcrete + | some alternative => + cases alternative with + | mk cidx fieldCount body => + cases fieldCount with + | zero => + simp [hpeel, halt] at hconcrete + | succ fieldCount => + cases fieldCount with + | zero => + simp only [hpeel, halt] + at hconcrete + have hmember : + Alt.mk cidx 1 body ∈ + alternatives.toList := by + simpa using + Array.mem_of_find?_eq_some halt + have hcidx : cidx = 1 := by + have hmatch := Array.find?_some + (p := fun alternative : Alt => + alternative.cidx == 1) + (a := .mk cidx 1 body) + (xs := alternatives) halt + exact beq_iff_eq.mp hmatch + have hbinders : + EnvironmentHolds declarations + store + (scrutineeFact.caseFields + peelNat cidx 1) + [.lit (.nat value)] := by + simpa [hpeel, hcidx] using + (Fact.caseFields_natSucc_holds + hscrutineeHolds) + exact + analyzeAlternatives_sound ihCode + hctx hcurrent henvironment + (fieldValues := + [.lit (.nat value)]) + hmember hbinders habstract (by + simpa using hconcrete) + | succ fieldCount => + simp [hpeel, halt] at hconcrete + | erased => simp at hconcrete + · intro ctx owner current store facts values operation outputStore + outputValue inferred hctx hcurrent henvironment habstract hconcrete + cases operation with + | pure atom => + have habstract' : resolveAtomFact facts atom = .ok inferred := by + simpa only [analyzeOp] using habstract + rw [runOp.eq_def] at hconcrete + dsimp only at hconcrete + cases hresolve : resolveAtom values atom with + | error error => + rw [hresolve] at hconcrete + simp only [bind, Except.bind] at hconcrete + contradiction + | ok value => + rw [hresolve] at hconcrete + simp only [bind, Except.bind] at hconcrete + change Except.ok (store, value) = + Except.ok (outputStore, outputValue) at hconcrete + injection hconcrete with houtput + cases houtput + exact resolveAtom_sound henvironment habstract' hresolve + | alloc world identity arguments => + simp only [analyzeOp, bind, Except.bind] at habstract + cases hvalid : resolveAtomFacts facts arguments with + | error error => + rw [hvalid] at habstract + contradiction + | ok argumentFacts => + rw [hvalid] at habstract + change Except.ok (Fact.heap (.ctor identity + (some (argumentFacts.map FieldFact.ofFact)))) = + Except.ok inferred at habstract + injection habstract with hinferred + subst inferred + rw [runOp.eq_def] at hconcrete + dsimp only at hconcrete + cases harguments : resolveAtoms values arguments with + | error error => + rw [harguments] at hconcrete + simp only [bind, Except.bind] at hconcrete + contradiction + | ok resolved => + rw [harguments] at hconcrete + simp only [bind, Except.bind] at hconcrete + change Except.ok + ((store.allocNode world + (.ctorN identity resolved.toArray)).1, + .loc (store.allocNode world + (.ctorN identity resolved.toArray)).2) = + Except.ok (outputStore, outputValue) at hconcrete + injection hconcrete with houtput + cases houtput + have hfields := resolveAtomFacts_sound henvironment hvalid + harguments + apply Fact.heap_holds + exact ⟨⟨world, 1, .ctorN identity resolved.toArray⟩, + resolved.toArray, + get?_allocNode_new store world + (.ctorN identity resolved.toArray), rfl, + by simpa using + hfields.toFieldFactsAllocNode + (world := world) + (node := .ctorN identity resolved.toArray)⟩ + | reuse target identity arguments => + simp only [analyzeOp, bind, Except.bind] at habstract + cases hvalid : resolveAtomFacts facts arguments with + | error error => + rw [hvalid] at habstract + contradiction + | ok argumentFacts => + rw [hvalid] at habstract + cases htargetFact : resolveAtomFact facts target with + | error error => + rw [htargetFact] at habstract + contradiction + | ok targetFact => + rw [htargetFact] at habstract + change Except.ok (Fact.heap (.ctor identity + (some (argumentFacts.map fun fact => + FieldFact.ofFact fact.forgetHeap)))) = + Except.ok inferred at habstract + injection habstract with hinferred + subst inferred + rw [runOp.eq_def] at hconcrete + dsimp only at hconcrete + cases harguments : resolveAtoms values arguments with + | error error => + rw [harguments] at hconcrete + simp only [bind, Except.bind] at hconcrete + contradiction + | ok resolved => + rw [harguments] at hconcrete + simp only [bind, Except.bind] at hconcrete + cases htarget : resolveAtom values target with + | error error => + rw [htarget] at hconcrete + simp only [bind, Except.bind] at hconcrete + contradiction + | ok targetValue => + rw [htarget] at hconcrete + simp only [bind, Except.bind] at hconcrete + cases targetValue with + | lit literal => simp at hconcrete + | erased => simp at hconcrete + | loc location => + cases hbox : store.get? location with + | none => simp [hbox] at hconcrete + | some box => + simp only [hbox] at hconcrete + cases box with + | mk boxWorld rc node => + cases boxWorld with + | shared => simp at hconcrete + | unique => + change Except.ok + ({ store.setBox location + ⟨.unique, 1, + .ctorN identity + resolved.toArray⟩ with + reuses := + (store.setBox location + ⟨.unique, 1, + .ctorN identity + resolved.toArray⟩).reuses + 1 }, + .loc location) = + Except.ok + (outputStore, outputValue) + at hconcrete + injection hconcrete with houtput + cases houtput + have hfields := + resolveAtomFacts_sound henvironment + hvalid harguments + apply Fact.heap_holds + refine ⟨⟨.unique, 1, + .ctorN identity resolved.toArray⟩, + resolved.toArray, ?_, rfl, ?_⟩ + · simpa [Store.get?] using + (get?_setBox_same + (new := ⟨.unique, 1, + .ctorN identity + resolved.toArray⟩) + hbox) + · simpa using hfields.toFieldFactsForget + (after := + { store.setBox location + ⟨.unique, 1, + .ctorN identity + resolved.toArray⟩ with + reuses := + (store.setBox location + ⟨.unique, 1, + .ctorN identity + resolved.toArray⟩).reuses + 1 }) + | free target => + simp only [analyzeOp, bind, Except.bind] at habstract + cases hvalid : resolveAtomFact facts target with + | error error => + rw [hvalid] at habstract + contradiction + | ok fact => + rw [hvalid] at habstract + change Except.ok Fact.scalar = Except.ok inferred at habstract + injection habstract with hinferred + subst inferred + rw [runOp.eq_def] at hconcrete + dsimp only at hconcrete + cases htarget : resolveAtom values target with + | error error => + rw [htarget] at hconcrete + simp only [bind, Except.bind] at hconcrete + contradiction + | ok targetValue => + rw [htarget] at hconcrete + simp only [bind, Except.bind] at hconcrete + cases targetValue with + | lit literal => simp at hconcrete + | erased => simp at hconcrete + | loc location => + cases hbox : store.get? location with + | none => simp [hbox] at hconcrete + | some box => + simp only [hbox] at hconcrete + cases box with + | mk boxWorld rc node => + cases boxWorld with + | shared => simp at hconcrete + | unique => + injection hconcrete with houtput + cases houtput + simp [Fact.Holds, Fact.scalar] + | dup target => + simp only [analyzeOp, bind, Except.bind] at habstract + cases hvalid : resolveAtomFact facts target with + | error error => + rw [hvalid] at habstract + contradiction + | ok fact => + rw [hvalid] at habstract + change Except.ok Fact.top = Except.ok inferred at habstract + injection habstract with hinferred + subst inferred + exact Fact.top_holds declarations outputStore outputValue + | drop target => + simp only [analyzeOp, bind, Except.bind] at habstract + cases hvalid : resolveAtomFact facts target with + | error error => + rw [hvalid] at habstract + contradiction + | ok fact => + rw [hvalid] at habstract + change Except.ok Fact.scalar = Except.ok inferred at habstract + injection habstract with hinferred + subst inferred + rw [runOp.eq_def] at hconcrete + dsimp only at hconcrete + cases htarget : resolveAtom values target with + | error error => + rw [htarget] at hconcrete + simp only [bind, Except.bind] at hconcrete + contradiction + | ok targetValue => + rw [htarget] at hconcrete + simp only [bind, Except.bind] at hconcrete + cases targetValue with + | lit literal => + injection hconcrete with houtput + cases houtput + simp [Fact.Holds, Fact.scalar] + | erased => + injection hconcrete with houtput + cases houtput + simp [Fact.Holds, Fact.scalar] + | loc location => + dsimp only at hconcrete + cases hdrop : dropVal ctx fuel store (.loc location) with + | error error => + rw [hdrop] at hconcrete + simp only [bind, Except.bind] at hconcrete + contradiction + | ok dropped => + rw [hdrop] at hconcrete + simp only [bind, Except.bind] at hconcrete + injection hconcrete with houtput + cases houtput + simp [Fact.Holds, Fact.scalar] + | dropU target => + simp only [analyzeOp, bind, Except.bind] at habstract + cases hvalid : resolveAtomFact facts target with + | error error => + rw [hvalid] at habstract + contradiction + | ok fact => + rw [hvalid] at habstract + change Except.ok Fact.scalar = Except.ok inferred at habstract + injection habstract with hinferred + subst inferred + rw [runOp.eq_def] at hconcrete + dsimp only at hconcrete + cases htarget : resolveAtom values target with + | error error => + rw [htarget] at hconcrete + simp only [bind, Except.bind] at hconcrete + contradiction + | ok targetValue => + rw [htarget] at hconcrete + simp only [bind, Except.bind] at hconcrete + cases targetValue with + | lit literal => + injection hconcrete with houtput + cases houtput + simp [Fact.Holds, Fact.scalar] + | erased => + injection hconcrete with houtput + cases houtput + simp [Fact.Holds, Fact.scalar] + | loc location => + dsimp only at hconcrete + cases hdrop : dropUVal ctx fuel store (.loc location) with + | error error => + rw [hdrop] at hconcrete + simp only [bind, Except.bind] at hconcrete + contradiction + | ok dropped => + rw [hdrop] at hconcrete + simp only [bind, Except.bind] at hconcrete + injection hconcrete with houtput + cases houtput + simp [Fact.Holds, Fact.scalar] + | fetch target field => + simp only [analyzeOp, bind, Except.bind] at habstract + cases hvalid : resolveAtomFact facts target with + | error error => + rw [hvalid] at habstract + contradiction + | ok fact => + rw [hvalid] at habstract + change Except.ok (fact.fetch field) = Except.ok inferred + at habstract + injection habstract with hinferred + subst inferred + rw [runOp.eq_def] at hconcrete + dsimp only at hconcrete + cases htarget : resolveAtom values target with + | error error => + rw [htarget] at hconcrete + simp only [bind, Except.bind] at hconcrete + contradiction + | ok targetValue => + rw [htarget] at hconcrete + simp only [bind, Except.bind] at hconcrete + cases targetValue with + | lit literal => simp at hconcrete + | erased => simp at hconcrete + | loc location => + cases hbox : store.get? location with + | none => simp [hbox] at hconcrete + | some box => + simp only [hbox] at hconcrete + cases box with + | mk world rc node => + cases node with + | papN function arity captured => + simp at hconcrete + | ctorN identity fields => + cases hfield : fields[field]? with + | none => simp [hfield] at hconcrete + | some value => + simp only [hfield] at hconcrete + injection hconcrete with houtput + cases houtput + exact Fact.fetch_holds + (resolveAtom_sound henvironment hvalid + htarget) + hbox rfl hfield + | call address arguments => + simp only [analyzeOp, bind, Except.bind] at habstract + cases hvalid : resolveAtomFacts facts arguments with + | error error => + rw [hvalid] at habstract + contradiction + | ok unit => + rw [hvalid] at habstract + simp only [bind, Except.bind] at habstract + cases hdecl : declarations address with + | none => simp [hdecl] at habstract + | some declaration => + simp only [hdecl] at habstract + cases harity : arguments.size != declArity declaration + · + simp only [harity, Bool.false_eq_true, if_false] + at habstract + rw [runOp.eq_def] at hconcrete + dsimp only at hconcrete + cases harguments : resolveAtoms values arguments with + | error error => + rw [harguments] at hconcrete + simp only [bind, Except.bind] at hconcrete + contradiction + | ok resolved => + rw [harguments] at hconcrete + simp only [bind, Except.bind] at hconcrete + exact ihInvoke ctx address resolved store outputStore + outputValue inferred hctx habstract hconcrete + · simp [harity] at habstract + | callSelf arguments => + simp only [analyzeOp, bind, Except.bind] at habstract + cases hvalid : resolveAtomFacts facts arguments with + | error error => + rw [hvalid] at habstract + contradiction + | ok unit => + rw [hvalid] at habstract + simp only [bind, Except.bind] at habstract + cases habstractArity : arguments.size != current.arity + · + simp only [habstractArity, Bool.false_eq_true, if_false] + at habstract + cases hsummary : summaries owner with + | none => simp [hsummary] at habstract + | some claimed => + rw [hsummary] at habstract + change Except.ok claimed = Except.ok inferred at habstract + injection habstract with hinferred + subst inferred + have hcurrentDecl : + declarations owner = some (.fn current) := by + rcases hcurrent with hcurrent | hmissing + · exact hcurrent + · rw [hsummary] at hmissing + contradiction + obtain ⟨localFact, hlocal, hle⟩ := + hpost owner current claimed hcurrentDecl hsummary + rw [runOp.eq_def] at hconcrete + dsimp only at hconcrete + cases harguments : resolveAtoms values arguments with + | error error => + rw [harguments] at hconcrete + simp only [bind, Except.bind] at hconcrete + contradiction + | ok resolved => + rw [harguments] at hconcrete + simp only [bind, Except.bind] at hconcrete + cases hconcreteArity : resolved.length != current.arity + · + simp only [hconcreteArity, Bool.false_eq_true, + if_false] at hconcrete + cases hbody : runCode ctx fuel current store + resolved.reverse current.body with + | error error => + rw [hbody] at hconcrete + simp only [bind, Except.bind] at hconcrete + contradiction + | ok bodyOutput => + rw [hbody] at hconcrete + simp only [bind, Except.bind] at hconcrete + have houtput := + eq_of_checkResultWorld_eq_ok hconcrete + rcases bodyOutput with + ⟨bodyStore, bodyValue⟩ + cases houtput + have hlength : resolved.length = + current.arity := by + simpa using hconcreteArity + have henv := + EnvironmentHolds.top_replicate + declarations store resolved.reverse + rw [List.length_reverse, hlength] at henv + have hbodySound := ihCode ctx owner current + store + (List.replicate current.arity Fact.top) + resolved.reverse current.body outputStore + outputValue localFact hctx hcurrent henv + (by simpa [inferFunction] using hlocal) + hbody + exact Fact.holds_of_le hle hbodySound + · simp [hconcreteArity] at hconcrete + · simp [habstractArity] at habstract + | papp address arguments => + simp only [analyzeOp, bind, Except.bind] at habstract + cases hvalid : resolveAtomFacts facts arguments with + | error error => + rw [hvalid] at habstract + contradiction + | ok unit => + rw [hvalid] at habstract + simp only [bind, Except.bind] at habstract + cases hdecl : declarations address with + | none => simp [hdecl] at habstract + | some declaration => + simp only [hdecl] at habstract + by_cases hless : arguments.size < declArity declaration + · + simp only [hless, if_true] at habstract + change Except.ok + (Fact.heap (.pap address arguments.size)) = + Except.ok inferred at habstract + injection habstract with hinferred + subst inferred + rw [runOp.eq_def] at hconcrete + dsimp only at hconcrete + cases harguments : resolveAtoms values arguments with + | error error => + rw [harguments] at hconcrete + simp only [bind, Except.bind] at hconcrete + contradiction + | ok resolved => + rw [harguments] at hconcrete + simp only [bind, Except.bind] at hconcrete + have hdeclConcrete : ctx.decls address = + some declaration := by + rw [hctx] + exact hdecl + simp only [hdeclConcrete] at hconcrete + have hlength := resolveAtoms_length harguments + have hlessConcrete : resolved.length < + declArity declaration := by + simpa [hlength] using hless + simp only [hlessConcrete, if_true] at hconcrete + change Except.ok + ((store.allocNode .shared + (.papN address (declArity declaration) + resolved.toArray)).1, + .loc (store.allocNode .shared + (.papN address (declArity declaration) + resolved.toArray)).2) = + Except.ok (outputStore, outputValue) at hconcrete + injection hconcrete with houtput + cases houtput + apply Fact.heap_holds + refine ⟨⟨.shared, 1, + .papN address (declArity declaration) + resolved.toArray⟩, + resolved.toArray, declaration, + get?_allocNode_new store .shared + (.papN address (declArity declaration) + resolved.toArray), hdecl, rfl, ?_, ?_⟩ + · simpa [hlength] + · exact hless + · simp [hless] at habstract + | apply function arguments => + simp only [analyzeOp, bind, Except.bind] at habstract + cases hfunctionAbstract : resolveAtomFact facts function with + | error error => + rw [hfunctionAbstract] at habstract + contradiction + | ok functionFact => + rw [hfunctionAbstract] at habstract + simp only [bind, Except.bind] at habstract + cases hvalid : resolveAtomFacts facts arguments with + | error error => + rw [hvalid] at habstract + contradiction + | ok unit => + rw [hvalid] at habstract + simp only [bind, Except.bind] at habstract + rw [runOp.eq_def] at hconcrete + dsimp only at hconcrete + cases hfunctionConcrete : resolveAtom values function with + | error error => + rw [hfunctionConcrete] at hconcrete + simp only [bind, Except.bind] at hconcrete + contradiction + | ok functionValue => + rw [hfunctionConcrete] at hconcrete + simp only [bind, Except.bind] at hconcrete + cases harguments : resolveAtoms values arguments with + | error error => + rw [harguments] at hconcrete + simp only [bind, Except.bind] at hconcrete + contradiction + | ok resolved => + rw [harguments] at hconcrete + simp only [bind, Except.bind] at hconcrete + have hlength := resolveAtoms_length harguments + have hfunctionHolds := resolveAtom_sound henvironment + hfunctionAbstract hfunctionConcrete + exact ihApply ctx store functionValue resolved + outputStore outputValue functionFact inferred + (arguments.size + 1) hctx hfunctionHolds + (by simpa [hlength] using habstract) hconcrete + | extern address arguments => + simp only [analyzeOp, bind, Except.bind] at habstract + cases hvalid : resolveAtomFacts facts arguments with + | error error => + rw [hvalid] at habstract + contradiction + | ok unit => + rw [hvalid] at habstract + change Except.ok Fact.scalar = Except.ok inferred at habstract + injection habstract with hinferred + subst inferred + rw [runOp.eq_def] at hconcrete + dsimp only at hconcrete + cases harguments : resolveAtoms values arguments with + | error error => + rw [harguments] at hconcrete + simp only [bind, Except.bind] at hconcrete + contradiction + | ok resolved => + rw [harguments] at hconcrete + simp only [bind, Except.bind] at hconcrete + cases horacle : callScalarOracle ctx address resolved with + | error error => + rw [horacle] at hconcrete + simp only [bind, Except.bind] at hconcrete + contradiction + | ok value => + rw [horacle] at hconcrete + simp only [bind, Except.bind] at hconcrete + change Except.ok (store, value) = + Except.ok (outputStore, outputValue) at hconcrete + injection hconcrete with houtput + cases houtput + rw [Fact.scalar_holds_iff] + exact scalar_of_callScalarOracle_eq_ok horacle + · intro ctx address arguments store outputStore outputValue fact hctx + habstract hconcrete + rw [invoke.eq_def] at hconcrete + dsimp only at hconcrete + cases hdeclConcrete : ctx.decls address with + | none => simp [hdeclConcrete] at hconcrete + | some declaration => + simp only [hdeclConcrete] at hconcrete + have hdecl : declarations address = some declaration := by + rw [← hctx] + exact hdeclConcrete + cases declaration with + | extern arity => + cases harity : arguments.length != arity + · + simp only [harity, Bool.false_eq_true, if_false] + at hconcrete + cases horacle : callScalarOracle ctx address arguments with + | error error => simp [horacle] at hconcrete + | ok value => + simp only [horacle] at hconcrete + injection hconcrete with houtput + cases houtput + have hfact : fact = Fact.scalar := by + simpa [callableResult, hdecl] using habstract.symm + subst fact + rw [Fact.scalar_holds_iff] + exact scalar_of_callScalarOracle_eq_ok horacle + · simp [harity] at hconcrete + | fn function => + cases harity : arguments.length != function.arity + · + simp only [harity, Bool.false_eq_true, if_false] + at hconcrete + cases hbody : runCode ctx fuel function store + arguments.reverse function.body with + | error error => + rw [hbody] at hconcrete + simp only [bind, Except.bind] at hconcrete + contradiction + | ok bodyOutput => + rw [hbody] at hconcrete + simp only [bind, Except.bind] at hconcrete + have houtput := eq_of_checkResultWorld_eq_ok hconcrete + rcases bodyOutput with ⟨bodyStore, bodyValue⟩ + cases houtput + cases hsummary : summaries address with + | none => simp [callableResult, hdecl, hsummary] + at habstract + | some claimed => + have hfact : claimed = fact := by + simpa [callableResult, hdecl, hsummary] using + habstract + subst fact + obtain ⟨localFact, hlocal, hle⟩ := + hpost address function claimed hdecl hsummary + have hlength : arguments.length = function.arity := by + simpa using harity + have henvironment := + EnvironmentHolds.top_replicate declarations store + arguments.reverse + rw [List.length_reverse, hlength] at henvironment + have hbodySound := ihCode ctx address function store + (List.replicate function.arity Fact.top) + arguments.reverse function.body outputStore + outputValue + localFact hctx (.inl hdecl) henvironment + (by simpa [inferFunction] using hlocal) hbody + exact Fact.holds_of_le hle hbodySound + · simp [harity] at hconcrete + · intro ctx store function arguments outputStore outputValue functionFact + resultFact abstractFuel hctx hfunction habstract hconcrete + cases abstractFuel with + | zero => + simp only [applyFact, Except.ok.injEq] at habstract + subst resultFact + exact Fact.top_holds declarations outputStore outputValue + | succ abstractFuel => + rw [applyFact] at habstract + dsimp only at habstract + cases hunknown : functionFact.unknownHeap with + | true => + simp only [hunknown, if_true] at habstract + change Except.ok Fact.top = Except.ok resultFact at habstract + injection habstract with hresult + subst resultFact + exact Fact.top_holds declarations outputStore outputValue + | false => + simp only [hunknown, Bool.false_eq_true, if_false] + at habstract + cases hheap : applyShapeFacts + (applyShapeFact declarations summaries + (applyFact declarations summaries abstractFuel) + arguments.length) functionFact.shapes with + | error error => + rw [hheap] at habstract + simp only [bind, Except.bind] at habstract + contradiction + | ok heapFact => + rw [hheap] at habstract + change Except.ok + ((if functionFact.mayScalar then Fact.scalar + else Fact.bottom).join heapFact) = + Except.ok resultFact at habstract + injection habstract with hresult + subst resultFact + rw [applyGo.eq_def] at hconcrete + dsimp only at hconcrete + cases function with + | lit literal => simp at hconcrete + | erased => + cases hdrop : dropMany ctx fuel store arguments with + | error error => + rw [hdrop] at hconcrete + simp only [bind, Except.bind] at hconcrete + contradiction + | ok dropped => + rw [hdrop] at hconcrete + simp only [bind, Except.bind] at hconcrete + change Except.ok (dropped, RVal.erased) = + Except.ok (outputStore, outputValue) at hconcrete + injection hconcrete with houtput + cases houtput + change functionFact.mayScalar = true at hfunction + apply Fact.holds_join + apply Or.inl + simp [hfunction, Fact.Holds, Fact.scalar] + | loc location => + cases hbox : store.get? location with + | none => simp [hbox] at hconcrete + | some box => + simp only [hbox] at hconcrete + cases box with + | mk world rc node => + cases node with + | ctorN identity fields => simp at hconcrete + | papN address arity captured => + simp only at hconcrete + simp only [Fact.Holds] at hfunction + rcases hfunction with hunknown' | + ⟨shape, hmember, hshape⟩ + · simp [hunknown] at hunknown' + · cases shape with + | ctor shapeIdentity shapeFacts => + simp only [HeapShape.Holds] at hshape + obtain ⟨shapeBox, shapeFields, + hshapeBox, hshapeNode, _⟩ := hshape + have : shapeBox = + ⟨world, rc, + .papN address arity captured⟩ := by + injection hshapeBox.symm.trans hbox + subst shapeBox + simp at hshapeNode + | pap shapeAddress supplied => + simp only [HeapShape.Holds] at hshape + obtain ⟨shapeBox, shapeArguments, + declaration, hshapeBox, hdecl, + hshapeNode, hsupplied, hproper⟩ := + hshape + have hboxEq : shapeBox = + ⟨world, rc, + .papN address arity captured⟩ := by + injection hshapeBox.symm.trans hbox + subst shapeBox + simp only [NodeBox.node] at hshapeNode + injection hshapeNode with haddress + harity hcaptured + subst shapeAddress + subst arity + subst shapeArguments + cases hdup : dupVals store captured.toList with + | error error => + rw [hdup] at hconcrete + simp only [bind, Except.bind] + at hconcrete + contradiction + | ok duplicated => + rw [hdup] at hconcrete + simp only [bind, Except.bind] + at hconcrete + cases hdrop : dropVal ctx fuel + duplicated (.loc location) with + | error error => + rw [hdrop] at hconcrete + simp only [bind, Except.bind] + at hconcrete + contradiction + | ok ready => + rw [hdrop] at hconcrete + simp only [bind, Except.bind] + at hconcrete + have hcapturedLength : + captured.toList.length = + supplied := by + simpa using hsupplied + have htotalLength : + (captured.toList ++ arguments).length = + supplied + arguments.length := by + simp [hcapturedLength] + by_cases hunder : + (captured.toList ++ + arguments).length < + declArity declaration + · + simp only [hunder, if_true] + at hconcrete + change Except.ok + ((ready.allocNode .shared + (.papN address + (declArity declaration) + ((captured.toList ++ + arguments).toArray))).1, + .loc + (ready.allocNode .shared + (.papN address + (declArity declaration) + ((captured.toList ++ + arguments).toArray))).2) = + Except.ok + (outputStore, outputValue) + at hconcrete + injection hconcrete with + houtput + cases houtput + have hunderAbstract : + supplied + arguments.length < + declArity declaration := by + simpa [htotalLength] using hunder + let shapeFact := Fact.heap + (.pap address + (supplied + arguments.length)) + have hstep : + applyShapeFact declarations + summaries + (applyFact declarations summaries + abstractFuel) + arguments.length + (.pap address supplied) = + .ok shapeFact := by + simp [applyShapeFact, hdecl, + hproper, hunderAbstract, + shapeFact] + change Except.ok + (Fact.heap (.pap address + (supplied + arguments.length))) = + Except.ok + (Fact.heap (.pap address + (supplied + arguments.length))) + rfl + have hshapeFact : + shapeFact.Holds declarations + (ready.allocNode .shared + (.papN address + (declArity declaration) + ((captured.toList ++ + arguments).toArray))).1 + (.loc + (ready.allocNode .shared + (.papN address + (declArity declaration) + ((captured.toList ++ + arguments).toArray))).2) := by + apply Fact.heap_holds + refine ⟨⟨.shared, 1, + .papN address + (declArity declaration) + ((captured.toList ++ + arguments).toArray)⟩, + (captured.toList ++ + arguments).toArray, + declaration, + get?_allocNode_new ready .shared + (.papN address + (declArity declaration) + ((captured.toList ++ + arguments).toArray)), + hdecl, rfl, ?_, + hunderAbstract⟩ + simpa [htotalLength] + apply Fact.holds_join + exact Or.inr + (holds_of_applyShapeFacts_member + hmember hstep hheap hshapeFact) + · + simp only [hunder, + if_false] + at hconcrete + have hpapsafe : + declPapSafe declaration = true := by + cases hsafety : + declPapSafe declaration with + | false => + simp [hctx, hdecl, hsafety] + at hconcrete + | true => rfl + simp only [hctx, hdecl, hpapsafe, + if_true] at hconcrete + by_cases hexactEq : + (((captured.toList ++ + arguments).length == + declArity declaration) = true) + · have hexact : + ((captured.toList ++ + arguments).length == + declArity declaration) = true := + hexactEq + simp only [hexact, if_true] + at hconcrete + have hexactAbstract : + supplied + arguments.length = + declArity declaration := by + have := beq_iff_eq.mp hexact + omega + cases hreturned : + callableResult declarations + summaries address with + | error error => + have hstepError : + applyShapeFact declarations + summaries + (applyFact declarations + summaries abstractFuel) + arguments.length + (.pap address supplied) = + .error error := by + simp [applyShapeFact, hdecl, + hproper, hexactAbstract, + hreturned] + exact False.elim + (applyShapeFacts_ne_ok_of_member_error + hmember hstepError hheap) + | ok returned => + have hstep : + applyShapeFact declarations + summaries + (applyFact declarations + summaries abstractFuel) + arguments.length + (.pap address supplied) = + .ok returned := by + simp [applyShapeFact, hdecl, + hproper, hexactAbstract, + hreturned] + have hreturnedHolds := ihInvoke + ctx address + (captured.toList ++ arguments) + ready outputStore outputValue + returned hctx hreturned hconcrete + apply Fact.holds_join + exact Or.inr + (holds_of_applyShapeFacts_member + hmember hstep hheap + hreturnedHolds) + · have hexact : + ((captured.toList ++ + arguments).length == + declArity declaration) = false := by + simpa using hexactEq + simp only [hexact, + Bool.false_eq_true, if_false] + at hconcrete + have hoverAbstract : + declArity declaration < + supplied + arguments.length := by + have hnunder : ¬ + supplied + arguments.length < + declArity declaration := by + simpa [htotalLength] using hunder + have hneConcrete : + (captured.toList ++ + arguments).length ≠ + declArity declaration := by + intro heq + apply hexactEq + simpa [heq] + omega + have hnunderAbstract : ¬ + supplied + arguments.length < + declArity declaration := by + omega + have hneAbstract : + supplied + arguments.length ≠ + declArity declaration := by + omega + cases hreturned : + callableResult declarations + summaries address with + | error error => + have hstepError : + applyShapeFact declarations + summaries + (applyFact declarations + summaries abstractFuel) + arguments.length + (.pap address supplied) = + .error error := by + simp [applyShapeFact, hdecl, + hproper, hnunderAbstract, + hneAbstract, + hreturned] + simp only [bind, Except.bind] + exact False.elim + (applyShapeFacts_ne_ok_of_member_error + hmember hstepError hheap) + | ok returned => + cases happlied : + applyFact declarations summaries + abstractFuel returned + (supplied + arguments.length - + declArity declaration) with + | error error => + have hstepError : + applyShapeFact declarations + summaries + (applyFact declarations + summaries abstractFuel) + arguments.length + (.pap address supplied) = + .error error := by + simp [applyShapeFact, hdecl, + hproper, hnunderAbstract, + hneAbstract, + hreturned, happlied] + simpa only [bind, Except.bind] + using happlied + exact False.elim + (applyShapeFacts_ne_ok_of_member_error + hmember hstepError hheap) + | ok applied => + have hstep : + applyShapeFact declarations + summaries + (applyFact declarations + summaries abstractFuel) + arguments.length + (.pap address supplied) = + .ok applied := by + simp [applyShapeFact, hdecl, + hproper, hnunderAbstract, + hneAbstract, + hreturned, happlied] + simpa only [bind, Except.bind] + using happlied + cases hinvoke : invoke ctx fuel + address + ((captured.toList ++ arguments).take + (declArity declaration)) + ready with + | error error => + rw [hinvoke] at hconcrete + simp only [bind, Except.bind] + at hconcrete + contradiction + | ok called => + rcases called with + ⟨calledStore, calledValue⟩ + rw [hinvoke] at hconcrete + simp only [bind, Except.bind] + at hconcrete + have hreturnedHolds := ihInvoke + ctx address + ((captured.toList ++ + arguments).take + (declArity declaration)) + ready calledStore calledValue + returned hctx hreturned hinvoke + have hdropLength : + ((captured.toList ++ + arguments).drop + (declArity declaration)).length = + supplied + arguments.length - + declArity declaration := by + simp [List.length_drop, + htotalLength] + have happliedHolds := ihApply ctx + calledStore calledValue + ((captured.toList ++ arguments).drop + (declArity declaration)) + outputStore outputValue returned + applied abstractFuel hctx + hreturnedHolds + (by simpa [hdropLength] using + happlied) + hconcrete + apply Fact.holds_join + exact Or.inr + (holds_of_applyShapeFacts_member + hmember hstep hheap + happliedHolds) + +/-! ## Public semantic interface -/ + +/-- Successful concrete execution of analyzed code is covered when the owner +is exact or self-analysis is forced to fail closed. -/ +theorem analyzeCode_sound_ownerCompatible + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {owner : Address} {current : FnDef} {store outputStore : Store} + {facts : List Fact} {values : List RVal} {code : Code} + {outputValue : RVal} {inferred : Fact} {fuel : Nat} + (hctx : ctx.decls = declarations) + (howner : AnalysisOwnerCompatible declarations summaries owner current) + (henvironment : EnvironmentHolds declarations store facts values) + (habstract : analyzeCode declarations summaries owner current facts code = + .ok inferred) + (hconcrete : runCode ctx fuel current store values code = + .ok (outputStore, outputValue)) : + inferred.Holds declarations outputStore outputValue := + (soundAt hpost fuel).1 ctx owner current store facts values code outputStore + outputValue inferred hctx howner henvironment habstract hconcrete + +/-- Exact stored-owner specialization of +`analyzeCode_sound_ownerCompatible`. -/ +theorem analyzeCode_sound {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {owner : Address} {current : FnDef} {store outputStore : Store} + {facts : List Fact} {values : List RVal} {code : Code} + {outputValue : RVal} {inferred : Fact} {fuel : Nat} + (hctx : ctx.decls = declarations) + (hcurrent : declarations owner = some (.fn current)) + (henvironment : EnvironmentHolds declarations store facts values) + (habstract : analyzeCode declarations summaries owner current facts code = + .ok inferred) + (hconcrete : runCode ctx fuel current store values code = + .ok (outputStore, outputValue)) : + inferred.Holds declarations outputStore outputValue := + analyzeCode_sound_ownerCompatible hpost hctx (.inl hcurrent) henvironment + habstract hconcrete + +/-- Operation-level form of `analyzeCode_sound_ownerCompatible`. -/ +theorem analyzeOp_sound_ownerCompatible + {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {owner : Address} {current : FnDef} {store outputStore : Store} + {facts : List Fact} {values : List RVal} {operation : Op} + {outputValue : RVal} {inferred : Fact} {fuel : Nat} + (hctx : ctx.decls = declarations) + (howner : AnalysisOwnerCompatible declarations summaries owner current) + (henvironment : EnvironmentHolds declarations store facts values) + (habstract : analyzeOp declarations summaries owner current facts operation = + .ok inferred) + (hconcrete : runOp ctx fuel current store values operation = + .ok (outputStore, outputValue)) : + inferred.Holds declarations outputStore outputValue := + (soundAt hpost fuel).2.1 ctx owner current store facts values operation + outputStore outputValue inferred hctx howner henvironment habstract + hconcrete + +/-- Exact stored-owner specialization used by ordinary HPT consumers. -/ +theorem analyzeOp_sound {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {owner : Address} {current : FnDef} {store outputStore : Store} + {facts : List Fact} {values : List RVal} {operation : Op} + {outputValue : RVal} {inferred : Fact} {fuel : Nat} + (hctx : ctx.decls = declarations) + (hcurrent : declarations owner = some (.fn current)) + (henvironment : EnvironmentHolds declarations store facts values) + (habstract : analyzeOp declarations summaries owner current facts operation = + .ok inferred) + (hconcrete : runOp ctx fuel current store values operation = + .ok (outputStore, outputValue)) : + inferred.Holds declarations outputStore outputValue := + analyzeOp_sound_ownerCompatible hpost hctx (.inl hcurrent) henvironment + habstract hconcrete + +/-- Known invocation respects `callableResult` under a local post-fixpoint. -/ +theorem invoke_sound {declarations : DeclEnv} {summaries : SummaryEnv} + (hpost : LocalPostFixpoint declarations summaries) + {ctx : Ctx} {address : Address} {arguments : List RVal} + {store outputStore : Store} {outputValue : RVal} {fact : Fact} + {fuel : Nat} (hctx : ctx.decls = declarations) + (habstract : callableResult declarations summaries address = .ok fact) + (hconcrete : invoke ctx fuel address arguments store = + .ok (outputStore, outputValue)) : + fact.Holds declarations outputStore outputValue := + (soundAt hpost fuel).2.2.1 ctx address arguments store outputStore + outputValue fact hctx habstract hconcrete + +private theorem lookup_build_some_mem {α : Type} + {entries : List (Address × α)} {address : Address} {value : α} + (hlookup : AddressEnv.lookup (AddressEnv.build entries) address = + some value) : (address, value) ∈ entries := by + rw [AddressEnv.lookup_build_apply] at hlookup + obtain ⟨entry, hfind, hvalue⟩ := Option.map_eq_some_iff.mp hlookup + rcases entry with ⟨entryAddress, entryValue⟩ + have hbeq : entryAddress == address := + List.find?_some + (p := fun entry : Address × α => entry.1 == address) hfind + have haddress : entryAddress = address := Address.eq_of_beq hbeq + have hentryValue : entryValue = value := by simpa using hvalue + subst entryAddress + subst entryValue + exact List.mem_of_find?_eq_some hfind + +private theorem checked_of_checkLocalRows + {declarations : DeclEnv} {summaries : SummaryEnv} + {entries : List (Address × Decl)} {address : Address} + {declaration : Decl} {claimed : Fact} + (hrows : checkLocalRows declarations summaries entries = true) + (hmember : (address, declaration) ∈ entries) + (hsummary : summaries address = some claimed) : + checkMember declarations summaries (address, declaration) + (address, claimed) = true := by + induction entries with + | nil => contradiction + | cons entry entries ih => + rcases entry with ⟨entryAddress, entryDeclaration⟩ + simp only [checkLocalRows, Bool.and_eq_true] at hrows + rcases List.mem_cons.mp hmember with hsame | hmember + · injection hsame with haddress hdeclaration + subst entryAddress + subst entryDeclaration + simpa [hsummary] using hrows.1 + · exact ih hrows.2 hmember + +/-- The executable whole-program condition implies the propositional local +post-fixpoint used by the evaluator proof. -/ +theorem localPostFixpoint_of_postFixpoint + {program : List ReaddressAll.Artifact} {certificate : Certificate} + (hcertificate : certificate.postFixpoint program = true) : + LocalPostFixpoint (programDeclEnv program) certificate.summaryEnv := by + intro address function claimed hdeclaration hsummary + have hrows : checkLocalRows (programDeclEnv program) certificate.summaryEnv + (declarationEntries program) = true := by + unfold Certificate.postFixpoint at hcertificate + simp only [Bool.and_eq_true] at hcertificate + exact hcertificate.1.2 + have hmember : (address, Decl.fn function) ∈ declarationEntries program := by + apply lookup_build_some_mem + simpa [programDeclEnv] using hdeclaration + have hchecked := checked_of_checkLocalRows hrows hmember hsummary + cases hinferred : inferFunction (programDeclEnv program) + certificate.summaryEnv address function with + | error error => + simp [checkMember, hinferred] at hchecked + | ok inferred => + refine ⟨inferred, rfl, ?_⟩ + have hparts : claimed.canonical = true ∧ inferred.le claimed = true := by + simpa [checkMember, hinferred] using hchecked + exact hparts.2 + +/-- A function row in any accepted certificate covers every successful +runtime invocation, for arbitrary arguments and fuel. -/ +theorem functionSummary_sound_of_postFixpoint + {program : List ReaddressAll.Artifact} {certificate : Certificate} + {ctx : Ctx} {address : Address} {function : FnDef} {claimed : Fact} + {arguments : List RVal} {store outputStore : Store} + {outputValue : RVal} {fuel : Nat} + (hcertificate : certificate.postFixpoint program = true) + (hctx : ctx.decls = programDeclEnv program) + (hdeclaration : programDeclEnv program address = some (.fn function)) + (hsummary : certificate.summaryEnv address = some claimed) + (hinvoke : invoke ctx fuel address arguments store = + .ok (outputStore, outputValue)) : + claimed.Holds (programDeclEnv program) outputStore outputValue := by + apply invoke_sound (localPostFixpoint_of_postFixpoint hcertificate) hctx + (hconcrete := hinvoke) + simp [callableResult, hdeclaration, hsummary] + +/-- Configurable checker success supplies the semantic certificate premise. -/ +theorem functionSummary_sound_of_runWith_eq_ok + {limits : Limits} {program : List ReaddressAll.Artifact} + {certificate : Certificate} {result : Result} + {ctx : Ctx} {address : Address} {function : FnDef} {claimed : Fact} + {arguments : List RVal} {store outputStore : Store} + {outputValue : RVal} {fuel : Nat} + (hcheck : runWith limits program certificate = .ok result) + (hctx : ctx.decls = programDeclEnv program) + (hdeclaration : programDeclEnv program address = some (.fn function)) + (hsummary : certificate.summaryEnv address = some claimed) + (hinvoke : invoke ctx fuel address arguments store = + .ok (outputStore, outputValue)) : + claimed.Holds (programDeclEnv program) outputStore outputValue := by + exact functionSummary_sound_of_postFixpoint + (postFixpoint_of_runWith_eq_ok hcheck) hctx hdeclaration hsummary hinvoke + +/-- Default-limit specialization of +`functionSummary_sound_of_runWith_eq_ok`. -/ +theorem functionSummary_sound_of_run_eq_ok + {program : List ReaddressAll.Artifact} {certificate : Certificate} + {result : Result} {ctx : Ctx} {address : Address} {function : FnDef} + {claimed : Fact} {arguments : List RVal} {store outputStore : Store} + {outputValue : RVal} {fuel : Nat} + (hcheck : run program certificate = .ok result) + (hctx : ctx.decls = programDeclEnv program) + (hdeclaration : programDeclEnv program address = some (.fn function)) + (hsummary : certificate.summaryEnv address = some claimed) + (hinvoke : invoke ctx fuel address arguments store = + .ok (outputStore, outputValue)) : + claimed.Holds (programDeclEnv program) outputStore outputValue := by + exact functionSummary_sound_of_runWith_eq_ok + (limits := defaultLimits) (by simpa [run] using hcheck) hctx hdeclaration + hsummary hinvoke + +end Ix.Compiler.IxIR1.HPT diff --git a/Ix/Compiler/IxIR1/Lower.lean b/Ix/Compiler/IxIR1/Lower.lean new file mode 100644 index 000000000..71540668d --- /dev/null +++ b/Ix/Compiler/IxIR1/Lower.lean @@ -0,0 +1,1589 @@ +import Ix.Compiler.IxIR1.Eval +import Ix.Compiler.IxIR0.Examples + +/-! +# The IxIR₀ → IxIR₁ lowering (stage 2: mode-directed) + +The two RC strategies of the plan, in one pass. Binder modes (`Uses` +on IxIR₀ `lam`/`letE`, inert until now) direct the memory lowering: + +- **`many` → the shared world** (the v1 path): `alloc .shared`, + Perceus dup/drop from source-occurrence counting. +- **`linear`/`affine` → the unique world**: `alloc .unique`, + move-only discipline — a unique variable used more than once is a + *lowering* error (the operational linear check), a dead `linear` + binding is an error, a dead `affine` binding deep-frees via + `dropU`. Unique values induce **zero refcount operations** — the + no-RC strategy, pinned by counter guards. + +Worlds flow as top-down **demands**: a let demands its binder-mode +world of the bound value; a saturated known call demands each +argument's world from the callee's lam modes; a constructor +application allocates in the demanded world and demands the same of +its fields (whole-value modes, gate B). Static mode errors at the +boundary: a shared variable at unique demand is dereliction; a unique +variable at shared demand would need a deep freeze. The v0 contract +rejects both directions in `UsageCheck` and retains these lowering +checks as backstops; the planned freeze lift and its wake conditions +are recorded in `docs/compiler/lowering-restrictions.md`. + +Function values (paps) and their captures are deliberately shared in +this slice. Since `apply` consequently supplies shared arguments, only +all-`many` telescopes may become function values or partial +applications; a non-`many` function is accepted only as a saturated +known call, otherwise lowering rejects it. Also deliberately shared: +recursor calls entirely (the Lean fragment is all-`many`; +mode-polymorphic recursors arrive with usage polymorphism/IxIR₀ˢ), +projection results (unique destructuring needs a real `case`). Definition +result worlds are carried by both IRs and checked at every statically known +call; unknown `apply` remains shared-only until paps carry a richer callable +type. Extern calls use the evaluator's enforced scalar-only +ABI; a future heap-valued extern needs an explicit ownership policy. +Reuse *pairing* (free+alloc → `reuse`) stays +IxIR₂'s optimization as planned: recursor-compiled code allocates +inside its minors, out of reach of alt-local pairing. + +## Stage 1 recap (unchanged mechanics) + +ANF over absolute compile-time slots; spine saturation against known +heads (exact `call`/`alloc`/`extern`, sound under-fill `papp`, over-fill +call-then-`apply`); recursors to `case`(+`peelNat`)/`callSelf` with +v1's self-saturation requirement; lambda lifting (a closure is a +`papp` of its captures) and eta wrappers for first-class ctors; +`apply` consumes its pap per the `Eval.lean` convention; case +alternatives dup their fields *before* dropping the scrutinee. + +Recorded corners: runtime-◻ into `apply`/`fetch` through a variable +is stuck here, absorbed at IxIR₀ (erasure never produces it); +closures compare opaquely against +paps; synthetic addresses are placeholder bytes; `CtorId.block` +carries the source constructor address. + +The differential harness runs the corpus through both semantics +(modes are inert at IxIR₀, so source values are unaffected): readback +trees must agree and every successful run must be leak-free — unique +results released by deep free, shared ones by drop. Error runs agree +only through the deliberate `errAgree` mapping (exact kinds, +addresses, and pinned message pairs — never any-error-vs-any-error). +-/ + +namespace Ix.Compiler.IxIR1.Lower + +open Ix.Compiler.Ixon (Address Owned Uses) +open Ix.Compiler.IxIR0 (Literal) + +/-! ## Source-side analyses -/ + +/-- Occurrences of de Bruijn variable `i` in `e`, any position. -/ +def countUses (i : Nat) : IxIR0.Expr → Nat + | .var j => if j == i then 1 else 0 + | .ref _ | .lit _ | .erased => 0 + | .app f a => countUses i f + countUses i a + | .lam _ b => countUses (i + 1) b + | .letE _ v b => countUses i v + countUses (i + 1) b + | .proj _ s => countUses i s + +/-- Length of the leading `lam` run. -/ +def lamArity : IxIR0.Expr → Nat + | .lam _ b => lamArity b + 1 + | _ => 0 + +/-- Strip the leading `lam` run. -/ +def stripLams : IxIR0.Expr → IxIR0.Expr + | .lam _ b => stripLams b + | e => e + +/-- The binder modes of the leading `lam` run — a known callee's +argument-world signature. -/ +def lamUses : IxIR0.Expr → List Uses + | .lam u b => u :: lamUses b + | _ => [] + +@[simp] theorem lamUses_length (e : IxIR0.Expr) : + (lamUses e).length = lamArity e := by + induction e <;> simp [lamUses, lamArity, *] + +/-- Shared paps can soundly accept only shared (`many`) parameters. +Non-`many` functions must remain visible as saturated known calls. -/ +def papSafe (e : IxIR0.Expr) : Bool := + (lamUses e).all fun u => u == .many + +/-- Stable diagnostic for the v0 no-freeze policy. Kept public so the +executable restriction corpus cannot drift from the lowerer. -/ +def freezeNeededMsg : String := + "freeze not in v0: unique value at non-unique sink (see docs/compiler/lowering-restrictions.md)" + +/-- Stable diagnostic for first-class functions whose telescope is not +all-`many`. -/ +def nonManyPapMsg : String := + "non-many function values require saturated known calls (one-shot paps deferred)" + +/-- Stable diagnostic for consuming projection from a unique source. -/ +def uniqueDestructuringMsg : String := + "projection from a unique value (unique destructuring deferred)" + +/-- Stable diagnostic for a unique value captured by a shared closure. -/ +def uniqueCaptureMsg : String := + "a lambda captures a unique value (deferred)" + +/-- Stable diagnostic for a recursive-self value used below saturation. -/ +def underAppliedRecSelfMsg : String := + "under-applied recSelf (v1 requires saturated self-calls)" + +/-- The complete policy inventory for the current IxIR₀ → IxIR₁ lowerer. +Each entry has an exact executable rejection witness in `Guards`; the design +ledger and wake conditions live in `docs/compiler/lowering-restrictions.md`. -/ +inductive RestrictionKind where + | freeze + | uniqueDestructuring + | sharedFunctionValues + | uniqueCapture + | modeMonomorphicRecursors + | saturatedRecSelf + deriving BEq, DecidableEq, Repr, Inhabited + +namespace RestrictionKind + +def all : Array RestrictionKind := #[ + .freeze, + .uniqueDestructuring, + .sharedFunctionValues, + .uniqueCapture, + .modeMonomorphicRecursors, + .saturatedRecSelf +] + +/-- The diagnostic pinned by the representative witness for each policy. +Mode-monomorphic recursors reject a unique major through the already-decided +no-freeze boundary, so those two categories deliberately share a message. -/ +def diagnostic : RestrictionKind → String + | .freeze | .modeMonomorphicRecursors => freezeNeededMsg + | .uniqueDestructuring => uniqueDestructuringMsg + | .sharedFunctionValues => nonManyPapMsg + | .uniqueCapture => uniqueCaptureMsg + | .saturatedRecSelf => underAppliedRecSelfMsg + +end RestrictionKind + +#guard RestrictionKind.all.size == 6 +#guard RestrictionKind.all.toList.eraseDups.length == 6 + +/-- The world a binder mode assigns (gate B whole-value scoping): +linear/affine values are unique, everything else shared. -/ +def worldOfUses : Uses → Owned + | .linear | .affine => .unique + | _ => .shared + +/-- Truncate/pad an argument-world list to length `k` (missing +positions — beyond a callee's telescope — demand shared). -/ +def padWorlds (ws : List Owned) (k : Nat) : List Owned := + ws.take k ++ List.replicate (k - ws.length) .shared + +/-! ## The lowering monad -/ + +/-- Placeholder synthetic address (lifted functions, constructor +wrappers): marker byte + counter, disjoint from the hand-written +corpus space. IxIR₁ content addressing replaces this. -/ +def synthAddr (n : Nat) : Address := + Address.ofFn fun i => + if i.val == 0 then 0xFE + else if i.val ≤ 8 then UInt8.ofNat ((n >>> (8 * (i.val - 1))) % 256) + else 0xEE + +structure WrapperMemo where + source : Address + tag : Nat + arity : Nat + wrapper : Address + deriving BEq + +def WrapperMemo.matches (memo : WrapperMemo) (source : Address) + (tag arity : Nat) : Bool := + memo.source == source && memo.tag == tag && memo.arity == arity + +structure LowSt where + /-- Lifted lambdas and constructor wrappers, accumulated. -/ + extra : List (Address × Decl) := [] + /-- Constructor-wrapper memo, including the source shape used to build + the wrapper. Recording the shape makes cache consistency explicit and + prevents an inconsistent internal caller from reusing the wrong eta + expansion for the same address. -/ + wrappers : List WrapperMemo := [] + fresh : Nat := 0 + +abbrev LowerM := EStateM String LowSt + +def freshAddr : LowerM Address := do + let st ← get + set { st with fresh := st.fresh + 1 } + pure (synthAddr st.fresh) + +def pushExtra (d : Address × Decl) : LowerM Unit := + modify fun st => { st with extra := d :: st.extra } + +/-- v1 constructor identity: the constructor's own IxIR₀ address as +the block, its tag as `cidx`. -/ +def ctorIdOf (adr : Address) (tag : Nat) : CtorId := ⟨adr, 0, tag⟩ + +/-- The declaration installed for one first-class constructor wrapper. -/ +def descendingVars : Nat → List Atom + | 0 => [] + | arity + 1 => .var arity :: descendingVars arity + +@[simp] theorem descendingVars_length (arity : Nat) : + (descendingVars arity).length = arity := by + induction arity with + | zero => rfl + | succ arity ih => simp [descendingVars, ih] + +def ctorWrapperDecl (source : Address) (tag arity : Nat) : Decl := + let atoms := (descendingVars arity).toArray + .fn ⟨arity, .shared, true, + .letOp (.alloc .shared (ctorIdOf source tag) atoms) + (.ret (.var 0))⟩ + +/-- Eta-expanding wrapper for a first-class constructor use: +`fun a₁ … aₙ => alloc cid a₁ … aₙ`, memoized per address. Wrappers +allocate shared (partial constructor applications live behind shared +paps this slice). -/ +def wrapperFor (a : Address) (tag ar : Nat) : LowerM Address := do + let st ← get + match st.wrappers.find? (·.matches a tag ar) with + | some memo => pure memo.wrapper + | none => + let w := synthAddr st.fresh + set { st with + fresh := st.fresh + 1, + wrappers := ⟨a, tag, ar, w⟩ :: st.wrappers, + extra := (w, ctorWrapperDecl a tag ar) :: st.extra } + pure w + +/-! ## Compile-time environment + +Runtime positions are tracked as **absolute** slots (distance from the +bottom of the runtime env), immune to later bindings; relative de +Bruijn indices are materialized only at the op that mentions them. +Entries carry their binder mode: `remaining` counts source occurrences +not yet emitted; in the shared world a use that leaves +`remaining > 0` dups and the last use moves, while a unique entry is +move-only (a second use is a lowering error); `held` records whether +the slot's ownership is still with it. -/ + +inductive VEntry where + | slot (abs remaining : Nat) (uses : Uses) (held : Bool) + /-- The rule-environment recursor slot: only a saturated spine head + (compiled to `callSelf`) is supported in v1. -/ + | recSelf (arity : Nat) + +structure VEnv where + entries : List VEntry := [] + depth : Nat := 0 + +def VEnv.rel (Γ : VEnv) (abs : Nat) : Nat := Γ.depth - 1 - abs + +def VEnv.bump (Γ : VEnv) : VEnv := { Γ with depth := Γ.depth + 1 } + +def VEnv.pop (Γ : VEnv) : VEnv := { Γ with entries := Γ.entries.tail } + +def VEnv.setEntry (Γ : VEnv) (i : Nat) (e : VEntry) : VEnv := + { Γ with entries := Γ.entries.set i e } + +/-- Canonical parameter entries, listed in source-variable order +(innermost first). `base` is the number of older absolute slots below the +parameter telescope; `remaining i` is the occurrence count of source +de-Bruijn variable `i`. -/ +def parameterEntries (base : Nat) : + List Uses → (Nat → Nat) → List VEntry + | [], _ => [] + | uses :: tail, remaining => + parameterEntries (base + 1) tail remaining ++ + [.slot base (remaining tail.length) uses true] + +/-- Dependent traversal for the canonical parameter-entry builder. Tail +layout, absolute-slot advancement, and outer-slot construction recurse once; +clients provide only empty and appended-slot result constructors. -/ +theorem parameterEntries_traverse + (remaining : Nat → Nat) + {Result : Nat → List Uses → List VEntry → Prop} + (hnil : ∀ base, Result base [] []) + (hcons : ∀ {base : Nat} {mode : Uses} {modes : List Uses} + {tail : List VEntry}, + Result (base + 1) modes tail → + Result base (mode :: modes) + (tail ++ [.slot base (remaining modes.length) mode true])) : + ∀ (base : Nat) (modes : List Uses), + Result base modes (parameterEntries base modes remaining) := by + intro base modes + induction modes generalizing base with + | nil => exact hnil base + | cons mode modes ih => + simpa [parameterEntries] using hcons (ih (base + 1)) + +/-- Logical entries for an ordered subset of older slots captured by a lifted +lambda. Selected entries receive consecutive absolute capture slots; entries +outside the subset remain as released proof-side placeholders so source +de-Bruijn indices are preserved. -/ +def selectedEntriesFrom (selected : Nat → Bool) (remaining : Nat → Nat) : + List Nat → Nat → List VEntry + | [], _ => [] + | index :: rest, next => + if selected index then + .slot next (remaining index) .many true :: + selectedEntriesFrom selected remaining rest (next + 1) + else + .slot 0 0 .many false :: + selectedEntriesFrom selected remaining rest next + +/-- Dependent traversal for the selected-entry builder. Selection dispatch, +absolute-slot advancement, and released/held entry construction recurse once; +clients provide only empty, unselected, and selected result constructors. -/ +theorem selectedEntriesFrom_traverse + (selected : Nat → Bool) (remaining : Nat → Nat) + {Result : List Nat → Nat → List VEntry → Prop} + (hnil : ∀ next, Result [] next []) + (hfalse : ∀ {index : Nat} {rest : List Nat} {next : Nat} + {tail : List VEntry}, + selected index = false → + Result rest next tail → + Result (index :: rest) next + (.slot 0 0 .many false :: tail)) + (htrue : ∀ {index : Nat} {rest : List Nat} {next : Nat} + {tail : List VEntry}, + selected index = true → + Result rest (next + 1) tail → + Result (index :: rest) next + (.slot next (remaining index) .many true :: tail)) : + ∀ (indices : List Nat) (next : Nat), + Result indices next + (selectedEntriesFrom selected remaining indices next) := by + intro indices + induction indices with + | nil => exact hnil + | cons index rest ih => + intro next + cases hselected : selected index with + | false => + simpa [selectedEntriesFrom, hselected] using + hfalse hselected (ih next) + | true => + simpa [selectedEntriesFrom, hselected] using + htrue hselected (ih (next + 1)) + +@[simp] theorem selectedEntriesFrom_length (selected : Nat → Bool) + (remaining : Nat → Nat) (indices : List Nat) (next : Nat) : + (selectedEntriesFrom selected remaining indices next).length = + indices.length := by + exact selectedEntriesFrom_traverse selected remaining + (Result := fun sourceIndices _ entries => + entries.length = sourceIndices.length) + (hnil := fun _ => rfl) + (hfalse := by + intro index rest current tail hselected htail + simpa using congrArg Nat.succ htail) + (htrue := by + intro index rest current tail hselected htail + simpa using congrArg Nat.succ htail) + indices next + +@[simp] theorem parameterEntries_length (base : Nat) (modes : List Uses) + (remaining : Nat → Nat) : + (parameterEntries base modes remaining).length = modes.length := by + exact parameterEntries_traverse remaining + (Result := fun _ sourceModes entries => + entries.length = sourceModes.length) + (hnil := fun _ => rfl) + (hcons := by + intro current mode rest tail htail + simpa using congrArg Nat.succ htail) + base modes + +/-- One dead parameter to release at function entry. Recording both its +source-entry index and absolute runtime slot lets the emitted operation and +the proof-side ownership environment advance together. -/ +structure SlotDrop where + entry : Nat + abs : Nat + uses : Uses + +/-- Shift a release descriptor past a leading block of unrelated `VEnv` +entries. Absolute runtime positions are unchanged. -/ +def SlotDrop.offsetEntry (offset : Nat) (drop : SlotDrop) : SlotDrop := + { drop with entry := offset + drop.entry } + +/-- The canonical inner-to-outer release plan for parameters with no body +occurrences. -/ +def parameterDrops (base : Nat) : + List Uses → (Nat → Nat) → List SlotDrop + | [], _ => [] + | uses :: tail, remaining => + parameterDrops (base + 1) tail remaining ++ + if remaining tail.length == 0 then + [⟨tail.length, base, uses⟩] + else [] + +/-- A lowered value: an owned runtime slot or an inert scalar atom. -/ +inductive AVal where + | slotA (abs : Nat) + | constA (a : Atom) + +def AVal.toAtom (Γ : VEnv) : AVal → Atom + | .slotA abs => .var (Γ.rel abs) + | .constA a => a + +/-! ## Emission -/ + +abbrev Emit := Code → Code + +def emitOp (op : Op) : Emit := fun c => .letOp op c + +/-- Release owned slots at a binder boundary, by mode: `many` drops, +`affine` deep-frees, a dead `linear` binding is an error. -/ +def releaseSlots (Γ : VEnv) : List SlotDrop → LowerM (VEnv × Emit) + | [] => pure (Γ, id) + | drop :: rest => do + let em ← match drop.uses with + | .many => pure (emitOp (.drop (.var (Γ.rel drop.abs)))) + | .affine => pure (emitOp (.dropU (.var (Γ.rel drop.abs)))) + | .linear => throw "unused linear binding" + | .erased => throw "internal: erased binder mode survived erasure" + let Γ := Γ.setEntry drop.entry + (.slot drop.abs 0 drop.uses false) + let (Γ', em') ← releaseSlots Γ.bump rest + pure (Γ', em ∘ em') + +/-- One borrowed constructor field that a recursor alternative retains before +dropping its major. `entry` is the rule-source variable slot, `fieldAbs` is +the borrowed field's original absolute runtime position, and `remaining` is +its body occurrence count. -/ +structure RecursorFieldRetain where + entry : Nat + fieldAbs : Nat + remaining : Nat + +/-- Canonical constructor-order retain list. Rule source variables list fields +in the opposite order, so entry indices count down while physical field +positions count up. -/ +def recursorFieldRetains (fieldAbs : Nat) (rhs : IxIR0.Expr) : + Nat → List RecursorFieldRetain + | 0 => [] + | fieldCount + 1 => + let uses := countUses fieldCount rhs + (if uses == 0 then [] else [⟨fieldCount, fieldAbs, uses⟩]) ++ + recursorFieldRetains (fieldAbs + 1) rhs fieldCount + +/-- Dependent traversal for the canonical recursor-field retain builder. +Descending source-entry indices, ascending absolute field slots, and the +zero-use retain omission recurse once; clients provide only empty, skipped, +and retained-field result constructors. -/ +theorem recursorFieldRetains_traverse + (rhs : IxIR0.Expr) + {Result : Nat → Nat → List RecursorFieldRetain → Prop} + (hnil : ∀ fieldAbs, Result fieldAbs 0 []) + (hskip : ∀ {fieldAbs fieldCount : Nat} + {tail : List RecursorFieldRetain}, + countUses fieldCount rhs = 0 → + Result (fieldAbs + 1) fieldCount tail → + Result fieldAbs (fieldCount + 1) tail) + (hretain : ∀ {fieldAbs fieldCount : Nat} + {tail : List RecursorFieldRetain}, + countUses fieldCount rhs ≠ 0 → + Result (fieldAbs + 1) fieldCount tail → + Result fieldAbs (fieldCount + 1) + (⟨fieldCount, fieldAbs, countUses fieldCount rhs⟩ :: tail)) : + ∀ (fieldAbs fieldCount : Nat), + Result fieldAbs fieldCount + (recursorFieldRetains fieldAbs rhs fieldCount) := by + intro fieldAbs fieldCount + induction fieldCount generalizing fieldAbs with + | zero => exact hnil fieldAbs + | succ fieldCount ih => + by_cases hzero : countUses fieldCount rhs = 0 + · simpa [recursorFieldRetains, hzero] using + hskip hzero (ih (fieldAbs + 1)) + · simpa [recursorFieldRetains, hzero] using + hretain hzero (ih (fieldAbs + 1)) + +/-- Execute a canonical field-retain list, updating the field-entry block and +building the exact `dup` emitter used by a recursor alternative. -/ +def applyRecursorFieldRetains (Γ : VEnv) : + List RecursorFieldRetain → VEnv × Emit + | [] => (Γ, id) + | retain :: rest => + let em := emitOp (.dup (.var (Γ.rel retain.fieldAbs))) + let Γ := + (Γ.setEntry retain.entry + (.slot Γ.depth retain.remaining .many true)).bump + let (Γ', em') := applyRecursorFieldRetains Γ rest + (Γ', em ∘ em') + +/-- Release owned shared values whose result is discarded +(◻ absorption; arguments there are demanded shared). -/ +def releaseAll (Γ : VEnv) : List AVal → VEnv × Emit + | [] => (Γ, id) + | .constA _ :: rest => releaseAll Γ rest + | .slotA abs :: rest => + let em := emitOp (.drop (.var (Γ.rel abs))) + let (Γ', em') := releaseAll Γ.bump rest + (Γ', em ∘ em') + +/-- Check a statically known heap-result world against its consuming +demand. Scalars satisfy either world dynamically, but without a scalar +result type the lowering must conservatively respect the declaration. -/ +def requireResultWorld (actual demand : Owned) : LowerM Unit := do + if actual == demand then pure () + else if actual == .unique then + throw freezeNeededMsg + else + throw "call result is shared at unique demand" + +private def fuelMsg : String := "lowering fuel exhausted" + +mutual + +/-- Lower `e` in a consuming position at demanded world `w`: the +returned value carries one ownership, which the caller must consume +exactly once. Static producers and declared call results are checked +against that demand. -/ +def lowerE (src : IxIR0.Env) (fuel : Nat) (Γ : VEnv) (w : Owned) + (e : IxIR0.Expr) : LowerM (VEnv × Emit × AVal) := + match fuel with + | 0 => throw fuelMsg + | fuel + 1 => + match e with + | .var i => + match Γ.entries[i]? with + | none => throw s!"unbound source variable {i}" + | some (.recSelf _) => + throw "recSelf escapes: v1 supports only saturated self-calls" + | some (.slot abs remaining uses held) => + if !held then throw s!"internal: variable {i} used after release" + else if worldOfUses uses != w then + if worldOfUses uses == .unique then + throw freezeNeededMsg + else + throw "dereliction: shared value at unique demand" + else if remaining ≥ 2 then + if worldOfUses uses == .unique then + throw "unique variable used more than once" + else + let Γ := Γ.setEntry i (.slot abs (remaining - 1) uses true) + let dupAbs := Γ.depth + pure (Γ.bump, emitOp (.dup (.var (Γ.rel abs))), .slotA dupAbs) + else if remaining == 1 then + let Γ := Γ.setEntry i (.slot abs 0 uses false) + pure (Γ, id, .slotA abs) + else throw s!"internal: variable {i} overcounted" + | .lit l => pure (Γ, id, .constA (.lit l)) + | .erased => pure (Γ, id, .constA .erased) + | .lam _ _ => + if w == .unique then + throw "function values live in the shared world (one-shot closures deferred)" + else lowerLam src fuel Γ e + | .letE u val body => do + let (Γ, em1, av) ← lowerE src fuel Γ (worldOfUses u) val + let n := countUses 0 body + match av with + | .slotA abs => + if n == 0 then + let em2 ← match u with + | .many => pure (emitOp (.drop (.var (Γ.rel abs)))) + | .affine => pure (emitOp (.dropU (.var (Γ.rel abs)))) + | .linear => throw "unused linear binding" + | .erased => throw "internal: erased binder mode survived erasure" + let Γ := { Γ with entries := .slot abs 0 u false :: Γ.entries, + depth := Γ.depth + 1 } + let (Γ, em3, r) ← lowerE src fuel Γ w body + pure (Γ.pop, em1 ∘ em2 ∘ em3, r) + else + let Γ := { Γ with entries := .slot abs n u true :: Γ.entries } + let (Γ, em3, r) ← lowerE src fuel Γ w body + pure (Γ.pop, em1 ∘ em3, r) + | .constA a => + let slotAbs := Γ.depth + let em2 := emitOp (.pure a) + let ent : VEntry := if n == 0 then .slot slotAbs 0 u false + else .slot slotAbs n u true + let Γ := { Γ with entries := ent :: Γ.entries, + depth := Γ.depth + 1 } + let (Γ, em3, r) ← lowerE src fuel Γ w body + pure (Γ.pop, em1 ∘ em2 ∘ em3, r) + | .app f a => lowerSpine src fuel Γ w f [a] + | .proj i s => do + if w == .unique then + throw "projection produces a shared field (unique destructuring deferred)" + let (Γ, em1, sv, release) ← lowerBorrow src fuel Γ s + match sv with + | .constA .erased => pure (Γ, em1, .constA .erased) -- ◻ absorbs + | .constA a => + -- scalar struct: runtime-stuck on both sides, emit faithfully + let em2 := emitOp (.fetch a i) + pure (Γ.bump, em1 ∘ em2, .slotA Γ.depth) + | .slotA abs => + let em2 := emitOp (.fetch (.var (Γ.rel abs)) i) + let fAbs := Γ.depth + let Γ := Γ.bump + let em3 := emitOp (.dup (.var (Γ.rel fAbs))) -- own the field + let dAbs := Γ.depth + let Γ := Γ.bump + if release then + let em4 := emitOp (.drop (.var (Γ.rel abs))) + pure (Γ.bump, em1 ∘ em2 ∘ em3 ∘ em4, .slotA dAbs) + else + pure (Γ, em1 ∘ em2 ∘ em3, .slotA dAbs) + | .ref a => + match src a with + | none => throw "unknown source reference" + | some (.defn result body) => + let n := lamArity body + if n == 0 then do + -- computed global: evaluate now (IxIR₀ evaluates at `ref`) + requireResultWorld result w + pure (Γ.bump, emitOp (.call a #[]), .slotA Γ.depth) + else if w == .unique then + throw "function values live in the shared world (one-shot closures deferred)" + else if result == .unique then + throw "partial applications of unique-result definitions are deferred" + else if !papSafe body then + throw nonManyPapMsg + else + pure (Γ.bump, emitOp (.papp a #[]), .slotA Γ.depth) + | some (.ctor tag ar) => + if ar == 0 then + pure (Γ.bump, emitOp (.alloc w (ctorIdOf a tag) #[]), + .slotA Γ.depth) + else if w == .unique then + throw "partial constructor applications are shared (deferred)" + else do + let w' ← wrapperFor a tag ar + pure (Γ.bump, emitOp (.papp w' #[]), .slotA Γ.depth) + | some (.recursor _ _ _) => + if w == .unique then + throw "function values live in the shared world (one-shot closures deferred)" + else + pure (Γ.bump, emitOp (.papp a #[]), .slotA Γ.depth) + | some (.extern ar) => + if ar == 0 then + pure (Γ.bump, emitOp (.extern a #[]), .slotA Γ.depth) + else if w == .unique then + throw "function values live in the shared world (one-shot closures deferred)" + else + pure (Γ.bump, emitOp (.papp a #[]), .slotA Γ.depth) + termination_by fuel + +/-- Lower `e` in a borrowing position (`fetch` target — shared only: +unique destructuring is deferred with real `case`). The returned flag +says whether the caller must release the value (emit `drop`) right +after the borrowing op: true for temporaries and for a variable's +last occurrence. -/ +def lowerBorrow (src : IxIR0.Env) (fuel : Nat) (Γ : VEnv) + (e : IxIR0.Expr) : LowerM (VEnv × Emit × AVal × Bool) := + match fuel with + | 0 => throw fuelMsg + | fuel + 1 => + match e with + | .var i => + match Γ.entries[i]? with + | none => throw s!"unbound source variable {i}" + | some (.recSelf _) => throw "recSelf in a borrowing position" + | some (.slot abs remaining uses held) => + if !held then throw s!"internal: variable {i} borrowed after release" + else if worldOfUses uses == .unique then + throw uniqueDestructuringMsg + else if remaining == 1 then + let Γ := Γ.setEntry i (.slot abs 0 uses false) + pure (Γ, id, .slotA abs, true) -- last occurrence: release after + else if remaining ≥ 2 then + let Γ := Γ.setEntry i (.slot abs (remaining - 1) uses true) + pure (Γ, id, .slotA abs, false) + else throw s!"internal: variable {i} overcounted" + | _ => do + let (Γ, em, av) ← lowerE src fuel Γ .shared e + let release := match av with | .slotA _ => true | .constA _ => false + pure (Γ, em, av, release) + termination_by fuel + +/-- Flatten and dispatch an application spine; `w` is the demanded +world of the spine's result. Allocations use it and known calls check +their declared result against it. -/ +def lowerSpine (src : IxIR0.Env) (fuel : Nat) (Γ : VEnv) (w : Owned) + (h : IxIR0.Expr) (args : List IxIR0.Expr) : + LowerM (VEnv × Emit × AVal) := + match fuel with + | 0 => throw fuelMsg + | fuel + 1 => + match h with + | .app f a => lowerSpine src fuel Γ w f (a :: args) + | .erased => + -- ◻ head: arguments are still evaluated (then discarded), the + -- application is absorbed statically + applyRest src fuel Γ w id (.constA .erased) args + | .var i => + match Γ.entries[i]? with + | some (.recSelf arity) => + if args.length < arity then + throw underAppliedRecSelfMsg + else do + requireResultWorld .shared w + knownCall src fuel Γ (.callSelf ·) arity + (List.replicate arity .shared) w args + | _ => do + let (Γ, em1, f) ← lowerE src fuel Γ .shared h + applyRest src fuel Γ w em1 f args + | .ref a => + match src a with + | none => throw "unknown source reference" + | some (.defn result body) => + let n := lamArity body + if args.length < n then + if w == .unique then + throw "function values live in the shared world (one-shot closures deferred)" + else if result == .unique then + throw "partial applications of unique-result definitions are deferred" + else if !papSafe body then + throw nonManyPapMsg + else + -- partial application: all parameters and pap storage are shared + knownCall src fuel Γ (.papp a ·) args.length + (List.replicate args.length .shared) w args + else do + requireResultWorld result (if args.length == n then w else .shared) + knownCall src fuel Γ (.call a ·) n + ((lamUses body).map worldOfUses) w args + | some (.ctor tag ar) => + if args.length < ar then + if w == .unique then + throw "partial constructor applications are shared (deferred)" + else do + let w' ← wrapperFor a tag ar + knownCall src fuel Γ (.papp w' ·) args.length + (List.replicate args.length .shared) w args + else + -- whole-value modes: fields are demanded the node's world + knownCall src fuel Γ (.alloc w (ctorIdOf a tag) ·) ar + (List.replicate ar w) w args + | some (.recursor numArgs _ _) => + -- recursors are the all-`many` fragment this slice + let arity := numArgs + 1 + if args.length < arity then + if w == .unique then + throw "function values live in the shared world (one-shot closures deferred)" + else + knownCall src fuel Γ (.papp a ·) args.length + (List.replicate args.length .shared) w args + else do + requireResultWorld .shared w + knownCall src fuel Γ (.call a ·) arity + (List.replicate arity .shared) w args + | some (.extern ar) => + if args.length < ar then + if w == .unique then + throw "function values live in the shared world (one-shot closures deferred)" + else + knownCall src fuel Γ (.papp a ·) args.length + (List.replicate args.length .shared) w args + else + knownCall src fuel Γ (.extern a ·) ar + (List.replicate ar .shared) w args + | _ => do + let (Γ, em1, f) ← lowerE src fuel Γ .shared h + applyRest src fuel Γ w em1 f args + termination_by fuel + +/-- Lower the first `n` spine arguments at the given per-argument +worlds, emit `build` over them, and feed any remaining arguments +through `apply`. -/ +def knownCall (src : IxIR0.Env) (fuel : Nat) (Γ : VEnv) + (build : Array Atom → Op) (n : Nat) (argWs : List Owned) + (resultW : Owned) (args : List IxIR0.Expr) : + LowerM (VEnv × Emit × AVal) := + match fuel with + | 0 => throw fuelMsg + | fuel + 1 => do + let (Γ, em1, avs) ← lowerArgs src fuel Γ + ((args.take n).zip (padWorlds argWs n)) + let atoms := (avs.map (·.toAtom Γ)).toArray + let res := Γ.depth + let Γ := Γ.bump + let em := em1 ∘ emitOp (build atoms) + if args.length ≤ n then pure (Γ, em, .slotA res) + else applyRest src fuel Γ resultW em (.slotA res) (args.drop n) + termination_by fuel + +/-- Left-to-right argument lowering (matching IxIR₀'s evaluation +order), each at its demanded world; atoms are materialized by the +caller at the consuming op. -/ +def lowerArgs (src : IxIR0.Env) (fuel : Nat) (Γ : VEnv) + (args : List (IxIR0.Expr × Owned)) : + LowerM (VEnv × Emit × List AVal) := + match fuel with + | 0 => throw fuelMsg + | fuel + 1 => + match args with + | [] => pure (Γ, id, []) + | (a, aw) :: rest => do + let (Γ, em1, av) ← lowerE src fuel Γ aw a + let (Γ, em2, avs) ← lowerArgs src fuel Γ rest + pure (Γ, em1 ∘ em2, av :: avs) + termination_by fuel + +/-- Apply a function value to further arguments (`apply` consumes the +function per the `Eval.lean` convention); unknown callees demand +shared arguments. A syntactic ◻ function is absorbed statically — +arguments are lowered and released. -/ +def applyRest (src : IxIR0.Env) (fuel : Nat) (Γ : VEnv) (resultW : Owned) + (pre : Emit) (f : AVal) (args : List IxIR0.Expr) : + LowerM (VEnv × Emit × AVal) := + match fuel with + | 0 => throw fuelMsg + | fuel + 1 => + match f with + | .constA .erased => do + let (Γ, em, avs) ← lowerArgs src fuel Γ + (args.map (fun a => (a, Owned.shared))) + let (Γ, em2) := releaseAll Γ avs + pure (Γ, pre ∘ em ∘ em2, .constA .erased) + | _ => do + requireResultWorld .shared resultW + let (Γ, em, avs) ← lowerArgs src fuel Γ + (args.map (fun a => (a, Owned.shared))) + let fAtom := f.toAtom Γ + let atoms := (avs.map (·.toAtom Γ)).toArray + let res := Γ.depth + pure (Γ.bump, pre ∘ em ∘ emitOp (.apply fAtom atoms), .slotA res) + termination_by fuel + +/-- Consume one shared outer value into a lifted lambda's capture prefix. +The source occurrence count inside the lambda is discharged all at once: +retain when later source uses remain, otherwise move the existing owner. -/ +def lowerCapture (e : IxIR0.Expr) (Γ : VEnv) (i : Nat) : + LowerM (VEnv × Emit × AVal) := do + match Γ.entries[i]? with + | some (.slot abs r uses held) => + if !held then throw "internal: capture of a released variable" + else if worldOfUses uses == .unique then + throw uniqueCaptureMsg + else + let inLam := countUses i e + if r > inLam then + let Γ := Γ.setEntry i (.slot abs (r - inLam) uses true) + let dupAbs := Γ.depth + pure (Γ.bump, emitOp (.dup (.var (Γ.rel abs))), .slotA dupAbs) + else if r == inLam then + let Γ := Γ.setEntry i (.slot abs 0 uses false) + pure (Γ, id, .slotA abs) + else throw "internal: capture overcount" + | some (.recSelf _) => + throw "recSelf captured by a lambda (v1 unsupported)" + | none => throw "internal: capture out of range" + +/-- Structurally recursive capture traversal. Factoring this out of +`lowerLam` exposes the exact induction boundary while preserving the old +left-to-right `foldlM` order and output vector. -/ +def lowerCaptures (e : IxIR0.Expr) : + VEnv → List Nat → LowerM (VEnv × Emit × List AVal) + | Γ, [] => pure (Γ, id, []) + | Γ, i :: rest => do + let (Γ, emitHead, value) ← lowerCapture e Γ i + let (Γ, emitTail, values) ← lowerCaptures e Γ rest + pure (Γ, emitHead ∘ emitTail, value :: values) + +/-- Lift an all-`many` `lam` run to a fresh top-level function over +captures ++ parameters (captures must be shared — paps are shared +nodes); the site value is a `papp` of the captures. Non-`many` local +lambdas would require a one-shot pap representation and are rejected. -/ +def lowerLam (src : IxIR0.Env) (fuel : Nat) (Γ : VEnv) + (e : IxIR0.Expr) : LowerM (VEnv × Emit × AVal) := + match fuel with + | 0 => throw fuelMsg + | fuel + 1 => do + let nParams := lamArity e + let us := lamUses e + unless papSafe e do + throw nonManyPapMsg + let body := stripLams e + let caps := (List.range Γ.entries.length).filter + (fun i => countUses i e > 0) + -- consume one ownership per capture at the site + let (Γ, emC, capVals) ← lowerCaptures e Γ caps + let fnAddr ← freshAddr + let k := caps.length + let fnArity := k + nParams + -- lifted body venv: runtime env = params.reverse ++ caps.reverse, + -- so capture j sits at abs j, parameter i (source var i, innermost + -- first) at abs (k + nParams - 1 - i); parameters keep their + -- binder modes (a linear parameter is a unique value in the body), + -- and `us` is outermost-first, so var i's mode sits at nParams-1-i + let paramEnts := parameterEntries k us fun i => countUses i body + let outerEnts := selectedEntriesFrom + (fun m => countUses m e > 0) + (fun m => countUses (nParams + m) body) + (List.range Γ.entries.length) 0 + let paramDrops := parameterDrops k us fun i => countUses i body + let code ← lowerFnBody src fuel + ⟨paramEnts ++ outerEnts, fnArity⟩ paramDrops .shared body + pushExtra (fnAddr, .fn ⟨fnArity, .shared, true, code⟩) + let capAtoms := (capVals.map (·.toAtom Γ)).toArray + let res := Γ.depth + pure (Γ.bump, emC ∘ emitOp (.papp fnAddr capAtoms), .slotA res) + termination_by fuel + +/-- Lower a function body at result demand `w`: mode-directed entry +releases for dead parameters, then the body, closed with `ret`. -/ +def lowerFnBody (src : IxIR0.Env) (fuel : Nat) (Γ : VEnv) + (drops : List SlotDrop) (w : Owned) (body : IxIR0.Expr) : + LowerM Code := + match fuel with + | 0 => throw fuelMsg + | fuel + 1 => do + let (Γ, em0) ← releaseSlots Γ drops + let (Γ, em, av) ← lowerE src fuel Γ w body + pure (em0 (em (.ret (av.toAtom Γ)))) + termination_by fuel + +end + +/-! ## Declaration lowering -/ + +/-- Lower one indexed recursor rule. Factoring this out of the array traversal +keeps the generated-alternative proof aligned with the executable compiler. -/ +def lowerRecursorRule (src : IxIR0.Env) (fuel : Nat) (numArgs : Nat) : + IxIR0.RecRule × Nat → LowerM Alt + | (rule, tag) => do + let arity := numArgs + 1 + let dead : VEntry := .slot 0 0 .many false + let nf := rule.fields + let d0 := arity + nf + -- entry runtime env (bottom-up): pre₁ … pre_numArgs, major, + -- field₁ … field_nf; field j (1-based) ↔ source var (nf - j) + let fieldRetains := + recursorFieldRetains (numArgs + 1) rule.rhs nf + let (Γ0, emDups) := + applyRecursorFieldRetains + ⟨List.replicate nf dead, d0⟩ fieldRetains + -- the rules never see the major: release it (after the field dups) + let emMaj := emitOp (.drop (.var (Γ0.rel numArgs))) + let Γ1 := Γ0.bump + -- Pre-major parameters reuse the canonical declaration layout/release + -- path. Their entries sit after the field block, so only proof-side entry + -- indices are offset; absolute runtime positions stay `0 .. numArgs-1`. + let paramModes := List.replicate numArgs .many + let paramRemaining : Nat → Nat := + fun i => countUses (nf + i) rule.rhs + let paramEnts := parameterEntries 0 paramModes paramRemaining + let paramDrops := + (parameterDrops 0 paramModes paramRemaining).map + (SlotDrop.offsetEntry nf) + let Γparams : VEnv := + ⟨Γ0.entries ++ paramEnts ++ [.recSelf arity], Γ1.depth⟩ + let (Γrhs, emPar) ← releaseSlots Γparams paramDrops + let (Γ3, emR, av) ← lowerE src fuel Γrhs .shared rule.rhs + let code := emDups (emMaj (emPar (emR (.ret (av.toAtom Γ3))))) + pure (Alt.mk tag nf code) + +/-- Compile a recursor to a function: one `case` on the major premise +(last argument), alternatives from the rules. Per alternative: dup the +fields the rule uses (they are borrowed from the scrutinee), *then* +drop the major, then drop parameters dead in this branch, then the +lowered rule rhs. The rule-environment convention +`fields.reverse ++ preMajor.reverse ++ [recSelf]` maps onto case-field +and parameter slots; the recSelf slot compiles to `callSelf`. +Recursors are the all-`many` fragment this slice — everything shared. -/ +def lowerRecursor (src : IxIR0.Env) (fuel : Nat) (numArgs : Nat) + (natLit : Bool) (rules : Array IxIR0.RecRule) : LowerM FnDef := do + let arity := numArgs + 1 + let altsL ← rules.toList.zipIdx.mapM + (lowerRecursorRule src fuel numArgs) + pure ⟨arity, .shared, true, .case (.var 0) natLit altsL.toArray⟩ + +/-- Lower one declaration. Constructors get no declaration of their +own (saturated sites `alloc`; first-class sites go through wrappers, +which land in the accumulated extras). Definition parameters keep +their binder modes, while the declared result world directs body +lowering and is preserved in `FnDef`. -/ +def lowerDecl (src : IxIR0.Env) (fuel : Nat) : + Address × IxIR0.Decl → LowerM (Option (Address × Decl)) + | (a, .defn result body) => do + let n := lamArity body + let us := lamUses body + let b := stripLams body + let entries := parameterEntries 0 us fun i => countUses i b + let drops := parameterDrops 0 us fun i => countUses i b + let code ← lowerFnBody src fuel ⟨entries, n⟩ drops result b + pure (some (a, .fn + ⟨n, result, result == .shared && papSafe body, code⟩)) + | (_, .ctor _ _) => pure none + | (a, .recursor numArgs natLit rules) => do + pure (some (a, .fn (← lowerRecursor src fuel numArgs natLit rules))) + | (a, .extern ar) => pure (some (a, .extern ar)) + +/-- The stateful whole-program action. Factoring it from `lowerAll` exposes +the final generated-declaration and wrapper-cache state to proofs while the +transient lowering API returns only declarations and main code. Production +artifacts cross `LowerAddressed.lowerAllAddressed`, which consumes this final +state and replaces generated names with declaration content addresses. -/ +def lowerAllAction (decls : List (Address × IxIR0.Decl)) + (main : IxIR0.Expr) (mainW : Owned) (fuel : Nat) : + LowerM (List (Address × Decl) × Code) := do + let src := IxIR0.Env.ofList decls + let base ← decls.filterMapM (lowerDecl src fuel) + let mainC ← lowerFnBody src fuel ⟨[], 0⟩ [] mainW main + let st ← get + pure (base ++ st.extra, mainC) + +/-- Lower a whole program plus a closed main expression, at the given result +world for the main expression. This theorem-facing result still contains +transient generated names; use `lowerAllAddressed` for an emitted artifact. -/ +def lowerAll (decls : List (Address × IxIR0.Decl)) (main : IxIR0.Expr) + (mainW : Owned := .shared) (fuel : Nat := 10000) : + Except String (List (Address × Decl) × Code) := + match (lowerAllAction decls main mainW fuel).run {} with + | .ok v _ => .ok v + | .error e _ => .error e + +/-- The indexed form of the stateful whole-program action. Keeping the final +state observable lets the compiled artifact boundary distinguish generated +declarations from source-backed declarations without recognizing the +temporary address spelling. -/ +def lowerAllIndexedAction (decls : List (Address × IxIR0.Decl)) + (main : IxIR0.Expr) (mainW : Owned) (fuel : Nat) : + LowerM (List (Address × Decl) × Code) := + let sourceIndex := IxIR0.Env.Index.ofList decls + let src := sourceIndex.toEnv + do + let base ← decls.filterMapM (lowerDecl src fuel) + let mainC ← lowerFnBody src fuel ⟨[], 0⟩ [] mainW main + let st ← get + pure (base ++ st.extra, mainC) + +/-- The indexed action is propositionally the transparent action: its +captured index implements exactly `Env.ofList` lookup semantics. -/ +theorem lowerAllIndexedAction_eq_lowerAllAction + (decls : List (Address × IxIR0.Decl)) (main : IxIR0.Expr) + (mainW : Owned) (fuel : Nat) : + lowerAllIndexedAction decls main mainW fuel = + lowerAllAction decls main mainW fuel := by + simp only [lowerAllIndexedAction, lowerAllAction, + IxIR0.Env.Index.toEnv_ofList] + +/-- Corpus-scale transient entry point. It constructs the source address index +once, then runs the same declaration/main lowering action against the captured +lookup closure. `lowerAllIndexed_eq_lowerAll` keeps the transparent list +environment as the proof specification; emitted artifacts use +`lowerAllIndexedAddressed`. -/ +def lowerAllIndexed (decls : List (Address × IxIR0.Decl)) + (main : IxIR0.Expr) (mainW : Owned := .shared) (fuel : Nat := 10000) : + Except String (List (Address × Decl) × Code) := + match (lowerAllIndexedAction decls main mainW fuel).run {} with + | .ok value _ => .ok value + | .error error _ => .error error + +theorem lowerAllIndexed_eq_lowerAll + (decls : List (Address × IxIR0.Decl)) (main : IxIR0.Expr) + (mainW : Owned) (fuel : Nat) : + lowerAllIndexed decls main mainW fuel = lowerAll decls main mainW fuel := by + simp only [lowerAllIndexed, lowerAllIndexedAction, lowerAll, lowerAllAction, + IxIR0.Env.Index.toEnv_ofList] + +/-! ## Readback and the differential harness + +Both semantics read back to first-order trees. Constructor identity +compares by the source address (which v1 threads through +`CtorId.block`); pap nodes compare by missing-arity and stored +arguments (their function addresses differ by construction — wrappers +and lifts are synthetic); IxIR₀ closures are opaque and match any +function-shaped tree. -/ + +inductive Tree where + | ctorT (adr : Address) (tag : Nat) (args : List Tree) + | litT (l : Literal) + | erasedT + | papT (missing : Nat) (args : List Tree) + | funT + +mutual + +def Tree.agree : Tree → Tree → Bool + | .ctorT a t as, .ctorT a' t' as' => a == a' && t == t' && agreeList as as' + | .litT l, .litT l' => l == l' + | .erasedT, .erasedT => true + | .papT m as, .papT m' as' => m == m' && agreeList as as' + | .funT, .papT _ _ => true + | .papT _ _, .funT => true + | .funT, .funT => true + | _, _ => false + +def Tree.agreeList : List Tree → List Tree → Bool + | [], [] => true + | x :: xs, y :: ys => Tree.agree x y && Tree.agreeList xs ys + | _, _ => false + +end + +mutual + +def treeOfVal (fuel : Nat) (v : IxIR0.Value) : Option Tree := + match fuel with + | 0 => none + | fuel + 1 => + match v with + | .lit l => some (.litT l) + | .erased => some .erasedT + | .clos _ _ _ => some .funT + | .pap h args => (treeOfVals fuel args).map + (.papT (h.arity - args.length) ·) + | .ctor a t args => (treeOfVals fuel args).map (.ctorT a t ·) + termination_by fuel + +def treeOfVals (fuel : Nat) (vs : List IxIR0.Value) : + Option (List Tree) := + match fuel with + | 0 => none + | fuel + 1 => + match vs with + | [] => some [] + | v :: rest => do + let t ← treeOfVal fuel v + let ts ← treeOfVals fuel rest + pure (t :: ts) + termination_by fuel + +end + +mutual + +def treeOfR (s : Store) (fuel : Nat) (v : RVal) : Option Tree := + match fuel with + | 0 => none + | fuel + 1 => + match v with + | .lit l => some (.litT l) + | .erased => some .erasedT + | .loc l => + match s.get? l with + | none => none + | some box => + match box.node with + | .ctorN cid fields => + (treeOfRs s fuel fields.toList).map (.ctorT cid.block cid.cidx ·) + | .papN _ ar got => + (treeOfRs s fuel got.toList).map (.papT (ar - got.size) ·) + termination_by fuel + +def treeOfRs (s : Store) (fuel : Nat) (vs : List RVal) : + Option (List Tree) := + match fuel with + | 0 => none + | fuel + 1 => + match vs with + | [] => some [] + | v :: rest => do + let t ← treeOfR s fuel v + let ts ← treeOfRs s fuel rest + pure (t :: ts) + termination_by fuel + +end + +/-- Nat decoding on trees (accepting literal tails, as at IxIR₀). -/ +def natT? : Tree → Option Nat + | .ctorT _ 0 [] => some 0 + | .ctorT _ 1 [t] => (natT? t).map (· + 1) + | .litT (.nat n) => some n + | _ => none + +/-- Target-side oracle mirroring the corpus ledger entry. -/ +def tgtOracle : Address → List RVal → Option RVal := fun a args => + if a == IxIR0.Examples.natAddExt then + match args with + | [.lit (.nat m), .lit (.nat n)] => some (.lit (.nat (m + n))) + | _ => none + else none + +/-- Release a run's result by its world: unique trees deep-free, +shared ones drop, scalars are inert. -/ +def releaseResult (ctx : Ctx) (fuel : Nat) (store : Store) (v : RVal) : + Except Err Store := + match v with + | .loc l => + match store.get? l with + | none => .error (.mem s!"release of a dead location {l}") + | some box => + match box.world with + | .unique => dropUVal ctx fuel store v + | .shared => dropVal ctx fuel store v + | _ => .ok store + +/-- Pinned cross-IR stuck-message pairs (source, target) — every stuck +agreement the corpus exercises, by exact text. An unlisted pair counts +as divergence: extend the table deliberately when a new fixture +legitimately sticks on both sides. -/ +def stuckPairs : List (String × String) := + [("application of a non-function value", "apply of a non-node value"), + ("projection 5 out of bounds", "fetch field 5 out of range")] + +/-- Deliberate error-agreement mapping between the two semantics +(`lowersErr`'s exactness, extended across IRs): + +- `fuel` pairs only with `fuel` (a stuck side against a diverging side + is a divergence, not agreement); +- unknown references pair by exact address; +- the IxIR₀ `oracleMissing` boundary pairs with the two ways IxIR₁ + refuses the *same* extern call: a `none` oracle answer on scalar + arguments (surfaced as `unknownRef`, matched by address) or the + scalar-only ABI's `mem` rejection of heap arguments (which the + literals-only source oracle observes as a domain miss) — pinned to + that exact ABI message; +- stuck messages pair only through `stuckPairs`; +- everything else — including IxIR₁ `mem` discipline faults, which + have no source counterpart — disagrees. -/ +def errAgree : IxIR0.Err → Err → Bool + | .fuel, .fuel => true + | .unknownRef a, .unknownRef b => a == b + | .oracleMissing a, .unknownRef b => a == b + | .oracleMissing _, .mem msg => + msg == "extern heap arguments require an ownership policy" + | .stuck msg, .stuck msg' => stuckPairs.contains (msg, msg') + | _, _ => false + +/-- The differential check: lower the corpus + `e` (main at world +`mainW`), run both semantics; on success the readback trees must +agree AND releasing the result must leave the store empty +(leak-freedom of the inserted memory ops); on failure both sides must +fail with errors related by the `errAgree` mapping. No leak check runs +on error runs: the evaluator's `Except Err` aborts without returning a +store, so the state at an error is unobservable at this API (a +transactional evaluator would make it checkable; today only successful +runs carry a store to audit). -/ +def diffExpr (e : IxIR0.Expr) (mainW : Owned := .shared) + (runFuel : Nat := 100000) : Bool := + match lowerAllIndexed IxIR0.Examples.declList e mainW with + | .error _ => false + | .ok (ds, mainC) => + let targetIndex := Env.Index.ofList ds + let tctx : Ctx := { decls := targetIndex.toEnv, oracle := tgtOracle } + match IxIR0.Examples.ctx.run e runFuel, runMain tctx mainC runFuel with + | .ok v, .ok (store, r) => + (match treeOfVal 1000 v, treeOfR store 1000 r with + | some a, some b => Tree.agree a b + | _, _ => false) + && (match releaseResult tctx runFuel store r with + | .ok s => s.live == 0 + | .error _ => false) + | .error source, .error target => errAgree source target + | _, _ => false + +/-- Target-only run for counter guards. -/ +def checkLowered (e : IxIR0.Expr) (mainW : Owned) + (p : Store → RVal → Bool) : Bool := + match lowerAllIndexed IxIR0.Examples.declList e mainW with + | .error _ => false + | .ok (ds, mainC) => + let targetIndex := Env.Index.ofList ds + match runMain { decls := targetIndex.toEnv, oracle := tgtOracle } mainC with + | .ok (store, r) => p store r + | .error _ => false + +/-- The lowering statically rejects `e` at the given main world with +the expected diagnostic. Keeping the message in the assertion stops +one mode error from accidentally satisfying a guard for another. -/ +def lowersErr (e : IxIR0.Expr) (mainW : Owned) (expected : String) : Bool := + match lowerAllIndexed IxIR0.Examples.declList e mainW with + | .error msg => msg == expected + | .ok _ => false + +section Guards + +open Ix.Compiler.IxIR0.Examples + +/-! β, let, dup (a variable consumed twice), projection -/ + +#guard diffExpr (.app (.lam .many (.var 0)) (natE 4)) +#guard diffExpr (.letE .many (natE 2) (.app (.ref natSucc) (.var 0))) +#guard diffExpr (.letE .many (natE 2) + (.app (.app (.ref pairMk) (.var 0)) (.var 0))) +#guard diffExpr (.proj 0 (.app (.app (.ref pairMk) (natE 1)) (natE 2))) +#guard diffExpr (.proj 1 (.app (.app (.ref pairMk) (natE 1)) (natE 2))) +#guard diffExpr (.proj 5 (.app (.app (.ref pairMk) (natE 1)) (natE 2))) +#guard diffExpr (.app (.ref pairMk) (natE 1)) -- first-class ctor pap + +-- dead binding: the inserted drop reclaims the unused 1̂ +#guard diffExpr (.letE .many (natE 1) (natE 2)) + +-- a struct borrowed twice: released only after its last projection +#guard diffExpr (.letE .many (.app (.app (.ref pairMk) (natE 1)) (natE 2)) + (.app (.app (.ref natAddDef) (.proj 0 (.var 0))) (.proj 1 (.var 0)))) + +/-! Recursor ι: `case` + `callSelf`, constructor and peeled-literal +majors -/ + +#guard diffExpr (.app (.app (.ref natAddDef) (natE 2)) (natE 3)) +#guard diffExpr (.app (.app (.ref natAddDef) (natE 0)) (natE 0)) +#guard diffExpr (.app (.app (.ref natAddDef) (natE 7)) (natE 0)) +#guard diffExpr (.app (.app (.ref natAddDef) (.lit (.nat 2))) (.lit (.nat 3))) +#guard diffExpr (.app (.app (.ref natAddDef) (natE 1)) (.lit (.nat 3))) + +/-! List recursion, including a shared (dup'd) list argument -/ + +#guard diffExpr + (.app (.app (.ref appendDef) (listE natE [1, 2])) (listE natE [3])) +#guard diffExpr + (.app (.app (.ref appendDef) (listE natE [])) (listE natE [])) +#guard diffExpr (.app (.ref lengthDef) (listE natE [5, 6, 7])) +#guard diffExpr (.letE .many (listE natE [1]) + (.app (.app (.ref appendDef) (.var 0)) (.var 0))) + +/-! Externs (success and both-sides refusal) -/ + +#guard diffExpr + (.app (.app (.ref natAddExt) (.lit (.nat 20))) (.lit (.nat 22))) +#guard diffExpr (.app (.app (.ref natAddExt) (natE 1)) (.lit (.nat 1))) + +/-! ◻ absorption (arguments still lowered, then released), stuckness -/ + +#guard diffExpr (.app .erased (natE 1)) +#guard diffExpr (.proj 0 .erased) +#guard diffExpr (.app (.lit (.nat 1)) (.lit (.nat 2))) + +/-! Lambda lifting with a capture: +`(fun x => (fun y => add x y) 2̂) 3̂` -/ + +#guard diffExpr (.app (.lam .many (.app (.lam .many + (.app (.app (.ref natAddDef) (.var 1)) (.var 0))) (natE 2))) (natE 3)) + +/-! Divergence: Ω exhausts fuel on both sides -/ + +#guard diffExpr + (.app (.lam .many (.app (.var 0) (.var 0))) + (.lam .many (.app (.var 0) (.var 0)))) + (runFuel := 300) + +/-! The lowering rejects unknown references at compile time -/ + +#guard + match lowerAll IxIR0.Examples.declList (.ref (synthAddr 999)) with + | .error _ => true + | .ok _ => false + +/-! Target-side readback: lowered 2+3 really is 5̂ -/ + +#guard + match lowerAll IxIR0.Examples.declList + (.app (.app (.ref natAddDef) (natE 2)) (natE 3)) with + | .ok (ds, c) => + (match runMain { decls := Env.ofList ds, oracle := tgtOracle } c with + | .ok (s, v) => ((treeOfR s 1000 v).bind natT?) == some 5 + | _ => false) + | _ => false + +/-! ## Stage 2: the unique world + +The same corpus expressions flip worlds by demand: `natE`/`pairMk` +spines at unique demand allocate unique. Linear/affine programs run +with **zero refcount operations** — the no-RC strategy, as counter +`#guard`s — and unique results release by deep free in the harness. -/ + +-- linear pair of linear nats: values agree with IxIR₀, leak-free +private def linPair : IxIR0.Expr := + .letE .linear (natE 2) (.letE .linear (natE 3) + (.app (.app (.ref pairMk) (.var 1)) (.var 0))) + +#guard diffExpr linPair (mainW := .unique) + +-- …and with zero RC traffic: 8 unique allocations, nothing else +#guard checkLowered linPair .unique fun s _ => + s.allocs == 8 && s.rcops == 0 && s.frees == 0 && s.live == 8 + +-- a whole unique tree without lets +#guard diffExpr (.app (.app (.ref pairMk) (natE 1)) (natE 2)) + (mainW := .unique) +#guard checkLowered (.app (.app (.ref pairMk) (natE 1)) (natE 2)) + .unique fun s _ => s.allocs == 6 && s.rcops == 0 && s.live == 6 + +-- dead affine: dropU deep-frees the unused 2̂ (3 nodes), no RC ops +private def affDead : IxIR0.Expr := .letE .affine (natE 2) (natE 1) + +#guard diffExpr affDead (mainW := .unique) +#guard checkLowered affDead .unique fun s _ => + s.allocs == 5 && s.frees == 3 && s.rcops == 0 && s.live == 2 + +/-! Static mode errors: the lowering is the operational usage check -/ + +-- a dead linear binding +#guard lowersErr (.letE .linear (natE 1) (natE 2)) .shared + "unused linear binding" + +-- a unique variable used twice +#guard lowersErr (.letE .linear (natE 1) + (.app (.app (.ref pairMk) (.var 0)) (.var 0))) .unique + "unique variable used more than once" + +-- dereliction: a shared value at unique demand +#guard lowersErr (.letE .many (natE 1) (.app (.ref natSucc) (.var 0))) + .unique "dereliction: shared value at unique demand" + +-- freeze needed: a unique value at shared demand +#guard lowersErr (.letE .linear (natE 1) (.app (.ref natSucc) (.var 0))) + .shared freezeNeededMsg + +-- a unique value into a recursor (the all-`many` fragment) +#guard lowersErr (.letE .linear (natE 1) + (.app (.app (.ref natAddDef) (.var 0)) (natE 1))) .shared + freezeNeededMsg + +-- function values live in the shared world +#guard lowersErr (.letE .linear (.lam .many (.var 0)) (.var 0)) .shared + "function values live in the shared world (one-shot closures deferred)" + +-- projection from a unique value +#guard lowersErr + (.letE .linear (.app (.app (.ref pairMk) (natE 1)) (natE 2)) + (.proj 0 (.var 0))) .shared + uniqueDestructuringMsg + +-- shared paps cannot own a captured unique value +private def uniqueCaptureRestriction : IxIR0.Expr := + .letE .linear (natE 1) (.lam .many (.var 1)) + +#guard lowersErr uniqueCaptureRestriction .shared uniqueCaptureMsg + +-- a direct recursor call demands every argument in the shared world +private def modeMonomorphicRecursorRestriction : IxIR0.Expr := + .letE .linear (natE 1) + (.app + (.app + (.app (.ref natRec) (natE 0)) + (.lam .many (.lam .many (.app (.ref natSucc) (.var 0))))) + (.var 0)) + +#guard lowersErr modeMonomorphicRecursorRestriction .shared freezeNeededMsg + +-- `recSelf` exists only in recursor-rule environments. A one-parameter +-- recursor has self arity two, so this one-argument rule call witnesses the +-- exact saturation restriction while the declaration itself is lowered. +private def underAppliedRecSelfAddr : Address := synthAddr 92 + +private def underAppliedRecSelfRule : IxIR0.RecRule := + { fields := 0, rhs := .app (.var 1) (.var 0) } + +private def underAppliedRecSelfRejected : Bool := + match lowerAll + (IxIR0.Examples.declList ++ + [(underAppliedRecSelfAddr, + .recursor 1 false #[underAppliedRecSelfRule])]) + (natE 0) with + | .error message => message == underAppliedRecSelfMsg + | .ok _ => false + +#guard underAppliedRecSelfRejected + +/-- Executable coverage for the complete six-entry policy inventory. The +individual guards above retain readable failure locations; this aggregate +guard prevents a newly listed restriction from landing without a witness. -/ +private def restrictionWitness : RestrictionKind → Bool + | kind@(.freeze) => + lowersErr (.letE .linear (natE 1) (.app (.ref natSucc) (.var 0))) + .shared kind.diagnostic + | kind@(.uniqueDestructuring) => + lowersErr + (.letE .linear (.app (.app (.ref pairMk) (natE 1)) (natE 2)) + (.proj 0 (.var 0))) + .shared kind.diagnostic + | kind@(.sharedFunctionValues) => + lowersErr (.app (.lam .affine (.lit (.nat 7))) (natE 3)) + .shared kind.diagnostic + | kind@(.uniqueCapture) => + lowersErr uniqueCaptureRestriction .shared kind.diagnostic + | kind@(.modeMonomorphicRecursors) => + lowersErr modeMonomorphicRecursorRestriction .shared kind.diagnostic + | .saturatedRecSelf => underAppliedRecSelfRejected + +#guard RestrictionKind.all.all restrictionWitness + +/-! Non-`many` function values are rejected before they can reach the +all-shared `apply` path: direct lambdas, bare known references, and +under-applied known definitions all pin the same exact diagnostic. +All-`many` partial applications remain supported. -/ + +#guard lowersErr + (.app (.lam .affine (.lit (.nat 7))) (natE 3)) .shared + nonManyPapMsg + +#guard lowersErr (.ref dropFstDef) .shared nonManyPapMsg + +#guard lowersErr (.app (.ref dropFstDef) (natE 1)) .shared nonManyPapMsg + +#guard diffExpr (.app (.ref natAddDef) (natE 2)) + +/-! Declared result worlds close the old call seam: a shared result at +unique demand is rejected statically, before a mismatched `dropU` can +reach the evaluator. -/ + +#guard lowersErr + (.letE .affine + (.app (.app (.ref natAddDef) (natE 1)) (natE 1)) + (natE 0)) .shared + "call result is shared at unique demand" + +private def uniqueResultDef : Address := synthAddr 91 + +private def uniqueResultDecls : List (Address × IxIR0.Decl) := + IxIR0.Examples.declList ++ + [(uniqueResultDef, .defn .unique (natE 1))] + +/-! A declared unique computed global is lowered in the unique world, +its signature survives in `FnDef`, and an unused affine caller can +deep-free the returned tree with no RC traffic. -/ + +#guard + match lowerAll uniqueResultDecls + (.letE .affine (.ref uniqueResultDef) (natE 0)) with + | .ok (ds, c) => + match (Env.ofList ds) uniqueResultDef, + runMain { decls := Env.ofList ds, oracle := tgtOracle } c with + | some (.fn d), .ok (s, _) => + d.result == .unique && s.allocs == 3 && s.frees == 2 && + s.rcops == 0 && s.live == 1 + | _, _ => false + | .error _ => false + +#guard + match lowerAll uniqueResultDecls (.ref uniqueResultDef) .shared with + | .error msg => + msg == freezeNeededMsg + | .ok _ => false + +/-! Mixed-mode telescopes: the binder-mode signature is +outermost-first while de Bruijn vars count innermost-first, so +entries, entry drops, and `knownCall` argument worlds must agree +per-parameter. Both orders exercise declaration lowering and saturated +known calls; first-class mixed-mode lambdas are rejected above. -/ + +#guard diffExpr (.app (.app (.ref dropFstDef) (natE 1)) (natE 2)) +#guard diffExpr (.app (.app (.ref dropSndDef) (natE 2)) (natE 1)) + +-- the dead affine argument (2 unique nodes) deep-frees at entry with +-- zero RC traffic; the shared result (3 nodes) survives +#guard checkLowered (.app (.app (.ref dropFstDef) (natE 1)) (natE 2)) + .shared fun s _ => + s.allocs == 5 && s.frees == 2 && s.rcops == 0 && s.live == 3 +#guard checkLowered (.app (.app (.ref dropSndDef) (natE 2)) (natE 1)) + .shared fun s _ => + s.allocs == 5 && s.frees == 2 && s.rcops == 0 && s.live == 3 + +-- A mixed-mode lambda cannot escape into the all-shared papp/apply path. +#guard lowersErr (.lam .affine (.lam .many (.var 0))) .shared + nonManyPapMsg + +-- a dead linear binder in a mixed telescope is rejected *as such* +-- (not as a freeze error on the wrong binder) +#guard + match lowerAll (IxIR0.Examples.declList ++ + [(synthAddr 90, + .defn .shared (.lam .linear (.lam .many (.var 0))))]) + (natE 0) with + | .error "unused linear binding" => true + | _ => false + +end Guards + +end Ix.Compiler.IxIR1.Lower diff --git a/Ix/Compiler/IxIR1/LowerAddressed.lean b/Ix/Compiler/IxIR1/LowerAddressed.lean new file mode 100644 index 000000000..41f5e0ff5 --- /dev/null +++ b/Ix/Compiler/IxIR1/LowerAddressed.lean @@ -0,0 +1,103 @@ +import Ix.Compiler.IxIR1.Lower +import Ix.Compiler.IxIR1.Readdress + +/-! +# Content-addressed IxIR₁ lowering boundary + +`Lower.lowerAllAction` remains the theorem-facing compiler action: generated +lambdas and constructor wrappers carry fresh transient names while their +bodies are being assembled. This module consumes its final state and runs +`Readdress.run`, so no transient generated name escapes through the production +artifact boundary. + +Keeping the boundary separate is also operationally necessary while BLAKE3 is +native: the extensive pure lowering `#guard` corpus can continue to elaborate, +whereas this post-pass runs in the compiled pipeline and test executable. +-/ + +namespace Ix.Compiler.IxIR1.Lower + +/-- Recover the source-backed prefix from the raw whole-program result and +the final generated-declaration suffix. Successful lowering results have +exactly this suffix; exposing the helper lets the semantic companion state +the post-pass call without unfolding the production wrapper. -/ +def sourcePrefix + (raw generated : List (Ixon.Address × Decl)) : + List (Ixon.Address × Decl) := + raw.take (raw.length - generated.length) + +@[simp] theorem sourcePrefix_append + (source generated : List (Ixon.Address × Decl)) : + sourcePrefix (source ++ generated) generated = source := by + simp [sourcePrefix] + +private def finishAddressing + (reserved : List Ixon.Address) + (run : EStateM.Result String LowSt + (List (Ixon.Address × Decl) × Code)) : + Except String Readdress.Result := + match run with + | .error message _ => .error message + | .ok (raw, main) state => + Readdress.runProtected reserved + (sourcePrefix raw state.extra) state.extra main + +/-- Lower with the transparent source environment, then replace every +generated temporary name by the content address of its finished declaration. +The result retains the complete old-to-new provenance map. -/ +def lowerAllAddressed (decls : List (Ixon.Address × IxIR0.Decl)) + (main : IxIR0.Expr) (mainW : Ixon.Owned := .shared) + (fuel : Nat := 10000) : Except String Readdress.Result := + finishAddressing (decls.map Prod.fst) + ((lowerAllAction decls main mainW fuel).run {}) + +/-- Invert a successful production boundary once the theorem-facing raw +compiler run is known. This is the exact `Readdress.run` invocation hidden +by `lowerAllAddressed`; no evaluator or hashing property is assumed here. -/ +theorem readdress_run_of_lowerAllAddressed_eq_ok + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainW : Ixon.Owned} {fuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : Readdress.Result} + (hlower : (lowerAllAction decls main mainW fuel).run {} = + .ok (raw, mainCode) finalState) + (hresult : lowerAllAddressed decls main mainW fuel = .ok result) : + Readdress.runProtected (decls.map Prod.fst) + (sourcePrefix raw finalState.extra) finalState.extra mainCode = + .ok result := by + simpa only [lowerAllAddressed, finishAddressing, hlower] using hresult + +/-- Indexed-source variant used by the production pipeline. -/ +def lowerAllIndexedAddressed + (decls : List (Ixon.Address × IxIR0.Decl)) + (main : IxIR0.Expr) (mainW : Ixon.Owned := .shared) + (fuel : Nat := 10000) : Except String Readdress.Result := + finishAddressing (decls.map Prod.fst) + ((lowerAllIndexedAction decls main mainW fuel).run {}) + +/-- Building the lookup index changes neither the transparent compiler action +nor the content-addressed production result. -/ +theorem lowerAllIndexedAddressed_eq_lowerAllAddressed + (decls : List (Ixon.Address × IxIR0.Decl)) (main : IxIR0.Expr) + (mainW : Ixon.Owned) (fuel : Nat) : + lowerAllIndexedAddressed decls main mainW fuel = + lowerAllAddressed decls main mainW fuel := by + simp only [lowerAllIndexedAddressed, lowerAllAddressed, + lowerAllIndexedAction, lowerAllAction, IxIR0.Env.Index.toEnv_ofList] + +/-- Indexed analogue of `readdress_run_of_lowerAllAddressed_eq_ok`. -/ +theorem readdress_run_of_lowerAllIndexedAddressed_eq_ok + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainW : Ixon.Owned} {fuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : Readdress.Result} + (hlower : (lowerAllIndexedAction decls main mainW fuel).run {} = + .ok (raw, mainCode) finalState) + (hresult : lowerAllIndexedAddressed decls main mainW fuel = .ok result) : + Readdress.runProtected (decls.map Prod.fst) + (sourcePrefix raw finalState.extra) finalState.extra mainCode = + .ok result := by + simpa only [lowerAllIndexedAddressed, finishAddressing, hlower] using + hresult + +end Ix.Compiler.IxIR1.Lower diff --git a/Ix/Compiler/IxIR1/LowerAddressedSim.lean b/Ix/Compiler/IxIR1/LowerAddressedSim.lean new file mode 100644 index 000000000..240574a6f --- /dev/null +++ b/Ix/Compiler/IxIR1/LowerAddressedSim.lean @@ -0,0 +1,580 @@ +import Ix.Compiler.IxIR1.LowerAddressed +import Ix.Compiler.IxIR1.LowerSim +import Ix.Compiler.IxIR1.ReaddressSim + +/-! +# Semantic boundary for content-addressed IxIR₁ lowering + +The theorem-facing lowerer returns source-backed declarations followed by +the final generated-declaration suffix. The production boundary rekeys that +suffix and all references into it. This module connects those two successful +runs and transports exact evaluator results, the three public dynamic-error +exclusion properties, and instruction-level cost observations. + +The raw side deliberately uses `Readdress.Result.preAddressCtx`. It agrees +with every successful lookup in the raw list and supplies stable aliases at +new content keys, which is the total context required by evaluator +equivariance after deduplication. +-/ + +namespace Ix.Compiler.IxIR1.LowerSim + +open Ix.Compiler.Ixon (Owned) +open Ix.Compiler.IxIR1.Lower + +/-- A source value is realized by an addressed heap when that heap is the +address image of some raw heap carrying the existing `ValueGraph` witness. +This keeps locations, values, and graph structure exact while recording the +only representation change introduced by the post-pass. -/ +def AddressedValueGraph (rename : Ixon.Address → Ixon.Address) + (funRel : Sim.FunctionRel) (store : Store) + (sourceValue : IxIR0.Value) (targetValue : RVal) : Prop := + ∃ rawStore, + store = Readdress.Store.mapAddresses rename rawStore ∧ + Sim.ValueGraph funRel rawStore sourceValue targetValue + +/-- Forward simulation whose target heap is compared modulo the declared +address image. Unlike the ordinary `SemanticForwardSimulation`, this +relation does not silently require generated function keys or constructor +identities to remain textually unchanged. -/ +def AddressedSemanticForwardSimulation + (sourceCtx : IxIR0.Ctx) (targetCtx : Ctx) + (source : IxIR0.Expr) (target : Code) + (rename : Ixon.Address → Ixon.Address) + (funRel : Sim.FunctionRel) : Prop := + ∀ {sourceFuel sourceValue}, + IxIR0.eval sourceCtx sourceFuel [] source = .ok sourceValue → + ∃ targetFuel targetStore targetValue, + runMain targetCtx target targetFuel = .ok (targetStore, targetValue) ∧ + AddressedValueGraph rename funRel targetStore sourceValue targetValue + +private theorem estateBindRun_ok_inv_addressed + {error state alpha beta : Type} + {action : EStateM error state alpha} + {next : alpha → EStateM error state beta} + {initial finalState : state} {result : beta} + (hrun : (action >>= next).run initial = .ok result finalState) : + ∃ value middle, + action.run initial = .ok value middle ∧ + (next value).run middle = .ok result finalState := by + change + (match action.run initial with + | .ok value nextState => (next value).run nextState + | .error error nextState => .error error nextState) = + .ok result finalState at hrun + cases haction : action.run initial with + | ok value middle => + rw [haction] at hrun + exact ⟨value, middle, rfl, hrun⟩ + | error error middle => + rw [haction] at hrun + contradiction + +private theorem lowerAllAction_run_of_indexed + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : LowSt} + (hlower : + (lowerAllIndexedAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) : + (lowerAllAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState := by + simpa only [lowerAllIndexedAction_eq_lowerAllAction] using hlower + +private theorem lowerAllAddressed_eq_ok_of_indexed + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {result : Readdress.Result} + (haddressed : + lowerAllIndexedAddressed decls main mainWorld compilerFuel = + .ok result) : + lowerAllAddressed decls main mainWorld compilerFuel = .ok result := by + rw [lowerAllIndexedAddressed_eq_lowerAllAddressed] at haddressed + exact haddressed + +/-- A successful whole-program action returns some source-backed prefix +followed by exactly the generated declarations stored in its final state. -/ +theorem lowerAllAction_result_split + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (raw, mainCode) finalState) : + ∃ source, raw = source ++ finalState.extra := by + simp only [lowerAllAction] at hlower + obtain ⟨base, baseState, _hbase, hafterBase⟩ := + estateBindRun_ok_inv_addressed hlower + obtain ⟨compiledMain, mainState, _hmain, hafterMain⟩ := + estateBindRun_ok_inv_addressed hafterBase + obtain ⟨observed, getState, hget, hpure⟩ := + estateBindRun_ok_inv_addressed hafterMain + have hget' : mainState = observed ∧ mainState = getState := by + simpa using hget + obtain ⟨hobserved, hgetState⟩ := hget' + subst observed + subst getState + have hpure' : + (base ++ mainState.extra, compiledMain) = (raw, mainCode) ∧ + mainState = finalState := by + simpa using hpure + obtain ⟨hresult, hstate⟩ := hpure' + subst finalState + exact ⟨base, (congrArg Prod.fst hresult).symm⟩ + +/-- A successful addressed result and its successful raw compiler run expose +one exact, certified readdressing call over the raw result split. -/ +theorem lowerAllAddressed_readdress_run + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : Readdress.Result} + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllAddressed decls main mainWorld compilerFuel = .ok result) : + ∃ source, + raw = source ++ finalState.extra ∧ + Readdress.run source finalState.extra mainCode = .ok result := by + obtain ⟨source, hraw⟩ := lowerAllAction_result_split hlower + refine ⟨source, hraw, ?_⟩ + have hprotected := + readdress_run_of_lowerAllAddressed_eq_ok hlower haddressed + have hprotected' : + Readdress.runProtected (decls.map Prod.fst) source + finalState.extra mainCode = .ok result := by + simpa only [hraw, sourcePrefix_append] using hprotected + exact (Readdress.run_and_protects_of_runProtected_eq_ok hprotected').1 + +/-- Production lowering fixes every original IxIR₀ declaration identity, +including constructor keys omitted from the raw IxIR₁ environment. -/ +theorem lowerAllAddressed_protectsSourceAddresses + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : Readdress.Result} + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllAddressed decls main mainWorld compilerFuel = .ok result) : + result.protects (decls.map Prod.fst) = true := + (Readdress.run_and_protects_of_runProtected_eq_ok + (readdress_run_of_lowerAllAddressed_eq_ok hlower haddressed)).2 + +/-- Pointwise form of `lowerAllAddressed_protectsSourceAddresses`. -/ +theorem lowerAllAddressed_apply_source_address + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : Readdress.Result} + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllAddressed decls main mainWorld compilerFuel = .ok result) + {address : Ixon.Address} {sourceDecl : IxIR0.Decl} + (hmember : (address, sourceDecl) ∈ decls) : + Readdress.Renaming.apply result.addressMap address = address := by + apply result.apply_eq_of_protects + (lowerAllAddressed_protectsSourceAddresses hlower haddressed) + exact List.mem_map.mpr ⟨(address, sourceDecl), hmember, rfl⟩ + +/-- Indexed production entry points carry the same source-identity +protection certificate. -/ +theorem lowerAllIndexedAddressed_protectsSourceAddresses + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : Readdress.Result} + (hlower : + (lowerAllIndexedAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedAddressed decls main mainWorld compilerFuel = + .ok result) : + result.protects (decls.map Prod.fst) = true := + lowerAllAddressed_protectsSourceAddresses + (lowerAllAction_run_of_indexed hlower) + (lowerAllAddressed_eq_ok_of_indexed haddressed) + +/-- The compiled main before and after the production address pass has one +exact evaluator result at every fuel. Values and heap locations are +unchanged; declaration identities retained in heap nodes are rekeyed. -/ +theorem lowerAllAddressed_runMain + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : Readdress.Result} + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllAddressed decls main mainWorld compilerFuel = .ok result) + (oracle : Ixon.Address → List RVal → Option RVal) + (runFuel : Nat) : + runMain (result.addressedCtx oracle) result.main runFuel = + Readdress.mapRunResult + (Readdress.Renaming.apply result.addressMap) + (runMain (result.preAddressCtx raw oracle) mainCode runFuel) := by + obtain ⟨source, hraw, hrun⟩ := + lowerAllAddressed_readdress_run hlower haddressed + subst raw + exact Readdress.runMain_of_run_eq_ok hrun oracle runFuel + +/-- Production indexed-entry analogue of `lowerAllAddressed_runMain`. -/ +theorem lowerAllIndexedAddressed_runMain + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : Readdress.Result} + (hlower : + (lowerAllIndexedAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedAddressed decls main mainWorld compilerFuel = + .ok result) + (oracle : Ixon.Address → List RVal → Option RVal) + (runFuel : Nat) : + runMain (result.addressedCtx oracle) result.main runFuel = + Readdress.mapRunResult + (Readdress.Renaming.apply result.addressMap) + (runMain (result.preAddressCtx raw oracle) mainCode runFuel) := by + have hlower' : + (lowerAllAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState := by + simpa only [lowerAllIndexedAction_eq_lowerAllAction] using hlower + have haddressed' : + lowerAllAddressed decls main mainWorld compilerFuel = .ok result := by + rw [lowerAllIndexedAddressed_eq_lowerAllAddressed] at haddressed + exact haddressed + exact lowerAllAddressed_runMain hlower' haddressed' oracle runFuel + +/-- Successful raw execution gives the exact addressed heap, the same +runtime value, and therefore the same observable result. -/ +theorem lowerAllAddressed_runMain_success + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel runFuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : Readdress.Result} + {store : Store} {value : RVal} + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllAddressed decls main mainWorld compilerFuel = .ok result) + (oracle : Ixon.Address → List RVal → Option RVal) + (hsource : + runMain (result.preAddressCtx raw oracle) mainCode runFuel = + .ok (store, value)) : + runMain (result.addressedCtx oracle) result.main runFuel = + .ok + (Readdress.Store.mapAddresses + (Readdress.Renaming.apply result.addressMap) store, + value) := by + rw [lowerAllAddressed_runMain hlower haddressed oracle runFuel, hsource] + rfl + +/-- Successful-run form for the indexed production entry point. -/ +theorem lowerAllIndexedAddressed_runMain_success + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel runFuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : Readdress.Result} + {store : Store} {value : RVal} + (hlower : + (lowerAllIndexedAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedAddressed decls main mainWorld compilerFuel = + .ok result) + (oracle : Ixon.Address → List RVal → Option RVal) + (hsource : + runMain (result.preAddressCtx raw oracle) mainCode runFuel = + .ok (store, value)) : + runMain (result.addressedCtx oracle) result.main runFuel = + .ok + (Readdress.Store.mapAddresses + (Readdress.Renaming.apply result.addressMap) store, + value) := by + rw [lowerAllIndexedAddressed_runMain hlower haddressed oracle runFuel, + hsource] + rfl + +/-- Every existing raw whole-program forward simulation composes with the +production address pass. The resulting graph records the exact raw heap +witness whose address image is returned by the addressed evaluator. -/ +theorem lowerAllAddressed_semanticForwardSimulation + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : Readdress.Result} + {funRel : Sim.FunctionRel} + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllAddressed decls main mainWorld compilerFuel = .ok result) + (oracle : Ixon.Address → List RVal → Option RVal) + (hraw : SemanticForwardSimulation sourceCtx + (result.preAddressCtx raw oracle) main mainCode funRel) : + AddressedSemanticForwardSimulation sourceCtx + (result.addressedCtx oracle) main result.main + (Readdress.Renaming.apply result.addressMap) funRel := by + intro sourceFuel sourceValue hsource + obtain ⟨targetFuel, rawStore, targetValue, htarget, hgraph⟩ := + hraw hsource + refine ⟨targetFuel, + Readdress.Store.mapAddresses + (Readdress.Renaming.apply result.addressMap) rawStore, + targetValue, ?_, rawStore, rfl, hgraph⟩ + exact lowerAllAddressed_runMain_success hlower haddressed oracle htarget + +/-- Direct composition theorem for the indexed production entry point. -/ +theorem lowerAllIndexedAddressed_semanticForwardSimulation + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : Readdress.Result} + {funRel : Sim.FunctionRel} + (hlower : + (lowerAllIndexedAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedAddressed decls main mainWorld compilerFuel = + .ok result) + (oracle : Ixon.Address → List RVal → Option RVal) + (hraw : SemanticForwardSimulation sourceCtx + (result.preAddressCtx raw oracle) main mainCode funRel) : + AddressedSemanticForwardSimulation sourceCtx + (result.addressedCtx oracle) main result.main + (Readdress.Renaming.apply result.addressMap) funRel := by + intro sourceFuel sourceValue hsource + obtain ⟨targetFuel, rawStore, targetValue, htarget, hgraph⟩ := + hraw hsource + refine ⟨targetFuel, + Readdress.Store.mapAddresses + (Readdress.Renaming.apply result.addressMap) rawStore, + targetValue, ?_, rawStore, rfl, hgraph⟩ + exact lowerAllIndexedAddressed_runMain_success hlower haddressed oracle + htarget + +/-- Address rekeying cannot introduce a memory-discipline error. -/ +theorem lowerAllAddressed_memoryErrorUnreachable + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : Readdress.Result} + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllAddressed decls main mainWorld compilerFuel = .ok result) + (oracle : Ixon.Address → List RVal → Option RVal) + (hraw : + MemoryErrorUnreachable (result.preAddressCtx raw oracle) mainCode) : + MemoryErrorUnreachable (result.addressedCtx oracle) result.main := by + intro runFuel message htarget + have htransport := + lowerAllAddressed_runMain hlower haddressed oracle runFuel + rw [htarget] at htransport + cases hsource : + runMain (result.preAddressCtx raw oracle) mainCode runFuel with + | ok output => + rcases output with ⟨store, value⟩ + simp [hsource] at htransport + | error error => + cases error with + | fuel => simp [hsource] at htransport + | stuck sourceMessage => simp [hsource] at htransport + | mem sourceMessage => exact hraw runFuel sourceMessage hsource + | unknownRef address => simp [hsource] at htransport + +/-- Address rekeying cannot introduce an ordinary stuck result. -/ +theorem lowerAllAddressed_ordinaryStuckUnreachable + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : Readdress.Result} + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllAddressed decls main mainWorld compilerFuel = .ok result) + (oracle : Ixon.Address → List RVal → Option RVal) + (hraw : + OrdinaryStuckUnreachable (result.preAddressCtx raw oracle) mainCode) : + OrdinaryStuckUnreachable (result.addressedCtx oracle) result.main := by + intro runFuel message htarget + have htransport := + lowerAllAddressed_runMain hlower haddressed oracle runFuel + rw [htarget] at htransport + cases hsource : + runMain (result.preAddressCtx raw oracle) mainCode runFuel with + | ok output => + rcases output with ⟨store, value⟩ + simp [hsource] at htransport + | error error => + cases error with + | fuel => simp [hsource] at htransport + | stuck sourceMessage => exact hraw runFuel sourceMessage hsource + | mem sourceMessage => simp [hsource] at htransport + | unknownRef address => simp [hsource] at htransport + +/-- Address rekeying cannot introduce a closed-world lookup failure. -/ +theorem lowerAllAddressed_unknownRefUnreachable + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : Readdress.Result} + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllAddressed decls main mainWorld compilerFuel = .ok result) + (oracle : Ixon.Address → List RVal → Option RVal) + (hraw : + UnknownRefUnreachable (result.preAddressCtx raw oracle) mainCode) : + UnknownRefUnreachable (result.addressedCtx oracle) result.main := by + intro runFuel address htarget + have htransport := + lowerAllAddressed_runMain hlower haddressed oracle runFuel + rw [htarget] at htransport + cases hsource : + runMain (result.preAddressCtx raw oracle) mainCode runFuel with + | ok output => + rcases output with ⟨store, value⟩ + simp [hsource] at htransport + | error error => + cases error with + | fuel => simp [hsource] at htransport + | stuck sourceMessage => simp [hsource] at htransport + | mem sourceMessage => simp [hsource] at htransport + | unknownRef sourceAddress => + exact hraw runFuel sourceAddress hsource + +/-- Indexed production transport of memory-error exclusion. -/ +theorem lowerAllIndexedAddressed_memoryErrorUnreachable + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : Readdress.Result} + (hlower : + (lowerAllIndexedAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedAddressed decls main mainWorld compilerFuel = + .ok result) + (oracle : Ixon.Address → List RVal → Option RVal) + (hraw : + MemoryErrorUnreachable (result.preAddressCtx raw oracle) mainCode) : + MemoryErrorUnreachable (result.addressedCtx oracle) result.main := + lowerAllAddressed_memoryErrorUnreachable + (lowerAllAction_run_of_indexed hlower) + (lowerAllAddressed_eq_ok_of_indexed haddressed) oracle hraw + +/-- Indexed production transport of ordinary-stuck exclusion. -/ +theorem lowerAllIndexedAddressed_ordinaryStuckUnreachable + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : Readdress.Result} + (hlower : + (lowerAllIndexedAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedAddressed decls main mainWorld compilerFuel = + .ok result) + (oracle : Ixon.Address → List RVal → Option RVal) + (hraw : OrdinaryStuckUnreachable + (result.preAddressCtx raw oracle) mainCode) : + OrdinaryStuckUnreachable (result.addressedCtx oracle) result.main := + lowerAllAddressed_ordinaryStuckUnreachable + (lowerAllAction_run_of_indexed hlower) + (lowerAllAddressed_eq_ok_of_indexed haddressed) oracle hraw + +/-- Indexed production transport of closed-world lookup safety. -/ +theorem lowerAllIndexedAddressed_unknownRefUnreachable + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : Readdress.Result} + (hlower : + (lowerAllIndexedAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedAddressed decls main mainWorld compilerFuel = + .ok result) + (oracle : Ixon.Address → List RVal → Option RVal) + (hraw : + UnknownRefUnreachable (result.preAddressCtx raw oracle) mainCode) : + UnknownRefUnreachable (result.addressedCtx oracle) result.main := + lowerAllAddressed_unknownRefUnreachable + (lowerAllAction_run_of_indexed hlower) + (lowerAllAddressed_eq_ok_of_indexed haddressed) oracle hraw + +@[simp] theorem costObservation_mapAddresses + (rename : Ixon.Address → Ixon.Address) (store : Store) : + costObservation (Readdress.Store.mapAddresses rename store) = + costObservation store := by + rfl + +/-- The address pass preserves all four instruction-level counters on every +successful whole-main run. -/ +theorem lowerAllAddressed_runMain_cost + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel runFuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : Readdress.Result} + {store : Store} {value : RVal} + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllAddressed decls main mainWorld compilerFuel = .ok result) + (oracle : Ixon.Address → List RVal → Option RVal) + (hsource : + runMain (result.preAddressCtx raw oracle) mainCode runFuel = + .ok (store, value)) : + ∃ addressedStore, + runMain (result.addressedCtx oracle) result.main runFuel = + .ok (addressedStore, value) ∧ + costObservation addressedStore = costObservation store := by + refine ⟨Readdress.Store.mapAddresses + (Readdress.Renaming.apply result.addressMap) store, ?_, ?_⟩ + · exact lowerAllAddressed_runMain_success hlower haddressed oracle hsource + · exact costObservation_mapAddresses _ _ + +/-- Indexed production entry point preserves the same cost observation. -/ +theorem lowerAllIndexedAddressed_runMain_cost + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel runFuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : Readdress.Result} + {store : Store} {value : RVal} + (hlower : + (lowerAllIndexedAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedAddressed decls main mainWorld compilerFuel = + .ok result) + (oracle : Ixon.Address → List RVal → Option RVal) + (hsource : + runMain (result.preAddressCtx raw oracle) mainCode runFuel = + .ok (store, value)) : + ∃ addressedStore, + runMain (result.addressedCtx oracle) result.main runFuel = + .ok (addressedStore, value) ∧ + costObservation addressedStore = costObservation store := by + refine ⟨Readdress.Store.mapAddresses + (Readdress.Renaming.apply result.addressMap) store, ?_, ?_⟩ + · exact lowerAllIndexedAddressed_runMain_success hlower haddressed oracle + hsource + · exact costObservation_mapAddresses _ _ + +end Ix.Compiler.IxIR1.LowerSim diff --git a/Ix/Compiler/IxIR1/LowerFullyAddressed.lean b/Ix/Compiler/IxIR1/LowerFullyAddressed.lean new file mode 100644 index 000000000..66e147885 --- /dev/null +++ b/Ix/Compiler/IxIR1/LowerFullyAddressed.lean @@ -0,0 +1,129 @@ +import Ix.Compiler.IxIR1.Lower +import Ix.Compiler.IxIR1.ReaddressAll + +/-! +# Fully content-addressed IxIR₁ lowering boundary + +The existing `LowerAddressed` boundary rekeys generated declarations while +retaining source function keys for its established proof interface. This +companion consumes the same raw whole-pass output and applies +`ReaddressAll` across source and generated functions together. Constructor +keys, which have no IxIR₁ declaration entry, are explicitly reserved; +extern declarations are retained as stable ABI artifacts by `ReaddressAll`. +-/ + +namespace Ix.Compiler.IxIR1.Lower + +open Ix.Compiler.Ixon (Address Owned) + +/-- Source identities used by constructor nodes but absent from the target +declaration environment. -/ +def constructorIdentities + (decls : List (Address × IxIR0.Decl)) : List Address := + decls.filterMap fun + | (address, .ctor _ _) => some address + | _ => none + +private def finishFullAddressing + (reserved : List Address) + (lowered : EStateM.Result String LowSt + (List (Address × Decl) × Code)) : + Except String ReaddressAll.Result := + match lowered with + | .error message _ => .error message + | .ok (raw, main) _ => ReaddressAll.run reserved raw main + +/-- Transparent-environment whole-program lowering followed by SCC-aware +source/generated function readdressing. -/ +def lowerAllFullyAddressed + (decls : List (Address × IxIR0.Decl)) + (main : IxIR0.Expr) (mainWorld : Owned := .shared) + (fuel : Nat := 10000) : Except String ReaddressAll.Result := + finishFullAddressing (constructorIdentities decls) + ((lowerAllAction decls main mainWorld fuel).run {}) + +/-- Indexed production analogue. -/ +def lowerAllIndexedFullyAddressed + (decls : List (Address × IxIR0.Decl)) + (main : IxIR0.Expr) (mainWorld : Owned := .shared) + (fuel : Nat := 10000) : Except String ReaddressAll.Result := + finishFullAddressing (constructorIdentities decls) + ((lowerAllIndexedAction decls main mainWorld fuel).run {}) + +/-- Proof-facing execution record for the production lowering boundary. +`lowerAllIndexedFullyAddressed` deliberately returns only the emitted graph; +this companion retains the exact raw declarations, main code, and final +compiler state consumed by the semantic theorems without running the lowerer +twice. Proof fields are erased by code generation. -/ +structure FullyAddressedTrace + (decls : List (Address × IxIR0.Decl)) (main : IxIR0.Expr) + (mainWorld : Owned) (fuel : Nat) where + raw : List (Address × Decl) + mainCode : Code + finalState : LowSt + result : ReaddressAll.Result + lowerRun : + (lowerAllIndexedAction decls main mainWorld fuel).run {} = + .ok (raw, mainCode) finalState + addressedRun : + lowerAllIndexedFullyAddressed decls main mainWorld fuel = .ok result + +/-- Execute indexed lowering and full SCC addressing once while preserving +the stateful run equation needed by whole-pass proofs. -/ +def lowerAllIndexedFullyAddressedWithTrace + (decls : List (Address × IxIR0.Decl)) + (main : IxIR0.Expr) (mainWorld : Owned := .shared) + (fuel : Nat := 10000) : + Except String (FullyAddressedTrace decls main mainWorld fuel) := + match hlower : (lowerAllIndexedAction decls main mainWorld fuel).run {} with + | .error message _ => .error message + | .ok (raw, mainCode) finalState => + match haddressed : ReaddressAll.run (constructorIdentities decls) + raw mainCode with + | .error message => .error message + | .ok result => + .ok + { raw, mainCode, finalState, result + lowerRun := hlower + addressedRun := by + simp only [lowerAllIndexedFullyAddressed, + finishFullAddressing, hlower, haddressed] } + +theorem lowerAllIndexedFullyAddressed_eq_lowerAllFullyAddressed + (decls : List (Address × IxIR0.Decl)) (main : IxIR0.Expr) + (mainWorld : Owned) (fuel : Nat) : + lowerAllIndexedFullyAddressed decls main mainWorld fuel = + lowerAllFullyAddressed decls main mainWorld fuel := by + simp only [lowerAllIndexedFullyAddressed, lowerAllFullyAddressed, + lowerAllIndexedAction, lowerAllAction, IxIR0.Env.Index.toEnv_ofList] + +/-- Expose the exact SCC pass hidden behind a successful raw compiler run. -/ +theorem readdressAll_run_of_lowerAllFullyAddressed_eq_ok + {decls : List (Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {fuel : Nat} + {raw : List (Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : ReaddressAll.Result} + (hlower : (lowerAllAction decls main mainWorld fuel).run {} = + .ok (raw, mainCode) finalState) + (hresult : lowerAllFullyAddressed decls main mainWorld fuel = + .ok result) : + ReaddressAll.run (constructorIdentities decls) raw mainCode = + .ok result := by + simpa only [lowerAllFullyAddressed, finishFullAddressing, hlower] using + hresult + +theorem readdressAll_run_of_lowerAllIndexedFullyAddressed_eq_ok + {decls : List (Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {fuel : Nat} + {raw : List (Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : ReaddressAll.Result} + (hlower : (lowerAllIndexedAction decls main mainWorld fuel).run {} = + .ok (raw, mainCode) finalState) + (hresult : lowerAllIndexedFullyAddressed decls main mainWorld fuel = + .ok result) : + ReaddressAll.run (constructorIdentities decls) raw mainCode = + .ok result := by + simpa only [lowerAllIndexedFullyAddressed, finishFullAddressing, hlower] + using hresult + +end Ix.Compiler.IxIR1.Lower diff --git a/Ix/Compiler/IxIR1/LowerFullyAddressedSim.lean b/Ix/Compiler/IxIR1/LowerFullyAddressedSim.lean new file mode 100644 index 000000000..a17e8f485 --- /dev/null +++ b/Ix/Compiler/IxIR1/LowerFullyAddressedSim.lean @@ -0,0 +1,343 @@ +import Ix.Compiler.IxIR1.LowerAddressedSim +import Ix.Compiler.IxIR1.LowerFullyAddressed +import Ix.Compiler.IxIR1.ReaddressAllSim + +/-! +# Semantic boundary for fully content-addressed IxIR₁ lowering + +The raw whole-pass compiler still uses transient producer labels internally. +`LowerFullyAddressed` sends the complete raw declaration graph through the +SCC-aware pass, rekeying source and generated functions together while fixing +constructor identities and stable extern ABI keys. This module composes that +exact successful call with evaluator equivariance and the existing raw +lowering relations. +-/ + +namespace Ix.Compiler.IxIR1.LowerSim + +open Ix.Compiler.Ixon (Address Owned) +open Ix.Compiler.IxIR1.Lower + +/-- Exact evaluator-result transport for the transparent lowerer. -/ +theorem lowerAllFullyAddressed_runMain + {decls : List (Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : ReaddressAll.Result} + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllFullyAddressed decls main mainWorld compilerFuel = .ok result) + (oracle : Address → List RVal → Option RVal) + (runFuel : Nat) : + runMain (result.addressedCtx oracle) result.main runFuel = + Readdress.mapRunResult + (Readdress.Renaming.apply result.addressMap) + (runMain (result.preAddressCtx raw oracle) mainCode runFuel) := by + exact ReaddressAll.runMain_of_run_eq_ok + (readdressAll_run_of_lowerAllFullyAddressed_eq_ok hlower haddressed) + oracle runFuel + +/-- Exact evaluator-result transport for the indexed production lowerer. -/ +theorem lowerAllIndexedFullyAddressed_runMain + {decls : List (Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : ReaddressAll.Result} + (hlower : + (lowerAllIndexedAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedFullyAddressed decls main mainWorld compilerFuel = + .ok result) + (oracle : Address → List RVal → Option RVal) + (runFuel : Nat) : + runMain (result.addressedCtx oracle) result.main runFuel = + Readdress.mapRunResult + (Readdress.Renaming.apply result.addressMap) + (runMain (result.preAddressCtx raw oracle) mainCode runFuel) := by + exact ReaddressAll.runMain_of_run_eq_ok + (readdressAll_run_of_lowerAllIndexedFullyAddressed_eq_ok + hlower haddressed) oracle runFuel + +/-- Alias-free evaluator-result transport for the indexed production +lowerer. The raw source context is literally `Env.ofList raw`; the certified +rebuild renaming supplies the total address action needed by the final graph. -/ +theorem lowerAllIndexedFullyAddressed_runMain_exact + {decls : List (Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : ReaddressAll.Result} + (hlower : + (lowerAllIndexedAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedFullyAddressed decls main mainWorld compilerFuel = + .ok result) + (oracle : Address → List RVal → Option RVal) + (runFuel : Nat) : + runMain (result.addressedCtx oracle) result.main runFuel = + Readdress.mapRunResult (result.rebuildRename raw) + (runMain (result.rebuildSourceCtx raw oracle) mainCode runFuel) := by + exact ReaddressAll.runMain_exact_of_run_eq_ok + (readdressAll_run_of_lowerAllIndexedFullyAddressed_eq_ok + hlower haddressed) oracle runFuel + +/-- Successful raw execution gives the exact fully addressed heap image and +the same scalar/location result. -/ +theorem lowerAllIndexedFullyAddressed_runMain_success + {decls : List (Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel runFuel : Nat} + {raw : List (Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : ReaddressAll.Result} + {store : Store} {value : RVal} + (hlower : + (lowerAllIndexedAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedFullyAddressed decls main mainWorld compilerFuel = + .ok result) + (oracle : Address → List RVal → Option RVal) + (hsource : + runMain (result.preAddressCtx raw oracle) mainCode runFuel = + .ok (store, value)) : + runMain (result.addressedCtx oracle) result.main runFuel = + .ok (Readdress.Store.mapAddresses + (Readdress.Renaming.apply result.addressMap) store, value) := by + rw [lowerAllIndexedFullyAddressed_runMain + hlower haddressed oracle runFuel, hsource] + rfl + +/-- Successful execution in the exact raw context gives the corresponding +fully addressed heap under the certified rebuild renaming. -/ +theorem lowerAllIndexedFullyAddressed_runMain_exact_success + {decls : List (Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel runFuel : Nat} + {raw : List (Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : ReaddressAll.Result} + {store : Store} {value : RVal} + (hlower : + (lowerAllIndexedAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedFullyAddressed decls main mainWorld compilerFuel = + .ok result) + (oracle : Address → List RVal → Option RVal) + (hsource : + runMain (result.rebuildSourceCtx raw oracle) mainCode runFuel = + .ok (store, value)) : + runMain (result.addressedCtx oracle) result.main runFuel = + .ok (Readdress.Store.mapAddresses + (result.rebuildRename raw) store, value) := by + rw [lowerAllIndexedFullyAddressed_runMain_exact + hlower haddressed oracle runFuel, hsource] + rfl + +/-- Every original constructor identity is fixed by the complete target map. +Unlike the old generated-only boundary, source function identities are not +claimed fixed: they are deliberately content-addressed. -/ +theorem lowerAllIndexedFullyAddressed_apply_constructorIdentity + {decls : List (Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : ReaddressAll.Result} + (hlower : + (lowerAllIndexedAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedFullyAddressed decls main mainWorld compilerFuel = + .ok result) + {address : Address} + (haddress : address ∈ constructorIdentities decls) : + Readdress.Renaming.apply result.addressMap address = address := by + have hrun := readdressAll_run_of_lowerAllIndexedFullyAddressed_eq_ok + hlower haddressed + have haudit := ReaddressAll.semanticAudit_of_run_eq_ok hrun + apply result.apply_reserved haudit + rw [ReaddressAll.reserved_of_run_eq_ok hrun] + exact haddress + +/-- Any raw IxIR₀→IxIR₁ forward simulation composes with complete +source/generated readdressing. -/ +theorem lowerAllIndexedFullyAddressed_semanticForwardSimulation + {sourceCtx : IxIR0.Ctx} + {decls : List (Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : ReaddressAll.Result} + {funRel : Sim.FunctionRel} + (hlower : + (lowerAllIndexedAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedFullyAddressed decls main mainWorld compilerFuel = + .ok result) + (oracle : Address → List RVal → Option RVal) + (hraw : SemanticForwardSimulation sourceCtx + (result.preAddressCtx raw oracle) main mainCode funRel) : + AddressedSemanticForwardSimulation sourceCtx + (result.addressedCtx oracle) main result.main + (Readdress.Renaming.apply result.addressMap) funRel := by + intro sourceFuel sourceValue hsource + obtain ⟨targetFuel, rawStore, targetValue, htarget, hgraph⟩ := + hraw hsource + refine ⟨targetFuel, + Readdress.Store.mapAddresses + (Readdress.Renaming.apply result.addressMap) rawStore, + targetValue, ?_, rawStore, rfl, hgraph⟩ + exact lowerAllIndexedFullyAddressed_runMain_success + hlower haddressed oracle htarget + +/-- Exact-source form of complete readdressing. Unlike the generic transport, +this theorem needs no alias-completed raw context and records the certified +`rebuildRename` heap image in the addressed value graph. -/ +theorem lowerAllIndexedFullyAddressed_semanticForwardSimulation_exact + {sourceCtx : IxIR0.Ctx} + {decls : List (Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : ReaddressAll.Result} + {funRel : Sim.FunctionRel} + (hlower : + (lowerAllIndexedAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedFullyAddressed decls main mainWorld compilerFuel = + .ok result) + (oracle : Address → List RVal → Option RVal) + (hraw : SemanticForwardSimulation sourceCtx + (result.rebuildSourceCtx raw oracle) main mainCode funRel) : + AddressedSemanticForwardSimulation sourceCtx + (result.addressedCtx oracle) main result.main + (result.rebuildRename raw) funRel := by + intro sourceFuel sourceValue hsource + obtain ⟨targetFuel, rawStore, targetValue, htarget, hgraph⟩ := + hraw hsource + refine ⟨targetFuel, + Readdress.Store.mapAddresses (result.rebuildRename raw) rawStore, + targetValue, ?_, rawStore, rfl, hgraph⟩ + exact lowerAllIndexedFullyAddressed_runMain_exact_success + hlower haddressed oracle htarget + +/-- Complete readdressing cannot introduce a memory-discipline error. -/ +theorem lowerAllIndexedFullyAddressed_memoryErrorUnreachable + {decls : List (Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : ReaddressAll.Result} + (hlower : + (lowerAllIndexedAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedFullyAddressed decls main mainWorld compilerFuel = + .ok result) + (oracle : Address → List RVal → Option RVal) + (hraw : MemoryErrorUnreachable + (result.preAddressCtx raw oracle) mainCode) : + MemoryErrorUnreachable (result.addressedCtx oracle) result.main := by + intro runFuel message htarget + have htransport := lowerAllIndexedFullyAddressed_runMain + hlower haddressed oracle runFuel + rw [htarget] at htransport + cases hsource : runMain (result.preAddressCtx raw oracle) mainCode runFuel with + | ok output => + rcases output with ⟨store, value⟩ + simp [hsource] at htransport + | error error => + cases error with + | fuel => simp [hsource] at htransport + | stuck sourceMessage => simp [hsource] at htransport + | mem sourceMessage => exact hraw runFuel sourceMessage hsource + | unknownRef address => simp [hsource] at htransport + +/-- Complete readdressing cannot introduce ordinary stuckness. -/ +theorem lowerAllIndexedFullyAddressed_ordinaryStuckUnreachable + {decls : List (Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : ReaddressAll.Result} + (hlower : + (lowerAllIndexedAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedFullyAddressed decls main mainWorld compilerFuel = + .ok result) + (oracle : Address → List RVal → Option RVal) + (hraw : OrdinaryStuckUnreachable + (result.preAddressCtx raw oracle) mainCode) : + OrdinaryStuckUnreachable (result.addressedCtx oracle) result.main := by + intro runFuel message htarget + have htransport := lowerAllIndexedFullyAddressed_runMain + hlower haddressed oracle runFuel + rw [htarget] at htransport + cases hsource : runMain (result.preAddressCtx raw oracle) mainCode runFuel with + | ok output => + rcases output with ⟨store, value⟩ + simp [hsource] at htransport + | error error => + cases error with + | fuel => simp [hsource] at htransport + | stuck sourceMessage => exact hraw runFuel sourceMessage hsource + | mem sourceMessage => simp [hsource] at htransport + | unknownRef address => simp [hsource] at htransport + +/-- Complete readdressing cannot introduce a closed-world lookup failure. -/ +theorem lowerAllIndexedFullyAddressed_unknownRefUnreachable + {decls : List (Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : ReaddressAll.Result} + (hlower : + (lowerAllIndexedAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedFullyAddressed decls main mainWorld compilerFuel = + .ok result) + (oracle : Address → List RVal → Option RVal) + (hraw : UnknownRefUnreachable + (result.preAddressCtx raw oracle) mainCode) : + UnknownRefUnreachable (result.addressedCtx oracle) result.main := by + intro runFuel address htarget + have htransport := lowerAllIndexedFullyAddressed_runMain + hlower haddressed oracle runFuel + rw [htarget] at htransport + cases hsource : runMain (result.preAddressCtx raw oracle) mainCode runFuel with + | ok output => + rcases output with ⟨store, value⟩ + simp [hsource] at htransport + | error error => + cases error with + | fuel => simp [hsource] at htransport + | stuck sourceMessage => simp [hsource] at htransport + | mem sourceMessage => simp [hsource] at htransport + | unknownRef sourceAddress => exact hraw runFuel sourceAddress hsource + +/-- All four instruction-level store counters survive complete readdressing. -/ +theorem lowerAllIndexedFullyAddressed_runMain_cost + {decls : List (Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel runFuel : Nat} + {raw : List (Address × Decl)} {mainCode : Code} + {finalState : LowSt} {result : ReaddressAll.Result} + {store : Store} {value : RVal} + (hlower : + (lowerAllIndexedAction decls main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedFullyAddressed decls main mainWorld compilerFuel = + .ok result) + (oracle : Address → List RVal → Option RVal) + (hsource : + runMain (result.preAddressCtx raw oracle) mainCode runFuel = + .ok (store, value)) : + ∃ addressedStore, + runMain (result.addressedCtx oracle) result.main runFuel = + .ok (addressedStore, value) ∧ + costObservation addressedStore = costObservation store := by + refine ⟨Readdress.Store.mapAddresses + (Readdress.Renaming.apply result.addressMap) store, ?_, ?_⟩ + · exact lowerAllIndexedFullyAddressed_runMain_success + hlower haddressed oracle hsource + · exact costObservation_mapAddresses _ _ + +end Ix.Compiler.IxIR1.LowerSim diff --git a/Ix/Compiler/IxIR1/LowerMutualAddressedProgress.lean b/Ix/Compiler/IxIR1/LowerMutualAddressedProgress.lean new file mode 100644 index 000000000..cd1edecf6 --- /dev/null +++ b/Ix/Compiler/IxIR1/LowerMutualAddressedProgress.lean @@ -0,0 +1,942 @@ +import Ix.Compiler.EraseAddressedSim +import Ix.Compiler.IxIR1.LowerAddressedSim +import Ix.Compiler.IxIR1.LowerMutualAddressedSim +import Ix.Compiler.IxIR1.LowerProgress + +/-! +# Certified progress through both production address passes + +The executable erasure validator certifies the literal legacy IxIR₀ +environment. Production first replaces mutual-member keys in that environment +and then replaces generated IxIR₁ keys after lowering. The trace transport +in `IxIR0.ReaddressProjectionSafe` lets the validator's exact call-aware trace +feed the sealed lowering-progress theorem at the first addressed image; the +existing IxIR₁ evaluator transport then carries the successful target run +through the second image. +-/ + +namespace Ix.Compiler.IxIR1.LowerSim + +open Ix.Compiler.Ixon (Address Constant Owned) +open Ix.Compiler.IxIR1.Lower + +/-- Preserve the source-value relation carried by a raw erasure certificate +while exposing the structurally renamed IxIR₀ value used by production. -/ +def MutualAddressedInlinedValRel (ectx : Ixon.Eval.EvalCtx) + (rawCtx : IxIR0.Ctx) (rename : Address → Address) + (sourceValue : Ixon.Eval.Value) (addressedValue : IxIR0.Value) + [scope : Ix.Compiler.Sim.MemberScope] : Prop := + ∃ rawValue, + Ix.Compiler.Sim.InlinedValRel ectx rawCtx sourceValue rawValue ∧ + addressedValue = IxIR0.Readdress.Value.mapAddresses rename rawValue + +namespace CallAwareProjectionSafe + +/-- A validator certificate over the exact legacy environment yields the +exact call-aware trace of the addressed IxIR₀ main. The accompanying value +relation retains the raw witness instead of pretending that `ValRel` itself is +address-invariant. -/ +theorem of_certifiedSharedClosed_addressed + {ectx : Ixon.Eval.EvalCtx} {frame : Ixon.Eval.Frame} + {source : Ixon.Expr} {sourceFuel certFuel : Nat} + {sourceValue : Ixon.Eval.Value} {eraseCtx : Erase.EraseCtx} + {constants : List (Address × Constant)} {programEraseFuel : Nat} + {erased : EraseAddressed.Result} + (beforeOracle afterOracle : IxIR0.Oracle) + (cert : Ix.Compiler.EraseValidator.CertifiedSharedExpr ectx + (erased.rawCtx beforeOracle) none + (Ix.Compiler.EraseValidator.tablesOfFrame frame) + frame.selfAddr [] certFuel source) + (hstrict : ectx.Strict) + (herase : EraseAddressed.run eraseCtx constants cert.target + programEraseFuel = .ok erased) + (hrenameOracle : ∀ address arguments, + afterOracle + (IxIR0.MutualBlock.Renaming.apply erased.addressMap address) + (IxIR0.Readdress.ValueList.mapAddresses + (IxIR0.MutualBlock.Renaming.apply erased.addressMap) arguments) = + (beforeOracle address arguments).map + (IxIR0.Readdress.Value.mapAddresses + (IxIR0.MutualBlock.Renaming.apply erased.addressMap))) + (horacles : Ix.Compiler.Sim.OracleRel ectx.inlineSharing + (erased.rawCtx beforeOracle)) + (hctx : ectx.SharingWF) (hframe : frame.SharingWF) + (hbelow : Ixon.Sharing.sharesBelow frame.sharing.size source = true) + (hsource : Ixon.Eval.eval ectx sourceFuel frame [] source = + .ok sourceValue) : + ∃ targetFuel targetValue, + IxIR0.ProjectionSafe.Eval + (erased.addressed.addressedCtx afterOracle) targetFuel [] + erased.main targetValue ∧ + MutualAddressedInlinedValRel ectx + (erased.rawCtx beforeOracle) + (IxIR0.MutualBlock.Renaming.apply erased.addressMap) + sourceValue targetValue := by + obtain ⟨targetFuel, rawValue, htrace, hrel⟩ := + CallAwareProjectionSafe.of_certifiedSharedClosed cert hstrict horacles hctx + hframe hbelow hsource + let rename := IxIR0.MutualBlock.Renaming.apply erased.addressMap + refine ⟨targetFuel, IxIR0.Readdress.Value.mapAddresses rename rawValue, + ?_, rawValue, hrel, rfl⟩ + exact EraseAddressed.run_projectionSafeMain_of_run_eq_ok herase + beforeOracle afterOracle hrenameOracle htrace + +/-- Member-scoped certificate transport through production IxIR₀ +readdressing. This is the cyclic/indexed counterpart of the empty-scope +compatibility theorem above. -/ +theorem of_certifiedSharedClosed_addressed_with_members + [scope : Ix.Compiler.Sim.MemberScope] + {ectx : Ixon.Eval.EvalCtx} {frame : Ixon.Eval.Frame} + {source : Ixon.Expr} {sourceFuel certFuel : Nat} + {sourceValue : Ixon.Eval.Value} {eraseCtx : Erase.EraseCtx} + {constants : List (Address × Constant)} {programEraseFuel : Nat} + {erased : EraseAddressed.Result} + (beforeOracle afterOracle : IxIR0.Oracle) + (hmembers : Ix.Compiler.Sim.MemberCoverage ectx.inlineSharing + (erased.rawCtx beforeOracle) scope.plan) + (cert : Ix.Compiler.EraseValidator.CertifiedSharedExpr ectx + (erased.rawCtx beforeOracle) none + (Ix.Compiler.EraseValidator.tablesOfFrame frame) + frame.selfAddr [] certFuel source) + (herase : EraseAddressed.run eraseCtx constants cert.target + programEraseFuel = .ok erased) + (hrenameOracle : ∀ address arguments, + afterOracle + (IxIR0.MutualBlock.Renaming.apply erased.addressMap address) + (IxIR0.Readdress.ValueList.mapAddresses + (IxIR0.MutualBlock.Renaming.apply erased.addressMap) arguments) = + (beforeOracle address arguments).map + (IxIR0.Readdress.Value.mapAddresses + (IxIR0.MutualBlock.Renaming.apply erased.addressMap))) + (horacles : Ix.Compiler.Sim.OracleRel ectx.inlineSharing + (erased.rawCtx beforeOracle)) + (hctx : ectx.SharingWF) (hframe : frame.SharingWF) + (hbelow : Ixon.Sharing.sharesBelow frame.sharing.size source = true) + (hsource : Ixon.Eval.eval ectx sourceFuel frame [] source = + .ok sourceValue) : + ∃ targetFuel targetValue, + IxIR0.ProjectionSafe.Eval + (erased.addressed.addressedCtx afterOracle) targetFuel [] + erased.main targetValue ∧ + MutualAddressedInlinedValRel ectx + (erased.rawCtx beforeOracle) + (IxIR0.MutualBlock.Renaming.apply erased.addressMap) + sourceValue targetValue := by + obtain ⟨targetFuel, rawValue, htrace, hrel⟩ := + CallAwareProjectionSafe.of_certifiedSharedClosed_with_members hmembers cert + horacles hctx hframe hbelow hsource + let rename := IxIR0.MutualBlock.Renaming.apply erased.addressMap + refine ⟨targetFuel, IxIR0.Readdress.Value.mapAddresses rename rawValue, + ?_, rawValue, hrel, rfl⟩ + exact EraseAddressed.run_projectionSafeMain_of_run_eq_ok herase + beforeOracle afterOracle hrenameOracle htrace + +end CallAwareProjectionSafe + +/-- The raw IxIR₁ target produced from a certified addressed IxIR₀ main +has a successful run. All callable value and trace contracts are rebuilt +from the actual compiler output; only the two explicit extern contracts +remain premises. -/ +theorem lowerAllIndexedAction_main_progress_of_addressed_certificate_sealed + {ectx : Ixon.Eval.EvalCtx} {frame : Ixon.Eval.Frame} + {source : Ixon.Expr} {sourceFuel certFuel : Nat} + {sourceValue : Ixon.Eval.Value} {eraseCtx : Erase.EraseCtx} + {constants : List (Address × Constant)} {programEraseFuel : Nat} + {erased : EraseAddressed.Result} + (beforeOracle afterOracle : IxIR0.Oracle) + (cert : Ix.Compiler.EraseValidator.CertifiedSharedExpr ectx + (erased.rawCtx beforeOracle) none + (Ix.Compiler.EraseValidator.tablesOfFrame frame) + frame.selfAddr [] certFuel source) + (hstrict : ectx.Strict) + (herase : EraseAddressed.run eraseCtx constants cert.target + programEraseFuel = .ok erased) + (hrenameOracle : ∀ address arguments, + afterOracle + (IxIR0.MutualBlock.Renaming.apply erased.addressMap address) + (IxIR0.Readdress.ValueList.mapAddresses + (IxIR0.MutualBlock.Renaming.apply erased.addressMap) arguments) = + (beforeOracle address arguments).map + (IxIR0.Readdress.Value.mapAddresses + (IxIR0.MutualBlock.Renaming.apply erased.addressMap))) + (horacles : Ix.Compiler.Sim.OracleRel ectx.inlineSharing + (erased.rawCtx beforeOracle)) + (hctx : ectx.SharingWF) (hframe : frame.SharingWF) + (hbelow : Ixon.Sharing.sharesBelow frame.sharing.size source = true) + (hsource : Ixon.Eval.eval ectx sourceFuel frame [] source = + .ok sourceValue) + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Address × Decl)} {mainCode : Code} + {finalState : LowSt} {targetCtx : Ctx} + (hlower : + (lowerAllIndexedAction erased.declarations erased.main mainWorld + compilerFuel).run {} = .ok (raw, mainCode) finalState) + (htarget : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ raw → + targetCtx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented targetCtx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList erased.declarations) + targetCtx) + (hexternValue : ExternValueContract + (CompilerFunctionRel + (erased.addressed.addressedCtx afterOracle) + (IxIR0.Env.ofList erased.declarations) finalState) + (erased.addressed.addressedCtx afterOracle) + targetCtx) + (hexternProgress : ExternTraceProgressContract + (CompilerFunctionRel + (erased.addressed.addressedCtx afterOracle) + (IxIR0.Env.ofList erased.declarations) finalState) + (erased.addressed.addressedCtx afterOracle) + targetCtx) : + ∃ targetFuel store value, + runMain targetCtx mainCode targetFuel = .ok (store, value) := by + obtain ⟨traceFuel, _, htrace, _⟩ := + CallAwareProjectionSafe.of_certifiedSharedClosed_addressed + beforeOracle afterOracle cert hstrict herase hrenameOracle horacles hctx + hframe hbelow hsource + have hlower' : + (lowerAllAction erased.declarations erased.main mainWorld + compilerFuel).run {} = .ok (raw, mainCode) finalState := by + simpa only [lowerAllIndexedAction_eq_lowerAllAction] using hlower + have henv : (erased.addressed.addressedCtx afterOracle).env = + IxIR0.Env.ofList erased.declarations := rfl + exact lowerAllAction_main_progress_of_trace_sealed henv hlower' htarget + hrepresented hcontracts hexternValue hexternProgress htrace + +/-- Member-scoped form of raw addressed target progress. Simultaneous member +coverage replaces the empty-scope strictness route while all lowering and +extern contracts remain identical. -/ +theorem + lowerAllIndexedAction_main_progress_of_addressed_certificate_with_members_sealed + [scope : Ix.Compiler.Sim.MemberScope] + {ectx : Ixon.Eval.EvalCtx} {frame : Ixon.Eval.Frame} + {source : Ixon.Expr} {sourceFuel certFuel : Nat} + {sourceValue : Ixon.Eval.Value} {eraseCtx : Erase.EraseCtx} + {constants : List (Address × Constant)} {programEraseFuel : Nat} + {erased : EraseAddressed.Result} + (beforeOracle afterOracle : IxIR0.Oracle) + (hmembers : Ix.Compiler.Sim.MemberCoverage ectx.inlineSharing + (erased.rawCtx beforeOracle) scope.plan) + (cert : Ix.Compiler.EraseValidator.CertifiedSharedExpr ectx + (erased.rawCtx beforeOracle) none + (Ix.Compiler.EraseValidator.tablesOfFrame frame) + frame.selfAddr [] certFuel source) + (herase : EraseAddressed.run eraseCtx constants cert.target + programEraseFuel = .ok erased) + (hrenameOracle : ∀ address arguments, + afterOracle + (IxIR0.MutualBlock.Renaming.apply erased.addressMap address) + (IxIR0.Readdress.ValueList.mapAddresses + (IxIR0.MutualBlock.Renaming.apply erased.addressMap) arguments) = + (beforeOracle address arguments).map + (IxIR0.Readdress.Value.mapAddresses + (IxIR0.MutualBlock.Renaming.apply erased.addressMap))) + (horacles : Ix.Compiler.Sim.OracleRel ectx.inlineSharing + (erased.rawCtx beforeOracle)) + (hctx : ectx.SharingWF) (hframe : frame.SharingWF) + (hbelow : Ixon.Sharing.sharesBelow frame.sharing.size source = true) + (hsource : Ixon.Eval.eval ectx sourceFuel frame [] source = + .ok sourceValue) + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Address × Decl)} {mainCode : Code} + {finalState : LowSt} {targetCtx : Ctx} + (hlower : + (lowerAllIndexedAction erased.declarations erased.main mainWorld + compilerFuel).run {} = .ok (raw, mainCode) finalState) + (htarget : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ raw → + targetCtx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented targetCtx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList erased.declarations) + targetCtx) + (hexternValue : ExternValueContract + (CompilerFunctionRel + (erased.addressed.addressedCtx afterOracle) + (IxIR0.Env.ofList erased.declarations) finalState) + (erased.addressed.addressedCtx afterOracle) + targetCtx) + (hexternProgress : ExternTraceProgressContract + (CompilerFunctionRel + (erased.addressed.addressedCtx afterOracle) + (IxIR0.Env.ofList erased.declarations) finalState) + (erased.addressed.addressedCtx afterOracle) + targetCtx) : + ∃ targetFuel store value, + runMain targetCtx mainCode targetFuel = .ok (store, value) := by + obtain ⟨traceFuel, _, htrace, _⟩ := + CallAwareProjectionSafe.of_certifiedSharedClosed_addressed_with_members + beforeOracle afterOracle hmembers cert herase hrenameOracle horacles hctx + hframe hbelow hsource + have hlower' : + (lowerAllAction erased.declarations erased.main mainWorld + compilerFuel).run {} = .ok (raw, mainCode) finalState := by + simpa only [lowerAllIndexedAction_eq_lowerAllAction] using hlower + have henv : (erased.addressed.addressedCtx afterOracle).env = + IxIR0.Env.ofList erased.declarations := rfl + exact lowerAllAction_main_progress_of_trace_sealed henv hlower' htarget + hrepresented hcontracts hexternValue hexternProgress htrace + +/-- The successful raw target run survives the generated-code address pass, +so the exact production artifact has a successful execution. -/ +theorem lowerAllIndexedAddressed_main_progress_of_certificate_sealed + {ectx : Ixon.Eval.EvalCtx} {frame : Ixon.Eval.Frame} + {source : Ixon.Expr} {sourceFuel certFuel : Nat} + {sourceValue : Ixon.Eval.Value} {eraseCtx : Erase.EraseCtx} + {constants : List (Address × Constant)} {programEraseFuel : Nat} + {erased : EraseAddressed.Result} + (beforeOracle : IxIR0.Oracle) + (cert : Ix.Compiler.EraseValidator.CertifiedSharedExpr ectx + (erased.rawCtx beforeOracle) none + (Ix.Compiler.EraseValidator.tablesOfFrame frame) + frame.selfAddr [] certFuel source) + (hstrict : ectx.Strict) + (herase : EraseAddressed.run eraseCtx constants cert.target + programEraseFuel = .ok erased) + (hreaddressable : IxIR0.Readdress.Oracle.Readdressable + erased.addressMap beforeOracle) + (horacles : Ix.Compiler.Sim.OracleRel ectx.inlineSharing + (erased.rawCtx beforeOracle)) + (hctx : ectx.SharingWF) (hframe : frame.SharingWF) + (hbelow : Ixon.Sharing.sharesBelow frame.sharing.size source = true) + (hsource : Ixon.Eval.eval ectx sourceFuel frame [] source = + .ok sourceValue) + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Address × Decl)} {mainCode : Code} + {finalState : LowSt} {lowered : IxIR1.Readdress.Result} + (hlower : + (lowerAllIndexedAction erased.declarations erased.main mainWorld + compilerFuel).run {} = .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedAddressed erased.declarations erased.main mainWorld + compilerFuel = .ok lowered) + (targetOracle : Address → List RVal → Option RVal) + (htarget : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ raw → + (lowered.preAddressCtx raw targetOracle).decls targetAddress = + some targetDecl) + (hrepresented : ExtraRepresented + (lowered.preAddressCtx raw targetOracle) finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList erased.declarations) + (lowered.preAddressCtx raw targetOracle)) + (hexternValue : ExternValueContract + (CompilerFunctionRel + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (IxIR0.Env.ofList erased.declarations) finalState) + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (lowered.preAddressCtx raw targetOracle)) + (hexternProgress : ExternTraceProgressContract + (CompilerFunctionRel + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (IxIR0.Env.ofList erased.declarations) finalState) + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (lowered.preAddressCtx raw targetOracle)) : + ∃ targetFuel store value, + runMain (lowered.addressedCtx targetOracle) lowered.main targetFuel = + .ok (store, value) := by + obtain ⟨targetFuel, rawStore, targetValue, hraw⟩ := + lowerAllIndexedAction_main_progress_of_addressed_certificate_sealed + (targetCtx := lowered.preAddressCtx raw targetOracle) + beforeOracle + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle) + cert hstrict herase + (IxIR0.Readdress.Oracle.readdress_compatible hreaddressable) + horacles hctx hframe + hbelow hsource hlower htarget hrepresented hcontracts hexternValue + hexternProgress + refine ⟨targetFuel, + IxIR1.Readdress.Store.mapAddresses + (IxIR1.Readdress.Renaming.apply lowered.addressMap) rawStore, + targetValue, ?_⟩ + exact lowerAllIndexedAddressed_runMain_success hlower haddressed + targetOracle hraw + +/-- Full certificate-sealed production simulation. The validator's raw +call-aware trace establishes target progress after IxIR₀ readdressing; +whole-pass value contracts establish raw lowering agreement; and both address +maps are then composed by their evaluator transports. -/ +theorem + lowerAllIndexedAddressed_semanticForwardSimulation_of_certificate_sealed + {ectx : Ixon.Eval.EvalCtx} {frame : Ixon.Eval.Frame} + {source : Ixon.Expr} {sourceFuel certFuel : Nat} + {sourceValue : Ixon.Eval.Value} {eraseCtx : Erase.EraseCtx} + {constants : List (Address × Constant)} {programEraseFuel : Nat} + {erased : EraseAddressed.Result} + (beforeOracle : IxIR0.Oracle) + (cert : Ix.Compiler.EraseValidator.CertifiedSharedExpr ectx + (erased.rawCtx beforeOracle) none + (Ix.Compiler.EraseValidator.tablesOfFrame frame) + frame.selfAddr [] certFuel source) + (hstrict : ectx.Strict) + (herase : EraseAddressed.run eraseCtx constants cert.target + programEraseFuel = .ok erased) + (hreaddressable : IxIR0.Readdress.Oracle.Readdressable + erased.addressMap beforeOracle) + (horacles : Ix.Compiler.Sim.OracleRel ectx.inlineSharing + (erased.rawCtx beforeOracle)) + (hctx : ectx.SharingWF) (hframe : frame.SharingWF) + (hbelow : Ixon.Sharing.sharesBelow frame.sharing.size source = true) + (hsource : Ixon.Eval.eval ectx sourceFuel frame [] source = + .ok sourceValue) + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Address × Decl)} {mainCode : Code} + {finalState : LowSt} {lowered : IxIR1.Readdress.Result} + (hlower : + (lowerAllIndexedAction erased.declarations erased.main mainWorld + compilerFuel).run {} = .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedAddressed erased.declarations erased.main mainWorld + compilerFuel = .ok lowered) + (targetOracle : Address → List RVal → Option RVal) + (htarget : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ raw → + (lowered.preAddressCtx raw targetOracle).decls targetAddress = + some targetDecl) + (hrepresented : ExtraRepresented + (lowered.preAddressCtx raw targetOracle) finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList erased.declarations) + (lowered.preAddressCtx raw targetOracle)) + (hexternValue : ExternValueContract + (CompilerFunctionRel + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (IxIR0.Env.ofList erased.declarations) finalState) + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (lowered.preAddressCtx raw targetOracle)) + (hexternProgress : ExternTraceProgressContract + (CompilerFunctionRel + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (IxIR0.Env.ofList erased.declarations) finalState) + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (lowered.preAddressCtx raw targetOracle)) : + MutualAddressedSemanticForwardSimulation + (erased.addressed.preAddressCtx erased.groups beforeOracle) + (lowered.addressedCtx targetOracle) cert.target lowered.main + (IxIR0.MutualBlock.Renaming.apply erased.addressMap) + (IxIR1.Readdress.Renaming.apply lowered.addressMap) + (CompilerFunctionRel + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (IxIR0.Env.ofList erased.declarations) finalState) := by + have hlower' : + (lowerAllAction erased.declarations erased.main mainWorld + compilerFuel).run {} = .ok (raw, mainCode) finalState := by + simpa only [lowerAllIndexedAction_eq_lowerAllAction] using hlower + have henv : (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)).env = + IxIR0.Env.ofList erased.declarations := rfl + have hfixedProgress := + lowerAllIndexedAction_main_progress_of_addressed_certificate_sealed + (targetCtx := lowered.preAddressCtx raw targetOracle) + beforeOracle + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle) + cert hstrict herase + (IxIR0.Readdress.Oracle.readdress_compatible hreaddressable) + horacles hctx hframe + hbelow hsource hlower htarget hrepresented hcontracts hexternValue + hexternProgress + have hrawSimulation : SemanticForwardSimulation + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (lowered.preAddressCtx raw targetOracle) erased.main mainCode + (CompilerFunctionRel + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (IxIR0.Env.ofList erased.declarations) finalState) := by + apply lowerAllAction_semanticForwardSimulation_of_targetProgress_sealed + henv hlower' htarget hrepresented hcontracts hexternValue + intro _ _ _ + exact hfixedProgress + intro legacyFuel legacyValue hlegacy + exact lowerAllIndexedAddressed_after_addressedErasure herase + beforeOracle + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle) + (IxIR0.Readdress.Oracle.readdress_compatible hreaddressable) + hlower haddressed targetOracle + hrawSimulation hlegacy + +/-! ## SCC-aware production endpoint -/ + +/-- The certificate-sealed raw target run survives complete source/generated +SCC readdressing, yielding progress for the exact pipeline artifact. -/ +theorem lowerAllIndexedFullyAddressed_main_progress_of_certificate_sealed + {ectx : Ixon.Eval.EvalCtx} {frame : Ixon.Eval.Frame} + {source : Ixon.Expr} {sourceFuel certFuel : Nat} + {sourceValue : Ixon.Eval.Value} {eraseCtx : Erase.EraseCtx} + {constants : List (Address × Constant)} {programEraseFuel : Nat} + {erased : EraseAddressed.Result} + (beforeOracle : IxIR0.Oracle) + (cert : Ix.Compiler.EraseValidator.CertifiedSharedExpr ectx + (erased.rawCtx beforeOracle) none + (Ix.Compiler.EraseValidator.tablesOfFrame frame) + frame.selfAddr [] certFuel source) + (hstrict : ectx.Strict) + (herase : EraseAddressed.run eraseCtx constants cert.target + programEraseFuel = .ok erased) + (hreaddressable : IxIR0.Readdress.Oracle.Readdressable + erased.addressMap beforeOracle) + (horacles : Ix.Compiler.Sim.OracleRel ectx.inlineSharing + (erased.rawCtx beforeOracle)) + (hctx : ectx.SharingWF) (hframe : frame.SharingWF) + (hbelow : Ixon.Sharing.sharesBelow frame.sharing.size source = true) + (hsource : Ixon.Eval.eval ectx sourceFuel frame [] source = + .ok sourceValue) + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Address × Decl)} {mainCode : Code} + {finalState : LowSt} {lowered : IxIR1.ReaddressAll.Result} + (hlower : + (lowerAllIndexedAction erased.declarations erased.main mainWorld + compilerFuel).run {} = .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedFullyAddressed erased.declarations erased.main mainWorld + compilerFuel = .ok lowered) + (targetOracle : Address → List RVal → Option RVal) + (htarget : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ raw → + (lowered.preAddressCtx raw targetOracle).decls targetAddress = + some targetDecl) + (hrepresented : ExtraRepresented + (lowered.preAddressCtx raw targetOracle) finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList erased.declarations) + (lowered.preAddressCtx raw targetOracle)) + (hexternValue : ExternValueContract + (CompilerFunctionRel + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (IxIR0.Env.ofList erased.declarations) finalState) + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (lowered.preAddressCtx raw targetOracle)) + (hexternProgress : ExternTraceProgressContract + (CompilerFunctionRel + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (IxIR0.Env.ofList erased.declarations) finalState) + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (lowered.preAddressCtx raw targetOracle)) : + ∃ targetFuel store value, + runMain (lowered.addressedCtx targetOracle) lowered.main targetFuel = + .ok (store, value) := by + obtain ⟨targetFuel, rawStore, targetValue, hraw⟩ := + lowerAllIndexedAction_main_progress_of_addressed_certificate_sealed + (targetCtx := lowered.preAddressCtx raw targetOracle) + beforeOracle + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle) + cert hstrict herase + (IxIR0.Readdress.Oracle.readdress_compatible hreaddressable) + horacles hctx hframe hbelow hsource hlower htarget hrepresented + hcontracts hexternValue hexternProgress + refine ⟨targetFuel, + IxIR1.Readdress.Store.mapAddresses + (IxIR1.Readdress.Renaming.apply lowered.addressMap) rawStore, + targetValue, ?_⟩ + exact lowerAllIndexedFullyAddressed_runMain_success hlower haddressed + targetOracle hraw + +/-- Final certificate-sealed production simulation through cycle-safe IxIR₀ +member addressing and complete cycle-safe IxIR₁ content addressing. -/ +theorem + lowerAllIndexedFullyAddressed_semanticForwardSimulation_of_certificate_sealed + {ectx : Ixon.Eval.EvalCtx} {frame : Ixon.Eval.Frame} + {source : Ixon.Expr} {sourceFuel certFuel : Nat} + {sourceValue : Ixon.Eval.Value} {eraseCtx : Erase.EraseCtx} + {constants : List (Address × Constant)} {programEraseFuel : Nat} + {erased : EraseAddressed.Result} + (beforeOracle : IxIR0.Oracle) + (cert : Ix.Compiler.EraseValidator.CertifiedSharedExpr ectx + (erased.rawCtx beforeOracle) none + (Ix.Compiler.EraseValidator.tablesOfFrame frame) + frame.selfAddr [] certFuel source) + (hstrict : ectx.Strict) + (herase : EraseAddressed.run eraseCtx constants cert.target + programEraseFuel = .ok erased) + (hreaddressable : IxIR0.Readdress.Oracle.Readdressable + erased.addressMap beforeOracle) + (horacles : Ix.Compiler.Sim.OracleRel ectx.inlineSharing + (erased.rawCtx beforeOracle)) + (hctx : ectx.SharingWF) (hframe : frame.SharingWF) + (hbelow : Ixon.Sharing.sharesBelow frame.sharing.size source = true) + (hsource : Ixon.Eval.eval ectx sourceFuel frame [] source = + .ok sourceValue) + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Address × Decl)} {mainCode : Code} + {finalState : LowSt} {lowered : IxIR1.ReaddressAll.Result} + (hlower : + (lowerAllIndexedAction erased.declarations erased.main mainWorld + compilerFuel).run {} = .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedFullyAddressed erased.declarations erased.main mainWorld + compilerFuel = .ok lowered) + (targetOracle : Address → List RVal → Option RVal) + (htarget : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ raw → + (lowered.preAddressCtx raw targetOracle).decls targetAddress = + some targetDecl) + (hrepresented : ExtraRepresented + (lowered.preAddressCtx raw targetOracle) finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList erased.declarations) + (lowered.preAddressCtx raw targetOracle)) + (hexternValue : ExternValueContract + (CompilerFunctionRel + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (IxIR0.Env.ofList erased.declarations) finalState) + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (lowered.preAddressCtx raw targetOracle)) + (hexternProgress : ExternTraceProgressContract + (CompilerFunctionRel + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (IxIR0.Env.ofList erased.declarations) finalState) + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (lowered.preAddressCtx raw targetOracle)) : + MutualAddressedSemanticForwardSimulation + (erased.addressed.preAddressCtx erased.groups beforeOracle) + (lowered.addressedCtx targetOracle) cert.target lowered.main + (IxIR0.MutualBlock.Renaming.apply erased.addressMap) + (IxIR1.Readdress.Renaming.apply lowered.addressMap) + (CompilerFunctionRel + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (IxIR0.Env.ofList erased.declarations) finalState) := by + have hlower' : + (lowerAllAction erased.declarations erased.main mainWorld + compilerFuel).run {} = .ok (raw, mainCode) finalState := by + simpa only [lowerAllIndexedAction_eq_lowerAllAction] using hlower + have henv : (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)).env = + IxIR0.Env.ofList erased.declarations := rfl + have hfixedProgress := + lowerAllIndexedAction_main_progress_of_addressed_certificate_sealed + (targetCtx := lowered.preAddressCtx raw targetOracle) + beforeOracle + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle) + cert hstrict herase + (IxIR0.Readdress.Oracle.readdress_compatible hreaddressable) + horacles hctx hframe hbelow hsource hlower htarget hrepresented + hcontracts hexternValue hexternProgress + have hrawSimulation : SemanticForwardSimulation + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (lowered.preAddressCtx raw targetOracle) erased.main mainCode + (CompilerFunctionRel + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (IxIR0.Env.ofList erased.declarations) finalState) := by + apply lowerAllAction_semanticForwardSimulation_of_targetProgress_sealed + henv hlower' htarget hrepresented hcontracts hexternValue + intro _ _ _ + exact hfixedProgress + intro legacyFuel legacyValue hlegacy + exact lowerAllIndexedFullyAddressed_after_addressedErasure herase + beforeOracle + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle) + (IxIR0.Readdress.Oracle.readdress_compatible hreaddressable) + hlower haddressed targetOracle hrawSimulation hlegacy + +/-- Member-scoped production simulation used by validator-gated compilation. +The executable erasure certificate, simultaneous member coverage, and both +address-pass traces are exact; the ordinary compiler/extern contracts remain +the explicit semantic boundary. -/ +theorem + lowerAllIndexedFullyAddressed_semanticForwardSimulation_of_certificate_with_members_sealed + [scope : Ix.Compiler.Sim.MemberScope] + {ectx : Ixon.Eval.EvalCtx} {frame : Ixon.Eval.Frame} + {source : Ixon.Expr} {sourceFuel certFuel : Nat} + {sourceValue : Ixon.Eval.Value} {eraseCtx : Erase.EraseCtx} + {constants : List (Address × Constant)} {programEraseFuel : Nat} + {erased : EraseAddressed.Result} + (beforeOracle : IxIR0.Oracle) + (hmembers : Ix.Compiler.Sim.MemberCoverage ectx.inlineSharing + (erased.rawCtx beforeOracle) scope.plan) + (cert : Ix.Compiler.EraseValidator.CertifiedSharedExpr ectx + (erased.rawCtx beforeOracle) none + (Ix.Compiler.EraseValidator.tablesOfFrame frame) + frame.selfAddr [] certFuel source) + (herase : EraseAddressed.run eraseCtx constants cert.target + programEraseFuel = .ok erased) + (hreaddressable : IxIR0.Readdress.Oracle.Readdressable + erased.addressMap beforeOracle) + (horacles : Ix.Compiler.Sim.OracleRel ectx.inlineSharing + (erased.rawCtx beforeOracle)) + (hctx : ectx.SharingWF) (hframe : frame.SharingWF) + (hbelow : Ixon.Sharing.sharesBelow frame.sharing.size source = true) + (hsource : Ixon.Eval.eval ectx sourceFuel frame [] source = + .ok sourceValue) + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Address × Decl)} {mainCode : Code} + {finalState : LowSt} {lowered : IxIR1.ReaddressAll.Result} + (hlower : + (lowerAllIndexedAction erased.declarations erased.main mainWorld + compilerFuel).run {} = .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedFullyAddressed erased.declarations erased.main mainWorld + compilerFuel = .ok lowered) + (targetOracle : Address → List RVal → Option RVal) + (htarget : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ raw → + (lowered.preAddressCtx raw targetOracle).decls targetAddress = + some targetDecl) + (hrepresented : ExtraRepresented + (lowered.preAddressCtx raw targetOracle) finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList erased.declarations) + (lowered.preAddressCtx raw targetOracle)) + (hexternValue : ExternValueContract + (CompilerFunctionRel + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (IxIR0.Env.ofList erased.declarations) finalState) + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (lowered.preAddressCtx raw targetOracle)) + (hexternProgress : ExternTraceProgressContract + (CompilerFunctionRel + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (IxIR0.Env.ofList erased.declarations) finalState) + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (lowered.preAddressCtx raw targetOracle)) : + MutualAddressedSemanticForwardSimulation + (erased.addressed.preAddressCtx erased.groups beforeOracle) + (lowered.addressedCtx targetOracle) cert.target lowered.main + (IxIR0.MutualBlock.Renaming.apply erased.addressMap) + (IxIR1.Readdress.Renaming.apply lowered.addressMap) + (CompilerFunctionRel + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (IxIR0.Env.ofList erased.declarations) finalState) := by + have hlower' : + (lowerAllAction erased.declarations erased.main mainWorld + compilerFuel).run {} = .ok (raw, mainCode) finalState := by + simpa only [lowerAllIndexedAction_eq_lowerAllAction] using hlower + have henv : (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)).env = + IxIR0.Env.ofList erased.declarations := rfl + have hfixedProgress := + lowerAllIndexedAction_main_progress_of_addressed_certificate_with_members_sealed + (targetCtx := lowered.preAddressCtx raw targetOracle) + beforeOracle + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle) + hmembers cert herase + (IxIR0.Readdress.Oracle.readdress_compatible hreaddressable) + horacles hctx hframe hbelow hsource hlower htarget hrepresented + hcontracts hexternValue hexternProgress + have hrawSimulation : SemanticForwardSimulation + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (lowered.preAddressCtx raw targetOracle) erased.main mainCode + (CompilerFunctionRel + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (IxIR0.Env.ofList erased.declarations) finalState) := by + apply lowerAllAction_semanticForwardSimulation_of_targetProgress_sealed + henv hlower' htarget hrepresented hcontracts hexternValue + intro _ _ _ + exact hfixedProgress + intro legacyFuel legacyValue hlegacy + exact lowerAllIndexedFullyAddressed_after_addressedErasure herase + beforeOracle + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle) + (IxIR0.Readdress.Oracle.readdress_compatible hreaddressable) + hlower haddressed targetOracle hrawSimulation hlegacy + +/-- Alias-free member-scoped progress for the exact production artifact. +The validator supplies progress in the literal raw declaration context, and +the certified rebuild map transports that successful run through complete +source/generated content addressing. -/ +theorem + lowerAllIndexedFullyAddressed_main_progress_of_addressed_certificate_with_members_exact_sealed + [scope : Ix.Compiler.Sim.MemberScope] + {ectx : Ixon.Eval.EvalCtx} {frame : Ixon.Eval.Frame} + {source : Ixon.Expr} {sourceFuel certFuel : Nat} + {sourceValue : Ixon.Eval.Value} {eraseCtx : Erase.EraseCtx} + {constants : List (Address × Constant)} {programEraseFuel : Nat} + {erased : EraseAddressed.Result} + (beforeOracle : IxIR0.Oracle) + (hmembers : Ix.Compiler.Sim.MemberCoverage ectx.inlineSharing + (erased.rawCtx beforeOracle) scope.plan) + (cert : Ix.Compiler.EraseValidator.CertifiedSharedExpr ectx + (erased.rawCtx beforeOracle) none + (Ix.Compiler.EraseValidator.tablesOfFrame frame) + frame.selfAddr [] certFuel source) + (herase : EraseAddressed.run eraseCtx constants cert.target + programEraseFuel = .ok erased) + (hreaddressable : IxIR0.Readdress.Oracle.Readdressable + erased.addressMap beforeOracle) + (horacles : Ix.Compiler.Sim.OracleRel ectx.inlineSharing + (erased.rawCtx beforeOracle)) + (hctx : ectx.SharingWF) (hframe : frame.SharingWF) + (hbelow : Ixon.Sharing.sharesBelow frame.sharing.size source = true) + (hsource : Ixon.Eval.eval ectx sourceFuel frame [] source = + .ok sourceValue) + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Address × Decl)} {mainCode : Code} + {finalState : LowSt} {lowered : IxIR1.ReaddressAll.Result} + (hlower : + (lowerAllIndexedAction erased.declarations erased.main mainWorld + compilerFuel).run {} = .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedFullyAddressed erased.declarations erased.main mainWorld + compilerFuel = .ok lowered) + (targetOracle : Address → List RVal → Option RVal) + (htarget : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ raw → + (lowered.rebuildSourceCtx raw targetOracle).decls targetAddress = + some targetDecl) + (hrepresented : ExtraRepresented + (lowered.rebuildSourceCtx raw targetOracle) finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList erased.declarations) + (lowered.rebuildSourceCtx raw targetOracle)) + (hexternValue : ExternValueContract + (CompilerFunctionRel + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (IxIR0.Env.ofList erased.declarations) finalState) + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (lowered.rebuildSourceCtx raw targetOracle)) + (hexternProgress : ExternTraceProgressContract + (CompilerFunctionRel + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (IxIR0.Env.ofList erased.declarations) finalState) + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (lowered.rebuildSourceCtx raw targetOracle)) : + ∃ targetFuel store value, + runMain (lowered.addressedCtx targetOracle) lowered.main targetFuel = + .ok (store, value) := by + obtain ⟨targetFuel, rawStore, targetValue, hraw⟩ := + lowerAllIndexedAction_main_progress_of_addressed_certificate_with_members_sealed + (targetCtx := lowered.rebuildSourceCtx raw targetOracle) + beforeOracle + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle) + hmembers cert herase + (IxIR0.Readdress.Oracle.readdress_compatible hreaddressable) + horacles hctx hframe hbelow hsource hlower htarget hrepresented + hcontracts hexternValue hexternProgress + refine ⟨targetFuel, + IxIR1.Readdress.Store.mapAddresses (lowered.rebuildRename raw) rawStore, + targetValue, ?_⟩ + exact lowerAllIndexedFullyAddressed_runMain_exact_success + hlower haddressed targetOracle hraw + +/-- Alias-free member-scoped production simulation. All raw lowering +obligations are stated against the literal declaration environment, while the +certified rebuild map transports the successful evaluator run to the emitted +content-addressed graph. -/ +theorem + lowerAllIndexedFullyAddressed_semanticForwardSimulation_of_certificate_with_members_exact_sealed + [scope : Ix.Compiler.Sim.MemberScope] + {ectx : Ixon.Eval.EvalCtx} {frame : Ixon.Eval.Frame} + {source : Ixon.Expr} {sourceFuel certFuel : Nat} + {sourceValue : Ixon.Eval.Value} {eraseCtx : Erase.EraseCtx} + {constants : List (Address × Constant)} {programEraseFuel : Nat} + {erased : EraseAddressed.Result} + (beforeOracle : IxIR0.Oracle) + (hmembers : Ix.Compiler.Sim.MemberCoverage ectx.inlineSharing + (erased.rawCtx beforeOracle) scope.plan) + (cert : Ix.Compiler.EraseValidator.CertifiedSharedExpr ectx + (erased.rawCtx beforeOracle) none + (Ix.Compiler.EraseValidator.tablesOfFrame frame) + frame.selfAddr [] certFuel source) + (herase : EraseAddressed.run eraseCtx constants cert.target + programEraseFuel = .ok erased) + (hreaddressable : IxIR0.Readdress.Oracle.Readdressable + erased.addressMap beforeOracle) + (horacles : Ix.Compiler.Sim.OracleRel ectx.inlineSharing + (erased.rawCtx beforeOracle)) + (hctx : ectx.SharingWF) (hframe : frame.SharingWF) + (hbelow : Ixon.Sharing.sharesBelow frame.sharing.size source = true) + (hsource : Ixon.Eval.eval ectx sourceFuel frame [] source = + .ok sourceValue) + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Address × Decl)} {mainCode : Code} + {finalState : LowSt} {lowered : IxIR1.ReaddressAll.Result} + (hlower : + (lowerAllIndexedAction erased.declarations erased.main mainWorld + compilerFuel).run {} = .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedFullyAddressed erased.declarations erased.main mainWorld + compilerFuel = .ok lowered) + (targetOracle : Address → List RVal → Option RVal) + (htarget : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ raw → + (lowered.rebuildSourceCtx raw targetOracle).decls targetAddress = + some targetDecl) + (hrepresented : ExtraRepresented + (lowered.rebuildSourceCtx raw targetOracle) finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList erased.declarations) + (lowered.rebuildSourceCtx raw targetOracle)) + (hexternValue : ExternValueContract + (CompilerFunctionRel + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (IxIR0.Env.ofList erased.declarations) finalState) + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (lowered.rebuildSourceCtx raw targetOracle)) + (hexternProgress : ExternTraceProgressContract + (CompilerFunctionRel + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (IxIR0.Env.ofList erased.declarations) finalState) + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (lowered.rebuildSourceCtx raw targetOracle)) : + MutualAddressedSemanticForwardSimulation + (erased.addressed.preAddressCtx erased.groups beforeOracle) + (lowered.addressedCtx targetOracle) cert.target lowered.main + (IxIR0.MutualBlock.Renaming.apply erased.addressMap) + (lowered.rebuildRename raw) + (CompilerFunctionRel + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (IxIR0.Env.ofList erased.declarations) finalState) := by + have hlower' : + (lowerAllAction erased.declarations erased.main mainWorld + compilerFuel).run {} = .ok (raw, mainCode) finalState := by + simpa only [lowerAllIndexedAction_eq_lowerAllAction] using hlower + have henv : (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)).env = + IxIR0.Env.ofList erased.declarations := rfl + have hfixedProgress := + lowerAllIndexedAction_main_progress_of_addressed_certificate_with_members_sealed + (targetCtx := lowered.rebuildSourceCtx raw targetOracle) + beforeOracle + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle) + hmembers cert herase + (IxIR0.Readdress.Oracle.readdress_compatible hreaddressable) + horacles hctx hframe hbelow hsource hlower htarget hrepresented + hcontracts hexternValue hexternProgress + have hrawSimulation : SemanticForwardSimulation + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (lowered.rebuildSourceCtx raw targetOracle) erased.main mainCode + (CompilerFunctionRel + (erased.addressed.addressedCtx + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle)) + (IxIR0.Env.ofList erased.declarations) finalState) := by + apply lowerAllAction_semanticForwardSimulation_of_targetProgress_sealed + henv hlower' htarget hrepresented hcontracts hexternValue + intro _ _ _ + exact hfixedProgress + intro legacyFuel legacyValue hlegacy + exact lowerAllIndexedFullyAddressed_exact_after_addressedErasure herase + beforeOracle + (IxIR0.Readdress.Oracle.readdress erased.addressMap beforeOracle) + (IxIR0.Readdress.Oracle.readdress_compatible hreaddressable) + hlower haddressed targetOracle hrawSimulation hlegacy + +end Ix.Compiler.IxIR1.LowerSim diff --git a/Ix/Compiler/IxIR1/LowerMutualAddressedSim.lean b/Ix/Compiler/IxIR1/LowerMutualAddressedSim.lean new file mode 100644 index 000000000..5de478b72 --- /dev/null +++ b/Ix/Compiler/IxIR1/LowerMutualAddressedSim.lean @@ -0,0 +1,271 @@ +import Ix.Compiler.EraseAddressedSim +import Ix.Compiler.IxIR1.LowerAddressedSim +import Ix.Compiler.IxIR1.LowerFullyAddressedSim + +/-! +# Composing IxIR₀ mutual-block and IxIR₁ generated-code addressing + +The production pipeline now crosses two independent address maps: + +1. cycle-safe IxIR₀ mutual blocks replace legacy member keys and map every + address retained in source values; and +2. IxIR₁ lowering preserves those source-backed keys while content-addressing + generated functions and mapping identities retained in the target heap. + +This module composes the two existing evaluator transports. It deliberately +keeps the maps separate: their domains and runtime actions differ, and +collapsing them into an untyped provenance list would obscure which value or +heap layer each map acts on. +-/ + +namespace Ix.Compiler.IxIR1.LowerSim + +open Ix.Compiler.Ixon (Address Constant Owned) +open Ix.Compiler.IxIR1.Lower + +/-- A final target heap realizes the IxIR₀ address image of a legacy source +value, modulo the independent IxIR₁ generated-declaration address image. -/ +def MutualAddressedValueGraph + (sourceRename targetRename : Address → Address) + (funRel : Sim.FunctionRel) (store : Store) + (legacyValue : IxIR0.Value) (targetValue : RVal) : Prop := + AddressedValueGraph targetRename funRel store + (IxIR0.Readdress.Value.mapAddresses sourceRename legacyValue) + targetValue + +/-- Forward simulation spanning both production address maps. -/ +def MutualAddressedSemanticForwardSimulation + (legacyCtx : IxIR0.Ctx) (targetCtx : Ctx) + (legacyMain : IxIR0.Expr) (targetMain : Code) + (sourceRename targetRename : Address → Address) + (funRel : Sim.FunctionRel) : Prop := + ∀ {sourceFuel sourceValue}, + IxIR0.eval legacyCtx sourceFuel [] legacyMain = .ok sourceValue → + ∃ targetFuel targetStore targetValue, + runMain targetCtx targetMain targetFuel = + .ok (targetStore, targetValue) ∧ + MutualAddressedValueGraph sourceRename targetRename funRel + targetStore sourceValue targetValue + +/-- Precompose an addressed IxIR₀→IxIR₁ simulation with the generic IxIR₀ +evaluator-renaming theorem. -/ +theorem AddressedSemanticForwardSimulation.precomposeIxIR0 + {sourceRename targetRename : Address → Address} + {legacyCtx addressedCtx : IxIR0.Ctx} {targetCtx : Ctx} + {legacyMain addressedMain : IxIR0.Expr} {targetMain : Code} + {funRel : Sim.FunctionRel} + (contexts : IxIR0.Readdress.Ctx.Renames sourceRename + legacyCtx addressedCtx) + (hmain : addressedMain = + IxIR0.MutualBlock.Concrete.Expr.mapAddresses sourceRename legacyMain) + (hsim : AddressedSemanticForwardSimulation addressedCtx targetCtx + addressedMain targetMain targetRename funRel) : + MutualAddressedSemanticForwardSimulation legacyCtx targetCtx + legacyMain targetMain sourceRename targetRename funRel := by + intro sourceFuel sourceValue hsource + have htransport := IxIR0.Readdress.eval_mapAddresses contexts + sourceFuel [] legacyMain + rw [hsource] at htransport + simp only [IxIR0.Readdress.mapResult] at htransport + rw [← hmain] at htransport + have htransport' : + IxIR0.eval addressedCtx sourceFuel [] addressedMain = + .ok (IxIR0.Readdress.Value.mapAddresses sourceRename sourceValue) := by + simpa only [IxIR0.Readdress.ValueList.mapAddresses_nil] using htransport + obtain ⟨targetFuel, targetStore, targetValue, htarget, hgraph⟩ := + hsim htransport' + exact ⟨targetFuel, targetStore, targetValue, htarget, hgraph⟩ + +/-- A successful addressed erasure supplies the concrete precomposition data +for any downstream addressed IxIR₀→IxIR₁ simulation. -/ +theorem AddressedSemanticForwardSimulation.precomposeAddressedErasure + {eraseCtx : Erase.EraseCtx} + {constants : List (Address × Constant)} {legacyMain : IxIR0.Expr} + {eraseFuel : Nat} {erased : EraseAddressed.Result} + (herase : EraseAddressed.run eraseCtx constants legacyMain eraseFuel = + .ok erased) + (beforeOracle afterOracle : IxIR0.Oracle) + (horacle : ∀ address arguments, + afterOracle + (IxIR0.MutualBlock.Renaming.apply erased.addressMap address) + (IxIR0.Readdress.ValueList.mapAddresses + (IxIR0.MutualBlock.Renaming.apply erased.addressMap) arguments) = + (beforeOracle address arguments).map + (IxIR0.Readdress.Value.mapAddresses + (IxIR0.MutualBlock.Renaming.apply erased.addressMap))) + {targetRename : Address → Address} {targetCtx : Ctx} + {targetMain : Code} {funRel : Sim.FunctionRel} + (hsim : AddressedSemanticForwardSimulation + (erased.addressed.addressedCtx afterOracle) targetCtx + erased.main targetMain targetRename funRel) : + MutualAddressedSemanticForwardSimulation + (erased.addressed.preAddressCtx erased.groups beforeOracle) + targetCtx legacyMain targetMain + (IxIR0.MutualBlock.Renaming.apply erased.addressMap) + targetRename funRel := by + have haudit := EraseAddressed.semanticAudit_of_run_eq_ok herase + have haddressed := erased.addressed_audit haudit + have hmain := erased.addressed.main_eq_mapAddresses haddressed + apply AddressedSemanticForwardSimulation.precomposeIxIR0 + (erased.addressed.renames_preAddressCtx haddressed + beforeOracle afterOracle horacle) + · simpa only [EraseAddressed.Result.main] using hmain + · exact hsim + +/-- Full production composition: a successful cycle-safe erasure, a +successful indexed lowerer/readdresser, and the existing raw lowering +simulation yield one forward simulation across both address maps. -/ +theorem lowerAllIndexedAddressed_after_addressedErasure + {eraseCtx : Erase.EraseCtx} + {constants : List (Address × Constant)} {legacyMain : IxIR0.Expr} + {eraseFuel : Nat} {erased : EraseAddressed.Result} + (herase : EraseAddressed.run eraseCtx constants legacyMain eraseFuel = + .ok erased) + (beforeOracle afterOracle : IxIR0.Oracle) + (horacle : ∀ address arguments, + afterOracle + (IxIR0.MutualBlock.Renaming.apply erased.addressMap address) + (IxIR0.Readdress.ValueList.mapAddresses + (IxIR0.MutualBlock.Renaming.apply erased.addressMap) arguments) = + (beforeOracle address arguments).map + (IxIR0.Readdress.Value.mapAddresses + (IxIR0.MutualBlock.Renaming.apply erased.addressMap))) + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Address × Decl)} {mainCode : Code} + {finalState : LowSt} {lowered : Readdress.Result} + (hlower : + (lowerAllIndexedAction erased.declarations erased.main mainWorld + compilerFuel).run {} = .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedAddressed erased.declarations erased.main mainWorld + compilerFuel = .ok lowered) + (targetOracle : Address → List RVal → Option RVal) + {funRel : Sim.FunctionRel} + (hlowering : SemanticForwardSimulation + (erased.addressed.addressedCtx afterOracle) + (lowered.preAddressCtx raw targetOracle) + erased.main mainCode funRel) : + MutualAddressedSemanticForwardSimulation + (erased.addressed.preAddressCtx erased.groups beforeOracle) + (lowered.addressedCtx targetOracle) + legacyMain lowered.main + (IxIR0.MutualBlock.Renaming.apply erased.addressMap) + (Readdress.Renaming.apply lowered.addressMap) funRel := by + have hsim : AddressedSemanticForwardSimulation + (erased.addressed.addressedCtx afterOracle) + (lowered.addressedCtx targetOracle) erased.main lowered.main + (Readdress.Renaming.apply lowered.addressMap) funRel := + lowerAllIndexedAddressed_semanticForwardSimulation + hlower haddressed targetOracle hlowering + intro sourceFuel sourceValue hsource + exact AddressedSemanticForwardSimulation.precomposeAddressedErasure + (targetRename := Readdress.Renaming.apply lowered.addressMap) + (targetCtx := lowered.addressedCtx targetOracle) + (targetMain := lowered.main) (funRel := funRel) + herase beforeOracle afterOracle horacle hsim hsource + +/-- Full production composition for the SCC-aware target boundary. The +second map is now complete: it rekeys source and generated IxIR₁ functions, +while its audited reserved set fixes constructor identities. -/ +theorem lowerAllIndexedFullyAddressed_after_addressedErasure + {eraseCtx : Erase.EraseCtx} + {constants : List (Address × Constant)} {legacyMain : IxIR0.Expr} + {eraseFuel : Nat} {erased : EraseAddressed.Result} + (herase : EraseAddressed.run eraseCtx constants legacyMain eraseFuel = + .ok erased) + (beforeOracle afterOracle : IxIR0.Oracle) + (horacle : ∀ address arguments, + afterOracle + (IxIR0.MutualBlock.Renaming.apply erased.addressMap address) + (IxIR0.Readdress.ValueList.mapAddresses + (IxIR0.MutualBlock.Renaming.apply erased.addressMap) arguments) = + (beforeOracle address arguments).map + (IxIR0.Readdress.Value.mapAddresses + (IxIR0.MutualBlock.Renaming.apply erased.addressMap))) + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Address × Decl)} {mainCode : Code} + {finalState : LowSt} {lowered : ReaddressAll.Result} + (hlower : + (lowerAllIndexedAction erased.declarations erased.main mainWorld + compilerFuel).run {} = .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedFullyAddressed erased.declarations erased.main mainWorld + compilerFuel = .ok lowered) + (targetOracle : Address → List RVal → Option RVal) + {funRel : Sim.FunctionRel} + (hlowering : SemanticForwardSimulation + (erased.addressed.addressedCtx afterOracle) + (lowered.preAddressCtx raw targetOracle) + erased.main mainCode funRel) : + MutualAddressedSemanticForwardSimulation + (erased.addressed.preAddressCtx erased.groups beforeOracle) + (lowered.addressedCtx targetOracle) + legacyMain lowered.main + (IxIR0.MutualBlock.Renaming.apply erased.addressMap) + (Readdress.Renaming.apply lowered.addressMap) funRel := by + have hsim : AddressedSemanticForwardSimulation + (erased.addressed.addressedCtx afterOracle) + (lowered.addressedCtx targetOracle) erased.main lowered.main + (Readdress.Renaming.apply lowered.addressMap) funRel := + lowerAllIndexedFullyAddressed_semanticForwardSimulation + hlower haddressed targetOracle hlowering + intro sourceFuel sourceValue hsource + exact AddressedSemanticForwardSimulation.precomposeAddressedErasure + (targetRename := Readdress.Renaming.apply lowered.addressMap) + (targetCtx := lowered.addressedCtx targetOracle) + (targetMain := lowered.main) (funRel := funRel) + herase beforeOracle afterOracle horacle hsim hsource + +/-- Alias-free production composition. The raw IxIR₁ simulation runs in +the literal lowering environment, and the final heap is related through the +certified exact-source `rebuildRename` rather than an alias-bearing adapter. -/ +theorem lowerAllIndexedFullyAddressed_exact_after_addressedErasure + {eraseCtx : Erase.EraseCtx} + {constants : List (Address × Constant)} {legacyMain : IxIR0.Expr} + {eraseFuel : Nat} {erased : EraseAddressed.Result} + (herase : EraseAddressed.run eraseCtx constants legacyMain eraseFuel = + .ok erased) + (beforeOracle afterOracle : IxIR0.Oracle) + (horacle : ∀ address arguments, + afterOracle + (IxIR0.MutualBlock.Renaming.apply erased.addressMap address) + (IxIR0.Readdress.ValueList.mapAddresses + (IxIR0.MutualBlock.Renaming.apply erased.addressMap) arguments) = + (beforeOracle address arguments).map + (IxIR0.Readdress.Value.mapAddresses + (IxIR0.MutualBlock.Renaming.apply erased.addressMap))) + {mainWorld : Owned} {compilerFuel : Nat} + {raw : List (Address × Decl)} {mainCode : Code} + {finalState : LowSt} {lowered : ReaddressAll.Result} + (hlower : + (lowerAllIndexedAction erased.declarations erased.main mainWorld + compilerFuel).run {} = .ok (raw, mainCode) finalState) + (haddressed : + lowerAllIndexedFullyAddressed erased.declarations erased.main mainWorld + compilerFuel = .ok lowered) + (targetOracle : Address → List RVal → Option RVal) + {funRel : Sim.FunctionRel} + (hlowering : SemanticForwardSimulation + (erased.addressed.addressedCtx afterOracle) + (lowered.rebuildSourceCtx raw targetOracle) + erased.main mainCode funRel) : + MutualAddressedSemanticForwardSimulation + (erased.addressed.preAddressCtx erased.groups beforeOracle) + (lowered.addressedCtx targetOracle) + legacyMain lowered.main + (IxIR0.MutualBlock.Renaming.apply erased.addressMap) + (lowered.rebuildRename raw) funRel := by + have hsim : AddressedSemanticForwardSimulation + (erased.addressed.addressedCtx afterOracle) + (lowered.addressedCtx targetOracle) erased.main lowered.main + (lowered.rebuildRename raw) funRel := + lowerAllIndexedFullyAddressed_semanticForwardSimulation_exact + hlower haddressed targetOracle hlowering + intro sourceFuel sourceValue hsource + exact AddressedSemanticForwardSimulation.precomposeAddressedErasure + (targetRename := lowered.rebuildRename raw) + (targetCtx := lowered.addressedCtx targetOracle) + (targetMain := lowered.main) (funRel := funRel) + herase beforeOracle afterOracle horacle hsim hsource + +end Ix.Compiler.IxIR1.LowerSim diff --git a/Ix/Compiler/IxIR1/LowerProgress.lean b/Ix/Compiler/IxIR1/LowerProgress.lean new file mode 100644 index 000000000..dae61597b --- /dev/null +++ b/Ix/Compiler/IxIR1/LowerProgress.lean @@ -0,0 +1,20940 @@ +import Ix.Compiler.IxIR1.LowerStateSim +import Ix.Compiler.IxIR1.Progress +import Ix.Compiler.IxIR0.ProjectionSafe +import Ix.Compiler.Sim +import Ix.Compiler.EraseValidator + +/-! +# Total-correctness interface for the IxIR₀ → IxIR₁ lowering + +`LowerSim` deliberately phrases ownership and value correspondence as +partial correctness. This companion interface records both successful +target-run existence and the weaker non-memory settlement needed by raw +lowering branches that may legitimately stop with ordinary stuckness. Its +continuation forms match `EmitSound`, while existential fuel is composed with +the target evaluator monotonicity theorems. +-/ + +namespace Ix.Compiler.IxIR1.LowerSim + +open Ix.Compiler.Ixon (Owned Uses) +open Ix.Compiler.IxIR1.Lower +open Ix.Compiler.IxIR1.Sim + +private theorem bindOk {error alpha beta : Type} (value : alpha) + (next : alpha → Except error beta) : + (Except.ok value >>= next) = next value := rfl + +private theorem bindErr {error alpha beta : Type} (err : error) + (next : alpha → Except error beta) : + ((Except.error err : Except error alpha) >>= next) = .error err := rfl + +private theorem estateBindRun {error state alpha beta : Type} + (action : EStateM error state alpha) + (next : alpha → EStateM error state beta) (initial : state) : + (action >>= next).run initial = + match action.run initial with + | .ok value nextState => (next value).run nextState + | .error err nextState => .error err nextState := rfl + +private theorem permExtractRoot (root : Root) + (before after rest : List Root) : + ((before ++ root :: after) ++ rest).Perm + (root :: (before ++ after) ++ rest) := by + induction before with + | nil => rfl + | cons head before ih => + simp only [List.cons_append] + exact (ih.cons head).trans (List.Perm.swap root head _) + +/-- Successful execution exists from every state satisfying `pre`. -/ +def CodeProgress (ctx : Ctx) (cur : FnDef) (pre : StatePred) + (code : Code) : Prop := + ∀ {store env}, pre store env → + ∃ fuel store' value, + runCode ctx fuel cur store env code = .ok (store', value) + +/-- One operation has some successful fuel and establishes `post` after +its result is pushed into the runtime environment. -/ +def OpProgress (ctx : Ctx) (cur : FnDef) (op : Op) + (pre post : StatePred) : Prop := + ∀ {store env}, pre store env → + ∃ fuel store' value, + runOp ctx fuel cur store env op = .ok (store', value) ∧ + post store' (value :: env) + +/-- A code fragment reaches success or ordinary stuckness at some finite +fuel, without pretending that a terminal stuck branch is successful. Both +memory faults and closed-world lookup failures are excluded. -/ +def CodeSettlement (ctx : Ctx) (cur : FnDef) (pre : StatePred) + (code : Code) : Prop := + ∀ {store env}, pre store env → + ∃ fuel, SettlesWithoutMemory (runCode ctx fuel cur store env code) + +/-- Continuation transformer for non-memory settlement. -/ +def EmitSettlement (ctx : Ctx) (cur : FnDef) (emit : Emit) + (pre mid : StatePred) : Prop := + ∀ code, CodeSettlement ctx cur mid code → + CodeSettlement ctx cur pre (emit code) + +/-- An emitted prefix itself reaches a non-memory terminal outcome, without +requiring anything of the continuation placed after it. -/ +def EmitStop (ctx : Ctx) (cur : FnDef) (emit : Emit) + (pre : StatePred) : Prop := + ∀ code, CodeSettlement ctx cur pre (emit code) + +theorem EmitStop.settlement {ctx : Ctx} {cur : FnDef} {emit : Emit} + {pre mid : StatePred} (hstop : EmitStop ctx cur emit pre) : + EmitSettlement ctx cur emit pre mid := by + intro code hcode + exact hstop code + +theorem EmitStop.postcompose {ctx : Ctx} {cur : FnDef} + {emit suffix : Emit} {pre : StatePred} + (hstop : EmitStop ctx cur emit pre) : + EmitStop ctx cur (emit ∘ suffix) pre := by + intro code + exact hstop (suffix code) + +theorem EmitSettlement.thenStop {ctx : Ctx} {cur : FnDef} + {emit stop : Emit} {pre mid : StatePred} + (hprefix : EmitSettlement ctx cur emit pre mid) + (hstop : EmitStop ctx cur stop mid) : + EmitStop ctx cur (emit ∘ stop) pre := by + intro code + exact hprefix (stop code) (hstop code) + +/-- Successful continuation progress for an emitted prefix, paired with the +weaker settlement transformer needed when a later continuation stops with an +ordinary non-memory error. Keeping both laws in one package makes every +successful lowering combinator automatically usable by the memory-safety +cluster. -/ +structure EmitProgress (ctx : Ctx) (cur : FnDef) (emit : Emit) + (pre mid : StatePred) : Prop where + progresses : ∀ code, CodeProgress ctx cur mid code → + CodeProgress ctx cur pre (emit code) + settles : EmitSettlement ctx cur emit pre mid + +instance {ctx : Ctx} {cur : FnDef} {emit : Emit} + {pre mid : StatePred} : + CoeFun (EmitProgress ctx cur emit pre mid) + (fun _ => ∀ code, CodeProgress ctx cur mid code → + CodeProgress ctx cur pre (emit code)) where + coe h := h.progresses + +theorem CodeProgress.settlement {ctx : Ctx} {cur : FnDef} + {pre : StatePred} {code : Code} + (hprogress : CodeProgress ctx cur pre code) : + CodeSettlement ctx cur pre code := by + intro store env hpre + obtain ⟨fuel, store', value, hrun⟩ := hprogress hpre + exact ⟨fuel, .success (store', value) hrun⟩ + +theorem settlesWithoutMemory_runCode_mono + {ctx : Ctx} {cur : FnDef} {store : Store} {env : List RVal} + {code : Code} {fuel larger : Nat} + (hsettles : SettlesWithoutMemory + (runCode ctx fuel cur store env code)) + (hle : fuel ≤ larger) : + SettlesWithoutMemory (runCode ctx larger cur store env code) := by + cases hsettles with + | success value hrun => + exact .success value + (Ix.Compiler.IxIR1.runCode_mono hle hrun) + | stuck message hrun => + exact .stuck message + (Ix.Compiler.IxIR1.runCode_error_mono hle (by simp) hrun) + +theorem EmitSettlement.id {ctx : Ctx} {cur : FnDef} + {pre : StatePred} : + EmitSettlement ctx cur (_root_.id : Emit) pre pre := by + intro code hcode + exact hcode + +theorem EmitSettlement.strengthen {ctx : Ctx} {cur : FnDef} + {pre mid : StatePred} + (himp : ∀ {store env}, pre store env → mid store env) : + EmitSettlement ctx cur (_root_.id : Emit) pre mid := by + intro code hcode store env hpre + exact hcode (himp hpre) + +theorem EmitSettlement.comp {ctx : Ctx} {cur : FnDef} + {emit₁ emit₂ : Emit} {pre mid post : StatePred} + (h₁ : EmitSettlement ctx cur emit₁ pre mid) + (h₂ : EmitSettlement ctx cur emit₂ mid post) : + EmitSettlement ctx cur (emit₁ ∘ emit₂) pre post := by + intro code hcode + exact h₁ (emit₂ code) (h₂ code hcode) + +theorem EmitSettlement.of_pointwise {ctx : Ctx} {cur : FnDef} + {emit : Emit} {pre post : StatePred} + (hpoint : ∀ {store env}, pre store env → + ∃ localPre : StatePred, localPre store env ∧ + EmitSettlement ctx cur emit localPre post) : + EmitSettlement ctx cur emit pre post := by + intro code hcode store env hpre + obtain ⟨localPre, hlocal, hsettles⟩ := hpoint hpre + exact hsettles code hcode hlocal + +/-- A successfully progressing operation also preserves non-memory +settlement of an arbitrary continuation. -/ +theorem OpProgress.emitSettlement {ctx : Ctx} {cur : FnDef} {op : Op} + {pre post : StatePred} (hop : OpProgress ctx cur op pre post) : + EmitSettlement ctx cur (emitOp op) pre post := by + intro code hcode store env hpre + obtain ⟨opFuel, middleStore, opValue, hopRun, hpost⟩ := hop hpre + obtain ⟨codeFuel, hcodeSettles⟩ := hcode hpost + let common := max opFuel codeFuel + have hopRun' : runOp ctx common cur store env op = + .ok (middleStore, opValue) := + runOp_mono (Nat.le_max_left _ _) hopRun + have hcodeSettles' : SettlesWithoutMemory + (runCode ctx common cur middleStore (opValue :: env) code) := + settlesWithoutMemory_runCode_mono hcodeSettles + (Nat.le_max_right _ _) + refine ⟨common + 1, ?_⟩ + cases hcodeSettles' with + | success value hrun => + apply SettlesWithoutMemory.success value + rw [runCode.eq_def] + dsimp only [emitOp] + rw [hopRun', bindOk] + exact hrun + | stuck message hrun => + apply SettlesWithoutMemory.stuck message + rw [runCode.eq_def] + dsimp only [emitOp] + rw [hopRun', bindOk] + exact hrun + +theorem EmitProgress.id {ctx : Ctx} {cur : FnDef} {pre : StatePred} : + EmitProgress ctx cur (_root_.id : Emit) pre pre := by + exact + { progresses := by + intro code hcode + exact hcode + settles := EmitSettlement.id } + +theorem EmitProgress.strengthen {ctx : Ctx} {cur : FnDef} + {pre mid : StatePred} + (himp : ∀ {store env}, pre store env → mid store env) : + EmitProgress ctx cur (_root_.id : Emit) pre mid := by + exact + { progresses := by + intro code hcode store env hpre + exact hcode (himp hpre) + settles := EmitSettlement.strengthen himp } + +/-- Build a uniform progress/settlement transformer from a proof selected at +each inhabited input state. This is useful when a semantic witness stored in +the precondition chooses a callable contract, while the emitted code and +public predicates remain fixed. -/ +theorem EmitProgress.of_pointwise {ctx : Ctx} {cur : FnDef} + {emit : Emit} {pre post : StatePred} + (hpoint : ∀ {store env}, pre store env → + ∃ localPre : StatePred, localPre store env ∧ + EmitProgress ctx cur emit localPre post) : + EmitProgress ctx cur emit pre post := by + exact + { progresses := by + intro code hcode store env hpre + obtain ⟨localPre, hlocal, hprogress⟩ := hpoint hpre + exact hprogress code hcode hlocal + settles := by + intro code hcode store env hpre + obtain ⟨localPre, hlocal, hprogress⟩ := hpoint hpre + exact hprogress.settles code hcode hlocal } + +theorem EmitProgress.comp {ctx : Ctx} {cur : FnDef} + {emit₁ emit₂ : Emit} {pre mid post : StatePred} + (h₁ : EmitProgress ctx cur emit₁ pre mid) + (h₂ : EmitProgress ctx cur emit₂ mid post) : + EmitProgress ctx cur (emit₁ ∘ emit₂) pre post := by + exact + { progresses := by + intro code hcode + exact h₁ (emit₂ code) (h₂ code hcode) + settles := EmitSettlement.comp h₁.settles h₂.settles } + +/-- One successful operation and one successful continuation can be raised +to a common predecessor fuel and joined by `Code.letOp`. -/ +theorem OpProgress.emit {ctx : Ctx} {cur : FnDef} {op : Op} + {pre post : StatePred} (hop : OpProgress ctx cur op pre post) : + EmitProgress ctx cur (emitOp op) pre post := by + refine + { progresses := ?_ + settles := hop.emitSettlement } + intro code hcode store env hpre + obtain ⟨opFuel, middleStore, opValue, hopRun, hpost⟩ := hop hpre + obtain ⟨codeFuel, finalStore, finalValue, hcodeRun⟩ := hcode hpost + let common := max opFuel codeFuel + have hopRun' : runOp ctx common cur store env op = + .ok (middleStore, opValue) := + runOp_mono (Nat.le_max_left _ _) hopRun + have hcodeRun' : runCode ctx common cur middleStore (opValue :: env) + code = .ok (finalStore, finalValue) := + runCode_mono (Nat.le_max_right _ _) hcodeRun + refine ⟨common + 1, finalStore, finalValue, ?_⟩ + rw [runCode.eq_def] + dsimp only [emitOp] + rw [hopRun', bindOk] + exact hcodeRun' + +/-- A resolved return atom closes progress immediately. -/ +theorem codeProgress_ret {ctx : Ctx} {cur : FnDef} + {pre : StatePred} {atom : Atom} + (hresolve : ∀ {store env}, pre store env → + ∃ value, resolveAtom env atom = .ok value) : + CodeProgress ctx cur pre (.ret atom) := by + intro store env hpre + obtain ⟨value, hvalue⟩ := hresolve hpre + refine ⟨1, store, value, ?_⟩ + rw [runCode.eq_def] + dsimp only + rw [hvalue, bindOk] + +/-! ## Progress refinements of lowering results -/ + +/-- A semantic lowering result together with successful execution of its +emitted prefix from every graph-owned input state. -/ +structure LowerResultValueProgress (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (ctx : Ctx) (cur : FnDef) + (input output : VEnv) + (sourceInput sourceOutput : List IxIR0.Value) + (sourceValue : IxIR0.Value) (world : Owned) + (emit : Emit) (av : AVal) : Prop + extends LowerResultValueSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue world emit av where + graphProgress : ∀ sourceRest rest slots, + EmitProgress ctx cur emit + (GraphOwnsVEnvProtected funRel recSelfRel input + sourceInput sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output + sourceOutput sourceValue world av sourceRest rest slots) + +/-- Progress refinement for a completed left-to-right argument vector. -/ +structure LowerArgsValueProgress (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (ctx : Ctx) (cur : FnDef) + (input output : VEnv) + (sourceInput sourceOutput sourceValues : List IxIR0.Value) + (worlds : List Owned) (emit : Emit) (avs : List AVal) : Prop + extends LowerArgsValueSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValues worlds emit avs where + graphProgress : ∀ sourceRest rest slots, + EmitProgress ctx cur emit + (GraphOwnsVEnvProtected funRel recSelfRel input + sourceInput sourceRest rest slots) + (GraphOwnsArgsResultProtected funRel recSelfRel output + sourceOutput sourceValues worlds avs sourceRest rest slots) + +/-- Progress refinement for a borrowing-position lowering result. -/ +structure LowerBorrowValueProgress (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (ctx : Ctx) (cur : FnDef) + (input output : VEnv) + (sourceInput sourceOutput : List IxIR0.Value) + (sourceValue : IxIR0.Value) (emit : Emit) (av : AVal) + (release : Bool) : Prop + extends LowerBorrowValueSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue emit av release where + graphProgress : ∀ sourceRest rest slots, + EmitProgress ctx cur emit + (GraphOwnsVEnvProtected funRel recSelfRel input + sourceInput sourceRest rest slots) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput sourceValue av release sourceRest rest slots) + +/-- Semantic lowering plus the weaker non-memory settlement transformer. +This is the uniform result used by the memory-safety induction: successful +branches preserve their full graph postcondition, while an ordinary-stuck +branch may terminate before reaching it. -/ +structure LowerResultValueSettlement (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (ctx : Ctx) (cur : FnDef) + (input output : VEnv) + (sourceInput sourceOutput : List IxIR0.Value) + (sourceValue : IxIR0.Value) (world : Owned) + (emit : Emit) (av : AVal) : Prop + extends LowerResultValueSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue world emit av where + graphSettlement : ∀ sourceRest rest slots, + EmitSettlement ctx cur emit + (GraphOwnsVEnvProtected funRel recSelfRel input + sourceInput sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output + sourceOutput sourceValue world av sourceRest rest slots) + +structure LowerArgsValueSettlement (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (ctx : Ctx) (cur : FnDef) + (input output : VEnv) + (sourceInput sourceOutput sourceValues : List IxIR0.Value) + (worlds : List Owned) (emit : Emit) (avs : List AVal) : Prop + extends LowerArgsValueSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValues worlds emit avs where + graphSettlement : ∀ sourceRest rest slots, + EmitSettlement ctx cur emit + (GraphOwnsVEnvProtected funRel recSelfRel input + sourceInput sourceRest rest slots) + (GraphOwnsArgsResultProtected funRel recSelfRel output + sourceOutput sourceValues worlds avs sourceRest rest slots) + +structure LowerBorrowValueSettlement (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (ctx : Ctx) (cur : FnDef) + (input output : VEnv) + (sourceInput sourceOutput : List IxIR0.Value) + (sourceValue : IxIR0.Value) (emit : Emit) (av : AVal) + (release : Bool) : Prop + extends LowerBorrowValueSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue emit av release where + graphSettlement : ∀ sourceRest rest slots, + EmitSettlement ctx cur emit + (GraphOwnsVEnvProtected funRel recSelfRel input + sourceInput sourceRest rest slots) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput sourceValue av release sourceRest rest slots) + +theorem LowerResultValueProgress.settlement + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {world : Owned} + {emit : Emit} {av : AVal} + (hprogress : LowerResultValueProgress funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceValue world emit av) : + LowerResultValueSettlement funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceValue world emit av := + { toLowerResultValueSound := hprogress.toLowerResultValueSound + graphSettlement := fun sourceRest rest slots => + (hprogress.graphProgress sourceRest rest slots).settles } + +theorem LowerArgsValueProgress.settlement + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput sourceValues : List IxIR0.Value} + {worlds : List Owned} {emit : Emit} {avs : List AVal} + (hprogress : LowerArgsValueProgress funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceValues worlds emit avs) : + LowerArgsValueSettlement funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceValues worlds emit avs := + { toLowerArgsValueSound := hprogress.toLowerArgsValueSound + graphSettlement := fun sourceRest rest slots => + (hprogress.graphProgress sourceRest rest slots).settles } + +theorem LowerBorrowValueProgress.settlement + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {av : AVal} + {release : Bool} + (hprogress : LowerBorrowValueProgress funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceValue emit av release) : + LowerBorrowValueSettlement funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceValue emit av release := + { toLowerBorrowValueSound := hprogress.toLowerBorrowValueSound + graphSettlement := fun sourceRest rest slots => + (hprogress.graphProgress sourceRest rest slots).settles } + +/-- If the source and logical compiler environments have different lengths, +the graph-owned input state is uninhabited. Any ownership-sound emitter is +therefore also a (vacuous) value-progress emitter for that malformed input. -/ +theorem LowerResultSound.valueProgress_of_sourceLength_ne + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {world : Owned} + {emit : Emit} {av : AVal} + (hsound : LowerResultSound ctx cur input output world emit av) + (hlength : sourceInput.length ≠ input.entries.length) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue world emit av := by + refine + { toLowerResultValueSound := + hsound.valueSound_of_sourceLength_ne hlength + graphProgress := ?_ } + intro sourceRest rest slots + apply EmitProgress.of_pointwise + intro store env hpre + obtain ⟨⟨roots, hgraph, hrestGraph, hown⟩, hslots⟩ := hpre + exact (hlength hgraph.entries.source_length).elim + +/-- A residual lambda prefix is always closure-shaped, never erased. -/ +theorem LambdaPrefix.value_ne_erased + {sourceEnv : List IxIR0.Value} {expr : IxIR0.Expr} + {arguments : List IxIR0.Value} {value : IxIR0.Value} + (hprefix : LambdaPrefix sourceEnv expr arguments value) : + value ≠ .erased := by + apply LambdaPrefix.traverse + (Result := fun _ _ _ currentValue => currentValue ≠ .erased) + (h := hprefix) + · intro currentEnv uses body + simp + · intro currentEnv uses body argument currentArguments currentValue + hinner ih + exact ih + +/-- A residual lambda prefix still denotes a closure. -/ +theorem LambdaPrefix.value_is_closure + {sourceEnv : List IxIR0.Value} {expr : IxIR0.Expr} + {arguments : List IxIR0.Value} {value : IxIR0.Value} + (hprefix : LambdaPrefix sourceEnv expr arguments value) : + ∃ uses closureEnv body, + value = .clos uses closureEnv body := by + apply LambdaPrefix.traverse + (Result := fun _ _ _ currentValue => + ∃ uses closureEnv body, + currentValue = .clos uses closureEnv body) + (h := hprefix) + · intro currentEnv uses body + exact ⟨uses, currentEnv, body, rfl⟩ + · intro currentEnv uses body argument currentArguments currentValue + hinner ih + exact ih + +/-- A positive-arity source definition reference denotes the initial +closure in its leading lambda prefix. -/ +theorem SourceRefValue.lambdaPrefix_nil + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {address : Ixon.Address} {result : Owned} {body : IxIR0.Expr} + {sourceFunction : IxIR0.Value} + (henv : sourceCtx.env = src) + (hsrc : src address = some (.defn result body)) + (hpositive : 0 < lamArity body) + (href : SourceRefValue sourceCtx address sourceFunction) : + LambdaPrefix [] body [] sourceFunction := by + cases body with + | lam uses body => + obtain ⟨fuel, href⟩ := href + cases fuel with + | zero => simp [IxIR0.eval] at href + | succ fuel => + cases fuel with + | zero => simp [IxIR0.eval, henv, hsrc] at href + | succ fuel => + have hvalue : sourceFunction = .clos uses [] body := by + simpa [IxIR0.eval, henv, hsrc] using href.symm + subst sourceFunction + exact .nil + | var => simp [lamArity] at hpositive + | ref => simp [lamArity] at hpositive + | app => simp [lamArity] at hpositive + | letE => simp [lamArity] at hpositive + | proj => simp [lamArity] at hpositive + | lit => simp [lamArity] at hpositive + | erased => simp [lamArity] at hpositive + +/-- A positive-arity constructor reference denotes its empty source pap. -/ +theorem SourceRefValue.ctorPap + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {address : Ixon.Address} {tag arity : Nat} + {sourceFunction : IxIR0.Value} + (henv : sourceCtx.env = src) + (hsrc : src address = some (.ctor tag arity)) + (hpositive : 0 < arity) + (href : SourceRefValue sourceCtx address sourceFunction) : + sourceFunction = .pap (.ctor address tag arity) [] := by + obtain ⟨fuel, href⟩ := href + cases fuel with + | zero => simp [IxIR0.eval] at href + | succ fuel => + cases fuel with + | zero => simp [IxIR0.eval, henv, hsrc, IxIR0.saturate] at href + | succ fuel => + have hne : 0 ≠ arity := Nat.ne_of_lt hpositive + simpa [IxIR0.eval, henv, hsrc, IxIR0.saturate, + IxIR0.Head.arity, hne] using href.symm + +/-- A positive-arity extern reference denotes its empty source pap. -/ +theorem SourceRefValue.externPap + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {address : Ixon.Address} {arity : Nat} + {sourceFunction : IxIR0.Value} + (henv : sourceCtx.env = src) + (hsrc : src address = some (.extern arity)) + (hpositive : 0 < arity) + (href : SourceRefValue sourceCtx address sourceFunction) : + sourceFunction = .pap (.ext address arity) [] := by + obtain ⟨fuel, href⟩ := href + cases fuel with + | zero => simp [IxIR0.eval] at href + | succ fuel => + cases fuel with + | zero => simp [IxIR0.eval, henv, hsrc, IxIR0.saturate] at href + | succ fuel => + have hne : 0 ≠ arity := Nat.ne_of_lt hpositive + simpa [IxIR0.eval, henv, hsrc, IxIR0.saturate, + IxIR0.Head.arity, hne] using href.symm + +/-- The canonical whole-pass function relation cannot disguise the erased +source scalar as a target pap. Every related value is a residual lambda or +a strictly under-filled source pap of the same provenance. -/ +theorem CompilerFunctionRel.value_ne_erased + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {state : LowSt} + {value : IxIR0.Value} {address : Ixon.Address} {arity : Nat} + {captures : List IxIR0.Value} + (henv : sourceCtx.env = src) + (hrel : CompilerFunctionRel sourceCtx src state value address arity + captures) : + value ≠ .erased := by + intro hvalue + subst value + cases hrel with + | source hsrc heligible harity href happlies hunder => + rename_i sourceFunction source + cases source with + | defn result body => + have hpositive : 0 < lamArity body := by + simp only [sourceDeclArity] at harity + omega + have hinitial := href.lambdaPrefix_nil henv hsrc hpositive + have hunderBody : ([] ++ captures).length < lamArity body := by + simp only [sourceDeclArity] at harity + simpa [harity] using hunder + have hprefix := hinitial.append_of_applies happlies hunderBody + exact hprefix.value_ne_erased rfl + | ctor tag sourceArity => + simp [SourcePapEligible] at heligible + | recursor numArgs natLit rules => + have hsourceLookup : sourceCtx.env address = + some (.recursor numArgs natLit rules) := by + simpa [henv] using hsrc + have hfunction := href.recursorValue hsourceLookup + subst sourceFunction + have hcanonical : SourceApplies sourceCtx + (.pap (.rec_ address (numArgs + 1)) []) captures + (.pap (.rec_ address (numArgs + 1)) captures) := by + apply sourcePap_underfills + simp only [sourceDeclArity] at harity + simpa [IxIR0.Head.arity, harity] using hunder + have himpossible := happlies.deterministic hcanonical + cases himpossible + | extern sourceArity => + have hpositive : 0 < sourceArity := by + simp only [sourceDeclArity] at harity + omega + have hfunction := href.externPap henv hsrc hpositive + subst sourceFunction + have hcanonical : SourceApplies sourceCtx + (.pap (.ext address sourceArity) []) captures + (.pap (.ext address sourceArity) captures) := by + apply sourcePap_underfills + simp only [sourceDeclArity] at harity + simpa [IxIR0.Head.arity, harity] using hunder + have himpossible := happlies.deterministic hcanonical + cases himpossible + | wrapper hmember hsrc href happlies hunder => + rename_i sourceFunction memo + have hpositive : 0 < memo.arity := by omega + have hfunction := href.ctorPap henv hsrc hpositive + subst sourceFunction + have hcanonical : SourceApplies sourceCtx + (.pap (.ctor memo.source memo.tag memo.arity) []) captures + (.pap (.ctor memo.source memo.tag memo.arity) captures) := by + apply sourcePap_underfills + simpa [IxIR0.Head.arity] using hunder + have himpossible := happlies.deterministic hcanonical + cases himpossible + | lifted hlifted => + obtain ⟨sourceEnv, expr, selected, supplied, hlift, hselected, + hcaptures, harity, hprefix⟩ := hlifted + exact hprefix.value_ne_erased rfl + +/-- Every value represented by the canonical target-pap relation is +function-shaped on the source side. This rules out the otherwise permitted +abstract `ValueGraph.function` realization of constructor data. -/ +theorem CompilerFunctionRel.value_is_function + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {state : LowSt} + {value : IxIR0.Value} {address : Ixon.Address} {arity : Nat} + {captures : List IxIR0.Value} + (henv : sourceCtx.env = src) + (hrel : CompilerFunctionRel sourceCtx src state value address arity + captures) : + (∃ uses closureEnv body, + value = .clos uses closureEnv body) ∨ + (∃ head arguments, value = .pap head arguments) := by + cases hrel with + | source hsrc heligible harity href happlies hunder => + rename_i sourceFunction source + cases source with + | defn result body => + have hpositive : 0 < lamArity body := by + simp only [sourceDeclArity] at harity + omega + have hinitial := href.lambdaPrefix_nil henv hsrc hpositive + have hunderBody : ([] ++ captures).length < lamArity body := by + simp only [sourceDeclArity] at harity + simpa [harity] using hunder + exact Or.inl + (hinitial.append_of_applies happlies hunderBody).value_is_closure + | ctor tag sourceArity => + simp [SourcePapEligible] at heligible + | recursor numArgs natLit rules => + have hsourceLookup : sourceCtx.env address = + some (.recursor numArgs natLit rules) := by + simpa [henv] using hsrc + have hfunction := href.recursorValue hsourceLookup + subst sourceFunction + have hcanonical : SourceApplies sourceCtx + (.pap (.rec_ address (numArgs + 1)) []) captures + (.pap (.rec_ address (numArgs + 1)) captures) := by + apply sourcePap_underfills + simp only [sourceDeclArity] at harity + simpa [IxIR0.Head.arity, harity] using hunder + have hvalue := happlies.deterministic hcanonical + subst value + exact Or.inr ⟨_, _, rfl⟩ + | extern sourceArity => + have hpositive : 0 < sourceArity := by + simp only [sourceDeclArity] at harity + omega + have hfunction := href.externPap henv hsrc hpositive + subst sourceFunction + have hcanonical : SourceApplies sourceCtx + (.pap (.ext address sourceArity) []) captures + (.pap (.ext address sourceArity) captures) := by + apply sourcePap_underfills + simp only [sourceDeclArity] at harity + simpa [IxIR0.Head.arity, harity] using hunder + have hvalue := happlies.deterministic hcanonical + subst value + exact Or.inr ⟨_, _, rfl⟩ + | wrapper hmember hsrc href happlies hunder => + rename_i sourceFunction memo + have hpositive : 0 < memo.arity := by omega + have hfunction := href.ctorPap henv hsrc hpositive + subst sourceFunction + have hcanonical : SourceApplies sourceCtx + (.pap (.ctor memo.source memo.tag memo.arity) []) captures + (.pap (.ctor memo.source memo.tag memo.arity) captures) := by + apply sourcePap_underfills + simpa [IxIR0.Head.arity] using hunder + have hvalue := happlies.deterministic hcanonical + subst value + exact Or.inr ⟨_, _, rfl⟩ + | lifted hlifted => + obtain ⟨sourceEnv, expr, selected, supplied, hlift, hselected, + hcaptures, harity, hprefix⟩ := hlifted + exact Or.inl hprefix.value_is_closure + +theorem CompilerFunctionRel.value_ne_ctor + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {state : LowSt} + {value : IxIR0.Value} {address : Ixon.Address} {arity : Nat} + {captures : List IxIR0.Value} {ctorAddress : Ixon.Address} + {tag : Nat} {fields : List IxIR0.Value} + (henv : sourceCtx.env = src) + (hrel : CompilerFunctionRel sourceCtx src state value address arity + captures) : + value ≠ .ctor ctorAddress tag fields := by + obtain ⟨uses, closureEnv, body, hvalue⟩ | + ⟨head, arguments, hvalue⟩ := hrel.value_is_function henv + · simp [hvalue] + · simp [hvalue] + +/-- Reclassify a progressing shared slot result as a pending borrow owner. -/ +theorem LowerResultValueProgress.asBorrowSlot + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {abs : Nat} + (hsound : LowerResultValueProgress funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceValue .shared emit + (.slotA abs)) : + LowerBorrowValueProgress funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue emit (.slotA abs) true := by + refine + { toLowerBorrowValueSound := + hsound.toLowerResultValueSound.asBorrowSlot + graphProgress := ?_ } + intro sourceRest rest slots + have hconvert : EmitProgress ctx cur (_root_.id : Emit) + (GraphOwnsResultProtected funRel recSelfRel output sourceOutput + sourceValue .shared (.slotA abs) sourceRest rest slots) + (GraphOwnsBorrowResultProtected funRel recSelfRel output sourceOutput + sourceValue (.slotA abs) true sourceRest rest slots) := by + apply EmitProgress.strengthen + intro store env hpre + obtain ⟨⟨roots, value, houtput, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + have hworld : HasWorld store .shared value := + hown.roots_world ⟨.shared, value⟩ (by simp) + refine ⟨roots, value, houtput, hav, hworld, hvalueGraph, + hrestGraph, ?_, hslots⟩ + simpa [borrowResultRoots] using hown + have hcomposed := EmitProgress.comp + (hsound.graphProgress sourceRest rest slots) hconvert + simpa [Function.comp_def] using hcomposed + +/-- Scalar results are ownership-inert and can progress as non-owning +borrows after discarding their distinguished logical root. -/ +theorem LowerResultValueProgress.asBorrowConst + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {atom : Atom} + (hsound : LowerResultValueProgress funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceValue .shared emit + (.constA atom)) : + LowerBorrowValueProgress funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue emit (.constA atom) false := by + refine + { toLowerBorrowValueSound := + hsound.toLowerResultValueSound.asBorrowConst + graphProgress := ?_ } + intro sourceRest rest slots + have hconvert : EmitProgress ctx cur (_root_.id : Emit) + (GraphOwnsResultProtected funRel recSelfRel output sourceOutput + sourceValue .shared (.constA atom) sourceRest rest slots) + (GraphOwnsBorrowResultProtected funRel recSelfRel output sourceOutput + sourceValue (.constA atom) false sourceRest rest slots) := by + apply EmitProgress.strengthen + intro store env hpre + obtain ⟨⟨roots, value, houtput, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + have hworld : HasWorld store .shared value := + hown.roots_world ⟨.shared, value⟩ (by simp) + refine ⟨roots, value, houtput, hav, hworld, hvalueGraph, + hrestGraph, ?_, hslots⟩ + simpa [borrowResultRoots] using + hown.dropNoLocation + (hsound.stable.const_noLocation hav) + have hcomposed := EmitProgress.comp + (hsound.graphProgress sourceRest rest slots) hconvert + simpa [Function.comp_def] using hcomposed + +theorem LowerResultValueSettlement.asBorrowSlot + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {abs : Nat} + (hsettles : LowerResultValueSettlement funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceValue .shared emit + (.slotA abs)) : + LowerBorrowValueSettlement funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue emit (.slotA abs) true := by + refine + { toLowerBorrowValueSound := + hsettles.toLowerResultValueSound.asBorrowSlot + graphSettlement := ?_ } + intro sourceRest rest slots + have hconvert : EmitSettlement ctx cur (_root_.id : Emit) + (GraphOwnsResultProtected funRel recSelfRel output sourceOutput + sourceValue .shared (.slotA abs) sourceRest rest slots) + (GraphOwnsBorrowResultProtected funRel recSelfRel output sourceOutput + sourceValue (.slotA abs) true sourceRest rest slots) := by + apply EmitSettlement.strengthen + intro store env hpre + obtain ⟨⟨roots, value, houtput, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + have hworld : HasWorld store .shared value := + hown.roots_world ⟨.shared, value⟩ (by simp) + refine ⟨roots, value, houtput, hav, hworld, hvalueGraph, + hrestGraph, ?_, hslots⟩ + simpa [borrowResultRoots] using hown + have hcomposed := EmitSettlement.comp + (hsettles.graphSettlement sourceRest rest slots) hconvert + simpa [Function.comp_def] using hcomposed + +theorem LowerResultValueSettlement.asBorrowConst + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {atom : Atom} + (hsettles : LowerResultValueSettlement funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceValue .shared emit + (.constA atom)) : + LowerBorrowValueSettlement funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue emit (.constA atom) false := by + refine + { toLowerBorrowValueSound := + hsettles.toLowerResultValueSound.asBorrowConst + graphSettlement := ?_ } + intro sourceRest rest slots + have hconvert : EmitSettlement ctx cur (_root_.id : Emit) + (GraphOwnsResultProtected funRel recSelfRel output sourceOutput + sourceValue .shared (.constA atom) sourceRest rest slots) + (GraphOwnsBorrowResultProtected funRel recSelfRel output sourceOutput + sourceValue (.constA atom) false sourceRest rest slots) := by + apply EmitSettlement.strengthen + intro store env hpre + obtain ⟨⟨roots, value, houtput, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + have hworld : HasWorld store .shared value := + hown.roots_world ⟨.shared, value⟩ (by simp) + refine ⟨roots, value, houtput, hav, hworld, hvalueGraph, + hrestGraph, ?_, hslots⟩ + simpa [borrowResultRoots] using + hown.dropNoLocation + (hsettles.stable.const_noLocation hav) + have hcomposed := EmitSettlement.comp + (hsettles.graphSettlement sourceRest rest slots) hconvert + simpa [Function.comp_def] using hcomposed + +/-- Empty argument lowering is an identity progress transformer. -/ +theorem lowerArgs_nil_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input : VEnv} + {sourceEnv : List IxIR0.Value} : + LowerArgsValueProgress funRel recSelfRel ctx cur input input + sourceEnv sourceEnv [] [] (_root_.id : Emit) [] := by + refine + { toLowerArgsValueSound := lowerArgs_nil_value_sound + graphProgress := ?_ } + intro sourceRest rest slots + apply EmitProgress.strengthen + intro store env hpre + obtain ⟨⟨roots, hinput, hrestGraph, hown⟩, hslots⟩ := hpre + exact ⟨⟨roots, [], hinput, .nil, .nil, hrestGraph, + by simpa [rootsForWorlds] using hown⟩, hslots⟩ + +/-- Literal lowering has no emitted operation and immediately establishes +its scalar result graph and ownership-inert distinguished root. -/ +theorem lower_lit_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input : VEnv} + {sourceEnv : List IxIR0.Value} {world : Owned} + {literal : IxIR0.Literal} : + LowerResultValueProgress funRel recSelfRel ctx cur input input + sourceEnv sourceEnv (.lit literal) world (_root_.id : Emit) + (.constA (.lit literal)) := by + refine + { toLowerResultValueSound := lower_lit_value_sound + graphProgress := ?_ } + intro sourceRest rest slots + apply EmitProgress.strengthen + intro store env hpre + obtain ⟨⟨roots, hinput, hrestGraph, hown⟩, hslots⟩ := hpre + exact ⟨⟨roots, .lit literal, hinput, .const rfl, .lit, + hrestGraph, hown.addNoLocation rfl⟩, hslots⟩ + +/-- Erased lowering is the analogous ownership-inert identity case. -/ +theorem lower_erased_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input : VEnv} + {sourceEnv : List IxIR0.Value} {world : Owned} : + LowerResultValueProgress funRel recSelfRel ctx cur input input + sourceEnv sourceEnv .erased world (_root_.id : Emit) + (.constA .erased) := by + refine + { toLowerResultValueSound := lower_erased_value_sound + graphProgress := ?_ } + intro sourceRest rest slots + apply EmitProgress.strengthen + intro store env hpre + obtain ⟨⟨roots, hinput, hrestGraph, hown⟩, hslots⟩ := hpre + exact ⟨⟨roots, .erased, hinput, .const rfl, .erased, + hrestGraph, hown.addNoLocation rfl⟩, hslots⟩ + +/-- Moving an arbitrary held entry emits no target operation, so its +semantic ownership transformation is also an immediate progress +transformation. -/ +theorem lower_held_move_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {i abs remaining : Nat} {uses : Uses} + (hsource : sourceEnv[i]? = some sourceValue) + (hentry : Γ.entries[i]? = some (.slot abs remaining uses true)) : + LowerResultValueProgress funRel recSelfRel ctx cur Γ + (Γ.setEntry i (.slot abs 0 uses false)) + sourceEnv sourceEnv sourceValue (worldOfUses uses) + (_root_.id : Emit) (.slotA abs) := by + refine + { toLowerResultValueSound := lower_held_move_value_sound hsource hentry + graphProgress := ?_ } + intro sourceRest rest slots + apply EmitProgress.strengthen + intro store env hpre + obtain ⟨⟨roots, hΓ, hrestGraph, hown⟩, hslots⟩ := hpre + obtain ⟨foundSource, value, before, after, hfoundSource, hbound, + hslot, _, hvalue, hroots, hout⟩ := + hΓ.entries.releaseAt hentry + have hsourceEq : foundSource = sourceValue := + Option.some.inj (hfoundSource.symm.trans hsource) + subst foundSource + refine ⟨⟨before ++ after, value, hΓ.setEntry hout, ?_, hvalue, + hrestGraph, ?_⟩, hslots.setEntry⟩ + · apply AValRealizes.slot + · simpa [VEnv.setEntry] using hbound + · simpa [VEnv.setEntry, VEnv.rel] using hslot + · rw [hroots] at hown + exact hown.perm + (permExtractRoot ⟨worldOfUses uses, value⟩ before after rest) + +/-- Ordinary final variable use specializes held-entry progress to the +single remaining source occurrence. -/ +theorem lower_var_move_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {i abs : Nat} {uses : Uses} + (hsource : sourceEnv[i]? = some sourceValue) + (hentry : Γ.entries[i]? = some (.slot abs 1 uses true)) : + LowerResultValueProgress funRel recSelfRel ctx cur Γ + (Γ.setEntry i (.slot abs 0 uses false)) + sourceEnv sourceEnv sourceValue (worldOfUses uses) + (_root_.id : Emit) (.slotA abs) := + lower_held_move_value_progress hsource hentry + +/-- Retaining a held shared entry always has a one-step target execution. +The refcount-only store extension transports the complete semantic +environment and caller frame. -/ +theorem lower_held_retain_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {i abs remaining newRemaining : Nat} {uses : Uses} + (hsource : sourceEnv[i]? = some sourceValue) + (hworldOfUses : worldOfUses uses = .shared) + (hentry : Γ.entries[i]? = some (.slot abs remaining uses true)) : + let Γ' := Γ.setEntry i (.slot abs newRemaining uses true) + LowerResultValueProgress funRel recSelfRel ctx cur Γ Γ'.bump + sourceEnv sourceEnv sourceValue .shared + (emitOp (.dup (.var (Γ'.rel abs)))) (.slotA Γ'.depth) := by + dsimp only + refine + { toLowerResultValueSound := + lower_held_retain_value_sound hsource hworldOfUses hentry + graphProgress := ?_ } + intro sourceRest rest slots + apply OpProgress.emit + intro store env hpre + obtain ⟨⟨roots, hΓ, hrestGraph, hown⟩, hslots⟩ := hpre + obtain ⟨foundSource, value, hfoundSource, hbound, hslot, + hvalueWorld, hvalue, _, hupdated⟩ := + hΓ.entries.updateHeldAt newRemaining hentry + have hsourceEq : foundSource = sourceValue := + Option.some.inj (hfoundSource.symm.trans hsource) + subst foundSource + let Γ' := Γ.setEntry i (.slot abs newRemaining uses true) + have hΓ' : VEnvValueGraph funRel recSelfRel store Γ' + sourceEnv env roots := hΓ.setEntry hupdated + have hav : AValRealizes Γ' env (.slotA abs) value := by + apply AValRealizes.slot + · simpa [Γ', VEnv.setEntry] using hbound + · simpa [Γ', VEnv.setEntry, VEnv.rel] using hslot + have hshared : HasWorld store .shared value := by + simpa [hworldOfUses] using hvalueWorld + obtain ⟨middle, heval, hstore, hresultGraph, hmiddle⟩ := + runOp_retain_borrowed_valueGraph + (ctx := ctx) (cur := cur) (fuel := 0) + hav.resolveAtom hshared hvalue hown + have hΓmiddle : VEnvValueGraph funRel recSelfRel middle Γ' + sourceEnv env roots := hΓ'.monoStore hstore + have hrestGraph' : Sim.RootsGraph funRel middle sourceRest rest := + hrestGraph.monoStore hstore + refine ⟨1, middle, value, heval, ?_⟩ + refine ⟨⟨roots, value, hΓmiddle.bump value, ?_, hresultGraph, + hrestGraph', hmiddle⟩, hslots.setEntry.bump value⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +/-- Non-final shared variable use decrements the static occurrence count and +executes the progressing retain rule. -/ +theorem lower_var_shared_dup_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {i abs remaining : Nat} {uses : Uses} + (hsource : sourceEnv[i]? = some sourceValue) + (hworldOfUses : worldOfUses uses = .shared) + (hentry : Γ.entries[i]? = + some (.slot abs (Nat.succ (Nat.succ remaining)) uses true)) : + let Γ' := Γ.setEntry i + (.slot abs (Nat.succ remaining) uses true) + LowerResultValueProgress funRel recSelfRel ctx cur Γ Γ'.bump + sourceEnv sourceEnv sourceValue .shared + (emitOp (.dup (.var (Γ'.rel abs)))) (.slotA Γ'.depth) := + lower_held_retain_value_progress hsource hworldOfUses hentry + +/-- Successful literal lowering selects the identity-emitter progress rule. -/ +theorem lowerE_lit_run_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Owned} + {literal : IxIR0.Literal} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + (hrun : (lowerE src (fuel + 1) input world (.lit literal)).run state = + .ok (output, emit, av) finalState) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv (.lit literal) world emit av := by + have hpure : + (input, (_root_.id : Emit), AVal.constA (.lit literal)) = + (output, emit, av) ∧ state = finalState := by + simpa [lowerE] using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact lower_lit_value_progress + +/-- Successful erased lowering likewise has immediate target progress. -/ +theorem lowerE_erased_run_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Owned} + {emit : Emit} {av : AVal} {state finalState : LowSt} + {sourceEnv : List IxIR0.Value} + (hrun : (lowerE src (fuel + 1) input world .erased).run state = + .ok (output, emit, av) finalState) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv .erased world emit av := by + have hpure : + (input, (_root_.id : Emit), AVal.constA .erased) = + (output, emit, av) ∧ state = finalState := by + simpa [lowerE] using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact lower_erased_value_progress + +/-- Progress counterpart of the complete variable dispatch. Final uses move +an existing owner without an operation; repeated shared uses execute one +`dup`. Every other successful-lowering case is contradictory. -/ +theorem lowerE_var_run_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Owned} {i : Nat} + {emit : Emit} {av : AVal} {state finalState : LowSt} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + (hsource : sourceEnv[i]? = some sourceValue) + (hrun : (lowerE src (fuel + 1) input world (.var i)).run state = + .ok (output, emit, av) finalState) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue world emit av := by + have hssNe : (Owned.shared != Owned.shared) = false := by decide + have huuNe : (Owned.unique != Owned.unique) = false := by decide + have hsuNe : (Owned.shared != Owned.unique) = true := by decide + have husNe : (Owned.unique != Owned.shared) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + have huuEq : (Owned.unique == Owned.unique) = true := by decide + cases hentry : input.entries[i]? with + | none => + exact (trackedThrowRun_not_ok (by + simpa [lowerE, hentry] using hrun)).elim + | some entry => + cases entry with + | recSelf arity => + exact (trackedThrowRun_not_ok (by + simpa [lowerE, hentry] using hrun)).elim + | slot abs remaining uses held => + cases held with + | false => + exact (trackedThrowRun_not_ok (by + simpa [lowerE, hentry] using hrun)).elim + | true => + by_cases hworld : worldOfUses uses = world + · subst world + have hsame : + (worldOfUses uses != worldOfUses uses) = false := by + cases uses <;> decide + cases remaining with + | zero => + exact (trackedThrowRun_not_ok (by + simpa [lowerE, hentry, hsame] using hrun)).elim + | succ remaining => + cases remaining with + | zero => + have hpure : + (input.setEntry i (.slot abs 0 uses false), + (_root_.id : Emit), AVal.slotA abs) = + (output, emit, av) ∧ state = finalState := by + simpa [lowerE, hentry, hsame] using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact lower_var_move_value_progress hsource hentry + | succ remaining => + cases uses with + | erased => + have heq : + (Owned.shared == Owned.unique) = false := by decide + have hpure : + let input' := input.setEntry i + (.slot abs (Nat.succ remaining) .erased true) + (input'.bump, + emitOp (.dup (.var (input'.rel abs))), + AVal.slotA input'.depth) = (output, emit, av) ∧ + state = finalState := by + simpa [lowerE, hentry, worldOfUses, hsame, heq, + hssNe, huuNe, hsuNe, husNe, hsuEq, huuEq] + using hrun + dsimp only at hpure + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact lower_held_retain_value_progress hsource (by rfl) + hentry + | linear => + have heq : + (Owned.unique == Owned.unique) = true := by decide + exact (trackedThrowRun_not_ok (by + simpa [lowerE, hentry, worldOfUses, hsame, heq, + hssNe, huuNe, hsuNe, husNe, hsuEq, huuEq] + using hrun)).elim + | affine => + have heq : + (Owned.unique == Owned.unique) = true := by decide + exact (trackedThrowRun_not_ok (by + simpa [lowerE, hentry, worldOfUses, hsame, heq, + hssNe, huuNe, hsuNe, husNe, hsuEq, huuEq] + using hrun)).elim + | many => + have heq : + (Owned.shared == Owned.unique) = false := by decide + have hpure : + let input' := input.setEntry i + (.slot abs (Nat.succ remaining) .many true) + (input'.bump, + emitOp (.dup (.var (input'.rel abs))), + AVal.slotA input'.depth) = (output, emit, av) ∧ + state = finalState := by + simpa [lowerE, hentry, worldOfUses, hsame, heq, + hssNe, huuNe, hsuNe, husNe, hsuEq, huuEq] + using hrun + dsimp only at hpure + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact lower_held_retain_value_progress hsource (by rfl) + hentry + · have hdiff : (worldOfUses uses != world) = true := by + cases uses <;> cases world <;> + simp_all [worldOfUses] <;> decide + cases uses <;> cases world + all_goals + try { exact (hworld (by rfl)).elim } + all_goals + exact (trackedThrowRun_not_ok (by + simpa [lowerE, hentry, worldOfUses, hdiff, hssNe, huuNe, + hsuNe, husNe, hsuEq, huuEq] using hrun)).elim + +/-- A final shared variable in borrowing position transfers its owner to the +projection caller without executing an operation. -/ +theorem lower_var_shared_move_borrow_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {i abs : Nat} {uses : Uses} + (hsource : sourceEnv[i]? = some sourceValue) + (hworld : worldOfUses uses = .shared) + (hentry : Γ.entries[i]? = some (.slot abs 1 uses true)) : + LowerBorrowValueProgress funRel recSelfRel ctx cur Γ + (Γ.setEntry i (.slot abs 0 uses false)) + sourceEnv sourceEnv sourceValue (_root_.id : Emit) + (.slotA abs) true := by + have hmove := lower_var_move_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) hsource hentry + have hshared : LowerResultValueProgress funRel recSelfRel ctx cur Γ + (Γ.setEntry i (.slot abs 0 uses false)) + sourceEnv sourceEnv sourceValue .shared + (_root_.id : Emit) (.slotA abs) := by + simpa [hworld] using hmove + exact hshared.asBorrowSlot + +/-- Repeated shared borrowing only updates the compiler-side use count; the +runtime environment is already a valid borrowing post-state. -/ +theorem lower_var_shared_borrow_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {i abs remaining : Nat} {uses : Uses} + (hsource : sourceEnv[i]? = some sourceValue) + (hworld : worldOfUses uses = .shared) + (hentry : Γ.entries[i]? = + some (.slot abs (Nat.succ (Nat.succ remaining)) uses true)) : + let Γ' := Γ.setEntry i (.slot abs (Nat.succ remaining) uses true) + LowerBorrowValueProgress funRel recSelfRel ctx cur Γ Γ' + sourceEnv sourceEnv sourceValue (_root_.id : Emit) + (.slotA abs) false := by + dsimp only + refine + { toLowerBorrowValueSound := + lower_var_shared_borrow_value_sound hsource hworld hentry + graphProgress := ?_ } + intro sourceRest rest slots + apply EmitProgress.strengthen + intro store env hpre + obtain ⟨⟨roots, hΓ, hrestGraph, hown⟩, hslots⟩ := hpre + obtain ⟨foundSource, value, hfoundSource, hbound, hslot, + hvalueWorld, hvalueGraph, _, hupdated⟩ := + hΓ.entries.updateHeldAt (Nat.succ remaining) hentry + have hsourceEq : foundSource = sourceValue := + Option.some.inj (hfoundSource.symm.trans hsource) + subst foundSource + let Γ' := Γ.setEntry i + (.slot abs (Nat.succ remaining) uses true) + have hΓ' : VEnvValueGraph funRel recSelfRel store Γ' + sourceEnv env roots := hΓ.setEntry hupdated + have hav : AValRealizes Γ' env (.slotA abs) value := by + apply AValRealizes.slot + · simpa [Γ', VEnv.setEntry] using hbound + · simpa [Γ', VEnv.setEntry, VEnv.rel] using hslot + have hshared : HasWorld store .shared value := by + simpa [hworld] using hvalueWorld + refine ⟨roots, value, hΓ', hav, hshared, hvalueGraph, + hrestGraph, ?_, hslots.setEntry⟩ + simpa [borrowResultRoots] using hown + +/-- Complete progressing variable-borrow dispatch. -/ +theorem lowerBorrow_var_run_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {i : Nat} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {av : AVal} {release : Bool} + {state finalState : LowSt} + (hsource : sourceEnv[i]? = some sourceValue) + (hrun : (lowerBorrow src (fuel + 1) input (.var i)).run state = + .ok (output, emit, av, release) finalState) : + LowerBorrowValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue emit av release := by + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + have huuEq : (Owned.unique == Owned.unique) = true := by decide + cases hentry : input.entries[i]? with + | none => + exact (trackedThrowRun_not_ok (by + simpa [lowerBorrow, hentry] using hrun)).elim + | some entry => + cases entry with + | recSelf arity => + exact (trackedThrowRun_not_ok (by + simpa [lowerBorrow, hentry] using hrun)).elim + | slot abs remaining uses held => + cases held with + | false => + exact (trackedThrowRun_not_ok (by + simpa [lowerBorrow, hentry] using hrun)).elim + | true => + cases uses with + | erased => + cases remaining with + | zero => + exact (trackedThrowRun_not_ok (by + simpa [lowerBorrow, hentry, worldOfUses, hsuEq] + using hrun)).elim + | succ remaining => + cases remaining with + | zero => + have hpure : + (input.setEntry i (.slot abs 0 .erased false), + (_root_.id : Emit), AVal.slotA abs, true) = + (output, emit, av, release) ∧ + state = finalState := by + simpa [lowerBorrow, hentry, worldOfUses, hsuEq] + using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact lower_var_shared_move_borrow_value_progress + hsource (by rfl) hentry + | succ remaining => + have hpure : + (input.setEntry i + (.slot abs (Nat.succ remaining) .erased true), + (_root_.id : Emit), AVal.slotA abs, false) = + (output, emit, av, release) ∧ + state = finalState := by + simpa [lowerBorrow, hentry, worldOfUses, hsuEq] + using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact lower_var_shared_borrow_value_progress + hsource (by rfl) hentry + + | linear => + exact (trackedThrowRun_not_ok (by + simpa [lowerBorrow, hentry, worldOfUses, huuEq] + using hrun)).elim + | affine => + exact (trackedThrowRun_not_ok (by + simpa [lowerBorrow, hentry, worldOfUses, huuEq] + using hrun)).elim + | many => + cases remaining with + | zero => + exact (trackedThrowRun_not_ok (by + simpa [lowerBorrow, hentry, worldOfUses, hsuEq] + using hrun)).elim + | succ remaining => + cases remaining with + | zero => + have hpure : + (input.setEntry i (.slot abs 0 .many false), + (_root_.id : Emit), AVal.slotA abs, true) = + (output, emit, av, release) ∧ + state = finalState := by + simpa [lowerBorrow, hentry, worldOfUses, hsuEq] + using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact lower_var_shared_move_borrow_value_progress + hsource (by rfl) hentry + | succ remaining => + have hpure : + (input.setEntry i + (.slot abs (Nat.succ remaining) .many true), + (_root_.id : Emit), AVal.slotA abs, false) = + (output, emit, av, release) ∧ + state = finalState := by + simpa [lowerBorrow, hentry, worldOfUses, hsuEq] + using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact lower_var_shared_borrow_value_progress + hsource (by rfl) hentry + +/-- Non-variable borrowing reuses progressing shared-expression lowering and +adapts the resulting descriptor without another target operation. -/ +theorem lowerBorrow_dynamic_run_value_progress_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} {ambient : LowSt} + {fuel : Nat} {input output : VEnv} {expr : IxIR0.Expr} + {emit : Emit} {av : AVal} {release : Bool} + {state finalState : LowSt} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + (hexpr : ∀ {exprOutput : VEnv} {exprEmit : Emit} {exprAv : AVal} + {exprState : LowSt}, + (lowerE src fuel input .shared expr).run state = + .ok (exprOutput, exprEmit, exprAv) exprState → + ExtraExtends exprState ambient → + LowerResultValueProgress funRel recSelfRel ctx cur input exprOutput + sourceEnv sourceEnv sourceValue .shared exprEmit exprAv) + (hshape : DynamicBorrowHead expr) + (hrun : (lowerBorrow src (fuel + 1) input expr).run state = + .ok (output, emit, av, release) finalState) + (hextends : ExtraExtends finalState ambient) : + LowerBorrowValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue emit av release := by + cases hshape <;> simp only [lowerBorrow] at hrun + all_goals + obtain ⟨exprResult, exprState, hexprRun, hafterExpr⟩ := + trackedBindRun_ok_inv hrun + rcases exprResult with ⟨exprOutput, exprEmit, exprValue⟩ + cases exprValue with + | slotA abs => + have hpure : + (exprOutput, exprEmit, AVal.slotA abs, true) = + (output, emit, av, release) ∧ + exprState = finalState := by + simpa using hafterExpr + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact (hexpr hexprRun hextends).asBorrowSlot + | constA atom => + have hpure : + (exprOutput, exprEmit, AVal.constA atom, false) = + (output, emit, av, release) ∧ + exprState = finalState := by + simpa using hafterExpr + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact (hexpr hexprRun hextends).asBorrowConst + +/-- Settlement counterpart of dynamic borrowing. If shared expression +lowering stops safely, the adapter stops with it; if it reaches its graph +postcondition, the descriptor is reclassified without another operation. -/ +theorem lowerBorrow_dynamic_run_value_settlement_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} {ambient : LowSt} + {fuel : Nat} {input output : VEnv} {expr : IxIR0.Expr} + {emit : Emit} {av : AVal} {release : Bool} + {state finalState : LowSt} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + (hexpr : ∀ {exprOutput : VEnv} {exprEmit : Emit} {exprAv : AVal} + {exprState : LowSt}, + (lowerE src fuel input .shared expr).run state = + .ok (exprOutput, exprEmit, exprAv) exprState → + ExtraExtends exprState ambient → + LowerResultValueSettlement funRel recSelfRel ctx cur + input exprOutput sourceEnv sourceEnv sourceValue .shared + exprEmit exprAv) + (hshape : DynamicBorrowHead expr) + (hrun : (lowerBorrow src (fuel + 1) input expr).run state = + .ok (output, emit, av, release) finalState) + (hextends : ExtraExtends finalState ambient) : + LowerBorrowValueSettlement funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue emit av release := by + cases hshape <;> simp only [lowerBorrow] at hrun + all_goals + obtain ⟨exprResult, exprState, hexprRun, hafterExpr⟩ := + trackedBindRun_ok_inv hrun + rcases exprResult with ⟨exprOutput, exprEmit, exprValue⟩ + cases exprValue with + | slotA abs => + have hpure : + (exprOutput, exprEmit, AVal.slotA abs, true) = + (output, emit, av, release) ∧ + exprState = finalState := by + simpa using hafterExpr + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact (hexpr hexprRun hextends).asBorrowSlot + | constA atom => + have hpure : + (exprOutput, exprEmit, AVal.constA atom, false) = + (output, emit, av, release) ∧ + exprState = finalState := by + simpa using hafterExpr + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact (hexpr hexprRun hextends).asBorrowConst + +/-- Progress-preserving left-to-right argument sequencing. The head result +is protected as a framed root while the tail runs, then moved back into the +argument prefix without executing another target operation. -/ +theorem LowerResultValueProgress.consArgs + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input middle output : VEnv} + {sourceInput sourceMiddle sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {sourceValues : List IxIR0.Value} + {world : Owned} {worlds : List Owned} + {emitHead emitTail : Emit} {av : AVal} {avs : List AVal} + (head : LowerResultValueProgress funRel recSelfRel ctx cur + input middle sourceInput sourceMiddle sourceValue world emitHead av) + (tail : LowerArgsValueProgress funRel recSelfRel ctx cur + middle output sourceMiddle sourceOutput sourceValues worlds + emitTail avs) : + LowerArgsValueProgress funRel recSelfRel ctx cur input output + sourceInput sourceOutput (sourceValue :: sourceValues) + (world :: worlds) (emitHead ∘ emitTail) (av :: avs) := by + refine + { toLowerArgsValueSound := + head.toLowerResultValueSound.consArgs tail.toLowerArgsValueSound + graphProgress := ?_ } + intro sourceRest rest slots + apply EmitProgress.comp (head.graphProgress sourceRest rest slots) + apply EmitProgress.of_pointwise + intro store env hmid + obtain ⟨⟨envRoots, value, hmiddle, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hmid + let root : Root := ⟨world, value⟩ + have hrootWorld : HasWorld store world value := by + apply hown.roots_world root + simp [root] + have hframeGraph : Sim.RootsGraph funRel store + ((world, sourceValue) :: sourceRest) (root :: rest) := + .cons rfl hrootWorld hvalueGraph hrestGraph + have hprotect : SlotsRealize middle env (aValProtection av value) := + head.stable.protection_realized hav + have htailOwn : RootOwnership store (envRoots ++ root :: rest) := by + apply hown.perm + simpa [root] using + (permExtractRoot root envRoots [] rest).symm + have htailPre : GraphOwnsVEnvProtected funRel recSelfRel middle + sourceMiddle ((world, sourceValue) :: sourceRest) (root :: rest) + (aValProtection av value ++ slots) store env := + ⟨⟨envRoots, hmiddle, hframeGraph, htailOwn⟩, + hprotect.append hslots⟩ + have hconvert : EmitProgress ctx cur (_root_.id : Emit) + (GraphOwnsArgsResultProtected funRel recSelfRel output + sourceOutput sourceValues worlds avs + ((world, sourceValue) :: sourceRest) (root :: rest) + (aValProtection av value ++ slots)) + (GraphOwnsArgsResultProtected funRel recSelfRel output + sourceOutput (sourceValue :: sourceValues) (world :: worlds) + (av :: avs) sourceRest rest slots) := by + apply EmitProgress.strengthen + intro innerStore innerEnv htailPost + obtain ⟨⟨outRoots, values, houtput, havs, hvalueGraphs, + hframeGraphFinal, hownTail⟩, hslotsTail⟩ := htailPost + cases hframeGraphFinal with + | cons _ _ hheadGraph hrestGraphFinal => + have havFinal : AValRealizes output innerEnv av value := + head.stable.realize_of_protection hav + hslotsTail.left_of_append + have hheadGraph' : + Sim.ValueGraph funRel innerStore sourceValue value := by + simpa [root] using hheadGraph + have hownFinal : RootOwnership innerStore + (rootsForWorlds (world :: worlds) (value :: values) ++ + outRoots ++ rest) := by + apply hownTail.perm + simpa [root, List.append_assoc] using + (permExtractRoot root + (rootsForWorlds worlds values ++ outRoots) [] rest) + exact ⟨⟨outRoots, value :: values, houtput, + .cons havFinal havs, .cons hheadGraph' hvalueGraphs, + hrestGraphFinal, hownFinal⟩, hslotsTail.right_of_append⟩ + have htailThenConvert := EmitProgress.comp + (tail.graphProgress ((world, sourceValue) :: sourceRest) (root :: rest) + (aValProtection av value ++ slots)) hconvert + exact ⟨_, htailPre, htailThenConvert⟩ + +/-- Settlement-preserving argument sequencing. If the head stops, the whole +sequence stops; if it succeeds, its protected graph result frames the tail's +settlement exactly as in successful argument progress. -/ +theorem LowerResultValueSettlement.consArgs + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input middle output : VEnv} + {sourceInput sourceMiddle sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {sourceValues : List IxIR0.Value} + {world : Owned} {worlds : List Owned} + {emitHead emitTail : Emit} {av : AVal} {avs : List AVal} + (head : LowerResultValueSettlement funRel recSelfRel ctx cur + input middle sourceInput sourceMiddle sourceValue world emitHead av) + (tail : LowerArgsValueSettlement funRel recSelfRel ctx cur + middle output sourceMiddle sourceOutput sourceValues worlds + emitTail avs) : + LowerArgsValueSettlement funRel recSelfRel ctx cur input output + sourceInput sourceOutput (sourceValue :: sourceValues) + (world :: worlds) (emitHead ∘ emitTail) (av :: avs) := by + refine + { toLowerArgsValueSound := + head.toLowerResultValueSound.consArgs tail.toLowerArgsValueSound + graphSettlement := ?_ } + intro sourceRest rest slots + apply EmitSettlement.comp + (head.graphSettlement sourceRest rest slots) + apply EmitSettlement.of_pointwise + intro store env hmid + obtain ⟨⟨envRoots, value, hmiddle, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hmid + let root : Root := ⟨world, value⟩ + have hrootWorld : HasWorld store world value := by + apply hown.roots_world root + simp [root] + have hframeGraph : Sim.RootsGraph funRel store + ((world, sourceValue) :: sourceRest) (root :: rest) := + .cons rfl hrootWorld hvalueGraph hrestGraph + have hprotect : SlotsRealize middle env (aValProtection av value) := + head.stable.protection_realized hav + have htailOwn : RootOwnership store (envRoots ++ root :: rest) := by + apply hown.perm + simpa [root] using + (permExtractRoot root envRoots [] rest).symm + have htailPre : GraphOwnsVEnvProtected funRel recSelfRel middle + sourceMiddle ((world, sourceValue) :: sourceRest) (root :: rest) + (aValProtection av value ++ slots) store env := + ⟨⟨envRoots, hmiddle, hframeGraph, htailOwn⟩, + hprotect.append hslots⟩ + have hconvert : EmitSettlement ctx cur (_root_.id : Emit) + (GraphOwnsArgsResultProtected funRel recSelfRel output + sourceOutput sourceValues worlds avs + ((world, sourceValue) :: sourceRest) (root :: rest) + (aValProtection av value ++ slots)) + (GraphOwnsArgsResultProtected funRel recSelfRel output + sourceOutput (sourceValue :: sourceValues) (world :: worlds) + (av :: avs) sourceRest rest slots) := by + apply EmitSettlement.strengthen + intro innerStore innerEnv htailPost + obtain ⟨⟨outRoots, values, houtput, havs, hvalueGraphs, + hframeGraphFinal, hownTail⟩, hslotsTail⟩ := htailPost + cases hframeGraphFinal with + | cons _ _ hheadGraph hrestGraphFinal => + have havFinal : AValRealizes output innerEnv av value := + head.stable.realize_of_protection hav + hslotsTail.left_of_append + have hheadGraph' : + Sim.ValueGraph funRel innerStore sourceValue value := by + simpa [root] using hheadGraph + have hownFinal : RootOwnership innerStore + (rootsForWorlds (world :: worlds) (value :: values) ++ + outRoots ++ rest) := by + apply hownTail.perm + simpa [root, List.append_assoc] using + (permExtractRoot root + (rootsForWorlds worlds values ++ outRoots) [] rest) + exact ⟨⟨outRoots, value :: values, houtput, + .cons havFinal havs, .cons hheadGraph' hvalueGraphs, + hrestGraphFinal, hownFinal⟩, hslotsTail.right_of_append⟩ + have htailThenConvert := EmitSettlement.comp + (tail.graphSettlement ((world, sourceValue) :: sourceRest) (root :: rest) + (aValProtection av value ++ slots)) hconvert + exact ⟨_, htailPre, htailThenConvert⟩ + +/-- Progressing constructor allocation turns the progressing argument vector +into a fresh graph-related constructor node. -/ +theorem LowerArgsValueProgress.alloc_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput sourceValues : List IxIR0.Value} + {sourceAddress : Ixon.Address} {sourceTag : Nat} + {world : Owned} {emit : Emit} {avs : List AVal} {cid : CtorId} + (hargs : LowerArgsValueProgress funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValues + (List.replicate avs.length world) emit avs) + (haddress : cid.block = sourceAddress) + (htag : cid.cidx = sourceTag) : + LowerResultValueProgress funRel recSelfRel ctx cur input output.bump + sourceInput sourceOutput (.ctor sourceAddress sourceTag sourceValues) + world + (emit ∘ emitOp + (.alloc world cid (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.alloc_graph haddress htag + graphProgress := ?_ } + intro sourceRest rest slots + apply EmitProgress.comp (hargs.graphProgress sourceRest rest slots) + apply OpProgress.emit + intro store env hpre + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + have hvaluesLength : values.length = avs.length := + havs.lengths.2.symm + have hroots : + rootsForWorlds (List.replicate avs.length world) values = + rootsFor world values := + rootsForWorlds_replicate_eq_rootsFor world hvaluesLength + have hown' : RootOwnership store + (rootsFor world values ++ (envRoots ++ rest)) := by + simpa [hroots, List.append_assoc] using hown + obtain ⟨heval, hstore, hresultGraph, hresultOwn⟩ := + runOp_alloc_owned_valueGraph + (ctx := ctx) (cur := cur) (fuel := 0) + havs.resolveAtoms haddress htag hvalueGraphs hown' + let allocated := store.allocNode world (.ctorN cid values.toArray) + let ctorValue : RVal := .loc allocated.2 + have houtput' : VEnvValueGraph funRel recSelfRel allocated.1 output + sourceOutput env envRoots := by + simpa [allocated] using houtput.monoStore hstore + have hrestGraph' : Sim.RootsGraph funRel allocated.1 sourceRest rest := by + simpa [allocated] using hrestGraph.monoStore hstore + refine ⟨1, allocated.1, ctorValue, ?_, ?_⟩ + · simpa [allocated, ctorValue] using heval + · refine ⟨⟨envRoots, ctorValue, houtput'.bump ctorValue, ?_, ?_, + hrestGraph', ?_⟩, hslots.bump ctorValue⟩ + · apply AValRealizes.slot + · simp [VEnv.bump] + · simp [ctorValue, VEnv.bump, VEnv.rel] + · simpa [allocated, ctorValue] using hresultGraph + · simpa [allocated, ctorValue] using hresultOwn + +/-- Progressing pap allocation stores a related shared argument prefix in a +fresh function node. -/ +theorem LowerArgsValueProgress.papp_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput sourceValues : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {avs : List AVal} + {f : Ixon.Address} {d : Decl} + (hargs : LowerArgsValueProgress funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValues + (List.replicate avs.length .shared) emit avs) + (hdecl : ctx.decls f = some d) + (hfun : funRel sourceValue f (declArity d) sourceValues) + (hunder : avs.length < declArity d) : + LowerResultValueProgress funRel recSelfRel ctx cur input output.bump + sourceInput sourceOutput sourceValue .shared + (emit ∘ emitOp (.papp f (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.papp_graph hdecl hfun hunder + graphProgress := ?_ } + intro sourceRest rest slots + apply EmitProgress.comp (hargs.graphProgress sourceRest rest slots) + apply OpProgress.emit + intro store env hpre + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + have hvaluesLength : values.length = avs.length := + havs.lengths.2.symm + have hunderValues : values.length < declArity d := by + simpa [hvaluesLength] using hunder + have hroots : + rootsForWorlds (List.replicate avs.length .shared) values = + rootsFor .shared values := + rootsForWorlds_replicate_eq_rootsFor .shared hvaluesLength + have hown' : RootOwnership store + (rootsFor .shared values ++ (envRoots ++ rest)) := by + simpa [hroots, List.append_assoc] using hown + obtain ⟨heval, hstore, hresultGraph, hresultOwn⟩ := + runOp_papp_owned_valueGraph + (ctx := ctx) (cur := cur) (fuel := 0) + havs.resolveAtoms hdecl hunderValues hfun hvalueGraphs hown' + let allocated := store.allocNode .shared + (.papN f (declArity d) values.toArray) + let papValue : RVal := .loc allocated.2 + have houtput' : VEnvValueGraph funRel recSelfRel allocated.1 output + sourceOutput env envRoots := by + simpa [allocated] using houtput.monoStore hstore + have hrestGraph' : Sim.RootsGraph funRel allocated.1 sourceRest rest := by + simpa [allocated] using hrestGraph.monoStore hstore + refine ⟨1, allocated.1, papValue, ?_, ?_⟩ + · simpa [allocated, papValue] using heval + · refine ⟨⟨envRoots, papValue, houtput'.bump papValue, ?_, ?_, + hrestGraph', ?_⟩, hslots.bump papValue⟩ + · apply AValRealizes.slot + · simp [VEnv.bump] + · simp [papValue, VEnv.bump, VEnv.rel] + · simpa [allocated, papValue] using hresultGraph + · simpa [allocated, papValue] using hresultOwn + +/-- Progressing constructor allocation turns the progressing argument vector +into a fresh graph-related constructor node. -/ +theorem LowerArgsValueSettlement.alloc_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput sourceValues : List IxIR0.Value} + {sourceAddress : Ixon.Address} {sourceTag : Nat} + {world : Owned} {emit : Emit} {avs : List AVal} {cid : CtorId} + (hargs : LowerArgsValueSettlement funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValues + (List.replicate avs.length world) emit avs) + (haddress : cid.block = sourceAddress) + (htag : cid.cidx = sourceTag) : + LowerResultValueSettlement funRel recSelfRel ctx cur input output.bump + sourceInput sourceOutput (.ctor sourceAddress sourceTag sourceValues) + world + (emit ∘ emitOp + (.alloc world cid (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.alloc_graph haddress htag + graphSettlement := ?_ } + intro sourceRest rest slots + apply EmitSettlement.comp (hargs.graphSettlement sourceRest rest slots) + apply OpProgress.emitSettlement + intro store env hpre + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + have hvaluesLength : values.length = avs.length := + havs.lengths.2.symm + have hroots : + rootsForWorlds (List.replicate avs.length world) values = + rootsFor world values := + rootsForWorlds_replicate_eq_rootsFor world hvaluesLength + have hown' : RootOwnership store + (rootsFor world values ++ (envRoots ++ rest)) := by + simpa [hroots, List.append_assoc] using hown + obtain ⟨heval, hstore, hresultGraph, hresultOwn⟩ := + runOp_alloc_owned_valueGraph + (ctx := ctx) (cur := cur) (fuel := 0) + havs.resolveAtoms haddress htag hvalueGraphs hown' + let allocated := store.allocNode world (.ctorN cid values.toArray) + let ctorValue : RVal := .loc allocated.2 + have houtput' : VEnvValueGraph funRel recSelfRel allocated.1 output + sourceOutput env envRoots := by + simpa [allocated] using houtput.monoStore hstore + have hrestGraph' : Sim.RootsGraph funRel allocated.1 sourceRest rest := by + simpa [allocated] using hrestGraph.monoStore hstore + refine ⟨1, allocated.1, ctorValue, ?_, ?_⟩ + · simpa [allocated, ctorValue] using heval + · refine ⟨⟨envRoots, ctorValue, houtput'.bump ctorValue, ?_, ?_, + hrestGraph', ?_⟩, hslots.bump ctorValue⟩ + · apply AValRealizes.slot + · simp [VEnv.bump] + · simp [ctorValue, VEnv.bump, VEnv.rel] + · simpa [allocated, ctorValue] using hresultGraph + · simpa [allocated, ctorValue] using hresultOwn + +/-- Progressing pap allocation stores a related shared argument prefix in a +fresh function node. -/ +theorem LowerArgsValueSettlement.papp_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput sourceValues : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {avs : List AVal} + {f : Ixon.Address} {d : Decl} + (hargs : LowerArgsValueSettlement funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValues + (List.replicate avs.length .shared) emit avs) + (hdecl : ctx.decls f = some d) + (hfun : funRel sourceValue f (declArity d) sourceValues) + (hunder : avs.length < declArity d) : + LowerResultValueSettlement funRel recSelfRel ctx cur input output.bump + sourceInput sourceOutput sourceValue .shared + (emit ∘ emitOp (.papp f (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.papp_graph hdecl hfun hunder + graphSettlement := ?_ } + intro sourceRest rest slots + apply EmitSettlement.comp (hargs.graphSettlement sourceRest rest slots) + apply OpProgress.emitSettlement + intro store env hpre + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + have hvaluesLength : values.length = avs.length := + havs.lengths.2.symm + have hunderValues : values.length < declArity d := by + simpa [hvaluesLength] using hunder + have hroots : + rootsForWorlds (List.replicate avs.length .shared) values = + rootsFor .shared values := + rootsForWorlds_replicate_eq_rootsFor .shared hvaluesLength + have hown' : RootOwnership store + (rootsFor .shared values ++ (envRoots ++ rest)) := by + simpa [hroots, List.append_assoc] using hown + obtain ⟨heval, hstore, hresultGraph, hresultOwn⟩ := + runOp_papp_owned_valueGraph + (ctx := ctx) (cur := cur) (fuel := 0) + havs.resolveAtoms hdecl hunderValues hfun hvalueGraphs hown' + let allocated := store.allocNode .shared + (.papN f (declArity d) values.toArray) + let papValue : RVal := .loc allocated.2 + have houtput' : VEnvValueGraph funRel recSelfRel allocated.1 output + sourceOutput env envRoots := by + simpa [allocated] using houtput.monoStore hstore + have hrestGraph' : Sim.RootsGraph funRel allocated.1 sourceRest rest := by + simpa [allocated] using hrestGraph.monoStore hstore + refine ⟨1, allocated.1, papValue, ?_, ?_⟩ + · simpa [allocated, papValue] using heval + · refine ⟨⟨envRoots, papValue, houtput'.bump papValue, ?_, ?_, + hrestGraph', ?_⟩, hslots.bump papValue⟩ + · apply AValRealizes.slot + · simp [VEnv.bump] + · simp [papValue, VEnv.bump, VEnv.rel] + · simpa [allocated, papValue] using hresultGraph + · simpa [allocated, papValue] using hresultOwn + +/-! ## Source-guided callable progress -/ + +/-- The source-side call witness used by total progress. Unlike the older +fuel-free `SourceApplies`, it retains each dynamically entered IxIR₀ +`Apply` trace and bounds every step by one enclosing source-evaluator fuel. -/ +abbrev SourceAppliesSafelyBelow (sourceCtx : IxIR0.Ctx) (limit : Nat) := + IxIR0.ProjectionSafe.AppliesBelow sourceCtx limit + +/-- Forget call-aware safety evidence and recover the semantic application +spine used by value correspondence. -/ +theorem SourceAppliesSafelyBelow.sourceApplies + {sourceCtx : IxIR0.Ctx} {limit : Nat} + {sourceFunction sourceResult : IxIR0.Value} + {sourceArgs : List IxIR0.Value} + (hspine : SourceAppliesSafelyBelow sourceCtx limit sourceFunction + sourceArgs sourceResult) : + SourceApplies sourceCtx sourceFunction sourceArgs sourceResult := by + exact IxIR0.ProjectionSafe.AppliesBelow.traverse + (Result := fun currentFunction currentArguments currentResult => + SourceApplies sourceCtx currentFunction currentArguments currentResult) + (hnil := fun _ => .nil) + (hcons := by + intro currentFunction argument currentMiddle currentResult + currentArguments fuel hfuel hstep htail ih + exact .cons hstep.run ih) + hspine + +/-- Function-body termination for application traces below one exact source +fuel. This is the contractive unit used by the source-fuel induction. -/ +def FnValueTraceProgressesAt (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (ctx : Ctx) (d : FnDef) + (argWorlds : List Owned) (sourceFunction : IxIR0.Value) + (sourceLimit : Nat) : Prop := + ∀ {store : Store} {args : List RVal} + {sourceArgs : List IxIR0.Value} {sourceResult : IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root}, + args.length = argWorlds.length → + Sim.ValuesGraph funRel store sourceArgs args → + SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction sourceArgs + sourceResult → + Sim.RootsGraph funRel store sourceRest rest → + RootOwnership store (rootsForWorlds argWorlds args ++ rest) → + ∃ fuel store' value, + runCode ctx fuel d store args.reverse d.body = .ok (store', value) + +/-- Unbounded callable progress assembled pointwise over source fuel. -/ +structure FnValueTraceProgressContract (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (ctx : Ctx) (d : FnDef) + (argWorlds : List Owned) (sourceFunction : IxIR0.Value) : Prop where + arity_eq : argWorlds.length = d.arity + progresses : ∀ sourceLimit, + FnValueTraceProgressesAt funRel sourceCtx ctx d argWorlds sourceFunction + sourceLimit + +/-- One callable contract restricted to source-fuel indices below `limit`. -/ +structure FnValueTraceProgressContractBelow (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (ctx : Ctx) (d : FnDef) + (argWorlds : List Owned) (sourceFunction : IxIR0.Value) + (limit : Nat) : Prop where + arity_eq : argWorlds.length = d.arity + progresses : ∀ {sourceLimit}, sourceLimit < limit → + FnValueTraceProgressesAt funRel sourceCtx ctx d argWorlds sourceFunction + sourceLimit + +theorem FnValueTraceProgressContract.below + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + {d : FnDef} {argWorlds : List Owned} + {sourceFunction : IxIR0.Value} + (hcontract : FnValueTraceProgressContract funRel sourceCtx ctx d + argWorlds sourceFunction) (limit : Nat) : + FnValueTraceProgressContractBelow funRel sourceCtx ctx d argWorlds + sourceFunction limit := + ⟨hcontract.arity_eq, fun _ => hcontract.progresses _⟩ + +theorem FnValueTraceProgressContractBelow.mono + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + {d : FnDef} {argWorlds : List Owned} + {sourceFunction : IxIR0.Value} {smaller larger : Nat} + (hcontract : FnValueTraceProgressContractBelow funRel sourceCtx ctx d + argWorlds sourceFunction larger) (hbound : smaller ≤ larger) : + FnValueTraceProgressContractBelow funRel sourceCtx ctx d argWorlds + sourceFunction smaller := + ⟨hcontract.arity_eq, + fun hsource => hcontract.progresses + (Nat.lt_of_lt_of_le hsource hbound)⟩ + +/-- Higher-order target application termination at one exact enclosing +source-fuel index. -/ +def ApplyValueTraceProgressesAt (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (ctx : Ctx) (sourceLimit : Nat) : Prop := + ∀ {store : Store} {function : RVal} {args : List RVal} + {sourceFunction : IxIR0.Value} {sourceArgs : List IxIR0.Value} + {sourceResult : IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root}, + Sim.ValueGraph funRel store sourceFunction function → + Sim.ValuesGraph funRel store sourceArgs args → + SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction sourceArgs + sourceResult → + sourceArgs ≠ [] → + Sim.RootsGraph funRel store sourceRest rest → + RootOwnership store + (⟨.shared, function⟩ :: rootsFor .shared args ++ rest) → + ∃ fuel store' value, + applyGo ctx fuel store function args = .ok (store', value) + +structure ApplyValueTraceProgressContract (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (ctx : Ctx) : Prop where + progresses : ∀ sourceLimit, + ApplyValueTraceProgressesAt funRel sourceCtx ctx sourceLimit + +structure ApplyValueTraceProgressContractBelow (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (ctx : Ctx) (limit : Nat) : Prop where + progresses : ∀ {sourceLimit}, sourceLimit < limit → + ApplyValueTraceProgressesAt funRel sourceCtx ctx sourceLimit + +theorem ApplyValueTraceProgressContract.below + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + (hcontract : ApplyValueTraceProgressContract funRel sourceCtx ctx) + (limit : Nat) : + ApplyValueTraceProgressContractBelow funRel sourceCtx ctx limit := + ⟨fun _ => hcontract.progresses _⟩ + +theorem ApplyValueTraceProgressContractBelow.mono + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + {smaller larger : Nat} + (hcontract : ApplyValueTraceProgressContractBelow funRel sourceCtx ctx + larger) (hbound : smaller ≤ larger) : + ApplyValueTraceProgressContractBelow funRel sourceCtx ctx smaller := + ⟨fun hsource => hcontract.progresses + (Nat.lt_of_lt_of_le hsource hbound)⟩ + +/-- The exact closed reference evaluation retained at a declaration-call +boundary. In particular, a nullary definition's body execution remains +available even though its application spine is empty. -/ +abbrev SourceRefTraceAt (sourceCtx : IxIR0.Ctx) (sourceLimit : Nat) + (address : Ixon.Address) (sourceFunction : IxIR0.Value) : Prop := + IxIR0.ProjectionSafe.Eval sourceCtx sourceLimit [] (.ref address) + sourceFunction + +/-- Pointwise source-backed declaration progress at one source-fuel index. -/ +def SourceFnTraceProgressesAt (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (src : IxIR0.Env) (ctx : Ctx) + (sourceLimit : Nat) : Prop := + ∀ {address : Ixon.Address} {source : IxIR0.Decl} + {worlds : List Owned} {result : Owned} {d : FnDef} + {sourceFunction : IxIR0.Value}, + src address = some source → + sourceCallableSignature source = some (worlds, result) → + ctx.decls address = some (.fn d) → + SourceRefTraceAt sourceCtx sourceLimit address sourceFunction → + FnValueTraceProgressesAt funRel sourceCtx ctx d worlds sourceFunction + sourceLimit + +structure SourceDeclTraceProgressContracts (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (src : IxIR0.Env) (ctx : Ctx) : Prop where + fn_progresses : ∀ sourceLimit, + SourceFnTraceProgressesAt funRel sourceCtx src ctx sourceLimit + +structure SourceDeclTraceProgressContractsBelow (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (src : IxIR0.Env) (ctx : Ctx) + (limit : Nat) : Prop where + fn_progresses : ∀ {sourceLimit}, sourceLimit < limit → + SourceFnTraceProgressesAt funRel sourceCtx src ctx sourceLimit + +theorem SourceDeclTraceProgressContracts.fnContract + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} + {src : IxIR0.Env} {ctx : Ctx} + (hcontracts : SourceDeclTraceProgressContracts funRel sourceCtx src ctx) + {address : Ixon.Address} {source : IxIR0.Decl} + {worlds : List Owned} {result : Owned} {d : FnDef} + {sourceFunction : IxIR0.Value} + (hsrc : src address = some source) + (hsignature : sourceCallableSignature source = some (worlds, result)) + (hdecl : ctx.decls address = some (.fn d)) + (href : SourceRefTraceAt sourceCtx sourceLimit address sourceFunction) : + FnValueTraceProgressesAt funRel sourceCtx ctx d worlds sourceFunction + sourceLimit := + hcontracts.fn_progresses sourceLimit hsrc hsignature hdecl href + +/-- Scalar-oracle termination restricted to a validated source application +trace. Oracle compatibility remains an explicit external boundary. -/ +structure ExternTraceProgressContract (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (ctx : Ctx) : Prop where + progresses : ∀ {sourceLimit : Nat} {store : Store} + {address : Ixon.Address} {arity : Nat} + {sourceFunction sourceResult : IxIR0.Value} + {sourceArgs : List IxIR0.Value} {args : List RVal}, + sourceCtx.env address = some (.extern arity) → + SourceRefValue sourceCtx address sourceFunction → + sourceArgs.length = arity → + SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction sourceArgs + sourceResult → + Sim.ValuesGraph funRel store sourceArgs args → + ∃ result, callScalarOracle ctx address args = .ok result + +/-- Source-fuel-indexed whole-context progress boundary. Unlike +`CompilerProgressContracts`, it asks for target termination only along the +call-aware traces furnished by validated erasure. -/ +structure CompilerTraceProgressContracts (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (src : IxIR0.Env) (ctx : Ctx) : Prop where + decls : SourceDeclTraceProgressContracts funRel sourceCtx src ctx + apply : ApplyValueTraceProgressContract funRel sourceCtx ctx + extern : ExternTraceProgressContract funRel sourceCtx ctx + +structure CompilerTraceProgressContractsBelow (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (src : IxIR0.Env) (ctx : Ctx) + (limit : Nat) : Prop where + decls : SourceDeclTraceProgressContractsBelow funRel sourceCtx src ctx + limit + apply : ApplyValueTraceProgressContractBelow funRel sourceCtx ctx limit + extern : ExternTraceProgressContract funRel sourceCtx ctx + +theorem CompilerTraceProgressContracts.below + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} + {src : IxIR0.Env} {ctx : Ctx} + (hcontracts : CompilerTraceProgressContracts funRel sourceCtx src ctx) + (limit : Nat) : + CompilerTraceProgressContractsBelow funRel sourceCtx src ctx limit := + ⟨⟨fun _ => hcontracts.decls.fn_progresses _⟩, + hcontracts.apply.below limit, hcontracts.extern⟩ + +theorem CompilerTraceProgressContractsBelow.mono + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} + {src : IxIR0.Env} {ctx : Ctx} {smaller larger : Nat} + (hcontracts : CompilerTraceProgressContractsBelow funRel sourceCtx src + ctx larger) (hbound : smaller ≤ larger) : + CompilerTraceProgressContractsBelow funRel sourceCtx src ctx smaller := + ⟨⟨fun hsource => hcontracts.decls.fn_progresses + (Nat.lt_of_lt_of_le hsource hbound)⟩, + hcontracts.apply.mono hbound, hcontracts.extern⟩ + +/-- Simultaneous source-fuel seal for declaration and higher-order progress. +The step at `limit` may use both callable families only at strictly smaller +source indices. -/ +theorem compilerTraceProgressContracts_of_below_step + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} + {src : IxIR0.Env} {ctx : Ctx} + (hextern : ExternTraceProgressContract funRel sourceCtx ctx) + (hstep : ∀ limit, + CompilerTraceProgressContractsBelow funRel sourceCtx src ctx limit → + SourceFnTraceProgressesAt funRel sourceCtx src ctx limit ∧ + ApplyValueTraceProgressesAt funRel sourceCtx ctx limit) : + CompilerTraceProgressContracts funRel sourceCtx src ctx := by + have hall : ∀ limit, + SourceFnTraceProgressesAt funRel sourceCtx src ctx limit ∧ + ApplyValueTraceProgressesAt funRel sourceCtx ctx limit := by + intro limit + induction limit using Nat.strongRecOn with + | ind limit ih => + apply hstep limit + refine ⟨⟨?_⟩, ⟨?_⟩, hextern⟩ + · intro prior hprior + exact (ih prior hprior).1 + · intro prior hprior + exact (ih prior hprior).2 + exact ⟨⟨fun limit => (hall limit).1⟩, + ⟨fun limit => (hall limit).2⟩, hextern⟩ + +/-- Current-self progress available strictly below one enclosing source +fuel. Its ownership and value components are the already sealed semantic +contracts; only termination is source-fuel bounded. -/ +structure CurrentSelfTraceProgressContractBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) : Prop + extends CurrentSelfValueContract funRel recSelfRel sourceCtx ctx cur where + progress : ∀ {sourceFunction : IxIR0.Value} {arity : Nat}, + recSelfRel sourceFunction arity → + FnValueTraceProgressContractBelow funRel sourceCtx ctx cur + (List.replicate arity .shared) sourceFunction limit + +/-- During exact-trace lowering, a bounded current-self contract is needed +only when the compiler environment actually contains a synthetic `recSelf` +entry. -/ +def SelfTraceProgressAvailableBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) (input : VEnv) : Prop := + CurrentSelfTraceProgressContractBelow funRel recSelfRel sourceCtx ctx cur + limit ∨ + NoRecSelf input + +theorem SelfTraceProgressAvailableBelow.valueAvailable + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {input : VEnv} + (havailable : SelfTraceProgressAvailableBelow funRel recSelfRel + sourceCtx ctx cur limit input) : + SelfValueAvailable funRel recSelfRel sourceCtx ctx cur input := by + cases havailable with + | inl hcontract => exact Or.inl hcontract.toCurrentSelfValueContract + | inr hno => exact Or.inr hno + +theorem SelfTraceProgressAvailableBelow.of_contract + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {input : VEnv} + (hcontract : CurrentSelfTraceProgressContractBelow funRel recSelfRel + sourceCtx ctx cur limit) : + SelfTraceProgressAvailableBelow funRel recSelfRel sourceCtx ctx cur + limit input := + Or.inl hcontract + +theorem SelfTraceProgressAvailableBelow.of_noRecSelf + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {input : VEnv} + (hno : NoRecSelf input) : + SelfTraceProgressAvailableBelow funRel recSelfRel sourceCtx ctx cur + limit input := + Or.inr hno + +theorem SelfTraceProgressAvailableBelow.mapNoRecSelf + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {input output : VEnv} + (havailable : SelfTraceProgressAvailableBelow funRel recSelfRel + sourceCtx ctx cur limit input) + (hpreserve : NoRecSelf input → NoRecSelf output) : + SelfTraceProgressAvailableBelow funRel recSelfRel sourceCtx ctx cur + limit output := by + cases havailable with + | inl hcontract => exact Or.inl hcontract + | inr hno => exact Or.inr (hpreserve hno) + +theorem SelfTraceProgressAvailableBelow.bump + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {input : VEnv} + (havailable : SelfTraceProgressAvailableBelow funRel recSelfRel + sourceCtx ctx cur limit input) : + SelfTraceProgressAvailableBelow funRel recSelfRel sourceCtx ctx cur + limit input.bump := + havailable.mapNoRecSelf NoRecSelf.bump + +theorem SelfTraceProgressAvailableBelow.lowerE + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {world : Owned} {expr : IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (havailable : SelfTraceProgressAvailableBelow funRel recSelfRel + sourceCtx ctx cur limit input) + (hrun : (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState) : + SelfTraceProgressAvailableBelow funRel recSelfRel sourceCtx ctx cur + limit output := + havailable.mapNoRecSelf + (fun hno => (lowerPreservesNoRecSelf src fuel).expr hrun hno) + +theorem SelfTraceProgressAvailableBelow.lowerBorrow + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {expr : IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {av : AVal} {release : Bool} + (havailable : SelfTraceProgressAvailableBelow funRel recSelfRel + sourceCtx ctx cur limit input) + (hrun : (lowerBorrow src fuel input expr).run state = + .ok (output, emit, av, release) finalState) : + SelfTraceProgressAvailableBelow funRel recSelfRel sourceCtx ctx cur + limit output := + havailable.mapNoRecSelf + (fun hno => (lowerPreservesNoRecSelf src fuel).borrow hrun hno) + +theorem SelfTraceProgressAvailableBelow.lowerArgs + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {args : List (IxIR0.Expr × Owned)} {state finalState : LowSt} + {emit : Emit} {avs : List AVal} + (havailable : SelfTraceProgressAvailableBelow funRel recSelfRel + sourceCtx ctx cur limit input) + (hrun : (lowerArgs src fuel input args).run state = + .ok (output, emit, avs) finalState) : + SelfTraceProgressAvailableBelow funRel recSelfRel sourceCtx ctx cur + limit output := + havailable.mapNoRecSelf + (fun hno => (lowerPreservesNoRecSelf src fuel).args hrun hno) + +/-- Total-correctness companion of `FnValueContract`. Termination is +conditioned on a successful source application spine, which is essential for +recursive declarations that need not terminate on arbitrary arguments. -/ +structure FnValueProgressContract (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (ctx : Ctx) (d : FnDef) + (argWorlds : List Owned) (sourceFunction : IxIR0.Value) : Prop where + arity_eq : argWorlds.length = d.arity + progresses : ∀ {store : Store} {args : List RVal} + {sourceArgs : List IxIR0.Value} {sourceResult : IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root}, + args.length = argWorlds.length → + Sim.ValuesGraph funRel store sourceArgs args → + SourceApplies sourceCtx sourceFunction sourceArgs sourceResult → + Sim.RootsGraph funRel store sourceRest rest → + RootOwnership store (rootsForWorlds argWorlds args ++ rest) → + ∃ fuel store' value, + runCode ctx fuel d store args.reverse d.body = .ok (store', value) + +/-- Total-correctness companion of `ApplyValueContract`. -/ +structure ApplyValueProgressContract (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (ctx : Ctx) : Prop where + progresses : ∀ {store : Store} {function : RVal} {args : List RVal} + {sourceFunction : IxIR0.Value} {sourceArgs : List IxIR0.Value} + {sourceResult : IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root}, + Sim.ValueGraph funRel store sourceFunction function → + Sim.ValuesGraph funRel store sourceArgs args → + SourceApplies sourceCtx sourceFunction sourceArgs sourceResult → + Sim.RootsGraph funRel store sourceRest rest → + RootOwnership store + (⟨.shared, function⟩ :: rootsFor .shared args ++ rest) → + ∃ fuel store' value, + applyGo ctx fuel store function args = .ok (store', value) + +/-- Total-correctness companion of `ExternValueContract`. The source +application witness selects a terminating oracle application; this contract +states that the target scalar oracle is defined on the related arguments. -/ +structure ExternProgressContract (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (ctx : Ctx) : Prop where + progresses : ∀ {store : Store} {address : Ixon.Address} {arity : Nat} + {sourceFunction sourceResult : IxIR0.Value} + {sourceArgs : List IxIR0.Value} {args : List RVal}, + sourceCtx.env address = some (.extern arity) → + SourceRefValue sourceCtx address sourceFunction → + sourceArgs.length = arity → + SourceApplies sourceCtx sourceFunction sourceArgs sourceResult → + Sim.ValuesGraph funRel store sourceArgs args → + ∃ result, callScalarOracle ctx address args = .ok result + +/-- The existing oracle-totality boundary is strong enough for the +trace-indexed interface; the latter merely restricts its call witnesses. -/ +theorem ExternProgressContract.toTrace + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + (hcontract : ExternProgressContract funRel sourceCtx ctx) : + ExternTraceProgressContract funRel sourceCtx ctx := by + refine ⟨?_⟩ + intro sourceLimit store address arity sourceFunction sourceResult + sourceArgs args hdecl href hlength hsource hargs + exact hcontract.progresses hdecl href hlength hsource.sourceApplies hargs + +/-- Pointwise progress of every source-backed target declaration. Source +identity is pinned by the same layout and reference premises as the semantic +declaration contracts. -/ +def SourceFnProgresses (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (src : IxIR0.Env) (ctx : Ctx) : Prop := + ∀ {address : Ixon.Address} {source : IxIR0.Decl} + {worlds : List Owned} {result : Owned} {d : FnDef} + {sourceFunction : IxIR0.Value}, + src address = some source → + sourceCallableSignature source = some (worlds, result) → + ctx.decls address = some (.fn d) → + SourceRefValue sourceCtx address sourceFunction → + FnValueProgressContract funRel sourceCtx ctx d worlds sourceFunction + +/-- Declaration-level package for source-guided target termination. -/ +structure SourceDeclProgressContracts (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (src : IxIR0.Env) (ctx : Ctx) : Prop where + fn_progresses : SourceFnProgresses funRel sourceCtx src ctx + +theorem SourceDeclProgressContracts.fnContract + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} + {src : IxIR0.Env} {ctx : Ctx} + (hcontracts : SourceDeclProgressContracts funRel sourceCtx src ctx) + {address : Ixon.Address} {source : IxIR0.Decl} + {worlds : List Owned} {result : Owned} {d : FnDef} + {sourceFunction : IxIR0.Value} + (hsrc : src address = some source) + (hsignature : sourceCallableSignature source = some (worlds, result)) + (hdecl : ctx.decls address = some (.fn d)) + (href : SourceRefValue sourceCtx address sourceFunction) : + FnValueProgressContract funRel sourceCtx ctx d worlds sourceFunction := + hcontracts.fn_progresses hsrc hsignature hdecl href + +/-- Whole-context source-guided progress boundary. It deliberately stays +parallel to `CompilerContracts` and `CompilerValueContracts`: termination, +ownership, and value correspondence can then be constructed and audited as +three independent obligations. -/ +structure CompilerProgressContracts (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (src : IxIR0.Env) (ctx : Ctx) : Prop where + decls : SourceDeclProgressContracts funRel sourceCtx src ctx + apply : ApplyValueProgressContract funRel sourceCtx ctx + extern : ExternProgressContract funRel sourceCtx ctx + +/-- Current-self package used by progressing recursor-rule environments. +It refines the existing ownership/value package with termination for each +source application represented by the synthetic self entry. -/ +structure CurrentSelfProgressContract (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) : Prop + extends CurrentSelfValueContract funRel recSelfRel sourceCtx ctx cur where + progress : ∀ {sourceFunction : IxIR0.Value} {arity : Nat}, + recSelfRel sourceFunction arity → + FnValueProgressContract funRel sourceCtx ctx cur + (List.replicate arity .shared) sourceFunction + +/-- Current-self progress is substantive in recursor environments and +irrelevant in ordinary environments that contain no synthetic self entry. -/ +def SelfProgressAvailable (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (input : VEnv) : Prop := + CurrentSelfProgressContract funRel recSelfRel sourceCtx ctx cur ∨ + NoRecSelf input + +theorem SelfProgressAvailable.valueAvailable + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {input : VEnv} + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + SelfValueAvailable funRel recSelfRel sourceCtx ctx cur input := by + cases havailable with + | inl hcontract => exact Or.inl hcontract.toCurrentSelfValueContract + | inr hno => exact Or.inr hno + +theorem SelfProgressAvailable.of_contract + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {input : VEnv} + (hcontract : CurrentSelfProgressContract funRel recSelfRel sourceCtx + ctx cur) : + SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur input := + Or.inl hcontract + +theorem SelfProgressAvailable.of_noRecSelf + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {input : VEnv} + (hno : NoRecSelf input) : + SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur input := + Or.inr hno + +theorem SelfProgressAvailable.mapNoRecSelf + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) + (hpreserve : NoRecSelf input → NoRecSelf output) : + SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur output := by + cases havailable with + | inl hcontract => exact Or.inl hcontract + | inr hno => exact Or.inr (hpreserve hno) + +theorem SelfProgressAvailable.bump + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {input : VEnv} + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur input.bump := + havailable.mapNoRecSelf NoRecSelf.bump + +theorem SelfProgressAvailable.lowerE + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {world : Owned} {expr : IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) + (hrun : (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState) : + SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur output := + havailable.mapNoRecSelf + (fun hno => (lowerPreservesNoRecSelf src fuel).expr hrun hno) + +theorem SelfProgressAvailable.lowerBorrow + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {expr : IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {av : AVal} {release : Bool} + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) + (hrun : (lowerBorrow src fuel input expr).run state = + .ok (output, emit, av, release) finalState) : + SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur output := + havailable.mapNoRecSelf + (fun hno => (lowerPreservesNoRecSelf src fuel).borrow hrun hno) + +theorem SelfProgressAvailable.lowerArgs + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {args : List (IxIR0.Expr × Owned)} {state finalState : LowSt} + {emit : Emit} {avs : List AVal} + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) + (hrun : (lowerArgs src fuel input args).run state = + .ok (output, emit, avs) finalState) : + SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur output := + havailable.mapNoRecSelf + (fun hno => (lowerPreservesNoRecSelf src fuel).args hrun hno) + +/-! ## Projection-safe source evaluation witnesses -/ + +/-- A successful IxIR₀ expression evaluation whose syntactically executed +projections all scrutinize constructors. Calls are intentionally left behind +`SourceApplies`: their bodies are governed by the callable progress contracts +rather than by the caller's syntax tree. In particular, there is no +constructor for IxIR₀'s `.proj`-over-`.erased` absorber. -/ +inductive ProjectionSafeEval (sourceCtx : IxIR0.Ctx) : + List IxIR0.Value → IxIR0.Expr → IxIR0.Value → Prop where + | var {sourceEnv : List IxIR0.Value} {index : Nat} + {value : IxIR0.Value} : + sourceEnv[index]? = some value → + ProjectionSafeEval sourceCtx sourceEnv (.var index) value + | ref {sourceEnv : List IxIR0.Value} {address : Ixon.Address} + {value : IxIR0.Value} : + (∃ fuel, IxIR0.eval sourceCtx fuel sourceEnv (.ref address) = + .ok value) → + ProjectionSafeEval sourceCtx sourceEnv (.ref address) value + | lit {sourceEnv : List IxIR0.Value} {literal : IxIR0.Literal} : + ProjectionSafeEval sourceCtx sourceEnv (.lit literal) (.lit literal) + | erased {sourceEnv : List IxIR0.Value} : + ProjectionSafeEval sourceCtx sourceEnv .erased .erased + | lam {sourceEnv : List IxIR0.Value} {uses : Uses} + {body : IxIR0.Expr} : + ProjectionSafeEval sourceCtx sourceEnv (.lam uses body) + (.clos uses sourceEnv body) + | letE {sourceEnv : List IxIR0.Value} {uses : Uses} + {value body : IxIR0.Expr} {bound result : IxIR0.Value} : + ProjectionSafeEval sourceCtx sourceEnv value bound → + ProjectionSafeEval sourceCtx (bound :: sourceEnv) body result → + ProjectionSafeEval sourceCtx sourceEnv (.letE uses value body) result + | app {sourceEnv : List IxIR0.Value} {function argument : IxIR0.Expr} + {sourceFunction sourceArgument result : IxIR0.Value} : + ProjectionSafeEval sourceCtx sourceEnv function sourceFunction → + ProjectionSafeEval sourceCtx sourceEnv argument sourceArgument → + (∃ fuel, IxIR0.apply sourceCtx fuel sourceFunction sourceArgument = + .ok result) → + ProjectionSafeEval sourceCtx sourceEnv (.app function argument) result + | proj {sourceEnv : List IxIR0.Value} {index : Nat} + {source : IxIR0.Expr} {address : Ixon.Address} {tag : Nat} + {fields : List IxIR0.Value} {result : IxIR0.Value} : + ProjectionSafeEval sourceCtx sourceEnv source + (.ctor address tag fields) → + fields[index]? = some result → + ProjectionSafeEval sourceCtx sourceEnv (.proj index source) result + +/-- Forget the exact call-aware evaluator trace while retaining the shallow +expression witness consumed by the existing lowering progress induction. -/ +theorem ProjectionSafeEval.of_trace + {sourceCtx : IxIR0.Ctx} {sourceFuel : Nat} + {sourceEnv : List IxIR0.Value} {source : IxIR0.Expr} + {sourceValue : IxIR0.Value} + (htrace : IxIR0.ProjectionSafe.Eval sourceCtx sourceFuel sourceEnv + source sourceValue) : + ProjectionSafeEval sourceCtx sourceEnv source sourceValue := by + induction sourceFuel using Nat.strongRecOn generalizing sourceEnv source + sourceValue with + | ind sourceFuel ih => + have hrun := htrace.run + cases htrace with + | var hlookup => exact .var hlookup + | lit => exact .lit + | erased => exact .erased + | lam => exact .lam + | letE hvalue hbody => + exact .letE (ih _ (by omega) hvalue) (ih _ (by omega) hbody) + | app hfunction hargument happly => + exact .app (ih _ (by omega) hfunction) + (ih _ (by omega) hargument) ⟨_, happly.run⟩ + | proj hsource hfield => exact .proj (ih _ (by omega) hsource) hfield + | refDefn hdecl hbody => + exact .ref ⟨_, + (IxIR0.ProjectionSafe.Eval.refDefn hdecl hbody).run⟩ + | refCtor hdecl hsaturate => + exact .ref ⟨_, + (IxIR0.ProjectionSafe.Eval.refCtor hdecl hsaturate).run⟩ + | refRecursor hdecl => + exact .ref ⟨_, hrun⟩ + | refExtern hdecl hsaturate => + exact .ref ⟨_, + (IxIR0.ProjectionSafe.Eval.refExtern hdecl hsaturate).run⟩ + +/-- Fuel-free call-aware termination implies the existing projection-safe +expression predicate. -/ +theorem ProjectionSafeEval.of_terminates + {sourceCtx : IxIR0.Ctx} {sourceEnv : List IxIR0.Value} + {source : IxIR0.Expr} {sourceValue : IxIR0.Value} + (htrace : IxIR0.ProjectionSafe.Terminates sourceCtx sourceEnv source + sourceValue) : + ProjectionSafeEval sourceCtx sourceEnv source sourceValue := by + obtain ⟨sourceFuel, htrace⟩ := htrace + exact ProjectionSafeEval.of_trace htrace + +/-- A projection-safe witness contains an ordinary successful evaluation at +some sufficient fuel. -/ +theorem ProjectionSafeEval.eval {sourceCtx : IxIR0.Ctx} : + ∀ {sourceEnv : List IxIR0.Value} {expr : IxIR0.Expr} + {value : IxIR0.Value}, + ProjectionSafeEval sourceCtx sourceEnv expr value → + ∃ fuel, IxIR0.eval sourceCtx fuel sourceEnv expr = .ok value + | _, _, _, .var hlookup => by + refine ⟨1, ?_⟩ + simp [IxIR0.eval, hlookup] + | _, _, _, .ref heval => heval + | _, _, _, .lit => ⟨1, by simp [IxIR0.eval]⟩ + | _, _, _, .erased => ⟨1, by simp [IxIR0.eval]⟩ + | _, _, _, .lam => ⟨1, by simp [IxIR0.eval]⟩ + | _, _, _, .letE hvalue hbody => by + obtain ⟨valueFuel, hvalueRun⟩ := hvalue.eval + obtain ⟨bodyFuel, hbodyRun⟩ := hbody.eval + let common := max valueFuel bodyFuel + refine ⟨common + 1, ?_⟩ + rw [IxIR0.eval.eq_def] + dsimp only + rw [IxIR0.eval_mono (Nat.le_max_left _ _) hvalueRun, bindOk] + exact IxIR0.eval_mono (Nat.le_max_right _ _) hbodyRun + | _, _, _, .app hfunction hargument happly => by + obtain ⟨functionFuel, hfunctionRun⟩ := hfunction.eval + obtain ⟨argumentFuel, hargumentRun⟩ := hargument.eval + obtain ⟨applyFuel, happlyRun⟩ := happly + let common := max functionFuel (max argumentFuel applyFuel) + have hfunctionLe : functionFuel ≤ common := Nat.le_max_left _ _ + have hargumentLe : argumentFuel ≤ common := + Nat.le_trans (Nat.le_max_left _ _) (Nat.le_max_right _ _) + have happlyLe : applyFuel ≤ common := + Nat.le_trans (Nat.le_max_right _ _) (Nat.le_max_right _ _) + refine ⟨common + 1, ?_⟩ + rw [IxIR0.eval.eq_def] + dsimp only + rw [IxIR0.eval_mono hfunctionLe hfunctionRun, bindOk] + rw [IxIR0.eval_mono hargumentLe hargumentRun, bindOk] + exact IxIR0.apply_mono happlyLe happlyRun + | _, _, _, .proj hsource hfield => by + obtain ⟨sourceFuel, hsourceRun⟩ := hsource.eval + refine ⟨sourceFuel + 1, ?_⟩ + rw [IxIR0.eval.eq_def] + dsimp only + rw [hsourceRun, bindOk] + dsimp only + rw [hfield] + +/-- Pointwise projection-safe evaluation of an argument list. -/ +inductive ProjectionSafeArgs (sourceCtx : IxIR0.Ctx) + (sourceEnv : List IxIR0.Value) : + List IxIR0.Expr → List IxIR0.Value → Prop where + | nil : ProjectionSafeArgs sourceCtx sourceEnv [] [] + | cons {expr : IxIR0.Expr} {value : IxIR0.Value} + {expressions : List IxIR0.Expr} {values : List IxIR0.Value} : + ProjectionSafeEval sourceCtx sourceEnv expr value → + ProjectionSafeArgs sourceCtx sourceEnv expressions values → + ProjectionSafeArgs sourceCtx sourceEnv + (expr :: expressions) (value :: values) + +/-- Dependent lockstep traversal of projection-safe source arguments and +their values. Each callback receives the exact head safety witness and the +original tail derivation together with the recursively produced result. -/ +theorem ProjectionSafeArgs.traverse {sourceCtx : IxIR0.Ctx} + {sourceEnv : List IxIR0.Value} + {Result : List IxIR0.Expr → List IxIR0.Value → Prop} + (hnil : Result [] []) + (hcons : ∀ {expr : IxIR0.Expr} {value : IxIR0.Value} + {expressions : List IxIR0.Expr} {values : List IxIR0.Value}, + ProjectionSafeEval sourceCtx sourceEnv expr value → + ProjectionSafeArgs sourceCtx sourceEnv expressions values → + Result expressions values → + Result (expr :: expressions) (value :: values)) + {expressions : List IxIR0.Expr} {values : List IxIR0.Value} + (hargs : ProjectionSafeArgs sourceCtx sourceEnv expressions values) : + Result expressions values := by + induction hargs with + | nil => exact hnil + | cons hhead htail ih => exact hcons hhead htail ih + +@[simp] theorem ProjectionSafeArgs.lengths {sourceCtx : IxIR0.Ctx} + {sourceEnv : List IxIR0.Value} {expressions : List IxIR0.Expr} + {values : List IxIR0.Value} + (hargs : ProjectionSafeArgs sourceCtx sourceEnv expressions values) : + expressions.length = values.length := by + exact ProjectionSafeArgs.traverse + (Result := fun currentExpressions currentValues => + currentExpressions.length = currentValues.length) + (hnil := rfl) + (hcons := by + intro expr value currentExpressions currentValues hhead htail ih + simp [ih]) + hargs + +/-- Forget projection evidence and retain the ordinary argument-evaluation +relation consumed by the semantic lowering lemmas. -/ +theorem ProjectionSafeArgs.evals {sourceCtx : IxIR0.Ctx} + {sourceEnv : List IxIR0.Value} {expressions : List IxIR0.Expr} + {values : List IxIR0.Value} + (hargs : ProjectionSafeArgs sourceCtx sourceEnv expressions values) : + SourceArgsEval sourceCtx sourceEnv expressions values := by + exact ProjectionSafeArgs.traverse + (Result := fun currentExpressions currentValues => + SourceArgsEval sourceCtx sourceEnv currentExpressions currentValues) + (hnil := .nil) + (hcons := by + intro expr value currentExpressions currentValues hhead htail ih + obtain ⟨fuel, hrun⟩ := hhead.eval + exact .cons hrun ih) + hargs + +/-- Projection safety is inherited by every argument prefix. -/ +theorem ProjectionSafeArgs.take {sourceCtx : IxIR0.Ctx} + {sourceEnv : List IxIR0.Value} {expressions : List IxIR0.Expr} + {values : List IxIR0.Value} + (hargs : ProjectionSafeArgs sourceCtx sourceEnv expressions values) + (count : Nat) : + ProjectionSafeArgs sourceCtx sourceEnv (expressions.take count) + (values.take count) := by + exact (ProjectionSafeArgs.traverse + (Result := fun currentExpressions currentValues => + ∀ currentCount, + ProjectionSafeArgs sourceCtx sourceEnv + (currentExpressions.take currentCount) + (currentValues.take currentCount)) + (hnil := by + intro currentCount + simp + exact .nil) + (hcons := by + intro expr value currentExpressions currentValues hhead htail ih + currentCount + cases currentCount with + | zero => exact .nil + | succ currentCount => + simpa using ProjectionSafeArgs.cons hhead (ih currentCount)) + hargs) count + +/-- Projection safety is inherited by every argument suffix. -/ +theorem ProjectionSafeArgs.drop {sourceCtx : IxIR0.Ctx} + {sourceEnv : List IxIR0.Value} {expressions : List IxIR0.Expr} + {values : List IxIR0.Value} + (hargs : ProjectionSafeArgs sourceCtx sourceEnv expressions values) + (count : Nat) : + ProjectionSafeArgs sourceCtx sourceEnv (expressions.drop count) + (values.drop count) := by + exact (ProjectionSafeArgs.traverse + (Result := fun currentExpressions currentValues => + ∀ currentCount, + ProjectionSafeArgs sourceCtx sourceEnv + (currentExpressions.drop currentCount) + (currentValues.drop currentCount)) + (hnil := by + intro currentCount + simp + exact .nil) + (hcons := by + intro expr value currentExpressions currentValues hhead htail ih + currentCount + cases currentCount with + | zero => exact .cons hhead htail + | succ currentCount => simpa using ih currentCount) + hargs) count + +/-- Projection-safe semantic evaluation of a flattened application spine. -/ +inductive ProjectionSafeSpine (sourceCtx : IxIR0.Ctx) + (sourceEnv : List IxIR0.Value) (head : IxIR0.Expr) + (arguments : List IxIR0.Expr) (result : IxIR0.Value) : Prop where + | intro {headValue : IxIR0.Value} + {argumentValues : List IxIR0.Value} : + ProjectionSafeEval sourceCtx sourceEnv head headValue → + ProjectionSafeArgs sourceCtx sourceEnv arguments argumentValues → + SourceApplies sourceCtx headValue argumentValues result → + ProjectionSafeSpine sourceCtx sourceEnv head arguments result + +/-- Dependent eliminator for projection-safe source-spine semantics. The +wrapper's hidden head and argument values are exposed in one constructor-local +place while clients retain the indexed safety and application evidence. -/ +theorem ProjectionSafeSpine.eliminate + {sourceCtx : IxIR0.Ctx} {sourceEnv : List IxIR0.Value} + {head : IxIR0.Expr} {arguments : List IxIR0.Expr} + {result : IxIR0.Value} {Result : Prop} + (hspine : ProjectionSafeSpine sourceCtx sourceEnv head arguments result) + (hintro : ∀ {headValue : IxIR0.Value} + {argumentValues : List IxIR0.Value}, + ProjectionSafeEval sourceCtx sourceEnv head headValue → + ProjectionSafeArgs sourceCtx sourceEnv arguments argumentValues → + SourceApplies sourceCtx headValue argumentValues result → + Result) : + Result := by + cases hspine with + | intro hhead harguments happlies => + exact hintro hhead harguments happlies + +/-- Forget projection evidence and retain the existing source-spine +evaluation relation. -/ +theorem ProjectionSafeSpine.spineEval {sourceCtx : IxIR0.Ctx} + {sourceEnv : List IxIR0.Value} {head : IxIR0.Expr} + {arguments : List IxIR0.Expr} {result : IxIR0.Value} + (hspine : ProjectionSafeSpine sourceCtx sourceEnv head arguments result) : + SourceSpineEval sourceCtx sourceEnv head arguments result := by + apply hspine.eliminate + · intro _ _ hhead hargs happlies + exact .intro hhead.eval hargs.evals happlies + +/-- A projection-safe head evaluation is the empty-argument safe spine. -/ +theorem ProjectionSafeSpine.of_eval_nil {sourceCtx : IxIR0.Ctx} + {sourceEnv : List IxIR0.Value} {head : IxIR0.Expr} + {result : IxIR0.Value} + (heval : ProjectionSafeEval sourceCtx sourceEnv head result) : + ProjectionSafeSpine sourceCtx sourceEnv head [] result := + .intro heval .nil .nil + +/-- One projection-safe application evaluation becomes the singleton +flattened spine used by the lowering's application branch. -/ +theorem ProjectionSafeSpine.of_eval_app {sourceCtx : IxIR0.Ctx} + {sourceEnv : List IxIR0.Value} {function argument : IxIR0.Expr} + {result : IxIR0.Value} + (heval : ProjectionSafeEval sourceCtx sourceEnv + (.app function argument) result) : + ProjectionSafeSpine sourceCtx sourceEnv function [argument] result := by + cases heval with + | app hfunction hargument happly => + exact .intro hfunction (.cons hargument .nil) (.cons happly.choose_spec .nil) + +/-- Flatten one more syntactic application while preserving all projection +evidence for its function and argument. -/ +theorem ProjectionSafeSpine.flattenApp {sourceCtx : IxIR0.Ctx} + {sourceEnv : List IxIR0.Value} {function argument : IxIR0.Expr} + {arguments : List IxIR0.Expr} {result : IxIR0.Value} + (hspine : ProjectionSafeSpine sourceCtx sourceEnv + (.app function argument) arguments result) : + ProjectionSafeSpine sourceCtx sourceEnv function + (argument :: arguments) result := by + apply hspine.eliminate + · intro _ _ hhead harguments happlies + cases hhead with + | app hfunction hargument happly => + exact .intro hfunction (.cons hargument harguments) + (.cons happly.choose_spec happlies) + +/-- Expose the closed source reference identity while retaining the +projection-safe argument trace. -/ +theorem ProjectionSafeSpine.refData {sourceCtx : IxIR0.Ctx} + {sourceEnv : List IxIR0.Value} {address : Ixon.Address} + {arguments : List IxIR0.Expr} {result : IxIR0.Value} + (hspine : ProjectionSafeSpine sourceCtx sourceEnv (.ref address) + arguments result) : + ∃ sourceFunction sourceArguments, + SourceRefValue sourceCtx address sourceFunction ∧ + ProjectionSafeArgs sourceCtx sourceEnv arguments sourceArguments ∧ + SourceApplies sourceCtx sourceFunction sourceArguments result := by + apply hspine.eliminate + · intro headValue argumentValues hhead harguments happlies + obtain ⟨fuel, hheadRun⟩ := hhead.eval + exact ⟨headValue, argumentValues, + ⟨fuel, sourceEval_ref_closed hheadRun⟩, harguments, happlies⟩ + +/-! ### Call-aware source spines -/ + +/-- Convert exact fuel-indexed argument traces to the shallow argument +invariant used by the established non-call lowering rules. -/ +theorem projectionSafeArgs_of_traces + {sourceCtx : IxIR0.Ctx} {limit : Nat} + {sourceEnv : List IxIR0.Value} {arguments : List IxIR0.Expr} + {argumentValues : List IxIR0.Value} + (hargs : IxIR0.ProjectionSafe.EvalsBelow sourceCtx limit sourceEnv + arguments argumentValues) : + ProjectionSafeArgs sourceCtx sourceEnv arguments argumentValues := by + exact IxIR0.ProjectionSafe.EvalsBelow.traverse + (Result := fun currentArguments currentValues => + ProjectionSafeArgs sourceCtx sourceEnv currentArguments currentValues) + (hnil := .nil) + (hcons := by + intro fuel expr value currentArguments currentValues hfuel htrace + htail ih + exact .cons (ProjectionSafeEval.of_trace htrace) ih) + hargs + +/-- Forget exact fuels while retaining the existing projection-safe flattened +spine. -/ +theorem projectionSafeSpine_of_trace + {sourceCtx : IxIR0.Ctx} {limit : Nat} + {sourceEnv : List IxIR0.Value} {head : IxIR0.Expr} + {arguments : List IxIR0.Expr} {result : IxIR0.Value} + (hspine : IxIR0.ProjectionSafe.Spine sourceCtx limit sourceEnv head + arguments result) : + ProjectionSafeSpine sourceCtx sourceEnv head arguments result := by + cases hspine with + | intro _ hhead hargs happlies => + exact .intro (ProjectionSafeEval.of_trace hhead) + (projectionSafeArgs_of_traces hargs) + (SourceAppliesSafelyBelow.sourceApplies happlies) + +/-- Expose a reference-headed call while retaining its bounded call trace. +This is the direct-call input to source-fuel-indexed declaration progress. -/ +theorem callAwareProjectionSafeSpine_refData + {sourceCtx : IxIR0.Ctx} {limit : Nat} + {sourceEnv : List IxIR0.Value} {address : Ixon.Address} + {arguments : List IxIR0.Expr} {result : IxIR0.Value} + (hspine : IxIR0.ProjectionSafe.Spine sourceCtx limit sourceEnv + (.ref address) arguments result) : + ∃ sourceFunction sourceArguments, + SourceRefValue sourceCtx address sourceFunction ∧ + SourceRefTraceAt sourceCtx limit address sourceFunction ∧ + IxIR0.ProjectionSafe.EvalsBelow sourceCtx limit sourceEnv arguments + sourceArguments ∧ + SourceAppliesSafelyBelow sourceCtx limit sourceFunction sourceArguments + result := by + cases hspine with + | @intro headFuel sourceFunction _ _ _ sourceArguments hheadBound hhead + harguments happlies => + exact ⟨sourceFunction, sourceArguments, + ⟨headFuel, sourceEval_ref_closed hhead.run⟩, + (hhead.ref_closed.mono_le hheadBound), harguments, happlies⟩ + +/-! ### Exact source saturation -/ + +/-- Every non-erased exact application needs at least two source-evaluator +fuel units: one for `apply` itself and one for the selected closure or +saturation constructor. -/ +theorem projectionSafeApply_two_le_of_function_ne_erased + {sourceCtx : IxIR0.Ctx} {fuel : Nat} + {function argument result : IxIR0.Value} + (htrace : IxIR0.ProjectionSafe.Apply sourceCtx fuel function argument + result) + (hne : function ≠ .erased) : + 2 ≤ fuel := by + cases htrace with + | clos hbody => cases hbody <;> omega + | pap hsaturate => cases hsaturate <;> omega + | erased => exact (hne rfl).elim + +/-- A nonempty bounded application spine from a non-erased function forces +the common source bound above the canonical two-fuel replay threshold. -/ +theorem SourceAppliesSafelyBelow.two_lt_limit_of_nonempty + {sourceCtx : IxIR0.Ctx} {limit : Nat} + {function result : IxIR0.Value} {arguments : List IxIR0.Value} + (hspine : SourceAppliesSafelyBelow sourceCtx limit function arguments + result) + (hne : function ≠ .erased) (hnonempty : arguments ≠ []) : + 2 < limit := by + cases hspine with + | nil => exact (hnonempty rfl).elim + | cons hfuel hstep _ => + exact Nat.lt_of_le_of_lt + (projectionSafeApply_two_le_of_function_ne_erased hstep hne) hfuel + +/-- Replay a residual leading-lambda prefix with canonical exact traces. +Each under-saturated closure step evaluates only the next lambda, so fuel +two suffices independently of how the prefix was originally reached. -/ +theorem LambdaPrefix.toAppliesBelow + {sourceCtx : IxIR0.Ctx} {limit : Nat} + {sourceEnv : List IxIR0.Value} {expr : IxIR0.Expr} + {arguments : List IxIR0.Value} {value : IxIR0.Value} + (hprefix : LambdaPrefix sourceEnv expr arguments value) + (hbound : 2 < limit) : + ∃ uses body, expr = .lam uses body ∧ + SourceAppliesSafelyBelow sourceCtx limit + (.clos uses sourceEnv body) arguments value := by + apply LambdaPrefix.traverse + (Result := fun currentEnv currentExpr currentArguments currentValue => + ∃ uses body, currentExpr = .lam uses body ∧ + SourceAppliesSafelyBelow sourceCtx limit + (.clos uses currentEnv body) currentArguments currentValue) + (h := hprefix) + · intro currentEnv uses body + exact ⟨uses, body, rfl, .nil⟩ + · intro currentEnv uses body argument currentArguments currentValue + hinner ih + obtain ⟨nextUses, nextBody, hbody, htail⟩ := ih + subst body + refine ⟨uses, .lam nextUses nextBody, rfl, + .cons hbound ?_ htail⟩ + exact .clos (.lam (fuel := 0)) + +/-- Replay a residual lambda prefix from a separately identified initial +closure. The empty prefix pins the canonical closure produced by +`toAppliesBelow` to the declaration-reference value used by callers. -/ +theorem LambdaPrefix.toAppliesBelow_from_initial + {sourceCtx : IxIR0.Ctx} {limit : Nat} + {sourceEnv : List IxIR0.Value} {expr : IxIR0.Expr} + {arguments : List IxIR0.Value} + {initial value : IxIR0.Value} + (hinitial : LambdaPrefix sourceEnv expr [] initial) + (hprefix : LambdaPrefix sourceEnv expr arguments value) + (hbound : 2 < limit) : + SourceAppliesSafelyBelow sourceCtx limit initial arguments value := by + obtain ⟨uses, body, hexpr, hcanonical⟩ := + hprefix.toAppliesBelow hbound + subst expr + cases hinitial + exact hcanonical + +/-- Replay any still-underfilled source PAP prefix at canonical fuel two. -/ +theorem projectionSafePap_underfills + {sourceCtx : IxIR0.Ctx} {limit : Nat} {head : IxIR0.Head} + {captures arguments : List IxIR0.Value} + (hbound : 2 < limit) + (hunder : (captures ++ arguments).length < head.arity) : + SourceAppliesSafelyBelow sourceCtx limit (.pap head captures) arguments + (.pap head (captures ++ arguments)) := by + induction arguments generalizing captures with + | nil => simpa using + (IxIR0.ProjectionSafe.AppliesBelow.nil + (ctx := sourceCtx) (limit := limit) + (value := IxIR0.Value.pap head captures)) + | cons argument arguments ih => + have honeUnder : (captures ++ [argument]).length < head.arity := by + simp only [List.length_append, List.length_cons, List.length_nil] + at hunder ⊢ + omega + have hnotLength : (captures ++ [argument]).length ≠ head.arity := + Nat.ne_of_lt honeUnder + have htailUnder : + ((captures ++ [argument]) ++ arguments).length < head.arity := by + simpa [List.append_assoc] using hunder + refine .cons hbound (.pap (.pending hnotLength)) ?_ + simpa [List.append_assoc] using + (ih (captures := captures ++ [argument]) htailUnder) + +/-- A positive-arity definition reference has a canonical exact reference +trace at every source bound of at least two. -/ +theorem SourceRefValue.defnTraceAt_of_positive + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {sourceLimit : Nat} + {address : Ixon.Address} {result : Owned} {body : IxIR0.Expr} + {sourceFunction : IxIR0.Value} + (henv : sourceCtx.env = src) + (hsrc : src address = some (.defn result body)) + (hpositive : 0 < lamArity body) + (href : SourceRefValue sourceCtx address sourceFunction) + (hbound : 2 ≤ sourceLimit) : + SourceRefTraceAt sourceCtx sourceLimit address sourceFunction := by + cases body with + | lam uses body => + obtain ⟨refFuel, hrefRun⟩ := href + have hlookup : sourceCtx.env address = + some (.defn result (.lam uses body)) := by + rw [henv] + exact hsrc + have hcanonical : IxIR0.ProjectionSafe.Eval sourceCtx 2 [] + (.ref address) (.clos uses [] body) := + .refDefn hlookup (.lam (fuel := 0)) + have hfunction : sourceFunction = .clos uses [] body := + sourceEval_ok_unique hrefRun hcanonical.run + subst sourceFunction + exact hcanonical.mono_le hbound + | var => simp [lamArity] at hpositive + | ref => simp [lamArity] at hpositive + | app => simp [lamArity] at hpositive + | letE => simp [lamArity] at hpositive + | proj => simp [lamArity] at hpositive + | lit => simp [lamArity] at hpositive + | erased => simp [lamArity] at hpositive + +/-- A positive-arity extern reference likewise has a canonical exact pending +PAP trace at every source bound of at least two. -/ +theorem SourceRefValue.externTraceAt_of_positive + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {sourceLimit : Nat} + {address : Ixon.Address} {arity : Nat} + {sourceFunction : IxIR0.Value} + (henv : sourceCtx.env = src) + (hsrc : src address = some (.extern arity)) + (hpositive : 0 < arity) + (href : SourceRefValue sourceCtx address sourceFunction) + (hbound : 2 ≤ sourceLimit) : + SourceRefTraceAt sourceCtx sourceLimit address sourceFunction := by + have hfunction := href.externPap henv hsrc hpositive + subst sourceFunction + have hlookup : sourceCtx.env address = some (.extern arity) := by + rw [henv] + exact hsrc + have hcanonical : IxIR0.ProjectionSafe.Eval sourceCtx 2 [] + (.ref address) (.pap (.ext address arity) []) := by + exact .refExtern hlookup (.pending (by + simpa [IxIR0.Head.arity] using Nat.ne_of_lt hpositive)) + exact hcanonical.mono_le hbound + +/-- A recursor reference is canonical without executing a declaration body. -/ +theorem SourceRefValue.recursorTraceAt + {sourceCtx : IxIR0.Ctx} {sourceLimit : Nat} + {address : Ixon.Address} {numArgs : Nat} {natLit : Bool} + {rules : Array IxIR0.RecRule} {sourceFunction : IxIR0.Value} + (hlookup : sourceCtx.env address = + some (.recursor numArgs natLit rules)) + (href : SourceRefValue sourceCtx address sourceFunction) + (hbound : 1 ≤ sourceLimit) : + SourceRefTraceAt sourceCtx sourceLimit address sourceFunction := by + have hfunction := href.recursorValue hlookup + subst sourceFunction + exact (IxIR0.ProjectionSafe.Eval.refRecursor + (fuel := 0) (env := []) hlookup).mono_le hbound + +/-- Evaluating an expression safely and then supplying exactly its leading +lambda telescope exposes a safe execution of `stripLams`. Both the initial +evaluation and every application lie below the common enclosing fuel, so the +selected body does as well. -/ +theorem projectionSafeEval_stripLams_of_applies + (sourceCtx : IxIR0.Ctx) : + ∀ {limit : Nat} {sourceEnv : List IxIR0.Value} {expr : IxIR0.Expr} + {function result : IxIR0.Value} {args : List IxIR0.Value} + {evalFuel : Nat}, + IxIR0.ProjectionSafe.Eval sourceCtx evalFuel sourceEnv expr function → + evalFuel < limit → + args.length = lamArity expr → + SourceAppliesSafelyBelow sourceCtx limit function args result → + ∃ bodyFuel, bodyFuel < limit ∧ + IxIR0.ProjectionSafe.Eval sourceCtx bodyFuel + (args.reverse ++ sourceEnv) (stripLams expr) result := by + intro limit sourceEnv expr + induction expr generalizing sourceEnv with + | var index => + intro function result args evalFuel heval hevalBound hlength happlies + have hnil : args = [] := + List.eq_nil_of_length_eq_zero (by simpa [lamArity] using hlength) + subst args + cases happlies + exact ⟨evalFuel, hevalBound, by simpa [stripLams] using heval⟩ + | ref address => + intro function result args evalFuel heval hevalBound hlength happlies + have hnil : args = [] := + List.eq_nil_of_length_eq_zero (by simpa [lamArity] using hlength) + subst args + cases happlies + exact ⟨evalFuel, hevalBound, by simpa [stripLams] using heval⟩ + | app fn arg => + intro function result args evalFuel heval hevalBound hlength happlies + have hnil : args = [] := + List.eq_nil_of_length_eq_zero (by simpa [lamArity] using hlength) + subst args + cases happlies + exact ⟨evalFuel, hevalBound, by simpa [stripLams] using heval⟩ + | lam uses body ih => + intro function result args evalFuel heval hevalBound hlength happlies + cases heval with + | lam => + cases args with + | nil => simp [lamArity] at hlength + | cons argument arguments => + have htailLength : arguments.length = lamArity body := by + simpa [lamArity] using hlength + cases happlies with + | @cons applyFuel _ _ middle _ _ happlyBound hstep htail => + cases hstep with + | clos hbody => + obtain ⟨bodyFuel, hbodyBound, hresult⟩ := + ih hbody (by omega) htailLength htail + refine ⟨bodyFuel, hbodyBound, ?_⟩ + simpa [stripLams, List.reverse_cons, + List.append_assoc] using hresult + | letE uses value body => + intro function result args evalFuel heval hevalBound hlength happlies + have hnil : args = [] := + List.eq_nil_of_length_eq_zero (by simpa [lamArity] using hlength) + subst args + cases happlies + exact ⟨evalFuel, hevalBound, by simpa [stripLams] using heval⟩ + | proj index value => + intro function result args evalFuel heval hevalBound hlength happlies + have hnil : args = [] := + List.eq_nil_of_length_eq_zero (by simpa [lamArity] using hlength) + subst args + cases happlies + exact ⟨evalFuel, hevalBound, by simpa [stripLams] using heval⟩ + | lit literal => + intro function result args evalFuel heval hevalBound hlength happlies + have hnil : args = [] := + List.eq_nil_of_length_eq_zero (by simpa [lamArity] using hlength) + subst args + cases happlies + exact ⟨evalFuel, hevalBound, by simpa [stripLams] using heval⟩ + | erased => + intro function result args evalFuel heval hevalBound hlength happlies + have hnil : args = [] := + List.eq_nil_of_length_eq_zero (by simpa [lamArity] using hlength) + subst args + cases happlies + exact ⟨evalFuel, hevalBound, by simpa [stripLams] using heval⟩ + +/-- Completing a residual lambda prefix with an exact remaining application +spine exposes the exact stripped-body trace selected by that saturation. -/ +theorem LambdaPrefix.saturateTrace + {sourceCtx : IxIR0.Ctx} {limit : Nat} + {sourceEnv : List IxIR0.Value} {expr : IxIR0.Expr} + {supplied remaining : List IxIR0.Value} + {function result : IxIR0.Value} + (hprefix : LambdaPrefix sourceEnv expr supplied function) + (hbound : 2 < limit) + (hlength : (supplied ++ remaining).length = lamArity expr) + (happlies : SourceAppliesSafelyBelow sourceCtx limit function remaining + result) : + ∃ bodyFuel, bodyFuel < limit ∧ + IxIR0.ProjectionSafe.Eval sourceCtx bodyFuel + ((supplied ++ remaining).reverse ++ sourceEnv) + (stripLams expr) result := by + obtain ⟨uses, body, hexpr, hcanonicalPrefix⟩ := + hprefix.toAppliesBelow hbound + subst expr + have hall := hcanonicalPrefix.append happlies + exact projectionSafeEval_stripLams_of_applies sourceCtx + (IxIR0.ProjectionSafe.Eval.lam (fuel := 0)) (by omega) + hlength hall + +/-- The exact reference trace for a definition retains its closed body trace +at a strictly smaller source-fuel index. -/ +theorem SourceRefTraceAt.defnBody + {sourceCtx : IxIR0.Ctx} {sourceLimit : Nat} + {address : Ixon.Address} {world : Owned} {body : IxIR0.Expr} + {function : IxIR0.Value} + (href : SourceRefTraceAt sourceCtx sourceLimit address function) + (hlookup : sourceCtx.env address = some (.defn world body)) : + ∃ bodyFuel, bodyFuel < sourceLimit ∧ + IxIR0.ProjectionSafe.Eval sourceCtx bodyFuel [] body function := by + cases href with + | refDefn hdecl hbody => + rw [hlookup] at hdecl + cases hdecl + exact ⟨_, by omega, hbody⟩ + | refCtor hdecl _ => simp [hlookup] at hdecl + | refRecursor hdecl => simp [hlookup] at hdecl + | refExtern hdecl _ => simp [hlookup] at hdecl + +/-- Saturating an exact definition-reference trace reaches its stripped body +under the reversed source argument vector, still strictly below the enclosing +reference fuel. -/ +theorem SourceRefTraceAt.defnSaturate + {sourceCtx : IxIR0.Ctx} {sourceLimit : Nat} + {address : Ixon.Address} {world : Owned} {body : IxIR0.Expr} + {function result : IxIR0.Value} {args : List IxIR0.Value} + (href : SourceRefTraceAt sourceCtx sourceLimit address function) + (hlookup : sourceCtx.env address = some (.defn world body)) + (hlength : args.length = lamArity body) + (happlies : SourceAppliesSafelyBelow sourceCtx sourceLimit function args + result) : + ∃ bodyFuel, bodyFuel < sourceLimit ∧ + IxIR0.ProjectionSafe.Eval sourceCtx bodyFuel args.reverse + (stripLams body) result := by + obtain ⟨evalFuel, hevalBound, heval⟩ := href.defnBody hlookup + simpa using projectionSafeEval_stripLams_of_applies sourceCtx heval + hevalBound hlength happlies + +/-- Invert a fully saturated exact recursor-reference trace at its final +major argument. The selected rule-body evaluation is structurally nested +inside `Apply`/`Saturate`/`Fire`, hence its fuel is strictly below the common +application bound. -/ +theorem sourceRecursorRef_saturates_trace_inv + {sourceCtx : IxIR0.Ctx} {sourceLimit : Nat} + {address : Ixon.Address} {numArgs : Nat} {natLit : Bool} + {rules : Array IxIR0.RecRule} + {sourceFunction sourceResult major : IxIR0.Value} + {pre : List IxIR0.Value} + (hlookup : sourceCtx.env address = + some (.recursor numArgs natLit rules)) + (href : SourceRefTraceAt sourceCtx sourceLimit address sourceFunction) + (hpreLength : pre.length = numArgs) + (happlies : SourceAppliesSafelyBelow sourceCtx sourceLimit + sourceFunction (pre ++ [major]) sourceResult) : + ∃ tag fields rule bodyFuel, + bodyFuel < sourceLimit ∧ + IxIR0.majorCtor natLit major = .ok (tag, fields) ∧ + rules[tag]? = some rule ∧ + fields.length = rule.fields ∧ + IxIR0.ProjectionSafe.Eval sourceCtx bodyFuel + (fields.reverse ++ pre.reverse ++ + [.pap (.rec_ address (numArgs + 1)) []]) + rule.rhs sourceResult := by + have hrefValue : SourceRefValue sourceCtx address sourceFunction := + ⟨sourceLimit, href.run⟩ + have hfunction := hrefValue.recursorValue hlookup + subst sourceFunction + obtain ⟨middle, hleft, hright⟩ := + happlies.split (left := pre) (right := [major]) + have hunder : ([] ++ pre).length < + (IxIR0.Head.rec_ address (numArgs + 1)).arity := by + simp [IxIR0.Head.arity, hpreLength] + have hprefix : SourceApplies sourceCtx + (.pap (.rec_ address (numArgs + 1)) []) pre + (.pap (.rec_ address (numArgs + 1)) pre) := + sourcePap_underfills hunder + have hmiddle : middle = .pap (.rec_ address (numArgs + 1)) pre := + (SourceAppliesSafelyBelow.sourceApplies hleft).deterministic hprefix + subst middle + cases hright with + | @cons applyFuel _ _ middle _ arguments happlyBound hstep htail => + cases htail + cases hstep with + | pap hsaturate => + cases hsaturate with + | pending hlength => + exfalso + apply hlength + simp [IxIR0.Head.arity, hpreLength] + | full hlength hfire => + cases hfire with + | @recursor bodyFuel _ _ _ _ _ _ _ _ _ _ _ + hdecl hlast hmajor hrule hfields hbody => + rw [hlookup] at hdecl + cases hdecl + have hlastExpected : (pre ++ [major]).getLast? = + some major := by simp + rw [hlastExpected] at hlast + cases hlast + exact ⟨_, _, _, bodyFuel, by omega, hmajor, hrule, hfields, + by simpa using hbody⟩ + +/-! ### Projection-safe erasure inversion -/ + +/-- Invert a successful Ixon application into its predecessor-fuel +function, argument, and application computations. -/ +private theorem ixonEval_app_inv + {sourceCtx : Ixon.Eval.EvalCtx} {fuel : Nat} + {frame : Ixon.Eval.Frame} {sourceEnv : List Ixon.Eval.Value} + {function argument : Ixon.Expr} {result : Ixon.Eval.Value} + (hrun : Ixon.Eval.eval sourceCtx fuel frame sourceEnv + (.app function argument) = .ok result) : + ∃ previous functionValue argumentValue, + previous < fuel ∧ + Ixon.Eval.eval sourceCtx previous frame sourceEnv function = + .ok functionValue ∧ + Ixon.Eval.eval sourceCtx previous frame sourceEnv argument = + .ok argumentValue ∧ + Ixon.Eval.apply sourceCtx previous functionValue argumentValue = + .ok result := by + cases fuel with + | zero => + rw [Ixon.Eval.eval.eq_def] at hrun + simp at hrun + | succ fuel => + rw [Ixon.Eval.eval.eq_def] at hrun + dsimp only at hrun + cases hfunction : + Ixon.Eval.eval sourceCtx fuel frame sourceEnv function with + | error error => + rw [hfunction] at hrun + contradiction + | ok functionValue => + rw [hfunction, bindOk] at hrun + cases hargument : + Ixon.Eval.eval sourceCtx fuel frame sourceEnv argument with + | error error => + rw [hargument] at hrun + contradiction + | ok argumentValue => + rw [hargument, bindOk] at hrun + exact ⟨fuel, functionValue, argumentValue, Nat.lt_succ_self _, + hfunction, hargument, hrun⟩ + +/-- Invert a successful Ixon let into its predecessor-fuel value and body +computations. -/ +private theorem ixonEval_let_inv + {sourceCtx : Ixon.Eval.EvalCtx} {fuel : Nat} + {frame : Ixon.Eval.Frame} {sourceEnv : List Ixon.Eval.Value} + {nondep : Bool} {type value body : Ixon.Expr} + {result : Ixon.Eval.Value} + (hrun : Ixon.Eval.eval sourceCtx fuel frame sourceEnv + (.letE nondep type value body) = .ok result) : + ∃ previous bound, + previous < fuel ∧ + Ixon.Eval.eval sourceCtx previous frame sourceEnv value = .ok bound ∧ + Ixon.Eval.eval sourceCtx previous frame (bound :: sourceEnv) body = + .ok result := by + cases fuel with + | zero => + rw [Ixon.Eval.eval.eq_def] at hrun + simp at hrun + | succ fuel => + rw [Ixon.Eval.eval.eq_def] at hrun + dsimp only at hrun + cases hvalue : Ixon.Eval.eval sourceCtx fuel frame sourceEnv value with + | error error => + rw [hvalue] at hrun + contradiction + | ok bound => + rw [hvalue, bindOk] at hrun + exact ⟨fuel, bound, Nat.lt_succ_self _, hvalue, hrun⟩ + +/-- A successful Ixon projection necessarily evaluated its operand at the +predecessor fuel. -/ +private theorem ixonEval_proj_target_inv + {sourceCtx : Ixon.Eval.EvalCtx} {fuel : Nat} + {frame : Ixon.Eval.Frame} {sourceEnv : List Ixon.Eval.Value} + {typeRef field : UInt64} {source : Ixon.Expr} + {result : Ixon.Eval.Value} + (hrun : Ixon.Eval.eval sourceCtx fuel frame sourceEnv + (.prj typeRef field source) = .ok result) : + ∃ previous target, + previous < fuel ∧ + Ixon.Eval.eval sourceCtx previous frame sourceEnv source = + .ok target := by + cases fuel with + | zero => + rw [Ixon.Eval.eval.eq_def] at hrun + simp at hrun + | succ fuel => + rw [Ixon.Eval.eval.eq_def] at hrun + dsimp only at hrun + cases htarget : Ixon.Eval.eval sourceCtx fuel frame sourceEnv source with + | error error => + rw [htarget] at hrun + contradiction + | ok target => exact ⟨fuel, target, Nat.lt_succ_self _, htarget⟩ + +/-- Pin the value relation produced by erasure simulation to any independently +obtained evaluation of the same erased expression. -/ +private theorem erasure_valRel_of_target_eval + {sourceFuel targetFuel : Nat} {ectx : Ixon.Eval.EvalCtx} + {frame : Ixon.Eval.Frame} {sourceEnv : List Ixon.Eval.Value} + {source : Ixon.Expr} {sourceValue : Ixon.Eval.Value} + {self : Option (Ixon.Address × Nat)} {mask : List Bool} + {targetEnv : List IxIR0.Value} {target : IxIR0.Expr} + {targetValue : IxIR0.Value} {targetCtx : IxIR0.Ctx} + (hstrict : ectx.Strict) + (horacles : Ix.Compiler.Sim.OracleRel ectx targetCtx) + (hsource : Ixon.Eval.eval ectx sourceFuel frame sourceEnv source = + .ok sourceValue) + (herases : Ix.Compiler.Sim.PErase ectx targetCtx self frame.refs + frame.selfMuts frame.selfAddr mask source target) + (henv : Ix.Compiler.Sim.EnvRel ectx targetCtx self frame.refs + frame.selfMuts frame.selfAddr mask sourceEnv targetEnv) + (htarget : IxIR0.eval targetCtx targetFuel targetEnv target = + .ok targetValue) : + Ix.Compiler.Sim.ValRel ectx targetCtx sourceValue targetValue := by + obtain ⟨witnessFuel, witnessValue, hwitness, hrel⟩ := + Ix.Compiler.Sim.erasure_sim hstrict horacles hsource herases henv + let common := max witnessFuel targetFuel + have hwitness' : IxIR0.eval targetCtx common targetEnv target = + .ok witnessValue := + IxIR0.eval_mono (Nat.le_max_left _ _) hwitness + have htarget' : IxIR0.eval targetCtx common targetEnv target = + .ok targetValue := + IxIR0.eval_mono (Nat.le_max_right _ _) htarget + rw [hwitness'] at htarget' + injection htarget' with hvalue + subst targetValue + exact hrel + +/-- The exact-target form used by the fuel induction: a successful Ixon run, +its erasure derivation, and a successful evaluation of that exact erased term +produce a constructor-only projection trace for the exact target value. -/ +private def ProjectionSafeErasureAt (fuel : Nat) : Prop := + ∀ {ectx : Ixon.Eval.EvalCtx} {frame : Ixon.Eval.Frame} + {sourceEnv : List Ixon.Eval.Value} {source : Ixon.Expr} + {sourceValue : Ixon.Eval.Value} {self : Option (Ixon.Address × Nat)} + {mask : List Bool} {targetEnv : List IxIR0.Value} + {target : IxIR0.Expr} {targetCtx : IxIR0.Ctx} + {targetFuel : Nat} {targetValue : IxIR0.Value}, + ectx.Strict → + Ix.Compiler.Sim.OracleRel ectx targetCtx → + Ixon.Eval.eval ectx fuel frame sourceEnv source = .ok sourceValue → + Ix.Compiler.Sim.PErase ectx targetCtx self frame.refs frame.selfMuts + frame.selfAddr mask source target → + Ix.Compiler.Sim.EnvRel ectx targetCtx self frame.refs frame.selfMuts + frame.selfAddr mask sourceEnv targetEnv → + IxIR0.eval targetCtx targetFuel targetEnv target = .ok targetValue → + ProjectionSafeEval targetCtx targetEnv target targetValue + +/-- The visible indexed-recursor spine has the same projection-safety +property as ordinary erasure. Kept arguments use the main smaller-fuel +hypothesis; ghost arguments erase to a trivially safe value; dropped +arguments do not occur in the target syntax. -/ +private theorem recEraseSpine_projectionSafe + {bound : Nat} + (safe : ∀ previous, previous < bound → + ProjectionSafeErasureAt previous) + {ectx : Ixon.Eval.EvalCtx} {targetCtx : IxIR0.Ctx} + (hstrict : ectx.Strict) + (horacles : Ix.Compiler.Sim.OracleRel ectx targetCtx) + {self : Option (Ixon.Address × Nat)} {frame : Ixon.Eval.Frame} + {mask : List Bool} {source : Ixon.Expr} {target : IxIR0.Expr} + {recursor : Ix.Compiler.Ixon.Recursor} + {rest : List Ix.Compiler.Erase.ArgPolicy} + (hspine : Ix.Compiler.Sim.RecEraseSpine ectx targetCtx self frame.refs + frame.selfMuts frame.selfAddr mask source target recursor rest) : + ∀ {fuel : Nat} {sourceEnv : List Ixon.Eval.Value} + {sourceValue : Ixon.Eval.Value} {targetEnv : List IxIR0.Value} + {targetFuel : Nat} {targetValue : IxIR0.Value}, + fuel ≤ bound → + Ixon.Eval.eval ectx fuel frame sourceEnv source = .ok sourceValue → + Ix.Compiler.Sim.EnvRel ectx targetCtx self frame.refs frame.selfMuts + frame.selfAddr mask sourceEnv targetEnv → + IxIR0.eval targetCtx targetFuel targetEnv target = .ok targetValue → + ProjectionSafeEval targetCtx targetEnv target targetValue := by + induction source generalizing target recursor rest with + | ref refIdx univIdxs => + cases hspine with + | head href hresolve hinfo hmut hindices htargetDecl hmember => + intro fuel sourceEnv sourceValue targetEnv targetFuel targetValue + hbound hsource henv htarget + exact .ref ⟨targetFuel, htarget⟩ + | app function argument ihFunction ihArgument => + cases hspine with + | keep hfunction hargument => + intro fuel sourceEnv sourceValue targetEnv targetFuel targetValue + hbound hsource henv htarget + obtain ⟨previous, sourceFunction, sourceArgument, hprevious, + hsourceFunction, hsourceArgument, hsourceApply⟩ := + ixonEval_app_inv hsource + obtain ⟨targetPrevious, targetFunction, targetArgument, + htargetFunction, htargetArgument, htargetApply⟩ := + sourceEval_app_inv htarget + exact .app + (ihFunction hfunction (fuel := previous) + (sourceValue := sourceFunction) (targetFuel := targetPrevious) + (targetValue := targetFunction) + (Nat.le_trans (Nat.le_of_lt hprevious) hbound) hsourceFunction + henv htargetFunction) + (safe previous (Nat.lt_of_lt_of_le hprevious hbound) + hstrict horacles hsourceArgument hargument henv htargetArgument) + ⟨targetPrevious, htargetApply⟩ + | ghost hfunction => + intro fuel sourceEnv sourceValue targetEnv targetFuel targetValue + hbound hsource henv htarget + obtain ⟨previous, sourceFunction, sourceArgument, hprevious, + hsourceFunction, hsourceArgument, hsourceApply⟩ := + ixonEval_app_inv hsource + obtain ⟨targetPrevious, targetFunction, targetArgument, + htargetFunction, htargetArgument, htargetApply⟩ := + sourceEval_app_inv htarget + have htargetErased := sourceEval_erased_inv htargetArgument + subst targetArgument + exact .app + (ihFunction hfunction (fuel := previous) + (sourceValue := sourceFunction) (targetFuel := targetPrevious) + (targetValue := targetFunction) + (Nat.le_trans (Nat.le_of_lt hprevious) hbound) hsourceFunction + henv htargetFunction) + .erased ⟨targetPrevious, htargetApply⟩ + | drop hfunction => + intro fuel sourceEnv sourceValue targetEnv targetFuel targetValue + hbound hsource henv htarget + obtain ⟨previous, sourceFunction, sourceArgument, hprevious, + hsourceFunction, hsourceArgument, hsourceApply⟩ := + ixonEval_app_inv hsource + exact ihFunction hfunction (fuel := previous) + (sourceValue := sourceFunction) (targetFuel := targetFuel) + (targetValue := targetValue) + (Nat.le_trans (Nat.le_of_lt hprevious) hbound) hsourceFunction henv + htarget + | sort index => cases hspine + | var index => cases hspine + | recur index univs => + cases hspine with + | selfHead hself hblock hindex hresolve hrefs hlookup hindices => + intro fuel sourceEnv sourceValue targetEnv targetFuel targetValue + hbound hsource henv htarget + exact .var (sourceEval_var_inv htarget) + | memberHead hblock hresolve hrefs hmuts hindices hplan => + intro fuel sourceEnv sourceValue targetEnv targetFuel targetValue + hbound hsource henv htarget + exact .ref ⟨targetFuel, htarget⟩ + | prj typeRef field source ih => cases hspine + | str index => cases hspine + | nat index => cases hspine + | lam uses type body ihType ihBody => cases hspine + | all uses owned domain codomain ihDomain ihCodomain => cases hspine + | letE nondep type value body ihType ihValue ihBody => cases hspine + | share index => cases hspine + +private theorem strongNatProjectionSafe {predicate : Nat → Prop} + (step : ∀ fuel, (∀ previous, previous < fuel → predicate previous) → + predicate fuel) : + ∀ fuel, predicate fuel := by + have aux : ∀ bound fuel, fuel < bound → predicate fuel := by + intro bound + induction bound with + | zero => intro fuel hlt; exact absurd hlt (Nat.not_lt_zero fuel) + | succ bound ih => + intro fuel hlt + exact step fuel fun previous hprevious => + ih previous (Nat.lt_of_lt_of_le hprevious (Nat.lt_succ_iff.mp hlt)) + exact fun fuel => aux (fuel + 1) fuel (Nat.lt_succ_self fuel) + +/-- Every successful proof-producing erasure evaluation is projection-safe +when pinned to an independently obtained evaluation of the erased term. -/ +private theorem projectionSafeErasureAt_all : + ∀ fuel, ProjectionSafeErasureAt fuel := by + intro fuel + induction fuel using strongNatProjectionSafe + rename_i fuel ih + intro ectx frame sourceEnv source sourceValue self mask targetEnv target + targetCtx targetFuel targetValue hstrict horacles hsource herases henv + htarget + cases herases with + | var hmask => + exact .var (sourceEval_var_inv htarget) + | sortE => + have hvalue := sourceEval_erased_inv htarget + subst targetValue + exact .erased + | allE => + have hvalue := sourceEval_erased_inv htarget + subst targetValue + exact .erased + | lamK hd hbody => + have hvalue := sourceEval_lam_inv htarget + subst targetValue + exact .lam + | lamD hd hbody => + have hvalue := sourceEval_lam_inv htarget + subst targetValue + exact .lam + | app hfunctionErase hargumentErase => + obtain ⟨previous, sourceFunction, sourceArgument, hprevious, + hsourceFunction, hsourceArgument, hsourceApply⟩ := + ixonEval_app_inv hsource + obtain ⟨targetPrevious, targetFunction, targetArgument, + htargetFunction, htargetArgument, htargetApply⟩ := + sourceEval_app_inv htarget + exact .app + (ih previous hprevious hstrict horacles hsourceFunction hfunctionErase henv + htargetFunction) + (ih previous hprevious hstrict horacles hsourceArgument hargumentErase henv + htargetArgument) + ⟨targetPrevious, htargetApply⟩ + | appE hd hfunctionErase => + obtain ⟨previous, sourceFunction, sourceArgument, hprevious, + hsourceFunction, hsourceArgument, hsourceApply⟩ := + ixonEval_app_inv hsource + obtain ⟨targetPrevious, targetFunction, targetArgument, + htargetFunction, htargetArgument, htargetApply⟩ := + sourceEval_app_inv htarget + have htargetErased := sourceEval_erased_inv htargetArgument + subst targetArgument + exact .app + (ih previous hprevious hstrict horacles hsourceFunction hfunctionErase henv + htargetFunction) + .erased ⟨targetPrevious, htargetApply⟩ + | appG hspine hghost hfunctionErase => + obtain ⟨previous, sourceFunction, sourceArgument, hprevious, + hsourceFunction, hsourceArgument, hsourceApply⟩ := + ixonEval_app_inv hsource + obtain ⟨targetPrevious, targetFunction, targetArgument, + htargetFunction, htargetArgument, htargetApply⟩ := + sourceEval_app_inv htarget + have htargetErased := sourceEval_erased_inv htargetArgument + subst targetArgument + exact .app + (ih previous hprevious hstrict horacles hsourceFunction hfunctionErase henv + htargetFunction) + .erased ⟨targetPrevious, htargetApply⟩ + | appDG hspine hghost hfunctionErase => + obtain ⟨previous, sourceFunction, sourceArgument, hprevious, + hsourceFunction, hsourceArgument, hsourceApply⟩ := + ixonEval_app_inv hsource + obtain ⟨targetPrevious, targetFunction, targetArgument, + htargetFunction, htargetArgument, htargetApply⟩ := + sourceEval_app_inv htarget + have htargetErased := sourceEval_erased_inv htargetArgument + subst targetArgument + exact .app + (ih previous hprevious hstrict horacles hsourceFunction hfunctionErase henv + htargetFunction) + .erased ⟨targetPrevious, htargetApply⟩ + | recP hspine => + exact recEraseSpine_projectionSafe ih hstrict horacles hspine + (Nat.le_refl fuel) + hsource henv htarget + | recW hspine hremaining => + rename_i target recursor remaining + cases remaining with + | zero => omega + | succ remaining => + obtain ⟨targetPrevious, targetBound, htargetValue, htargetBody⟩ := + sourceEval_let_inv (by + simpa [Ix.Compiler.Erase.captureThenIgnoreN] using htarget) + have hvalue := sourceEval_lam_inv (by + simpa [Ix.Compiler.Erase.lamManyN] using htargetBody) + subst targetValue + exact .letE + (recEraseSpine_projectionSafe ih hstrict horacles hspine + (Nat.le_refl fuel) hsource henv htargetValue) + .lam + | letE hvalueErase hbodyErase => + obtain ⟨previous, sourceBound, hprevious, hsourceValue, + hsourceBody⟩ := ixonEval_let_inv hsource + obtain ⟨targetPrevious, targetBound, htargetValue, htargetBody⟩ := + sourceEval_let_inv htarget + have hboundRel := erasure_valRel_of_target_eval hstrict horacles hsourceValue + hvalueErase henv htargetValue + exact .letE + (ih previous hprevious hstrict horacles hsourceValue hvalueErase henv + htargetValue) + (ih previous hprevious hstrict horacles hsourceBody hbodyErase + (Ix.Compiler.Sim.EnvRel.keep hboundRel henv) htargetBody) + | ctorP hparams hspine hdecl => + exact .ref ⟨targetFuel, htarget⟩ + | ctorW hspine hparams hdecl => + have hvalue := sourceEval_lam_inv htarget + subst targetValue + exact .lam + | ref href hcovered => + exact .ref ⟨targetFuel, htarget⟩ + | recurS hindex hrecur => + exact .var (sourceEval_var_inv htarget) + | recurI hblock hresolve hrefs hlookup hdecl => + exact .ref ⟨targetFuel, htarget⟩ + | recurD hblock hresolve hrefs hmuts hunfold hplan => + exact .ref ⟨targetFuel, htarget⟩ + | recurO hblock hresolve hrefs hmuts hunfold hconfigured hplan => + exact .ref ⟨targetFuel, htarget⟩ + | recurR hblock hresolve hrefs hmuts hindices hplan => + exact .ref ⟨targetFuel, htarget⟩ + | natE href hblob => + have hvalue := sourceEval_lit_inv htarget + subst targetValue + exact .lit + | strE href hblob => + have hvalue := sourceEval_lit_inv htarget + subst targetValue + exact .lit + | prjE hsourceErase => + obtain ⟨previous, sourceTarget, hprevious, hsourceTarget⟩ := + ixonEval_proj_target_inv hsource + obtain ⟨targetPrevious, targetTarget, htargetTarget, hproject⟩ := + sourceEval_proj_inv htarget + obtain ⟨address, tag, fields, projected, hshape, hfield, hrel⟩ := + Ix.Compiler.Sim.erasure_proj_target_ctor hstrict horacles hsource + (Ix.Compiler.Sim.PErase.prjE hsourceErase) henv htargetTarget + subst targetTarget + cases hproject with + | ctor htargetField => + exact .proj + (ih previous hprevious hstrict horacles hsourceTarget hsourceErase henv + htargetTarget) + htargetField + +/-- Successful source evaluation plus proof-producing erasure constructs the +projection-safe IxIR₀ trace consumed by strong lowering progress. -/ +theorem ProjectionSafeEval.of_erasure_with_members + [scope : Ix.Compiler.Sim.MemberScope] + {sourceFuel : Nat} {ectx : Ixon.Eval.EvalCtx} + {frame : Ixon.Eval.Frame} {sourceEnv : List Ixon.Eval.Value} + {source : Ixon.Expr} {sourceValue : Ixon.Eval.Value} + {self : Option (Ixon.Address × Nat)} {mask : List Bool} + {targetEnv : List IxIR0.Value} {target : IxIR0.Expr} + {targetCtx : IxIR0.Ctx} + (hmembers : Ix.Compiler.Sim.MemberCoverage ectx targetCtx scope.plan) + (horacles : Ix.Compiler.Sim.OracleRel ectx targetCtx) + (hsource : Ixon.Eval.eval ectx sourceFuel frame sourceEnv source = + .ok sourceValue) + (herases : Ix.Compiler.Sim.PErase ectx targetCtx self frame.refs + frame.selfMuts frame.selfAddr mask source target) + (henv : Ix.Compiler.Sim.EnvRel ectx targetCtx self frame.refs + frame.selfMuts frame.selfAddr mask sourceEnv targetEnv) : + ∃ targetValue, + ProjectionSafeEval targetCtx targetEnv target targetValue ∧ + Ix.Compiler.Sim.ValRel ectx targetCtx sourceValue targetValue := by + obtain ⟨targetFuel, targetValue, htrace, hrel⟩ := + Ix.Compiler.Sim.erasure_sim_projectionSafe_with_members hmembers + horacles hsource herases henv + exact ⟨targetValue, ProjectionSafeEval.of_trace htrace, hrel⟩ + +/-- Empty-member-scope compatibility specialization of +`ProjectionSafeEval.of_erasure_with_members`. -/ +theorem ProjectionSafeEval.of_erasure + {sourceFuel : Nat} {ectx : Ixon.Eval.EvalCtx} + {frame : Ixon.Eval.Frame} {sourceEnv : List Ixon.Eval.Value} + {source : Ixon.Expr} {sourceValue : Ixon.Eval.Value} + {self : Option (Ixon.Address × Nat)} {mask : List Bool} + {targetEnv : List IxIR0.Value} {target : IxIR0.Expr} + {targetCtx : IxIR0.Ctx} + (hstrict : ectx.Strict) + (horacles : Ix.Compiler.Sim.OracleRel ectx targetCtx) + (hsource : Ixon.Eval.eval ectx sourceFuel frame sourceEnv source = + .ok sourceValue) + (herases : Ix.Compiler.Sim.PErase ectx targetCtx self frame.refs + frame.selfMuts frame.selfAddr mask source target) + (henv : Ix.Compiler.Sim.EnvRel ectx targetCtx self frame.refs + frame.selfMuts frame.selfAddr mask sourceEnv targetEnv) : + ∃ targetValue, + ProjectionSafeEval targetCtx targetEnv target targetValue ∧ + Ix.Compiler.Sim.ValRel ectx targetCtx sourceValue targetValue := by + obtain ⟨targetFuel, targetValue, htarget, hrel⟩ := + Ix.Compiler.Sim.erasure_sim hstrict horacles hsource herases henv + exact ⟨targetValue, + projectionSafeErasureAt_all sourceFuel hstrict horacles hsource herases henv + htarget, + hrel⟩ + +/-- Closed-term specialization of projection-safe erasure. -/ +theorem ProjectionSafeEval.of_erasure_closed + {sourceFuel : Nat} {ectx : Ixon.Eval.EvalCtx} + {frame : Ixon.Eval.Frame} {source : Ixon.Expr} + {sourceValue : Ixon.Eval.Value} {target : IxIR0.Expr} + {targetCtx : IxIR0.Ctx} + (hstrict : ectx.Strict) + (horacles : Ix.Compiler.Sim.OracleRel ectx targetCtx) + (hsource : Ixon.Eval.eval ectx sourceFuel frame [] source = + .ok sourceValue) + (herases : Ix.Compiler.Sim.PErase ectx targetCtx none frame.refs + frame.selfMuts frame.selfAddr [] source target) : + ∃ targetValue, + ProjectionSafeEval targetCtx [] target targetValue ∧ + Ix.Compiler.Sim.ValRel ectx targetCtx sourceValue targetValue := + ProjectionSafeEval.of_erasure hstrict horacles hsource herases .nil + +/-- Sharing-aware projection-safe erasure. Evaluation is transported through +the same semantic inlining theorem used by the erasure simulation before the +share-free safety induction is applied. -/ +theorem ProjectionSafeEval.of_erasure_inlineSharing + {sourceFuel : Nat} {ectx : Ixon.Eval.EvalCtx} + {frame : Ixon.Eval.Frame} {sourceEnv : List Ixon.Eval.Value} + {source : Ixon.Expr} {sourceValue : Ixon.Eval.Value} + {self : Option (Ixon.Address × Nat)} {mask : List Bool} + {targetEnv : List IxIR0.Value} {target : IxIR0.Expr} + {targetCtx : IxIR0.Ctx} + (hstrict : ectx.Strict) + (horacles : Ix.Compiler.Sim.OracleRel ectx.inlineSharing targetCtx) + (hctx : ectx.SharingWF) (hframe : frame.SharingWF) + (henvWF : Ixon.Eval.ValuesSharingWF sourceEnv) + (hbelow : Ixon.Sharing.sharesBelow frame.sharing.size source = true) + (hsource : Ixon.Eval.eval ectx sourceFuel frame sourceEnv source = + .ok sourceValue) + (herases : Ix.Compiler.Sim.PErase ectx.inlineSharing targetCtx self + frame.inlineSharing.refs frame.inlineSharing.selfMuts + frame.inlineSharing.selfAddr mask + (Ixon.Sharing.inlineExpr frame.sharing source) target) + (henv : Ix.Compiler.Sim.EnvRel ectx.inlineSharing targetCtx self + frame.inlineSharing.refs frame.inlineSharing.selfMuts + frame.inlineSharing.selfAddr mask + (Ixon.Eval.valuesInlineSharing sourceEnv) targetEnv) : + ∃ targetValue, + ProjectionSafeEval targetCtx targetEnv target targetValue ∧ + Ix.Compiler.Sim.InlinedValRel ectx targetCtx sourceValue targetValue := by + have hinlined := Ixon.Eval.eval_inlineSharing hctx hframe henvWF hbelow + hsource + have hinlineEval : Ixon.Eval.eval ectx.inlineSharing sourceFuel + frame.inlineSharing (Ixon.Eval.valuesInlineSharing sourceEnv) + (Ixon.Sharing.inlineExpr frame.sharing source) = + .ok sourceValue.inlineSharing := by + simpa using hinlined.1 + exact ProjectionSafeEval.of_erasure hstrict.inlineSharing horacles + hinlineEval herases henv + +/-- Closed-term sharing-aware specialization. -/ +theorem ProjectionSafeEval.of_erasure_inlineSharing_closed + {sourceFuel : Nat} {ectx : Ixon.Eval.EvalCtx} + {frame : Ixon.Eval.Frame} {source : Ixon.Expr} + {sourceValue : Ixon.Eval.Value} {target : IxIR0.Expr} + {targetCtx : IxIR0.Ctx} + (hstrict : ectx.Strict) + (horacles : Ix.Compiler.Sim.OracleRel ectx.inlineSharing targetCtx) + (hctx : ectx.SharingWF) (hframe : frame.SharingWF) + (hbelow : Ixon.Sharing.sharesBelow frame.sharing.size source = true) + (hsource : Ixon.Eval.eval ectx sourceFuel frame [] source = + .ok sourceValue) + (herases : Ix.Compiler.Sim.PErase ectx.inlineSharing targetCtx none + frame.inlineSharing.refs frame.inlineSharing.selfMuts + frame.inlineSharing.selfAddr [] + (Ixon.Sharing.inlineExpr frame.sharing source) target) : + ∃ targetValue, + ProjectionSafeEval targetCtx [] target targetValue ∧ + Ix.Compiler.Sim.InlinedValRel ectx targetCtx sourceValue targetValue := by + apply ProjectionSafeEval.of_erasure_inlineSharing hstrict horacles hctx + hframe .nil hbelow hsource herases + simpa [Ixon.Eval.valuesInlineSharing] using + (Ix.Compiler.Sim.EnvRel.nil (ectx := ectx.inlineSharing) + (ictx := targetCtx) (refs := frame.inlineSharing.refs) + (muts := frame.inlineSharing.selfMuts) + (sa := frame.inlineSharing.selfAddr)) + +/-- The executable sharing-aware validator's closed certificate supplies the +exact `PErase` witness required by projection-safe progress. The conclusion +is indexed by `cert.target`, so no separately reconstructed erased expression +can be substituted at this boundary. -/ +theorem ProjectionSafeEval.of_certifiedSharedClosed + {sourceFuel eraseFuel : Nat} {ectx : Ixon.Eval.EvalCtx} + {frame : Ixon.Eval.Frame} {source : Ixon.Expr} + {sourceValue : Ixon.Eval.Value} {targetCtx : IxIR0.Ctx} + (cert : Ix.Compiler.EraseValidator.CertifiedSharedExpr ectx targetCtx + none (Ix.Compiler.EraseValidator.tablesOfFrame frame) + frame.selfAddr [] eraseFuel source) + (hstrict : ectx.Strict) + (horacles : Ix.Compiler.Sim.OracleRel ectx.inlineSharing targetCtx) + (hctx : ectx.SharingWF) (hframe : frame.SharingWF) + (hbelow : Ixon.Sharing.sharesBelow frame.sharing.size source = true) + (hsource : Ixon.Eval.eval ectx sourceFuel frame [] source = + .ok sourceValue) : + ∃ targetValue, + ProjectionSafeEval targetCtx [] cert.target targetValue ∧ + Ix.Compiler.Sim.InlinedValRel ectx targetCtx sourceValue targetValue := by + apply ProjectionSafeEval.of_erasure_inlineSharing_closed hstrict horacles + hctx hframe hbelow hsource + have hrelated := cert.related + rw [Ix.Compiler.EraseValidator.inlineTables_tablesOfFrame] at hrelated + exact hrelated + +/-! ### Call-aware certified erasure traces -/ + +namespace CallAwareProjectionSafe + +/-- Successful proof-producing erasure returns the exact fuel-indexed trace +used by callable progress, not only the shallow expression invariant. -/ +theorem of_erasure_with_members + [scope : Ix.Compiler.Sim.MemberScope] + {sourceFuel : Nat} {ectx : Ixon.Eval.EvalCtx} + {frame : Ixon.Eval.Frame} {sourceEnv : List Ixon.Eval.Value} + {source : Ixon.Expr} {sourceValue : Ixon.Eval.Value} + {self : Option (Ixon.Address × Nat)} {mask : List Bool} + {targetEnv : List IxIR0.Value} {target : IxIR0.Expr} + {targetCtx : IxIR0.Ctx} + (hmembers : Ix.Compiler.Sim.MemberCoverage ectx targetCtx scope.plan) + (horacles : Ix.Compiler.Sim.OracleRel ectx targetCtx) + (hsource : Ixon.Eval.eval ectx sourceFuel frame sourceEnv source = + .ok sourceValue) + (herases : Ix.Compiler.Sim.PErase ectx targetCtx self frame.refs + frame.selfMuts frame.selfAddr mask source target) + (henv : Ix.Compiler.Sim.EnvRel ectx targetCtx self frame.refs + frame.selfMuts frame.selfAddr mask sourceEnv targetEnv) : + ∃ targetFuel targetValue, + IxIR0.ProjectionSafe.Eval targetCtx targetFuel targetEnv target + targetValue ∧ + Ix.Compiler.Sim.ValRel ectx targetCtx sourceValue targetValue := + Ix.Compiler.Sim.erasure_sim_projectionSafe_with_members hmembers + horacles hsource herases henv + +/-- Empty-member-scope compatibility specialization of +`CallAwareProjectionSafe.of_erasure_with_members`. -/ +theorem of_erasure + {sourceFuel : Nat} {ectx : Ixon.Eval.EvalCtx} + {frame : Ixon.Eval.Frame} {sourceEnv : List Ixon.Eval.Value} + {source : Ixon.Expr} {sourceValue : Ixon.Eval.Value} + {self : Option (Ixon.Address × Nat)} {mask : List Bool} + {targetEnv : List IxIR0.Value} {target : IxIR0.Expr} + {targetCtx : IxIR0.Ctx} + (hstrict : ectx.Strict) + (horacles : Ix.Compiler.Sim.OracleRel ectx targetCtx) + (hsource : Ixon.Eval.eval ectx sourceFuel frame sourceEnv source = + .ok sourceValue) + (herases : Ix.Compiler.Sim.PErase ectx targetCtx self frame.refs + frame.selfMuts frame.selfAddr mask source target) + (henv : Ix.Compiler.Sim.EnvRel ectx targetCtx self frame.refs + frame.selfMuts frame.selfAddr mask sourceEnv targetEnv) : + ∃ targetFuel targetValue, + IxIR0.ProjectionSafe.Eval targetCtx targetFuel targetEnv target + targetValue ∧ + Ix.Compiler.Sim.ValRel ectx targetCtx sourceValue targetValue := + Ix.Compiler.Sim.erasure_sim_projectionSafe hstrict horacles hsource herases + henv + +/-- Sharing-aware call-aware erasure trace. -/ +theorem of_erasure_inlineSharing + {sourceFuel : Nat} {ectx : Ixon.Eval.EvalCtx} + {frame : Ixon.Eval.Frame} {sourceEnv : List Ixon.Eval.Value} + {source : Ixon.Expr} {sourceValue : Ixon.Eval.Value} + {self : Option (Ixon.Address × Nat)} {mask : List Bool} + {targetEnv : List IxIR0.Value} {target : IxIR0.Expr} + {targetCtx : IxIR0.Ctx} + (hstrict : ectx.Strict) + (horacles : Ix.Compiler.Sim.OracleRel ectx.inlineSharing targetCtx) + (hctx : ectx.SharingWF) (hframe : frame.SharingWF) + (henvWF : Ixon.Eval.ValuesSharingWF sourceEnv) + (hbelow : Ixon.Sharing.sharesBelow frame.sharing.size source = true) + (hsource : Ixon.Eval.eval ectx sourceFuel frame sourceEnv source = + .ok sourceValue) + (herases : Ix.Compiler.Sim.PErase ectx.inlineSharing targetCtx self + frame.inlineSharing.refs frame.inlineSharing.selfMuts + frame.inlineSharing.selfAddr mask + (Ixon.Sharing.inlineExpr frame.sharing source) target) + (henv : Ix.Compiler.Sim.EnvRel ectx.inlineSharing targetCtx self + frame.inlineSharing.refs frame.inlineSharing.selfMuts + frame.inlineSharing.selfAddr mask + (Ixon.Eval.valuesInlineSharing sourceEnv) targetEnv) : + ∃ targetFuel targetValue, + IxIR0.ProjectionSafe.Eval targetCtx targetFuel targetEnv target + targetValue ∧ + Ix.Compiler.Sim.InlinedValRel ectx targetCtx sourceValue targetValue := + Ix.Compiler.Sim.erasure_sim_projectionSafe_inlineSharing + hstrict horacles hctx hframe henvWF hbelow hsource herases henv + +/-- Sharing-aware call-aware erasure under a simultaneous member certificate. +Unlike the empty-scope compatibility theorem above, cyclic definition and +recursor calls are discharged by `hmembers`. -/ +theorem of_erasure_inlineSharing_with_members + [scope : Ix.Compiler.Sim.MemberScope] + {sourceFuel : Nat} {ectx : Ixon.Eval.EvalCtx} + {frame : Ixon.Eval.Frame} {sourceEnv : List Ixon.Eval.Value} + {source : Ixon.Expr} {sourceValue : Ixon.Eval.Value} + {self : Option (Ixon.Address × Nat)} {mask : List Bool} + {targetEnv : List IxIR0.Value} {target : IxIR0.Expr} + {targetCtx : IxIR0.Ctx} + (hmembers : Ix.Compiler.Sim.MemberCoverage ectx.inlineSharing targetCtx + scope.plan) + (horacles : Ix.Compiler.Sim.OracleRel ectx.inlineSharing targetCtx) + (hctx : ectx.SharingWF) (hframe : frame.SharingWF) + (henvWF : Ixon.Eval.ValuesSharingWF sourceEnv) + (hbelow : Ixon.Sharing.sharesBelow frame.sharing.size source = true) + (hsource : Ixon.Eval.eval ectx sourceFuel frame sourceEnv source = + .ok sourceValue) + (herases : Ix.Compiler.Sim.PErase ectx.inlineSharing targetCtx self + frame.inlineSharing.refs frame.inlineSharing.selfMuts + frame.inlineSharing.selfAddr mask + (Ixon.Sharing.inlineExpr frame.sharing source) target) + (henv : Ix.Compiler.Sim.EnvRel ectx.inlineSharing targetCtx self + frame.inlineSharing.refs frame.inlineSharing.selfMuts + frame.inlineSharing.selfAddr mask + (Ixon.Eval.valuesInlineSharing sourceEnv) targetEnv) : + ∃ targetFuel targetValue, + IxIR0.ProjectionSafe.Eval targetCtx targetFuel targetEnv target + targetValue ∧ + Ix.Compiler.Sim.InlinedValRel ectx targetCtx sourceValue targetValue := by + have hinlined := Ixon.Eval.eval_inlineSharing hctx hframe henvWF hbelow + hsource + simpa only [Ix.Compiler.Sim.InlinedValRel] using + (CallAwareProjectionSafe.of_erasure_with_members hmembers horacles + hinlined.1 herases henv) + +/-- The executable validator's exact erased target carries the full trace, +including every dynamically entered closure and recursor-rule body. -/ +theorem of_certifiedSharedClosed + {sourceFuel eraseFuel : Nat} {ectx : Ixon.Eval.EvalCtx} + {frame : Ixon.Eval.Frame} {source : Ixon.Expr} + {sourceValue : Ixon.Eval.Value} {targetCtx : IxIR0.Ctx} + (cert : Ix.Compiler.EraseValidator.CertifiedSharedExpr ectx targetCtx + none (Ix.Compiler.EraseValidator.tablesOfFrame frame) + frame.selfAddr [] eraseFuel source) + (hstrict : ectx.Strict) + (horacles : Ix.Compiler.Sim.OracleRel ectx.inlineSharing targetCtx) + (hctx : ectx.SharingWF) (hframe : frame.SharingWF) + (hbelow : Ixon.Sharing.sharesBelow frame.sharing.size source = true) + (hsource : Ixon.Eval.eval ectx sourceFuel frame [] source = + .ok sourceValue) : + ∃ targetFuel targetValue, + IxIR0.ProjectionSafe.Eval targetCtx targetFuel [] cert.target + targetValue ∧ + Ix.Compiler.Sim.InlinedValRel ectx targetCtx sourceValue targetValue := by + apply Ix.Compiler.Sim.erasure_sim_projectionSafe_inlineSharing_closed + hstrict horacles hctx hframe hbelow hsource + have hrelated := cert.related + rw [Ix.Compiler.EraseValidator.inlineTables_tablesOfFrame] at hrelated + exact hrelated + +/-- Member-scoped analogue of `of_certifiedSharedClosed`. The certificate +and simultaneous member proof share the same scope, so recursive projection +heads retain the full call-aware trace needed by lowering progress. -/ +theorem of_certifiedSharedClosed_with_members + [scope : Ix.Compiler.Sim.MemberScope] + {sourceFuel eraseFuel : Nat} {ectx : Ixon.Eval.EvalCtx} + {frame : Ixon.Eval.Frame} {source : Ixon.Expr} + {sourceValue : Ixon.Eval.Value} {targetCtx : IxIR0.Ctx} + (hmembers : Ix.Compiler.Sim.MemberCoverage ectx.inlineSharing targetCtx + scope.plan) + (cert : Ix.Compiler.EraseValidator.CertifiedSharedExpr ectx targetCtx + none (Ix.Compiler.EraseValidator.tablesOfFrame frame) + frame.selfAddr [] eraseFuel source) + (horacles : Ix.Compiler.Sim.OracleRel ectx.inlineSharing targetCtx) + (hctx : ectx.SharingWF) (hframe : frame.SharingWF) + (hbelow : Ixon.Sharing.sharesBelow frame.sharing.size source = true) + (hsource : Ixon.Eval.eval ectx sourceFuel frame [] source = + .ok sourceValue) : + ∃ targetFuel targetValue, + IxIR0.ProjectionSafe.Eval targetCtx targetFuel [] cert.target + targetValue ∧ + Ix.Compiler.Sim.InlinedValRel ectx targetCtx sourceValue targetValue := by + apply CallAwareProjectionSafe.of_erasure_inlineSharing_with_members + hmembers horacles hctx hframe .nil hbelow hsource + · have hrelated := cert.related + rw [Ix.Compiler.EraseValidator.inlineTables_tablesOfFrame] at hrelated + exact hrelated + · simpa [Ixon.Eval.valuesInlineSharing] using + (Ix.Compiler.Sim.EnvRel.nil (ectx := ectx.inlineSharing) + (ictx := targetCtx) (refs := frame.inlineSharing.refs) + (muts := frame.inlineSharing.selfMuts) + (sa := frame.inlineSharing.selfAddr)) + +end CallAwareProjectionSafe + +/-! ## Recursive lowering progress interfaces -/ + +def LowerEValueProgressesWithin (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {world : Owned} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal}, + IxIR0.eval sourceCtx sourceFuel sourceEnv expr = .ok sourceValue → + (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState → + ExtraExtends finalState ambient → + SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue world emit av + +def LowerBorrowValueProgressesWithin (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal} {release : Bool}, + IxIR0.eval sourceCtx sourceFuel sourceEnv expr = .ok sourceValue → + (lowerBorrow src fuel input expr).run state = + .ok (output, emit, av, release) finalState → + ExtraExtends finalState ambient → + SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerBorrowValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue emit av release + +def LowerArgsValueProgressesWithin (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {sourceEnv sourceValues : List IxIR0.Value} + {args : List (IxIR0.Expr × Owned)} {state finalState : LowSt} + {emit : Emit} {avs : List AVal}, + SourceArgsEval sourceCtx sourceEnv (args.map Prod.fst) sourceValues → + (lowerArgs src fuel input args).run state = + .ok (output, emit, avs) finalState → + ExtraExtends finalState ambient → + SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerArgsValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValues (args.map Prod.snd) emit avs + +def ApplyRestNonErasedValueProgressesWithin (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {start input output : VEnv} + {sourceStart sourceMiddle sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {resultWorld : Owned} {emitFunction emit : Emit} + {function av : AVal} {args : List IxIR0.Expr} + {state finalState : LowSt}, + function ≠ .constA .erased → + SourceArgsEval sourceCtx sourceMiddle args sourceArgs → + SourceApplies sourceCtx sourceFunction sourceArgs sourceResult → + LowerResultValueProgress funRel recSelfRel ctx cur start input + sourceStart sourceMiddle sourceFunction .shared emitFunction + function → + (applyRest src fuel input resultWorld emitFunction function args).run + state = .ok (output, emit, av) finalState → + ExtraExtends finalState ambient → + SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerResultValueProgress funRel recSelfRel ctx cur start output + sourceStart sourceMiddle sourceResult resultWorld emit av + +def LowerSpineValueProgressesWithin (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {world : Owned} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal}, + SourceSpineEval sourceCtx sourceEnv head args sourceResult → + (lowerSpine src fuel input world head args).run state = + .ok (output, emit, av) finalState → + ExtraExtends finalState ambient → + SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av + +/-- Strong expression progress restricted to executions carrying an explicit +constructor-only projection trace. -/ +def LowerEValueProgressesSafelyWithin (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {world : Owned} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal}, + ProjectionSafeEval sourceCtx sourceEnv expr sourceValue → + (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState → + ExtraExtends finalState ambient → + SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue world emit av + +def LowerBorrowValueProgressesSafelyWithin (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + {release : Bool}, + ProjectionSafeEval sourceCtx sourceEnv expr sourceValue → + (lowerBorrow src fuel input expr).run state = + .ok (output, emit, av, release) finalState → + ExtraExtends finalState ambient → + SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerBorrowValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue emit av release + +def LowerArgsValueProgressesSafelyWithin (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {sourceEnv sourceValues : List IxIR0.Value} + {args : List (IxIR0.Expr × Owned)} {state finalState : LowSt} + {emit : Emit} {avs : List AVal}, + ProjectionSafeArgs sourceCtx sourceEnv (args.map Prod.fst) + sourceValues → + (lowerArgs src fuel input args).run state = + .ok (output, emit, avs) finalState → + ExtraExtends finalState ambient → + SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerArgsValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValues (args.map Prod.snd) emit avs + +def ApplyRestNonErasedValueProgressesSafelyWithin + (funRel : Sim.FunctionRel) (recSelfRel : RecSelfRel) + (sourceCtx : IxIR0.Ctx) (ctx : Ctx) (cur : FnDef) + (src : IxIR0.Env) (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {start input output : VEnv} + {sourceStart sourceMiddle sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {resultWorld : Owned} {emitFunction emit : Emit} + {function av : AVal} {args : List IxIR0.Expr} + {state finalState : LowSt}, + function ≠ .constA .erased → + ProjectionSafeArgs sourceCtx sourceMiddle args sourceArgs → + SourceApplies sourceCtx sourceFunction sourceArgs sourceResult → + LowerResultValueProgress funRel recSelfRel ctx cur start input + sourceStart sourceMiddle sourceFunction .shared emitFunction + function → + (applyRest src fuel input resultWorld emitFunction function args).run + state = .ok (output, emit, av) finalState → + ExtraExtends finalState ambient → + SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerResultValueProgress funRel recSelfRel ctx cur start output + sourceStart sourceMiddle sourceResult resultWorld emit av + +def LowerSpineValueProgressesSafelyWithin (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {world : Owned} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal}, + ProjectionSafeSpine sourceCtx sourceEnv head args sourceResult → + (lowerSpine src fuel input world head args).run state = + .ok (output, emit, av) finalState → + ExtraExtends finalState ambient → + SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av + +/-! ### Exact-trace lowering interfaces + +These judgments retain the source evaluator's numeric fuel instead of +collapsing it to `ProjectionSafeEval`. `limit` is the outer strong-induction +index used while sealing callable progress; every source execution consumed +by the lowering is strictly below it. -/ + +def LowerEValueTraceProgressesWithinBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {world : Owned} {expr : IxIR0.Expr} + {sourceFuel : Nat} {sourceEnv : List IxIR0.Value} + {sourceValue : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal}, + sourceFuel < limit → + IxIR0.ProjectionSafe.Eval sourceCtx sourceFuel sourceEnv expr + sourceValue → + (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState → + ExtraExtends finalState ambient → + SelfTraceProgressAvailableBelow funRel recSelfRel sourceCtx ctx cur + limit input → + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue world emit av + +def LowerBorrowValueTraceProgressesWithinBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {expr : IxIR0.Expr} {sourceFuel : Nat} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + {release : Bool}, + sourceFuel < limit → + IxIR0.ProjectionSafe.Eval sourceCtx sourceFuel sourceEnv expr + sourceValue → + (lowerBorrow src fuel input expr).run state = + .ok (output, emit, av, release) finalState → + ExtraExtends finalState ambient → + SelfTraceProgressAvailableBelow funRel recSelfRel sourceCtx ctx cur + limit input → + LowerBorrowValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue emit av release + +def LowerArgsValueTraceProgressesWithinBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {sourceLimit : Nat} + {sourceEnv sourceValues : List IxIR0.Value} + {args : List (IxIR0.Expr × Owned)} {state finalState : LowSt} + {emit : Emit} {avs : List AVal}, + sourceLimit < limit → + IxIR0.ProjectionSafe.EvalsBelow sourceCtx sourceLimit sourceEnv + (args.map Prod.fst) sourceValues → + (lowerArgs src fuel input args).run state = + .ok (output, emit, avs) finalState → + ExtraExtends finalState ambient → + SelfTraceProgressAvailableBelow funRel recSelfRel sourceCtx ctx cur + limit input → + LowerArgsValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValues (args.map Prod.snd) emit avs + +def ApplyRestNonErasedValueTraceProgressesWithinBelow + (funRel : Sim.FunctionRel) (recSelfRel : RecSelfRel) + (sourceCtx : IxIR0.Ctx) (ctx : Ctx) (cur : FnDef) (limit : Nat) + (src : IxIR0.Env) (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {start input output : VEnv} {sourceLimit : Nat} + {sourceStart sourceMiddle sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {resultWorld : Owned} {emitFunction emit : Emit} + {function av : AVal} {args : List IxIR0.Expr} + {state finalState : LowSt}, + sourceLimit < limit → + function ≠ .constA .erased → + IxIR0.ProjectionSafe.EvalsBelow sourceCtx sourceLimit sourceMiddle args + sourceArgs → + SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction sourceArgs + sourceResult → + sourceArgs ≠ [] → + LowerResultValueProgress funRel recSelfRel ctx cur start input + sourceStart sourceMiddle sourceFunction .shared emitFunction + function → + (applyRest src fuel input resultWorld emitFunction function args).run + state = .ok (output, emit, av) finalState → + ExtraExtends finalState ambient → + SelfTraceProgressAvailableBelow funRel recSelfRel sourceCtx ctx cur + limit input → + LowerResultValueProgress funRel recSelfRel ctx cur start output + sourceStart sourceMiddle sourceResult resultWorld emit av + +def LowerSpineValueTraceProgressesWithinBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {world : Owned} {sourceLimit : Nat} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal}, + sourceLimit < limit → + IxIR0.ProjectionSafe.Spine sourceCtx sourceLimit sourceEnv head args + sourceResult → + (args ≠ [] ∨ ∃ address, head = .ref address) → + (lowerSpine src fuel input world head args).run state = + .ok (output, emit, av) finalState → + ExtraExtends finalState ambient → + SelfTraceProgressAvailableBelow funRel recSelfRel sourceCtx ctx cur + limit input → + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av + +/-- Weaker recursive expression interface used by the generic memory-safety +cluster. It differs from successful progress only in the emitted-prefix +judgment; semantic partial correctness is retained unchanged. -/ +def LowerEValueSettlesWithin (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {world : Owned} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal}, + IxIR0.eval sourceCtx sourceFuel sourceEnv expr = .ok sourceValue → + (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState → + ExtraExtends finalState ambient → + SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerResultValueSettlement funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue world emit av + +def LowerBorrowValueSettlesWithin (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal} {release : Bool}, + IxIR0.eval sourceCtx sourceFuel sourceEnv expr = .ok sourceValue → + (lowerBorrow src fuel input expr).run state = + .ok (output, emit, av, release) finalState → + ExtraExtends finalState ambient → + SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerBorrowValueSettlement funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue emit av release + +def LowerArgsValueSettlesWithin (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {sourceEnv sourceValues : List IxIR0.Value} + {args : List (IxIR0.Expr × Owned)} {state finalState : LowSt} + {emit : Emit} {avs : List AVal}, + SourceArgsEval sourceCtx sourceEnv (args.map Prod.fst) sourceValues → + (lowerArgs src fuel input args).run state = + .ok (output, emit, avs) finalState → + ExtraExtends finalState ambient → + SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerArgsValueSettlement funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValues (args.map Prod.snd) emit avs + +def ApplyRestNonErasedValueSettlesWithin (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {start input output : VEnv} + {sourceStart sourceMiddle sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {resultWorld : Owned} {emitFunction emit : Emit} + {function av : AVal} {args : List IxIR0.Expr} + {state finalState : LowSt}, + function ≠ .constA .erased → + SourceArgsEval sourceCtx sourceMiddle args sourceArgs → + SourceApplies sourceCtx sourceFunction sourceArgs sourceResult → + LowerResultValueSettlement funRel recSelfRel ctx cur start input + sourceStart sourceMiddle sourceFunction .shared emitFunction + function → + (applyRest src fuel input resultWorld emitFunction function args).run + state = .ok (output, emit, av) finalState → + ExtraExtends finalState ambient → + SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerResultValueSettlement funRel recSelfRel ctx cur start output + sourceStart sourceMiddle sourceResult resultWorld emit av + +def LowerSpineValueSettlesWithin (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {world : Owned} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal}, + SourceSpineEval sourceCtx sourceEnv head args sourceResult → + (lowerSpine src fuel input world head args).run state = + .ok (output, emit, av) finalState → + ExtraExtends finalState ambient → + SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerResultValueSettlement funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av + +theorem LowerEValueProgressesWithin.settles + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hprogress : LowerEValueProgressesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) : + LowerEValueSettlesWithin funRel recSelfRel sourceCtx ctx cur src ambient + fuel := by + intro input output world expr sourceEnv sourceFuel sourceValue state + finalState emit av hsource hrun hextends havailable + exact (hprogress hsource hrun hextends havailable).settlement + +theorem LowerBorrowValueProgressesWithin.settles + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hprogress : LowerBorrowValueProgressesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) : + LowerBorrowValueSettlesWithin funRel recSelfRel sourceCtx ctx cur src + ambient fuel := by + intro input output expr sourceEnv sourceFuel sourceValue state finalState + emit av release hsource hrun hextends havailable + exact (hprogress hsource hrun hextends havailable).settlement + +theorem LowerArgsValueProgressesWithin.settles + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hprogress : LowerArgsValueProgressesWithin funRel recSelfRel sourceCtx + ctx cur src ambient fuel) : + LowerArgsValueSettlesWithin funRel recSelfRel sourceCtx ctx cur src + ambient fuel := by + intro input output sourceEnv sourceValues args state finalState emit avs + hsource hrun hextends havailable + exact (hprogress hsource hrun hextends havailable).settlement + +theorem LowerSpineValueProgressesWithin.settles + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hprogress : LowerSpineValueProgressesWithin funRel recSelfRel sourceCtx + ctx cur src ambient fuel) : + LowerSpineValueSettlesWithin funRel recSelfRel sourceCtx ctx cur src + ambient fuel := by + intro input output world head args sourceEnv sourceResult state finalState + emit av hsource hrun hextends havailable + exact (hprogress hsource hrun hextends havailable).settlement + +theorem lowerEValueProgressesWithin_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} : + LowerEValueProgressesWithin funRel recSelfRel sourceCtx ctx cur src + ambient 0 := by + intro input output world expr sourceEnv sourceFuel sourceValue state + finalState emit av _ hrun _ _ + exact (lowerE_noSuccess_zero src input world expr hrun).elim + +theorem lowerBorrowValueProgressesWithin_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} : + LowerBorrowValueProgressesWithin funRel recSelfRel sourceCtx ctx cur src + ambient 0 := by + intro input output expr sourceEnv sourceFuel sourceValue state finalState + emit av release _ hrun _ _ + exact (lowerBorrow_noSuccess_zero src input expr hrun).elim + +theorem lowerSpineValueProgressesWithin_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} : + LowerSpineValueProgressesWithin funRel recSelfRel sourceCtx ctx cur src + ambient 0 := by + intro input output world head args sourceEnv sourceResult state finalState + emit av _ hrun _ _ + exact (lowerSpine_noSuccess_zero src input world head args hrun).elim + +theorem lowerSpineValueProgressesWithin_one + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} : + LowerSpineValueProgressesWithin funRel recSelfRel sourceCtx ctx cur src + ambient 1 := by + intro input output world head args sourceEnv sourceResult state finalState + emit av _ hrun _ _ + exact (lowerSpine_noSuccess_one src input world head args hrun).elim + +theorem lowerArgsValueProgressesWithin_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} : + LowerArgsValueProgressesWithin funRel recSelfRel sourceCtx ctx cur src + ambient 0 := by + intro input output sourceEnv sourceValues args state finalState emit avs + _ hrun _ _ + exact (lowerArgs_noSuccess_zero src input args hrun).elim + +theorem applyRestNonErasedValueProgressesWithin_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} : + ApplyRestNonErasedValueProgressesWithin funRel recSelfRel sourceCtx ctx + cur src ambient 0 := by + intro start input output sourceStart sourceMiddle sourceArgs + sourceFunction sourceResult resultWorld emitFunction emit function av + args state finalState _ _ _ _ hrun _ _ + exact (applyRest_noSuccess_zero src input resultWorld emitFunction + function args hrun).elim + +/-- Reachable-state argument progress. The head's progressing emitter frames +its result while the recursively progressing tail is compiled and executed. -/ +theorem lowerArgsValueProgressesWithin_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEValueProgressesWithin funRel recSelfRel sourceCtx ctx cur + src ambient fuel) + (htail : LowerArgsValueProgressesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) : + LowerArgsValueProgressesWithin funRel recSelfRel sourceCtx ctx cur src + ambient (fuel + 1) := by + intro input output sourceEnv sourceValues args state finalState emit avs + hsource hrun hextends havailable + cases args with + | nil => + cases hsource + have hpure : + (input, (_root_.id : Emit), []) = (output, emit, avs) ∧ + state = finalState := by + simpa [lowerArgs] using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact lowerArgs_nil_value_progress + | cons arg args => + rcases arg with ⟨expr, world⟩ + change SourceArgsEval sourceCtx sourceEnv + (expr :: args.map Prod.fst) sourceValues at hsource + cases hsource with + | cons hsourceHead hsourceTail => + simp only [lowerArgs] at hrun + obtain ⟨headResult, middleState, hheadRun, hafterHead⟩ := + trackedBindRun_ok_inv hrun + rcases headResult with ⟨middle, emitHead, av⟩ + dsimp only at hafterHead + obtain ⟨tailResult, tailState, htailRun, hpureRun⟩ := + trackedBindRun_ok_inv hafterHead + rcases tailResult with ⟨actualOutput, emitTail, tailAVals⟩ + have hpure : + (actualOutput, emitHead ∘ emitTail, av :: tailAVals) = + (output, emit, avs) ∧ tailState = finalState := by + simpa using hpureRun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + have hmiddleExtends : ExtraExtends middleState ambient := + (lowerArgs_extraExtends htailRun).trans hextends + have hheadProgress := + hexpr hsourceHead hheadRun hmiddleExtends havailable + have htailProgress := htail hsourceTail htailRun hextends + (havailable.lowerE hheadRun) + exact hheadProgress.consArgs htailProgress + +/-- Complete borrowing-position progress step: variables use the direct +borrow rules, while every other head delegates to predecessor expression +progress and a pure descriptor adapter. -/ +theorem lowerBorrowValueProgressesWithin_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEValueProgressesWithin funRel recSelfRel sourceCtx ctx cur + src ambient fuel) : + LowerBorrowValueProgressesWithin funRel recSelfRel sourceCtx ctx cur src + ambient (fuel + 1) := by + intro input output expr sourceEnv sourceFuel sourceValue state finalState + emit av release hsource hrun hextends havailable + cases expr with + | var index => + exact lowerBorrow_var_run_value_progress (sourceEval_var_inv hsource) + hrun + | ref address => + exact lowerBorrow_dynamic_run_value_progress_within + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.ref address) hrun hextends + | app function argument => + exact lowerBorrow_dynamic_run_value_progress_within + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.app function argument) hrun hextends + | lam uses body => + exact lowerBorrow_dynamic_run_value_progress_within + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.lam uses body) hrun hextends + | letE uses value body => + exact lowerBorrow_dynamic_run_value_progress_within + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.letE uses value body) hrun hextends + | proj index source => + exact lowerBorrow_dynamic_run_value_progress_within + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.proj index source) hrun hextends + | lit literal => + exact lowerBorrow_dynamic_run_value_progress_within + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.lit literal) hrun hextends + | erased => + exact lowerBorrow_dynamic_run_value_progress_within + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + .erased hrun hextends + +theorem lowerEValueProgressesSafelyWithin_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} : + LowerEValueProgressesSafelyWithin funRel recSelfRel sourceCtx ctx cur + src ambient 0 := by + intro input output world expr sourceEnv sourceValue state finalState emit + av _ hrun _ _ + exact (lowerE_noSuccess_zero src input world expr hrun).elim + +theorem lowerBorrowValueProgressesSafelyWithin_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} : + LowerBorrowValueProgressesSafelyWithin funRel recSelfRel sourceCtx ctx + cur src ambient 0 := by + intro input output expr sourceEnv sourceValue state finalState emit av + release _ hrun _ _ + exact (lowerBorrow_noSuccess_zero src input expr hrun).elim + +theorem lowerArgsValueProgressesSafelyWithin_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} : + LowerArgsValueProgressesSafelyWithin funRel recSelfRel sourceCtx ctx cur + src ambient 0 := by + intro input output sourceEnv sourceValues args state finalState emit avs + _ hrun _ _ + exact (lowerArgs_noSuccess_zero src input args hrun).elim + +theorem lowerSpineValueProgressesSafelyWithin_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} : + LowerSpineValueProgressesSafelyWithin funRel recSelfRel sourceCtx ctx cur + src ambient 0 := by + intro input output world head args sourceEnv sourceResult state finalState + emit av _ hrun _ _ + exact (lowerSpine_noSuccess_zero src input world head args hrun).elim + +theorem lowerSpineValueProgressesSafelyWithin_one + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} : + LowerSpineValueProgressesSafelyWithin funRel recSelfRel sourceCtx ctx cur + src ambient 1 := by + intro input output world head args sourceEnv sourceResult state finalState + emit av _ hrun _ _ + exact (lowerSpine_noSuccess_one src input world head args hrun).elim + +theorem applyRestNonErasedValueProgressesSafelyWithin_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} : + ApplyRestNonErasedValueProgressesSafelyWithin funRel recSelfRel + sourceCtx ctx cur src ambient 0 := by + intro start input output sourceStart sourceMiddle sourceArgs + sourceFunction sourceResult resultWorld emitFunction emit function av + args state finalState _ _ _ _ hrun _ _ + exact (applyRest_noSuccess_zero src input resultWorld emitFunction + function args hrun).elim + +/-- Projection-safe left-to-right argument progress. -/ +theorem lowerArgsValueProgressesSafelyWithin_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEValueProgressesSafelyWithin funRel recSelfRel sourceCtx + ctx cur src ambient fuel) + (htail : LowerArgsValueProgressesSafelyWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) : + LowerArgsValueProgressesSafelyWithin funRel recSelfRel sourceCtx ctx cur + src ambient (fuel + 1) := by + intro input output sourceEnv sourceValues args state finalState emit avs + hsource hrun hextends havailable + cases args with + | nil => + cases hsource + have hpure : + (input, (_root_.id : Emit), []) = (output, emit, avs) ∧ + state = finalState := by + simpa [lowerArgs] using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact lowerArgs_nil_value_progress + | cons arg args => + rcases arg with ⟨expr, world⟩ + change ProjectionSafeArgs sourceCtx sourceEnv + (expr :: args.map Prod.fst) sourceValues at hsource + cases hsource with + | cons hsourceHead hsourceTail => + simp only [lowerArgs] at hrun + obtain ⟨headResult, middleState, hheadRun, hafterHead⟩ := + trackedBindRun_ok_inv hrun + rcases headResult with ⟨middle, emitHead, av⟩ + dsimp only at hafterHead + obtain ⟨tailResult, tailState, htailRun, hpureRun⟩ := + trackedBindRun_ok_inv hafterHead + rcases tailResult with ⟨actualOutput, emitTail, tailAVals⟩ + have hpure : + (actualOutput, emitHead ∘ emitTail, av :: tailAVals) = + (output, emit, avs) ∧ tailState = finalState := by + simpa using hpureRun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + have hmiddleExtends : ExtraExtends middleState ambient := + (lowerArgs_extraExtends htailRun).trans hextends + have hheadProgress := + hexpr hsourceHead hheadRun hmiddleExtends havailable + have htailProgress := htail hsourceTail htailRun hextends + (havailable.lowerE hheadRun) + exact hheadProgress.consArgs htailProgress + +/-- Projection-safe borrowing-position progress. -/ +theorem lowerBorrowValueProgressesSafelyWithin_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEValueProgressesSafelyWithin funRel recSelfRel sourceCtx + ctx cur src ambient fuel) : + LowerBorrowValueProgressesSafelyWithin funRel recSelfRel sourceCtx ctx + cur src ambient (fuel + 1) := by + intro input output expr sourceEnv sourceValue state finalState emit av + release hsource hrun hextends havailable + cases expr with + | var index => + cases hsource with + | var hlookup => exact lowerBorrow_var_run_value_progress hlookup hrun + | ref address => + exact lowerBorrow_dynamic_run_value_progress_within + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.ref address) hrun hextends + | app function argument => + exact lowerBorrow_dynamic_run_value_progress_within + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.app function argument) hrun hextends + | lam uses body => + exact lowerBorrow_dynamic_run_value_progress_within + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.lam uses body) hrun hextends + | letE uses value body => + exact lowerBorrow_dynamic_run_value_progress_within + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.letE uses value body) hrun hextends + | proj index source => + exact lowerBorrow_dynamic_run_value_progress_within + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.proj index source) hrun hextends + | lit literal => + exact lowerBorrow_dynamic_run_value_progress_within + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.lit literal) hrun hextends + | erased => + exact lowerBorrow_dynamic_run_value_progress_within + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + .erased hrun hextends + +theorem lowerEValueTraceProgressesWithinBelow_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {ambient : LowSt} : + LowerEValueTraceProgressesWithinBelow funRel recSelfRel sourceCtx ctx + cur limit src ambient 0 := by + intro input output world expr sourceFuel sourceEnv sourceValue state + finalState emit av _ _ hrun _ _ + exact (lowerE_noSuccess_zero src input world expr hrun).elim + +theorem lowerBorrowValueTraceProgressesWithinBelow_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {ambient : LowSt} : + LowerBorrowValueTraceProgressesWithinBelow funRel recSelfRel sourceCtx + ctx cur limit src ambient 0 := by + intro input output expr sourceFuel sourceEnv sourceValue state finalState + emit av release _ _ hrun _ _ + exact (lowerBorrow_noSuccess_zero src input expr hrun).elim + +theorem lowerArgsValueTraceProgressesWithinBelow_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {ambient : LowSt} : + LowerArgsValueTraceProgressesWithinBelow funRel recSelfRel sourceCtx ctx + cur limit src ambient 0 := by + intro input output sourceLimit sourceEnv sourceValues args state + finalState emit avs _ _ hrun _ _ + exact (lowerArgs_noSuccess_zero src input args hrun).elim + +theorem lowerSpineValueTraceProgressesWithinBelow_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {ambient : LowSt} : + LowerSpineValueTraceProgressesWithinBelow funRel recSelfRel sourceCtx + ctx cur limit src ambient 0 := by + intro input output world sourceLimit head args sourceEnv sourceResult state + finalState emit av _ _ _ hrun _ _ + exact (lowerSpine_noSuccess_zero src input world head args hrun).elim + +theorem lowerSpineValueTraceProgressesWithinBelow_one + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {ambient : LowSt} : + LowerSpineValueTraceProgressesWithinBelow funRel recSelfRel sourceCtx + ctx cur limit src ambient 1 := by + intro input output world sourceLimit head args sourceEnv sourceResult state + finalState emit av _ _ _ hrun _ _ + exact (lowerSpine_noSuccess_one src input world head args hrun).elim + +theorem applyRestNonErasedValueTraceProgressesWithinBelow_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {ambient : LowSt} : + ApplyRestNonErasedValueTraceProgressesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient 0 := by + intro start input output sourceLimit sourceStart sourceMiddle sourceArgs + sourceFunction sourceResult resultWorld emitFunction emit function av + args state finalState _ _ _ _ _ _ hrun _ _ + exact (applyRest_noSuccess_zero src input resultWorld emitFunction + function args hrun).elim + +/-- Exact-trace left-to-right argument progress. Each element's evaluator +fuel is strictly below the list's common bound and hence below the outer +callable-sealing index. -/ +theorem lowerArgsValueTraceProgressesWithinBelow_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEValueTraceProgressesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + (htail : LowerArgsValueTraceProgressesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) : + LowerArgsValueTraceProgressesWithinBelow funRel recSelfRel sourceCtx ctx + cur limit src ambient (fuel + 1) := by + intro input output sourceLimit sourceEnv sourceValues args state finalState + emit avs hlimit hsource hrun hextends havailable + cases args with + | nil => + cases hsource + have hpure : + (input, (_root_.id : Emit), []) = (output, emit, avs) ∧ + state = finalState := by + simpa [lowerArgs] using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact lowerArgs_nil_value_progress + | cons arg args => + rcases arg with ⟨expr, world⟩ + change IxIR0.ProjectionSafe.EvalsBelow sourceCtx sourceLimit sourceEnv + (expr :: args.map Prod.fst) sourceValues at hsource + cases hsource with + | cons hheadFuel hsourceHead hsourceTail => + simp only [lowerArgs] at hrun + obtain ⟨headResult, middleState, hheadRun, hafterHead⟩ := + trackedBindRun_ok_inv hrun + rcases headResult with ⟨middle, emitHead, av⟩ + dsimp only at hafterHead + obtain ⟨tailResult, tailState, htailRun, hpureRun⟩ := + trackedBindRun_ok_inv hafterHead + rcases tailResult with ⟨actualOutput, emitTail, tailAVals⟩ + have hpure : + (actualOutput, emitHead ∘ emitTail, av :: tailAVals) = + (output, emit, avs) ∧ tailState = finalState := by + simpa using hpureRun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + have hmiddleExtends : ExtraExtends middleState ambient := + (lowerArgs_extraExtends htailRun).trans hextends + have hheadProgress := + hexpr (Nat.lt_trans hheadFuel hlimit) hsourceHead hheadRun + hmiddleExtends havailable + have htailProgress := htail hlimit hsourceTail htailRun hextends + (havailable.lowerE hheadRun) + exact hheadProgress.consArgs htailProgress + +/-- Exact-trace borrowing-position progress. -/ +theorem lowerBorrowValueTraceProgressesWithinBelow_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEValueTraceProgressesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) : + LowerBorrowValueTraceProgressesWithinBelow funRel recSelfRel sourceCtx + ctx cur limit src ambient (fuel + 1) := by + intro input output expr sourceFuel sourceEnv sourceValue state finalState + emit av release hlimit hsource hrun hextends havailable + cases expr with + | var index => + cases hsource with + | var hlookup => exact lowerBorrow_var_run_value_progress hlookup hrun + | ref address => + exact lowerBorrow_dynamic_run_value_progress_within + (fun hsubrun hwithin => + hexpr hlimit hsource hsubrun hwithin havailable) + (.ref address) hrun hextends + | app function argument => + exact lowerBorrow_dynamic_run_value_progress_within + (fun hsubrun hwithin => + hexpr hlimit hsource hsubrun hwithin havailable) + (.app function argument) hrun hextends + | lam uses body => + exact lowerBorrow_dynamic_run_value_progress_within + (fun hsubrun hwithin => + hexpr hlimit hsource hsubrun hwithin havailable) + (.lam uses body) hrun hextends + | letE uses value body => + exact lowerBorrow_dynamic_run_value_progress_within + (fun hsubrun hwithin => + hexpr hlimit hsource hsubrun hwithin havailable) + (.letE uses value body) hrun hextends + | proj index source => + exact lowerBorrow_dynamic_run_value_progress_within + (fun hsubrun hwithin => + hexpr hlimit hsource hsubrun hwithin havailable) + (.proj index source) hrun hextends + | lit literal => + exact lowerBorrow_dynamic_run_value_progress_within + (fun hsubrun hwithin => + hexpr hlimit hsource hsubrun hwithin havailable) + (.lit literal) hrun hextends + | erased => + exact lowerBorrow_dynamic_run_value_progress_within + (fun hsubrun hwithin => + hexpr hlimit hsource hsubrun hwithin havailable) + .erased hrun hextends + +theorem lowerEValueSettlesWithin_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} : + LowerEValueSettlesWithin funRel recSelfRel sourceCtx ctx cur src ambient + 0 := + lowerEValueProgressesWithin_zero.settles + +theorem lowerBorrowValueSettlesWithin_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} : + LowerBorrowValueSettlesWithin funRel recSelfRel sourceCtx ctx cur src + ambient 0 := + lowerBorrowValueProgressesWithin_zero.settles + +theorem lowerArgsValueSettlesWithin_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} : + LowerArgsValueSettlesWithin funRel recSelfRel sourceCtx ctx cur src + ambient 0 := + lowerArgsValueProgressesWithin_zero.settles + +theorem lowerSpineValueSettlesWithin_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} : + LowerSpineValueSettlesWithin funRel recSelfRel sourceCtx ctx cur src + ambient 0 := + lowerSpineValueProgressesWithin_zero.settles + +theorem lowerSpineValueSettlesWithin_one + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} : + LowerSpineValueSettlesWithin funRel recSelfRel sourceCtx ctx cur src + ambient 1 := + lowerSpineValueProgressesWithin_one.settles + +theorem applyRestNonErasedValueSettlesWithin_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} : + ApplyRestNonErasedValueSettlesWithin funRel recSelfRel sourceCtx ctx cur + src ambient 0 := by + intro start input output sourceStart sourceMiddle sourceArgs + sourceFunction sourceResult resultWorld emitFunction emit function av + args state finalState _ _ _ _ hrun _ _ + exact (applyRest_noSuccess_zero src input resultWorld emitFunction + function args hrun).elim + +/-- Left-to-right argument settlement propagates a terminal head without +requiring the tail, and otherwise continues through the protected head root. -/ +theorem lowerArgsValueSettlesWithin_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEValueSettlesWithin funRel recSelfRel sourceCtx ctx cur + src ambient fuel) + (htail : LowerArgsValueSettlesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) : + LowerArgsValueSettlesWithin funRel recSelfRel sourceCtx ctx cur src + ambient (fuel + 1) := by + intro input output sourceEnv sourceValues args state finalState emit avs + hsource hrun hextends havailable + cases args with + | nil => + cases hsource + have hpure : + (input, (_root_.id : Emit), []) = (output, emit, avs) ∧ + state = finalState := by + simpa [lowerArgs] using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact lowerArgs_nil_value_progress.settlement + | cons arg args => + rcases arg with ⟨expr, world⟩ + change SourceArgsEval sourceCtx sourceEnv + (expr :: args.map Prod.fst) sourceValues at hsource + cases hsource with + | cons hsourceHead hsourceTail => + simp only [lowerArgs] at hrun + obtain ⟨headResult, middleState, hheadRun, hafterHead⟩ := + trackedBindRun_ok_inv hrun + rcases headResult with ⟨middle, emitHead, av⟩ + dsimp only at hafterHead + obtain ⟨tailResult, tailState, htailRun, hpureRun⟩ := + trackedBindRun_ok_inv hafterHead + rcases tailResult with ⟨actualOutput, emitTail, tailAVals⟩ + have hpure : + (actualOutput, emitHead ∘ emitTail, av :: tailAVals) = + (output, emit, avs) ∧ tailState = finalState := by + simpa using hpureRun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + have hmiddleExtends : ExtraExtends middleState ambient := + (lowerArgs_extraExtends htailRun).trans hextends + have hheadSettles := + hexpr hsourceHead hheadRun hmiddleExtends havailable + have htailSettles := htail hsourceTail htailRun hextends + (havailable.lowerE hheadRun) + exact hheadSettles.consArgs htailSettles + +/-- Borrow settlement closes recursively even when predecessor expression +lowering may stop before producing a descriptor. -/ +theorem lowerBorrowValueSettlesWithin_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEValueSettlesWithin funRel recSelfRel sourceCtx ctx cur + src ambient fuel) : + LowerBorrowValueSettlesWithin funRel recSelfRel sourceCtx ctx cur src + ambient (fuel + 1) := by + intro input output expr sourceEnv sourceFuel sourceValue state finalState + emit av release hsource hrun hextends havailable + cases expr with + | var index => + exact (lowerBorrow_var_run_value_progress + (sourceEval_var_inv hsource) hrun).settlement + | ref address => + exact lowerBorrow_dynamic_run_value_settlement_within + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.ref address) hrun hextends + | app function argument => + exact lowerBorrow_dynamic_run_value_settlement_within + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.app function argument) hrun hextends + | lam uses body => + exact lowerBorrow_dynamic_run_value_settlement_within + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.lam uses body) hrun hextends + | letE uses value body => + exact lowerBorrow_dynamic_run_value_settlement_within + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.letE uses value body) hrun hextends + | proj index source => + exact lowerBorrow_dynamic_run_value_settlement_within + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.proj index source) hrun hextends + | lit literal => + exact lowerBorrow_dynamic_run_value_settlement_within + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + (.lit literal) hrun hextends + | erased => + exact lowerBorrow_dynamic_run_value_settlement_within + (fun hsubrun hwithin => + hexpr hsource hsubrun hwithin havailable) + .erased hrun hextends + +/-- Source-guided function-body progress constructs a successful `invoke`; +the established ownership and value contracts recover all three post-state +invariants and discharge `checkResultWorld`. -/ +theorem invoke_fn_value_trace_progress_at + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + {sourceLimit : Nat} {address : Ixon.Address} {d : FnDef} + {argWorlds : List Owned} {sourceFunction : IxIR0.Value} + {store : Store} {args : List RVal} + {sourceArgs : List IxIR0.Value} {sourceResult : IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hdecl : ctx.decls address = some (.fn d)) + (harity : argWorlds.length = d.arity) + (hprogress : FnValueTraceProgressesAt funRel sourceCtx ctx d + argWorlds sourceFunction sourceLimit) + (hownership : FnOwnershipContract ctx d argWorlds) + (hvalue : FnValueContract funRel sourceCtx ctx d argWorlds + sourceFunction) + (hlength : args.length = argWorlds.length) + (hargs : Sim.ValuesGraph funRel store sourceArgs args) + (hsource : SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + sourceArgs sourceResult) + (hframe : Sim.RootsGraph funRel store sourceRest rest) + (hown : RootOwnership store + (rootsForWorlds argWorlds args ++ rest)) : + ∃ fuel store' value, + invoke ctx fuel address args store = .ok (store', value) ∧ + Sim.ValueGraph funRel store' sourceResult value ∧ + Sim.RootsGraph funRel store' sourceRest rest ∧ + RootOwnership store' (⟨d.result, value⟩ :: rest) := by + obtain ⟨bodyFuel, store', value, hbody⟩ := + hprogress hlength hargs hsource hframe hown + have hown' : RootOwnership store' (⟨d.result, value⟩ :: rest) := + hownership.preserves hlength hown hbody + have hsemantic := hvalue.preserves hlength hargs hsource.sourceApplies + hframe hown hbody + have hworld : HasWorld store' d.result value := + hown'.roots_world ⟨d.result, value⟩ (by simp) + have hcheck : checkResultWorld d.result (store', value) = + .ok (store', value) := by + simp [checkResultWorld, rval_hasWorld_eq_true_iff.mpr hworld] + have htargetArity : args.length = d.arity := hlength.trans harity + have hinvoke : invoke ctx (bodyFuel + 1) address args store = + .ok (store', value) := by + rw [invoke.eq_def] + dsimp only + rw [hdecl] + dsimp only + simp only [htargetArity] + simp + rw [hbody, bindOk] + exact hcheck + exact ⟨bodyFuel + 1, store', value, hinvoke, + hsemantic.1, hsemantic.2, hown'⟩ + +/-- Pointwise wrapper around `invoke_fn_value_trace_progress_at`. Keeping +the exact-bound lemma separate is what lets the whole-pass seal consume a +`CompilerTraceProgressContractsBelow` package during strong source-fuel +induction. -/ +theorem invoke_fn_value_trace_progress + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + {sourceLimit : Nat} {address : Ixon.Address} {d : FnDef} + {argWorlds : List Owned} {sourceFunction : IxIR0.Value} + {store : Store} {args : List RVal} + {sourceArgs : List IxIR0.Value} {sourceResult : IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hdecl : ctx.decls address = some (.fn d)) + (hprogress : FnValueTraceProgressContract funRel sourceCtx ctx d + argWorlds sourceFunction) + (hownership : FnOwnershipContract ctx d argWorlds) + (hvalue : FnValueContract funRel sourceCtx ctx d argWorlds + sourceFunction) + (hlength : args.length = argWorlds.length) + (hargs : Sim.ValuesGraph funRel store sourceArgs args) + (hsource : SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + sourceArgs sourceResult) + (hframe : Sim.RootsGraph funRel store sourceRest rest) + (hown : RootOwnership store + (rootsForWorlds argWorlds args ++ rest)) : + ∃ fuel store' value, + invoke ctx fuel address args store = .ok (store', value) ∧ + Sim.ValueGraph funRel store' sourceResult value ∧ + Sim.RootsGraph funRel store' sourceRest rest ∧ + RootOwnership store' (⟨d.result, value⟩ :: rest) := by + exact invoke_fn_value_trace_progress_at hdecl hprogress.arity_eq + (hprogress.progresses sourceLimit) hownership hvalue hlength hargs + hsource hframe hown + +/-- Legacy fuel-free callable adapter. New sealed progress uses +`invoke_fn_value_trace_progress`; this theorem remains for callers that +explicitly provide the stronger monolithic contract. -/ +theorem invoke_fn_value_progress + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + {address : Ixon.Address} {d : FnDef} {argWorlds : List Owned} + {sourceFunction : IxIR0.Value} {store : Store} {args : List RVal} + {sourceArgs : List IxIR0.Value} {sourceResult : IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hdecl : ctx.decls address = some (.fn d)) + (hprogress : FnValueProgressContract funRel sourceCtx ctx d argWorlds + sourceFunction) + (hownership : FnOwnershipContract ctx d argWorlds) + (hvalue : FnValueContract funRel sourceCtx ctx d argWorlds + sourceFunction) + (hlength : args.length = argWorlds.length) + (hargs : Sim.ValuesGraph funRel store sourceArgs args) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs sourceResult) + (hframe : Sim.RootsGraph funRel store sourceRest rest) + (hown : RootOwnership store + (rootsForWorlds argWorlds args ++ rest)) : + ∃ fuel store' value, + invoke ctx fuel address args store = .ok (store', value) ∧ + Sim.ValueGraph funRel store' sourceResult value ∧ + Sim.RootsGraph funRel store' sourceRest rest ∧ + RootOwnership store' (⟨d.result, value⟩ :: rest) := by + obtain ⟨bodyFuel, store', value, hbody⟩ := + hprogress.progresses hlength hargs hsource hframe hown + have hown' : RootOwnership store' (⟨d.result, value⟩ :: rest) := + hownership.preserves hlength hown hbody + have hsemantic := hvalue.preserves hlength hargs hsource hframe hown hbody + have hworld : HasWorld store' d.result value := + hown'.roots_world ⟨d.result, value⟩ (by simp) + have hcheck : checkResultWorld d.result (store', value) = + .ok (store', value) := by + simp [checkResultWorld, rval_hasWorld_eq_true_iff.mpr hworld] + have harity : args.length = d.arity := + hlength.trans hprogress.arity_eq + have hinvoke : invoke ctx (bodyFuel + 1) address args store = + .ok (store', value) := by + rw [invoke.eq_def] + dsimp only + rw [hdecl] + dsimp only + simp only [harity] + simp + rw [hbody, bindOk] + exact hcheck + exact ⟨bodyFuel + 1, store', value, hinvoke, + hsemantic.1, hsemantic.2, hown'⟩ + +/-- Source-guided higher-order progress, bundled with the semantic and +ownership postconditions supplied by the existing partial contracts. -/ +theorem apply_value_trace_progress_at + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + {sourceLimit : Nat} {store : Store} {function : RVal} + {args : List RVal} {sourceFunction : IxIR0.Value} + {sourceArgs : List IxIR0.Value} {sourceResult : IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hprogress : ApplyValueTraceProgressesAt funRel sourceCtx ctx sourceLimit) + (hownership : ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hfunction : Sim.ValueGraph funRel store sourceFunction function) + (hargs : Sim.ValuesGraph funRel store sourceArgs args) + (hsource : SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + sourceArgs sourceResult) + (hsourceArgsNonempty : sourceArgs ≠ []) + (hframe : Sim.RootsGraph funRel store sourceRest rest) + (hown : RootOwnership store + (⟨.shared, function⟩ :: rootsFor .shared args ++ rest)) : + ∃ fuel store' value, + applyGo ctx fuel store function args = .ok (store', value) ∧ + Sim.ValueGraph funRel store' sourceResult value ∧ + Sim.RootsGraph funRel store' sourceRest rest ∧ + RootOwnership store' (⟨.shared, value⟩ :: rest) := by + obtain ⟨fuel, store', value, hrun⟩ := + hprogress hfunction hargs hsource hsourceArgsNonempty hframe hown + have hsemantic := hvalue.preserves hfunction hargs hsource.sourceApplies + hframe hown hrun + exact ⟨fuel, store', value, hrun, hsemantic.1, hsemantic.2, + hownership.preserves hown hrun⟩ + +theorem apply_value_trace_progress + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + {sourceLimit : Nat} {store : Store} {function : RVal} + {args : List RVal} {sourceFunction : IxIR0.Value} + {sourceArgs : List IxIR0.Value} {sourceResult : IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hprogress : ApplyValueTraceProgressContract funRel sourceCtx ctx) + (hownership : ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hfunction : Sim.ValueGraph funRel store sourceFunction function) + (hargs : Sim.ValuesGraph funRel store sourceArgs args) + (hsource : SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + sourceArgs sourceResult) + (hsourceArgsNonempty : sourceArgs ≠ []) + (hframe : Sim.RootsGraph funRel store sourceRest rest) + (hown : RootOwnership store + (⟨.shared, function⟩ :: rootsFor .shared args ++ rest)) : + ∃ fuel store' value, + applyGo ctx fuel store function args = .ok (store', value) ∧ + Sim.ValueGraph funRel store' sourceResult value ∧ + Sim.RootsGraph funRel store' sourceRest rest ∧ + RootOwnership store' (⟨.shared, value⟩ :: rest) := by + exact apply_value_trace_progress_at + (hprogress.progresses sourceLimit) hownership hvalue hfunction hargs + hsource hsourceArgsNonempty hframe hown + +/-- Retaining a finite vector of live shared values cannot fail. This is +the fuel-free first half of `applyGo`'s PAP-consumption prefix. -/ +theorem dupVals_progress_of_hasWorld + {store : Store} {values : List RVal} + (hworld : ∀ value ∈ values, HasWorld store .shared value) : + ∃ store', dupVals store values = .ok store' := by + induction values generalizing store with + | nil => exact ⟨store, rfl⟩ + | cons head tail ih => + have htailWorld : ∀ value ∈ tail, HasWorld store .shared value := by + intro value hvalue + exact hworld value (by simp [hvalue]) + cases head with + | lit literal => + obtain ⟨store', htail⟩ := ih htailWorld + refine ⟨store', ?_⟩ + unfold dupVals at htail ⊢ + simp only [List.foldlM_cons] + simpa only [bindOk] using htail + | erased => + obtain ⟨store', htail⟩ := ih htailWorld + refine ⟨store', ?_⟩ + unfold dupVals at htail ⊢ + simp only [List.foldlM_cons] + simpa only [bindOk] using htail + | loc loc => + obtain ⟨box, hget, hboxWorld⟩ := hworld (.loc loc) (by simp) + cases box with + | mk world rc node => + change world = .shared at hboxWorld + subst world + let middle := incRcStore store loc ⟨.shared, rc, node⟩ + have htailWorld' : ∀ value ∈ tail, + HasWorld middle .shared value := by + intro value hvalue + exact HasWorld.incRcStore hget (htailWorld value hvalue) + obtain ⟨store', htail⟩ := ih htailWorld' + refine ⟨store', ?_⟩ + unfold dupVals at htail ⊢ + simp only [List.foldlM_cons] + rw [hget] + dsimp only + simpa only [middle, incRcStore, bindOk] using htail + +/-- Construct the complete PAP preparation prefix: duplicate every stored +capture, release the consumed PAP root with sufficient fuel, and retain all +source graphs and the exact post-prefix ownership partition. -/ +theorem applyGo_preparePap_valueGraphs_progress + {funRel : Sim.FunctionRel} {ctx : Ctx} + {store : Store} {loc rc : Nat} + {address : Ixon.Address} {arity : Nat} {got : Array RVal} + {args : List RVal} {captures sourceArgs : List IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hget : store.get? loc = some + ⟨.shared, rc, .papN address arity got⟩) + (hcaptures : Sim.ValuesGraph funRel store captures got.toList) + (hargs : Sim.ValuesGraph funRel store sourceArgs args) + (hframe : Sim.RootsGraph funRel store sourceRest rest) + (hown : RootOwnership store + (⟨.shared, .loc loc⟩ :: rootsFor .shared args ++ rest)) : + ∃ dropFuel dupStore readyStore, + dupVals store got.toList = .ok dupStore ∧ + dropVal ctx dropFuel dupStore (.loc loc) = .ok readyStore ∧ + Sim.ValuesGraph funRel readyStore captures got.toList ∧ + Sim.ValuesGraph funRel readyStore sourceArgs args ∧ + Sim.RootsGraph funRel readyStore sourceRest rest ∧ + RootOwnership readyStore + (rootsFor .shared (got.toList ++ args) ++ rest) := by + have hgotWorld : ∀ value ∈ got.toList, + HasWorld store .shared value := by + intro value hvalue + exact hown.edges_world hget value (by + simpa [nodeChildren] using hvalue) + obtain ⟨dupStore, hdup⟩ := dupVals_progress_of_hasWorld hgotWorld + have hduped : RootOwnership dupStore + (rootsFor .shared got.toList ++ + ⟨.shared, .loc loc⟩ :: rootsFor .shared args ++ rest) := by + simpa [List.append_assoc] using + dupVals_borrowedMany_preserves hown hgotWorld hdup + have hpapFirst : RootOwnership dupStore + (⟨.shared, .loc loc⟩ :: + rootsFor .shared got.toList ++ rootsFor .shared args ++ rest) := by + apply hduped.perm + simpa [List.append_assoc] using + (List.perm_append_comm + (l₁ := rootsFor .shared got.toList) + (l₂ := [(⟨.shared, .loc loc⟩ : Root)])).append_right + (rootsFor .shared args ++ rest) + obtain ⟨dropFuel, readyStore, hdrop, _⟩ := + dropVal_progress (ctx := ctx) hpapFirst + obtain ⟨hcapturesReady, hargsReady, hframeReady, hready⟩ := + applyGo_preparePap_valueGraphs hget hcaptures hargs hframe hown + hdup hdrop + exact ⟨dropFuel, dupStore, readyStore, hdup, hdrop, + hcapturesReady, hargsReady, hframeReady, hready⟩ + +theorem apply_value_progress + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + {store : Store} {function : RVal} {args : List RVal} + {sourceFunction : IxIR0.Value} {sourceArgs : List IxIR0.Value} + {sourceResult : IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hprogress : ApplyValueProgressContract funRel sourceCtx ctx) + (hownership : ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hfunction : Sim.ValueGraph funRel store sourceFunction function) + (hargs : Sim.ValuesGraph funRel store sourceArgs args) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs sourceResult) + (hframe : Sim.RootsGraph funRel store sourceRest rest) + (hown : RootOwnership store + (⟨.shared, function⟩ :: rootsFor .shared args ++ rest)) : + ∃ fuel store' value, + applyGo ctx fuel store function args = .ok (store', value) ∧ + Sim.ValueGraph funRel store' sourceResult value ∧ + Sim.RootsGraph funRel store' sourceRest rest ∧ + RootOwnership store' (⟨.shared, value⟩ :: rest) := by + obtain ⟨fuel, store', value, hrun⟩ := + hprogress.progresses hfunction hargs hsource hframe hown + have hsemantic := hvalue.preserves hfunction hargs hsource hframe hown hrun + exact ⟨fuel, store', value, hrun, hsemantic.1, hsemantic.2, + hownership.preserves hown hrun⟩ + +/-! ## Source-guided operation progress -/ + +/-- A source-backed direct call has a successful target operation run and +establishes the same semantic frame and exact ownership postconditions used +by the partial-correctness lowering proof. -/ +theorem runOp_call_value_trace_progress_at + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + {sourceLimit : Nat} {cur d : FnDef} {address : Ixon.Address} + {atoms : Array Atom} {store : Store} {env : List RVal} + {args : List RVal} {argWorlds : List Owned} + {sourceFunction sourceResult : IxIR0.Value} + {sourceArgs : List IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hatoms : resolveAtoms env atoms = .ok args) + (hdecl : ctx.decls address = some (.fn d)) + (harity : argWorlds.length = d.arity) + (hprogress : FnValueTraceProgressesAt funRel sourceCtx ctx d + argWorlds sourceFunction sourceLimit) + (hownership : FnOwnershipContract ctx d argWorlds) + (hvalue : FnValueContract funRel sourceCtx ctx d argWorlds + sourceFunction) + (hlength : args.length = argWorlds.length) + (hargs : Sim.ValuesGraph funRel store sourceArgs args) + (hsource : SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + sourceArgs sourceResult) + (hframe : Sim.RootsGraph funRel store sourceRest rest) + (hown : RootOwnership store + (rootsForWorlds argWorlds args ++ rest)) : + ∃ fuel store' value, + runOp ctx fuel cur store env (.call address atoms) = + .ok (store', value) ∧ + Sim.ValueGraph funRel store' sourceResult value ∧ + Sim.RootsGraph funRel store' sourceRest rest ∧ + RootOwnership store' (⟨d.result, value⟩ :: rest) := by + obtain ⟨invokeFuel, store', value, hinvoke, hresult, hframe', hown'⟩ := + invoke_fn_value_trace_progress_at hdecl harity hprogress hownership + hvalue hlength hargs hsource hframe hown + refine ⟨invokeFuel + 1, store', value, ?_, hresult, hframe', hown'⟩ + rw [runOp.eq_def] + dsimp only + rw [hatoms, bindOk] + exact hinvoke + +theorem runOp_call_value_trace_progress + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + {sourceLimit : Nat} {cur d : FnDef} {address : Ixon.Address} + {atoms : Array Atom} {store : Store} {env : List RVal} + {args : List RVal} {argWorlds : List Owned} + {sourceFunction sourceResult : IxIR0.Value} + {sourceArgs : List IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hatoms : resolveAtoms env atoms = .ok args) + (hdecl : ctx.decls address = some (.fn d)) + (hprogress : FnValueTraceProgressContract funRel sourceCtx ctx d + argWorlds sourceFunction) + (hownership : FnOwnershipContract ctx d argWorlds) + (hvalue : FnValueContract funRel sourceCtx ctx d argWorlds + sourceFunction) + (hlength : args.length = argWorlds.length) + (hargs : Sim.ValuesGraph funRel store sourceArgs args) + (hsource : SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + sourceArgs sourceResult) + (hframe : Sim.RootsGraph funRel store sourceRest rest) + (hown : RootOwnership store + (rootsForWorlds argWorlds args ++ rest)) : + ∃ fuel store' value, + runOp ctx fuel cur store env (.call address atoms) = + .ok (store', value) ∧ + Sim.ValueGraph funRel store' sourceResult value ∧ + Sim.RootsGraph funRel store' sourceRest rest ∧ + RootOwnership store' (⟨d.result, value⟩ :: rest) := by + exact runOp_call_value_trace_progress_at hatoms hdecl + hprogress.arity_eq (hprogress.progresses sourceLimit) hownership hvalue + hlength hargs hsource hframe hown + +theorem runOp_call_value_progress + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + {cur d : FnDef} {address : Ixon.Address} {atoms : Array Atom} + {store : Store} {env : List RVal} {args : List RVal} + {argWorlds : List Owned} {sourceFunction sourceResult : IxIR0.Value} + {sourceArgs : List IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hatoms : resolveAtoms env atoms = .ok args) + (hdecl : ctx.decls address = some (.fn d)) + (hprogress : FnValueProgressContract funRel sourceCtx ctx d argWorlds + sourceFunction) + (hownership : FnOwnershipContract ctx d argWorlds) + (hvalue : FnValueContract funRel sourceCtx ctx d argWorlds + sourceFunction) + (hlength : args.length = argWorlds.length) + (hargs : Sim.ValuesGraph funRel store sourceArgs args) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs sourceResult) + (hframe : Sim.RootsGraph funRel store sourceRest rest) + (hown : RootOwnership store + (rootsForWorlds argWorlds args ++ rest)) : + ∃ fuel store' value, + runOp ctx fuel cur store env (.call address atoms) = + .ok (store', value) ∧ + Sim.ValueGraph funRel store' sourceResult value ∧ + Sim.RootsGraph funRel store' sourceRest rest ∧ + RootOwnership store' (⟨d.result, value⟩ :: rest) := by + obtain ⟨invokeFuel, store', value, hinvoke, hresult, hframe', hown'⟩ := + invoke_fn_value_progress hdecl hprogress hownership hvalue hlength + hargs hsource hframe hown + have hrun : runOp ctx (invokeFuel + 1) cur store env + (.call address atoms) = .ok (store', value) := by + rw [runOp.eq_def] + dsimp only + rw [hatoms, bindOk] + exact hinvoke + exact ⟨invokeFuel + 1, store', value, hrun, hresult, hframe', hown'⟩ + +/-- Source-guided recursive-self progress. Unlike `FnProgressContract`, the +body need only terminate for the particular source argument spine at hand. -/ +theorem runOp_callSelf_value_trace_progress_at + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + {sourceLimit : Nat} {cur : FnDef} {atoms : Array Atom} + {store : Store} {env : List RVal} {args : List RVal} + {argWorlds : List Owned} {sourceFunction sourceResult : IxIR0.Value} + {sourceArgs : List IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hatoms : resolveAtoms env atoms = .ok args) + (harity : argWorlds.length = cur.arity) + (hprogress : FnValueTraceProgressesAt funRel sourceCtx ctx cur + argWorlds sourceFunction sourceLimit) + (hownership : FnOwnershipContract ctx cur argWorlds) + (hvalue : FnValueContract funRel sourceCtx ctx cur argWorlds + sourceFunction) + (hlength : args.length = argWorlds.length) + (hargs : Sim.ValuesGraph funRel store sourceArgs args) + (hsource : SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + sourceArgs sourceResult) + (hframe : Sim.RootsGraph funRel store sourceRest rest) + (hown : RootOwnership store + (rootsForWorlds argWorlds args ++ rest)) : + ∃ fuel store' value, + runOp ctx fuel cur store env (.callSelf atoms) = + .ok (store', value) ∧ + Sim.ValueGraph funRel store' sourceResult value ∧ + Sim.RootsGraph funRel store' sourceRest rest ∧ + RootOwnership store' (⟨cur.result, value⟩ :: rest) := by + obtain ⟨bodyFuel, store', value, hbody⟩ := + hprogress hlength hargs hsource hframe hown + have hown' : RootOwnership store' (⟨cur.result, value⟩ :: rest) := + hownership.preserves hlength hown hbody + have hsemantic := hvalue.preserves hlength hargs hsource.sourceApplies + hframe hown hbody + have hworld : HasWorld store' cur.result value := + hown'.roots_world ⟨cur.result, value⟩ (by simp) + have hcheck : checkResultWorld cur.result (store', value) = + .ok (store', value) := by + simp [checkResultWorld, rval_hasWorld_eq_true_iff.mpr hworld] + have htargetArity : args.length = cur.arity := hlength.trans harity + refine ⟨bodyFuel + 1, store', value, ?_, hsemantic.1, + hsemantic.2, hown'⟩ + rw [runOp.eq_def] + dsimp only + rw [hatoms, bindOk] + simp only [htargetArity] + simp + rw [hbody, bindOk] + exact hcheck + +theorem runOp_callSelf_value_trace_progress + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + {sourceLimit : Nat} {cur : FnDef} {atoms : Array Atom} + {store : Store} {env : List RVal} {args : List RVal} + {argWorlds : List Owned} {sourceFunction sourceResult : IxIR0.Value} + {sourceArgs : List IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hatoms : resolveAtoms env atoms = .ok args) + (hprogress : FnValueTraceProgressContract funRel sourceCtx ctx cur + argWorlds sourceFunction) + (hownership : FnOwnershipContract ctx cur argWorlds) + (hvalue : FnValueContract funRel sourceCtx ctx cur argWorlds + sourceFunction) + (hlength : args.length = argWorlds.length) + (hargs : Sim.ValuesGraph funRel store sourceArgs args) + (hsource : SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + sourceArgs sourceResult) + (hframe : Sim.RootsGraph funRel store sourceRest rest) + (hown : RootOwnership store + (rootsForWorlds argWorlds args ++ rest)) : + ∃ fuel store' value, + runOp ctx fuel cur store env (.callSelf atoms) = + .ok (store', value) ∧ + Sim.ValueGraph funRel store' sourceResult value ∧ + Sim.RootsGraph funRel store' sourceRest rest ∧ + RootOwnership store' (⟨cur.result, value⟩ :: rest) := by + exact runOp_callSelf_value_trace_progress_at hatoms hprogress.arity_eq + (hprogress.progresses sourceLimit) hownership hvalue hlength hargs + hsource hframe hown + +theorem runOp_callSelf_value_progress + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + {cur : FnDef} {atoms : Array Atom} {store : Store} + {env : List RVal} {args : List RVal} {argWorlds : List Owned} + {sourceFunction sourceResult : IxIR0.Value} + {sourceArgs : List IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hatoms : resolveAtoms env atoms = .ok args) + (hprogress : FnValueProgressContract funRel sourceCtx ctx cur argWorlds + sourceFunction) + (hownership : FnOwnershipContract ctx cur argWorlds) + (hvalue : FnValueContract funRel sourceCtx ctx cur argWorlds + sourceFunction) + (hlength : args.length = argWorlds.length) + (hargs : Sim.ValuesGraph funRel store sourceArgs args) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs sourceResult) + (hframe : Sim.RootsGraph funRel store sourceRest rest) + (hown : RootOwnership store + (rootsForWorlds argWorlds args ++ rest)) : + ∃ fuel store' value, + runOp ctx fuel cur store env (.callSelf atoms) = + .ok (store', value) ∧ + Sim.ValueGraph funRel store' sourceResult value ∧ + Sim.RootsGraph funRel store' sourceRest rest ∧ + RootOwnership store' (⟨cur.result, value⟩ :: rest) := by + obtain ⟨bodyFuel, store', value, hbody⟩ := + hprogress.progresses hlength hargs hsource hframe hown + have hown' : RootOwnership store' + (⟨cur.result, value⟩ :: rest) := + hownership.preserves hlength hown hbody + have hsemantic := + hvalue.preserves hlength hargs hsource hframe hown hbody + have hworld : HasWorld store' cur.result value := + hown'.roots_world ⟨cur.result, value⟩ (by simp) + have hcheck : checkResultWorld cur.result (store', value) = + .ok (store', value) := by + simp [checkResultWorld, rval_hasWorld_eq_true_iff.mpr hworld] + have harity : args.length = cur.arity := + hlength.trans hprogress.arity_eq + have hrun : runOp ctx (bodyFuel + 1) cur store env + (.callSelf atoms) = .ok (store', value) := by + rw [runOp.eq_def] + dsimp only + rw [hatoms, bindOk] + simp only [harity] + simp + rw [hbody, bindOk] + exact hcheck + exact ⟨bodyFuel + 1, store', value, hrun, hsemantic.1, + hsemantic.2, hown'⟩ + +/-- Source-guided higher-order application progress at the operation level. -/ +theorem runOp_apply_value_trace_progress_at + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + {sourceLimit : Nat} {cur : FnDef} {store : Store} + {env : List RVal} {functionAtom : Atom} {function : RVal} + {atoms : Array Atom} {args : List RVal} + {sourceFunction sourceResult : IxIR0.Value} + {sourceArgs : List IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hfunction : resolveAtom env functionAtom = .ok function) + (hatoms : resolveAtoms env atoms = .ok args) + (hprogress : ApplyValueTraceProgressesAt funRel sourceCtx ctx sourceLimit) + (hownership : ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hfunctionGraph : Sim.ValueGraph funRel store sourceFunction function) + (hargs : Sim.ValuesGraph funRel store sourceArgs args) + (hsource : SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + sourceArgs sourceResult) + (hsourceArgsNonempty : sourceArgs ≠ []) + (hframe : Sim.RootsGraph funRel store sourceRest rest) + (hown : RootOwnership store + (⟨.shared, function⟩ :: rootsFor .shared args ++ rest)) : + ∃ fuel store' value, + runOp ctx fuel cur store env (.apply functionAtom atoms) = + .ok (store', value) ∧ + Sim.ValueGraph funRel store' sourceResult value ∧ + Sim.RootsGraph funRel store' sourceRest rest ∧ + RootOwnership store' (⟨.shared, value⟩ :: rest) := by + obtain ⟨applyFuel, store', value, happly, hresult, hframe', hown'⟩ := + apply_value_trace_progress_at hprogress hownership hvalue hfunctionGraph + hargs hsource hsourceArgsNonempty hframe hown + refine ⟨applyFuel + 1, store', value, ?_, hresult, hframe', hown'⟩ + rw [runOp.eq_def] + dsimp only + rw [hfunction, bindOk, hatoms, bindOk] + exact happly + +theorem runOp_apply_value_trace_progress + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + {sourceLimit : Nat} {cur : FnDef} {store : Store} + {env : List RVal} {functionAtom : Atom} {function : RVal} + {atoms : Array Atom} {args : List RVal} + {sourceFunction sourceResult : IxIR0.Value} + {sourceArgs : List IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hfunction : resolveAtom env functionAtom = .ok function) + (hatoms : resolveAtoms env atoms = .ok args) + (hprogress : ApplyValueTraceProgressContract funRel sourceCtx ctx) + (hownership : ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hfunctionGraph : Sim.ValueGraph funRel store sourceFunction function) + (hargs : Sim.ValuesGraph funRel store sourceArgs args) + (hsource : SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + sourceArgs sourceResult) + (hsourceArgsNonempty : sourceArgs ≠ []) + (hframe : Sim.RootsGraph funRel store sourceRest rest) + (hown : RootOwnership store + (⟨.shared, function⟩ :: rootsFor .shared args ++ rest)) : + ∃ fuel store' value, + runOp ctx fuel cur store env (.apply functionAtom atoms) = + .ok (store', value) ∧ + Sim.ValueGraph funRel store' sourceResult value ∧ + Sim.RootsGraph funRel store' sourceRest rest ∧ + RootOwnership store' (⟨.shared, value⟩ :: rest) := by + exact runOp_apply_value_trace_progress_at hfunction hatoms + (hprogress.progresses sourceLimit) hownership hvalue hfunctionGraph + hargs hsource hsourceArgsNonempty hframe hown + +theorem runOp_apply_value_progress + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + {cur : FnDef} {store : Store} {env : List RVal} + {functionAtom : Atom} {function : RVal} {atoms : Array Atom} + {args : List RVal} {sourceFunction sourceResult : IxIR0.Value} + {sourceArgs : List IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hfunction : resolveAtom env functionAtom = .ok function) + (hatoms : resolveAtoms env atoms = .ok args) + (hprogress : ApplyValueProgressContract funRel sourceCtx ctx) + (hownership : ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hfunctionGraph : Sim.ValueGraph funRel store sourceFunction function) + (hargs : Sim.ValuesGraph funRel store sourceArgs args) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs sourceResult) + (hframe : Sim.RootsGraph funRel store sourceRest rest) + (hown : RootOwnership store + (⟨.shared, function⟩ :: rootsFor .shared args ++ rest)) : + ∃ fuel store' value, + runOp ctx fuel cur store env (.apply functionAtom atoms) = + .ok (store', value) ∧ + Sim.ValueGraph funRel store' sourceResult value ∧ + Sim.RootsGraph funRel store' sourceRest rest ∧ + RootOwnership store' (⟨.shared, value⟩ :: rest) := by + obtain ⟨applyFuel, store', value, happly, hresult, hframe', hown'⟩ := + apply_value_progress hprogress hownership hvalue hfunctionGraph hargs + hsource hframe hown + have hrun : runOp ctx (applyFuel + 1) cur store env + (.apply functionAtom atoms) = .ok (store', value) := by + rw [runOp.eq_def] + dsimp only + rw [hfunction, bindOk, hatoms, bindOk] + exact happly + exact ⟨applyFuel + 1, store', value, hrun, hresult, hframe', hown'⟩ + +/-- A source-backed extern call progresses when its explicit target-oracle +totality contract supplies a result. -/ +theorem runOp_extern_value_trace_progress + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + {sourceLimit : Nat} {cur : FnDef} {store : Store} + {env : List RVal} {address : Ixon.Address} {atoms : Array Atom} + {args : List RVal} {arity : Nat} {resultWorld : Owned} + {sourceFunction sourceResult : IxIR0.Value} + {sourceArgs : List IxIR0.Value} {rest : List Root} + (hatoms : resolveAtoms env atoms = .ok args) + (hprogress : ExternTraceProgressContract funRel sourceCtx ctx) + (hvalue : ExternValueContract funRel sourceCtx ctx) + (hlookup : sourceCtx.env address = some (.extern arity)) + (href : SourceRefValue sourceCtx address sourceFunction) + (hlength : sourceArgs.length = arity) + (hsource : SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + sourceArgs sourceResult) + (hargs : Sim.ValuesGraph funRel store sourceArgs args) + (hown : RootOwnership store (rootsFor .shared args ++ rest)) : + ∃ fuel result, + runOp ctx fuel cur store env (.extern address atoms) = + .ok (store, result) ∧ + Sim.ValueGraph funRel store sourceResult result ∧ + RootOwnership store (⟨resultWorld, result⟩ :: rest) := by + obtain ⟨result, horacle⟩ := + hprogress.progresses hlookup href hlength hsource hargs + have hrun : runOp ctx 1 cur store env (.extern address atoms) = + .ok (store, result) := by + rw [runOp.eq_def] + dsimp only + rw [hatoms, bindOk, horacle, bindOk] + have hresultGraph : Sim.ValueGraph funRel store sourceResult result := + hvalue.preserves hlookup href hlength hsource.sourceApplies hargs horacle + have hown' : RootOwnership store + (⟨resultWorld, result⟩ :: rest) := + runOp_extern_owned (ctx := ctx) (cur := cur) (fuel := 0) + hatoms hown hrun + exact ⟨1, result, hrun, hresultGraph, hown'⟩ + +theorem runOp_extern_value_progress + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + {cur : FnDef} {store : Store} {env : List RVal} + {address : Ixon.Address} {atoms : Array Atom} {args : List RVal} + {arity : Nat} {resultWorld : Owned} + {sourceFunction sourceResult : IxIR0.Value} + {sourceArgs : List IxIR0.Value} {rest : List Root} + (hatoms : resolveAtoms env atoms = .ok args) + (hprogress : ExternProgressContract funRel sourceCtx ctx) + (hvalue : ExternValueContract funRel sourceCtx ctx) + (hlookup : sourceCtx.env address = some (.extern arity)) + (href : SourceRefValue sourceCtx address sourceFunction) + (hlength : sourceArgs.length = arity) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs sourceResult) + (hargs : Sim.ValuesGraph funRel store sourceArgs args) + (hown : RootOwnership store (rootsFor .shared args ++ rest)) : + ∃ fuel result, + runOp ctx fuel cur store env (.extern address atoms) = + .ok (store, result) ∧ + Sim.ValueGraph funRel store sourceResult result ∧ + RootOwnership store (⟨resultWorld, result⟩ :: rest) := by + obtain ⟨result, horacle⟩ := + hprogress.progresses hlookup href hlength hsource hargs + have hrun : runOp ctx 1 cur store env (.extern address atoms) = + .ok (store, result) := by + rw [runOp.eq_def] + dsimp only + rw [hatoms, bindOk, horacle, bindOk] + have hresultGraph : Sim.ValueGraph funRel store sourceResult result := + hvalue.preserves hlookup href hlength hsource hargs horacle + have hown' : RootOwnership store + (⟨resultWorld, result⟩ :: rest) := + runOp_extern_owned (ctx := ctx) (cur := cur) (fuel := 0) + hatoms hown hrun + exact ⟨1, result, hrun, hresultGraph, hown'⟩ + +/-! ## Source-guided lowering consumers -/ + +/-- Consume a progressing semantic argument vector through a source-backed +direct call. The callee's preserved root graph reconstructs the caller's +logical environment after the store-changing operation. -/ +theorem LowerArgsValueProgress.call_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur d : FnDef} + {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Owned} {emit : Emit} {avs : List AVal} + {address : Ixon.Address} + (hargs : LowerArgsValueProgress funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceArgs worlds emit avs) + (hdecl : ctx.decls address = some (.fn d)) + (hprogress : FnValueProgressContract funRel sourceCtx ctx d worlds + sourceFunction) + (hownership : FnOwnershipContract ctx d worlds) + (hvalue : FnValueContract funRel sourceCtx ctx d worlds sourceFunction) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + LowerResultValueProgress funRel recSelfRel ctx cur + input output.bump sourceInput sourceOutput sourceResult d.result + (emit ∘ emitOp + (.call address (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.call_graph hdecl hownership hvalue + hsource + graphProgress := ?_ } + intro sourceRest rest slots + apply EmitProgress.comp (hargs.graphProgress sourceRest rest slots) + apply OpProgress.emit + intro store env hpre + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + have henvFrame : Sim.RootsGraph funRel store + (entrySourceRoots output.entries sourceOutput) envRoots := + houtput.entries.rootsGraphExact + have hcombinedFrame : Sim.RootsGraph funRel store + (entrySourceRoots output.entries sourceOutput ++ sourceRest) + (envRoots ++ rest) := + henvFrame.append hrestGraph + have hownCall : RootOwnership store + (rootsForWorlds worlds values ++ (envRoots ++ rest)) := by + simpa [List.append_assoc] using hown + have hlength : values.length = worlds.length := + havs.lengths.2.symm.trans havs.lengths.1.symm + obtain ⟨fuel, store', result, hrun, hresultGraph, hcombinedAfter, + hownAfter⟩ := + runOp_call_value_progress + (sourceCtx := sourceCtx) (ctx := ctx) (cur := cur) + havs.resolveAtoms hdecl hprogress hownership hvalue hlength + hvalueGraphs hsource hcombinedFrame hownCall + obtain ⟨henvAfter, hrestAfter⟩ := + hcombinedAfter.splitAppend henvFrame.lengths + have houtputAfter : VEnvValueGraph funRel recSelfRel store' + output sourceOutput env envRoots := + houtput.ofRootsGraph henvAfter + refine ⟨fuel, store', result, hrun, ?_⟩ + refine ⟨⟨envRoots, result, houtputAfter.bump result, ?_, + hresultGraph, hrestAfter, hownAfter⟩, hslots.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +/-- Recursive-self counterpart of `LowerArgsValueProgress.call_graph`. -/ +theorem LowerArgsValueProgress.callSelf_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Owned} {emit : Emit} {avs : List AVal} + (hargs : LowerArgsValueProgress funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceArgs worlds emit avs) + (hprogress : FnValueProgressContract funRel sourceCtx ctx cur worlds + sourceFunction) + (hownership : FnOwnershipContract ctx cur worlds) + (hvalue : FnValueContract funRel sourceCtx ctx cur worlds + sourceFunction) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + LowerResultValueProgress funRel recSelfRel ctx cur + input output.bump sourceInput sourceOutput sourceResult cur.result + (emit ∘ emitOp + (.callSelf (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.callSelf_graph hownership hvalue hsource + graphProgress := ?_ } + intro sourceRest rest slots + apply EmitProgress.comp (hargs.graphProgress sourceRest rest slots) + apply OpProgress.emit + intro store env hpre + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + have henvFrame : Sim.RootsGraph funRel store + (entrySourceRoots output.entries sourceOutput) envRoots := + houtput.entries.rootsGraphExact + have hcombinedFrame : Sim.RootsGraph funRel store + (entrySourceRoots output.entries sourceOutput ++ sourceRest) + (envRoots ++ rest) := + henvFrame.append hrestGraph + have hownCall : RootOwnership store + (rootsForWorlds worlds values ++ (envRoots ++ rest)) := by + simpa [List.append_assoc] using hown + have hlength : values.length = worlds.length := + havs.lengths.2.symm.trans havs.lengths.1.symm + obtain ⟨fuel, store', result, hrun, hresultGraph, hcombinedAfter, + hownAfter⟩ := + runOp_callSelf_value_progress + (sourceCtx := sourceCtx) (ctx := ctx) (cur := cur) + havs.resolveAtoms hprogress hownership hvalue hlength hvalueGraphs + hsource hcombinedFrame hownCall + obtain ⟨henvAfter, hrestAfter⟩ := + hcombinedAfter.splitAppend henvFrame.lengths + have houtputAfter : VEnvValueGraph funRel recSelfRel store' + output sourceOutput env envRoots := + houtput.ofRootsGraph henvAfter + refine ⟨fuel, store', result, hrun, ?_⟩ + refine ⟨⟨envRoots, result, houtputAfter.bump result, ?_, + hresultGraph, hrestAfter, hownAfter⟩, hslots.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +/-- Recursive-self progress where the source function identity is recovered +from the synthetic input entry. -/ +theorem LowerArgsValueProgress.callSelf_entry_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {input output : VEnv} {index arity : Nat} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Owned} {emit : Emit} {avs : List AVal} + (hargs : LowerArgsValueProgress funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceArgs worlds emit avs) + (hentry : input.entries[index]? = some (.recSelf arity)) + (hhead : sourceInput[index]? = some sourceFunction) + (hprogress : recSelfRel sourceFunction arity → + FnValueProgressContract funRel sourceCtx ctx cur worlds sourceFunction) + (hownership : FnOwnershipContract ctx cur worlds) + (hvalue : recSelfRel sourceFunction arity → + FnValueContract funRel sourceCtx ctx cur worlds sourceFunction) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + LowerResultValueProgress funRel recSelfRel ctx cur + input output.bump sourceInput sourceOutput sourceResult cur.result + (emit ∘ emitOp + (.callSelf (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.callSelf_entry_graph hentry hhead + hownership hvalue hsource + graphProgress := ?_ } + intro sourceRest rest slots + apply EmitProgress.of_pointwise + intro store env hpre + obtain ⟨⟨envRoots, hinput, hrestGraph, hown⟩, hslots⟩ := hpre + obtain ⟨source, hsourceLookup, hself⟩ := hinput.getRecSelf hentry + have hsourceEq : source = sourceFunction := by + rw [hhead] at hsourceLookup + exact (Option.some.inj hsourceLookup).symm + subst source + have hsound := hargs.callSelf_graph (hprogress hself) hownership + (hvalue hself) hsource + exact ⟨_, ⟨⟨envRoots, hinput, hrestGraph, hown⟩, hslots⟩, + hsound.graphProgress sourceRest rest slots⟩ + +/-- Recursive-self call progress from the whole current-function contract. +The advertised marker arity is checked semantically: a realizable marker +supplies a progress contract whose arity equation rules out the target's +stuck arity branch. -/ +theorem LowerArgsValueProgress.callSelf_current_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {input output : VEnv} {index arity : Nat} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {emit : Emit} {avs : List AVal} + (hargs : LowerArgsValueProgress funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceArgs + (List.replicate arity .shared) emit avs) + (hentry : input.entries[index]? = some (.recSelf arity)) + (hhead : sourceInput[index]? = some sourceFunction) + (hself : CurrentSelfProgressContract funRel recSelfRel sourceCtx ctx + cur) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) + (havsLength : avs.length = arity) : + LowerResultValueProgress funRel recSelfRel ctx cur + input output.bump sourceInput sourceOutput sourceResult cur.result + (emit ∘ emitOp + (.callSelf (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + by_cases harity : arity = cur.arity + · have hprogress : recSelfRel sourceFunction arity → + FnValueProgressContract funRel sourceCtx ctx cur + (List.replicate arity .shared) sourceFunction := by + intro hrel + exact hself.progress hrel + have hownership : FnOwnershipContract ctx cur + (List.replicate arity .shared) := by + simpa [harity] using hself.ownership + have hvalue : recSelfRel sourceFunction arity → + FnValueContract funRel sourceCtx ctx cur + (List.replicate arity .shared) sourceFunction := by + intro hrel + simpa [harity] using hself.value (by simpa [harity] using hrel) + exact hargs.callSelf_entry_graph hentry hhead hprogress hownership + hvalue hsource + · refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.callSelf_arity_mismatch_graph + (fun heq => harity (havsLength.symm.trans heq)) + graphProgress := ?_ } + intro sourceRest rest slots + apply EmitProgress.of_pointwise + intro store env hpre + obtain ⟨⟨envRoots, hinput, hrestGraph, hown⟩, hslots⟩ := hpre + obtain ⟨source, hsourceLookup, hrel⟩ := hinput.getRecSelf hentry + have hsourceEq : source = sourceFunction := by + rw [hhead] at hsourceLookup + exact (Option.some.inj hsourceLookup).symm + subst source + have hcontract := hself.progress hrel + have heq : arity = cur.arity := by + simpa using hcontract.arity_eq + exact (harity heq).elim + +/-- Consume a progressing homogeneous shared argument prefix through the +scalar extern ABI. The explicit progress contract supplies oracle +definedness; the value contract supplies source-result correspondence. -/ +theorem LowerArgsValueProgress.extern_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {emit : Emit} {avs : List AVal} {address : Ixon.Address} + {arity : Nat} {resultWorld : Owned} + (hargs : LowerArgsValueProgress funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceArgs + (List.replicate avs.length .shared) emit avs) + (hprogress : ExternProgressContract funRel sourceCtx ctx) + (hvalue : ExternValueContract funRel sourceCtx ctx) + (hlookup : sourceCtx.env address = some (.extern arity)) + (href : SourceRefValue sourceCtx address sourceFunction) + (hlength : sourceArgs.length = arity) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + LowerResultValueProgress funRel recSelfRel ctx cur + input output.bump sourceInput sourceOutput sourceResult resultWorld + (emit ∘ emitOp + (.extern address (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.extern_graph hvalue hlookup href hlength + hsource + graphProgress := ?_ } + intro sourceRest rest slots + apply EmitProgress.comp (hargs.graphProgress sourceRest rest slots) + apply OpProgress.emit + intro store env hpre + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + have hvaluesLength : values.length = avs.length := + havs.lengths.2.symm + have hroots : + rootsForWorlds (List.replicate avs.length .shared) values = + rootsFor .shared values := + rootsForWorlds_replicate_eq_rootsFor .shared hvaluesLength + have hownExtern : RootOwnership store + (rootsFor .shared values ++ (envRoots ++ rest)) := by + simpa [hroots, List.append_assoc] using hown + obtain ⟨fuel, result, hrun, hresultGraph, hownAfter⟩ := + runOp_extern_value_progress + (sourceCtx := sourceCtx) (ctx := ctx) (cur := cur) + (resultWorld := resultWorld) havs.resolveAtoms hprogress hvalue + hlookup href hlength hsource hvalueGraphs hownExtern + refine ⟨fuel, store, result, hrun, ?_⟩ + refine ⟨⟨envRoots, result, houtput.bump result, ?_, + hresultGraph, hrestGraph, hownAfter⟩, hslots.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +/-- Direct-call graph progress at one exact source-spine bound. -/ +theorem LowerArgsValueProgress.call_graph_trace + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur d : FnDef} + {sourceLimit : Nat} {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Owned} {emit : Emit} {avs : List AVal} + {address : Ixon.Address} + (hargs : LowerArgsValueProgress funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceArgs worlds emit avs) + (hdecl : ctx.decls address = some (.fn d)) + (harity : worlds.length = d.arity) + (hprogress : FnValueTraceProgressesAt funRel sourceCtx ctx d worlds + sourceFunction sourceLimit) + (hownership : FnOwnershipContract ctx d worlds) + (hvalue : FnValueContract funRel sourceCtx ctx d worlds sourceFunction) + (hsource : SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + sourceArgs sourceResult) : + LowerResultValueProgress funRel recSelfRel ctx cur + input output.bump sourceInput sourceOutput sourceResult d.result + (emit ∘ emitOp + (.call address (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.call_graph hdecl hownership hvalue + hsource.sourceApplies + graphProgress := ?_ } + intro sourceRest rest slots + apply EmitProgress.comp (hargs.graphProgress sourceRest rest slots) + apply OpProgress.emit + intro store env hpre + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + have henvFrame : Sim.RootsGraph funRel store + (entrySourceRoots output.entries sourceOutput) envRoots := + houtput.entries.rootsGraphExact + have hcombinedFrame : Sim.RootsGraph funRel store + (entrySourceRoots output.entries sourceOutput ++ sourceRest) + (envRoots ++ rest) := + henvFrame.append hrestGraph + have hownCall : RootOwnership store + (rootsForWorlds worlds values ++ (envRoots ++ rest)) := by + simpa [List.append_assoc] using hown + have hlength : values.length = worlds.length := + havs.lengths.2.symm.trans havs.lengths.1.symm + obtain ⟨fuel, store', result, hrun, hresultGraph, hcombinedAfter, + hownAfter⟩ := + runOp_call_value_trace_progress_at + (sourceCtx := sourceCtx) (ctx := ctx) (cur := cur) + havs.resolveAtoms hdecl harity hprogress hownership hvalue hlength + hvalueGraphs hsource hcombinedFrame hownCall + obtain ⟨henvAfter, hrestAfter⟩ := + hcombinedAfter.splitAppend henvFrame.lengths + have houtputAfter : VEnvValueGraph funRel recSelfRel store' + output sourceOutput env envRoots := + houtput.ofRootsGraph henvAfter + refine ⟨fuel, store', result, hrun, ?_⟩ + refine ⟨⟨envRoots, result, houtputAfter.bump result, ?_, + hresultGraph, hrestAfter, hownAfter⟩, hslots.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +/-- Recursive-self graph progress at one exact source-spine bound. -/ +theorem LowerArgsValueProgress.callSelf_graph_trace + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {sourceLimit : Nat} {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Owned} {emit : Emit} {avs : List AVal} + (hargs : LowerArgsValueProgress funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceArgs worlds emit avs) + (harity : worlds.length = cur.arity) + (hprogress : FnValueTraceProgressesAt funRel sourceCtx ctx cur worlds + sourceFunction sourceLimit) + (hownership : FnOwnershipContract ctx cur worlds) + (hvalue : FnValueContract funRel sourceCtx ctx cur worlds + sourceFunction) + (hsource : SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + sourceArgs sourceResult) : + LowerResultValueProgress funRel recSelfRel ctx cur + input output.bump sourceInput sourceOutput sourceResult cur.result + (emit ∘ emitOp + (.callSelf (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.callSelf_graph hownership hvalue + hsource.sourceApplies + graphProgress := ?_ } + intro sourceRest rest slots + apply EmitProgress.comp (hargs.graphProgress sourceRest rest slots) + apply OpProgress.emit + intro store env hpre + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + have henvFrame : Sim.RootsGraph funRel store + (entrySourceRoots output.entries sourceOutput) envRoots := + houtput.entries.rootsGraphExact + have hcombinedFrame : Sim.RootsGraph funRel store + (entrySourceRoots output.entries sourceOutput ++ sourceRest) + (envRoots ++ rest) := + henvFrame.append hrestGraph + have hownCall : RootOwnership store + (rootsForWorlds worlds values ++ (envRoots ++ rest)) := by + simpa [List.append_assoc] using hown + have hlength : values.length = worlds.length := + havs.lengths.2.symm.trans havs.lengths.1.symm + obtain ⟨fuel, store', result, hrun, hresultGraph, hcombinedAfter, + hownAfter⟩ := + runOp_callSelf_value_trace_progress_at + (sourceCtx := sourceCtx) (ctx := ctx) (cur := cur) + havs.resolveAtoms harity hprogress hownership hvalue hlength + hvalueGraphs hsource hcombinedFrame hownCall + obtain ⟨henvAfter, hrestAfter⟩ := + hcombinedAfter.splitAppend henvFrame.lengths + have houtputAfter : VEnvValueGraph funRel recSelfRel store' + output sourceOutput env envRoots := + houtput.ofRootsGraph henvAfter + refine ⟨fuel, store', result, hrun, ?_⟩ + refine ⟨⟨envRoots, result, houtputAfter.bump result, ?_, + hresultGraph, hrestAfter, hownAfter⟩, hslots.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +/-- Exact-bound recursive-self progress where the source function identity +is recovered from the synthetic input entry. -/ +theorem LowerArgsValueProgress.callSelf_entry_graph_trace + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {sourceLimit : Nat} {input output : VEnv} {index arity : Nat} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Owned} {emit : Emit} {avs : List AVal} + (hargs : LowerArgsValueProgress funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceArgs worlds emit avs) + (hentry : input.entries[index]? = some (.recSelf arity)) + (hhead : sourceInput[index]? = some sourceFunction) + (harity : worlds.length = cur.arity) + (hprogress : recSelfRel sourceFunction arity → + FnValueTraceProgressesAt funRel sourceCtx ctx cur worlds + sourceFunction sourceLimit) + (hownership : FnOwnershipContract ctx cur worlds) + (hvalue : recSelfRel sourceFunction arity → + FnValueContract funRel sourceCtx ctx cur worlds sourceFunction) + (hsource : SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + sourceArgs sourceResult) : + LowerResultValueProgress funRel recSelfRel ctx cur + input output.bump sourceInput sourceOutput sourceResult cur.result + (emit ∘ emitOp + (.callSelf (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.callSelf_entry_graph hentry hhead + hownership hvalue hsource.sourceApplies + graphProgress := ?_ } + intro sourceRest rest slots + apply EmitProgress.of_pointwise + intro store env hpre + obtain ⟨⟨envRoots, hinput, hrestGraph, hown⟩, hslots⟩ := hpre + obtain ⟨source, hsourceLookup, hself⟩ := hinput.getRecSelf hentry + have hsourceEq : source = sourceFunction := by + rw [hhead] at hsourceLookup + exact (Option.some.inj hsourceLookup).symm + subst source + have hsound := hargs.callSelf_graph_trace harity (hprogress hself) + hownership (hvalue hself) hsource + exact ⟨_, ⟨⟨envRoots, hinput, hrestGraph, hown⟩, hslots⟩, + hsound.graphProgress sourceRest rest slots⟩ + +/-- Recursive-self call progress recovered from the bounded current-function +package and the synthetic input entry. -/ +theorem LowerArgsValueProgress.callSelf_current_graph_trace + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit sourceLimit : Nat} {input output : VEnv} {index arity : Nat} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {emit : Emit} {avs : List AVal} + (hargs : LowerArgsValueProgress funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceArgs + (List.replicate arity .shared) emit avs) + (hentry : input.entries[index]? = some (.recSelf arity)) + (hhead : sourceInput[index]? = some sourceFunction) + (hself : CurrentSelfTraceProgressContractBelow funRel recSelfRel + sourceCtx ctx cur limit) + (hsourceBound : sourceLimit < limit) + (hsource : SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + sourceArgs sourceResult) + (havsLength : avs.length = arity) : + LowerResultValueProgress funRel recSelfRel ctx cur + input output.bump sourceInput sourceOutput sourceResult cur.result + (emit ∘ emitOp + (.callSelf (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + by_cases harity : arity = cur.arity + · have hprogress : recSelfRel sourceFunction arity → + FnValueTraceProgressesAt funRel sourceCtx ctx cur + (List.replicate arity .shared) sourceFunction sourceLimit := by + intro hrel + exact (hself.progress hrel).progresses hsourceBound + have hownership : FnOwnershipContract ctx cur + (List.replicate arity .shared) := by + simpa [harity] using hself.ownership + have hvalue : recSelfRel sourceFunction arity → + FnValueContract funRel sourceCtx ctx cur + (List.replicate arity .shared) sourceFunction := by + intro hrel + simpa [harity] using hself.value (by simpa [harity] using hrel) + exact hargs.callSelf_entry_graph_trace hentry hhead (by simp [harity]) + hprogress hownership hvalue hsource + · refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.callSelf_arity_mismatch_graph + (fun heq => harity (havsLength.symm.trans heq)) + graphProgress := ?_ } + intro sourceRest rest slots + apply EmitProgress.of_pointwise + intro store env hpre + obtain ⟨⟨envRoots, hinput, hrestGraph, hown⟩, hslots⟩ := hpre + obtain ⟨source, hsourceLookup, hrel⟩ := hinput.getRecSelf hentry + have hsourceEq : source = sourceFunction := by + rw [hhead] at hsourceLookup + exact (Option.some.inj hsourceLookup).symm + subst source + have heq : arity = cur.arity := by + simpa using (hself.progress hrel).arity_eq + exact (harity heq).elim + +/-- Scalar-extern graph progress at one exact source-spine bound. -/ +theorem LowerArgsValueProgress.extern_graph_trace + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {sourceLimit : Nat} {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {emit : Emit} {avs : List AVal} {address : Ixon.Address} + {arity : Nat} {resultWorld : Owned} + (hargs : LowerArgsValueProgress funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceArgs + (List.replicate avs.length .shared) emit avs) + (hprogress : ExternTraceProgressContract funRel sourceCtx ctx) + (hvalue : ExternValueContract funRel sourceCtx ctx) + (hlookup : sourceCtx.env address = some (.extern arity)) + (href : SourceRefValue sourceCtx address sourceFunction) + (hlength : sourceArgs.length = arity) + (hsource : SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + sourceArgs sourceResult) : + LowerResultValueProgress funRel recSelfRel ctx cur + input output.bump sourceInput sourceOutput sourceResult resultWorld + (emit ∘ emitOp + (.extern address (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.extern_graph hvalue hlookup href hlength + hsource.sourceApplies + graphProgress := ?_ } + intro sourceRest rest slots + apply EmitProgress.comp (hargs.graphProgress sourceRest rest slots) + apply OpProgress.emit + intro store env hpre + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + have hvaluesLength : values.length = avs.length := + havs.lengths.2.symm + have hroots : + rootsForWorlds (List.replicate avs.length .shared) values = + rootsFor .shared values := + rootsForWorlds_replicate_eq_rootsFor .shared hvaluesLength + have hownExtern : RootOwnership store + (rootsFor .shared values ++ (envRoots ++ rest)) := by + simpa [hroots, List.append_assoc] using hown + obtain ⟨fuel, result, hrun, hresultGraph, hownAfter⟩ := + runOp_extern_value_trace_progress + (sourceCtx := sourceCtx) (ctx := ctx) (cur := cur) + (resultWorld := resultWorld) havs.resolveAtoms hprogress hvalue + hlookup href hlength hsource hvalueGraphs hownExtern + refine ⟨fuel, store, result, hrun, ?_⟩ + refine ⟨⟨envRoots, result, houtput.bump result, ?_, + hresultGraph, hrestGraph, hownAfter⟩, hslots.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +/-- Lower shared arguments while framing an already-produced function, then +consume both through source-guided higher-order application progress. -/ +theorem LowerArgsValueProgress.apply_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {emit : Emit} {avs : List AVal} {function : AVal} + (hargs : LowerArgsValueProgress funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceArgs + (List.replicate avs.length .shared) emit avs) + (hfunctionStable : AValStable function) + (hprogress : ApplyValueProgressContract funRel sourceCtx ctx) + (hownership : ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + ∀ sourceRest rest slots, + EmitProgress ctx cur + (emit ∘ emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (GraphOwnsResultProtected funRel recSelfRel input sourceInput + sourceFunction .shared function sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult .shared (.slotA output.depth) + sourceRest rest slots) := by + intro sourceRest rest slots + apply EmitProgress.of_pointwise + intro store env hfunctionPre + obtain ⟨⟨envRoots, functionValue, hinput, hfunction, + hfunctionGraph, hrestGraph, hownFunction⟩, hslots⟩ := hfunctionPre + let functionRoot : Root := ⟨.shared, functionValue⟩ + have hfunctionWorld : HasWorld store .shared functionValue := + hownFunction.roots_world functionRoot (by simp [functionRoot]) + have hframeGraph : Sim.RootsGraph funRel store + ((.shared, sourceFunction) :: sourceRest) (functionRoot :: rest) := + .cons rfl hfunctionWorld hfunctionGraph hrestGraph + have hfunctionProtection : + SlotsRealize input env (aValProtection function functionValue) := + hfunctionStable.protection_realized hfunction + have hargsOwn : RootOwnership store (envRoots ++ functionRoot :: rest) := by + apply hownFunction.perm + simpa [functionRoot] using + (permExtractRoot functionRoot envRoots [] rest).symm + have hargsPre : GraphOwnsVEnvProtected funRel recSelfRel input + sourceInput ((.shared, sourceFunction) :: sourceRest) + (functionRoot :: rest) + (aValProtection function functionValue ++ slots) store env := + ⟨⟨envRoots, hinput, hframeGraph, hargsOwn⟩, + hfunctionProtection.append hslots⟩ + have happlyProgress : EmitProgress ctx cur + (emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (GraphOwnsArgsResultProtected funRel recSelfRel output + sourceOutput sourceArgs (List.replicate avs.length .shared) avs + ((.shared, sourceFunction) :: sourceRest) (functionRoot :: rest) + (aValProtection function functionValue ++ slots)) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult .shared (.slotA output.depth) + sourceRest rest slots) := by + apply OpProgress.emit + intro argsStore argsEnv hargsPost + obtain ⟨⟨outRoots, values, houtput, havs, hvalueGraphs, + hframeGraphFinal, hownArgs⟩, hslotsOut⟩ := hargsPost + cases hframeGraphFinal with + | cons _ hfunctionWorldFinal hfunctionGraphFinal hrestGraphFinal => + have hfunctionFinal : + AValRealizes output argsEnv function functionValue := + hfunctionStable.realize_of_protection hfunction + hslotsOut.left_of_append + have hfunctionGraph' : Sim.ValueGraph funRel argsStore + sourceFunction functionValue := by + simpa [functionRoot] using hfunctionGraphFinal + have hvaluesLength : values.length = avs.length := + havs.lengths.2.symm + have hroots : + rootsForWorlds (List.replicate avs.length .shared) values = + rootsFor .shared values := + rootsForWorlds_replicate_eq_rootsFor .shared hvaluesLength + have hownApply : RootOwnership argsStore + (functionRoot :: rootsFor .shared values ++ + (outRoots ++ rest)) := by + apply hownArgs.perm + simpa [functionRoot, hroots, List.append_assoc] using + (permExtractRoot functionRoot + (rootsForWorlds (List.replicate avs.length .shared) values ++ + outRoots) [] rest) + have henvFrame : Sim.RootsGraph funRel argsStore + (entrySourceRoots output.entries sourceOutput) outRoots := + houtput.entries.rootsGraphExact + have hcombinedFrame : Sim.RootsGraph funRel argsStore + (entrySourceRoots output.entries sourceOutput ++ sourceRest) + (outRoots ++ rest) := + henvFrame.append hrestGraphFinal + obtain ⟨fuel, store', result, hrun, hresultGraph, hcombinedAfter, + hownAfter⟩ := + runOp_apply_value_progress + (sourceCtx := sourceCtx) (ctx := ctx) (cur := cur) + hfunctionFinal.resolveAtom havs.resolveAtoms hprogress hownership + hvalue hfunctionGraph' hvalueGraphs hsource hcombinedFrame + hownApply + obtain ⟨henvAfter, hrestAfter⟩ := + hcombinedAfter.splitAppend henvFrame.lengths + have houtputAfter : VEnvValueGraph funRel recSelfRel store' + output sourceOutput argsEnv outRoots := + houtput.ofRootsGraph henvAfter + refine ⟨fuel, store', result, hrun, ?_⟩ + refine ⟨⟨outRoots, result, houtputAfter.bump result, ?_, + hresultGraph, hrestAfter, hownAfter⟩, + hslotsOut.right_of_append.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + have hargsThenApply := EmitProgress.comp + (hargs.graphProgress ((.shared, sourceFunction) :: sourceRest) + (functionRoot :: rest) + (aValProtection function functionValue ++ slots)) + happlyProgress + exact ⟨_, hargsPre, hargsThenApply⟩ + +/-- Exact-source-fuel counterpart of `LowerArgsValueProgress.apply_graph`. +Only the target-termination component changes; semantic correspondence still +uses the forgotten `SourceApplies` spine. -/ +theorem LowerArgsValueProgress.apply_graph_trace + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {sourceLimit : Nat} {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {emit : Emit} {avs : List AVal} {function : AVal} + (hargs : LowerArgsValueProgress funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceArgs + (List.replicate avs.length .shared) emit avs) + (hfunctionStable : AValStable function) + (hprogress : ApplyValueTraceProgressesAt funRel sourceCtx ctx sourceLimit) + (hownership : ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hsource : SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + sourceArgs sourceResult) + (hsourceArgsNonempty : sourceArgs ≠ []) : + ∀ sourceRest rest slots, + EmitProgress ctx cur + (emit ∘ emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (GraphOwnsResultProtected funRel recSelfRel input sourceInput + sourceFunction .shared function sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult .shared (.slotA output.depth) + sourceRest rest slots) := by + intro sourceRest rest slots + apply EmitProgress.of_pointwise + intro store env hfunctionPre + obtain ⟨⟨envRoots, functionValue, hinput, hfunction, + hfunctionGraph, hrestGraph, hownFunction⟩, hslots⟩ := hfunctionPre + let functionRoot : Root := ⟨.shared, functionValue⟩ + have hfunctionWorld : HasWorld store .shared functionValue := + hownFunction.roots_world functionRoot (by simp [functionRoot]) + have hframeGraph : Sim.RootsGraph funRel store + ((.shared, sourceFunction) :: sourceRest) (functionRoot :: rest) := + .cons rfl hfunctionWorld hfunctionGraph hrestGraph + have hfunctionProtection : + SlotsRealize input env (aValProtection function functionValue) := + hfunctionStable.protection_realized hfunction + have hargsOwn : RootOwnership store (envRoots ++ functionRoot :: rest) := by + apply hownFunction.perm + simpa [functionRoot] using + (permExtractRoot functionRoot envRoots [] rest).symm + have hargsPre : GraphOwnsVEnvProtected funRel recSelfRel input + sourceInput ((.shared, sourceFunction) :: sourceRest) + (functionRoot :: rest) + (aValProtection function functionValue ++ slots) store env := + ⟨⟨envRoots, hinput, hframeGraph, hargsOwn⟩, + hfunctionProtection.append hslots⟩ + have happlyProgress : EmitProgress ctx cur + (emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (GraphOwnsArgsResultProtected funRel recSelfRel output + sourceOutput sourceArgs (List.replicate avs.length .shared) avs + ((.shared, sourceFunction) :: sourceRest) (functionRoot :: rest) + (aValProtection function functionValue ++ slots)) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult .shared (.slotA output.depth) + sourceRest rest slots) := by + apply OpProgress.emit + intro argsStore argsEnv hargsPost + obtain ⟨⟨outRoots, values, houtput, havs, hvalueGraphs, + hframeGraphFinal, hownArgs⟩, hslotsOut⟩ := hargsPost + cases hframeGraphFinal with + | cons _ hfunctionWorldFinal hfunctionGraphFinal hrestGraphFinal => + have hfunctionFinal : + AValRealizes output argsEnv function functionValue := + hfunctionStable.realize_of_protection hfunction + hslotsOut.left_of_append + have hfunctionGraph' : Sim.ValueGraph funRel argsStore + sourceFunction functionValue := by + simpa [functionRoot] using hfunctionGraphFinal + have hvaluesLength : values.length = avs.length := + havs.lengths.2.symm + have hroots : + rootsForWorlds (List.replicate avs.length .shared) values = + rootsFor .shared values := + rootsForWorlds_replicate_eq_rootsFor .shared hvaluesLength + have hownApply : RootOwnership argsStore + (functionRoot :: rootsFor .shared values ++ + (outRoots ++ rest)) := by + apply hownArgs.perm + simpa [functionRoot, hroots, List.append_assoc] using + (permExtractRoot functionRoot + (rootsForWorlds (List.replicate avs.length .shared) values ++ + outRoots) [] rest) + have henvFrame : Sim.RootsGraph funRel argsStore + (entrySourceRoots output.entries sourceOutput) outRoots := + houtput.entries.rootsGraphExact + have hcombinedFrame : Sim.RootsGraph funRel argsStore + (entrySourceRoots output.entries sourceOutput ++ sourceRest) + (outRoots ++ rest) := + henvFrame.append hrestGraphFinal + obtain ⟨fuel, store', result, hrun, hresultGraph, hcombinedAfter, + hownAfter⟩ := + runOp_apply_value_trace_progress_at + (sourceCtx := sourceCtx) (ctx := ctx) (cur := cur) + hfunctionFinal.resolveAtom havs.resolveAtoms hprogress hownership + hvalue hfunctionGraph' hvalueGraphs hsource hsourceArgsNonempty + hcombinedFrame hownApply + obtain ⟨henvAfter, hrestAfter⟩ := + hcombinedAfter.splitAppend henvFrame.lengths + have houtputAfter : VEnvValueGraph funRel recSelfRel store' + output sourceOutput argsEnv outRoots := + houtput.ofRootsGraph henvAfter + refine ⟨fuel, store', result, hrun, ?_⟩ + refine ⟨⟨outRoots, result, houtputAfter.bump result, ?_, + hresultGraph, hrestAfter, hownAfter⟩, + hslotsOut.right_of_append.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + have hargsThenApply := EmitProgress.comp + (hargs.graphProgress ((.shared, sourceFunction) :: sourceRest) + (functionRoot :: rest) + (aValProtection function functionValue ++ slots)) + happlyProgress + exact ⟨_, hargsPre, hargsThenApply⟩ + +/-- Full higher-order progress composition: produce the function, evaluate +the argument vector, and perform the source-guided target application. -/ +theorem LowerResultValueProgress.applyArgs_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {start input output : VEnv} + {sourceStart sourceMiddle sourceOutput sourceArgs : + List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {emitFunction emitArgs : Emit} {function : AVal} {avs : List AVal} + (hfunction : LowerResultValueProgress funRel recSelfRel ctx cur + start input sourceStart sourceMiddle sourceFunction .shared + emitFunction function) + (hargs : LowerArgsValueProgress funRel recSelfRel ctx cur + input output sourceMiddle sourceOutput sourceArgs + (List.replicate avs.length .shared) emitArgs avs) + (hprogress : ApplyValueProgressContract funRel sourceCtx ctx) + (hownership : ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + LowerResultValueProgress funRel recSelfRel ctx cur + start output.bump sourceStart sourceOutput sourceResult .shared + ((emitFunction ∘ emitArgs) ∘ + emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultValueSound := + hfunction.toLowerResultValueSound.applyArgs_graph + hargs.toLowerArgsValueSound hownership hvalue hsource + graphProgress := ?_ } + intro sourceRest rest slots + have hcomposed := EmitProgress.comp + (hfunction.graphProgress sourceRest rest slots) + (hargs.apply_graph hfunction.stable hprogress hownership hvalue hsource + sourceRest rest slots) + simpa [Function.comp_def] using hcomposed + +/-- Full higher-order progress at one exact source-spine bound. -/ +theorem LowerResultValueProgress.applyArgs_graph_trace + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {sourceLimit : Nat} {start input output : VEnv} + {sourceStart sourceMiddle sourceOutput sourceArgs : + List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {emitFunction emitArgs : Emit} {function : AVal} {avs : List AVal} + (hfunction : LowerResultValueProgress funRel recSelfRel ctx cur + start input sourceStart sourceMiddle sourceFunction .shared + emitFunction function) + (hargs : LowerArgsValueProgress funRel recSelfRel ctx cur + input output sourceMiddle sourceOutput sourceArgs + (List.replicate avs.length .shared) emitArgs avs) + (hprogress : ApplyValueTraceProgressesAt funRel sourceCtx ctx sourceLimit) + (hownership : ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hsource : SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + sourceArgs sourceResult) + (hsourceArgsNonempty : sourceArgs ≠ []) : + LowerResultValueProgress funRel recSelfRel ctx cur + start output.bump sourceStart sourceOutput sourceResult .shared + ((emitFunction ∘ emitArgs) ∘ + emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultValueSound := + hfunction.toLowerResultValueSound.applyArgs_graph + hargs.toLowerArgsValueSound hownership hvalue + hsource.sourceApplies + graphProgress := ?_ } + intro sourceRest rest slots + have hcomposed := EmitProgress.comp + (hfunction.graphProgress sourceRest rest slots) + (hargs.apply_graph_trace hfunction.stable hprogress hownership hvalue + hsource hsourceArgsNonempty sourceRest rest slots) + simpa [Function.comp_def] using hcomposed + +/-- Consume a progressing semantic argument vector through a source-backed +direct call. The callee's preserved root graph reconstructs the caller's +logical environment after the store-changing operation. -/ +theorem LowerArgsValueSettlement.call_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur d : FnDef} + {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Owned} {emit : Emit} {avs : List AVal} + {address : Ixon.Address} + (hargs : LowerArgsValueSettlement funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceArgs worlds emit avs) + (hdecl : ctx.decls address = some (.fn d)) + (hprogress : FnValueProgressContract funRel sourceCtx ctx d worlds + sourceFunction) + (hownership : FnOwnershipContract ctx d worlds) + (hvalue : FnValueContract funRel sourceCtx ctx d worlds sourceFunction) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + LowerResultValueSettlement funRel recSelfRel ctx cur + input output.bump sourceInput sourceOutput sourceResult d.result + (emit ∘ emitOp + (.call address (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.call_graph hdecl hownership hvalue + hsource + graphSettlement := ?_ } + intro sourceRest rest slots + apply EmitSettlement.comp (hargs.graphSettlement sourceRest rest slots) + apply OpProgress.emitSettlement + intro store env hpre + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + have henvFrame : Sim.RootsGraph funRel store + (entrySourceRoots output.entries sourceOutput) envRoots := + houtput.entries.rootsGraphExact + have hcombinedFrame : Sim.RootsGraph funRel store + (entrySourceRoots output.entries sourceOutput ++ sourceRest) + (envRoots ++ rest) := + henvFrame.append hrestGraph + have hownCall : RootOwnership store + (rootsForWorlds worlds values ++ (envRoots ++ rest)) := by + simpa [List.append_assoc] using hown + have hlength : values.length = worlds.length := + havs.lengths.2.symm.trans havs.lengths.1.symm + obtain ⟨fuel, store', result, hrun, hresultGraph, hcombinedAfter, + hownAfter⟩ := + runOp_call_value_progress + (sourceCtx := sourceCtx) (ctx := ctx) (cur := cur) + havs.resolveAtoms hdecl hprogress hownership hvalue hlength + hvalueGraphs hsource hcombinedFrame hownCall + obtain ⟨henvAfter, hrestAfter⟩ := + hcombinedAfter.splitAppend henvFrame.lengths + have houtputAfter : VEnvValueGraph funRel recSelfRel store' + output sourceOutput env envRoots := + houtput.ofRootsGraph henvAfter + refine ⟨fuel, store', result, hrun, ?_⟩ + refine ⟨⟨envRoots, result, houtputAfter.bump result, ?_, + hresultGraph, hrestAfter, hownAfter⟩, hslots.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +/-- Recursive-self counterpart of `LowerArgsValueSettlement.call_graph`. -/ +theorem LowerArgsValueSettlement.callSelf_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Owned} {emit : Emit} {avs : List AVal} + (hargs : LowerArgsValueSettlement funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceArgs worlds emit avs) + (hprogress : FnValueProgressContract funRel sourceCtx ctx cur worlds + sourceFunction) + (hownership : FnOwnershipContract ctx cur worlds) + (hvalue : FnValueContract funRel sourceCtx ctx cur worlds + sourceFunction) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + LowerResultValueSettlement funRel recSelfRel ctx cur + input output.bump sourceInput sourceOutput sourceResult cur.result + (emit ∘ emitOp + (.callSelf (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.callSelf_graph hownership hvalue hsource + graphSettlement := ?_ } + intro sourceRest rest slots + apply EmitSettlement.comp (hargs.graphSettlement sourceRest rest slots) + apply OpProgress.emitSettlement + intro store env hpre + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + have henvFrame : Sim.RootsGraph funRel store + (entrySourceRoots output.entries sourceOutput) envRoots := + houtput.entries.rootsGraphExact + have hcombinedFrame : Sim.RootsGraph funRel store + (entrySourceRoots output.entries sourceOutput ++ sourceRest) + (envRoots ++ rest) := + henvFrame.append hrestGraph + have hownCall : RootOwnership store + (rootsForWorlds worlds values ++ (envRoots ++ rest)) := by + simpa [List.append_assoc] using hown + have hlength : values.length = worlds.length := + havs.lengths.2.symm.trans havs.lengths.1.symm + obtain ⟨fuel, store', result, hrun, hresultGraph, hcombinedAfter, + hownAfter⟩ := + runOp_callSelf_value_progress + (sourceCtx := sourceCtx) (ctx := ctx) (cur := cur) + havs.resolveAtoms hprogress hownership hvalue hlength hvalueGraphs + hsource hcombinedFrame hownCall + obtain ⟨henvAfter, hrestAfter⟩ := + hcombinedAfter.splitAppend henvFrame.lengths + have houtputAfter : VEnvValueGraph funRel recSelfRel store' + output sourceOutput env envRoots := + houtput.ofRootsGraph henvAfter + refine ⟨fuel, store', result, hrun, ?_⟩ + refine ⟨⟨envRoots, result, houtputAfter.bump result, ?_, + hresultGraph, hrestAfter, hownAfter⟩, hslots.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +/-- Recursive-self progress where the source function identity is recovered +from the synthetic input entry. -/ +theorem LowerArgsValueSettlement.callSelf_entry_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {input output : VEnv} {index arity : Nat} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Owned} {emit : Emit} {avs : List AVal} + (hargs : LowerArgsValueSettlement funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceArgs worlds emit avs) + (hentry : input.entries[index]? = some (.recSelf arity)) + (hhead : sourceInput[index]? = some sourceFunction) + (hprogress : recSelfRel sourceFunction arity → + FnValueProgressContract funRel sourceCtx ctx cur worlds sourceFunction) + (hownership : FnOwnershipContract ctx cur worlds) + (hvalue : recSelfRel sourceFunction arity → + FnValueContract funRel sourceCtx ctx cur worlds sourceFunction) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + LowerResultValueSettlement funRel recSelfRel ctx cur + input output.bump sourceInput sourceOutput sourceResult cur.result + (emit ∘ emitOp + (.callSelf (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.callSelf_entry_graph hentry hhead + hownership hvalue hsource + graphSettlement := ?_ } + intro sourceRest rest slots + apply EmitSettlement.of_pointwise + intro store env hpre + obtain ⟨⟨envRoots, hinput, hrestGraph, hown⟩, hslots⟩ := hpre + obtain ⟨source, hsourceLookup, hself⟩ := hinput.getRecSelf hentry + have hsourceEq : source = sourceFunction := by + rw [hhead] at hsourceLookup + exact (Option.some.inj hsourceLookup).symm + subst source + have hsound := hargs.callSelf_graph (hprogress hself) hownership + (hvalue hself) hsource + exact ⟨_, ⟨⟨envRoots, hinput, hrestGraph, hown⟩, hslots⟩, + hsound.graphSettlement sourceRest rest slots⟩ + +/-- Recursive-self call progress from the whole current-function contract. +The advertised marker arity is checked semantically: a realizable marker +supplies a progress contract whose arity equation rules out the target's +stuck arity branch. -/ +theorem LowerArgsValueSettlement.callSelf_current_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {input output : VEnv} {index arity : Nat} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {emit : Emit} {avs : List AVal} + (hargs : LowerArgsValueSettlement funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceArgs + (List.replicate arity .shared) emit avs) + (hentry : input.entries[index]? = some (.recSelf arity)) + (hhead : sourceInput[index]? = some sourceFunction) + (hself : CurrentSelfProgressContract funRel recSelfRel sourceCtx ctx + cur) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) + (havsLength : avs.length = arity) : + LowerResultValueSettlement funRel recSelfRel ctx cur + input output.bump sourceInput sourceOutput sourceResult cur.result + (emit ∘ emitOp + (.callSelf (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + by_cases harity : arity = cur.arity + · have hprogress : recSelfRel sourceFunction arity → + FnValueProgressContract funRel sourceCtx ctx cur + (List.replicate arity .shared) sourceFunction := by + intro hrel + exact hself.progress hrel + have hownership : FnOwnershipContract ctx cur + (List.replicate arity .shared) := by + simpa [harity] using hself.ownership + have hvalue : recSelfRel sourceFunction arity → + FnValueContract funRel sourceCtx ctx cur + (List.replicate arity .shared) sourceFunction := by + intro hrel + simpa [harity] using hself.value (by simpa [harity] using hrel) + exact hargs.callSelf_entry_graph hentry hhead hprogress hownership + hvalue hsource + · refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.callSelf_arity_mismatch_graph + (fun heq => harity (havsLength.symm.trans heq)) + graphSettlement := ?_ } + intro sourceRest rest slots + apply EmitSettlement.of_pointwise + intro store env hpre + obtain ⟨⟨envRoots, hinput, hrestGraph, hown⟩, hslots⟩ := hpre + obtain ⟨source, hsourceLookup, hrel⟩ := hinput.getRecSelf hentry + have hsourceEq : source = sourceFunction := by + rw [hhead] at hsourceLookup + exact (Option.some.inj hsourceLookup).symm + subst source + have hcontract := hself.progress hrel + have heq : arity = cur.arity := by + simpa using hcontract.arity_eq + exact (harity heq).elim + +/-- Consume a progressing homogeneous shared argument prefix through the +scalar extern ABI. The explicit progress contract supplies oracle +definedness; the value contract supplies source-result correspondence. -/ +theorem LowerArgsValueSettlement.extern_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {emit : Emit} {avs : List AVal} {address : Ixon.Address} + {arity : Nat} {resultWorld : Owned} + (hargs : LowerArgsValueSettlement funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceArgs + (List.replicate avs.length .shared) emit avs) + (hprogress : ExternProgressContract funRel sourceCtx ctx) + (hvalue : ExternValueContract funRel sourceCtx ctx) + (hlookup : sourceCtx.env address = some (.extern arity)) + (href : SourceRefValue sourceCtx address sourceFunction) + (hlength : sourceArgs.length = arity) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + LowerResultValueSettlement funRel recSelfRel ctx cur + input output.bump sourceInput sourceOutput sourceResult resultWorld + (emit ∘ emitOp + (.extern address (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultValueSound := + hargs.toLowerArgsValueSound.extern_graph hvalue hlookup href hlength + hsource + graphSettlement := ?_ } + intro sourceRest rest slots + apply EmitSettlement.comp (hargs.graphSettlement sourceRest rest slots) + apply OpProgress.emitSettlement + intro store env hpre + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + have hvaluesLength : values.length = avs.length := + havs.lengths.2.symm + have hroots : + rootsForWorlds (List.replicate avs.length .shared) values = + rootsFor .shared values := + rootsForWorlds_replicate_eq_rootsFor .shared hvaluesLength + have hownExtern : RootOwnership store + (rootsFor .shared values ++ (envRoots ++ rest)) := by + simpa [hroots, List.append_assoc] using hown + obtain ⟨fuel, result, hrun, hresultGraph, hownAfter⟩ := + runOp_extern_value_progress + (sourceCtx := sourceCtx) (ctx := ctx) (cur := cur) + (resultWorld := resultWorld) havs.resolveAtoms hprogress hvalue + hlookup href hlength hsource hvalueGraphs hownExtern + refine ⟨fuel, store, result, hrun, ?_⟩ + refine ⟨⟨envRoots, result, houtput.bump result, ?_, + hresultGraph, hrestGraph, hownAfter⟩, hslots.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +/-- Lower shared arguments while framing an already-produced function, then +consume both through source-guided higher-order application progress. -/ +theorem LowerArgsValueSettlement.apply_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {emit : Emit} {avs : List AVal} {function : AVal} + (hargs : LowerArgsValueSettlement funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceArgs + (List.replicate avs.length .shared) emit avs) + (hfunctionStable : AValStable function) + (hprogress : ApplyValueProgressContract funRel sourceCtx ctx) + (hownership : ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + ∀ sourceRest rest slots, + EmitSettlement ctx cur + (emit ∘ emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (GraphOwnsResultProtected funRel recSelfRel input sourceInput + sourceFunction .shared function sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult .shared (.slotA output.depth) + sourceRest rest slots) := by + intro sourceRest rest slots + apply EmitSettlement.of_pointwise + intro store env hfunctionPre + obtain ⟨⟨envRoots, functionValue, hinput, hfunction, + hfunctionGraph, hrestGraph, hownFunction⟩, hslots⟩ := hfunctionPre + let functionRoot : Root := ⟨.shared, functionValue⟩ + have hfunctionWorld : HasWorld store .shared functionValue := + hownFunction.roots_world functionRoot (by simp [functionRoot]) + have hframeGraph : Sim.RootsGraph funRel store + ((.shared, sourceFunction) :: sourceRest) (functionRoot :: rest) := + .cons rfl hfunctionWorld hfunctionGraph hrestGraph + have hfunctionProtection : + SlotsRealize input env (aValProtection function functionValue) := + hfunctionStable.protection_realized hfunction + have hargsOwn : RootOwnership store (envRoots ++ functionRoot :: rest) := by + apply hownFunction.perm + simpa [functionRoot] using + (permExtractRoot functionRoot envRoots [] rest).symm + have hargsPre : GraphOwnsVEnvProtected funRel recSelfRel input + sourceInput ((.shared, sourceFunction) :: sourceRest) + (functionRoot :: rest) + (aValProtection function functionValue ++ slots) store env := + ⟨⟨envRoots, hinput, hframeGraph, hargsOwn⟩, + hfunctionProtection.append hslots⟩ + have happlyProgress : EmitSettlement ctx cur + (emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (GraphOwnsArgsResultProtected funRel recSelfRel output + sourceOutput sourceArgs (List.replicate avs.length .shared) avs + ((.shared, sourceFunction) :: sourceRest) (functionRoot :: rest) + (aValProtection function functionValue ++ slots)) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult .shared (.slotA output.depth) + sourceRest rest slots) := by + apply OpProgress.emitSettlement + intro argsStore argsEnv hargsPost + obtain ⟨⟨outRoots, values, houtput, havs, hvalueGraphs, + hframeGraphFinal, hownArgs⟩, hslotsOut⟩ := hargsPost + cases hframeGraphFinal with + | cons _ hfunctionWorldFinal hfunctionGraphFinal hrestGraphFinal => + have hfunctionFinal : + AValRealizes output argsEnv function functionValue := + hfunctionStable.realize_of_protection hfunction + hslotsOut.left_of_append + have hfunctionGraph' : Sim.ValueGraph funRel argsStore + sourceFunction functionValue := by + simpa [functionRoot] using hfunctionGraphFinal + have hvaluesLength : values.length = avs.length := + havs.lengths.2.symm + have hroots : + rootsForWorlds (List.replicate avs.length .shared) values = + rootsFor .shared values := + rootsForWorlds_replicate_eq_rootsFor .shared hvaluesLength + have hownApply : RootOwnership argsStore + (functionRoot :: rootsFor .shared values ++ + (outRoots ++ rest)) := by + apply hownArgs.perm + simpa [functionRoot, hroots, List.append_assoc] using + (permExtractRoot functionRoot + (rootsForWorlds (List.replicate avs.length .shared) values ++ + outRoots) [] rest) + have henvFrame : Sim.RootsGraph funRel argsStore + (entrySourceRoots output.entries sourceOutput) outRoots := + houtput.entries.rootsGraphExact + have hcombinedFrame : Sim.RootsGraph funRel argsStore + (entrySourceRoots output.entries sourceOutput ++ sourceRest) + (outRoots ++ rest) := + henvFrame.append hrestGraphFinal + obtain ⟨fuel, store', result, hrun, hresultGraph, hcombinedAfter, + hownAfter⟩ := + runOp_apply_value_progress + (sourceCtx := sourceCtx) (ctx := ctx) (cur := cur) + hfunctionFinal.resolveAtom havs.resolveAtoms hprogress hownership + hvalue hfunctionGraph' hvalueGraphs hsource hcombinedFrame + hownApply + obtain ⟨henvAfter, hrestAfter⟩ := + hcombinedAfter.splitAppend henvFrame.lengths + have houtputAfter : VEnvValueGraph funRel recSelfRel store' + output sourceOutput argsEnv outRoots := + houtput.ofRootsGraph henvAfter + refine ⟨fuel, store', result, hrun, ?_⟩ + refine ⟨⟨outRoots, result, houtputAfter.bump result, ?_, + hresultGraph, hrestAfter, hownAfter⟩, + hslotsOut.right_of_append.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + have hargsThenApply := EmitSettlement.comp + (hargs.graphSettlement ((.shared, sourceFunction) :: sourceRest) + (functionRoot :: rest) + (aValProtection function functionValue ++ slots)) + happlyProgress + exact ⟨_, hargsPre, hargsThenApply⟩ + +/-- Full higher-order progress composition: produce the function, evaluate +the argument vector, and perform the source-guided target application. -/ +theorem LowerResultValueSettlement.applyArgs_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {start input output : VEnv} + {sourceStart sourceMiddle sourceOutput sourceArgs : + List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {emitFunction emitArgs : Emit} {function : AVal} {avs : List AVal} + (hfunction : LowerResultValueSettlement funRel recSelfRel ctx cur + start input sourceStart sourceMiddle sourceFunction .shared + emitFunction function) + (hargs : LowerArgsValueSettlement funRel recSelfRel ctx cur + input output sourceMiddle sourceOutput sourceArgs + (List.replicate avs.length .shared) emitArgs avs) + (hprogress : ApplyValueProgressContract funRel sourceCtx ctx) + (hownership : ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + LowerResultValueSettlement funRel recSelfRel ctx cur + start output.bump sourceStart sourceOutput sourceResult .shared + ((emitFunction ∘ emitArgs) ∘ + emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultValueSound := + hfunction.toLowerResultValueSound.applyArgs_graph + hargs.toLowerArgsValueSound hownership hvalue hsource + graphSettlement := ?_ } + intro sourceRest rest slots + have hcomposed := EmitSettlement.comp + (hfunction.graphSettlement sourceRest rest slots) + (hargs.apply_graph hfunction.stable hprogress hownership hvalue hsource + sourceRest rest slots) + simpa [Function.comp_def] using hcomposed + +/-- Reachable-state non-erased higher-order application progress. Its +recursive work is exactly the progressing shared-argument traversal. -/ +theorem applyRestNonErasedValueProgressesWithin_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hargs : LowerArgsValueProgressesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hprogress : ApplyValueProgressContract funRel sourceCtx ctx) + (hownership : ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) : + ApplyRestNonErasedValueProgressesWithin funRel recSelfRel sourceCtx ctx + cur src ambient (fuel + 1) := by + intro start input output sourceStart sourceMiddle sourceArgs + sourceFunction sourceResult resultWorld emitFunction emit function av + args state finalState hfunctionNe hsourceArgs hsource hfunction hrun + hextends havailable + simp only [applyRest] at hrun + cases resultWorld with + | unique => + have hrequire : + (requireResultWorld .shared .unique).run state = + .error "call result is shared at unique demand" state := by + rfl + rw [estateBindRun, hrequire] at hrun + contradiction + | shared => + have hrequire : + (requireResultWorld .shared .shared).run state = .ok () state := by + rfl + rw [estateBindRun, hrequire] at hrun + simp only at hrun + obtain ⟨argsResult, argsState, hargsRun, hpureRun⟩ := + trackedBindRun_ok_inv hrun + rcases argsResult with ⟨argsOutput, emitArgs, avs⟩ + have hpure : + (argsOutput.bump, + (emitFunction ∘ emitArgs) ∘ + emitOp (.apply (function.toAtom argsOutput) + (avs.map (·.toAtom argsOutput)).toArray), + AVal.slotA argsOutput.depth) = (output, emit, av) ∧ + argsState = finalState := by + simpa [Function.comp_def] using hpureRun + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + have hsourcePaired : SourceArgsEval sourceCtx sourceMiddle + ((args.map (fun arg => (arg, Owned.shared))).map Prod.fst) + sourceArgs := by + simpa [Function.comp_def] using hsourceArgs + have hargsProgress := + hargs hsourcePaired hargsRun hextends havailable + have havsLength : avs.length = args.length := by + simpa using lowerArgs_success_length src hargsRun + have hworldsHomogeneous : + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate avs.length .shared := by + simpa [havsLength] using map_shared_arg_worlds args + have hhomogeneous : LowerArgsValueProgress funRel recSelfRel ctx cur + input argsOutput sourceMiddle sourceMiddle sourceArgs + (List.replicate avs.length .shared) emitArgs avs := by + simpa [hworldsHomogeneous] using hargsProgress + simpa [Function.comp_def] using + hfunction.applyArgs_graph hhomogeneous hprogress hownership hvalue + hsource + +/-- Projection-safe counterpart of non-erased higher-order application. -/ +theorem applyRestNonErasedValueProgressesSafelyWithin_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hargs : LowerArgsValueProgressesSafelyWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hprogress : ApplyValueProgressContract funRel sourceCtx ctx) + (hownership : ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) : + ApplyRestNonErasedValueProgressesSafelyWithin funRel recSelfRel + sourceCtx ctx cur src ambient (fuel + 1) := by + intro start input output sourceStart sourceMiddle sourceArgs + sourceFunction sourceResult resultWorld emitFunction emit function av + args state finalState hfunctionNe hsourceArgs hsource hfunction hrun + hextends havailable + simp only [applyRest] at hrun + cases resultWorld with + | unique => + have hrequire : + (requireResultWorld .shared .unique).run state = + .error "call result is shared at unique demand" state := by + rfl + rw [estateBindRun, hrequire] at hrun + contradiction + | shared => + have hrequire : + (requireResultWorld .shared .shared).run state = .ok () state := by + rfl + rw [estateBindRun, hrequire] at hrun + simp only at hrun + obtain ⟨argsResult, argsState, hargsRun, hpureRun⟩ := + trackedBindRun_ok_inv hrun + rcases argsResult with ⟨argsOutput, emitArgs, avs⟩ + have hpure : + (argsOutput.bump, + (emitFunction ∘ emitArgs) ∘ + emitOp (.apply (function.toAtom argsOutput) + (avs.map (·.toAtom argsOutput)).toArray), + AVal.slotA argsOutput.depth) = (output, emit, av) ∧ + argsState = finalState := by + simpa [Function.comp_def] using hpureRun + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + have hsourcePaired : ProjectionSafeArgs sourceCtx sourceMiddle + ((args.map (fun arg => (arg, Owned.shared))).map Prod.fst) + sourceArgs := by + simpa [Function.comp_def] using hsourceArgs + have hargsProgress := + hargs hsourcePaired hargsRun hextends havailable + have havsLength : avs.length = args.length := by + simpa using lowerArgs_success_length src hargsRun + have hworldsHomogeneous : + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate avs.length .shared := by + simpa [havsLength] using map_shared_arg_worlds args + have hhomogeneous : LowerArgsValueProgress funRel recSelfRel ctx cur + input argsOutput sourceMiddle sourceMiddle sourceArgs + (List.replicate avs.length .shared) emitArgs avs := by + simpa [hworldsHomogeneous] using hargsProgress + simpa [Function.comp_def] using + hfunction.applyArgs_graph hhomogeneous hprogress hownership hvalue + hsource + +/-- Exact-trace non-erased higher-order application. The operation contract +is selected at the spine's source bound, which is strictly below the outer +callable-sealing index. -/ +theorem applyRestNonErasedValueTraceProgressesWithinBelow_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hargs : LowerArgsValueTraceProgressesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + (hprogress : ApplyValueTraceProgressContractBelow funRel sourceCtx ctx + limit) + (hownership : ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) : + ApplyRestNonErasedValueTraceProgressesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient (fuel + 1) := by + intro start input output sourceLimit sourceStart sourceMiddle sourceArgs + sourceFunction sourceResult resultWorld emitFunction emit function av + args state finalState hlimit hfunctionNe hsourceArgs hsource + hsourceArgsNonempty hfunction hrun hextends havailable + simp only [applyRest] at hrun + cases resultWorld with + | unique => + have hrequire : + (requireResultWorld .shared .unique).run state = + .error "call result is shared at unique demand" state := by + rfl + rw [estateBindRun, hrequire] at hrun + contradiction + | shared => + have hrequire : + (requireResultWorld .shared .shared).run state = .ok () state := by + rfl + rw [estateBindRun, hrequire] at hrun + simp only at hrun + obtain ⟨argsResult, argsState, hargsRun, hpureRun⟩ := + trackedBindRun_ok_inv hrun + rcases argsResult with ⟨argsOutput, emitArgs, avs⟩ + have hpure : + (argsOutput.bump, + (emitFunction ∘ emitArgs) ∘ + emitOp (.apply (function.toAtom argsOutput) + (avs.map (·.toAtom argsOutput)).toArray), + AVal.slotA argsOutput.depth) = (output, emit, av) ∧ + argsState = finalState := by + simpa [Function.comp_def] using hpureRun + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + have hsourcePaired : IxIR0.ProjectionSafe.EvalsBelow sourceCtx + sourceLimit sourceMiddle + ((args.map (fun arg => (arg, Owned.shared))).map Prod.fst) + sourceArgs := by + simpa [Function.comp_def] using hsourceArgs + have hargsProgress := + hargs hlimit hsourcePaired hargsRun hextends havailable + have havsLength : avs.length = args.length := by + simpa using lowerArgs_success_length src hargsRun + have hworldsHomogeneous : + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate avs.length .shared := by + simpa [havsLength] using map_shared_arg_worlds args + have hhomogeneous : LowerArgsValueProgress funRel recSelfRel ctx cur + input argsOutput sourceMiddle sourceMiddle sourceArgs + (List.replicate avs.length .shared) emitArgs avs := by + simpa [hworldsHomogeneous] using hargsProgress + simpa [Function.comp_def] using + hfunction.applyArgs_graph_trace hhomogeneous + (hprogress.progresses hlimit) hownership hvalue hsource + hsourceArgsNonempty + +/-- Reachable-state non-erased higher-order application progress. Its +recursive work is exactly the progressing shared-argument traversal. -/ +theorem applyRestNonErasedValueSettlesWithin_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hargs : LowerArgsValueSettlesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hprogress : ApplyValueProgressContract funRel sourceCtx ctx) + (hownership : ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) : + ApplyRestNonErasedValueSettlesWithin funRel recSelfRel sourceCtx ctx + cur src ambient (fuel + 1) := by + intro start input output sourceStart sourceMiddle sourceArgs + sourceFunction sourceResult resultWorld emitFunction emit function av + args state finalState hfunctionNe hsourceArgs hsource hfunction hrun + hextends havailable + simp only [applyRest] at hrun + cases resultWorld with + | unique => + have hrequire : + (requireResultWorld .shared .unique).run state = + .error "call result is shared at unique demand" state := by + rfl + rw [estateBindRun, hrequire] at hrun + contradiction + | shared => + have hrequire : + (requireResultWorld .shared .shared).run state = .ok () state := by + rfl + rw [estateBindRun, hrequire] at hrun + simp only at hrun + obtain ⟨argsResult, argsState, hargsRun, hpureRun⟩ := + trackedBindRun_ok_inv hrun + rcases argsResult with ⟨argsOutput, emitArgs, avs⟩ + have hpure : + (argsOutput.bump, + (emitFunction ∘ emitArgs) ∘ + emitOp (.apply (function.toAtom argsOutput) + (avs.map (·.toAtom argsOutput)).toArray), + AVal.slotA argsOutput.depth) = (output, emit, av) ∧ + argsState = finalState := by + simpa [Function.comp_def] using hpureRun + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + have hsourcePaired : SourceArgsEval sourceCtx sourceMiddle + ((args.map (fun arg => (arg, Owned.shared))).map Prod.fst) + sourceArgs := by + simpa [Function.comp_def] using hsourceArgs + have hargsProgress := + hargs hsourcePaired hargsRun hextends havailable + have havsLength : avs.length = args.length := by + simpa using lowerArgs_success_length src hargsRun + have hworldsHomogeneous : + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate avs.length .shared := by + simpa [havsLength] using map_shared_arg_worlds args + have hhomogeneous : LowerArgsValueSettlement funRel recSelfRel ctx cur + input argsOutput sourceMiddle sourceMiddle sourceArgs + (List.replicate avs.length .shared) emitArgs avs := by + simpa [hworldsHomogeneous] using hargsProgress + simpa [Function.comp_def] using + hfunction.applyArgs_graph hhomogeneous hprogress hownership hvalue + hsource + +/-- Reachable-state progressing `knownCall`. The prefix argument traversal +and the optional over-application tail retain the same ambient-state +threading as the semantic partial-correctness induction. -/ +theorem knownCall_run_value_progress_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {build : Array Atom → Op} {argWorlds : List Owned} + {resultWorld buildWorld : Owned} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueProgressesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hbuild : ∀ {prefixOutput : VEnv} {emitPrefix : Emit} + {prefixAVals : List AVal} {sourceBuilt : IxIR0.Value}, + LowerArgsValueProgress funRel recSelfRel ctx cur input prefixOutput + sourceEnv sourceEnv (sourceValues.take count) + (((args.take count).zip (padWorlds argWorlds count)).map Prod.snd) + emitPrefix prefixAVals → + SourceApplies sourceCtx sourceFunction (sourceValues.take count) + sourceBuilt → + prefixAVals.length = + ((args.take count).zip (padWorlds argWorlds count)).length → + LowerResultValueProgress funRel recSelfRel ctx cur input + prefixOutput.bump sourceEnv sourceEnv sourceBuilt buildWorld + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth)) + (hterminalWorld : args.length ≤ count → buildWorld = resultWorld) + (hoverWorld : count < args.length → buildWorld = .shared) + (hrun : (knownCall src (fuel + 1) input build count argWorlds + resultWorld args).run state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult resultWorld emit av := by + simp only [knownCall] at hrun + obtain ⟨prefixResult, prefixState, hprefixRun, hafterPrefix⟩ := + trackedBindRun_ok_inv hrun + rcases prefixResult with ⟨prefixOutput, emitPrefix, prefixAVals⟩ + dsimp only at hafterPrefix + have hprefixLength := lowerArgs_success_length src hprefixRun + have hprefixSource : SourceArgsEval sourceCtx sourceEnv + (((args.take count).zip + (padWorlds argWorlds count)).map Prod.fst) + (sourceValues.take count) := by + rw [knownCall_prefix_exprs_eq] + exact hsourceArgs.take count + obtain ⟨sourceBuilt, hprefixApply, htailApply⟩ := + hsource.splitAt count + by_cases hle : args.length ≤ count + · rw [if_pos hle] at hafterPrefix + have hpure : + (prefixOutput.bump, + emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray), + AVal.slotA prefixOutput.depth) = (output, emit, av) ∧ + prefixState = finalState := by + simpa using hafterPrefix + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + have hprefixProgress := hargs hprefixSource hprefixRun hextends + havailable + have hbuilt := hbuild hprefixProgress hprefixApply hprefixLength + have hsourceLe : sourceValues.length ≤ count := by + simpa [← hsourceArgs.lengths] using hle + rw [List.drop_eq_nil_of_le hsourceLe] at htailApply + cases htailApply + simpa [hterminalWorld hle] using hbuilt + · have hover : count < args.length := Nat.lt_of_not_ge hle + rw [if_neg hle] at hafterPrefix + have hprefixExtends : ExtraExtends prefixState ambient := + (applyRest_extraExtends hafterPrefix).trans hextends + have hprefixProgress := hargs hprefixSource hprefixRun hprefixExtends + havailable + have hbuilt := hbuild hprefixProgress hprefixApply hprefixLength + have hbuiltShared : LowerResultValueProgress funRel recSelfRel ctx cur + input prefixOutput.bump sourceEnv sourceEnv sourceBuilt .shared + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) := by + simpa [hoverWorld hover] using hbuilt + exact hrest (by simp) (hsourceArgs.drop count) htailApply + hbuiltShared hafterPrefix hextends + (havailable.lowerArgs hprefixRun).bump + +/-- Direct-call specialization of progressing `knownCall`. -/ +theorem knownCall_call_run_value_progress_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur d : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {argWorlds : List Owned} {resultWorld : Owned} {f : Ixon.Address} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueProgressesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hworlds : argWorlds.length = count) + (hcount : count ≤ args.length) + (hdecl : ctx.decls f = some (.fn d)) + (hprogress : FnValueProgressContract funRel sourceCtx ctx d argWorlds + sourceFunction) + (hownership : FnOwnershipContract ctx d argWorlds) + (hvalue : FnValueContract funRel sourceCtx ctx d argWorlds + sourceFunction) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hterminalWorld : args.length ≤ count → d.result = resultWorld) + (hoverWorld : count < args.length → d.result = .shared) + (hrun : (knownCall src (fuel + 1) input (.call f ·) count + argWorlds resultWorld args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult resultWorld emit av := by + refine knownCall_run_value_progress_within hargs hrest hsourceArgs + hsource ?_ hterminalWorld hoverWorld hrun hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixProgress + hprefixApply _ + have hshape := knownCall_prefix_worlds_eq args argWorlds count + hworlds hcount + have hprefix : LowerArgsValueProgress funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + argWorlds emitPrefix prefixAVals := by + simpa only [hshape] using hprefixProgress + exact hprefix.call_graph hdecl hprogress hownership hvalue hprefixApply + +/-- Recursive-self `knownCall` specialization using the synthetic input +entry to recover both value correspondence and source-guided termination. -/ +theorem knownCall_callSelf_entry_run_value_progress_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count index : Nat} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueProgressesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hcount : count ≤ args.length) + (hentry : input.entries[index]? = some (.recSelf count)) + (hhead : sourceEnv[index]? = some sourceFunction) + (hprogress : recSelfRel sourceFunction count → + FnValueProgressContract funRel sourceCtx ctx cur + (List.replicate count .shared) sourceFunction) + (hownership : FnOwnershipContract ctx cur + (List.replicate count .shared)) + (hvalue : recSelfRel sourceFunction count → + FnValueContract funRel sourceCtx ctx cur + (List.replicate count .shared) sourceFunction) + (hresult : cur.result = .shared) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hrun : (knownCall src (fuel + 1) input (.callSelf ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult .shared emit av := by + refine knownCall_run_value_progress_within hargs hrest hsourceArgs + hsource ?_ (fun _ => by simpa [hresult]) + (fun _ => by simpa [hresult]) hrun hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixProgress + hprefixApply _ + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hprefix : LowerArgsValueProgress funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate count .shared) emitPrefix prefixAVals := by + simpa only [hshape] using hprefixProgress + have hbuilt := hprefix.callSelf_entry_graph hentry hhead hprogress + hownership hvalue hprefixApply + simpa [hresult] using hbuilt + +/-- Recursive-self `knownCall` specialization discharged directly by the +whole current-function progress package. -/ +theorem knownCall_callSelf_current_run_value_progress_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count index : Nat} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueProgressesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hcount : count ≤ args.length) + (hentry : input.entries[index]? = some (.recSelf count)) + (hhead : sourceEnv[index]? = some sourceFunction) + (hself : CurrentSelfProgressContract funRel recSelfRel sourceCtx ctx cur) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hrun : (knownCall src (fuel + 1) input (.callSelf ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult .shared emit av := by + refine knownCall_run_value_progress_within + (build := .callSelf) (count := count) + (argWorlds := List.replicate count .shared) + (resultWorld := .shared) (buildWorld := .shared) + hargs hrest hsourceArgs hsource ?_ (fun _ => rfl) + (fun _ => rfl) hrun hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixProgress + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count .shared) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsValueProgress funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate count .shared) emitPrefix prefixAVals := by + simpa only [hshape] using hprefixProgress + have hbuilt := hprefix.callSelf_current_graph hentry hhead hself + hprefixApply havsLength + simpa [hself.result] using hbuilt + +/-- Constructor-allocation specialization of progressing `knownCall`. -/ +theorem knownCall_alloc_run_value_progress_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {world : Owned} {cid : CtorId} + {sourceAddress : Ixon.Address} {sourceTag : Nat} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueProgressesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hcount : count ≤ args.length) + (haddress : cid.block = sourceAddress) + (htag : cid.cidx = sourceTag) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hctor : SourceApplies sourceCtx sourceFunction + (sourceValues.take count) + (.ctor sourceAddress sourceTag (sourceValues.take count))) + (hrun : (knownCall src (fuel + 1) input (.alloc world cid ·) count + (List.replicate count world) world args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + refine knownCall_run_value_progress_within hargs hrest hsourceArgs + hsource ?_ (fun _ => rfl) ?_ hrun hextends havailable + · intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixProgress + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count world) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count world) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsValueProgress funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length world) + emitPrefix prefixAVals := by + simpa only [hshape, havsLength] using hprefixProgress + have hbuilt := hprefix.alloc_graph haddress htag + rw [hprefixApply.deterministic hctor] + exact hbuilt + · intro hover + exact knownCall_over_run_world_shared hover hrun + +/-- Scalar-extern specialization of progressing `knownCall`. -/ +theorem knownCall_extern_run_value_progress_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {f : Ixon.Address} {input output : VEnv} {resultWorld : Owned} + {args : List IxIR0.Expr} {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueProgressesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hprogress : ExternProgressContract funRel sourceCtx ctx) + (hcontract : ExternValueContract funRel sourceCtx ctx) + (hcount : count ≤ args.length) + (hlookup : sourceCtx.env f = some (.extern count)) + (href : SourceRefValue sourceCtx f sourceFunction) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hrun : (knownCall src (fuel + 1) input (.extern f ·) count + (List.replicate count .shared) resultWorld args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult resultWorld emit av := by + refine knownCall_run_value_progress_within hargs hrest hsourceArgs + hsource ?_ (fun _ => rfl) ?_ hrun hextends havailable + · intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixProgress + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count .shared) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsValueProgress funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length .shared) + emitPrefix prefixAVals := by + simpa only [hshape, havsLength] using hprefixProgress + have hvalueCount : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hvalueCount] + exact hprefix.extern_graph hprogress hcontract hlookup href htakeLength + hprefixApply + · intro hover + exact knownCall_over_run_world_shared hover hrun + +/-- Partial-application specialization of progressing `knownCall`. -/ +theorem knownCall_papp_run_value_progress_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {f : Ixon.Address} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueProgressesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hcount : count ≤ args.length) + (hdecl : ctx.decls f = some d) + (hunder : count < declArity d) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hfun : ∀ {sourceBuilt : IxIR0.Value}, + SourceApplies sourceCtx sourceFunction (sourceValues.take count) + sourceBuilt → + funRel sourceBuilt f (declArity d) (sourceValues.take count)) + (hrun : (knownCall src (fuel + 1) input (.papp f ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult .shared emit av := by + refine knownCall_run_value_progress_within hargs hrest hsourceArgs + hsource ?_ (fun _ => rfl) (fun _ => rfl) hrun hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixProgress + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count .shared) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsValueProgress funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length .shared) + emitPrefix prefixAVals := by + simpa only [hshape, havsLength] using hprefixProgress + apply hprefix.papp_graph hdecl (hfun hprefixApply) + simpa [havsLength] using hunder + +/-- Static source-address pap allocation under the whole-pass function +relation. -/ +theorem knownCall_papp_source_run_value_progress_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + {fuel count : Nat} {f : Ixon.Address} {source : IxIR0.Decl} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hcount : count ≤ args.length) + (hsrc : src f = some source) + (heligible : SourcePapEligible source) + (harity : sourceDeclArity source = declArity d) + (href : SourceRefValue sourceCtx f sourceFunction) + (hdecl : ctx.decls f = some d) + (hunder : count < declArity d) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hrun : (knownCall src (fuel + 1) input (.papp f ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + .shared emit av := by + apply knownCall_papp_run_value_progress_within hargs hrest hcount hdecl + hunder hsourceArgs hsource + · intro sourceBuilt hprefixApply + apply CompilerFunctionRel.source hsrc heligible harity href hprefixApply + have hcountValues : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hcountValues] + simpa [htakeLength] using hunder + · exact hrun + · exact hextends + · exact havailable + +/-- Memoized constructor-wrapper pap allocation under the whole-pass +function relation. -/ +theorem knownCall_papp_wrapper_run_value_progress_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + {fuel count : Nat} {memo : WrapperMemo} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hcount : count ≤ args.length) + (hmember : memo ∈ ambient.wrappers) + (hsrc : src memo.source = some (.ctor memo.tag memo.arity)) + (href : SourceRefValue sourceCtx memo.source sourceFunction) + (hdecl : ctx.decls memo.wrapper = some d) + (harity : memo.arity = declArity d) + (hunder : count < declArity d) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hrun : (knownCall src (fuel + 1) input (.papp memo.wrapper ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + .shared emit av := by + apply knownCall_papp_run_value_progress_within hargs hrest hcount hdecl + hunder hsourceArgs hsource + · intro sourceBuilt hprefixApply + rw [← harity] + apply CompilerFunctionRel.wrapper hmember hsrc href hprefixApply + have hcountValues : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hcountValues] + rw [htakeLength] + simpa [harity] using hunder + · exact hrun + · exact hextends + · exact havailable + +/-- Reachable-state progressing `knownCall`. The prefix argument traversal +and the optional over-application tail retain the same ambient-state +threading as the semantic partial-correctness induction. -/ +theorem knownCall_run_value_progress_safely_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {build : Array Atom → Op} {argWorlds : List Owned} + {resultWorld buildWorld : Owned} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueProgressesSafelyWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesSafelyWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hsourceArgs : ProjectionSafeArgs sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hbuild : ∀ {prefixOutput : VEnv} {emitPrefix : Emit} + {prefixAVals : List AVal} {sourceBuilt : IxIR0.Value}, + LowerArgsValueProgress funRel recSelfRel ctx cur input prefixOutput + sourceEnv sourceEnv (sourceValues.take count) + (((args.take count).zip (padWorlds argWorlds count)).map Prod.snd) + emitPrefix prefixAVals → + SourceApplies sourceCtx sourceFunction (sourceValues.take count) + sourceBuilt → + prefixAVals.length = + ((args.take count).zip (padWorlds argWorlds count)).length → + LowerResultValueProgress funRel recSelfRel ctx cur input + prefixOutput.bump sourceEnv sourceEnv sourceBuilt buildWorld + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth)) + (hterminalWorld : args.length ≤ count → buildWorld = resultWorld) + (hoverWorld : count < args.length → buildWorld = .shared) + (hrun : (knownCall src (fuel + 1) input build count argWorlds + resultWorld args).run state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult resultWorld emit av := by + simp only [knownCall] at hrun + obtain ⟨prefixResult, prefixState, hprefixRun, hafterPrefix⟩ := + trackedBindRun_ok_inv hrun + rcases prefixResult with ⟨prefixOutput, emitPrefix, prefixAVals⟩ + dsimp only at hafterPrefix + have hprefixLength := lowerArgs_success_length src hprefixRun + have hprefixSource : ProjectionSafeArgs sourceCtx sourceEnv + (((args.take count).zip + (padWorlds argWorlds count)).map Prod.fst) + (sourceValues.take count) := by + rw [knownCall_prefix_exprs_eq] + exact hsourceArgs.take count + obtain ⟨sourceBuilt, hprefixApply, htailApply⟩ := + hsource.splitAt count + by_cases hle : args.length ≤ count + · rw [if_pos hle] at hafterPrefix + have hpure : + (prefixOutput.bump, + emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray), + AVal.slotA prefixOutput.depth) = (output, emit, av) ∧ + prefixState = finalState := by + simpa using hafterPrefix + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + have hprefixProgress := hargs hprefixSource hprefixRun hextends + havailable + have hbuilt := hbuild hprefixProgress hprefixApply hprefixLength + have hsourceLe : sourceValues.length ≤ count := by + simpa [← hsourceArgs.lengths] using hle + rw [List.drop_eq_nil_of_le hsourceLe] at htailApply + cases htailApply + simpa [hterminalWorld hle] using hbuilt + · have hover : count < args.length := Nat.lt_of_not_ge hle + rw [if_neg hle] at hafterPrefix + have hprefixExtends : ExtraExtends prefixState ambient := + (applyRest_extraExtends hafterPrefix).trans hextends + have hprefixProgress := hargs hprefixSource hprefixRun hprefixExtends + havailable + have hbuilt := hbuild hprefixProgress hprefixApply hprefixLength + have hbuiltShared : LowerResultValueProgress funRel recSelfRel ctx cur + input prefixOutput.bump sourceEnv sourceEnv sourceBuilt .shared + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) := by + simpa [hoverWorld hover] using hbuilt + exact hrest (by simp) (hsourceArgs.drop count) htailApply + hbuiltShared hafterPrefix hextends + (havailable.lowerArgs hprefixRun).bump + +/-- Exact-trace `knownCall` composition. Prefix and over-application +spines retain their common source bound through `take`/`drop` and +`AppliesBelow.splitAt`. -/ +theorem knownCall_run_value_trace_progress_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit sourceLimit : Nat} {src : IxIR0.Env} {ambient : LowSt} + {fuel count : Nat} {build : Array Atom → Op} + {argWorlds : List Owned} {resultWorld buildWorld : Owned} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueTraceProgressesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValueTraceProgressesWithinBelow funRel + recSelfRel sourceCtx ctx cur limit src ambient fuel) + (hsourceBound : sourceLimit < limit) + (hsourceArgs : IxIR0.ProjectionSafe.EvalsBelow sourceCtx sourceLimit + sourceEnv args sourceValues) + (hsource : SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + sourceValues sourceResult) + (hbuild : ∀ {prefixOutput : VEnv} {emitPrefix : Emit} + {prefixAVals : List AVal} {sourceBuilt : IxIR0.Value}, + LowerArgsValueProgress funRel recSelfRel ctx cur input prefixOutput + sourceEnv sourceEnv (sourceValues.take count) + (((args.take count).zip (padWorlds argWorlds count)).map Prod.snd) + emitPrefix prefixAVals → + SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + (sourceValues.take count) sourceBuilt → + prefixAVals.length = + ((args.take count).zip (padWorlds argWorlds count)).length → + LowerResultValueProgress funRel recSelfRel ctx cur input + prefixOutput.bump sourceEnv sourceEnv sourceBuilt buildWorld + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth)) + (hterminalWorld : args.length ≤ count → buildWorld = resultWorld) + (hoverWorld : count < args.length → buildWorld = .shared) + (hrun : (knownCall src (fuel + 1) input build count argWorlds + resultWorld args).run state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfTraceProgressAvailableBelow funRel recSelfRel + sourceCtx ctx cur limit input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult resultWorld emit av := by + simp only [knownCall] at hrun + obtain ⟨prefixResult, prefixState, hprefixRun, hafterPrefix⟩ := + trackedBindRun_ok_inv hrun + rcases prefixResult with ⟨prefixOutput, emitPrefix, prefixAVals⟩ + dsimp only at hafterPrefix + have hprefixLength := lowerArgs_success_length src hprefixRun + have hprefixSource : IxIR0.ProjectionSafe.EvalsBelow sourceCtx sourceLimit + sourceEnv + (((args.take count).zip + (padWorlds argWorlds count)).map Prod.fst) + (sourceValues.take count) := by + rw [knownCall_prefix_exprs_eq] + exact hsourceArgs.take count + obtain ⟨sourceBuilt, hprefixApply, htailApply⟩ := + hsource.splitAt count + by_cases hle : args.length ≤ count + · rw [if_pos hle] at hafterPrefix + have hpure : + (prefixOutput.bump, + emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray), + AVal.slotA prefixOutput.depth) = (output, emit, av) ∧ + prefixState = finalState := by + simpa using hafterPrefix + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + have hprefixProgress := hargs hsourceBound hprefixSource hprefixRun + hextends havailable + have hbuilt := hbuild hprefixProgress hprefixApply hprefixLength + have hsourceLe : sourceValues.length ≤ count := by + simpa [← hsourceArgs.lengths] using hle + rw [List.drop_eq_nil_of_le hsourceLe] at htailApply + cases htailApply + simpa [hterminalWorld hle] using hbuilt + · have hover : count < args.length := Nat.lt_of_not_ge hle + rw [if_neg hle] at hafterPrefix + have hprefixExtends : ExtraExtends prefixState ambient := + (applyRest_extraExtends hafterPrefix).trans hextends + have hprefixProgress := hargs hsourceBound hprefixSource hprefixRun + hprefixExtends havailable + have hbuilt := hbuild hprefixProgress hprefixApply hprefixLength + have hbuiltShared : LowerResultValueProgress funRel recSelfRel ctx cur + input prefixOutput.bump sourceEnv sourceEnv sourceBuilt .shared + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) := by + simpa [hoverWorld hover] using hbuilt + have htailNonempty : sourceValues.drop count ≠ [] := by + intro hnil + have hzero : sourceValues.length - count = 0 := by + simpa using congrArg List.length hnil + have hlengths := hsourceArgs.lengths + omega + exact hrest hsourceBound (by simp) (hsourceArgs.drop count) + htailApply htailNonempty hbuiltShared hafterPrefix hextends + (havailable.lowerArgs hprefixRun).bump + +/-- Direct-call specialization of progressing `knownCall`. -/ +theorem knownCall_call_run_value_progress_safely_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur d : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {argWorlds : List Owned} {resultWorld : Owned} {f : Ixon.Address} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueProgressesSafelyWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesSafelyWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hworlds : argWorlds.length = count) + (hcount : count ≤ args.length) + (hdecl : ctx.decls f = some (.fn d)) + (hprogress : FnValueProgressContract funRel sourceCtx ctx d argWorlds + sourceFunction) + (hownership : FnOwnershipContract ctx d argWorlds) + (hvalue : FnValueContract funRel sourceCtx ctx d argWorlds + sourceFunction) + (hsourceArgs : ProjectionSafeArgs sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hterminalWorld : args.length ≤ count → d.result = resultWorld) + (hoverWorld : count < args.length → d.result = .shared) + (hrun : (knownCall src (fuel + 1) input (.call f ·) count + argWorlds resultWorld args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult resultWorld emit av := by + refine knownCall_run_value_progress_safely_within hargs hrest hsourceArgs + hsource ?_ hterminalWorld hoverWorld hrun hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixProgress + hprefixApply _ + have hshape := knownCall_prefix_worlds_eq args argWorlds count + hworlds hcount + have hprefix : LowerArgsValueProgress funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + argWorlds emitPrefix prefixAVals := by + simpa only [hshape] using hprefixProgress + exact hprefix.call_graph hdecl hprogress hownership hvalue hprefixApply + +/-- Recursive-self `knownCall` specialization using the synthetic input +entry to recover both value correspondence and source-guided termination. -/ +theorem knownCall_callSelf_entry_run_value_progress_safely_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count index : Nat} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueProgressesSafelyWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesSafelyWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hcount : count ≤ args.length) + (hentry : input.entries[index]? = some (.recSelf count)) + (hhead : sourceEnv[index]? = some sourceFunction) + (hprogress : recSelfRel sourceFunction count → + FnValueProgressContract funRel sourceCtx ctx cur + (List.replicate count .shared) sourceFunction) + (hownership : FnOwnershipContract ctx cur + (List.replicate count .shared)) + (hvalue : recSelfRel sourceFunction count → + FnValueContract funRel sourceCtx ctx cur + (List.replicate count .shared) sourceFunction) + (hresult : cur.result = .shared) + (hsourceArgs : ProjectionSafeArgs sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hrun : (knownCall src (fuel + 1) input (.callSelf ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult .shared emit av := by + refine knownCall_run_value_progress_safely_within hargs hrest hsourceArgs + hsource ?_ (fun _ => by simpa [hresult]) + (fun _ => by simpa [hresult]) hrun hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixProgress + hprefixApply _ + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hprefix : LowerArgsValueProgress funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate count .shared) emitPrefix prefixAVals := by + simpa only [hshape] using hprefixProgress + have hbuilt := hprefix.callSelf_entry_graph hentry hhead hprogress + hownership hvalue hprefixApply + simpa [hresult] using hbuilt + +/-- Recursive-self `knownCall` specialization discharged directly by the +whole current-function progress package. -/ +theorem knownCall_callSelf_current_run_value_progress_safely_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count index : Nat} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueProgressesSafelyWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesSafelyWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hcount : count ≤ args.length) + (hentry : input.entries[index]? = some (.recSelf count)) + (hhead : sourceEnv[index]? = some sourceFunction) + (hself : CurrentSelfProgressContract funRel recSelfRel sourceCtx ctx cur) + (hsourceArgs : ProjectionSafeArgs sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hrun : (knownCall src (fuel + 1) input (.callSelf ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult .shared emit av := by + refine knownCall_run_value_progress_safely_within + (build := .callSelf) (count := count) + (argWorlds := List.replicate count .shared) + (resultWorld := .shared) (buildWorld := .shared) + hargs hrest hsourceArgs hsource ?_ (fun _ => rfl) + (fun _ => rfl) hrun hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixProgress + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count .shared) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsValueProgress funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate count .shared) emitPrefix prefixAVals := by + simpa only [hshape] using hprefixProgress + have hbuilt := hprefix.callSelf_current_graph hentry hhead hself + hprefixApply havsLength + simpa [hself.result] using hbuilt + +/-- Constructor-allocation specialization of progressing `knownCall`. -/ +theorem knownCall_alloc_run_value_progress_safely_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {world : Owned} {cid : CtorId} + {sourceAddress : Ixon.Address} {sourceTag : Nat} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueProgressesSafelyWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesSafelyWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hcount : count ≤ args.length) + (haddress : cid.block = sourceAddress) + (htag : cid.cidx = sourceTag) + (hsourceArgs : ProjectionSafeArgs sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hctor : SourceApplies sourceCtx sourceFunction + (sourceValues.take count) + (.ctor sourceAddress sourceTag (sourceValues.take count))) + (hrun : (knownCall src (fuel + 1) input (.alloc world cid ·) count + (List.replicate count world) world args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + refine knownCall_run_value_progress_safely_within hargs hrest hsourceArgs + hsource ?_ (fun _ => rfl) ?_ hrun hextends havailable + · intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixProgress + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count world) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count world) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsValueProgress funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length world) + emitPrefix prefixAVals := by + simpa only [hshape, havsLength] using hprefixProgress + have hbuilt := hprefix.alloc_graph haddress htag + rw [hprefixApply.deterministic hctor] + exact hbuilt + · intro hover + exact knownCall_over_run_world_shared hover hrun + +/-- Scalar-extern specialization of progressing `knownCall`. -/ +theorem knownCall_extern_run_value_progress_safely_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {f : Ixon.Address} {input output : VEnv} {resultWorld : Owned} + {args : List IxIR0.Expr} {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueProgressesSafelyWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesSafelyWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hprogress : ExternProgressContract funRel sourceCtx ctx) + (hcontract : ExternValueContract funRel sourceCtx ctx) + (hcount : count ≤ args.length) + (hlookup : sourceCtx.env f = some (.extern count)) + (href : SourceRefValue sourceCtx f sourceFunction) + (hsourceArgs : ProjectionSafeArgs sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hrun : (knownCall src (fuel + 1) input (.extern f ·) count + (List.replicate count .shared) resultWorld args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult resultWorld emit av := by + refine knownCall_run_value_progress_safely_within hargs hrest hsourceArgs + hsource ?_ (fun _ => rfl) ?_ hrun hextends havailable + · intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixProgress + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count .shared) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsValueProgress funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length .shared) + emitPrefix prefixAVals := by + simpa only [hshape, havsLength] using hprefixProgress + have hvalueCount : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hvalueCount] + exact hprefix.extern_graph hprogress hcontract hlookup href htakeLength + hprefixApply + · intro hover + exact knownCall_over_run_world_shared hover hrun + +/-- Partial-application specialization of progressing `knownCall`. -/ +theorem knownCall_papp_run_value_progress_safely_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {f : Ixon.Address} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueProgressesSafelyWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesSafelyWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hcount : count ≤ args.length) + (hdecl : ctx.decls f = some d) + (hunder : count < declArity d) + (hsourceArgs : ProjectionSafeArgs sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hfun : ∀ {sourceBuilt : IxIR0.Value}, + SourceApplies sourceCtx sourceFunction (sourceValues.take count) + sourceBuilt → + funRel sourceBuilt f (declArity d) (sourceValues.take count)) + (hrun : (knownCall src (fuel + 1) input (.papp f ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult .shared emit av := by + refine knownCall_run_value_progress_safely_within hargs hrest hsourceArgs + hsource ?_ (fun _ => rfl) (fun _ => rfl) hrun hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixProgress + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count .shared) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsValueProgress funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length .shared) + emitPrefix prefixAVals := by + simpa only [hshape, havsLength] using hprefixProgress + apply hprefix.papp_graph hdecl (hfun hprefixApply) + simpa [havsLength] using hunder + +/-- Static source-address pap allocation under the whole-pass function +relation. -/ +theorem knownCall_papp_source_run_value_progress_safely_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + {fuel count : Nat} {f : Ixon.Address} {source : IxIR0.Decl} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hcount : count ≤ args.length) + (hsrc : src f = some source) + (heligible : SourcePapEligible source) + (harity : sourceDeclArity source = declArity d) + (href : SourceRefValue sourceCtx f sourceFunction) + (hdecl : ctx.decls f = some d) + (hunder : count < declArity d) + (hsourceArgs : ProjectionSafeArgs sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hrun : (knownCall src (fuel + 1) input (.papp f ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + .shared emit av := by + apply knownCall_papp_run_value_progress_safely_within hargs hrest hcount hdecl + hunder hsourceArgs hsource + · intro sourceBuilt hprefixApply + apply CompilerFunctionRel.source hsrc heligible harity href hprefixApply + have hcountValues : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hcountValues] + simpa [htakeLength] using hunder + · exact hrun + · exact hextends + · exact havailable + +/-- Memoized constructor-wrapper pap allocation under the whole-pass +function relation. -/ +theorem knownCall_papp_wrapper_run_value_progress_safely_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + {fuel count : Nat} {memo : WrapperMemo} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hcount : count ≤ args.length) + (hmember : memo ∈ ambient.wrappers) + (hsrc : src memo.source = some (.ctor memo.tag memo.arity)) + (href : SourceRefValue sourceCtx memo.source sourceFunction) + (hdecl : ctx.decls memo.wrapper = some d) + (harity : memo.arity = declArity d) + (hunder : count < declArity d) + (hsourceArgs : ProjectionSafeArgs sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hrun : (knownCall src (fuel + 1) input (.papp memo.wrapper ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + .shared emit av := by + apply knownCall_papp_run_value_progress_safely_within hargs hrest hcount hdecl + hunder hsourceArgs hsource + · intro sourceBuilt hprefixApply + rw [← harity] + apply CompilerFunctionRel.wrapper hmember hsrc href hprefixApply + have hcountValues : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hcountValues] + rw [htakeLength] + simpa [harity] using hunder + · exact hrun + · exact hextends + · exact havailable + +/-! Exact-trace `knownCall` specializations. -/ + +theorem knownCall_call_run_value_trace_progress_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur d : FnDef} + {limit sourceLimit : Nat} {src : IxIR0.Env} {ambient : LowSt} + {fuel count : Nat} {argWorlds : List Owned} + {resultWorld : Owned} {f : Ixon.Address} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueTraceProgressesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValueTraceProgressesWithinBelow funRel + recSelfRel sourceCtx ctx cur limit src ambient fuel) + (hsourceBound : sourceLimit < limit) + (hworlds : argWorlds.length = count) + (hcount : count ≤ args.length) + (hdecl : ctx.decls f = some (.fn d)) + (harity : argWorlds.length = d.arity) + (hprogress : FnValueTraceProgressesAt funRel sourceCtx ctx d argWorlds + sourceFunction sourceLimit) + (hownership : FnOwnershipContract ctx d argWorlds) + (hvalue : FnValueContract funRel sourceCtx ctx d argWorlds + sourceFunction) + (hsourceArgs : IxIR0.ProjectionSafe.EvalsBelow sourceCtx sourceLimit + sourceEnv args sourceValues) + (hsource : SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + sourceValues sourceResult) + (hterminalWorld : args.length ≤ count → d.result = resultWorld) + (hoverWorld : count < args.length → d.result = .shared) + (hrun : (knownCall src (fuel + 1) input (.call f ·) count + argWorlds resultWorld args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfTraceProgressAvailableBelow funRel recSelfRel + sourceCtx ctx cur limit input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult resultWorld emit av := by + refine knownCall_run_value_trace_progress_within_below hargs hrest + hsourceBound hsourceArgs hsource ?_ hterminalWorld hoverWorld hrun + hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixProgress + hprefixApply _ + have hshape := knownCall_prefix_worlds_eq args argWorlds count + hworlds hcount + have hprefix : LowerArgsValueProgress funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + argWorlds emitPrefix prefixAVals := by + simpa only [hshape] using hprefixProgress + exact hprefix.call_graph_trace hdecl harity hprogress hownership hvalue + hprefixApply + +theorem knownCall_callSelf_current_run_value_trace_progress_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit sourceLimit : Nat} {src : IxIR0.Env} {ambient : LowSt} + {fuel count index : Nat} {input output : VEnv} + {args : List IxIR0.Expr} {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueTraceProgressesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValueTraceProgressesWithinBelow funRel + recSelfRel sourceCtx ctx cur limit src ambient fuel) + (hsourceBound : sourceLimit < limit) + (hcount : count ≤ args.length) + (hentry : input.entries[index]? = some (.recSelf count)) + (hhead : sourceEnv[index]? = some sourceFunction) + (hself : CurrentSelfTraceProgressContractBelow funRel recSelfRel + sourceCtx ctx cur limit) + (hsourceArgs : IxIR0.ProjectionSafe.EvalsBelow sourceCtx sourceLimit + sourceEnv args sourceValues) + (hsource : SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + sourceValues sourceResult) + (hrun : (knownCall src (fuel + 1) input (.callSelf ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfTraceProgressAvailableBelow funRel recSelfRel + sourceCtx ctx cur limit input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult .shared emit av := by + refine knownCall_run_value_trace_progress_within_below + (build := .callSelf) (count := count) + (argWorlds := List.replicate count .shared) + (resultWorld := .shared) (buildWorld := .shared) + hargs hrest hsourceBound hsourceArgs hsource ?_ (fun _ => rfl) + (fun _ => rfl) hrun hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixProgress + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count .shared) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsValueProgress funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate count .shared) emitPrefix prefixAVals := by + simpa only [hshape] using hprefixProgress + have hbuilt := hprefix.callSelf_current_graph_trace hentry hhead hself + hsourceBound hprefixApply havsLength + simpa [hself.result] using hbuilt + +theorem knownCall_alloc_run_value_trace_progress_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit sourceLimit : Nat} {src : IxIR0.Env} {ambient : LowSt} + {fuel count : Nat} {world : Owned} {cid : CtorId} + {sourceAddress : Ixon.Address} {sourceTag : Nat} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueTraceProgressesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValueTraceProgressesWithinBelow funRel + recSelfRel sourceCtx ctx cur limit src ambient fuel) + (hsourceBound : sourceLimit < limit) + (hcount : count ≤ args.length) + (haddress : cid.block = sourceAddress) + (htag : cid.cidx = sourceTag) + (hsourceArgs : IxIR0.ProjectionSafe.EvalsBelow sourceCtx sourceLimit + sourceEnv args sourceValues) + (hsource : SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + sourceValues sourceResult) + (hctor : SourceApplies sourceCtx sourceFunction + (sourceValues.take count) + (.ctor sourceAddress sourceTag (sourceValues.take count))) + (hrun : (knownCall src (fuel + 1) input (.alloc world cid ·) count + (List.replicate count world) world args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfTraceProgressAvailableBelow funRel recSelfRel + sourceCtx ctx cur limit input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + refine knownCall_run_value_trace_progress_within_below hargs hrest + hsourceBound hsourceArgs hsource ?_ (fun _ => rfl) ?_ hrun hextends + havailable + · intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixProgress + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count world) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count world) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsValueProgress funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length world) + emitPrefix prefixAVals := by + simpa only [hshape, havsLength] using hprefixProgress + have hbuilt := hprefix.alloc_graph haddress htag + rw [hprefixApply.sourceApplies.deterministic hctor] + exact hbuilt + · intro hover + exact knownCall_over_run_world_shared hover hrun + +theorem knownCall_extern_run_value_trace_progress_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit sourceLimit : Nat} {src : IxIR0.Env} {ambient : LowSt} + {fuel count : Nat} {f : Ixon.Address} {input output : VEnv} + {resultWorld : Owned} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueTraceProgressesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValueTraceProgressesWithinBelow funRel + recSelfRel sourceCtx ctx cur limit src ambient fuel) + (hsourceBound : sourceLimit < limit) + (hprogress : ExternTraceProgressContract funRel sourceCtx ctx) + (hcontract : ExternValueContract funRel sourceCtx ctx) + (hcount : count ≤ args.length) + (hlookup : sourceCtx.env f = some (.extern count)) + (href : SourceRefValue sourceCtx f sourceFunction) + (hsourceArgs : IxIR0.ProjectionSafe.EvalsBelow sourceCtx sourceLimit + sourceEnv args sourceValues) + (hsource : SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + sourceValues sourceResult) + (hrun : (knownCall src (fuel + 1) input (.extern f ·) count + (List.replicate count .shared) resultWorld args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfTraceProgressAvailableBelow funRel recSelfRel + sourceCtx ctx cur limit input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult resultWorld emit av := by + refine knownCall_run_value_trace_progress_within_below hargs hrest + hsourceBound hsourceArgs hsource ?_ (fun _ => rfl) ?_ hrun hextends + havailable + · intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixProgress + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count .shared) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsValueProgress funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length .shared) + emitPrefix prefixAVals := by + simpa only [hshape, havsLength] using hprefixProgress + have hvalueCount : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hvalueCount] + exact hprefix.extern_graph_trace hprogress hcontract hlookup href + htakeLength hprefixApply + · intro hover + exact knownCall_over_run_world_shared hover hrun + +theorem knownCall_papp_run_value_trace_progress_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit sourceLimit : Nat} {src : IxIR0.Env} {ambient : LowSt} + {fuel count : Nat} {f : Ixon.Address} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueTraceProgressesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValueTraceProgressesWithinBelow funRel + recSelfRel sourceCtx ctx cur limit src ambient fuel) + (hsourceBound : sourceLimit < limit) + (hcount : count ≤ args.length) + (hdecl : ctx.decls f = some d) + (hunder : count < declArity d) + (hsourceArgs : IxIR0.ProjectionSafe.EvalsBelow sourceCtx sourceLimit + sourceEnv args sourceValues) + (hsource : SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + sourceValues sourceResult) + (hfun : ∀ {sourceBuilt : IxIR0.Value}, + SourceApplies sourceCtx sourceFunction (sourceValues.take count) + sourceBuilt → + funRel sourceBuilt f (declArity d) (sourceValues.take count)) + (hrun : (knownCall src (fuel + 1) input (.papp f ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfTraceProgressAvailableBelow funRel recSelfRel + sourceCtx ctx cur limit input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult .shared emit av := by + refine knownCall_run_value_trace_progress_within_below hargs hrest + hsourceBound hsourceArgs hsource ?_ (fun _ => rfl) (fun _ => rfl) + hrun hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixProgress + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count .shared) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsValueProgress funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length .shared) + emitPrefix prefixAVals := by + simpa only [hshape, havsLength] using hprefixProgress + apply hprefix.papp_graph hdecl (hfun hprefixApply.sourceApplies) + simpa [havsLength] using hunder + +theorem knownCall_papp_source_run_value_trace_progress_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + {limit sourceLimit fuel count : Nat} {f : Ixon.Address} + {source : IxIR0.Decl} {d : Decl} {input output : VEnv} + {args : List IxIR0.Expr} {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hsourceBound : sourceLimit < limit) + (hcount : count ≤ args.length) + (hsrc : src f = some source) + (heligible : SourcePapEligible source) + (harity : sourceDeclArity source = declArity d) + (href : SourceRefValue sourceCtx f sourceFunction) + (hdecl : ctx.decls f = some d) + (hunder : count < declArity d) + (hsourceArgs : IxIR0.ProjectionSafe.EvalsBelow sourceCtx sourceLimit + sourceEnv args sourceValues) + (hsource : SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + sourceValues sourceResult) + (hrun : (knownCall src (fuel + 1) input (.papp f ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfTraceProgressAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + .shared emit av := by + apply knownCall_papp_run_value_trace_progress_within_below hargs hrest + hsourceBound hcount hdecl hunder hsourceArgs hsource + · intro sourceBuilt hprefixApply + apply CompilerFunctionRel.source hsrc heligible harity href hprefixApply + have hcountValues : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hcountValues] + simpa [htakeLength] using hunder + · exact hrun + · exact hextends + · exact havailable + +theorem knownCall_papp_wrapper_run_value_trace_progress_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + {limit sourceLimit fuel count : Nat} {memo : WrapperMemo} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hsourceBound : sourceLimit < limit) + (hcount : count ≤ args.length) + (hmember : memo ∈ ambient.wrappers) + (hsrc : src memo.source = some (.ctor memo.tag memo.arity)) + (href : SourceRefValue sourceCtx memo.source sourceFunction) + (hdecl : ctx.decls memo.wrapper = some d) + (harity : memo.arity = declArity d) + (hunder : count < declArity d) + (hsourceArgs : IxIR0.ProjectionSafe.EvalsBelow sourceCtx sourceLimit + sourceEnv args sourceValues) + (hsource : SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + sourceValues sourceResult) + (hrun : (knownCall src (fuel + 1) input (.papp memo.wrapper ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfTraceProgressAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + .shared emit av := by + apply knownCall_papp_run_value_trace_progress_within_below hargs hrest + hsourceBound hcount hdecl hunder hsourceArgs hsource + · intro sourceBuilt hprefixApply + rw [← harity] + apply CompilerFunctionRel.wrapper hmember hsrc href hprefixApply + have hcountValues : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hcountValues] + rw [htakeLength] + simpa [harity] using hunder + · exact hrun + · exact hextends + · exact havailable + +/-- Saturated/over-applied definition-reference spine progress. -/ +theorem lowerSpine_ref_defn_call_run_value_progress_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + (hvalues : SourceDeclValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : SourceDeclProgressContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {input output : VEnv} {world result : Owned} {f : Ixon.Address} + {body : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsrc : src f = some (.defn result body)) + (hcount : lamArity body ≤ args.length) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + obtain ⟨d, hdecl, harity, hresult, hownership⟩ := hdecls.defn hsrc + have hvalue : FnValueContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + ((lamUses body).map worldOfUses) sourceFunction := by + apply hvalues.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + have hcallee : FnValueProgressContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + ((lamUses body).map worldOfUses) sourceFunction := by + apply hprogress.fnContract hsrc (by rfl) hdecl href + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_neg (Nat.not_lt.mpr hcount)] at hrun + obtain ⟨checked, nextState, hrequireRun, hknownRun⟩ := + trackedBindRun_ok_inv hrun + cases checked + obtain ⟨hguard, _⟩ := requireResultWorld_run_ok_inv hrequireRun + refine knownCall_call_run_value_progress_within hargs hrest (by simp) + hcount hdecl hcallee hownership hvalue hsourceArgs hsourceApply ?_ ?_ + hknownRun hextends havailable + · intro hterminal + have heq : args.length = lamArity body := + Nat.le_antisymm hterminal hcount + simpa [hresult, heq] using hguard + · intro hover + have hne : args.length ≠ lamArity body := Nat.ne_of_gt hover + simpa [hresult, hne] using hguard + +/-- Under-applied definition references progress by allocating a pap after +the compiler's existing world and pap-safety guards succeed. -/ +theorem lowerSpine_ref_defn_partial_run_value_progress_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world result : Owned} {f : Ixon.Address} + {body : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsrc : src f = some (.defn result body)) + (hunder : args.length < lamArity body) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + obtain ⟨d, hdecl, harity, _, _⟩ := hdecls.defn hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (trackedThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + cases result with + | unique => + exact (trackedThrowRun_not_ok + (by simpa [hsuEq, huuEq] using hrun)).elim + | shared => + cases hp : papSafe body with + | false => + exact (trackedThrowRun_not_ok + (by simpa [hsuEq, hp] using hrun)).elim + | true => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq, hp] using hrun + apply knownCall_papp_source_run_value_progress_within hargs hrest + (Nat.le_refl _) hsrc ⟨rfl, hp⟩ + (by simpa [sourceDeclArity, declArity] using harity.symm) + href hdecl (by simpa [declArity, harity] using hunder) + hsourceArgs hsourceApply hknown hextends havailable + +/-- Saturated/over-applied recursor-reference spine progress. -/ +theorem lowerSpine_ref_recursor_call_run_value_progress_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + (hvalues : SourceDeclValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : SourceDeclProgressContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {numArgs : Nat} {natLit : Bool} {rules : Array IxIR0.RecRule} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.recursor numArgs natLit rules)) + (hcount : numArgs + 1 ≤ args.length) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + obtain ⟨d, hdecl, harity, hresult, hownership⟩ := + hdecls.recursor hsrc + have hvalue : FnValueContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + (List.replicate (numArgs + 1) .shared) sourceFunction := by + apply hvalues.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + have hcallee : FnValueProgressContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + (List.replicate (numArgs + 1) .shared) sourceFunction := by + apply hprogress.fnContract hsrc (by rfl) hdecl href + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_neg (Nat.not_lt.mpr hcount)] at hrun + obtain ⟨checked, nextState, hrequireRun, hknownRun⟩ := + trackedBindRun_ok_inv hrun + cases checked + obtain ⟨hguard, _⟩ := requireResultWorld_run_ok_inv hrequireRun + refine knownCall_call_run_value_progress_within hargs hrest (by simp) + hcount hdecl hcallee hownership hvalue hsourceArgs hsourceApply ?_ ?_ + hknownRun hextends havailable + · intro hterminal + have heq : args.length = numArgs + 1 := + Nat.le_antisymm hterminal hcount + simpa [hresult, heq] using hguard + · intro _ + simpa [hresult] using hguard + +/-- Under-applied recursor references progress by allocating a pap. -/ +theorem lowerSpine_ref_recursor_partial_run_value_progress_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {numArgs : Nat} {natLit : Bool} {rules : Array IxIR0.RecRule} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.recursor numArgs natLit rules)) + (hunder : args.length < numArgs + 1) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + obtain ⟨d, hdecl, harity, _, _⟩ := hdecls.recursor hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (trackedThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + apply knownCall_papp_source_run_value_progress_within hargs hrest + (Nat.le_refl _) hsrc (by simp [SourcePapEligible]) + (by simpa [sourceDeclArity, declArity] using harity.symm) + href hdecl (by simpa [declArity, harity] using hunder) + hsourceArgs hsourceApply hknown hextends havailable + +/-- Saturated/over-applied constructor references progress by allocating the +constructor node and then applying any remaining arguments. -/ +theorem lowerSpine_ref_ctor_alloc_run_value_progress_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {tag arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hlookup : sourceCtx.env f = some (.ctor tag arity)) + (hsrc : src f = some (.ctor tag arity)) + (hcount : arity ≤ args.length) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + have hvalueCount : arity ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take arity).length = arity := by + simp [List.length_take, hvalueCount] + have hctor : SourceApplies sourceCtx sourceFunction + (sourceValues.take arity) + (.ctor f tag (sourceValues.take arity)) := + sourceCtorRef_saturates hlookup href htakeLength + have hknown : + (knownCall src (fuel + 1) input + (.alloc world (ctorIdOf f tag) ·) arity + (List.replicate arity world) world args).run state = + .ok (output, emit, av) finalState := by + simpa [lowerSpine, hsrc, Nat.not_lt.mpr hcount] using hrun + exact knownCall_alloc_run_value_progress_within hargs hrest hcount rfl rfl + hsourceArgs hsourceApply hctor hknown hextends havailable + +/-- Under-applied constructor references progress through wrapper synthesis +and partial-application allocation. -/ +theorem lowerSpine_ref_ctor_partial_run_value_progress_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (hargs : LowerArgsValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {tag arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} + (hsrc : src f = some (.ctor tag arity)) + (hunder : args.length < arity) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (trackedThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hrun' : + ((wrapperFor f tag arity) >>= fun wrapper => + knownCall src (fuel + 1) input (.papp wrapper ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + obtain ⟨wrapper, wrapperState, hwrapperRun, hknownRun⟩ := + trackedBindRun_ok_inv hrun' + let memo : WrapperMemo := ⟨f, tag, arity, wrapper⟩ + have hmemoFinal : memo ∈ finalState.wrappers := + (hknownExtra input (.papp wrapper ·) args.length + (List.replicate args.length .shared) .shared args + hknownRun).wrapper_mem (wrapperFor_memo_mem hwrapperRun) + have hmemo : memo ∈ ambient.wrappers := + hextends.wrapper_mem hmemoFinal + have hdecl := hrepresented.wrapper hmemo + apply knownCall_papp_wrapper_run_value_progress_within hargs hrest + (Nat.le_refl _) hmemo hsrc href hdecl + (by simp [memo, ctorWrapperDecl, declArity]) + (by simpa [memo, ctorWrapperDecl, declArity] using hunder) + hsourceArgs hsourceApply hknownRun hextends havailable + +/-- Saturated/over-applied extern references progress when the target oracle +is defined on every source-guided argument tuple. -/ +theorem lowerSpine_ref_extern_call_run_value_progress_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hprogress : ExternProgressContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx) + (hcontract : ExternValueContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hlookup : sourceCtx.env f = some (.extern arity)) + (hsrc : src f = some (.extern arity)) + (hcount : arity ≤ args.length) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + have hknown : + (knownCall src (fuel + 1) input (.extern f ·) arity + (List.replicate arity .shared) world args).run state = + .ok (output, emit, av) finalState := by + simpa [lowerSpine, hsrc, Nat.not_lt.mpr hcount] using hrun + exact knownCall_extern_run_value_progress_within hargs hrest hprogress + hcontract hcount hlookup href hsourceArgs hsourceApply hknown hextends + havailable + +/-- Under-applied extern references progress by allocating a pap. -/ +theorem lowerSpine_ref_extern_partial_run_value_progress_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsrc : src f = some (.extern arity)) + (hunder : args.length < arity) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + have hdecl := hdecls.extern hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (trackedThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + apply knownCall_papp_source_run_value_progress_within hargs hrest + (Nat.le_refl _) hsrc (by simp [SourcePapEligible]) (by rfl) href hdecl + (by simpa [declArity] using hunder) + hsourceArgs hsourceApply hknown hextends havailable + +/-- Complete source-guided progress for static-reference spines. -/ +theorem lowerSpine_ref_run_value_progress_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hargs : LowerArgsValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + cases hsrc : src f with + | none => + exact (trackedThrowRun_not_ok + (by simpa [lowerSpine, hsrc] using hrun)).elim + | some source => + cases source with + | defn result body => + by_cases hunder : args.length < lamArity body + · exact lowerSpine_ref_defn_partial_run_value_progress_within + hargs hrest hcontracts.decls hsrc hunder hsource hrun hextends + havailable + · exact lowerSpine_ref_defn_call_run_value_progress_within + hargs hrest hcontracts.decls hvalues.decls hprogress.decls hsrc + (Nat.le_of_not_gt hunder) hsource hrun hextends havailable + | ctor tag arity => + have hlookup : sourceCtx.env f = some (.ctor tag arity) := by + rw [henv] + exact hsrc + by_cases hunder : args.length < arity + · exact lowerSpine_ref_ctor_partial_run_value_progress_within + hargs hrest hknownExtra hsrc hunder hsource hrun hextends + hrepresented havailable + · exact lowerSpine_ref_ctor_alloc_run_value_progress_within + hargs hrest hlookup hsrc (Nat.le_of_not_gt hunder) hsource hrun + hextends havailable + | recursor numArgs natLit rules => + by_cases hunder : args.length < numArgs + 1 + · exact lowerSpine_ref_recursor_partial_run_value_progress_within + hargs hrest hcontracts.decls hsrc hunder hsource hrun hextends + havailable + · exact lowerSpine_ref_recursor_call_run_value_progress_within + hargs hrest hcontracts.decls hvalues.decls hprogress.decls hsrc + (Nat.le_of_not_gt hunder) hsource hrun hextends havailable + | extern arity => + have hlookup : sourceCtx.env f = some (.extern arity) := by + rw [henv] + exact hsrc + by_cases hunder : args.length < arity + · exact lowerSpine_ref_extern_partial_run_value_progress_within + hargs hrest hcontracts.decls hsrc hunder hsource hrun hextends + havailable + · exact lowerSpine_ref_extern_call_run_value_progress_within + hargs hrest hprogress.extern hvalues.extern hlookup hsrc + (Nat.le_of_not_gt hunder) hsource hrun hextends havailable + +/-- Saturated/over-applied definition-reference spine progress. -/ +theorem lowerSpine_ref_defn_call_run_value_progress_safely_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + (hvalues : SourceDeclValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : SourceDeclProgressContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {input output : VEnv} {world result : Owned} {f : Ixon.Address} + {body : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsrc : src f = some (.defn result body)) + (hcount : lamArity body ≤ args.length) + (hsource : ProjectionSafeSpine sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + obtain ⟨d, hdecl, harity, hresult, hownership⟩ := hdecls.defn hsrc + have hvalue : FnValueContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + ((lamUses body).map worldOfUses) sourceFunction := by + apply hvalues.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + have hcallee : FnValueProgressContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + ((lamUses body).map worldOfUses) sourceFunction := by + apply hprogress.fnContract hsrc (by rfl) hdecl href + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_neg (Nat.not_lt.mpr hcount)] at hrun + obtain ⟨checked, nextState, hrequireRun, hknownRun⟩ := + trackedBindRun_ok_inv hrun + cases checked + obtain ⟨hguard, _⟩ := requireResultWorld_run_ok_inv hrequireRun + refine knownCall_call_run_value_progress_safely_within hargs hrest (by simp) + hcount hdecl hcallee hownership hvalue hsourceArgs hsourceApply ?_ ?_ + hknownRun hextends havailable + · intro hterminal + have heq : args.length = lamArity body := + Nat.le_antisymm hterminal hcount + simpa [hresult, heq] using hguard + · intro hover + have hne : args.length ≠ lamArity body := Nat.ne_of_gt hover + simpa [hresult, hne] using hguard + +/-- Under-applied definition references progress by allocating a pap after +the compiler's existing world and pap-safety guards succeed. -/ +theorem lowerSpine_ref_defn_partial_run_value_progress_safely_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world result : Owned} {f : Ixon.Address} + {body : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsrc : src f = some (.defn result body)) + (hunder : args.length < lamArity body) + (hsource : ProjectionSafeSpine sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + obtain ⟨d, hdecl, harity, _, _⟩ := hdecls.defn hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (trackedThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + cases result with + | unique => + exact (trackedThrowRun_not_ok + (by simpa [hsuEq, huuEq] using hrun)).elim + | shared => + cases hp : papSafe body with + | false => + exact (trackedThrowRun_not_ok + (by simpa [hsuEq, hp] using hrun)).elim + | true => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq, hp] using hrun + apply knownCall_papp_source_run_value_progress_safely_within hargs hrest + (Nat.le_refl _) hsrc ⟨rfl, hp⟩ + (by simpa [sourceDeclArity, declArity] using harity.symm) + href hdecl (by simpa [declArity, harity] using hunder) + hsourceArgs hsourceApply hknown hextends havailable + +/-- Saturated/over-applied recursor-reference spine progress. -/ +theorem lowerSpine_ref_recursor_call_run_value_progress_safely_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + (hvalues : SourceDeclValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : SourceDeclProgressContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {numArgs : Nat} {natLit : Bool} {rules : Array IxIR0.RecRule} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.recursor numArgs natLit rules)) + (hcount : numArgs + 1 ≤ args.length) + (hsource : ProjectionSafeSpine sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + obtain ⟨d, hdecl, harity, hresult, hownership⟩ := + hdecls.recursor hsrc + have hvalue : FnValueContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + (List.replicate (numArgs + 1) .shared) sourceFunction := by + apply hvalues.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + have hcallee : FnValueProgressContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + (List.replicate (numArgs + 1) .shared) sourceFunction := by + apply hprogress.fnContract hsrc (by rfl) hdecl href + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_neg (Nat.not_lt.mpr hcount)] at hrun + obtain ⟨checked, nextState, hrequireRun, hknownRun⟩ := + trackedBindRun_ok_inv hrun + cases checked + obtain ⟨hguard, _⟩ := requireResultWorld_run_ok_inv hrequireRun + refine knownCall_call_run_value_progress_safely_within hargs hrest (by simp) + hcount hdecl hcallee hownership hvalue hsourceArgs hsourceApply ?_ ?_ + hknownRun hextends havailable + · intro hterminal + have heq : args.length = numArgs + 1 := + Nat.le_antisymm hterminal hcount + simpa [hresult, heq] using hguard + · intro _ + simpa [hresult] using hguard + +/-- Under-applied recursor references progress by allocating a pap. -/ +theorem lowerSpine_ref_recursor_partial_run_value_progress_safely_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {numArgs : Nat} {natLit : Bool} {rules : Array IxIR0.RecRule} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.recursor numArgs natLit rules)) + (hunder : args.length < numArgs + 1) + (hsource : ProjectionSafeSpine sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + obtain ⟨d, hdecl, harity, _, _⟩ := hdecls.recursor hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (trackedThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + apply knownCall_papp_source_run_value_progress_safely_within hargs hrest + (Nat.le_refl _) hsrc (by simp [SourcePapEligible]) + (by simpa [sourceDeclArity, declArity] using harity.symm) + href hdecl (by simpa [declArity, harity] using hunder) + hsourceArgs hsourceApply hknown hextends havailable + +/-- Saturated/over-applied constructor references progress by allocating the +constructor node and then applying any remaining arguments. -/ +theorem lowerSpine_ref_ctor_alloc_run_value_progress_safely_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {tag arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hlookup : sourceCtx.env f = some (.ctor tag arity)) + (hsrc : src f = some (.ctor tag arity)) + (hcount : arity ≤ args.length) + (hsource : ProjectionSafeSpine sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + have hvalueCount : arity ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take arity).length = arity := by + simp [List.length_take, hvalueCount] + have hctor : SourceApplies sourceCtx sourceFunction + (sourceValues.take arity) + (.ctor f tag (sourceValues.take arity)) := + sourceCtorRef_saturates hlookup href htakeLength + have hknown : + (knownCall src (fuel + 1) input + (.alloc world (ctorIdOf f tag) ·) arity + (List.replicate arity world) world args).run state = + .ok (output, emit, av) finalState := by + simpa [lowerSpine, hsrc, Nat.not_lt.mpr hcount] using hrun + exact knownCall_alloc_run_value_progress_safely_within hargs hrest hcount rfl rfl + hsourceArgs hsourceApply hctor hknown hextends havailable + +/-- Under-applied constructor references progress through wrapper synthesis +and partial-application allocation. -/ +theorem lowerSpine_ref_ctor_partial_run_value_progress_safely_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (hargs : LowerArgsValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {tag arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} + (hsrc : src f = some (.ctor tag arity)) + (hunder : args.length < arity) + (hsource : ProjectionSafeSpine sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (trackedThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hrun' : + ((wrapperFor f tag arity) >>= fun wrapper => + knownCall src (fuel + 1) input (.papp wrapper ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + obtain ⟨wrapper, wrapperState, hwrapperRun, hknownRun⟩ := + trackedBindRun_ok_inv hrun' + let memo : WrapperMemo := ⟨f, tag, arity, wrapper⟩ + have hmemoFinal : memo ∈ finalState.wrappers := + (hknownExtra input (.papp wrapper ·) args.length + (List.replicate args.length .shared) .shared args + hknownRun).wrapper_mem (wrapperFor_memo_mem hwrapperRun) + have hmemo : memo ∈ ambient.wrappers := + hextends.wrapper_mem hmemoFinal + have hdecl := hrepresented.wrapper hmemo + apply knownCall_papp_wrapper_run_value_progress_safely_within hargs hrest + (Nat.le_refl _) hmemo hsrc href hdecl + (by simp [memo, ctorWrapperDecl, declArity]) + (by simpa [memo, ctorWrapperDecl, declArity] using hunder) + hsourceArgs hsourceApply hknownRun hextends havailable + +/-- Saturated/over-applied extern references progress when the target oracle +is defined on every source-guided argument tuple. -/ +theorem lowerSpine_ref_extern_call_run_value_progress_safely_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hprogress : ExternProgressContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx) + (hcontract : ExternValueContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hlookup : sourceCtx.env f = some (.extern arity)) + (hsrc : src f = some (.extern arity)) + (hcount : arity ≤ args.length) + (hsource : ProjectionSafeSpine sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + have hknown : + (knownCall src (fuel + 1) input (.extern f ·) arity + (List.replicate arity .shared) world args).run state = + .ok (output, emit, av) finalState := by + simpa [lowerSpine, hsrc, Nat.not_lt.mpr hcount] using hrun + exact knownCall_extern_run_value_progress_safely_within hargs hrest hprogress + hcontract hcount hlookup href hsourceArgs hsourceApply hknown hextends + havailable + +/-- Under-applied extern references progress by allocating a pap. -/ +theorem lowerSpine_ref_extern_partial_run_value_progress_safely_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsrc : src f = some (.extern arity)) + (hunder : args.length < arity) + (hsource : ProjectionSafeSpine sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + have hdecl := hdecls.extern hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (trackedThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + apply knownCall_papp_source_run_value_progress_safely_within hargs hrest + (Nat.le_refl _) hsrc (by simp [SourcePapEligible]) (by rfl) href hdecl + (by simpa [declArity] using hunder) + hsourceArgs hsourceApply hknown hextends havailable + +/-- Complete source-guided progress for static-reference spines. -/ +theorem lowerSpine_ref_run_value_progress_safely_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hargs : LowerArgsValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + (hsource : ProjectionSafeSpine sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + cases hsrc : src f with + | none => + exact (trackedThrowRun_not_ok + (by simpa [lowerSpine, hsrc] using hrun)).elim + | some source => + cases source with + | defn result body => + by_cases hunder : args.length < lamArity body + · exact lowerSpine_ref_defn_partial_run_value_progress_safely_within + hargs hrest hcontracts.decls hsrc hunder hsource hrun hextends + havailable + · exact lowerSpine_ref_defn_call_run_value_progress_safely_within + hargs hrest hcontracts.decls hvalues.decls hprogress.decls hsrc + (Nat.le_of_not_gt hunder) hsource hrun hextends havailable + | ctor tag arity => + have hlookup : sourceCtx.env f = some (.ctor tag arity) := by + rw [henv] + exact hsrc + by_cases hunder : args.length < arity + · exact lowerSpine_ref_ctor_partial_run_value_progress_safely_within + hargs hrest hknownExtra hsrc hunder hsource hrun hextends + hrepresented havailable + · exact lowerSpine_ref_ctor_alloc_run_value_progress_safely_within + hargs hrest hlookup hsrc (Nat.le_of_not_gt hunder) hsource hrun + hextends havailable + | recursor numArgs natLit rules => + by_cases hunder : args.length < numArgs + 1 + · exact lowerSpine_ref_recursor_partial_run_value_progress_safely_within + hargs hrest hcontracts.decls hsrc hunder hsource hrun hextends + havailable + · exact lowerSpine_ref_recursor_call_run_value_progress_safely_within + hargs hrest hcontracts.decls hvalues.decls hprogress.decls hsrc + (Nat.le_of_not_gt hunder) hsource hrun hextends havailable + | extern arity => + have hlookup : sourceCtx.env f = some (.extern arity) := by + rw [henv] + exact hsrc + by_cases hunder : args.length < arity + · exact lowerSpine_ref_extern_partial_run_value_progress_safely_within + hargs hrest hcontracts.decls hsrc hunder hsource hrun hextends + havailable + · exact lowerSpine_ref_extern_call_run_value_progress_safely_within + hargs hrest hprogress.extern hvalues.extern hlookup hsrc + (Nat.le_of_not_gt hunder) hsource hrun hextends havailable + +/-! Exact-trace static-reference spine progress. -/ + +/-- Saturated/over-applied definition references preserve the exact source +trace used to justify the target call. -/ +theorem lowerSpine_ref_defn_call_run_value_trace_progress_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + {limit sourceLimit fuel : Nat} + (hargs : LowerArgsValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + (hvalues : SourceDeclValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : SourceDeclTraceProgressContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + {input output : VEnv} {world result : Owned} {f : Ixon.Address} + {body : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsourceBound : sourceLimit < limit) + (hsrc : src f = some (.defn result body)) + (hcount : lamArity body ≤ args.length) + (hsource : IxIR0.ProjectionSafe.Spine sourceCtx sourceLimit sourceEnv + (.ref f) args sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfTraceProgressAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hrefTrace, hsourceArgs, + hsourceApply⟩ := callAwareProjectionSafeSpine_refData hsource + obtain ⟨d, hdecl, harity, hresult, hownership⟩ := hdecls.defn hsrc + have hvalue : FnValueContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + ((lamUses body).map worldOfUses) sourceFunction := by + apply hvalues.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + have hcallee : FnValueTraceProgressesAt + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + ((lamUses body).map worldOfUses) sourceFunction sourceLimit := by + exact hprogress.fn_progresses hsourceBound hsrc (by rfl) hdecl hrefTrace + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_neg (Nat.not_lt.mpr hcount)] at hrun + obtain ⟨checked, nextState, hrequireRun, hknownRun⟩ := + trackedBindRun_ok_inv hrun + cases checked + obtain ⟨hguard, _⟩ := requireResultWorld_run_ok_inv hrequireRun + refine knownCall_call_run_value_trace_progress_within_below hargs hrest + hsourceBound (by simp) hcount hdecl (by simpa using harity.symm) + hcallee hownership hvalue hsourceArgs hsourceApply ?_ ?_ hknownRun + hextends havailable + · intro hterminal + have heq : args.length = lamArity body := + Nat.le_antisymm hterminal hcount + simpa [hresult, heq] using hguard + · intro hover + have hne : args.length ≠ lamArity body := Nat.ne_of_gt hover + simpa [hresult, hne] using hguard + +/-- Under-applied definition references allocate a pap without forgetting the +source trace that will justify any remaining application. -/ +theorem lowerSpine_ref_defn_partial_run_value_trace_progress_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + {limit sourceLimit fuel : Nat} + (hargs : LowerArgsValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world result : Owned} {f : Ixon.Address} + {body : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsourceBound : sourceLimit < limit) + (hsrc : src f = some (.defn result body)) + (hunder : args.length < lamArity body) + (hsource : IxIR0.ProjectionSafe.Spine sourceCtx sourceLimit sourceEnv + (.ref f) args sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfTraceProgressAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, _, hsourceArgs, + hsourceApply⟩ := callAwareProjectionSafeSpine_refData hsource + obtain ⟨d, hdecl, harity, _, _⟩ := hdecls.defn hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (trackedThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + cases result with + | unique => + exact (trackedThrowRun_not_ok + (by simpa [hsuEq, huuEq] using hrun)).elim + | shared => + cases hp : papSafe body with + | false => + exact (trackedThrowRun_not_ok + (by simpa [hsuEq, hp] using hrun)).elim + | true => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq, hp] using hrun + apply knownCall_papp_source_run_value_trace_progress_within_below + hargs hrest hsourceBound (Nat.le_refl _) hsrc ⟨rfl, hp⟩ + (by simpa [sourceDeclArity, declArity] using harity.symm) + href hdecl (by simpa [declArity, harity] using hunder) + hsourceArgs hsourceApply hknown hextends havailable + +/-- Saturated/over-applied recursor references preserve the exact source call +trace at the declaration boundary. -/ +theorem lowerSpine_ref_recursor_call_run_value_trace_progress_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + {limit sourceLimit fuel : Nat} + (hargs : LowerArgsValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + (hvalues : SourceDeclValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : SourceDeclTraceProgressContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {numArgs : Nat} {natLit : Bool} {rules : Array IxIR0.RecRule} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsourceBound : sourceLimit < limit) + (hsrc : src f = some (.recursor numArgs natLit rules)) + (hcount : numArgs + 1 ≤ args.length) + (hsource : IxIR0.ProjectionSafe.Spine sourceCtx sourceLimit sourceEnv + (.ref f) args sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfTraceProgressAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hrefTrace, hsourceArgs, + hsourceApply⟩ := callAwareProjectionSafeSpine_refData hsource + obtain ⟨d, hdecl, harity, hresult, hownership⟩ := + hdecls.recursor hsrc + have hvalue : FnValueContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + (List.replicate (numArgs + 1) .shared) sourceFunction := by + apply hvalues.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + have hcallee : FnValueTraceProgressesAt + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + (List.replicate (numArgs + 1) .shared) sourceFunction sourceLimit := by + exact hprogress.fn_progresses hsourceBound hsrc (by rfl) hdecl hrefTrace + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_neg (Nat.not_lt.mpr hcount)] at hrun + obtain ⟨checked, nextState, hrequireRun, hknownRun⟩ := + trackedBindRun_ok_inv hrun + cases checked + obtain ⟨hguard, _⟩ := requireResultWorld_run_ok_inv hrequireRun + refine knownCall_call_run_value_trace_progress_within_below hargs hrest + hsourceBound (by simp) hcount hdecl (by simpa using harity.symm) + hcallee hownership hvalue hsourceArgs hsourceApply ?_ ?_ hknownRun + hextends havailable + · intro hterminal + have heq : args.length = numArgs + 1 := + Nat.le_antisymm hterminal hcount + simpa [hresult, heq] using hguard + · intro _ + simpa [hresult] using hguard + +/-- Under-applied recursor references preserve their exact source trace while +allocating a pap. -/ +theorem lowerSpine_ref_recursor_partial_run_value_trace_progress_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + {limit sourceLimit fuel : Nat} + (hargs : LowerArgsValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {numArgs : Nat} {natLit : Bool} {rules : Array IxIR0.RecRule} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsourceBound : sourceLimit < limit) + (hsrc : src f = some (.recursor numArgs natLit rules)) + (hunder : args.length < numArgs + 1) + (hsource : IxIR0.ProjectionSafe.Spine sourceCtx sourceLimit sourceEnv + (.ref f) args sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfTraceProgressAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, _, hsourceArgs, + hsourceApply⟩ := callAwareProjectionSafeSpine_refData hsource + obtain ⟨d, hdecl, harity, _, _⟩ := hdecls.recursor hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (trackedThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + apply knownCall_papp_source_run_value_trace_progress_within_below + hargs hrest hsourceBound (Nat.le_refl _) hsrc + (by simp [SourcePapEligible]) + (by simpa [sourceDeclArity, declArity] using harity.symm) + href hdecl (by simpa [declArity, harity] using hunder) + hsourceArgs hsourceApply hknown hextends havailable + +/-- Saturated/over-applied constructor references allocate their node while +retaining the exact source application trace. -/ +theorem lowerSpine_ref_ctor_alloc_run_value_trace_progress_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + {limit sourceLimit fuel : Nat} + (hargs : LowerArgsValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {tag arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsourceBound : sourceLimit < limit) + (hlookup : sourceCtx.env f = some (.ctor tag arity)) + (hsrc : src f = some (.ctor tag arity)) + (hcount : arity ≤ args.length) + (hsource : IxIR0.ProjectionSafe.Spine sourceCtx sourceLimit sourceEnv + (.ref f) args sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfTraceProgressAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, _, hsourceArgs, + hsourceApply⟩ := callAwareProjectionSafeSpine_refData hsource + have hvalueCount : arity ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take arity).length = arity := by + simp [List.length_take, hvalueCount] + have hctor : SourceApplies sourceCtx sourceFunction + (sourceValues.take arity) + (.ctor f tag (sourceValues.take arity)) := + sourceCtorRef_saturates hlookup href htakeLength + have hknown : + (knownCall src (fuel + 1) input + (.alloc world (ctorIdOf f tag) ·) arity + (List.replicate arity world) world args).run state = + .ok (output, emit, av) finalState := by + simpa [lowerSpine, hsrc, Nat.not_lt.mpr hcount] using hrun + exact knownCall_alloc_run_value_trace_progress_within_below hargs hrest + hsourceBound hcount rfl rfl hsourceArgs hsourceApply hctor hknown + hextends havailable + +/-- Under-applied constructor references preserve their exact source trace +through wrapper synthesis and pap allocation. -/ +theorem lowerSpine_ref_ctor_partial_run_value_trace_progress_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + {limit sourceLimit fuel : Nat} {state finalState : LowSt} + (hargs : LowerArgsValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {tag arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} + (hsourceBound : sourceLimit < limit) + (hsrc : src f = some (.ctor tag arity)) + (hunder : args.length < arity) + (hsource : IxIR0.ProjectionSafe.Spine sourceCtx sourceLimit sourceEnv + (.ref f) args sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfTraceProgressAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, _, hsourceArgs, + hsourceApply⟩ := callAwareProjectionSafeSpine_refData hsource + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (trackedThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hrun' : + ((wrapperFor f tag arity) >>= fun wrapper => + knownCall src (fuel + 1) input (.papp wrapper ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + obtain ⟨wrapper, wrapperState, hwrapperRun, hknownRun⟩ := + trackedBindRun_ok_inv hrun' + let memo : WrapperMemo := ⟨f, tag, arity, wrapper⟩ + have hmemoFinal : memo ∈ finalState.wrappers := + (hknownExtra input (.papp wrapper ·) args.length + (List.replicate args.length .shared) .shared args + hknownRun).wrapper_mem (wrapperFor_memo_mem hwrapperRun) + have hmemo : memo ∈ ambient.wrappers := + hextends.wrapper_mem hmemoFinal + have hdecl := hrepresented.wrapper hmemo + apply knownCall_papp_wrapper_run_value_trace_progress_within_below + hargs hrest hsourceBound (Nat.le_refl _) hmemo hsrc href hdecl + (by simp [memo, ctorWrapperDecl, declArity]) + (by simpa [memo, ctorWrapperDecl, declArity] using hunder) + hsourceArgs hsourceApply hknownRun hextends havailable + +/-- Saturated/over-applied extern references preserve the exact source trace +used at the scalar-oracle boundary. -/ +theorem lowerSpine_ref_extern_call_run_value_trace_progress_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + {limit sourceLimit fuel : Nat} + (hargs : LowerArgsValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hprogress : ExternTraceProgressContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx) + (hcontract : ExternValueContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsourceBound : sourceLimit < limit) + (hlookup : sourceCtx.env f = some (.extern arity)) + (hsrc : src f = some (.extern arity)) + (hcount : arity ≤ args.length) + (hsource : IxIR0.ProjectionSafe.Spine sourceCtx sourceLimit sourceEnv + (.ref f) args sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfTraceProgressAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, _, hsourceArgs, + hsourceApply⟩ := callAwareProjectionSafeSpine_refData hsource + have hknown : + (knownCall src (fuel + 1) input (.extern f ·) arity + (List.replicate arity .shared) world args).run state = + .ok (output, emit, av) finalState := by + simpa [lowerSpine, hsrc, Nat.not_lt.mpr hcount] using hrun + exact knownCall_extern_run_value_trace_progress_within_below hargs hrest + hsourceBound hprogress hcontract hcount hlookup href hsourceArgs + hsourceApply hknown hextends havailable + +/-- Under-applied extern references preserve their exact source trace while +allocating a pap. -/ +theorem lowerSpine_ref_extern_partial_run_value_trace_progress_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + {limit sourceLimit fuel : Nat} + (hargs : LowerArgsValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsourceBound : sourceLimit < limit) + (hsrc : src f = some (.extern arity)) + (hunder : args.length < arity) + (hsource : IxIR0.ProjectionSafe.Spine sourceCtx sourceLimit sourceEnv + (.ref f) args sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfTraceProgressAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, _, hsourceArgs, + hsourceApply⟩ := callAwareProjectionSafeSpine_refData hsource + have hdecl := hdecls.extern hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (trackedThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + apply knownCall_papp_source_run_value_trace_progress_within_below + hargs hrest hsourceBound (Nat.le_refl _) hsrc + (by simp [SourcePapEligible]) (by rfl) href hdecl + (by simpa [declArity] using hunder) + hsourceArgs hsourceApply hknown hextends havailable + +/-- Complete exact-trace progress for static-reference spines. -/ +theorem lowerSpine_ref_run_value_trace_progress_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + {limit sourceLimit fuel : Nat} {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hargs : LowerArgsValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerTraceProgressContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + (hsourceBound : sourceLimit < limit) + (hsource : IxIR0.ProjectionSafe.Spine sourceCtx sourceLimit sourceEnv + (.ref f) args sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfTraceProgressAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + cases hsrc : src f with + | none => + exact (trackedThrowRun_not_ok + (by simpa [lowerSpine, hsrc] using hrun)).elim + | some source => + cases source with + | defn result body => + by_cases hunder : args.length < lamArity body + · exact + lowerSpine_ref_defn_partial_run_value_trace_progress_within_below + hargs hrest hcontracts.decls hsourceBound hsrc hunder hsource + hrun hextends havailable + · exact lowerSpine_ref_defn_call_run_value_trace_progress_within_below + hargs hrest hcontracts.decls hvalues.decls hprogress.decls + hsourceBound hsrc (Nat.le_of_not_gt hunder) hsource hrun hextends + havailable + | ctor tag arity => + have hlookup : sourceCtx.env f = some (.ctor tag arity) := by + rw [henv] + exact hsrc + by_cases hunder : args.length < arity + · exact + lowerSpine_ref_ctor_partial_run_value_trace_progress_within_below + hargs hrest hknownExtra hsourceBound hsrc hunder hsource hrun + hextends hrepresented havailable + · exact + lowerSpine_ref_ctor_alloc_run_value_trace_progress_within_below + hargs hrest hsourceBound hlookup hsrc (Nat.le_of_not_gt hunder) + hsource hrun hextends havailable + | recursor numArgs natLit rules => + by_cases hunder : args.length < numArgs + 1 + · exact + lowerSpine_ref_recursor_partial_run_value_trace_progress_within_below + hargs hrest hcontracts.decls hsourceBound hsrc hunder hsource + hrun hextends havailable + · exact + lowerSpine_ref_recursor_call_run_value_trace_progress_within_below + hargs hrest hcontracts.decls hvalues.decls hprogress.decls + hsourceBound hsrc (Nat.le_of_not_gt hunder) hsource hrun hextends + havailable + | extern arity => + have hlookup : sourceCtx.env f = some (.extern arity) := by + rw [henv] + exact hsrc + by_cases hunder : args.length < arity + · exact + lowerSpine_ref_extern_partial_run_value_trace_progress_within_below + hargs hrest hcontracts.decls hsourceBound hsrc hunder hsource + hrun hextends havailable + · exact + lowerSpine_ref_extern_call_run_value_trace_progress_within_below + hargs hrest hprogress.extern hvalues.extern hsourceBound hlookup + hsrc (Nat.le_of_not_gt hunder) hsource hrun hextends havailable + +/-- Reachable-state progressing `knownCall`. The prefix argument traversal +and the optional over-application tail retain the same ambient-state +threading as the semantic partial-correctness induction. -/ +theorem knownCall_run_value_settlement_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {build : Array Atom → Op} {argWorlds : List Owned} + {resultWorld buildWorld : Owned} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueSettlesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueSettlesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hbuild : ∀ {prefixOutput : VEnv} {emitPrefix : Emit} + {prefixAVals : List AVal} {sourceBuilt : IxIR0.Value}, + LowerArgsValueSettlement funRel recSelfRel ctx cur input prefixOutput + sourceEnv sourceEnv (sourceValues.take count) + (((args.take count).zip (padWorlds argWorlds count)).map Prod.snd) + emitPrefix prefixAVals → + SourceApplies sourceCtx sourceFunction (sourceValues.take count) + sourceBuilt → + prefixAVals.length = + ((args.take count).zip (padWorlds argWorlds count)).length → + LowerResultValueSettlement funRel recSelfRel ctx cur input + prefixOutput.bump sourceEnv sourceEnv sourceBuilt buildWorld + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth)) + (hterminalWorld : args.length ≤ count → buildWorld = resultWorld) + (hoverWorld : count < args.length → buildWorld = .shared) + (hrun : (knownCall src (fuel + 1) input build count argWorlds + resultWorld args).run state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueSettlement funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult resultWorld emit av := by + simp only [knownCall] at hrun + obtain ⟨prefixResult, prefixState, hprefixRun, hafterPrefix⟩ := + trackedBindRun_ok_inv hrun + rcases prefixResult with ⟨prefixOutput, emitPrefix, prefixAVals⟩ + dsimp only at hafterPrefix + have hprefixLength := lowerArgs_success_length src hprefixRun + have hprefixSource : SourceArgsEval sourceCtx sourceEnv + (((args.take count).zip + (padWorlds argWorlds count)).map Prod.fst) + (sourceValues.take count) := by + rw [knownCall_prefix_exprs_eq] + exact hsourceArgs.take count + obtain ⟨sourceBuilt, hprefixApply, htailApply⟩ := + hsource.splitAt count + by_cases hle : args.length ≤ count + · rw [if_pos hle] at hafterPrefix + have hpure : + (prefixOutput.bump, + emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray), + AVal.slotA prefixOutput.depth) = (output, emit, av) ∧ + prefixState = finalState := by + simpa using hafterPrefix + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + have hprefixProgress := hargs hprefixSource hprefixRun hextends + havailable + have hbuilt := hbuild hprefixProgress hprefixApply hprefixLength + have hsourceLe : sourceValues.length ≤ count := by + simpa [← hsourceArgs.lengths] using hle + rw [List.drop_eq_nil_of_le hsourceLe] at htailApply + cases htailApply + simpa [hterminalWorld hle] using hbuilt + · have hover : count < args.length := Nat.lt_of_not_ge hle + rw [if_neg hle] at hafterPrefix + have hprefixExtends : ExtraExtends prefixState ambient := + (applyRest_extraExtends hafterPrefix).trans hextends + have hprefixProgress := hargs hprefixSource hprefixRun hprefixExtends + havailable + have hbuilt := hbuild hprefixProgress hprefixApply hprefixLength + have hbuiltShared : LowerResultValueSettlement funRel recSelfRel ctx cur + input prefixOutput.bump sourceEnv sourceEnv sourceBuilt .shared + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) := by + simpa [hoverWorld hover] using hbuilt + exact hrest (by simp) (hsourceArgs.drop count) htailApply + hbuiltShared hafterPrefix hextends + (havailable.lowerArgs hprefixRun).bump + +/-- Direct-call specialization of progressing `knownCall`. -/ +theorem knownCall_call_run_value_settlement_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur d : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {argWorlds : List Owned} {resultWorld : Owned} {f : Ixon.Address} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueSettlesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueSettlesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hworlds : argWorlds.length = count) + (hcount : count ≤ args.length) + (hdecl : ctx.decls f = some (.fn d)) + (hprogress : FnValueProgressContract funRel sourceCtx ctx d argWorlds + sourceFunction) + (hownership : FnOwnershipContract ctx d argWorlds) + (hvalue : FnValueContract funRel sourceCtx ctx d argWorlds + sourceFunction) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hterminalWorld : args.length ≤ count → d.result = resultWorld) + (hoverWorld : count < args.length → d.result = .shared) + (hrun : (knownCall src (fuel + 1) input (.call f ·) count + argWorlds resultWorld args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueSettlement funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult resultWorld emit av := by + refine knownCall_run_value_settlement_within hargs hrest hsourceArgs + hsource ?_ hterminalWorld hoverWorld hrun hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixProgress + hprefixApply _ + have hshape := knownCall_prefix_worlds_eq args argWorlds count + hworlds hcount + have hprefix : LowerArgsValueSettlement funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + argWorlds emitPrefix prefixAVals := by + simpa only [hshape] using hprefixProgress + exact hprefix.call_graph hdecl hprogress hownership hvalue hprefixApply + +/-- Recursive-self `knownCall` specialization using the synthetic input +entry to recover both value correspondence and source-guided termination. -/ +theorem knownCall_callSelf_entry_run_value_settlement_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count index : Nat} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueSettlesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueSettlesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hcount : count ≤ args.length) + (hentry : input.entries[index]? = some (.recSelf count)) + (hhead : sourceEnv[index]? = some sourceFunction) + (hprogress : recSelfRel sourceFunction count → + FnValueProgressContract funRel sourceCtx ctx cur + (List.replicate count .shared) sourceFunction) + (hownership : FnOwnershipContract ctx cur + (List.replicate count .shared)) + (hvalue : recSelfRel sourceFunction count → + FnValueContract funRel sourceCtx ctx cur + (List.replicate count .shared) sourceFunction) + (hresult : cur.result = .shared) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hrun : (knownCall src (fuel + 1) input (.callSelf ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueSettlement funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult .shared emit av := by + refine knownCall_run_value_settlement_within hargs hrest hsourceArgs + hsource ?_ (fun _ => by simpa [hresult]) + (fun _ => by simpa [hresult]) hrun hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixProgress + hprefixApply _ + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hprefix : LowerArgsValueSettlement funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate count .shared) emitPrefix prefixAVals := by + simpa only [hshape] using hprefixProgress + have hbuilt := hprefix.callSelf_entry_graph hentry hhead hprogress + hownership hvalue hprefixApply + simpa [hresult] using hbuilt + +/-- Recursive-self `knownCall` specialization discharged directly by the +whole current-function progress package. -/ +theorem knownCall_callSelf_current_run_value_settlement_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count index : Nat} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueSettlesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueSettlesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hcount : count ≤ args.length) + (hentry : input.entries[index]? = some (.recSelf count)) + (hhead : sourceEnv[index]? = some sourceFunction) + (hself : CurrentSelfProgressContract funRel recSelfRel sourceCtx ctx cur) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hrun : (knownCall src (fuel + 1) input (.callSelf ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueSettlement funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult .shared emit av := by + refine knownCall_run_value_settlement_within + (build := .callSelf) (count := count) + (argWorlds := List.replicate count .shared) + (resultWorld := .shared) (buildWorld := .shared) + hargs hrest hsourceArgs hsource ?_ (fun _ => rfl) + (fun _ => rfl) hrun hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixProgress + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count .shared) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsValueSettlement funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate count .shared) emitPrefix prefixAVals := by + simpa only [hshape] using hprefixProgress + have hbuilt := hprefix.callSelf_current_graph hentry hhead hself + hprefixApply havsLength + simpa [hself.result] using hbuilt + +/-- Constructor-allocation specialization of progressing `knownCall`. -/ +theorem knownCall_alloc_run_value_settlement_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {world : Owned} {cid : CtorId} + {sourceAddress : Ixon.Address} {sourceTag : Nat} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueSettlesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueSettlesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hcount : count ≤ args.length) + (haddress : cid.block = sourceAddress) + (htag : cid.cidx = sourceTag) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hctor : SourceApplies sourceCtx sourceFunction + (sourceValues.take count) + (.ctor sourceAddress sourceTag (sourceValues.take count))) + (hrun : (knownCall src (fuel + 1) input (.alloc world cid ·) count + (List.replicate count world) world args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueSettlement funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + refine knownCall_run_value_settlement_within hargs hrest hsourceArgs + hsource ?_ (fun _ => rfl) ?_ hrun hextends havailable + · intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixProgress + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count world) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count world) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsValueSettlement funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length world) + emitPrefix prefixAVals := by + simpa only [hshape, havsLength] using hprefixProgress + have hbuilt := hprefix.alloc_graph haddress htag + rw [hprefixApply.deterministic hctor] + exact hbuilt + · intro hover + exact knownCall_over_run_world_shared hover hrun + +/-- Scalar-extern specialization of progressing `knownCall`. -/ +theorem knownCall_extern_run_value_settlement_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {f : Ixon.Address} {input output : VEnv} {resultWorld : Owned} + {args : List IxIR0.Expr} {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueSettlesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueSettlesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hprogress : ExternProgressContract funRel sourceCtx ctx) + (hcontract : ExternValueContract funRel sourceCtx ctx) + (hcount : count ≤ args.length) + (hlookup : sourceCtx.env f = some (.extern count)) + (href : SourceRefValue sourceCtx f sourceFunction) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hrun : (knownCall src (fuel + 1) input (.extern f ·) count + (List.replicate count .shared) resultWorld args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueSettlement funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult resultWorld emit av := by + refine knownCall_run_value_settlement_within hargs hrest hsourceArgs + hsource ?_ (fun _ => rfl) ?_ hrun hextends havailable + · intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixProgress + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count .shared) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsValueSettlement funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length .shared) + emitPrefix prefixAVals := by + simpa only [hshape, havsLength] using hprefixProgress + have hvalueCount : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hvalueCount] + exact hprefix.extern_graph hprogress hcontract hlookup href htakeLength + hprefixApply + · intro hover + exact knownCall_over_run_world_shared hover hrun + +/-- Partial-application specialization of progressing `knownCall`. -/ +theorem knownCall_papp_run_value_settlement_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {f : Ixon.Address} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueSettlesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueSettlesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hcount : count ≤ args.length) + (hdecl : ctx.decls f = some d) + (hunder : count < declArity d) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hfun : ∀ {sourceBuilt : IxIR0.Value}, + SourceApplies sourceCtx sourceFunction (sourceValues.take count) + sourceBuilt → + funRel sourceBuilt f (declArity d) (sourceValues.take count)) + (hrun : (knownCall src (fuel + 1) input (.papp f ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueSettlement funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult .shared emit av := by + refine knownCall_run_value_settlement_within hargs hrest hsourceArgs + hsource ?_ (fun _ => rfl) (fun _ => rfl) hrun hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixProgress + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count .shared) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsValueSettlement funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length .shared) + emitPrefix prefixAVals := by + simpa only [hshape, havsLength] using hprefixProgress + apply hprefix.papp_graph hdecl (hfun hprefixApply) + simpa [havsLength] using hunder + +/-- Static source-address pap allocation under the whole-pass function +relation. -/ +theorem knownCall_papp_source_run_value_settlement_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + {fuel count : Nat} {f : Ixon.Address} {source : IxIR0.Decl} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hcount : count ≤ args.length) + (hsrc : src f = some source) + (heligible : SourcePapEligible source) + (harity : sourceDeclArity source = declArity d) + (href : SourceRefValue sourceCtx f sourceFunction) + (hdecl : ctx.decls f = some d) + (hunder : count < declArity d) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hrun : (knownCall src (fuel + 1) input (.papp f ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSettlement (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + .shared emit av := by + apply knownCall_papp_run_value_settlement_within hargs hrest hcount hdecl + hunder hsourceArgs hsource + · intro sourceBuilt hprefixApply + apply CompilerFunctionRel.source hsrc heligible harity href hprefixApply + have hcountValues : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hcountValues] + simpa [htakeLength] using hunder + · exact hrun + · exact hextends + · exact havailable + +/-- Memoized constructor-wrapper pap allocation under the whole-pass +function relation. -/ +theorem knownCall_papp_wrapper_run_value_settlement_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + {fuel count : Nat} {memo : WrapperMemo} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hcount : count ≤ args.length) + (hmember : memo ∈ ambient.wrappers) + (hsrc : src memo.source = some (.ctor memo.tag memo.arity)) + (href : SourceRefValue sourceCtx memo.source sourceFunction) + (hdecl : ctx.decls memo.wrapper = some d) + (harity : memo.arity = declArity d) + (hunder : count < declArity d) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hrun : (knownCall src (fuel + 1) input (.papp memo.wrapper ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSettlement (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + .shared emit av := by + apply knownCall_papp_run_value_settlement_within hargs hrest hcount hdecl + hunder hsourceArgs hsource + · intro sourceBuilt hprefixApply + rw [← harity] + apply CompilerFunctionRel.wrapper hmember hsrc href hprefixApply + have hcountValues : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hcountValues] + rw [htakeLength] + simpa [harity] using hunder + · exact hrun + · exact hextends + · exact havailable + +/-- Saturated/over-applied definition-reference spine progress. -/ +theorem lowerSpine_ref_defn_call_run_value_settlement_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + (hvalues : SourceDeclValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : SourceDeclProgressContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {input output : VEnv} {world result : Owned} {f : Ixon.Address} + {body : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsrc : src f = some (.defn result body)) + (hcount : lamArity body ≤ args.length) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSettlement (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + obtain ⟨d, hdecl, harity, hresult, hownership⟩ := hdecls.defn hsrc + have hvalue : FnValueContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + ((lamUses body).map worldOfUses) sourceFunction := by + apply hvalues.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + have hcallee : FnValueProgressContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + ((lamUses body).map worldOfUses) sourceFunction := by + apply hprogress.fnContract hsrc (by rfl) hdecl href + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_neg (Nat.not_lt.mpr hcount)] at hrun + obtain ⟨checked, nextState, hrequireRun, hknownRun⟩ := + trackedBindRun_ok_inv hrun + cases checked + obtain ⟨hguard, _⟩ := requireResultWorld_run_ok_inv hrequireRun + refine knownCall_call_run_value_settlement_within hargs hrest (by simp) + hcount hdecl hcallee hownership hvalue hsourceArgs hsourceApply ?_ ?_ + hknownRun hextends havailable + · intro hterminal + have heq : args.length = lamArity body := + Nat.le_antisymm hterminal hcount + simpa [hresult, heq] using hguard + · intro hover + have hne : args.length ≠ lamArity body := Nat.ne_of_gt hover + simpa [hresult, hne] using hguard + +/-- Under-applied definition references progress by allocating a pap after +the compiler's existing world and pap-safety guards succeed. -/ +theorem lowerSpine_ref_defn_partial_run_value_settlement_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world result : Owned} {f : Ixon.Address} + {body : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsrc : src f = some (.defn result body)) + (hunder : args.length < lamArity body) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSettlement (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + obtain ⟨d, hdecl, harity, _, _⟩ := hdecls.defn hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (trackedThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + cases result with + | unique => + exact (trackedThrowRun_not_ok + (by simpa [hsuEq, huuEq] using hrun)).elim + | shared => + cases hp : papSafe body with + | false => + exact (trackedThrowRun_not_ok + (by simpa [hsuEq, hp] using hrun)).elim + | true => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq, hp] using hrun + apply knownCall_papp_source_run_value_settlement_within hargs hrest + (Nat.le_refl _) hsrc ⟨rfl, hp⟩ + (by simpa [sourceDeclArity, declArity] using harity.symm) + href hdecl (by simpa [declArity, harity] using hunder) + hsourceArgs hsourceApply hknown hextends havailable + +/-- Saturated/over-applied recursor-reference spine progress. -/ +theorem lowerSpine_ref_recursor_call_run_value_settlement_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + (hvalues : SourceDeclValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : SourceDeclProgressContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {numArgs : Nat} {natLit : Bool} {rules : Array IxIR0.RecRule} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.recursor numArgs natLit rules)) + (hcount : numArgs + 1 ≤ args.length) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSettlement (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + obtain ⟨d, hdecl, harity, hresult, hownership⟩ := + hdecls.recursor hsrc + have hvalue : FnValueContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + (List.replicate (numArgs + 1) .shared) sourceFunction := by + apply hvalues.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + have hcallee : FnValueProgressContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + (List.replicate (numArgs + 1) .shared) sourceFunction := by + apply hprogress.fnContract hsrc (by rfl) hdecl href + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_neg (Nat.not_lt.mpr hcount)] at hrun + obtain ⟨checked, nextState, hrequireRun, hknownRun⟩ := + trackedBindRun_ok_inv hrun + cases checked + obtain ⟨hguard, _⟩ := requireResultWorld_run_ok_inv hrequireRun + refine knownCall_call_run_value_settlement_within hargs hrest (by simp) + hcount hdecl hcallee hownership hvalue hsourceArgs hsourceApply ?_ ?_ + hknownRun hextends havailable + · intro hterminal + have heq : args.length = numArgs + 1 := + Nat.le_antisymm hterminal hcount + simpa [hresult, heq] using hguard + · intro _ + simpa [hresult] using hguard + +/-- Under-applied recursor references progress by allocating a pap. -/ +theorem lowerSpine_ref_recursor_partial_run_value_settlement_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {numArgs : Nat} {natLit : Bool} {rules : Array IxIR0.RecRule} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.recursor numArgs natLit rules)) + (hunder : args.length < numArgs + 1) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSettlement (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + obtain ⟨d, hdecl, harity, _, _⟩ := hdecls.recursor hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (trackedThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + apply knownCall_papp_source_run_value_settlement_within hargs hrest + (Nat.le_refl _) hsrc (by simp [SourcePapEligible]) + (by simpa [sourceDeclArity, declArity] using harity.symm) + href hdecl (by simpa [declArity, harity] using hunder) + hsourceArgs hsourceApply hknown hextends havailable + +/-- Saturated/over-applied constructor references progress by allocating the +constructor node and then applying any remaining arguments. -/ +theorem lowerSpine_ref_ctor_alloc_run_value_settlement_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {tag arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hlookup : sourceCtx.env f = some (.ctor tag arity)) + (hsrc : src f = some (.ctor tag arity)) + (hcount : arity ≤ args.length) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSettlement (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + have hvalueCount : arity ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take arity).length = arity := by + simp [List.length_take, hvalueCount] + have hctor : SourceApplies sourceCtx sourceFunction + (sourceValues.take arity) + (.ctor f tag (sourceValues.take arity)) := + sourceCtorRef_saturates hlookup href htakeLength + have hknown : + (knownCall src (fuel + 1) input + (.alloc world (ctorIdOf f tag) ·) arity + (List.replicate arity world) world args).run state = + .ok (output, emit, av) finalState := by + simpa [lowerSpine, hsrc, Nat.not_lt.mpr hcount] using hrun + exact knownCall_alloc_run_value_settlement_within hargs hrest hcount rfl rfl + hsourceArgs hsourceApply hctor hknown hextends havailable + +/-- Under-applied constructor references progress through wrapper synthesis +and partial-application allocation. -/ +theorem lowerSpine_ref_ctor_partial_run_value_settlement_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (hargs : LowerArgsValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {tag arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} + (hsrc : src f = some (.ctor tag arity)) + (hunder : args.length < arity) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSettlement (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (trackedThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hrun' : + ((wrapperFor f tag arity) >>= fun wrapper => + knownCall src (fuel + 1) input (.papp wrapper ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + obtain ⟨wrapper, wrapperState, hwrapperRun, hknownRun⟩ := + trackedBindRun_ok_inv hrun' + let memo : WrapperMemo := ⟨f, tag, arity, wrapper⟩ + have hmemoFinal : memo ∈ finalState.wrappers := + (hknownExtra input (.papp wrapper ·) args.length + (List.replicate args.length .shared) .shared args + hknownRun).wrapper_mem (wrapperFor_memo_mem hwrapperRun) + have hmemo : memo ∈ ambient.wrappers := + hextends.wrapper_mem hmemoFinal + have hdecl := hrepresented.wrapper hmemo + apply knownCall_papp_wrapper_run_value_settlement_within hargs hrest + (Nat.le_refl _) hmemo hsrc href hdecl + (by simp [memo, ctorWrapperDecl, declArity]) + (by simpa [memo, ctorWrapperDecl, declArity] using hunder) + hsourceArgs hsourceApply hknownRun hextends havailable + +/-- Saturated/over-applied extern references progress when the target oracle +is defined on every source-guided argument tuple. -/ +theorem lowerSpine_ref_extern_call_run_value_settlement_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hprogress : ExternProgressContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx) + (hcontract : ExternValueContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hlookup : sourceCtx.env f = some (.extern arity)) + (hsrc : src f = some (.extern arity)) + (hcount : arity ≤ args.length) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSettlement (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + have hknown : + (knownCall src (fuel + 1) input (.extern f ·) arity + (List.replicate arity .shared) world args).run state = + .ok (output, emit, av) finalState := by + simpa [lowerSpine, hsrc, Nat.not_lt.mpr hcount] using hrun + exact knownCall_extern_run_value_settlement_within hargs hrest hprogress + hcontract hcount hlookup href hsourceArgs hsourceApply hknown hextends + havailable + +/-- Under-applied extern references progress by allocating a pap. -/ +theorem lowerSpine_ref_extern_partial_run_value_settlement_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsrc : src f = some (.extern arity)) + (hunder : args.length < arity) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSettlement (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + have hdecl := hdecls.extern hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (trackedThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + apply knownCall_papp_source_run_value_settlement_within hargs hrest + (Nat.le_refl _) hsrc (by simp [SourcePapEligible]) (by rfl) href hdecl + (by simpa [declArity] using hunder) + hsourceArgs hsourceApply hknown hextends havailable + +/-- Complete source-guided progress for static-reference spines. -/ +theorem lowerSpine_ref_run_value_settlement_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hargs : LowerArgsValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSettlement (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + cases hsrc : src f with + | none => + exact (trackedThrowRun_not_ok + (by simpa [lowerSpine, hsrc] using hrun)).elim + | some source => + cases source with + | defn result body => + by_cases hunder : args.length < lamArity body + · exact lowerSpine_ref_defn_partial_run_value_settlement_within + hargs hrest hcontracts.decls hsrc hunder hsource hrun hextends + havailable + · exact lowerSpine_ref_defn_call_run_value_settlement_within + hargs hrest hcontracts.decls hvalues.decls hprogress.decls hsrc + (Nat.le_of_not_gt hunder) hsource hrun hextends havailable + | ctor tag arity => + have hlookup : sourceCtx.env f = some (.ctor tag arity) := by + rw [henv] + exact hsrc + by_cases hunder : args.length < arity + · exact lowerSpine_ref_ctor_partial_run_value_settlement_within + hargs hrest hknownExtra hsrc hunder hsource hrun hextends + hrepresented havailable + · exact lowerSpine_ref_ctor_alloc_run_value_settlement_within + hargs hrest hlookup hsrc (Nat.le_of_not_gt hunder) hsource hrun + hextends havailable + | recursor numArgs natLit rules => + by_cases hunder : args.length < numArgs + 1 + · exact lowerSpine_ref_recursor_partial_run_value_settlement_within + hargs hrest hcontracts.decls hsrc hunder hsource hrun hextends + havailable + · exact lowerSpine_ref_recursor_call_run_value_settlement_within + hargs hrest hcontracts.decls hvalues.decls hprogress.decls hsrc + (Nat.le_of_not_gt hunder) hsource hrun hextends havailable + | extern arity => + have hlookup : sourceCtx.env f = some (.extern arity) := by + rw [henv] + exact hsrc + by_cases hunder : args.length < arity + · exact lowerSpine_ref_extern_partial_run_value_settlement_within + hargs hrest hcontracts.decls hsrc hunder hsource hrun hextends + havailable + · exact lowerSpine_ref_extern_call_run_value_settlement_within + hargs hrest hprogress.extern hvalues.extern hlookup hsrc + (Nat.le_of_not_gt hunder) hsource hrun hextends havailable + +/-- Close a progressing semantic expression with its generated return. The +stable result descriptor supplies a resolvable atom, so no additional target +progress premise is needed at function exit. -/ +theorem LowerResultValueProgress.closeProgress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {world : Owned} + {emit : Emit} {av : AVal} + (hsound : LowerResultValueProgress funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceValue world emit av) + (sourceRest : List (Owned × IxIR0.Value)) (rest : List Root) : + CodeProgress ctx cur + (GraphOwnsVEnv funRel recSelfRel input sourceInput sourceRest rest) + (emit (.ret (av.toAtom output))) := by + have hret : CodeProgress ctx cur + (GraphOwnsResultProtected funRel recSelfRel output sourceOutput + sourceValue world av sourceRest rest []) + (.ret (av.toAtom output)) := by + apply codeProgress_ret + intro store env hpre + obtain ⟨⟨roots, value, houtput, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + exact ⟨value, hav.resolveAtom⟩ + have hemitted : CodeProgress ctx cur + (GraphOwnsVEnvProtected funRel recSelfRel input sourceInput + sourceRest rest []) + (emit (.ret (av.toAtom output))) := + hsound.graphProgress sourceRest rest [] (.ret (av.toAtom output)) hret + intro store env hpre + exact hemitted ⟨hpre, SlotsRealize.nil⟩ + +/-- Closing progress and partial correctness together constructs a target +run whose returned value realizes the source result and whose caller frame +is preserved. -/ +theorem LowerResultValueProgress.closeGraphProgress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {world : Owned} + {emit : Emit} {av : AVal} + (hsound : LowerResultValueProgress funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceValue world emit av) + (hreleased : EntriesReleased output.entries) + (sourceRest : List (Owned × IxIR0.Value)) (rest : List Root) + {store : Store} {env : List RVal} + (hpre : GraphOwnsVEnv funRel recSelfRel input sourceInput + sourceRest rest store env) : + ∃ fuel store' value, + runCode ctx fuel cur store env (emit (.ret (av.toAtom output))) = + .ok (store', value) ∧ + Sim.ValueGraph funRel store' sourceValue value ∧ + Sim.RootsGraph funRel store' sourceRest rest := by + obtain ⟨fuel, store', value, hrun⟩ := + hsound.closeProgress sourceRest rest hpre + have hgraphs := hsound.toLowerResultValueSound.closeGraph + hreleased sourceRest rest hpre hrun + exact ⟨fuel, store', value, hrun, hgraphs.1, hgraphs.2⟩ + +/-- Close a semantic settlement result with the generated return. A prefix +that reaches its graph postcondition returns successfully; a prefix that +stops earlier preserves that ordinary terminal observation. -/ +theorem LowerResultValueSettlement.closeSettlement + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {world : Owned} + {emit : Emit} {av : AVal} + (hsettles : LowerResultValueSettlement funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceValue world emit av) + (sourceRest : List (Owned × IxIR0.Value)) (rest : List Root) : + CodeSettlement ctx cur + (GraphOwnsVEnv funRel recSelfRel input sourceInput sourceRest rest) + (emit (.ret (av.toAtom output))) := by + have hretProgress : CodeProgress ctx cur + (GraphOwnsResultProtected funRel recSelfRel output sourceOutput + sourceValue world av sourceRest rest []) + (.ret (av.toAtom output)) := by + apply codeProgress_ret + intro store env hpre + obtain ⟨⟨roots, value, houtput, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + exact ⟨value, hav.resolveAtom⟩ + have hemitted : CodeSettlement ctx cur + (GraphOwnsVEnvProtected funRel recSelfRel input sourceInput + sourceRest rest []) + (emit (.ret (av.toAtom output))) := + hsettles.graphSettlement sourceRest rest [] + (.ret (av.toAtom output)) hretProgress.settlement + intro store env hpre + exact hemitted ⟨hpre, SlotsRealize.nil⟩ + +/-! ## Call-free primitive progress rules -/ + +theorem emit_pure_scalar_progress {ctx : Ctx} {cur : FnDef} + {frame : List RVal → Prop} {atom : Atom} {value : RVal} + {world : Owned} {rest : List Root} + (hnone : rvalLocation? value = none) : + EmitProgress ctx cur (emitOp (.pure atom)) + (fun store env => frame env ∧ resolveAtom env atom = .ok value ∧ + RootOwnership store rest) + (OwnsPushedRoot frame world rest) := by + apply OpProgress.emit + intro store env hpre + obtain ⟨hframe, hresolve, hown⟩ := hpre + have hop := runOp_pure_scalar_owned (ctx := ctx) (cur := cur) + (fuel := 0) (world := world) (roots := rest) hresolve hnone hown + exact ⟨1, store, value, hop.1, + ⟨value, env, rfl, hframe, hop.2⟩⟩ + +theorem emit_alloc_progress {ctx : Ctx} {cur : FnDef} + {frame : List RVal → Prop} {world : Owned} {cid : CtorId} + {atoms : Array Atom} {values : List RVal} {rest : List Root} : + EmitProgress ctx cur (emitOp (.alloc world cid atoms)) + (fun store env => frame env ∧ resolveAtoms env atoms = .ok values ∧ + RootOwnership store (rootsFor world values ++ rest)) + (OwnsPushedRoot frame world rest) := by + apply OpProgress.emit + intro store env hpre + obtain ⟨hframe, hresolve, hown⟩ := hpre + have hop := runOp_alloc_owned (ctx := ctx) (cur := cur) (fuel := 0) + (cid := cid) (args := atoms) (values := values) (rest := rest) + hresolve hown + let allocated := store.allocNode world (.ctorN cid values.toArray) + refine ⟨1, allocated.1, .loc allocated.2, ?_, ?_⟩ + · simpa [allocated] using hop.1 + · exact ⟨.loc allocated.2, env, rfl, hframe, by + simpa [allocated] using hop.2⟩ + +theorem emit_papp_progress {ctx : Ctx} {cur : FnDef} + {f : Ixon.Address} {d : Decl} {frame : List RVal → Prop} + {atoms : Array Atom} {values : List RVal} {rest : List Root} + (hdecl : ctx.decls f = some d) + (hunder : values.length < declArity d) : + EmitProgress ctx cur (emitOp (.papp f atoms)) + (fun store env => frame env ∧ resolveAtoms env atoms = .ok values ∧ + RootOwnership store (rootsFor .shared values ++ rest)) + (OwnsPushedRoot frame .shared rest) := by + apply OpProgress.emit + intro store env hpre + obtain ⟨hframe, hresolve, hown⟩ := hpre + have hop := runOp_papp_owned (ctx := ctx) (cur := cur) (fuel := 0) + hresolve hdecl hunder hown + let allocated := store.allocNode .shared + (.papN f (declArity d) values.toArray) + refine ⟨1, allocated.1, .loc allocated.2, ?_, ?_⟩ + · simpa [allocated] using hop.1 + · exact ⟨.loc allocated.2, env, rfl, hframe, by + simpa [allocated] using hop.2⟩ + +theorem emit_retain_borrowed_progress {ctx : Ctx} {cur : FnDef} + {frame : List RVal → Prop} {atom : Atom} {value : RVal} + {rest : List Root} : + EmitProgress ctx cur (emitOp (.dup atom)) + (fun store env => frame env ∧ resolveAtom env atom = .ok value ∧ + HasWorld store .shared value ∧ RootOwnership store rest) + (OwnsPushedRoot frame .shared rest) := by + apply OpProgress.emit + intro store env hpre + obtain ⟨hframe, hresolve, hworld, hown⟩ := hpre + obtain ⟨store', hrun, hown'⟩ := + runOp_retain_borrowed (ctx := ctx) (cur := cur) (fuel := 0) + hresolve hworld hown + exact ⟨1, store', value, hrun, + ⟨value, env, rfl, hframe, hown'⟩⟩ + +theorem emit_call_progress {ctx : Ctx} {cur d : FnDef} + {address : Ixon.Address} {frame : List RVal → Prop} + {atoms : Array Atom} {args : List RVal} {argWorlds : List Owned} + {rest : List Root} + (hdecl : ctx.decls address = some (.fn d)) + (hprogress : FnProgressContract ctx d argWorlds) + (hownership : FnOwnershipContract ctx d argWorlds) + (hlength : args.length = argWorlds.length) : + EmitProgress ctx cur (emitOp (.call address atoms)) + (fun store env => frame env ∧ resolveAtoms env atoms = .ok args ∧ + RootOwnership store (rootsForWorlds argWorlds args ++ rest)) + (OwnsPushedRoot frame d.result rest) := by + apply OpProgress.emit + intro store env hpre + obtain ⟨hframe, hargs, hown⟩ := hpre + obtain ⟨fuel, store', value, hrun, hown'⟩ := + runOp_call_progress hargs hdecl hprogress hownership hlength hown + exact ⟨fuel, store', value, hrun, + ⟨value, env, rfl, hframe, hown'⟩⟩ + +theorem emit_callSelf_progress {ctx : Ctx} {cur : FnDef} + {frame : List RVal → Prop} {atoms : Array Atom} + {args : List RVal} {argWorlds : List Owned} {rest : List Root} + (hprogress : FnProgressContract ctx cur argWorlds) + (hownership : FnOwnershipContract ctx cur argWorlds) + (hlength : args.length = argWorlds.length) : + EmitProgress ctx cur (emitOp (.callSelf atoms)) + (fun store env => frame env ∧ resolveAtoms env atoms = .ok args ∧ + RootOwnership store (rootsForWorlds argWorlds args ++ rest)) + (OwnsPushedRoot frame cur.result rest) := by + apply OpProgress.emit + intro store env hpre + obtain ⟨hframe, hargs, hown⟩ := hpre + obtain ⟨fuel, store', value, hrun, hown'⟩ := + runOp_callSelf_progress hargs hprogress hownership hlength hown + exact ⟨fuel, store', value, hrun, + ⟨value, env, rfl, hframe, hown'⟩⟩ + +theorem emit_drop_value_progress {ctx : Ctx} {cur : FnDef} + {frame : List RVal → Prop} {target : Atom} {value : RVal} + {rest : List Root} : + EmitProgress ctx cur (emitOp (.drop target)) + (fun store env => frame env ∧ resolveAtom env target = .ok value ∧ + RootOwnership store (⟨.shared, value⟩ :: rest)) + (OwnsAfterPush frame rest) := by + apply OpProgress.emit + intro store env hpre + obtain ⟨hframe, hresolve, hown⟩ := hpre + cases value with + | lit literal => + have hrun : runOp ctx 1 cur store env (.drop target) = + .ok (store, .erased) := by + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + exact ⟨1, store, .erased, hrun, + ⟨.erased, env, rfl, hframe, hown.dropNoLocation rfl⟩⟩ + | erased => + have hrun : runOp ctx 1 cur store env (.drop target) = + .ok (store, .erased) := by + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + exact ⟨1, store, .erased, hrun, + ⟨.erased, env, rfl, hframe, hown.dropNoLocation rfl⟩⟩ + | loc loc => + obtain ⟨fuel, store', hdrop, hown'⟩ := dropVal_progress hown + have hrun := runOp_drop (ctx := ctx) (cur := cur) (fuel := fuel) + hresolve hdrop + exact ⟨fuel + 1, store', .erased, hrun, + ⟨.erased, env, rfl, hframe, hown'⟩⟩ + +/-! ## Erased-result argument-release progress -/ + +/-- Skipping a stable scalar argument is an identity progress +transformation on the remaining semantic argument vector. -/ +theorem discard_const_arg_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {source : IxIR0.Value} + {sources : List IxIR0.Value} {atom : Atom} + {worlds : List Owned} {avs : List AVal} + (hstable : AValStable (.constA atom)) : + ∀ sourceRest rest slots, + EmitProgress ctx cur (_root_.id : Emit) + (GraphOwnsArgsResultProtected funRel recSelfRel Γ + sourceEnv (source :: sources) (.shared :: worlds) + (.constA atom :: avs) sourceRest rest slots) + (GraphOwnsArgsResultProtected funRel recSelfRel Γ + sourceEnv sources worlds avs sourceRest rest slots) := by + intro sourceRest rest slots + apply EmitProgress.strengthen + intro store env hpre + obtain ⟨⟨roots, values, hΓ, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + cases havs with + | @cons headWorld tailWorlds headAV tailAVs value tailValues hav htail => + cases hvalueGraphs with + | cons hvalueGraph htailGraphs => + have howned : RootOwnership store + (⟨.shared, value⟩ :: + (rootsForWorlds worlds tailValues ++ roots ++ rest)) := by + simpa [rootsForWorlds] using hown + exact ⟨⟨roots, tailValues, hΓ, htail, htailGraphs, + hrestGraph, + howned.dropNoLocation (hstable.const_noLocation hav)⟩, + hslots⟩ + +/-- Forgetting an ownership-inert scalar result also progresses by an +identity transformation. -/ +theorem discard_const_result_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {world : Owned} {atom : Atom} + (hstable : AValStable (.constA atom)) : + ∀ sourceRest rest slots, + EmitProgress ctx cur (_root_.id : Emit) + (GraphOwnsResultProtected funRel recSelfRel Γ sourceEnv + sourceValue world (.constA atom) sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel Γ sourceEnv + sourceRest rest slots) := by + intro sourceRest rest slots + apply EmitProgress.strengthen + intro store env hpre + obtain ⟨⟨roots, value, hΓ, hav, _, hrestGraph, hown⟩, + hslots⟩ := hpre + exact ⟨⟨roots, hΓ, hrestGraph, + hown.dropNoLocation (hstable.const_noLocation hav)⟩, hslots⟩ + +/-- A slot-backed shared argument has a terminating deep release. The +restriction theorem for that successful drop transports all surviving value +graphs to the resulting store. -/ +theorem discard_slot_arg_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {source : IxIR0.Value} + {sources : List IxIR0.Value} {abs : Nat} + {worlds : List Owned} {avs : List AVal} + (htailStable : AValsStable avs) : + ∀ sourceRest rest slots, + EmitProgress ctx cur (emitOp (.drop (.var (Γ.rel abs)))) + (GraphOwnsArgsResultProtected funRel recSelfRel Γ + sourceEnv (source :: sources) (.shared :: worlds) + (.slotA abs :: avs) sourceRest rest slots) + (GraphOwnsArgsResultProtected funRel recSelfRel Γ.bump + sourceEnv sources worlds avs sourceRest rest slots) := by + intro sourceRest rest slots + apply OpProgress.emit + intro store env hpre + obtain ⟨⟨roots, values, hΓ, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + cases havs with + | @cons headWorld tailWorlds headAV tailAVs value tailValues hav htail => + cases hvalueGraphs with + | cons hvalueGraph htailGraphs => + let remainingRoots := + rootsForWorlds worlds tailValues ++ roots ++ rest + have howned : RootOwnership store + (⟨.shared, value⟩ :: remainingRoots) := by + simpa [remainingRoots, rootsForWorlds] using hown + have hresolve : resolveAtom env (.var (Γ.rel abs)) = .ok value := by + exact hav.resolveAtom + cases value with + | lit literal => + have hrun : runOp ctx 1 cur store env + (.drop (.var (Γ.rel abs))) = .ok (store, .erased) := by + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + exact ⟨1, store, .erased, hrun, + ⟨⟨roots, tailValues, hΓ.bump .erased, + htailStable.realize_bump htail .erased, + htailGraphs, hrestGraph, howned.dropNoLocation rfl⟩, + hslots.bump .erased⟩⟩ + | erased => + have hrun : runOp ctx 1 cur store env + (.drop (.var (Γ.rel abs))) = .ok (store, .erased) := by + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + exact ⟨1, store, .erased, hrun, + ⟨⟨roots, tailValues, hΓ.bump .erased, + htailStable.realize_bump htail .erased, + htailGraphs, hrestGraph, howned.dropNoLocation rfl⟩, + hslots.bump .erased⟩⟩ + | loc loc => + obtain ⟨fuel, store', hdrop, _⟩ := dropVal_progress howned + have hrun := runOp_drop (ctx := ctx) (cur := cur) (fuel := fuel) + hresolve hdrop + obtain ⟨_, hrestrict, hownAfter⟩ := + runOp_drop_value_owned_restricts hresolve howned hrun + have hΓAfter : VEnvValueGraph funRel recSelfRel store' + Γ sourceEnv env roots := + hΓ.ofRestricts hrestrict hownAfter + (fun root hmember => by + simp [remainingRoots, hmember]) + have hlength : worlds.length = tailValues.length := + htail.lengths.1.trans htail.lengths.2 + have htailGraphsAfter : + Sim.ValuesGraph funRel store' sources tailValues := + htailGraphs.ofRestrictsIn hrestrict hownAfter + (fun runtime hmember => by + obtain ⟨runtimeWorld, hroot⟩ := + exists_root_mem_rootsForWorlds hlength hmember + exact ⟨runtimeWorld, by + simp [remainingRoots, hroot]⟩) + have hrestAfter : Sim.RootsGraph funRel store' + sourceRest rest := + hrestGraph.ofRestrictsIn hrestrict hownAfter + (fun root hmember => by + simp [remainingRoots, hmember]) + refine ⟨fuel + 1, store', .erased, hrun, ?_⟩ + exact ⟨⟨roots, tailValues, hΓAfter.bump .erased, + htailStable.realize_bump htail .erased, + htailGraphsAfter, hrestAfter, hownAfter⟩, + hslots.bump .erased⟩ + +/-- Stable argument descriptors determine a terminating `releaseAll` +emitter that consumes every shared temporary owner. -/ +theorem releaseAll_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv sourceValues : List IxIR0.Value} {avs : List AVal} + (hstable : AValsStable avs) + (hsourceLength : sourceValues.length = avs.length) : + ∀ sourceRest rest slots, + EmitProgress ctx cur (releaseAll Γ avs).2 + (GraphOwnsArgsResultProtected funRel recSelfRel Γ + sourceEnv sourceValues (List.replicate avs.length .shared) + avs sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel + (releaseAll Γ avs).1 sourceEnv sourceRest rest slots) := by + apply AValsStable.traverseAligned + (Result := fun Γ sourceValues avs => + ∀ sourceRest rest slots, + EmitProgress ctx cur (releaseAll Γ avs).2 + (GraphOwnsArgsResultProtected funRel recSelfRel Γ + sourceEnv sourceValues (List.replicate avs.length .shared) + avs sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel + (releaseAll Γ avs).1 sourceEnv sourceRest rest slots)) + (hstable := hstable) (hlength := hsourceLength) + · intro Γ sourceRest rest slots + apply EmitProgress.strengthen + intro store env hpre + obtain ⟨⟨roots, values, hΓ, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + cases havs + cases hvalueGraphs + exact ⟨⟨roots, hΓ, hrestGraph, + by simpa [rootsForWorlds] using hown⟩, hslots⟩ + · intro Γ source sources abs avs htail ih sourceRest rest slots + have hcomposed := EmitProgress.comp + (discard_slot_arg_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := Γ) + (sourceEnv := sourceEnv) (source := source) + (sources := sources) (abs := abs) + (worlds := List.replicate avs.length .shared) + (avs := avs) htail sourceRest rest slots) + (ih sourceRest rest slots) + simpa [releaseAll, List.replicate_succ] using hcomposed + · intro Γ source sources literal avs htail ih sourceRest rest slots + have hcomposed := EmitProgress.comp + (discard_const_arg_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := Γ) + (sourceEnv := sourceEnv) (source := source) + (sources := sources) (atom := .lit literal) + (worlds := List.replicate avs.length .shared) + (avs := avs) AValStable.lit sourceRest rest slots) + (ih sourceRest rest slots) + simpa [releaseAll, List.replicate_succ, Function.comp_def] using + hcomposed + · intro Γ source sources avs htail ih sourceRest rest slots + have hcomposed := EmitProgress.comp + (discard_const_arg_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := Γ) + (sourceEnv := sourceEnv) (source := source) + (sources := sources) (atom := .erased) + (worlds := List.replicate avs.length .shared) + (avs := avs) AValStable.erased sourceRest rest slots) + (ih sourceRest rest slots) + simpa [releaseAll, List.replicate_succ, Function.comp_def] using + hcomposed + +/-- Progressing erased-function and argument emitters compose with total +argument release and the ownership-inert erased result. -/ +theorem LowerResultValueProgress.discardArgs + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {start input output : VEnv} + {sourceStart sourceMiddle sourceOutput sourceValues : + List IxIR0.Value} + {resultWorld : Owned} {emitFunction emitArgs : Emit} + {avs : List AVal} + (hfunction : LowerResultValueProgress funRel recSelfRel ctx cur + start input sourceStart sourceMiddle .erased .shared + emitFunction (.constA .erased)) + (hargs : LowerArgsValueProgress funRel recSelfRel ctx cur input output + sourceMiddle sourceOutput sourceValues + (List.replicate avs.length .shared) emitArgs avs) + (hsourceLength : sourceValues.length = avs.length) : + LowerResultValueProgress funRel recSelfRel ctx cur start + (releaseAll output avs).1 sourceStart sourceOutput .erased resultWorld + ((emitFunction ∘ emitArgs) ∘ (releaseAll output avs).2) + (.constA .erased) := by + refine + { toLowerResultValueSound := + hfunction.toLowerResultValueSound.discardArgs + hargs.toLowerArgsValueSound hsourceLength + graphProgress := ?_ } + intro sourceRest rest slots + have hcomposed := EmitProgress.comp + (hfunction.graphProgress sourceRest rest slots) + (EmitProgress.comp + (discard_const_result_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := input) + (sourceEnv := sourceMiddle) (sourceValue := IxIR0.Value.erased) + AValStable.erased sourceRest rest slots) + (EmitProgress.comp (hargs.graphProgress sourceRest rest slots) + (EmitProgress.comp + (releaseAll_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output) + (sourceEnv := sourceOutput) hargs.stable hsourceLength + sourceRest rest slots) + ((lower_erased_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) + (input := (releaseAll output avs).1) + (sourceEnv := sourceOutput) (world := resultWorld)).graphProgress + sourceRest rest slots)))) + simpa [Function.comp_def] using hcomposed + +/-- Settlement counterpart of erased-function application. Every +successfully reached phase preserves the same graph invariant, while an +ordinary-stuck prefix closes the composed emitter immediately. -/ +theorem LowerResultValueSettlement.discardArgs + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {start input output : VEnv} + {sourceStart sourceMiddle sourceOutput sourceValues : + List IxIR0.Value} + {resultWorld : Owned} {emitFunction emitArgs : Emit} + {avs : List AVal} + (hfunction : LowerResultValueSettlement funRel recSelfRel ctx cur + start input sourceStart sourceMiddle .erased .shared + emitFunction (.constA .erased)) + (hargs : LowerArgsValueSettlement funRel recSelfRel ctx cur input output + sourceMiddle sourceOutput sourceValues + (List.replicate avs.length .shared) emitArgs avs) + (hsourceLength : sourceValues.length = avs.length) : + LowerResultValueSettlement funRel recSelfRel ctx cur start + (releaseAll output avs).1 sourceStart sourceOutput .erased resultWorld + ((emitFunction ∘ emitArgs) ∘ (releaseAll output avs).2) + (.constA .erased) := by + refine + { toLowerResultValueSound := + hfunction.toLowerResultValueSound.discardArgs + hargs.toLowerArgsValueSound hsourceLength + graphSettlement := ?_ } + intro sourceRest rest slots + have hcomposed := EmitSettlement.comp + (hfunction.graphSettlement sourceRest rest slots) + (EmitSettlement.comp + (discard_const_result_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := input) + (sourceEnv := sourceMiddle) (sourceValue := IxIR0.Value.erased) + AValStable.erased sourceRest rest slots).settles + (EmitSettlement.comp (hargs.graphSettlement sourceRest rest slots) + (EmitSettlement.comp + (releaseAll_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output) + (sourceEnv := sourceOutput) hargs.stable hsourceLength + sourceRest rest slots).settles + ((lower_erased_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) + (input := (releaseAll output avs).1) + (sourceEnv := sourceOutput) (world := resultWorld)).graphProgress + sourceRest rest slots).settles))) + simpa [Function.comp_def] using hcomposed + +/-- Reachable-state erased application progress. Every argument is evaluated +and its shared temporary owner is then released before returning erased. -/ +theorem applyRest_erased_run_value_progress_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hargs : LowerArgsValueProgressesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + {start input output : VEnv} + {sourceStart sourceMiddle sourceArgs : List IxIR0.Value} + {resultWorld : Owned} {emitFunction emit : Emit} + {args : List IxIR0.Expr} {av : AVal} + {state finalState : LowSt} + (hsourceArgs : SourceArgsEval sourceCtx sourceMiddle args sourceArgs) + (hfunction : LowerResultValueProgress funRel recSelfRel ctx cur + start input sourceStart sourceMiddle .erased .shared emitFunction + (.constA .erased)) + (hrun : (applyRest src (fuel + 1) input resultWorld emitFunction + (.constA .erased) args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueProgress funRel recSelfRel ctx cur start output + sourceStart sourceMiddle .erased resultWorld emit av := by + simp only [applyRest] at hrun + obtain ⟨argsResult, argsState, hargsRun, hpureRun⟩ := + trackedBindRun_ok_inv hrun + rcases argsResult with ⟨argsOutput, emitArgs, avs⟩ + have hpure : + ((releaseAll argsOutput avs).1, + (emitFunction ∘ emitArgs) ∘ (releaseAll argsOutput avs).2, + AVal.constA .erased) = (output, emit, av) ∧ + argsState = finalState := by + simpa [Function.comp_def] using hpureRun + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + have hsourcePaired : SourceArgsEval sourceCtx sourceMiddle + ((args.map (fun arg => (arg, Owned.shared))).map Prod.fst) + sourceArgs := by + simpa [Function.comp_def] using hsourceArgs + have hargsProgress := hargs hsourcePaired hargsRun hextends havailable + have havsLength : avs.length = args.length := by + simpa using lowerArgs_success_length src hargsRun + have hworldsHomogeneous : + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate avs.length .shared := by + simpa [havsLength] using map_shared_arg_worlds args + have hhomogeneous : LowerArgsValueProgress funRel recSelfRel ctx cur + input argsOutput sourceMiddle sourceMiddle sourceArgs + (List.replicate avs.length .shared) emitArgs avs := by + simpa [hworldsHomogeneous] using hargsProgress + have hsourceLength : sourceArgs.length = avs.length := by + rw [← hsourceArgs.lengths, ← havsLength] + simpa [Function.comp_def] using + hfunction.discardArgs hhomogeneous hsourceLength + +/-- Projection-safe erased application still evaluates and releases every +argument; the only change from the generic helper is the stronger recursive +argument witness. -/ +theorem applyRest_erased_run_value_progress_safely_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hargs : LowerArgsValueProgressesSafelyWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + {start input output : VEnv} + {sourceStart sourceMiddle sourceArgs : List IxIR0.Value} + {resultWorld : Owned} {emitFunction emit : Emit} + {args : List IxIR0.Expr} {av : AVal} + {state finalState : LowSt} + (hsourceArgs : ProjectionSafeArgs sourceCtx sourceMiddle args sourceArgs) + (hfunction : LowerResultValueProgress funRel recSelfRel ctx cur + start input sourceStart sourceMiddle .erased .shared emitFunction + (.constA .erased)) + (hrun : (applyRest src (fuel + 1) input resultWorld emitFunction + (.constA .erased) args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueProgress funRel recSelfRel ctx cur start output + sourceStart sourceMiddle .erased resultWorld emit av := by + simp only [applyRest] at hrun + obtain ⟨argsResult, argsState, hargsRun, hpureRun⟩ := + trackedBindRun_ok_inv hrun + rcases argsResult with ⟨argsOutput, emitArgs, avs⟩ + have hpure : + ((releaseAll argsOutput avs).1, + (emitFunction ∘ emitArgs) ∘ (releaseAll argsOutput avs).2, + AVal.constA .erased) = (output, emit, av) ∧ + argsState = finalState := by + simpa [Function.comp_def] using hpureRun + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + have hsourcePaired : ProjectionSafeArgs sourceCtx sourceMiddle + ((args.map (fun arg => (arg, Owned.shared))).map Prod.fst) + sourceArgs := by + simpa [Function.comp_def] using hsourceArgs + have hargsProgress := hargs hsourcePaired hargsRun hextends havailable + have havsLength : avs.length = args.length := by + simpa using lowerArgs_success_length src hargsRun + have hworldsHomogeneous : + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate avs.length .shared := by + simpa [havsLength] using map_shared_arg_worlds args + have hhomogeneous : LowerArgsValueProgress funRel recSelfRel ctx cur + input argsOutput sourceMiddle sourceMiddle sourceArgs + (List.replicate avs.length .shared) emitArgs avs := by + simpa [hworldsHomogeneous] using hargsProgress + have hsourceLength : sourceArgs.length = avs.length := by + rw [← hsourceArgs.lengths, ← havsLength] + simpa [Function.comp_def] using + hfunction.discardArgs hhomogeneous hsourceLength + +/-- An erased spine head progresses through argument evaluation and total +temporary release. -/ +theorem lowerSpine_erased_run_value_progress_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hargs : LowerArgsValueProgressesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + {input output : VEnv} {world : Owned} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hsource : SourceSpineEval sourceCtx sourceEnv .erased args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world .erased args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + apply hsource.eliminate + · intro headValue argumentValues hhead harguments happlies + obtain ⟨_, hhead⟩ := hhead + have herasedEval : IxIR0.eval sourceCtx 1 sourceEnv .erased = + .ok .erased := by + simp [IxIR0.eval] + have hheadValue : headValue = .erased := + sourceEval_ok_unique hhead herasedEval + subst headValue + have hresult : sourceResult = .erased := + happlies.deterministic (SourceApplies.erased sourceCtx argumentValues) + subst sourceResult + apply applyRest_erased_run_value_progress_within hargs harguments + (lower_erased_value_progress (funRel := funRel) + (recSelfRel := recSelfRel) (ctx := ctx) (cur := cur) + (sourceEnv := sourceEnv) (world := .shared)) + · simpa [lowerSpine] using hrun + · exact hextends + · exact havailable + +/-- Reachable-state recursive-self spine progress. Realizable self markers +cannot advertise a mismatched target arity because their source-guided body +progress contract carries the current function's arity equation. -/ +theorem lowerSpine_recSelf_run_value_progress_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValueProgressesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + {input output : VEnv} {world : Owned} {index arity : Nat} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hentry : input.entries[index]? = some (.recSelf arity)) + (hself : CurrentSelfProgressContract funRel recSelfRel sourceCtx ctx cur) + (hsource : SourceSpineEval sourceCtx sourceEnv (.var index) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.var index) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + apply hsource.eliminate + · intro sourceFunction sourceValues hhead hsourceArgs hsourceApply + obtain ⟨sourceFuel, hhead⟩ := hhead + have hsourceHead : sourceEnv[index]? = some sourceFunction := + sourceEval_var_inv hhead + simp only [lowerSpine] at hrun + rw [hentry] at hrun + simp only at hrun + by_cases hunder : args.length < arity + · rw [if_pos hunder] at hrun + exact (trackedThrowRun_not_ok hrun).elim + · rw [if_neg hunder] at hrun + have hcount : arity ≤ args.length := Nat.le_of_not_gt hunder + cases world with + | unique => + have hrequire : + (requireResultWorld .shared .unique).run state = + .error "call result is shared at unique demand" state := by + rfl + rw [estateBindRun, hrequire] at hrun + contradiction + | shared => + have hrequire : + (requireResultWorld .shared .shared).run state = .ok () state := by + rfl + rw [estateBindRun, hrequire] at hrun + simp only at hrun + exact knownCall_callSelf_current_run_value_progress_within + hargs hrest hcount hentry hsourceHead hself hsourceArgs + hsourceApply hrun hextends havailable + +/-- Dynamic spine progress lowers the function expression, reflects the +erased descriptor when necessary, and otherwise consumes higher-order apply +progress for the argument tail. -/ +theorem lowerSpine_dynamic_run_value_progress_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEValueProgressesWithin funRel recSelfRel sourceCtx ctx cur + src ambient (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsValueProgressesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesWithin funRel recSelfRel + sourceCtx ctx cur src ambient (fuel + 1)) + {input output : VEnv} {world : Owned} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hshape : DynamicSpineHead head) + (hsource : SourceSpineEval sourceCtx sourceEnv head args sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world head args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + apply hsource.eliminate + · intro sourceFunction sourceArgs hhead hsourceArgs hsourceApply + obtain ⟨sourceFuel, hhead⟩ := hhead + obtain ⟨functionOutput, emitFunction, function, middleState, + hfunctionRun, hrestRun⟩ := + lowerSpine_dynamic_run_inv hshape hrun + have hfunctionExtends : ExtraExtends middleState ambient := + (applyRest_extraExtends hrestRun).trans hextends + have hfunctionProgress := + hexpr hhead hfunctionRun hfunctionExtends havailable + have hfunctionAvailable := havailable.lowerE hfunctionRun + by_cases herased : function = .constA .erased + · have hsourceErased : sourceFunction = .erased := + hreflect hhead hfunctionRun herased + subst sourceFunction + have hresult : sourceResult = .erased := + hsourceApply.deterministic + (SourceApplies.erased sourceCtx sourceArgs) + subst sourceResult + subst function + exact applyRest_erased_run_value_progress_within hargs hsourceArgs + hfunctionProgress hrestRun hextends hfunctionAvailable + · exact hrest herased hsourceArgs hsourceApply hfunctionProgress + hrestRun hextends hfunctionAvailable + +/-- Variable dynamic heads use the dedicated inversion that excludes the +synthetic recursive-self lowering branch. -/ +theorem lowerSpine_var_dynamic_run_value_progress_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEValueProgressesWithin funRel recSelfRel sourceCtx ctx cur + src ambient (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsValueProgressesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesWithin funRel recSelfRel + sourceCtx ctx cur src ambient (fuel + 1)) + {input output : VEnv} {world : Owned} {index : Nat} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hnotSelf : ∀ arity, + input.entries[index]? ≠ some (.recSelf arity)) + (hsource : SourceSpineEval sourceCtx sourceEnv (.var index) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.var index) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + apply hsource.eliminate + · intro sourceFunction sourceArgs hhead hsourceArgs hsourceApply + obtain ⟨sourceFuel, hhead⟩ := hhead + obtain ⟨functionOutput, emitFunction, function, middleState, + hfunctionRun, hrestRun⟩ := + lowerSpine_var_dynamic_run_inv hnotSelf hrun + have hfunctionExtends : ExtraExtends middleState ambient := + (applyRest_extraExtends hrestRun).trans hextends + have hfunctionProgress := + hexpr hhead hfunctionRun hfunctionExtends havailable + have hfunctionAvailable := havailable.lowerE hfunctionRun + by_cases herased : function = .constA .erased + · have hsourceErased : sourceFunction = .erased := + hreflect hhead hfunctionRun herased + subst sourceFunction + have hresult : sourceResult = .erased := + hsourceApply.deterministic + (SourceApplies.erased sourceCtx sourceArgs) + subst sourceResult + subst function + exact applyRest_erased_run_value_progress_within hargs hsourceArgs + hfunctionProgress hrestRun hextends hfunctionAvailable + · exact hrest herased hsourceArgs hsourceApply hfunctionProgress + hrestRun hextends hfunctionAvailable + +/-- One complete reachable-state spine progress step. All recursive calls +are constrained to the ambient whole-pass state, matching the partial +correctness cluster's fuel decomposition. -/ +theorem lowerSpine_run_value_progress_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hspine : LowerSpineValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hexpr : LowerEValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrestNext : ApplyRestNonErasedValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {input output : VEnv} {world : Owned} {head : IxIR0.Expr} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + (hsource : SourceSpineEval sourceCtx sourceEnv head args sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world head args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + cases head with + | app function argument => + apply hspine hsource.flattenApp + · simpa [lowerSpine] using hrun + · exact hextends + · exact havailable + | erased => + exact lowerSpine_erased_run_value_progress_within hargs hsource hrun + hextends havailable + | var index => + cases hentry : input.entries[index]? with + | none => + exact lowerSpine_var_dynamic_run_value_progress_within hexpr hreflect + hargs hrestNext (fun arity => by simp [hentry]) hsource hrun + hextends havailable + | some entry => + cases entry with + | recSelf arity => + cases havailable with + | inl hself => + exact lowerSpine_recSelf_run_value_progress_within hargs hrest + hentry hself hsource hrun hextends + (SelfProgressAvailable.of_contract hself) + | inr hno => exact (hno index arity hentry).elim + | slot abs remaining uses held => + exact lowerSpine_var_dynamic_run_value_progress_within hexpr + hreflect hargs hrestNext (fun arity => by simp [hentry]) + hsource hrun hextends havailable + | ref address => + exact lowerSpine_ref_run_value_progress_within henv hargs hrest + hknownExtra hcontracts hvalues hprogress hsource hrun hextends + hrepresented havailable + | lam uses body => + exact lowerSpine_dynamic_run_value_progress_within hexpr hreflect hargs + hrestNext (.lam uses body) hsource hrun hextends havailable + | letE uses value body => + exact lowerSpine_dynamic_run_value_progress_within hexpr hreflect hargs + hrestNext (.letE uses value body) hsource hrun hextends havailable + | proj index value => + exact lowerSpine_dynamic_run_value_progress_within hexpr hreflect hargs + hrestNext (.proj index value) hsource hrun hextends havailable + | lit literal => + exact lowerSpine_dynamic_run_value_progress_within hexpr hreflect hargs + hrestNext (.lit literal) hsource hrun hextends havailable + +/-- Reachable-state erased application progress. Every argument is evaluated +and its shared temporary owner is then released before returning erased. -/ +theorem lowerSpine_erased_run_value_progress_safely_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hargs : LowerArgsValueProgressesSafelyWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + {input output : VEnv} {world : Owned} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hsource : ProjectionSafeSpine sourceCtx sourceEnv .erased args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world .erased args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + apply hsource.eliminate + · intro headValue argumentValues hhead harguments happlies + obtain ⟨_, hhead⟩ := hhead.eval + have herasedEval : IxIR0.eval sourceCtx 1 sourceEnv .erased = + .ok .erased := by + simp [IxIR0.eval] + have hheadValue : headValue = .erased := + sourceEval_ok_unique hhead herasedEval + subst headValue + have hresult : sourceResult = .erased := + happlies.deterministic (SourceApplies.erased sourceCtx argumentValues) + subst sourceResult + apply applyRest_erased_run_value_progress_safely_within hargs harguments + (lower_erased_value_progress (funRel := funRel) + (recSelfRel := recSelfRel) (ctx := ctx) (cur := cur) + (sourceEnv := sourceEnv) (world := .shared)) + · simpa [lowerSpine] using hrun + · exact hextends + · exact havailable + +/-- Reachable-state recursive-self spine progress. Realizable self markers +cannot advertise a mismatched target arity because their source-guided body +progress contract carries the current function's arity equation. -/ +theorem lowerSpine_recSelf_run_value_progress_safely_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValueProgressesSafelyWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesSafelyWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + {input output : VEnv} {world : Owned} {index arity : Nat} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hentry : input.entries[index]? = some (.recSelf arity)) + (hself : CurrentSelfProgressContract funRel recSelfRel sourceCtx ctx cur) + (hsource : ProjectionSafeSpine sourceCtx sourceEnv (.var index) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.var index) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + apply hsource.eliminate + · intro sourceFunction sourceValues hhead hsourceArgs hsourceApply + obtain ⟨sourceFuel, hhead⟩ := hhead.eval + have hsourceHead : sourceEnv[index]? = some sourceFunction := + sourceEval_var_inv hhead + simp only [lowerSpine] at hrun + rw [hentry] at hrun + simp only at hrun + by_cases hunder : args.length < arity + · rw [if_pos hunder] at hrun + exact (trackedThrowRun_not_ok hrun).elim + · rw [if_neg hunder] at hrun + have hcount : arity ≤ args.length := Nat.le_of_not_gt hunder + cases world with + | unique => + have hrequire : + (requireResultWorld .shared .unique).run state = + .error "call result is shared at unique demand" state := by + rfl + rw [estateBindRun, hrequire] at hrun + contradiction + | shared => + have hrequire : + (requireResultWorld .shared .shared).run state = .ok () state := by + rfl + rw [estateBindRun, hrequire] at hrun + simp only at hrun + exact knownCall_callSelf_current_run_value_progress_safely_within + hargs hrest hcount hentry hsourceHead hself hsourceArgs + hsourceApply hrun hextends havailable + +/-- Dynamic spine progress lowers the function expression, reflects the +erased descriptor when necessary, and otherwise consumes higher-order apply +progress for the argument tail. -/ +theorem lowerSpine_dynamic_run_value_progress_safely_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEValueProgressesSafelyWithin funRel recSelfRel sourceCtx ctx cur + src ambient (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsValueProgressesSafelyWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesSafelyWithin funRel recSelfRel + sourceCtx ctx cur src ambient (fuel + 1)) + {input output : VEnv} {world : Owned} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hshape : DynamicSpineHead head) + (hsource : ProjectionSafeSpine sourceCtx sourceEnv head args sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world head args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + apply hsource.eliminate + · intro sourceFunction sourceArgs hheadSafe hsourceArgs hsourceApply + obtain ⟨sourceFuel, hhead⟩ := hheadSafe.eval + obtain ⟨functionOutput, emitFunction, function, middleState, + hfunctionRun, hrestRun⟩ := + lowerSpine_dynamic_run_inv hshape hrun + have hfunctionExtends : ExtraExtends middleState ambient := + (applyRest_extraExtends hrestRun).trans hextends + have hfunctionProgress := + hexpr hheadSafe hfunctionRun hfunctionExtends havailable + have hfunctionAvailable := havailable.lowerE hfunctionRun + by_cases herased : function = .constA .erased + · have hsourceErased : sourceFunction = .erased := + hreflect hhead hfunctionRun herased + subst sourceFunction + have hresult : sourceResult = .erased := + hsourceApply.deterministic + (SourceApplies.erased sourceCtx sourceArgs) + subst sourceResult + subst function + exact applyRest_erased_run_value_progress_safely_within hargs hsourceArgs + hfunctionProgress hrestRun hextends hfunctionAvailable + · exact hrest herased hsourceArgs hsourceApply hfunctionProgress + hrestRun hextends hfunctionAvailable + +/-- Variable dynamic heads use the dedicated inversion that excludes the +synthetic recursive-self lowering branch. -/ +theorem lowerSpine_var_dynamic_run_value_progress_safely_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEValueProgressesSafelyWithin funRel recSelfRel sourceCtx ctx cur + src ambient (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsValueProgressesSafelyWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesSafelyWithin funRel recSelfRel + sourceCtx ctx cur src ambient (fuel + 1)) + {input output : VEnv} {world : Owned} {index : Nat} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hnotSelf : ∀ arity, + input.entries[index]? ≠ some (.recSelf arity)) + (hsource : ProjectionSafeSpine sourceCtx sourceEnv (.var index) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.var index) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + apply hsource.eliminate + · intro sourceFunction sourceArgs hheadSafe hsourceArgs hsourceApply + obtain ⟨sourceFuel, hhead⟩ := hheadSafe.eval + obtain ⟨functionOutput, emitFunction, function, middleState, + hfunctionRun, hrestRun⟩ := + lowerSpine_var_dynamic_run_inv hnotSelf hrun + have hfunctionExtends : ExtraExtends middleState ambient := + (applyRest_extraExtends hrestRun).trans hextends + have hfunctionProgress := + hexpr hheadSafe hfunctionRun hfunctionExtends havailable + have hfunctionAvailable := havailable.lowerE hfunctionRun + by_cases herased : function = .constA .erased + · have hsourceErased : sourceFunction = .erased := + hreflect hhead hfunctionRun herased + subst sourceFunction + have hresult : sourceResult = .erased := + hsourceApply.deterministic + (SourceApplies.erased sourceCtx sourceArgs) + subst sourceResult + subst function + exact applyRest_erased_run_value_progress_safely_within hargs hsourceArgs + hfunctionProgress hrestRun hextends hfunctionAvailable + · exact hrest herased hsourceArgs hsourceApply hfunctionProgress + hrestRun hextends hfunctionAvailable + +/-- One complete reachable-state spine progress step. All recursive calls +are constrained to the ambient whole-pass state, matching the partial +correctness cluster's fuel decomposition. -/ +theorem lowerSpine_run_value_progress_safely_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hspine : LowerSpineValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hexpr : LowerEValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrestNext : ApplyRestNonErasedValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {input output : VEnv} {world : Owned} {head : IxIR0.Expr} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + (hsource : ProjectionSafeSpine sourceCtx sourceEnv head args sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world head args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + cases head with + | app function argument => + apply hspine hsource.flattenApp + · simpa [lowerSpine] using hrun + · exact hextends + · exact havailable + | erased => + exact lowerSpine_erased_run_value_progress_safely_within hargs hsource hrun + hextends havailable + | var index => + cases hentry : input.entries[index]? with + | none => + exact lowerSpine_var_dynamic_run_value_progress_safely_within hexpr hreflect + hargs hrestNext (fun arity => by simp [hentry]) hsource hrun + hextends havailable + | some entry => + cases entry with + | recSelf arity => + cases havailable with + | inl hself => + exact lowerSpine_recSelf_run_value_progress_safely_within hargs hrest + hentry hself hsource hrun hextends + (SelfProgressAvailable.of_contract hself) + | inr hno => exact (hno index arity hentry).elim + | slot abs remaining uses held => + exact lowerSpine_var_dynamic_run_value_progress_safely_within hexpr + hreflect hargs hrestNext (fun arity => by simp [hentry]) + hsource hrun hextends havailable + | ref address => + exact lowerSpine_ref_run_value_progress_safely_within henv hargs hrest + hknownExtra hcontracts hvalues hprogress hsource hrun hextends + hrepresented havailable + | lam uses body => + exact lowerSpine_dynamic_run_value_progress_safely_within hexpr hreflect hargs + hrestNext (.lam uses body) hsource hrun hextends havailable + | letE uses value body => + exact lowerSpine_dynamic_run_value_progress_safely_within hexpr hreflect hargs + hrestNext (.letE uses value body) hsource hrun hextends havailable + | proj index value => + exact lowerSpine_dynamic_run_value_progress_safely_within hexpr hreflect hargs + hrestNext (.proj index value) hsource hrun hextends havailable + | lit literal => + exact lowerSpine_dynamic_run_value_progress_safely_within hexpr hreflect hargs + hrestNext (.lit literal) hsource hrun hextends havailable + +/-! Exact-trace complete spine progress. -/ + +/-- Exact-trace erased application still evaluates and releases every +argument while preserving their common source bound. -/ +theorem applyRest_erased_run_value_trace_progress_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {ambient : LowSt} {fuel sourceLimit : Nat} + (hargs : LowerArgsValueTraceProgressesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + {start input output : VEnv} + {sourceStart sourceMiddle sourceArgs : List IxIR0.Value} + {resultWorld : Owned} {emitFunction emit : Emit} + {args : List IxIR0.Expr} {av : AVal} + {state finalState : LowSt} + (hsourceBound : sourceLimit < limit) + (hsourceArgs : IxIR0.ProjectionSafe.EvalsBelow sourceCtx sourceLimit + sourceMiddle args sourceArgs) + (hfunction : LowerResultValueProgress funRel recSelfRel ctx cur + start input sourceStart sourceMiddle .erased .shared emitFunction + (.constA .erased)) + (hrun : (applyRest src (fuel + 1) input resultWorld emitFunction + (.constA .erased) args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfTraceProgressAvailableBelow funRel recSelfRel + sourceCtx ctx cur limit input) : + LowerResultValueProgress funRel recSelfRel ctx cur start output + sourceStart sourceMiddle .erased resultWorld emit av := by + simp only [applyRest] at hrun + obtain ⟨argsResult, argsState, hargsRun, hpureRun⟩ := + trackedBindRun_ok_inv hrun + rcases argsResult with ⟨argsOutput, emitArgs, avs⟩ + have hpure : + ((releaseAll argsOutput avs).1, + (emitFunction ∘ emitArgs) ∘ (releaseAll argsOutput avs).2, + AVal.constA .erased) = (output, emit, av) ∧ + argsState = finalState := by + simpa [Function.comp_def] using hpureRun + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + have hsourcePaired : IxIR0.ProjectionSafe.EvalsBelow sourceCtx + sourceLimit sourceMiddle + ((args.map (fun arg => (arg, Owned.shared))).map Prod.fst) + sourceArgs := by + simpa [Function.comp_def] using hsourceArgs + have hargsProgress := hargs hsourceBound hsourcePaired hargsRun hextends + havailable + have havsLength : avs.length = args.length := by + simpa using lowerArgs_success_length src hargsRun + have hworldsHomogeneous : + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate avs.length .shared := by + simpa [havsLength] using map_shared_arg_worlds args + have hhomogeneous : LowerArgsValueProgress funRel recSelfRel ctx cur + input argsOutput sourceMiddle sourceMiddle sourceArgs + (List.replicate avs.length .shared) emitArgs avs := by + simpa [hworldsHomogeneous] using hargsProgress + have hsourceLength : sourceArgs.length = avs.length := by + rw [← hsourceArgs.lengths, ← havsLength] + simpa [Function.comp_def] using + hfunction.discardArgs hhomogeneous hsourceLength + +/-- An erased exact-trace spine progresses through argument evaluation and +total temporary release. -/ +theorem lowerSpine_erased_run_value_trace_progress_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit sourceLimit : Nat} {src : IxIR0.Env} {ambient : LowSt} + {fuel : Nat} + (hargs : LowerArgsValueTraceProgressesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + {input output : VEnv} {world : Owned} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hsourceBound : sourceLimit < limit) + (hsource : IxIR0.ProjectionSafe.Spine sourceCtx sourceLimit sourceEnv + .erased args sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world .erased args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfTraceProgressAvailableBelow funRel recSelfRel + sourceCtx ctx cur limit input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + cases hsource with + | @intro headFuel headValue _ _ _ argumentValues hheadBound hhead + harguments happlies => + have herasedEval : IxIR0.eval sourceCtx 1 sourceEnv .erased = + .ok .erased := by + simp [IxIR0.eval] + have hheadValue : headValue = .erased := + sourceEval_ok_unique hhead.run herasedEval + subst headValue + have hresult : sourceResult = .erased := + (SourceAppliesSafelyBelow.sourceApplies happlies).deterministic + (SourceApplies.erased sourceCtx argumentValues) + subst sourceResult + apply applyRest_erased_run_value_trace_progress_within_below hargs + hsourceBound harguments + (lower_erased_value_progress (funRel := funRel) + (recSelfRel := recSelfRel) (ctx := ctx) (cur := cur) + (sourceEnv := sourceEnv) (world := .shared)) + · simpa [lowerSpine] using hrun + · exact hextends + · exact havailable + +/-- Exact-trace recursive-self spine progress. -/ +theorem lowerSpine_recSelf_run_value_trace_progress_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {ctx : Ctx} {cur : FnDef} + {limit sourceLimit fuel : Nat} + (hargs : LowerArgsValueTraceProgressesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValueTraceProgressesWithinBelow funRel + recSelfRel sourceCtx ctx cur limit src ambient fuel) + {input output : VEnv} {world : Owned} {index arity : Nat} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hsourceBound : sourceLimit < limit) + (hentry : input.entries[index]? = some (.recSelf arity)) + (hself : CurrentSelfTraceProgressContractBelow funRel recSelfRel + sourceCtx ctx cur limit) + (hsource : IxIR0.ProjectionSafe.Spine sourceCtx sourceLimit sourceEnv + (.var index) args sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.var index) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfTraceProgressAvailableBelow funRel recSelfRel + sourceCtx ctx cur limit input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + cases hsource with + | @intro headFuel sourceFunction _ _ _ sourceValues hheadBound hhead + hsourceArgs hsourceApply => + have hsourceHead : sourceEnv[index]? = some sourceFunction := + sourceEval_var_inv hhead.run + simp only [lowerSpine] at hrun + rw [hentry] at hrun + simp only at hrun + by_cases hunder : args.length < arity + · rw [if_pos hunder] at hrun + exact (trackedThrowRun_not_ok hrun).elim + · rw [if_neg hunder] at hrun + have hcount : arity ≤ args.length := Nat.le_of_not_gt hunder + cases world with + | unique => + have hrequire : + (requireResultWorld .shared .unique).run state = + .error "call result is shared at unique demand" state := by + rfl + rw [estateBindRun, hrequire] at hrun + contradiction + | shared => + have hrequire : + (requireResultWorld .shared .shared).run state = .ok () state := by + rfl + rw [estateBindRun, hrequire] at hrun + simp only at hrun + exact knownCall_callSelf_current_run_value_trace_progress_within_below + hargs hrest hsourceBound hcount hentry hsourceHead hself + hsourceArgs hsourceApply hrun hextends havailable + +/-- Dynamic exact-trace spine progress lowers the function expression and +then consumes the bounded higher-order application trace. -/ +theorem lowerSpine_dynamic_run_value_trace_progress_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit sourceLimit : Nat} {src : IxIR0.Env} {ambient : LowSt} + {fuel : Nat} + (hexpr : LowerEValueTraceProgressesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsValueTraceProgressesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValueTraceProgressesWithinBelow funRel + recSelfRel sourceCtx ctx cur limit src ambient (fuel + 1)) + {input output : VEnv} {world : Owned} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hshape : DynamicSpineHead head) + (hargsNonempty : args ≠ []) + (hsourceBound : sourceLimit < limit) + (hsource : IxIR0.ProjectionSafe.Spine sourceCtx sourceLimit sourceEnv + head args sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world head args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfTraceProgressAvailableBelow funRel recSelfRel + sourceCtx ctx cur limit input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + cases hsource with + | @intro headFuel sourceFunction _ _ _ sourceArgs hheadBound hhead + hsourceArgs hsourceApply => + have hsourceArgsNonempty : sourceArgs ≠ [] := by + intro hnil + have hargsLengthZero : args.length = 0 := by + simpa [hnil] using hsourceArgs.lengths + exact hargsNonempty (List.eq_nil_of_length_eq_zero hargsLengthZero) + obtain ⟨functionOutput, emitFunction, function, middleState, + hfunctionRun, hrestRun⟩ := + lowerSpine_dynamic_run_inv hshape hrun + have hfunctionExtends : ExtraExtends middleState ambient := + (applyRest_extraExtends hrestRun).trans hextends + have hheadOuter : headFuel < limit := + Nat.lt_of_le_of_lt hheadBound hsourceBound + have hfunctionProgress := + hexpr hheadOuter hhead hfunctionRun hfunctionExtends havailable + have hfunctionAvailable := havailable.lowerE hfunctionRun + by_cases herased : function = .constA .erased + · have hsourceErased : sourceFunction = .erased := + hreflect hhead.run hfunctionRun herased + subst sourceFunction + have hresult : sourceResult = .erased := + (SourceAppliesSafelyBelow.sourceApplies hsourceApply).deterministic + (SourceApplies.erased sourceCtx sourceArgs) + subst sourceResult + subst function + exact applyRest_erased_run_value_trace_progress_within_below hargs + hsourceBound hsourceArgs hfunctionProgress hrestRun hextends + hfunctionAvailable + · exact hrest hsourceBound herased hsourceArgs hsourceApply + hsourceArgsNonempty hfunctionProgress hrestRun hextends + hfunctionAvailable + +/-- Variable dynamic heads use exact source traces while excluding the +synthetic recursive-self lowering branch. -/ +theorem lowerSpine_var_dynamic_run_value_trace_progress_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit sourceLimit : Nat} {src : IxIR0.Env} {ambient : LowSt} + {fuel : Nat} + (hexpr : LowerEValueTraceProgressesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsValueTraceProgressesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValueTraceProgressesWithinBelow funRel + recSelfRel sourceCtx ctx cur limit src ambient (fuel + 1)) + {input output : VEnv} {world : Owned} {index : Nat} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hnotSelf : ∀ arity, + input.entries[index]? ≠ some (.recSelf arity)) + (hargsNonempty : args ≠ []) + (hsourceBound : sourceLimit < limit) + (hsource : IxIR0.ProjectionSafe.Spine sourceCtx sourceLimit sourceEnv + (.var index) args sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.var index) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfTraceProgressAvailableBelow funRel recSelfRel + sourceCtx ctx cur limit input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + cases hsource with + | @intro headFuel sourceFunction _ _ _ sourceArgs hheadBound hhead + hsourceArgs hsourceApply => + have hsourceArgsNonempty : sourceArgs ≠ [] := by + intro hnil + have hargsLengthZero : args.length = 0 := by + simpa [hnil] using hsourceArgs.lengths + exact hargsNonempty (List.eq_nil_of_length_eq_zero hargsLengthZero) + obtain ⟨functionOutput, emitFunction, function, middleState, + hfunctionRun, hrestRun⟩ := + lowerSpine_var_dynamic_run_inv hnotSelf hrun + have hfunctionExtends : ExtraExtends middleState ambient := + (applyRest_extraExtends hrestRun).trans hextends + have hheadOuter : headFuel < limit := + Nat.lt_of_le_of_lt hheadBound hsourceBound + have hfunctionProgress := + hexpr hheadOuter hhead hfunctionRun hfunctionExtends havailable + have hfunctionAvailable := havailable.lowerE hfunctionRun + by_cases herased : function = .constA .erased + · have hsourceErased : sourceFunction = .erased := + hreflect hhead.run hfunctionRun herased + subst sourceFunction + have hresult : sourceResult = .erased := + (SourceAppliesSafelyBelow.sourceApplies hsourceApply).deterministic + (SourceApplies.erased sourceCtx sourceArgs) + subst sourceResult + subst function + exact applyRest_erased_run_value_trace_progress_within_below hargs + hsourceBound hsourceArgs hfunctionProgress hrestRun hextends + hfunctionAvailable + · exact hrest hsourceBound herased hsourceArgs hsourceApply + hsourceArgsNonempty hfunctionProgress hrestRun hextends + hfunctionAvailable + +/-- One complete exact-trace reachable-state spine progress step. -/ +theorem lowerSpine_run_value_trace_progress_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hspine : LowerSpineValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient (fuel + 1)) + (hexpr : LowerEValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrestNext : ApplyRestNonErasedValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerTraceProgressContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + {input output : VEnv} {world : Owned} {sourceLimit : Nat} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} + (hsourceBound : sourceLimit < limit) + (hsource : IxIR0.ProjectionSafe.Spine sourceCtx sourceLimit sourceEnv + head args sourceResult) + (hcallable : args ≠ [] ∨ ∃ targetAddress, + head = .ref targetAddress) + (hrun : (lowerSpine src (fuel + 2) input world head args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfTraceProgressAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + have hargsNonempty (hnotRef : ¬ ∃ targetAddress, + head = IxIR0.Expr.ref targetAddress) : args ≠ [] := + Or.resolve_right hcallable hnotRef + cases head with + | app function argument => + apply hspine hsourceBound hsource.flattenApp + · exact Or.inl (by simp) + · simpa [lowerSpine] using hrun + · exact hextends + · exact havailable + | erased => + exact lowerSpine_erased_run_value_trace_progress_within_below hargs + hsourceBound hsource hrun hextends havailable + | var index => + cases hentry : input.entries[index]? with + | none => + exact lowerSpine_var_dynamic_run_value_trace_progress_within_below + hexpr hreflect hargs hrestNext (fun arity => by simp [hentry]) + (hargsNonempty (by simp)) hsourceBound hsource hrun hextends + havailable + | some entry => + cases entry with + | recSelf arity => + cases havailable with + | inl hself => + exact lowerSpine_recSelf_run_value_trace_progress_within_below + hargs hrest hsourceBound hentry hself hsource hrun hextends + (SelfTraceProgressAvailableBelow.of_contract hself) + | inr hno => exact (hno index arity hentry).elim + | slot abs remaining uses held => + exact lowerSpine_var_dynamic_run_value_trace_progress_within_below + hexpr hreflect hargs hrestNext (fun arity => by simp [hentry]) + (hargsNonempty (by simp)) hsourceBound hsource hrun hextends + havailable + | ref address => + exact lowerSpine_ref_run_value_trace_progress_within_below henv hargs + hrest hknownExtra hcontracts hvalues hprogress hsourceBound hsource + hrun hextends hrepresented havailable + | lam uses body => + exact lowerSpine_dynamic_run_value_trace_progress_within_below hexpr + hreflect hargs hrestNext (.lam uses body) (hargsNonempty (by simp)) + hsourceBound hsource hrun hextends havailable + | letE uses value body => + exact lowerSpine_dynamic_run_value_trace_progress_within_below hexpr + hreflect hargs hrestNext (.letE uses value body) + (hargsNonempty (by simp)) hsourceBound hsource hrun hextends havailable + | proj index value => + exact lowerSpine_dynamic_run_value_trace_progress_within_below hexpr + hreflect hargs hrestNext (.proj index value) (hargsNonempty (by simp)) + hsourceBound hsource hrun hextends havailable + | lit literal => + exact lowerSpine_dynamic_run_value_trace_progress_within_below hexpr + hreflect hargs hrestNext (.lit literal) (hargsNonempty (by simp)) + hsourceBound hsource hrun hextends havailable + +/-- Reachable-state erased application progress. Every argument is evaluated +and its shared temporary owner is then released before returning erased. -/ + +theorem applyRest_erased_run_value_settlement_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hargs : LowerArgsValueSettlesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + {start input output : VEnv} + {sourceStart sourceMiddle sourceArgs : List IxIR0.Value} + {resultWorld : Owned} {emitFunction emit : Emit} + {args : List IxIR0.Expr} {av : AVal} + {state finalState : LowSt} + (hsourceArgs : SourceArgsEval sourceCtx sourceMiddle args sourceArgs) + (hfunction : LowerResultValueSettlement funRel recSelfRel ctx cur + start input sourceStart sourceMiddle .erased .shared emitFunction + (.constA .erased)) + (hrun : (applyRest src (fuel + 1) input resultWorld emitFunction + (.constA .erased) args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueSettlement funRel recSelfRel ctx cur start output + sourceStart sourceMiddle .erased resultWorld emit av := by + simp only [applyRest] at hrun + obtain ⟨argsResult, argsState, hargsRun, hpureRun⟩ := + trackedBindRun_ok_inv hrun + rcases argsResult with ⟨argsOutput, emitArgs, avs⟩ + have hpure : + ((releaseAll argsOutput avs).1, + (emitFunction ∘ emitArgs) ∘ (releaseAll argsOutput avs).2, + AVal.constA .erased) = (output, emit, av) ∧ + argsState = finalState := by + simpa [Function.comp_def] using hpureRun + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + have hsourcePaired : SourceArgsEval sourceCtx sourceMiddle + ((args.map (fun arg => (arg, Owned.shared))).map Prod.fst) + sourceArgs := by + simpa [Function.comp_def] using hsourceArgs + have hargsProgress := hargs hsourcePaired hargsRun hextends havailable + have havsLength : avs.length = args.length := by + simpa using lowerArgs_success_length src hargsRun + have hworldsHomogeneous : + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate avs.length .shared := by + simpa [havsLength] using map_shared_arg_worlds args + have hhomogeneous : LowerArgsValueSettlement funRel recSelfRel ctx cur + input argsOutput sourceMiddle sourceMiddle sourceArgs + (List.replicate avs.length .shared) emitArgs avs := by + simpa [hworldsHomogeneous] using hargsProgress + have hsourceLength : sourceArgs.length = avs.length := by + rw [← hsourceArgs.lengths, ← havsLength] + simpa [Function.comp_def] using + hfunction.discardArgs hhomogeneous hsourceLength + +/-- An erased spine head progresses through argument evaluation and total +temporary release. -/ +theorem lowerSpine_erased_run_value_settlement_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hargs : LowerArgsValueSettlesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + {input output : VEnv} {world : Owned} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hsource : SourceSpineEval sourceCtx sourceEnv .erased args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world .erased args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueSettlement funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + apply hsource.eliminate + · intro headValue argumentValues hhead harguments happlies + obtain ⟨_, hhead⟩ := hhead + have herasedEval : IxIR0.eval sourceCtx 1 sourceEnv .erased = + .ok .erased := by + simp [IxIR0.eval] + have hheadValue : headValue = .erased := + sourceEval_ok_unique hhead herasedEval + subst headValue + have hresult : sourceResult = .erased := + happlies.deterministic (SourceApplies.erased sourceCtx argumentValues) + subst sourceResult + apply applyRest_erased_run_value_settlement_within hargs harguments + (lower_erased_value_progress (funRel := funRel) + (recSelfRel := recSelfRel) (ctx := ctx) (cur := cur) + (sourceEnv := sourceEnv) (world := .shared)).settlement + · simpa [lowerSpine] using hrun + · exact hextends + · exact havailable + +/-- Reachable-state recursive-self spine progress. Realizable self markers +cannot advertise a mismatched target arity because their source-guided body +progress contract carries the current function's arity equation. -/ +theorem lowerSpine_recSelf_run_value_settlement_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValueSettlesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueSettlesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + {input output : VEnv} {world : Owned} {index arity : Nat} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hentry : input.entries[index]? = some (.recSelf arity)) + (hself : CurrentSelfProgressContract funRel recSelfRel sourceCtx ctx cur) + (hsource : SourceSpineEval sourceCtx sourceEnv (.var index) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.var index) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueSettlement funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + apply hsource.eliminate + · intro sourceFunction sourceValues hhead hsourceArgs hsourceApply + obtain ⟨sourceFuel, hhead⟩ := hhead + have hsourceHead : sourceEnv[index]? = some sourceFunction := + sourceEval_var_inv hhead + simp only [lowerSpine] at hrun + rw [hentry] at hrun + simp only at hrun + by_cases hunder : args.length < arity + · rw [if_pos hunder] at hrun + exact (trackedThrowRun_not_ok hrun).elim + · rw [if_neg hunder] at hrun + have hcount : arity ≤ args.length := Nat.le_of_not_gt hunder + cases world with + | unique => + have hrequire : + (requireResultWorld .shared .unique).run state = + .error "call result is shared at unique demand" state := by + rfl + rw [estateBindRun, hrequire] at hrun + contradiction + | shared => + have hrequire : + (requireResultWorld .shared .shared).run state = .ok () state := by + rfl + rw [estateBindRun, hrequire] at hrun + simp only at hrun + exact knownCall_callSelf_current_run_value_settlement_within + hargs hrest hcount hentry hsourceHead hself hsourceArgs + hsourceApply hrun hextends havailable + +/-- Dynamic spine progress lowers the function expression, reflects the +erased descriptor when necessary, and otherwise consumes higher-order apply +progress for the argument tail. -/ +theorem lowerSpine_dynamic_run_value_settlement_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEValueSettlesWithin funRel recSelfRel sourceCtx ctx cur + src ambient (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsValueSettlesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueSettlesWithin funRel recSelfRel + sourceCtx ctx cur src ambient (fuel + 1)) + {input output : VEnv} {world : Owned} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hshape : DynamicSpineHead head) + (hsource : SourceSpineEval sourceCtx sourceEnv head args sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world head args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueSettlement funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + apply hsource.eliminate + · intro sourceFunction sourceArgs hhead hsourceArgs hsourceApply + obtain ⟨sourceFuel, hhead⟩ := hhead + obtain ⟨functionOutput, emitFunction, function, middleState, + hfunctionRun, hrestRun⟩ := + lowerSpine_dynamic_run_inv hshape hrun + have hfunctionExtends : ExtraExtends middleState ambient := + (applyRest_extraExtends hrestRun).trans hextends + have hfunctionProgress := + hexpr hhead hfunctionRun hfunctionExtends havailable + have hfunctionAvailable := havailable.lowerE hfunctionRun + by_cases herased : function = .constA .erased + · have hsourceErased : sourceFunction = .erased := + hreflect hhead hfunctionRun herased + subst sourceFunction + have hresult : sourceResult = .erased := + hsourceApply.deterministic + (SourceApplies.erased sourceCtx sourceArgs) + subst sourceResult + subst function + exact applyRest_erased_run_value_settlement_within hargs hsourceArgs + hfunctionProgress hrestRun hextends hfunctionAvailable + · exact hrest herased hsourceArgs hsourceApply hfunctionProgress + hrestRun hextends hfunctionAvailable + +/-- Variable dynamic heads use the dedicated inversion that excludes the +synthetic recursive-self lowering branch. -/ +theorem lowerSpine_var_dynamic_run_value_settlement_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEValueSettlesWithin funRel recSelfRel sourceCtx ctx cur + src ambient (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsValueSettlesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueSettlesWithin funRel recSelfRel + sourceCtx ctx cur src ambient (fuel + 1)) + {input output : VEnv} {world : Owned} {index : Nat} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hnotSelf : ∀ arity, + input.entries[index]? ≠ some (.recSelf arity)) + (hsource : SourceSpineEval sourceCtx sourceEnv (.var index) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.var index) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueSettlement funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + apply hsource.eliminate + · intro sourceFunction sourceArgs hhead hsourceArgs hsourceApply + obtain ⟨sourceFuel, hhead⟩ := hhead + obtain ⟨functionOutput, emitFunction, function, middleState, + hfunctionRun, hrestRun⟩ := + lowerSpine_var_dynamic_run_inv hnotSelf hrun + have hfunctionExtends : ExtraExtends middleState ambient := + (applyRest_extraExtends hrestRun).trans hextends + have hfunctionProgress := + hexpr hhead hfunctionRun hfunctionExtends havailable + have hfunctionAvailable := havailable.lowerE hfunctionRun + by_cases herased : function = .constA .erased + · have hsourceErased : sourceFunction = .erased := + hreflect hhead hfunctionRun herased + subst sourceFunction + have hresult : sourceResult = .erased := + hsourceApply.deterministic + (SourceApplies.erased sourceCtx sourceArgs) + subst sourceResult + subst function + exact applyRest_erased_run_value_settlement_within hargs hsourceArgs + hfunctionProgress hrestRun hextends hfunctionAvailable + · exact hrest herased hsourceArgs hsourceApply hfunctionProgress + hrestRun hextends hfunctionAvailable + +/-- One complete reachable-state spine progress step. All recursive calls +are constrained to the ambient whole-pass state, matching the partial +correctness cluster's fuel decomposition. -/ +theorem lowerSpine_run_value_settlement_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hspine : LowerSpineValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hexpr : LowerEValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrestNext : ApplyRestNonErasedValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {input output : VEnv} {world : Owned} {head : IxIR0.Expr} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + (hsource : SourceSpineEval sourceCtx sourceEnv head args sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world head args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSettlement (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + cases head with + | app function argument => + apply hspine hsource.flattenApp + · simpa [lowerSpine] using hrun + · exact hextends + · exact havailable + | erased => + exact lowerSpine_erased_run_value_settlement_within hargs hsource hrun + hextends havailable + | var index => + cases hentry : input.entries[index]? with + | none => + exact lowerSpine_var_dynamic_run_value_settlement_within hexpr hreflect + hargs hrestNext (fun arity => by simp [hentry]) hsource hrun + hextends havailable + | some entry => + cases entry with + | recSelf arity => + cases havailable with + | inl hself => + exact lowerSpine_recSelf_run_value_settlement_within hargs hrest + hentry hself hsource hrun hextends + (SelfProgressAvailable.of_contract hself) + | inr hno => exact (hno index arity hentry).elim + | slot abs remaining uses held => + exact lowerSpine_var_dynamic_run_value_settlement_within hexpr + hreflect hargs hrestNext (fun arity => by simp [hentry]) + hsource hrun hextends havailable + | ref address => + exact lowerSpine_ref_run_value_settlement_within henv hargs hrest + hknownExtra hcontracts hvalues hprogress hsource hrun hextends + hrepresented havailable + | lam uses body => + exact lowerSpine_dynamic_run_value_settlement_within hexpr hreflect hargs + hrestNext (.lam uses body) hsource hrun hextends havailable + | letE uses value body => + exact lowerSpine_dynamic_run_value_settlement_within hexpr hreflect hargs + hrestNext (.letE uses value body) hsource hrun hextends havailable + | proj index value => + exact lowerSpine_dynamic_run_value_settlement_within hexpr hreflect hargs + hrestNext (.proj index value) hsource hrun hextends havailable + | lit literal => + exact lowerSpine_dynamic_run_value_settlement_within hexpr hreflect hargs + hrestNext (.lit literal) hsource hrun hextends havailable + +/-- Package the complete spine rule as the two-step recursive-interface +constructor dictated by `lowerSpine`'s compiler-fuel accounting. -/ +theorem lowerSpineValueProgressesWithin_succ_succ + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (henv : sourceCtx.env = src) + (hspine : LowerSpineValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hexpr : LowerEValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrestNext : ApplyRestNonErasedValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hrepresented : ExtraRepresented ctx ambient) : + LowerSpineValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 2) := by + intro input output world head args sourceEnv sourceResult state finalState + emit av hsource hrun hextends havailable + exact lowerSpine_run_value_progress_within henv hspine hexpr hreflect + hargs hrest hrestNext hknownExtra hcontracts hvalues hprogress hsource + hrun hextends hrepresented havailable + +/-- Package the complete spine rule as the two-step recursive-interface +constructor dictated by `lowerSpine`'s compiler-fuel accounting. -/ +theorem lowerSpineValueProgressesSafelyWithin_succ_succ + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (henv : sourceCtx.env = src) + (hspine : LowerSpineValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hexpr : LowerEValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrestNext : ApplyRestNonErasedValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hrepresented : ExtraRepresented ctx ambient) : + LowerSpineValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 2) := by + intro input output world head args sourceEnv sourceResult state finalState + emit av hsource hrun hextends havailable + exact lowerSpine_run_value_progress_safely_within henv hspine hexpr hreflect + hargs hrest hrestNext hknownExtra hcontracts hvalues hprogress hsource + hrun hextends hrepresented havailable + +/-- Package the complete spine rule as the two-step recursive-interface +constructor dictated by `lowerSpine`'s compiler-fuel accounting. -/ + +theorem lowerSpineValueSettlesWithin_succ_succ + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (henv : sourceCtx.env = src) + (hspine : LowerSpineValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hexpr : LowerEValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrestNext : ApplyRestNonErasedValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hrepresented : ExtraRepresented ctx ambient) : + LowerSpineValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 2) := by + intro input output world head args sourceEnv sourceResult state finalState + emit av hsource hrun hextends havailable + exact lowerSpine_run_value_settlement_within henv hspine hexpr hreflect + hargs hrest hrestNext hknownExtra hcontracts hvalues hprogress hsource + hrun hextends hrepresented havailable + +/-- Standalone source references inherit static-spine progress through the +empty-argument lowering correspondence. -/ +theorem lowerE_ref_run_value_progress_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hargs : LowerArgsValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hrest : ApplyRestNonErasedValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 2)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + (hsource : IxIR0.eval sourceCtx sourceFuel sourceEnv (.ref f) = + .ok sourceResult) + (hrun : (lowerE src (fuel + 1) input world (.ref f)).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + apply lowerSpine_ref_run_value_progress_within henv hargs hrest + hknownExtra hcontracts hvalues hprogress + (SourceSpineEval.of_eval_nil hsource) + · exact lowerE_ref_run_to_lowerSpine_nil hrun + · exact hextends + · exact hrepresented + · exact havailable + +/-- Projection-safe standalone references inherit static-spine progress +through the empty-argument lowering correspondence. -/ +theorem lowerE_ref_run_value_progress_safely_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hargs : LowerArgsValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hrest : ApplyRestNonErasedValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 2)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} + (hsource : ProjectionSafeEval sourceCtx sourceEnv (.ref f) + sourceResult) + (hrun : (lowerE src (fuel + 1) input world (.ref f)).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + apply lowerSpine_ref_run_value_progress_safely_within henv hargs hrest + hknownExtra hcontracts hvalues hprogress + (ProjectionSafeSpine.of_eval_nil hsource) + · exact lowerE_ref_run_to_lowerSpine_nil hrun + · exact hextends + · exact hrepresented + · exact havailable + +/-- Standalone source references inherit static-spine progress through the +empty-argument lowering correspondence. -/ +theorem lowerE_ref_run_value_settlement_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hargs : LowerArgsValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hrest : ApplyRestNonErasedValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 2)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + (hsource : IxIR0.eval sourceCtx sourceFuel sourceEnv (.ref f) = + .ok sourceResult) + (hrun : (lowerE src (fuel + 1) input world (.ref f)).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSettlement (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + apply lowerSpine_ref_run_value_settlement_within henv hargs hrest + hknownExtra hcontracts hvalues hprogress + (SourceSpineEval.of_eval_nil hsource) + · exact lowerE_ref_run_to_lowerSpine_nil hrun + · exact hextends + · exact hrepresented + · exact havailable + +/-- A successful lambda-capture step has target progress. The compiler can +only move the final shared occurrence or retain a shared occurrence that is +needed again after the lifted lambda has consumed its uses. -/ +theorem lowerCapture_run_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {e : IxIR0.Expr} {input output : VEnv} {i : Nat} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsource : sourceEnv[i]? = some sourceValue) + (hrun : (lowerCapture e input i).run state = + .ok (output, emit, av) finalState) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue .shared emit av := by + apply lowerCapture_run_core + (Result := fun output emit av => + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue .shared emit av) + (hrun := hrun) + · intro abs remaining uses hshared hentry + let next := input.setEntry i + (.slot abs (remaining - countUses i e) uses true) + have hprogress := lower_held_retain_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) + (newRemaining := remaining - countUses i e) + hsource hshared hentry + simpa [next] using hprogress + · intro abs remaining uses hshared hentry + let next := input.setEntry i (.slot abs 0 uses false) + have hprogress := lower_held_move_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) hsource hentry + simpa [next, hshared] using hprogress +/-- The recursive capture traversal progresses through its homogeneous +shared argument prefix in source-selection order. -/ +theorem lowerCaptures_run_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + (e : IxIR0.Expr) (caps : List Nat) + {sourceEnv sourceValues : List IxIR0.Value} + {input output : VEnv} {emit : Emit} {values : List AVal} + {state finalState : LowSt} + (hselected : ValuesAt sourceEnv caps sourceValues) + (hrun : (lowerCaptures e input caps).run state = + .ok (output, emit, values) finalState) : + LowerArgsValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValues + (List.replicate caps.length .shared) emit values := by + apply ValuesAt.lowerCaptures_core + (e := e) (hselected := hselected) (hrun := hrun) + · intro input + exact lowerArgs_nil_value_progress + · intro index sourceValue rest sourceValues input middle output + headEmit tailEmit headValue tailValues state middleState + hsource hheadRun htail + have hhead := lowerCapture_run_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) hsource hheadRun + simpa [List.replicate_succ] using hhead.consArgs htail + +/-- Successful local-lambda lowering progresses through capture sequencing +and the fresh partial-application allocation. The generated body run records +compiler provenance; it does not execute at the lambda site. -/ +theorem lowerLam_run_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {e : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsourceLength : sourceEnv.length = input.entries.length) + (hprefix : LambdaPrefix sourceEnv e [] sourceValue) + (hinclude : ∀ value address arity captures, + CompilerLiftedFunctionRel src finalState value address arity captures → + funRel value address arity captures) + (hrepresented : ExtraRepresented ctx finalState) + (hrun : (lowerLam src fuel input e).run state = + .ok (output, emit, av) finalState) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue .shared emit av := by + apply lowerLam_run_value_core + (ArgsResult := fun selected captureOutput captureEmit captureValues => + LowerArgsValueProgress funRel recSelfRel ctx cur + input captureOutput sourceEnv sourceEnv selected + (List.replicate captureValues.length .shared) + captureEmit captureValues) + (Result := fun _ output emit av => + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue .shared emit av) + (hsourceLength := hsourceLength) (hprefix := hprefix) + (hinclude := hinclude) (hrepresented := hrepresented) (hrun := hrun) + · intro caps selected captureOutput captureEmit captureValues + _captureState _hcanonical hselected hcaptureRun hlength + have hcaptures := lowerCaptures_run_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) e caps hselected hcaptureRun + simpa [hlength] using hcaptures + · intro _caps _selected _captureOutput _captureEmit _captureValues + _fnAddr _code _bodyState _hcanonical hargs hdecl hfun hunder + apply hargs.papp_graph hdecl + · simpa only [declArity] using hfun + · simpa only [declArity] using hunder + +/-- The lambda branch of expression lowering progresses whenever its source +environment has the logical length needed for capture selection. -/ +theorem lowerE_lam_run_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Owned} {uses : Uses} + {body : IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsourceLength : sourceEnv.length = input.entries.length) + (hinclude : ∀ value address arity captures, + CompilerLiftedFunctionRel src finalState value address arity captures → + funRel value address arity captures) + (hrepresented : ExtraRepresented ctx finalState) + (hrun : (lowerE src (fuel + 1) input world (.lam uses body)).run state = + .ok (output, emit, av) finalState) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv (.clos uses sourceEnv body) world emit av := by + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (trackedThrowRun_not_ok (by + simpa [lowerE, huuEq] using hrun)).elim + | shared => + have hlam : (lowerLam src fuel input (.lam uses body)).run state = + .ok (output, emit, av) finalState := by + simpa [lowerE, hsuEq] using hrun + exact lowerLam_run_value_progress hsourceLength .nil hinclude + hrepresented hlam + +/-- Premise-free lambda progress at the expression interface. A realizable +input supplies the capture-selection length equality; malformed inputs have +an empty graph-owned precondition. -/ +theorem lowerE_lam_run_value_progress_any + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Owned} {uses : Uses} + {body : IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hinclude : ∀ value address arity captures, + CompilerLiftedFunctionRel src finalState value address arity captures → + funRel value address arity captures) + (hrepresented : ExtraRepresented ctx finalState) + (hrun : (lowerE src (fuel + 1) input world (.lam uses body)).run state = + .ok (output, emit, av) finalState) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv (.clos uses sourceEnv body) world emit av := by + by_cases hlength : sourceEnv.length = input.entries.length + · exact lowerE_lam_run_value_progress hlength hinclude hrepresented hrun + · have hsound : LowerResultSound ctx cur input output world emit av := + LowerResultSound.of_below (fun limit => + lowerE_lam_run_sound_below (limit := limit) hrepresented hrun) + exact hsound.valueProgress_of_sourceLength_ne hlength + +theorem emit_dropU_value_progress {ctx : Ctx} {cur : FnDef} + {frame : List RVal → Prop} {target : Atom} {value : RVal} + {rest : List Root} : + EmitProgress ctx cur (emitOp (.dropU target)) + (fun store env => frame env ∧ resolveAtom env target = .ok value ∧ + RootOwnership store (⟨.unique, value⟩ :: rest)) + (OwnsAfterPush frame rest) := by + apply OpProgress.emit + intro store env hpre + obtain ⟨hframe, hresolve, hown⟩ := hpre + cases value with + | lit literal => + have hrun : runOp ctx 1 cur store env (.dropU target) = + .ok (store, .erased) := by + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + exact ⟨1, store, .erased, hrun, + ⟨.erased, env, rfl, hframe, hown.dropNoLocation rfl⟩⟩ + | erased => + have hrun : runOp ctx 1 cur store env (.dropU target) = + .ok (store, .erased) := by + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + exact ⟨1, store, .erased, hrun, + ⟨.erased, env, rfl, hframe, hown.dropNoLocation rfl⟩⟩ + | loc loc => + obtain ⟨fuel, store', hdrop, hown'⟩ := dropUVal_progress hown + have hrun := runOp_dropU (ctx := ctx) (cur := cur) (fuel := fuel) + hresolve hdrop + exact ⟨fuel + 1, store', .erased, hrun, + ⟨.erased, env, rfl, hframe, hown'⟩⟩ + +theorem emit_free_progress {ctx : Ctx} {cur : FnDef} + {frame : List RVal → Prop} {target : Atom} {loc : Nat} + {node : Node} {rest : List Root} : + EmitProgress ctx cur (emitOp (.free target)) + (fun store env => frame env ∧ + resolveAtom env target = .ok (.loc loc) ∧ + store.get? loc = some ⟨.unique, 1, node⟩ ∧ + RootOwnership store (⟨.unique, .loc loc⟩ :: rest)) + (OwnsAfterPush frame (rootsFor .unique (nodeChildren node) ++ rest)) := by + apply OpProgress.emit + intro store env hpre + obtain ⟨hframe, hresolve, hbox, hown⟩ := hpre + have hop := runOp_free_owned (ctx := ctx) (cur := cur) (fuel := 0) + hresolve hbox hown + exact ⟨1, store.kill loc, .erased, hop.1, + ⟨.erased, env, rfl, hframe, hop.2⟩⟩ + +theorem emit_fetch_borrowed_progress {ctx : Ctx} {cur : FnDef} + {frame : List RVal → Prop} {target : Atom} {loc rc i : Nat} + {cid : CtorId} {fields : Array RVal} {value : RVal} + {roots : List Root} (hfield : fields[i]? = some value) : + EmitProgress ctx cur (emitOp (.fetch target i)) + (fun store env => frame env ∧ + resolveAtom env target = .ok (.loc loc) ∧ + store.get? loc = some ⟨.shared, rc, .ctorN cid fields⟩ ∧ + RootOwnership store roots) + (BorrowsPushed frame .shared roots) := by + apply OpProgress.emit + intro store env hpre + obtain ⟨hframe, hresolve, hbox, hown⟩ := hpre + have hop := runOp_fetch_borrowed (ctx := ctx) (cur := cur) (fuel := 0) + hresolve hbox hfield hown + exact ⟨1, store, value, hop.1, + ⟨value, env, rfl, hframe, hop.2, hown⟩⟩ + +/-- Extern progress needs an explicit successful target oracle witness; the +partial-correctness extern rule cannot manufacture one. -/ +theorem emit_extern_progress {ctx : Ctx} {cur : FnDef} + {f : Ixon.Address} {frame : List RVal → Prop} + {atoms : Array Atom} {args : List RVal} {result : RVal} + {resultWorld : Owned} {rest : List Root} : + EmitProgress ctx cur (emitOp (.extern f atoms)) + (fun store env => frame env ∧ resolveAtoms env atoms = .ok args ∧ + callScalarOracle ctx f args = .ok result ∧ + RootOwnership store (rootsFor .shared args ++ rest)) + (OwnsPushedRoot frame resultWorld rest) := by + apply OpProgress.emit + intro store env hpre + obtain ⟨hframe, hargs, horacle, hown⟩ := hpre + have hrun : runOp ctx 1 cur store env (.extern f atoms) = + .ok (store, result) := by + rw [runOp.eq_def] + dsimp only + rw [hargs, bindOk, horacle, bindOk] + have hresult := runOp_extern_owned (ctx := ctx) (cur := cur) + (fuel := 0) (resultWorld := resultWorld) hargs hown hrun + exact ⟨1, store, result, hrun, + ⟨result, env, rfl, hframe, hresult⟩⟩ + +/-! ## Constructor-projection progress -/ + +/-- A graph-related constructor slot has a total in-bounds `fetch`, provided +the function relation cannot also classify that constructor as a pap. -/ +theorem fetchBorrowSlot_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {address : Ixon.Address} + {tag : Nat} {sourceFields : List IxIR0.Value} + {sourceField : IxIR0.Value} {targetAbs index : Nat} + {release : Bool} {sourceRest : List (Owned × IxIR0.Value)} + {rest : List Root} {slots : List (Nat × RVal)} + (hnotFunction : ∀ f arity captures, + ¬ funRel (.ctor address tag sourceFields) f arity captures) + (hsourceField : sourceFields[index]? = some sourceField) : + EmitProgress ctx cur + (emitOp (.fetch (.var (Γ.rel targetAbs)) index)) + (GraphOwnsBorrowResultProtected funRel recSelfRel Γ sourceEnv + (.ctor address tag sourceFields) (.slotA targetAbs) release + sourceRest rest slots) + (GraphOwnsFetchedBorrowProtected funRel recSelfRel Γ.bump sourceEnv + (.ctor address tag sourceFields) sourceField + (.slotA targetAbs) (.slotA Γ.depth) release + sourceRest rest slots) := by + apply OpProgress.emit + intro store env hpre + obtain ⟨roots, targetValue, hΓ, htarget, htargetWorld, + htargetGraph, hrestGraph, hown, hslots⟩ := hpre + have hresolve : + resolveAtom env (.var (Γ.rel targetAbs)) = .ok targetValue := by + simpa [AVal.toAtom] using htarget.resolveAtom + cases htargetGraph with + | @ctor _ _ _ loc boxWorld rc cid fields hget hblock htag hfieldsGraph => + obtain ⟨box, hworldGet, hboxWorld⟩ := htargetWorld + have hboxEq : + (⟨boxWorld, rc, .ctorN cid fields⟩ : NodeBox) = box := + Option.some.inj (hget.symm.trans hworldGet) + subst box + dsimp only [NodeBox.world] at hboxWorld + subst boxWorld + obtain ⟨fieldValue, hfieldList, hfieldGraph⟩ := + hfieldsGraph.get? hsourceField + have hfield : fields[index]? = some fieldValue := by + simpa using hfieldList + have hop := runOp_fetch_borrowed + (ctx := ctx) (cur := cur) (fuel := 0) + hresolve hget hfield hown + refine ⟨1, store, fieldValue, hop.1, roots, .loc loc, fieldValue, + hΓ.bump fieldValue, + AValStable.slot.realize_bump htarget fieldValue, ?_, + ⟨⟨.shared, rc, .ctorN cid fields⟩, hget, rfl⟩, hop.2, + ?_, hfieldGraph, + hrestGraph, hown, hslots.bump fieldValue⟩ + · apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + · exact .ctor hget hblock htag hfieldsGraph + | @function _ f arity captures loc rc args hget hrel hcaptures => + exact (hnotFunction f arity captures hrel).elim + +/-- Retaining a fetched field is total because the borrow graph supplies its +shared-world witness; the RC-only update preserves every graph in the frame. -/ +theorem retainFetchedBorrow_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} + {sourceTarget sourceField : IxIR0.Value} + {targetAbs fieldAbs : Nat} {release : Bool} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + {slots : List (Nat × RVal)} : + EmitProgress ctx cur + (emitOp (.dup (.var (Γ.rel fieldAbs)))) + (GraphOwnsFetchedBorrowProtected funRel recSelfRel Γ sourceEnv + sourceTarget sourceField (.slotA targetAbs) (.slotA fieldAbs) + release sourceRest rest slots) + (GraphOwnsRetainedProjectionProtected funRel recSelfRel Γ.bump + sourceEnv sourceTarget sourceField (.slotA targetAbs) + (.slotA Γ.depth) release sourceRest rest slots) := by + apply OpProgress.emit + intro store env hpre + obtain ⟨roots, targetValue, fieldValue, hΓ, htarget, hfield, + htargetWorld, hfieldWorld, htargetGraph, hfieldGraph, + hrestGraph, hown, hslots⟩ := hpre + have hresolve : + resolveAtom env (.var (Γ.rel fieldAbs)) = .ok fieldValue := by + simpa [AVal.toAtom] using hfield.resolveAtom + obtain ⟨nextStore, hrun, hstore, hfieldGraphNext, hownNext⟩ := + runOp_retain_borrowed_valueGraph + (ctx := ctx) (cur := cur) (fuel := 0) + hresolve hfieldWorld hfieldGraph hown + refine ⟨1, nextStore, fieldValue, hrun, roots, targetValue, + fieldValue, (hΓ.monoStore hstore).bump fieldValue, + AValStable.slot.realize_bump htarget fieldValue, ?_, + htargetWorld.monoStore hstore, htargetGraph.monoStore hstore, + hfieldGraphNext, hrestGraph.monoStore hstore, + hownNext, hslots.bump fieldValue⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +/-- A retained field whose target remains live is already a complete shared +projection result. -/ +theorem retainedProjection_kept_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} + {sourceTarget sourceField : IxIR0.Value} + {target result : AVal} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + {slots : List (Nat × RVal)} : + EmitProgress ctx cur (_root_.id : Emit) + (GraphOwnsRetainedProjectionProtected funRel recSelfRel Γ + sourceEnv sourceTarget sourceField target result false + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel Γ + sourceEnv sourceField .shared result sourceRest rest slots) := by + apply EmitProgress.strengthen + intro store env hpre + obtain ⟨roots, targetValue, resultValue, hΓ, htarget, hresult, + htargetWorld, htargetGraph, hresultGraph, hrestGraph, + hown, hslots⟩ := hpre + refine ⟨⟨roots, resultValue, hΓ, hresult, hresultGraph, + hrestGraph, ?_⟩, hslots⟩ + simpa [borrowResultRoots] using hown + +/-- After retaining a final-use field, the target's shared owner can always +be dropped; reverse graph restriction preserves the result and caller frame. -/ +theorem releaseRetainedProjection_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} + {sourceTarget sourceField : IxIR0.Value} + {targetAbs resultAbs : Nat} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + {slots : List (Nat × RVal)} : + EmitProgress ctx cur + (emitOp (.drop (.var (Γ.rel targetAbs)))) + (GraphOwnsRetainedProjectionProtected funRel recSelfRel Γ + sourceEnv sourceTarget sourceField (.slotA targetAbs) + (.slotA resultAbs) true sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel Γ.bump + sourceEnv sourceField .shared (.slotA resultAbs) + sourceRest rest slots) := by + apply OpProgress.emit + intro store env hpre + obtain ⟨roots, targetValue, resultValue, hΓ, htarget, hresult, + htargetWorld, htargetGraph, hresultGraph, hrestGraph, + hown, hslots⟩ := hpre + have hresolve : + resolveAtom env (.var (Γ.rel targetAbs)) = .ok targetValue := by + simpa [AVal.toAtom] using htarget.resolveAtom + let remainingRoots := + ⟨Owned.shared, resultValue⟩ :: roots ++ rest + have howned : RootOwnership store + (⟨.shared, targetValue⟩ :: remainingRoots) := by + apply hown.perm + simpa [remainingRoots, borrowResultRoots] using + (List.Perm.swap ⟨Owned.shared, targetValue⟩ + ⟨Owned.shared, resultValue⟩ (roots ++ rest)) + have hfinish {store' : Store} + (hrestrict : Sim.StoreGraphRestricts store store') + (hownAfter : RootOwnership store' remainingRoots) : + GraphOwnsResultProtected funRel recSelfRel Γ.bump + sourceEnv sourceField .shared (.slotA resultAbs) + sourceRest rest slots store' (.erased :: env) := by + have hresultWorld : HasWorld store' .shared resultValue := + hownAfter.roots_world ⟨.shared, resultValue⟩ + (by simp [remainingRoots]) + have hΓAfter : VEnvValueGraph funRel recSelfRel store' + Γ sourceEnv env roots := + hΓ.ofRestricts hrestrict hownAfter + (fun root hmember => by + simp [remainingRoots, hmember]) + have hresultAfter : Sim.ValueGraph funRel store' + sourceField resultValue := + hresultGraph.ofRestricts hrestrict hownAfter hresultWorld + have hrestAfter : Sim.RootsGraph funRel store' + sourceRest rest := + hrestGraph.ofRestrictsIn hrestrict hownAfter + (fun root hmember => by + simp [remainingRoots, hmember]) + refine ⟨⟨roots, resultValue, hΓAfter.bump .erased, + AValStable.slot.realize_bump hresult .erased, + hresultAfter, hrestAfter, ?_⟩, hslots.bump .erased⟩ + simpa [remainingRoots] using hownAfter + cases targetValue with + | lit literal => + have hrun : runOp ctx 1 cur store env + (.drop (.var (Γ.rel targetAbs))) = .ok (store, .erased) := by + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + exact ⟨1, store, .erased, hrun, + hfinish (Sim.StoreGraphRestricts.refl store) + (howned.dropNoLocation rfl)⟩ + | erased => + have hrun : runOp ctx 1 cur store env + (.drop (.var (Γ.rel targetAbs))) = .ok (store, .erased) := by + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + exact ⟨1, store, .erased, hrun, + hfinish (Sim.StoreGraphRestricts.refl store) + (howned.dropNoLocation rfl)⟩ + | loc loc => + obtain ⟨fuel, store', hdrop, hownAfter⟩ := dropVal_progress howned + have hrun := runOp_drop (ctx := ctx) (cur := cur) (fuel := fuel) + hresolve hdrop + exact ⟨fuel + 1, store', .erased, hrun, + hfinish (Sim.dropVal_restricts hdrop) hownAfter⟩ + +/-- Progressing projection through a retained constructor slot. -/ +theorem LowerBorrowValueProgress.projectSlotKept + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {address : Ixon.Address} {tag : Nat} + {sourceFields : List IxIR0.Value} {sourceField : IxIR0.Value} + {emit : Emit} {targetAbs index : Nat} + (hprogress : LowerBorrowValueProgress funRel recSelfRel ctx cur + input output sourceInput sourceOutput + (.ctor address tag sourceFields) emit (.slotA targetAbs) false) + (hnotFunction : ∀ f arity captures, + ¬ funRel (.ctor address tag sourceFields) f arity captures) + (hsourceField : sourceFields[index]? = some sourceField) : + LowerResultValueProgress funRel recSelfRel ctx cur + input output.bump.bump sourceInput sourceOutput sourceField .shared + (emit ∘ emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth)))) + (.slotA output.bump.depth) := by + refine + { toLowerResultValueSound := + hprogress.toLowerBorrowValueSound.projectSlotKept hsourceField + graphProgress := ?_ } + intro sourceRest rest slots + have hfetch := fetchBorrowSlot_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output) + (sourceEnv := sourceOutput) (address := address) (tag := tag) + (targetAbs := targetAbs) (index := index) (release := false) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + hnotFunction hsourceField + have hretain := retainFetchedBorrow_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output.bump) + (sourceEnv := sourceOutput) + (sourceTarget := .ctor address tag sourceFields) + (sourceField := sourceField) (targetAbs := targetAbs) + (fieldAbs := output.depth) (release := false) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + have hfinish := retainedProjection_kept_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output.bump.bump) + (sourceEnv := sourceOutput) + (sourceTarget := .ctor address tag sourceFields) + (sourceField := sourceField) (target := .slotA targetAbs) + (result := .slotA output.bump.depth) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + have hcomposed := EmitProgress.comp + (hprogress.graphProgress sourceRest rest slots) + (EmitProgress.comp hfetch (EmitProgress.comp hretain hfinish)) + simpa [Function.comp_def] using hcomposed + +/-- Progressing projection through a final-use constructor slot. -/ +theorem LowerBorrowValueProgress.projectSlotReleased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {address : Ixon.Address} {tag : Nat} + {sourceFields : List IxIR0.Value} {sourceField : IxIR0.Value} + {emit : Emit} {targetAbs index : Nat} + (hprogress : LowerBorrowValueProgress funRel recSelfRel ctx cur + input output sourceInput sourceOutput + (.ctor address tag sourceFields) emit (.slotA targetAbs) true) + (hnotFunction : ∀ f arity captures, + ¬ funRel (.ctor address tag sourceFields) f arity captures) + (hsourceField : sourceFields[index]? = some sourceField) : + LowerResultValueProgress funRel recSelfRel ctx cur + input output.bump.bump.bump sourceInput sourceOutput sourceField .shared + (emit ∘ emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth))) ∘ + emitOp (.drop (.var (output.bump.bump.rel targetAbs)))) + (.slotA output.bump.depth) := by + refine + { toLowerResultValueSound := + hprogress.toLowerBorrowValueSound.projectSlotReleased hsourceField + graphProgress := ?_ } + intro sourceRest rest slots + have hfetch := fetchBorrowSlot_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output) + (sourceEnv := sourceOutput) (address := address) (tag := tag) + (targetAbs := targetAbs) (index := index) (release := true) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + hnotFunction hsourceField + have hretain := retainFetchedBorrow_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output.bump) + (sourceEnv := sourceOutput) + (sourceTarget := .ctor address tag sourceFields) + (sourceField := sourceField) (targetAbs := targetAbs) + (fieldAbs := output.depth) (release := true) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + have hfinish := releaseRetainedProjection_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output.bump.bump) + (sourceEnv := sourceOutput) + (sourceTarget := .ctor address tag sourceFields) + (sourceField := sourceField) (targetAbs := targetAbs) + (resultAbs := output.bump.depth) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + have hcomposed := EmitProgress.comp + (hprogress.graphProgress sourceRest rest slots) + (EmitProgress.comp hfetch (EmitProgress.comp hretain hfinish)) + simpa [Function.comp_def] using hcomposed + +theorem LowerBorrowValueSettlement.projectSlotKept + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {address : Ixon.Address} {tag : Nat} + {sourceFields : List IxIR0.Value} {sourceField : IxIR0.Value} + {emit : Emit} {targetAbs index : Nat} + (hsettles : LowerBorrowValueSettlement funRel recSelfRel ctx cur + input output sourceInput sourceOutput + (.ctor address tag sourceFields) emit (.slotA targetAbs) false) + (hnotFunction : ∀ f arity captures, + ¬ funRel (.ctor address tag sourceFields) f arity captures) + (hsourceField : sourceFields[index]? = some sourceField) : + LowerResultValueSettlement funRel recSelfRel ctx cur + input output.bump.bump sourceInput sourceOutput sourceField .shared + (emit ∘ emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth)))) + (.slotA output.bump.depth) := by + refine + { toLowerResultValueSound := + hsettles.toLowerBorrowValueSound.projectSlotKept hsourceField + graphSettlement := ?_ } + intro sourceRest rest slots + have hfetch := fetchBorrowSlot_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output) + (sourceEnv := sourceOutput) (address := address) (tag := tag) + (targetAbs := targetAbs) (index := index) (release := false) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + hnotFunction hsourceField + have hretain := retainFetchedBorrow_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output.bump) + (sourceEnv := sourceOutput) + (sourceTarget := .ctor address tag sourceFields) + (sourceField := sourceField) (targetAbs := targetAbs) + (fieldAbs := output.depth) (release := false) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + have hfinish := retainedProjection_kept_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output.bump.bump) + (sourceEnv := sourceOutput) + (sourceTarget := .ctor address tag sourceFields) + (sourceField := sourceField) (target := .slotA targetAbs) + (result := .slotA output.bump.depth) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + have hcomposed := EmitSettlement.comp + (hsettles.graphSettlement sourceRest rest slots) + (EmitSettlement.comp hfetch.settles + (EmitSettlement.comp hretain.settles hfinish.settles)) + simpa [Function.comp_def] using hcomposed + +theorem LowerBorrowValueSettlement.projectSlotReleased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {address : Ixon.Address} {tag : Nat} + {sourceFields : List IxIR0.Value} {sourceField : IxIR0.Value} + {emit : Emit} {targetAbs index : Nat} + (hsettles : LowerBorrowValueSettlement funRel recSelfRel ctx cur + input output sourceInput sourceOutput + (.ctor address tag sourceFields) emit (.slotA targetAbs) true) + (hnotFunction : ∀ f arity captures, + ¬ funRel (.ctor address tag sourceFields) f arity captures) + (hsourceField : sourceFields[index]? = some sourceField) : + LowerResultValueSettlement funRel recSelfRel ctx cur + input output.bump.bump.bump sourceInput sourceOutput sourceField .shared + (emit ∘ emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth))) ∘ + emitOp (.drop (.var (output.bump.bump.rel targetAbs)))) + (.slotA output.bump.depth) := by + refine + { toLowerResultValueSound := + hsettles.toLowerBorrowValueSound.projectSlotReleased hsourceField + graphSettlement := ?_ } + intro sourceRest rest slots + have hfetch := fetchBorrowSlot_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output) + (sourceEnv := sourceOutput) (address := address) (tag := tag) + (targetAbs := targetAbs) (index := index) (release := true) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + hnotFunction hsourceField + have hretain := retainFetchedBorrow_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output.bump) + (sourceEnv := sourceOutput) + (sourceTarget := .ctor address tag sourceFields) + (sourceField := sourceField) (targetAbs := targetAbs) + (fieldAbs := output.depth) (release := true) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + have hfinish := releaseRetainedProjection_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output.bump.bump) + (sourceEnv := sourceOutput) + (sourceTarget := .ctor address tag sourceFields) + (sourceField := sourceField) (targetAbs := targetAbs) + (resultAbs := output.bump.depth) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + have hcomposed := EmitSettlement.comp + (hsettles.graphSettlement sourceRest rest slots) + (EmitSettlement.comp hfetch.settles + (EmitSettlement.comp hretain.settles hfinish.settles)) + simpa [Function.comp_def] using hcomposed + +/-- The erased scalar borrow is already a total shared expression result. -/ +theorem LowerBorrowValueProgress.returnErased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {emit : Emit} {release : Bool} + (hprogress : LowerBorrowValueProgress funRel recSelfRel ctx cur + input output sourceInput sourceOutput .erased emit + (.constA .erased) release) : + LowerResultValueProgress funRel recSelfRel ctx cur + input output sourceInput sourceOutput .erased .shared emit + (.constA .erased) := by + refine + { toLowerResultValueSound := + hprogress.toLowerBorrowValueSound.returnErased + graphProgress := ?_ } + intro sourceRest rest slots + have hconvert : EmitProgress ctx cur (_root_.id : Emit) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput .erased (.constA .erased) release + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output + sourceOutput .erased .shared (.constA .erased) + sourceRest rest slots) := by + apply EmitProgress.strengthen + intro store env hpre + obtain ⟨roots, value, houtput, hav, hworld, hvalueGraph, + hrestGraph, hown, hslots⟩ := hpre + refine ⟨⟨roots, value, houtput, hav, hvalueGraph, + hrestGraph, ?_⟩, hslots⟩ + cases release with + | false => + simpa [borrowResultRoots] using + hown.addNoLocation (hprogress.stable.const_noLocation hav) + | true => simpa [borrowResultRoots] using hown + have hcomposed := EmitProgress.comp + (hprogress.graphProgress sourceRest rest slots) hconvert + simpa [Function.comp_def] using hcomposed + +/-- A constructor target cannot reach the erased descriptor midpoint. The +borrow prefix therefore progresses only from an empty input precondition. -/ +theorem LowerBorrowValueProgress.projectCtorErased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {address : Ixon.Address} {tag : Nat} + {sourceFields : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {release : Bool} + (hprogress : LowerBorrowValueProgress funRel recSelfRel ctx cur + input output sourceInput sourceOutput + (.ctor address tag sourceFields) emit (.constA .erased) release) : + LowerResultValueProgress funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceValue .shared emit + (.constA .erased) := by + refine + { toLowerResultValueSound := + hprogress.toLowerBorrowValueSound.projectCtorErased + graphProgress := ?_ } + intro sourceRest rest slots + have himpossible : ∀ {store env}, + GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput (.ctor address tag sourceFields) (.constA .erased) + release sourceRest rest slots store env → False := by + intro store env hpre + obtain ⟨roots, value, houtput, hav, hworld, hvalueGraph, + hrestGraph, hown, hslots⟩ := hpre + cases hav with + | const hresolve => + simp only [resolveAtom] at hresolve + have hvalue : RVal.erased = value := Except.ok.inj hresolve + subst value + cases hvalueGraph + have hconvert : EmitProgress ctx cur (_root_.id : Emit) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput (.ctor address tag sourceFields) (.constA .erased) + release sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output + sourceOutput sourceValue .shared (.constA .erased) + sourceRest rest slots) := + EmitProgress.strengthen (fun hpre => (himpossible hpre).elim) + have hcomposed := EmitProgress.comp + (hprogress.graphProgress sourceRest rest slots) hconvert + simpa [Function.comp_def] using hcomposed + +/-- A constructor source cannot be realized by a stable literal descriptor; +the following faithfully emitted scalar fetch is therefore vacuously total. -/ +theorem LowerBorrowValueProgress.projectCtorLiteral + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {address : Ixon.Address} {tag : Nat} + {sourceFields : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {literal : IxIR0.Literal} {index : Nat} + {release : Bool} + (hprogress : LowerBorrowValueProgress funRel recSelfRel ctx cur + input output sourceInput sourceOutput + (.ctor address tag sourceFields) emit (.constA (.lit literal)) + release) : + LowerResultValueProgress funRel recSelfRel ctx cur + input output.bump sourceInput sourceOutput sourceValue .shared + (emit ∘ emitOp (.fetch (.lit literal) index)) + (.slotA output.depth) := by + refine + { toLowerResultValueSound := + hprogress.toLowerBorrowValueSound.projectConst + graphProgress := ?_ } + intro sourceRest rest slots + have hsuffix : EmitProgress ctx cur + (emitOp (.fetch (.lit literal) index)) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput (.ctor address tag sourceFields) + (.constA (.lit literal)) release sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump + sourceOutput sourceValue .shared (.slotA output.depth) + sourceRest rest slots) := by + apply EmitProgress.of_pointwise + intro store env hpre + obtain ⟨roots, value, houtput, hav, hworld, hvalueGraph, + hrestGraph, hown, hslots⟩ := hpre + cases hav with + | const hresolve => + simp only [resolveAtom] at hresolve + have hvalue : RVal.lit literal = value := Except.ok.inj hresolve + subst value + cases hvalueGraph + exact EmitProgress.comp + (hprogress.graphProgress sourceRest rest slots) hsuffix + +/-- An erased source target likewise cannot be realized by a literal +descriptor. This vacuous successful rule lets the settlement dispatcher +cover every stable descriptor even though only the slot case genuinely +stops. -/ +theorem LowerBorrowValueProgress.projectErasedLiteral + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} + {literal : IxIR0.Literal} {index : Nat} {release : Bool} + (hprogress : LowerBorrowValueProgress funRel recSelfRel ctx cur + input output sourceInput sourceOutput .erased emit + (.constA (.lit literal)) release) : + LowerResultValueProgress funRel recSelfRel ctx cur + input output.bump sourceInput sourceOutput sourceValue .shared + (emit ∘ emitOp (.fetch (.lit literal) index)) + (.slotA output.depth) := by + refine + { toLowerResultValueSound := + hprogress.toLowerBorrowValueSound.projectConst + graphProgress := ?_ } + intro sourceRest rest slots + have hsuffix : EmitProgress ctx cur + (emitOp (.fetch (.lit literal) index)) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput .erased (.constA (.lit literal)) release + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump + sourceOutput sourceValue .shared (.slotA output.depth) + sourceRest rest slots) := by + apply EmitProgress.of_pointwise + intro store env hpre + obtain ⟨roots, value, houtput, hav, hworld, hvalueGraph, + hrestGraph, hown, hslots⟩ := hpre + cases hav with + | const hresolve => + simp only [resolveAtom] at hresolve + have hvalue : RVal.lit literal = value := Except.ok.inj hresolve + subst value + cases hvalueGraph + exact EmitProgress.comp + (hprogress.graphProgress sourceRest rest slots) hsuffix + +theorem LowerBorrowValueSettlement.returnErased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {emit : Emit} {release : Bool} + (hsettles : LowerBorrowValueSettlement funRel recSelfRel ctx cur + input output sourceInput sourceOutput .erased emit + (.constA .erased) release) : + LowerResultValueSettlement funRel recSelfRel ctx cur + input output sourceInput sourceOutput .erased .shared emit + (.constA .erased) := by + refine + { toLowerResultValueSound := + hsettles.toLowerBorrowValueSound.returnErased + graphSettlement := ?_ } + intro sourceRest rest slots + have hconvert : EmitSettlement ctx cur (_root_.id : Emit) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput .erased (.constA .erased) release + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output + sourceOutput .erased .shared (.constA .erased) + sourceRest rest slots) := by + apply EmitSettlement.strengthen + intro store env hpre + obtain ⟨roots, value, houtput, hav, hworld, hvalueGraph, + hrestGraph, hown, hslots⟩ := hpre + refine ⟨⟨roots, value, houtput, hav, hvalueGraph, + hrestGraph, ?_⟩, hslots⟩ + cases release with + | false => + simpa [borrowResultRoots] using + hown.addNoLocation (hsettles.stable.const_noLocation hav) + | true => simpa [borrowResultRoots] using hown + have hcomposed := EmitSettlement.comp + (hsettles.graphSettlement sourceRest rest slots) hconvert + simpa [Function.comp_def] using hcomposed + +theorem LowerBorrowValueSettlement.projectCtorErased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {address : Ixon.Address} {tag : Nat} + {sourceFields : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {release : Bool} + (hsettles : LowerBorrowValueSettlement funRel recSelfRel ctx cur + input output sourceInput sourceOutput + (.ctor address tag sourceFields) emit (.constA .erased) release) : + LowerResultValueSettlement funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceValue .shared emit + (.constA .erased) := by + refine + { toLowerResultValueSound := + hsettles.toLowerBorrowValueSound.projectCtorErased + graphSettlement := ?_ } + intro sourceRest rest slots + have hconvert : EmitSettlement ctx cur (_root_.id : Emit) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput (.ctor address tag sourceFields) (.constA .erased) + release sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output + sourceOutput sourceValue .shared (.constA .erased) + sourceRest rest slots) := by + apply EmitSettlement.strengthen + intro store env hpre + obtain ⟨roots, value, houtput, hav, hworld, hvalueGraph, + hrestGraph, hown, hslots⟩ := hpre + cases hav with + | const hresolve => + simp only [resolveAtom] at hresolve + have hvalue : RVal.erased = value := Except.ok.inj hresolve + subst value + cases hvalueGraph + have hcomposed := EmitSettlement.comp + (hsettles.graphSettlement sourceRest rest slots) hconvert + simpa [Function.comp_def] using hcomposed + +theorem LowerBorrowValueSettlement.projectCtorLiteral + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {address : Ixon.Address} {tag : Nat} + {sourceFields : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {literal : IxIR0.Literal} {index : Nat} + {release : Bool} + (hsettles : LowerBorrowValueSettlement funRel recSelfRel ctx cur + input output sourceInput sourceOutput + (.ctor address tag sourceFields) emit (.constA (.lit literal)) + release) : + LowerResultValueSettlement funRel recSelfRel ctx cur + input output.bump sourceInput sourceOutput sourceValue .shared + (emit ∘ emitOp (.fetch (.lit literal) index)) + (.slotA output.depth) := by + refine + { toLowerResultValueSound := + hsettles.toLowerBorrowValueSound.projectConst + graphSettlement := ?_ } + intro sourceRest rest slots + have hsuffix : EmitSettlement ctx cur + (emitOp (.fetch (.lit literal) index)) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput (.ctor address tag sourceFields) + (.constA (.lit literal)) release sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump + sourceOutput sourceValue .shared (.slotA output.depth) + sourceRest rest slots) := by + intro code hcode store env hpre + obtain ⟨roots, value, houtput, hav, hworld, hvalueGraph, + hrestGraph, hown, hslots⟩ := hpre + cases hav with + | const hresolve => + simp only [resolveAtom] at hresolve + have hvalue : RVal.lit literal = value := Except.ok.inj hresolve + subst value + cases hvalueGraph + exact EmitSettlement.comp + (hsettles.graphSettlement sourceRest rest slots) hsuffix + +theorem LowerBorrowValueSettlement.projectErasedLiteral + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} + {literal : IxIR0.Literal} {index : Nat} {release : Bool} + (hsettles : LowerBorrowValueSettlement funRel recSelfRel ctx cur + input output sourceInput sourceOutput .erased emit + (.constA (.lit literal)) release) : + LowerResultValueSettlement funRel recSelfRel ctx cur + input output.bump sourceInput sourceOutput sourceValue .shared + (emit ∘ emitOp (.fetch (.lit literal) index)) + (.slotA output.depth) := by + refine + { toLowerResultValueSound := + hsettles.toLowerBorrowValueSound.projectConst + graphSettlement := ?_ } + intro sourceRest rest slots + have hsuffix : EmitSettlement ctx cur + (emitOp (.fetch (.lit literal) index)) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput .erased (.constA (.lit literal)) release + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump + sourceOutput sourceValue .shared (.slotA output.depth) + sourceRest rest slots) := by + intro code hcode store env hpre + obtain ⟨roots, value, houtput, hav, hworld, hvalueGraph, + hrestGraph, hown, hslots⟩ := hpre + cases hav with + | const hresolve => + simp only [resolveAtom] at hresolve + have hvalue : RVal.lit literal = value := Except.ok.inj hresolve + subst value + cases hvalueGraph + exact EmitSettlement.comp + (hsettles.graphSettlement sourceRest rest slots) hsuffix + +/-- The erased-through-slot branch is not merely missing a proof: whenever +its graph precondition is inhabited, the emitted `fetch` cannot satisfy the +successful-execution progress interface. -/ +theorem fetchErasedSlot_not_progress_of_inhabited + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {targetAbs index : Nat} + {release : Bool} {sourceRest : List (Owned × IxIR0.Value)} + {rest : List Root} {slots : List (Nat × RVal)} {mid : StatePred} + (hinhabited : ∃ store env, + GraphOwnsBorrowResultProtected funRel recSelfRel Γ sourceEnv + .erased (.slotA targetAbs) release sourceRest rest slots store env) : + ¬ EmitProgress ctx cur + (emitOp (.fetch (.var (Γ.rel targetAbs)) index)) + (GraphOwnsBorrowResultProtected funRel recSelfRel Γ sourceEnv + .erased (.slotA targetAbs) release sourceRest rest slots) + mid := by + intro hprogress + obtain ⟨store, env, hpre⟩ := hinhabited + have hret : CodeProgress ctx cur mid (.ret .erased) := by + apply codeProgress_ret + intro nextStore nextEnv hmid + exact ⟨.erased, rfl⟩ + obtain ⟨fuel, store', value, hrun⟩ := + hprogress (.ret .erased) hret hpre + have hfalse := fetchErasedSlot_false + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := Γ) (sourceEnv := sourceEnv) + (targetAbs := targetAbs) (index := index) (release := release) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + have hfalseCode : CodeOwns ctx cur (fun _ _ => False) + (fun _ _ => False) (.ret .erased) := by + intro nextFuel nextStore nextEnv finalStore finalValue himpossible + hnextRun + exact himpossible.elim + exact hfalse (fun _ _ => False) (.ret .erased) hfalseCode hpre hrun + +/-- The erased-through-slot branch does have the weaker property needed for +memory safety: its emitted fetch reaches ordinary stuckness at finite fuel, +independently of the continuation. An abstract function realization is a +live pap and therefore stops with the pap-specific fetch error; the canonical +erased realization stops as a non-location. -/ +theorem fetchErasedSlot_stop + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {targetAbs index : Nat} + {release : Bool} {sourceRest : List (Owned × IxIR0.Value)} + {rest : List Root} {slots : List (Nat × RVal)} : + EmitStop ctx cur + (emitOp (.fetch (.var (Γ.rel targetAbs)) index)) + (GraphOwnsBorrowResultProtected funRel recSelfRel Γ sourceEnv + .erased (.slotA targetAbs) release sourceRest rest slots) := by + intro code store env hpre + obtain ⟨roots, targetValue, hΓ, htarget, htargetWorld, + htargetGraph, hrestGraph, hown, hslots⟩ := hpre + have hresolve : + resolveAtom env (.var (Γ.rel targetAbs)) = .ok targetValue := by + simpa [AVal.toAtom] using htarget.resolveAtom + cases htargetGraph with + | erased => + refine ⟨2, .stuck "fetch from a non-location" ?_⟩ + rw [runCode.eq_def] + dsimp only [emitOp] + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk, bindErr] + | function hget hrel hcaptures => + refine ⟨2, .stuck "fetch from a pap node" ?_⟩ + rw [runCode.eq_def] + dsimp only [emitOp] + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + simp only [hget, bindErr] + +theorem fetchErasedSlot_settlement + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {targetAbs index : Nat} + {release : Bool} {sourceRest : List (Owned × IxIR0.Value)} + {rest : List Root} {slots : List (Nat × RVal)} {mid : StatePred} : + EmitSettlement ctx cur + (emitOp (.fetch (.var (Γ.rel targetAbs)) index)) + (GraphOwnsBorrowResultProtected funRel recSelfRel Γ sourceEnv + .erased (.slotA targetAbs) release sourceRest rest slots) + mid := + (fetchErasedSlot_stop (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := Γ) (sourceEnv := sourceEnv) + (targetAbs := targetAbs) (index := index) (release := release) + (sourceRest := sourceRest) (rest := rest) (slots := slots)).settlement + +/-- An erased source target projected through a retained logical slot is a +valid non-memory settlement result. The borrow prefix may itself settle; +when it succeeds, the following fetch is a terminal ordinary-stuck prefix, +so the unreachable duplicate never needs a progress proof. -/ +theorem LowerBorrowValueSettlement.projectSlotKeptErased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {targetAbs index : Nat} + (hsettles : LowerBorrowValueSettlement funRel recSelfRel ctx cur + input output sourceInput sourceOutput .erased emit + (.slotA targetAbs) false) : + LowerResultValueSettlement funRel recSelfRel ctx cur + input output.bump.bump sourceInput sourceOutput sourceValue .shared + (emit ∘ emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth)))) + (.slotA output.bump.depth) := by + refine + { toLowerResultValueSound := + hsettles.toLowerBorrowValueSound.projectSlotKeptErased + graphSettlement := ?_ } + intro sourceRest rest slots + have hfetch := fetchErasedSlot_stop + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output) + (sourceEnv := sourceOutput) (targetAbs := targetAbs) + (index := index) (release := false) (sourceRest := sourceRest) + (rest := rest) (slots := slots) + have hfetchThenDup := EmitStop.postcompose + (suffix := emitOp (.dup (.var (output.bump.rel output.depth)))) + hfetch + have hstop := (hsettles.graphSettlement sourceRest rest slots).thenStop + hfetchThenDup + simpa [Function.comp_def] using hstop.settlement + +/-- Final-use erased-slot projection has the same safe stop; both the +duplicate and the target drop lie after the failing fetch. -/ +theorem LowerBorrowValueSettlement.projectSlotReleasedErased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {targetAbs index : Nat} + (hsettles : LowerBorrowValueSettlement funRel recSelfRel ctx cur + input output sourceInput sourceOutput .erased emit + (.slotA targetAbs) true) : + LowerResultValueSettlement funRel recSelfRel ctx cur + input output.bump.bump.bump sourceInput sourceOutput sourceValue + .shared + (emit ∘ emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth))) ∘ + emitOp (.drop (.var (output.bump.bump.rel targetAbs)))) + (.slotA output.bump.depth) := by + refine + { toLowerResultValueSound := + hsettles.toLowerBorrowValueSound.projectSlotReleasedErased + graphSettlement := ?_ } + intro sourceRest rest slots + have hfetch := fetchErasedSlot_stop + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output) + (sourceEnv := sourceOutput) (targetAbs := targetAbs) + (index := index) (release := true) (sourceRest := sourceRest) + (rest := rest) (slots := slots) + have hfetchThenSuffix := EmitStop.postcompose + (suffix := emitOp (.dup (.var (output.bump.rel output.depth))) ∘ + emitOp (.drop (.var (output.bump.bump.rel targetAbs)))) hfetch + have hstop := (hsettles.graphSettlement sourceRest rest slots).thenStop + hfetchThenSuffix + simpa [Function.comp_def] using hstop.settlement + +/-- A released logical slot containing the erased scalar is a concrete +inhabitant of the obstructing projection precondition. -/ +theorem erasedReleasedSlot_borrow_pre_inhabited + (funRel : Sim.FunctionRel) (recSelfRel : RecSelfRel) : + ∃ store env, + GraphOwnsBorrowResultProtected funRel recSelfRel + ⟨[.slot 0 0 .many false], 1⟩ [.erased] + .erased (.slotA 0) true [] [] [] store env := by + refine ⟨{}, [.erased], [], .erased, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · refine ⟨by simp, ?_⟩ + exact EntriesValueGraph.released (by simp) EntriesValueGraph.nil + · apply AValRealizes.slot + · simp + · simp [VEnv.rel] + · trivial + · exact .erased + · exact .nil + · simpa [borrowResultRoots] using + (RootOwnership.empty.addNoLocation (world := .shared) (by rfl)) + · exact SlotsRealize.nil + +/-- Consequently, even the canonical scalar realization gives a direct +counterexample to unconditional successful progress for erased-slot fetch. -/ +theorem erasedReleasedSlot_fetch_not_progress + {ctx : Ctx} {cur : FnDef} (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (index : Nat) (mid : StatePred) : + ¬ EmitProgress ctx cur + (emitOp (.fetch (.var + ((⟨[.slot 0 0 .many false], 1⟩ : VEnv).rel 0)) index)) + (GraphOwnsBorrowResultProtected funRel recSelfRel + ⟨[.slot 0 0 .many false], 1⟩ [.erased] + .erased (.slotA 0) true [] [] []) + mid := + fetchErasedSlot_not_progress_of_inhabited + (erasedReleasedSlot_borrow_pre_inhabited funRel recSelfRel) + +/-- Reachable projection progress for the constructor outcome of the source +evaluator. The canonical function relation rules out pap-shaped disguises, +so both retained and final-use slot descriptors execute `fetch`/`dup` +(and the optional target release) successfully. -/ +theorem lowerE_proj_ctor_run_value_progress_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (henv : sourceCtx.env = src) + (hborrow : LowerBorrowValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + {input output : VEnv} {world : Owned} {index : Nat} + {source : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + {sourceFuel : Nat} {address : Ixon.Address} {tag : Nat} + {fields : List IxIR0.Value} {sourceValue : IxIR0.Value} + (htarget : IxIR0.eval sourceCtx sourceFuel sourceEnv source = + .ok (.ctor address tag fields)) + (hfield : fields[index]? = some sourceValue) + (hrun : (lowerE src (fuel + 1) input world + (.proj index source)).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur + input output sourceEnv sourceEnv sourceValue world emit av := by + cases world with + | unique => + have huuEq : (Owned.unique == Owned.unique) = true := by decide + simp only [lowerE, huuEq, if_true] at hrun + exact (trackedThrowRun_not_ok hrun).elim + | shared => + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + simp only [lowerE, hsuEq, Bool.false_eq_true, if_false] at hrun + obtain ⟨borrowResult, middleState, hborrowRun, hafterBorrow⟩ := + trackedBindRun_ok_inv hrun + rcases borrowResult with + ⟨borrowOutput, borrowEmit, borrowed, release⟩ + have hnotFunction : ∀ f arity captures, + ¬ CompilerFunctionRel sourceCtx src ambient + (.ctor address tag fields) f arity captures := by + intro f arity captures hrel + exact hrel.value_ne_ctor henv rfl + cases borrowed with + | constA atom => + cases atom with + | var relative => + have hpure : + (borrowOutput.bump, + borrowEmit ∘ emitOp (.fetch (.var relative) index), + AVal.slotA borrowOutput.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + cases (hborrow htarget hborrowRun hextends havailable).stable + | lit literal => + have hpure : + (borrowOutput.bump, + borrowEmit ∘ emitOp (.fetch (.lit literal) index), + AVal.slotA borrowOutput.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact (hborrow htarget hborrowRun hextends + havailable).projectCtorLiteral + | erased => + have hpure : + (borrowOutput, borrowEmit, AVal.constA .erased) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact (hborrow htarget hborrowRun hextends + havailable).projectCtorErased + | slotA targetAbs => + cases release with + | false => + have hpure : + (borrowOutput.bump.bump, + borrowEmit ∘ + emitOp (.fetch (.var (borrowOutput.rel targetAbs)) index) ∘ + emitOp (.dup + (.var (borrowOutput.bump.rel borrowOutput.depth))), + AVal.slotA borrowOutput.bump.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact (hborrow htarget hborrowRun hextends + havailable).projectSlotKept hnotFunction hfield + | true => + have hpure : + (borrowOutput.bump.bump.bump, + borrowEmit ∘ + emitOp (.fetch (.var (borrowOutput.rel targetAbs)) index) ∘ + emitOp (.dup + (.var (borrowOutput.bump.rel borrowOutput.depth))) ∘ + emitOp (.drop + (.var (borrowOutput.bump.bump.rel targetAbs))), + AVal.slotA borrowOutput.bump.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact (hborrow htarget hborrowRun hextends + havailable).projectSlotReleased hnotFunction hfield + +/-- A successful Ixon projection related by proof-producing erasure enters +only the constructor branch of the IxIR₀ projection dispatcher. Composing +that erasure inversion with the existing constructor projection theorem +eliminates the raw erased-slot counterexample at this source boundary. -/ +theorem lowerE_proj_ctor_run_value_progress_safely_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (henv : sourceCtx.env = src) + (hborrow : LowerBorrowValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + {input output : VEnv} {world : Owned} {index : Nat} + {source : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + {address : Ixon.Address} {tag : Nat} + {fields : List IxIR0.Value} {sourceValue : IxIR0.Value} + (htarget : ProjectionSafeEval sourceCtx sourceEnv source + (.ctor address tag fields)) + (hfield : fields[index]? = some sourceValue) + (hrun : (lowerE src (fuel + 1) input world + (.proj index source)).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur + input output sourceEnv sourceEnv sourceValue world emit av := by + cases world with + | unique => + have huuEq : (Owned.unique == Owned.unique) = true := by decide + simp only [lowerE, huuEq, if_true] at hrun + exact (trackedThrowRun_not_ok hrun).elim + | shared => + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + simp only [lowerE, hsuEq, Bool.false_eq_true, if_false] at hrun + obtain ⟨borrowResult, middleState, hborrowRun, hafterBorrow⟩ := + trackedBindRun_ok_inv hrun + rcases borrowResult with + ⟨borrowOutput, borrowEmit, borrowed, release⟩ + have hnotFunction : ∀ f arity captures, + ¬ CompilerFunctionRel sourceCtx src ambient + (.ctor address tag fields) f arity captures := by + intro f arity captures hrel + exact hrel.value_ne_ctor henv rfl + cases borrowed with + | constA atom => + cases atom with + | var relative => + have hpure : + (borrowOutput.bump, + borrowEmit ∘ emitOp (.fetch (.var relative) index), + AVal.slotA borrowOutput.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + cases (hborrow htarget hborrowRun hextends havailable).stable + | lit literal => + have hpure : + (borrowOutput.bump, + borrowEmit ∘ emitOp (.fetch (.lit literal) index), + AVal.slotA borrowOutput.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact (hborrow htarget hborrowRun hextends + havailable).projectCtorLiteral + | erased => + have hpure : + (borrowOutput, borrowEmit, AVal.constA .erased) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact (hborrow htarget hborrowRun hextends + havailable).projectCtorErased + | slotA targetAbs => + cases release with + | false => + have hpure : + (borrowOutput.bump.bump, + borrowEmit ∘ + emitOp (.fetch (.var (borrowOutput.rel targetAbs)) index) ∘ + emitOp (.dup + (.var (borrowOutput.bump.rel borrowOutput.depth))), + AVal.slotA borrowOutput.bump.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact (hborrow htarget hborrowRun hextends + havailable).projectSlotKept hnotFunction hfield + | true => + have hpure : + (borrowOutput.bump.bump.bump, + borrowEmit ∘ + emitOp (.fetch (.var (borrowOutput.rel targetAbs)) index) ∘ + emitOp (.dup + (.var (borrowOutput.bump.rel borrowOutput.depth))) ∘ + emitOp (.drop + (.var (borrowOutput.bump.bump.rel targetAbs))), + AVal.slotA borrowOutput.bump.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact (hborrow htarget hborrowRun hextends + havailable).projectSlotReleased hnotFunction hfield + +/-- A successful Ixon projection related by proof-producing erasure enters +only the constructor branch of the IxIR₀ projection dispatcher. Composing +that erasure inversion with the existing constructor projection theorem +eliminates the raw erased-slot counterexample at this source boundary. -/ + +theorem lowerE_proj_erasure_run_value_progress_within + {ectx : Ixon.Eval.EvalCtx} {F : Ixon.Eval.Frame} + {sourceRuntimeEnv : List Ixon.Eval.Value} + {tyRef fieldIdx : UInt64} {ixonSource : Ixon.Expr} + {ixonValue : Ixon.Eval.Value} + {selfCtx : Option (Ixon.Address × Nat)} {mask : List Bool} + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {source : IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {ixonFuel compilerFuel : Nat} + (hstrict : ectx.Strict) + (horacles : Ix.Compiler.Sim.OracleRel ectx sourceCtx) + (hixon : Ixon.Eval.eval ectx ixonFuel F sourceRuntimeEnv + (.prj tyRef fieldIdx ixonSource) = .ok ixonValue) + (herases : Ix.Compiler.Sim.PErase ectx sourceCtx selfCtx F.refs + F.selfMuts F.selfAddr mask (.prj tyRef fieldIdx ixonSource) + (.proj fieldIdx.toNat source)) + (herasedEnv : Ix.Compiler.Sim.EnvRel ectx sourceCtx selfCtx F.refs + F.selfMuts F.selfAddr mask sourceRuntimeEnv sourceEnv) + (henv : sourceCtx.env = src) + (hborrow : LowerBorrowValueProgressesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient compilerFuel) + {input output : VEnv} {world : Owned} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceFuel : Nat} + {sourceTarget : IxIR0.Value} + (htarget : IxIR0.eval sourceCtx sourceFuel sourceEnv source = + .ok sourceTarget) + (hrun : (lowerE src (compilerFuel + 1) input world + (.proj fieldIdx.toNat source)).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + ∃ address tag fields sourceValue, + sourceTarget = .ctor address tag fields ∧ + Ix.Compiler.Sim.ValRel ectx sourceCtx ixonValue sourceValue ∧ + LowerResultValueProgress + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur + input output sourceEnv sourceEnv sourceValue world emit av := by + obtain ⟨address, tag, fields, sourceValue, hsourceTarget, hfield, + hvalueRel⟩ := Ix.Compiler.Sim.erasure_proj_target_ctor + hstrict horacles hixon herases herasedEnv htarget + subst sourceTarget + refine ⟨address, tag, fields, sourceValue, rfl, hvalueRel, ?_⟩ + exact lowerE_proj_ctor_run_value_progress_within henv hborrow htarget + hfield hrun hextends havailable + +/-- Complete reachable projection settlement. Constructor targets retain the +strong successful result above. An erased target with a stable scalar +descriptor is vacuous or returns erased; an erased target carried by a slot +settles at the emitted fetch with ordinary stuckness. -/ +theorem lowerE_proj_run_value_settlement_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (henv : sourceCtx.env = src) + (hborrow : LowerBorrowValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + {input output : VEnv} {world : Owned} {index : Nat} + {source : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + {sourceFuel : Nat} {sourceTarget sourceValue : IxIR0.Value} + (htarget : IxIR0.eval sourceCtx sourceFuel sourceEnv source = + .ok sourceTarget) + (hproject : SourceProject index sourceTarget sourceValue) + (hrun : (lowerE src (fuel + 1) input world + (.proj index source)).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSettlement + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur + input output sourceEnv sourceEnv sourceValue world emit av := by + cases world with + | unique => + have huuEq : (Owned.unique == Owned.unique) = true := by decide + simp only [lowerE, huuEq, if_true] at hrun + exact (trackedThrowRun_not_ok hrun).elim + | shared => + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + simp only [lowerE, hsuEq, Bool.false_eq_true, if_false] at hrun + obtain ⟨borrowResult, middleState, hborrowRun, hafterBorrow⟩ := + trackedBindRun_ok_inv hrun + rcases borrowResult with + ⟨borrowOutput, borrowEmit, borrowed, release⟩ + cases borrowed with + | constA atom => + cases atom with + | var relative => + have hpure : + (borrowOutput.bump, + borrowEmit ∘ emitOp (.fetch (.var relative) index), + AVal.slotA borrowOutput.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + cases (hborrow htarget hborrowRun hextends havailable).stable + | lit literal => + have hpure : + (borrowOutput.bump, + borrowEmit ∘ emitOp (.fetch (.lit literal) index), + AVal.slotA borrowOutput.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + have hborrowSettles := + hborrow htarget hborrowRun hextends havailable + cases hproject with + | ctor hfield => + exact hborrowSettles.projectCtorLiteral + | erased => + exact hborrowSettles.projectErasedLiteral + | erased => + have hpure : + (borrowOutput, borrowEmit, AVal.constA .erased) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + have hborrowSettles := + hborrow htarget hborrowRun hextends havailable + cases hproject with + | ctor hfield => + exact hborrowSettles.projectCtorErased + | erased => exact hborrowSettles.returnErased + | slotA targetAbs => + cases release with + | false => + have hpure : + (borrowOutput.bump.bump, + borrowEmit ∘ + emitOp (.fetch (.var (borrowOutput.rel targetAbs)) index) ∘ + emitOp (.dup + (.var (borrowOutput.bump.rel borrowOutput.depth))), + AVal.slotA borrowOutput.bump.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + have hborrowSettles := + hborrow htarget hborrowRun hextends havailable + cases hproject with + | @ctor address tag fields value hfield => + have hnotFunction : ∀ f arity captures, + ¬ CompilerFunctionRel sourceCtx src ambient + (.ctor address tag fields) f arity captures := by + intro f arity captures hrel + exact hrel.value_ne_ctor henv rfl + exact hborrowSettles.projectSlotKept hnotFunction hfield + | erased => + exact hborrowSettles.projectSlotKeptErased + | true => + have hpure : + (borrowOutput.bump.bump.bump, + borrowEmit ∘ + emitOp (.fetch (.var (borrowOutput.rel targetAbs)) index) ∘ + emitOp (.dup + (.var (borrowOutput.bump.rel borrowOutput.depth))) ∘ + emitOp (.drop + (.var (borrowOutput.bump.bump.rel targetAbs))), + AVal.slotA borrowOutput.bump.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + have hborrowSettles := + hborrow htarget hborrowRun hextends havailable + cases hproject with + | @ctor address tag fields value hfield => + have hnotFunction : ∀ f arity captures, + ¬ CompilerFunctionRel sourceCtx src ambient + (.ctor address tag fields) f arity captures := by + intro f arity captures hrel + exact hrel.value_ne_ctor henv rfl + exact hborrowSettles.projectSlotReleased hnotFunction hfield + | erased => + exact hborrowSettles.projectSlotReleasedErased + +/-! ## Let-binder progress -/ + +/-- Progress refinement for the semantic installation of one let binder. -/ +structure InstallBinderValueProgress (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (ctx : Ctx) (cur : FnDef) + (input output : VEnv) (sourceEnv : List IxIR0.Value) + (boundSource : IxIR0.Value) (boundWorld : Owned) + (boundValue : AVal) (emit : Emit) : Prop + extends InstallBinderValueSound funRel recSelfRel ctx cur input output + sourceEnv boundSource boundWorld boundValue emit where + graphProgress : ∀ sourceRest rest slots, + EmitProgress ctx cur emit + (GraphOwnsResultProtected funRel recSelfRel input sourceEnv + boundSource boundWorld boundValue sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel output + (boundSource :: sourceEnv) sourceRest rest slots) + +/-- Installing a slot-backed binder is an ownership-and-graph rearrangement +with no target operation. -/ +theorem installAliasBinder_held_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {boundSource : IxIR0.Value} + {abs remaining : Nat} {uses : Uses} : + InstallBinderValueProgress funRel recSelfRel ctx cur Γ + (installAliasBinder Γ abs remaining uses true) + sourceEnv boundSource (worldOfUses uses) (.slotA abs) + (_root_.id : Emit) := by + refine + { toInstallBinderValueSound := installAliasBinder_held_value_sound + graphProgress := ?_ } + intro sourceRest rest slots + apply EmitProgress.strengthen + intro store env hpre + obtain ⟨⟨roots, value, hΓ, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + cases hav with + | slot hbound hslot => + let output := installAliasBinder Γ abs remaining uses true + have htail : EntriesValueGraph funRel recSelfRel store output env + Γ.entries sourceEnv roots := + hΓ.entries.of_depth_eq (by simp [output, installAliasBinder]) + have hvalueWorld : HasWorld store (worldOfUses uses) value := + hown.roots_world ⟨worldOfUses uses, value⟩ (by simp) + have houtput : VEnvValueGraph funRel recSelfRel store output + (boundSource :: sourceEnv) env + (⟨worldOfUses uses, value⟩ :: roots) := by + refine ⟨by simpa [output, installAliasBinder] using hΓ.depth_eq, ?_⟩ + exact EntriesValueGraph.held + (by simpa [output, installAliasBinder] using hbound) + (by simpa [output, installAliasBinder, VEnv.rel] using hslot) + hvalueWorld hvalueGraph htail + refine ⟨⟨⟨worldOfUses uses, value⟩ :: roots, + houtput, hrestGraph, ?_⟩, ?_⟩ + · simpa using hown + · exact SlotsRealize.of_depth_eq + (by simp [output, installAliasBinder]) hslots + +/-- Materializing a stable scalar binder always executes one `pure` +operation and installs the pushed value in the logical environment. -/ +theorem materializeConstBinder_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {boundSource : IxIR0.Value} + {atom : Atom} {remaining : Nat} {uses : Uses} {held : Bool} + (hstable : AValStable (.constA atom)) : + InstallBinderValueProgress funRel recSelfRel ctx cur Γ + (installPushedBinder Γ remaining uses held) sourceEnv boundSource + (worldOfUses uses) (.constA atom) (emitOp (.pure atom)) := by + refine + { toInstallBinderValueSound := + materializeConstBinder_value_sound hstable + graphProgress := ?_ } + intro sourceRest rest slots + apply OpProgress.emit + intro store env hpre + obtain ⟨⟨roots, value, hΓ, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + have hpure := runOp_pure (ctx := ctx) (cur := cur) (fuel := 0) + (store := store) hav.resolveAtom + let output := installPushedBinder Γ remaining uses held + have htail : EntriesValueGraph funRel recSelfRel store output + (value :: env) Γ.entries sourceEnv roots := + (hΓ.entries.bump value).of_depth_eq + (by simp [output, installPushedBinder, VEnv.bump]) + have hdepth : (value :: env).length = output.depth := by + simpa [output, installPushedBinder] using + congrArg Nat.succ hΓ.depth_eq + cases held with + | false => + have houtput : VEnvValueGraph funRel recSelfRel store output + (boundSource :: sourceEnv) (value :: env) roots := by + refine ⟨hdepth, ?_⟩ + exact EntriesValueGraph.released + (by simp [output, installPushedBinder]) htail + refine ⟨1, store, value, hpure, ⟨⟨roots, houtput, hrestGraph, ?_⟩, + ?_⟩⟩ + · exact hown.dropNoLocation (hstable.const_noLocation hav) + · exact SlotsRealize.of_depth_eq + (by simp [output, installPushedBinder, VEnv.bump]) + (hslots.bump value) + | true => + have hvalueWorld : HasWorld store (worldOfUses uses) value := + hown.roots_world ⟨worldOfUses uses, value⟩ (by simp) + have houtput : VEnvValueGraph funRel recSelfRel store output + (boundSource :: sourceEnv) (value :: env) + (⟨worldOfUses uses, value⟩ :: roots) := by + refine ⟨hdepth, ?_⟩ + exact EntriesValueGraph.held + (by simp [output, installPushedBinder]) + (by simp [output, installPushedBinder, VEnv.rel]) + hvalueWorld hvalueGraph htail + refine ⟨1, store, value, hpure, + ⟨⟨⟨worldOfUses uses, value⟩ :: roots, + houtput, hrestGraph, ?_⟩, ?_⟩⟩ + · simpa using hown + · exact SlotsRealize.of_depth_eq + (by simp [output, installPushedBinder, VEnv.bump]) + (hslots.bump value) + +/-- Common progressing release of one held logical entry. The selected root +is consumed by a total drop operation, and its reverse shape inclusion +rebuilds all surviving environment and caller graphs. -/ +private theorem release_slot_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {i abs : Nat} {uses : Uses} {world : Owned} {releaseOp : Op} + (hworld : worldOfUses uses = world) + (hentry : Γ.entries[i]? = some (.slot abs 0 uses true)) + (hop : ∀ {store : Store} {env : List RVal} {value : RVal} + {tailRoots : List Root}, + resolveAtom env (.var (Γ.rel abs)) = .ok value → + RootOwnership store (⟨world, value⟩ :: tailRoots) → + ∃ fuel store', + runOp ctx fuel cur store env releaseOp = .ok (store', .erased) ∧ + Sim.StoreGraphRestricts store store' ∧ + RootOwnership store' tailRoots) : + ∀ sourceEnv sourceRest rest slots, + EmitProgress ctx cur (emitOp releaseOp) + (GraphOwnsVEnvProtected funRel recSelfRel Γ + sourceEnv sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel + ((Γ.setEntry i (.slot abs 0 uses false)).bump) + sourceEnv sourceRest rest slots) := by + intro sourceEnv sourceRest rest slots + apply OpProgress.emit + intro store env hpre + obtain ⟨⟨roots, hΓ, hrestGraph, hown⟩, hslots⟩ := hpre + obtain ⟨_, value, before, after, _, hbound, hslot, _, _, + hroots, hreleased⟩ := hΓ.entries.releaseAt hentry + let Γreleased := Γ.setEntry i (.slot abs 0 uses false) + let tailRoots := before ++ after ++ rest + have hΓreleased : VEnvValueGraph funRel recSelfRel store + Γreleased sourceEnv env (before ++ after) := + hΓ.setEntry hreleased + have howned : RootOwnership store (⟨world, value⟩ :: tailRoots) := by + rw [hroots] at hown + have hfront := hown.perm + (permExtractRoot ⟨worldOfUses uses, value⟩ before after rest) + simpa [tailRoots, hworld] using hfront + have hresolve : + resolveAtom env (.var (Γ.rel abs)) = .ok value := + (AValRealizes.slot hbound hslot).resolveAtom + obtain ⟨fuel, store', hrun, hrestrict, hownAfter⟩ := + hop hresolve howned + have hΓafter : VEnvValueGraph funRel recSelfRel store' + Γreleased sourceEnv env (before ++ after) := + hΓreleased.ofRestricts hrestrict hownAfter + (fun root hmember => by + simpa [tailRoots] using List.mem_append_left rest hmember) + have hrestAfter : Sim.RootsGraph funRel store' sourceRest rest := + hrestGraph.ofRestrictsIn hrestrict hownAfter + (fun root hmember => by + simpa [tailRoots] using + List.mem_append_right (before ++ after) hmember) + refine ⟨fuel, store', .erased, hrun, + ⟨⟨before ++ after, hΓafter.bump .erased, hrestAfter, ?_⟩, + (hslots.setEntry).bump .erased⟩⟩ + simpa [tailRoots] using hownAfter + +/-- Total shared release for a dead let alias. -/ +theorem release_slot_many_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} {i abs : Nat} + (hentry : Γ.entries[i]? = some (.slot abs 0 .many true)) : + ∀ sourceEnv sourceRest rest slots, + EmitProgress ctx cur (emitOp (.drop (.var (Γ.rel abs)))) + (GraphOwnsVEnvProtected funRel recSelfRel Γ + sourceEnv sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel + ((Γ.setEntry i (.slot abs 0 .many false)).bump) + sourceEnv sourceRest rest slots) := by + apply release_slot_value_progress (world := .shared) rfl hentry + intro store env value tailRoots hresolve hown + cases value with + | lit literal => + have hrun : runOp ctx 1 cur store env + (.drop (.var (Γ.rel abs))) = .ok (store, .erased) := by + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + exact ⟨1, store, hrun, Sim.StoreGraphRestricts.refl store, + hown.dropNoLocation rfl⟩ + | erased => + have hrun : runOp ctx 1 cur store env + (.drop (.var (Γ.rel abs))) = .ok (store, .erased) := by + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + exact ⟨1, store, hrun, Sim.StoreGraphRestricts.refl store, + hown.dropNoLocation rfl⟩ + | loc loc => + obtain ⟨fuel, store', hdrop, hownAfter⟩ := + dropVal_progress (ctx := ctx) hown + have hrun := runOp_drop (ctx := ctx) (cur := cur) (fuel := fuel) + hresolve hdrop + exact ⟨fuel + 1, store', hrun, Sim.dropVal_restricts hdrop, + hownAfter⟩ + +/-- Total unique release for a dead affine let alias. -/ +theorem release_slot_affine_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} {i abs : Nat} + (hentry : Γ.entries[i]? = some (.slot abs 0 .affine true)) : + ∀ sourceEnv sourceRest rest slots, + EmitProgress ctx cur (emitOp (.dropU (.var (Γ.rel abs)))) + (GraphOwnsVEnvProtected funRel recSelfRel Γ + sourceEnv sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel + ((Γ.setEntry i (.slot abs 0 .affine false)).bump) + sourceEnv sourceRest rest slots) := by + apply release_slot_value_progress (world := .unique) rfl hentry + intro store env value tailRoots hresolve hown + cases value with + | lit literal => + have hrun : runOp ctx 1 cur store env + (.dropU (.var (Γ.rel abs))) = .ok (store, .erased) := by + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + exact ⟨1, store, hrun, Sim.StoreGraphRestricts.refl store, + hown.dropNoLocation rfl⟩ + | erased => + have hrun : runOp ctx 1 cur store env + (.dropU (.var (Γ.rel abs))) = .ok (store, .erased) := by + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + exact ⟨1, store, hrun, Sim.StoreGraphRestricts.refl store, + hown.dropNoLocation rfl⟩ + | loc loc => + obtain ⟨fuel, store', hdrop, hownAfter⟩ := + dropUVal_progress (ctx := ctx) hown + have hrun := runOp_dropU (ctx := ctx) (cur := cur) (fuel := fuel) + hresolve hdrop + exact ⟨fuel + 1, store', hrun, Sim.dropUVal_restricts hdrop, + hownAfter⟩ + +/-- Total graph-preserving form of one generated borrowed-field retain. -/ +theorem retain_borrowed_into_entry_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {i placeholderAbs fieldAbs remaining : Nat} + {sourceEnv : List IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} + {rest extra : List Root} {slots : List (Nat × RVal)} + {borrowed : List RVal} {retains : List RecursorFieldRetain} + (hentry : Γ.entries[i]? = + some (.slot placeholderAbs 0 .many false)) : + EmitProgress ctx cur (emitOp (.dup (.var (Γ.rel fieldAbs)))) + (GraphOwnsVEnvRetains funRel recSelfRel Γ sourceEnv + sourceRest rest extra slots borrowed + (⟨i, fieldAbs, remaining⟩ :: retains)) + (GraphOwnsVEnvRetains funRel recSelfRel + ((Γ.setEntry i (.slot Γ.depth remaining .many true)).bump) + sourceEnv sourceRest rest extra slots borrowed retains) := by + apply OpProgress.emit + intro store env hpre + obtain ⟨roots, hΓ, hframe, hown, hslots, hborrowed, + hgraphs⟩ := hpre + obtain ⟨source, value, hsource, hslotMem, hborrowMem, hvalue⟩ := + hgraphs ⟨i, fieldAbs, remaining⟩ (by simp) + obtain ⟨hfieldBound, hfieldSlot⟩ := + hslots fieldAbs value hslotMem + have hresolve : + resolveAtom env (.var (Γ.rel fieldAbs)) = .ok value := + (AValRealizes.slot hfieldBound hfieldSlot).resolveAtom + have hworld : HasWorld store .shared value := + hborrowed value hborrowMem + obtain ⟨nextStore, heval, hextends, hvalueNext, hownNext⟩ := + runOp_retain_borrowed_valueGraph + (ctx := ctx) (cur := cur) (fuel := 0) + hresolve hworld hvalue + (show RootOwnership store (roots ++ extra ++ rest) from hown) + have hΓbump : VEnvValueGraph funRel recSelfRel nextStore + Γ.bump sourceEnv (value :: env) roots := + (hΓ.monoStore hextends).bump value + have hentryBump : Γ.bump.entries[i]? = + some (.slot placeholderAbs 0 .many false) := by + simpa [VEnv.bump] using hentry + have hnewBound : Γ.depth < Γ.bump.depth := by simp [VEnv.bump] + have hnewSlot : + (value :: env)[Γ.bump.rel Γ.depth]? = some value := by + simp [VEnv.bump, VEnv.rel] + have hworldNext : HasWorld nextStore .shared value := + hworld.monoStore hextends + obtain ⟨before, after, hroots, hentries⟩ := + hΓbump.entries.holdAt hentryBump hsource hnewBound hnewSlot + hworldNext hvalueNext + have hset : VEnvValueGraph funRel recSelfRel nextStore + (Γ.bump.setEntry i (.slot Γ.depth remaining .many true)) + sourceEnv (value :: env) + (before ++ ⟨.shared, value⟩ :: after) := + hΓbump.setEntry hentries + have henvEq : + Γ.bump.setEntry i (.slot Γ.depth remaining .many true) = + ((Γ.setEntry i (.slot Γ.depth remaining .many true)).bump) := by + cases Γ + rfl + rw [henvEq] at hset + have howned : RootOwnership nextStore + ((before ++ ⟨.shared, value⟩ :: after) ++ extra ++ rest) := by + rw [hroots] at hownNext + have hfront : RootOwnership nextStore + (⟨.shared, value⟩ :: (before ++ after) ++ (extra ++ rest)) := by + simpa [List.append_assoc] using hownNext + have hreordered := hfront.perm + (permExtractRoot ⟨.shared, value⟩ before after + (extra ++ rest)).symm + simpa [List.append_assoc] using hreordered + have htailBefore : RetainsValueGraphs funRel store sourceEnv slots + borrowed retains := by + intro retain hmember + exact hgraphs retain (by simp [hmember]) + refine ⟨1, nextStore, value, heval, + before ++ ⟨.shared, value⟩ :: after, hset, + hframe.monoStore hextends, howned, (hslots.setEntry).bump value, + ?_, htailBefore.monoStore hextends⟩ + intro candidate hmember + exact (hborrowed candidate hmember).monoStore hextends + +/-- A complete static field-retain plan is target-progressing and consumes +its pending source/target retain witnesses one descriptor at a time. -/ +theorem FieldRetainPlan.valueProgress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {input output : VEnv} {retains : List RecursorFieldRetain} + {emit : Emit} (hplan : FieldRetainPlan input retains output emit) : + ∀ sourceEnv sourceRest rest extra slots borrowed, + EmitProgress ctx cur emit + (GraphOwnsVEnvRetains funRel recSelfRel input sourceEnv + sourceRest rest extra slots borrowed retains) + (GraphOwnsVEnvRetains funRel recSelfRel output sourceEnv + sourceRest rest extra slots borrowed []) := by + apply FieldRetainPlan.traverse (hplan := hplan) + · intro Γ sourceEnv sourceRest rest extra slots borrowed + exact EmitProgress.id + · intro Γ output i placeholderAbs fieldAbs remaining retains tailEmit + hentry ih sourceEnv sourceRest rest extra slots borrowed + exact EmitProgress.comp + (retain_borrowed_into_entry_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (sourceEnv := sourceEnv) (sourceRest := sourceRest) + (rest := rest) (extra := extra) (slots := slots) + (borrowed := borrowed) (retains := retains) hentry) + (ih sourceEnv sourceRest rest extra slots borrowed) + +/-- Total graph-preserving release of the selected recursor major after all +needed fields have been retained. -/ +theorem drop_major_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} + {majorAbs : Nat} {major : RVal} {rest : List Root} + {slots : List (Nat × RVal)} {borrowed : List RVal} + (hmajor : (majorAbs, major) ∈ slots) : + EmitProgress ctx cur (emitOp (.drop (.var (Γ.rel majorAbs)))) + (GraphOwnsVEnvRetains funRel recSelfRel Γ sourceEnv + sourceRest rest [⟨.shared, major⟩] slots borrowed []) + (GraphOwnsVEnvProtected funRel recSelfRel Γ.bump sourceEnv + sourceRest rest slots) := by + apply OpProgress.emit + intro store env hpre + obtain ⟨roots, hΓ, hrestGraph, hown, hslots, _, _⟩ := hpre + obtain ⟨hmajorBound, hmajorSlot⟩ := + hslots majorAbs major hmajor + have hresolve : + resolveAtom env (.var (Γ.rel majorAbs)) = .ok major := + (AValRealizes.slot hmajorBound hmajorSlot).resolveAtom + have howned : RootOwnership store + (⟨.shared, major⟩ :: roots ++ rest) := by + have hcanonical : RootOwnership store + (roots ++ ⟨.shared, major⟩ :: rest) := by + simpa [List.append_assoc] using hown + exact hcanonical.perm (by + simpa using + (permExtractRoot ⟨.shared, major⟩ roots [] rest)) + have hdrop : ∃ fuel store', + runOp ctx fuel cur store env (.drop (.var (Γ.rel majorAbs))) = + .ok (store', .erased) ∧ + Sim.StoreGraphRestricts store store' ∧ + RootOwnership store' (roots ++ rest) := by + cases major with + | lit literal => + have hrun : runOp ctx 1 cur store env + (.drop (.var (Γ.rel majorAbs))) = .ok (store, .erased) := by + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + exact ⟨1, store, hrun, Sim.StoreGraphRestricts.refl store, + howned.dropNoLocation rfl⟩ + | erased => + have hrun : runOp ctx 1 cur store env + (.drop (.var (Γ.rel majorAbs))) = .ok (store, .erased) := by + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + exact ⟨1, store, hrun, Sim.StoreGraphRestricts.refl store, + howned.dropNoLocation rfl⟩ + | loc loc => + obtain ⟨fuel, store', hrun, hownAfter⟩ := + dropVal_progress (ctx := ctx) howned + exact ⟨fuel + 1, store', runOp_drop hresolve hrun, + Sim.dropVal_restricts hrun, hownAfter⟩ + obtain ⟨fuel, store', hrun, hrestrict, hownAfter⟩ := hdrop + have hΓAfter : VEnvValueGraph funRel recSelfRel store' + Γ sourceEnv env roots := + hΓ.ofRestricts hrestrict hownAfter + (fun root hmember => List.mem_append_left rest hmember) + have hrestAfter : Sim.RootsGraph funRel store' sourceRest rest := + hrestGraph.ofRestrictsIn hrestrict hownAfter + (fun root hmember => List.mem_append_right roots hmember) + exact ⟨fuel, store', .erased, hrun, + ⟨⟨roots, hΓAfter.bump .erased, hrestAfter, hownAfter⟩, + hslots.bump .erased⟩⟩ + +/-- Every proof-relevant release plan executes successfully while preserving +the complete source-value graph and arbitrary protected caller frame. -/ +theorem ReleasePlan.valueProgress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {input output : VEnv} {drops : List SlotDrop} {emit : Emit} + (hplan : ReleasePlan input drops output emit) + (sourceEnv : List IxIR0.Value) : + ∀ sourceRest rest slots, + EmitProgress ctx cur emit + (GraphOwnsVEnvProtected funRel recSelfRel input + sourceEnv sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel output + sourceEnv sourceRest rest slots) := by + intro sourceRest rest slots + apply ReleasePlan.traverse (hplan := hplan) + · intro Γ + exact EmitProgress.id + · intro Γ output i abs drops tailEmit hentry ih + exact EmitProgress.comp + (release_slot_many_value_progress hentry + sourceEnv sourceRest rest slots) + ih + · intro Γ output i abs drops tailEmit hentry ih + exact EmitProgress.comp + (release_slot_affine_value_progress hentry + sourceEnv sourceRest rest slots) + ih + +/-- Total-progress composition for the generated recursor prefix. The +field-retain plan protects every rule field needed by the RHS, the selected +major is then released, and the parameter-release plan brings the target +environment to the rule body's input layout. -/ +theorem recursorPrefixPlans_valueProgress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + (numArgs nf : Nat) (rhs : IxIR0.Expr) + {fieldOutput rhsInput : VEnv} {fieldEmit parameterEmit : Emit} + (hfieldPlan : FieldRetainPlan + ⟨List.replicate nf (.slot 0 0 .many false), + (numArgs + 1) + nf⟩ + (recursorFieldRetains (numArgs + 1) rhs nf) + fieldOutput fieldEmit) + (hparameterPlan : ReleasePlan + ⟨fieldOutput.entries ++ + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (nf + i) rhs) ++ + [.recSelf (numArgs + 1)], + fieldOutput.depth + 1⟩ + ((parameterDrops 0 (List.replicate numArgs .many) + (fun i => countUses (nf + i) rhs)).map + (SlotDrop.offsetEntry nf)) + rhsInput parameterEmit) : + ∀ sourceEnv sourceRest rest major fields, + EmitProgress ctx cur + (fieldEmit ∘ + emitOp (.drop (.var (fieldOutput.rel numArgs))) ∘ + parameterEmit) + (GraphOwnsVEnvRetains funRel recSelfRel + (recursorInitialVEnv numArgs nf rhs) sourceEnv + sourceRest rest [⟨.shared, major⟩] + (recursorFieldSlots numArgs (major :: fields)) fields + (recursorFieldRetains (numArgs + 1) rhs nf)) + (GraphOwnsVEnv funRel recSelfRel rhsInput sourceEnv + sourceRest rest) := by + intro sourceEnv sourceRest rest major fields + let frame := + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (nf + i) rhs) ++ + [.recSelf (numArgs + 1)] + have hfieldFramed := hfieldPlan.frameEntries frame + have hfield : EmitProgress ctx cur fieldEmit + (GraphOwnsVEnvRetains funRel recSelfRel + (recursorInitialVEnv numArgs nf rhs) sourceEnv + sourceRest rest [⟨.shared, major⟩] + (recursorFieldSlots numArgs (major :: fields)) fields + (recursorFieldRetains (numArgs + 1) rhs nf)) + (GraphOwnsVEnvRetains funRel recSelfRel + (frameVEnvEntries fieldOutput frame) sourceEnv + sourceRest rest [⟨.shared, major⟩] + (recursorFieldSlots numArgs (major :: fields)) fields []) := by + have hprogress := hfieldFramed.valueProgress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) + sourceEnv sourceRest rest [⟨.shared, major⟩] + (recursorFieldSlots numArgs (major :: fields)) fields + simpa [frame, recursorInitialVEnv, frameVEnvEntries, + List.append_assoc] using hprogress + have hmajor : EmitProgress ctx cur + (emitOp (.drop (.var + ((frameVEnvEntries fieldOutput frame).rel numArgs)))) + (GraphOwnsVEnvRetains funRel recSelfRel + (frameVEnvEntries fieldOutput frame) sourceEnv + sourceRest rest [⟨.shared, major⟩] + (recursorFieldSlots numArgs (major :: fields)) fields []) + (GraphOwnsVEnvProtected funRel recSelfRel + (frameVEnvEntries fieldOutput frame).bump sourceEnv + sourceRest rest + (recursorFieldSlots numArgs (major :: fields))) := + drop_major_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) + (by simp [recursorFieldSlots]) + have hparameters : EmitProgress ctx cur parameterEmit + (GraphOwnsVEnvProtected funRel recSelfRel + (frameVEnvEntries fieldOutput frame).bump sourceEnv + sourceRest rest + (recursorFieldSlots numArgs (major :: fields))) + (GraphOwnsVEnvProtected funRel recSelfRel rhsInput sourceEnv + sourceRest rest + (recursorFieldSlots numArgs (major :: fields))) := by + have hprogress := hparameterPlan.valueProgress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) sourceEnv sourceRest rest + (recursorFieldSlots numArgs (major :: fields)) + simpa [frameVEnvEntries, VEnv.bump, frame, List.append_assoc] + using hprogress + have hforget : EmitProgress ctx cur (_root_.id : Emit) + (GraphOwnsVEnvProtected funRel recSelfRel rhsInput sourceEnv + sourceRest rest + (recursorFieldSlots numArgs (major :: fields))) + (GraphOwnsVEnv funRel recSelfRel rhsInput sourceEnv + sourceRest rest) := + EmitProgress.strengthen (fun h => h.1) + have hcomposed := EmitProgress.comp hfield + (EmitProgress.comp hmajor + (EmitProgress.comp hparameters hforget)) + simpa [frameVEnvEntries, VEnv.rel, Function.comp_def] using hcomposed + +/-- Prefixing a progressing expression with a generated release plan +preserves both partial correctness and existential target termination. -/ +theorem LowerResultValueProgress.afterRelease + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input middle output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {releaseEmit emit : Emit} + {world : Owned} {av : AVal} {drops : List SlotDrop} + (hbody : LowerResultValueProgress funRel recSelfRel ctx cur + middle output sourceInput sourceOutput sourceValue world emit av) + (hrelease : ReleasePlan input drops middle releaseEmit) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue world (releaseEmit ∘ emit) av := by + refine + { toLowerResultValueSound := + hbody.toLowerResultValueSound.afterRelease + (hrelease.valueSound sourceInput) + graphProgress := ?_ } + intro sourceRest rest slots + exact EmitProgress.comp + (hrelease.valueProgress sourceInput sourceRest rest slots) + (hbody.graphProgress sourceRest rest slots) + +/-- Forget a released first logical binder from a progressing result. -/ +theorem LowerResultValueProgress.popFirstReleased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {boundSource sourceValue : IxIR0.Value} + {world : Owned} {emit : Emit} {av : AVal} + (hprogress : LowerResultValueProgress funRel recSelfRel ctx cur + input output sourceInput (boundSource :: sourceOutput) + sourceValue world emit av) + (hfirst : FirstEntryReleased output) : + LowerResultValueProgress funRel recSelfRel ctx cur input output.pop + sourceInput sourceOutput sourceValue world emit av := by + refine + { toLowerResultValueSound := + hprogress.toLowerResultValueSound.popFirstReleased hfirst + graphProgress := ?_ } + intro sourceRest rest slots + have hpop : EmitProgress ctx cur (_root_.id : Emit) + (GraphOwnsResultProtected funRel recSelfRel output + (boundSource :: sourceOutput) sourceValue world av + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.pop + sourceOutput sourceValue world av sourceRest rest slots) := by + apply EmitProgress.strengthen + intro store env hpre + obtain ⟨⟨roots, value, houtput, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + refine ⟨⟨roots, value, houtput.pop_firstReleased hfirst, + hav.of_depth_eq (by simp [VEnv.pop]), hvalueGraph, + hrestGraph, hown⟩, ?_⟩ + exact SlotsRealize.of_depth_eq (by simp [VEnv.pop]) hslots + have hcomposed := EmitProgress.comp + (hprogress.graphProgress sourceRest rest slots) hpop + simpa [Function.comp_def] using hcomposed + +/-- Sequence a progressing bound value, binder installation, and body, then +remove the released logical binder. -/ +theorem LowerResultValueProgress.installThen + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {input middle installed output : VEnv} + {sourceInput sourceMiddle sourceOutput : List IxIR0.Value} + {boundSource sourceResult : IxIR0.Value} + {boundWorld resultWorld : Owned} + {boundEmit installEmit bodyEmit : Emit} + {boundValue result : AVal} + (hbound : LowerResultValueProgress funRel recSelfRel ctx cur + input middle sourceInput sourceMiddle boundSource boundWorld + boundEmit boundValue) + (hinstall : InstallBinderValueProgress funRel recSelfRel ctx cur + middle installed sourceMiddle boundSource boundWorld boundValue + installEmit) + (hbody : LowerResultValueProgress funRel recSelfRel ctx cur + installed output (boundSource :: sourceMiddle) + (boundSource :: sourceOutput) sourceResult resultWorld + bodyEmit result) + (hreleased : FirstEntryReleased output) : + LowerResultValueProgress funRel recSelfRel ctx cur input output.pop + sourceInput sourceOutput sourceResult resultWorld + ((boundEmit ∘ installEmit) ∘ bodyEmit) result := by + have hpopped := hbody.popFirstReleased hreleased + refine + { toLowerResultValueSound := + hbound.toLowerResultValueSound.installThen + hinstall.toInstallBinderValueSound hbody.toLowerResultValueSound + hreleased + graphProgress := ?_ } + intro sourceRest rest slots + have hcomposed := EmitProgress.comp + (hbound.graphProgress sourceRest rest slots) + (EmitProgress.comp (hinstall.graphProgress sourceRest rest slots) + (hpopped.graphProgress sourceRest rest slots)) + simpa [Function.comp_def] using hcomposed + +theorem LowerResultValueSettlement.popFirstReleased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {boundSource sourceValue : IxIR0.Value} + {world : Owned} {emit : Emit} {av : AVal} + (hsettles : LowerResultValueSettlement funRel recSelfRel ctx cur + input output sourceInput (boundSource :: sourceOutput) + sourceValue world emit av) + (hfirst : FirstEntryReleased output) : + LowerResultValueSettlement funRel recSelfRel ctx cur input output.pop + sourceInput sourceOutput sourceValue world emit av := by + refine + { toLowerResultValueSound := + hsettles.toLowerResultValueSound.popFirstReleased hfirst + graphSettlement := ?_ } + intro sourceRest rest slots + have hpop : EmitSettlement ctx cur (_root_.id : Emit) + (GraphOwnsResultProtected funRel recSelfRel output + (boundSource :: sourceOutput) sourceValue world av + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.pop + sourceOutput sourceValue world av sourceRest rest slots) := by + apply EmitSettlement.strengthen + intro store env hpre + obtain ⟨⟨roots, value, houtput, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + refine ⟨⟨roots, value, houtput.pop_firstReleased hfirst, + hav.of_depth_eq (by simp [VEnv.pop]), hvalueGraph, + hrestGraph, hown⟩, ?_⟩ + exact SlotsRealize.of_depth_eq (by simp [VEnv.pop]) hslots + have hcomposed := EmitSettlement.comp + (hsettles.graphSettlement sourceRest rest slots) hpop + simpa [Function.comp_def] using hcomposed + +/-- Sequence a settling bound value, total binder installation, and a +settling body, then remove the released logical binder. -/ +theorem LowerResultValueSettlement.installThen + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {input middle installed output : VEnv} + {sourceInput sourceMiddle sourceOutput : List IxIR0.Value} + {boundSource sourceResult : IxIR0.Value} + {boundWorld resultWorld : Owned} + {boundEmit installEmit bodyEmit : Emit} + {boundValue result : AVal} + (hbound : LowerResultValueSettlement funRel recSelfRel ctx cur + input middle sourceInput sourceMiddle boundSource boundWorld + boundEmit boundValue) + (hinstall : InstallBinderValueProgress funRel recSelfRel ctx cur + middle installed sourceMiddle boundSource boundWorld boundValue + installEmit) + (hbody : LowerResultValueSettlement funRel recSelfRel ctx cur + installed output (boundSource :: sourceMiddle) + (boundSource :: sourceOutput) sourceResult resultWorld + bodyEmit result) + (hreleased : FirstEntryReleased output) : + LowerResultValueSettlement funRel recSelfRel ctx cur input output.pop + sourceInput sourceOutput sourceResult resultWorld + ((boundEmit ∘ installEmit) ∘ bodyEmit) result := by + have hpopped := hbody.popFirstReleased hreleased + refine + { toLowerResultValueSound := + hbound.toLowerResultValueSound.installThen + hinstall.toInstallBinderValueSound hbody.toLowerResultValueSound + hreleased + graphSettlement := ?_ } + intro sourceRest rest slots + have hcomposed := EmitSettlement.comp + (hbound.graphSettlement sourceRest rest slots) + (EmitSettlement.comp + (hinstall.graphProgress sourceRest rest slots).settles + (hpopped.graphSettlement sourceRest rest slots)) + simpa [Function.comp_def] using hcomposed + +/-- Progressing semantic let branch of `lowerE`. The value emitter, binder +installation (including any eager release), and body emitter are all total on +the graph-owned states established by the preceding stage. -/ +theorem lowerE_let_run_value_progress + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Owned} {uses : Uses} + {value body : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + {boundSource sourceValue : IxIR0.Value} + (hrecursive : ∀ {middle bodyInput bodyOutput : VEnv} + {valueEmit bodyEmit : Emit} {boundValue resultValue : AVal} + {valueState bodyState bodyFinal : LowSt}, + (lowerE src fuel input (worldOfUses uses) value).run state = + .ok (middle, valueEmit, boundValue) valueState → + (lowerE src fuel bodyInput world body).run bodyState = + .ok (bodyOutput, bodyEmit, resultValue) bodyFinal → + bodyState = valueState → + ExtraExtends bodyFinal finalState → + (NoRecSelf middle → NoRecSelf bodyInput) → + LowerResultValueProgress funRel recSelfRel ctx cur input middle + sourceEnv sourceEnv boundSource (worldOfUses uses) + valueEmit boundValue ∧ + LowerResultValueProgress funRel recSelfRel ctx cur bodyInput bodyOutput + (boundSource :: sourceEnv) (boundSource :: sourceEnv) + sourceValue world bodyEmit resultValue) + (hreleases : LowerEReleasesTrackedFirst src fuel body) + (hrun : (lowerE src (fuel + 1) input world + (.letE uses value body)).run state = + .ok (output, emit, av) finalState) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue world emit av := by + simp only [lowerE] at hrun + obtain ⟨valueResult, valueState, hvalueRun, hafterValue⟩ := + trackedBindRun_ok_inv hrun + rcases valueResult with ⟨middle, valueEmit, boundValue⟩ + cases boundValue with + | slotA abs => + by_cases hzero : countUses 0 body = 0 + · cases uses with + | erased => + obtain ⟨_, _, hthrow, _⟩ := trackedBindRun_ok_inv + (by simpa [hzero] using hafterValue) + exact (trackedThrowRun_not_ok hthrow).elim + | linear => + obtain ⟨_, _, hthrow, _⟩ := trackedBindRun_ok_inv + (by simpa [hzero] using hafterValue) + exact (trackedThrowRun_not_ok hthrow).elim + | affine => + let heldInput := + installAliasBinder middle abs 0 Uses.affine true + let bodyInput := + (heldInput.setEntry 0 (.slot abs 0 .affine false)).bump + have hcontinue : + ((lowerE src fuel bodyInput world body) >>= fun result => + let (bodyOutput, bodyEmit, resultValue) := result + pure (bodyOutput.pop, + valueEmit ∘ emitOp (.dropU (.var (middle.rel abs))) ∘ + bodyEmit, + resultValue)).run valueState = + .ok (output, emit, av) finalState := by + simpa [hzero, heldInput, bodyInput, installAliasBinder, + VEnv.setEntry, VEnv.bump] using hafterValue + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + trackedBindRun_ok_inv hcontinue + rcases bodyResult with ⟨bodyOutput, bodyEmit, resultValue⟩ + have hpure : + (bodyOutput.pop, + valueEmit ∘ emitOp (.dropU (.var (middle.rel abs))) ∘ + bodyEmit, + resultValue) = (output, emit, av) ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + obtain ⟨hvalueProgress, hbodyProgress⟩ := + hrecursive hvalueRun hbodyRun rfl (ExtraExtends.refl _) (by + intro hno + have hinstalled := + (hno.consSlot abs 0 .affine true).setSlot + 0 abs 0 .affine false + simpa [bodyInput, heldInput, installAliasBinder] using + hinstalled.bump) + have htracked : FirstEntryTracks bodyInput .affine + (countUses 0 body) := by + refine ⟨abs, middle.entries, ?_⟩ + simp [bodyInput, heldInput, + installAliasBinder, VEnv.setEntry, VEnv.bump, hzero] + have hreleased := hreleases htracked hbodyRun + have hentry : heldInput.entries[0]? = + some (.slot abs 0 Uses.affine true) := by + simp [heldInput, installAliasBinder] + have hinstall : InstallBinderValueProgress funRel recSelfRel ctx cur + middle bodyInput sourceEnv boundSource .unique (.slotA abs) + (emitOp (.dropU (.var (middle.rel abs)))) := by + refine { toInstallBinderValueSound := ?_, graphProgress := ?_ } + · refine { toInstallBinderSound := ?_, graphEmits := ?_ } + · intro rest slots + have halias := installAliasBinder_held + (ctx := ctx) (cur := cur) (Γ := middle) (abs := abs) + (remaining := 0) (uses := Uses.affine) rest slots + have hdrop := release_slot_affine_owned + (ctx := ctx) (cur := cur) (Γ := heldInput) (i := 0) + (abs := abs) hentry rest slots + have hcomposed := EmitSound.comp halias hdrop + simpa [bodyInput, heldInput, installAliasBinder, VEnv.rel, + worldOfUses, Function.comp_def] using hcomposed + · intro sourceRest rest slots + have halias := installAliasBinder_held_value_sound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (abs := abs) (remaining := 0) (uses := Uses.affine) + have hdrop := release_slot_affine_value_sound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := heldInput) (i := 0) + (abs := abs) hentry + (boundSource :: sourceEnv) sourceRest rest slots + have hcomposed := EmitSound.comp + (halias.graphEmits sourceRest rest slots) hdrop + simpa [bodyInput, heldInput, installAliasBinder, VEnv.rel, + worldOfUses, Function.comp_def] using hcomposed + · intro sourceRest rest slots + have halias := installAliasBinder_held_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (abs := abs) (remaining := 0) (uses := Uses.affine) + have hdrop := release_slot_affine_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := heldInput) (i := 0) + (abs := abs) hentry + (boundSource :: sourceEnv) sourceRest rest slots + have hcomposed := EmitProgress.comp + (halias.graphProgress sourceRest rest slots) hdrop + simpa [bodyInput, heldInput, installAliasBinder, VEnv.rel, + worldOfUses, Function.comp_def] using hcomposed + have hprogress := + hvalueProgress.installThen hinstall hbodyProgress hreleased + simpa [worldOfUses, Function.comp_def] using hprogress + | many => + let heldInput := installAliasBinder middle abs 0 Uses.many true + let bodyInput := + (heldInput.setEntry 0 (.slot abs 0 .many false)).bump + have hcontinue : + ((lowerE src fuel bodyInput world body) >>= fun result => + let (bodyOutput, bodyEmit, resultValue) := result + pure (bodyOutput.pop, + valueEmit ∘ emitOp (.drop (.var (middle.rel abs))) ∘ + bodyEmit, + resultValue)).run valueState = + .ok (output, emit, av) finalState := by + simpa [hzero, heldInput, bodyInput, installAliasBinder, + VEnv.setEntry, VEnv.bump] using hafterValue + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + trackedBindRun_ok_inv hcontinue + rcases bodyResult with ⟨bodyOutput, bodyEmit, resultValue⟩ + have hpure : + (bodyOutput.pop, + valueEmit ∘ emitOp (.drop (.var (middle.rel abs))) ∘ + bodyEmit, + resultValue) = (output, emit, av) ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + obtain ⟨hvalueProgress, hbodyProgress⟩ := + hrecursive hvalueRun hbodyRun rfl (ExtraExtends.refl _) (by + intro hno + have hinstalled := + (hno.consSlot abs 0 .many true).setSlot + 0 abs 0 .many false + simpa [bodyInput, heldInput, installAliasBinder] using + hinstalled.bump) + have htracked : FirstEntryTracks bodyInput .many + (countUses 0 body) := by + refine ⟨abs, middle.entries, ?_⟩ + simp [bodyInput, heldInput, + installAliasBinder, VEnv.setEntry, VEnv.bump, hzero] + have hreleased := hreleases htracked hbodyRun + have hentry : heldInput.entries[0]? = + some (.slot abs 0 Uses.many true) := by + simp [heldInput, installAliasBinder] + have hinstall : InstallBinderValueProgress funRel recSelfRel ctx cur + middle bodyInput sourceEnv boundSource .shared (.slotA abs) + (emitOp (.drop (.var (middle.rel abs)))) := by + refine { toInstallBinderValueSound := ?_, graphProgress := ?_ } + · refine { toInstallBinderSound := ?_, graphEmits := ?_ } + · intro rest slots + have halias := installAliasBinder_held + (ctx := ctx) (cur := cur) (Γ := middle) (abs := abs) + (remaining := 0) (uses := Uses.many) rest slots + have hdrop := release_slot_many_owned + (ctx := ctx) (cur := cur) (Γ := heldInput) (i := 0) + (abs := abs) hentry rest slots + have hcomposed := EmitSound.comp halias hdrop + simpa [bodyInput, heldInput, installAliasBinder, VEnv.rel, + worldOfUses, Function.comp_def] using hcomposed + · intro sourceRest rest slots + have halias := installAliasBinder_held_value_sound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (abs := abs) (remaining := 0) (uses := Uses.many) + have hdrop := release_slot_many_value_sound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := heldInput) (i := 0) + (abs := abs) hentry + (boundSource :: sourceEnv) sourceRest rest slots + have hcomposed := EmitSound.comp + (halias.graphEmits sourceRest rest slots) hdrop + simpa [bodyInput, heldInput, installAliasBinder, VEnv.rel, + worldOfUses, Function.comp_def] using hcomposed + · intro sourceRest rest slots + have halias := installAliasBinder_held_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (abs := abs) (remaining := 0) (uses := Uses.many) + have hdrop := release_slot_many_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := heldInput) (i := 0) + (abs := abs) hentry + (boundSource :: sourceEnv) sourceRest rest slots + have hcomposed := EmitProgress.comp + (halias.graphProgress sourceRest rest slots) hdrop + simpa [bodyInput, heldInput, installAliasBinder, VEnv.rel, + worldOfUses, Function.comp_def] using hcomposed + have hprogress := + hvalueProgress.installThen hinstall hbodyProgress hreleased + simpa [worldOfUses, Function.comp_def] using hprogress + · let bodyInput := installAliasBinder middle abs + (countUses 0 body) uses true + have hcontinue : + ((lowerE src fuel bodyInput world body) >>= fun result => + let (bodyOutput, bodyEmit, resultValue) := result + pure (bodyOutput.pop, valueEmit ∘ bodyEmit, resultValue)).run + valueState = .ok (output, emit, av) finalState := by + simpa [hzero, bodyInput, installAliasBinder] using hafterValue + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + trackedBindRun_ok_inv hcontinue + rcases bodyResult with ⟨bodyOutput, bodyEmit, resultValue⟩ + have hpure : + (bodyOutput.pop, valueEmit ∘ bodyEmit, resultValue) = + (output, emit, av) ∧ bodyState = finalState := by + simpa using hafterBody + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + obtain ⟨hvalueProgress, hbodyProgress⟩ := + hrecursive hvalueRun hbodyRun rfl (ExtraExtends.refl _) (by + intro hno + simpa [bodyInput, installAliasBinder] using + hno.consSlot abs (countUses 0 body) uses true) + have htracked : FirstEntryTracks bodyInput uses + (countUses 0 body) := by + refine ⟨abs, middle.entries, ?_⟩ + simp [bodyInput, installAliasBinder, hzero] + have hreleased := hreleases htracked hbodyRun + have hinstall := installAliasBinder_held_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (abs := abs) (remaining := countUses 0 body) (uses := uses) + have hprogress := + hvalueProgress.installThen hinstall hbodyProgress hreleased + simpa [Function.comp_def] using hprogress + | constA atom => + by_cases hzero : countUses 0 body = 0 + · let bodyInput := installPushedBinder middle 0 uses false + have hcontinue : + ((lowerE src fuel bodyInput world body) >>= fun result => + let (bodyOutput, bodyEmit, resultValue) := result + pure (bodyOutput.pop, + valueEmit ∘ emitOp (.pure atom) ∘ bodyEmit, + resultValue)).run valueState = + .ok (output, emit, av) finalState := by + simpa [hzero, bodyInput, installPushedBinder] using hafterValue + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + trackedBindRun_ok_inv hcontinue + rcases bodyResult with ⟨bodyOutput, bodyEmit, resultValue⟩ + have hpure : + (bodyOutput.pop, valueEmit ∘ emitOp (.pure atom) ∘ bodyEmit, + resultValue) = (output, emit, av) ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + obtain ⟨hvalueProgress, hbodyProgress⟩ := + hrecursive hvalueRun hbodyRun rfl (ExtraExtends.refl _) (by + intro hno + simpa [bodyInput, installPushedBinder, VEnv.bump] using + (hno.consSlot middle.depth 0 uses false).bump) + have htracked : FirstEntryTracks bodyInput uses + (countUses 0 body) := by + refine ⟨middle.depth, middle.entries, ?_⟩ + simp [bodyInput, installPushedBinder, hzero] + have hreleased := hreleases htracked hbodyRun + have hinstall := materializeConstBinder_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (atom := atom) (remaining := 0) + (uses := uses) (held := false) hvalueProgress.stable + have hprogress := + hvalueProgress.installThen hinstall hbodyProgress hreleased + simpa [worldOfUses, Function.comp_def] using hprogress + · let bodyInput := installPushedBinder middle (countUses 0 body) + uses true + have hcontinue : + ((lowerE src fuel bodyInput world body) >>= fun result => + let (bodyOutput, bodyEmit, resultValue) := result + pure (bodyOutput.pop, + valueEmit ∘ emitOp (.pure atom) ∘ bodyEmit, + resultValue)).run valueState = + .ok (output, emit, av) finalState := by + simpa [hzero, bodyInput, installPushedBinder] using hafterValue + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + trackedBindRun_ok_inv hcontinue + rcases bodyResult with ⟨bodyOutput, bodyEmit, resultValue⟩ + have hpure : + (bodyOutput.pop, valueEmit ∘ emitOp (.pure atom) ∘ bodyEmit, + resultValue) = (output, emit, av) ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + obtain ⟨hvalueProgress, hbodyProgress⟩ := + hrecursive hvalueRun hbodyRun rfl (ExtraExtends.refl _) (by + intro hno + simpa [bodyInput, installPushedBinder, VEnv.bump] using + (hno.consSlot middle.depth (countUses 0 body) uses true).bump) + have htracked : FirstEntryTracks bodyInput uses + (countUses 0 body) := by + refine ⟨middle.depth, middle.entries, ?_⟩ + simp [bodyInput, installPushedBinder, hzero] + have hreleased := hreleases htracked hbodyRun + have hinstall := materializeConstBinder_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (atom := atom) (remaining := countUses 0 body) + (uses := uses) (held := true) hvalueProgress.stable + have hprogress := + hvalueProgress.installThen hinstall hbodyProgress hreleased + simpa [worldOfUses, Function.comp_def] using hprogress + +/-- Reachable-state let progress. The suffix relation from the body to the +ambient compiler state also makes the earlier value run reachable, while the +no-self transport rebuilds progress availability for the installed binder. -/ +theorem lowerE_let_run_value_progress_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEValueProgressesWithin funRel recSelfRel sourceCtx ctx cur + src ambient fuel) + {input output : VEnv} {world : Owned} {uses : Uses} + {value body : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + {valueFuel bodyFuel : Nat} + {boundSource sourceValue : IxIR0.Value} + (hvalueSource : IxIR0.eval sourceCtx valueFuel sourceEnv value = + .ok boundSource) + (hbodySource : IxIR0.eval sourceCtx bodyFuel + (boundSource :: sourceEnv) body = .ok sourceValue) + (hreleases : LowerEReleasesTrackedFirst src fuel body) + (hrun : (lowerE src (fuel + 1) input world + (.letE uses value body)).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue world emit av := by + apply lowerE_let_run_value_progress + · intro middle bodyInput bodyOutput valueEmit bodyEmit boundValue + resultValue valueState bodyState bodyFinal hvalueRun hbodyRun + hbodyState hbodyFinal hbodyNo + subst bodyState + have hbodyExtends : ExtraExtends bodyFinal ambient := + hbodyFinal.trans hextends + have hvalueExtends : ExtraExtends valueState ambient := + (lowerE_extraExtends hbodyRun).trans hbodyExtends + have hmiddleAvailable := havailable.lowerE hvalueRun + exact ⟨hexpr hvalueSource hvalueRun hvalueExtends havailable, + hexpr hbodySource hbodyRun hbodyExtends + (hmiddleAvailable.mapNoRecSelf hbodyNo)⟩ + · exact hreleases + · exact hrun + +/-- Projection-safe reachable-state let progress. Safety is threaded +separately through the bound expression and the body under its new source +binder. -/ +theorem lowerE_let_run_value_progress_safely_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEValueProgressesSafelyWithin funRel recSelfRel sourceCtx + ctx cur src ambient fuel) + {input output : VEnv} {world : Owned} {uses : Uses} + {value body : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + {boundSource sourceValue : IxIR0.Value} + (hvalueSource : ProjectionSafeEval sourceCtx sourceEnv value + boundSource) + (hbodySource : ProjectionSafeEval sourceCtx (boundSource :: sourceEnv) + body sourceValue) + (hreleases : LowerEReleasesTrackedFirst src fuel body) + (hrun : (lowerE src (fuel + 1) input world + (.letE uses value body)).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue world emit av := by + apply lowerE_let_run_value_progress + · intro middle bodyInput bodyOutput valueEmit bodyEmit boundValue + resultValue valueState bodyState bodyFinal hvalueRun hbodyRun + hbodyState hbodyFinal hbodyNo + subst bodyState + have hbodyExtends : ExtraExtends bodyFinal ambient := + hbodyFinal.trans hextends + have hvalueExtends : ExtraExtends valueState ambient := + (lowerE_extraExtends hbodyRun).trans hbodyExtends + have hmiddleAvailable := havailable.lowerE hvalueRun + exact ⟨hexpr hvalueSource hvalueRun hvalueExtends havailable, + hexpr hbodySource hbodyRun hbodyExtends + (hmiddleAvailable.mapNoRecSelf hbodyNo)⟩ + · exact hreleases + · exact hrun + +/-- Settling semantic let branch of `lowerE`. The value emitter, binder +installation (including any eager release), and body emitter are all total on +the graph-owned states established by the preceding stage. -/ +theorem lowerE_let_run_value_settlement + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Owned} {uses : Uses} + {value body : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + {boundSource sourceValue : IxIR0.Value} + (hrecursive : ∀ {middle bodyInput bodyOutput : VEnv} + {valueEmit bodyEmit : Emit} {boundValue resultValue : AVal} + {valueState bodyState bodyFinal : LowSt}, + (lowerE src fuel input (worldOfUses uses) value).run state = + .ok (middle, valueEmit, boundValue) valueState → + (lowerE src fuel bodyInput world body).run bodyState = + .ok (bodyOutput, bodyEmit, resultValue) bodyFinal → + bodyState = valueState → + ExtraExtends bodyFinal finalState → + (NoRecSelf middle → NoRecSelf bodyInput) → + LowerResultValueSettlement funRel recSelfRel ctx cur input middle + sourceEnv sourceEnv boundSource (worldOfUses uses) + valueEmit boundValue ∧ + LowerResultValueSettlement funRel recSelfRel ctx cur bodyInput bodyOutput + (boundSource :: sourceEnv) (boundSource :: sourceEnv) + sourceValue world bodyEmit resultValue) + (hreleases : LowerEReleasesTrackedFirst src fuel body) + (hrun : (lowerE src (fuel + 1) input world + (.letE uses value body)).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSettlement funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue world emit av := by + simp only [lowerE] at hrun + obtain ⟨valueResult, valueState, hvalueRun, hafterValue⟩ := + trackedBindRun_ok_inv hrun + rcases valueResult with ⟨middle, valueEmit, boundValue⟩ + cases boundValue with + | slotA abs => + by_cases hzero : countUses 0 body = 0 + · cases uses with + | erased => + obtain ⟨_, _, hthrow, _⟩ := trackedBindRun_ok_inv + (by simpa [hzero] using hafterValue) + exact (trackedThrowRun_not_ok hthrow).elim + | linear => + obtain ⟨_, _, hthrow, _⟩ := trackedBindRun_ok_inv + (by simpa [hzero] using hafterValue) + exact (trackedThrowRun_not_ok hthrow).elim + | affine => + let heldInput := + installAliasBinder middle abs 0 Uses.affine true + let bodyInput := + (heldInput.setEntry 0 (.slot abs 0 .affine false)).bump + have hcontinue : + ((lowerE src fuel bodyInput world body) >>= fun result => + let (bodyOutput, bodyEmit, resultValue) := result + pure (bodyOutput.pop, + valueEmit ∘ emitOp (.dropU (.var (middle.rel abs))) ∘ + bodyEmit, + resultValue)).run valueState = + .ok (output, emit, av) finalState := by + simpa [hzero, heldInput, bodyInput, installAliasBinder, + VEnv.setEntry, VEnv.bump] using hafterValue + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + trackedBindRun_ok_inv hcontinue + rcases bodyResult with ⟨bodyOutput, bodyEmit, resultValue⟩ + have hpure : + (bodyOutput.pop, + valueEmit ∘ emitOp (.dropU (.var (middle.rel abs))) ∘ + bodyEmit, + resultValue) = (output, emit, av) ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + obtain ⟨hvalueProgress, hbodyProgress⟩ := + hrecursive hvalueRun hbodyRun rfl (ExtraExtends.refl _) (by + intro hno + have hinstalled := + (hno.consSlot abs 0 .affine true).setSlot + 0 abs 0 .affine false + simpa [bodyInput, heldInput, installAliasBinder] using + hinstalled.bump) + have htracked : FirstEntryTracks bodyInput .affine + (countUses 0 body) := by + refine ⟨abs, middle.entries, ?_⟩ + simp [bodyInput, heldInput, + installAliasBinder, VEnv.setEntry, VEnv.bump, hzero] + have hreleased := hreleases htracked hbodyRun + have hentry : heldInput.entries[0]? = + some (.slot abs 0 Uses.affine true) := by + simp [heldInput, installAliasBinder] + have hinstall : InstallBinderValueProgress funRel recSelfRel ctx cur + middle bodyInput sourceEnv boundSource .unique (.slotA abs) + (emitOp (.dropU (.var (middle.rel abs)))) := by + refine { toInstallBinderValueSound := ?_, graphProgress := ?_ } + · refine { toInstallBinderSound := ?_, graphEmits := ?_ } + · intro rest slots + have halias := installAliasBinder_held + (ctx := ctx) (cur := cur) (Γ := middle) (abs := abs) + (remaining := 0) (uses := Uses.affine) rest slots + have hdrop := release_slot_affine_owned + (ctx := ctx) (cur := cur) (Γ := heldInput) (i := 0) + (abs := abs) hentry rest slots + have hcomposed := EmitSound.comp halias hdrop + simpa [bodyInput, heldInput, installAliasBinder, VEnv.rel, + worldOfUses, Function.comp_def] using hcomposed + · intro sourceRest rest slots + have halias := installAliasBinder_held_value_sound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (abs := abs) (remaining := 0) (uses := Uses.affine) + have hdrop := release_slot_affine_value_sound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := heldInput) (i := 0) + (abs := abs) hentry + (boundSource :: sourceEnv) sourceRest rest slots + have hcomposed := EmitSound.comp + (halias.graphEmits sourceRest rest slots) hdrop + simpa [bodyInput, heldInput, installAliasBinder, VEnv.rel, + worldOfUses, Function.comp_def] using hcomposed + · intro sourceRest rest slots + have halias := installAliasBinder_held_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (abs := abs) (remaining := 0) (uses := Uses.affine) + have hdrop := release_slot_affine_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := heldInput) (i := 0) + (abs := abs) hentry + (boundSource :: sourceEnv) sourceRest rest slots + have hcomposed := EmitProgress.comp + (halias.graphProgress sourceRest rest slots) hdrop + simpa [bodyInput, heldInput, installAliasBinder, VEnv.rel, + worldOfUses, Function.comp_def] using hcomposed + have hprogress := + hvalueProgress.installThen hinstall hbodyProgress hreleased + simpa [worldOfUses, Function.comp_def] using hprogress + | many => + let heldInput := installAliasBinder middle abs 0 Uses.many true + let bodyInput := + (heldInput.setEntry 0 (.slot abs 0 .many false)).bump + have hcontinue : + ((lowerE src fuel bodyInput world body) >>= fun result => + let (bodyOutput, bodyEmit, resultValue) := result + pure (bodyOutput.pop, + valueEmit ∘ emitOp (.drop (.var (middle.rel abs))) ∘ + bodyEmit, + resultValue)).run valueState = + .ok (output, emit, av) finalState := by + simpa [hzero, heldInput, bodyInput, installAliasBinder, + VEnv.setEntry, VEnv.bump] using hafterValue + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + trackedBindRun_ok_inv hcontinue + rcases bodyResult with ⟨bodyOutput, bodyEmit, resultValue⟩ + have hpure : + (bodyOutput.pop, + valueEmit ∘ emitOp (.drop (.var (middle.rel abs))) ∘ + bodyEmit, + resultValue) = (output, emit, av) ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + obtain ⟨hvalueProgress, hbodyProgress⟩ := + hrecursive hvalueRun hbodyRun rfl (ExtraExtends.refl _) (by + intro hno + have hinstalled := + (hno.consSlot abs 0 .many true).setSlot + 0 abs 0 .many false + simpa [bodyInput, heldInput, installAliasBinder] using + hinstalled.bump) + have htracked : FirstEntryTracks bodyInput .many + (countUses 0 body) := by + refine ⟨abs, middle.entries, ?_⟩ + simp [bodyInput, heldInput, + installAliasBinder, VEnv.setEntry, VEnv.bump, hzero] + have hreleased := hreleases htracked hbodyRun + have hentry : heldInput.entries[0]? = + some (.slot abs 0 Uses.many true) := by + simp [heldInput, installAliasBinder] + have hinstall : InstallBinderValueProgress funRel recSelfRel ctx cur + middle bodyInput sourceEnv boundSource .shared (.slotA abs) + (emitOp (.drop (.var (middle.rel abs)))) := by + refine { toInstallBinderValueSound := ?_, graphProgress := ?_ } + · refine { toInstallBinderSound := ?_, graphEmits := ?_ } + · intro rest slots + have halias := installAliasBinder_held + (ctx := ctx) (cur := cur) (Γ := middle) (abs := abs) + (remaining := 0) (uses := Uses.many) rest slots + have hdrop := release_slot_many_owned + (ctx := ctx) (cur := cur) (Γ := heldInput) (i := 0) + (abs := abs) hentry rest slots + have hcomposed := EmitSound.comp halias hdrop + simpa [bodyInput, heldInput, installAliasBinder, VEnv.rel, + worldOfUses, Function.comp_def] using hcomposed + · intro sourceRest rest slots + have halias := installAliasBinder_held_value_sound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (abs := abs) (remaining := 0) (uses := Uses.many) + have hdrop := release_slot_many_value_sound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := heldInput) (i := 0) + (abs := abs) hentry + (boundSource :: sourceEnv) sourceRest rest slots + have hcomposed := EmitSound.comp + (halias.graphEmits sourceRest rest slots) hdrop + simpa [bodyInput, heldInput, installAliasBinder, VEnv.rel, + worldOfUses, Function.comp_def] using hcomposed + · intro sourceRest rest slots + have halias := installAliasBinder_held_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (abs := abs) (remaining := 0) (uses := Uses.many) + have hdrop := release_slot_many_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := heldInput) (i := 0) + (abs := abs) hentry + (boundSource :: sourceEnv) sourceRest rest slots + have hcomposed := EmitProgress.comp + (halias.graphProgress sourceRest rest slots) hdrop + simpa [bodyInput, heldInput, installAliasBinder, VEnv.rel, + worldOfUses, Function.comp_def] using hcomposed + have hprogress := + hvalueProgress.installThen hinstall hbodyProgress hreleased + simpa [worldOfUses, Function.comp_def] using hprogress + · let bodyInput := installAliasBinder middle abs + (countUses 0 body) uses true + have hcontinue : + ((lowerE src fuel bodyInput world body) >>= fun result => + let (bodyOutput, bodyEmit, resultValue) := result + pure (bodyOutput.pop, valueEmit ∘ bodyEmit, resultValue)).run + valueState = .ok (output, emit, av) finalState := by + simpa [hzero, bodyInput, installAliasBinder] using hafterValue + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + trackedBindRun_ok_inv hcontinue + rcases bodyResult with ⟨bodyOutput, bodyEmit, resultValue⟩ + have hpure : + (bodyOutput.pop, valueEmit ∘ bodyEmit, resultValue) = + (output, emit, av) ∧ bodyState = finalState := by + simpa using hafterBody + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + obtain ⟨hvalueProgress, hbodyProgress⟩ := + hrecursive hvalueRun hbodyRun rfl (ExtraExtends.refl _) (by + intro hno + simpa [bodyInput, installAliasBinder] using + hno.consSlot abs (countUses 0 body) uses true) + have htracked : FirstEntryTracks bodyInput uses + (countUses 0 body) := by + refine ⟨abs, middle.entries, ?_⟩ + simp [bodyInput, installAliasBinder, hzero] + have hreleased := hreleases htracked hbodyRun + have hinstall := installAliasBinder_held_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (abs := abs) (remaining := countUses 0 body) (uses := uses) + have hprogress := + hvalueProgress.installThen hinstall hbodyProgress hreleased + simpa [Function.comp_def] using hprogress + | constA atom => + by_cases hzero : countUses 0 body = 0 + · let bodyInput := installPushedBinder middle 0 uses false + have hcontinue : + ((lowerE src fuel bodyInput world body) >>= fun result => + let (bodyOutput, bodyEmit, resultValue) := result + pure (bodyOutput.pop, + valueEmit ∘ emitOp (.pure atom) ∘ bodyEmit, + resultValue)).run valueState = + .ok (output, emit, av) finalState := by + simpa [hzero, bodyInput, installPushedBinder] using hafterValue + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + trackedBindRun_ok_inv hcontinue + rcases bodyResult with ⟨bodyOutput, bodyEmit, resultValue⟩ + have hpure : + (bodyOutput.pop, valueEmit ∘ emitOp (.pure atom) ∘ bodyEmit, + resultValue) = (output, emit, av) ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + obtain ⟨hvalueProgress, hbodyProgress⟩ := + hrecursive hvalueRun hbodyRun rfl (ExtraExtends.refl _) (by + intro hno + simpa [bodyInput, installPushedBinder, VEnv.bump] using + (hno.consSlot middle.depth 0 uses false).bump) + have htracked : FirstEntryTracks bodyInput uses + (countUses 0 body) := by + refine ⟨middle.depth, middle.entries, ?_⟩ + simp [bodyInput, installPushedBinder, hzero] + have hreleased := hreleases htracked hbodyRun + have hinstall := materializeConstBinder_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (atom := atom) (remaining := 0) + (uses := uses) (held := false) hvalueProgress.stable + have hprogress := + hvalueProgress.installThen hinstall hbodyProgress hreleased + simpa [worldOfUses, Function.comp_def] using hprogress + · let bodyInput := installPushedBinder middle (countUses 0 body) + uses true + have hcontinue : + ((lowerE src fuel bodyInput world body) >>= fun result => + let (bodyOutput, bodyEmit, resultValue) := result + pure (bodyOutput.pop, + valueEmit ∘ emitOp (.pure atom) ∘ bodyEmit, + resultValue)).run valueState = + .ok (output, emit, av) finalState := by + simpa [hzero, bodyInput, installPushedBinder] using hafterValue + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + trackedBindRun_ok_inv hcontinue + rcases bodyResult with ⟨bodyOutput, bodyEmit, resultValue⟩ + have hpure : + (bodyOutput.pop, valueEmit ∘ emitOp (.pure atom) ∘ bodyEmit, + resultValue) = (output, emit, av) ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + obtain ⟨hvalueProgress, hbodyProgress⟩ := + hrecursive hvalueRun hbodyRun rfl (ExtraExtends.refl _) (by + intro hno + simpa [bodyInput, installPushedBinder, VEnv.bump] using + (hno.consSlot middle.depth (countUses 0 body) uses true).bump) + have htracked : FirstEntryTracks bodyInput uses + (countUses 0 body) := by + refine ⟨middle.depth, middle.entries, ?_⟩ + simp [bodyInput, installPushedBinder, hzero] + have hreleased := hreleases htracked hbodyRun + have hinstall := materializeConstBinder_value_progress + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (atom := atom) (remaining := countUses 0 body) + (uses := uses) (held := true) hvalueProgress.stable + have hprogress := + hvalueProgress.installThen hinstall hbodyProgress hreleased + simpa [worldOfUses, Function.comp_def] using hprogress + +/-- Reachable-state let settlement. The suffix relation from the body to the +ambient compiler state also makes the earlier value run reachable, while the +no-self transport rebuilds progress availability for the installed binder. -/ +theorem lowerE_let_run_value_settlement_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEValueSettlesWithin funRel recSelfRel sourceCtx ctx cur + src ambient fuel) + {input output : VEnv} {world : Owned} {uses : Uses} + {value body : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + {valueFuel bodyFuel : Nat} + {boundSource sourceValue : IxIR0.Value} + (hvalueSource : IxIR0.eval sourceCtx valueFuel sourceEnv value = + .ok boundSource) + (hbodySource : IxIR0.eval sourceCtx bodyFuel + (boundSource :: sourceEnv) body = .ok sourceValue) + (hreleases : LowerEReleasesTrackedFirst src fuel body) + (hrun : (lowerE src (fuel + 1) input world + (.letE uses value body)).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfProgressAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueSettlement funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue world emit av := by + apply lowerE_let_run_value_settlement + · intro middle bodyInput bodyOutput valueEmit bodyEmit boundValue + resultValue valueState bodyState bodyFinal hvalueRun hbodyRun + hbodyState hbodyFinal hbodyNo + subst bodyState + have hbodyExtends : ExtraExtends bodyFinal ambient := + hbodyFinal.trans hextends + have hvalueExtends : ExtraExtends valueState ambient := + (lowerE_extraExtends hbodyRun).trans hbodyExtends + have hmiddleAvailable := havailable.lowerE hvalueRun + exact ⟨hexpr hvalueSource hvalueRun hvalueExtends havailable, + hexpr hbodySource hbodyRun hbodyExtends + (hmiddleAvailable.mapNoRecSelf hbodyNo)⟩ + · exact hreleases + · exact hrun + +/-- One complete projection-safe expression progress step. The source +trace rules out the erased-projection absorber, so every successful lowering +branch reaches a value rather than merely settling. -/ +theorem lowerE_run_value_progress_safely_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hexpr : LowerEValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hspine : LowerSpineValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hborrow : LowerBorrowValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hargsNext : LowerArgsValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hrestNext : ApplyRestNonErasedValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 2)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hreleases : ∀ body, LowerEReleasesTrackedFirst src fuel body) + {input output : VEnv} {world : Owned} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {av : AVal} + (hsource : ProjectionSafeEval sourceCtx sourceEnv expr sourceValue) + (hrun : (lowerE src (fuel + 1) input world expr).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceValue + world emit av := by + cases hsource with + | var hlookup => + exact lowerE_var_run_value_progress hlookup hrun + | ref href => + exact lowerE_ref_run_value_progress_safely_within henv hargsNext + hrestNext hknownExtra hcontracts hvalues hprogress (.ref href) hrun + hextends hrepresented havailable + | app hfunction hargument happly => + apply hspine + (ProjectionSafeSpine.of_eval_app (.app hfunction hargument happly)) + · simpa [lowerE] using hrun + · exact hextends + · exact havailable + | lam => + exact lowerE_lam_run_value_progress_any + (fun value address arity captures hlifted => + CompilerFunctionRel.lifted (hlifted.monoState hextends)) + (hrepresented.of_extends hextends) hrun + | letE hvalue hbody => + exact lowerE_let_run_value_progress_safely_within hexpr hvalue hbody + (hreleases _) hrun hextends havailable + | proj htarget hfield => + exact lowerE_proj_ctor_run_value_progress_safely_within henv hborrow + htarget hfield hrun hextends havailable + | lit => + exact lowerE_lit_run_value_progress hrun + | erased => + exact lowerE_erased_run_value_progress hrun + +/-! Exact-trace expression progress. -/ + +/-- Package the complete exact-trace spine rule using `lowerSpine`'s +two-step compiler-fuel accounting. -/ +theorem lowerSpineValueTraceProgressesWithinBelow_succ_succ + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + {limit fuel : Nat} + (henv : sourceCtx.env = src) + (hspine : LowerSpineValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient (fuel + 1)) + (hexpr : LowerEValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrestNext : ApplyRestNonErasedValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerTraceProgressContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + (hrepresented : ExtraRepresented ctx ambient) : + LowerSpineValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient (fuel + 2) := by + intro input output world sourceLimit head args sourceEnv sourceResult state + finalState emit av hsourceBound hsource hcallable hrun hextends + havailable + exact lowerSpine_run_value_trace_progress_within_below henv hspine hexpr + hreflect hargs hrest hrestNext hknownExtra hcontracts hvalues hprogress + hsourceBound hsource hcallable hrun hextends hrepresented havailable + +/-- Standalone exact-trace references inherit static-spine progress through +the empty-argument correspondence. -/ +theorem lowerE_ref_run_value_trace_progress_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit sourceFuel fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hargs : LowerArgsValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient (fuel + 1)) + (hrest : ApplyRestNonErasedValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 2)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerTraceProgressContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} + (hsourceBound : sourceFuel < limit) + (hsource : IxIR0.ProjectionSafe.Eval sourceCtx sourceFuel sourceEnv + (.ref f) sourceResult) + (hrun : (lowerE src (fuel + 1) input world (.ref f)).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfTraceProgressAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + apply lowerSpine_ref_run_value_trace_progress_within_below henv hargs + hrest hknownExtra hcontracts hvalues hprogress hsourceBound + (IxIR0.ProjectionSafe.Spine.of_eval_nil hsource) + · exact lowerE_ref_run_to_lowerSpine_nil hrun + · exact hextends + · exact hrepresented + · exact havailable + +/-- Constructor projection progress specialized to an exact source trace. -/ +theorem lowerE_proj_ctor_run_value_trace_progress_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit sourceFuel fuel : Nat} + (henv : sourceCtx.env = src) + (hborrow : LowerBorrowValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + {input output : VEnv} {world : Owned} {index : Nat} + {source : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + {address : Ixon.Address} {tag : Nat} + {fields : List IxIR0.Value} {sourceValue : IxIR0.Value} + (hsourceBound : sourceFuel < limit) + (htarget : IxIR0.ProjectionSafe.Eval sourceCtx sourceFuel sourceEnv + source (.ctor address tag fields)) + (hfield : fields[index]? = some sourceValue) + (hrun : (lowerE src (fuel + 1) input world + (.proj index source)).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfTraceProgressAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueProgress + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur + input output sourceEnv sourceEnv sourceValue world emit av := by + cases world with + | unique => + have huuEq : (Owned.unique == Owned.unique) = true := by decide + simp only [lowerE, huuEq, if_true] at hrun + exact (trackedThrowRun_not_ok hrun).elim + | shared => + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + simp only [lowerE, hsuEq, Bool.false_eq_true, if_false] at hrun + obtain ⟨borrowResult, middleState, hborrowRun, hafterBorrow⟩ := + trackedBindRun_ok_inv hrun + rcases borrowResult with + ⟨borrowOutput, borrowEmit, borrowed, release⟩ + have hnotFunction : ∀ f arity captures, + ¬ CompilerFunctionRel sourceCtx src ambient + (.ctor address tag fields) f arity captures := by + intro f arity captures hrel + exact hrel.value_ne_ctor henv rfl + cases borrowed with + | constA atom => + cases atom with + | var relative => + have hpure : + (borrowOutput.bump, + borrowEmit ∘ emitOp (.fetch (.var relative) index), + AVal.slotA borrowOutput.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + cases (hborrow hsourceBound htarget hborrowRun hextends + havailable).stable + | lit literal => + have hpure : + (borrowOutput.bump, + borrowEmit ∘ emitOp (.fetch (.lit literal) index), + AVal.slotA borrowOutput.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact (hborrow hsourceBound htarget hborrowRun hextends + havailable).projectCtorLiteral + | erased => + have hpure : + (borrowOutput, borrowEmit, AVal.constA .erased) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact (hborrow hsourceBound htarget hborrowRun hextends + havailable).projectCtorErased + | slotA targetAbs => + cases release with + | false => + have hpure : + (borrowOutput.bump.bump, + borrowEmit ∘ + emitOp (.fetch (.var (borrowOutput.rel targetAbs)) index) ∘ + emitOp (.dup + (.var (borrowOutput.bump.rel borrowOutput.depth))), + AVal.slotA borrowOutput.bump.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact (hborrow hsourceBound htarget hborrowRun hextends + havailable).projectSlotKept hnotFunction hfield + | true => + have hpure : + (borrowOutput.bump.bump.bump, + borrowEmit ∘ + emitOp (.fetch (.var (borrowOutput.rel targetAbs)) index) ∘ + emitOp (.dup + (.var (borrowOutput.bump.rel borrowOutput.depth))) ∘ + emitOp (.drop + (.var (borrowOutput.bump.bump.rel targetAbs))), + AVal.slotA borrowOutput.bump.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact (hborrow hsourceBound htarget hborrowRun hextends + havailable).projectSlotReleased hnotFunction hfield + +/-- Exact-trace reachable-state let progress threads the predecessor source +fuel through both recursive expressions. -/ +theorem lowerE_let_run_value_trace_progress_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit sourceFuel : Nat} {src : IxIR0.Env} {ambient : LowSt} + {fuel : Nat} + (hexpr : LowerEValueTraceProgressesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + {input output : VEnv} {world : Owned} {uses : Uses} + {value body : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + {boundSource sourceValue : IxIR0.Value} + (hsourceBound : sourceFuel < limit) + (hvalueSource : IxIR0.ProjectionSafe.Eval sourceCtx sourceFuel + sourceEnv value boundSource) + (hbodySource : IxIR0.ProjectionSafe.Eval sourceCtx sourceFuel + (boundSource :: sourceEnv) body sourceValue) + (hreleases : LowerEReleasesTrackedFirst src fuel body) + (hrun : (lowerE src (fuel + 1) input world + (.letE uses value body)).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfTraceProgressAvailableBelow funRel recSelfRel + sourceCtx ctx cur limit input) : + LowerResultValueProgress funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue world emit av := by + apply lowerE_let_run_value_progress + · intro middle bodyInput bodyOutput valueEmit bodyEmit boundValue + resultValue valueState bodyState bodyFinal hvalueRun hbodyRun + hbodyState hbodyFinal hbodyNo + subst bodyState + have hbodyExtends : ExtraExtends bodyFinal ambient := + hbodyFinal.trans hextends + have hvalueExtends : ExtraExtends valueState ambient := + (lowerE_extraExtends hbodyRun).trans hbodyExtends + have hmiddleAvailable := havailable.lowerE hvalueRun + exact ⟨hexpr hsourceBound hvalueSource hvalueRun hvalueExtends + havailable, + hexpr hsourceBound hbodySource hbodyRun hbodyExtends + (hmiddleAvailable.mapNoRecSelf hbodyNo)⟩ + · exact hreleases + · exact hrun + +/-- One complete exact-trace expression progress step. -/ +theorem lowerE_run_value_trace_progress_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hexpr : LowerEValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hspine : LowerSpineValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hborrow : LowerBorrowValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hargsNext : LowerArgsValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient (fuel + 1)) + (hrestNext : ApplyRestNonErasedValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 2)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerTraceProgressContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + (hreleases : ∀ body, LowerEReleasesTrackedFirst src fuel body) + {input output : VEnv} {world : Owned} {expr : IxIR0.Expr} + {sourceFuel : Nat} {sourceEnv : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {av : AVal} + (hsourceBound : sourceFuel < limit) + (hsource : IxIR0.ProjectionSafe.Eval sourceCtx sourceFuel sourceEnv + expr sourceValue) + (hrun : (lowerE src (fuel + 1) input world expr).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfTraceProgressAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueProgress (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceValue + world emit av := by + cases hsource with + | var hlookup => + exact lowerE_var_run_value_progress hlookup hrun + | refDefn hdecl hbody => + exact lowerE_ref_run_value_trace_progress_within_below henv hargsNext + hrestNext hknownExtra hcontracts hvalues hprogress hsourceBound + (.refDefn hdecl hbody) hrun hextends hrepresented havailable + | refCtor hdecl hsaturate => + exact lowerE_ref_run_value_trace_progress_within_below henv hargsNext + hrestNext hknownExtra hcontracts hvalues hprogress hsourceBound + (.refCtor hdecl hsaturate) hrun hextends hrepresented havailable + | refRecursor hdecl => + exact lowerE_ref_run_value_trace_progress_within_below henv hargsNext + hrestNext hknownExtra hcontracts hvalues hprogress hsourceBound + (.refRecursor hdecl) hrun hextends hrepresented havailable + | refExtern hdecl hsaturate => + exact lowerE_ref_run_value_trace_progress_within_below henv hargsNext + hrestNext hknownExtra hcontracts hvalues hprogress hsourceBound + (.refExtern hdecl hsaturate) hrun hextends hrepresented havailable + | app hfunction hargument happly => + apply hspine hsourceBound + (IxIR0.ProjectionSafe.Spine.of_eval_app + (.app hfunction hargument happly)) + · exact Or.inl (by simp) + · simpa [lowerE] using hrun + · exact hextends + · exact havailable + | lam => + exact lowerE_lam_run_value_progress_any + (fun value address arity captures hlifted => + CompilerFunctionRel.lifted (hlifted.monoState hextends)) + (hrepresented.of_extends hextends) hrun + | letE hvalue hbody => + exact lowerE_let_run_value_trace_progress_within_below hexpr + (by omega) hvalue hbody (hreleases _) hrun hextends havailable + | proj htarget hfield => + exact lowerE_proj_ctor_run_value_trace_progress_within_below henv + hborrow (by omega) htarget hfield hrun hextends havailable + | lit => + exact lowerE_lit_run_value_progress hrun + | erased => + exact lowerE_erased_run_value_progress hrun + +/-- One complete reachable-state expression settlement step. Static and +higher-order calls use their source-guided progress contracts; projection +and sequencing retain only the weaker non-memory terminal guarantee. -/ +theorem lowerE_run_value_settlement_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hexpr : LowerEValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hspine : LowerSpineValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hborrow : LowerBorrowValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hargsNext : LowerArgsValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hrestNext : ApplyRestNonErasedValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 2)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hreleases : ∀ body, LowerEReleasesTrackedFirst src fuel body) + {input output : VEnv} {world : Owned} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {emit : Emit} {av : AVal} + (hsource : IxIR0.eval sourceCtx sourceFuel sourceEnv expr = + .ok sourceValue) + (hrun : (lowerE src (fuel + 1) input world expr).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfProgressAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSettlement (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceValue + world emit av := by + cases expr with + | var index => + exact (lowerE_var_run_value_progress + (sourceEval_var_inv hsource) hrun).settlement + | ref address => + exact lowerE_ref_run_value_settlement_within henv hargsNext hrestNext + hknownExtra hcontracts hvalues hprogress hsource hrun hextends + hrepresented havailable + | app function argument => + apply hspine (SourceSpineEval.of_eval_app hsource) + · simpa [lowerE] using hrun + · exact hextends + · exact havailable + | lam uses body => + have hvalue := sourceEval_lam_inv hsource + subst sourceValue + exact (lowerE_lam_run_value_progress_any + (fun value address arity captures hlifted => + CompilerFunctionRel.lifted (hlifted.monoState hextends)) + (hrepresented.of_extends hextends) hrun).settlement + | letE uses value body => + obtain ⟨sourceStep, boundSource, hvalueSource, hbodySource⟩ := + sourceEval_let_inv hsource + exact lowerE_let_run_value_settlement_within hexpr hvalueSource + hbodySource (hreleases body) hrun hextends havailable + | proj index source => + obtain ⟨sourceStep, sourceTarget, htarget, hproject⟩ := + sourceEval_proj_inv hsource + exact lowerE_proj_run_value_settlement_within henv hborrow htarget + hproject hrun hextends havailable + | lit literal => + have hvalue := sourceEval_lit_inv hsource + subst sourceValue + exact (lowerE_lit_run_value_progress hrun).settlement + | erased => + have hvalue := sourceEval_erased_inv hsource + subst sourceValue + exact (lowerE_erased_run_value_progress hrun).settlement + +/-- The mutually recursive settling invariant at one compiler-fuel index. -/ +structure LowerValueSettlementClusterWithin + (sourceCtx : IxIR0.Ctx) (src : IxIR0.Env) (ambient : LowSt) + (recSelfRel : RecSelfRel) (ctx : Ctx) (cur : FnDef) + (fuel : Nat) : Prop where + expr : LowerEValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel + borrow : LowerBorrowValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel + spine : LowerSpineValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel + args : LowerArgsValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel + applyRest : ApplyRestNonErasedValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel + +/-- Complete compiler-fuel induction for non-memory settlement. Unlike the +strong progress induction, this remains valid across the formally exposed +erased-projection stuck branch. -/ +theorem lowerValueSettlementClusterWithin + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) : + ∀ fuel, + LowerValueSettlementClusterWithin sourceCtx src ambient recSelfRel ctx + cur fuel := + lowerValueClusterWithin_core + (Expr := LowerEValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient) + (Borrow := LowerBorrowValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient) + (Spine := LowerSpineValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient) + (Args := LowerArgsValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient) + (ApplyRest := ApplyRestNonErasedValueSettlesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient) + (Cluster := LowerValueSettlementClusterWithin sourceCtx src ambient + recSelfRel ctx cur) + (hzero := { + expr := lowerEValueSettlesWithin_zero + borrow := lowerBorrowValueSettlesWithin_zero + spine := lowerSpineValueSettlesWithin_zero + args := lowerArgsValueSettlesWithin_zero + applyRest := applyRestNonErasedValueSettlesWithin_zero }) + (hclusterExpr := fun hcluster => hcluster.expr) + (hclusterBorrow := fun hcluster => hcluster.borrow) + (hclusterSpine := fun hcluster => hcluster.spine) + (hclusterArgs := fun hcluster => hcluster.args) + (hclusterApplyRest := fun hcluster => hcluster.applyRest) + (hmake := fun hexpr hborrow hspine hargs hrest => { + expr := hexpr + borrow := hborrow + spine := hspine + args := hargs + applyRest := hrest }) + (hargsSucc := fun hexpr hargs => + lowerArgsValueSettlesWithin_succ hexpr hargs) + (happlyRestSucc := fun hargs => + applyRestNonErasedValueSettlesWithin_succ hargs + hprogress.apply hcontracts.apply hvalues.apply) + (hborrowSucc := fun hexpr => + lowerBorrowValueSettlesWithin_succ hexpr) + (hspineOne := lowerSpineValueSettlesWithin_one) + (hspineSucc := by + intro fuel hprevSpine hprevExpr hpriorArgs hpriorRest hprevRest + exact lowerSpineValueSettlesWithin_succ_succ henv hprevSpine + hprevExpr (lowerE_reflectsErased sourceCtx src (fuel + 1)) + hpriorArgs hpriorRest hprevRest + (lowerExtraMonotone src (fuel + 1)).knownCall hcontracts + hvalues hprogress hrepresented) + (hexprSucc := by + intro fuel hprevExpr hprevSpine hprevBorrow hargs hrest + intro input output world expr sourceEnv sourceFuel sourceValue state + finalState emit av hsource hrun hextends havailable + exact lowerE_run_value_settlement_within (fuel := fuel) henv + hprevExpr hprevSpine hprevBorrow hargs hrest + (lowerExtraMonotone src (fuel + 2)).knownCall hcontracts hvalues + hprogress (fun body => lowerE_releasesTrackedFirst src fuel body) + hsource hrun hextends hrepresented havailable) +/-- The mutually recursive projection-safe value-progress invariant at one +compiler-fuel index. -/ +structure LowerValueProgressSafeClusterWithin + (sourceCtx : IxIR0.Ctx) (src : IxIR0.Env) (ambient : LowSt) + (recSelfRel : RecSelfRel) (ctx : Ctx) (cur : FnDef) + (fuel : Nat) : Prop where + expr : LowerEValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel + borrow : LowerBorrowValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel + spine : LowerSpineValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel + args : LowerArgsValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel + applyRest : ApplyRestNonErasedValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel + +/-- Complete compiler-fuel induction for value progress on projection-safe +source executions. -/ +theorem lowerValueProgressSafeClusterWithin + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) : + ∀ fuel, + LowerValueProgressSafeClusterWithin sourceCtx src ambient recSelfRel ctx + cur fuel := + lowerValueClusterWithin_core + (Expr := LowerEValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient) + (Borrow := LowerBorrowValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient) + (Spine := LowerSpineValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient) + (Args := LowerArgsValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient) + (ApplyRest := ApplyRestNonErasedValueProgressesSafelyWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient) + (Cluster := LowerValueProgressSafeClusterWithin sourceCtx src ambient + recSelfRel ctx cur) + (hzero := { + expr := lowerEValueProgressesSafelyWithin_zero + borrow := lowerBorrowValueProgressesSafelyWithin_zero + spine := lowerSpineValueProgressesSafelyWithin_zero + args := lowerArgsValueProgressesSafelyWithin_zero + applyRest := applyRestNonErasedValueProgressesSafelyWithin_zero }) + (hclusterExpr := fun hcluster => hcluster.expr) + (hclusterBorrow := fun hcluster => hcluster.borrow) + (hclusterSpine := fun hcluster => hcluster.spine) + (hclusterArgs := fun hcluster => hcluster.args) + (hclusterApplyRest := fun hcluster => hcluster.applyRest) + (hmake := fun hexpr hborrow hspine hargs hrest => { + expr := hexpr + borrow := hborrow + spine := hspine + args := hargs + applyRest := hrest }) + (hargsSucc := fun hexpr hargs => + lowerArgsValueProgressesSafelyWithin_succ hexpr hargs) + (happlyRestSucc := fun hargs => + applyRestNonErasedValueProgressesSafelyWithin_succ hargs + hprogress.apply hcontracts.apply hvalues.apply) + (hborrowSucc := fun hexpr => + lowerBorrowValueProgressesSafelyWithin_succ hexpr) + (hspineOne := lowerSpineValueProgressesSafelyWithin_one) + (hspineSucc := by + intro fuel hprevSpine hprevExpr hpriorArgs hpriorRest hprevRest + exact lowerSpineValueProgressesSafelyWithin_succ_succ henv + hprevSpine hprevExpr + (lowerE_reflectsErased sourceCtx src (fuel + 1)) hpriorArgs + hpriorRest hprevRest + (lowerExtraMonotone src (fuel + 1)).knownCall hcontracts + hvalues hprogress hrepresented) + (hexprSucc := by + intro fuel hprevExpr hprevSpine hprevBorrow hargs hrest + intro input output world expr sourceEnv sourceValue state finalState + emit av hsource hrun hextends havailable + exact lowerE_run_value_progress_safely_within (fuel := fuel) henv + hprevExpr hprevSpine hprevBorrow hargs hrest + (lowerExtraMonotone src (fuel + 2)).knownCall hcontracts hvalues + hprogress (fun body => lowerE_releasesTrackedFirst src fuel body) + hsource hrun hextends hrepresented havailable) +/-- The mutually recursive exact-trace progress invariant at one compiler +fuel and one outer source-fuel induction bound. -/ +structure LowerValueTraceProgressClusterWithinBelow + (sourceCtx : IxIR0.Ctx) (src : IxIR0.Env) (ambient : LowSt) + (recSelfRel : RecSelfRel) (ctx : Ctx) (cur : FnDef) + (limit fuel : Nat) : Prop where + expr : LowerEValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel + borrow : LowerBorrowValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel + spine : LowerSpineValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel + args : LowerArgsValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel + applyRest : ApplyRestNonErasedValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel + +/-- Complete compiler-fuel induction for exact source traces strictly below +one outer source-fuel bound. -/ +theorem lowerValueTraceProgressClusterWithinBelow + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerTraceProgressContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) : + ∀ fuel, + LowerValueTraceProgressClusterWithinBelow sourceCtx src ambient + recSelfRel ctx cur limit fuel := + lowerValueClusterWithin_core + (Expr := LowerEValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient) + (Borrow := LowerBorrowValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient) + (Spine := LowerSpineValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient) + (Args := LowerArgsValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient) + (ApplyRest := ApplyRestNonErasedValueTraceProgressesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient) + (Cluster := LowerValueTraceProgressClusterWithinBelow sourceCtx src + ambient recSelfRel ctx cur limit) + (hzero := { + expr := lowerEValueTraceProgressesWithinBelow_zero + borrow := lowerBorrowValueTraceProgressesWithinBelow_zero + spine := lowerSpineValueTraceProgressesWithinBelow_zero + args := lowerArgsValueTraceProgressesWithinBelow_zero + applyRest := applyRestNonErasedValueTraceProgressesWithinBelow_zero }) + (hclusterExpr := fun hcluster => hcluster.expr) + (hclusterBorrow := fun hcluster => hcluster.borrow) + (hclusterSpine := fun hcluster => hcluster.spine) + (hclusterArgs := fun hcluster => hcluster.args) + (hclusterApplyRest := fun hcluster => hcluster.applyRest) + (hmake := fun hexpr hborrow hspine hargs hrest => { + expr := hexpr + borrow := hborrow + spine := hspine + args := hargs + applyRest := hrest }) + (hargsSucc := fun hexpr hargs => + lowerArgsValueTraceProgressesWithinBelow_succ hexpr hargs) + (happlyRestSucc := fun hargs => + applyRestNonErasedValueTraceProgressesWithinBelow_succ hargs + hprogress.apply hcontracts.apply hvalues.apply) + (hborrowSucc := fun hexpr => + lowerBorrowValueTraceProgressesWithinBelow_succ hexpr) + (hspineOne := lowerSpineValueTraceProgressesWithinBelow_one) + (hspineSucc := by + intro fuel hprevSpine hprevExpr hpriorArgs hpriorRest hprevRest + exact lowerSpineValueTraceProgressesWithinBelow_succ_succ henv + hprevSpine hprevExpr + (lowerE_reflectsErased sourceCtx src (fuel + 1)) hpriorArgs + hpriorRest hprevRest + (lowerExtraMonotone src (fuel + 1)).knownCall hcontracts + hvalues hprogress hrepresented) + (hexprSucc := by + intro fuel hprevExpr hprevSpine hprevBorrow hargs hrest + intro input output world expr sourceFuel sourceEnv sourceValue state + finalState emit av hsourceBound hsource hrun hextends havailable + exact lowerE_run_value_trace_progress_within_below (fuel := fuel) + henv hprevExpr hprevSpine hprevBorrow hargs hrest + (lowerExtraMonotone src (fuel + 2)).knownCall hcontracts hvalues + hprogress (fun body => lowerE_releasesTrackedFirst src fuel body) + hsourceBound hsource hrun hextends hrepresented havailable) +/-- Exact-trace progress for a generated lifted-function body. Selected +outer captures occupy the framed suffix of the logical environment, while +the complete supplied lambda telescope occupies its ordinary parameter +prefix. -/ +theorem lowerFnBody_liftedEntries_valueTraceProgress_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {ctx : Ctx} {sourceLimit compilerFuel : Nat} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerTraceProgressContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx + sourceLimit) + (entryCount : Nat) (modes : List Uses) (body : IxIR0.Expr) + (selected : Nat → Bool) + {state finalState : LowSt} {code : Code} + (hadmissible : ParameterDropsAdmissible modes + (fun index => countUses index body)) + (hselectDef : ∀ index, index < entryCount → + selected index = (countUses (modes.length + index) body != 0)) + (hpositive : 0 < modes.length) + (hshared : modes.map worldOfUses = + List.replicate modes.length .shared) + (hrun : (lowerFnBody src (compilerFuel + 1) + (let captures := (List.range entryCount).filter selected + ⟨parameterEntries captures.length modes + (fun index => countUses index body) ++ + selectedEntriesFrom selected + (fun index => countUses (modes.length + index) body) + (List.range entryCount) 0, + captures.length + modes.length⟩) + (let captures := (List.range entryCount).filter selected + parameterDrops captures.length modes + (fun index => countUses index body)) + .shared body).run state = .ok code finalState) + (hextends : ExtraExtends finalState ambient) + {sourceEnv selectedSources parameterSources : List IxIR0.Value} + {sourceResult : IxIR0.Value} + {store : Store} {captureArgs parameterArgs : List RVal} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hsourceLength : sourceEnv.length = entryCount) + (hselectedValues : ValuesAt sourceEnv + ((List.range entryCount).filter selected) selectedSources) + (hcaptureLength : captureArgs.length = + ((List.range entryCount).filter selected).length) + (hparameterLength : parameterArgs.length = modes.length) + (hcaptureGraph : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store selectedSources + captureArgs) + (hparameterGraph : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store parameterSources + parameterArgs) + {sourceFuel : Nat} + (hsourceBound : sourceFuel < sourceLimit) + (hsource : IxIR0.ProjectionSafe.Eval sourceCtx sourceFuel + (parameterSources.reverse ++ sourceEnv) body sourceResult) + (hframe : Sim.RootsGraph + (CompilerFunctionRel sourceCtx src ambient) store sourceRest rest) + (hown : RootOwnership store + (rootsFor .shared (captureArgs ++ parameterArgs) ++ rest)) : + ∃ targetFuel store' value, + runCode ctx targetFuel + ⟨((List.range entryCount).filter selected).length + modes.length, + .shared, true, code⟩ store + (captureArgs ++ parameterArgs).reverse code = .ok (store', value) ∧ + RootOwnership store' (⟨.shared, value⟩ :: rest) := by + let captures := (List.range entryCount).filter selected + let parameterRemaining : Nat → Nat := fun index => countUses index body + let captureRemaining : Nat → Nat := + fun index => countUses (modes.length + index) body + let outerEntries := selectedEntriesFrom selected captureRemaining + (List.range entryCount) 0 + let input : VEnv := + ⟨parameterEntries captures.length modes parameterRemaining ++ outerEntries, + captures.length + modes.length⟩ + let drops := parameterDrops captures.length modes parameterRemaining + have hrun' : + (lowerFnBody src (compilerFuel + 1) input drops .shared body).run state = + .ok code finalState := by + simpa [input, drops, outerEntries, parameterRemaining, captureRemaining, + captures] using hrun + simp only [lowerFnBody] at hrun' + obtain ⟨releaseResult, releaseState, hreleaseRun, hafterRelease⟩ := + trackedBindRun_ok_inv hrun' + rcases releaseResult with ⟨middle, releaseEmit⟩ + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + trackedBindRun_ok_inv hafterRelease + rcases bodyResult with ⟨output, emit, av⟩ + have hpure : + (releaseEmit ∘ emit) (.ret (av.toAtom output)) = code ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨hcode, hbodyState⟩ := hpure + subst bodyState + have hinputNo : NoRecSelf input := by + apply NoRecSelf.appendEntries + · exact parameterEntries_noRecSelf captures.length modes + parameterRemaining (captures.length + modes.length) + · simpa [outerEntries] using + selectedEntriesFrom_noRecSelf selected captureRemaining + (List.range entryCount) 0 (captures.length + modes.length) + have hmiddleNo : NoRecSelf middle := + releaseSlots_noRecSelf input hreleaseRun hinputNo + obtain ⟨parameterOutput, plannedEmit, hparameterPlan, _⟩ := + parameterDrops_releasePlan_tracked_atDepth captures.length + (captures.length + modes.length) modes parameterRemaining + (by simpa [parameterRemaining] using hadmissible) + let plannedMiddle := frameVEnvEntries parameterOutput outerEntries + have hplan : ReleasePlan input drops plannedMiddle plannedEmit := by + have hframed := hparameterPlan.frameEntries outerEntries + simpa [input, drops, plannedMiddle, outerEntries, frameVEnvEntries] + using hframed + have hplanRun : (releaseSlots input drops).run state = + .ok (plannedMiddle, plannedEmit) state := hplan.run state + have heq : + (plannedMiddle, plannedEmit) = (middle, releaseEmit) ∧ + state = releaseState := by + simpa using hplanRun.symm.trans hreleaseRun + have hmiddle : plannedMiddle = middle := congrArg Prod.fst heq.1 + have hemit : plannedEmit = releaseEmit := congrArg Prod.snd heq.1 + subst middle + subst releaseEmit + cases heq.2 + have hbodyProgress : LowerResultValueProgress + (CompilerFunctionRel sourceCtx src ambient) (fun _ _ => False) ctx + ⟨captures.length + modes.length, .shared, true, code⟩ + plannedMiddle output + (parameterSources.reverse ++ sourceEnv) + (parameterSources.reverse ++ sourceEnv) sourceResult .shared emit av := + (lowerValueTraceProgressClusterWithinBelow + (recSelfRel := fun _ _ => False) + (cur := + (⟨captures.length + modes.length, .shared, true, code⟩ : FnDef)) + henv hrepresented hcontracts hvalues hprogress compilerFuel).expr + hsourceBound hsource hbodyRun hextends + (SelfTraceProgressAvailableBelow.of_noRecSelf hmiddleNo) + have hfull : LowerResultValueProgress + (CompilerFunctionRel sourceCtx src ambient) (fun _ _ => False) ctx + ⟨captures.length + modes.length, .shared, true, code⟩ input output + (parameterSources.reverse ++ sourceEnv) + (parameterSources.reverse ++ sourceEnv) sourceResult .shared + (plannedEmit ∘ emit) av := + hbodyProgress.afterRelease hplan + have hentryGraph : VEnvValueGraph + (CompilerFunctionRel sourceCtx src ambient) (fun _ _ => False) store + input (parameterSources.reverse ++ sourceEnv) + (captureArgs ++ parameterArgs).reverse + ((rootsForWorlds (modes.map worldOfUses) parameterArgs).reverse ++ + rootsFor .shared captureArgs) := by + simpa [input, outerEntries, parameterRemaining, captureRemaining, + captures] using + VEnvValueGraph.lifted (recSelfRel := fun _ _ => False) + entryCount modes parameterRemaining selected captureRemaining + hsourceLength hselectedValues hcaptureLength hparameterLength + hcaptureGraph hparameterGraph hpositive hshared hown + have hparameterRoots : + rootsForWorlds (modes.map worldOfUses) parameterArgs = + rootsFor .shared parameterArgs := by + rw [hshared] + exact rootsForWorlds_replicate_eq_rootsFor .shared hparameterLength + have hpre : GraphOwnsVEnv + (CompilerFunctionRel sourceCtx src ambient) (fun _ _ => False) input + (parameterSources.reverse ++ sourceEnv) sourceRest rest store + (captureArgs ++ parameterArgs).reverse := by + refine ⟨(rootsForWorlds + (modes.map worldOfUses) parameterArgs).reverse ++ + rootsFor .shared captureArgs, hentryGraph, hframe, ?_⟩ + have hrootPerm : + (rootsFor .shared (captureArgs ++ parameterArgs) ++ rest).Perm + (((rootsForWorlds (modes.map worldOfUses) parameterArgs).reverse ++ + rootsFor .shared captureArgs) ++ rest) := by + rw [hparameterRoots] + simp only [rootsFor, List.map_append] + exact (List.perm_append_comm.trans + ((List.reverse_perm + (parameterArgs.map fun value => (⟨.shared, value⟩ : Root))).symm + |>.append_right (captureArgs.map fun value => + (⟨.shared, value⟩ : Root)))).append_right rest + exact hown.perm hrootPerm + obtain ⟨targetFuel, store', value, htarget⟩ := + hfull.closeProgress sourceRest rest hpre + have htarget' : runCode ctx targetFuel + ⟨captures.length + modes.length, .shared, true, code⟩ store + (captureArgs ++ parameterArgs).reverse code = .ok (store', value) := by + simpa only [hcode] using htarget + have hfinalRepresented : ExtraRepresented ctx finalState := + hrepresented.of_extends hextends + have hownershipAt : FnOwnershipPreservesAt ctx + ⟨captures.length + modes.length, .shared, true, code⟩ + (List.replicate (captures.length + modes.length) .shared) + targetFuel := by + intro ownStore ownStore' ownArgs ownValue ownRest + hownLength hownInput hownRun + exact (lowerFnBody_liftedEntries_preservesAt + (limit := targetFuel) (fuel := compilerFuel) + (hcontracts.apply.below targetFuel) + (hcontracts.decls.below targetFuel) entryCount modes body selected + hadmissible hselectDef hpositive hshared hrun hfinalRepresented) + (by simpa [captures] using hownLength) + (by simpa [captures] using hownInput) + (by simpa [captures] using hownRun) + have hargsLength : (captureArgs ++ parameterArgs).length = + captures.length + modes.length := by + simp [captures, hcaptureLength, hparameterLength] + have hroots : rootsForWorlds + (List.replicate (captures.length + modes.length) .shared) + (captureArgs ++ parameterArgs) = + rootsFor .shared (captureArgs ++ parameterArgs) := + rootsForWorlds_replicate_eq_rootsFor .shared hargsLength + have hownPublic : RootOwnership store + (rootsForWorlds + (List.replicate (captures.length + modes.length) .shared) + (captureArgs ++ parameterArgs) ++ rest) := by + rwa [hroots] + have hownAfter : RootOwnership store' + (⟨.shared, value⟩ :: rest) := by + exact hownershipAt (by simpa using hargsLength) hownPublic htarget' + exact ⟨targetFuel, store', value, by simpa [captures] using htarget', + hownAfter⟩ + +/-- Saturating a compiler-provenanced lifted PAP constructs its generated +target invocation from the exact residual closure trace. -/ +theorem invoke_lifted_value_trace_progress_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {ctx : Ctx} {sourceLimit : Nat} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerTraceProgressContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx + sourceLimit) + {sourceFunction sourceResult : IxIR0.Value} + {address : Ixon.Address} {arity : Nat} + {captures sourceArgs : List IxIR0.Value} + {store : Store} {got args : List RVal} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hlifted : CompilerLiftedFunctionRel src ambient sourceFunction address + arity captures) + (hgot : Sim.ValuesGraph (CompilerFunctionRel sourceCtx src ambient) + store captures got) + (hargs : Sim.ValuesGraph (CompilerFunctionRel sourceCtx src ambient) + store sourceArgs args) + (happlies : SourceAppliesSafelyBelow sourceCtx sourceLimit + sourceFunction sourceArgs sourceResult) + (hframe : Sim.RootsGraph (CompilerFunctionRel sourceCtx src ambient) + store sourceRest rest) + (hown : RootOwnership store + (rootsFor .shared (got ++ args) ++ rest)) + (htotalLength : (got ++ args).length = arity) : + ∃ fuel store' value, + invoke ctx fuel address (got ++ args) store = .ok (store', value) := by + obtain ⟨sourceEnv, expr, selectedSources, suppliedSources, hliftCode, + hselectedValues, hcaptures, harity, hprefix⟩ := hlifted + subst captures + rw [harity] at htotalLength + obtain ⟨bodyCompilerFuel, bodyInitial, bodyFinal, code, hsafe, + hbodyRun, hbodyExtends, hmember⟩ := hliftCode + have hselectedLength := hselectedValues.length + rw [← hselectedLength] at hmember + have hdecl : ctx.decls address = some (.fn + ⟨selectedSources.length + lamArity expr, .shared, true, code⟩) := + hrepresented.decl hmember + have hmodes := papSafe_lamUses_eq_replicate hsafe + have hadmissible : ParameterDropsAdmissible (lamUses expr) + (fun index => countUses index (stripLams expr)) := by + rw [hmodes] + exact parameterDropsAdmissible_replicate_many _ _ + have hselectDef : ∀ index, index < sourceEnv.length → + decide (0 < countUses index expr) = + (countUses ((lamUses expr).length + index) (stripLams expr) != 0) := by + intro index _ + rw [lamUses_length] + rw [← countUses_eq_stripLams_shift expr index] + cases countUses index expr <;> rfl + have hshared : (lamUses expr).map worldOfUses = + List.replicate (lamUses expr).length .shared := by + rw [hmodes] + simp [worldOfUses] + have hpositive : 0 < (lamUses expr).length := by + have hunder := hprefix.length_lt_lamArity + rw [lamUses_length] + omega + cases bodyCompilerFuel with + | zero => + exact (trackedThrowRun_not_ok + (by simpa [lowerFnBody] using hbodyRun)).elim + | succ compilerFuel => + let selectedArgs := got.take selectedSources.length + let suppliedArgs := got.drop selectedSources.length + have hgotSplit : selectedArgs ++ suppliedArgs = got := + List.take_append_drop selectedSources.length got + have hselectedGraph : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store selectedSources + selectedArgs := by + simpa [selectedArgs] using hgot.take selectedSources.length + have hsuppliedGraph : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store suppliedSources + suppliedArgs := by + simpa [suppliedArgs] using hgot.drop selectedSources.length + have hparameterGraph : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store + (suppliedSources ++ sourceArgs) (suppliedArgs ++ args) := + hsuppliedGraph.append hargs + have hselectedArgsLength : selectedArgs.length = + (liftCaptureIndices sourceEnv.length expr).length := by + calc + selectedArgs.length = selectedSources.length := by + simpa [selectedArgs] using hselectedGraph.length.symm + _ = (liftCaptureIndices sourceEnv.length expr).length := + hselectedValues.length + have htotalSplit : selectedArgs ++ (suppliedArgs ++ args) = + got ++ args := by + rw [← List.append_assoc, hgotSplit] + have hownSplit : RootOwnership store + (rootsFor .shared (selectedArgs ++ (suppliedArgs ++ args)) ++ + rest) := by + rw [htotalSplit] + exact hown + have hparameterLength : (suppliedArgs ++ args).length = + (lamUses expr).length := by + have hgotLength : got.length = + selectedSources.length + suppliedSources.length := by + simpa using hgot.length.symm + have hsuppliedLength : suppliedArgs.length = suppliedSources.length := + hsuppliedGraph.length.symm + simp only [List.length_append] at htotalLength ⊢ + rw [lamUses_length] + omega + have hlambdaLength : (suppliedSources ++ sourceArgs).length = + lamArity expr := by + calc + (suppliedSources ++ sourceArgs).length = + (suppliedArgs ++ args).length := hparameterGraph.length + _ = (lamUses expr).length := hparameterLength + _ = lamArity expr := lamUses_length expr + have hsourceArgsNonempty : sourceArgs ≠ [] := by + intro hnil + subst sourceArgs + have hunder := hprefix.length_lt_lamArity + simp only [List.append_nil, List.length_append] at hlambdaLength + omega + have htwo : 2 < sourceLimit := + happlies.two_lt_limit_of_nonempty hprefix.value_ne_erased + hsourceArgsNonempty + obtain ⟨sourceFuel, hsourceBound, hsourceTrace⟩ := + hprefix.saturateTrace htwo hlambdaLength happlies + have hbodyRun' : + (lowerFnBody src (compilerFuel + 1) + (liftedBodyVEnv sourceEnv.length expr) + (liftedBodyDrops sourceEnv.length expr) .shared + (stripLams expr)).run bodyInitial = .ok code bodyFinal := by + simpa using hbodyRun + obtain ⟨targetFuel, store', value, htarget, hownAfter⟩ := + lowerFnBody_liftedEntries_valueTraceProgress_within_below + henv hrepresented hcontracts hvalues hprogress sourceEnv.length + (lamUses expr) (stripLams expr) + (fun index => countUses index expr > 0) + hadmissible hselectDef hpositive hshared + (by simpa [liftedBodyVEnv, liftedBodyDrops, liftCaptureIndices] + using hbodyRun') + hbodyExtends (sourceEnv := sourceEnv) + (selectedSources := selectedSources) + (parameterSources := suppliedSources ++ sourceArgs) + (captureArgs := selectedArgs) + (parameterArgs := suppliedArgs ++ args) + rfl (by simpa [liftCaptureIndices] using hselectedValues) + (by simpa [liftCaptureIndices] using hselectedArgsLength) + hparameterLength hselectedGraph hparameterGraph hsourceBound + (by simpa using hsourceTrace) hframe hownSplit + have htarget' : runCode ctx targetFuel + ⟨selectedSources.length + lamArity expr, .shared, true, code⟩ + store + (got ++ args).reverse code = .ok (store', value) := by + simpa [liftCaptureIndices, hselectedLength, lamUses_length, + htotalSplit] using htarget + have hworld : HasWorld store' .shared value := + hownAfter.roots_world ⟨.shared, value⟩ (by simp) + have hcheck : checkResultWorld .shared (store', value) = + .ok (store', value) := by + simp [checkResultWorld, rval_hasWorld_eq_true_iff.mpr hworld] + have hinvoke : invoke ctx (targetFuel + 1) address (got ++ args) store = + .ok (store', value) := by + rw [invoke.eq_def] + dsimp only + rw [hdecl] + dsimp only + simp only [htotalLength] + simp + have hreverse : args.reverse ++ got.reverse = + (got ++ args).reverse := by + simp + rw [hreverse, htarget', bindOk] + exact hcheck + exact ⟨targetFuel + 1, store', value, hinvoke⟩ + +/-- Execute one selected generated recursor branch from an exact source RHS +trace. Progress constructs the target run without a target-fuel premise; +the ordinary semantic branch theorem is then instantiated at the produced +fuel to recover the result and caller-frame graphs. -/ +theorem lowerRecursorRule_branch_value_trace_progress_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + {sourceLimit fuel numArgs : Nat} {rule : IxIR0.RecRule} + {headState nextState : LowSt} + {fieldOutput rhsInput output : VEnv} + {fieldEmit parameterEmit bodyEmit : Emit} {av : AVal} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerTraceProgressContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx + sourceLimit) + (hself : CurrentSelfTraceProgressContractBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur sourceLimit) + (hfieldPlan : FieldRetainPlan + ⟨List.replicate rule.fields (.slot 0 0 .many false), + (numArgs + 1) + rule.fields⟩ + (recursorFieldRetains (numArgs + 1) rule.rhs rule.fields) + fieldOutput fieldEmit) + (hparameterPlan : ReleasePlan + ⟨fieldOutput.entries ++ + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (rule.fields + i) rule.rhs) ++ + [.recSelf (numArgs + 1)], + fieldOutput.depth + 1⟩ + ((parameterDrops 0 (List.replicate numArgs .many) + (fun i => countUses (rule.fields + i) rule.rhs)).map + (SlotDrop.offsetEntry rule.fields)) + rhsInput parameterEmit) + (hbodyRun : (lowerE src fuel rhsInput .shared rule.rhs).run headState = + .ok (output, bodyEmit, av) nextState) + (hextends : ExtraExtends nextState ambient) + {sourcePre : List IxIR0.Value} {pre : List RVal} + {sourceFields : List IxIR0.Value} {fields : List RVal} + {sourceSelf sourceValue : IxIR0.Value} {major : RVal} + {sourceFuel : Nat} + (hsourceBound : sourceFuel < sourceLimit) + (hsource : IxIR0.ProjectionSafe.Eval sourceCtx sourceFuel + (sourceFields.reverse ++ sourcePre.reverse ++ [sourceSelf]) + rule.rhs sourceValue) + (hpreLength : pre.length = numArgs) + (hfieldsLength : fields.length = rule.fields) + {store : Store} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hpreGraphs : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store sourcePre pre) + (hfieldGraphs : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store sourceFields fields) + (hsourceSelf : recSelfRel sourceSelf (numArgs + 1)) + (hframe : Sim.RootsGraph + (CompilerFunctionRel sourceCtx src ambient) store sourceRest rest) + (hown : RootOwnership store + (rootsFor .shared (pre ++ [major]) ++ rest)) + (hfieldWorld : ∀ field ∈ fields, HasWorld store .shared field) : + ∃ branchFuel store' value, + runCode ctx branchFuel cur store + (fields.reverse ++ major :: pre.reverse) + (fieldEmit + (emitOp (.drop (.var (fieldOutput.rel numArgs))) + (parameterEmit + (bodyEmit (.ret (av.toAtom output)))))) = + .ok (store', value) ∧ + Sim.ValueGraph (CompilerFunctionRel sourceCtx src ambient) store' + sourceValue value ∧ + Sim.RootsGraph (CompilerFunctionRel sourceCtx src ambient) store' + sourceRest rest := by + have hentry := recursorAltEntry_value_state + (funRel := CompilerFunctionRel sourceCtx src ambient) + (recSelfRel := recSelfRel) numArgs rule.fields rule.rhs + hpreLength hfieldsLength hpreGraphs hfieldGraphs hsourceSelf hframe hown + hfieldWorld + have hprefix := recursorPrefixPlans_valueProgress + (funRel := CompilerFunctionRel sourceCtx src ambient) + (recSelfRel := recSelfRel) (ctx := ctx) (cur := cur) + numArgs rule.fields rule.rhs hfieldPlan hparameterPlan + (sourceFields.reverse ++ sourcePre.reverse ++ [sourceSelf]) + sourceRest rest major fields + have hbodyProgress : LowerResultValueProgress + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur + rhsInput output + (sourceFields.reverse ++ sourcePre.reverse ++ [sourceSelf]) + (sourceFields.reverse ++ sourcePre.reverse ++ [sourceSelf]) + sourceValue .shared bodyEmit av := + (lowerValueTraceProgressClusterWithinBelow + (recSelfRel := recSelfRel) (cur := cur) + henv hrepresented hcontracts hvalues hprogress fuel).expr + hsourceBound hsource hbodyRun hextends + (SelfTraceProgressAvailableBelow.of_contract hself) + have hbodyCode : CodeProgress ctx cur + (GraphOwnsVEnv (CompilerFunctionRel sourceCtx src ambient) + recSelfRel rhsInput + (sourceFields.reverse ++ sourcePre.reverse ++ [sourceSelf]) + sourceRest rest) + (bodyEmit (.ret (av.toAtom output))) := + hbodyProgress.closeProgress sourceRest rest + have hfull : CodeProgress ctx cur + (GraphOwnsVEnvRetains + (CompilerFunctionRel sourceCtx src ambient) recSelfRel + (recursorInitialVEnv numArgs rule.fields rule.rhs) + (sourceFields.reverse ++ sourcePre.reverse ++ [sourceSelf]) + sourceRest rest [⟨.shared, major⟩] + (recursorFieldSlots numArgs (major :: fields)) fields + (recursorFieldRetains (numArgs + 1) rule.rhs rule.fields)) + (fieldEmit + (emitOp (.drop (.var (fieldOutput.rel numArgs))) + (parameterEmit + (bodyEmit (.ret (av.toAtom output)))))) := by + exact hprefix.progresses + (bodyEmit (.ret (av.toAtom output))) hbodyCode + obtain ⟨branchFuel, store', value, hbranchRun⟩ := + hfull (store := store) + (env := fields.reverse ++ major :: pre.reverse) hentry + have hgraphs := lowerRecursorRule_branch_value_below + (limit := branchFuel) henv hrepresented hcontracts + (hvalues.below branchFuel) + (hself.toCurrentSelfValueContract.below branchFuel) + hfieldPlan hparameterPlan hbodyRun hextends hsource.run + hpreLength hfieldsLength hpreGraphs hfieldGraphs hsourceSelf hframe hown + hfieldWorld (Nat.le_refl branchFuel) hbranchRun + exact ⟨branchFuel, store', value, hbranchRun, hgraphs.1, hgraphs.2⟩ + +/-- Every indexed source rule represented by a completed lowering plan has +a selectable target alternative with the same case index. -/ +theorem RecursorRulesPlanBelow.find?_exists_of_mem + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel numArgs : Nat} {state finalState : LowSt} + {rules : List (IxIR0.RecRule × Nat)} {alts : List Alt} + (hplan : RecursorRulesPlanBelow ctx cur limit src fuel numArgs + state rules finalState alts) + {rule : IxIR0.RecRule} {cidx : Nat} + (hmember : (rule, cidx) ∈ rules) : + ∃ selectedTag fieldCount body, + alts.toArray.find? (fun alt => alt.cidx == cidx) = + some (.mk selectedTag fieldCount body) := by + have hexists : ∃ alt ∈ alts, alt.cidx = cidx := by + exact (RecursorRulesPlanWith.traverse + (Result := fun _ currentRules _ currentAlts => + ∀ selectedRule selectedCidx, + (selectedRule, selectedCidx) ∈ currentRules → + ∃ alt ∈ currentAlts, alt.cidx = selectedCidx) + (hnil := by + intro current selectedRule selectedCidx hselected + simp at hselected) + (hcons := by + intro state middleState finalState headRule tag tailRules alt tailAlts + hhead hcontract tail ih selectedRule selectedCidx hselected + simp only [List.mem_cons] at hselected + rcases hselected with hheadMember | htailMember + · cases hheadMember + obtain ⟨fieldOutput, fieldEmit, rhsInput, parameterEmit, + output, bodyEmit, av, hfieldPlan, hparameterPlan, + hbodyRun, halt⟩ := + lowerRecursorRule_run_plan_inv hhead + refine ⟨alt, by simp, ?_⟩ + rw [halt] + simp [Alt.cidx] + · obtain ⟨selected, hselectedMem, hselectedTag⟩ := + ih selectedRule selectedCidx htailMember + exact ⟨selected, by simp [hselectedMem], hselectedTag⟩) + (hplan := hplan)) rule cidx hmember + obtain ⟨candidate, hcandidateMem, hcandidateTag⟩ := hexists + have hisSome : + (alts.toArray.find? (fun alt => alt.cidx == cidx)).isSome := by + apply Array.find?_isSome.mpr + exact ⟨candidate, by simpa using hcandidateMem, + by simp [hcandidateTag]⟩ + cases hfind : alts.toArray.find? (fun alt => alt.cidx == cidx) with + | none => simp [hfind] at hisSome + | some selected => + cases selected with + | mk selectedTag fieldCount body => + exact ⟨selectedTag, fieldCount, body, rfl⟩ + +/-- Contractive function-entry adapter for exact source traces. The source +definition saturation witness selects a body trace strictly below +`sourceLimit`; the compiler-fuel cluster then supplies target progress using +only declaration/application contracts below that same bound. -/ +theorem lowerFnBody_parameterEntries_valueTraceProgressesAt_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} + {compilerFuel sourceLimit : Nat} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerTraceProgressContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx + sourceLimit) + (modes : List Uses) (world : Owned) (body : IxIR0.Expr) + {state finalState : LowSt} {code : Code} {papSafeFlag : Bool} + (hadmissible : ParameterDropsAdmissible modes + (fun index => countUses index body)) + (hrun : (lowerFnBody src (compilerFuel + 1) + ⟨parameterEntries 0 modes (fun index => countUses index body), + modes.length⟩ + (parameterDrops 0 modes (fun index => countUses index body)) + world body).run state = .ok code finalState) + (hextends : ExtraExtends finalState ambient) + {sourceFunction : IxIR0.Value} + (hsaturates : ∀ {sourceArgs : List IxIR0.Value} + {sourceResult : IxIR0.Value}, + sourceArgs.length = modes.length → + SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + sourceArgs sourceResult → + ∃ sourceFuel, sourceFuel < sourceLimit ∧ + IxIR0.ProjectionSafe.Eval sourceCtx sourceFuel sourceArgs.reverse + body sourceResult) : + FnValueTraceProgressesAt + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx + ⟨modes.length, world, papSafeFlag, code⟩ (modes.map worldOfUses) + sourceFunction sourceLimit := by + let remaining : Nat → Nat := fun index => countUses index body + let input : VEnv := + ⟨parameterEntries 0 modes remaining, modes.length⟩ + let drops := parameterDrops 0 modes remaining + have hrun' : + (lowerFnBody src (compilerFuel + 1) input drops world body).run state = + .ok code finalState := by + simpa [input, drops, remaining] using hrun + simp only [lowerFnBody] at hrun' + obtain ⟨releaseResult, releaseState, hreleaseRun, hafterRelease⟩ := + trackedBindRun_ok_inv hrun' + rcases releaseResult with ⟨middle, releaseEmit⟩ + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + trackedBindRun_ok_inv hafterRelease + rcases bodyResult with ⟨output, emit, av⟩ + have hpure : + (releaseEmit ∘ emit) (.ret (av.toAtom output)) = code ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨hcode, hbodyState⟩ := hpure + subst bodyState + have hmiddleNo : NoRecSelf middle := + releaseSlots_noRecSelf input hreleaseRun (by + simpa [input, remaining] using + parameterEntries_noRecSelf 0 modes remaining modes.length) + obtain ⟨plannedMiddle, plannedEmit, hplan, _⟩ := + parameterDrops_releasePlan_tracked 0 modes remaining + (by simpa [remaining] using hadmissible) + have hplan' : ReleasePlan input drops plannedMiddle plannedEmit := by + simpa [input, drops] using hplan + have hplanRun : (releaseSlots input drops).run state = + .ok (plannedMiddle, plannedEmit) state := hplan'.run state + have heq : + (plannedMiddle, plannedEmit) = (middle, releaseEmit) ∧ + state = releaseState := by + simpa using hplanRun.symm.trans hreleaseRun + have hmiddle : plannedMiddle = middle := congrArg Prod.fst heq.1 + have hemit : plannedEmit = releaseEmit := congrArg Prod.snd heq.1 + subst middle + subst releaseEmit + cases heq.2 + intro store args sourceArgs sourceResult sourceRest rest hlength hargs + happlies hframe hown + have hargsLength : args.length = modes.length := by + simpa using hlength + have hsourceArgsLength : sourceArgs.length = args.length := by + simpa using hargs.length + obtain ⟨sourceFuel, hsourceBound, hsource⟩ := hsaturates + (hsourceArgsLength.trans hargsLength) happlies + have hbodyProgress : LowerResultValueProgress + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx + ⟨modes.length, world, papSafeFlag, code⟩ plannedMiddle output + sourceArgs.reverse sourceArgs.reverse sourceResult world emit av := + (lowerValueTraceProgressClusterWithinBelow + (recSelfRel := recSelfRel) + (cur := (⟨modes.length, world, papSafeFlag, code⟩ : FnDef)) + henv hrepresented hcontracts hvalues hprogress compilerFuel).expr + hsourceBound hsource hbodyRun hextends + (SelfTraceProgressAvailableBelow.of_noRecSelf hmiddleNo) + have hfull : LowerResultValueProgress + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx + ⟨modes.length, world, papSafeFlag, code⟩ input output + sourceArgs.reverse sourceArgs.reverse sourceResult world + (plannedEmit ∘ emit) av := + hbodyProgress.afterRelease hplan' + have hpre : GraphOwnsVEnv + (CompilerFunctionRel sourceCtx src ambient) recSelfRel input + sourceArgs.reverse sourceRest rest store args.reverse := by + refine ⟨(rootsForWorlds (modes.map worldOfUses) args).reverse, + ?_, hframe, ?_⟩ + · simpa [input] using VEnvValueGraph.parameterEntries + (recSelfRel := recSelfRel) modes remaining hargsLength hargs hown + · exact hown.perm + ((List.reverse_perm + (rootsForWorlds (modes.map worldOfUses) args)).symm.append_right + rest) + obtain ⟨targetFuel, store', value, htarget⟩ := + hfull.closeProgress sourceRest rest hpre + exact ⟨targetFuel, store', value, by simpa only [hcode] using htarget⟩ + +/-- A reachable ordinary declaration proves its exact current-fuel callable +progress from the retained definition-reference trace and only +strictly-smaller compiler trace contracts. -/ +theorem lowerDecl_defn_valueTraceProgressesAt_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {ctx : Ctx} {compilerFuel sourceLimit : Nat} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerTraceProgressContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx + sourceLimit) + {address : Ixon.Address} {result : Owned} {body : IxIR0.Expr} + {state finalState : LowSt} {d : FnDef} + {sourceFunction : IxIR0.Value} + (hsrc : src address = some (.defn result body)) + (href : SourceRefTraceAt sourceCtx sourceLimit address sourceFunction) + (hadmissible : ParameterDropsAdmissible (lamUses body) + (fun index => countUses index (stripLams body))) + (hrun : (lowerDecl src (compilerFuel + 1) + (address, .defn result body)).run state = + .ok (some (address, .fn d)) finalState) + (hextends : ExtraExtends finalState ambient) : + FnValueTraceProgressesAt + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + ((lamUses body).map worldOfUses) sourceFunction sourceLimit := by + simp only [lowerDecl] at hrun + obtain ⟨code, bodyState, hbodyRun, hpureRun⟩ := + trackedBindRun_ok_inv hrun + have hpure : + some (address, Decl.fn ⟨lamArity body, result, + result == .shared && papSafe body, code⟩) = + some (address, Decl.fn d) ∧ + bodyState = finalState := by + simpa using hpureRun + have hd : d = ⟨lamArity body, result, + result == .shared && papSafe body, code⟩ := by + have hp := Option.some.inj hpure.1 + exact Decl.fn.inj (Prod.mk.inj hp).2.symm + cases hpure.2 + subst d + have hlookup : sourceCtx.env address = some (.defn result body) := by + rw [henv] + exact hsrc + have hprogresses : FnValueTraceProgressesAt + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx + ⟨(lamUses body).length, result, + result == .shared && papSafe body, code⟩ + ((lamUses body).map worldOfUses) sourceFunction sourceLimit := + lowerFnBody_parameterEntries_valueTraceProgressesAt_within_below + (recSelfRel := fun _ _ => False) + (compilerFuel := compilerFuel) (sourceLimit := sourceLimit) + henv hrepresented hcontracts hvalues hprogress (lamUses body) result + (stripLams body) hadmissible (by simpa using hbodyRun) hextends + (by + intro sourceArgs sourceResult hlength happlies + exact href.defnSaturate hlookup (by simpa using hlength) happlies) + have hfn : (⟨(lamUses body).length, result, + result == .shared && papSafe body, code⟩ : FnDef) = + ⟨lamArity body, result, + result == .shared && papSafe body, code⟩ := by + rw [lamUses_length] + rw [← hfn] + intro store args sourceArgs sourceResult sourceRest rest hlength hargs + happlies hframe hown + exact hprogresses hlength hargs happlies hframe hown + +/-- Exact source-trace progress for a generated recursor function. Source +saturation selects the indexed rule and its smaller RHS trace; the completed +lowering plan supplies the matching target alternative, whose prefix and RHS +then execute by the recursor-branch progress theorem. -/ +theorem lowerRecursor_valueTraceProgressesAt_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {ctx : Ctx} {sourceLimit compilerFuel numArgs : Nat} + {natLit : Bool} {rules : Array IxIR0.RecRule} + {address : Ixon.Address} {sourceFunction : IxIR0.Value} + {state finalState : LowSt} {d : FnDef} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerTraceProgressContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx + sourceLimit) + (hsrc : src address = some (.recursor numArgs natLit rules)) + (hdecl : ctx.decls address = some (.fn d)) + (href : SourceRefTraceAt sourceCtx sourceLimit address sourceFunction) + (hrun : (lowerRecursor src compilerFuel numArgs natLit rules).run state = + .ok d finalState) + (hextends : ExtraExtends finalState ambient) : + FnValueTraceProgressesAt + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + (List.replicate (numArgs + 1) .shared) sourceFunction + sourceLimit := by + simp only [lowerRecursor] at hrun + obtain ⟨alts, rulesState, hrulesRun, hafterRules⟩ := + trackedBindRun_ok_inv hrun + have hpure : + (⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩ : FnDef) = d ∧ + rulesState = finalState := by + simpa using hafterRules + obtain ⟨hd, hstate⟩ := hpure + subst d + subst rulesState + have hsourceLookup : sourceCtx.env address = + some (.recursor numArgs natLit rules) := by + rw [henv] + exact hsrc + have hrefValue : SourceRefValue sourceCtx address sourceFunction := + ⟨sourceLimit, href.run⟩ + have hsourceFunction := hrefValue.recursorValue hsourceLookup + subst sourceFunction + let recSelfRel : RecSelfRel := fun value arity => + value = .pap (.rec_ address (numArgs + 1)) [] ∧ + arity = numArgs + 1 + obtain ⟨ownedD, hownedDecl, _, _, hownedContract⟩ := + hcontracts.decls.recursor hsrc + have hownedD : ownedD = + (⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩ : FnDef) := by + have hsame : some (Decl.fn ownedD) = some + (.fn ⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩) := + hownedDecl.symm.trans hdecl + exact Decl.fn.inj (Option.some.inj hsame) + subst ownedD + have hvalueContract : FnValueContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx + ⟨numArgs + 1, .shared, true, .case (.var 0) natLit alts.toArray⟩ + (List.replicate (numArgs + 1) .shared) + (.pap (.rec_ address (numArgs + 1)) []) := by + apply hvalues.decls.fnContract hsrc (by rfl) hdecl hrefValue + simp + have hself : CurrentSelfTraceProgressContractBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + ⟨numArgs + 1, .shared, true, .case (.var 0) natLit alts.toArray⟩ + sourceLimit := by + refine + { toCurrentSelfValueContract := ?_ + progress := ?_ } + · refine ⟨rfl, ?_, ?_⟩ + · simpa using hownedContract + · intro candidate hcandidate + change candidate = .pap (.rec_ address (numArgs + 1)) [] ∧ + numArgs + 1 = numArgs + 1 at hcandidate + rcases hcandidate with ⟨rfl, _⟩ + exact hvalueContract + · intro candidate arity hcandidate + change candidate = .pap (.rec_ address (numArgs + 1)) [] ∧ + arity = numArgs + 1 at hcandidate + rcases hcandidate with ⟨rfl, rfl⟩ + refine ⟨by simp, ?_⟩ + intro prior hprior + cases prior with + | zero => + intro store args sourceArgs sourceResult sourceRest rest + hargsLength hargs happlies hframe hown + have hsourceArgsLength : sourceArgs.length = numArgs + 1 := by + calc + sourceArgs.length = args.length := hargs.length + _ = numArgs + 1 := by simpa using hargsLength + cases happlies with + | nil => simp at hsourceArgsLength + | cons hbound hstep htail => omega + | succ prior => + exact hprogress.decls.fn_progresses hprior hsrc (by rfl) hdecl + (IxIR0.ProjectionSafe.Eval.refRecursor + (fuel := prior) (env := []) hsourceLookup) + have hfinalRepresented : ExtraRepresented ctx finalState := + hrepresented.of_extends hextends + have hownershipSelf : CurrentSelfContractBelow ctx + ⟨numArgs + 1, .shared, true, .case (.var 0) natLit alts.toArray⟩ + sourceLimit := + ⟨hself.result, hself.ownership.below sourceLimit⟩ + have hplan : RecursorRulesPlanBelow ctx + ⟨numArgs + 1, .shared, true, .case (.var 0) natLit alts.toArray⟩ + sourceLimit src compilerFuel numArgs state rules.toList.zipIdx + finalState alts := + recursorRulesPlanBelow_of_run (hcontracts.below sourceLimit).apply + (hcontracts.below sourceLimit).decls hownershipSelf rfl + compilerFuel numArgs hrulesRun hfinalRepresented + intro store args sourceArgs sourceResult sourceRest rest + hargsLength hargs happlies hframe hown + have hargsArity : args.length = numArgs + 1 := by + simpa using hargsLength + have hrootShape : + rootsForWorlds (List.replicate (numArgs + 1) .shared) args = + rootsFor .shared args := + rootsForWorlds_replicate_eq_rootsFor .shared hargsArity + rw [hrootShape] at hown + cases hreverse : args.reverse with + | nil => + have hargsNil : args = [] := by + have h := congrArg List.reverse hreverse + simpa using h + simp [hargsNil] at hargsArity + | cons major runtimePre => + have hargsForm : args = runtimePre.reverse ++ [major] := by + have h := congrArg List.reverse hreverse + simpa [List.reverse_cons] using h + have hruntimePreLength : runtimePre.length = numArgs := by + rw [hargsForm] at hargsArity + simp only [List.length_append, List.length_reverse, + List.length_singleton] at hargsArity + omega + obtain ⟨sourcePre, sourceMajor, hsourceArgsForm, + hsourcePreLength, hpreGraphs, hmajorGraph⟩ := + valuesGraph_splitLast hargs hargsForm hruntimePreLength + rw [hsourceArgsForm] at happlies + obtain ⟨sourceTag, sourceFields, sourceRule, bodyFuel, + hbodyFuelBound, hsourceMajor, hsourceRule, + hsourceFieldsLength, hsourceEval⟩ := + sourceRecursorRef_saturates_trace_inv hsourceLookup href + hsourcePreLength happlies + have hmajorWorld : HasWorld store .shared major := by + apply hown.roots_world ⟨.shared, major⟩ + apply List.mem_append_left rest + simp [rootsFor, hargsForm] + have hentryOwn : RootOwnership store + (rootsFor .shared (runtimePre.reverse ++ [major]) ++ rest) := by + simpa [hargsForm] using hown + have hsourceRuleList : + rules.toList[sourceTag]? = some sourceRule := by + rw [Array.getElem?_toList] + exact hsourceRule + have hsourceMember : + (sourceRule, sourceTag) ∈ rules.toList.zipIdx := + List.mk_mem_zipIdx_iff_getElem?.2 hsourceRuleList + obtain ⟨selectedTag, fieldCount, body, halt⟩ := + hplan.find?_exists_of_mem hsourceMember + obtain ⟨rule, headState, nextState, tailRules, tailAlts, + fieldOutput, fieldEmit, rhsInput, parameterEmit, + output, bodyEmit, av, hrule, _, hfieldCount, + hfieldPlan, hparameterPlan, hbodyRun, hbody, htailPlan⟩ := + hplan.find?_run_plan_inv halt + have hruleEq : rule = sourceRule := + Option.some.inj (hrule.symm.trans hsourceRule) + subst rule + have htailExtends : ExtraExtends nextState finalState := + (ExtraMonotone.listMapM + (lowerRecursorRule src compilerFuel numArgs) + (lowerRecursorRule_extraMonotone src compilerFuel numArgs) + tailRules) htailPlan.run + have hnextExtends : ExtraExtends nextState ambient := + htailExtends.trans hextends + have finish {targetFields : List RVal} + (hfieldGraphs : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store + sourceFields targetFields) + (htargetFieldsLength : targetFields.length = fieldCount) + (hfieldWorld : ∀ field ∈ targetFields, + HasWorld store .shared field) : + ∃ branchFuel store' value, + runCode ctx branchFuel + ⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩ + store (targetFields.reverse ++ major :: runtimePre) body = + .ok (store', value) ∧ + Sim.ValueGraph (CompilerFunctionRel sourceCtx src ambient) + store' sourceResult value ∧ + Sim.RootsGraph (CompilerFunctionRel sourceCtx src ambient) + store' sourceRest rest := by + rw [hbody] + simpa using + (lowerRecursorRule_branch_value_trace_progress_within_below + (recSelfRel := recSelfRel) (sourceLimit := sourceLimit) + henv hrepresented hcontracts hvalues hprogress hself + hfieldPlan hparameterPlan hbodyRun hnextExtends + (sourcePre := sourcePre) (pre := runtimePre.reverse) + (sourceFields := sourceFields) (fields := targetFields) + (sourceSelf := .pap (.rec_ address (numArgs + 1)) []) + (sourceValue := sourceResult) (major := major) + hbodyFuelBound hsourceEval (by simpa using hruntimePreLength) + (htargetFieldsLength.trans hfieldCount) + hpreGraphs hfieldGraphs ⟨rfl, rfl⟩ hframe hentryOwn hfieldWorld) + cases hmajorGraph with + | @lit literal => + cases literal with + | str string => simp [IxIR0.majorCtor] at hsourceMajor + | nat n => + cases hpeel : natLit with + | false => simp [IxIR0.majorCtor, hpeel] at hsourceMajor + | true => + cases n with + | zero => + have hmajorPair : + 0 = sourceTag ∧ sourceFields = [] := by + simpa [IxIR0.majorCtor, hpeel] using hsourceMajor + have htag : sourceTag = 0 := hmajorPair.1.symm + have hfields : sourceFields = [] := hmajorPair.2 + subst sourceTag + subst sourceFields + have hfieldCountZero : fieldCount = 0 := + hfieldCount.trans hsourceFieldsLength.symm + have haltZero : alts.toArray.find? + (fun alt => alt.cidx == 0) = + some (.mk selectedTag 0 body) := by + simpa [htag, hfieldCountZero] using halt + obtain ⟨branchFuel, store', value, hbranchRun, + hvalueGraph, hframeAfter⟩ := + finish Sim.ValuesGraph.nil + (by simpa using hfieldCountZero.symm) (by simp) + refine ⟨branchFuel + 1, store', value, ?_⟩ + rw [runCode_case_nat_zero rfl haltZero] + simpa [hpeel] using hbranchRun + | succ n => + have hmajorPair : + 1 = sourceTag ∧ + [.lit (.nat n)] = sourceFields := by + simpa [IxIR0.majorCtor, hpeel] using hsourceMajor + have htag : sourceTag = 1 := hmajorPair.1.symm + have hfields : sourceFields = [.lit (.nat n)] := + hmajorPair.2.symm + subst sourceTag + subst sourceFields + have hfieldCountOne : fieldCount = 1 := by + rw [hfieldCount] + simpa using hsourceFieldsLength.symm + have haltOne : alts.toArray.find? + (fun alt => alt.cidx == 1) = + some (.mk selectedTag 1 body) := by + simpa [htag, hfieldCountOne] using halt + obtain ⟨branchFuel, store', value, hbranchRun, + hvalueGraph, hframeAfter⟩ := + finish (.cons .lit .nil) + (by simpa using hfieldCountOne.symm) + (by simp [HasWorld]) + refine ⟨branchFuel + 1, store', value, ?_⟩ + rw [runCode_case_nat_succ (n := n) rfl haltOne] + simpa [hpeel] using hbranchRun + | erased => simp [IxIR0.majorCtor] at hsourceMajor + | @ctor sourceAddress sourceCtorTag sourceCtorFields loc + world rc cid targetFields hget haddress htag hfieldGraphs => + have hmajorPair : + sourceCtorTag = sourceTag ∧ + sourceCtorFields = sourceFields := by + simpa [IxIR0.majorCtor] using hsourceMajor + have hsourceTagEq : sourceTag = sourceCtorTag := + hmajorPair.1.symm + have hsourceFieldsEq : sourceFields = sourceCtorFields := + hmajorPair.2.symm + subst sourceTag + subst sourceFields + obtain ⟨ownedBox, hownedBox, hownedWorld⟩ := hmajorWorld + rw [hget] at hownedBox + have hboxEq : + (⟨world, rc, .ctorN cid targetFields⟩ : NodeBox) = + ownedBox := Option.some.inj hownedBox + subst ownedBox + dsimp only [NodeBox.world] at hownedWorld + subst world + have halt' : alts.toArray.find? + (fun alt => alt.cidx == cid.cidx) = + some (.mk selectedTag fieldCount body) := by + simpa [htag, hsourceTagEq] using halt + have hsize : targetFields.size = fieldCount := by + have hgraphLength := hfieldGraphs.length + simp only [Array.length_toList] at hgraphLength + omega + obtain ⟨branchFuel, store', value, hbranchRun, + hvalueGraph, hframeAfter⟩ := + finish (by simpa using hfieldGraphs) (by simpa using hsize) + (hown.caseFieldsBorrowed hget) + refine ⟨branchFuel + 1, store', value, ?_⟩ + rw [runCode_case_ctor rfl hget halt' hsize] + rw [Array.foldl_cons_eq_reverse_append] + exact hbranchRun + | function hget hfun hcaptures => + obtain ⟨uses, closureEnv, closureBody, hsourceMajorEq⟩ | + ⟨head, captures, hsourceMajorEq⟩ := + hfun.value_is_function henv + · subst sourceMajor + simp [IxIR0.majorCtor] at hsourceMajor + · subst sourceMajor + simp [IxIR0.majorCtor] at hsourceMajor + +/-- Declaration-facing adapter for exact recursor progress. `lowerDecl` +adds no runtime code; it only exposes the generated recursor and the compiler +state in which its proof-relevant rule plan was built. -/ +theorem lowerDecl_recursor_valueTraceProgressesAt_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {ctx : Ctx} {sourceLimit compilerFuel numArgs : Nat} + {natLit : Bool} {rules : Array IxIR0.RecRule} + {address : Ixon.Address} {sourceFunction : IxIR0.Value} + {state finalState : LowSt} {d : FnDef} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hprogress : CompilerTraceProgressContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx + sourceLimit) + (hsrc : src address = some (.recursor numArgs natLit rules)) + (hdecl : ctx.decls address = some (.fn d)) + (href : SourceRefTraceAt sourceCtx sourceLimit address sourceFunction) + (hrun : + (lowerDecl src compilerFuel + (address, .recursor numArgs natLit rules)).run state = + .ok (some (address, .fn d)) finalState) + (hextends : ExtraExtends finalState ambient) : + FnValueTraceProgressesAt + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + (List.replicate (numArgs + 1) .shared) sourceFunction + sourceLimit := by + simp only [lowerDecl] at hrun + obtain ⟨actual, recursorState, hrecursorRun, hafterRecursor⟩ := + trackedBindRun_ok_inv hrun + have hpure : + some (address, Decl.fn actual) = some (address, Decl.fn d) ∧ + recursorState = finalState := by + simpa using hafterRecursor + have hd : actual = d := by + have hp := Option.some.inj hpure.1 + exact Decl.fn.inj (Prod.mk.inj hp).2 + have hrecursorState : recursorState = finalState := hpure.2 + subst actual + subst recursorState + intro store args sourceArgs sourceResult sourceRest rest + hlength hargs happlies hframe hown + exact lowerRecursor_valueTraceProgressesAt_within_below + henv hrepresented hcontracts hvalues hprogress hsrc hdecl href + hrecursorRun hextends hlength hargs happlies hframe hown + +/-- At one exact source-evaluator index, every source-backed callable emitted +by an actual whole-pass run makes progress using only declaration and +higher-order progress contracts at strictly smaller source indices. -/ +theorem lowerAllAction_sourceFnTraceProgressesAt_within_below + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel sourceLimit : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htarget : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hprogress : CompilerTraceProgressContractsBelow + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx sourceLimit) : + SourceFnTraceProgressesAt + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx sourceLimit := by + intro address source worlds result d sourceFunction + hsrc hsignature hdecl href + obtain ⟨itemInitial, itemFinal, hrun, hextends⟩ := + lowerAllAction_callable_decl_trace hlower htarget hsrc hsignature hdecl + cases source with + | defn sourceResult body => + simp only [sourceCallableSignature, Option.some.injEq, + Prod.mk.injEq] at hsignature + obtain ⟨rfl, rfl⟩ := hsignature + cases compilerFuel with + | zero => + simp only [lowerDecl] at hrun + obtain ⟨code, bodyState, hbodyRun, _⟩ := + trackedBindRun_ok_inv hrun + exact (trackedThrowRun_not_ok (by + simpa [lowerFnBody] using hbodyRun)).elim + | succ bodyFuel => + have hadmissible := lowerDecl_defn_parameterDropsAdmissible hrun + intro store args sourceArgs sourceValue sourceRest rest + hlength hargs happlies hframe hown + exact lowerDecl_defn_valueTraceProgressesAt_within_below + (compilerFuel := bodyFuel) (sourceLimit := sourceLimit) + henv hrepresented hcontracts hvalues hprogress hsrc href + hadmissible (by simpa [Nat.succ_eq_add_one] using hrun) hextends + hlength hargs happlies hframe hown + | ctor tag arity => + simp [sourceCallableSignature] at hsignature + | recursor numArgs natLit rules => + simp only [sourceCallableSignature, Option.some.injEq, + Prod.mk.injEq] at hsignature + obtain ⟨rfl, rfl⟩ := hsignature + intro store args sourceArgs sourceValue sourceRest rest + hlength hargs happlies hframe hown + exact lowerDecl_recursor_valueTraceProgressesAt_within_below + (compilerFuel := compilerFuel) (sourceLimit := sourceLimit) + henv hrepresented hcontracts hvalues hprogress hsrc hdecl href + hrun hextends hlength hargs happlies hframe hown + | extern arity => + simp [sourceCallableSignature] at hsignature + +/-- The generated constructor eta-wrapper has a fixed two-step body run. +Its trace-progress proof is independent of the source application trace; +that trace is consumed by the semantic contract when the invocation is +closed. -/ +theorem ctorWrapper_fnValueTraceProgressesAt + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + {sourceLimit : Nat} (source : Ixon.Address) (tag arity : Nat) + (sourceFunction : IxIR0.Value) : + FnValueTraceProgressesAt funRel sourceCtx ctx + ⟨arity, .shared, true, + .letOp (.alloc .shared (ctorIdOf source tag) + (descendingVars arity).toArray) (.ret (.var 0))⟩ + (List.replicate arity .shared) sourceFunction sourceLimit := by + intro store args sourceArgs sourceResult sourceRest rest + hlength _ _ _ _ + have hargsLength : args.length = arity := by + simpa using hlength + have hresolve : resolveAtoms args.reverse + (descendingVars arity).toArray = .ok args := by + rw [← hargsLength] + exact descendingVars_resolveAtoms args + let allocated := store.allocNode .shared + (.ctorN (ctorIdOf source tag) args.toArray) + refine ⟨2, allocated.1, .loc allocated.2, ?_⟩ + simp only [runCode, runOp] + rw [hresolve] + simp [resolveAtom, allocated] + rfl + +/-- Exact source-trace progress for saturating every callable origin in the +whole-pass function relation. Same-address source declarations are tied +back to the concrete `lowerDecl` run selected by `lowerAllAction`; generated +wrappers and lifted closures use their retained compiler provenance. -/ +theorem invoke_compilerFunction_value_trace_progress_within_below + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel sourceLimit : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htarget : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hprogress : CompilerTraceProgressContractsBelow + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx sourceLimit) + {sourceFunction sourceResult : IxIR0.Value} + {address : Ixon.Address} {arity : Nat} + {captures sourceArgs : List IxIR0.Value} + {store : Store} {got args : List RVal} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hrel : CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) + finalState sourceFunction address arity captures) + (hcaptures : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + store captures got) + (hargs : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + store sourceArgs args) + (happlies : SourceAppliesSafelyBelow sourceCtx sourceLimit + sourceFunction sourceArgs sourceResult) + (hframe : Sim.RootsGraph + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + store sourceRest rest) + (hown : RootOwnership store + (rootsFor .shared (got ++ args) ++ rest)) + (htotalLength : (got ++ args).length = arity) : + ∃ fuel store' value, + invoke ctx fuel address (got ++ args) store = .ok (store', value) ∧ + Sim.ValueGraph + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + store' sourceResult value ∧ + Sim.RootsGraph + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + store' sourceRest rest ∧ + RootOwnership store' (⟨.shared, value⟩ :: rest) := by + have hsourceArgsNonempty : sourceArgs ≠ [] := by + intro hnil + subst sourceArgs + have hargsNil : args = [] := by + apply List.eq_nil_of_length_eq_zero + simpa using hargs.length.symm + have hgotLength : got.length = arity := by + simpa [hargsNil] using htotalLength + have hcapturesLength : captures.length = got.length := + hcaptures.length + have hunder := hrel.underfilled + omega + have htwo : 2 < sourceLimit := + happlies.two_lt_limit_of_nonempty (hrel.value_ne_erased henv) + hsourceArgsNonempty + cases hrel with + | @source relatedFunction baseFunction targetAddress targetArity + storedSources source hsrc heligible harity href hprefix hunder => + have hfullGraph : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + store (captures ++ sourceArgs) (got ++ args) := + hcaptures.append hargs + cases source with + | defn result body => + obtain ⟨hresultShared, hsafe⟩ := heligible + subst result + have hpositive : 0 < lamArity body := by + simp only [sourceDeclArity] at harity + omega + have hinitial := href.lambdaPrefix_nil henv hsrc hpositive + have hstoredUnder : ([] ++ captures).length < lamArity body := by + simp only [sourceDeclArity] at harity + simpa [harity] using hunder + have hlambdaPrefix := + hinitial.append_of_applies hprefix hstoredUnder + have hstoredTrace : SourceAppliesSafelyBelow sourceCtx sourceLimit + baseFunction captures sourceFunction := + hinitial.toAppliesBelow_from_initial hlambdaPrefix htwo + have hfullTrace := hstoredTrace.append happlies + have hrefTrace : SourceRefTraceAt sourceCtx sourceLimit address + baseFunction := + href.defnTraceAt_of_positive henv hsrc hpositive + (Nat.le_of_lt htwo) + obtain ⟨d, hdecl, harityDef, hresultDef, hownership⟩ := + hcontracts.decls.defn hsrc + obtain ⟨itemInitial, itemFinal, hrun, hextends⟩ := + lowerAllAction_callable_decl_trace hlower htarget hsrc (by rfl) + hdecl + cases compilerFuel with + | zero => + simp only [lowerDecl] at hrun + obtain ⟨code, bodyState, hbodyRun, _⟩ := + trackedBindRun_ok_inv hrun + exact (trackedThrowRun_not_ok (by + simpa [lowerFnBody] using hbodyRun)).elim + | succ bodyFuel => + have hadmissible := lowerDecl_defn_parameterDropsAdmissible hrun + have hbodyProgress : FnValueTraceProgressesAt + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) + finalState) sourceCtx ctx d + ((lamUses body).map worldOfUses) baseFunction sourceLimit := + lowerDecl_defn_valueTraceProgressesAt_within_below + (compilerFuel := bodyFuel) (sourceLimit := sourceLimit) + henv hrepresented hcontracts hvalues hprogress hsrc hrefTrace + hadmissible (by simpa [Nat.succ_eq_add_one] using hrun) + hextends + have hvalueContract : FnValueContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) + finalState) sourceCtx ctx d + ((lamUses body).map worldOfUses) baseFunction := by + apply hvalues.decls.fnContract hsrc (by rfl) hdecl href + simpa using harityDef.symm + have hmodes := papSafe_lamUses_eq_replicate hsafe + have hworlds : (lamUses body).map worldOfUses = + List.replicate (lamUses body).length .shared := by + rw [hmodes] + simp [worldOfUses] + have hlength : (got ++ args).length = + ((lamUses body).map worldOfUses).length := by + simpa [sourceDeclArity, lamUses_length] using + htotalLength.trans harity.symm + have hroots : rootsForWorlds + ((lamUses body).map worldOfUses) (got ++ args) = + rootsFor .shared (got ++ args) := by + rw [hworlds] + exact rootsForWorlds_replicate_eq_rootsFor .shared (by + simpa [hworlds] using hlength) + have hown' : RootOwnership store + (rootsForWorlds ((lamUses body).map worldOfUses) + (got ++ args) ++ rest) := by + rwa [hroots] + obtain ⟨fuel, store', value, hinvoke, hresult, hframe', hown'⟩ := + invoke_fn_value_trace_progress_at hdecl hvalueContract.arity_eq + hbodyProgress hownership hvalueContract hlength hfullGraph + hfullTrace hframe hown' + rw [hresultDef] at hown' + exact ⟨fuel, store', value, hinvoke, hresult, hframe', hown'⟩ + | ctor tag ctorArity => + exact heligible.elim + | recursor numArgs natLit rules => + have hlookup : sourceCtx.env address = + some (.recursor numArgs natLit rules) := by + rw [henv] + exact hsrc + have hbase := href.recursorValue hlookup + subst baseFunction + have hstoredUnder : + ([] ++ captures).length < + (IxIR0.Head.rec_ address (numArgs + 1)).arity := by + simp only [sourceDeclArity] at harity + simpa [IxIR0.Head.arity, harity] using hunder + have hstoredTrace := + projectionSafePap_underfills (sourceCtx := sourceCtx) htwo + hstoredUnder + have hrelated : sourceFunction = + .pap (.rec_ address (numArgs + 1)) captures := + hprefix.deterministic hstoredTrace.sourceApplies + subst sourceFunction + have hfullTrace := hstoredTrace.append happlies + have hrefTrace : SourceRefTraceAt sourceCtx sourceLimit address + (.pap (.rec_ address (numArgs + 1)) []) := + href.recursorTraceAt hlookup (by omega) + obtain ⟨d, hdecl, harityRec, hresultRec, hownership⟩ := + hcontracts.decls.recursor hsrc + obtain ⟨itemInitial, itemFinal, hrun, hextends⟩ := + lowerAllAction_callable_decl_trace hlower htarget hsrc (by rfl) + hdecl + have hbodyProgress : FnValueTraceProgressesAt + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) + finalState) sourceCtx ctx d + (List.replicate (numArgs + 1) .shared) + (.pap (.rec_ address (numArgs + 1)) []) sourceLimit := + lowerDecl_recursor_valueTraceProgressesAt_within_below + (compilerFuel := compilerFuel) (sourceLimit := sourceLimit) + henv hrepresented hcontracts hvalues hprogress hsrc hdecl + hrefTrace hrun hextends + have hvalueContract : FnValueContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) + finalState) sourceCtx ctx d + (List.replicate (numArgs + 1) .shared) + (.pap (.rec_ address (numArgs + 1)) []) := by + apply hvalues.decls.fnContract hsrc (by rfl) hdecl href + simpa using harityRec.symm + have hlength : (got ++ args).length = + (List.replicate (numArgs + 1) Owned.shared).length := by + simpa [sourceDeclArity] using htotalLength.trans harity.symm + have hroots : rootsForWorlds + (List.replicate (numArgs + 1) .shared) (got ++ args) = + rootsFor .shared (got ++ args) := + rootsForWorlds_replicate_eq_rootsFor .shared (by + simpa using hlength) + have hown' : RootOwnership store + (rootsForWorlds (List.replicate (numArgs + 1) .shared) + (got ++ args) ++ rest) := by + rwa [hroots] + obtain ⟨fuel, store', value, hinvoke, hresult, hframe', hown'⟩ := + invoke_fn_value_trace_progress_at hdecl hvalueContract.arity_eq + hbodyProgress hownership hvalueContract hlength hfullGraph + hfullTrace hframe hown' + rw [hresultRec] at hown' + exact ⟨fuel, store', value, hinvoke, hresult, hframe', hown'⟩ + | extern externArity => + have hpositive : 0 < externArity := by + simp only [sourceDeclArity] at harity + omega + have hbase := href.externPap henv hsrc hpositive + subst baseFunction + have hstoredUnder : + ([] ++ captures).length < + (IxIR0.Head.ext address externArity).arity := by + simp only [sourceDeclArity] at harity + simpa [IxIR0.Head.arity, harity] using hunder + have hstoredTrace := + projectionSafePap_underfills (sourceCtx := sourceCtx) htwo + hstoredUnder + have hrelated : sourceFunction = + .pap (.ext address externArity) captures := + hprefix.deterministic hstoredTrace.sourceApplies + subst sourceFunction + have hfullTrace := hstoredTrace.append happlies + have hlookup : sourceCtx.env address = + some (.extern externArity) := by + rw [henv] + exact hsrc + have hsourceLength : (captures ++ sourceArgs).length = + externArity := by + calc + (captures ++ sourceArgs).length = (got ++ args).length := + hfullGraph.length + _ = arity := htotalLength + _ = externArity := by + simpa [sourceDeclArity] using harity.symm + obtain ⟨runtimeResult, horacle⟩ := + hprogress.extern.progresses hlookup href hsourceLength hfullTrace + hfullGraph + have hdecl := hcontracts.decls.extern hsrc + have htargetArity : arity = externArity := by + simpa [sourceDeclArity] using harity.symm + have hruntimeLength : (got ++ args).length = externArity := + htotalLength.trans htargetArity + have hinvoke : invoke ctx 1 address (got ++ args) store = + .ok (store, runtimeResult) := by + simp [invoke, hdecl, hruntimeLength, horacle] + have hresult := hvalues.extern.preserves hlookup href hsourceLength + (SourceAppliesSafelyBelow.sourceApplies hfullTrace) hfullGraph + horacle + have hscalar := callScalarOracle_ok horacle + have hown' : RootOwnership store + (⟨.shared, runtimeResult⟩ :: rest) := + (hown.dropScalars hscalar.1).addNoLocation + (RVal.rvalLocation?_eq_none_of_isScalar hscalar.2) + exact ⟨1, store, runtimeResult, hinvoke, hresult, hframe, hown'⟩ + | @wrapper relatedFunction baseFunction storedSources memo hmember hsrc + href hprefix hunder => + have hfullGraph : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + store (captures ++ sourceArgs) (got ++ args) := + hcaptures.append hargs + have hlookup : sourceCtx.env memo.source = + some (.ctor memo.tag memo.arity) := by + rw [henv] + exact hsrc + have hpositive : 0 < memo.arity := by omega + have hbase := href.ctorPap henv hsrc hpositive + subst baseFunction + have hstoredUnder : + ([] ++ captures).length < + (IxIR0.Head.ctor memo.source memo.tag memo.arity).arity := by + simpa [IxIR0.Head.arity] using hunder + have hstoredTrace := + projectionSafePap_underfills (sourceCtx := sourceCtx) htwo + hstoredUnder + have hrelated : sourceFunction = + .pap (.ctor memo.source memo.tag memo.arity) captures := + hprefix.deterministic hstoredTrace.sourceApplies + subst sourceFunction + have hfullTrace := hstoredTrace.append happlies + let wrapperDef : FnDef := + ⟨memo.arity, .shared, true, + .letOp (.alloc .shared (ctorIdOf memo.source memo.tag) + (descendingVars memo.arity).toArray) (.ret (.var 0))⟩ + have hdecl : ctx.decls memo.wrapper = some (.fn wrapperDef) := by + simpa [wrapperDef, ctorWrapperDecl] using + hrepresented.wrapper hmember + have hbodyProgress : FnValueTraceProgressesAt + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx wrapperDef (List.replicate memo.arity .shared) + (.pap (.ctor memo.source memo.tag memo.arity) []) sourceLimit := by + dsimp only [wrapperDef] + exact ctorWrapper_fnValueTraceProgressesAt + (funRel := CompilerFunctionRel sourceCtx + (IxIR0.Env.ofList decls) finalState) + (sourceCtx := sourceCtx) (ctx := ctx) + (sourceLimit := sourceLimit) memo.source memo.tag memo.arity + (.pap (.ctor memo.source memo.tag memo.arity) []) + have hvalueContract := ctorWrapper_fnValueContract + (funRel := CompilerFunctionRel sourceCtx + (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx memo.source memo.tag memo.arity + (.pap (.ctor memo.source memo.tag memo.arity) []) hlookup href + have hownership := + ctorWrapper_fnOwnershipContract ctx memo.source memo.tag memo.arity + have hlength : (got ++ args).length = + (List.replicate memo.arity Owned.shared).length := by + simpa using htotalLength + have hroots : rootsForWorlds + (List.replicate memo.arity .shared) (got ++ args) = + rootsFor .shared (got ++ args) := + rootsForWorlds_replicate_eq_rootsFor .shared (by + simpa using hlength) + have hown' : RootOwnership store + (rootsForWorlds (List.replicate memo.arity .shared) + (got ++ args) ++ rest) := by + rwa [hroots] + exact invoke_fn_value_trace_progress_at hdecl hvalueContract.arity_eq + hbodyProgress hownership hvalueContract hlength hfullGraph + hfullTrace hframe hown' + | lifted hlifted => + obtain ⟨fuel, store', value, hinvoke⟩ := + invoke_lifted_value_trace_progress_within_below henv hrepresented + hcontracts hvalues hprogress hlifted hcaptures hargs happlies + hframe hown htotalLength + have hsemantic := invoke_lifted_value_below henv hrepresented + hcontracts (hvalues.below fuel) hlifted hcaptures hargs + happlies.sourceApplies hframe hown (Nat.le_refl fuel) hinvoke + have howned := invoke_lifted_owned_below hrepresented hcontracts + hlifted hown hinvoke + exact ⟨fuel, store', value, hinvoke, hsemantic.1, hsemantic.2, + howned⟩ + +/-- Exact source-trace progress for higher-order application of every +whole-pass compiler function. The only recursive target branch is +over-application; its remaining argument suffix is strictly shorter, so +the proof is independent of the source-fuel induction used to construct +callable-body progress. -/ +theorem lowerAllAction_applyValueTraceProgressesAt_within_below + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel sourceLimit : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htarget : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hprogress : CompilerTraceProgressContractsBelow + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx sourceLimit) : + ApplyValueTraceProgressesAt + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx sourceLimit := by + have go : ∀ argLength, + ∀ {store : Store} {function : RVal} {args : List RVal} + {sourceFunction : IxIR0.Value} + {sourceArgs : List IxIR0.Value} {sourceResult : IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root}, + args.length = argLength → + Sim.ValueGraph + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + store sourceFunction function → + Sim.ValuesGraph + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + store sourceArgs args → + SourceAppliesSafelyBelow sourceCtx sourceLimit sourceFunction + sourceArgs sourceResult → + sourceArgs ≠ [] → + Sim.RootsGraph + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + store sourceRest rest → + RootOwnership store + (⟨.shared, function⟩ :: rootsFor .shared args ++ rest) → + ∃ fuel store' value, + applyGo ctx fuel store function args = .ok (store', value) := by + intro argLength + induction argLength using Nat.strongRecOn with + | ind argLength ih => + intro store function args sourceFunction sourceArgs sourceResult + sourceRest rest hargsLength hfunction hargs happlies + hsourceArgsNonempty hframe hown + cases hfunction with + | lit => + cases sourceArgs with + | nil => exact (hsourceArgsNonempty rfl).elim + | cons sourceArgument sourceArgs => + cases happlies with + | cons _ hstep _ => cases hstep + | erased => + have hargsOwn : RootOwnership store + (rootsFor .shared args ++ rest) := + hown.dropNoLocation rfl + obtain ⟨dropFuel, store', hdrop, _⟩ := + dropMany_progress (ctx := ctx) hargsOwn + refine ⟨dropFuel + 1, store', .erased, ?_⟩ + rw [applyGo.eq_def] + dsimp only + rw [hdrop, bindOk] + | @ctor sourceAddress sourceTag sourceFields loc world rc cid fields + hget haddress htag hfields => + cases sourceArgs with + | nil => exact (hsourceArgsNonempty rfl).elim + | cons sourceArgument sourceArgs => + cases happlies with + | cons _ hstep _ => cases hstep + | @function relatedFunction address arity captures loc rc got hget + hrel hcaptures => + obtain ⟨declaration, hdeclaration, hpapsafe⟩ := + lowerAllAction_compilerFunction_declPapSafe hlower htarget + hrepresented hcontracts hrel + obtain ⟨dropFuel, dupStore, readyStore, hdup, hdrop, + hcapturesReady, hargsReady, hframeReady, hready⟩ := + applyGo_preparePap_valueGraphs_progress + (ctx := ctx) hget hcaptures hargs hframe hown + let total := got.toList ++ args + by_cases hunder : total.length < arity + · let allocated := readyStore.allocNode .shared + (.papN address arity total.toArray) + have hunder' : (got.toList ++ args).length < arity := by + simpa [total] using hunder + refine ⟨dropFuel + 1, allocated.1, .loc allocated.2, ?_⟩ + rw [applyGo.eq_def] + dsimp only + rw [hget] + dsimp only + rw [hdup, bindOk, hdrop, bindOk] + rw [if_pos hunder'] + · by_cases hexact : total.length = arity + · obtain ⟨invokeFuel, store', value, hinvoke, _, _, _⟩ := + invoke_compilerFunction_value_trace_progress_within_below + henv hlower htarget hrepresented hcontracts hvalues + hprogress hrel hcapturesReady hargsReady happlies + hframeReady hready (by simpa [total] using hexact) + let commonFuel := max dropFuel invokeFuel + have hdrop' : dropVal ctx commonFuel dupStore (.loc loc) = + .ok readyStore := + dropVal_mono (by + exact Nat.le_max_left dropFuel invokeFuel) hdrop + have hinvokeBase : invoke ctx invokeFuel address total readyStore = + .ok (store', value) := by + simpa [total] using hinvoke + have hinvoke' : invoke ctx commonFuel address total readyStore = + .ok (store', value) := + invoke_mono (by + exact Nat.le_max_right dropFuel invokeFuel) hinvokeBase + have hunder' : ¬(got.toList ++ args).length < arity := by + simpa [total] using hunder + have hexact' : (got.toList ++ args).length = arity := by + simpa [total] using hexact + refine ⟨commonFuel + 1, store', value, ?_⟩ + rw [applyGo.eq_def] + dsimp only + rw [hget] + dsimp only + rw [hdup, bindOk, hdrop', bindOk] + rw [if_neg hunder'] + have hbeq : ((got.toList ++ args).length == arity) = true := by + simp [hexact'] + rw [hbeq] + rw [hdeclaration] + simp only [hpapsafe, ↓reduceIte] + simpa using hinvoke' + · have hcapturesUnder : captures.length < arity := + hrel.underfilled + have hgotUnder : got.toList.length < arity := by + rw [← hcapturesReady.length] + exact hcapturesUnder + have hgotLe : got.toList.length ≤ arity := + Nat.le_of_lt hgotUnder + have hoverLength : arity < total.length := by omega + let missing := arity - got.toList.length + have hmissingPositive : 0 < missing := by + simp only [missing] + omega + have hmissingLe : missing ≤ args.length := by + simp only [total, List.length_append] at hoverLength + simp only [missing] + omega + have htakeTotal : total.take arity = + got.toList ++ args.take missing := by + rw [List.take_append] + rw [List.take_of_length_le hgotLe] + have hdropTotal : total.drop arity = args.drop missing := by + rw [List.drop_append] + rw [List.drop_eq_nil_of_le hgotLe] + rfl + have htotalPrefix : + (got.toList ++ args.take missing).length = arity := by + rw [← htakeTotal] + simp [List.length_take, Nat.min_eq_left + (Nat.le_of_lt hoverLength)] + obtain ⟨middleSource, hprefixApply, htailApply⟩ := + happlies.splitAt missing + have hprefixGraph := hargsReady.take missing + have htailGraph := hargsReady.drop missing + have htailRuntimeNonempty : args.drop missing ≠ [] := by + intro hnil + have hzero := congrArg List.length hnil + simp only [List.length_drop, List.length_nil] at hzero + simp only [total, List.length_append] at hoverLength + omega + have htailSourceNonempty : sourceArgs.drop missing ≠ [] := by + intro hnil + apply htailRuntimeNonempty + apply List.eq_nil_of_length_eq_zero + simpa [hnil] using htailGraph.length.symm + let tailSourceRest : List (Owned × IxIR0.Value) := + (sourceArgs.drop missing).map + (fun source => (.shared, source)) + let tailRoots : List Root := + rootsFor .shared (args.drop missing) + have htailWorld : ∀ runtime, + runtime ∈ args.drop missing → + HasWorld readyStore .shared runtime := by + intro runtime hmember + apply hready.roots_world ⟨.shared, runtime⟩ + apply List.mem_append_left rest + have hmemberArgs : runtime ∈ args := + List.mem_of_mem_drop hmember + have hmemberTotal : runtime ∈ total := by + exact List.mem_append_right got.toList hmemberArgs + simpa [total, rootsFor] using hmemberTotal + have htailFrame : Sim.RootsGraph + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) + finalState) + readyStore tailSourceRest tailRoots := by + exact htailGraph.rootsGraph .shared htailWorld + have hcombinedFrame : Sim.RootsGraph + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) + finalState) + readyStore (tailSourceRest ++ sourceRest) + (tailRoots ++ rest) := + htailFrame.append hframeReady + have hrootsSplit : rootsFor .shared total = + rootsFor .shared (total.take arity) ++ + rootsFor .shared (total.drop arity) := by + unfold rootsFor + rw [← List.map_append] + exact congrArg _ (List.take_append_drop arity total).symm + have hpartition : RootOwnership readyStore + (rootsFor .shared (got.toList ++ args.take missing) ++ + (tailRoots ++ rest)) := by + have hsplit := hready + rw [hrootsSplit] at hsplit + rw [htakeTotal, hdropTotal] at hsplit + simpa [tailRoots, List.append_assoc] using hsplit + obtain ⟨invokeFuel, calledStore, calledValue, hinvoke, + hcalledGraph, hcombinedAfter, hcalledOwn⟩ := + invoke_compilerFunction_value_trace_progress_within_below + henv hlower htarget hrepresented hcontracts hvalues + hprogress hrel hcapturesReady hprefixGraph hprefixApply + hcombinedFrame hpartition htotalPrefix + have htailLength : tailSourceRest.length = tailRoots.length := by + simp [tailSourceRest, tailRoots, rootsFor, hargsReady.length] + obtain ⟨htailFrameAfter, hframeAfter⟩ := + hcombinedAfter.splitAppend htailLength + have htailGraphAfter : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) + finalState) + calledStore (sourceArgs.drop missing) + (args.drop missing) := + htailFrameAfter.valuesGraph + have htailLengthLt : (args.drop missing).length < argLength := by + rw [← hargsLength] + simp only [List.length_drop] + omega + obtain ⟨recursiveFuel, store', value, hrecursive⟩ := + ih (args.drop missing).length htailLengthLt rfl + hcalledGraph htailGraphAfter htailApply + htailSourceNonempty hframeAfter hcalledOwn + let commonFuel := max dropFuel (max invokeFuel recursiveFuel) + have hdrop' : dropVal ctx commonFuel dupStore (.loc loc) = + .ok readyStore := + dropVal_mono (by + exact Nat.le_max_left dropFuel (max invokeFuel recursiveFuel)) + hdrop + have hinvokeBase : invoke ctx invokeFuel address + (total.take arity) readyStore = + .ok (calledStore, calledValue) := by + rw [htakeTotal] + exact hinvoke + have hinvoke' : invoke ctx commonFuel address + (total.take arity) readyStore = + .ok (calledStore, calledValue) := + invoke_mono (by + exact Nat.le_trans + (Nat.le_max_left invokeFuel recursiveFuel) + (Nat.le_max_right dropFuel + (max invokeFuel recursiveFuel))) hinvokeBase + have hrecursiveBase : applyGo ctx recursiveFuel calledStore + calledValue (total.drop arity) = .ok (store', value) := by + rw [hdropTotal] + exact hrecursive + have hrecursive' : applyGo ctx commonFuel calledStore calledValue + (total.drop arity) = .ok (store', value) := + applyGo_mono (by + exact Nat.le_trans + (Nat.le_max_right invokeFuel recursiveFuel) + (Nat.le_max_right dropFuel + (max invokeFuel recursiveFuel))) hrecursiveBase + have hunder' : ¬(got.toList ++ args).length < arity := by + simpa [total] using hunder + have hexact' : (got.toList ++ args).length ≠ arity := by + simpa [total] using hexact + refine ⟨commonFuel + 1, store', value, ?_⟩ + rw [applyGo.eq_def] + dsimp only + rw [hget] + dsimp only + rw [hdup, bindOk, hdrop', bindOk] + rw [if_neg hunder'] + have hbeq : ((got.toList ++ args).length == arity) = false := by + rw [beq_eq_false_iff_ne] + exact hexact' + rw [hbeq] + simp only [Bool.false_eq_true, if_false] + rw [hdeclaration] + simp only [hpapsafe, ↓reduceIte] + rw [hinvoke', bindOk] + exact hrecursive' + intro store function args sourceFunction sourceArgs sourceResult + sourceRest rest hfunction hargs happlies hsourceArgsNonempty hframe hown + exact go args.length rfl hfunction hargs happlies hsourceArgsNonempty + hframe hown + +/-- The exact whole-pass output supplies both mutually recursive callable +progress families. The strong source-fuel fixed point is closed from +strictly smaller declaration/application contracts; scalar-oracle +termination remains the explicit external boundary. -/ +theorem lowerAllAction_compilerTraceProgressContracts + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htarget : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hextern : ExternTraceProgressContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx) : + CompilerTraceProgressContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx := by + apply compilerTraceProgressContracts_of_below_step hextern + intro sourceLimit hbelow + exact ⟨ + lowerAllAction_sourceFnTraceProgressesAt_within_below + henv hlower htarget hrepresented hcontracts hvalues hbelow, + lowerAllAction_applyValueTraceProgressesAt_within_below + henv hlower htarget hrepresented hcontracts hvalues hbelow⟩ + +/-- A successfully compiled and source-terminating whole main reaches a +non-memory terminal target observation. Declaration/application progress is +kept as an explicit semantic boundary; ownership and value contracts supply +the graph invariant used by the settling compiler induction. -/ +theorem lowerAllAction_main_settlement + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} {sourceFuel : Nat} {sourceValue : IxIR0.Value} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hsource : IxIR0.eval sourceCtx sourceFuel [] main = .ok sourceValue) : + ∃ targetFuel, + SettlesWithoutMemory (runMain ctx mainCode targetFuel) := by + obtain ⟨mainInitial, hmain⟩ := lowerAllAction_main_trace hlower + cases compilerFuel with + | zero => + simp only [lowerFnBody] at hmain + exact (trackedThrowRun_not_ok hmain).elim + | succ bodyFuel => + simp only [lowerFnBody] at hmain + obtain ⟨releaseResult, releaseState, hrelease, hafterRelease⟩ := + trackedBindRun_ok_inv hmain + rcases releaseResult with ⟨middle, releaseEmit⟩ + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + trackedBindRun_ok_inv hafterRelease + rcases bodyResult with ⟨output, emit, av⟩ + have hpure : + (releaseEmit ∘ emit) (.ret (av.toAtom output)) = mainCode ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨hcode, hbodyState⟩ := hpure + subst bodyState + let input : VEnv := ⟨[], 0⟩ + have hplan : ReleasePlan input [] input (_root_.id : Emit) := .nil + have hplanRun : (releaseSlots input []).run mainInitial = + .ok (input, (_root_.id : Emit)) mainInitial := + hplan.run mainInitial + have heq : + (input, (_root_.id : Emit)) = (middle, releaseEmit) ∧ + mainInitial = releaseState := by + simpa [input] using hplanRun.symm.trans hrelease + have hmiddle : input = middle := congrArg Prod.fst heq.1 + have hemitting : (_root_.id : Emit) = releaseEmit := + congrArg Prod.snd heq.1 + subst middle + subst releaseEmit + cases heq.2 + let cur : FnDef := ⟨0, .shared, false, mainCode⟩ + have hbodySettles : LowerResultValueSettlement + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + (fun _ _ => False) ctx cur input output [] [] sourceValue + mainWorld emit av := + (lowerValueSettlementClusterWithin + (recSelfRel := fun _ _ => False) (cur := cur) henv hrepresented + hcontracts hvalues hprogress bodyFuel).expr hsource hbodyRun + (ExtraExtends.refl _) + (SelfProgressAvailable.of_noRecSelf (by + intro index arity hentry + simp [input] at hentry)) + have hpre : GraphOwnsVEnv + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + (fun _ _ => False) input [] [] [] ({} : Store) [] := by + refine ⟨[], ?_, Sim.RootsGraph.nil, RootOwnership.empty⟩ + exact ⟨by simp [input], EntriesValueGraph.nil⟩ + obtain ⟨targetFuel, htarget⟩ := + hbodySettles.closeSettlement [] [] hpre + refine ⟨targetFuel, ?_⟩ + unfold runMain + change SettlesWithoutMemory + (runCode ctx targetFuel cur ({} : Store) [] mainCode) + rw [← hcode] + simpa [Function.comp_def] using htarget + +/-- A successfully compiled projection-safe whole main reaches a concrete +target value. -/ +theorem lowerAllAction_main_progress_of_projectionSafe + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} {sourceValue : IxIR0.Value} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hsource : ProjectionSafeEval sourceCtx [] main sourceValue) : + ∃ targetFuel store value, + runMain ctx mainCode targetFuel = .ok (store, value) := by + obtain ⟨mainInitial, hmain⟩ := lowerAllAction_main_trace hlower + cases compilerFuel with + | zero => + simp only [lowerFnBody] at hmain + exact (trackedThrowRun_not_ok hmain).elim + | succ bodyFuel => + simp only [lowerFnBody] at hmain + obtain ⟨releaseResult, releaseState, hrelease, hafterRelease⟩ := + trackedBindRun_ok_inv hmain + rcases releaseResult with ⟨middle, releaseEmit⟩ + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + trackedBindRun_ok_inv hafterRelease + rcases bodyResult with ⟨output, emit, av⟩ + have hpure : + (releaseEmit ∘ emit) (.ret (av.toAtom output)) = mainCode ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨hcode, hbodyState⟩ := hpure + subst bodyState + let input : VEnv := ⟨[], 0⟩ + have hplan : ReleasePlan input [] input (_root_.id : Emit) := .nil + have hplanRun : (releaseSlots input []).run mainInitial = + .ok (input, (_root_.id : Emit)) mainInitial := + hplan.run mainInitial + have heq : + (input, (_root_.id : Emit)) = (middle, releaseEmit) ∧ + mainInitial = releaseState := by + simpa [input] using hplanRun.symm.trans hrelease + have hmiddle : input = middle := congrArg Prod.fst heq.1 + have hemitting : (_root_.id : Emit) = releaseEmit := + congrArg Prod.snd heq.1 + subst middle + subst releaseEmit + cases heq.2 + let cur : FnDef := ⟨0, .shared, false, mainCode⟩ + have hbodyProgress : LowerResultValueProgress + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + (fun _ _ => False) ctx cur input output [] [] sourceValue + mainWorld emit av := + (lowerValueProgressSafeClusterWithin + (recSelfRel := fun _ _ => False) (cur := cur) henv hrepresented + hcontracts hvalues hprogress bodyFuel).expr hsource hbodyRun + (ExtraExtends.refl _) + (SelfProgressAvailable.of_noRecSelf (by + intro index arity hentry + simp [input] at hentry)) + have hpre : GraphOwnsVEnv + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + (fun _ _ => False) input [] [] [] ({} : Store) [] := by + refine ⟨[], ?_, Sim.RootsGraph.nil, RootOwnership.empty⟩ + exact ⟨by simp [input], EntriesValueGraph.nil⟩ + obtain ⟨targetFuel, store, value, htarget⟩ := + hbodyProgress.closeProgress [] [] hpre + refine ⟨targetFuel, store, value, ?_⟩ + unfold runMain + change runCode ctx targetFuel cur ({} : Store) [] mainCode = + .ok (store, value) + rw [← hcode] + simpa [Function.comp_def] using htarget + +/-- A successfully compiled main with an exact source trace below `limit` +reaches a concrete target value using only trace-progress contracts below +that same limit. -/ +theorem lowerAllAction_main_progress_of_trace_below + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel limit sourceFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} {sourceValue : IxIR0.Value} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hprogress : CompilerTraceProgressContractsBelow + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx limit) + (hsourceBound : sourceFuel < limit) + (hsource : IxIR0.ProjectionSafe.Eval sourceCtx sourceFuel [] main + sourceValue) : + ∃ targetFuel store value, + runMain ctx mainCode targetFuel = .ok (store, value) := by + obtain ⟨mainInitial, hmain⟩ := lowerAllAction_main_trace hlower + cases compilerFuel with + | zero => + simp only [lowerFnBody] at hmain + exact (trackedThrowRun_not_ok hmain).elim + | succ bodyFuel => + simp only [lowerFnBody] at hmain + obtain ⟨releaseResult, releaseState, hrelease, hafterRelease⟩ := + trackedBindRun_ok_inv hmain + rcases releaseResult with ⟨middle, releaseEmit⟩ + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + trackedBindRun_ok_inv hafterRelease + rcases bodyResult with ⟨output, emit, av⟩ + have hpure : + (releaseEmit ∘ emit) (.ret (av.toAtom output)) = mainCode ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨hcode, hbodyState⟩ := hpure + subst bodyState + let input : VEnv := ⟨[], 0⟩ + have hplan : ReleasePlan input [] input (_root_.id : Emit) := .nil + have hplanRun : (releaseSlots input []).run mainInitial = + .ok (input, (_root_.id : Emit)) mainInitial := + hplan.run mainInitial + have heq : + (input, (_root_.id : Emit)) = (middle, releaseEmit) ∧ + mainInitial = releaseState := by + simpa [input] using hplanRun.symm.trans hrelease + have hmiddle : input = middle := congrArg Prod.fst heq.1 + have hemitting : (_root_.id : Emit) = releaseEmit := + congrArg Prod.snd heq.1 + subst middle + subst releaseEmit + cases heq.2 + let cur : FnDef := ⟨0, .shared, false, mainCode⟩ + have hbodyProgress : LowerResultValueProgress + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + (fun _ _ => False) ctx cur input output [] [] sourceValue + mainWorld emit av := + (lowerValueTraceProgressClusterWithinBelow + (recSelfRel := fun _ _ => False) (cur := cur) henv hrepresented + hcontracts hvalues hprogress bodyFuel).expr hsourceBound hsource + hbodyRun (ExtraExtends.refl _) + (SelfTraceProgressAvailableBelow.of_noRecSelf (by + intro index arity hentry + simp [input] at hentry)) + have hpre : GraphOwnsVEnv + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + (fun _ _ => False) input [] [] [] ({} : Store) [] := by + refine ⟨[], ?_, Sim.RootsGraph.nil, RootOwnership.empty⟩ + exact ⟨by simp [input], EntriesValueGraph.nil⟩ + obtain ⟨targetFuel, store, value, htarget⟩ := + hbodyProgress.closeProgress [] [] hpre + refine ⟨targetFuel, store, value, ?_⟩ + unfold runMain + change runCode ctx targetFuel cur ({} : Store) [] mainCode = + .ok (store, value) + rw [← hcode] + simpa [Function.comp_def] using htarget + +/-- Unbounded exact-trace whole-main progress assembled pointwise from a +full trace-progress contract. -/ +theorem lowerAllAction_main_progress_of_trace + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel sourceFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} {sourceValue : IxIR0.Value} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hprogress : CompilerTraceProgressContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hsource : IxIR0.ProjectionSafe.Eval sourceCtx sourceFuel [] main + sourceValue) : + ∃ targetFuel store value, + runMain ctx mainCode targetFuel = .ok (store, value) := + lowerAllAction_main_progress_of_trace_below (limit := sourceFuel + 1) + henv hlower hrepresented hcontracts hvalues + (hprogress.below (sourceFuel + 1)) (Nat.lt_succ_self sourceFuel) hsource + +/-- Whole-main progress with every internal semantic and trace-progress +contract reconstructed from the exact compiler output. Only the two scalar +extern boundaries remain explicit: value compatibility and termination. -/ +theorem lowerAllAction_main_progress_of_trace_sealed + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel sourceFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} {sourceValue : IxIR0.Value} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htarget : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hexternValue : ExternValueContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx) + (hexternProgress : ExternTraceProgressContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx) + (hsource : IxIR0.ProjectionSafe.Eval sourceCtx sourceFuel [] main + sourceValue) : + ∃ targetFuel store value, + runMain ctx mainCode targetFuel = .ok (store, value) := by + have hvalues := lowerAllAction_compilerValueContracts + henv hlower htarget hrepresented hcontracts hexternValue + have hprogress := lowerAllAction_compilerTraceProgressContracts + henv hlower htarget hrepresented hcontracts hvalues hexternProgress + exact lowerAllAction_main_progress_of_trace henv hlower hrepresented + hcontracts hvalues hprogress hsource + +/-- End-to-end target progress for the executable validator's exact erased +main. Callable progress is derived from the full call-aware certificate and +the concrete whole-pass provenance, rather than accepted as a monolithic +compiler-progress premise. -/ +theorem lowerAllAction_main_progress_of_certificate_sealed + {ectx : Ixon.Eval.EvalCtx} {frame : Ixon.Eval.Frame} + {source : Ixon.Expr} {sourceFuel eraseFuel : Nat} + {sourceValue : Ixon.Eval.Value} {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (cert : Ix.Compiler.EraseValidator.CertifiedSharedExpr ectx sourceCtx + none (Ix.Compiler.EraseValidator.tablesOfFrame frame) + frame.selfAddr [] eraseFuel source) + (hstrict : ectx.Strict) + (horacles : Ix.Compiler.Sim.OracleRel ectx.inlineSharing sourceCtx) + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hctx : ectx.SharingWF) (hframe : frame.SharingWF) + (hbelow : Ixon.Sharing.sharesBelow frame.sharing.size source = true) + (hsource : Ixon.Eval.eval ectx sourceFuel frame [] source = + .ok sourceValue) + (hlower : + (lowerAllAction decls cert.target mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htarget : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hexternValue : ExternValueContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx) + (hexternProgress : ExternTraceProgressContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx) : + ∃ targetFuel store value, + runMain ctx mainCode targetFuel = .ok (store, value) := by + obtain ⟨targetFuel, targetValue, htrace, _⟩ := + CallAwareProjectionSafe.of_certifiedSharedClosed cert hstrict horacles hctx + hframe hbelow hsource + exact lowerAllAction_main_progress_of_trace_sealed henv hlower htarget + hrepresented hcontracts hexternValue hexternProgress htrace + +/-- One successful top-level run excludes ordinary stuckness at every fuel: +success and non-fuel errors both persist upward, so either fuel ordering gives +a contradiction. -/ +theorem ordinaryStuckUnreachable_of_progress + {ctx : Ctx} {code : Code} + (hprogress : ∃ fuel store value, + runMain ctx code fuel = .ok (store, value)) : + OrdinaryStuckUnreachable ctx code := by + obtain ⟨successFuel, store, value, hsuccess⟩ := hprogress + intro fuel message hstuck + by_cases hle : successFuel ≤ fuel + · have hsuccess' := runMain_mono hle hsuccess + rw [hstuck] at hsuccess' + contradiction + · have hsmall : fuel ≤ successFuel := + Nat.le_of_lt (Nat.lt_of_not_ge hle) + have hstuck' := runMain_stuck_mono hsmall hstuck + rw [hsuccess] at hstuck' + contradiction + +/-- Projection-safe source evaluation discharges the whole target's +ordinary-stuck exclusion, not merely the witnessed run. -/ +theorem lowerAllAction_ordinaryStuckUnreachable_of_projectionSafe + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} {sourceValue : IxIR0.Value} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hsource : ProjectionSafeEval sourceCtx [] main sourceValue) : + OrdinaryStuckUnreachable ctx mainCode := + ordinaryStuckUnreachable_of_progress + (lowerAllAction_main_progress_of_projectionSafe henv hlower + hrepresented hcontracts hvalues hprogress hsource) + +/-- Proof-producing erasure turns a successful closed Ixon evaluation into +the projection-safe witness required to exclude ordinary stuckness after +lowering. -/ +theorem lowerAllAction_ordinaryStuckUnreachable_of_erasure + {ectx : Ixon.Eval.EvalCtx} {frame : Ixon.Eval.Frame} + {source : Ixon.Expr} {sourceFuel : Nat} + {sourceValue : Ixon.Eval.Value} {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (hstrict : ectx.Strict) + (horacles : Ix.Compiler.Sim.OracleRel ectx sourceCtx) + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hsource : Ixon.Eval.eval ectx sourceFuel frame [] source = + .ok sourceValue) + (herases : Ix.Compiler.Sim.PErase ectx sourceCtx none frame.refs + frame.selfMuts frame.selfAddr [] source main) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) : + OrdinaryStuckUnreachable ctx mainCode := by + obtain ⟨targetValue, hsafe, hrel⟩ := + ProjectionSafeEval.of_erasure_closed hstrict horacles hsource herases + exact lowerAllAction_ordinaryStuckUnreachable_of_projectionSafe henv + hlower hrepresented hcontracts hvalues hprogress hsafe + +/-- Sharing-aware proof-producing erasure excludes ordinary stuckness for +the exact erased main compiled by the lowering pass. -/ +theorem lowerAllAction_ordinaryStuckUnreachable_of_erasure_inlineSharing + {ectx : Ixon.Eval.EvalCtx} {frame : Ixon.Eval.Frame} + {source : Ixon.Expr} {sourceFuel : Nat} + {sourceValue : Ixon.Eval.Value} {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (hstrict : ectx.Strict) + (horacles : Ix.Compiler.Sim.OracleRel ectx.inlineSharing sourceCtx) + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hctx : ectx.SharingWF) (hframe : frame.SharingWF) + (hbelow : Ixon.Sharing.sharesBelow frame.sharing.size source = true) + (hsource : Ixon.Eval.eval ectx sourceFuel frame [] source = + .ok sourceValue) + (herases : Ix.Compiler.Sim.PErase ectx.inlineSharing sourceCtx none + frame.inlineSharing.refs frame.inlineSharing.selfMuts + frame.inlineSharing.selfAddr [] + (Ixon.Sharing.inlineExpr frame.sharing source) main) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) : + OrdinaryStuckUnreachable ctx mainCode := by + obtain ⟨targetValue, hsafe, hrel⟩ := + ProjectionSafeEval.of_erasure_inlineSharing_closed hstrict horacles hctx + hframe hbelow hsource herases + exact lowerAllAction_ordinaryStuckUnreachable_of_projectionSafe henv + hlower hrepresented hcontracts hvalues hprogress hsafe + + +/-! ## Public target-safety closure -/ + +/-- Fuel-or-success safety excludes every concrete non-fuel evaluator +error. -/ +theorem succeedsOrFuel_ne_error {alpha : Type} {result : Except Err alpha} + (hsafe : SucceedsOrFuel result) {error : Err} + (hne : error ≠ .fuel) : result ≠ .error error := by + intro herror + cases hsafe with + | inl hfuel => + rw [herror] at hfuel + exact hne (Except.error.inj hfuel) + | inr hsuccess => + obtain ⟨value, hvalue⟩ := hsuccess + rw [herror] at hvalue + contradiction + +/-- The roadmap's public memory-safety proposition follows immediately once +the whole compiled main has fuel-or-success safety at every approximation. -/ +theorem memoryErrorUnreachable_of_succeedsOrFuel + {ctx : Ctx} {code : Code} + (hsafe : ∀ fuel, SucceedsOrFuel (runMain ctx code fuel)) : + MemoryErrorUnreachable ctx code := by + intro fuel message + exact succeedsOrFuel_ne_error (hsafe fuel) (by simp) + +/-- One closed non-memory terminal observation excludes dynamic memory +errors at every fuel. At greater fuel the observation persists; at lesser +fuel a hypothetical memory error would persist up to the terminal +observation. -/ +theorem memoryErrorUnreachable_of_settlement + {ctx : Ctx} {code : Code} + (hsettles : ∃ fuel, SettlesWithoutMemory (runMain ctx code fuel)) : + MemoryErrorUnreachable ctx code := by + intro fuel message hmemory + obtain ⟨terminalFuel, hterminal⟩ := hsettles + by_cases hle : terminalFuel ≤ fuel + · cases hterminal with + | success value hsuccess => + have hsuccess' := runMain_mono hle hsuccess + rw [hmemory] at hsuccess' + cases hsuccess' + | stuck stuckMessage hstuck => + have hstuck' := runMain_stuck_mono hle hstuck + rw [hmemory] at hstuck' + cases hstuck' + · have hsmall : fuel ≤ terminalFuel := + Nat.le_of_lt (Nat.lt_of_not_ge hle) + have hmemory' := runMain_mem_mono hsmall hmemory + cases hterminal with + | success value hsuccess => + rw [hsuccess] at hmemory' + cases hmemory' + | stuck stuckMessage hstuck => + rw [hstuck] at hmemory' + cases hmemory' + +/-- One closed non-memory terminal observation also excludes unresolved +declaration or oracle lookups at every fuel. This extracts the closed-world +content already present in the source-guided call and extern contracts. -/ +theorem unknownRefUnreachable_of_settlement + {ctx : Ctx} {code : Code} + (hsettles : ∃ fuel, SettlesWithoutMemory (runMain ctx code fuel)) : + UnknownRefUnreachable ctx code := by + intro fuel address hunknown + obtain ⟨terminalFuel, hterminal⟩ := hsettles + by_cases hle : terminalFuel ≤ fuel + · cases hterminal with + | success value hsuccess => + have hsuccess' := runMain_mono hle hsuccess + rw [hunknown] at hsuccess' + cases hsuccess' + | stuck message hstuck => + have hstuck' := runMain_stuck_mono hle hstuck + rw [hunknown] at hstuck' + cases hstuck' + · have hsmall : fuel ≤ terminalFuel := + Nat.le_of_lt (Nat.lt_of_not_ge hle) + have hunknown' := runMain_unknownRef_mono hsmall hunknown + cases hterminal with + | success value hsuccess => + rw [hsuccess] at hunknown' + cases hunknown' + | stuck message hstuck => + rw [hstuck] at hunknown' + cases hunknown' + +/-- Settlement becomes genuine target progress exactly when its one admitted +non-success terminal class, ordinary stuckness, is excluded. Closed-world +lookup failure has already been ruled out by the settlement construction. -/ +theorem targetProgress_of_settlement + {ctx : Ctx} {code : Code} + (hsettles : ∃ fuel, SettlesWithoutMemory (runMain ctx code fuel)) + (hstuck : OrdinaryStuckUnreachable ctx code) : + ∃ fuel store value, + runMain ctx code fuel = .ok (store, value) := by + obtain ⟨fuel, hterminal⟩ := hsettles + cases hterminal with + | success result hrun => + exact ⟨fuel, result.1, result.2, hrun⟩ + | stuck message hrun => + exact (hstuck fuel message hrun).elim + +/-- The three independent error-exclusion contracts recover the stronger +all-fuel progress classification without conflating their proofs. -/ +theorem succeedsOrFuel_of_error_exclusions + {ctx : Ctx} {code : Code} + (hmemory : MemoryErrorUnreachable ctx code) + (hstuck : OrdinaryStuckUnreachable ctx code) + (hunknown : UnknownRefUnreachable ctx code) : + ∀ fuel, SucceedsOrFuel (runMain ctx code fuel) := by + intro fuel + cases hrun : runMain ctx code fuel with + | ok result => exact Or.inr ⟨result, rfl⟩ + | error error => + cases error with + | fuel => exact Or.inl rfl + | stuck message => exact (hstuck fuel message hrun).elim + | mem message => exact (hmemory fuel message hrun).elim + | unknownRef address => exact (hunknown fuel address hrun).elim + +/-- Generic whole-pass memory safety from the independent ownership, value, +and source-guided progress contract packages. -/ +theorem lowerAllAction_memoryErrorUnreachable + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} {sourceFuel : Nat} {sourceValue : IxIR0.Value} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hsource : IxIR0.eval sourceCtx sourceFuel [] main = .ok sourceValue) : + MemoryErrorUnreachable ctx mainCode := + memoryErrorUnreachable_of_settlement + (lowerAllAction_main_settlement henv hlower hrepresented hcontracts + hvalues hprogress hsource) + +/-- Generic whole-pass closed-world safety from the same independently +auditable ownership, value, and source-guided progress contracts. -/ +theorem lowerAllAction_unknownRefUnreachable + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} {sourceFuel : Nat} {sourceValue : IxIR0.Value} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hsource : IxIR0.eval sourceCtx sourceFuel [] main = .ok sourceValue) : + UnknownRefUnreachable ctx mainCode := + unknownRefUnreachable_of_settlement + (lowerAllAction_main_settlement henv hlower hrepresented hcontracts + hvalues hprogress hsource) + +/-- Whole-pass memory safety with semantic value contracts reconstructed +from the actual compiler output. Only the explicit extern-value boundary +and source-guided target-progress package remain semantic premises. -/ +theorem lowerAllAction_memoryErrorUnreachable_sealed + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} {sourceFuel : Nat} {sourceValue : IxIR0.Value} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htargetDecls : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hextern : ExternValueContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hsource : IxIR0.eval sourceCtx sourceFuel [] main = .ok sourceValue) : + MemoryErrorUnreachable ctx mainCode := by + have hvalues := lowerAllAction_compilerValueContracts + henv hlower htargetDecls hrepresented hcontracts hextern + exact lowerAllAction_memoryErrorUnreachable henv hlower hrepresented + hcontracts hvalues hprogress hsource + +/-- Whole-pass closed-world safety with semantic value contracts reconstructed +from the actual compiler output. As for memory safety, the remaining +semantic premises are the extern-value and source-guided progress packages. -/ +theorem lowerAllAction_unknownRefUnreachable_sealed + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} {sourceFuel : Nat} {sourceValue : IxIR0.Value} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htargetDecls : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hextern : ExternValueContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hsource : IxIR0.eval sourceCtx sourceFuel [] main = .ok sourceValue) : + UnknownRefUnreachable ctx mainCode := by + have hvalues := lowerAllAction_compilerValueContracts + henv hlower htargetDecls hrepresented hcontracts hextern + exact lowerAllAction_unknownRefUnreachable henv hlower hrepresented + hcontracts hvalues hprogress hsource + +/-- Whole-pass ordinary-stuck exclusion with semantic value contracts +reconstructed from the actual compiler output. -/ +theorem lowerAllAction_ordinaryStuckUnreachable_of_projectionSafe_sealed + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} {sourceValue : IxIR0.Value} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htargetDecls : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hextern : ExternValueContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hsource : ProjectionSafeEval sourceCtx [] main sourceValue) : + OrdinaryStuckUnreachable ctx mainCode := by + have hvalues := lowerAllAction_compilerValueContracts + henv hlower htargetDecls hrepresented hcontracts hextern + exact lowerAllAction_ordinaryStuckUnreachable_of_projectionSafe henv + hlower hrepresented hcontracts hvalues hprogress hsource + +/-- Sealed proof-producing-erasure route to ordinary-stuck exclusion. -/ +theorem lowerAllAction_ordinaryStuckUnreachable_of_erasure_sealed + {ectx : Ixon.Eval.EvalCtx} {frame : Ixon.Eval.Frame} + {source : Ixon.Expr} {sourceFuel : Nat} + {sourceValue : Ixon.Eval.Value} {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (hstrict : ectx.Strict) + (horacles : Ix.Compiler.Sim.OracleRel ectx sourceCtx) + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hsource : Ixon.Eval.eval ectx sourceFuel frame [] source = + .ok sourceValue) + (herases : Ix.Compiler.Sim.PErase ectx sourceCtx none frame.refs + frame.selfMuts frame.selfAddr [] source main) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htargetDecls : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hextern : ExternValueContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) : + OrdinaryStuckUnreachable ctx mainCode := by + obtain ⟨targetValue, hsafe, hrel⟩ := + ProjectionSafeEval.of_erasure_closed hstrict horacles hsource herases + exact lowerAllAction_ordinaryStuckUnreachable_of_projectionSafe_sealed + henv hlower htargetDecls hrepresented hcontracts hextern hprogress hsafe + +/-- Sealed sharing-aware proof-producing-erasure route to ordinary-stuck +exclusion. -/ +theorem + lowerAllAction_ordinaryStuckUnreachable_of_erasure_inlineSharing_sealed + {ectx : Ixon.Eval.EvalCtx} {frame : Ixon.Eval.Frame} + {source : Ixon.Expr} {sourceFuel : Nat} + {sourceValue : Ixon.Eval.Value} {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (hstrict : ectx.Strict) + (horacles : Ix.Compiler.Sim.OracleRel ectx.inlineSharing sourceCtx) + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hctx : ectx.SharingWF) (hframe : frame.SharingWF) + (hbelow : Ixon.Sharing.sharesBelow frame.sharing.size source = true) + (hsource : Ixon.Eval.eval ectx sourceFuel frame [] source = + .ok sourceValue) + (herases : Ix.Compiler.Sim.PErase ectx.inlineSharing sourceCtx none + frame.inlineSharing.refs frame.inlineSharing.selfMuts + frame.inlineSharing.selfAddr [] + (Ixon.Sharing.inlineExpr frame.sharing source) main) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htargetDecls : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hextern : ExternValueContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) : + OrdinaryStuckUnreachable ctx mainCode := by + obtain ⟨targetValue, hsafe, hrel⟩ := + ProjectionSafeEval.of_erasure_inlineSharing_closed hstrict horacles hctx + hframe hbelow hsource herases + exact lowerAllAction_ordinaryStuckUnreachable_of_projectionSafe_sealed + henv hlower htargetDecls hrepresented hcontracts hextern hprogress hsafe + +/-- Public semantic forward simulation from settlement and the remaining +ordinary-stuck admissibility boundary. Memory and closed-world failures are +already excluded by settlement and remain available as separate whole-pass +theorems above. -/ +theorem lowerAllAction_semanticForwardSimulation_of_admissibility_sealed + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htargetDecls : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hextern : ExternValueContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hstuck : OrdinaryStuckUnreachable ctx mainCode) : + SemanticForwardSimulation sourceCtx ctx main mainCode + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) + finalState) := by + have hvalues := lowerAllAction_compilerValueContracts + henv hlower htargetDecls hrepresented hcontracts hextern + apply lowerAllAction_semanticForwardSimulation_of_targetProgress + henv hlower hrepresented hcontracts hvalues + intro sourceFuel sourceValue hsource + obtain ⟨fuel, store, value, hrun⟩ := targetProgress_of_settlement + (lowerAllAction_main_settlement henv hlower hrepresented hcontracts + hvalues hprogress hsource) + hstuck + exact ⟨fuel, store, value, hrun⟩ + +/-- Projection-safe source execution removes the final admissibility premise +from the sealed semantic forward-simulation theorem. -/ +theorem lowerAllAction_semanticForwardSimulation_of_projectionSafe_sealed + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} {sourceValue : IxIR0.Value} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htargetDecls : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hextern : ExternValueContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hsource : ProjectionSafeEval sourceCtx [] main sourceValue) : + SemanticForwardSimulation sourceCtx ctx main mainCode + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) + finalState) := by + apply lowerAllAction_semanticForwardSimulation_of_admissibility_sealed + henv hlower htargetDecls hrepresented hcontracts hextern hprogress + exact lowerAllAction_ordinaryStuckUnreachable_of_projectionSafe_sealed + henv hlower htargetDecls hrepresented hcontracts hextern hprogress + hsource + +/-- Proof-producing erasure removes the ordinary-stuck premise from sealed +semantic forward simulation. -/ +theorem lowerAllAction_semanticForwardSimulation_of_erasure_sealed + {ectx : Ixon.Eval.EvalCtx} {frame : Ixon.Eval.Frame} + {source : Ixon.Expr} {sourceFuel : Nat} + {sourceValue : Ixon.Eval.Value} {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (hstrict : ectx.Strict) + (horacles : Ix.Compiler.Sim.OracleRel ectx sourceCtx) + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hsource : Ixon.Eval.eval ectx sourceFuel frame [] source = + .ok sourceValue) + (herases : Ix.Compiler.Sim.PErase ectx sourceCtx none frame.refs + frame.selfMuts frame.selfAddr [] source main) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htargetDecls : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hextern : ExternValueContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) : + SemanticForwardSimulation sourceCtx ctx main mainCode + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) + finalState) := by + obtain ⟨targetValue, hsafe, hrel⟩ := + ProjectionSafeEval.of_erasure_closed hstrict horacles hsource herases + exact lowerAllAction_semanticForwardSimulation_of_projectionSafe_sealed + henv hlower htargetDecls hrepresented hcontracts hextern hprogress hsafe + +/-- Sharing-aware proof-producing erasure removes the ordinary-stuck premise +from sealed semantic forward simulation. -/ +theorem + lowerAllAction_semanticForwardSimulation_of_erasure_inlineSharing_sealed + {ectx : Ixon.Eval.EvalCtx} {frame : Ixon.Eval.Frame} + {source : Ixon.Expr} {sourceFuel : Nat} + {sourceValue : Ixon.Eval.Value} {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (hstrict : ectx.Strict) + (horacles : Ix.Compiler.Sim.OracleRel ectx.inlineSharing sourceCtx) + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hctx : ectx.SharingWF) (hframe : frame.SharingWF) + (hbelow : Ixon.Sharing.sharesBelow frame.sharing.size source = true) + (hsource : Ixon.Eval.eval ectx sourceFuel frame [] source = + .ok sourceValue) + (herases : Ix.Compiler.Sim.PErase ectx.inlineSharing sourceCtx none + frame.inlineSharing.refs frame.inlineSharing.selfMuts + frame.inlineSharing.selfAddr [] + (Ixon.Sharing.inlineExpr frame.sharing source) main) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htargetDecls : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hextern : ExternValueContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) : + SemanticForwardSimulation sourceCtx ctx main mainCode + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) + finalState) := by + obtain ⟨targetValue, hsafe, hrel⟩ := + ProjectionSafeEval.of_erasure_inlineSharing_closed hstrict horacles hctx + hframe hbelow hsource herases + exact lowerAllAction_semanticForwardSimulation_of_projectionSafe_sealed + henv hlower htargetDecls hrepresented hcontracts hextern hprogress hsafe + +/-- The executable validator's exact closed target excludes ordinary +stuckness after whole-pass lowering. This certificate-level boundary prevents +the erasure proof and the expression passed to `lowerAllAction` from drifting +apart. -/ +theorem + lowerAllAction_ordinaryStuckUnreachable_of_certificate_sealed + {ectx : Ixon.Eval.EvalCtx} {frame : Ixon.Eval.Frame} + {source : Ixon.Expr} {sourceFuel eraseFuel : Nat} + {sourceValue : Ixon.Eval.Value} {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (cert : Ix.Compiler.EraseValidator.CertifiedSharedExpr ectx sourceCtx + none (Ix.Compiler.EraseValidator.tablesOfFrame frame) + frame.selfAddr [] eraseFuel source) + (hstrict : ectx.Strict) + (horacles : Ix.Compiler.Sim.OracleRel ectx.inlineSharing sourceCtx) + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hctx : ectx.SharingWF) (hframe : frame.SharingWF) + (hbelow : Ixon.Sharing.sharesBelow frame.sharing.size source = true) + (hsource : Ixon.Eval.eval ectx sourceFuel frame [] source = + .ok sourceValue) + (hlower : + (lowerAllAction decls cert.target mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htargetDecls : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hextern : ExternValueContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) : + OrdinaryStuckUnreachable ctx mainCode := by + obtain ⟨targetValue, hsafe, hrel⟩ := + ProjectionSafeEval.of_certifiedSharedClosed cert hstrict horacles hctx + hframe hbelow hsource + exact lowerAllAction_ordinaryStuckUnreachable_of_projectionSafe_sealed + henv hlower htargetDecls hrepresented hcontracts hextern hprogress hsafe + +/-- End-to-end semantic forward simulation for the exact expression returned +by the executable sharing-aware erasure validator. -/ +theorem + lowerAllAction_semanticForwardSimulation_of_certificate_sealed + {ectx : Ixon.Eval.EvalCtx} {frame : Ixon.Eval.Frame} + {source : Ixon.Expr} {sourceFuel eraseFuel : Nat} + {sourceValue : Ixon.Eval.Value} {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (cert : Ix.Compiler.EraseValidator.CertifiedSharedExpr ectx sourceCtx + none (Ix.Compiler.EraseValidator.tablesOfFrame frame) + frame.selfAddr [] eraseFuel source) + (hstrict : ectx.Strict) + (horacles : Ix.Compiler.Sim.OracleRel ectx.inlineSharing sourceCtx) + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hctx : ectx.SharingWF) (hframe : frame.SharingWF) + (hbelow : Ixon.Sharing.sharesBelow frame.sharing.size source = true) + (hsource : Ixon.Eval.eval ectx sourceFuel frame [] source = + .ok sourceValue) + (hlower : + (lowerAllAction decls cert.target mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htargetDecls : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hextern : ExternValueContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx) + (hprogress : CompilerProgressContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) : + SemanticForwardSimulation sourceCtx ctx cert.target mainCode + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) + finalState) := by + obtain ⟨targetValue, hsafe, hrel⟩ := + ProjectionSafeEval.of_certifiedSharedClosed cert hstrict horacles hctx + hframe hbelow hsource + exact lowerAllAction_semanticForwardSimulation_of_projectionSafe_sealed + henv hlower htargetDecls hrepresented hcontracts hextern hprogress hsafe + +/-- Certificate-indexed forward simulation with callable progress rebuilt +from exact source traces and whole-pass provenance. This is the call-aware +replacement for the compatibility theorem above: it has no +`CompilerProgressContracts` premise. -/ +theorem + lowerAllAction_semanticForwardSimulation_of_certificate_trace_sealed + {ectx : Ixon.Eval.EvalCtx} {frame : Ixon.Eval.Frame} + {source : Ixon.Expr} {sourceFuel eraseFuel : Nat} + {sourceValue : Ixon.Eval.Value} {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (cert : Ix.Compiler.EraseValidator.CertifiedSharedExpr ectx sourceCtx + none (Ix.Compiler.EraseValidator.tablesOfFrame frame) + frame.selfAddr [] eraseFuel source) + (hstrict : ectx.Strict) + (horacles : Ix.Compiler.Sim.OracleRel ectx.inlineSharing sourceCtx) + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hctx : ectx.SharingWF) (hframe : frame.SharingWF) + (hbelow : Ixon.Sharing.sharesBelow frame.sharing.size source = true) + (hsource : Ixon.Eval.eval ectx sourceFuel frame [] source = + .ok sourceValue) + (hlower : + (lowerAllAction decls cert.target mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htarget : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hexternValue : ExternValueContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx) + (hexternProgress : ExternTraceProgressContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx) : + SemanticForwardSimulation sourceCtx ctx cert.target mainCode + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) + finalState) := by + have htargetProgress := lowerAllAction_main_progress_of_certificate_sealed + cert hstrict horacles henv hctx hframe hbelow hsource hlower htarget + hrepresented hcontracts hexternValue hexternProgress + apply lowerAllAction_semanticForwardSimulation_of_targetProgress_sealed + henv hlower htarget hrepresented hcontracts hexternValue + intro targetSourceFuel targetSourceValue htargetSource + exact htargetProgress + +/-- Hoare-style settlement of a closed main yields the public all-fuel +memory-safety proposition. -/ +theorem memoryErrorUnreachable_of_codeSettlement + {ctx : Ctx} {code : Code} {pre : StatePred} + (hsettles : CodeSettlement ctx ⟨0, .shared, false, code⟩ pre code) + (hpre : pre {} []) : + MemoryErrorUnreachable ctx code := by + apply memoryErrorUnreachable_of_settlement + obtain ⟨fuel, hterminal⟩ := hsettles hpre + exact ⟨fuel, by simpa [runMain] using hterminal⟩ + +/-- One successful top-level run is enough to exclude dynamic memory errors +at every fuel. Above the successful fuel, success is monotone; below it, a +memory error would persist up to the successful fuel. -/ +theorem memoryErrorUnreachable_of_progress + {ctx : Ctx} {code : Code} + (hprogress : ∃ fuel store value, + runMain ctx code fuel = .ok (store, value)) : + MemoryErrorUnreachable ctx code := by + obtain ⟨successFuel, store, value, hsuccess⟩ := hprogress + exact memoryErrorUnreachable_of_settlement + ⟨successFuel, .success (store, value) hsuccess⟩ + +/-- Any established semantic forward simulation yields the public all-fuel +memory-safety claim as soon as the source program has one successful run. -/ +theorem SemanticForwardSimulation.memoryErrorUnreachable + {sourceCtx : IxIR0.Ctx} {targetCtx : Ctx} + {source : IxIR0.Expr} {target : Code} {funRel : Sim.FunctionRel} + (hsim : SemanticForwardSimulation sourceCtx targetCtx source target + funRel) + {sourceFuel : Nat} {sourceValue : IxIR0.Value} + (hsource : IxIR0.eval sourceCtx sourceFuel [] source = + .ok sourceValue) : + MemoryErrorUnreachable targetCtx target := by + obtain ⟨targetFuel, targetStore, targetValue, htarget, _⟩ := + hsim hsource + exact memoryErrorUnreachable_of_progress + ⟨targetFuel, targetStore, targetValue, htarget⟩ + +end Ix.Compiler.IxIR1.LowerSim diff --git a/Ix/Compiler/IxIR1/LowerSim.lean b/Ix/Compiler/IxIR1/LowerSim.lean new file mode 100644 index 000000000..be0a332b0 --- /dev/null +++ b/Ix/Compiler/IxIR1/LowerSim.lean @@ -0,0 +1,34095 @@ +import Ix.Compiler.IxIR1.LowerStateBase +import Ix.Compiler.IxIR1.Sim +import Ix.Compiler.IxIR1.Mono +import Ix.Compiler.IxIR1.Reclamation +import Ix.Compiler.IxIR0.Mono + +/-! +# Proof interface for the IxIR₀ → IxIR₁ lowering + +This file begins the compiler induction proper. `IxIR1.Sim` proves exact +ownership interfaces for evaluator operations; here those interfaces are +lifted to the continuation-building shape used by `Lower.Emit` and tied to +the lowerer's absolute-slot environment. + +The central judgment is `EmitSound`: an emitter transforms any continuation +valid under its output state predicate into code valid under its input state +predicate. This is a weakest-precondition presentation of the existing +`Code → Code` difference-list representation, so emitter composition becomes +the compiler induction's sequencing rule. +-/ + +namespace Ix.Compiler.IxIR1.LowerSim + +open Ix.Compiler.Ixon (Owned Uses) +open Ix.Compiler.IxIR1.Lower +open Ix.Compiler.IxIR1.Sim + +/-! ## Runtime realization of the compile-time environment -/ + +/-- Realize the held entries of a compile-time `VEnv` as an ordered root +list. Released slots and the synthetic recursor-self entry own no runtime +root. Absolute slots are interpreted with the same `VEnv.rel` calculation +used by code emission. -/ +inductive EntriesRealize (Γ : VEnv) (env : List RVal) : + List VEntry → List Root → Prop where + | nil : EntriesRealize Γ env [] [] + | released {abs remaining uses entries roots} : + abs < Γ.depth → + EntriesRealize Γ env entries roots → + EntriesRealize Γ env + (.slot abs remaining uses false :: entries) roots + | held {abs remaining uses entries roots value} : + abs < Γ.depth → + env[Γ.rel abs]? = some value → + EntriesRealize Γ env entries roots → + EntriesRealize Γ env + (.slot abs remaining uses true :: entries) + (⟨worldOfUses uses, value⟩ :: roots) + | recSelf {arity entries roots} : + EntriesRealize Γ env entries roots → + EntriesRealize Γ env (.recSelf arity :: entries) roots + +/-- Dependent traversal of an ownership environment graph. Entry/root +threading and released/held/recursive-self dispatch recurse once; callbacks +receive both the original tail witness and the recursively produced result. -/ +theorem EntriesRealize.traverse + {Γ : VEnv} {env : List RVal} + {Result : List VEntry → List Root → Prop} + (hnil : Result [] []) + (hreleased : ∀ {abs remaining : Nat} {uses : Uses} + {entries : List VEntry} {roots : List Root}, + abs < Γ.depth → + EntriesRealize Γ env entries roots → + Result entries roots → + Result (.slot abs remaining uses false :: entries) roots) + (hheld : ∀ {abs remaining : Nat} {uses : Uses} + {entries : List VEntry} {roots : List Root} {value : RVal}, + abs < Γ.depth → + env[Γ.rel abs]? = some value → + EntriesRealize Γ env entries roots → + Result entries roots → + Result (.slot abs remaining uses true :: entries) + (⟨worldOfUses uses, value⟩ :: roots)) + (hrecSelf : ∀ {arity : Nat} {entries : List VEntry} + {roots : List Root}, + EntriesRealize Γ env entries roots → + Result entries roots → + Result (.recSelf arity :: entries) roots) + {entries : List VEntry} {roots : List Root} + (h : EntriesRealize Γ env entries roots) : + Result entries roots := by + induction h with + | nil => exact hnil + | released hbound htail ih => exact hreleased hbound htail ih + | held hbound hslot htail ih => exact hheld hbound hslot htail ih + | recSelf htail ih => exact hrecSelf htail ih + +theorem EntriesRealize.append {Γ : VEnv} {env : List RVal} + {left right : List VEntry} {leftRoots rightRoots : List Root} + (hleft : EntriesRealize Γ env left leftRoots) + (hright : EntriesRealize Γ env right rightRoots) : + EntriesRealize Γ env (left ++ right) (leftRoots ++ rightRoots) := by + apply EntriesRealize.traverse + (Result := fun current currentRoots => + EntriesRealize Γ env (current ++ right) + (currentRoots ++ rightRoots)) + (h := hleft) + · simpa using hright + · intro abs remaining uses entries roots hbound htail ih + simpa using EntriesRealize.released hbound ih + · intro abs remaining uses entries roots value hbound hslot htail ih + simpa using EntriesRealize.held hbound hslot ih + · intro arity entries roots htail ih + simpa using EntriesRealize.recSelf ih + +/-- A runtime environment realizes a `VEnv` when its physical depth agrees +and its held entries realize exactly the listed logical roots. -/ +structure VEnvRealizes (Γ : VEnv) (env : List RVal) + (roots : List Root) : Prop where + depth_eq : env.length = Γ.depth + entries : EntriesRealize Γ env Γ.entries roots + +/-! ## Companion source-environment graph + +The ownership induction above deliberately forgets source values. The +semantic induction instead layers the following graph over the same `VEnv` +and exact root order. Held entries relate their source value to the runtime +slot through `ValueGraph`; released entries retain only the source-list +shape; and the synthetic recursor-self entry is described by a separate +static relation because it emits `callSelf` without occupying a runtime +slot. -/ + +/-- Correspondence for the synthetic source recursor value represented by a +`VEntry.recSelf`. The enclosing recursor theorem will instantiate the source +address as well as the shared target function contract. -/ +abbrev RecSelfRel := IxIR0.Value → Nat → Prop + +/-! ## Lifted closures and their stored pap prefixes -/ + +/-- The outer de Bruijn entries captured by lambda lifting, in the exact +order used by `lowerLam`. -/ +def liftCaptureIndices (entryCount : Nat) (expr : IxIR0.Expr) : List Nat := + (List.range entryCount).filter (fun index => countUses index expr > 0) + +/-- `values` are the source-environment values at `indices`, in order. +Making lookup success proof-relevant avoids a default source value and gives +the capture-lowering induction exactly the relation it has to construct. -/ +inductive ValuesAt (sourceEnv : List IxIR0.Value) : + List Nat → List IxIR0.Value → Prop where + | nil : ValuesAt sourceEnv [] [] + | cons {index : Nat} {value : IxIR0.Value} + {indices : List Nat} {values : List IxIR0.Value} : + sourceEnv[index]? = some value → + ValuesAt sourceEnv indices values → + ValuesAt sourceEnv (index :: indices) (value :: values) + +@[simp] theorem ValuesAt.length {sourceEnv : List IxIR0.Value} + {indices : List Nat} {values : List IxIR0.Value} + (h : ValuesAt sourceEnv indices values) : + values.length = indices.length := by + induction h <;> simp_all + +theorem ValuesAt.exists_of_forall_lt + (sourceEnv : List IxIR0.Value) (indices : List Nat) + (hbound : ∀ index, index ∈ indices → index < sourceEnv.length) : + ∃ values, ValuesAt sourceEnv indices values := by + induction indices with + | nil => exact ⟨[], .nil⟩ + | cons index rest ih => + have hindex : index < sourceEnv.length := + hbound index (by simp) + obtain ⟨values, hvalues⟩ := ih (fun candidate hmember => + hbound candidate (by simp [hmember])) + let value := sourceEnv[index] + refine ⟨value :: values, .cons ?_ hvalues⟩ + exact List.getElem?_eq_some_iff.mpr ⟨hindex, rfl⟩ + +/-- Every compiler-selected capture index is valid when the source and +lowering environments have the same logical length. -/ +theorem ValuesAt.exists_liftCaptureIndices + (sourceEnv : List IxIR0.Value) (entryCount : Nat) + (expr : IxIR0.Expr) (hlength : sourceEnv.length = entryCount) : + ∃ values, + ValuesAt sourceEnv (liftCaptureIndices entryCount expr) values := by + apply ValuesAt.exists_of_forall_lt + intro index hmember + obtain ⟨hrange, _⟩ := List.mem_filter.mp hmember + have hindex := List.mem_range.mp hrange + omega + +/-- A source closure after zero or more applications from the leading lambda +run. Arguments are stored in application order, while the evaluator closure +environment grows in reverse order. Requiring the residual expression to be +a lambda makes every represented prefix strictly under-saturated. -/ +inductive LambdaPrefix : + List IxIR0.Value → IxIR0.Expr → + List IxIR0.Value → IxIR0.Value → Prop where + | nil {sourceEnv : List IxIR0.Value} {uses : Uses} + {body : IxIR0.Expr} : + LambdaPrefix sourceEnv (.lam uses body) [] + (.clos uses sourceEnv body) + | cons {sourceEnv : List IxIR0.Value} {uses : Uses} + {body : IxIR0.Expr} {argument : IxIR0.Value} + {arguments : List IxIR0.Value} {value : IxIR0.Value} : + LambdaPrefix (argument :: sourceEnv) body arguments value → + LambdaPrefix sourceEnv (.lam uses body) + (argument :: arguments) value + +/-- Dependent traversal of a residual lifted-closure prefix. Source +environment growth, lambda peeling, supplied arguments, and the residual +source value recurse once; callbacks retain the original inner-prefix witness +alongside its recursively produced result. -/ +theorem LambdaPrefix.traverse + {Result : List IxIR0.Value → IxIR0.Expr → + List IxIR0.Value → IxIR0.Value → Prop} + (hnil : ∀ {sourceEnv : List IxIR0.Value} {uses : Uses} + {body : IxIR0.Expr}, + Result sourceEnv (.lam uses body) [] + (.clos uses sourceEnv body)) + (hcons : ∀ {sourceEnv : List IxIR0.Value} {uses : Uses} + {body : IxIR0.Expr} {argument : IxIR0.Value} + {arguments : List IxIR0.Value} {value : IxIR0.Value}, + LambdaPrefix (argument :: sourceEnv) body arguments value → + Result (argument :: sourceEnv) body arguments value → + Result sourceEnv (.lam uses body) (argument :: arguments) value) + {sourceEnv : List IxIR0.Value} {expr : IxIR0.Expr} + {arguments : List IxIR0.Value} {value : IxIR0.Value} + (h : LambdaPrefix sourceEnv expr arguments value) : + Result sourceEnv expr arguments value := by + induction h with + | nil => exact hnil + | cons hinner ih => exact hcons hinner ih + +/-- A represented closure prefix contains fewer supplied parameters than the +leading lambda arity, matching the target evaluator's pap invariant. -/ +theorem LambdaPrefix.length_lt_lamArity + {sourceEnv : List IxIR0.Value} {expr : IxIR0.Expr} + {arguments : List IxIR0.Value} {value : IxIR0.Value} + (h : LambdaPrefix sourceEnv expr arguments value) : + arguments.length < lamArity expr := by + apply LambdaPrefix.traverse + (Result := fun _ currentExpr currentArguments _ => + currentArguments.length < lamArity currentExpr) + (h := h) + · intro currentEnv uses body + simp [lamArity] + · intro currentEnv uses body argument currentArguments currentValue + hinner ih + simpa [lamArity] using Nat.succ_lt_succ ih + +/-- Provenance boundary for one generated lifted declaration. The concrete +compiler relation below supplies this from an exact `lowerFnBody` run and a +declaration in the accumulated lowering state. -/ +abbrev LiftCodeRel := + Ixon.Address → Nat → IxIR0.Expr → Prop + +/-- Function correspondence for lifted paps. The pap stores selected outer +captures followed by already supplied parameters; the related source value +is precisely the residual closure after that parameter prefix. -/ +def LiftedFunctionRel (liftRel : LiftCodeRel) : Sim.FunctionRel := + fun value address arity captures => + ∃ sourceEnv expr selected supplied, + liftRel address sourceEnv.length expr ∧ + ValuesAt sourceEnv (liftCaptureIndices sourceEnv.length expr) selected ∧ + captures = selected ++ supplied ∧ + arity = selected.length + lamArity expr ∧ + LambdaPrefix sourceEnv expr supplied value + +theorem LiftedFunctionRel.initial {liftRel : LiftCodeRel} + {sourceEnv : List IxIR0.Value} {uses : Uses} {body : IxIR0.Expr} + {selected : List IxIR0.Value} {address : Ixon.Address} + (hlift : liftRel address sourceEnv.length (.lam uses body)) + (hselected : ValuesAt sourceEnv + (liftCaptureIndices sourceEnv.length (.lam uses body)) selected) : + LiftedFunctionRel liftRel (.clos uses sourceEnv body) address + (selected.length + lamArity (.lam uses body)) selected := by + refine ⟨sourceEnv, .lam uses body, selected, [], hlift, hselected, + ?_, rfl, .nil⟩ + simp + +theorem LiftedFunctionRel.underfilled {liftRel : LiftCodeRel} + {value : IxIR0.Value} {address : Ixon.Address} {arity : Nat} + {captures : List IxIR0.Value} + (h : LiftedFunctionRel liftRel value address arity captures) : + captures.length < arity := by + obtain ⟨sourceEnv, expr, selected, supplied, _, _, rfl, rfl, + hprefix⟩ := h + have hunder := hprefix.length_lt_lamArity + simp only [List.length_append] + omega + +/-- Lifted function correspondence is monotone in its declaration-provenance +relation. This lets a local lowering result be transported to the final +whole-program accumulation. -/ +theorem LiftedFunctionRel.mono {before after : LiftCodeRel} + (hmono : ∀ address entryCount expr, + before address entryCount expr → after address entryCount expr) + {value : IxIR0.Value} {address : Ixon.Address} {arity : Nat} + {captures : List IxIR0.Value} + (h : LiftedFunctionRel before value address arity captures) : + LiftedFunctionRel after value address arity captures := by + obtain ⟨sourceEnv, expr, selected, supplied, hlift, hselected, + hcaptures, harity, hprefix⟩ := h + exact ⟨sourceEnv, expr, selected, supplied, + hmono address sourceEnv.length expr hlift, + hselected, hcaptures, harity, hprefix⟩ + +/-- Pointwise semantic realization of a source evaluator environment by a +lowering environment and its runtime stack. The root list has exactly the +same order as `EntriesRealize`, so it can be consumed directly by +`RootsGraph` and `RootOwnership`. -/ +inductive EntriesValueGraph (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (store : Store) (Γ : VEnv) + (env : List RVal) : + List VEntry → List IxIR0.Value → List Root → Prop where + | nil : EntriesValueGraph funRel recSelfRel store Γ env [] [] [] + | released {abs remaining : Nat} {uses : Uses} + {entries : List VEntry} {source : IxIR0.Value} + {sources : List IxIR0.Value} {roots : List Root} : + abs < Γ.depth → + EntriesValueGraph funRel recSelfRel store Γ env + entries sources roots → + EntriesValueGraph funRel recSelfRel store Γ env + (.slot abs remaining uses false :: entries) + (source :: sources) roots + | held {abs remaining : Nat} {uses : Uses} + {entries : List VEntry} {source : IxIR0.Value} + {sources : List IxIR0.Value} {value : RVal} + {roots : List Root} : + abs < Γ.depth → + env[Γ.rel abs]? = some value → + HasWorld store (worldOfUses uses) value → + Sim.ValueGraph funRel store source value → + EntriesValueGraph funRel recSelfRel store Γ env + entries sources roots → + EntriesValueGraph funRel recSelfRel store Γ env + (.slot abs remaining uses true :: entries) + (source :: sources) + (⟨worldOfUses uses, value⟩ :: roots) + | recSelf {arity : Nat} {entries : List VEntry} + {source : IxIR0.Value} {sources : List IxIR0.Value} + {roots : List Root} : + recSelfRel source arity → + EntriesValueGraph funRel recSelfRel store Γ env + entries sources roots → + EntriesValueGraph funRel recSelfRel store Γ env + (.recSelf arity :: entries) (source :: sources) roots + +/-- Dependent traversal of a semantic environment graph. Entry/source/root +threading and released/held/recursive-self dispatch recurse once; callbacks +receive both the original tail witness and the recursively produced result. -/ +theorem EntriesValueGraph.traverse + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {store : Store} {Γ : VEnv} {env : List RVal} + {Result : List VEntry → List IxIR0.Value → List Root → Prop} + (hnil : Result [] [] []) + (hreleased : ∀ {abs remaining : Nat} {uses : Uses} + {entries : List VEntry} {source : IxIR0.Value} + {sources : List IxIR0.Value} {roots : List Root}, + abs < Γ.depth → + EntriesValueGraph funRel recSelfRel store Γ env + entries sources roots → + Result entries sources roots → + Result (.slot abs remaining uses false :: entries) + (source :: sources) roots) + (hheld : ∀ {abs remaining : Nat} {uses : Uses} + {entries : List VEntry} {source : IxIR0.Value} + {sources : List IxIR0.Value} {value : RVal} + {roots : List Root}, + abs < Γ.depth → + env[Γ.rel abs]? = some value → + HasWorld store (worldOfUses uses) value → + Sim.ValueGraph funRel store source value → + EntriesValueGraph funRel recSelfRel store Γ env + entries sources roots → + Result entries sources roots → + Result (.slot abs remaining uses true :: entries) + (source :: sources) (⟨worldOfUses uses, value⟩ :: roots)) + (hrecSelf : ∀ {arity : Nat} {entries : List VEntry} + {source : IxIR0.Value} {sources : List IxIR0.Value} + {roots : List Root}, + recSelfRel source arity → + EntriesValueGraph funRel recSelfRel store Γ env + entries sources roots → + Result entries sources roots → + Result (.recSelf arity :: entries) (source :: sources) roots) + {entries : List VEntry} {sourceEnv : List IxIR0.Value} + {roots : List Root} + (h : EntriesValueGraph funRel recSelfRel store Γ env + entries sourceEnv roots) : + Result entries sourceEnv roots := by + induction h with + | nil => exact hnil + | released hbound htail ih => exact hreleased hbound htail ih + | held hbound hslot hworld hvalue htail ih => + exact hheld hbound hslot hworld hvalue htail ih + | recSelf hself htail ih => exact hrecSelf hself htail ih + +/-- Semantic entry graphs compose in the same logical-entry and root order +as their ownership-only companions. -/ +theorem EntriesValueGraph.append {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {store : Store} {Γ : VEnv} + {env : List RVal} {left right : List VEntry} + {leftSources rightSources : List IxIR0.Value} + {leftRoots rightRoots : List Root} + (hleft : EntriesValueGraph funRel recSelfRel store Γ env + left leftSources leftRoots) + (hright : EntriesValueGraph funRel recSelfRel store Γ env + right rightSources rightRoots) : + EntriesValueGraph funRel recSelfRel store Γ env + (left ++ right) (leftSources ++ rightSources) + (leftRoots ++ rightRoots) := by + apply EntriesValueGraph.traverse + (Result := fun current currentSources currentRoots => + EntriesValueGraph funRel recSelfRel store Γ env + (current ++ right) (currentSources ++ rightSources) + (currentRoots ++ rightRoots)) + (h := hleft) + · simpa using hright + · intro abs remaining uses entries source sources roots hbound htail ih + simpa using EntriesValueGraph.released hbound ih + · intro abs remaining uses entries source sources value roots hbound + hslot hworld hvalue htail ih + simpa using EntriesValueGraph.held hbound hslot hworld hvalue ih + · intro arity entries source sources roots hself htail ih + simpa using EntriesValueGraph.recSelf hself ih + +/-- A complete source environment realized by a lowering environment. -/ +structure VEnvValueGraph (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (store : Store) (Γ : VEnv) + (sourceEnv : List IxIR0.Value) (env : List RVal) + (roots : List Root) : Prop where + depth_eq : env.length = Γ.depth + entries : EntriesValueGraph funRel recSelfRel store Γ env + Γ.entries sourceEnv roots + +/-- The companion graph forgets to the existing target-stack realization. -/ +theorem EntriesValueGraph.entriesRealize {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {store : Store} {Γ : VEnv} + {env : List RVal} {entries : List VEntry} + {sourceEnv : List IxIR0.Value} {roots : List Root} + (h : EntriesValueGraph funRel recSelfRel store Γ env + entries sourceEnv roots) : + EntriesRealize Γ env entries roots := by + apply EntriesValueGraph.traverse + (Result := fun current _ currentRoots => + EntriesRealize Γ env current currentRoots) + (h := h) + · exact .nil + · intro abs remaining uses tail source sources tailRoots hbound htail ih + exact .released hbound ih + · intro abs remaining uses tail source sources value tailRoots hbound + hslot hworld hvalue htail ih + exact .held hbound hslot ih + · intro arity tail source sources tailRoots hself htail ih + exact .recSelf ih + +/-- The source-side root frame determined solely by entry structure. Held +entries contribute their source value at the entry's world; released and +synthetic recursive-self entries contribute no runtime owner. This list is +store-independent, which makes it the stable name for an environment frame +across a callee that may both allocate and free. -/ +def entrySourceRoots : List VEntry → List IxIR0.Value → + List (Owned × IxIR0.Value) + | .slot _ _ uses held :: entries, source :: sources => + if held then + (worldOfUses uses, source) :: entrySourceRoots entries sources + else + entrySourceRoots entries sources + | .recSelf _ :: entries, _ :: sources => + entrySourceRoots entries sources + | _, _ => [] + +/-- An environment graph realizes its canonical, store-independent source +root frame exactly. -/ +theorem EntriesValueGraph.rootsGraphExact {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {store : Store} {Γ : VEnv} + {env : List RVal} {entries : List VEntry} + {sourceEnv : List IxIR0.Value} {roots : List Root} + (h : EntriesValueGraph funRel recSelfRel store Γ env + entries sourceEnv roots) : + Sim.RootsGraph funRel store (entrySourceRoots entries sourceEnv) + roots := by + apply EntriesValueGraph.traverse + (Result := fun current currentSources currentRoots => + Sim.RootsGraph funRel store + (entrySourceRoots current currentSources) currentRoots) + (h := h) + · exact .nil + · intro abs remaining uses tail source sources tailRoots hbound htail ih + exact ih + · intro abs remaining uses tail source sources value tailRoots hbound + hslot hworld hvalue htail ih + exact .cons rfl hworld hvalue ih + · intro arity tail source sources tailRoots hself htail ih + exact ih + +/-- The exact root order carried by the environment graph is a semantic +`RootsGraph`; this is the bridge from logical compiler slots to pure source +values. -/ +theorem EntriesValueGraph.rootsGraph {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {store : Store} {Γ : VEnv} + {env : List RVal} {entries : List VEntry} + {sourceEnv : List IxIR0.Value} {roots : List Root} + (h : EntriesValueGraph funRel recSelfRel store Γ env + entries sourceEnv roots) : + ∃ sourceRoots : List (Owned × IxIR0.Value), + Sim.RootsGraph funRel store sourceRoots roots := + ⟨entrySourceRoots entries sourceEnv, h.rootsGraphExact⟩ + +/-- Rebuild an entry graph in an arbitrary post-store from preservation of +its canonical source-root frame. Entry bounds, slot lookups, released state, +and recursive-self evidence are store-independent; the supplied +`RootsGraph` replaces exactly the held entries' world and value witnesses. -/ +theorem EntriesValueGraph.ofRootsGraph {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {before after : Store} {Γ : VEnv} + {env : List RVal} {entries : List VEntry} + {sourceEnv : List IxIR0.Value} {roots : List Root} + (h : EntriesValueGraph funRel recSelfRel before Γ env + entries sourceEnv roots) + (hroots : Sim.RootsGraph funRel after + (entrySourceRoots entries sourceEnv) roots) : + EntriesValueGraph funRel recSelfRel after Γ env + entries sourceEnv roots := by + revert hroots + apply EntriesValueGraph.traverse + (Result := fun current currentSources currentRoots => + Sim.RootsGraph funRel after + (entrySourceRoots current currentSources) currentRoots → + EntriesValueGraph funRel recSelfRel after Γ env + current currentSources currentRoots) + (h := h) + · intro hroots + exact .nil + · intro abs remaining uses tail source sources tailRoots hbound htail ih + hroots + exact .released hbound (ih hroots) + · intro abs remaining uses tail source sources value tailRoots hbound + hslot hworld hvalue htail ih hroots + change Sim.RootsGraph funRel after + ((worldOfUses uses, source) :: entrySourceRoots tail sources) + (⟨worldOfUses uses, value⟩ :: tailRoots) at hroots + cases hroots with + | cons _ hworld hvalue htail => + exact .held hbound hslot hworld hvalue (ih htail) + · intro arity tail source sources tailRoots hself htail ih hroots + exact .recSelf hself (ih hroots) + +@[simp] theorem EntriesValueGraph.source_length {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {store : Store} {Γ : VEnv} + {env : List RVal} {entries : List VEntry} + {sourceEnv : List IxIR0.Value} {roots : List Root} + (h : EntriesValueGraph funRel recSelfRel store Γ env + entries sourceEnv roots) : + sourceEnv.length = entries.length := by + apply EntriesValueGraph.traverse + (Result := fun current currentSources _ => + currentSources.length = current.length) + (h := h) + · rfl + · intro abs remaining uses tail source sources tailRoots hbound htail ih + simp [ih] + · intro abs remaining uses tail source sources value tailRoots hbound + hslot hworld hvalue htail ih + simp [ih] + · intro arity tail source sources tailRoots hself htail ih + simp [ih] + +/-- Looking up a held compiler entry recovers the related source and target +values needed by the variable case of the semantic induction. -/ +theorem EntriesValueGraph.getHeld {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {store : Store} {Γ : VEnv} + {env : List RVal} {entries : List VEntry} + {sourceEnv : List IxIR0.Value} {roots : List Root} + {i abs remaining : Nat} {uses : Uses} + (h : EntriesValueGraph funRel recSelfRel store Γ env + entries sourceEnv roots) + (hentry : entries[i]? = some (.slot abs remaining uses true)) : + ∃ source value, + sourceEnv[i]? = some source ∧ + env[Γ.rel abs]? = some value ∧ + HasWorld store (worldOfUses uses) value ∧ + Sim.ValueGraph funRel store source value := by + have hlookup : + ∀ {index : Nat}, + entries[index]? = some (.slot abs remaining uses true) → + ∃ source value, + sourceEnv[index]? = some source ∧ + env[Γ.rel abs]? = some value ∧ + HasWorld store (worldOfUses uses) value ∧ + Sim.ValueGraph funRel store source value := by + exact EntriesValueGraph.traverse + (Result := fun current currentSources _ => + ∀ {index : Nat}, + current[index]? = some (.slot abs remaining uses true) → + ∃ source value, + currentSources[index]? = some source ∧ + env[Γ.rel abs]? = some value ∧ + HasWorld store (worldOfUses uses) value ∧ + Sim.ValueGraph funRel store source value) + (hnil := by + intro index hentry + simp at hentry) + (hreleased := by + intro curAbs curRemaining curUses tail source sources tailRoots + hbound htail ih index hentry + cases index with + | zero => simp at hentry + | succ index => + rw [List.getElem?_cons_succ] at hentry + obtain ⟨source, value, hsource, hslot, hworld, hvalue⟩ := + ih hentry + exact ⟨source, value, by simpa using hsource, + hslot, hworld, hvalue⟩) + (hheld := by + intro curAbs curRemaining curUses tail source sources value tailRoots + hbound hslot hworld hvalue htail ih index hentry + cases index with + | zero => + rw [List.getElem?_cons_zero] at hentry + have heqs : curAbs = abs ∧ curRemaining = remaining ∧ + curUses = uses := by simpa using hentry + obtain ⟨rfl, rfl, rfl⟩ := heqs + exact ⟨source, value, rfl, hslot, hworld, hvalue⟩ + | succ index => + rw [List.getElem?_cons_succ] at hentry + obtain ⟨foundSource, foundValue, hsource, hfoundSlot, + hfoundWorld, hfoundValue⟩ := ih hentry + exact ⟨foundSource, foundValue, by simpa using hsource, + hfoundSlot, hfoundWorld, hfoundValue⟩) + (hrecSelf := by + intro arity tail source sources tailRoots hself htail ih index hentry + cases index with + | zero => simp at hentry + | succ index => + rw [List.getElem?_cons_succ] at hentry + obtain ⟨source, value, hsource, hslot, hworld, hvalue⟩ := + ih hentry + exact ⟨source, value, by simpa using hsource, + hslot, hworld, hvalue⟩) + (h := h) + exact hlookup hentry + +/-- Looking up the synthetic self entry recovers the statically related +source recursor value; it intentionally has no target runtime slot. -/ +theorem EntriesValueGraph.getRecSelf {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {store : Store} {Γ : VEnv} + {env : List RVal} {entries : List VEntry} + {sourceEnv : List IxIR0.Value} {roots : List Root} + {i arity : Nat} + (h : EntriesValueGraph funRel recSelfRel store Γ env + entries sourceEnv roots) + (hentry : entries[i]? = some (.recSelf arity)) : + ∃ source, + sourceEnv[i]? = some source ∧ recSelfRel source arity := by + have hlookup : + ∀ {index : Nat}, + entries[index]? = some (.recSelf arity) → + ∃ source, + sourceEnv[index]? = some source ∧ recSelfRel source arity := by + exact EntriesValueGraph.traverse + (Result := fun current currentSources _ => + ∀ {index : Nat}, + current[index]? = some (.recSelf arity) → + ∃ source, + currentSources[index]? = some source ∧ recSelfRel source arity) + (hnil := by + intro index hentry + simp at hentry) + (hreleased := by + intro abs remaining uses tail source sources tailRoots hbound htail ih + index hentry + cases index with + | zero => simp at hentry + | succ index => + rw [List.getElem?_cons_succ] at hentry + obtain ⟨source, hsource, hself⟩ := ih hentry + exact ⟨source, by simpa using hsource, hself⟩) + (hheld := by + intro abs remaining uses tail source sources value tailRoots hbound + hslot hworld hvalue htail ih index hentry + cases index with + | zero => simp at hentry + | succ index => + rw [List.getElem?_cons_succ] at hentry + obtain ⟨source, hsource, hself⟩ := ih hentry + exact ⟨source, by simpa using hsource, hself⟩) + (hrecSelf := by + intro currentArity tail source sources tailRoots hself htail ih + index hentry + cases index with + | zero => + rw [List.getElem?_cons_zero] at hentry + have harity : currentArity = arity := by simpa using hentry + subst arity + exact ⟨source, rfl, hself⟩ + | succ index => + rw [List.getElem?_cons_succ] at hentry + obtain ⟨found, hsource, hfound⟩ := ih hentry + exact ⟨found, by simpa using hsource, hfound⟩) + (h := h) + exact hlookup hentry + +theorem VEnvValueGraph.vEnvRealizes {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {store : Store} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {env : List RVal} + {roots : List Root} + (h : VEnvValueGraph funRel recSelfRel store Γ sourceEnv env roots) : + VEnvRealizes Γ env roots := + ⟨h.depth_eq, h.entries.entriesRealize⟩ + +theorem VEnvValueGraph.rootsGraph {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {store : Store} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {env : List RVal} + {roots : List Root} + (h : VEnvValueGraph funRel recSelfRel store Γ sourceEnv env roots) : + ∃ sourceRoots : List (Owned × IxIR0.Value), + Sim.RootsGraph funRel store sourceRoots roots := + h.entries.rootsGraph + +/-- Rebuild the complete semantic environment after an arbitrary callee +transition, provided the callee preserves the canonical environment frame. +No global extension/restriction relation between the stores is required. -/ +theorem VEnvValueGraph.ofRootsGraph {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {before after : Store} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {env : List RVal} + {roots : List Root} + (h : VEnvValueGraph funRel recSelfRel before Γ sourceEnv env roots) + (hroots : Sim.RootsGraph funRel after + (entrySourceRoots Γ.entries sourceEnv) roots) : + VEnvValueGraph funRel recSelfRel after Γ sourceEnv env roots := + ⟨h.depth_eq, h.entries.ofRootsGraph hroots⟩ + +theorem VEnvValueGraph.getHeld {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {store : Store} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {env : List RVal} + {roots : List Root} {i abs remaining : Nat} {uses : Uses} + (h : VEnvValueGraph funRel recSelfRel store Γ sourceEnv env roots) + (hentry : Γ.entries[i]? = some (.slot abs remaining uses true)) : + ∃ source value, + sourceEnv[i]? = some source ∧ + env[Γ.rel abs]? = some value ∧ + HasWorld store (worldOfUses uses) value ∧ + Sim.ValueGraph funRel store source value := + h.entries.getHeld hentry + +theorem VEnvValueGraph.getRecSelf {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {store : Store} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {env : List RVal} + {roots : List Root} {i arity : Nat} + (h : VEnvValueGraph funRel recSelfRel store Γ sourceEnv env roots) + (hentry : Γ.entries[i]? = some (.recSelf arity)) : + ∃ source, + sourceEnv[i]? = some source ∧ recSelfRel source arity := + h.entries.getRecSelf hentry + +/-- Runtime realization of the lowerer's returned value descriptor. -/ +inductive AValRealizes (Γ : VEnv) (env : List RVal) : + AVal → RVal → Prop where + | slot {abs value} : + abs < Γ.depth → + env[Γ.rel abs]? = some value → + AValRealizes Γ env (.slotA abs) value + | const {atom value} : + resolveAtom env atom = .ok value → + AValRealizes Γ env (.constA atom) value + +theorem AValRealizes.resolveAtom {Γ : VEnv} {env : List RVal} + {av : AVal} {value : RVal} (h : AValRealizes Γ env av value) : + resolveAtom env (av.toAtom Γ) = .ok value := by + cases h with + | slot _ hslot => + change (match env[Γ.rel _]? with + | some found => (Except.ok found : Except Err RVal) + | none => Except.error (.stuck s!"unbound variable {Γ.rel _}")) = + Except.ok value + rw [hslot] + | const hconst => simpa [AVal.toAtom] using hconst + +/-- Returned descriptors depend on a compile-time environment only through +its runtime depth. This is the transport used when a released logical binder +is popped without changing the physical runtime stack. -/ +theorem AValRealizes.of_depth_eq {Γ Δ : VEnv} {env : List RVal} + {av : AVal} {value : RVal} (hdepth : Γ.depth = Δ.depth) + (h : AValRealizes Γ env av value) : + AValRealizes Δ env av value := by + cases h with + | slot hbound hslot => + apply AValRealizes.slot + · simpa [hdepth] using hbound + · simpa [VEnv.rel, hdepth] using hslot + | const hresolve => exact AValRealizes.const hresolve + +/-- Returned `AVal`s are either absolute slots or environment-independent +scalar atoms. The lowerer never stores a relative variable in `constA`; this +fact is what lets argument results survive later runtime pushes. -/ +inductive AValStable : AVal → Prop where + | slot {abs : Nat} : AValStable (.slotA abs) + | lit {literal : IxIR0.Literal} : AValStable (.constA (.lit literal)) + | erased : AValStable (.constA .erased) + +/-- Absolute slots whose values must remain resolvable while a later +lowering derivation pushes additional runtime results. -/ +def SlotsRealize (Γ : VEnv) (env : List RVal) + (slots : List (Nat × RVal)) : Prop := + ∀ abs value, (abs, value) ∈ slots → + abs < Γ.depth ∧ env[Γ.rel abs]? = some value + +theorem SlotsRealize.nil {Γ : VEnv} {env : List RVal} : + SlotsRealize Γ env [] := by + simp [SlotsRealize] + +theorem SlotsRealize.mono {Γ : VEnv} {env : List RVal} + {left right : List (Nat × RVal)} (hsub : ∀ item, item ∈ left → item ∈ right) + (h : SlotsRealize Γ env right) : SlotsRealize Γ env left := by + intro abs value hmem + exact h abs value (hsub _ hmem) + +theorem SlotsRealize.append {Γ : VEnv} {env : List RVal} + {left right : List (Nat × RVal)} + (hleft : SlotsRealize Γ env left) + (hright : SlotsRealize Γ env right) : + SlotsRealize Γ env (left ++ right) := by + intro abs value hmem + rcases List.mem_append.mp hmem with hmem | hmem + · exact hleft abs value hmem + · exact hright abs value hmem + +theorem SlotsRealize.left_of_append {Γ : VEnv} {env : List RVal} + {left right : List (Nat × RVal)} + (h : SlotsRealize Γ env (left ++ right)) : SlotsRealize Γ env left := + h.mono (fun _ hmem => List.mem_append_left right hmem) + +theorem SlotsRealize.right_of_append {Γ : VEnv} {env : List RVal} + {left right : List (Nat × RVal)} + (h : SlotsRealize Γ env (left ++ right)) : SlotsRealize Γ env right := + h.mono (fun _ hmem => List.mem_append_right left hmem) + +theorem SlotsRealize.bump {Γ : VEnv} {env : List RVal} + {slots : List (Nat × RVal)} (pushed : RVal) + (h : SlotsRealize Γ env slots) : + SlotsRealize Γ.bump (pushed :: env) slots := by + intro abs value hmem + obtain ⟨hbound, hslot⟩ := h abs value hmem + constructor + · simpa [VEnv.bump] using Nat.lt_succ_of_lt hbound + · have hrel : Γ.bump.rel abs = Γ.rel abs + 1 := by + simp only [VEnv.bump, VEnv.rel] + omega + rw [hrel] + simpa using hslot + +theorem SlotsRealize.setEntry {Γ : VEnv} {env : List RVal} + {slots : List (Nat × RVal)} {i : Nat} {entry : VEntry} + (h : SlotsRealize Γ env slots) : + SlotsRealize (Γ.setEntry i entry) env slots := by + intro abs value hmem + simpa [VEnv.setEntry, VEnv.rel] using h abs value hmem + +/-- Protected absolute slots depend only on the runtime depth, not on the +logical entries tracked alongside it. -/ +theorem SlotsRealize.of_depth_eq {Γ Δ : VEnv} {env : List RVal} + {slots : List (Nat × RVal)} (hdepth : Γ.depth = Δ.depth) + (h : SlotsRealize Γ env slots) : SlotsRealize Δ env slots := by + intro abs value hmem + simpa [VEnv.rel, hdepth] using h abs value hmem + +/-- The one absolute slot needed to preserve a returned slot value; stable +constants need no protected runtime position. -/ +def aValProtection : AVal → RVal → List (Nat × RVal) + | .slotA abs, value => [(abs, value)] + | .constA _, _ => [] + +theorem AValStable.protection_realized {Γ : VEnv} {env : List RVal} + {av : AVal} {value : RVal} (stable : AValStable av) + (h : AValRealizes Γ env av value) : + SlotsRealize Γ env (aValProtection av value) := by + cases stable with + | slot => + cases h with + | slot hbound hslot => + intro abs found hmem + simp only [aValProtection, List.mem_singleton, Prod.mk.injEq] at hmem + obtain ⟨rfl, rfl⟩ := hmem + exact ⟨hbound, hslot⟩ + | lit => exact SlotsRealize.nil + | erased => exact SlotsRealize.nil + +theorem AValStable.realize_of_protection {Γ Δ : VEnv} + {env env' : List RVal} {av : AVal} {value : RVal} + (stable : AValStable av) (h : AValRealizes Γ env av value) + (hslots : SlotsRealize Δ env' (aValProtection av value)) : + AValRealizes Δ env' av value := by + cases stable with + | @slot abs => + cases h with + | slot _ _ => + obtain ⟨hbound, hslot⟩ := + hslots abs value (by simp [aValProtection]) + exact .slot hbound hslot + | lit => + cases h with + | const hresolve => + simp only [resolveAtom, Except.ok.injEq] at hresolve + subst value + exact .const rfl + | erased => + cases h with + | const hresolve => + simp only [resolveAtom, Except.ok.injEq] at hresolve + subst value + exact .const rfl + +/-- Stable descriptors remain realized after an unrelated runtime push. -/ +theorem AValStable.realize_bump {Γ : VEnv} {env : List RVal} + {av : AVal} {value : RVal} (stable : AValStable av) + (h : AValRealizes Γ env av value) (pushed : RVal) : + AValRealizes Γ.bump (pushed :: env) av value := by + exact stable.realize_of_protection h + ((stable.protection_realized h).bump pushed) + +/-- A stable constant descriptor can realize only an ownership-inert scalar. +This excludes the unstable `.constA (.var _)` shape by construction. -/ +theorem AValStable.const_noLocation {Γ : VEnv} {env : List RVal} + {atom : Atom} {value : RVal} + (stable : AValStable (.constA atom)) + (h : AValRealizes Γ env (.constA atom) value) : + rvalLocation? value = none := by + cases stable with + | lit => + cases h with + | const hresolve => + simp only [resolveAtom, Except.ok.injEq] at hresolve + subst value + rfl + | erased => + cases h with + | const hresolve => + simp only [resolveAtom, Except.ok.injEq] at hresolve + subst value + rfl + +theorem VEnv.rel_bump {Γ : VEnv} {abs : Nat} (habs : abs < Γ.depth) : + Γ.bump.rel abs = Γ.rel abs + 1 := by + simp only [VEnv.bump, VEnv.rel] + omega + +/-- Pushing one runtime result preserves realization of every older absolute +slot. The explicit slot bound is what rules out a malformed absolute address +from aliasing the newly pushed head. -/ +theorem EntriesRealize.bump {Γ : VEnv} {env : List RVal} + {entries : List VEntry} {roots : List Root} (value : RVal) + (h : EntriesRealize Γ env entries roots) : + EntriesRealize Γ.bump (value :: env) entries roots := by + apply EntriesRealize.traverse + (Result := fun current currentRoots => + EntriesRealize Γ.bump (value :: env) current currentRoots) + (h := h) + · exact .nil + · intro abs remaining uses tail tailRoots habs htail ih + apply EntriesRealize.released + · simpa [VEnv.bump] using Nat.lt_succ_of_lt habs + · exact ih + · intro abs remaining uses tail tailRoots currentValue habs hslot htail ih + apply EntriesRealize.held + · simpa [VEnv.bump] using Nat.lt_succ_of_lt habs + · rw [VEnv.rel_bump habs] + simpa using hslot + · exact ih + · intro arity tail tailRoots htail ih + exact .recSelf ih + +theorem VEnvRealizes.bump {Γ : VEnv} {env : List RVal} + {roots : List Root} (value : RVal) (h : VEnvRealizes Γ env roots) : + VEnvRealizes Γ.bump (value :: env) roots := by + constructor + · simpa [VEnv.bump] using h.depth_eq + · exact h.entries.bump value + +/-- A runtime push preserves the companion source graph for all older +logical entries. The source evaluator environment is unchanged. -/ +theorem EntriesValueGraph.bump {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {store : Store} {Γ : VEnv} + {env : List RVal} {entries : List VEntry} + {sourceEnv : List IxIR0.Value} {roots : List Root} + (value : RVal) + (h : EntriesValueGraph funRel recSelfRel store Γ env + entries sourceEnv roots) : + EntriesValueGraph funRel recSelfRel store Γ.bump (value :: env) + entries sourceEnv roots := by + apply EntriesValueGraph.traverse + (Result := fun current currentSources currentRoots => + EntriesValueGraph funRel recSelfRel store Γ.bump (value :: env) + current currentSources currentRoots) + (h := h) + · exact .nil + · intro abs remaining uses tail source sources tailRoots hbound htail ih + apply EntriesValueGraph.released + · simpa [VEnv.bump] using Nat.lt_succ_of_lt hbound + · exact ih + · intro abs remaining uses tail source sources currentValue tailRoots + hbound hslot hworld hvalue htail ih + apply EntriesValueGraph.held + · simpa [VEnv.bump] using Nat.lt_succ_of_lt hbound + · rw [VEnv.rel_bump hbound] + simpa using hslot + · exact hworld + · exact hvalue + · exact ih + · intro arity tail source sources tailRoots hself htail ih + exact .recSelf hself ih + +theorem VEnvValueGraph.bump {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {store : Store} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {env : List RVal} + {roots : List Root} (value : RVal) + (h : VEnvValueGraph funRel recSelfRel store Γ sourceEnv env roots) : + VEnvValueGraph funRel recSelfRel store Γ.bump sourceEnv + (value :: env) roots := by + constructor + · simpa [VEnv.bump] using h.depth_eq + · exact h.entries.bump value + +/-- The semantic entry graph, like `EntriesRealize`, observes the enclosing +`VEnv` only through its physical depth. -/ +theorem EntriesValueGraph.of_depth_eq {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {store : Store} {Γ Δ : VEnv} + {env : List RVal} {entries : List VEntry} + {sourceEnv : List IxIR0.Value} {roots : List Root} + (hdepth : Γ.depth = Δ.depth) + (h : EntriesValueGraph funRel recSelfRel store Γ env + entries sourceEnv roots) : + EntriesValueGraph funRel recSelfRel store Δ env + entries sourceEnv roots := by + apply EntriesValueGraph.traverse + (Result := fun current currentSources currentRoots => + EntriesValueGraph funRel recSelfRel store Δ env + current currentSources currentRoots) + (h := h) + · exact .nil + · intro abs remaining uses tail source sources tailRoots hbound htail ih + apply EntriesValueGraph.released + · simpa [hdepth] using hbound + · exact ih + · intro abs remaining uses tail source sources value tailRoots hbound + hslot hworld hvalue htail ih + apply EntriesValueGraph.held + · simpa [hdepth] using hbound + · simpa [VEnv.rel, hdepth] using hslot + · exact hworld + · exact hvalue + · exact ih + · intro arity tail source sources tailRoots hself htail ih + exact .recSelf hself ih + +/-- Transport the source-environment graph through a store update that keeps +all existing live node shapes. Runtime slots and logical roots are unchanged. -/ +theorem EntriesValueGraph.monoStore {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {before after : Store} {Γ : VEnv} + {env : List RVal} {entries : List VEntry} + {sourceEnv : List IxIR0.Value} {roots : List Root} + (hstore : Sim.StoreGraphExtends before after) + (h : EntriesValueGraph funRel recSelfRel before Γ env + entries sourceEnv roots) : + EntriesValueGraph funRel recSelfRel after Γ env + entries sourceEnv roots := by + apply EntriesValueGraph.traverse + (Result := fun current currentSources currentRoots => + EntriesValueGraph funRel recSelfRel after Γ env + current currentSources currentRoots) + (h := h) + · exact .nil + · intro abs remaining uses tail source sources tailRoots hbound htail ih + exact .released hbound ih + · intro abs remaining uses tail source sources value tailRoots hbound + hslot hworld hvalue htail ih + exact .held hbound hslot (hworld.monoStore hstore) + (hvalue.monoStore hstore) ih + · intro arity tail source sources tailRoots hself htail ih + exact .recSelf hself ih + +theorem VEnvValueGraph.monoStore {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {before after : Store} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {env : List RVal} + {roots : List Root} + (hstore : Sim.StoreGraphExtends before after) + (h : VEnvValueGraph funRel recSelfRel before Γ sourceEnv env roots) : + VEnvValueGraph funRel recSelfRel after Γ sourceEnv env roots := + ⟨h.depth_eq, h.entries.monoStore hstore⟩ + +/-- Destructive store restriction preserves every held environment graph +whose logical root survives in the post-state ownership set. -/ +theorem EntriesValueGraph.ofRestricts {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {before after : Store} {Γ : VEnv} + {env : List RVal} {entries : List VEntry} + {sourceEnv : List IxIR0.Value} {roots allRoots : List Root} + (hstore : Sim.StoreGraphRestricts before after) + (hown : RootOwnership after allRoots) + (hsubset : ∀ root, root ∈ roots → root ∈ allRoots) + (h : EntriesValueGraph funRel recSelfRel before Γ env + entries sourceEnv roots) : + EntriesValueGraph funRel recSelfRel after Γ env + entries sourceEnv roots := by + have hrestrict : + (∀ root, root ∈ roots → root ∈ allRoots) → + EntriesValueGraph funRel recSelfRel after Γ env + entries sourceEnv roots := by + exact EntriesValueGraph.traverse + (Result := fun current currentSources currentRoots => + (∀ root, root ∈ currentRoots → root ∈ allRoots) → + EntriesValueGraph funRel recSelfRel after Γ env + current currentSources currentRoots) + (hnil := by + intro hsubset + exact .nil) + (hreleased := by + intro abs remaining uses tail source sources tailRoots hbound htail ih + hsubset + exact .released hbound (ih hsubset)) + (hheld := by + intro abs remaining uses tail source sources value tailRoots hbound + hslot hworld hvalue htail ih hsubset + have hrootLive : HasWorld after (worldOfUses uses) value := by + apply hown.roots_world ⟨worldOfUses uses, value⟩ + exact hsubset _ (by simp) + apply EntriesValueGraph.held hbound hslot hrootLive + · exact hvalue.ofRestricts hstore hown hrootLive + · exact ih (fun root hmember => + hsubset root (by simp [hmember]))) + (hrecSelf := by + intro arity tail source sources tailRoots hself htail ih hsubset + exact .recSelf hself (ih hsubset)) + (h := h) + exact hrestrict hsubset + +theorem VEnvValueGraph.ofRestricts {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {before after : Store} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {env : List RVal} + {roots allRoots : List Root} + (hstore : Sim.StoreGraphRestricts before after) + (hown : RootOwnership after allRoots) + (hsubset : ∀ root, root ∈ roots → root ∈ allRoots) + (h : VEnvValueGraph funRel recSelfRel before Γ sourceEnv env roots) : + VEnvValueGraph funRel recSelfRel after Γ sourceEnv env roots := + ⟨h.depth_eq, h.entries.ofRestricts hstore hown hsubset⟩ + +/-- Rebuild the enclosing semantic environment after changing one logical +entry while leaving the runtime stack and source environment fixed. -/ +theorem VEnvValueGraph.setEntry {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {store : Store} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {env : List RVal} + {roots roots' : List Root} {i : Nat} {entry : VEntry} + (h : VEnvValueGraph funRel recSelfRel store Γ sourceEnv env roots) + (hentries : EntriesValueGraph funRel recSelfRel store Γ env + (Γ.entries.set i entry) sourceEnv roots') : + VEnvValueGraph funRel recSelfRel store (Γ.setEntry i entry) + sourceEnv env roots' := by + constructor + · simpa [VEnv.setEntry] using h.depth_eq + · exact hentries.of_depth_eq (by simp [VEnv.setEntry]) + +/-- Increase only the physical runtime depth of a compile-time environment. -/ +def addVEnvDepth (Γ : VEnv) (count : Nat) : VEnv := + { Γ with depth := Γ.depth + count } + +/-- Repeated runtime pushes preserve all existing logical entries and roots. -/ +theorem VEnvRealizes.bumpList {Γ : VEnv} {env : List RVal} + {roots : List Root} (values : List RVal) + (h : VEnvRealizes Γ env roots) : + VEnvRealizes (addVEnvDepth Γ values.length) + (values.reverse ++ env) roots := by + induction values generalizing Γ env with + | nil => simpa [addVEnvDepth] using h + | cons value values ih => + have htail := ih (h.bump value) + simpa [addVEnvDepth, VEnv.bump, List.reverse_cons, + List.append_assoc, Nat.add_assoc, Nat.add_comm, + Nat.add_left_comm] using htail + +/-- Repeated runtime pushes preserve the complete source-environment graph. +The pushed values are physical case bindings and do not become logical +source entries until the recursor prefix explicitly retains them. -/ +theorem VEnvValueGraph.bumpList {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {store : Store} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {env : List RVal} + {roots : List Root} (values : List RVal) + (h : VEnvValueGraph funRel recSelfRel store Γ sourceEnv env roots) : + VEnvValueGraph funRel recSelfRel store + (addVEnvDepth Γ values.length) sourceEnv + (values.reverse ++ env) roots := by + induction values generalizing Γ env with + | nil => simpa [addVEnvDepth] using h + | cons value values ih => + have htail := ih (h.bump value) + simpa [addVEnvDepth, VEnv.bump, List.reverse_cons, + List.append_assoc, Nat.add_assoc, Nat.add_comm, + Nat.add_left_comm] using htail + +/-- A block of released placeholder slots contributes no logical roots. -/ +theorem EntriesRealize.replicateReleased {Γ : VEnv} {env : List RVal} + (count : Nat) (hbound : 0 < Γ.depth) : + EntriesRealize Γ env + (List.replicate count (.slot 0 0 .many false)) [] := by + induction count with + | zero => exact EntriesRealize.nil + | succ count ih => + simpa [List.replicate_succ] using + EntriesRealize.released hbound ih + +/-- A released placeholder block retains the corresponding pure source-list +shape while contributing no semantic roots. -/ +theorem EntriesValueGraph.replicateReleased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {store : Store} {Γ : VEnv} {env : List RVal} + {sources : List IxIR0.Value} {count : Nat} + (hlength : sources.length = count) (hbound : 0 < Γ.depth) : + EntriesValueGraph funRel recSelfRel store Γ env + (List.replicate count (.slot 0 0 .many false)) sources [] := by + induction count generalizing sources with + | zero => + have hsources : sources = [] := + List.eq_nil_of_length_eq_zero hlength + subst sources + exact EntriesValueGraph.nil + | succ count ih => + cases sources with + | nil => simp at hlength + | cons source sources => + have htail : sources.length = count := by simpa using hlength + simpa [List.replicate_succ] using + EntriesValueGraph.released hbound (ih htail) + +/-- `EntriesRealize` observes only a `VEnv`'s depth (through `rel`), so it +transports between compile-time environments with the same runtime depth. -/ +theorem EntriesRealize.of_depth_eq {Γ Δ : VEnv} {env : List RVal} + {entries : List VEntry} {roots : List Root} (hdepth : Γ.depth = Δ.depth) + (h : EntriesRealize Γ env entries roots) : + EntriesRealize Δ env entries roots := by + apply EntriesRealize.traverse + (Result := fun current currentRoots => + EntriesRealize Δ env current currentRoots) + (h := h) + · exact .nil + · intro abs remaining uses tail tailRoots habs htail ih + apply EntriesRealize.released + · simpa [hdepth] using habs + · exact ih + · intro abs remaining uses tail tailRoots value habs hslot htail ih + apply EntriesRealize.held + · simpa [hdepth] using habs + · simpa [VEnv.rel, hdepth] using hslot + · exact ih + · intro arity tail tailRoots htail ih + exact .recSelf ih + +/-- Rebuild a realized `VEnv` after changing one source-entry descriptor. +The caller supplies the corresponding entry-list realization. -/ +theorem VEnvRealizes.setEntry {Γ : VEnv} {env : List RVal} + {roots roots' : List Root} {i : Nat} {entry : VEntry} + (h : VEnvRealizes Γ env roots) + (hentries : EntriesRealize Γ env (Γ.entries.set i entry) roots') : + VEnvRealizes (Γ.setEntry i entry) env roots' := by + constructor + · simpa [VEnv.setEntry] using h.depth_eq + · exact hentries.of_depth_eq (by simp [VEnv.setEntry]) + +/-- Locate a held entry in its exact logical-root list and release it. This +is the proof-relevant state transition for a variable's final (moving) use. -/ +theorem EntriesRealize.releaseAt {Γ : VEnv} {env : List RVal} + {entries : List VEntry} {roots : List Root} {i abs remaining : Nat} + {uses : Uses} (hreal : EntriesRealize Γ env entries roots) + (hentry : entries[i]? = some (.slot abs remaining uses true)) : + ∃ value before after, + abs < Γ.depth ∧ + env[Γ.rel abs]? = some value ∧ + roots = before ++ ⟨worldOfUses uses, value⟩ :: after ∧ + EntriesRealize Γ env + (entries.set i (.slot abs 0 uses false)) (before ++ after) := by + have hrelease : + ∀ {index : Nat}, + entries[index]? = some (.slot abs remaining uses true) → + ∃ value before after, + abs < Γ.depth ∧ + env[Γ.rel abs]? = some value ∧ + roots = before ++ ⟨worldOfUses uses, value⟩ :: after ∧ + EntriesRealize Γ env + (entries.set index (.slot abs 0 uses false)) + (before ++ after) := by + exact EntriesRealize.traverse + (Result := fun current currentRoots => + ∀ {index : Nat}, + current[index]? = some (.slot abs remaining uses true) → + ∃ value before after, + abs < Γ.depth ∧ + env[Γ.rel abs]? = some value ∧ + currentRoots = + before ++ ⟨worldOfUses uses, value⟩ :: after ∧ + EntriesRealize Γ env + (current.set index (.slot abs 0 uses false)) + (before ++ after)) + (hnil := by + intro index hentry + simp at hentry) + (hreleased := by + intro curAbs curRemaining curUses tail tailRoots habs htail ih + index hentry + cases index with + | zero => simp at hentry + | succ index => + rw [List.getElem?_cons_succ] at hentry + obtain ⟨value, before, after, hbound, hslot, hroots, hout⟩ := + ih hentry + refine ⟨value, before, after, hbound, hslot, hroots, ?_⟩ + simpa using EntriesRealize.released habs hout) + (hheld := by + intro curAbs curRemaining curUses tail tailRoots current + habs hslot htail ih index hentry + cases index with + | zero => + rw [List.getElem?_cons_zero] at hentry + have heqs : curAbs = abs ∧ curRemaining = remaining ∧ + curUses = uses := by simpa using hentry + obtain ⟨rfl, rfl, rfl⟩ := heqs + refine ⟨current, [], tailRoots, habs, hslot, rfl, ?_⟩ + simpa using EntriesRealize.released habs htail + | succ index => + rw [List.getElem?_cons_succ] at hentry + obtain ⟨value, before, after, hbound, hselected, hroots, hout⟩ := + ih hentry + refine ⟨value, ⟨worldOfUses curUses, current⟩ :: before, after, + hbound, hselected, ?_, ?_⟩ + · simp [hroots] + · simpa using EntriesRealize.held habs hslot hout) + (hrecSelf := by + intro arity tail tailRoots htail ih index hentry + cases index with + | zero => simp at hentry + | succ index => + rw [List.getElem?_cons_succ] at hentry + obtain ⟨value, before, after, hbound, hslot, hroots, hout⟩ := + ih hentry + refine ⟨value, before, after, hbound, hslot, hroots, ?_⟩ + simpa using EntriesRealize.recSelf hout) + (h := hreal) + exact hrelease hentry + +/-- Semantic counterpart of `EntriesRealize.releaseAt`. Besides transferring +the exact target root, it preserves the full source environment and exposes +the `ValueGraph` witness for the moved result. -/ +theorem EntriesValueGraph.releaseAt {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {store : Store} {Γ : VEnv} + {env : List RVal} {entries : List VEntry} + {sourceEnv : List IxIR0.Value} {roots : List Root} + {i abs remaining : Nat} {uses : Uses} + (hreal : EntriesValueGraph funRel recSelfRel store Γ env + entries sourceEnv roots) + (hentry : entries[i]? = some (.slot abs remaining uses true)) : + ∃ source value before after, + sourceEnv[i]? = some source ∧ + abs < Γ.depth ∧ + env[Γ.rel abs]? = some value ∧ + HasWorld store (worldOfUses uses) value ∧ + Sim.ValueGraph funRel store source value ∧ + roots = before ++ ⟨worldOfUses uses, value⟩ :: after ∧ + EntriesValueGraph funRel recSelfRel store Γ env + (entries.set i (.slot abs 0 uses false)) sourceEnv + (before ++ after) := by + have hrelease : + ∀ {index : Nat}, + entries[index]? = some (.slot abs remaining uses true) → + ∃ source value before after, + sourceEnv[index]? = some source ∧ + abs < Γ.depth ∧ + env[Γ.rel abs]? = some value ∧ + HasWorld store (worldOfUses uses) value ∧ + Sim.ValueGraph funRel store source value ∧ + roots = before ++ ⟨worldOfUses uses, value⟩ :: after ∧ + EntriesValueGraph funRel recSelfRel store Γ env + (entries.set index (.slot abs 0 uses false)) sourceEnv + (before ++ after) := by + exact EntriesValueGraph.traverse + (Result := fun current currentSources currentRoots => + ∀ {index : Nat}, + current[index]? = some (.slot abs remaining uses true) → + ∃ source value before after, + currentSources[index]? = some source ∧ + abs < Γ.depth ∧ + env[Γ.rel abs]? = some value ∧ + HasWorld store (worldOfUses uses) value ∧ + Sim.ValueGraph funRel store source value ∧ + currentRoots = + before ++ ⟨worldOfUses uses, value⟩ :: after ∧ + EntriesValueGraph funRel recSelfRel store Γ env + (current.set index (.slot abs 0 uses false)) currentSources + (before ++ after)) + (hnil := by + intro index hentry + simp at hentry) + (hreleased := by + intro curAbs curRemaining curUses tail currentSource sources + tailRoots hbound htail ih index hentry + cases index with + | zero => simp at hentry + | succ index => + rw [List.getElem?_cons_succ] at hentry + obtain ⟨source, value, before, after, hsource, habs, hslot, + hworld, hvalue, hroots, hout⟩ := ih hentry + refine ⟨source, value, before, after, by simpa using hsource, + habs, hslot, hworld, hvalue, hroots, ?_⟩ + simpa using EntriesValueGraph.released hbound hout) + (hheld := by + intro curAbs curRemaining curUses tail currentSource sources + currentValue tailRoots hbound hslot hworld hvalue htail ih + index hentry + cases index with + | zero => + rw [List.getElem?_cons_zero] at hentry + have heqs : curAbs = abs ∧ curRemaining = remaining ∧ + curUses = uses := by simpa using hentry + obtain ⟨rfl, rfl, rfl⟩ := heqs + exact ⟨currentSource, currentValue, [], tailRoots, rfl, + hbound, hslot, hworld, hvalue, rfl, + by simpa using EntriesValueGraph.released hbound htail⟩ + | succ index => + rw [List.getElem?_cons_succ] at hentry + obtain ⟨source, value, before, after, hsource, habs, + hselected, hfoundWorld, hfoundValue, hroots, hout⟩ := + ih hentry + refine ⟨source, value, + ⟨worldOfUses curUses, currentValue⟩ :: before, after, + by simpa using hsource, habs, hselected, hfoundWorld, + hfoundValue, ?_, ?_⟩ + · simp [hroots] + · simpa using + EntriesValueGraph.held hbound hslot hworld hvalue hout) + (hrecSelf := by + intro arity tail currentSource sources tailRoots hself htail ih + index hentry + cases index with + | zero => simp at hentry + | succ index => + rw [List.getElem?_cons_succ] at hentry + obtain ⟨source, value, before, after, hsource, habs, hslot, + hworld, hvalue, hroots, hout⟩ := ih hentry + refine ⟨source, value, before, after, by simpa using hsource, + habs, hslot, hworld, hvalue, hroots, ?_⟩ + simpa using EntriesValueGraph.recSelf hself hout) + (h := hreal) + exact hrelease hentry + +/-- Activate a released entry at a newly available absolute slot. The new +owner is inserted at the entry's structural position in the exact root list; +this is the proof-side transition for retaining a borrowed case field. -/ +theorem EntriesRealize.holdAt {Γ : VEnv} {env : List RVal} + {entries : List VEntry} {roots : List Root} + {i oldAbs oldRemaining newAbs newRemaining : Nat} {uses : Uses} + {value : RVal} + (hreal : EntriesRealize Γ env entries roots) + (hentry : entries[i]? = + some (.slot oldAbs oldRemaining uses false)) + (hbound : newAbs < Γ.depth) + (hslot : env[Γ.rel newAbs]? = some value) : + ∃ before after, + roots = before ++ after ∧ + EntriesRealize Γ env + (entries.set i (.slot newAbs newRemaining uses true)) + (before ++ ⟨worldOfUses uses, value⟩ :: after) := by + have hhold : + ∀ {index : Nat}, + entries[index]? = + some (.slot oldAbs oldRemaining uses false) → + ∃ before after, + roots = before ++ after ∧ + EntriesRealize Γ env + (entries.set index (.slot newAbs newRemaining uses true)) + (before ++ ⟨worldOfUses uses, value⟩ :: after) := by + exact EntriesRealize.traverse + (Result := fun current currentRoots => + ∀ {index : Nat}, + current[index]? = + some (.slot oldAbs oldRemaining uses false) → + ∃ before after, + currentRoots = before ++ after ∧ + EntriesRealize Γ env + (current.set index (.slot newAbs newRemaining uses true)) + (before ++ ⟨worldOfUses uses, value⟩ :: after)) + (hnil := by + intro index hentry + simp at hentry) + (hreleased := by + intro curAbs curRemaining curUses tail tailRoots habs htail ih + index hentry + cases index with + | zero => + refine ⟨[], tailRoots, rfl, ?_⟩ + simpa using EntriesRealize.held hbound hslot htail + | succ index => + rw [List.getElem?_cons_succ] at hentry + obtain ⟨before, after, hroots, hout⟩ := ih hentry + refine ⟨before, after, hroots, ?_⟩ + simpa using EntriesRealize.released habs hout) + (hheld := by + intro curAbs curRemaining curUses tail tailRoots current + habs hcurrent htail ih index hentry + cases index with + | zero => simp at hentry + | succ index => + rw [List.getElem?_cons_succ] at hentry + obtain ⟨before, after, hroots, hout⟩ := ih hentry + refine ⟨⟨worldOfUses curUses, current⟩ :: before, after, ?_, ?_⟩ + · simp [hroots] + · simpa using EntriesRealize.held habs hcurrent hout) + (hrecSelf := by + intro arity tail tailRoots htail ih index hentry + cases index with + | zero => simp at hentry + | succ index => + rw [List.getElem?_cons_succ] at hentry + obtain ⟨before, after, hroots, hout⟩ := ih hentry + refine ⟨before, after, hroots, ?_⟩ + simpa using EntriesRealize.recSelf hout) + (h := hreal) + exact hhold hentry + +/-- Semantic counterpart of `EntriesRealize.holdAt`. Activating a released +entry records the source value realized by the newly retained runtime owner +at the entry's exact structural root position. -/ +theorem EntriesValueGraph.holdAt {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {store : Store} {Γ : VEnv} + {env : List RVal} {entries : List VEntry} + {sourceEnv : List IxIR0.Value} {roots : List Root} + {i oldAbs oldRemaining newAbs newRemaining : Nat} {uses : Uses} + {source : IxIR0.Value} {value : RVal} + (hreal : EntriesValueGraph funRel recSelfRel store Γ env + entries sourceEnv roots) + (hentry : entries[i]? = + some (.slot oldAbs oldRemaining uses false)) + (hsource : sourceEnv[i]? = some source) + (hbound : newAbs < Γ.depth) + (hslot : env[Γ.rel newAbs]? = some value) + (hworld : HasWorld store (worldOfUses uses) value) + (hvalue : Sim.ValueGraph funRel store source value) : + ∃ before after, + roots = before ++ after ∧ + EntriesValueGraph funRel recSelfRel store Γ env + (entries.set i (.slot newAbs newRemaining uses true)) + sourceEnv + (before ++ ⟨worldOfUses uses, value⟩ :: after) := by + have hhold : + ∀ {index : Nat}, + entries[index]? = + some (.slot oldAbs oldRemaining uses false) → + sourceEnv[index]? = some source → + ∃ before after, + roots = before ++ after ∧ + EntriesValueGraph funRel recSelfRel store Γ env + (entries.set index (.slot newAbs newRemaining uses true)) + sourceEnv + (before ++ ⟨worldOfUses uses, value⟩ :: after) := by + exact EntriesValueGraph.traverse + (Result := fun current currentSources currentRoots => + ∀ {index : Nat}, + current[index]? = + some (.slot oldAbs oldRemaining uses false) → + currentSources[index]? = some source → + ∃ before after, + currentRoots = before ++ after ∧ + EntriesValueGraph funRel recSelfRel store Γ env + (current.set index (.slot newAbs newRemaining uses true)) + currentSources + (before ++ ⟨worldOfUses uses, value⟩ :: after)) + (hnil := by + intro index hentry hsource + simp at hentry) + (hreleased := by + intro curAbs curRemaining curUses tail currentSource sources + tailRoots hcurBound htail ih index hentry hsource + cases index with + | zero => + simp only [List.getElem?_cons_zero, Option.some.injEq] at hsource + subst currentSource + refine ⟨[], tailRoots, rfl, ?_⟩ + simpa using + EntriesValueGraph.held hbound hslot hworld hvalue htail + | succ index => + rw [List.getElem?_cons_succ] at hentry hsource + obtain ⟨before, after, hroots, hout⟩ := ih hentry hsource + refine ⟨before, after, hroots, ?_⟩ + simpa using EntriesValueGraph.released hcurBound hout) + (hheld := by + intro curAbs curRemaining curUses tail currentSource sources + currentValue tailRoots hcurBound hcurSlot hcurWorld hcurValue + htail ih index hentry hsource + cases index with + | zero => simp at hentry + | succ index => + rw [List.getElem?_cons_succ] at hentry hsource + obtain ⟨before, after, hroots, hout⟩ := ih hentry hsource + refine ⟨⟨worldOfUses curUses, currentValue⟩ :: before, + after, ?_, ?_⟩ + · simp [hroots] + · simpa using EntriesValueGraph.held hcurBound hcurSlot + hcurWorld hcurValue hout) + (hrecSelf := by + intro arity tail currentSource sources tailRoots hself htail ih + index hentry hsource + cases index with + | zero => simp at hentry + | succ index => + rw [List.getElem?_cons_succ] at hentry hsource + obtain ⟨before, after, hroots, hout⟩ := ih hentry hsource + refine ⟨before, after, hroots, ?_⟩ + simpa using EntriesValueGraph.recSelf hself hout) + (h := hreal) + exact hhold hentry hsource + +/-- Update the remaining-use counter of a held entry without changing its +existing root. The selected value and its root membership are exposed for +the following shared retain operation. -/ +theorem EntriesRealize.updateHeldAt {Γ : VEnv} {env : List RVal} + {entries : List VEntry} {roots : List Root} {i abs remaining : Nat} + {uses : Uses} (newRemaining : Nat) + (hreal : EntriesRealize Γ env entries roots) + (hentry : entries[i]? = some (.slot abs remaining uses true)) : + ∃ value, + abs < Γ.depth ∧ + env[Γ.rel abs]? = some value ∧ + ⟨worldOfUses uses, value⟩ ∈ roots ∧ + EntriesRealize Γ env + (entries.set i (.slot abs newRemaining uses true)) roots := by + have hupdate : + ∀ {index : Nat}, + entries[index]? = some (.slot abs remaining uses true) → + ∃ value, + abs < Γ.depth ∧ + env[Γ.rel abs]? = some value ∧ + ⟨worldOfUses uses, value⟩ ∈ roots ∧ + EntriesRealize Γ env + (entries.set index (.slot abs newRemaining uses true)) + roots := by + exact EntriesRealize.traverse + (Result := fun current currentRoots => + ∀ {index : Nat}, + current[index]? = some (.slot abs remaining uses true) → + ∃ value, + abs < Γ.depth ∧ + env[Γ.rel abs]? = some value ∧ + ⟨worldOfUses uses, value⟩ ∈ currentRoots ∧ + EntriesRealize Γ env + (current.set index (.slot abs newRemaining uses true)) + currentRoots) + (hnil := by + intro index hentry + simp at hentry) + (hreleased := by + intro curAbs curRemaining curUses tail tailRoots habs htail ih + index hentry + cases index with + | zero => simp at hentry + | succ index => + rw [List.getElem?_cons_succ] at hentry + obtain ⟨value, hbound, hslot, hmem, hout⟩ := ih hentry + refine ⟨value, hbound, hslot, hmem, ?_⟩ + simpa using EntriesRealize.released habs hout) + (hheld := by + intro curAbs curRemaining curUses tail tailRoots current + habs hslot htail ih index hentry + cases index with + | zero => + rw [List.getElem?_cons_zero] at hentry + have heqs : curAbs = abs ∧ curRemaining = remaining ∧ + curUses = uses := by simpa using hentry + obtain ⟨rfl, rfl, rfl⟩ := heqs + refine ⟨current, habs, hslot, by simp, ?_⟩ + simpa using EntriesRealize.held habs hslot htail + | succ index => + rw [List.getElem?_cons_succ] at hentry + obtain ⟨value, hbound, hselected, hmem, hout⟩ := ih hentry + refine ⟨value, hbound, hselected, + List.mem_cons_of_mem _ hmem, ?_⟩ + simpa using EntriesRealize.held habs hslot hout) + (hrecSelf := by + intro arity tail tailRoots htail ih index hentry + cases index with + | zero => simp at hentry + | succ index => + rw [List.getElem?_cons_succ] at hentry + obtain ⟨value, hbound, hslot, hmem, hout⟩ := ih hentry + refine ⟨value, hbound, hslot, hmem, ?_⟩ + simpa using EntriesRealize.recSelf hout) + (h := hreal) + exact hupdate hentry + +/-- Semantic held-entry update. The target root stays in place while the +compiler-side use counter changes, and the selected source/value graph is +exposed for a following retain. -/ +theorem EntriesValueGraph.updateHeldAt {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {store : Store} {Γ : VEnv} + {env : List RVal} {entries : List VEntry} + {sourceEnv : List IxIR0.Value} {roots : List Root} + {i abs remaining : Nat} {uses : Uses} (newRemaining : Nat) + (hreal : EntriesValueGraph funRel recSelfRel store Γ env + entries sourceEnv roots) + (hentry : entries[i]? = some (.slot abs remaining uses true)) : + ∃ source value, + sourceEnv[i]? = some source ∧ + abs < Γ.depth ∧ + env[Γ.rel abs]? = some value ∧ + HasWorld store (worldOfUses uses) value ∧ + Sim.ValueGraph funRel store source value ∧ + ⟨worldOfUses uses, value⟩ ∈ roots ∧ + EntriesValueGraph funRel recSelfRel store Γ env + (entries.set i (.slot abs newRemaining uses true)) + sourceEnv roots := by + have hupdate : + ∀ {index : Nat}, + entries[index]? = some (.slot abs remaining uses true) → + ∃ source value, + sourceEnv[index]? = some source ∧ + abs < Γ.depth ∧ + env[Γ.rel abs]? = some value ∧ + HasWorld store (worldOfUses uses) value ∧ + Sim.ValueGraph funRel store source value ∧ + ⟨worldOfUses uses, value⟩ ∈ roots ∧ + EntriesValueGraph funRel recSelfRel store Γ env + (entries.set index (.slot abs newRemaining uses true)) + sourceEnv roots := by + exact EntriesValueGraph.traverse + (Result := fun current currentSources currentRoots => + ∀ {index : Nat}, + current[index]? = some (.slot abs remaining uses true) → + ∃ source value, + currentSources[index]? = some source ∧ + abs < Γ.depth ∧ + env[Γ.rel abs]? = some value ∧ + HasWorld store (worldOfUses uses) value ∧ + Sim.ValueGraph funRel store source value ∧ + ⟨worldOfUses uses, value⟩ ∈ currentRoots ∧ + EntriesValueGraph funRel recSelfRel store Γ env + (current.set index (.slot abs newRemaining uses true)) + currentSources currentRoots) + (hnil := by + intro index hentry + simp at hentry) + (hreleased := by + intro curAbs curRemaining curUses tail currentSource sources + tailRoots hbound htail ih index hentry + cases index with + | zero => simp at hentry + | succ index => + rw [List.getElem?_cons_succ] at hentry + obtain ⟨source, value, hsource, habs, hslot, hworld, hvalue, + hmem, hout⟩ := ih hentry + refine ⟨source, value, by simpa using hsource, habs, hslot, + hworld, hvalue, hmem, ?_⟩ + simpa using EntriesValueGraph.released hbound hout) + (hheld := by + intro curAbs curRemaining curUses tail currentSource sources + currentValue tailRoots hbound hslot hworld hvalue htail ih + index hentry + cases index with + | zero => + rw [List.getElem?_cons_zero] at hentry + have heqs : curAbs = abs ∧ curRemaining = remaining ∧ + curUses = uses := by simpa using hentry + obtain ⟨rfl, rfl, rfl⟩ := heqs + exact ⟨currentSource, currentValue, rfl, hbound, hslot, + hworld, hvalue, by simp, + (by + simpa using + (EntriesValueGraph.held hbound hslot hworld hvalue htail))⟩ + | succ index => + rw [List.getElem?_cons_succ] at hentry + obtain ⟨source, value, hsource, habs, hselected, hfoundWorld, + hfoundValue, hmem, hout⟩ := ih hentry + refine ⟨source, value, by simpa using hsource, habs, hselected, + hfoundWorld, hfoundValue, List.mem_cons_of_mem _ hmem, ?_⟩ + simpa using + EntriesValueGraph.held hbound hslot hworld hvalue hout) + (hrecSelf := by + intro arity tail currentSource sources tailRoots hself htail ih + index hentry + cases index with + | zero => simp at hentry + | succ index => + rw [List.getElem?_cons_succ] at hentry + obtain ⟨source, value, hsource, habs, hslot, hworld, hvalue, + hmem, hout⟩ := ih hentry + refine ⟨source, value, by simpa using hsource, habs, hslot, + hworld, hvalue, hmem, ?_⟩ + simpa using EntriesValueGraph.recSelf hself hout) + (h := hreal) + exact hupdate hentry + +private theorem perm_extract_root (root : Root) (before after rest : List Root) : + ((before ++ root :: after) ++ rest).Perm + (root :: (before ++ after) ++ rest) := by + induction before with + | nil => rfl + | cons head before ih => + simp only [List.cons_append] + exact (ih.cons head).trans (List.Perm.swap root head _) + +private theorem perm_extract_root_front + (root : Root) (before rest : List Root) : + (before ++ root :: rest).Perm (root :: before ++ rest) := by + induction before with + | nil => rfl + | cons head before ih => + simp only [List.cons_append] + exact (ih.cons head).trans (List.Perm.swap root head _) + +/-- Compile-time environments in which no source slot still owns a value. +This is the condition needed when a function closes its emitter with `ret`. -/ +inductive EntriesReleased : List VEntry → Prop where + | nil : EntriesReleased [] + | slot {abs remaining uses entries} : + EntriesReleased entries → + EntriesReleased (.slot abs remaining uses false :: entries) + | recSelf {arity entries} : + EntriesReleased entries → + EntriesReleased (.recSelf arity :: entries) + +/-- The structural fact needed at a let boundary: the installed source +binder is still the first logical entry and no longer owns its slot. -/ +def FirstEntryReleased (Γ : VEnv) : Prop := + ∃ abs remaining uses tail, + Γ.entries = .slot abs remaining uses false :: tail + +/-- Reachable let-body entry shape: the first logical entry carries exactly +the syntactic use count of the body and is held precisely when that count is +nonzero. This is the compile-state fact needed to justify the lowerer's +post-body `VEnv.pop`. -/ +def FirstEntryTracks (Γ : VEnv) (uses : Uses) (remaining : Nat) : Prop := + ∃ abs tail, + Γ.entries = + .slot abs remaining uses (remaining != 0) :: tail + +/-- Removing a released first logical entry preserves the exact environment +roots. `VEnv.pop` changes no runtime depth or physical stack position. -/ +theorem VEnvRealizes.pop_firstReleased {Γ : VEnv} {env : List RVal} + {roots : List Root} (hfirst : FirstEntryReleased Γ) + (h : VEnvRealizes Γ env roots) : + VEnvRealizes Γ.pop env roots := by + obtain ⟨abs, remaining, uses, tail, hentries⟩ := hfirst + refine ⟨by simpa [VEnv.pop] using h.depth_eq, ?_⟩ + have hreal := h.entries + rw [hentries] at hreal + cases hreal with + | released _ htail => + have htransport := htail.of_depth_eq (Γ := Γ) (Δ := Γ.pop) + (by simp [VEnv.pop]) + simpa [VEnv.pop, hentries] using htransport + +/-- Semantic let-pop counterpart: removing the released leading logical +binder removes exactly the leading source-environment value. Runtime slots, +roots, and all remaining value graphs are unchanged. -/ +theorem VEnvValueGraph.pop_firstReleased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {store : Store} {Γ : VEnv} {source : IxIR0.Value} + {sourceEnv : List IxIR0.Value} {env : List RVal} + {roots : List Root} (hfirst : FirstEntryReleased Γ) + (h : VEnvValueGraph funRel recSelfRel store Γ + (source :: sourceEnv) env roots) : + VEnvValueGraph funRel recSelfRel store Γ.pop sourceEnv env roots := by + obtain ⟨abs, remaining, uses, tail, hentries⟩ := hfirst + refine ⟨by simpa [VEnv.pop] using h.depth_eq, ?_⟩ + have hreal := h.entries + rw [hentries] at hreal + cases hreal with + | released _ htail => + have htransport := htail.of_depth_eq (Γ := Γ) (Δ := Γ.pop) + (by simp [VEnv.pop]) + simpa [VEnv.pop, hentries] using htransport + +theorem EntriesRealize.eq_nil_of_released {Γ : VEnv} {env : List RVal} : + ∀ {entries roots}, EntriesReleased entries → + EntriesRealize Γ env entries roots → roots = [] := by + intro entries roots hreleased hrealize + induction hreleased with + | nil => cases hrealize; rfl + | slot _ ih => + cases hrealize with + | released _ htail => exact ih htail + | recSelf _ ih => + cases hrealize with + | recSelf htail => exact ih htail + +/-! ## Hoare-style continuation semantics -/ + +abbrev StatePred := Store → List RVal → Prop +abbrev ResultPred := Store → RVal → Prop + +/-- Partial-correctness judgment for an IxIR₁ code sequence. -/ +def CodeOwns (ctx : Ctx) (cur : FnDef) (pre : StatePred) + (post : ResultPred) (code : Code) : Prop := + ∀ {fuel store env store' value}, pre store env → + runCode ctx fuel cur store env code = .ok (store', value) → + post store' value + +/-- An emitter is sound from `pre` to `mid` when it transports every +ownership-valid continuation under `mid` back to one under `pre`. -/ +def EmitSound (ctx : Ctx) (cur : FnDef) (emit : Emit) + (pre mid : StatePred) : Prop := + ∀ (post : ResultPred) (code : Code), + CodeOwns ctx cur mid post code → + CodeOwns ctx cur pre post (emit code) + +/-- One operation's state-transformer judgment. The operation result is +prepended to the runtime environment exactly as `Code.letOp` specifies. -/ +def OpSound (ctx : Ctx) (cur : FnDef) (op : Op) + (pre post : StatePred) : Prop := + ∀ {fuel store env store' value}, pre store env → + runOp ctx fuel cur store env op = .ok (store', value) → + post store' (value :: env) + +/-- `CodeOwns` restricted to evaluator indices through `limit`. The outer +`runCode` step lowers every operation and continuation to a strictly smaller +index, so this judgment can cover the exact index being sealed while consuming +only operation/callee contracts below it. -/ +def CodeOwnsBelow (ctx : Ctx) (cur : FnDef) (limit : Nat) + (pre : StatePred) (post : ResultPred) (code : Code) : Prop := + ∀ {fuel store env store' value}, fuel ≤ limit → pre store env → + runCode ctx fuel cur store env code = .ok (store', value) → + post store' value + +/-- Fuel-bounded emitter soundness. Keeping the same +continuation-transformer shape as `EmitSound` preserves composition. -/ +def EmitSoundBelow (ctx : Ctx) (cur : FnDef) (limit : Nat) + (emit : Emit) (pre mid : StatePred) : Prop := + ∀ bound, bound ≤ limit → ∀ (post : ResultPred) (code : Code), + CodeOwnsBelow ctx cur bound mid post code → + CodeOwnsBelow ctx cur bound pre post (emit code) + +/-- One operation's state-transformer judgment below a fuel bound. -/ +def OpSoundBelow (ctx : Ctx) (cur : FnDef) (limit : Nat) (op : Op) + (pre post : StatePred) : Prop := + ∀ {fuel store env store' value}, fuel < limit → pre store env → + runOp ctx fuel cur store env op = .ok (store', value) → + post store' (value :: env) + +private theorem bindOk {error α β : Type} (value : α) + (next : α → Except error β) : + (Except.ok value >>= next) = next value := rfl + +private theorem estateBindRun {error state α β : Type} + (action : EStateM error state α) (next : α → EStateM error state β) + (initial : state) : + (action >>= next).run initial = + match action.run initial with + | .ok value nextState => (next value).run nextState + | .error err nextState => .error err nextState := rfl + +private theorem estatePureRun {error state α : Type} + (value : α) (initial : state) : + (pure value : EStateM error state α).run initial = + .ok value initial := rfl + +private theorem estateThrowRun_not_ok {error state α : Type} + {err : error} {initial final : state} {value : α} + (h : (throw err : EStateM error state α).run initial = + .ok value final) : False := by + change EStateM.Result.error err initial = .ok value final at h + contradiction + +/-- A successful declared-result world check certifies exact agreement and +leaves the lowering state unchanged. -/ +theorem requireResultWorld_run_ok_inv + {actual demand : Owned} {initial final : LowSt} + (hrun : (requireResultWorld actual demand).run initial = + .ok () final) : actual = demand ∧ initial = final := by + have hssEq : (Owned.shared == Owned.shared) = true := by decide + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + have husEq : (Owned.unique == Owned.shared) = false := by decide + cases actual <;> cases demand <;> + simp [requireResultWorld, hssEq, huuEq, hsuEq, husEq] at hrun ⊢ + all_goals assumption + +/-- Successful state-monad bind inversion, used to recover the two recursive +compiler runs from a successful `do` block. -/ +private theorem estateBindRun_ok_inv {error state α β : Type} + {action : EStateM error state α} {next : α → EStateM error state β} + {initial final : state} {result : β} + (h : (action >>= next).run initial = .ok result final) : + ∃ value middle, + action.run initial = .ok value middle ∧ + (next value).run middle = .ok result final := by + rw [estateBindRun] at h + cases haction : action.run initial with + | ok value middle => + rw [haction] at h + exact ⟨value, middle, rfl, h⟩ + | error err middle => + rw [haction] at h + contradiction + +theorem EmitSound.id {ctx : Ctx} {cur : FnDef} {pre : StatePred} : + EmitSound ctx cur (_root_.id : Emit) pre pre := by + intro post code hcode fuel store env store' value hpre hrun + exact hcode hpre hrun + +theorem EmitSound.strengthen {ctx : Ctx} {cur : FnDef} + {pre mid : StatePred} + (himp : ∀ {store env}, pre store env → mid store env) : + EmitSound ctx cur (_root_.id : Emit) pre mid := by + intro post code hcode fuel store env store' value hpre hrun + exact hcode (himp hpre) hrun + +theorem EmitSound.comp {ctx : Ctx} {cur : FnDef} {emit₁ emit₂ : Emit} + {pre mid post : StatePred} + (h₁ : EmitSound ctx cur emit₁ pre mid) + (h₂ : EmitSound ctx cur emit₂ mid post) : + EmitSound ctx cur (emit₁ ∘ emit₂) pre post := by + intro result code hcode + exact h₁ result (emit₂ code) (h₂ result code hcode) + +/-- An emitter whose precondition no execution can satisfy transports every +postcondition. Vacuous compiler branches use this to skip the remainder of +their emitted sequence once one operation is known to fail. -/ +theorem EmitSound.ofFalse {ctx : Ctx} {cur : FnDef} {emit : Emit} + {mid : StatePred} : + EmitSound ctx cur emit (fun _ _ => False) mid := by + intro post code hcode fuel store env store' value hpre hrun + exact hpre.elim + +/-- An emitter proved to reach an unsatisfiable midpoint reaches any +midpoint. This is the terminal step of a vacuous branch, where the emitted +code is exactly the prefix already shown to fail. -/ +theorem EmitSound.ofFalseMid {ctx : Ctx} {cur : FnDef} {emit : Emit} + {pre mid : StatePred} + (hfalse : EmitSound ctx cur emit pre (fun _ _ => False)) : + EmitSound ctx cur emit pre mid := by + intro post code _ + exact hfalse post code (fun hpre _ => hpre.elim) + +/-- Unbounded code ownership restricts to any fuel prefix. -/ +theorem CodeOwns.below {ctx : Ctx} {cur : FnDef} {pre : StatePred} + {post : ResultPred} {code : Code} + (hcode : CodeOwns ctx cur pre post code) (limit : Nat) : + CodeOwnsBelow ctx cur limit pre post code := by + intro fuel store env store' value _ hpre hrun + exact hcode hpre hrun + +/-- Unbounded operation soundness restricts to any fuel prefix. -/ +theorem OpSound.below {ctx : Ctx} {cur : FnDef} {op : Op} + {pre post : StatePred} + (hop : OpSound ctx cur op pre post) (limit : Nat) : + OpSoundBelow ctx cur limit op pre post := by + intro fuel store env store' value _ hpre hrun + exact hop hpre hrun + +theorem EmitSoundBelow.id {ctx : Ctx} {cur : FnDef} {limit : Nat} + {pre : StatePred} : + EmitSoundBelow ctx cur limit (_root_.id : Emit) pre pre := by + intro bound _ post code hcode + exact hcode + +theorem EmitSoundBelow.strengthen {ctx : Ctx} {cur : FnDef} + {limit : Nat} {pre mid : StatePred} + (himp : ∀ {store env}, pre store env → mid store env) : + EmitSoundBelow ctx cur limit (_root_.id : Emit) pre mid := by + intro bound _ post code hcode fuel store env store' value hfuel hpre hrun + exact hcode hfuel (himp hpre) hrun + +theorem EmitSoundBelow.comp {ctx : Ctx} {cur : FnDef} {limit : Nat} + {emit₁ emit₂ : Emit} {pre mid post : StatePred} + (h₁ : EmitSoundBelow ctx cur limit emit₁ pre mid) + (h₂ : EmitSoundBelow ctx cur limit emit₂ mid post) : + EmitSoundBelow ctx cur limit (emit₁ ∘ emit₂) pre post := by + intro bound hbound result code hcode + exact h₁ bound hbound result (emit₂ code) + (h₂ bound hbound result code hcode) + +theorem EmitSoundBelow.ofFalse {ctx : Ctx} {cur : FnDef} + {limit : Nat} {emit : Emit} {mid : StatePred} : + EmitSoundBelow ctx cur limit emit (fun _ _ => False) mid := by + intro bound hbound post code hcode fuel store env store' value hfuel + hpre hrun + exact hpre.elim + +theorem EmitSoundBelow.ofFalseMid {ctx : Ctx} {cur : FnDef} + {limit : Nat} {emit : Emit} {pre mid : StatePred} + (hfalse : EmitSoundBelow ctx cur limit emit pre (fun _ _ => False)) : + EmitSoundBelow ctx cur limit emit pre mid := by + intro bound hbound post code hcode + exact hfalse bound hbound post code (by + intro fuel store env store' value hfuel hpre hrun + exact hpre.elim) + +/-- Closing a bounded emitter proof at every evaluator limit recovers the +unbounded judgment. This is the bridge used to keep one bounded compiler +induction and expose the legacy exact interface only at its boundary. -/ +theorem EmitSound.of_below {ctx : Ctx} {cur : FnDef} {emit : Emit} + {pre mid : StatePred} + (hsound : ∀ limit, EmitSoundBelow ctx cur limit emit pre mid) : + EmitSound ctx cur emit pre mid := by + intro post code hcode fuel store env store' value hpre hrun + have hbounded : CodeOwnsBelow ctx cur fuel mid post code := + hcode.below fuel + exact hsound fuel fuel (Nat.le_refl fuel) post code hbounded + (Nat.le_refl fuel) hpre hrun + +/-- Closing bounded operation soundness at every evaluator limit recovers the +unbounded operation judgment. -/ +theorem OpSound.of_below {ctx : Ctx} {cur : FnDef} {op : Op} + {pre post : StatePred} + (hsound : ∀ limit, OpSoundBelow ctx cur limit op pre post) : + OpSound ctx cur op pre post := by + intro fuel store env store' value hpre hrun + exact hsound fuel.succ (Nat.lt_succ_self fuel) hpre hrun + +/-- Lift one bounded operation through `Code.letOp`. Both the operation and +its continuation run at the predecessor of the enclosing code fuel, hence +remain below the same bound. -/ +theorem OpSoundBelow.emit {ctx : Ctx} {cur : FnDef} {limit : Nat} + {op : Op} {pre post : StatePred} + (hop : OpSoundBelow ctx cur limit op pre post) : + EmitSoundBelow ctx cur limit (emitOp op) pre post := by + intro bound hbound result code hcode fuel store env finalStore finalValue + hfuel hpre hrun + cases fuel with + | zero => simp [runCode] at hrun + | succ fuel => + have hinner : fuel < bound := + Nat.lt_of_lt_of_le (Nat.lt_succ_self fuel) hfuel + have hinnerLimit : fuel < limit := Nat.lt_of_lt_of_le hinner hbound + rw [runCode.eq_def] at hrun + dsimp only [emitOp] at hrun + cases hopEval : runOp ctx fuel cur store env op with + | error err => + rw [hopEval] at hrun + change (Except.error err : Except Err (Store × RVal)) = + .ok (finalStore, finalValue) at hrun + contradiction + | ok out => + rcases out with ⟨store', value⟩ + rw [hopEval] at hrun + change runCode ctx fuel cur store' (value :: env) code = + .ok (finalStore, finalValue) at hrun + exact hcode (Nat.le_of_lt hinner) (hop hinnerLimit hpre hopEval) hrun + +theorem OpSound.emit {ctx : Ctx} {cur : FnDef} {op : Op} + {pre post : StatePred} (hop : OpSound ctx cur op pre post) : + EmitSound ctx cur (emitOp op) pre post := by + intro result code hcode fuel store env finalStore finalValue hpre hrun + cases fuel with + | zero => simp [runCode] at hrun + | succ fuel => + rw [runCode.eq_def] at hrun + dsimp only [emitOp] at hrun + cases hopEval : runOp ctx fuel cur store env op with + | error err => + rw [hopEval] at hrun + change (Except.error err : Except Err (Store × RVal)) = + .ok (finalStore, finalValue) at hrun + contradiction + | ok out => + rcases out with ⟨store', value⟩ + rw [hopEval] at hrun + change runCode ctx fuel cur store' (value :: env) code = + .ok (finalStore, finalValue) at hrun + exact hcode (hop hpre hopEval) hrun + +/-! ## Emitter rules backed by the exact evaluator interfaces -/ + +/-- A state after one operation has pushed a physical environment slot while +leaving the stated logical roots. The pushed value itself is ownership-inert +or has already been accounted for elsewhere. -/ +def OwnsAfterPush (frame : List RVal → Prop) (roots : List Root) : StatePred := + fun store env' => ∃ value env, + env' = value :: env ∧ frame env ∧ RootOwnership store roots + +/-- A stronger pushed-state predicate in which the new value is exactly one +owned root. -/ +def OwnsPushedRoot (frame : List RVal → Prop) (world : Owned) + (rest : List Root) : StatePred := + fun store env' => ∃ value env, + env' = value :: env ∧ frame env ∧ + RootOwnership store (⟨world, value⟩ :: rest) + +/-- The pushed operation result is a borrow, not a new owner. -/ +def BorrowsPushed (frame : List RVal → Prop) (world : Owned) + (roots : List Root) : StatePred := + fun store env' => ∃ value env, + env' = value :: env ∧ frame env ∧ HasWorld store world value ∧ + RootOwnership store roots + +private theorem emit_pure_scalar_owned_at {ctx : Ctx} {cur : FnDef} + {limit : Nat} {frame : List RVal → Prop} {atom : Atom} + {value : RVal} {world : Owned} {rest : List Root} + (hnone : rvalLocation? value = none) : + EmitSoundBelow ctx cur limit (emitOp (.pure atom)) + (fun store env => frame env ∧ resolveAtom env atom = .ok value ∧ + RootOwnership store rest) + (OwnsPushedRoot frame world rest) := by + apply OpSoundBelow.emit + intro fuel store env store' result _ hpre hrun + obtain ⟨hframe, hresolve, hown⟩ := hpre + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + have hop := runOp_pure_scalar_owned (ctx := ctx) (cur := cur) + (fuel := fuel) (world := world) (roots := rest) + hresolve hnone hown + have hpair : (store, value) = (store', result) := + Except.ok.inj (hop.1.symm.trans hrun) + cases hpair + exact ⟨value, env, rfl, hframe, hop.2⟩ + +theorem emit_pure_scalar_owned {ctx : Ctx} {cur : FnDef} + {frame : List RVal → Prop} {atom : Atom} {value : RVal} + {world : Owned} {rest : List Root} + (hnone : rvalLocation? value = none) : + EmitSound ctx cur (emitOp (.pure atom)) + (fun store env => frame env ∧ resolveAtom env atom = .ok value ∧ + RootOwnership store rest) + (OwnsPushedRoot frame world rest) := by + exact EmitSound.of_below fun limit => + emit_pure_scalar_owned_at (limit := limit) hnone + +/-- Fuel-bounded scalar materialization. -/ +theorem emit_pure_scalar_owned_below {ctx : Ctx} {cur : FnDef} + {limit : Nat} {frame : List RVal → Prop} {atom : Atom} + {value : RVal} {world : Owned} {rest : List Root} + (hnone : rvalLocation? value = none) : + EmitSoundBelow ctx cur limit (emitOp (.pure atom)) + (fun store env => frame env ∧ resolveAtom env atom = .ok value ∧ + RootOwnership store rest) + (OwnsPushedRoot frame world rest) := by + exact emit_pure_scalar_owned_at hnone + +private theorem emit_alloc_owned_at {ctx : Ctx} {cur : FnDef} + {limit : Nat} {frame : List RVal → Prop} {world : Owned} + {cid : CtorId} {atoms : Array Atom} {values : List RVal} + {rest : List Root} : + EmitSoundBelow ctx cur limit (emitOp (.alloc world cid atoms)) + (fun store env => frame env ∧ resolveAtoms env atoms = .ok values ∧ + RootOwnership store (rootsFor world values ++ rest)) + (OwnsPushedRoot frame world rest) := by + apply OpSoundBelow.emit + intro fuel store env store' result _ hpre hrun + obtain ⟨hframe, hresolve, hown⟩ := hpre + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + have hop := runOp_alloc_owned (ctx := ctx) (cur := cur) + (fuel := fuel) (cid := cid) (args := atoms) (values := values) + (rest := rest) hresolve hown + have hpair : + ((store.allocNode world (.ctorN cid values.toArray)).1, + .loc (store.allocNode world (.ctorN cid values.toArray)).2) = + (store', result) := by + exact Except.ok.inj (hop.1.symm.trans hrun) + have hstore := congrArg Prod.fst hpair + have hresult := congrArg Prod.snd hpair + dsimp only at hstore hresult + subst store' + subst result + exact ⟨.loc (store.allocNode world (.ctorN cid values.toArray)).2, + env, rfl, hframe, hop.2⟩ + +theorem emit_alloc_owned {ctx : Ctx} {cur : FnDef} + {frame : List RVal → Prop} {world : Owned} {cid : CtorId} + {atoms : Array Atom} {values : List RVal} {rest : List Root} : + EmitSound ctx cur (emitOp (.alloc world cid atoms)) + (fun store env => frame env ∧ resolveAtoms env atoms = .ok values ∧ + RootOwnership store (rootsFor world values ++ rest)) + (OwnsPushedRoot frame world rest) := by + exact EmitSound.of_below fun limit => + emit_alloc_owned_at (limit := limit) + +/-- Fuel-bounded constructor allocation. -/ +theorem emit_alloc_owned_below {ctx : Ctx} {cur : FnDef} + {limit : Nat} {frame : List RVal → Prop} {world : Owned} + {cid : CtorId} {atoms : Array Atom} {values : List RVal} + {rest : List Root} : + EmitSoundBelow ctx cur limit (emitOp (.alloc world cid atoms)) + (fun store env => frame env ∧ resolveAtoms env atoms = .ok values ∧ + RootOwnership store (rootsFor world values ++ rest)) + (OwnsPushedRoot frame world rest) := by + exact emit_alloc_owned_at + +/-- Partial application packages a shared argument prefix into one fresh +shared pap root. -/ +private theorem emit_papp_owned_at {ctx : Ctx} {cur : FnDef} + {limit : Nat} {f : Ixon.Address} {d : Decl} + {frame : List RVal → Prop} {atoms : Array Atom} + {values : List RVal} {rest : List Root} + (hdecl : ctx.decls f = some d) + (hunder : values.length < declArity d) : + EmitSoundBelow ctx cur limit (emitOp (.papp f atoms)) + (fun store env => frame env ∧ resolveAtoms env atoms = .ok values ∧ + RootOwnership store (rootsFor .shared values ++ rest)) + (OwnsPushedRoot frame .shared rest) := by + apply OpSoundBelow.emit + intro fuel store env store' result _ hpre hrun + obtain ⟨hframe, hresolve, hown⟩ := hpre + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + have hop := runOp_papp_owned (ctx := ctx) (cur := cur) + (fuel := fuel) hresolve hdecl hunder hown + have hpair : + ((store.allocNode .shared + (.papN f (declArity d) values.toArray)).1, + .loc (store.allocNode .shared + (.papN f (declArity d) values.toArray)).2) = + (store', result) := Except.ok.inj (hop.1.symm.trans hrun) + cases hpair + exact ⟨.loc (store.allocNode .shared + (.papN f (declArity d) values.toArray)).2, + env, rfl, hframe, hop.2⟩ + +theorem emit_papp_owned {ctx : Ctx} {cur : FnDef} {f : Ixon.Address} + {d : Decl} {frame : List RVal → Prop} {atoms : Array Atom} + {values : List RVal} {rest : List Root} + (hdecl : ctx.decls f = some d) + (hunder : values.length < declArity d) : + EmitSound ctx cur (emitOp (.papp f atoms)) + (fun store env => frame env ∧ resolveAtoms env atoms = .ok values ∧ + RootOwnership store (rootsFor .shared values ++ rest)) + (OwnsPushedRoot frame .shared rest) := by + exact EmitSound.of_below fun limit => + emit_papp_owned_at (limit := limit) hdecl hunder + +/-- Fuel-bounded partial-application allocation. -/ +theorem emit_papp_owned_below {ctx : Ctx} {cur : FnDef} + {limit : Nat} {f : Ixon.Address} {d : Decl} + {frame : List RVal → Prop} {atoms : Array Atom} + {values : List RVal} {rest : List Root} + (hdecl : ctx.decls f = some d) + (hunder : values.length < declArity d) : + EmitSoundBelow ctx cur limit (emitOp (.papp f atoms)) + (fun store env => frame env ∧ resolveAtoms env atoms = .ok values ∧ + RootOwnership store (rootsFor .shared values ++ rest)) + (OwnsPushedRoot frame .shared rest) := by + exact emit_papp_owned_at hdecl hunder + +private theorem emit_retain_borrowed_at {ctx : Ctx} {cur : FnDef} + {limit : Nat} {frame : List RVal → Prop} {atom : Atom} + {value : RVal} {rest : List Root} : + EmitSoundBelow ctx cur limit (emitOp (.dup atom)) + (fun store env => frame env ∧ resolveAtom env atom = .ok value ∧ + HasWorld store .shared value ∧ RootOwnership store rest) + (OwnsPushedRoot frame .shared rest) := by + apply OpSoundBelow.emit + intro fuel store env store' result _ hpre hrun + obtain ⟨hframe, hresolve, hworld, hown⟩ := hpre + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + obtain ⟨middle, heval, hmiddle⟩ := + runOp_retain_borrowed (ctx := ctx) (cur := cur) (fuel := fuel) + hresolve hworld hown + have hpair : (middle, value) = (store', result) := + Except.ok.inj (heval.symm.trans hrun) + cases hpair + exact ⟨value, env, rfl, hframe, hmiddle⟩ + +theorem emit_retain_borrowed {ctx : Ctx} {cur : FnDef} + {frame : List RVal → Prop} {atom : Atom} {value : RVal} + {rest : List Root} : + EmitSound ctx cur (emitOp (.dup atom)) + (fun store env => frame env ∧ resolveAtom env atom = .ok value ∧ + HasWorld store .shared value ∧ RootOwnership store rest) + (OwnsPushedRoot frame .shared rest) := by + exact EmitSound.of_below fun limit => + emit_retain_borrowed_at (limit := limit) + +/-- Fuel-bounded counterpart of `emit_retain_borrowed`. Retain itself is +call-free, so the only fuel obligation is the enclosing operation bound. -/ +theorem emit_retain_borrowed_below {ctx : Ctx} {cur : FnDef} + {limit : Nat} {frame : List RVal → Prop} {atom : Atom} + {value : RVal} {rest : List Root} : + EmitSoundBelow ctx cur limit (emitOp (.dup atom)) + (fun store env => frame env ∧ resolveAtom env atom = .ok value ∧ + HasWorld store .shared value ∧ RootOwnership store rest) + (OwnsPushedRoot frame .shared rest) := by + exact emit_retain_borrowed_at + +/-- A known direct call plugs the declaration contract into the emitter +induction: argument roots disappear, the declared result root is pushed, and +the caller's continuation roots remain exact. -/ +private theorem emit_call_owned_at {ctx : Ctx} {cur d : FnDef} + {limit : Nat} {f : Ixon.Address} {frame : List RVal → Prop} + {atoms : Array Atom} {args : List RVal} {argWorlds : List Owned} + {rest : List Root} + (hdecl : ctx.decls f = some (.fn d)) + (hcontract : FnOwnershipContractBelow ctx d argWorlds limit) : + EmitSoundBelow ctx cur limit (emitOp (.call f atoms)) + (fun store env => frame env ∧ resolveAtoms env atoms = .ok args ∧ + RootOwnership store (rootsForWorlds argWorlds args ++ rest)) + (OwnsPushedRoot frame d.result rest) := by + apply OpSoundBelow.emit + intro opFuel store env store' result hopFuel hpre hrun + obtain ⟨hframe, hargs, hown⟩ := hpre + cases opFuel with + | zero => simp [runOp] at hrun + | succ fuel => + have hcallee : FnOwnershipContractBelow ctx d argWorlds fuel := + hcontract.mono (by omega) + have hresult := runOp_call_owned_below (ctx := ctx) (cur := cur) + (fuel := fuel) hargs hdecl hcallee hown hrun + exact ⟨result, env, rfl, hframe, hresult⟩ + +theorem emit_call_owned {ctx : Ctx} {cur d : FnDef} {f : Ixon.Address} + {frame : List RVal → Prop} {atoms : Array Atom} {args : List RVal} + {argWorlds : List Owned} {rest : List Root} + (hdecl : ctx.decls f = some (.fn d)) + (hcontract : FnOwnershipContract ctx d argWorlds) : + EmitSound ctx cur (emitOp (.call f atoms)) + (fun store env => frame env ∧ resolveAtoms env atoms = .ok args ∧ + RootOwnership store (rootsForWorlds argWorlds args ++ rest)) + (OwnsPushedRoot frame d.result rest) := by + exact EmitSound.of_below fun limit => + emit_call_owned_at hdecl (hcontract.below limit) + +/-- Recursive self-call counterpart of `emit_call_owned`. The current +function's contract consumes the argument prefix and supplies one root in +its declared result world. -/ +private theorem emit_callSelf_owned_at {ctx : Ctx} {cur : FnDef} + {limit : Nat} {frame : List RVal → Prop} {atoms : Array Atom} + {args : List RVal} {argWorlds : List Owned} {rest : List Root} + (hcontract : FnOwnershipContractBelow ctx cur argWorlds limit) : + EmitSoundBelow ctx cur limit (emitOp (.callSelf atoms)) + (fun store env => frame env ∧ resolveAtoms env atoms = .ok args ∧ + RootOwnership store (rootsForWorlds argWorlds args ++ rest)) + (OwnsPushedRoot frame cur.result rest) := by + apply OpSoundBelow.emit + intro opFuel store env store' result hopFuel hpre hrun + obtain ⟨hframe, hargs, hown⟩ := hpre + cases opFuel with + | zero => simp [runOp] at hrun + | succ fuel => + have hself : FnOwnershipContractBelow ctx cur argWorlds (fuel + 1) := + hcontract.mono (Nat.le_of_lt hopFuel) + have hresult := runOp_callSelf_owned_below (ctx := ctx) (cur := cur) + (fuel := fuel) hargs hself hown hrun + exact ⟨result, env, rfl, hframe, hresult⟩ + +theorem emit_callSelf_owned {ctx : Ctx} {cur : FnDef} + {frame : List RVal → Prop} {atoms : Array Atom} {args : List RVal} + {argWorlds : List Owned} {rest : List Root} + (hcontract : FnOwnershipContract ctx cur argWorlds) : + EmitSound ctx cur (emitOp (.callSelf atoms)) + (fun store env => frame env ∧ resolveAtoms env atoms = .ok args ∧ + RootOwnership store (rootsForWorlds argWorlds args ++ rest)) + (OwnsPushedRoot frame cur.result rest) := by + exact EmitSound.of_below fun limit => + emit_callSelf_owned_at (hcontract.below limit) + +/-- Successful scalar-only extern calls consume their inert shared argument +roots and push one scalar result root at the caller's demanded world. -/ +private theorem emit_extern_owned_at {ctx : Ctx} {cur : FnDef} + {limit : Nat} {f : Ixon.Address} {frame : List RVal → Prop} + {atoms : Array Atom} {args : List RVal} {resultWorld : Owned} + {rest : List Root} : + EmitSoundBelow ctx cur limit (emitOp (.extern f atoms)) + (fun store env => frame env ∧ resolveAtoms env atoms = .ok args ∧ + RootOwnership store (rootsFor .shared args ++ rest)) + (OwnsPushedRoot frame resultWorld rest) := by + apply OpSoundBelow.emit + intro fuel store env store' result _ hpre hrun + obtain ⟨hframe, hargs, hown⟩ := hpre + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + have hresult := runOp_extern_owned (ctx := ctx) (cur := cur) + (fuel := fuel) (resultWorld := resultWorld) hargs hown hrun + exact ⟨result, env, rfl, hframe, hresult⟩ + +theorem emit_extern_owned {ctx : Ctx} {cur : FnDef} {f : Ixon.Address} + {frame : List RVal → Prop} {atoms : Array Atom} {args : List RVal} + {resultWorld : Owned} {rest : List Root} : + EmitSound ctx cur (emitOp (.extern f atoms)) + (fun store env => frame env ∧ resolveAtoms env atoms = .ok args ∧ + RootOwnership store (rootsFor .shared args ++ rest)) + (OwnsPushedRoot frame resultWorld rest) := by + exact EmitSound.of_below fun limit => + emit_extern_owned_at (limit := limit) + +/-- Fuel-bounded scalar-only extern operation. -/ +theorem emit_extern_owned_below {ctx : Ctx} {cur : FnDef} + {limit : Nat} {f : Ixon.Address} {frame : List RVal → Prop} + {atoms : Array Atom} {args : List RVal} {resultWorld : Owned} + {rest : List Root} : + EmitSoundBelow ctx cur limit (emitOp (.extern f atoms)) + (fun store env => frame env ∧ resolveAtoms env atoms = .ok args ∧ + RootOwnership store (rootsFor .shared args ++ rest)) + (OwnsPushedRoot frame resultWorld rest) := by + exact emit_extern_owned_at + +/-- Unknown application consumes the shared pap/function root together with +all supplied shared argument roots. Pap saturation and recursive +over-application are encapsulated by the context's callable contract. -/ +private theorem emit_apply_owned_at {ctx : Ctx} {cur : FnDef} + {limit : Nat} {frame : List RVal → Prop} + {functionAtom : Atom} {function : RVal} {atoms : Array Atom} + {args : List RVal} {rest : List Root} + (hcontract : ApplyOwnershipContractBelow ctx limit) : + EmitSoundBelow ctx cur limit (emitOp (.apply functionAtom atoms)) + (fun store env => frame env ∧ + resolveAtom env functionAtom = .ok function ∧ + resolveAtoms env atoms = .ok args ∧ + RootOwnership store + (⟨.shared, function⟩ :: rootsFor .shared args ++ rest)) + (OwnsPushedRoot frame .shared rest) := by + apply OpSoundBelow.emit + intro opFuel store env store' result hopFuel hpre hrun + obtain ⟨hframe, hfunction, hargs, hown⟩ := hpre + cases opFuel with + | zero => simp [runOp] at hrun + | succ fuel => + have happly : ApplyOwnershipContractBelow ctx (fuel + 1) := + hcontract.mono (Nat.le_of_lt hopFuel) + have hresult := runOp_apply_owned_below (ctx := ctx) (cur := cur) + (fuel := fuel) hfunction hargs happly hown hrun + exact ⟨result, env, rfl, hframe, hresult⟩ + +theorem emit_apply_owned {ctx : Ctx} {cur : FnDef} + {frame : List RVal → Prop} {functionAtom : Atom} {function : RVal} + {atoms : Array Atom} {args : List RVal} {rest : List Root} + (hcontract : ApplyOwnershipContract ctx) : + EmitSound ctx cur (emitOp (.apply functionAtom atoms)) + (fun store env => frame env ∧ + resolveAtom env functionAtom = .ok function ∧ + resolveAtoms env atoms = .ok args ∧ + RootOwnership store + (⟨.shared, function⟩ :: rootsFor .shared args ++ rest)) + (OwnsPushedRoot frame .shared rest) := by + exact EmitSound.of_below fun limit => + emit_apply_owned_at (hcontract.below limit) + +/-- Bounded direct-call emitter rule for the mutual compiler induction. -/ +theorem emit_call_owned_below {ctx : Ctx} {cur d : FnDef} + {limit : Nat} {f : Ixon.Address} {frame : List RVal → Prop} + {atoms : Array Atom} {args : List RVal} {argWorlds : List Owned} + {rest : List Root} + (hdecl : ctx.decls f = some (.fn d)) + (hcontract : FnOwnershipContractBelow ctx d argWorlds limit) : + EmitSoundBelow ctx cur limit (emitOp (.call f atoms)) + (fun store env => frame env ∧ resolveAtoms env atoms = .ok args ∧ + RootOwnership store (rootsForWorlds argWorlds args ++ rest)) + (OwnsPushedRoot frame d.result rest) := by + exact emit_call_owned_at hdecl hcontract + +/-- Bounded recursive-self emitter rule. Only the strictly smaller body +contract exposed by the enclosing fuel prefix is consumed. -/ +theorem emit_callSelf_owned_below {ctx : Ctx} {cur : FnDef} + {limit : Nat} {frame : List RVal → Prop} {atoms : Array Atom} + {args : List RVal} {argWorlds : List Owned} {rest : List Root} + (hcontract : FnOwnershipContractBelow ctx cur argWorlds limit) : + EmitSoundBelow ctx cur limit (emitOp (.callSelf atoms)) + (fun store env => frame env ∧ resolveAtoms env atoms = .ok args ∧ + RootOwnership store (rootsForWorlds argWorlds args ++ rest)) + (OwnsPushedRoot frame cur.result rest) := by + exact emit_callSelf_owned_at hcontract + +/-- Bounded unknown-application emitter rule. Saturation and +over-application recurse only through the smaller application prefix. -/ +theorem emit_apply_owned_below {ctx : Ctx} {cur : FnDef} + {limit : Nat} {frame : List RVal → Prop} + {functionAtom : Atom} {function : RVal} {atoms : Array Atom} + {args : List RVal} {rest : List Root} + (hcontract : ApplyOwnershipContractBelow ctx limit) : + EmitSoundBelow ctx cur limit (emitOp (.apply functionAtom atoms)) + (fun store env => frame env ∧ + resolveAtom env functionAtom = .ok function ∧ + resolveAtoms env atoms = .ok args ∧ + RootOwnership store + (⟨.shared, function⟩ :: rootsFor .shared args ++ rest)) + (OwnsPushedRoot frame .shared rest) := by + exact emit_apply_owned_at hcontract + +/-- Dropping a shared value consumes its logical root whether the resolved +value is a location or an ownership-inert scalar. This is the generic rule +needed by `releaseAll`, whose slot descriptors may hold either kind. -/ +private theorem emit_drop_value_owned_at {ctx : Ctx} {cur : FnDef} + {limit : Nat} {frame : List RVal → Prop} {target : Atom} {value : RVal} + {rest : List Root} : + EmitSoundBelow ctx cur limit (emitOp (.drop target)) + (fun store env => frame env ∧ + resolveAtom env target = .ok value ∧ + RootOwnership store (⟨.shared, value⟩ :: rest)) + (OwnsAfterPush frame rest) := by + apply OpSoundBelow.emit + intro fuel store env store' result _ hpre hrun + obtain ⟨hframe, hresolve, hown⟩ := hpre + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [hresolve, bindOk] at hrun + cases value with + | lit literal => + change (Except.ok (store, RVal.erased) : + Except Err (Store × RVal)) = .ok (store', result) at hrun + have hpair : (store, RVal.erased) = (store', result) := + Except.ok.inj hrun + cases hpair + exact ⟨.erased, env, rfl, hframe, + hown.dropNoLocation (by rfl)⟩ + | erased => + change (Except.ok (store, RVal.erased) : + Except Err (Store × RVal)) = .ok (store', result) at hrun + have hpair : (store, RVal.erased) = (store', result) := + Except.ok.inj hrun + cases hpair + exact ⟨.erased, env, rfl, hframe, + hown.dropNoLocation (by rfl)⟩ + | loc loc => + dsimp only at hrun + cases hdrop : dropVal ctx fuel store (.loc loc) with + | error err => + rw [hdrop] at hrun + change (Except.error err : Except Err (Store × RVal)) = + .ok (store', result) at hrun + contradiction + | ok dropped => + rw [hdrop] at hrun + change (Except.ok (dropped, RVal.erased) : + Except Err (Store × RVal)) = .ok (store', result) at hrun + have hpair : (dropped, RVal.erased) = (store', result) := + Except.ok.inj hrun + cases hpair + exact ⟨.erased, env, rfl, hframe, + dropVal_preserves hown hdrop⟩ + +theorem emit_drop_value_owned {ctx : Ctx} {cur : FnDef} + {frame : List RVal → Prop} {target : Atom} {value : RVal} + {rest : List Root} : + EmitSound ctx cur (emitOp (.drop target)) + (fun store env => frame env ∧ + resolveAtom env target = .ok value ∧ + RootOwnership store (⟨.shared, value⟩ :: rest)) + (OwnsAfterPush frame rest) := by + exact EmitSound.of_below fun limit => + emit_drop_value_owned_at (limit := limit) + +/-- Fuel-bounded shared release for a value of arbitrary runtime shape. -/ +theorem emit_drop_value_owned_below {ctx : Ctx} {cur : FnDef} + {limit : Nat} {frame : List RVal → Prop} {target : Atom} + {value : RVal} {rest : List Root} : + EmitSoundBelow ctx cur limit (emitOp (.drop target)) + (fun store env => frame env ∧ + resolveAtom env target = .ok value ∧ + RootOwnership store (⟨.shared, value⟩ :: rest)) + (OwnsAfterPush frame rest) := by + exact emit_drop_value_owned_at + +theorem emit_drop_owned {ctx : Ctx} {cur : FnDef} + {frame : List RVal → Prop} {target : Atom} {loc : Nat} + {rest : List Root} : + EmitSound ctx cur (emitOp (.drop target)) + (fun store env => frame env ∧ + resolveAtom env target = .ok (.loc loc) ∧ + RootOwnership store (⟨.shared, .loc loc⟩ :: rest)) + (OwnsAfterPush frame rest) := by + apply OpSound.emit + intro fuel store env store' result hpre hrun + obtain ⟨hframe, hresolve, hown⟩ := hpre + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [hresolve, bindOk] at hrun + dsimp only at hrun + cases hdrop : dropVal ctx fuel store (.loc loc) with + | error err => + rw [hdrop] at hrun + change (Except.error err : Except Err (Store × RVal)) = + .ok (store', result) at hrun + contradiction + | ok dropped => + rw [hdrop] at hrun + change (Except.ok (dropped, .erased) : Except Err (Store × RVal)) = + .ok (store', result) at hrun + have hpair : (dropped, RVal.erased) = (store', result) := + Except.ok.inj hrun + cases hpair + exact ⟨.erased, env, rfl, hframe, + dropVal_preserves hown hdrop⟩ + +theorem emit_dropU_owned {ctx : Ctx} {cur : FnDef} + {frame : List RVal → Prop} {target : Atom} {loc : Nat} + {rest : List Root} : + EmitSound ctx cur (emitOp (.dropU target)) + (fun store env => frame env ∧ + resolveAtom env target = .ok (.loc loc) ∧ + RootOwnership store (⟨.unique, .loc loc⟩ :: rest)) + (OwnsAfterPush frame rest) := by + apply OpSound.emit + intro fuel store env store' result hpre hrun + obtain ⟨hframe, hresolve, hown⟩ := hpre + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [hresolve, bindOk] at hrun + dsimp only at hrun + cases hdrop : dropUVal ctx fuel store (.loc loc) with + | error err => + rw [hdrop] at hrun + change (Except.error err : Except Err (Store × RVal)) = + .ok (store', result) at hrun + contradiction + | ok dropped => + rw [hdrop] at hrun + change (Except.ok (dropped, .erased) : Except Err (Store × RVal)) = + .ok (store', result) at hrun + have hpair : (dropped, RVal.erased) = (store', result) := + Except.ok.inj hrun + cases hpair + exact ⟨.erased, env, rfl, hframe, + dropUVal_preserves hown hdrop⟩ + +/-- Generic affine release, including ownership-inert scalar values. -/ +private theorem emit_dropU_value_owned_at {ctx : Ctx} {cur : FnDef} + {limit : Nat} {frame : List RVal → Prop} {target : Atom} {value : RVal} + {rest : List Root} : + EmitSoundBelow ctx cur limit (emitOp (.dropU target)) + (fun store env => frame env ∧ + resolveAtom env target = .ok value ∧ + RootOwnership store (⟨.unique, value⟩ :: rest)) + (OwnsAfterPush frame rest) := by + apply OpSoundBelow.emit + intro fuel store env store' result _ hpre hrun + obtain ⟨hframe, hresolve, hown⟩ := hpre + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [hresolve, bindOk] at hrun + cases value with + | lit literal => + change (Except.ok (store, RVal.erased) : + Except Err (Store × RVal)) = .ok (store', result) at hrun + have hpair : (store, RVal.erased) = (store', result) := + Except.ok.inj hrun + cases hpair + exact ⟨.erased, env, rfl, hframe, + hown.dropNoLocation (by rfl)⟩ + | erased => + change (Except.ok (store, RVal.erased) : + Except Err (Store × RVal)) = .ok (store', result) at hrun + have hpair : (store, RVal.erased) = (store', result) := + Except.ok.inj hrun + cases hpair + exact ⟨.erased, env, rfl, hframe, + hown.dropNoLocation (by rfl)⟩ + | loc loc => + dsimp only at hrun + cases hdrop : dropUVal ctx fuel store (.loc loc) with + | error err => + rw [hdrop] at hrun + change (Except.error err : Except Err (Store × RVal)) = + .ok (store', result) at hrun + contradiction + | ok dropped => + rw [hdrop] at hrun + change (Except.ok (dropped, RVal.erased) : + Except Err (Store × RVal)) = .ok (store', result) at hrun + have hpair : (dropped, RVal.erased) = (store', result) := + Except.ok.inj hrun + cases hpair + exact ⟨.erased, env, rfl, hframe, + dropUVal_preserves hown hdrop⟩ + +theorem emit_dropU_value_owned {ctx : Ctx} {cur : FnDef} + {frame : List RVal → Prop} {target : Atom} {value : RVal} + {rest : List Root} : + EmitSound ctx cur (emitOp (.dropU target)) + (fun store env => frame env ∧ + resolveAtom env target = .ok value ∧ + RootOwnership store (⟨.unique, value⟩ :: rest)) + (OwnsAfterPush frame rest) := by + exact EmitSound.of_below fun limit => + emit_dropU_value_owned_at (limit := limit) + +/-- Fuel-bounded affine release for a value of arbitrary runtime shape. -/ +theorem emit_dropU_value_owned_below {ctx : Ctx} {cur : FnDef} + {limit : Nat} {frame : List RVal → Prop} {target : Atom} + {value : RVal} {rest : List Root} : + EmitSoundBelow ctx cur limit (emitOp (.dropU target)) + (fun store env => frame env ∧ + resolveAtom env target = .ok value ∧ + RootOwnership store (⟨.unique, value⟩ :: rest)) + (OwnsAfterPush frame rest) := by + exact emit_dropU_value_owned_at + +theorem emit_free_owned {ctx : Ctx} {cur : FnDef} + {frame : List RVal → Prop} {target : Atom} {loc : Nat} + {node : Node} {rest : List Root} : + EmitSound ctx cur (emitOp (.free target)) + (fun store env => frame env ∧ + resolveAtom env target = .ok (.loc loc) ∧ + store.get? loc = some ⟨.unique, 1, node⟩ ∧ + RootOwnership store (⟨.unique, .loc loc⟩ :: rest)) + (OwnsAfterPush frame (rootsFor .unique (nodeChildren node) ++ rest)) := by + apply OpSound.emit + intro fuel store env store' result hpre hrun + obtain ⟨hframe, hresolve, hbox, hown⟩ := hpre + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + have hop := runOp_free_owned (ctx := ctx) (cur := cur) + (fuel := fuel) hresolve hbox hown + have hpair : (store.kill loc, RVal.erased) = (store', result) := + Except.ok.inj (hop.1.symm.trans hrun) + cases hpair + exact ⟨.erased, env, rfl, hframe, hop.2⟩ + +private theorem emit_fetch_borrowed_at {ctx : Ctx} {cur : FnDef} + {limit : Nat} {frame : List RVal → Prop} {target : Atom} {loc rc i : Nat} + {cid : CtorId} {fields : Array RVal} + {value : RVal} {roots : List Root} + (hfield : fields[i]? = some value) : + EmitSoundBelow ctx cur limit (emitOp (.fetch target i)) + (fun store env => frame env ∧ + resolveAtom env target = .ok (.loc loc) ∧ + store.get? loc = some ⟨.shared, rc, .ctorN cid fields⟩ ∧ + RootOwnership store roots) + (BorrowsPushed frame .shared roots) := by + apply OpSoundBelow.emit + intro fuel store env store' result _ hpre hrun + obtain ⟨hframe, hresolve, hbox, hown⟩ := hpre + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + have hop := runOp_fetch_borrowed (ctx := ctx) (cur := cur) + (fuel := fuel) hresolve hbox hfield hown + have hpair : (store, value) = (store', result) := + Except.ok.inj (hop.1.symm.trans hrun) + cases hpair + exact ⟨value, env, rfl, hframe, hop.2, hown⟩ + +theorem emit_fetch_borrowed {ctx : Ctx} {cur : FnDef} + {frame : List RVal → Prop} {target : Atom} {loc rc i : Nat} + {cid : CtorId} {fields : Array RVal} + {value : RVal} {roots : List Root} + (hfield : fields[i]? = some value) : + EmitSound ctx cur (emitOp (.fetch target i)) + (fun store env => frame env ∧ + resolveAtom env target = .ok (.loc loc) ∧ + store.get? loc = some ⟨.shared, rc, .ctorN cid fields⟩ ∧ + RootOwnership store roots) + (BorrowsPushed frame .shared roots) := by + exact EmitSound.of_below fun limit => + emit_fetch_borrowed_at (limit := limit) hfield + +/-- Fuel-bounded borrowed-field fetch. The operation pushes only a borrow; +the parent's root and the complete root multiset remain unchanged. -/ +theorem emit_fetch_borrowed_below {ctx : Ctx} {cur : FnDef} + {limit : Nat} {frame : List RVal → Prop} {target : Atom} + {loc rc i : Nat} {cid : CtorId} {fields : Array RVal} + {value : RVal} {roots : List Root} + (hfield : fields[i]? = some value) : + EmitSoundBelow ctx cur limit (emitOp (.fetch target i)) + (fun store env => frame env ∧ + resolveAtom env target = .ok (.loc loc) ∧ + store.get? loc = some ⟨.shared, rc, .ctorN cid fields⟩ ∧ + RootOwnership store roots) + (BorrowsPushed frame .shared roots) := by + exact emit_fetch_borrowed_at hfield + +/-! ## Exact-root predicates used by expression lowering -/ + +/-- The held source slots plus an arbitrary caller continuation own the +entire input heap. -/ +def OwnsVEnv (Γ : VEnv) (rest : List Root) : StatePred := + fun store env => ∃ roots, + VEnvRealizes Γ env roots ∧ + RootOwnership store (roots ++ rest) + +/-- The lowered result owns one root in `world`, alongside the roots still +held by the output `VEnv` and the caller continuation. -/ +def OwnsResult (Γ : VEnv) (world : Owned) (av : AVal) + (rest : List Root) : StatePred := + fun store env => ∃ roots value, + VEnvRealizes Γ env roots ∧ + AValRealizes Γ env av value ∧ + RootOwnership store (⟨world, value⟩ :: roots ++ rest) + +/-- Semantic companion of `OwnsVEnv`: each held logical root additionally +realizes the corresponding source evaluator value, and the caller's framed +roots carry their own source correspondence. The latter is essential when an +earlier argument is framed across the lowering of later arguments. -/ +def GraphOwnsVEnv (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (Γ : VEnv) + (sourceEnv : List IxIR0.Value) + (sourceRest : List (Owned × IxIR0.Value)) + (rest : List Root) : StatePred := + fun store env => ∃ roots, + VEnvValueGraph funRel recSelfRel store Γ sourceEnv env roots ∧ + Sim.RootsGraph funRel store sourceRest rest ∧ + RootOwnership store (roots ++ rest) + +/-- Semantic companion of `OwnsResult`: the returned `AVal` realizes both +the target root and the successful pure source result. -/ +def GraphOwnsResult (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (Γ : VEnv) + (sourceEnv : List IxIR0.Value) (sourceValue : IxIR0.Value) + (world : Owned) (av : AVal) + (sourceRest : List (Owned × IxIR0.Value)) + (rest : List Root) : StatePred := + fun store env => ∃ roots value, + VEnvValueGraph funRel recSelfRel store Γ sourceEnv env roots ∧ + AValRealizes Γ env av value ∧ + Sim.ValueGraph funRel store sourceValue value ∧ + Sim.RootsGraph funRel store sourceRest rest ∧ + RootOwnership store (⟨world, value⟩ :: roots ++ rest) + +/-- Forgetting source values recovers the ownership precondition used by the +existing lowering proof. -/ +theorem GraphOwnsVEnv.toOwnsVEnv {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + {store : Store} {env : List RVal} + (h : GraphOwnsVEnv funRel recSelfRel Γ sourceEnv + sourceRest rest store env) : + OwnsVEnv Γ rest store env := by + obtain ⟨roots, hgraph, _, hown⟩ := h + exact ⟨roots, hgraph.vEnvRealizes, hown⟩ + +/-- Forgetting the result graph recovers the ownership postcondition. -/ +theorem GraphOwnsResult.toOwnsResult {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {world : Owned} {av : AVal} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + {store : Store} {env : List RVal} + (h : GraphOwnsResult funRel recSelfRel Γ sourceEnv sourceValue + world av sourceRest rest store env) : + OwnsResult Γ world av rest store env := by + obtain ⟨roots, value, hgraph, hav, _, _, hown⟩ := h + exact ⟨roots, value, hgraph.vEnvRealizes, hav, hown⟩ + +/-- Input ownership plus an arbitrary frame of older absolute slots that a +later argument/result must not invalidate. -/ +def OwnsVEnvProtected (Γ : VEnv) (rest : List Root) + (slots : List (Nat × RVal)) : StatePred := + fun store env => OwnsVEnv Γ rest store env ∧ + SlotsRealize Γ env slots + +/-- A protected lowering environment together with shared-world facts for +borrowed case fields that later prefix steps may retain. -/ +def OwnsVEnvBorrowed (Γ : VEnv) (rest : List Root) + (slots : List (Nat × RVal)) (borrowed : List RVal) : StatePred := + fun store env => OwnsVEnvProtected Γ rest slots store env ∧ + ∀ value ∈ borrowed, HasWorld store .shared value + +/-- Result ownership while preserving every protected absolute slot. -/ +def OwnsResultProtected (Γ : VEnv) (world : Owned) (av : AVal) + (rest : List Root) (slots : List (Nat × RVal)) : StatePred := + fun store env => OwnsResult Γ world av rest store env ∧ + SlotsRealize Γ env slots + +def GraphOwnsVEnvProtected (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (Γ : VEnv) + (sourceEnv : List IxIR0.Value) + (sourceRest : List (Owned × IxIR0.Value)) (rest : List Root) + (slots : List (Nat × RVal)) : StatePred := + fun store env => + GraphOwnsVEnv funRel recSelfRel Γ sourceEnv sourceRest rest store env ∧ + SlotsRealize Γ env slots + +/-- Dynamic graph coverage for the borrowed fields that a remaining +recursor-retain plan may activate. The source lookup is at the logical +entry selected by the retain descriptor; the target lookup is carried by +the protected absolute-slot relation. -/ +def RetainsValueGraphs (funRel : Sim.FunctionRel) (store : Store) + (sourceEnv : List IxIR0.Value) (slots : List (Nat × RVal)) + (borrowed : List RVal) (retains : List RecursorFieldRetain) : Prop := + ∀ retain, retain ∈ retains → + ∃ source value, + sourceEnv[retain.entry]? = some source ∧ + (retain.fieldAbs, value) ∈ slots ∧ + value ∈ borrowed ∧ + Sim.ValueGraph funRel store source value + +/-- Semantic recursor-prefix state. `extra` contains owned roots (notably +the major premise) that are intentionally outside the logical source +environment and will be consumed by a later fixed prefix step. -/ +def GraphOwnsVEnvRetains (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (Γ : VEnv) + (sourceEnv : List IxIR0.Value) + (sourceRest : List (Owned × IxIR0.Value)) (rest extra : List Root) + (slots : List (Nat × RVal)) (borrowed : List RVal) + (retains : List RecursorFieldRetain) : StatePred := + fun store env => ∃ roots, + VEnvValueGraph funRel recSelfRel store Γ sourceEnv env roots ∧ + Sim.RootsGraph funRel store sourceRest rest ∧ + RootOwnership store (roots ++ extra ++ rest) ∧ + SlotsRealize Γ env slots ∧ + (∀ value ∈ borrowed, HasWorld store .shared value) ∧ + RetainsValueGraphs funRel store sourceEnv slots borrowed retains + +theorem RetainsValueGraphs.monoStore {funRel : Sim.FunctionRel} + {before after : Store} {sourceEnv : List IxIR0.Value} + {slots : List (Nat × RVal)} {borrowed : List RVal} + {retains : List RecursorFieldRetain} + (hstore : Sim.StoreGraphExtends before after) + (hgraphs : RetainsValueGraphs funRel before sourceEnv slots borrowed + retains) : + RetainsValueGraphs funRel after sourceEnv slots borrowed retains := by + intro retain hmember + obtain ⟨source, value, hsource, hslot, hborrowed, hvalue⟩ := + hgraphs retain hmember + exact ⟨source, value, hsource, hslot, hborrowed, + hvalue.monoStore hstore⟩ + +def GraphOwnsResultProtected (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (Γ : VEnv) + (sourceEnv : List IxIR0.Value) (sourceValue : IxIR0.Value) + (world : Owned) (av : AVal) + (sourceRest : List (Owned × IxIR0.Value)) (rest : List Root) + (slots : List (Nat × RVal)) : StatePred := + fun store env => + GraphOwnsResult funRel recSelfRel Γ sourceEnv sourceValue + world av sourceRest rest store env ∧ + SlotsRealize Γ env slots + +/-- The soundness proposition attached to one successful `lowerE` result. +Besides exact ownership it records that the returned descriptor is stable and +preserves any older absolute slots. The latter is the frame rule required by +left-to-right `lowerArgs` sequencing. -/ +structure LowerResultSound (ctx : Ctx) (cur : FnDef) + (input output : VEnv) (world : Owned) (emit : Emit) (av : AVal) : Prop where + stable : AValStable av + emits : ∀ rest slots, + EmitSound ctx cur emit (OwnsVEnvProtected input rest slots) + (OwnsResultProtected output world av rest slots) + +/-- Companion semantic refinement for one expression result. It retains the +complete ownership theorem as a parent field and separately transports a +source-environment graph to a graph-related source result. Keeping the two +transformers separate prevents source values from entering primitive RC and +frame lemmas. -/ +structure LowerResultValueSound (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (ctx : Ctx) (cur : FnDef) + (input output : VEnv) + (sourceInput sourceOutput : List IxIR0.Value) + (sourceValue : IxIR0.Value) (world : Owned) + (emit : Emit) (av : AVal) : Prop + extends LowerResultSound ctx cur input output world emit av where + graphEmits : ∀ sourceRest rest slots, + EmitSound ctx cur emit + (GraphOwnsVEnvProtected funRel recSelfRel input + sourceInput sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output + sourceOutput sourceValue world av sourceRest rest slots) + +/-- A mismatched source/logical environment length makes the semantic +precondition uninhabited. This is the deliberately vacuous branch used by +rules such as lambda lifting: well-formed callers recover the length equality +from `VEnvValueGraph`, while the public transformer need not carry it as a +separate premise. -/ +theorem LowerResultSound.valueSound_of_sourceLength_ne + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {world : Owned} + {emit : Emit} {av : AVal} + (hsound : LowerResultSound ctx cur input output world emit av) + (hlength : sourceInput.length ≠ input.entries.length) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue world emit av := by + refine { toLowerResultSound := hsound, graphEmits := ?_ } + intro sourceRest rest slots post code hcode fuel store env store' value + hpre hrun + obtain ⟨⟨roots, hgraph, _, _⟩, _⟩ := hpre + exact (hlength hgraph.entries.source_length).elim + +/-- Fuel-bounded expression-lowering soundness used before recursive +context contracts have been sealed. -/ +structure LowerResultSoundBelow (ctx : Ctx) (cur : FnDef) + (limit : Nat) (input output : VEnv) (world : Owned) + (emit : Emit) (av : AVal) : Prop where + stable : AValStable av + emits : ∀ rest slots, + EmitSoundBelow ctx cur limit emit + (OwnsVEnvProtected input rest slots) + (OwnsResultProtected output world av rest slots) + +/-- Fuel-bounded semantic expression result. Both the ownership transformer +and its source graph refinement are restricted to the same target evaluator +bound, which is the contractive interface needed while declaration and apply +contracts are still being constructed. -/ +structure LowerResultValueSoundBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (ctx : Ctx) (cur : FnDef) + (limit : Nat) (input output : VEnv) + (sourceInput sourceOutput : List IxIR0.Value) + (sourceValue : IxIR0.Value) (world : Owned) + (emit : Emit) (av : AVal) : Prop + extends LowerResultSoundBelow ctx cur limit input output world emit av where + graphEmits : ∀ sourceRest rest slots, + EmitSoundBelow ctx cur limit emit + (GraphOwnsVEnvProtected funRel recSelfRel input + sourceInput sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output + sourceOutput sourceValue world av sourceRest rest slots) + +/-- As in the unbounded interface, a source/logical environment length +mismatch makes the bounded semantic precondition unreachable. -/ +theorem LowerResultSoundBelow.valueSound_of_sourceLength_ne + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {world : Owned} + {emit : Emit} {av : AVal} + (hsound : LowerResultSoundBelow ctx cur limit input output world emit av) + (hlength : sourceInput.length ≠ input.entries.length) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceInput sourceOutput sourceValue world emit av := by + refine { toLowerResultSoundBelow := hsound, graphEmits := ?_ } + intro sourceRest rest slots bound hbound post code hcode fuel store env + store' value hfuel hpre hrun + obtain ⟨⟨roots, hgraph, _, _⟩, _⟩ := hpre + exact (hlength hgraph.entries.source_length).elim + +/-- An expression result proved uniformly at every fuel bound satisfies the +unbounded ownership interface. The stable descriptor is fuel-independent; +only its continuation transformer needs closure through `EmitSound.of_below`. +-/ +theorem LowerResultSound.of_below {ctx : Ctx} {cur : FnDef} + {input output : VEnv} {world : Owned} {emit : Emit} {av : AVal} + (hsound : ∀ limit, + LowerResultSoundBelow ctx cur limit input output world emit av) : + LowerResultSound ctx cur input output world emit av := by + refine ⟨(hsound 0).stable, ?_⟩ + intro rest slots + exact EmitSound.of_below fun limit => + (hsound limit).emits rest slots + +/-- Uniform bounded semantic results close to the existing unbounded +semantic interface. -/ +theorem LowerResultValueSound.of_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {world : Owned} + {emit : Emit} {av : AVal} + (hsound : ∀ limit, + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceValue world emit av) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue world emit av := by + refine + { toLowerResultSound := LowerResultSound.of_below + (fun limit => (hsound limit).toLowerResultSoundBelow) + graphEmits := ?_ } + intro sourceRest rest slots + exact EmitSound.of_below fun limit => + (hsound limit).graphEmits sourceRest rest slots + +/-- Bounded semantic expression results are contravariant in their target +evaluator bound. -/ +theorem LowerResultValueSoundBelow.mono + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {smaller larger : Nat} + {input output : VEnv} {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {world : Owned} + {emit : Emit} {av : AVal} + (hsound : LowerResultValueSoundBelow funRel recSelfRel ctx cur larger + input output sourceInput sourceOutput sourceValue world emit av) + (hbound : smaller ≤ larger) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur smaller + input output sourceInput sourceOutput sourceValue world emit av := by + refine + { toLowerResultSoundBelow := + { stable := hsound.stable + emits := by + intro rest slots bound hsmall + exact hsound.emits rest slots bound + (Nat.le_trans hsmall hbound) } + graphEmits := ?_ } + intro sourceRest rest slots bound hsmall + exact hsound.graphEmits sourceRest rest slots bound + (Nat.le_trans hsmall hbound) + +/-- Logical roots supplied by a borrowing result. A temporary or final-use +slot still owns one shared root that the projection must release; a repeated +variable borrow is already owned by the returned `VEnv`. -/ +def borrowResultRoots (release : Bool) (value : RVal) : List Root := + if release then [⟨.shared, value⟩] else [] + +/-- Successful `lowerBorrow` output: the descriptor resolves to a shared +borrow, and `release` states whether its owner sits outside the output +environment and must be consumed by the caller. -/ +def OwnsBorrowResult (Γ : VEnv) (av : AVal) (release : Bool) + (rest : List Root) : StatePred := + fun store env => ∃ roots value, + VEnvRealizes Γ env roots ∧ + AValRealizes Γ env av value ∧ + HasWorld store .shared value ∧ + RootOwnership store + (borrowResultRoots release value ++ roots ++ rest) + +def OwnsBorrowResultProtected (Γ : VEnv) (av : AVal) + (release : Bool) (rest : List Root) + (slots : List (Nat × RVal)) : StatePred := + fun store env => OwnsBorrowResult Γ av release rest store env ∧ + SlotsRealize Γ env slots + +/-- State after `fetch`: the original target and newly pushed field are both +shared borrows, and no root multiplicity has changed. -/ +def OwnsFetchedBorrowProtected (Γ : VEnv) (target field : AVal) + (release : Bool) (rest : List Root) + (slots : List (Nat × RVal)) : StatePred := + fun store env => ∃ roots targetValue fieldValue, + VEnvRealizes Γ env roots ∧ + AValRealizes Γ env target targetValue ∧ + AValRealizes Γ env field fieldValue ∧ + HasWorld store .shared targetValue ∧ + HasWorld store .shared fieldValue ∧ + RootOwnership store + (borrowResultRoots release targetValue ++ roots ++ rest) ∧ + SlotsRealize Γ env slots + +/-- State after retaining the fetched field: the field is now the distinct +owned result root, while a final-use target owner remains pending exactly +when `release` is true. -/ +def OwnsRetainedProjectionProtected (Γ : VEnv) (target result : AVal) + (release : Bool) (rest : List Root) + (slots : List (Nat × RVal)) : StatePred := + fun store env => ∃ roots targetValue resultValue, + VEnvRealizes Γ env roots ∧ + AValRealizes Γ env target targetValue ∧ + AValRealizes Γ env result resultValue ∧ + HasWorld store .shared targetValue ∧ + RootOwnership store + (⟨.shared, resultValue⟩ :: + borrowResultRoots release targetValue ++ roots ++ rest) ∧ + SlotsRealize Γ env slots + +/-- Semantic borrowing result: the borrowed runtime value still realizes the +source value, while the source environment and caller frame keep their graph +witnesses. -/ +def GraphOwnsBorrowResultProtected (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (Γ : VEnv) + (sourceEnv : List IxIR0.Value) (sourceValue : IxIR0.Value) + (av : AVal) (release : Bool) + (sourceRest : List (Owned × IxIR0.Value)) (rest : List Root) + (slots : List (Nat × RVal)) : StatePred := + fun store env => ∃ roots value, + VEnvValueGraph funRel recSelfRel store Γ sourceEnv env roots ∧ + AValRealizes Γ env av value ∧ + HasWorld store .shared value ∧ + Sim.ValueGraph funRel store sourceValue value ∧ + Sim.RootsGraph funRel store sourceRest rest ∧ + RootOwnership store + (borrowResultRoots release value ++ roots ++ rest) ∧ + SlotsRealize Γ env slots + +/-- Semantic state after `fetch`: both the constructor target and selected +field retain their source graphs, while the field remains only a borrow. -/ +def GraphOwnsFetchedBorrowProtected (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (Γ : VEnv) + (sourceEnv : List IxIR0.Value) + (sourceTarget sourceField : IxIR0.Value) + (target field : AVal) (release : Bool) + (sourceRest : List (Owned × IxIR0.Value)) (rest : List Root) + (slots : List (Nat × RVal)) : StatePred := + fun store env => ∃ roots targetValue fieldValue, + VEnvValueGraph funRel recSelfRel store Γ sourceEnv env roots ∧ + AValRealizes Γ env target targetValue ∧ + AValRealizes Γ env field fieldValue ∧ + HasWorld store .shared targetValue ∧ + HasWorld store .shared fieldValue ∧ + Sim.ValueGraph funRel store sourceTarget targetValue ∧ + Sim.ValueGraph funRel store sourceField fieldValue ∧ + Sim.RootsGraph funRel store sourceRest rest ∧ + RootOwnership store + (borrowResultRoots release targetValue ++ roots ++ rest) ∧ + SlotsRealize Γ env slots + +/-- Semantic state after retaining the fetched field as the owned result. -/ +def GraphOwnsRetainedProjectionProtected (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (Γ : VEnv) + (sourceEnv : List IxIR0.Value) + (sourceTarget sourceField : IxIR0.Value) + (target result : AVal) (release : Bool) + (sourceRest : List (Owned × IxIR0.Value)) (rest : List Root) + (slots : List (Nat × RVal)) : StatePred := + fun store env => ∃ roots targetValue resultValue, + VEnvValueGraph funRel recSelfRel store Γ sourceEnv env roots ∧ + AValRealizes Γ env target targetValue ∧ + AValRealizes Γ env result resultValue ∧ + HasWorld store .shared targetValue ∧ + Sim.ValueGraph funRel store sourceTarget targetValue ∧ + Sim.ValueGraph funRel store sourceField resultValue ∧ + Sim.RootsGraph funRel store sourceRest rest ∧ + RootOwnership store + (⟨.shared, resultValue⟩ :: + borrowResultRoots release targetValue ++ roots ++ rest) ∧ + SlotsRealize Γ env slots + +/-- Fuel-bounded soundness package for one successful borrowing-position +lowering run. -/ +structure LowerBorrowSoundBelow (ctx : Ctx) (cur : FnDef) + (limit : Nat) (input output : VEnv) (emit : Emit) (av : AVal) + (release : Bool) : Prop where + stable : AValStable av + emits : ∀ rest slots, + EmitSoundBelow ctx cur limit emit + (OwnsVEnvProtected input rest slots) + (OwnsBorrowResultProtected output av release rest slots) + +/-- Unbounded ownership interface for borrowing-position lowering. -/ +structure LowerBorrowSound (ctx : Ctx) (cur : FnDef) + (input output : VEnv) (emit : Emit) (av : AVal) + (release : Bool) : Prop where + stable : AValStable av + emits : ∀ rest slots, + EmitSound ctx cur emit + (OwnsVEnvProtected input rest slots) + (OwnsBorrowResultProtected output av release rest slots) + +theorem LowerBorrowSound.of_below {ctx : Ctx} {cur : FnDef} + {input output : VEnv} {emit : Emit} {av : AVal} {release : Bool} + (hsound : ∀ limit, + LowerBorrowSoundBelow ctx cur limit input output emit av release) : + LowerBorrowSound ctx cur input output emit av release := by + refine ⟨(hsound 0).stable, ?_⟩ + intro rest slots + exact EmitSound.of_below fun limit => + (hsound limit).emits rest slots + +/-- Companion semantic refinement for a borrowing-position result. -/ +structure LowerBorrowValueSound (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (ctx : Ctx) (cur : FnDef) + (input output : VEnv) + (sourceInput sourceOutput : List IxIR0.Value) + (sourceValue : IxIR0.Value) (emit : Emit) (av : AVal) + (release : Bool) : Prop + extends LowerBorrowSound ctx cur input output emit av release where + graphEmits : ∀ sourceRest rest slots, + EmitSound ctx cur emit + (GraphOwnsVEnvProtected funRel recSelfRel input + sourceInput sourceRest rest slots) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput sourceValue av release sourceRest rest slots) + +/-- Fuel-bounded semantic borrowing result. -/ +structure LowerBorrowValueSoundBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (ctx : Ctx) (cur : FnDef) + (limit : Nat) (input output : VEnv) + (sourceInput sourceOutput : List IxIR0.Value) + (sourceValue : IxIR0.Value) (emit : Emit) (av : AVal) + (release : Bool) : Prop + extends LowerBorrowSoundBelow ctx cur limit input output emit av release where + graphEmits : ∀ sourceRest rest slots, + EmitSoundBelow ctx cur limit emit + (GraphOwnsVEnvProtected funRel recSelfRel input + sourceInput sourceRest rest slots) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput sourceValue av release sourceRest rest slots) + +theorem LowerBorrowValueSound.of_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {av : AVal} + {release : Bool} + (hsound : ∀ limit, + LowerBorrowValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceValue emit av release) : + LowerBorrowValueSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue emit av release := by + refine + { toLowerBorrowSound := LowerBorrowSound.of_below + (fun limit => (hsound limit).toLowerBorrowSoundBelow) + graphEmits := ?_ } + intro sourceRest rest slots + exact EmitSound.of_below fun limit => + (hsound limit).graphEmits sourceRest rest slots + +theorem LowerBorrowValueSoundBelow.mono + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {smaller larger : Nat} + {input output : VEnv} {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {av : AVal} + {release : Bool} + (hsound : LowerBorrowValueSoundBelow funRel recSelfRel ctx cur larger + input output sourceInput sourceOutput sourceValue emit av release) + (hbound : smaller ≤ larger) : + LowerBorrowValueSoundBelow funRel recSelfRel ctx cur smaller + input output sourceInput sourceOutput sourceValue emit av release := by + refine + { toLowerBorrowSoundBelow := + { stable := hsound.stable + emits := by + intro rest slots bound hsmall + exact hsound.emits rest slots bound + (Nat.le_trans hsmall hbound) } + graphEmits := ?_ } + intro sourceRest rest slots bound hsmall + exact hsound.graphEmits sourceRest rest slots bound + (Nat.le_trans hsmall hbound) + +/-- Bounded expression proofs are contravariant in their fuel bound. -/ +theorem LowerResultSoundBelow.mono {ctx : Ctx} {cur : FnDef} + {smaller larger : Nat} {input output : VEnv} {world : Owned} + {emit : Emit} {av : AVal} + (hsound : LowerResultSoundBelow ctx cur larger input output world emit av) + (hbound : smaller ≤ larger) : + LowerResultSoundBelow ctx cur smaller input output world emit av := by + refine ⟨hsound.stable, ?_⟩ + intro rest slots bound hsmall + exact hsound.emits rest slots bound (Nat.le_trans hsmall hbound) + +/-- Forget a released first logical binder from a bounded expression result. +The physical stack and absolute-slot interpretation are unchanged. -/ +theorem LowerResultSoundBelow.popFirstReleased + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} {world : Owned} {emit : Emit} {av : AVal} + (hsound : LowerResultSoundBelow ctx cur limit input output world emit av) + (hfirst : FirstEntryReleased output) : + LowerResultSoundBelow ctx cur limit input output.pop world emit av := by + refine ⟨hsound.stable, ?_⟩ + intro rest slots + have hpop : EmitSoundBelow ctx cur limit (_root_.id : Emit) + (OwnsResultProtected output world av rest slots) + (OwnsResultProtected output.pop world av rest slots) := by + apply EmitSoundBelow.strengthen + intro store env hpre + obtain ⟨⟨roots, value, houtput, hav, hown⟩, hslots⟩ := hpre + refine ⟨⟨roots, value, houtput.pop_firstReleased hfirst, + hav.of_depth_eq (by simp [VEnv.pop]), hown⟩, ?_⟩ + exact SlotsRealize.of_depth_eq (by simp [VEnv.pop]) hslots + have hcomposed := EmitSoundBelow.comp (hsound.emits rest slots) hpop + simpa [Function.comp_def] using hcomposed + +/-- Forget a released first logical binder from an unbounded expression +result. This is the continuation-level counterpart of `VEnv.pop`. -/ +theorem LowerResultSound.popFirstReleased + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {world : Owned} {emit : Emit} {av : AVal} + (hsound : LowerResultSound ctx cur input output world emit av) + (hfirst : FirstEntryReleased output) : + LowerResultSound ctx cur input output.pop world emit av := by + refine ⟨hsound.stable, ?_⟩ + intro rest slots + have hpop : EmitSound ctx cur (_root_.id : Emit) + (OwnsResultProtected output world av rest slots) + (OwnsResultProtected output.pop world av rest slots) := by + apply EmitSound.strengthen + intro store env hpre + obtain ⟨⟨roots, value, houtput, hav, hown⟩, hslots⟩ := hpre + refine ⟨⟨roots, value, houtput.pop_firstReleased hfirst, + hav.of_depth_eq (by simp [VEnv.pop]), hown⟩, ?_⟩ + exact SlotsRealize.of_depth_eq (by simp [VEnv.pop]) hslots + have hcomposed := EmitSound.comp (hsound.emits rest slots) hpop + simpa [Function.comp_def] using hcomposed + +/-- The semantic companion removes the corresponding leading source value +when a let body's released first logical entry is popped. -/ +theorem LowerResultValueSound.popFirstReleased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {boundSource sourceValue : IxIR0.Value} + {world : Owned} {emit : Emit} {av : AVal} + (hsound : LowerResultValueSound funRel recSelfRel ctx cur + input output sourceInput (boundSource :: sourceOutput) + sourceValue world emit av) + (hfirst : FirstEntryReleased output) : + LowerResultValueSound funRel recSelfRel ctx cur input output.pop + sourceInput sourceOutput sourceValue world emit av := by + refine + { toLowerResultSound := + hsound.toLowerResultSound.popFirstReleased hfirst + graphEmits := ?_ } + intro sourceRest rest slots + have hpop : EmitSound ctx cur (_root_.id : Emit) + (GraphOwnsResultProtected funRel recSelfRel output + (boundSource :: sourceOutput) sourceValue world av + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.pop + sourceOutput sourceValue world av sourceRest rest slots) := by + apply EmitSound.strengthen + intro store env hpre + obtain ⟨⟨roots, value, houtput, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + refine ⟨⟨roots, value, houtput.pop_firstReleased hfirst, + hav.of_depth_eq (by simp [VEnv.pop]), hvalueGraph, + hrestGraph, hown⟩, ?_⟩ + exact SlotsRealize.of_depth_eq (by simp [VEnv.pop]) hslots + have hcomposed := EmitSound.comp + (hsound.graphEmits sourceRest rest slots) hpop + simpa [Function.comp_def] using hcomposed + +/-- Fuel-bounded semantic counterpart of popping a released leading let +binder. -/ +theorem LowerResultValueSoundBelow.popFirstReleased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {boundSource sourceValue : IxIR0.Value} + {world : Owned} {emit : Emit} {av : AVal} + (hsound : LowerResultValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput (boundSource :: sourceOutput) + sourceValue world emit av) + (hfirst : FirstEntryReleased output) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input + output.pop sourceInput sourceOutput sourceValue world emit av := by + refine + { toLowerResultSoundBelow := + hsound.toLowerResultSoundBelow.popFirstReleased hfirst + graphEmits := ?_ } + intro sourceRest rest slots + have hpop : EmitSoundBelow ctx cur limit (_root_.id : Emit) + (GraphOwnsResultProtected funRel recSelfRel output + (boundSource :: sourceOutput) sourceValue world av + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.pop + sourceOutput sourceValue world av sourceRest rest slots) := by + apply EmitSoundBelow.strengthen + intro store env hpre + obtain ⟨⟨roots, value, houtput, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + refine ⟨⟨roots, value, houtput.pop_firstReleased hfirst, + hav.of_depth_eq (by simp [VEnv.pop]), hvalueGraph, + hrestGraph, hown⟩, ?_⟩ + exact SlotsRealize.of_depth_eq (by simp [VEnv.pop]) hslots + have hcomposed := EmitSoundBelow.comp + (hsound.graphEmits sourceRest rest slots) hpop + simpa [Function.comp_def] using hcomposed + +/-- Bounded borrow proofs are contravariant in their evaluator bound. -/ +theorem LowerBorrowSoundBelow.mono {ctx : Ctx} {cur : FnDef} + {smaller larger : Nat} {input output : VEnv} {emit : Emit} + {av : AVal} {release : Bool} + (hsound : LowerBorrowSoundBelow ctx cur larger input output emit av + release) + (hbound : smaller ≤ larger) : + LowerBorrowSoundBelow ctx cur smaller input output emit av release := by + refine ⟨hsound.stable, ?_⟩ + intro rest slots bound hsmall + exact hsound.emits rest slots bound (Nat.le_trans hsmall hbound) + +/-- Reinterpret an owned shared slot result as a borrowing result whose +separate owner must be released by the projection caller. -/ +theorem LowerResultSoundBelow.asBorrowSlot + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} {emit : Emit} {abs : Nat} + (hsound : LowerResultSoundBelow ctx cur limit input output .shared emit + (.slotA abs)) : + LowerBorrowSoundBelow ctx cur limit input output emit (.slotA abs) + true := by + refine ⟨hsound.stable, ?_⟩ + intro rest slots + have hconvert : EmitSoundBelow ctx cur limit (_root_.id : Emit) + (OwnsResultProtected output .shared (.slotA abs) rest slots) + (OwnsBorrowResultProtected output (.slotA abs) true rest slots) := by + apply EmitSoundBelow.strengthen + intro store env hpre + obtain ⟨⟨roots, value, houtput, hav, hown⟩, hslots⟩ := hpre + have hworld : HasWorld store .shared value := + hown.roots_world ⟨.shared, value⟩ (by simp) + refine ⟨⟨roots, value, houtput, hav, hworld, ?_⟩, hslots⟩ + simpa [borrowResultRoots] using hown + have hcomposed := EmitSoundBelow.comp (hsound.emits rest slots) hconvert + simpa [Function.comp_def] using hcomposed + +/-- Stable scalar results carry no heap owner, so their logical result root +can be forgotten and the value exposed as a non-releasing shared borrow. -/ +theorem LowerResultSoundBelow.asBorrowConst + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} {emit : Emit} {atom : Atom} + (hsound : LowerResultSoundBelow ctx cur limit input output .shared emit + (.constA atom)) : + LowerBorrowSoundBelow ctx cur limit input output emit (.constA atom) + false := by + refine ⟨hsound.stable, ?_⟩ + intro rest slots + have hconvert : EmitSoundBelow ctx cur limit (_root_.id : Emit) + (OwnsResultProtected output .shared (.constA atom) rest slots) + (OwnsBorrowResultProtected output (.constA atom) false rest slots) := by + apply EmitSoundBelow.strengthen + intro store env hpre + obtain ⟨⟨roots, value, houtput, hav, hown⟩, hslots⟩ := hpre + have hworld : HasWorld store .shared value := + hown.roots_world ⟨.shared, value⟩ (by simp) + refine ⟨⟨roots, value, houtput, hav, hworld, ?_⟩, hslots⟩ + simpa [borrowResultRoots] using + hown.dropNoLocation (hsound.stable.const_noLocation hav) + have hcomposed := EmitSoundBelow.comp (hsound.emits rest slots) hconvert + simpa [Function.comp_def] using hcomposed + +/-- Unbounded counterpart of `asBorrowSlot`: the expression result's shared +owner becomes the explicit owner that a borrowing caller must eventually +release. -/ +theorem LowerResultSound.asBorrowSlot + {ctx : Ctx} {cur : FnDef} + {input output : VEnv} {emit : Emit} {abs : Nat} + (hsound : LowerResultSound ctx cur input output .shared emit + (.slotA abs)) : + LowerBorrowSound ctx cur input output emit (.slotA abs) true := by + refine ⟨hsound.stable, ?_⟩ + intro rest slots + have hconvert : EmitSound ctx cur (_root_.id : Emit) + (OwnsResultProtected output .shared (.slotA abs) rest slots) + (OwnsBorrowResultProtected output (.slotA abs) true rest slots) := by + apply EmitSound.strengthen + intro store env hpre + obtain ⟨⟨roots, value, houtput, hav, hown⟩, hslots⟩ := hpre + have hworld : HasWorld store .shared value := + hown.roots_world ⟨.shared, value⟩ (by simp) + refine ⟨⟨roots, value, houtput, hav, hworld, ?_⟩, hslots⟩ + simpa [borrowResultRoots] using hown + have hcomposed := EmitSound.comp (hsound.emits rest slots) hconvert + simpa [Function.comp_def] using hcomposed + +/-- Unbounded scalar adapter. A stable constant has no heap location, so its +distinguished logical result owner can be forgotten. -/ +theorem LowerResultSound.asBorrowConst + {ctx : Ctx} {cur : FnDef} + {input output : VEnv} {emit : Emit} {atom : Atom} + (hsound : LowerResultSound ctx cur input output .shared emit + (.constA atom)) : + LowerBorrowSound ctx cur input output emit (.constA atom) false := by + refine ⟨hsound.stable, ?_⟩ + intro rest slots + have hconvert : EmitSound ctx cur (_root_.id : Emit) + (OwnsResultProtected output .shared (.constA atom) rest slots) + (OwnsBorrowResultProtected output (.constA atom) false rest slots) := by + apply EmitSound.strengthen + intro store env hpre + obtain ⟨⟨roots, value, houtput, hav, hown⟩, hslots⟩ := hpre + have hworld : HasWorld store .shared value := + hown.roots_world ⟨.shared, value⟩ (by simp) + refine ⟨⟨roots, value, houtput, hav, hworld, ?_⟩, hslots⟩ + simpa [borrowResultRoots] using + hown.dropNoLocation (hsound.stable.const_noLocation hav) + have hcomposed := EmitSound.comp (hsound.emits rest slots) hconvert + simpa [Function.comp_def] using hcomposed + +/-- Semantic slot adapter: the result graph is preserved while its shared +root is reclassified as the borrowing caller's pending owner. -/ +theorem LowerResultValueSound.asBorrowSlot + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {abs : Nat} + (hsound : LowerResultValueSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceValue .shared emit + (.slotA abs)) : + LowerBorrowValueSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceValue emit + (.slotA abs) true := by + refine + { toLowerBorrowSound := + hsound.toLowerResultSound.asBorrowSlot + graphEmits := ?_ } + intro sourceRest rest slots + have hconvert : EmitSound ctx cur (_root_.id : Emit) + (GraphOwnsResultProtected funRel recSelfRel output sourceOutput + sourceValue .shared (.slotA abs) sourceRest rest slots) + (GraphOwnsBorrowResultProtected funRel recSelfRel output sourceOutput + sourceValue (.slotA abs) true sourceRest rest slots) := by + apply EmitSound.strengthen + intro store env hpre + obtain ⟨⟨roots, value, houtput, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + have hworld : HasWorld store .shared value := + hown.roots_world ⟨.shared, value⟩ (by simp) + refine ⟨roots, value, houtput, hav, hworld, hvalueGraph, + hrestGraph, ?_, hslots⟩ + simpa [borrowResultRoots] using hown + have hcomposed := EmitSound.comp + (hsound.graphEmits sourceRest rest slots) hconvert + simpa [Function.comp_def] using hcomposed + +/-- Semantic scalar adapter: dropping the ownership-inert result root leaves +the source/result graph and caller-frame graph unchanged. -/ +theorem LowerResultValueSound.asBorrowConst + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {atom : Atom} + (hsound : LowerResultValueSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceValue .shared emit + (.constA atom)) : + LowerBorrowValueSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceValue emit + (.constA atom) false := by + refine + { toLowerBorrowSound := + hsound.toLowerResultSound.asBorrowConst + graphEmits := ?_ } + intro sourceRest rest slots + have hconvert : EmitSound ctx cur (_root_.id : Emit) + (GraphOwnsResultProtected funRel recSelfRel output sourceOutput + sourceValue .shared (.constA atom) sourceRest rest slots) + (GraphOwnsBorrowResultProtected funRel recSelfRel output sourceOutput + sourceValue (.constA atom) false sourceRest rest slots) := by + apply EmitSound.strengthen + intro store env hpre + obtain ⟨⟨roots, value, houtput, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + have hworld : HasWorld store .shared value := + hown.roots_world ⟨.shared, value⟩ (by simp) + refine ⟨roots, value, houtput, hav, hworld, hvalueGraph, + hrestGraph, ?_, hslots⟩ + simpa [borrowResultRoots] using + hown.dropNoLocation (hsound.stable.const_noLocation hav) + have hcomposed := EmitSound.comp + (hsound.graphEmits sourceRest rest slots) hconvert + simpa [Function.comp_def] using hcomposed + +theorem LowerResultValueSoundBelow.asBorrowSlot + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {abs : Nat} + (hsound : LowerResultValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceValue .shared emit + (.slotA abs)) : + LowerBorrowValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceValue emit + (.slotA abs) true := by + refine + { toLowerBorrowSoundBelow := + hsound.toLowerResultSoundBelow.asBorrowSlot + graphEmits := ?_ } + intro sourceRest rest slots + have hconvert : EmitSoundBelow ctx cur limit (_root_.id : Emit) + (GraphOwnsResultProtected funRel recSelfRel output sourceOutput + sourceValue .shared (.slotA abs) sourceRest rest slots) + (GraphOwnsBorrowResultProtected funRel recSelfRel output sourceOutput + sourceValue (.slotA abs) true sourceRest rest slots) := by + apply EmitSoundBelow.strengthen + intro store env hpre + obtain ⟨⟨roots, value, houtput, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + have hworld : HasWorld store .shared value := + hown.roots_world ⟨.shared, value⟩ (by simp) + refine ⟨roots, value, houtput, hav, hworld, hvalueGraph, + hrestGraph, ?_, hslots⟩ + simpa [borrowResultRoots] using hown + have hcomposed := EmitSoundBelow.comp + (hsound.graphEmits sourceRest rest slots) hconvert + simpa [Function.comp_def] using hcomposed + +theorem LowerResultValueSoundBelow.asBorrowConst + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {atom : Atom} + (hsound : LowerResultValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceValue .shared emit + (.constA atom)) : + LowerBorrowValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceValue emit + (.constA atom) false := by + refine + { toLowerBorrowSoundBelow := + hsound.toLowerResultSoundBelow.asBorrowConst + graphEmits := ?_ } + intro sourceRest rest slots + have hconvert : EmitSoundBelow ctx cur limit (_root_.id : Emit) + (GraphOwnsResultProtected funRel recSelfRel output sourceOutput + sourceValue .shared (.constA atom) sourceRest rest slots) + (GraphOwnsBorrowResultProtected funRel recSelfRel output sourceOutput + sourceValue (.constA atom) false sourceRest rest slots) := by + apply EmitSoundBelow.strengthen + intro store env hpre + obtain ⟨⟨roots, value, houtput, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + have hworld : HasWorld store .shared value := + hown.roots_world ⟨.shared, value⟩ (by simp) + refine ⟨roots, value, houtput, hav, hworld, hvalueGraph, + hrestGraph, ?_, hslots⟩ + simpa [borrowResultRoots] using + hown.dropNoLocation (hsound.stable.const_noLocation hav) + have hcomposed := EmitSoundBelow.comp + (hsound.graphEmits sourceRest rest slots) hconvert + simpa [Function.comp_def] using hcomposed + +/-- Fetch a field through a slot-backed shared borrow. Successful execution +itself identifies a live shared constructor and in-bounds field; the pushed +field is tracked as a borrow while every root remains unchanged. -/ +theorem fetchBorrowSlot_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {targetAbs index : Nat} {release : Bool} + {rest : List Root} {slots : List (Nat × RVal)} : + EmitSoundBelow ctx cur limit + (emitOp (.fetch (.var (Γ.rel targetAbs)) index)) + (OwnsBorrowResultProtected Γ (.slotA targetAbs) release rest slots) + (OwnsFetchedBorrowProtected Γ.bump (.slotA targetAbs) + (.slotA Γ.depth) release rest slots) := by + apply OpSoundBelow.emit + intro fuel store env store' result _ hpre hrun + obtain ⟨⟨roots, targetValue, hΓ, htarget, htargetWorld, hown⟩, + hslots⟩ := hpre + have hresolve : + resolveAtom env (.var (Γ.rel targetAbs)) = .ok targetValue := by + simpa [AVal.toAtom] using htarget.resolveAtom + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [hresolve, bindOk] at hrun + cases targetValue with + | lit literal => contradiction + | erased => contradiction + | loc loc => + obtain ⟨box, hget, hboxWorld⟩ := htargetWorld + cases box with + | mk boxWorld rc node => + dsimp only [NodeBox.world] at hboxWorld + subst boxWorld + dsimp only at hrun + rw [hget] at hrun + dsimp only at hrun + cases node with + | papN f arity args => contradiction + | ctorN cid fields => + dsimp only at hrun + cases hfield : fields[index]? with + | none => + rw [hfield] at hrun + contradiction + | some fieldValue => + rw [hfield] at hrun + have hpair : (store, fieldValue) = (store', result) := + Except.ok.inj hrun + cases hpair + refine ⟨roots, .loc loc, result, hΓ.bump result, + AValStable.slot.realize_bump htarget result, ?_, + ⟨⟨.shared, rc, .ctorN cid fields⟩, hget, rfl⟩, + hown.fetchBorrowed hget hfield, hown, hslots.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +theorem fetchBorrowSlot + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {targetAbs index : Nat} {release : Bool} + {rest : List Root} {slots : List (Nat × RVal)} : + EmitSound ctx cur + (emitOp (.fetch (.var (Γ.rel targetAbs)) index)) + (OwnsBorrowResultProtected Γ (.slotA targetAbs) release rest slots) + (OwnsFetchedBorrowProtected Γ.bump (.slotA targetAbs) + (.slotA Γ.depth) release rest slots) := + EmitSound.of_below fun limit => + fetchBorrowSlot_below (ctx := ctx) (cur := cur) (limit := limit) + +/-- Semantic fetch selects the runtime field graph at the same index as the +successful source constructor projection. -/ +theorem fetchBorrowSlot_value_op + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {address : Ixon.Address} + {tag : Nat} {sourceFields : List IxIR0.Value} + {sourceField : IxIR0.Value} {targetAbs index : Nat} + {release : Bool} {sourceRest : List (Owned × IxIR0.Value)} + {rest : List Root} {slots : List (Nat × RVal)} + (hsourceField : sourceFields[index]? = some sourceField) : + OpSound ctx cur (.fetch (.var (Γ.rel targetAbs)) index) + (GraphOwnsBorrowResultProtected funRel recSelfRel Γ sourceEnv + (.ctor address tag sourceFields) (.slotA targetAbs) release + sourceRest rest slots) + (GraphOwnsFetchedBorrowProtected funRel recSelfRel Γ.bump sourceEnv + (.ctor address tag sourceFields) sourceField + (.slotA targetAbs) (.slotA Γ.depth) release + sourceRest rest slots) := by + intro fuel store env store' result hpre hrun + obtain ⟨roots, targetValue, hΓ, htarget, htargetWorld, + htargetGraph, hrestGraph, hown, hslots⟩ := hpre + have hresolve : + resolveAtom env (.var (Γ.rel targetAbs)) = .ok targetValue := by + simpa [AVal.toAtom] using htarget.resolveAtom + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [hresolve, bindOk] at hrun + cases targetValue with + | lit literal => contradiction + | erased => contradiction + | loc loc => + obtain ⟨box, hget, hboxWorld⟩ := htargetWorld + cases box with + | mk boxWorld rc node => + dsimp only [NodeBox.world] at hboxWorld + subst boxWorld + dsimp only at hrun + rw [hget] at hrun + dsimp only at hrun + cases node with + | papN f arity args => contradiction + | ctorN cid fields => + dsimp only at hrun + cases hfield : fields[index]? with + | none => + rw [hfield] at hrun + contradiction + | some fieldValue => + rw [hfield] at hrun + have hpair : (store, fieldValue) = (store', result) := + Except.ok.inj hrun + cases hpair + obtain ⟨_, _, hfieldsGraph⟩ := + htargetGraph.ctor_fields_of_get hget + obtain ⟨relatedField, hrelatedSlot, hfieldGraph⟩ := + hfieldsGraph.get? hsourceField + have hrelatedArray : + fields[index]? = some relatedField := by + simpa using hrelatedSlot + have hfieldEq : relatedField = result := + Option.some.inj (hrelatedArray.symm.trans hfield) + subst relatedField + refine ⟨roots, .loc loc, result, hΓ.bump result, + AValStable.slot.realize_bump htarget result, ?_, + ⟨⟨.shared, rc, .ctorN cid fields⟩, hget, rfl⟩, + hown.fetchBorrowed hget hfield, htargetGraph, + hfieldGraph, hrestGraph, hown, hslots.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +theorem fetchBorrowSlot_value + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {address : Ixon.Address} + {tag : Nat} {sourceFields : List IxIR0.Value} + {sourceField : IxIR0.Value} {targetAbs index : Nat} + {release : Bool} {sourceRest : List (Owned × IxIR0.Value)} + {rest : List Root} {slots : List (Nat × RVal)} + (hsourceField : sourceFields[index]? = some sourceField) : + EmitSound ctx cur + (emitOp (.fetch (.var (Γ.rel targetAbs)) index)) + (GraphOwnsBorrowResultProtected funRel recSelfRel Γ sourceEnv + (.ctor address tag sourceFields) (.slotA targetAbs) release + sourceRest rest slots) + (GraphOwnsFetchedBorrowProtected funRel recSelfRel Γ.bump sourceEnv + (.ctor address tag sourceFields) sourceField + (.slotA targetAbs) (.slotA Γ.depth) release + sourceRest rest slots) := + OpSound.emit (fetchBorrowSlot_value_op hsourceField) + +/-- Fuel-bounded semantic fetch. -/ +theorem fetchBorrowSlot_value_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {address : Ixon.Address} + {tag : Nat} {sourceFields : List IxIR0.Value} + {sourceField : IxIR0.Value} {targetAbs index : Nat} + {release : Bool} {sourceRest : List (Owned × IxIR0.Value)} + {rest : List Root} {slots : List (Nat × RVal)} + (hsourceField : sourceFields[index]? = some sourceField) : + EmitSoundBelow ctx cur limit + (emitOp (.fetch (.var (Γ.rel targetAbs)) index)) + (GraphOwnsBorrowResultProtected funRel recSelfRel Γ sourceEnv + (.ctor address tag sourceFields) (.slotA targetAbs) release + sourceRest rest slots) + (GraphOwnsFetchedBorrowProtected funRel recSelfRel Γ.bump sourceEnv + (.ctor address tag sourceFields) sourceField + (.slotA targetAbs) (.slotA Γ.depth) release + sourceRest rest slots) := by + apply OpSoundBelow.emit + intro fuel store env store' result _ hpre hrun + obtain ⟨roots, targetValue, hΓ, htarget, htargetWorld, + htargetGraph, hrestGraph, hown, hslots⟩ := hpre + have hresolve : + resolveAtom env (.var (Γ.rel targetAbs)) = .ok targetValue := by + simpa [AVal.toAtom] using htarget.resolveAtom + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [hresolve, bindOk] at hrun + cases targetValue with + | lit literal => contradiction + | erased => contradiction + | loc loc => + obtain ⟨box, hget, hboxWorld⟩ := htargetWorld + cases box with + | mk boxWorld rc node => + dsimp only [NodeBox.world] at hboxWorld + subst boxWorld + dsimp only at hrun + rw [hget] at hrun + dsimp only at hrun + cases node with + | papN f arity args => contradiction + | ctorN cid fields => + dsimp only at hrun + cases hfield : fields[index]? with + | none => + rw [hfield] at hrun + contradiction + | some fieldValue => + rw [hfield] at hrun + have hpair : (store, fieldValue) = (store', result) := + Except.ok.inj hrun + cases hpair + obtain ⟨_, _, hfieldsGraph⟩ := + htargetGraph.ctor_fields_of_get hget + obtain ⟨relatedField, hrelatedSlot, hfieldGraph⟩ := + hfieldsGraph.get? hsourceField + have hrelatedArray : + fields[index]? = some relatedField := by + simpa using hrelatedSlot + have hfieldEq : relatedField = result := + Option.some.inj (hrelatedArray.symm.trans hfield) + subst relatedField + refine ⟨roots, .loc loc, result, hΓ.bump result, + AValStable.slot.realize_bump htarget result, ?_, + ⟨⟨.shared, rc, .ctorN cid fields⟩, hget, rfl⟩, + hown.fetchBorrowed hget hfield, htargetGraph, + hfieldGraph, hrestGraph, hown, hslots.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +/-- Retain the fetched field into a fresh owned result slot while preserving +the original target borrow across the refcount update. -/ +theorem retainFetchedBorrow_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {targetAbs fieldAbs : Nat} {release : Bool} + {rest : List Root} {slots : List (Nat × RVal)} : + EmitSoundBelow ctx cur limit + (emitOp (.dup (.var (Γ.rel fieldAbs)))) + (OwnsFetchedBorrowProtected Γ (.slotA targetAbs) + (.slotA fieldAbs) release rest slots) + (OwnsRetainedProjectionProtected Γ.bump (.slotA targetAbs) + (.slotA Γ.depth) release rest slots) := by + apply OpSoundBelow.emit + intro fuel store env store' result _ hpre hrun + obtain ⟨roots, targetValue, fieldValue, hΓ, htarget, hfield, + htargetWorld, hfieldWorld, hown, hslots⟩ := hpre + have hresolve : + resolveAtom env (.var (Γ.rel fieldAbs)) = .ok fieldValue := by + simpa [AVal.toAtom] using hfield.resolveAtom + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + obtain ⟨nextStore, heval, hownNext, hborrowedNext⟩ := + runOp_retain_borrowed_preserves_hasWorlds + (ctx := ctx) (cur := cur) (fuel := fuel) + hresolve hfieldWorld hown (borrowed := [targetValue]) + (by + intro candidate hmem + simp only [List.mem_singleton] at hmem + subst candidate + exact htargetWorld) + have hpair : (nextStore, fieldValue) = (store', result) := + Except.ok.inj (heval.symm.trans hrun) + cases hpair + refine ⟨roots, targetValue, result, hΓ.bump result, + AValStable.slot.realize_bump htarget result, ?_, + hborrowedNext targetValue (by simp), hownNext, + hslots.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +theorem retainFetchedBorrow + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {targetAbs fieldAbs : Nat} {release : Bool} + {rest : List Root} {slots : List (Nat × RVal)} : + EmitSound ctx cur + (emitOp (.dup (.var (Γ.rel fieldAbs)))) + (OwnsFetchedBorrowProtected Γ (.slotA targetAbs) + (.slotA fieldAbs) release rest slots) + (OwnsRetainedProjectionProtected Γ.bump (.slotA targetAbs) + (.slotA Γ.depth) release rest slots) := + EmitSound.of_below fun limit => + retainFetchedBorrow_below (ctx := ctx) (cur := cur) (limit := limit) + +/-- Semantic retain turns the fetched field graph into a separately owned +result graph and transports all other witnesses through the RC-only update. -/ +theorem retainFetchedBorrow_value_op + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} + {sourceTarget sourceField : IxIR0.Value} + {targetAbs fieldAbs : Nat} {release : Bool} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + {slots : List (Nat × RVal)} : + OpSound ctx cur (.dup (.var (Γ.rel fieldAbs))) + (GraphOwnsFetchedBorrowProtected funRel recSelfRel Γ sourceEnv + sourceTarget sourceField (.slotA targetAbs) (.slotA fieldAbs) + release sourceRest rest slots) + (GraphOwnsRetainedProjectionProtected funRel recSelfRel Γ.bump + sourceEnv sourceTarget sourceField (.slotA targetAbs) + (.slotA Γ.depth) release sourceRest rest slots) := by + intro fuel store env store' result hpre hrun + obtain ⟨roots, targetValue, fieldValue, hΓ, htarget, hfield, + htargetWorld, hfieldWorld, htargetGraph, hfieldGraph, + hrestGraph, hown, hslots⟩ := hpre + have hresolve : + resolveAtom env (.var (Γ.rel fieldAbs)) = .ok fieldValue := by + simpa [AVal.toAtom] using hfield.resolveAtom + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + obtain ⟨nextStore, heval, hstore, hfieldGraphNext, hownNext⟩ := + runOp_retain_borrowed_valueGraph + (ctx := ctx) (cur := cur) (fuel := fuel) + hresolve hfieldWorld hfieldGraph hown + have hpair : (nextStore, fieldValue) = (store', result) := + Except.ok.inj (heval.symm.trans hrun) + cases hpair + refine ⟨roots, targetValue, result, + (hΓ.monoStore hstore).bump result, + AValStable.slot.realize_bump htarget result, ?_, + htargetWorld.monoStore hstore, htargetGraph.monoStore hstore, + hfieldGraphNext, hrestGraph.monoStore hstore, + hownNext, hslots.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +theorem retainFetchedBorrow_value + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} + {sourceTarget sourceField : IxIR0.Value} + {targetAbs fieldAbs : Nat} {release : Bool} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + {slots : List (Nat × RVal)} : + EmitSound ctx cur + (emitOp (.dup (.var (Γ.rel fieldAbs)))) + (GraphOwnsFetchedBorrowProtected funRel recSelfRel Γ sourceEnv + sourceTarget sourceField (.slotA targetAbs) (.slotA fieldAbs) + release sourceRest rest slots) + (GraphOwnsRetainedProjectionProtected funRel recSelfRel Γ.bump + sourceEnv sourceTarget sourceField (.slotA targetAbs) + (.slotA Γ.depth) release sourceRest rest slots) := + OpSound.emit retainFetchedBorrow_value_op + +/-- Fuel-bounded semantic retain of a fetched field. -/ +theorem retainFetchedBorrow_value_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} + {sourceTarget sourceField : IxIR0.Value} + {targetAbs fieldAbs : Nat} {release : Bool} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + {slots : List (Nat × RVal)} : + EmitSoundBelow ctx cur limit + (emitOp (.dup (.var (Γ.rel fieldAbs)))) + (GraphOwnsFetchedBorrowProtected funRel recSelfRel Γ sourceEnv + sourceTarget sourceField (.slotA targetAbs) (.slotA fieldAbs) + release sourceRest rest slots) + (GraphOwnsRetainedProjectionProtected funRel recSelfRel Γ.bump + sourceEnv sourceTarget sourceField (.slotA targetAbs) + (.slotA Γ.depth) release sourceRest rest slots) := by + apply OpSoundBelow.emit + intro fuel store env store' result _ hpre hrun + obtain ⟨roots, targetValue, fieldValue, hΓ, htarget, hfield, + htargetWorld, hfieldWorld, htargetGraph, hfieldGraph, + hrestGraph, hown, hslots⟩ := hpre + have hresolve : + resolveAtom env (.var (Γ.rel fieldAbs)) = .ok fieldValue := by + simpa [AVal.toAtom] using hfield.resolveAtom + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + obtain ⟨nextStore, heval, hstore, hfieldGraphNext, hownNext⟩ := + runOp_retain_borrowed_valueGraph + (ctx := ctx) (cur := cur) (fuel := fuel) + hresolve hfieldWorld hfieldGraph hown + have hpair : (nextStore, fieldValue) = (store', result) := + Except.ok.inj (heval.symm.trans hrun) + cases hpair + refine ⟨roots, targetValue, result, + (hΓ.monoStore hstore).bump result, + AValStable.slot.realize_bump htarget result, ?_, + htargetWorld.monoStore hstore, htargetGraph.monoStore hstore, + hfieldGraphNext, hrestGraph.monoStore hstore, + hownNext, hslots.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +/-- When the projection target remains owned by the output environment, the +retained field is already the complete expression result. -/ +theorem retainedProjection_kept_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {target result : AVal} {rest : List Root} + {slots : List (Nat × RVal)} : + EmitSoundBelow ctx cur limit (_root_.id : Emit) + (OwnsRetainedProjectionProtected Γ target result false rest slots) + (OwnsResultProtected Γ .shared result rest slots) := by + apply EmitSoundBelow.strengthen + intro store env hpre + obtain ⟨roots, targetValue, resultValue, hΓ, htarget, hresult, + htargetWorld, hown, hslots⟩ := hpre + refine ⟨⟨roots, resultValue, hΓ, hresult, ?_⟩, hslots⟩ + simpa [borrowResultRoots] using hown + +theorem retainedProjection_kept + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {target result : AVal} {rest : List Root} + {slots : List (Nat × RVal)} : + EmitSound ctx cur (_root_.id : Emit) + (OwnsRetainedProjectionProtected Γ target result false rest slots) + (OwnsResultProtected Γ .shared result rest slots) := + EmitSound.of_below fun limit => + retainedProjection_kept_below + (ctx := ctx) (cur := cur) (limit := limit) + +/-- Semantic kept-target finish: the separately retained field already has +the graph and exact owner required for the source projection result. -/ +theorem retainedProjection_kept_value + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} + {sourceTarget sourceField : IxIR0.Value} + {target result : AVal} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + {slots : List (Nat × RVal)} : + EmitSound ctx cur (_root_.id : Emit) + (GraphOwnsRetainedProjectionProtected funRel recSelfRel Γ + sourceEnv sourceTarget sourceField target result false + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel Γ + sourceEnv sourceField .shared result sourceRest rest slots) := by + apply EmitSound.strengthen + intro store env hpre + obtain ⟨roots, targetValue, resultValue, hΓ, htarget, hresult, + htargetWorld, htargetGraph, hresultGraph, hrestGraph, + hown, hslots⟩ := hpre + refine ⟨⟨roots, resultValue, hΓ, hresult, hresultGraph, + hrestGraph, ?_⟩, hslots⟩ + simpa [borrowResultRoots] using hown + +/-- Fuel-bounded semantic kept-target finish. -/ +theorem retainedProjection_kept_value_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} + {sourceTarget sourceField : IxIR0.Value} + {target result : AVal} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + {slots : List (Nat × RVal)} : + EmitSoundBelow ctx cur limit (_root_.id : Emit) + (GraphOwnsRetainedProjectionProtected funRel recSelfRel Γ + sourceEnv sourceTarget sourceField target result false + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel Γ + sourceEnv sourceField .shared result sourceRest rest slots) := by + apply EmitSoundBelow.strengthen + intro store env hpre + obtain ⟨roots, targetValue, resultValue, hΓ, htarget, hresult, + htargetWorld, htargetGraph, hresultGraph, hrestGraph, + hown, hslots⟩ := hpre + refine ⟨⟨roots, resultValue, hΓ, hresult, hresultGraph, + hrestGraph, ?_⟩, hslots⟩ + simpa [borrowResultRoots] using hown + +/-- Release a final-use projection target after retaining its field. The +inert drop result pushes one slot, while the retained field root and result +descriptor survive as the expression output. -/ +theorem releaseRetainedProjection_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {targetAbs resultAbs : Nat} {rest : List Root} + {slots : List (Nat × RVal)} : + EmitSoundBelow ctx cur limit + (emitOp (.drop (.var (Γ.rel targetAbs)))) + (OwnsRetainedProjectionProtected Γ (.slotA targetAbs) + (.slotA resultAbs) true rest slots) + (OwnsResultProtected Γ.bump .shared (.slotA resultAbs) rest slots) := by + intro bound hbound post code hcode + intro fuel store env finalStore finalValue hfuel hpre hrun + obtain ⟨roots, targetValue, resultValue, hΓ, htarget, hresult, + htargetWorld, hown, hslots⟩ := hpre + let frame : List RVal → Prop := fun oldEnv => + VEnvRealizes Γ oldEnv roots ∧ + AValRealizes Γ oldEnv (.slotA resultAbs) resultValue ∧ + SlotsRealize Γ oldEnv slots + let remainingRoots := ⟨Owned.shared, resultValue⟩ :: roots ++ rest + have howned : RootOwnership store + (⟨.shared, targetValue⟩ :: remainingRoots) := by + apply hown.perm + simpa [remainingRoots, borrowResultRoots] using + (List.Perm.swap ⟨Owned.shared, targetValue⟩ + ⟨Owned.shared, resultValue⟩ (roots ++ rest)) + have hnext : CodeOwnsBelow ctx cur bound + (OwnsAfterPush frame remainingRoots) post code := by + intro nextFuel nextStore nextEnv resultStore resultValue' hnextFuel + hpushed hcodeRun + obtain ⟨pushed, oldEnv, rfl, ⟨hΓOld, hresultOld, hslotsOld⟩, + hownRest⟩ := hpushed + apply hcode hnextFuel + · refine ⟨⟨roots, resultValue, hΓOld.bump pushed, + AValStable.slot.realize_bump hresultOld pushed, ?_⟩, + hslotsOld.bump pushed⟩ + simpa [remainingRoots] using hownRest + · exact hcodeRun + have hdrop : CodeOwnsBelow ctx cur bound + (fun dropStore dropEnv => + frame dropEnv ∧ + resolveAtom dropEnv (.var (Γ.rel targetAbs)) = + .ok targetValue ∧ + RootOwnership dropStore + (⟨.shared, targetValue⟩ :: remainingRoots)) + post (emitOp (.drop (.var (Γ.rel targetAbs))) code) := + (emit_drop_value_owned_below (ctx := ctx) (cur := cur) + (limit := limit) (target := .var (Γ.rel targetAbs)) + (value := targetValue) (rest := remainingRoots) (frame := frame)) + bound hbound post code hnext + apply hdrop hfuel + · refine ⟨⟨hΓ, hresult, hslots⟩, ?_, howned⟩ + simpa [AVal.toAtom] using htarget.resolveAtom + · exact hrun + +theorem releaseRetainedProjection + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {targetAbs resultAbs : Nat} {rest : List Root} + {slots : List (Nat × RVal)} : + EmitSound ctx cur + (emitOp (.drop (.var (Γ.rel targetAbs)))) + (OwnsRetainedProjectionProtected Γ (.slotA targetAbs) + (.slotA resultAbs) true rest slots) + (OwnsResultProtected Γ.bump .shared (.slotA resultAbs) rest slots) := + EmitSound.of_below fun limit => + releaseRetainedProjection_below + (ctx := ctx) (cur := cur) (limit := limit) + +/-- Semantic final-use finish: after retaining the projected field, dropping +the target restricts the heap without changing surviving node shapes. The +result, environment, and caller-frame graphs therefore transport to the +post-state. -/ +theorem releaseRetainedProjection_value_op + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} + {sourceTarget sourceField : IxIR0.Value} + {targetAbs resultAbs : Nat} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + {slots : List (Nat × RVal)} : + OpSound ctx cur (.drop (.var (Γ.rel targetAbs))) + (GraphOwnsRetainedProjectionProtected funRel recSelfRel Γ + sourceEnv sourceTarget sourceField (.slotA targetAbs) + (.slotA resultAbs) true sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel Γ.bump + sourceEnv sourceField .shared (.slotA resultAbs) + sourceRest rest slots) := by + intro fuel store env store' result hpre hrun + obtain ⟨roots, targetValue, resultValue, hΓ, htarget, hresult, + htargetWorld, htargetGraph, hresultGraph, hrestGraph, + hown, hslots⟩ := hpre + have hresolve : + resolveAtom env (.var (Γ.rel targetAbs)) = .ok targetValue := by + simpa [AVal.toAtom] using htarget.resolveAtom + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + let remainingRoots := + ⟨Owned.shared, resultValue⟩ :: roots ++ rest + have howned : RootOwnership store + (⟨.shared, targetValue⟩ :: remainingRoots) := by + apply hown.perm + simpa [remainingRoots, borrowResultRoots] using + (List.Perm.swap ⟨Owned.shared, targetValue⟩ + ⟨Owned.shared, resultValue⟩ (roots ++ rest)) + obtain ⟨rfl, hrestrict, hownAfter⟩ := + runOp_drop_value_owned_restricts hresolve howned hrun + have hresultWorld : HasWorld store' .shared resultValue := + hownAfter.roots_world ⟨.shared, resultValue⟩ + (by simp [remainingRoots]) + have hΓAfter : VEnvValueGraph funRel recSelfRel store' + Γ sourceEnv env roots := + hΓ.ofRestricts hrestrict hownAfter + (fun root hmember => by + simp [remainingRoots, hmember]) + have hresultAfter : Sim.ValueGraph funRel store' + sourceField resultValue := + hresultGraph.ofRestricts hrestrict hownAfter hresultWorld + have hrestAfter : Sim.RootsGraph funRel store' + sourceRest rest := + hrestGraph.ofRestrictsIn hrestrict hownAfter + (fun root hmember => by + simp [remainingRoots, hmember]) + refine ⟨⟨roots, resultValue, hΓAfter.bump .erased, + AValStable.slot.realize_bump hresult .erased, + hresultAfter, hrestAfter, ?_⟩, hslots.bump .erased⟩ + simpa [remainingRoots] using hownAfter + +theorem releaseRetainedProjection_value + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} + {sourceTarget sourceField : IxIR0.Value} + {targetAbs resultAbs : Nat} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + {slots : List (Nat × RVal)} : + EmitSound ctx cur + (emitOp (.drop (.var (Γ.rel targetAbs)))) + (GraphOwnsRetainedProjectionProtected funRel recSelfRel Γ + sourceEnv sourceTarget sourceField (.slotA targetAbs) + (.slotA resultAbs) true sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel Γ.bump + sourceEnv sourceField .shared (.slotA resultAbs) + sourceRest rest slots) := + OpSound.emit releaseRetainedProjection_value_op + +/-- Fuel-bounded semantic final-use projection finish. -/ +theorem releaseRetainedProjection_value_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} + {sourceTarget sourceField : IxIR0.Value} + {targetAbs resultAbs : Nat} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + {slots : List (Nat × RVal)} : + EmitSoundBelow ctx cur limit + (emitOp (.drop (.var (Γ.rel targetAbs)))) + (GraphOwnsRetainedProjectionProtected funRel recSelfRel Γ + sourceEnv sourceTarget sourceField (.slotA targetAbs) + (.slotA resultAbs) true sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel Γ.bump + sourceEnv sourceField .shared (.slotA resultAbs) + sourceRest rest slots) := by + apply OpSoundBelow.emit + intro fuel store env store' result _ hpre hrun + obtain ⟨roots, targetValue, resultValue, hΓ, htarget, hresult, + htargetWorld, htargetGraph, hresultGraph, hrestGraph, + hown, hslots⟩ := hpre + have hresolve : + resolveAtom env (.var (Γ.rel targetAbs)) = .ok targetValue := by + simpa [AVal.toAtom] using htarget.resolveAtom + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + let remainingRoots := + ⟨Owned.shared, resultValue⟩ :: roots ++ rest + have howned : RootOwnership store + (⟨.shared, targetValue⟩ :: remainingRoots) := by + apply hown.perm + simpa [remainingRoots, borrowResultRoots] using + (List.Perm.swap ⟨.shared, targetValue⟩ + ⟨.shared, resultValue⟩ (roots ++ rest)) + obtain ⟨rfl, hrestrict, hownAfter⟩ := + runOp_drop_value_owned_restricts hresolve howned hrun + have hresultWorld : HasWorld store' .shared resultValue := + hownAfter.roots_world ⟨.shared, resultValue⟩ + (by simp [remainingRoots]) + have hΓAfter : VEnvValueGraph funRel recSelfRel store' + Γ sourceEnv env roots := + hΓ.ofRestricts hrestrict hownAfter + (fun root hmember => by + simp [remainingRoots, hmember]) + have hresultAfter : Sim.ValueGraph funRel store' + sourceField resultValue := + hresultGraph.ofRestricts hrestrict hownAfter hresultWorld + have hrestAfter : Sim.RootsGraph funRel store' + sourceRest rest := + hrestGraph.ofRestrictsIn hrestrict hownAfter + (fun root hmember => by + simp [remainingRoots, hmember]) + refine ⟨⟨roots, resultValue, hΓAfter.bump .erased, + AValStable.slot.realize_bump hresult .erased, + hresultAfter, hrestAfter, ?_⟩, hslots.bump .erased⟩ + simpa [remainingRoots] using hownAfter + +/-- Finish an erased borrowing result as an ordinary shared expression +result. Erased values have no heap location, so adding the distinguished +result root does not change the ownership accounting. -/ +theorem LowerBorrowSoundBelow.returnErased + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} {emit : Emit} {release : Bool} + (hsound : LowerBorrowSoundBelow ctx cur limit input output emit + (.constA .erased) release) : + LowerResultSoundBelow ctx cur limit input output .shared emit + (.constA .erased) := by + refine ⟨.erased, ?_⟩ + intro rest slots + have hconvert : EmitSoundBelow ctx cur limit (_root_.id : Emit) + (OwnsBorrowResultProtected output (.constA .erased) release rest slots) + (OwnsResultProtected output .shared (.constA .erased) rest slots) := by + apply EmitSoundBelow.strengthen + intro store env hpre + obtain ⟨⟨roots, value, houtput, hav, _, hown⟩, hslots⟩ := hpre + refine ⟨⟨roots, value, houtput, hav, ?_⟩, hslots⟩ + cases release with + | false => + simpa [borrowResultRoots] using + hown.addNoLocation (hsound.stable.const_noLocation hav) + | true => simpa [borrowResultRoots] using hown + have hcomposed := EmitSoundBelow.comp (hsound.emits rest slots) hconvert + simpa [Function.comp_def] using hcomposed + +/-- Unbounded erased-borrow finish. Whether or not the borrowing result +carried a pending logical owner, erased has no heap location and can be +returned at shared world without changing the store. -/ +theorem LowerBorrowSound.returnErased + {ctx : Ctx} {cur : FnDef} + {input output : VEnv} {emit : Emit} {release : Bool} + (hsound : LowerBorrowSound ctx cur input output emit + (.constA .erased) release) : + LowerResultSound ctx cur input output .shared emit + (.constA .erased) := by + refine ⟨.erased, ?_⟩ + intro rest slots + have hconvert : EmitSound ctx cur (_root_.id : Emit) + (OwnsBorrowResultProtected output (.constA .erased) release rest slots) + (OwnsResultProtected output .shared (.constA .erased) rest slots) := by + apply EmitSound.strengthen + intro store env hpre + obtain ⟨⟨roots, value, houtput, hav, _, hown⟩, hslots⟩ := hpre + refine ⟨⟨roots, value, houtput, hav, ?_⟩, hslots⟩ + cases release with + | false => + simpa [borrowResultRoots] using + hown.addNoLocation (hsound.stable.const_noLocation hav) + | true => simpa [borrowResultRoots] using hown + have hcomposed := EmitSound.comp (hsound.emits rest slots) hconvert + simpa [Function.comp_def] using hcomposed + +/-- Semantic erased-borrow finish. The erased value graph and all framed +graphs are preserved while the ownership-inert result root is exposed. -/ +theorem LowerBorrowValueSound.returnErased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {emit : Emit} {release : Bool} + (hsound : LowerBorrowValueSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput .erased emit + (.constA .erased) release) : + LowerResultValueSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput .erased .shared emit + (.constA .erased) := by + refine + { toLowerResultSound := + hsound.toLowerBorrowSound.returnErased + graphEmits := ?_ } + intro sourceRest rest slots + have hconvert : EmitSound ctx cur (_root_.id : Emit) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput .erased (.constA .erased) release + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output + sourceOutput .erased .shared (.constA .erased) + sourceRest rest slots) := by + apply EmitSound.strengthen + intro store env hpre + obtain ⟨roots, value, houtput, hav, hworld, hvalueGraph, + hrestGraph, hown, hslots⟩ := hpre + refine ⟨⟨roots, value, houtput, hav, hvalueGraph, + hrestGraph, ?_⟩, hslots⟩ + cases release with + | false => + simpa [borrowResultRoots] using + hown.addNoLocation (hsound.stable.const_noLocation hav) + | true => simpa [borrowResultRoots] using hown + have hcomposed := EmitSound.comp + (hsound.graphEmits sourceRest rest slots) hconvert + simpa [Function.comp_def] using hcomposed + +/-- Fuel-bounded semantic erased-borrow finish. -/ +theorem LowerBorrowValueSoundBelow.returnErased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {emit : Emit} {release : Bool} + (hsound : LowerBorrowValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput .erased emit + (.constA .erased) release) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceInput sourceOutput .erased .shared emit (.constA .erased) := by + refine + { toLowerResultSoundBelow := + hsound.toLowerBorrowSoundBelow.returnErased + graphEmits := ?_ } + intro sourceRest rest slots + have hconvert : EmitSoundBelow ctx cur limit (_root_.id : Emit) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput .erased (.constA .erased) release + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output + sourceOutput .erased .shared (.constA .erased) + sourceRest rest slots) := by + apply EmitSoundBelow.strengthen + intro store env hpre + obtain ⟨roots, value, houtput, hav, hworld, hvalueGraph, + hrestGraph, hown, hslots⟩ := hpre + refine ⟨⟨roots, value, houtput, hav, hvalueGraph, + hrestGraph, ?_⟩, hslots⟩ + cases release with + | false => + simpa [borrowResultRoots] using + hown.addNoLocation (hsound.stable.const_noLocation hav) + | true => simpa [borrowResultRoots] using hown + have hcomposed := EmitSoundBelow.comp + (hsound.graphEmits sourceRest rest slots) hconvert + simpa [Function.comp_def] using hcomposed + +/-- Project through a retained slot borrow while keeping its original owner +in the output environment. Fetch adds a borrow and `dup` turns that field +into the owned shared expression result. -/ +theorem LowerBorrowSoundBelow.projectSlotKept + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} {emit : Emit} {targetAbs index : Nat} + (hsound : LowerBorrowSoundBelow ctx cur limit input output emit + (.slotA targetAbs) false) : + LowerResultSoundBelow ctx cur limit input output.bump.bump .shared + (emit ∘ emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth)))) + (.slotA output.bump.depth) := by + refine ⟨.slot, ?_⟩ + intro rest slots + have hfetch := fetchBorrowSlot_below + (ctx := ctx) (cur := cur) (limit := limit) (Γ := output) + (targetAbs := targetAbs) (index := index) (release := false) + (rest := rest) (slots := slots) + have hretain := retainFetchedBorrow_below + (ctx := ctx) (cur := cur) (limit := limit) (Γ := output.bump) + (targetAbs := targetAbs) (fieldAbs := output.depth) + (release := false) (rest := rest) (slots := slots) + have hfinish := retainedProjection_kept_below + (ctx := ctx) (cur := cur) (limit := limit) (Γ := output.bump.bump) + (target := .slotA targetAbs) (result := .slotA output.bump.depth) + (rest := rest) (slots := slots) + have hcomposed := EmitSoundBelow.comp (hsound.emits rest slots) + (EmitSoundBelow.comp hfetch (EmitSoundBelow.comp hretain hfinish)) + simpa [Function.comp_def] using hcomposed + +/-- Project through a final-use slot borrow, retaining the field before +dropping the now-consumed target owner. -/ +theorem LowerBorrowSoundBelow.projectSlotReleased + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} {emit : Emit} {targetAbs index : Nat} + (hsound : LowerBorrowSoundBelow ctx cur limit input output emit + (.slotA targetAbs) true) : + LowerResultSoundBelow ctx cur limit input output.bump.bump.bump .shared + (emit ∘ emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth))) ∘ + emitOp (.drop (.var (output.bump.bump.rel targetAbs)))) + (.slotA output.bump.depth) := by + refine ⟨.slot, ?_⟩ + intro rest slots + have hfetch := fetchBorrowSlot_below + (ctx := ctx) (cur := cur) (limit := limit) (Γ := output) + (targetAbs := targetAbs) (index := index) (release := true) + (rest := rest) (slots := slots) + have hretain := retainFetchedBorrow_below + (ctx := ctx) (cur := cur) (limit := limit) (Γ := output.bump) + (targetAbs := targetAbs) (fieldAbs := output.depth) + (release := true) (rest := rest) (slots := slots) + have hfinish := releaseRetainedProjection_below + (ctx := ctx) (cur := cur) (limit := limit) (Γ := output.bump.bump) + (targetAbs := targetAbs) (resultAbs := output.bump.depth) + (rest := rest) (slots := slots) + have hcomposed := EmitSoundBelow.comp (hsound.emits rest slots) + (EmitSoundBelow.comp hfetch (EmitSoundBelow.comp hretain hfinish)) + simpa [Function.comp_def] using hcomposed + +theorem LowerBorrowSound.projectSlotKept + {ctx : Ctx} {cur : FnDef} + {input output : VEnv} {emit : Emit} {targetAbs index : Nat} + (hsound : LowerBorrowSound ctx cur input output emit + (.slotA targetAbs) false) : + LowerResultSound ctx cur input output.bump.bump .shared + (emit ∘ emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth)))) + (.slotA output.bump.depth) := by + refine ⟨.slot, ?_⟩ + intro rest slots + have hfetch := fetchBorrowSlot + (ctx := ctx) (cur := cur) (Γ := output) + (targetAbs := targetAbs) (index := index) (release := false) + (rest := rest) (slots := slots) + have hretain := retainFetchedBorrow + (ctx := ctx) (cur := cur) (Γ := output.bump) + (targetAbs := targetAbs) (fieldAbs := output.depth) + (release := false) (rest := rest) (slots := slots) + have hfinish := retainedProjection_kept + (ctx := ctx) (cur := cur) (Γ := output.bump.bump) + (target := .slotA targetAbs) (result := .slotA output.bump.depth) + (rest := rest) (slots := slots) + have hcomposed := EmitSound.comp (hsound.emits rest slots) + (EmitSound.comp hfetch (EmitSound.comp hretain hfinish)) + simpa [Function.comp_def] using hcomposed + +theorem LowerBorrowSound.projectSlotReleased + {ctx : Ctx} {cur : FnDef} + {input output : VEnv} {emit : Emit} {targetAbs index : Nat} + (hsound : LowerBorrowSound ctx cur input output emit + (.slotA targetAbs) true) : + LowerResultSound ctx cur input output.bump.bump.bump .shared + (emit ∘ emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth))) ∘ + emitOp (.drop (.var (output.bump.bump.rel targetAbs)))) + (.slotA output.bump.depth) := by + refine ⟨.slot, ?_⟩ + intro rest slots + have hfetch := fetchBorrowSlot + (ctx := ctx) (cur := cur) (Γ := output) + (targetAbs := targetAbs) (index := index) (release := true) + (rest := rest) (slots := slots) + have hretain := retainFetchedBorrow + (ctx := ctx) (cur := cur) (Γ := output.bump) + (targetAbs := targetAbs) (fieldAbs := output.depth) + (release := true) (rest := rest) (slots := slots) + have hfinish := releaseRetainedProjection + (ctx := ctx) (cur := cur) (Γ := output.bump.bump) + (targetAbs := targetAbs) (resultAbs := output.bump.depth) + (rest := rest) (slots := slots) + have hcomposed := EmitSound.comp (hsound.emits rest slots) + (EmitSound.comp hfetch (EmitSound.comp hretain hfinish)) + simpa [Function.comp_def] using hcomposed + +/-! ### The source evaluator's projection outcomes + +Target-side projection is one syntactic form with four descriptor branches, +while the source evaluator distinguishes only constructor data and the +erased absorber. `SourceProject` names that source-side dichotomy so a +single dispatch theorem covers both, and `of_eval` pins it to the real +evaluator rather than to a hand-written reading of it. -/ + +/-- The two successful outcomes of `IxIR0.eval`'s `.proj` arm: select a +constructor field, or absorb into `◻`. -/ +inductive SourceProject (index : Nat) : IxIR0.Value → IxIR0.Value → Prop where + | ctor {address : Ixon.Address} {tag : Nat} + {fields : List IxIR0.Value} {value : IxIR0.Value} : + fields[index]? = some value → + SourceProject index (.ctor address tag fields) value + | erased : SourceProject index .erased .erased + +/-- Every successful source projection over a successful target evaluation +is one of the two `SourceProject` outcomes. -/ +theorem SourceProject.of_eval {srcCtx : IxIR0.Ctx} {sourceFuel : Nat} + {sourceEnv : List IxIR0.Value} {index : Nat} {source : IxIR0.Expr} + {sourceTarget sourceValue : IxIR0.Value} + (htarget : IxIR0.eval srcCtx sourceFuel sourceEnv source = + .ok sourceTarget) + (hproject : IxIR0.eval srcCtx (sourceFuel + 1) sourceEnv + (.proj index source) = .ok sourceValue) : + SourceProject index sourceTarget sourceValue := by + rw [IxIR0.eval.eq_def] at hproject + dsimp only at hproject + rw [htarget, bindOk] at hproject + cases sourceTarget with + | clos uses env body => exact absurd hproject (by simp) + | pap head args => exact absurd hproject (by simp) + | lit literal => exact absurd hproject (by simp) + | erased => + dsimp only at hproject + have hvalue : IxIR0.Value.erased = sourceValue := + Except.ok.inj hproject + subst hvalue + exact .erased + | ctor address tag fields => + dsimp only at hproject + cases hfield : fields[index]? with + | none => + rw [hfield] at hproject + exact absurd hproject (by simp) + | some field => + rw [hfield] at hproject + have hvalue : field = sourceValue := Except.ok.inj hproject + subst hvalue + exact .ctor hfield + +/-- Semantic projection through a retained slot. The source constructor-field +lookup selects the same field graph that `fetch` returns, and `dup` gives it +the distinguished shared result owner. -/ +theorem LowerBorrowValueSound.projectSlotKept + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {address : Ixon.Address} {tag : Nat} + {sourceFields : List IxIR0.Value} {sourceField : IxIR0.Value} + {emit : Emit} {targetAbs index : Nat} + (hsound : LowerBorrowValueSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput + (.ctor address tag sourceFields) emit (.slotA targetAbs) false) + (hsourceField : sourceFields[index]? = some sourceField) : + LowerResultValueSound funRel recSelfRel ctx cur + input output.bump.bump sourceInput sourceOutput sourceField .shared + (emit ∘ emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth)))) + (.slotA output.bump.depth) := by + refine + { toLowerResultSound := + hsound.toLowerBorrowSound.projectSlotKept + graphEmits := ?_ } + intro sourceRest rest slots + have hfetch := fetchBorrowSlot_value + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output) + (sourceEnv := sourceOutput) (address := address) (tag := tag) + (targetAbs := targetAbs) (index := index) (release := false) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + hsourceField + have hretain := retainFetchedBorrow_value + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output.bump) + (sourceEnv := sourceOutput) + (sourceTarget := .ctor address tag sourceFields) + (sourceField := sourceField) (targetAbs := targetAbs) + (fieldAbs := output.depth) (release := false) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + have hfinish := retainedProjection_kept_value + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output.bump.bump) + (sourceEnv := sourceOutput) + (sourceTarget := .ctor address tag sourceFields) + (sourceField := sourceField) (target := .slotA targetAbs) + (result := .slotA output.bump.depth) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + have hcomposed := EmitSound.comp + (hsound.graphEmits sourceRest rest slots) + (EmitSound.comp hfetch (EmitSound.comp hretain hfinish)) + simpa [Function.comp_def] using hcomposed + +/-- Semantic projection through a final-use slot. The retained field remains +graph-related after the target's destructive release because the release +proof transports every surviving root through the resulting store +restriction. -/ +theorem LowerBorrowValueSound.projectSlotReleased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {address : Ixon.Address} {tag : Nat} + {sourceFields : List IxIR0.Value} {sourceField : IxIR0.Value} + {emit : Emit} {targetAbs index : Nat} + (hsound : LowerBorrowValueSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput + (.ctor address tag sourceFields) emit (.slotA targetAbs) true) + (hsourceField : sourceFields[index]? = some sourceField) : + LowerResultValueSound funRel recSelfRel ctx cur + input output.bump.bump.bump sourceInput sourceOutput sourceField .shared + (emit ∘ emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth))) ∘ + emitOp (.drop (.var (output.bump.bump.rel targetAbs)))) + (.slotA output.bump.depth) := by + refine + { toLowerResultSound := + hsound.toLowerBorrowSound.projectSlotReleased + graphEmits := ?_ } + intro sourceRest rest slots + have hfetch := fetchBorrowSlot_value + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output) + (sourceEnv := sourceOutput) (address := address) (tag := tag) + (targetAbs := targetAbs) (index := index) (release := true) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + hsourceField + have hretain := retainFetchedBorrow_value + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output.bump) + (sourceEnv := sourceOutput) + (sourceTarget := .ctor address tag sourceFields) + (sourceField := sourceField) (targetAbs := targetAbs) + (fieldAbs := output.depth) (release := true) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + have hfinish := releaseRetainedProjection_value + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output.bump.bump) + (sourceEnv := sourceOutput) + (sourceTarget := .ctor address tag sourceFields) + (sourceField := sourceField) (targetAbs := targetAbs) + (resultAbs := output.bump.depth) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + have hcomposed := EmitSound.comp + (hsound.graphEmits sourceRest rest slots) + (EmitSound.comp hfetch (EmitSound.comp hretain hfinish)) + simpa [Function.comp_def] using hcomposed + +/-- Fuel-bounded semantic projection through a retained slot. -/ +theorem LowerBorrowValueSoundBelow.projectSlotKept + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {address : Ixon.Address} {tag : Nat} + {sourceFields : List IxIR0.Value} {sourceField : IxIR0.Value} + {emit : Emit} {targetAbs index : Nat} + (hsound : LowerBorrowValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput + (.ctor address tag sourceFields) emit (.slotA targetAbs) false) + (hsourceField : sourceFields[index]? = some sourceField) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input + output.bump.bump sourceInput sourceOutput sourceField .shared + (emit ∘ emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth)))) + (.slotA output.bump.depth) := by + refine + { toLowerResultSoundBelow := + hsound.toLowerBorrowSoundBelow.projectSlotKept + graphEmits := ?_ } + intro sourceRest rest slots + have hfetch := fetchBorrowSlot_value_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) (Γ := output) + (sourceEnv := sourceOutput) (address := address) (tag := tag) + (targetAbs := targetAbs) (index := index) (release := false) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + hsourceField + have hretain := retainFetchedBorrow_value_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) (Γ := output.bump) + (sourceEnv := sourceOutput) + (sourceTarget := .ctor address tag sourceFields) + (sourceField := sourceField) (targetAbs := targetAbs) + (fieldAbs := output.depth) (release := false) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + have hfinish := retainedProjection_kept_value_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) + (Γ := output.bump.bump) (sourceEnv := sourceOutput) + (sourceTarget := .ctor address tag sourceFields) + (sourceField := sourceField) (target := .slotA targetAbs) + (result := .slotA output.bump.depth) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + have hcomposed := EmitSoundBelow.comp + (hsound.graphEmits sourceRest rest slots) + (EmitSoundBelow.comp hfetch (EmitSoundBelow.comp hretain hfinish)) + simpa [Function.comp_def] using hcomposed + +/-- Fuel-bounded semantic projection through a final-use slot. -/ +theorem LowerBorrowValueSoundBelow.projectSlotReleased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {address : Ixon.Address} {tag : Nat} + {sourceFields : List IxIR0.Value} {sourceField : IxIR0.Value} + {emit : Emit} {targetAbs index : Nat} + (hsound : LowerBorrowValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput + (.ctor address tag sourceFields) emit (.slotA targetAbs) true) + (hsourceField : sourceFields[index]? = some sourceField) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input + output.bump.bump.bump sourceInput sourceOutput sourceField .shared + (emit ∘ emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth))) ∘ + emitOp (.drop (.var (output.bump.bump.rel targetAbs)))) + (.slotA output.bump.depth) := by + refine + { toLowerResultSoundBelow := + hsound.toLowerBorrowSoundBelow.projectSlotReleased + graphEmits := ?_ } + intro sourceRest rest slots + have hfetch := fetchBorrowSlot_value_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) (Γ := output) + (sourceEnv := sourceOutput) (address := address) (tag := tag) + (targetAbs := targetAbs) (index := index) (release := true) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + hsourceField + have hretain := retainFetchedBorrow_value_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) (Γ := output.bump) + (sourceEnv := sourceOutput) + (sourceTarget := .ctor address tag sourceFields) + (sourceField := sourceField) (targetAbs := targetAbs) + (fieldAbs := output.depth) (release := true) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + have hfinish := releaseRetainedProjection_value_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) + (Γ := output.bump.bump) (sourceEnv := sourceOutput) + (sourceTarget := .ctor address tag sourceFields) + (sourceField := sourceField) (targetAbs := targetAbs) + (resultAbs := output.bump.depth) + (sourceRest := sourceRest) (rest := rest) (slots := slots) + have hcomposed := EmitSoundBelow.comp + (hsound.graphEmits sourceRest rest slots) + (EmitSoundBelow.comp hfetch (EmitSoundBelow.comp hretain hfinish)) + simpa [Function.comp_def] using hcomposed + +/-! ### Projection branches unreachable at their source shape + +The compiler chooses a projection branch from the borrow *descriptor*, which +is independent of the source target's shape. The two mismatched pairings +below are therefore genuine proof obligations rather than syntactic +impossibilities, and both are discharged by showing that no execution +reaches them. -/ + +/-- Fetching a field from an erased source target can never succeed. The +borrowed runtime value is either the erased scalar itself or — through the +abstract function relation — a pap node, and `fetch` rejects both. -/ +theorem fetchErasedSlot_false_op + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {targetAbs index : Nat} + {release : Bool} {sourceRest : List (Owned × IxIR0.Value)} + {rest : List Root} {slots : List (Nat × RVal)} : + OpSound ctx cur (.fetch (.var (Γ.rel targetAbs)) index) + (GraphOwnsBorrowResultProtected funRel recSelfRel Γ sourceEnv + .erased (.slotA targetAbs) release sourceRest rest slots) + (fun _ _ => False) := by + intro fuel store env store' result hpre hrun + obtain ⟨roots, targetValue, hΓ, htarget, htargetWorld, + htargetGraph, hrestGraph, hown, hslots⟩ := hpre + have hresolve : + resolveAtom env (.var (Γ.rel targetAbs)) = .ok targetValue := by + simpa [AVal.toAtom] using htarget.resolveAtom + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [hresolve, bindOk] at hrun + cases htargetGraph with + | erased => contradiction + | function hget _ _ => + dsimp only at hrun + rw [hget] at hrun + dsimp only at hrun + contradiction + +theorem fetchErasedSlot_false + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {targetAbs index : Nat} + {release : Bool} {sourceRest : List (Owned × IxIR0.Value)} + {rest : List Root} {slots : List (Nat × RVal)} : + EmitSound ctx cur + (emitOp (.fetch (.var (Γ.rel targetAbs)) index)) + (GraphOwnsBorrowResultProtected funRel recSelfRel Γ sourceEnv + .erased (.slotA targetAbs) release sourceRest rest slots) + (fun _ _ => False) := + OpSound.emit fetchErasedSlot_false_op + +/-- Fuel-bounded unreachable fetch from an erased source value. -/ +theorem fetchErasedSlot_false_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {targetAbs index : Nat} + {release : Bool} {sourceRest : List (Owned × IxIR0.Value)} + {rest : List Root} {slots : List (Nat × RVal)} : + EmitSoundBelow ctx cur limit + (emitOp (.fetch (.var (Γ.rel targetAbs)) index)) + (GraphOwnsBorrowResultProtected funRel recSelfRel Γ sourceEnv + .erased (.slotA targetAbs) release sourceRest rest slots) + (fun _ _ => False) := by + apply OpSoundBelow.emit + intro fuel store env store' result _ hpre hrun + obtain ⟨roots, targetValue, hΓ, htarget, htargetWorld, + htargetGraph, hrestGraph, hown, hslots⟩ := hpre + have hresolve : + resolveAtom env (.var (Γ.rel targetAbs)) = .ok targetValue := by + simpa [AVal.toAtom] using htarget.resolveAtom + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [hresolve, bindOk] at hrun + cases htargetGraph with + | erased => contradiction + | function hget _ _ => + dsimp only at hrun + rw [hget] at hrun + dsimp only at hrun + contradiction + +/-- A constructor-shaped source target is never realized by the erased +scalar, so the descriptor-absorbing branch is unreachable with constructor +data. The ownership half is the ordinary erased finish. -/ +theorem LowerBorrowValueSound.projectCtorErased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {address : Ixon.Address} {tag : Nat} + {sourceFields : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {release : Bool} + (hsound : LowerBorrowValueSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput + (.ctor address tag sourceFields) emit (.constA .erased) release) : + LowerResultValueSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceValue .shared emit + (.constA .erased) := by + refine + { toLowerResultSound := hsound.toLowerBorrowSound.returnErased + graphEmits := ?_ } + intro sourceRest rest slots + apply EmitSound.ofFalseMid + apply EmitSound.comp (hsound.graphEmits sourceRest rest slots) + apply EmitSound.strengthen + intro store env hpre + obtain ⟨roots, value, _, hav, _, hgraph, _, _, _⟩ := hpre + cases hav with + | const hresolve => + simp only [resolveAtom] at hresolve + have hvalue : RVal.erased = value := Except.ok.inj hresolve + subst hvalue + cases hgraph + +/-- Erased-target projection through a retained slot. The emitted `fetch` +cannot succeed, so the branch transports the source projection result +whatever it is. -/ +theorem LowerBorrowValueSound.projectSlotKeptErased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} + {emit : Emit} {targetAbs index : Nat} + (hsound : LowerBorrowValueSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput .erased emit + (.slotA targetAbs) false) : + LowerResultValueSound funRel recSelfRel ctx cur + input output.bump.bump sourceInput sourceOutput sourceValue .shared + (emit ∘ emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth)))) + (.slotA output.bump.depth) := by + refine + { toLowerResultSound := + hsound.toLowerBorrowSound.projectSlotKept + graphEmits := ?_ } + intro sourceRest rest slots + exact EmitSound.comp (hsound.graphEmits sourceRest rest slots) + (EmitSound.comp + (fetchErasedSlot_false (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output) (sourceEnv := sourceOutput) + (targetAbs := targetAbs) (index := index) (release := false) + (sourceRest := sourceRest) (rest := rest) (slots := slots)) + EmitSound.ofFalse) + +/-- Erased-target projection through a final-use slot: the same unreachable +`fetch`, one emitted `drop` further along. -/ +theorem LowerBorrowValueSound.projectSlotReleasedErased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} + {emit : Emit} {targetAbs index : Nat} + (hsound : LowerBorrowValueSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput .erased emit + (.slotA targetAbs) true) : + LowerResultValueSound funRel recSelfRel ctx cur + input output.bump.bump.bump sourceInput sourceOutput sourceValue + .shared + (emit ∘ emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth))) ∘ + emitOp (.drop (.var (output.bump.bump.rel targetAbs)))) + (.slotA output.bump.depth) := by + refine + { toLowerResultSound := + hsound.toLowerBorrowSound.projectSlotReleased + graphEmits := ?_ } + intro sourceRest rest slots + exact EmitSound.comp (hsound.graphEmits sourceRest rest slots) + (EmitSound.comp + (fetchErasedSlot_false (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output) (sourceEnv := sourceOutput) + (targetAbs := targetAbs) (index := index) (release := true) + (sourceRest := sourceRest) (rest := rest) (slots := slots)) + EmitSound.ofFalse) + +/-- Fuel-bounded constructor/erased descriptor mismatch. -/ +theorem LowerBorrowValueSoundBelow.projectCtorErased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {address : Ixon.Address} {tag : Nat} + {sourceFields : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {release : Bool} + (hsound : LowerBorrowValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput + (.ctor address tag sourceFields) emit (.constA .erased) release) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceInput sourceOutput sourceValue .shared emit + (.constA .erased) := by + refine + { toLowerResultSoundBelow := + hsound.toLowerBorrowSoundBelow.returnErased + graphEmits := ?_ } + intro sourceRest rest slots + apply EmitSoundBelow.ofFalseMid + apply EmitSoundBelow.comp (hsound.graphEmits sourceRest rest slots) + apply EmitSoundBelow.strengthen + intro store env hpre + obtain ⟨roots, value, _, hav, _, hgraph, _, _, _⟩ := hpre + cases hav with + | const hresolve => + simp only [resolveAtom] at hresolve + have hvalue : RVal.erased = value := Except.ok.inj hresolve + subst hvalue + cases hgraph + +/-- Fuel-bounded erased-target projection through a retained slot. -/ +theorem LowerBorrowValueSoundBelow.projectSlotKeptErased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} + {emit : Emit} {targetAbs index : Nat} + (hsound : LowerBorrowValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput .erased emit + (.slotA targetAbs) false) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input + output.bump.bump sourceInput sourceOutput sourceValue .shared + (emit ∘ emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth)))) + (.slotA output.bump.depth) := by + refine + { toLowerResultSoundBelow := + hsound.toLowerBorrowSoundBelow.projectSlotKept + graphEmits := ?_ } + intro sourceRest rest slots + exact EmitSoundBelow.comp (hsound.graphEmits sourceRest rest slots) + (EmitSoundBelow.comp + (fetchErasedSlot_false_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) (Γ := output) + (sourceEnv := sourceOutput) (targetAbs := targetAbs) + (index := index) (release := false) + (sourceRest := sourceRest) (rest := rest) (slots := slots)) + EmitSoundBelow.ofFalse) + +/-- Fuel-bounded erased-target projection through a final-use slot. -/ +theorem LowerBorrowValueSoundBelow.projectSlotReleasedErased + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} + {emit : Emit} {targetAbs index : Nat} + (hsound : LowerBorrowValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput .erased emit + (.slotA targetAbs) true) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input + output.bump.bump.bump sourceInput sourceOutput sourceValue .shared + (emit ∘ emitOp (.fetch (.var (output.rel targetAbs)) index) ∘ + emitOp (.dup (.var (output.bump.rel output.depth))) ∘ + emitOp (.drop (.var (output.bump.bump.rel targetAbs)))) + (.slotA output.bump.depth) := by + refine + { toLowerResultSoundBelow := + hsound.toLowerBorrowSoundBelow.projectSlotReleased + graphEmits := ?_ } + intro sourceRest rest slots + exact EmitSoundBelow.comp (hsound.graphEmits sourceRest rest slots) + (EmitSoundBelow.comp + (fetchErasedSlot_false_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) (Γ := output) + (sourceEnv := sourceOutput) (targetAbs := targetAbs) + (index := index) (release := true) + (sourceRest := sourceRest) (rest := rest) (slots := slots)) + EmitSoundBelow.ofFalse) + +/-- A stable constant can never be the heap node expected by `fetch`. +Exposing the operation-level contradiction lets later exact-run refinements +share the same impossible midpoint as the CPS ownership proof. -/ +theorem fetchStableConst_false_op + {ctx : Ctx} {cur : FnDef} {atom : Atom} {index : Nat} + {pre : StatePred} + (hstable : AValStable (.constA atom)) : + OpSound ctx cur (.fetch atom index) pre (fun _ _ => False) := by + intro fuel store env store' result _ hrun + cases hstable <;> cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + rw [runOp.eq_def] at hrun + simp [resolveAtom, bindOk] at hrun + +/-- A stable constant cannot successfully act as a constructor target. +Consequently the faithfully emitted scalar `fetch` branch is sound by +vacuity for every successful target execution. -/ +theorem LowerBorrowSoundBelow.projectConst + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} {emit : Emit} {atom : Atom} {index : Nat} + {release : Bool} + (hsound : LowerBorrowSoundBelow ctx cur limit input output emit + (.constA atom) release) : + LowerResultSoundBelow ctx cur limit input output.bump .shared + (emit ∘ emitOp (.fetch atom index)) (.slotA output.depth) := by + refine ⟨.slot, ?_⟩ + intro rest slots + have hfetch : EmitSoundBelow ctx cur limit + (emitOp (.fetch atom index)) + (OwnsBorrowResultProtected output (.constA atom) release rest slots) + (OwnsResultProtected output.bump .shared (.slotA output.depth) + rest slots) := by + apply OpSoundBelow.emit + intro fuel store env store' result _ _ hrun + cases hsound.stable <;> cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + rw [runOp.eq_def] at hrun + simp [resolveAtom, bindOk] at hrun + have hcomposed := EmitSoundBelow.comp (hsound.emits rest slots) hfetch + simpa [Function.comp_def] using hcomposed + +/-- Unbounded scalar-target projection. -/ +theorem LowerBorrowSound.projectConst + {ctx : Ctx} {cur : FnDef} + {input output : VEnv} {emit : Emit} {atom : Atom} {index : Nat} + {release : Bool} + (hsound : LowerBorrowSound ctx cur input output emit + (.constA atom) release) : + LowerResultSound ctx cur input output.bump .shared + (emit ∘ emitOp (.fetch atom index)) (.slotA output.depth) := by + refine ⟨.slot, ?_⟩ + intro rest slots + have hfetch : EmitSound ctx cur (emitOp (.fetch atom index)) + (OwnsBorrowResultProtected output (.constA atom) release rest slots) + (OwnsResultProtected output.bump .shared (.slotA output.depth) + rest slots) := by + apply OpSound.emit + intro fuel store env store' result _ hrun + cases hsound.stable <;> cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + rw [runOp.eq_def] at hrun + simp [resolveAtom, bindOk] at hrun + have hcomposed := EmitSound.comp (hsound.emits rest slots) hfetch + simpa [Function.comp_def] using hcomposed + +/-- Semantic scalar-target projection. Vacuity is independent of the source +side, so the branch transports whatever the source evaluator produced. -/ +theorem LowerBorrowValueSound.projectConst + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceTarget sourceValue : IxIR0.Value} + {emit : Emit} {atom : Atom} {index : Nat} {release : Bool} + (hsound : LowerBorrowValueSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceTarget emit + (.constA atom) release) : + LowerResultValueSound funRel recSelfRel ctx cur + input output.bump sourceInput sourceOutput sourceValue .shared + (emit ∘ emitOp (.fetch atom index)) (.slotA output.depth) := by + refine + { toLowerResultSound := hsound.toLowerBorrowSound.projectConst + graphEmits := ?_ } + intro sourceRest rest slots + have hfetch : EmitSound ctx cur (emitOp (.fetch atom index)) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput sourceTarget (.constA atom) release + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump + sourceOutput sourceValue .shared (.slotA output.depth) + sourceRest rest slots) := by + apply OpSound.emit + intro fuel store env store' result _ hrun + cases hsound.stable <;> cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + rw [runOp.eq_def] at hrun + simp [resolveAtom, bindOk] at hrun + have hcomposed := EmitSound.comp + (hsound.graphEmits sourceRest rest slots) hfetch + simpa [Function.comp_def] using hcomposed + +/-- Fuel-bounded semantic scalar-target projection. -/ +theorem LowerBorrowValueSoundBelow.projectConst + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceTarget sourceValue : IxIR0.Value} + {emit : Emit} {atom : Atom} {index : Nat} {release : Bool} + (hsound : LowerBorrowValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceTarget emit + (.constA atom) release) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input + output.bump sourceInput sourceOutput sourceValue .shared + (emit ∘ emitOp (.fetch atom index)) (.slotA output.depth) := by + refine + { toLowerResultSoundBelow := + hsound.toLowerBorrowSoundBelow.projectConst + graphEmits := ?_ } + intro sourceRest rest slots + have hfetch : EmitSoundBelow ctx cur limit (emitOp (.fetch atom index)) + (GraphOwnsBorrowResultProtected funRel recSelfRel output + sourceOutput sourceTarget (.constA atom) release + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump + sourceOutput sourceValue .shared (.slotA output.depth) + sourceRest rest slots) := by + apply OpSoundBelow.emit + intro fuel store env store' result _ _ hrun + cases hsound.stable <;> cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + rw [runOp.eq_def] at hrun + simp [resolveAtom, bindOk] at hrun + have hcomposed := EmitSoundBelow.comp + (hsound.graphEmits sourceRest rest slots) hfetch + simpa [Function.comp_def] using hcomposed + +/-! ## Left-to-right argument sequencing -/ + +/-- Pointwise realization of lowered arguments. The world list is carried in +lockstep so `rootsForWorlds` is exact rather than truncating. -/ +inductive AValsRealize (Γ : VEnv) (env : List RVal) : + List Owned → List AVal → List RVal → Prop where + | nil : AValsRealize Γ env [] [] [] + | cons {world : Owned} {worlds : List Owned} {av : AVal} + {avs : List AVal} {value : RVal} {values : List RVal} : + AValRealizes Γ env av value → + AValsRealize Γ env worlds avs values → + AValsRealize Γ env (world :: worlds) (av :: avs) (value :: values) + +/-- Dependent lockstep traversal of realized argument worlds, descriptors, +and runtime values. The one-descriptor realization and original tail witness +are preserved for clients alongside the recursively produced result. -/ +theorem AValsRealize.traverse {Γ : VEnv} {env : List RVal} + {Result : List Owned → List AVal → List RVal → Prop} + (hnil : Result [] [] []) + (hcons : ∀ {world : Owned} {worlds : List Owned} {av : AVal} + {avs : List AVal} {value : RVal} {values : List RVal}, + AValRealizes Γ env av value → + AValsRealize Γ env worlds avs values → + Result worlds avs values → + Result (world :: worlds) (av :: avs) (value :: values)) + {worlds : List Owned} {avs : List AVal} {values : List RVal} + (hreal : AValsRealize Γ env worlds avs values) : + Result worlds avs values := by + induction hreal with + | nil => exact hnil + | cons hav htail ih => exact hcons hav htail ih + +theorem AValsRealize.lengths {Γ : VEnv} {env : List RVal} : + ∀ {worlds : List Owned} {avs : List AVal} {values : List RVal}, + AValsRealize Γ env worlds avs values → + worlds.length = avs.length ∧ avs.length = values.length := by + intro worlds avs values h + exact AValsRealize.traverse + (Result := fun currentWorlds currentAvs currentValues => + currentWorlds.length = currentAvs.length ∧ + currentAvs.length = currentValues.length) + (hnil := ⟨rfl, rfl⟩) + (hcons := by + intro world currentWorlds av currentAvs value currentValues + hav htail ih + exact ⟨by simp [ih.1], by simp [ih.2]⟩) + h + +private theorem AValsRealize.resolveAtomsFrom {Γ : VEnv} {env : List RVal} : + ∀ {worlds : List Owned} {avs : List AVal} {values : List RVal}, + AValsRealize Γ env worlds avs values → + ∀ accum, + (avs.map (·.toAtom Γ)).toArray.foldlM + (fun acc atom => do pure (acc ++ [← resolveAtom env atom])) accum = + .ok (accum ++ values) := by + intro worlds avs values h + exact AValsRealize.traverse + (Result := fun _ currentAvs currentValues => + ∀ accum, + (currentAvs.map (·.toAtom Γ)).toArray.foldlM + (fun acc atom => do pure (acc ++ [← resolveAtom env atom])) + accum = .ok (accum ++ currentValues)) + (hnil := by + intro accum + simp only [List.map_nil, List.foldlM_toArray, List.foldlM_nil, + List.append_nil] + rfl) + (hcons := by + intro world currentWorlds av currentAvs value currentValues + hav htail ih accum + simp only [List.map_cons, List.foldlM_toArray, List.foldlM_cons] + rw [hav.resolveAtom] + simp only [bindOk] + simpa [List.append_assoc] using ih (accum ++ [value])) + h + +/-- The atom array emitted by `knownCall` resolves to exactly the values +tracked by `AValsRealize`, in source argument order. -/ +theorem AValsRealize.resolveAtoms {Γ : VEnv} {env : List RVal} + {worlds : List Owned} {avs : List AVal} {values : List RVal} + (h : AValsRealize Γ env worlds avs values) : + resolveAtoms env (avs.map (·.toAtom Γ)).toArray = .ok values := by + unfold Ix.Compiler.IxIR1.resolveAtoms + simpa using h.resolveAtomsFrom [] + +theorem rootsForWorlds_replicate_eq_rootsFor (world : Owned) : + ∀ {values : List RVal} {count : Nat}, values.length = count → + rootsForWorlds (List.replicate count world) values = + rootsFor world values := by + intro values count hlength + induction values generalizing count with + | nil => + cases count <;> simp_all [rootsFor, rootsForWorlds] + | cons value values ih => + cases count with + | zero => simp at hlength + | succ count => + simp only [List.length_cons, Nat.succ.injEq] at hlength + simp [List.replicate_succ, rootsFor, ih hlength] + +/-- Exact state after lowering an argument list: argument roots precede the +still-held source-environment roots, ready for allocation or a known call. -/ +def OwnsArgsResult (Γ : VEnv) (worlds : List Owned) (avs : List AVal) + (rest : List Root) : StatePred := + fun store env => ∃ roots values, + VEnvRealizes Γ env roots ∧ + AValsRealize Γ env worlds avs values ∧ + RootOwnership store (rootsForWorlds worlds values ++ roots ++ rest) + +def OwnsArgsResultProtected (Γ : VEnv) (worlds : List Owned) + (avs : List AVal) (rest : List Root) + (slots : List (Nat × RVal)) : StatePred := + fun store env => OwnsArgsResult Γ worlds avs rest store env ∧ + SlotsRealize Γ env slots + +/-- Semantic argument-list postcondition. It relates each lowered argument +to its pure source value and keeps the caller's semantic root frame intact. -/ +def GraphOwnsArgsResult (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (Γ : VEnv) + (sourceEnv sourceValues : List IxIR0.Value) + (worlds : List Owned) (avs : List AVal) + (sourceRest : List (Owned × IxIR0.Value)) + (rest : List Root) : StatePred := + fun store env => ∃ roots values, + VEnvValueGraph funRel recSelfRel store Γ sourceEnv env roots ∧ + AValsRealize Γ env worlds avs values ∧ + Sim.ValuesGraph funRel store sourceValues values ∧ + Sim.RootsGraph funRel store sourceRest rest ∧ + RootOwnership store (rootsForWorlds worlds values ++ roots ++ rest) + +def GraphOwnsArgsResultProtected (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (Γ : VEnv) + (sourceEnv sourceValues : List IxIR0.Value) + (worlds : List Owned) (avs : List AVal) + (sourceRest : List (Owned × IxIR0.Value)) + (rest : List Root) (slots : List (Nat × RVal)) : StatePred := + fun store env => + GraphOwnsArgsResult funRel recSelfRel Γ sourceEnv sourceValues + worlds avs sourceRest rest store env ∧ + SlotsRealize Γ env slots + +inductive AValsStable : List AVal → Prop where + | nil : AValsStable [] + | cons {av : AVal} {avs : List AVal} : + AValStable av → AValsStable avs → AValsStable (av :: avs) + +/-- Source-neutral dependent traversal of stable argument descriptors. +Absolute-slot descriptors advance the threaded runtime environment; literal +and erased constants leave it unchanged. Clients receive the original tail +stability witness together with the recursively produced result. -/ +theorem AValsStable.traverse + {Result : VEnv → List AVal → Prop} + (hnil : ∀ Γ, Result Γ []) + (hslot : ∀ {Γ : VEnv} {abs : Nat} {avs : List AVal}, + AValsStable avs → Result Γ.bump avs → + Result Γ (.slotA abs :: avs)) + (hlit : ∀ {Γ : VEnv} {literal : IxIR0.Literal} {avs : List AVal}, + AValsStable avs → Result Γ avs → + Result Γ (.constA (.lit literal) :: avs)) + (herased : ∀ {Γ : VEnv} {avs : List AVal}, + AValsStable avs → Result Γ avs → + Result Γ (.constA .erased :: avs)) + {Γ : VEnv} {avs : List AVal} (hstable : AValsStable avs) : + Result Γ avs := by + induction hstable generalizing Γ with + | nil => exact hnil Γ + | cons hhead htail ih => + cases hhead with + | @slot abs => exact hslot htail (ih (Γ := Γ.bump)) + | @lit literal => exact hlit htail (ih (Γ := Γ)) + | erased => exact herased htail (ih (Γ := Γ)) + +/-- Traverse the raw argument descriptors consumed by `releaseAll` while +recovering its exact output environment and emitter. Empty-list, +constant, and slot normalization happen once; clients provide only their +result judgment for those three operational cases. -/ +theorem releaseAll_traverse + {Result : VEnv → List AVal → VEnv → Emit → Prop} + (hnil : ∀ Γ, Result Γ [] Γ (_root_.id : Emit)) + (hconst : ∀ {Γ : VEnv} {atom : Atom} {avs : List AVal} + {output : VEnv} {emit : Emit}, + Result Γ avs output emit → + Result Γ (.constA atom :: avs) output emit) + (hslot : ∀ {Γ : VEnv} {abs : Nat} {avs : List AVal} + {output : VEnv} {tailEmit : Emit}, + Result Γ.bump avs output tailEmit → + Result Γ (.slotA abs :: avs) output + (emitOp (.drop (.var (Γ.rel abs))) ∘ tailEmit)) + (input : VEnv) (values : List AVal) : + Result input values (releaseAll input values).1 + (releaseAll input values).2 := by + exact releaseAll_traverse_core hnil hconst hslot input values + +/-- Traverse stable argument descriptors together with an equally sized +logical source list. Source-list normalization and the slot/literal/erased +descriptor split happen once; clients provide only their result judgment at +the empty and three cons cases. -/ +theorem AValsStable.traverseAligned + {α : Type} {Result : VEnv → List α → List AVal → Prop} + (hnil : ∀ Γ, Result Γ [] []) + (hslot : ∀ {Γ : VEnv} {source : α} {sources : List α} + {abs : Nat} {avs : List AVal}, + AValsStable avs → Result Γ.bump sources avs → + Result Γ (source :: sources) (.slotA abs :: avs)) + (hlit : ∀ {Γ : VEnv} {source : α} {sources : List α} + {literal : IxIR0.Literal} {avs : List AVal}, + AValsStable avs → Result Γ sources avs → + Result Γ (source :: sources) (.constA (.lit literal) :: avs)) + (herased : ∀ {Γ : VEnv} {source : α} {sources : List α} + {avs : List AVal}, + AValsStable avs → Result Γ sources avs → + Result Γ (source :: sources) (.constA .erased :: avs)) + {Γ : VEnv} {sources : List α} {avs : List AVal} + (hstable : AValsStable avs) (hlength : sources.length = avs.length) : + Result Γ sources avs := by + exact (AValsStable.traverse + (Result := fun current currentAvs => + ∀ currentSources, currentSources.length = currentAvs.length → + Result current currentSources currentAvs) + (hnil := by + intro current currentSources hcurrentLength + cases currentSources with + | nil => exact hnil current + | cons source sources => simp at hcurrentLength) + (hslot := by + intro current abs currentAvs htail ih currentSources hcurrentLength + cases currentSources with + | nil => simp at hcurrentLength + | cons source sources => + have htailLength : sources.length = currentAvs.length := by + simpa using hcurrentLength + exact hslot htail (ih sources htailLength)) + (hlit := by + intro current literal currentAvs htail ih currentSources + hcurrentLength + cases currentSources with + | nil => simp at hcurrentLength + | cons source sources => + have htailLength : sources.length = currentAvs.length := by + simpa using hcurrentLength + exact hlit htail (ih sources htailLength)) + (herased := by + intro current currentAvs htail ih currentSources hcurrentLength + cases currentSources with + | nil => simp at hcurrentLength + | cons source sources => + have htailLength : sources.length = currentAvs.length := by + simpa using hcurrentLength + exact herased htail (ih sources htailLength)) + (hstable := hstable)) sources hlength + +/-- Stable argument descriptors remain valid after an unrelated operation +pushes one runtime value. Absolute slots are re-indexed through the bumped +`VEnv`; constants are environment-independent. -/ +theorem AValsStable.realize_bump {Γ : VEnv} {env : List RVal} : + ∀ {worlds : List Owned} {avs : List AVal} {values : List RVal}, + AValsStable avs → + AValsRealize Γ env worlds avs values → + ∀ pushed, AValsRealize Γ.bump (pushed :: env) worlds avs values := by + intro worlds avs values hstable hreal pushed + exact (AValsStable.traverse + (Result := fun _ currentAvs => + ∀ {current : VEnv} {currentWorlds : List Owned} + {currentValues : List RVal}, + AValsRealize current env currentWorlds currentAvs currentValues → + ∀ pushed, + AValsRealize current.bump (pushed :: env) + currentWorlds currentAvs currentValues) + (hnil := by + intro current currentΓ currentWorlds currentValues hcurrent pushed + cases hcurrent + exact .nil) + (hslot := by + intro current abs currentAvs htail ih currentΓ currentWorlds + currentValues hcurrent pushed + cases hcurrent with + | cons hav havs => + exact .cons (AValStable.realize_bump .slot hav pushed) + (ih havs pushed)) + (hlit := by + intro current literal currentAvs htail ih currentΓ currentWorlds + currentValues hcurrent pushed + cases hcurrent with + | cons hav havs => + exact .cons (AValStable.realize_bump .lit hav pushed) + (ih havs pushed)) + (herased := by + intro current currentAvs htail ih currentΓ currentWorlds + currentValues hcurrent pushed + cases hcurrent with + | cons hav havs => + exact .cons (AValStable.realize_bump .erased hav pushed) + (ih havs pushed)) + (Γ := Γ) (hstable := hstable)) hreal pushed + +/-- Soundness package for one successful `lowerArgs` result. -/ +structure LowerArgsSound (ctx : Ctx) (cur : FnDef) + (input output : VEnv) (worlds : List Owned) + (emit : Emit) (avs : List AVal) : Prop where + stable : AValsStable avs + emits : ∀ rest slots, + EmitSound ctx cur emit (OwnsVEnvProtected input rest slots) + (OwnsArgsResultProtected output worlds avs rest slots) + +/-- Companion semantic refinement for left-to-right argument lowering. -/ +structure LowerArgsValueSound (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (ctx : Ctx) (cur : FnDef) + (input output : VEnv) + (sourceInput sourceOutput sourceValues : List IxIR0.Value) + (worlds : List Owned) (emit : Emit) (avs : List AVal) : Prop + extends LowerArgsSound ctx cur input output worlds emit avs where + graphEmits : ∀ sourceRest rest slots, + EmitSound ctx cur emit + (GraphOwnsVEnvProtected funRel recSelfRel input + sourceInput sourceRest rest slots) + (GraphOwnsArgsResultProtected funRel recSelfRel output + sourceOutput sourceValues worlds avs sourceRest rest slots) + +/-- Fuel-bounded left-to-right argument-lowering soundness. -/ +structure LowerArgsSoundBelow (ctx : Ctx) (cur : FnDef) + (limit : Nat) (input output : VEnv) (worlds : List Owned) + (emit : Emit) (avs : List AVal) : Prop where + stable : AValsStable avs + emits : ∀ rest slots, + EmitSoundBelow ctx cur limit emit + (OwnsVEnvProtected input rest slots) + (OwnsArgsResultProtected output worlds avs rest slots) + +/-- Fuel-bounded semantic argument-list result. -/ +structure LowerArgsValueSoundBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (ctx : Ctx) (cur : FnDef) + (limit : Nat) (input output : VEnv) + (sourceInput sourceOutput sourceValues : List IxIR0.Value) + (worlds : List Owned) (emit : Emit) (avs : List AVal) : Prop + extends LowerArgsSoundBelow ctx cur limit input output worlds emit avs where + graphEmits : ∀ sourceRest rest slots, + EmitSoundBelow ctx cur limit emit + (GraphOwnsVEnvProtected funRel recSelfRel input + sourceInput sourceRest rest slots) + (GraphOwnsArgsResultProtected funRel recSelfRel output + sourceOutput sourceValues worlds avs sourceRest rest slots) + +/-- Uniform bounded argument soundness closes to the unbounded interface. -/ +theorem LowerArgsSound.of_below {ctx : Ctx} {cur : FnDef} + {input output : VEnv} {worlds : List Owned} + {emit : Emit} {avs : List AVal} + (hsound : ∀ limit, + LowerArgsSoundBelow ctx cur limit input output worlds emit avs) : + LowerArgsSound ctx cur input output worlds emit avs := by + refine ⟨(hsound 0).stable, ?_⟩ + intro rest slots + exact EmitSound.of_below fun limit => + (hsound limit).emits rest slots + +theorem LowerArgsValueSound.of_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput sourceValues : List IxIR0.Value} + {worlds : List Owned} {emit : Emit} {avs : List AVal} + (hsound : ∀ limit, + LowerArgsValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceValues worlds emit avs) : + LowerArgsValueSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValues worlds emit avs := by + refine + { toLowerArgsSound := LowerArgsSound.of_below + (fun limit => (hsound limit).toLowerArgsSoundBelow) + graphEmits := ?_ } + intro sourceRest rest slots + exact EmitSound.of_below fun limit => + (hsound limit).graphEmits sourceRest rest slots + +/-- Bounded argument proofs are contravariant in their fuel bound. -/ +theorem LowerArgsSoundBelow.mono {ctx : Ctx} {cur : FnDef} + {smaller larger : Nat} {input output : VEnv} + {worlds : List Owned} {emit : Emit} {avs : List AVal} + (hsound : LowerArgsSoundBelow ctx cur larger input output worlds emit avs) + (hbound : smaller ≤ larger) : + LowerArgsSoundBelow ctx cur smaller input output worlds emit avs := by + refine ⟨hsound.stable, ?_⟩ + intro rest slots bound hsmall + exact hsound.emits rest slots bound (Nat.le_trans hsmall hbound) + +theorem LowerArgsValueSoundBelow.mono + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {smaller larger : Nat} + {input output : VEnv} + {sourceInput sourceOutput sourceValues : List IxIR0.Value} + {worlds : List Owned} {emit : Emit} {avs : List AVal} + (hsound : LowerArgsValueSoundBelow funRel recSelfRel ctx cur larger + input output sourceInput sourceOutput sourceValues worlds emit avs) + (hbound : smaller ≤ larger) : + LowerArgsValueSoundBelow funRel recSelfRel ctx cur smaller + input output sourceInput sourceOutput sourceValues worlds emit avs := by + refine + { toLowerArgsSoundBelow := + hsound.toLowerArgsSoundBelow.mono hbound + graphEmits := ?_ } + intro sourceRest rest slots bound hsmall + exact hsound.graphEmits sourceRest rest slots bound + (Nat.le_trans hsmall hbound) + +/-- Every compiler-generated declaration and every memoized constructor +wrapper accumulated in a lowering state is present verbatim in the target +evaluator context. The wrapper clause is deliberately indexed by the shape +stored in `WrapperMemo`: it is the layout fact needed by partial constructor +applications, while callable body contracts remain a separate obligation. -/ +structure ExtraRepresented (ctx : Ctx) (state : LowSt) : Prop where + decl : ∀ {address decl}, (address, decl) ∈ state.extra → + ctx.decls address = some decl + wrapper : ∀ {memo : WrapperMemo}, memo ∈ state.wrappers → + ctx.decls memo.wrapper = + some (ctorWrapperDecl memo.source memo.tag memo.arity) + +/-- Exact evaluator contract required only when a logical environment can +actually expose the synthetic recursor-self entry. -/ +def CurrentSelfContractBelow (ctx : Ctx) (cur : FnDef) + (limit : Nat) : Prop := + cur.result = .shared ∧ + FnOwnershipContractBelow ctx cur + (List.replicate cur.arity .shared) limit + +/-- The current-function contract is available either substantively, for a +recursor-rule environment, or vacuously because the logical environment has +no `recSelf` entry. This is the boundary used by ordinary generated bodies. -/ +def SelfAvailableBelow (ctx : Ctx) (cur : FnDef) (limit : Nat) + (input : VEnv) : Prop := + CurrentSelfContractBelow ctx cur limit ∨ NoRecSelf input + +theorem SelfAvailableBelow.of_contract {ctx : Ctx} {cur : FnDef} + {limit : Nat} {input : VEnv} + (hcontract : CurrentSelfContractBelow ctx cur limit) : + SelfAvailableBelow ctx cur limit input := + Or.inl hcontract + +theorem SelfAvailableBelow.of_noRecSelf {ctx : Ctx} {cur : FnDef} + {limit : Nat} {input : VEnv} (hno : NoRecSelf input) : + SelfAvailableBelow ctx cur limit input := + Or.inr hno + +/-- Transport self availability through any state-only transformation known +not to synthesize a recursor-self entry. -/ +theorem SelfAvailableBelow.mapNoRecSelf + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input output : VEnv} + (havailable : SelfAvailableBelow ctx cur limit input) + (hpreserve : NoRecSelf input → NoRecSelf output) : + SelfAvailableBelow ctx cur limit output := by + cases havailable with + | inl hcontract => exact Or.inl hcontract + | inr hno => exact Or.inr (hpreserve hno) + +theorem SelfAvailableBelow.bump + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input : VEnv} + (havailable : SelfAvailableBelow ctx cur limit input) : + SelfAvailableBelow ctx cur limit input.bump := + havailable.mapNoRecSelf NoRecSelf.bump + +theorem SelfAvailableBelow.pop + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input : VEnv} + (havailable : SelfAvailableBelow ctx cur limit input) : + SelfAvailableBelow ctx cur limit input.pop := + havailable.mapNoRecSelf NoRecSelf.pop + +theorem SelfAvailableBelow.setSlot + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input : VEnv} + (havailable : SelfAvailableBelow ctx cur limit input) + (changed abs remaining : Nat) (uses : Uses) (held : Bool) : + SelfAvailableBelow ctx cur limit + (input.setEntry changed (.slot abs remaining uses held)) := + havailable.mapNoRecSelf + (fun hno => hno.setSlot changed abs remaining uses held) + +theorem SelfAvailableBelow.consSlot + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input : VEnv} + (havailable : SelfAvailableBelow ctx cur limit input) + (abs remaining : Nat) (uses : Uses) (held : Bool) : + SelfAvailableBelow ctx cur limit + { input with + entries := .slot abs remaining uses held :: input.entries } := + havailable.mapNoRecSelf + (fun hno => hno.consSlot abs remaining uses held) + +theorem SelfAvailableBelow.lowerE + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Owned} + {expr : IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {value : AVal} + (havailable : SelfAvailableBelow ctx cur limit input) + (hrun : (lowerE src fuel input world expr).run state = + .ok (output, emit, value) finalState) : + SelfAvailableBelow ctx cur limit output := + havailable.mapNoRecSelf + (fun hno => (lowerPreservesNoRecSelf src fuel).expr hrun hno) + +theorem SelfAvailableBelow.lowerBorrow + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {expr : IxIR0.Expr} + {state finalState : LowSt} {emit : Emit} {value : AVal} + {release : Bool} + (havailable : SelfAvailableBelow ctx cur limit input) + (hrun : (lowerBorrow src fuel input expr).run state = + .ok (output, emit, value, release) finalState) : + SelfAvailableBelow ctx cur limit output := + havailable.mapNoRecSelf + (fun hno => (lowerPreservesNoRecSelf src fuel).borrow hrun hno) + +theorem SelfAvailableBelow.lowerArgs + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} + {args : List (IxIR0.Expr × Owned)} {state finalState : LowSt} + {emit : Emit} {values : List AVal} + (havailable : SelfAvailableBelow ctx cur limit input) + (hrun : (lowerArgs src fuel input args).run state = + .ok (output, emit, values) finalState) : + SelfAvailableBelow ctx cur limit output := + havailable.mapNoRecSelf + (fun hno => (lowerPreservesNoRecSelf src fuel).args hrun hno) + +theorem SelfAvailableBelow.applyRest + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {resultWorld : Owned} + {pre : Emit} {function : AVal} {args : List IxIR0.Expr} + {state finalState : LowSt} {emit : Emit} {value : AVal} + (havailable : SelfAvailableBelow ctx cur limit input) + (hrun : (applyRest src fuel input resultWorld pre function args).run state = + .ok (output, emit, value) finalState) : + SelfAvailableBelow ctx cur limit output := + havailable.mapNoRecSelf + (fun hno => (lowerPreservesNoRecSelf src fuel).applyRest hrun hno) + +/-- Lowering only prepends generated declarations and wrapper memos. Besides +the two exact suffix equations, the relation records that every newly cached +memo was installed together with its exact eta-wrapper declaration. This +turns wrapper-cache reachability into a compositional compiler-state fact. -/ +def ExtraExtends (initial final : LowSt) : Prop := + ∃ (addedExtra : List (Ixon.Address × Decl)) + (addedWrappers : List WrapperMemo), + final.extra = addedExtra ++ initial.extra ∧ + final.wrappers = addedWrappers ++ initial.wrappers ∧ + ∀ memo, memo ∈ addedWrappers → + (memo.wrapper, + ctorWrapperDecl memo.source memo.tag memo.arity) ∈ final.extra + +theorem ExtraExtends.refl (state : LowSt) : ExtraExtends state state := by + refine ⟨[], [], by simp, by simp, ?_⟩ + simp + +theorem ExtraExtends.trans {first middle final : LowSt} + (hfirst : ExtraExtends first middle) + (hsecond : ExtraExtends middle final) : + ExtraExtends first final := by + obtain ⟨leftExtra, leftWrappers, hleftExtra, hleftWrappers, + hleftSound⟩ := hfirst + obtain ⟨rightExtra, rightWrappers, hrightExtra, hrightWrappers, + hrightSound⟩ := hsecond + refine ⟨rightExtra ++ leftExtra, rightWrappers ++ leftWrappers, + ?_, ?_, ?_⟩ + · simp [hrightExtra, hleftExtra, List.append_assoc] + · simp [hrightWrappers, hleftWrappers, List.append_assoc] + · intro memo hmember + rw [List.mem_append] at hmember + cases hmember with + | inl hright => exact hrightSound memo hright + | inr hleft => + rw [hrightExtra] + exact List.mem_append_right _ (hleftSound memo hleft) + +/-- Wrapper memos, like generated declarations, are never removed. -/ +theorem ExtraExtends.wrapper_mem {initial final : LowSt} + (hextends : ExtraExtends initial final) {memo : WrapperMemo} + (hmember : memo ∈ initial.wrappers) : memo ∈ final.wrappers := by + obtain ⟨_, addedWrappers, _, hwrappers, _⟩ := hextends + rw [hwrappers] + exact List.mem_append_right addedWrappers hmember + +/-- Generated declarations, like wrapper memos, are never removed. -/ +theorem ExtraExtends.extra_mem {initial final : LowSt} + (hextends : ExtraExtends initial final) + {item : Ixon.Address × Decl} + (hmember : item ∈ initial.extra) : item ∈ final.extra := by + obtain ⟨addedExtra, _, hextra, _, _⟩ := hextends + rw [hextra] + exact List.mem_append_right addedExtra hmember + +/-- A final generated-declaration layout also represents every earlier +state whose extras are a suffix of that final accumulation. -/ +theorem ExtraRepresented.of_extends {ctx : Ctx} {initial final : LowSt} + (hfinal : ExtraRepresented ctx final) + (hextends : ExtraExtends initial final) : + ExtraRepresented ctx initial := by + obtain ⟨addedExtra, addedWrappers, hextra, hwrappers, _⟩ := hextends + constructor + · intro address decl hmember + apply hfinal.decl + rw [hextra] + exact List.mem_append_right addedExtra hmember + · intro memo hmember + apply hfinal.wrapper + rw [hwrappers] + exact List.mem_append_right addedWrappers hmember + +/-- A run beginning at the empty compiler state automatically satisfies the +wrapper half of `ExtraRepresented`: every final memo belongs to the added +prefix and `ExtraExtends.wrapper_extra` supplies its declaration. -/ +theorem ExtraExtends.represented_of_empty {ctx : Ctx} {final : LowSt} + (hextends : ExtraExtends ({} : LowSt) final) + (hdecls : ∀ {address decl}, (address, decl) ∈ final.extra → + ctx.decls address = some decl) : + ExtraRepresented ctx final := by + obtain ⟨addedExtra, addedWrappers, _, hwrappers, hwrapperExtra⟩ := + hextends + constructor + · exact hdecls + · intro memo hmember + have hwrappers' : final.wrappers = addedWrappers := by + simpa using hwrappers + have hadded : memo ∈ addedWrappers := by + rw [hwrappers'] at hmember + exact hmember + exact hdecls (hwrapperExtra memo hadded) + +/-- Every represented successful expression-lowering run at one compiler +fuel produces a bounded ownership transformer. Requiring representation only +for the run's final state keeps the induction valid for the reachable prefix +of one whole-program lowering trajectory without quantifying over unrelated +synthetic-address histories. -/ +def LowerEPreservesBelow (ctx : Ctx) (cur : FnDef) (limit : Nat) + (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {world : Owned} {expr : IxIR0.Expr} + {state finalState : LowSt} {output : VEnv} {emit : Emit} {av : AVal}, + (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState → + ExtraRepresented ctx finalState → + SelfAvailableBelow ctx cur limit input → + LowerResultSoundBelow ctx cur limit input output world emit av + +/-- `freshAddr` changes only the counter. -/ +theorem freshAddr_extraExtends {initial final : LowSt} + {address : Ixon.Address} + (hrun : freshAddr.run initial = .ok address final) : + ExtraExtends initial final := by + change EStateM.Result.ok (synthAddr initial.fresh) + { initial with fresh := initial.fresh + 1 } = + .ok address final at hrun + have hstate : { initial with fresh := initial.fresh + 1 } = final := + congrArg + (fun result : EStateM.Result String LowSt Ixon.Address => + match result with + | .ok _ state | .error _ state => state) + hrun + subst final + refine ⟨[], [], by simp, by simp, ?_⟩ + simp + +/-- Installing one generated declaration prepends exactly one extra. -/ +theorem pushExtra_extraExtends {initial final : LowSt} + {item : Ixon.Address × Decl} + (hrun : (pushExtra item).run initial = .ok () final) : + ExtraExtends initial final := by + simp [pushExtra] at hrun + subst final + refine ⟨[item], [], by simp, by simp, ?_⟩ + simp + +/-- Constructor-wrapper lookup either preserves the extra list (cache hit) +or prepends the freshly synthesized wrapper declaration (cache miss). -/ +theorem wrapperFor_extraExtends {initial final : LowSt} + {source wrapper : Ixon.Address} {tag arity : Nat} + (hrun : (wrapperFor source tag arity).run initial = + .ok wrapper final) : + ExtraExtends initial final := by + cases hcached : initial.wrappers.find? + (·.matches source tag arity) with + | none => + simp [wrapperFor, hcached] at hrun + have hstate : + { initial with + fresh := initial.fresh + 1 + wrappers := + ⟨source, tag, arity, synthAddr initial.fresh⟩ :: + initial.wrappers + extra := + (synthAddr initial.fresh, + ctorWrapperDecl source tag arity) :: + initial.extra } = final := by + exact congrArg + (fun result : EStateM.Result String LowSt Ixon.Address => + match result with + | .ok _ state | .error _ state => state) + hrun + subst final + refine ⟨[(synthAddr initial.fresh, + ctorWrapperDecl source tag arity)], + [⟨source, tag, arity, synthAddr initial.fresh⟩], rfl, rfl, ?_⟩ + simp + | some memo => + simp [wrapperFor, hcached] at hrun + obtain ⟨_, hstate⟩ := hrun + subst final + exact ExtraExtends.refl _ + +/-- Every successful wrapper lookup returns the exact shape-indexed memo in +its output state, on both cache hits and misses. -/ +theorem wrapperFor_memo_mem {initial final : LowSt} + {source wrapper : Ixon.Address} {tag arity : Nat} + (hrun : (wrapperFor source tag arity).run initial = + .ok wrapper final) : + (⟨source, tag, arity, wrapper⟩ : WrapperMemo) ∈ final.wrappers := by + cases hcached : initial.wrappers.find? + (·.matches source tag arity) with + | none => + dsimp [wrapperFor] at hrun + rw [hcached] at hrun + dsimp at hrun + injection hrun with _ hstate + subst wrapper + subst final + simp + | some memo => + have hmember := List.mem_of_find?_eq_some hcached + have hmatch := List.find?_some hcached + dsimp [wrapperFor] at hrun + rw [hcached] at hrun + dsimp at hrun + injection hrun with _ hstate + subst wrapper + subst final + rw [WrapperMemo.matches, Bool.and_eq_true, Bool.and_eq_true] at hmatch + have hsource := Ixon.Address.eq_of_beq hmatch.1.1 + have htag : memo.tag = tag := by simpa using hmatch.1.2 + have harity : memo.arity = arity := by simpa using hmatch.2 + cases memo + simp_all + +/-- A lowering-monad action is monotone in the generated-declaration list +when every successful run only prepends extras. -/ +def ExtraMonotone {α : Type} (action : LowerM α) : Prop := + ∀ {initial final result}, action.run initial = .ok result final → + ExtraExtends initial final + +theorem ExtraMonotone.pure {α : Type} (value : α) : + ExtraMonotone (pure value : LowerM α) := by + intro initial final result hrun + have hpure : value = result ∧ initial = final := by + simpa using hrun + obtain ⟨_, hstate⟩ := hpure + subst final + exact ExtraExtends.refl _ + +theorem ExtraMonotone.throw {α : Type} (message : String) : + ExtraMonotone (throw message : LowerM α) := by + intro initial final result hrun + exact (estateThrowRun_not_ok hrun).elim + +theorem ExtraMonotone.throwBind {α β : Type} (message : String) + (next : α → LowerM β) : + ExtraMonotone ((EStateM.throw message : LowerM α) >>= next) := by + intro initial final result hrun + change EStateM.Result.error message initial = .ok result final at hrun + contradiction + +theorem ExtraMonotone.get : + ExtraMonotone (get : LowerM LowSt) := by + intro initial final result hrun + change EStateM.Result.ok initial initial = .ok result final at hrun + injection hrun with _ hstate + subst final + exact ExtraExtends.refl _ + +theorem ExtraMonotone.bind {α β : Type} + {action : LowerM α} {next : α → LowerM β} + (haction : ExtraMonotone action) + (hnext : ∀ value, ExtraMonotone (next value)) : + ExtraMonotone (action >>= next) := by + intro initial final result hrun + obtain ⟨value, middle, hfirst, hsecond⟩ := + estateBindRun_ok_inv hrun + exact (haction hfirst).trans (hnext value hsecond) + +theorem ExtraMonotone.map {α β : Type} {action : LowerM α} + (haction : ExtraMonotone action) (f : α → β) : + ExtraMonotone (f <$> action) := by + have hbind : ExtraMonotone + (action >>= fun value => (Pure.pure (f value) : LowerM β)) := + ExtraMonotone.bind (action := action) + (next := fun value => (Pure.pure (f value) : LowerM β)) haction + (fun value => ExtraMonotone.pure (f value)) + intro initial final result hrun + apply hbind + simpa only [bind_pure_comp] using hrun + +/-- Left-to-right monadic traversal preserves generated-state extension +when every element action does. -/ +theorem ExtraMonotone.listMapM {α β : Type} (f : α → LowerM β) + (hf : ∀ value, ExtraMonotone (f value)) : + ∀ values : List α, ExtraMonotone (values.mapM f) + | [] => by + simpa using (ExtraMonotone.pure ([] : List β)) + | value :: rest => by + rw [List.mapM_cons] + apply ExtraMonotone.bind (hf value) + intro head + apply ExtraMonotone.bind (ExtraMonotone.listMapM f hf rest) + intro tail + exact ExtraMonotone.pure (head :: tail) + +/-- Filtering monadic traversal has the same extension law; discarding a +`none` result does not affect the threaded compiler state. -/ +theorem ExtraMonotone.listFilterMapM {α β : Type} + (f : α → LowerM (Option β)) + (hf : ∀ value, ExtraMonotone (f value)) : + ∀ values : List α, ExtraMonotone (values.filterMapM f) + | [] => by + simpa using (ExtraMonotone.pure ([] : List β)) + | value :: rest => by + rw [List.filterMapM_cons] + apply ExtraMonotone.bind (hf value) + intro head + cases head with + | none => exact ExtraMonotone.listFilterMapM f hf rest + | some head => + apply ExtraMonotone.bind + (ExtraMonotone.listFilterMapM f hf rest) + intro tail + exact ExtraMonotone.pure (head :: tail) + +/-- Recover the exact element action corresponding to any input member of a +successful filtering traversal. The suffix extension and optional output +membership are retained for declaration-level contract proofs. -/ +theorem listFilterMapM_trace {α β : Type} + (f : α → LowerM (Option β)) + (hmono : ∀ item, ExtraMonotone (f item)) : + ∀ (items : List α) {initial final : LowSt} {results : List β}, + (items.filterMapM f).run initial = .ok results final → + ∀ {item}, item ∈ items → + ∃ itemInitial itemFinal output, + (f item).run itemInitial = .ok output itemFinal ∧ + ExtraExtends itemFinal final ∧ + ∀ value, output = some value → value ∈ results := by + intro items + induction items with + | nil => + intro initial final results hrun item hmember + simp at hmember + | cons head tail ih => + intro initial final results hrun item hmember + rw [List.filterMapM_cons] at hrun + obtain ⟨headOutput, middle, hheadRun, hafterHead⟩ := + estateBindRun_ok_inv hrun + cases headOutput with + | none => + simp only at hafterHead + rw [List.mem_cons] at hmember + cases hmember with + | inl hitem => + subst item + refine ⟨initial, middle, none, hheadRun, + ExtraMonotone.listFilterMapM f hmono tail hafterHead, ?_⟩ + intro value hnone + contradiction + | inr htail => + exact ih hafterHead htail + | some headValue => + obtain ⟨tailResults, tailState, htailRun, hpureRun⟩ := + estateBindRun_ok_inv hafterHead + have hpure : headValue :: tailResults = results ∧ + tailState = final := by + simpa [Function.comp_def] using hpureRun + obtain ⟨hresults, hstate⟩ := hpure + subst results + subst final + rw [List.mem_cons] at hmember + cases hmember with + | inl hitem => + subst item + refine ⟨initial, middle, some headValue, hheadRun, + ExtraMonotone.listFilterMapM f hmono tail htailRun, ?_⟩ + intro value hvalue + have : value = headValue := Option.some.inj hvalue.symm + subst value + simp + | inr htail => + obtain ⟨itemInitial, itemFinal, output, hitemRun, hextends, + houtput⟩ := ih htailRun htail + refine ⟨itemInitial, itemFinal, output, hitemRun, hextends, ?_⟩ + intro value hvalue + exact List.mem_cons_of_mem _ (houtput value hvalue) + +/-- Reverse the filtering traversal for one returned member. The witness is +the exact input element action that produced that `some`; state generated by +earlier and later elements is deliberately left existential. -/ +theorem listFilterMapM_result_trace {α β : Type} + (f : α → LowerM (Option β)) : + ∀ (items : List α) {initial final : LowSt} {results : List β}, + (items.filterMapM f).run initial = .ok results final → + ∀ {value}, value ∈ results → + ∃ item itemInitial itemFinal, + item ∈ items ∧ + (f item).run itemInitial = .ok (some value) itemFinal := by + intro items + induction items with + | nil => + intro initial final results hrun value hmember + have hresults : results = [] := by + simpa using congrArg + (fun result : EStateM.Result String LowSt (List β) => + match result with + | .ok values _ => values + | .error _ _ => []) hrun.symm + subst results + simp at hmember + | cons head tail ih => + intro initial final results hrun value hmember + rw [List.filterMapM_cons] at hrun + obtain ⟨headOutput, middle, hheadRun, hafterHead⟩ := + estateBindRun_ok_inv hrun + cases headOutput with + | none => + obtain ⟨item, itemInitial, itemFinal, hitem, hitemRun⟩ := + ih hafterHead hmember + exact ⟨item, itemInitial, itemFinal, + List.mem_cons_of_mem head hitem, hitemRun⟩ + | some headValue => + obtain ⟨tailResults, tailState, htailRun, hpureRun⟩ := + estateBindRun_ok_inv hafterHead + have hpure : headValue :: tailResults = results ∧ + tailState = final := by + simpa [Function.comp_def] using hpureRun + obtain ⟨hresults, hstate⟩ := hpure + subst results + subst final + rw [List.mem_cons] at hmember + cases hmember with + | inl hvalue => + subst value + exact ⟨head, initial, middle, by simp, hheadRun⟩ + | inr htail => + obtain ⟨item, itemInitial, itemFinal, hitem, hitemRun⟩ := + ih htailRun htail + exact ⟨item, itemInitial, itemFinal, + List.mem_cons_of_mem head hitem, hitemRun⟩ + +theorem freshAddr_extraMonotone : ExtraMonotone freshAddr := + fun hrun => freshAddr_extraExtends hrun + +theorem pushExtra_extraMonotone (item : Ixon.Address × Decl) : + ExtraMonotone (pushExtra item) := + fun hrun => pushExtra_extraExtends hrun + +theorem wrapperFor_extraMonotone (source : Ixon.Address) + (tag arity : Nat) : ExtraMonotone (wrapperFor source tag arity) := + fun hrun => wrapperFor_extraExtends hrun + +/-- Entry cleanup emits code and rewrites `VEnv`, but cannot add generated +declarations. -/ +theorem releaseSlots_extraMonotone (input : VEnv) : + ∀ drops : List SlotDrop, ExtraMonotone (releaseSlots input drops) := by + exact releaseSlots_action_core + (ActionProperty := fun {α : Type} (action : LowerM α) => + ExtraMonotone action) + (hpure := fun value => ExtraMonotone.pure value) + (hbind := fun haction hnext => ExtraMonotone.bind haction hnext) + (hthrowBind := fun message next => + ExtraMonotone.throwBind message next) + input + +/-- Generated-declaration monotonicity for every expression action at one +compiler-fuel index. This is intentionally independent of evaluator +ownership soundness. -/ +def LowerEExtraMonotone (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ input world expr, ExtraMonotone (lowerE src fuel input world expr) + +/-- Generated-declaration monotonicity for every closed-body action at one +compiler-fuel index. -/ +def LowerFnBodyExtraMonotone (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ input drops world body, + ExtraMonotone (lowerFnBody src fuel input drops world body) + +def LowerLamExtraMonotone (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ input expr, ExtraMonotone (lowerLam src fuel input expr) + +def LowerBorrowExtraMonotone (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ input expr, ExtraMonotone (lowerBorrow src fuel input expr) + +def LowerSpineExtraMonotone (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ input world head args, + ExtraMonotone (lowerSpine src fuel input world head args) + +def KnownCallExtraMonotone (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ input build count argWorlds resultWorld args, + ExtraMonotone + (knownCall src fuel input build count argWorlds resultWorld args) + +def LowerArgsExtraMonotone (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ input args, ExtraMonotone (lowerArgs src fuel input args) + +def ApplyRestExtraMonotone (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ input resultWorld pre function args, + ExtraMonotone + (applyRest src fuel input resultWorld pre function args) + +/-- The complete state-only invariant for the mutually recursive lowering +cluster at one compiler-fuel index. -/ +structure LowerExtraMonotone (src : IxIR0.Env) (fuel : Nat) : Prop where + expr : LowerEExtraMonotone src fuel + borrow : LowerBorrowExtraMonotone src fuel + spine : LowerSpineExtraMonotone src fuel + knownCall : KnownCallExtraMonotone src fuel + args : LowerArgsExtraMonotone src fuel + applyRest : ApplyRestExtraMonotone src fuel + lam : LowerLamExtraMonotone src fuel + fnBody : LowerFnBodyExtraMonotone src fuel + +/-- Result-world checks inspect no compiler state. -/ +theorem requireResultWorld_extraMonotone (actual demand : Owned) : + ExtraMonotone (requireResultWorld actual demand) := by + cases actual <;> cases demand <;> + simp [requireResultWorld] <;> + first | exact ExtraMonotone.pure _ | exact ExtraMonotone.throw _ + +theorem lowerFnBodyExtraMonotone_zero (src : IxIR0.Env) : + LowerFnBodyExtraMonotone src 0 := by + intro input drops world body + simp only [lowerFnBody] + exact ExtraMonotone.throw _ + +/-- A body action only sequences entry cleanup, predecessor-fuel expression +lowering, and a pure `ret` closure. -/ +theorem lowerFnBodyExtraMonotone_succ {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEExtraMonotone src fuel) : + LowerFnBodyExtraMonotone src (fuel + 1) := by + intro input drops world body + simp only [lowerFnBody] + apply ExtraMonotone.bind (releaseSlots_extraMonotone input drops) + intro releaseResult + rcases releaseResult with ⟨middle, releaseEmit⟩ + apply ExtraMonotone.bind (hexpr middle world body) + intro bodyResult + rcases bodyResult with ⟨output, bodyEmit, value⟩ + exact ExtraMonotone.pure + (releaseEmit (bodyEmit (.ret (value.toAtom output)))) + +theorem lowerExtraMonotone_zero (src : IxIR0.Env) : + LowerExtraMonotone src 0 := by + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro input world expr + simp only [lowerE] + exact ExtraMonotone.throw _ + · intro input expr + simp only [lowerBorrow] + exact ExtraMonotone.throw _ + · intro input world head args + simp only [lowerSpine] + exact ExtraMonotone.throw _ + · intro input build count argWorlds resultWorld args + simp only [knownCall] + exact ExtraMonotone.throw _ + · intro input args + simp only [lowerArgs] + exact ExtraMonotone.throw _ + · intro input resultWorld pre function args + simp only [applyRest] + exact ExtraMonotone.throw _ + · intro input expr + simp only [lowerLam] + exact ExtraMonotone.throw _ + · exact lowerFnBodyExtraMonotone_zero src + +/-- Compile-state companion to semantic expression preservation. A body +started with a correctly counted first binder releases that binder on every +successful lowering run. Keeping this obligation separate avoids weakening +`LowerResultSoundBelow` with compiler-internal entry arithmetic. -/ +def LowerEReleasesTrackedFirst (src : IxIR0.Env) (fuel : Nat) + (expr : IxIR0.Expr) : Prop := + ∀ {input output : VEnv} {world : Owned} + {uses : Uses} {state finalState : LowSt} {emit : Emit} {av : AVal}, + FirstEntryTracks input uses (countUses 0 expr) → + (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState → + FirstEntryReleased output + +/-- Every successful borrowing-position run at one compiler fuel produces a +shared borrowed descriptor and records whether its owner must be released. -/ +def LowerBorrowPreservesBelow (ctx : Ctx) (cur : FnDef) (limit : Nat) + (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {expr : IxIR0.Expr} + {state finalState : LowSt} {output : VEnv} {emit : Emit} + {av : AVal} {release : Bool}, + (lowerBorrow src fuel input expr).run state = + .ok (output, emit, av, release) finalState → + ExtraRepresented ctx finalState → + SelfAvailableBelow ctx cur limit input → + LowerBorrowSoundBelow ctx cur limit input output emit av release + +/-- Every successful argument-lowering run at one compiler fuel produces the +bounded left-to-right argument transformer. -/ +def LowerArgsPreservesBelow (ctx : Ctx) (cur : FnDef) (limit : Nat) + (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {args : List (IxIR0.Expr × Owned)} + {state finalState : LowSt} {output : VEnv} + {emit : Emit} {avs : List AVal}, + (lowerArgs src fuel input args).run state = + .ok (output, emit, avs) finalState → + ExtraRepresented ctx finalState → + SelfAvailableBelow ctx cur limit input → + LowerArgsSoundBelow ctx cur limit input output + (args.map Prod.snd) emit avs + +/-- Successful `applyRest` runs preserve a previously produced shared +function result. This premise-parametric form composes both syntactic erased +absorption and genuine higher-order application. -/ +def ApplyRestPreservesBelow (ctx : Ctx) (cur : FnDef) (limit : Nat) + (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {start input : VEnv} {resultWorld : Owned} {pre : Emit} + {function : AVal} {args : List IxIR0.Expr} + {state finalState : LowSt} {output : VEnv} + {emit : Emit} {av : AVal}, + LowerResultSoundBelow ctx cur limit start input .shared pre function → + (applyRest src fuel input resultWorld pre function args).run state = + .ok (output, emit, av) finalState → + ExtraRepresented ctx finalState → + SelfAvailableBelow ctx cur limit input → + LowerResultSoundBelow ctx cur limit start output resultWorld emit av + +/-- Successful `knownCall` runs preserve ownership for one fixed operation +builder and argument telescope. Operation-specific dispatch supplies the +builder's result-world rule. -/ +def KnownCallPreservesBelow (ctx : Ctx) (cur : FnDef) (limit : Nat) + (src : IxIR0.Env) (fuel : Nat) (build : Array Atom → Op) + (count : Nat) (argWorlds : List Owned) (resultWorld : Owned) : Prop := + ∀ {input : VEnv} {args : List IxIR0.Expr} + {state finalState : LowSt} {output : VEnv} + {emit : Emit} {av : AVal}, + (knownCall src fuel input build count argWorlds resultWorld args).run + state = .ok (output, emit, av) finalState → + ExtraRepresented ctx finalState → + SelfAvailableBelow ctx cur limit input → + LowerResultSoundBelow ctx cur limit input output resultWorld emit av + +/-- Successful application-spine lowering at one compiler fuel. -/ +def LowerSpinePreservesBelow (ctx : Ctx) (cur : FnDef) (limit : Nat) + (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {world : Owned} {head : IxIR0.Expr} + {args : List IxIR0.Expr} {state finalState : LowSt} + {output : VEnv} {emit : Emit} {av : AVal}, + (lowerSpine src fuel input world head args).run state = + .ok (output, emit, av) finalState → + ExtraRepresented ctx finalState → + SelfAvailableBelow ctx cur limit input → + LowerResultSoundBelow ctx cur limit input output world emit av + +private theorem lowerArgs_nil_sound_at {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} : + LowerArgsSoundBelow ctx cur limit Γ Γ [] (_root_.id : Emit) [] := by + refine ⟨AValsStable.nil, ?_⟩ + intro rest slots + apply EmitSoundBelow.strengthen + intro store env hpre + obtain ⟨⟨roots, hΓ, hown⟩, hslots⟩ := hpre + exact ⟨⟨roots, [], hΓ, .nil, by simpa [rootsForWorlds] using hown⟩, + hslots⟩ + +theorem lowerArgs_nil_sound {ctx : Ctx} {cur : FnDef} {Γ : VEnv} : + LowerArgsSound ctx cur Γ Γ [] (_root_.id : Emit) [] := by + apply LowerArgsSound.of_below + intro limit + exact lowerArgs_nil_sound_at (limit := limit) + +theorem lowerArgs_nil_value_sound {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} : + LowerArgsValueSound funRel recSelfRel ctx cur Γ Γ + sourceEnv sourceEnv [] [] (_root_.id : Emit) [] := by + refine + { toLowerArgsSound := lowerArgs_nil_sound + graphEmits := ?_ } + intro sourceRest rest slots + apply EmitSound.strengthen + intro store env hpre + obtain ⟨⟨roots, hΓ, hrestGraph, hown⟩, hslots⟩ := hpre + exact ⟨⟨roots, [], hΓ, .nil, .nil, hrestGraph, + by simpa [rootsForWorlds] using hown⟩, hslots⟩ + +/-- Bounded base case for left-to-right argument lowering. -/ +theorem lowerArgs_nil_sound_below {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} : + LowerArgsSoundBelow ctx cur limit Γ Γ [] (_root_.id : Emit) [] := by + exact lowerArgs_nil_sound_at + +theorem lowerArgs_nil_value_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} : + LowerArgsValueSoundBelow funRel recSelfRel ctx cur limit Γ Γ + sourceEnv sourceEnv [] [] (_root_.id : Emit) [] := by + refine + { toLowerArgsSoundBelow := lowerArgs_nil_sound_below + graphEmits := ?_ } + intro sourceRest rest slots + apply EmitSoundBelow.strengthen + intro store env hpre + obtain ⟨⟨roots, hΓ, hrestGraph, hown⟩, hslots⟩ := hpre + exact ⟨⟨roots, [], hΓ, .nil, .nil, hrestGraph, + by simpa [rootsForWorlds] using hown⟩, hslots⟩ + +/-- The central `lowerArgs` cons rule. The head result becomes a protected +absolute slot while the tail is emitted; on completion it is realized again +and moved from the tail continuation into the argument-root prefix. -/ +theorem LowerResultSound.consArgs {ctx : Ctx} {cur : FnDef} + {input middle output : VEnv} {world : Owned} {worlds : List Owned} + {emitHead emitTail : Emit} {av : AVal} {avs : List AVal} + (head : LowerResultSound ctx cur input middle world emitHead av) + (tail : LowerArgsSound ctx cur middle output worlds emitTail avs) : + LowerArgsSound ctx cur input output (world :: worlds) + (emitHead ∘ emitTail) (av :: avs) := by + refine ⟨AValsStable.cons head.stable tail.stable, ?_⟩ + intro rest slots + apply EmitSound.comp (head.emits rest slots) + intro post code hcode + intro fuel store env finalStore finalValue hmid hrun + obtain ⟨⟨envRoots, value, hmiddle, hav, hown⟩, hslots⟩ := hmid + let root : Root := ⟨world, value⟩ + have hprotect : SlotsRealize middle env (aValProtection av value) := + head.stable.protection_realized hav + have htailOwn : RootOwnership store (envRoots ++ root :: rest) := by + apply hown.perm + simpa [root] using + (perm_extract_root root envRoots [] rest).symm + have htailPre : OwnsVEnvProtected middle (root :: rest) + (aValProtection av value ++ slots) store env := + ⟨⟨envRoots, hmiddle, htailOwn⟩, hprotect.append hslots⟩ + have htailCont : CodeOwns ctx cur + (OwnsArgsResultProtected output worlds avs (root :: rest) + (aValProtection av value ++ slots)) post code := by + intro innerFuel innerStore innerEnv resultStore resultValue htailPost hcodeRun + obtain ⟨⟨outRoots, values, houtput, havs, hownTail⟩, + hslotsTail⟩ := htailPost + have havFinal : AValRealizes output innerEnv av value := + head.stable.realize_of_protection hav hslotsTail.left_of_append + have hownFinal : RootOwnership innerStore + (rootsForWorlds (world :: worlds) (value :: values) ++ + outRoots ++ rest) := by + apply hownTail.perm + simpa [root, List.append_assoc] using + (perm_extract_root root + (rootsForWorlds worlds values ++ outRoots) [] rest) + apply hcode + · exact ⟨⟨outRoots, value :: values, houtput, + .cons havFinal havs, hownFinal⟩, hslotsTail.right_of_append⟩ + · exact hcodeRun + have htailCode : CodeOwns ctx cur + (OwnsVEnvProtected middle (root :: rest) + (aValProtection av value ++ slots)) post (emitTail code) := + tail.emits (root :: rest) (aValProtection av value ++ slots) + post code htailCont + exact htailCode htailPre hrun + +/-- Semantic argument sequencing. The head result is framed for the tail as +one related source/target root; the tail postcondition returns that +`RootsGraph`, so the head `ValueGraph` remains available in the final store. -/ +theorem LowerResultValueSound.consArgs {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + {input middle output : VEnv} + {sourceInput sourceMiddle sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {sourceValues : List IxIR0.Value} + {world : Owned} {worlds : List Owned} + {emitHead emitTail : Emit} {av : AVal} {avs : List AVal} + (head : LowerResultValueSound funRel recSelfRel ctx cur input middle + sourceInput sourceMiddle sourceValue world emitHead av) + (tail : LowerArgsValueSound funRel recSelfRel ctx cur middle output + sourceMiddle sourceOutput sourceValues worlds emitTail avs) : + LowerArgsValueSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput (sourceValue :: sourceValues) + (world :: worlds) (emitHead ∘ emitTail) (av :: avs) := by + refine + { toLowerArgsSound := head.toLowerResultSound.consArgs + tail.toLowerArgsSound + graphEmits := ?_ } + intro sourceRest rest slots + apply EmitSound.comp (head.graphEmits sourceRest rest slots) + intro post code hcode + intro fuel store env finalStore finalValue hmid hrun + obtain ⟨⟨envRoots, value, hmiddle, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hmid + let root : Root := ⟨world, value⟩ + have hrootWorld : HasWorld store world value := by + apply hown.roots_world root + simp [root] + have hframeGraph : Sim.RootsGraph funRel store + ((world, sourceValue) :: sourceRest) (root :: rest) := + .cons rfl hrootWorld hvalueGraph hrestGraph + have hprotect : SlotsRealize middle env (aValProtection av value) := + head.stable.protection_realized hav + have htailOwn : RootOwnership store (envRoots ++ root :: rest) := by + apply hown.perm + simpa [root] using + (perm_extract_root root envRoots [] rest).symm + have htailPre : GraphOwnsVEnvProtected funRel recSelfRel middle + sourceMiddle ((world, sourceValue) :: sourceRest) (root :: rest) + (aValProtection av value ++ slots) store env := + ⟨⟨envRoots, hmiddle, hframeGraph, htailOwn⟩, + hprotect.append hslots⟩ + have htailCont : CodeOwns ctx cur + (GraphOwnsArgsResultProtected funRel recSelfRel output + sourceOutput sourceValues worlds avs + ((world, sourceValue) :: sourceRest) (root :: rest) + (aValProtection av value ++ slots)) post code := by + intro innerFuel innerStore innerEnv resultStore resultValue + htailPost hcodeRun + obtain ⟨⟨outRoots, values, houtput, havs, hvalueGraphs, + hframeGraphFinal, hownTail⟩, hslotsTail⟩ := htailPost + cases hframeGraphFinal with + | cons _ _ hheadGraph hrestGraphFinal => + have havFinal : AValRealizes output innerEnv av value := + head.stable.realize_of_protection hav + hslotsTail.left_of_append + have hheadGraph' : + Sim.ValueGraph funRel innerStore sourceValue value := by + simpa [root] using hheadGraph + have hownFinal : RootOwnership innerStore + (rootsForWorlds (world :: worlds) (value :: values) ++ + outRoots ++ rest) := by + apply hownTail.perm + simpa [root, List.append_assoc] using + (perm_extract_root root + (rootsForWorlds worlds values ++ outRoots) [] rest) + apply hcode + · exact ⟨⟨outRoots, value :: values, houtput, + .cons havFinal havs, .cons hheadGraph' hvalueGraphs, + hrestGraphFinal, hownFinal⟩, + hslotsTail.right_of_append⟩ + · exact hcodeRun + have htailCode : CodeOwns ctx cur + (GraphOwnsVEnvProtected funRel recSelfRel middle sourceMiddle + ((world, sourceValue) :: sourceRest) (root :: rest) + (aValProtection av value ++ slots)) post (emitTail code) := + tail.graphEmits ((world, sourceValue) :: sourceRest) (root :: rest) + (aValProtection av value ++ slots) post code htailCont + exact htailCode htailPre hrun + +/-- Fuel-bounded argument sequencing. The hereditary emitter bound lets the +head protect its result slot across the recursively emitted tail exactly as +in `LowerResultSound.consArgs`. -/ +theorem LowerResultSoundBelow.consArgs {ctx : Ctx} {cur : FnDef} + {limit : Nat} {input middle output : VEnv} + {world : Owned} {worlds : List Owned} + {emitHead emitTail : Emit} {av : AVal} {avs : List AVal} + (head : LowerResultSoundBelow ctx cur limit input middle world + emitHead av) + (tail : LowerArgsSoundBelow ctx cur limit middle output worlds + emitTail avs) : + LowerArgsSoundBelow ctx cur limit input output (world :: worlds) + (emitHead ∘ emitTail) (av :: avs) := by + refine ⟨AValsStable.cons head.stable tail.stable, ?_⟩ + intro rest slots + apply EmitSoundBelow.comp (head.emits rest slots) + intro bound hbound post code hcode + intro fuel store env finalStore finalValue hfuel hmid hrun + obtain ⟨⟨envRoots, value, hmiddle, hav, hown⟩, hslots⟩ := hmid + let root : Root := ⟨world, value⟩ + have hprotect : SlotsRealize middle env (aValProtection av value) := + head.stable.protection_realized hav + have htailOwn : RootOwnership store (envRoots ++ root :: rest) := by + apply hown.perm + simpa [root] using + (perm_extract_root root envRoots [] rest).symm + have htailPre : OwnsVEnvProtected middle (root :: rest) + (aValProtection av value ++ slots) store env := + ⟨⟨envRoots, hmiddle, htailOwn⟩, hprotect.append hslots⟩ + have htailCont : CodeOwnsBelow ctx cur bound + (OwnsArgsResultProtected output worlds avs (root :: rest) + (aValProtection av value ++ slots)) post code := by + intro innerFuel innerStore innerEnv resultStore resultValue hinnerFuel + htailPost hcodeRun + obtain ⟨⟨outRoots, values, houtput, havs, hownTail⟩, + hslotsTail⟩ := htailPost + have havFinal : AValRealizes output innerEnv av value := + head.stable.realize_of_protection hav hslotsTail.left_of_append + have hownFinal : RootOwnership innerStore + (rootsForWorlds (world :: worlds) (value :: values) ++ + outRoots ++ rest) := by + apply hownTail.perm + simpa [root, List.append_assoc] using + (perm_extract_root root + (rootsForWorlds worlds values ++ outRoots) [] rest) + apply hcode hinnerFuel + · exact ⟨⟨outRoots, value :: values, houtput, + .cons havFinal havs, hownFinal⟩, hslotsTail.right_of_append⟩ + · exact hcodeRun + have htailCode : CodeOwnsBelow ctx cur bound + (OwnsVEnvProtected middle (root :: rest) + (aValProtection av value ++ slots)) post (emitTail code) := + tail.emits (root :: rest) (aValProtection av value ++ slots) + bound hbound post code htailCont + exact htailCode hfuel htailPre hrun + +/-- Fuel-bounded semantic argument sequencing. -/ +theorem LowerResultValueSoundBelow.consArgs + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input middle output : VEnv} + {sourceInput sourceMiddle sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {sourceValues : List IxIR0.Value} + {world : Owned} {worlds : List Owned} + {emitHead emitTail : Emit} {av : AVal} {avs : List AVal} + (head : LowerResultValueSoundBelow funRel recSelfRel ctx cur limit + input middle sourceInput sourceMiddle sourceValue world emitHead av) + (tail : LowerArgsValueSoundBelow funRel recSelfRel ctx cur limit + middle output sourceMiddle sourceOutput sourceValues worlds + emitTail avs) : + LowerArgsValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceInput sourceOutput (sourceValue :: sourceValues) + (world :: worlds) (emitHead ∘ emitTail) (av :: avs) := by + refine + { toLowerArgsSoundBelow := head.toLowerResultSoundBelow.consArgs + tail.toLowerArgsSoundBelow + graphEmits := ?_ } + intro sourceRest rest slots + apply EmitSoundBelow.comp (head.graphEmits sourceRest rest slots) + intro bound hbound post code hcode + intro fuel store env finalStore finalValue hfuel hmid hrun + obtain ⟨⟨envRoots, value, hmiddle, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hmid + let root : Root := ⟨world, value⟩ + have hrootWorld : HasWorld store world value := by + apply hown.roots_world root + simp [root] + have hframeGraph : Sim.RootsGraph funRel store + ((world, sourceValue) :: sourceRest) (root :: rest) := + .cons rfl hrootWorld hvalueGraph hrestGraph + have hprotect : SlotsRealize middle env (aValProtection av value) := + head.stable.protection_realized hav + have htailOwn : RootOwnership store (envRoots ++ root :: rest) := by + apply hown.perm + simpa [root] using + (perm_extract_root root envRoots [] rest).symm + have htailPre : GraphOwnsVEnvProtected funRel recSelfRel middle + sourceMiddle ((world, sourceValue) :: sourceRest) (root :: rest) + (aValProtection av value ++ slots) store env := + ⟨⟨envRoots, hmiddle, hframeGraph, htailOwn⟩, + hprotect.append hslots⟩ + have htailCont : CodeOwnsBelow ctx cur bound + (GraphOwnsArgsResultProtected funRel recSelfRel output + sourceOutput sourceValues worlds avs + ((world, sourceValue) :: sourceRest) (root :: rest) + (aValProtection av value ++ slots)) post code := by + intro innerFuel innerStore innerEnv resultStore resultValue hinnerFuel + htailPost hcodeRun + obtain ⟨⟨outRoots, values, houtput, havs, hvalueGraphs, + hframeGraphFinal, hownTail⟩, hslotsTail⟩ := htailPost + cases hframeGraphFinal with + | cons _ _ hheadGraph hrestGraphFinal => + have havFinal : AValRealizes output innerEnv av value := + head.stable.realize_of_protection hav + hslotsTail.left_of_append + have hheadGraph' : + Sim.ValueGraph funRel innerStore sourceValue value := by + simpa [root] using hheadGraph + have hownFinal : RootOwnership innerStore + (rootsForWorlds (world :: worlds) (value :: values) ++ + outRoots ++ rest) := by + apply hownTail.perm + simpa [root, List.append_assoc] using + (perm_extract_root root + (rootsForWorlds worlds values ++ outRoots) [] rest) + apply hcode hinnerFuel + · exact ⟨⟨outRoots, value :: values, houtput, + .cons havFinal havs, .cons hheadGraph' hvalueGraphs, + hrestGraphFinal, hownFinal⟩, + hslotsTail.right_of_append⟩ + · exact hcodeRun + have htailCode : CodeOwnsBelow ctx cur bound + (GraphOwnsVEnvProtected funRel recSelfRel middle sourceMiddle + ((world, sourceValue) :: sourceRest) (root :: rest) + (aValProtection av value ++ slots)) post (emitTail code) := + tail.graphEmits ((world, sourceValue) :: sourceRest) (root :: rest) + (aValProtection av value ++ slots) bound hbound post code htailCont + exact htailCode hfuel htailPre hrun + +/-- One compiler-fuel step of the `lowerArgs` induction. Both recursive +calls use the predecessor fuel, so this theorem is the exact bridge consumed +by the eventual joint strong induction over the lowering cluster. -/ +theorem lowerArgsPreservesBelow_succ + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} + (hexpr : LowerEPreservesBelow ctx cur limit src fuel) + (hargs : LowerArgsPreservesBelow ctx cur limit src fuel) + (hargsExtra : LowerArgsExtraMonotone src fuel) : + LowerArgsPreservesBelow ctx cur limit src (fuel + 1) := by + intro input args state finalState output emit avs hrun hrepresented + havailable + cases args with + | nil => + have hpure : + (input, (_root_.id : Emit), []) = (output, emit, avs) ∧ + state = finalState := by + simpa [lowerArgs] using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact lowerArgs_nil_sound_below + | cons head rest => + rcases head with ⟨expr, world⟩ + simp only [lowerArgs] at hrun + obtain ⟨headResult, middleState, hheadRun, hafterHead⟩ := + estateBindRun_ok_inv hrun + rcases headResult with ⟨middle, emitHead, av⟩ + dsimp only at hafterHead + obtain ⟨tailResult, tailState, htailRun, hpureRun⟩ := + estateBindRun_ok_inv hafterHead + rcases tailResult with ⟨actualOutput, emitTail, tailAvs⟩ + have hpure : + (actualOutput, emitHead ∘ emitTail, av :: tailAvs) = + (output, emit, avs) ∧ + tailState = finalState := by + simpa using hpureRun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + have hmiddleRepresented : ExtraRepresented ctx middleState := + hrepresented.of_extends + (hargsExtra middle rest htailRun) + have hmiddleAvailable := havailable.lowerE hheadRun + exact (hexpr hheadRun hmiddleRepresented havailable).consArgs + (hargs htailRun hrepresented hmiddleAvailable) + +/-- `lowerArgs` is not an independent mutual-induction obligation: at fuel +`n` it follows from expression soundness at every strictly smaller compiler +fuel. The tail recursion is discharged internally by ordinary induction. -/ +theorem lowerArgsPreservesBelow_of_expr + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + (fuel : Nat) + (hexpr : ∀ prior, prior < fuel → + LowerEPreservesBelow ctx cur limit src prior) + (hextra : ∀ prior, prior < fuel → + LowerArgsExtraMonotone src prior) : + LowerArgsPreservesBelow ctx cur limit src fuel := by + induction fuel with + | zero => + intro input args state finalState output emit avs hrun hrepresented _ + simp only [lowerArgs] at hrun + exact (estateThrowRun_not_ok hrun).elim + | succ fuel ih => + apply lowerArgsPreservesBelow_succ + · exact hexpr fuel (Nat.lt_succ_self fuel) + · apply ih + intro prior hprior + exact hexpr prior (Nat.lt_trans hprior (Nat.lt_succ_self fuel)) + intro prior hprior + exact hextra prior (Nat.lt_trans hprior (Nat.lt_succ_self fuel)) + · exact hextra fuel (Nat.lt_succ_self fuel) + +/-- Successful argument lowering preserves list length independently of its +semantic proof. This supplies the homogeneous-world equalities needed by +`applyRest` and `knownCall`. -/ +theorem lowerArgs_success_length (src : IxIR0.Env) : + ∀ {fuel : Nat} {input : VEnv} + {args : List (IxIR0.Expr × Owned)} {state finalState : LowSt} + {output : VEnv} {emit : Emit} {avs : List AVal}, + (lowerArgs src fuel input args).run state = + .ok (output, emit, avs) finalState → + avs.length = args.length := by + intro fuel + induction fuel with + | zero => + intro input args state finalState output emit avs hrun + simp only [lowerArgs] at hrun + exact (estateThrowRun_not_ok hrun).elim + | succ fuel ih => + intro input args state finalState output emit avs hrun + cases args with + | nil => + have hpure : + (input, (_root_.id : Emit), []) = (output, emit, avs) ∧ + state = finalState := by + simpa [lowerArgs] using hrun + obtain ⟨hvalue, _⟩ := hpure + cases hvalue + rfl + | cons head rest => + rcases head with ⟨expr, world⟩ + simp only [lowerArgs] at hrun + obtain ⟨headResult, middleState, _, hafterHead⟩ := + estateBindRun_ok_inv hrun + rcases headResult with ⟨middle, emitHead, av⟩ + dsimp only at hafterHead + obtain ⟨tailResult, tailState, htailRun, hpureRun⟩ := + estateBindRun_ok_inv hafterHead + rcases tailResult with ⟨actualOutput, emitTail, tailAvs⟩ + have hpure : + (actualOutput, emitHead ∘ emitTail, av :: tailAvs) = + (output, emit, avs) ∧ + tailState = finalState := by + simpa using hpureRun + obtain ⟨hvalue, _⟩ := hpure + cases hvalue + simp [ih htailRun] + +theorem map_shared_arg_worlds (args : List IxIR0.Expr) : + (args.map (fun arg => (arg, Owned.shared))).map Prod.snd = + List.replicate args.length .shared := by + induction args with + | nil => rfl + | cons arg args ih => + simp [List.replicate_succ, ih] + +/-- Zipping a known-call prefix with `padWorlds` never truncates the +expression prefix: `padWorlds` has exactly the requested length, while +`take count` has at most that length. -/ +theorem knownCall_prefix_exprs_eq (args : List IxIR0.Expr) + (worlds : List Owned) (count : Nat) : + (((args.take count).zip (padWorlds worlds count)).map Prod.fst) = + args.take count := by + apply List.map_fst_zip + simp [padWorlds] + omega + +/-- Once a known call has enough source arguments for its requested prefix, +zipping with a complete world telescope preserves that telescope exactly. -/ +theorem knownCall_prefix_worlds_eq (args : List IxIR0.Expr) + (worlds : List Owned) (count : Nat) + (hworlds : worlds.length = count) (hcount : count ≤ args.length) : + (((args.take count).zip (padWorlds worlds count)).map Prod.snd) = + worlds := by + rw [show padWorlds worlds count = worlds by + simp [padWorlds, ← hworlds]] + apply List.map_snd_zip + simp [hworlds, hcount] + +/-- The corresponding executable prefix has exactly the requested length. -/ +theorem knownCall_prefix_length_eq (args : List IxIR0.Expr) + (worlds : List Owned) (count : Nat) + (hworlds : worlds.length = count) (hcount : count ≤ args.length) : + ((args.take count).zip (padWorlds worlds count)).length = count := by + have hshape := knownCall_prefix_worlds_eq args worlds count hworlds hcount + simpa [hworlds] using congrArg List.length hshape + +/-- Repackage the common output of a result-producing operation as the +lowerer's fresh absolute result slot while preserving its `VEnv` and slot +frame. -/ +theorem ownsPushedRoot_result {Γ : VEnv} {envRoots rest : List Root} + {slots : List (Nat × RVal)} {world : Owned} : + ∀ {store env}, + OwnsPushedRoot + (fun oldEnv => VEnvRealizes Γ oldEnv envRoots ∧ + SlotsRealize Γ oldEnv slots) + world (envRoots ++ rest) store env → + OwnsResultProtected Γ.bump world (.slotA Γ.depth) + rest slots store env := by + intro store env hpush + obtain ⟨value, oldEnv, rfl, hΓ, hown⟩ := hpush + refine ⟨⟨envRoots, value, hΓ.1.bump value, ?_, hown⟩, + hΓ.2.bump value⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +/-- Generic bounded consumer for a lowered argument list followed by one +operation that consumes its roots and pushes a result. The operation-specific +rules supply only their expected root shape. -/ +theorem LowerArgsSoundBelow.finishPushed + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} {worlds : List Owned} + {emit : Emit} {avs : List AVal} {op : Op} + {resultWorld : Owned} {opRoots : List RVal → List Root} + (hargs : LowerArgsSoundBelow ctx cur limit input output worlds emit avs) + (hrootShape : ∀ {values : List RVal}, values.length = avs.length → + rootsForWorlds worlds values = opRoots values) + (hop : ∀ {frame : List RVal → Prop} {values : List RVal} + {tailRoots : List Root}, + values.length = avs.length → + EmitSoundBelow ctx cur limit (emitOp op) + (fun store env => frame env ∧ + resolveAtoms env (avs.map (·.toAtom output)).toArray = .ok values ∧ + RootOwnership store (opRoots values ++ tailRoots)) + (OwnsPushedRoot frame resultWorld tailRoots)) : + LowerResultSoundBelow ctx cur limit input output.bump resultWorld + (emit ∘ emitOp op) (.slotA output.depth) := by + refine ⟨.slot, ?_⟩ + intro rest slots + apply EmitSoundBelow.comp (hargs.emits rest slots) + intro bound hbound post code hcode + intro fuel store env finalStore finalValue hfuel hpre hrun + obtain ⟨⟨envRoots, values, houtput, havs, hown⟩, hslots⟩ := hpre + let frame : List RVal → Prop := fun oldEnv => + VEnvRealizes output oldEnv envRoots ∧ SlotsRealize output oldEnv slots + have hnext : CodeOwnsBelow ctx cur bound + (OwnsPushedRoot frame resultWorld (envRoots ++ rest)) post code := by + intro nextFuel nextStore nextEnv resultStore resultValue hnextFuel + hpushed hcodeRun + apply hcode hnextFuel + · exact ownsPushedRoot_result hpushed + · exact hcodeRun + have hvaluesLength : values.length = avs.length := havs.lengths.2.symm + have hopCode : CodeOwnsBelow ctx cur bound + (fun opStore opEnv => frame opEnv ∧ + resolveAtoms opEnv (avs.map (·.toAtom output)).toArray = .ok values ∧ + RootOwnership opStore (opRoots values ++ (envRoots ++ rest))) + post (emitOp op code) := + (hop hvaluesLength) bound hbound post code hnext + apply hopCode hfuel + · refine ⟨⟨houtput, hslots⟩, havs.resolveAtoms, ?_⟩ + simpa [hrootShape hvaluesLength, List.append_assoc] using hown + · exact hrun + +/-- Bounded direct-call consumer for a heterogeneous argument telescope. -/ +theorem LowerArgsSoundBelow.call_owned {ctx : Ctx} {cur d : FnDef} + {limit : Nat} {input output : VEnv} {worlds : List Owned} + {emit : Emit} {avs : List AVal} {f : Ixon.Address} + (hargs : LowerArgsSoundBelow ctx cur limit input output worlds emit avs) + (hdecl : ctx.decls f = some (.fn d)) + (hcontract : FnOwnershipContractBelow ctx d worlds limit) : + LowerResultSoundBelow ctx cur limit input output.bump d.result + (emit ∘ emitOp (.call f (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + apply hargs.finishPushed (opRoots := rootsForWorlds worlds) + · intro values _ + rfl + · intro frame values tailRoots _ + exact emit_call_owned_below hdecl hcontract + +/-- Bounded recursive-self-call consumer. -/ +theorem LowerArgsSoundBelow.callSelf_owned + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} {worlds : List Owned} + {emit : Emit} {avs : List AVal} + (hargs : LowerArgsSoundBelow ctx cur limit input output worlds emit avs) + (hcontract : FnOwnershipContractBelow ctx cur worlds limit) : + LowerResultSoundBelow ctx cur limit input output.bump cur.result + (emit ∘ emitOp (.callSelf (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + apply hargs.finishPushed (opRoots := rootsForWorlds worlds) + · intro values _ + rfl + · intro frame values tailRoots _ + exact emit_callSelf_owned_below hcontract + +/-- A malformed compiler environment may advertise the wrong recursive-self +arity. The emitted operation is nevertheless ownership-safe because the +target evaluator rejects that call before entering the current body. This +lets the compiler proof require a contract only at `cur.arity`; reachable +environments later rule out the malformed case altogether. -/ +theorem LowerArgsSoundBelow.callSelf_arity_mismatch + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} {worlds : List Owned} + {emit : Emit} {avs : List AVal} + (hargs : LowerArgsSoundBelow ctx cur limit input output worlds emit avs) + (harity : avs.length ≠ cur.arity) : + LowerResultSoundBelow ctx cur limit input output.bump cur.result + (emit ∘ emitOp (.callSelf (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + apply hargs.finishPushed (opRoots := rootsForWorlds worlds) + · intro values _ + rfl + · intro frame values tailRoots hvaluesLength + apply OpSoundBelow.emit + intro opFuel store env store' result hopFuel hpre hrun + obtain ⟨hframe, hresolve, hown⟩ := hpre + cases opFuel with + | zero => simp [runOp] at hrun + | succ fuel => + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [hresolve] at hrun + have hne : values.length ≠ cur.arity := by + intro heq + exact harity (hvaluesLength.symm.trans heq) + change (if (values.length != cur.arity) = true then + .error (.stuck "callSelf arity mismatch") + else + (do + let out ← runCode ctx fuel cur store values.reverse cur.body + checkResultWorld cur.result out)) = + .ok (store', result) at hrun + have hbne : (values.length != cur.arity) = true := by + simp [hne] + rw [if_pos hbne] at hrun + contradiction + +/-- Bounded homogeneous constructor allocation. -/ +theorem LowerArgsSoundBelow.alloc_owned + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} {world : Owned} {emit : Emit} + {avs : List AVal} {cid : CtorId} + (hargs : LowerArgsSoundBelow ctx cur limit input output + (List.replicate avs.length world) emit avs) : + LowerResultSoundBelow ctx cur limit input output.bump world + (emit ∘ emitOp + (.alloc world cid (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + apply hargs.finishPushed (opRoots := rootsFor world) + · intro values hlength + exact rootsForWorlds_replicate_eq_rootsFor world hlength + · intro frame values tailRoots _ + exact emit_alloc_owned_below + +/-- Bounded homogeneous partial-application allocation. -/ +theorem LowerArgsSoundBelow.papp_owned + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} {emit : Emit} {avs : List AVal} + {f : Ixon.Address} {d : Decl} + (hargs : LowerArgsSoundBelow ctx cur limit input output + (List.replicate avs.length .shared) emit avs) + (hdecl : ctx.decls f = some d) + (hunder : avs.length < declArity d) : + LowerResultSoundBelow ctx cur limit input output.bump .shared + (emit ∘ emitOp (.papp f (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + apply hargs.finishPushed (opRoots := rootsFor .shared) + · intro values hlength + exact rootsForWorlds_replicate_eq_rootsFor .shared hlength + · intro frame values tailRoots hlength + apply emit_papp_owned_below hdecl + simpa [hlength] using hunder + +/-- Bounded scalar-only extern consumer. -/ +theorem LowerArgsSoundBelow.extern_owned + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} {emit : Emit} {avs : List AVal} + {f : Ixon.Address} {resultWorld : Owned} + (hargs : LowerArgsSoundBelow ctx cur limit input output + (List.replicate avs.length .shared) emit avs) : + LowerResultSoundBelow ctx cur limit input output.bump resultWorld + (emit ∘ emitOp (.extern f (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + apply hargs.finishPushed (opRoots := rootsFor .shared) + · intro values hlength + exact rootsForWorlds_replicate_eq_rootsFor .shared hlength + · intro frame values tailRoots _ + exact emit_extern_owned_below + +/-- Consume a proved heterogeneous argument prefix with a direct call. The +callee contract removes every argument owner and produces one root in the +declaration's result world. -/ +theorem LowerArgsSound.call_owned {ctx : Ctx} {cur d : FnDef} + {input output : VEnv} {worlds : List Owned} {emit : Emit} + {avs : List AVal} {f : Ixon.Address} + (hargs : LowerArgsSound ctx cur input output worlds emit avs) + (hdecl : ctx.decls f = some (.fn d)) + (hcontract : FnOwnershipContract ctx d worlds) : + LowerResultSound ctx cur input output.bump d.result + (emit ∘ emitOp (.call f (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine ⟨.slot, ?_⟩ + intro rest slots + apply EmitSound.comp (hargs.emits rest slots) + intro post code hcode + intro fuel store env finalStore finalValue hpre hrun + obtain ⟨⟨envRoots, values, houtput, havs, hown⟩, hslots⟩ := hpre + let frame : List RVal → Prop := fun oldEnv => + VEnvRealizes output oldEnv envRoots ∧ SlotsRealize output oldEnv slots + have hnext : CodeOwns ctx cur + (OwnsPushedRoot frame d.result (envRoots ++ rest)) post code := by + intro nextFuel nextStore nextEnv resultStore resultValue hpushed hcodeRun + apply hcode + · exact ownsPushedRoot_result hpushed + · exact hcodeRun + have hcall : CodeOwns ctx cur + (fun callStore callEnv => + frame callEnv ∧ + resolveAtoms callEnv (avs.map (·.toAtom output)).toArray = + .ok values ∧ + RootOwnership callStore + (rootsForWorlds worlds values ++ (envRoots ++ rest))) + post (emitOp (.call f (avs.map (·.toAtom output)).toArray) code) := + (emit_call_owned hdecl hcontract) post code hnext + apply hcall + · exact ⟨⟨houtput, hslots⟩, havs.resolveAtoms, + by simpa [List.append_assoc] using hown⟩ + · exact hrun + +/-- Consume a proved heterogeneous argument prefix with a recursive call to +the current function. -/ +theorem LowerArgsSound.callSelf_owned {ctx : Ctx} {cur : FnDef} + {input output : VEnv} {worlds : List Owned} {emit : Emit} + {avs : List AVal} + (hargs : LowerArgsSound ctx cur input output worlds emit avs) + (hcontract : FnOwnershipContract ctx cur worlds) : + LowerResultSound ctx cur input output.bump cur.result + (emit ∘ emitOp (.callSelf (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine ⟨.slot, ?_⟩ + intro rest slots + apply EmitSound.comp (hargs.emits rest slots) + intro post code hcode + intro fuel store env finalStore finalValue hpre hrun + obtain ⟨⟨envRoots, values, houtput, havs, hown⟩, hslots⟩ := hpre + let frame : List RVal → Prop := fun oldEnv => + VEnvRealizes output oldEnv envRoots ∧ SlotsRealize output oldEnv slots + have hnext : CodeOwns ctx cur + (OwnsPushedRoot frame cur.result (envRoots ++ rest)) post code := by + intro nextFuel nextStore nextEnv resultStore resultValue hpushed hcodeRun + apply hcode + · exact ownsPushedRoot_result hpushed + · exact hcodeRun + have hcall : CodeOwns ctx cur + (fun callStore callEnv => + frame callEnv ∧ + resolveAtoms callEnv (avs.map (·.toAtom output)).toArray = + .ok values ∧ + RootOwnership callStore + (rootsForWorlds worlds values ++ (envRoots ++ rest))) + post + (emitOp (.callSelf (avs.map (·.toAtom output)).toArray) code) := + emit_callSelf_owned hcontract post code hnext + apply hcall + · exact ⟨⟨houtput, hslots⟩, havs.resolveAtoms, + by simpa [List.append_assoc] using hown⟩ + · exact hrun + +/-- Consume a homogeneous argument prefix as the fields of a fresh +constructor. This is the whole-value ownership rule used by saturated +constructor spines in `knownCall`. -/ +theorem LowerArgsSound.alloc_owned {ctx : Ctx} {cur : FnDef} + {input output : VEnv} {world : Owned} {emit : Emit} + {avs : List AVal} {cid : CtorId} + (hargs : LowerArgsSound ctx cur input output + (List.replicate avs.length world) emit avs) : + LowerResultSound ctx cur input output.bump world + (emit ∘ emitOp + (.alloc world cid (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine ⟨.slot, ?_⟩ + intro rest slots + apply EmitSound.comp (hargs.emits rest slots) + intro post code hcode + intro fuel store env finalStore finalValue hpre hrun + obtain ⟨⟨envRoots, values, houtput, havs, hown⟩, hslots⟩ := hpre + let frame : List RVal → Prop := fun oldEnv => + VEnvRealizes output oldEnv envRoots ∧ SlotsRealize output oldEnv slots + have hnext : CodeOwns ctx cur + (OwnsPushedRoot frame world (envRoots ++ rest)) post code := by + intro nextFuel nextStore nextEnv resultStore resultValue hpushed hcodeRun + apply hcode + · exact ownsPushedRoot_result hpushed + · exact hcodeRun + have halloc : CodeOwns ctx cur + (fun allocStore allocEnv => + frame allocEnv ∧ + resolveAtoms allocEnv (avs.map (·.toAtom output)).toArray = + .ok values ∧ + RootOwnership allocStore + (rootsFor world values ++ (envRoots ++ rest))) + post + (emitOp (.alloc world cid (avs.map (·.toAtom output)).toArray) + code) := + emit_alloc_owned post code hnext + have hvaluesLength : values.length = avs.length := havs.lengths.2.symm + have hroots : rootsForWorlds (List.replicate avs.length world) values = + rootsFor world values := + rootsForWorlds_replicate_eq_rootsFor world hvaluesLength + apply halloc + · exact ⟨⟨houtput, hslots⟩, havs.resolveAtoms, + by simpa [hroots, List.append_assoc] using hown⟩ + · exact hrun + +/-- Operation-level semantic constructor allocation. -/ +theorem alloc_graph_op + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {output : VEnv} + {sourceOutput sourceValues : List IxIR0.Value} + {sourceAddress : Ixon.Address} {sourceTag : Nat} + {world : Owned} {avs : List AVal} {cid : CtorId} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + {slots : List (Nat × RVal)} + (haddress : cid.block = sourceAddress) + (htag : cid.cidx = sourceTag) : + OpSound ctx cur + (.alloc world cid (avs.map (·.toAtom output)).toArray) + (GraphOwnsArgsResultProtected funRel recSelfRel output sourceOutput + sourceValues (List.replicate avs.length world) avs sourceRest rest + slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + (.ctor sourceAddress sourceTag sourceValues) world + (.slotA output.depth) sourceRest rest slots) := by + intro fuel store env store' result hpre hrun + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + have hvaluesLength : values.length = avs.length := + havs.lengths.2.symm + have hroots : + rootsForWorlds (List.replicate avs.length world) values = + rootsFor world values := + rootsForWorlds_replicate_eq_rootsFor world hvaluesLength + have hown' : RootOwnership store + (rootsFor world values ++ (envRoots ++ rest)) := by + simpa [hroots, List.append_assoc] using hown + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + obtain ⟨heval, hstore, hresultGraph, hresultOwn⟩ := + runOp_alloc_owned_valueGraph + (ctx := ctx) (cur := cur) (fuel := fuel) + havs.resolveAtoms haddress htag hvalueGraphs hown' + have hpair : + ((store.allocNode world (.ctorN cid values.toArray)).1, + .loc (store.allocNode world (.ctorN cid values.toArray)).2) = + (store', result) := + Except.ok.inj (heval.symm.trans hrun) + cases hpair + have houtput' := houtput.monoStore hstore + have hrestGraph' := hrestGraph.monoStore hstore + let ctorValue : RVal := .loc + (store.allocNode world (.ctorN cid values.toArray)).2 + refine ⟨⟨envRoots, ctorValue, houtput'.bump ctorValue, ?_, + hresultGraph, hrestGraph', hresultOwn⟩, hslots.bump ctorValue⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [ctorValue, VEnv.bump, VEnv.rel] + +/-- Semantic constructor allocation. The related source arguments become +the fields of the fresh constructor graph, while the output environment and +caller frame transport through the allocation unchanged. -/ +theorem LowerArgsValueSound.alloc_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput sourceValues : List IxIR0.Value} + {sourceAddress : Ixon.Address} {sourceTag : Nat} + {world : Owned} {emit : Emit} {avs : List AVal} {cid : CtorId} + (hargs : LowerArgsValueSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValues + (List.replicate avs.length world) emit avs) + (haddress : cid.block = sourceAddress) + (htag : cid.cidx = sourceTag) : + LowerResultValueSound funRel recSelfRel ctx cur input output.bump + sourceInput sourceOutput (.ctor sourceAddress sourceTag sourceValues) + world + (emit ∘ emitOp + (.alloc world cid (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultSound := hargs.toLowerArgsSound.alloc_owned + graphEmits := ?_ } + intro sourceRest rest slots + apply EmitSound.comp (hargs.graphEmits sourceRest rest slots) + apply OpSound.emit + intro fuel store env store' result hpre hrun + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + have hvaluesLength : values.length = avs.length := + havs.lengths.2.symm + have hroots : + rootsForWorlds (List.replicate avs.length world) values = + rootsFor world values := + rootsForWorlds_replicate_eq_rootsFor world hvaluesLength + have hown' : RootOwnership store + (rootsFor world values ++ (envRoots ++ rest)) := by + simpa [hroots, List.append_assoc] using hown + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + obtain ⟨heval, hstore, hresultGraph, hresultOwn⟩ := + runOp_alloc_owned_valueGraph + (ctx := ctx) (cur := cur) (fuel := fuel) + havs.resolveAtoms haddress htag hvalueGraphs hown' + have hpair : + ((store.allocNode world (.ctorN cid values.toArray)).1, + .loc (store.allocNode world (.ctorN cid values.toArray)).2) = + (store', result) := + Except.ok.inj (heval.symm.trans hrun) + cases hpair + have houtput' := houtput.monoStore hstore + have hrestGraph' := hrestGraph.monoStore hstore + let ctorValue : RVal := .loc + (store.allocNode world (.ctorN cid values.toArray)).2 + refine ⟨⟨envRoots, ctorValue, houtput'.bump ctorValue, ?_, + hresultGraph, hrestGraph', hresultOwn⟩, hslots.bump ctorValue⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [ctorValue, VEnv.bump, VEnv.rel] + +theorem LowerArgsValueSoundBelow.alloc_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} + {sourceInput sourceOutput sourceValues : List IxIR0.Value} + {sourceAddress : Ixon.Address} {sourceTag : Nat} + {world : Owned} {emit : Emit} {avs : List AVal} {cid : CtorId} + (hargs : LowerArgsValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceValues + (List.replicate avs.length world) emit avs) + (haddress : cid.block = sourceAddress) + (htag : cid.cidx = sourceTag) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input + output.bump sourceInput sourceOutput + (.ctor sourceAddress sourceTag sourceValues) world + (emit ∘ emitOp + (.alloc world cid (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultSoundBelow := + hargs.toLowerArgsSoundBelow.alloc_owned + graphEmits := ?_ } + intro sourceRest rest slots + apply EmitSoundBelow.comp (hargs.graphEmits sourceRest rest slots) + apply OpSoundBelow.emit + intro fuel store env store' result _ hpre hrun + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + have hvaluesLength : values.length = avs.length := + havs.lengths.2.symm + have hroots : + rootsForWorlds (List.replicate avs.length world) values = + rootsFor world values := + rootsForWorlds_replicate_eq_rootsFor world hvaluesLength + have hown' : RootOwnership store + (rootsFor world values ++ (envRoots ++ rest)) := by + simpa [hroots, List.append_assoc] using hown + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + obtain ⟨heval, hstore, hresultGraph, hresultOwn⟩ := + runOp_alloc_owned_valueGraph + (ctx := ctx) (cur := cur) (fuel := fuel) + havs.resolveAtoms haddress htag hvalueGraphs hown' + have hpair : + ((store.allocNode world (.ctorN cid values.toArray)).1, + .loc (store.allocNode world (.ctorN cid values.toArray)).2) = + (store', result) := + Except.ok.inj (heval.symm.trans hrun) + cases hpair + have houtput' := houtput.monoStore hstore + have hrestGraph' := hrestGraph.monoStore hstore + let ctorValue : RVal := .loc + (store.allocNode world (.ctorN cid values.toArray)).2 + refine ⟨⟨envRoots, ctorValue, houtput'.bump ctorValue, ?_, + hresultGraph, hrestGraph', hresultOwn⟩, hslots.bump ctorValue⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [ctorValue, VEnv.bump, VEnv.rel] + +/-- Fold a homogeneous shared argument prefix into a fresh partial- +application node. -/ +theorem LowerArgsSound.papp_owned {ctx : Ctx} {cur : FnDef} + {input output : VEnv} {emit : Emit} {avs : List AVal} + {f : Ixon.Address} {d : Decl} + (hargs : LowerArgsSound ctx cur input output + (List.replicate avs.length .shared) emit avs) + (hdecl : ctx.decls f = some d) + (hunder : avs.length < declArity d) : + LowerResultSound ctx cur input output.bump .shared + (emit ∘ emitOp (.papp f (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine ⟨.slot, ?_⟩ + intro rest slots + apply EmitSound.comp (hargs.emits rest slots) + intro post code hcode + intro fuel store env finalStore finalValue hpre hrun + obtain ⟨⟨envRoots, values, houtput, havs, hown⟩, hslots⟩ := hpre + let frame : List RVal → Prop := fun oldEnv => + VEnvRealizes output oldEnv envRoots ∧ SlotsRealize output oldEnv slots + have hnext : CodeOwns ctx cur + (OwnsPushedRoot frame .shared (envRoots ++ rest)) post code := by + intro nextFuel nextStore nextEnv resultStore resultValue hpushed hcodeRun + apply hcode + · exact ownsPushedRoot_result hpushed + · exact hcodeRun + have hvaluesLength : values.length = avs.length := havs.lengths.2.symm + have hunderValues : values.length < declArity d := by + simpa [hvaluesLength] using hunder + have hpapp : CodeOwns ctx cur + (fun pappStore pappEnv => + frame pappEnv ∧ + resolveAtoms pappEnv (avs.map (·.toAtom output)).toArray = + .ok values ∧ + RootOwnership pappStore + (rootsFor .shared values ++ (envRoots ++ rest))) + post + (emitOp (.papp f (avs.map (·.toAtom output)).toArray) code) := + emit_papp_owned hdecl hunderValues post code hnext + have hroots : + rootsForWorlds (List.replicate avs.length .shared) values = + rootsFor .shared values := + rootsForWorlds_replicate_eq_rootsFor .shared hvaluesLength + apply hpapp + · exact ⟨⟨houtput, hslots⟩, havs.resolveAtoms, + by simpa [hroots, List.append_assoc] using hown⟩ + · exact hrun + +/-- Operation-level semantic pap allocation. Besides conserving roots, the +fresh shared node realizes a source function value whose complete stored +prefix is the related source argument vector. -/ +theorem papp_graph_op + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {output : VEnv} {sourceOutput sourceValues : List IxIR0.Value} + {sourceValue : IxIR0.Value} {avs : List AVal} + {f : Ixon.Address} {d : Decl} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + {slots : List (Nat × RVal)} + (hdecl : ctx.decls f = some d) + (hfun : funRel sourceValue f (declArity d) sourceValues) + (hunder : avs.length < declArity d) : + OpSound ctx cur (.papp f (avs.map (·.toAtom output)).toArray) + (GraphOwnsArgsResultProtected funRel recSelfRel output + sourceOutput sourceValues (List.replicate avs.length .shared) avs + sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump + sourceOutput sourceValue .shared (.slotA output.depth) + sourceRest rest slots) := by + intro fuel store env store' result hpre hrun + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + have hvaluesLength : values.length = avs.length := + havs.lengths.2.symm + have hunderValues : values.length < declArity d := by + simpa [hvaluesLength] using hunder + have hroots : + rootsForWorlds (List.replicate avs.length .shared) values = + rootsFor .shared values := + rootsForWorlds_replicate_eq_rootsFor .shared hvaluesLength + have hown' : RootOwnership store + (rootsFor .shared values ++ (envRoots ++ rest)) := by + simpa [hroots, List.append_assoc] using hown + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + obtain ⟨heval, hstore, hresultGraph, hresultOwn⟩ := + runOp_papp_owned_valueGraph + (ctx := ctx) (cur := cur) (fuel := fuel) + havs.resolveAtoms hdecl hunderValues hfun hvalueGraphs hown' + have hpair : + ((store.allocNode .shared + (.papN f (declArity d) values.toArray)).1, + .loc (store.allocNode .shared + (.papN f (declArity d) values.toArray)).2) = + (store', result) := + Except.ok.inj (heval.symm.trans hrun) + cases hpair + have houtput' := houtput.monoStore hstore + have hrestGraph' := hrestGraph.monoStore hstore + let papValue : RVal := .loc (store.allocNode .shared + (.papN f (declArity d) values.toArray)).2 + refine ⟨⟨envRoots, papValue, houtput'.bump papValue, ?_, + hresultGraph, hrestGraph', hresultOwn⟩, hslots.bump papValue⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [papValue, VEnv.bump, VEnv.rel] + +/-- Semantic pap allocation lifted across an already verified argument +prefix. -/ +theorem LowerArgsValueSound.papp_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput sourceValues : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {avs : List AVal} + {f : Ixon.Address} {d : Decl} + (hargs : LowerArgsValueSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValues + (List.replicate avs.length .shared) emit avs) + (hdecl : ctx.decls f = some d) + (hfun : funRel sourceValue f (declArity d) sourceValues) + (hunder : avs.length < declArity d) : + LowerResultValueSound funRel recSelfRel ctx cur input output.bump + sourceInput sourceOutput sourceValue .shared + (emit ∘ emitOp (.papp f (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultSound := + hargs.toLowerArgsSound.papp_owned hdecl hunder + graphEmits := ?_ } + intro sourceRest rest slots + apply EmitSound.comp (hargs.graphEmits sourceRest rest slots) + exact OpSound.emit (papp_graph_op hdecl hfun hunder) + +theorem LowerArgsValueSoundBelow.papp_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} + {sourceInput sourceOutput sourceValues : List IxIR0.Value} + {sourceValue : IxIR0.Value} {emit : Emit} {avs : List AVal} + {f : Ixon.Address} {d : Decl} + (hargs : LowerArgsValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceValues + (List.replicate avs.length .shared) emit avs) + (hdecl : ctx.decls f = some d) + (hfun : funRel sourceValue f (declArity d) sourceValues) + (hunder : avs.length < declArity d) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input + output.bump sourceInput sourceOutput sourceValue .shared + (emit ∘ emitOp (.papp f (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultSoundBelow := + hargs.toLowerArgsSoundBelow.papp_owned hdecl hunder + graphEmits := ?_ } + intro sourceRest rest slots + apply EmitSoundBelow.comp (hargs.graphEmits sourceRest rest slots) + apply OpSoundBelow.emit + intro fuel store env store' result _ hpre hrun + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + have hvaluesLength : values.length = avs.length := + havs.lengths.2.symm + have hunderValues : values.length < declArity d := by + simpa [hvaluesLength] using hunder + have hroots : + rootsForWorlds (List.replicate avs.length .shared) values = + rootsFor .shared values := + rootsForWorlds_replicate_eq_rootsFor .shared hvaluesLength + have hown' : RootOwnership store + (rootsFor .shared values ++ (envRoots ++ rest)) := by + simpa [hroots, List.append_assoc] using hown + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + obtain ⟨heval, hstore, hresultGraph, hresultOwn⟩ := + runOp_papp_owned_valueGraph + (ctx := ctx) (cur := cur) (fuel := fuel) + havs.resolveAtoms hdecl hunderValues hfun hvalueGraphs hown' + have hpair : + ((store.allocNode .shared + (.papN f (declArity d) values.toArray)).1, + .loc (store.allocNode .shared + (.papN f (declArity d) values.toArray)).2) = + (store', result) := + Except.ok.inj (heval.symm.trans hrun) + cases hpair + have houtput' := houtput.monoStore hstore + have hrestGraph' := hrestGraph.monoStore hstore + let papValue : RVal := .loc (store.allocNode .shared + (.papN f (declArity d) values.toArray)).2 + refine ⟨⟨envRoots, papValue, houtput'.bump papValue, ?_, + hresultGraph, hrestGraph', hresultOwn⟩, hslots.bump papValue⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [papValue, VEnv.bump, VEnv.rel] + +/-- Consume a homogeneous shared argument prefix through the scalar-only +extern ABI and package its scalar result at the demanded world. -/ +theorem LowerArgsSound.extern_owned {ctx : Ctx} {cur : FnDef} + {input output : VEnv} {emit : Emit} {avs : List AVal} + {f : Ixon.Address} {resultWorld : Owned} + (hargs : LowerArgsSound ctx cur input output + (List.replicate avs.length .shared) emit avs) : + LowerResultSound ctx cur input output.bump resultWorld + (emit ∘ emitOp (.extern f (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine ⟨.slot, ?_⟩ + intro rest slots + apply EmitSound.comp (hargs.emits rest slots) + intro post code hcode + intro fuel store env finalStore finalValue hpre hrun + obtain ⟨⟨envRoots, values, houtput, havs, hown⟩, hslots⟩ := hpre + let frame : List RVal → Prop := fun oldEnv => + VEnvRealizes output oldEnv envRoots ∧ SlotsRealize output oldEnv slots + have hnext : CodeOwns ctx cur + (OwnsPushedRoot frame resultWorld (envRoots ++ rest)) post code := by + intro nextFuel nextStore nextEnv resultStore resultValue hpushed hcodeRun + apply hcode + · exact ownsPushedRoot_result hpushed + · exact hcodeRun + have hextern : CodeOwns ctx cur + (fun externStore externEnv => + frame externEnv ∧ + resolveAtoms externEnv (avs.map (·.toAtom output)).toArray = + .ok values ∧ + RootOwnership externStore + (rootsFor .shared values ++ (envRoots ++ rest))) + post + (emitOp (.extern f (avs.map (·.toAtom output)).toArray) code) := + emit_extern_owned post code hnext + have hvaluesLength : values.length = avs.length := havs.lengths.2.symm + have hroots : + rootsForWorlds (List.replicate avs.length .shared) values = + rootsFor .shared values := + rootsForWorlds_replicate_eq_rootsFor .shared hvaluesLength + apply hextern + · exact ⟨⟨houtput, hslots⟩, havs.resolveAtoms, + by simpa [hroots, List.append_assoc] using hown⟩ + · exact hrun + +/-- Lower shared arguments while protecting an already-produced function +descriptor, then consume the function root and argument prefix together via +the context's higher-order apply contract. -/ +theorem LowerArgsSound.apply_owned {ctx : Ctx} {cur : FnDef} + {input output : VEnv} {emit : Emit} {avs : List AVal} + {function : AVal} + (hargs : LowerArgsSound ctx cur input output + (List.replicate avs.length .shared) emit avs) + (hfunctionStable : AValStable function) + (hcontract : ApplyOwnershipContract ctx) : + ∀ rest slots, + EmitSound ctx cur + (emit ∘ emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (OwnsResultProtected input .shared function rest slots) + (OwnsResultProtected output.bump .shared (.slotA output.depth) + rest slots) := by + intro rest slots post code hcode + intro fuel store env finalStore finalValue hfunctionPre hrun + obtain ⟨⟨envRoots, functionValue, hinput, hfunction, hownFunction⟩, + hslots⟩ := hfunctionPre + let functionRoot : Root := ⟨.shared, functionValue⟩ + have hfunctionProtection : + SlotsRealize input env (aValProtection function functionValue) := + hfunctionStable.protection_realized hfunction + have hargsOwn : RootOwnership store (envRoots ++ functionRoot :: rest) := by + apply hownFunction.perm + simpa [functionRoot] using + (perm_extract_root functionRoot envRoots [] rest).symm + have hargsPre : OwnsVEnvProtected input (functionRoot :: rest) + (aValProtection function functionValue ++ slots) store env := + ⟨⟨envRoots, hinput, hargsOwn⟩, hfunctionProtection.append hslots⟩ + have hargsCont : CodeOwns ctx cur + (OwnsArgsResultProtected output + (List.replicate avs.length .shared) avs (functionRoot :: rest) + (aValProtection function functionValue ++ slots)) + post + (emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray) code) := by + intro argsFuel argsStore argsEnv resultStore resultValue hargsPost happlyRun + obtain ⟨⟨outRoots, values, houtput, havs, hownArgs⟩, + hslotsOut⟩ := hargsPost + have hfunctionFinal : AValRealizes output argsEnv function functionValue := + hfunctionStable.realize_of_protection hfunction + hslotsOut.left_of_append + have hvaluesLength : values.length = avs.length := havs.lengths.2.symm + have hroots : + rootsForWorlds (List.replicate avs.length .shared) values = + rootsFor .shared values := + rootsForWorlds_replicate_eq_rootsFor .shared hvaluesLength + have hownApply : RootOwnership argsStore + (functionRoot :: rootsFor .shared values ++ (outRoots ++ rest)) := by + apply hownArgs.perm + simpa [functionRoot, hroots, List.append_assoc] using + (perm_extract_root functionRoot + (rootsForWorlds (List.replicate avs.length .shared) values ++ + outRoots) [] rest) + let frame : List RVal → Prop := fun oldEnv => + VEnvRealizes output oldEnv outRoots ∧ + SlotsRealize output oldEnv slots + have hnext : CodeOwns ctx cur + (OwnsPushedRoot frame .shared (outRoots ++ rest)) post code := by + intro nextFuel nextStore nextEnv endStore endValue hpushed hcodeRun + apply hcode + · exact ownsPushedRoot_result hpushed + · exact hcodeRun + have happly : CodeOwns ctx cur + (fun applyStore applyEnv => + frame applyEnv ∧ + resolveAtom applyEnv (function.toAtom output) = + .ok functionValue ∧ + resolveAtoms applyEnv (avs.map (·.toAtom output)).toArray = + .ok values ∧ + RootOwnership applyStore + (functionRoot :: rootsFor .shared values ++ (outRoots ++ rest))) + post + (emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray) code) := + emit_apply_owned hcontract post code hnext + apply happly + · exact ⟨⟨houtput, hslotsOut.right_of_append⟩, + hfunctionFinal.resolveAtom, havs.resolveAtoms, hownApply⟩ + · exact happlyRun + have hargsCode : CodeOwns ctx cur + (OwnsVEnvProtected input (functionRoot :: rest) + (aValProtection function functionValue ++ slots)) post + (emit (emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray) code)) := + hargs.emits (functionRoot :: rest) + (aValProtection function functionValue ++ slots) + post _ hargsCont + exact hargsCode hargsPre hrun + +/-- Full non-erased `applyRest` semantic composition, abstracting only the +executable recursive calls: first produce a shared function, lower all +supplied shared arguments, then apply under the context contract. -/ +theorem LowerResultSound.applyArgs {ctx : Ctx} {cur : FnDef} + {start input output : VEnv} {emitFunction emitArgs : Emit} + {function : AVal} {avs : List AVal} + (hfunction : LowerResultSound ctx cur start input .shared + emitFunction function) + (hargs : LowerArgsSound ctx cur input output + (List.replicate avs.length .shared) emitArgs avs) + (hcontract : ApplyOwnershipContract ctx) : + LowerResultSound ctx cur start output.bump .shared + ((emitFunction ∘ emitArgs) ∘ + emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine ⟨.slot, ?_⟩ + intro rest slots + have hcomposed := EmitSound.comp (hfunction.emits rest slots) + (hargs.apply_owned hfunction.stable hcontract rest slots) + simpa [Function.comp_def] using hcomposed + +/-- Bounded higher-order application after shared argument lowering. -/ +theorem LowerArgsSoundBelow.apply_owned + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} {emit : Emit} {avs : List AVal} + {function : AVal} + (hargs : LowerArgsSoundBelow ctx cur limit input output + (List.replicate avs.length .shared) emit avs) + (hfunctionStable : AValStable function) + (hcontract : ApplyOwnershipContractBelow ctx limit) : + ∀ rest slots, + EmitSoundBelow ctx cur limit + (emit ∘ emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (OwnsResultProtected input .shared function rest slots) + (OwnsResultProtected output.bump .shared (.slotA output.depth) + rest slots) := by + intro rest slots bound hbound post code hcode + intro fuel store env finalStore finalValue hfuel hfunctionPre hrun + obtain ⟨⟨envRoots, functionValue, hinput, hfunction, hownFunction⟩, + hslots⟩ := hfunctionPre + let functionRoot : Root := ⟨.shared, functionValue⟩ + have hfunctionProtection : + SlotsRealize input env (aValProtection function functionValue) := + hfunctionStable.protection_realized hfunction + have hargsOwn : RootOwnership store (envRoots ++ functionRoot :: rest) := by + apply hownFunction.perm + simpa [functionRoot] using + (perm_extract_root functionRoot envRoots [] rest).symm + have hargsPre : OwnsVEnvProtected input (functionRoot :: rest) + (aValProtection function functionValue ++ slots) store env := + ⟨⟨envRoots, hinput, hargsOwn⟩, hfunctionProtection.append hslots⟩ + have hargsCont : CodeOwnsBelow ctx cur bound + (OwnsArgsResultProtected output + (List.replicate avs.length .shared) avs (functionRoot :: rest) + (aValProtection function functionValue ++ slots)) + post + (emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray) code) := by + intro argsFuel argsStore argsEnv resultStore resultValue hargsFuel + hargsPost happlyRun + obtain ⟨⟨outRoots, values, houtput, havs, hownArgs⟩, + hslotsOut⟩ := hargsPost + have hfunctionFinal : AValRealizes output argsEnv function functionValue := + hfunctionStable.realize_of_protection hfunction + hslotsOut.left_of_append + have hvaluesLength : values.length = avs.length := havs.lengths.2.symm + have hroots : + rootsForWorlds (List.replicate avs.length .shared) values = + rootsFor .shared values := + rootsForWorlds_replicate_eq_rootsFor .shared hvaluesLength + have hownApply : RootOwnership argsStore + (functionRoot :: rootsFor .shared values ++ (outRoots ++ rest)) := by + apply hownArgs.perm + simpa [functionRoot, hroots, List.append_assoc] using + (perm_extract_root functionRoot + (rootsForWorlds (List.replicate avs.length .shared) values ++ + outRoots) [] rest) + let frame : List RVal → Prop := fun oldEnv => + VEnvRealizes output oldEnv outRoots ∧ + SlotsRealize output oldEnv slots + have hnext : CodeOwnsBelow ctx cur bound + (OwnsPushedRoot frame .shared (outRoots ++ rest)) post code := by + intro nextFuel nextStore nextEnv endStore endValue hnextFuel + hpushed hcodeRun + apply hcode hnextFuel + · exact ownsPushedRoot_result hpushed + · exact hcodeRun + have happly : CodeOwnsBelow ctx cur bound + (fun applyStore applyEnv => + frame applyEnv ∧ + resolveAtom applyEnv (function.toAtom output) = + .ok functionValue ∧ + resolveAtoms applyEnv (avs.map (·.toAtom output)).toArray = + .ok values ∧ + RootOwnership applyStore + (functionRoot :: rootsFor .shared values ++ (outRoots ++ rest))) + post + (emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray) code) := + (emit_apply_owned_below hcontract) bound hbound post code hnext + apply happly hargsFuel + · exact ⟨⟨houtput, hslotsOut.right_of_append⟩, + hfunctionFinal.resolveAtom, havs.resolveAtoms, hownApply⟩ + · exact happlyRun + have hargsCode : CodeOwnsBelow ctx cur bound + (OwnsVEnvProtected input (functionRoot :: rest) + (aValProtection function functionValue ++ slots)) post + (emit (emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray) code)) := + hargs.emits (functionRoot :: rest) + (aValProtection function functionValue ++ slots) + bound hbound post _ hargsCont + exact hargsCode hfuel hargsPre hrun + +/-- Bounded semantic composition for the non-erased `applyRest` path. -/ +theorem LowerResultSoundBelow.applyArgs + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {start input output : VEnv} {emitFunction emitArgs : Emit} + {function : AVal} {avs : List AVal} + (hfunction : LowerResultSoundBelow ctx cur limit start input .shared + emitFunction function) + (hargs : LowerArgsSoundBelow ctx cur limit input output + (List.replicate avs.length .shared) emitArgs avs) + (hcontract : ApplyOwnershipContractBelow ctx limit) : + LowerResultSoundBelow ctx cur limit start output.bump .shared + ((emitFunction ∘ emitArgs) ∘ + emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine ⟨.slot, ?_⟩ + intro rest slots + have hcomposed := EmitSoundBelow.comp (hfunction.emits rest slots) + (hargs.apply_owned hfunction.stable hcontract rest slots) + simpa [Function.comp_def] using hcomposed + +/-! ## Erased-result argument release -/ + +private theorem discard_const_arg_at {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} {atom : Atom} + {worlds : List Owned} {avs : List AVal} + (hstable : AValStable (.constA atom)) : + ∀ rest slots, + EmitSoundBelow ctx cur limit (_root_.id : Emit) + (OwnsArgsResultProtected Γ (.shared :: worlds) + (.constA atom :: avs) rest slots) + (OwnsArgsResultProtected Γ worlds avs rest slots) := by + intro rest slots + apply EmitSoundBelow.strengthen + intro store env hpre + obtain ⟨⟨roots, values, hΓ, havs, hown⟩, hslots⟩ := hpre + cases havs with + | @cons headWorld tailWorlds headAV tailAVs value tailValues hav htail => + have howned : RootOwnership store + (⟨.shared, value⟩ :: + (rootsForWorlds worlds tailValues ++ roots ++ rest)) := by + simpa [rootsForWorlds] using hown + exact ⟨⟨roots, tailValues, hΓ, htail, + howned.dropNoLocation (hstable.const_noLocation hav)⟩, hslots⟩ + +/-- Skipping a stable constant argument consumes its scalar logical root +without changing the store or runtime environment. -/ +theorem discard_const_arg {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {atom : Atom} {worlds : List Owned} {avs : List AVal} + (hstable : AValStable (.constA atom)) : + ∀ rest slots, + EmitSound ctx cur (_root_.id : Emit) + (OwnsArgsResultProtected Γ (.shared :: worlds) + (.constA atom :: avs) rest slots) + (OwnsArgsResultProtected Γ worlds avs rest slots) := by + intro rest slots + apply EmitSound.of_below + intro limit + exact discard_const_arg_at (limit := limit) hstable rest slots + +private theorem discard_const_arg_value_at + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {source : IxIR0.Value} + {sources : List IxIR0.Value} {atom : Atom} + {worlds : List Owned} {avs : List AVal} + (hstable : AValStable (.constA atom)) : + ∀ sourceRest rest slots, + EmitSoundBelow ctx cur limit (_root_.id : Emit) + (GraphOwnsArgsResultProtected funRel recSelfRel Γ + sourceEnv (source :: sources) (.shared :: worlds) + (.constA atom :: avs) sourceRest rest slots) + (GraphOwnsArgsResultProtected funRel recSelfRel Γ + sourceEnv sources worlds avs sourceRest rest slots) := by + intro sourceRest rest slots + apply EmitSoundBelow.strengthen + intro store env hpre + obtain ⟨⟨roots, values, hΓ, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + cases havs with + | @cons headWorld tailWorlds headAV tailAVs value tailValues hav htail => + cases hvalueGraphs with + | cons hvalueGraph htailGraphs => + have howned : RootOwnership store + (⟨.shared, value⟩ :: + (rootsForWorlds worlds tailValues ++ roots ++ rest)) := by + simpa [rootsForWorlds] using hown + exact ⟨⟨roots, tailValues, hΓ, htail, htailGraphs, + hrestGraph, + howned.dropNoLocation (hstable.const_noLocation hav)⟩, + hslots⟩ + +/-- Semantic constant discard removes the inert head argument and its source +value while leaving every remaining graph and the store unchanged. -/ +theorem discard_const_arg_value + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {source : IxIR0.Value} + {sources : List IxIR0.Value} {atom : Atom} + {worlds : List Owned} {avs : List AVal} + (hstable : AValStable (.constA atom)) : + ∀ sourceRest rest slots, + EmitSound ctx cur (_root_.id : Emit) + (GraphOwnsArgsResultProtected funRel recSelfRel Γ + sourceEnv (source :: sources) (.shared :: worlds) + (.constA atom :: avs) sourceRest rest slots) + (GraphOwnsArgsResultProtected funRel recSelfRel Γ + sourceEnv sources worlds avs sourceRest rest slots) := by + intro sourceRest rest slots + apply EmitSound.of_below + intro limit + exact discard_const_arg_value_at (limit := limit) hstable + sourceRest rest slots + +theorem discard_const_arg_below {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} {atom : Atom} + {worlds : List Owned} {avs : List AVal} + (hstable : AValStable (.constA atom)) : + ∀ rest slots, + EmitSoundBelow ctx cur limit (_root_.id : Emit) + (OwnsArgsResultProtected Γ (.shared :: worlds) + (.constA atom :: avs) rest slots) + (OwnsArgsResultProtected Γ worlds avs rest slots) := by + exact discard_const_arg_at hstable + +theorem discard_const_arg_value_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {source : IxIR0.Value} + {sources : List IxIR0.Value} {atom : Atom} + {worlds : List Owned} {avs : List AVal} + (hstable : AValStable (.constA atom)) : + ∀ sourceRest rest slots, + EmitSoundBelow ctx cur limit (_root_.id : Emit) + (GraphOwnsArgsResultProtected funRel recSelfRel Γ + sourceEnv (source :: sources) (.shared :: worlds) + (.constA atom :: avs) sourceRest rest slots) + (GraphOwnsArgsResultProtected funRel recSelfRel Γ + sourceEnv sources worlds avs sourceRest rest slots) := by + exact discard_const_arg_value_at hstable + +private theorem discard_const_result_at {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} + {world : Owned} {atom : Atom} (hstable : AValStable (.constA atom)) : + ∀ rest slots, + EmitSoundBelow ctx cur limit (_root_.id : Emit) + (OwnsResultProtected Γ world (.constA atom) rest slots) + (OwnsVEnvProtected Γ rest slots) := by + intro rest slots + apply EmitSoundBelow.strengthen + intro store env hpre + obtain ⟨⟨roots, value, hΓ, hav, hown⟩, hslots⟩ := hpre + exact ⟨⟨roots, hΓ, + hown.dropNoLocation (hstable.const_noLocation hav)⟩, hslots⟩ + +/-- Forget an ownership-inert constant result before continuing with a +consumer that needs only the surrounding source environment. -/ +theorem discard_const_result {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {world : Owned} {atom : Atom} (hstable : AValStable (.constA atom)) : + ∀ rest slots, + EmitSound ctx cur (_root_.id : Emit) + (OwnsResultProtected Γ world (.constA atom) rest slots) + (OwnsVEnvProtected Γ rest slots) := by + intro rest slots + apply EmitSound.of_below + intro limit + exact discard_const_result_at (limit := limit) hstable rest slots + +private theorem discard_const_result_value_at + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {world : Owned} {atom : Atom} + (hstable : AValStable (.constA atom)) : + ∀ sourceRest rest slots, + EmitSoundBelow ctx cur limit (_root_.id : Emit) + (GraphOwnsResultProtected funRel recSelfRel Γ sourceEnv + sourceValue world (.constA atom) sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel Γ sourceEnv + sourceRest rest slots) := by + intro sourceRest rest slots + apply EmitSoundBelow.strengthen + intro store env hpre + obtain ⟨⟨roots, value, hΓ, hav, _, hrestGraph, hown⟩, + hslots⟩ := hpre + exact ⟨⟨roots, hΓ, hrestGraph, + hown.dropNoLocation (hstable.const_noLocation hav)⟩, hslots⟩ + +/-- Semantic constant-result discard removes an ownership-inert result root +before a continuation that needs only the related source environment. -/ +theorem discard_const_result_value + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {world : Owned} {atom : Atom} + (hstable : AValStable (.constA atom)) : + ∀ sourceRest rest slots, + EmitSound ctx cur (_root_.id : Emit) + (GraphOwnsResultProtected funRel recSelfRel Γ sourceEnv + sourceValue world (.constA atom) sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel Γ sourceEnv + sourceRest rest slots) := by + intro sourceRest rest slots + apply EmitSound.of_below + intro limit + exact discard_const_result_value_at (limit := limit) hstable + sourceRest rest slots + +theorem discard_const_result_below {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} {world : Owned} {atom : Atom} + (hstable : AValStable (.constA atom)) : + ∀ rest slots, + EmitSoundBelow ctx cur limit (_root_.id : Emit) + (OwnsResultProtected Γ world (.constA atom) rest slots) + (OwnsVEnvProtected Γ rest slots) := by + exact discard_const_result_at hstable + +theorem discard_const_result_value_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {world : Owned} {atom : Atom} + (hstable : AValStable (.constA atom)) : + ∀ sourceRest rest slots, + EmitSoundBelow ctx cur limit (_root_.id : Emit) + (GraphOwnsResultProtected funRel recSelfRel Γ sourceEnv + sourceValue world (.constA atom) sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel Γ sourceEnv + sourceRest rest slots) := by + exact discard_const_result_value_at hstable + +/-! ## Let-binder installation -/ + +/-- Install a logical binder that aliases an already existing absolute slot; +no runtime value is pushed. -/ +def installAliasBinder (Γ : VEnv) (abs remaining : Nat) + (uses : Uses) (held : Bool) : VEnv := + { Γ with entries := .slot abs remaining uses held :: Γ.entries } + +/-- Install a logical binder for the result of a runtime operation that has +just pushed a fresh slot. -/ +def installPushedBinder (Γ : VEnv) (remaining : Nat) + (uses : Uses) (held : Bool) : VEnv := + { entries := .slot Γ.depth remaining uses held :: Γ.entries, + depth := Γ.depth + 1 } + +/-- Ownership interface shared by alias and materialized let-binder +installation. -/ +def InstallBinderSound (ctx : Ctx) (cur : FnDef) + (input output : VEnv) (boundWorld : Owned) + (boundValue : AVal) (emit : Emit) : Prop := + ∀ rest slots, + EmitSound ctx cur emit + (OwnsResultProtected input boundWorld boundValue rest slots) + (OwnsVEnvProtected output rest slots) + +/-- Semantic binder installation moves the source result into the leading +source-environment entry consumed by the let body. -/ +structure InstallBinderValueSound (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (ctx : Ctx) (cur : FnDef) + (input output : VEnv) (sourceEnv : List IxIR0.Value) + (boundSource : IxIR0.Value) (boundWorld : Owned) + (boundValue : AVal) (emit : Emit) : Prop where + toInstallBinderSound : InstallBinderSound ctx cur input output + boundWorld boundValue emit + graphEmits : ∀ sourceRest rest slots, + EmitSound ctx cur emit + (GraphOwnsResultProtected funRel recSelfRel input sourceEnv + boundSource boundWorld boundValue sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel output + (boundSource :: sourceEnv) sourceRest rest slots) + +/-- Fuel-bounded semantic binder installation. -/ +structure InstallBinderValueSoundBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (ctx : Ctx) (cur : FnDef) + (limit : Nat) (input output : VEnv) + (sourceEnv : List IxIR0.Value) (boundSource : IxIR0.Value) + (boundWorld : Owned) (boundValue : AVal) (emit : Emit) : Prop where + toInstallBinderSoundBelow : ∀ rest slots, + EmitSoundBelow ctx cur limit emit + (OwnsResultProtected input boundWorld boundValue rest slots) + (OwnsVEnvProtected output rest slots) + graphEmits : ∀ sourceRest rest slots, + EmitSoundBelow ctx cur limit emit + (GraphOwnsResultProtected funRel recSelfRel input sourceEnv + boundSource boundWorld boundValue sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel output + (boundSource :: sourceEnv) sourceRest rest slots) + +/-- Move a slot-backed expression result into a live let binder without an +operation. The distinguished result root becomes the binder's environment +root at the same physical slot. -/ +theorem installAliasBinder_held_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {abs remaining : Nat} {uses : Uses} : + ∀ rest slots, + EmitSoundBelow ctx cur limit (_root_.id : Emit) + (OwnsResultProtected Γ (worldOfUses uses) (.slotA abs) rest slots) + (OwnsVEnvProtected + (installAliasBinder Γ abs remaining uses true) rest slots) := by + intro rest slots + apply EmitSoundBelow.strengthen + intro store env hpre + obtain ⟨⟨roots, value, hΓ, hav, hown⟩, hslots⟩ := hpre + cases hav with + | slot hbound hslot => + let output := installAliasBinder Γ abs remaining uses true + have htail : EntriesRealize output env Γ.entries roots := + hΓ.entries.of_depth_eq (by simp [output, installAliasBinder]) + have houtput : VEnvRealizes output env + (⟨worldOfUses uses, value⟩ :: roots) := by + refine ⟨by simpa [output, installAliasBinder] using hΓ.depth_eq, ?_⟩ + exact EntriesRealize.held + (by simpa [output, installAliasBinder] using hbound) + (by simpa [output, installAliasBinder, VEnv.rel] using hslot) + htail + refine ⟨⟨⟨worldOfUses uses, value⟩ :: roots, houtput, ?_⟩, ?_⟩ + · simpa using hown + · exact SlotsRealize.of_depth_eq + (by simp [output, installAliasBinder]) hslots + +theorem installAliasBinder_held + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {abs remaining : Nat} {uses : Uses} : + ∀ rest slots, + EmitSound ctx cur (_root_.id : Emit) + (OwnsResultProtected Γ (worldOfUses uses) (.slotA abs) rest slots) + (OwnsVEnvProtected + (installAliasBinder Γ abs remaining uses true) rest slots) := by + intro rest slots + exact EmitSound.of_below fun limit => + installAliasBinder_held_below + (ctx := ctx) (cur := cur) (limit := limit) + (Γ := Γ) (abs := abs) (remaining := remaining) (uses := uses) + rest slots + +/-- Semantic alias installation moves the bound result graph into a new +leading held environment entry without changing the runtime stack. -/ +theorem installAliasBinder_held_value + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {boundSource : IxIR0.Value} + {abs remaining : Nat} {uses : Uses} : + ∀ sourceRest rest slots, + EmitSound ctx cur (_root_.id : Emit) + (GraphOwnsResultProtected funRel recSelfRel Γ sourceEnv + boundSource (worldOfUses uses) (.slotA abs) + sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel + (installAliasBinder Γ abs remaining uses true) + (boundSource :: sourceEnv) sourceRest rest slots) := by + intro sourceRest rest slots + apply EmitSound.strengthen + intro store env hpre + obtain ⟨⟨roots, value, hΓ, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + cases hav with + | slot hbound hslot => + let output := installAliasBinder Γ abs remaining uses true + have htail : EntriesValueGraph funRel recSelfRel store output env + Γ.entries sourceEnv roots := + hΓ.entries.of_depth_eq (by simp [output, installAliasBinder]) + have hvalueWorld : HasWorld store (worldOfUses uses) value := + hown.roots_world ⟨worldOfUses uses, value⟩ (by simp) + have houtput : VEnvValueGraph funRel recSelfRel store output + (boundSource :: sourceEnv) env + (⟨worldOfUses uses, value⟩ :: roots) := by + refine ⟨by simpa [output, installAliasBinder] using hΓ.depth_eq, ?_⟩ + exact EntriesValueGraph.held + (by simpa [output, installAliasBinder] using hbound) + (by simpa [output, installAliasBinder, VEnv.rel] using hslot) + hvalueWorld hvalueGraph htail + refine ⟨⟨⟨worldOfUses uses, value⟩ :: roots, + houtput, hrestGraph, ?_⟩, ?_⟩ + · simpa using hown + · exact SlotsRealize.of_depth_eq + (by simp [output, installAliasBinder]) hslots + +/-- Fuel-bounded semantic alias installation. -/ +theorem installAliasBinder_held_value_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {boundSource : IxIR0.Value} + {abs remaining : Nat} {uses : Uses} : + ∀ sourceRest rest slots, + EmitSoundBelow ctx cur limit (_root_.id : Emit) + (GraphOwnsResultProtected funRel recSelfRel Γ sourceEnv + boundSource (worldOfUses uses) (.slotA abs) + sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel + (installAliasBinder Γ abs remaining uses true) + (boundSource :: sourceEnv) sourceRest rest slots) := by + intro sourceRest rest slots + apply EmitSoundBelow.strengthen + intro store env hpre + obtain ⟨⟨roots, value, hΓ, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + cases hav with + | slot hbound hslot => + let output := installAliasBinder Γ abs remaining uses true + have htail : EntriesValueGraph funRel recSelfRel store output env + Γ.entries sourceEnv roots := + hΓ.entries.of_depth_eq (by simp [output, installAliasBinder]) + have hvalueWorld : HasWorld store (worldOfUses uses) value := + hown.roots_world ⟨worldOfUses uses, value⟩ (by simp) + have houtput : VEnvValueGraph funRel recSelfRel store output + (boundSource :: sourceEnv) env + (⟨worldOfUses uses, value⟩ :: roots) := by + refine ⟨by simpa [output, installAliasBinder] using hΓ.depth_eq, ?_⟩ + exact EntriesValueGraph.held + (by simpa [output, installAliasBinder] using hbound) + (by simpa [output, installAliasBinder, VEnv.rel] using hslot) + hvalueWorld hvalueGraph htail + refine ⟨⟨⟨worldOfUses uses, value⟩ :: roots, + houtput, hrestGraph, ?_⟩, ?_⟩ + · simpa using hown + · exact SlotsRealize.of_depth_eq + (by simp [output, installAliasBinder]) hslots + +theorem installAliasBinder_held_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {boundSource : IxIR0.Value} + {abs remaining : Nat} {uses : Uses} : + InstallBinderValueSound funRel recSelfRel ctx cur Γ + (installAliasBinder Γ abs remaining uses true) + sourceEnv boundSource (worldOfUses uses) (.slotA abs) + (_root_.id : Emit) := + { toInstallBinderSound := installAliasBinder_held + graphEmits := installAliasBinder_held_value } + +theorem installAliasBinder_held_value_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {boundSource : IxIR0.Value} + {abs remaining : Nat} {uses : Uses} : + InstallBinderValueSoundBelow funRel recSelfRel ctx cur limit Γ + (installAliasBinder Γ abs remaining uses true) + sourceEnv boundSource (worldOfUses uses) (.slotA abs) + (_root_.id : Emit) := + { toInstallBinderSoundBelow := installAliasBinder_held_below + graphEmits := installAliasBinder_held_value_below } + +/-- Materialize a stable constant into the fresh physical slot used by a let +binder. A live binder owns the scalar root; a dead binder records only the +released entry, since scalar roots are ownership-inert. -/ +theorem materializeConstBinder_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {atom : Atom} {remaining : Nat} {uses : Uses} {held : Bool} + (hstable : AValStable (.constA atom)) : + ∀ rest slots, + EmitSoundBelow ctx cur limit (emitOp (.pure atom)) + (OwnsResultProtected Γ (worldOfUses uses) (.constA atom) rest slots) + (OwnsVEnvProtected + (installPushedBinder Γ remaining uses held) rest slots) := by + intro rest slots + apply OpSoundBelow.emit + intro fuel store env store' result _ hpre hrun + obtain ⟨⟨roots, value, hΓ, hav, hown⟩, hslots⟩ := hpre + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + have hpure := runOp_pure (ctx := ctx) (cur := cur) (fuel := fuel) + (store := store) hav.resolveAtom + have hpair : (store, value) = (store', result) := + Except.ok.inj (hpure.symm.trans hrun) + cases hpair + let output := installPushedBinder Γ remaining uses held + have htail : EntriesRealize output (result :: env) Γ.entries roots := + (hΓ.entries.bump result).of_depth_eq + (by simp [output, installPushedBinder, VEnv.bump]) + have hdepth : (result :: env).length = output.depth := by + simpa [output, installPushedBinder] using congrArg Nat.succ hΓ.depth_eq + cases held with + | false => + have houtput : VEnvRealizes output (result :: env) roots := by + refine ⟨hdepth, ?_⟩ + exact EntriesRealize.released + (by simp [output, installPushedBinder]) htail + refine ⟨⟨roots, houtput, ?_⟩, ?_⟩ + · exact hown.dropNoLocation (hstable.const_noLocation hav) + · exact SlotsRealize.of_depth_eq + (by simp [output, installPushedBinder, VEnv.bump]) + (hslots.bump result) + + | true => + have houtput : VEnvRealizes output (result :: env) + (⟨worldOfUses uses, result⟩ :: roots) := by + refine ⟨hdepth, ?_⟩ + exact EntriesRealize.held + (by simp [output, installPushedBinder]) + (by simp [output, installPushedBinder, VEnv.rel]) htail + refine ⟨⟨⟨worldOfUses uses, result⟩ :: roots, houtput, ?_⟩, ?_⟩ + · simpa using hown + · exact SlotsRealize.of_depth_eq + (by simp [output, installPushedBinder, VEnv.bump]) + (hslots.bump result) + +theorem materializeConstBinder + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {atom : Atom} {remaining : Nat} {uses : Uses} {held : Bool} + (hstable : AValStable (.constA atom)) : + ∀ rest slots, + EmitSound ctx cur (emitOp (.pure atom)) + (OwnsResultProtected Γ (worldOfUses uses) (.constA atom) rest slots) + (OwnsVEnvProtected + (installPushedBinder Γ remaining uses held) rest slots) := by + intro rest slots + exact EmitSound.of_below fun limit => + materializeConstBinder_below + (ctx := ctx) (cur := cur) (limit := limit) + (Γ := Γ) (atom := atom) (remaining := remaining) + (uses := uses) (held := held) hstable rest slots + +/-- Semantic constant materialization installs the bound source value as a +leading held or released entry, matching the compile-time `held` flag. -/ +theorem materializeConstBinder_value + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {boundSource : IxIR0.Value} + {atom : Atom} {remaining : Nat} {uses : Uses} {held : Bool} + (hstable : AValStable (.constA atom)) : + ∀ sourceRest rest slots, + EmitSound ctx cur (emitOp (.pure atom)) + (GraphOwnsResultProtected funRel recSelfRel Γ sourceEnv + boundSource (worldOfUses uses) (.constA atom) + sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel + (installPushedBinder Γ remaining uses held) + (boundSource :: sourceEnv) sourceRest rest slots) := by + intro sourceRest rest slots + apply OpSound.emit + intro fuel store env store' result hpre hrun + obtain ⟨⟨roots, value, hΓ, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + have hpure := runOp_pure (ctx := ctx) (cur := cur) (fuel := fuel) + (store := store) hav.resolveAtom + have hpair : (store, value) = (store', result) := + Except.ok.inj (hpure.symm.trans hrun) + cases hpair + let output := installPushedBinder Γ remaining uses held + have htail : EntriesValueGraph funRel recSelfRel store output + (result :: env) Γ.entries sourceEnv roots := + (hΓ.entries.bump result).of_depth_eq + (by simp [output, installPushedBinder, VEnv.bump]) + have hdepth : (result :: env).length = output.depth := by + simpa [output, installPushedBinder] using + congrArg Nat.succ hΓ.depth_eq + cases held with + | false => + have houtput : VEnvValueGraph funRel recSelfRel store output + (boundSource :: sourceEnv) (result :: env) roots := by + refine ⟨hdepth, ?_⟩ + exact EntriesValueGraph.released + (by simp [output, installPushedBinder]) htail + refine ⟨⟨roots, houtput, hrestGraph, ?_⟩, ?_⟩ + · exact hown.dropNoLocation (hstable.const_noLocation hav) + · exact SlotsRealize.of_depth_eq + (by simp [output, installPushedBinder, VEnv.bump]) + (hslots.bump result) + | true => + have hvalueWorld : HasWorld store (worldOfUses uses) result := + hown.roots_world ⟨worldOfUses uses, result⟩ (by simp) + have houtput : VEnvValueGraph funRel recSelfRel store output + (boundSource :: sourceEnv) (result :: env) + (⟨worldOfUses uses, result⟩ :: roots) := by + refine ⟨hdepth, ?_⟩ + exact EntriesValueGraph.held + (by simp [output, installPushedBinder]) + (by simp [output, installPushedBinder, VEnv.rel]) + hvalueWorld hvalueGraph htail + refine ⟨⟨⟨worldOfUses uses, result⟩ :: roots, + houtput, hrestGraph, ?_⟩, ?_⟩ + · simpa using hown + · exact SlotsRealize.of_depth_eq + (by simp [output, installPushedBinder, VEnv.bump]) + (hslots.bump result) + +/-- Fuel-bounded semantic constant materialization. -/ +theorem materializeConstBinder_value_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {boundSource : IxIR0.Value} + {atom : Atom} {remaining : Nat} {uses : Uses} {held : Bool} + (hstable : AValStable (.constA atom)) : + ∀ sourceRest rest slots, + EmitSoundBelow ctx cur limit (emitOp (.pure atom)) + (GraphOwnsResultProtected funRel recSelfRel Γ sourceEnv + boundSource (worldOfUses uses) (.constA atom) + sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel + (installPushedBinder Γ remaining uses held) + (boundSource :: sourceEnv) sourceRest rest slots) := by + intro sourceRest rest slots + apply OpSoundBelow.emit + intro fuel store env store' result _ hpre hrun + obtain ⟨⟨roots, value, hΓ, hav, hvalueGraph, + hrestGraph, hown⟩, hslots⟩ := hpre + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + have hpure := runOp_pure (ctx := ctx) (cur := cur) (fuel := fuel) + (store := store) hav.resolveAtom + have hpair : (store, value) = (store', result) := + Except.ok.inj (hpure.symm.trans hrun) + cases hpair + let output := installPushedBinder Γ remaining uses held + have htail : EntriesValueGraph funRel recSelfRel store output + (result :: env) Γ.entries sourceEnv roots := + (hΓ.entries.bump result).of_depth_eq + (by simp [output, installPushedBinder, VEnv.bump]) + have hdepth : (result :: env).length = output.depth := by + simpa [output, installPushedBinder] using + congrArg Nat.succ hΓ.depth_eq + cases held with + | false => + have houtput : VEnvValueGraph funRel recSelfRel store output + (boundSource :: sourceEnv) (result :: env) roots := by + refine ⟨hdepth, ?_⟩ + exact EntriesValueGraph.released + (by simp [output, installPushedBinder]) htail + refine ⟨⟨roots, houtput, hrestGraph, ?_⟩, ?_⟩ + · exact hown.dropNoLocation (hstable.const_noLocation hav) + · exact SlotsRealize.of_depth_eq + (by simp [output, installPushedBinder, VEnv.bump]) + (hslots.bump result) + | true => + have hvalueWorld : HasWorld store (worldOfUses uses) result := + hown.roots_world ⟨worldOfUses uses, result⟩ (by simp) + have houtput : VEnvValueGraph funRel recSelfRel store output + (boundSource :: sourceEnv) (result :: env) + (⟨worldOfUses uses, result⟩ :: roots) := by + refine ⟨hdepth, ?_⟩ + exact EntriesValueGraph.held + (by simp [output, installPushedBinder]) + (by simp [output, installPushedBinder, VEnv.rel]) + hvalueWorld hvalueGraph htail + refine ⟨⟨⟨worldOfUses uses, result⟩ :: roots, + houtput, hrestGraph, ?_⟩, ?_⟩ + · simpa using hown + · exact SlotsRealize.of_depth_eq + (by simp [output, installPushedBinder, VEnv.bump]) + (hslots.bump result) +theorem materializeConstBinder_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {boundSource : IxIR0.Value} + {atom : Atom} {remaining : Nat} {uses : Uses} {held : Bool} + (hstable : AValStable (.constA atom)) : + InstallBinderValueSound funRel recSelfRel ctx cur Γ + (installPushedBinder Γ remaining uses held) sourceEnv boundSource + (worldOfUses uses) (.constA atom) (emitOp (.pure atom)) := + { toInstallBinderSound := materializeConstBinder hstable + graphEmits := materializeConstBinder_value hstable } + +theorem materializeConstBinder_value_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {boundSource : IxIR0.Value} + {atom : Atom} {remaining : Nat} {uses : Uses} {held : Bool} + (hstable : AValStable (.constA atom)) : + InstallBinderValueSoundBelow funRel recSelfRel ctx cur limit Γ + (installPushedBinder Γ remaining uses held) sourceEnv boundSource + (worldOfUses uses) (.constA atom) (emitOp (.pure atom)) := + { toInstallBinderSoundBelow := materializeConstBinder_below hstable + graphEmits := materializeConstBinder_value_below hstable } + +/-- Unbounded let sequencing through binder installation and the final +logical pop. -/ +theorem LowerResultSound.installThen + {ctx : Ctx} {cur : FnDef} + {input middle installed output : VEnv} + {boundWorld resultWorld : Owned} + {boundEmit installEmit bodyEmit : Emit} + {boundValue result : AVal} + (hbound : LowerResultSound ctx cur input middle boundWorld + boundEmit boundValue) + (hinstall : InstallBinderSound ctx cur middle installed + boundWorld boundValue installEmit) + (hbody : LowerResultSound ctx cur installed output resultWorld + bodyEmit result) + (hreleased : FirstEntryReleased output) : + LowerResultSound ctx cur input output.pop resultWorld + ((boundEmit ∘ installEmit) ∘ bodyEmit) result := by + have hpopped := hbody.popFirstReleased hreleased + refine ⟨hpopped.stable, ?_⟩ + intro rest slots + have hcomposed := EmitSound.comp (hbound.emits rest slots) + (EmitSound.comp (hinstall rest slots) (hpopped.emits rest slots)) + simpa [Function.comp_def] using hcomposed + +/-- Semantic let sequencing. The bound result becomes the leading source +environment value for the body; after the body releases that entry, `pop` +returns to the body's tail source environment. -/ +theorem LowerResultValueSound.installThen + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {input middle installed output : VEnv} + {sourceInput sourceMiddle sourceOutput : List IxIR0.Value} + {boundSource sourceResult : IxIR0.Value} + {boundWorld resultWorld : Owned} + {boundEmit installEmit bodyEmit : Emit} + {boundValue result : AVal} + (hbound : LowerResultValueSound funRel recSelfRel ctx cur + input middle sourceInput sourceMiddle boundSource boundWorld + boundEmit boundValue) + (hinstall : InstallBinderValueSound funRel recSelfRel ctx cur + middle installed sourceMiddle boundSource boundWorld boundValue + installEmit) + (hbody : LowerResultValueSound funRel recSelfRel ctx cur + installed output (boundSource :: sourceMiddle) + (boundSource :: sourceOutput) sourceResult resultWorld + bodyEmit result) + (hreleased : FirstEntryReleased output) : + LowerResultValueSound funRel recSelfRel ctx cur input output.pop + sourceInput sourceOutput sourceResult resultWorld + ((boundEmit ∘ installEmit) ∘ bodyEmit) result := by + have hpopped := hbody.popFirstReleased hreleased + refine + { toLowerResultSound := hbound.toLowerResultSound.installThen + hinstall.toInstallBinderSound hbody.toLowerResultSound hreleased + graphEmits := ?_ } + intro sourceRest rest slots + have hcomposed := EmitSound.comp + (hbound.graphEmits sourceRest rest slots) + (EmitSound.comp (hinstall.graphEmits sourceRest rest slots) + (hpopped.graphEmits sourceRest rest slots)) + simpa [Function.comp_def] using hcomposed + +/-- Sequence an already proved bound value, its binder-installation emitter, +and a body that has consumed the installed first entry. The final logical +`pop` is justified by `FirstEntryReleased`; no runtime slot is removed. -/ +theorem LowerResultSoundBelow.installThen + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input middle installed output : VEnv} + {boundWorld resultWorld : Owned} + {boundEmit installEmit bodyEmit : Emit} + {boundValue result : AVal} + (hbound : LowerResultSoundBelow ctx cur limit input middle boundWorld + boundEmit boundValue) + (hinstall : ∀ rest slots, + EmitSoundBelow ctx cur limit installEmit + (OwnsResultProtected middle boundWorld boundValue rest slots) + (OwnsVEnvProtected installed rest slots)) + (hbody : LowerResultSoundBelow ctx cur limit installed output resultWorld + bodyEmit result) + (hreleased : FirstEntryReleased output) : + LowerResultSoundBelow ctx cur limit input output.pop resultWorld + ((boundEmit ∘ installEmit) ∘ bodyEmit) result := by + have hpopped := hbody.popFirstReleased hreleased + refine ⟨hpopped.stable, ?_⟩ + intro rest slots + have hcomposed := EmitSoundBelow.comp (hbound.emits rest slots) + (EmitSoundBelow.comp (hinstall rest slots) (hpopped.emits rest slots)) + simpa [Function.comp_def] using hcomposed + +/-- Fuel-bounded semantic let sequencing. -/ +theorem LowerResultValueSoundBelow.installThen + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input middle installed output : VEnv} + {sourceInput sourceMiddle sourceOutput : List IxIR0.Value} + {boundSource sourceResult : IxIR0.Value} + {boundWorld resultWorld : Owned} + {boundEmit installEmit bodyEmit : Emit} + {boundValue result : AVal} + (hbound : LowerResultValueSoundBelow funRel recSelfRel ctx cur limit + input middle sourceInput sourceMiddle boundSource boundWorld + boundEmit boundValue) + (hinstall : InstallBinderValueSoundBelow funRel recSelfRel ctx cur + limit middle installed sourceMiddle boundSource boundWorld boundValue + installEmit) + (hbody : LowerResultValueSoundBelow funRel recSelfRel ctx cur limit + installed output (boundSource :: sourceMiddle) + (boundSource :: sourceOutput) sourceResult resultWorld + bodyEmit result) + (hreleased : FirstEntryReleased output) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input + output.pop sourceInput sourceOutput sourceResult resultWorld + ((boundEmit ∘ installEmit) ∘ bodyEmit) result := by + have hpopped := hbody.popFirstReleased hreleased + refine + { toLowerResultSoundBelow := + hbound.toLowerResultSoundBelow.installThen + hinstall.toInstallBinderSoundBelow + hbody.toLowerResultSoundBelow hreleased + graphEmits := ?_ } + intro sourceRest rest slots + have hcomposed := EmitSoundBelow.comp + (hbound.graphEmits sourceRest rest slots) + (EmitSoundBelow.comp (hinstall.graphEmits sourceRest rest slots) + (hpopped.graphEmits sourceRest rest slots)) + simpa [Function.comp_def] using hcomposed + +private theorem discard_slot_arg_at {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} {abs : Nat} + {worlds : List Owned} {avs : List AVal} + (htailStable : AValsStable avs) : + ∀ rest slots, + EmitSoundBelow ctx cur limit + (emitOp (.drop (.var (Γ.rel abs)))) + (OwnsArgsResultProtected Γ (.shared :: worlds) + (.slotA abs :: avs) rest slots) + (OwnsArgsResultProtected Γ.bump worlds avs rest slots) := by + intro rest slots bound hbound post code hcode + intro fuel store env finalStore finalValue hfuel hpre hrun + obtain ⟨⟨roots, values, hΓ, havs, hown⟩, hslots⟩ := hpre + cases havs with + | @cons headWorld tailWorlds headAV tailAVs value tailValues hav htail => + let frame : List RVal → Prop := fun oldEnv => + VEnvRealizes Γ oldEnv roots ∧ + AValsRealize Γ oldEnv worlds avs tailValues ∧ + SlotsRealize Γ oldEnv slots + let remainingRoots := rootsForWorlds worlds tailValues ++ roots ++ rest + have howned : RootOwnership store + (⟨.shared, value⟩ :: remainingRoots) := by + simpa [remainingRoots, rootsForWorlds] using hown + have hnext : CodeOwnsBelow ctx cur bound + (OwnsAfterPush frame remainingRoots) post code := by + intro nextFuel nextStore nextEnv resultStore resultValue hnextFuel + hpushed hcodeRun + obtain ⟨pushed, oldEnv, rfl, ⟨hΓOld, htailOld, hslotsOld⟩, + hownRest⟩ := hpushed + apply hcode hnextFuel + · exact ⟨⟨roots, tailValues, hΓOld.bump pushed, + htailStable.realize_bump htailOld pushed, hownRest⟩, + hslotsOld.bump pushed⟩ + · exact hcodeRun + have hdrop : CodeOwnsBelow ctx cur bound + (fun dropStore dropEnv => + frame dropEnv ∧ + resolveAtom dropEnv (.var (Γ.rel abs)) = .ok value ∧ + RootOwnership dropStore (⟨.shared, value⟩ :: remainingRoots)) + post (emitOp (.drop (.var (Γ.rel abs))) code) := + emit_drop_value_owned_below bound hbound post code hnext + apply hdrop hfuel + · exact ⟨⟨hΓ, htail, hslots⟩, hav.resolveAtom, howned⟩ + · exact hrun + +/-- Releasing a slot-backed shared argument emits one `drop`. Its inert +result slot bumps the `VEnv`, all remaining stable argument descriptors, and +the protected-slot frame while consuming exactly the head argument root. -/ +theorem discard_slot_arg {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {abs : Nat} {worlds : List Owned} {avs : List AVal} + (htailStable : AValsStable avs) : + ∀ rest slots, + EmitSound ctx cur (emitOp (.drop (.var (Γ.rel abs)))) + (OwnsArgsResultProtected Γ (.shared :: worlds) + (.slotA abs :: avs) rest slots) + (OwnsArgsResultProtected Γ.bump worlds avs rest slots) := by + intro rest slots + apply EmitSound.of_below + intro limit + exact discard_slot_arg_at (limit := limit) htailStable rest slots + +private theorem discard_slot_arg_value_op_at + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {source : IxIR0.Value} + {sources : List IxIR0.Value} {abs : Nat} + {worlds : List Owned} {avs : List AVal} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + {slots : List (Nat × RVal)} + (htailStable : AValsStable avs) : + OpSoundBelow ctx cur limit (.drop (.var (Γ.rel abs))) + (GraphOwnsArgsResultProtected funRel recSelfRel Γ + sourceEnv (source :: sources) (.shared :: worlds) + (.slotA abs :: avs) sourceRest rest slots) + (GraphOwnsArgsResultProtected funRel recSelfRel Γ.bump + sourceEnv sources worlds avs sourceRest rest slots) := by + intro fuel store env store' result _ hpre hrun + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + obtain ⟨⟨roots, values, hΓ, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + cases havs with + | @cons headWorld tailWorlds headAV tailAVs value tailValues hav htail => + cases hvalueGraphs with + | cons hvalueGraph htailGraphs => + let remainingRoots := + rootsForWorlds worlds tailValues ++ roots ++ rest + have howned : RootOwnership store + (⟨.shared, value⟩ :: remainingRoots) := by + simpa [remainingRoots, rootsForWorlds] using hown + obtain ⟨rfl, hrestrict, hownAfter⟩ := + runOp_drop_value_owned_restricts hav.resolveAtom howned hrun + have hΓAfter : VEnvValueGraph funRel recSelfRel store' + Γ sourceEnv env roots := + hΓ.ofRestricts hrestrict hownAfter + (fun root hmember => by + simp [remainingRoots, hmember]) + have hlength : worlds.length = tailValues.length := + htail.lengths.1.trans htail.lengths.2 + have htailGraphsAfter : + Sim.ValuesGraph funRel store' sources tailValues := + htailGraphs.ofRestrictsIn hrestrict hownAfter + (fun runtime hmember => by + obtain ⟨runtimeWorld, hroot⟩ := + exists_root_mem_rootsForWorlds hlength hmember + exact ⟨runtimeWorld, by + simp [remainingRoots, hroot]⟩) + have hrestAfter : Sim.RootsGraph funRel store' + sourceRest rest := + hrestGraph.ofRestrictsIn hrestrict hownAfter + (fun root hmember => by + simp [remainingRoots, hmember]) + exact ⟨⟨roots, tailValues, hΓAfter.bump .erased, + htailStable.realize_bump htail .erased, + htailGraphsAfter, hrestAfter, hownAfter⟩, + hslots.bump .erased⟩ + +/-- Operation-level semantic slot discard. Exposing the exact midpoint lets +the cost simulation attach the zero local ownership charge to the same +destructive drop run. -/ +theorem discard_slot_arg_value_op + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {source : IxIR0.Value} + {sources : List IxIR0.Value} {abs : Nat} + {worlds : List Owned} {avs : List AVal} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + {slots : List (Nat × RVal)} + (htailStable : AValsStable avs) : + OpSound ctx cur (.drop (.var (Γ.rel abs))) + (GraphOwnsArgsResultProtected funRel recSelfRel Γ + sourceEnv (source :: sources) (.shared :: worlds) + (.slotA abs :: avs) sourceRest rest slots) + (GraphOwnsArgsResultProtected funRel recSelfRel Γ.bump + sourceEnv sources worlds avs sourceRest rest slots) := by + apply OpSound.of_below + intro limit + exact discard_slot_arg_value_op_at (limit := limit) htailStable + +/-- Semantic slot discard transports the environment, remaining argument +vector, and caller frame through the destructive shared drop. -/ +theorem discard_slot_arg_value + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {source : IxIR0.Value} + {sources : List IxIR0.Value} {abs : Nat} + {worlds : List Owned} {avs : List AVal} + (htailStable : AValsStable avs) : + ∀ sourceRest rest slots, + EmitSound ctx cur (emitOp (.drop (.var (Γ.rel abs)))) + (GraphOwnsArgsResultProtected funRel recSelfRel Γ + sourceEnv (source :: sources) (.shared :: worlds) + (.slotA abs :: avs) sourceRest rest slots) + (GraphOwnsArgsResultProtected funRel recSelfRel Γ.bump + sourceEnv sources worlds avs sourceRest rest slots) := by + intro sourceRest rest slots + exact OpSound.emit (discard_slot_arg_value_op htailStable) + +theorem discard_slot_arg_below {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} {abs : Nat} + {worlds : List Owned} {avs : List AVal} + (htailStable : AValsStable avs) : + ∀ rest slots, + EmitSoundBelow ctx cur limit + (emitOp (.drop (.var (Γ.rel abs)))) + (OwnsArgsResultProtected Γ (.shared :: worlds) + (.slotA abs :: avs) rest slots) + (OwnsArgsResultProtected Γ.bump worlds avs rest slots) := by + exact discard_slot_arg_at htailStable + +theorem discard_slot_arg_value_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {source : IxIR0.Value} + {sources : List IxIR0.Value} {abs : Nat} + {worlds : List Owned} {avs : List AVal} + (htailStable : AValsStable avs) : + ∀ sourceRest rest slots, + EmitSoundBelow ctx cur limit + (emitOp (.drop (.var (Γ.rel abs)))) + (GraphOwnsArgsResultProtected funRel recSelfRel Γ + sourceEnv (source :: sources) (.shared :: worlds) + (.slotA abs :: avs) sourceRest rest slots) + (GraphOwnsArgsResultProtected funRel recSelfRel Γ.bump + sourceEnv sources worlds avs sourceRest rest slots) := by + intro sourceRest rest slots + exact OpSoundBelow.emit + (discard_slot_arg_value_op_at htailStable) + +/-- Semantic result of `releaseAll`: every shared argument owner is consumed, +the source-environment roots and protected slots survive, and the returned +`VEnv` records exactly the inert slots pushed by slot-backed drops. -/ +def ReleaseAllSound (ctx : Ctx) (cur : FnDef) (input output : VEnv) + (emit : Emit) (avs : List AVal) : Prop := + ∀ rest slots, + EmitSound ctx cur emit + (OwnsArgsResultProtected input + (List.replicate avs.length .shared) avs rest slots) + (OwnsVEnvProtected output rest slots) + +/-- Semantic refinement of `releaseAll`. Its argument source values are +consumed together with their temporary roots, while the source environment +and arbitrary caller frame remain graph-related. -/ +structure ReleaseAllValueSound (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (ctx : Ctx) (cur : FnDef) + (input output : VEnv) (sourceEnv sourceValues : List IxIR0.Value) + (emit : Emit) (avs : List AVal) : Prop where + toReleaseAllSound : ReleaseAllSound ctx cur input output emit avs + graphEmits : ∀ sourceRest rest slots, + EmitSound ctx cur emit + (GraphOwnsArgsResultProtected funRel recSelfRel input + sourceEnv sourceValues (List.replicate avs.length .shared) + avs sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel output + sourceEnv sourceRest rest slots) + +def ReleaseAllSoundBelow (ctx : Ctx) (cur : FnDef) (limit : Nat) + (input output : VEnv) (emit : Emit) (avs : List AVal) : Prop := + ∀ rest slots, + EmitSoundBelow ctx cur limit emit + (OwnsArgsResultProtected input + (List.replicate avs.length .shared) avs rest slots) + (OwnsVEnvProtected output rest slots) + +structure ReleaseAllValueSoundBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (ctx : Ctx) (cur : FnDef) (limit : Nat) + (input output : VEnv) (sourceEnv sourceValues : List IxIR0.Value) + (emit : Emit) (avs : List AVal) : Prop where + toReleaseAllSoundBelow : ReleaseAllSoundBelow ctx cur limit input output + emit avs + graphEmits : ∀ sourceRest rest slots, + EmitSoundBelow ctx cur limit emit + (GraphOwnsArgsResultProtected funRel recSelfRel input + sourceEnv sourceValues (List.replicate avs.length .shared) + avs sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel output + sourceEnv sourceRest rest slots) + +/-- Single bounded induction body for releasing a list of argument owners. -/ +private theorem releaseAll_sound_at {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} {avs : List AVal} + (hstable : AValsStable avs) : + ReleaseAllSoundBelow ctx cur limit Γ (releaseAll Γ avs).1 + (releaseAll Γ avs).2 avs := by + exact AValsStable.traverse + (Result := fun current currentAvs => + ReleaseAllSoundBelow ctx cur limit current + (releaseAll current currentAvs).1 + (releaseAll current currentAvs).2 currentAvs) + (hnil := by + intro current rest slots + apply EmitSoundBelow.strengthen + intro store env hpre + obtain ⟨⟨roots, values, hcurrent, havs, hown⟩, hslots⟩ := hpre + cases havs + exact ⟨⟨roots, hcurrent, + by simpa [rootsForWorlds] using hown⟩, hslots⟩) + (hslot := by + intro current abs currentAvs htail ih rest slots + have hcomposed := EmitSoundBelow.comp + (discard_slot_arg_below (ctx := ctx) (cur := cur) + (limit := limit) (Γ := current) + (abs := abs) + (worlds := List.replicate currentAvs.length .shared) + (avs := currentAvs) htail rest slots) + (ih rest slots) + simpa [releaseAll, List.replicate_succ] using hcomposed) + (hlit := by + intro current literal currentAvs htail ih rest slots + have hcomposed := EmitSoundBelow.comp + (discard_const_arg_below (ctx := ctx) (cur := cur) + (limit := limit) (Γ := current) + (atom := .lit literal) + (worlds := List.replicate currentAvs.length .shared) + (avs := currentAvs) AValStable.lit rest slots) + (ih rest slots) + simpa [releaseAll, List.replicate_succ, Function.comp_def] using + hcomposed) + (herased := by + intro current currentAvs htail ih rest slots + have hcomposed := EmitSoundBelow.comp + (discard_const_arg_below (ctx := ctx) (cur := cur) + (limit := limit) (Γ := current) + (atom := .erased) + (worlds := List.replicate currentAvs.length .shared) + (avs := currentAvs) AValStable.erased rest slots) + (ih rest slots) + simpa [releaseAll, List.replicate_succ, Function.comp_def] using + hcomposed) + (hstable := hstable) + +/-- Bounded graph adapter over the shared aligned stable-value traversal. -/ +private theorem releaseAll_value_sound_at + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv sourceValues : List IxIR0.Value} {avs : List AVal} + (hstable : AValsStable avs) + (hsourceLength : sourceValues.length = avs.length) : + ReleaseAllValueSoundBelow funRel recSelfRel ctx cur limit Γ + (releaseAll Γ avs).1 sourceEnv sourceValues + (releaseAll Γ avs).2 avs := by + refine + { toReleaseAllSoundBelow := releaseAll_sound_at hstable + graphEmits := ?_ } + apply AValsStable.traverseAligned + (Result := fun Γ sourceValues avs => + ∀ sourceRest rest slots, + EmitSoundBelow ctx cur limit (releaseAll Γ avs).2 + (GraphOwnsArgsResultProtected funRel recSelfRel Γ + sourceEnv sourceValues (List.replicate avs.length .shared) + avs sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel + (releaseAll Γ avs).1 sourceEnv sourceRest rest slots)) + (hstable := hstable) (hlength := hsourceLength) + · intro Γ sourceRest rest slots + apply EmitSoundBelow.strengthen + intro store env hpre + obtain ⟨⟨roots, values, hΓ, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + cases havs + cases hvalueGraphs + exact ⟨⟨roots, hΓ, hrestGraph, + by simpa [rootsForWorlds] using hown⟩, hslots⟩ + · intro Γ source sources abs avs htail ih sourceRest rest slots + have hcomposed := EmitSoundBelow.comp + (discard_slot_arg_value_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) (Γ := Γ) + (sourceEnv := sourceEnv) (source := source) + (sources := sources) (abs := abs) + (worlds := List.replicate avs.length .shared) + (avs := avs) htail sourceRest rest slots) + (ih sourceRest rest slots) + simpa [releaseAll, List.replicate_succ] using hcomposed + · intro Γ source sources literal avs htail ih sourceRest rest slots + have hcomposed := EmitSoundBelow.comp + (discard_const_arg_value_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) (Γ := Γ) + (sourceEnv := sourceEnv) (source := source) + (sources := sources) (atom := .lit literal) + (worlds := List.replicate avs.length .shared) + (avs := avs) AValStable.lit sourceRest rest slots) + (ih sourceRest rest slots) + simpa [releaseAll, List.replicate_succ, Function.comp_def] using + hcomposed + · intro Γ source sources avs htail ih sourceRest rest slots + have hcomposed := EmitSoundBelow.comp + (discard_const_arg_value_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) (Γ := Γ) + (sourceEnv := sourceEnv) (source := source) + (sources := sources) (atom := .erased) + (worlds := List.replicate avs.length .shared) + (avs := avs) AValStable.erased sourceRest rest slots) + (ih sourceRest rest slots) + simpa [releaseAll, List.replicate_succ, Function.comp_def] using + hcomposed + +/-- Stable argument descriptors determine the exact `releaseAll` ownership +transformer by closing the single bounded induction body. -/ +theorem releaseAll_sound {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {avs : List AVal} (hstable : AValsStable avs) : + ReleaseAllSound ctx cur Γ (releaseAll Γ avs).1 + (releaseAll Γ avs).2 avs := by + intro rest slots + exact EmitSound.of_below fun limit => + releaseAll_sound_at (limit := limit) hstable rest slots + +/-- Stable argument descriptors and an equally sized source vector determine +the exact semantic `releaseAll` transformer. -/ +theorem releaseAll_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv sourceValues : List IxIR0.Value} {avs : List AVal} + (hstable : AValsStable avs) + (hsourceLength : sourceValues.length = avs.length) : + ReleaseAllValueSound funRel recSelfRel ctx cur Γ + (releaseAll Γ avs).1 sourceEnv sourceValues + (releaseAll Γ avs).2 avs := by + refine + { toReleaseAllSound := releaseAll_sound hstable + graphEmits := ?_ } + intro sourceRest rest slots + exact EmitSound.of_below fun limit => + (releaseAll_value_sound_at (limit := limit) hstable + hsourceLength).graphEmits sourceRest rest slots + +theorem releaseAll_sound_below {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} {avs : List AVal} + (hstable : AValsStable avs) : + ReleaseAllSoundBelow ctx cur limit Γ (releaseAll Γ avs).1 + (releaseAll Γ avs).2 avs := by + exact releaseAll_sound_at hstable + +theorem releaseAll_value_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv sourceValues : List IxIR0.Value} {avs : List AVal} + (hstable : AValsStable avs) + (hsourceLength : sourceValues.length = avs.length) : + ReleaseAllValueSoundBelow funRel recSelfRel ctx cur limit Γ + (releaseAll Γ avs).1 sourceEnv sourceValues + (releaseAll Γ avs).2 avs := by + exact releaseAll_value_sound_at hstable hsourceLength + +/-! ## Source-variable transitions -/ + +/-- Retain one protected borrowed field into a previously released entry. +The exact `dup` result occupies the old `VEnv.depth`, the entry becomes held, +and all original field slots plus all borrow facts survive for the remaining +field-fold iterations. -/ +theorem retain_borrowed_into_entry_owned + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {i placeholderAbs fieldAbs remaining : Nat} {value : RVal} + {rest : List Root} {slots : List (Nat × RVal)} + {borrowed : List RVal} + (hentry : Γ.entries[i]? = + some (.slot placeholderAbs 0 .many false)) + (hslotMem : (fieldAbs, value) ∈ slots) + (hborrowMem : value ∈ borrowed) : + EmitSound ctx cur (emitOp (.dup (.var (Γ.rel fieldAbs)))) + (OwnsVEnvBorrowed Γ rest slots borrowed) + (OwnsVEnvBorrowed + ((Γ.setEntry i (.slot Γ.depth remaining .many true)).bump) + rest slots borrowed) := by + apply OpSound.emit + intro fuel store env store' result hpre hrun + obtain ⟨⟨⟨roots, hΓ, hown⟩, hslots⟩, hborrowed⟩ := hpre + obtain ⟨hfieldBound, hfieldSlot⟩ := + hslots fieldAbs value hslotMem + have hresolve : + resolveAtom env (.var (Γ.rel fieldAbs)) = .ok value := + (AValRealizes.slot hfieldBound hfieldSlot).resolveAtom + have hworld : HasWorld store .shared value := + hborrowed value hborrowMem + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + obtain ⟨nextStore, heval, hownNext, hborrowedNext⟩ := + runOp_retain_borrowed_preserves_hasWorlds + (ctx := ctx) (cur := cur) (fuel := fuel) + hresolve hworld (show RootOwnership store (roots ++ rest) from hown) + hborrowed + have hpair : (nextStore, value) = (store', result) := + Except.ok.inj (heval.symm.trans hrun) + have hstoreEq : nextStore = store' := congrArg Prod.fst hpair + have hresultEq : value = result := congrArg Prod.snd hpair + subst nextStore + subst result + have hΓbump : VEnvRealizes Γ.bump (value :: env) roots := + hΓ.bump value + have hentryBump : Γ.bump.entries[i]? = + some (.slot placeholderAbs 0 .many false) := by + simpa [VEnv.bump] using hentry + have hnewBound : Γ.depth < Γ.bump.depth := by simp [VEnv.bump] + have hnewSlot : + (value :: env)[Γ.bump.rel Γ.depth]? = some value := by + simp [VEnv.bump, VEnv.rel] + obtain ⟨before, after, hroots, hentries⟩ := + hΓbump.entries.holdAt hentryBump hnewBound hnewSlot + have hset : VEnvRealizes + (Γ.bump.setEntry i (.slot Γ.depth remaining .many true)) + (value :: env) + (before ++ ⟨.shared, value⟩ :: after) := + hΓbump.setEntry hentries + have henvEq : + Γ.bump.setEntry i (.slot Γ.depth remaining .many true) = + ((Γ.setEntry i (.slot Γ.depth remaining .many true)).bump) := by + cases Γ + rfl + rw [henvEq] at hset + have howned : RootOwnership store' + ((before ++ ⟨.shared, value⟩ :: after) ++ rest) := by + rw [hroots] at hownNext + exact hownNext.perm + (perm_extract_root ⟨.shared, value⟩ before after rest).symm + refine ⟨⟨⟨before ++ ⟨.shared, value⟩ :: after, + hset, howned⟩, ?_⟩, hborrowedNext⟩ + exact (hslots.setEntry).bump value + +/-- Fuel-bounded retained-field transition used by the recursive compiler +induction. The transition is call-free and preserves the same protected +slots and borrow facts as its unbounded counterpart. -/ +theorem retain_borrowed_into_entry_owned_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {i placeholderAbs fieldAbs remaining : Nat} {value : RVal} + {rest : List Root} {slots : List (Nat × RVal)} + {borrowed : List RVal} + (hentry : Γ.entries[i]? = + some (.slot placeholderAbs 0 .many false)) + (hslotMem : (fieldAbs, value) ∈ slots) + (hborrowMem : value ∈ borrowed) : + EmitSoundBelow ctx cur limit + (emitOp (.dup (.var (Γ.rel fieldAbs)))) + (OwnsVEnvBorrowed Γ rest slots borrowed) + (OwnsVEnvBorrowed + ((Γ.setEntry i (.slot Γ.depth remaining .many true)).bump) + rest slots borrowed) := by + apply OpSoundBelow.emit + intro fuel store env store' result _ hpre hrun + obtain ⟨⟨⟨roots, hΓ, hown⟩, hslots⟩, hborrowed⟩ := hpre + obtain ⟨hfieldBound, hfieldSlot⟩ := + hslots fieldAbs value hslotMem + have hresolve : + resolveAtom env (.var (Γ.rel fieldAbs)) = .ok value := + (AValRealizes.slot hfieldBound hfieldSlot).resolveAtom + have hworld : HasWorld store .shared value := + hborrowed value hborrowMem + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + obtain ⟨nextStore, heval, hownNext, hborrowedNext⟩ := + runOp_retain_borrowed_preserves_hasWorlds + (ctx := ctx) (cur := cur) (fuel := fuel) + hresolve hworld (show RootOwnership store (roots ++ rest) from hown) + hborrowed + have hpair : (nextStore, value) = (store', result) := + Except.ok.inj (heval.symm.trans hrun) + cases hpair + have hΓbump : VEnvRealizes Γ.bump (value :: env) roots := + hΓ.bump value + have hentryBump : Γ.bump.entries[i]? = + some (.slot placeholderAbs 0 .many false) := by + simpa [VEnv.bump] using hentry + have hnewBound : Γ.depth < Γ.bump.depth := by simp [VEnv.bump] + have hnewSlot : + (value :: env)[Γ.bump.rel Γ.depth]? = some value := by + simp [VEnv.bump, VEnv.rel] + obtain ⟨before, after, hroots, hentries⟩ := + hΓbump.entries.holdAt hentryBump hnewBound hnewSlot + have hset : VEnvRealizes + (Γ.bump.setEntry i (.slot Γ.depth remaining .many true)) + (value :: env) + (before ++ ⟨.shared, value⟩ :: after) := + hΓbump.setEntry hentries + have henvEq : + Γ.bump.setEntry i (.slot Γ.depth remaining .many true) = + ((Γ.setEntry i (.slot Γ.depth remaining .many true)).bump) := by + cases Γ + rfl + rw [henvEq] at hset + have howned : RootOwnership store' + ((before ++ ⟨.shared, value⟩ :: after) ++ rest) := by + rw [hroots] at hownNext + exact hownNext.perm + (perm_extract_root ⟨.shared, value⟩ before after rest).symm + refine ⟨⟨⟨before ++ ⟨.shared, value⟩ :: after, + hset, howned⟩, ?_⟩, hborrowedNext⟩ + exact (hslots.setEntry).bump value + +/-- Semantic retained-field transition. Besides the ownership update, the +newly held entry receives the source graph named by its logical index, and +all still-pending borrowed-field graphs survive the refcount-only update. -/ +theorem retain_borrowed_into_entry_value_opSoundBelow + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {i placeholderAbs fieldAbs remaining : Nat} + {sourceEnv : List IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} + {rest extra : List Root} {slots : List (Nat × RVal)} + {borrowed : List RVal} {retains : List RecursorFieldRetain} + (hentry : Γ.entries[i]? = + some (.slot placeholderAbs 0 .many false)) : + OpSoundBelow ctx cur limit (.dup (.var (Γ.rel fieldAbs))) + (GraphOwnsVEnvRetains funRel recSelfRel Γ sourceEnv + sourceRest rest extra slots borrowed + (⟨i, fieldAbs, remaining⟩ :: retains)) + (GraphOwnsVEnvRetains funRel recSelfRel + ((Γ.setEntry i (.slot Γ.depth remaining .many true)).bump) + sourceEnv sourceRest rest extra slots borrowed retains) := by + intro fuel store env store' result _ hpre hrun + obtain ⟨roots, hΓ, hframe, hown, hslots, hborrowed, + hgraphs⟩ := hpre + obtain ⟨source, value, hsource, hslotMem, hborrowMem, hvalue⟩ := + hgraphs ⟨i, fieldAbs, remaining⟩ (by simp) + obtain ⟨hfieldBound, hfieldSlot⟩ := + hslots fieldAbs value hslotMem + have hresolve : + resolveAtom env (.var (Γ.rel fieldAbs)) = .ok value := + (AValRealizes.slot hfieldBound hfieldSlot).resolveAtom + have hworld : HasWorld store .shared value := + hborrowed value hborrowMem + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + obtain ⟨nextStore, heval, hextends, hvalueNext, hownNext⟩ := + runOp_retain_borrowed_valueGraph + (ctx := ctx) (cur := cur) (fuel := fuel) + hresolve hworld hvalue + (show RootOwnership store (roots ++ extra ++ rest) from hown) + have hpair : (nextStore, value) = (store', result) := + Except.ok.inj (heval.symm.trans hrun) + have hstoreEq : nextStore = store' := congrArg Prod.fst hpair + have hresultEq : value = result := congrArg Prod.snd hpair + subst nextStore + subst result + have hΓbump : VEnvValueGraph funRel recSelfRel store' + Γ.bump sourceEnv (value :: env) roots := + (hΓ.monoStore hextends).bump value + have hentryBump : Γ.bump.entries[i]? = + some (.slot placeholderAbs 0 .many false) := by + simpa [VEnv.bump] using hentry + have hnewBound : Γ.depth < Γ.bump.depth := by simp [VEnv.bump] + have hnewSlot : + (value :: env)[Γ.bump.rel Γ.depth]? = some value := by + simp [VEnv.bump, VEnv.rel] + have hworldNext : HasWorld store' .shared value := + hworld.monoStore hextends + obtain ⟨before, after, hroots, hentries⟩ := + hΓbump.entries.holdAt hentryBump hsource hnewBound hnewSlot + hworldNext hvalueNext + have hset : VEnvValueGraph funRel recSelfRel store' + (Γ.bump.setEntry i (.slot Γ.depth remaining .many true)) + sourceEnv (value :: env) + (before ++ ⟨.shared, value⟩ :: after) := + hΓbump.setEntry hentries + have henvEq : + Γ.bump.setEntry i (.slot Γ.depth remaining .many true) = + ((Γ.setEntry i (.slot Γ.depth remaining .many true)).bump) := by + cases Γ + rfl + rw [henvEq] at hset + have howned : RootOwnership store' + ((before ++ ⟨.shared, value⟩ :: after) ++ extra ++ rest) := by + rw [hroots] at hownNext + have hfront : RootOwnership store' + (⟨.shared, value⟩ :: (before ++ after) ++ (extra ++ rest)) := by + simpa [List.append_assoc] using hownNext + have hreordered := hfront.perm + (perm_extract_root ⟨.shared, value⟩ before after + (extra ++ rest)).symm + simpa [List.append_assoc] using hreordered + have htailBefore : RetainsValueGraphs funRel store sourceEnv slots + borrowed retains := by + intro retain hmember + exact hgraphs retain (by simp [hmember]) + refine ⟨before ++ ⟨.shared, value⟩ :: after, hset, + hframe.monoStore hextends, howned, (hslots.setEntry).bump value, + ?_, htailBefore.monoStore hextends⟩ + intro candidate hmember + exact (hborrowed candidate hmember).monoStore hextends + +/-- Fuel-bounded emitter form of the semantic retained-field transition. -/ +theorem retain_borrowed_into_entry_value_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {i placeholderAbs fieldAbs remaining : Nat} + {sourceEnv : List IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} + {rest extra : List Root} {slots : List (Nat × RVal)} + {borrowed : List RVal} {retains : List RecursorFieldRetain} + (hentry : Γ.entries[i]? = + some (.slot placeholderAbs 0 .many false)) : + EmitSoundBelow ctx cur limit + (emitOp (.dup (.var (Γ.rel fieldAbs)))) + (GraphOwnsVEnvRetains funRel recSelfRel Γ sourceEnv + sourceRest rest extra slots borrowed + (⟨i, fieldAbs, remaining⟩ :: retains)) + (GraphOwnsVEnvRetains funRel recSelfRel + ((Γ.setEntry i (.slot Γ.depth remaining .many true)).bump) + sourceEnv sourceRest rest extra slots borrowed retains) := + OpSoundBelow.emit + (retain_borrowed_into_entry_value_opSoundBelow hentry) + +private theorem drop_major_owned_at {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} {majorAbs : Nat} {major : RVal} + {rest : List Root} {slots : List (Nat × RVal)} + {borrowed : List RVal} + (hmajor : (majorAbs, major) ∈ slots) : + EmitSoundBelow ctx cur limit + (emitOp (.drop (.var (Γ.rel majorAbs)))) + (OwnsVEnvBorrowed Γ (⟨.shared, major⟩ :: rest) slots borrowed) + (OwnsVEnvProtected Γ.bump rest slots) := by + intro bound hbound post code hcode + intro fuel store env finalStore finalValue hfuel hpre hrun + obtain ⟨⟨⟨roots, hΓ, hown⟩, hslots⟩, _⟩ := hpre + obtain ⟨hmajorBound, hmajorSlot⟩ := + hslots majorAbs major hmajor + let frame : List RVal → Prop := fun oldEnv => + VEnvRealizes Γ oldEnv roots ∧ SlotsRealize Γ oldEnv slots + have hnext : CodeOwnsBelow ctx cur bound + (OwnsAfterPush frame (roots ++ rest)) post code := by + intro nextFuel nextStore nextEnv resultStore resultValue hnextFuel + hpushed hcodeRun + obtain ⟨pushed, oldEnv, rfl, ⟨hrealize, hslotsOld⟩, + hownRest⟩ := hpushed + apply hcode hnextFuel + · exact ⟨⟨roots, hrealize.bump pushed, hownRest⟩, + hslotsOld.bump pushed⟩ + · exact hcodeRun + apply (emit_drop_value_owned_below (ctx := ctx) (cur := cur) + (limit := limit) (frame := frame) + (target := .var (Γ.rel majorAbs)) (value := major) + (rest := roots ++ rest)) bound hbound post code hnext hfuel + · refine ⟨⟨hΓ, hslots⟩, + (AValRealizes.slot hmajorBound hmajorSlot).resolveAtom, ?_⟩ + exact hown.perm + (perm_extract_root_front ⟨.shared, major⟩ roots rest) + · exact hrun + +/-- Drop the recursor major after every needed constructor field has been +retained. The major is the first external root, while retained fields and +pre-major parameters are represented by `VEnv` roots. Borrow facts are no +longer promised after destroying the scrutinee. -/ +theorem drop_major_owned {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {majorAbs : Nat} {major : RVal} {rest : List Root} + {slots : List (Nat × RVal)} {borrowed : List RVal} + (hmajor : (majorAbs, major) ∈ slots) : + EmitSound ctx cur (emitOp (.drop (.var (Γ.rel majorAbs)))) + (OwnsVEnvBorrowed Γ (⟨.shared, major⟩ :: rest) slots borrowed) + (OwnsVEnvProtected Γ.bump rest slots) := by + apply EmitSound.of_below + intro limit + exact drop_major_owned_at (limit := limit) hmajor + +/-- Fuel-bounded major release. This is the middle transition of the +generated recursor prefix. -/ +theorem drop_major_owned_below {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} {majorAbs : Nat} {major : RVal} + {rest : List Root} {slots : List (Nat × RVal)} + {borrowed : List RVal} + (hmajor : (majorAbs, major) ∈ slots) : + EmitSoundBelow ctx cur limit + (emitOp (.drop (.var (Γ.rel majorAbs)))) + (OwnsVEnvBorrowed Γ (⟨.shared, major⟩ :: rest) slots borrowed) + (OwnsVEnvProtected Γ.bump rest slots) := by + exact drop_major_owned_at hmajor + +/-- Semantic fuel-bounded major release. Once the retain list is empty the +borrow-only witnesses may be discarded; every logical environment root and +caller-frame root survives the destructive release and its graph transports +through the resulting store restriction. -/ +theorem drop_major_value_opSoundBelow + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} + {majorAbs : Nat} {major : RVal} {rest : List Root} + {slots : List (Nat × RVal)} {borrowed : List RVal} + (hmajor : (majorAbs, major) ∈ slots) : + OpSoundBelow ctx cur limit (.drop (.var (Γ.rel majorAbs))) + (GraphOwnsVEnvRetains funRel recSelfRel Γ sourceEnv + sourceRest rest [⟨.shared, major⟩] slots borrowed []) + (GraphOwnsVEnvProtected funRel recSelfRel Γ.bump sourceEnv + sourceRest rest slots) := by + intro fuel store env store' result _ hpre hrun + obtain ⟨roots, hΓ, hrestGraph, hown, hslots, _, _⟩ := hpre + obtain ⟨hmajorBound, hmajorSlot⟩ := + hslots majorAbs major hmajor + have hresolve : + resolveAtom env (.var (Γ.rel majorAbs)) = .ok major := + (AValRealizes.slot hmajorBound hmajorSlot).resolveAtom + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + have howned : RootOwnership store + (⟨.shared, major⟩ :: roots ++ rest) := by + have hcanonical : RootOwnership store + (roots ++ ⟨.shared, major⟩ :: rest) := by + simpa [List.append_assoc] using hown + have hreordered := hcanonical.perm + (perm_extract_root_front ⟨.shared, major⟩ roots rest) + exact hreordered + obtain ⟨rfl, hrestrict, hownAfter⟩ := + runOp_drop_value_owned_restricts hresolve howned hrun + have hΓAfter : VEnvValueGraph funRel recSelfRel store' + Γ sourceEnv env roots := + hΓ.ofRestricts hrestrict hownAfter + (fun root hmember => + List.mem_append_left rest hmember) + have hrestAfter : Sim.RootsGraph funRel store' sourceRest rest := + hrestGraph.ofRestrictsIn hrestrict hownAfter + (fun root hmember => + List.mem_append_right roots hmember) + refine ⟨⟨roots, hΓAfter.bump .erased, hrestAfter, ?_⟩, + hslots.bump .erased⟩ + exact hownAfter + +/-- Fuel-bounded emitter form of the semantic recursor-major release. -/ +theorem drop_major_value_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} + {majorAbs : Nat} {major : RVal} {rest : List Root} + {slots : List (Nat × RVal)} {borrowed : List RVal} + (hmajor : (majorAbs, major) ∈ slots) : + EmitSoundBelow ctx cur limit + (emitOp (.drop (.var (Γ.rel majorAbs)))) + (GraphOwnsVEnvRetains funRel recSelfRel Γ sourceEnv + sourceRest rest [⟨.shared, major⟩] slots borrowed []) + (GraphOwnsVEnvProtected funRel recSelfRel Γ.bump sourceEnv + sourceRest rest slots) := + OpSoundBelow.emit (drop_major_value_opSoundBelow hmajor) + +/-- Single bounded common proof for releasing one held entry, abstracted over +shared versus affine destruction. -/ +private theorem release_slot_owned_at + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {i abs : Nat} {uses : Uses} {world : Owned} {releaseEmit : Emit} + (hworld : worldOfUses uses = world) + (hentry : Γ.entries[i]? = some (.slot abs 0 uses true)) + (hop : ∀ {frame : List RVal → Prop} {value : RVal} + {tailRoots : List Root}, + EmitSoundBelow ctx cur limit releaseEmit + (fun store env => frame env ∧ + resolveAtom env (.var (Γ.rel abs)) = .ok value ∧ + RootOwnership store (⟨world, value⟩ :: tailRoots)) + (OwnsAfterPush frame tailRoots)) : + ∀ rest slots, + EmitSoundBelow ctx cur limit releaseEmit + (OwnsVEnvProtected Γ rest slots) + (OwnsVEnvProtected + ((Γ.setEntry i (.slot abs 0 uses false)).bump) rest slots) := by + intro rest slots bound hbound post code hcode + intro fuel store env finalStore finalValue hfuel hpre hrun + obtain ⟨⟨roots, hΓ, hown⟩, hslots⟩ := hpre + obtain ⟨value, before, after, hboundSlot, hslot, hroots, hreleased⟩ := + hΓ.entries.releaseAt hentry + let Γreleased := Γ.setEntry i (.slot abs 0 uses false) + let tailRoots := before ++ after ++ rest + let frame : List RVal → Prop := fun oldEnv => + VEnvRealizes Γreleased oldEnv (before ++ after) ∧ + SlotsRealize Γreleased oldEnv slots + have hΓreleased : VEnvRealizes Γreleased env (before ++ after) := + hΓ.setEntry hreleased + have howned : RootOwnership store (⟨world, value⟩ :: tailRoots) := by + rw [hroots] at hown + have hfront := hown.perm + (perm_extract_root ⟨worldOfUses uses, value⟩ before after rest) + simpa [tailRoots, hworld] using hfront + have hnext : CodeOwnsBelow ctx cur bound + (OwnsAfterPush frame tailRoots) post code := by + intro nextFuel nextStore nextEnv resultStore resultValue hnextFuel + hpushed hcodeRun + obtain ⟨pushed, oldEnv, rfl, ⟨hrealize, hslotsOld⟩, + hownRest⟩ := hpushed + apply hcode hnextFuel + · refine ⟨⟨before ++ after, hrealize.bump pushed, ?_⟩, + hslotsOld.bump pushed⟩ + simpa [tailRoots, List.append_assoc] using hownRest + · exact hcodeRun + apply hop bound hbound post code hnext hfuel + · refine ⟨⟨hΓreleased, hslots.setEntry⟩, ?_, howned⟩ + exact (AValRealizes.slot hboundSlot hslot).resolveAtom + · exact hrun + +/-- Single bounded semantic proof for releasing one slot. The selected root is +consumed while reverse shape inclusion rebuilds every surviving graph. -/ +private theorem release_slot_value_sound_at + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {i abs : Nat} {uses : Uses} {world : Owned} {releaseOp : Op} + (hworld : worldOfUses uses = world) + (hentry : Γ.entries[i]? = some (.slot abs 0 uses true)) + (hop : ∀ {fuel : Nat} {store store' : Store} {env : List RVal} + {value result : RVal} {tailRoots : List Root}, + resolveAtom env (.var (Γ.rel abs)) = .ok value → + RootOwnership store (⟨world, value⟩ :: tailRoots) → + runOp ctx (fuel + 1) cur store env releaseOp = + .ok (store', result) → + result = .erased ∧ Sim.StoreGraphRestricts store store' ∧ + RootOwnership store' tailRoots) : + ∀ sourceEnv sourceRest rest slots, + EmitSoundBelow ctx cur limit (emitOp releaseOp) + (GraphOwnsVEnvProtected funRel recSelfRel Γ + sourceEnv sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel + ((Γ.setEntry i (.slot abs 0 uses false)).bump) + sourceEnv sourceRest rest slots) := by + intro sourceEnv sourceRest rest slots + apply OpSoundBelow.emit + intro fuel store env store' result _ hpre hrun + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + obtain ⟨⟨roots, hΓ, hrestGraph, hown⟩, hslots⟩ := hpre + obtain ⟨_, value, before, after, _, hbound, hslot, _, _, + hroots, hreleased⟩ := hΓ.entries.releaseAt hentry + let Γreleased := Γ.setEntry i (.slot abs 0 uses false) + let tailRoots := before ++ after ++ rest + have hΓreleased : VEnvValueGraph funRel recSelfRel store + Γreleased sourceEnv env (before ++ after) := + hΓ.setEntry hreleased + have howned : RootOwnership store + (⟨world, value⟩ :: tailRoots) := by + rw [hroots] at hown + have hfront := hown.perm + (perm_extract_root + ⟨worldOfUses uses, value⟩ before after rest) + simpa [tailRoots, hworld] using hfront + have hresolve : + resolveAtom env (.var (Γ.rel abs)) = .ok value := + (AValRealizes.slot hbound hslot).resolveAtom + obtain ⟨rfl, hrestrict, hownAfter⟩ := + hop hresolve howned hrun + have hΓafter : VEnvValueGraph funRel recSelfRel store' + Γreleased sourceEnv env (before ++ after) := + hΓreleased.ofRestricts hrestrict hownAfter + (fun root hmember => by + simpa [tailRoots] using + List.mem_append_left rest hmember) + have hrestAfter : Sim.RootsGraph funRel store' sourceRest rest := + hrestGraph.ofRestrictsIn hrestrict hownAfter + (fun root hmember => by + simpa [tailRoots] using + List.mem_append_right (before ++ after) hmember) + refine ⟨⟨before ++ after, ?_, hrestAfter, ?_⟩, ?_⟩ + · exact hΓafter.bump .erased + · simpa [tailRoots] using hownAfter + · exact (hslots.setEntry).bump .erased + +theorem release_slot_many_owned {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {i abs : Nat} + (hentry : Γ.entries[i]? = some (.slot abs 0 .many true)) : + ∀ rest slots, + EmitSound ctx cur (emitOp (.drop (.var (Γ.rel abs)))) + (OwnsVEnvProtected Γ rest slots) + (OwnsVEnvProtected + ((Γ.setEntry i (.slot abs 0 .many false)).bump) rest slots) := by + intro rest slots + apply EmitSound.of_below + intro limit + apply release_slot_owned_at (limit := limit) (world := .shared) rfl hentry + exact emit_drop_value_owned_below + +theorem release_slot_affine_owned {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {i abs : Nat} + (hentry : Γ.entries[i]? = some (.slot abs 0 .affine true)) : + ∀ rest slots, + EmitSound ctx cur (emitOp (.dropU (.var (Γ.rel abs)))) + (OwnsVEnvProtected Γ rest slots) + (OwnsVEnvProtected + ((Γ.setEntry i (.slot abs 0 .affine false)).bump) rest slots) := by + intro rest slots + apply EmitSound.of_below + intro limit + apply release_slot_owned_at (limit := limit) (world := .unique) rfl hentry + exact emit_dropU_value_owned_below + +/-- Releasing a dead shared entry preserves the source graph of every other +logical entry and every caller-framed root. -/ +theorem release_slot_many_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} {i abs : Nat} + (hentry : Γ.entries[i]? = some (.slot abs 0 .many true)) : + ∀ sourceEnv sourceRest rest slots, + EmitSound ctx cur (emitOp (.drop (.var (Γ.rel abs)))) + (GraphOwnsVEnvProtected funRel recSelfRel Γ + sourceEnv sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel + ((Γ.setEntry i (.slot abs 0 .many false)).bump) + sourceEnv sourceRest rest slots) := by + intro sourceEnv sourceRest rest slots + apply EmitSound.of_below + intro limit + apply release_slot_value_sound_at (limit := limit) + (world := .shared) rfl hentry + exact runOp_drop_value_owned_restricts + +/-- Releasing a dead affine entry has the same graph-preserving interface, +using unique deep destruction underneath. -/ +theorem release_slot_affine_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} {i abs : Nat} + (hentry : Γ.entries[i]? = some (.slot abs 0 .affine true)) : + ∀ sourceEnv sourceRest rest slots, + EmitSound ctx cur (emitOp (.dropU (.var (Γ.rel abs)))) + (GraphOwnsVEnvProtected funRel recSelfRel Γ + sourceEnv sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel + ((Γ.setEntry i (.slot abs 0 .affine false)).bump) + sourceEnv sourceRest rest slots) := by + intro sourceEnv sourceRest rest slots + apply EmitSound.of_below + intro limit + apply release_slot_value_sound_at (limit := limit) + (world := .unique) rfl hentry + exact runOp_dropU_value_owned_restricts + +theorem release_slot_many_value_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {i abs : Nat} + (hentry : Γ.entries[i]? = some (.slot abs 0 .many true)) : + ∀ sourceEnv sourceRest rest slots, + EmitSoundBelow ctx cur limit + (emitOp (.drop (.var (Γ.rel abs)))) + (GraphOwnsVEnvProtected funRel recSelfRel Γ + sourceEnv sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel + ((Γ.setEntry i (.slot abs 0 .many false)).bump) + sourceEnv sourceRest rest slots) := by + apply release_slot_value_sound_at (world := .shared) rfl hentry + exact runOp_drop_value_owned_restricts + +theorem release_slot_affine_value_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {i abs : Nat} + (hentry : Γ.entries[i]? = some (.slot abs 0 .affine true)) : + ∀ sourceEnv sourceRest rest slots, + EmitSoundBelow ctx cur limit + (emitOp (.dropU (.var (Γ.rel abs)))) + (GraphOwnsVEnvProtected funRel recSelfRel Γ + sourceEnv sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel + ((Γ.setEntry i (.slot abs 0 .affine false)).bump) + sourceEnv sourceRest rest slots) := by + apply release_slot_value_sound_at (world := .unique) rfl hentry + exact runOp_dropU_value_owned_restricts + +theorem release_slot_many_owned_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {i abs : Nat} + (hentry : Γ.entries[i]? = some (.slot abs 0 .many true)) : + ∀ rest slots, + EmitSoundBelow ctx cur limit + (emitOp (.drop (.var (Γ.rel abs)))) + (OwnsVEnvProtected Γ rest slots) + (OwnsVEnvProtected + ((Γ.setEntry i (.slot abs 0 .many false)).bump) rest slots) := by + apply release_slot_owned_at (world := .shared) rfl hentry + exact emit_drop_value_owned_below + +theorem release_slot_affine_owned_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {i abs : Nat} + (hentry : Γ.entries[i]? = some (.slot abs 0 .affine true)) : + ∀ rest slots, + EmitSoundBelow ctx cur limit + (emitOp (.dropU (.var (Γ.rel abs)))) + (OwnsVEnvProtected Γ rest slots) + (OwnsVEnvProtected + ((Γ.setEntry i (.slot abs 0 .affine false)).bump) rest slots) := by + apply release_slot_owned_at (world := .unique) rfl hentry + exact emit_dropU_value_owned_below + +/-- Proof-relevant successful execution plan for `releaseSlots`. Linear and +erased dead parameters have no constructor because the executable lowerer +rejects them. -/ +inductive ReleasePlan : VEnv → List SlotDrop → VEnv → Emit → Prop where + | nil {Γ : VEnv} : + ReleasePlan Γ [] Γ (_root_.id : Emit) + | many {Γ output : VEnv} {i abs : Nat} {drops : List SlotDrop} + {tailEmit : Emit} + (hentry : Γ.entries[i]? = some (.slot abs 0 .many true)) + (tail : ReleasePlan + ((Γ.setEntry i (.slot abs 0 .many false)).bump) + drops output tailEmit) : + ReleasePlan Γ (⟨i, abs, .many⟩ :: drops) output + (emitOp (.drop (.var (Γ.rel abs))) ∘ tailEmit) + | affine {Γ output : VEnv} {i abs : Nat} {drops : List SlotDrop} + {tailEmit : Emit} + (hentry : Γ.entries[i]? = some (.slot abs 0 .affine true)) + (tail : ReleasePlan + ((Γ.setEntry i (.slot abs 0 .affine false)).bump) + drops output tailEmit) : + ReleasePlan Γ (⟨i, abs, .affine⟩ :: drops) output + (emitOp (.dropU (.var (Γ.rel abs))) ∘ tailEmit) + +/-- Dependent traversal of a release plan. The lowering-state transition, +descriptor consumption, and emitter composition are exposed once here, while +clients supply only the judgment-specific identity, shared-drop, and +affine-drop steps. -/ +theorem ReleasePlan.traverse + {Result : VEnv → List SlotDrop → VEnv → Emit → Prop} + (hnil : ∀ Γ, Result Γ [] Γ (_root_.id : Emit)) + (hmany : ∀ {Γ output : VEnv} {i abs : Nat} + {drops : List SlotDrop} {tailEmit : Emit}, + Γ.entries[i]? = some (.slot abs 0 .many true) → + Result + ((Γ.setEntry i (.slot abs 0 .many false)).bump) + drops output tailEmit → + Result Γ (⟨i, abs, .many⟩ :: drops) output + (emitOp (.drop (.var (Γ.rel abs))) ∘ tailEmit)) + (haffine : ∀ {Γ output : VEnv} {i abs : Nat} + {drops : List SlotDrop} {tailEmit : Emit}, + Γ.entries[i]? = some (.slot abs 0 .affine true) → + Result + ((Γ.setEntry i (.slot abs 0 .affine false)).bump) + drops output tailEmit → + Result Γ (⟨i, abs, .affine⟩ :: drops) output + (emitOp (.dropU (.var (Γ.rel abs))) ∘ tailEmit)) + {input output : VEnv} {drops : List SlotDrop} {emit : Emit} + (hplan : ReleasePlan input drops output emit) : + Result input drops output emit := by + induction hplan with + | nil => exact hnil _ + | many hentry tail ih => exact hmany hentry ih + | affine hentry tail ih => exact haffine hentry ih + +/-- Append untouched logical entries without changing runtime depth. This is +the frame needed to prove parameter releases inside lifted-function +environments that also contain capture/source entries. -/ +def frameVEnvEntries (Γ : VEnv) (frame : List VEntry) : VEnv := + { Γ with entries := Γ.entries ++ frame } + +/-- Prepend unrelated logical entries without changing runtime depth. Release +descriptor indices must be shifted by the prefix length. -/ +def prependVEnvEntries (leading : List VEntry) (Γ : VEnv) : VEnv := + { Γ with entries := leading ++ Γ.entries } + +theorem ReleasePlan.entries_length {input output : VEnv} + {drops : List SlotDrop} {emit : Emit} + (hplan : ReleasePlan input drops output emit) : + output.entries.length = input.entries.length := by + apply ReleasePlan.traverse + (Result := fun current _ final _ => + final.entries.length = current.entries.length) + (hplan := hplan) + · intro Γ + rfl + · intro Γ output i abs drops tailEmit hentry ih + simpa [VEnv.setEntry, VEnv.bump] using ih + · intro Γ output i abs drops tailEmit hentry ih + simpa [VEnv.setEntry, VEnv.bump] using ih + +/-- Release plans preserve an appended suffix of entries. All generated drop +indices point into the original prefix, and entry updates commute with this +frame. -/ +theorem ReleasePlan.frameEntries {input output : VEnv} + {drops : List SlotDrop} {emit : Emit} + (hplan : ReleasePlan input drops output emit) (frame : List VEntry) : + ReleasePlan (frameVEnvEntries input frame) drops + (frameVEnvEntries output frame) emit := by + apply ReleasePlan.traverse + (Result := fun current drops final emit => + ReleasePlan (frameVEnvEntries current frame) drops + (frameVEnvEntries final frame) emit) + (hplan := hplan) + · intro Γ + exact ReleasePlan.nil + · intro Γ output i abs drops tailEmit hentry ih + obtain ⟨hi, _⟩ := List.getElem?_eq_some_iff.mp hentry + have hentryFrame : (frameVEnvEntries Γ frame).entries[i]? = + some (.slot abs 0 .many true) := by + simpa [frameVEnvEntries, + List.getElem?_append_left hi] using hentry + have hnext : + ((frameVEnvEntries Γ frame).setEntry i + (.slot abs 0 .many false)).bump = + (frameVEnvEntries + ((Γ.setEntry i (.slot abs 0 .many false)).bump) frame) := by + cases Γ + simp [frameVEnvEntries, VEnv.setEntry, VEnv.bump, + List.set_append_left _ _ hi] + apply ReleasePlan.many hentryFrame + rw [hnext] + simpa [frameVEnvEntries, VEnv.rel] using ih + · intro Γ output i abs drops tailEmit hentry ih + obtain ⟨hi, _⟩ := List.getElem?_eq_some_iff.mp hentry + have hentryFrame : (frameVEnvEntries Γ frame).entries[i]? = + some (.slot abs 0 .affine true) := by + simpa [frameVEnvEntries, + List.getElem?_append_left hi] using hentry + have hnext : + ((frameVEnvEntries Γ frame).setEntry i + (.slot abs 0 .affine false)).bump = + (frameVEnvEntries + ((Γ.setEntry i (.slot abs 0 .affine false)).bump) frame) := by + cases Γ + simp [frameVEnvEntries, VEnv.setEntry, VEnv.bump, + List.set_append_left _ _ hi] + apply ReleasePlan.affine hentryFrame + rw [hnext] + simpa [frameVEnvEntries, VEnv.rel] using ih + +/-- A leading logical-entry frame preserves a release plan after shifting +every descriptor's entry index. Absolute runtime slots and emitted relative +indices are unchanged because the frame does not alter runtime depth. -/ +theorem ReleasePlan.prependEntries {input output : VEnv} + {drops : List SlotDrop} {emit : Emit} + (hplan : ReleasePlan input drops output emit) + (leading : List VEntry) : + ReleasePlan (prependVEnvEntries leading input) + (drops.map (SlotDrop.offsetEntry leading.length)) + (prependVEnvEntries leading output) emit := by + apply ReleasePlan.traverse + (Result := fun current drops final emit => + ReleasePlan (prependVEnvEntries leading current) + (drops.map (SlotDrop.offsetEntry leading.length)) + (prependVEnvEntries leading final) emit) + (hplan := hplan) + · intro Γ + exact ReleasePlan.nil + · intro Γ output i abs drops tailEmit hentry ih + have hentryPrefix : + (prependVEnvEntries leading Γ).entries[leading.length + i]? = + some (.slot abs 0 .many true) := by + rw [show (prependVEnvEntries leading Γ).entries = + leading ++ Γ.entries by rfl] + rw [List.getElem?_append_right (Nat.le_add_right _ _)] + simpa using hentry + have hnext : + ((prependVEnvEntries leading Γ).setEntry (leading.length + i) + (.slot abs 0 .many false)).bump = + prependVEnvEntries leading + ((Γ.setEntry i (.slot abs 0 .many false)).bump) := by + cases Γ + simp [prependVEnvEntries, VEnv.setEntry, VEnv.bump, + List.set_append_right] + apply ReleasePlan.many hentryPrefix + rw [hnext] + simpa [SlotDrop.offsetEntry] using ih + · intro Γ output i abs drops tailEmit hentry ih + have hentryPrefix : + (prependVEnvEntries leading Γ).entries[leading.length + i]? = + some (.slot abs 0 .affine true) := by + rw [show (prependVEnvEntries leading Γ).entries = + leading ++ Γ.entries by rfl] + rw [List.getElem?_append_right (Nat.le_add_right _ _)] + simpa using hentry + have hnext : + ((prependVEnvEntries leading Γ).setEntry (leading.length + i) + (.slot abs 0 .affine false)).bump = + prependVEnvEntries leading + ((Γ.setEntry i (.slot abs 0 .affine false)).bump) := by + cases Γ + simp [prependVEnvEntries, VEnv.setEntry, VEnv.bump, + List.set_append_right] + apply ReleasePlan.affine hentryPrefix + rw [hnext] + simpa [SlotDrop.offsetEntry] using ih + +/-- Proof-relevant execution plan for the recursor's canonical borrowed-field +retain list. Each step activates one released field entry at the fresh slot +pushed by `dup`. -/ +inductive FieldRetainPlan : + VEnv → List RecursorFieldRetain → VEnv → Emit → Prop where + | nil {Γ : VEnv} : + FieldRetainPlan Γ [] Γ (_root_.id : Emit) + | retain {Γ output : VEnv} {i placeholderAbs fieldAbs remaining : Nat} + {retains : List RecursorFieldRetain} {tailEmit : Emit} + (hentry : Γ.entries[i]? = + some (.slot placeholderAbs 0 .many false)) + (tail : FieldRetainPlan + ((Γ.setEntry i (.slot Γ.depth remaining .many true)).bump) + retains output tailEmit) : + FieldRetainPlan Γ + (⟨i, fieldAbs, remaining⟩ :: retains) output + (emitOp (.dup (.var (Γ.rel fieldAbs))) ∘ tailEmit) + +/-- Dependent traversal of a field-retain plan. Descriptor consumption, +environment threading, and emitter composition are shared by every logical +consumer; the caller supplies only its identity and one-retain judgments. -/ +theorem FieldRetainPlan.traverse + {Result : VEnv → List RecursorFieldRetain → VEnv → Emit → Prop} + (hnil : ∀ Γ, Result Γ [] Γ (_root_.id : Emit)) + (hretain : ∀ {Γ output : VEnv} + {i placeholderAbs fieldAbs remaining : Nat} + {retains : List RecursorFieldRetain} {tailEmit : Emit}, + Γ.entries[i]? = some (.slot placeholderAbs 0 .many false) → + Result + ((Γ.setEntry i (.slot Γ.depth remaining .many true)).bump) + retains output tailEmit → + Result Γ (⟨i, fieldAbs, remaining⟩ :: retains) output + (emitOp (.dup (.var (Γ.rel fieldAbs))) ∘ tailEmit)) + {input output : VEnv} {retains : List RecursorFieldRetain} + {emit : Emit} (hplan : FieldRetainPlan input retains output emit) : + Result input retains output emit := by + induction hplan with + | nil => exact hnil _ + | retain hentry tail ih => exact hretain hentry ih + +/-- Later field retains address only the original field-entry block, so an +appended logical frame commutes with the whole plan. -/ +theorem FieldRetainPlan.frameEntries {input output : VEnv} + {retains : List RecursorFieldRetain} {emit : Emit} + (hplan : FieldRetainPlan input retains output emit) + (frame : List VEntry) : + FieldRetainPlan (frameVEnvEntries input frame) retains + (frameVEnvEntries output frame) emit := by + apply FieldRetainPlan.traverse + (Result := fun current retains final emit => + FieldRetainPlan (frameVEnvEntries current frame) retains + (frameVEnvEntries final frame) emit) + (hplan := hplan) + · intro Γ + exact FieldRetainPlan.nil + · intro Γ output i placeholderAbs fieldAbs remaining retains tailEmit + hentry ih + obtain ⟨hi, _⟩ := List.getElem?_eq_some_iff.mp hentry + have hentryFrame : (frameVEnvEntries Γ frame).entries[i]? = + some (.slot placeholderAbs 0 .many false) := by + simpa [frameVEnvEntries, List.getElem?_append_left hi] using hentry + have hnext : + ((frameVEnvEntries Γ frame).setEntry i + (.slot Γ.depth remaining .many true)).bump = + frameVEnvEntries + ((Γ.setEntry i (.slot Γ.depth remaining .many true)).bump) + frame := by + cases Γ + simp [frameVEnvEntries, VEnv.setEntry, VEnv.bump, + List.set_append_left _ _ hi] + apply FieldRetainPlan.retain hentryFrame + rw [show (frameVEnvEntries Γ frame).depth = Γ.depth by rfl] + rw [hnext] + simpa [frameVEnvEntries, VEnv.rel] using ih + +/-- Field-retain plans update entries in place and therefore preserve the +logical environment length. -/ +theorem FieldRetainPlan.entries_length {input output : VEnv} + {retains : List RecursorFieldRetain} {emit : Emit} + (hplan : FieldRetainPlan input retains output emit) : + output.entries.length = input.entries.length := by + apply FieldRetainPlan.traverse + (Result := fun current _ final _ => + final.entries.length = current.entries.length) + (hplan := hplan) + · intro Γ + rfl + · intro Γ output i placeholderAbs fieldAbs remaining retains tailEmit + hentry ih + simpa [VEnv.setEntry, VEnv.bump] using ih + +/-- A field-retain plan computes the exact pure interpreter result. -/ +theorem FieldRetainPlan.run {input output : VEnv} + {retains : List RecursorFieldRetain} {emit : Emit} + (hplan : FieldRetainPlan input retains output emit) : + applyRecursorFieldRetains input retains = (output, emit) := by + apply FieldRetainPlan.traverse + (Result := fun current pending final pendingEmit => + applyRecursorFieldRetains current pending = (final, pendingEmit)) + (hplan := hplan) + · intro Γ + rfl + · intro Γ output i placeholderAbs fieldAbs remaining retains tailEmit + hentry ih + simp only [applyRecursorFieldRetains] + rw [ih] + +/-- Build the concrete retain plan while carrying an arbitrary invariant of +its output environment. Released placeholders, live-slot activation, depth +advancement, and emitter composition are shared by all plan clients. -/ +theorem recursorFieldRetains_plan_traverse + (rhs : IxIR0.Expr) + {Result : Nat → Nat → Nat → VEnv → Prop} + (hnilResult : ∀ fieldAbs depth, + Result fieldAbs depth 0 ⟨[], depth⟩) + (hskipResult : ∀ {fieldAbs depth fieldCount : Nat} + {tailOutput : VEnv}, + Result (fieldAbs + 1) depth fieldCount tailOutput → + tailOutput.entries.length = fieldCount → + countUses fieldCount rhs = 0 → + Result fieldAbs depth (fieldCount + 1) + (frameVEnvEntries tailOutput [.slot 0 0 .many false])) + (hretainResult : ∀ {fieldAbs depth fieldCount : Nat} + {tailOutput : VEnv}, + Result (fieldAbs + 1) (depth + 1) fieldCount tailOutput → + tailOutput.entries.length = fieldCount → + countUses fieldCount rhs ≠ 0 → + Result fieldAbs depth (fieldCount + 1) + (frameVEnvEntries tailOutput + [.slot depth (countUses fieldCount rhs) .many true])) : + ∀ (fieldAbs depth fieldCount : Nat), + ∃ output emit, + FieldRetainPlan + ⟨List.replicate fieldCount (.slot 0 0 .many false), depth⟩ + (recursorFieldRetains fieldAbs rhs fieldCount) + output emit ∧ + Result fieldAbs depth fieldCount output := by + intro fieldAbs depth fieldCount + exact recursorFieldRetains_traverse rhs + (Result := fun currentAbs currentCount retains => + ∀ currentDepth, + ∃ output emit, + FieldRetainPlan + ⟨List.replicate currentCount (.slot 0 0 .many false), + currentDepth⟩ + retains output emit ∧ + Result currentAbs currentDepth currentCount output) + (hnil := by + intro currentAbs currentDepth + exact ⟨⟨[], currentDepth⟩, (_root_.id : Emit), + FieldRetainPlan.nil, hnilResult currentAbs currentDepth⟩) + (hskip := by + intro currentAbs currentCount tail hzero ih currentDepth + obtain ⟨tailOutput, tailEmit, htail, htailResult⟩ := ih currentDepth + let dead : VEntry := .slot 0 0 .many false + have hrep : List.replicate (currentCount + 1) dead = + List.replicate currentCount dead ++ [dead] := by + symm + simpa using (List.replicate_append_replicate + (n := currentCount) (m := 1) (a := dead)) + have hframed := htail.frameEntries [dead] + have hlength : tailOutput.entries.length = currentCount := by + calc + tailOutput.entries.length = + (List.replicate currentCount dead).length := + htail.entries_length + _ = currentCount := by simp + refine ⟨frameVEnvEntries tailOutput [dead], tailEmit, ?_, ?_⟩ + · rw [hrep] + simpa [dead, frameVEnvEntries] using hframed + · simpa [dead] using + hskipResult htailResult hlength hzero) + (hretain := by + intro currentAbs currentCount tail hnonzero ih currentDepth + obtain ⟨tailOutput, tailEmit, htail, htailResult⟩ := + ih (currentDepth + 1) + let dead : VEntry := .slot 0 0 .many false + let uses := countUses currentCount rhs + let held : VEntry := .slot currentDepth uses .many true + have hrep : List.replicate (currentCount + 1) dead = + List.replicate currentCount dead ++ [dead] := by + symm + simpa using (List.replicate_append_replicate + (n := currentCount) (m := 1) (a := dead)) + let input : VEnv := + ⟨List.replicate (currentCount + 1) dead, currentDepth⟩ + have hentry : input.entries[currentCount]? = some dead := by + simp [input, dead] + have hnext : + ((input.setEntry currentCount held).bump) = + frameVEnvEntries + ⟨List.replicate currentCount dead, currentDepth + 1⟩ + [held] := by + simp only [input, VEnv.setEntry, VEnv.bump] + rw [hrep] + simp [held, dead, frameVEnvEntries, List.set_append_right] + have hframed := htail.frameEntries [held] + have htailFull : FieldRetainPlan + ((input.setEntry currentCount held).bump) tail + (frameVEnvEntries tailOutput [held]) tailEmit := by + rw [hnext] + exact hframed + have hfirst := FieldRetainPlan.retain + (fieldAbs := currentAbs) hentry htailFull + have hlength : tailOutput.entries.length = currentCount := by + calc + tailOutput.entries.length = + (List.replicate currentCount dead).length := + htail.entries_length + _ = currentCount := by simp + refine ⟨frameVEnvEntries tailOutput [held], + emitOp (.dup (.var (input.rel currentAbs))) ∘ tailEmit, ?_, ?_⟩ + · simpa [input, dead, held, uses] using hfirst + · simpa [held, uses] using + hretainResult htailResult hlength hnonzero) + fieldAbs fieldCount depth + +/-- The compiler-generated retain list always has a concrete plan from its +all-released field-entry block, at any ambient runtime depth. -/ +theorem recursorFieldRetains_plan + (fieldAbs depth fieldCount : Nat) (rhs : IxIR0.Expr) : + let dead : VEntry := .slot 0 0 .many false + ∃ output emit, + FieldRetainPlan + ⟨List.replicate fieldCount dead, depth⟩ + (recursorFieldRetains fieldAbs rhs fieldCount) + output emit := by + dsimp only + obtain ⟨output, emit, hplan, _⟩ := + recursorFieldRetains_plan_traverse rhs + (Result := fun _ _ _ _ => True) + (hnilResult := by simp) + (hskipResult := by simp) + (hretainResult := by simp) + fieldAbs depth fieldCount + exact ⟨output, emit, hplan⟩ + +/-- Original borrowed field slots in constructor order. The first field is at +`fieldAbs`; each following field occupies the next older absolute position. -/ +def recursorFieldSlots : Nat → List RVal → List (Nat × RVal) + | _, [] => [] + | fieldAbs, value :: values => + (fieldAbs, value) :: recursorFieldSlots (fieldAbs + 1) values + +private theorem List.foldl_cons_eq_reverse_append (values env : List RVal) : + values.foldl (fun current value => value :: current) env = + values.reverse ++ env := by + induction values generalizing env with + | nil => rfl + | cons value values ih => + simp only [List.foldl_cons] + rw [ih] + simp [List.reverse_cons, List.append_assoc] + +theorem Array.foldl_cons_eq_reverse_append + (fields : Array RVal) (env : List RVal) : + fields.foldl (fun current field => field :: current) env = + fields.toList.reverse ++ env := by + rw [← Array.foldl_toList] + exact List.foldl_cons_eq_reverse_append fields.toList env + +/-- Constructor fields pushed from left to right occupy consecutive absolute +slots, starting immediately outside the pre-major argument prefix. -/ +theorem recursorFieldSlots_realize_list (env values : List RVal) : + SlotsRealize ⟨[], env.length + values.length⟩ + (values.reverse ++ env) + (recursorFieldSlots env.length values) := by + induction values generalizing env with + | nil => exact SlotsRealize.nil + | cons value values ih => + intro abs found hmem + simp only [recursorFieldSlots, List.mem_cons] at hmem + rcases hmem with hpair | htail + · obtain ⟨rfl, rfl⟩ := Prod.mk.inj hpair + constructor + · simp + · simp [VEnv.rel, List.reverse_cons, List.append_assoc] + · have hrest := ih (value :: env) abs found htail + simpa [VEnv.rel, List.reverse_cons, List.append_assoc, + Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hrest + +/-- Every static retain descriptor resolves to one protected borrowed value. -/ +def FieldRetainsCovered (retains : List RecursorFieldRetain) + (slots : List (Nat × RVal)) (borrowed : List RVal) : Prop := + ∀ retain ∈ retains, ∃ value, + (retain.fieldAbs, value) ∈ slots ∧ value ∈ borrowed + +/-- Fuel-bounded ownership adapter for an arbitrary field-retain plan. The +shared traversal consumes descriptors; this callback supplies coverage for +each `dup` while preserving protected slots and borrow facts. -/ +private theorem FieldRetainPlan.soundAt {ctx : Ctx} {cur : FnDef} + {limit : Nat} {input output : VEnv} {retains : List RecursorFieldRetain} + {emit : Emit} (hplan : FieldRetainPlan input retains output emit) + (slots : List (Nat × RVal)) (borrowed : List RVal) + (hcovered : FieldRetainsCovered retains slots borrowed) : + ∀ rest, + EmitSoundBelow ctx cur limit emit + (OwnsVEnvBorrowed input rest slots borrowed) + (OwnsVEnvBorrowed output rest slots borrowed) := by + revert hcovered + apply FieldRetainPlan.traverse (hplan := hplan) + · intro Γ hcovered rest + exact EmitSoundBelow.id + · intro Γ output i placeholderAbs fieldAbs remaining retains tailEmit + hentry ih hcovered rest + obtain ⟨value, hslot, hborrow⟩ := + hcovered ⟨i, fieldAbs, remaining⟩ (by simp) + have htailCovered : FieldRetainsCovered retains slots borrowed := by + intro retain hmem + exact hcovered retain (by simp [hmem]) + exact EmitSoundBelow.comp + (retain_borrowed_into_entry_owned_below hentry hslot hborrow) + (ih htailCovered rest) + +/-- Semantic induction for an arbitrary field-retain plan, closed from its +uniformly bounded proof body. -/ +theorem FieldRetainPlan.sound {ctx : Ctx} {cur : FnDef} + {input output : VEnv} {retains : List RecursorFieldRetain} + {emit : Emit} (hplan : FieldRetainPlan input retains output emit) + (slots : List (Nat × RVal)) (borrowed : List RVal) + (hcovered : FieldRetainsCovered retains slots borrowed) : + ∀ rest, + EmitSound ctx cur emit + (OwnsVEnvBorrowed input rest slots borrowed) + (OwnsVEnvBorrowed output rest slots borrowed) := by + intro rest + exact EmitSound.of_below fun limit => + hplan.soundAt (limit := limit) slots borrowed hcovered rest + +/-- Fuel-bounded semantic induction for a field-retain plan. -/ +theorem FieldRetainPlan.soundBelow {ctx : Ctx} {cur : FnDef} + {limit : Nat} {input output : VEnv} + {retains : List RecursorFieldRetain} {emit : Emit} + (hplan : FieldRetainPlan input retains output emit) + (slots : List (Nat × RVal)) (borrowed : List RVal) + (hcovered : FieldRetainsCovered retains slots borrowed) : + ∀ rest, + EmitSoundBelow ctx cur limit emit + (OwnsVEnvBorrowed input rest slots borrowed) + (OwnsVEnvBorrowed output rest slots borrowed) := by + exact hplan.soundAt slots borrowed hcovered + +/-- Semantic fuel-bounded induction for a field-retain plan. In contrast +to `FieldRetainPlan.soundBelow`, the pending retain list itself supplies the +source/target graph witness for each `dup`, so consuming the plan consumes +that list one descriptor at a time. -/ +theorem FieldRetainPlan.valueSoundBelow + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} {retains : List RecursorFieldRetain} + {emit : Emit} (hplan : FieldRetainPlan input retains output emit) : + ∀ sourceEnv sourceRest rest extra slots borrowed, + EmitSoundBelow ctx cur limit emit + (GraphOwnsVEnvRetains funRel recSelfRel input sourceEnv + sourceRest rest extra slots borrowed retains) + (GraphOwnsVEnvRetains funRel recSelfRel output sourceEnv + sourceRest rest extra slots borrowed []) := by + apply FieldRetainPlan.traverse (hplan := hplan) + · intro Γ sourceEnv sourceRest rest extra slots borrowed + exact EmitSoundBelow.id + · intro Γ output i placeholderAbs fieldAbs remaining retains tailEmit + hentry ih sourceEnv sourceRest rest extra slots borrowed + exact EmitSoundBelow.comp + (retain_borrowed_into_entry_value_below + (funRel := funRel) (recSelfRel := recSelfRel) + (sourceEnv := sourceEnv) (sourceRest := sourceRest) + (rest := rest) (extra := extra) (slots := slots) + (borrowed := borrowed) (retains := retains) hentry) + (ih sourceEnv sourceRest rest extra slots borrowed) + +/-- The canonical retain generator is covered by constructor-order runtime +field values of the declared width. -/ +theorem recursorFieldRetains_covered + (fieldAbs fieldCount : Nat) (rhs : IxIR0.Expr) (values : List RVal) + (hlength : values.length = fieldCount) : + FieldRetainsCovered + (recursorFieldRetains fieldAbs rhs fieldCount) + (recursorFieldSlots fieldAbs values) values := by + exact recursorFieldRetains_traverse rhs + (Result := fun currentAbs currentCount retains => + ∀ runtimeValues : List RVal, + runtimeValues.length = currentCount → + FieldRetainsCovered retains + (recursorFieldSlots currentAbs runtimeValues) runtimeValues) + (hnil := by + intro currentAbs runtimeValues hlength + cases runtimeValues with + | nil => + intro retain hmem + simp at hmem + | cons value values => simp at hlength) + (hskip := by + intro currentAbs currentCount tail _ ih runtimeValues hlength + cases runtimeValues with + | nil => simp at hlength + | cons value values => + have htailLength : values.length = currentCount := by + simpa using hlength + have htail := ih values htailLength + intro retain hmem + obtain ⟨found, hslot, hborrow⟩ := htail retain hmem + exact ⟨found, by simp [recursorFieldSlots, hslot], + by simp [hborrow]⟩) + (hretain := by + intro currentAbs currentCount tail _ ih runtimeValues hlength + cases runtimeValues with + | nil => simp at hlength + | cons value values => + have htailLength : values.length = currentCount := by + simpa using hlength + have htail := ih values htailLength + intro retain hmem + rcases List.mem_cons.mp hmem with rfl | hmemTail + · exact ⟨value, by simp [recursorFieldSlots], by simp⟩ + · obtain ⟨found, hslot, hborrow⟩ := htail retain hmemTail + exact ⟨found, by simp [recursorFieldSlots, hslot], + by simp [hborrow]⟩) + fieldAbs fieldCount values hlength + +/-- The canonical retain descriptors select pointwise-related source and +target constructor fields. Constructor fields arrive in constructor order, +whereas the rule environment exposes them in reverse order; the descending +`entry` component of `recursorFieldRetains` is exactly that reversal. -/ +theorem recursorFieldRetains_valueGraphs + {funRel : Sim.FunctionRel} {store : Store} + (fieldAbs fieldCount : Nat) (rhs : IxIR0.Expr) + {sourceValues : List IxIR0.Value} {values : List RVal} + (suffix : List IxIR0.Value) + (hgraphs : Sim.ValuesGraph funRel store sourceValues values) + (hlength : values.length = fieldCount) : + RetainsValueGraphs funRel store + (sourceValues.reverse ++ suffix) + (recursorFieldSlots fieldAbs values) values + (recursorFieldRetains fieldAbs rhs fieldCount) := by + exact recursorFieldRetains_traverse rhs + (Result := fun currentAbs currentCount retains => + ∀ {currentSources : List IxIR0.Value} + {runtimeValues : List RVal} (sourceSuffix : List IxIR0.Value), + Sim.ValuesGraph funRel store currentSources runtimeValues → + runtimeValues.length = currentCount → + RetainsValueGraphs funRel store + (currentSources.reverse ++ sourceSuffix) + (recursorFieldSlots currentAbs runtimeValues) runtimeValues retains) + (hnil := by + intro currentAbs currentSources runtimeValues sourceSuffix hgraphs + hlength + have hvalues : runtimeValues = [] := + List.eq_nil_of_length_eq_zero hlength + subst runtimeValues + cases hgraphs + intro retain hmember + simp at hmember) + (hskip := by + intro currentAbs currentCount tail _ ih currentSources runtimeValues + sourceSuffix hgraphs hlength + cases runtimeValues with + | nil => simp at hlength + | cons value values => + cases hgraphs with + | @cons source value sources values hhead htailGraphs => + have htailLength : values.length = currentCount := by + simpa using hlength + have htail := ih (currentSources := sources) + (runtimeValues := values) (source :: sourceSuffix) htailGraphs + htailLength + intro retain hmember + obtain ⟨foundSource, foundValue, hsource, hslot, + hborrowed, hvalue⟩ := htail retain hmember + exact ⟨foundSource, foundValue, + by simpa [List.reverse_cons, List.append_assoc] using hsource, + by simp [recursorFieldSlots, hslot], by simp [hborrowed], hvalue⟩) + (hretain := by + intro currentAbs currentCount tail _ ih currentSources runtimeValues + sourceSuffix hgraphs hlength + cases runtimeValues with + | nil => simp at hlength + | cons value values => + cases hgraphs with + | @cons source value sources values hhead htailGraphs => + have htailLength : values.length = currentCount := by + simpa using hlength + have hsourcesLength : sources.length = currentCount := + htailGraphs.length.trans htailLength + have htail := ih (currentSources := sources) + (runtimeValues := values) (source :: sourceSuffix) htailGraphs + htailLength + intro retain hmember + rcases List.mem_cons.mp hmember with rfl | hmemberTail + · exact ⟨source, value, + by simp [List.reverse_cons, ← hsourcesLength], + by simp [recursorFieldSlots], by simp, hhead⟩ + · obtain ⟨foundSource, foundValue, hsource, hslot, + hborrowed, hvalue⟩ := htail _ hmemberTail + exact ⟨foundSource, foundValue, + by simpa [List.reverse_cons, List.append_assoc] using hsource, + by simp [recursorFieldSlots, hslot], by simp [hborrowed], + hvalue⟩) + fieldAbs fieldCount suffix hgraphs hlength + +/-- End-to-end executable/semantic certificate for the arbitrary borrowed- +field fold used by `lowerRecursor`, before the major and parameter releases. -/ +theorem recursorFieldRetains_verified {ctx : Ctx} {cur : FnDef} + (fieldAbs depth fieldCount : Nat) (rhs : IxIR0.Expr) + (values : List RVal) (hlength : values.length = fieldCount) : + let dead : VEntry := .slot 0 0 .many false + let input : VEnv := ⟨List.replicate fieldCount dead, depth⟩ + ∃ output emit, + applyRecursorFieldRetains input + (recursorFieldRetains fieldAbs rhs fieldCount) = + (output, emit) ∧ + ∀ rest, + EmitSound ctx cur emit + (OwnsVEnvBorrowed input rest + (recursorFieldSlots fieldAbs values) values) + (OwnsVEnvBorrowed output rest + (recursorFieldSlots fieldAbs values) values) := by + dsimp only + obtain ⟨output, emit, hplan⟩ := + recursorFieldRetains_plan fieldAbs depth fieldCount rhs + have hcovered := + recursorFieldRetains_covered fieldAbs fieldCount rhs values hlength + exact ⟨output, emit, hplan.run, hplan.sound _ _ hcovered⟩ + +/-- Sequential release plans compose, matching list append and emitter +composition. -/ +theorem ReleasePlan.comp {input middle output : VEnv} + {firstDrops secondDrops : List SlotDrop} {firstEmit secondEmit : Emit} + (hfirst : ReleasePlan input firstDrops middle firstEmit) + (hsecond : ReleasePlan middle secondDrops output secondEmit) : + ReleasePlan input (firstDrops ++ secondDrops) output + (firstEmit ∘ secondEmit) := by + apply ReleasePlan.traverse + (Result := fun current initialDrops intermediate initialEmit => + ReleasePlan intermediate secondDrops output secondEmit → + ReleasePlan current (initialDrops ++ secondDrops) output + (initialEmit ∘ secondEmit)) + (hnil := by + intro Γ htail + simpa [Function.comp_def] using htail) + (hmany := by + intro Γ intermediate i abs initialDrops initialEmit hentry ih + htail + simpa [Function.comp_def] using + ReleasePlan.many hentry (ih htail)) + (haffine := by + intro Γ intermediate i abs initialDrops initialEmit hentry ih + htail + simpa [Function.comp_def] using + ReleasePlan.affine hentry (ih htail)) + (hplan := hfirst) + exact hsecond + +/-- Exactly the mode-side condition under which `parameterDrops` can +succeed. Live parameters need no release restriction; a dead parameter must +be shared (`many`) or affine. -/ +def ParameterDropsAdmissible : List Uses → (Nat → Nat) → Prop + | [], _ => True + | mode :: modes, remaining => + ParameterDropsAdmissible modes remaining ∧ + (remaining modes.length = 0 → mode = .many ∨ mode = .affine) + +private theorem frameVEnvEntries_parameterEntries_cons + (base depth : Nat) (mode : Uses) (modes : List Uses) + (remaining : Nat → Nat) : + frameVEnvEntries + ⟨parameterEntries (base + 1) modes remaining, depth⟩ + [.slot base (remaining modes.length) mode true] = + ⟨parameterEntries base (mode :: modes) remaining, depth⟩ := by + simp [frameVEnvEntries, parameterEntries] + +/-- Result-polymorphic traversal for canonical parameter release plans. +Admissibility splitting, tail framing, entry lookup, shared/affine release, +environment advancement, and emitter composition recurse once; clients add +only an invariant of each constructed output environment. -/ +theorem parameterDrops_releasePlan_traverse + (remaining : Nat → Nat) + {Result : Nat → Nat → List Uses → VEnv → Prop} + (hnil : ∀ base depth, Result base depth [] ⟨[], depth⟩) + (hlive : ∀ {base depth : Nat} {mode : Uses} {modes : List Uses} + {innerOutput : VEnv}, + Result (base + 1) depth modes innerOutput → + innerOutput.entries.length = modes.length → + remaining modes.length ≠ 0 → + Result base depth (mode :: modes) + (frameVEnvEntries innerOutput + [.slot base (remaining modes.length) mode true])) + (hmany : ∀ {base depth : Nat} {modes : List Uses} + {innerOutput : VEnv}, + Result (base + 1) depth modes innerOutput → + innerOutput.entries.length = modes.length → + remaining modes.length = 0 → + Result base depth (.many :: modes) + (((frameVEnvEntries innerOutput [.slot base 0 .many true]).setEntry + modes.length (.slot base 0 .many false)).bump)) + (haffine : ∀ {base depth : Nat} {modes : List Uses} + {innerOutput : VEnv}, + Result (base + 1) depth modes innerOutput → + innerOutput.entries.length = modes.length → + remaining modes.length = 0 → + Result base depth (.affine :: modes) + (((frameVEnvEntries innerOutput [.slot base 0 .affine true]).setEntry + modes.length (.slot base 0 .affine false)).bump)) : + ∀ (base depth : Nat) (modes : List Uses), + ParameterDropsAdmissible modes remaining → + ∃ output emit, + ReleasePlan + ⟨parameterEntries base modes remaining, depth⟩ + (parameterDrops base modes remaining) output emit ∧ + Result base depth modes output := by + intro base depth modes hadmissible + induction modes generalizing base depth with + | nil => + exact ⟨⟨[], depth⟩, (_root_.id : Emit), ReleasePlan.nil, + hnil base depth⟩ + | cons mode modes ih => + obtain ⟨htail, hmode⟩ := hadmissible + obtain ⟨innerOutput, innerEmit, hinner, hinnerResult⟩ := + ih (base + 1) depth htail + let outerEntry : VEntry := + .slot base (remaining modes.length) mode true + let framedOutput := frameVEnvEntries innerOutput [outerEntry] + have hinnerFull : ReleasePlan + ⟨parameterEntries base (mode :: modes) remaining, depth⟩ + (parameterDrops (base + 1) modes remaining) + framedOutput innerEmit := by + have hframed := hinner.frameEntries [outerEntry] + rw [frameVEnvEntries_parameterEntries_cons] at hframed + simpa [framedOutput, outerEntry] using hframed + have hlength : innerOutput.entries.length = modes.length := by + calc + innerOutput.entries.length = + (parameterEntries (base + 1) modes remaining).length := + hinner.entries_length + _ = modes.length := parameterEntries_length _ _ _ + by_cases hzero : remaining modes.length = 0 + · rcases hmode hzero with rfl | rfl + · have hentry : framedOutput.entries[modes.length]? = + some (.slot base 0 .many true) := by + simp [framedOutput, frameVEnvEntries, outerEntry, hlength, hzero] + let finalOutput := + (framedOutput.setEntry modes.length + (.slot base 0 .many false)).bump + have houter : ReleasePlan framedOutput + [⟨modes.length, base, .many⟩] finalOutput + (emitOp (.drop (.var (framedOutput.rel base))) ∘ + (_root_.id : Emit)) := by + exact ReleasePlan.many hentry ReleasePlan.nil + refine ⟨finalOutput, innerEmit ∘ + (emitOp (.drop (.var (framedOutput.rel base))) ∘ + (_root_.id : Emit)), ?_, ?_⟩ + · simpa [parameterDrops, hzero] using hinnerFull.comp houter + · simpa [finalOutput, framedOutput, outerEntry, hzero] using + hmany hinnerResult hlength hzero + · have hentry : framedOutput.entries[modes.length]? = + some (.slot base 0 .affine true) := by + simp [framedOutput, frameVEnvEntries, outerEntry, hlength, hzero] + let finalOutput := + (framedOutput.setEntry modes.length + (.slot base 0 .affine false)).bump + have houter : ReleasePlan framedOutput + [⟨modes.length, base, .affine⟩] finalOutput + (emitOp (.dropU (.var (framedOutput.rel base))) ∘ + (_root_.id : Emit)) := by + exact ReleasePlan.affine hentry ReleasePlan.nil + refine ⟨finalOutput, innerEmit ∘ + (emitOp (.dropU (.var (framedOutput.rel base))) ∘ + (_root_.id : Emit)), ?_, ?_⟩ + · simpa [parameterDrops, hzero] using hinnerFull.comp houter + · simpa [finalOutput, framedOutput, outerEntry, hzero] using + haffine hinnerResult hlength hzero + · refine ⟨framedOutput, innerEmit, ?_, ?_⟩ + · simpa [parameterDrops, hzero] using hinnerFull + · simpa [framedOutput, outerEntry] using + hlive hinnerResult hlength hzero + +/-- Canonical parameter entries and drops generate a concrete release plan at +any ambient runtime depth whenever their dead modes are admissible. This is +the form needed after a recursor has pushed field retains and the major-drop +result before releasing its parameters. -/ +theorem parameterDrops_releasePlan_atDepth (base depth : Nat) + (modes : List Uses) + (remaining : Nat → Nat) + (hadmissible : ParameterDropsAdmissible modes remaining) : + ∃ output emit, + ReleasePlan + ⟨parameterEntries base modes remaining, depth⟩ + (parameterDrops base modes remaining) output emit := by + obtain ⟨output, emit, hplan, _⟩ := + parameterDrops_releasePlan_traverse remaining + (Result := fun _ _ _ _ => True) + (hnil := by simp) + (hlive := by simp) + (hmany := by simp) + (haffine := by simp) + base depth modes hadmissible + exact ⟨output, emit, hplan⟩ + +/-- Declaration-entry specialization of +`parameterDrops_releasePlan_atDepth` at the canonical telescope depth. -/ +theorem parameterDrops_releasePlan (base : Nat) (modes : List Uses) + (remaining : Nat → Nat) + (hadmissible : ParameterDropsAdmissible modes remaining) : + ∃ output emit, + ReleasePlan + ⟨parameterEntries base modes remaining, base + modes.length⟩ + (parameterDrops base modes remaining) output emit := + parameterDrops_releasePlan_atDepth base (base + modes.length) + modes remaining hadmissible + +/-- The generated release certificate is stable under the trailing entries +used for a lambda-lifted function's capture environment. The runtime depth is +already accounted for by `base`; framing adds only proof-side entries. -/ +theorem parameterDrops_releasePlan_framed (base : Nat) (modes : List Uses) + (remaining : Nat → Nat) (frame : List VEntry) + (hadmissible : ParameterDropsAdmissible modes remaining) : + ∃ output emit, + ReleasePlan + ⟨parameterEntries base modes remaining ++ frame, + base + modes.length⟩ + (parameterDrops base modes remaining) output emit := by + obtain ⟨output, emit, hplan⟩ := + parameterDrops_releasePlan base modes remaining hadmissible + exact ⟨frameVEnvEntries output frame, emit, + by simpa [frameVEnvEntries] using hplan.frameEntries frame⟩ + +/-- Generated parameter releases remain valid when the parameter telescope +sits between unrelated leading and trailing entries. Leading entries shift +only `SlotDrop.entry`; trailing entries require no descriptor change. -/ +theorem parameterDrops_releasePlan_between + (base depth : Nat) (modes : List Uses) (remaining : Nat → Nat) + (leading trailing : List VEntry) + (hadmissible : ParameterDropsAdmissible modes remaining) : + ∃ output emit, + ReleasePlan + ⟨leading ++ parameterEntries base modes remaining ++ trailing, + depth⟩ + ((parameterDrops base modes remaining).map + (SlotDrop.offsetEntry leading.length)) + output emit := by + obtain ⟨output, emit, hplan⟩ := + parameterDrops_releasePlan_atDepth base depth modes remaining hadmissible + have hframed := hplan.frameEntries trailing + have hbetween := hframed.prependEntries leading + exact ⟨prependVEnvEntries leading (frameVEnvEntries output trailing), + emit, by + simpa [prependVEnvEntries, frameVEnvEntries, List.append_assoc] + using hbetween⟩ + +@[simp] theorem parameterDropsAdmissible_replicate_many + (count : Nat) (remaining : Nat → Nat) : + ParameterDropsAdmissible (List.replicate count .many) remaining := by + induction count with + | zero => simp [ParameterDropsAdmissible] + | succ count ih => + simp [List.replicate_succ, ParameterDropsAdmissible, ih] + +/-- The exact arbitrary pre-major release shape used by `lowerRecursor`: +field entries lead, the canonical all-shared parameter telescope occupies the +middle, and `recSelf` trails. -/ +theorem recursorParameterDrops_releasePlan + (numArgs nf depth : Nat) (rhs : IxIR0.Expr) + (fieldEntries : List VEntry) (hfields : fieldEntries.length = nf) : + ∃ output emit, + ReleasePlan + ⟨fieldEntries ++ + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (nf + i) rhs) ++ + [.recSelf (numArgs + 1)], + depth⟩ + ((parameterDrops 0 (List.replicate numArgs .many) + (fun i => countUses (nf + i) rhs)).map + (SlotDrop.offsetEntry nf)) + output emit := by + have hplan := parameterDrops_releasePlan_between + 0 depth (List.replicate numArgs .many) + (fun i => countUses (nf + i) rhs) + fieldEntries [.recSelf (numArgs + 1)] + (parameterDropsAdmissible_replicate_many numArgs _) + simpa [hfields] using hplan + +/-- A release plan computes the exact successful `releaseSlots` result and +does not mutate the lowering monad state. -/ +theorem ReleasePlan.run {input output : VEnv} {drops : List SlotDrop} + {emit : Emit} (hplan : ReleasePlan input drops output emit) + (state : LowSt) : + (releaseSlots input drops).run state = .ok (output, emit) state := by + apply ReleasePlan.traverse + (Result := fun current pending final pendingEmit => + (releaseSlots current pending).run state = + .ok (final, pendingEmit) state) + (hplan := hplan) + · intro Γ + simp [releaseSlots] + · intro Γ output i abs drops tailEmit hentry ih + simp only [releaseSlots] + rw [estateBindRun] + rw [estatePureRun] + simp only + rw [estateBindRun, ih] + rfl + · intro Γ output i abs drops tailEmit hentry ih + simp only [releaseSlots] + rw [estateBindRun] + rw [estatePureRun] + simp only + rw [estateBindRun, ih] + rfl + +/-- Semantic half of a release plan: every dead parameter root is consumed, +all unrelated roots/protected slots survive, and the returned `VEnv` exactly +tracks the pushed inert results. -/ +def ReleaseSlotsSound (ctx : Ctx) (cur : FnDef) + (input output : VEnv) (emit : Emit) : Prop := + ∀ rest slots, + EmitSound ctx cur emit + (OwnsVEnvProtected input rest slots) + (OwnsVEnvProtected output rest slots) + +/-- Semantic refinement of a successful release sequence. The logical source +environment is unchanged even though its dead target entries become released; +all still-held values and every caller-framed root retain their `ValueGraph`. +-/ +structure ReleaseSlotsValueSound (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (ctx : Ctx) (cur : FnDef) + (input output : VEnv) (sourceEnv : List IxIR0.Value) + (emit : Emit) : Prop where + toReleaseSlotsSound : ReleaseSlotsSound ctx cur input output emit + graphEmits : ∀ sourceRest rest slots, + EmitSound ctx cur emit + (GraphOwnsVEnvProtected funRel recSelfRel input + sourceEnv sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel output + sourceEnv sourceRest rest slots) + +/-- Fuel-bounded semantic result of `releaseSlots`. -/ +def ReleaseSlotsSoundBelow (ctx : Ctx) (cur : FnDef) (limit : Nat) + (input output : VEnv) (emit : Emit) : Prop := + ∀ rest slots, + EmitSoundBelow ctx cur limit emit + (OwnsVEnvProtected input rest slots) + (OwnsVEnvProtected output rest slots) + +/-- Fuel-bounded semantic refinement of a successful release sequence. -/ +structure ReleaseSlotsValueSoundBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (ctx : Ctx) (cur : FnDef) + (limit : Nat) (input output : VEnv) + (sourceEnv : List IxIR0.Value) (emit : Emit) : Prop where + toReleaseSlotsSoundBelow : + ReleaseSlotsSoundBelow ctx cur limit input output emit + graphEmits : ∀ sourceRest rest slots, + EmitSoundBelow ctx cur limit emit + (GraphOwnsVEnvProtected funRel recSelfRel input + sourceEnv sourceRest rest slots) + (GraphOwnsVEnvProtected funRel recSelfRel output + sourceEnv sourceRest rest slots) + +/-- Bounded ownership adapter over the shared release-plan traversal. -/ +private theorem ReleasePlan.soundAt {ctx : Ctx} {cur : FnDef} + {limit : Nat} {input output : VEnv} {drops : List SlotDrop} + {emit : Emit} (hplan : ReleasePlan input drops output emit) : + ReleaseSlotsSoundBelow ctx cur limit input output emit := by + apply ReleasePlan.traverse (hplan := hplan) + · intro Γ rest slots + exact EmitSoundBelow.id + · intro Γ output i abs drops tailEmit hentry ih rest slots + exact EmitSoundBelow.comp + (release_slot_many_owned_below hentry rest slots) + (ih rest slots) + · intro Γ output i abs drops tailEmit hentry ih rest slots + exact EmitSoundBelow.comp + (release_slot_affine_owned_below hentry rest slots) + (ih rest slots) + +/-- Bounded graph adapter over the shared release-plan traversal. -/ +private theorem ReleasePlan.valueSoundAt {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {input output : VEnv} {drops : List SlotDrop} + {emit : Emit} + (hplan : ReleasePlan input drops output emit) + (sourceEnv : List IxIR0.Value) : + ReleaseSlotsValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceEnv emit := by + refine { toReleaseSlotsSoundBelow := hplan.soundAt, graphEmits := ?_ } + intro sourceRest rest slots + apply ReleasePlan.traverse (hplan := hplan) + · intro Γ + exact EmitSoundBelow.id + · intro Γ output i abs drops tailEmit hentry ih + exact EmitSoundBelow.comp + (release_slot_many_value_sound_below hentry + sourceEnv sourceRest rest slots) + ih + · intro Γ output i abs drops tailEmit hentry ih + exact EmitSoundBelow.comp + (release_slot_affine_value_sound_below hentry + sourceEnv sourceRest rest slots) + ih + +/-- The exact ownership transformer is closed from the uniformly bounded +release-plan proof. -/ +theorem ReleasePlan.sound {ctx : Ctx} {cur : FnDef} + {input output : VEnv} {drops : List SlotDrop} {emit : Emit} + (hplan : ReleasePlan input drops output emit) : + ReleaseSlotsSound ctx cur input output emit := by + intro rest slots + exact EmitSound.of_below fun limit => + hplan.soundAt (limit := limit) rest slots + +/-- Every proof-relevant release plan preserves the complete semantic graph +of its unchanged source environment and of the arbitrary caller frame. The +exact interface is closed from the single bounded induction body. -/ +theorem ReleasePlan.valueSound {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + {input output : VEnv} {drops : List SlotDrop} {emit : Emit} + (hplan : ReleasePlan input drops output emit) + (sourceEnv : List IxIR0.Value) : + ReleaseSlotsValueSound funRel recSelfRel ctx cur + input output sourceEnv emit := by + refine { toReleaseSlotsSound := hplan.sound, graphEmits := ?_ } + intro sourceRest rest slots + exact EmitSound.of_below fun limit => + (hplan.valueSoundAt (limit := limit) sourceEnv).graphEmits + sourceRest rest slots + +/-- Fuel-bounded semantic half of a release plan. -/ +theorem ReleasePlan.soundBelow {ctx : Ctx} {cur : FnDef} + {limit : Nat} {input output : VEnv} {drops : List SlotDrop} + {emit : Emit} (hplan : ReleasePlan input drops output emit) : + ReleaseSlotsSoundBelow ctx cur limit input output emit := by + exact hplan.soundAt + +/-- The semantic release transformer is contractive at every evaluator +bound; release operations themselves require no function contracts. -/ +theorem ReleasePlan.valueSoundBelow + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} {drops : List SlotDrop} {emit : Emit} + (hplan : ReleasePlan input drops output emit) + (sourceEnv : List IxIR0.Value) : + ReleaseSlotsValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceEnv emit := by + exact hplan.valueSoundAt sourceEnv + +/-- The canonical declaration-entry releases execute successfully and carry +their ownership transformer without any caller-supplied `ReleasePlan`. -/ +theorem parameterDrops_verified {ctx : Ctx} {cur : FnDef} + (base : Nat) (modes : List Uses) (remaining : Nat → Nat) + (state : LowSt) + (hadmissible : ParameterDropsAdmissible modes remaining) : + ∃ output emit, + (releaseSlots + ⟨parameterEntries base modes remaining, base + modes.length⟩ + (parameterDrops base modes remaining)).run state = + .ok (output, emit) state ∧ + ReleaseSlotsSound ctx cur + ⟨parameterEntries base modes remaining, base + modes.length⟩ + output emit := by + obtain ⟨output, emit, hplan⟩ := + parameterDrops_releasePlan base modes remaining hadmissible + exact ⟨output, emit, hplan.run state, hplan.sound⟩ + +/-- Executable/sound generated releases also cover the trailing entry frame +of a lifted local function. -/ +theorem parameterDrops_framed_verified {ctx : Ctx} {cur : FnDef} + (base : Nat) (modes : List Uses) (remaining : Nat → Nat) + (frame : List VEntry) (state : LowSt) + (hadmissible : ParameterDropsAdmissible modes remaining) : + ∃ output emit, + (releaseSlots + ⟨parameterEntries base modes remaining ++ frame, + base + modes.length⟩ + (parameterDrops base modes remaining)).run state = + .ok (output, emit) state ∧ + ReleaseSlotsSound ctx cur + ⟨parameterEntries base modes remaining ++ frame, + base + modes.length⟩ + output emit := by + obtain ⟨output, emit, hplan⟩ := + parameterDrops_releasePlan_framed base modes remaining frame hadmissible + exact ⟨output, emit, hplan.run state, hplan.sound⟩ + +/-- Arbitrary pre-major cleanup in the refactored recursor executes through +the real `releaseSlots` definition and preserves the exact ownership state. +The only structural premise is that the preceding field-entry block has the +constructor's declared width. -/ +theorem recursorParameterDrops_verified {ctx : Ctx} {cur : FnDef} + (numArgs nf depth : Nat) (rhs : IxIR0.Expr) + (fieldEntries : List VEntry) (hfields : fieldEntries.length = nf) + (state : LowSt) : + ∃ output emit, + (releaseSlots + ⟨fieldEntries ++ + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (nf + i) rhs) ++ + [.recSelf (numArgs + 1)], + depth⟩ + ((parameterDrops 0 (List.replicate numArgs .many) + (fun i => countUses (nf + i) rhs)).map + (SlotDrop.offsetEntry nf))).run state = + .ok (output, emit) state ∧ + ReleaseSlotsSound ctx cur + ⟨fieldEntries ++ + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (nf + i) rhs) ++ + [.recSelf (numArgs + 1)], + depth⟩ + output emit := by + obtain ⟨output, emit, hplan⟩ := + recursorParameterDrops_releasePlan numArgs nf depth rhs + fieldEntries hfields + exact ⟨output, emit, hplan.run state, hplan.sound⟩ + +/-- Prefix a lowered expression proof with a verified dead-parameter release +plan. -/ +theorem LowerResultSound.afterRelease {ctx : Ctx} {cur : FnDef} + {input middle output : VEnv} {releaseEmit emit : Emit} + {world : Owned} {av : AVal} + (hbody : LowerResultSound ctx cur middle output world emit av) + (hrelease : ReleaseSlotsSound ctx cur input middle releaseEmit) : + LowerResultSound ctx cur input output world (releaseEmit ∘ emit) av := by + refine ⟨hbody.stable, ?_⟩ + intro rest slots + exact EmitSound.comp (hrelease rest slots) (hbody.emits rest slots) + +/-- Semantic release-prefix composition. Because release plans leave the +logical source environment intact, their graph transformer feeds directly +into the companion judgment for the following expression. -/ +theorem LowerResultValueSound.afterRelease + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input middle output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {releaseEmit emit : Emit} + {world : Owned} {av : AVal} + (hbody : LowerResultValueSound funRel recSelfRel ctx cur + middle output sourceInput sourceOutput sourceValue world emit av) + (hrelease : ReleaseSlotsValueSound funRel recSelfRel ctx cur + input middle sourceInput releaseEmit) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue world + (releaseEmit ∘ emit) av := by + refine + { toLowerResultSound := hbody.toLowerResultSound.afterRelease + hrelease.toReleaseSlotsSound + graphEmits := ?_ } + intro sourceRest rest slots + exact EmitSound.comp (hrelease.graphEmits sourceRest rest slots) + (hbody.graphEmits sourceRest rest slots) + +/-- Fuel-bounded release-prefix composition. -/ +theorem LowerResultSoundBelow.afterRelease {ctx : Ctx} {cur : FnDef} + {limit : Nat} {input middle output : VEnv} + {releaseEmit emit : Emit} {world : Owned} {av : AVal} + (hbody : LowerResultSoundBelow ctx cur limit middle output world emit av) + (hrelease : ReleaseSlotsSoundBelow ctx cur limit + input middle releaseEmit) : + LowerResultSoundBelow ctx cur limit input output world + (releaseEmit ∘ emit) av := by + refine ⟨hbody.stable, ?_⟩ + intro rest slots + exact EmitSoundBelow.comp (hrelease rest slots) (hbody.emits rest slots) + +/-- Fuel-bounded semantic release-prefix composition. -/ +theorem LowerResultValueSoundBelow.afterRelease + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input middle output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {releaseEmit emit : Emit} + {world : Owned} {av : AVal} + (hbody : LowerResultValueSoundBelow funRel recSelfRel ctx cur limit + middle output sourceInput sourceOutput sourceValue world emit av) + (hrelease : ReleaseSlotsValueSoundBelow funRel recSelfRel ctx cur limit + input middle sourceInput releaseEmit) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceValue world + (releaseEmit ∘ emit) av := by + refine + { toLowerResultSoundBelow := + hbody.toLowerResultSoundBelow.afterRelease + hrelease.toReleaseSlotsSoundBelow + graphEmits := ?_ } + intro sourceRest rest slots + exact EmitSoundBelow.comp + (hrelease.graphEmits sourceRest rest slots) + (hbody.graphEmits sourceRest rest slots) + +/-- Generic executable/proof rule for `lowerFnBody`: first execute a +`ReleasePlan`, then reuse an already verified `lowerE` result, and finally +close with the exact `ret` emitted by the lowerer. -/ +theorem lowerFnBody_verified {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) + (input middle output : VEnv) (drops : List SlotDrop) + (world : Owned) (body : IxIR0.Expr) + (releaseEmit emit : Emit) (av : AVal) + (state finalState : LowSt) + (hplan : ReleasePlan input drops middle releaseEmit) + (hbodyRun : (lowerE src fuel middle world body).run state = + .ok (output, emit, av) finalState) + (hbody : LowerResultSound ctx cur middle output world emit av) : + (lowerFnBody src (Nat.succ fuel) input drops world body).run state = + .ok ((releaseEmit ∘ emit) (.ret (av.toAtom output))) finalState ∧ + LowerResultSound ctx cur input output world (releaseEmit ∘ emit) av := by + constructor + · simp only [lowerFnBody] + rw [estateBindRun, hplan.run state] + simp only + rw [estateBindRun, hbodyRun] + rfl + · exact hbody.afterRelease hplan.sound + +private theorem lower_held_move_sound_at {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} {i abs remaining : Nat} {uses : Uses} + (hentry : Γ.entries[i]? = some (.slot abs remaining uses true)) : + LowerResultSoundBelow ctx cur limit Γ + (Γ.setEntry i (.slot abs 0 uses false)) (worldOfUses uses) + (_root_.id : Emit) (.slotA abs) := by + refine ⟨.slot, ?_⟩ + intro rest slots + apply EmitSoundBelow.strengthen + intro store env hpre + obtain ⟨⟨roots, hΓ, hown⟩, hslots⟩ := hpre + obtain ⟨value, before, after, hbound, hslot, hroots, hout⟩ := + hΓ.entries.releaseAt hentry + refine ⟨⟨before ++ after, value, hΓ.setEntry hout, ?_, ?_⟩, + hslots.setEntry⟩ + · apply AValRealizes.slot + · simpa [VEnv.setEntry] using hbound + · simpa [VEnv.setEntry, VEnv.rel] using hslot + · rw [hroots] at hown + exact hown.perm + (perm_extract_root ⟨worldOfUses uses, value⟩ before after rest) + +private theorem lower_held_move_value_sound_at + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {i abs remaining : Nat} {uses : Uses} + (hsource : sourceEnv[i]? = some sourceValue) + (hentry : Γ.entries[i]? = some (.slot abs remaining uses true)) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit Γ + (Γ.setEntry i (.slot abs 0 uses false)) + sourceEnv sourceEnv sourceValue (worldOfUses uses) + (_root_.id : Emit) (.slotA abs) := by + refine + { toLowerResultSoundBelow := lower_held_move_sound_at hentry + graphEmits := ?_ } + intro sourceRest rest slots + apply EmitSoundBelow.strengthen + intro store env hpre + obtain ⟨⟨roots, hΓ, hrestGraph, hown⟩, hslots⟩ := hpre + obtain ⟨foundSource, value, before, after, hfoundSource, hbound, + hslot, _, hvalue, hroots, hout⟩ := + hΓ.entries.releaseAt hentry + have hsourceEq : foundSource = sourceValue := + Option.some.inj (hfoundSource.symm.trans hsource) + subst foundSource + refine ⟨⟨before ++ after, value, hΓ.setEntry hout, ?_, hvalue, + hrestGraph, ?_⟩, hslots.setEntry⟩ + · apply AValRealizes.slot + · simpa [VEnv.setEntry] using hbound + · simpa [VEnv.setEntry, VEnv.rel] using hslot + · rw [hroots] at hown + exact hown.perm + (perm_extract_root ⟨worldOfUses uses, value⟩ before after rest) + +/-- A final variable occurrence moves its existing owner from an arbitrary +held `VEnv` entry to the distinguished expression-result root. This one rule +covers shared, affine, and linear moves; no target operation is emitted. -/ +theorem lower_var_move_sound {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {i abs : Nat} {uses : Uses} + (hentry : Γ.entries[i]? = some (.slot abs 1 uses true)) : + LowerResultSound ctx cur Γ + (Γ.setEntry i (.slot abs 0 uses false)) (worldOfUses uses) + (_root_.id : Emit) (.slotA abs) := by + apply LowerResultSound.of_below + intro limit + exact lower_held_move_sound_at (limit := limit) hentry + +/-- Semantic final-use variable rule. The source evaluator lookup and the +held target slot identify the same value through `ValueGraph`, while the +existing ownership theorem remains the parent refinement. -/ +theorem lower_var_move_value_sound {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {i abs : Nat} {uses : Uses} + (hsource : sourceEnv[i]? = some sourceValue) + (hentry : Γ.entries[i]? = some (.slot abs 1 uses true)) : + LowerResultValueSound funRel recSelfRel ctx cur Γ + (Γ.setEntry i (.slot abs 0 uses false)) + sourceEnv sourceEnv sourceValue (worldOfUses uses) + (_root_.id : Emit) (.slotA abs) := by + apply LowerResultValueSound.of_below + intro limit + exact lower_held_move_value_sound_at (limit := limit) hsource hentry + +/-- Fuel-bounded move of a held entry. The compiler-side remaining counter is +irrelevant to the ownership transfer; local-lambda capture uses this generic +form to discharge several syntactic occurrences at once. -/ +theorem lower_held_move_sound_below {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} {i abs remaining : Nat} {uses : Uses} + (hentry : Γ.entries[i]? = some (.slot abs remaining uses true)) : + LowerResultSoundBelow ctx cur limit Γ + (Γ.setEntry i (.slot abs 0 uses false)) (worldOfUses uses) + (_root_.id : Emit) (.slotA abs) := by + exact lower_held_move_sound_at hentry + +/-- Unbounded ownership interface for moving an arbitrary held entry. -/ +theorem lower_held_move_sound {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {i abs remaining : Nat} {uses : Uses} + (hentry : Γ.entries[i]? = some (.slot abs remaining uses true)) : + LowerResultSound ctx cur Γ + (Γ.setEntry i (.slot abs 0 uses false)) (worldOfUses uses) + (_root_.id : Emit) (.slotA abs) := by + apply LowerResultSound.of_below + intro limit + exact lower_held_move_sound_below (limit := limit) hentry + +/-- Semantic counterpart of an arbitrary held-entry move. This is the +capture case in which all remaining source occurrences move into the pap. -/ +theorem lower_held_move_value_sound {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {i abs remaining : Nat} {uses : Uses} + (hsource : sourceEnv[i]? = some sourceValue) + (hentry : Γ.entries[i]? = some (.slot abs remaining uses true)) : + LowerResultValueSound funRel recSelfRel ctx cur Γ + (Γ.setEntry i (.slot abs 0 uses false)) + sourceEnv sourceEnv sourceValue (worldOfUses uses) + (_root_.id : Emit) (.slotA abs) := by + apply LowerResultValueSound.of_below + intro limit + exact lower_held_move_value_sound_at (limit := limit) hsource hentry + +theorem lower_held_move_value_sound_below {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {i abs remaining : Nat} {uses : Uses} + (hsource : sourceEnv[i]? = some sourceValue) + (hentry : Γ.entries[i]? = some (.slot abs remaining uses true)) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit Γ + (Γ.setEntry i (.slot abs 0 uses false)) + sourceEnv sourceEnv sourceValue (worldOfUses uses) + (_root_.id : Emit) (.slotA abs) := by + exact lower_held_move_value_sound_at hsource hentry + +/-- Ordinary final variable use specializes the generic held-entry move to +remaining count one. -/ +theorem lower_var_move_sound_below {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} {i abs : Nat} {uses : Uses} + (hentry : Γ.entries[i]? = some (.slot abs 1 uses true)) : + LowerResultSoundBelow ctx cur limit Γ + (Γ.setEntry i (.slot abs 0 uses false)) (worldOfUses uses) + (_root_.id : Emit) (.slotA abs) := + lower_held_move_sound_below hentry + +/-- A final shared variable occurrence in borrowing position moves its owner +out of the environment and records that the projection caller must release +that owner after fetching the field. -/ +theorem lower_var_shared_move_borrow_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {i abs : Nat} {uses : Uses} + (hworld : worldOfUses uses = .shared) + (hentry : Γ.entries[i]? = some (.slot abs 1 uses true)) : + LowerBorrowSoundBelow ctx cur limit Γ + (Γ.setEntry i (.slot abs 0 uses false)) (_root_.id : Emit) + (.slotA abs) true := by + have hmove := lower_var_move_sound_below + (ctx := ctx) (cur := cur) (limit := limit) hentry + have hshared : LowerResultSoundBelow ctx cur limit Γ + (Γ.setEntry i (.slot abs 0 uses false)) .shared + (_root_.id : Emit) (.slotA abs) := by + simpa [hworld] using hmove + exact hshared.asBorrowSlot + +/-- Unbounded ownership interface for a final shared variable borrow. -/ +theorem lower_var_shared_move_borrow_sound + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {i abs : Nat} {uses : Uses} + (hworld : worldOfUses uses = .shared) + (hentry : Γ.entries[i]? = some (.slot abs 1 uses true)) : + LowerBorrowSound ctx cur Γ + (Γ.setEntry i (.slot abs 0 uses false)) (_root_.id : Emit) + (.slotA abs) true := by + apply LowerBorrowSound.of_below + intro limit + exact lower_var_shared_move_borrow_sound_below + (limit := limit) hworld hentry + +private theorem lower_var_shared_move_borrow_value_sound_at + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {i abs : Nat} {uses : Uses} + (hsource : sourceEnv[i]? = some sourceValue) + (hworld : worldOfUses uses = .shared) + (hentry : Γ.entries[i]? = some (.slot abs 1 uses true)) : + LowerBorrowValueSoundBelow funRel recSelfRel ctx cur limit Γ + (Γ.setEntry i (.slot abs 0 uses false)) + sourceEnv sourceEnv sourceValue (_root_.id : Emit) + (.slotA abs) true := by + have hmove := lower_held_move_value_sound_at + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) hsource hentry + have hshared : LowerResultValueSoundBelow funRel recSelfRel ctx cur limit + Γ (Γ.setEntry i (.slot abs 0 uses false)) + sourceEnv sourceEnv sourceValue .shared + (_root_.id : Emit) (.slotA abs) := by + simpa [hworld] using hmove + exact hshared.asBorrowSlot + +/-- Semantic final shared-variable borrow. The moved result graph becomes the +pending borrow owner consumed by the projection caller. -/ +theorem lower_var_shared_move_borrow_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {i abs : Nat} {uses : Uses} + (hsource : sourceEnv[i]? = some sourceValue) + (hworld : worldOfUses uses = .shared) + (hentry : Γ.entries[i]? = some (.slot abs 1 uses true)) : + LowerBorrowValueSound funRel recSelfRel ctx cur Γ + (Γ.setEntry i (.slot abs 0 uses false)) + sourceEnv sourceEnv sourceValue (_root_.id : Emit) + (.slotA abs) true := by + apply LowerBorrowValueSound.of_below + intro limit + exact lower_var_shared_move_borrow_value_sound_at + (limit := limit) hsource hworld hentry + +theorem lower_var_shared_move_borrow_value_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {i abs : Nat} {uses : Uses} + (hsource : sourceEnv[i]? = some sourceValue) + (hworld : worldOfUses uses = .shared) + (hentry : Γ.entries[i]? = some (.slot abs 1 uses true)) : + LowerBorrowValueSoundBelow funRel recSelfRel ctx cur limit Γ + (Γ.setEntry i (.slot abs 0 uses false)) + sourceEnv sourceEnv sourceValue (_root_.id : Emit) + (.slotA abs) true := by + exact lower_var_shared_move_borrow_value_sound_at hsource hworld hentry + +/-- A repeated shared variable borrow decrements its remaining-use counter +without duplicating the owner. The owner remains in the output `VEnv`, while +the returned descriptor carries only a shared borrow. -/ +theorem lower_var_shared_borrow_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {i abs remaining : Nat} {uses : Uses} + (hworld : worldOfUses uses = .shared) + (hentry : Γ.entries[i]? = + some (.slot abs (Nat.succ (Nat.succ remaining)) uses true)) : + let Γ' := Γ.setEntry i (.slot abs (Nat.succ remaining) uses true) + LowerBorrowSoundBelow ctx cur limit Γ Γ' (_root_.id : Emit) + (.slotA abs) false := by + dsimp only + refine ⟨.slot, ?_⟩ + intro rest slots + apply EmitSoundBelow.strengthen + intro store env hpre + obtain ⟨⟨roots, hΓ, hown⟩, hslots⟩ := hpre + obtain ⟨value, hbound, hslot, hmem, hupdated⟩ := + hΓ.entries.updateHeldAt (Nat.succ remaining) hentry + let Γ' := Γ.setEntry i (.slot abs (Nat.succ remaining) uses true) + have hΓ' : VEnvRealizes Γ' env roots := hΓ.setEntry hupdated + have hav : AValRealizes Γ' env (.slotA abs) value := by + apply AValRealizes.slot + · simpa [Γ', VEnv.setEntry] using hbound + · simpa [Γ', VEnv.setEntry, VEnv.rel] using hslot + have hvalueWorld : HasWorld store .shared value := by + apply hown.roots_world ⟨.shared, value⟩ + exact List.mem_append_left rest (by simpa [hworld] using hmem) + refine ⟨⟨roots, value, hΓ', hav, hvalueWorld, ?_⟩, + hslots.setEntry⟩ + simpa [borrowResultRoots] using hown + +/-- Unbounded ownership interface for a repeated shared variable borrow. -/ +theorem lower_var_shared_borrow_sound + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {i abs remaining : Nat} {uses : Uses} + (hworld : worldOfUses uses = .shared) + (hentry : Γ.entries[i]? = + some (.slot abs (Nat.succ (Nat.succ remaining)) uses true)) : + let Γ' := Γ.setEntry i (.slot abs (Nat.succ remaining) uses true) + LowerBorrowSound ctx cur Γ Γ' (_root_.id : Emit) + (.slotA abs) false := by + apply LowerBorrowSound.of_below + intro limit + exact lower_var_shared_borrow_sound_below + (limit := limit) hworld hentry + +private theorem lower_var_shared_borrow_value_sound_at + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {i abs remaining : Nat} {uses : Uses} + (hsource : sourceEnv[i]? = some sourceValue) + (hworld : worldOfUses uses = .shared) + (hentry : Γ.entries[i]? = + some (.slot abs (Nat.succ (Nat.succ remaining)) uses true)) : + let Γ' := Γ.setEntry i (.slot abs (Nat.succ remaining) uses true) + LowerBorrowValueSoundBelow funRel recSelfRel ctx cur limit Γ Γ' + sourceEnv sourceEnv sourceValue (_root_.id : Emit) + (.slotA abs) false := by + dsimp only + refine + { toLowerBorrowSoundBelow := + lower_var_shared_borrow_sound_below hworld hentry + graphEmits := ?_ } + intro sourceRest rest slots + apply EmitSoundBelow.strengthen + intro store env hpre + obtain ⟨⟨roots, hΓ, hrestGraph, hown⟩, hslots⟩ := hpre + obtain ⟨foundSource, value, hfoundSource, hbound, hslot, + hvalueWorld, hvalueGraph, _, hupdated⟩ := + hΓ.entries.updateHeldAt (Nat.succ remaining) hentry + have hsourceEq : foundSource = sourceValue := + Option.some.inj (hfoundSource.symm.trans hsource) + subst foundSource + let Γ' := Γ.setEntry i + (.slot abs (Nat.succ remaining) uses true) + have hΓ' : VEnvValueGraph funRel recSelfRel store Γ' + sourceEnv env roots := hΓ.setEntry hupdated + have hav : AValRealizes Γ' env (.slotA abs) value := by + apply AValRealizes.slot + · simpa [Γ', VEnv.setEntry] using hbound + · simpa [Γ', VEnv.setEntry, VEnv.rel] using hslot + have hshared : HasWorld store .shared value := by + simpa [hworld] using hvalueWorld + refine ⟨roots, value, hΓ', hav, hshared, hvalueGraph, + hrestGraph, ?_, hslots.setEntry⟩ + simpa [borrowResultRoots] using hown + +/-- Semantic repeated shared-variable borrow. Updating the static use count +leaves the runtime owner in the environment, and the returned descriptor +reuses its existing source graph without an RC operation. -/ +theorem lower_var_shared_borrow_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {i abs remaining : Nat} {uses : Uses} + (hsource : sourceEnv[i]? = some sourceValue) + (hworld : worldOfUses uses = .shared) + (hentry : Γ.entries[i]? = + some (.slot abs (Nat.succ (Nat.succ remaining)) uses true)) : + let Γ' := Γ.setEntry i (.slot abs (Nat.succ remaining) uses true) + LowerBorrowValueSound funRel recSelfRel ctx cur Γ Γ' + sourceEnv sourceEnv sourceValue (_root_.id : Emit) + (.slotA abs) false := by + apply LowerBorrowValueSound.of_below + intro limit + exact lower_var_shared_borrow_value_sound_at + (limit := limit) hsource hworld hentry + +theorem lower_var_shared_borrow_value_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {i abs remaining : Nat} {uses : Uses} + (hsource : sourceEnv[i]? = some sourceValue) + (hworld : worldOfUses uses = .shared) + (hentry : Γ.entries[i]? = + some (.slot abs (Nat.succ (Nat.succ remaining)) uses true)) : + let Γ' := Γ.setEntry i (.slot abs (Nat.succ remaining) uses true) + LowerBorrowValueSoundBelow funRel recSelfRel ctx cur limit Γ Γ' + sourceEnv sourceEnv sourceValue (_root_.id : Emit) + (.slotA abs) false := by + exact lower_var_shared_borrow_value_sound_at hsource hworld hentry + +private theorem lower_held_retain_sound_at {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} {i abs remaining newRemaining : Nat} + {uses : Uses} + (hworldOfUses : worldOfUses uses = .shared) + (hentry : Γ.entries[i]? = some (.slot abs remaining uses true)) : + let Γ' := Γ.setEntry i (.slot abs newRemaining uses true) + LowerResultSoundBelow ctx cur limit Γ Γ'.bump .shared + (emitOp (.dup (.var (Γ'.rel abs)))) (.slotA Γ'.depth) := by + dsimp only + refine ⟨.slot, ?_⟩ + intro rest slots + apply OpSoundBelow.emit + intro fuel store env store' result _ hpre hrun + obtain ⟨⟨roots, hΓ, hown⟩, hslots⟩ := hpre + obtain ⟨value, hbound, hslot, hmem, hupdated⟩ := + hΓ.entries.updateHeldAt newRemaining hentry + let Γ' := Γ.setEntry i (.slot abs newRemaining uses true) + have hΓ' : VEnvRealizes Γ' env roots := hΓ.setEntry hupdated + have hav : AValRealizes Γ' env (.slotA abs) value := by + apply AValRealizes.slot + · simpa [Γ', VEnv.setEntry] using hbound + · simpa [Γ', VEnv.setEntry, VEnv.rel] using hslot + have hworld : HasWorld store .shared value := by + have hroot := hown.roots_world ⟨Owned.shared, value⟩ + (List.mem_append_left _ (by simpa [hworldOfUses] using hmem)) + exact hroot + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + obtain ⟨middle, heval, hmiddle⟩ := + runOp_retain_borrowed (ctx := ctx) (cur := cur) (fuel := fuel) + hav.resolveAtom hworld hown + have hpair : (middle, value) = (store', result) := + Except.ok.inj (heval.symm.trans hrun) + cases hpair + refine ⟨⟨roots, result, hΓ'.bump result, ?_, hmiddle⟩, + hslots.setEntry.bump result⟩ + · apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +private theorem lower_held_retain_value_sound_at + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {i abs remaining newRemaining : Nat} {uses : Uses} + (hsource : sourceEnv[i]? = some sourceValue) + (hworldOfUses : worldOfUses uses = .shared) + (hentry : Γ.entries[i]? = some (.slot abs remaining uses true)) : + let Γ' := Γ.setEntry i (.slot abs newRemaining uses true) + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit Γ Γ'.bump + sourceEnv sourceEnv sourceValue .shared + (emitOp (.dup (.var (Γ'.rel abs)))) (.slotA Γ'.depth) := by + dsimp only + refine + { toLowerResultSoundBelow := + lower_held_retain_sound_at hworldOfUses hentry + graphEmits := ?_ } + intro sourceRest rest slots + apply OpSoundBelow.emit + intro fuel store env store' result _ hpre hrun + obtain ⟨⟨roots, hΓ, hrestGraph, hown⟩, hslots⟩ := hpre + obtain ⟨foundSource, value, hfoundSource, hbound, hslot, + hvalueWorld, hvalue, _, hupdated⟩ := + hΓ.entries.updateHeldAt newRemaining hentry + have hsourceEq : foundSource = sourceValue := + Option.some.inj (hfoundSource.symm.trans hsource) + subst foundSource + let Γ' := Γ.setEntry i (.slot abs newRemaining uses true) + have hΓ' : VEnvValueGraph funRel recSelfRel store Γ' + sourceEnv env roots := hΓ.setEntry hupdated + have hav : AValRealizes Γ' env (.slotA abs) value := by + apply AValRealizes.slot + · simpa [Γ', VEnv.setEntry] using hbound + · simpa [Γ', VEnv.setEntry, VEnv.rel] using hslot + have hshared : HasWorld store .shared value := by + simpa [hworldOfUses] using hvalueWorld + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + obtain ⟨middle, heval, hstore, hresultGraph, hmiddle⟩ := + runOp_retain_borrowed_valueGraph + (ctx := ctx) (cur := cur) (fuel := fuel) + hav.resolveAtom hshared hvalue hown + have hpair : (middle, value) = (store', result) := + Except.ok.inj (heval.symm.trans hrun) + cases hpair + have hΓmiddle : VEnvValueGraph funRel recSelfRel store' Γ' + sourceEnv env roots := hΓ'.monoStore hstore + have hrestGraph' : Sim.RootsGraph funRel store' sourceRest rest := + hrestGraph.monoStore hstore + refine ⟨⟨roots, result, hΓmiddle.bump result, ?_, hresultGraph, + hrestGraph', hmiddle⟩, hslots.setEntry.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +/-- A non-final `many` occurrence retains the selected shared owner, pushes +the duplicate into a fresh absolute slot, and leaves the original entry held +with one fewer remaining source use. -/ +theorem lower_var_many_dup_sound {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {i abs remaining : Nat} + (hentry : Γ.entries[i]? = + some (.slot abs (Nat.succ (Nat.succ remaining)) .many true)) : + let Γ' := Γ.setEntry i (.slot abs (Nat.succ remaining) .many true) + LowerResultSound ctx cur Γ Γ'.bump .shared + (emitOp (.dup (.var (Γ'.rel abs)))) (.slotA Γ'.depth) := by + apply LowerResultSound.of_below + intro limit + exact lower_held_retain_sound_at (limit := limit) (by rfl) hentry + +/-- Semantic non-final shared-variable rule. `dup` changes only one +reference count, so `StoreGraphExtends` transports every older environment +graph while the returned owner realizes the same source variable. -/ +theorem lower_var_many_dup_value_sound {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {i abs remaining : Nat} + (hsource : sourceEnv[i]? = some sourceValue) + (hentry : Γ.entries[i]? = + some (.slot abs (Nat.succ (Nat.succ remaining)) .many true)) : + let Γ' := Γ.setEntry i + (.slot abs (Nat.succ remaining) .many true) + LowerResultValueSound funRel recSelfRel ctx cur Γ Γ'.bump + sourceEnv sourceEnv sourceValue .shared + (emitOp (.dup (.var (Γ'.rel abs)))) (.slotA Γ'.depth) := by + apply LowerResultValueSound.of_below + intro limit + exact lower_held_retain_value_sound_at + (limit := limit) hsource (by rfl) hentry + +/-- Retain a held shared entry while replacing its compiler-side remaining +counter by an arbitrary smaller count. Ordinary variable duplication lowers +it by one; lambda capture lowers it by the whole captured occurrence count. -/ +theorem lower_held_retain_sound_below {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} {i abs remaining newRemaining : Nat} + {uses : Uses} + (hworldOfUses : worldOfUses uses = .shared) + (hentry : Γ.entries[i]? = + some (.slot abs remaining uses true)) : + let Γ' := Γ.setEntry i (.slot abs newRemaining uses true) + LowerResultSoundBelow ctx cur limit Γ Γ'.bump .shared + (emitOp (.dup (.var (Γ'.rel abs)))) (.slotA Γ'.depth) := by + exact lower_held_retain_sound_at hworldOfUses hentry + +/-- Unbounded ownership interface for retaining a held shared entry while +installing an arbitrary residual source-use count. -/ +theorem lower_held_retain_sound {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {i abs remaining newRemaining : Nat} {uses : Uses} + (hworldOfUses : worldOfUses uses = .shared) + (hentry : Γ.entries[i]? = some (.slot abs remaining uses true)) : + let Γ' := Γ.setEntry i (.slot abs newRemaining uses true) + LowerResultSound ctx cur Γ Γ'.bump .shared + (emitOp (.dup (.var (Γ'.rel abs)))) (.slotA Γ'.depth) := by + apply LowerResultSound.of_below + intro limit + exact lower_held_retain_sound_below + (limit := limit) hworldOfUses hentry + +/-- Semantic arbitrary-count retain. Allocation and all older value graphs +survive the single RC increment through `StoreGraphExtends`. -/ +theorem lower_held_retain_value_sound {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {i abs remaining newRemaining : Nat} {uses : Uses} + (hsource : sourceEnv[i]? = some sourceValue) + (hworldOfUses : worldOfUses uses = .shared) + (hentry : Γ.entries[i]? = some (.slot abs remaining uses true)) : + let Γ' := Γ.setEntry i (.slot abs newRemaining uses true) + LowerResultValueSound funRel recSelfRel ctx cur Γ Γ'.bump + sourceEnv sourceEnv sourceValue .shared + (emitOp (.dup (.var (Γ'.rel abs)))) (.slotA Γ'.depth) := by + apply LowerResultValueSound.of_below + intro limit + exact lower_held_retain_value_sound_at + (limit := limit) hsource hworldOfUses hentry + +/-- Fuel-bounded semantic arbitrary-count retain. The graph proof is local +to the emitted `dup`, so it does not require any recursive compiler value +contract at the surrounding evaluator bound. -/ +theorem lower_held_retain_value_sound_below {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {i abs remaining newRemaining : Nat} {uses : Uses} + (hsource : sourceEnv[i]? = some sourceValue) + (hworldOfUses : worldOfUses uses = .shared) + (hentry : Γ.entries[i]? = some (.slot abs remaining uses true)) : + let Γ' := Γ.setEntry i (.slot abs newRemaining uses true) + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit Γ Γ'.bump + sourceEnv sourceEnv sourceValue .shared + (emitOp (.dup (.var (Γ'.rel abs)))) (.slotA Γ'.depth) := by + exact lower_held_retain_value_sound_at hsource hworldOfUses hentry + +/-- Fuel-bounded semantic non-final variable use. -/ +theorem lower_var_shared_dup_value_sound_below {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {i abs remaining : Nat} {uses : Uses} + (hsource : sourceEnv[i]? = some sourceValue) + (hworldOfUses : worldOfUses uses = .shared) + (hentry : Γ.entries[i]? = + some (.slot abs (Nat.succ (Nat.succ remaining)) uses true)) : + let Γ' := Γ.setEntry i (.slot abs (Nat.succ remaining) uses true) + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit Γ Γ'.bump + sourceEnv sourceEnv sourceValue .shared + (emitOp (.dup (.var (Γ'.rel abs)))) (.slotA Γ'.depth) := by + exact lower_held_retain_value_sound_below hsource hworldOfUses hentry + +/-- Fuel-bounded non-final use in the shared world. This also covers an +erased-use entry should one appear in an arbitrary input `VEnv`; generated +environments normally eliminate those entries before lowering. -/ +theorem lower_var_shared_dup_sound_below {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} {i abs remaining : Nat} {uses : Uses} + (hworldOfUses : worldOfUses uses = .shared) + (hentry : Γ.entries[i]? = + some (.slot abs (Nat.succ (Nat.succ remaining)) uses true)) : + let Γ' := Γ.setEntry i (.slot abs (Nat.succ remaining) uses true) + LowerResultSoundBelow ctx cur limit Γ Γ'.bump .shared + (emitOp (.dup (.var (Γ'.rel abs)))) (.slotA Γ'.depth) := by + exact lower_held_retain_sound_below hworldOfUses hentry + +/-- The ordinary `.many` specialization of shared duplication. -/ +theorem lower_var_many_dup_sound_below {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} {i abs remaining : Nat} + (hentry : Γ.entries[i]? = + some (.slot abs (Nat.succ (Nat.succ remaining)) .many true)) : + let Γ' := Γ.setEntry i (.slot abs (Nat.succ remaining) .many true) + LowerResultSoundBelow ctx cur limit Γ Γ'.bump .shared + (emitOp (.dup (.var (Γ'.rel abs)))) (.slotA Γ'.depth) := by + exact lower_var_shared_dup_sound_below (by rfl) hentry + +/-! ## Lambda-capture lowering -/ + +/-- Canonical entry environment of a generated lifted function, factored +from `lowerLam` so compiler provenance can name the exact body-lowering run. -/ +def liftedBodyVEnv (entryCount : Nat) (expr : IxIR0.Expr) : VEnv := + let parameterCount := lamArity expr + let modes := lamUses expr + let body := stripLams expr + let captures := liftCaptureIndices entryCount expr + ⟨parameterEntries captures.length modes (fun index => + countUses index body) ++ + selectedEntriesFrom + (fun index => countUses index expr > 0) + (fun index => countUses (parameterCount + index) body) + (List.range entryCount) 0, + captures.length + parameterCount⟩ + +/-- Canonical dead-parameter release plan paired with `liftedBodyVEnv`. -/ +def liftedBodyDrops (entryCount : Nat) (expr : IxIR0.Expr) : + List SlotDrop := + let body := stripLams expr + let captures := liftCaptureIndices entryCount expr + parameterDrops captures.length (lamUses expr) + (fun index => countUses index body) + +/-- Concrete provenance of a lifted declaration in an accumulated compiler +state. Its code must be the exact result of lowering the canonical stripped +lambda body, and the matching declaration must occur in `state.extra`. -/ +def CompilerLiftCodeRel (src : IxIR0.Env) (state : LowSt) : LiftCodeRel := + fun address entryCount expr => + ∃ fuel initial generated code, + papSafe expr = true ∧ + (lowerFnBody src fuel (liftedBodyVEnv entryCount expr) + (liftedBodyDrops entryCount expr) .shared (stripLams expr)).run + initial = .ok code generated ∧ + ExtraExtends generated state ∧ + (address, .fn + ⟨(liftCaptureIndices entryCount expr).length + lamArity expr, + .shared, true, code⟩) ∈ state.extra + +/-- The lowering-specific function oracle for generated lifted paps in one +final compiler state. -/ +abbrev CompilerLiftedFunctionRel (src : IxIR0.Env) (state : LowSt) : + Sim.FunctionRel := + LiftedFunctionRel (CompilerLiftCodeRel src state) + +/-- Exact lifted-body provenance survives later declaration generation. -/ +theorem CompilerLiftCodeRel.monoState {src : IxIR0.Env} + {initial final : LowSt} (hextends : ExtraExtends initial final) + {address : Ixon.Address} {entryCount : Nat} {expr : IxIR0.Expr} + (h : CompilerLiftCodeRel src initial address entryCount expr) : + CompilerLiftCodeRel src final address entryCount expr := by + obtain ⟨fuel, bodyInitial, generated, code, hsafe, hrun, hgenerated, + hmember⟩ := h + exact ⟨fuel, bodyInitial, generated, code, hsafe, hrun, + hgenerated.trans hextends, + hextends.extra_mem hmember⟩ + +theorem CompilerLiftedFunctionRel.monoState {src : IxIR0.Env} + {initial final : LowSt} (hextends : ExtraExtends initial final) + {value : IxIR0.Value} {address : Ixon.Address} {arity : Nat} + {captures : List IxIR0.Value} + (h : CompilerLiftedFunctionRel src initial value address arity captures) : + CompilerLiftedFunctionRel src final value address arity captures := by + apply h.mono + intro generatedAddress entryCount expr hlift + exact hlift.monoState hextends + +/-! ### Generated-declaration provenance -/ + +/-- Operational origin of one declaration accumulated by the lowerer. Eta +wrappers are identified by their exact declaration shape. Lifted functions +retain the successful canonical body-lowering run that produced their code; +the positive-arity witness records that this run came from an actual `.lam` +branch rather than an arbitrary direct call to the internal `lowerLam` +helper. -/ +def GeneratedDeclProvenance (src : IxIR0.Env) (state : LowSt) + (item : Ixon.Address × Decl) : Prop := + (∃ address source tag arity, + item = (address, ctorWrapperDecl source tag arity)) ∨ + ∃ address entryCount expr fuel initial generated code, + item = (address, .fn + ⟨(liftCaptureIndices entryCount expr).length + lamArity expr, + .shared, true, code⟩) ∧ + 0 < lamArity expr ∧ + papSafe expr = true ∧ + (lowerFnBody src fuel (liftedBodyVEnv entryCount expr) + (liftedBodyDrops entryCount expr) .shared + (stripLams expr)).run initial = .ok code generated ∧ + ExtraExtends generated state ∧ + (address, .fn + ⟨(liftCaptureIndices entryCount expr).length + lamArity expr, + .shared, true, code⟩) ∈ state.extra + +/-- Generated-declaration provenance survives every later lowering-state +extension. -/ +theorem GeneratedDeclProvenance.monoState + {src : IxIR0.Env} {initial final : LowSt} + (hextends : ExtraExtends initial final) + {item : Ixon.Address × Decl} + (hprovenance : GeneratedDeclProvenance src initial item) : + GeneratedDeclProvenance src final item := by + cases hprovenance with + | inl hwrapper => exact Or.inl hwrapper + | inr hlifted => + obtain ⟨address, entryCount, expr, fuel, bodyInitial, generated, code, + hitem, hpositive, hsafe, hrun, hgenerated, hmember⟩ := hlifted + exact Or.inr ⟨address, entryCount, expr, fuel, bodyInitial, generated, + code, hitem, hpositive, hsafe, hrun, hgenerated.trans hextends, + hextends.extra_mem hmember⟩ + +/-- A lowering-state extension whose newly reachable declarations all carry +compiler provenance. Membership is phrased as an old-row/new-origin +partition so it composes without choosing a particular prefix witness from +`ExtraExtends`. -/ +structure ExtraProvenanceExtends (src : IxIR0.Env) + (initial final : LowSt) : Prop where + toExtraExtends : ExtraExtends initial final + provenance : ∀ {item}, item ∈ final.extra → + item ∈ initial.extra ∨ GeneratedDeclProvenance src final item + +theorem ExtraProvenanceExtends.refl (src : IxIR0.Env) (state : LowSt) : + ExtraProvenanceExtends src state state := by + refine ⟨ExtraExtends.refl state, ?_⟩ + intro item hmember + exact Or.inl hmember + +theorem ExtraProvenanceExtends.trans + {src : IxIR0.Env} {first middle final : LowSt} + (hfirst : ExtraProvenanceExtends src first middle) + (hsecond : ExtraProvenanceExtends src middle final) : + ExtraProvenanceExtends src first final := by + refine ⟨hfirst.toExtraExtends.trans hsecond.toExtraExtends, ?_⟩ + intro item hmember + cases hsecond.provenance hmember with + | inr hfinal => exact Or.inr hfinal + | inl hmiddle => + cases hfirst.provenance hmiddle with + | inl hfirst => exact Or.inl hfirst + | inr hprovenance => + exact Or.inr (hprovenance.monoState hsecond.toExtraExtends) + +/-- From an empty input state, the old-row side of the provenance partition +is impossible. -/ +theorem ExtraProvenanceExtends.provenance_of_empty + {src : IxIR0.Env} {final : LowSt} + (hextends : ExtraProvenanceExtends src ({} : LowSt) final) + {item : Ixon.Address × Decl} (hmember : item ∈ final.extra) : + GeneratedDeclProvenance src final item := by + cases hextends.provenance hmember with + | inl hold => simp at hold + | inr hprovenance => exact hprovenance + +/-- Monad action law corresponding to `ExtraProvenanceExtends`. -/ +def ExtraProvenanceMonotone {α : Type} (src : IxIR0.Env) + (action : LowerM α) : Prop := + ∀ {initial final result}, action.run initial = .ok result final → + ExtraProvenanceExtends src initial final + +theorem ExtraProvenanceMonotone.pure {α : Type} (src : IxIR0.Env) + (value : α) : + ExtraProvenanceMonotone src (pure value : LowerM α) := by + intro initial final result hrun + have hpure : value = result ∧ initial = final := by + simpa using hrun + obtain ⟨_, hstate⟩ := hpure + subst final + exact ExtraProvenanceExtends.refl src initial + +theorem ExtraProvenanceMonotone.throw {α : Type} (src : IxIR0.Env) + (message : String) : + ExtraProvenanceMonotone src (throw message : LowerM α) := by + intro initial final result hrun + exact (estateThrowRun_not_ok hrun).elim + +theorem ExtraProvenanceMonotone.throwBind {α β : Type} + (src : IxIR0.Env) (message : String) (next : α → LowerM β) : + ExtraProvenanceMonotone src + ((EStateM.throw message : LowerM α) >>= next) := by + intro initial final result hrun + change EStateM.Result.error message initial = .ok result final at hrun + contradiction + +theorem ExtraProvenanceMonotone.get (src : IxIR0.Env) : + ExtraProvenanceMonotone src (get : LowerM LowSt) := by + intro initial final result hrun + change EStateM.Result.ok initial initial = .ok result final at hrun + injection hrun with _ hstate + subst final + exact ExtraProvenanceExtends.refl src initial + +theorem ExtraProvenanceMonotone.bind {α β : Type} {src : IxIR0.Env} + {action : LowerM α} {next : α → LowerM β} + (haction : ExtraProvenanceMonotone src action) + (hnext : ∀ value, ExtraProvenanceMonotone src (next value)) : + ExtraProvenanceMonotone src (action >>= next) := by + intro initial final result hrun + obtain ⟨value, middle, hfirst, hsecond⟩ := + estateBindRun_ok_inv hrun + exact (haction hfirst).trans (hnext value hsecond) + +theorem ExtraProvenanceMonotone.map {α β : Type} {src : IxIR0.Env} + {action : LowerM α} (haction : ExtraProvenanceMonotone src action) + (f : α → β) : ExtraProvenanceMonotone src (f <$> action) := by + have hbind : ExtraProvenanceMonotone src + (action >>= fun value => (Pure.pure (f value) : LowerM β)) := + ExtraProvenanceMonotone.bind haction + (fun value => ExtraProvenanceMonotone.pure src (f value)) + intro initial final result hrun + apply hbind + simpa only [bind_pure_comp] using hrun + +theorem ExtraProvenanceMonotone.listMapM {α β : Type} + (src : IxIR0.Env) (f : α → LowerM β) + (hf : ∀ value, ExtraProvenanceMonotone src (f value)) : + ∀ values : List α, ExtraProvenanceMonotone src (values.mapM f) + | [] => by + simpa using (ExtraProvenanceMonotone.pure src ([] : List β)) + | value :: rest => by + rw [List.mapM_cons] + apply ExtraProvenanceMonotone.bind (hf value) + intro head + apply ExtraProvenanceMonotone.bind + (ExtraProvenanceMonotone.listMapM src f hf rest) + intro tail + exact ExtraProvenanceMonotone.pure src (head :: tail) + +theorem ExtraProvenanceMonotone.listFilterMapM {α β : Type} + (src : IxIR0.Env) (f : α → LowerM (Option β)) + (hf : ∀ value, ExtraProvenanceMonotone src (f value)) : + ∀ values : List α, ExtraProvenanceMonotone src (values.filterMapM f) + | [] => by + simpa using (ExtraProvenanceMonotone.pure src ([] : List β)) + | value :: rest => by + rw [List.filterMapM_cons] + apply ExtraProvenanceMonotone.bind (hf value) + intro head + cases head with + | none => + exact ExtraProvenanceMonotone.listFilterMapM src f hf rest + | some head => + apply ExtraProvenanceMonotone.bind + (ExtraProvenanceMonotone.listFilterMapM src f hf rest) + intro tail + exact ExtraProvenanceMonotone.pure src (head :: tail) + +theorem freshAddr_extraProvenance (src : IxIR0.Env) : + ExtraProvenanceMonotone src freshAddr := by + intro initial final address hrun + refine ⟨freshAddr_extraExtends hrun, ?_⟩ + intro item hmember + change EStateM.Result.ok (synthAddr initial.fresh) + { initial with fresh := initial.fresh + 1 } = + .ok address final at hrun + have hstate : { initial with fresh := initial.fresh + 1 } = final := + congrArg + (fun result : EStateM.Result String LowSt Ixon.Address => + match result with + | .ok _ state | .error _ state => state) + hrun + subst final + exact Or.inl hmember + +/-- Wrapper lookup either adds one declaration with explicit wrapper +provenance or leaves the compiler state unchanged on a cache hit. -/ +theorem wrapperFor_extraProvenance (src : IxIR0.Env) + (source : Ixon.Address) (tag arity : Nat) : + ExtraProvenanceMonotone src (wrapperFor source tag arity) := by + intro initial final wrapper hrun + refine ⟨wrapperFor_extraExtends hrun, ?_⟩ + intro item hmember + cases hcached : initial.wrappers.find? + (·.matches source tag arity) with + | none => + have hstate : + { initial with + fresh := initial.fresh + 1 + wrappers := + ⟨source, tag, arity, synthAddr initial.fresh⟩ :: + initial.wrappers + extra := + (synthAddr initial.fresh, + ctorWrapperDecl source tag arity) :: + initial.extra } = final := by + dsimp [wrapperFor] at hrun + rw [hcached] at hrun + exact congrArg + (fun result : EStateM.Result String LowSt Ixon.Address => + match result with + | .ok _ state | .error _ state => state) + hrun + subst final + simp only [List.mem_cons] at hmember + cases hmember with + | inl hnew => + exact Or.inr (Or.inl + ⟨synthAddr initial.fresh, source, tag, arity, hnew⟩) + | inr hold => exact Or.inl hold + | some memo => + dsimp [wrapperFor] at hrun + rw [hcached] at hrun + dsimp at hrun + injection hrun with _ hstate + subst final + exact Or.inl hmember + +/-- Entry cleanup uses only pure compiler-state actions. -/ +theorem releaseSlots_extraProvenance (src : IxIR0.Env) (input : VEnv) : + ∀ drops : List SlotDrop, + ExtraProvenanceMonotone src (releaseSlots input drops) := by + exact releaseSlots_action_core + (ActionProperty := fun {α : Type} (action : LowerM α) => + ExtraProvenanceMonotone src action) + (hpure := fun value => ExtraProvenanceMonotone.pure src value) + (hbind := fun haction hnext => + ExtraProvenanceMonotone.bind haction hnext) + (hthrowBind := fun message next => + ExtraProvenanceMonotone.throwBind src message next) + input + +/-- Result-world checks inspect no compiler state. -/ +theorem requireResultWorld_extraProvenance (src : IxIR0.Env) + (actual demand : Owned) : + ExtraProvenanceMonotone src (requireResultWorld actual demand) := by + cases actual <;> cases demand <;> + simp [requireResultWorld] <;> + first + | exact ExtraProvenanceMonotone.pure src _ + | exact ExtraProvenanceMonotone.throw src _ + +/-- Provenance-preserving expression actions at one compiler-fuel index. -/ +def LowerEExtraProvenance (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ input world expr, + ExtraProvenanceMonotone src (lowerE src fuel input world expr) + +def LowerBorrowExtraProvenance (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ input expr, + ExtraProvenanceMonotone src (lowerBorrow src fuel input expr) + +def LowerSpineExtraProvenance (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ input world head args, + ExtraProvenanceMonotone src + (lowerSpine src fuel input world head args) + +def KnownCallExtraProvenance (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ input build count argWorlds resultWorld args, + ExtraProvenanceMonotone src + (knownCall src fuel input build count argWorlds resultWorld args) + +def LowerArgsExtraProvenance (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ input args, + ExtraProvenanceMonotone src (lowerArgs src fuel input args) + +def ApplyRestExtraProvenance (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ input resultWorld pre function args, + ExtraProvenanceMonotone src + (applyRest src fuel input resultWorld pre function args) + +/-- `lowerLam` is internal; only positive-arity calls made by the `.lam` +expression branch are admitted to the generated-declaration invariant. -/ +def LowerLamExtraProvenance (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ input expr, 0 < lamArity expr → + ExtraProvenanceMonotone src (lowerLam src fuel input expr) + +def LowerFnBodyExtraProvenance (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ input drops world body, + ExtraProvenanceMonotone src + (lowerFnBody src fuel input drops world body) + +structure LowerExtraProvenance (src : IxIR0.Env) (fuel : Nat) : Prop where + expr : LowerEExtraProvenance src fuel + borrow : LowerBorrowExtraProvenance src fuel + spine : LowerSpineExtraProvenance src fuel + knownCall : KnownCallExtraProvenance src fuel + args : LowerArgsExtraProvenance src fuel + applyRest : ApplyRestExtraProvenance src fuel + lam : LowerLamExtraProvenance src fuel + fnBody : LowerFnBodyExtraProvenance src fuel + +theorem lowerFnBodyExtraProvenance_zero (src : IxIR0.Env) : + LowerFnBodyExtraProvenance src 0 := by + intro input drops world body + simp only [lowerFnBody] + exact ExtraProvenanceMonotone.throw src _ + +theorem lowerFnBodyExtraProvenance_succ + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEExtraProvenance src fuel) : + LowerFnBodyExtraProvenance src (fuel + 1) := by + intro input drops world body + simp only [lowerFnBody] + apply ExtraProvenanceMonotone.bind + (releaseSlots_extraProvenance src input drops) + intro releaseResult + rcases releaseResult with ⟨middle, releaseEmit⟩ + apply ExtraProvenanceMonotone.bind (hexpr middle world body) + intro bodyResult + rcases bodyResult with ⟨output, bodyEmit, value⟩ + exact ExtraProvenanceMonotone.pure src + (releaseEmit (bodyEmit (.ret (value.toAtom output)))) + +theorem lowerExtraProvenance_zero (src : IxIR0.Env) : + LowerExtraProvenance src 0 := by + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro input world expr + simp only [lowerE] + exact ExtraProvenanceMonotone.throw src _ + · intro input expr + simp only [lowerBorrow] + exact ExtraProvenanceMonotone.throw src _ + · intro input world head args + simp only [lowerSpine] + exact ExtraProvenanceMonotone.throw src _ + · intro input build count argWorlds resultWorld args + simp only [knownCall] + exact ExtraProvenanceMonotone.throw src _ + · intro input args + simp only [lowerArgs] + exact ExtraProvenanceMonotone.throw src _ + · intro input resultWorld pre function args + simp only [applyRest] + exact ExtraProvenanceMonotone.throw src _ + · intro input expr _ + simp only [lowerLam] + exact ExtraProvenanceMonotone.throw src _ + · exact lowerFnBodyExtraProvenance_zero src + +/-- Capture bookkeeping never changes `LowSt`; it only rewrites the logical +`VEnv` and emitter returned as the action's value. -/ +theorem lowerCapture_extraMonotone (e : IxIR0.Expr) (input : VEnv) + (index : Nat) : ExtraMonotone (lowerCapture e input index) := by + intro state finalState result hrun + cases hentry : input.entries[index]? with + | none => + exact (estateThrowRun_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | some entry => + cases entry with + | recSelf arity => + exact (estateThrowRun_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | slot abs remaining uses held => + cases held with + | false => + exact (estateThrowRun_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | true => + by_cases hunique : worldOfUses uses = .unique + · have huuEq : (Owned.unique == Owned.unique) = true := by decide + exact (estateThrowRun_not_ok (by + simpa [lowerCapture, hentry, hunique, huuEq] using hrun)).elim + · have huniqueEq : + (worldOfUses uses == Owned.unique) = false := by + cases uses <;> simp_all [worldOfUses] <;> decide + by_cases hmore : remaining > countUses index e + · have hpure : state = finalState := by + have hresult : + (input.setEntry index + (.slot abs (remaining - countUses index e) uses true)).bump = + result.1 ∧ + state = finalState := by + have hfull : + ((input.setEntry index + (.slot abs (remaining - countUses index e) uses true)).bump, + emitOp (.dup (.var + ((input.setEntry index + (.slot abs (remaining - countUses index e) uses true)).rel abs))), + AVal.slotA + (input.setEntry index + (.slot abs (remaining - countUses index e) uses true)).depth) = + result ∧ state = finalState := by + simpa [lowerCapture, hentry, huniqueEq, hmore] using hrun + exact ⟨congrArg (fun value : VEnv × Emit × AVal => value.1) + hfull.1, hfull.2⟩ + exact hresult.2 + subst finalState + exact ExtraExtends.refl _ + · by_cases hequal : remaining = countUses index e + · have hpure : state = finalState := by + have hfull : + (input.setEntry index (.slot abs 0 uses false), + (_root_.id : Emit), AVal.slotA abs) = result ∧ + state = finalState := by + simpa [lowerCapture, hentry, huniqueEq, hmore, hequal] + using hrun + exact hfull.2 + subst finalState + exact ExtraExtends.refl _ + · exact (estateThrowRun_not_ok (by + simpa [lowerCapture, hentry, huniqueEq, hmore, hequal] + using hrun)).elim + +/-- A whole capture traversal likewise preserves `LowSt.extra`. The generic +bind rule records this structurally rather than relying on an opaque fold. -/ +theorem lowerCaptures_extraMonotone (e : IxIR0.Expr) : + ∀ (input : VEnv) (caps : List Nat), + ExtraMonotone (lowerCaptures e input caps) := by + exact lowerCaptures_action_core + (e := e) + (ActionProperty := fun {α : Type} (action : LowerM α) => + ExtraMonotone action) + (hpure := fun value => ExtraMonotone.pure value) + (hbind := fun haction hnext => ExtraMonotone.bind haction hnext) + (hcapture := lowerCapture_extraMonotone e) + +theorem lowerLam_extraMonotone_zero (src : IxIR0.Env) + (input : VEnv) (e : IxIR0.Expr) : + ExtraMonotone (lowerLam src 0 input e) := by + simp only [lowerLam] + exact ExtraMonotone.throw _ + +/-- Lambda lifting composes the state-preserving capture traversal, counter- +only fresh allocation, recursively monotone body lowering, and one explicit +extra-list prepend. -/ +theorem lowerLam_extraMonotone_succ + {src : IxIR0.Env} {fuel : Nat} + (hfn : LowerFnBodyExtraMonotone src fuel) + (input : VEnv) (e : IxIR0.Expr) : + ExtraMonotone (lowerLam src (fuel + 1) input e) := by + simp only [lowerLam] + cases hp : papSafe e with + | false => + simp only [Bool.false_eq_true, if_false] + exact ExtraMonotone.throwBind _ _ + | true => + simp only [↓reduceIte, bind_pure_comp] + let caps := (List.range input.entries.length).filter + (fun i => countUses i e > 0) + have hcaps : caps = (List.range input.entries.length).filter + (fun i => countUses i e > 0) := rfl + rw [← hcaps] + apply ExtraMonotone.bind (lowerCaptures_extraMonotone e input caps) + intro captureResult + rcases captureResult with ⟨captureOutput, captureEmit, captureValues⟩ + apply ExtraMonotone.bind freshAddr_extraMonotone + intro fnAddr + apply ExtraMonotone.bind (hfn _ _ _ _) + intro code + exact ExtraMonotone.map (pushExtra_extraMonotone _) + (fun _ => (captureOutput.bump, + captureEmit ∘ emitOp (.papp fnAddr + (captureValues.map (·.toAtom captureOutput)).toArray), + AVal.slotA captureOutput.depth)) + +/-- Capture bookkeeping preserves generated provenance because it leaves the +lowering state unchanged on every successful branch. -/ +theorem lowerCapture_extraProvenance (src : IxIR0.Env) + (e : IxIR0.Expr) (input : VEnv) (index : Nat) : + ExtraProvenanceMonotone src (lowerCapture e input index) := by + intro state finalState result hrun + cases hentry : input.entries[index]? with + | none => + exact (estateThrowRun_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | some entry => + cases entry with + | recSelf arity => + exact (estateThrowRun_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | slot abs remaining uses held => + cases held with + | false => + exact (estateThrowRun_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | true => + by_cases hunique : worldOfUses uses = .unique + · have huuEq : (Owned.unique == Owned.unique) = true := by decide + exact (estateThrowRun_not_ok (by + simpa [lowerCapture, hentry, hunique, huuEq] using hrun)).elim + · have huniqueEq : + (worldOfUses uses == Owned.unique) = false := by + cases uses <;> simp_all [worldOfUses] <;> decide + by_cases hmore : remaining > countUses index e + · have hpure : state = finalState := by + have hresult : + (input.setEntry index + (.slot abs (remaining - countUses index e) uses true)).bump = + result.1 ∧ + state = finalState := by + have hfull : + ((input.setEntry index + (.slot abs (remaining - countUses index e) uses true)).bump, + emitOp (.dup (.var + ((input.setEntry index + (.slot abs (remaining - countUses index e) uses true)).rel abs))), + AVal.slotA + (input.setEntry index + (.slot abs (remaining - countUses index e) uses true)).depth) = + result ∧ state = finalState := by + simpa [lowerCapture, hentry, huniqueEq, hmore] using hrun + exact ⟨congrArg (fun value : VEnv × Emit × AVal => value.1) + hfull.1, hfull.2⟩ + exact hresult.2 + subst finalState + exact ExtraProvenanceExtends.refl src state + · by_cases hequal : remaining = countUses index e + · have hpure : state = finalState := by + have hfull : + (input.setEntry index (.slot abs 0 uses false), + (_root_.id : Emit), AVal.slotA abs) = result ∧ + state = finalState := by + simpa [lowerCapture, hentry, huniqueEq, hmore, hequal] + using hrun + exact hfull.2 + subst finalState + exact ExtraProvenanceExtends.refl src state + · exact (estateThrowRun_not_ok (by + simpa [lowerCapture, hentry, huniqueEq, hmore, hequal] + using hrun)).elim + +theorem lowerCaptures_extraProvenance (src : IxIR0.Env) + (e : IxIR0.Expr) : + ∀ (input : VEnv) (caps : List Nat), + ExtraProvenanceMonotone src (lowerCaptures e input caps) := by + exact lowerCaptures_action_core + (e := e) + (ActionProperty := fun {α : Type} (action : LowerM α) => + ExtraProvenanceMonotone src action) + (hpure := fun value => ExtraProvenanceMonotone.pure src value) + (hbind := fun haction hnext => + ExtraProvenanceMonotone.bind haction hnext) + (hcapture := lowerCapture_extraProvenance src e) + +theorem lowerLam_extraProvenance_zero (src : IxIR0.Env) + (input : VEnv) (e : IxIR0.Expr) : + ExtraProvenanceMonotone src (lowerLam src 0 input e) := by + simp only [lowerLam] + exact ExtraProvenanceMonotone.throw src _ + +theorem lowerArgsExtraMonotone_succ + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEExtraMonotone src fuel) + (hargs : LowerArgsExtraMonotone src fuel) : + LowerArgsExtraMonotone src (fuel + 1) := by + intro input args + cases args with + | nil => + simp only [lowerArgs] + exact ExtraMonotone.pure _ + | cons head rest => + rcases head with ⟨expr, world⟩ + simp only [lowerArgs] + apply ExtraMonotone.bind (hexpr input world expr) + intro headResult + rcases headResult with ⟨middle, headEmit, value⟩ + apply ExtraMonotone.bind (hargs middle rest) + intro tailResult + rcases tailResult with ⟨output, tailEmit, values⟩ + exact ExtraMonotone.pure + (output, headEmit ∘ tailEmit, value :: values) + +theorem applyRestExtraMonotone_succ + {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsExtraMonotone src fuel) : + ApplyRestExtraMonotone src (fuel + 1) := by + intro input resultWorld pre function args + cases function with + | slotA abs => + simp only [applyRest] + apply ExtraMonotone.bind + (requireResultWorld_extraMonotone .shared resultWorld) + intro unitValue + cases unitValue + apply ExtraMonotone.bind + (hargs input (args.map (fun arg => (arg, Owned.shared)))) + intro argsResult + rcases argsResult with ⟨output, argsEmit, values⟩ + exact ExtraMonotone.pure + (output.bump, + pre ∘ argsEmit ∘ emitOp (.apply + ((AVal.slotA abs).toAtom output) + (values.map (·.toAtom output)).toArray), + AVal.slotA output.depth) + | constA atom => + cases atom with + | erased => + simp only [applyRest] + apply ExtraMonotone.bind + (hargs input (args.map (fun arg => (arg, Owned.shared)))) + intro argsResult + rcases argsResult with ⟨output, argsEmit, values⟩ + exact ExtraMonotone.pure + ((releaseAll output values).1, + pre ∘ argsEmit ∘ (releaseAll output values).2, + AVal.constA .erased) + | var relative => + simp only [applyRest] + apply ExtraMonotone.bind + (requireResultWorld_extraMonotone .shared resultWorld) + intro unitValue + cases unitValue + apply ExtraMonotone.bind + (hargs input (args.map (fun arg => (arg, Owned.shared)))) + intro argsResult + rcases argsResult with ⟨output, argsEmit, values⟩ + exact ExtraMonotone.pure + (output.bump, + pre ∘ argsEmit ∘ emitOp (.apply + ((AVal.constA (.var relative)).toAtom output) + (values.map (·.toAtom output)).toArray), + AVal.slotA output.depth) + | lit literal => + simp only [applyRest] + apply ExtraMonotone.bind + (requireResultWorld_extraMonotone .shared resultWorld) + intro unitValue + cases unitValue + apply ExtraMonotone.bind + (hargs input (args.map (fun arg => (arg, Owned.shared)))) + intro argsResult + rcases argsResult with ⟨output, argsEmit, values⟩ + exact ExtraMonotone.pure + (output.bump, + pre ∘ argsEmit ∘ emitOp (.apply + ((AVal.constA (.lit literal)).toAtom output) + (values.map (·.toAtom output)).toArray), + AVal.slotA output.depth) + +theorem knownCallExtraMonotone_succ + {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsExtraMonotone src fuel) + (hrest : ApplyRestExtraMonotone src fuel) : + KnownCallExtraMonotone src (fuel + 1) := by + intro input build count argWorlds resultWorld args + simp only [knownCall] + apply ExtraMonotone.bind + (hargs input ((args.take count).zip (padWorlds argWorlds count))) + intro argsResult + rcases argsResult with ⟨output, argsEmit, values⟩ + by_cases hterminal : args.length ≤ count + · simp only [if_pos hterminal] + exact ExtraMonotone.pure + (output.bump, + argsEmit ∘ emitOp + (build (values.map (·.toAtom output)).toArray), + AVal.slotA output.depth) + · simp only [if_neg hterminal] + exact hrest output.bump resultWorld + (argsEmit ∘ emitOp + (build (values.map (·.toAtom output)).toArray)) + (.slotA output.depth) (args.drop count) + +theorem lowerArgsExtraProvenance_succ + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEExtraProvenance src fuel) + (hargs : LowerArgsExtraProvenance src fuel) : + LowerArgsExtraProvenance src (fuel + 1) := by + intro input args + cases args with + | nil => + simp only [lowerArgs] + exact ExtraProvenanceMonotone.pure src _ + | cons head rest => + rcases head with ⟨expr, world⟩ + simp only [lowerArgs] + apply ExtraProvenanceMonotone.bind (hexpr input world expr) + intro headResult + rcases headResult with ⟨middle, headEmit, value⟩ + apply ExtraProvenanceMonotone.bind (hargs middle rest) + intro tailResult + rcases tailResult with ⟨output, tailEmit, values⟩ + exact ExtraProvenanceMonotone.pure src + (output, headEmit ∘ tailEmit, value :: values) + +theorem applyRestExtraProvenance_succ + {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsExtraProvenance src fuel) : + ApplyRestExtraProvenance src (fuel + 1) := by + intro input resultWorld pre function args + cases function with + | slotA abs => + simp only [applyRest] + apply ExtraProvenanceMonotone.bind + (requireResultWorld_extraProvenance src .shared resultWorld) + intro unitValue + cases unitValue + apply ExtraProvenanceMonotone.bind + (hargs input (args.map (fun arg => (arg, Owned.shared)))) + intro argsResult + rcases argsResult with ⟨output, argsEmit, values⟩ + exact ExtraProvenanceMonotone.pure src + (output.bump, + pre ∘ argsEmit ∘ emitOp (.apply + ((AVal.slotA abs).toAtom output) + (values.map (·.toAtom output)).toArray), + AVal.slotA output.depth) + | constA atom => + cases atom with + | erased => + simp only [applyRest] + apply ExtraProvenanceMonotone.bind + (hargs input (args.map (fun arg => (arg, Owned.shared)))) + intro argsResult + rcases argsResult with ⟨output, argsEmit, values⟩ + exact ExtraProvenanceMonotone.pure src + ((releaseAll output values).1, + pre ∘ argsEmit ∘ (releaseAll output values).2, + AVal.constA .erased) + | var relative => + simp only [applyRest] + apply ExtraProvenanceMonotone.bind + (requireResultWorld_extraProvenance src .shared resultWorld) + intro unitValue + cases unitValue + apply ExtraProvenanceMonotone.bind + (hargs input (args.map (fun arg => (arg, Owned.shared)))) + intro argsResult + rcases argsResult with ⟨output, argsEmit, values⟩ + exact ExtraProvenanceMonotone.pure src + (output.bump, + pre ∘ argsEmit ∘ emitOp (.apply + ((AVal.constA (.var relative)).toAtom output) + (values.map (·.toAtom output)).toArray), + AVal.slotA output.depth) + | lit literal => + simp only [applyRest] + apply ExtraProvenanceMonotone.bind + (requireResultWorld_extraProvenance src .shared resultWorld) + intro unitValue + cases unitValue + apply ExtraProvenanceMonotone.bind + (hargs input (args.map (fun arg => (arg, Owned.shared)))) + intro argsResult + rcases argsResult with ⟨output, argsEmit, values⟩ + exact ExtraProvenanceMonotone.pure src + (output.bump, + pre ∘ argsEmit ∘ emitOp (.apply + ((AVal.constA (.lit literal)).toAtom output) + (values.map (·.toAtom output)).toArray), + AVal.slotA output.depth) + +theorem knownCallExtraProvenance_succ + {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsExtraProvenance src fuel) + (hrest : ApplyRestExtraProvenance src fuel) : + KnownCallExtraProvenance src (fuel + 1) := by + intro input build count argWorlds resultWorld args + simp only [knownCall] + apply ExtraProvenanceMonotone.bind + (hargs input ((args.take count).zip (padWorlds argWorlds count))) + intro argsResult + rcases argsResult with ⟨output, argsEmit, values⟩ + by_cases hterminal : args.length ≤ count + · simp only [if_pos hterminal] + exact ExtraProvenanceMonotone.pure src + (output.bump, + argsEmit ∘ emitOp + (build (values.map (·.toAtom output)).toArray), + AVal.slotA output.depth) + · simp only [if_neg hterminal] + exact hrest output.bump resultWorld + (argsEmit ∘ emitOp + (build (values.map (·.toAtom output)).toArray)) + (.slotA output.depth) (args.drop count) + +/-- Variable borrowing never touches the generated-declaration state. The +case split mirrors the executable rejection/move/borrow branches. -/ +theorem lowerBorrow_var_extraMonotone + (src : IxIR0.Env) (fuel : Nat) (input : VEnv) (index : Nat) : + ExtraMonotone + (lowerBorrow src (fuel + 1) input (.var index)) := by + simp only [lowerBorrow] + cases hentry : input.entries[index]? with + | none => exact ExtraMonotone.throw _ + | some entry => + cases entry with + | recSelf arity => exact ExtraMonotone.throw _ + | slot abs remaining uses held => + cases held with + | false => exact ExtraMonotone.throw _ + | true => + cases uses with + | linear => exact ExtraMonotone.throw _ + | affine => exact ExtraMonotone.throw _ + | erased => + cases remaining with + | zero => exact ExtraMonotone.throw _ + | succ remaining => + cases remaining with + | zero => exact ExtraMonotone.pure _ + | succ remaining => exact ExtraMonotone.pure _ + | many => + cases remaining with + | zero => exact ExtraMonotone.throw _ + | succ remaining => + cases remaining with + | zero => exact ExtraMonotone.pure _ + | succ remaining => exact ExtraMonotone.pure _ + +theorem lowerBorrow_var_extraProvenance + (src : IxIR0.Env) (fuel : Nat) (input : VEnv) (index : Nat) : + ExtraProvenanceMonotone src + (lowerBorrow src (fuel + 1) input (.var index)) := by + simp only [lowerBorrow] + cases hentry : input.entries[index]? with + | none => exact ExtraProvenanceMonotone.throw src _ + | some entry => + cases entry with + | recSelf arity => exact ExtraProvenanceMonotone.throw src _ + | slot abs remaining uses held => + cases held with + | false => exact ExtraProvenanceMonotone.throw src _ + | true => + cases uses with + | linear => exact ExtraProvenanceMonotone.throw src _ + | affine => exact ExtraProvenanceMonotone.throw src _ + | erased => + cases remaining with + | zero => exact ExtraProvenanceMonotone.throw src _ + | succ remaining => + cases remaining with + | zero => exact ExtraProvenanceMonotone.pure src _ + | succ remaining => exact ExtraProvenanceMonotone.pure src _ + | many => + cases remaining with + | zero => exact ExtraProvenanceMonotone.throw src _ + | succ remaining => + cases remaining with + | zero => exact ExtraProvenanceMonotone.pure src _ + | succ remaining => exact ExtraProvenanceMonotone.pure src _ + +/-- Variable consumption is state-only trivial even though its ownership +branching distinguishes demand, binder mode, and remaining-use count. -/ +theorem lowerE_var_extraMonotone + (src : IxIR0.Env) (fuel : Nat) (input : VEnv) + (world : Owned) (index : Nat) : + ExtraMonotone (lowerE src (fuel + 1) input world (.var index)) := by + simp only [lowerE] + cases hentry : input.entries[index]? with + | none => exact ExtraMonotone.throw _ + | some entry => + cases entry with + | recSelf arity => exact ExtraMonotone.throw _ + | slot abs remaining uses held => + cases held with + | false => exact ExtraMonotone.throw _ + | true => + cases remaining with + | zero => + cases uses <;> cases world <;> + first + | exact ExtraMonotone.pure _ + | exact ExtraMonotone.throw _ + | succ remaining => + cases remaining with + | zero => + cases uses <;> cases world <;> + first + | exact ExtraMonotone.pure _ + | exact ExtraMonotone.throw _ + | succ remaining => + cases uses <;> cases world <;> + first + | exact ExtraMonotone.pure _ + | exact ExtraMonotone.throw _ + +theorem lowerE_var_extraProvenance + (src : IxIR0.Env) (fuel : Nat) (input : VEnv) + (world : Owned) (index : Nat) : + ExtraProvenanceMonotone src + (lowerE src (fuel + 1) input world (.var index)) := by + simp only [lowerE] + cases hentry : input.entries[index]? with + | none => exact ExtraProvenanceMonotone.throw src _ + | some entry => + cases entry with + | recSelf arity => exact ExtraProvenanceMonotone.throw src _ + | slot abs remaining uses held => + cases held with + | false => exact ExtraProvenanceMonotone.throw src _ + | true => + cases remaining with + | zero => + cases uses <;> cases world <;> + first + | exact ExtraProvenanceMonotone.pure src _ + | exact ExtraProvenanceMonotone.throw src _ + | succ remaining => + cases remaining with + | zero => + cases uses <;> cases world <;> + first + | exact ExtraProvenanceMonotone.pure src _ + | exact ExtraProvenanceMonotone.throw src _ + | succ remaining => + cases uses <;> cases world <;> + first + | exact ExtraProvenanceMonotone.pure src _ + | exact ExtraProvenanceMonotone.throw src _ + +theorem lowerE_ref_extraMonotone + (src : IxIR0.Env) (fuel : Nat) (input : VEnv) + (world : Owned) (address : Ixon.Address) : + ExtraMonotone (lowerE src (fuel + 1) input world (.ref address)) := by + simp only [lowerE] + cases hsource : src address with + | none => + simp only + exact ExtraMonotone.throw _ + | some decl => + cases decl with + | defn result body => + simp only + cases harity : lamArity body with + | zero => + apply ExtraMonotone.bind + (requireResultWorld_extraMonotone result world) + intro unitValue + cases unitValue + exact ExtraMonotone.pure _ + | succ arity => + cases result <;> cases world <;> cases hp : papSafe body <;> + first + | exact ExtraMonotone.pure _ + | exact ExtraMonotone.throw _ + | ctor tag arity => + simp only + cases arity with + | zero => exact ExtraMonotone.pure _ + | succ arity => + cases world with + | unique => exact ExtraMonotone.throw _ + | shared => + apply ExtraMonotone.bind + (wrapperFor_extraMonotone address tag (arity + 1)) + intro wrapper + exact ExtraMonotone.pure _ + | recursor numArgs natLit rules => + simp only + cases world <;> first + | exact ExtraMonotone.pure _ + | exact ExtraMonotone.throw _ + | extern arity => + simp only + cases arity with + | zero => exact ExtraMonotone.pure _ + | succ arity => + cases world <;> first + | exact ExtraMonotone.pure _ + | exact ExtraMonotone.throw _ + +theorem lowerE_ref_extraProvenance + (src : IxIR0.Env) (fuel : Nat) (input : VEnv) + (world : Owned) (address : Ixon.Address) : + ExtraProvenanceMonotone src + (lowerE src (fuel + 1) input world (.ref address)) := by + simp only [lowerE] + cases hsource : src address with + | none => + simp only + exact ExtraProvenanceMonotone.throw src _ + | some decl => + cases decl with + | defn result body => + simp only + cases harity : lamArity body with + | zero => + apply ExtraProvenanceMonotone.bind + (requireResultWorld_extraProvenance src result world) + intro unitValue + cases unitValue + exact ExtraProvenanceMonotone.pure src _ + | succ arity => + cases result <;> cases world <;> cases hp : papSafe body <;> + first + | exact ExtraProvenanceMonotone.pure src _ + | exact ExtraProvenanceMonotone.throw src _ + | ctor tag arity => + simp only + cases arity with + | zero => exact ExtraProvenanceMonotone.pure src _ + | succ arity => + cases world with + | unique => exact ExtraProvenanceMonotone.throw src _ + | shared => + apply ExtraProvenanceMonotone.bind + (wrapperFor_extraProvenance src address tag (arity + 1)) + intro wrapper + exact ExtraProvenanceMonotone.pure src _ + | recursor numArgs natLit rules => + simp only + cases world <;> first + | exact ExtraProvenanceMonotone.pure src _ + | exact ExtraProvenanceMonotone.throw src _ + | extern arity => + simp only + cases arity with + | zero => exact ExtraProvenanceMonotone.pure src _ + | succ arity => + cases world <;> first + | exact ExtraProvenanceMonotone.pure src _ + | exact ExtraProvenanceMonotone.throw src _ + +theorem lowerE_lam_extraMonotone + {src : IxIR0.Env} {fuel : Nat} + (hlam : LowerLamExtraMonotone src fuel) + (input : VEnv) (world : Owned) (uses : Uses) + (body : IxIR0.Expr) : + ExtraMonotone + (lowerE src (fuel + 1) input world (.lam uses body)) := by + cases world with + | unique => + simp only [lowerE] + exact ExtraMonotone.throw _ + | shared => + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + intro initial final result hrun + apply hlam input (.lam uses body) + simpa only [lowerE, hsuEq, Bool.false_eq_true, if_false] using hrun + +theorem lowerE_lam_extraProvenance + {src : IxIR0.Env} {fuel : Nat} + (hlam : LowerLamExtraProvenance src fuel) + (input : VEnv) (world : Owned) (uses : Uses) + (body : IxIR0.Expr) : + ExtraProvenanceMonotone src + (lowerE src (fuel + 1) input world (.lam uses body)) := by + cases world with + | unique => + simp only [lowerE] + exact ExtraProvenanceMonotone.throw src _ + | shared => + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + intro initial final result hrun + apply hlam input (.lam uses body) (by simp [lamArity]) + simpa only [lowerE, hsuEq, Bool.false_eq_true, if_false] using hrun + +theorem lowerE_proj_extraMonotone + {src : IxIR0.Env} {fuel : Nat} + (hborrow : LowerBorrowExtraMonotone src fuel) + (input : VEnv) (world : Owned) (index : Nat) + (source : IxIR0.Expr) : + ExtraMonotone + (lowerE src (fuel + 1) input world (.proj index source)) := by + cases world with + | unique => + simp only [lowerE] + exact ExtraMonotone.throw _ + | shared => + simp only [lowerE] + apply ExtraMonotone.bind (hborrow input source) + intro borrowResult + rcases borrowResult with ⟨output, emit, value, release⟩ + cases value with + | slotA abs => cases release <;> exact ExtraMonotone.pure _ + | constA atom => cases atom <;> exact ExtraMonotone.pure _ + +theorem lowerE_proj_extraProvenance + {src : IxIR0.Env} {fuel : Nat} + (hborrow : LowerBorrowExtraProvenance src fuel) + (input : VEnv) (world : Owned) (index : Nat) + (source : IxIR0.Expr) : + ExtraProvenanceMonotone src + (lowerE src (fuel + 1) input world (.proj index source)) := by + cases world with + | unique => + simp only [lowerE] + exact ExtraProvenanceMonotone.throw src _ + | shared => + simp only [lowerE] + apply ExtraProvenanceMonotone.bind (hborrow input source) + intro borrowResult + rcases borrowResult with ⟨output, emit, value, release⟩ + cases value with + | slotA abs => + cases release <;> exact ExtraProvenanceMonotone.pure src _ + | constA atom => + cases atom <;> exact ExtraProvenanceMonotone.pure src _ + +theorem lowerE_let_extraMonotone + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEExtraMonotone src fuel) + (input : VEnv) (world : Owned) (uses : Uses) + (value body : IxIR0.Expr) : + ExtraMonotone + (lowerE src (fuel + 1) input world (.letE uses value body)) := by + simp only [lowerE] + apply ExtraMonotone.bind (hexpr input (worldOfUses uses) value) + intro valueResult + rcases valueResult with ⟨middle, valueEmit, boundValue⟩ + cases boundValue with + | slotA abs => + by_cases hzero : countUses 0 body = 0 + · simp only [hzero, beq_self_eq_true, if_true] + cases uses with + | erased => exact ExtraMonotone.throwBind _ _ + | linear => exact ExtraMonotone.throwBind _ _ + | affine => + apply ExtraMonotone.bind (ExtraMonotone.pure _) + intro releaseEmit + apply ExtraMonotone.bind (hexpr _ world body) + intro bodyResult + rcases bodyResult with ⟨output, bodyEmit, result⟩ + exact ExtraMonotone.pure + (output.pop, valueEmit ∘ releaseEmit ∘ bodyEmit, result) + | many => + apply ExtraMonotone.bind (ExtraMonotone.pure _) + intro releaseEmit + apply ExtraMonotone.bind (hexpr _ world body) + intro bodyResult + rcases bodyResult with ⟨output, bodyEmit, result⟩ + exact ExtraMonotone.pure + (output.pop, valueEmit ∘ releaseEmit ∘ bodyEmit, result) + · simp [hzero] + apply ExtraMonotone.bind (hexpr _ world body) + intro bodyResult + rcases bodyResult with ⟨output, bodyEmit, result⟩ + exact ExtraMonotone.pure + (output.pop, valueEmit ∘ bodyEmit, result) + | constA atom => + by_cases hzero : countUses 0 body = 0 + · simp only [hzero, beq_self_eq_true, if_true] + apply ExtraMonotone.bind (hexpr _ world body) + intro bodyResult + rcases bodyResult with ⟨output, bodyEmit, result⟩ + exact ExtraMonotone.pure + (output.pop, + valueEmit ∘ emitOp (.pure atom) ∘ bodyEmit, result) + · simp [hzero] + apply ExtraMonotone.bind (hexpr _ world body) + intro bodyResult + rcases bodyResult with ⟨output, bodyEmit, result⟩ + exact ExtraMonotone.pure + (output.pop, + valueEmit ∘ emitOp (.pure atom) ∘ bodyEmit, result) + +theorem lowerE_let_extraProvenance + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEExtraProvenance src fuel) + (input : VEnv) (world : Owned) (uses : Uses) + (value body : IxIR0.Expr) : + ExtraProvenanceMonotone src + (lowerE src (fuel + 1) input world (.letE uses value body)) := by + simp only [lowerE] + apply ExtraProvenanceMonotone.bind (hexpr input (worldOfUses uses) value) + intro valueResult + rcases valueResult with ⟨middle, valueEmit, boundValue⟩ + cases boundValue with + | slotA abs => + by_cases hzero : countUses 0 body = 0 + · simp only [hzero, beq_self_eq_true, if_true] + cases uses with + | erased => exact ExtraProvenanceMonotone.throwBind src _ _ + | linear => exact ExtraProvenanceMonotone.throwBind src _ _ + | affine => + apply ExtraProvenanceMonotone.bind + (ExtraProvenanceMonotone.pure src _) + intro releaseEmit + apply ExtraProvenanceMonotone.bind (hexpr _ world body) + intro bodyResult + rcases bodyResult with ⟨output, bodyEmit, result⟩ + exact ExtraProvenanceMonotone.pure src + (output.pop, valueEmit ∘ releaseEmit ∘ bodyEmit, result) + | many => + apply ExtraProvenanceMonotone.bind + (ExtraProvenanceMonotone.pure src _) + intro releaseEmit + apply ExtraProvenanceMonotone.bind (hexpr _ world body) + intro bodyResult + rcases bodyResult with ⟨output, bodyEmit, result⟩ + exact ExtraProvenanceMonotone.pure src + (output.pop, valueEmit ∘ releaseEmit ∘ bodyEmit, result) + · simp [hzero] + apply ExtraProvenanceMonotone.bind (hexpr _ world body) + intro bodyResult + rcases bodyResult with ⟨output, bodyEmit, result⟩ + exact ExtraProvenanceMonotone.pure src + (output.pop, valueEmit ∘ bodyEmit, result) + | constA atom => + by_cases hzero : countUses 0 body = 0 + · simp only [hzero, beq_self_eq_true, if_true] + apply ExtraProvenanceMonotone.bind (hexpr _ world body) + intro bodyResult + rcases bodyResult with ⟨output, bodyEmit, result⟩ + exact ExtraProvenanceMonotone.pure src + (output.pop, + valueEmit ∘ emitOp (.pure atom) ∘ bodyEmit, result) + · simp [hzero] + apply ExtraProvenanceMonotone.bind (hexpr _ world body) + intro bodyResult + rcases bodyResult with ⟨output, bodyEmit, result⟩ + exact ExtraProvenanceMonotone.pure src + (output.pop, + valueEmit ∘ emitOp (.pure atom) ∘ bodyEmit, result) + +theorem lowerEExtraMonotone_succ + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEExtraMonotone src fuel) + (hspine : LowerSpineExtraMonotone src fuel) + (hborrow : LowerBorrowExtraMonotone src fuel) + (hlam : LowerLamExtraMonotone src fuel) : + LowerEExtraMonotone src (fuel + 1) := by + intro input world expr + cases expr with + | var index => exact (lowerE_var_extraMonotone + src fuel input world index) + | ref address => exact (lowerE_ref_extraMonotone + src fuel input world address) + | lit literal => + simp only [lowerE] + exact ExtraMonotone.pure _ + | erased => + simp only [lowerE] + exact ExtraMonotone.pure _ + | lam uses body => exact (lowerE_lam_extraMonotone + hlam input world uses body) + | letE uses value body => exact (lowerE_let_extraMonotone + hexpr input world uses value body) + | app function argument => + simp only [lowerE] + exact hspine input world function [argument] + | proj index source => exact (lowerE_proj_extraMonotone + hborrow input world index source) + +theorem lowerEExtraProvenance_succ + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEExtraProvenance src fuel) + (hspine : LowerSpineExtraProvenance src fuel) + (hborrow : LowerBorrowExtraProvenance src fuel) + (hlam : LowerLamExtraProvenance src fuel) : + LowerEExtraProvenance src (fuel + 1) := by + intro input world expr + cases expr with + | var index => exact (lowerE_var_extraProvenance + src fuel input world index) + | ref address => exact (lowerE_ref_extraProvenance + src fuel input world address) + | lit literal => + simp only [lowerE] + exact ExtraProvenanceMonotone.pure src _ + | erased => + simp only [lowerE] + exact ExtraProvenanceMonotone.pure src _ + | lam uses body => exact (lowerE_lam_extraProvenance + hlam input world uses body) + | letE uses value body => exact (lowerE_let_extraProvenance + hexpr input world uses value body) + | app function argument => + simp only [lowerE] + exact hspine input world function [argument] + | proj index source => exact (lowerE_proj_extraProvenance + hborrow input world index source) + +theorem lowerSpine_dynamic_extraMonotone + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEExtraMonotone src fuel) + (hrest : ApplyRestExtraMonotone src fuel) + (input : VEnv) (world : Owned) (head : IxIR0.Expr) + (args : List IxIR0.Expr) : + ExtraMonotone (do + let (output, emit, function) ← lowerE src fuel input .shared head + applyRest src fuel output world emit function args) := by + apply ExtraMonotone.bind (hexpr input .shared head) + intro headResult + rcases headResult with ⟨output, emit, function⟩ + exact hrest output world emit function args + +theorem lowerSpine_var_extraMonotone + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEExtraMonotone src fuel) + (hknown : KnownCallExtraMonotone src fuel) + (hrest : ApplyRestExtraMonotone src fuel) + (input : VEnv) (world : Owned) (index : Nat) + (args : List IxIR0.Expr) : + ExtraMonotone + (lowerSpine src (fuel + 1) input world (.var index) args) := by + simp only [lowerSpine] + cases hentry : input.entries[index]? with + | none => + simp only + exact lowerSpine_dynamic_extraMonotone + hexpr hrest input world (.var index) args + | some entry => + cases entry with + | slot abs remaining uses held => + simp only + exact lowerSpine_dynamic_extraMonotone + hexpr hrest input world (.var index) args + | recSelf arity => + simp only + by_cases hunder : args.length < arity + · simp only [if_pos hunder] + exact ExtraMonotone.throw _ + · simp only [if_neg hunder] + apply ExtraMonotone.bind + (requireResultWorld_extraMonotone .shared world) + intro unitValue + cases unitValue + exact hknown input (.callSelf ·) arity + (List.replicate arity .shared) world args + +theorem lowerSpine_ref_extraMonotone + {src : IxIR0.Env} {fuel : Nat} + (hknown : KnownCallExtraMonotone src fuel) + (input : VEnv) (world : Owned) (address : Ixon.Address) + (args : List IxIR0.Expr) : + ExtraMonotone + (lowerSpine src (fuel + 1) input world (.ref address) args) := by + simp only [lowerSpine] + cases hsource : src address with + | none => + simp only + exact ExtraMonotone.throw _ + | some decl => + cases decl with + | defn result body => + simp only + by_cases hunder : args.length < lamArity body + · simp only [if_pos hunder] + cases world with + | unique => exact ExtraMonotone.throw _ + | shared => + cases result with + | unique => exact ExtraMonotone.throw _ + | shared => + cases hp : papSafe body with + | false => exact ExtraMonotone.throw _ + | true => + exact hknown input (.papp address ·) args.length + (List.replicate args.length .shared) .shared args + · simp only [if_neg hunder] + apply ExtraMonotone.bind + (requireResultWorld_extraMonotone result + (if args.length == lamArity body then world else .shared)) + intro unitValue + cases unitValue + exact hknown input (.call address ·) (lamArity body) + ((lamUses body).map worldOfUses) world args + | ctor tag arity => + simp only + by_cases hunder : args.length < arity + · simp only [if_pos hunder] + cases world with + | unique => exact ExtraMonotone.throw _ + | shared => + apply ExtraMonotone.bind + (wrapperFor_extraMonotone address tag arity) + intro wrapper + exact hknown input (.papp wrapper ·) args.length + (List.replicate args.length .shared) .shared args + · simp only [if_neg hunder] + exact hknown input (.alloc world (ctorIdOf address tag) ·) arity + (List.replicate arity world) world args + | recursor numArgs natLit rules => + simp only + by_cases hunder : args.length < numArgs + 1 + · simp only [if_pos hunder] + cases world with + | unique => exact ExtraMonotone.throw _ + | shared => + exact hknown input (.papp address ·) args.length + (List.replicate args.length .shared) .shared args + · simp only [if_neg hunder] + apply ExtraMonotone.bind + (requireResultWorld_extraMonotone .shared world) + intro unitValue + cases unitValue + exact hknown input (.call address ·) (numArgs + 1) + (List.replicate (numArgs + 1) .shared) world args + | extern arity => + simp only + by_cases hunder : args.length < arity + · simp only [if_pos hunder] + cases world with + | unique => exact ExtraMonotone.throw _ + | shared => + exact hknown input (.papp address ·) args.length + (List.replicate args.length .shared) .shared args + · simp only [if_neg hunder] + exact hknown input (.extern address ·) arity + (List.replicate arity .shared) world args + +theorem lowerSpineExtraMonotone_succ + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEExtraMonotone src fuel) + (hspine : LowerSpineExtraMonotone src fuel) + (hknown : KnownCallExtraMonotone src fuel) + (hrest : ApplyRestExtraMonotone src fuel) : + LowerSpineExtraMonotone src (fuel + 1) := by + intro input world head args + cases head with + | app function argument => + simp only [lowerSpine] + exact hspine input world function (argument :: args) + | erased => + simp only [lowerSpine] + exact hrest input world (_root_.id : Emit) (.constA .erased) args + | var index => exact (lowerSpine_var_extraMonotone + hexpr hknown hrest input world index args) + | ref address => exact (lowerSpine_ref_extraMonotone + hknown input world address args) + | lam uses body => + simp only [lowerSpine] + exact lowerSpine_dynamic_extraMonotone + hexpr hrest input world (.lam uses body) args + | letE uses value body => + simp only [lowerSpine] + exact lowerSpine_dynamic_extraMonotone + hexpr hrest input world (.letE uses value body) args + | proj index source => + simp only [lowerSpine] + exact lowerSpine_dynamic_extraMonotone + hexpr hrest input world (.proj index source) args + | lit literal => + simp only [lowerSpine] + exact lowerSpine_dynamic_extraMonotone + hexpr hrest input world (.lit literal) args + +theorem lowerSpine_dynamic_extraProvenance + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEExtraProvenance src fuel) + (hrest : ApplyRestExtraProvenance src fuel) + (input : VEnv) (world : Owned) (head : IxIR0.Expr) + (args : List IxIR0.Expr) : + ExtraProvenanceMonotone src (do + let (output, emit, function) ← lowerE src fuel input .shared head + applyRest src fuel output world emit function args) := by + apply ExtraProvenanceMonotone.bind (hexpr input .shared head) + intro headResult + rcases headResult with ⟨output, emit, function⟩ + exact hrest output world emit function args + +theorem lowerSpine_var_extraProvenance + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEExtraProvenance src fuel) + (hknown : KnownCallExtraProvenance src fuel) + (hrest : ApplyRestExtraProvenance src fuel) + (input : VEnv) (world : Owned) (index : Nat) + (args : List IxIR0.Expr) : + ExtraProvenanceMonotone src + (lowerSpine src (fuel + 1) input world (.var index) args) := by + simp only [lowerSpine] + cases hentry : input.entries[index]? with + | none => + simp only + exact lowerSpine_dynamic_extraProvenance + hexpr hrest input world (.var index) args + | some entry => + cases entry with + | slot abs remaining uses held => + simp only + exact lowerSpine_dynamic_extraProvenance + hexpr hrest input world (.var index) args + | recSelf arity => + simp only + by_cases hunder : args.length < arity + · simp only [if_pos hunder] + exact ExtraProvenanceMonotone.throw src _ + · simp only [if_neg hunder] + apply ExtraProvenanceMonotone.bind + (requireResultWorld_extraProvenance src .shared world) + intro unitValue + cases unitValue + exact hknown input (.callSelf ·) arity + (List.replicate arity .shared) world args + +theorem lowerSpine_ref_extraProvenance + {src : IxIR0.Env} {fuel : Nat} + (hknown : KnownCallExtraProvenance src fuel) + (input : VEnv) (world : Owned) (address : Ixon.Address) + (args : List IxIR0.Expr) : + ExtraProvenanceMonotone src + (lowerSpine src (fuel + 1) input world (.ref address) args) := by + simp only [lowerSpine] + cases hsource : src address with + | none => + simp only + exact ExtraProvenanceMonotone.throw src _ + | some decl => + cases decl with + | defn result body => + simp only + by_cases hunder : args.length < lamArity body + · simp only [if_pos hunder] + cases world with + | unique => exact ExtraProvenanceMonotone.throw src _ + | shared => + cases result with + | unique => exact ExtraProvenanceMonotone.throw src _ + | shared => + cases hp : papSafe body with + | false => exact ExtraProvenanceMonotone.throw src _ + | true => + exact hknown input (.papp address ·) args.length + (List.replicate args.length .shared) .shared args + · simp only [if_neg hunder] + apply ExtraProvenanceMonotone.bind + (requireResultWorld_extraProvenance src result + (if args.length == lamArity body then world else .shared)) + intro unitValue + cases unitValue + exact hknown input (.call address ·) (lamArity body) + ((lamUses body).map worldOfUses) world args + | ctor tag arity => + simp only + by_cases hunder : args.length < arity + · simp only [if_pos hunder] + cases world with + | unique => exact ExtraProvenanceMonotone.throw src _ + | shared => + apply ExtraProvenanceMonotone.bind + (wrapperFor_extraProvenance src address tag arity) + intro wrapper + exact hknown input (.papp wrapper ·) args.length + (List.replicate args.length .shared) .shared args + · simp only [if_neg hunder] + exact hknown input (.alloc world (ctorIdOf address tag) ·) arity + (List.replicate arity world) world args + | recursor numArgs natLit rules => + simp only + by_cases hunder : args.length < numArgs + 1 + · simp only [if_pos hunder] + cases world with + | unique => exact ExtraProvenanceMonotone.throw src _ + | shared => + exact hknown input (.papp address ·) args.length + (List.replicate args.length .shared) .shared args + · simp only [if_neg hunder] + apply ExtraProvenanceMonotone.bind + (requireResultWorld_extraProvenance src .shared world) + intro unitValue + cases unitValue + exact hknown input (.call address ·) (numArgs + 1) + (List.replicate (numArgs + 1) .shared) world args + | extern arity => + simp only + by_cases hunder : args.length < arity + · simp only [if_pos hunder] + cases world with + | unique => exact ExtraProvenanceMonotone.throw src _ + | shared => + exact hknown input (.papp address ·) args.length + (List.replicate args.length .shared) .shared args + · simp only [if_neg hunder] + exact hknown input (.extern address ·) arity + (List.replicate arity .shared) world args + +theorem lowerSpineExtraProvenance_succ + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEExtraProvenance src fuel) + (hspine : LowerSpineExtraProvenance src fuel) + (hknown : KnownCallExtraProvenance src fuel) + (hrest : ApplyRestExtraProvenance src fuel) : + LowerSpineExtraProvenance src (fuel + 1) := by + intro input world head args + cases head with + | app function argument => + simp only [lowerSpine] + exact hspine input world function (argument :: args) + | erased => + simp only [lowerSpine] + exact hrest input world (_root_.id : Emit) (.constA .erased) args + | var index => exact (lowerSpine_var_extraProvenance + hexpr hknown hrest input world index args) + | ref address => exact (lowerSpine_ref_extraProvenance + hknown input world address args) + | lam uses body => + simp only [lowerSpine] + exact lowerSpine_dynamic_extraProvenance + hexpr hrest input world (.lam uses body) args + | letE uses value body => + simp only [lowerSpine] + exact lowerSpine_dynamic_extraProvenance + hexpr hrest input world (.letE uses value body) args + | proj index source => + simp only [lowerSpine] + exact lowerSpine_dynamic_extraProvenance + hexpr hrest input world (.proj index source) args + | lit literal => + simp only [lowerSpine] + exact lowerSpine_dynamic_extraProvenance + hexpr hrest input world (.lit literal) args + +/-- Result-polymorphic operational classification of one successful lambda +capture. Missing, recursive, released, and unique entries plus capture +overcounts are rejected once here; shared retain/move output reconstruction +is exposed to judgment-specific callbacks. -/ +theorem lowerCapture_run_core + {e : IxIR0.Expr} {input output : VEnv} {i : Nat} + {emit : Emit} {av : AVal} {state finalState : LowSt} + {Result : VEnv → Emit → AVal → Prop} + (hretain : ∀ {abs remaining : Nat} {uses : Uses}, + worldOfUses uses = .shared → + input.entries[i]? = some (.slot abs remaining uses true) → + let next := input.setEntry i + (.slot abs (remaining - countUses i e) uses true) + Result next.bump (emitOp (.dup (.var (next.rel abs)))) + (.slotA next.depth)) + (hmove : ∀ {abs remaining : Nat} {uses : Uses}, + worldOfUses uses = .shared → + input.entries[i]? = some (.slot abs remaining uses true) → + let next := input.setEntry i (.slot abs 0 uses false) + Result next (_root_.id : Emit) (.slotA abs)) + (hrun : (lowerCapture e input i).run state = + .ok (output, emit, av) finalState) : + Result output emit av := by + cases hentry : input.entries[i]? with + | none => + exact (estateThrowRun_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | some entry => + cases entry with + | recSelf arity => + exact (estateThrowRun_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | slot abs remaining uses held => + cases held with + | false => + exact (estateThrowRun_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | true => + by_cases hunique : worldOfUses uses = .unique + · have huuEq : (Owned.unique == Owned.unique) = true := by decide + exact (estateThrowRun_not_ok (by + simpa [lowerCapture, hentry, hunique, huuEq] using hrun)).elim + · have hshared : worldOfUses uses = .shared := by + cases uses <;> simp_all [worldOfUses] + have huniqueEq : + (worldOfUses uses == Owned.unique) = false := by + cases uses <;> simp_all [worldOfUses] <;> decide + by_cases hmore : remaining > countUses i e + · let next := input.setEntry i + (.slot abs (remaining - countUses i e) uses true) + have hpure : + (next.bump, emitOp (.dup (.var (next.rel abs))), + AVal.slotA next.depth) = (output, emit, av) ∧ + state = finalState := by + simpa [lowerCapture, hentry, huniqueEq, hmore, next] + using hrun + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + exact hretain hshared hentry + · by_cases hequal : remaining = countUses i e + · let next := input.setEntry i (.slot abs 0 uses false) + have hpure : + (next, (_root_.id : Emit), AVal.slotA abs) = + (output, emit, av) ∧ state = finalState := by + simpa [lowerCapture, hentry, huniqueEq, hmore, hequal, + next] using hrun + obtain ⟨hresult, hstate⟩ := hpure + have houtput : next = output := + congrArg (fun p : VEnv × Emit × AVal => p.1) hresult + have hemit : (_root_.id : Emit) = emit := + congrArg (fun p : VEnv × Emit × AVal => p.2.1) hresult + have hvalue : AVal.slotA abs = av := + congrArg (fun p : VEnv × Emit × AVal => p.2.2) hresult + subst output + subst emit + subst av + subst finalState + exact hmove hshared hentry + · exact (estateThrowRun_not_ok (by + simpa [lowerCapture, hentry, huniqueEq, hmore, hequal] + using hrun)).elim + +/-- Every successful one-capture compiler step transfers one shared owner: +it retains into a fresh slot when later source uses remain, and otherwise +moves the existing slot owner. Unique/released/recursive entries and capture +overcounts cannot produce a successful run. -/ +theorem lowerCapture_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {e : IxIR0.Expr} {input output : VEnv} {i : Nat} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hrun : (lowerCapture e input i).run state = + .ok (output, emit, av) finalState) : + LowerResultSoundBelow ctx cur limit input output .shared emit av := by + apply lowerCapture_run_core + (Result := fun output emit av => + LowerResultSoundBelow ctx cur limit input output .shared emit av) + (hrun := hrun) + · intro abs remaining uses hshared hentry + let next := input.setEntry i + (.slot abs (remaining - countUses i e) uses true) + have hsound := lower_held_retain_sound_below + (ctx := ctx) (cur := cur) (limit := limit) + (newRemaining := remaining - countUses i e) hshared hentry + simpa [next] using hsound + · intro abs remaining uses hshared hentry + let next := input.setEntry i (.slot abs 0 uses false) + have hsound := lower_held_move_sound_below + (ctx := ctx) (cur := cur) (limit := limit) hentry + simpa [next, hshared] using hsound +private theorem lowerCapture_run_value_sound_at + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {e : IxIR0.Expr} {input output : VEnv} {i : Nat} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsource : sourceEnv[i]? = some sourceValue) + (hrun : (lowerCapture e input i).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue .shared emit av := by + apply lowerCapture_run_core + (Result := fun output emit av => + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceEnv sourceEnv sourceValue .shared emit av) + (hrun := hrun) + · intro abs remaining uses hshared hentry + let next := input.setEntry i + (.slot abs (remaining - countUses i e) uses true) + have hsound := lower_held_retain_value_sound_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) + (newRemaining := remaining - countUses i e) + hsource hshared hentry + simpa [next] using hsound + · intro abs remaining uses hshared hentry + let next := input.setEntry i (.slot abs 0 uses false) + have hsound := lower_held_move_value_sound_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) hsource hentry + simpa [next, hshared] using hsound +/-- Semantic one-capture compiler step. A successful capture selects the +source value at the same de Bruijn index and either moves or retains its +related shared root according to the compiler's remaining-use test. -/ +theorem lowerCapture_run_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {e : IxIR0.Expr} {input output : VEnv} {i : Nat} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsource : sourceEnv[i]? = some sourceValue) + (hrun : (lowerCapture e input i).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue .shared emit av := by + exact LowerResultValueSound.of_below fun limit => + lowerCapture_run_value_sound_at (limit := limit) hsource hrun + +/-- Fuel-bounded semantic one-capture step. -/ +theorem lowerCapture_run_value_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {e : IxIR0.Expr} {input output : VEnv} {i : Nat} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsource : sourceEnv[i]? = some sourceValue) + (hrun : (lowerCapture e input i).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue .shared emit av := by + exact lowerCapture_run_value_sound_at hsource hrun + +/-- The structurally recursive capture traversal is a homogeneous shared +argument prefix. This is exactly the input expected by the existing verified +`papp` allocation rule. -/ +theorem lowerCaptures_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} + (e : IxIR0.Expr) (caps : List Nat) + {input output : VEnv} {emit : Emit} {values : List AVal} + {state finalState : LowSt} + (hrun : (lowerCaptures e input caps).run state = + .ok (output, emit, values) finalState) : + LowerArgsSoundBelow ctx cur limit input output + (List.replicate caps.length .shared) emit values := by + apply lowerCaptures_run_core + (Result := fun input output caps emit values => + LowerArgsSoundBelow ctx cur limit input output + (List.replicate caps.length .shared) emit values) + (e := e) (hrun := hrun) + · intro input + exact lowerArgs_nil_sound_below + · intro index rest input middle output headEmit tailEmit headValue + tailValues state middleState hheadRun htail + have hhead := lowerCapture_run_sound_below + (ctx := ctx) (cur := cur) (limit := limit) hheadRun + simpa [List.replicate_succ] using hhead.consArgs htail + +/-- Source-aligned adapter over the source-neutral successful-capture +traversal. It consumes the `ValuesAt` witness in lockstep with the raw +capture indices; clients supply only the empty judgment and semantic +composition for one successful `lowerCapture`. -/ +theorem ValuesAt.lowerCaptures_core + (e : IxIR0.Expr) {sourceEnv : List IxIR0.Value} + {Result : VEnv → VEnv → List Nat → List IxIR0.Value → + Emit → List AVal → Prop} + (hnil : ∀ input, Result input input [] [] (_root_.id : Emit) []) + (hcons : ∀ {index : Nat} {sourceValue : IxIR0.Value} + {rest : List Nat} {sourceValues : List IxIR0.Value} + {input middle output : VEnv} {headEmit tailEmit : Emit} + {headValue : AVal} {tailValues : List AVal} + {state middleState : LowSt}, + sourceEnv[index]? = some sourceValue → + (lowerCapture e input index).run state = + .ok (middle, headEmit, headValue) middleState → + Result middle output rest sourceValues tailEmit tailValues → + Result input output (index :: rest) (sourceValue :: sourceValues) + (headEmit ∘ tailEmit) (headValue :: tailValues)) + {caps : List Nat} {sourceValues : List IxIR0.Value} + {input output : VEnv} {emit : Emit} {values : List AVal} + {state finalState : LowSt} + (hselected : ValuesAt sourceEnv caps sourceValues) + (hrun : (lowerCaptures e input caps).run state = + .ok (output, emit, values) finalState) : + Result input output caps sourceValues emit values := by + refine (lowerCaptures_run_core + (Result := fun input output caps emit values => + ∀ {selected}, ValuesAt sourceEnv caps selected → + Result input output caps selected emit values) + (e := e) (hrun := hrun) ?_ ?_) hselected + · intro input selected hselected + cases hselected + exact hnil input + · intro index rest input middle output headEmit tailEmit headValue + tailValues state middleState hheadRun htail selected hselected + cases hselected with + | cons hsource htailSelected => + exact hcons hsource hheadRun (htail htailSelected) + +private theorem lowerCaptures_run_value_sound_at + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + (e : IxIR0.Expr) (caps : List Nat) + {sourceEnv sourceValues : List IxIR0.Value} + {input output : VEnv} {emit : Emit} {values : List AVal} + {state finalState : LowSt} + (hselected : ValuesAt sourceEnv caps sourceValues) + (hrun : (lowerCaptures e input caps).run state = + .ok (output, emit, values) finalState) : + LowerArgsValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValues + (List.replicate caps.length .shared) emit values := by + apply ValuesAt.lowerCaptures_core + (e := e) (hselected := hselected) (hrun := hrun) + · intro input + exact lowerArgs_nil_value_sound_below + · intro index sourceValue rest sourceValues input middle output + headEmit tailEmit headValue tailValues state middleState + hsource hheadRun htail + have hhead := lowerCapture_run_value_sound_at + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) hsource hheadRun + simpa [List.replicate_succ] using hhead.consArgs htail + +/-- Semantic capture traversal. The returned pap arguments realize exactly +the selected source-environment values, in the compiler's capture order. -/ +theorem lowerCaptures_run_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + (e : IxIR0.Expr) (caps : List Nat) + {sourceEnv sourceValues : List IxIR0.Value} + {input output : VEnv} {emit : Emit} {values : List AVal} + {state finalState : LowSt} + (hselected : ValuesAt sourceEnv caps sourceValues) + (hrun : (lowerCaptures e input caps).run state = + .ok (output, emit, values) finalState) : + LowerArgsValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValues + (List.replicate caps.length .shared) emit values := by + exact LowerArgsValueSound.of_below fun limit => + lowerCaptures_run_value_sound_at (limit := limit) + e caps hselected hrun + +/-- Fuel-bounded semantic capture traversal. -/ +theorem lowerCaptures_run_value_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + (e : IxIR0.Expr) (caps : List Nat) + {sourceEnv sourceValues : List IxIR0.Value} + {input output : VEnv} {emit : Emit} {values : List AVal} + {state finalState : LowSt} + (hselected : ValuesAt sourceEnv caps sourceValues) + (hrun : (lowerCaptures e input caps).run state = + .ok (output, emit, values) finalState) : + LowerArgsValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValues + (List.replicate caps.length .shared) emit values := by + exact lowerCaptures_run_value_sound_at e caps hselected hrun + +/-- Successful capture lowering preserves the statically selected capture +count. Besides documenting the shape of `lowerCaptures`, this lets the +ownership proof index its homogeneous shared prefix by the returned values, +as required by the verified `papp` rule. -/ +theorem lowerCaptures_success_length (e : IxIR0.Expr) : + ∀ {caps : List Nat} {input output : VEnv} {emit : Emit} + {values : List AVal} {state finalState : LowSt}, + (lowerCaptures e input caps).run state = + .ok (output, emit, values) finalState → + values.length = caps.length := by + intro caps input output emit values state finalState hrun + apply lowerCaptures_run_core + (Result := fun _ _ caps _ values => + values.length = caps.length) + (e := e) (hrun := hrun) + · intro input + rfl + · intro index rest input middle output headEmit tailEmit headValue + tailValues state middleState hheadRun htail + simpa using congrArg Nat.succ htail + +/-- Result-polymorphic operational inversion for successful local-lambda +lowering. Fuel and pap-safety rejection, capture/fresh/body bind inversion, +the generated-declaration push, and final pap-result reconstruction are +performed once; ownership and graph judgments consume the canonical runs +and exact predecessor-fuel equality through `hsuccess`. -/ +theorem lowerLam_run_core + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {e : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} + {Result : LowSt → VEnv → Emit → AVal → Prop} + (hsuccess : ∀ {bodyFuel : Nat} + {captureOutput : VEnv} {captureEmit : Emit} + {captureValues : List AVal} {captureState : LowSt} + {fnAddr : Ixon.Address} {addressState : LowSt} + {code : Code} {bodyState : LowSt}, + bodyFuel + 1 = fuel → + papSafe e = true → + (lowerCaptures e input + (liftCaptureIndices input.entries.length e)).run state = + .ok (captureOutput, captureEmit, captureValues) captureState → + freshAddr.run captureState = .ok fnAddr addressState → + (lowerFnBody src bodyFuel + (liftedBodyVEnv input.entries.length e) + (liftedBodyDrops input.entries.length e) .shared + (stripLams e)).run addressState = .ok code bodyState → + Result + { bodyState with + extra := (fnAddr, .fn + ⟨(liftCaptureIndices input.entries.length e).length + + lamArity e, + .shared, true, code⟩) :: bodyState.extra } + captureOutput.bump + (captureEmit ∘ emitOp (.papp fnAddr + (captureValues.map (·.toAtom captureOutput)).toArray)) + (.slotA captureOutput.depth)) + (hrun : (lowerLam src fuel input e).run state = + .ok (output, emit, av) finalState) : + Result finalState output emit av := by + cases fuel with + | zero => + simp [lowerLam] at hrun + exact (estateThrowRun_not_ok hrun).elim + | succ bodyFuel => + cases hp : papSafe e with + | false => + simp [lowerLam, hp] at hrun + | true => + simp only [lowerLam] at hrun + simp only [hp, ↓reduceIte, bind_pure_comp] at hrun + let caps := liftCaptureIndices input.entries.length e + have hcaps : caps = (List.range input.entries.length).filter + (fun index => countUses index e > 0) := by + rfl + rw [← hcaps] at hrun + obtain ⟨captureResult, captureState, hcaptureRun, hafterCapture⟩ := + estateBindRun_ok_inv hrun + rcases captureResult with ⟨captureOutput, captureEmit, captureValues⟩ + dsimp only at hafterCapture + obtain ⟨fnAddr, addressState, hfreshRun, hafterFresh⟩ := + estateBindRun_ok_inv hafterCapture + obtain ⟨code, bodyState, hbodyRun, hafterBody⟩ := + estateBindRun_ok_inv hafterFresh + change + (pushExtra + (fnAddr, .fn + ⟨caps.length + lamArity e, .shared, true, code⟩) >>= fun _ => + pure (captureOutput.bump, + captureEmit ∘ emitOp (.papp fnAddr + (captureValues.map (·.toAtom captureOutput)).toArray), + .slotA captureOutput.depth)).run bodyState = + .ok (output, emit, av) finalState at hafterBody + obtain ⟨unitValue, pushedState, hpushRun, hpureRun⟩ := + estateBindRun_ok_inv hafterBody + cases unitValue + have hpure : + (captureOutput.bump, + captureEmit ∘ emitOp (.papp fnAddr + (captureValues.map (·.toAtom captureOutput)).toArray), + AVal.slotA captureOutput.depth) = + (output, emit, av) ∧ + pushedState = finalState := by + simpa using hpureRun + obtain ⟨hresult, hstate⟩ := hpure + have hentryCount : captureOutput.entries.length = + input.entries.length := + lowerCaptures_preservesEntryCount e hcaptureRun + have hbodyRun' := hbodyRun + rw [hentryCount] at hbodyRun' + have hcanonicalBody : + (lowerFnBody src bodyFuel + (liftedBodyVEnv input.entries.length e) + (liftedBodyDrops input.entries.length e) .shared + (stripLams e)).run addressState = .ok code bodyState := by + simpa [liftedBodyVEnv, liftedBodyDrops, liftCaptureIndices, + caps] using hbodyRun' + cases hresult + subst finalState + simp [pushExtra] at hpushRun + subst pushedState + simpa [caps] using + (hsuccess (by simp) hp (by simpa [caps] using hcaptureRun) + hfreshRun hcanonicalBody) + +/-- A successful positive-arity lambda run preserves nested provenance from +its body and records the exact body-lowering witness for its own prepend. -/ +theorem lowerLam_extraProvenance_succ + {src : IxIR0.Env} {fuel : Nat} + (hfn : LowerFnBodyExtraProvenance src fuel) + (input : VEnv) (e : IxIR0.Expr) (hpositive : 0 < lamArity e) : + ExtraProvenanceMonotone src (lowerLam src (fuel + 1) input e) := by + intro state finalState result hrun + rcases result with ⟨output, emit, value⟩ + apply lowerLam_run_core + (Result := fun finalState _ _ _ => + ExtraProvenanceExtends src state finalState) + (hrun := hrun) + intro bodyFuel captureOutput captureEmit captureValues captureState + fnAddr addressState code bodyState hfuel hsafe hcaptureRun hfreshRun + hbodyRun + have hbodyFuel : bodyFuel = fuel := by omega + subst bodyFuel + have hcaptures := lowerCaptures_extraProvenance src e input + (liftCaptureIndices input.entries.length e) hcaptureRun + have hfresh := freshAddr_extraProvenance src hfreshRun + have hbody := hfn + (liftedBodyVEnv input.entries.length e) + (liftedBodyDrops input.entries.length e) .shared (stripLams e) hbodyRun + let d : FnDef := + ⟨(liftCaptureIndices input.entries.length e).length + lamArity e, + .shared, true, code⟩ + let pushed : LowSt := + { bodyState with extra := (fnAddr, .fn d) :: bodyState.extra } + have hextends : ExtraExtends bodyState pushed := by + refine ⟨[(fnAddr, .fn d)], [], ?_, ?_, ?_⟩ + · simp [pushed] + · simp [pushed] + · simp + have hpushed : ExtraProvenanceExtends src bodyState pushed := by + refine ⟨hextends, ?_⟩ + intro item hmember + change item ∈ (fnAddr, .fn d) :: bodyState.extra at hmember + rw [List.mem_cons] at hmember + cases hmember with + | inr hold => exact Or.inl hold + | inl hnew => + subst item + exact Or.inr (Or.inr + ⟨fnAddr, input.entries.length, e, fuel, addressState, + bodyState, code, rfl, hpositive, hsafe, hbodyRun, hextends, + by simp [pushed, d]⟩) + simpa [pushed, d] using + ((hcaptures.trans hfresh).trans hbody).trans hpushed + +/-- Judgment-polymorphic semantic assembly for successful local-lambda +lowering. Canonical capture identity, lifted-code provenance, selected source +captures, represented-declaration recovery, function relation construction, +and the strict pap-prefix bound are established once. Callbacks supply only +the capture-argument judgment and its pap closure, allowing soundness, +progress, and profile proofs to share the same semantic spine. -/ +theorem lowerLam_run_value_core + {funRel : Sim.FunctionRel} {ctx : Ctx} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {e : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + {ArgsResult : List IxIR0.Value → VEnv → Emit → List AVal → Prop} + {Result : LowSt → VEnv → Emit → AVal → Prop} + (hcapture : ∀ {caps : List Nat} {selected : List IxIR0.Value} + {captureOutput : VEnv} {captureEmit : Emit} + {captureValues : List AVal} {captureState : LowSt}, + caps = liftCaptureIndices input.entries.length e → + ValuesAt sourceEnv caps selected → + (lowerCaptures e input caps).run state = + .ok (captureOutput, captureEmit, captureValues) captureState → + captureValues.length = caps.length → + ArgsResult selected captureOutput captureEmit captureValues) + (hpapp : ∀ {caps : List Nat} {selected : List IxIR0.Value} + {captureOutput : VEnv} {captureEmit : Emit} + {captureValues : List AVal} {fnAddr : Ixon.Address} + {code : Code} {bodyState : LowSt}, + caps = liftCaptureIndices input.entries.length e → + ArgsResult selected captureOutput captureEmit captureValues → + ctx.decls fnAddr = some (.fn + ⟨caps.length + lamArity e, .shared, true, code⟩) → + funRel sourceValue fnAddr + (caps.length + lamArity e) selected → + captureValues.length < caps.length + lamArity e → + Result + { bodyState with + extra := (fnAddr, .fn + ⟨caps.length + lamArity e, .shared, true, code⟩) :: + bodyState.extra } + captureOutput.bump + (captureEmit ∘ emitOp (.papp fnAddr + (captureValues.map (·.toAtom captureOutput)).toArray)) + (.slotA captureOutput.depth)) + (hsourceLength : sourceEnv.length = input.entries.length) + (hprefix : LambdaPrefix sourceEnv e [] sourceValue) + (hinclude : ∀ value address arity captures, + CompilerLiftedFunctionRel src finalState value address arity captures → + funRel value address arity captures) + (hrepresented : ExtraRepresented ctx finalState) + (hrun : (lowerLam src fuel input e).run state = + .ok (output, emit, av) finalState) : + Result finalState output emit av := by + have hpositive : 0 < lamArity e := by + have hunder := hprefix.length_lt_lamArity + simpa using hunder + refine lowerLam_run_core + (Result := fun finalState output emit av => + (∀ value address arity captures, + CompilerLiftedFunctionRel src finalState value address arity captures → + funRel value address arity captures) → + ExtraRepresented ctx finalState → + Result finalState output emit av) + ?_ hrun hinclude hrepresented + intro bodyFuel captureOutput captureEmit captureValues _captureState + fnAddr addressState code bodyState _hfuel hp hcaptureRun _hfreshRun hbodyRun + hinclude hrepresented + let caps := liftCaptureIndices input.entries.length e + let ambient : LowSt := + { bodyState with + extra := (fnAddr, .fn + ⟨caps.length + lamArity e, .shared, true, code⟩) :: bodyState.extra } + change (lowerCaptures e input caps).run state = + .ok (captureOutput, captureEmit, captureValues) _ at hcaptureRun + change (∀ value address arity captures, + CompilerLiftedFunctionRel src ambient value address arity captures → + funRel value address arity captures) at hinclude + change ExtraRepresented ctx ambient at hrepresented + have hdecl : ctx.decls fnAddr = some (.fn + ⟨caps.length + lamArity e, .shared, true, code⟩) := by + apply hrepresented.decl + simp [ambient] + have hliftCode : CompilerLiftCodeRel src ambient fnAddr + input.entries.length e := by + refine ⟨bodyFuel, addressState, bodyState, code, hp, hbodyRun, ?_, ?_⟩ + · refine ⟨[(fnAddr, .fn + ⟨caps.length + lamArity e, .shared, true, code⟩)], [], ?_, ?_, ?_⟩ + · simp [ambient] + · simp [ambient] + · simp + · simp [ambient, caps] + obtain ⟨selected, hselected⟩ := + ValuesAt.exists_liftCaptureIndices sourceEnv + input.entries.length e hsourceLength + have hselectedCaps : ValuesAt sourceEnv caps selected := by + simpa [caps] using hselected + have hselectedLength : selected.length = caps.length := + hselectedCaps.length + have hlength := lowerCaptures_success_length e hcaptureRun + have hargs := hcapture rfl hselectedCaps hcaptureRun hlength + have hlifted : CompilerLiftedFunctionRel src ambient sourceValue + fnAddr (caps.length + lamArity e) selected := by + refine ⟨sourceEnv, e, selected, [], ?_, ?_, ?_, ?_, hprefix⟩ + · simpa [hsourceLength] using hliftCode + · simpa [hsourceLength] using hselected + · simp + · simp [hselectedLength] + have hfun : funRel sourceValue fnAddr + (caps.length + lamArity e) selected := + hinclude sourceValue fnAddr _ selected hlifted + have hunder : captureValues.length < caps.length + lamArity e := by + omega + change Result ambient captureOutput.bump + (captureEmit ∘ emitOp (.papp fnAddr + (captureValues.map (·.toAtom captureOutput)).toArray)) + (.slotA captureOutput.depth) + exact hpapp rfl hargs hdecl hfun hunder + +/-- A successful local-lambda lowering consumes its captures as shared +arguments and installs them in a fresh partial-application node. The nested +lifted body may itself extend `LowSt`; only the final declaration-layout fact +is needed for ownership of the allocation performed at the lambda site. -/ +theorem lowerLam_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {e : IxIR0.Expr} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hpositive : 0 < lamArity e) + (hrepresented : ExtraRepresented ctx finalState) + (hrun : (lowerLam src fuel input e).run state = + .ok (output, emit, av) finalState) : + LowerResultSoundBelow ctx cur limit input output .shared emit av := by + refine lowerLam_run_core + (Result := fun finalState output emit av => + ExtraRepresented ctx finalState → + LowerResultSoundBelow ctx cur limit input output .shared emit av) + ?_ hrun hrepresented + intro _bodyFuel captureOutput captureEmit captureValues _captureState + fnAddr _addressState code _bodyState _hfuel _hp hcaptureRun _hfreshRun + _hbodyRun hrepresented + let caps := liftCaptureIndices input.entries.length e + change (lowerCaptures e input caps).run state = + .ok (captureOutput, captureEmit, captureValues) _ at hcaptureRun + have hdecl : ctx.decls fnAddr = some (.fn + ⟨caps.length + lamArity e, .shared, true, code⟩) := by + apply hrepresented.decl + simp [caps] + have hlength := lowerCaptures_success_length e hcaptureRun + have hcaptures := lowerCaptures_run_sound_below + (ctx := ctx) (cur := cur) (limit := limit) e caps hcaptureRun + have hargs : LowerArgsSoundBelow ctx cur limit input captureOutput + (List.replicate captureValues.length .shared) + captureEmit captureValues := by + simpa [hlength] using hcaptures + apply hargs.papp_owned hdecl + simp only [declArity] + omega + +private theorem lowerLam_run_value_sound_at + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {e : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsourceLength : sourceEnv.length = input.entries.length) + (hprefix : LambdaPrefix sourceEnv e [] sourceValue) + (hinclude : ∀ value address arity captures, + CompilerLiftedFunctionRel src finalState value address arity captures → + funRel value address arity captures) + (hrepresented : ExtraRepresented ctx finalState) + (hrun : (lowerLam src fuel input e).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue .shared emit av := by + apply lowerLam_run_value_core + (ArgsResult := fun selected captureOutput captureEmit captureValues => + LowerArgsValueSoundBelow funRel recSelfRel ctx cur limit + input captureOutput sourceEnv sourceEnv selected + (List.replicate captureValues.length .shared) + captureEmit captureValues) + (Result := fun _ output emit av => + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceEnv sourceEnv sourceValue .shared emit av) + (hsourceLength := hsourceLength) (hprefix := hprefix) + (hinclude := hinclude) (hrepresented := hrepresented) (hrun := hrun) + · intro caps selected captureOutput captureEmit captureValues + _captureState _hcanonical hselected hcaptureRun hlength + have hcaptures := lowerCaptures_run_value_sound_at + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) + e caps hselected hcaptureRun + simpa [hlength] using hcaptures + · intro _caps _selected _captureOutput _captureEmit _captureValues + _fnAddr _code _bodyState _hcanonical hargs hdecl hfun hunder + apply hargs.papp_graph hdecl + · simpa only [declArity] using hfun + · simpa only [declArity] using hunder + +/-- Semantic local-lambda lowering. The capture traversal constructs the +selected source-value prefix, the exact generated body run establishes +compiler provenance for the fresh address, and pap allocation yields a +`ValueGraph` for the source closure. `hinclude` embeds this lifted-only +relation into the whole-program function relation used by surrounding code. -/ +theorem lowerLam_run_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {e : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsourceLength : sourceEnv.length = input.entries.length) + (hprefix : LambdaPrefix sourceEnv e [] sourceValue) + (hinclude : ∀ value address arity captures, + CompilerLiftedFunctionRel src finalState value address arity captures → + funRel value address arity captures) + (hrepresented : ExtraRepresented ctx finalState) + (hrun : (lowerLam src fuel input e).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue .shared emit av := by + exact LowerResultValueSound.of_below fun limit => + lowerLam_run_value_sound_at (limit := limit) hsourceLength hprefix + hinclude hrepresented hrun + +/-- Fuel-bounded semantic local-lambda lowering. Generated-function +provenance is fuel-independent; only capture sequencing and pap allocation +use the bounded emitter interface. -/ +theorem lowerLam_run_value_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {e : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsourceLength : sourceEnv.length = input.entries.length) + (hprefix : LambdaPrefix sourceEnv e [] sourceValue) + (hinclude : ∀ value address arity captures, + CompilerLiftedFunctionRel src finalState value address arity captures → + funRel value address arity captures) + (hrepresented : ExtraRepresented ctx finalState) + (hrun : (lowerLam src fuel input e).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue .shared emit av := by + exact lowerLam_run_value_sound_at hsourceLength hprefix hinclude + hrepresented hrun + +/-- Independently of semantic provenance, a successful `lowerLam` run ends +by allocating a pap result in a fresh runtime slot. -/ +theorem lowerLam_run_result_slot + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {e : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hrun : (lowerLam src fuel input e).run state = + .ok (output, emit, av) finalState) : + ∃ abs, av = .slotA abs := by + apply lowerLam_run_core + (Result := fun _ _ _ av => ∃ abs, av = .slotA abs) + (hrun := hrun) + intro _bodyFuel captureOutput _captureEmit _captureValues _captureState + _fnAddr _addressState _code _bodyState _hfuel _hp _hcaptureRun _hfreshRun + _hbodyRun + exact ⟨captureOutput.depth, rfl⟩ + +theorem lowerE_lam_run_ne_constErased + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {world : Owned} {uses : Uses} {body : IxIR0.Expr} + {emit : Emit} {state finalState : LowSt} + (hrun : (lowerE src (fuel + 1) input world (.lam uses body)).run state = + .ok (output, emit, .constA .erased) finalState) : + False := by + cases world with + | unique => + exact estateThrowRun_not_ok (by simpa [lowerE] using hrun) + | shared => + have hlam : (lowerLam src fuel input (.lam uses body)).run state = + .ok (output, emit, .constA .erased) finalState := by + simpa [lowerE] using hrun + obtain ⟨abs, hav⟩ := lowerLam_run_result_slot hlam + contradiction + +/-- The lambda branch of `lowerE`: unique demand cannot succeed, while a +shared demand delegates to the verified capture-and-`papp` lowering above. -/ +theorem lowerE_lam_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Owned} {uses : Uses} + {body : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hrepresented : ExtraRepresented ctx finalState) + (hrun : (lowerE src (fuel + 1) input world (.lam uses body)).run state = + .ok (output, emit, av) finalState) : + LowerResultSoundBelow ctx cur limit input output world emit av := by + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + apply False.elim + apply estateThrowRun_not_ok + simpa [lowerE, huuEq] using hrun + | shared => + have hlam : (lowerLam src fuel input (.lam uses body)).run state = + .ok (output, emit, av) finalState := by + simpa [lowerE, hsuEq] using hrun + exact lowerLam_run_sound_below (by simp [lamArity]) + hrepresented hlam + +private theorem lowerE_lam_run_value_sound_at + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Owned} {uses : Uses} + {body : IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsourceLength : sourceEnv.length = input.entries.length) + (hinclude : ∀ value address arity captures, + CompilerLiftedFunctionRel src finalState value address arity captures → + funRel value address arity captures) + (hrepresented : ExtraRepresented ctx finalState) + (hrun : (lowerE src (fuel + 1) input world (.lam uses body)).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv (.clos uses sourceEnv body) world emit av := by + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (estateThrowRun_not_ok (by + simpa [lowerE, huuEq] using hrun)).elim + | shared => + have hlam : (lowerLam src fuel input (.lam uses body)).run state = + .ok (output, emit, av) finalState := by + simpa [lowerE, hsuEq] using hrun + exact lowerLam_run_value_sound_at (limit := limit) + hsourceLength .nil hinclude + hrepresented hlam + +/-- Semantic lambda branch of `lowerE`. The source evaluator returns its +closure immediately; successful shared lowering realizes that closure by the +fresh compiler-provenanced pap constructed above. -/ +theorem lowerE_lam_run_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Owned} {uses : Uses} + {body : IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsourceLength : sourceEnv.length = input.entries.length) + (hinclude : ∀ value address arity captures, + CompilerLiftedFunctionRel src finalState value address arity captures → + funRel value address arity captures) + (hrepresented : ExtraRepresented ctx finalState) + (hrun : (lowerE src (fuel + 1) input world (.lam uses body)).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv (.clos uses sourceEnv body) world emit av := by + exact LowerResultValueSound.of_below fun limit => + lowerE_lam_run_value_sound_at (limit := limit) hsourceLength hinclude + hrepresented hrun + +private theorem lowerE_lam_run_value_sound_any_at + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Owned} {uses : Uses} + {body : IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hinclude : ∀ value address arity captures, + CompilerLiftedFunctionRel src finalState value address arity captures → + funRel value address arity captures) + (hrepresented : ExtraRepresented ctx finalState) + (hrun : (lowerE src (fuel + 1) input world (.lam uses body)).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv (.clos uses sourceEnv body) world emit av := by + by_cases hlength : sourceEnv.length = input.entries.length + · exact lowerE_lam_run_value_sound_at hlength hinclude hrepresented hrun + · exact (lowerE_lam_run_sound_below (limit := limit) hrepresented hrun) + |>.valueSound_of_sourceLength_ne hlength + +/-- Premise-free lambda semantics at the expression interface. A realizable +semantic input necessarily has the source/logical length required by capture +selection; if the indices are malformed, the graph transformer is vacuous +while the already-proved ownership transformer remains substantive. -/ +theorem lowerE_lam_run_value_sound_any + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Owned} {uses : Uses} + {body : IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hinclude : ∀ value address arity captures, + CompilerLiftedFunctionRel src finalState value address arity captures → + funRel value address arity captures) + (hrepresented : ExtraRepresented ctx finalState) + (hrun : (lowerE src (fuel + 1) input world (.lam uses body)).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv (.clos uses sourceEnv body) world emit av := by + exact LowerResultValueSound.of_below fun limit => + lowerE_lam_run_value_sound_any_at (limit := limit) hinclude + hrepresented hrun + +/-- Fuel-bounded semantic lambda branch with an explicit environment-length +witness. -/ +theorem lowerE_lam_run_value_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Owned} {uses : Uses} + {body : IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsourceLength : sourceEnv.length = input.entries.length) + (hinclude : ∀ value address arity captures, + CompilerLiftedFunctionRel src finalState value address arity captures → + funRel value address arity captures) + (hrepresented : ExtraRepresented ctx finalState) + (hrun : (lowerE src (fuel + 1) input world (.lam uses body)).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv (.clos uses sourceEnv body) world emit av := by + exact lowerE_lam_run_value_sound_at hsourceLength hinclude hrepresented hrun + +/-- Premise-free bounded lambda semantics. A graph-realizable input supplies +the required source/logical length; otherwise the graph transformer is +vacuous while the bounded ownership proof remains meaningful. -/ +theorem lowerE_lam_run_value_sound_any_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Owned} {uses : Uses} + {body : IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hinclude : ∀ value address arity captures, + CompilerLiftedFunctionRel src finalState value address arity captures → + funRel value address arity captures) + (hrepresented : ExtraRepresented ctx finalState) + (hrun : (lowerE src (fuel + 1) input world (.lam uses body)).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv (.clos uses sourceEnv body) world emit av := by + exact lowerE_lam_run_value_sound_any_at hinclude hrepresented hrun + +/-- Returning a lowered value is ownership-correct once every source entry +has been released or moved. -/ +theorem ret_owns {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {world : Owned} {av : AVal} {rest : List Root} + (hreleased : EntriesReleased Γ.entries) : + CodeOwns ctx cur (OwnsResult Γ world av rest) + (fun store value => RootOwnership store (⟨world, value⟩ :: rest)) + (.ret (av.toAtom Γ)) := by + intro fuel store runtimeEnv store' value hpre hrun + obtain ⟨roots, result, hΓ, hav, hown⟩ := hpre + have hroots : roots = [] := + EntriesRealize.eq_nil_of_released hreleased hΓ.entries + subst roots + cases fuel with + | zero => simp [runCode] at hrun + | succ fuel => + rw [Nat.add_one] at hrun + rw [runCode.eq_def] at hrun + dsimp only at hrun + rw [hav.resolveAtom] at hrun + change (Except.ok (store, result) : Except Err (Store × RVal)) = + .ok (store', value) at hrun + have hpair : (store, result) = (store', value) := Except.ok.inj hrun + cases hpair + simpa using hown + +/-- Close a sound expression emitter with the actual `ret` used by +`lowerFnBody`. This is the base shape of the eventual function-contract +construction. -/ +theorem LowerResultSound.close {ctx : Ctx} {cur : FnDef} + {input output : VEnv} {world : Owned} {emit : Emit} {av : AVal} + (hsound : LowerResultSound ctx cur input output world emit av) + (hreleased : EntriesReleased output.entries) (rest : List Root) : + CodeOwns ctx cur (OwnsVEnv input rest) + (fun store value => RootOwnership store (⟨world, value⟩ :: rest)) + (emit (.ret (av.toAtom output))) := by + intro fuel store env store' value hpre hrun + have hret : CodeOwns ctx cur + (OwnsResultProtected output world av rest []) + (fun store value => RootOwnership store (⟨world, value⟩ :: rest)) + (.ret (av.toAtom output)) := by + intro innerFuel innerStore innerEnv finalStore finalValue hprotected hretRun + exact ret_owns hreleased hprotected.1 hretRun + have hcode : CodeOwns ctx cur (OwnsVEnvProtected input rest []) + (fun store value => RootOwnership store (⟨world, value⟩ :: rest)) + (emit (.ret (av.toAtom output))) := + hsound.emits rest [] _ _ hret + exact hcode ⟨hpre, SlotsRealize.nil⟩ hrun + +/-- Fuel-bounded counterpart of `LowerResultSound.close`. -/ +theorem LowerResultSoundBelow.close {ctx : Ctx} {cur : FnDef} + {limit : Nat} {input output : VEnv} {world : Owned} + {emit : Emit} {av : AVal} + (hsound : LowerResultSoundBelow ctx cur limit input output world emit av) + (hreleased : EntriesReleased output.entries) (rest : List Root) : + CodeOwnsBelow ctx cur limit (OwnsVEnv input rest) + (fun store value => RootOwnership store (⟨world, value⟩ :: rest)) + (emit (.ret (av.toAtom output))) := by + have hret : CodeOwnsBelow ctx cur limit + (OwnsResultProtected output world av rest []) + (fun store value => RootOwnership store (⟨world, value⟩ :: rest)) + (.ret (av.toAtom output)) := by + intro fuel store env store' value _ hprotected hrun + exact ret_owns hreleased hprotected.1 hrun + have hcode : CodeOwnsBelow ctx cur limit + (OwnsVEnvProtected input rest []) + (fun store value => RootOwnership store (⟨world, value⟩ :: rest)) + (emit (.ret (av.toAtom output))) := + hsound.emits rest [] limit (Nat.le_refl _) _ _ hret + intro fuel store env store' value hfuel hpre hrun + exact hcode hfuel ⟨hpre, SlotsRealize.nil⟩ hrun + +/-! ## Function-entry contracts -/ + +/-- Relate a lowerer's absolute-slot environment to the source-order +argument telescope of a function contract. `runCode` enters a function with +`args.reverse`, while `EntriesRealize` follows the lowerer's source-variable +order, so the realized roots need only be a permutation of the public +source-order roots. -/ +def FnEntryRealizes (input : VEnv) (argWorlds : List Owned) : Prop := + ∀ {args : List RVal}, args.length = argWorlds.length → + ∃ roots, + VEnvRealizes input args.reverse roots ∧ + roots.Perm (rootsForWorlds argWorlds args) + +theorem FnEntryRealizes.empty : + FnEntryRealizes ⟨[], 0⟩ [] := by + intro args hlength + cases args with + | nil => exact ⟨[], ⟨rfl, EntriesRealize.nil⟩, List.Perm.refl []⟩ + | cons arg tail => simp at hlength + +/-- The canonical one-parameter entry layout used by `lowerDecl`. The +remaining-use count is irrelevant at entry; it affects only subsequent +lowering transitions. -/ +theorem FnEntryRealizes.singleton (uses : Uses) (remaining : Nat) : + FnEntryRealizes + ⟨[.slot 0 remaining uses true], 1⟩ + [worldOfUses uses] := by + intro args hlength + cases args with + | nil => simp at hlength + | cons arg tail => + cases tail with + | nil => + refine ⟨[⟨worldOfUses uses, arg⟩], ?_, List.Perm.refl _⟩ + constructor + · rfl + · exact EntriesRealize.held (by simp) rfl EntriesRealize.nil + | cons next tail => simp at hlength + +/-- Canonical parameter entries realize the reversed runtime argument stack +even in the presence of `base` older slots below the telescope. The extra +`suffix` is precisely those older slots. -/ +theorem parameterEntries_entriesRealize (remaining : Nat → Nat) : + ∀ (base : Nat) (modes : List Uses) {args suffix : List RVal}, + args.length = modes.length → suffix.length = base → + let Γ : VEnv := + ⟨parameterEntries base modes remaining, base + modes.length⟩ + EntriesRealize Γ (args.reverse ++ suffix) Γ.entries + (rootsForWorlds (modes.map worldOfUses) args).reverse := by + intro base modes + exact parameterEntries_traverse remaining + (Result := fun current sourceModes entries => + ∀ {runtimeArgs suffix : List RVal}, + runtimeArgs.length = sourceModes.length → + suffix.length = current → + let Γ : VEnv := ⟨entries, current + sourceModes.length⟩ + EntriesRealize Γ (runtimeArgs.reverse ++ suffix) entries + (rootsForWorlds (sourceModes.map worldOfUses) + runtimeArgs).reverse) + (hnil := by + intro current runtimeArgs suffix hargs hsuffix + cases runtimeArgs with + | nil => exact EntriesRealize.nil + | cons arg tail => simp at hargs) + (hcons := by + intro current mode rest innerEntries ih runtimeArgs suffix hargs + hsuffix + cases runtimeArgs with + | nil => simp at hargs + | cons arg args => + have htail : args.length = rest.length := by simpa using hargs + let Γ : VEnv := + ⟨innerEntries ++ + [.slot current (remaining rest.length) mode true], + current + (mode :: rest).length⟩ + let Δ : VEnv := + ⟨innerEntries, (current + 1) + rest.length⟩ + have hinner₀ := ih (runtimeArgs := args) + (suffix := arg :: suffix) htail (by simp [hsuffix]) + have hdepth : Δ.depth = Γ.depth := by + simp [Δ, Γ] + omega + have hinner : EntriesRealize Γ + ((arg :: args).reverse ++ suffix) innerEntries + (rootsForWorlds (rest.map worldOfUses) args).reverse := by + have htransport := hinner₀.of_depth_eq hdepth + simpa [List.reverse_cons, List.append_assoc, Δ, Γ] using + htransport + have houter : EntriesRealize Γ + ((arg :: args).reverse ++ suffix) + [.slot current (remaining rest.length) mode true] + [⟨worldOfUses mode, arg⟩] := by + apply EntriesRealize.held + · simp [Γ] + · simp [Γ, VEnv.rel, List.reverse_cons, htail] + · exact EntriesRealize.nil + simpa [Γ, List.reverse_cons] using hinner.append houter) + base modes + +/-- Canonical parameter entries also realize the source argument vector +pointwise. The generalized `base`/`suffix` form is what makes the recursive +tail layout line up with absolute slots. -/ +theorem parameterEntries_entriesValueGraph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} {store : Store} + (remaining : Nat → Nat) : + ∀ (base : Nat) (modes : List Uses) + {sourceArgs : List IxIR0.Value} {args suffix : List RVal}, + args.length = modes.length → suffix.length = base → + Sim.ValuesGraph funRel store sourceArgs args → + (∀ root, root ∈ rootsForWorlds (modes.map worldOfUses) args → + HasWorld store root.world root.value) → + let Γ : VEnv := + ⟨parameterEntries base modes remaining, base + modes.length⟩ + EntriesValueGraph funRel recSelfRel store Γ + (args.reverse ++ suffix) Γ.entries sourceArgs.reverse + (rootsForWorlds (modes.map worldOfUses) args).reverse := by + intro base modes + exact parameterEntries_traverse remaining + (Result := fun current sourceModes entries => + ∀ {sourceArgs : List IxIR0.Value} {runtimeArgs suffix : List RVal}, + runtimeArgs.length = sourceModes.length → + suffix.length = current → + Sim.ValuesGraph funRel store sourceArgs runtimeArgs → + (∀ root, + root ∈ rootsForWorlds (sourceModes.map worldOfUses) runtimeArgs → + HasWorld store root.world root.value) → + let Γ : VEnv := ⟨entries, current + sourceModes.length⟩ + EntriesValueGraph funRel recSelfRel store Γ + (runtimeArgs.reverse ++ suffix) entries sourceArgs.reverse + (rootsForWorlds (sourceModes.map worldOfUses) + runtimeArgs).reverse) + (hnil := by + intro current sourceArgs runtimeArgs suffix hargs hsuffix hgraphs + hworlds + cases runtimeArgs with + | nil => + cases hgraphs + exact EntriesValueGraph.nil + | cons arg tail => simp at hargs) + (hcons := by + intro current mode rest innerEntries ih sourceArgs runtimeArgs suffix + hargs hsuffix hgraphs hworlds + cases runtimeArgs with + | nil => simp at hargs + | cons arg args => + cases hgraphs with + | @cons source arg sources args hvalue htailGraphs => + have htail : args.length = rest.length := by + simpa using hargs + let Γ : VEnv := + ⟨innerEntries ++ + [.slot current (remaining rest.length) mode true], + current + (mode :: rest).length⟩ + let Δ : VEnv := + ⟨innerEntries, (current + 1) + rest.length⟩ + have hinner₀ := ih (sourceArgs := sources) (runtimeArgs := args) + (suffix := arg :: suffix) htail (by simp [hsuffix]) htailGraphs + (by + intro root hroot + exact hworlds root (by simp [hroot])) + have hdepth : Δ.depth = Γ.depth := by + simp [Δ, Γ] + omega + have hinner : EntriesValueGraph funRel recSelfRel store Γ + ((arg :: args).reverse ++ suffix) innerEntries sources.reverse + (rootsForWorlds (rest.map worldOfUses) args).reverse := by + have htransport := hinner₀.of_depth_eq hdepth + simpa [List.reverse_cons, List.append_assoc, Δ, Γ] using + htransport + have houter : EntriesValueGraph funRel recSelfRel store Γ + ((arg :: args).reverse ++ suffix) + [.slot current (remaining rest.length) mode true] + [source] [⟨worldOfUses mode, arg⟩] := by + apply EntriesValueGraph.held + · simp [Γ] + · simp [Γ, VEnv.rel, List.reverse_cons, htail] + · exact hworlds ⟨worldOfUses mode, arg⟩ (by simp) + · exact hvalue + · exact EntriesValueGraph.nil + simpa [Γ, List.reverse_cons] using hinner.append houter) + base modes + +/-- At a public function entry, pointwise-related source/runtime arguments +form the complete semantic graph for the canonical parameter environment. +Ownership may include an arbitrary caller frame; only the parameter-prefix +world facts are used here. -/ +theorem VEnvValueGraph.parameterEntries + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} {store : Store} + (modes : List Uses) (remaining : Nat → Nat) + {sourceArgs : List IxIR0.Value} {args : List RVal} + {rest : List Root} + (hlength : args.length = modes.length) + (hgraphs : Sim.ValuesGraph funRel store sourceArgs args) + (hown : RootOwnership store + (rootsForWorlds (modes.map worldOfUses) args ++ rest)) : + VEnvValueGraph funRel recSelfRel store + ⟨parameterEntries 0 modes remaining, modes.length⟩ + sourceArgs.reverse args.reverse + (rootsForWorlds (modes.map worldOfUses) args).reverse := by + constructor + · simpa using hlength + · simpa using parameterEntries_entriesValueGraph + (funRel := funRel) (recSelfRel := recSelfRel) (store := store) + remaining 0 modes (sourceArgs := sourceArgs) (args := args) + (suffix := []) hlength rfl hgraphs (by + intro root hroot + exact hown.roots_world root (List.mem_append_left _ hroot)) + +/-- Every canonical direct-function parameter layout realizes the public +source-order argument telescope. -/ +theorem FnEntryRealizes.parameterEntries (modes : List Uses) + (remaining : Nat → Nat) : + FnEntryRealizes + ⟨parameterEntries 0 modes remaining, modes.length⟩ + (modes.map worldOfUses) := by + intro args hlength + have hmodes : args.length = modes.length := by simpa using hlength + refine ⟨(rootsForWorlds (modes.map worldOfUses) args).reverse, ?_, + List.reverse_perm _⟩ + constructor + · simpa using hmodes + · simpa using parameterEntries_entriesRealize remaining 0 modes + (args := args) (suffix := []) hmodes rfl + +/-- A bounded closed-body emitter yields ownership preservation at the exact +evaluator index forming its bound. This is the declaration-level step used by +the mutual source-context contract induction. -/ +theorem LowerResultSoundBelow.fnOwnershipPreservesAt + {ctx : Ctx} {d : FnDef} {limit : Nat} + {input output : VEnv} {argWorlds : List Owned} + {emit : Emit} {av : AVal} + (hsound : LowerResultSoundBelow ctx d limit input output d.result emit av) + (hentry : FnEntryRealizes input argWorlds) + (harity : argWorlds.length = d.arity) + (hreleased : EntriesReleased output.entries) + (hbody : d.body = emit (.ret (av.toAtom output))) : + FnOwnershipPreservesAt ctx d argWorlds limit := by + intro store store' args value rest hlength hown hrun + obtain ⟨roots, hinput, hperm⟩ := hentry hlength + have hcode : CodeOwnsBelow ctx d limit (OwnsVEnv input rest) + (fun finalStore finalValue => + RootOwnership finalStore (⟨d.result, finalValue⟩ :: rest)) + (emit (.ret (av.toAtom output))) := + hsound.close hreleased rest + rw [hbody] at hrun + apply hcode (Nat.le_refl limit) + · refine ⟨roots, hinput, ?_⟩ + exact hown.perm (hperm.symm.append_right rest) + · exact hrun + +/-- Body-level ownership invariant used to construct a callable function +contract. It separates the mechanical entry-layout proof from the compiler +induction that proves the emitted body code. -/ +structure FnBodySound (ctx : Ctx) (d : FnDef) (input : VEnv) + (argWorlds : List Owned) : Prop where + arity_eq : argWorlds.length = d.arity + entry_realizes : FnEntryRealizes input argWorlds + body_owns : ∀ rest, + CodeOwns ctx d (OwnsVEnv input rest) + (fun store value => + RootOwnership store (⟨d.result, value⟩ :: rest)) + d.body + +/-- A body proof whose entry slots realize the source argument telescope is +exactly the externally callable `FnOwnershipContract`. -/ +theorem FnBodySound.contract {ctx : Ctx} {d : FnDef} {input : VEnv} + {argWorlds : List Owned} + (h : FnBodySound ctx d input argWorlds) : + FnOwnershipContract ctx d argWorlds := by + refine ⟨h.arity_eq, ?_⟩ + intro fuel store store' args value rest hlength hown hrun + obtain ⟨roots, hinput, hperm⟩ := h.entry_realizes hlength + apply h.body_owns rest + · refine ⟨roots, hinput, ?_⟩ + exact hown.perm (hperm.symm.append_right rest) + · exact hrun + +/-- Package a closed expression-lowering derivation as a body invariant for +the actual emitted `FnDef`. This is the reusable bridge from the compiler +induction to declaration contracts. -/ +theorem LowerResultSound.fnBodySound {ctx : Ctx} {d : FnDef} + {input output : VEnv} {argWorlds : List Owned} + {emit : Emit} {av : AVal} + (hsound : LowerResultSound ctx d input output d.result emit av) + (hentry : FnEntryRealizes input argWorlds) + (harity : argWorlds.length = d.arity) + (hreleased : EntriesReleased output.entries) + (hbody : d.body = emit (.ret (av.toAtom output))) : + FnBodySound ctx d input argWorlds := by + refine ⟨harity, hentry, ?_⟩ + intro rest + rw [hbody] + exact hsound.close hreleased rest + +/-- Direct constructor for the contract of a successfully lowered and +closed function body. -/ +theorem LowerResultSound.fnOwnershipContract {ctx : Ctx} {d : FnDef} + {input output : VEnv} {argWorlds : List Owned} + {emit : Emit} {av : AVal} + (hsound : LowerResultSound ctx d input output d.result emit av) + (hentry : FnEntryRealizes input argWorlds) + (harity : argWorlds.length = d.arity) + (hreleased : EntriesReleased output.entries) + (hbody : d.body = emit (.ret (av.toAtom output))) : + FnOwnershipContract ctx d argWorlds := + (hsound.fnBodySound hentry harity hreleased hbody).contract + +/-- Verified `.defn` declaration rule. The mutual compiler induction supplies +the concrete release plan and recursive body proof; this theorem runs the +actual `lowerDecl` branch and packages its emitted function as a callable +ownership contract. -/ +theorem lowerDecl_defn_verified {ctx : Ctx} + (src : IxIR0.Env) (fuel : Nat) (address : Ixon.Address) + (result : Owned) (body : IxIR0.Expr) + (middle output : VEnv) (releaseEmit emit : Emit) (av : AVal) + (state finalState : LowSt) (d : FnDef) + (hplan : ReleasePlan + ⟨parameterEntries 0 (lamUses body) + (fun i => countUses i (stripLams body)), lamArity body⟩ + (parameterDrops 0 (lamUses body) + (fun i => countUses i (stripLams body))) + middle releaseEmit) + (hbodyRun : (lowerE src fuel middle result (stripLams body)).run state = + .ok (output, emit, av) finalState) + (hd : d = + ⟨lamArity body, result, result == .shared && papSafe body, + (releaseEmit ∘ emit) (.ret (av.toAtom output))⟩) + (hbody : LowerResultSound ctx d middle output result emit av) + (hreleased : EntriesReleased output.entries) : + (lowerDecl src (Nat.succ fuel) (address, .defn result body)).run state = + .ok (some (address, .fn d)) finalState ∧ + FnOwnershipContract ctx d ((lamUses body).map worldOfUses) := by + subst d + let remaining : Nat → Nat := fun i => countUses i (stripLams body) + let input : VEnv := + ⟨parameterEntries 0 (lamUses body) remaining, lamArity body⟩ + let drops := parameterDrops 0 (lamUses body) remaining + have hfn := lowerFnBody_verified (ctx := ctx) + (cur := ⟨lamArity body, result, result == .shared && papSafe body, + (releaseEmit ∘ emit) (.ret (av.toAtom output))⟩) + src fuel input middle output drops result (stripLams body) + releaseEmit emit av state finalState (by simpa [input, drops, remaining] + using hplan) hbodyRun hbody + constructor + · simp only [lowerDecl] + rw [estateBindRun] + have hrun := hfn.1 + simp only [input, drops, remaining] at hrun + rw [hrun] + rfl + · have hentry : FnEntryRealizes input + ((lamUses body).map worldOfUses) := by + have hinput : input = + ⟨parameterEntries 0 (lamUses body) remaining, + (lamUses body).length⟩ := by + simp [input] + rw [hinput] + intro args hlength + exact (FnEntryRealizes.parameterEntries (lamUses body) remaining) + hlength + apply hfn.2.fnOwnershipContract hentry + · simp + · exact hreleased + · rfl + +/-- Definition-level rule with compiler-generated parameter releases. The +caller proves only the mode admissibility condition and continues from the +actual successful `releaseSlots` result; the indexed `ReleasePlan` is +constructed internally. This is the interface expected by the eventual +mutual lowering proof. -/ +theorem lowerDecl_defn_generated_verified {ctx : Ctx} + (src : IxIR0.Env) (fuel : Nat) (address : Ixon.Address) + (result : Owned) (body : IxIR0.Expr) (state : LowSt) + (hadmissible : ParameterDropsAdmissible (lamUses body) + (fun i => countUses i (stripLams body))) + (hbody : ∀ middle releaseEmit, + (releaseSlots + ⟨parameterEntries 0 (lamUses body) + (fun i => countUses i (stripLams body)), lamArity body⟩ + (parameterDrops 0 (lamUses body) + (fun i => countUses i (stripLams body)))).run state = + .ok (middle, releaseEmit) state → + ∃ output emit av finalState, + (lowerE src fuel middle result (stripLams body)).run state = + .ok (output, emit, av) finalState ∧ + LowerResultSound ctx + ⟨lamArity body, result, result == .shared && papSafe body, + (releaseEmit ∘ emit) (.ret (av.toAtom output))⟩ + middle output result emit av ∧ + EntriesReleased output.entries) : + ∃ finalState d, + (lowerDecl src (Nat.succ fuel) (address, .defn result body)).run state = + .ok (some (address, .fn d)) finalState ∧ + FnOwnershipContract ctx d ((lamUses body).map worldOfUses) := by + let remaining : Nat → Nat := fun i => countUses i (stripLams body) + let input : VEnv := + ⟨parameterEntries 0 (lamUses body) remaining, lamArity body⟩ + let drops := parameterDrops 0 (lamUses body) remaining + obtain ⟨middle, releaseEmit, rawPlan⟩ := + parameterDrops_releasePlan 0 (lamUses body) remaining + (by simpa [remaining] using hadmissible) + have hplan : ReleasePlan input drops middle releaseEmit := by + simpa [input, drops, remaining] using rawPlan + obtain ⟨output, emit, av, finalState, hbodyRun, hsound, hreleased⟩ := + hbody middle releaseEmit + (by simpa [input, drops, remaining] using hplan.run state) + let d : FnDef := + ⟨lamArity body, result, result == .shared && papSafe body, + (releaseEmit ∘ emit) (.ret (av.toAtom output))⟩ + refine ⟨finalState, d, ?_⟩ + have hdecl := lowerDecl_defn_verified (ctx := ctx) + src fuel address result body middle output releaseEmit emit av + state finalState d hplan hbodyRun rfl hsound hreleased + simpa [d] using hdecl + +/-! ## Case-alternative contracts -/ + +/-- Runtime shape of a recursor alternative before the dispatcher pushes its +constructor fields. `pre` is in source argument order; the function runtime +environment is reversed and headed by the major premise. -/ +def RecursorEntryValid (numArgs : Nat) + (env : List RVal) (_fields : Array RVal) : Prop := + ∃ (pre : List RVal) (major : RVal), + pre.length = numArgs ∧ env = major :: pre.reverse + +/-- Public function-argument roots consumed by a recursor alternative. The +runtime environment is reversed, so reversing it recovers source order. -/ +def recursorEntryRoots + (env : List RVal) (_fields : Array RVal) : List Root := + rootsFor .shared env.reverse + +/-- Canonical logical entry layout at the start of a recursor alternative: +released field placeholders, all-shared pre-major parameters, and synthetic +recursive self. -/ +def recursorInitialVEnv (numArgs nf : Nat) (rhs : IxIR0.Expr) : VEnv := + let dead : VEntry := .slot 0 0 .many false + ⟨List.replicate nf dead ++ + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (nf + i) rhs) ++ + [.recSelf (numArgs + 1)], + (numArgs + 1) + nf⟩ + +/-- Protected major and constructor-field positions at alternative entry. +The major lies immediately above the `numArgs` older parameters; fields +then occupy consecutive absolute positions in constructor order. -/ +def recursorEntrySlots (numArgs : Nat) (major : RVal) + (fields : Array RVal) : List (Nat × RVal) := + recursorFieldSlots numArgs (major :: fields.toList) + +/-- Relate a selected alternative's physical entry environment to the roots +owned by that branch. `entryValid` carries arity/layout side conditions; +borrowed field evidence remains separate because fields are not roots until +the emitted prefix explicitly retains them. -/ +def AltEntryRealizes (input : VEnv) (fieldCount : Nat) + (entryValid : List RVal → Array RVal → Prop) + (entryRoots : List RVal → Array RVal → List Root) : Prop := + ∀ {env : List RVal} {fields : Array RVal}, + fields.size = fieldCount → entryValid env fields → + ∃ roots, + VEnvRealizes input + (fields.foldl (fun branchEnv field => field :: branchEnv) env) + roots ∧ + roots.Perm (entryRoots env fields) + +/-- State at the start of a selected case alternative: its physical field +bindings, exact owned roots, and the non-owning field-world facts exposed by +the dispatcher. -/ +def OwnsAltEntry (fieldWorld : Owned) + (entryRoots : List RVal → Array RVal → List Root) + (env : List RVal) (fields : Array RVal) (rest : List Root) : StatePred := + fun store branchEnv => + branchEnv = + fields.foldl (fun current field => field :: current) env ∧ + RootOwnership store (entryRoots env fields ++ rest) ∧ + ∀ field ∈ fields.toList, HasWorld store fieldWorld field + +/-- Convert the public recursor alternative entry state into the exact +logical split expected by the generated field-retain fold. Pre-major +parameters are owned by the `VEnv`; the major remains the first external +root; fields remain borrowed, with every original absolute slot protected. -/ +theorem recursorAltEntry_borrowed_state + (numArgs nf : Nat) (rhs : IxIR0.Expr) + (pre : List RVal) (major : RVal) (fields : Array RVal) + (hpreLength : pre.length = numArgs) (hfields : fields.size = nf) + (rest : List Root) : + ∀ {store branchEnv}, + OwnsAltEntry .shared recursorEntryRoots + (major :: pre.reverse) fields rest store branchEnv → + OwnsVEnvBorrowed (recursorInitialVEnv numArgs nf rhs) + (⟨.shared, major⟩ :: rest) + (recursorEntrySlots numArgs major fields) fields.toList + store branchEnv := by + intro store branchEnv hentry + obtain ⟨hbranch, hown, hborrowed⟩ := hentry + rw [Array.foldl_cons_eq_reverse_append] at hbranch + subst branchEnv + let modes := List.replicate numArgs Uses.many + let remaining : Nat → Nat := fun i => countUses (nf + i) rhs + have hargs : pre.length = (modes.map worldOfUses).length := by + simp [modes, hpreLength] + obtain ⟨preRoots, hpreRealize, hprePerm⟩ := + (FnEntryRealizes.parameterEntries modes remaining) hargs + have hpushed := hpreRealize.bumpList (major :: fields.toList) + let input := recursorInitialVEnv numArgs nf rhs + have hfieldsLength : fields.toList.length = nf := by + simpa using hfields + have hpushedDepth : + (addVEnvDepth + ⟨parameterEntries 0 modes remaining, modes.length⟩ + (major :: fields.toList).length).depth = input.depth := by + simp [addVEnvDepth, input, recursorInitialVEnv, modes, + hfieldsLength] + omega + have hparams : EntriesRealize input + (fields.toList.reverse ++ major :: pre.reverse) + (parameterEntries 0 modes remaining) preRoots := by + have htransport := hpushed.entries.of_depth_eq hpushedDepth + simpa [addVEnvDepth, List.reverse_cons, List.append_assoc] + using htransport + let dead : VEntry := .slot 0 0 .many false + have hdead : EntriesRealize input + (fields.toList.reverse ++ major :: pre.reverse) + (List.replicate nf dead) [] := by + apply EntriesRealize.replicateReleased + simp [input, recursorInitialVEnv] + omega + have hentries : EntriesRealize input + (fields.toList.reverse ++ major :: pre.reverse) + input.entries preRoots := by + have hself : EntriesRealize input + (fields.toList.reverse ++ major :: pre.reverse) + [.recSelf (numArgs + 1)] [] := + EntriesRealize.recSelf EntriesRealize.nil + have hall := hdead.append (hparams.append hself) + simpa [input, recursorInitialVEnv, modes, remaining, dead, + List.append_assoc] using hall + have hdepth : + (fields.toList.reverse ++ major :: pre.reverse).length = + input.depth := by + simp [input, recursorInitialVEnv, hfieldsLength, hpreLength] + omega + have hslotDepth : + (⟨[], pre.reverse.length + (major :: fields.toList).length⟩ : + VEnv).depth = input.depth := by + simp [input, recursorInitialVEnv, hfieldsLength, hpreLength] + omega + have hslots : SlotsRealize input + (fields.toList.reverse ++ major :: pre.reverse) + (recursorEntrySlots numArgs major fields) := by + have hraw := recursorFieldSlots_realize_list + pre.reverse (major :: fields.toList) + have htransport := hraw.of_depth_eq hslotDepth + simpa [recursorEntrySlots, hpreLength, List.reverse_cons, + List.append_assoc] using htransport + have hworlds : + rootsForWorlds (modes.map worldOfUses) pre = + rootsFor .shared pre := by + have hrep : modes.map worldOfUses = + List.replicate numArgs Owned.shared := by + simp [modes, worldOfUses] + rw [hrep] + exact rootsForWorlds_replicate_eq_rootsFor .shared hpreLength + rw [hworlds] at hprePerm + have howned : RootOwnership store + (preRoots ++ ⟨.shared, major⟩ :: rest) := by + apply hown.perm + simpa [recursorEntryRoots, rootsFor, List.reverse_cons, + List.append_assoc] using + hprePerm.symm.append_right (⟨.shared, major⟩ :: rest) + exact ⟨⟨⟨preRoots, ⟨hdepth, hentries⟩, howned⟩, hslots⟩, + hborrowed⟩ + +/-- Semantic branch-entry conversion for a selected recursor rule. It +reconstructs the exact rule evaluator environment—reversed fields, reversed +pre-major arguments, then synthetic recursive self—while keeping the major +as the one external root consumed by the generated prefix. -/ +theorem recursorAltEntry_value_state + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} {store : Store} + (numArgs nf : Nat) (rhs : IxIR0.Expr) + {sourcePre : List IxIR0.Value} {pre : List RVal} + {sourceFields : List IxIR0.Value} {fields : List RVal} + {sourceSelf : IxIR0.Value} {major : RVal} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hpreLength : pre.length = numArgs) + (hfieldsLength : fields.length = nf) + (hpreGraphs : Sim.ValuesGraph funRel store sourcePre pre) + (hfieldGraphs : Sim.ValuesGraph funRel store sourceFields fields) + (hself : recSelfRel sourceSelf (numArgs + 1)) + (hrestGraph : Sim.RootsGraph funRel store sourceRest rest) + (hown : RootOwnership store + (rootsFor .shared (pre ++ [major]) ++ rest)) + (hfieldWorld : ∀ field ∈ fields, HasWorld store .shared field) : + GraphOwnsVEnvRetains funRel recSelfRel + (recursorInitialVEnv numArgs nf rhs) + (sourceFields.reverse ++ sourcePre.reverse ++ [sourceSelf]) + sourceRest rest [⟨.shared, major⟩] + (recursorFieldSlots numArgs (major :: fields)) fields + (recursorFieldRetains (numArgs + 1) rhs nf) + store (fields.reverse ++ major :: pre.reverse) := by + let modes := List.replicate numArgs Uses.many + let remaining : Nat → Nat := fun i => countUses (nf + i) rhs + have hmodes : pre.length = modes.length := by + simp [modes, hpreLength] + have hworldLayout : modes.map worldOfUses = + List.replicate numArgs Owned.shared := by + simp [modes, worldOfUses] + have hparameterOwn : RootOwnership store + (rootsForWorlds (modes.map worldOfUses) pre ++ + (⟨.shared, major⟩ :: rest)) := by + rw [hworldLayout] + rw [rootsForWorlds_replicate_eq_rootsFor .shared hpreLength] + simpa [rootsFor, List.append_assoc] using hown + have hparameters₀ := VEnvValueGraph.parameterEntries + (funRel := funRel) (recSelfRel := recSelfRel) + modes remaining hmodes hpreGraphs hparameterOwn + have hpushed := hparameters₀.bumpList (major :: fields) + let input := recursorInitialVEnv numArgs nf rhs + have hpushedDepth : + (addVEnvDepth + ⟨parameterEntries 0 modes remaining, modes.length⟩ + (major :: fields).length).depth = input.depth := by + simp [addVEnvDepth, input, recursorInitialVEnv, modes, + hfieldsLength] + omega + let preRoots := + (rootsForWorlds (modes.map worldOfUses) pre).reverse + have hparameters : EntriesValueGraph funRel recSelfRel store input + (fields.reverse ++ major :: pre.reverse) + (parameterEntries 0 modes remaining) sourcePre.reverse preRoots := by + have htransport := hpushed.entries.of_depth_eq hpushedDepth + simpa [addVEnvDepth, List.reverse_cons, List.append_assoc, preRoots] + using htransport + let dead : VEntry := .slot 0 0 .many false + have hsourceFieldsLength : sourceFields.reverse.length = nf := by + simpa [hfieldsLength] using hfieldGraphs.length + have hdead : EntriesValueGraph funRel recSelfRel store input + (fields.reverse ++ major :: pre.reverse) + (List.replicate nf dead) sourceFields.reverse [] := by + apply EntriesValueGraph.replicateReleased + · exact hsourceFieldsLength + · simp [input, recursorInitialVEnv] + omega + have hselfEntry : EntriesValueGraph funRel recSelfRel store input + (fields.reverse ++ major :: pre.reverse) + [.recSelf (numArgs + 1)] [sourceSelf] [] := + EntriesValueGraph.recSelf hself EntriesValueGraph.nil + have hentries : EntriesValueGraph funRel recSelfRel store input + (fields.reverse ++ major :: pre.reverse) input.entries + (sourceFields.reverse ++ sourcePre.reverse ++ [sourceSelf]) + preRoots := by + have hall := hdead.append (hparameters.append hselfEntry) + simpa [input, recursorInitialVEnv, modes, remaining, dead, + List.append_assoc] using hall + have hdepth : + (fields.reverse ++ major :: pre.reverse).length = input.depth := by + simp [input, recursorInitialVEnv, hfieldsLength, hpreLength] + omega + have hslotDepth : + (⟨[], pre.reverse.length + (major :: fields).length⟩ : VEnv).depth = + input.depth := by + simp [input, recursorInitialVEnv, hfieldsLength, hpreLength] + omega + have hslots : SlotsRealize input + (fields.reverse ++ major :: pre.reverse) + (recursorFieldSlots numArgs (major :: fields)) := by + have hraw := recursorFieldSlots_realize_list pre.reverse + (major :: fields) + have htransport := hraw.of_depth_eq hslotDepth + simpa [hpreLength, List.reverse_cons, List.append_assoc] + using htransport + have howned : RootOwnership store + (preRoots ++ ⟨.shared, major⟩ :: rest) := by + have hnormal : RootOwnership store + (rootsFor .shared pre ++ ⟨.shared, major⟩ :: rest) := by + simpa [rootsFor, List.append_assoc] using hown + have hreverse : + (rootsForWorlds (modes.map worldOfUses) pre).reverse.Perm + (rootsFor .shared pre) := by + rw [hworldLayout] + rw [rootsForWorlds_replicate_eq_rootsFor .shared hpreLength] + exact List.reverse_perm _ + exact hnormal.perm (hreverse.symm.append_right + (⟨.shared, major⟩ :: rest)) + have hretainBase := recursorFieldRetains_valueGraphs + (funRel := funRel) (store := store) (numArgs + 1) nf rhs + (sourceValues := sourceFields) (values := fields) + (sourcePre.reverse ++ [sourceSelf]) hfieldGraphs hfieldsLength + have hretains : RetainsValueGraphs funRel store + (sourceFields.reverse ++ sourcePre.reverse ++ [sourceSelf]) + (recursorFieldSlots numArgs (major :: fields)) fields + (recursorFieldRetains (numArgs + 1) rhs nf) := by + intro retain hmember + obtain ⟨source, value, hsource, hslot, hborrowed, hvalue⟩ := + hretainBase retain hmember + exact ⟨source, value, + by simpa [List.append_assoc] using hsource, + by simp [recursorFieldSlots, hslot], hborrowed, hvalue⟩ + exact ⟨preRoots, ⟨hdepth, hentries⟩, hrestGraph, + by simpa [List.append_assoc] using howned, hslots, + hfieldWorld, hretains⟩ + +/-- Identity-emitter wrapper for the recursor entry-state conversion. -/ +theorem recursorAltEntry_borrowed {ctx : Ctx} {cur : FnDef} + (numArgs nf : Nat) (rhs : IxIR0.Expr) + (pre : List RVal) (major : RVal) (fields : Array RVal) + (hpreLength : pre.length = numArgs) (hfields : fields.size = nf) + (rest : List Root) : + EmitSound ctx cur (_root_.id : Emit) + (OwnsAltEntry .shared recursorEntryRoots + (major :: pre.reverse) fields rest) + (OwnsVEnvBorrowed (recursorInitialVEnv numArgs nf rhs) + (⟨.shared, major⟩ :: rest) + (recursorEntrySlots numArgs major fields) fields.toList) := by + apply EmitSound.strengthen + exact recursorAltEntry_borrowed_state numArgs nf rhs pre major fields + hpreLength hfields rest + +/-- Fuel-bounded identity-emitter wrapper for recursor entry conversion. -/ +theorem recursorAltEntry_borrowed_below {ctx : Ctx} {cur : FnDef} + {limit : Nat} (numArgs nf : Nat) (rhs : IxIR0.Expr) + (pre : List RVal) (major : RVal) (fields : Array RVal) + (hpreLength : pre.length = numArgs) (hfields : fields.size = nf) + (rest : List Root) : + EmitSoundBelow ctx cur limit (_root_.id : Emit) + (OwnsAltEntry .shared recursorEntryRoots + (major :: pre.reverse) fields rest) + (OwnsVEnvBorrowed (recursorInitialVEnv numArgs nf rhs) + (⟨.shared, major⟩ :: rest) + (recursorEntrySlots numArgs major fields) fields.toList) := by + apply EmitSoundBelow.strengthen + exact recursorAltEntry_borrowed_state numArgs nf rhs pre major fields + hpreLength hfields rest + +/-- One uniformly bounded composition proof for the generated recursor +prefix. Operational plan witnesses are limit-independent; only the final +ownership judgment is indexed, so exact and bounded public certificates can +share this body. -/ +private theorem recursorPrefix_generated_verified_core + {ctx : Ctx} {cur : FnDef} (numArgs nf : Nat) + (rhs : IxIR0.Expr) (state : LowSt) : + let dead : VEntry := .slot 0 0 .many false + let fieldInput : VEnv := + ⟨List.replicate nf dead, (numArgs + 1) + nf⟩ + let retains := recursorFieldRetains (numArgs + 1) rhs nf + let frame := + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (nf + i) rhs) ++ + [.recSelf (numArgs + 1)] + let drops := + (parameterDrops 0 (List.replicate numArgs .many) + (fun i => countUses (nf + i) rhs)).map + (SlotDrop.offsetEntry nf) + ∃ fieldOutput fieldEmit rhsInput parameterEmit, + applyRecursorFieldRetains fieldInput retains = + (fieldOutput, fieldEmit) ∧ + (releaseSlots + ⟨fieldOutput.entries ++ frame, fieldOutput.depth + 1⟩ + drops).run state = .ok (rhsInput, parameterEmit) state ∧ + ∀ limit {pre : List RVal} {major : RVal} {fields : Array RVal} + {rest : List Root}, + pre.length = numArgs → fields.size = nf → + EmitSoundBelow ctx cur limit + (fieldEmit ∘ + emitOp (.drop (.var (fieldOutput.rel numArgs))) ∘ + parameterEmit) + (OwnsAltEntry .shared recursorEntryRoots + (major :: pre.reverse) fields rest) + (OwnsVEnv rhsInput rest) := by + dsimp only + let dead : VEntry := .slot 0 0 .many false + let fieldInput : VEnv := + ⟨List.replicate nf dead, (numArgs + 1) + nf⟩ + let retains := recursorFieldRetains (numArgs + 1) rhs nf + let frame := + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (nf + i) rhs) ++ + [.recSelf (numArgs + 1)] + let drops := + (parameterDrops 0 (List.replicate numArgs .many) + (fun i => countUses (nf + i) rhs)).map + (SlotDrop.offsetEntry nf) + obtain ⟨fieldOutput, fieldEmit, hfieldPlan⟩ := + recursorFieldRetains_plan (numArgs + 1) ((numArgs + 1) + nf) nf rhs + have hfieldEntriesLength : fieldOutput.entries.length = nf := by + calc + fieldOutput.entries.length = + (⟨List.replicate nf dead, + (numArgs + 1) + nf⟩ : VEnv).entries.length := + hfieldPlan.entries_length + _ = nf := by simp + obtain ⟨rhsInput, parameterEmit, hparameterPlan⟩ := + recursorParameterDrops_releasePlan numArgs nf + (fieldOutput.depth + 1) rhs fieldOutput.entries + hfieldEntriesLength + refine ⟨fieldOutput, fieldEmit, rhsInput, parameterEmit, + ?_, ?_, ?_⟩ + · simpa [fieldInput, retains, dead] using hfieldPlan.run + · simpa [frame, drops, List.append_assoc] using + hparameterPlan.run state + · intro limit pre major fields rest hpreLength hfields + have hfieldsLength : fields.toList.length = nf := by + simpa using hfields + have hcoveredBase := recursorFieldRetains_covered + (numArgs + 1) nf rhs fields.toList hfieldsLength + have hcovered : FieldRetainsCovered + (recursorFieldRetains (numArgs + 1) rhs nf) + (recursorEntrySlots numArgs major fields) fields.toList := by + intro retain hmem + obtain ⟨value, hslot, hborrowed⟩ := + hcoveredBase retain hmem + exact ⟨value, by + simp [recursorEntrySlots, recursorFieldSlots, hslot], hborrowed⟩ + have hentry := recursorAltEntry_borrowed_below + (ctx := ctx) (cur := cur) (limit := limit) + numArgs nf rhs pre major fields hpreLength hfields rest + have hfieldFramed := hfieldPlan.frameEntries frame + have hfield : EmitSoundBelow ctx cur limit fieldEmit + (OwnsVEnvBorrowed (recursorInitialVEnv numArgs nf rhs) + (⟨.shared, major⟩ :: rest) + (recursorEntrySlots numArgs major fields) fields.toList) + (OwnsVEnvBorrowed (frameVEnvEntries fieldOutput frame) + (⟨.shared, major⟩ :: rest) + (recursorEntrySlots numArgs major fields) fields.toList) := by + have hsound := hfieldFramed.soundBelow + (ctx := ctx) (cur := cur) (limit := limit) + (recursorEntrySlots numArgs major fields) fields.toList + hcovered (⟨.shared, major⟩ :: rest) + simpa [fieldInput, retains, frame, dead, recursorInitialVEnv, + frameVEnvEntries, List.append_assoc] using hsound + have hmajor : EmitSoundBelow ctx cur limit + (emitOp (.drop (.var + ((frameVEnvEntries fieldOutput frame).rel numArgs)))) + (OwnsVEnvBorrowed (frameVEnvEntries fieldOutput frame) + (⟨.shared, major⟩ :: rest) + (recursorEntrySlots numArgs major fields) fields.toList) + (OwnsVEnvProtected (frameVEnvEntries fieldOutput frame).bump + rest (recursorEntrySlots numArgs major fields)) := + drop_major_owned_below (limit := limit) (by + simp [recursorEntrySlots, recursorFieldSlots]) + have hparameters : EmitSoundBelow ctx cur limit parameterEmit + (OwnsVEnvProtected (frameVEnvEntries fieldOutput frame).bump + rest (recursorEntrySlots numArgs major fields)) + (OwnsVEnvProtected rhsInput rest + (recursorEntrySlots numArgs major fields)) := by + have hsound := hparameterPlan.soundBelow + (ctx := ctx) (cur := cur) (limit := limit) rest + (recursorEntrySlots numArgs major fields) + simpa [frameVEnvEntries, VEnv.bump, frame, List.append_assoc] + using hsound + have hforget : EmitSoundBelow ctx cur limit (_root_.id : Emit) + (OwnsVEnvProtected rhsInput rest + (recursorEntrySlots numArgs major fields)) + (OwnsVEnv rhsInput rest) := + EmitSoundBelow.strengthen (fun h => h.1) + have hcomposed := EmitSoundBelow.comp hentry + (EmitSoundBelow.comp hfield + (EmitSoundBelow.comp hmajor + (EmitSoundBelow.comp hparameters hforget))) + simpa [frameVEnvEntries, VEnv.rel, Function.comp_def] using hcomposed + + +/-- End-to-end certificate for the complete generated recursor prefix at an +arbitrary branch width: retain every used borrowed field, release the major, +then execute the canonical dead-parameter release plan. The returned +`VEnv` is exactly the input expected by lowering the rule RHS. -/ +theorem recursorPrefix_generated_verified {ctx : Ctx} {cur : FnDef} + (numArgs nf : Nat) (rhs : IxIR0.Expr) (state : LowSt) : + let dead : VEntry := .slot 0 0 .many false + let fieldInput : VEnv := + ⟨List.replicate nf dead, (numArgs + 1) + nf⟩ + let retains := recursorFieldRetains (numArgs + 1) rhs nf + let frame := + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (nf + i) rhs) ++ + [.recSelf (numArgs + 1)] + let drops := + (parameterDrops 0 (List.replicate numArgs .many) + (fun i => countUses (nf + i) rhs)).map + (SlotDrop.offsetEntry nf) + ∃ fieldOutput fieldEmit rhsInput parameterEmit, + applyRecursorFieldRetains fieldInput retains = + (fieldOutput, fieldEmit) ∧ + (releaseSlots + ⟨fieldOutput.entries ++ frame, fieldOutput.depth + 1⟩ + drops).run state = .ok (rhsInput, parameterEmit) state ∧ + ∀ {pre : List RVal} {major : RVal} {fields : Array RVal} + {rest : List Root}, + pre.length = numArgs → fields.size = nf → + EmitSound ctx cur + (fieldEmit ∘ + emitOp (.drop (.var (fieldOutput.rel numArgs))) ∘ + parameterEmit) + (OwnsAltEntry .shared recursorEntryRoots + (major :: pre.reverse) fields rest) + (OwnsVEnv rhsInput rest) := by + dsimp only + obtain ⟨fieldOutput, fieldEmit, rhsInput, parameterEmit, + hfieldRun, hparameterRun, hsound⟩ := + recursorPrefix_generated_verified_core (ctx := ctx) (cur := cur) + numArgs nf rhs state + refine ⟨fieldOutput, fieldEmit, rhsInput, parameterEmit, + hfieldRun, hparameterRun, ?_⟩ + intro pre major fields rest hpreLength hfields + exact EmitSound.of_below fun limit => + hsound limit hpreLength hfields + +/-- Fuel-bounded end-to-end certificate for the generated recursor prefix. +All prefix operations are call-free; the hereditary bound is carried solely +to compose with the recursively proved rule body. -/ +theorem recursorPrefix_generated_verified_below + {ctx : Ctx} {cur : FnDef} (limit numArgs nf : Nat) + (rhs : IxIR0.Expr) (state : LowSt) : + let dead : VEntry := .slot 0 0 .many false + let fieldInput : VEnv := + ⟨List.replicate nf dead, (numArgs + 1) + nf⟩ + let retains := recursorFieldRetains (numArgs + 1) rhs nf + let frame := + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (nf + i) rhs) ++ + [.recSelf (numArgs + 1)] + let drops := + (parameterDrops 0 (List.replicate numArgs .many) + (fun i => countUses (nf + i) rhs)).map + (SlotDrop.offsetEntry nf) + ∃ fieldOutput fieldEmit rhsInput parameterEmit, + applyRecursorFieldRetains fieldInput retains = + (fieldOutput, fieldEmit) ∧ + (releaseSlots + ⟨fieldOutput.entries ++ frame, fieldOutput.depth + 1⟩ + drops).run state = .ok (rhsInput, parameterEmit) state ∧ + ∀ {pre : List RVal} {major : RVal} {fields : Array RVal} + {rest : List Root}, + pre.length = numArgs → fields.size = nf → + EmitSoundBelow ctx cur limit + (fieldEmit ∘ + emitOp (.drop (.var (fieldOutput.rel numArgs))) ∘ + parameterEmit) + (OwnsAltEntry .shared recursorEntryRoots + (major :: pre.reverse) fields rest) + (OwnsVEnv rhsInput rest) := by + dsimp only + obtain ⟨fieldOutput, fieldEmit, rhsInput, parameterEmit, + hfieldRun, hparameterRun, hsound⟩ := + recursorPrefix_generated_verified_core (ctx := ctx) (cur := cur) + numArgs nf rhs state + refine ⟨fieldOutput, fieldEmit, rhsInput, parameterEmit, + hfieldRun, hparameterRun, ?_⟩ + intro pre major fields rest hpreLength hfields + exact hsound limit hpreLength hfields +/-- Semantic composition rule for the three proof-relevant plans making up +a generated recursor prefix. Retaining fields enriches released logical +entries, dropping the major removes the sole external branch root, and the +parameter-release plan then preserves the resulting source environment all +the way to the rule RHS input. -/ +theorem recursorPrefixPlans_valueSoundBelow + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + (numArgs nf : Nat) (rhs : IxIR0.Expr) + {fieldOutput rhsInput : VEnv} {fieldEmit parameterEmit : Emit} + (hfieldPlan : FieldRetainPlan + ⟨List.replicate nf (.slot 0 0 .many false), + (numArgs + 1) + nf⟩ + (recursorFieldRetains (numArgs + 1) rhs nf) + fieldOutput fieldEmit) + (hparameterPlan : ReleasePlan + ⟨fieldOutput.entries ++ + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (nf + i) rhs) ++ + [.recSelf (numArgs + 1)], + fieldOutput.depth + 1⟩ + ((parameterDrops 0 (List.replicate numArgs .many) + (fun i => countUses (nf + i) rhs)).map + (SlotDrop.offsetEntry nf)) + rhsInput parameterEmit) : + ∀ sourceEnv sourceRest rest major fields, + EmitSoundBelow ctx cur limit + (fieldEmit ∘ + emitOp (.drop (.var (fieldOutput.rel numArgs))) ∘ + parameterEmit) + (GraphOwnsVEnvRetains funRel recSelfRel + (recursorInitialVEnv numArgs nf rhs) sourceEnv + sourceRest rest [⟨.shared, major⟩] + (recursorFieldSlots numArgs (major :: fields)) fields + (recursorFieldRetains (numArgs + 1) rhs nf)) + (GraphOwnsVEnv funRel recSelfRel rhsInput sourceEnv + sourceRest rest) := by + intro sourceEnv sourceRest rest major fields + let frame := + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (nf + i) rhs) ++ + [.recSelf (numArgs + 1)] + have hfieldFramed := hfieldPlan.frameEntries frame + have hfield : EmitSoundBelow ctx cur limit fieldEmit + (GraphOwnsVEnvRetains funRel recSelfRel + (recursorInitialVEnv numArgs nf rhs) sourceEnv + sourceRest rest [⟨.shared, major⟩] + (recursorFieldSlots numArgs (major :: fields)) fields + (recursorFieldRetains (numArgs + 1) rhs nf)) + (GraphOwnsVEnvRetains funRel recSelfRel + (frameVEnvEntries fieldOutput frame) sourceEnv + sourceRest rest [⟨.shared, major⟩] + (recursorFieldSlots numArgs (major :: fields)) fields []) := by + have hsound := hfieldFramed.valueSoundBelow + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) + sourceEnv sourceRest rest [⟨.shared, major⟩] + (recursorFieldSlots numArgs (major :: fields)) fields + simpa [frame, recursorInitialVEnv, frameVEnvEntries, + List.append_assoc] using hsound + have hmajor : EmitSoundBelow ctx cur limit + (emitOp (.drop (.var + ((frameVEnvEntries fieldOutput frame).rel numArgs)))) + (GraphOwnsVEnvRetains funRel recSelfRel + (frameVEnvEntries fieldOutput frame) sourceEnv + sourceRest rest [⟨.shared, major⟩] + (recursorFieldSlots numArgs (major :: fields)) fields []) + (GraphOwnsVEnvProtected funRel recSelfRel + (frameVEnvEntries fieldOutput frame).bump sourceEnv + sourceRest rest + (recursorFieldSlots numArgs (major :: fields))) := + drop_major_value_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) + (by simp [recursorFieldSlots]) + have hparameters : EmitSoundBelow ctx cur limit parameterEmit + (GraphOwnsVEnvProtected funRel recSelfRel + (frameVEnvEntries fieldOutput frame).bump sourceEnv + sourceRest rest + (recursorFieldSlots numArgs (major :: fields))) + (GraphOwnsVEnvProtected funRel recSelfRel rhsInput sourceEnv + sourceRest rest + (recursorFieldSlots numArgs (major :: fields))) := by + have hsound := (hparameterPlan.valueSoundBelow + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) sourceEnv).graphEmits + sourceRest rest (recursorFieldSlots numArgs (major :: fields)) + simpa [frameVEnvEntries, VEnv.bump, frame, List.append_assoc] + using hsound + have hforget : EmitSoundBelow ctx cur limit (_root_.id : Emit) + (GraphOwnsVEnvProtected funRel recSelfRel rhsInput sourceEnv + sourceRest rest + (recursorFieldSlots numArgs (major :: fields))) + (GraphOwnsVEnv funRel recSelfRel rhsInput sourceEnv + sourceRest rest) := + EmitSoundBelow.strengthen (fun h => h.1) + have hcomposed := EmitSoundBelow.comp hfield + (EmitSoundBelow.comp hmajor + (EmitSoundBelow.comp hparameters hforget)) + simpa [frameVEnvEntries, VEnv.rel, Function.comp_def] using hcomposed + +/-- When the lowered body starts directly at branch entry, an entry-layout +realization turns the case predicate into the ordinary `OwnsVEnv` predicate +used by expression lowering. -/ +theorem AltEntryRealizes.emitId {ctx : Ctx} {cur : FnDef} + {input : VEnv} {fieldCount : Nat} + {fieldWorld : Owned} + {entryValid : List RVal → Array RVal → Prop} + {entryRoots : List RVal → Array RVal → List Root} + (hentry : AltEntryRealizes input fieldCount entryValid entryRoots) + {env : List RVal} {fields : Array RVal} + (hsize : fields.size = fieldCount) (hvalid : entryValid env fields) + (rest : List Root) : + EmitSound ctx cur (_root_.id : Emit) + (OwnsAltEntry fieldWorld entryRoots env fields rest) + (OwnsVEnv input rest) := by + apply EmitSound.strengthen + intro store branchEnv hpre + obtain ⟨henv, hown, _⟩ := hpre + subst branchEnv + obtain ⟨roots, hrealize, hperm⟩ := hentry hsize hvalid + refine ⟨roots, hrealize, ?_⟩ + exact hown.perm (hperm.symm.append_right rest) + +/-- Fuel-bounded entry-layout adapter. -/ +theorem AltEntryRealizes.emitIdBelow {ctx : Ctx} {cur : FnDef} + {limit : Nat} {input : VEnv} {fieldCount : Nat} + {fieldWorld : Owned} + {entryValid : List RVal → Array RVal → Prop} + {entryRoots : List RVal → Array RVal → List Root} + (hentry : AltEntryRealizes input fieldCount entryValid entryRoots) + {env : List RVal} {fields : Array RVal} + (hsize : fields.size = fieldCount) (hvalid : entryValid env fields) + (rest : List Root) : + EmitSoundBelow ctx cur limit (_root_.id : Emit) + (OwnsAltEntry fieldWorld entryRoots env fields rest) + (OwnsVEnv input rest) := by + apply EmitSoundBelow.strengthen + intro store branchEnv hpre + obtain ⟨henv, hown, _⟩ := hpre + subst branchEnv + obtain ⟨roots, hrealize, hperm⟩ := hentry hsize hvalid + refine ⟨roots, hrealize, ?_⟩ + exact hown.perm (hperm.symm.append_right rest) + +/-- Close a lowered alternative body behind its case-entry prefix. This is +the branch analogue of `LowerResultSound.fnOwnershipContract`: the prefix +may retain borrowed fields and release the scrutinee/dead parameters before +the ordinary expression proof begins. -/ +theorem LowerResultSound.altOwnershipContractWithPrefix + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {fieldWorld : Owned} {entryValid : List RVal → Array RVal → Prop} + {entryRoots : List RVal → Array RVal → List Root} + {entryEmit emit : Emit} {av : AVal} {tag fieldCount : Nat} + (hsound : LowerResultSound ctx cur input output cur.result emit av) + (hprefix : ∀ {env : List RVal} {fields : Array RVal} + {rest : List Root}, + fields.size = fieldCount → entryValid env fields → + EmitSound ctx cur entryEmit + (OwnsAltEntry fieldWorld entryRoots env fields rest) + (OwnsVEnv input rest)) + (hreleased : EntriesReleased output.entries) : + AltOwnershipContract ctx cur + (.mk tag fieldCount (entryEmit (emit (.ret (av.toAtom output))))) + fieldWorld entryValid entryRoots := by + refine ⟨?_⟩ + intro fuel store store' env fields value rest hsize hvalid hown + hborrow hrun + exact (hprefix hsize hvalid _ _ (hsound.close hreleased rest)) + ⟨rfl, hown, hborrow⟩ hrun + +/-- Prefix-free specialization for alternatives whose entry layout already +matches the input `VEnv`. -/ +theorem LowerResultSound.altOwnershipContract + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {fieldWorld : Owned} {entryValid : List RVal → Array RVal → Prop} + {entryRoots : List RVal → Array RVal → List Root} + {emit : Emit} {av : AVal} {tag fieldCount : Nat} + (hsound : LowerResultSound ctx cur input output cur.result emit av) + (hentry : AltEntryRealizes input fieldCount entryValid entryRoots) + (hreleased : EntriesReleased output.entries) : + AltOwnershipContract ctx cur + (.mk tag fieldCount (emit (.ret (av.toAtom output)))) + fieldWorld entryValid entryRoots := by + simpa using hsound.altOwnershipContractWithPrefix + (entryEmit := (_root_.id : Emit)) + (fun hsize hvalid => hentry.emitId hsize hvalid _) hreleased + +/-- Close a bounded lowered alternative behind a bounded generated prefix. -/ +theorem LowerResultSoundBelow.altOwnershipContractWithPrefix + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input output : VEnv} + {fieldWorld : Owned} {entryValid : List RVal → Array RVal → Prop} + {entryRoots : List RVal → Array RVal → List Root} + {entryEmit emit : Emit} {av : AVal} {tag fieldCount : Nat} + (hsound : LowerResultSoundBelow ctx cur limit input output + cur.result emit av) + (hprefix : ∀ {env : List RVal} {fields : Array RVal} + {rest : List Root}, + fields.size = fieldCount → entryValid env fields → + EmitSoundBelow ctx cur limit entryEmit + (OwnsAltEntry fieldWorld entryRoots env fields rest) + (OwnsVEnv input rest)) + (hreleased : EntriesReleased output.entries) : + AltOwnershipContractBelow ctx cur + (.mk tag fieldCount (entryEmit (emit (.ret (av.toAtom output))))) + fieldWorld entryValid entryRoots limit := by + refine ⟨?_⟩ + intro fuel store store' env fields value rest hfuel hsize hvalid hown + hborrow hrun + have hcode : CodeOwnsBelow ctx cur limit + (OwnsAltEntry fieldWorld entryRoots env fields rest) + (fun store value => + RootOwnership store (⟨cur.result, value⟩ :: rest)) + (entryEmit (emit (.ret (av.toAtom output)))) := + hprefix hsize hvalid limit (Nat.le_refl _) _ _ + (hsound.close hreleased rest) + exact hcode (Nat.le_of_lt hfuel) ⟨rfl, hown, hborrow⟩ hrun + +/-- Prefix-free bounded alternative specialization. -/ +theorem LowerResultSoundBelow.altOwnershipContract + {ctx : Ctx} {cur : FnDef} {limit : Nat} {input output : VEnv} + {fieldWorld : Owned} {entryValid : List RVal → Array RVal → Prop} + {entryRoots : List RVal → Array RVal → List Root} + {emit : Emit} {av : AVal} {tag fieldCount : Nat} + (hsound : LowerResultSoundBelow ctx cur limit input output + cur.result emit av) + (hentry : AltEntryRealizes input fieldCount entryValid entryRoots) + (hreleased : EntriesReleased output.entries) : + AltOwnershipContractBelow ctx cur + (.mk tag fieldCount (emit (.ret (av.toAtom output)))) + fieldWorld entryValid entryRoots limit := by + simpa using hsound.altOwnershipContractWithPrefix + (entryEmit := (_root_.id : Emit)) + (fun hsize hvalid => hentry.emitIdBelow hsize hvalid _) hreleased + +/-- Recursive compiler premise for one recursor-rule RHS, stated against the +actual field-retain and parameter-release results consumed by +`lowerRecursorRule`. -/ +def RecursorRuleBodySound (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) + (fuel numArgs : Nat) (rule : IxIR0.RecRule) (state : LowSt) : Prop := + ∀ {fieldOutput : VEnv} {fieldEmit : Emit} + {rhsInput : VEnv} {parameterEmit : Emit}, + applyRecursorFieldRetains + ⟨List.replicate rule.fields (.slot 0 0 .many false), + (numArgs + 1) + rule.fields⟩ + (recursorFieldRetains (numArgs + 1) rule.rhs rule.fields) = + (fieldOutput, fieldEmit) → + (releaseSlots + ⟨fieldOutput.entries ++ + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (rule.fields + i) rule.rhs) ++ + [.recSelf (numArgs + 1)], + fieldOutput.depth + 1⟩ + ((parameterDrops 0 (List.replicate numArgs .many) + (fun i => countUses (rule.fields + i) rule.rhs)).map + (SlotDrop.offsetEntry rule.fields))).run state = + .ok (rhsInput, parameterEmit) state → + ∃ output bodyEmit av finalState, + (lowerE src fuel rhsInput .shared rule.rhs).run state = + .ok (output, bodyEmit, av) finalState ∧ + LowerResultSound ctx cur rhsInput output .shared bodyEmit av ∧ + EntriesReleased output.entries + +/-- Fuel-bounded recursive compiler premise for one recursor-rule RHS. -/ +def RecursorRuleBodySoundBelow (ctx : Ctx) (cur : FnDef) + (limit : Nat) (src : IxIR0.Env) (fuel numArgs : Nat) + (rule : IxIR0.RecRule) (state : LowSt) : Prop := + ∀ {fieldOutput : VEnv} {fieldEmit : Emit} + {rhsInput : VEnv} {parameterEmit : Emit}, + applyRecursorFieldRetains + ⟨List.replicate rule.fields (.slot 0 0 .many false), + (numArgs + 1) + rule.fields⟩ + (recursorFieldRetains (numArgs + 1) rule.rhs rule.fields) = + (fieldOutput, fieldEmit) → + (releaseSlots + ⟨fieldOutput.entries ++ + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (rule.fields + i) rule.rhs) ++ + [.recSelf (numArgs + 1)], + fieldOutput.depth + 1⟩ + ((parameterDrops 0 (List.replicate numArgs .many) + (fun i => countUses (rule.fields + i) rule.rhs)).map + (SlotDrop.offsetEntry rule.fields))).run state = + .ok (rhsInput, parameterEmit) state → + ∃ output bodyEmit av finalState, + (lowerE src fuel rhsInput .shared rule.rhs).run state = + .ok (output, bodyEmit, av) finalState ∧ + LowerResultSoundBelow ctx cur limit rhsInput output .shared + bodyEmit av ∧ + EntriesReleased output.entries + +/-- Bounded ownership transformer for the exact generated retain/major/ +parameter prefix of one recursor rule. -/ +def RecursorRulePrefixSoundBelow (ctx : Ctx) (cur : FnDef) + (limit numArgs : Nat) (rule : IxIR0.RecRule) (state : LowSt) : Prop := + ∀ {fieldOutput : VEnv} {fieldEmit : Emit} + {rhsInput : VEnv} {parameterEmit : Emit}, + applyRecursorFieldRetains + ⟨List.replicate rule.fields (.slot 0 0 .many false), + (numArgs + 1) + rule.fields⟩ + (recursorFieldRetains (numArgs + 1) rule.rhs rule.fields) = + (fieldOutput, fieldEmit) → + (releaseSlots + ⟨fieldOutput.entries ++ + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (rule.fields + i) rule.rhs) ++ + [.recSelf (numArgs + 1)], + fieldOutput.depth + 1⟩ + ((parameterDrops 0 (List.replicate numArgs .many) + (fun i => countUses (rule.fields + i) rule.rhs)).map + (SlotDrop.offsetEntry rule.fields))).run state = + .ok (rhsInput, parameterEmit) state → + ∀ {pre : List RVal} {major : RVal} {fields : Array RVal} + {rest : List Root}, + pre.length = numArgs → fields.size = rule.fields → + EmitSoundBelow ctx cur limit + (fieldEmit ∘ + emitOp (.drop (.var (fieldOutput.rel numArgs))) ∘ + parameterEmit) + (OwnsAltEntry .shared recursorEntryRoots + (major :: pre.reverse) fields rest) + (OwnsVEnv rhsInput rest) + +/-- The executable retain/release prefix itself supplies the bounded prefix +premise; callers need only identify its deterministic interpreter results. -/ +theorem recursorRulePrefixSound_generated_below + {ctx : Ctx} {cur : FnDef} (limit numArgs : Nat) + (rule : IxIR0.RecRule) (state : LowSt) : + RecursorRulePrefixSoundBelow ctx cur limit numArgs rule state := by + intro fieldOutput fieldEmit rhsInput parameterEmit + hfieldRun hparameterRun + intro pre major fields rest hpreLength hfields + obtain ⟨generatedFieldOutput, generatedFieldEmit, + generatedRhsInput, generatedParameterEmit, + generatedFieldRun, generatedParameterRun, hsound⟩ := + recursorPrefix_generated_verified_below (ctx := ctx) (cur := cur) + limit numArgs rule.fields rule.rhs state + have hfieldEq : + (fieldOutput, fieldEmit) = + (generatedFieldOutput, generatedFieldEmit) := + hfieldRun.symm.trans generatedFieldRun + cases hfieldEq + simp only [List.append_assoc] at hparameterRun + have hparameterResultEq := + hparameterRun.symm.trans generatedParameterRun + have hparameterEq : + (rhsInput, parameterEmit) = + (generatedRhsInput, generatedParameterEmit) := by + simpa using hparameterResultEq + cases hparameterEq + exact hsound hpreLength hfields + +/-- Shared operational constructor for a generated recursor rule. Exact and +bounded ownership clients choose their emitter, body, and alternative +judgments, while prefix normalization, RHS sequencing, alternative assembly, +run reconstruction, and entry-validity elimination occur once. -/ +private theorem lowerRecursorRule_generated_verified_core + {EmitJudgment : Emit → StatePred → StatePred → Prop} + {BodySound : VEnv → VEnv → Emit → AVal → Prop} + {Contract : Alt → Prop} + (src : IxIR0.Env) (fuel numArgs : Nat) (rule : IxIR0.RecRule) + (tag : Nat) (state : LowSt) + {fieldOutput : VEnv} {fieldEmit : Emit} + {rhsInput : VEnv} {parameterEmit : Emit} + (hfieldRun : + applyRecursorFieldRetains + ⟨List.replicate rule.fields (.slot 0 0 .many false), + (numArgs + 1) + rule.fields⟩ + (recursorFieldRetains (numArgs + 1) rule.rhs rule.fields) = + (fieldOutput, fieldEmit)) + (hparameterRun : + (releaseSlots + ⟨fieldOutput.entries ++ + (parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (rule.fields + i) rule.rhs) ++ + [.recSelf (numArgs + 1)]), + fieldOutput.depth + 1⟩ + ((parameterDrops 0 (List.replicate numArgs .many) + (fun i => countUses (rule.fields + i) rule.rhs)).map + (SlotDrop.offsetEntry rule.fields))).run state = + .ok (rhsInput, parameterEmit) state) + (hprefix : ∀ {pre : List RVal} {major : RVal} + {fields : Array RVal} {rest : List Root}, + pre.length = numArgs → fields.size = rule.fields → + EmitJudgment + (fieldEmit ∘ + emitOp (.drop (.var (fieldOutput.rel numArgs))) ∘ + parameterEmit) + (OwnsAltEntry .shared recursorEntryRoots + (major :: pre.reverse) fields rest) + (OwnsVEnv rhsInput rest)) + (hbody : + (releaseSlots + ⟨fieldOutput.entries ++ + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (rule.fields + i) rule.rhs) ++ + [.recSelf (numArgs + 1)], + fieldOutput.depth + 1⟩ + ((parameterDrops 0 (List.replicate numArgs .many) + (fun i => countUses (rule.fields + i) rule.rhs)).map + (SlotDrop.offsetEntry rule.fields))).run state = + .ok (rhsInput, parameterEmit) state → + ∃ output bodyEmit av finalState, + (lowerE src fuel rhsInput .shared rule.rhs).run state = + .ok (output, bodyEmit, av) finalState ∧ + BodySound rhsInput output bodyEmit av ∧ + EntriesReleased output.entries) + (hclose : ∀ {output : VEnv} {bodyEmit : Emit} {av : AVal}, + BodySound rhsInput output bodyEmit av → + (∀ {env : List RVal} {fields : Array RVal} {rest : List Root}, + fields.size = rule.fields → RecursorEntryValid numArgs env fields → + EmitJudgment + (fieldEmit ∘ + emitOp (.drop (.var (fieldOutput.rel numArgs))) ∘ + parameterEmit) + (OwnsAltEntry .shared recursorEntryRoots env fields rest) + (OwnsVEnv rhsInput rest)) → + EntriesReleased output.entries → + Contract (.mk tag rule.fields + (fieldEmit + (emitOp (.drop (.var (fieldOutput.rel numArgs))) + (parameterEmit (bodyEmit (.ret (av.toAtom output)))))))) : + ∃ finalState alt, + (lowerRecursorRule src fuel numArgs (rule, tag)).run state = + .ok alt finalState ∧ + Contract alt := by + have hparameterRun' : + (releaseSlots + ⟨fieldOutput.entries ++ + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (rule.fields + i) rule.rhs) ++ + [.recSelf (numArgs + 1)], + fieldOutput.depth + 1⟩ + ((parameterDrops 0 (List.replicate numArgs .many) + (fun i => countUses (rule.fields + i) rule.rhs)).map + (SlotDrop.offsetEntry rule.fields))).run state = + .ok (rhsInput, parameterEmit) state := by + simpa [List.append_assoc] using hparameterRun + obtain ⟨output, bodyEmit, av, finalState, + hbodyRun, hsound, hreleased⟩ := hbody hparameterRun' + let alt : Alt := + .mk tag rule.fields + (fieldEmit + (emitOp (.drop (.var (fieldOutput.rel numArgs))) + (parameterEmit (bodyEmit (.ret (av.toAtom output)))))) + refine ⟨finalState, alt, ?_, ?_⟩ + · simp only [lowerRecursorRule] + rw [hfieldRun] + simp only + rw [estateBindRun] + simp only [VEnv.bump, List.append_assoc] + rw [hparameterRun] + simp only + rw [estateBindRun, hbodyRun] + rfl + · have hprefixValid : ∀ {env : List RVal} {fields : Array RVal} + {rest : List Root}, + fields.size = rule.fields → RecursorEntryValid numArgs env fields → + EmitJudgment + (fieldEmit ∘ + emitOp (.drop (.var (fieldOutput.rel numArgs))) ∘ + parameterEmit) + (OwnsAltEntry .shared recursorEntryRoots env fields rest) + (OwnsVEnv rhsInput rest) := by + intro env fields rest hfields hvalid + obtain ⟨pre, major, hpreLength, rfl⟩ := hvalid + exact hprefix hpreLength hfields + simpa [alt] using hclose hsound hprefixValid hreleased + +/-- The executable lowering of one arbitrary recursor rule produces an +alternative satisfying the generic public entry contract. -/ +theorem lowerRecursorRule_generated_verified {ctx : Ctx} {cur : FnDef} + (hresult : cur.result = .shared) + (src : IxIR0.Env) (fuel numArgs : Nat) (rule : IxIR0.RecRule) + (tag : Nat) (state : LowSt) + (hbody : RecursorRuleBodySound ctx cur src fuel numArgs rule state) : + ∃ finalState alt, + (lowerRecursorRule src fuel numArgs (rule, tag)).run state = + .ok alt finalState ∧ + AltOwnershipContract ctx cur alt .shared + (RecursorEntryValid numArgs) recursorEntryRoots := by + obtain ⟨fieldOutput, fieldEmit, rhsInput, parameterEmit, + hfieldRun, hparameterRun, hprefix⟩ := + recursorPrefix_generated_verified (ctx := ctx) (cur := cur) + numArgs rule.fields rule.rhs state + refine lowerRecursorRule_generated_verified_core + (EmitJudgment := EmitSound ctx cur) + (BodySound := fun input output emit av => + LowerResultSound ctx cur input output .shared emit av) + (Contract := fun alt => + AltOwnershipContract ctx cur alt .shared + (RecursorEntryValid numArgs) recursorEntryRoots) + src fuel numArgs rule tag state hfieldRun hparameterRun hprefix + (fun hparameterRun' => hbody hfieldRun hparameterRun') ?_ + intro output bodyEmit av hsound hprefixValid hreleased + have hsoundCur : LowerResultSound ctx cur rhsInput output + cur.result bodyEmit av := by + simpa [hresult] using hsound + have hcontract := hsoundCur.altOwnershipContractWithPrefix + (fieldWorld := .shared) + (entryValid := RecursorEntryValid numArgs) + (entryRoots := recursorEntryRoots) + (entryEmit := fieldEmit ∘ + emitOp (.drop (.var (fieldOutput.rel numArgs))) ∘ parameterEmit) + (tag := tag) (fieldCount := rule.fields) hprefixValid hreleased + simpa [Function.comp_def] using hcontract + +/-- Exact-fuel version of `lowerRecursorRule_generated_verified`. The +recursive RHS and the generated prefix both carry only bounded Hoare proofs, +and the produced alternative is correspondingly bounded. -/ +theorem lowerRecursorRule_generated_verified_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} + (hresult : cur.result = .shared) + (src : IxIR0.Env) (fuel numArgs : Nat) (rule : IxIR0.RecRule) + (tag : Nat) (state : LowSt) + (hbody : RecursorRuleBodySoundBelow ctx cur limit src fuel numArgs + rule state) : + ∃ finalState alt, + (lowerRecursorRule src fuel numArgs (rule, tag)).run state = + .ok alt finalState ∧ + AltOwnershipContractBelow ctx cur alt .shared + (RecursorEntryValid numArgs) recursorEntryRoots limit := by + obtain ⟨fieldOutput, fieldEmit, rhsInput, parameterEmit, + hfieldRun, hparameterRun, hprefix⟩ := + recursorPrefix_generated_verified_below (ctx := ctx) (cur := cur) + limit numArgs rule.fields rule.rhs state + refine lowerRecursorRule_generated_verified_core + (EmitJudgment := EmitSoundBelow ctx cur limit) + (BodySound := fun input output emit av => + LowerResultSoundBelow ctx cur limit input output .shared emit av) + (Contract := fun alt => + AltOwnershipContractBelow ctx cur alt .shared + (RecursorEntryValid numArgs) recursorEntryRoots limit) + src fuel numArgs rule tag state hfieldRun hparameterRun hprefix + (fun hparameterRun' => hbody hfieldRun hparameterRun') ?_ + intro output bodyEmit av hsound hprefixValid hreleased + have hsoundCur : LowerResultSoundBelow ctx cur limit rhsInput output + cur.result bodyEmit av := by + simpa [hresult] using hsound + have hcontract := hsoundCur.altOwnershipContractWithPrefix + (fieldWorld := .shared) + (entryValid := RecursorEntryValid numArgs) + (entryRoots := recursorEntryRoots) + (entryEmit := fieldEmit ∘ + emitOp (.drop (.var (fieldOutput.rel numArgs))) ∘ parameterEmit) + (tag := tag) (fieldCount := rule.fields) hprefixValid hreleased + simpa [Function.comp_def] using hcontract + +/-- Contract-parameterized state-threaded traversal of indexed recursor +rules. Exact and bounded ownership plans share this executable spine and its +recursive eliminators. -/ +inductive RecursorRulesPlanWith (RuleContract : Alt → Prop) + (src : IxIR0.Env) (fuel numArgs : Nat) : + LowSt → List (IxIR0.RecRule × Nat) → LowSt → List Alt → Prop where + | nil (state : LowSt) : + RecursorRulesPlanWith RuleContract src fuel numArgs + state [] state [] + | cons {state middleState finalState : LowSt} + {rule : IxIR0.RecRule} {tag : Nat} + {rules : List (IxIR0.RecRule × Nat)} {alt : Alt} {alts : List Alt} + (hhead : (lowerRecursorRule src fuel numArgs (rule, tag)).run state = + .ok alt middleState) + (hcontract : RuleContract alt) + (tail : RecursorRulesPlanWith RuleContract src fuel numArgs + middleState rules finalState alts) : + RecursorRulesPlanWith RuleContract src fuel numArgs state + ((rule, tag) :: rules) finalState (alt :: alts) + +/-- Dependent traversal over the shared recursor-rule plan. State, source +rule/tag, generated alternative, successful head execution, and the selected +alternative contract are threaded once; clients retain the original tail +witness together with the recursively produced result. -/ +theorem RecursorRulesPlanWith.traverse + {RuleContract : Alt → Prop} + {src : IxIR0.Env} {fuel numArgs : Nat} + {Result : LowSt → List (IxIR0.RecRule × Nat) → + LowSt → List Alt → Prop} + (hnil : ∀ state, Result state [] state []) + (hcons : ∀ {state middleState finalState : LowSt} + {rule : IxIR0.RecRule} {tag : Nat} + {rules : List (IxIR0.RecRule × Nat)} + {alt : Alt} {alts : List Alt}, + (lowerRecursorRule src fuel numArgs (rule, tag)).run state = + .ok alt middleState → + RuleContract alt → + RecursorRulesPlanWith RuleContract src fuel numArgs + middleState rules finalState alts → + Result middleState rules finalState alts → + Result state ((rule, tag) :: rules) finalState (alt :: alts)) + {state finalState : LowSt} + {rules : List (IxIR0.RecRule × Nat)} {alts : List Alt} + (hplan : RecursorRulesPlanWith RuleContract src fuel numArgs + state rules finalState alts) : + Result state rules finalState alts := by + induction hplan with + | nil state => exact hnil state + | cons hhead hcontract tail ih => + exact hcons hhead hcontract tail ih + +/-- Exact ownership specialization of the shared traversal family. -/ +abbrev RecursorRulesPlan (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) + (fuel numArgs : Nat) := + RecursorRulesPlanWith + (fun alt => AltOwnershipContract ctx cur alt .shared + (RecursorEntryValid numArgs) recursorEntryRoots) + src fuel numArgs + +/-- Public empty exact-plan constructor retained across the generic spine. -/ +theorem RecursorRulesPlan.nil {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel numArgs : Nat} (state : LowSt) : + RecursorRulesPlan ctx cur src fuel numArgs state [] state [] := + RecursorRulesPlanWith.nil state + +/-- Public exact-plan step constructor retained across the generic spine. -/ +theorem RecursorRulesPlan.cons {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel numArgs : Nat} + {state middleState finalState : LowSt} + {rule : IxIR0.RecRule} {tag : Nat} + {rules : List (IxIR0.RecRule × Nat)} {alt : Alt} {alts : List Alt} + (hhead : (lowerRecursorRule src fuel numArgs (rule, tag)).run state = + .ok alt middleState) + (hcontract : AltOwnershipContract ctx cur alt .shared + (RecursorEntryValid numArgs) recursorEntryRoots) + (tail : RecursorRulesPlan ctx cur src fuel numArgs + middleState rules finalState alts) : + RecursorRulesPlan ctx cur src fuel numArgs state + ((rule, tag) :: rules) finalState (alt :: alts) := + RecursorRulesPlanWith.cons hhead hcontract tail + +/-- Every specialization of the shared traversal computes the exact +successful `mapM` result. -/ +theorem RecursorRulesPlanWith.run {RuleContract : Alt → Prop} + {src : IxIR0.Env} {fuel numArgs : Nat} + {state finalState : LowSt} {rules : List (IxIR0.RecRule × Nat)} + {alts : List Alt} + (hplan : RecursorRulesPlanWith RuleContract src fuel numArgs + state rules finalState alts) : + (rules.mapM (lowerRecursorRule src fuel numArgs)).run state = + .ok alts finalState := by + exact RecursorRulesPlanWith.traverse + (Result := fun current currentRules currentFinal currentAlts => + (currentRules.mapM (lowerRecursorRule src fuel numArgs)).run current = + .ok currentAlts currentFinal) + (hnil := by + intro current + rfl) + (hcons := by + intro state middleState finalState rule tag rules alt alts + hhead hcontract tail ih + simp only [List.mapM_cons] + rw [estateBindRun, hhead] + simp only + rw [estateBindRun, ih] + rfl) + (hplan := hplan) + +/-- Every output of the shared traversal carries its selected contract +payload. -/ +theorem RecursorRulesPlanWith.forall_mem {RuleContract : Alt → Prop} + {src : IxIR0.Env} {fuel numArgs : Nat} + {state finalState : LowSt} {rules : List (IxIR0.RecRule × Nat)} + {alts : List Alt} + (hplan : RecursorRulesPlanWith RuleContract src fuel numArgs + state rules finalState alts) : + ∀ alt ∈ alts, RuleContract alt := by + exact RecursorRulesPlanWith.traverse + (Result := fun _ _ _ currentAlts => + ∀ selected ∈ currentAlts, RuleContract selected) + (hnil := by + intro current + simp) + (hcons := by + intro state middleState finalState rule tag rules alt alts + hhead hcontract tail ih selected hmem + simp only [List.mem_cons] at hmem + rcases hmem with rfl | htail + · exact hcontract + · exact ih selected htail) + (hplan := hplan) + +/-- Exact-plan compatibility wrapper for the shared run theorem. -/ +theorem RecursorRulesPlan.run {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel numArgs : Nat} + {state finalState : LowSt} {rules : List (IxIR0.RecRule × Nat)} + {alts : List Alt} + (hplan : RecursorRulesPlan ctx cur src fuel numArgs + state rules finalState alts) : + (rules.mapM (lowerRecursorRule src fuel numArgs)).run state = + .ok alts finalState := + RecursorRulesPlanWith.run hplan + +/-- Exact-plan compatibility wrapper for shared contract membership. -/ +theorem RecursorRulesPlan.forall_mem {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel numArgs : Nat} + {state finalState : LowSt} {rules : List (IxIR0.RecRule × Nat)} + {alts : List Alt} + (hplan : RecursorRulesPlan ctx cur src fuel numArgs + state rules finalState alts) : + ∀ alt ∈ alts, + AltOwnershipContract ctx cur alt .shared + (RecursorEntryValid numArgs) recursorEntryRoots := + RecursorRulesPlanWith.forall_mem hplan + +/-- Ownership contracts for every alternative that the evaluator can select. +Indexing by the successful `Array.find?` equation mirrors `runCode` exactly +and avoids imposing a separate uniqueness or array-membership invariant. -/ +def RecursorAltContracts (ctx : Ctx) (cur : FnDef) (numArgs : Nat) + (alts : Array Alt) : Prop := + ∀ {cidx tag fieldCount : Nat} {body : Code}, + alts.find? (fun alt => alt.cidx == cidx) = + some (.mk tag fieldCount body) → + AltOwnershipContract ctx cur (.mk tag fieldCount body) .shared + (RecursorEntryValid numArgs) recursorEntryRoots + +/-- Pointwise contracts collect into the evaluator-selection-indexed bundle. -/ +theorem RecursorAltContracts.of_forall_mem {ctx : Ctx} {cur : FnDef} + {numArgs : Nat} {alts : Array Alt} + (hall : ∀ alt ∈ alts, + AltOwnershipContract ctx cur alt .shared + (RecursorEntryValid numArgs) recursorEntryRoots) : + RecursorAltContracts ctx cur numArgs alts := by + intro cidx tag fieldCount body hfind + exact hall (.mk tag fieldCount body) + (Array.mem_of_find?_eq_some hfind) + +/-- A completed rule traversal supplies the selection-indexed bundle used by +the `case` evaluator. -/ +theorem RecursorRulesPlan.altContracts {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel numArgs : Nat} + {state finalState : LowSt} {rules : List (IxIR0.RecRule × Nat)} + {alts : List Alt} + (hplan : RecursorRulesPlan ctx cur src fuel numArgs + state rules finalState alts) : + RecursorAltContracts ctx cur numArgs alts.toArray := by + apply RecursorAltContracts.of_forall_mem + intro alt hmem + apply hplan.forall_mem alt + simpa using hmem + +/-- Selection-indexed alternative contracts available below one evaluator +fuel bound. -/ +def RecursorAltContractsBelow (ctx : Ctx) (cur : FnDef) + (numArgs : Nat) (alts : Array Alt) (limit : Nat) : Prop := + ∀ {cidx tag fieldCount : Nat} {body : Code}, + alts.find? (fun alt => alt.cidx == cidx) = + some (.mk tag fieldCount body) → + AltOwnershipContractBelow ctx cur (.mk tag fieldCount body) .shared + (RecursorEntryValid numArgs) recursorEntryRoots limit + +/-- Restrict a completed recursor alternative bundle to a fuel prefix. -/ +theorem RecursorAltContracts.below {ctx : Ctx} {cur : FnDef} + {numArgs : Nat} {alts : Array Alt} + (hcontracts : RecursorAltContracts ctx cur numArgs alts) + (limit : Nat) : + RecursorAltContractsBelow ctx cur numArgs alts limit := by + intro cidx tag fieldCount body hfind + exact (hcontracts hfind).below limit + +/-- Bounded recursor alternative bundles are contravariant in their bound. -/ +theorem RecursorAltContractsBelow.mono {ctx : Ctx} {cur : FnDef} + {numArgs : Nat} {alts : Array Alt} {smaller larger : Nat} + (hcontracts : RecursorAltContractsBelow ctx cur numArgs alts larger) + (hbound : smaller ≤ larger) : + RecursorAltContractsBelow ctx cur numArgs alts smaller := by + intro cidx tag fieldCount body hfind + exact (hcontracts hfind).mono hbound + +/-- Bounded ownership specialization of the shared traversal family. -/ +abbrev RecursorRulesPlanBelow (ctx : Ctx) (cur : FnDef) + (limit : Nat) (src : IxIR0.Env) (fuel numArgs : Nat) := + RecursorRulesPlanWith + (fun alt => AltOwnershipContractBelow ctx cur alt .shared + (RecursorEntryValid numArgs) recursorEntryRoots limit) + src fuel numArgs + +/-- Public empty bounded-plan constructor retained across the generic spine. -/ +theorem RecursorRulesPlanBelow.nil {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {fuel numArgs : Nat} + (state : LowSt) : + RecursorRulesPlanBelow ctx cur limit src fuel numArgs + state [] state [] := + RecursorRulesPlanWith.nil state + +/-- Public bounded-plan step constructor retained across the generic spine. -/ +theorem RecursorRulesPlanBelow.cons {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {fuel numArgs : Nat} + {state middleState finalState : LowSt} + {rule : IxIR0.RecRule} {tag : Nat} + {rules : List (IxIR0.RecRule × Nat)} {alt : Alt} {alts : List Alt} + (hhead : (lowerRecursorRule src fuel numArgs (rule, tag)).run state = + .ok alt middleState) + (hcontract : AltOwnershipContractBelow ctx cur alt .shared + (RecursorEntryValid numArgs) recursorEntryRoots limit) + (tail : RecursorRulesPlanBelow ctx cur limit src fuel numArgs + middleState rules finalState alts) : + RecursorRulesPlanBelow ctx cur limit src fuel numArgs state + ((rule, tag) :: rules) finalState (alt :: alts) := + RecursorRulesPlanWith.cons hhead hcontract tail + +/-- Bounded-plan compatibility wrapper for the shared run theorem. -/ +theorem RecursorRulesPlanBelow.run {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {fuel numArgs : Nat} + {state finalState : LowSt} {rules : List (IxIR0.RecRule × Nat)} + {alts : List Alt} + (hplan : RecursorRulesPlanBelow ctx cur limit src fuel numArgs + state rules finalState alts) : + (rules.mapM (lowerRecursorRule src fuel numArgs)).run state = + .ok alts finalState := + RecursorRulesPlanWith.run hplan + +/-- Bounded-plan compatibility wrapper for shared contract membership. -/ +theorem RecursorRulesPlanBelow.forall_mem {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {fuel numArgs : Nat} + {state finalState : LowSt} {rules : List (IxIR0.RecRule × Nat)} + {alts : List Alt} + (hplan : RecursorRulesPlanBelow ctx cur limit src fuel numArgs + state rules finalState alts) : + ∀ alt ∈ alts, + AltOwnershipContractBelow ctx cur alt .shared + (RecursorEntryValid numArgs) recursorEntryRoots limit := + RecursorRulesPlanWith.forall_mem hplan + +/-- Trace any generated alternative back to the exact source rule/tag run +that produced it, retaining the remaining proof-relevant tail from that +point to the traversal's final compiler state. -/ +theorem RecursorRulesPlanBelow.trace_mem {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {fuel numArgs : Nat} + {state finalState : LowSt} {rules : List (IxIR0.RecRule × Nat)} + {alts : List Alt} + (hplan : RecursorRulesPlanBelow ctx cur limit src fuel numArgs + state rules finalState alts) : + ∀ alt ∈ alts, + ∃ rule tag headState nextState tailRules tailAlts, + (rule, tag) ∈ rules ∧ + (lowerRecursorRule src fuel numArgs (rule, tag)).run headState = + .ok alt nextState ∧ + RecursorRulesPlanBelow ctx cur limit src fuel numArgs + nextState tailRules finalState tailAlts := by + exact RecursorRulesPlanWith.traverse + (Result := fun _ currentRules currentFinal currentAlts => + ∀ selected ∈ currentAlts, + ∃ rule tag headState nextState tailRules tailAlts, + (rule, tag) ∈ currentRules ∧ + (lowerRecursorRule src fuel numArgs (rule, tag)).run headState = + .ok selected nextState ∧ + RecursorRulesPlanBelow ctx cur limit src fuel numArgs + nextState tailRules currentFinal tailAlts) + (hnil := by + intro current selected hmember + simp at hmember) + (hcons := by + intro state middleState finalState rule tag rules alt alts + hhead hcontract tail ih selected hmember + simp only [List.mem_cons] at hmember + rcases hmember with rfl | htail + · exact ⟨rule, tag, state, middleState, rules, alts, + by simp, hhead, tail⟩ + · obtain ⟨foundRule, foundTag, headState, nextState, + tailRules, tailAlts, hfound, hrun, htailPlan⟩ := + ih selected htail + exact ⟨foundRule, foundTag, headState, nextState, + tailRules, tailAlts, by simp [hfound], hrun, htailPlan⟩) + (hplan := hplan) + +/-- A bounded traversal supplies every selection-indexed alternative +contract used by the exact-fuel recursor collector. -/ +theorem RecursorRulesPlanBelow.altContracts {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {fuel numArgs : Nat} + {state finalState : LowSt} {rules : List (IxIR0.RecRule × Nat)} + {alts : List Alt} + (hplan : RecursorRulesPlanBelow ctx cur limit src fuel numArgs + state rules finalState alts) : + RecursorAltContractsBelow ctx cur numArgs alts.toArray limit := by + intro cidx tag fieldCount body hfind + apply hplan.forall_mem (.mk tag fieldCount body) + simpa using Array.mem_of_find?_eq_some hfind + +private theorem lowerSimExceptBindOk {error α β : Type} (value : α) + (next : α → Except error β) : + (Except.ok value >>= next) = next value := rfl + +/-- At one exact evaluator index, bounded contracts for every selectable +alternative preserve the public all-shared recursor boundary. -/ +theorem recursorFnOwnershipPreservesAt (ctx : Ctx) (numArgs : Nat) + (natLit : Bool) (alts : Array Alt) (fuel : Nat) : + let d : FnDef := + ⟨numArgs + 1, .shared, true, .case (.var 0) natLit alts⟩ + RecursorAltContractsBelow ctx d numArgs alts fuel → + FnOwnershipPreservesAt ctx d + (List.replicate (numArgs + 1) .shared) fuel := by + dsimp only + let d : FnDef := + ⟨numArgs + 1, .shared, true, .case (.var 0) natLit alts⟩ + intro hcontracts + intro store store' args value rest hargsLength hown hrun + have hargsArity : args.length = numArgs + 1 := by + simpa using hargsLength + have hrootShape : + rootsForWorlds (List.replicate (numArgs + 1) .shared) args = + rootsFor .shared args := + rootsForWorlds_replicate_eq_rootsFor .shared hargsArity + rw [hrootShape] at hown + cases fuel with + | zero => simp [runCode] at hrun + | succ branchFuel => + cases hreverse : args.reverse with + | nil => + have hargsNil : args = [] := by + have h := congrArg List.reverse hreverse + simpa using h + simp [hargsNil] at hargsArity + | cons major runtimePre => + have hargsForm : args = runtimePre.reverse ++ [major] := by + have h := congrArg List.reverse hreverse + simpa [List.reverse_cons] using h + have hruntimePreLength : runtimePre.length = numArgs := by + rw [hargsForm] at hargsArity + simp only [List.length_append, List.length_reverse, + List.length_singleton] at hargsArity + omega + have hvalid (fields : Array RVal) : + RecursorEntryValid numArgs (major :: runtimePre) fields := by + exact ⟨runtimePre.reverse, major, by simpa using hruntimePreLength, + by simp⟩ + have hentryOwn (fields : Array RVal) : RootOwnership store + (recursorEntryRoots (major :: runtimePre) fields ++ rest) := by + simpa [recursorEntryRoots, hargsForm, List.reverse_cons] using hown + have hmajorWorld : HasWorld store .shared major := by + apply hown.roots_world ⟨.shared, major⟩ + apply List.mem_append_left rest + simp [rootsFor, hargsForm] + rw [hreverse] at hrun + change runCode ctx (branchFuel + 1) d store + (major :: runtimePre) (.case (.var 0) natLit alts) = + .ok (store', value) at hrun + have hdispatch := hrun + rw [runCode.eq_def] at hdispatch + dsimp only at hdispatch + rw [show resolveAtom (major :: runtimePre) (.var 0) = .ok major + from rfl, lowerSimExceptBindOk] at hdispatch + cases major with + | erased => contradiction + | lit literal => + cases literal with + | str string => contradiction + | nat n => + cases hpeel : natLit with + | false => simp [hpeel] at hdispatch + | true => + cases n with + | zero => + cases halt : alts.find? (fun alt => alt.cidx == 0) with + | none => simp [hpeel, halt] at hdispatch + | some alt => + cases alt with + | mk tag fieldCount body => + cases fieldCount with + | zero => + exact runCode_case_nat_zero_contract_owned_below + (ctx := ctx) (fuel := branchFuel) (cur := d) + (store := store) (store' := store') + (env := .lit (.nat 0) :: runtimePre) + (scrut := .var 0) + (alts := alts) (tag := tag) (body := body) + (value := value) (rest := rest) + (fieldWorld := .shared) + (entryValid := RecursorEntryValid numArgs) + (entryRoots := recursorEntryRoots) + rfl halt (hcontracts halt) (hvalid #[]) + (hentryOwn #[]) (by simpa [hpeel] using hrun) + | succ fieldCount => + simp [hpeel, halt] at hdispatch + | succ n => + cases halt : alts.find? (fun alt => alt.cidx == 1) with + | none => simp [hpeel, halt] at hdispatch + | some alt => + cases alt with + | mk tag fieldCount body => + by_cases hfieldCount : fieldCount = 1 + · subst fieldCount + exact runCode_case_nat_succ_contract_owned_below + (ctx := ctx) (fuel := branchFuel) (cur := d) + (store := store) (store' := store') + (env := .lit (.nat (n + 1)) :: runtimePre) + (scrut := .var 0) + (alts := alts) (n := n) (tag := tag) (body := body) + (value := value) (rest := rest) + (fieldWorld := .shared) + (entryValid := RecursorEntryValid numArgs) + (entryRoots := recursorEntryRoots) + rfl halt (hcontracts halt) + (hvalid #[.lit (.nat n)]) + (hentryOwn #[.lit (.nat n)]) + (by simpa [hpeel] using hrun) + · simp [hpeel, halt, hfieldCount] at hdispatch + | loc loc => + obtain ⟨ownedBox, hownedBox, hownedWorld⟩ := hmajorWorld + cases hget : store.get? loc with + | none => + rw [hget] at hownedBox + contradiction + | some box => + rw [hget] at hownedBox + have hboxEq : box = ownedBox := Option.some.inj hownedBox + subst ownedBox + cases box with + | mk boxWorld rc node => + dsimp only [NodeBox.world] at hownedWorld + subst boxWorld + cases node with + | papN fn arity papArgs => + simp [hget] at hdispatch + | ctorN cid fields => + cases halt : alts.find? + (fun alt => alt.cidx == cid.cidx) with + | none => simp [hget, halt] at hdispatch + | some alt => + cases alt with + | mk tag fieldCount body => + by_cases hsize : fields.size = fieldCount + · exact runCode_case_ctor_contract_owned_below + (ctx := ctx) (fuel := branchFuel) (cur := d) + (store := store) (store' := store') + (env := .loc loc :: runtimePre) (scrut := .var 0) + (peelNat := natLit) (alts := alts) (loc := loc) + (rc := rc) (world := .shared) (cid := cid) + (fields := fields) (tag := tag) + (nf := fieldCount) (body := body) (value := value) + (rest := rest) + (entryValid := RecursorEntryValid numArgs) + (entryRoots := recursorEntryRoots) + rfl hget halt hsize (hcontracts halt) + (hvalid fields) (hentryOwn fields) hrun + · simp [hget, halt, hsize] at hdispatch + +/-- Collecting completed contracts for every selectable alternative yields +the public unbounded recursor contract. The implementation now seals the +exact-fuel collector above, so recursive alternatives need only smaller-fuel +self contracts when constructed by the mutual compiler proof. -/ +theorem recursorFnOwnershipContract (ctx : Ctx) (numArgs : Nat) + (natLit : Bool) (alts : Array Alt) : + let d : FnDef := + ⟨numArgs + 1, .shared, true, .case (.var 0) natLit alts⟩ + RecursorAltContracts ctx d numArgs alts → + FnOwnershipContract ctx d + (List.replicate (numArgs + 1) .shared) := by + dsimp only + let d : FnDef := + ⟨numArgs + 1, .shared, true, .case (.var 0) natLit alts⟩ + intro hcontracts + apply fnOwnershipContract_of_below_step (by simp) + intro limit _ + exact recursorFnOwnershipPreservesAt ctx numArgs natLit alts limit + (hcontracts.below limit) + +/-- Shared finalizer for a generated recursor. The result family lets exact +contract sealing and one-index preservation remain distinct while target +definition normalization and executable rule-traversal reconstruction occur +once. -/ +private theorem lowerRecursor_generated_verified_core + (src : IxIR0.Env) (fuel numArgs : Nat) (natLit : Bool) + (rules : Array IxIR0.RecRule) (state finalState : LowSt) + (alts : List Alt) (d : FnDef) + (hd : d = ⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩) + {Plan Result : FnDef → Prop} + (hplan : Plan d) + (hplanRun : ∀ {actual}, Plan actual → + (rules.toList.zipIdx.mapM + (lowerRecursorRule src fuel numArgs)).run state = + .ok alts finalState) + (hresult : Plan ⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩ → + Result ⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩) : + (lowerRecursor src fuel numArgs natLit rules).run state = + .ok d finalState ∧ + Result d := by + subst d + constructor + · simp only [lowerRecursor] + rw [estateBindRun, hplanRun hplan] + rfl + · exact hresult hplan + +/-- Complete generated-recursors rule: an exact state-threaded traversal of +the compiler's indexed rule list yields both the executable `lowerRecursor` +result and its public `FnOwnershipContract`. -/ +theorem lowerRecursor_generated_verified {ctx : Ctx} + (src : IxIR0.Env) (fuel numArgs : Nat) (natLit : Bool) + (rules : Array IxIR0.RecRule) (state finalState : LowSt) + (alts : List Alt) (d : FnDef) + (hd : d = ⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩) + (hplan : RecursorRulesPlan ctx d src fuel numArgs state + rules.toList.zipIdx finalState alts) : + (lowerRecursor src fuel numArgs natLit rules).run state = + .ok d finalState ∧ + FnOwnershipContract ctx d + (List.replicate (numArgs + 1) .shared) := by + exact lowerRecursor_generated_verified_core + (Plan := fun actual => + RecursorRulesPlan ctx actual src fuel numArgs state + rules.toList.zipIdx finalState alts) + (Result := fun actual => FnOwnershipContract ctx actual + (List.replicate (numArgs + 1) .shared)) + src fuel numArgs natLit rules state finalState alts d hd hplan + (fun plan => plan.run) + (fun plan => recursorFnOwnershipContract ctx numArgs natLit alts.toArray + plan.altContracts) + +/-- Exact-fuel generated-recursors rule. A bounded state-threaded rule plan +produces both the executable recursor and its one-index ownership theorem; +`compilerContracts_of_below_step` later seals these results globally. -/ +theorem lowerRecursor_generated_verified_below {ctx : Ctx} + (limit : Nat) (src : IxIR0.Env) (fuel numArgs : Nat) (natLit : Bool) + (rules : Array IxIR0.RecRule) (state finalState : LowSt) + (alts : List Alt) (d : FnDef) + (hd : d = ⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩) + (hplan : RecursorRulesPlanBelow ctx d limit src fuel numArgs state + rules.toList.zipIdx finalState alts) : + (lowerRecursor src fuel numArgs natLit rules).run state = + .ok d finalState ∧ + FnOwnershipPreservesAt ctx d + (List.replicate (numArgs + 1) .shared) limit := by + exact lowerRecursor_generated_verified_core + (Plan := fun actual => + RecursorRulesPlanBelow ctx actual limit src fuel numArgs state + rules.toList.zipIdx finalState alts) + (Result := fun actual => FnOwnershipPreservesAt ctx actual + (List.replicate (numArgs + 1) .shared) limit) + src fuel numArgs natLit rules state finalState alts d hd hplan + (fun plan => plan.run) + (fun plan => recursorFnOwnershipPreservesAt ctx numArgs natLit + alts.toArray limit plan.altContracts) + +/-! ## Source/target declaration-contract environment -/ + +/-- The callable target signature determined by a source declaration. +Constructors lower directly at use sites and externs remain target externs, +so only definitions and recursors contribute function contracts. -/ +def sourceCallableSignature : IxIR0.Decl → + Option (List Owned × Owned) + | .defn result body => + some ((lamUses body).map worldOfUses, result) + | .recursor numArgs _ _ => + some (List.replicate (numArgs + 1) .shared, .shared) + | .ctor _ _ | .extern _ => none + +/-- Callable source branches of `lowerDecl` always emit a function at the +same address; constructors and externs have no source callable signature. -/ +theorem lowerDecl_output_fn_of_callable + {src : IxIR0.Env} {fuel : Nat} {address : Ixon.Address} + {source : IxIR0.Decl} {worlds : List Owned} + {resultWorld : Owned} {initial final : LowSt} + {output : Option (Ixon.Address × Decl)} + (hsignature : sourceCallableSignature source = + some (worlds, resultWorld)) + (hrun : (lowerDecl src fuel (address, source)).run initial = + .ok output final) : + ∃ d, output = some (address, .fn d) := by + cases source with + | defn result body => + simp only [lowerDecl] at hrun + obtain ⟨code, bodyState, hbodyRun, hpureRun⟩ := + estateBindRun_ok_inv hrun + have hpure : some (address, Decl.fn + ⟨lamArity body, result, result == .shared && papSafe body, code⟩) = output ∧ + bodyState = final := by + simpa using hpureRun + exact ⟨⟨lamArity body, result, + result == .shared && papSafe body, code⟩, hpure.1.symm⟩ + | ctor tag arity => simp [sourceCallableSignature] at hsignature + | recursor numArgs natLit rules => + simp only [lowerDecl] at hrun + obtain ⟨d, recursorState, hrecursorRun, hpureRun⟩ := + estateBindRun_ok_inv hrun + have hpure : some (address, Decl.fn d) = output ∧ + recursorState = final := by + simpa using hpureRun + exact ⟨d, hpure.1.symm⟩ + | extern arity => simp [sourceCallableSignature] at hsignature + +/-- Callable declaration lowering preserves the source signature in the +emitted same-address function. This is the fuel-independent layout half of +the eventual ownership contract. -/ +theorem lowerDecl_output_fn_layout_of_callable + {src : IxIR0.Env} {fuel : Nat} {address : Ixon.Address} + {source : IxIR0.Decl} {worlds : List Owned} + {resultWorld : Owned} {initial final : LowSt} + {output : Option (Ixon.Address × Decl)} + (hsignature : sourceCallableSignature source = + some (worlds, resultWorld)) + (hrun : (lowerDecl src fuel (address, source)).run initial = + .ok output final) : + ∃ d, output = some (address, .fn d) ∧ + d.arity = worlds.length ∧ d.result = resultWorld := by + cases source with + | defn result body => + simp only [sourceCallableSignature, Option.some.injEq, + Prod.mk.injEq] at hsignature + obtain ⟨rfl, rfl⟩ := hsignature + simp only [lowerDecl] at hrun + obtain ⟨code, bodyState, _, hpureRun⟩ := + estateBindRun_ok_inv hrun + have hpure : + some (address, Decl.fn + ⟨lamArity body, result, + result == .shared && papSafe body, code⟩) = output ∧ + bodyState = final := by + simpa using hpureRun + refine ⟨⟨lamArity body, result, + result == .shared && papSafe body, code⟩, + hpure.1.symm, ?_, rfl⟩ + simp [lamUses_length] + | ctor tag arity => simp [sourceCallableSignature] at hsignature + | recursor numArgs natLit rules => + simp only [sourceCallableSignature, Option.some.injEq, + Prod.mk.injEq] at hsignature + obtain ⟨rfl, rfl⟩ := hsignature + simp only [lowerDecl] at hrun + obtain ⟨actual, recursorState, hrecursorRun, hafterRecursor⟩ := + estateBindRun_ok_inv hrun + simp only [lowerRecursor] at hrecursorRun + obtain ⟨alts, rulesState, _, hafterRules⟩ := + estateBindRun_ok_inv hrecursorRun + have hactual : actual = + ⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩ := by + have hpure : + (⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩ : FnDef) = actual ∧ + rulesState = recursorState := by + simpa using hafterRules + exact hpure.1.symm + subst actual + have hpure : + some (address, Decl.fn + ⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩) = output ∧ + recursorState = final := by + simpa using hafterRecursor + refine ⟨⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩, + hpure.1.symm, by simp, rfl⟩ + | extern arity => simp [sourceCallableSignature] at hsignature + +/-- If one declaration action returned a function, its input was a callable +source declaration at the same producer address. -/ +theorem lowerDecl_fn_output_input_callable + {src : IxIR0.Env} {fuel : Nat} + {sourceAddress address : Ixon.Address} {source : IxIR0.Decl} + {initial final : LowSt} {d : FnDef} + (hrun : (lowerDecl src fuel (sourceAddress, source)).run initial = + .ok (some (address, .fn d)) final) : + sourceAddress = address ∧ + ∃ worlds result, + sourceCallableSignature source = some (worlds, result) := by + cases source with + | defn result body => + simp only [lowerDecl] at hrun + obtain ⟨code, bodyState, _, hpureRun⟩ := + estateBindRun_ok_inv hrun + have hpure : + some (sourceAddress, Decl.fn + ⟨lamArity body, result, + result == .shared && papSafe body, code⟩) = + some (address, .fn d) ∧ bodyState = final := by + simpa using hpureRun + have haddress : sourceAddress = address := + congrArg Prod.fst (Option.some.inj hpure.1) + exact ⟨haddress, ⟨(lamUses body).map worldOfUses, result, rfl⟩⟩ + | ctor tag arity => + simp [lowerDecl] at hrun + | recursor numArgs natLit rules => + simp only [lowerDecl] at hrun + obtain ⟨actual, recursorState, _, hpureRun⟩ := + estateBindRun_ok_inv hrun + have hpure : + some (sourceAddress, Decl.fn actual) = + some (address, .fn d) ∧ recursorState = final := by + simpa using hpureRun + have haddress : sourceAddress = address := + congrArg Prod.fst (Option.some.inj hpure.1) + exact ⟨haddress, + ⟨List.replicate (numArgs + 1) .shared, .shared, rfl⟩⟩ + | extern arity => + simp [lowerDecl] at hrun + +/-- Fuel-independent correspondence between the source declaration map and +the target context. The semantic contract is kept separate so all functions +can be closed simultaneously by evaluator-fuel induction. -/ +structure SourceDeclLayout (src : IxIR0.Env) (ctx : Ctx) : Prop where + fn : ∀ {address source worlds result}, + src address = some source → + sourceCallableSignature source = some (worlds, result) → + ∃ d, ctx.decls address = some (.fn d) ∧ + d.arity = worlds.length ∧ d.result = result + extern : ∀ {address arity}, + src address = some (.extern arity) → + ctx.decls address = some (.extern arity) + +/-- Pointwise ownership preservation of every source-backed target function +at one exact evaluator-fuel index. -/ +def SourceFnPreservesAt (src : IxIR0.Env) (ctx : Ctx) + (fuel : Nat) : Prop := + ∀ {address source worlds result d}, + src address = some source → + sourceCallableSignature source = some (worlds, result) → + ctx.decls address = some (.fn d) → + FnOwnershipPreservesAt ctx d worlds fuel + +/-- The declaration environment's contracts restricted to evaluator indices +strictly below `limit`. This is the mutual-call induction hypothesis used +while proving every function at the exact index `limit`. -/ +structure SourceDeclContractsBelow (src : IxIR0.Env) (ctx : Ctx) + (limit : Nat) extends SourceDeclLayout src ctx where + fn_preserves : ∀ {fuel}, fuel < limit → + SourceFnPreservesAt src ctx fuel + +/-- Public, unbounded ownership contracts for every source-backed target +function, together with exact declaration-layout correspondence. -/ +structure SourceDeclContracts (src : IxIR0.Env) (ctx : Ctx) + extends SourceDeclLayout src ctx where + fn_contract : ∀ {address source worlds result d}, + src address = some source → + sourceCallableSignature source = some (worlds, result) → + ctx.decls address = some (.fn d) → + FnOwnershipContract ctx d worlds + +/-- Restrict a completed declaration environment to a fuel prefix. -/ +theorem SourceDeclContracts.below {src : IxIR0.Env} {ctx : Ctx} + (hcontracts : SourceDeclContracts src ctx) (limit : Nat) : + SourceDeclContractsBelow src ctx limit := by + refine { toSourceDeclLayout := hcontracts.toSourceDeclLayout, fn_preserves := ?_ } + intro fuel _ address source worlds result d hsrc hsignature hdecl + exact (hcontracts.fn_contract hsrc hsignature hdecl).preserves + +/-- Fuel-prefix declaration environments are contravariant in the bound. -/ +theorem SourceDeclContractsBelow.mono {src : IxIR0.Env} {ctx : Ctx} + {smaller larger : Nat} + (hcontracts : SourceDeclContractsBelow src ctx larger) + (hbound : smaller ≤ larger) : + SourceDeclContractsBelow src ctx smaller := by + refine { toSourceDeclLayout := hcontracts.toSourceDeclLayout, fn_preserves := ?_ } + intro fuel hfuel + exact hcontracts.fn_preserves (Nat.lt_of_lt_of_le hfuel hbound) + +/-- Recover the unique target function and its bounded contract from a +callable source declaration. This is the lookup rule used by recursive +`ref` lowering at one mutual-induction step. -/ +theorem SourceDeclContractsBelow.fnContract {src : IxIR0.Env} {ctx : Ctx} + {limit : Nat} + (hcontracts : SourceDeclContractsBelow src ctx limit) + {address : Ixon.Address} {source : IxIR0.Decl} + {worlds : List Owned} {result : Owned} + (hsrc : src address = some source) + (hsignature : sourceCallableSignature source = + some (worlds, result)) : + ∃ d, ctx.decls address = some (.fn d) ∧ + d.arity = worlds.length ∧ d.result = result ∧ + FnOwnershipContractBelow ctx d worlds limit := by + obtain ⟨d, hdecl, harity, hresult⟩ := + hcontracts.fn hsrc hsignature + refine ⟨d, hdecl, harity, hresult, ⟨harity.symm, ?_⟩⟩ + intro fuel hfuel + exact hcontracts.fn_preserves hfuel hsrc hsignature hdecl + +/-- Bounded definition lookup in the source/target declaration environment. -/ +theorem SourceDeclContractsBelow.defn {src : IxIR0.Env} {ctx : Ctx} + {limit : Nat} + (hcontracts : SourceDeclContractsBelow src ctx limit) + {address : Ixon.Address} {result : Owned} {body : IxIR0.Expr} + (hsrc : src address = some (.defn result body)) : + ∃ d, ctx.decls address = some (.fn d) ∧ + d.arity = lamArity body ∧ d.result = result ∧ + FnOwnershipContractBelow ctx d + ((lamUses body).map worldOfUses) limit := by + obtain ⟨d, hdecl, harity, hresult, hcontract⟩ := + hcontracts.fnContract hsrc (by rfl) + exact ⟨d, hdecl, by simpa using harity, hresult, hcontract⟩ + +/-- Bounded recursor lookup in the source/target declaration environment. -/ +theorem SourceDeclContractsBelow.recursor {src : IxIR0.Env} {ctx : Ctx} + {limit : Nat} + (hcontracts : SourceDeclContractsBelow src ctx limit) + {address : Ixon.Address} {numArgs : Nat} {natLit : Bool} + {rules : Array IxIR0.RecRule} + (hsrc : src address = some (.recursor numArgs natLit rules)) : + ∃ d, ctx.decls address = some (.fn d) ∧ + d.arity = numArgs + 1 ∧ d.result = .shared ∧ + FnOwnershipContractBelow ctx d + (List.replicate (numArgs + 1) .shared) limit := by + obtain ⟨d, hdecl, harity, hresult, hcontract⟩ := + hcontracts.fnContract hsrc (by rfl) + exact ⟨d, hdecl, by simpa using harity, hresult, hcontract⟩ + +/-- Seal an exact-fuel mutual compiler proof into contracts for the whole +declaration environment. At each index the proof producer may call any +source-backed target function only through the strictly smaller environment; +strong induction closes self recursion and mutually recursive calls alike. -/ +theorem sourceDeclContracts_of_below_step {src : IxIR0.Env} {ctx : Ctx} + (hlayout : SourceDeclLayout src ctx) + (hstep : ∀ limit, + SourceDeclContractsBelow src ctx limit → + SourceFnPreservesAt src ctx limit) : + SourceDeclContracts src ctx := by + have hall : ∀ fuel, SourceFnPreservesAt src ctx fuel := by + intro fuel + induction fuel using Nat.strongRecOn with + | ind fuel ih => + apply hstep fuel + refine { toSourceDeclLayout := hlayout, fn_preserves := ?_ } + intro prior hprior + exact ih prior hprior + refine { toSourceDeclLayout := hlayout, fn_contract := ?_ } + intro address source worlds result d hsrc hsignature hdecl + obtain ⟨d', hdecl', harity, _⟩ := hlayout.fn hsrc hsignature + have hd : d' = d := by + have hsame : some (Decl.fn d') = some (Decl.fn d) := + hdecl'.symm.trans hdecl + exact Decl.fn.inj (Option.some.inj hsame) + subst d' + refine ⟨harity.symm, ?_⟩ + intro fuel + exact hall fuel hsrc hsignature hdecl + +/-- Definition lookup specialized from the generic declaration contract +environment. -/ +theorem SourceDeclContracts.defn {src : IxIR0.Env} {ctx : Ctx} + (hcontracts : SourceDeclContracts src ctx) + {address : Ixon.Address} {result : Owned} {body : IxIR0.Expr} + (hsrc : src address = some (.defn result body)) : + ∃ d, ctx.decls address = some (.fn d) ∧ + d.arity = lamArity body ∧ d.result = result ∧ + FnOwnershipContract ctx d ((lamUses body).map worldOfUses) := by + obtain ⟨d, hdecl, harity, hresult⟩ := + hcontracts.fn hsrc (by rfl) + refine ⟨d, hdecl, ?_, hresult, ?_⟩ + · simpa using harity + · exact hcontracts.fn_contract hsrc (by rfl) hdecl + +/-- Recursor lookup specialized from the generic declaration contract +environment. -/ +theorem SourceDeclContracts.recursor {src : IxIR0.Env} {ctx : Ctx} + (hcontracts : SourceDeclContracts src ctx) + {address : Ixon.Address} {numArgs : Nat} {natLit : Bool} + {rules : Array IxIR0.RecRule} + (hsrc : src address = some (.recursor numArgs natLit rules)) : + ∃ d, ctx.decls address = some (.fn d) ∧ + d.arity = numArgs + 1 ∧ d.result = .shared ∧ + FnOwnershipContract ctx d + (List.replicate (numArgs + 1) .shared) := by + obtain ⟨d, hdecl, harity, hresult⟩ := + hcontracts.fn hsrc (by rfl) + exact ⟨d, hdecl, by simpa using harity, hresult, + hcontracts.fn_contract hsrc (by rfl) hdecl⟩ + +/-- The two recursive semantic obligations of a closed lowering context: +source-backed direct calls and higher-order pap application. -/ +def CompilerPreservesAt (src : IxIR0.Env) (ctx : Ctx) + (fuel : Nat) : Prop := + SourceFnPreservesAt src ctx fuel ∧ ApplyOwnershipPreservesAt ctx fuel + +/-- Mutual compiler contracts available below one evaluator-fuel bound. -/ +structure CompilerContractsBelow (src : IxIR0.Env) (ctx : Ctx) + (limit : Nat) : Prop where + decls : SourceDeclContractsBelow src ctx limit + apply : ApplyOwnershipContractBelow ctx limit + +/-- Completed direct-call and higher-order-application contracts for a +closed lowering context. -/ +structure CompilerContracts (src : IxIR0.Env) (ctx : Ctx) : Prop where + decls : SourceDeclContracts src ctx + apply : ApplyOwnershipContract ctx + +/-- Restrict all completed compiler contracts to a fuel prefix. -/ +theorem CompilerContracts.below {src : IxIR0.Env} {ctx : Ctx} + (hcontracts : CompilerContracts src ctx) (limit : Nat) : + CompilerContractsBelow src ctx limit := + ⟨hcontracts.decls.below limit, hcontracts.apply.below limit⟩ + +/-- The combined bounded environment is contravariant in its bound. -/ +theorem CompilerContractsBelow.mono {src : IxIR0.Env} {ctx : Ctx} + {smaller larger : Nat} + (hcontracts : CompilerContractsBelow src ctx larger) + (hbound : smaller ≤ larger) : + CompilerContractsBelow src ctx smaller := + ⟨hcontracts.decls.mono hbound, hcontracts.apply.mono hbound⟩ + +/-- Seal the exact-fuel output of the mutual compiler proof into both public +context contracts at once. The producer at `limit` receives only contracts +below `limit`, so direct recursion, cross-declaration calls, and `applyGo` +cycles are all justified by the evaluator's strict fuel decrease. -/ +theorem compilerContracts_of_below_step {src : IxIR0.Env} {ctx : Ctx} + (hlayout : SourceDeclLayout src ctx) + (hstep : ∀ limit, + CompilerContractsBelow src ctx limit → + CompilerPreservesAt src ctx limit) : + CompilerContracts src ctx := by + have hall : ∀ fuel, CompilerPreservesAt src ctx fuel := by + intro fuel + induction fuel using Nat.strongRecOn with + | ind fuel ih => + apply hstep fuel + refine ⟨?_, ?_⟩ + · refine { toSourceDeclLayout := hlayout, fn_preserves := ?_ } + intro prior hprior + exact (ih prior hprior).1 + · refine ⟨?_⟩ + intro prior hprior + exact (ih prior hprior).2 + refine ⟨?_, ?_⟩ + · apply sourceDeclContracts_of_below_step hlayout + intro limit _ + exact (hall limit).1 + · apply applyOwnershipContract_of_below_step + intro limit _ + exact (hall limit).2 + +/-! ## Closing source-backed and generated declarations together -/ + +/-- Exact-index ownership preservation for every function accumulated in a +successful lowering state. Generated functions are all-shared at their public +capture-plus-parameter boundary. -/ +def ExtraFnPreservesAt (ctx : Ctx) (state : LowSt) (fuel : Nat) : Prop := + ∀ {address d}, (address, .fn d) ∈ state.extra → + d.result = .shared ∧ + FnOwnershipPreservesAt ctx d + (List.replicate d.arity .shared) fuel + +/-- The result-world half of the generated-function invariant is independent +of evaluator fuel. -/ +def ExtraFnResultsShared (state : LowSt) : Prop := + ∀ {address d}, (address, .fn d) ∈ state.extra → + d.result = .shared + +structure ExtraFnContractsBelow (ctx : Ctx) (state : LowSt) + (limit : Nat) : Prop where + fn_result : ExtraFnResultsShared state + fn_preserves : ∀ {fuel}, fuel < limit → + ExtraFnPreservesAt ctx state fuel + +structure ExtraFnContracts (ctx : Ctx) (state : LowSt) : Prop where + fn_contract : ∀ {address d}, (address, .fn d) ∈ state.extra → + d.result = .shared ∧ + FnOwnershipContract ctx d (List.replicate d.arity .shared) + +theorem ExtraFnContracts.below {ctx : Ctx} {state : LowSt} + (hcontracts : ExtraFnContracts ctx state) (limit : Nat) : + ExtraFnContractsBelow ctx state limit := by + refine ⟨fun hmember => (hcontracts.fn_contract hmember).1, ?_⟩ + intro fuel _ address d hmember + obtain ⟨hresult, hcontract⟩ := hcontracts.fn_contract hmember + exact ⟨hresult, hcontract.preserves⟩ + +theorem ExtraFnContractsBelow.mono {ctx : Ctx} {state : LowSt} + {smaller larger : Nat} + (hcontracts : ExtraFnContractsBelow ctx state larger) + (hbound : smaller ≤ larger) : + ExtraFnContractsBelow ctx state smaller := by + refine ⟨hcontracts.fn_result, ?_⟩ + intro fuel hfuel + exact hcontracts.fn_preserves (Nat.lt_of_lt_of_le hfuel hbound) + +/-- Every source-backed callable has the homogeneous shared signature needed +for it to be a legal target of an arbitrary pap. -/ +def SourceAllShared (src : IxIR0.Env) : Prop := + ∀ {address source worlds result}, + src address = some source → + sourceCallableSignature source = some (worlds, result) → + result = .shared ∧ + worlds = List.replicate worlds.length .shared + +/-- A source-backed callable needs the homogeneous shared signature only when +its lowered declaration permits dynamic PAP entry. Direct calls to declarations +with unique or affine boundaries remain legal because they bypass `applyGo`. +Keeping this premise owner-sensitive is what lets mixed-mode programs close the +same whole-context compiler contracts as all-shared programs. -/ +def SourcePapSafe (src : IxIR0.Env) (ctx : Ctx) : Prop := + ∀ {address source worlds result d}, + src address = some source → + sourceCallableSignature source = some (worlds, result) → + ctx.decls address = some (.fn d) → + d.papSafe = true → + result = .shared ∧ + worlds = List.replicate worlds.length .shared + +/-- The former global all-shared premise is a sufficient, but no longer +necessary, way to establish owner-sensitive PAP safety. -/ +theorem SourceAllShared.papSafe {src : IxIR0.Env} {ctx : Ctx} + (hshared : SourceAllShared src) : SourcePapSafe src ctx := by + intro address source worlds result d hsrc hsignature _ _ + exact hshared hsrc hsignature + +/-- `SourcePapSafe` is genuinely weaker than the former global all-shared +premise: a unique-boundary declaration remains available to direct calls when +its target declaration rejects shared-PAP entry. -/ +theorem sourcePapSafe_not_sourceAllShared : + ∃ src ctx, SourcePapSafe src ctx ∧ ¬ SourceAllShared src := by + let address : Ixon.Address := Ixon.Address.replicate 0xA5 + let source : IxIR0.Decl := + .defn .unique (.lam .affine (.var 0)) + let target : FnDef := + ⟨1, .unique, false, .ret (.var 0)⟩ + let src : IxIR0.Env := fun candidate => + if candidate = address then some source else none + let ctx : Ctx := + { decls := fun candidate => + if candidate = address then some (.fn target) else none } + refine ⟨src, ctx, ?_, ?_⟩ + · intro candidate found worlds result d hsrc hsignature hdecl hsafe + have hcandidate : candidate = address := by + by_cases heq : candidate = address + · exact heq + · simp [src, heq] at hsrc + subst candidate + have htarget : target = d := by + simpa [ctx] using hdecl + subst d + simp [target] at hsafe + · intro hshared + have h := hshared (address := address) (source := source) + (worlds := [.unique]) (result := .unique) + (by simp [src]) (by simp [source, sourceCallableSignature, lamUses, + worldOfUses]) + cases h.1 + +/-- Every target function is either the lowering of the same-address source +callable or an exact generated-state member. -/ +def FnDeclCovered (src : IxIR0.Env) (ctx : Ctx) (state : LowSt) : Prop := + ∀ {address d}, ctx.decls address = some (.fn d) → + (∃ source worlds result, + src address = some source ∧ + sourceCallableSignature source = some (worlds, result)) ∨ + (address, .fn d) ∈ state.extra + +/-- Source and generated contracts cover exactly the declarations admitted by +the evaluator's dynamic PAP-entry check. -/ +theorem papSafeDeclContractsBelow_of_source_extra + {src : IxIR0.Env} {ctx : Ctx} {state : LowSt} {limit : Nat} + (hsource : SourceDeclContractsBelow src ctx limit) + (hextra : ExtraFnContractsBelow ctx state limit) + (hpapsafe : SourcePapSafe src ctx) + (hcovered : FnDeclCovered src ctx state) : + PapSafeDeclContractsBelow ctx limit := by + refine ⟨?_⟩ + intro address d hdecl hsafe + cases hcovered hdecl with + | inl hsourceMember => + obtain ⟨source, worlds, result, hsrc, hsignature⟩ := hsourceMember + obtain ⟨target, htargetDecl, harity, hresult, hcontract⟩ := + hsource.fnContract hsrc hsignature + have htarget : target = d := by + have heq : some (Decl.fn target) = some (Decl.fn d) := + htargetDecl.symm.trans hdecl + exact Decl.fn.inj (Option.some.inj heq) + subst target + obtain ⟨hsourceResult, hworlds⟩ := + hpapsafe hsrc hsignature hdecl hsafe + have hresultShared : d.result = .shared := + hresult.trans hsourceResult + have hworlds' : worlds = List.replicate d.arity .shared := by + rw [hworlds, harity] + rw [hworlds'] at hcontract + exact ⟨hresultShared, hcontract⟩ + | inr hextraMember => + have hpreserves := fun {fuel} (hfuel : fuel < limit) => + hextra.fn_preserves hfuel hextraMember + refine ⟨hextra.fn_result hextraMember, ⟨by simp, ?_⟩⟩ + intro fuel hfuel + exact (hpreserves hfuel).2 + +/-- Jointly seal source declarations, generated declarations, and pap +application. At the current evaluator index the producer receives only the +three strictly smaller environments, so the cycle remains contractive. -/ +theorem compilerContracts_of_source_extra_below_step + {src : IxIR0.Env} {ctx : Ctx} {state : LowSt} + (hlayout : SourceDeclLayout src ctx) + (hpapsafe : SourcePapSafe src ctx) + (hextraResults : ExtraFnResultsShared state) + (hcovered : FnDeclCovered src ctx state) + (hstep : ∀ limit, + SourceDeclContractsBelow src ctx limit → + ExtraFnContractsBelow ctx state limit → + ApplyOwnershipContractBelow ctx limit → + SourceFnPreservesAt src ctx limit ∧ + ExtraFnPreservesAt ctx state limit) : + CompilerContracts src ctx ∧ ExtraFnContracts ctx state := by + have hall : ∀ fuel, + SourceFnPreservesAt src ctx fuel ∧ + ExtraFnPreservesAt ctx state fuel ∧ + ApplyOwnershipPreservesAt ctx fuel := by + intro fuel + induction fuel using Nat.strongRecOn with + | ind fuel ih => + let hsourceBelow : SourceDeclContractsBelow src ctx fuel := + { toSourceDeclLayout := hlayout + fn_preserves := fun hprior => (ih _ hprior).1 } + let hextraBelow : ExtraFnContractsBelow ctx state fuel := + ⟨hextraResults, fun hprior => (ih _ hprior).2.1⟩ + let happlyBelow : ApplyOwnershipContractBelow ctx fuel := + ⟨fun hprior => (ih _ hprior).2.2⟩ + have hfunctions := hstep fuel hsourceBelow hextraBelow happlyBelow + have hdecls := papSafeDeclContractsBelow_of_source_extra + hsourceBelow hextraBelow hpapsafe hcovered + exact ⟨hfunctions.1, hfunctions.2, + applyOwnershipPreservesAt_of_papSafeDeclsBelow hdecls happlyBelow⟩ + have hsourceContracts : SourceDeclContracts src ctx := + sourceDeclContracts_of_below_step hlayout fun limit _ => (hall limit).1 + have hextraContracts : ExtraFnContracts ctx state := by + refine ⟨?_⟩ + intro address d hmember + have hresult := (hall 0).2.1 hmember |>.1 + refine ⟨hresult, ⟨by simp, ?_⟩⟩ + intro fuel + exact (hall fuel).2.1 hmember |>.2 + have happlyContract : ApplyOwnershipContract ctx := + applyOwnershipContract_of_below_step fun limit _ => (hall limit).2.2 + exact ⟨⟨hsourceContracts, happlyContract⟩, hextraContracts⟩ + +/-! ## Whole-pass target statements + +These definitions make the four independently checkable M2b claims concrete. +They are deliberately separate: semantic value correspondence does not hide +memory progress, reclamation, or counter obligations. -/ + +/-! ## Semantic call and application contracts -/ + +/-- Left-to-right source evaluation of an argument vector. Each argument may +use its own sufficient fuel: source fuel is a totality witness rather than a +cost, and the compiler proof only needs the resulting values in source order. +Keeping this relation on expression lists (rather than world-annotated +compiler arguments) makes it reusable by both `lowerSpine` and `applyRest`. -/ +inductive SourceArgsEval (sourceCtx : IxIR0.Ctx) + (sourceEnv : List IxIR0.Value) : + List IxIR0.Expr → List IxIR0.Value → Prop where + | nil : SourceArgsEval sourceCtx sourceEnv [] [] + | cons {expr : IxIR0.Expr} {value : IxIR0.Value} + {expressions : List IxIR0.Expr} {values : List IxIR0.Value} + {fuel : Nat} : + IxIR0.eval sourceCtx fuel sourceEnv expr = .ok value → + SourceArgsEval sourceCtx sourceEnv expressions values → + SourceArgsEval sourceCtx sourceEnv + (expr :: expressions) (value :: values) + +/-- Dependent lockstep traversal of source argument expressions and their +evaluated values. Each callback receives the exact head evaluation and the +original tail witness together with the recursively produced result. -/ +theorem SourceArgsEval.traverse {sourceCtx : IxIR0.Ctx} + {sourceEnv : List IxIR0.Value} + {Result : List IxIR0.Expr → List IxIR0.Value → Prop} + (hnil : Result [] []) + (hcons : ∀ {expr : IxIR0.Expr} {value : IxIR0.Value} + {expressions : List IxIR0.Expr} {values : List IxIR0.Value} + {fuel : Nat}, + IxIR0.eval sourceCtx fuel sourceEnv expr = .ok value → + SourceArgsEval sourceCtx sourceEnv expressions values → + Result expressions values → + Result (expr :: expressions) (value :: values)) + {expressions : List IxIR0.Expr} {values : List IxIR0.Value} + (hargs : SourceArgsEval sourceCtx sourceEnv expressions values) : + Result expressions values := by + induction hargs with + | nil => exact hnil + | cons heval htail ih => exact hcons heval htail ih + +@[simp] theorem SourceArgsEval.lengths {sourceCtx : IxIR0.Ctx} + {sourceEnv : List IxIR0.Value} {expressions : List IxIR0.Expr} + {values : List IxIR0.Value} + (hargs : SourceArgsEval sourceCtx sourceEnv expressions values) : + expressions.length = values.length := by + exact SourceArgsEval.traverse + (Result := fun currentExpressions currentValues => + currentExpressions.length = currentValues.length) + (hnil := rfl) + (hcons := by + intro expr value currentExpressions currentValues fuel heval htail ih + simp [ih]) + hargs + +/-- Source argument evaluation restricts to the same prefix on both sides. -/ +theorem SourceArgsEval.take {sourceCtx : IxIR0.Ctx} + {sourceEnv : List IxIR0.Value} {expressions : List IxIR0.Expr} + {values : List IxIR0.Value} + (hargs : SourceArgsEval sourceCtx sourceEnv expressions values) + (count : Nat) : + SourceArgsEval sourceCtx sourceEnv + (expressions.take count) (values.take count) := by + exact (SourceArgsEval.traverse + (Result := fun currentExpressions currentValues => + ∀ currentCount, + SourceArgsEval sourceCtx sourceEnv + (currentExpressions.take currentCount) + (currentValues.take currentCount)) + (hnil := by + intro currentCount + simp + exact .nil) + (hcons := by + intro expr value currentExpressions currentValues fuel heval htail ih + currentCount + cases currentCount with + | zero => exact .nil + | succ currentCount => + simpa using SourceArgsEval.cons heval (ih currentCount)) + hargs) count + +/-- Source argument evaluation restricts to the corresponding suffix. -/ +theorem SourceArgsEval.drop {sourceCtx : IxIR0.Ctx} + {sourceEnv : List IxIR0.Value} {expressions : List IxIR0.Expr} + {values : List IxIR0.Value} + (hargs : SourceArgsEval sourceCtx sourceEnv expressions values) + (count : Nat) : + SourceArgsEval sourceCtx sourceEnv + (expressions.drop count) (values.drop count) := by + exact (SourceArgsEval.traverse + (Result := fun currentExpressions currentValues => + ∀ currentCount, + SourceArgsEval sourceCtx sourceEnv + (currentExpressions.drop currentCount) + (currentValues.drop currentCount)) + (hnil := by + intro currentCount + simp + exact .nil) + (hcons := by + intro expr value currentExpressions currentValues fuel heval htail ih + currentCount + cases currentCount with + | zero => exact .cons heval htail + | succ currentCount => simpa using ih currentCount) + hargs) count + +/-- Source-side n-ary application, fuel-free at the interface: each step is +one `IxIR0.apply` at some fuel of its own. Currying makes this the exact +source counterpart of the target's `applyGo` argument list. -/ +inductive SourceApplies (sourceCtx : IxIR0.Ctx) : + IxIR0.Value → List IxIR0.Value → IxIR0.Value → Prop where + | nil {value : IxIR0.Value} : SourceApplies sourceCtx value [] value + | cons {function argument middle result : IxIR0.Value} + {arguments : List IxIR0.Value} {fuel : Nat} : + IxIR0.apply sourceCtx fuel function argument = .ok middle → + SourceApplies sourceCtx middle arguments result → + SourceApplies sourceCtx function (argument :: arguments) result + +/-- Dependent traversal of a source application spine. Clients receive the +exact head application, the original tail derivation, and the recursively +produced result while the initial value, remaining arguments, and final value +stay synchronized. -/ +theorem SourceApplies.traverse {sourceCtx : IxIR0.Ctx} + {Result : IxIR0.Value → List IxIR0.Value → IxIR0.Value → Prop} + (hnil : ∀ value, Result value [] value) + (hcons : ∀ {function argument middle result : IxIR0.Value} + {arguments : List IxIR0.Value} {fuel : Nat}, + IxIR0.apply sourceCtx fuel function argument = .ok middle → + SourceApplies sourceCtx middle arguments result → + Result middle arguments result → + Result function (argument :: arguments) result) + {function result : IxIR0.Value} {arguments : List IxIR0.Value} + (hargs : SourceApplies sourceCtx function arguments result) : + Result function arguments result := by + induction hargs with + | nil => exact hnil _ + | cons hstep htail ih => exact hcons hstep htail ih + +/-- Applying a prefix and then the rest is applying the concatenation. -/ +theorem SourceApplies.append {sourceCtx : IxIR0.Ctx} + {function middle result : IxIR0.Value} + {left right : List IxIR0.Value} + (hleft : SourceApplies sourceCtx function left middle) + (hright : SourceApplies sourceCtx middle right result) : + SourceApplies sourceCtx function (left ++ right) result := by + exact (SourceApplies.traverse + (Result := fun currentFunction currentArguments currentResult => + ∀ {remaining final}, + SourceApplies sourceCtx currentResult remaining final → + SourceApplies sourceCtx currentFunction + (currentArguments ++ remaining) final) + (hnil := by + intro value remaining final hremaining + simpa using hremaining) + (hcons := by + intro currentFunction argument currentMiddle currentResult + currentArguments fuel hstep htail ih remaining final hremaining + exact .cons hstep (ih hremaining)) + hleft) hright + +/-- One more argument after a completed spine. -/ +theorem SourceApplies.snoc {sourceCtx : IxIR0.Ctx} + {function middle result argument : IxIR0.Value} + {arguments : List IxIR0.Value} {fuel : Nat} + (hspine : SourceApplies sourceCtx function arguments middle) + (hstep : IxIR0.apply sourceCtx fuel middle argument = .ok result) : + SourceApplies sourceCtx function (arguments ++ [argument]) result := + hspine.append (.cons hstep .nil) + +/-- Split one source application derivation at the same numeric boundary +used by `knownCall`'s `take`/`drop` executable branches. -/ +theorem SourceApplies.splitAt {sourceCtx : IxIR0.Ctx} + {function result : IxIR0.Value} {arguments : List IxIR0.Value} + (hargs : SourceApplies sourceCtx function arguments result) + (count : Nat) : + ∃ middle, + SourceApplies sourceCtx function (arguments.take count) middle ∧ + SourceApplies sourceCtx middle (arguments.drop count) result := by + exact (SourceApplies.traverse + (Result := fun currentFunction currentArguments currentResult => + ∀ currentCount, + ∃ middle, + SourceApplies sourceCtx currentFunction + (currentArguments.take currentCount) middle ∧ + SourceApplies sourceCtx middle + (currentArguments.drop currentCount) currentResult) + (hnil := by + intro value currentCount + simp + exact ⟨value, .nil, .nil⟩) + (hcons := by + intro currentFunction argument currentMiddle currentResult + currentArguments fuel hstep htail ih currentCount + cases currentCount with + | zero => exact ⟨currentFunction, .nil, .cons hstep htail⟩ + | succ currentCount => + obtain ⟨middle, hprefix, hsuffix⟩ := ih currentCount + exact ⟨middle, .cons hstep hprefix, hsuffix⟩) + hargs) count + +/-- Splitting a spine at any point exposes the intermediate source value. -/ +theorem SourceApplies.split {sourceCtx : IxIR0.Ctx} + {function result : IxIR0.Value} : + ∀ {left right : List IxIR0.Value}, + SourceApplies sourceCtx function (left ++ right) result → + ∃ middle, SourceApplies sourceCtx function left middle ∧ + SourceApplies sourceCtx middle right result := by + intro left right hargs + simpa using SourceApplies.splitAt hargs left.length + +/-- Invert one successful source application evaluation into the three +predecessor-fuel computations used by IxIR₀'s evaluator. -/ +theorem sourceEval_app_inv {sourceCtx : IxIR0.Ctx} {sourceFuel : Nat} + {sourceEnv : List IxIR0.Value} {function argument : IxIR0.Expr} + {result : IxIR0.Value} + (heval : IxIR0.eval sourceCtx sourceFuel sourceEnv + (.app function argument) = .ok result) : + ∃ fuel sourceFunction sourceArgument, + IxIR0.eval sourceCtx fuel sourceEnv function = .ok sourceFunction ∧ + IxIR0.eval sourceCtx fuel sourceEnv argument = .ok sourceArgument ∧ + IxIR0.apply sourceCtx fuel sourceFunction sourceArgument = + .ok result := by + cases sourceFuel with + | zero => simp [IxIR0.eval] at heval + | succ fuel => + rw [IxIR0.eval.eq_def] at heval + dsimp only at heval + cases hfunction : IxIR0.eval sourceCtx fuel sourceEnv function with + | error error => + rw [hfunction] at heval + contradiction + | ok sourceFunction => + rw [hfunction, bindOk] at heval + cases hargument : IxIR0.eval sourceCtx fuel sourceEnv argument with + | error error => + rw [hargument] at heval + contradiction + | ok sourceArgument => + rw [hargument, bindOk] at heval + exact ⟨fuel, sourceFunction, sourceArgument, hfunction, + hargument, heval⟩ + +/-- Invert successful source-variable evaluation to the corresponding +source-environment lookup. -/ +theorem sourceEval_var_inv {sourceCtx : IxIR0.Ctx} {sourceFuel : Nat} + {sourceEnv : List IxIR0.Value} {index : Nat} + {result : IxIR0.Value} + (heval : IxIR0.eval sourceCtx sourceFuel sourceEnv (.var index) = + .ok result) : + sourceEnv[index]? = some result := by + cases sourceFuel with + | zero => simp [IxIR0.eval] at heval + | succ fuel => + cases hlookup : sourceEnv[index]? with + | none => simp [IxIR0.eval, hlookup] at heval + | some value => + have hvalue : value = result := by + simpa [IxIR0.eval, hlookup] using heval + subst value + rfl + +/-- Successful scalar-source evaluation pins the literal constructor. -/ +theorem sourceEval_lit_inv {sourceCtx : IxIR0.Ctx} {sourceFuel : Nat} + {sourceEnv : List IxIR0.Value} {literal : IxIR0.Literal} + {result : IxIR0.Value} + (heval : IxIR0.eval sourceCtx sourceFuel sourceEnv (.lit literal) = + .ok result) : + result = .lit literal := by + cases sourceFuel with + | zero => simp [IxIR0.eval] at heval + | succ fuel => simpa [IxIR0.eval] using heval.symm + +/-- Successful erased-source evaluation pins the erased value. -/ +theorem sourceEval_erased_inv {sourceCtx : IxIR0.Ctx} {sourceFuel : Nat} + {sourceEnv : List IxIR0.Value} {result : IxIR0.Value} + (heval : IxIR0.eval sourceCtx sourceFuel sourceEnv .erased = + .ok result) : + result = .erased := by + cases sourceFuel with + | zero => simp [IxIR0.eval] at heval + | succ fuel => simpa [IxIR0.eval] using heval.symm + +/-- A source lambda evaluates immediately to the closure over its current +environment. -/ +theorem sourceEval_lam_inv {sourceCtx : IxIR0.Ctx} {sourceFuel : Nat} + {sourceEnv : List IxIR0.Value} {uses : Uses} {body : IxIR0.Expr} + {result : IxIR0.Value} + (heval : IxIR0.eval sourceCtx sourceFuel sourceEnv (.lam uses body) = + .ok result) : + result = .clos uses sourceEnv body := by + cases sourceFuel with + | zero => simp [IxIR0.eval] at heval + | succ fuel => simpa [IxIR0.eval] using heval.symm + +/-- Invert one successful source let into the bound-value and body +evaluations at the common predecessor fuel used by `IxIR0.eval`. -/ +theorem sourceEval_let_inv {sourceCtx : IxIR0.Ctx} {sourceFuel : Nat} + {sourceEnv : List IxIR0.Value} {uses : Uses} + {value body : IxIR0.Expr} {result : IxIR0.Value} + (heval : IxIR0.eval sourceCtx sourceFuel sourceEnv + (.letE uses value body) = .ok result) : + ∃ fuel bound, + IxIR0.eval sourceCtx fuel sourceEnv value = .ok bound ∧ + IxIR0.eval sourceCtx fuel (bound :: sourceEnv) body = .ok result := by + cases sourceFuel with + | zero => simp [IxIR0.eval] at heval + | succ fuel => + rw [IxIR0.eval.eq_def] at heval + dsimp only at heval + cases hvalue : IxIR0.eval sourceCtx fuel sourceEnv value with + | error error => + rw [hvalue] at heval + contradiction + | ok bound => + rw [hvalue, bindOk] at heval + exact ⟨fuel, bound, hvalue, heval⟩ + +/-- Invert one successful source projection into evaluation of its target +and the evaluator's constructor/erased projection relation. -/ +theorem sourceEval_proj_inv {sourceCtx : IxIR0.Ctx} {sourceFuel : Nat} + {sourceEnv : List IxIR0.Value} {index : Nat} + {source : IxIR0.Expr} {result : IxIR0.Value} + (heval : IxIR0.eval sourceCtx sourceFuel sourceEnv + (.proj index source) = .ok result) : + ∃ fuel target, + IxIR0.eval sourceCtx fuel sourceEnv source = .ok target ∧ + SourceProject index target result := by + cases sourceFuel with + | zero => simp [IxIR0.eval] at heval + | succ fuel => + have hwhole := heval + rw [IxIR0.eval.eq_def] at heval + dsimp only at heval + cases htarget : IxIR0.eval sourceCtx fuel sourceEnv source with + | error error => + rw [htarget] at heval + contradiction + | ok target => + exact ⟨fuel, target, htarget, + SourceProject.of_eval htarget hwhole⟩ + +/-- Global-reference evaluation is independent of the surrounding source +environment; definitions deliberately evaluate their bodies in `[]`. -/ +theorem sourceEval_ref_closed {sourceCtx : IxIR0.Ctx} {sourceFuel : Nat} + {sourceEnv : List IxIR0.Value} {address : Ixon.Address} + {value : IxIR0.Value} + (heval : IxIR0.eval sourceCtx sourceFuel sourceEnv (.ref address) = + .ok value) : + IxIR0.eval sourceCtx sourceFuel [] (.ref address) = .ok value := by + cases sourceFuel with + | zero => simp [IxIR0.eval] at heval + | succ fuel => + rw [IxIR0.eval.eq_def] at heval ⊢ + exact heval + +/-- Source semantics of a flattened application spine: evaluate the head, +evaluate all arguments left-to-right in the unchanged pure environment, and +apply the resulting source values in order. An inductive proposition (rather +than a `structure`) keeps the existential source values proof-irrelevant. -/ +inductive SourceSpineEval (sourceCtx : IxIR0.Ctx) + (sourceEnv : List IxIR0.Value) (head : IxIR0.Expr) + (arguments : List IxIR0.Expr) (result : IxIR0.Value) : Prop where + | intro {headValue : IxIR0.Value} + {argumentValues : List IxIR0.Value} : + (∃ fuel, IxIR0.eval sourceCtx fuel sourceEnv head = .ok headValue) → + SourceArgsEval sourceCtx sourceEnv arguments argumentValues → + SourceApplies sourceCtx headValue argumentValues result → + SourceSpineEval sourceCtx sourceEnv head arguments result + +/-- Dependent eliminator for source-spine semantics. Keeping the sole direct +destruction beside the judgment gives downstream proofs the exact hidden head +and argument values without duplicating constructor-sensitive case splits. -/ +theorem SourceSpineEval.eliminate + {sourceCtx : IxIR0.Ctx} {sourceEnv : List IxIR0.Value} + {head : IxIR0.Expr} {arguments : List IxIR0.Expr} + {result : IxIR0.Value} {Result : Prop} + (hspine : SourceSpineEval sourceCtx sourceEnv head arguments result) + (hintro : ∀ {headValue : IxIR0.Value} + {argumentValues : List IxIR0.Value}, + (∃ fuel, IxIR0.eval sourceCtx fuel sourceEnv head = .ok headValue) → + SourceArgsEval sourceCtx sourceEnv arguments argumentValues → + SourceApplies sourceCtx headValue argumentValues result → + Result) : + Result := by + cases hspine with + | intro hhead harguments happlies => + exact hintro hhead harguments happlies + +/-- A successful head evaluation is the empty-argument source spine. -/ +theorem SourceSpineEval.of_eval_nil {sourceCtx : IxIR0.Ctx} + {sourceFuel : Nat} {sourceEnv : List IxIR0.Value} + {head : IxIR0.Expr} {result : IxIR0.Value} + (heval : IxIR0.eval sourceCtx sourceFuel sourceEnv head = .ok result) : + SourceSpineEval sourceCtx sourceEnv head [] result := + .intro ⟨sourceFuel, heval⟩ .nil .nil + +/-- One successful source `.app` evaluation is the singleton flattened +spine used by `lowerE`'s application branch. -/ +theorem SourceSpineEval.of_eval_app {sourceCtx : IxIR0.Ctx} + {sourceFuel : Nat} {sourceEnv : List IxIR0.Value} + {function argument : IxIR0.Expr} {result : IxIR0.Value} + (heval : IxIR0.eval sourceCtx sourceFuel sourceEnv + (.app function argument) = .ok result) : + SourceSpineEval sourceCtx sourceEnv function [argument] result := by + obtain ⟨fuel, sourceFunction, sourceArgument, hfunction, hargument, + happly⟩ := sourceEval_app_inv heval + exact .intro ⟨fuel, hfunction⟩ (.cons hargument .nil) + (.cons happly .nil) + +/-- Flattening one more syntactic application preserves the source spine +judgment and prepends exactly its argument/value pair. -/ +theorem SourceSpineEval.flattenApp {sourceCtx : IxIR0.Ctx} + {sourceEnv : List IxIR0.Value} {function argument : IxIR0.Expr} + {arguments : List IxIR0.Expr} {result : IxIR0.Value} + (hspine : SourceSpineEval sourceCtx sourceEnv + (.app function argument) arguments result) : + SourceSpineEval sourceCtx sourceEnv function + (argument :: arguments) result := by + apply hspine.eliminate + · intro headValue argumentValues hhead harguments happlies + obtain ⟨_, hhead⟩ := hhead + obtain ⟨fuel, sourceFunction, sourceArgument, hfunction, hargument, + happly⟩ := sourceEval_app_inv hhead + exact .intro ⟨fuel, hfunction⟩ (.cons hargument harguments) + (.cons happly happlies) + +/-- Expose the source reference identity, argument values, and application +derivation carried by a reference-headed source spine. -/ +theorem SourceSpineEval.refData {sourceCtx : IxIR0.Ctx} + {sourceEnv : List IxIR0.Value} {address : Ixon.Address} + {arguments : List IxIR0.Expr} {result : IxIR0.Value} + (hspine : SourceSpineEval sourceCtx sourceEnv (.ref address) + arguments result) : + ∃ sourceFunction sourceArguments, + (∃ fuel, IxIR0.eval sourceCtx fuel [] (.ref address) = + .ok sourceFunction) ∧ + SourceArgsEval sourceCtx sourceEnv arguments sourceArguments ∧ + SourceApplies sourceCtx sourceFunction sourceArguments result := by + apply hspine.eliminate + · intro headValue argumentValues hhead harguments happlies + obtain ⟨fuel, hhead⟩ := hhead + exact ⟨headValue, argumentValues, + ⟨fuel, sourceEval_ref_closed hhead⟩, harguments, happlies⟩ + +/-- The source value a global reference denotes, at some source fuel. This +is the callee's source identity: a `.defn` denotes its closure, while +constructors, recursors, and externs denote their zero-argument paps. -/ +def SourceRefValue (sourceCtx : IxIR0.Ctx) (address : Ixon.Address) + (value : IxIR0.Value) : Prop := + ∃ fuel, IxIR0.eval sourceCtx fuel [] (.ref address) = .ok value + +/-- A source reference to a recursor denotes its canonical empty pap. -/ +theorem SourceRefValue.recursorValue {sourceCtx : IxIR0.Ctx} + {address : Ixon.Address} {numArgs : Nat} {natLit : Bool} + {rules : Array IxIR0.RecRule} {sourceFunction : IxIR0.Value} + (hlookup : sourceCtx.env address = + some (.recursor numArgs natLit rules)) + (href : SourceRefValue sourceCtx address sourceFunction) : + sourceFunction = .pap (.rec_ address (numArgs + 1)) [] := by + obtain ⟨fuel, href⟩ := href + cases fuel with + | zero => simp [IxIR0.eval] at href + | succ fuel => simpa [IxIR0.eval, hlookup] using href.symm + +/-- Total source arity used by partial-application nodes. Unlike +`sourceCallableSignature`, this includes constructors and externs, which do +not become target function declarations but can still be stored as paps. -/ +def sourceDeclArity : IxIR0.Decl → Nat + | .defn _ body => lamArity body + | .ctor _ arity => arity + | .recursor numArgs _ _ => numArgs + 1 + | .extern arity => arity + +/-- Source declarations that may back a same-address target pap. Ordinary +definitions must pass the executable all-shared safety check; recursors and +externs have homogeneous shared signatures by construction. Constructors +are deliberately excluded because partial constructor applications use a +generated eta-wrapper instead. -/ +def SourcePapEligible : IxIR0.Decl → Prop + | .defn result body => result = .shared ∧ papSafe body = true + | .ctor _ _ => False + | .recursor _ _ _ => True + | .extern _ => True + +/-- Canonical function correspondence for the whole lowering pass. + +There are three origins for a target pap node: a source declaration at the +same address, a generated eta wrapper for a partially applied constructor, +or a lifted local lambda. In every static case the related source value is +the residual result of applying exactly the values stored in the pap. -/ +inductive CompilerFunctionRel (sourceCtx : IxIR0.Ctx) (src : IxIR0.Env) + (state : LowSt) : Sim.FunctionRel where + | source {value sourceFunction : IxIR0.Value} + {address : Ixon.Address} {arity : Nat} + {captures : List IxIR0.Value} {source : IxIR0.Decl} : + src address = some source → + SourcePapEligible source → + sourceDeclArity source = arity → + SourceRefValue sourceCtx address sourceFunction → + SourceApplies sourceCtx sourceFunction captures value → + captures.length < arity → + CompilerFunctionRel sourceCtx src state value address arity captures + | wrapper {value sourceFunction : IxIR0.Value} + {captures : List IxIR0.Value} {memo : WrapperMemo} : + memo ∈ state.wrappers → + src memo.source = some (.ctor memo.tag memo.arity) → + SourceRefValue sourceCtx memo.source sourceFunction → + SourceApplies sourceCtx sourceFunction captures value → + captures.length < memo.arity → + CompilerFunctionRel sourceCtx src state value memo.wrapper + memo.arity captures + | lifted {value : IxIR0.Value} {address : Ixon.Address} {arity : Nat} + {captures : List IxIR0.Value} : + CompilerLiftedFunctionRel src state value address arity captures → + CompilerFunctionRel sourceCtx src state value address arity captures + +/-- Every branch of the canonical function relation survives later compiler +state extension. Static-source evidence is state independent; wrapper memos +and lifted declaration provenance are monotone suffix invariants. -/ +theorem CompilerFunctionRel.monoState + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {initial final : LowSt} (hextends : ExtraExtends initial final) + {value : IxIR0.Value} {address : Ixon.Address} {arity : Nat} + {captures : List IxIR0.Value} + (hrel : CompilerFunctionRel sourceCtx src initial value address arity + captures) : + CompilerFunctionRel sourceCtx src final value address arity captures := by + cases hrel with + | source hsrc heligible harity href happly hunder => + exact .source hsrc heligible harity href happly hunder + | wrapper hmember hsrc href happly hunder => + exact .wrapper (hextends.wrapper_mem hmember) hsrc href happly hunder + | lifted hlifted => + exact .lifted (hlifted.monoState hextends) + +/-- Every function represented by the compiler relation is a genuine +under-saturated pap. -/ +theorem CompilerFunctionRel.underfilled + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {state : LowSt} + {value : IxIR0.Value} {address : Ixon.Address} {arity : Nat} + {captures : List IxIR0.Value} + (hrel : CompilerFunctionRel sourceCtx src state value address arity + captures) : + captures.length < arity := by + cases hrel with + | source _ _ _ _ _ hunder => exact hunder + | wrapper _ _ _ _ hunder => exact hunder + | lifted hlifted => exact hlifted.underfilled + +/-- Successful source evaluation is deterministic even when the two proofs +use different fuel witnesses. -/ +theorem sourceEval_ok_unique {sourceCtx : IxIR0.Ctx} + {leftFuel rightFuel : Nat} {sourceEnv : List IxIR0.Value} + {expr : IxIR0.Expr} {left right : IxIR0.Value} + (hleft : IxIR0.eval sourceCtx leftFuel sourceEnv expr = .ok left) + (hright : IxIR0.eval sourceCtx rightFuel sourceEnv expr = .ok right) : + left = right := by + have hleft' := IxIR0.eval_mono + (Nat.le_max_left leftFuel rightFuel) hleft + have hright' := IxIR0.eval_mono + (Nat.le_max_right leftFuel rightFuel) hright + rw [hleft'] at hright' + exact Except.ok.inj hright' + +/-- Source application is likewise deterministic across independent fuel +witnesses. -/ +theorem sourceApply_ok_unique {sourceCtx : IxIR0.Ctx} + {leftFuel rightFuel : Nat} {function argument : IxIR0.Value} + {left right : IxIR0.Value} + (hleft : IxIR0.apply sourceCtx leftFuel function argument = .ok left) + (hright : IxIR0.apply sourceCtx rightFuel function argument = .ok right) : + left = right := by + have hleft' := IxIR0.apply_mono + (Nat.le_max_left leftFuel rightFuel) hleft + have hright' := IxIR0.apply_mono + (Nat.le_max_right leftFuel rightFuel) hright + rw [hleft'] at hright' + exact Except.ok.inj hright' + +/-- An n-ary source application has a unique result, although each step in +`SourceApplies` deliberately carries an independent fuel witness. -/ +theorem SourceApplies.deterministic {sourceCtx : IxIR0.Ctx} + {function : IxIR0.Value} {arguments : List IxIR0.Value} + {left right : IxIR0.Value} + (hleft : SourceApplies sourceCtx function arguments left) + (hright : SourceApplies sourceCtx function arguments right) : + left = right := by + exact (SourceApplies.traverse + (Result := fun currentFunction currentArguments currentLeft => + ∀ {currentRight}, + SourceApplies sourceCtx currentFunction currentArguments + currentRight → + currentLeft = currentRight) + (hnil := by + intro value currentRight hcurrentRight + cases hcurrentRight + rfl) + (hcons := by + intro currentFunction argument middle currentLeft currentArguments + leftFuel hleftStep hleftTail ih currentRight hcurrentRight + cases hcurrentRight with + | @cons _ _ rightMiddle right _ rightFuel hrightStep hrightTail => + have hmiddle : middle = rightMiddle := + sourceApply_ok_unique hleftStep hrightStep + subst rightMiddle + exact ih hrightTail) + hleft) hright + +/-- Extend a residual lambda prefix by one source application while it +remains strictly under-saturated. -/ +theorem LambdaPrefix.snoc_of_apply + {sourceCtx : IxIR0.Ctx} {sourceEnv : List IxIR0.Value} + {expr : IxIR0.Expr} {supplied : List IxIR0.Value} + {function argument result : IxIR0.Value} + (hprefix : LambdaPrefix sourceEnv expr supplied function) + (hunder : (supplied ++ [argument]).length < lamArity expr) + (happly : ∃ fuel, + IxIR0.apply sourceCtx fuel function argument = .ok result) : + LambdaPrefix sourceEnv expr (supplied ++ [argument]) result := by + exact (LambdaPrefix.traverse + (Result := fun currentEnv currentExpr currentSupplied currentFunction => + (currentSupplied ++ [argument]).length < lamArity currentExpr → + (∃ fuel, + IxIR0.apply sourceCtx fuel currentFunction argument = .ok result) → + LambdaPrefix currentEnv currentExpr + (currentSupplied ++ [argument]) result) + (hnil := by + intro currentEnv uses body hunder happly + obtain ⟨applyFuel, happly⟩ := happly + cases body with + | lam nextUses nextBody => + have hcanonical : IxIR0.apply sourceCtx 2 + (.clos uses currentEnv (.lam nextUses nextBody)) argument = + .ok (.clos nextUses (argument :: currentEnv) nextBody) := by + simp [IxIR0.apply, IxIR0.eval] + have hresult : result = + .clos nextUses (argument :: currentEnv) nextBody := + sourceApply_ok_unique happly hcanonical + subst result + simpa using + (LambdaPrefix.cons (LambdaPrefix.nil + (sourceEnv := argument :: currentEnv) + (uses := nextUses) (body := nextBody))) + | var => simp [lamArity] at hunder + | ref => simp [lamArity] at hunder + | app => simp [lamArity] at hunder + | letE => simp [lamArity] at hunder + | proj => simp [lamArity] at hunder + | lit => simp [lamArity] at hunder + | erased => simp [lamArity] at hunder) + (hcons := by + intro currentEnv uses body first currentArguments currentFunction + hinner ih hunder happly + have hinnerUnder : (currentArguments ++ [argument]).length < + lamArity body := by + simpa [lamArity] using hunder + have hextended := ih hinnerUnder happly + simpa using (LambdaPrefix.cons hextended)) + (h := hprefix)) hunder happly + +/-- Extend a residual lambda prefix by an arbitrary still-underfilled +source application spine. -/ +theorem LambdaPrefix.append_of_applies + {sourceCtx : IxIR0.Ctx} {sourceEnv : List IxIR0.Value} + {expr : IxIR0.Expr} {supplied additional : List IxIR0.Value} + {function result : IxIR0.Value} + (hprefix : LambdaPrefix sourceEnv expr supplied function) + (happlies : SourceApplies sourceCtx function additional result) + (hunder : (supplied ++ additional).length < lamArity expr) : + LambdaPrefix sourceEnv expr (supplied ++ additional) result := by + induction additional generalizing supplied function result with + | nil => + cases happlies + simpa using hprefix + | cons argument additional ih => + cases happlies with + | @cons _ _ middle result _ applyFuel hstep htail => + have honeUnder : (supplied ++ [argument]).length < lamArity expr := by + simp only [List.length_append, List.length_cons, + List.length_nil] at hunder ⊢ + omega + have hone := hprefix.snoc_of_apply honeUnder ⟨applyFuel, hstep⟩ + have htailUnder : ((supplied ++ [argument]) ++ additional).length < + lamArity expr := by + simpa [List.append_assoc] using hunder + have hall := ih hone htail htailUnder + simpa [List.append_assoc] using hall + +/-- Under-filling a compiler-related pap preserves its origin and extends +the stored source prefix by exactly the newly applied values. -/ +theorem CompilerFunctionRel.underfilledApply + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {state : LowSt} + {function result : IxIR0.Value} {address : Ixon.Address} + {arity : Nat} {captures arguments : List IxIR0.Value} + (hrel : CompilerFunctionRel sourceCtx src state function address arity + captures) + (happlies : SourceApplies sourceCtx function arguments result) + (hunder : (captures ++ arguments).length < arity) : + CompilerFunctionRel sourceCtx src state result address arity + (captures ++ arguments) := by + cases hrel with + | source hsrc heligible harity href hprefix _ => + exact .source hsrc heligible harity href (hprefix.append happlies) hunder + | wrapper hmember hsrc href hprefix _ => + exact .wrapper hmember hsrc href (hprefix.append happlies) hunder + | lifted hlifted => + obtain ⟨sourceEnv, expr, selected, supplied, hlift, hselected, + hcaptures, harity, hprefix⟩ := hlifted + subst captures + subst arity + have hprefixUnder : (supplied ++ arguments).length < lamArity expr := by + simp only [List.length_append] at hunder ⊢ + omega + apply CompilerFunctionRel.lifted + refine ⟨sourceEnv, expr, selected, supplied ++ arguments, hlift, + hselected, ?_, rfl, + hprefix.append_of_applies happlies hprefixUnder⟩ + simp [List.append_assoc] + +/-- The erased source value absorbs every argument while preserving strict +argument evaluation outside this relation. -/ +theorem SourceApplies.erased (sourceCtx : IxIR0.Ctx) : + ∀ arguments : List IxIR0.Value, + SourceApplies sourceCtx .erased arguments .erased + | [] => .nil + | argument :: arguments => by + exact SourceApplies.cons (fuel := 1) + (by simp [IxIR0.apply]) + (SourceApplies.erased sourceCtx arguments) + +/-- Applying an arbitrary still-underfilling argument vector to a source pap +only extends its stored prefix. This uniform lemma is useful for recursors +and externs as well as constructor and definition heads. -/ +theorem sourcePap_underfills {sourceCtx : IxIR0.Ctx} + {head : IxIR0.Head} {captures arguments : List IxIR0.Value} + (hunder : (captures ++ arguments).length < head.arity) : + SourceApplies sourceCtx (.pap head captures) arguments + (.pap head (captures ++ arguments)) := by + induction arguments generalizing captures with + | nil => simpa using (SourceApplies.nil (sourceCtx := sourceCtx) + (value := IxIR0.Value.pap head captures)) + | cons argument arguments ih => + have honeUnder : (captures ++ [argument]).length < head.arity := by + simp only [List.length_append, List.length_cons, List.length_nil] + at hunder ⊢ + omega + have hnotLength : captures.length + 1 ≠ head.arity := by + simpa using Nat.ne_of_lt honeUnder + have htailUnder : + ((captures ++ [argument]) ++ arguments).length < head.arity := by + simpa [List.append_assoc] using hunder + apply SourceApplies.cons + (middle := .pap head (captures ++ [argument])) (fuel := 2) + · simp [IxIR0.apply, IxIR0.saturate, hnotLength] + · simpa [List.append_assoc] using + (ih (captures := captures ++ [argument]) htailUnder) + +/-- Invert a saturated source recursor reference at the pre-major/major +boundary. The conclusion exposes exactly the rule lookup and RHS evaluator +environment that the corresponding target case alternative must simulate. -/ +theorem sourceRecursorRef_saturates_inv + {sourceCtx : IxIR0.Ctx} {address : Ixon.Address} + {numArgs : Nat} {natLit : Bool} {rules : Array IxIR0.RecRule} + {sourceFunction sourceResult major : IxIR0.Value} + {pre : List IxIR0.Value} + (hlookup : sourceCtx.env address = + some (.recursor numArgs natLit rules)) + (href : SourceRefValue sourceCtx address sourceFunction) + (hpreLength : pre.length = numArgs) + (happlies : SourceApplies sourceCtx sourceFunction + (pre ++ [major]) sourceResult) : + ∃ tag fields rule sourceFuel, + IxIR0.majorCtor natLit major = .ok (tag, fields) ∧ + rules[tag]? = some rule ∧ + fields.length = rule.fields ∧ + IxIR0.eval sourceCtx sourceFuel + (fields.reverse ++ pre.reverse ++ + [.pap (.rec_ address (numArgs + 1)) []]) + rule.rhs = .ok sourceResult := by + have hfunction := href.recursorValue hlookup + subst sourceFunction + have hunder : ([] ++ pre).length < + (IxIR0.Head.rec_ address (numArgs + 1)).arity := by + simp [IxIR0.Head.arity, hpreLength] + have hprefix : SourceApplies sourceCtx + (.pap (.rec_ address (numArgs + 1)) []) pre + (.pap (.rec_ address (numArgs + 1)) pre) := + sourcePap_underfills hunder + obtain ⟨middle, hleft, hright⟩ := + SourceApplies.split (left := pre) (right := [major]) (by + simpa using happlies) + have hmiddle : middle = .pap (.rec_ address (numArgs + 1)) pre := + hleft.deterministic hprefix + subst middle + cases hright with + | @cons _ _ middle result arguments applyFuel hstep htail => + cases htail + cases applyFuel with + | zero => simp [IxIR0.apply] at hstep + | succ fuel => + rw [IxIR0.apply.eq_def] at hstep + dsimp only at hstep + cases fuel with + | zero => simp [IxIR0.saturate] at hstep + | succ fuel => + rw [IxIR0.saturate.eq_def] at hstep + dsimp only at hstep + have hlength : (pre ++ [major]).length = numArgs + 1 := by + simp [hpreLength] + simp only [IxIR0.Head.arity, hlength, beq_self_eq_true, + if_true] at hstep + cases fuel with + | zero => simp [IxIR0.fire] at hstep + | succ sourceFuel => + rw [IxIR0.fire.eq_def] at hstep + dsimp only at hstep + rw [hlookup] at hstep + simp only at hstep + have hlast : (pre ++ [major]).getLast? = some major := by + simp + rw [hlast] at hstep + simp only at hstep + cases hmajor : IxIR0.majorCtor natLit major with + | error error => + rw [hmajor] at hstep + contradiction + | ok pair => + rcases pair with ⟨tag, fields⟩ + rw [hmajor] at hstep + rw [lowerSimExceptBindOk] at hstep + cases hrule : rules[tag]? with + | none => + rw [hrule] at hstep + contradiction + | some rule => + rw [hrule] at hstep + by_cases hfields : fields.length != rule.fields + · simp [hfields] at hstep + · have hfieldEq : fields.length = rule.fields := by + simpa using hfields + simp only [hfields] at hstep + exact ⟨tag, fields, rule, sourceFuel, rfl, hrule, + hfieldEq, by simpa using hstep⟩ + +/-- Split a pointwise argument graph at its final value when the target +runtime stack has already exposed the reversed prefix and major premise. -/ +theorem valuesGraph_splitLast + {funRel : Sim.FunctionRel} {store : Store} + {sourceArgs : List IxIR0.Value} {args : List RVal} + {runtimePre : List RVal} {major : RVal} {numArgs : Nat} + (hgraph : Sim.ValuesGraph funRel store sourceArgs args) + (hargsForm : args = runtimePre.reverse ++ [major]) + (hpreLength : runtimePre.length = numArgs) : + ∃ sourcePre sourceMajor, + sourceArgs = sourcePre ++ [sourceMajor] ∧ + sourcePre.length = numArgs ∧ + Sim.ValuesGraph funRel store sourcePre runtimePre.reverse ∧ + Sim.ValueGraph funRel store sourceMajor major := by + have hsourceLength : sourceArgs.length = numArgs + 1 := by + calc + sourceArgs.length = args.length := hgraph.length + _ = numArgs + 1 := by simp [hargsForm, hpreLength] + have hsourceBound : numArgs < sourceArgs.length := by omega + let sourcePre := sourceArgs.take numArgs + let sourceMajor := sourceArgs[numArgs] + have hsourceForm : sourceArgs = sourcePre ++ [sourceMajor] := by + have htake := List.take_append_getElem hsourceBound + have htakeAll : sourceArgs.take (numArgs + 1) = sourceArgs := by + apply List.take_of_length_le + omega + simpa [sourcePre, sourceMajor, htakeAll] using htake.symm + have hsourcePreLength : sourcePre.length = numArgs := by + simp [sourcePre, hsourceLength] + have htargetTake : args.take numArgs = runtimePre.reverse := by + rw [hargsForm] + apply List.take_left' + simpa using hpreLength + have hpreGraph : Sim.ValuesGraph funRel store sourcePre + runtimePre.reverse := by + simpa [sourcePre, htargetTake] using hgraph.take numArgs + have hsourceLookup : sourceArgs[numArgs]? = some sourceMajor := + List.getElem?_eq_getElem hsourceBound + obtain ⟨runtimeMajor, hruntimeLookup, hmajorGraph⟩ := + hgraph.get? hsourceLookup + have htargetLookup : args[numArgs]? = some major := by + rw [hargsForm] + simp [← hpreLength] + have hruntimeMajor : runtimeMajor = major := by + rw [htargetLookup] at hruntimeLookup + exact Option.some.inj hruntimeLookup.symm + subst runtimeMajor + exact ⟨sourcePre, sourceMajor, hsourceForm, hsourcePreLength, + hpreGraph, hmajorGraph⟩ + +/-- Applying exactly the missing arguments to an under-saturated source +constructor pap produces the constructor with the stored prefix followed by +those arguments. This is the source counterpart of IxIR₁'s static +constructor allocation. -/ +theorem sourceCtorPap_saturates {sourceCtx : IxIR0.Ctx} + {address : Ixon.Address} {tag arity : Nat} + {captures arguments : List IxIR0.Value} + (hunder : captures.length < arity) + (hsaturated : (captures ++ arguments).length = arity) : + SourceApplies sourceCtx (.pap (.ctor address tag arity) captures) + arguments (.ctor address tag (captures ++ arguments)) := by + induction arguments generalizing captures with + | nil => simp at hsaturated; omega + | cons argument arguments ih => + by_cases hfinal : (captures ++ [argument]).length = arity + · have hnil : arguments = [] := by + apply List.eq_nil_of_length_eq_zero + have htotal : + ((captures ++ [argument]) ++ arguments).length = arity := by + simpa [List.append_assoc] using hsaturated + simp only [List.length_append] at htotal hfinal + omega + subst arguments + apply SourceApplies.cons + (middle := .ctor address tag (captures ++ [argument])) (fuel := 3) + · simp [IxIR0.apply, IxIR0.saturate, IxIR0.fire, + IxIR0.Head.arity, hfinal] + · exact .nil + · have htotal : + ((captures ++ [argument]) ++ arguments).length = arity := by + simpa [List.append_assoc] using hsaturated + have hnextUnder : (captures ++ [argument]).length < arity := by + simp only [List.length_append] at htotal hfinal ⊢ + omega + have hnotLength : captures.length + 1 ≠ arity := by + simpa using Nat.ne_of_lt hnextUnder + apply SourceApplies.cons + (middle := .pap (.ctor address tag arity) + (captures ++ [argument])) (fuel := 2) + · simp [IxIR0.apply, IxIR0.saturate, IxIR0.Head.arity, + hnotLength] + · simpa [List.append_assoc] using + (ih hnextUnder htotal) + +/-- A constructor reference followed by exactly its declared number of +arguments evaluates to the corresponding source constructor value. The +explicit source-context lookup is the semantic/program consistency premise; +`SourceRefValue` then pins the otherwise existential reference fuel. -/ +theorem sourceCtorRef_saturates {sourceCtx : IxIR0.Ctx} + {address : Ixon.Address} {tag arity : Nat} + {sourceFunction : IxIR0.Value} {arguments : List IxIR0.Value} + (hlookup : sourceCtx.env address = some (.ctor tag arity)) + (href : SourceRefValue sourceCtx address sourceFunction) + (hlength : arguments.length = arity) : + SourceApplies sourceCtx sourceFunction arguments + (.ctor address tag arguments) := by + obtain ⟨sourceFuel, href⟩ := href + cases arity with + | zero => + have harguments : arguments = [] := + List.eq_nil_of_length_eq_zero hlength + subst arguments + have hcanonical : + IxIR0.eval sourceCtx 3 [] (.ref address) = + .ok (.ctor address tag []) := by + simp [IxIR0.eval, hlookup, IxIR0.saturate, IxIR0.fire, + IxIR0.Head.arity] + have hfunction : sourceFunction = .ctor address tag [] := + sourceEval_ok_unique href hcanonical + subst sourceFunction + exact .nil + | succ arity => + have hcanonical : + IxIR0.eval sourceCtx 2 [] (.ref address) = + .ok (.pap (.ctor address tag (arity + 1)) []) := by + simp [IxIR0.eval, hlookup, IxIR0.saturate, IxIR0.Head.arity] + have hfunction : + sourceFunction = .pap (.ctor address tag (arity + 1)) [] := + sourceEval_ok_unique href hcanonical + subst sourceFunction + simpa using sourceCtorPap_saturates + (sourceCtx := sourceCtx) (address := address) (tag := tag) + (arity := arity + 1) (captures := []) (arguments := arguments) + (by simp) (by simpa using hlength) + +/-- Exact-fuel semantic preservation for one compiled declaration body. + +Two conclusions, not one. The result clause is the obvious half. The *frame* +clause is the half that makes the contract usable at a call site at all: a +caller's post-state predicate (`GraphOwnsResult` and friends) demands +`RootsGraph` for its framed roots in the store the callee returns, and that +does not follow from ownership. A general callee both frees and allocates, +so neither `StoreGraphExtends` nor `StoreGraphRestricts` covers it, and the +obligation has to be discharged by the callee rather than reconstructed by +the caller. The argument worlds are carried in lockstep with +`FnOwnershipContract` so the two contracts share one call-site premise. -/ +def FnValuePreservesAt (funRel : Sim.FunctionRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (d : FnDef) (argWorlds : List Owned) + (sourceFunction : IxIR0.Value) (fuel : Nat) : Prop := + ∀ {store store' : Store} {args : List RVal} {value : RVal} + {sourceArgs : List IxIR0.Value} {sourceResult : IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root}, + args.length = argWorlds.length → + Sim.ValuesGraph funRel store sourceArgs args → + SourceApplies sourceCtx sourceFunction sourceArgs sourceResult → + Sim.RootsGraph funRel store sourceRest rest → + RootOwnership store (rootsForWorlds argWorlds args ++ rest) → + runCode ctx fuel d store args.reverse d.body = .ok (store', value) → + Sim.ValueGraph funRel store' sourceResult value ∧ + Sim.RootsGraph funRel store' sourceRest rest + +/-- Semantic contract for one compiled function declaration: entered on +arguments realizing source values, its body returns a value realizing the +source evaluator's own result for that saturated application, without +disturbing the caller's framed graphs. -/ +structure FnValueContract (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (ctx : Ctx) (d : FnDef) + (argWorlds : List Owned) (sourceFunction : IxIR0.Value) : Prop where + arity_eq : argWorlds.length = d.arity + preserves : ∀ {fuel : Nat}, + FnValuePreservesAt funRel sourceCtx ctx d argWorlds sourceFunction fuel + +/-- One function's semantic contract restricted to evaluator fuels strictly +below `limit`. -/ +structure FnValueContractBelow (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (ctx : Ctx) (d : FnDef) + (argWorlds : List Owned) (sourceFunction : IxIR0.Value) + (limit : Nat) : Prop where + arity_eq : argWorlds.length = d.arity + preserves : ∀ {fuel : Nat}, fuel < limit → + FnValuePreservesAt funRel sourceCtx ctx d argWorlds sourceFunction fuel + +theorem FnValueContract.below {funRel : Sim.FunctionRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {d : FnDef} + {argWorlds : List Owned} {sourceFunction : IxIR0.Value} + (hcontract : FnValueContract funRel sourceCtx ctx d argWorlds + sourceFunction) (limit : Nat) : + FnValueContractBelow funRel sourceCtx ctx d argWorlds sourceFunction + limit := + ⟨hcontract.arity_eq, fun _ => hcontract.preserves⟩ + +theorem FnValueContractBelow.mono {funRel : Sim.FunctionRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {d : FnDef} + {argWorlds : List Owned} {sourceFunction : IxIR0.Value} + {smaller larger : Nat} + (hcontract : FnValueContractBelow funRel sourceCtx ctx d argWorlds + sourceFunction larger) + (hbound : smaller ≤ larger) : + FnValueContractBelow funRel sourceCtx ctx d argWorlds sourceFunction + smaller := + ⟨hcontract.arity_eq, + fun hfuel => hcontract.preserves (Nat.lt_of_lt_of_le hfuel hbound)⟩ + +/-- Seal a one-fuel-step semantic body proof into an unbounded function +contract. The step may use the same function only at strictly smaller target +evaluator fuels. -/ +theorem fnValueContract_of_below_step {funRel : Sim.FunctionRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {d : FnDef} + {argWorlds : List Owned} {sourceFunction : IxIR0.Value} + (harity : argWorlds.length = d.arity) + (hstep : ∀ limit, + FnValueContractBelow funRel sourceCtx ctx d argWorlds sourceFunction + limit → + FnValuePreservesAt funRel sourceCtx ctx d argWorlds sourceFunction + limit) : + FnValueContract funRel sourceCtx ctx d argWorlds sourceFunction := by + refine ⟨harity, ?_⟩ + intro fuel store store' args value sourceArgs sourceResult sourceRest rest + hlength hargs happlies hframe hown hrun + have hall : ∀ index, + FnValuePreservesAt funRel sourceCtx ctx d argWorlds sourceFunction + index := by + intro index + induction index using Nat.strongRecOn with + | ind index ih => + apply hstep index + refine ⟨harity, ?_⟩ + intro prior hprior + exact ih prior hprior + exact hall fuel hlength hargs happlies hframe hown hrun + +/-- Exact-fuel semantic preservation for higher-order application, with the +same two-clause shape and the same frame obligation as the direct-call +contract. `applyGo` consumes one shared function root and all supplied +shared argument roots, matching `ApplyOwnershipContract`. -/ +def ApplyValuePreservesAt (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (ctx : Ctx) (fuel : Nat) : Prop := + ∀ {store store' : Store} {function : RVal} {args : List RVal} + {value : RVal} {sourceFunction : IxIR0.Value} + {sourceArgs : List IxIR0.Value} {sourceResult : IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root}, + Sim.ValueGraph funRel store sourceFunction function → + Sim.ValuesGraph funRel store sourceArgs args → + SourceApplies sourceCtx sourceFunction sourceArgs sourceResult → + Sim.RootsGraph funRel store sourceRest rest → + RootOwnership store + (⟨.shared, function⟩ :: rootsFor .shared args ++ rest) → + applyGo ctx fuel store function args = .ok (store', value) → + Sim.ValueGraph funRel store' sourceResult value ∧ + Sim.RootsGraph funRel store' sourceRest rest + +/-- Whole-context semantic application contract. This is where `FunctionRel` +stops being an assumption and becomes an obligation: an abstract relation +that merely *claims* a pap realizes a source function must additionally make +that pap compute the source function. -/ +structure ApplyValueContract (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (ctx : Ctx) : Prop where + preserves : ∀ {fuel : Nat}, + ApplyValuePreservesAt funRel sourceCtx ctx fuel + +/-- Semantic compatibility of the pure IxIR₀ extern oracle with IxIR₁'s +scalar-only ABI. The compiler does not manufacture this fact: it is the +explicit trusted boundary saying that related scalar arguments produce +related results at the same extern address. -/ +structure ExternValueContract (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (ctx : Ctx) : Prop where + preserves : ∀ {store : Store} {address : Ixon.Address} {arity : Nat} + {sourceFunction sourceResult : IxIR0.Value} + {sourceArgs : List IxIR0.Value} {args : List RVal} {result : RVal}, + sourceCtx.env address = some (.extern arity) → + SourceRefValue sourceCtx address sourceFunction → + sourceArgs.length = arity → + SourceApplies sourceCtx sourceFunction sourceArgs sourceResult → + Sim.ValuesGraph funRel store sourceArgs args → + callScalarOracle ctx address args = .ok result → + Sim.ValueGraph funRel store sourceResult result + +/-- Higher-order semantic application below an evaluator-fuel bound. +Saturating and over-applied paps re-enter declarations at strictly smaller +fuel, so this belongs in the same mutual induction as the call contract. -/ +structure ApplyValueContractBelow (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (ctx : Ctx) (limit : Nat) : Prop where + preserves : ∀ {fuel : Nat}, fuel < limit → + ApplyValuePreservesAt funRel sourceCtx ctx fuel + +theorem ApplyValueContract.below {funRel : Sim.FunctionRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} + (hcontract : ApplyValueContract funRel sourceCtx ctx) (limit : Nat) : + ApplyValueContractBelow funRel sourceCtx ctx limit := + ⟨fun _ => hcontract.preserves⟩ + +theorem ApplyValueContractBelow.mono {funRel : Sim.FunctionRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {smaller larger : Nat} + (hcontract : ApplyValueContractBelow funRel sourceCtx ctx larger) + (hbound : smaller ≤ larger) : + ApplyValueContractBelow funRel sourceCtx ctx smaller := + ⟨fun hfuel => hcontract.preserves (Nat.lt_of_lt_of_le hfuel hbound)⟩ + +/-- Pointwise semantic preservation of every source-backed target function at +one exact evaluator-fuel index. The source identity of the callee is pinned +by `SourceRefValue` at the same address the layout relation uses, so a +declaration cannot be related to a source function it was not compiled +from. -/ +def SourceFnValuePreservesAt (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (src : IxIR0.Env) (ctx : Ctx) + (fuel : Nat) : Prop := + ∀ {address : Ixon.Address} {source : IxIR0.Decl} + {worlds : List Owned} {result : Owned} {d : FnDef} + {sourceFunction : IxIR0.Value}, + src address = some source → + sourceCallableSignature source = some (worlds, result) → + ctx.decls address = some (.fn d) → + SourceRefValue sourceCtx address sourceFunction → + FnValuePreservesAt funRel sourceCtx ctx d worlds sourceFunction fuel + +/-- Semantic declaration contracts below an evaluator-fuel bound: the mutual +induction hypothesis for cross-declaration and self calls. -/ +structure SourceDeclValueContractsBelow (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (src : IxIR0.Env) (ctx : Ctx) + (limit : Nat) : Prop where + fn_preserves : ∀ {fuel : Nat}, fuel < limit → + SourceFnValuePreservesAt funRel sourceCtx src ctx fuel + +/-- Public, unbounded semantic contracts for every source-backed target +function. -/ +structure SourceDeclValueContracts (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (src : IxIR0.Env) (ctx : Ctx) : Prop where + fn_preserves : ∀ {fuel : Nat}, + SourceFnValuePreservesAt funRel sourceCtx src ctx fuel + +/-- Package the pointwise semantic declaration environment as the call-site +`FnValueContract` once the (fuel-independent) layout supplies its arity. -/ +theorem SourceDeclValueContracts.fnContract {funRel : Sim.FunctionRel} + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ctx : Ctx} + (hcontracts : SourceDeclValueContracts funRel sourceCtx src ctx) + {address : Ixon.Address} {source : IxIR0.Decl} + {worlds : List Owned} {result : Owned} {d : FnDef} + {sourceFunction : IxIR0.Value} + (hsrc : src address = some source) + (hsignature : sourceCallableSignature source = some (worlds, result)) + (hdecl : ctx.decls address = some (.fn d)) + (href : SourceRefValue sourceCtx address sourceFunction) + (harity : worlds.length = d.arity) : + FnValueContract funRel sourceCtx ctx d worlds sourceFunction := by + refine ⟨harity, ?_⟩ + intro fuel + exact hcontracts.fn_preserves hsrc hsignature hdecl href + +theorem SourceDeclValueContractsBelow.fnContract + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} + {src : IxIR0.Env} {ctx : Ctx} {limit : Nat} + (hcontracts : SourceDeclValueContractsBelow funRel sourceCtx src ctx + limit) + {address : Ixon.Address} {source : IxIR0.Decl} + {worlds : List Owned} {result : Owned} {d : FnDef} + {sourceFunction : IxIR0.Value} + (hsrc : src address = some source) + (hsignature : sourceCallableSignature source = some (worlds, result)) + (hdecl : ctx.decls address = some (.fn d)) + (href : SourceRefValue sourceCtx address sourceFunction) + (harity : worlds.length = d.arity) : + FnValueContractBelow funRel sourceCtx ctx d worlds sourceFunction + limit := by + refine ⟨harity, ?_⟩ + intro fuel hfuel + exact hcontracts.fn_preserves hfuel hsrc hsignature hdecl href + +theorem SourceDeclValueContracts.below {funRel : Sim.FunctionRel} + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ctx : Ctx} + (hcontracts : SourceDeclValueContracts funRel sourceCtx src ctx) + (limit : Nat) : + SourceDeclValueContractsBelow funRel sourceCtx src ctx limit := + ⟨fun _ => hcontracts.fn_preserves⟩ + +theorem SourceDeclValueContractsBelow.mono {funRel : Sim.FunctionRel} + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ctx : Ctx} + {smaller larger : Nat} + (hcontracts : SourceDeclValueContractsBelow funRel sourceCtx src ctx + larger) (hbound : smaller ≤ larger) : + SourceDeclValueContractsBelow funRel sourceCtx src ctx smaller := + ⟨fun hfuel => hcontracts.fn_preserves (Nat.lt_of_lt_of_le hfuel hbound)⟩ + +/-- Semantic twin of `CompilerContracts`: direct calls and higher-order +application both carry their source result. -/ +structure CompilerValueContracts (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (src : IxIR0.Env) (ctx : Ctx) : Prop where + decls : SourceDeclValueContracts funRel sourceCtx src ctx + apply : ApplyValueContract funRel sourceCtx ctx + extern : ExternValueContract funRel sourceCtx ctx + +structure CompilerValueContractsBelow (funRel : Sim.FunctionRel) + (sourceCtx : IxIR0.Ctx) (src : IxIR0.Env) (ctx : Ctx) + (limit : Nat) : Prop where + decls : SourceDeclValueContractsBelow funRel sourceCtx src ctx limit + apply : ApplyValueContractBelow funRel sourceCtx ctx limit + extern : ExternValueContract funRel sourceCtx ctx + +theorem CompilerValueContracts.below {funRel : Sim.FunctionRel} + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ctx : Ctx} + (hcontracts : CompilerValueContracts funRel sourceCtx src ctx) + (limit : Nat) : + CompilerValueContractsBelow funRel sourceCtx src ctx limit := + ⟨hcontracts.decls.below limit, hcontracts.apply.below limit, + hcontracts.extern⟩ + +theorem CompilerValueContractsBelow.mono {funRel : Sim.FunctionRel} + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ctx : Ctx} + {smaller larger : Nat} + (hcontracts : CompilerValueContractsBelow funRel sourceCtx src ctx + larger) (hbound : smaller ≤ larger) : + CompilerValueContractsBelow funRel sourceCtx src ctx smaller := + ⟨hcontracts.decls.mono hbound, hcontracts.apply.mono hbound, + hcontracts.extern⟩ + +/-- Simultaneously seal semantic declaration and higher-order-application +contracts. At index `limit`, the producer receives both families only below +`limit`; strong induction then constructs the public unbounded package +without assuming the result being proved. -/ +theorem compilerValueContracts_of_below_step + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} + {src : IxIR0.Env} {ctx : Ctx} + (hextern : ExternValueContract funRel sourceCtx ctx) + (hstep : ∀ limit, + CompilerValueContractsBelow funRel sourceCtx src ctx limit → + SourceFnValuePreservesAt funRel sourceCtx src ctx limit ∧ + ApplyValuePreservesAt funRel sourceCtx ctx limit) : + CompilerValueContracts funRel sourceCtx src ctx := by + have hall : ∀ index, + SourceFnValuePreservesAt funRel sourceCtx src ctx index ∧ + ApplyValuePreservesAt funRel sourceCtx ctx index := by + intro index + induction index using Nat.strongRecOn with + | ind index ih => + apply hstep index + refine ⟨⟨?_⟩, ⟨?_⟩, hextern⟩ + · intro prior hprior + exact (ih prior hprior).1 + · intro prior hprior + exact (ih prior hprior).2 + refine ⟨⟨?_⟩, ⟨?_⟩, hextern⟩ + · intro fuel + exact (hall fuel).1 + · intro fuel + exact (hall fuel).2 + +/-! ### Semantic compiler-induction interfaces -/ + +/-- Successful expression lowering refines a successful source evaluation at +one compiler-fuel index. Source evaluation is pure, so both semantic +environment indices are the same even though lowering may consume target +owners from its `VEnv`. -/ +def LowerEValuePreserves (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {world : Owned} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal}, + IxIR0.eval sourceCtx sourceFuel sourceEnv expr = .ok sourceValue → + (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState → + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue world emit av + +/-- Contractive semantic expression interface at one target evaluator +bound. Compiler recursion remains indexed separately by `fuel`. -/ +def LowerEValuePreservesBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) + (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {world : Owned} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal}, + IxIR0.eval sourceCtx sourceFuel sourceEnv expr = .ok sourceValue → + (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState → + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue world emit av + +/-- Descriptor-shape companion to semantic expression preservation. If a +successful lowering run returns the literal erased descriptor, then the +successful source evaluation returned `◻` as well. This small reflection +fact selects the two semantically different `applyRest` branches without +strengthening every `LowerResultValueSound` operation lemma. -/ +def LowerEReflectsErased (sourceCtx : IxIR0.Ctx) (src : IxIR0.Env) + (fuel : Nat) : Prop := + ∀ {input output : VEnv} {world : Owned} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal}, + IxIR0.eval sourceCtx sourceFuel sourceEnv expr = .ok sourceValue → + (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState → + av = .constA .erased → + sourceValue = .erased + +/-- Successful borrowing-position lowering refines evaluation of the source +target. This is the semantic companion consumed by the projection branch of +the expression induction. -/ +def LowerBorrowValuePreserves (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal} {release : Bool}, + IxIR0.eval sourceCtx sourceFuel sourceEnv expr = .ok sourceValue → + (lowerBorrow src fuel input expr).run state = + .ok (output, emit, av, release) finalState → + LowerBorrowValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue emit av release + +def LowerBorrowValuePreservesBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) + (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal} {release : Bool}, + IxIR0.eval sourceCtx sourceFuel sourceEnv expr = .ok sourceValue → + (lowerBorrow src fuel input expr).run state = + .ok (output, emit, av, release) finalState → + LowerBorrowValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue emit av release + +/-- Descriptor reflection for a borrowing position. It is separated from +the value transformer because it is a pure statement about source and +compiler executions and therefore remains meaningful without a realizable +heap precondition. -/ +def LowerBorrowReflectsErased (sourceCtx : IxIR0.Ctx) (src : IxIR0.Env) + (fuel : Nat) : Prop := + ∀ {input output : VEnv} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal} {release : Bool}, + IxIR0.eval sourceCtx sourceFuel sourceEnv expr = .ok sourceValue → + (lowerBorrow src fuel input expr).run state = + .ok (output, emit, av, release) finalState → + av = .constA .erased → + sourceValue = .erased + +/-- Descriptor reflection for flattened spines. This is the companion +needed by `.app`: an erased target descriptor implies the complete source +application result was erased, including dynamic erased absorption. -/ +def LowerSpineReflectsErased (sourceCtx : IxIR0.Ctx) (src : IxIR0.Env) + (fuel : Nat) : Prop := + ∀ {input output : VEnv} {world : Owned} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal}, + SourceSpineEval sourceCtx sourceEnv head args sourceResult → + (lowerSpine src fuel input world head args).run state = + .ok (output, emit, av) finalState → + av = .constA .erased → + sourceResult = .erased + +/-- Successful `lowerArgs` refines pointwise left-to-right source argument +evaluation. Worlds remain compiler-side annotations; the source relation +tracks only the expressions and their values. -/ +def LowerArgsValuePreserves (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {sourceEnv sourceValues : List IxIR0.Value} + {args : List (IxIR0.Expr × Owned)} {state finalState : LowSt} + {emit : Emit} {avs : List AVal}, + SourceArgsEval sourceCtx sourceEnv (args.map Prod.fst) sourceValues → + (lowerArgs src fuel input args).run state = + .ok (output, emit, avs) finalState → + LowerArgsValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValues (args.map Prod.snd) emit avs + +def LowerArgsValuePreservesBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) + (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {sourceEnv sourceValues : List IxIR0.Value} + {args : List (IxIR0.Expr × Owned)} {state finalState : LowSt} + {emit : Emit} {avs : List AVal}, + SourceArgsEval sourceCtx sourceEnv (args.map Prod.fst) sourceValues → + (lowerArgs src fuel input args).run state = + .ok (output, emit, avs) finalState → + LowerArgsValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValues (args.map Prod.snd) emit avs + +/-- Semantic preservation for the genuine (non-erased) branch of +`applyRest`. The function has already been produced at shared ownership; +this interface evaluates the source/target argument tail and applies the two +completed higher-order contracts. -/ +def ApplyRestNonErasedValuePreserves (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {start input output : VEnv} + {sourceStart sourceMiddle sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {resultWorld : Owned} {emitFunction emit : Emit} + {function av : AVal} {args : List IxIR0.Expr} + {state finalState : LowSt}, + function ≠ .constA .erased → + SourceArgsEval sourceCtx sourceMiddle args sourceArgs → + SourceApplies sourceCtx sourceFunction sourceArgs sourceResult → + LowerResultValueSound funRel recSelfRel ctx cur start input + sourceStart sourceMiddle sourceFunction .shared emitFunction + function → + (applyRest src fuel input resultWorld emitFunction function args).run + state = .ok (output, emit, av) finalState → + LowerResultValueSound funRel recSelfRel ctx cur start output + sourceStart sourceMiddle sourceResult resultWorld emit av + +def ApplyRestNonErasedValuePreservesBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) + (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {start input output : VEnv} + {sourceStart sourceMiddle sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {resultWorld : Owned} {emitFunction emit : Emit} + {function av : AVal} {args : List IxIR0.Expr} + {state finalState : LowSt}, + function ≠ .constA .erased → + SourceArgsEval sourceCtx sourceMiddle args sourceArgs → + SourceApplies sourceCtx sourceFunction sourceArgs sourceResult → + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit start input + sourceStart sourceMiddle sourceFunction .shared emitFunction + function → + (applyRest src fuel input resultWorld emitFunction function args).run + state = .ok (output, emit, av) finalState → + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit start output + sourceStart sourceMiddle sourceResult resultWorld emit av + +/-- Successful flattened-spine lowering refines `SourceSpineEval` at one +compiler-fuel index. This is the semantic induction interface shared by the +`.app` branch of `lowerE` and the recursive `.app` head of `lowerSpine`. -/ +def LowerSpineValuePreserves (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {world : Owned} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal}, + SourceSpineEval sourceCtx sourceEnv head args sourceResult → + (lowerSpine src fuel input world head args).run state = + .ok (output, emit, av) finalState → + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av + +def LowerSpineValuePreservesBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) + (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {world : Owned} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal}, + SourceSpineEval sourceCtx sourceEnv head args sourceResult → + (lowerSpine src fuel input world head args).run state = + .ok (output, emit, av) finalState → + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult world emit av + +/-! ### Reachable-state semantic compiler interfaces -/ + +/-- Semantic contract for the current generated function. As on the +ownership side, the substantive contract is needed only in environments +that can expose a synthetic `recSelf` entry. -/ +structure CurrentSelfValueContract (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) : Prop where + result : cur.result = .shared + ownership : FnOwnershipContract ctx cur + (List.replicate cur.arity .shared) + value : ∀ {sourceFunction : IxIR0.Value}, + recSelfRel sourceFunction cur.arity → + FnValueContract funRel sourceCtx ctx cur + (List.replicate cur.arity .shared) sourceFunction + +/-- Contractive current-self contract at one evaluator bound. -/ +structure CurrentSelfValueContractBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) : Prop where + result : cur.result = .shared + ownership : FnOwnershipContractBelow ctx cur + (List.replicate cur.arity .shared) limit + value : ∀ {sourceFunction : IxIR0.Value}, + recSelfRel sourceFunction cur.arity → + FnValueContractBelow funRel sourceCtx ctx cur + (List.replicate cur.arity .shared) sourceFunction limit + +theorem CurrentSelfValueContract.below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + (hcontract : CurrentSelfValueContract funRel recSelfRel sourceCtx ctx + cur) (limit : Nat) : + CurrentSelfValueContractBelow funRel recSelfRel sourceCtx ctx cur + limit := + ⟨hcontract.result, hcontract.ownership.below limit, + fun hself => (hcontract.value hself).below limit⟩ + +/-- Bounded current-self semantics are either available substantively or +irrelevant because the logical environment has no synthetic self entry. -/ +def SelfValueAvailableBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) (input : VEnv) : Prop := + CurrentSelfValueContractBelow funRel recSelfRel sourceCtx ctx cur limit ∨ + NoRecSelf input + +theorem SelfValueAvailableBelow.of_contract + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {input : VEnv} + (hcontract : CurrentSelfValueContractBelow funRel recSelfRel sourceCtx + ctx cur limit) : + SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx cur limit input := + Or.inl hcontract + +theorem SelfValueAvailableBelow.of_noRecSelf + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {input : VEnv} (hno : NoRecSelf input) : + SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx cur limit input := + Or.inr hno + +theorem SelfValueAvailableBelow.mapNoRecSelf + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {input output : VEnv} + (havailable : SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx + cur limit input) + (hpreserve : NoRecSelf input → NoRecSelf output) : + SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + output := by + cases havailable with + | inl hcontract => exact Or.inl hcontract + | inr hno => exact Or.inr (hpreserve hno) + +theorem SelfValueAvailableBelow.bump + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {input : VEnv} + (havailable : SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx + cur limit input) : + SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input.bump := + havailable.mapNoRecSelf NoRecSelf.bump + +theorem SelfValueAvailableBelow.pop + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {input : VEnv} + (havailable : SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx + cur limit input) : + SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input.pop := + havailable.mapNoRecSelf NoRecSelf.pop + +theorem SelfValueAvailableBelow.setSlot + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {input : VEnv} + (havailable : SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx + cur limit input) + (changed abs remaining : Nat) (uses : Uses) (held : Bool) : + SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + (input.setEntry changed (.slot abs remaining uses held)) := + havailable.mapNoRecSelf + (fun hno => hno.setSlot changed abs remaining uses held) + +theorem SelfValueAvailableBelow.consSlot + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {input : VEnv} + (havailable : SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx + cur limit input) + (abs remaining : Nat) (uses : Uses) (held : Bool) : + SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + { input with + entries := .slot abs remaining uses held :: input.entries } := + havailable.mapNoRecSelf + (fun hno => hno.consSlot abs remaining uses held) + +theorem SelfValueAvailableBelow.lowerE + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Owned} {expr : IxIR0.Expr} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (havailable : SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx + cur limit input) + (hrun : (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState) : + SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + output := + havailable.mapNoRecSelf + (fun hno => (lowerPreservesNoRecSelf src fuel).expr hrun hno) + +theorem SelfValueAvailableBelow.lowerBorrow + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {expr : IxIR0.Expr} + {state finalState : LowSt} {emit : Emit} {av : AVal} + {release : Bool} + (havailable : SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx + cur limit input) + (hrun : (lowerBorrow src fuel input expr).run state = + .ok (output, emit, av, release) finalState) : + SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + output := + havailable.mapNoRecSelf + (fun hno => (lowerPreservesNoRecSelf src fuel).borrow hrun hno) + +theorem SelfValueAvailableBelow.lowerArgs + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {args : List (IxIR0.Expr × Owned)} + {state finalState : LowSt} {emit : Emit} {avs : List AVal} + (havailable : SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx + cur limit input) + (hrun : (lowerArgs src fuel input args).run state = + .ok (output, emit, avs) finalState) : + SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + output := + havailable.mapNoRecSelf + (fun hno => (lowerPreservesNoRecSelf src fuel).args hrun hno) + +theorem SelfValueAvailableBelow.applyRest + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {resultWorld : Owned} + {pre : Emit} {function : AVal} {args : List IxIR0.Expr} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (havailable : SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx + cur limit input) + (hrun : (applyRest src fuel input resultWorld pre function args).run + state = .ok (output, emit, av) finalState) : + SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + output := + havailable.mapNoRecSelf + (fun hno => (lowerPreservesNoRecSelf src fuel).applyRest hrun hno) + +/-- Current-self semantics are available substantively for recursor-rule +environments or vacuously for ordinary environments with no self marker. -/ +def SelfValueAvailable (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (input : VEnv) : Prop := + CurrentSelfValueContract funRel recSelfRel sourceCtx ctx cur ∨ + NoRecSelf input + +theorem SelfValueAvailable.of_contract + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {input : VEnv} + (hcontract : CurrentSelfValueContract funRel recSelfRel sourceCtx ctx + cur) : + SelfValueAvailable funRel recSelfRel sourceCtx ctx cur input := + Or.inl hcontract + +theorem SelfValueAvailable.of_noRecSelf + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {input : VEnv} + (hno : NoRecSelf input) : + SelfValueAvailable funRel recSelfRel sourceCtx ctx cur input := + Or.inr hno + +theorem SelfValueAvailable.mapNoRecSelf + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + (havailable : SelfValueAvailable funRel recSelfRel sourceCtx ctx cur + input) + (hpreserve : NoRecSelf input → NoRecSelf output) : + SelfValueAvailable funRel recSelfRel sourceCtx ctx cur output := by + cases havailable with + | inl hcontract => exact Or.inl hcontract + | inr hno => exact Or.inr (hpreserve hno) + +theorem SelfValueAvailable.bump + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {input : VEnv} + (havailable : SelfValueAvailable funRel recSelfRel sourceCtx ctx cur + input) : + SelfValueAvailable funRel recSelfRel sourceCtx ctx cur input.bump := + havailable.mapNoRecSelf NoRecSelf.bump + +theorem SelfValueAvailable.pop + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {input : VEnv} + (havailable : SelfValueAvailable funRel recSelfRel sourceCtx ctx cur + input) : + SelfValueAvailable funRel recSelfRel sourceCtx ctx cur input.pop := + havailable.mapNoRecSelf NoRecSelf.pop + +theorem SelfValueAvailable.setSlot + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {input : VEnv} + (havailable : SelfValueAvailable funRel recSelfRel sourceCtx ctx cur + input) + (changed abs remaining : Nat) (uses : Uses) (held : Bool) : + SelfValueAvailable funRel recSelfRel sourceCtx ctx cur + (input.setEntry changed (.slot abs remaining uses held)) := + havailable.mapNoRecSelf + (fun hno => hno.setSlot changed abs remaining uses held) + +theorem SelfValueAvailable.consSlot + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {input : VEnv} + (havailable : SelfValueAvailable funRel recSelfRel sourceCtx ctx cur + input) + (abs remaining : Nat) (uses : Uses) (held : Bool) : + SelfValueAvailable funRel recSelfRel sourceCtx ctx cur + { input with + entries := .slot abs remaining uses held :: input.entries } := + havailable.mapNoRecSelf + (fun hno => hno.consSlot abs remaining uses held) + +theorem SelfValueAvailable.lowerE + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {world : Owned} {expr : IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (havailable : SelfValueAvailable funRel recSelfRel sourceCtx ctx cur + input) + (hrun : (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState) : + SelfValueAvailable funRel recSelfRel sourceCtx ctx cur output := + havailable.mapNoRecSelf + (fun hno => (lowerPreservesNoRecSelf src fuel).expr hrun hno) + +theorem SelfValueAvailable.lowerBorrow + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {expr : IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {av : AVal} {release : Bool} + (havailable : SelfValueAvailable funRel recSelfRel sourceCtx ctx cur + input) + (hrun : (lowerBorrow src fuel input expr).run state = + .ok (output, emit, av, release) finalState) : + SelfValueAvailable funRel recSelfRel sourceCtx ctx cur output := + havailable.mapNoRecSelf + (fun hno => (lowerPreservesNoRecSelf src fuel).borrow hrun hno) + +theorem SelfValueAvailable.lowerArgs + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {args : List (IxIR0.Expr × Owned)} {state finalState : LowSt} + {emit : Emit} {avs : List AVal} + (havailable : SelfValueAvailable funRel recSelfRel sourceCtx ctx cur + input) + (hrun : (lowerArgs src fuel input args).run state = + .ok (output, emit, avs) finalState) : + SelfValueAvailable funRel recSelfRel sourceCtx ctx cur output := + havailable.mapNoRecSelf + (fun hno => (lowerPreservesNoRecSelf src fuel).args hrun hno) + +theorem SelfValueAvailable.applyRest + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {resultWorld : Owned} {pre : Emit} {function : AVal} + {args : List IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (havailable : SelfValueAvailable funRel recSelfRel sourceCtx ctx cur + input) + (hrun : (applyRest src fuel input resultWorld pre function args).run + state = .ok (output, emit, av) finalState) : + SelfValueAvailable funRel recSelfRel sourceCtx ctx cur output := + havailable.mapNoRecSelf + (fun hno => (lowerPreservesNoRecSelf src fuel).applyRest hrun hno) + +/-- Reachable-state expression semantics. The successful subrun need only +end at a suffix-prefix of the ambient whole-pass state indexing `funRel`. -/ +def LowerEValuePreservesWithin (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {world : Owned} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal}, + IxIR0.eval sourceCtx sourceFuel sourceEnv expr = .ok sourceValue → + (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState → + ExtraExtends finalState ambient → + SelfValueAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue world emit av + +def LowerBorrowValuePreservesWithin (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal} {release : Bool}, + IxIR0.eval sourceCtx sourceFuel sourceEnv expr = .ok sourceValue → + (lowerBorrow src fuel input expr).run state = + .ok (output, emit, av, release) finalState → + ExtraExtends finalState ambient → + SelfValueAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerBorrowValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue emit av release + +def LowerArgsValuePreservesWithin (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {sourceEnv sourceValues : List IxIR0.Value} + {args : List (IxIR0.Expr × Owned)} {state finalState : LowSt} + {emit : Emit} {avs : List AVal}, + SourceArgsEval sourceCtx sourceEnv (args.map Prod.fst) sourceValues → + (lowerArgs src fuel input args).run state = + .ok (output, emit, avs) finalState → + ExtraExtends finalState ambient → + SelfValueAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerArgsValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValues (args.map Prod.snd) emit avs + +def ApplyRestNonErasedValuePreservesWithin (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {start input output : VEnv} + {sourceStart sourceMiddle sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {resultWorld : Owned} {emitFunction emit : Emit} + {function av : AVal} {args : List IxIR0.Expr} + {state finalState : LowSt}, + function ≠ .constA .erased → + SourceArgsEval sourceCtx sourceMiddle args sourceArgs → + SourceApplies sourceCtx sourceFunction sourceArgs sourceResult → + LowerResultValueSound funRel recSelfRel ctx cur start input + sourceStart sourceMiddle sourceFunction .shared emitFunction + function → + (applyRest src fuel input resultWorld emitFunction function args).run + state = .ok (output, emit, av) finalState → + ExtraExtends finalState ambient → + SelfValueAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerResultValueSound funRel recSelfRel ctx cur start output + sourceStart sourceMiddle sourceResult resultWorld emit av + +def LowerSpineValuePreservesWithin (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {world : Owned} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal}, + SourceSpineEval sourceCtx sourceEnv head args sourceResult → + (lowerSpine src fuel input world head args).run state = + .ok (output, emit, av) finalState → + ExtraExtends finalState ambient → + SelfValueAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av + +/-! ### Fuel-bounded reachable-state semantic interfaces -/ + +/-- Reachable-state expression semantics restricted to one target evaluator +bound. -/ +def LowerEValuePreservesWithinBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {world : Owned} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal}, + IxIR0.eval sourceCtx sourceFuel sourceEnv expr = .ok sourceValue → + (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState → + ExtraExtends finalState ambient → + SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx cur limit input → + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue world emit av + +/-- Reachable-state borrow semantics restricted to one evaluator bound. -/ +def LowerBorrowValuePreservesWithinBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal} {release : Bool}, + IxIR0.eval sourceCtx sourceFuel sourceEnv expr = .ok sourceValue → + (lowerBorrow src fuel input expr).run state = + .ok (output, emit, av, release) finalState → + ExtraExtends finalState ambient → + SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx cur limit input → + LowerBorrowValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue emit av release + +/-- Reachable-state argument semantics restricted to one evaluator bound. -/ +def LowerArgsValuePreservesWithinBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {sourceEnv sourceValues : List IxIR0.Value} + {args : List (IxIR0.Expr × Owned)} {state finalState : LowSt} + {emit : Emit} {avs : List AVal}, + SourceArgsEval sourceCtx sourceEnv (args.map Prod.fst) sourceValues → + (lowerArgs src fuel input args).run state = + .ok (output, emit, avs) finalState → + ExtraExtends finalState ambient → + SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx cur limit input → + LowerArgsValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValues (args.map Prod.snd) emit avs + +/-- Reachable-state non-erased application semantics restricted to one +evaluator bound. -/ +def ApplyRestNonErasedValuePreservesWithinBelow + (funRel : Sim.FunctionRel) (recSelfRel : RecSelfRel) + (sourceCtx : IxIR0.Ctx) (ctx : Ctx) (cur : FnDef) (limit : Nat) + (src : IxIR0.Env) (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {start input output : VEnv} + {sourceStart sourceMiddle sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {resultWorld : Owned} {emitFunction emit : Emit} + {function av : AVal} {args : List IxIR0.Expr} + {state finalState : LowSt}, + function ≠ .constA .erased → + SourceArgsEval sourceCtx sourceMiddle args sourceArgs → + SourceApplies sourceCtx sourceFunction sourceArgs sourceResult → + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit start input + sourceStart sourceMiddle sourceFunction .shared emitFunction function → + (applyRest src fuel input resultWorld emitFunction function args).run + state = .ok (output, emit, av) finalState → + ExtraExtends finalState ambient → + SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx cur limit input → + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit start output + sourceStart sourceMiddle sourceResult resultWorld emit av + +/-- Reachable-state spine semantics restricted to one evaluator bound. -/ +def LowerSpineValuePreservesWithinBelow (funRel : Sim.FunctionRel) + (recSelfRel : RecSelfRel) (sourceCtx : IxIR0.Ctx) + (ctx : Ctx) (cur : FnDef) (limit : Nat) (src : IxIR0.Env) + (ambient : LowSt) (fuel : Nat) : Prop := + ∀ {input output : VEnv} {world : Owned} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal}, + SourceSpineEval sourceCtx sourceEnv head args sourceResult → + (lowerSpine src fuel input world head args).run state = + .ok (output, emit, av) finalState → + ExtraExtends finalState ambient → + SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx cur limit input → + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult world emit av + +/-- No successful argument-lowering run exists at zero compiler fuel. -/ +theorem lowerArgsValuePreserves_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) : + LowerArgsValuePreserves funRel recSelfRel sourceCtx ctx cur src 0 := by + intro input output sourceEnv sourceValues args state finalState emit avs + _ hrun + simp only [lowerArgs] at hrun + exact (estateThrowRun_not_ok hrun).elim + +theorem lowerArgsValuePreservesBelow_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (src : IxIR0.Env) : + LowerArgsValuePreservesBelow funRel recSelfRel sourceCtx ctx cur limit + src 0 := by + intro input output sourceEnv sourceValues args state finalState emit avs + _ hrun + simp only [lowerArgs] at hrun + exact (estateThrowRun_not_ok hrun).elim + +theorem lowerEReflectsErased_zero (sourceCtx : IxIR0.Ctx) + (src : IxIR0.Env) : LowerEReflectsErased sourceCtx src 0 := by + intro input output world expr sourceEnv sourceFuel sourceValue state + finalState emit av _ hrun _ + simp only [lowerE] at hrun + exact (estateThrowRun_not_ok hrun).elim + +/-- No successful expression-lowering run exists at zero compiler fuel. -/ +theorem lowerEValuePreserves_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) : + LowerEValuePreserves funRel recSelfRel sourceCtx ctx cur src 0 := by + intro input output world expr sourceEnv sourceFuel sourceValue state + finalState emit av _ hrun + simp only [lowerE] at hrun + exact (estateThrowRun_not_ok hrun).elim + +theorem lowerEValuePreservesBelow_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (src : IxIR0.Env) : + LowerEValuePreservesBelow funRel recSelfRel sourceCtx ctx cur limit + src 0 := by + intro input output world expr sourceEnv sourceFuel sourceValue state + finalState emit av _ hrun + simp only [lowerE] at hrun + exact (estateThrowRun_not_ok hrun).elim + +/-- No successful borrow-lowering run exists at zero compiler fuel. -/ +theorem lowerBorrowValuePreserves_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) : + LowerBorrowValuePreserves funRel recSelfRel sourceCtx ctx cur src 0 := by + intro input output expr sourceEnv sourceFuel sourceValue state finalState + emit av release _ hrun + simp only [lowerBorrow] at hrun + exact (estateThrowRun_not_ok hrun).elim + +theorem lowerBorrowValuePreservesBelow_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (src : IxIR0.Env) : + LowerBorrowValuePreservesBelow funRel recSelfRel sourceCtx ctx cur + limit src 0 := by + intro input output expr sourceEnv sourceFuel sourceValue state finalState + emit av release _ hrun + simp only [lowerBorrow] at hrun + exact (estateThrowRun_not_ok hrun).elim + +theorem lowerBorrowReflectsErased_zero (sourceCtx : IxIR0.Ctx) + (src : IxIR0.Env) : LowerBorrowReflectsErased sourceCtx src 0 := by + intro input output expr sourceEnv sourceFuel sourceValue state finalState + emit av release _ hrun _ + simp only [lowerBorrow] at hrun + exact (estateThrowRun_not_ok hrun).elim + +/-- No successful spine-lowering run exists at zero compiler fuel. -/ +theorem lowerSpineValuePreserves_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) : + LowerSpineValuePreserves funRel recSelfRel sourceCtx ctx cur src 0 := by + intro input output world head args sourceEnv sourceResult state finalState + emit av _ hrun + simp only [lowerSpine] at hrun + exact (estateThrowRun_not_ok hrun).elim + +theorem lowerSpineValuePreservesBelow_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (src : IxIR0.Env) : + LowerSpineValuePreservesBelow funRel recSelfRel sourceCtx ctx cur limit + src 0 := by + intro input output world head args sourceEnv sourceResult state finalState + emit av _ hrun + simp only [lowerSpine] at hrun + exact (estateThrowRun_not_ok hrun).elim + +theorem lowerEValuePreservesWithin_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (ambient : LowSt) : + LowerEValuePreservesWithin funRel recSelfRel sourceCtx ctx cur src + ambient 0 := by + intro input output world expr sourceEnv sourceFuel sourceValue state + finalState emit av _ hrun _ _ + simp only [lowerE] at hrun + exact (estateThrowRun_not_ok hrun).elim + +theorem lowerBorrowValuePreservesWithin_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (ambient : LowSt) : + LowerBorrowValuePreservesWithin funRel recSelfRel sourceCtx ctx cur src + ambient 0 := by + intro input output expr sourceEnv sourceFuel sourceValue state finalState + emit av release _ hrun _ _ + simp only [lowerBorrow] at hrun + exact (estateThrowRun_not_ok hrun).elim + +theorem lowerArgsValuePreservesWithin_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (ambient : LowSt) : + LowerArgsValuePreservesWithin funRel recSelfRel sourceCtx ctx cur src + ambient 0 := by + intro input output sourceEnv sourceValues args state finalState emit avs + _ hrun _ _ + simp only [lowerArgs] at hrun + exact (estateThrowRun_not_ok hrun).elim + +theorem applyRestNonErasedValuePreservesWithin_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (ambient : LowSt) : + ApplyRestNonErasedValuePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient 0 := by + intro start input output sourceStart sourceMiddle sourceArgs + sourceFunction sourceResult resultWorld emitFunction emit function av + args state finalState _ _ _ _ hrun _ _ + simp only [applyRest] at hrun + exact (estateThrowRun_not_ok hrun).elim + +theorem lowerSpineValuePreservesWithin_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (ambient : LowSt) : + LowerSpineValuePreservesWithin funRel recSelfRel sourceCtx ctx cur src + ambient 0 := by + intro input output world head args sourceEnv sourceResult state finalState + emit av _ hrun _ _ + simp only [lowerSpine] at hrun + exact (estateThrowRun_not_ok hrun).elim + +/-- The bounded reachable semantic cluster is vacuous at zero compiler +fuel. -/ +theorem lowerEValuePreservesWithinBelow_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (src : IxIR0.Env) (ambient : LowSt) : + LowerEValuePreservesWithinBelow funRel recSelfRel sourceCtx ctx cur + limit src ambient 0 := by + intro input output world expr sourceEnv sourceFuel sourceValue state + finalState emit av hsource hrun _ _ + exact lowerEValuePreservesBelow_zero src hsource hrun + +theorem lowerBorrowValuePreservesWithinBelow_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (src : IxIR0.Env) (ambient : LowSt) : + LowerBorrowValuePreservesWithinBelow funRel recSelfRel sourceCtx ctx cur + limit src ambient 0 := by + intro input output expr sourceEnv sourceFuel sourceValue state finalState + emit av release hsource hrun _ _ + exact lowerBorrowValuePreservesBelow_zero src hsource hrun + +theorem lowerArgsValuePreservesWithinBelow_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (src : IxIR0.Env) (ambient : LowSt) : + LowerArgsValuePreservesWithinBelow funRel recSelfRel sourceCtx ctx cur + limit src ambient 0 := by + intro input output sourceEnv sourceValues args state finalState emit avs + hsource hrun _ _ + exact lowerArgsValuePreservesBelow_zero src hsource hrun + +theorem applyRestNonErasedValuePreservesWithinBelow_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (src : IxIR0.Env) (ambient : LowSt) : + ApplyRestNonErasedValuePreservesWithinBelow funRel recSelfRel sourceCtx + ctx cur limit src ambient 0 := by + intro start input output sourceStart sourceMiddle sourceArgs + sourceFunction sourceResult resultWorld emitFunction emit function av + args state finalState _ _ _ _ hrun _ _ + simp only [applyRest] at hrun + exact (estateThrowRun_not_ok hrun).elim + +theorem lowerSpineValuePreservesWithinBelow_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (src : IxIR0.Env) (ambient : LowSt) : + LowerSpineValuePreservesWithinBelow funRel recSelfRel sourceCtx ctx cur + limit src ambient 0 := by + intro input output world head args sourceEnv sourceResult state finalState + emit av hsource hrun _ _ + exact lowerSpineValuePreservesBelow_zero src hsource hrun + +theorem lowerSpineReflectsErased_zero (sourceCtx : IxIR0.Ctx) + (src : IxIR0.Env) : LowerSpineReflectsErased sourceCtx src 0 := by + intro input output world head args sourceEnv sourceResult state finalState + emit av _ hrun _ + simp only [lowerSpine] at hrun + exact (estateThrowRun_not_ok hrun).elim + +/-- The genuine `applyRest` branch always returns a fresh slot descriptor. +Consequently a successful erased descriptor can only have come from the +syntactic erased-function branch. -/ +theorem applyRest_nonErased_run_result_slot + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {resultWorld : Owned} {pre : Emit} {function : AVal} + {args : List IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hfunction : function ≠ .constA .erased) + (hrun : (applyRest src fuel input resultWorld pre function args).run + state = .ok (output, emit, av) finalState) : + ∃ abs, av = .slotA abs := by + cases fuel with + | zero => + simp only [applyRest] at hrun + exact (estateThrowRun_not_ok hrun).elim + | succ fuel => + cases function with + | slotA functionAbs => + simp only [applyRest] at hrun + obtain ⟨_, requireState, _, hafterRequire⟩ := + estateBindRun_ok_inv hrun + obtain ⟨argsResult, argsState, _, hpureRun⟩ := + estateBindRun_ok_inv hafterRequire + rcases argsResult with ⟨argsOutput, emitArgs, avs⟩ + have hpure : + (argsOutput.bump, + pre ∘ emitArgs ∘ + emitOp (.apply ((AVal.slotA functionAbs).toAtom argsOutput) + (avs.map (·.toAtom argsOutput)).toArray), + AVal.slotA argsOutput.depth) = (output, emit, av) ∧ + argsState = finalState := by + simpa using hpureRun + exact ⟨argsOutput.depth, (congrArg Prod.snd + (congrArg Prod.snd hpure.1)).symm⟩ + | constA atom => + cases atom with + | erased => exact (hfunction rfl).elim + | var index => + simp only [applyRest] at hrun + obtain ⟨_, requireState, _, hafterRequire⟩ := + estateBindRun_ok_inv hrun + obtain ⟨argsResult, argsState, _, hpureRun⟩ := + estateBindRun_ok_inv hafterRequire + rcases argsResult with ⟨argsOutput, emitArgs, avs⟩ + have hpure : + (argsOutput.bump, + pre ∘ emitArgs ∘ + emitOp (.apply ((AVal.constA (.var index)).toAtom argsOutput) + (avs.map (·.toAtom argsOutput)).toArray), + AVal.slotA argsOutput.depth) = (output, emit, av) ∧ + argsState = finalState := by + simpa [Function.comp_def] using hpureRun + exact ⟨argsOutput.depth, (congrArg Prod.snd + (congrArg Prod.snd hpure.1)).symm⟩ + | lit literal => + simp only [applyRest] at hrun + obtain ⟨_, requireState, _, hafterRequire⟩ := + estateBindRun_ok_inv hrun + obtain ⟨argsResult, argsState, _, hpureRun⟩ := + estateBindRun_ok_inv hafterRequire + rcases argsResult with ⟨argsOutput, emitArgs, avs⟩ + have hpure : + (argsOutput.bump, + pre ∘ emitArgs ∘ + emitOp (.apply ((AVal.constA (.lit literal)).toAtom argsOutput) + (avs.map (·.toAtom argsOutput)).toArray), + AVal.slotA argsOutput.depth) = (output, emit, av) ∧ + argsState = finalState := by + simpa [Function.comp_def] using hpureRun + exact ⟨argsOutput.depth, (congrArg Prod.snd + (congrArg Prod.snd hpure.1)).symm⟩ + +/-- Every successful `knownCall` returns a slot: terminal calls push the +operation result directly, and over-application enters `applyRest` with that +non-erased slot as its function descriptor. -/ +theorem knownCall_run_result_slot + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {build : Array Atom → Op} {count : Nat} {argWorlds : List Owned} + {resultWorld : Owned} {args : List IxIR0.Expr} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hrun : (knownCall src fuel input build count argWorlds resultWorld + args).run state = .ok (output, emit, av) finalState) : + ∃ abs, av = .slotA abs := by + cases fuel with + | zero => + simp only [knownCall] at hrun + exact (estateThrowRun_not_ok hrun).elim + | succ fuel => + simp only [knownCall] at hrun + obtain ⟨argsResult, argsState, _, hafterArgs⟩ := + estateBindRun_ok_inv hrun + rcases argsResult with ⟨argsOutput, emitArgs, avs⟩ + by_cases hterminal : args.length ≤ count + · rw [if_pos hterminal] at hafterArgs + have hpure : + (argsOutput.bump, + emitArgs ∘ emitOp + (build (avs.map (·.toAtom argsOutput)).toArray), + AVal.slotA argsOutput.depth) = (output, emit, av) ∧ + argsState = finalState := by + simpa using hafterArgs + exact ⟨argsOutput.depth, (congrArg Prod.snd + (congrArg Prod.snd hpure.1)).symm⟩ + · rw [if_neg hterminal] at hafterArgs + exact applyRest_nonErased_run_result_slot (by simp) hafterArgs + +theorem applyRest_run_constErased_inv + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {resultWorld : Owned} {pre : Emit} {function : AVal} + {args : List IxIR0.Expr} {state finalState : LowSt} {emit : Emit} + (hrun : (applyRest src fuel input resultWorld pre function args).run + state = .ok (output, emit, .constA .erased) finalState) : + function = .constA .erased := by + by_cases hfunction : function = .constA .erased + · exact hfunction + · obtain ⟨abs, hav⟩ := + applyRest_nonErased_run_result_slot hfunction hrun + contradiction + +theorem knownCall_run_ne_constErased + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {build : Array Atom → Op} {count : Nat} {argWorlds : List Owned} + {resultWorld : Owned} {args : List IxIR0.Expr} + {state finalState : LowSt} {emit : Emit} + (hrun : (knownCall src fuel input build count argWorlds resultWorld + args).run state = .ok (output, emit, .constA .erased) finalState) : + False := by + obtain ⟨abs, hav⟩ := knownCall_run_result_slot hrun + contradiction + +/-- Static reference dispatch never returns the literal erased descriptor. +Every successful branch terminates in `knownCall`; constructor wrappers add +only a stateful lookup before that call. -/ +theorem lowerSpine_ref_run_ne_constErased + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {world : Owned} {address : Ixon.Address} {args : List IxIR0.Expr} + {state finalState : LowSt} {emit : Emit} + (hrun : (lowerSpine src fuel input world (.ref address) args).run + state = .ok (output, emit, .constA .erased) finalState) : + False := by + cases fuel with + | zero => + simp only [lowerSpine] at hrun + exact estateThrowRun_not_ok hrun + | succ fuel => + simp only [lowerSpine] at hrun + cases hsrc : src address with + | none => + rw [hsrc] at hrun + exact estateThrowRun_not_ok hrun + | some source => + rw [hsrc] at hrun + cases source with + | defn result body => + simp only at hrun + by_cases hunder : args.length < lamArity body + · rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact estateThrowRun_not_ok (by simpa [huuEq] using hrun) + | shared => + cases result with + | unique => + exact estateThrowRun_not_ok + (by simpa [hsuEq, huuEq] using hrun) + | shared => + cases hp : papSafe body with + | false => + exact estateThrowRun_not_ok + (by simpa [hsuEq, hp] using hrun) + | true => + apply knownCall_run_ne_constErased + simpa [hsuEq, hp] using hrun + · rw [if_neg hunder] at hrun + obtain ⟨_, _, _, hknownRun⟩ := estateBindRun_ok_inv hrun + exact knownCall_run_ne_constErased hknownRun + | ctor tag arity => + simp only at hrun + by_cases hunder : args.length < arity + · rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact estateThrowRun_not_ok (by simpa [huuEq] using hrun) + | shared => + have hrun' : + ((wrapperFor address tag arity) >>= fun wrapper => + knownCall src fuel input (.papp wrapper ·) args.length + (List.replicate args.length .shared) .shared args).run + state = + .ok (output, emit, .constA .erased) finalState := by + simpa [hsuEq] using hrun + obtain ⟨_, _, _, hknownRun⟩ := estateBindRun_ok_inv hrun' + exact knownCall_run_ne_constErased hknownRun + · apply knownCall_run_ne_constErased + simpa [if_neg hunder] using hrun + | recursor numArgs natLit rules => + simp only at hrun + by_cases hunder : args.length < numArgs + 1 + · rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact estateThrowRun_not_ok (by simpa [huuEq] using hrun) + | shared => + apply knownCall_run_ne_constErased + simpa [hsuEq] using hrun + · rw [if_neg hunder] at hrun + obtain ⟨_, _, _, hknownRun⟩ := estateBindRun_ok_inv hrun + exact knownCall_run_ne_constErased hknownRun + | extern arity => + simp only at hrun + by_cases hunder : args.length < arity + · rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact estateThrowRun_not_ok (by simpa [huuEq] using hrun) + | shared => + apply knownCall_run_ne_constErased + simpa [hsuEq] using hrun + · apply knownCall_run_ne_constErased + simpa [if_neg hunder] using hrun + +/-- Shared operational decomposition for one successful argument-list step. +The result family is independent of the source relation, so semantic and +profile clients share nil recovery, monadic sequencing, emitter/list +reconstruction, and final-state recovery. -/ +theorem lowerArgs_run_core + {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {args : List (IxIR0.Expr × Owned)} + {state finalState : LowSt} {emit : Emit} {avs : List AVal} + {Result : List (IxIR0.Expr × Owned) → VEnv → Emit → List AVal → + LowSt → Prop} + (hnil : Result [] input (_root_.id : Emit) [] state) + (hcons : ∀ (expr : IxIR0.Expr) (world : Owned) + (tail : List (IxIR0.Expr × Owned)) + {middle actualOutput : VEnv} {emitHead emitTail : Emit} + {av : AVal} {tailAVals : List AVal} + {middleState tailState : LowSt}, + (lowerE src fuel input world expr).run state = + .ok (middle, emitHead, av) middleState → + (lowerArgs src fuel middle tail).run middleState = + .ok (actualOutput, emitTail, tailAVals) tailState → + Result ((expr, world) :: tail) actualOutput (emitHead ∘ emitTail) + (av :: tailAVals) tailState) + (hrun : (lowerArgs src (fuel + 1) input args).run state = + .ok (output, emit, avs) finalState) : + Result args output emit avs finalState := by + cases args with + | nil => + have hpure : + (input, (_root_.id : Emit), []) = (output, emit, avs) ∧ + state = finalState := by + simpa [lowerArgs] using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact hnil + | cons arg tail => + rcases arg with ⟨expr, world⟩ + simp only [lowerArgs] at hrun + obtain ⟨headResult, middleState, hheadRun, hafterHead⟩ := + estateBindRun_ok_inv hrun + rcases headResult with ⟨middle, emitHead, av⟩ + dsimp only at hafterHead + obtain ⟨tailResult, tailState, htailRun, hpureRun⟩ := + estateBindRun_ok_inv hafterHead + rcases tailResult with ⟨actualOutput, emitTail, tailAVals⟩ + have hpure : + (actualOutput, emitHead ∘ emitTail, av :: tailAVals) = + (output, emit, avs) ∧ + tailState = finalState := by + simpa using hpureRun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact hcons expr world tail hheadRun htailRun + +/-- Semantic-source adapter for `lowerArgs_run_core`. `SourceArgsEval` +inversion remains canonical across ordinary, bounded, and reachable semantic +clients, while the operational decomposition is shared with profile proofs. -/ +private theorem lowerArgs_run_value_sound_core + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {sourceEnv sourceValues : List IxIR0.Value} + {args : List (IxIR0.Expr × Owned)} {state finalState : LowSt} + {emit : Emit} {avs : List AVal} + {Result : VEnv → List IxIR0.Value → List Owned → Emit → + List AVal → LowSt → Prop} + (hnil : Result input [] [] (_root_.id : Emit) [] state) + (hcons : ∀ (expr : IxIR0.Expr) (world : Owned) + (tail : List (IxIR0.Expr × Owned)) + {sourceFuel : Nat} {sourceValue : IxIR0.Value} + {sourceTail : List IxIR0.Value} + {middle actualOutput : VEnv} {emitHead emitTail : Emit} + {av : AVal} {tailAVals : List AVal} + {middleState tailState : LowSt}, + IxIR0.eval sourceCtx sourceFuel sourceEnv expr = .ok sourceValue → + SourceArgsEval sourceCtx sourceEnv (tail.map Prod.fst) sourceTail → + (lowerE src fuel input world expr).run state = + .ok (middle, emitHead, av) middleState → + (lowerArgs src fuel middle tail).run middleState = + .ok (actualOutput, emitTail, tailAVals) tailState → + Result actualOutput (sourceValue :: sourceTail) + (world :: tail.map Prod.snd) (emitHead ∘ emitTail) + (av :: tailAVals) tailState) + (hsource : SourceArgsEval sourceCtx sourceEnv (args.map Prod.fst) + sourceValues) + (hrun : (lowerArgs src (fuel + 1) input args).run state = + .ok (output, emit, avs) finalState) : + Result output sourceValues (args.map Prod.snd) emit avs finalState := by + exact (lowerArgs_run_core + (Result := fun actualArgs actualOutput actualEmit actualAVals + actualState => + ∀ {actualSourceValues : List IxIR0.Value}, + SourceArgsEval sourceCtx sourceEnv (actualArgs.map Prod.fst) + actualSourceValues → + Result actualOutput actualSourceValues (actualArgs.map Prod.snd) + actualEmit actualAVals actualState) + (hnil := by + intro actualSourceValues hactualSource + cases hactualSource + exact hnil) + (hcons := by + intro expr world tail middle actualOutput emitHead emitTail av + tailAVals middleState tailState hheadRun htailRun + actualSourceValues hactualSource + change SourceArgsEval sourceCtx sourceEnv + (expr :: tail.map Prod.fst) actualSourceValues at hactualSource + cases hactualSource with + | cons hsourceHead hsourceTail => + exact hcons expr world tail hsourceHead hsourceTail hheadRun htailRun) + hrun) hsource + +/-- The semantic `lowerArgs` induction step. The source relation and the +executable lowerer decompose in the same list order, after which +`LowerResultValueSound.consArgs` supplies the semantic frame rule needed by +the tail. -/ +theorem lowerArgsValuePreserves_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEValuePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + (htail : LowerArgsValuePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) : + LowerArgsValuePreserves funRel recSelfRel sourceCtx ctx cur src + (fuel + 1) := by + intro input output sourceEnv sourceValues args state finalState emit avs + hsource hrun + exact lowerArgs_run_value_sound_core + (Result := fun actualOutput actualSourceValues worlds actualEmit + actualAVals _ => + LowerArgsValueSound funRel recSelfRel ctx cur input actualOutput + sourceEnv sourceEnv actualSourceValues worlds actualEmit actualAVals) + (hnil := lowerArgs_nil_value_sound) + (hcons := by + intro _ _ _ _ _ _ _ _ _ _ _ _ _ _ hsourceHead hsourceTail + hheadRun htailRun + exact (hexpr hsourceHead hheadRun).consArgs + (htail hsourceTail htailRun)) + hsource hrun + +/-- Shared strict-fuel closure for argument judgments. The predicate +parameters keep semantic and profile result contracts distinct while +predecessor-hypothesis narrowing and tail recursion are proved once. -/ +theorem lowerArgsPreserves_of_expr_core + {Expr Args : Nat → Prop} + (hzero : Args 0) + (hsucc : ∀ {fuel}, Expr fuel → Args fuel → Args (fuel + 1)) + (fuel : Nat) + (hexpr : ∀ prior, prior < fuel → Expr prior) : + Args fuel := by + induction fuel with + | zero => exact hzero + | succ fuel ih => + apply hsucc + · exact hexpr fuel (Nat.lt_succ_self fuel) + · apply ih + intro prior hprior + exact hexpr prior (Nat.lt_trans hprior (Nat.lt_succ_self fuel)) + +/-- `lowerArgs` semantic preservation at any compiler fuel follows from the +strictly smaller expression hypotheses, matching the recursive fuel +discipline of the executable mutually recursive cluster. -/ +theorem lowerArgsValuePreserves_of_expr + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} (fuel : Nat) + (hexpr : ∀ prior, prior < fuel → + LowerEValuePreserves funRel recSelfRel sourceCtx ctx cur src prior) : + LowerArgsValuePreserves funRel recSelfRel sourceCtx ctx cur src fuel := + lowerArgsPreserves_of_expr_core + (Expr := LowerEValuePreserves funRel recSelfRel sourceCtx ctx cur src) + (Args := LowerArgsValuePreserves funRel recSelfRel sourceCtx ctx cur src) + (hzero := lowerArgsValuePreserves_zero src) + (hsucc := fun hexpr htail => + lowerArgsValuePreserves_succ hexpr htail) + fuel hexpr + +theorem lowerArgsValuePreservesBelow_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEValuePreservesBelow funRel recSelfRel sourceCtx ctx cur + limit src fuel) + (htail : LowerArgsValuePreservesBelow funRel recSelfRel sourceCtx ctx + cur limit src fuel) : + LowerArgsValuePreservesBelow funRel recSelfRel sourceCtx ctx cur limit + src (fuel + 1) := by + intro input output sourceEnv sourceValues args state finalState emit avs + hsource hrun + exact lowerArgs_run_value_sound_core + (Result := fun actualOutput actualSourceValues worlds actualEmit + actualAVals _ => + LowerArgsValueSoundBelow funRel recSelfRel ctx cur limit input + actualOutput sourceEnv sourceEnv actualSourceValues worlds actualEmit + actualAVals) + (hnil := lowerArgs_nil_value_sound_below) + (hcons := by + intro _ _ _ _ _ _ _ _ _ _ _ _ _ _ hsourceHead hsourceTail + hheadRun htailRun + exact (hexpr hsourceHead hheadRun).consArgs + (htail hsourceTail htailRun)) + hsource hrun + +theorem lowerArgsValuePreservesBelow_of_expr + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} (fuel : Nat) + (hexpr : ∀ prior, prior < fuel → + LowerEValuePreservesBelow funRel recSelfRel sourceCtx ctx cur limit + src prior) : + LowerArgsValuePreservesBelow funRel recSelfRel sourceCtx ctx cur limit + src fuel := + lowerArgsPreserves_of_expr_core + (Expr := LowerEValuePreservesBelow funRel recSelfRel sourceCtx ctx cur + limit src) + (Args := LowerArgsValuePreservesBelow funRel recSelfRel sourceCtx ctx cur + limit src) + (hzero := lowerArgsValuePreservesBelow_zero src) + (hsucc := fun hexpr htail => + lowerArgsValuePreservesBelow_succ hexpr htail) + fuel hexpr + +/-! ### Semantic call primitives at the operation level -/ + +/-- Semantic transfer across a direct invocation, from a contract available +strictly below the invocation fuel. A successful invocation at `fuel + 1` +enters the callee body at `fuel`, which is exactly where the mutual +declaration induction needs the strict decrease. -/ +theorem invoke_fn_value_below {funRel : Sim.FunctionRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {fuel : Nat} {f : Ixon.Address} + {args : List RVal} {store store' : Store} {value : RVal} {d : FnDef} + {argWorlds : List Owned} {sourceFunction sourceResult : IxIR0.Value} + {sourceArgs : List IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hdecl : ctx.decls f = some (.fn d)) + (harity : argWorlds.length = d.arity) + (hcontract : ∀ {smaller : Nat}, smaller < fuel → + FnValuePreservesAt funRel sourceCtx ctx d argWorlds sourceFunction + smaller) + (hargs : Sim.ValuesGraph funRel store sourceArgs args) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs sourceResult) + (hframe : Sim.RootsGraph funRel store sourceRest rest) + (hown : RootOwnership store (rootsForWorlds argWorlds args ++ rest)) + (hinvoke : invoke ctx fuel f args store = .ok (store', value)) : + Sim.ValueGraph funRel store' sourceResult value ∧ + Sim.RootsGraph funRel store' sourceRest rest := by + cases fuel with + | zero => simp [invoke] at hinvoke + | succ fuel => + simp only [invoke, hdecl] at hinvoke + split at hinvoke + · contradiction + next hlen => + have hargsLength : args.length = argWorlds.length := by + have hd : args.length = d.arity := by simpa using hlen + exact hd.trans harity.symm + cases hrun : runCode ctx fuel d store args.reverse d.body with + | error e => + rw [hrun] at hinvoke + change (.error e : Except Err (Store × RVal)) = + .ok (store', value) at hinvoke + contradiction + | ok out => + rw [hrun] at hinvoke + change checkResultWorld d.result out = .ok (store', value) at hinvoke + obtain ⟨hpair, _⟩ := checkResultWorld_ok hinvoke + subst out + exact hcontract (Nat.lt_succ_self fuel) hargsLength hargs hsource + hframe hown hrun + +/-- Operation-level semantic direct call. -/ +theorem runOp_call_value_below {funRel : Sim.FunctionRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {fuel : Nat} {cur d : FnDef} + {store store' : Store} {env : List RVal} {f : Ixon.Address} + {atoms : Array Atom} {args : List RVal} {value : RVal} + {argWorlds : List Owned} {sourceFunction sourceResult : IxIR0.Value} + {sourceArgs : List IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hatoms : resolveAtoms env atoms = .ok args) + (hdecl : ctx.decls f = some (.fn d)) + (harity : argWorlds.length = d.arity) + (hcontract : ∀ {smaller : Nat}, smaller < fuel → + FnValuePreservesAt funRel sourceCtx ctx d argWorlds sourceFunction + smaller) + (hargs : Sim.ValuesGraph funRel store sourceArgs args) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs sourceResult) + (hframe : Sim.RootsGraph funRel store sourceRest rest) + (hown : RootOwnership store (rootsForWorlds argWorlds args ++ rest)) + (hrun : runOp ctx (fuel + 1) cur store env (.call f atoms) = + .ok (store', value)) : + Sim.ValueGraph funRel store' sourceResult value ∧ + Sim.RootsGraph funRel store' sourceRest rest := by + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [hatoms, bindOk] at hrun + exact invoke_fn_value_below hdecl harity hcontract hargs hsource hframe + hown hrun + +/-- Operation-level semantic recursive self call. The current function's own +contract is available at the enclosing index, since the body re-enters at +`fuel` while the operation runs at `fuel + 1`. -/ +theorem runOp_callSelf_value_below {funRel : Sim.FunctionRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store store' : Store} {env : List RVal} {atoms : Array Atom} + {args : List RVal} {value : RVal} + {argWorlds : List Owned} {sourceFunction sourceResult : IxIR0.Value} + {sourceArgs : List IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hatoms : resolveAtoms env atoms = .ok args) + (harity : argWorlds.length = cur.arity) + (hcontract : ∀ {smaller : Nat}, smaller < fuel + 1 → + FnValuePreservesAt funRel sourceCtx ctx cur argWorlds sourceFunction + smaller) + (hargs : Sim.ValuesGraph funRel store sourceArgs args) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs sourceResult) + (hframe : Sim.RootsGraph funRel store sourceRest rest) + (hown : RootOwnership store (rootsForWorlds argWorlds args ++ rest)) + (hrun : runOp ctx (fuel + 1) cur store env (.callSelf atoms) = + .ok (store', value)) : + Sim.ValueGraph funRel store' sourceResult value ∧ + Sim.RootsGraph funRel store' sourceRest rest := by + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [hatoms, bindOk] at hrun + split at hrun + · contradiction + next hlen => + have hargsLength : args.length = argWorlds.length := by + have hd : args.length = cur.arity := by simpa using hlen + exact hd.trans harity.symm + cases hcode : runCode ctx fuel cur store args.reverse cur.body with + | error e => + rw [hcode] at hrun + change (.error e : Except Err (Store × RVal)) = + .ok (store', value) at hrun + contradiction + | ok out => + rw [hcode] at hrun + change checkResultWorld cur.result out = .ok (store', value) at hrun + obtain ⟨hpair, _⟩ := checkResultWorld_ok hrun + subst out + exact hcontract (Nat.lt_succ_self fuel) hargsLength hargs hsource + hframe hown hcode + +/-- Unbounded direct-call semantic primitive. -/ +theorem runOp_call_value {funRel : Sim.FunctionRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {fuel : Nat} {cur d : FnDef} + {store store' : Store} {env : List RVal} {f : Ixon.Address} + {atoms : Array Atom} {args : List RVal} {value : RVal} + {argWorlds : List Owned} {sourceFunction sourceResult : IxIR0.Value} + {sourceArgs : List IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hatoms : resolveAtoms env atoms = .ok args) + (hdecl : ctx.decls f = some (.fn d)) + (hcontract : FnValueContract funRel sourceCtx ctx d argWorlds + sourceFunction) + (hargs : Sim.ValuesGraph funRel store sourceArgs args) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs sourceResult) + (hframe : Sim.RootsGraph funRel store sourceRest rest) + (hown : RootOwnership store (rootsForWorlds argWorlds args ++ rest)) + (hrun : runOp ctx (fuel + 1) cur store env (.call f atoms) = + .ok (store', value)) : + Sim.ValueGraph funRel store' sourceResult value ∧ + Sim.RootsGraph funRel store' sourceRest rest := by + exact runOp_call_value_below hatoms hdecl hcontract.arity_eq + (fun _ => hcontract.preserves) hargs hsource hframe hown hrun + +/-- Unbounded recursive-self-call semantic primitive. -/ +theorem runOp_callSelf_value {funRel : Sim.FunctionRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store store' : Store} {env : List RVal} {atoms : Array Atom} + {args : List RVal} {value : RVal} + {argWorlds : List Owned} {sourceFunction sourceResult : IxIR0.Value} + {sourceArgs : List IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hatoms : resolveAtoms env atoms = .ok args) + (hcontract : FnValueContract funRel sourceCtx ctx cur argWorlds + sourceFunction) + (hargs : Sim.ValuesGraph funRel store sourceArgs args) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs sourceResult) + (hframe : Sim.RootsGraph funRel store sourceRest rest) + (hown : RootOwnership store (rootsForWorlds argWorlds args ++ rest)) + (hrun : runOp ctx (fuel + 1) cur store env (.callSelf atoms) = + .ok (store', value)) : + Sim.ValueGraph funRel store' sourceResult value ∧ + Sim.RootsGraph funRel store' sourceRest rest := by + exact runOp_callSelf_value_below hatoms hcontract.arity_eq + (fun _ => hcontract.preserves) hargs hsource hframe hown hrun + +/-- Operation-level semantic extern call. A successful IxIR₁ operation +leaves the store unchanged; the explicit oracle contract supplies the result +graph for the corresponding saturated IxIR₀ extern application. -/ +theorem runOp_extern_value {funRel : Sim.FunctionRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store store' : Store} {env : List RVal} {f : Ixon.Address} + {atoms : Array Atom} {args : List RVal} {value : RVal} + {arity : Nat} {sourceFunction sourceResult : IxIR0.Value} + {sourceArgs : List IxIR0.Value} + (hatoms : resolveAtoms env atoms = .ok args) + (hcontract : ExternValueContract funRel sourceCtx ctx) + (hlookup : sourceCtx.env f = some (.extern arity)) + (href : SourceRefValue sourceCtx f sourceFunction) + (hlength : sourceArgs.length = arity) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs sourceResult) + (hargs : Sim.ValuesGraph funRel store sourceArgs args) + (hrun : runOp ctx (fuel + 1) cur store env (.extern f atoms) = + .ok (store', value)) : + store' = store ∧ Sim.ValueGraph funRel store sourceResult value := by + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [hatoms, bindOk] at hrun + cases horacle : callScalarOracle ctx f args with + | error error => + rw [horacle] at hrun + contradiction + | ok result => + rw [horacle] at hrun + have hpair : (store, result) = (store', value) := + Except.ok.inj hrun + cases hpair + exact ⟨rfl, hcontract.preserves hlookup href hlength hsource hargs + horacle⟩ + +/-- Operation-level higher-order semantic application under a bounded +contract environment. -/ +theorem runOp_apply_value_below {funRel : Sim.FunctionRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store store' : Store} {env : List RVal} {functionAtom : Atom} + {function : RVal} {atoms : Array Atom} {args : List RVal} + {value : RVal} {sourceFunction sourceResult : IxIR0.Value} + {sourceArgs : List IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hfunction : resolveAtom env functionAtom = .ok function) + (hatoms : resolveAtoms env atoms = .ok args) + (hcontract : ApplyValueContractBelow funRel sourceCtx ctx (fuel + 1)) + (hfunctionGraph : Sim.ValueGraph funRel store sourceFunction function) + (hargs : Sim.ValuesGraph funRel store sourceArgs args) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs sourceResult) + (hframe : Sim.RootsGraph funRel store sourceRest rest) + (hown : RootOwnership store + (⟨.shared, function⟩ :: rootsFor .shared args ++ rest)) + (hrun : runOp ctx (fuel + 1) cur store env + (.apply functionAtom atoms) = .ok (store', value)) : + Sim.ValueGraph funRel store' sourceResult value ∧ + Sim.RootsGraph funRel store' sourceRest rest := by + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [hfunction, bindOk, hatoms, bindOk] at hrun + exact hcontract.preserves (Nat.lt_succ_self fuel) hfunctionGraph hargs + hsource hframe hown hrun + +/-- Unbounded operation-level higher-order semantic application. -/ +theorem runOp_apply_value {funRel : Sim.FunctionRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store store' : Store} {env : List RVal} {functionAtom : Atom} + {function : RVal} {atoms : Array Atom} {args : List RVal} + {value : RVal} {sourceFunction sourceResult : IxIR0.Value} + {sourceArgs : List IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hfunction : resolveAtom env functionAtom = .ok function) + (hatoms : resolveAtoms env atoms = .ok args) + (hcontract : ApplyValueContract funRel sourceCtx ctx) + (hfunctionGraph : Sim.ValueGraph funRel store sourceFunction function) + (hargs : Sim.ValuesGraph funRel store sourceArgs args) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs sourceResult) + (hframe : Sim.RootsGraph funRel store sourceRest rest) + (hown : RootOwnership store + (⟨.shared, function⟩ :: rootsFor .shared args ++ rest)) + (hrun : runOp ctx (fuel + 1) cur store env + (.apply functionAtom atoms) = .ok (store', value)) : + Sim.ValueGraph funRel store' sourceResult value ∧ + Sim.RootsGraph funRel store' sourceRest rest := + runOp_apply_value_below hfunction hatoms (hcontract.below (fuel + 1)) + hfunctionGraph hargs hsource hframe hown hrun + +/-- State-indexed semantic direct-call primitive. This is the operation +midpoint used by paired value/profile proofs: the arguments and caller frame +are consumed and reconstructed around the exact callee run. -/ +theorem call_graph_op + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur d : FnDef} + {output : VEnv} {sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Owned} {avs : List AVal} {f : Ixon.Address} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + {slots : List (Nat × RVal)} + (hdecl : ctx.decls f = some (.fn d)) + (hownership : FnOwnershipContract ctx d worlds) + (hvalue : FnValueContract funRel sourceCtx ctx d worlds sourceFunction) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + OpSound ctx cur (.call f (avs.map (·.toAtom output)).toArray) + (GraphOwnsArgsResultProtected funRel recSelfRel output sourceOutput + sourceArgs worlds avs sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult d.result (.slotA output.depth) sourceRest rest slots) := by + intro fuel store env store' result hpre hrun + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + have henvFrame : Sim.RootsGraph funRel store + (entrySourceRoots output.entries sourceOutput) envRoots := + houtput.entries.rootsGraphExact + have hcombinedFrame : Sim.RootsGraph funRel store + (entrySourceRoots output.entries sourceOutput ++ sourceRest) + (envRoots ++ rest) := + henvFrame.append hrestGraph + have hownCall : RootOwnership store + (rootsForWorlds worlds values ++ (envRoots ++ rest)) := by + simpa [List.append_assoc] using hown + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + obtain ⟨hresultGraph, hcombinedAfter⟩ := + runOp_call_value + (sourceCtx := sourceCtx) (ctx := ctx) (cur := cur) + (fuel := fuel) havs.resolveAtoms hdecl hvalue hvalueGraphs + hsource hcombinedFrame hownCall hrun + have hownAfter : RootOwnership store' + (⟨d.result, result⟩ :: envRoots ++ rest) := + runOp_call_owned havs.resolveAtoms hdecl hownership hownCall hrun + obtain ⟨henvAfter, hrestAfter⟩ := + hcombinedAfter.splitAppend henvFrame.lengths + have houtputAfter : VEnvValueGraph funRel recSelfRel store' + output sourceOutput env envRoots := + houtput.ofRootsGraph henvAfter + refine ⟨⟨envRoots, result, houtputAfter.bump result, ?_, + hresultGraph, hrestAfter, hownAfter⟩, hslots.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +/-- State-indexed semantic `callSelf` primitive, parallel to +`call_graph_op` but entering the current declaration. -/ +theorem callSelf_graph_op + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {output : VEnv} {sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Owned} {avs : List AVal} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + {slots : List (Nat × RVal)} + (hownership : FnOwnershipContract ctx cur worlds) + (hvalue : FnValueContract funRel sourceCtx ctx cur worlds sourceFunction) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + OpSound ctx cur (.callSelf (avs.map (·.toAtom output)).toArray) + (GraphOwnsArgsResultProtected funRel recSelfRel output sourceOutput + sourceArgs worlds avs sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult cur.result (.slotA output.depth) sourceRest rest + slots) := by + intro fuel store env store' result hpre hrun + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + have henvFrame : Sim.RootsGraph funRel store + (entrySourceRoots output.entries sourceOutput) envRoots := + houtput.entries.rootsGraphExact + have hcombinedFrame : Sim.RootsGraph funRel store + (entrySourceRoots output.entries sourceOutput ++ sourceRest) + (envRoots ++ rest) := + henvFrame.append hrestGraph + have hownCall : RootOwnership store + (rootsForWorlds worlds values ++ (envRoots ++ rest)) := by + simpa [List.append_assoc] using hown + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + obtain ⟨hresultGraph, hcombinedAfter⟩ := + runOp_callSelf_value + (sourceCtx := sourceCtx) (ctx := ctx) (cur := cur) + (fuel := fuel) havs.resolveAtoms hvalue hvalueGraphs hsource + hcombinedFrame hownCall hrun + have hownAfter : RootOwnership store' + (⟨cur.result, result⟩ :: envRoots ++ rest) := + runOp_callSelf_owned havs.resolveAtoms hownership hownCall hrun + obtain ⟨henvAfter, hrestAfter⟩ := + hcombinedAfter.splitAppend henvFrame.lengths + have houtputAfter : VEnvValueGraph funRel recSelfRel store' + output sourceOutput env envRoots := + houtput.ofRootsGraph henvAfter + refine ⟨⟨envRoots, result, houtputAfter.bump result, ?_, + hresultGraph, hrestAfter, hownAfter⟩, hslots.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +/-- Consume a semantic argument vector through a direct call. The callee's +frame clause preserves the canonical environment roots and caller roots as +one concatenated graph; `VEnvValueGraph.ofRootsGraph` reconstructs the +unchanged logical environment after splitting that frame. -/ +theorem LowerArgsValueSound.call_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur d : FnDef} + {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Owned} {emit : Emit} {avs : List AVal} + {f : Ixon.Address} + (hargs : LowerArgsValueSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceArgs worlds emit avs) + (hdecl : ctx.decls f = some (.fn d)) + (hownership : FnOwnershipContract ctx d worlds) + (hvalue : FnValueContract funRel sourceCtx ctx d worlds sourceFunction) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + LowerResultValueSound funRel recSelfRel ctx cur + input output.bump sourceInput sourceOutput sourceResult d.result + (emit ∘ emitOp (.call f (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultSound := + hargs.toLowerArgsSound.call_owned hdecl hownership + graphEmits := ?_ } + intro sourceRest rest slots + apply EmitSound.comp (hargs.graphEmits sourceRest rest slots) + apply OpSound.emit + intro fuel store env store' result hpre hrun + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + have henvFrame : Sim.RootsGraph funRel store + (entrySourceRoots output.entries sourceOutput) envRoots := + houtput.entries.rootsGraphExact + have hcombinedFrame : Sim.RootsGraph funRel store + (entrySourceRoots output.entries sourceOutput ++ sourceRest) + (envRoots ++ rest) := + henvFrame.append hrestGraph + have hownCall : RootOwnership store + (rootsForWorlds worlds values ++ (envRoots ++ rest)) := by + simpa [List.append_assoc] using hown + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + obtain ⟨hresultGraph, hcombinedAfter⟩ := + runOp_call_value + (sourceCtx := sourceCtx) (ctx := ctx) (cur := cur) + (fuel := fuel) havs.resolveAtoms hdecl hvalue hvalueGraphs + hsource hcombinedFrame hownCall hrun + have hownAfter : RootOwnership store' + (⟨d.result, result⟩ :: envRoots ++ rest) := + runOp_call_owned havs.resolveAtoms hdecl hownership hownCall hrun + obtain ⟨henvAfter, hrestAfter⟩ := + hcombinedAfter.splitAppend henvFrame.lengths + have houtputAfter : VEnvValueGraph funRel recSelfRel store' + output sourceOutput env envRoots := + houtput.ofRootsGraph henvAfter + refine ⟨⟨envRoots, result, houtputAfter.bump result, ?_, + hresultGraph, hrestAfter, hownAfter⟩, hslots.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +/-- Fuel-bounded direct-call semantic consumer. -/ +theorem LowerArgsValueSoundBelow.call_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur d : FnDef} + {limit : Nat} {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Owned} {emit : Emit} {avs : List AVal} + {f : Ixon.Address} + (hargs : LowerArgsValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceArgs worlds emit avs) + (hdecl : ctx.decls f = some (.fn d)) + (hownership : FnOwnershipContractBelow ctx d worlds limit) + (hvalue : FnValueContractBelow funRel sourceCtx ctx d worlds + sourceFunction limit) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit + input output.bump sourceInput sourceOutput sourceResult d.result + (emit ∘ emitOp (.call f (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultSoundBelow := + hargs.toLowerArgsSoundBelow.call_owned hdecl hownership + graphEmits := ?_ } + intro sourceRest rest slots + apply EmitSoundBelow.comp (hargs.graphEmits sourceRest rest slots) + apply OpSoundBelow.emit + intro fuel store env store' result hfuel hpre hrun + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + have henvFrame : Sim.RootsGraph funRel store + (entrySourceRoots output.entries sourceOutput) envRoots := + houtput.entries.rootsGraphExact + have hcombinedFrame : Sim.RootsGraph funRel store + (entrySourceRoots output.entries sourceOutput ++ sourceRest) + (envRoots ++ rest) := + henvFrame.append hrestGraph + have hownCall : RootOwnership store + (rootsForWorlds worlds values ++ (envRoots ++ rest)) := by + simpa [List.append_assoc] using hown + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + have hvalueAt : ∀ {smaller : Nat}, smaller < fuel → + FnValuePreservesAt funRel sourceCtx ctx d worlds sourceFunction + smaller := by + intro smaller hsmaller + exact hvalue.preserves + (Nat.lt_trans hsmaller + (Nat.lt_trans (Nat.lt_succ_self fuel) hfuel)) + obtain ⟨hresultGraph, hcombinedAfter⟩ := + runOp_call_value_below + (sourceCtx := sourceCtx) (ctx := ctx) (cur := cur) + (fuel := fuel) havs.resolveAtoms hdecl hvalue.arity_eq hvalueAt + hvalueGraphs hsource hcombinedFrame hownCall hrun + have hownershipAt : FnOwnershipContractBelow ctx d worlds fuel := + hownership.mono (Nat.le_of_lt + (Nat.lt_trans (Nat.lt_succ_self fuel) hfuel)) + have hownAfter : RootOwnership store' + (⟨d.result, result⟩ :: envRoots ++ rest) := + runOp_call_owned_below havs.resolveAtoms hdecl hownershipAt + hownCall hrun + obtain ⟨henvAfter, hrestAfter⟩ := + hcombinedAfter.splitAppend henvFrame.lengths + have houtputAfter : VEnvValueGraph funRel recSelfRel store' + output sourceOutput env envRoots := + houtput.ofRootsGraph henvAfter + refine ⟨⟨envRoots, result, houtputAfter.bump result, ?_, + hresultGraph, hrestAfter, hownAfter⟩, hslots.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +/-- Recursive-self counterpart of `LowerArgsValueSound.call_graph`. -/ +theorem LowerArgsValueSound.callSelf_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Owned} {emit : Emit} {avs : List AVal} + (hargs : LowerArgsValueSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceArgs worlds emit avs) + (hownership : FnOwnershipContract ctx cur worlds) + (hvalue : FnValueContract funRel sourceCtx ctx cur worlds sourceFunction) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + LowerResultValueSound funRel recSelfRel ctx cur + input output.bump sourceInput sourceOutput sourceResult cur.result + (emit ∘ emitOp + (.callSelf (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultSound := + hargs.toLowerArgsSound.callSelf_owned hownership + graphEmits := ?_ } + intro sourceRest rest slots + apply EmitSound.comp (hargs.graphEmits sourceRest rest slots) + apply OpSound.emit + intro fuel store env store' result hpre hrun + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + have henvFrame : Sim.RootsGraph funRel store + (entrySourceRoots output.entries sourceOutput) envRoots := + houtput.entries.rootsGraphExact + have hcombinedFrame : Sim.RootsGraph funRel store + (entrySourceRoots output.entries sourceOutput ++ sourceRest) + (envRoots ++ rest) := + henvFrame.append hrestGraph + have hownCall : RootOwnership store + (rootsForWorlds worlds values ++ (envRoots ++ rest)) := by + simpa [List.append_assoc] using hown + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + obtain ⟨hresultGraph, hcombinedAfter⟩ := + runOp_callSelf_value + (sourceCtx := sourceCtx) (ctx := ctx) (cur := cur) + (fuel := fuel) havs.resolveAtoms hvalue hvalueGraphs hsource + hcombinedFrame hownCall hrun + have hownAfter : RootOwnership store' + (⟨cur.result, result⟩ :: envRoots ++ rest) := + runOp_callSelf_owned havs.resolveAtoms hownership hownCall hrun + obtain ⟨henvAfter, hrestAfter⟩ := + hcombinedAfter.splitAppend henvFrame.lengths + have houtputAfter : VEnvValueGraph funRel recSelfRel store' + output sourceOutput env envRoots := + houtput.ofRootsGraph henvAfter + refine ⟨⟨envRoots, result, houtputAfter.bump result, ?_, + hresultGraph, hrestAfter, hownAfter⟩, hslots.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +/-- Fuel-bounded recursive-self semantic consumer. -/ +theorem LowerArgsValueSoundBelow.callSelf_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Owned} {emit : Emit} {avs : List AVal} + (hargs : LowerArgsValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceArgs worlds emit avs) + (hownership : FnOwnershipContractBelow ctx cur worlds limit) + (hvalue : FnValueContractBelow funRel sourceCtx ctx cur worlds + sourceFunction limit) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit + input output.bump sourceInput sourceOutput sourceResult cur.result + (emit ∘ emitOp + (.callSelf (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultSoundBelow := + hargs.toLowerArgsSoundBelow.callSelf_owned hownership + graphEmits := ?_ } + intro sourceRest rest slots + apply EmitSoundBelow.comp (hargs.graphEmits sourceRest rest slots) + apply OpSoundBelow.emit + intro fuel store env store' result hfuel hpre hrun + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + have henvFrame : Sim.RootsGraph funRel store + (entrySourceRoots output.entries sourceOutput) envRoots := + houtput.entries.rootsGraphExact + have hcombinedFrame : Sim.RootsGraph funRel store + (entrySourceRoots output.entries sourceOutput ++ sourceRest) + (envRoots ++ rest) := + henvFrame.append hrestGraph + have hownCall : RootOwnership store + (rootsForWorlds worlds values ++ (envRoots ++ rest)) := by + simpa [List.append_assoc] using hown + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + have hvalueAt : ∀ {smaller : Nat}, smaller < fuel + 1 → + FnValuePreservesAt funRel sourceCtx ctx cur worlds sourceFunction + smaller := by + intro smaller hsmaller + exact hvalue.preserves (Nat.lt_trans hsmaller hfuel) + obtain ⟨hresultGraph, hcombinedAfter⟩ := + runOp_callSelf_value_below + (sourceCtx := sourceCtx) (ctx := ctx) (cur := cur) + (fuel := fuel) havs.resolveAtoms hvalue.arity_eq hvalueAt + hvalueGraphs hsource hcombinedFrame hownCall hrun + have hownershipAt : FnOwnershipContractBelow ctx cur worlds + (fuel + 1) := + hownership.mono (Nat.le_of_lt hfuel) + have hownAfter : RootOwnership store' + (⟨cur.result, result⟩ :: envRoots ++ rest) := + runOp_callSelf_owned_below havs.resolveAtoms hownershipAt + hownCall hrun + obtain ⟨henvAfter, hrestAfter⟩ := + hcombinedAfter.splitAppend henvFrame.lengths + have houtputAfter : VEnvValueGraph funRel recSelfRel store' + output sourceOutput env envRoots := + houtput.ofRootsGraph henvAfter + refine ⟨⟨envRoots, result, houtputAfter.bump result, ?_, + hresultGraph, hrestAfter, hownAfter⟩, hslots.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +/-- Recursive-self call where the callee's source identity is supplied by a +synthetic `recSelf` environment entry. The relation witness is intentionally +recovered inside the semantic precondition; no runtime slot represents this +entry, so it cannot be selected by an ordinary `ValueGraph` lookup. -/ +theorem LowerArgsValueSound.callSelf_entry_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {input output : VEnv} {index arity : Nat} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Owned} {emit : Emit} {avs : List AVal} + (hargs : LowerArgsValueSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceArgs worlds emit avs) + (hentry : input.entries[index]? = some (.recSelf arity)) + (hhead : sourceInput[index]? = some sourceFunction) + (hownership : FnOwnershipContract ctx cur worlds) + (hvalue : recSelfRel sourceFunction arity → + FnValueContract funRel sourceCtx ctx cur worlds sourceFunction) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + LowerResultValueSound funRel recSelfRel ctx cur + input output.bump sourceInput sourceOutput sourceResult cur.result + (emit ∘ emitOp + (.callSelf (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultSound := + hargs.toLowerArgsSound.callSelf_owned hownership + graphEmits := ?_ } + intro sourceRest rest slots post code hcode + intro fuel store env finalStore finalValue hpre hrun + obtain ⟨⟨envRoots, hinput, hrestGraph, hown⟩, hslots⟩ := hpre + obtain ⟨source, hsourceLookup, hself⟩ := + hinput.getRecSelf hentry + have hsourceEq : source = sourceFunction := by + rw [hhead] at hsourceLookup + exact (Option.some.inj hsourceLookup).symm + subst source + have hsound := hargs.callSelf_graph hownership (hvalue hself) hsource + exact hsound.graphEmits sourceRest rest slots post code hcode + ⟨⟨envRoots, hinput, hrestGraph, hown⟩, hslots⟩ hrun + +/-- Fuel-bounded recursive-self call where the source identity is recovered +from the synthetic `recSelf` environment entry. -/ +theorem LowerArgsValueSoundBelow.callSelf_entry_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {input output : VEnv} {index arity : Nat} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {worlds : List Owned} {emit : Emit} {avs : List AVal} + (hargs : LowerArgsValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceArgs worlds emit avs) + (hentry : input.entries[index]? = some (.recSelf arity)) + (hhead : sourceInput[index]? = some sourceFunction) + (hownership : FnOwnershipContractBelow ctx cur worlds limit) + (hvalue : recSelfRel sourceFunction arity → + FnValueContractBelow funRel sourceCtx ctx cur worlds sourceFunction + limit) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit + input output.bump sourceInput sourceOutput sourceResult cur.result + (emit ∘ emitOp + (.callSelf (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultSoundBelow := + hargs.toLowerArgsSoundBelow.callSelf_owned hownership + graphEmits := ?_ } + intro sourceRest rest slots bound hbound post code hcode + intro fuel store env finalStore finalValue hfuel hpre hrun + obtain ⟨⟨envRoots, hinput, hrestGraph, hown⟩, hslots⟩ := hpre + obtain ⟨source, hsourceLookup, hself⟩ := + hinput.getRecSelf hentry + have hsourceEq : source = sourceFunction := by + rw [hhead] at hsourceLookup + exact (Option.some.inj hsourceLookup).symm + subst source + have hsound := hargs.callSelf_graph hownership (hvalue hself) hsource + exact hsound.graphEmits sourceRest rest slots bound hbound post code hcode + hfuel ⟨⟨envRoots, hinput, hrestGraph, hown⟩, hslots⟩ hrun + +/-- Operation-level semantic scalar extern call. -/ +theorem extern_graph_op + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {output : VEnv} {sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {avs : List AVal} {f : Ixon.Address} {arity : Nat} + {resultWorld : Owned} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + {slots : List (Nat × RVal)} + (hcontract : ExternValueContract funRel sourceCtx ctx) + (hlookup : sourceCtx.env f = some (.extern arity)) + (href : SourceRefValue sourceCtx f sourceFunction) + (hlength : sourceArgs.length = arity) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + OpSound ctx cur (.extern f (avs.map (·.toAtom output)).toArray) + (GraphOwnsArgsResultProtected funRel recSelfRel output sourceOutput + sourceArgs (List.replicate avs.length .shared) avs sourceRest rest + slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult resultWorld (.slotA output.depth) sourceRest rest + slots) := by + intro fuel store env store' result hpre hrun + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + have hvaluesLength : values.length = avs.length := + havs.lengths.2.symm + have hroots : + rootsForWorlds (List.replicate avs.length .shared) values = + rootsFor .shared values := + rootsForWorlds_replicate_eq_rootsFor .shared hvaluesLength + have hownExtern : RootOwnership store + (rootsFor .shared values ++ (envRoots ++ rest)) := by + simpa [hroots, List.append_assoc] using hown + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + have hownAfter : RootOwnership store' + (⟨resultWorld, result⟩ :: envRoots ++ rest) := + runOp_extern_owned havs.resolveAtoms hownExtern hrun + obtain ⟨hstore, hresultGraph⟩ := + runOp_extern_value + (sourceCtx := sourceCtx) (ctx := ctx) (cur := cur) + (fuel := fuel) havs.resolveAtoms hcontract hlookup href hlength + hsource hvalueGraphs hrun + subst store' + refine ⟨⟨envRoots, result, houtput.bump result, ?_, + hresultGraph, hrestGraph, hownAfter⟩, hslots.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +/-- Consume a homogeneous shared argument prefix through the scalar extern +ABI while preserving its source result. Since the ABI rejects locations and +does not modify the store, both the semantic environment and caller frame +remain valid without a heap transport step. -/ +theorem LowerArgsValueSound.extern_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {emit : Emit} {avs : List AVal} {f : Ixon.Address} + {arity : Nat} {resultWorld : Owned} + (hargs : LowerArgsValueSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceArgs + (List.replicate avs.length .shared) emit avs) + (hcontract : ExternValueContract funRel sourceCtx ctx) + (hlookup : sourceCtx.env f = some (.extern arity)) + (href : SourceRefValue sourceCtx f sourceFunction) + (hlength : sourceArgs.length = arity) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + LowerResultValueSound funRel recSelfRel ctx cur + input output.bump sourceInput sourceOutput sourceResult resultWorld + (emit ∘ emitOp (.extern f (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultSound := hargs.toLowerArgsSound.extern_owned + graphEmits := ?_ } + intro sourceRest rest slots + apply EmitSound.comp (hargs.graphEmits sourceRest rest slots) + apply OpSound.emit + intro fuel store env store' result hpre hrun + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + have hvaluesLength : values.length = avs.length := + havs.lengths.2.symm + have hroots : + rootsForWorlds (List.replicate avs.length .shared) values = + rootsFor .shared values := + rootsForWorlds_replicate_eq_rootsFor .shared hvaluesLength + have hownExtern : RootOwnership store + (rootsFor .shared values ++ (envRoots ++ rest)) := by + simpa [hroots, List.append_assoc] using hown + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + have hownAfter : RootOwnership store' + (⟨resultWorld, result⟩ :: envRoots ++ rest) := + runOp_extern_owned havs.resolveAtoms hownExtern hrun + obtain ⟨hstore, hresultGraph⟩ := + runOp_extern_value + (sourceCtx := sourceCtx) (ctx := ctx) (cur := cur) + (fuel := fuel) havs.resolveAtoms hcontract hlookup href hlength + hsource hvalueGraphs hrun + subst store' + refine ⟨⟨envRoots, result, houtput.bump result, ?_, + hresultGraph, hrestGraph, hownAfter⟩, hslots.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +theorem LowerArgsValueSoundBelow.extern_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {emit : Emit} {avs : List AVal} {f : Ixon.Address} + {arity : Nat} {resultWorld : Owned} + (hargs : LowerArgsValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceArgs + (List.replicate avs.length .shared) emit avs) + (hcontract : ExternValueContract funRel sourceCtx ctx) + (hlookup : sourceCtx.env f = some (.extern arity)) + (href : SourceRefValue sourceCtx f sourceFunction) + (hlength : sourceArgs.length = arity) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit + input output.bump sourceInput sourceOutput sourceResult resultWorld + (emit ∘ emitOp (.extern f (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultSoundBelow := hargs.toLowerArgsSoundBelow.extern_owned + graphEmits := ?_ } + intro sourceRest rest slots + apply EmitSoundBelow.comp (hargs.graphEmits sourceRest rest slots) + apply OpSoundBelow.emit + intro fuel store env store' result _ hpre hrun + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + have hvaluesLength : values.length = avs.length := + havs.lengths.2.symm + have hroots : + rootsForWorlds (List.replicate avs.length .shared) values = + rootsFor .shared values := + rootsForWorlds_replicate_eq_rootsFor .shared hvaluesLength + have hownExtern : RootOwnership store + (rootsFor .shared values ++ (envRoots ++ rest)) := by + simpa [hroots, List.append_assoc] using hown + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + have hownAfter : RootOwnership store' + (⟨resultWorld, result⟩ :: envRoots ++ rest) := + runOp_extern_owned havs.resolveAtoms hownExtern hrun + obtain ⟨hstore, hresultGraph⟩ := + runOp_extern_value + (sourceCtx := sourceCtx) (ctx := ctx) (cur := cur) + (fuel := fuel) havs.resolveAtoms hcontract hlookup href hlength + hsource hvalueGraphs hrun + subst store' + refine ⟨⟨envRoots, result, houtput.bump result, ?_, + hresultGraph, hrestGraph, hownAfter⟩, hslots.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +/-- Operation-level semantic higher-order application from the protected +post-argument state. The original realization witness fixes the runtime +value of stable constant descriptors; slot descriptors are reconstructed +from the protected absolute slot carried through argument lowering. -/ +theorem apply_graph_op + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {functionInput output : VEnv} {functionEnv : List RVal} + {sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {avs : List AVal} {function : AVal} {functionValue : RVal} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + {slots : List (Nat × RVal)} + (hfunctionStable : AValStable function) + (hfunction : AValRealizes functionInput functionEnv function + functionValue) + (hownership : ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + OpSound ctx cur + (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray) + (GraphOwnsArgsResultProtected funRel recSelfRel output + sourceOutput sourceArgs (List.replicate avs.length .shared) avs + ((.shared, sourceFunction) :: sourceRest) + (⟨.shared, functionValue⟩ :: rest) + (aValProtection function functionValue ++ slots)) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult .shared (.slotA output.depth) sourceRest rest slots) := by + intro opFuel argsStore argsEnv store' result hargsPost hrunOp + obtain ⟨⟨outRoots, values, houtput, havs, hvalueGraphs, + hframeGraphFinal, hownArgs⟩, hslotsOut⟩ := hargsPost + cases hframeGraphFinal with + | cons _ hfunctionWorldFinal hfunctionGraphFinal hrestGraphFinal => + have hfunctionFinal : + AValRealizes output argsEnv function functionValue := + hfunctionStable.realize_of_protection hfunction + hslotsOut.left_of_append + have hvaluesLength : values.length = avs.length := + havs.lengths.2.symm + have hroots : + rootsForWorlds (List.replicate avs.length .shared) values = + rootsFor .shared values := + rootsForWorlds_replicate_eq_rootsFor .shared hvaluesLength + have hownApply : RootOwnership argsStore + (⟨.shared, functionValue⟩ :: rootsFor .shared values ++ + (outRoots ++ rest)) := by + apply hownArgs.perm + simpa [hroots, List.append_assoc] using + (perm_extract_root ⟨.shared, functionValue⟩ + (rootsForWorlds (List.replicate avs.length .shared) values ++ + outRoots) [] rest) + have henvFrame : Sim.RootsGraph funRel argsStore + (entrySourceRoots output.entries sourceOutput) outRoots := + houtput.entries.rootsGraphExact + have hcombinedFrame : Sim.RootsGraph funRel argsStore + (entrySourceRoots output.entries sourceOutput ++ sourceRest) + (outRoots ++ rest) := + henvFrame.append hrestGraphFinal + cases opFuel with + | zero => simp [runOp] at hrunOp + | succ opFuel => + obtain ⟨hresultGraph, hcombinedAfter⟩ := + runOp_apply_value + (sourceCtx := sourceCtx) (ctx := ctx) (cur := cur) + (fuel := opFuel) hfunctionFinal.resolveAtom havs.resolveAtoms + hvalue (by simpa using hfunctionGraphFinal) hvalueGraphs hsource + hcombinedFrame hownApply hrunOp + have hownAfter : RootOwnership store' + (⟨.shared, result⟩ :: outRoots ++ rest) := + runOp_apply_owned hfunctionFinal.resolveAtom havs.resolveAtoms + hownership hownApply hrunOp + obtain ⟨henvAfter, hrestAfter⟩ := + hcombinedAfter.splitAppend henvFrame.lengths + have houtputAfter : VEnvValueGraph funRel recSelfRel store' + output sourceOutput argsEnv outRoots := + houtput.ofRootsGraph henvAfter + refine ⟨⟨outRoots, result, houtputAfter.bump result, ?_, + hresultGraph, hrestAfter, hownAfter⟩, + hslotsOut.right_of_append.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +/-- Lower shared arguments while semantically framing an already-produced +function, then consume the function and arguments through the higher-order +application contracts. -/ +theorem LowerArgsValueSound.apply_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {emit : Emit} {avs : List AVal} {function : AVal} + (hargs : LowerArgsValueSound funRel recSelfRel ctx cur + input output sourceInput sourceOutput sourceArgs + (List.replicate avs.length .shared) emit avs) + (hfunctionStable : AValStable function) + (hownership : ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + ∀ sourceRest rest slots, + EmitSound ctx cur + (emit ∘ emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (GraphOwnsResultProtected funRel recSelfRel input sourceInput + sourceFunction .shared function sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult .shared (.slotA output.depth) + sourceRest rest slots) := by + intro sourceRest rest slots post code hcode + intro fuel store env finalStore finalValue hfunctionPre hrun + obtain ⟨⟨envRoots, functionValue, hinput, hfunction, + hfunctionGraph, hrestGraph, hownFunction⟩, hslots⟩ := hfunctionPre + let functionRoot : Root := ⟨.shared, functionValue⟩ + have hfunctionWorld : HasWorld store .shared functionValue := + hownFunction.roots_world functionRoot (by simp [functionRoot]) + have hframeGraph : Sim.RootsGraph funRel store + ((.shared, sourceFunction) :: sourceRest) (functionRoot :: rest) := + .cons rfl hfunctionWorld hfunctionGraph hrestGraph + have hfunctionProtection : + SlotsRealize input env (aValProtection function functionValue) := + hfunctionStable.protection_realized hfunction + have hargsOwn : RootOwnership store (envRoots ++ functionRoot :: rest) := by + apply hownFunction.perm + simpa [functionRoot] using + (perm_extract_root functionRoot envRoots [] rest).symm + have hargsPre : GraphOwnsVEnvProtected funRel recSelfRel input + sourceInput ((.shared, sourceFunction) :: sourceRest) + (functionRoot :: rest) + (aValProtection function functionValue ++ slots) store env := + ⟨⟨envRoots, hinput, hframeGraph, hargsOwn⟩, + hfunctionProtection.append hslots⟩ + have happlySound : EmitSound ctx cur + (emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (GraphOwnsArgsResultProtected funRel recSelfRel output + sourceOutput sourceArgs (List.replicate avs.length .shared) avs + ((.shared, sourceFunction) :: sourceRest) (functionRoot :: rest) + (aValProtection function functionValue ++ slots)) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult .shared (.slotA output.depth) + sourceRest rest slots) := by + apply OpSound.emit + intro opFuel argsStore argsEnv store' result hargsPost hrunOp + obtain ⟨⟨outRoots, values, houtput, havs, hvalueGraphs, + hframeGraphFinal, hownArgs⟩, hslotsOut⟩ := hargsPost + cases hframeGraphFinal with + | cons _ hfunctionWorldFinal hfunctionGraphFinal hrestGraphFinal => + have hfunctionFinal : + AValRealizes output argsEnv function functionValue := + hfunctionStable.realize_of_protection hfunction + hslotsOut.left_of_append + have hfunctionGraph' : Sim.ValueGraph funRel argsStore + sourceFunction functionValue := by + simpa [functionRoot] using hfunctionGraphFinal + have hvaluesLength : values.length = avs.length := + havs.lengths.2.symm + have hroots : + rootsForWorlds (List.replicate avs.length .shared) values = + rootsFor .shared values := + rootsForWorlds_replicate_eq_rootsFor .shared hvaluesLength + have hownApply : RootOwnership argsStore + (functionRoot :: rootsFor .shared values ++ + (outRoots ++ rest)) := by + apply hownArgs.perm + simpa [functionRoot, hroots, List.append_assoc] using + (perm_extract_root functionRoot + (rootsForWorlds (List.replicate avs.length .shared) values ++ + outRoots) [] rest) + have henvFrame : Sim.RootsGraph funRel argsStore + (entrySourceRoots output.entries sourceOutput) outRoots := + houtput.entries.rootsGraphExact + have hcombinedFrame : Sim.RootsGraph funRel argsStore + (entrySourceRoots output.entries sourceOutput ++ sourceRest) + (outRoots ++ rest) := + henvFrame.append hrestGraphFinal + cases opFuel with + | zero => simp [runOp] at hrunOp + | succ opFuel => + obtain ⟨hresultGraph, hcombinedAfter⟩ := + runOp_apply_value + (sourceCtx := sourceCtx) (ctx := ctx) (cur := cur) + (fuel := opFuel) hfunctionFinal.resolveAtom havs.resolveAtoms + hvalue hfunctionGraph' hvalueGraphs hsource hcombinedFrame + hownApply hrunOp + have hownAfter : RootOwnership store' + (⟨.shared, result⟩ :: outRoots ++ rest) := + runOp_apply_owned hfunctionFinal.resolveAtom havs.resolveAtoms + hownership hownApply hrunOp + obtain ⟨henvAfter, hrestAfter⟩ := + hcombinedAfter.splitAppend henvFrame.lengths + have houtputAfter : VEnvValueGraph funRel recSelfRel store' + output sourceOutput argsEnv outRoots := + houtput.ofRootsGraph henvAfter + refine ⟨⟨outRoots, result, houtputAfter.bump result, ?_, + hresultGraph, hrestAfter, hownAfter⟩, + hslotsOut.right_of_append.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + have hargsCont : CodeOwns ctx cur + (GraphOwnsArgsResultProtected funRel recSelfRel output + sourceOutput sourceArgs (List.replicate avs.length .shared) avs + ((.shared, sourceFunction) :: sourceRest) (functionRoot :: rest) + (aValProtection function functionValue ++ slots)) + post (emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray) code) := + happlySound post code hcode + have hargsCode : CodeOwns ctx cur + (GraphOwnsVEnvProtected funRel recSelfRel input sourceInput + ((.shared, sourceFunction) :: sourceRest) (functionRoot :: rest) + (aValProtection function functionValue ++ slots)) + post + (emit (emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray) code)) := + hargs.graphEmits ((.shared, sourceFunction) :: sourceRest) + (functionRoot :: rest) + (aValProtection function functionValue ++ slots) + post _ hargsCont + exact hargsCode hargsPre hrun + +/-- Fuel-bounded higher-order application after shared argument lowering. -/ +theorem LowerArgsValueSoundBelow.apply_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {input output : VEnv} + {sourceInput sourceOutput sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {emit : Emit} {avs : List AVal} {function : AVal} + (hargs : LowerArgsValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceArgs + (List.replicate avs.length .shared) emit avs) + (hfunctionStable : AValStable function) + (hownership : ApplyOwnershipContractBelow ctx limit) + (hvalue : ApplyValueContractBelow funRel sourceCtx ctx limit) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + ∀ sourceRest rest slots, + EmitSoundBelow ctx cur limit + (emit ∘ emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (GraphOwnsResultProtected funRel recSelfRel input sourceInput + sourceFunction .shared function sourceRest rest slots) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult .shared (.slotA output.depth) + sourceRest rest slots) := by + intro sourceRest rest slots bound hbound post code hcode + intro fuel store env finalStore finalValue hfuel hfunctionPre hrun + obtain ⟨⟨envRoots, functionValue, hinput, hfunction, + hfunctionGraph, hrestGraph, hownFunction⟩, hslots⟩ := hfunctionPre + let functionRoot : Root := ⟨.shared, functionValue⟩ + have hfunctionWorld : HasWorld store .shared functionValue := + hownFunction.roots_world functionRoot (by simp [functionRoot]) + have hframeGraph : Sim.RootsGraph funRel store + ((.shared, sourceFunction) :: sourceRest) (functionRoot :: rest) := + .cons rfl hfunctionWorld hfunctionGraph hrestGraph + have hfunctionProtection : + SlotsRealize input env (aValProtection function functionValue) := + hfunctionStable.protection_realized hfunction + have hargsOwn : RootOwnership store (envRoots ++ functionRoot :: rest) := by + apply hownFunction.perm + simpa [functionRoot] using + (perm_extract_root functionRoot envRoots [] rest).symm + have hargsPre : GraphOwnsVEnvProtected funRel recSelfRel input + sourceInput ((.shared, sourceFunction) :: sourceRest) + (functionRoot :: rest) + (aValProtection function functionValue ++ slots) store env := + ⟨⟨envRoots, hinput, hframeGraph, hargsOwn⟩, + hfunctionProtection.append hslots⟩ + have happlySound : EmitSoundBelow ctx cur limit + (emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (GraphOwnsArgsResultProtected funRel recSelfRel output + sourceOutput sourceArgs (List.replicate avs.length .shared) avs + ((.shared, sourceFunction) :: sourceRest) (functionRoot :: rest) + (aValProtection function functionValue ++ slots)) + (GraphOwnsResultProtected funRel recSelfRel output.bump sourceOutput + sourceResult .shared (.slotA output.depth) + sourceRest rest slots) := by + apply OpSoundBelow.emit + intro opFuel argsStore argsEnv store' result hopFuel hargsPost hrunOp + obtain ⟨⟨outRoots, values, houtput, havs, hvalueGraphs, + hframeGraphFinal, hownArgs⟩, hslotsOut⟩ := hargsPost + cases hframeGraphFinal with + | cons _ hfunctionWorldFinal hfunctionGraphFinal hrestGraphFinal => + have hfunctionFinal : + AValRealizes output argsEnv function functionValue := + hfunctionStable.realize_of_protection hfunction + hslotsOut.left_of_append + have hfunctionGraph' : Sim.ValueGraph funRel argsStore + sourceFunction functionValue := by + simpa [functionRoot] using hfunctionGraphFinal + have hvaluesLength : values.length = avs.length := + havs.lengths.2.symm + have hroots : + rootsForWorlds (List.replicate avs.length .shared) values = + rootsFor .shared values := + rootsForWorlds_replicate_eq_rootsFor .shared hvaluesLength + have hownApply : RootOwnership argsStore + (functionRoot :: rootsFor .shared values ++ + (outRoots ++ rest)) := by + apply hownArgs.perm + simpa [functionRoot, hroots, List.append_assoc] using + (perm_extract_root functionRoot + (rootsForWorlds (List.replicate avs.length .shared) values ++ + outRoots) [] rest) + have henvFrame : Sim.RootsGraph funRel argsStore + (entrySourceRoots output.entries sourceOutput) outRoots := + houtput.entries.rootsGraphExact + have hcombinedFrame : Sim.RootsGraph funRel argsStore + (entrySourceRoots output.entries sourceOutput ++ sourceRest) + (outRoots ++ rest) := + henvFrame.append hrestGraphFinal + cases opFuel with + | zero => simp [runOp] at hrunOp + | succ opFuel => + have hvalueAt : ApplyValueContractBelow funRel sourceCtx ctx + (opFuel + 1) := + hvalue.mono (Nat.le_of_lt hopFuel) + obtain ⟨hresultGraph, hcombinedAfter⟩ := + runOp_apply_value_below + (sourceCtx := sourceCtx) (ctx := ctx) (cur := cur) + (fuel := opFuel) hfunctionFinal.resolveAtom havs.resolveAtoms + hvalueAt hfunctionGraph' hvalueGraphs hsource hcombinedFrame + hownApply hrunOp + have hownershipAt : ApplyOwnershipContractBelow ctx + (opFuel + 1) := + hownership.mono (Nat.le_of_lt hopFuel) + have hownAfter : RootOwnership store' + (⟨.shared, result⟩ :: outRoots ++ rest) := + runOp_apply_owned_below hfunctionFinal.resolveAtom + havs.resolveAtoms hownershipAt hownApply hrunOp + obtain ⟨henvAfter, hrestAfter⟩ := + hcombinedAfter.splitAppend henvFrame.lengths + have houtputAfter : VEnvValueGraph funRel recSelfRel store' + output sourceOutput argsEnv outRoots := + houtput.ofRootsGraph henvAfter + refine ⟨⟨outRoots, result, houtputAfter.bump result, ?_, + hresultGraph, hrestAfter, hownAfter⟩, + hslotsOut.right_of_append.bump result⟩ + apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + have hargsCont : CodeOwnsBelow ctx cur bound + (GraphOwnsArgsResultProtected funRel recSelfRel output + sourceOutput sourceArgs (List.replicate avs.length .shared) avs + ((.shared, sourceFunction) :: sourceRest) (functionRoot :: rest) + (aValProtection function functionValue ++ slots)) + post (emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray) code) := + happlySound bound hbound post code hcode + have hargsCode : CodeOwnsBelow ctx cur bound + (GraphOwnsVEnvProtected funRel recSelfRel input sourceInput + ((.shared, sourceFunction) :: sourceRest) (functionRoot :: rest) + (aValProtection function functionValue ++ slots)) + post + (emit (emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray) code)) := + hargs.graphEmits ((.shared, sourceFunction) :: sourceRest) + (functionRoot :: rest) + (aValProtection function functionValue ++ slots) + bound hbound post _ hargsCont + exact hargsCode hfuel hargsPre hrun + +/-- Fuel-bounded full non-erased semantic application composition. -/ +theorem LowerResultValueSoundBelow.applyArgs_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {start input output : VEnv} + {sourceStart sourceMiddle sourceOutput sourceArgs : + List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {emitFunction emitArgs : Emit} {function : AVal} {avs : List AVal} + (hfunction : LowerResultValueSoundBelow funRel recSelfRel ctx cur limit + start input sourceStart sourceMiddle sourceFunction .shared + emitFunction function) + (hargs : LowerArgsValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceMiddle sourceOutput sourceArgs + (List.replicate avs.length .shared) emitArgs avs) + (hownership : ApplyOwnershipContractBelow ctx limit) + (hvalue : ApplyValueContractBelow funRel sourceCtx ctx limit) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit + start output.bump sourceStart sourceOutput sourceResult .shared + ((emitFunction ∘ emitArgs) ∘ + emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultSoundBelow := hfunction.toLowerResultSoundBelow.applyArgs + hargs.toLowerArgsSoundBelow hownership + graphEmits := ?_ } + intro sourceRest rest slots + have hcomposed := EmitSoundBelow.comp + (hfunction.graphEmits sourceRest rest slots) + (hargs.apply_graph hfunction.stable hownership hvalue hsource + sourceRest rest slots) + simpa [Function.comp_def] using hcomposed + +/-- Full non-erased semantic application composition: produce the function, +evaluate its shared arguments left-to-right, and relate the target `apply` +result to the source n-ary application result. -/ +theorem LowerResultValueSound.applyArgs_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {start input output : VEnv} + {sourceStart sourceMiddle sourceOutput sourceArgs : + List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {emitFunction emitArgs : Emit} {function : AVal} {avs : List AVal} + (hfunction : LowerResultValueSound funRel recSelfRel ctx cur + start input sourceStart sourceMiddle sourceFunction .shared + emitFunction function) + (hargs : LowerArgsValueSound funRel recSelfRel ctx cur + input output sourceMiddle sourceOutput sourceArgs + (List.replicate avs.length .shared) emitArgs avs) + (hownership : ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + LowerResultValueSound funRel recSelfRel ctx cur + start output.bump sourceStart sourceOutput sourceResult .shared + ((emitFunction ∘ emitArgs) ∘ + emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultSound := hfunction.toLowerResultSound.applyArgs + hargs.toLowerArgsSound hownership + graphEmits := ?_ } + intro sourceRest rest slots + have hcomposed := EmitSound.comp + (hfunction.graphEmits sourceRest rest slots) + (hargs.apply_graph hfunction.stable hownership hvalue hsource + sourceRest rest slots) + simpa [Function.comp_def] using hcomposed + +/-- Executable non-erased `applyRest` branch with semantic higher-order +application. -/ +theorem applyRest_shared_value_verified + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) (start input output : VEnv) + (sourceStart sourceMiddle sourceOutput sourceArgs : + List IxIR0.Value) + (sourceFunction sourceResult : IxIR0.Value) + (emitFunction emitArgs : Emit) (function : AVal) + (args : List IxIR0.Expr) (avs : List AVal) + (state finalState : LowSt) + (hfunctionNe : function ≠ .constA .erased) + (hargsRun : + (lowerArgs src fuel input + (args.map (fun arg => (arg, Owned.shared)))).run state = + .ok (output, emitArgs, avs) finalState) + (hargsSound : LowerArgsValueSound funRel recSelfRel ctx cur + input output sourceMiddle sourceOutput sourceArgs + (List.replicate avs.length .shared) emitArgs avs) + (hfunction : LowerResultValueSound funRel recSelfRel ctx cur + start input sourceStart sourceMiddle sourceFunction .shared + emitFunction function) + (hownership : ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) : + (applyRest src (Nat.succ fuel) input .shared emitFunction function + args).run state = + .ok (output.bump, + (emitFunction ∘ emitArgs) ∘ + emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray), + .slotA output.depth) finalState ∧ + LowerResultValueSound funRel recSelfRel ctx cur start output.bump + sourceStart sourceOutput sourceResult .shared + ((emitFunction ∘ emitArgs) ∘ + emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + constructor + · simp only [applyRest] + have hrequire : + (requireResultWorld .shared .shared).run state = .ok () state := by + rfl + rw [estateBindRun, hrequire] + simp only + rw [estateBindRun, hargsRun] + rfl + · exact hfunction.applyArgs_graph hargsSound hownership hvalue hsource + +/-- Source-neutral operational inversion for successful non-erased +`applyRest` runs. The result family keeps ownership, semantic, profile, and +reachable clients separate while the result-world guard, argument run, +homogeneous-world normalization, and final slot recovery remain canonical. -/ +theorem applyRest_nonErased_run_core + {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} + {resultWorld : Owned} {pre emit : Emit} {function av : AVal} + {args : List IxIR0.Expr} {state finalState : LowSt} + {Result : Owned → VEnv → Emit → AVal → LowSt → Prop} + (hfinish : ∀ (argsOutput : VEnv) (emitArgs : Emit) + (avs : List AVal) (argsState : LowSt), + (lowerArgs src fuel input + (args.map (fun arg => (arg, Owned.shared)))).run state = + .ok (argsOutput, emitArgs, avs) argsState → + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate avs.length .shared → + Result .shared argsOutput.bump + ((pre ∘ emitArgs) ∘ + emitOp (.apply (function.toAtom argsOutput) + (avs.map (·.toAtom argsOutput)).toArray)) + (.slotA argsOutput.depth) argsState) + (hfunctionNe : function ≠ .constA .erased) + (hrun : (applyRest src (fuel + 1) input resultWorld pre function + args).run state = .ok (output, emit, av) finalState) : + Result resultWorld output emit av finalState := by + simp only [applyRest] at hrun + cases resultWorld with + | unique => + have hrequire : + (requireResultWorld .shared .unique).run state = + .error "call result is shared at unique demand" state := by + rfl + rw [estateBindRun, hrequire] at hrun + contradiction + | shared => + have hrequire : + (requireResultWorld .shared .shared).run state = .ok () state := by + rfl + rw [estateBindRun, hrequire] at hrun + simp only at hrun + obtain ⟨argsResult, argsState, hargsRun, hpureRun⟩ := + estateBindRun_ok_inv hrun + rcases argsResult with ⟨argsOutput, emitArgs, avs⟩ + have hpure : + (argsOutput.bump, + (pre ∘ emitArgs) ∘ + emitOp (.apply (function.toAtom argsOutput) + (avs.map (·.toAtom argsOutput)).toArray), + AVal.slotA argsOutput.depth) = (output, emit, av) ∧ + argsState = finalState := by + simpa [Function.comp_def] using hpureRun + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + have havsLength : avs.length = args.length := by + simpa using lowerArgs_success_length src hargsRun + have hworldsHomogeneous : + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate avs.length .shared := by + simpa [havsLength] using map_shared_arg_worlds args + exact hfinish argsOutput emitArgs avs argsState hargsRun + hworldsHomogeneous + +/-- Semantic inversion of any successful non-erased `applyRest` run. The +argument correspondence is obtained from `LowerArgsValuePreserves`, and the +successful result-world guard forces the shared result required by target +`apply`. This is the tail consumer used by over-applied known calls. -/ +theorem applyRest_nonErased_run_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsValuePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + (hownership : ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) + {start input output : VEnv} + {sourceStart sourceMiddle sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {resultWorld : Owned} {emitFunction emit : Emit} + {function av : AVal} {args : List IxIR0.Expr} + {state finalState : LowSt} + (hfunctionNe : function ≠ .constA .erased) + (hsourceArgs : SourceArgsEval sourceCtx sourceMiddle args sourceArgs) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) + (hfunction : LowerResultValueSound funRel recSelfRel ctx cur + start input sourceStart sourceMiddle sourceFunction .shared + emitFunction function) + (hrun : (applyRest src (fuel + 1) input resultWorld emitFunction + function args).run state = .ok (output, emit, av) finalState) : + LowerResultValueSound funRel recSelfRel ctx cur start output + sourceStart sourceMiddle sourceResult resultWorld emit av := by + exact applyRest_nonErased_run_core + (Result := fun actualWorld actualOutput actualEmit actualAv _ => + LowerResultValueSound funRel recSelfRel ctx cur start actualOutput + sourceStart sourceMiddle sourceResult actualWorld actualEmit actualAv) + (hfinish := fun argsOutput emitArgs avs _ hargsRun + hworldsHomogeneous => by + have hsourcePaired : SourceArgsEval sourceCtx sourceMiddle + ((args.map (fun arg => (arg, Owned.shared))).map Prod.fst) + sourceArgs := by + simpa [Function.comp_def] using hsourceArgs + have hargsSound := hargs hsourcePaired hargsRun + have hhomogeneous : LowerArgsValueSound funRel recSelfRel ctx cur + input argsOutput sourceMiddle sourceMiddle sourceArgs + (List.replicate avs.length .shared) emitArgs avs := by + simpa [hworldsHomogeneous] using hargsSound + simpa [Function.comp_def] using + hfunction.applyArgs_graph hhomogeneous hownership hvalue hsource) + hfunctionNe hrun + +/-- No successful non-erased `applyRest` run exists at zero compiler fuel. -/ +theorem applyRestNonErasedValuePreserves_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) : + ApplyRestNonErasedValuePreserves funRel recSelfRel sourceCtx ctx cur + src 0 := by + intro start input output sourceStart sourceMiddle sourceArgs + sourceFunction sourceResult resultWorld emitFunction emit function av + args state finalState _ _ _ _ hrun + simp only [applyRest] at hrun + exact (estateThrowRun_not_ok hrun).elim + +/-- One semantic `applyRest` induction step follows directly from semantic +argument lowering plus the completed ownership and value contracts for +higher-order application. -/ +theorem applyRestNonErasedValuePreserves_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsValuePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + (hownership : ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) : + ApplyRestNonErasedValuePreserves funRel recSelfRel sourceCtx ctx cur + src (fuel + 1) := by + intro start input output sourceStart sourceMiddle sourceArgs + sourceFunction sourceResult resultWorld emitFunction emit function av + args state finalState hfunctionNe hsourceArgs hsource hfunction hrun + exact applyRest_nonErased_run_value_sound hargs hownership hvalue + hfunctionNe hsourceArgs hsource hfunction hrun + +/-- Shared zero/successor dispatcher for exact and bounded non-erased +`applyRest` semantic and profile preservation. Argument closure remains a +callback, so each flavor retains its own result and higher-order contracts +while fuel case analysis and strict-hypothesis narrowing occur once. -/ +theorem applyRestNonErasedPreserves_of_expr_core + {Expr Args ApplyRest : Nat → Prop} + (hargsOfExpr : ∀ fuel, + (∀ prior, prior < fuel → Expr prior) → Args fuel) + (hzero : ApplyRest 0) + (hsucc : ∀ {fuel}, Args fuel → ApplyRest (fuel + 1)) + (fuel : Nat) + (hexpr : ∀ prior, prior < fuel → Expr prior) : + ApplyRest fuel := by + cases fuel with + | zero => exact hzero + | succ fuel => + apply hsucc + apply hargsOfExpr fuel + intro prior hprior + exact hexpr prior (Nat.lt_trans hprior (Nat.lt_succ_self fuel)) + +/-- Close non-erased `applyRest` semantic preservation directly from all +strictly smaller expression hypotheses. This is the compiler-fuel induction +form consumed by `knownCall` and `lowerSpine`. -/ +theorem applyRestNonErasedValuePreserves_of_expr + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} (fuel : Nat) + (hexpr : ∀ prior, prior < fuel → + LowerEValuePreserves funRel recSelfRel sourceCtx ctx cur src prior) + (hownership : ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) : + ApplyRestNonErasedValuePreserves funRel recSelfRel sourceCtx ctx cur + src fuel := + applyRestNonErasedPreserves_of_expr_core + (Expr := LowerEValuePreserves funRel recSelfRel sourceCtx ctx cur src) + (Args := LowerArgsValuePreserves funRel recSelfRel sourceCtx ctx cur src) + (ApplyRest := ApplyRestNonErasedValuePreserves funRel recSelfRel + sourceCtx ctx cur src) + (hargsOfExpr := fun fuel hexpr => + lowerArgsValuePreserves_of_expr fuel hexpr) + (hzero := applyRestNonErasedValuePreserves_zero src) + (hsucc := fun hargs => + applyRestNonErasedValuePreserves_succ hargs hownership hvalue) + fuel hexpr + +/-- Fuel-bounded semantic inversion of a successful non-erased +`applyRest` run. -/ +theorem applyRest_nonErased_run_value_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsValuePreservesBelow funRel recSelfRel sourceCtx ctx + cur limit src fuel) + (hownership : ApplyOwnershipContractBelow ctx limit) + (hvalue : ApplyValueContractBelow funRel sourceCtx ctx limit) + {start input output : VEnv} + {sourceStart sourceMiddle sourceArgs : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {resultWorld : Owned} {emitFunction emit : Emit} + {function av : AVal} {args : List IxIR0.Expr} + {state finalState : LowSt} + (hfunctionNe : function ≠ .constA .erased) + (hsourceArgs : SourceArgsEval sourceCtx sourceMiddle args sourceArgs) + (hsource : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) + (hfunction : LowerResultValueSoundBelow funRel recSelfRel ctx cur limit + start input sourceStart sourceMiddle sourceFunction .shared + emitFunction function) + (hrun : (applyRest src (fuel + 1) input resultWorld emitFunction + function args).run state = .ok (output, emit, av) finalState) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit start output + sourceStart sourceMiddle sourceResult resultWorld emit av := by + exact applyRest_nonErased_run_core + (Result := fun actualWorld actualOutput actualEmit actualAv _ => + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit start + actualOutput sourceStart sourceMiddle sourceResult actualWorld + actualEmit actualAv) + (hfinish := fun argsOutput emitArgs avs _ hargsRun + hworldsHomogeneous => by + have hsourcePaired : SourceArgsEval sourceCtx sourceMiddle + ((args.map (fun arg => (arg, Owned.shared))).map Prod.fst) + sourceArgs := by + simpa [Function.comp_def] using hsourceArgs + have hargsSound := hargs hsourcePaired hargsRun + have hhomogeneous : LowerArgsValueSoundBelow funRel recSelfRel ctx cur + limit input argsOutput sourceMiddle sourceMiddle sourceArgs + (List.replicate avs.length .shared) emitArgs avs := by + simpa [hworldsHomogeneous] using hargsSound + simpa [Function.comp_def] using + hfunction.applyArgs_graph hhomogeneous hownership hvalue hsource) + hfunctionNe hrun + +/-- No successful bounded non-erased `applyRest` run exists at zero +compiler fuel. -/ +theorem applyRestNonErasedValuePreservesBelow_zero + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (src : IxIR0.Env) : + ApplyRestNonErasedValuePreservesBelow funRel recSelfRel sourceCtx ctx + cur limit src 0 := by + intro start input output sourceStart sourceMiddle sourceArgs + sourceFunction sourceResult resultWorld emitFunction emit function av + args state finalState _ _ _ _ hrun + simp only [applyRest] at hrun + exact (estateThrowRun_not_ok hrun).elim + +/-- One bounded semantic `applyRest` induction step follows from bounded +argument lowering and bounded higher-order contracts. -/ +theorem applyRestNonErasedValuePreservesBelow_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsValuePreservesBelow funRel recSelfRel sourceCtx ctx + cur limit src fuel) + (hownership : ApplyOwnershipContractBelow ctx limit) + (hvalue : ApplyValueContractBelow funRel sourceCtx ctx limit) : + ApplyRestNonErasedValuePreservesBelow funRel recSelfRel sourceCtx ctx + cur limit src (fuel + 1) := by + intro start input output sourceStart sourceMiddle sourceArgs + sourceFunction sourceResult resultWorld emitFunction emit function av + args state finalState hfunctionNe hsourceArgs hsource hfunction hrun + exact applyRest_nonErased_run_value_sound_below hargs hownership hvalue + hfunctionNe hsourceArgs hsource hfunction hrun + +/-- Close bounded non-erased `applyRest` preservation from all strictly +smaller bounded expression hypotheses. -/ +theorem applyRestNonErasedValuePreservesBelow_of_expr + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} (fuel : Nat) + (hexpr : ∀ prior, prior < fuel → + LowerEValuePreservesBelow funRel recSelfRel sourceCtx ctx cur limit + src prior) + (hownership : ApplyOwnershipContractBelow ctx limit) + (hvalue : ApplyValueContractBelow funRel sourceCtx ctx limit) : + ApplyRestNonErasedValuePreservesBelow funRel recSelfRel sourceCtx ctx + cur limit src fuel := + applyRestNonErasedPreserves_of_expr_core + (Expr := LowerEValuePreservesBelow funRel recSelfRel sourceCtx ctx cur + limit src) + (Args := LowerArgsValuePreservesBelow funRel recSelfRel sourceCtx ctx cur + limit src) + (ApplyRest := ApplyRestNonErasedValuePreservesBelow funRel recSelfRel + sourceCtx ctx cur limit src) + (hargsOfExpr := fun fuel hexpr => + lowerArgsValuePreservesBelow_of_expr fuel hexpr) + (hzero := applyRestNonErasedValuePreservesBelow_zero src) + (hsucc := fun hargs => + applyRestNonErasedValuePreservesBelow_succ hargs hownership hvalue) + fuel hexpr + +/-! The semantic proof is intentionally a companion refinement over the +ownership development above. `LowerResultSound` remains the reusable +ownership/frame judgment; the semantic induction may consume it, but does not +add source values to each of its existing operation and continuation lemmas. -/ + +/-- Successful source evaluation has some target execution with a graph- +related result. `funRel` is the lambda-lifting/pap correspondence that the +generated-environment proof must instantiate. -/ +def SemanticForwardSimulation (sourceCtx : IxIR0.Ctx) (targetCtx : Ctx) + (source : IxIR0.Expr) (target : Code) (funRel : Sim.FunctionRel) : Prop := + ∀ {sourceFuel sourceValue}, + IxIR0.eval sourceCtx sourceFuel [] source = .ok sourceValue → + ∃ targetFuel targetStore targetValue, + runMain targetCtx target targetFuel = .ok (targetStore, targetValue) ∧ + Sim.ValueGraph funRel targetStore sourceValue targetValue + +/-- No evaluator fuel may expose a dynamic memory-discipline failure. Fuel, +ordinary stuckness, and closed-world failures remain separate claims. -/ +def MemoryErrorUnreachable (targetCtx : Ctx) (target : Code) : Prop := + ∀ fuel message, runMain targetCtx target fuel ≠ .error (.mem message) + +/-- No evaluator fuel may expose an ordinary dynamic stuck branch. This is +deliberately independent of memory safety: raw lowering has a formal erased- +projection counterexample, while validated source programs may discharge the +proposition through a stronger admissibility theorem. -/ +def OrdinaryStuckUnreachable (targetCtx : Ctx) (target : Code) : Prop := + ∀ fuel message, runMain targetCtx target fuel ≠ .error (.stuck message) + +/-- Every reference reached by the closed target program is present. Oracle +failure remains ordinary stuckness; this proposition isolates declaration- +environment completeness only. -/ +def UnknownRefUnreachable (targetCtx : Ctx) (target : Code) : Prop := + ∀ fuel address, + runMain targetCtx target fuel ≠ .error (.unknownRef address) + +/-- Release the final result root according to the statically requested +world. Scalars are inert under either release operation. -/ +def releaseResult (targetCtx : Ctx) (world : Owned) (fuel : Nat) + (store : Store) (value : RVal) : Except Err Store := + match world with + | .shared => dropVal targetCtx fuel store value + | .unique => dropUVal targetCtx fuel store value + +/-- A closed successful run can release its final result and leave no live +nodes. `RootOwnership` alone intentionally admits rootless cycles; +`reclamation_of_run_invariants` combines it with the separate append-order +trace invariant chosen for the current no-reuse lowerer. -/ +def Reclamation (targetCtx : Ctx) (target : Code) + (resultWorld : Owned) : Prop := + ∀ {runFuel store value}, + runMain targetCtx target runFuel = .ok (store, value) → + ∃ releaseFuel released, + releaseResult targetCtx resultWorld releaseFuel store value = + .ok released ∧ + released.live = 0 + +/-- Reclamation reduces to the two independent run invariants established by +the ownership simulation and the append-only runtime trace. Release +termination comes from `Progress`; the finite empty-root theorem then turns +their conjunction into concrete `Store.live = 0`. -/ +theorem reclamation_of_run_invariants {targetCtx : Ctx} {target : Code} + {resultWorld : Owned} + (hinvariants : ∀ {runFuel store value}, + runMain targetCtx target runFuel = .ok (store, value) → + Sim.RootOwnership store [⟨resultWorld, value⟩] ∧ + Ix.Compiler.IxIR1.Reclamation.AllocationOrderInvariant store) : + Reclamation targetCtx target resultWorld := by + intro runFuel store value hrun + obtain ⟨hown, horder⟩ := hinvariants hrun + cases resultWorld with + | shared => + obtain ⟨releaseFuel, released, hrelease, hlive⟩ := + Ix.Compiler.IxIR1.Reclamation.shared_reclamation hown horder + exact ⟨releaseFuel, released, by + simpa [releaseResult] using hrelease, hlive⟩ + | unique => + obtain ⟨releaseFuel, released, hrelease, hlive⟩ := + Ix.Compiler.IxIR1.Reclamation.unique_reclamation hown horder + exact ⟨releaseFuel, released, by + simpa [releaseResult] using hrelease, hlive⟩ + +/-- For a fresh `runMain`, exact result ownership and a zero reuse counter are +the only client-facing obligations needed for reclamation. The evaluator +trace theorem derives append allocation order from the latter. -/ +theorem reclamation_of_run_ownership_and_zero_reuses + {targetCtx : Ctx} {target : Code} {resultWorld : Owned} + (hownership : ∀ {runFuel store value}, + runMain targetCtx target runFuel = .ok (store, value) → + Sim.RootOwnership store [⟨resultWorld, value⟩]) + (hzero : ∀ {runFuel store value}, + runMain targetCtx target runFuel = .ok (store, value) → + store.reuses = 0) : + Reclamation targetCtx target resultWorld := by + apply reclamation_of_run_invariants + intro runFuel store value hrun + exact ⟨hownership hrun, + (Ix.Compiler.IxIR1.Reclamation.runMain_order_of_reuses_eq_zero + hrun (hzero hrun)).1⟩ + +/-- The four instruction-level counters observed independently of semantic +heap equality. -/ +structure CostObservation where + allocs : Nat + reuses : Nat + frees : Nat + rcops : Nat + deriving BEq, Repr + +def costObservation (store : Store) : CostObservation := + ⟨store.allocs, store.reuses, store.frees, store.rcops⟩ + +/-- A result-independent counter property of every successful target run. +This is the convenient producer interface for equations such as +`reuses = 0`; semantic clients can lift it into `CostRefinement` without +mixing the counter proof into `ValueGraph`. -/ +def RunCostInvariant (targetCtx : Ctx) (target : Code) + (spec : CostObservation → Prop) : Prop := + ∀ {targetFuel targetStore targetValue}, + runMain targetCtx target targetFuel = .ok (targetStore, targetValue) → + spec (costObservation targetStore) + +/-- The counter-only allocation/free law exposed through `CostRefinement`. +The stronger runtime equation also identifies `allocs - frees` with the +number of live slots, but that heap observation deliberately remains outside +the four-counter interface. -/ +def AllocationFreeCostSpec (observation : CostObservation) : Prop := + observation.frees ≤ observation.allocs + +/-- Exact runtime heap accounting gives every target program the general +counter inequality `frees ≤ allocs`, independently of its result. -/ +theorem runCostInvariant_allocationFree (targetCtx : Ctx) (target : Code) : + RunCostInvariant targetCtx target AllocationFreeCostSpec := by + intro targetFuel targetStore targetValue hrun + exact Ix.Compiler.IxIR1.Reclamation.runMain_frees_le_allocs hrun + +/-- On a successful fresh run, the counter difference is exactly the live +heap size. -/ +theorem costObservation_allocs_sub_frees_eq_live + {targetCtx : Ctx} {target : Code} {targetFuel : Nat} + {targetStore : Store} {targetValue : RVal} + (hrun : runMain targetCtx target targetFuel = + .ok (targetStore, targetValue)) : + (costObservation targetStore).allocs - + (costObservation targetStore).frees = targetStore.live := by + have hbalance := + Ix.Compiler.IxIR1.Reclamation.runMain_live_add_frees_eq_allocs hrun + simp only [costObservation] + omega + +/-- Successful top-level executions are independent of the particular fuel +that was large enough. Raising both runs to their common maximum exposes +the same deterministic evaluator result. -/ +theorem runMain_success_unique {targetCtx : Ctx} {target : Code} + {leftFuel rightFuel : Nat} {leftStore rightStore : Store} + {leftValue rightValue : RVal} + (hleft : runMain targetCtx target leftFuel = + .ok (leftStore, leftValue)) + (hright : runMain targetCtx target rightFuel = + .ok (rightStore, rightValue)) : + (leftStore, leftValue) = (rightStore, rightValue) := by + have hleftMax := runMain_mono + (Nat.le_max_left leftFuel rightFuel) hleft + have hrightMax := runMain_mono + (Nat.le_max_right leftFuel rightFuel) hright + exact Except.ok.inj (hleftMax.symm.trans hrightMax) + +/-- One exact successful run is enough to establish any counter property for +all successful fuels. This turns kernel-checked execution traces into +reusable cost refinements without re-running an evaluator induction for each +equation. -/ +theorem RunCostInvariant.of_witness + {targetCtx : Ctx} {target : Code} + {spec : CostObservation → Prop} + {witnessFuel : Nat} {witnessStore : Store} {witnessValue : RVal} + (hrun : runMain targetCtx target witnessFuel = + .ok (witnessStore, witnessValue)) + (hspec : spec (costObservation witnessStore)) : + RunCostInvariant targetCtx target spec := by + intro targetFuel targetStore targetValue htarget + have hresult : + (targetStore, targetValue) = (witnessStore, witnessValue) := + runMain_success_unique htarget hrun + cases hresult + exact hspec + +/-- A caller-supplied cost specification relates the source result to the +target's counter observation whenever related successful runs are compared. +Keeping `spec` abstract permits exact equations and asymptotic inequalities +without mixing either into semantic equality. -/ +def CostRefinement (sourceCtx : IxIR0.Ctx) (targetCtx : Ctx) + (source : IxIR0.Expr) (target : Code) (funRel : Sim.FunctionRel) + (spec : IxIR0.Value → CostObservation → Prop) : Prop := + ∀ {sourceFuel sourceValue targetFuel targetStore targetValue}, + IxIR0.eval sourceCtx sourceFuel [] source = .ok sourceValue → + runMain targetCtx target targetFuel = .ok (targetStore, targetValue) → + Sim.ValueGraph funRel targetStore sourceValue targetValue → + spec sourceValue (costObservation targetStore) + +/-- Independent cost refinements compose pointwise. -/ +theorem CostRefinement.and + {sourceCtx : IxIR0.Ctx} {targetCtx : Ctx} + {source : IxIR0.Expr} {target : Code} {funRel : Sim.FunctionRel} + {left right : IxIR0.Value → CostObservation → Prop} + (hleft : CostRefinement sourceCtx targetCtx source target funRel left) + (hright : CostRefinement sourceCtx targetCtx source target funRel right) : + CostRefinement sourceCtx targetCtx source target funRel + (fun sourceValue observation => + left sourceValue observation ∧ right sourceValue observation) := by + intro sourceFuel sourceValue targetFuel targetStore targetValue + hsource htarget hgraph + exact ⟨hleft hsource htarget hgraph, hright hsource htarget hgraph⟩ + +/-- A target-only counter invariant is a cost refinement for the +result-independent lifting of its specification. -/ +theorem RunCostInvariant.costRefinement + {sourceCtx : IxIR0.Ctx} {targetCtx : Ctx} + {source : IxIR0.Expr} {target : Code} {funRel : Sim.FunctionRel} + {spec : CostObservation → Prop} + (hcost : RunCostInvariant targetCtx target spec) : + CostRefinement sourceCtx targetCtx source target funRel + (fun _ observation => spec observation) := by + intro sourceFuel sourceValue targetFuel targetStore targetValue + _hsource htarget _hgraph + exact hcost htarget + +/-- Every source/target pair satisfies the structural allocation/free cost +refinement whenever their successful runs and value graph are compared. -/ +theorem allocationFreeCostRefinement + {sourceCtx : IxIR0.Ctx} {targetCtx : Ctx} + {source : IxIR0.Expr} {target : Code} {funRel : Sim.FunctionRel} : + CostRefinement sourceCtx targetCtx source target funRel + (fun _ observation => AllocationFreeCostSpec observation) := by + apply RunCostInvariant.costRefinement + exact runCostInvariant_allocationFree targetCtx target + +/-! ## First executable lowering cases -/ + +private theorem scalar_id_sound_at {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} {world : Owned} {atom : Atom} + {value : RVal} + (hstable : AValStable (.constA atom)) + (hresolve : ∀ env, resolveAtom env atom = .ok value) + (hnone : rvalLocation? value = none) : + LowerResultSoundBelow ctx cur limit Γ Γ world (_root_.id : Emit) + (.constA atom) := by + refine ⟨hstable, ?_⟩ + intro rest slots + apply EmitSoundBelow.strengthen + intro store env hpre + obtain ⟨⟨roots, hΓ, hown⟩, hslots⟩ := hpre + exact ⟨⟨roots, value, hΓ, .const (hresolve env), + hown.addNoLocation hnone⟩, hslots⟩ + +theorem scalar_id_sound {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {world : Owned} {atom : Atom} {value : RVal} + (hstable : AValStable (.constA atom)) + (hresolve : ∀ env, resolveAtom env atom = .ok value) + (hnone : rvalLocation? value = none) : + LowerResultSound ctx cur Γ Γ world (_root_.id : Emit) + (.constA atom) := by + apply LowerResultSound.of_below + intro limit + exact scalar_id_sound_at (limit := limit) hstable hresolve hnone + +private theorem scalar_id_value_sound_at {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {world : Owned} {atom : Atom} {value : RVal} + (hstable : AValStable (.constA atom)) + (hresolve : ∀ env, resolveAtom env atom = .ok value) + (hnone : rvalLocation? value = none) + (hvalue : ∀ store, + Sim.ValueGraph funRel store sourceValue value) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit Γ Γ + sourceEnv sourceEnv sourceValue world (_root_.id : Emit) + (.constA atom) := by + refine + { toLowerResultSoundBelow := scalar_id_sound_at hstable hresolve hnone + graphEmits := ?_ } + intro sourceRest rest slots + apply EmitSoundBelow.strengthen + intro store env hpre + obtain ⟨⟨roots, hΓ, hrestGraph, hown⟩, hslots⟩ := hpre + exact ⟨⟨roots, value, hΓ, .const (hresolve env), hvalue store, + hrestGraph, hown.addNoLocation hnone⟩, hslots⟩ + +/-- Semantic scalar identity rule. The source/result graph premise is +store-polymorphic because literals and erased values do not inspect the heap. -/ +theorem scalar_id_value_sound {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {world : Owned} {atom : Atom} {value : RVal} + (hstable : AValStable (.constA atom)) + (hresolve : ∀ env, resolveAtom env atom = .ok value) + (hnone : rvalLocation? value = none) + (hvalue : ∀ store, + Sim.ValueGraph funRel store sourceValue value) : + LowerResultValueSound funRel recSelfRel ctx cur Γ Γ + sourceEnv sourceEnv sourceValue world (_root_.id : Emit) + (.constA atom) := by + exact LowerResultValueSound.of_below fun limit => + scalar_id_value_sound_at (limit := limit) + hstable hresolve hnone hvalue + +/-- Fuel-bounded ownership rule for an environment-independent scalar. -/ +theorem scalar_id_sound_below {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} {world : Owned} {atom : Atom} {value : RVal} + (hstable : AValStable (.constA atom)) + (hresolve : ∀ env, resolveAtom env atom = .ok value) + (hnone : rvalLocation? value = none) : + LowerResultSoundBelow ctx cur limit Γ Γ world (_root_.id : Emit) + (.constA atom) := by + exact scalar_id_sound_at hstable hresolve hnone + +theorem scalar_id_value_sound_below {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {world : Owned} {atom : Atom} {value : RVal} + (hstable : AValStable (.constA atom)) + (hresolve : ∀ env, resolveAtom env atom = .ok value) + (hnone : rvalLocation? value = none) + (hvalue : ∀ store, Sim.ValueGraph funRel store sourceValue value) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit Γ Γ + sourceEnv sourceEnv sourceValue world (_root_.id : Emit) + (.constA atom) := by + exact scalar_id_value_sound_at hstable hresolve hnone hvalue + +theorem lower_lit_sound {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {world : Owned} {literal : IxIR0.Literal} : + LowerResultSound ctx cur Γ Γ world (_root_.id : Emit) + (.constA (.lit literal)) := by + apply scalar_id_sound .lit + · intro env; rfl + · rfl + +private theorem lower_lit_value_sound_at {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {world : Owned} + {literal : IxIR0.Literal} : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit Γ Γ + sourceEnv sourceEnv (.lit literal) world (_root_.id : Emit) + (.constA (.lit literal)) := by + apply scalar_id_value_sound_at .lit + · intro env + rfl + · rfl + · intro store + exact .lit + +theorem lower_lit_value_sound {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {world : Owned} + {literal : IxIR0.Literal} : + LowerResultValueSound funRel recSelfRel ctx cur Γ Γ + sourceEnv sourceEnv (.lit literal) world (_root_.id : Emit) + (.constA (.lit literal)) := by + exact LowerResultValueSound.of_below fun limit => + lower_lit_value_sound_at (limit := limit) + +theorem lower_lit_sound_below {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} {world : Owned} + {literal : IxIR0.Literal} : + LowerResultSoundBelow ctx cur limit Γ Γ world (_root_.id : Emit) + (.constA (.lit literal)) := by + apply scalar_id_sound_below .lit + · intro env + rfl + · rfl + +theorem lower_lit_value_sound_below {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} {sourceEnv : List IxIR0.Value} + {world : Owned} {literal : IxIR0.Literal} : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit Γ Γ + sourceEnv sourceEnv (.lit literal) world (_root_.id : Emit) + (.constA (.lit literal)) := by + exact lower_lit_value_sound_at + +theorem lower_erased_sound {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {world : Owned} : + LowerResultSound ctx cur Γ Γ world (_root_.id : Emit) + (.constA .erased) := by + apply scalar_id_sound .erased + · intro env; rfl + · rfl + +private theorem lower_erased_value_sound_at {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {world : Owned} : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit Γ Γ + sourceEnv sourceEnv .erased world (_root_.id : Emit) + (.constA .erased) := by + apply scalar_id_value_sound_at .erased + · intro env + rfl + · rfl + · intro store + exact .erased + +theorem lower_erased_value_sound {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {sourceEnv : List IxIR0.Value} {world : Owned} : + LowerResultValueSound funRel recSelfRel ctx cur Γ Γ + sourceEnv sourceEnv .erased world (_root_.id : Emit) + (.constA .erased) := by + exact LowerResultValueSound.of_below fun limit => + lower_erased_value_sound_at (limit := limit) + +theorem lower_erased_sound_below {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} {world : Owned} : + LowerResultSoundBelow ctx cur limit Γ Γ world (_root_.id : Emit) + (.constA .erased) := by + apply scalar_id_sound_below .erased + · intro env + rfl + · rfl + +theorem lower_erased_value_sound_below {funRel : Sim.FunctionRel} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {Γ : VEnv} {sourceEnv : List IxIR0.Value} + {world : Owned} : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit Γ Γ + sourceEnv sourceEnv .erased world (_root_.id : Emit) + (.constA .erased) := by + exact lower_erased_value_sound_at + +/-- Evaluate shared arguments to an erased function, release every produced +owner, and return the erased scalar at the caller's demanded result world. -/ +theorem LowerResultSound.discardArgs {ctx : Ctx} {cur : FnDef} + {start input output : VEnv} {resultWorld : Owned} + {emitFunction emitArgs : Emit} {avs : List AVal} + (hfunction : LowerResultSound ctx cur start input .shared + emitFunction (.constA .erased)) + (hargs : LowerArgsSound ctx cur input output + (List.replicate avs.length .shared) emitArgs avs) : + LowerResultSound ctx cur start (releaseAll output avs).1 resultWorld + ((emitFunction ∘ emitArgs) ∘ (releaseAll output avs).2) + (.constA .erased) := by + refine ⟨.erased, ?_⟩ + intro rest slots + have hrelease := releaseAll_sound (ctx := ctx) (cur := cur) + (Γ := output) hargs.stable + have hcomposed := EmitSound.comp (hfunction.emits rest slots) + (EmitSound.comp (discard_const_result AValStable.erased rest slots) + (EmitSound.comp (hargs.emits rest slots) + (EmitSound.comp (hrelease rest slots) + ((lower_erased_sound (ctx := ctx) (cur := cur) + (Γ := (releaseAll output avs).1) + (world := resultWorld)).emits rest slots)))) + simpa [Function.comp_def] using hcomposed + +/-- Semantic erased-application composition. The erased function result is +ownership-inert, every argument is still evaluated and graph-related, and +`releaseAll` consumes those temporary argument values before producing the +source evaluator's erased result. -/ +theorem LowerResultValueSound.discardArgs + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {start input output : VEnv} + {sourceStart sourceMiddle sourceOutput sourceValues : + List IxIR0.Value} + {resultWorld : Owned} {emitFunction emitArgs : Emit} + {avs : List AVal} + (hfunction : LowerResultValueSound funRel recSelfRel ctx cur + start input sourceStart sourceMiddle .erased .shared + emitFunction (.constA .erased)) + (hargs : LowerArgsValueSound funRel recSelfRel ctx cur input output + sourceMiddle sourceOutput sourceValues + (List.replicate avs.length .shared) emitArgs avs) + (hsourceLength : sourceValues.length = avs.length) : + LowerResultValueSound funRel recSelfRel ctx cur start + (releaseAll output avs).1 sourceStart sourceOutput .erased + resultWorld + ((emitFunction ∘ emitArgs) ∘ (releaseAll output avs).2) + (.constA .erased) := by + refine + { toLowerResultSound := hfunction.toLowerResultSound.discardArgs + hargs.toLowerArgsSound + graphEmits := ?_ } + intro sourceRest rest slots + have hrelease := releaseAll_value_sound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := output) + (sourceEnv := sourceOutput) hargs.stable hsourceLength + have hcomposed := EmitSound.comp + (hfunction.graphEmits sourceRest rest slots) + (EmitSound.comp + (discard_const_result_value + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := input) + (sourceEnv := sourceMiddle) (sourceValue := IxIR0.Value.erased) + AValStable.erased sourceRest rest slots) + (EmitSound.comp (hargs.graphEmits sourceRest rest slots) + (EmitSound.comp (hrelease.graphEmits sourceRest rest slots) + ((lower_erased_value_sound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) + (Γ := (releaseAll output avs).1) + (sourceEnv := sourceOutput) (world := resultWorld)).graphEmits + sourceRest rest slots)))) + simpa [Function.comp_def] using hcomposed + +/-- Executable erased `applyRest` branch with source-value correspondence. +The source application of erased is erased after every argument, while the +target evaluates and releases the same graph-related argument vector. -/ +theorem applyRest_erased_value_verified + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) (start input output : VEnv) + (sourceStart sourceMiddle sourceOutput sourceArgs : + List IxIR0.Value) + (resultWorld : Owned) (emitFunction emitArgs : Emit) + (args : List IxIR0.Expr) (avs : List AVal) + (state finalState : LowSt) + (hargsRun : + (lowerArgs src fuel input + (args.map (fun arg => (arg, Owned.shared)))).run state = + .ok (output, emitArgs, avs) finalState) + (hargsSound : LowerArgsValueSound funRel recSelfRel ctx cur + input output sourceMiddle sourceOutput sourceArgs + (List.replicate avs.length .shared) emitArgs avs) + (hfunction : LowerResultValueSound funRel recSelfRel ctx cur + start input sourceStart sourceMiddle .erased .shared + emitFunction (.constA .erased)) + (hsourceLength : sourceArgs.length = avs.length) : + (applyRest src (Nat.succ fuel) input resultWorld emitFunction + (.constA .erased) args).run state = + .ok ((releaseAll output avs).1, + (emitFunction ∘ emitArgs) ∘ (releaseAll output avs).2, + .constA .erased) finalState ∧ + LowerResultValueSound funRel recSelfRel ctx cur start + (releaseAll output avs).1 sourceStart sourceOutput .erased + resultWorld + ((emitFunction ∘ emitArgs) ∘ (releaseAll output avs).2) + (.constA .erased) := by + constructor + · simp only [applyRest] + rw [estateBindRun, hargsRun] + rfl + · exact hfunction.discardArgs hargsSound hsourceLength + +/-- Source-neutral operational inversion for the erased `applyRest` branch. +The result family separates ownership, semantic, profile, and reachable +clients while argument execution, homogeneous-world normalization, full +release, and erased-result recovery remain canonical. -/ +theorem applyRest_erased_run_core + {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} + {resultWorld : Owned} {pre emit : Emit} {args : List IxIR0.Expr} + {state finalState : LowSt} {av : AVal} + {Result : Owned → VEnv → Emit → AVal → LowSt → Prop} + (hfinish : ∀ (argsOutput : VEnv) (emitArgs : Emit) + (avs : List AVal) (argsState : LowSt), + (lowerArgs src fuel input + (args.map (fun arg => (arg, Owned.shared)))).run state = + .ok (argsOutput, emitArgs, avs) argsState → + avs.length = args.length → + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate avs.length .shared → + Result resultWorld (releaseAll argsOutput avs).1 + ((pre ∘ emitArgs) ∘ (releaseAll argsOutput avs).2) + (.constA .erased) argsState) + (hrun : (applyRest src (fuel + 1) input resultWorld pre + (.constA .erased) args).run state = + .ok (output, emit, av) finalState) : + Result resultWorld output emit av finalState := by + simp only [applyRest] at hrun + obtain ⟨argsResult, argsState, hargsRun, hpureRun⟩ := + estateBindRun_ok_inv hrun + rcases argsResult with ⟨argsOutput, emitArgs, avs⟩ + have hpure : + ((releaseAll argsOutput avs).1, + (pre ∘ emitArgs) ∘ (releaseAll argsOutput avs).2, + AVal.constA .erased) = (output, emit, av) ∧ + argsState = finalState := by + simpa [Function.comp_def] using hpureRun + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + have havsLength : avs.length = args.length := by + simpa using lowerArgs_success_length src hargsRun + have hworldsHomogeneous : + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate avs.length .shared := by + simpa [havsLength] using map_shared_arg_worlds args + exact hfinish argsOutput emitArgs avs argsState hargsRun havsLength + hworldsHomogeneous + +/-- Semantic-source adapter for `applyRest_erased_run_core`. Source argument +pairing and source/target length agreement are recovered once for ordinary +and reachable exact/bounded value clients. -/ +private theorem applyRest_erased_run_value_sound_core + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {sourceMiddle sourceArgs : List IxIR0.Value} + {resultWorld : Owned} {pre emit : Emit} {args : List IxIR0.Expr} + {state finalState : LowSt} {av : AVal} + {Result : Owned → VEnv → Emit → AVal → LowSt → Prop} + (hfinish : ∀ (argsOutput : VEnv) (emitArgs : Emit) + (avs : List AVal) (argsState : LowSt), + SourceArgsEval sourceCtx sourceMiddle + ((args.map (fun arg => (arg, Owned.shared))).map Prod.fst) + sourceArgs → + (lowerArgs src fuel input + (args.map (fun arg => (arg, Owned.shared)))).run state = + .ok (argsOutput, emitArgs, avs) argsState → + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate avs.length .shared → + sourceArgs.length = avs.length → + Result resultWorld (releaseAll argsOutput avs).1 + ((pre ∘ emitArgs) ∘ (releaseAll argsOutput avs).2) + (.constA .erased) argsState) + (hsourceArgs : SourceArgsEval sourceCtx sourceMiddle args sourceArgs) + (hrun : (applyRest src (fuel + 1) input resultWorld pre + (.constA .erased) args).run state = + .ok (output, emit, av) finalState) : + Result resultWorld output emit av finalState := by + exact applyRest_erased_run_core + (Result := Result) + (hfinish := fun argsOutput emitArgs avs argsState hargsRun havsLength + hworldsHomogeneous => by + have hsourcePaired : SourceArgsEval sourceCtx sourceMiddle + ((args.map (fun arg => (arg, Owned.shared))).map Prod.fst) + sourceArgs := by + simpa [Function.comp_def] using hsourceArgs + have hsourceLength : sourceArgs.length = avs.length := by + rw [← hsourceArgs.lengths, ← havsLength] + exact hfinish argsOutput emitArgs avs argsState hsourcePaired hargsRun + hworldsHomogeneous hsourceLength) + hrun + +/-- Semantic inversion of the erased `applyRest` branch. Arguments remain +strictly evaluated and graph-related, then all their owners are released; +the source and target results are both the erased scalar at either demanded +world. -/ +theorem applyRest_erased_run_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsValuePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + {start input output : VEnv} + {sourceStart sourceMiddle sourceArgs : List IxIR0.Value} + {resultWorld : Owned} {emitFunction emit : Emit} + {args : List IxIR0.Expr} {av : AVal} + {state finalState : LowSt} + (hsourceArgs : SourceArgsEval sourceCtx sourceMiddle args sourceArgs) + (hfunction : LowerResultValueSound funRel recSelfRel ctx cur + start input sourceStart sourceMiddle .erased .shared + emitFunction (.constA .erased)) + (hrun : (applyRest src (fuel + 1) input resultWorld emitFunction + (.constA .erased) args).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSound funRel recSelfRel ctx cur start output + sourceStart sourceMiddle .erased resultWorld emit av := by + exact applyRest_erased_run_value_sound_core + (Result := fun actualWorld actualOutput actualEmit actualAv _ => + LowerResultValueSound funRel recSelfRel ctx cur start actualOutput + sourceStart sourceMiddle .erased actualWorld actualEmit actualAv) + (hfinish := fun argsOutput emitArgs avs _ hsourcePaired hargsRun + hworldsHomogeneous hsourceLength => by + have hargsSound := hargs hsourcePaired hargsRun + have hhomogeneous : LowerArgsValueSound funRel recSelfRel ctx cur + input argsOutput sourceMiddle sourceMiddle sourceArgs + (List.replicate avs.length .shared) emitArgs avs := by + simpa [hworldsHomogeneous] using hargsSound + simpa [Function.comp_def] using + hfunction.discardArgs hhomogeneous hsourceLength) + hsourceArgs hrun + +/-- Semantic flattening branch of `lowerSpine`: the executable recursive +call and `SourceSpineEval.flattenApp` prepend the same argument. -/ +theorem lowerSpine_app_run_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel : Nat} + (hspine : LowerSpineValuePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + {input output : VEnv} {world : Owned} + {function argument : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hsource : SourceSpineEval sourceCtx sourceEnv + (.app function argument) args sourceResult) + (hrun : (lowerSpine src (fuel + 1) input world + (.app function argument) args).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + apply hspine hsource.flattenApp + simpa [lowerSpine] using hrun + +/-- The expression-level `.app` constructor is now a semantic delegation to +the singleton source/target spine, rather than an uncovered head case. -/ +theorem lowerE_app_run_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel sourceFuel : Nat} + (hspine : LowerSpineValuePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + {input output : VEnv} {world : Owned} + {function argument : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hsource : IxIR0.eval sourceCtx sourceFuel sourceEnv + (.app function argument) = .ok sourceResult) + (hrun : (lowerE src (fuel + 1) input world + (.app function argument)).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + apply hspine (SourceSpineEval.of_eval_app hsource) + simpa [lowerE] using hrun + +/-- Source-neutral operational normalization for an erased-head spine. Every +successful run is exactly the corresponding erased-function `applyRest` run +at predecessor fuel. -/ +theorem lowerSpine_erased_run_core + {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Owned} {args : List IxIR0.Expr} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hrun : (lowerSpine src (fuel + 2) input world .erased args).run + state = .ok (output, emit, av) finalState) : + (applyRest src (fuel + 1) input world (_root_.id : Emit) + (.constA .erased) args).run state = + .ok (output, emit, av) finalState := by + simpa [lowerSpine] using hrun + +/-- Semantic-source adapter for `lowerSpine_erased_run_core`. The result +family keeps ordinary and reachable value clients separate while erased-head +evaluation, erased-result forcing, and source argument recovery occur once. -/ +private theorem lowerSpine_erased_run_value_sound_core + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Owned} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + {Result : IxIR0.Value → Prop} + (hfinish : ∀ {sourceArgs : List IxIR0.Value}, + SourceArgsEval sourceCtx sourceEnv args sourceArgs → + (applyRest src (fuel + 1) input world (_root_.id : Emit) + (.constA .erased) args).run state = + .ok (output, emit, av) finalState → + Result .erased) + (hsource : SourceSpineEval sourceCtx sourceEnv .erased args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world .erased args).run + state = .ok (output, emit, av) finalState) : + Result sourceResult := by + apply hsource.eliminate + · intro headValue argumentValues hhead harguments happlies + obtain ⟨_, hhead⟩ := hhead + have herasedEval : IxIR0.eval sourceCtx 1 sourceEnv .erased = + .ok .erased := by + simp [IxIR0.eval] + have hheadValue : headValue = .erased := + sourceEval_ok_unique hhead herasedEval + subst headValue + have hresult : sourceResult = .erased := + happlies.deterministic + (SourceApplies.erased sourceCtx argumentValues) + subst sourceResult + exact hfinish harguments (lowerSpine_erased_run_core hrun) + +/-- Complete semantic erased-head spine. The source head and every source +application result are forced to `◻`; the target evaluates the same argument +vector, releases it, and returns its erased scalar at either result world. -/ +theorem lowerSpine_erased_run_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsValuePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + {input output : VEnv} {world : Owned} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hsource : SourceSpineEval sourceCtx sourceEnv .erased args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world .erased args).run + state = .ok (output, emit, av) finalState) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + exact lowerSpine_erased_run_value_sound_core + (Result := fun actualResult => + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv actualResult world emit av) + (hfinish := by + intro sourceArgs hsourceArgs hrestRun + exact applyRest_erased_run_value_sound hargs hsourceArgs + (lower_erased_value_sound (funRel := funRel) + (recSelfRel := recSelfRel) (ctx := ctx) (cur := cur) + (sourceEnv := sourceEnv) (world := .shared)) hrestRun) + hsource hrun + +/-- Bounded erased-function path: evaluate and release every shared +argument, then return the ownership-inert erased value. -/ +theorem LowerResultSoundBelow.discardArgs + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {start input output : VEnv} {resultWorld : Owned} + {emitFunction emitArgs : Emit} {avs : List AVal} + (hfunction : LowerResultSoundBelow ctx cur limit start input .shared + emitFunction (.constA .erased)) + (hargs : LowerArgsSoundBelow ctx cur limit input output + (List.replicate avs.length .shared) emitArgs avs) : + LowerResultSoundBelow ctx cur limit start (releaseAll output avs).1 + resultWorld ((emitFunction ∘ emitArgs) ∘ (releaseAll output avs).2) + (.constA .erased) := by + refine ⟨.erased, ?_⟩ + intro rest slots + have hrelease := releaseAll_sound_below + (ctx := ctx) (cur := cur) (limit := limit) + (Γ := output) hargs.stable + have hcomposed := EmitSoundBelow.comp (hfunction.emits rest slots) + (EmitSoundBelow.comp + (discard_const_result_below AValStable.erased rest slots) + (EmitSoundBelow.comp (hargs.emits rest slots) + (EmitSoundBelow.comp (hrelease rest slots) + ((lower_erased_sound_below (ctx := ctx) (cur := cur) + (limit := limit) (Γ := (releaseAll output avs).1) + (world := resultWorld)).emits rest slots)))) + simpa [Function.comp_def] using hcomposed + +/-- Fuel-bounded semantic erased-application composition. -/ +theorem LowerResultValueSoundBelow.discardArgs + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {start input output : VEnv} + {sourceStart sourceMiddle sourceOutput sourceValues : + List IxIR0.Value} + {resultWorld : Owned} {emitFunction emitArgs : Emit} + {avs : List AVal} + (hfunction : LowerResultValueSoundBelow funRel recSelfRel ctx cur limit + start input sourceStart sourceMiddle .erased .shared + emitFunction (.constA .erased)) + (hargs : LowerArgsValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceMiddle sourceOutput sourceValues + (List.replicate avs.length .shared) emitArgs avs) + (hsourceLength : sourceValues.length = avs.length) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit start + (releaseAll output avs).1 sourceStart sourceOutput .erased + resultWorld + ((emitFunction ∘ emitArgs) ∘ (releaseAll output avs).2) + (.constA .erased) := by + refine + { toLowerResultSoundBelow := + hfunction.toLowerResultSoundBelow.discardArgs + hargs.toLowerArgsSoundBelow + graphEmits := ?_ } + intro sourceRest rest slots + have hrelease := releaseAll_value_sound_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) (Γ := output) + (sourceEnv := sourceOutput) hargs.stable hsourceLength + have hcomposed := EmitSoundBelow.comp + (hfunction.graphEmits sourceRest rest slots) + (EmitSoundBelow.comp + (discard_const_result_value_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) (Γ := input) + (sourceEnv := sourceMiddle) (sourceValue := IxIR0.Value.erased) + AValStable.erased sourceRest rest slots) + (EmitSoundBelow.comp (hargs.graphEmits sourceRest rest slots) + (EmitSoundBelow.comp (hrelease.graphEmits sourceRest rest slots) + ((lower_erased_value_sound_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) + (Γ := (releaseAll output avs).1) + (sourceEnv := sourceOutput) (world := resultWorld)).graphEmits + sourceRest rest slots)))) + simpa [Function.comp_def] using hcomposed + +/-- The first sequencing case of the compiler induction: a scalar literal is +materialized for a `many` binder, its sole variable occurrence moves that +slot into the result, and the old source environment remains realized under +the newly pushed runtime slot. -/ +theorem lower_let_lit_var_sound {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {literal : IxIR0.Literal} : + LowerResultSound ctx cur Γ Γ.bump .shared + (emitOp (.pure (.lit literal))) (.slotA Γ.depth) := by + refine ⟨.slot, ?_⟩ + intro rest slots + apply OpSound.emit + intro fuel store env store' result hpre hrun + obtain ⟨⟨roots, hΓ, hown⟩, hslots⟩ := hpre + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + have hop := runOp_pure_scalar_owned (ctx := ctx) (cur := cur) + (fuel := fuel) (world := Owned.shared) (roots := roots ++ rest) + (env := env) (target := .lit literal) (value := .lit literal) + rfl rfl hown + have hpair : (store, RVal.lit literal) = (store', result) := + Except.ok.inj (hop.1.symm.trans hrun) + cases hpair + refine ⟨⟨roots, .lit literal, hΓ.bump (.lit literal), ?_, hop.2⟩, + hslots.bump (.lit literal)⟩ + · apply AValRealizes.slot + · simp [VEnv.bump] + · simp [VEnv.bump, VEnv.rel] + +/-- Executable/proof base case for the actual `lowerArgs` definition. -/ +theorem lowerArgs_nil_verified {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) (Γ : VEnv) (state : LowSt) : + (lowerArgs src (Nat.succ fuel) Γ []).run state = + .ok (Γ, (_root_.id : Emit), []) state ∧ + LowerArgsSound ctx cur Γ Γ [] (_root_.id : Emit) [] := by + exact ⟨by simp [lowerArgs], lowerArgs_nil_sound⟩ + +/-- Generic executable/proof cons rule. This is the constructor used by the +eventual mutual induction once its head `lowerE` and tail `lowerArgs` +recursive calls have returned. -/ +theorem lowerArgs_cons_verified {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) (input middle output : VEnv) + (expr : IxIR0.Expr) (world : Owned) + (args : List (IxIR0.Expr × Owned)) + (emitHead emitTail : Emit) (av : AVal) (avs : List AVal) + (state middleState finalState : LowSt) + (hheadRun : (lowerE src fuel input world expr).run state = + .ok (middle, emitHead, av) middleState) + (htailRun : (lowerArgs src fuel middle args).run middleState = + .ok (output, emitTail, avs) finalState) + (hhead : LowerResultSound ctx cur input middle world emitHead av) + (htail : LowerArgsSound ctx cur middle output (args.map Prod.snd) + emitTail avs) : + (lowerArgs src (Nat.succ fuel) input ((expr, world) :: args)).run state = + .ok (output, emitHead ∘ emitTail, av :: avs) finalState ∧ + LowerArgsSound ctx cur input output + (world :: args.map Prod.snd) (emitHead ∘ emitTail) (av :: avs) := by + constructor + · simp only [lowerArgs] + rw [estateBindRun, hheadRun] + simp only + rw [estateBindRun, htailRun] + rfl + · exact hhead.consArgs htail + +/-- Bounded executable/proof cons rule for the mutual induction. -/ +theorem lowerArgs_cons_verified_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} + (src : IxIR0.Env) (fuel : Nat) (input middle output : VEnv) + (expr : IxIR0.Expr) (world : Owned) + (args : List (IxIR0.Expr × Owned)) + (emitHead emitTail : Emit) (av : AVal) (avs : List AVal) + (state middleState finalState : LowSt) + (hheadRun : (lowerE src fuel input world expr).run state = + .ok (middle, emitHead, av) middleState) + (htailRun : (lowerArgs src fuel middle args).run middleState = + .ok (output, emitTail, avs) finalState) + (hhead : LowerResultSoundBelow ctx cur limit input middle world + emitHead av) + (htail : LowerArgsSoundBelow ctx cur limit middle output + (args.map Prod.snd) emitTail avs) : + (lowerArgs src (Nat.succ fuel) input ((expr, world) :: args)).run state = + .ok (output, emitHead ∘ emitTail, av :: avs) finalState ∧ + LowerArgsSoundBelow ctx cur limit input output + (world :: args.map Prod.snd) (emitHead ∘ emitTail) + (av :: avs) := by + constructor + · simp only [lowerArgs] + rw [estateBindRun, hheadRun] + simp only + rw [estateBindRun, htailRun] + rfl + · exact hhead.consArgs htail + +/-- The executable erased branch of `applyRest`, paired with argument +evaluation and exact release of every shared argument owner. No result-world +guard is needed because the returned erased scalar inhabits either world. -/ +theorem applyRest_erased_verified {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) (start input output : VEnv) + (resultWorld : Owned) (emitFunction emitArgs : Emit) + (args : List IxIR0.Expr) (avs : List AVal) + (state finalState : LowSt) + (hargsRun : + (lowerArgs src fuel input + (args.map (fun arg => (arg, Owned.shared)))).run state = + .ok (output, emitArgs, avs) finalState) + (hargsSound : LowerArgsSound ctx cur input output + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) + emitArgs avs) + (hworldsHomogeneous : + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate avs.length .shared) + (hfunction : LowerResultSound ctx cur start input .shared + emitFunction (.constA .erased)) : + (applyRest src (Nat.succ fuel) input resultWorld emitFunction + (.constA .erased) args).run state = + .ok ((releaseAll output avs).1, + (emitFunction ∘ emitArgs) ∘ (releaseAll output avs).2, + .constA .erased) finalState ∧ + LowerResultSound ctx cur start (releaseAll output avs).1 resultWorld + ((emitFunction ∘ emitArgs) ∘ (releaseAll output avs).2) + (.constA .erased) := by + constructor + · simp only [applyRest] + rw [estateBindRun, hargsRun] + rfl + · have hhomogeneous : LowerArgsSound ctx cur input output + (List.replicate avs.length .shared) emitArgs avs := by + simpa [hworldsHomogeneous] using hargsSound + exact hfunction.discardArgs hhomogeneous + +/-- The executable non-erased branch of `applyRest`, paired with the +ownership proof for the exact emitter it returns. Unknown callees are +shared-only in v1, so both the supplied arguments and the result use the +shared world. -/ +theorem applyRest_shared_verified {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) (start input output : VEnv) + (emitFunction emitArgs : Emit) (function : AVal) + (args : List IxIR0.Expr) (avs : List AVal) + (state finalState : LowSt) + (hfunctionNe : function ≠ .constA .erased) + (hargsRun : + (lowerArgs src fuel input + (args.map (fun arg => (arg, Owned.shared)))).run state = + .ok (output, emitArgs, avs) finalState) + (hargsSound : LowerArgsSound ctx cur input output + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) + emitArgs avs) + (hworldsHomogeneous : + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate avs.length .shared) + (hfunction : LowerResultSound ctx cur start input .shared + emitFunction function) + (hcontract : ApplyOwnershipContract ctx) : + (applyRest src (Nat.succ fuel) input .shared emitFunction function + args).run state = + .ok (output.bump, + (emitFunction ∘ emitArgs) ∘ + emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray), + .slotA output.depth) finalState ∧ + LowerResultSound ctx cur start output.bump .shared + ((emitFunction ∘ emitArgs) ∘ + emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + constructor + · simp only [applyRest] + have hrequire : + (requireResultWorld .shared .shared).run state = + .ok () state := by + rfl + rw [estateBindRun, hrequire] + simp only + rw [estateBindRun, hargsRun] + rfl + · have hhomogeneous : LowerArgsSound ctx cur input output + (List.replicate avs.length .shared) emitArgs avs := by + simpa [hworldsHomogeneous] using hargsSound + exact hfunction.applyArgs hhomogeneous hcontract + +/-- Bounded erased `applyRest` branch. The executable length invariant +derives the homogeneous shared-world telescope internally. -/ +theorem applyRest_erased_verified_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} + (src : IxIR0.Env) (fuel : Nat) (start input output : VEnv) + (resultWorld : Owned) (emitFunction emitArgs : Emit) + (args : List IxIR0.Expr) (avs : List AVal) + (state finalState : LowSt) + (hargsRun : + (lowerArgs src fuel input + (args.map (fun arg => (arg, Owned.shared)))).run state = + .ok (output, emitArgs, avs) finalState) + (hargsSound : LowerArgsSoundBelow ctx cur limit input output + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) + emitArgs avs) + (hfunction : LowerResultSoundBelow ctx cur limit start input .shared + emitFunction (.constA .erased)) : + (applyRest src (Nat.succ fuel) input resultWorld emitFunction + (.constA .erased) args).run state = + .ok ((releaseAll output avs).1, + (emitFunction ∘ emitArgs) ∘ (releaseAll output avs).2, + .constA .erased) finalState ∧ + LowerResultSoundBelow ctx cur limit start (releaseAll output avs).1 + resultWorld + ((emitFunction ∘ emitArgs) ∘ (releaseAll output avs).2) + (.constA .erased) := by + constructor + · simp only [applyRest] + rw [estateBindRun, hargsRun] + rfl + · have havsLength : avs.length = args.length := by + simpa using lowerArgs_success_length src hargsRun + have hworldsHomogeneous : + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate avs.length .shared := by + simpa [havsLength] using map_shared_arg_worlds args + have hhomogeneous : LowerArgsSoundBelow ctx cur limit input output + (List.replicate avs.length .shared) emitArgs avs := by + simpa [hworldsHomogeneous] using hargsSound + exact hfunction.discardArgs hhomogeneous + +/-- Bounded non-erased `applyRest` branch. -/ +theorem applyRest_shared_verified_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} + (src : IxIR0.Env) (fuel : Nat) (start input output : VEnv) + (emitFunction emitArgs : Emit) (function : AVal) + (args : List IxIR0.Expr) (avs : List AVal) + (state finalState : LowSt) + (hfunctionNe : function ≠ .constA .erased) + (hargsRun : + (lowerArgs src fuel input + (args.map (fun arg => (arg, Owned.shared)))).run state = + .ok (output, emitArgs, avs) finalState) + (hargsSound : LowerArgsSoundBelow ctx cur limit input output + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) + emitArgs avs) + (hfunction : LowerResultSoundBelow ctx cur limit start input .shared + emitFunction function) + (hcontract : ApplyOwnershipContractBelow ctx limit) : + (applyRest src (Nat.succ fuel) input .shared emitFunction function + args).run state = + .ok (output.bump, + (emitFunction ∘ emitArgs) ∘ + emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray), + .slotA output.depth) finalState ∧ + LowerResultSoundBelow ctx cur limit start output.bump .shared + ((emitFunction ∘ emitArgs) ∘ + emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + constructor + · simp only [applyRest] + have hrequire : + (requireResultWorld .shared .shared).run state = + .ok () state := by + rfl + rw [estateBindRun, hrequire] + simp only + rw [estateBindRun, hargsRun] + rfl + · have havsLength : avs.length = args.length := by + simpa using lowerArgs_success_length src hargsRun + have hworldsHomogeneous : + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate avs.length .shared := by + simpa [havsLength] using map_shared_arg_worlds args + have hhomogeneous : LowerArgsSoundBelow ctx cur limit input output + (List.replicate avs.length .shared) emitArgs avs := by + simpa [hworldsHomogeneous] using hargsSound + exact hfunction.applyArgs hhomogeneous hcontract + +/-- One compiler-fuel step for `applyRest`, derived from predecessor-fuel +argument lowering and the bounded higher-order application contract. -/ +theorem applyRestPreservesBelow_succ + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} + (hargs : LowerArgsPreservesBelow ctx cur limit src fuel) + (happly : ApplyOwnershipContractBelow ctx limit) : + ApplyRestPreservesBelow ctx cur limit src (fuel + 1) := by + intro start input resultWorld pre function args state finalState + output emit av hfunction hrun hrepresented havailable + by_cases herased : function = .constA .erased + · subst function + simp only [applyRest] at hrun + obtain ⟨argsResult, argsState, hargsRun, hpureRun⟩ := + estateBindRun_ok_inv hrun + rcases argsResult with ⟨argsOutput, emitArgs, avs⟩ + have hpure : + ((releaseAll argsOutput avs).1, + pre ∘ emitArgs ∘ (releaseAll argsOutput avs).2, + AVal.constA .erased) = (output, emit, av) ∧ + argsState = finalState := by + simpa using hpureRun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + have hargsSound := hargs hargsRun hrepresented havailable + have havsLength : avs.length = args.length := by + simpa using lowerArgs_success_length src hargsRun + have hworldsHomogeneous : + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate avs.length .shared := by + simpa [havsLength] using map_shared_arg_worlds args + have hhomogeneous : LowerArgsSoundBelow ctx cur limit input argsOutput + (List.replicate avs.length .shared) emitArgs avs := by + simpa [hworldsHomogeneous] using hargsSound + simpa [Function.comp_def] using hfunction.discardArgs hhomogeneous + · cases resultWorld with + | shared => + simp only [applyRest] at hrun + have hrequire : + (requireResultWorld .shared .shared).run state = + .ok () state := by + rfl + rw [estateBindRun, hrequire] at hrun + simp only at hrun + obtain ⟨argsResult, argsState, hargsRun, hpureRun⟩ := + estateBindRun_ok_inv hrun + rcases argsResult with ⟨argsOutput, emitArgs, avs⟩ + have hpure : + (argsOutput.bump, + pre ∘ emitArgs ∘ + emitOp (.apply (function.toAtom argsOutput) + (avs.map (·.toAtom argsOutput)).toArray), + AVal.slotA argsOutput.depth) = (output, emit, av) ∧ + argsState = finalState := by + simpa using hpureRun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + have hargsSound := hargs hargsRun hrepresented havailable + have havsLength : avs.length = args.length := by + simpa using lowerArgs_success_length src hargsRun + have hworldsHomogeneous : + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate avs.length .shared := by + simpa [havsLength] using map_shared_arg_worlds args + have hhomogeneous : LowerArgsSoundBelow ctx cur limit input argsOutput + (List.replicate avs.length .shared) emitArgs avs := by + simpa [hworldsHomogeneous] using hargsSound + simpa [Function.comp_def] using + hfunction.applyArgs hhomogeneous happly + | unique => + simp only [applyRest] at hrun + have hrequire : + (requireResultWorld .shared .unique).run state = + .error "call result is shared at unique demand" state := by + rfl + rw [estateBindRun, hrequire] at hrun + contradiction + +/-- Like `lowerArgs`, `applyRest` follows from strictly smaller expression +soundness. Higher-order evaluator recursion is supplied separately by the +bounded compiler contract. -/ +theorem applyRestPreservesBelow_of_expr + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + (fuel : Nat) + (hexpr : ∀ prior, prior < fuel → + LowerEPreservesBelow ctx cur limit src prior) + (hextra : ∀ prior, prior < fuel → + LowerArgsExtraMonotone src prior) + (happly : ApplyOwnershipContractBelow ctx limit) : + ApplyRestPreservesBelow ctx cur limit src fuel := by + cases fuel with + | zero => + intro start input resultWorld pre function args state finalState + output emit av hfunction hrun hrepresented _ + simp only [applyRest] at hrun + exact (estateThrowRun_not_ok hrun).elim + | succ fuel => + apply applyRestPreservesBelow_succ + · apply lowerArgsPreservesBelow_of_expr fuel + intro prior hprior + exact hexpr prior (Nat.lt_trans hprior (Nat.lt_succ_self fuel)) + intro prior hprior + exact hextra prior (Nat.lt_trans hprior (Nat.lt_succ_self fuel)) + · exact happly + +/-- A successful non-erased `applyRest` run necessarily passed its shared +result-world guard. This executable fact is independent of semantic +contracts and is used to classify over-applied static producers. -/ +theorem applyRest_slot_run_world_shared + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {resultWorld : Owned} {pre emit : Emit} {abs : Nat} + {args : List IxIR0.Expr} {av : AVal} + {state finalState : LowSt} + (hrun : (applyRest src fuel input resultWorld pre (.slotA abs) + args).run state = .ok (output, emit, av) finalState) : + resultWorld = .shared := by + cases fuel with + | zero => + simp only [applyRest] at hrun + exact (estateThrowRun_not_ok hrun).elim + | succ fuel => + simp only [applyRest] at hrun + obtain ⟨checked, nextState, hrequireRun, _⟩ := + estateBindRun_ok_inv hrun + cases checked + exact (requireResultWorld_run_ok_inv hrequireRun).1.symm + +/-- In the excess-tail branch of `knownCall`, successful execution forces +the requested result world to be shared before higher-order application. -/ +theorem knownCall_over_run_world_shared + {src : IxIR0.Env} {fuel count : Nat} {build : Array Atom → Op} + {argWorlds : List Owned} {resultWorld : Owned} {input output : VEnv} + {args : List IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hover : count < args.length) + (hrun : (knownCall src (fuel + 1) input build count argWorlds + resultWorld args).run state = .ok (output, emit, av) finalState) : + resultWorld = .shared := by + simp only [knownCall] at hrun + obtain ⟨prefixResult, prefixState, _, hafterPrefix⟩ := + estateBindRun_ok_inv hrun + rcases prefixResult with ⟨prefixOutput, emitPrefix, prefixAVals⟩ + dsimp only at hafterPrefix + rw [if_neg (Nat.not_le.mpr hover)] at hafterPrefix + exact applyRest_slot_run_world_shared hafterPrefix + +/-- Shared semantic sequencing for `knownCall`. The state predicate lets +ordinary and ambient-state clients choose how a successful tail transports +their prefix evidence, while prefix execution, source splitting, terminal +output recovery, and excess-tail dispatch remain canonical. -/ +private theorem knownCall_run_value_sound_core + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {fuel count : Nat} + {build : Array Atom → Op} {argWorlds : List Owned} + {resultWorld : Owned} {input output : VEnv} + {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + {Reach : LowSt → Prop} + {PrefixSound : VEnv → Emit → List AVal → Prop} + {BuiltSound : IxIR0.Value → VEnv → Emit → List AVal → Prop} + {Result : IxIR0.Value → VEnv → Emit → AVal → LowSt → Prop} + (hprefixBack : ∀ {prefixOutput : VEnv} {emitPrefix : Emit} + {prefixAVals : List AVal} {prefixState : LowSt}, + (applyRest src fuel prefixOutput.bump resultWorld + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) (args.drop count)).run prefixState = + .ok (output, emit, av) finalState → + Reach finalState → Reach prefixState) + (hprefixSound : ∀ {prefixOutput : VEnv} {emitPrefix : Emit} + {prefixAVals : List AVal} {prefixState : LowSt}, + SourceArgsEval sourceCtx sourceEnv + (((args.take count).zip + (padWorlds argWorlds count)).map Prod.fst) + (sourceValues.take count) → + (lowerArgs src fuel input + ((args.take count).zip + (padWorlds argWorlds count))).run state = + .ok (prefixOutput, emitPrefix, prefixAVals) prefixState → + Reach prefixState → PrefixSound prefixOutput emitPrefix prefixAVals) + (hbuild : ∀ {prefixOutput : VEnv} {emitPrefix : Emit} + {prefixAVals : List AVal} {sourceBuilt : IxIR0.Value}, + PrefixSound prefixOutput emitPrefix prefixAVals → + SourceApplies sourceCtx sourceFunction (sourceValues.take count) + sourceBuilt → + prefixAVals.length = + ((args.take count).zip + (padWorlds argWorlds count)).length → + BuiltSound sourceBuilt prefixOutput emitPrefix prefixAVals) + (hterminalFinish : ∀ {sourceBuilt : IxIR0.Value} + {prefixOutput : VEnv} {emitPrefix : Emit} + {prefixAVals : List AVal} {prefixState : LowSt}, + args.length ≤ count → + BuiltSound sourceBuilt prefixOutput emitPrefix prefixAVals → + Result sourceBuilt prefixOutput.bump + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) prefixState) + (hoverFinish : ∀ {sourceBuilt : IxIR0.Value} + {prefixOutput : VEnv} {emitPrefix : Emit} + {prefixAVals : List AVal} {prefixState : LowSt}, + count < args.length → + BuiltSound sourceBuilt prefixOutput emitPrefix prefixAVals → + SourceApplies sourceCtx sourceBuilt (sourceValues.drop count) + sourceResult → + (applyRest src fuel prefixOutput.bump resultWorld + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) (args.drop count)).run prefixState = + .ok (output, emit, av) finalState → + Reach finalState → Result sourceResult output emit av finalState) + (hfinalReach : Reach finalState) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hrun : (knownCall src (fuel + 1) input build count argWorlds + resultWorld args).run state = .ok (output, emit, av) finalState) : + Result sourceResult output emit av finalState := by + simp only [knownCall] at hrun + obtain ⟨prefixResult, prefixState, hprefixRun, hafterPrefix⟩ := + estateBindRun_ok_inv hrun + rcases prefixResult with ⟨prefixOutput, emitPrefix, prefixAVals⟩ + dsimp only at hafterPrefix + have hprefixLength := lowerArgs_success_length src hprefixRun + have hprefixSource : SourceArgsEval sourceCtx sourceEnv + (((args.take count).zip + (padWorlds argWorlds count)).map Prod.fst) + (sourceValues.take count) := by + rw [knownCall_prefix_exprs_eq] + exact hsourceArgs.take count + obtain ⟨sourceBuilt, hprefixApply, htailApply⟩ := + hsource.splitAt count + by_cases hle : args.length ≤ count + · rw [if_pos hle] at hafterPrefix + have hpure : + (prefixOutput.bump, + emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray), + AVal.slotA prefixOutput.depth) = (output, emit, av) ∧ + prefixState = finalState := by + simpa using hafterPrefix + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + have hprefix := hprefixSound hprefixSource hprefixRun hfinalReach + have hbuilt := hbuild hprefix hprefixApply hprefixLength + have hsourceLe : sourceValues.length ≤ count := by + simpa [← hsourceArgs.lengths] using hle + rw [List.drop_eq_nil_of_le hsourceLe] at htailApply + cases htailApply + exact hterminalFinish hle hbuilt + · have hover : count < args.length := Nat.lt_of_not_ge hle + rw [if_neg hle] at hafterPrefix + have hprefixReach := hprefixBack hafterPrefix hfinalReach + have hprefix := hprefixSound hprefixSource hprefixRun hprefixReach + have hbuilt := hbuild hprefix hprefixApply hprefixLength + exact hoverFinish hover hbuilt htailApply hafterPrefix hfinalReach + +/-- Semantic counterpart of `knownCall_run_sound_below`. One source +argument/application spine is split at the executable `take count` boundary. +The operation-specific premise relates the built prefix result; a terminal +run returns it directly, while an excess tail is delegated to the proved +non-erased `applyRest` transformer. -/ +theorem knownCall_run_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel count : Nat} + {build : Array Atom → Op} {argWorlds : List Owned} + {resultWorld buildWorld : Owned} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValuePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + (hrest : ApplyRestNonErasedValuePreserves funRel recSelfRel + sourceCtx ctx cur src fuel) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hbuild : ∀ {prefixOutput : VEnv} {emitPrefix : Emit} + {prefixAVals : List AVal} {sourceBuilt : IxIR0.Value}, + LowerArgsValueSound funRel recSelfRel ctx cur input prefixOutput + sourceEnv sourceEnv (sourceValues.take count) + (((args.take count).zip (padWorlds argWorlds count)).map Prod.snd) + emitPrefix prefixAVals → + SourceApplies sourceCtx sourceFunction (sourceValues.take count) + sourceBuilt → + prefixAVals.length = + ((args.take count).zip (padWorlds argWorlds count)).length → + LowerResultValueSound funRel recSelfRel ctx cur input + prefixOutput.bump sourceEnv sourceEnv sourceBuilt buildWorld + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth)) + (hterminalWorld : args.length ≤ count → buildWorld = resultWorld) + (hoverWorld : count < args.length → buildWorld = .shared) + (hrun : (knownCall src (fuel + 1) input build count argWorlds + resultWorld args).run state = .ok (output, emit, av) finalState) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult resultWorld emit av := by + exact knownCall_run_value_sound_core + (Reach := fun _ => True) + (PrefixSound := fun prefixOutput emitPrefix prefixAVals => + LowerArgsValueSound funRel recSelfRel ctx cur input prefixOutput + sourceEnv sourceEnv (sourceValues.take count) + (((args.take count).zip + (padWorlds argWorlds count)).map Prod.snd) + emitPrefix prefixAVals) + (BuiltSound := fun sourceBuilt prefixOutput emitPrefix prefixAVals => + LowerResultValueSound funRel recSelfRel ctx cur input + prefixOutput.bump sourceEnv sourceEnv sourceBuilt buildWorld + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth)) + (Result := fun actualResult actualOutput actualEmit actualAv _ => + LowerResultValueSound funRel recSelfRel ctx cur input actualOutput + sourceEnv sourceEnv actualResult resultWorld actualEmit actualAv) + (hprefixBack := by + intro _ _ _ _ _ _ + trivial) + (hprefixSound := by + intro _ _ _ _ hprefixSource hprefixRun _ + exact hargs hprefixSource hprefixRun) + (hbuild := hbuild) + (hterminalFinish := by + intro _ _ _ _ _ hle hbuilt + simpa [hterminalWorld hle] using hbuilt) + (hoverFinish := by + intro sourceBuilt prefixOutput emitPrefix prefixAVals _ hover + hbuilt htailApply hafterPrefix _ + have hbuiltShared : LowerResultValueSound funRel recSelfRel ctx cur + input prefixOutput.bump sourceEnv sourceEnv sourceBuilt .shared + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) := by + simpa [hoverWorld hover] using hbuilt + exact hrest (by simp) (hsourceArgs.drop count) htailApply + hbuiltShared hafterPrefix) + (hfinalReach := trivial) hsourceArgs hsource hrun + +/-- Direct-call specialization of the semantic `knownCall` rule. The +source prefix result is exactly the result named by the callee's +`FnValueContract`; any excess source/target tail is then handled by +`ApplyRestNonErasedValuePreserves`. -/ +theorem knownCall_call_run_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur d : FnDef} + {src : IxIR0.Env} {fuel count : Nat} {argWorlds : List Owned} + {resultWorld : Owned} {f : Ixon.Address} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValuePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + (hrest : ApplyRestNonErasedValuePreserves funRel recSelfRel + sourceCtx ctx cur src fuel) + (hworlds : argWorlds.length = count) + (hcount : count ≤ args.length) + (hdecl : ctx.decls f = some (.fn d)) + (hownership : FnOwnershipContract ctx d argWorlds) + (hvalue : FnValueContract funRel sourceCtx ctx d argWorlds + sourceFunction) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hterminalWorld : args.length ≤ count → d.result = resultWorld) + (hoverWorld : count < args.length → d.result = .shared) + (hrun : (knownCall src (fuel + 1) input (.call f ·) count + argWorlds resultWorld args).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult resultWorld emit av := by + refine knownCall_run_value_sound hargs hrest hsourceArgs hsource + ?_ hterminalWorld hoverWorld hrun + intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixSound + hprefixApply _ + have hshape := knownCall_prefix_worlds_eq args argWorlds count + hworlds hcount + have hprefix : LowerArgsValueSound funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + argWorlds emitPrefix prefixAVals := by + simpa only [hshape] using hprefixSound + exact hprefix.call_graph hdecl hownership hvalue hprefixApply + +/-- Recursive-self specialization of semantic `knownCall`. The source +function identity is supplied by the surrounding recursor environment, while +the target operation invokes the current declaration directly. -/ +theorem knownCall_callSelf_run_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel count : Nat} {argWorlds : List Owned} + {resultWorld : Owned} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValuePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + (hrest : ApplyRestNonErasedValuePreserves funRel recSelfRel + sourceCtx ctx cur src fuel) + (hworlds : argWorlds.length = count) + (hcount : count ≤ args.length) + (hownership : FnOwnershipContract ctx cur argWorlds) + (hvalue : FnValueContract funRel sourceCtx ctx cur argWorlds + sourceFunction) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hterminalWorld : args.length ≤ count → cur.result = resultWorld) + (hoverWorld : count < args.length → cur.result = .shared) + (hrun : (knownCall src (fuel + 1) input (.callSelf ·) count + argWorlds resultWorld args).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult resultWorld emit av := by + refine knownCall_run_value_sound hargs hrest hsourceArgs hsource + ?_ hterminalWorld hoverWorld hrun + intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixSound + hprefixApply _ + have hshape := knownCall_prefix_worlds_eq args argWorlds count + hworlds hcount + have hprefix : LowerArgsValueSound funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + argWorlds emitPrefix prefixAVals := by + simpa only [hshape] using hprefixSound + exact hprefix.callSelf_graph hownership hvalue hprefixApply + +/-- Recursive-self `knownCall` whose source identity is represented by the +input environment's synthetic self entry. The value contract is selected +from the `recSelfRel` witness inside `callSelf_entry_graph`, while ownership +and result-world facts remain ordinary static current-function contracts. -/ +theorem knownCall_callSelf_entry_run_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel count index : Nat} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValuePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + (hrest : ApplyRestNonErasedValuePreserves funRel recSelfRel + sourceCtx ctx cur src fuel) + (hcount : count ≤ args.length) + (hentry : input.entries[index]? = some (.recSelf count)) + (hhead : sourceEnv[index]? = some sourceFunction) + (hownership : FnOwnershipContract ctx cur + (List.replicate count .shared)) + (hvalue : recSelfRel sourceFunction count → + FnValueContract funRel sourceCtx ctx cur + (List.replicate count .shared) sourceFunction) + (hresult : cur.result = .shared) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hrun : (knownCall src (fuel + 1) input (.callSelf ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult .shared emit av := by + refine knownCall_run_value_sound hargs hrest hsourceArgs hsource + ?_ (fun _ => by simpa [hresult]) (fun _ => by simpa [hresult]) hrun + intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixSound + hprefixApply _ + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hprefix : LowerArgsValueSound funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate count .shared) emitPrefix prefixAVals := by + simpa only [hshape] using hprefixSound + have hbuilt := hprefix.callSelf_entry_graph hentry hhead hownership + hvalue hprefixApply + simpa [hresult] using hbuilt + +/-- Constructor-allocation specialization of semantic `knownCall`. The +source-side premise identifies saturation of the constructor reference with +the constructor value holding exactly the evaluated prefix fields. -/ +theorem knownCall_alloc_run_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel count : Nat} {world : Owned} + {cid : CtorId} {sourceAddress : Ixon.Address} {sourceTag : Nat} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValuePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + (hrest : ApplyRestNonErasedValuePreserves funRel recSelfRel + sourceCtx ctx cur src fuel) + (hcount : count ≤ args.length) + (haddress : cid.block = sourceAddress) + (htag : cid.cidx = sourceTag) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hctor : SourceApplies sourceCtx sourceFunction + (sourceValues.take count) + (.ctor sourceAddress sourceTag (sourceValues.take count))) + (hrun : (knownCall src (fuel + 1) input (.alloc world cid ·) count + (List.replicate count world) world args).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + refine knownCall_run_value_sound hargs hrest hsourceArgs hsource + ?_ (fun _ => rfl) ?_ hrun + · intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixSound + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count world) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count world) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsValueSound funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length world) + emitPrefix prefixAVals := by + simpa only [hshape, havsLength] using hprefixSound + have hbuilt := hprefix.alloc_graph haddress htag + rw [hprefixApply.deterministic hctor] + exact hbuilt + · intro hover + exact knownCall_over_run_world_shared hover hrun + +/-- Scalar-extern specialization of semantic `knownCall`. The trusted oracle +contract relates the exact source application prefix to the emitted target +extern result; an excess tail is valid only when the successful executable +path has forced that intermediate result into the shared world. -/ +theorem knownCall_extern_run_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel count : Nat} {f : Ixon.Address} + {input output : VEnv} {resultWorld : Owned} + {args : List IxIR0.Expr} {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValuePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + (hrest : ApplyRestNonErasedValuePreserves funRel recSelfRel + sourceCtx ctx cur src fuel) + (hcontract : ExternValueContract funRel sourceCtx ctx) + (hcount : count ≤ args.length) + (hlookup : sourceCtx.env f = some (.extern count)) + (href : SourceRefValue sourceCtx f sourceFunction) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hrun : (knownCall src (fuel + 1) input (.extern f ·) count + (List.replicate count .shared) resultWorld args).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult resultWorld emit av := by + refine knownCall_run_value_sound hargs hrest hsourceArgs hsource + ?_ (fun _ => rfl) ?_ hrun + · intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixSound + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count .shared) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsValueSound funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length .shared) + emitPrefix prefixAVals := by + simpa only [hshape, havsLength] using hprefixSound + have hvalueCount : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hvalueCount] + exact hprefix.extern_graph hcontract hlookup href htakeLength + hprefixApply + · intro hover + exact knownCall_over_run_world_shared hover hrun + +/-- Partial-application specialization of semantic `knownCall`. Its sole +semantic side condition is the canonical function-relation fact for the +residual source function and the prefix stored in the fresh pap node. -/ +theorem knownCall_papp_run_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel count : Nat} {f : Ixon.Address} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValuePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + (hrest : ApplyRestNonErasedValuePreserves funRel recSelfRel + sourceCtx ctx cur src fuel) + (hcount : count ≤ args.length) + (hdecl : ctx.decls f = some d) + (hunder : count < declArity d) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hfun : ∀ {sourceBuilt : IxIR0.Value}, + SourceApplies sourceCtx sourceFunction (sourceValues.take count) + sourceBuilt → + funRel sourceBuilt f (declArity d) (sourceValues.take count)) + (hrun : (knownCall src (fuel + 1) input (.papp f ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult .shared emit av := by + refine knownCall_run_value_sound hargs hrest hsourceArgs hsource + ?_ (fun _ => rfl) (fun _ => rfl) hrun + intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixSound + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count .shared) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsValueSound funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length .shared) + emitPrefix prefixAVals := by + simpa only [hshape, havsLength] using hprefixSound + apply hprefix.papp_graph hdecl (hfun hprefixApply) + simpa [havsLength] using hunder + +/-- Static-address pap allocation under the canonical whole-pass function +relation. The relation side condition of `knownCall_papp_run_value_sound` is +now derived solely from source lookup, source-reference evaluation, and the +same prefix application derivation already split from the source spine. -/ +theorem knownCall_papp_source_run_value_sound + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel count : Nat} + {f : Ixon.Address} {source : IxIR0.Decl} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hrest : ApplyRestNonErasedValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hcount : count ≤ args.length) + (hsrc : src f = some source) + (heligible : SourcePapEligible source) + (harity : sourceDeclArity source = declArity d) + (href : SourceRefValue sourceCtx f sourceFunction) + (hdecl : ctx.decls f = some d) + (hunder : count < declArity d) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hrun : (knownCall src (fuel + 1) input (.papp f ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSound (CompilerFunctionRel sourceCtx src relationState) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + .shared emit av := by + apply knownCall_papp_run_value_sound hargs hrest hcount hdecl hunder + hsourceArgs hsource + · intro sourceBuilt hprefixApply + apply CompilerFunctionRel.source hsrc heligible harity href hprefixApply + have hcountValues : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hcountValues] + simpa [htakeLength] using hunder + · exact hrun + +/-- Constructor-wrapper pap allocation under the canonical function +relation. `ExtraRepresented.wrapper` supplies the target declaration in the +eventual spine theorem; this local rule needs only the cached memo and its +arity agreement. -/ +theorem knownCall_papp_wrapper_run_value_sound + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel count : Nat} + {memo : WrapperMemo} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hrest : ApplyRestNonErasedValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hcount : count ≤ args.length) + (hmember : memo ∈ relationState.wrappers) + (hsrc : src memo.source = some (.ctor memo.tag memo.arity)) + (href : SourceRefValue sourceCtx memo.source sourceFunction) + (hdecl : ctx.decls memo.wrapper = some d) + (harity : memo.arity = declArity d) + (hunder : count < declArity d) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hrun : (knownCall src (fuel + 1) input (.papp memo.wrapper ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSound (CompilerFunctionRel sourceCtx src relationState) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + .shared emit av := by + apply knownCall_papp_run_value_sound hargs hrest hcount hdecl hunder + hsourceArgs hsource + · intro sourceBuilt hprefixApply + rw [← harity] + apply CompilerFunctionRel.wrapper hmember hsrc href hprefixApply + have hcountValues : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hcountValues] + rw [htakeLength] + simpa [harity] using hunder + · exact hrun + +/-- Saturated and over-applied definition references preserve the source +spine result. The source reference witness selects the semantic identity used +by the declaration contract; the executable result-world guard supplies the +terminal or over-application equality required by `knownCall`. -/ +theorem lowerSpine_ref_defn_call_run_value_sound + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hrest : ApplyRestNonErasedValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hdecls : SourceDeclContracts src ctx) + (hvalues : SourceDeclValueContracts + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx) + {input output : VEnv} {world result : Owned} {f : Ixon.Address} + {body : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsrc : src f = some (.defn result body)) + (hcount : lamArity body ≤ args.length) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) : + LowerResultValueSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + obtain ⟨d, hdecl, harity, hresult, hownership⟩ := hdecls.defn hsrc + have hvalue : FnValueContract + (CompilerFunctionRel sourceCtx src relationState) sourceCtx ctx d + ((lamUses body).map worldOfUses) sourceFunction := by + apply hvalues.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_neg (Nat.not_lt.mpr hcount)] at hrun + obtain ⟨checked, nextState, hrequireRun, hknownRun⟩ := + estateBindRun_ok_inv hrun + cases checked + obtain ⟨hguard, _⟩ := requireResultWorld_run_ok_inv hrequireRun + refine knownCall_call_run_value_sound hargs hrest (by simp) hcount + hdecl hownership hvalue hsourceArgs hsourceApply ?_ ?_ hknownRun + · intro hterminal + have heq : args.length = lamArity body := + Nat.le_antisymm hterminal hcount + simpa [hresult, heq] using hguard + · intro hover + have hne : args.length ≠ lamArity body := Nat.ne_of_gt hover + simpa [hresult, hne] using hguard + +/-- Under-applied definition references allocate a pap related to the exact +residual source function obtained by applying the evaluated argument prefix. +The executable branch already rules out unique function values, unique +results, and unsafe pap bodies. -/ +theorem lowerSpine_ref_defn_partial_run_value_sound + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hrest : ApplyRestNonErasedValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world result : Owned} {f : Ixon.Address} + {body : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsrc : src f = some (.defn result body)) + (hunder : args.length < lamArity body) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) : + LowerResultValueSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + obtain ⟨d, hdecl, harity, _, _⟩ := hdecls.defn hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (estateThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + cases result with + | unique => + exact (estateThrowRun_not_ok + (by simpa [hsuEq, huuEq] using hrun)).elim + | shared => + cases hp : papSafe body with + | false => + exact (estateThrowRun_not_ok + (by simpa [hsuEq, hp] using hrun)).elim + | true => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq, hp] using hrun + apply knownCall_papp_source_run_value_sound hargs hrest + (Nat.le_refl _) hsrc ⟨rfl, hp⟩ + (by simpa [sourceDeclArity, declArity] using harity.symm) + href hdecl (by simpa [declArity, harity] using hunder) + hsourceArgs hsourceApply hknown + +/-- Saturated and over-applied recursor references are semantic direct calls +through the generated recursor declaration. Both the firing telescope and +its intermediate result live in the shared world. -/ +theorem lowerSpine_ref_recursor_call_run_value_sound + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hrest : ApplyRestNonErasedValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hdecls : SourceDeclContracts src ctx) + (hvalues : SourceDeclValueContracts + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {numArgs : Nat} {natLit : Bool} {rules : Array IxIR0.RecRule} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.recursor numArgs natLit rules)) + (hcount : numArgs + 1 ≤ args.length) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) : + LowerResultValueSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + obtain ⟨d, hdecl, harity, hresult, hownership⟩ := + hdecls.recursor hsrc + have hvalue : FnValueContract + (CompilerFunctionRel sourceCtx src relationState) sourceCtx ctx d + (List.replicate (numArgs + 1) .shared) sourceFunction := by + apply hvalues.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_neg (Nat.not_lt.mpr hcount)] at hrun + obtain ⟨checked, nextState, hrequireRun, hknownRun⟩ := + estateBindRun_ok_inv hrun + cases checked + obtain ⟨hguard, _⟩ := requireResultWorld_run_ok_inv hrequireRun + refine knownCall_call_run_value_sound hargs hrest (by simp) hcount + hdecl hownership hvalue hsourceArgs hsourceApply ?_ ?_ hknownRun + · intro hterminal + have heq : args.length = numArgs + 1 := + Nat.le_antisymm hterminal hcount + simpa [hresult, heq] using hguard + · intro _ + simpa [hresult] using hguard + +/-- Under-applied recursor references allocate a same-address pap governed +by the canonical compiler function relation. -/ +theorem lowerSpine_ref_recursor_partial_run_value_sound + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hrest : ApplyRestNonErasedValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {numArgs : Nat} {natLit : Bool} {rules : Array IxIR0.RecRule} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.recursor numArgs natLit rules)) + (hunder : args.length < numArgs + 1) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) : + LowerResultValueSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + obtain ⟨d, hdecl, harity, _, _⟩ := hdecls.recursor hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (estateThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + apply knownCall_papp_source_run_value_sound hargs hrest + (Nat.le_refl _) hsrc (by simp [SourcePapEligible]) + (by simpa [sourceDeclArity, declArity] using harity.symm) + href hdecl (by simpa [declArity, harity] using hunder) + hsourceArgs hsourceApply hknown + +/-- Saturated and over-applied constructor references allocate the target +node for the exact source saturation prefix, then delegate any excess tail to +semantic higher-order application. -/ +theorem lowerSpine_ref_ctor_alloc_run_value_sound + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hrest : ApplyRestNonErasedValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {tag arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hlookup : sourceCtx.env f = some (.ctor tag arity)) + (hsrc : src f = some (.ctor tag arity)) + (hcount : arity ≤ args.length) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) : + LowerResultValueSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + have hvalueCount : arity ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take arity).length = arity := by + simp [List.length_take, hvalueCount] + have hctor : SourceApplies sourceCtx sourceFunction + (sourceValues.take arity) + (.ctor f tag (sourceValues.take arity)) := + sourceCtorRef_saturates hlookup href htakeLength + have hknown : + (knownCall src (fuel + 1) input + (.alloc world (ctorIdOf f tag) ·) arity + (List.replicate arity world) world args).run state = + .ok (output, emit, av) finalState := by + simpa [lowerSpine, hsrc, Nat.not_lt.mpr hcount] using hrun + exact knownCall_alloc_run_value_sound hargs hrest hcount rfl rfl + hsourceArgs hsourceApply hctor hknown + +/-- Under-applied constructor references use the memoized eta wrapper. The +run's final state contains the produced (or reused) memo; an enclosing +compiler-state extension transports that provenance to the ambient relation +index. -/ +theorem lowerSpine_ref_ctor_partial_run_value_sound + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (hargs : LowerArgsValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hrest : ApplyRestNonErasedValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {tag arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} + (hsrc : src f = some (.ctor tag arity)) + (hunder : args.length < arity) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState relationState) + (hrepresented : ExtraRepresented ctx relationState) : + LowerResultValueSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (estateThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hrun' : + ((wrapperFor f tag arity) >>= fun wrapper => + knownCall src (fuel + 1) input (.papp wrapper ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + obtain ⟨wrapper, wrapperState, hwrapperRun, hknownRun⟩ := + estateBindRun_ok_inv hrun' + let memo : WrapperMemo := ⟨f, tag, arity, wrapper⟩ + have hmemoFinal : memo ∈ finalState.wrappers := + (hknownExtra input (.papp wrapper ·) args.length + (List.replicate args.length .shared) .shared args + hknownRun).wrapper_mem (wrapperFor_memo_mem hwrapperRun) + have hmemo : memo ∈ relationState.wrappers := + hextends.wrapper_mem hmemoFinal + have hdecl := hrepresented.wrapper hmemo + apply knownCall_papp_wrapper_run_value_sound hargs hrest + (Nat.le_refl _) hmemo hsrc href hdecl + (by simp [memo, ctorWrapperDecl, declArity]) + (by simpa [memo, ctorWrapperDecl, declArity] using hunder) + hsourceArgs hsourceApply hknownRun + +/-- Saturated and over-applied extern references route the evaluated source +prefix through the explicit scalar-oracle compatibility contract. -/ +theorem lowerSpine_ref_extern_call_run_value_sound + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hrest : ApplyRestNonErasedValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hcontract : ExternValueContract + (CompilerFunctionRel sourceCtx src relationState) sourceCtx ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hlookup : sourceCtx.env f = some (.extern arity)) + (hsrc : src f = some (.extern arity)) + (hcount : arity ≤ args.length) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) : + LowerResultValueSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + have hknown : + (knownCall src (fuel + 1) input (.extern f ·) arity + (List.replicate arity .shared) world args).run state = + .ok (output, emit, av) finalState := by + simpa [lowerSpine, hsrc, Nat.not_lt.mpr hcount] using hrun + exact knownCall_extern_run_value_sound hargs hrest hcontract hcount + hlookup href hsourceArgs hsourceApply hknown + +/-- Under-applied extern references are ordinary same-address paps. Target +layout supplies the extern declaration used by pap allocation, while the +canonical function relation records the residual source application. -/ +theorem lowerSpine_ref_extern_partial_run_value_sound + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hrest : ApplyRestNonErasedValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsrc : src f = some (.extern arity)) + (hunder : args.length < arity) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) : + LowerResultValueSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + have hdecl := hdecls.extern hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (estateThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + apply knownCall_papp_source_run_value_sound hargs hrest + (Nat.le_refl _) hsrc (by simp [SourcePapEligible]) (by rfl) href hdecl + (by simpa [declArity] using hunder) + hsourceArgs hsourceApply hknown + +/-- Shared complete dispatch for a successful static-reference spine. The +result proposition keeps ownership, semantic, progress, and profile clients +separate while source lookup, declaration classification, arity comparison, +and unknown-reference rejection remain canonical. -/ +theorem lowerSpine_ref_run_core + {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {args : List IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} {Result : Prop} + (hdefnPartial : ∀ (result : Owned) (body : IxIR0.Expr), + src f = some (.defn result body) → + args.length < lamArity body → Result) + (hdefnCall : ∀ (result : Owned) (body : IxIR0.Expr), + src f = some (.defn result body) → + lamArity body ≤ args.length → Result) + (hctorPartial : ∀ (tag arity : Nat), + src f = some (.ctor tag arity) → args.length < arity → Result) + (hctorAlloc : ∀ (tag arity : Nat), + src f = some (.ctor tag arity) → arity ≤ args.length → Result) + (hrecursorPartial : ∀ (numArgs : Nat) (natLit : Bool) + (rules : Array IxIR0.RecRule), + src f = some (.recursor numArgs natLit rules) → + args.length < numArgs + 1 → Result) + (hrecursorCall : ∀ (numArgs : Nat) (natLit : Bool) + (rules : Array IxIR0.RecRule), + src f = some (.recursor numArgs natLit rules) → + numArgs + 1 ≤ args.length → Result) + (hexternPartial : ∀ (arity : Nat), + src f = some (.extern arity) → args.length < arity → Result) + (hexternCall : ∀ (arity : Nat), + src f = some (.extern arity) → arity ≤ args.length → Result) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) : + Result := by + cases hsrc : src f with + | none => + exact (estateThrowRun_not_ok + (by simpa [lowerSpine, hsrc] using hrun)).elim + | some source => + cases source with + | defn result body => + by_cases hunder : args.length < lamArity body + · exact hdefnPartial result body hsrc hunder + · exact hdefnCall result body hsrc (Nat.le_of_not_gt hunder) + | ctor tag arity => + by_cases hunder : args.length < arity + · exact hctorPartial tag arity hsrc hunder + · exact hctorAlloc tag arity hsrc (Nat.le_of_not_gt hunder) + | recursor numArgs natLit rules => + by_cases hunder : args.length < numArgs + 1 + · exact hrecursorPartial numArgs natLit rules hsrc hunder + · exact hrecursorCall numArgs natLit rules hsrc + (Nat.le_of_not_gt hunder) + | extern arity => + by_cases hunder : args.length < arity + · exact hexternPartial arity hsrc hunder + · exact hexternCall arity hsrc (Nat.le_of_not_gt hunder) + +/-- Complete semantic `.ref` spine dispatch for the canonical compiler +function relation. Definitions and recursors use paired ownership/value +contracts, constructors use source saturation plus wrapper provenance, and +externs cross the explicit scalar-oracle compatibility boundary. -/ +theorem lowerSpine_ref_run_value_sound + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hargs : LowerArgsValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hrest : ApplyRestNonErasedValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState relationState) + (hrepresented : ExtraRepresented ctx relationState) : + LowerResultValueSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult world emit av := by + exact lowerSpine_ref_run_core + (Result := LowerResultValueSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel ctx cur + input output sourceEnv sourceEnv sourceResult world emit av) + (hdefnPartial := by + intro _ _ hsrc hunder + exact lowerSpine_ref_defn_partial_run_value_sound + hargs hrest hcontracts.decls hsrc hunder hsource hrun) + (hdefnCall := by + intro _ _ hsrc hcount + exact lowerSpine_ref_defn_call_run_value_sound + hargs hrest hcontracts.decls hvalues.decls hsrc hcount hsource hrun) + (hctorPartial := by + intro _ _ hsrc hunder + exact lowerSpine_ref_ctor_partial_run_value_sound + hargs hrest hknownExtra hsrc hunder hsource hrun hextends + hrepresented) + (hctorAlloc := by + intro tag arity hsrc hcount + have hlookup : sourceCtx.env f = some (.ctor tag arity) := by + rw [henv] + exact hsrc + exact lowerSpine_ref_ctor_alloc_run_value_sound + hargs hrest hlookup hsrc hcount hsource hrun) + (hrecursorPartial := by + intro _ _ _ hsrc hunder + exact lowerSpine_ref_recursor_partial_run_value_sound + hargs hrest hcontracts.decls hsrc hunder hsource hrun) + (hrecursorCall := by + intro _ _ _ hsrc hcount + exact lowerSpine_ref_recursor_call_run_value_sound + hargs hrest hcontracts.decls hvalues.decls hsrc hcount hsource hrun) + (hexternPartial := by + intro _ hsrc hunder + exact lowerSpine_ref_extern_partial_run_value_sound + hargs hrest hcontracts.decls hsrc hunder hsource hrun) + (hexternCall := by + intro arity hsrc hcount + have hlookup : sourceCtx.env f = some (.extern arity) := by + rw [henv] + exact hsrc + exact lowerSpine_ref_extern_call_run_value_sound + hargs hrest hvalues.extern hlookup hsrc hcount hsource hrun) + hrun + +/-- Semantic saturated/over-applied recursive-self spine. The source +variable lookup identifies the self function in `SourceSpineEval`; the +synthetic environment entry supplies its `recSelfRel` witness when the call +emission is interpreted. Under-application remains deliberately rejected by +the executable v1 lowerer. -/ +theorem lowerSpine_recSelf_run_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValuePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + (hrest : ApplyRestNonErasedValuePreserves funRel recSelfRel + sourceCtx ctx cur src fuel) + {input output : VEnv} {world : Owned} {index arity : Nat} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hentry : input.entries[index]? = some (.recSelf arity)) + (hownership : FnOwnershipContract ctx cur + (List.replicate arity .shared)) + (hvalue : ∀ {sourceFunction : IxIR0.Value}, + recSelfRel sourceFunction arity → + FnValueContract funRel sourceCtx ctx cur + (List.replicate arity .shared) sourceFunction) + (hresult : cur.result = .shared) + (hsource : SourceSpineEval sourceCtx sourceEnv (.var index) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.var index) args).run + state = .ok (output, emit, av) finalState) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + apply hsource.eliminate + · intro sourceFunction sourceValues hhead hsourceArgs hsourceApply + obtain ⟨sourceFuel, hhead⟩ := hhead + have hsourceHead : sourceEnv[index]? = some sourceFunction := + sourceEval_var_inv hhead + simp only [lowerSpine] at hrun + rw [hentry] at hrun + simp only at hrun + by_cases hunder : args.length < arity + · rw [if_pos hunder] at hrun + exact (estateThrowRun_not_ok hrun).elim + · rw [if_neg hunder] at hrun + have hcount : arity ≤ args.length := Nat.le_of_not_gt hunder + cases world with + | unique => + have hrequire : + (requireResultWorld .shared .unique).run state = + .error "call result is shared at unique demand" state := by + rfl + rw [estateBindRun, hrequire] at hrun + contradiction + | shared => + have hrequire : + (requireResultWorld .shared .shared).run state = + .ok () state := by + rfl + rw [estateBindRun, hrequire] at hrun + simp only at hrun + exact knownCall_callSelf_entry_run_value_sound hargs hrest hcount + hentry hsourceHead hownership hvalue hresult hsourceArgs + hsourceApply hrun + +/-- One successful compiler-fuel `knownCall` step, factored uniformly across +call, self-call, allocation, pap, and extern builders. -/ +theorem knownCall_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel count : Nat} {build : Array Atom → Op} + {argWorlds : List Owned} {resultWorld buildWorld : Owned} + {input : VEnv} {args : List IxIR0.Expr} + {state finalState : LowSt} {output : VEnv} + {emit : Emit} {av : AVal} + (hargs : LowerArgsPreservesBelow ctx cur limit src fuel) + (hrest : ApplyRestPreservesBelow ctx cur limit src fuel) + (hrestExtra : ApplyRestExtraMonotone src fuel) + (hbuild : ∀ {prefixOutput : VEnv} + {emitPrefix : Emit} {prefixAVals : List AVal}, + LowerArgsSoundBelow ctx cur limit input prefixOutput + (((args.take count).zip (padWorlds argWorlds count)).map Prod.snd) + emitPrefix prefixAVals → + prefixAVals.length = + ((args.take count).zip (padWorlds argWorlds count)).length → + LowerResultSoundBelow ctx cur limit input prefixOutput.bump buildWorld + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth)) + (hterminalWorld : args.length ≤ count → buildWorld = resultWorld) + (hoverWorld : count < args.length → buildWorld = .shared) + (hrun : (knownCall src (fuel + 1) input build count argWorlds + resultWorld args).run state = .ok (output, emit, av) finalState) : + ExtraRepresented ctx finalState → + SelfAvailableBelow ctx cur limit input → + LowerResultSoundBelow ctx cur limit input output resultWorld emit av := by + intro hrepresented havailable + simp only [knownCall] at hrun + obtain ⟨prefixResult, prefixState, hprefixRun, hafterPrefix⟩ := + estateBindRun_ok_inv hrun + rcases prefixResult with ⟨prefixOutput, emitPrefix, prefixAVals⟩ + dsimp only at hafterPrefix + have hprefixLength := lowerArgs_success_length src hprefixRun + by_cases hle : args.length ≤ count + · rw [if_pos hle] at hafterPrefix + have hpure : + (prefixOutput.bump, + emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray), + AVal.slotA prefixOutput.depth) = (output, emit, av) ∧ + prefixState = finalState := by + simpa using hafterPrefix + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + have hprefixSound := hargs hprefixRun hrepresented havailable + have hbuilt := hbuild hprefixSound hprefixLength + simpa [hterminalWorld hle] using hbuilt + · have hover : count < args.length := Nat.lt_of_not_ge hle + rw [if_neg hle] at hafterPrefix + have hprefixRepresented : ExtraRepresented ctx prefixState := + hrepresented.of_extends + (hrestExtra prefixOutput.bump resultWorld + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) (args.drop count) hafterPrefix) + have hprefixSound := hargs hprefixRun hprefixRepresented havailable + have hbuilt := hbuild hprefixSound hprefixLength + have hbuiltShared : LowerResultSoundBelow ctx cur limit input + prefixOutput.bump .shared + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) := by + simpa [hoverWorld hover] using hbuilt + have hprefixAvailable := havailable.lowerArgs hprefixRun + exact hrest hbuiltShared hafterPrefix hrepresented hprefixAvailable.bump + +/-- Uniform wrapper for operation builders whose world law holds for every +argument list. -/ +theorem knownCallPreservesBelow_succ + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel count : Nat} {build : Array Atom → Op} + {argWorlds : List Owned} {resultWorld buildWorld : Owned} + (hargs : LowerArgsPreservesBelow ctx cur limit src fuel) + (hrest : ApplyRestPreservesBelow ctx cur limit src fuel) + (hrestExtra : ApplyRestExtraMonotone src fuel) + (hbuild : ∀ {input output : VEnv} {args : List IxIR0.Expr} + {emit : Emit} {avs : List AVal}, + LowerArgsSoundBelow ctx cur limit input output + (((args.take count).zip (padWorlds argWorlds count)).map Prod.snd) + emit avs → + LowerResultSoundBelow ctx cur limit input output.bump buildWorld + (emit ∘ emitOp (build (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth)) + (hterminalWorld : ∀ {args : List IxIR0.Expr}, + args.length ≤ count → buildWorld = resultWorld) + (hoverWorld : ∀ {args : List IxIR0.Expr}, + count < args.length → buildWorld = .shared) : + KnownCallPreservesBelow ctx cur limit src (fuel + 1) build count + argWorlds resultWorld := by + intro input args state finalState output emit av hrun hrepresented + havailable + exact knownCall_run_sound_below hargs hrest hrestExtra + (fun hsound _ => hbuild (args := args) hsound) + (fun hle => hterminalWorld hle) (fun hover => hoverWorld hover) hrun + hrepresented havailable + +/-- A partial application consumes every supplied shared argument into a +fresh shared pap. Choosing the known-call prefix length to be the whole +argument list makes the over-application branch impossible. -/ +theorem knownCall_papp_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} + (hargs : LowerArgsPreservesBelow ctx cur limit src fuel) + (hrest : ApplyRestPreservesBelow ctx cur limit src fuel) + (hrestExtra : ApplyRestExtraMonotone src fuel) + {input output : VEnv} {f : Ixon.Address} {d : Decl} + {args : List IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hdecl : ctx.decls f = some d) + (hunder : args.length < declArity d) + (hrun : (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (havailable : SelfAvailableBelow ctx cur limit input) : + LowerResultSoundBelow ctx cur limit input output .shared emit av := by + refine knownCall_run_sound_below + (build := .papp f) (count := args.length) + (argWorlds := List.replicate args.length .shared) + (resultWorld := .shared) (buildWorld := .shared) + (args := args) hargs hrest hrestExtra ?_ ?_ ?_ hrun hrepresented + havailable + · intro prefixOutput emitPrefix prefixAVals hprefixSound hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate args.length .shared) args.length (by simp) + (Nat.le_refl _) + have hzipLength := knownCall_prefix_length_eq args + (List.replicate args.length .shared) args.length (by simp) + (Nat.le_refl _) + have havsLength : prefixAVals.length = args.length := + hprefixLength.trans hzipLength + have hsound : LowerArgsSoundBelow ctx cur limit input prefixOutput + (List.replicate prefixAVals.length .shared) + emitPrefix prefixAVals := by + simpa only [hshape, havsLength] using hprefixSound + apply hsound.papp_owned hdecl + simpa [havsLength] using hunder + · intro _ + rfl + · intro hover + omega + +/-- A saturated extern prefix consumes homogeneous shared scalar arguments. +Terminal calls return at the demanded world; an excess tail is necessarily +shared by executable `applyRest` inversion. -/ +theorem knownCall_extern_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel count : Nat} + (hargs : LowerArgsPreservesBelow ctx cur limit src fuel) + (hrest : ApplyRestPreservesBelow ctx cur limit src fuel) + (hrestExtra : ApplyRestExtraMonotone src fuel) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {args : List IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hcount : count ≤ args.length) + (hrun : (knownCall src (fuel + 1) input (.extern f ·) count + (List.replicate count .shared) world args).run state = + .ok (output, emit, av) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (havailable : SelfAvailableBelow ctx cur limit input) : + LowerResultSoundBelow ctx cur limit input output world emit av := by + refine knownCall_run_sound_below + (build := .extern f) (count := count) + (argWorlds := List.replicate count .shared) + (resultWorld := world) (buildWorld := world) + (args := args) hargs hrest hrestExtra ?_ ?_ ?_ hrun hrepresented + havailable + · intro prefixOutput emitPrefix prefixAVals hprefixSound hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count .shared) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hsound : LowerArgsSoundBelow ctx cur limit input prefixOutput + (List.replicate prefixAVals.length .shared) + emitPrefix prefixAVals := by + simpa only [hshape, havsLength] using hprefixSound + exact hsound.extern_owned + · intro _ + rfl + · intro hover + exact knownCall_over_run_world_shared hover hrun + +/-- A saturated constructor prefix consumes a homogeneous telescope in the +node's whole-value world. If an excess application tail exists, successful +execution forces that node world to be shared. -/ +theorem knownCall_alloc_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel count : Nat} + (hargs : LowerArgsPreservesBelow ctx cur limit src fuel) + (hrest : ApplyRestPreservesBelow ctx cur limit src fuel) + (hrestExtra : ApplyRestExtraMonotone src fuel) + {input output : VEnv} {world : Owned} {cid : CtorId} + {args : List IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hcount : count ≤ args.length) + (hrun : (knownCall src (fuel + 1) input (.alloc world cid ·) count + (List.replicate count world) world args).run state = + .ok (output, emit, av) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (havailable : SelfAvailableBelow ctx cur limit input) : + LowerResultSoundBelow ctx cur limit input output world emit av := by + refine knownCall_run_sound_below + (build := .alloc world cid) (count := count) + (argWorlds := List.replicate count world) + (resultWorld := world) (buildWorld := world) + (args := args) hargs hrest hrestExtra ?_ ?_ ?_ hrun hrepresented + havailable + · intro prefixOutput emitPrefix prefixAVals hprefixSound hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count world) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count world) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hsound : LowerArgsSoundBelow ctx cur limit input prefixOutput + (List.replicate prefixAVals.length world) + emitPrefix prefixAVals := by + simpa only [hshape, havsLength] using hprefixSound + exact hsound.alloc_owned + · intro _ + rfl + · intro hover + exact knownCall_over_run_world_shared hover hrun + +/-! ## Executable `lowerSpine` dispatch -/ + +/-- Flattening one more source application is exactly the recursive +`lowerSpine` judgment on the extended argument list. -/ +theorem lowerSpine_app_verified {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) (Γ output : VEnv) + (world : Owned) (function argument : IxIR0.Expr) + (args : List IxIR0.Expr) (emit : Emit) (av : AVal) + (state finalState : LowSt) + (hrun : (lowerSpine src fuel Γ world function (argument :: args)).run + state = .ok (output, emit, av) finalState) + (hsound : LowerResultSound ctx cur Γ output world emit av) : + (lowerSpine src (Nat.succ fuel) Γ world (.app function argument) + args).run state = .ok (output, emit, av) finalState ∧ + LowerResultSound ctx cur Γ output world emit av := by + exact ⟨by simpa [lowerSpine] using hrun, hsound⟩ + +/-- A syntactic erased spine head evaluates all shared arguments, releases +their owners, and returns erased at either demanded result world. -/ +theorem lowerSpine_erased_verified {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) (Γ output : VEnv) + (world : Owned) (args : List IxIR0.Expr) + (emitArgs : Emit) (avs : List AVal) + (state finalState : LowSt) + (hargsRun : + (lowerArgs src fuel Γ + (args.map (fun arg => (arg, Owned.shared)))).run state = + .ok (output, emitArgs, avs) finalState) + (hargsSound : LowerArgsSound ctx cur Γ output + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) + emitArgs avs) + (hworldsHomogeneous : + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate avs.length .shared) : + (lowerSpine src (Nat.succ (Nat.succ fuel)) Γ world .erased args).run + state = + .ok ((releaseAll output avs).1, + ((_root_.id : Emit) ∘ emitArgs) ∘ (releaseAll output avs).2, + .constA .erased) finalState ∧ + LowerResultSound ctx cur Γ (releaseAll output avs).1 world + (((_root_.id : Emit) ∘ emitArgs) ∘ (releaseAll output avs).2) + (.constA .erased) := by + have happly := applyRest_erased_verified (ctx := ctx) (cur := cur) + src fuel Γ Γ output world (_root_.id : Emit) emitArgs args avs + state finalState hargsRun hargsSound hworldsHomogeneous + (lower_erased_sound (ctx := ctx) (cur := cur) (Γ := Γ) + (world := .shared)) + constructor + · simpa only [lowerSpine] using happly.1 + · exact happly.2 + +/-- An ordinary source variable (as opposed to `recSelf`) is lowered as a +shared function value and then enters the proved non-erased `applyRest` +path. -/ +theorem lowerSpine_var_apply_verified {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) + (input functionOutput output : VEnv) + (i abs remaining : Nat) (uses : Uses) (held : Bool) + (args : List IxIR0.Expr) (emitFunction emitArgs : Emit) + (function : AVal) (avs : List AVal) + (state middleState finalState : LowSt) + (hentry : input.entries[i]? = + some (.slot abs remaining uses held)) + (hfunctionRun : + (lowerE src (Nat.succ fuel) input .shared (.var i)).run state = + .ok (functionOutput, emitFunction, function) middleState) + (hfunction : LowerResultSound ctx cur input functionOutput .shared + emitFunction function) + (hfunctionNe : function ≠ .constA .erased) + (hargsRun : + (lowerArgs src fuel functionOutput + (args.map (fun arg => (arg, Owned.shared)))).run middleState = + .ok (output, emitArgs, avs) finalState) + (hargsSound : LowerArgsSound ctx cur functionOutput output + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) + emitArgs avs) + (hworldsHomogeneous : + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate avs.length .shared) + (hcontract : ApplyOwnershipContract ctx) : + (lowerSpine src (Nat.succ (Nat.succ fuel)) input .shared (.var i) + args).run state = + .ok (output.bump, + (emitFunction ∘ emitArgs) ∘ + emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray), + .slotA output.depth) finalState ∧ + LowerResultSound ctx cur input output.bump .shared + ((emitFunction ∘ emitArgs) ∘ + emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + have happly := applyRest_shared_verified (ctx := ctx) (cur := cur) + src fuel input functionOutput output emitFunction emitArgs function + args avs middleState finalState hfunctionNe hargsRun hargsSound + hworldsHomogeneous hfunction hcontract + constructor + · simp only [lowerSpine] + rw [hentry] + simp only + rw [estateBindRun, hfunctionRun] + exact happly.1 + · exact happly.2 + +/-- Source heads handled by `lowerSpine`'s final dynamic fallback: lower the +head expression normally, then pass its descriptor to `applyRest`. -/ +inductive DynamicSpineHead : IxIR0.Expr → Prop where + | lam (uses : Uses) (body : IxIR0.Expr) : + DynamicSpineHead (.lam uses body) + | letE (uses : Uses) (value body : IxIR0.Expr) : + DynamicSpineHead (.letE uses value body) + | proj (index : Nat) (value : IxIR0.Expr) : + DynamicSpineHead (.proj index value) + | lit (literal : IxIR0.Literal) : + DynamicSpineHead (.lit literal) + +/-- Executable inversion for the four dynamic spine heads. They all run the +same predecessor-fuel `lowerE` action followed by the same `applyRest` +action; the syntactic predicate merely justifies selecting that fallback +branch of `lowerSpine`. -/ +theorem lowerSpine_dynamic_run_inv + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {world : Owned} {head : IxIR0.Expr} {args : List IxIR0.Expr} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hshape : DynamicSpineHead head) + (hrun : (lowerSpine src (fuel + 2) input world head args).run state = + .ok (output, emit, av) finalState) : + ∃ functionOutput emitFunction function middleState, + (lowerE src (fuel + 1) input .shared head).run state = + .ok (functionOutput, emitFunction, function) middleState ∧ + (applyRest src (fuel + 1) functionOutput world emitFunction + function args).run middleState = + .ok (output, emit, av) finalState := by + cases hshape <;> simp only [lowerSpine] at hrun + all_goals + obtain ⟨functionResult, middleState, hfunctionRun, hrestRun⟩ := + estateBindRun_ok_inv hrun + rcases functionResult with ⟨functionOutput, emitFunction, function⟩ + exact ⟨functionOutput, emitFunction, function, middleState, + hfunctionRun, hrestRun⟩ + +/-- Dynamic spine reflection follows the only branch capable of returning +literal erased: the head expression returned erased and `applyRest` absorbed +the argument vector. Source application of erased is deterministic. -/ +theorem lowerSpine_dynamic_run_reflectsErased + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {fuel : Nat} + (hreflect : LowerEReflectsErased sourceCtx src fuel) + {input output : VEnv} {world : Owned} {head : IxIR0.Expr} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hshape : DynamicSpineHead head) + (hsource : SourceSpineEval sourceCtx sourceEnv head args sourceResult) + (hrun : (lowerSpine src (fuel + 1) input world head args).run state = + .ok (output, emit, av) finalState) + (herased : av = .constA .erased) : + sourceResult = .erased := by + subst av + apply hsource.eliminate + · intro sourceFunction sourceArgs hhead hsourceArgs hsourceApply + obtain ⟨sourceFuel, hhead⟩ := hhead + cases hshape <;> simp only [lowerSpine] at hrun + all_goals + obtain ⟨functionResult, middleState, hfunctionRun, hrestRun⟩ := + estateBindRun_ok_inv hrun + rcases functionResult with + ⟨functionOutput, emitFunction, function⟩ + have hfunctionErased : function = .constA .erased := + applyRest_run_constErased_inv hrestRun + have hsourceErased : sourceFunction = .erased := + hreflect hhead hfunctionRun hfunctionErased + subst sourceFunction + exact hsourceApply.deterministic + (SourceApplies.erased sourceCtx sourceArgs) + +/-- One compiler-fuel step of pure erased-descriptor reflection for both +expressions and spines. This theorem closes application flattening, ordinary +variables, synthetic self, static references, and all dynamic heads without +any heap realizability premise. -/ +theorem lowerSpineReflectsErased_succ + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {fuel : Nat} + (hspine : LowerSpineReflectsErased sourceCtx src fuel) + (hexpr : LowerEReflectsErased sourceCtx src fuel) : + LowerSpineReflectsErased sourceCtx src (fuel + 1) := by + intro input output world head args sourceEnv sourceResult state finalState + emit av hsource hrun herased + cases head with + | app function argument => + apply hspine hsource.flattenApp + · simpa [lowerSpine] using hrun + · exact herased + | erased => + apply hsource.eliminate + · intro sourceFunction sourceArgs hhead hsourceArgs hsourceApply + obtain ⟨sourceFuel, hhead⟩ := hhead + have hsourceFunction : sourceFunction = .erased := + sourceEval_erased_inv hhead + subst sourceFunction + exact hsourceApply.deterministic + (SourceApplies.erased sourceCtx sourceArgs) + | ref address => + subst av + exact (lowerSpine_ref_run_ne_constErased hrun).elim + | lam uses body => + exact lowerSpine_dynamic_run_reflectsErased hexpr (.lam uses body) + hsource hrun herased + | letE uses value body => + exact lowerSpine_dynamic_run_reflectsErased hexpr + (.letE uses value body) hsource hrun herased + | proj index source => + exact lowerSpine_dynamic_run_reflectsErased hexpr + (.proj index source) hsource hrun herased + | lit literal => + exact lowerSpine_dynamic_run_reflectsErased hexpr (.lit literal) + hsource hrun herased + | var index => + subst av + apply hsource.eliminate + · intro sourceFunction sourceArgs hhead hsourceArgs hsourceApply + obtain ⟨sourceFuel, hhead⟩ := hhead + have hdynamic : + ∀ {functionOutput : VEnv} {emitFunction : Emit} + {function : AVal} {middleState : LowSt}, + (lowerE src fuel input .shared (.var index)).run state = + .ok (functionOutput, emitFunction, function) middleState → + (applyRest src fuel functionOutput world emitFunction function + args).run middleState = + .ok (output, emit, .constA .erased) finalState → + sourceResult = .erased := by + intro functionOutput emitFunction function middleState + hfunctionRun hrestRun + have hfunctionErased : function = .constA .erased := + applyRest_run_constErased_inv hrestRun + have hsourceErased : sourceFunction = .erased := + hexpr hhead hfunctionRun hfunctionErased + subst sourceFunction + exact hsourceApply.deterministic + (SourceApplies.erased sourceCtx sourceArgs) + simp only [lowerSpine] at hrun + cases hentry : input.entries[index]? with + | none => + obtain ⟨functionResult, middleState, hfunctionRun, hrestRun⟩ := + estateBindRun_ok_inv (by simpa [hentry] using hrun) + rcases functionResult with + ⟨functionOutput, emitFunction, function⟩ + exact hdynamic hfunctionRun hrestRun + | some entry => + cases entry with + | slot abs remaining uses held => + obtain ⟨functionResult, middleState, hfunctionRun, hrestRun⟩ := + estateBindRun_ok_inv (by simpa [hentry] using hrun) + rcases functionResult with + ⟨functionOutput, emitFunction, function⟩ + exact hdynamic hfunctionRun hrestRun + | recSelf arity => + rw [hentry] at hrun + simp only at hrun + by_cases hunder : args.length < arity + · rw [if_pos hunder] at hrun + exact (estateThrowRun_not_ok hrun).elim + · rw [if_neg hunder] at hrun + obtain ⟨_, _, _, hknownRun⟩ := estateBindRun_ok_inv hrun + exact (knownCall_run_ne_constErased hknownRun).elim + +/-- Shared semantic core for every `lowerSpine` branch that lowers its head +at the shared world and then delegates to `applyRest`. The head relation and +final result remain client-defined, while source-spine inversion, erased +reflection, and erased/non-erased application dispatch are single-sourced. -/ +private theorem lowerSpine_apply_run_value_sound_core + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Owned} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + {HeadSound : IxIR0.Value → VEnv → Emit → AVal → LowSt → Prop} + {Result : IxIR0.Value → Prop} + (hheadSound : ∀ {sourceFuel : Nat} + {sourceFunction : IxIR0.Value} {functionOutput : VEnv} + {emitFunction : Emit} {function : AVal} {middleState : LowSt}, + IxIR0.eval sourceCtx sourceFuel sourceEnv head = .ok sourceFunction → + (lowerE src (fuel + 1) input .shared head).run state = + .ok (functionOutput, emitFunction, function) middleState → + (applyRest src (fuel + 1) functionOutput world emitFunction + function args).run middleState = + .ok (output, emit, av) finalState → + HeadSound sourceFunction functionOutput emitFunction function + middleState) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (herasedFinish : ∀ {sourceArgs : List IxIR0.Value} + {functionOutput : VEnv} {emitFunction : Emit} + {middleState : LowSt}, + SourceArgsEval sourceCtx sourceEnv args sourceArgs → + HeadSound .erased functionOutput emitFunction (.constA .erased) + middleState → + (applyRest src (fuel + 1) functionOutput world emitFunction + (.constA .erased) args).run middleState = + .ok (output, emit, av) finalState → + Result .erased) + (hnonErasedFinish : ∀ {sourceFunction : IxIR0.Value} + {sourceArgs : List IxIR0.Value} {functionOutput : VEnv} + {emitFunction : Emit} {function : AVal} {middleState : LowSt}, + function ≠ .constA .erased → + SourceArgsEval sourceCtx sourceEnv args sourceArgs → + SourceApplies sourceCtx sourceFunction sourceArgs sourceResult → + HeadSound sourceFunction functionOutput emitFunction function + middleState → + (applyRest src (fuel + 1) functionOutput world emitFunction + function args).run middleState = + .ok (output, emit, av) finalState → + Result sourceResult) + (hsource : SourceSpineEval sourceCtx sourceEnv head args sourceResult) + (hinvert : ∃ functionOutput emitFunction function middleState, + (lowerE src (fuel + 1) input .shared head).run state = + .ok (functionOutput, emitFunction, function) middleState ∧ + (applyRest src (fuel + 1) functionOutput world emitFunction + function args).run middleState = + .ok (output, emit, av) finalState) : + Result sourceResult := by + apply hsource.eliminate + · intro sourceFunction sourceArgs hhead hsourceArgs hsourceApply + obtain ⟨sourceFuel, hhead⟩ := hhead + obtain ⟨functionOutput, emitFunction, function, middleState, + hfunctionRun, hrestRun⟩ := hinvert + have hfunctionSound := hheadSound hhead hfunctionRun hrestRun + by_cases herased : function = .constA .erased + · have hsourceErased : sourceFunction = .erased := + hreflect hhead hfunctionRun herased + subst sourceFunction + have hresult : sourceResult = .erased := + hsourceApply.deterministic + (SourceApplies.erased sourceCtx sourceArgs) + subst sourceResult + subst function + exact herasedFinish hsourceArgs hfunctionSound hrestRun + · exact hnonErasedFinish herased hsourceArgs hsourceApply + hfunctionSound hrestRun + +/-- Complete semantic dynamic-head spine rule. `LowerEReflectsErased` +selects erased absorption versus genuine higher-order application; both +branches consume the same source argument vector carried by +`SourceSpineEval`. -/ +theorem lowerSpine_dynamic_run_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEValuePreserves funRel recSelfRel sourceCtx ctx cur src + (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsValuePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + (hrest : ApplyRestNonErasedValuePreserves funRel recSelfRel + sourceCtx ctx cur src (fuel + 1)) + {input output : VEnv} {world : Owned} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hshape : DynamicSpineHead head) + (hsource : SourceSpineEval sourceCtx sourceEnv head args sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world head args).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + exact lowerSpine_apply_run_value_sound_core + (HeadSound := fun sourceFunction functionOutput emitFunction function + _ => + LowerResultValueSound funRel recSelfRel ctx cur input functionOutput + sourceEnv sourceEnv sourceFunction .shared emitFunction function) + (Result := fun actualResult => + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv actualResult world emit av) + (hheadSound := by + intro _ _ _ _ _ _ hhead hfunctionRun _ + exact hexpr hhead hfunctionRun) + (hreflect := hreflect) + (herasedFinish := by + intro _ _ _ _ hsourceArgs hfunctionSound hrestRun + exact applyRest_erased_run_value_sound hargs hsourceArgs + hfunctionSound hrestRun) + (hnonErasedFinish := by + intro _ _ _ _ _ _ hfunctionNe hsourceArgs hsourceApply + hfunctionSound hrestRun + exact hrest hfunctionNe hsourceArgs hsourceApply hfunctionSound + hrestRun) + hsource (lowerSpine_dynamic_run_inv hshape hrun) + +/-- Executable inversion for an ordinary variable spine. Every entry shape +except the synthetic recursor-self marker follows the same lower-then-apply +path as the dynamic syntactic heads. -/ +theorem lowerSpine_var_dynamic_run_inv + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {world : Owned} {i : Nat} {args : List IxIR0.Expr} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hnotSelf : ∀ arity, + input.entries[i]? ≠ some (.recSelf arity)) + (hrun : (lowerSpine src (fuel + 2) input world (.var i) args).run + state = .ok (output, emit, av) finalState) : + ∃ functionOutput emitFunction function middleState, + (lowerE src (fuel + 1) input .shared (.var i)).run state = + .ok (functionOutput, emitFunction, function) middleState ∧ + (applyRest src (fuel + 1) functionOutput world emitFunction + function args).run middleState = + .ok (output, emit, av) finalState := by + simp only [lowerSpine] at hrun + cases hentry : input.entries[i]? with + | none => + obtain ⟨functionResult, middleState, hfunctionRun, hrestRun⟩ := + estateBindRun_ok_inv (by simpa [hentry] using hrun) + rcases functionResult with ⟨functionOutput, emitFunction, function⟩ + exact ⟨functionOutput, emitFunction, function, middleState, + hfunctionRun, hrestRun⟩ + | some entry => + cases entry with + | recSelf arity => exact (hnotSelf arity hentry).elim + | slot abs remaining uses held => + obtain ⟨functionResult, middleState, hfunctionRun, hrestRun⟩ := + estateBindRun_ok_inv (by simpa [hentry] using hrun) + rcases functionResult with ⟨functionOutput, emitFunction, function⟩ + exact ⟨functionOutput, emitFunction, function, middleState, + hfunctionRun, hrestRun⟩ + +/-- Semantic ordinary-variable spine. Descriptor reflection selects erased +absorption versus genuine higher-order application exactly as for dynamic +heads; the only excluded case is the dedicated static self-call marker. -/ +theorem lowerSpine_var_dynamic_run_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEValuePreserves funRel recSelfRel sourceCtx ctx cur src + (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsValuePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) + (hrest : ApplyRestNonErasedValuePreserves funRel recSelfRel + sourceCtx ctx cur src (fuel + 1)) + {input output : VEnv} {world : Owned} {i : Nat} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hnotSelf : ∀ arity, + input.entries[i]? ≠ some (.recSelf arity)) + (hsource : SourceSpineEval sourceCtx sourceEnv (.var i) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.var i) args).run + state = .ok (output, emit, av) finalState) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + exact lowerSpine_apply_run_value_sound_core + (HeadSound := fun sourceFunction functionOutput emitFunction function + _ => + LowerResultValueSound funRel recSelfRel ctx cur input functionOutput + sourceEnv sourceEnv sourceFunction .shared emitFunction function) + (Result := fun actualResult => + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv actualResult world emit av) + (hheadSound := by + intro _ _ _ _ _ _ hhead hfunctionRun _ + exact hexpr hhead hfunctionRun) + (hreflect := hreflect) + (herasedFinish := by + intro _ _ _ _ hsourceArgs hfunctionSound hrestRun + exact applyRest_erased_run_value_sound hargs hsourceArgs + hfunctionSound hrestRun) + (hnonErasedFinish := by + intro _ _ _ _ _ _ hfunctionNe hsourceArgs hsourceApply + hfunctionSound hrestRun + exact hrest hfunctionNe hsourceArgs hsourceApply hfunctionSound + hrestRun) + hsource (lowerSpine_var_dynamic_run_inv hnotSelf hrun) + +/-- Shared complete head classification for `lowerSpine`. The dependent +result family exposes the refined head to each callback while application, +erased, reference, dynamic, and variable-entry dispatch remain canonical +across ownership, semantic, progress, and profile clients. -/ +theorem lowerSpine_run_core + {input : VEnv} {head : IxIR0.Expr} + {Result : IxIR0.Expr → Prop} + (happ : ∀ (function argument : IxIR0.Expr), + Result (.app function argument)) + (herased : Result .erased) + (hvar : ∀ (index : Nat), + (∀ arity, input.entries[index]? ≠ some (.recSelf arity)) → + Result (.var index)) + (hrecSelf : ∀ (index arity : Nat), + input.entries[index]? = some (.recSelf arity) → Result (.var index)) + (href : ∀ (address : Ixon.Address), Result (.ref address)) + (hdynamic : ∀ (dynamic : IxIR0.Expr), + DynamicSpineHead dynamic → Result dynamic) : + Result head := by + cases head with + | app function argument => exact happ function argument + | erased => exact herased + | var index => + cases hentry : input.entries[index]? with + | none => exact hvar index (fun arity => by simp [hentry]) + | some entry => + cases entry with + | recSelf arity => exact hrecSelf index arity hentry + | slot abs remaining uses held => + exact hvar index (fun arity => by simp [hentry]) + | ref address => exact href address + | lam uses body => exact hdynamic (.lam uses body) (.lam uses body) + | letE uses value body => + exact hdynamic (.letE uses value body) (.letE uses value body) + | proj index value => + exact hdynamic (.proj index value) (.proj index value) + | lit literal => exact hdynamic (.lit literal) (.lit literal) + +/-- One complete semantic `lowerSpine` step. Every executable head family is +covered: application flattening, erased absorption, ordinary variable +application, synthetic self calls, static declaration dispatch, and dynamic +lower-then-apply heads. Current-self contracts are requested only when the +input actually contains a `recSelf` marker. -/ +theorem lowerSpine_run_value_sound + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hspine : LowerSpineValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src (fuel + 1)) + (hexpr : LowerEValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hrest : ApplyRestNonErasedValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hrestNext : ApplyRestNonErasedValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx) + {input output : VEnv} {world : Owned} {head : IxIR0.Expr} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + (hselfOwnership : ∀ {index arity : Nat}, + input.entries[index]? = some (VEntry.recSelf arity) → + FnOwnershipContract ctx cur (List.replicate arity .shared)) + (hselfValue : ∀ {index arity : Nat} + {sourceFunction : IxIR0.Value}, + input.entries[index]? = some (VEntry.recSelf arity) → + recSelfRel sourceFunction arity → + FnValueContract + (CompilerFunctionRel sourceCtx src relationState) sourceCtx ctx cur + (List.replicate arity .shared) sourceFunction) + (hselfResult : ∀ {index arity : Nat}, + input.entries[index]? = some (VEntry.recSelf arity) → + cur.result = .shared) + (hsource : SourceSpineEval sourceCtx sourceEnv head args sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world head args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState relationState) + (hrepresented : ExtraRepresented ctx relationState) : + LowerResultValueSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult world emit av := by + exact lowerSpine_run_core + (Result := fun actualHead => + SourceSpineEval sourceCtx sourceEnv actualHead args sourceResult → + (lowerSpine src (fuel + 2) input world actualHead args).run state = + .ok (output, emit, av) finalState → + LowerResultValueSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel ctx cur + input output sourceEnv sourceEnv sourceResult world emit av) + (happ := by + intro _ _ hsource hrun + exact lowerSpine_app_run_value_sound hspine hsource hrun) + (herased := by + intro hsource hrun + exact lowerSpine_erased_run_value_sound hargs hsource hrun) + (hvar := by + intro _ hnotSelf hsource hrun + exact lowerSpine_var_dynamic_run_value_sound hexpr hreflect hargs + hrestNext hnotSelf hsource hrun) + (hrecSelf := by + intro _ _ hentry hsource hrun + exact lowerSpine_recSelf_run_value_sound hargs hrest hentry + (hselfOwnership hentry) (fun hrel => hselfValue hentry hrel) + (hselfResult hentry) hsource hrun) + (href := by + intro _ hsource hrun + exact lowerSpine_ref_run_value_sound henv hargs hrest hknownExtra + hcontracts hvalues hsource hrun hextends hrepresented) + (hdynamic := by + intro _ hshape hsource hrun + exact lowerSpine_dynamic_run_value_sound hexpr hreflect hargs + hrestNext hshape hsource hrun) + hsource hrun + +/-- One flattened application node delegates to the predecessor-fuel spine +proof. -/ +theorem lowerSpine_app_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} + (hspine : LowerSpinePreservesBelow ctx cur limit src fuel) + {input output : VEnv} {world : Owned} + {function argument : IxIR0.Expr} {args : List IxIR0.Expr} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hrun : (lowerSpine src (fuel + 1) input world + (.app function argument) args).run state = + .ok (output, emit, av) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (havailable : SelfAvailableBelow ctx cur limit input) : + LowerResultSoundBelow ctx cur limit input output world emit av := by + apply hspine + · simpa [lowerSpine] using hrun + · exact hrepresented + · exact havailable + +/-- The syntactic erased spine head is handled entirely by bounded +`applyRest` absorption. -/ +theorem lowerSpine_erased_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} + (hrest : ApplyRestPreservesBelow ctx cur limit src fuel) + {input output : VEnv} {world : Owned} {args : List IxIR0.Expr} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hrun : (lowerSpine src (fuel + 1) input world .erased args).run state = + .ok (output, emit, av) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (havailable : SelfAvailableBelow ctx cur limit input) : + LowerResultSoundBelow ctx cur limit input output world emit av := by + apply hrest (lower_erased_sound_below (ctx := ctx) (cur := cur) + (limit := limit) (Γ := input) (world := .shared)) + · simpa [lowerSpine] using hrun + · exact hrepresented + · exact havailable + +/-- Dynamic fallback heads first use predecessor-fuel `lowerE`, then the +already-derived predecessor-fuel `applyRest` transformer. -/ +theorem lowerSpine_dynamic_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} + (hexpr : LowerEPreservesBelow ctx cur limit src fuel) + (hrest : ApplyRestPreservesBelow ctx cur limit src fuel) + (hrestExtra : ApplyRestExtraMonotone src fuel) + {input output : VEnv} {world : Owned} {head : IxIR0.Expr} + {args : List IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hshape : DynamicSpineHead head) + (hrun : (lowerSpine src (fuel + 1) input world head args).run state = + .ok (output, emit, av) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (havailable : SelfAvailableBelow ctx cur limit input) : + LowerResultSoundBelow ctx cur limit input output world emit av := by + cases hshape <;> simp only [lowerSpine] at hrun + all_goals + obtain ⟨functionResult, functionState, hfunctionRun, hafterFunction⟩ := + estateBindRun_ok_inv hrun + rcases functionResult with ⟨functionOutput, emitFunction, function⟩ + have hfunctionRepresented : ExtraRepresented ctx functionState := + hrepresented.of_extends + (hrestExtra functionOutput world emitFunction function args + hafterFunction) + exact hrest (hexpr hfunctionRun hfunctionRepresented havailable) + hafterFunction hrepresented (havailable.lowerE hfunctionRun) + +/-- An ordinary variable spine head follows the same lower-then-apply path +as the syntactic dynamic fallback. The side condition excludes only the +dedicated `recSelf` entry handled by the static self-call rule. -/ +theorem lowerSpine_var_dynamic_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} + (hexpr : LowerEPreservesBelow ctx cur limit src fuel) + (hrest : ApplyRestPreservesBelow ctx cur limit src fuel) + (hrestExtra : ApplyRestExtraMonotone src fuel) + {input output : VEnv} {world : Owned} {i : Nat} + {args : List IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hnotSelf : ∀ arity, + input.entries[i]? ≠ some (.recSelf arity)) + (hrun : (lowerSpine src (fuel + 1) input world (.var i) args).run + state = .ok (output, emit, av) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (havailable : SelfAvailableBelow ctx cur limit input) : + LowerResultSoundBelow ctx cur limit input output world emit av := by + simp only [lowerSpine] at hrun + cases hentry : input.entries[i]? with + | none => + obtain ⟨functionResult, functionState, hfunctionRun, hafterFunction⟩ := + estateBindRun_ok_inv (by simpa [hentry] using hrun) + rcases functionResult with ⟨functionOutput, emitFunction, function⟩ + have hfunctionRepresented : ExtraRepresented ctx functionState := + hrepresented.of_extends + (hrestExtra functionOutput world emitFunction function args + hafterFunction) + exact hrest (hexpr hfunctionRun hfunctionRepresented havailable) + hafterFunction hrepresented (havailable.lowerE hfunctionRun) + | some entry => + cases entry with + | recSelf arity => exact (hnotSelf arity hentry).elim + | slot abs remaining uses held => + obtain ⟨functionResult, functionState, hfunctionRun, hafterFunction⟩ := + estateBindRun_ok_inv (by simpa [hentry] using hrun) + rcases functionResult with ⟨functionOutput, emitFunction, function⟩ + have hfunctionRepresented : ExtraRepresented ctx functionState := + hrepresented.of_extends + (hrestExtra functionOutput world emitFunction function args + hafterFunction) + exact hrest (hexpr hfunctionRun hfunctionRepresented havailable) + hafterFunction hrepresented (havailable.lowerE hfunctionRun) + +/-- Saturated or over-applied recursive-self dispatch is bounded-sound in +one rule. The successful result-world guard forces the all-shared recursor +boundary, while `knownCall` handles both the terminal and tail-application +shapes. -/ +theorem lowerSpine_recSelf_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} + (hargs : LowerArgsPreservesBelow ctx cur limit src fuel) + (hrest : ApplyRestPreservesBelow ctx cur limit src fuel) + (hrestExtra : ApplyRestExtraMonotone src fuel) + {input output : VEnv} {world : Owned} {i arity : Nat} + {args : List IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hentry : input.entries[i]? = some (.recSelf arity)) + (hself : FnOwnershipContractBelow ctx cur + (List.replicate cur.arity .shared) limit) + (hresult : cur.result = .shared) + (hrun : (lowerSpine src (fuel + 2) input world (.var i) args).run + state = .ok (output, emit, av) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (havailable : SelfAvailableBelow ctx cur limit input) : + LowerResultSoundBelow ctx cur limit input output world emit av := by + simp only [lowerSpine] at hrun + rw [hentry] at hrun + simp only at hrun + by_cases hunder : args.length < arity + · rw [if_pos hunder] at hrun + exact (estateThrowRun_not_ok hrun).elim + · rw [if_neg hunder] at hrun + have hcount : arity ≤ args.length := Nat.le_of_not_gt hunder + cases world with + | unique => + have hrequire : + (requireResultWorld .shared .unique).run state = + .error "call result is shared at unique demand" state := by + rfl + rw [estateBindRun, hrequire] at hrun + contradiction + | shared => + have hrequire : + (requireResultWorld .shared .shared).run state = .ok () state := by + rfl + rw [estateBindRun, hrequire] at hrun + simp only at hrun + refine knownCall_run_sound_below + (build := .callSelf) (count := arity) + (argWorlds := List.replicate arity .shared) + (resultWorld := .shared) (buildWorld := .shared) + (args := args) hargs hrest hrestExtra ?_ ?_ ?_ hrun hrepresented + havailable + · intro prefixOutput emitPrefix prefixAVals hprefixSound + hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate arity .shared) arity (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate arity .shared) arity (by simp) hcount + have havsLength : prefixAVals.length = arity := + hprefixLength.trans hzipLength + have hsound : LowerArgsSoundBelow ctx cur limit input prefixOutput + (List.replicate arity .shared) emitPrefix prefixAVals := by + simpa only [hshape] using hprefixSound + by_cases harity : arity = cur.arity + · have hself' : FnOwnershipContractBelow ctx cur + (List.replicate arity .shared) limit := by + simpa [harity] using hself + simpa [hresult] using hsound.callSelf_owned hself' + · have hmismatch : prefixAVals.length ≠ cur.arity := by + intro heq + exact harity (havsLength.symm.trans heq) + simpa [hresult] using + hsound.callSelf_arity_mismatch hmismatch + · intro _ + rfl + · intro _ + rfl + +/-- Saturated and over-applied source definitions share one bounded direct- +call proof. The executable world guard supplies the terminal result equality +or the shared intermediate world required before applying an excess tail. -/ +theorem lowerSpine_ref_defn_call_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} + (hargs : LowerArgsPreservesBelow ctx cur limit src fuel) + (hrest : ApplyRestPreservesBelow ctx cur limit src fuel) + (hrestExtra : ApplyRestExtraMonotone src fuel) + (hdecls : SourceDeclContractsBelow src ctx limit) + {input output : VEnv} {world result : Owned} {f : Ixon.Address} + {body : IxIR0.Expr} {args : List IxIR0.Expr} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsrc : src f = some (.defn result body)) + (hcount : lamArity body ≤ args.length) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (havailable : SelfAvailableBelow ctx cur limit input) : + LowerResultSoundBelow ctx cur limit input output world emit av := by + obtain ⟨d, hdecl, harity, hresult, hcontract⟩ := hdecls.defn hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_neg (Nat.not_lt.mpr hcount)] at hrun + obtain ⟨checked, nextState, hrequireRun, hknownRun⟩ := + estateBindRun_ok_inv hrun + cases checked + obtain ⟨hguard, _⟩ := requireResultWorld_run_ok_inv hrequireRun + refine knownCall_run_sound_below + (build := .call f) (count := lamArity body) + (argWorlds := (lamUses body).map worldOfUses) + (resultWorld := world) (buildWorld := result) + (args := args) hargs hrest hrestExtra ?_ ?_ ?_ hknownRun hrepresented + havailable + · intro prefixOutput emitPrefix prefixAVals hprefixSound _ + have hshape := knownCall_prefix_worlds_eq args + ((lamUses body).map worldOfUses) (lamArity body) + (by simp) hcount + have hsound : LowerArgsSoundBelow ctx cur limit input prefixOutput + ((lamUses body).map worldOfUses) emitPrefix prefixAVals := by + simpa only [hshape] using hprefixSound + simpa [hresult] using hsound.call_owned hdecl hcontract + · intro hterminal + have heq : args.length = lamArity body := + Nat.le_antisymm hterminal hcount + simpa [heq] using hguard + · intro hover + have hne : args.length ≠ lamArity body := Nat.ne_of_gt hover + simpa [hne] using hguard + +/-- Under-applied source definitions that successfully pass the shared- +function guards consume all supplied arguments into a bounded pap node. -/ +theorem lowerSpine_ref_defn_partial_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} + (hargs : LowerArgsPreservesBelow ctx cur limit src fuel) + (hrest : ApplyRestPreservesBelow ctx cur limit src fuel) + (hrestExtra : ApplyRestExtraMonotone src fuel) + (hdecls : SourceDeclContractsBelow src ctx limit) + {input output : VEnv} {world result : Owned} {f : Ixon.Address} + {body : IxIR0.Expr} {args : List IxIR0.Expr} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsrc : src f = some (.defn result body)) + (hunder : args.length < lamArity body) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (havailable : SelfAvailableBelow ctx cur limit input) : + LowerResultSoundBelow ctx cur limit input output world emit av := by + obtain ⟨d, hdecl, harity, _, _⟩ := hdecls.defn hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + apply False.elim + apply estateThrowRun_not_ok + simpa [huuEq] using hrun + | shared => + cases result with + | unique => + apply False.elim + apply estateThrowRun_not_ok + simpa [hsuEq, huuEq] using hrun + | shared => + cases hp : papSafe body with + | false => + apply False.elim + apply estateThrowRun_not_ok + simpa [hsuEq, hp] using hrun + | true => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq, hp] using hrun + exact knownCall_papp_run_sound_below + (f := f) (d := .fn d) (args := args) hargs hrest hrestExtra + hdecl (by simpa [declArity, harity] using hunder) hknown + hrepresented havailable + +/-- Saturated and over-applied recursor references are ordinary bounded +all-shared direct calls once the generated recursor declaration is recovered +from the source/target contract environment. -/ +theorem lowerSpine_ref_recursor_call_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} + (hargs : LowerArgsPreservesBelow ctx cur limit src fuel) + (hrest : ApplyRestPreservesBelow ctx cur limit src fuel) + (hrestExtra : ApplyRestExtraMonotone src fuel) + (hdecls : SourceDeclContractsBelow src ctx limit) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {numArgs : Nat} {natLit : Bool} {rules : Array IxIR0.RecRule} + {args : List IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.recursor numArgs natLit rules)) + (hcount : numArgs + 1 ≤ args.length) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (havailable : SelfAvailableBelow ctx cur limit input) : + LowerResultSoundBelow ctx cur limit input output world emit av := by + obtain ⟨d, hdecl, harity, hresult, hcontract⟩ := + hdecls.recursor hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_neg (Nat.not_lt.mpr hcount)] at hrun + obtain ⟨checked, nextState, hrequireRun, hknownRun⟩ := + estateBindRun_ok_inv hrun + cases checked + obtain ⟨hguard, _⟩ := requireResultWorld_run_ok_inv hrequireRun + refine knownCall_run_sound_below + (build := .call f) (count := numArgs + 1) + (argWorlds := List.replicate (numArgs + 1) .shared) + (resultWorld := world) (buildWorld := .shared) + (args := args) hargs hrest hrestExtra ?_ ?_ ?_ hknownRun hrepresented + havailable + · intro prefixOutput emitPrefix prefixAVals hprefixSound _ + have hshape := knownCall_prefix_worlds_eq args + (List.replicate (numArgs + 1) .shared) (numArgs + 1) + (by simp) hcount + have hsound : LowerArgsSoundBelow ctx cur limit input prefixOutput + (List.replicate (numArgs + 1) .shared) + emitPrefix prefixAVals := by + simpa only [hshape] using hprefixSound + simpa [hresult] using hsound.call_owned hdecl hcontract + · intro hterminal + have heq : args.length = numArgs + 1 := + Nat.le_antisymm hterminal hcount + simpa [heq] using hguard + · intro _ + rfl + +/-- An under-applied recursor is a shared pap over all supplied arguments; +its target declaration and strict under-application bound come from the +bounded generated-recursor contract. -/ +theorem lowerSpine_ref_recursor_partial_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} + (hargs : LowerArgsPreservesBelow ctx cur limit src fuel) + (hrest : ApplyRestPreservesBelow ctx cur limit src fuel) + (hrestExtra : ApplyRestExtraMonotone src fuel) + (hdecls : SourceDeclContractsBelow src ctx limit) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {numArgs : Nat} {natLit : Bool} {rules : Array IxIR0.RecRule} + {args : List IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.recursor numArgs natLit rules)) + (hunder : args.length < numArgs + 1) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (havailable : SelfAvailableBelow ctx cur limit input) : + LowerResultSoundBelow ctx cur limit input output world emit av := by + obtain ⟨d, hdecl, harity, _, _⟩ := hdecls.recursor hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + apply False.elim + apply estateThrowRun_not_ok + simpa [huuEq] using hrun + | shared => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + exact knownCall_papp_run_sound_below + (f := f) (d := .fn d) (args := args) hargs hrest hrestExtra hdecl + (by simpa [declArity, harity] using hunder) hknown hrepresented + havailable + +/-- Saturated and over-applied extern references use the homogeneous bounded +extern consumer; the excess-tail shared-world fact is recovered from the +successful run itself. -/ +theorem lowerSpine_ref_extern_call_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} + (hargs : LowerArgsPreservesBelow ctx cur limit src fuel) + (hrest : ApplyRestPreservesBelow ctx cur limit src fuel) + (hrestExtra : ApplyRestExtraMonotone src fuel) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {arity : Nat} {args : List IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.extern arity)) + (hcount : arity ≤ args.length) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (havailable : SelfAvailableBelow ctx cur limit input) : + LowerResultSoundBelow ctx cur limit input output world emit av := by + have hknown : + (knownCall src (fuel + 1) input (.extern f ·) arity + (List.replicate arity .shared) world args).run state = + .ok (output, emit, av) finalState := by + simpa [lowerSpine, hsrc, Nat.not_lt.mpr hcount] using hrun + exact knownCall_extern_run_sound_below + (count := arity) hargs hrest hrestExtra hcount hknown hrepresented + havailable + +/-- Under-applied extern references are shared paps backed by the extern +declaration supplied by the source/target layout. -/ +theorem lowerSpine_ref_extern_partial_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} + (hargs : LowerArgsPreservesBelow ctx cur limit src fuel) + (hrest : ApplyRestPreservesBelow ctx cur limit src fuel) + (hrestExtra : ApplyRestExtraMonotone src fuel) + (hdecls : SourceDeclContractsBelow src ctx limit) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {arity : Nat} {args : List IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.extern arity)) + (hunder : args.length < arity) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (havailable : SelfAvailableBelow ctx cur limit input) : + LowerResultSoundBelow ctx cur limit input output world emit av := by + have hdecl := hdecls.extern hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + apply False.elim + apply estateThrowRun_not_ok + simpa [huuEq] using hrun + | shared => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + exact knownCall_papp_run_sound_below + (f := f) (d := .extern arity) (args := args) hargs hrest hrestExtra + hdecl (by simpa [declArity] using hunder) hknown hrepresented + havailable + +/-- Saturated and over-applied constructors lower through the bounded +homogeneous allocation rule at the demanded whole-value world. -/ +theorem lowerSpine_ref_ctor_alloc_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} + (hargs : LowerArgsPreservesBelow ctx cur limit src fuel) + (hrest : ApplyRestPreservesBelow ctx cur limit src fuel) + (hrestExtra : ApplyRestExtraMonotone src fuel) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {tag arity : Nat} {args : List IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.ctor tag arity)) + (hcount : arity ≤ args.length) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (havailable : SelfAvailableBelow ctx cur limit input) : + LowerResultSoundBelow ctx cur limit input output world emit av := by + have hknown : + (knownCall src (fuel + 1) input + (.alloc world (ctorIdOf f tag) ·) arity + (List.replicate arity world) world args).run state = + .ok (output, emit, av) finalState := by + simpa [lowerSpine, hsrc, Nat.not_lt.mpr hcount] using hrun + exact knownCall_alloc_run_sound_below + (count := arity) hargs hrest hrestExtra hcount hknown hrepresented + havailable + +/-- Under-applied constructors use the statefully memoized eta-wrapper. The +whole-program layout need only certify the declaration and arity of the +wrapper actually returned by that successful lookup. -/ +theorem lowerSpine_ref_ctor_partial_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} + (hargs : LowerArgsPreservesBelow ctx cur limit src fuel) + (hrest : ApplyRestPreservesBelow ctx cur limit src fuel) + (hrestExtra : ApplyRestExtraMonotone src fuel) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {tag arity : Nat} {args : List IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.ctor tag arity)) + (hunder : args.length < arity) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (havailable : SelfAvailableBelow ctx cur limit input) : + LowerResultSoundBelow ctx cur limit input output world emit av := by + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + apply False.elim + apply estateThrowRun_not_ok + simpa [huuEq] using hrun + | shared => + have hrun' : + ((wrapperFor f tag arity) >>= fun wrapper => + knownCall src (fuel + 1) input (.papp wrapper ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + obtain ⟨wrapper, wrapperState, hwrapperRun, hknownRun⟩ := + estateBindRun_ok_inv hrun' + have hmemo : (⟨f, tag, arity, wrapper⟩ : WrapperMemo) ∈ + finalState.wrappers := + (hknownExtra input (.papp wrapper ·) args.length + (List.replicate args.length .shared) .shared args + hknownRun).wrapper_mem (wrapperFor_memo_mem hwrapperRun) + have hdecl := hrepresented.wrapper hmemo + exact knownCall_papp_run_sound_below + (f := wrapper) (d := ctorWrapperDecl f tag arity) (args := args) + hargs hrest hrestExtra hdecl + (by simpa [ctorWrapperDecl, declArity] using hunder) hknownRun + hrepresented havailable + +/-- Complete bounded `.ref` spine dispatch. Source declarations select the +proved definition, constructor, recursor, or extern family; unknown +references cannot produce a successful lowering run. -/ +theorem lowerSpine_ref_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} + (hargs : LowerArgsPreservesBelow ctx cur limit src fuel) + (hargsExtra : LowerArgsExtraMonotone src fuel) + (hrest : ApplyRestPreservesBelow ctx cur limit src fuel) + (hrestExtra : ApplyRestExtraMonotone src fuel) + (hdecls : SourceDeclContractsBelow src ctx limit) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {args : List IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (havailable : SelfAvailableBelow ctx cur limit input) : + LowerResultSoundBelow ctx cur limit input output world emit av := by + exact lowerSpine_ref_run_core + (Result := LowerResultSoundBelow ctx cur limit input output world + emit av) + (hdefnPartial := by + intro _ _ hsrc hunder + exact lowerSpine_ref_defn_partial_run_sound_below + hargs hrest hrestExtra hdecls hsrc hunder hrun hrepresented + havailable) + (hdefnCall := by + intro _ _ hsrc hcount + exact lowerSpine_ref_defn_call_run_sound_below + hargs hrest hrestExtra hdecls hsrc hcount hrun hrepresented + havailable) + (hctorPartial := by + intro _ _ hsrc hunder + exact lowerSpine_ref_ctor_partial_run_sound_below + hargs hrest hrestExtra + (knownCallExtraMonotone_succ hargsExtra hrestExtra) + hsrc hunder hrun hrepresented havailable) + (hctorAlloc := by + intro _ _ hsrc hcount + exact lowerSpine_ref_ctor_alloc_run_sound_below + hargs hrest hrestExtra hsrc hcount hrun hrepresented havailable) + (hrecursorPartial := by + intro _ _ _ hsrc hunder + exact lowerSpine_ref_recursor_partial_run_sound_below + hargs hrest hrestExtra hdecls hsrc hunder hrun hrepresented + havailable) + (hrecursorCall := by + intro _ _ _ hsrc hcount + exact lowerSpine_ref_recursor_call_run_sound_below + hargs hrest hrestExtra hdecls hsrc hcount hrun hrepresented + havailable) + (hexternPartial := by + intro _ hsrc hunder + exact lowerSpine_ref_extern_partial_run_sound_below + hargs hrest hrestExtra hdecls hsrc hunder hrun hrepresented + havailable) + (hexternCall := by + intro _ hsrc hcount + exact lowerSpine_ref_extern_call_run_sound_below + hargs hrest hrestExtra hsrc hcount hrun hrepresented havailable) + hrun + +/-- One complete bounded `lowerSpine` step. All syntactic dispatch families +are now connected; the two generated-environment obligations are explicit: +`recSelf` entries must name the current shared contract, and a state-created +constructor wrapper must be represented in the final target context. -/ +theorem lowerSpine_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} + (hspine : LowerSpinePreservesBelow ctx cur limit src (fuel + 1)) + (hexpr : LowerEPreservesBelow ctx cur limit src (fuel + 1)) + (hargs : LowerArgsPreservesBelow ctx cur limit src fuel) + (hargsExtra : LowerArgsExtraMonotone src fuel) + (hrest : ApplyRestPreservesBelow ctx cur limit src fuel) + (hrestNext : ApplyRestPreservesBelow ctx cur limit src (fuel + 1)) + (hrestExtra : ApplyRestExtraMonotone src fuel) + (hrestNextExtra : ApplyRestExtraMonotone src (fuel + 1)) + (hdecls : SourceDeclContractsBelow src ctx limit) + {input output : VEnv} {world : Owned} {head : IxIR0.Expr} + {args : List IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hrun : (lowerSpine src (fuel + 2) input world head args).run state = + .ok (output, emit, av) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (havailable : SelfAvailableBelow ctx cur limit input) : + LowerResultSoundBelow ctx cur limit input output world emit av := by + exact lowerSpine_run_core + (Result := fun actualHead => + (lowerSpine src (fuel + 2) input world actualHead args).run state = + .ok (output, emit, av) finalState → + LowerResultSoundBelow ctx cur limit input output world emit av) + (happ := by + intro _ _ hrun + exact lowerSpine_app_run_sound_below hspine hrun hrepresented + havailable) + (herased := by + intro hrun + exact lowerSpine_erased_run_sound_below hrestNext hrun hrepresented + havailable) + (hvar := by + intro _ hnotSelf hrun + exact lowerSpine_var_dynamic_run_sound_below hexpr hrestNext + hrestNextExtra hnotSelf hrun hrepresented havailable) + (hrecSelf := by + intro index arity hentry hrun + cases havailable with + | inl hself => + obtain ⟨hresult, hcontract⟩ := hself + exact lowerSpine_recSelf_run_sound_below + hargs hrest hrestExtra hentry hcontract hresult hrun hrepresented + (SelfAvailableBelow.of_contract ⟨hresult, hcontract⟩) + | inr hno => exact (hno index arity hentry).elim) + (href := by + intro _ hrun + exact lowerSpine_ref_run_sound_below hargs hargsExtra hrest + hrestExtra hdecls hrun hrepresented havailable) + (hdynamic := by + intro _ hshape hrun + exact lowerSpine_dynamic_run_sound_below hexpr hrestNext + hrestNextExtra hshape hrun hrepresented havailable) + hrun + +/-- Standalone reference lowering is the empty-argument spine dispatch with +two extra administrative compiler-fuel steps for `knownCall` and its empty +`lowerArgs` prefix. -/ +theorem lowerE_ref_run_to_lowerSpine_nil + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {world : Owned} {f : Ixon.Address} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hrun : (lowerE src (fuel + 1) input world (.ref f)).run state = + .ok (output, emit, av) finalState) : + (lowerSpine src (fuel + 3) input world (.ref f) []).run state = + .ok (output, emit, av) finalState := by + cases hsrc : src f with + | none => + apply False.elim + apply estateThrowRun_not_ok + simpa [lowerE, hsrc] using hrun + | some source => + cases source with + | defn result body => + cases hn : lamArity body with + | zero => + simpa [lowerE, lowerSpine, knownCall, lowerArgs, hsrc, hn, + padWorlds, Function.comp_def] using hrun + | succ n => + simpa [lowerE, lowerSpine, knownCall, lowerArgs, hsrc, hn, + padWorlds, Function.comp_def] using hrun + | ctor tag arity => + cases arity with + | zero => + simpa [lowerE, lowerSpine, knownCall, lowerArgs, hsrc, + padWorlds, Function.comp_def] using hrun + | succ arity => + simpa [lowerE, lowerSpine, knownCall, lowerArgs, hsrc, + padWorlds, Function.comp_def] using hrun + | recursor numArgs natLit rules => + simpa [lowerE, lowerSpine, knownCall, lowerArgs, hsrc, + padWorlds, Function.comp_def] using hrun + | extern arity => + cases arity with + | zero => + simpa [lowerE, lowerSpine, knownCall, lowerArgs, hsrc, + padWorlds, Function.comp_def] using hrun + | succ arity => + simpa [lowerE, lowerSpine, knownCall, lowerArgs, hsrc, + padWorlds, Function.comp_def] using hrun + +/-- Every successful standalone source reference inherits bounded soundness +from complete empty-spine dispatch. -/ +theorem lowerE_ref_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} + (hargs : LowerArgsPreservesBelow ctx cur limit src (fuel + 1)) + (hargsExtra : LowerArgsExtraMonotone src (fuel + 1)) + (hrest : ApplyRestPreservesBelow ctx cur limit src (fuel + 1)) + (hrestExtra : ApplyRestExtraMonotone src (fuel + 1)) + (hdecls : SourceDeclContractsBelow src ctx limit) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hrun : (lowerE src (fuel + 1) input world (.ref f)).run state = + .ok (output, emit, av) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (havailable : SelfAvailableBelow ctx cur limit input) : + LowerResultSoundBelow ctx cur limit input output world emit av := by + apply lowerSpine_ref_run_sound_below hargs hargsExtra hrest hrestExtra + hdecls + · exact lowerE_ref_run_to_lowerSpine_nil hrun + · exact hrepresented + · exact havailable + +/-- Semantic standalone reference lowering is the empty source/target spine. +The existing executable equivalence contributes the two administrative fuel +steps needed to expose `knownCall`; no additional semantic case split is +required at the expression boundary. -/ +theorem lowerE_ref_run_value_sound + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hargs : LowerArgsValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src (fuel + 1)) + (hrest : ApplyRestNonErasedValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 2)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + (hsource : IxIR0.eval sourceCtx sourceFuel sourceEnv (.ref f) = + .ok sourceResult) + (hrun : (lowerE src (fuel + 1) input world (.ref f)).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState relationState) + (hrepresented : ExtraRepresented ctx relationState) : + LowerResultValueSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceResult world emit av := by + apply lowerSpine_ref_run_value_sound henv hargs hrest hknownExtra + hcontracts hvalues (SourceSpineEval.of_eval_nil hsource) + · exact lowerE_ref_run_to_lowerSpine_nil hrun + · exact hextends + · exact hrepresented + +/-- Successful literal lowering is bounded-sound at every contract limit. -/ +theorem lowerE_lit_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Owned} + {literal : IxIR0.Literal} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hrun : (lowerE src (fuel + 1) input world (.lit literal)).run state = + .ok (output, emit, av) finalState) : + LowerResultSoundBelow ctx cur limit input output world emit av := by + have hpure : + (input, (_root_.id : Emit), AVal.constA (.lit literal)) = + (output, emit, av) ∧ + state = finalState := by + simpa [lowerE] using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact lower_lit_sound_below + +private theorem lowerE_lit_run_value_sound_at + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Owned} + {literal : IxIR0.Literal} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + (hrun : (lowerE src (fuel + 1) input world (.lit literal)).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv (.lit literal) world emit av := by + have hpure : + (input, (_root_.id : Emit), AVal.constA (.lit literal)) = + (output, emit, av) ∧ + state = finalState := by + simpa [lowerE] using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact lower_lit_value_sound_at + +/-- Semantic literal branch: the source evaluator returns the same literal +the target lowers to an environment-independent scalar. -/ +theorem lowerE_lit_run_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Owned} + {literal : IxIR0.Literal} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + (hrun : (lowerE src (fuel + 1) input world (.lit literal)).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv (.lit literal) world emit av := by + exact LowerResultValueSound.of_below fun limit => + lowerE_lit_run_value_sound_at (limit := limit) hrun + +/-- Fuel-bounded semantic literal branch. -/ +theorem lowerE_lit_run_value_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Owned} + {literal : IxIR0.Literal} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + (hrun : (lowerE src (fuel + 1) input world (.lit literal)).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv (.lit literal) world emit av := by + exact lowerE_lit_run_value_sound_at hrun + +/-- Successful erased lowering is bounded-sound at every contract limit. -/ +theorem lowerE_erased_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Owned} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hrun : (lowerE src (fuel + 1) input world .erased).run state = + .ok (output, emit, av) finalState) : + LowerResultSoundBelow ctx cur limit input output world emit av := by + have hpure : + (input, (_root_.id : Emit), AVal.constA .erased) = + (output, emit, av) ∧ + state = finalState := by + simpa [lowerE] using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact lower_erased_sound_below + +private theorem lowerE_erased_run_value_sound_at + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Owned} + {emit : Emit} {av : AVal} {state finalState : LowSt} + {sourceEnv : List IxIR0.Value} + (hrun : (lowerE src (fuel + 1) input world .erased).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv .erased world emit av := by + have hpure : + (input, (_root_.id : Emit), AVal.constA .erased) = + (output, emit, av) ∧ + state = finalState := by + simpa [lowerE] using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact lower_erased_value_sound_at + +/-- Semantic erased branch: `◻` on both sides, with no heap participation. -/ +theorem lowerE_erased_run_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Owned} + {emit : Emit} {av : AVal} {state finalState : LowSt} + {sourceEnv : List IxIR0.Value} + (hrun : (lowerE src (fuel + 1) input world .erased).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv .erased world emit av := by + exact LowerResultValueSound.of_below fun limit => + lowerE_erased_run_value_sound_at (limit := limit) hrun + +/-- Fuel-bounded semantic erased branch. -/ +theorem lowerE_erased_run_value_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Owned} + {emit : Emit} {av : AVal} {state finalState : LowSt} + {sourceEnv : List IxIR0.Value} + (hrun : (lowerE src (fuel + 1) input world .erased).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv .erased world emit av := by + exact lowerE_erased_run_value_sound_at hrun + +/-- Shared operational proof for successful variable lowering. Clients +supply the meaning of a final move and a repeated shared retain; missing, +synthetic, released, exhausted, mismatched-world, and repeated unique entries +are rejected here, together with exact output and state recovery. -/ +theorem lowerE_var_run_sound_core + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {world : Owned} {i : Nat} {emit : Emit} {av : AVal} + {state finalState : LowSt} + {Result : Owned → VEnv → Emit → AVal → LowSt → Prop} + (hmove : ∀ {abs : Nat} {uses : Uses}, + input.entries[i]? = some (.slot abs 1 uses true) → + Result (worldOfUses uses) + (input.setEntry i (.slot abs 0 uses false)) + (_root_.id : Emit) (.slotA abs) state) + (hdup : ∀ {abs remaining : Nat} {uses : Uses}, + worldOfUses uses = .shared → + input.entries[i]? = + some (.slot abs (Nat.succ (Nat.succ remaining)) uses true) → + let next := input.setEntry i + (.slot abs (Nat.succ remaining) uses true) + Result .shared next.bump + (emitOp (.dup (.var (next.rel abs)))) (.slotA next.depth) state) + (hrun : (lowerE src (fuel + 1) input world (.var i)).run state = + .ok (output, emit, av) finalState) : + Result world output emit av finalState := by + have hssNe : (Owned.shared != Owned.shared) = false := by decide + have huuNe : (Owned.unique != Owned.unique) = false := by decide + have hsuNe : (Owned.shared != Owned.unique) = true := by decide + have husNe : (Owned.unique != Owned.shared) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + have huuEq : (Owned.unique == Owned.unique) = true := by decide + cases hentry : input.entries[i]? with + | none => + apply False.elim + apply estateThrowRun_not_ok + simpa [lowerE, hentry] using hrun + | some entry => + cases entry with + | recSelf arity => + apply False.elim + apply estateThrowRun_not_ok + simpa [lowerE, hentry] using hrun + | slot abs remaining uses held => + cases held with + | false => + apply False.elim + apply estateThrowRun_not_ok + simpa [lowerE, hentry] using hrun + | true => + by_cases hworld : worldOfUses uses = world + · subst world + have hsame : + (worldOfUses uses != worldOfUses uses) = false := by + cases uses <;> decide + cases remaining with + | zero => + apply False.elim + apply estateThrowRun_not_ok + simpa [lowerE, hentry, hsame] using hrun + | succ remaining => + cases remaining with + | zero => + have hpure : + (input.setEntry i (.slot abs 0 uses false), + (_root_.id : Emit), AVal.slotA abs) = + (output, emit, av) ∧ state = finalState := by + simpa [lowerE, hentry, hsame] using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact hmove hentry + | succ remaining => + cases uses with + | erased => + have heq : + (Owned.shared == Owned.unique) = false := by decide + have hpure : + let next := input.setEntry i + (.slot abs (Nat.succ remaining) .erased true) + (next.bump, + emitOp (.dup (.var (next.rel abs))), + AVal.slotA next.depth) = (output, emit, av) ∧ + state = finalState := by + simpa [lowerE, hentry, worldOfUses, hsame, heq, + hssNe, huuNe, hsuNe, husNe, hsuEq, huuEq] + using hrun + dsimp only at hpure + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact hdup (by rfl) hentry + | linear => + have heq : + (Owned.unique == Owned.unique) = true := by decide + apply False.elim + apply estateThrowRun_not_ok + simpa [lowerE, hentry, worldOfUses, hsame, heq, + hssNe, huuNe, hsuNe, husNe, hsuEq, huuEq] + using hrun + | affine => + have heq : + (Owned.unique == Owned.unique) = true := by decide + apply False.elim + apply estateThrowRun_not_ok + simpa [lowerE, hentry, worldOfUses, hsame, heq, + hssNe, huuNe, hsuNe, husNe, hsuEq, huuEq] + using hrun + | many => + have heq : + (Owned.shared == Owned.unique) = false := by decide + have hpure : + let next := input.setEntry i + (.slot abs (Nat.succ remaining) .many true) + (next.bump, + emitOp (.dup (.var (next.rel abs))), + AVal.slotA next.depth) = (output, emit, av) ∧ + state = finalState := by + simpa [lowerE, hentry, worldOfUses, hsame, heq, + hssNe, huuNe, hsuNe, husNe, hsuEq, huuEq] + using hrun + dsimp only at hpure + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact hdup (by rfl) hentry + · have hdiff : (worldOfUses uses != world) = true := by + cases uses <;> cases world <;> + simp_all [worldOfUses] <;> decide + cases uses <;> cases world + all_goals + try { exact (hworld (by rfl)).elim } + all_goals + apply False.elim + apply estateThrowRun_not_ok + simpa [lowerE, hentry, worldOfUses, hdiff, hssNe, huuNe, + hsuNe, husNe, hsuEq, huuEq] using hrun + +/-- Every successful variable lowering branch is bounded-sound. Impossible +entry states and ownership mismatches are discharged from the successful +monadic run; final uses move an owner and repeated shared uses retain it. -/ +theorem lowerE_var_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Owned} {i : Nat} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hrun : (lowerE src (fuel + 1) input world (.var i)).run state = + .ok (output, emit, av) finalState) : + LowerResultSoundBelow ctx cur limit input output world emit av := by + exact lowerE_var_run_sound_core + (Result := fun resultWorld resultOutput resultEmit resultAv _ => + LowerResultSoundBelow ctx cur limit input resultOutput resultWorld + resultEmit resultAv) + (hmove := fun hentry => lower_var_move_sound_below hentry) + (hdup := fun hworld hentry => + lower_var_shared_dup_sound_below hworld hentry) + hrun + +private theorem lowerE_var_run_value_sound_at + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Owned} {i : Nat} + {emit : Emit} {av : AVal} {state finalState : LowSt} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + (hsource : sourceEnv[i]? = some sourceValue) + (hrun : (lowerE src (fuel + 1) input world (.var i)).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue world emit av := by + exact lowerE_var_run_sound_core + (Result := fun resultWorld resultOutput resultEmit resultAv _ => + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input + resultOutput sourceEnv sourceEnv sourceValue resultWorld resultEmit + resultAv) + (hmove := fun hentry => + lower_held_move_value_sound_at hsource hentry) + (hdup := fun hworld hentry => + lower_held_retain_value_sound_at hsource hworld hentry) + hrun + +/-- Semantic variable branch of `lowerE`. A final use moves the source +value's owner out of the environment; a repeated shared use retains it and +returns a fresh owner for the same graph. Every other entry state and every +world mismatch is unreachable in a successful run. -/ +theorem lowerE_var_run_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Owned} {i : Nat} + {emit : Emit} {av : AVal} {state finalState : LowSt} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + (hsource : sourceEnv[i]? = some sourceValue) + (hrun : (lowerE src (fuel + 1) input world (.var i)).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue world emit av := by + exact LowerResultValueSound.of_below fun limit => + lowerE_var_run_value_sound_at (limit := limit) hsource hrun + +/-- Fuel-bounded semantic variable branch. The only emitted operation is the +non-final shared `dup`; final uses are ownership-preserving identity emits. -/ +theorem lowerE_var_run_value_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {world : Owned} {i : Nat} + {emit : Emit} {av : AVal} {state finalState : LowSt} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + (hsource : sourceEnv[i]? = some sourceValue) + (hrun : (lowerE src (fuel + 1) input world (.var i)).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue world emit av := by + exact lowerE_var_run_value_sound_at hsource hrun + +/-- Every successful variable expression returns a slot descriptor. -/ +theorem lowerE_var_run_ne_constErased + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {world : Owned} {index : Nat} {emit : Emit} + {state finalState : LowSt} + (hrun : (lowerE src (fuel + 1) input world (.var index)).run state = + .ok (output, emit, .constA .erased) finalState) : + False := by + have hnotErased := lowerE_var_run_sound_core + (Result := fun _ _ _ result _ => result ≠ .constA .erased) + (hmove := fun _ => by simp) + (hdup := fun _ _ => by simp) + hrun + exact hnotErased rfl + +/-- Shared operational proof for successful variable borrowing. Clients +supply the meaning of a final shared move and a repeated shared borrow; +missing, synthetic, released, exhausted, and unique entries are rejected +here, together with exact release-bit, output, and state recovery. -/ +theorem lowerBorrow_var_run_sound_core + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} {i : Nat} + {emit : Emit} {av : AVal} {release : Bool} + {state finalState : LowSt} + {Result : VEnv → Emit → AVal → Bool → LowSt → Prop} + (hmove : ∀ {abs : Nat} {uses : Uses}, + worldOfUses uses = .shared → + input.entries[i]? = some (.slot abs 1 uses true) → + Result (input.setEntry i (.slot abs 0 uses false)) + (_root_.id : Emit) (.slotA abs) true state) + (hrepeated : ∀ {abs remaining : Nat} {uses : Uses}, + worldOfUses uses = .shared → + input.entries[i]? = + some (.slot abs (Nat.succ (Nat.succ remaining)) uses true) → + let next := input.setEntry i + (.slot abs (Nat.succ remaining) uses true) + Result next (_root_.id : Emit) (.slotA abs) false state) + (hrun : (lowerBorrow src (fuel + 1) input (.var i)).run state = + .ok (output, emit, av, release) finalState) : + Result output emit av release finalState := by + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + have huuEq : (Owned.unique == Owned.unique) = true := by decide + cases hentry : input.entries[i]? with + | none => + apply False.elim + apply estateThrowRun_not_ok + simpa [lowerBorrow, hentry] using hrun + | some entry => + cases entry with + | recSelf arity => + apply False.elim + apply estateThrowRun_not_ok + simpa [lowerBorrow, hentry] using hrun + | slot abs remaining uses held => + cases held with + | false => + apply False.elim + apply estateThrowRun_not_ok + simpa [lowerBorrow, hentry] using hrun + | true => + cases uses with + | erased => + cases remaining with + | zero => + apply False.elim + apply estateThrowRun_not_ok + simpa [lowerBorrow, hentry, worldOfUses, hsuEq] using hrun + | succ remaining => + cases remaining with + | zero => + have hpure : + (input.setEntry i (.slot abs 0 .erased false), + (_root_.id : Emit), AVal.slotA abs, true) = + (output, emit, av, release) ∧ + state = finalState := by + simpa [lowerBorrow, hentry, worldOfUses, hsuEq] using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact hmove (by rfl) hentry + | succ remaining => + have hpure : + let next := input.setEntry i + (.slot abs (Nat.succ remaining) .erased true) + (next, (_root_.id : Emit), AVal.slotA abs, false) = + (output, emit, av, release) ∧ + state = finalState := by + simpa [lowerBorrow, hentry, worldOfUses, hsuEq] using hrun + dsimp only at hpure + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact hrepeated (by rfl) hentry + | linear => + apply False.elim + apply estateThrowRun_not_ok + simpa [lowerBorrow, hentry, worldOfUses, huuEq] using hrun + | affine => + apply False.elim + apply estateThrowRun_not_ok + simpa [lowerBorrow, hentry, worldOfUses, huuEq] using hrun + | many => + cases remaining with + | zero => + apply False.elim + apply estateThrowRun_not_ok + simpa [lowerBorrow, hentry, worldOfUses, hsuEq] using hrun + | succ remaining => + cases remaining with + | zero => + have hpure : + (input.setEntry i (.slot abs 0 .many false), + (_root_.id : Emit), AVal.slotA abs, true) = + (output, emit, av, release) ∧ + state = finalState := by + simpa [lowerBorrow, hentry, worldOfUses, hsuEq] using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact hmove (by rfl) hentry + | succ remaining => + have hpure : + let next := input.setEntry i + (.slot abs (Nat.succ remaining) .many true) + (next, (_root_.id : Emit), AVal.slotA abs, false) = + (output, emit, av, release) ∧ + state = finalState := by + simpa [lowerBorrow, hentry, worldOfUses, hsuEq] using hrun + dsimp only at hpure + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact hrepeated (by rfl) hentry + +/-- Every successful variable borrow is bounded-sound. Unique entries, +released entries, and overcounted entries cannot reach a successful run; +final shared uses transfer an owner and repeated shared uses retain it in the +environment. -/ +theorem lowerBorrow_var_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {i : Nat} + {emit : Emit} {av : AVal} {release : Bool} + {state finalState : LowSt} + (hrun : (lowerBorrow src (fuel + 1) input (.var i)).run state = + .ok (output, emit, av, release) finalState) : + LowerBorrowSoundBelow ctx cur limit input output emit av release := by + exact lowerBorrow_var_run_sound_core + (Result := fun resultOutput resultEmit resultAv resultRelease _ => + LowerBorrowSoundBelow ctx cur limit input resultOutput resultEmit + resultAv resultRelease) + (hmove := fun hworld hentry => + lower_var_shared_move_borrow_sound_below hworld hentry) + (hrepeated := fun hworld hentry => + lower_var_shared_borrow_sound_below hworld hentry) + hrun + +private theorem lowerBorrow_var_run_value_sound_at + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {i : Nat} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {av : AVal} {release : Bool} + {state finalState : LowSt} + (hsource : sourceEnv[i]? = some sourceValue) + (hrun : (lowerBorrow src (fuel + 1) input (.var i)).run state = + .ok (output, emit, av, release) finalState) : + LowerBorrowValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceEnv sourceEnv sourceValue emit av release := by + exact lowerBorrow_var_run_sound_core + (Result := fun resultOutput resultEmit resultAv resultRelease _ => + LowerBorrowValueSoundBelow funRel recSelfRel ctx cur limit input + resultOutput sourceEnv sourceEnv sourceValue resultEmit resultAv + resultRelease) + (hmove := fun hworld hentry => + lower_var_shared_move_borrow_value_sound_at + hsource hworld hentry) + (hrepeated := fun hworld hentry => + lower_var_shared_borrow_value_sound_at hsource hworld hentry) + hrun + +/-- Semantic variable-borrow branch of the executable lowerer. Successful +final shared uses move the source-related owner to the caller, while repeated +shared uses keep that owner in the updated semantic environment. -/ +theorem lowerBorrow_var_run_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {i : Nat} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {av : AVal} {release : Bool} + {state finalState : LowSt} + (hsource : sourceEnv[i]? = some sourceValue) + (hrun : (lowerBorrow src (fuel + 1) input (.var i)).run state = + .ok (output, emit, av, release) finalState) : + LowerBorrowValueSound funRel recSelfRel ctx cur + input output sourceEnv sourceEnv sourceValue emit av release := by + exact LowerBorrowValueSound.of_below fun limit => + lowerBorrow_var_run_value_sound_at (limit := limit) hsource hrun + +theorem lowerBorrow_var_run_value_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} {input output : VEnv} {i : Nat} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + {emit : Emit} {av : AVal} {release : Bool} + {state finalState : LowSt} + (hsource : sourceEnv[i]? = some sourceValue) + (hrun : (lowerBorrow src (fuel + 1) input (.var i)).run state = + .ok (output, emit, av, release) finalState) : + LowerBorrowValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceEnv sourceEnv sourceValue emit av release := by + exact lowerBorrow_var_run_value_sound_at hsource hrun + +/-- A variable borrow is always represented by a slot descriptor; every +other executable branch is an error. -/ +theorem lowerBorrow_var_run_ne_constErased + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} {i : Nat} + {emit : Emit} {release : Bool} {state finalState : LowSt} + (hrun : (lowerBorrow src (fuel + 1) input (.var i)).run state = + .ok (output, emit, .constA .erased, release) finalState) : + False := by + have hnotErased := lowerBorrow_var_run_sound_core + (Result := fun _ _ result _ _ => result ≠ .constA .erased) + (hmove := fun _ _ => by simp) + (hrepeated := fun _ _ => by simp) + hrun + exact hnotErased rfl + +/-- Every non-variable expression uses `lowerBorrow`'s ordinary +shared-expression fallback. -/ +inductive DynamicBorrowHead : IxIR0.Expr → Prop where + | ref (address : Ixon.Address) : DynamicBorrowHead (.ref address) + | app (function argument : IxIR0.Expr) : + DynamicBorrowHead (.app function argument) + | lam (uses : Uses) (body : IxIR0.Expr) : + DynamicBorrowHead (.lam uses body) + | letE (uses : Uses) (value body : IxIR0.Expr) : + DynamicBorrowHead (.letE uses value body) + | proj (index : Nat) (value : IxIR0.Expr) : + DynamicBorrowHead (.proj index value) + | lit (literal : IxIR0.Literal) : DynamicBorrowHead (.lit literal) + | erased : DynamicBorrowHead .erased + +/-- Shared operational proof for the ordinary-expression borrowing fallback. +The result predicates keep state-only, semantic, reflection, and profile +clients separate while the monadic inversion and descriptor dispatch stay +canonical. -/ +theorem lowerBorrow_dynamic_run_core + {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {expr : IxIR0.Expr} + {emit : Emit} {av : AVal} {release : Bool} + {state finalState : LowSt} + {ExprResult : VEnv → Emit → AVal → LowSt → Prop} + {BorrowResult : VEnv → Emit → AVal → Bool → LowSt → Prop} + (hexpr : ∀ {exprOutput : VEnv} {exprEmit : Emit} {exprAv : AVal} + {exprState : LowSt}, + (lowerE src fuel input .shared expr).run state = + .ok (exprOutput, exprEmit, exprAv) exprState → + ExprResult exprOutput exprEmit exprAv exprState) + (hslot : ∀ {exprOutput : VEnv} {exprEmit : Emit} {abs : Nat} + {exprState : LowSt}, + ExprResult exprOutput exprEmit (.slotA abs) exprState → + BorrowResult exprOutput exprEmit (.slotA abs) true exprState) + (hconst : ∀ {exprOutput : VEnv} {exprEmit : Emit} {atom : Atom} + {exprState : LowSt}, + ExprResult exprOutput exprEmit (.constA atom) exprState → + BorrowResult exprOutput exprEmit (.constA atom) false exprState) + (hshape : DynamicBorrowHead expr) + (hrun : (lowerBorrow src (fuel + 1) input expr).run state = + .ok (output, emit, av, release) finalState) : + BorrowResult output emit av release finalState := by + cases hshape <;> simp only [lowerBorrow] at hrun + all_goals + obtain ⟨exprResult, exprState, hexprRun, hafterExpr⟩ := + estateBindRun_ok_inv hrun + rcases exprResult with ⟨exprOutput, exprEmit, exprValue⟩ + cases exprValue with + | slotA abs => + have hpure : + (exprOutput, exprEmit, AVal.slotA abs, true) = + (output, emit, av, release) ∧ + exprState = finalState := by + simpa using hafterExpr + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact hslot (hexpr hexprRun) + | constA atom => + have hpure : + (exprOutput, exprEmit, AVal.constA atom, false) = + (output, emit, av, release) ∧ + exprState = finalState := by + simpa using hafterExpr + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact hconst (hexpr hexprRun) + +theorem lowerBorrow_dynamic_extraMonotone + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEExtraMonotone src fuel) + {input : VEnv} {expr : IxIR0.Expr} + (hshape : DynamicBorrowHead expr) : + ExtraMonotone (lowerBorrow src (fuel + 1) input expr) := by + cases hshape <;> simp only [lowerBorrow] + all_goals + apply ExtraMonotone.bind (hexpr input .shared _) + intro exprResult + rcases exprResult with ⟨output, emit, value⟩ + exact ExtraMonotone.pure + (output, emit, value, + match value with | .slotA _ => true | .constA _ => false) + +theorem lowerBorrowExtraMonotone_succ + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEExtraMonotone src fuel) : + LowerBorrowExtraMonotone src (fuel + 1) := by + intro input expr + cases expr with + | var index => exact lowerBorrow_var_extraMonotone src fuel input index + | ref address => + exact lowerBorrow_dynamic_extraMonotone hexpr (.ref address) + | app function argument => + exact lowerBorrow_dynamic_extraMonotone hexpr + (.app function argument) + | lam uses body => + exact lowerBorrow_dynamic_extraMonotone hexpr (.lam uses body) + | letE uses value body => + exact lowerBorrow_dynamic_extraMonotone hexpr + (.letE uses value body) + | proj index value => + exact lowerBorrow_dynamic_extraMonotone hexpr (.proj index value) + | lit literal => + exact lowerBorrow_dynamic_extraMonotone hexpr (.lit literal) + | erased => exact lowerBorrow_dynamic_extraMonotone hexpr .erased + +theorem lowerBorrow_dynamic_extraProvenance + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEExtraProvenance src fuel) + {input : VEnv} {expr : IxIR0.Expr} + (hshape : DynamicBorrowHead expr) : + ExtraProvenanceMonotone src + (lowerBorrow src (fuel + 1) input expr) := by + cases hshape <;> simp only [lowerBorrow] + all_goals + apply ExtraProvenanceMonotone.bind (hexpr input .shared _) + intro exprResult + rcases exprResult with ⟨output, emit, value⟩ + exact ExtraProvenanceMonotone.pure src + (output, emit, value, + match value with | .slotA _ => true | .constA _ => false) + +theorem lowerBorrowExtraProvenance_succ + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEExtraProvenance src fuel) : + LowerBorrowExtraProvenance src (fuel + 1) := by + intro input expr + cases expr with + | var index => exact (lowerBorrow_var_extraProvenance + src fuel input index) + | ref address => + exact lowerBorrow_dynamic_extraProvenance hexpr (.ref address) + | app function argument => + exact lowerBorrow_dynamic_extraProvenance hexpr + (.app function argument) + | lam uses body => + exact lowerBorrow_dynamic_extraProvenance hexpr (.lam uses body) + | letE uses value body => + exact lowerBorrow_dynamic_extraProvenance hexpr + (.letE uses value body) + | proj index value => + exact lowerBorrow_dynamic_extraProvenance hexpr (.proj index value) + | lit literal => + exact lowerBorrow_dynamic_extraProvenance hexpr (.lit literal) + | erased => exact lowerBorrow_dynamic_extraProvenance hexpr .erased + +/-- One fuel step for the entire state-only lowering cluster. Every recursive +compiler call is at predecessor fuel; the only generated declarations come +from the wrapper and lambda rules already isolated above. -/ +theorem lowerExtraMonotone_succ {src : IxIR0.Env} {fuel : Nat} + (hprev : LowerExtraMonotone src fuel) : + LowerExtraMonotone src (fuel + 1) where + expr := lowerEExtraMonotone_succ + hprev.expr hprev.spine hprev.borrow hprev.lam + borrow := lowerBorrowExtraMonotone_succ hprev.expr + spine := lowerSpineExtraMonotone_succ + hprev.expr hprev.spine hprev.knownCall hprev.applyRest + knownCall := knownCallExtraMonotone_succ hprev.args hprev.applyRest + args := lowerArgsExtraMonotone_succ hprev.expr hprev.args + applyRest := applyRestExtraMonotone_succ hprev.args + lam := fun input expr => + lowerLam_extraMonotone_succ hprev.fnBody input expr + fnBody := lowerFnBodyExtraMonotone_succ hprev.expr + +/-- One compiler-fuel step preserves exact provenance for both primitive +generated-declaration sites and every recursively threaded subaction. -/ +theorem lowerExtraProvenance_succ {src : IxIR0.Env} {fuel : Nat} + (hprev : LowerExtraProvenance src fuel) : + LowerExtraProvenance src (fuel + 1) where + expr := lowerEExtraProvenance_succ + hprev.expr hprev.spine hprev.borrow hprev.lam + borrow := lowerBorrowExtraProvenance_succ hprev.expr + spine := lowerSpineExtraProvenance_succ + hprev.expr hprev.spine hprev.knownCall hprev.applyRest + knownCall := knownCallExtraProvenance_succ + hprev.args hprev.applyRest + args := lowerArgsExtraProvenance_succ hprev.expr hprev.args + applyRest := applyRestExtraProvenance_succ hprev.args + lam := fun input expr hpositive => + lowerLam_extraProvenance_succ hprev.fnBody input expr hpositive + fnBody := lowerFnBodyExtraProvenance_succ hprev.expr + +/-- All successful lowering-cluster actions prepend (and never discard) +generated declarations. -/ +theorem lowerExtraMonotone (src : IxIR0.Env) : + ∀ fuel, LowerExtraMonotone src fuel + | 0 => lowerExtraMonotone_zero src + | fuel + 1 => lowerExtraMonotone_succ (lowerExtraMonotone src fuel) + +/-- Complete compiler-fuel induction for generated-declaration provenance. -/ +theorem lowerExtraProvenance (src : IxIR0.Env) : + ∀ fuel, LowerExtraProvenance src fuel + | 0 => lowerExtraProvenance_zero src + | fuel + 1 => + lowerExtraProvenance_succ (lowerExtraProvenance src fuel) + +theorem lowerE_extraExtends + {src : IxIR0.Env} {fuel : Nat} {input : VEnv} {world : Owned} + {expr : IxIR0.Expr} {state finalState : LowSt} + {output : VEnv} {emit : Emit} {value : AVal} + (hrun : (lowerE src fuel input world expr).run state = + .ok (output, emit, value) finalState) : + ExtraExtends state finalState := + (lowerExtraMonotone src fuel).expr input world expr hrun + +theorem lowerBorrow_extraExtends + {src : IxIR0.Env} {fuel : Nat} {input : VEnv} + {expr : IxIR0.Expr} {state finalState : LowSt} + {result : VEnv × Emit × AVal × Bool} + (hrun : (lowerBorrow src fuel input expr).run state = + .ok result finalState) : + ExtraExtends state finalState := + (lowerExtraMonotone src fuel).borrow input expr hrun + +theorem lowerSpine_extraExtends + {src : IxIR0.Env} {fuel : Nat} {input : VEnv} {world : Owned} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {state finalState : LowSt} {result : VEnv × Emit × AVal} + (hrun : (lowerSpine src fuel input world head args).run state = + .ok result finalState) : + ExtraExtends state finalState := + (lowerExtraMonotone src fuel).spine input world head args hrun + +theorem lowerArgs_extraExtends + {src : IxIR0.Env} {fuel : Nat} {input : VEnv} + {args : List (IxIR0.Expr × Owned)} {state finalState : LowSt} + {result : VEnv × Emit × List AVal} + (hrun : (lowerArgs src fuel input args).run state = + .ok result finalState) : + ExtraExtends state finalState := + (lowerExtraMonotone src fuel).args input args hrun + +theorem knownCall_extraExtends + {src : IxIR0.Env} {fuel : Nat} {input : VEnv} + {build : Array Atom → Op} {count : Nat} + {argWorlds : List Owned} {resultWorld : Owned} + {args : List IxIR0.Expr} {state finalState : LowSt} + {result : VEnv × Emit × AVal} + (hrun : (knownCall src fuel input build count argWorlds resultWorld + args).run state = .ok result finalState) : + ExtraExtends state finalState := + (lowerExtraMonotone src fuel).knownCall input build count argWorlds + resultWorld args hrun + +theorem applyRest_extraExtends + {src : IxIR0.Env} {fuel : Nat} {input : VEnv} + {resultWorld : Owned} {pre : Emit} {function : AVal} + {args : List IxIR0.Expr} {state finalState : LowSt} + {result : VEnv × Emit × AVal} + (hrun : (applyRest src fuel input resultWorld pre function args).run + state = .ok result finalState) : + ExtraExtends state finalState := + (lowerExtraMonotone src fuel).applyRest input resultWorld pre function + args hrun + +theorem lowerLam_extraExtends + {src : IxIR0.Env} {fuel : Nat} {input : VEnv} + {expr : IxIR0.Expr} {state finalState : LowSt} + {result : VEnv × Emit × AVal} + (hrun : (lowerLam src fuel input expr).run state = + .ok result finalState) : + ExtraExtends state finalState := + (lowerExtraMonotone src fuel).lam input expr hrun + +theorem lowerFnBody_extraExtends + {src : IxIR0.Env} {fuel : Nat} {input : VEnv} + {drops : List SlotDrop} {world : Owned} {body : IxIR0.Expr} + {state finalState : LowSt} {code : Code} + (hrun : (lowerFnBody src fuel input drops world body).run state = + .ok code finalState) : + ExtraExtends state finalState := + (lowerExtraMonotone src fuel).fnBody input drops world body hrun + +/-- One recursor alternative sequences only canonical entry cleanup and an +ordinary expression-lowering action, so it preserves the generated-state +extension invariant. -/ +theorem lowerRecursorRule_extraMonotone (src : IxIR0.Env) (fuel numArgs : Nat) + (ruleTag : IxIR0.RecRule × Nat) : + ExtraMonotone (lowerRecursorRule src fuel numArgs ruleTag) := by + rcases ruleTag with ⟨rule, tag⟩ + simp only [lowerRecursorRule] + apply ExtraMonotone.bind (releaseSlots_extraMonotone _ _) + intro releaseResult + rcases releaseResult with ⟨input, releaseEmit⟩ + apply ExtraMonotone.bind + ((lowerExtraMonotone src fuel).expr input .shared rule.rhs) + intro bodyResult + rcases bodyResult with ⟨output, bodyEmit, value⟩ + exact ExtraMonotone.pure _ + +/-- Traversing all recursor alternatives preserves generated state. -/ +theorem lowerRecursor_extraMonotone (src : IxIR0.Env) (fuel numArgs : Nat) + (natLit : Bool) (rules : Array IxIR0.RecRule) : + ExtraMonotone (lowerRecursor src fuel numArgs natLit rules) := by + simp only [lowerRecursor] + apply ExtraMonotone.bind + (ExtraMonotone.listMapM (lowerRecursorRule src fuel numArgs) + (lowerRecursorRule_extraMonotone src fuel numArgs) + rules.toList.zipIdx) + intro alts + exact ExtraMonotone.pure + (⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩ : FnDef) + +/-- Every declaration-lowering branch preserves generated state. -/ +theorem lowerDecl_extraMonotone (src : IxIR0.Env) (fuel : Nat) : + ∀ item, ExtraMonotone (lowerDecl src fuel item) + | (address, .defn result body) => by + simp only [lowerDecl] + apply ExtraMonotone.bind + ((lowerExtraMonotone src fuel).fnBody _ _ result _) + intro code + exact ExtraMonotone.pure + (some (address, Decl.fn ⟨lamArity body, result, + result == .shared && papSafe body, code⟩)) + | (_, .ctor tag arity) => by + simp only [lowerDecl] + exact ExtraMonotone.pure + (none : Option (Ixon.Address × Decl)) + | (address, .recursor numArgs natLit rules) => by + simp only [lowerDecl] + apply ExtraMonotone.bind + (lowerRecursor_extraMonotone src fuel numArgs natLit rules) + intro d + exact ExtraMonotone.pure (some (address, Decl.fn d)) + | (address, .extern arity) => by + simp only [lowerDecl] + exact ExtraMonotone.pure (some (address, Decl.extern arity)) + +/-- The full declaration traversal preserves generated state. -/ +theorem lowerDecls_extraMonotone (src : IxIR0.Env) (fuel : Nat) + (decls : List (Ixon.Address × IxIR0.Decl)) : + ExtraMonotone (decls.filterMapM (lowerDecl src fuel)) := + ExtraMonotone.listFilterMapM (lowerDecl src fuel) + (lowerDecl_extraMonotone src fuel) decls + +/-- Whole-program lowering extends the empty generated-state trajectory; +the final `get` merely exposes the accumulated declarations in the result. -/ +theorem lowerAllAction_extraMonotone + (decls : List (Ixon.Address × IxIR0.Decl)) (main : IxIR0.Expr) + (mainWorld : Owned) (fuel : Nat) : + ExtraMonotone (lowerAllAction decls main mainWorld fuel) := by + let src := IxIR0.Env.ofList decls + simp only [lowerAllAction] + apply ExtraMonotone.bind (lowerDecls_extraMonotone src fuel decls) + intro base + apply ExtraMonotone.bind + ((lowerExtraMonotone src fuel).fnBody ⟨[], 0⟩ [] mainWorld main) + intro mainCode + apply ExtraMonotone.bind ExtraMonotone.get + intro state + exact ExtraMonotone.pure (base ++ state.extra, mainCode) + +theorem lowerRecursorRule_extraProvenance + (src : IxIR0.Env) (fuel numArgs : Nat) + (ruleTag : IxIR0.RecRule × Nat) : + ExtraProvenanceMonotone src + (lowerRecursorRule src fuel numArgs ruleTag) := by + rcases ruleTag with ⟨rule, tag⟩ + simp only [lowerRecursorRule] + apply ExtraProvenanceMonotone.bind + (releaseSlots_extraProvenance src _ _) + intro releaseResult + rcases releaseResult with ⟨input, releaseEmit⟩ + apply ExtraProvenanceMonotone.bind + ((lowerExtraProvenance src fuel).expr input .shared rule.rhs) + intro bodyResult + rcases bodyResult with ⟨output, bodyEmit, value⟩ + exact ExtraProvenanceMonotone.pure src _ + +theorem lowerRecursor_extraProvenance + (src : IxIR0.Env) (fuel numArgs : Nat) + (natLit : Bool) (rules : Array IxIR0.RecRule) : + ExtraProvenanceMonotone src + (lowerRecursor src fuel numArgs natLit rules) := by + simp only [lowerRecursor] + apply ExtraProvenanceMonotone.bind + (ExtraProvenanceMonotone.listMapM src + (lowerRecursorRule src fuel numArgs) + (lowerRecursorRule_extraProvenance src fuel numArgs) + rules.toList.zipIdx) + intro alts + exact ExtraProvenanceMonotone.pure src + (⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩ : FnDef) + +theorem lowerDecl_extraProvenance (src : IxIR0.Env) (fuel : Nat) : + ∀ item, ExtraProvenanceMonotone src (lowerDecl src fuel item) + | (address, .defn result body) => by + simp only [lowerDecl] + apply ExtraProvenanceMonotone.bind + ((lowerExtraProvenance src fuel).fnBody _ _ result _) + intro code + exact ExtraProvenanceMonotone.pure src + (some (address, Decl.fn ⟨lamArity body, result, + result == .shared && papSafe body, code⟩)) + | (_, .ctor tag arity) => by + simp only [lowerDecl] + exact ExtraProvenanceMonotone.pure src + (none : Option (Ixon.Address × Decl)) + | (address, .recursor numArgs natLit rules) => by + simp only [lowerDecl] + apply ExtraProvenanceMonotone.bind + (lowerRecursor_extraProvenance src fuel numArgs natLit rules) + intro d + exact ExtraProvenanceMonotone.pure src + (some (address, Decl.fn d)) + | (address, .extern arity) => by + simp only [lowerDecl] + exact ExtraProvenanceMonotone.pure src + (some (address, Decl.extern arity)) + +theorem lowerDecls_extraProvenance (src : IxIR0.Env) (fuel : Nat) + (decls : List (Ixon.Address × IxIR0.Decl)) : + ExtraProvenanceMonotone src + (decls.filterMapM (lowerDecl src fuel)) := + ExtraProvenanceMonotone.listFilterMapM src (lowerDecl src fuel) + (lowerDecl_extraProvenance src fuel) decls + +/-- Whole-program lowering from any state preserves exact origin witnesses +for every generated declaration added by declarations or the main body. -/ +theorem lowerAllAction_extraProvenance + (decls : List (Ixon.Address × IxIR0.Decl)) (main : IxIR0.Expr) + (mainWorld : Owned) (fuel : Nat) : + ExtraProvenanceMonotone (IxIR0.Env.ofList decls) + (lowerAllAction decls main mainWorld fuel) := by + let src := IxIR0.Env.ofList decls + simp only [lowerAllAction] + apply ExtraProvenanceMonotone.bind + (lowerDecls_extraProvenance src fuel decls) + intro base + apply ExtraProvenanceMonotone.bind + ((lowerExtraProvenance src fuel).fnBody + ⟨[], 0⟩ [] mainWorld main) + intro mainCode + apply ExtraProvenanceMonotone.bind + (ExtraProvenanceMonotone.get src) + intro state + exact ExtraProvenanceMonotone.pure src + (base ++ state.extra, mainCode) + +/-- Closed whole-pass provenance: no generated row can come from an +arbitrary pre-existing compiler state. -/ +theorem lowerAllAction_extraProvenance_empty + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {fuel : Nat} + {result : List (Ixon.Address × Decl) × Code} {finalState : LowSt} + (hrun : (lowerAllAction decls main mainWorld fuel).run {} = + .ok result finalState) : + ExtraProvenanceExtends (IxIR0.Env.ofList decls) + ({} : LowSt) finalState := + lowerAllAction_extraProvenance decls main mainWorld fuel hrun + +/-- Every final generated declaration exposed by a successful whole-program +action occurs verbatim in the returned target declaration list. -/ +theorem lowerAllAction_extra_mem_result + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {fuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + (hrun : (lowerAllAction decls main mainWorld fuel).run initial = + .ok (targetDecls, mainCode) finalState) : + ∀ {item}, item ∈ finalState.extra → item ∈ targetDecls := by + intro item hmember + simp only [lowerAllAction] at hrun + obtain ⟨base, baseState, hbase, hafterBase⟩ := + estateBindRun_ok_inv hrun + obtain ⟨compiledMain, mainState, hmain, hafterMain⟩ := + estateBindRun_ok_inv hafterBase + obtain ⟨observed, getState, hget, hpure⟩ := + estateBindRun_ok_inv hafterMain + have hget' : mainState = observed ∧ mainState = getState := by + simpa using hget + obtain ⟨hobserved, hgetState⟩ := hget' + subst observed + subst getState + have hpure' : + (base ++ mainState.extra, compiledMain) = + (targetDecls, mainCode) ∧ mainState = finalState := by + simpa using hpure + obtain ⟨hresult, hstate⟩ := hpure' + subst finalState + have hdecls : base ++ mainState.extra = targetDecls := + congrArg Prod.fst hresult + rw [← hdecls] + exact List.mem_append_right base hmember + +/-- Recover the exact `lowerDecl` sub-run for any source-list member of a +successful whole-program action. Its final state is a represented suffix of +the whole trajectory, and any emitted base declaration occurs in the returned +target list. -/ +theorem lowerAllAction_decl_trace + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {fuel : Nat} {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + (hrun : (lowerAllAction decls main mainWorld fuel).run initial = + .ok (targetDecls, mainCode) finalState) + {item : Ixon.Address × IxIR0.Decl} (hitem : item ∈ decls) : + ∃ itemInitial itemFinal output, + (lowerDecl (IxIR0.Env.ofList decls) fuel item).run itemInitial = + .ok output itemFinal ∧ + ExtraExtends itemFinal finalState ∧ + ∀ value, output = some value → value ∈ targetDecls := by + let src := IxIR0.Env.ofList decls + simp only [lowerAllAction] at hrun + obtain ⟨base, baseState, hbase, hafterBase⟩ := + estateBindRun_ok_inv hrun + obtain ⟨compiledMain, mainState, hmain, hafterMain⟩ := + estateBindRun_ok_inv hafterBase + obtain ⟨observed, getState, hget, hpure⟩ := + estateBindRun_ok_inv hafterMain + have hget' : mainState = observed ∧ mainState = getState := by + simpa using hget + obtain ⟨hobserved, hgetState⟩ := hget' + subst observed + subst getState + have hpure' : + (base ++ mainState.extra, compiledMain) = + (targetDecls, mainCode) ∧ mainState = finalState := by + simpa using hpure + obtain ⟨hresult, hstate⟩ := hpure' + subst finalState + obtain ⟨itemInitial, itemFinal, output, hitemRun, hitemExtends, + houtput⟩ := listFilterMapM_trace (lowerDecl src fuel) + (lowerDecl_extraMonotone src fuel) decls hbase hitem + refine ⟨itemInitial, itemFinal, output, ?_, + hitemExtends.trans (lowerFnBody_extraExtends hmain), ?_⟩ + · simpa [src] using hitemRun + · intro value hvalue + have hbaseMember := houtput value hvalue + have hdecls : base ++ mainState.extra = targetDecls := + congrArg Prod.fst hresult + rw [← hdecls] + exact List.mem_append_left _ hbaseMember + +/-- A successful whole-program action from the default state carries the +exact cache/declaration reachability witness needed to construct the final +`ExtraRepresented` layout. -/ +theorem lowerAllAction_extraExtends_empty + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {fuel : Nat} {result : List (Ixon.Address × Decl) × Code} + {finalState : LowSt} + (hrun : (lowerAllAction decls main mainWorld fuel).run {} = + .ok result finalState) : + ExtraExtends ({} : LowSt) finalState := + lowerAllAction_extraMonotone decls main mainWorld fuel hrun + +/-- Once the target context represents the final `extra` list, a successful +whole-program run from the default state also represents every memoized +constructor wrapper. No arbitrary-state wrapper oracle remains. -/ +theorem lowerAllAction_extraRepresented + {ctx : Ctx} {decls : List (Ixon.Address × IxIR0.Decl)} + {main : IxIR0.Expr} {mainWorld : Owned} {fuel : Nat} + {result : List (Ixon.Address × Decl) × Code} {finalState : LowSt} + (hrun : (lowerAllAction decls main mainWorld fuel).run {} = + .ok result finalState) + (hdecls : ∀ {address decl}, (address, decl) ∈ finalState.extra → + ctx.decls address = some decl) : + ExtraRepresented ctx finalState := + (lowerAllAction_extraExtends_empty hrun).represented_of_empty hdecls + +/-- Non-variable borrowing is derived directly from predecessor-fuel +expression soundness. Slot results carry a releasable temporary owner; +stable constants are ownership-inert non-releasing borrows. -/ +theorem lowerBorrow_dynamic_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} + (hexpr : LowerEPreservesBelow ctx cur limit src fuel) + {input output : VEnv} {expr : IxIR0.Expr} + {emit : Emit} {av : AVal} {release : Bool} + {state finalState : LowSt} + (hshape : DynamicBorrowHead expr) + (hrun : (lowerBorrow src (fuel + 1) input expr).run state = + .ok (output, emit, av, release) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (havailable : SelfAvailableBelow ctx cur limit input) : + LowerBorrowSoundBelow ctx cur limit input output emit av release := by + exact (lowerBorrow_dynamic_run_core + (ExprResult := fun exprOutput exprEmit exprAv exprState => + ExtraRepresented ctx exprState → + LowerResultSoundBelow ctx cur limit input exprOutput .shared + exprEmit exprAv) + (BorrowResult := fun borrowOutput borrowEmit borrowAv borrowRelease + borrowState => + ExtraRepresented ctx borrowState → + LowerBorrowSoundBelow ctx cur limit input borrowOutput borrowEmit + borrowAv borrowRelease) + (hexpr := fun hsubrun hrepresented => + hexpr hsubrun hrepresented havailable) + (hslot := fun hsound hrepresented => + (hsound hrepresented).asBorrowSlot) + (hconst := fun hsound hrepresented => + (hsound hrepresented).asBorrowConst) + hshape hrun) hrepresented + +/-- Semantic dynamic-borrow branch. Every non-variable borrowing position is +lowered as an ordinary shared expression and adapted by the two borrow +adapters, so the source graph passes through unchanged and only the release +obligation is recomputed from the descriptor. -/ +theorem lowerBorrow_dynamic_run_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {expr : IxIR0.Expr} + {emit : Emit} {av : AVal} {release : Bool} + {state finalState : LowSt} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + (hexpr : ∀ {exprOutput : VEnv} {exprEmit : Emit} {exprAv : AVal} + {exprState : LowSt}, + (lowerE src fuel input .shared expr).run state = + .ok (exprOutput, exprEmit, exprAv) exprState → + LowerResultValueSound funRel recSelfRel ctx cur input exprOutput + sourceEnv sourceEnv sourceValue .shared exprEmit exprAv) + (hshape : DynamicBorrowHead expr) + (hrun : (lowerBorrow src (fuel + 1) input expr).run state = + .ok (output, emit, av, release) finalState) : + LowerBorrowValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue emit av release := by + exact lowerBorrow_dynamic_run_core + (ExprResult := fun exprOutput exprEmit exprAv _ => + LowerResultValueSound funRel recSelfRel ctx cur input exprOutput + sourceEnv sourceEnv sourceValue .shared exprEmit exprAv) + (BorrowResult := fun borrowOutput borrowEmit borrowAv borrowRelease _ => + LowerBorrowValueSound funRel recSelfRel ctx cur input borrowOutput + sourceEnv sourceEnv sourceValue borrowEmit borrowAv borrowRelease) + (hexpr := fun hsubrun => hexpr hsubrun) + (hslot := fun hsound => hsound.asBorrowSlot) + (hconst := fun hsound => hsound.asBorrowConst) + hshape hrun + +/-- A complete bounded `lowerBorrow` step follows from predecessor-fuel +expression soundness plus the direct variable-borrow rule. -/ +theorem lowerBorrowPreservesBelow_succ + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} + (hexpr : LowerEPreservesBelow ctx cur limit src fuel) : + LowerBorrowPreservesBelow ctx cur limit src (fuel + 1) := by + intro input expr state finalState output emit av release hrun hrepresented + havailable + cases expr with + | var i => exact lowerBorrow_var_run_sound_below hrun + | ref address => + exact lowerBorrow_dynamic_run_sound_below hexpr (.ref address) hrun + hrepresented havailable + | app function argument => + exact lowerBorrow_dynamic_run_sound_below hexpr + (.app function argument) hrun hrepresented havailable + | lam uses body => + exact lowerBorrow_dynamic_run_sound_below hexpr (.lam uses body) hrun + hrepresented havailable + | letE uses value body => + exact lowerBorrow_dynamic_run_sound_below hexpr + (.letE uses value body) hrun hrepresented havailable + | proj index value => + exact lowerBorrow_dynamic_run_sound_below hexpr (.proj index value) hrun + hrepresented havailable + | lit literal => + exact lowerBorrow_dynamic_run_sound_below hexpr (.lit literal) hrun + hrepresented havailable + | erased => + exact lowerBorrow_dynamic_run_sound_below hexpr .erased hrun + hrepresented havailable + +/-- One complete semantic borrow step. Variables use the direct lookup rule; +every other constructor delegates to predecessor-fuel expression semantics +and then applies the descriptor-preserving borrow adapter. -/ +theorem lowerBorrowValuePreserves_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEValuePreserves funRel recSelfRel sourceCtx ctx cur + src fuel) : + LowerBorrowValuePreserves funRel recSelfRel sourceCtx ctx cur src + (fuel + 1) := by + intro input output expr sourceEnv sourceFuel sourceValue state finalState + emit av release hsource hrun + cases expr with + | var index => + exact lowerBorrow_var_run_value_sound (sourceEval_var_inv hsource) hrun + | ref address => + exact lowerBorrow_dynamic_run_value_sound + (fun hsubrun => hexpr hsource hsubrun) (.ref address) hrun + | app function argument => + exact lowerBorrow_dynamic_run_value_sound + (fun hsubrun => hexpr hsource hsubrun) + (.app function argument) hrun + | lam uses body => + exact lowerBorrow_dynamic_run_value_sound + (fun hsubrun => hexpr hsource hsubrun) (.lam uses body) hrun + | letE uses value body => + exact lowerBorrow_dynamic_run_value_sound + (fun hsubrun => hexpr hsource hsubrun) + (.letE uses value body) hrun + | proj index source => + exact lowerBorrow_dynamic_run_value_sound + (fun hsubrun => hexpr hsource hsubrun) (.proj index source) hrun + | lit literal => + exact lowerBorrow_dynamic_run_value_sound + (fun hsubrun => hexpr hsource hsubrun) (.lit literal) hrun + | erased => + exact lowerBorrow_dynamic_run_value_sound + (fun hsubrun => hexpr hsource hsubrun) .erased hrun + +/-- The non-variable borrow adapter reflects an erased descriptor through +its predecessor `lowerE` run. Slot results cannot equal erased; scalar +results retain the exact atom returned by that run. -/ +theorem lowerBorrow_dynamic_run_reflectsErased + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {fuel : Nat} + (hreflect : LowerEReflectsErased sourceCtx src fuel) + {input output : VEnv} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {emit : Emit} {av : AVal} + {release : Bool} {state finalState : LowSt} + (hshape : DynamicBorrowHead expr) + (hsource : IxIR0.eval sourceCtx sourceFuel sourceEnv expr = + .ok sourceValue) + (hrun : (lowerBorrow src (fuel + 1) input expr).run state = + .ok (output, emit, av, release) finalState) + (herased : av = .constA .erased) : + sourceValue = .erased := by + exact (lowerBorrow_dynamic_run_core + (ExprResult := fun _ _ exprAv _ => + exprAv = .constA .erased → sourceValue = .erased) + (BorrowResult := fun _ _ borrowAv _ _ => + borrowAv = .constA .erased → sourceValue = .erased) + (hexpr := fun hsubrun herased => hreflect hsource hsubrun herased) + (hslot := fun _ hcontra => by cases hcontra) + (hconst := fun hsound => hsound) + hshape hrun) herased + +theorem lowerBorrowReflectsErased_succ + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {fuel : Nat} + (hreflect : LowerEReflectsErased sourceCtx src fuel) : + LowerBorrowReflectsErased sourceCtx src (fuel + 1) := by + intro input output expr sourceEnv sourceFuel sourceValue state finalState + emit av release hsource hrun herased + cases expr with + | var index => + subst av + exact (lowerBorrow_var_run_ne_constErased hrun).elim + | ref address => + exact lowerBorrow_dynamic_run_reflectsErased hreflect (.ref address) + hsource hrun herased + | app function argument => + exact lowerBorrow_dynamic_run_reflectsErased hreflect + (.app function argument) hsource hrun herased + | lam uses body => + exact lowerBorrow_dynamic_run_reflectsErased hreflect (.lam uses body) + hsource hrun herased + | letE uses value body => + exact lowerBorrow_dynamic_run_reflectsErased hreflect + (.letE uses value body) hsource hrun herased + | proj index source => + exact lowerBorrow_dynamic_run_reflectsErased hreflect + (.proj index source) hsource hrun herased + | lit literal => + exact lowerBorrow_dynamic_run_reflectsErased hreflect (.lit literal) + hsource hrun herased + | erased => + exact lowerBorrow_dynamic_run_reflectsErased hreflect .erased + hsource hrun herased + +/-- Shared operational proof for projection lowering. Clients supply the +logical meaning of a successful borrow and one semantic adapter per concrete +descriptor branch; world rejection, monadic inversion, and output recovery +remain independent of the ownership, graph, reflection, or profile judgment +being established. -/ +theorem lowerE_proj_run_sound_core + {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Owned} {index : Nat} + {source : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} + {BorrowResult : VEnv → Emit → AVal → Bool → LowSt → Prop} + {ProjectionResult : Owned → VEnv → Emit → AVal → LowSt → Prop} + (hborrow : ∀ {borrowOutput : VEnv} {borrowEmit : Emit} + {borrowed : AVal} {release : Bool} {middleState : LowSt}, + (lowerBorrow src fuel input source).run state = + .ok (borrowOutput, borrowEmit, borrowed, release) middleState → + BorrowResult borrowOutput borrowEmit borrowed release middleState) + (hvar : ∀ {borrowOutput : VEnv} {borrowEmit : Emit} + {relative : Nat} {release : Bool} {middleState : LowSt}, + BorrowResult borrowOutput borrowEmit (.constA (.var relative)) + release middleState → + ProjectionResult .shared borrowOutput.bump + (borrowEmit ∘ emitOp (.fetch (.var relative) index)) + (.slotA borrowOutput.depth) middleState) + (hlit : ∀ {borrowOutput : VEnv} {borrowEmit : Emit} + {literal : IxIR0.Literal} {release : Bool} {middleState : LowSt}, + BorrowResult borrowOutput borrowEmit (.constA (.lit literal)) + release middleState → + ProjectionResult .shared borrowOutput.bump + (borrowEmit ∘ emitOp (.fetch (.lit literal) index)) + (.slotA borrowOutput.depth) middleState) + (herased : ∀ {borrowOutput : VEnv} {borrowEmit : Emit} + {release : Bool} {middleState : LowSt}, + BorrowResult borrowOutput borrowEmit (.constA .erased) release + middleState → + ProjectionResult .shared borrowOutput borrowEmit (.constA .erased) + middleState) + (hslotKept : ∀ {borrowOutput : VEnv} {borrowEmit : Emit} + {targetAbs : Nat} {middleState : LowSt}, + BorrowResult borrowOutput borrowEmit (.slotA targetAbs) false + middleState → + ProjectionResult .shared borrowOutput.bump.bump + (borrowEmit ∘ + emitOp (.fetch (.var (borrowOutput.rel targetAbs)) index) ∘ + emitOp (.dup + (.var (borrowOutput.bump.rel borrowOutput.depth)))) + (.slotA borrowOutput.bump.depth) middleState) + (hslotReleased : ∀ {borrowOutput : VEnv} {borrowEmit : Emit} + {targetAbs : Nat} {middleState : LowSt}, + BorrowResult borrowOutput borrowEmit (.slotA targetAbs) true + middleState → + ProjectionResult .shared borrowOutput.bump.bump.bump + (borrowEmit ∘ + emitOp (.fetch (.var (borrowOutput.rel targetAbs)) index) ∘ + emitOp (.dup + (.var (borrowOutput.bump.rel borrowOutput.depth))) ∘ + emitOp (.drop + (.var (borrowOutput.bump.bump.rel targetAbs)))) + (.slotA borrowOutput.bump.depth) middleState) + (hrun : (lowerE src (fuel + 1) input world + (.proj index source)).run state = + .ok (output, emit, av) finalState) : + ProjectionResult world output emit av finalState := by + cases world with + | unique => + have huuEq : (Owned.unique == Owned.unique) = true := by decide + simp only [lowerE, huuEq, if_true] at hrun + exact (estateThrowRun_not_ok hrun).elim + | shared => + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + simp only [lowerE, hsuEq, Bool.false_eq_true, if_false] at hrun + obtain ⟨borrowResult, middleState, hborrowRun, hafterBorrow⟩ := + estateBindRun_ok_inv hrun + rcases borrowResult with + ⟨borrowOutput, borrowEmit, borrowed, release⟩ + cases borrowed with + | constA atom => + cases atom with + | var relative => + have hpure : + (borrowOutput.bump, + borrowEmit ∘ emitOp (.fetch (.var relative) index), + AVal.slotA borrowOutput.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact hvar (hborrow hborrowRun) + | lit literal => + have hpure : + (borrowOutput.bump, + borrowEmit ∘ emitOp (.fetch (.lit literal) index), + AVal.slotA borrowOutput.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact hlit (hborrow hborrowRun) + | erased => + have hpure : + (borrowOutput, borrowEmit, AVal.constA .erased) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact herased (hborrow hborrowRun) + | slotA targetAbs => + cases release with + | false => + have hpure : + (borrowOutput.bump.bump, + borrowEmit ∘ + emitOp (.fetch (.var (borrowOutput.rel targetAbs)) index) ∘ + emitOp (.dup + (.var (borrowOutput.bump.rel borrowOutput.depth))), + AVal.slotA borrowOutput.bump.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact hslotKept (hborrow hborrowRun) + | true => + have hpure : + (borrowOutput.bump.bump.bump, + borrowEmit ∘ + emitOp (.fetch (.var (borrowOutput.rel targetAbs)) index) ∘ + emitOp (.dup + (.var (borrowOutput.bump.rel borrowOutput.depth))) ∘ + emitOp (.drop + (.var (borrowOutput.bump.bump.rel targetAbs))), + AVal.slotA borrowOutput.bump.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact hslotReleased (hborrow hborrowRun) + +/-- Every successful shared projection lowering is bounded-sound. The +borrowing sub-run determines whether the target owner remains in the output +environment or is released after retaining the fetched field; erased values +absorb projection, while other stable constants make target execution stuck. -/ +theorem lowerE_proj_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} + (hborrow : LowerBorrowPreservesBelow ctx cur limit src fuel) + {input output : VEnv} {world : Owned} {index : Nat} + {source : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hrun : (lowerE src (fuel + 1) input world + (.proj index source)).run state = + .ok (output, emit, av) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (havailable : SelfAvailableBelow ctx cur limit input) : + LowerResultSoundBelow ctx cur limit input output world emit av := by + exact (lowerE_proj_run_sound_core + (BorrowResult := fun borrowOutput borrowEmit borrowed release + middleState => + ExtraRepresented ctx middleState → + LowerBorrowSoundBelow ctx cur limit input borrowOutput borrowEmit + borrowed release) + (ProjectionResult := fun projectionWorld projectionOutput projectionEmit + projectionAv projectionState => + ExtraRepresented ctx projectionState → + LowerResultSoundBelow ctx cur limit input projectionOutput + projectionWorld + projectionEmit projectionAv) + (hborrow := fun hsubrun hrepresented => + hborrow hsubrun hrepresented havailable) + (hvar := fun hsound hrepresented => by + cases (hsound hrepresented).stable) + (hlit := fun hsound hrepresented => + (hsound hrepresented).projectConst) + (herased := fun hsound hrepresented => + (hsound hrepresented).returnErased) + (hslotKept := fun hsound hrepresented => + (hsound hrepresented).projectSlotKept) + (hslotReleased := fun hsound hrepresented => + (hsound hrepresented).projectSlotReleased) + hrun) hrepresented + +/-- Semantic projection branch of the executable lowerer. The four target +descriptors are dispatched against the two source outcomes: a slot borrow +selects the corresponding constructor field, the erased descriptor absorbs +an erased target, and the remaining two pairings are unreachable. The +compiler-induction hypothesis is supplied for the exact borrow run, so this +theorem carries no fuel bound of its own. -/ +theorem lowerE_proj_run_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Owned} {index : Nat} + {source : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + {sourceTarget sourceValue : IxIR0.Value} + (hborrow : ∀ {borrowOutput : VEnv} {borrowEmit : Emit} + {borrowed : AVal} {release : Bool} {middleState : LowSt}, + (lowerBorrow src fuel input source).run state = + .ok (borrowOutput, borrowEmit, borrowed, release) middleState → + LowerBorrowValueSound funRel recSelfRel ctx cur input borrowOutput + sourceEnv sourceEnv sourceTarget borrowEmit borrowed release) + (hproject : SourceProject index sourceTarget sourceValue) + (hrun : (lowerE src (fuel + 1) input world + (.proj index source)).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue world emit av := by + exact lowerE_proj_run_sound_core + (BorrowResult := fun borrowOutput borrowEmit borrowed release _ => + LowerBorrowValueSound funRel recSelfRel ctx cur input borrowOutput + sourceEnv sourceEnv sourceTarget borrowEmit borrowed release) + (ProjectionResult := fun projectionWorld projectionOutput projectionEmit + projectionAv _ => + LowerResultValueSound funRel recSelfRel ctx cur input projectionOutput + sourceEnv sourceEnv sourceValue projectionWorld projectionEmit + projectionAv) + (hborrow := fun hsubrun => hborrow hsubrun) + (hvar := fun hsound => by cases hsound.stable) + (hlit := fun hsound => hsound.projectConst) + (herased := fun hsound => by + cases hproject with + | ctor hfield => exact hsound.projectCtorErased + | erased => exact hsound.returnErased) + (hslotKept := fun hsound => by + cases hproject with + | ctor hfield => exact hsound.projectSlotKept hfield + | erased => exact hsound.projectSlotKeptErased) + (hslotReleased := fun hsound => by + cases hproject with + | ctor hfield => exact hsound.projectSlotReleased hfield + | erased => exact hsound.projectSlotReleasedErased) + hrun + +/-- If projection lowering returns literal erased, its borrowing sub-run +returned literal erased as well. All fetch-producing branches return slots. -/ +theorem lowerE_proj_run_constErased_inv + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {world : Owned} {index : Nat} {source : IxIR0.Expr} + {emit : Emit} {state finalState : LowSt} + (hrun : (lowerE src (fuel + 1) input world + (.proj index source)).run state = + .ok (output, emit, .constA .erased) finalState) : + ∃ borrowOutput borrowEmit release middleState, + (lowerBorrow src fuel input source).run state = + .ok (borrowOutput, borrowEmit, .constA .erased, release) + middleState := by + exact (lowerE_proj_run_sound_core + (BorrowResult := fun borrowOutput borrowEmit borrowed release + middleState => + (lowerBorrow src fuel input source).run state = + .ok (borrowOutput, borrowEmit, borrowed, release) middleState) + (ProjectionResult := fun _ _ _ projectionAv _ => + projectionAv = .constA .erased → + ∃ borrowOutput borrowEmit release middleState, + (lowerBorrow src fuel input source).run state = + .ok (borrowOutput, borrowEmit, .constA .erased, release) + middleState) + (hborrow := fun hsubrun => hsubrun) + (hvar := fun _ hcontra => by cases hcontra) + (hlit := fun _ hcontra => by cases hcontra) + (herased := fun hsubrun _ => ⟨_, _, _, _, hsubrun⟩) + (hslotKept := fun _ hcontra => by cases hcontra) + (hslotReleased := fun _ hcontra => by cases hcontra) + hrun) rfl + +/-- Fully instantiated semantic projection: with a source variable as the +projection target the borrow hypothesis is discharged by the variable-borrow +theorem, so this carries no compiler-induction premise at all. -/ +theorem lowerE_proj_var_run_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Owned} {index i : Nat} + {emit : Emit} {av : AVal} {state finalState : LowSt} + {sourceEnv : List IxIR0.Value} + {sourceTarget sourceValue : IxIR0.Value} + (hsource : sourceEnv[i]? = some sourceTarget) + (hproject : SourceProject index sourceTarget sourceValue) + (hrun : (lowerE src (fuel + 2) input world + (.proj index (.var i))).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue world emit av := by + refine lowerE_proj_run_value_sound (fuel := fuel + 1) ?_ hproject hrun + intro borrowOutput borrowEmit borrowed release middleState hborrowRun + exact lowerBorrow_var_run_value_sound hsource hborrowRun + +/-- The expression-level application constructor delegates exactly to the +predecessor-fuel spine proof. -/ +theorem lowerE_app_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} + (hspine : LowerSpinePreservesBelow ctx cur limit src fuel) + {input output : VEnv} {world : Owned} {function argument : IxIR0.Expr} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hrun : (lowerE src (fuel + 1) input world + (.app function argument)).run state = + .ok (output, emit, av) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (havailable : SelfAvailableBelow ctx cur limit input) : + LowerResultSoundBelow ctx cur limit input output world emit av := by + apply hspine + · simpa [lowerE] using hrun + · exact hrepresented + · exact havailable + +/-- Expression constructors that neither install a local binder nor create a +lifted local declaration. These are exactly the cases already closed by the +bounded compiler induction's variable, spine, borrow, and scalar layers. -/ +inductive NonbindingLowerEHead : IxIR0.Expr → Prop where + | var (index : Nat) : NonbindingLowerEHead (.var index) + | ref (address : Ixon.Address) : NonbindingLowerEHead (.ref address) + | app (function argument : IxIR0.Expr) : + NonbindingLowerEHead (.app function argument) + | proj (index : Nat) (source : IxIR0.Expr) : + NonbindingLowerEHead (.proj index source) + | lit (literal : IxIR0.Literal) : NonbindingLowerEHead (.lit literal) + | erased : NonbindingLowerEHead .erased + +/-- Consolidated bounded `lowerE` step for every nonbinding constructor. +Lambda lifting and let installation are supplied by their adjacent dedicated +rules. -/ +theorem lowerE_nonbinding_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} + (hspine : LowerSpinePreservesBelow ctx cur limit src fuel) + (hargsNext : LowerArgsPreservesBelow ctx cur limit src (fuel + 1)) + (hargsNextExtra : LowerArgsExtraMonotone src (fuel + 1)) + (hrestNext : ApplyRestPreservesBelow ctx cur limit src (fuel + 1)) + (hrestNextExtra : ApplyRestExtraMonotone src (fuel + 1)) + (hborrow : LowerBorrowPreservesBelow ctx cur limit src fuel) + (hdecls : SourceDeclContractsBelow src ctx limit) + {input output : VEnv} {world : Owned} {expr : IxIR0.Expr} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hshape : NonbindingLowerEHead expr) + (hrun : (lowerE src (fuel + 1) input world expr).run state = + .ok (output, emit, av) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (havailable : SelfAvailableBelow ctx cur limit input) : + LowerResultSoundBelow ctx cur limit input output world emit av := by + cases hshape with + | var index => exact lowerE_var_run_sound_below hrun + | ref address => + exact lowerE_ref_run_sound_below hargsNext hargsNextExtra hrestNext + hrestNextExtra hdecls hrun hrepresented havailable + | app function argument => + exact lowerE_app_run_sound_below hspine hrun hrepresented havailable + | proj index source => + exact lowerE_proj_run_sound_below hborrow hrun hrepresented havailable + | lit literal => exact lowerE_lit_run_sound_below hrun + | erased => exact lowerE_erased_run_sound_below hrun + +/-- Invert a pure post-map that preserves the third component of a lowered +expression result. This factors the common tail of every executable let +installation branch. -/ +theorem lowerE_mapResult_run_inv + {src : IxIR0.Env} {fuel : Nat} {bodyInput output : VEnv} + {world : Owned} {body : IxIR0.Expr} {map : VEnv → Emit → VEnv × Emit} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hrun : ((lowerE src fuel bodyInput world body) >>= fun result => + let (bodyOutput, bodyEmit, resultValue) := result + let mapped := map bodyOutput bodyEmit + pure (mapped.1, mapped.2, resultValue)).run state = + .ok (output, emit, av) finalState) : + ∃ bodyOutput bodyEmit bodyFinal, + (lowerE src fuel bodyInput world body).run state = + .ok (bodyOutput, bodyEmit, av) bodyFinal := by + obtain ⟨bodyResult, bodyFinal, hbodyRun, hpureRun⟩ := + estateBindRun_ok_inv hrun + rcases bodyResult with ⟨bodyOutput, bodyEmit, resultValue⟩ + have hpure : + (let mapped := map bodyOutput bodyEmit; + (mapped.1, mapped.2, resultValue)) = (output, emit, av) ∧ + bodyFinal = finalState := by + simpa using hpureRun + have hvalue : resultValue = av := by + simpa using congrArg (fun result => result.2.2) hpure.1 + subst resultValue + exact ⟨bodyOutput, bodyEmit, bodyFinal, hbodyRun⟩ + +/-- Shared operational dispatcher for successful let lowering. The result +family keeps inversion, bounded ownership, and exact/bounded semantic and +profile clients separate while value/body sequencing, binder-shape +classification, dead-use rejection, output recovery, and the common +environment facts occur once. -/ +theorem lowerE_let_run_sound_core + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {world : Owned} {uses : Uses} {value body : IxIR0.Expr} + {emit : Emit} {av : AVal} {state finalState : LowSt} + {Result : VEnv → Emit → AVal → LowSt → Prop} + (hslotAffine : ∀ {middle : VEnv} {valueEmit : Emit} {abs : Nat} + {valueState : LowSt} {bodyOutput : VEnv} {bodyEmit : Emit} + {resultValue : AVal} {bodyState : LowSt}, + (lowerE src fuel input (worldOfUses uses) value).run state = + .ok (middle, valueEmit, .slotA abs) valueState → + uses = .affine → + let heldInput := installAliasBinder middle abs 0 .affine true + let bodyInput := + (heldInput.setEntry 0 (.slot abs 0 .affine false)).bump + (lowerE src fuel bodyInput world body).run valueState = + .ok (bodyOutput, bodyEmit, resultValue) bodyState → + (NoRecSelf middle → NoRecSelf bodyInput) → + FirstEntryTracks bodyInput .affine (countUses 0 body) → + heldInput.entries[0]? = some (.slot abs 0 .affine true) → + Result bodyOutput.pop + (valueEmit ∘ emitOp (.dropU (.var (middle.rel abs))) ∘ bodyEmit) + resultValue bodyState) + (hslotMany : ∀ {middle : VEnv} {valueEmit : Emit} {abs : Nat} + {valueState : LowSt} {bodyOutput : VEnv} {bodyEmit : Emit} + {resultValue : AVal} {bodyState : LowSt}, + (lowerE src fuel input (worldOfUses uses) value).run state = + .ok (middle, valueEmit, .slotA abs) valueState → + uses = .many → + let heldInput := installAliasBinder middle abs 0 .many true + let bodyInput := + (heldInput.setEntry 0 (.slot abs 0 .many false)).bump + (lowerE src fuel bodyInput world body).run valueState = + .ok (bodyOutput, bodyEmit, resultValue) bodyState → + (NoRecSelf middle → NoRecSelf bodyInput) → + FirstEntryTracks bodyInput .many (countUses 0 body) → + heldInput.entries[0]? = some (.slot abs 0 .many true) → + Result bodyOutput.pop + (valueEmit ∘ emitOp (.drop (.var (middle.rel abs))) ∘ bodyEmit) + resultValue bodyState) + (hslotUsed : ∀ {middle : VEnv} {valueEmit : Emit} {abs : Nat} + {valueState : LowSt} {bodyOutput : VEnv} {bodyEmit : Emit} + {resultValue : AVal} {bodyState : LowSt}, + (lowerE src fuel input (worldOfUses uses) value).run state = + .ok (middle, valueEmit, .slotA abs) valueState → + let bodyInput := installAliasBinder middle abs (countUses 0 body) + uses true + (lowerE src fuel bodyInput world body).run valueState = + .ok (bodyOutput, bodyEmit, resultValue) bodyState → + (NoRecSelf middle → NoRecSelf bodyInput) → + FirstEntryTracks bodyInput uses (countUses 0 body) → + Result bodyOutput.pop (valueEmit ∘ bodyEmit) resultValue bodyState) + (hconstUnused : ∀ {middle : VEnv} {valueEmit : Emit} + {atom : Atom} {valueState : LowSt} {bodyOutput : VEnv} + {bodyEmit : Emit} {resultValue : AVal} {bodyState : LowSt}, + (lowerE src fuel input (worldOfUses uses) value).run state = + .ok (middle, valueEmit, .constA atom) valueState → + let bodyInput := installPushedBinder middle 0 uses false + (lowerE src fuel bodyInput world body).run valueState = + .ok (bodyOutput, bodyEmit, resultValue) bodyState → + (NoRecSelf middle → NoRecSelf bodyInput) → + FirstEntryTracks bodyInput uses (countUses 0 body) → + Result bodyOutput.pop + (valueEmit ∘ emitOp (.pure atom) ∘ bodyEmit) resultValue bodyState) + (hconstUsed : ∀ {middle : VEnv} {valueEmit : Emit} + {atom : Atom} {valueState : LowSt} {bodyOutput : VEnv} + {bodyEmit : Emit} {resultValue : AVal} {bodyState : LowSt}, + (lowerE src fuel input (worldOfUses uses) value).run state = + .ok (middle, valueEmit, .constA atom) valueState → + let bodyInput := installPushedBinder middle (countUses 0 body) + uses true + (lowerE src fuel bodyInput world body).run valueState = + .ok (bodyOutput, bodyEmit, resultValue) bodyState → + (NoRecSelf middle → NoRecSelf bodyInput) → + FirstEntryTracks bodyInput uses (countUses 0 body) → + Result bodyOutput.pop + (valueEmit ∘ emitOp (.pure atom) ∘ bodyEmit) resultValue bodyState) + (hrun : (lowerE src (fuel + 1) input world + (.letE uses value body)).run state = + .ok (output, emit, av) finalState) : + Result output emit av finalState := by + simp only [lowerE] at hrun + obtain ⟨valueResult, valueState, hvalueRun, hafterValue⟩ := + estateBindRun_ok_inv hrun + rcases valueResult with ⟨middle, valueEmit, boundValue⟩ + cases boundValue with + | slotA abs => + by_cases hzero : countUses 0 body = 0 + · cases uses with + | erased => + obtain ⟨_, _, hthrow, _⟩ := estateBindRun_ok_inv + (by simpa [hzero] using hafterValue) + exact (estateThrowRun_not_ok hthrow).elim + | linear => + obtain ⟨_, _, hthrow, _⟩ := estateBindRun_ok_inv + (by simpa [hzero] using hafterValue) + exact (estateThrowRun_not_ok hthrow).elim + | affine => + let heldInput := installAliasBinder middle abs 0 .affine true + let bodyInput := + (heldInput.setEntry 0 (.slot abs 0 .affine false)).bump + have hcontinue : + ((lowerE src fuel bodyInput world body) >>= fun result => + let (bodyOutput, bodyEmit, resultValue) := result + pure (bodyOutput.pop, + valueEmit ∘ emitOp (.dropU (.var (middle.rel abs))) ∘ + bodyEmit, + resultValue)).run valueState = + .ok (output, emit, av) finalState := by + simpa [hzero, heldInput, bodyInput, installAliasBinder, + VEnv.setEntry, VEnv.bump] using hafterValue + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + estateBindRun_ok_inv hcontinue + rcases bodyResult with ⟨bodyOutput, bodyEmit, resultValue⟩ + have hpure : + (bodyOutput.pop, + valueEmit ∘ emitOp (.dropU (.var (middle.rel abs))) ∘ + bodyEmit, + resultValue) = (output, emit, av) ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + have hno : NoRecSelf middle → NoRecSelf bodyInput := by + intro hmiddle + have hinstalled := + (hmiddle.consSlot abs 0 .affine true).setSlot + 0 abs 0 .affine false + simpa [bodyInput, heldInput, installAliasBinder] using + hinstalled.bump + have htracked : FirstEntryTracks bodyInput .affine + (countUses 0 body) := by + refine ⟨abs, middle.entries, ?_⟩ + simp [bodyInput, heldInput, installAliasBinder, VEnv.setEntry, + VEnv.bump, hzero] + have hentry : heldInput.entries[0]? = + some (.slot abs 0 .affine true) := by + simp [heldInput, installAliasBinder] + exact hslotAffine hvalueRun rfl hbodyRun hno htracked hentry + | many => + let heldInput := installAliasBinder middle abs 0 .many true + let bodyInput := + (heldInput.setEntry 0 (.slot abs 0 .many false)).bump + have hcontinue : + ((lowerE src fuel bodyInput world body) >>= fun result => + let (bodyOutput, bodyEmit, resultValue) := result + pure (bodyOutput.pop, + valueEmit ∘ emitOp (.drop (.var (middle.rel abs))) ∘ + bodyEmit, + resultValue)).run valueState = + .ok (output, emit, av) finalState := by + simpa [hzero, heldInput, bodyInput, installAliasBinder, + VEnv.setEntry, VEnv.bump] using hafterValue + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + estateBindRun_ok_inv hcontinue + rcases bodyResult with ⟨bodyOutput, bodyEmit, resultValue⟩ + have hpure : + (bodyOutput.pop, + valueEmit ∘ emitOp (.drop (.var (middle.rel abs))) ∘ + bodyEmit, + resultValue) = (output, emit, av) ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + have hno : NoRecSelf middle → NoRecSelf bodyInput := by + intro hmiddle + have hinstalled := + (hmiddle.consSlot abs 0 .many true).setSlot + 0 abs 0 .many false + simpa [bodyInput, heldInput, installAliasBinder] using + hinstalled.bump + have htracked : FirstEntryTracks bodyInput .many + (countUses 0 body) := by + refine ⟨abs, middle.entries, ?_⟩ + simp [bodyInput, heldInput, installAliasBinder, VEnv.setEntry, + VEnv.bump, hzero] + have hentry : heldInput.entries[0]? = + some (.slot abs 0 .many true) := by + simp [heldInput, installAliasBinder] + exact hslotMany hvalueRun rfl hbodyRun hno htracked hentry + · let bodyInput := installAliasBinder middle abs + (countUses 0 body) uses true + have hcontinue : + ((lowerE src fuel bodyInput world body) >>= fun result => + let (bodyOutput, bodyEmit, resultValue) := result + pure (bodyOutput.pop, valueEmit ∘ bodyEmit, resultValue)).run + valueState = .ok (output, emit, av) finalState := by + simpa [hzero, bodyInput, installAliasBinder] using hafterValue + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + estateBindRun_ok_inv hcontinue + rcases bodyResult with ⟨bodyOutput, bodyEmit, resultValue⟩ + have hpure : + (bodyOutput.pop, valueEmit ∘ bodyEmit, resultValue) = + (output, emit, av) ∧ bodyState = finalState := by + simpa using hafterBody + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + have hno : NoRecSelf middle → NoRecSelf bodyInput := by + intro hmiddle + simpa [bodyInput, installAliasBinder] using + hmiddle.consSlot abs (countUses 0 body) uses true + have htracked : FirstEntryTracks bodyInput uses + (countUses 0 body) := by + refine ⟨abs, middle.entries, ?_⟩ + simp [bodyInput, installAliasBinder, hzero] + exact hslotUsed hvalueRun hbodyRun hno htracked + | constA atom => + by_cases hzero : countUses 0 body = 0 + · let bodyInput := installPushedBinder middle 0 uses false + have hcontinue : + ((lowerE src fuel bodyInput world body) >>= fun result => + let (bodyOutput, bodyEmit, resultValue) := result + pure (bodyOutput.pop, + valueEmit ∘ emitOp (.pure atom) ∘ bodyEmit, + resultValue)).run valueState = + .ok (output, emit, av) finalState := by + simpa [hzero, bodyInput, installPushedBinder] using hafterValue + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + estateBindRun_ok_inv hcontinue + rcases bodyResult with ⟨bodyOutput, bodyEmit, resultValue⟩ + have hpure : + (bodyOutput.pop, valueEmit ∘ emitOp (.pure atom) ∘ bodyEmit, + resultValue) = (output, emit, av) ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + have hno : NoRecSelf middle → NoRecSelf bodyInput := by + intro hmiddle + simpa [bodyInput, installPushedBinder, VEnv.bump] using + (hmiddle.consSlot middle.depth 0 uses false).bump + have htracked : FirstEntryTracks bodyInput uses + (countUses 0 body) := by + refine ⟨middle.depth, middle.entries, ?_⟩ + simp [bodyInput, installPushedBinder, hzero] + exact hconstUnused hvalueRun hbodyRun hno htracked + · let bodyInput := installPushedBinder middle (countUses 0 body) + uses true + have hcontinue : + ((lowerE src fuel bodyInput world body) >>= fun result => + let (bodyOutput, bodyEmit, resultValue) := result + pure (bodyOutput.pop, + valueEmit ∘ emitOp (.pure atom) ∘ bodyEmit, + resultValue)).run valueState = + .ok (output, emit, av) finalState := by + simpa [hzero, bodyInput, installPushedBinder] using hafterValue + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + estateBindRun_ok_inv hcontinue + rcases bodyResult with ⟨bodyOutput, bodyEmit, resultValue⟩ + have hpure : + (bodyOutput.pop, valueEmit ∘ emitOp (.pure atom) ∘ bodyEmit, + resultValue) = (output, emit, av) ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + have hno : NoRecSelf middle → NoRecSelf bodyInput := by + intro hmiddle + simpa [bodyInput, installPushedBinder, VEnv.bump] using + (hmiddle.consSlot middle.depth (countUses 0 body) uses true).bump + have htracked : FirstEntryTracks bodyInput uses + (countUses 0 body) := by + refine ⟨middle.depth, middle.entries, ?_⟩ + simp [bodyInput, installPushedBinder, hzero] + exact hconstUsed hvalueRun hbodyRun hno htracked + +/-- Every successful let run exposes the predecessor-fuel body run with the +same result descriptor. Binder materialization and cleanup change only the +environment and emitter components. -/ +theorem lowerE_let_body_run_inv + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {world : Owned} {uses : Uses} {value body : IxIR0.Expr} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hrun : (lowerE src (fuel + 1) input world + (.letE uses value body)).run state = + .ok (output, emit, av) finalState) : + ∃ bodyInput bodyOutput bodyEmit bodyState bodyFinal, + (lowerE src fuel bodyInput world body).run bodyState = + .ok (bodyOutput, bodyEmit, av) bodyFinal := by + exact lowerE_let_run_sound_core + (Result := fun _ _ resultValue _ => + ∃ bodyInput bodyOutput bodyEmit bodyState bodyFinal, + (lowerE src fuel bodyInput world body).run bodyState = + .ok (bodyOutput, bodyEmit, resultValue) bodyFinal) + (hslotAffine := by + intro _ _ _ valueState bodyOutput bodyEmit _ bodyState _ + intro _ + dsimp only + intro hbodyRun _ _ _ + exact ⟨_, bodyOutput, bodyEmit, valueState, bodyState, hbodyRun⟩) + (hslotMany := by + intro _ _ _ valueState bodyOutput bodyEmit _ bodyState _ + intro _ + dsimp only + intro hbodyRun _ _ _ + exact ⟨_, bodyOutput, bodyEmit, valueState, bodyState, hbodyRun⟩) + (hslotUsed := by + intro _ _ _ valueState bodyOutput bodyEmit _ bodyState _ + dsimp only + intro hbodyRun _ _ + exact ⟨_, bodyOutput, bodyEmit, valueState, bodyState, hbodyRun⟩) + (hconstUnused := by + intro _ _ _ valueState bodyOutput bodyEmit _ bodyState _ + dsimp only + intro hbodyRun _ _ + exact ⟨_, bodyOutput, bodyEmit, valueState, bodyState, hbodyRun⟩) + (hconstUsed := by + intro _ _ _ valueState bodyOutput bodyEmit _ bodyState _ + dsimp only + intro hbodyRun _ _ + exact ⟨_, bodyOutput, bodyEmit, valueState, bodyState, hbodyRun⟩) + hrun + +/-- Every successful let installation is bounded-sound once the companion +compile-state induction proves that the body consumes its counted first +entry. Slot values alias their existing owner; dead shared/affine aliases are +released before the body; stable constants are materialized in the physical +slot the executable lowerer installs. -/ +theorem lowerE_let_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} + (hexpr : LowerEPreservesBelow ctx cur limit src fuel) + {input output : VEnv} {world : Owned} {uses : Uses} + {value body : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hreleases : LowerEReleasesTrackedFirst src fuel body) + (hrun : (lowerE src (fuel + 1) input world + (.letE uses value body)).run state = + .ok (output, emit, av) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (havailable : SelfAvailableBelow ctx cur limit input) : + LowerResultSoundBelow ctx cur limit input output world emit av := by + exact (lowerE_let_run_sound_core + (Result := fun branchOutput branchEmit branchValue branchState => + ExtraRepresented ctx branchState → + LowerResultSoundBelow ctx cur limit input branchOutput world + branchEmit branchValue) + (hslotAffine := by + intro middle valueEmit abs valueState bodyOutput bodyEmit resultValue + bodyState hvalueRun + intro huses + subst uses + dsimp only + intro hbodyRun _ htracked hentry hrepresented + let heldInput := installAliasBinder middle abs 0 .affine true + let bodyInput := + (heldInput.setEntry 0 (.slot abs 0 .affine false)).bump + have hmiddleAvailable := havailable.lowerE hvalueRun + have hbodyAvailable : SelfAvailableBelow ctx cur limit bodyInput := by + have hinstalled := + (hmiddleAvailable.consSlot abs 0 .affine true).setSlot + 0 abs 0 .affine false + simpa [bodyInput, heldInput, installAliasBinder] using + hinstalled.bump + have hbodySound := hexpr hbodyRun hrepresented hbodyAvailable + have hvalueSound := hexpr hvalueRun + (hrepresented.of_extends (lowerE_extraExtends hbodyRun)) + havailable + have hreleased := hreleases htracked hbodyRun + have hinstall : ∀ rest slots, + EmitSoundBelow ctx cur limit + (emitOp (.dropU (.var (middle.rel abs)))) + (OwnsResultProtected middle .unique (.slotA abs) rest slots) + (OwnsVEnvProtected bodyInput rest slots) := by + intro rest slots + have halias := installAliasBinder_held_below + (ctx := ctx) (cur := cur) (limit := limit) + (Γ := middle) (abs := abs) (remaining := 0) + (uses := .affine) rest slots + have hdrop := release_slot_affine_owned_below + (ctx := ctx) (cur := cur) (limit := limit) + (Γ := heldInput) (i := 0) (abs := abs) hentry rest slots + have hcomposed := EmitSoundBelow.comp halias hdrop + simpa [bodyInput, heldInput, installAliasBinder, VEnv.rel, + worldOfUses, Function.comp_def] using hcomposed + have hsound := hvalueSound.installThen hinstall hbodySound hreleased + simpa [worldOfUses, Function.comp_def] using hsound) + (hslotMany := by + intro middle valueEmit abs valueState bodyOutput bodyEmit resultValue + bodyState hvalueRun + intro huses + subst uses + dsimp only + intro hbodyRun _ htracked hentry hrepresented + let heldInput := installAliasBinder middle abs 0 .many true + let bodyInput := + (heldInput.setEntry 0 (.slot abs 0 .many false)).bump + have hmiddleAvailable := havailable.lowerE hvalueRun + have hbodyAvailable : SelfAvailableBelow ctx cur limit bodyInput := by + have hinstalled := + (hmiddleAvailable.consSlot abs 0 .many true).setSlot + 0 abs 0 .many false + simpa [bodyInput, heldInput, installAliasBinder] using + hinstalled.bump + have hbodySound := hexpr hbodyRun hrepresented hbodyAvailable + have hvalueSound := hexpr hvalueRun + (hrepresented.of_extends (lowerE_extraExtends hbodyRun)) + havailable + have hreleased := hreleases htracked hbodyRun + have hinstall : ∀ rest slots, + EmitSoundBelow ctx cur limit + (emitOp (.drop (.var (middle.rel abs)))) + (OwnsResultProtected middle .shared (.slotA abs) rest slots) + (OwnsVEnvProtected bodyInput rest slots) := by + intro rest slots + have halias := installAliasBinder_held_below + (ctx := ctx) (cur := cur) (limit := limit) + (Γ := middle) (abs := abs) (remaining := 0) + (uses := .many) rest slots + have hdrop := release_slot_many_owned_below + (ctx := ctx) (cur := cur) (limit := limit) + (Γ := heldInput) (i := 0) (abs := abs) hentry rest slots + have hcomposed := EmitSoundBelow.comp halias hdrop + simpa [bodyInput, heldInput, installAliasBinder, VEnv.rel, + worldOfUses, Function.comp_def] using hcomposed + have hsound := hvalueSound.installThen hinstall hbodySound hreleased + simpa [worldOfUses, Function.comp_def] using hsound) + (hslotUsed := by + intro middle valueEmit abs valueState bodyOutput bodyEmit resultValue + bodyState hvalueRun + dsimp only + intro hbodyRun _ htracked hrepresented + let bodyInput := installAliasBinder middle abs + (countUses 0 body) uses true + have hmiddleAvailable := havailable.lowerE hvalueRun + have hbodyAvailable : SelfAvailableBelow ctx cur limit bodyInput := by + simpa [bodyInput, installAliasBinder] using + hmiddleAvailable.consSlot abs (countUses 0 body) uses true + have hbodySound := hexpr hbodyRun hrepresented hbodyAvailable + have hvalueSound := hexpr hvalueRun + (hrepresented.of_extends (lowerE_extraExtends hbodyRun)) + havailable + have hreleased := hreleases htracked hbodyRun + have hinstall := installAliasBinder_held_below + (ctx := ctx) (cur := cur) (limit := limit) + (Γ := middle) (abs := abs) (remaining := countUses 0 body) + (uses := uses) + have hsound := hvalueSound.installThen hinstall hbodySound hreleased + simpa [Function.comp_def] using hsound) + (hconstUnused := by + intro middle valueEmit atom valueState bodyOutput bodyEmit resultValue + bodyState hvalueRun + dsimp only + intro hbodyRun _ htracked hrepresented + let bodyInput := installPushedBinder middle 0 uses false + have hmiddleAvailable := havailable.lowerE hvalueRun + have hbodyAvailable : SelfAvailableBelow ctx cur limit bodyInput := by + simpa [bodyInput, installPushedBinder, VEnv.bump] using + (hmiddleAvailable.consSlot middle.depth 0 uses false).bump + have hbodySound := hexpr hbodyRun hrepresented hbodyAvailable + have hvalueSound := hexpr hvalueRun + (hrepresented.of_extends (lowerE_extraExtends hbodyRun)) + havailable + have hreleased := hreleases htracked hbodyRun + have hinstall := materializeConstBinder_below + (ctx := ctx) (cur := cur) (limit := limit) + (Γ := middle) (atom := atom) (remaining := 0) + (uses := uses) (held := false) hvalueSound.stable + have hsound := hvalueSound.installThen hinstall hbodySound hreleased + simpa [worldOfUses, Function.comp_def] using hsound) + (hconstUsed := by + intro middle valueEmit atom valueState bodyOutput bodyEmit resultValue + bodyState hvalueRun + dsimp only + intro hbodyRun _ htracked hrepresented + let bodyInput := installPushedBinder middle (countUses 0 body) + uses true + have hmiddleAvailable := havailable.lowerE hvalueRun + have hbodyAvailable : SelfAvailableBelow ctx cur limit bodyInput := by + simpa [bodyInput, installPushedBinder, VEnv.bump] using + (hmiddleAvailable.consSlot middle.depth (countUses 0 body) uses + true).bump + have hbodySound := hexpr hbodyRun hrepresented hbodyAvailable + have hvalueSound := hexpr hvalueRun + (hrepresented.of_extends (lowerE_extraExtends hbodyRun)) + havailable + have hreleased := hreleases htracked hbodyRun + have hinstall := materializeConstBinder_below + (ctx := ctx) (cur := cur) (limit := limit) + (Γ := middle) (atom := atom) (remaining := countUses 0 body) + (uses := uses) (held := true) hvalueSound.stable + have hsound := hvalueSound.installThen hinstall hbodySound hreleased + simpa [worldOfUses, Function.comp_def] using hsound) + hrun) hrepresented +/-- Semantic let branch of `lowerE`. The bound expression's source value is +installed as the body's leading environment entry — as an alias for a +slot-backed result, materialized for a scalar, and immediately released when +the body never mentions it — and the body's source result is returned after +the logical pop. -/ +theorem lowerE_let_run_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Owned} {uses : Uses} + {value body : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + {boundSource sourceValue : IxIR0.Value} + (hrecursive : ∀ {middle bodyInput bodyOutput : VEnv} + {valueEmit bodyEmit : Emit} {boundValue resultValue : AVal} + {valueState bodyState bodyFinal : LowSt}, + (lowerE src fuel input (worldOfUses uses) value).run state = + .ok (middle, valueEmit, boundValue) valueState → + (lowerE src fuel bodyInput world body).run bodyState = + .ok (bodyOutput, bodyEmit, resultValue) bodyFinal → + bodyState = valueState → + ExtraExtends bodyFinal finalState → + (NoRecSelf middle → NoRecSelf bodyInput) → + LowerResultValueSound funRel recSelfRel ctx cur input middle + sourceEnv sourceEnv boundSource (worldOfUses uses) + valueEmit boundValue ∧ + LowerResultValueSound funRel recSelfRel ctx cur bodyInput bodyOutput + (boundSource :: sourceEnv) (boundSource :: sourceEnv) + sourceValue world bodyEmit resultValue) + (hreleases : LowerEReleasesTrackedFirst src fuel body) + (hrun : (lowerE src (fuel + 1) input world + (.letE uses value body)).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue world emit av := by + exact (lowerE_let_run_sound_core + (Result := fun branchOutput branchEmit branchValue branchState => + ExtraExtends branchState finalState → + LowerResultValueSound funRel recSelfRel ctx cur input branchOutput + sourceEnv sourceEnv sourceValue world branchEmit branchValue) + (hslotAffine := by + intro middle valueEmit abs valueState bodyOutput bodyEmit resultValue + bodyState hvalueRun + intro huses + subst uses + dsimp only + intro hbodyRun hno htracked hentry hwithin + let heldInput := installAliasBinder middle abs 0 .affine true + let bodyInput := + (heldInput.setEntry 0 (.slot abs 0 .affine false)).bump + obtain ⟨hvalueSound, hbodySound⟩ := + hrecursive hvalueRun hbodyRun rfl hwithin hno + have hreleased := hreleases htracked hbodyRun + have hinstall : InstallBinderValueSound funRel recSelfRel ctx cur + middle bodyInput sourceEnv boundSource .unique (.slotA abs) + (emitOp (.dropU (.var (middle.rel abs)))) := by + refine { toInstallBinderSound := ?_, graphEmits := ?_ } + · intro rest slots + have halias := installAliasBinder_held + (ctx := ctx) (cur := cur) (Γ := middle) (abs := abs) + (remaining := 0) (uses := .affine) rest slots + have hdrop := release_slot_affine_owned + (ctx := ctx) (cur := cur) (Γ := heldInput) (i := 0) + (abs := abs) hentry rest slots + have hcomposed := EmitSound.comp halias hdrop + simpa [bodyInput, heldInput, installAliasBinder, VEnv.rel, + worldOfUses, Function.comp_def] using hcomposed + · intro sourceRest rest slots + have halias := installAliasBinder_held_value_sound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (abs := abs) (remaining := 0) (uses := .affine) + have hdrop := release_slot_affine_value_sound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := heldInput) (i := 0) + (abs := abs) hentry + (boundSource :: sourceEnv) sourceRest rest slots + have hcomposed := EmitSound.comp + (halias.graphEmits sourceRest rest slots) hdrop + simpa [bodyInput, heldInput, installAliasBinder, VEnv.rel, + worldOfUses, Function.comp_def] using hcomposed + have hsound := hvalueSound.installThen hinstall hbodySound hreleased + simpa [worldOfUses, Function.comp_def] using hsound) + (hslotMany := by + intro middle valueEmit abs valueState bodyOutput bodyEmit resultValue + bodyState hvalueRun + intro huses + subst uses + dsimp only + intro hbodyRun hno htracked hentry hwithin + let heldInput := installAliasBinder middle abs 0 .many true + let bodyInput := + (heldInput.setEntry 0 (.slot abs 0 .many false)).bump + obtain ⟨hvalueSound, hbodySound⟩ := + hrecursive hvalueRun hbodyRun rfl hwithin hno + have hreleased := hreleases htracked hbodyRun + have hinstall : InstallBinderValueSound funRel recSelfRel ctx cur + middle bodyInput sourceEnv boundSource .shared (.slotA abs) + (emitOp (.drop (.var (middle.rel abs)))) := by + refine { toInstallBinderSound := ?_, graphEmits := ?_ } + · intro rest slots + have halias := installAliasBinder_held + (ctx := ctx) (cur := cur) (Γ := middle) (abs := abs) + (remaining := 0) (uses := .many) rest slots + have hdrop := release_slot_many_owned + (ctx := ctx) (cur := cur) (Γ := heldInput) (i := 0) + (abs := abs) hentry rest slots + have hcomposed := EmitSound.comp halias hdrop + simpa [bodyInput, heldInput, installAliasBinder, VEnv.rel, + worldOfUses, Function.comp_def] using hcomposed + · intro sourceRest rest slots + have halias := installAliasBinder_held_value_sound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (abs := abs) (remaining := 0) (uses := .many) + have hdrop := release_slot_many_value_sound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := heldInput) (i := 0) + (abs := abs) hentry + (boundSource :: sourceEnv) sourceRest rest slots + have hcomposed := EmitSound.comp + (halias.graphEmits sourceRest rest slots) hdrop + simpa [bodyInput, heldInput, installAliasBinder, VEnv.rel, + worldOfUses, Function.comp_def] using hcomposed + have hsound := hvalueSound.installThen hinstall hbodySound hreleased + simpa [worldOfUses, Function.comp_def] using hsound) + (hslotUsed := by + intro middle valueEmit abs valueState bodyOutput bodyEmit resultValue + bodyState hvalueRun + dsimp only + intro hbodyRun hno htracked hwithin + obtain ⟨hvalueSound, hbodySound⟩ := + hrecursive hvalueRun hbodyRun rfl hwithin hno + have hreleased := hreleases htracked hbodyRun + have hinstall := installAliasBinder_held_value_sound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (abs := abs) (remaining := countUses 0 body) (uses := uses) + have hsound := hvalueSound.installThen hinstall hbodySound hreleased + simpa [Function.comp_def] using hsound) + (hconstUnused := by + intro middle valueEmit atom valueState bodyOutput bodyEmit resultValue + bodyState hvalueRun + dsimp only + intro hbodyRun hno htracked hwithin + obtain ⟨hvalueSound, hbodySound⟩ := + hrecursive hvalueRun hbodyRun rfl hwithin hno + have hreleased := hreleases htracked hbodyRun + have hinstall := materializeConstBinder_value_sound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (atom := atom) (remaining := 0) + (uses := uses) (held := false) hvalueSound.stable + have hsound := hvalueSound.installThen hinstall hbodySound hreleased + simpa [worldOfUses, Function.comp_def] using hsound) + (hconstUsed := by + intro middle valueEmit atom valueState bodyOutput bodyEmit resultValue + bodyState hvalueRun + dsimp only + intro hbodyRun hno htracked hwithin + obtain ⟨hvalueSound, hbodySound⟩ := + hrecursive hvalueRun hbodyRun rfl hwithin hno + have hreleased := hreleases htracked hbodyRun + have hinstall := materializeConstBinder_value_sound + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (Γ := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (atom := atom) (remaining := countUses 0 body) + (uses := uses) (held := true) hvalueSound.stable + have hsound := hvalueSound.installThen hinstall hbodySound hreleased + simpa [worldOfUses, Function.comp_def] using hsound) + hrun) (ExtraExtends.refl _) +/-- Fuel-bounded semantic let lowering. All binder emitters and both +recursive expression results remain at the same target evaluator limit. -/ +theorem lowerE_let_run_value_sound_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Owned} {uses : Uses} + {value body : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + {boundSource sourceValue : IxIR0.Value} + (hrecursive : ∀ {middle bodyInput bodyOutput : VEnv} + {valueEmit bodyEmit : Emit} {boundValue resultValue : AVal} + {valueState bodyState bodyFinal : LowSt}, + (lowerE src fuel input (worldOfUses uses) value).run state = + .ok (middle, valueEmit, boundValue) valueState → + (lowerE src fuel bodyInput world body).run bodyState = + .ok (bodyOutput, bodyEmit, resultValue) bodyFinal → + bodyState = valueState → + ExtraExtends bodyFinal finalState → + (NoRecSelf middle → NoRecSelf bodyInput) → + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input middle + sourceEnv sourceEnv boundSource (worldOfUses uses) + valueEmit boundValue ∧ + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit bodyInput bodyOutput + (boundSource :: sourceEnv) (boundSource :: sourceEnv) + sourceValue world bodyEmit resultValue) + (hreleases : LowerEReleasesTrackedFirst src fuel body) + (hrun : (lowerE src (fuel + 1) input world + (.letE uses value body)).run state = + .ok (output, emit, av) finalState) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue world emit av := by + exact (lowerE_let_run_sound_core + (Result := fun branchOutput branchEmit branchValue branchState => + ExtraExtends branchState finalState → + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input + branchOutput sourceEnv sourceEnv sourceValue world branchEmit + branchValue) + (hslotAffine := by + intro middle valueEmit abs valueState bodyOutput bodyEmit resultValue + bodyState hvalueRun + intro huses + subst uses + dsimp only + intro hbodyRun hno htracked hentry hwithin + let heldInput := installAliasBinder middle abs 0 .affine true + let bodyInput := + (heldInput.setEntry 0 (.slot abs 0 .affine false)).bump + obtain ⟨hvalueSound, hbodySound⟩ := + hrecursive hvalueRun hbodyRun rfl hwithin hno + have hreleased := hreleases htracked hbodyRun + have hinstall : InstallBinderValueSoundBelow funRel recSelfRel ctx cur + limit middle bodyInput sourceEnv boundSource .unique (.slotA abs) + (emitOp (.dropU (.var (middle.rel abs)))) := by + refine { toInstallBinderSoundBelow := ?_, graphEmits := ?_ } + · intro rest slots + have halias := installAliasBinder_held_below + (ctx := ctx) (cur := cur) (limit := limit) (Γ := middle) + (abs := abs) (remaining := 0) (uses := .affine) rest slots + have hdrop := release_slot_affine_owned_below + (ctx := ctx) (cur := cur) (limit := limit) + (Γ := heldInput) (i := 0) (abs := abs) hentry rest slots + have hcomposed := EmitSoundBelow.comp halias hdrop + simpa [bodyInput, heldInput, installAliasBinder, VEnv.rel, + worldOfUses, Function.comp_def] using hcomposed + · intro sourceRest rest slots + have halias := installAliasBinder_held_value_sound_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) (Γ := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (abs := abs) (remaining := 0) (uses := .affine) + have hdrop := release_slot_affine_value_sound_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) + (Γ := heldInput) (i := 0) (abs := abs) hentry + (boundSource :: sourceEnv) sourceRest rest slots + have hcomposed := EmitSoundBelow.comp + (halias.graphEmits sourceRest rest slots) hdrop + simpa [bodyInput, heldInput, installAliasBinder, VEnv.rel, + worldOfUses, Function.comp_def] using hcomposed + have hsound := hvalueSound.installThen hinstall hbodySound hreleased + simpa [worldOfUses, Function.comp_def] using hsound) + (hslotMany := by + intro middle valueEmit abs valueState bodyOutput bodyEmit resultValue + bodyState hvalueRun + intro huses + subst uses + dsimp only + intro hbodyRun hno htracked hentry hwithin + let heldInput := installAliasBinder middle abs 0 .many true + let bodyInput := + (heldInput.setEntry 0 (.slot abs 0 .many false)).bump + obtain ⟨hvalueSound, hbodySound⟩ := + hrecursive hvalueRun hbodyRun rfl hwithin hno + have hreleased := hreleases htracked hbodyRun + have hinstall : InstallBinderValueSoundBelow funRel recSelfRel ctx cur + limit middle bodyInput sourceEnv boundSource .shared (.slotA abs) + (emitOp (.drop (.var (middle.rel abs)))) := by + refine { toInstallBinderSoundBelow := ?_, graphEmits := ?_ } + · intro rest slots + have halias := installAliasBinder_held_below + (ctx := ctx) (cur := cur) (limit := limit) (Γ := middle) + (abs := abs) (remaining := 0) (uses := .many) rest slots + have hdrop := release_slot_many_owned_below + (ctx := ctx) (cur := cur) (limit := limit) + (Γ := heldInput) (i := 0) (abs := abs) hentry rest slots + have hcomposed := EmitSoundBelow.comp halias hdrop + simpa [bodyInput, heldInput, installAliasBinder, VEnv.rel, + worldOfUses, Function.comp_def] using hcomposed + · intro sourceRest rest slots + have halias := installAliasBinder_held_value_sound_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) (Γ := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (abs := abs) (remaining := 0) (uses := .many) + have hdrop := release_slot_many_value_sound_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) + (Γ := heldInput) (i := 0) (abs := abs) hentry + (boundSource :: sourceEnv) sourceRest rest slots + have hcomposed := EmitSoundBelow.comp + (halias.graphEmits sourceRest rest slots) hdrop + simpa [bodyInput, heldInput, installAliasBinder, VEnv.rel, + worldOfUses, Function.comp_def] using hcomposed + have hsound := hvalueSound.installThen hinstall hbodySound hreleased + simpa [worldOfUses, Function.comp_def] using hsound) + (hslotUsed := by + intro middle valueEmit abs valueState bodyOutput bodyEmit resultValue + bodyState hvalueRun + dsimp only + intro hbodyRun hno htracked hwithin + obtain ⟨hvalueSound, hbodySound⟩ := + hrecursive hvalueRun hbodyRun rfl hwithin hno + have hreleased := hreleases htracked hbodyRun + have hinstall := installAliasBinder_held_value_sound_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) (Γ := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (abs := abs) (remaining := countUses 0 body) (uses := uses) + have hsound := hvalueSound.installThen hinstall hbodySound hreleased + simpa [Function.comp_def] using hsound) + (hconstUnused := by + intro middle valueEmit atom valueState bodyOutput bodyEmit resultValue + bodyState hvalueRun + dsimp only + intro hbodyRun hno htracked hwithin + obtain ⟨hvalueSound, hbodySound⟩ := + hrecursive hvalueRun hbodyRun rfl hwithin hno + have hreleased := hreleases htracked hbodyRun + have hinstall := materializeConstBinder_value_sound_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) (Γ := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (atom := atom) (remaining := 0) + (uses := uses) (held := false) hvalueSound.stable + have hsound := hvalueSound.installThen hinstall hbodySound hreleased + simpa [worldOfUses, Function.comp_def] using hsound) + (hconstUsed := by + intro middle valueEmit atom valueState bodyOutput bodyEmit resultValue + bodyState hvalueRun + dsimp only + intro hbodyRun hno htracked hwithin + obtain ⟨hvalueSound, hbodySound⟩ := + hrecursive hvalueRun hbodyRun rfl hwithin hno + have hreleased := hreleases htracked hbodyRun + have hinstall := materializeConstBinder_value_sound_below + (funRel := funRel) (recSelfRel := recSelfRel) + (ctx := ctx) (cur := cur) (limit := limit) (Γ := middle) + (sourceEnv := sourceEnv) (boundSource := boundSource) + (atom := atom) (remaining := countUses 0 body) + (uses := uses) (held := true) hvalueSound.stable + have hsound := hvalueSound.installThen hinstall hbodySound hreleased + simpa [worldOfUses, Function.comp_def] using hsound) + hrun) (ExtraExtends.refl _) +/-- Shared source/run dispatcher for complete expression semantics. The +result family and constructor callbacks keep ordinary, reachable, bounded, +and reflection clients logically separate while source inversion and the +application-to-spine conversion remain canonical. -/ +private theorem lowerE_run_value_sound_core + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {fuel : Nat} + {state finalState : LowSt} {input output : VEnv} {world : Owned} + {expr : IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceFuel : Nat} {sourceValue : IxIR0.Value} + {emit : Emit} {av : AVal} + {Result : IxIR0.Value → Prop} + (hvar : ∀ (index : Nat) {result : IxIR0.Value}, + sourceEnv[index]? = some result → + (lowerE src (fuel + 1) input world (.var index)).run state = + .ok (output, emit, av) finalState → + Result result) + (href : ∀ (address : Ixon.Address) {result : IxIR0.Value}, + IxIR0.eval sourceCtx sourceFuel sourceEnv (.ref address) = .ok result → + (lowerE src (fuel + 1) input world (.ref address)).run state = + .ok (output, emit, av) finalState → + Result result) + (happ : ∀ (function argument : IxIR0.Expr) + {result : IxIR0.Value}, + SourceSpineEval sourceCtx sourceEnv function [argument] result → + (lowerSpine src fuel input world function [argument]).run state = + .ok (output, emit, av) finalState → + Result result) + (hlam : ∀ (uses : Uses) (body : IxIR0.Expr), + (lowerE src (fuel + 1) input world (.lam uses body)).run state = + .ok (output, emit, av) finalState → + Result (.clos uses sourceEnv body)) + (hlet : ∀ (uses : Uses) (value body : IxIR0.Expr) + {sourceStep : Nat} {bound result : IxIR0.Value}, + IxIR0.eval sourceCtx sourceStep sourceEnv value = .ok bound → + IxIR0.eval sourceCtx sourceStep (bound :: sourceEnv) body = + .ok result → + (lowerE src (fuel + 1) input world (.letE uses value body)).run + state = .ok (output, emit, av) finalState → + Result result) + (hproj : ∀ (index : Nat) (source : IxIR0.Expr) + {sourceStep : Nat} {target result : IxIR0.Value}, + IxIR0.eval sourceCtx sourceStep sourceEnv source = .ok target → + SourceProject index target result → + (lowerE src (fuel + 1) input world (.proj index source)).run state = + .ok (output, emit, av) finalState → + Result result) + (hlit : ∀ (literal : IxIR0.Literal), + (lowerE src (fuel + 1) input world (.lit literal)).run state = + .ok (output, emit, av) finalState → + Result (.lit literal)) + (herased : + (lowerE src (fuel + 1) input world .erased).run state = + .ok (output, emit, av) finalState → + Result .erased) + (hsource : IxIR0.eval sourceCtx sourceFuel sourceEnv expr = + .ok sourceValue) + (hrun : (lowerE src (fuel + 1) input world expr).run state = + .ok (output, emit, av) finalState) : + Result sourceValue := by + cases expr with + | var index => + exact hvar index (sourceEval_var_inv hsource) hrun + | ref address => + exact href address hsource hrun + | app function argument => + apply happ function argument (SourceSpineEval.of_eval_app hsource) + simpa [lowerE] using hrun + | lam uses body => + have hvalue := sourceEval_lam_inv hsource + subst sourceValue + exact hlam uses body hrun + | letE uses value body => + obtain ⟨sourceStep, boundSource, hvalueSource, hbodySource⟩ := + sourceEval_let_inv hsource + exact hlet uses value body hvalueSource hbodySource hrun + | proj index source => + obtain ⟨sourceStep, sourceTarget, htarget, hproject⟩ := + sourceEval_proj_inv hsource + exact hproj index source htarget hproject hrun + | lit literal => + have hvalue := sourceEval_lit_inv hsource + subst sourceValue + exact hlit literal hrun + | erased => + have hvalue := sourceEval_erased_inv hsource + subst sourceValue + exact herased hrun + +/-- One complete semantic expression step. Source evaluator inversion supplies +the exact recursive values for let and projection; application and reference +delegate to their completed spine routes; lambda provenance is included in +the canonical whole-pass function relation. -/ +theorem lowerE_run_value_sound + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {relationState : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hexpr : LowerEValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hspine : LowerSpineValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hborrow : LowerBorrowValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src fuel) + (hargsNext : LowerArgsValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src (fuel + 1)) + (hrestNext : ApplyRestNonErasedValuePreserves + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + sourceCtx ctx cur src (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 2)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src relationState) sourceCtx src ctx) + (hreleases : ∀ body, LowerEReleasesTrackedFirst src fuel body) + {input output : VEnv} {world : Owned} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {emit : Emit} {av : AVal} + (hsource : IxIR0.eval sourceCtx sourceFuel sourceEnv expr = + .ok sourceValue) + (hrun : (lowerE src (fuel + 1) input world expr).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState relationState) + (hrepresented : ExtraRepresented ctx relationState) : + LowerResultValueSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel + ctx cur input output sourceEnv sourceEnv sourceValue world emit av := by + exact lowerE_run_value_sound_core + (Result := fun result => + LowerResultValueSound + (CompilerFunctionRel sourceCtx src relationState) recSelfRel ctx cur + input output sourceEnv sourceEnv result world emit av) + (hvar := fun _ _ hlookup hbranchRun => + lowerE_var_run_value_sound hlookup hbranchRun) + (href := fun _ _ hbranchSource hbranchRun => + lowerE_ref_run_value_sound henv hargsNext hrestNext hknownExtra + hcontracts hvalues hbranchSource hbranchRun hextends hrepresented) + (happ := fun _ _ _ hsourceSpine hspineRun => + hspine hsourceSpine hspineRun) + (hlam := fun _ _ hbranchRun => + lowerE_lam_run_value_sound_any + (fun value address arity captures hlifted => + CompilerFunctionRel.lifted (hlifted.monoState hextends)) + (hrepresented.of_extends hextends) hbranchRun) + (hlet := fun _ _ body _ _ _ hvalueSource hbodySource hbranchRun => + lowerE_let_run_value_sound + (fun hvalueRun hbodyRun _ _ _ => + ⟨hexpr hvalueSource hvalueRun, hexpr hbodySource hbodyRun⟩) + (hreleases body) hbranchRun) + (hproj := fun _ _ _ _ _ htarget hproject hbranchRun => + lowerE_proj_run_value_sound + (fun hborrowRun => hborrow htarget hborrowRun) hproject hbranchRun) + (hlit := fun _ hbranchRun => lowerE_lit_run_value_sound hbranchRun) + (herased := fun hbranchRun => + lowerE_erased_run_value_sound hbranchRun) + hsource hrun + +/-- One complete expression-reflection step. Let cleanup preserves the body +descriptor, projection exposes its erased borrow, and all allocating or +scalar constructors are ruled out by executable result shape. -/ +theorem lowerEReflectsErased_succ + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEReflectsErased sourceCtx src fuel) + (hborrow : LowerBorrowReflectsErased sourceCtx src fuel) + (hspine : LowerSpineReflectsErased sourceCtx src fuel) : + LowerEReflectsErased sourceCtx src (fuel + 1) := by + intro input output world expr sourceEnv sourceFuel sourceValue state + finalState emit av hsource hrun herased + exact lowerE_run_value_sound_core + (Result := fun result => result = .erased) + (hvar := fun _ _ _ hbranchRun => by + subst av + exact (lowerE_var_run_ne_constErased hbranchRun).elim) + (href := fun _ _ _ hbranchRun => by + subst av + exact (lowerSpine_ref_run_ne_constErased + (lowerE_ref_run_to_lowerSpine_nil hbranchRun)).elim) + (happ := fun _ _ _ hsourceSpine hspineRun => + hspine hsourceSpine hspineRun herased) + (hlam := fun _ _ hbranchRun => by + subst av + exact (lowerE_lam_run_ne_constErased hbranchRun).elim) + (hlet := fun _ _ _ _ _ _ _ hbodySource hbranchRun => by + obtain ⟨bodyInput, bodyOutput, bodyEmit, bodyState, bodyFinal, + hbodyRun⟩ := lowerE_let_body_run_inv hbranchRun + exact hexpr hbodySource hbodyRun herased) + (hproj := fun _ _ _ sourceTarget _ htarget hproject hbranchRun => by + subst av + obtain ⟨borrowOutput, borrowEmit, release, middleState, + hborrowRun⟩ := lowerE_proj_run_constErased_inv hbranchRun + have htargetErased : sourceTarget = .erased := + hborrow htarget hborrowRun rfl + cases hproject with + | ctor hfield => contradiction + | erased => rfl) + (hlit := fun _ hbranchRun => by + subst av + simp [lowerE] at hbranchRun) + (herased := fun _ => rfl) + hsource hrun + +/-- Closed pure reflection cluster for the three mutually recursive actions +whose result descriptor can expose erased absorption. -/ +structure LowerReflectsErased (sourceCtx : IxIR0.Ctx) (src : IxIR0.Env) + (fuel : Nat) : Prop where + expr : LowerEReflectsErased sourceCtx src fuel + borrow : LowerBorrowReflectsErased sourceCtx src fuel + spine : LowerSpineReflectsErased sourceCtx src fuel + +theorem lowerReflectsErased (sourceCtx : IxIR0.Ctx) (src : IxIR0.Env) : + ∀ fuel, LowerReflectsErased sourceCtx src fuel + | 0 => + { expr := lowerEReflectsErased_zero sourceCtx src + borrow := lowerBorrowReflectsErased_zero sourceCtx src + spine := lowerSpineReflectsErased_zero sourceCtx src } + | fuel + 1 => by + have hprev := lowerReflectsErased sourceCtx src fuel + exact + { expr := lowerEReflectsErased_succ + hprev.expr hprev.borrow hprev.spine + borrow := lowerBorrowReflectsErased_succ hprev.expr + spine := lowerSpineReflectsErased_succ hprev.spine hprev.expr } + +theorem lowerE_reflectsErased (sourceCtx : IxIR0.Ctx) + (src : IxIR0.Env) (fuel : Nat) : + LowerEReflectsErased sourceCtx src fuel := + (lowerReflectsErased sourceCtx src fuel).expr + +theorem lowerBorrow_reflectsErased (sourceCtx : IxIR0.Ctx) + (src : IxIR0.Env) (fuel : Nat) : + LowerBorrowReflectsErased sourceCtx src fuel := + (lowerReflectsErased sourceCtx src fuel).borrow + +theorem lowerSpine_reflectsErased (sourceCtx : IxIR0.Ctx) + (src : IxIR0.Env) (fuel : Nat) : + LowerSpineReflectsErased sourceCtx src fuel := + (lowerReflectsErased sourceCtx src fuel).spine + +/-! ### Reachable-state semantic induction steps -/ + +/-- Reachable-state argument sequencing. The tail run transports the head +subrun's final state into the ambient compiler result. -/ +theorem lowerArgsValuePreservesWithin_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEValuePreservesWithin funRel recSelfRel sourceCtx ctx cur + src ambient fuel) + (htail : LowerArgsValuePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) : + LowerArgsValuePreservesWithin funRel recSelfRel sourceCtx ctx cur src + ambient (fuel + 1) := by + intro input output sourceEnv sourceValues args state finalState emit avs + hsource hrun hextends havailable + exact (lowerArgs_run_value_sound_core + (Result := fun actualOutput actualSourceValues worlds actualEmit + actualAVals actualState => + ExtraExtends actualState ambient → + SelfValueAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerArgsValueSound funRel recSelfRel ctx cur input actualOutput + sourceEnv sourceEnv actualSourceValues worlds actualEmit actualAVals) + (hnil := fun _ _ => lowerArgs_nil_value_sound) + (hcons := by + intro _ _ _ _ _ _ _ _ _ _ _ _ _ _ hsourceHead hsourceTail + hheadRun htailRun hwithin hself + have hmiddleExtends : ExtraExtends _ ambient := + (lowerArgs_extraExtends htailRun).trans hwithin + have hheadSound := + hexpr hsourceHead hheadRun hmiddleExtends hself + have htailSound := htail hsourceTail htailRun hwithin + (hself.lowerE hheadRun) + exact hheadSound.consArgs htailSound) + hsource hrun) hextends havailable + +/-- Fuel-bounded reachable-state argument sequencing. -/ +theorem lowerArgsValuePreservesWithinBelow_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEValuePreservesWithinBelow funRel recSelfRel sourceCtx + ctx cur limit src ambient fuel) + (htail : LowerArgsValuePreservesWithinBelow funRel recSelfRel sourceCtx + ctx cur limit src ambient fuel) : + LowerArgsValuePreservesWithinBelow funRel recSelfRel sourceCtx ctx cur + limit src ambient (fuel + 1) := by + intro input output sourceEnv sourceValues args state finalState emit avs + hsource hrun hextends havailable + exact (lowerArgs_run_value_sound_core + (Result := fun actualOutput actualSourceValues worlds actualEmit + actualAVals actualState => + ExtraExtends actualState ambient → + SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input → + LowerArgsValueSoundBelow funRel recSelfRel ctx cur limit input + actualOutput sourceEnv sourceEnv actualSourceValues worlds actualEmit + actualAVals) + (hnil := fun _ _ => lowerArgs_nil_value_sound_below) + (hcons := by + intro _ _ _ _ _ _ _ _ _ _ _ _ _ _ hsourceHead hsourceTail + hheadRun htailRun hwithin hself + have hmiddleExtends : ExtraExtends _ ambient := + (lowerArgs_extraExtends htailRun).trans hwithin + have hheadSound := + hexpr hsourceHead hheadRun hmiddleExtends hself + have htailSound := htail hsourceTail htailRun hwithin + (hself.lowerE hheadRun) + exact hheadSound.consArgs htailSound) + hsource hrun) hextends havailable + +/-- Reachable-state non-erased higher-order application. Its sole recursive +subrun is the argument traversal ending in the same compiler state. -/ +theorem applyRestNonErasedValuePreservesWithin_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hargs : LowerArgsValuePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hownership : ApplyOwnershipContract ctx) + (hvalue : ApplyValueContract funRel sourceCtx ctx) : + ApplyRestNonErasedValuePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient (fuel + 1) := by + intro start input output sourceStart sourceMiddle sourceArgs + sourceFunction sourceResult resultWorld emitFunction emit function av + args state finalState hfunctionNe hsourceArgs hsource hfunction hrun + hextends havailable + exact (applyRest_nonErased_run_core + (Result := fun actualWorld actualOutput actualEmit actualAv actualState => + ExtraExtends actualState ambient → + SelfValueAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerResultValueSound funRel recSelfRel ctx cur start actualOutput + sourceStart sourceMiddle sourceResult actualWorld actualEmit actualAv) + (hfinish := fun argsOutput emitArgs avs _ hargsRun + hworldsHomogeneous hwithin hself => by + have hsourcePaired : SourceArgsEval sourceCtx sourceMiddle + ((args.map (fun arg => (arg, Owned.shared))).map Prod.fst) + sourceArgs := by + simpa [Function.comp_def] using hsourceArgs + have hargsSound := hargs hsourcePaired hargsRun hwithin hself + have hhomogeneous : LowerArgsValueSound funRel recSelfRel ctx cur + input argsOutput sourceMiddle sourceMiddle sourceArgs + (List.replicate avs.length .shared) emitArgs avs := by + simpa [hworldsHomogeneous] using hargsSound + simpa [Function.comp_def] using + hfunction.applyArgs_graph hhomogeneous hownership hvalue hsource) + hfunctionNe hrun) hextends havailable + +/-- Fuel-bounded reachable-state non-erased higher-order application. -/ +theorem applyRestNonErasedValuePreservesWithinBelow_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hargs : LowerArgsValuePreservesWithinBelow funRel recSelfRel sourceCtx + ctx cur limit src ambient fuel) + (hownership : ApplyOwnershipContractBelow ctx limit) + (hvalue : ApplyValueContractBelow funRel sourceCtx ctx limit) : + ApplyRestNonErasedValuePreservesWithinBelow funRel recSelfRel sourceCtx + ctx cur limit src ambient (fuel + 1) := by + intro start input output sourceStart sourceMiddle sourceArgs + sourceFunction sourceResult resultWorld emitFunction emit function av + args state finalState hfunctionNe hsourceArgs hsource hfunction hrun + hextends havailable + exact (applyRest_nonErased_run_core + (Result := fun actualWorld actualOutput actualEmit actualAv actualState => + ExtraExtends actualState ambient → + SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input → + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit start + actualOutput sourceStart sourceMiddle sourceResult actualWorld + actualEmit actualAv) + (hfinish := fun argsOutput emitArgs avs _ hargsRun + hworldsHomogeneous hwithin hself => by + have hsourcePaired : SourceArgsEval sourceCtx sourceMiddle + ((args.map (fun arg => (arg, Owned.shared))).map Prod.fst) + sourceArgs := by + simpa [Function.comp_def] using hsourceArgs + have hargsSound := hargs hsourcePaired hargsRun hwithin hself + have hhomogeneous : LowerArgsValueSoundBelow funRel recSelfRel ctx cur + limit input argsOutput sourceMiddle sourceMiddle sourceArgs + (List.replicate avs.length .shared) emitArgs avs := by + simpa [hworldsHomogeneous] using hargsSound + simpa [Function.comp_def] using + hfunction.applyArgs_graph hhomogeneous hownership hvalue hsource) + hfunctionNe hrun) hextends havailable + +/-- Reachable-state erased application, used by erased and dynamically +erased spine heads. -/ +theorem applyRest_erased_run_value_sound_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hargs : LowerArgsValuePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + {start input output : VEnv} + {sourceStart sourceMiddle sourceArgs : List IxIR0.Value} + {resultWorld : Owned} {emitFunction emit : Emit} + {args : List IxIR0.Expr} {av : AVal} + {state finalState : LowSt} + (hsourceArgs : SourceArgsEval sourceCtx sourceMiddle args sourceArgs) + (hfunction : LowerResultValueSound funRel recSelfRel ctx cur + start input sourceStart sourceMiddle .erased .shared emitFunction + (.constA .erased)) + (hrun : (applyRest src (fuel + 1) input resultWorld emitFunction + (.constA .erased) args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueSound funRel recSelfRel ctx cur start output + sourceStart sourceMiddle .erased resultWorld emit av := by + exact (applyRest_erased_run_value_sound_core + (Result := fun actualWorld actualOutput actualEmit actualAv actualState => + ExtraExtends actualState ambient → + SelfValueAvailable funRel recSelfRel sourceCtx ctx cur input → + LowerResultValueSound funRel recSelfRel ctx cur start actualOutput + sourceStart sourceMiddle .erased actualWorld actualEmit actualAv) + (hfinish := fun argsOutput emitArgs avs _ hsourcePaired hargsRun + hworldsHomogeneous hsourceLength hwithin hself => by + have hargsSound := hargs hsourcePaired hargsRun hwithin hself + have hhomogeneous : LowerArgsValueSound funRel recSelfRel ctx cur + input argsOutput sourceMiddle sourceMiddle sourceArgs + (List.replicate avs.length .shared) emitArgs avs := by + simpa [hworldsHomogeneous] using hargsSound + simpa [Function.comp_def] using + hfunction.discardArgs hhomogeneous hsourceLength) + hsourceArgs hrun) hextends havailable + +/-- Fuel-bounded reachable-state erased application. -/ +theorem applyRest_erased_run_value_sound_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hargs : LowerArgsValuePreservesWithinBelow funRel recSelfRel sourceCtx + ctx cur limit src ambient fuel) + {start input output : VEnv} + {sourceStart sourceMiddle sourceArgs : List IxIR0.Value} + {resultWorld : Owned} {emitFunction emit : Emit} + {args : List IxIR0.Expr} {av : AVal} + {state finalState : LowSt} + (hsourceArgs : SourceArgsEval sourceCtx sourceMiddle args sourceArgs) + (hfunction : LowerResultValueSoundBelow funRel recSelfRel ctx cur limit + start input sourceStart sourceMiddle .erased .shared emitFunction + (.constA .erased)) + (hrun : (applyRest src (fuel + 1) input resultWorld emitFunction + (.constA .erased) args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit start output + sourceStart sourceMiddle .erased resultWorld emit av := by + exact (applyRest_erased_run_value_sound_core + (Result := fun actualWorld actualOutput actualEmit actualAv actualState => + ExtraExtends actualState ambient → + SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + input → + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit start + actualOutput sourceStart sourceMiddle .erased actualWorld actualEmit + actualAv) + (hfinish := fun argsOutput emitArgs avs _ hsourcePaired hargsRun + hworldsHomogeneous hsourceLength hwithin hself => by + have hargsSound := hargs hsourcePaired hargsRun hwithin hself + have hhomogeneous : LowerArgsValueSoundBelow funRel recSelfRel ctx cur + limit input argsOutput sourceMiddle sourceMiddle sourceArgs + (List.replicate avs.length .shared) emitArgs avs := by + simpa [hworldsHomogeneous] using hargsSound + simpa [Function.comp_def] using + hfunction.discardArgs hhomogeneous hsourceLength) + hsourceArgs hrun) hextends havailable + +/-- Reachable-state dynamic borrow adapter. Its post-processing is pure, so +the expression subrun ends in the same state as the enclosing borrow run. -/ +theorem lowerBorrow_dynamic_run_value_sound_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + {input output : VEnv} {expr : IxIR0.Expr} + {emit : Emit} {av : AVal} {release : Bool} + {state finalState : LowSt} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + (hexpr : ∀ {exprOutput : VEnv} {exprEmit : Emit} {exprAv : AVal} + {exprState : LowSt}, + (lowerE src fuel input .shared expr).run state = + .ok (exprOutput, exprEmit, exprAv) exprState → + ExtraExtends exprState ambient → + LowerResultValueSound funRel recSelfRel ctx cur input exprOutput + sourceEnv sourceEnv sourceValue .shared exprEmit exprAv) + (hshape : DynamicBorrowHead expr) + (hrun : (lowerBorrow src (fuel + 1) input expr).run state = + .ok (output, emit, av, release) finalState) + (hextends : ExtraExtends finalState ambient) : + LowerBorrowValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue emit av release := by + exact (lowerBorrow_dynamic_run_core + (ExprResult := fun exprOutput exprEmit exprAv exprState => + ExtraExtends exprState ambient → + LowerResultValueSound funRel recSelfRel ctx cur input exprOutput + sourceEnv sourceEnv sourceValue .shared exprEmit exprAv) + (BorrowResult := fun borrowOutput borrowEmit borrowAv borrowRelease + borrowState => + ExtraExtends borrowState ambient → + LowerBorrowValueSound funRel recSelfRel ctx cur input borrowOutput + sourceEnv sourceEnv sourceValue borrowEmit borrowAv borrowRelease) + (hexpr := fun hsubrun hwithin => hexpr hsubrun hwithin) + (hslot := fun hsound hwithin => + (hsound hwithin).asBorrowSlot) + (hconst := fun hsound hwithin => + (hsound hwithin).asBorrowConst) + hshape hrun) hextends + +/-- Fuel-bounded reachable-state dynamic borrow adapter. -/ +theorem lowerBorrow_dynamic_run_value_sound_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + {input output : VEnv} {expr : IxIR0.Expr} + {emit : Emit} {av : AVal} {release : Bool} + {state finalState : LowSt} + {sourceEnv : List IxIR0.Value} {sourceValue : IxIR0.Value} + (hexpr : ∀ {exprOutput : VEnv} {exprEmit : Emit} {exprAv : AVal} + {exprState : LowSt}, + (lowerE src fuel input .shared expr).run state = + .ok (exprOutput, exprEmit, exprAv) exprState → + ExtraExtends exprState ambient → + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input + exprOutput sourceEnv sourceEnv sourceValue .shared exprEmit exprAv) + (hshape : DynamicBorrowHead expr) + (hrun : (lowerBorrow src (fuel + 1) input expr).run state = + .ok (output, emit, av, release) finalState) + (hextends : ExtraExtends finalState ambient) : + LowerBorrowValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue emit av release := by + exact (lowerBorrow_dynamic_run_core + (ExprResult := fun exprOutput exprEmit exprAv exprState => + ExtraExtends exprState ambient → + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input + exprOutput sourceEnv sourceEnv sourceValue .shared exprEmit exprAv) + (BorrowResult := fun borrowOutput borrowEmit borrowAv borrowRelease + borrowState => + ExtraExtends borrowState ambient → + LowerBorrowValueSoundBelow funRel recSelfRel ctx cur limit input + borrowOutput sourceEnv sourceEnv sourceValue borrowEmit borrowAv + borrowRelease) + (hexpr := fun hsubrun hwithin => hexpr hsubrun hwithin) + (hslot := fun hsound hwithin => + (hsound hwithin).asBorrowSlot) + (hconst := fun hsound hwithin => + (hsound hwithin).asBorrowConst) + hshape hrun) hextends + +/-- Reachable-state borrow induction step. Non-variable borrowing delegates +to an expression subrun with the same final compiler state. -/ +theorem lowerBorrowValuePreservesWithin_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEValuePreservesWithin funRel recSelfRel sourceCtx ctx cur + src ambient fuel) : + LowerBorrowValuePreservesWithin funRel recSelfRel sourceCtx ctx cur src + ambient (fuel + 1) := by + intro input output expr sourceEnv sourceFuel sourceValue state finalState + emit av release hsource hrun hextends havailable + cases expr with + | var index => + exact lowerBorrow_var_run_value_sound (sourceEval_var_inv hsource) hrun + | ref address => + exact lowerBorrow_dynamic_run_value_sound_within + (fun hsubrun hwithin => hexpr hsource hsubrun hwithin havailable) + (.ref address) hrun hextends + | app function argument => + exact lowerBorrow_dynamic_run_value_sound_within + (fun hsubrun hwithin => hexpr hsource hsubrun hwithin havailable) + (.app function argument) hrun hextends + | lam uses body => + exact lowerBorrow_dynamic_run_value_sound_within + (fun hsubrun hwithin => hexpr hsource hsubrun hwithin havailable) + (.lam uses body) hrun hextends + | letE uses value body => + exact lowerBorrow_dynamic_run_value_sound_within + (fun hsubrun hwithin => hexpr hsource hsubrun hwithin havailable) + (.letE uses value body) hrun hextends + | proj index source => + exact lowerBorrow_dynamic_run_value_sound_within + (fun hsubrun hwithin => hexpr hsource hsubrun hwithin havailable) + (.proj index source) hrun hextends + | lit literal => + exact lowerBorrow_dynamic_run_value_sound_within + (fun hsubrun hwithin => hexpr hsource hsubrun hwithin havailable) + (.lit literal) hrun hextends + | erased => + exact lowerBorrow_dynamic_run_value_sound_within + (fun hsubrun hwithin => hexpr hsource hsubrun hwithin havailable) + .erased hrun hextends + +/-- Fuel-bounded reachable-state borrow induction step. -/ +theorem lowerBorrowValuePreservesWithinBelow_succ + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEValuePreservesWithinBelow funRel recSelfRel sourceCtx + ctx cur limit src ambient fuel) : + LowerBorrowValuePreservesWithinBelow funRel recSelfRel sourceCtx ctx + cur limit src ambient (fuel + 1) := by + intro input output expr sourceEnv sourceFuel sourceValue state finalState + emit av release hsource hrun hextends havailable + cases expr with + | var index => + exact lowerBorrow_var_run_value_sound_below + (sourceEval_var_inv hsource) hrun + | ref address => + exact lowerBorrow_dynamic_run_value_sound_within_below + (fun hsubrun hwithin => hexpr hsource hsubrun hwithin havailable) + (.ref address) hrun hextends + | app function argument => + exact lowerBorrow_dynamic_run_value_sound_within_below + (fun hsubrun hwithin => hexpr hsource hsubrun hwithin havailable) + (.app function argument) hrun hextends + | lam uses body => + exact lowerBorrow_dynamic_run_value_sound_within_below + (fun hsubrun hwithin => hexpr hsource hsubrun hwithin havailable) + (.lam uses body) hrun hextends + | letE uses value body => + exact lowerBorrow_dynamic_run_value_sound_within_below + (fun hsubrun hwithin => hexpr hsource hsubrun hwithin havailable) + (.letE uses value body) hrun hextends + | proj index source => + exact lowerBorrow_dynamic_run_value_sound_within_below + (fun hsubrun hwithin => hexpr hsource hsubrun hwithin havailable) + (.proj index source) hrun hextends + | lit literal => + exact lowerBorrow_dynamic_run_value_sound_within_below + (fun hsubrun hwithin => hexpr hsource hsubrun hwithin havailable) + (.lit literal) hrun hextends + | erased => + exact lowerBorrow_dynamic_run_value_sound_within_below + (fun hsubrun hwithin => hexpr hsource hsubrun hwithin havailable) + .erased hrun hextends + +/-- Reachable-state semantic `knownCall`. In the excess-tail case, +`applyRest` monotonicity proves that the evaluated prefix also lies inside +the ambient state; the tail itself uses the enclosing suffix witness. -/ +theorem knownCall_run_value_sound_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {build : Array Atom → Op} {argWorlds : List Owned} + {resultWorld buildWorld : Owned} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValuePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hbuild : ∀ {prefixOutput : VEnv} {emitPrefix : Emit} + {prefixAVals : List AVal} {sourceBuilt : IxIR0.Value}, + LowerArgsValueSound funRel recSelfRel ctx cur input prefixOutput + sourceEnv sourceEnv (sourceValues.take count) + (((args.take count).zip (padWorlds argWorlds count)).map Prod.snd) + emitPrefix prefixAVals → + SourceApplies sourceCtx sourceFunction (sourceValues.take count) + sourceBuilt → + prefixAVals.length = + ((args.take count).zip (padWorlds argWorlds count)).length → + LowerResultValueSound funRel recSelfRel ctx cur input + prefixOutput.bump sourceEnv sourceEnv sourceBuilt buildWorld + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth)) + (hterminalWorld : args.length ≤ count → buildWorld = resultWorld) + (hoverWorld : count < args.length → buildWorld = .shared) + (hrun : (knownCall src (fuel + 1) input build count argWorlds + resultWorld args).run state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult resultWorld emit av := by + exact knownCall_run_value_sound_core + (Reach := fun actualState => ExtraExtends actualState ambient) + (PrefixSound := fun prefixOutput emitPrefix prefixAVals => + LowerArgsValueSound funRel recSelfRel ctx cur input prefixOutput + sourceEnv sourceEnv (sourceValues.take count) + (((args.take count).zip + (padWorlds argWorlds count)).map Prod.snd) + emitPrefix prefixAVals ∧ + SelfValueAvailable funRel recSelfRel sourceCtx ctx cur + prefixOutput) + (BuiltSound := fun sourceBuilt prefixOutput emitPrefix prefixAVals => + LowerResultValueSound funRel recSelfRel ctx cur input + prefixOutput.bump sourceEnv sourceEnv sourceBuilt buildWorld + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) ∧ + SelfValueAvailable funRel recSelfRel sourceCtx ctx cur + prefixOutput.bump) + (Result := fun actualResult actualOutput actualEmit actualAv _ => + LowerResultValueSound funRel recSelfRel ctx cur input actualOutput + sourceEnv sourceEnv actualResult resultWorld actualEmit actualAv) + (hprefixBack := by + intro _ _ _ _ hafterPrefix hreach + exact (applyRest_extraExtends hafterPrefix).trans hreach) + (hprefixSound := by + intro _ _ _ _ hprefixSource hprefixRun hreach + exact ⟨hargs hprefixSource hprefixRun hreach havailable, + havailable.lowerArgs hprefixRun⟩) + (hbuild := by + intro _ _ _ _ hprefix hprefixApply hprefixLength + exact ⟨hbuild hprefix.1 hprefixApply hprefixLength, + hprefix.2.bump⟩) + (hterminalFinish := by + intro _ _ _ _ _ hle hbuilt + simpa [hterminalWorld hle] using hbuilt.1) + (hoverFinish := by + intro sourceBuilt prefixOutput emitPrefix prefixAVals _ hover + hbuilt htailApply hafterPrefix hreach + have hbuiltShared : LowerResultValueSound funRel recSelfRel ctx cur + input prefixOutput.bump sourceEnv sourceEnv sourceBuilt .shared + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) := by + simpa [hoverWorld hover] using hbuilt.1 + exact hrest (by simp) (hsourceArgs.drop count) htailApply + hbuiltShared hafterPrefix hreach hbuilt.2) + (hfinalReach := hextends) hsourceArgs hsource hrun + +/-- Fuel-bounded reachable-state semantic `knownCall`. -/ +theorem knownCall_run_value_sound_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {ambient : LowSt} + {fuel count : Nat} {build : Array Atom → Op} + {argWorlds : List Owned} {resultWorld buildWorld : Owned} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValuePreservesWithinBelow funRel recSelfRel sourceCtx + ctx cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hbuild : ∀ {prefixOutput : VEnv} {emitPrefix : Emit} + {prefixAVals : List AVal} {sourceBuilt : IxIR0.Value}, + LowerArgsValueSoundBelow funRel recSelfRel ctx cur limit input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (((args.take count).zip (padWorlds argWorlds count)).map Prod.snd) + emitPrefix prefixAVals → + SourceApplies sourceCtx sourceFunction (sourceValues.take count) + sourceBuilt → + prefixAVals.length = + ((args.take count).zip (padWorlds argWorlds count)).length → + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input + prefixOutput.bump sourceEnv sourceEnv sourceBuilt buildWorld + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth)) + (hterminalWorld : args.length ≤ count → buildWorld = resultWorld) + (hoverWorld : count < args.length → buildWorld = .shared) + (hrun : (knownCall src (fuel + 1) input build count argWorlds + resultWorld args).run state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult resultWorld emit av := by + exact knownCall_run_value_sound_core + (Reach := fun actualState => ExtraExtends actualState ambient) + (PrefixSound := fun prefixOutput emitPrefix prefixAVals => + LowerArgsValueSoundBelow funRel recSelfRel ctx cur limit input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (((args.take count).zip + (padWorlds argWorlds count)).map Prod.snd) + emitPrefix prefixAVals ∧ + SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + prefixOutput) + (BuiltSound := fun sourceBuilt prefixOutput emitPrefix prefixAVals => + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input + prefixOutput.bump sourceEnv sourceEnv sourceBuilt buildWorld + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) ∧ + SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + prefixOutput.bump) + (Result := fun actualResult actualOutput actualEmit actualAv _ => + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input + actualOutput sourceEnv sourceEnv actualResult resultWorld + actualEmit actualAv) + (hprefixBack := by + intro _ _ _ _ hafterPrefix hreach + exact (applyRest_extraExtends hafterPrefix).trans hreach) + (hprefixSound := by + intro _ _ _ _ hprefixSource hprefixRun hreach + exact ⟨hargs hprefixSource hprefixRun hreach havailable, + havailable.lowerArgs hprefixRun⟩) + (hbuild := by + intro _ _ _ _ hprefix hprefixApply hprefixLength + exact ⟨hbuild hprefix.1 hprefixApply hprefixLength, + hprefix.2.bump⟩) + (hterminalFinish := by + intro _ _ _ _ _ hle hbuilt + simpa [hterminalWorld hle] using hbuilt.1) + (hoverFinish := by + intro sourceBuilt prefixOutput emitPrefix prefixAVals _ hover + hbuilt htailApply hafterPrefix hreach + have hbuiltShared : LowerResultValueSoundBelow funRel recSelfRel ctx + cur limit input prefixOutput.bump sourceEnv sourceEnv sourceBuilt + .shared + (emitPrefix ∘ emitOp + (build (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) := by + simpa [hoverWorld hover] using hbuilt.1 + exact hrest (by simp) (hsourceArgs.drop count) htailApply + hbuiltShared hafterPrefix hreach hbuilt.2) + (hfinalReach := hextends) hsourceArgs hsource hrun + +theorem knownCall_call_run_value_sound_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur d : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {argWorlds : List Owned} {resultWorld : Owned} {f : Ixon.Address} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValuePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hworlds : argWorlds.length = count) + (hcount : count ≤ args.length) + (hdecl : ctx.decls f = some (.fn d)) + (hownership : FnOwnershipContract ctx d argWorlds) + (hvalue : FnValueContract funRel sourceCtx ctx d argWorlds + sourceFunction) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hterminalWorld : args.length ≤ count → d.result = resultWorld) + (hoverWorld : count < args.length → d.result = .shared) + (hrun : (knownCall src (fuel + 1) input (.call f ·) count + argWorlds resultWorld args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult resultWorld emit av := by + refine knownCall_run_value_sound_within hargs hrest hsourceArgs hsource + ?_ hterminalWorld hoverWorld hrun hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixSound + hprefixApply _ + have hshape := knownCall_prefix_worlds_eq args argWorlds count + hworlds hcount + have hprefix : LowerArgsValueSound funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + argWorlds emitPrefix prefixAVals := by + simpa only [hshape] using hprefixSound + exact hprefix.call_graph hdecl hownership hvalue hprefixApply + +theorem knownCall_call_run_value_sound_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur d : FnDef} + {limit : Nat} {src : IxIR0.Env} {ambient : LowSt} + {fuel count : Nat} {argWorlds : List Owned} + {resultWorld : Owned} {f : Ixon.Address} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValuePreservesWithinBelow funRel recSelfRel sourceCtx + ctx cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + (hworlds : argWorlds.length = count) + (hcount : count ≤ args.length) + (hdecl : ctx.decls f = some (.fn d)) + (hownership : FnOwnershipContractBelow ctx d argWorlds limit) + (hvalue : FnValueContractBelow funRel sourceCtx ctx d argWorlds + sourceFunction limit) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hterminalWorld : args.length ≤ count → d.result = resultWorld) + (hoverWorld : count < args.length → d.result = .shared) + (hrun : (knownCall src (fuel + 1) input (.call f ·) count + argWorlds resultWorld args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult resultWorld emit av := by + refine knownCall_run_value_sound_within_below hargs hrest hsourceArgs + hsource ?_ hterminalWorld hoverWorld hrun hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixSound + hprefixApply _ + have hshape := knownCall_prefix_worlds_eq args argWorlds count + hworlds hcount + have hprefix : LowerArgsValueSoundBelow funRel recSelfRel ctx cur limit + input prefixOutput sourceEnv sourceEnv (sourceValues.take count) + argWorlds emitPrefix prefixAVals := by + simpa only [hshape] using hprefixSound + exact hprefix.call_graph hdecl hownership hvalue hprefixApply + +theorem knownCall_callSelf_entry_run_value_sound_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count index : Nat} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValuePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hcount : count ≤ args.length) + (hentry : input.entries[index]? = some (.recSelf count)) + (hhead : sourceEnv[index]? = some sourceFunction) + (hownership : FnOwnershipContract ctx cur + (List.replicate count .shared)) + (hvalue : recSelfRel sourceFunction count → + FnValueContract funRel sourceCtx ctx cur + (List.replicate count .shared) sourceFunction) + (hresult : cur.result = .shared) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hrun : (knownCall src (fuel + 1) input (.callSelf ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult .shared emit av := by + refine knownCall_run_value_sound_within hargs hrest hsourceArgs hsource + ?_ (fun _ => by simpa [hresult]) (fun _ => by simpa [hresult]) hrun + hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixSound + hprefixApply _ + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hprefix : LowerArgsValueSound funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate count .shared) emitPrefix prefixAVals := by + simpa only [hshape] using hprefixSound + have hbuilt := hprefix.callSelf_entry_graph hentry hhead hownership + hvalue hprefixApply + simpa [hresult] using hbuilt + +theorem knownCall_callSelf_entry_run_value_sound_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {ambient : LowSt} + {fuel count index : Nat} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValuePreservesWithinBelow funRel recSelfRel sourceCtx + ctx cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + (hcount : count ≤ args.length) + (hentry : input.entries[index]? = some (.recSelf count)) + (hhead : sourceEnv[index]? = some sourceFunction) + (hownership : FnOwnershipContractBelow ctx cur + (List.replicate count .shared) limit) + (hvalue : recSelfRel sourceFunction count → + FnValueContractBelow funRel sourceCtx ctx cur + (List.replicate count .shared) sourceFunction limit) + (hresult : cur.result = .shared) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hrun : (knownCall src (fuel + 1) input (.callSelf ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult .shared emit av := by + refine knownCall_run_value_sound_within_below hargs hrest hsourceArgs + hsource ?_ (fun _ => by simpa [hresult]) + (fun _ => by simpa [hresult]) hrun hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixSound + hprefixApply _ + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hprefix : LowerArgsValueSoundBelow funRel recSelfRel ctx cur limit + input prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate count .shared) emitPrefix prefixAVals := by + simpa only [hshape] using hprefixSound + have hbuilt := hprefix.callSelf_entry_graph hentry hhead hownership + hvalue hprefixApply + simpa [hresult] using hbuilt + +theorem knownCall_alloc_run_value_sound_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {world : Owned} {cid : CtorId} + {sourceAddress : Ixon.Address} {sourceTag : Nat} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValuePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hcount : count ≤ args.length) + (haddress : cid.block = sourceAddress) + (htag : cid.cidx = sourceTag) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hctor : SourceApplies sourceCtx sourceFunction + (sourceValues.take count) + (.ctor sourceAddress sourceTag (sourceValues.take count))) + (hrun : (knownCall src (fuel + 1) input (.alloc world cid ·) count + (List.replicate count world) world args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + refine knownCall_run_value_sound_within hargs hrest hsourceArgs hsource + ?_ (fun _ => rfl) ?_ hrun hextends havailable + · intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixSound + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count world) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count world) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsValueSound funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length world) emitPrefix prefixAVals := by + simpa only [hshape, havsLength] using hprefixSound + have hbuilt := hprefix.alloc_graph haddress htag + rw [hprefixApply.deterministic hctor] + exact hbuilt + · intro hover + exact knownCall_over_run_world_shared hover hrun + +theorem knownCall_alloc_run_value_sound_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {ambient : LowSt} + {fuel count : Nat} {world : Owned} {cid : CtorId} + {sourceAddress : Ixon.Address} {sourceTag : Nat} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValuePreservesWithinBelow funRel recSelfRel sourceCtx + ctx cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + (hcount : count ≤ args.length) + (haddress : cid.block = sourceAddress) + (htag : cid.cidx = sourceTag) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hctor : SourceApplies sourceCtx sourceFunction + (sourceValues.take count) + (.ctor sourceAddress sourceTag (sourceValues.take count))) + (hrun : (knownCall src (fuel + 1) input (.alloc world cid ·) count + (List.replicate count world) world args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult world emit av := by + refine knownCall_run_value_sound_within_below hargs hrest hsourceArgs + hsource ?_ (fun _ => rfl) ?_ hrun hextends havailable + · intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixSound + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count world) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count world) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsValueSoundBelow funRel recSelfRel ctx cur limit + input prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length world) emitPrefix prefixAVals := by + simpa only [hshape, havsLength] using hprefixSound + have hbuilt := hprefix.alloc_graph haddress htag + rw [hprefixApply.deterministic hctor] + exact hbuilt + · intro hover + exact knownCall_over_run_world_shared hover hrun + +theorem knownCall_extern_run_value_sound_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {f : Ixon.Address} {input output : VEnv} {resultWorld : Owned} + {args : List IxIR0.Expr} {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValuePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hcontract : ExternValueContract funRel sourceCtx ctx) + (hcount : count ≤ args.length) + (hlookup : sourceCtx.env f = some (.extern count)) + (href : SourceRefValue sourceCtx f sourceFunction) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hrun : (knownCall src (fuel + 1) input (.extern f ·) count + (List.replicate count .shared) resultWorld args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult resultWorld emit av := by + refine knownCall_run_value_sound_within hargs hrest hsourceArgs hsource + ?_ (fun _ => rfl) ?_ hrun hextends havailable + · intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixSound + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count .shared) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsValueSound funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length .shared) + emitPrefix prefixAVals := by + simpa only [hshape, havsLength] using hprefixSound + have hvalueCount : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hvalueCount] + exact hprefix.extern_graph hcontract hlookup href htakeLength + hprefixApply + · intro hover + exact knownCall_over_run_world_shared hover hrun + +theorem knownCall_extern_run_value_sound_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {ambient : LowSt} + {fuel count : Nat} {f : Ixon.Address} + {input output : VEnv} {resultWorld : Owned} + {args : List IxIR0.Expr} {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValuePreservesWithinBelow funRel recSelfRel sourceCtx + ctx cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + (hcontract : ExternValueContract funRel sourceCtx ctx) + (hcount : count ≤ args.length) + (hlookup : sourceCtx.env f = some (.extern count)) + (href : SourceRefValue sourceCtx f sourceFunction) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hrun : (knownCall src (fuel + 1) input (.extern f ·) count + (List.replicate count .shared) resultWorld args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult resultWorld emit av := by + refine knownCall_run_value_sound_within_below hargs hrest hsourceArgs + hsource ?_ (fun _ => rfl) ?_ hrun hextends havailable + · intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixSound + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count .shared) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsValueSoundBelow funRel recSelfRel ctx cur limit + input prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length .shared) + emitPrefix prefixAVals := by + simpa only [hshape, havsLength] using hprefixSound + have hvalueCount : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hvalueCount] + exact hprefix.extern_graph hcontract hlookup href htakeLength + hprefixApply + · intro hover + exact knownCall_over_run_world_shared hover hrun + +theorem knownCall_papp_run_value_sound_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel count : Nat} + {f : Ixon.Address} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValuePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + (hcount : count ≤ args.length) + (hdecl : ctx.decls f = some d) + (hunder : count < declArity d) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hfun : ∀ {sourceBuilt : IxIR0.Value}, + SourceApplies sourceCtx sourceFunction (sourceValues.take count) + sourceBuilt → + funRel sourceBuilt f (declArity d) (sourceValues.take count)) + (hrun : (knownCall src (fuel + 1) input (.papp f ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult .shared emit av := by + refine knownCall_run_value_sound_within hargs hrest hsourceArgs hsource + ?_ (fun _ => rfl) (fun _ => rfl) hrun hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixSound + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count .shared) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsValueSound funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length .shared) + emitPrefix prefixAVals := by + simpa only [hshape, havsLength] using hprefixSound + apply hprefix.papp_graph hdecl (hfun hprefixApply) + simpa [havsLength] using hunder + +theorem knownCall_papp_run_value_sound_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {ambient : LowSt} + {fuel count : Nat} {f : Ixon.Address} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValuePreservesWithinBelow funRel recSelfRel sourceCtx + ctx cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + (hcount : count ≤ args.length) + (hdecl : ctx.decls f = some d) + (hunder : count < declArity d) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hfun : ∀ {sourceBuilt : IxIR0.Value}, + SourceApplies sourceCtx sourceFunction (sourceValues.take count) + sourceBuilt → + funRel sourceBuilt f (declArity d) (sourceValues.take count)) + (hrun : (knownCall src (fuel + 1) input (.papp f ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult .shared emit av := by + refine knownCall_run_value_sound_within_below hargs hrest hsourceArgs + hsource ?_ (fun _ => rfl) (fun _ => rfl) hrun hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixSound + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate count .shared) count (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate count .shared) count (by simp) hcount + have havsLength : prefixAVals.length = count := + hprefixLength.trans hzipLength + have hprefix : LowerArgsValueSoundBelow funRel recSelfRel ctx cur limit + input prefixOutput sourceEnv sourceEnv (sourceValues.take count) + (List.replicate prefixAVals.length .shared) + emitPrefix prefixAVals := by + simpa only [hshape, havsLength] using hprefixSound + apply hprefix.papp_graph hdecl (hfun hprefixApply) + simpa [havsLength] using hunder + +theorem knownCall_papp_source_run_value_sound_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel count : Nat} + {f : Ixon.Address} {source : IxIR0.Decl} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hcount : count ≤ args.length) + (hsrc : src f = some source) + (heligible : SourcePapEligible source) + (harity : sourceDeclArity source = declArity d) + (href : SourceRefValue sourceCtx f sourceFunction) + (hdecl : ctx.decls f = some d) + (hunder : count < declArity d) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hrun : (knownCall src (fuel + 1) input (.papp f ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSound (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + .shared emit av := by + apply knownCall_papp_run_value_sound_within hargs hrest hcount hdecl + hunder hsourceArgs hsource + · intro sourceBuilt hprefixApply + apply CompilerFunctionRel.source hsrc heligible harity href hprefixApply + have hcountValues : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hcountValues] + simpa [htakeLength] using hunder + · exact hrun + · exact hextends + · exact havailable + +theorem knownCall_papp_source_run_value_sound_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit fuel count : Nat} + {f : Ixon.Address} {source : IxIR0.Decl} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hcount : count ≤ args.length) + (hsrc : src f = some source) + (heligible : SourcePapEligible source) + (harity : sourceDeclArity source = declArity d) + (href : SourceRefValue sourceCtx f sourceFunction) + (hdecl : ctx.decls f = some d) + (hunder : count < declArity d) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hrun : (knownCall src (fuel + 1) input (.papp f ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueSoundBelow (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur limit input output sourceEnv sourceEnv sourceResult + .shared emit av := by + apply knownCall_papp_run_value_sound_within_below hargs hrest hcount + hdecl hunder hsourceArgs hsource + · intro sourceBuilt hprefixApply + apply CompilerFunctionRel.source hsrc heligible harity href hprefixApply + have hcountValues : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hcountValues] + simpa [htakeLength] using hunder + · exact hrun + · exact hextends + · exact havailable + +theorem knownCall_papp_wrapper_run_value_sound_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel count : Nat} + {memo : WrapperMemo} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hcount : count ≤ args.length) + (hmember : memo ∈ ambient.wrappers) + (hsrc : src memo.source = some (.ctor memo.tag memo.arity)) + (href : SourceRefValue sourceCtx memo.source sourceFunction) + (hdecl : ctx.decls memo.wrapper = some d) + (harity : memo.arity = declArity d) + (hunder : count < declArity d) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hrun : (knownCall src (fuel + 1) input (.papp memo.wrapper ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSound (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + .shared emit av := by + apply knownCall_papp_run_value_sound_within hargs hrest hcount hdecl + hunder hsourceArgs hsource + · intro sourceBuilt hprefixApply + rw [← harity] + apply CompilerFunctionRel.wrapper hmember hsrc href hprefixApply + have hcountValues : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hcountValues] + rw [htakeLength] + simpa [harity] using hunder + · exact hrun + · exact hextends + · exact havailable + +theorem knownCall_papp_wrapper_run_value_sound_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit fuel count : Nat} + {memo : WrapperMemo} {d : Decl} + {input output : VEnv} {args : List IxIR0.Expr} + {sourceEnv sourceValues : List IxIR0.Value} + {sourceFunction sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hargs : LowerArgsValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hcount : count ≤ args.length) + (hmember : memo ∈ ambient.wrappers) + (hsrc : src memo.source = some (.ctor memo.tag memo.arity)) + (href : SourceRefValue sourceCtx memo.source sourceFunction) + (hdecl : ctx.decls memo.wrapper = some d) + (harity : memo.arity = declArity d) + (hunder : count < declArity d) + (hsourceArgs : SourceArgsEval sourceCtx sourceEnv args sourceValues) + (hsource : SourceApplies sourceCtx sourceFunction sourceValues + sourceResult) + (hrun : (knownCall src (fuel + 1) input (.papp memo.wrapper ·) count + (List.replicate count .shared) .shared args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueSoundBelow (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur limit input output sourceEnv sourceEnv sourceResult + .shared emit av := by + apply knownCall_papp_run_value_sound_within_below hargs hrest hcount + hdecl hunder hsourceArgs hsource + · intro sourceBuilt hprefixApply + rw [← harity] + apply CompilerFunctionRel.wrapper hmember hsrc href hprefixApply + have hcountValues : count ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take count).length = count := by + simp [List.length_take, hcountValues] + rw [htakeLength] + simpa [harity] using hunder + · exact hrun + · exact hextends + · exact havailable + +theorem lowerSpine_ref_defn_call_run_value_sound_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + (hvalues : SourceDeclValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {input output : VEnv} {world result : Owned} {f : Ixon.Address} + {body : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsrc : src f = some (.defn result body)) + (hcount : lamArity body ≤ args.length) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSound (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + obtain ⟨d, hdecl, harity, hresult, hownership⟩ := hdecls.defn hsrc + have hvalue : FnValueContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + ((lamUses body).map worldOfUses) sourceFunction := by + apply hvalues.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_neg (Nat.not_lt.mpr hcount)] at hrun + obtain ⟨checked, nextState, hrequireRun, hknownRun⟩ := + estateBindRun_ok_inv hrun + cases checked + obtain ⟨hguard, _⟩ := requireResultWorld_run_ok_inv hrequireRun + refine knownCall_call_run_value_sound_within hargs hrest (by simp) + hcount hdecl hownership hvalue hsourceArgs hsourceApply ?_ ?_ + hknownRun hextends havailable + · intro hterminal + have heq : args.length = lamArity body := + Nat.le_antisymm hterminal hcount + simpa [hresult, heq] using hguard + · intro hover + have hne : args.length ≠ lamArity body := Nat.ne_of_gt hover + simpa [hresult, hne] using hguard + +theorem lowerSpine_ref_defn_partial_run_value_sound_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world result : Owned} {f : Ixon.Address} + {body : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsrc : src f = some (.defn result body)) + (hunder : args.length < lamArity body) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSound (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + obtain ⟨d, hdecl, harity, _, _⟩ := hdecls.defn hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (estateThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + cases result with + | unique => + exact (estateThrowRun_not_ok + (by simpa [hsuEq, huuEq] using hrun)).elim + | shared => + cases hp : papSafe body with + | false => + exact (estateThrowRun_not_ok + (by simpa [hsuEq, hp] using hrun)).elim + | true => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq, hp] using hrun + apply knownCall_papp_source_run_value_sound_within hargs hrest + (Nat.le_refl _) hsrc ⟨rfl, hp⟩ + (by simpa [sourceDeclArity, declArity] using harity.symm) + href hdecl (by simpa [declArity, harity] using hunder) + hsourceArgs hsourceApply hknown hextends havailable + +theorem lowerSpine_ref_defn_call_run_value_sound_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit fuel : Nat} + (hargs : LowerArgsValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + (hvalues : SourceDeclValueContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + {input output : VEnv} {world result : Owned} {f : Ixon.Address} + {body : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsrc : src f = some (.defn result body)) + (hcount : lamArity body ≤ args.length) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueSoundBelow (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur limit input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + obtain ⟨d, hdecl, harity, hresult, hownership⟩ := hdecls.defn hsrc + have hvalue : FnValueContractBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + ((lamUses body).map worldOfUses) sourceFunction limit := by + apply hvalues.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_neg (Nat.not_lt.mpr hcount)] at hrun + obtain ⟨checked, nextState, hrequireRun, hknownRun⟩ := + estateBindRun_ok_inv hrun + cases checked + obtain ⟨hguard, _⟩ := requireResultWorld_run_ok_inv hrequireRun + refine knownCall_call_run_value_sound_within_below hargs hrest (by simp) + hcount hdecl (hownership.below limit) hvalue hsourceArgs hsourceApply + ?_ ?_ hknownRun hextends havailable + · intro hterminal + have heq : args.length = lamArity body := + Nat.le_antisymm hterminal hcount + simpa [hresult, heq] using hguard + · intro hover + have hne : args.length ≠ lamArity body := Nat.ne_of_gt hover + simpa [hresult, hne] using hguard + +theorem lowerSpine_ref_defn_partial_run_value_sound_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit fuel : Nat} + (hargs : LowerArgsValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world result : Owned} {f : Ixon.Address} + {body : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsrc : src f = some (.defn result body)) + (hunder : args.length < lamArity body) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueSoundBelow (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur limit input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + obtain ⟨d, hdecl, harity, _, _⟩ := hdecls.defn hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (estateThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + cases result with + | unique => + exact (estateThrowRun_not_ok + (by simpa [hsuEq, huuEq] using hrun)).elim + | shared => + cases hp : papSafe body with + | false => + exact (estateThrowRun_not_ok + (by simpa [hsuEq, hp] using hrun)).elim + | true => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq, hp] using hrun + apply knownCall_papp_source_run_value_sound_within_below hargs hrest + (Nat.le_refl _) hsrc ⟨rfl, hp⟩ + (by simpa [sourceDeclArity, declArity] using harity.symm) + href hdecl (by simpa [declArity, harity] using hunder) + hsourceArgs hsourceApply hknown hextends havailable + +theorem lowerSpine_ref_recursor_call_run_value_sound_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + (hvalues : SourceDeclValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {numArgs : Nat} {natLit : Bool} {rules : Array IxIR0.RecRule} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.recursor numArgs natLit rules)) + (hcount : numArgs + 1 ≤ args.length) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSound (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + obtain ⟨d, hdecl, harity, hresult, hownership⟩ := + hdecls.recursor hsrc + have hvalue : FnValueContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + (List.replicate (numArgs + 1) .shared) sourceFunction := by + apply hvalues.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_neg (Nat.not_lt.mpr hcount)] at hrun + obtain ⟨checked, nextState, hrequireRun, hknownRun⟩ := + estateBindRun_ok_inv hrun + cases checked + obtain ⟨hguard, _⟩ := requireResultWorld_run_ok_inv hrequireRun + refine knownCall_call_run_value_sound_within hargs hrest (by simp) + hcount hdecl hownership hvalue hsourceArgs hsourceApply ?_ ?_ + hknownRun hextends havailable + · intro hterminal + have heq : args.length = numArgs + 1 := + Nat.le_antisymm hterminal hcount + simpa [hresult, heq] using hguard + · intro _ + simpa [hresult] using hguard + +theorem lowerSpine_ref_recursor_partial_run_value_sound_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {numArgs : Nat} {natLit : Bool} {rules : Array IxIR0.RecRule} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.recursor numArgs natLit rules)) + (hunder : args.length < numArgs + 1) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSound (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + obtain ⟨d, hdecl, harity, _, _⟩ := hdecls.recursor hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (estateThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + apply knownCall_papp_source_run_value_sound_within hargs hrest + (Nat.le_refl _) hsrc (by simp [SourcePapEligible]) + (by simpa [sourceDeclArity, declArity] using harity.symm) + href hdecl (by simpa [declArity, harity] using hunder) + hsourceArgs hsourceApply hknown hextends havailable + +theorem lowerSpine_ref_recursor_call_run_value_sound_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit fuel : Nat} + (hargs : LowerArgsValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + (hvalues : SourceDeclValueContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {numArgs : Nat} {natLit : Bool} {rules : Array IxIR0.RecRule} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.recursor numArgs natLit rules)) + (hcount : numArgs + 1 ≤ args.length) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueSoundBelow (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur limit input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + obtain ⟨d, hdecl, harity, hresult, hownership⟩ := + hdecls.recursor hsrc + have hvalue : FnValueContractBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + (List.replicate (numArgs + 1) .shared) sourceFunction limit := by + apply hvalues.fnContract hsrc (by rfl) hdecl href + simpa using harity.symm + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_neg (Nat.not_lt.mpr hcount)] at hrun + obtain ⟨checked, nextState, hrequireRun, hknownRun⟩ := + estateBindRun_ok_inv hrun + cases checked + obtain ⟨hguard, _⟩ := requireResultWorld_run_ok_inv hrequireRun + refine knownCall_call_run_value_sound_within_below hargs hrest (by simp) + hcount hdecl (hownership.below limit) hvalue hsourceArgs hsourceApply + ?_ ?_ hknownRun hextends havailable + · intro hterminal + have heq : args.length = numArgs + 1 := + Nat.le_antisymm hterminal hcount + simpa [hresult, heq] using hguard + · intro _ + simpa [hresult] using hguard + +theorem lowerSpine_ref_recursor_partial_run_value_sound_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit fuel : Nat} + (hargs : LowerArgsValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {numArgs : Nat} {natLit : Bool} {rules : Array IxIR0.RecRule} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hsrc : src f = some (.recursor numArgs natLit rules)) + (hunder : args.length < numArgs + 1) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueSoundBelow (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur limit input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + obtain ⟨d, hdecl, harity, _, _⟩ := hdecls.recursor hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (estateThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + apply knownCall_papp_source_run_value_sound_within_below hargs hrest + (Nat.le_refl _) hsrc (by simp [SourcePapEligible]) + (by simpa [sourceDeclArity, declArity] using harity.symm) + href hdecl (by simpa [declArity, harity] using hunder) + hsourceArgs hsourceApply hknown hextends havailable + +theorem lowerSpine_ref_ctor_alloc_run_value_sound_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {tag arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hlookup : sourceCtx.env f = some (.ctor tag arity)) + (hsrc : src f = some (.ctor tag arity)) + (hcount : arity ≤ args.length) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSound (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + have hvalueCount : arity ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take arity).length = arity := by + simp [List.length_take, hvalueCount] + have hctor : SourceApplies sourceCtx sourceFunction + (sourceValues.take arity) + (.ctor f tag (sourceValues.take arity)) := + sourceCtorRef_saturates hlookup href htakeLength + have hknown : + (knownCall src (fuel + 1) input + (.alloc world (ctorIdOf f tag) ·) arity + (List.replicate arity world) world args).run state = + .ok (output, emit, av) finalState := by + simpa [lowerSpine, hsrc, Nat.not_lt.mpr hcount] using hrun + exact knownCall_alloc_run_value_sound_within hargs hrest hcount rfl rfl + hsourceArgs hsourceApply hctor hknown hextends havailable + +theorem lowerSpine_ref_ctor_partial_run_value_sound_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (hargs : LowerArgsValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {tag arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} + (hsrc : src f = some (.ctor tag arity)) + (hunder : args.length < arity) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfValueAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSound (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (estateThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hrun' : + ((wrapperFor f tag arity) >>= fun wrapper => + knownCall src (fuel + 1) input (.papp wrapper ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + obtain ⟨wrapper, wrapperState, hwrapperRun, hknownRun⟩ := + estateBindRun_ok_inv hrun' + let memo : WrapperMemo := ⟨f, tag, arity, wrapper⟩ + have hmemoFinal : memo ∈ finalState.wrappers := + (hknownExtra input (.papp wrapper ·) args.length + (List.replicate args.length .shared) .shared args + hknownRun).wrapper_mem (wrapperFor_memo_mem hwrapperRun) + have hmemo : memo ∈ ambient.wrappers := + hextends.wrapper_mem hmemoFinal + have hdecl := hrepresented.wrapper hmemo + apply knownCall_papp_wrapper_run_value_sound_within hargs hrest + (Nat.le_refl _) hmemo hsrc href hdecl + (by simp [memo, ctorWrapperDecl, declArity]) + (by simpa [memo, ctorWrapperDecl, declArity] using hunder) + hsourceArgs hsourceApply hknownRun hextends havailable + +theorem lowerSpine_ref_ctor_alloc_run_value_sound_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit fuel : Nat} + (hargs : LowerArgsValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {tag arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hlookup : sourceCtx.env f = some (.ctor tag arity)) + (hsrc : src f = some (.ctor tag arity)) + (hcount : arity ≤ args.length) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueSoundBelow (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur limit input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + have hvalueCount : arity ≤ sourceValues.length := by + simpa [← hsourceArgs.lengths] using hcount + have htakeLength : (sourceValues.take arity).length = arity := by + simp [List.length_take, hvalueCount] + have hctor : SourceApplies sourceCtx sourceFunction + (sourceValues.take arity) + (.ctor f tag (sourceValues.take arity)) := + sourceCtorRef_saturates hlookup href htakeLength + have hknown : + (knownCall src (fuel + 1) input + (.alloc world (ctorIdOf f tag) ·) arity + (List.replicate arity world) world args).run state = + .ok (output, emit, av) finalState := by + simpa [lowerSpine, hsrc, Nat.not_lt.mpr hcount] using hrun + exact knownCall_alloc_run_value_sound_within_below hargs hrest hcount + rfl rfl hsourceArgs hsourceApply hctor hknown hextends havailable + +theorem lowerSpine_ref_ctor_partial_run_value_sound_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit fuel : Nat} + {state finalState : LowSt} + (hargs : LowerArgsValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {tag arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} + (hsrc : src f = some (.ctor tag arity)) + (hunder : args.length < arity) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfValueAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueSoundBelow (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur limit input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (estateThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hrun' : + ((wrapperFor f tag arity) >>= fun wrapper => + knownCall src (fuel + 1) input (.papp wrapper ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + obtain ⟨wrapper, wrapperState, hwrapperRun, hknownRun⟩ := + estateBindRun_ok_inv hrun' + let memo : WrapperMemo := ⟨f, tag, arity, wrapper⟩ + have hmemoFinal : memo ∈ finalState.wrappers := + (hknownExtra input (.papp wrapper ·) args.length + (List.replicate args.length .shared) .shared args + hknownRun).wrapper_mem (wrapperFor_memo_mem hwrapperRun) + have hmemo : memo ∈ ambient.wrappers := + hextends.wrapper_mem hmemoFinal + have hdecl := hrepresented.wrapper hmemo + apply knownCall_papp_wrapper_run_value_sound_within_below hargs hrest + (Nat.le_refl _) hmemo hsrc href hdecl + (by simp [memo, ctorWrapperDecl, declArity]) + (by simpa [memo, ctorWrapperDecl, declArity] using hunder) + hsourceArgs hsourceApply hknownRun hextends havailable + +theorem lowerSpine_ref_extern_call_run_value_sound_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hcontract : ExternValueContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hlookup : sourceCtx.env f = some (.extern arity)) + (hsrc : src f = some (.extern arity)) + (hcount : arity ≤ args.length) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSound (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + have hknown : + (knownCall src (fuel + 1) input (.extern f ·) arity + (List.replicate arity .shared) world args).run state = + .ok (output, emit, av) finalState := by + simpa [lowerSpine, hsrc, Nat.not_lt.mpr hcount] using hrun + exact knownCall_extern_run_value_sound_within hargs hrest hcontract + hcount hlookup href hsourceArgs hsourceApply hknown hextends havailable + +theorem lowerSpine_ref_extern_partial_run_value_sound_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsrc : src f = some (.extern arity)) + (hunder : args.length < arity) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSound (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + have hdecl := hdecls.extern hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (estateThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + apply knownCall_papp_source_run_value_sound_within hargs hrest + (Nat.le_refl _) hsrc (by simp [SourcePapEligible]) (by rfl) href hdecl + (by simpa [declArity] using hunder) + hsourceArgs hsourceApply hknown hextends havailable + +theorem lowerSpine_ref_extern_call_run_value_sound_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit fuel : Nat} + (hargs : LowerArgsValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hcontract : ExternValueContract + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hlookup : sourceCtx.env f = some (.extern arity)) + (hsrc : src f = some (.extern arity)) + (hcount : arity ≤ args.length) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueSoundBelow (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur limit input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + have hknown : + (knownCall src (fuel + 1) input (.extern f ·) arity + (List.replicate arity .shared) world args).run state = + .ok (output, emit, av) finalState := by + simpa [lowerSpine, hsrc, Nat.not_lt.mpr hcount] using hrun + exact knownCall_extern_run_value_sound_within_below hargs hrest + hcontract hcount hlookup href hsourceArgs hsourceApply hknown hextends + havailable + +theorem lowerSpine_ref_extern_partial_run_value_sound_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit fuel : Nat} + (hargs : LowerArgsValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hdecls : SourceDeclContracts src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {arity : Nat} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hsrc : src f = some (.extern arity)) + (hunder : args.length < arity) + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueSoundBelow (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur limit input output sourceEnv sourceEnv sourceResult + world emit av := by + obtain ⟨sourceFunction, sourceValues, href, hsourceArgs, + hsourceApply⟩ := hsource.refData + have hdecl := hdecls.extern hsrc + simp only [lowerSpine] at hrun + rw [hsrc] at hrun + simp only at hrun + rw [if_pos hunder] at hrun + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases world with + | unique => + exact (estateThrowRun_not_ok (by simpa [huuEq] using hrun)).elim + | shared => + have hknown : + (knownCall src (fuel + 1) input (.papp f ·) args.length + (List.replicate args.length .shared) .shared args).run state = + .ok (output, emit, av) finalState := by + simpa [hsuEq] using hrun + apply knownCall_papp_source_run_value_sound_within_below hargs hrest + (Nat.le_refl _) hsrc (by simp [SourcePapEligible]) (by rfl) href hdecl + (by simpa [declArity] using hunder) + hsourceArgs hsourceApply hknown hextends havailable + +/-- Complete reachable-state static-reference dispatch. Wrapper and lifted +provenance are interpreted in the ambient whole-pass state while all +recursive argument/tail runs are justified by their suffix witnesses. -/ +theorem lowerSpine_ref_run_value_sound_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hargs : LowerArgsValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfValueAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSound (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + exact lowerSpine_ref_run_core + (Result := LowerResultValueSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur input + output sourceEnv sourceEnv sourceResult world emit av) + (hdefnPartial := by + intro _ _ hsrc hunder + exact lowerSpine_ref_defn_partial_run_value_sound_within + hargs hrest hcontracts.decls hsrc hunder hsource hrun hextends + havailable) + (hdefnCall := by + intro _ _ hsrc hcount + exact lowerSpine_ref_defn_call_run_value_sound_within + hargs hrest hcontracts.decls hvalues.decls hsrc hcount hsource hrun + hextends havailable) + (hctorPartial := by + intro _ _ hsrc hunder + exact lowerSpine_ref_ctor_partial_run_value_sound_within + hargs hrest hknownExtra hsrc hunder hsource hrun hextends + hrepresented havailable) + (hctorAlloc := by + intro tag arity hsrc hcount + have hlookup : sourceCtx.env f = some (.ctor tag arity) := by + rw [henv] + exact hsrc + exact lowerSpine_ref_ctor_alloc_run_value_sound_within + hargs hrest hlookup hsrc hcount hsource hrun hextends havailable) + (hrecursorPartial := by + intro _ _ _ hsrc hunder + exact lowerSpine_ref_recursor_partial_run_value_sound_within + hargs hrest hcontracts.decls hsrc hunder hsource hrun hextends + havailable) + (hrecursorCall := by + intro _ _ _ hsrc hcount + exact lowerSpine_ref_recursor_call_run_value_sound_within + hargs hrest hcontracts.decls hvalues.decls hsrc hcount hsource hrun + hextends havailable) + (hexternPartial := by + intro _ hsrc hunder + exact lowerSpine_ref_extern_partial_run_value_sound_within + hargs hrest hcontracts.decls hsrc hunder hsource hrun hextends + havailable) + (hexternCall := by + intro arity hsrc hcount + have hlookup : sourceCtx.env f = some (.extern arity) := by + rw [henv] + exact hsrc + exact lowerSpine_ref_extern_call_run_value_sound_within + hargs hrest hvalues.extern hlookup hsrc hcount hsource hrun + hextends havailable) + hrun + +/-- Fuel-bounded reachable-state static-reference dispatch. -/ +theorem lowerSpine_ref_run_value_sound_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hargs : LowerArgsValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + (hsource : SourceSpineEval sourceCtx sourceEnv (.ref f) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.ref f) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfValueAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueSoundBelow (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur limit input output sourceEnv sourceEnv sourceResult + world emit av := by + exact lowerSpine_ref_run_core + (Result := LowerResultValueSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur limit + input output sourceEnv sourceEnv sourceResult world emit av) + (hdefnPartial := by + intro _ _ hsrc hunder + exact lowerSpine_ref_defn_partial_run_value_sound_within_below + hargs hrest hcontracts.decls hsrc hunder hsource hrun hextends + havailable) + (hdefnCall := by + intro _ _ hsrc hcount + exact lowerSpine_ref_defn_call_run_value_sound_within_below + hargs hrest hcontracts.decls hvalues.decls hsrc hcount hsource hrun + hextends havailable) + (hctorPartial := by + intro _ _ hsrc hunder + exact lowerSpine_ref_ctor_partial_run_value_sound_within_below + hargs hrest hknownExtra hsrc hunder hsource hrun hextends + hrepresented havailable) + (hctorAlloc := by + intro tag arity hsrc hcount + have hlookup : sourceCtx.env f = some (.ctor tag arity) := by + rw [henv] + exact hsrc + exact lowerSpine_ref_ctor_alloc_run_value_sound_within_below + hargs hrest hlookup hsrc hcount hsource hrun hextends havailable) + (hrecursorPartial := by + intro _ _ _ hsrc hunder + exact lowerSpine_ref_recursor_partial_run_value_sound_within_below + hargs hrest hcontracts.decls hsrc hunder hsource hrun hextends + havailable) + (hrecursorCall := by + intro _ _ _ hsrc hcount + exact lowerSpine_ref_recursor_call_run_value_sound_within_below + hargs hrest hcontracts.decls hvalues.decls hsrc hcount hsource hrun + hextends havailable) + (hexternPartial := by + intro _ hsrc hunder + exact lowerSpine_ref_extern_partial_run_value_sound_within_below + hargs hrest hcontracts.decls hsrc hunder hsource hrun hextends + havailable) + (hexternCall := by + intro arity hsrc hcount + have hlookup : sourceCtx.env f = some (.extern arity) := by + rw [henv] + exact hsrc + exact lowerSpine_ref_extern_call_run_value_sound_within_below + hargs hrest hvalues.extern hlookup hsrc hcount hsource hrun + hextends havailable) + hrun + +/-- Unbounded ownership wrapper for a malformed recursive-self arity. -/ +theorem LowerArgsSound.callSelf_arity_mismatch + {ctx : Ctx} {cur : FnDef} + {input output : VEnv} {worlds : List Owned} + {emit : Emit} {avs : List AVal} + (hargs : LowerArgsSound ctx cur input output worlds emit avs) + (harity : avs.length ≠ cur.arity) : + LowerResultSound ctx cur input output.bump cur.result + (emit ∘ emitOp + (.callSelf (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine ⟨.slot, ?_⟩ + intro rest slots + apply EmitSound.comp (hargs.emits rest slots) + apply OpSound.emit + intro fuel store env store' result hpre hrun + obtain ⟨⟨envRoots, values, houtput, havs, hown⟩, hslots⟩ := hpre + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [havs.resolveAtoms] at hrun + have hvaluesLength : values.length = avs.length := + havs.lengths.2.symm + have hne : values.length ≠ cur.arity := by + intro heq + exact harity (hvaluesLength.symm.trans heq) + change (if (values.length != cur.arity) = true then + .error (.stuck "callSelf arity mismatch") + else + (do + let out ← runCode ctx fuel cur store values.reverse cur.body + checkResultWorld cur.result out)) = + .ok (store', result) at hrun + have hbne : (values.length != cur.arity) = true := by + simp [hne] + rw [if_pos hbne] at hrun + contradiction + +/-- Semantic wrapper for a malformed recursive-self arity. The emitted +target operation is stuck before entering the current function, so its graph +postcondition is vacuous while the ownership transformer remains exact. -/ +theorem LowerArgsValueSound.callSelf_arity_mismatch_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} + {input output : VEnv} + {sourceInput sourceOutput sourceResult : List IxIR0.Value} + {sourceValue : IxIR0.Value} {worlds : List Owned} + {emit : Emit} {avs : List AVal} + (hargs : LowerArgsValueSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceResult worlds emit avs) + (harity : avs.length ≠ cur.arity) : + LowerResultValueSound funRel recSelfRel ctx cur input output.bump + sourceInput sourceOutput sourceValue cur.result + (emit ∘ emitOp + (.callSelf (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultSound := + hargs.toLowerArgsSound.callSelf_arity_mismatch harity + graphEmits := ?_ } + intro sourceRest rest slots + apply EmitSound.comp (hargs.graphEmits sourceRest rest slots) + apply OpSound.emit + intro fuel store env store' result hpre hrun + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [havs.resolveAtoms] at hrun + have hvaluesLength : values.length = avs.length := + havs.lengths.2.symm + have hne : values.length ≠ cur.arity := by + intro heq + exact harity (hvaluesLength.symm.trans heq) + change (if (values.length != cur.arity) = true then + .error (.stuck "callSelf arity mismatch") + else + (do + let out ← runCode ctx fuel cur store values.reverse cur.body + checkResultWorld cur.result out)) = + .ok (store', result) at hrun + have hbne : (values.length != cur.arity) = true := by + simp [hne] + rw [if_pos hbne] at hrun + contradiction + +theorem LowerArgsValueSoundBelow.callSelf_arity_mismatch_graph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} + {sourceInput sourceOutput sourceResult : List IxIR0.Value} + {sourceValue : IxIR0.Value} {worlds : List Owned} + {emit : Emit} {avs : List AVal} + (hargs : LowerArgsValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceResult worlds emit avs) + (harity : avs.length ≠ cur.arity) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input + output.bump sourceInput sourceOutput sourceValue cur.result + (emit ∘ emitOp + (.callSelf (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + refine + { toLowerResultSoundBelow := + hargs.toLowerArgsSoundBelow.callSelf_arity_mismatch harity + graphEmits := ?_ } + intro sourceRest rest slots + apply EmitSoundBelow.comp (hargs.graphEmits sourceRest rest slots) + apply OpSoundBelow.emit + intro fuel store env store' result _ hpre hrun + obtain ⟨⟨envRoots, values, houtput, havs, hvalueGraphs, + hrestGraph, hown⟩, hslots⟩ := hpre + cases fuel with + | zero => simp [runOp] at hrun + | succ fuel => + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [havs.resolveAtoms] at hrun + have hvaluesLength : values.length = avs.length := + havs.lengths.2.symm + have hne : values.length ≠ cur.arity := by + intro heq + exact harity (hvaluesLength.symm.trans heq) + change (if (values.length != cur.arity) = true then + .error (.stuck "callSelf arity mismatch") + else + (do + let out ← runCode ctx fuel cur store values.reverse cur.body + checkResultWorld cur.result out)) = + .ok (store', result) at hrun + have hbne : (values.length != cur.arity) = true := by + simp [hne] + rw [if_pos hbne] at hrun + contradiction + +/-- Reachable-state recursive-self spine. A malformed advertised arity is +covered by the stuck-operation rule; the matching case consumes the current +function's semantic contract. -/ +theorem lowerSpine_recSelf_run_value_sound_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {ctx : Ctx} {cur : FnDef} {fuel : Nat} + (hargs : LowerArgsValuePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithin funRel recSelfRel + sourceCtx ctx cur src ambient fuel) + {input output : VEnv} {world : Owned} {index arity : Nat} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hentry : input.entries[index]? = some (.recSelf arity)) + (hself : CurrentSelfValueContract funRel recSelfRel sourceCtx ctx cur) + (hsource : SourceSpineEval sourceCtx sourceEnv (.var index) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.var index) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + apply hsource.eliminate + · intro sourceFunction sourceValues hhead hsourceArgs hsourceApply + obtain ⟨sourceFuel, hhead⟩ := hhead + have hsourceHead : sourceEnv[index]? = some sourceFunction := + sourceEval_var_inv hhead + simp only [lowerSpine] at hrun + rw [hentry] at hrun + simp only at hrun + by_cases hunder : args.length < arity + · rw [if_pos hunder] at hrun + exact (estateThrowRun_not_ok hrun).elim + · rw [if_neg hunder] at hrun + have hcount : arity ≤ args.length := Nat.le_of_not_gt hunder + cases world with + | unique => + have hrequire : + (requireResultWorld .shared .unique).run state = + .error "call result is shared at unique demand" state := by + rfl + rw [estateBindRun, hrequire] at hrun + contradiction + | shared => + have hrequire : + (requireResultWorld .shared .shared).run state = .ok () state := by + rfl + rw [estateBindRun, hrequire] at hrun + simp only at hrun + refine knownCall_run_value_sound_within + (build := .callSelf) (count := arity) + (argWorlds := List.replicate arity .shared) + (resultWorld := .shared) (buildWorld := .shared) + hargs hrest hsourceArgs hsourceApply ?_ (fun _ => rfl) + (fun _ => rfl) hrun hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixSound + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate arity .shared) arity (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate arity .shared) arity (by simp) hcount + have havsLength : prefixAVals.length = arity := + hprefixLength.trans hzipLength + have hprefix : LowerArgsValueSound funRel recSelfRel ctx cur input + prefixOutput sourceEnv sourceEnv (sourceValues.take arity) + (List.replicate arity .shared) emitPrefix prefixAVals := by + simpa only [hshape] using hprefixSound + by_cases harity : arity = cur.arity + · have hownership : FnOwnershipContract ctx cur + (List.replicate arity .shared) := by + simpa [harity] using hself.ownership + have hvalue : recSelfRel sourceFunction arity → + FnValueContract funRel sourceCtx ctx cur + (List.replicate arity .shared) sourceFunction := by + intro hrel + simpa [harity] using hself.value (by simpa [harity] using hrel) + have hbuilt := hprefix.callSelf_entry_graph hentry hsourceHead + hownership hvalue hprefixApply + simpa [hself.result] using hbuilt + · have hmismatch : prefixAVals.length ≠ cur.arity := by + intro heq + exact harity (havsLength.symm.trans heq) + simpa [hself.result] using + hprefix.callSelf_arity_mismatch_graph + (sourceValue := sourceBuilt) hmismatch + +theorem lowerSpine_recSelf_run_value_sound_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {ctx : Ctx} {cur : FnDef} + {limit fuel : Nat} + (hargs : LowerArgsValuePreservesWithinBelow funRel recSelfRel sourceCtx + ctx cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + {input output : VEnv} {world : Owned} {index arity : Nat} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hentry : input.entries[index]? = some (.recSelf arity)) + (hself : CurrentSelfValueContractBelow funRel recSelfRel sourceCtx ctx + cur limit) + (hsource : SourceSpineEval sourceCtx sourceEnv (.var index) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.var index) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult world emit av := by + apply hsource.eliminate + · intro sourceFunction sourceValues hhead hsourceArgs hsourceApply + obtain ⟨sourceFuel, hhead⟩ := hhead + have hsourceHead : sourceEnv[index]? = some sourceFunction := + sourceEval_var_inv hhead + simp only [lowerSpine] at hrun + rw [hentry] at hrun + simp only at hrun + by_cases hunder : args.length < arity + · rw [if_pos hunder] at hrun + exact (estateThrowRun_not_ok hrun).elim + · rw [if_neg hunder] at hrun + have hcount : arity ≤ args.length := Nat.le_of_not_gt hunder + cases world with + | unique => + have hrequire : + (requireResultWorld .shared .unique).run state = + .error "call result is shared at unique demand" state := by + rfl + rw [estateBindRun, hrequire] at hrun + contradiction + | shared => + have hrequire : + (requireResultWorld .shared .shared).run state = + .ok () state := by + rfl + rw [estateBindRun, hrequire] at hrun + simp only at hrun + refine knownCall_run_value_sound_within_below + (build := .callSelf) (count := arity) + (argWorlds := List.replicate arity .shared) + (resultWorld := .shared) (buildWorld := .shared) + hargs hrest hsourceArgs hsourceApply ?_ (fun _ => rfl) + (fun _ => rfl) hrun hextends havailable + intro prefixOutput emitPrefix prefixAVals sourceBuilt hprefixSound + hprefixApply hprefixLength + have hshape := knownCall_prefix_worlds_eq args + (List.replicate arity .shared) arity (by simp) hcount + have hzipLength := knownCall_prefix_length_eq args + (List.replicate arity .shared) arity (by simp) hcount + have havsLength : prefixAVals.length = arity := + hprefixLength.trans hzipLength + have hprefix : LowerArgsValueSoundBelow funRel recSelfRel ctx cur + limit input prefixOutput sourceEnv sourceEnv + (sourceValues.take arity) (List.replicate arity .shared) + emitPrefix prefixAVals := by + simpa only [hshape] using hprefixSound + by_cases harity : arity = cur.arity + · have hownership : FnOwnershipContractBelow ctx cur + (List.replicate arity .shared) limit := by + simpa [harity] using hself.ownership + have hvalue : recSelfRel sourceFunction arity → + FnValueContractBelow funRel sourceCtx ctx cur + (List.replicate arity .shared) sourceFunction limit := by + intro hrel + simpa [harity] using hself.value (by simpa [harity] using hrel) + have hbuilt := hprefix.callSelf_entry_graph hentry hsourceHead + hownership hvalue hprefixApply + simpa [hself.result] using hbuilt + · have hmismatch : prefixAVals.length ≠ cur.arity := by + intro heq + exact harity (havsLength.symm.trans heq) + simpa [hself.result] using + hprefix.callSelf_arity_mismatch_graph + (sourceValue := sourceBuilt) hmismatch + +theorem lowerSpine_erased_run_value_sound_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hargs : LowerArgsValuePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + {input output : VEnv} {world : Owned} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hsource : SourceSpineEval sourceCtx sourceEnv .erased args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world .erased args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + exact lowerSpine_erased_run_value_sound_core + (Result := fun actualResult => + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv actualResult world emit av) + (hfinish := by + intro sourceArgs hsourceArgs hrestRun + exact applyRest_erased_run_value_sound_within hargs hsourceArgs + (lower_erased_value_sound (funRel := funRel) + (recSelfRel := recSelfRel) (ctx := ctx) (cur := cur) + (sourceEnv := sourceEnv) (world := .shared)) + hrestRun hextends havailable) + hsource hrun + +theorem lowerSpine_erased_run_value_sound_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hargs : LowerArgsValuePreservesWithinBelow funRel recSelfRel sourceCtx + ctx cur limit src ambient fuel) + {input output : VEnv} {world : Owned} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hsource : SourceSpineEval sourceCtx sourceEnv .erased args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world .erased args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult world emit av := by + exact lowerSpine_erased_run_value_sound_core + (Result := fun actualResult => + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input + output sourceEnv sourceEnv actualResult world emit av) + (hfinish := by + intro sourceArgs hsourceArgs hrestRun + exact applyRest_erased_run_value_sound_within_below hargs + hsourceArgs + (lower_erased_value_sound_below (funRel := funRel) + (recSelfRel := recSelfRel) (ctx := ctx) (cur := cur) + (limit := limit) (sourceEnv := sourceEnv) (world := .shared)) + hrestRun hextends havailable) + hsource hrun + +theorem lowerSpine_dynamic_run_value_sound_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEValuePreservesWithin funRel recSelfRel sourceCtx ctx cur + src ambient (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsValuePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithin funRel recSelfRel + sourceCtx ctx cur src ambient (fuel + 1)) + {input output : VEnv} {world : Owned} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hshape : DynamicSpineHead head) + (hsource : SourceSpineEval sourceCtx sourceEnv head args sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world head args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + exact lowerSpine_apply_run_value_sound_core + (HeadSound := fun sourceFunction functionOutput emitFunction function + _ => + LowerResultValueSound funRel recSelfRel ctx cur input functionOutput + sourceEnv sourceEnv sourceFunction .shared emitFunction function ∧ + SelfValueAvailable funRel recSelfRel sourceCtx ctx cur + functionOutput) + (Result := fun actualResult => + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv actualResult world emit av) + (hheadSound := by + intro _ _ _ _ _ _ hhead hfunctionRun hrestRun + exact ⟨hexpr hhead hfunctionRun + ((applyRest_extraExtends hrestRun).trans hextends) havailable, + havailable.lowerE hfunctionRun⟩) + (hreflect := hreflect) + (herasedFinish := by + intro _ _ _ _ hsourceArgs hfunctionSound hrestRun + exact applyRest_erased_run_value_sound_within hargs hsourceArgs + hfunctionSound.1 hrestRun hextends hfunctionSound.2) + (hnonErasedFinish := by + intro _ _ _ _ _ _ hfunctionNe hsourceArgs hsourceApply + hfunctionSound hrestRun + exact hrest hfunctionNe hsourceArgs hsourceApply hfunctionSound.1 + hrestRun hextends hfunctionSound.2) + hsource (lowerSpine_dynamic_run_inv hshape hrun) + +theorem lowerSpine_dynamic_run_value_sound_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEValuePreservesWithinBelow funRel recSelfRel sourceCtx + ctx cur limit src ambient (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsValuePreservesWithinBelow funRel recSelfRel sourceCtx + ctx cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient (fuel + 1)) + {input output : VEnv} {world : Owned} + {head : IxIR0.Expr} {args : List IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceResult : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hshape : DynamicSpineHead head) + (hsource : SourceSpineEval sourceCtx sourceEnv head args sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world head args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult world emit av := by + exact lowerSpine_apply_run_value_sound_core + (HeadSound := fun sourceFunction functionOutput emitFunction function + _ => + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input + functionOutput sourceEnv sourceEnv sourceFunction .shared + emitFunction function ∧ + SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + functionOutput) + (Result := fun actualResult => + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input + output sourceEnv sourceEnv actualResult world emit av) + (hheadSound := by + intro _ _ _ _ _ _ hhead hfunctionRun hrestRun + exact ⟨hexpr hhead hfunctionRun + ((applyRest_extraExtends hrestRun).trans hextends) havailable, + havailable.lowerE hfunctionRun⟩) + (hreflect := hreflect) + (herasedFinish := by + intro _ _ _ _ hsourceArgs hfunctionSound hrestRun + exact applyRest_erased_run_value_sound_within_below hargs + hsourceArgs hfunctionSound.1 hrestRun hextends hfunctionSound.2) + (hnonErasedFinish := by + intro _ _ _ _ _ _ hfunctionNe hsourceArgs hsourceApply + hfunctionSound hrestRun + exact hrest hfunctionNe hsourceArgs hsourceApply hfunctionSound.1 + hrestRun hextends hfunctionSound.2) + hsource (lowerSpine_dynamic_run_inv hshape hrun) + +theorem lowerSpine_var_dynamic_run_value_sound_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEValuePreservesWithin funRel recSelfRel sourceCtx ctx cur + src ambient (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsValuePreservesWithin funRel recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithin funRel recSelfRel + sourceCtx ctx cur src ambient (fuel + 1)) + {input output : VEnv} {world : Owned} {index : Nat} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hnotSelf : ∀ arity, + input.entries[index]? ≠ some (.recSelf arity)) + (hsource : SourceSpineEval sourceCtx sourceEnv (.var index) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.var index) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceResult world emit av := by + exact lowerSpine_apply_run_value_sound_core + (HeadSound := fun sourceFunction functionOutput emitFunction function + _ => + LowerResultValueSound funRel recSelfRel ctx cur input functionOutput + sourceEnv sourceEnv sourceFunction .shared emitFunction function ∧ + SelfValueAvailable funRel recSelfRel sourceCtx ctx cur + functionOutput) + (Result := fun actualResult => + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv actualResult world emit av) + (hheadSound := by + intro _ _ _ _ _ _ hhead hfunctionRun hrestRun + exact ⟨hexpr hhead hfunctionRun + ((applyRest_extraExtends hrestRun).trans hextends) havailable, + havailable.lowerE hfunctionRun⟩) + (hreflect := hreflect) + (herasedFinish := by + intro _ _ _ _ hsourceArgs hfunctionSound hrestRun + exact applyRest_erased_run_value_sound_within hargs hsourceArgs + hfunctionSound.1 hrestRun hextends hfunctionSound.2) + (hnonErasedFinish := by + intro _ _ _ _ _ _ hfunctionNe hsourceArgs hsourceApply + hfunctionSound hrestRun + exact hrest hfunctionNe hsourceArgs hsourceApply hfunctionSound.1 + hrestRun hextends hfunctionSound.2) + hsource (lowerSpine_var_dynamic_run_inv hnotSelf hrun) + +theorem lowerSpine_var_dynamic_run_value_sound_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEValuePreservesWithinBelow funRel recSelfRel sourceCtx + ctx cur limit src ambient (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsValuePreservesWithinBelow funRel recSelfRel sourceCtx + ctx cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient (fuel + 1)) + {input output : VEnv} {world : Owned} {index : Nat} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hnotSelf : ∀ arity, + input.entries[index]? ≠ some (.recSelf arity)) + (hsource : SourceSpineEval sourceCtx sourceEnv (.var index) args + sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world (.var index) args).run + state = .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceResult world emit av := by + exact lowerSpine_apply_run_value_sound_core + (HeadSound := fun sourceFunction functionOutput emitFunction function + _ => + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input + functionOutput sourceEnv sourceEnv sourceFunction .shared + emitFunction function ∧ + SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx cur limit + functionOutput) + (Result := fun actualResult => + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input + output sourceEnv sourceEnv actualResult world emit av) + (hheadSound := by + intro _ _ _ _ _ _ hhead hfunctionRun hrestRun + exact ⟨hexpr hhead hfunctionRun + ((applyRest_extraExtends hrestRun).trans hextends) havailable, + havailable.lowerE hfunctionRun⟩) + (hreflect := hreflect) + (herasedFinish := by + intro _ _ _ _ hsourceArgs hfunctionSound hrestRun + exact applyRest_erased_run_value_sound_within_below hargs + hsourceArgs hfunctionSound.1 hrestRun hextends hfunctionSound.2) + (hnonErasedFinish := by + intro _ _ _ _ _ _ hfunctionNe hsourceArgs hsourceApply + hfunctionSound hrestRun + exact hrest hfunctionNe hsourceArgs hsourceApply hfunctionSound.1 + hrestRun hextends hfunctionSound.2) + hsource (lowerSpine_var_dynamic_run_inv hnotSelf hrun) + +/-- One complete reachable-state semantic spine step. This is the induction +form used by the generic compiler proof: every recursive run is constrained +to the ambient whole-pass state, and current-self semantics are requested +only when the logical environment actually contains its marker. -/ +theorem lowerSpine_run_value_sound_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hspine : LowerSpineValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hexpr : LowerEValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hrestNext : ApplyRestNonErasedValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {input output : VEnv} {world : Owned} {head : IxIR0.Expr} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + (hsource : SourceSpineEval sourceCtx sourceEnv head args sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world head args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfValueAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSound (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + exact lowerSpine_run_core + (Result := fun actualHead => + SourceSpineEval sourceCtx sourceEnv actualHead args sourceResult → + (lowerSpine src (fuel + 2) input world actualHead args).run state = + .ok (output, emit, av) finalState → + LowerResultValueSound (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av) + (happ := by + intro _ _ hsource hrun + apply hspine hsource.flattenApp + · simpa [lowerSpine] using hrun + · exact hextends + · exact havailable) + (herased := by + intro hsource hrun + exact lowerSpine_erased_run_value_sound_within hargs hsource hrun + hextends havailable) + (hvar := by + intro _ hnotSelf hsource hrun + exact lowerSpine_var_dynamic_run_value_sound_within hexpr hreflect + hargs hrestNext hnotSelf hsource hrun hextends havailable) + (hrecSelf := by + intro index arity hentry hsource hrun + cases havailable with + | inl hself => + exact lowerSpine_recSelf_run_value_sound_within hargs hrest + hentry hself hsource hrun hextends + (SelfValueAvailable.of_contract hself) + | inr hno => exact (hno index arity hentry).elim) + (href := by + intro _ hsource hrun + exact lowerSpine_ref_run_value_sound_within henv hargs hrest + hknownExtra hcontracts hvalues hsource hrun hextends hrepresented + havailable) + (hdynamic := by + intro _ hshape hsource hrun + exact lowerSpine_dynamic_run_value_sound_within hexpr hreflect hargs + hrestNext hshape hsource hrun hextends havailable) + hsource hrun + +/-- One complete fuel-bounded reachable-state semantic spine step. -/ +theorem lowerSpine_run_value_sound_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hspine : LowerSpineValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient (fuel + 1)) + (hexpr : LowerEValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient (fuel + 1)) + (hreflect : LowerEReflectsErased sourceCtx src (fuel + 1)) + (hargs : LowerArgsValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrest : ApplyRestNonErasedValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hrestNext : ApplyRestNonErasedValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 1)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + {input output : VEnv} {world : Owned} {head : IxIR0.Expr} + {args : List IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + (hsource : SourceSpineEval sourceCtx sourceEnv head args sourceResult) + (hrun : (lowerSpine src (fuel + 2) input world head args).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfValueAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueSoundBelow (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur limit input output sourceEnv sourceEnv sourceResult + world emit av := by + exact lowerSpine_run_core + (Result := fun actualHead => + SourceSpineEval sourceCtx sourceEnv actualHead args sourceResult → + (lowerSpine src (fuel + 2) input world actualHead args).run state = + .ok (output, emit, av) finalState → + LowerResultValueSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur limit + input output sourceEnv sourceEnv sourceResult world emit av) + (happ := by + intro _ _ hsource hrun + apply hspine hsource.flattenApp + · simpa [lowerSpine] using hrun + · exact hextends + · exact havailable) + (herased := by + intro hsource hrun + exact lowerSpine_erased_run_value_sound_within_below hargs hsource + hrun hextends havailable) + (hvar := by + intro _ hnotSelf hsource hrun + exact lowerSpine_var_dynamic_run_value_sound_within_below hexpr + hreflect hargs hrestNext hnotSelf hsource hrun hextends havailable) + (hrecSelf := by + intro index arity hentry hsource hrun + cases havailable with + | inl hself => + exact lowerSpine_recSelf_run_value_sound_within_below hargs hrest + hentry hself hsource hrun hextends + (SelfValueAvailableBelow.of_contract hself) + | inr hno => exact (hno index arity hentry).elim) + (href := by + intro _ hsource hrun + exact lowerSpine_ref_run_value_sound_within_below henv hargs hrest + hknownExtra hcontracts hvalues hsource hrun hextends hrepresented + havailable) + (hdynamic := by + intro _ hshape hsource hrun + exact lowerSpine_dynamic_run_value_sound_within_below hexpr hreflect + hargs hrestNext hshape hsource hrun hextends havailable) + hsource hrun + +theorem lowerE_ref_run_value_sound_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hargs : LowerArgsValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hrest : ApplyRestNonErasedValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 2)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + (hsource : IxIR0.eval sourceCtx sourceFuel sourceEnv (.ref f) = + .ok sourceResult) + (hrun : (lowerE src (fuel + 1) input world (.ref f)).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfValueAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSound (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceResult + world emit av := by + apply lowerSpine_ref_run_value_sound_within henv hargs hrest hknownExtra + hcontracts hvalues (SourceSpineEval.of_eval_nil hsource) + · exact lowerE_ref_run_to_lowerSpine_nil hrun + · exact hextends + · exact hrepresented + · exact havailable + +/-- Fuel-bounded standalone reference lowering. -/ +theorem lowerE_ref_run_value_sound_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hargs : LowerArgsValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient (fuel + 1)) + (hrest : ApplyRestNonErasedValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 2)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + {input output : VEnv} {world : Owned} {f : Ixon.Address} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceResult : IxIR0.Value} {emit : Emit} {av : AVal} + (hsource : IxIR0.eval sourceCtx sourceFuel sourceEnv (.ref f) = + .ok sourceResult) + (hrun : (lowerE src (fuel + 1) input world (.ref f)).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfValueAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueSoundBelow (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur limit input output sourceEnv sourceEnv sourceResult + world emit av := by + apply lowerSpine_ref_run_value_sound_within_below henv hargs hrest + hknownExtra hcontracts hvalues (SourceSpineEval.of_eval_nil hsource) + · exact lowerE_ref_run_to_lowerSpine_nil hrun + · exact hextends + · exact hrepresented + · exact havailable + +theorem lowerE_proj_run_value_sound_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hborrow : LowerBorrowValuePreservesWithin funRel recSelfRel sourceCtx + ctx cur src ambient fuel) + {input output : VEnv} {world : Owned} {index : Nat} + {source : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + {sourceFuel : Nat} {sourceTarget sourceValue : IxIR0.Value} + (htarget : IxIR0.eval sourceCtx sourceFuel sourceEnv source = + .ok sourceTarget) + (hproject : SourceProject index sourceTarget sourceValue) + (hrun : (lowerE src (fuel + 1) input world + (.proj index source)).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue world emit av := by + exact (lowerE_proj_run_sound_core + (BorrowResult := fun borrowOutput borrowEmit borrowed release + middleState => + ExtraExtends middleState ambient → + LowerBorrowValueSound funRel recSelfRel ctx cur input borrowOutput + sourceEnv sourceEnv sourceTarget borrowEmit borrowed release) + (ProjectionResult := fun projectionWorld projectionOutput projectionEmit + projectionAv projectionState => + ExtraExtends projectionState ambient → + LowerResultValueSound funRel recSelfRel ctx cur input projectionOutput + sourceEnv sourceEnv sourceValue projectionWorld projectionEmit + projectionAv) + (hborrow := fun hsubrun hwithin => + hborrow htarget hsubrun hwithin havailable) + (hvar := fun hsound hwithin => by + cases (hsound hwithin).stable) + (hlit := fun hsound hwithin => + (hsound hwithin).projectConst) + (herased := fun hsound hwithin => by + cases hproject with + | ctor hfield => exact (hsound hwithin).projectCtorErased + | erased => exact (hsound hwithin).returnErased) + (hslotKept := fun hsound hwithin => by + cases hproject with + | ctor hfield => exact (hsound hwithin).projectSlotKept hfield + | erased => exact (hsound hwithin).projectSlotKeptErased) + (hslotReleased := fun hsound hwithin => by + cases hproject with + | ctor hfield => exact (hsound hwithin).projectSlotReleased hfield + | erased => exact (hsound hwithin).projectSlotReleasedErased) + hrun) hextends + +/-- Fuel-bounded reachable-state projection semantics. -/ +theorem lowerE_proj_run_value_sound_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hborrow : LowerBorrowValuePreservesWithinBelow funRel recSelfRel + sourceCtx ctx cur limit src ambient fuel) + {input output : VEnv} {world : Owned} {index : Nat} + {source : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + {sourceFuel : Nat} {sourceTarget sourceValue : IxIR0.Value} + (htarget : IxIR0.eval sourceCtx sourceFuel sourceEnv source = + .ok sourceTarget) + (hproject : SourceProject index sourceTarget sourceValue) + (hrun : (lowerE src (fuel + 1) input world + (.proj index source)).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue world emit av := by + exact (lowerE_proj_run_sound_core + (BorrowResult := fun borrowOutput borrowEmit borrowed release + middleState => + ExtraExtends middleState ambient → + LowerBorrowValueSoundBelow funRel recSelfRel ctx cur limit input + borrowOutput sourceEnv sourceEnv sourceTarget borrowEmit borrowed + release) + (ProjectionResult := fun projectionWorld projectionOutput projectionEmit + projectionAv projectionState => + ExtraExtends projectionState ambient → + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input + projectionOutput sourceEnv sourceEnv sourceValue projectionWorld + projectionEmit projectionAv) + (hborrow := fun hsubrun hwithin => + hborrow htarget hsubrun hwithin havailable) + (hvar := fun hsound hwithin => by + cases (hsound hwithin).stable) + (hlit := fun hsound hwithin => + (hsound hwithin).projectConst) + (herased := fun hsound hwithin => by + cases hproject with + | ctor hfield => exact (hsound hwithin).projectCtorErased + | erased => exact (hsound hwithin).returnErased) + (hslotKept := fun hsound hwithin => by + cases hproject with + | ctor hfield => exact (hsound hwithin).projectSlotKept hfield + | erased => exact (hsound hwithin).projectSlotKeptErased) + (hslotReleased := fun hsound hwithin => by + cases hproject with + | ctor hfield => exact (hsound hwithin).projectSlotReleased hfield + | erased => exact (hsound hwithin).projectSlotReleasedErased) + hrun) hextends + +/-- Reachable-state let semantics. The body-to-enclosing suffix supplied by +the generic binder proof also transports the earlier bound-value run, while +the explicit no-self map rebuilds current-self availability for the +installed body environment. -/ +theorem lowerE_let_run_value_sound_within + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEValuePreservesWithin funRel recSelfRel sourceCtx ctx cur + src ambient fuel) + {input output : VEnv} {world : Owned} {uses : Uses} + {value body : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + {valueFuel bodyFuel : Nat} + {boundSource sourceValue : IxIR0.Value} + (hvalueSource : IxIR0.eval sourceCtx valueFuel sourceEnv value = + .ok boundSource) + (hbodySource : IxIR0.eval sourceCtx bodyFuel + (boundSource :: sourceEnv) body = .ok sourceValue) + (hreleases : LowerEReleasesTrackedFirst src fuel body) + (hrun : (lowerE src (fuel + 1) input world + (.letE uses value body)).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailable funRel recSelfRel sourceCtx ctx cur + input) : + LowerResultValueSound funRel recSelfRel ctx cur input output + sourceEnv sourceEnv sourceValue world emit av := by + apply lowerE_let_run_value_sound + · intro middle bodyInput bodyOutput valueEmit bodyEmit boundValue + resultValue valueState bodyState bodyFinal hvalueRun hbodyRun + hbodyState hbodyFinal hbodyNo + subst bodyState + have hbodyExtends : ExtraExtends bodyFinal ambient := + hbodyFinal.trans hextends + have hvalueExtends : ExtraExtends valueState ambient := + (lowerE_extraExtends hbodyRun).trans hbodyExtends + have hmiddleAvailable := havailable.lowerE hvalueRun + exact ⟨hexpr hvalueSource hvalueRun hvalueExtends havailable, + hexpr hbodySource hbodyRun hbodyExtends + (hmiddleAvailable.mapNoRecSelf hbodyNo)⟩ + · exact hreleases + · exact hrun + +/-- Fuel-bounded reachable-state let semantics. -/ +theorem lowerE_let_run_value_sound_within_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {ambient : LowSt} {fuel : Nat} + (hexpr : LowerEValuePreservesWithinBelow funRel recSelfRel sourceCtx + ctx cur limit src ambient fuel) + {input output : VEnv} {world : Owned} {uses : Uses} + {value body : IxIR0.Expr} {emit : Emit} {av : AVal} + {state finalState : LowSt} {sourceEnv : List IxIR0.Value} + {valueFuel bodyFuel : Nat} + {boundSource sourceValue : IxIR0.Value} + (hvalueSource : IxIR0.eval sourceCtx valueFuel sourceEnv value = + .ok boundSource) + (hbodySource : IxIR0.eval sourceCtx bodyFuel + (boundSource :: sourceEnv) body = .ok sourceValue) + (hreleases : LowerEReleasesTrackedFirst src fuel body) + (hrun : (lowerE src (fuel + 1) input world + (.letE uses value body)).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (havailable : SelfValueAvailableBelow funRel recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueSoundBelow funRel recSelfRel ctx cur limit input output + sourceEnv sourceEnv sourceValue world emit av := by + apply lowerE_let_run_value_sound_below + · intro middle bodyInput bodyOutput valueEmit bodyEmit boundValue + resultValue valueState bodyState bodyFinal hvalueRun hbodyRun + hbodyState hbodyFinal hbodyNo + subst bodyState + have hbodyExtends : ExtraExtends bodyFinal ambient := + hbodyFinal.trans hextends + have hvalueExtends : ExtraExtends valueState ambient := + (lowerE_extraExtends hbodyRun).trans hbodyExtends + have hmiddleAvailable := havailable.lowerE hvalueRun + exact ⟨hexpr hvalueSource hvalueRun hvalueExtends havailable, + hexpr hbodySource hbodyRun hbodyExtends + (hmiddleAvailable.mapNoRecSelf hbodyNo)⟩ + · exact hreleases + · exact hrun + +/-- One complete reachable-state semantic expression step. Together with +the reachable spine/borrow/argument rules, this is the last local component +needed by the closed compiler-fuel induction. -/ +theorem lowerE_run_value_sound_within + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hexpr : LowerEValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hspine : LowerSpineValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hborrow : LowerBorrowValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel) + (hargsNext : LowerArgsValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hrestNext : ApplyRestNonErasedValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 2)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (hreleases : ∀ body, LowerEReleasesTrackedFirst src fuel body) + {input output : VEnv} {world : Owned} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {emit : Emit} {av : AVal} + (hsource : IxIR0.eval sourceCtx sourceFuel sourceEnv expr = + .ok sourceValue) + (hrun : (lowerE src (fuel + 1) input world expr).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfValueAvailable + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur input) : + LowerResultValueSound (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceValue + world emit av := by + exact lowerE_run_value_sound_core + (Result := fun result => + LowerResultValueSound (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv result world + emit av) + (hvar := fun _ _ hlookup hbranchRun => + lowerE_var_run_value_sound hlookup hbranchRun) + (href := fun _ _ hbranchSource hbranchRun => + lowerE_ref_run_value_sound_within henv hargsNext hrestNext + hknownExtra hcontracts hvalues hbranchSource hbranchRun hextends + hrepresented havailable) + (happ := fun _ _ _ hsourceSpine hspineRun => + hspine hsourceSpine hspineRun hextends havailable) + (hlam := fun _ _ hbranchRun => + lowerE_lam_run_value_sound_any + (fun value address arity captures hlifted => + CompilerFunctionRel.lifted (hlifted.monoState hextends)) + (hrepresented.of_extends hextends) hbranchRun) + (hlet := fun _ _ body _ _ _ hvalueSource hbodySource hbranchRun => + lowerE_let_run_value_sound_within hexpr hvalueSource hbodySource + (hreleases body) hbranchRun hextends havailable) + (hproj := fun _ _ _ _ _ htarget hproject hbranchRun => + lowerE_proj_run_value_sound_within hborrow htarget hproject + hbranchRun hextends havailable) + (hlit := fun _ hbranchRun => lowerE_lit_run_value_sound hbranchRun) + (herased := fun hbranchRun => + lowerE_erased_run_value_sound hbranchRun) + hsource hrun + +/-- One complete fuel-bounded reachable-state semantic expression step. -/ +theorem lowerE_run_value_sound_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} + {ambient : LowSt} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit fuel : Nat} + {state finalState : LowSt} + (henv : sourceCtx.env = src) + (hexpr : LowerEValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hspine : LowerSpineValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hborrow : LowerBorrowValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel) + (hargsNext : LowerArgsValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient (fuel + 1)) + (hrestNext : ApplyRestNonErasedValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient (fuel + 1)) + (hknownExtra : KnownCallExtraMonotone src (fuel + 2)) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + (hreleases : ∀ body, LowerEReleasesTrackedFirst src fuel body) + {input output : VEnv} {world : Owned} {expr : IxIR0.Expr} + {sourceEnv : List IxIR0.Value} {sourceFuel : Nat} + {sourceValue : IxIR0.Value} {emit : Emit} {av : AVal} + (hsource : IxIR0.eval sourceCtx sourceFuel sourceEnv expr = + .ok sourceValue) + (hrun : (lowerE src (fuel + 1) input world expr).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hrepresented : ExtraRepresented ctx ambient) + (havailable : SelfValueAvailableBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit input) : + LowerResultValueSoundBelow (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur limit input output sourceEnv sourceEnv sourceValue + world emit av := by + exact lowerE_run_value_sound_core + (Result := fun result => + LowerResultValueSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx cur limit + input output sourceEnv sourceEnv result world emit av) + (hvar := fun _ _ hlookup hbranchRun => + lowerE_var_run_value_sound_below hlookup hbranchRun) + (href := fun _ _ hbranchSource hbranchRun => + lowerE_ref_run_value_sound_within_below henv hargsNext hrestNext + hknownExtra hcontracts hvalues hbranchSource hbranchRun hextends + hrepresented havailable) + (happ := fun _ _ _ hsourceSpine hspineRun => + hspine hsourceSpine hspineRun hextends havailable) + (hlam := fun _ _ hbranchRun => + lowerE_lam_run_value_sound_any_below + (fun value address arity captures hlifted => + CompilerFunctionRel.lifted (hlifted.monoState hextends)) + (hrepresented.of_extends hextends) hbranchRun) + (hlet := fun _ _ body _ _ _ hvalueSource hbodySource hbranchRun => + lowerE_let_run_value_sound_within_below hexpr hvalueSource + hbodySource (hreleases body) hbranchRun hextends havailable) + (hproj := fun _ _ _ _ _ htarget hproject hbranchRun => + lowerE_proj_run_value_sound_within_below hborrow htarget hproject + hbranchRun hextends havailable) + (hlit := fun _ hbranchRun => + lowerE_lit_run_value_sound_below hbranchRun) + (herased := fun hbranchRun => + lowerE_erased_run_value_sound_below hbranchRun) + hsource hrun + +/-- One complete bounded expression step. The semantic recursive premises +are separated from the two compiler-state facts they cannot express: +successful let bodies release their counted binder, and the final target +context represents declarations accumulated by lambda lifting. -/ +theorem lowerE_run_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} + (hexpr : LowerEPreservesBelow ctx cur limit src fuel) + (hspine : LowerSpinePreservesBelow ctx cur limit src fuel) + (hargsNext : LowerArgsPreservesBelow ctx cur limit src (fuel + 1)) + (hargsNextExtra : LowerArgsExtraMonotone src (fuel + 1)) + (hrestNext : ApplyRestPreservesBelow ctx cur limit src (fuel + 1)) + (hrestNextExtra : ApplyRestExtraMonotone src (fuel + 1)) + (hborrow : LowerBorrowPreservesBelow ctx cur limit src fuel) + (hdecls : SourceDeclContractsBelow src ctx limit) + (hreleases : ∀ body, LowerEReleasesTrackedFirst src fuel body) + {input output : VEnv} {world : Owned} {expr : IxIR0.Expr} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hrepresented : ExtraRepresented ctx finalState) + (hrun : (lowerE src (fuel + 1) input world expr).run state = + .ok (output, emit, av) finalState) + (havailable : SelfAvailableBelow ctx cur limit input) : + LowerResultSoundBelow ctx cur limit input output world emit av := by + cases expr with + | var index => + exact lowerE_nonbinding_run_sound_below hspine hargsNext hargsNextExtra + hrestNext hrestNextExtra hborrow hdecls (.var index) hrun + hrepresented havailable + | ref address => + exact lowerE_nonbinding_run_sound_below hspine hargsNext hargsNextExtra + hrestNext hrestNextExtra hborrow hdecls (.ref address) hrun + hrepresented havailable + | app function argument => + exact lowerE_nonbinding_run_sound_below hspine hargsNext hargsNextExtra + hrestNext hrestNextExtra hborrow hdecls (.app function argument) + hrun hrepresented havailable + | lam uses body => + exact lowerE_lam_run_sound_below hrepresented hrun + | letE uses value body => + exact lowerE_let_run_sound_below hexpr (hreleases body) hrun + hrepresented havailable + | proj index source => + exact lowerE_nonbinding_run_sound_below hspine hargsNext hargsNextExtra + hrestNext hrestNextExtra hborrow hdecls (.proj index source) hrun + hrepresented havailable + | lit literal => + exact lowerE_nonbinding_run_sound_below hspine hargsNext hargsNextExtra + hrestNext hrestNextExtra hborrow hdecls (.lit literal) hrun + hrepresented havailable + | erased => + exact lowerE_nonbinding_run_sound_below hspine hargsNext hargsNextExtra + hrestNext hrestNextExtra hborrow hdecls .erased hrun hrepresented + havailable + +/-- Non-erased dynamic heads compose their proved `lowerE` result with the +shared `applyRest` branch. -/ +theorem lowerSpine_dynamic_apply_verified {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) + (input functionOutput output : VEnv) (head : IxIR0.Expr) + (args : List IxIR0.Expr) (emitFunction emitArgs : Emit) + (function : AVal) (avs : List AVal) + (state middleState finalState : LowSt) + (hshape : DynamicSpineHead head) + (hfunctionRun : + (lowerE src (Nat.succ fuel) input .shared head).run state = + .ok (functionOutput, emitFunction, function) middleState) + (hfunction : LowerResultSound ctx cur input functionOutput .shared + emitFunction function) + (hfunctionNe : function ≠ .constA .erased) + (hargsRun : + (lowerArgs src fuel functionOutput + (args.map (fun arg => (arg, Owned.shared)))).run middleState = + .ok (output, emitArgs, avs) finalState) + (hargsSound : LowerArgsSound ctx cur functionOutput output + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) + emitArgs avs) + (hworldsHomogeneous : + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate avs.length .shared) + (hcontract : ApplyOwnershipContract ctx) : + (lowerSpine src (Nat.succ (Nat.succ fuel)) input .shared head + args).run state = + .ok (output.bump, + (emitFunction ∘ emitArgs) ∘ + emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray), + .slotA output.depth) finalState ∧ + LowerResultSound ctx cur input output.bump .shared + ((emitFunction ∘ emitArgs) ∘ + emitOp (.apply (function.toAtom output) + (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + have happly := applyRest_shared_verified (ctx := ctx) (cur := cur) + src fuel input functionOutput output emitFunction emitArgs function + args avs middleState finalState hfunctionNe hargsRun hargsSound + hworldsHomogeneous hfunction hcontract + constructor + · cases hshape <;> + simp only [lowerSpine] <;> + rw [estateBindRun, hfunctionRun] <;> + exact happly.1 + · exact happly.2 + +/-- If the dynamically lowered head is erased, its arguments are evaluated +and released through the erased `applyRest` branch at either result world. -/ +theorem lowerSpine_dynamic_erased_verified {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) + (input functionOutput output : VEnv) (resultWorld : Owned) + (head : IxIR0.Expr) (args : List IxIR0.Expr) + (emitFunction emitArgs : Emit) (avs : List AVal) + (state middleState finalState : LowSt) + (hshape : DynamicSpineHead head) + (hfunctionRun : + (lowerE src (Nat.succ fuel) input .shared head).run state = + .ok (functionOutput, emitFunction, .constA .erased) middleState) + (hfunction : LowerResultSound ctx cur input functionOutput .shared + emitFunction (.constA .erased)) + (hargsRun : + (lowerArgs src fuel functionOutput + (args.map (fun arg => (arg, Owned.shared)))).run middleState = + .ok (output, emitArgs, avs) finalState) + (hargsSound : LowerArgsSound ctx cur functionOutput output + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) + emitArgs avs) + (hworldsHomogeneous : + ((args.map (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate avs.length .shared) : + (lowerSpine src (Nat.succ (Nat.succ fuel)) input resultWorld head + args).run state = + .ok ((releaseAll output avs).1, + (emitFunction ∘ emitArgs) ∘ (releaseAll output avs).2, + .constA .erased) finalState ∧ + LowerResultSound ctx cur input (releaseAll output avs).1 resultWorld + ((emitFunction ∘ emitArgs) ∘ (releaseAll output avs).2) + (.constA .erased) := by + have happly := applyRest_erased_verified (ctx := ctx) (cur := cur) + src fuel input functionOutput output resultWorld emitFunction emitArgs + args avs middleState finalState hargsRun hargsSound + hworldsHomogeneous hfunction + constructor + · cases hshape <;> + simp only [lowerSpine] <;> + rw [estateBindRun, hfunctionRun] <;> + exact happly.1 + · exact happly.2 + +/-- The terminal direct-call branch of the executable `knownCall`: once the +proved argument prefix has no over-application tail, it is consumed by the +callee contract and the fresh result slot is returned. -/ +theorem knownCall_call_terminal_verified {ctx : Ctx} {cur d : FnDef} + (src : IxIR0.Env) (fuel : Nat) (input output : VEnv) + (f : Ixon.Address) (n : Nat) (argWorlds : List Owned) + (resultDemand : Owned) (args : List IxIR0.Expr) + (emit : Emit) (avs : List AVal) (state finalState : LowSt) + (hargsRun : + (lowerArgs src fuel input + ((args.take n).zip (padWorlds argWorlds n))).run state = + .ok (output, emit, avs) finalState) + (hargsSound : LowerArgsSound ctx cur input output + (((args.take n).zip (padWorlds argWorlds n)).map Prod.snd) + emit avs) + (hle : args.length ≤ n) + (hdecl : ctx.decls f = some (.fn d)) + (hcontract : FnOwnershipContract ctx d + (((args.take n).zip (padWorlds argWorlds n)).map Prod.snd)) : + (knownCall src (Nat.succ fuel) input (.call f ·) n argWorlds + resultDemand args).run state = + .ok (output.bump, + emit ∘ emitOp + (.call f (avs.map (·.toAtom output)).toArray), + .slotA output.depth) finalState ∧ + LowerResultSound ctx cur input output.bump d.result + (emit ∘ emitOp + (.call f (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + constructor + · simp only [knownCall] + rw [estateBindRun, hargsRun] + simp [hle] + · exact hargsSound.call_owned hdecl hcontract + +/-- Terminal recursive-self branch of `knownCall`, paired with the current +function's ownership contract. -/ +theorem knownCall_callSelf_terminal_verified {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) (input output : VEnv) + (n : Nat) (argWorlds : List Owned) (resultDemand : Owned) + (args : List IxIR0.Expr) (emit : Emit) (avs : List AVal) + (state finalState : LowSt) + (hargsRun : + (lowerArgs src fuel input + ((args.take n).zip (padWorlds argWorlds n))).run state = + .ok (output, emit, avs) finalState) + (hargsSound : LowerArgsSound ctx cur input output + (((args.take n).zip (padWorlds argWorlds n)).map Prod.snd) + emit avs) + (hle : args.length ≤ n) + (hcontract : FnOwnershipContract ctx cur + (((args.take n).zip (padWorlds argWorlds n)).map Prod.snd)) : + (knownCall src (Nat.succ fuel) input (.callSelf ·) n argWorlds + resultDemand args).run state = + .ok (output.bump, + emit ∘ emitOp + (.callSelf (avs.map (·.toAtom output)).toArray), + .slotA output.depth) finalState ∧ + LowerResultSound ctx cur input output.bump cur.result + (emit ∘ emitOp + (.callSelf (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + constructor + · simp only [knownCall] + rw [estateBindRun, hargsRun] + simp [hle] + · exact hargsSound.callSelf_owned hcontract + +/-- Exact-saturation `recSelf` dispatch in `lowerSpine`. The v1 source +restriction supplies an all-shared telescope and the current function +contract closes the recursive call. -/ +theorem lowerSpine_recSelf_terminal_verified {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) (input output : VEnv) + (i arity : Nat) (args : List IxIR0.Expr) + (emit : Emit) (avs : List AVal) (state finalState : LowSt) + (hentry : input.entries[i]? = some (.recSelf arity)) + (hargsLength : args.length = arity) + (hargsRun : + (lowerArgs src fuel input + ((args.take arity).zip + (padWorlds (List.replicate arity .shared) arity))).run state = + .ok (output, emit, avs) finalState) + (hargsSound : LowerArgsSound ctx cur input output + (((args.take arity).zip + (padWorlds (List.replicate arity .shared) arity)).map Prod.snd) + emit avs) + (hcontract : FnOwnershipContract ctx cur + (((args.take arity).zip + (padWorlds (List.replicate arity .shared) arity)).map Prod.snd)) + (hresult : cur.result = .shared) : + (lowerSpine src (Nat.succ (Nat.succ fuel)) input .shared (.var i) + args).run state = + .ok (output.bump, + emit ∘ emitOp + (.callSelf (avs.map (·.toAtom output)).toArray), + .slotA output.depth) finalState ∧ + LowerResultSound ctx cur input output.bump .shared + (emit ∘ emitOp + (.callSelf (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + have hknown := knownCall_callSelf_terminal_verified + (ctx := ctx) (cur := cur) src fuel input output arity + (List.replicate arity .shared) .shared args emit avs state finalState + hargsRun hargsSound (by omega) hcontract + constructor + · simp only [lowerSpine] + rw [hentry] + simp only + rw [if_neg (by omega)] + have hrequire : + (requireResultWorld .shared .shared).run state = .ok () state := by + rfl + rw [estateBindRun, hrequire] + simp only + exact hknown.1 + · simpa [hresult] using hknown.2 + +/-- Over-applied recursive-self branch of `knownCall`: call the current +function on its saturated prefix, protect the shared recursive result, then +apply the remaining shared arguments. -/ +theorem knownCall_callSelf_overapplied_verified + {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) + (input prefixOutput output : VEnv) + (n : Nat) (argWorlds : List Owned) (args : List IxIR0.Expr) + (emitPrefix emitTail : Emit) (prefixAVals tailAVals : List AVal) + (state middleState finalState : LowSt) + (hprefixRun : + (lowerArgs src (Nat.succ fuel) input + ((args.take n).zip (padWorlds argWorlds n))).run state = + .ok (prefixOutput, emitPrefix, prefixAVals) middleState) + (hprefixSound : LowerArgsSound ctx cur input prefixOutput + (((args.take n).zip (padWorlds argWorlds n)).map Prod.snd) + emitPrefix prefixAVals) + (hover : n < args.length) + (hcallContract : FnOwnershipContract ctx cur + (((args.take n).zip (padWorlds argWorlds n)).map Prod.snd)) + (hresult : cur.result = .shared) + (htailRun : + (lowerArgs src fuel prefixOutput.bump + ((args.drop n).map (fun arg => (arg, Owned.shared)))).run + middleState = + .ok (output, emitTail, tailAVals) finalState) + (htailSound : LowerArgsSound ctx cur prefixOutput.bump output + (((args.drop n).map (fun arg => (arg, Owned.shared))).map Prod.snd) + emitTail tailAVals) + (htailWorlds : + (((args.drop n).map (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate tailAVals.length .shared) + (happlyContract : ApplyOwnershipContract ctx) : + (knownCall src (Nat.succ (Nat.succ fuel)) input (.callSelf ·) n + argWorlds .shared args).run state = + .ok (output.bump, + ((emitPrefix ∘ emitOp (.callSelf + (prefixAVals.map (·.toAtom prefixOutput)).toArray)) ∘ + emitTail) ∘ + emitOp (.apply + ((AVal.slotA prefixOutput.depth).toAtom output) + (tailAVals.map (·.toAtom output)).toArray), + .slotA output.depth) finalState ∧ + LowerResultSound ctx cur input output.bump .shared + (((emitPrefix ∘ emitOp (.callSelf + (prefixAVals.map (·.toAtom prefixOutput)).toArray)) ∘ + emitTail) ∘ + emitOp (.apply + ((AVal.slotA prefixOutput.depth).toAtom output) + (tailAVals.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + have hcall : LowerResultSound ctx cur input prefixOutput.bump .shared + (emitPrefix ∘ emitOp (.callSelf + (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) := by + simpa [hresult] using hprefixSound.callSelf_owned hcallContract + have happly := applyRest_shared_verified (ctx := ctx) (cur := cur) + src fuel input prefixOutput.bump output + (emitPrefix ∘ emitOp (.callSelf + (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + emitTail (.slotA prefixOutput.depth) (args.drop n) tailAVals + middleState finalState (by simp) htailRun htailSound htailWorlds + hcall happlyContract + constructor + · simp only [knownCall] + rw [estateBindRun, hprefixRun] + simp only + rw [if_neg (Nat.not_le.mpr hover)] + exact happly.1 + · exact happly.2 + +/-- Over-applied `recSelf` dispatch in `lowerSpine`, including the recursive +prefix call and higher-order application of the tail. -/ +theorem lowerSpine_recSelf_overapplied_verified + {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) + (input prefixOutput output : VEnv) + (i arity : Nat) (args : List IxIR0.Expr) + (emitPrefix emitTail : Emit) (prefixAVals tailAVals : List AVal) + (state middleState finalState : LowSt) + (hentry : input.entries[i]? = some (.recSelf arity)) + (hprefixRun : + (lowerArgs src (Nat.succ fuel) input + ((args.take arity).zip + (padWorlds (List.replicate arity .shared) arity))).run state = + .ok (prefixOutput, emitPrefix, prefixAVals) middleState) + (hprefixSound : LowerArgsSound ctx cur input prefixOutput + (((args.take arity).zip + (padWorlds (List.replicate arity .shared) arity)).map Prod.snd) + emitPrefix prefixAVals) + (hover : arity < args.length) + (hcallContract : FnOwnershipContract ctx cur + (((args.take arity).zip + (padWorlds (List.replicate arity .shared) arity)).map Prod.snd)) + (hresult : cur.result = .shared) + (htailRun : + (lowerArgs src fuel prefixOutput.bump + ((args.drop arity).map (fun arg => (arg, Owned.shared)))).run + middleState = + .ok (output, emitTail, tailAVals) finalState) + (htailSound : LowerArgsSound ctx cur prefixOutput.bump output + (((args.drop arity).map + (fun arg => (arg, Owned.shared))).map Prod.snd) + emitTail tailAVals) + (htailWorlds : + (((args.drop arity).map + (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate tailAVals.length .shared) + (happlyContract : ApplyOwnershipContract ctx) : + (lowerSpine src (Nat.succ (Nat.succ (Nat.succ fuel))) input .shared + (.var i) args).run state = + .ok (output.bump, + ((emitPrefix ∘ emitOp (.callSelf + (prefixAVals.map (·.toAtom prefixOutput)).toArray)) ∘ + emitTail) ∘ + emitOp (.apply + ((AVal.slotA prefixOutput.depth).toAtom output) + (tailAVals.map (·.toAtom output)).toArray), + .slotA output.depth) finalState ∧ + LowerResultSound ctx cur input output.bump .shared + (((emitPrefix ∘ emitOp (.callSelf + (prefixAVals.map (·.toAtom prefixOutput)).toArray)) ∘ + emitTail) ∘ + emitOp (.apply + ((AVal.slotA prefixOutput.depth).toAtom output) + (tailAVals.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + have hknown := knownCall_callSelf_overapplied_verified + (ctx := ctx) (cur := cur) src fuel input prefixOutput output arity + (List.replicate arity .shared) args emitPrefix emitTail prefixAVals + tailAVals state middleState finalState hprefixRun hprefixSound hover + hcallContract hresult htailRun htailSound htailWorlds happlyContract + constructor + · simp only [lowerSpine] + rw [hentry] + simp only + rw [if_neg (by omega)] + have hrequire : + (requireResultWorld .shared .shared).run state = .ok () state := by + rfl + rw [estateBindRun, hrequire] + simp only + exact hknown.1 + · exact hknown.2 + +/-- Exact-saturation definition dispatch in `lowerSpine`, reducing its +source declaration/world checks to the terminal direct-call `knownCall` +rule. -/ +theorem lowerSpine_ref_call_terminal_verified {ctx : Ctx} {cur d : FnDef} + (src : IxIR0.Env) (fuel : Nat) (input output : VEnv) + (f : Ixon.Address) (result : Owned) (body : IxIR0.Expr) + (args : List IxIR0.Expr) (emit : Emit) (avs : List AVal) + (state finalState : LowSt) + (hsrc : src f = some (.defn result body)) + (hargsLength : args.length = lamArity body) + (hargsRun : + (lowerArgs src fuel input + ((args.take (lamArity body)).zip + (padWorlds ((lamUses body).map worldOfUses) + (lamArity body)))).run state = + .ok (output, emit, avs) finalState) + (hargsSound : LowerArgsSound ctx cur input output + (((args.take (lamArity body)).zip + (padWorlds ((lamUses body).map worldOfUses) + (lamArity body))).map Prod.snd) + emit avs) + (hdecl : ctx.decls f = some (.fn d)) + (hcontract : FnOwnershipContract ctx d + (((args.take (lamArity body)).zip + (padWorlds ((lamUses body).map worldOfUses) + (lamArity body))).map Prod.snd)) + (hresult : d.result = result) : + (lowerSpine src (Nat.succ (Nat.succ fuel)) input result (.ref f) + args).run state = + .ok (output.bump, + emit ∘ emitOp (.call f + (avs.map (·.toAtom output)).toArray), + .slotA output.depth) finalState ∧ + LowerResultSound ctx cur input output.bump result + (emit ∘ emitOp (.call f + (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + have hknown := knownCall_call_terminal_verified (ctx := ctx) (cur := cur) + src fuel input output f (lamArity body) + ((lamUses body).map worldOfUses) result args emit avs state finalState + hargsRun hargsSound (by omega) hdecl hcontract + constructor + · simp only [lowerSpine] + rw [hsrc] + simp only + rw [if_neg (by omega)] + have hrequire : + (requireResultWorld result + (if args.length == lamArity body then result else .shared)).run + state = .ok () state := by + simp [hargsLength, requireResultWorld] + rw [estateBindRun, hrequire] + simp only + exact hknown.1 + · simpa [hresult] using hknown.2 + +/-- Exact-saturation recursor dispatch. Once the recursor has been lowered +to a target function, its all-shared firing telescope is an ordinary direct +call under that declaration's contract. -/ +theorem lowerSpine_ref_recursor_terminal_verified + {ctx : Ctx} {cur d : FnDef} + (src : IxIR0.Env) (fuel : Nat) (input output : VEnv) + (f : Ixon.Address) (numArgs : Nat) (natLit : Bool) + (rules : Array IxIR0.RecRule) (args : List IxIR0.Expr) + (emit : Emit) (avs : List AVal) (state finalState : LowSt) + (hsrc : src f = some (.recursor numArgs natLit rules)) + (hargsLength : args.length = numArgs + 1) + (hargsRun : + (lowerArgs src fuel input + ((args.take (numArgs + 1)).zip + (padWorlds (List.replicate (numArgs + 1) .shared) + (numArgs + 1)))).run state = + .ok (output, emit, avs) finalState) + (hargsSound : LowerArgsSound ctx cur input output + (((args.take (numArgs + 1)).zip + (padWorlds (List.replicate (numArgs + 1) .shared) + (numArgs + 1))).map Prod.snd) + emit avs) + (hdecl : ctx.decls f = some (.fn d)) + (hcontract : FnOwnershipContract ctx d + (((args.take (numArgs + 1)).zip + (padWorlds (List.replicate (numArgs + 1) .shared) + (numArgs + 1))).map Prod.snd)) + (hresult : d.result = .shared) : + (lowerSpine src (Nat.succ (Nat.succ fuel)) input .shared (.ref f) + args).run state = + .ok (output.bump, + emit ∘ emitOp (.call f + (avs.map (·.toAtom output)).toArray), + .slotA output.depth) finalState ∧ + LowerResultSound ctx cur input output.bump .shared + (emit ∘ emitOp (.call f + (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + have hknown := knownCall_call_terminal_verified (ctx := ctx) (cur := cur) + src fuel input output f (numArgs + 1) + (List.replicate (numArgs + 1) .shared) .shared args emit avs + state finalState hargsRun hargsSound (by omega) hdecl hcontract + constructor + · simp only [lowerSpine] + rw [hsrc] + simp only + rw [if_neg (by omega)] + have hrequire : + (requireResultWorld .shared .shared).run state = .ok () state := by + rfl + rw [estateBindRun, hrequire] + simp only + exact hknown.1 + · simpa [hresult] using hknown.2 + +/-- The over-applied direct-call branch of `knownCall`. The saturated prefix +is consumed by the callee contract, its shared result is protected while the +remaining shared arguments are lowered, and the resulting prefix is consumed +by `apply`. -/ +theorem knownCall_call_overapplied_verified {ctx : Ctx} {cur d : FnDef} + (src : IxIR0.Env) (fuel : Nat) + (input prefixOutput output : VEnv) + (f : Ixon.Address) (n : Nat) (argWorlds : List Owned) + (args : List IxIR0.Expr) + (emitPrefix emitTail : Emit) (prefixAVals tailAVals : List AVal) + (state middleState finalState : LowSt) + (hprefixRun : + (lowerArgs src (Nat.succ fuel) input + ((args.take n).zip (padWorlds argWorlds n))).run state = + .ok (prefixOutput, emitPrefix, prefixAVals) middleState) + (hprefixSound : LowerArgsSound ctx cur input prefixOutput + (((args.take n).zip (padWorlds argWorlds n)).map Prod.snd) + emitPrefix prefixAVals) + (hover : n < args.length) + (hdecl : ctx.decls f = some (.fn d)) + (hcallContract : FnOwnershipContract ctx d + (((args.take n).zip (padWorlds argWorlds n)).map Prod.snd)) + (hresult : d.result = .shared) + (htailRun : + (lowerArgs src fuel prefixOutput.bump + ((args.drop n).map (fun arg => (arg, Owned.shared)))).run + middleState = + .ok (output, emitTail, tailAVals) finalState) + (htailSound : LowerArgsSound ctx cur prefixOutput.bump output + (((args.drop n).map (fun arg => (arg, Owned.shared))).map Prod.snd) + emitTail tailAVals) + (htailWorlds : + (((args.drop n).map (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate tailAVals.length .shared) + (happlyContract : ApplyOwnershipContract ctx) : + (knownCall src (Nat.succ (Nat.succ fuel)) input (.call f ·) n + argWorlds .shared args).run state = + .ok (output.bump, + ((emitPrefix ∘ emitOp (.call f + (prefixAVals.map (·.toAtom prefixOutput)).toArray)) ∘ + emitTail) ∘ + emitOp (.apply + ((AVal.slotA prefixOutput.depth).toAtom output) + (tailAVals.map (·.toAtom output)).toArray), + .slotA output.depth) finalState ∧ + LowerResultSound ctx cur input output.bump .shared + (((emitPrefix ∘ emitOp (.call f + (prefixAVals.map (·.toAtom prefixOutput)).toArray)) ∘ + emitTail) ∘ + emitOp (.apply + ((AVal.slotA prefixOutput.depth).toAtom output) + (tailAVals.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + have hcall : LowerResultSound ctx cur input prefixOutput.bump .shared + (emitPrefix ∘ emitOp (.call f + (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) := by + simpa [hresult] using hprefixSound.call_owned hdecl hcallContract + have happly := applyRest_shared_verified (ctx := ctx) (cur := cur) + src fuel input prefixOutput.bump output + (emitPrefix ∘ emitOp (.call f + (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + emitTail (.slotA prefixOutput.depth) (args.drop n) tailAVals + middleState finalState (by simp) htailRun htailSound htailWorlds + hcall happlyContract + constructor + · simp only [knownCall] + rw [estateBindRun, hprefixRun] + simp only + rw [if_neg (Nat.not_le.mpr hover)] + exact happly.1 + · exact happly.2 + +/-- Over-applied definition dispatch in `lowerSpine`: the source declaration +check selects a shared saturated prefix call, after which `knownCall` lowers +and applies the remaining shared arguments. -/ +theorem lowerSpine_ref_call_overapplied_verified + {ctx : Ctx} {cur d : FnDef} + (src : IxIR0.Env) (fuel : Nat) + (input prefixOutput output : VEnv) + (f : Ixon.Address) (body : IxIR0.Expr) (args : List IxIR0.Expr) + (emitPrefix emitTail : Emit) (prefixAVals tailAVals : List AVal) + (state middleState finalState : LowSt) + (hsrc : src f = some (.defn .shared body)) + (hprefixRun : + (lowerArgs src (Nat.succ fuel) input + ((args.take (lamArity body)).zip + (padWorlds ((lamUses body).map worldOfUses) + (lamArity body)))).run state = + .ok (prefixOutput, emitPrefix, prefixAVals) middleState) + (hprefixSound : LowerArgsSound ctx cur input prefixOutput + (((args.take (lamArity body)).zip + (padWorlds ((lamUses body).map worldOfUses) + (lamArity body))).map Prod.snd) + emitPrefix prefixAVals) + (hover : lamArity body < args.length) + (hdecl : ctx.decls f = some (.fn d)) + (hcallContract : FnOwnershipContract ctx d + (((args.take (lamArity body)).zip + (padWorlds ((lamUses body).map worldOfUses) + (lamArity body))).map Prod.snd)) + (hresult : d.result = .shared) + (htailRun : + (lowerArgs src fuel prefixOutput.bump + ((args.drop (lamArity body)).map + (fun arg => (arg, Owned.shared)))).run middleState = + .ok (output, emitTail, tailAVals) finalState) + (htailSound : LowerArgsSound ctx cur prefixOutput.bump output + (((args.drop (lamArity body)).map + (fun arg => (arg, Owned.shared))).map Prod.snd) + emitTail tailAVals) + (htailWorlds : + (((args.drop (lamArity body)).map + (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate tailAVals.length .shared) + (happlyContract : ApplyOwnershipContract ctx) : + (lowerSpine src (Nat.succ (Nat.succ (Nat.succ fuel))) input .shared + (.ref f) args).run state = + .ok (output.bump, + ((emitPrefix ∘ emitOp (.call f + (prefixAVals.map (·.toAtom prefixOutput)).toArray)) ∘ + emitTail) ∘ + emitOp (.apply + ((AVal.slotA prefixOutput.depth).toAtom output) + (tailAVals.map (·.toAtom output)).toArray), + .slotA output.depth) finalState ∧ + LowerResultSound ctx cur input output.bump .shared + (((emitPrefix ∘ emitOp (.call f + (prefixAVals.map (·.toAtom prefixOutput)).toArray)) ∘ + emitTail) ∘ + emitOp (.apply + ((AVal.slotA prefixOutput.depth).toAtom output) + (tailAVals.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + have hknown := knownCall_call_overapplied_verified + (ctx := ctx) (cur := cur) src fuel input prefixOutput output f + (lamArity body) ((lamUses body).map worldOfUses) args + emitPrefix emitTail prefixAVals tailAVals state middleState finalState + hprefixRun hprefixSound hover hdecl hcallContract hresult htailRun + htailSound htailWorlds happlyContract + constructor + · simp only [lowerSpine] + rw [hsrc] + simp only + rw [if_neg (by omega)] + have hrequire : + (requireResultWorld .shared + (if args.length == lamArity body then .shared else .shared)).run + state = .ok () state := by + simp [requireResultWorld] + rw [estateBindRun, hrequire] + simp only + exact hknown.1 + · exact hknown.2 + +/-- Over-applied recursor dispatch is the all-shared recursor analogue of +over-applied definition dispatch: direct-call the firing prefix, then apply +the remaining arguments to its shared result. -/ +theorem lowerSpine_ref_recursor_overapplied_verified + {ctx : Ctx} {cur d : FnDef} + (src : IxIR0.Env) (fuel : Nat) + (input prefixOutput output : VEnv) + (f : Ixon.Address) (numArgs : Nat) (natLit : Bool) + (rules : Array IxIR0.RecRule) (args : List IxIR0.Expr) + (emitPrefix emitTail : Emit) (prefixAVals tailAVals : List AVal) + (state middleState finalState : LowSt) + (hsrc : src f = some (.recursor numArgs natLit rules)) + (hprefixRun : + (lowerArgs src (Nat.succ fuel) input + ((args.take (numArgs + 1)).zip + (padWorlds (List.replicate (numArgs + 1) .shared) + (numArgs + 1)))).run state = + .ok (prefixOutput, emitPrefix, prefixAVals) middleState) + (hprefixSound : LowerArgsSound ctx cur input prefixOutput + (((args.take (numArgs + 1)).zip + (padWorlds (List.replicate (numArgs + 1) .shared) + (numArgs + 1))).map Prod.snd) + emitPrefix prefixAVals) + (hover : numArgs + 1 < args.length) + (hdecl : ctx.decls f = some (.fn d)) + (hcallContract : FnOwnershipContract ctx d + (((args.take (numArgs + 1)).zip + (padWorlds (List.replicate (numArgs + 1) .shared) + (numArgs + 1))).map Prod.snd)) + (hresult : d.result = .shared) + (htailRun : + (lowerArgs src fuel prefixOutput.bump + ((args.drop (numArgs + 1)).map + (fun arg => (arg, Owned.shared)))).run middleState = + .ok (output, emitTail, tailAVals) finalState) + (htailSound : LowerArgsSound ctx cur prefixOutput.bump output + (((args.drop (numArgs + 1)).map + (fun arg => (arg, Owned.shared))).map Prod.snd) + emitTail tailAVals) + (htailWorlds : + (((args.drop (numArgs + 1)).map + (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate tailAVals.length .shared) + (happlyContract : ApplyOwnershipContract ctx) : + (lowerSpine src (Nat.succ (Nat.succ (Nat.succ fuel))) input .shared + (.ref f) args).run state = + .ok (output.bump, + ((emitPrefix ∘ emitOp (.call f + (prefixAVals.map (·.toAtom prefixOutput)).toArray)) ∘ + emitTail) ∘ + emitOp (.apply + ((AVal.slotA prefixOutput.depth).toAtom output) + (tailAVals.map (·.toAtom output)).toArray), + .slotA output.depth) finalState ∧ + LowerResultSound ctx cur input output.bump .shared + (((emitPrefix ∘ emitOp (.call f + (prefixAVals.map (·.toAtom prefixOutput)).toArray)) ∘ + emitTail) ∘ + emitOp (.apply + ((AVal.slotA prefixOutput.depth).toAtom output) + (tailAVals.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + have hknown := knownCall_call_overapplied_verified + (ctx := ctx) (cur := cur) src fuel input prefixOutput output f + (numArgs + 1) (List.replicate (numArgs + 1) .shared) args + emitPrefix emitTail prefixAVals tailAVals state middleState finalState + hprefixRun hprefixSound hover hdecl hcallContract hresult htailRun + htailSound htailWorlds happlyContract + constructor + · simp only [lowerSpine] + rw [hsrc] + simp only + rw [if_neg (by omega)] + have hrequire : + (requireResultWorld .shared .shared).run state = .ok () state := by + rfl + rw [estateBindRun, hrequire] + simp only + exact hknown.1 + · exact hknown.2 + +/-- The homogeneous constructor counterpart of +`knownCall_call_terminal_verified`. Whole-value mode scoping makes every +field world equal to the newly allocated node's world. -/ +theorem knownCall_alloc_terminal_verified {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) (input output : VEnv) + (world : Owned) (cid : CtorId) (n : Nat) + (argWorlds : List Owned) (resultDemand : Owned) + (args : List IxIR0.Expr) (emit : Emit) (avs : List AVal) + (state finalState : LowSt) + (hargsRun : + (lowerArgs src fuel input + ((args.take n).zip (padWorlds argWorlds n))).run state = + .ok (output, emit, avs) finalState) + (hargsSound : LowerArgsSound ctx cur input output + (((args.take n).zip (padWorlds argWorlds n)).map Prod.snd) + emit avs) + (hworldsHomogeneous : + ((args.take n).zip (padWorlds argWorlds n)).map Prod.snd = + List.replicate avs.length world) + (hle : args.length ≤ n) : + (knownCall src (Nat.succ fuel) input (.alloc world cid ·) n + argWorlds resultDemand args).run state = + .ok (output.bump, + emit ∘ emitOp (.alloc world cid + (avs.map (·.toAtom output)).toArray), + .slotA output.depth) finalState ∧ + LowerResultSound ctx cur input output.bump world + (emit ∘ emitOp (.alloc world cid + (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + constructor + · simp only [knownCall] + rw [estateBindRun, hargsRun] + simp [hle] + · have hhomogeneous : LowerArgsSound ctx cur input output + (List.replicate avs.length world) emit avs := by + simpa [hworldsHomogeneous] using hargsSound + exact hhomogeneous.alloc_owned + +/-- Over-applied shared-constructor branch of `knownCall`: allocate the +saturated field prefix, protect the fresh constructor root, then emit the +remaining higher-order application. -/ +theorem knownCall_alloc_overapplied_verified {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) + (input prefixOutput output : VEnv) + (cid : CtorId) (n : Nat) (argWorlds : List Owned) + (args : List IxIR0.Expr) + (emitPrefix emitTail : Emit) (prefixAVals tailAVals : List AVal) + (state middleState finalState : LowSt) + (hprefixRun : + (lowerArgs src (Nat.succ fuel) input + ((args.take n).zip (padWorlds argWorlds n))).run state = + .ok (prefixOutput, emitPrefix, prefixAVals) middleState) + (hprefixSound : LowerArgsSound ctx cur input prefixOutput + (((args.take n).zip (padWorlds argWorlds n)).map Prod.snd) + emitPrefix prefixAVals) + (hprefixWorlds : + ((args.take n).zip (padWorlds argWorlds n)).map Prod.snd = + List.replicate prefixAVals.length .shared) + (hover : n < args.length) + (htailRun : + (lowerArgs src fuel prefixOutput.bump + ((args.drop n).map (fun arg => (arg, Owned.shared)))).run + middleState = + .ok (output, emitTail, tailAVals) finalState) + (htailSound : LowerArgsSound ctx cur prefixOutput.bump output + (((args.drop n).map (fun arg => (arg, Owned.shared))).map Prod.snd) + emitTail tailAVals) + (htailWorlds : + (((args.drop n).map (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate tailAVals.length .shared) + (happlyContract : ApplyOwnershipContract ctx) : + (knownCall src (Nat.succ (Nat.succ fuel)) input + (.alloc .shared cid ·) n argWorlds .shared args).run state = + .ok (output.bump, + ((emitPrefix ∘ emitOp (.alloc .shared cid + (prefixAVals.map (·.toAtom prefixOutput)).toArray)) ∘ + emitTail) ∘ + emitOp (.apply + ((AVal.slotA prefixOutput.depth).toAtom output) + (tailAVals.map (·.toAtom output)).toArray), + .slotA output.depth) finalState ∧ + LowerResultSound ctx cur input output.bump .shared + (((emitPrefix ∘ emitOp (.alloc .shared cid + (prefixAVals.map (·.toAtom prefixOutput)).toArray)) ∘ + emitTail) ∘ + emitOp (.apply + ((AVal.slotA prefixOutput.depth).toAtom output) + (tailAVals.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + have hhomogeneous : LowerArgsSound ctx cur input prefixOutput + (List.replicate prefixAVals.length .shared) + emitPrefix prefixAVals := by + simpa [hprefixWorlds] using hprefixSound + have halloc : LowerResultSound ctx cur input prefixOutput.bump .shared + (emitPrefix ∘ emitOp (.alloc .shared cid + (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) := hhomogeneous.alloc_owned + have happly := applyRest_shared_verified (ctx := ctx) (cur := cur) + src fuel input prefixOutput.bump output + (emitPrefix ∘ emitOp (.alloc .shared cid + (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + emitTail (.slotA prefixOutput.depth) (args.drop n) tailAVals + middleState finalState (by simp) htailRun htailSound htailWorlds + halloc happlyContract + constructor + · simp only [knownCall] + rw [estateBindRun, hprefixRun] + simp only + rw [if_neg (Nat.not_le.mpr hover)] + exact happly.1 + · exact happly.2 + +/-- Over-applied constructor dispatch in `lowerSpine`. Only the shared world +can reach the emitted tail `apply`; unique over-application is rejected by +`applyRest`'s world guard. -/ +theorem lowerSpine_ref_ctor_overapplied_verified + {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) + (input prefixOutput output : VEnv) + (f : Ixon.Address) (tag arity : Nat) (args : List IxIR0.Expr) + (emitPrefix emitTail : Emit) (prefixAVals tailAVals : List AVal) + (state middleState finalState : LowSt) + (hsrc : src f = some (.ctor tag arity)) + (hprefixRun : + (lowerArgs src (Nat.succ fuel) input + ((args.take arity).zip + (padWorlds (List.replicate arity .shared) arity))).run state = + .ok (prefixOutput, emitPrefix, prefixAVals) middleState) + (hprefixSound : LowerArgsSound ctx cur input prefixOutput + (((args.take arity).zip + (padWorlds (List.replicate arity .shared) arity)).map Prod.snd) + emitPrefix prefixAVals) + (hprefixWorlds : + ((args.take arity).zip + (padWorlds (List.replicate arity .shared) arity)).map Prod.snd = + List.replicate prefixAVals.length .shared) + (hover : arity < args.length) + (htailRun : + (lowerArgs src fuel prefixOutput.bump + ((args.drop arity).map (fun arg => (arg, Owned.shared)))).run + middleState = + .ok (output, emitTail, tailAVals) finalState) + (htailSound : LowerArgsSound ctx cur prefixOutput.bump output + (((args.drop arity).map + (fun arg => (arg, Owned.shared))).map Prod.snd) + emitTail tailAVals) + (htailWorlds : + (((args.drop arity).map + (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate tailAVals.length .shared) + (happlyContract : ApplyOwnershipContract ctx) : + (lowerSpine src (Nat.succ (Nat.succ (Nat.succ fuel))) input .shared + (.ref f) args).run state = + .ok (output.bump, + ((emitPrefix ∘ emitOp (.alloc .shared (ctorIdOf f tag) + (prefixAVals.map (·.toAtom prefixOutput)).toArray)) ∘ + emitTail) ∘ + emitOp (.apply + ((AVal.slotA prefixOutput.depth).toAtom output) + (tailAVals.map (·.toAtom output)).toArray), + .slotA output.depth) finalState ∧ + LowerResultSound ctx cur input output.bump .shared + (((emitPrefix ∘ emitOp (.alloc .shared (ctorIdOf f tag) + (prefixAVals.map (·.toAtom prefixOutput)).toArray)) ∘ + emitTail) ∘ + emitOp (.apply + ((AVal.slotA prefixOutput.depth).toAtom output) + (tailAVals.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + have hknown := knownCall_alloc_overapplied_verified + (ctx := ctx) (cur := cur) src fuel input prefixOutput output + (ctorIdOf f tag) arity (List.replicate arity .shared) args + emitPrefix emitTail prefixAVals tailAVals state middleState finalState + hprefixRun hprefixSound hprefixWorlds hover htailRun htailSound + htailWorlds happlyContract + constructor + · simp only [lowerSpine] + rw [hsrc] + simp only + rw [if_neg (by omega)] + exact hknown.1 + · exact hknown.2 + +/-- Terminal partial-application branch of `knownCall`: all supplied shared +arguments become captures of one fresh pap node. -/ +theorem knownCall_papp_terminal_verified {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) (input output : VEnv) + (f : Ixon.Address) (d : Decl) (n : Nat) + (argWorlds : List Owned) (resultDemand : Owned) + (args : List IxIR0.Expr) (emit : Emit) (avs : List AVal) + (state finalState : LowSt) + (hargsRun : + (lowerArgs src fuel input + ((args.take n).zip (padWorlds argWorlds n))).run state = + .ok (output, emit, avs) finalState) + (hargsSound : LowerArgsSound ctx cur input output + (((args.take n).zip (padWorlds argWorlds n)).map Prod.snd) + emit avs) + (hworldsHomogeneous : + ((args.take n).zip (padWorlds argWorlds n)).map Prod.snd = + List.replicate avs.length .shared) + (hle : args.length ≤ n) + (hdecl : ctx.decls f = some d) + (hunder : avs.length < declArity d) : + (knownCall src (Nat.succ fuel) input (.papp f ·) n argWorlds + resultDemand args).run state = + .ok (output.bump, + emit ∘ emitOp (.papp f + (avs.map (·.toAtom output)).toArray), + .slotA output.depth) finalState ∧ + LowerResultSound ctx cur input output.bump .shared + (emit ∘ emitOp (.papp f + (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + constructor + · simp only [knownCall] + rw [estateBindRun, hargsRun] + simp [hle] + · have hhomogeneous : LowerArgsSound ctx cur input output + (List.replicate avs.length .shared) emit avs := by + simpa [hworldsHomogeneous] using hargsSound + exact hhomogeneous.papp_owned hdecl hunder + +/-- Terminal scalar-extern branch of `knownCall`. Successful evaluation +certifies all argument descriptors and the result scalar, so the result may +inhabit the requested world. -/ +theorem knownCall_extern_terminal_verified {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) (input output : VEnv) + (f : Ixon.Address) (n : Nat) (argWorlds : List Owned) + (resultDemand : Owned) (args : List IxIR0.Expr) + (emit : Emit) (avs : List AVal) (state finalState : LowSt) + (hargsRun : + (lowerArgs src fuel input + ((args.take n).zip (padWorlds argWorlds n))).run state = + .ok (output, emit, avs) finalState) + (hargsSound : LowerArgsSound ctx cur input output + (((args.take n).zip (padWorlds argWorlds n)).map Prod.snd) + emit avs) + (hworldsHomogeneous : + ((args.take n).zip (padWorlds argWorlds n)).map Prod.snd = + List.replicate avs.length .shared) + (hle : args.length ≤ n) : + (knownCall src (Nat.succ fuel) input (.extern f ·) n argWorlds + resultDemand args).run state = + .ok (output.bump, + emit ∘ emitOp (.extern f + (avs.map (·.toAtom output)).toArray), + .slotA output.depth) finalState ∧ + LowerResultSound ctx cur input output.bump resultDemand + (emit ∘ emitOp (.extern f + (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + constructor + · simp only [knownCall] + rw [estateBindRun, hargsRun] + simp [hle] + · have hhomogeneous : LowerArgsSound ctx cur input output + (List.replicate avs.length .shared) emit avs := by + simpa [hworldsHomogeneous] using hargsSound + exact hhomogeneous.extern_owned + +/-- Exact-saturation extern dispatch in `lowerSpine`. -/ +theorem lowerSpine_ref_extern_terminal_verified + {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) (input output : VEnv) + (world : Owned) (f : Ixon.Address) (arity : Nat) + (args : List IxIR0.Expr) (emit : Emit) (avs : List AVal) + (state finalState : LowSt) + (hsrc : src f = some (.extern arity)) + (hargsLength : args.length = arity) + (hargsRun : + (lowerArgs src fuel input + ((args.take arity).zip + (padWorlds (List.replicate arity .shared) arity))).run state = + .ok (output, emit, avs) finalState) + (hargsSound : LowerArgsSound ctx cur input output + (((args.take arity).zip + (padWorlds (List.replicate arity .shared) arity)).map Prod.snd) + emit avs) + (hworldsHomogeneous : + ((args.take arity).zip + (padWorlds (List.replicate arity .shared) arity)).map Prod.snd = + List.replicate avs.length .shared) : + (lowerSpine src (Nat.succ (Nat.succ fuel)) input world (.ref f) + args).run state = + .ok (output.bump, + emit ∘ emitOp (.extern f + (avs.map (·.toAtom output)).toArray), + .slotA output.depth) finalState ∧ + LowerResultSound ctx cur input output.bump world + (emit ∘ emitOp (.extern f + (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + have hknown := knownCall_extern_terminal_verified + (ctx := ctx) (cur := cur) src fuel input output f arity + (List.replicate arity .shared) world args emit avs state finalState + hargsRun hargsSound hworldsHomogeneous (by omega) + constructor + · simp only [lowerSpine] + rw [hsrc] + simp only + rw [if_neg (by omega)] + exact hknown.1 + · exact hknown.2 + +/-- Over-applied scalar-extern branch of `knownCall`. The scalar prefix +result is ownership-inert but may still be framed as a shared result while +the remaining arguments are lowered and passed to `apply`. -/ +theorem knownCall_extern_overapplied_verified + {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) + (input prefixOutput output : VEnv) + (f : Ixon.Address) (n : Nat) (argWorlds : List Owned) + (args : List IxIR0.Expr) + (emitPrefix emitTail : Emit) (prefixAVals tailAVals : List AVal) + (state middleState finalState : LowSt) + (hprefixRun : + (lowerArgs src (Nat.succ fuel) input + ((args.take n).zip (padWorlds argWorlds n))).run state = + .ok (prefixOutput, emitPrefix, prefixAVals) middleState) + (hprefixSound : LowerArgsSound ctx cur input prefixOutput + (((args.take n).zip (padWorlds argWorlds n)).map Prod.snd) + emitPrefix prefixAVals) + (hprefixWorlds : + ((args.take n).zip (padWorlds argWorlds n)).map Prod.snd = + List.replicate prefixAVals.length .shared) + (hover : n < args.length) + (htailRun : + (lowerArgs src fuel prefixOutput.bump + ((args.drop n).map (fun arg => (arg, Owned.shared)))).run + middleState = + .ok (output, emitTail, tailAVals) finalState) + (htailSound : LowerArgsSound ctx cur prefixOutput.bump output + (((args.drop n).map (fun arg => (arg, Owned.shared))).map Prod.snd) + emitTail tailAVals) + (htailWorlds : + (((args.drop n).map (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate tailAVals.length .shared) + (happlyContract : ApplyOwnershipContract ctx) : + (knownCall src (Nat.succ (Nat.succ fuel)) input (.extern f ·) n + argWorlds .shared args).run state = + .ok (output.bump, + ((emitPrefix ∘ emitOp (.extern f + (prefixAVals.map (·.toAtom prefixOutput)).toArray)) ∘ + emitTail) ∘ + emitOp (.apply + ((AVal.slotA prefixOutput.depth).toAtom output) + (tailAVals.map (·.toAtom output)).toArray), + .slotA output.depth) finalState ∧ + LowerResultSound ctx cur input output.bump .shared + (((emitPrefix ∘ emitOp (.extern f + (prefixAVals.map (·.toAtom prefixOutput)).toArray)) ∘ + emitTail) ∘ + emitOp (.apply + ((AVal.slotA prefixOutput.depth).toAtom output) + (tailAVals.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + have hhomogeneous : LowerArgsSound ctx cur input prefixOutput + (List.replicate prefixAVals.length .shared) + emitPrefix prefixAVals := by + simpa [hprefixWorlds] using hprefixSound + have hextern : LowerResultSound ctx cur input prefixOutput.bump .shared + (emitPrefix ∘ emitOp (.extern f + (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + (.slotA prefixOutput.depth) := hhomogeneous.extern_owned + have happly := applyRest_shared_verified (ctx := ctx) (cur := cur) + src fuel input prefixOutput.bump output + (emitPrefix ∘ emitOp (.extern f + (prefixAVals.map (·.toAtom prefixOutput)).toArray)) + emitTail (.slotA prefixOutput.depth) (args.drop n) tailAVals + middleState finalState (by simp) htailRun htailSound htailWorlds + hextern happlyContract + constructor + · simp only [knownCall] + rw [estateBindRun, hprefixRun] + simp only + rw [if_neg (Nat.not_le.mpr hover)] + exact happly.1 + · exact happly.2 + +/-- Over-applied extern dispatch in `lowerSpine`, pairing the saturated +scalar oracle prefix with the emitted tail `apply`. -/ +theorem lowerSpine_ref_extern_overapplied_verified + {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) + (input prefixOutput output : VEnv) + (f : Ixon.Address) (arity : Nat) (args : List IxIR0.Expr) + (emitPrefix emitTail : Emit) (prefixAVals tailAVals : List AVal) + (state middleState finalState : LowSt) + (hsrc : src f = some (.extern arity)) + (hprefixRun : + (lowerArgs src (Nat.succ fuel) input + ((args.take arity).zip + (padWorlds (List.replicate arity .shared) arity))).run state = + .ok (prefixOutput, emitPrefix, prefixAVals) middleState) + (hprefixSound : LowerArgsSound ctx cur input prefixOutput + (((args.take arity).zip + (padWorlds (List.replicate arity .shared) arity)).map Prod.snd) + emitPrefix prefixAVals) + (hprefixWorlds : + ((args.take arity).zip + (padWorlds (List.replicate arity .shared) arity)).map Prod.snd = + List.replicate prefixAVals.length .shared) + (hover : arity < args.length) + (htailRun : + (lowerArgs src fuel prefixOutput.bump + ((args.drop arity).map (fun arg => (arg, Owned.shared)))).run + middleState = + .ok (output, emitTail, tailAVals) finalState) + (htailSound : LowerArgsSound ctx cur prefixOutput.bump output + (((args.drop arity).map + (fun arg => (arg, Owned.shared))).map Prod.snd) + emitTail tailAVals) + (htailWorlds : + (((args.drop arity).map + (fun arg => (arg, Owned.shared))).map Prod.snd) = + List.replicate tailAVals.length .shared) + (happlyContract : ApplyOwnershipContract ctx) : + (lowerSpine src (Nat.succ (Nat.succ (Nat.succ fuel))) input .shared + (.ref f) args).run state = + .ok (output.bump, + ((emitPrefix ∘ emitOp (.extern f + (prefixAVals.map (·.toAtom prefixOutput)).toArray)) ∘ + emitTail) ∘ + emitOp (.apply + ((AVal.slotA prefixOutput.depth).toAtom output) + (tailAVals.map (·.toAtom output)).toArray), + .slotA output.depth) finalState ∧ + LowerResultSound ctx cur input output.bump .shared + (((emitPrefix ∘ emitOp (.extern f + (prefixAVals.map (·.toAtom prefixOutput)).toArray)) ∘ + emitTail) ∘ + emitOp (.apply + ((AVal.slotA prefixOutput.depth).toAtom output) + (tailAVals.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + have hknown := knownCall_extern_overapplied_verified + (ctx := ctx) (cur := cur) src fuel input prefixOutput output f arity + (List.replicate arity .shared) args emitPrefix emitTail prefixAVals + tailAVals state middleState finalState hprefixRun hprefixSound + hprefixWorlds hover htailRun htailSound htailWorlds happlyContract + constructor + · simp only [lowerSpine] + rw [hsrc] + simp only + rw [if_neg (by omega)] + exact hknown.1 + · exact hknown.2 + +/-- Under-applied all-`many` definition dispatch in `lowerSpine`. The source +checks select `papp`; target arity agreement establishes that the emitted +capture prefix is strictly under-saturating. -/ +theorem lowerSpine_ref_def_partial_verified {ctx : Ctx} {cur d : FnDef} + (src : IxIR0.Env) (fuel : Nat) (input output : VEnv) + (f : Ixon.Address) (body : IxIR0.Expr) (args : List IxIR0.Expr) + (emit : Emit) (avs : List AVal) (state finalState : LowSt) + (hsrc : src f = some (.defn .shared body)) + (hunderSource : args.length < lamArity body) + (hpapSafe : papSafe body = true) + (hargsRun : + (lowerArgs src fuel input + ((args.take args.length).zip + (padWorlds (List.replicate args.length .shared) + args.length))).run state = + .ok (output, emit, avs) finalState) + (hargsSound : LowerArgsSound ctx cur input output + (((args.take args.length).zip + (padWorlds (List.replicate args.length .shared) + args.length)).map Prod.snd) + emit avs) + (hworldsHomogeneous : + ((args.take args.length).zip + (padWorlds (List.replicate args.length .shared) + args.length)).map Prod.snd = + List.replicate avs.length .shared) + (hdecl : ctx.decls f = some (.fn d)) + (harity : d.arity = lamArity body) : + (lowerSpine src (Nat.succ (Nat.succ fuel)) input .shared (.ref f) + args).run state = + .ok (output.bump, + emit ∘ emitOp (.papp f + (avs.map (·.toAtom output)).toArray), + .slotA output.depth) finalState ∧ + LowerResultSound ctx cur input output.bump .shared + (emit ∘ emitOp (.papp f + (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + have havsLength : avs.length = args.length := by + have hlength := congrArg List.length hworldsHomogeneous + simp [padWorlds] at hlength + omega + have hunderTarget : avs.length < declArity (.fn d) := by + simp only [declArity] + omega + have hknown := knownCall_papp_terminal_verified + (ctx := ctx) (cur := cur) src fuel input output f (.fn d) + args.length (List.replicate args.length .shared) .shared args emit avs + state finalState hargsRun hargsSound hworldsHomogeneous + (Nat.le_refl _) hdecl hunderTarget + constructor + · simp only [lowerSpine] + rw [hsrc] + simp [hunderSource, hpapSafe] + exact hknown.1 + · exact hknown.2 + +/-- Under-applied recursor dispatch shares the same pap ownership rule. The +target declaration's arity is tied to the source recursor firing arity. -/ +theorem lowerSpine_ref_recursor_partial_verified + {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) (input output : VEnv) + (f : Ixon.Address) (numArgs : Nat) (natLit : Bool) + (rules : Array IxIR0.RecRule) (targetDecl : Decl) + (args : List IxIR0.Expr) (emit : Emit) (avs : List AVal) + (state finalState : LowSt) + (hsrc : src f = some (.recursor numArgs natLit rules)) + (hunderSource : args.length < numArgs + 1) + (hargsRun : + (lowerArgs src fuel input + ((args.take args.length).zip + (padWorlds (List.replicate args.length .shared) + args.length))).run state = + .ok (output, emit, avs) finalState) + (hargsSound : LowerArgsSound ctx cur input output + (((args.take args.length).zip + (padWorlds (List.replicate args.length .shared) + args.length)).map Prod.snd) + emit avs) + (hworldsHomogeneous : + ((args.take args.length).zip + (padWorlds (List.replicate args.length .shared) + args.length)).map Prod.snd = + List.replicate avs.length .shared) + (hdecl : ctx.decls f = some targetDecl) + (harity : declArity targetDecl = numArgs + 1) : + (lowerSpine src (Nat.succ (Nat.succ fuel)) input .shared (.ref f) + args).run state = + .ok (output.bump, + emit ∘ emitOp (.papp f + (avs.map (·.toAtom output)).toArray), + .slotA output.depth) finalState ∧ + LowerResultSound ctx cur input output.bump .shared + (emit ∘ emitOp (.papp f + (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + have havsLength : avs.length = args.length := by + have hlength := congrArg List.length hworldsHomogeneous + simp [padWorlds] at hlength + omega + have hunderTarget : avs.length < declArity targetDecl := by omega + have hknown := knownCall_papp_terminal_verified + (ctx := ctx) (cur := cur) src fuel input output f targetDecl + args.length (List.replicate args.length .shared) .shared args emit avs + state finalState hargsRun hargsSound hworldsHomogeneous + (Nat.le_refl _) hdecl hunderTarget + constructor + · simp only [lowerSpine] + rw [hsrc] + simp [hunderSource] + exact hknown.1 + · exact hknown.2 + +/-- Under-applied extern dispatch also builds a shared pap; no oracle call is +made until later saturation. -/ +theorem lowerSpine_ref_extern_partial_verified + {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) (input output : VEnv) + (f : Ixon.Address) (arity : Nat) (args : List IxIR0.Expr) + (emit : Emit) (avs : List AVal) (state finalState : LowSt) + (hsrc : src f = some (.extern arity)) + (hunderSource : args.length < arity) + (hargsRun : + (lowerArgs src fuel input + ((args.take args.length).zip + (padWorlds (List.replicate args.length .shared) + args.length))).run state = + .ok (output, emit, avs) finalState) + (hargsSound : LowerArgsSound ctx cur input output + (((args.take args.length).zip + (padWorlds (List.replicate args.length .shared) + args.length)).map Prod.snd) + emit avs) + (hworldsHomogeneous : + ((args.take args.length).zip + (padWorlds (List.replicate args.length .shared) + args.length)).map Prod.snd = + List.replicate avs.length .shared) + (hdecl : ctx.decls f = some (.extern arity)) : + (lowerSpine src (Nat.succ (Nat.succ fuel)) input .shared (.ref f) + args).run state = + .ok (output.bump, + emit ∘ emitOp (.papp f + (avs.map (·.toAtom output)).toArray), + .slotA output.depth) finalState ∧ + LowerResultSound ctx cur input output.bump .shared + (emit ∘ emitOp (.papp f + (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + have havsLength : avs.length = args.length := by + have hlength := congrArg List.length hworldsHomogeneous + simp [padWorlds] at hlength + omega + have hunderTarget : avs.length < declArity (.extern arity) := by + simp only [declArity] + omega + have hknown := knownCall_papp_terminal_verified + (ctx := ctx) (cur := cur) src fuel input output f (.extern arity) + args.length (List.replicate args.length .shared) .shared args emit avs + state finalState hargsRun hargsSound hworldsHomogeneous + (Nat.le_refl _) hdecl hunderTarget + constructor + · simp only [lowerSpine] + rw [hsrc] + simp [hunderSource] + exact hknown.1 + · exact hknown.2 + +/-- Under-applied constructor dispatch, including the stateful eta-wrapper +lookup/creation step. The eventual whole-program proof supplies the generated +wrapper declaration in `ctx`; its arity makes the following `papp` strictly +under-saturated. -/ +theorem lowerSpine_ref_ctor_partial_verified + {ctx : Ctx} {cur wrapperDef : FnDef} + (src : IxIR0.Env) (fuel : Nat) (input output : VEnv) + (f wrapper : Ixon.Address) (tag arity : Nat) + (args : List IxIR0.Expr) (emit : Emit) (avs : List AVal) + (state wrapperState finalState : LowSt) + (hsrc : src f = some (.ctor tag arity)) + (hunderSource : args.length < arity) + (hwrapperRun : (wrapperFor f tag arity).run state = + .ok wrapper wrapperState) + (hargsRun : + (lowerArgs src fuel input + ((args.take args.length).zip + (padWorlds (List.replicate args.length .shared) + args.length))).run wrapperState = + .ok (output, emit, avs) finalState) + (hargsSound : LowerArgsSound ctx cur input output + (((args.take args.length).zip + (padWorlds (List.replicate args.length .shared) + args.length)).map Prod.snd) + emit avs) + (hworldsHomogeneous : + ((args.take args.length).zip + (padWorlds (List.replicate args.length .shared) + args.length)).map Prod.snd = + List.replicate avs.length .shared) + (hdecl : ctx.decls wrapper = some (.fn wrapperDef)) + (harity : wrapperDef.arity = arity) : + (lowerSpine src (Nat.succ (Nat.succ fuel)) input .shared (.ref f) + args).run state = + .ok (output.bump, + emit ∘ emitOp (.papp wrapper + (avs.map (·.toAtom output)).toArray), + .slotA output.depth) finalState ∧ + LowerResultSound ctx cur input output.bump .shared + (emit ∘ emitOp (.papp wrapper + (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + have havsLength : avs.length = args.length := by + have hlength := congrArg List.length hworldsHomogeneous + simp [padWorlds] at hlength + omega + have hunderTarget : avs.length < declArity (.fn wrapperDef) := by + simp only [declArity] + omega + have hknown := knownCall_papp_terminal_verified + (ctx := ctx) (cur := cur) src fuel input output wrapper + (.fn wrapperDef) args.length (List.replicate args.length .shared) + .shared args emit avs wrapperState finalState hargsRun hargsSound + hworldsHomogeneous (Nat.le_refl _) hdecl hunderTarget + constructor + · simp only [lowerSpine] + rw [hsrc] + simp only + rw [if_pos hunderSource] + rw [if_neg (by decide)] + rw [estateBindRun, hwrapperRun] + exact hknown.1 + · exact hknown.2 + +/-- Exact-saturation constructor dispatch in `lowerSpine`, including its +whole-value field-world telescope and concrete constructor identity. -/ +theorem lowerSpine_ref_ctor_terminal_verified {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) (input output : VEnv) + (world : Owned) (f : Ixon.Address) (tag arity : Nat) + (args : List IxIR0.Expr) (emit : Emit) (avs : List AVal) + (state finalState : LowSt) + (hsrc : src f = some (.ctor tag arity)) + (hargsLength : args.length = arity) + (hargsRun : + (lowerArgs src fuel input + ((args.take arity).zip + (padWorlds (List.replicate arity world) arity))).run state = + .ok (output, emit, avs) finalState) + (hargsSound : LowerArgsSound ctx cur input output + (((args.take arity).zip + (padWorlds (List.replicate arity world) arity)).map Prod.snd) + emit avs) + (hworldsHomogeneous : + ((args.take arity).zip + (padWorlds (List.replicate arity world) arity)).map Prod.snd = + List.replicate avs.length world) : + (lowerSpine src (Nat.succ (Nat.succ fuel)) input world (.ref f) + args).run state = + .ok (output.bump, + emit ∘ emitOp (.alloc world (ctorIdOf f tag) + (avs.map (·.toAtom output)).toArray), + .slotA output.depth) finalState ∧ + LowerResultSound ctx cur input output.bump world + (emit ∘ emitOp (.alloc world (ctorIdOf f tag) + (avs.map (·.toAtom output)).toArray)) + (.slotA output.depth) := by + have hknown := knownCall_alloc_terminal_verified + (ctx := ctx) (cur := cur) src fuel input output world + (ctorIdOf f tag) arity (List.replicate arity world) world args + emit avs state finalState hargsRun hargsSound hworldsHomogeneous + (by omega) + constructor + · simp only [lowerSpine] + rw [hsrc] + simp only + rw [if_neg (by omega)] + exact hknown.1 + · exact hknown.2 + +/-- The executable compiler equations for the first two induction cases, +paired with their semantic proofs. -/ +theorem lowerE_lit_verified {ctx : Ctx} {cur : FnDef} (src : IxIR0.Env) + (fuel : Nat) (Γ : VEnv) (world : Owned) (literal : IxIR0.Literal) + (state : LowSt) : + (lowerE src (Nat.succ fuel) Γ world (.lit literal)).run state = + .ok (Γ, (_root_.id : Emit), .constA (.lit literal)) state ∧ + LowerResultSound ctx cur Γ Γ world (_root_.id : Emit) + (.constA (.lit literal)) := by + constructor + · simp [lowerE] + · exact lower_lit_sound + +theorem lowerE_lit_verified_below {ctx : Ctx} {cur : FnDef} + {limit : Nat} (src : IxIR0.Env) (fuel : Nat) (Γ : VEnv) + (world : Owned) (literal : IxIR0.Literal) (state : LowSt) : + (lowerE src (Nat.succ fuel) Γ world (.lit literal)).run state = + .ok (Γ, (_root_.id : Emit), .constA (.lit literal)) state ∧ + LowerResultSoundBelow ctx cur limit Γ Γ world (_root_.id : Emit) + (.constA (.lit literal)) := by + constructor + · simp [lowerE] + · exact lower_lit_sound_below + +theorem lowerE_erased_verified {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) (Γ : VEnv) (world : Owned) + (state : LowSt) : + (lowerE src (Nat.succ fuel) Γ world .erased).run state = + .ok (Γ, (_root_.id : Emit), .constA .erased) state ∧ + LowerResultSound ctx cur Γ Γ world (_root_.id : Emit) + (.constA .erased) := by + constructor + · simp [lowerE] + · exact lower_erased_sound + +theorem lowerE_erased_verified_below {ctx : Ctx} {cur : FnDef} + {limit : Nat} (src : IxIR0.Env) (fuel : Nat) (Γ : VEnv) + (world : Owned) (state : LowSt) : + (lowerE src (Nat.succ fuel) Γ world .erased).run state = + .ok (Γ, (_root_.id : Emit), .constA .erased) state ∧ + LowerResultSoundBelow ctx cur limit Γ Γ world (_root_.id : Emit) + (.constA .erased) := by + constructor + · simp [lowerE] + · exact lower_erased_sound_below + +/-- The executable final-use branch and its generic semantic move theorem. -/ +theorem lowerE_var_move_verified {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) (Γ : VEnv) (i abs : Nat) + (uses : Uses) (state : LowSt) + (hentry : Γ.entries[i]? = some (.slot abs 1 uses true)) : + (lowerE src (Nat.succ fuel) Γ (worldOfUses uses) (.var i)).run state = + .ok (Γ.setEntry i (.slot abs 0 uses false), + (_root_.id : Emit), .slotA abs) state ∧ + LowerResultSound ctx cur Γ + (Γ.setEntry i (.slot abs 0 uses false)) (worldOfUses uses) + (_root_.id : Emit) (.slotA abs) := by + constructor + · have hshared : (Owned.shared != Owned.shared) = false := by decide + have hunique : (Owned.unique != Owned.unique) = false := by decide + cases uses <;> + simp [lowerE, hentry, worldOfUses, hshared, hunique] + · exact lower_var_move_sound hentry + +theorem lowerE_var_move_verified_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} + (src : IxIR0.Env) (fuel : Nat) (Γ : VEnv) (i abs : Nat) + (uses : Uses) (state : LowSt) + (hentry : Γ.entries[i]? = some (.slot abs 1 uses true)) : + (lowerE src (Nat.succ fuel) Γ (worldOfUses uses) (.var i)).run state = + .ok (Γ.setEntry i (.slot abs 0 uses false), + (_root_.id : Emit), .slotA abs) state ∧ + LowerResultSoundBelow ctx cur limit Γ + (Γ.setEntry i (.slot abs 0 uses false)) (worldOfUses uses) + (_root_.id : Emit) (.slotA abs) := by + constructor + · have hshared : (Owned.shared != Owned.shared) = false := by decide + have hunique : (Owned.unique != Owned.unique) = false := by decide + cases uses <;> + simp [lowerE, hentry, worldOfUses, hshared, hunique] + · exact lower_var_move_sound_below hentry + +/-- The executable shared-dup branch and its exact retain proof. -/ +theorem lowerE_var_many_dup_verified {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) (Γ : VEnv) (i abs remaining : Nat) + (state : LowSt) + (hentry : Γ.entries[i]? = + some (.slot abs (Nat.succ (Nat.succ remaining)) .many true)) : + let Γ' := Γ.setEntry i (.slot abs (Nat.succ remaining) .many true) + (lowerE src (Nat.succ fuel) Γ .shared (.var i)).run state = + .ok (Γ'.bump, emitOp (.dup (.var (Γ'.rel abs))), + .slotA Γ'.depth) state ∧ + LowerResultSound ctx cur Γ Γ'.bump .shared + (emitOp (.dup (.var (Γ'.rel abs)))) (.slotA Γ'.depth) := by + dsimp only + constructor + · have hsame : (Owned.shared != Owned.shared) = false := by decide + have hunique : (Owned.shared == Owned.unique) = false := by decide + simp [lowerE, hentry, worldOfUses, hsame, hunique] + · exact lower_var_many_dup_sound hentry + +theorem lowerE_var_many_dup_verified_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} + (src : IxIR0.Env) (fuel : Nat) (Γ : VEnv) + (i abs remaining : Nat) (state : LowSt) + (hentry : Γ.entries[i]? = + some (.slot abs (Nat.succ (Nat.succ remaining)) .many true)) : + let Γ' := Γ.setEntry i (.slot abs (Nat.succ remaining) .many true) + (lowerE src (Nat.succ fuel) Γ .shared (.var i)).run state = + .ok (Γ'.bump, emitOp (.dup (.var (Γ'.rel abs))), + .slotA Γ'.depth) state ∧ + LowerResultSoundBelow ctx cur limit Γ Γ'.bump .shared + (emitOp (.dup (.var (Γ'.rel abs)))) (.slotA Γ'.depth) := by + dsimp only + constructor + · have hsame : (Owned.shared != Owned.shared) = false := by decide + have hunique : (Owned.shared == Owned.unique) = false := by decide + simp [lowerE, hentry, worldOfUses, hsame, hunique] + · exact lower_var_many_dup_sound_below hentry + +/-- Executable lowering and semantic ownership agree for the first +nontrivial `let`/variable derivation. -/ +theorem lowerE_let_lit_var_verified {ctx : Ctx} {cur : FnDef} + (src : IxIR0.Env) (fuel : Nat) (Γ : VEnv) (literal : IxIR0.Literal) + (state : LowSt) : + (lowerE src (Nat.succ (Nat.succ fuel)) Γ .shared + (.letE .many (.lit literal) (.var 0))).run state = + .ok (Γ.bump, emitOp (.pure (.lit literal)), .slotA Γ.depth) state ∧ + LowerResultSound ctx cur Γ Γ.bump .shared + (emitOp (.pure (.lit literal))) (.slotA Γ.depth) := by + constructor + · have hsame : (Owned.shared != Owned.shared) = false := by decide + simp [lowerE, countUses, worldOfUses, VEnv.bump, VEnv.pop, + VEnv.setEntry, Function.comp_def, hsame] + · exact lower_let_lit_var_sound + +/-- A non-head linear entry exercises root extraction and permutation: the +preceding shared source root remains in the environment while the selected +unique root becomes the expression result. -/ +theorem fixture_nonhead_unique_move_sound {ctx : Ctx} {cur : FnDef} : + let Γ : VEnv := + ⟨[.slot 1 1 .many true, .slot 0 1 .linear true], 2⟩ + LowerResultSound ctx cur Γ + (Γ.setEntry 1 (.slot 0 0 .linear false)) .unique + (_root_.id : Emit) (.slotA 0) := by + dsimp only + apply lower_var_move_sound + rfl + +/-- Two argument expressions each push a runtime slot. The cons proof keeps +the first absolute slot protected while the second push changes its relative +index, then realizes both descriptors in source order. -/ +theorem fixture_two_pushed_args_sound {ctx : Ctx} {cur : FnDef} + {Γ : VEnv} {first second : IxIR0.Literal} : + LowerArgsSound ctx cur Γ Γ.bump.bump [.shared, .shared] + (emitOp (.pure (.lit first)) ∘ emitOp (.pure (.lit second))) + [.slotA Γ.depth, .slotA Γ.bump.depth] := by + exact (lower_let_lit_var_sound (ctx := ctx) (cur := cur) + (Γ := Γ) (literal := first)).consArgs + ((lower_let_lit_var_sound (ctx := ctx) (cur := cur) + (Γ := Γ.bump) (literal := second)).consArgs + (lowerArgs_nil_sound (ctx := ctx) (cur := cur) (Γ := Γ.bump.bump))) + +/-- The two protected argument slots become fields of one shared +constructor, leaving exactly the fresh node as the expression result. -/ +theorem fixture_two_pushed_alloc_sound {ctx : Ctx} {cur : FnDef} + {Γ : VEnv} {first second : IxIR0.Literal} {cid : CtorId} : + LowerResultSound ctx cur Γ Γ.bump.bump.bump .shared + ((emitOp (.pure (.lit first)) ∘ emitOp (.pure (.lit second))) ∘ + emitOp (.alloc .shared cid + (([AVal.slotA Γ.depth, AVal.slotA Γ.bump.depth] : List AVal).map + (·.toAtom Γ.bump.bump)).toArray)) + (.slotA Γ.bump.bump.depth) := by + exact (fixture_two_pushed_args_sound (ctx := ctx) (cur := cur) + (Γ := Γ) (first := first) (second := second)).alloc_owned + +/-- The same protected two-argument prefix becomes the captures of a fresh +shared pap when the target declaration still expects more arguments. -/ +theorem fixture_two_pushed_papp_sound {ctx : Ctx} {cur : FnDef} + {Γ : VEnv} {first second : IxIR0.Literal} + {f : Ixon.Address} {d : Decl} + (hdecl : ctx.decls f = some d) + (hunder : 2 < declArity d) : + LowerResultSound ctx cur Γ Γ.bump.bump.bump .shared + ((emitOp (.pure (.lit first)) ∘ emitOp (.pure (.lit second))) ∘ + emitOp (.papp f + (([AVal.slotA Γ.depth, AVal.slotA Γ.bump.depth] : List AVal).map + (·.toAtom Γ.bump.bump)).toArray)) + (.slotA Γ.bump.bump.depth) := by + have hargs : LowerArgsSound ctx cur Γ Γ.bump.bump + (List.replicate + ([AVal.slotA Γ.depth, AVal.slotA Γ.bump.depth] : List AVal).length + .shared) + (emitOp (.pure (.lit first)) ∘ emitOp (.pure (.lit second))) + [AVal.slotA Γ.depth, AVal.slotA Γ.bump.depth] := by + simpa using (fixture_two_pushed_args_sound (ctx := ctx) (cur := cur) + (Γ := Γ) (first := first) (second := second)) + exact hargs.papp_owned hdecl (by simpa using hunder) + +/-- A scalar extern consumes the same two shared argument owners on every +successful run and returns an ownership-inert scalar at either result world. -/ +theorem fixture_two_pushed_extern_sound {ctx : Ctx} {cur : FnDef} + {Γ : VEnv} {world : Owned} {first second : IxIR0.Literal} + {f : Ixon.Address} : + LowerResultSound ctx cur Γ Γ.bump.bump.bump world + ((emitOp (.pure (.lit first)) ∘ emitOp (.pure (.lit second))) ∘ + emitOp (.extern f + (([AVal.slotA Γ.depth, AVal.slotA Γ.bump.depth] : List AVal).map + (·.toAtom Γ.bump.bump)).toArray)) + (.slotA Γ.bump.bump.depth) := by + have hargs : LowerArgsSound ctx cur Γ Γ.bump.bump + (List.replicate + ([AVal.slotA Γ.depth, AVal.slotA Γ.bump.depth] : List AVal).length + .shared) + (emitOp (.pure (.lit first)) ∘ emitOp (.pure (.lit second))) + [AVal.slotA Γ.depth, AVal.slotA Γ.bump.depth] := by + simpa using (fixture_two_pushed_args_sound (ctx := ctx) (cur := cur) + (Γ := Γ) (first := first) (second := second)) + exact hargs.extern_owned + +/-- The direct-call dual: an abstract two-shared-argument contract consumes +both protected roots and supplies the declaration's result root. -/ +theorem fixture_two_pushed_call_sound {ctx : Ctx} {cur d : FnDef} + {Γ : VEnv} {first second : IxIR0.Literal} {f : Ixon.Address} + (hdecl : ctx.decls f = some (.fn d)) + (hcontract : FnOwnershipContract ctx d [.shared, .shared]) : + LowerResultSound ctx cur Γ Γ.bump.bump.bump d.result + ((emitOp (.pure (.lit first)) ∘ emitOp (.pure (.lit second))) ∘ + emitOp (.call f + (([AVal.slotA Γ.depth, AVal.slotA Γ.bump.depth] : List AVal).map + (·.toAtom Γ.bump.bump)).toArray)) + (.slotA Γ.bump.bump.depth) := by + exact (fixture_two_pushed_args_sound (ctx := ctx) (cur := cur) + (Γ := Γ) (first := first) (second := second)).call_owned + hdecl hcontract + +/-- A previously produced shared function survives both argument pushes; +the final `apply` consumes that function root and both argument roots and +returns one fresh shared result root. -/ +theorem fixture_two_pushed_apply_sound {ctx : Ctx} {cur : FnDef} + {start Γ : VEnv} {emitFunction : Emit} {function : AVal} + {first second : IxIR0.Literal} + (hfunction : LowerResultSound ctx cur start Γ .shared + emitFunction function) + (hcontract : ApplyOwnershipContract ctx) : + LowerResultSound ctx cur start Γ.bump.bump.bump .shared + ((emitFunction ∘ + (emitOp (.pure (.lit first)) ∘ emitOp (.pure (.lit second)))) ∘ + emitOp (.apply (function.toAtom Γ.bump.bump) + (([AVal.slotA Γ.depth, AVal.slotA Γ.bump.depth] : List AVal).map + (·.toAtom Γ.bump.bump)).toArray)) + (.slotA Γ.bump.bump.depth) := by + exact hfunction.applyArgs + (fixture_two_pushed_args_sound (ctx := ctx) (cur := cur) + (Γ := Γ) (first := first) (second := second)) + hcontract + +/-- `releaseAll` drops both slot-backed arguments in order. Each drop pushes +an inert slot, so both absolute arguments resolve at relative index one when +their respective operation is emitted. -/ +theorem fixture_two_pushed_releaseAll_eq {Γ : VEnv} : + releaseAll Γ.bump.bump + [AVal.slotA Γ.depth, AVal.slotA Γ.bump.depth] = + (Γ.bump.bump.bump.bump, + emitOp (.drop (.var (Γ.bump.bump.rel Γ.depth))) ∘ + emitOp (.drop (.var (Γ.bump.bump.bump.rel Γ.bump.depth)))) := by + rfl + +/-- Erased application evaluates the same two pushing arguments, consumes +both resulting shared owners via `releaseAll`, and leaves only the erased +scalar result. -/ +theorem fixture_two_pushed_erased_release_sound + {ctx : Ctx} {cur : FnDef} {Γ : VEnv} + {world : Owned} {first second : IxIR0.Literal} : + LowerResultSound ctx cur Γ Γ.bump.bump.bump.bump world + (((_root_.id : Emit) ∘ + (emitOp (.pure (.lit first)) ∘ emitOp (.pure (.lit second)))) ∘ + (emitOp (.drop (.var (Γ.bump.bump.rel Γ.depth))) ∘ + emitOp (.drop (.var (Γ.bump.bump.bump.rel Γ.bump.depth))))) + (.constA .erased) := by + have hargs : LowerArgsSound ctx cur Γ Γ.bump.bump + (List.replicate + ([AVal.slotA Γ.depth, AVal.slotA Γ.bump.depth] : List AVal).length + .shared) + (emitOp (.pure (.lit first)) ∘ emitOp (.pure (.lit second))) + [AVal.slotA Γ.depth, AVal.slotA Γ.bump.depth] := by + simpa using (fixture_two_pushed_args_sound (ctx := ctx) (cur := cur) + (Γ := Γ) (first := first) (second := second)) + have hsound := (lower_erased_sound (ctx := ctx) (cur := cur) + (Γ := Γ) (world := .shared)).discardArgs + (resultWorld := world) hargs + rw [fixture_two_pushed_releaseAll_eq] at hsound + exact hsound + +/-- Closed proof fixture for the exact code emitted by +`let many x := literal; x`. -/ +theorem fixture_closed_let_lit_owned {ctx : Ctx} {cur : FnDef} + {literal : IxIR0.Literal} : + CodeOwns ctx cur (OwnsVEnv ⟨[], 0⟩ []) + (fun store value => + RootOwnership store [⟨Owned.shared, value⟩]) + (.letOp (.pure (.lit literal)) (.ret (.var 0))) := by + let Γ₀ : VEnv := ⟨[], 0⟩ + have h : CodeOwns ctx cur (OwnsVEnv Γ₀ []) + (fun store value => + RootOwnership store (⟨Owned.shared, value⟩ :: [])) + ((emitOp (.pure (.lit literal))) + (.ret ((AVal.slotA Γ₀.depth).toAtom Γ₀.bump))) := + LowerResultSound.close + (lower_let_lit_var_sound (ctx := ctx) (cur := cur) + (Γ := Γ₀) (literal := literal)) + EntriesReleased.nil [] + change CodeOwns ctx cur (OwnsVEnv Γ₀ []) + (fun store value => + RootOwnership store (⟨Owned.shared, value⟩ :: [])) + ((emitOp (.pure (.lit literal))) + (.ret ((AVal.slotA Γ₀.depth).toAtom Γ₀.bump))) + exact h + +/-- Generated releases handle several dead parameters in canonical +inner-to-outer order, mixing shared `drop` with affine `dropU`. -/ +theorem parameterDrops_mixed_generated_verified {ctx : Ctx} {cur : FnDef} + (state : LowSt) : + ∃ output emit, + (releaseSlots + ⟨parameterEntries 0 [.many, .affine, .many] (fun _ => 0), 3⟩ + (parameterDrops 0 [.many, .affine, .many] (fun _ => 0))).run state = + .ok (output, emit) state ∧ + ReleaseSlotsSound ctx cur + ⟨parameterEntries 0 [.many, .affine, .many] (fun _ => 0), 3⟩ + output emit := by + exact parameterDrops_verified (ctx := ctx) (cur := cur) + 0 [.many, .affine, .many] (fun _ => 0) state + (by simp [ParameterDropsAdmissible]) + +/-- A declaration-level generated-release fixture: three unused parameters +mix shared and affine ownership, while the scalar body leaves every entry +released and therefore yields a callable contract. -/ +theorem lowerDecl_all_dead_mixed_generated_verified {ctx : Ctx} + (src : IxIR0.Env) (fuel : Nat) (address : Ixon.Address) + (literal : IxIR0.Literal) (state : LowSt) : + let sourceBody : IxIR0.Expr := + .lam .many (.lam .affine (.lam .many (.lit literal))) + ∃ finalState d, + (lowerDecl src (Nat.succ (Nat.succ fuel)) + (address, .defn .shared sourceBody)).run state = + .ok (some (address, .fn d)) finalState ∧ + FnOwnershipContract ctx d [.shared, .unique, .shared] := by + dsimp only + apply lowerDecl_defn_generated_verified (ctx := ctx) + src (Nat.succ fuel) address .shared + (.lam .many (.lam .affine (.lam .many (.lit literal)))) state + · simp [ParameterDropsAdmissible, lamUses, stripLams, countUses] + · intro middle releaseEmit hrelease + simp [releaseSlots, parameterEntries, parameterDrops, lamUses, + stripLams, lamArity, countUses, VEnv.rel, VEnv.setEntry, + VEnv.bump, Function.comp_def] at hrelease + obtain ⟨hmiddle, hemit⟩ := hrelease + have hreleased : EntriesReleased middle.entries := by + rw [← hmiddle] + exact EntriesReleased.slot + (EntriesReleased.slot (EntriesReleased.slot EntriesReleased.nil)) + refine ⟨middle, (_root_.id : Emit), .constA (.lit literal), state, + ?_, ?_, ?_⟩ + · exact (lowerE_lit_verified (ctx := ctx) + (cur := ⟨3, .shared, false, + (releaseEmit ∘ (_root_.id : Emit)) (.ret (.lit literal))⟩) + src fuel middle .shared literal state).1 + · exact (lowerE_lit_verified (ctx := ctx) + (cur := ⟨3, .shared, false, + (releaseEmit ∘ (_root_.id : Emit)) (.ret (.lit literal))⟩) + src fuel middle .shared literal state).2 + · exact hreleased + +/-- `lowerFnBody` and the contract constructor agree on the smallest real +function body: a single parameter used exactly once. This covers both shared +and unique parameter worlds through `worldOfUses`. -/ +theorem lowerFnBody_single_var_verified {ctx : Ctx} + (src : IxIR0.Env) (fuel : Nat) (uses : Uses) (state : LowSt) : + let input : VEnv := ⟨[.slot 0 1 uses true], 1⟩ + let d : FnDef := + ⟨1, worldOfUses uses, false, .ret (.var 0)⟩ + (lowerFnBody src (Nat.succ (Nat.succ fuel)) input [] + (worldOfUses uses) (.var 0)).run state = + .ok d.body state ∧ + FnOwnershipContract ctx d [worldOfUses uses] := by + dsimp only + constructor + · have hsame : (worldOfUses uses != worldOfUses uses) = false := by + cases uses <;> decide + simp [lowerFnBody, releaseSlots, lowerE, hsame, VEnv.setEntry, + VEnv.rel, AVal.toAtom] + · let input : VEnv := ⟨[.slot 0 1 uses true], 1⟩ + let output := input.setEntry 0 (.slot 0 0 uses false) + let d : FnDef := ⟨1, worldOfUses uses, false, .ret (.var 0)⟩ + have hsound : LowerResultSound ctx d input output + (worldOfUses uses) (_root_.id : Emit) (.slotA 0) := by + apply lower_var_move_sound + rfl + apply hsound.fnOwnershipContract (FnEntryRealizes.singleton uses 1) + · rfl + · exact EntriesReleased.slot EntriesReleased.nil + · rfl + +/-- A real two-parameter function-body run with one dead shared parameter. +The entry release emits `drop`, records that owner as released, and the live +inner parameter is then moved to the result. -/ +theorem lowerFnBody_dead_many_verified {ctx : Ctx} + (src : IxIR0.Env) (fuel : Nat) (state : LowSt) : + let input : VEnv := + ⟨[.slot 1 1 .many true, .slot 0 0 .many true], 2⟩ + let d : FnDef := + ⟨2, .shared, false, .letOp (.drop (.var 1)) (.ret (.var 1))⟩ + (lowerFnBody src (Nat.succ (Nat.succ fuel)) input + [⟨1, 0, .many⟩] .shared (.var 0)).run state = + .ok d.body state ∧ + FnOwnershipContract ctx d [.shared, .shared] := by + dsimp only + let remaining : Nat → Nat := fun i => if i = 0 then 1 else 0 + let input : VEnv := + ⟨parameterEntries 0 [.many, .many] remaining, 2⟩ + let middle := + (input.setEntry 1 (.slot 0 0 .many false)).bump + let output := middle.setEntry 0 (.slot 1 0 .many false) + let releaseEmit : Emit := + emitOp (.drop (.var (input.rel 0))) ∘ (_root_.id : Emit) + let d : FnDef := + ⟨2, .shared, false, .letOp (.drop (.var 1)) (.ret (.var 1))⟩ + have hplan : ReleasePlan input [⟨1, 0, .many⟩] middle releaseEmit := by + apply ReleasePlan.many + · rfl + · exact ReleasePlan.nil + have hvar := lowerE_var_move_verified (ctx := ctx) (cur := d) + src fuel middle 0 1 .many state (by rfl) + have hfn := lowerFnBody_verified (ctx := ctx) (cur := d) + src (Nat.succ fuel) input middle output [⟨1, 0, .many⟩] + .shared (.var 0) releaseEmit (_root_.id : Emit) (.slotA 1) + state state hplan hvar.1 hvar.2 + constructor + · simpa [input, middle, output, releaseEmit, d, VEnv.rel, + VEnv.setEntry, VEnv.bump, parameterEntries, remaining, + AVal.toAtom, emitOp, Function.comp_def] using hfn.1 + · have hentry : FnEntryRealizes input [.shared, .shared] := by + exact FnEntryRealizes.parameterEntries [.many, .many] remaining + have hreleased : EntriesReleased output.entries := by + exact EntriesReleased.slot (EntriesReleased.slot EntriesReleased.nil) + apply hfn.2.fnOwnershipContract hentry rfl hreleased + rfl + +/-- The corresponding real `lowerDecl` branch: a two-argument definition +whose outer shared parameter is dead lowers to the verified drop/return +function and immediately receives its callable contract. -/ +theorem lowerDecl_dead_many_verified {ctx : Ctx} + (src : IxIR0.Env) (fuel : Nat) (address : Ixon.Address) + (state : LowSt) : + let sourceBody : IxIR0.Expr := + .lam .many (.lam .many (.var 0)) + let d : FnDef := + ⟨2, .shared, true, .letOp (.drop (.var 1)) (.ret (.var 1))⟩ + (lowerDecl src (Nat.succ (Nat.succ fuel)) + (address, .defn .shared sourceBody)).run state = + .ok (some (address, .fn d)) state ∧ + FnOwnershipContract ctx d [.shared, .shared] := by + dsimp only + let sourceBody : IxIR0.Expr := .lam .many (.lam .many (.var 0)) + let remaining : Nat → Nat := fun i => countUses i (.var 0) + let input : VEnv := + ⟨parameterEntries 0 [.many, .many] remaining, 2⟩ + let middle := (input.setEntry 1 (.slot 0 0 .many false)).bump + let output := middle.setEntry 0 (.slot 1 0 .many false) + let releaseEmit : Emit := + emitOp (.drop (.var (input.rel 0))) ∘ (_root_.id : Emit) + let d : FnDef := + ⟨2, .shared, true, .letOp (.drop (.var 1)) (.ret (.var 1))⟩ + have hplan : ReleasePlan input [⟨1, 0, .many⟩] middle releaseEmit := by + apply ReleasePlan.many + · rfl + · exact ReleasePlan.nil + have hvar := lowerE_var_move_verified (ctx := ctx) (cur := d) + src fuel middle 0 1 .many state (by rfl) + have hreleased : EntriesReleased output.entries := + EntriesReleased.slot (EntriesReleased.slot EntriesReleased.nil) + have hdecl := lowerDecl_defn_verified (ctx := ctx) + src (Nat.succ fuel) address .shared sourceBody middle output + releaseEmit (_root_.id : Emit) (.slotA 1) state state d + (by simpa [sourceBody, input, remaining, parameterDrops, lamUses, + stripLams, lamArity, countUses] using hplan) + (by simpa [sourceBody, output, stripLams, worldOfUses] using hvar.1) + (by simp [d, sourceBody, releaseEmit, input, output, middle, + remaining, parameterEntries, VEnv.rel, VEnv.setEntry, VEnv.bump, + lamArity, papSafe, lamUses, AVal.toAtom, emitOp, Function.comp_def]) + hvar.2 hreleased + simpa [sourceBody, d, lamUses, worldOfUses] using hdecl + +private def NullaryRecursorEntryValid + (env : List RVal) (fields : Array RVal) : Prop := + ∃ major, env = [major] ∧ fields = #[] + +private def nullaryRecursorEntryRoots + (env : List RVal) (_ : Array RVal) : List Root := + match env with + | major :: _ => [⟨.shared, major⟩] + | [] => [] + +/-- Entry shape for the first nontrivial recursor-prefix fixture. The +function receives one pre-major parameter and the major; dispatch exposes one +borrowed constructor field. -/ +private def OneFieldDeadParamEntryValid + (env : List RVal) (fields : Array RVal) : Prop := + ∃ pre major field, env = [major, pre] ∧ fields = #[field] + +/-- Function-argument root order for `OneFieldDeadParamEntryValid`. This +matches the source argument vector (`pre`, then `major`), independently of +the reversed runtime environment. -/ +private def oneFieldDeadParamEntryRoots + (env : List RVal) (_ : Array RVal) : List Root := + match env with + | major :: pre :: _ => [⟨.shared, pre⟩, ⟨.shared, major⟩] + | _ => [] + +/-- A complete non-nullary recursor prefix: retain one borrowed field, drop +the major, drop one dead pre-major parameter, then move the retained field to +the result. This isolates all three ownership transitions generated by the +corresponding `lowerRecursor` fold. -/ +theorem lowerRecursor_one_field_dead_param_alt_contract + {ctx : Ctx} {cur : FnDef} (hresult : cur.result = .shared) : + AltOwnershipContract ctx cur + (.mk 0 1 + (.letOp (.dup (.var 0)) + (.letOp (.drop (.var 2)) + (.letOp (.drop (.var 4)) (.ret (.var 2)))))) + .shared OneFieldDeadParamEntryValid + oneFieldDeadParamEntryRoots := by + let input : VEnv := + ⟨[.slot 3 1 .many true, .slot 0 0 .many false, .recSelf 2], 6⟩ + let output := input.setEntry 0 (.slot 3 0 .many false) + have hbody : LowerResultSound ctx cur input output cur.result + (_root_.id : Emit) (.slotA 3) := by + rw [hresult] + apply lower_var_move_sound + rfl + have hprefix : ∀ {env : List RVal} {fields : Array RVal} + {rest : List Root}, + fields.size = 1 → OneFieldDeadParamEntryValid env fields → + EmitSound ctx cur + (emitOp (.dup (.var 0)) ∘ + emitOp (.drop (.var 2)) ∘ + emitOp (.drop (.var 4))) + (OwnsAltEntry .shared oneFieldDeadParamEntryRoots env fields rest) + (OwnsVEnv input rest) := by + intro env fields rest _ hvalid + obtain ⟨pre, major, field, rfl, rfl⟩ := hvalid + intro post code hcode + let entryFrame : List RVal → Prop := + fun oldEnv => oldEnv = [field, major, pre] + have hafterDup : CodeOwns ctx cur + (OwnsPushedRoot entryFrame .shared + ([⟨.shared, pre⟩, ⟨.shared, major⟩] ++ rest)) + post + ((emitOp (.drop (.var 2)) ∘ emitOp (.drop (.var 4))) code) := by + intro nextFuel nextStore nextEnv resultStore resultValue hpushed hrun + obtain ⟨ownedField, oldEnv, rfl, hold, hown⟩ := hpushed + subst oldEnv + let majorFrame : List RVal → Prop := + fun current => current = [ownedField, field, major, pre] + have hafterMajor : CodeOwns ctx cur + (OwnsAfterPush majorFrame + (⟨.shared, ownedField⟩ :: ⟨.shared, pre⟩ :: rest)) + post (emitOp (.drop (.var 4)) code) := by + intro majorFuel majorStore majorEnv finalStore finalValue + hpushedMajor hrunMajor + obtain ⟨majorResult, oldEnv, rfl, holdMajor, hownMajor⟩ := + hpushedMajor + subst oldEnv + let paramFrame : List RVal → Prop := + fun current => + current = [majorResult, ownedField, field, major, pre] + have hafterParam : CodeOwns ctx cur + (OwnsAfterPush paramFrame ([⟨.shared, ownedField⟩] ++ rest)) + post code := by + intro paramFuel paramStore paramEnv finalStore finalValue + hpushedParam hrunParam + obtain ⟨paramResult, oldEnv, rfl, holdParam, hownParam⟩ := + hpushedParam + subst oldEnv + have hrealize : VEnvRealizes input + [paramResult, majorResult, ownedField, field, major, pre] + [⟨.shared, ownedField⟩] := by + refine ⟨by simp [input], ?_⟩ + apply EntriesRealize.held + · simp [input] + · simp [input, VEnv.rel] + · apply EntriesRealize.released + · simp [input] + · exact EntriesRealize.recSelf EntriesRealize.nil + apply hcode + · exact ⟨[⟨.shared, ownedField⟩], hrealize, + by simpa using hownParam⟩ + · exact hrunParam + apply (emit_drop_value_owned (ctx := ctx) (cur := cur) + (target := .var 4) (value := pre) (frame := paramFrame) + (rest := ⟨.shared, ownedField⟩ :: rest)) + post code hafterParam + · refine ⟨rfl, rfl, ?_⟩ + exact hownMajor.perm + (perm_extract_root ⟨.shared, pre⟩ + [⟨.shared, ownedField⟩] [] rest) + · exact hrunMajor + apply (emit_drop_value_owned (ctx := ctx) (cur := cur) + (target := .var 2) (value := major) (frame := majorFrame) + (rest := ⟨.shared, ownedField⟩ :: ⟨.shared, pre⟩ :: rest)) + post (emitOp (.drop (.var 4)) code) hafterMajor + · refine ⟨rfl, rfl, ?_⟩ + exact hown.perm + (perm_extract_root ⟨.shared, major⟩ + [⟨.shared, ownedField⟩, ⟨.shared, pre⟩] [] rest) + · simpa [Function.comp_def] using hrun + intro startFuel startStore branchEnv endStore endValue hentry hrun + have hpre : + entryFrame branchEnv ∧ + resolveAtom branchEnv (.var 0) = .ok field ∧ + HasWorld startStore .shared field ∧ + RootOwnership startStore + ([⟨.shared, pre⟩, ⟨.shared, major⟩] ++ rest) := by + obtain ⟨henv, hown, hborrow⟩ := hentry + have hbranch : branchEnv = [field, major, pre] := by + simpa using henv + refine ⟨hbranch, ?_, hborrow field (by simp), ?_⟩ + · rw [hbranch] + rfl + · simpa [oneFieldDeadParamEntryRoots] using hown + exact (emit_retain_borrowed (ctx := ctx) (cur := cur) + (atom := .var 0) (value := field) (frame := entryFrame) + (rest := [⟨.shared, pre⟩, ⟨.shared, major⟩] ++ rest)) + post ((emitOp (.drop (.var 2)) ∘ emitOp (.drop (.var 4))) code) + hafterDup (fuel := startFuel) (store := startStore) + (env := branchEnv) (store' := endStore) (value := endValue) hpre + (by simpa [Function.comp_def] using hrun) + have hcontract := hbody.altOwnershipContractWithPrefix + (fieldWorld := .shared) + (entryValid := OneFieldDeadParamEntryValid) + (entryRoots := oneFieldDeadParamEntryRoots) + (entryEmit := emitOp (.dup (.var 0)) ∘ + emitOp (.drop (.var 2)) ∘ emitOp (.drop (.var 4))) + (tag := 0) (fieldCount := 1) hprefix + (EntriesReleased.slot + (EntriesReleased.slot + (EntriesReleased.recSelf EntriesReleased.nil))) + simpa [input, output, VEnv.setEntry, VEnv.rel, AVal.toAtom, + emitOp, Function.comp_def] using hcontract + +/-- Exact contract for the first concrete `lowerRecursor` prefix shape: +a nullary rule with no pre-major parameters. The alternative owns the shared +major, exposes no fields, drops the major, and then returns a scalar literal. -/ +theorem lowerRecursor_nullary_lit_alt_contract {ctx : Ctx} {cur : FnDef} + (literal : IxIR0.Literal) : + AltOwnershipContract ctx cur + (.mk 0 0 (.letOp (.drop (.var 0)) (.ret (.lit literal)))) + .shared NullaryRecursorEntryValid nullaryRecursorEntryRoots := by + let input : VEnv := ⟨[.recSelf 1], 2⟩ + have hbody : LowerResultSound ctx cur input input cur.result + (_root_.id : Emit) (.constA (.lit literal)) := lower_lit_sound + have hprefix : ∀ {env : List RVal} {fields : Array RVal} + {rest : List Root}, + fields.size = 0 → NullaryRecursorEntryValid env fields → + EmitSound ctx cur (emitOp (.drop (.var 0))) + (OwnsAltEntry .shared nullaryRecursorEntryRoots env fields rest) + (OwnsVEnv input rest) := by + intro env fields rest hsize hvalid + obtain ⟨major, rfl, rfl⟩ := hvalid + intro post code hcode + intro fuel store branchEnv store' value hpre hrun + obtain ⟨henv, hown, _⟩ := hpre + have hbranch : branchEnv = [major] := by simpa using henv + subst branchEnv + let frame : List RVal → Prop := fun oldEnv => oldEnv = [major] + have hnext : CodeOwns ctx cur (OwnsAfterPush frame rest) post code := by + intro nextFuel nextStore nextEnv resultStore resultValue hpushed + hcodeRun + obtain ⟨pushed, oldEnv, rfl, hold, hownRest⟩ := hpushed + subst oldEnv + apply hcode + · have hrealize : VEnvRealizes input (pushed :: [major]) [] := by + exact ⟨by simp [input], EntriesRealize.recSelf EntriesRealize.nil⟩ + refine ⟨[], hrealize, ?_⟩ + · simpa using hownRest + · exact hcodeRun + apply emit_drop_value_owned (target := .var 0) (value := major) + (frame := frame) (rest := rest) post code hnext + · exact ⟨rfl, rfl, by simpa [nullaryRecursorEntryRoots] using hown⟩ + · exact hrun + have hcontract := hbody.altOwnershipContractWithPrefix + (fieldWorld := .shared) + (entryValid := NullaryRecursorEntryValid) + (entryRoots := nullaryRecursorEntryRoots) + (entryEmit := emitOp (.drop (.var 0))) (tag := 0) (fieldCount := 0) + hprefix (EntriesReleased.recSelf EntriesReleased.nil) + simpa [input, AVal.toAtom, emitOp, Function.comp_def] using hcontract + +/-- The executable `lowerRecursor` equation paired with the contract of its +generated nullary alternative. -/ +theorem lowerRecursor_nullary_lit_verified {ctx : Ctx} + (src : IxIR0.Env) (fuel : Nat) (literal : IxIR0.Literal) + (state : LowSt) : + let alt : Alt := + .mk 0 0 (.letOp (.drop (.var 0)) (.ret (.lit literal))) + let d : FnDef := ⟨1, .shared, true, .case (.var 0) false #[alt]⟩ + (lowerRecursor src (Nat.succ fuel) 0 false + #[⟨0, .lit literal⟩]).run state = .ok d state ∧ + AltOwnershipContract ctx d alt .shared + NullaryRecursorEntryValid nullaryRecursorEntryRoots := by + dsimp only + constructor + · simp [lowerRecursor, lowerRecursorRule, recursorFieldRetains, + applyRecursorFieldRetains, releaseSlots, parameterEntries, + parameterDrops, lowerE, AVal.toAtom, emitOp, VEnv.rel] + · exact lowerRecursor_nullary_lit_alt_contract literal + +/-- The non-nullary prefix contract is paired with the real recursor fold. +The generated code retains field zero, drops the major at relative index two, +drops the dead pre-major parameter at index four, and returns the retained +field at index two. -/ +theorem lowerRecursor_one_field_dead_param_verified {ctx : Ctx} + (src : IxIR0.Env) (fuel : Nat) (state : LowSt) : + let alt : Alt := + .mk 0 1 + (.letOp (.dup (.var 0)) + (.letOp (.drop (.var 2)) + (.letOp (.drop (.var 4)) (.ret (.var 2))))) + let d : FnDef := ⟨2, .shared, true, .case (.var 0) false #[alt]⟩ + (lowerRecursor src (Nat.succ fuel) 1 false + #[⟨1, .var 0⟩]).run state = .ok d state ∧ + AltOwnershipContract ctx d alt .shared + OneFieldDeadParamEntryValid oneFieldDeadParamEntryRoots := by + dsimp only + constructor + · have hsame : (Owned.shared != Owned.shared) = false := by decide + simp [lowerRecursor, lowerRecursorRule, recursorFieldRetains, + applyRecursorFieldRetains, releaseSlots, parameterEntries, + parameterDrops, SlotDrop.offsetEntry, lowerE, countUses, worldOfUses, + hsame, VEnv.rel, VEnv.setEntry, VEnv.bump, AVal.toAtom, emitOp, + Function.comp_def] + · exact lowerRecursor_one_field_dead_param_alt_contract rfl + +/-- Canonical recursor parameter cleanup with more than one release. The +innermost and outermost pre-major parameters are dead while the middle one is +returned, so the shared drops occur at changing relative indices two and +five after the major has first been dropped. -/ +theorem lowerRecursor_three_params_release_order_verified + (src : IxIR0.Env) (fuel : Nat) (state : LowSt) : + let alt : Alt := + .mk 0 0 + (.letOp (.drop (.var 0)) + (.letOp (.drop (.var 2)) + (.letOp (.drop (.var 5)) (.ret (.var 5))))) + let d : FnDef := ⟨4, .shared, true, .case (.var 0) false #[alt]⟩ + (lowerRecursor src (Nat.succ fuel) 3 false + #[⟨0, .var 1⟩]).run state = .ok d state := by + dsimp only + have hsame : (Owned.shared != Owned.shared) = false := by decide + simp [lowerRecursor, lowerRecursorRule, recursorFieldRetains, + applyRecursorFieldRetains, + releaseSlots, parameterEntries, parameterDrops, SlotDrop.offsetEntry, + lowerE, countUses, worldOfUses, hsame, VEnv.rel, VEnv.setEntry, + VEnv.bump, AVal.toAtom, emitOp, Function.comp_def] + +/-- A unary Nat alternative whose result is a scalar exercises the complete +alternative constructor. The predecessor is exposed as a borrow, the entry +layout records its physical slot, and the branch itself owns no input roots. -/ +theorem fixture_nat_succ_alt_contract {ctx : Ctx} {cur : FnDef} + (n : Nat) (literal : IxIR0.Literal) : + AltOwnershipContract ctx cur + (.mk 1 1 (.ret (.lit literal))) .shared + (fun env fields => + env = [] ∧ fields = #[RVal.lit (.nat n)]) + (fun _ _ => []) := by + let input : VEnv := ⟨[], 1⟩ + have hentry : AltEntryRealizes input 1 + (fun env fields => + env = [] ∧ fields = #[RVal.lit (.nat n)]) + (fun _ _ => []) := by + intro env fields hsize hvalid + obtain ⟨rfl, rfl⟩ := hvalid + exact ⟨[], ⟨rfl, EntriesRealize.nil⟩, List.Perm.refl []⟩ + have hsound : LowerResultSound ctx cur input input cur.result + (_root_.id : Emit) (.constA (.lit literal)) := + lower_lit_sound + simpa [AVal.toAtom] using hsound.altOwnershipContract + (fieldWorld := .shared) (tag := 1) hentry EntriesReleased.nil + +/-- The alternative fixture plugs into peeled-successor dispatch and yields +the exact result root while starting from the empty store/root set. -/ +theorem fixture_nat_succ_alt_dispatch_owned {ctx : Ctx} {cur : FnDef} + (fuel n : Nat) (literal : IxIR0.Literal) {store' : Store} + {value : RVal} + (hrun : runCode ctx (fuel + 1) cur {} [] + (.case (.lit (.nat (n + 1))) true + #[.mk 1 1 (.ret (.lit literal))]) = .ok (store', value)) : + RootOwnership store' [⟨cur.result, value⟩] := by + apply runCode_case_nat_succ_contract_owned + (ctx := ctx) (fuel := fuel) (cur := cur) (store := ({} : Store)) + (store' := store') (env := []) + (scrut := .lit (.nat (n + 1))) + (alts := #[.mk 1 1 (.ret (.lit literal))]) + (n := n) (tag := 1) (body := .ret (.lit literal)) + (value := value) (rest := []) + (entryValid := fun env fields => + env = [] ∧ fields = #[RVal.lit (.nat n)]) + (entryRoots := fun _ _ => []) + · rfl + · simp [Alt.cidx] + · exact fixture_nat_succ_alt_contract n literal + · exact ⟨rfl, rfl⟩ + · exact RootOwnership.empty + · exact hrun + +/-! ## Contentful semantic-projection instances + +Both fixtures run the real lowerer on a real expression and apply the +semantic projection theorem to that exact output, so neither the run nor the +`SourceProject` premise is assumed. The source environment holds a +two-field constructor, and the selected field is the *second* one, so a +field-index-blind proof could not close them. -/ + +/-- Final-use projection: the single source occurrence is consumed, so the +compiler emits `fetch`, `dup`, and the destructive `drop` of the pair, and +the theorem still returns the selected field's graph after the release. -/ +theorem fixture_proj_var_final_use_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} (src : IxIR0.Env) (fuel : Nat) + (state : LowSt) (address : Ixon.Address) (tag : Nat) + (first second : IxIR0.Value) : + ∃ output emit av, + (lowerE src (fuel + 2) ⟨[.slot 0 1 .many true], 1⟩ .shared + (.proj 1 (.var 0))).run state = .ok (output, emit, av) state ∧ + LowerResultValueSound funRel recSelfRel ctx cur + ⟨[.slot 0 1 .many true], 1⟩ output + [.ctor address tag [first, second]] + [.ctor address tag [first, second]] second .shared emit av := by + obtain ⟨output, emit, av, hrun⟩ : + ∃ output emit av, + (lowerE src (fuel + 2) ⟨[.slot 0 1 .many true], 1⟩ .shared + (.proj 1 (.var 0))).run state = .ok (output, emit, av) state := by + simp [lowerE, lowerBorrow, worldOfUses, VEnv.setEntry, VEnv.bump, + VEnv.rel, Function.comp_def, emitOp] + exact ⟨output, emit, av, hrun, + lowerE_proj_var_run_value_sound (i := 0) rfl (.ctor rfl) hrun⟩ + +/-- Repeated-use projection: one source occurrence survives, so the pair +stays owned by the output environment and no `drop` is emitted. -/ +theorem fixture_proj_var_kept_value_sound + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} (src : IxIR0.Env) (fuel : Nat) + (state : LowSt) (address : Ixon.Address) (tag : Nat) + (first second : IxIR0.Value) : + ∃ output emit av, + (lowerE src (fuel + 2) ⟨[.slot 0 2 .many true], 1⟩ .shared + (.proj 1 (.var 0))).run state = .ok (output, emit, av) state ∧ + LowerResultValueSound funRel recSelfRel ctx cur + ⟨[.slot 0 2 .many true], 1⟩ output + [.ctor address tag [first, second]] + [.ctor address tag [first, second]] second .shared emit av := by + obtain ⟨output, emit, av, hrun⟩ : + ∃ output emit av, + (lowerE src (fuel + 2) ⟨[.slot 0 2 .many true], 1⟩ .shared + (.proj 1 (.var 0))).run state = .ok (output, emit, av) state := by + simp [lowerE, lowerBorrow, worldOfUses, VEnv.setEntry, VEnv.bump, + VEnv.rel, Function.comp_def, emitOp] + exact ⟨output, emit, av, hrun, + lowerE_proj_var_run_value_sound (i := 0) rfl (.ctor rfl) hrun⟩ + +end Ix.Compiler.IxIR1.LowerSim diff --git a/Ix/Compiler/IxIR1/LowerStateBase.lean b/Ix/Compiler/IxIR1/LowerStateBase.lean new file mode 100644 index 000000000..dd9f7d791 --- /dev/null +++ b/Ix/Compiler/IxIR1/LowerStateBase.lean @@ -0,0 +1,3277 @@ +import Ix.Compiler.IxIR1.Lower + +/-! +# Structural compile-environment invariants + +State-only facts needed by the semantic lowering proof, kept below +`LowerSim` in the import graph. In particular, ordinary function bodies +start without the synthetic recursor-self entry and successful lowering +never invents one. +-/ + +namespace Ix.Compiler.IxIR1.Lower + +open Ix.Compiler.Ixon (Owned Uses) + +/-- No logical entry advertises the recursor-only `callSelf` capability. -/ +def NoRecSelf (input : VEnv) : Prop := + ∀ (index arity : Nat), + input.entries[index]? ≠ some (VEntry.recSelf arity) + +theorem NoRecSelf.empty : NoRecSelf ⟨[], depth⟩ := by + intro index arity + simp + +theorem NoRecSelf.bump {input : VEnv} (h : NoRecSelf input) : + NoRecSelf input.bump := by + simpa [NoRecSelf, VEnv.bump] using h + +theorem NoRecSelf.setSlot {input : VEnv} (h : NoRecSelf input) + (changed abs remaining : Nat) (uses : Uses) (held : Bool) : + NoRecSelf + (input.setEntry changed (.slot abs remaining uses held)) := by + intro index arity hentry + by_cases heq : changed = index + · subst index + rw [VEnv.setEntry, List.getElem?_set] at hentry + simp at hentry + · rw [VEnv.setEntry, List.getElem?_set] at hentry + simp [heq] at hentry + exact h index arity hentry + +theorem NoRecSelf.consSlot {input : VEnv} (h : NoRecSelf input) + (abs remaining : Nat) (uses : Uses) (held : Bool) : + NoRecSelf + { input with + entries := .slot abs remaining uses held :: input.entries } := by + intro index arity hentry + cases index with + | zero => simp at hentry + | succ index => + exact h index arity (by simpa using hentry) + +theorem NoRecSelf.pop {input : VEnv} (h : NoRecSelf input) : + NoRecSelf input.pop := by + intro index arity hentry + exact h (index + 1) arity (by simpa [VEnv.pop] using hentry) + +theorem NoRecSelf.of_entries_eq {input output : VEnv} + (h : NoRecSelf input) (hentries : output.entries = input.entries) : + NoRecSelf output := by + simpa [NoRecSelf, hentries] using h + +theorem NoRecSelf.of_mem_not_recSelf (input : VEnv) + (hentries : ∀ entry ∈ input.entries, ∀ arity, + entry ≠ VEntry.recSelf arity) : + NoRecSelf input := by + intro index arity hentry + obtain ⟨hindex, heq⟩ := List.getElem?_eq_some_iff.mp hentry + have hmember : VEntry.recSelf arity ∈ input.entries := by + rw [← heq] + exact List.getElem_mem hindex + exact hentries (.recSelf arity) hmember arity rfl + +private theorem parameterEntries_mem_not_recSelf (base : Nat) : + ∀ (modes : List Uses) (remaining : Nat → Nat) entry, + entry ∈ parameterEntries base modes remaining → + ∀ arity, entry ≠ VEntry.recSelf arity := by + intro modes remaining + exact parameterEntries_traverse remaining + (Result := fun _ _ entries => + ∀ entry ∈ entries, ∀ arity, entry ≠ VEntry.recSelf arity) + (hnil := by + intro current entry hmember + simp at hmember) + (hcons := by + intro current mode rest tail htail entry hmember arity heq + rw [List.mem_append] at hmember + cases hmember with + | inl hinner => exact htail entry hinner arity heq + | inr hlast => + simp only [List.mem_singleton] at hlast + subst entry + contradiction) + base modes + +/-- Canonical ordinary-function parameter layouts contain only slots. -/ +theorem parameterEntries_noRecSelf (base : Nat) (modes : List Uses) + (remaining : Nat → Nat) (depth : Nat) : + NoRecSelf ⟨parameterEntries base modes remaining, depth⟩ := by + apply NoRecSelf.of_mem_not_recSelf + intro entry hmember arity + exact parameterEntries_mem_not_recSelf base modes remaining entry hmember + arity + +/-- Foundational dependent traversal for the pure `releaseAll` fold. Empty, +constant, and slot normalization plus environment and emitter threading +recurse once; clients provide only their three result constructors. -/ +theorem releaseAll_traverse_core + {Result : VEnv → List AVal → VEnv → Emit → Prop} + (hnil : ∀ input, + Result input [] input (_root_.id : Emit)) + (hconst : ∀ {input : VEnv} {atom : Atom} {rest : List AVal} + {output : VEnv} {emit : Emit}, + Result input rest output emit → + Result input (.constA atom :: rest) output emit) + (hslot : ∀ {input : VEnv} {abs : Nat} {rest : List AVal} + {output : VEnv} {tailEmit : Emit}, + Result input.bump rest output tailEmit → + Result input (.slotA abs :: rest) output + (emitOp (.drop (.var (input.rel abs))) ∘ tailEmit)) + (input : VEnv) (values : List AVal) : + Result input values (releaseAll input values).1 + (releaseAll input values).2 := by + induction values generalizing input with + | nil => exact hnil input + | cons value rest ih => + cases value with + | constA atom => + simpa [releaseAll] using hconst (ih input) + | slotA abs => + simpa [releaseAll] using hslot (ih input.bump) + +theorem NoRecSelf.releaseAll (input : VEnv) (values : List AVal) + (h : NoRecSelf input) : + NoRecSelf (releaseAll input values).1 := by + exact releaseAll_traverse_core + (Result := fun initial _ output _ => + NoRecSelf initial → NoRecSelf output) + (hnil := fun _ hinitial => hinitial) + (hconst := fun htail hinitial => htail hinitial) + (hslot := fun htail hinitial => htail hinitial.bump) + input values h + +private theorem throw_run_not_ok {α : Type} {message : String} + {initial final : LowSt} {result : α} + (hrun : (throw message : LowerM α).run initial = .ok result final) : + False := by + change EStateM.Result.error message initial = .ok result final at hrun + contradiction + +private theorem bind_run_ok_inv {error state α β : Type} + {action : EStateM error state α} {next : α → EStateM error state β} + {initial final : state} {result : β} + (hrun : (action >>= next).run initial = .ok result final) : + ∃ value middle, + action.run initial = .ok value middle ∧ + (next value).run middle = .ok result final := by + change + (match action.run initial with + | .ok value nextState => (next value).run nextState + | .error err nextState => .error err nextState) = + .ok result final at hrun + cases haction : action.run initial with + | ok value middle => + rw [haction] at hrun + exact ⟨value, middle, rfl, hrun⟩ + | error err middle => + rw [haction] at hrun + contradiction + +/-- Source-neutral operational traversal for a successful `lowerCaptures` +run. Empty recovery, both bind inversions, compiler-state threading, and +final tuple reconstruction happen once; clients supply only their empty +judgment and one successful-capture composition step. -/ +theorem lowerCaptures_run_core + (e : IxIR0.Expr) + {Result : VEnv → VEnv → List Nat → Emit → List AVal → Prop} + (hnil : ∀ input, + Result input input [] (_root_.id : Emit) []) + (hcons : ∀ {index : Nat} {rest : List Nat} + {input middle output : VEnv} {headEmit tailEmit : Emit} + {headValue : AVal} {tailValues : List AVal} + {state middleState : LowSt}, + (lowerCapture e input index).run state = + .ok (middle, headEmit, headValue) middleState → + Result middle output rest tailEmit tailValues → + Result input output (index :: rest) (headEmit ∘ tailEmit) + (headValue :: tailValues)) + {captures : List Nat} {input output : VEnv} + {emit : Emit} {values : List AVal} {state finalState : LowSt} + (hrun : (lowerCaptures e input captures).run state = + .ok (output, emit, values) finalState) : + Result input output captures emit values := by + induction captures generalizing input output emit values state finalState with + | nil => + have hpure : + (input, (_root_.id : Emit), []) = (output, emit, values) ∧ + state = finalState := by + simpa [lowerCaptures] using hrun + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + exact hnil _ + | cons index rest ih => + simp only [lowerCaptures] at hrun + obtain ⟨headResult, middleState, hheadRun, hafterHead⟩ := + bind_run_ok_inv hrun + rcases headResult with ⟨middle, headEmit, headValue⟩ + obtain ⟨tailResult, tailState, htailRun, hafterTail⟩ := + bind_run_ok_inv hafterHead + rcases tailResult with ⟨tailOutput, tailEmit, tailValues⟩ + have hpure : + (tailOutput, headEmit ∘ tailEmit, headValue :: tailValues) = + (output, emit, values) ∧ tailState = finalState := by + simpa using hafterTail + obtain ⟨hresult, hstate⟩ := hpure + cases hresult + subst finalState + exact hcons hheadRun (ih htailRun) + +/-- Property-polymorphic action traversal for `lowerCaptures`. Its +left-to-right `lowerCapture` sequencing and final pure tuple construction +recurse once for every action invariant closed under `pure` and `bind`. -/ +theorem lowerCaptures_action_core + (e : IxIR0.Expr) + {ActionProperty : {α : Type} → LowerM α → Prop} + (hpure : ∀ {α : Type} (value : α), + ActionProperty (pure value : LowerM α)) + (hbind : ∀ {α β : Type} {action : LowerM α} + {next : α → LowerM β}, + ActionProperty action → + (∀ value, ActionProperty (next value)) → + ActionProperty (action >>= next)) + (hcapture : ∀ input index, + ActionProperty (lowerCapture e input index)) : + ∀ (input : VEnv) (captures : List Nat), + ActionProperty (lowerCaptures e input captures) := by + intro input captures + induction captures generalizing input with + | nil => + change ActionProperty + (pure (input, (_root_.id : Emit), ([] : List AVal)) : + LowerM (VEnv × Emit × List AVal)) + exact hpure _ + | cons index rest ih => + simp only [lowerCaptures] + apply hbind (hcapture input index) + intro headResult + rcases headResult with ⟨middle, headEmit, headValue⟩ + apply hbind (ih middle) + intro tailResult + rcases tailResult with ⟨output, tailEmit, tailValues⟩ + exact hpure + (output, headEmit ∘ tailEmit, headValue :: tailValues) + +private theorem map_run_ok_inv {α β : Type} {action : LowerM α} + {f : α → β} {initial final : LowSt} {result : β} + (hrun : (f <$> action).run initial = .ok result final) : + ∃ value, + action.run initial = .ok value final ∧ f value = result := by + have hbind : (action >>= fun value => pure (f value)).run initial = + .ok result final := by + simpa only [bind_pure_comp] using hrun + obtain ⟨value, middle, haction, hpure⟩ := bind_run_ok_inv hbind + have hresult : f value = result ∧ middle = final := by + simpa using hpure + cases hresult.2 + exact ⟨value, haction, hresult.1⟩ + +/-- Source-neutral operational traversal for a successful `releaseSlots` +run. Mode rejection, environment rewriting, depth advancement, tail-run +recovery, and emitter composition recurse once; clients supply only their +empty, affine-drop, and shared-drop judgments. -/ +theorem releaseSlots_run_core + {Result : VEnv → VEnv → List SlotDrop → Emit → Prop} + (hnil : ∀ input, + Result input input [] (_root_.id : Emit)) + (haffine : ∀ {entry abs : Nat} {rest : List SlotDrop} + {input output : VEnv} {tailEmit : Emit}, + Result + (input.setEntry entry (.slot abs 0 .affine false)).bump + output rest tailEmit → + Result input output + (⟨entry, abs, .affine⟩ :: rest) + (emitOp (.dropU (.var (input.rel abs))) ∘ tailEmit)) + (hmany : ∀ {entry abs : Nat} {rest : List SlotDrop} + {input output : VEnv} {tailEmit : Emit}, + Result + (input.setEntry entry (.slot abs 0 .many false)).bump + output rest tailEmit → + Result input output + (⟨entry, abs, .many⟩ :: rest) + (emitOp (.drop (.var (input.rel abs))) ∘ tailEmit)) + {input output : VEnv} {drops : List SlotDrop} {emit : Emit} + {state finalState : LowSt} + (hrun : (releaseSlots input drops).run state = + .ok (output, emit) finalState) : + Result input output drops emit := by + induction drops generalizing input output emit state finalState with + | nil => + have hpure : + (input, (_root_.id : Emit)) = (output, emit) ∧ + state = finalState := by + simpa [releaseSlots] using hrun + obtain ⟨hresult, _⟩ := hpure + cases hresult + exact hnil input + | cons drop rest ih => + rcases drop with ⟨entry, abs, uses⟩ + cases uses with + | erased => + obtain ⟨_, _, hthrow, _⟩ := bind_run_ok_inv (by + simpa [releaseSlots] using hrun) + exact (throw_run_not_ok hthrow).elim + | linear => + obtain ⟨_, _, hthrow, _⟩ := bind_run_ok_inv (by + simpa [releaseSlots] using hrun) + exact (throw_run_not_ok hthrow).elim + | affine => + have hmap : + ((fun result : VEnv × Emit => + (result.1, + emitOp (.dropU (.var (input.rel abs))) ∘ result.2)) <$> + releaseSlots + (input.setEntry entry + (.slot abs 0 .affine false)).bump rest).run state = + .ok (output, emit) finalState := by + simpa [releaseSlots] using hrun + obtain ⟨tailResult, htailRun, hvalue⟩ := map_run_ok_inv hmap + rcases tailResult with ⟨actualOutput, tailEmit⟩ + have houtput : actualOutput = output := congrArg Prod.fst hvalue + have hemit : + emitOp (.dropU (.var (input.rel abs))) ∘ tailEmit = emit := + congrArg Prod.snd hvalue + subst output + subst emit + exact haffine (ih htailRun) + | many => + have hmap : + ((fun result : VEnv × Emit => + (result.1, + emitOp (.drop (.var (input.rel abs))) ∘ result.2)) <$> + releaseSlots + (input.setEntry entry + (.slot abs 0 .many false)).bump rest).run state = + .ok (output, emit) finalState := by + simpa [releaseSlots] using hrun + obtain ⟨tailResult, htailRun, hvalue⟩ := map_run_ok_inv hmap + rcases tailResult with ⟨actualOutput, tailEmit⟩ + have houtput : actualOutput = output := congrArg Prod.fst hvalue + have hemit : + emitOp (.drop (.var (input.rel abs))) ∘ tailEmit = emit := + congrArg Prod.snd hvalue + subst output + subst emit + exact hmany (ih htailRun) + +/-- Property-polymorphic action traversal for `releaseSlots`. Its mode +dispatch, state-free head action, environment threading, tail action, and +pure emitter assembly recurse once for every property closed under `pure`, +`bind`, and an immediately throwing bind. -/ +theorem releaseSlots_action_core + {ActionProperty : {α : Type} → LowerM α → Prop} + (hpure : ∀ {α : Type} (value : α), + ActionProperty (pure value : LowerM α)) + (hbind : ∀ {α β : Type} {action : LowerM α} + {next : α → LowerM β}, + ActionProperty action → + (∀ value, ActionProperty (next value)) → + ActionProperty (action >>= next)) + (hthrowBind : ∀ {α β : Type} (message : String) + (next : α → LowerM β), + ActionProperty + ((EStateM.throw message : LowerM α) >>= next)) : + ∀ (input : VEnv) (drops : List SlotDrop), + ActionProperty (releaseSlots input drops) := by + intro input drops + induction drops generalizing input with + | nil => + change ActionProperty + (pure (input, (_root_.id : Emit)) : LowerM (VEnv × Emit)) + exact hpure _ + | cons drop rest ih => + simp only [releaseSlots] + cases drop.uses with + | erased => exact hthrowBind _ _ + | linear => exact hthrowBind _ _ + | affine => + apply hbind (hpure _) + intro headEmit + apply hbind + (ih (input.setEntry drop.entry + (.slot drop.abs 0 .affine false)).bump) + intro tailResult + rcases tailResult with ⟨output, tailEmit⟩ + exact hpure (output, headEmit ∘ tailEmit) + | many => + apply hbind (hpure _) + intro headEmit + apply hbind + (ih (input.setEntry drop.entry + (.slot drop.abs 0 .many false)).bump) + intro tailResult + rcases tailResult with ⟨output, tailEmit⟩ + exact hpure (output, headEmit ∘ tailEmit) + +theorem releaseSlots_noRecSelf (input : VEnv) : + ∀ {drops output emit state finalState}, + (releaseSlots input drops).run state = + .ok (output, emit) finalState → + NoRecSelf input → NoRecSelf output := by + intro drops output emit state finalState hrun hno + exact releaseSlots_run_core + (Result := fun initial final _ _ => + NoRecSelf initial → NoRecSelf final) + (hnil := fun _ h => h) + (haffine := by + intro entry abs rest initial final tailEmit htail hinitial + exact htail + (hinitial.setSlot entry abs 0 .affine false).bump) + (hmany := by + intro entry abs rest initial final tailEmit htail hinitial + exact htail + (hinitial.setSlot entry abs 0 .many false).bump) + hrun hno + +theorem lowerCapture_noRecSelf (expr : IxIR0.Expr) (input : VEnv) + (index : Nat) {output : VEnv} {emit : Emit} {value : AVal} + {state finalState : LowSt} + (hrun : (lowerCapture expr input index).run state = + .ok (output, emit, value) finalState) + (hno : NoRecSelf input) : NoRecSelf output := by + cases hentry : input.entries[index]? with + | none => exact (throw_run_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | some entry => + cases entry with + | recSelf arity => exact (hno index arity hentry).elim + | slot abs remaining uses held => + cases held with + | false => exact (throw_run_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | true => + by_cases hunique : worldOfUses uses = .unique + · have huuEq : (Owned.unique == Owned.unique) = true := by decide + exact (throw_run_not_ok (by + simpa [lowerCapture, hentry, hunique, huuEq] using hrun)).elim + · have huniqueEq : + (worldOfUses uses == Owned.unique) = false := by + cases uses <;> simp_all [worldOfUses] <;> decide + by_cases hmore : remaining > countUses index expr + · have houtput : output = + (input.setEntry index + (.slot abs (remaining - countUses index expr) uses true)).bump := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hrun + simpa [lowerCapture, hentry, huniqueEq, hmore] using hvalue.symm + subst output + exact (hno.setSlot index abs + (remaining - countUses index expr) uses true).bump + · by_cases hequal : remaining = countUses index expr + · have houtput : output = + input.setEntry index (.slot abs 0 uses false) := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hrun + simpa [lowerCapture, hentry, huniqueEq, hmore, hequal] + using hvalue.symm + subst output + exact hno.setSlot index abs 0 uses false + · exact (throw_run_not_ok (by + simpa [lowerCapture, hentry, huniqueEq, hmore, hequal] + using hrun)).elim + +theorem lowerCaptures_noRecSelf (expr : IxIR0.Expr) : + ∀ {indices input output emit values state finalState}, + (lowerCaptures expr input indices).run state = + .ok (output, emit, values) finalState → + NoRecSelf input → NoRecSelf output := by + intro indices input output emit values state finalState hrun + apply lowerCaptures_run_core + (Result := fun input output _ _ _ => + NoRecSelf input → NoRecSelf output) + (e := expr) (hrun := hrun) + · intro input hno + exact hno + · intro index rest input middle output headEmit tailEmit headValue + tailValues state middleState hheadRun htail hno + exact htail + (lowerCapture_noRecSelf expr input index hheadRun hno) + +def LowerEPreservesNoRecSelf (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {world : Owned} {expr : IxIR0.Expr} + {state finalState : LowSt} {output : VEnv} {emit : Emit} {value : AVal}, + (lowerE src fuel input world expr).run state = + .ok (output, emit, value) finalState → + NoRecSelf input → NoRecSelf output + +def LowerBorrowPreservesNoRecSelf (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {expr : IxIR0.Expr} {state finalState : LowSt} + {output : VEnv} {emit : Emit} {value : AVal} {release : Bool}, + (lowerBorrow src fuel input expr).run state = + .ok (output, emit, value, release) finalState → + NoRecSelf input → NoRecSelf output + +def LowerSpinePreservesNoRecSelf (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {world : Owned} {head : IxIR0.Expr} + {args : List IxIR0.Expr} {state finalState : LowSt} + {output : VEnv} {emit : Emit} {value : AVal}, + (lowerSpine src fuel input world head args).run state = + .ok (output, emit, value) finalState → + NoRecSelf input → NoRecSelf output + +def KnownCallPreservesNoRecSelf (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {build : Array Atom → Op} {count : Nat} + {argWorlds : List Owned} {resultWorld : Owned} + {args : List IxIR0.Expr} {state finalState : LowSt} + {output : VEnv} {emit : Emit} {value : AVal}, + (knownCall src fuel input build count argWorlds resultWorld args).run + state = .ok (output, emit, value) finalState → + NoRecSelf input → NoRecSelf output + +def LowerArgsPreservesNoRecSelf (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {args : List (IxIR0.Expr × Owned)} + {state finalState : LowSt} {output : VEnv} + {emit : Emit} {values : List AVal}, + (lowerArgs src fuel input args).run state = + .ok (output, emit, values) finalState → + NoRecSelf input → NoRecSelf output + +def ApplyRestPreservesNoRecSelf (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {resultWorld : Owned} {pre : Emit} + {function : AVal} {args : List IxIR0.Expr} + {state finalState : LowSt} {output : VEnv} + {emit : Emit} {value : AVal}, + (applyRest src fuel input resultWorld pre function args).run state = + .ok (output, emit, value) finalState → + NoRecSelf input → NoRecSelf output + +def LowerLamPreservesNoRecSelf (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {expr : IxIR0.Expr} {state finalState : LowSt} + {output : VEnv} {emit : Emit} {value : AVal}, + (lowerLam src fuel input expr).run state = + .ok (output, emit, value) finalState → + NoRecSelf input → NoRecSelf output + +structure LowerPreservesNoRecSelf (src : IxIR0.Env) (fuel : Nat) : Prop where + expr : LowerEPreservesNoRecSelf src fuel + borrow : LowerBorrowPreservesNoRecSelf src fuel + spine : LowerSpinePreservesNoRecSelf src fuel + knownCall : KnownCallPreservesNoRecSelf src fuel + args : LowerArgsPreservesNoRecSelf src fuel + applyRest : ApplyRestPreservesNoRecSelf src fuel + lam : LowerLamPreservesNoRecSelf src fuel + +theorem lowerPreservesNoRecSelf_zero (src : IxIR0.Env) : + LowerPreservesNoRecSelf src 0 := by + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro input world expr state finalState output emit value hrun _ + exact (throw_run_not_ok (by simpa [lowerE] using hrun)).elim + · intro input expr state finalState output emit value release hrun _ + exact (throw_run_not_ok (by simpa [lowerBorrow] using hrun)).elim + · intro input world head args state finalState output emit value hrun _ + exact (throw_run_not_ok (by simpa [lowerSpine] using hrun)).elim + · intro input build count argWorlds resultWorld args state finalState + output emit value hrun _ + exact (throw_run_not_ok (by simpa [knownCall] using hrun)).elim + · intro input args state finalState output emit values hrun _ + exact (throw_run_not_ok (by simpa [lowerArgs] using hrun)).elim + · intro input resultWorld pre function args state finalState output emit + value hrun _ + exact (throw_run_not_ok (by simpa [applyRest] using hrun)).elim + · intro input expr state finalState output emit value hrun _ + exact (throw_run_not_ok (by simpa [lowerLam] using hrun)).elim + +theorem lowerArgsPreservesNoRecSelf_succ {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesNoRecSelf src fuel) + (hargs : LowerArgsPreservesNoRecSelf src fuel) : + LowerArgsPreservesNoRecSelf src (fuel + 1) := by + intro input args state finalState output emit values hrun hno + cases args with + | nil => + have hpure : + (input, (_root_.id : Emit), []) = (output, emit, values) ∧ + state = finalState := by + simpa [lowerArgs] using hrun + cases hpure.1 + exact hno + | cons head rest => + rcases head with ⟨expr, world⟩ + simp only [lowerArgs] at hrun + obtain ⟨headResult, middleState, hheadRun, hafterHead⟩ := + bind_run_ok_inv hrun + rcases headResult with ⟨middle, headEmit, headValue⟩ + obtain ⟨tailResult, tailState, htailRun, hafterTail⟩ := + bind_run_ok_inv hafterHead + rcases tailResult with ⟨actualOutput, tailEmit, tailValues⟩ + have hvalue : actualOutput = output := by + have hpure : + (actualOutput, headEmit ∘ tailEmit, headValue :: tailValues) = + (output, emit, values) ∧ tailState = finalState := by + simpa using hafterTail + exact congrArg Prod.fst hpure.1 + subst output + exact hargs htailRun (hexpr hheadRun hno) + +theorem applyRestPreservesNoRecSelf_succ {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsPreservesNoRecSelf src fuel) : + ApplyRestPreservesNoRecSelf src (fuel + 1) := by + intro input resultWorld pre function args state finalState output emit value + hrun hno + cases function with + | constA atom => + cases atom with + | erased => + simp only [applyRest] at hrun + obtain ⟨argsResult, argsState, hargsRun, hpureRun⟩ := + bind_run_ok_inv hrun + rcases argsResult with ⟨middle, argsEmit, values⟩ + have hpure : (releaseAll middle values).1 = output := by + have hvalue : + ((releaseAll middle values).1, + pre ∘ argsEmit ∘ (releaseAll middle values).2, + AVal.constA .erased) = (output, emit, value) ∧ + argsState = finalState := by + simpa using hpureRun + exact congrArg Prod.fst hvalue.1 + subst output + exact (hargs hargsRun hno).releaseAll middle values + | var relative => + simp only [applyRest] at hrun + obtain ⟨_, checkedState, _, hafterCheck⟩ := bind_run_ok_inv hrun + obtain ⟨argsResult, argsState, hargsRun, hpureRun⟩ := + bind_run_ok_inv hafterCheck + rcases argsResult with ⟨middle, argsEmit, values⟩ + have houtput : middle.bump = output := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hpureRun + simpa using hvalue + subst output + exact (hargs hargsRun hno).bump + | lit literal => + simp only [applyRest] at hrun + obtain ⟨_, checkedState, _, hafterCheck⟩ := bind_run_ok_inv hrun + obtain ⟨argsResult, argsState, hargsRun, hpureRun⟩ := + bind_run_ok_inv hafterCheck + rcases argsResult with ⟨middle, argsEmit, values⟩ + have houtput : middle.bump = output := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hpureRun + simpa using hvalue + subst output + exact (hargs hargsRun hno).bump + | slotA abs => + simp only [applyRest] at hrun + obtain ⟨_, checkedState, _, hafterCheck⟩ := bind_run_ok_inv hrun + obtain ⟨argsResult, argsState, hargsRun, hpureRun⟩ := + bind_run_ok_inv hafterCheck + rcases argsResult with ⟨middle, argsEmit, values⟩ + have houtput : middle.bump = output := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hpureRun + simpa using hvalue + subst output + exact (hargs hargsRun hno).bump + +theorem knownCallPreservesNoRecSelf_succ {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsPreservesNoRecSelf src fuel) + (hrest : ApplyRestPreservesNoRecSelf src fuel) : + KnownCallPreservesNoRecSelf src (fuel + 1) := by + intro input build count argWorlds resultWorld args state finalState output + emit value hrun hno + simp only [knownCall] at hrun + obtain ⟨argsResult, argsState, hargsRun, hafterArgs⟩ := + bind_run_ok_inv hrun + rcases argsResult with ⟨middle, argsEmit, values⟩ + have hmiddle := hargs hargsRun hno + by_cases hterminal : args.length ≤ count + · have houtput : middle.bump = output := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hafterArgs + simpa [hterminal] using hvalue + subst output + exact hmiddle.bump + · have hrestRun : + (applyRest src fuel middle.bump resultWorld + (argsEmit ∘ emitOp + (build (values.map (·.toAtom middle)).toArray)) + (.slotA middle.depth) (args.drop count)).run argsState = + .ok (output, emit, value) finalState := by + simpa [hterminal] using hafterArgs + exact hrest hrestRun hmiddle.bump + +private theorem lowerBorrow_dynamic_noRecSelf + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesNoRecSelf src fuel) + {input output : VEnv} {expr : IxIR0.Expr} + {state finalState : LowSt} {emit : Emit} {value : AVal} + {releaseFlag : Bool} + {finish : (VEnv × Emit × AVal) → (VEnv × Emit × AVal × Bool)} + (hrun : (finish <$> lowerE src fuel input .shared expr).run state = + .ok (output, emit, value, releaseFlag) finalState) + (hfinish : ∀ result, (finish result).1 = result.1) + (hno : NoRecSelf input) : NoRecSelf output := by + obtain ⟨exprResult, hexprRun, hvalue⟩ := map_run_ok_inv hrun + rcases exprResult with ⟨middle, middleEmit, middleValue⟩ + have houtput : middle = output := by + have := congrArg Prod.fst hvalue + simpa [hfinish] using this + subst output + exact hexpr hexprRun hno + +theorem lowerBorrowPreservesNoRecSelf_succ + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesNoRecSelf src fuel) : + LowerBorrowPreservesNoRecSelf src (fuel + 1) := by + intro input expr state finalState output emit value release hrun hno + cases expr with + | var index => + cases hentry : input.entries[index]? with + | none => exact (throw_run_not_ok (by + simpa [lowerBorrow, hentry] using hrun)).elim + | some entry => + cases entry with + | recSelf arity => exact (hno index arity hentry).elim + | slot abs remaining uses held => + cases held with + | false => exact (throw_run_not_ok (by + simpa [lowerBorrow, hentry] using hrun)).elim + | true => + by_cases hunique : worldOfUses uses = .unique + · have huuEq : (Owned.unique == Owned.unique) = true := by decide + exact (throw_run_not_ok (by + simpa [lowerBorrow, hentry, hunique, huuEq] using hrun)).elim + · have huniqueEq : + (worldOfUses uses == Owned.unique) = false := by + cases uses <;> simp_all [worldOfUses] <;> decide + cases remaining with + | zero => exact (throw_run_not_ok (by + simpa [lowerBorrow, hentry, huniqueEq] using hrun)).elim + | succ remaining => + cases remaining with + | zero => + have hpure : + (input.setEntry index (.slot abs 0 uses false), + (_root_.id : Emit), AVal.slotA abs, true) = + (output, emit, value, release) ∧ + state = finalState := by + simpa [lowerBorrow, hentry, huniqueEq] using hrun + cases hpure.1 + exact hno.setSlot index abs 0 uses false + | succ remaining => + have hpure : + (input.setEntry index + (.slot abs (remaining + 1) uses true), + (_root_.id : Emit), AVal.slotA abs, false) = + (output, emit, value, release) ∧ + state = finalState := by + simpa [lowerBorrow, hentry, huniqueEq] using hrun + cases hpure.1 + exact hno.setSlot index abs (remaining + 1) uses true + | ref address => + apply lowerBorrow_dynamic_noRecSelf hexpr + (by simpa [lowerBorrow] using hrun) (fun _ => rfl) hno + | app function argument => + apply lowerBorrow_dynamic_noRecSelf hexpr + (by simpa [lowerBorrow] using hrun) (fun _ => rfl) hno + | lam uses body => + apply lowerBorrow_dynamic_noRecSelf hexpr + (by simpa [lowerBorrow] using hrun) (fun _ => rfl) hno + | letE uses value body => + apply lowerBorrow_dynamic_noRecSelf hexpr + (by simpa [lowerBorrow] using hrun) (fun _ => rfl) hno + | proj index source => + apply lowerBorrow_dynamic_noRecSelf hexpr + (by simpa [lowerBorrow] using hrun) (fun _ => rfl) hno + | lit literal => + apply lowerBorrow_dynamic_noRecSelf hexpr + (by simpa [lowerBorrow] using hrun) (fun _ => rfl) hno + | erased => + apply lowerBorrow_dynamic_noRecSelf hexpr + (by simpa [lowerBorrow] using hrun) (fun _ => rfl) hno + +private theorem lowerE_applyRest_noRecSelf + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesNoRecSelf src fuel) + (hrest : ApplyRestPreservesNoRecSelf src fuel) + {input output : VEnv} {world : Owned} {head : IxIR0.Expr} + {args : List IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {value : AVal} + (hrun : (do + let (middle, headEmit, function) ← + lowerE src fuel input .shared head + applyRest src fuel middle world headEmit function args).run state = + .ok (output, emit, value) finalState) + (hno : NoRecSelf input) : NoRecSelf output := by + obtain ⟨headResult, middleState, hheadRun, hrestRun⟩ := + bind_run_ok_inv hrun + rcases headResult with ⟨middle, headEmit, function⟩ + exact hrest hrestRun (hexpr hheadRun hno) + +theorem lowerSpinePreservesNoRecSelf_succ + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesNoRecSelf src fuel) + (hspine : LowerSpinePreservesNoRecSelf src fuel) + (hknown : KnownCallPreservesNoRecSelf src fuel) + (hrest : ApplyRestPreservesNoRecSelf src fuel) : + LowerSpinePreservesNoRecSelf src (fuel + 1) := by + intro input world head args state finalState output emit value hrun hno + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases head with + | app function argument => + apply hspine + · simpa [lowerSpine] using hrun + · exact hno + | erased => + apply hrest + · simpa [lowerSpine] using hrun + · exact hno + | var index => + simp only [lowerSpine] at hrun + cases hentry : input.entries[index]? with + | none => + apply lowerE_applyRest_noRecSelf hexpr hrest + · simpa [hentry] using hrun + · exact hno + | some entry => + cases entry with + | recSelf arity => exact (hno index arity hentry).elim + | slot abs remaining uses held => + apply lowerE_applyRest_noRecSelf hexpr hrest + · simpa [hentry] using hrun + · exact hno + | ref address => + simp only [lowerSpine] at hrun + cases hsource : src address with + | none => + rw [hsource] at hrun + exact (throw_run_not_ok hrun).elim + | some decl => + rw [hsource] at hrun + cases decl with + | defn result body => + simp only at hrun + by_cases hunder : args.length < lamArity body + · rw [if_pos hunder] at hrun + cases world with + | unique => exact (throw_run_not_ok hrun).elim + | shared => + cases result with + | unique => exact (throw_run_not_ok hrun).elim + | shared => + cases hp : papSafe body with + | false => exact (throw_run_not_ok (by + simpa [hp, hsuEq] using hrun)).elim + | true => + apply hknown + · simpa [hp, hsuEq] using hrun + · exact hno + · rw [if_neg hunder] at hrun + obtain ⟨_, checkedState, _, hknownRun⟩ := bind_run_ok_inv hrun + exact hknown hknownRun hno + | ctor tag arity => + simp only at hrun + by_cases hunder : args.length < arity + · rw [if_pos hunder] at hrun + cases world with + | unique => exact (throw_run_not_ok hrun).elim + | shared => + obtain ⟨wrapper, wrapperState, _, hknownRun⟩ := + bind_run_ok_inv hrun + exact hknown hknownRun hno + · rw [if_neg hunder] at hrun + exact hknown hrun hno + | recursor numArgs natLit rules => + simp only at hrun + by_cases hunder : args.length < numArgs + 1 + · rw [if_pos hunder] at hrun + cases world with + | unique => exact (throw_run_not_ok hrun).elim + | shared => exact hknown hrun hno + · rw [if_neg hunder] at hrun + obtain ⟨_, checkedState, _, hknownRun⟩ := bind_run_ok_inv hrun + exact hknown hknownRun hno + | extern arity => + simp only at hrun + by_cases hunder : args.length < arity + · rw [if_pos hunder] at hrun + cases world with + | unique => exact (throw_run_not_ok hrun).elim + | shared => exact hknown hrun hno + · rw [if_neg hunder] at hrun + exact hknown hrun hno + | lam uses body => + apply lowerE_applyRest_noRecSelf hexpr hrest + · simpa [lowerSpine] using hrun + · exact hno + | letE uses bound body => + apply lowerE_applyRest_noRecSelf hexpr hrest + · simpa [lowerSpine] using hrun + · exact hno + | proj index source => + apply lowerE_applyRest_noRecSelf hexpr hrest + · simpa [lowerSpine] using hrun + · exact hno + | lit literal => + apply lowerE_applyRest_noRecSelf hexpr hrest + · simpa [lowerSpine] using hrun + · exact hno + +theorem lowerLamPreservesNoRecSelf_succ + {src : IxIR0.Env} {fuel : Nat} : + LowerLamPreservesNoRecSelf src (fuel + 1) := by + intro input expr state finalState output emit value hrun hno + cases hp : papSafe expr with + | false => simp [lowerLam, hp] at hrun + | true => + simp only [lowerLam] at hrun + simp only [hp, ↓reduceIte, bind_pure_comp] at hrun + let captures := (List.range input.entries.length).filter + (fun index => countUses index expr > 0) + have hcaptures : captures = (List.range input.entries.length).filter + (fun index => countUses index expr > 0) := rfl + rw [← hcaptures] at hrun + obtain ⟨captureResult, captureState, hcaptureRun, hafterCapture⟩ := + bind_run_ok_inv hrun + rcases captureResult with ⟨captureOutput, captureEmit, captureValues⟩ + obtain ⟨fnAddr, addressState, _, hafterFresh⟩ := + bind_run_ok_inv hafterCapture + obtain ⟨code, bodyState, _, hafterBody⟩ := + bind_run_ok_inv hafterFresh + obtain ⟨_, _, hvalue⟩ := map_run_ok_inv hafterBody + have houtput : captureOutput.bump = output := by + exact congrArg Prod.fst hvalue + subst output + exact (lowerCaptures_noRecSelf expr hcaptureRun hno).bump + +private theorem lowerE_ref_entries_eq_noRecSelf + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {world : Owned} {address : Ixon.Address} + {state finalState : LowSt} {emit : Emit} {value : AVal} + (hrun : (lowerE src (fuel + 1) input world (.ref address)).run state = + .ok (output, emit, value) finalState) : + output.entries = input.entries := by + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases hsource : src address with + | none => exact (throw_run_not_ok (by + simpa [lowerE, hsource] using hrun)).elim + | some decl => + cases decl with + | defn result body => + cases harity : lamArity body with + | zero => + have hrun' := hrun + simp only [lowerE, hsource, harity] at hrun' + obtain ⟨_, checkedState, _, hpureRun⟩ := bind_run_ok_inv hrun' + have houtput := congrArg + (fun result : EStateM.Result String LowSt (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1.entries + | .error _ _ => []) hpureRun + simpa [VEnv.bump] using houtput.symm + | succ arity => + cases world with + | unique => exact (throw_run_not_ok (by + simpa [lowerE, hsource, harity, huuEq] using hrun)).elim + | shared => + cases result with + | unique => exact (throw_run_not_ok (by + simpa [lowerE, hsource, harity, hsuEq, huuEq] + using hrun)).elim + | shared => + cases hp : papSafe body with + | false => exact (throw_run_not_ok (by + simpa [lowerE, hsource, harity, hsuEq, hp] + using hrun)).elim + | true => + have hpure := hrun + simp [lowerE, hsource, harity, hsuEq, hp] at hpure + rw [← hpure.1.1] + rfl + | ctor tag arity => + cases arity with + | zero => + have hpure := hrun + simp [lowerE, hsource] at hpure + rw [← hpure.1.1] + rfl + | succ arity => + cases world with + | unique => exact (throw_run_not_ok (by + simpa [lowerE, hsource, huuEq] using hrun)).elim + | shared => + have hrun' := hrun + simp only [lowerE, hsource, hsuEq, Bool.false_eq_true, + if_false] at hrun' + obtain ⟨wrapper, wrapperState, _, hpureRun⟩ := + bind_run_ok_inv hrun' + have houtput := congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1.entries + | .error _ _ => []) hpureRun + simpa [VEnv.bump] using houtput.symm + | recursor numArgs natLit rules => + cases world with + | unique => exact (throw_run_not_ok (by + simpa [lowerE, hsource, huuEq] using hrun)).elim + | shared => + have hpure := hrun + simp [lowerE, hsource, hsuEq] at hpure + rw [← hpure.1.1] + rfl + | extern arity => + cases arity with + | zero => + have hpure := hrun + simp [lowerE, hsource] at hpure + rw [← hpure.1.1] + rfl + | succ arity => + cases world with + | unique => exact (throw_run_not_ok (by + simpa [lowerE, hsource, huuEq] using hrun)).elim + | shared => + have hpure := hrun + simp [lowerE, hsource, hsuEq] at hpure + rw [← hpure.1.1] + rfl + +private theorem lowerE_proj_noRecSelf + {src : IxIR0.Env} {fuel : Nat} + (hborrow : LowerBorrowPreservesNoRecSelf src fuel) + {input output : VEnv} {world : Owned} {fieldIndex : Nat} + {source : IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {value : AVal} + (hrun : (lowerE src (fuel + 1) input world + (.proj fieldIndex source)).run state = + .ok (output, emit, value) finalState) + (hno : NoRecSelf input) : NoRecSelf output := by + cases world with + | unique => + have huuEq : (Owned.unique == Owned.unique) = true := by decide + simp [lowerE, huuEq] at hrun + | shared => + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + simp only [lowerE, hsuEq, Bool.false_eq_true, if_false] at hrun + obtain ⟨borrowResult, middleState, hborrowRun, hafterBorrow⟩ := + bind_run_ok_inv hrun + rcases borrowResult with + ⟨borrowOutput, borrowEmit, borrowed, release⟩ + have hborrowNo := hborrow hborrowRun hno + cases borrowed with + | constA atom => + cases atom with + | var relative => + have hpure : borrowOutput.bump = output := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hafterBorrow + simpa using hvalue + subst output + exact hborrowNo.bump + | lit literal => + have hpure : borrowOutput.bump = output := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hafterBorrow + simpa using hvalue + subst output + exact hborrowNo.bump + | erased => + have hpure : borrowOutput = output := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hafterBorrow + simpa using hvalue + subst output + exact hborrowNo + | slotA targetAbs => + cases release with + | false => + have hpure : borrowOutput.bump.bump = output := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hafterBorrow + simpa using hvalue + subst output + exact hborrowNo.bump.bump + | true => + have hpure : borrowOutput.bump.bump.bump = output := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hafterBorrow + simpa using hvalue + subst output + exact hborrowNo.bump.bump.bump + +private theorem lowerE_mapped_body_pop_noRecSelf + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesNoRecSelf src fuel) + {bodyInput output : VEnv} {world : Owned} {body : IxIR0.Expr} + {state finalState : LowSt} {emit : Emit} {value : AVal} + {finish : (VEnv × Emit × AVal) → (VEnv × Emit × AVal)} + (hrun : (finish <$> lowerE src fuel bodyInput world body).run state = + .ok (output, emit, value) finalState) + (hfinish : ∀ result, (finish result).1 = result.1.pop) + (hno : NoRecSelf bodyInput) : NoRecSelf output := by + obtain ⟨bodyResult, hbodyRun, hvalue⟩ := map_run_ok_inv hrun + rcases bodyResult with ⟨bodyOutput, bodyEmit, bodyValue⟩ + have houtput : bodyOutput.pop = output := by + have := congrArg Prod.fst hvalue + simpa [hfinish] using this + subst output + exact (hexpr hbodyRun hno).pop + +private theorem lowerE_let_noRecSelf + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesNoRecSelf src fuel) + {input output : VEnv} {world : Owned} {binderUses : Uses} + {bound body : IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {value : AVal} + (hrun : (lowerE src (fuel + 1) input world + (.letE binderUses bound body)).run state = + .ok (output, emit, value) finalState) + (hno : NoRecSelf input) : NoRecSelf output := by + simp only [lowerE] at hrun + obtain ⟨boundResult, boundState, hboundRun, hafterBound⟩ := + bind_run_ok_inv hrun + rcases boundResult with ⟨middle, boundEmit, boundValue⟩ + have hmiddle := hexpr hboundRun hno + cases boundValue with + | slotA boundAbs => + by_cases hzero : countUses 0 body = 0 + · cases binderUses with + | erased => + obtain ⟨_, _, hthrow, _⟩ := bind_run_ok_inv + (by simpa [hzero] using hafterBound) + exact (throw_run_not_ok hthrow).elim + | linear => + obtain ⟨_, _, hthrow, _⟩ := bind_run_ok_inv + (by simpa [hzero] using hafterBound) + exact (throw_run_not_ok hthrow).elim + | affine => + let bodyInput : VEnv := + { middle with + entries := .slot boundAbs 0 .affine false :: middle.entries + depth := middle.depth + 1 } + have hbodyNo : NoRecSelf bodyInput := by + exact hmiddle.consSlot boundAbs 0 .affine false + apply lowerE_mapped_body_pop_noRecSelf hexpr + (bodyInput := bodyInput) + (by simpa [hzero, bodyInput] using hafterBound) + (fun _ => rfl) hbodyNo + | many => + let bodyInput : VEnv := + { middle with + entries := .slot boundAbs 0 .many false :: middle.entries + depth := middle.depth + 1 } + have hbodyNo : NoRecSelf bodyInput := by + exact hmiddle.consSlot boundAbs 0 .many false + apply lowerE_mapped_body_pop_noRecSelf hexpr + (bodyInput := bodyInput) + (by simpa [hzero, bodyInput] using hafterBound) + (fun _ => rfl) hbodyNo + · let bodyInput : VEnv := + { middle with + entries := + .slot boundAbs (countUses 0 body) binderUses true :: + middle.entries } + have hbodyNo : NoRecSelf bodyInput := by + exact hmiddle.consSlot boundAbs (countUses 0 body) binderUses true + apply lowerE_mapped_body_pop_noRecSelf hexpr + (bodyInput := bodyInput) + (by simpa [hzero, bodyInput] using hafterBound) + (fun _ => rfl) hbodyNo + + | constA atom => + by_cases hzero : countUses 0 body = 0 + · let bodyInput : VEnv := + { middle with + entries := .slot middle.depth 0 binderUses false :: middle.entries + depth := middle.depth + 1 } + have hbodyNo : NoRecSelf bodyInput := by + exact hmiddle.consSlot middle.depth 0 binderUses false + apply lowerE_mapped_body_pop_noRecSelf hexpr + (bodyInput := bodyInput) + (by simpa [hzero, bodyInput] using hafterBound) + (fun _ => rfl) hbodyNo + + · let bodyInput : VEnv := + { middle with + entries := + .slot middle.depth (countUses 0 body) binderUses true :: + middle.entries + depth := middle.depth + 1 } + have hbodyNo : NoRecSelf bodyInput := by + exact hmiddle.consSlot middle.depth (countUses 0 body) binderUses true + apply lowerE_mapped_body_pop_noRecSelf hexpr + (bodyInput := bodyInput) + (by simpa [hzero, bodyInput] using hafterBound) + (fun _ => rfl) hbodyNo + +private theorem lowerE_var_noRecSelf + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {world : Owned} {index : Nat} {state finalState : LowSt} + {emit : Emit} {value : AVal} + (hrun : (lowerE src (fuel + 1) input world (.var index)).run state = + .ok (output, emit, value) finalState) + (hno : NoRecSelf input) : NoRecSelf output := by + have hssNe : (Owned.shared != Owned.shared) = false := by decide + have huuNe : (Owned.unique != Owned.unique) = false := by decide + have hsuNe : (Owned.shared != Owned.unique) = true := by decide + have husNe : (Owned.unique != Owned.shared) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + have huuEq : (Owned.unique == Owned.unique) = true := by decide + cases hentry : input.entries[index]? with + | none => exact (throw_run_not_ok (by + simpa [lowerE, hentry] using hrun)).elim + | some entry => + cases entry with + | recSelf arity => exact (hno index arity hentry).elim + | slot abs remaining uses held => + cases held with + | false => exact (throw_run_not_ok (by + simpa [lowerE, hentry] using hrun)).elim + | true => + by_cases hworld : worldOfUses uses = world + · subst world + have hsame : + (worldOfUses uses != worldOfUses uses) = false := by + cases uses <;> decide + cases remaining with + | zero => exact (throw_run_not_ok (by + simpa [lowerE, hentry, hsame] using hrun)).elim + | succ remaining => + cases remaining with + | zero => + have hpure : + (input.setEntry index (.slot abs 0 uses false), + (_root_.id : Emit), AVal.slotA abs) = + (output, emit, value) ∧ state = finalState := by + simpa [lowerE, hentry, hsame] using hrun + cases hpure.1 + exact hno.setSlot index abs 0 uses false + | succ remaining => + by_cases hunique : worldOfUses uses = .unique + · have huniqueEq : + (worldOfUses uses == Owned.unique) = true := by + rw [hunique] + exact huuEq + exact (throw_run_not_ok (by + simpa [lowerE, hentry, hsame, huniqueEq, huuNe] + using hrun)).elim + · have huniqueEq : + (worldOfUses uses == Owned.unique) = false := by + cases uses <;> simp_all [worldOfUses] <;> decide + let changed := input.setEntry index + (.slot abs (remaining + 1) uses true) + have hpure : + (changed.bump, + emitOp (.dup (.var (changed.rel abs))), + AVal.slotA changed.depth) = + (output, emit, value) ∧ state = finalState := by + simpa [lowerE, hentry, hsame, huniqueEq, hssNe, changed] + using hrun + cases hpure.1 + exact (hno.setSlot index abs (remaining + 1) uses true).bump + · cases uses <;> cases world + all_goals + try { exact (hworld (by rfl)).elim } + all_goals + exact (throw_run_not_ok (by + simpa [lowerE, hentry, worldOfUses, hssNe, huuNe, hsuNe, + husNe, hsuEq, huuEq] using hrun)).elim + +theorem lowerEPreservesNoRecSelf_succ + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesNoRecSelf src fuel) + (hborrow : LowerBorrowPreservesNoRecSelf src fuel) + (hspine : LowerSpinePreservesNoRecSelf src fuel) + (hlam : LowerLamPreservesNoRecSelf src fuel) : + LowerEPreservesNoRecSelf src (fuel + 1) := by + intro input world expr state finalState output emit value hrun hno + cases expr with + | var index => exact lowerE_var_noRecSelf hrun hno + | ref address => + exact hno.of_entries_eq (lowerE_ref_entries_eq_noRecSelf hrun) + | app function argument => + apply hspine + · simpa [lowerE] using hrun + · exact hno + | lam uses body => + cases world with + | unique => + have huuEq : (Owned.unique == Owned.unique) = true := by decide + exact (throw_run_not_ok (by + simpa [lowerE, huuEq] using hrun)).elim + | shared => + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + apply hlam + · simpa [lowerE, hsuEq] using hrun + · exact hno + | letE uses bound body => exact lowerE_let_noRecSelf hexpr hrun hno + | proj fieldIndex source => exact lowerE_proj_noRecSelf hborrow hrun hno + | lit literal => + have hpure : + (input, (_root_.id : Emit), AVal.constA (.lit literal)) = + (output, emit, value) ∧ state = finalState := by + simpa [lowerE] using hrun + cases hpure.1 + exact hno + | erased => + have hpure : + (input, (_root_.id : Emit), AVal.constA .erased) = + (output, emit, value) ∧ state = finalState := by + simpa [lowerE] using hrun + cases hpure.1 + exact hno + +theorem lowerPreservesNoRecSelf_succ + {src : IxIR0.Env} {fuel : Nat} + (hprev : LowerPreservesNoRecSelf src fuel) : + LowerPreservesNoRecSelf src (fuel + 1) where + expr := lowerEPreservesNoRecSelf_succ + hprev.expr hprev.borrow hprev.spine hprev.lam + borrow := lowerBorrowPreservesNoRecSelf_succ hprev.expr + spine := lowerSpinePreservesNoRecSelf_succ + hprev.expr hprev.spine hprev.knownCall hprev.applyRest + knownCall := knownCallPreservesNoRecSelf_succ hprev.args hprev.applyRest + args := lowerArgsPreservesNoRecSelf_succ hprev.expr hprev.args + applyRest := applyRestPreservesNoRecSelf_succ hprev.args + lam := lowerLamPreservesNoRecSelf_succ + +/-- Successful lowering never synthesizes the recursor-only logical entry. -/ +theorem lowerPreservesNoRecSelf (src : IxIR0.Env) : + ∀ fuel, LowerPreservesNoRecSelf src fuel + | 0 => lowerPreservesNoRecSelf_zero src + | fuel + 1 => + lowerPreservesNoRecSelf_succ (lowerPreservesNoRecSelf src fuel) + +theorem lowerE_noRecSelf + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {world : Owned} {expr : IxIR0.Expr} + {state finalState : LowSt} {emit : Emit} {value : AVal} + (hrun : (lowerE src fuel input world expr).run state = + .ok (output, emit, value) finalState) + (hno : NoRecSelf input) : NoRecSelf output := + (lowerPreservesNoRecSelf src fuel).expr hrun hno + +/-! ## Logical-entry cardinality + +The lowering environment may gain physical runtime slots (`depth`), but a +completed expression never gains or loses source-level logical entries. Let +binders are installed only for the recursive body run and are popped again at +the boundary. This structural invariant complements exact occurrence +consumption: together they rule out untracked output entries when closing a +generated function body. -/ + +/-- The output contains exactly as many source-level entries as the input. -/ +def EntryCountPreserved (input output : VEnv) : Prop := + output.entries.length = input.entries.length + +theorem EntryCountPreserved.refl (input : VEnv) : + EntryCountPreserved input input := rfl + +theorem EntryCountPreserved.trans {first middle final : VEnv} + (hleft : EntryCountPreserved first middle) + (hright : EntryCountPreserved middle final) : + EntryCountPreserved first final := + Eq.trans hright hleft + +theorem EntryCountPreserved.bump {input output : VEnv} + (h : EntryCountPreserved input output) : + EntryCountPreserved input output.bump := by + simpa [EntryCountPreserved, VEnv.bump] using h + +theorem releaseAll_preservesEntryCount (input : VEnv) (values : List AVal) : + EntryCountPreserved input (releaseAll input values).1 := by + exact releaseAll_traverse_core + (Result := fun initial _ output _ => + EntryCountPreserved initial output) + (hnil := EntryCountPreserved.refl) + (hconst := fun htail => htail) + (hslot := by + intro initial abs rest output tailEmit htail + simpa [EntryCountPreserved, VEnv.bump] using htail) + input values + +/-- Entry releases update slots in place and therefore preserve logical-entry +cardinality even though each emitted drop bumps the physical depth. -/ +theorem releaseSlots_preservesEntryCount (input : VEnv) : + ∀ {drops output emit state finalState}, + (releaseSlots input drops).run state = + .ok (output, emit) finalState → + EntryCountPreserved input output := by + intro drops output emit state finalState hrun + exact releaseSlots_run_core + (Result := fun initial final _ _ => + EntryCountPreserved initial final) + (hnil := EntryCountPreserved.refl) + (haffine := by + intro entry abs rest initial final tailEmit htail + simpa [EntryCountPreserved, VEnv.bump, VEnv.setEntry] using htail) + (hmany := by + intro entry abs rest initial final tailEmit htail + simpa [EntryCountPreserved, VEnv.bump, VEnv.setEntry] using htail) + hrun + +theorem lowerCapture_preservesEntryCount (expr : IxIR0.Expr) (input : VEnv) + (index : Nat) {output : VEnv} {emit : Emit} {value : AVal} + {state finalState : LowSt} + (hrun : (lowerCapture expr input index).run state = + .ok (output, emit, value) finalState) : + EntryCountPreserved input output := by + cases hentry : input.entries[index]? with + | none => exact (throw_run_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | some entry => + cases entry with + | recSelf arity => exact (throw_run_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | slot abs remaining uses held => + cases held with + | false => exact (throw_run_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | true => + by_cases hunique : worldOfUses uses = .unique + · have huuEq : (Owned.unique == Owned.unique) = true := by decide + exact (throw_run_not_ok (by + simpa [lowerCapture, hentry, hunique, huuEq] using hrun)).elim + · have huniqueEq : + (worldOfUses uses == Owned.unique) = false := by + cases uses <;> simp_all [worldOfUses] <;> decide + by_cases hmore : remaining > countUses index expr + · have houtput : output = + (input.setEntry index + (.slot abs (remaining - countUses index expr) uses true)).bump := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hrun + simpa [lowerCapture, hentry, huniqueEq, hmore] using hvalue.symm + subst output + simp [EntryCountPreserved, VEnv.setEntry, VEnv.bump] + · by_cases hequal : remaining = countUses index expr + · have houtput : output = + input.setEntry index (.slot abs 0 uses false) := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hrun + simpa [lowerCapture, hentry, huniqueEq, hmore, hequal] + using hvalue.symm + subst output + simp [EntryCountPreserved, VEnv.setEntry] + · exact (throw_run_not_ok (by + simpa [lowerCapture, hentry, huniqueEq, hmore, hequal] + using hrun)).elim + +theorem lowerCaptures_preservesEntryCount (expr : IxIR0.Expr) : + ∀ {indices input output emit values state finalState}, + (lowerCaptures expr input indices).run state = + .ok (output, emit, values) finalState → + EntryCountPreserved input output := by + intro indices input output emit values state finalState hrun + apply lowerCaptures_run_core + (Result := fun input output _ _ _ => + EntryCountPreserved input output) + (e := expr) (hrun := hrun) + · intro input + exact .refl input + · intro index rest input middle output headEmit tailEmit headValue + tailValues state middleState hheadRun htail + exact (lowerCapture_preservesEntryCount expr input index hheadRun).trans + htail + +def LowerEPreservesEntryCount (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {world : Owned} {expr : IxIR0.Expr} + {state finalState : LowSt} {output : VEnv} {emit : Emit} {value : AVal}, + (lowerE src fuel input world expr).run state = + .ok (output, emit, value) finalState → + EntryCountPreserved input output + +def LowerBorrowPreservesEntryCount (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {expr : IxIR0.Expr} {state finalState : LowSt} + {output : VEnv} {emit : Emit} {value : AVal} {release : Bool}, + (lowerBorrow src fuel input expr).run state = + .ok (output, emit, value, release) finalState → + EntryCountPreserved input output + +def LowerSpinePreservesEntryCount (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {world : Owned} {head : IxIR0.Expr} + {args : List IxIR0.Expr} {state finalState : LowSt} + {output : VEnv} {emit : Emit} {value : AVal}, + (lowerSpine src fuel input world head args).run state = + .ok (output, emit, value) finalState → + EntryCountPreserved input output + +def KnownCallPreservesEntryCount (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {build : Array Atom → Op} {count : Nat} + {argWorlds : List Owned} {resultWorld : Owned} + {args : List IxIR0.Expr} {state finalState : LowSt} + {output : VEnv} {emit : Emit} {value : AVal}, + (knownCall src fuel input build count argWorlds resultWorld args).run + state = .ok (output, emit, value) finalState → + EntryCountPreserved input output + +def LowerArgsPreservesEntryCount (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {args : List (IxIR0.Expr × Owned)} + {state finalState : LowSt} {output : VEnv} + {emit : Emit} {values : List AVal}, + (lowerArgs src fuel input args).run state = + .ok (output, emit, values) finalState → + EntryCountPreserved input output + +def ApplyRestPreservesEntryCount (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {resultWorld : Owned} {pre : Emit} + {function : AVal} {args : List IxIR0.Expr} + {state finalState : LowSt} {output : VEnv} + {emit : Emit} {value : AVal}, + (applyRest src fuel input resultWorld pre function args).run state = + .ok (output, emit, value) finalState → + EntryCountPreserved input output + +def LowerLamPreservesEntryCount (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {expr : IxIR0.Expr} {state finalState : LowSt} + {output : VEnv} {emit : Emit} {value : AVal}, + (lowerLam src fuel input expr).run state = + .ok (output, emit, value) finalState → + EntryCountPreserved input output + +structure LowerPreservesEntryCount (src : IxIR0.Env) (fuel : Nat) : Prop where + expr : LowerEPreservesEntryCount src fuel + borrow : LowerBorrowPreservesEntryCount src fuel + spine : LowerSpinePreservesEntryCount src fuel + knownCall : KnownCallPreservesEntryCount src fuel + args : LowerArgsPreservesEntryCount src fuel + applyRest : ApplyRestPreservesEntryCount src fuel + lam : LowerLamPreservesEntryCount src fuel + +theorem lowerPreservesEntryCount_zero (src : IxIR0.Env) : + LowerPreservesEntryCount src 0 := by + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro input world expr state finalState output emit value hrun + exact (throw_run_not_ok (by simpa [lowerE] using hrun)).elim + · intro input expr state finalState output emit value release hrun + exact (throw_run_not_ok (by simpa [lowerBorrow] using hrun)).elim + · intro input world head args state finalState output emit value hrun + exact (throw_run_not_ok (by simpa [lowerSpine] using hrun)).elim + · intro input build count argWorlds resultWorld args state finalState + output emit value hrun + exact (throw_run_not_ok (by simpa [knownCall] using hrun)).elim + · intro input args state finalState output emit values hrun + exact (throw_run_not_ok (by simpa [lowerArgs] using hrun)).elim + · intro input resultWorld pre function args state finalState output emit + value hrun + exact (throw_run_not_ok (by simpa [applyRest] using hrun)).elim + · intro input expr state finalState output emit value hrun + exact (throw_run_not_ok (by simpa [lowerLam] using hrun)).elim + +theorem lowerArgsPreservesEntryCount_succ {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesEntryCount src fuel) + (hargs : LowerArgsPreservesEntryCount src fuel) : + LowerArgsPreservesEntryCount src (fuel + 1) := by + intro input args state finalState output emit values hrun + cases args with + | nil => + have hpure : + (input, (_root_.id : Emit), []) = (output, emit, values) ∧ + state = finalState := by + simpa [lowerArgs] using hrun + cases hpure.1 + exact .refl input + | cons head rest => + rcases head with ⟨expr, world⟩ + simp only [lowerArgs] at hrun + obtain ⟨headResult, middleState, hheadRun, hafterHead⟩ := + bind_run_ok_inv hrun + rcases headResult with ⟨middle, headEmit, headValue⟩ + obtain ⟨tailResult, tailState, htailRun, hafterTail⟩ := + bind_run_ok_inv hafterHead + rcases tailResult with ⟨actualOutput, tailEmit, tailValues⟩ + have hvalue : actualOutput = output := by + have hpure : + (actualOutput, headEmit ∘ tailEmit, headValue :: tailValues) = + (output, emit, values) ∧ tailState = finalState := by + simpa using hafterTail + exact congrArg Prod.fst hpure.1 + subst output + exact (hexpr hheadRun).trans (hargs htailRun) + +theorem applyRestPreservesEntryCount_succ {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsPreservesEntryCount src fuel) : + ApplyRestPreservesEntryCount src (fuel + 1) := by + intro input resultWorld pre function args state finalState output emit value + hrun + cases function with + | constA atom => + cases atom with + | erased => + simp only [applyRest] at hrun + obtain ⟨argsResult, argsState, hargsRun, hpureRun⟩ := + bind_run_ok_inv hrun + rcases argsResult with ⟨middle, argsEmit, values⟩ + have hpure : (releaseAll middle values).1 = output := by + have hvalue : + ((releaseAll middle values).1, + pre ∘ argsEmit ∘ (releaseAll middle values).2, + AVal.constA .erased) = (output, emit, value) ∧ + argsState = finalState := by + simpa using hpureRun + exact congrArg Prod.fst hvalue.1 + subst output + exact (hargs hargsRun).trans + (releaseAll_preservesEntryCount middle values) + | var relative => + simp only [applyRest] at hrun + obtain ⟨_, checkedState, _, hafterCheck⟩ := bind_run_ok_inv hrun + obtain ⟨argsResult, argsState, hargsRun, hpureRun⟩ := + bind_run_ok_inv hafterCheck + rcases argsResult with ⟨middle, argsEmit, values⟩ + have houtput : middle.bump = output := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hpureRun + simpa using hvalue + subst output + exact (hargs hargsRun).bump + | lit literal => + simp only [applyRest] at hrun + obtain ⟨_, checkedState, _, hafterCheck⟩ := bind_run_ok_inv hrun + obtain ⟨argsResult, argsState, hargsRun, hpureRun⟩ := + bind_run_ok_inv hafterCheck + rcases argsResult with ⟨middle, argsEmit, values⟩ + have houtput : middle.bump = output := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hpureRun + simpa using hvalue + subst output + exact (hargs hargsRun).bump + | slotA abs => + simp only [applyRest] at hrun + obtain ⟨_, checkedState, _, hafterCheck⟩ := bind_run_ok_inv hrun + obtain ⟨argsResult, argsState, hargsRun, hpureRun⟩ := + bind_run_ok_inv hafterCheck + rcases argsResult with ⟨middle, argsEmit, values⟩ + have houtput : middle.bump = output := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hpureRun + simpa using hvalue + subst output + exact (hargs hargsRun).bump + +theorem knownCallPreservesEntryCount_succ {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsPreservesEntryCount src fuel) + (hrest : ApplyRestPreservesEntryCount src fuel) : + KnownCallPreservesEntryCount src (fuel + 1) := by + intro input build count argWorlds resultWorld args state finalState output + emit value hrun + simp only [knownCall] at hrun + obtain ⟨argsResult, argsState, hargsRun, hafterArgs⟩ := + bind_run_ok_inv hrun + rcases argsResult with ⟨middle, argsEmit, values⟩ + have hmiddle := hargs hargsRun + by_cases hterminal : args.length ≤ count + · have houtput : middle.bump = output := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hafterArgs + simpa [hterminal] using hvalue + subst output + exact hmiddle.bump + · have hrestRun : + (applyRest src fuel middle.bump resultWorld + (argsEmit ∘ emitOp + (build (values.map (·.toAtom middle)).toArray)) + (.slotA middle.depth) (args.drop count)).run argsState = + .ok (output, emit, value) finalState := by + simpa [hterminal] using hafterArgs + exact hmiddle.bump.trans (hrest hrestRun) + +private theorem lowerBorrow_dynamic_preservesEntryCount + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesEntryCount src fuel) + {input output : VEnv} {expr : IxIR0.Expr} + {state finalState : LowSt} {emit : Emit} {value : AVal} + {releaseFlag : Bool} + {finish : (VEnv × Emit × AVal) → (VEnv × Emit × AVal × Bool)} + (hrun : (finish <$> lowerE src fuel input .shared expr).run state = + .ok (output, emit, value, releaseFlag) finalState) + (hfinish : ∀ result, (finish result).1 = result.1) : + EntryCountPreserved input output := by + obtain ⟨exprResult, hexprRun, hvalue⟩ := map_run_ok_inv hrun + rcases exprResult with ⟨middle, middleEmit, middleValue⟩ + have houtput : middle = output := by + have := congrArg Prod.fst hvalue + simpa [hfinish] using this + subst output + exact hexpr hexprRun + +theorem lowerBorrowPreservesEntryCount_succ + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesEntryCount src fuel) : + LowerBorrowPreservesEntryCount src (fuel + 1) := by + intro input expr state finalState output emit value release hrun + cases expr with + | var index => + cases hentry : input.entries[index]? with + | none => exact (throw_run_not_ok (by + simpa [lowerBorrow, hentry] using hrun)).elim + | some entry => + cases entry with + | recSelf arity => exact (throw_run_not_ok (by + simpa [lowerBorrow, hentry] using hrun)).elim + | slot abs remaining uses held => + cases held with + | false => exact (throw_run_not_ok (by + simpa [lowerBorrow, hentry] using hrun)).elim + | true => + by_cases hunique : worldOfUses uses = .unique + · have huuEq : (Owned.unique == Owned.unique) = true := by decide + exact (throw_run_not_ok (by + simpa [lowerBorrow, hentry, hunique, huuEq] using hrun)).elim + · have huniqueEq : + (worldOfUses uses == Owned.unique) = false := by + cases uses <;> simp_all [worldOfUses] <;> decide + cases remaining with + | zero => exact (throw_run_not_ok (by + simpa [lowerBorrow, hentry, huniqueEq] using hrun)).elim + | succ remaining => + cases remaining with + | zero => + have hpure : + (input.setEntry index (.slot abs 0 uses false), + (_root_.id : Emit), AVal.slotA abs, true) = + (output, emit, value, release) ∧ + state = finalState := by + simpa [lowerBorrow, hentry, huniqueEq] using hrun + cases hpure.1 + simp [EntryCountPreserved, VEnv.setEntry] + | succ remaining => + have hpure : + (input.setEntry index + (.slot abs (remaining + 1) uses true), + (_root_.id : Emit), AVal.slotA abs, false) = + (output, emit, value, release) ∧ + state = finalState := by + simpa [lowerBorrow, hentry, huniqueEq] using hrun + cases hpure.1 + simp [EntryCountPreserved, VEnv.setEntry] + | ref address => + apply lowerBorrow_dynamic_preservesEntryCount hexpr + (by simpa [lowerBorrow] using hrun) (fun _ => rfl) + | app function argument => + apply lowerBorrow_dynamic_preservesEntryCount hexpr + (by simpa [lowerBorrow] using hrun) (fun _ => rfl) + | lam uses body => + apply lowerBorrow_dynamic_preservesEntryCount hexpr + (by simpa [lowerBorrow] using hrun) (fun _ => rfl) + | letE uses value body => + apply lowerBorrow_dynamic_preservesEntryCount hexpr + (by simpa [lowerBorrow] using hrun) (fun _ => rfl) + | proj index source => + apply lowerBorrow_dynamic_preservesEntryCount hexpr + (by simpa [lowerBorrow] using hrun) (fun _ => rfl) + | lit literal => + apply lowerBorrow_dynamic_preservesEntryCount hexpr + (by simpa [lowerBorrow] using hrun) (fun _ => rfl) + | erased => + apply lowerBorrow_dynamic_preservesEntryCount hexpr + (by simpa [lowerBorrow] using hrun) (fun _ => rfl) + +private theorem lowerE_applyRest_preservesEntryCount + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesEntryCount src fuel) + (hrest : ApplyRestPreservesEntryCount src fuel) + {input output : VEnv} {world : Owned} {head : IxIR0.Expr} + {args : List IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {value : AVal} + (hrun : (do + let (middle, headEmit, function) ← + lowerE src fuel input .shared head + applyRest src fuel middle world headEmit function args).run state = + .ok (output, emit, value) finalState) : + EntryCountPreserved input output := by + obtain ⟨headResult, middleState, hheadRun, hrestRun⟩ := + bind_run_ok_inv hrun + rcases headResult with ⟨middle, headEmit, function⟩ + exact (hexpr hheadRun).trans (hrest hrestRun) + +theorem lowerSpinePreservesEntryCount_succ + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesEntryCount src fuel) + (hspine : LowerSpinePreservesEntryCount src fuel) + (hknown : KnownCallPreservesEntryCount src fuel) + (hrest : ApplyRestPreservesEntryCount src fuel) : + LowerSpinePreservesEntryCount src (fuel + 1) := by + intro input world head args state finalState output emit value hrun + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases head with + | app function argument => + apply hspine + simpa [lowerSpine] using hrun + | erased => + apply hrest + simpa [lowerSpine] using hrun + | var index => + simp only [lowerSpine] at hrun + cases hentry : input.entries[index]? with + | none => + apply lowerE_applyRest_preservesEntryCount hexpr hrest + simpa [hentry] using hrun + | some entry => + cases entry with + | recSelf arity => + rw [hentry] at hrun + simp only at hrun + by_cases hunder : args.length < arity + · rw [if_pos hunder] at hrun + exact (throw_run_not_ok hrun).elim + · rw [if_neg hunder] at hrun + obtain ⟨unitValue, checkedState, _, hknownRun⟩ := + bind_run_ok_inv hrun + cases unitValue + exact hknown hknownRun + | slot abs remaining uses held => + apply lowerE_applyRest_preservesEntryCount hexpr hrest + simpa [hentry] using hrun + | ref address => + simp only [lowerSpine] at hrun + cases hsource : src address with + | none => + rw [hsource] at hrun + exact (throw_run_not_ok hrun).elim + | some decl => + rw [hsource] at hrun + cases decl with + | defn result body => + simp only at hrun + by_cases hunder : args.length < lamArity body + · rw [if_pos hunder] at hrun + cases world with + | unique => exact (throw_run_not_ok hrun).elim + | shared => + cases result with + | unique => exact (throw_run_not_ok hrun).elim + | shared => + cases hp : papSafe body with + | false => exact (throw_run_not_ok (by + simpa [hp, hsuEq] using hrun)).elim + | true => + apply hknown + simpa [hp, hsuEq] using hrun + · rw [if_neg hunder] at hrun + obtain ⟨_, checkedState, _, hknownRun⟩ := bind_run_ok_inv hrun + exact hknown hknownRun + | ctor tag arity => + simp only at hrun + by_cases hunder : args.length < arity + · rw [if_pos hunder] at hrun + cases world with + | unique => exact (throw_run_not_ok hrun).elim + | shared => + obtain ⟨wrapper, wrapperState, _, hknownRun⟩ := + bind_run_ok_inv hrun + exact hknown hknownRun + · rw [if_neg hunder] at hrun + exact hknown hrun + | recursor numArgs natLit rules => + simp only at hrun + by_cases hunder : args.length < numArgs + 1 + · rw [if_pos hunder] at hrun + cases world with + | unique => exact (throw_run_not_ok hrun).elim + | shared => exact hknown hrun + · rw [if_neg hunder] at hrun + obtain ⟨_, checkedState, _, hknownRun⟩ := bind_run_ok_inv hrun + exact hknown hknownRun + | extern arity => + simp only at hrun + by_cases hunder : args.length < arity + · rw [if_pos hunder] at hrun + cases world with + | unique => exact (throw_run_not_ok hrun).elim + | shared => exact hknown hrun + · rw [if_neg hunder] at hrun + exact hknown hrun + | lam uses body => + apply lowerE_applyRest_preservesEntryCount hexpr hrest + simpa [lowerSpine] using hrun + | letE uses bound body => + apply lowerE_applyRest_preservesEntryCount hexpr hrest + simpa [lowerSpine] using hrun + | proj index source => + apply lowerE_applyRest_preservesEntryCount hexpr hrest + simpa [lowerSpine] using hrun + | lit literal => + apply lowerE_applyRest_preservesEntryCount hexpr hrest + simpa [lowerSpine] using hrun + +theorem lowerLamPreservesEntryCount_succ + {src : IxIR0.Env} {fuel : Nat} : + LowerLamPreservesEntryCount src (fuel + 1) := by + intro input expr state finalState output emit value hrun + cases hp : papSafe expr with + | false => simp [lowerLam, hp] at hrun + | true => + simp only [lowerLam] at hrun + simp only [hp, ↓reduceIte, bind_pure_comp] at hrun + let captures := (List.range input.entries.length).filter + (fun index => countUses index expr > 0) + have hcaptures : captures = (List.range input.entries.length).filter + (fun index => countUses index expr > 0) := rfl + rw [← hcaptures] at hrun + obtain ⟨captureResult, captureState, hcaptureRun, hafterCapture⟩ := + bind_run_ok_inv hrun + rcases captureResult with ⟨captureOutput, captureEmit, captureValues⟩ + obtain ⟨fnAddr, addressState, _, hafterFresh⟩ := + bind_run_ok_inv hafterCapture + obtain ⟨code, bodyState, _, hafterBody⟩ := + bind_run_ok_inv hafterFresh + obtain ⟨_, _, hvalue⟩ := map_run_ok_inv hafterBody + have houtput : captureOutput.bump = output := + congrArg Prod.fst hvalue + subst output + exact (lowerCaptures_preservesEntryCount expr hcaptureRun).bump + +private theorem lowerE_proj_preservesEntryCount + {src : IxIR0.Env} {fuel : Nat} + (hborrow : LowerBorrowPreservesEntryCount src fuel) + {input output : VEnv} {world : Owned} {fieldIndex : Nat} + {source : IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {value : AVal} + (hrun : (lowerE src (fuel + 1) input world + (.proj fieldIndex source)).run state = + .ok (output, emit, value) finalState) : + EntryCountPreserved input output := by + cases world with + | unique => + have huuEq : (Owned.unique == Owned.unique) = true := by decide + simp [lowerE, huuEq] at hrun + | shared => + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + simp only [lowerE, hsuEq, Bool.false_eq_true, if_false] at hrun + obtain ⟨borrowResult, middleState, hborrowRun, hafterBorrow⟩ := + bind_run_ok_inv hrun + rcases borrowResult with + ⟨borrowOutput, borrowEmit, borrowed, release⟩ + have hborrowCount := hborrow hborrowRun + cases borrowed with + | constA atom => + cases atom with + | var relative => + have hpure : borrowOutput.bump = output := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hafterBorrow + simpa using hvalue + subst output + exact hborrowCount.bump + | lit literal => + have hpure : borrowOutput.bump = output := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hafterBorrow + simpa using hvalue + subst output + exact hborrowCount.bump + | erased => + have hpure : borrowOutput = output := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hafterBorrow + simpa using hvalue + subst output + exact hborrowCount + | slotA targetAbs => + cases release with + | false => + have hpure : borrowOutput.bump.bump = output := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hafterBorrow + simpa using hvalue + subst output + exact hborrowCount.bump.bump + | true => + have hpure : borrowOutput.bump.bump.bump = output := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hafterBorrow + simpa using hvalue + subst output + exact hborrowCount.bump.bump.bump + +private theorem lowerE_mapped_body_pop_preservesEntryCount + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesEntryCount src fuel) + {middle bodyInput output : VEnv} {world : Owned} {body : IxIR0.Expr} + {state finalState : LowSt} {emit : Emit} {value : AVal} + {finish : (VEnv × Emit × AVal) → (VEnv × Emit × AVal)} + {binder : VEntry} + (hrun : (finish <$> lowerE src fuel bodyInput world body).run state = + .ok (output, emit, value) finalState) + (hfinish : ∀ result, (finish result).1 = result.1.pop) + (hentries : bodyInput.entries = binder :: middle.entries) : + EntryCountPreserved middle output := by + obtain ⟨bodyResult, hbodyRun, hvalue⟩ := map_run_ok_inv hrun + rcases bodyResult with ⟨bodyOutput, bodyEmit, bodyValue⟩ + have houtput : bodyOutput.pop = output := by + have := congrArg Prod.fst hvalue + simpa [hfinish] using this + subst output + have hbodyCount := hexpr hbodyRun + rw [EntryCountPreserved] at hbodyCount ⊢ + simp only [VEnv.pop] + rw [List.length_tail] + rw [hbodyCount, hentries] + simp + +private theorem lowerE_let_preservesEntryCount + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesEntryCount src fuel) + {input output : VEnv} {world : Owned} {binderUses : Uses} + {bound body : IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {value : AVal} + (hrun : (lowerE src (fuel + 1) input world + (.letE binderUses bound body)).run state = + .ok (output, emit, value) finalState) : + EntryCountPreserved input output := by + simp only [lowerE] at hrun + obtain ⟨boundResult, boundState, hboundRun, hafterBound⟩ := + bind_run_ok_inv hrun + rcases boundResult with ⟨middle, boundEmit, boundValue⟩ + have hmiddle := hexpr hboundRun + cases boundValue with + | slotA boundAbs => + by_cases hzero : countUses 0 body = 0 + · cases binderUses with + | erased => + obtain ⟨_, _, hthrow, _⟩ := bind_run_ok_inv + (by simpa [hzero] using hafterBound) + exact (throw_run_not_ok hthrow).elim + | linear => + obtain ⟨_, _, hthrow, _⟩ := bind_run_ok_inv + (by simpa [hzero] using hafterBound) + exact (throw_run_not_ok hthrow).elim + | affine => + let bodyInput : VEnv := + { middle with + entries := .slot boundAbs 0 .affine false :: middle.entries + depth := middle.depth + 1 } + apply hmiddle.trans + apply lowerE_mapped_body_pop_preservesEntryCount hexpr + (middle := middle) (bodyInput := bodyInput) + (by simpa [hzero, bodyInput] using hafterBound) + (fun _ => rfl) + rfl + | many => + let bodyInput : VEnv := + { middle with + entries := .slot boundAbs 0 .many false :: middle.entries + depth := middle.depth + 1 } + apply hmiddle.trans + apply lowerE_mapped_body_pop_preservesEntryCount hexpr + (middle := middle) (bodyInput := bodyInput) + (by simpa [hzero, bodyInput] using hafterBound) + (fun _ => rfl) + rfl + · let bodyInput : VEnv := + { middle with + entries := + .slot boundAbs (countUses 0 body) binderUses true :: + middle.entries } + apply hmiddle.trans + apply lowerE_mapped_body_pop_preservesEntryCount hexpr + (middle := middle) (bodyInput := bodyInput) + (by simpa [hzero, bodyInput] using hafterBound) + (fun _ => rfl) + rfl + | constA atom => + by_cases hzero : countUses 0 body = 0 + · let bodyInput : VEnv := + { middle with + entries := .slot middle.depth 0 binderUses false :: middle.entries + depth := middle.depth + 1 } + apply hmiddle.trans + apply lowerE_mapped_body_pop_preservesEntryCount hexpr + (middle := middle) (bodyInput := bodyInput) + (by simpa [hzero, bodyInput] using hafterBound) + (fun _ => rfl) + rfl + · let bodyInput : VEnv := + { middle with + entries := + .slot middle.depth (countUses 0 body) binderUses true :: + middle.entries + depth := middle.depth + 1 } + apply hmiddle.trans + apply lowerE_mapped_body_pop_preservesEntryCount hexpr + (middle := middle) (bodyInput := bodyInput) + (by simpa [hzero, bodyInput] using hafterBound) + (fun _ => rfl) + rfl + +private theorem lowerE_var_preservesEntryCount + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {world : Owned} {index : Nat} {state finalState : LowSt} + {emit : Emit} {value : AVal} + (hrun : (lowerE src (fuel + 1) input world (.var index)).run state = + .ok (output, emit, value) finalState) : + EntryCountPreserved input output := by + have hssNe : (Owned.shared != Owned.shared) = false := by decide + have huuNe : (Owned.unique != Owned.unique) = false := by decide + have hsuNe : (Owned.shared != Owned.unique) = true := by decide + have husNe : (Owned.unique != Owned.shared) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + have huuEq : (Owned.unique == Owned.unique) = true := by decide + cases hentry : input.entries[index]? with + | none => exact (throw_run_not_ok (by + simpa [lowerE, hentry] using hrun)).elim + | some entry => + cases entry with + | recSelf arity => exact (throw_run_not_ok (by + simpa [lowerE, hentry] using hrun)).elim + | slot abs remaining uses held => + cases held with + | false => exact (throw_run_not_ok (by + simpa [lowerE, hentry] using hrun)).elim + | true => + by_cases hworld : worldOfUses uses = world + · subst world + have hsame : + (worldOfUses uses != worldOfUses uses) = false := by + cases uses <;> decide + cases remaining with + | zero => exact (throw_run_not_ok (by + simpa [lowerE, hentry, hsame] using hrun)).elim + | succ remaining => + cases remaining with + | zero => + have hpure : + (input.setEntry index (.slot abs 0 uses false), + (_root_.id : Emit), AVal.slotA abs) = + (output, emit, value) ∧ state = finalState := by + simpa [lowerE, hentry, hsame] using hrun + cases hpure.1 + simp [EntryCountPreserved, VEnv.setEntry] + | succ remaining => + by_cases hunique : worldOfUses uses = .unique + · have huniqueEq : + (worldOfUses uses == Owned.unique) = true := by + rw [hunique] + exact huuEq + exact (throw_run_not_ok (by + simpa [lowerE, hentry, hsame, huniqueEq, huuNe] + using hrun)).elim + · have huniqueEq : + (worldOfUses uses == Owned.unique) = false := by + cases uses <;> simp_all [worldOfUses] <;> decide + let changed := input.setEntry index + (.slot abs (remaining + 1) uses true) + have hpure : + (changed.bump, + emitOp (.dup (.var (changed.rel abs))), + AVal.slotA changed.depth) = + (output, emit, value) ∧ state = finalState := by + simpa [lowerE, hentry, hsame, huniqueEq, hssNe, changed] + using hrun + cases hpure.1 + simp [EntryCountPreserved, changed, VEnv.setEntry, VEnv.bump] + · cases uses <;> cases world + all_goals + try { exact (hworld (by rfl)).elim } + all_goals + exact (throw_run_not_ok (by + simpa [lowerE, hentry, worldOfUses, hssNe, huuNe, hsuNe, + husNe, hsuEq, huuEq] using hrun)).elim + +theorem lowerEPreservesEntryCount_succ + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesEntryCount src fuel) + (hborrow : LowerBorrowPreservesEntryCount src fuel) + (hspine : LowerSpinePreservesEntryCount src fuel) + (hlam : LowerLamPreservesEntryCount src fuel) : + LowerEPreservesEntryCount src (fuel + 1) := by + intro input world expr state finalState output emit value hrun + cases expr with + | var index => exact lowerE_var_preservesEntryCount hrun + | ref address => + exact congrArg List.length (lowerE_ref_entries_eq_noRecSelf hrun) + | app function argument => + apply hspine + simpa [lowerE] using hrun + | lam uses body => + cases world with + | unique => + have huuEq : (Owned.unique == Owned.unique) = true := by decide + exact (throw_run_not_ok (by + simpa [lowerE, huuEq] using hrun)).elim + | shared => + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + apply hlam + simpa [lowerE, hsuEq] using hrun + | letE uses bound body => exact lowerE_let_preservesEntryCount hexpr hrun + | proj fieldIndex source => + exact lowerE_proj_preservesEntryCount hborrow hrun + | lit literal => + have hpure : + (input, (_root_.id : Emit), AVal.constA (.lit literal)) = + (output, emit, value) ∧ state = finalState := by + simpa [lowerE] using hrun + cases hpure.1 + exact .refl input + | erased => + have hpure : + (input, (_root_.id : Emit), AVal.constA .erased) = + (output, emit, value) ∧ state = finalState := by + simpa [lowerE] using hrun + cases hpure.1 + exact .refl input + +theorem lowerPreservesEntryCount_succ + {src : IxIR0.Env} {fuel : Nat} + (hprev : LowerPreservesEntryCount src fuel) : + LowerPreservesEntryCount src (fuel + 1) where + expr := lowerEPreservesEntryCount_succ + hprev.expr hprev.borrow hprev.spine hprev.lam + borrow := lowerBorrowPreservesEntryCount_succ hprev.expr + spine := lowerSpinePreservesEntryCount_succ + hprev.expr hprev.spine hprev.knownCall hprev.applyRest + knownCall := knownCallPreservesEntryCount_succ hprev.args hprev.applyRest + args := lowerArgsPreservesEntryCount_succ hprev.expr hprev.args + applyRest := applyRestPreservesEntryCount_succ hprev.args + lam := lowerLamPreservesEntryCount_succ + +/-- Successful expression lowering preserves the cardinality of its logical +source environment, even though emitted operations may increase runtime depth. -/ +theorem lowerPreservesEntryCount (src : IxIR0.Env) : + ∀ fuel, LowerPreservesEntryCount src fuel + | 0 => lowerPreservesEntryCount_zero src + | fuel + 1 => + lowerPreservesEntryCount_succ (lowerPreservesEntryCount src fuel) + +theorem lowerE_preservesEntryCount + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {world : Owned} {expr : IxIR0.Expr} + {state finalState : LowSt} {emit : Emit} {value : AVal} + (hrun : (lowerE src fuel input world expr).run state = + .ok (output, emit, value) finalState) : + EntryCountPreserved input output := + (lowerPreservesEntryCount src fuel).expr hrun + +/-! ## Recursive-self entry preservation + +Unlike an ordinary slot, the synthetic recursor entry carries no ownership. +Successful lowering may inspect it only as the head of a saturated recursive +call; it never rewrites it. The pointwise invariant below records that fact +without imposing any restriction on the ordinary entries around it. -/ + +def RecSelfAt (input : VEnv) (index arity : Nat) : Prop := + input.entries[index]? = some (.recSelf arity) + +theorem RecSelfAt.bump {input : VEnv} {index arity : Nat} + (hself : RecSelfAt input index arity) : + RecSelfAt input.bump index arity := by + simpa [RecSelfAt, VEnv.bump] using hself + +theorem RecSelfAt.of_entries_eq {input output : VEnv} + {index arity : Nat} (hentries : output.entries = input.entries) + (hself : RecSelfAt input index arity) : + RecSelfAt output index arity := by + simpa [RecSelfAt, hentries] using hself + +theorem RecSelfAt.setSlot {input : VEnv} {index arity changed : Nat} + {oldAbs oldRemaining : Nat} {oldUses : Uses} {oldHeld : Bool} + (hself : RecSelfAt input index arity) + (hslot : input.entries[changed]? = + some (.slot oldAbs oldRemaining oldUses oldHeld)) + (newAbs newRemaining : Nat) (newUses : Uses) (newHeld : Bool) : + RecSelfAt + (input.setEntry changed + (.slot newAbs newRemaining newUses newHeld)) + index arity := by + have hne : changed ≠ index := by + intro heq + subst changed + rw [hself] at hslot + cases hslot + rw [RecSelfAt, VEnv.setEntry, List.getElem?_set] + simp [hne] + exact hself + +theorem RecSelfAt.cons {input : VEnv} {index arity : Nat} + {entry : VEntry} (hself : RecSelfAt input index arity) : + RecSelfAt { input with entries := entry :: input.entries } + (index + 1) arity := by + simpa [RecSelfAt] using hself + +theorem RecSelfAt.pop_succ {input : VEnv} {index arity : Nat} + (hself : RecSelfAt input (index + 1) arity) : + RecSelfAt input.pop index arity := by + simpa [RecSelfAt, VEnv.pop] using hself + +theorem releaseAll_recSelfAt (input : VEnv) (values : List AVal) + {index arity : Nat} (hself : RecSelfAt input index arity) : + RecSelfAt (releaseAll input values).1 index arity := by + exact releaseAll_traverse_core + (Result := fun initial _ output _ => + RecSelfAt initial index arity → RecSelfAt output index arity) + (hnil := fun _ hinitial => hinitial) + (hconst := fun htail hinitial => htail hinitial) + (hslot := fun htail hinitial => htail hinitial.bump) + input values hself + +theorem lowerCapture_recSelfAt (expr : IxIR0.Expr) (input : VEnv) + (captured : Nat) {output : VEnv} {emit : Emit} {value : AVal} + {state finalState : LowSt} {index arity : Nat} + (hrun : (lowerCapture expr input captured).run state = + .ok (output, emit, value) finalState) + (hself : RecSelfAt input index arity) : + RecSelfAt output index arity := by + cases hentry : input.entries[captured]? with + | none => exact (throw_run_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | some entry => + cases entry with + | recSelf foundArity => exact (throw_run_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | slot abs remaining uses held => + cases held with + | false => exact (throw_run_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | true => + by_cases hunique : worldOfUses uses = .unique + · have huuEq : (Owned.unique == Owned.unique) = true := by decide + exact (throw_run_not_ok (by + simpa [lowerCapture, hentry, hunique, huuEq] using hrun)).elim + · have huniqueEq : + (worldOfUses uses == Owned.unique) = false := by + cases uses <;> simp_all [worldOfUses] <;> decide + by_cases hmore : remaining > countUses captured expr + · have houtput : output = + (input.setEntry captured + (.slot abs (remaining - countUses captured expr) + uses true)).bump := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hrun + simpa [lowerCapture, hentry, huniqueEq, hmore] + using hvalue.symm + subst output + exact (hself.setSlot hentry abs + (remaining - countUses captured expr) uses true).bump + · by_cases hequal : remaining = countUses captured expr + · have houtput : output = + input.setEntry captured (.slot abs 0 uses false) := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hrun + simpa [lowerCapture, hentry, huniqueEq, hmore, hequal] + using hvalue.symm + subst output + exact hself.setSlot hentry abs 0 uses false + · exact (throw_run_not_ok (by + simpa [lowerCapture, hentry, huniqueEq, hmore, hequal] + using hrun)).elim + +theorem lowerCaptures_recSelfAt (expr : IxIR0.Expr) : + ∀ {captures input output emit values state finalState index arity}, + (lowerCaptures expr input captures).run state = + .ok (output, emit, values) finalState → + RecSelfAt input index arity → RecSelfAt output index arity := by + intro captures input output emit values state finalState index arity hrun + apply lowerCaptures_run_core + (Result := fun input output _ _ _ => + RecSelfAt input index arity → RecSelfAt output index arity) + (e := expr) (hrun := hrun) + · intro input hself + exact hself + · intro captured rest input middle output headEmit tailEmit headValue + tailValues state middleState hheadRun htail hself + exact htail + (lowerCapture_recSelfAt expr input captured hheadRun hself) + +def LowerEPreservesRecSelf (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {world : Owned} {expr : IxIR0.Expr} + {state finalState : LowSt} {output : VEnv} {emit : Emit} {value : AVal} + {index arity : Nat}, + (lowerE src fuel input world expr).run state = + .ok (output, emit, value) finalState → + RecSelfAt input index arity → RecSelfAt output index arity + +def LowerBorrowPreservesRecSelf (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {expr : IxIR0.Expr} {state finalState : LowSt} + {output : VEnv} {emit : Emit} {value : AVal} {release : Bool} + {index arity : Nat}, + (lowerBorrow src fuel input expr).run state = + .ok (output, emit, value, release) finalState → + RecSelfAt input index arity → RecSelfAt output index arity + +def LowerSpinePreservesRecSelf (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {world : Owned} {head : IxIR0.Expr} + {args : List IxIR0.Expr} {state finalState : LowSt} + {output : VEnv} {emit : Emit} {value : AVal} {index arity : Nat}, + (lowerSpine src fuel input world head args).run state = + .ok (output, emit, value) finalState → + RecSelfAt input index arity → RecSelfAt output index arity + +def KnownCallPreservesRecSelf (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {build : Array Atom → Op} {count : Nat} + {argWorlds : List Owned} {resultWorld : Owned} + {args : List IxIR0.Expr} {state finalState : LowSt} + {output : VEnv} {emit : Emit} {value : AVal} {index arity : Nat}, + (knownCall src fuel input build count argWorlds resultWorld args).run + state = .ok (output, emit, value) finalState → + RecSelfAt input index arity → RecSelfAt output index arity + +def LowerArgsPreservesRecSelf (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {args : List (IxIR0.Expr × Owned)} + {state finalState : LowSt} {output : VEnv} + {emit : Emit} {values : List AVal} {index arity : Nat}, + (lowerArgs src fuel input args).run state = + .ok (output, emit, values) finalState → + RecSelfAt input index arity → RecSelfAt output index arity + +def ApplyRestPreservesRecSelf (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {resultWorld : Owned} {pre : Emit} + {function : AVal} {args : List IxIR0.Expr} + {state finalState : LowSt} {output : VEnv} + {emit : Emit} {value : AVal} {index arity : Nat}, + (applyRest src fuel input resultWorld pre function args).run state = + .ok (output, emit, value) finalState → + RecSelfAt input index arity → RecSelfAt output index arity + +def LowerLamPreservesRecSelf (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {expr : IxIR0.Expr} {state finalState : LowSt} + {output : VEnv} {emit : Emit} {value : AVal} {index arity : Nat}, + (lowerLam src fuel input expr).run state = + .ok (output, emit, value) finalState → + RecSelfAt input index arity → RecSelfAt output index arity + +structure LowerPreservesRecSelf (src : IxIR0.Env) (fuel : Nat) : Prop where + expr : LowerEPreservesRecSelf src fuel + borrow : LowerBorrowPreservesRecSelf src fuel + spine : LowerSpinePreservesRecSelf src fuel + knownCall : KnownCallPreservesRecSelf src fuel + args : LowerArgsPreservesRecSelf src fuel + applyRest : ApplyRestPreservesRecSelf src fuel + lam : LowerLamPreservesRecSelf src fuel + +theorem lowerPreservesRecSelf_zero (src : IxIR0.Env) : + LowerPreservesRecSelf src 0 := by + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro input world expr state finalState output emit value index arity + hrun _ + exact (throw_run_not_ok (by simpa [lowerE] using hrun)).elim + · intro input expr state finalState output emit value release index arity + hrun _ + exact (throw_run_not_ok (by simpa [lowerBorrow] using hrun)).elim + · intro input world head args state finalState output emit value index + arity hrun _ + exact (throw_run_not_ok (by simpa [lowerSpine] using hrun)).elim + · intro input build count argWorlds resultWorld args state finalState + output emit value index arity hrun _ + exact (throw_run_not_ok (by simpa [knownCall] using hrun)).elim + · intro input args state finalState output emit values index arity hrun _ + exact (throw_run_not_ok (by simpa [lowerArgs] using hrun)).elim + · intro input resultWorld pre function args state finalState output emit + value index arity hrun _ + exact (throw_run_not_ok (by simpa [applyRest] using hrun)).elim + · intro input expr state finalState output emit value index arity hrun _ + exact (throw_run_not_ok (by simpa [lowerLam] using hrun)).elim + +theorem lowerArgsPreservesRecSelf_succ {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesRecSelf src fuel) + (hargs : LowerArgsPreservesRecSelf src fuel) : + LowerArgsPreservesRecSelf src (fuel + 1) := by + intro input args state finalState output emit values index arity hrun hself + cases args with + | nil => + have hpure : + (input, (_root_.id : Emit), []) = (output, emit, values) ∧ + state = finalState := by + simpa [lowerArgs] using hrun + cases hpure.1 + exact hself + | cons head rest => + rcases head with ⟨expr, world⟩ + simp only [lowerArgs] at hrun + obtain ⟨headResult, middleState, hheadRun, hafterHead⟩ := + bind_run_ok_inv hrun + rcases headResult with ⟨middle, headEmit, headValue⟩ + obtain ⟨tailResult, tailState, htailRun, hafterTail⟩ := + bind_run_ok_inv hafterHead + rcases tailResult with ⟨actualOutput, tailEmit, tailValues⟩ + have houtput : actualOutput = output := by + have hpure : + (actualOutput, headEmit ∘ tailEmit, headValue :: tailValues) = + (output, emit, values) ∧ tailState = finalState := by + simpa using hafterTail + exact congrArg Prod.fst hpure.1 + subst output + exact hargs htailRun (hexpr hheadRun hself) + +theorem applyRestPreservesRecSelf_succ {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsPreservesRecSelf src fuel) : + ApplyRestPreservesRecSelf src (fuel + 1) := by + intro input resultWorld pre function args state finalState output emit value + index arity hrun hself + cases function with + | constA atom => + cases atom with + | erased => + simp only [applyRest] at hrun + obtain ⟨argsResult, argsState, hargsRun, hpureRun⟩ := + bind_run_ok_inv hrun + rcases argsResult with ⟨middle, argsEmit, values⟩ + have hpure : (releaseAll middle values).1 = output := by + have hvalue : + ((releaseAll middle values).1, + pre ∘ argsEmit ∘ (releaseAll middle values).2, + AVal.constA .erased) = (output, emit, value) ∧ + argsState = finalState := by + simpa using hpureRun + exact congrArg Prod.fst hvalue.1 + subst output + exact releaseAll_recSelfAt middle values (hargs hargsRun hself) + | var relative => + simp only [applyRest] at hrun + obtain ⟨_, checkedState, _, hafterCheck⟩ := bind_run_ok_inv hrun + obtain ⟨argsResult, argsState, hargsRun, hpureRun⟩ := + bind_run_ok_inv hafterCheck + rcases argsResult with ⟨middle, argsEmit, values⟩ + have houtput : middle.bump = output := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hpureRun + simpa using hvalue + subst output + exact (hargs hargsRun hself).bump + | lit literal => + simp only [applyRest] at hrun + obtain ⟨_, checkedState, _, hafterCheck⟩ := bind_run_ok_inv hrun + obtain ⟨argsResult, argsState, hargsRun, hpureRun⟩ := + bind_run_ok_inv hafterCheck + rcases argsResult with ⟨middle, argsEmit, values⟩ + have houtput : middle.bump = output := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hpureRun + simpa using hvalue + subst output + exact (hargs hargsRun hself).bump + | slotA abs => + simp only [applyRest] at hrun + obtain ⟨_, checkedState, _, hafterCheck⟩ := bind_run_ok_inv hrun + obtain ⟨argsResult, argsState, hargsRun, hpureRun⟩ := + bind_run_ok_inv hafterCheck + rcases argsResult with ⟨middle, argsEmit, values⟩ + have houtput : middle.bump = output := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hpureRun + simpa using hvalue + subst output + exact (hargs hargsRun hself).bump + +theorem knownCallPreservesRecSelf_succ {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsPreservesRecSelf src fuel) + (hrest : ApplyRestPreservesRecSelf src fuel) : + KnownCallPreservesRecSelf src (fuel + 1) := by + intro input build count argWorlds resultWorld args state finalState output + emit value index arity hrun hself + simp only [knownCall] at hrun + obtain ⟨argsResult, argsState, hargsRun, hafterArgs⟩ := + bind_run_ok_inv hrun + rcases argsResult with ⟨middle, argsEmit, values⟩ + have hmiddle := hargs hargsRun hself + by_cases hterminal : args.length ≤ count + · have houtput : middle.bump = output := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hafterArgs + simpa [hterminal] using hvalue + subst output + exact hmiddle.bump + · have hrestRun : + (applyRest src fuel middle.bump resultWorld + (argsEmit ∘ emitOp + (build (values.map (·.toAtom middle)).toArray)) + (.slotA middle.depth) (args.drop count)).run argsState = + .ok (output, emit, value) finalState := by + simpa [hterminal] using hafterArgs + exact hrest hrestRun hmiddle.bump + +private theorem lowerBorrow_dynamic_recSelf + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesRecSelf src fuel) + {input output : VEnv} {expr : IxIR0.Expr} + {state finalState : LowSt} {emit : Emit} {value : AVal} + {releaseFlag : Bool} {index arity : Nat} + {finish : (VEnv × Emit × AVal) → (VEnv × Emit × AVal × Bool)} + (hrun : (finish <$> lowerE src fuel input .shared expr).run state = + .ok (output, emit, value, releaseFlag) finalState) + (hfinish : ∀ result, (finish result).1 = result.1) + (hself : RecSelfAt input index arity) : + RecSelfAt output index arity := by + obtain ⟨exprResult, hexprRun, hvalue⟩ := map_run_ok_inv hrun + rcases exprResult with ⟨middle, middleEmit, middleValue⟩ + have houtput : middle = output := by + have := congrArg Prod.fst hvalue + simpa [hfinish] using this + subst output + exact hexpr hexprRun hself + +theorem lowerBorrowPreservesRecSelf_succ + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesRecSelf src fuel) : + LowerBorrowPreservesRecSelf src (fuel + 1) := by + intro input expr state finalState output emit value release selfIndex + selfArity hrun hself + cases expr with + | var variableIndex => + cases hentry : input.entries[variableIndex]? with + | none => exact (throw_run_not_ok (by + simpa [lowerBorrow, hentry] using hrun)).elim + | some entry => + cases entry with + | recSelf arity => exact (throw_run_not_ok (by + simpa [lowerBorrow, hentry] using hrun)).elim + | slot abs remaining uses held => + cases held with + | false => exact (throw_run_not_ok (by + simpa [lowerBorrow, hentry] using hrun)).elim + | true => + by_cases hunique : worldOfUses uses = .unique + · have huuEq : (Owned.unique == Owned.unique) = true := by decide + exact (throw_run_not_ok (by + simpa [lowerBorrow, hentry, hunique, huuEq] using hrun)).elim + · have huniqueEq : + (worldOfUses uses == Owned.unique) = false := by + cases uses <;> simp_all [worldOfUses] <;> decide + cases remaining with + | zero => exact (throw_run_not_ok (by + simpa [lowerBorrow, hentry, huniqueEq] using hrun)).elim + | succ remaining => + cases remaining with + | zero => + have hpure : + (input.setEntry variableIndex + (.slot abs 0 uses false), + (_root_.id : Emit), AVal.slotA abs, true) = + (output, emit, value, release) ∧ + state = finalState := by + simpa [lowerBorrow, hentry, huniqueEq] using hrun + cases hpure.1 + exact hself.setSlot hentry abs 0 uses false + | succ remaining => + have hpure : + (input.setEntry variableIndex + (.slot abs (remaining + 1) uses true), + (_root_.id : Emit), AVal.slotA abs, false) = + (output, emit, value, release) ∧ + state = finalState := by + simpa [lowerBorrow, hentry, huniqueEq] using hrun + cases hpure.1 + exact hself.setSlot hentry abs (remaining + 1) uses true + | ref address => + apply lowerBorrow_dynamic_recSelf hexpr + (by simpa [lowerBorrow] using hrun) (fun _ => rfl) hself + | app function argument => + apply lowerBorrow_dynamic_recSelf hexpr + (by simpa [lowerBorrow] using hrun) (fun _ => rfl) hself + | lam uses body => + apply lowerBorrow_dynamic_recSelf hexpr + (by simpa [lowerBorrow] using hrun) (fun _ => rfl) hself + | letE uses value body => + apply lowerBorrow_dynamic_recSelf hexpr + (by simpa [lowerBorrow] using hrun) (fun _ => rfl) hself + | proj index source => + apply lowerBorrow_dynamic_recSelf hexpr + (by simpa [lowerBorrow] using hrun) (fun _ => rfl) hself + | lit literal => + apply lowerBorrow_dynamic_recSelf hexpr + (by simpa [lowerBorrow] using hrun) (fun _ => rfl) hself + | erased => + apply lowerBorrow_dynamic_recSelf hexpr + (by simpa [lowerBorrow] using hrun) (fun _ => rfl) hself + +private theorem lowerE_applyRest_recSelf + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesRecSelf src fuel) + (hrest : ApplyRestPreservesRecSelf src fuel) + {input output : VEnv} {world : Owned} {head : IxIR0.Expr} + {args : List IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {value : AVal} {index arity : Nat} + (hrun : (do + let (middle, headEmit, function) ← + lowerE src fuel input .shared head + applyRest src fuel middle world headEmit function args).run state = + .ok (output, emit, value) finalState) + (hself : RecSelfAt input index arity) : + RecSelfAt output index arity := by + obtain ⟨headResult, middleState, hheadRun, hrestRun⟩ := + bind_run_ok_inv hrun + rcases headResult with ⟨middle, headEmit, function⟩ + exact hrest hrestRun (hexpr hheadRun hself) + +theorem lowerSpinePreservesRecSelf_succ + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesRecSelf src fuel) + (hspine : LowerSpinePreservesRecSelf src fuel) + (hknown : KnownCallPreservesRecSelf src fuel) + (hrest : ApplyRestPreservesRecSelf src fuel) : + LowerSpinePreservesRecSelf src (fuel + 1) := by + intro input world head args state finalState output emit value selfIndex + selfArity hrun hself + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases head with + | app function argument => + apply hspine + · simpa [lowerSpine] using hrun + · exact hself + | erased => + apply hrest + · simpa [lowerSpine] using hrun + · exact hself + | var variableIndex => + simp only [lowerSpine] at hrun + cases hentry : input.entries[variableIndex]? with + | none => + apply lowerE_applyRest_recSelf hexpr hrest + · simpa [hentry] using hrun + · exact hself + | some entry => + cases entry with + | recSelf arity => + rw [hentry] at hrun + simp only at hrun + by_cases hunder : args.length < arity + · rw [if_pos hunder] at hrun + exact (throw_run_not_ok hrun).elim + · rw [if_neg hunder] at hrun + obtain ⟨unitValue, checkedState, _, hknownRun⟩ := + bind_run_ok_inv hrun + cases unitValue + exact hknown hknownRun hself + | slot abs remaining uses held => + apply lowerE_applyRest_recSelf hexpr hrest + · simpa [hentry] using hrun + · exact hself + | ref address => + simp only [lowerSpine] at hrun + cases hsource : src address with + | none => + rw [hsource] at hrun + exact (throw_run_not_ok hrun).elim + | some decl => + rw [hsource] at hrun + cases decl with + | defn result body => + simp only at hrun + by_cases hunder : args.length < lamArity body + · rw [if_pos hunder] at hrun + cases world with + | unique => exact (throw_run_not_ok hrun).elim + | shared => + cases result with + | unique => exact (throw_run_not_ok hrun).elim + | shared => + cases hp : papSafe body with + | false => exact (throw_run_not_ok (by + simpa [hp, hsuEq] using hrun)).elim + | true => + apply hknown + · simpa [hp, hsuEq] using hrun + · exact hself + · rw [if_neg hunder] at hrun + obtain ⟨_, checkedState, _, hknownRun⟩ := bind_run_ok_inv hrun + exact hknown hknownRun hself + | ctor tag arity => + simp only at hrun + by_cases hunder : args.length < arity + · rw [if_pos hunder] at hrun + cases world with + | unique => exact (throw_run_not_ok hrun).elim + | shared => + obtain ⟨wrapper, wrapperState, _, hknownRun⟩ := + bind_run_ok_inv hrun + exact hknown hknownRun hself + · rw [if_neg hunder] at hrun + exact hknown hrun hself + | recursor numArgs natLit rules => + simp only at hrun + by_cases hunder : args.length < numArgs + 1 + · rw [if_pos hunder] at hrun + cases world with + | unique => exact (throw_run_not_ok hrun).elim + | shared => exact hknown hrun hself + · rw [if_neg hunder] at hrun + obtain ⟨_, checkedState, _, hknownRun⟩ := bind_run_ok_inv hrun + exact hknown hknownRun hself + | extern arity => + simp only at hrun + by_cases hunder : args.length < arity + · rw [if_pos hunder] at hrun + cases world with + | unique => exact (throw_run_not_ok hrun).elim + | shared => exact hknown hrun hself + · rw [if_neg hunder] at hrun + exact hknown hrun hself + | lam uses body => + apply lowerE_applyRest_recSelf hexpr hrest + · simpa [lowerSpine] using hrun + · exact hself + | letE uses bound body => + apply lowerE_applyRest_recSelf hexpr hrest + · simpa [lowerSpine] using hrun + · exact hself + | proj index source => + apply lowerE_applyRest_recSelf hexpr hrest + · simpa [lowerSpine] using hrun + · exact hself + | lit literal => + apply lowerE_applyRest_recSelf hexpr hrest + · simpa [lowerSpine] using hrun + · exact hself + +theorem lowerLamPreservesRecSelf_succ + {src : IxIR0.Env} {fuel : Nat} : + LowerLamPreservesRecSelf src (fuel + 1) := by + intro input expr state finalState output emit value index arity hrun hself + cases hp : papSafe expr with + | false => simp [lowerLam, hp] at hrun + | true => + simp only [lowerLam] at hrun + simp only [hp, ↓reduceIte, bind_pure_comp] at hrun + let captures := (List.range input.entries.length).filter + (fun index => countUses index expr > 0) + have hcaptures : captures = (List.range input.entries.length).filter + (fun index => countUses index expr > 0) := rfl + rw [← hcaptures] at hrun + obtain ⟨captureResult, captureState, hcaptureRun, hafterCapture⟩ := + bind_run_ok_inv hrun + rcases captureResult with ⟨captureOutput, captureEmit, captureValues⟩ + obtain ⟨fnAddr, addressState, _, hafterFresh⟩ := + bind_run_ok_inv hafterCapture + obtain ⟨code, bodyState, _, hafterBody⟩ := + bind_run_ok_inv hafterFresh + obtain ⟨_, _, hvalue⟩ := map_run_ok_inv hafterBody + have houtput : captureOutput.bump = output := + congrArg Prod.fst hvalue + subst output + exact (lowerCaptures_recSelfAt expr hcaptureRun hself).bump + +private theorem lowerE_proj_recSelf + {src : IxIR0.Env} {fuel : Nat} + (hborrow : LowerBorrowPreservesRecSelf src fuel) + {input output : VEnv} {world : Owned} {fieldIndex : Nat} + {source : IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {value : AVal} {index arity : Nat} + (hrun : (lowerE src (fuel + 1) input world + (.proj fieldIndex source)).run state = + .ok (output, emit, value) finalState) + (hself : RecSelfAt input index arity) : + RecSelfAt output index arity := by + cases world with + | unique => + have huuEq : (Owned.unique == Owned.unique) = true := by decide + simp [lowerE, huuEq] at hrun + | shared => + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + simp only [lowerE, hsuEq, Bool.false_eq_true, if_false] at hrun + obtain ⟨borrowResult, middleState, hborrowRun, hafterBorrow⟩ := + bind_run_ok_inv hrun + rcases borrowResult with + ⟨borrowOutput, borrowEmit, borrowed, release⟩ + have hborrowSelf := hborrow hborrowRun hself + cases borrowed with + | constA atom => + cases atom with + | var relative => + have hpure : borrowOutput.bump = output := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hafterBorrow + simpa using hvalue + subst output + exact hborrowSelf.bump + | lit literal => + have hpure : borrowOutput.bump = output := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hafterBorrow + simpa using hvalue + subst output + exact hborrowSelf.bump + | erased => + have hpure : borrowOutput = output := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hafterBorrow + simpa using hvalue + subst output + exact hborrowSelf + | slotA targetAbs => + cases release with + | false => + have hpure : borrowOutput.bump.bump = output := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hafterBorrow + simpa using hvalue + subst output + exact hborrowSelf.bump.bump + | true => + have hpure : borrowOutput.bump.bump.bump = output := by + have hvalue := congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × AVal) => + match result with + | .ok value _ => value.1 + | .error _ _ => input) hafterBorrow + simpa using hvalue + subst output + exact hborrowSelf.bump.bump.bump + +private theorem lowerE_mapped_body_pop_recSelf + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesRecSelf src fuel) + {middle bodyInput output : VEnv} {world : Owned} {body : IxIR0.Expr} + {state finalState : LowSt} {emit : Emit} {value : AVal} + {finish : (VEnv × Emit × AVal) → (VEnv × Emit × AVal)} + {binder : VEntry} {index arity : Nat} + (hrun : (finish <$> lowerE src fuel bodyInput world body).run state = + .ok (output, emit, value) finalState) + (hfinish : ∀ result, (finish result).1 = result.1.pop) + (hentries : bodyInput.entries = binder :: middle.entries) + (hself : RecSelfAt middle index arity) : + RecSelfAt output index arity := by + obtain ⟨bodyResult, hbodyRun, hvalue⟩ := map_run_ok_inv hrun + rcases bodyResult with ⟨bodyOutput, bodyEmit, bodyValue⟩ + have houtput : bodyOutput.pop = output := by + have := congrArg Prod.fst hvalue + simpa [hfinish] using this + subst output + have hbodyInput : RecSelfAt bodyInput (index + 1) arity := by + rw [RecSelfAt, hentries] + simpa [RecSelfAt] using hself + exact (hexpr hbodyRun hbodyInput).pop_succ + +private theorem lowerE_let_recSelf + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesRecSelf src fuel) + {input output : VEnv} {world : Owned} {binderUses : Uses} + {bound body : IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {value : AVal} {index arity : Nat} + (hrun : (lowerE src (fuel + 1) input world + (.letE binderUses bound body)).run state = + .ok (output, emit, value) finalState) + (hself : RecSelfAt input index arity) : + RecSelfAt output index arity := by + simp only [lowerE] at hrun + obtain ⟨boundResult, boundState, hboundRun, hafterBound⟩ := + bind_run_ok_inv hrun + rcases boundResult with ⟨middle, boundEmit, boundValue⟩ + have hmiddle := hexpr hboundRun hself + cases boundValue with + | slotA boundAbs => + by_cases hzero : countUses 0 body = 0 + · cases binderUses with + | erased => + obtain ⟨_, _, hthrow, _⟩ := bind_run_ok_inv + (by simpa [hzero] using hafterBound) + exact (throw_run_not_ok hthrow).elim + | linear => + obtain ⟨_, _, hthrow, _⟩ := bind_run_ok_inv + (by simpa [hzero] using hafterBound) + exact (throw_run_not_ok hthrow).elim + | affine => + let bodyInput : VEnv := + { middle with + entries := .slot boundAbs 0 .affine false :: middle.entries + depth := middle.depth + 1 } + apply lowerE_mapped_body_pop_recSelf hexpr + (middle := middle) (bodyInput := bodyInput) + (by simpa [hzero, bodyInput] using hafterBound) + (fun _ => rfl) (by rfl) hmiddle + | many => + let bodyInput : VEnv := + { middle with + entries := .slot boundAbs 0 .many false :: middle.entries + depth := middle.depth + 1 } + apply lowerE_mapped_body_pop_recSelf hexpr + (middle := middle) (bodyInput := bodyInput) + (by simpa [hzero, bodyInput] using hafterBound) + (fun _ => rfl) (by rfl) hmiddle + · let bodyInput : VEnv := + { middle with + entries := + .slot boundAbs (countUses 0 body) binderUses true :: + middle.entries } + apply lowerE_mapped_body_pop_recSelf hexpr + (middle := middle) (bodyInput := bodyInput) + (by simpa [hzero, bodyInput] using hafterBound) + (fun _ => rfl) (by rfl) hmiddle + | constA atom => + by_cases hzero : countUses 0 body = 0 + · let bodyInput : VEnv := + { middle with + entries := .slot middle.depth 0 binderUses false :: + middle.entries + depth := middle.depth + 1 } + apply lowerE_mapped_body_pop_recSelf hexpr + (middle := middle) (bodyInput := bodyInput) + (by simpa [hzero, bodyInput] using hafterBound) + (fun _ => rfl) (by rfl) hmiddle + · let bodyInput : VEnv := + { middle with + entries := + .slot middle.depth (countUses 0 body) binderUses true :: + middle.entries + depth := middle.depth + 1 } + apply lowerE_mapped_body_pop_recSelf hexpr + (middle := middle) (bodyInput := bodyInput) + (by simpa [hzero, bodyInput] using hafterBound) + (fun _ => rfl) (by rfl) hmiddle + +private theorem lowerE_var_recSelf + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {world : Owned} {variableIndex : Nat} {state finalState : LowSt} + {emit : Emit} {value : AVal} {selfIndex selfArity : Nat} + (hrun : (lowerE src (fuel + 1) input world + (.var variableIndex)).run state = + .ok (output, emit, value) finalState) + (hself : RecSelfAt input selfIndex selfArity) : + RecSelfAt output selfIndex selfArity := by + have hssNe : (Owned.shared != Owned.shared) = false := by decide + have huuNe : (Owned.unique != Owned.unique) = false := by decide + have hsuNe : (Owned.shared != Owned.unique) = true := by decide + have husNe : (Owned.unique != Owned.shared) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + have huuEq : (Owned.unique == Owned.unique) = true := by decide + cases hentry : input.entries[variableIndex]? with + | none => exact (throw_run_not_ok (by + simpa [lowerE, hentry] using hrun)).elim + | some entry => + cases entry with + | recSelf arity => exact (throw_run_not_ok (by + simpa [lowerE, hentry] using hrun)).elim + | slot abs remaining uses held => + cases held with + | false => exact (throw_run_not_ok (by + simpa [lowerE, hentry] using hrun)).elim + | true => + by_cases hworld : worldOfUses uses = world + · subst world + have hsame : + (worldOfUses uses != worldOfUses uses) = false := by + cases uses <;> decide + cases remaining with + | zero => exact (throw_run_not_ok (by + simpa [lowerE, hentry, hsame] using hrun)).elim + | succ remaining => + cases remaining with + | zero => + have hpure : + (input.setEntry variableIndex (.slot abs 0 uses false), + (_root_.id : Emit), AVal.slotA abs) = + (output, emit, value) ∧ state = finalState := by + simpa [lowerE, hentry, hsame] using hrun + cases hpure.1 + exact hself.setSlot hentry abs 0 uses false + | succ remaining => + by_cases hunique : worldOfUses uses = .unique + · have huniqueEq : + (worldOfUses uses == Owned.unique) = true := by + rw [hunique] + exact huuEq + exact (throw_run_not_ok (by + simpa [lowerE, hentry, hsame, huniqueEq, huuNe] + using hrun)).elim + · have huniqueEq : + (worldOfUses uses == Owned.unique) = false := by + cases uses <;> simp_all [worldOfUses] <;> decide + let changed := input.setEntry variableIndex + (.slot abs (remaining + 1) uses true) + have hpure : + (changed.bump, + emitOp (.dup (.var (changed.rel abs))), + AVal.slotA changed.depth) = + (output, emit, value) ∧ state = finalState := by + simpa [lowerE, hentry, hsame, huniqueEq, hssNe, changed] + using hrun + cases hpure.1 + exact (hself.setSlot hentry abs + (remaining + 1) uses true).bump + · cases uses <;> cases world + all_goals + try { exact (hworld (by rfl)).elim } + all_goals + exact (throw_run_not_ok (by + simpa [lowerE, hentry, worldOfUses, hssNe, huuNe, hsuNe, + husNe, hsuEq, huuEq] using hrun)).elim + +theorem lowerEPreservesRecSelf_succ + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesRecSelf src fuel) + (hborrow : LowerBorrowPreservesRecSelf src fuel) + (hspine : LowerSpinePreservesRecSelf src fuel) + (hlam : LowerLamPreservesRecSelf src fuel) : + LowerEPreservesRecSelf src (fuel + 1) := by + intro input world expr state finalState output emit value index arity hrun + hself + cases expr with + | var variableIndex => exact lowerE_var_recSelf hrun hself + | ref address => + exact hself.of_entries_eq (lowerE_ref_entries_eq_noRecSelf hrun) + | app function argument => + apply hspine + · simpa [lowerE] using hrun + · exact hself + | lam uses body => + cases world with + | unique => + have huuEq : (Owned.unique == Owned.unique) = true := by decide + exact (throw_run_not_ok (by + simpa [lowerE, huuEq] using hrun)).elim + | shared => + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + apply hlam + · simpa [lowerE, hsuEq] using hrun + · exact hself + | letE uses bound body => exact lowerE_let_recSelf hexpr hrun hself + | proj fieldIndex source => exact lowerE_proj_recSelf hborrow hrun hself + | lit literal => + have hpure : + (input, (_root_.id : Emit), AVal.constA (.lit literal)) = + (output, emit, value) ∧ state = finalState := by + simpa [lowerE] using hrun + cases hpure.1 + exact hself + | erased => + have hpure : + (input, (_root_.id : Emit), AVal.constA .erased) = + (output, emit, value) ∧ state = finalState := by + simpa [lowerE] using hrun + cases hpure.1 + exact hself + +theorem lowerPreservesRecSelf_succ + {src : IxIR0.Env} {fuel : Nat} + (hprev : LowerPreservesRecSelf src fuel) : + LowerPreservesRecSelf src (fuel + 1) where + expr := lowerEPreservesRecSelf_succ + hprev.expr hprev.borrow hprev.spine hprev.lam + borrow := lowerBorrowPreservesRecSelf_succ hprev.expr + spine := lowerSpinePreservesRecSelf_succ + hprev.expr hprev.spine hprev.knownCall hprev.applyRest + knownCall := knownCallPreservesRecSelf_succ hprev.args hprev.applyRest + args := lowerArgsPreservesRecSelf_succ hprev.expr hprev.args + applyRest := applyRestPreservesRecSelf_succ hprev.args + lam := lowerLamPreservesRecSelf_succ + +/-- Successful expression lowering preserves every synthetic recursive-self +entry at its original logical index. -/ +theorem lowerPreservesRecSelf (src : IxIR0.Env) : + ∀ fuel, LowerPreservesRecSelf src fuel + | 0 => lowerPreservesRecSelf_zero src + | fuel + 1 => + lowerPreservesRecSelf_succ (lowerPreservesRecSelf src fuel) + +theorem lowerE_recSelfAt + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {world : Owned} {expr : IxIR0.Expr} + {state finalState : LowSt} {emit : Emit} {value : AVal} + {index arity : Nat} + (hrun : (lowerE src fuel input world expr).run state = + .ok (output, emit, value) finalState) + (hself : RecSelfAt input index arity) : + RecSelfAt output index arity := + (lowerPreservesRecSelf src fuel).expr hrun hself + +end Ix.Compiler.IxIR1.Lower diff --git a/Ix/Compiler/IxIR1/LowerStateSim.lean b/Ix/Compiler/IxIR1/LowerStateSim.lean new file mode 100644 index 000000000..d4f4e01dd --- /dev/null +++ b/Ix/Compiler/IxIR1/LowerStateSim.lean @@ -0,0 +1,8245 @@ +import Ix.Compiler.IxIR1.LowerSim + +/-! +# Compile-state simulation for IxIR₀ → IxIR₁ lowering + +This companion proves that successful lowering consumes exactly each source +entry's syntactic occurrence count. In particular, a counted let binder is +released before the executable lowerer removes its logical entry. +-/ + +namespace Ix.Compiler.IxIR1.LowerSim + +open Ix.Compiler.Ixon (Owned Uses) +open Ix.Compiler.IxIR1.Lower +open Ix.Compiler.IxIR1.Sim + +theorem trackedThrowRun_not_ok {error state α : Type} + {err : error} {initial final : state} {value : α} + (h : (throw err : EStateM error state α).run initial = + .ok value final) : False := by + change EStateM.Result.error err initial = .ok value final at h + contradiction + +theorem trackedBindRun_ok_inv {error state α β : Type} + {action : EStateM error state α} {next : α → EStateM error state β} + {initial final : state} {result : β} + (h : (action >>= next).run initial = .ok result final) : + ∃ value middle, + action.run initial = .ok value middle ∧ + (next value).run middle = .ok result final := by + change + (match action.run initial with + | .ok value nextState => (next value).run nextState + | .error err nextState => .error err nextState) = + .ok result final at h + cases haction : action.run initial with + | ok value middle => + rw [haction] at h + exact ⟨value, middle, rfl, h⟩ + | error err middle => + rw [haction] at h + contradiction + +theorem trackedMapRun_ok_inv {error state α β : Type} + {action : EStateM error state α} {f : α → β} + {initial final : state} {result : β} + (hrun : (f <$> action).run initial = .ok result final) : + ∃ value, action.run initial = .ok value final ∧ f value = result := by + have hbind : (action >>= fun value => pure (f value)).run initial = + .ok result final := by + simpa only [bind_pure_comp] using hrun + obtain ⟨value, middle, haction, hpure⟩ := trackedBindRun_ok_inv hbind + have hresult : f value = result ∧ middle = final := by + simpa using hpure + cases hresult.2 + exact ⟨value, haction, hresult.1⟩ + +def EntryTracksAt (Γ : VEnv) (index abs : Nat) (uses : Uses) + (remaining : Nat) : Prop := + Γ.entries[index]? = + some (.slot abs remaining uses (remaining != 0)) + +def EntryConsumption (input output : VEnv) + (consumed : Nat → Nat) : Prop := + ∀ index abs uses base, + EntryTracksAt input index abs uses (base + consumed index) → + EntryTracksAt output index abs uses base + +/-- Every entry in a fixed logical prefix has the requested remaining-use +count and the canonical held bit. -/ +def EntriesTrackCounts (Γ : VEnv) (count : Nat) + (remaining : Nat → Nat) : Prop := + ∀ index, index < count → + ∃ abs uses, EntryTracksAt Γ index abs uses (remaining index) + +private theorem entriesReleased_of_getElem_slot_false : + ∀ entries : List VEntry, + (∀ index, index < entries.length → + ∃ abs remaining uses, + entries[index]? = some (.slot abs remaining uses false)) → + EntriesReleased entries := by + intro entries + induction entries with + | nil => exact fun _ => .nil + | cons entry tail ih => + intro hall + obtain ⟨abs, remaining, uses, hhead⟩ := hall 0 (by simp) + have hentry : entry = .slot abs remaining uses false := by + simpa using hhead + subst entry + apply EntriesReleased.slot + apply ih + intro index hindex + obtain ⟨tailAbs, tailRemaining, tailUses, htail⟩ := + hall (index + 1) (by simp; omega) + exact ⟨tailAbs, tailRemaining, tailUses, by simpa using htail⟩ + +/-- Exact consumption releases every tracked entry once the output is known to +have no additional logical entries. -/ +theorem EntryConsumption.entriesReleased {input output : VEnv} + {consumed : Nat → Nat} {count : Nat} + (hconsume : EntryConsumption input output consumed) + (htracks : EntriesTrackCounts input count consumed) + (hlength : output.entries.length = count) : + EntriesReleased output.entries := by + apply entriesReleased_of_getElem_slot_false + intro index hindex + have hcount : index < count := by simpa [hlength] using hindex + obtain ⟨abs, uses, htrack⟩ := htracks index hcount + have hout := hconsume index abs uses 0 (by simpa using htrack) + exact ⟨abs, 0, uses, by simpa [EntryTracksAt] using hout⟩ + +private theorem entriesReleased_of_prefix_slots_recSelf : + ∀ (count : Nat) (entries : List VEntry) (arity : Nat), + entries.length = count + 1 → + (∀ index, index < count → + ∃ abs remaining uses, + entries[index]? = some (.slot abs remaining uses false)) → + entries[count]? = some (.recSelf arity) → + EntriesReleased entries := by + intro count + induction count with + | zero => + intro entries arity hlength _ hself + cases entries with + | nil => simp at hlength + | cons entry tail => + have htailLength : tail.length = 0 := by simpa using hlength + cases tail with + | nil => + have hentry : entry = .recSelf arity := by simpa using hself + subst entry + exact EntriesReleased.recSelf EntriesReleased.nil + | cons tailHead tailRest => simp at htailLength + | succ count ih => + intro entries arity hlength hprefix hself + cases entries with + | nil => simp at hlength + | cons entry tail => + obtain ⟨abs, remaining, uses, hhead⟩ := + hprefix 0 (Nat.zero_lt_succ count) + have hentry : entry = .slot abs remaining uses false := by + simpa using hhead + subst entry + apply EntriesReleased.slot + apply ih tail arity + · simpa using hlength + · intro index hindex + obtain ⟨tailAbs, tailRemaining, tailUses, htail⟩ := + hprefix (index + 1) (by omega) + exact ⟨tailAbs, tailRemaining, tailUses, by simpa using htail⟩ + · simpa using hself + +/-- Exact consumption releases every ordinary entry in a tracked prefix while +the structural lowering invariant preserves the trailing recursive-self +entry used by recursor rule bodies. -/ +theorem EntryConsumption.entriesReleasedWithRecSelf + {input output : VEnv} {consumed : Nat → Nat} + {count arity : Nat} + (hconsume : EntryConsumption input output consumed) + (htracks : EntriesTrackCounts input count consumed) + (hlength : output.entries.length = count + 1) + (hself : RecSelfAt output count arity) : + EntriesReleased output.entries := by + apply entriesReleased_of_prefix_slots_recSelf count output.entries arity + hlength + · intro index hindex + obtain ⟨abs, uses, htrack⟩ := htracks index hindex + have hout := hconsume index abs uses 0 (by simpa using htrack) + exact ⟨abs, 0, uses, by simpa [EntryTracksAt] using hout⟩ + · exact hself + +private theorem EntriesTrackCounts.frameLiveSlot + {Γ : VEnv} {count abs : Nat} {uses : Uses} + {remaining : Nat → Nat} + (htracks : EntriesTrackCounts Γ count remaining) + (hlength : Γ.entries.length = count) + (hlive : remaining count ≠ 0) : + EntriesTrackCounts + (frameVEnvEntries Γ + [.slot abs (remaining count) uses true]) + (count + 1) remaining := by + intro index hindex + by_cases hprefix : index < count + · obtain ⟨trackedAbs, trackedUses, htrack⟩ := htracks index hprefix + refine ⟨trackedAbs, trackedUses, ?_⟩ + have hΓ : index < Γ.entries.length := by simpa [hlength] using hprefix + rw [EntryTracksAt] at htrack ⊢ + change (Γ.entries ++ [.slot abs (remaining count) uses true])[index]? = _ + rw [List.getElem?_append_left hΓ] + exact htrack + · have hi : index = count := by omega + subst index + refine ⟨abs, uses, ?_⟩ + simp [EntryTracksAt, frameVEnvEntries, hlength, hlive] + +private theorem EntriesTrackCounts.frameReleasedSlot + {Γ : VEnv} {count abs : Nat} {uses : Uses} + {remaining : Nat → Nat} + (htracks : EntriesTrackCounts Γ count remaining) + (hlength : Γ.entries.length = count) + (hdead : remaining count = 0) : + let framed := frameVEnvEntries Γ [.slot abs 0 uses true] + EntriesTrackCounts + ((framed.setEntry count (.slot abs 0 uses false)).bump) + (count + 1) remaining := by + dsimp only + intro index hindex + by_cases hprefix : index < count + · obtain ⟨trackedAbs, trackedUses, htrack⟩ := htracks index hprefix + refine ⟨trackedAbs, trackedUses, ?_⟩ + have hframed : EntryTracksAt + (frameVEnvEntries Γ [.slot abs 0 uses true]) index trackedAbs + trackedUses (remaining index) := by + have hΓ : index < Γ.entries.length := by simpa [hlength] using hprefix + rw [EntryTracksAt] at htrack ⊢ + change (Γ.entries ++ [.slot abs 0 uses true])[index]? = _ + rw [List.getElem?_append_left hΓ] + exact htrack + have hne : count ≠ index := by omega + simpa [EntryTracksAt, VEnv.setEntry, VEnv.bump, hne] using hframed + · have hi : index = count := by omega + subst index + refine ⟨abs, uses, ?_⟩ + rw [hdead] + simp [EntryTracksAt, frameVEnvEntries, VEnv.setEntry, VEnv.bump, + hlength] + +theorem EntriesTrackCounts.frameCanonicalSlot + {Γ : VEnv} {count abs : Nat} {uses : Uses} + {remaining : Nat → Nat} + (htracks : EntriesTrackCounts Γ count remaining) + (hlength : Γ.entries.length = count) : + EntriesTrackCounts + (frameVEnvEntries Γ + [.slot abs (remaining count) uses (remaining count != 0)]) + (count + 1) remaining := by + intro index hindex + by_cases hprefix : index < count + · obtain ⟨trackedAbs, trackedUses, htrack⟩ := htracks index hprefix + refine ⟨trackedAbs, trackedUses, ?_⟩ + have hΓ : index < Γ.entries.length := by simpa [hlength] using hprefix + rw [EntryTracksAt] at htrack ⊢ + change + (Γ.entries ++ + [.slot abs (remaining count) uses (remaining count != 0)])[index]? = _ + rw [List.getElem?_append_left hΓ] + exact htrack + · have hi : index = count := by omega + subst index + refine ⟨abs, uses, ?_⟩ + simp [EntryTracksAt, frameVEnvEntries, hlength] + +/-- The canonical generated parameter-drop plan leaves every logical parameter +at its original remaining-use count with the canonical held bit. This +strengthens `parameterDrops_releasePlan_atDepth` by recording the state fact +needed after the body consumes those remaining occurrences. -/ +theorem parameterDrops_releasePlan_tracked_atDepth (base depth : Nat) + (modes : List Uses) (remaining : Nat → Nat) + (hadmissible : ParameterDropsAdmissible modes remaining) : + ∃ output emit, + ReleasePlan + ⟨parameterEntries base modes remaining, depth⟩ + (parameterDrops base modes remaining) output emit ∧ + EntriesTrackCounts output modes.length remaining := by + exact parameterDrops_releasePlan_traverse remaining + (Result := fun _ _ sourceModes output => + EntriesTrackCounts output sourceModes.length remaining) + (hnil := by + intro _ _ index hindex + simp at hindex) + (hlive := by + intro current _ mode rest innerOutput htracks hlength hlive + simpa using EntriesTrackCounts.frameLiveSlot + (abs := current) (uses := mode) htracks hlength hlive) + (hmany := by + intro current _ rest innerOutput htracks hlength hdead + simpa using EntriesTrackCounts.frameReleasedSlot + (abs := current) (uses := .many) htracks hlength hdead) + (haffine := by + intro current _ rest innerOutput htracks hlength hdead + simpa using EntriesTrackCounts.frameReleasedSlot + (abs := current) (uses := .affine) htracks hlength hdead) + base depth modes hadmissible + +/-- Canonical ordinary-function entry specialization. -/ +theorem parameterDrops_releasePlan_tracked (base : Nat) + (modes : List Uses) (remaining : Nat → Nat) + (hadmissible : ParameterDropsAdmissible modes remaining) : + ∃ output emit, + ReleasePlan + ⟨parameterEntries base modes remaining, base + modes.length⟩ + (parameterDrops base modes remaining) output emit ∧ + EntriesTrackCounts output modes.length remaining := + parameterDrops_releasePlan_tracked_atDepth base (base + modes.length) + modes remaining hadmissible + +/-- The generated recursor-field retain fold leaves each field placeholder at +exactly its RHS occurrence count. Zero-use fields remain released; live +fields are activated by the corresponding `dup`. -/ +theorem recursorFieldRetains_plan_tracked + (fieldAbs depth fieldCount : Nat) (rhs : IxIR0.Expr) : + let dead : VEntry := .slot 0 0 .many false + ∃ output emit, + FieldRetainPlan + ⟨List.replicate fieldCount dead, depth⟩ + (recursorFieldRetains fieldAbs rhs fieldCount) + output emit ∧ + EntriesTrackCounts output fieldCount + (fun index => countUses index rhs) := by + dsimp only + exact recursorFieldRetains_plan_traverse rhs + (Result := fun _ _ currentCount output => + EntriesTrackCounts output currentCount + (fun index => countUses index rhs)) + (hnilResult := by + intro _ _ index hindex + simp at hindex) + (hskipResult := by + intro _ _ currentCount tailOutput htracks hlength hzero + simpa [hzero] using EntriesTrackCounts.frameCanonicalSlot + (abs := 0) (uses := .many) htracks hlength) + (hretainResult := by + intro _ currentDepth currentCount tailOutput htracks hlength + hnonzero + simpa using EntriesTrackCounts.frameLiveSlot + (abs := currentDepth) (uses := .many) htracks hlength hnonzero) + fieldAbs depth fieldCount + +theorem replicate_many_parameterDropsAdmissible + (count : Nat) (remaining : Nat → Nat) : + ParameterDropsAdmissible (List.replicate count .many) remaining := + parameterDropsAdmissible_replicate_many count remaining + +/-- Every descriptor in a successfully executed release list has a runtime +release mode. The other two source modes are precisely the error branches +of `releaseSlots`. -/ +theorem releaseSlots_run_drop_admissible + {input output : VEnv} {drops : List SlotDrop} {emit : Emit} + {state finalState : LowSt} + (hrun : (releaseSlots input drops).run state = + .ok (output, emit) finalState) : + ∀ drop ∈ drops, drop.uses = .many ∨ drop.uses = .affine := by + exact releaseSlots_run_core + (Result := fun _ _ selectedDrops _ => + ∀ drop ∈ selectedDrops, + drop.uses = .many ∨ drop.uses = .affine) + (hnil := by simp) + (haffine := by + intro entry abs rest initial final tailEmit htail selected hselected + rcases List.mem_cons.mp hselected with rfl | hrest + · exact Or.inr rfl + · exact htail selected hrest) + (hmany := by + intro entry abs rest initial final tailEmit htail selected hselected + rcases List.mem_cons.mp hselected with rfl | hrest + · exact Or.inl rfl + · exact htail selected hrest) + hrun + +/-- If every generated dead-parameter descriptor has a runtime release +mode, the source telescope satisfies the exact syntactic admissibility +predicate used by the function-entry proof. -/ +theorem parameterDropsAdmissible_of_drop_admissible + (base : Nat) (modes : List Uses) (remaining : Nat → Nat) + (hdrops : ∀ drop ∈ parameterDrops base modes remaining, + drop.uses = .many ∨ drop.uses = .affine) : + ParameterDropsAdmissible modes remaining := by + induction modes generalizing base with + | nil => trivial + | cons mode modes ih => + constructor + · apply ih (base + 1) + intro drop hdrop + apply hdrops drop + simpa [parameterDrops] using + List.mem_append_left + (if remaining modes.length == 0 then + [⟨modes.length, base, mode⟩] + else []) hdrop + · intro hzero + apply hdrops ⟨modes.length, base, mode⟩ + simp [parameterDrops, hzero] + +/-- Successful execution of the compiler-generated parameter release list +is itself the missing admissibility certificate. -/ +theorem parameterDropsAdmissible_of_releaseSlots_run + (base : Nat) (modes : List Uses) (remaining : Nat → Nat) + {input output : VEnv} {emit : Emit} {state finalState : LowSt} + (hrun : (releaseSlots input (parameterDrops base modes remaining)).run + state = .ok (output, emit) finalState) : + ParameterDropsAdmissible modes remaining := + parameterDropsAdmissible_of_drop_admissible base modes remaining + (releaseSlots_run_drop_admissible hrun) + +/-- The exact generated field/parameter prefix establishes the logical RHS +layout needed by occurrence accounting: every ordinary entry is tracked by +its RHS count and the final entry is the untouched recursive-self marker. -/ +theorem recursorPrefix_entries_tracked + (numArgs fields : Nat) (rhs : IxIR0.Expr) (state : LowSt) + {fieldOutput : VEnv} {fieldEmit : Emit} + {rhsInput : VEnv} {parameterEmit : Emit} + (hfieldRun : + applyRecursorFieldRetains + ⟨List.replicate fields (.slot 0 0 .many false), + (numArgs + 1) + fields⟩ + (recursorFieldRetains (numArgs + 1) rhs fields) = + (fieldOutput, fieldEmit)) + (hparameterRun : + (releaseSlots + ⟨fieldOutput.entries ++ + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (fields + i) rhs) ++ + [.recSelf (numArgs + 1)], + fieldOutput.depth + 1⟩ + ((parameterDrops 0 (List.replicate numArgs .many) + (fun i => countUses (fields + i) rhs)).map + (SlotDrop.offsetEntry fields))).run state = + .ok (rhsInput, parameterEmit) state) : + EntriesTrackCounts rhsInput (fields + numArgs) + (fun index => countUses index rhs) ∧ + rhsInput.entries.length = fields + numArgs + 1 ∧ + RecSelfAt rhsInput (fields + numArgs) (numArgs + 1) := by + obtain ⟨plannedFieldOutput, plannedFieldEmit, + hfieldPlan, hfieldTracks⟩ := + recursorFieldRetains_plan_tracked + (numArgs + 1) ((numArgs + 1) + fields) fields rhs + have hfieldEq : + (fieldOutput, fieldEmit) = + (plannedFieldOutput, plannedFieldEmit) := + hfieldRun.symm.trans hfieldPlan.run + cases hfieldEq + have hfieldLength : fieldOutput.entries.length = fields := by + calc + fieldOutput.entries.length = + (List.replicate fields + (VEntry.slot 0 0 Uses.many false)).length := + hfieldPlan.entries_length + _ = fields := by simp + let paramModes := List.replicate numArgs Uses.many + let paramRemaining : Nat → Nat := + fun index => countUses (fields + index) rhs + obtain ⟨parameterOutput, plannedParameterEmit, + hparameterPlan, hparameterTracks⟩ := + parameterDrops_releasePlan_tracked_atDepth + 0 (fieldOutput.depth + 1) paramModes paramRemaining + (replicate_many_parameterDropsAdmissible numArgs paramRemaining) + have hparameterLength : parameterOutput.entries.length = numArgs := by + calc + parameterOutput.entries.length = + (parameterEntries 0 paramModes paramRemaining).length := + hparameterPlan.entries_length + _ = numArgs := by simp [paramModes] + let plannedRhsInput := + prependVEnvEntries fieldOutput.entries + (frameVEnvEntries parameterOutput [.recSelf (numArgs + 1)]) + have hfullPlan : ReleasePlan + ⟨fieldOutput.entries ++ + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (fields + i) rhs) ++ + [.recSelf (numArgs + 1)], + fieldOutput.depth + 1⟩ + ((parameterDrops 0 (List.replicate numArgs .many) + (fun i => countUses (fields + i) rhs)).map + (SlotDrop.offsetEntry fields)) + plannedRhsInput plannedParameterEmit := by + have hframed := hparameterPlan.frameEntries + [.recSelf (numArgs + 1)] + have hprepended := hframed.prependEntries fieldOutput.entries + simpa [plannedRhsInput, prependVEnvEntries, frameVEnvEntries, + paramModes, paramRemaining, hfieldLength, List.append_assoc] + using hprepended + have hfullRun := hfullPlan.run state + have hrhsEq : + (plannedRhsInput, plannedParameterEmit) = + (rhsInput, parameterEmit) ∧ state = state := by + simpa using hfullRun.symm.trans hparameterRun + have hinputs := hrhsEq.1 + have hrhsInput : plannedRhsInput = rhsInput := + congrArg Prod.fst hinputs + subst rhsInput + refine ⟨?_, ?_, ?_⟩ + · intro index hindex + by_cases hfield : index < fields + · obtain ⟨abs, uses, htrack⟩ := hfieldTracks index hfield + refine ⟨abs, uses, ?_⟩ + rw [EntryTracksAt] at htrack ⊢ + change + (fieldOutput.entries ++ + (parameterOutput.entries ++ [.recSelf (numArgs + 1)]))[index]? = _ + have hfield' : index < fieldOutput.entries.length := by + simpa [hfieldLength] using hfield + rw [List.getElem?_append_left hfield'] + exact htrack + · let parameterIndex := index - fields + have hparameterIndex : parameterIndex < numArgs := by + dsimp only [parameterIndex] + omega + obtain ⟨abs, uses, htrack⟩ := + hparameterTracks parameterIndex + (by simpa [paramModes] using hparameterIndex) + refine ⟨abs, uses, ?_⟩ + rw [EntryTracksAt] at htrack ⊢ + change + (fieldOutput.entries ++ + (parameterOutput.entries ++ [.recSelf (numArgs + 1)]))[index]? = _ + have hindexEq : + index = fieldOutput.entries.length + parameterIndex := by + dsimp only [parameterIndex] + omega + rw [hindexEq] + rw [List.getElem?_append_right (Nat.le_add_right _ _)] + simp only [Nat.add_sub_cancel_left] + have hparameter' : + parameterIndex < parameterOutput.entries.length := by + simpa [hparameterLength] using hparameterIndex + rw [List.getElem?_append_left hparameter'] + simpa only [paramRemaining, hfieldLength] using htrack + · simp [plannedRhsInput, prependVEnvEntries, frameVEnvEntries, + hfieldLength, hparameterLength] + omega + · simp [RecSelfAt, plannedRhsInput, prependVEnvEntries, + frameVEnvEntries, hfieldLength, hparameterLength] + +theorem EntryTracksAt.index_lt {Γ : VEnv} {index abs : Nat} + {uses : Uses} {remaining : Nat} + (htrack : EntryTracksAt Γ index abs uses remaining) : + index < Γ.entries.length := by + rw [EntryTracksAt] at htrack + exact (List.getElem?_eq_some_iff.mp htrack).choose + +theorem EntryTracksAt.bump {Γ : VEnv} {index abs : Nat} + {uses : Uses} {remaining : Nat} + (htrack : EntryTracksAt Γ index abs uses remaining) : + EntryTracksAt Γ.bump index abs uses remaining := by + exact htrack + +theorem EntryTracksAt.of_entries_eq {Γ Δ : VEnv} {index abs : Nat} + {uses : Uses} {remaining : Nat} + (hentries : Δ.entries = Γ.entries) + (htrack : EntryTracksAt Γ index abs uses remaining) : + EntryTracksAt Δ index abs uses remaining := by + simpa [EntryTracksAt, hentries] using htrack + +theorem EntryTracksAt.set_self {Γ : VEnv} {index abs remaining : Nat} + {uses : Uses} + (htrack : EntryTracksAt Γ index abs uses remaining) : + EntryTracksAt + (Γ.setEntry index + (.slot abs remaining uses (remaining != 0))) + index abs uses remaining := by + rw [EntryTracksAt, VEnv.setEntry, List.getElem?_set] + simp [htrack.index_lt] + +theorem EntryTracksAt.set_self_to {Γ : VEnv} + {index oldAbs oldRemaining : Nat} {oldUses : Uses} + (newAbs remaining : Nat) (uses : Uses) + (htrack : EntryTracksAt Γ index oldAbs oldUses oldRemaining) : + EntryTracksAt + (Γ.setEntry index + (.slot newAbs remaining uses (remaining != 0))) + index newAbs uses remaining := by + rw [EntryTracksAt, VEnv.setEntry, List.getElem?_set] + simp [htrack.index_lt] + +theorem EntryTracksAt.set_ne {Γ : VEnv} {tracked changed abs : Nat} + {uses : Uses} {remaining : Nat} {entry : VEntry} + (hne : changed ≠ tracked) + (htrack : EntryTracksAt Γ tracked abs uses remaining) : + EntryTracksAt (Γ.setEntry changed entry) tracked abs uses remaining := by + rw [EntryTracksAt, VEnv.setEntry, List.getElem?_set] + simp [hne] + simpa [EntryTracksAt] using htrack + +theorem EntryTracksAt.slot_inj {Γ : VEnv} {index : Nat} + {knownAbs knownRemaining trackedAbs trackedRemaining : Nat} + {knownUses trackedUses : Uses} {knownHeld : Bool} + (htrack : EntryTracksAt Γ index trackedAbs trackedUses + trackedRemaining) + (hentry : Γ.entries[index]? = some + (.slot knownAbs knownRemaining knownUses knownHeld)) : + knownAbs = trackedAbs ∧ knownRemaining = trackedRemaining ∧ + knownUses = trackedUses ∧ + knownHeld = (trackedRemaining != 0) := by + rw [EntryTracksAt] at htrack + have hsome := Option.some.inj (hentry.symm.trans htrack) + exact VEntry.slot.inj hsome + +theorem EntryTracksAt.cons {Γ : VEnv} {index abs : Nat} + {uses : Uses} {remaining : Nat} {entry : VEntry} + (htrack : EntryTracksAt Γ index abs uses remaining) : + EntryTracksAt { Γ with entries := entry :: Γ.entries } + (index + 1) abs uses remaining := by + simpa [EntryTracksAt] using htrack + +theorem EntryTracksAt.pop_succ {Γ : VEnv} {index abs : Nat} + {uses : Uses} {remaining : Nat} + (htrack : EntryTracksAt Γ (index + 1) abs uses remaining) : + EntryTracksAt Γ.pop index abs uses remaining := by + simpa [EntryTracksAt, VEnv.pop] using htrack + +theorem EntryConsumption.zero (Γ : VEnv) : + EntryConsumption Γ Γ (fun _ => 0) := by + intro index abs uses base htrack + simpa using htrack + +theorem EntryConsumption.bump {input output : VEnv} + {consumed : Nat → Nat} + (hconsume : EntryConsumption input output consumed) : + EntryConsumption input output.bump consumed := by + intro index abs uses base htrack + exact (hconsume index abs uses base htrack).bump + +theorem EntryConsumption.comp {first middle final : VEnv} + {left right : Nat → Nat} + (hleft : EntryConsumption first middle left) + (hright : EntryConsumption middle final right) : + EntryConsumption first final (fun i => left i + right i) := by + intro index abs uses base htrack + have hfirst : EntryTracksAt first index abs uses + ((base + right index) + left index) := by + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using htrack + exact hright index abs uses base + (hleft index abs uses (base + right index) hfirst) + +theorem EntryConsumption.bind_under_binder + {input middle bodyInput bodyOutput : VEnv} + {value body : IxIR0.Expr} {binder : VEntry} + (hvalue : EntryConsumption input middle + (fun index => countUses index value)) + (hbody : EntryConsumption bodyInput bodyOutput + (fun index => countUses index body)) + (hentries : bodyInput.entries = binder :: middle.entries) : + EntryConsumption input bodyOutput.pop + (fun index => countUses index value + countUses (index + 1) body) := by + intro index abs uses base htrack + have hvalueInput : EntryTracksAt input index abs uses + ((base + countUses (index + 1) body) + countUses index value) := by + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using htrack + have hmiddle := hvalue index abs uses + (base + countUses (index + 1) body) hvalueInput + have hbodyInput : EntryTracksAt bodyInput (index + 1) abs uses + (base + countUses (index + 1) body) := by + rw [EntryTracksAt, hentries] + simpa [EntryTracksAt] using hmiddle + exact EntryTracksAt.pop_succ + (hbody (index + 1) abs uses base hbodyInput) + +theorem EntryConsumption.of_entries_eq {input output : VEnv} + (hentries : output.entries = input.entries) : + EntryConsumption input output (fun _ => 0) := by + intro index abs uses base htrack + simpa [EntryTracksAt, hentries] using htrack + +theorem releaseAll_entries_eq (input : VEnv) : + ∀ values : List AVal, + (releaseAll input values).1.entries = input.entries := by + intro values + exact releaseAll_traverse_core + (Result := fun initial _ output _ => + output.entries = initial.entries) + (hnil := fun _ => rfl) + (hconst := fun htail => htail) + (hslot := by + intro initial abs rest output tailEmit htail + simpa [VEnv.bump] using htail) + input values + +theorem releaseAll_consumes_zero (input : VEnv) (values : List AVal) : + EntryConsumption input (releaseAll input values).1 (fun _ => 0) := + EntryConsumption.of_entries_eq (releaseAll_entries_eq input values) + +theorem FirstEntryTracks.entryTracksAt + {Γ : VEnv} {uses : Uses} {remaining : Nat} + (htrack : FirstEntryTracks Γ uses remaining) : + ∃ abs, EntryTracksAt Γ 0 abs uses remaining := by + obtain ⟨abs, tail, hentries⟩ := htrack + exact ⟨abs, by simp [EntryTracksAt, hentries]⟩ + +theorem EntryTracksAt.zeroReleased {Γ : VEnv} {abs : Nat} + {uses : Uses} + (htrack : EntryTracksAt Γ 0 abs uses 0) : + FirstEntryReleased Γ := by + cases hentries : Γ.entries with + | nil => simp [EntryTracksAt, hentries] at htrack + | cons entry tail => + have hentry : entry = .slot abs 0 uses false := by + simpa [EntryTracksAt, hentries] using htrack + subst entry + exact ⟨abs, 0, uses, tail, hentries⟩ + +def countUsesExprs (index : Nat) (exprs : List IxIR0.Expr) : Nat := + (exprs.map (countUses index)).sum + +def countUsesArgs (index : Nat) + (args : List (IxIR0.Expr × Owned)) : Nat := + (args.map (fun arg => countUses index arg.1)).sum + +@[simp] theorem countUsesArgs_map_shared (index : Nat) + (exprs : List IxIR0.Expr) : + countUsesArgs index (exprs.map (fun expr => (expr, Owned.shared))) = + countUsesExprs index exprs := by + induction exprs with + | nil => rfl + | cons expr rest ih => + simp [countUsesArgs, countUsesExprs, Function.comp_def] + +theorem countUsesArgs_zip (index : Nat) : + ∀ (exprs : List IxIR0.Expr) (worlds : List Owned), + exprs.length ≤ worlds.length → + countUsesArgs index (exprs.zip worlds) = + countUsesExprs index exprs := by + intro exprs + induction exprs with + | nil => intro worlds _; rfl + | cons expr rest ih => + intro worlds hlength + cases worlds with + | nil => simp at hlength + | cons world worlds => + simp only [List.length_cons, Nat.add_le_add_iff_right] at hlength + change countUses index expr + + countUsesArgs index (rest.zip worlds) = + countUses index expr + countUsesExprs index rest + rw [ih worlds hlength] + +@[simp] theorem padWorlds_length (worlds : List Owned) (count : Nat) : + (padWorlds worlds count).length = count := by + simp [padWorlds] + omega + +theorem countUsesArgs_knownPrefix (index : Nat) + (args : List IxIR0.Expr) (worlds : List Owned) (count : Nat) : + countUsesArgs index ((args.take count).zip (padWorlds worlds count)) = + countUsesExprs index (args.take count) := by + apply countUsesArgs_zip + simpa using Nat.min_le_left count args.length + +theorem countUsesExprs_take_add_drop (index count : Nat) + (args : List IxIR0.Expr) : + countUsesExprs index (args.take count) + + countUsesExprs index (args.drop count) = + countUsesExprs index args := by + simp only [countUsesExprs] + rw [← List.sum_append, ← List.map_append] + simp + +def LowerEConsumesEntries (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {world : Owned} {expr : IxIR0.Expr} + {state finalState : LowSt} {output : VEnv} {emit : Emit} {av : AVal}, + (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState → + EntryConsumption input output (fun index => countUses index expr) + +theorem LowerEConsumesEntries.releasesTrackedFirst + {src : IxIR0.Env} {fuel : Nat} + (hconsume : LowerEConsumesEntries src fuel) (expr : IxIR0.Expr) : + LowerEReleasesTrackedFirst src fuel expr := by + intro input output world uses state finalState emit av htrack hrun + obtain ⟨abs, hat⟩ := htrack.entryTracksAt + apply EntryTracksAt.zeroReleased (abs := abs) + exact hconsume hrun 0 abs uses 0 (by simpa using hat) + +theorem lowerE_var_consumesEntries + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {world : Owned} {varIndex : Nat} {emit : Emit} {av : AVal} + {state finalState : LowSt} + (hrun : (lowerE src (fuel + 1) input world (.var varIndex)).run state = + .ok (output, emit, av) finalState) : + EntryConsumption input output + (fun index => countUses index (.var varIndex)) := by + have hssNe : (Owned.shared != Owned.shared) = false := by decide + have huuNe : (Owned.unique != Owned.unique) = false := by decide + have hsuNe : (Owned.shared != Owned.unique) = true := by decide + have husNe : (Owned.unique != Owned.shared) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + have huuEq : (Owned.unique == Owned.unique) = true := by decide + intro index abs uses base htrack + by_cases heq : varIndex = index + · subst index + cases base with + | zero => + have hentry : input.entries[varIndex]? = + some (.slot abs 1 uses true) := by + simpa [EntryTracksAt, countUses] using htrack + by_cases hworld : worldOfUses uses = world + · subst world + have hsame : + (worldOfUses uses != worldOfUses uses) = false := by + cases uses <;> decide + have hpure : + (input.setEntry varIndex (.slot abs 0 uses false), + (_root_.id : Emit), AVal.slotA abs) = + (output, emit, av) ∧ state = finalState := by + simpa [lowerE, hentry, hsame] using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + apply EntryTracksAt.set_self_to abs 0 uses + exact htrack + · cases uses <;> cases world + all_goals + try { exact (hworld (by rfl)).elim } + all_goals + exact (trackedThrowRun_not_ok (by + simpa [lowerE, hentry, worldOfUses, hssNe, huuNe, hsuNe, + husNe, hsuEq, huuEq] using hrun)).elim + | succ base => + have hentry : input.entries[varIndex]? = + some (.slot abs (base + 2) uses true) := by + simpa [EntryTracksAt, countUses, Nat.add_assoc] using htrack + by_cases hworld : worldOfUses uses = world + · subst world + have hsame : + (worldOfUses uses != worldOfUses uses) = false := by + cases uses <;> decide + cases uses with + | erased => + have heqUnique : + (Owned.shared == Owned.unique) = false := by decide + have hpure : + let changed := input.setEntry varIndex + (.slot abs (base + 1) .erased true) + (changed.bump, + emitOp (.dup (.var (changed.rel abs))), + AVal.slotA changed.depth) = (output, emit, av) ∧ + state = finalState := by + simpa [lowerE, hentry, worldOfUses, hsame, heqUnique, + hssNe] using hrun + dsimp only at hpure + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + apply EntryTracksAt.bump + apply EntryTracksAt.set_self_to abs (base + 1) .erased + exact htrack + | linear => + have heqUnique : + (Owned.unique == Owned.unique) = true := by decide + exact (trackedThrowRun_not_ok (by + simpa [lowerE, hentry, worldOfUses, hsame, heqUnique, + huuNe] using hrun)).elim + | affine => + have heqUnique : + (Owned.unique == Owned.unique) = true := by decide + exact (trackedThrowRun_not_ok (by + simpa [lowerE, hentry, worldOfUses, hsame, heqUnique, + huuNe] using hrun)).elim + | many => + have heqUnique : + (Owned.shared == Owned.unique) = false := by decide + have hpure : + let changed := input.setEntry varIndex + (.slot abs (base + 1) .many true) + (changed.bump, + emitOp (.dup (.var (changed.rel abs))), + AVal.slotA changed.depth) = (output, emit, av) ∧ + state = finalState := by + simpa [lowerE, hentry, worldOfUses, hsame, heqUnique, + hssNe] using hrun + dsimp only at hpure + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + apply EntryTracksAt.bump + apply EntryTracksAt.set_self_to abs (base + 1) .many + exact htrack + · cases uses <;> cases world + all_goals + try { exact (hworld (by rfl)).elim } + all_goals + exact (trackedThrowRun_not_ok (by + simpa [lowerE, hentry, worldOfUses, hssNe, huuNe, hsuNe, + husNe, hsuEq, huuEq] using hrun)).elim + · have hcount : countUses index (.var varIndex) = 0 := by + simp [countUses, heq] + have htrack' : EntryTracksAt input index abs uses base := by + simpa [hcount] using htrack + cases hentry : input.entries[varIndex]? with + | none => + exact (trackedThrowRun_not_ok (by + simpa [lowerE, hentry] using hrun)).elim + | some entry => + cases entry with + | recSelf arity => + exact (trackedThrowRun_not_ok (by + simpa [lowerE, hentry] using hrun)).elim + | slot variableAbs remaining variableUses held => + cases held with + | false => + exact (trackedThrowRun_not_ok (by + simpa [lowerE, hentry] using hrun)).elim + | true => + by_cases hworld : worldOfUses variableUses = world + · subst world + have hsame : + (worldOfUses variableUses != worldOfUses variableUses) = + false := by + cases variableUses <;> decide + cases remaining with + | zero => + exact (trackedThrowRun_not_ok (by + simpa [lowerE, hentry, hsame] using hrun)).elim + | succ remaining => + cases remaining with + | zero => + have hpure : + (input.setEntry varIndex + (.slot variableAbs 0 variableUses false), + (_root_.id : Emit), AVal.slotA variableAbs) = + (output, emit, av) ∧ state = finalState := by + simpa [lowerE, hentry, hsame] using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact EntryTracksAt.set_ne heq htrack' + | succ remaining => + cases variableUses with + | erased => + have heqUnique : + (Owned.shared == Owned.unique) = false := by decide + have hpure : + let changed := input.setEntry varIndex + (.slot variableAbs (Nat.succ remaining) .erased true) + (changed.bump, + emitOp (.dup (.var (changed.rel variableAbs))), + AVal.slotA changed.depth) = (output, emit, av) ∧ + state = finalState := by + simpa [lowerE, hentry, worldOfUses, hsame, + heqUnique, hssNe] using hrun + dsimp only at hpure + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact (EntryTracksAt.set_ne heq htrack').bump + | linear => + have heqUnique : + (Owned.unique == Owned.unique) = true := by decide + exact (trackedThrowRun_not_ok (by + simpa [lowerE, hentry, worldOfUses, hsame, heqUnique, + huuNe] using hrun)).elim + | affine => + have heqUnique : + (Owned.unique == Owned.unique) = true := by decide + exact (trackedThrowRun_not_ok (by + simpa [lowerE, hentry, worldOfUses, hsame, heqUnique, + huuNe] using hrun)).elim + | many => + have heqUnique : + (Owned.shared == Owned.unique) = false := by decide + have hpure : + let changed := input.setEntry varIndex + (.slot variableAbs (Nat.succ remaining) .many true) + (changed.bump, + emitOp (.dup (.var (changed.rel variableAbs))), + AVal.slotA changed.depth) = (output, emit, av) ∧ + state = finalState := by + simpa [lowerE, hentry, worldOfUses, hsame, + heqUnique, hssNe] using hrun + dsimp only at hpure + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact (EntryTracksAt.set_ne heq htrack').bump + · have hdiff : (worldOfUses variableUses != world) = true := by + cases variableUses <;> cases world <;> + simp_all [worldOfUses] <;> decide + cases variableUses <;> cases world + all_goals + try { exact (hworld (by rfl)).elim } + all_goals + exact (trackedThrowRun_not_ok (by + simpa [lowerE, hentry, worldOfUses, hdiff, hssNe, huuNe, + hsuNe, husNe, hsuEq, huuEq] using hrun)).elim + +def LowerBorrowConsumesEntries (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {expr : IxIR0.Expr} + {state finalState : LowSt} {output : VEnv} {emit : Emit} + {av : AVal} {release : Bool}, + (lowerBorrow src fuel input expr).run state = + .ok (output, emit, av, release) finalState → + EntryConsumption input output (fun index => countUses index expr) + +def LowerSpineConsumesEntries (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {world : Owned} {head : IxIR0.Expr} + {args : List IxIR0.Expr} {state finalState : LowSt} + {output : VEnv} {emit : Emit} {av : AVal}, + (lowerSpine src fuel input world head args).run state = + .ok (output, emit, av) finalState → + EntryConsumption input output + (fun index => countUses index head + countUsesExprs index args) + +def LowerArgsConsumesEntries (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {args : List (IxIR0.Expr × Owned)} + {state finalState : LowSt} {output : VEnv} + {emit : Emit} {avs : List AVal}, + (lowerArgs src fuel input args).run state = + .ok (output, emit, avs) finalState → + EntryConsumption input output (fun index => countUsesArgs index args) + +def KnownCallConsumesEntries (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {build : Array Atom → Op} {count : Nat} + {argWorlds : List Owned} {resultWorld : Owned} + {args : List IxIR0.Expr} {state finalState : LowSt} + {output : VEnv} {emit : Emit} {av : AVal}, + (knownCall src fuel input build count argWorlds resultWorld args).run + state = .ok (output, emit, av) finalState → + EntryConsumption input output (fun index => countUsesExprs index args) + +def ApplyRestConsumesEntries (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {resultWorld : Owned} {pre : Emit} + {function : AVal} {args : List IxIR0.Expr} + {state finalState : LowSt} {output : VEnv} + {emit : Emit} {av : AVal}, + (applyRest src fuel input resultWorld pre function args).run state = + .ok (output, emit, av) finalState → + EntryConsumption input output (fun index => countUsesExprs index args) + +def LowerLamConsumesEntries (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {expr : IxIR0.Expr} + {state finalState : LowSt} {output : VEnv} + {emit : Emit} {av : AVal}, + (lowerLam src fuel input expr).run state = + .ok (output, emit, av) finalState → + EntryConsumption input output (fun index => countUses index expr) + +structure LowerConsumesEntries (src : IxIR0.Env) (fuel : Nat) : Prop where + expr : LowerEConsumesEntries src fuel + borrow : LowerBorrowConsumesEntries src fuel + spine : LowerSpineConsumesEntries src fuel + knownCall : KnownCallConsumesEntries src fuel + args : LowerArgsConsumesEntries src fuel + applyRest : ApplyRestConsumesEntries src fuel + lam : LowerLamConsumesEntries src fuel + +theorem lowerConsumesEntries_zero (src : IxIR0.Env) : + LowerConsumesEntries src 0 := by + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro input world expr state finalState output emit av hrun + exact (trackedThrowRun_not_ok (by simpa [lowerE] using hrun)).elim + · intro input expr state finalState output emit av release hrun + exact (trackedThrowRun_not_ok (by + simpa [lowerBorrow] using hrun)).elim + · intro input world head args state finalState output emit av hrun + exact (trackedThrowRun_not_ok (by + simpa [lowerSpine] using hrun)).elim + · intro input build count argWorlds resultWorld args state finalState + output emit av hrun + exact (trackedThrowRun_not_ok (by + simpa [knownCall] using hrun)).elim + · intro input args state finalState output emit avs hrun + exact (trackedThrowRun_not_ok (by + simpa [lowerArgs] using hrun)).elim + · intro input resultWorld pre function args state finalState output emit av + hrun + exact (trackedThrowRun_not_ok (by + simpa [applyRest] using hrun)).elim + · intro input expr state finalState output emit av hrun + exact (trackedThrowRun_not_ok (by simpa [lowerLam] using hrun)).elim + +theorem lowerArgsConsumesEntries_succ + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEConsumesEntries src fuel) + (hargs : LowerArgsConsumesEntries src fuel) : + LowerArgsConsumesEntries src (fuel + 1) := by + intro input args state finalState output emit avs hrun + cases args with + | nil => + have hpure : + (input, (_root_.id : Emit), []) = (output, emit, avs) ∧ + state = finalState := by + simpa [lowerArgs] using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + simpa [countUsesArgs] using EntryConsumption.zero input + | cons head rest => + rcases head with ⟨expr, world⟩ + simp only [lowerArgs] at hrun + obtain ⟨headResult, middleState, hheadRun, hafterHead⟩ := + trackedBindRun_ok_inv hrun + rcases headResult with ⟨middle, headEmit, av⟩ + obtain ⟨tailResult, tailState, htailRun, hpureRun⟩ := + trackedBindRun_ok_inv hafterHead + rcases tailResult with ⟨actualOutput, tailEmit, tailValues⟩ + have hpure : + (actualOutput, headEmit ∘ tailEmit, av :: tailValues) = + (output, emit, avs) ∧ tailState = finalState := by + simpa using hpureRun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + have hcomposed := (hexpr hheadRun).comp (hargs htailRun) + simpa [countUsesArgs] using hcomposed + +theorem applyRestConsumesEntries_succ + {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsConsumesEntries src fuel) : + ApplyRestConsumesEntries src (fuel + 1) := by + intro input resultWorld pre function args state finalState output emit av + hrun + cases function with + | constA atom => + cases atom with + | erased => + simp only [applyRest] at hrun + obtain ⟨argsResult, argsState, hargsRun, hpureRun⟩ := + trackedBindRun_ok_inv hrun + rcases argsResult with ⟨middle, argsEmit, values⟩ + have hpure : + ((releaseAll middle values).1, + pre ∘ argsEmit ∘ (releaseAll middle values).2, + AVal.constA .erased) = (output, emit, av) ∧ + argsState = finalState := by + simpa using hpureRun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + have hcomposed := (hargs hargsRun).comp + (releaseAll_consumes_zero middle values) + simpa using hcomposed + | var functionIndex => + simp only [applyRest] at hrun + obtain ⟨unitValue, checkedState, _, hafterCheck⟩ := + trackedBindRun_ok_inv hrun + cases unitValue + obtain ⟨argsResult, argsState, hargsRun, hpureRun⟩ := + trackedBindRun_ok_inv hafterCheck + rcases argsResult with ⟨middle, argsEmit, values⟩ + have hpure : + (middle.bump, + pre ∘ argsEmit ∘ emitOp (.apply + ((AVal.constA (.var functionIndex)).toAtom middle) + (values.map (·.toAtom middle)).toArray), + AVal.slotA middle.depth) = (output, emit, av) ∧ + argsState = finalState := by + simpa using hpureRun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + simpa using (hargs hargsRun).bump + | lit literal => + simp only [applyRest] at hrun + obtain ⟨unitValue, checkedState, _, hafterCheck⟩ := + trackedBindRun_ok_inv hrun + cases unitValue + obtain ⟨argsResult, argsState, hargsRun, hpureRun⟩ := + trackedBindRun_ok_inv hafterCheck + rcases argsResult with ⟨middle, argsEmit, values⟩ + have hpure : + (middle.bump, + pre ∘ argsEmit ∘ emitOp (.apply + ((AVal.constA (.lit literal)).toAtom middle) + (values.map (·.toAtom middle)).toArray), + AVal.slotA middle.depth) = (output, emit, av) ∧ + argsState = finalState := by + simpa using hpureRun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + simpa using (hargs hargsRun).bump + | slotA functionAbs => + simp only [applyRest] at hrun + obtain ⟨unitValue, checkedState, _, hafterCheck⟩ := + trackedBindRun_ok_inv hrun + cases unitValue + obtain ⟨argsResult, argsState, hargsRun, hpureRun⟩ := + trackedBindRun_ok_inv hafterCheck + rcases argsResult with ⟨middle, argsEmit, values⟩ + have hpure : + (middle.bump, + pre ∘ argsEmit ∘ emitOp (.apply + ((AVal.slotA functionAbs).toAtom middle) + (values.map (·.toAtom middle)).toArray), + AVal.slotA middle.depth) = (output, emit, av) ∧ + argsState = finalState := by + simpa using hpureRun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + simpa using (hargs hargsRun).bump + +theorem knownCallConsumesEntries_succ + {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsConsumesEntries src fuel) + (hrest : ApplyRestConsumesEntries src fuel) : + KnownCallConsumesEntries src (fuel + 1) := by + intro input build count argWorlds resultWorld args state finalState output + emit av hrun + simp only [knownCall] at hrun + obtain ⟨argsResult, argsState, hargsRun, hafterArgs⟩ := + trackedBindRun_ok_inv hrun + rcases argsResult with ⟨middle, argsEmit, values⟩ + have hprefix := hargs hargsRun + have hprefix' : EntryConsumption input middle + (fun index => countUsesExprs index (args.take count)) := by + simpa only [countUsesArgs_knownPrefix] using hprefix + by_cases hterminal : args.length ≤ count + · have hpure : + (middle.bump, + argsEmit ∘ emitOp + (build (values.map (·.toAtom middle)).toArray), + AVal.slotA middle.depth) = (output, emit, av) ∧ + argsState = finalState := by + simpa [hterminal] using hafterArgs + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + have htake : args.take count = args := + List.take_of_length_le hterminal + simpa [htake] using hprefix'.bump + · have hrestRun : + (applyRest src fuel middle.bump resultWorld + (argsEmit ∘ emitOp + (build (values.map (·.toAtom middle)).toArray)) + (.slotA middle.depth) (args.drop count)).run argsState = + .ok (output, emit, av) finalState := by + simpa [hterminal] using hafterArgs + have hcomposed := hprefix'.bump.comp (hrest hrestRun) + simpa [countUsesArgs_knownPrefix, + countUsesExprs_take_add_drop] using hcomposed + +theorem lowerSpine_dynamic_consumesEntries + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEConsumesEntries src fuel) + (hrest : ApplyRestConsumesEntries src fuel) + {input output : VEnv} {world : Owned} {head : IxIR0.Expr} + {args : List IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hrun : (do + let (middle, headEmit, function) ← + lowerE src fuel input .shared head + applyRest src fuel middle world headEmit function args).run state = + .ok (output, emit, av) finalState) : + EntryConsumption input output + (fun index => countUses index head + countUsesExprs index args) := by + obtain ⟨headResult, middleState, hheadRun, hrestRun⟩ := + trackedBindRun_ok_inv hrun + rcases headResult with ⟨middle, headEmit, function⟩ + exact (hexpr hheadRun).comp (hrest hrestRun) + +theorem lowerSpine_var_consumesEntries + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEConsumesEntries src fuel) + (hknown : KnownCallConsumesEntries src fuel) + (hrest : ApplyRestConsumesEntries src fuel) + {input output : VEnv} {world : Owned} {varIndex : Nat} + {args : List IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hrun : (lowerSpine src (fuel + 1) input world (.var varIndex) + args).run state = .ok (output, emit, av) finalState) : + EntryConsumption input output + (fun index => countUses index (.var varIndex) + + countUsesExprs index args) := by + simp only [lowerSpine] at hrun + cases hentry : input.entries[varIndex]? with + | none => + rw [hentry] at hrun + simp only at hrun + exact lowerSpine_dynamic_consumesEntries hexpr hrest hrun + | some entry => + cases entry with + | slot abs remaining uses held => + rw [hentry] at hrun + simp only at hrun + exact lowerSpine_dynamic_consumesEntries hexpr hrest hrun + | recSelf arity => + rw [hentry] at hrun + simp only at hrun + by_cases hunder : args.length < arity + · rw [if_pos hunder] at hrun + exact (trackedThrowRun_not_ok hrun).elim + · rw [if_neg hunder] at hrun + obtain ⟨unitValue, checkedState, _, hknownRun⟩ := + trackedBindRun_ok_inv hrun + cases unitValue + have hargsConsume := hknown hknownRun + intro index trackedAbs trackedUses base htrack + have hne : varIndex ≠ index := by + intro heq + subst index + rw [EntryTracksAt] at htrack + rw [hentry] at htrack + cases htrack + have hzero : countUses index (.var varIndex) = 0 := by + simp [countUses, hne] + exact hargsConsume index trackedAbs trackedUses base + (by simpa [hzero] using htrack) + +theorem lowerSpine_ref_consumesEntries + {src : IxIR0.Env} {fuel : Nat} + (hknown : KnownCallConsumesEntries src fuel) + {input output : VEnv} {world : Owned} {address : Ixon.Address} + {args : List IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hrun : (lowerSpine src (fuel + 1) input world (.ref address) + args).run state = .ok (output, emit, av) finalState) : + EntryConsumption input output + (fun index => countUses index (.ref address) + + countUsesExprs index args) := by + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + simp only [lowerSpine] at hrun + cases hsource : src address with + | none => + rw [hsource] at hrun + exact (trackedThrowRun_not_ok hrun).elim + | some decl => + rw [hsource] at hrun + cases decl with + | defn result body => + simp only at hrun + by_cases hunder : args.length < lamArity body + · rw [if_pos hunder] at hrun + cases world with + | unique => exact (trackedThrowRun_not_ok hrun).elim + | shared => + cases result with + | unique => exact (trackedThrowRun_not_ok hrun).elim + | shared => + cases hp : papSafe body with + | false => + exact (trackedThrowRun_not_ok (by + simpa [hp, hsuEq] using hrun)).elim + | true => + have hknownRun : + (knownCall src fuel input (.papp address ·) args.length + (List.replicate args.length .shared) .shared args).run + state = .ok (output, emit, av) finalState := by + simpa [hp, hsuEq] using hrun + simpa [countUses] using hknown hknownRun + · rw [if_neg hunder] at hrun + obtain ⟨unitValue, checkedState, _, hknownRun⟩ := + trackedBindRun_ok_inv hrun + cases unitValue + simpa [countUses] using hknown hknownRun + | ctor tag arity => + simp only at hrun + by_cases hunder : args.length < arity + · rw [if_pos hunder] at hrun + cases world with + | unique => exact (trackedThrowRun_not_ok hrun).elim + | shared => + obtain ⟨wrapper, wrapperState, _, hknownRun⟩ := + trackedBindRun_ok_inv hrun + simpa [countUses] using hknown hknownRun + · rw [if_neg hunder] at hrun + simpa [countUses] using hknown hrun + | recursor numArgs natLit rules => + simp only at hrun + by_cases hunder : args.length < numArgs + 1 + · rw [if_pos hunder] at hrun + cases world with + | unique => exact (trackedThrowRun_not_ok hrun).elim + | shared => simpa [countUses] using hknown hrun + · rw [if_neg hunder] at hrun + obtain ⟨unitValue, checkedState, _, hknownRun⟩ := + trackedBindRun_ok_inv hrun + cases unitValue + simpa [countUses] using hknown hknownRun + | extern arity => + simp only at hrun + by_cases hunder : args.length < arity + · rw [if_pos hunder] at hrun + cases world with + | unique => exact (trackedThrowRun_not_ok hrun).elim + | shared => simpa [countUses] using hknown hrun + · rw [if_neg hunder] at hrun + simpa [countUses] using hknown hrun + +theorem lowerSpineConsumesEntries_succ + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEConsumesEntries src fuel) + (hspine : LowerSpineConsumesEntries src fuel) + (hknown : KnownCallConsumesEntries src fuel) + (hrest : ApplyRestConsumesEntries src fuel) : + LowerSpineConsumesEntries src (fuel + 1) := by + intro input world head args state finalState output emit av hrun + cases head with + | app function argument => + have hrecursive := hspine (by simpa [lowerSpine] using hrun) + simpa [countUses, countUsesExprs, Nat.add_assoc, Nat.add_comm, + Nat.add_left_comm] using hrecursive + | erased => + have happly := hrest (by simpa [lowerSpine] using hrun) + simpa [countUses] using happly + | var index => + exact lowerSpine_var_consumesEntries hexpr hknown hrest hrun + | ref address => + exact lowerSpine_ref_consumesEntries hknown hrun + | lam uses body => + exact lowerSpine_dynamic_consumesEntries hexpr hrest + (by simpa [lowerSpine] using hrun) + | letE uses value body => + exact lowerSpine_dynamic_consumesEntries hexpr hrest + (by simpa [lowerSpine] using hrun) + | proj index source => + exact lowerSpine_dynamic_consumesEntries hexpr hrest + (by simpa [lowerSpine] using hrun) + | lit literal => + exact lowerSpine_dynamic_consumesEntries hexpr hrest + (by simpa [lowerSpine] using hrun) + +theorem lowerBorrow_var_consumesEntries + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {varIndex : Nat} {state finalState : LowSt} + {emit : Emit} {av : AVal} {release : Bool} + (hrun : (lowerBorrow src (fuel + 1) input (.var varIndex)).run state = + .ok (output, emit, av, release) finalState) : + EntryConsumption input output + (fun index => countUses index (.var varIndex)) := by + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + have huuEq : (Owned.unique == Owned.unique) = true := by decide + intro index abs uses base htrack + by_cases heq : varIndex = index + · subst index + cases base with + | zero => + have hentry : input.entries[varIndex]? = + some (.slot abs 1 uses true) := by + simpa [EntryTracksAt, countUses] using htrack + cases uses with + | erased => + have hpure : + (input.setEntry varIndex (.slot abs 0 .erased false), + (_root_.id : Emit), AVal.slotA abs, true) = + (output, emit, av, release) ∧ state = finalState := by + simpa [lowerBorrow, hentry, worldOfUses, hsuEq] using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + apply EntryTracksAt.set_self_to abs 0 .erased + exact htrack + | linear => + exact (trackedThrowRun_not_ok (by + simpa [lowerBorrow, hentry, worldOfUses, huuEq] + using hrun)).elim + | affine => + exact (trackedThrowRun_not_ok (by + simpa [lowerBorrow, hentry, worldOfUses, huuEq] + using hrun)).elim + | many => + have hpure : + (input.setEntry varIndex (.slot abs 0 .many false), + (_root_.id : Emit), AVal.slotA abs, true) = + (output, emit, av, release) ∧ state = finalState := by + simpa [lowerBorrow, hentry, worldOfUses, hsuEq] using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + apply EntryTracksAt.set_self_to abs 0 .many + exact htrack + | succ base => + have hentry : input.entries[varIndex]? = + some (.slot abs (base + 2) uses true) := by + simpa [EntryTracksAt, countUses, Nat.add_assoc] using htrack + cases uses with + | erased => + have hpure : + (input.setEntry varIndex + (.slot abs (base + 1) .erased true), + (_root_.id : Emit), AVal.slotA abs, false) = + (output, emit, av, release) ∧ state = finalState := by + simpa [lowerBorrow, hentry, worldOfUses, hsuEq] using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + apply EntryTracksAt.set_self_to abs (base + 1) .erased + exact htrack + | linear => + exact (trackedThrowRun_not_ok (by + simpa [lowerBorrow, hentry, worldOfUses, huuEq] + using hrun)).elim + | affine => + exact (trackedThrowRun_not_ok (by + simpa [lowerBorrow, hentry, worldOfUses, huuEq] + using hrun)).elim + | many => + have hpure : + (input.setEntry varIndex + (.slot abs (base + 1) .many true), + (_root_.id : Emit), AVal.slotA abs, false) = + (output, emit, av, release) ∧ state = finalState := by + simpa [lowerBorrow, hentry, worldOfUses, hsuEq] using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + apply EntryTracksAt.set_self_to abs (base + 1) .many + exact htrack + · have hcount : countUses index (.var varIndex) = 0 := by + simp [countUses, heq] + have htrack' : EntryTracksAt input index abs uses base := by + simpa [hcount] using htrack + cases hentry : input.entries[varIndex]? with + | none => + exact (trackedThrowRun_not_ok (by + simpa [lowerBorrow, hentry] using hrun)).elim + | some entry => + cases entry with + | recSelf arity => + exact (trackedThrowRun_not_ok (by + simpa [lowerBorrow, hentry] using hrun)).elim + | slot variableAbs remaining variableUses held => + cases held with + | false => + exact (trackedThrowRun_not_ok (by + simpa [lowerBorrow, hentry] using hrun)).elim + | true => + cases variableUses with + | linear => + exact (trackedThrowRun_not_ok (by + simpa [lowerBorrow, hentry, worldOfUses, huuEq] + using hrun)).elim + | affine => + exact (trackedThrowRun_not_ok (by + simpa [lowerBorrow, hentry, worldOfUses, huuEq] + using hrun)).elim + | erased => + cases remaining with + | zero => + exact (trackedThrowRun_not_ok (by + simpa [lowerBorrow, hentry, worldOfUses, hsuEq] + using hrun)).elim + | succ remaining => + cases remaining with + | zero => + have hpure : + (input.setEntry varIndex + (.slot variableAbs 0 .erased false), + (_root_.id : Emit), AVal.slotA variableAbs, true) = + (output, emit, av, release) ∧ + state = finalState := by + simpa [lowerBorrow, hentry, worldOfUses, hsuEq] + using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact EntryTracksAt.set_ne heq htrack' + | succ remaining => + have hpure : + (input.setEntry varIndex + (.slot variableAbs (remaining + 1) .erased true), + (_root_.id : Emit), AVal.slotA variableAbs, false) = + (output, emit, av, release) ∧ + state = finalState := by + simpa [lowerBorrow, hentry, worldOfUses, hsuEq] + using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact EntryTracksAt.set_ne heq htrack' + | many => + cases remaining with + | zero => + exact (trackedThrowRun_not_ok (by + simpa [lowerBorrow, hentry, worldOfUses, hsuEq] + using hrun)).elim + | succ remaining => + cases remaining with + | zero => + have hpure : + (input.setEntry varIndex + (.slot variableAbs 0 .many false), + (_root_.id : Emit), AVal.slotA variableAbs, true) = + (output, emit, av, release) ∧ + state = finalState := by + simpa [lowerBorrow, hentry, worldOfUses, hsuEq] + using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact EntryTracksAt.set_ne heq htrack' + | succ remaining => + have hpure : + (input.setEntry varIndex + (.slot variableAbs (remaining + 1) .many true), + (_root_.id : Emit), AVal.slotA variableAbs, false) = + (output, emit, av, release) ∧ + state = finalState := by + simpa [lowerBorrow, hentry, worldOfUses, hsuEq] + using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + exact EntryTracksAt.set_ne heq htrack' + +theorem lowerBorrow_dynamic_consumesEntries + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEConsumesEntries src fuel) + {input output : VEnv} {expr : IxIR0.Expr} + {state finalState : LowSt} {emit : Emit} {av : AVal} + {release : Bool} + (hshape : DynamicBorrowHead expr) + (hrun : (lowerBorrow src (fuel + 1) input expr).run state = + .ok (output, emit, av, release) finalState) : + EntryConsumption input output (fun index => countUses index expr) := by + cases hshape <;> simp only [lowerBorrow] at hrun + all_goals + obtain ⟨exprResult, exprState, hexprRun, hpureRun⟩ := + trackedBindRun_ok_inv hrun + rcases exprResult with ⟨actualOutput, actualEmit, value⟩ + simp at hpureRun + have houtput : actualOutput = output := hpureRun.1.1 + subst output + exact hexpr hexprRun + +theorem lowerBorrowConsumesEntries_succ + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEConsumesEntries src fuel) : + LowerBorrowConsumesEntries src (fuel + 1) := by + intro input expr state finalState output emit av release hrun + cases expr with + | var index => exact lowerBorrow_var_consumesEntries hrun + | ref address => + exact lowerBorrow_dynamic_consumesEntries hexpr (.ref address) hrun + | app function argument => + exact lowerBorrow_dynamic_consumesEntries hexpr + (.app function argument) hrun + | lam uses body => + exact lowerBorrow_dynamic_consumesEntries hexpr (.lam uses body) hrun + | letE uses value body => + exact lowerBorrow_dynamic_consumesEntries hexpr + (.letE uses value body) hrun + | proj index source => + exact lowerBorrow_dynamic_consumesEntries hexpr + (.proj index source) hrun + | lit literal => + exact lowerBorrow_dynamic_consumesEntries hexpr (.lit literal) hrun + | erased => + exact lowerBorrow_dynamic_consumesEntries hexpr .erased hrun + +def captureUseCount (expr : IxIR0.Expr) (captures : List Nat) + (index : Nat) : Nat := + captures.count index * countUses index expr + +@[simp] theorem captureUseCount_nil (expr : IxIR0.Expr) : + captureUseCount expr [] = fun _ => 0 := by + funext index + simp [captureUseCount] + +theorem captureUseCount_cons (expr : IxIR0.Expr) (captured : Nat) + (rest : List Nat) : + captureUseCount expr (captured :: rest) = fun index => + (if captured = index then countUses index expr else 0) + + captureUseCount expr rest index := by + funext index + by_cases heq : captured = index + · subst index + simp [captureUseCount, Nat.add_mul, Nat.add_comm] + · have hne : index ≠ captured := Ne.symm heq + simp [captureUseCount, heq] + +theorem lowerCapture_consumesEntries + {expr : IxIR0.Expr} {input output : VEnv} {captured : Nat} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hrun : (lowerCapture expr input captured).run state = + .ok (output, emit, av) finalState) : + EntryConsumption input output + (fun index => if captured = index then countUses index expr else 0) := by + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + have huuEq : (Owned.unique == Owned.unique) = true := by decide + simp only [lowerCapture] at hrun + cases hentry : input.entries[captured]? with + | none => + rw [hentry] at hrun + exact (trackedThrowRun_not_ok hrun).elim + | some entry => + rw [hentry] at hrun + cases entry with + | recSelf arity => + exact (trackedThrowRun_not_ok hrun).elim + | slot capturedAbs remaining capturedUses held => + cases held with + | false => + exact (trackedThrowRun_not_ok hrun).elim + | true => + cases capturedUses with + | linear => + exact (trackedThrowRun_not_ok (by + simpa [worldOfUses, huuEq] using hrun)).elim + | affine => + exact (trackedThrowRun_not_ok (by + simpa [worldOfUses, huuEq] using hrun)).elim + | erased => + by_cases hmore : remaining > countUses captured expr + · have hpure : + let changed := input.setEntry captured + (.slot capturedAbs + (remaining - countUses captured expr) .erased true) + (changed.bump, + emitOp (.dup (.var (changed.rel capturedAbs))), + AVal.slotA changed.depth) = (output, emit, av) ∧ + state = finalState := by + simpa [worldOfUses, hsuEq, hmore] using hrun + dsimp only at hpure + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + intro index abs uses base htrack + by_cases heq : captured = index + · subst index + obtain ⟨rfl, hremaining, rfl, _⟩ := + htrack.slot_inj hentry + simp at hremaining + have hbase : 0 < base := by omega + have hbne : (base != 0) = true := by + simp [Nat.ne_of_gt hbase] + have hcanonical := EntryTracksAt.set_self_to capturedAbs + base .erased htrack + apply EntryTracksAt.bump + simpa [hremaining, Nat.add_sub_cancel_right, + Nat.ne_of_gt hbase, hbne] using hcanonical + · have hzero : + (if captured = index then countUses index expr else 0) = + 0 := by simp [heq] + have htrack' : + EntryTracksAt input index abs uses base := by + simpa [hzero] using htrack + exact (EntryTracksAt.set_ne heq htrack').bump + · by_cases hequal : remaining = countUses captured expr + · have hpure : + (input.setEntry captured + (.slot capturedAbs 0 .erased false), + (_root_.id : Emit), AVal.slotA capturedAbs) = + (output, emit, av) ∧ state = finalState := by + simpa [worldOfUses, hsuEq, hmore, hequal] using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + intro index abs uses base htrack + by_cases heq : captured = index + · subst index + obtain ⟨rfl, hremaining, rfl, _⟩ := + htrack.slot_inj hentry + simp at hremaining + have hbase : base = 0 := by omega + subst base + apply EntryTracksAt.set_self_to capturedAbs 0 .erased + exact htrack + · have hzero : + (if captured = index then countUses index expr else 0) = + 0 := by simp [heq] + have htrack' : + EntryTracksAt input index abs uses base := by + simpa [hzero] using htrack + exact EntryTracksAt.set_ne heq htrack' + · exact (trackedThrowRun_not_ok (by + simpa [worldOfUses, hsuEq, hmore, hequal] + using hrun)).elim + | many => + by_cases hmore : remaining > countUses captured expr + · have hpure : + let changed := input.setEntry captured + (.slot capturedAbs + (remaining - countUses captured expr) .many true) + (changed.bump, + emitOp (.dup (.var (changed.rel capturedAbs))), + AVal.slotA changed.depth) = (output, emit, av) ∧ + state = finalState := by + simpa [worldOfUses, hsuEq, hmore] using hrun + dsimp only at hpure + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + intro index abs uses base htrack + by_cases heq : captured = index + · subst index + obtain ⟨rfl, hremaining, rfl, _⟩ := + htrack.slot_inj hentry + simp at hremaining + have hbase : 0 < base := by omega + have hbne : (base != 0) = true := by + simp [Nat.ne_of_gt hbase] + have hcanonical := EntryTracksAt.set_self_to capturedAbs + base .many htrack + apply EntryTracksAt.bump + simpa [hremaining, Nat.add_sub_cancel_right, + Nat.ne_of_gt hbase, hbne] using hcanonical + · have hzero : + (if captured = index then countUses index expr else 0) = + 0 := by simp [heq] + have htrack' : + EntryTracksAt input index abs uses base := by + simpa [hzero] using htrack + exact (EntryTracksAt.set_ne heq htrack').bump + · by_cases hequal : remaining = countUses captured expr + · have hpure : + (input.setEntry captured + (.slot capturedAbs 0 .many false), + (_root_.id : Emit), AVal.slotA capturedAbs) = + (output, emit, av) ∧ state = finalState := by + simpa [worldOfUses, hsuEq, hmore, hequal] using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + intro index abs uses base htrack + by_cases heq : captured = index + · subst index + obtain ⟨rfl, hremaining, rfl, _⟩ := + htrack.slot_inj hentry + simp at hremaining + have hbase : base = 0 := by omega + subst base + apply EntryTracksAt.set_self_to capturedAbs 0 .many + exact htrack + · have hzero : + (if captured = index then countUses index expr else 0) = + 0 := by simp [heq] + have htrack' : + EntryTracksAt input index abs uses base := by + simpa [hzero] using htrack + exact EntryTracksAt.set_ne heq htrack' + · exact (trackedThrowRun_not_ok (by + simpa [worldOfUses, hsuEq, hmore, hequal] + using hrun)).elim + +theorem lowerCaptures_consumesEntries (expr : IxIR0.Expr) : + ∀ {captures : List Nat} {input output : VEnv} + {state finalState : LowSt} {emit : Emit} {values : List AVal}, + (lowerCaptures expr input captures).run state = + .ok (output, emit, values) finalState → + EntryConsumption input output (captureUseCount expr captures) := by + intro captures input output state finalState emit values hrun + apply lowerCaptures_run_core + (Result := fun input output captures _ _ => + EntryConsumption input output (captureUseCount expr captures)) + (e := expr) (hrun := hrun) + · intro input + rw [captureUseCount_nil] + exact EntryConsumption.zero input + · intro captured rest input middle output headEmit tailEmit headValue + tailValues state middleState hheadRun htail + have hcomposed := + (lowerCapture_consumesEntries hheadRun).comp htail + rw [captureUseCount_cons] + exact hcomposed + +theorem captureUseCount_selected_at (expr : IxIR0.Expr) (length index : Nat) + (hindex : index < length) : + captureUseCount expr + ((List.range length).filter (fun i => countUses i expr > 0)) + index = + countUses index expr := by + by_cases hzero : countUses index expr = 0 + · simp [captureUseCount, hzero] + · have hpositive : (countUses index expr > 0 : Bool) = true := by + simp + omega + have hcount : + List.count index + ((List.range length).filter + (fun i => countUses i expr > 0)) = + List.count index (List.range length) := + List.count_filter (p := fun i => countUses i expr > 0) + (a := index) (l := List.range length) hpositive + rw [captureUseCount, hcount, List.count_range] + simp [hindex] + +theorem lowerCaptures_selected_consumesEntries + {expr : IxIR0.Expr} {input output : VEnv} + {state finalState : LowSt} {emit : Emit} {values : List AVal} + (hrun : (lowerCaptures expr input + ((List.range input.entries.length).filter + (fun i => countUses i expr > 0))).run state = + .ok (output, emit, values) finalState) : + EntryConsumption input output (fun index => countUses index expr) := by + have hcaptures := lowerCaptures_consumesEntries expr hrun + intro index abs uses base htrack + have hcount := captureUseCount_selected_at expr input.entries.length + index htrack.index_lt + exact hcaptures index abs uses base (by simpa [hcount] using htrack) + +theorem lowerLamConsumesEntries_succ + {src : IxIR0.Env} {fuel : Nat} : + LowerLamConsumesEntries src (fuel + 1) := by + intro input expr state finalState output emit av hrun + apply lowerLam_run_core + (Result := fun _ output _ _ => + EntryConsumption input output (fun index => countUses index expr)) + (hrun := hrun) + intro _bodyFuel captureOutput captureEmit captureValues captureState + _fnAddr _addressState _code _bodyState _hfuel _hp hcaptureRun _hfreshRun + _hbodyRun + have hselected : + (lowerCaptures expr input + ((List.range input.entries.length).filter + (fun index => countUses index expr > 0))).run state = + .ok (captureOutput, captureEmit, captureValues) captureState := by + simpa [liftCaptureIndices] using hcaptureRun + exact (lowerCaptures_selected_consumesEntries hselected).bump + +theorem lowerE_let_consumesEntries + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEConsumesEntries src fuel) + {input output : VEnv} {world : Owned} {binderUses : Uses} + {value body : IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hrun : (lowerE src (fuel + 1) input world + (.letE binderUses value body)).run state = + .ok (output, emit, av) finalState) : + EntryConsumption input output + (fun index => countUses index (.letE binderUses value body)) := by + simp only [lowerE] at hrun + obtain ⟨valueResult, valueState, hvalueRun, hafterValue⟩ := + trackedBindRun_ok_inv hrun + rcases valueResult with ⟨middle, valueEmit, boundValue⟩ + have hvalueConsume := hexpr hvalueRun + cases boundValue with + | slotA boundAbs => + by_cases hzero : countUses 0 body = 0 + · cases binderUses with + | erased => + obtain ⟨_, _, hthrow, _⟩ := trackedBindRun_ok_inv + (by simpa [hzero] using hafterValue) + exact (trackedThrowRun_not_ok hthrow).elim + | linear => + obtain ⟨_, _, hthrow, _⟩ := trackedBindRun_ok_inv + (by simpa [hzero] using hafterValue) + exact (trackedThrowRun_not_ok hthrow).elim + | affine => + let heldInput := + installAliasBinder middle boundAbs 0 Uses.affine true + let bodyInput := + (heldInput.setEntry 0 (.slot boundAbs 0 .affine false)).bump + have hcontinue : + ((lowerE src fuel bodyInput world body) >>= fun result => + let (bodyOutput, bodyEmit, resultValue) := result + pure (bodyOutput.pop, + valueEmit ∘ emitOp (.dropU (.var (middle.rel boundAbs))) ∘ + bodyEmit, + resultValue)).run valueState = + .ok (output, emit, av) finalState := by + simpa [hzero, heldInput, bodyInput, installAliasBinder, + VEnv.setEntry, VEnv.bump] using hafterValue + obtain ⟨bodyResult, bodyState, hbodyRun, hpureRun⟩ := + trackedBindRun_ok_inv hcontinue + rcases bodyResult with ⟨bodyOutput, bodyEmit, resultValue⟩ + have hpure : + (bodyOutput.pop, + valueEmit ∘ emitOp (.dropU (.var (middle.rel boundAbs))) ∘ + bodyEmit, + resultValue) = (output, emit, av) ∧ + bodyState = finalState := by + simpa using hpureRun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + have hentries : bodyInput.entries = + (.slot boundAbs 0 .affine false) :: middle.entries := by + simp [bodyInput, heldInput, installAliasBinder, VEnv.setEntry, + VEnv.bump] + simpa [countUses] using hvalueConsume.bind_under_binder + (hexpr hbodyRun) hentries + | many => + let heldInput := + installAliasBinder middle boundAbs 0 Uses.many true + let bodyInput := + (heldInput.setEntry 0 (.slot boundAbs 0 .many false)).bump + have hcontinue : + ((lowerE src fuel bodyInput world body) >>= fun result => + let (bodyOutput, bodyEmit, resultValue) := result + pure (bodyOutput.pop, + valueEmit ∘ emitOp (.drop (.var (middle.rel boundAbs))) ∘ + bodyEmit, + resultValue)).run valueState = + .ok (output, emit, av) finalState := by + simpa [hzero, heldInput, bodyInput, installAliasBinder, + VEnv.setEntry, VEnv.bump] using hafterValue + obtain ⟨bodyResult, bodyState, hbodyRun, hpureRun⟩ := + trackedBindRun_ok_inv hcontinue + rcases bodyResult with ⟨bodyOutput, bodyEmit, resultValue⟩ + have hpure : + (bodyOutput.pop, + valueEmit ∘ emitOp (.drop (.var (middle.rel boundAbs))) ∘ + bodyEmit, + resultValue) = (output, emit, av) ∧ + bodyState = finalState := by + simpa using hpureRun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + have hentries : bodyInput.entries = + (.slot boundAbs 0 .many false) :: middle.entries := by + simp [bodyInput, heldInput, installAliasBinder, VEnv.setEntry, + VEnv.bump] + simpa [countUses] using hvalueConsume.bind_under_binder + (hexpr hbodyRun) hentries + · let bodyInput := installAliasBinder middle boundAbs + (countUses 0 body) binderUses true + have hcontinue : + ((lowerE src fuel bodyInput world body) >>= fun result => + let (bodyOutput, bodyEmit, resultValue) := result + pure (bodyOutput.pop, valueEmit ∘ bodyEmit, resultValue)).run + valueState = .ok (output, emit, av) finalState := by + simpa [hzero, bodyInput, installAliasBinder] using hafterValue + obtain ⟨bodyResult, bodyState, hbodyRun, hpureRun⟩ := + trackedBindRun_ok_inv hcontinue + rcases bodyResult with ⟨bodyOutput, bodyEmit, resultValue⟩ + have hpure : + (bodyOutput.pop, valueEmit ∘ bodyEmit, resultValue) = + (output, emit, av) ∧ bodyState = finalState := by + simpa using hpureRun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + have hentries : bodyInput.entries = + (.slot boundAbs (countUses 0 body) binderUses true) :: + middle.entries := by + simp [bodyInput, installAliasBinder] + simpa [countUses] using hvalueConsume.bind_under_binder + (hexpr hbodyRun) hentries + | constA atom => + by_cases hzero : countUses 0 body = 0 + · let bodyInput := installPushedBinder middle 0 binderUses false + have hcontinue : + ((lowerE src fuel bodyInput world body) >>= fun result => + let (bodyOutput, bodyEmit, resultValue) := result + pure (bodyOutput.pop, + valueEmit ∘ emitOp (.pure atom) ∘ bodyEmit, + resultValue)).run valueState = + .ok (output, emit, av) finalState := by + simpa [hzero, bodyInput, installPushedBinder] using hafterValue + obtain ⟨bodyResult, bodyState, hbodyRun, hpureRun⟩ := + trackedBindRun_ok_inv hcontinue + rcases bodyResult with ⟨bodyOutput, bodyEmit, resultValue⟩ + have hpure : + (bodyOutput.pop, + valueEmit ∘ emitOp (.pure atom) ∘ bodyEmit, + resultValue) = (output, emit, av) ∧ + bodyState = finalState := by + simpa using hpureRun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + have hentries : bodyInput.entries = + (.slot middle.depth 0 binderUses false) :: middle.entries := by + simp [bodyInput, installPushedBinder] + simpa [countUses] using hvalueConsume.bind_under_binder + (hexpr hbodyRun) hentries + · let bodyInput := installPushedBinder middle (countUses 0 body) + binderUses true + have hcontinue : + ((lowerE src fuel bodyInput world body) >>= fun result => + let (bodyOutput, bodyEmit, resultValue) := result + pure (bodyOutput.pop, + valueEmit ∘ emitOp (.pure atom) ∘ bodyEmit, + resultValue)).run valueState = + .ok (output, emit, av) finalState := by + simpa [hzero, bodyInput, installPushedBinder] using hafterValue + obtain ⟨bodyResult, bodyState, hbodyRun, hpureRun⟩ := + trackedBindRun_ok_inv hcontinue + rcases bodyResult with ⟨bodyOutput, bodyEmit, resultValue⟩ + have hpure : + (bodyOutput.pop, + valueEmit ∘ emitOp (.pure atom) ∘ bodyEmit, + resultValue) = (output, emit, av) ∧ + bodyState = finalState := by + simpa using hpureRun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + have hentries : bodyInput.entries = + (.slot middle.depth (countUses 0 body) binderUses true) :: + middle.entries := by + simp [bodyInput, installPushedBinder] + simpa [countUses] using hvalueConsume.bind_under_binder + (hexpr hbodyRun) hentries + +theorem lowerE_proj_consumesEntries + {src : IxIR0.Env} {fuel : Nat} + (hborrow : LowerBorrowConsumesEntries src fuel) + {input output : VEnv} {world : Owned} {fieldIndex : Nat} + {source : IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hrun : (lowerE src (fuel + 1) input world + (.proj fieldIndex source)).run state = + .ok (output, emit, av) finalState) : + EntryConsumption input output + (fun index => countUses index (.proj fieldIndex source)) := by + cases world with + | unique => + have huuEq : (Owned.unique == Owned.unique) = true := by decide + simp [lowerE, huuEq] at hrun + | shared => + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + simp only [lowerE, hsuEq, Bool.false_eq_true, if_false] at hrun + obtain ⟨borrowResult, middleState, hborrowRun, hafterBorrow⟩ := + trackedBindRun_ok_inv hrun + rcases borrowResult with + ⟨borrowOutput, borrowEmit, borrowed, release⟩ + have hconsume := hborrow hborrowRun + cases borrowed with + | constA atom => + cases atom with + | var relative => + have hpure : + (borrowOutput.bump, + borrowEmit ∘ emitOp (.fetch (.var relative) fieldIndex), + AVal.slotA borrowOutput.depth) = (output, emit, av) ∧ + middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + simpa [countUses] using hconsume.bump + | lit literal => + have hpure : + (borrowOutput.bump, + borrowEmit ∘ emitOp (.fetch (.lit literal) fieldIndex), + AVal.slotA borrowOutput.depth) = (output, emit, av) ∧ + middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + simpa [countUses] using hconsume.bump + | erased => + have hpure : + (borrowOutput, borrowEmit, AVal.constA .erased) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + simpa [countUses] using hconsume + | slotA targetAbs => + cases release with + | false => + have hpure : + (borrowOutput.bump.bump, + borrowEmit ∘ + emitOp (.fetch (.var (borrowOutput.rel targetAbs)) + fieldIndex) ∘ + emitOp (.dup + (.var (borrowOutput.bump.rel borrowOutput.depth))), + AVal.slotA borrowOutput.bump.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + simpa [countUses] using hconsume.bump.bump + | true => + have hpure : + (borrowOutput.bump.bump.bump, + borrowEmit ∘ + emitOp (.fetch (.var (borrowOutput.rel targetAbs)) + fieldIndex) ∘ + emitOp (.dup + (.var (borrowOutput.bump.rel borrowOutput.depth))) ∘ + emitOp (.drop + (.var (borrowOutput.bump.bump.rel targetAbs))), + AVal.slotA borrowOutput.bump.depth) = + (output, emit, av) ∧ middleState = finalState := by + simpa using hafterBorrow + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + simpa [countUses] using hconsume.bump.bump.bump + +theorem lowerE_lit_consumesEntries + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {world : Owned} {literal : IxIR0.Literal} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hrun : (lowerE src (fuel + 1) input world (.lit literal)).run state = + .ok (output, emit, av) finalState) : + EntryConsumption input output + (fun index => countUses index (.lit literal)) := by + have hpure : + (input, (_root_.id : Emit), AVal.constA (.lit literal)) = + (output, emit, av) ∧ state = finalState := by + simpa [lowerE] using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + simpa [countUses] using EntryConsumption.zero input + +theorem lowerE_erased_consumesEntries + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {world : Owned} {state finalState : LowSt} {emit : Emit} {av : AVal} + (hrun : (lowerE src (fuel + 1) input world .erased).run state = + .ok (output, emit, av) finalState) : + EntryConsumption input output (fun index => countUses index .erased) := by + have hpure : + (input, (_root_.id : Emit), AVal.constA .erased) = + (output, emit, av) ∧ state = finalState := by + simpa [lowerE] using hrun + obtain ⟨hvalue, hstate⟩ := hpure + cases hvalue + subst finalState + simpa [countUses] using EntryConsumption.zero input + +theorem lowerE_ref_entries_eq + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {world : Owned} {address : Ixon.Address} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hrun : (lowerE src (fuel + 1) input world (.ref address)).run state = + .ok (output, emit, av) finalState) : + output.entries = input.entries := by + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + cases hsource : src address with + | none => + exact (trackedThrowRun_not_ok (by + simpa [lowerE, hsource] using hrun)).elim + | some decl => + cases decl with + | defn result body => + cases harity : lamArity body with + | zero => + have hrun' := hrun + simp only [lowerE, hsource, harity] at hrun' + obtain ⟨unitValue, checkedState, _, hpureRun⟩ := + trackedBindRun_ok_inv hrun' + cases unitValue + simp at hpureRun + rw [← hpureRun.1.1] + rfl + | succ arity => + cases world with + | unique => + exact (trackedThrowRun_not_ok (by + simpa [lowerE, hsource, harity, huuEq] using hrun)).elim + | shared => + cases result with + | unique => + exact (trackedThrowRun_not_ok (by + simpa [lowerE, hsource, harity, hsuEq, huuEq] + using hrun)).elim + | shared => + cases hp : papSafe body with + | false => + exact (trackedThrowRun_not_ok (by + simpa [lowerE, hsource, harity, hsuEq, hp] + using hrun)).elim + | true => + have hpure := hrun + simp [lowerE, hsource, harity, hsuEq, hp] at hpure + rw [← hpure.1.1] + rfl + | ctor tag arity => + cases arity with + | zero => + have hpure := hrun + simp [lowerE, hsource] at hpure + rw [← hpure.1.1] + rfl + | succ arity => + cases world with + | unique => + exact (trackedThrowRun_not_ok (by + simpa [lowerE, hsource, huuEq] using hrun)).elim + | shared => + have hrun' := hrun + simp only [lowerE, hsource, hsuEq, Bool.false_eq_true, + if_false] at hrun' + obtain ⟨wrapper, wrapperState, _, hpureRun⟩ := + trackedBindRun_ok_inv hrun' + simp at hpureRun + rw [← hpureRun.1.1] + rfl + | recursor numArgs natLit rules => + cases world with + | unique => + exact (trackedThrowRun_not_ok (by + simpa [lowerE, hsource, huuEq] using hrun)).elim + | shared => + have hpure := hrun + simp [lowerE, hsource, hsuEq] at hpure + rw [← hpure.1.1] + rfl + | extern arity => + cases arity with + | zero => + have hpure := hrun + simp [lowerE, hsource] at hpure + rw [← hpure.1.1] + rfl + | succ arity => + cases world with + | unique => + exact (trackedThrowRun_not_ok (by + simpa [lowerE, hsource, huuEq] using hrun)).elim + | shared => + have hpure := hrun + simp [lowerE, hsource, hsuEq] at hpure + rw [← hpure.1.1] + rfl + +theorem lowerE_ref_consumesEntries + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {world : Owned} {address : Ixon.Address} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hrun : (lowerE src (fuel + 1) input world (.ref address)).run state = + .ok (output, emit, av) finalState) : + EntryConsumption input output + (fun index => countUses index (.ref address)) := by + have hzero := EntryConsumption.of_entries_eq (lowerE_ref_entries_eq hrun) + simpa [countUses] using hzero + +theorem lowerEConsumesEntries_succ + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEConsumesEntries src fuel) + (hborrow : LowerBorrowConsumesEntries src fuel) + (hspine : LowerSpineConsumesEntries src fuel) + (hlam : LowerLamConsumesEntries src fuel) : + LowerEConsumesEntries src (fuel + 1) := by + intro input world expr state finalState output emit av hrun + cases expr with + | var index => exact lowerE_var_consumesEntries hrun + | ref address => exact lowerE_ref_consumesEntries hrun + | app function argument => + have hspineRun : + (lowerSpine src fuel input world function [argument]).run state = + .ok (output, emit, av) finalState := by + simpa [lowerE] using hrun + simpa [countUses, countUsesExprs] using hspine hspineRun + | lam uses body => + cases world with + | unique => + have huuEq : (Owned.unique == Owned.unique) = true := by decide + have hthrow : + (throw + "function values live in the shared world (one-shot closures deferred)" : + LowerM (VEnv × Emit × AVal)).run state = + .ok (output, emit, av) finalState := by + simpa [lowerE, huuEq] using hrun + exact (trackedThrowRun_not_ok hthrow).elim + | shared => + have hsuEq : (Owned.shared == Owned.unique) = false := by decide + have hlamRun : + (lowerLam src fuel input (.lam uses body)).run state = + .ok (output, emit, av) finalState := by + simpa [lowerE, hsuEq] using hrun + exact hlam hlamRun + | letE uses value body => + exact lowerE_let_consumesEntries hexpr hrun + | proj index source => + exact lowerE_proj_consumesEntries hborrow hrun + | lit literal => exact lowerE_lit_consumesEntries hrun + | erased => exact lowerE_erased_consumesEntries hrun + +theorem lowerConsumesEntries_succ + {src : IxIR0.Env} {fuel : Nat} + (hprev : LowerConsumesEntries src fuel) : + LowerConsumesEntries src (fuel + 1) where + expr := lowerEConsumesEntries_succ + hprev.expr hprev.borrow hprev.spine hprev.lam + borrow := lowerBorrowConsumesEntries_succ hprev.expr + spine := lowerSpineConsumesEntries_succ + hprev.expr hprev.spine hprev.knownCall hprev.applyRest + knownCall := knownCallConsumesEntries_succ hprev.args hprev.applyRest + args := lowerArgsConsumesEntries_succ hprev.expr hprev.args + applyRest := applyRestConsumesEntries_succ hprev.args + lam := lowerLamConsumesEntries_succ + +/-- Every successful lowering-cluster run consumes exactly the syntactic +occurrence count of each tracked source entry. -/ +theorem lowerConsumesEntries (src : IxIR0.Env) : + ∀ fuel, LowerConsumesEntries src fuel + | 0 => lowerConsumesEntries_zero src + | fuel + 1 => lowerConsumesEntries_succ (lowerConsumesEntries src fuel) + +theorem lowerE_consumesEntries + {src : IxIR0.Env} {fuel : Nat} {input output : VEnv} + {world : Owned} {expr : IxIR0.Expr} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hrun : (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState) : + EntryConsumption input output (fun index => countUses index expr) := + (lowerConsumesEntries src fuel).expr hrun + +/-- The counted first entry installed for a let body is always released by +every successful lowering run. -/ +theorem lowerE_releasesTrackedFirst + (src : IxIR0.Env) (fuel : Nat) (expr : IxIR0.Expr) : + LowerEReleasesTrackedFirst src fuel expr := + LowerEConsumesEntries.releasesTrackedFirst + (lowerConsumesEntries src fuel).expr expr + +/-! ## Reachable semantic fuel induction -/ + +/-- A lowering action cannot produce a successful result. This small +state-independent predicate packages the two administrative base cases of +the semantic fuel induction. -/ +def LowerNoSuccess {α : Type} (action : LowerM α) : Prop := + ∀ {initial final result}, + action.run initial = .ok result final → False + +theorem LowerNoSuccess.throw {α : Type} (message : String) : + LowerNoSuccess (throw message : LowerM α) := by + intro initial final result hrun + exact trackedThrowRun_not_ok hrun + +theorem LowerNoSuccess.bindLeft {α β : Type} + {action : LowerM α} {next : α → LowerM β} + (haction : LowerNoSuccess action) : + LowerNoSuccess (action >>= next) := by + intro initial final result hrun + obtain ⟨value, middle, hfirst, _⟩ := trackedBindRun_ok_inv hrun + exact haction hfirst + +theorem LowerNoSuccess.bindRight {α β : Type} + {action : LowerM α} {next : α → LowerM β} + (hnext : ∀ value, LowerNoSuccess (next value)) : + LowerNoSuccess (action >>= next) := by + intro initial final result hrun + obtain ⟨value, middle, _, hsecond⟩ := trackedBindRun_ok_inv hrun + exact hnext value hsecond + +theorem lowerE_noSuccess_zero (src : IxIR0.Env) (input : VEnv) + (world : Owned) (expr : IxIR0.Expr) : + LowerNoSuccess (lowerE src 0 input world expr) := by + simp only [lowerE] + exact LowerNoSuccess.throw _ + +theorem lowerBorrow_noSuccess_zero (src : IxIR0.Env) (input : VEnv) + (expr : IxIR0.Expr) : + LowerNoSuccess (lowerBorrow src 0 input expr) := by + simp only [lowerBorrow] + exact LowerNoSuccess.throw _ + +theorem lowerSpine_noSuccess_zero (src : IxIR0.Env) (input : VEnv) + (world : Owned) (head : IxIR0.Expr) (args : List IxIR0.Expr) : + LowerNoSuccess (lowerSpine src 0 input world head args) := by + simp only [lowerSpine] + exact LowerNoSuccess.throw _ + +theorem knownCall_noSuccess_zero (src : IxIR0.Env) (input : VEnv) + (build : Array Atom → Op) (count : Nat) (argWorlds : List Owned) + (resultWorld : Owned) (args : List IxIR0.Expr) : + LowerNoSuccess + (knownCall src 0 input build count argWorlds resultWorld args) := by + simp only [knownCall] + exact LowerNoSuccess.throw _ + +theorem applyRest_noSuccess_zero (src : IxIR0.Env) (input : VEnv) + (resultWorld : Owned) (pre : Emit) (function : AVal) + (args : List IxIR0.Expr) : + LowerNoSuccess + (applyRest src 0 input resultWorld pre function args) := by + simp only [applyRest] + exact LowerNoSuccess.throw _ + +/-- `lowerSpine` has one extra administrative layer over the other mutual +actions. At fuel one every branch reaches a zero-fuel action before it can +return, including the stateful constructor-wrapper branch. -/ +theorem lowerSpine_noSuccess_one (src : IxIR0.Env) (input : VEnv) + (world : Owned) (head : IxIR0.Expr) (args : List IxIR0.Expr) : + LowerNoSuccess (lowerSpine src 1 input world head args) := by + cases head with + | app function argument => + simp only [lowerSpine] + exact LowerNoSuccess.throw _ + | erased => + simp only [lowerSpine] + exact applyRest_noSuccess_zero src input world id (.constA .erased) args + | var index => + simp only [lowerSpine] + cases hentry : input.entries[index]? with + | none => + simp only + exact LowerNoSuccess.bindLeft + (lowerE_noSuccess_zero src input .shared (.var index)) + | some entry => + cases entry with + | recSelf arity => + simp only + by_cases hunder : args.length < arity + · rw [if_pos hunder] + exact LowerNoSuccess.throw _ + · rw [if_neg hunder] + exact LowerNoSuccess.bindRight (fun _ => + knownCall_noSuccess_zero src input (.callSelf ·) arity + (List.replicate arity .shared) world args) + | slot abs remaining uses held => + simp only + exact LowerNoSuccess.bindLeft + (lowerE_noSuccess_zero src input .shared (.var index)) + | ref address => + simp only [lowerSpine] + cases hsrc : src address with + | none => + simp only + exact LowerNoSuccess.throw _ + | some decl => + cases decl with + | defn result body => + simp only + by_cases hunder : args.length < lamArity body + · rw [if_pos hunder] + by_cases hworld : world == .unique + · rw [if_pos hworld] + exact LowerNoSuccess.throw _ + · rw [if_neg hworld] + by_cases hresult : result == .unique + · rw [if_pos hresult] + exact LowerNoSuccess.throw _ + · rw [if_neg hresult] + by_cases hpap : !papSafe body + · rw [if_pos hpap] + exact LowerNoSuccess.throw _ + · rw [if_neg hpap] + exact knownCall_noSuccess_zero src input (.papp address ·) + args.length (List.replicate args.length .shared) world args + · rw [if_neg hunder] + exact LowerNoSuccess.bindRight (fun _ => + knownCall_noSuccess_zero src input (.call address ·) + (lamArity body) ((lamUses body).map worldOfUses) world args) + | ctor tag arity => + simp only + by_cases hunder : args.length < arity + · rw [if_pos hunder] + by_cases hworld : world == .unique + · rw [if_pos hworld] + exact LowerNoSuccess.throw _ + · rw [if_neg hworld] + exact LowerNoSuccess.bindRight (fun wrapper => + knownCall_noSuccess_zero src input (.papp wrapper ·) + args.length (List.replicate args.length .shared) world args) + · rw [if_neg hunder] + exact knownCall_noSuccess_zero src input + (.alloc world (ctorIdOf address tag) ·) arity + (List.replicate arity world) world args + | recursor numArgs natLit rules => + simp only + by_cases hunder : args.length < numArgs + 1 + · rw [if_pos hunder] + by_cases hworld : world == .unique + · rw [if_pos hworld] + exact LowerNoSuccess.throw _ + · rw [if_neg hworld] + exact knownCall_noSuccess_zero src input (.papp address ·) + args.length (List.replicate args.length .shared) world args + · rw [if_neg hunder] + exact LowerNoSuccess.bindRight (fun _ => + knownCall_noSuccess_zero src input (.call address ·) + (numArgs + 1) (List.replicate (numArgs + 1) .shared) + world args) + | extern arity => + simp only + by_cases hunder : args.length < arity + · rw [if_pos hunder] + by_cases hworld : world == .unique + · rw [if_pos hworld] + exact LowerNoSuccess.throw _ + · rw [if_neg hworld] + exact knownCall_noSuccess_zero src input (.papp address ·) + args.length (List.replicate args.length .shared) world args + · rw [if_neg hunder] + exact knownCall_noSuccess_zero src input (.extern address ·) + arity (List.replicate arity .shared) world args + | lam uses body => + simp only [lowerSpine] + exact LowerNoSuccess.bindLeft + (lowerE_noSuccess_zero src input .shared (.lam uses body)) + | letE uses value body => + simp only [lowerSpine] + exact LowerNoSuccess.bindLeft + (lowerE_noSuccess_zero src input .shared (.letE uses value body)) + | proj index source => + simp only [lowerSpine] + exact LowerNoSuccess.bindLeft + (lowerE_noSuccess_zero src input .shared (.proj index source)) + | lit literal => + simp only [lowerSpine] + exact LowerNoSuccess.bindLeft + (lowerE_noSuccess_zero src input .shared (.lit literal)) + +theorem lowerEPreservesBelow_zero + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} : + LowerEPreservesBelow ctx cur limit src 0 := by + intro input world expr state finalState output emit av hrun hrepresented _ + exact (lowerE_noSuccess_zero src input world expr hrun).elim + +theorem lowerBorrowPreservesBelow_zero + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} : + LowerBorrowPreservesBelow ctx cur limit src 0 := by + intro input expr state finalState output emit av release hrun hrepresented _ + exact (lowerBorrow_noSuccess_zero src input expr hrun).elim + +theorem lowerSpinePreservesBelow_zero + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} : + LowerSpinePreservesBelow ctx cur limit src 0 := by + intro input world head args state finalState output emit av hrun hrepresented _ + exact (lowerSpine_noSuccess_zero src input world head args hrun).elim + +theorem lowerSpinePreservesBelow_one + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} : + LowerSpinePreservesBelow ctx cur limit src 1 := by + intro input world head args state finalState output emit av hrun hrepresented _ + exact (lowerSpine_noSuccess_one src input world head args hrun).elim + +theorem lowerArgs_noSuccess_zero (src : IxIR0.Env) (input : VEnv) + (args : List (IxIR0.Expr × Owned)) : + LowerNoSuccess (lowerArgs src 0 input args) := by + simp only [lowerArgs] + exact LowerNoSuccess.throw _ + +theorem lowerArgsPreservesBelow_zero + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} : + LowerArgsPreservesBelow ctx cur limit src 0 := by + intro input args state finalState output emit avs hrun hrepresented _ + exact (lowerArgs_noSuccess_zero src input args hrun).elim + +theorem applyRestPreservesBelow_zero + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} : + ApplyRestPreservesBelow ctx cur limit src 0 := by + intro start input resultWorld pre function args state finalState output emit + av hfunction hrun hrepresented _ + exact (applyRest_noSuccess_zero src input resultWorld pre function args + hrun).elim + +/-- Shared compiler-fuel recursion for reachable semantic and progress +clusters. The cluster fields and their one-step constructors are predicate +parameters, so the zero case, the special spine-at-one case, and the +two-predecessor successor case are assembled once without identifying any +public interface or proof flavor. -/ +theorem lowerValueClusterWithin_core + {Expr Borrow Spine Args ApplyRest Cluster : Nat → Prop} + (hzero : Cluster 0) + (hclusterExpr : ∀ {fuel}, Cluster fuel → Expr fuel) + (hclusterBorrow : ∀ {fuel}, Cluster fuel → Borrow fuel) + (hclusterSpine : ∀ {fuel}, Cluster fuel → Spine fuel) + (hclusterArgs : ∀ {fuel}, Cluster fuel → Args fuel) + (hclusterApplyRest : ∀ {fuel}, Cluster fuel → ApplyRest fuel) + (hmake : ∀ {fuel}, Expr fuel → Borrow fuel → Spine fuel → + Args fuel → ApplyRest fuel → Cluster fuel) + (hargsSucc : ∀ {fuel}, Expr fuel → Args fuel → Args (fuel + 1)) + (happlyRestSucc : ∀ {fuel}, Args fuel → ApplyRest (fuel + 1)) + (hborrowSucc : ∀ {fuel}, Expr fuel → Borrow (fuel + 1)) + (hspineOne : Spine 1) + (hspineSucc : ∀ {fuel}, + Spine (fuel + 1) → Expr (fuel + 1) → Args fuel → + ApplyRest fuel → ApplyRest (fuel + 1) → Spine (fuel + 2)) + (hexprSucc : ∀ {fuel}, + Expr fuel → Spine fuel → Borrow fuel → Args (fuel + 1) → + ApplyRest (fuel + 1) → Expr (fuel + 1)) : + ∀ fuel, Cluster fuel := by + intro fuel + induction fuel using Nat.strongRecOn with + | ind fuel ih => + cases fuel with + | zero => exact hzero + | succ previous => + have hprev : Cluster previous := + ih previous (Nat.lt_succ_self previous) + have hargs : Args (previous + 1) := + hargsSucc (hclusterExpr hprev) (hclusterArgs hprev) + have hrest : ApplyRest (previous + 1) := + happlyRestSucc (hclusterArgs hprev) + have hborrow : Borrow (previous + 1) := + hborrowSucc (hclusterExpr hprev) + have hspine : Spine (previous + 1) := by + cases previous with + | zero => exact hspineOne + | succ prior => + have hprior : Cluster prior := ih prior (by omega) + exact hspineSucc (hclusterSpine hprev) (hclusterExpr hprev) + (hclusterArgs hprior) (hclusterApplyRest hprior) + (hclusterApplyRest hprev) + exact hmake + (hexprSucc (hclusterExpr hprev) (hclusterSpine hprev) + (hclusterBorrow hprev) hargs hrest) + hborrow hspine hargs hrest + +/-- The mutually recursive semantic compiler invariant at one fuel. Its +successful-run premises are reachable-state premises: the target context +need represent only the declarations in that run's final lowering state. -/ +structure LowerClusterPreservesBelow (ctx : Ctx) (cur : FnDef) + (limit : Nat) (src : IxIR0.Env) (fuel : Nat) : Prop where + expr : LowerEPreservesBelow ctx cur limit src fuel + borrow : LowerBorrowPreservesBelow ctx cur limit src fuel + spine : LowerSpinePreservesBelow ctx cur limit src fuel + args : LowerArgsPreservesBelow ctx cur limit src fuel + applyRest : ApplyRestPreservesBelow ctx cur limit src fuel + +/-- The bounded source-declaration environment supplies exactly the current +self contract needed while lowering any recursor body. -/ +theorem SourceDeclContractsBelow.recursorCurrentSelf + {src : IxIR0.Env} {ctx : Ctx} {limit : Nat} + (hcontracts : SourceDeclContractsBelow src ctx limit) + {address : Ixon.Address} {numArgs : Nat} {natLit : Bool} + {rules : Array IxIR0.RecRule} + (hsrc : src address = some (.recursor numArgs natLit rules)) : + ∃ d, ctx.decls address = some (.fn d) ∧ + d.arity = numArgs + 1 ∧ CurrentSelfContractBelow ctx d limit := by + obtain ⟨d, hdecl, harity, hresult, hcontract⟩ := + hcontracts.recursor hsrc + refine ⟨d, hdecl, harity, hresult, ?_⟩ + simpa [harity] using hcontract + +/-- Complete fuel induction for the expression/borrow/spine/arguments/rest +lowering cluster. `ExtraRepresented` is threaded only along successful runs; +`ExtraExtends` transports both declarations and shape-indexed wrapper memos +to earlier sequential sub-runs. The remaining premises are evaluator and +source/self contracts, not compiler-recursion or wrapper-oracle hypotheses. -/ +theorem lowerClusterPreservesBelow + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + (happly : ApplyOwnershipContractBelow ctx limit) + (hdecls : SourceDeclContractsBelow src ctx limit) : + ∀ fuel, LowerClusterPreservesBelow ctx cur limit src fuel := + lowerValueClusterWithin_core + (Expr := LowerEPreservesBelow ctx cur limit src) + (Borrow := LowerBorrowPreservesBelow ctx cur limit src) + (Spine := LowerSpinePreservesBelow ctx cur limit src) + (Args := LowerArgsPreservesBelow ctx cur limit src) + (ApplyRest := ApplyRestPreservesBelow ctx cur limit src) + (Cluster := LowerClusterPreservesBelow ctx cur limit src) + (hzero := { + expr := lowerEPreservesBelow_zero + borrow := lowerBorrowPreservesBelow_zero + spine := lowerSpinePreservesBelow_zero + args := lowerArgsPreservesBelow_zero + applyRest := applyRestPreservesBelow_zero }) + (hclusterExpr := fun hcluster => hcluster.expr) + (hclusterBorrow := fun hcluster => hcluster.borrow) + (hclusterSpine := fun hcluster => hcluster.spine) + (hclusterArgs := fun hcluster => hcluster.args) + (hclusterApplyRest := fun hcluster => hcluster.applyRest) + (hmake := fun hexpr hborrow hspine hargs hrest => { + expr := hexpr + borrow := hborrow + spine := hspine + args := hargs + applyRest := hrest }) + (hargsSucc := by + intro fuel hexpr hargs + exact lowerArgsPreservesBelow_succ hexpr hargs + (lowerExtraMonotone src fuel).args) + (happlyRestSucc := fun hargs => + applyRestPreservesBelow_succ hargs happly) + (hborrowSucc := fun hexpr => + lowerBorrowPreservesBelow_succ hexpr) + (hspineOne := lowerSpinePreservesBelow_one) + (hspineSucc := by + intro fuel hprevSpine hprevExpr hpriorArgs hpriorRest hprevRest + intro input world head args state finalState output emit av hrun + hrepresented havailable + exact lowerSpine_run_sound_below hprevSpine hprevExpr hpriorArgs + (lowerExtraMonotone src fuel).args hpriorRest hprevRest + (lowerExtraMonotone src fuel).applyRest + (lowerExtraMonotone src (fuel + 1)).applyRest hdecls hrun + hrepresented havailable) + (hexprSucc := by + intro fuel hprevExpr hprevSpine hprevBorrow hargs hrest + intro input world expr state finalState output emit av hrun + hrepresented havailable + exact lowerE_run_sound_below hprevExpr hprevSpine hargs + (lowerExtraMonotone src (fuel + 1)).args hrest + (lowerExtraMonotone src (fuel + 1)).applyRest hprevBorrow + hdecls (fun body => lowerE_releasesTrackedFirst src fuel body) + hrepresented hrun havailable) + +/-! ### Closed reachable-state value induction -/ + +/-- At compiler fuel one, `lowerSpine` still cannot complete: every branch +reaches a zero-fuel recursive action first. This is the semantic companion +to `lowerSpinePreservesBelow_one`. -/ +theorem lowerSpineValuePreservesWithin_one + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {src : IxIR0.Env} {ambient : LowSt} : + LowerSpineValuePreservesWithin funRel recSelfRel sourceCtx ctx cur src + ambient 1 := by + intro input output world head args sourceEnv sourceResult state finalState + emit av _ hrun _ _ + exact (lowerSpine_noSuccess_one src input world head args hrun).elim + +/-- The complete reachable-state semantic invariant for the mutually +recursive lowering cluster at one compiler-fuel index. All function +provenance is indexed by the ambient state of the enclosing whole-pass run; +individual successful subruns supply only an `ExtraExtends` suffix proof. -/ +structure LowerValueClusterWithin + (sourceCtx : IxIR0.Ctx) (src : IxIR0.Env) (ambient : LowSt) + (recSelfRel : RecSelfRel) (ctx : Ctx) (cur : FnDef) + (fuel : Nat) : Prop where + expr : LowerEValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel + borrow : LowerBorrowValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel + spine : LowerSpineValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel + args : LowerArgsValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel + applyRest : ApplyRestNonErasedValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient fuel + +/-- Complete compiler-fuel induction for value correspondence. The static +declaration and higher-order application hypotheses are semantic contracts +of the final target context; compiler recursion, erased reflection, let +cleanup, and generated-declaration reachability are all discharged here. -/ +theorem lowerValueClusterWithin + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) : + ∀ fuel, + LowerValueClusterWithin sourceCtx src ambient recSelfRel ctx cur fuel := + lowerValueClusterWithin_core + (Expr := LowerEValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient) + (Borrow := LowerBorrowValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient) + (Spine := LowerSpineValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient) + (Args := LowerArgsValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient) + (ApplyRest := ApplyRestNonErasedValuePreservesWithin + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur src ambient) + (Cluster := LowerValueClusterWithin sourceCtx src ambient recSelfRel ctx + cur) + (hzero := { + expr := lowerEValuePreservesWithin_zero src ambient + borrow := lowerBorrowValuePreservesWithin_zero src ambient + spine := lowerSpineValuePreservesWithin_zero src ambient + args := lowerArgsValuePreservesWithin_zero src ambient + applyRest := applyRestNonErasedValuePreservesWithin_zero src ambient }) + (hclusterExpr := fun hcluster => hcluster.expr) + (hclusterBorrow := fun hcluster => hcluster.borrow) + (hclusterSpine := fun hcluster => hcluster.spine) + (hclusterArgs := fun hcluster => hcluster.args) + (hclusterApplyRest := fun hcluster => hcluster.applyRest) + (hmake := fun hexpr hborrow hspine hargs hrest => { + expr := hexpr + borrow := hborrow + spine := hspine + args := hargs + applyRest := hrest }) + (hargsSucc := fun hexpr hargs => + lowerArgsValuePreservesWithin_succ hexpr hargs) + (happlyRestSucc := fun hargs => + applyRestNonErasedValuePreservesWithin_succ hargs + hcontracts.apply hvalues.apply) + (hborrowSucc := fun hexpr => + lowerBorrowValuePreservesWithin_succ hexpr) + (hspineOne := lowerSpineValuePreservesWithin_one) + (hspineSucc := by + intro fuel hprevSpine hprevExpr hpriorArgs hpriorRest hprevRest + intro input output world head args sourceEnv sourceResult state + finalState emit av hsource hrun hextends havailable + exact lowerSpine_run_value_sound_within (fuel := fuel) henv + hprevSpine hprevExpr + (lowerE_reflectsErased sourceCtx src (fuel + 1)) hpriorArgs + hpriorRest hprevRest + (lowerExtraMonotone src (fuel + 1)).knownCall hcontracts hvalues + hsource hrun hextends hrepresented havailable) + (hexprSucc := by + intro fuel hprevExpr hprevSpine hprevBorrow hargs hrest + intro input output world expr sourceEnv sourceFuel sourceValue state + finalState emit av hsource hrun hextends havailable + exact lowerE_run_value_sound_within (fuel := fuel) henv hprevExpr + hprevSpine hprevBorrow hargs hrest + (lowerExtraMonotone src (fuel + 2)).knownCall hcontracts hvalues + (fun body => lowerE_releasesTrackedFirst src fuel body) + hsource hrun hextends hrepresented havailable) + +/-- At compiler fuel one, the bounded semantic spine interface is likewise +vacuous because every executable branch reaches a zero-fuel subaction. -/ +theorem lowerSpineValuePreservesWithinBelow_one + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {cur : FnDef} + {limit : Nat} {src : IxIR0.Env} {ambient : LowSt} : + LowerSpineValuePreservesWithinBelow funRel recSelfRel sourceCtx ctx cur + limit src ambient 1 := by + intro input output world head args sourceEnv sourceResult state finalState + emit av _ hrun _ _ + exact (lowerSpine_noSuccess_one src input world head args hrun).elim + +/-- Fuel-bounded reachable-state semantic invariant for the complete +mutually recursive lowering cluster. -/ +structure LowerValueClusterWithinBelow + (sourceCtx : IxIR0.Ctx) (src : IxIR0.Env) (ambient : LowSt) + (recSelfRel : RecSelfRel) (ctx : Ctx) (cur : FnDef) + (limit fuel : Nat) : Prop where + expr : LowerEValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel + borrow : LowerBorrowValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel + spine : LowerSpineValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel + args : LowerArgsValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel + applyRest : ApplyRestNonErasedValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient fuel + +/-- Complete compiler-fuel induction under semantic contracts bounded at a +single target evaluator limit. This is the contractive cluster used while +the declaration and higher-order apply contracts themselves are sealed. -/ +theorem lowerValueClusterWithinBelow + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) : + ∀ fuel, LowerValueClusterWithinBelow sourceCtx src ambient recSelfRel + ctx cur limit fuel := + lowerValueClusterWithin_core + (Expr := LowerEValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient) + (Borrow := LowerBorrowValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient) + (Spine := LowerSpineValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient) + (Args := LowerArgsValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient) + (ApplyRest := ApplyRestNonErasedValuePreservesWithinBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit src ambient) + (Cluster := LowerValueClusterWithinBelow sourceCtx src ambient + recSelfRel ctx cur limit) + (hzero := { + expr := lowerEValuePreservesWithinBelow_zero src ambient + borrow := lowerBorrowValuePreservesWithinBelow_zero src ambient + spine := lowerSpineValuePreservesWithinBelow_zero src ambient + args := lowerArgsValuePreservesWithinBelow_zero src ambient + applyRest := + applyRestNonErasedValuePreservesWithinBelow_zero src ambient }) + (hclusterExpr := fun hcluster => hcluster.expr) + (hclusterBorrow := fun hcluster => hcluster.borrow) + (hclusterSpine := fun hcluster => hcluster.spine) + (hclusterArgs := fun hcluster => hcluster.args) + (hclusterApplyRest := fun hcluster => hcluster.applyRest) + (hmake := fun hexpr hborrow hspine hargs hrest => { + expr := hexpr + borrow := hborrow + spine := hspine + args := hargs + applyRest := hrest }) + (hargsSucc := fun hexpr hargs => + lowerArgsValuePreservesWithinBelow_succ hexpr hargs) + (happlyRestSucc := fun hargs => + applyRestNonErasedValuePreservesWithinBelow_succ hargs + (hcontracts.apply.below limit) hvalues.apply) + (hborrowSucc := fun hexpr => + lowerBorrowValuePreservesWithinBelow_succ hexpr) + (hspineOne := lowerSpineValuePreservesWithinBelow_one) + (hspineSucc := by + intro fuel hprevSpine hprevExpr hpriorArgs hpriorRest hprevRest + intro input output world head args sourceEnv sourceResult state + finalState emit av hsource hrun hextends havailable + exact lowerSpine_run_value_sound_within_below (fuel := fuel) henv + hprevSpine hprevExpr + (lowerE_reflectsErased sourceCtx src (fuel + 1)) hpriorArgs + hpriorRest hprevRest + (lowerExtraMonotone src (fuel + 1)).knownCall hcontracts hvalues + hsource hrun hextends hrepresented havailable) + (hexprSucc := by + intro fuel hprevExpr hprevSpine hprevBorrow hargs hrest + intro input output world expr sourceEnv sourceFuel sourceValue state + finalState emit av hsource hrun hextends havailable + exact lowerE_run_value_sound_within_below (fuel := fuel) henv + hprevExpr hprevSpine hprevBorrow hargs hrest + (lowerExtraMonotone src (fuel + 2)).knownCall hcontracts hvalues + (fun body => lowerE_releasesTrackedFirst src fuel body) + hsource hrun hextends hrepresented havailable) + +/-- Bounded ordinary-expression interface with no recursive-self entry. -/ +theorem lowerE_run_value_sound_within_noRecSelf_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + {fuel : Nat} {input output : VEnv} {world : Owned} + {expr : IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceFuel : Nat} {sourceValue : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hsource : IxIR0.eval sourceCtx sourceFuel sourceEnv expr = + .ok sourceValue) + (hrun : (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hno : NoRecSelf input) : + LowerResultValueSoundBelow (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur limit input output sourceEnv sourceEnv sourceValue + world emit av := + (lowerValueClusterWithinBelow (recSelfRel := recSelfRel) (cur := cur) + henv hrepresented hcontracts hvalues fuel).expr hsource hrun hextends + (SelfValueAvailableBelow.of_noRecSelf hno) + +/-- Bounded recursor-rule expression interface with current-self semantics. -/ +theorem lowerE_run_value_sound_within_currentSelf_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {limit : Nat} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + {fuel : Nat} {input output : VEnv} {world : Owned} + {expr : IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceFuel : Nat} {sourceValue : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hsource : IxIR0.eval sourceCtx sourceFuel sourceEnv expr = + .ok sourceValue) + (hrun : (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hself : CurrentSelfValueContractBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit) : + LowerResultValueSoundBelow (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur limit input output sourceEnv sourceEnv sourceValue + world emit av := + (lowerValueClusterWithinBelow (recSelfRel := recSelfRel) (cur := cur) + henv hrepresented hcontracts hvalues fuel).expr hsource hrun hextends + (SelfValueAvailableBelow.of_contract hself) + +/-- Ordinary expressions expose the closed semantic compiler induction +without requiring a current recursive-self contract. -/ +theorem lowerE_run_value_sound_within_noRecSelf + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {fuel : Nat} {input output : VEnv} {world : Owned} + {expr : IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceFuel : Nat} {sourceValue : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hsource : IxIR0.eval sourceCtx sourceFuel sourceEnv expr = + .ok sourceValue) + (hrun : (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hno : NoRecSelf input) : + LowerResultValueSound (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceValue world + emit av := + (lowerValueClusterWithin (recSelfRel := recSelfRel) (cur := cur) henv + hrepresented hcontracts hvalues fuel).expr hsource hrun hextends + (SelfValueAvailable.of_noRecSelf hno) + +/-- Recursor-rule expressions use the same closed semantic induction with +the generated current-function value contract. -/ +theorem lowerE_run_value_sound_within_currentSelf + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {fuel : Nat} {input output : VEnv} {world : Owned} + {expr : IxIR0.Expr} {sourceEnv : List IxIR0.Value} + {sourceFuel : Nat} {sourceValue : IxIR0.Value} + {state finalState : LowSt} {emit : Emit} {av : AVal} + (hsource : IxIR0.eval sourceCtx sourceFuel sourceEnv expr = + .ok sourceValue) + (hrun : (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState) + (hextends : ExtraExtends finalState ambient) + (hself : CurrentSelfValueContract + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur) : + LowerResultValueSound (CompilerFunctionRel sourceCtx src ambient) + recSelfRel ctx cur input output sourceEnv sourceEnv sourceValue world + emit av := + (lowerValueClusterWithin (recSelfRel := recSelfRel) (cur := cur) henv + hrepresented hcontracts hvalues fuel).expr hsource hrun hextends + (SelfValueAvailable.of_contract hself) + +/-! ### Source saturation lemmas for declaration contracts -/ + +/-- Evaluating an expression and then supplying exactly its leading lambda +telescope is the same source computation as evaluating `stripLams` in the +reversed argument environment. Fuel witnesses remain existential because +source fuel is a totality witness, not a cost. -/ +theorem sourceEval_stripLams_of_applies (sourceCtx : IxIR0.Ctx) : + ∀ {sourceEnv : List IxIR0.Value} {expr : IxIR0.Expr} + {function result : IxIR0.Value} {args : List IxIR0.Value} + {evalFuel : Nat}, + IxIR0.eval sourceCtx evalFuel sourceEnv expr = .ok function → + args.length = lamArity expr → + SourceApplies sourceCtx function args result → + ∃ bodyFuel, + IxIR0.eval sourceCtx bodyFuel (args.reverse ++ sourceEnv) + (stripLams expr) = .ok result := by + intro sourceEnv expr + induction expr generalizing sourceEnv with + | var index => + intro function result args evalFuel heval hlength happlies + have hnil : args = [] := + List.eq_nil_of_length_eq_zero (by simpa [lamArity] using hlength) + subst args + cases happlies + exact ⟨evalFuel, by simpa [stripLams] using heval⟩ + | ref address => + intro function result args evalFuel heval hlength happlies + have hnil : args = [] := + List.eq_nil_of_length_eq_zero (by simpa [lamArity] using hlength) + subst args + cases happlies + exact ⟨evalFuel, by simpa [stripLams] using heval⟩ + | app fn arg => + intro function result args evalFuel heval hlength happlies + have hnil : args = [] := + List.eq_nil_of_length_eq_zero (by simpa [lamArity] using hlength) + subst args + cases happlies + exact ⟨evalFuel, by simpa [stripLams] using heval⟩ + | lam uses body ih => + intro function result args evalFuel heval hlength happlies + cases evalFuel with + | zero => simp [IxIR0.eval] at heval + | succ evalFuel => + have hfunction : function = .clos uses sourceEnv body := by + simpa [IxIR0.eval] using heval.symm + subst function + cases args with + | nil => simp [lamArity] at hlength + | cons argument arguments => + have htailLength : arguments.length = lamArity body := by + simpa [lamArity] using hlength + cases happlies with + | @cons _ _ middle _ _ applyFuel hstep htail => + cases applyFuel with + | zero => simp [IxIR0.apply] at hstep + | succ applyFuel => + have hbodyEval : IxIR0.eval sourceCtx applyFuel + (argument :: sourceEnv) body = .ok middle := by + simpa [IxIR0.apply] using hstep + obtain ⟨bodyFuel, hresult⟩ := + ih hbodyEval htailLength htail + refine ⟨bodyFuel, ?_⟩ + simpa [stripLams, List.reverse_cons, List.append_assoc] using + hresult + | letE uses value body => + intro function result args evalFuel heval hlength happlies + have hnil : args = [] := + List.eq_nil_of_length_eq_zero (by simpa [lamArity] using hlength) + subst args + cases happlies + exact ⟨evalFuel, by simpa [stripLams] using heval⟩ + | proj index value => + intro function result args evalFuel heval hlength happlies + have hnil : args = [] := + List.eq_nil_of_length_eq_zero (by simpa [lamArity] using hlength) + subst args + cases happlies + exact ⟨evalFuel, by simpa [stripLams] using heval⟩ + | lit literal => + intro function result args evalFuel heval hlength happlies + have hnil : args = [] := + List.eq_nil_of_length_eq_zero (by simpa [lamArity] using hlength) + subst args + cases happlies + exact ⟨evalFuel, by simpa [stripLams] using heval⟩ + | erased => + intro function result args evalFuel heval hlength happlies + have hnil : args = [] := + List.eq_nil_of_length_eq_zero (by simpa [lamArity] using hlength) + subst args + cases happlies + exact ⟨evalFuel, by simpa [stripLams] using heval⟩ + +/-- Complete a residual lifted-closure prefix with the remaining arguments. +The resulting source environment is exactly the selected prefix's full +application order reversed, followed by the original closure environment. -/ +theorem LambdaPrefix.saturate + {sourceCtx : IxIR0.Ctx} {sourceEnv : List IxIR0.Value} + {expr : IxIR0.Expr} {supplied remaining : List IxIR0.Value} + {function result : IxIR0.Value} + (hprefix : LambdaPrefix sourceEnv expr supplied function) + (hlength : (supplied ++ remaining).length = lamArity expr) + (happlies : SourceApplies sourceCtx function remaining result) : + ∃ fuel, + IxIR0.eval sourceCtx fuel + ((supplied ++ remaining).reverse ++ sourceEnv) + (stripLams expr) = .ok result := by + exact (LambdaPrefix.traverse + (Result := fun currentEnv currentExpr currentSupplied currentFunction => + (currentSupplied ++ remaining).length = lamArity currentExpr → + SourceApplies sourceCtx currentFunction remaining result → + ∃ fuel, + IxIR0.eval sourceCtx fuel + ((currentSupplied ++ remaining).reverse ++ currentEnv) + (stripLams currentExpr) = .ok result) + (hnil := by + intro currentEnv uses body hlength happlies + have heval : IxIR0.eval sourceCtx 1 currentEnv (.lam uses body) = + .ok (.clos uses currentEnv body) := by + simp [IxIR0.eval] + simpa using sourceEval_stripLams_of_applies sourceCtx heval + (by simpa using hlength) happlies) + (hcons := by + intro currentEnv uses body argument currentSupplied currentFunction + hinner ih hlength happlies + have hinnerLength : (currentSupplied ++ remaining).length = + lamArity body := by + simpa [lamArity] using hlength + obtain ⟨fuel, hresult⟩ := ih hinnerLength happlies + refine ⟨fuel, ?_⟩ + simpa [stripLams, List.reverse_cons, List.append_assoc] using hresult) + (h := hprefix)) hlength happlies + +/-- A source definition reference exposes the exact closed evaluation of its +body, independent of the existential reference fuel. -/ +theorem SourceRefValue.defnBody + {sourceCtx : IxIR0.Ctx} {address : Ixon.Address} + {world : Owned} {body : IxIR0.Expr} {function : IxIR0.Value} + (hlookup : sourceCtx.env address = some (.defn world body)) + (href : SourceRefValue sourceCtx address function) : + ∃ fuel, IxIR0.eval sourceCtx fuel [] body = .ok function := by + obtain ⟨fuel, href⟩ := href + cases fuel with + | zero => simp [IxIR0.eval] at href + | succ fuel => + exact ⟨fuel, by simpa [IxIR0.eval, hlookup] using href⟩ + +/-- Saturating a source definition reference reaches its stripped body under +the reversed source argument vector. -/ +theorem SourceRefValue.defnSaturate + {sourceCtx : IxIR0.Ctx} {address : Ixon.Address} + {world : Owned} {body : IxIR0.Expr} + {function result : IxIR0.Value} {args : List IxIR0.Value} + (hlookup : sourceCtx.env address = some (.defn world body)) + (href : SourceRefValue sourceCtx address function) + (hlength : args.length = lamArity body) + (happlies : SourceApplies sourceCtx function args result) : + ∃ fuel, IxIR0.eval sourceCtx fuel args.reverse + (stripLams body) = .ok result := by + obtain ⟨evalFuel, heval⟩ := href.defnBody hlookup + simpa using sourceEval_stripLams_of_applies sourceCtx heval hlength + happlies + +/-! ### Semantic function closure -/ + +/-- Closing a semantic lowering result with its generated `ret` exposes the +source result graph and preserves an arbitrary semantic caller frame. This +is the value-level counterpart of `LowerResultSound.close`; ownership of the +returned root remains available through the parent judgment when needed. -/ +theorem LowerResultValueSound.closeGraph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {world : Owned} + {emit : Emit} {av : AVal} + (hsound : LowerResultValueSound funRel recSelfRel ctx cur input output + sourceInput sourceOutput sourceValue world emit av) + (hreleased : EntriesReleased output.entries) + (sourceRest : List (Owned × IxIR0.Value)) (rest : List Root) : + CodeOwns ctx cur + (GraphOwnsVEnv funRel recSelfRel input sourceInput sourceRest rest) + (fun store value => + Sim.ValueGraph funRel store sourceValue value ∧ + Sim.RootsGraph funRel store sourceRest rest) + (emit (.ret (av.toAtom output))) := by + have hret : CodeOwns ctx cur + (GraphOwnsResultProtected funRel recSelfRel output sourceOutput + sourceValue world av sourceRest rest []) + (fun store value => + Sim.ValueGraph funRel store sourceValue value ∧ + Sim.RootsGraph funRel store sourceRest rest) + (.ret (av.toAtom output)) := by + intro fuel store env store' value hprotected hrun + obtain ⟨⟨roots, result, houtput, hav, hvalue, hframe, _⟩, _⟩ := + hprotected + have hroots : roots = [] := + EntriesRealize.eq_nil_of_released hreleased + houtput.entries.entriesRealize + subst roots + cases fuel with + | zero => simp [runCode] at hrun + | succ fuel => + rw [Nat.add_one] at hrun + rw [runCode.eq_def] at hrun + dsimp only at hrun + rw [hav.resolveAtom] at hrun + have hpair : (store, result) = (store', value) := + Except.ok.inj hrun + cases hpair + exact ⟨hvalue, hframe⟩ + intro fuel store env store' value hpre hrun + exact hsound.graphEmits sourceRest rest [] + (fun store value => + Sim.ValueGraph funRel store sourceValue value ∧ + Sim.RootsGraph funRel store sourceRest rest) + (.ret (av.toAtom output)) hret + ⟨hpre, SlotsRealize.nil⟩ hrun + +/-- Bounded counterpart of `closeGraph`; this is the function-exit rule used +while mutually recursive declaration contracts are available only below the +current evaluator index. -/ +theorem LowerResultValueSoundBelow.closeGraph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {ctx : Ctx} {cur : FnDef} {limit : Nat} + {input output : VEnv} + {sourceInput sourceOutput : List IxIR0.Value} + {sourceValue : IxIR0.Value} {world : Owned} + {emit : Emit} {av : AVal} + (hsound : LowerResultValueSoundBelow funRel recSelfRel ctx cur limit + input output sourceInput sourceOutput sourceValue world emit av) + (hreleased : EntriesReleased output.entries) + (sourceRest : List (Owned × IxIR0.Value)) (rest : List Root) : + CodeOwnsBelow ctx cur limit + (GraphOwnsVEnv funRel recSelfRel input sourceInput sourceRest rest) + (fun store value => + Sim.ValueGraph funRel store sourceValue value ∧ + Sim.RootsGraph funRel store sourceRest rest) + (emit (.ret (av.toAtom output))) := by + have hret : CodeOwnsBelow ctx cur limit + (GraphOwnsResultProtected funRel recSelfRel output sourceOutput + sourceValue world av sourceRest rest []) + (fun store value => + Sim.ValueGraph funRel store sourceValue value ∧ + Sim.RootsGraph funRel store sourceRest rest) + (.ret (av.toAtom output)) := by + intro fuel store env store' value _ hprotected hrun + obtain ⟨⟨roots, result, houtput, hav, hvalue, hframe, _⟩, _⟩ := + hprotected + have hroots : roots = [] := + EntriesRealize.eq_nil_of_released hreleased + houtput.entries.entriesRealize + subst roots + cases fuel with + | zero => simp [runCode] at hrun + | succ fuel => + rw [Nat.add_one] at hrun + rw [runCode.eq_def] at hrun + dsimp only at hrun + rw [hav.resolveAtom] at hrun + have hpair : (store, result) = (store', value) := + Except.ok.inj hrun + cases hpair + exact ⟨hvalue, hframe⟩ + intro fuel store env store' value hfuel hpre hrun + exact hsound.graphEmits sourceRest rest [] limit (Nat.le_refl _) + (fun store value => + Sim.ValueGraph funRel store sourceValue value ∧ + Sim.RootsGraph funRel store sourceRest rest) + (.ret (av.toAtom output)) hret hfuel + ⟨hpre, SlotsRealize.nil⟩ hrun + +/-- Contractive function-entry/exit adapter. A bounded expression theorem +for the lowered body is enough to prove the function at the bound itself; +all declaration/apply dependencies used by that expression theorem may +therefore remain strictly below the bound. -/ +theorem lowerFnBody_parameterEntries_valuePreservesAt_below + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {sourceCtx : IxIR0.Ctx} {ctx : Ctx} {src : IxIR0.Env} + {compilerFuel limit : Nat} + (modes : List Uses) (world : Owned) (body : IxIR0.Expr) + {state finalState : LowSt} {code : Code} {papSafeFlag : Bool} + (hbodyPreserves : LowerEValuePreservesBelow funRel recSelfRel + sourceCtx ctx ⟨modes.length, world, papSafeFlag, code⟩ + limit src compilerFuel) + (hadmissible : ParameterDropsAdmissible modes + (fun index => countUses index body)) + (hrun : (lowerFnBody src (compilerFuel + 1) + ⟨parameterEntries 0 modes (fun index => countUses index body), + modes.length⟩ + (parameterDrops 0 modes (fun index => countUses index body)) + world body).run state = .ok code finalState) + {sourceFunction : IxIR0.Value} + (hsaturates : ∀ {sourceArgs : List IxIR0.Value} + {sourceResult : IxIR0.Value}, + sourceArgs.length = modes.length → + SourceApplies sourceCtx sourceFunction sourceArgs sourceResult → + ∃ sourceFuel, + IxIR0.eval sourceCtx sourceFuel sourceArgs.reverse body = + .ok sourceResult) : + FnValuePreservesAt funRel sourceCtx ctx + ⟨modes.length, world, papSafeFlag, code⟩ (modes.map worldOfUses) + sourceFunction limit := by + let remaining : Nat → Nat := fun index => countUses index body + let input : VEnv := + ⟨parameterEntries 0 modes remaining, modes.length⟩ + let drops := parameterDrops 0 modes remaining + have hrun' : + (lowerFnBody src (compilerFuel + 1) input drops world body).run state = + .ok code finalState := by + simpa [input, drops, remaining] using hrun + simp only [lowerFnBody] at hrun' + obtain ⟨releaseResult, releaseState, hreleaseRun, hafterRelease⟩ := + trackedBindRun_ok_inv hrun' + rcases releaseResult with ⟨middle, releaseEmit⟩ + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + trackedBindRun_ok_inv hafterRelease + rcases bodyResult with ⟨output, emit, av⟩ + have hpure : + (releaseEmit ∘ emit) (.ret (av.toAtom output)) = code ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨hcode, hbodyState⟩ := hpure + subst bodyState + obtain ⟨plannedMiddle, plannedEmit, hplan, htracks⟩ := + parameterDrops_releasePlan_tracked 0 modes remaining + (by simpa [remaining] using hadmissible) + have hplan' : ReleasePlan input drops plannedMiddle plannedEmit := by + simpa [input, drops] using hplan + have hplanRun : (releaseSlots input drops).run state = + .ok (plannedMiddle, plannedEmit) state := hplan'.run state + have heq : + (plannedMiddle, plannedEmit) = (middle, releaseEmit) ∧ + state = releaseState := by + simpa using hplanRun.symm.trans hreleaseRun + have hmiddle : plannedMiddle = middle := congrArg Prod.fst heq.1 + have hemit : plannedEmit = releaseEmit := congrArg Prod.snd heq.1 + subst middle + subst releaseEmit + cases heq.2 + have hconsume := lowerE_consumesEntries hbodyRun + have hcount := lowerE_preservesEntryCount hbodyRun + have hmiddleLength : plannedMiddle.entries.length = modes.length := by + calc + plannedMiddle.entries.length = input.entries.length := + hplan'.entries_length + _ = modes.length := by simp [input, remaining] + have hreleased : EntriesReleased output.entries := + hconsume.entriesReleased htracks (Eq.trans hcount hmiddleLength) + intro store store' args value sourceArgs sourceResult sourceRest rest + hlength hargs happlies hframe hown hcodeRun + have hargsLength : args.length = modes.length := by + simpa using hlength + have hsourceArgsLength : sourceArgs.length = args.length := by + simpa using hargs.length + obtain ⟨sourceFuel, hsource⟩ := hsaturates + (hsourceArgsLength.trans hargsLength) happlies + have hbodySound : LowerResultValueSoundBelow funRel recSelfRel ctx + ⟨modes.length, world, papSafeFlag, code⟩ limit plannedMiddle output + sourceArgs.reverse sourceArgs.reverse sourceResult world emit av := + hbodyPreserves hsource hbodyRun + have hfull : LowerResultValueSoundBelow funRel recSelfRel ctx + ⟨modes.length, world, papSafeFlag, code⟩ limit input output + sourceArgs.reverse sourceArgs.reverse sourceResult world + (plannedEmit ∘ emit) av := + hbodySound.afterRelease (hplan'.valueSoundBelow sourceArgs.reverse) + have hpre : GraphOwnsVEnv funRel recSelfRel input sourceArgs.reverse + sourceRest rest store args.reverse := by + refine ⟨(rootsForWorlds (modes.map worldOfUses) args).reverse, + ?_, hframe, ?_⟩ + · simpa [input] using VEnvValueGraph.parameterEntries + (recSelfRel := recSelfRel) modes remaining hargsLength hargs hown + · exact hown.perm + ((List.reverse_perm + (rootsForWorlds (modes.map worldOfUses) args)).symm.append_right + rest) + have hcodeRun' : runCode ctx limit + ⟨modes.length, world, papSafeFlag, code⟩ store args.reverse + ((plannedEmit ∘ emit) (.ret (av.toAtom output))) = + .ok (store', value) := by + rw [hcode] + exact hcodeRun + exact hfull.closeGraph hreleased sourceRest rest (Nat.le_refl _) + hpre hcodeRun' + +/-- Contractive ordinary-declaration producer. Once the bounded expression +induction is available for the actual emitted function, this proves that +function at the current evaluator bound without assuming its own unbounded +semantic contract. -/ +theorem lowerDecl_defn_valuePreservesAt_below + {funRel : Sim.FunctionRel} {sourceCtx : IxIR0.Ctx} + {src : IxIR0.Env} {ctx : Ctx} {compilerFuel limit : Nat} + {address : Ixon.Address} {result : Owned} {body : IxIR0.Expr} + {state finalState : LowSt} {d : FnDef} + {sourceFunction : IxIR0.Value} + (hlookup : sourceCtx.env address = some (.defn result body)) + (href : SourceRefValue sourceCtx address sourceFunction) + (hbodyPreserves : LowerEValuePreservesBelow funRel + (fun _ _ => False) sourceCtx ctx d limit src compilerFuel) + (hadmissible : ParameterDropsAdmissible (lamUses body) + (fun index => countUses index (stripLams body))) + (hrun : (lowerDecl src (compilerFuel + 1) + (address, .defn result body)).run state = + .ok (some (address, .fn d)) finalState) : + FnValuePreservesAt funRel sourceCtx ctx d + ((lamUses body).map worldOfUses) sourceFunction limit := by + simp only [lowerDecl] at hrun + obtain ⟨code, bodyState, hbodyRun, hpureRun⟩ := + trackedBindRun_ok_inv hrun + have hpure : + some (address, Decl.fn ⟨lamArity body, result, + result == .shared && papSafe body, code⟩) = + some (address, Decl.fn d) ∧ + bodyState = finalState := by + simpa using hpureRun + have hd : d = ⟨lamArity body, result, + result == .shared && papSafe body, code⟩ := by + have hp := Option.some.inj hpure.1 + exact Decl.fn.inj (Prod.mk.inj hp).2.symm + cases hpure.2 + subst d + have hbodyPreserves' : LowerEValuePreservesBelow funRel + (fun _ _ => False) sourceCtx ctx + ⟨(lamUses body).length, result, + result == .shared && papSafe body, code⟩ limit src compilerFuel := by + intro input output world expr sourceEnv sourceFuel sourceValue + state finalState emit av hsource hrun + simpa using hbodyPreserves hsource hrun + have hpreserves : FnValuePreservesAt funRel sourceCtx ctx + ⟨(lamUses body).length, result, + result == .shared && papSafe body, code⟩ + ((lamUses body).map worldOfUses) sourceFunction limit := + lowerFnBody_parameterEntries_valuePreservesAt_below + (recSelfRel := fun _ _ => False) + (compilerFuel := compilerFuel) (limit := limit) + (lamUses body) result (stripLams body) hbodyPreserves' + hadmissible (by simpa using hbodyRun) + (by + intro sourceArgs sourceResult hlength happlies + exact href.defnSaturate hlookup (by simpa using hlength) happlies) + have hfn : (⟨(lamUses body).length, result, + result == .shared && papSafe body, code⟩ : FnDef) = + ⟨lamArity body, result, + result == .shared && papSafe body, code⟩ := by + rw [lamUses_length] + rw [← hfn] + intro store store' args value sourceArgs sourceResult sourceRest rest + hlength hargs happlies hframe hown hcodeRun + exact hpreserves hlength hargs happlies hframe hown hcodeRun + +/-- Reachable-state specialization of the contractive function-entry +adapter. Unlike `lowerFnBody_parameterEntries_valuePreservesAt_below`, this +version follows the one actual body run into the ambient final lowering +state. That is the shape supplied by `lowerAllAction`: generated function +provenance is only known in the final accumulated state, and +`ExtraExtends` transports it back to this particular body run. -/ +theorem lowerFnBody_parameterEntries_valuePreservesAt_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} + {compilerFuel limit : Nat} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + (modes : List Uses) (world : Owned) (body : IxIR0.Expr) + {state finalState : LowSt} {code : Code} {papSafeFlag : Bool} + (hadmissible : ParameterDropsAdmissible modes + (fun index => countUses index body)) + (hrun : (lowerFnBody src (compilerFuel + 1) + ⟨parameterEntries 0 modes (fun index => countUses index body), + modes.length⟩ + (parameterDrops 0 modes (fun index => countUses index body)) + world body).run state = .ok code finalState) + (hextends : ExtraExtends finalState ambient) + {sourceFunction : IxIR0.Value} + (hsaturates : ∀ {sourceArgs : List IxIR0.Value} + {sourceResult : IxIR0.Value}, + sourceArgs.length = modes.length → + SourceApplies sourceCtx sourceFunction sourceArgs sourceResult → + ∃ sourceFuel, + IxIR0.eval sourceCtx sourceFuel sourceArgs.reverse body = + .ok sourceResult) : + FnValuePreservesAt (CompilerFunctionRel sourceCtx src ambient) + sourceCtx ctx ⟨modes.length, world, papSafeFlag, code⟩ + (modes.map worldOfUses) sourceFunction limit := by + let remaining : Nat → Nat := fun index => countUses index body + let input : VEnv := + ⟨parameterEntries 0 modes remaining, modes.length⟩ + let drops := parameterDrops 0 modes remaining + have hrun' : + (lowerFnBody src (compilerFuel + 1) input drops world body).run state = + .ok code finalState := by + simpa [input, drops, remaining] using hrun + simp only [lowerFnBody] at hrun' + obtain ⟨releaseResult, releaseState, hreleaseRun, hafterRelease⟩ := + trackedBindRun_ok_inv hrun' + rcases releaseResult with ⟨middle, releaseEmit⟩ + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + trackedBindRun_ok_inv hafterRelease + rcases bodyResult with ⟨output, emit, av⟩ + have hpure : + (releaseEmit ∘ emit) (.ret (av.toAtom output)) = code ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨hcode, hbodyState⟩ := hpure + subst bodyState + have hmiddleNo : NoRecSelf middle := + releaseSlots_noRecSelf input hreleaseRun (by + simpa [input, remaining] using + parameterEntries_noRecSelf 0 modes remaining modes.length) + obtain ⟨plannedMiddle, plannedEmit, hplan, htracks⟩ := + parameterDrops_releasePlan_tracked 0 modes remaining + (by simpa [remaining] using hadmissible) + have hplan' : ReleasePlan input drops plannedMiddle plannedEmit := by + simpa [input, drops] using hplan + have hplanRun : (releaseSlots input drops).run state = + .ok (plannedMiddle, plannedEmit) state := hplan'.run state + have heq : + (plannedMiddle, plannedEmit) = (middle, releaseEmit) ∧ + state = releaseState := by + simpa using hplanRun.symm.trans hreleaseRun + have hmiddle : plannedMiddle = middle := congrArg Prod.fst heq.1 + have hemit : plannedEmit = releaseEmit := congrArg Prod.snd heq.1 + subst middle + subst releaseEmit + cases heq.2 + have hconsume := lowerE_consumesEntries hbodyRun + have hcount := lowerE_preservesEntryCount hbodyRun + have hmiddleLength : plannedMiddle.entries.length = modes.length := by + calc + plannedMiddle.entries.length = input.entries.length := + hplan'.entries_length + _ = modes.length := by simp [input, remaining] + have hreleased : EntriesReleased output.entries := + hconsume.entriesReleased htracks (Eq.trans hcount hmiddleLength) + intro store store' args value sourceArgs sourceResult sourceRest rest + hlength hargs happlies hframe hown hcodeRun + have hargsLength : args.length = modes.length := by + simpa using hlength + have hsourceArgsLength : sourceArgs.length = args.length := by + simpa using hargs.length + obtain ⟨sourceFuel, hsource⟩ := hsaturates + (hsourceArgsLength.trans hargsLength) happlies + have hbodySound : LowerResultValueSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx + ⟨modes.length, world, papSafeFlag, code⟩ limit plannedMiddle output + sourceArgs.reverse sourceArgs.reverse sourceResult world emit av := + lowerE_run_value_sound_within_noRecSelf_below + (recSelfRel := recSelfRel) + (cur := (⟨modes.length, world, papSafeFlag, code⟩ : FnDef)) + henv hrepresented hcontracts hvalues hsource hbodyRun hextends + hmiddleNo + have hfull : LowerResultValueSoundBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx + ⟨modes.length, world, papSafeFlag, code⟩ limit input output + sourceArgs.reverse sourceArgs.reverse sourceResult world + (plannedEmit ∘ emit) av := + hbodySound.afterRelease (hplan'.valueSoundBelow sourceArgs.reverse) + have hpre : GraphOwnsVEnv + (CompilerFunctionRel sourceCtx src ambient) recSelfRel input + sourceArgs.reverse sourceRest rest store args.reverse := by + refine ⟨(rootsForWorlds (modes.map worldOfUses) args).reverse, + ?_, hframe, ?_⟩ + · simpa [input] using VEnvValueGraph.parameterEntries + (recSelfRel := recSelfRel) modes remaining hargsLength hargs hown + · exact hown.perm + ((List.reverse_perm + (rootsForWorlds (modes.map worldOfUses) args)).symm.append_right + rest) + have hcodeRun' : runCode ctx limit + ⟨modes.length, world, papSafeFlag, code⟩ store args.reverse + ((plannedEmit ∘ emit) (.ret (av.toAtom output))) = + .ok (store', value) := by + rw [hcode] + exact hcodeRun + exact hfull.closeGraph hreleased sourceRest rest (Nat.le_refl _) + hpre hcodeRun' + +/-- A successful ordinary declaration run proves its own dead-parameter +admissibility: `lowerFnBody` executes the generated release list before any +body lowering, and the forbidden modes are exactly its error cases. -/ +theorem lowerDecl_defn_parameterDropsAdmissible + {src : IxIR0.Env} {compilerFuel : Nat} + {address : Ixon.Address} {result : Owned} {body : IxIR0.Expr} + {state finalState : LowSt} {d : FnDef} + (hrun : (lowerDecl src compilerFuel (address, .defn result body)).run + state = .ok (some (address, .fn d)) finalState) : + ParameterDropsAdmissible (lamUses body) + (fun index => countUses index (stripLams body)) := by + simp only [lowerDecl] at hrun + obtain ⟨code, bodyState, hbodyRun, _⟩ := + trackedBindRun_ok_inv hrun + cases compilerFuel with + | zero => + exact (trackedThrowRun_not_ok (by + simpa [lowerFnBody] using hbodyRun)).elim + | succ bodyFuel => + simp only [lowerFnBody] at hbodyRun + obtain ⟨releaseResult, releaseState, hreleaseRun, _⟩ := + trackedBindRun_ok_inv hbodyRun + exact parameterDropsAdmissible_of_releaseSlots_run 0 (lamUses body) + (fun index => countUses index (stripLams body)) hreleaseRun + +/-- An ordinary source declaration produced by a reachable whole-pass run +satisfies the exact semantic contract at the current evaluator index using +only strictly-smaller semantic declaration/application contracts. -/ +theorem lowerDecl_defn_valuePreservesAt_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {ctx : Ctx} {compilerFuel limit : Nat} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + {address : Ixon.Address} {result : Owned} {body : IxIR0.Expr} + {state finalState : LowSt} {d : FnDef} + {sourceFunction : IxIR0.Value} + (hsrc : src address = some (.defn result body)) + (href : SourceRefValue sourceCtx address sourceFunction) + (hadmissible : ParameterDropsAdmissible (lamUses body) + (fun index => countUses index (stripLams body))) + (hrun : (lowerDecl src (compilerFuel + 1) + (address, .defn result body)).run state = + .ok (some (address, .fn d)) finalState) + (hextends : ExtraExtends finalState ambient) : + FnValuePreservesAt + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + ((lamUses body).map worldOfUses) sourceFunction limit := by + simp only [lowerDecl] at hrun + obtain ⟨code, bodyState, hbodyRun, hpureRun⟩ := + trackedBindRun_ok_inv hrun + have hpure : + some (address, Decl.fn ⟨lamArity body, result, + result == .shared && papSafe body, code⟩) = + some (address, Decl.fn d) ∧ + bodyState = finalState := by + simpa using hpureRun + have hd : d = ⟨lamArity body, result, + result == .shared && papSafe body, code⟩ := by + have hp := Option.some.inj hpure.1 + exact Decl.fn.inj (Prod.mk.inj hp).2.symm + cases hpure.2 + subst d + have hlookup : sourceCtx.env address = some (.defn result body) := by + rw [henv] + exact hsrc + have hpreserves : FnValuePreservesAt + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx + ⟨(lamUses body).length, result, + result == .shared && papSafe body, code⟩ + ((lamUses body).map worldOfUses) sourceFunction limit := + lowerFnBody_parameterEntries_valuePreservesAt_within_below + (recSelfRel := fun _ _ => False) + (compilerFuel := compilerFuel) (limit := limit) + henv hrepresented hcontracts hvalues (lamUses body) result + (stripLams body) hadmissible (by simpa using hbodyRun) hextends + (by + intro sourceArgs sourceResult hlength happlies + exact href.defnSaturate hlookup (by simpa using hlength) happlies) + have hfn : (⟨(lamUses body).length, result, + result == .shared && papSafe body, code⟩ : FnDef) = + ⟨lamArity body, result, + result == .shared && papSafe body, code⟩ := by + rw [lamUses_length] + rw [← hfn] + intro store store' args value sourceArgs sourceResult sourceRest rest + hlength hargs happlies hframe hown hcodeRun + exact hpreserves hlength hargs happlies hframe hown hcodeRun + +/-- A successfully lowered ordinary body realizes any source function whose +saturated applications evaluate the source body in the canonical reversed +argument environment. This is the semantic function-entry/exit adapter; +recursive call contracts remain explicit in `hvalues`. -/ +theorem lowerFnBody_parameterEntries_valuePreservesAt + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} + {compilerFuel targetFuel : Nat} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + (modes : List Uses) (world : Owned) (body : IxIR0.Expr) + {state finalState : LowSt} {code : Code} {papSafeFlag : Bool} + (hadmissible : ParameterDropsAdmissible modes + (fun index => countUses index body)) + (hrun : (lowerFnBody src (compilerFuel + 1) + ⟨parameterEntries 0 modes (fun index => countUses index body), + modes.length⟩ + (parameterDrops 0 modes (fun index => countUses index body)) + world body).run state = .ok code finalState) + (hextends : ExtraExtends finalState ambient) + {sourceFunction : IxIR0.Value} + (hsaturates : ∀ {sourceArgs : List IxIR0.Value} + {sourceResult : IxIR0.Value}, + sourceArgs.length = modes.length → + SourceApplies sourceCtx sourceFunction sourceArgs sourceResult → + ∃ sourceFuel, + IxIR0.eval sourceCtx sourceFuel sourceArgs.reverse body = + .ok sourceResult) : + FnValuePreservesAt (CompilerFunctionRel sourceCtx src ambient) + sourceCtx ctx ⟨modes.length, world, papSafeFlag, code⟩ + (modes.map worldOfUses) sourceFunction targetFuel := by + let remaining : Nat → Nat := fun index => countUses index body + let input : VEnv := + ⟨parameterEntries 0 modes remaining, modes.length⟩ + let drops := parameterDrops 0 modes remaining + have hrun' : + (lowerFnBody src (compilerFuel + 1) input drops world body).run state = + .ok code finalState := by + simpa [input, drops, remaining] using hrun + simp only [lowerFnBody] at hrun' + obtain ⟨releaseResult, releaseState, hreleaseRun, hafterRelease⟩ := + trackedBindRun_ok_inv hrun' + rcases releaseResult with ⟨middle, releaseEmit⟩ + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + trackedBindRun_ok_inv hafterRelease + rcases bodyResult with ⟨output, emit, av⟩ + have hpure : + (releaseEmit ∘ emit) (.ret (av.toAtom output)) = code ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨hcode, hbodyState⟩ := hpure + subst bodyState + have hmiddleNo : NoRecSelf middle := + releaseSlots_noRecSelf input hreleaseRun (by + simpa [input, remaining] using + parameterEntries_noRecSelf 0 modes remaining modes.length) + obtain ⟨plannedMiddle, plannedEmit, hplan, htracks⟩ := + parameterDrops_releasePlan_tracked 0 modes remaining + (by simpa [remaining] using hadmissible) + have hplan' : ReleasePlan input drops plannedMiddle plannedEmit := by + simpa [input, drops] using hplan + have hplanRun : (releaseSlots input drops).run state = + .ok (plannedMiddle, plannedEmit) state := hplan'.run state + have heq : + (plannedMiddle, plannedEmit) = (middle, releaseEmit) ∧ + state = releaseState := by + simpa using hplanRun.symm.trans hreleaseRun + have hmiddle : plannedMiddle = middle := congrArg Prod.fst heq.1 + have hemit : plannedEmit = releaseEmit := congrArg Prod.snd heq.1 + subst middle + subst releaseEmit + cases heq.2 + have hconsume := lowerE_consumesEntries hbodyRun + have hcount := lowerE_preservesEntryCount hbodyRun + have hmiddleLength : plannedMiddle.entries.length = modes.length := by + calc + plannedMiddle.entries.length = input.entries.length := + hplan'.entries_length + _ = modes.length := by simp [input, remaining] + have hreleased : EntriesReleased output.entries := + hconsume.entriesReleased htracks (Eq.trans hcount hmiddleLength) + intro store store' args value sourceArgs sourceResult sourceRest rest + hlength hargs happlies hframe hown hcodeRun + have hargsLength : args.length = modes.length := by + simpa using hlength + have hsourceArgsLength : sourceArgs.length = args.length := by + simpa using hargs.length + obtain ⟨sourceFuel, hsource⟩ := hsaturates + (hsourceArgsLength.trans hargsLength) happlies + have hbodySound : LowerResultValueSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx + ⟨modes.length, world, papSafeFlag, code⟩ plannedMiddle output + sourceArgs.reverse sourceArgs.reverse sourceResult world emit av := + lowerE_run_value_sound_within_noRecSelf + (recSelfRel := recSelfRel) + (cur := (⟨modes.length, world, papSafeFlag, code⟩ : FnDef)) + henv hrepresented hcontracts hvalues hsource hbodyRun hextends + hmiddleNo + have hfull : LowerResultValueSound + (CompilerFunctionRel sourceCtx src ambient) recSelfRel ctx + ⟨modes.length, world, papSafeFlag, code⟩ input output + sourceArgs.reverse sourceArgs.reverse sourceResult world + (plannedEmit ∘ emit) av := + hbodySound.afterRelease (hplan'.valueSound sourceArgs.reverse) + have hpre : GraphOwnsVEnv + (CompilerFunctionRel sourceCtx src ambient) recSelfRel input + sourceArgs.reverse sourceRest rest store args.reverse := by + refine ⟨(rootsForWorlds (modes.map worldOfUses) args).reverse, + ?_, hframe, ?_⟩ + · simpa [input] using VEnvValueGraph.parameterEntries + (recSelfRel := recSelfRel) modes remaining hargsLength hargs hown + · exact hown.perm + ((List.reverse_perm + (rootsForWorlds (modes.map worldOfUses) args)).symm.append_right + rest) + have hcodeRun' : runCode ctx targetFuel + ⟨modes.length, world, papSafeFlag, code⟩ store args.reverse + ((plannedEmit ∘ emit) (.ret (av.toAtom output))) = + .ok (store', value) := by + rw [hcode] + exact hcodeRun + exact hfull.closeGraph hreleased sourceRest rest hpre hcodeRun' + +/-- An actual successful ordinary `lowerDecl` run satisfies the exact-fuel +semantic contract of the source definition it compiled. The public source +reference fixes the source function, while `defnSaturate` supplies the body +evaluation required by the generic function-entry adapter. -/ +theorem lowerDecl_defn_valuePreservesAt + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {ctx : Ctx} {compilerFuel targetFuel : Nat} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {address : Ixon.Address} {result : Owned} {body : IxIR0.Expr} + {state finalState : LowSt} {d : FnDef} + {sourceFunction : IxIR0.Value} + (hsrc : src address = some (.defn result body)) + (href : SourceRefValue sourceCtx address sourceFunction) + (hadmissible : ParameterDropsAdmissible (lamUses body) + (fun index => countUses index (stripLams body))) + (hrun : (lowerDecl src (compilerFuel + 1) + (address, .defn result body)).run state = + .ok (some (address, .fn d)) finalState) + (hextends : ExtraExtends finalState ambient) : + FnValuePreservesAt + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + ((lamUses body).map worldOfUses) sourceFunction targetFuel := by + simp only [lowerDecl] at hrun + obtain ⟨code, bodyState, hbodyRun, hpureRun⟩ := + trackedBindRun_ok_inv hrun + have hpure : + some (address, Decl.fn ⟨lamArity body, result, + result == .shared && papSafe body, code⟩) = + some (address, Decl.fn d) ∧ + bodyState = finalState := by + simpa using hpureRun + have hd : d = ⟨lamArity body, result, + result == .shared && papSafe body, code⟩ := by + have hp := Option.some.inj hpure.1 + exact Decl.fn.inj (Prod.mk.inj hp).2.symm + cases hpure.2 + subst d + have hlookup : sourceCtx.env address = some (.defn result body) := by + rw [henv] + exact hsrc + have hpreserves : FnValuePreservesAt + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx + ⟨(lamUses body).length, result, + result == .shared && papSafe body, code⟩ + ((lamUses body).map worldOfUses) sourceFunction targetFuel := + lowerFnBody_parameterEntries_valuePreservesAt + (recSelfRel := fun _ _ => False) + (compilerFuel := compilerFuel) (targetFuel := targetFuel) + henv hrepresented hcontracts hvalues (lamUses body) result + (stripLams body) hadmissible (by simpa using hbodyRun) hextends + (by + intro sourceArgs sourceResult hlength happlies + exact href.defnSaturate hlookup (by simpa using hlength) happlies) + have hfn : (⟨(lamUses body).length, result, + result == .shared && papSafe body, code⟩ : FnDef) = + ⟨lamArity body, result, + result == .shared && papSafe body, code⟩ := by + rw [lamUses_length] + rw [← hfn] + intro store store' args value sourceArgs sourceResult sourceRest rest + hlength hargs happlies hframe hown hcodeRun + exact hpreserves hlength hargs happlies hframe hown hcodeRun + +/-- Unbounded packaging of the ordinary declaration adapter. This theorem +does not seal the mutually recursive compiler contracts—`hvalues` is still +an explicit premise—but it removes all function-entry, cleanup, and source +saturation obligations from that eventual contractive construction. -/ +theorem lowerDecl_defn_valueContract + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {ctx : Ctx} {compilerFuel : Nat} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx) + {address : Ixon.Address} {result : Owned} {body : IxIR0.Expr} + {state finalState : LowSt} {d : FnDef} + {sourceFunction : IxIR0.Value} + (hsrc : src address = some (.defn result body)) + (href : SourceRefValue sourceCtx address sourceFunction) + (hadmissible : ParameterDropsAdmissible (lamUses body) + (fun index => countUses index (stripLams body))) + (hrun : (lowerDecl src (compilerFuel + 1) + (address, .defn result body)).run state = + .ok (some (address, .fn d)) finalState) + (hextends : ExtraExtends finalState ambient) : + FnValueContract (CompilerFunctionRel sourceCtx src ambient) + sourceCtx ctx d ((lamUses body).map worldOfUses) sourceFunction := by + have hshape : d.arity = lamArity body := by + have hrunShape := hrun + simp only [lowerDecl] at hrunShape + obtain ⟨code, bodyState, _, hpureRun⟩ := + trackedBindRun_ok_inv hrunShape + have hpure : + some (address, Decl.fn ⟨lamArity body, result, + result == .shared && papSafe body, code⟩) = + some (address, Decl.fn d) ∧ + bodyState = finalState := by + simpa using hpureRun + have hd : d = ⟨lamArity body, result, + result == .shared && papSafe body, code⟩ := by + have hp := Option.some.inj hpure.1 + exact Decl.fn.inj (Prod.mk.inj hp).2.symm + rw [hd] + refine ⟨?_, ?_⟩ + · calc + ((lamUses body).map worldOfUses).length = lamArity body := by simp + _ = d.arity := hshape.symm + · intro targetFuel + exact lowerDecl_defn_valuePreservesAt + (targetFuel := targetFuel) henv hrepresented hcontracts hvalues + hsrc href hadmissible hrun hextends + +/-! ### Whole-main value agreement -/ + +/-- Recover the exact main-body lowering run from a successful whole-program +action. Declaration traversal supplies the initial state; the trailing +`get` and `pure` leave the main body's final state unchanged. -/ +theorem lowerAllAction_main_trace + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {fuel : Nat} {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + (hrun : (lowerAllAction decls main mainWorld fuel).run initial = + .ok (targetDecls, mainCode) finalState) : + ∃ mainInitial, + (lowerFnBody (IxIR0.Env.ofList decls) fuel ⟨[], 0⟩ [] mainWorld + main).run mainInitial = .ok mainCode finalState := by + simp only [lowerAllAction] at hrun + obtain ⟨base, baseState, _, hafterBase⟩ := + trackedBindRun_ok_inv hrun + obtain ⟨compiledMain, mainState, hmain, hafterMain⟩ := + trackedBindRun_ok_inv hafterBase + obtain ⟨observed, getState, hget, hpure⟩ := + trackedBindRun_ok_inv hafterMain + have hget' : mainState = observed ∧ mainState = getState := by + simpa using hget + obtain ⟨hobserved, hgetState⟩ := hget' + subst observed + subst getState + have hpure' : + (base ++ mainState.extra, compiledMain) = + (targetDecls, mainCode) ∧ + mainState = finalState := by + simpa using hpure + have hcode : compiledMain = mainCode := congrArg Prod.snd hpure'.1 + subst mainCode + refine ⟨baseState, ?_⟩ + rw [← hpure'.2] + exact hmain + +/-- Every successful execution of an actually lowered closed main owns +exactly its declared result root. This is the ownership half of +`Reclamation`; unlike value agreement it needs no successful source run. -/ +theorem lowerAllAction_main_owned + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} {targetFuel : Nat} {targetStore : Store} + {targetValue : RVal} + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (htarget : runMain ctx mainCode targetFuel = + .ok (targetStore, targetValue)) : + RootOwnership targetStore [⟨mainWorld, targetValue⟩] := by + obtain ⟨mainInitial, hmain⟩ := lowerAllAction_main_trace hlower + cases compilerFuel with + | zero => + simp only [lowerFnBody] at hmain + exact (trackedThrowRun_not_ok hmain).elim + | succ bodyFuel => + simp only [lowerFnBody] at hmain + obtain ⟨releaseResult, releaseState, hrelease, hafterRelease⟩ := + trackedBindRun_ok_inv hmain + rcases releaseResult with ⟨middle, releaseEmit⟩ + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + trackedBindRun_ok_inv hafterRelease + rcases bodyResult with ⟨output, emit, av⟩ + have hpure : + (releaseEmit ∘ emit) (.ret (av.toAtom output)) = mainCode ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨hcode, hbodyState⟩ := hpure + subst bodyState + let input : VEnv := ⟨[], 0⟩ + have hplan : ReleasePlan input [] input (_root_.id : Emit) := .nil + have hplanRun : (releaseSlots input []).run mainInitial = + .ok (input, (_root_.id : Emit)) mainInitial := + hplan.run mainInitial + have heq : + (input, (_root_.id : Emit)) = (middle, releaseEmit) ∧ + mainInitial = releaseState := by + simpa [input] using hplanRun.symm.trans hrelease + have hmiddle : input = middle := congrArg Prod.fst heq.1 + have hemitting : (_root_.id : Emit) = releaseEmit := + congrArg Prod.snd heq.1 + subst middle + subst releaseEmit + cases heq.2 + let cur : FnDef := ⟨0, .shared, false, mainCode⟩ + have hbodySound : LowerResultSoundBelow ctx cur targetFuel input output + mainWorld emit av := + (lowerClusterPreservesBelow (cur := cur) + (hcontracts.apply.below targetFuel) + (hcontracts.decls.below targetFuel) bodyFuel).expr + hbodyRun hrepresented + (SelfAvailableBelow.of_noRecSelf + (by intro index arity hentry; simp [input] at hentry)) + have hfull : LowerResultSoundBelow ctx cur targetFuel input output + mainWorld ((_root_.id : Emit) ∘ emit) av := + hbodySound.afterRelease hplan.soundBelow + have hcount := lowerE_preservesEntryCount hbodyRun + have houtputEntries : output.entries = [] := by + apply List.eq_nil_of_length_eq_zero + simpa [EntryCountPreserved, input] using hcount + have hreleased : EntriesReleased output.entries := by + rw [houtputEntries] + exact .nil + have hpre : OwnsVEnv input [] ({} : Store) [] := by + refine ⟨[], ?_, ?_⟩ + · exact ⟨by simp [input], EntriesRealize.nil⟩ + · simpa using RootOwnership.empty + have htarget' : runCode ctx targetFuel cur ({} : Store) [] + (((_root_.id : Emit) ∘ emit) (.ret (av.toAtom output))) = + .ok (targetStore, targetValue) := by + unfold runMain at htarget + change runCode ctx targetFuel cur ({} : Store) [] mainCode = + .ok (targetStore, targetValue) at htarget + rw [hcode] + exact htarget + exact hfull.close hreleased [] (Nat.le_refl _) hpre htarget' + +/-- Generic value agreement for the compiled whole-program main. The theorem +deliberately accepts a successful target execution: proving that such an +execution exists for every successful source run is the separate progress +obligation (`MemoryErrorUnreachable` and ordinary-stuck exclusion). -/ +theorem lowerAllAction_main_value_graph + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} {sourceFuel targetFuel : Nat} + {sourceValue : IxIR0.Value} {targetStore : Store} + {targetValue : RVal} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hsource : IxIR0.eval sourceCtx sourceFuel [] main = .ok sourceValue) + (htarget : runMain ctx mainCode targetFuel = + .ok (targetStore, targetValue)) : + Sim.ValueGraph + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + targetStore sourceValue targetValue := by + obtain ⟨mainInitial, hmain⟩ := lowerAllAction_main_trace hlower + cases compilerFuel with + | zero => + simp only [lowerFnBody] at hmain + exact (trackedThrowRun_not_ok hmain).elim + | succ bodyFuel => + simp only [lowerFnBody] at hmain + obtain ⟨releaseResult, releaseState, hrelease, hafterRelease⟩ := + trackedBindRun_ok_inv hmain + rcases releaseResult with ⟨middle, releaseEmit⟩ + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + trackedBindRun_ok_inv hafterRelease + rcases bodyResult with ⟨output, emit, av⟩ + have hpure : + (releaseEmit ∘ emit) (.ret (av.toAtom output)) = mainCode ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨hcode, hbodyState⟩ := hpure + subst bodyState + let input : VEnv := ⟨[], 0⟩ + have hplan : ReleasePlan input [] input (_root_.id : Emit) := by + exact .nil + have hplanRun : (releaseSlots input []).run mainInitial = + .ok (input, (_root_.id : Emit)) mainInitial := + hplan.run mainInitial + have heq : + (input, (_root_.id : Emit)) = (middle, releaseEmit) ∧ + mainInitial = releaseState := by + simpa [input] using hplanRun.symm.trans hrelease + have hmiddle : input = middle := congrArg Prod.fst heq.1 + have hemitting : (_root_.id : Emit) = releaseEmit := + congrArg Prod.snd heq.1 + subst middle + subst releaseEmit + cases heq.2 + let cur : FnDef := ⟨0, .shared, false, mainCode⟩ + have hbodySound : LowerResultValueSound + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + (fun _ _ => False) ctx cur input output [] [] sourceValue + mainWorld emit av := + lowerE_run_value_sound_within_noRecSelf + (recSelfRel := fun _ _ => False) (cur := cur) henv hrepresented + hcontracts hvalues hsource hbodyRun (ExtraExtends.refl _) + (by intro index arity hentry; simp [input] at hentry) + have hfull : LowerResultValueSound + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + (fun _ _ => False) ctx cur input output [] [] sourceValue + mainWorld ((_root_.id : Emit) ∘ emit) av := + hbodySound.afterRelease (hplan.valueSound []) + have hcount := lowerE_preservesEntryCount hbodyRun + have houtputEntries : output.entries = [] := by + apply List.eq_nil_of_length_eq_zero + simpa [EntryCountPreserved, input] using hcount + have hreleased : EntriesReleased output.entries := by + rw [houtputEntries] + exact .nil + have hpre : GraphOwnsVEnv + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + (fun _ _ => False) input [] [] [] ({} : Store) [] := by + refine ⟨[], ?_, Sim.RootsGraph.nil, RootOwnership.empty⟩ + exact ⟨by simp [input], EntriesValueGraph.nil⟩ + have htarget' : runCode ctx targetFuel cur ({} : Store) [] + (((_root_.id : Emit) ∘ emit) (.ret (av.toAtom output))) = + .ok (targetStore, targetValue) := by + unfold runMain at htarget + change runCode ctx targetFuel cur ({} : Store) [] mainCode = + .ok (targetStore, targetValue) at htarget + rw [hcode] + exact htarget + exact (hfull.closeGraph hreleased [] [] hpre htarget').1 + +/-- Lift whole-main value agreement to the public forward-simulation +proposition once target progress is supplied independently. This statement +makes the remaining split explicit: compiler value contracts establish +agreement, while the progress premise establishes existence of a successful +target run. -/ +theorem lowerAllAction_semanticForwardSimulation_of_targetProgress + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hvalues : CompilerValueContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx) + (hprogress : ∀ {sourceFuel sourceValue}, + IxIR0.eval sourceCtx sourceFuel [] main = .ok sourceValue → + ∃ targetFuel targetStore targetValue, + runMain ctx mainCode targetFuel = .ok (targetStore, targetValue)) : + SemanticForwardSimulation sourceCtx ctx main mainCode + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) + finalState) := by + intro sourceFuel sourceValue hsource + obtain ⟨targetFuel, targetStore, targetValue, htarget⟩ := + hprogress hsource + refine ⟨targetFuel, targetStore, targetValue, htarget, ?_⟩ + exact lowerAllAction_main_value_graph henv hlower hrepresented + hcontracts hvalues hsource htarget + +/-- Ordinary generated bodies need no current-self assumption: successful +lowering from a self-free logical environment is covered directly by the +closed compiler-fuel cluster. -/ +theorem lowerE_run_sound_below_noRecSelf + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + (happly : ApplyOwnershipContractBelow ctx limit) + (hdecls : SourceDeclContractsBelow src ctx limit) + {fuel : Nat} {input output : VEnv} {world : Owned} + {expr : IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hrun : (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (hno : NoRecSelf input) : + LowerResultSoundBelow ctx cur limit input output world emit av := + (lowerClusterPreservesBelow (cur := cur) happly hdecls fuel).expr + hrun hrepresented (SelfAvailableBelow.of_noRecSelf hno) + +/-- Recursor-rule bodies use the same closed cluster with the substantive +current-function contract supplied by the generated recursor environment. -/ +theorem lowerE_run_sound_below_currentSelf + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + (happly : ApplyOwnershipContractBelow ctx limit) + (hdecls : SourceDeclContractsBelow src ctx limit) + {fuel : Nat} {input output : VEnv} {world : Owned} + {expr : IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {av : AVal} + (hrun : (lowerE src fuel input world expr).run state = + .ok (output, emit, av) finalState) + (hrepresented : ExtraRepresented ctx finalState) + (hself : CurrentSelfContractBelow ctx cur limit) : + LowerResultSoundBelow ctx cur limit input output world emit av := + (lowerClusterPreservesBelow (cur := cur) happly hdecls fuel).expr + hrun hrepresented (SelfAvailableBelow.of_contract hself) + +/-- A successful recursor-rule RHS run closes all ordinary logical entries +while preserving the trailing recursive-self marker. This discharges the +state-side premise consumed by the generated alternative theorem. -/ +theorem lowerRecursorRule_rhs_sound_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + (happly : ApplyOwnershipContractBelow ctx limit) + (hdecls : SourceDeclContractsBelow src ctx limit) + (hself : CurrentSelfContractBelow ctx cur limit) + {fuel numArgs : Nat} {rule : IxIR0.RecRule} + {state finalState : LowSt} + {fieldOutput rhsInput output : VEnv} + {fieldEmit parameterEmit bodyEmit : Emit} {av : AVal} + (hfieldRun : + applyRecursorFieldRetains + ⟨List.replicate rule.fields (.slot 0 0 .many false), + (numArgs + 1) + rule.fields⟩ + (recursorFieldRetains (numArgs + 1) rule.rhs rule.fields) = + (fieldOutput, fieldEmit)) + (hparameterRun : + (releaseSlots + ⟨fieldOutput.entries ++ + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (rule.fields + i) rule.rhs) ++ + [.recSelf (numArgs + 1)], + fieldOutput.depth + 1⟩ + ((parameterDrops 0 (List.replicate numArgs .many) + (fun i => countUses (rule.fields + i) rule.rhs)).map + (SlotDrop.offsetEntry rule.fields))).run state = + .ok (rhsInput, parameterEmit) state) + (hbodyRun : (lowerE src fuel rhsInput .shared rule.rhs).run state = + .ok (output, bodyEmit, av) finalState) + (hrepresented : ExtraRepresented ctx finalState) : + LowerResultSoundBelow ctx cur limit rhsInput output .shared + bodyEmit av ∧ + EntriesReleased output.entries := by + obtain ⟨htracks, hinputLength, hinputSelf⟩ := + recursorPrefix_entries_tracked numArgs rule.fields rule.rhs state + hfieldRun hparameterRun + have hsound := lowerE_run_sound_below_currentSelf + happly hdecls hbodyRun hrepresented hself + have hconsume := lowerE_consumesEntries hbodyRun + have hcount := lowerE_preservesEntryCount hbodyRun + have houtputLength : + output.entries.length = rule.fields + numArgs + 1 := + Eq.trans hcount hinputLength + have houtputSelf : + RecSelfAt output (rule.fields + numArgs) (numArgs + 1) := + lowerE_recSelfAt hbodyRun hinputSelf + exact ⟨hsound, + hconsume.entriesReleasedWithRecSelf htracks houtputLength houtputSelf⟩ + +/-- Determinism of the generated prefix turns one concrete successful RHS +run into the universally quantified body premise expected by +`lowerRecursorRule_generated_verified_below`. -/ +theorem recursorRuleBodySoundBelow_of_run + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + (happly : ApplyOwnershipContractBelow ctx limit) + (hdecls : SourceDeclContractsBelow src ctx limit) + (hself : CurrentSelfContractBelow ctx cur limit) + {fuel numArgs : Nat} {rule : IxIR0.RecRule} + {state finalState : LowSt} + {canonicalFieldOutput canonicalRhsInput output : VEnv} + {canonicalFieldEmit canonicalParameterEmit bodyEmit : Emit} + {av : AVal} + (hfieldRun : + applyRecursorFieldRetains + ⟨List.replicate rule.fields (.slot 0 0 .many false), + (numArgs + 1) + rule.fields⟩ + (recursorFieldRetains (numArgs + 1) rule.rhs rule.fields) = + (canonicalFieldOutput, canonicalFieldEmit)) + (hparameterRun : + (releaseSlots + ⟨canonicalFieldOutput.entries ++ + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (rule.fields + i) rule.rhs) ++ + [.recSelf (numArgs + 1)], + canonicalFieldOutput.depth + 1⟩ + ((parameterDrops 0 (List.replicate numArgs .many) + (fun i => countUses (rule.fields + i) rule.rhs)).map + (SlotDrop.offsetEntry rule.fields))).run state = + .ok (canonicalRhsInput, canonicalParameterEmit) state) + (hbodyRun : + (lowerE src fuel canonicalRhsInput .shared rule.rhs).run state = + .ok (output, bodyEmit, av) finalState) + (hrepresented : ExtraRepresented ctx finalState) : + RecursorRuleBodySoundBelow ctx cur limit src fuel numArgs rule state := by + intro fieldOutput fieldEmit rhsInput parameterEmit + hfieldRun' hparameterRun' + have hfieldPair : + (fieldOutput, fieldEmit) = + (canonicalFieldOutput, canonicalFieldEmit) := + hfieldRun'.symm.trans hfieldRun + have hfieldOutput : fieldOutput = canonicalFieldOutput := + congrArg Prod.fst hfieldPair + subst fieldOutput + have hparameterPair : + (rhsInput, parameterEmit) = + (canonicalRhsInput, canonicalParameterEmit) ∧ state = state := by + simpa using hparameterRun'.symm.trans hparameterRun + have hrhsInput : rhsInput = canonicalRhsInput := + congrArg Prod.fst hparameterPair.1 + subst rhsInput + obtain ⟨hsound, hreleased⟩ := lowerRecursorRule_rhs_sound_below + happly hdecls hself hfieldRun hparameterRun hbodyRun hrepresented + exact ⟨output, bodyEmit, av, finalState, + hbodyRun, hsound, hreleased⟩ + +/-- Actual successful lowering of one recursor rule produces a bounded +ownership-safe alternative; all generated-prefix and RHS cleanup obligations +are reconstructed from the run itself. -/ +theorem lowerRecursorRule_preservesAlt_below + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + (happly : ApplyOwnershipContractBelow ctx limit) + (hdecls : SourceDeclContractsBelow src ctx limit) + (hself : CurrentSelfContractBelow ctx cur limit) + (hresult : cur.result = .shared) + {fuel numArgs : Nat} {rule : IxIR0.RecRule} {tag : Nat} + {state finalState : LowSt} {alt : Alt} + (hrun : (lowerRecursorRule src fuel numArgs (rule, tag)).run state = + .ok alt finalState) + (hrepresented : ExtraRepresented ctx finalState) : + AltOwnershipContractBelow ctx cur alt .shared + (RecursorEntryValid numArgs) recursorEntryRoots limit := by + obtain ⟨fieldOutput, fieldEmit, rhsInput, parameterEmit, + hfieldRun, hparameterRun, _⟩ := + recursorPrefix_generated_verified_below (ctx := ctx) (cur := cur) + limit numArgs rule.fields rule.rhs state + have hparameterRun' : + (releaseSlots + ⟨fieldOutput.entries ++ + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (rule.fields + i) rule.rhs) ++ + [.recSelf (numArgs + 1)], + fieldOutput.depth + 1⟩ + ((parameterDrops 0 (List.replicate numArgs .many) + (fun i => countUses (rule.fields + i) rule.rhs)).map + (SlotDrop.offsetEntry rule.fields))).run state = + .ok (rhsInput, parameterEmit) state := by + simpa [List.append_assoc] using hparameterRun + have horiginalRun := hrun + simp only [lowerRecursorRule] at hrun + rw [hfieldRun] at hrun + simp only at hrun + obtain ⟨releaseResult, releaseState, hreleaseRun, hafterRelease⟩ := + trackedBindRun_ok_inv hrun + rcases releaseResult with ⟨actualRhsInput, actualParameterEmit⟩ + have hreleaseEq : + (rhsInput, parameterEmit) = + (actualRhsInput, actualParameterEmit) ∧ state = releaseState := by + simpa [VEnv.bump, List.append_assoc] using + hparameterRun'.symm.trans hreleaseRun + have hrhsInput : rhsInput = actualRhsInput := + congrArg Prod.fst hreleaseEq.1 + have hparameterEmit : parameterEmit = actualParameterEmit := + congrArg Prod.snd hreleaseEq.1 + have hreleaseState : state = releaseState := hreleaseEq.2 + subst actualRhsInput + subst actualParameterEmit + subst releaseState + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + trackedBindRun_ok_inv hafterRelease + rcases bodyResult with ⟨output, bodyEmit, av⟩ + have hpure : + Alt.mk tag rule.fields + (fieldEmit + (emitOp (.drop (.var (fieldOutput.rel numArgs))) + (parameterEmit + (bodyEmit (.ret (av.toAtom output)))))) = alt ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨halt, hstate⟩ := hpure + subst bodyState + have hbody : RecursorRuleBodySoundBelow + ctx cur limit src fuel numArgs rule state := + recursorRuleBodySoundBelow_of_run + happly hdecls hself hfieldRun hparameterRun' hbodyRun hrepresented + obtain ⟨generatedFinalState, generatedAlt, + hgeneratedRun, hcontract⟩ := + lowerRecursorRule_generated_verified_below + hresult src fuel numArgs rule tag state hbody + have hrunEq : alt = generatedAlt ∧ finalState = generatedFinalState := by + simpa using horiginalRun.symm.trans hgeneratedRun + rw [hrunEq.1] + exact hcontract + +/-- Reconstruct the bounded proof-relevant rule plan from the compiler's +actual successful `mapM` traversal. Final generated-state representation is +transported backward along each tail before proving its head alternative. -/ +theorem recursorRulesPlanBelow_of_run + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + (happly : ApplyOwnershipContractBelow ctx limit) + (hdecls : SourceDeclContractsBelow src ctx limit) + (hself : CurrentSelfContractBelow ctx cur limit) + (hresult : cur.result = .shared) + (fuel numArgs : Nat) : + ∀ {rules : List (IxIR0.RecRule × Nat)} + {state finalState : LowSt} {alts : List Alt}, + (rules.mapM (lowerRecursorRule src fuel numArgs)).run state = + .ok alts finalState → + ExtraRepresented ctx finalState → + RecursorRulesPlanBelow ctx cur limit src fuel numArgs + state rules finalState alts := by + intro rules + induction rules with + | nil => + intro state finalState alts hrun _ + have hpure : ([] : List Alt) = alts ∧ state = finalState := by + simpa using hrun + obtain ⟨halts, hstate⟩ := hpure + subst alts + subst finalState + exact RecursorRulesPlanBelow.nil state + | cons ruleTag rules ih => + intro state finalState alts hrun hrepresented + rcases ruleTag with ⟨rule, tag⟩ + simp only [List.mapM_cons] at hrun + obtain ⟨headAlt, middleState, hheadRun, hafterHead⟩ := + trackedBindRun_ok_inv hrun + obtain ⟨tailAlts, tailState, htailRun, hafterTail⟩ := + trackedBindRun_ok_inv hafterHead + have hpure : headAlt :: tailAlts = alts ∧ + tailState = finalState := by + simpa using hafterTail + obtain ⟨halts, hstate⟩ := hpure + subst alts + subst finalState + have htailExtends : ExtraExtends middleState tailState := + (ExtraMonotone.listMapM + (lowerRecursorRule src fuel numArgs) + (lowerRecursorRule_extraMonotone src fuel numArgs) rules) htailRun + have hmiddleRepresented : ExtraRepresented ctx middleState := + hrepresented.of_extends htailExtends + have hheadContract : AltOwnershipContractBelow ctx cur headAlt .shared + (RecursorEntryValid numArgs) recursorEntryRoots limit := + lowerRecursorRule_preservesAlt_below + happly hdecls hself hresult hheadRun hmiddleRepresented + exact RecursorRulesPlanBelow.cons hheadRun hheadContract + (ih htailRun hrepresented) + +/-- Invert one successful generated-rule lowering into the two exact prefix +plans and the concrete semantic RHS run. The static retain/release plans +also prove that neither prefix phase changes the compiler state. -/ +theorem lowerRecursorRule_run_plan_inv + {src : IxIR0.Env} {fuel numArgs : Nat} + {rule : IxIR0.RecRule} {tag : Nat} + {state finalState : LowSt} {alt : Alt} + (hrun : (lowerRecursorRule src fuel numArgs (rule, tag)).run state = + .ok alt finalState) : + ∃ fieldOutput fieldEmit rhsInput parameterEmit + output bodyEmit av, + FieldRetainPlan + ⟨List.replicate rule.fields (.slot 0 0 .many false), + (numArgs + 1) + rule.fields⟩ + (recursorFieldRetains (numArgs + 1) rule.rhs rule.fields) + fieldOutput fieldEmit ∧ + ReleasePlan + ⟨fieldOutput.entries ++ + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (rule.fields + i) rule.rhs) ++ + [.recSelf (numArgs + 1)], + fieldOutput.depth + 1⟩ + ((parameterDrops 0 (List.replicate numArgs .many) + (fun i => countUses (rule.fields + i) rule.rhs)).map + (SlotDrop.offsetEntry rule.fields)) + rhsInput parameterEmit ∧ + (lowerE src fuel rhsInput .shared rule.rhs).run state = + .ok (output, bodyEmit, av) finalState ∧ + alt = .mk tag rule.fields + (fieldEmit + (emitOp (.drop (.var (fieldOutput.rel numArgs))) + (parameterEmit + (bodyEmit (.ret (av.toAtom output)))))) := by + obtain ⟨fieldOutput, fieldEmit, hfieldPlan⟩ := + recursorFieldRetains_plan (numArgs + 1) + ((numArgs + 1) + rule.fields) rule.fields rule.rhs + have hfieldLength : fieldOutput.entries.length = rule.fields := by + calc + fieldOutput.entries.length = + (⟨List.replicate rule.fields (.slot 0 0 .many false), + (numArgs + 1) + rule.fields⟩ : VEnv).entries.length := + hfieldPlan.entries_length + _ = rule.fields := by simp + obtain ⟨rhsInput, parameterEmit, hparameterPlan⟩ := + recursorParameterDrops_releasePlan numArgs rule.fields + (fieldOutput.depth + 1) rule.rhs fieldOutput.entries hfieldLength + have hfieldRun := hfieldPlan.run + have horiginal := hrun + simp only [lowerRecursorRule] at hrun + rw [hfieldRun] at hrun + simp only at hrun + obtain ⟨releaseResult, releaseState, hreleaseRun, hafterRelease⟩ := + trackedBindRun_ok_inv hrun + rcases releaseResult with ⟨actualRhsInput, actualParameterEmit⟩ + have hparameterRun := hparameterPlan.run state + have hreleaseEq : + (rhsInput, parameterEmit) = + (actualRhsInput, actualParameterEmit) ∧ + state = releaseState := by + simpa [VEnv.bump, List.append_assoc] using + hparameterRun.symm.trans hreleaseRun + obtain ⟨hrhsInput, hreleaseState⟩ := hreleaseEq + have hparameterEmit : parameterEmit = actualParameterEmit := + congrArg Prod.snd hrhsInput + have hrhsInputOnly : rhsInput = actualRhsInput := + congrArg Prod.fst hrhsInput + subst actualRhsInput + subst actualParameterEmit + subst releaseState + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + trackedBindRun_ok_inv hafterRelease + rcases bodyResult with ⟨output, bodyEmit, av⟩ + have hpure : + Alt.mk tag rule.fields + (fieldEmit + (emitOp (.drop (.var (fieldOutput.rel numArgs))) + (parameterEmit + (bodyEmit (.ret (av.toAtom output)))))) = alt ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨halt, hbodyState⟩ := hpure + subst bodyState + exact ⟨fieldOutput, fieldEmit, rhsInput, parameterEmit, + output, bodyEmit, av, hfieldPlan, + by simpa [List.append_assoc] using hparameterPlan, + hbodyRun, halt.symm⟩ + +/-- Invert a successful target alternative selection all the way back to +the indexed source rule that generated it. Besides the exact rule lookup, +the result retains both executable prefix plans, the semantic RHS run, and +the remaining state-threaded traversal after the selected rule. -/ +theorem RecursorRulesPlanBelow.find?_run_plan_inv + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel numArgs : Nat} {state finalState : LowSt} + {rules : Array IxIR0.RecRule} {alts : List Alt} + (hplan : RecursorRulesPlanBelow ctx cur limit src fuel numArgs + state rules.toList.zipIdx finalState alts) + {cidx selectedTag fieldCount : Nat} {body : Code} + (hfind : alts.toArray.find? (fun alt => alt.cidx == cidx) = + some (.mk selectedTag fieldCount body)) : + ∃ rule headState nextState tailRules tailAlts + fieldOutput fieldEmit rhsInput parameterEmit + output bodyEmit av, + rules[cidx]? = some rule ∧ + selectedTag = cidx ∧ + fieldCount = rule.fields ∧ + FieldRetainPlan + ⟨List.replicate rule.fields (.slot 0 0 .many false), + (numArgs + 1) + rule.fields⟩ + (recursorFieldRetains (numArgs + 1) rule.rhs rule.fields) + fieldOutput fieldEmit ∧ + ReleasePlan + ⟨fieldOutput.entries ++ + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (rule.fields + i) rule.rhs) ++ + [.recSelf (numArgs + 1)], + fieldOutput.depth + 1⟩ + ((parameterDrops 0 (List.replicate numArgs .many) + (fun i => countUses (rule.fields + i) rule.rhs)).map + (SlotDrop.offsetEntry rule.fields)) + rhsInput parameterEmit ∧ + (lowerE src fuel rhsInput .shared rule.rhs).run headState = + .ok (output, bodyEmit, av) nextState ∧ + body = fieldEmit + (emitOp (.drop (.var (fieldOutput.rel numArgs))) + (parameterEmit + (bodyEmit (.ret (av.toAtom output))))) ∧ + RecursorRulesPlanBelow ctx cur limit src fuel numArgs + nextState tailRules finalState tailAlts := by + have hmember : (.mk selectedTag fieldCount body : Alt) ∈ alts := by + simpa using Array.mem_of_find?_eq_some hfind + obtain ⟨rule, tag, headState, nextState, tailRules, tailAlts, + hsourceMember, hheadRun, htailPlan⟩ := + hplan.trace_mem (.mk selectedTag fieldCount body) hmember + obtain ⟨fieldOutput, fieldEmit, rhsInput, parameterEmit, + output, bodyEmit, av, hfieldPlan, hparameterPlan, + hbodyRun, halt⟩ := + lowerRecursorRule_run_plan_inv hheadRun + have hselectedTag : selectedTag = cidx := by + have hmatch := Array.find?_some + (p := fun alt : Alt => alt.cidx == cidx) + (a := .mk selectedTag fieldCount body) + (xs := alts.toArray) hfind + exact beq_iff_eq.mp hmatch + have htag : selectedTag = tag := by + injection halt + have hfieldCount : fieldCount = rule.fields := by + injection halt + have hbody : body = fieldEmit + (emitOp (.drop (.var (fieldOutput.rel numArgs))) + (parameterEmit + (bodyEmit (.ret (av.toAtom output))))) := by + injection halt + have htagCidx : tag = cidx := htag.symm.trans hselectedTag + obtain ⟨_, htagBound, hruleElem⟩ := + List.mem_zipIdx hsourceMember + have htagLt : tag < rules.toList.length := by + simpa using htagBound + have hruleTag : rules[tag]? = some rule := by + rw [← Array.getElem?_toList] + rw [List.getElem?_eq_getElem htagLt] + exact congrArg some hruleElem.symm + have hrule : rules[cidx]? = some rule := by + rwa [← htagCidx] + exact ⟨rule, headState, nextState, tailRules, tailAlts, + fieldOutput, fieldEmit, rhsInput, parameterEmit, + output, bodyEmit, av, hrule, hselectedTag, hfieldCount, + hfieldPlan, hparameterPlan, hbodyRun, hbody, htailPlan⟩ + +/-- Execute the exact generated prefix and RHS for one selected recursor +rule while transporting the source result and the caller's framed graphs. +This is independent of how the case dispatcher represented the major; the +caller supplies the corresponding source/target field graph and field-world +facts. -/ +theorem lowerRecursorRule_branch_value_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {recSelfRel : RecSelfRel} {ctx : Ctx} {cur : FnDef} {limit : Nat} + {fuel numArgs : Nat} {rule : IxIR0.RecRule} + {headState nextState : LowSt} + {fieldOutput rhsInput output : VEnv} + {fieldEmit parameterEmit bodyEmit : Emit} {av : AVal} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + (hself : CurrentSelfValueContractBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + cur limit) + (hfieldPlan : FieldRetainPlan + ⟨List.replicate rule.fields (.slot 0 0 .many false), + (numArgs + 1) + rule.fields⟩ + (recursorFieldRetains (numArgs + 1) rule.rhs rule.fields) + fieldOutput fieldEmit) + (hparameterPlan : ReleasePlan + ⟨fieldOutput.entries ++ + parameterEntries 0 (List.replicate numArgs .many) + (fun i => countUses (rule.fields + i) rule.rhs) ++ + [.recSelf (numArgs + 1)], + fieldOutput.depth + 1⟩ + ((parameterDrops 0 (List.replicate numArgs .many) + (fun i => countUses (rule.fields + i) rule.rhs)).map + (SlotDrop.offsetEntry rule.fields)) + rhsInput parameterEmit) + (hbodyRun : (lowerE src fuel rhsInput .shared rule.rhs).run headState = + .ok (output, bodyEmit, av) nextState) + (hextends : ExtraExtends nextState ambient) + {sourcePre : List IxIR0.Value} {pre : List RVal} + {sourceFields : List IxIR0.Value} {fields : List RVal} + {sourceSelf sourceValue : IxIR0.Value} {major : RVal} + {sourceFuel : Nat} + (hsource : IxIR0.eval sourceCtx sourceFuel + (sourceFields.reverse ++ sourcePre.reverse ++ [sourceSelf]) + rule.rhs = .ok sourceValue) + (hpreLength : pre.length = numArgs) + (hfieldsLength : fields.length = rule.fields) + {store store' : Store} {value : RVal} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hpreGraphs : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store sourcePre pre) + (hfieldGraphs : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store sourceFields fields) + (hsourceSelf : recSelfRel sourceSelf (numArgs + 1)) + (hframe : Sim.RootsGraph + (CompilerFunctionRel sourceCtx src ambient) store sourceRest rest) + (hown : RootOwnership store + (rootsFor .shared (pre ++ [major]) ++ rest)) + (hfieldWorld : ∀ field ∈ fields, HasWorld store .shared field) + {branchFuel : Nat} (hbound : branchFuel ≤ limit) + (hbranchRun : runCode ctx branchFuel cur store + (fields.reverse ++ major :: pre.reverse) + (fieldEmit + (emitOp (.drop (.var (fieldOutput.rel numArgs))) + (parameterEmit + (bodyEmit (.ret (av.toAtom output)))))) = + .ok (store', value)) : + Sim.ValueGraph (CompilerFunctionRel sourceCtx src ambient) store' + sourceValue value ∧ + Sim.RootsGraph (CompilerFunctionRel sourceCtx src ambient) store' + sourceRest rest := by + have hentry := recursorAltEntry_value_state + (funRel := CompilerFunctionRel sourceCtx src ambient) + (recSelfRel := recSelfRel) numArgs rule.fields rule.rhs + hpreLength hfieldsLength hpreGraphs hfieldGraphs hsourceSelf hframe hown + hfieldWorld + have hprefix := recursorPrefixPlans_valueSoundBelow + (funRel := CompilerFunctionRel sourceCtx src ambient) + (recSelfRel := recSelfRel) (ctx := ctx) (cur := cur) (limit := limit) + numArgs rule.fields rule.rhs hfieldPlan hparameterPlan + (sourceFields.reverse ++ sourcePre.reverse ++ [sourceSelf]) + sourceRest rest major fields + have hbodySound := lowerE_run_value_sound_within_currentSelf_below + henv hrepresented hcontracts hvalues hsource hbodyRun hextends hself + have hnextRepresented : ExtraRepresented ctx nextState := + hrepresented.of_extends hextends + have hownershipSelf : CurrentSelfContractBelow ctx cur limit := + ⟨hself.result, hself.ownership⟩ + have hfieldRun := hfieldPlan.run + have hparameterRun := hparameterPlan.run headState + obtain ⟨_, hreleased⟩ := lowerRecursorRule_rhs_sound_below + (hcontracts.below limit).apply (hcontracts.below limit).decls + hownershipSelf hfieldRun hparameterRun hbodyRun hnextRepresented + have hbodyCode : CodeOwnsBelow ctx cur limit + (GraphOwnsVEnv (CompilerFunctionRel sourceCtx src ambient) + recSelfRel rhsInput + (sourceFields.reverse ++ sourcePre.reverse ++ [sourceSelf]) + sourceRest rest) + (fun resultStore resultValue => + Sim.ValueGraph (CompilerFunctionRel sourceCtx src ambient) + resultStore sourceValue resultValue ∧ + Sim.RootsGraph (CompilerFunctionRel sourceCtx src ambient) + resultStore sourceRest rest) + (bodyEmit (.ret (av.toAtom output))) := + hbodySound.closeGraph hreleased sourceRest rest + exact hprefix limit (Nat.le_refl limit) + (fun resultStore resultValue => + Sim.ValueGraph (CompilerFunctionRel sourceCtx src ambient) + resultStore sourceValue resultValue ∧ + Sim.RootsGraph (CompilerFunctionRel sourceCtx src ambient) + resultStore sourceRest rest) + (bodyEmit (.ret (av.toAtom output))) hbodyCode + (fuel := branchFuel) (store := store) + (env := fields.reverse ++ major :: pre.reverse) + (store' := store') (value := value) hbound hentry + (by simpa [Function.comp_def] using hbranchRun) + +private theorem lowerStateSimExceptBindOk {error α β : Type} + (value : α) (next : α → Except error β) : + (Except.ok value >>= next) = next value := rfl + +/-- Actual successful lowering of an entire recursor reconstructs the rule +plan and yields its exact-index function ownership theorem. -/ +theorem lowerRecursor_preservesAt + {ctx : Ctx} {limit : Nat} {src : IxIR0.Env} + (happly : ApplyOwnershipContractBelow ctx limit) + (hdecls : SourceDeclContractsBelow src ctx limit) + {fuel numArgs : Nat} {natLit : Bool} + {rules : Array IxIR0.RecRule} {state finalState : LowSt} {d : FnDef} + (hself : CurrentSelfContractBelow ctx d limit) + (hrun : (lowerRecursor src fuel numArgs natLit rules).run state = + .ok d finalState) + (hrepresented : ExtraRepresented ctx finalState) : + FnOwnershipPreservesAt ctx d + (List.replicate (numArgs + 1) .shared) limit := by + simp only [lowerRecursor] at hrun + obtain ⟨alts, rulesState, hrulesRun, hafterRules⟩ := + trackedBindRun_ok_inv hrun + have hpure : + (⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩ : FnDef) = d ∧ + rulesState = finalState := by + simpa using hafterRules + obtain ⟨hd, hstate⟩ := hpure + subst d + subst rulesState + have hplan : RecursorRulesPlanBelow ctx + ⟨numArgs + 1, .shared, true, .case (.var 0) natLit alts.toArray⟩ + limit src fuel numArgs state rules.toList.zipIdx finalState alts := + recursorRulesPlanBelow_of_run happly hdecls hself rfl + fuel numArgs hrulesRun hrepresented + have hverified : + (lowerRecursor src fuel numArgs natLit rules).run state = + .ok ⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩ finalState ∧ + FnOwnershipPreservesAt ctx + ⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩ + (List.replicate (numArgs + 1) .shared) limit := + lowerRecursor_generated_verified_below + limit src fuel numArgs natLit rules state finalState alts + ⟨numArgs + 1, .shared, true, .case (.var 0) natLit alts.toArray⟩ + rfl hplan + have hpreserves : FnOwnershipPreservesAt ctx + ⟨numArgs + 1, .shared, true, .case (.var 0) natLit alts.toArray⟩ + (List.replicate (numArgs + 1) .shared) limit := hverified.2 + intro store store' args value rest hlength hown hcodeRun + exact hpreserves hlength hown hcodeRun + +/-- Exact-fuel semantic preservation for a successfully generated source +recursor. Source saturation identifies the chosen rule and its evaluator +environment; target case dispatch is then joined to the exact generated +prefix/RHS trace for that same indexed rule. -/ +theorem lowerRecursor_valuePreservesAt_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {ctx : Ctx} {limit compilerFuel numArgs : Nat} + {natLit : Bool} {rules : Array IxIR0.RecRule} + {address : Ixon.Address} {sourceFunction : IxIR0.Value} + {state finalState : LowSt} {d : FnDef} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + (hsrc : src address = some (.recursor numArgs natLit rules)) + (hdecl : ctx.decls address = some (.fn d)) + (href : SourceRefValue sourceCtx address sourceFunction) + (hrun : (lowerRecursor src compilerFuel numArgs natLit rules).run state = + .ok d finalState) + (hextends : ExtraExtends finalState ambient) : + FnValuePreservesAt (CompilerFunctionRel sourceCtx src ambient) + sourceCtx ctx d (List.replicate (numArgs + 1) .shared) + sourceFunction limit := by + simp only [lowerRecursor] at hrun + obtain ⟨alts, rulesState, hrulesRun, hafterRules⟩ := + trackedBindRun_ok_inv hrun + have hpure : + (⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩ : FnDef) = d ∧ + rulesState = finalState := by + simpa using hafterRules + obtain ⟨hd, hstate⟩ := hpure + subst d + subst rulesState + have hsourceLookup : sourceCtx.env address = + some (.recursor numArgs natLit rules) := by + rw [henv] + exact hsrc + have hsourceFunction := href.recursorValue hsourceLookup + subst sourceFunction + let recSelfRel : RecSelfRel := fun value arity => + value = .pap (.rec_ address (numArgs + 1)) [] ∧ + arity = numArgs + 1 + obtain ⟨ownedD, hownedDecl, _, _, hownedContract⟩ := + hcontracts.decls.recursor hsrc + have hownedD : ownedD = + (⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩ : FnDef) := by + have hsame : some (Decl.fn ownedD) = some + (.fn ⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩) := + hownedDecl.symm.trans hdecl + exact Decl.fn.inj (Option.some.inj hsame) + subst ownedD + have hvalueContract : FnValueContractBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx + ⟨numArgs + 1, .shared, true, .case (.var 0) natLit alts.toArray⟩ + (List.replicate (numArgs + 1) .shared) + (.pap (.rec_ address (numArgs + 1)) []) limit := by + apply hvalues.decls.fnContract hsrc (by rfl) hdecl href + simp + have hself : CurrentSelfValueContractBelow + (CompilerFunctionRel sourceCtx src ambient) recSelfRel sourceCtx ctx + ⟨numArgs + 1, .shared, true, .case (.var 0) natLit alts.toArray⟩ + limit := by + refine ⟨rfl, ?_, ?_⟩ + · simpa using hownedContract.below limit + · intro candidate hcandidate + change candidate = .pap (.rec_ address (numArgs + 1)) [] ∧ + numArgs + 1 = numArgs + 1 at hcandidate + rcases hcandidate with ⟨rfl, _⟩ + exact hvalueContract + have hfinalRepresented : ExtraRepresented ctx finalState := + hrepresented.of_extends hextends + have hownershipSelf : CurrentSelfContractBelow ctx + ⟨numArgs + 1, .shared, true, .case (.var 0) natLit alts.toArray⟩ + limit := ⟨hself.result, hself.ownership⟩ + have hplan : RecursorRulesPlanBelow ctx + ⟨numArgs + 1, .shared, true, .case (.var 0) natLit alts.toArray⟩ + limit src compilerFuel numArgs state rules.toList.zipIdx + finalState alts := + recursorRulesPlanBelow_of_run (hcontracts.below limit).apply + (hcontracts.below limit).decls hownershipSelf rfl + compilerFuel numArgs hrulesRun hfinalRepresented + intro store store' args value sourceArgs sourceResult sourceRest rest + hargsLength hargs happlies hframe hown htarget + have hargsArity : args.length = numArgs + 1 := by + simpa using hargsLength + have hrootShape : + rootsForWorlds (List.replicate (numArgs + 1) .shared) args = + rootsFor .shared args := + rootsForWorlds_replicate_eq_rootsFor .shared hargsArity + rw [hrootShape] at hown + cases limit with + | zero => simp [runCode] at htarget + | succ branchFuel => + cases hreverse : args.reverse with + | nil => + have hargsNil : args = [] := by + have h := congrArg List.reverse hreverse + simpa using h + simp [hargsNil] at hargsArity + | cons major runtimePre => + have hargsForm : args = runtimePre.reverse ++ [major] := by + have h := congrArg List.reverse hreverse + simpa [List.reverse_cons] using h + have hruntimePreLength : runtimePre.length = numArgs := by + rw [hargsForm] at hargsArity + simp only [List.length_append, List.length_reverse, + List.length_singleton] at hargsArity + omega + obtain ⟨sourcePre, sourceMajor, hsourceArgsForm, + hsourcePreLength, hpreGraphs, hmajorGraph⟩ := + valuesGraph_splitLast hargs hargsForm hruntimePreLength + rw [hsourceArgsForm] at happlies + obtain ⟨sourceTag, sourceFields, sourceRule, sourceFuel, + hsourceMajor, hsourceRule, hsourceFieldsLength, hsourceEval⟩ := + sourceRecursorRef_saturates_inv hsourceLookup href + hsourcePreLength happlies + have hmajorWorld : HasWorld store .shared major := by + apply hown.roots_world ⟨.shared, major⟩ + apply List.mem_append_left rest + simp [rootsFor, hargsForm] + have hentryOwn : RootOwnership store + (rootsFor .shared (runtimePre.reverse ++ [major]) ++ rest) := by + simpa [hargsForm] using hown + rw [hreverse] at htarget + change runCode ctx (branchFuel + 1) + ⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩ + store (major :: runtimePre) + (.case (.var 0) natLit alts.toArray) = + .ok (store', value) at htarget + have hdispatch := htarget + rw [runCode.eq_def] at hdispatch + dsimp only at hdispatch + rw [show resolveAtom (major :: runtimePre) (.var 0) = .ok major + from rfl, lowerStateSimExceptBindOk] at hdispatch + have finish {cidx selectedTag fieldCount : Nat} {body : Code} + (halt : alts.toArray.find? (fun alt => alt.cidx == cidx) = + some (.mk selectedTag fieldCount body)) + (hcidx : cidx = sourceTag) + {targetFields : List RVal} + (hfieldGraphs : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store + sourceFields targetFields) + (htargetFieldsLength : targetFields.length = fieldCount) + (hfieldWorld : ∀ field ∈ targetFields, + HasWorld store .shared field) + (hbranchRun : runCode ctx branchFuel + ⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩ + store (targetFields.reverse ++ major :: runtimePre) body = + .ok (store', value)) : + Sim.ValueGraph (CompilerFunctionRel sourceCtx src ambient) + store' sourceResult value ∧ + Sim.RootsGraph (CompilerFunctionRel sourceCtx src ambient) + store' sourceRest rest := by + obtain ⟨rule, headState, nextState, tailRules, tailAlts, + fieldOutput, fieldEmit, rhsInput, parameterEmit, + output, bodyEmit, av, hrule, _, hfieldCount, + hfieldPlan, hparameterPlan, hbodyRun, hbody, htailPlan⟩ := + hplan.find?_run_plan_inv halt + have hsourceRuleAt : rules[cidx]? = some sourceRule := by + rw [hcidx] + exact hsourceRule + have hruleEq : rule = sourceRule := + Option.some.inj (hrule.symm.trans hsourceRuleAt) + subst rule + have htargetRuleLength : targetFields.length = sourceRule.fields := + htargetFieldsLength.trans hfieldCount + have htailExtends : ExtraExtends nextState finalState := + (ExtraMonotone.listMapM + (lowerRecursorRule src compilerFuel numArgs) + (lowerRecursorRule_extraMonotone src compilerFuel numArgs) + tailRules) htailPlan.run + have hnextExtends : ExtraExtends nextState ambient := + htailExtends.trans hextends + rw [hbody] at hbranchRun + exact lowerRecursorRule_branch_value_below + (recSelfRel := recSelfRel) (limit := branchFuel + 1) + (branchFuel := branchFuel) + henv hrepresented hcontracts hvalues + hself hfieldPlan hparameterPlan hbodyRun hnextExtends + (sourcePre := sourcePre) (pre := runtimePre.reverse) + (sourceFields := sourceFields) (fields := targetFields) + (sourceSelf := .pap (.rec_ address (numArgs + 1)) []) + (sourceValue := sourceResult) (major := major) + hsourceEval (by simpa using hruntimePreLength) + htargetRuleLength hpreGraphs hfieldGraphs ⟨rfl, rfl⟩ + hframe hentryOwn hfieldWorld (by omega) + (by simpa using hbranchRun) + cases hmajorGraph with + | @lit literal => + cases literal with + | str string => simp [IxIR0.majorCtor] at hsourceMajor + | nat n => + cases hpeel : natLit with + | false => simp [IxIR0.majorCtor, hpeel] at hsourceMajor + | true => + cases n with + | zero => + have hmajorPair : + 0 = sourceTag ∧ sourceFields = [] := by + simpa [IxIR0.majorCtor, hpeel] using hsourceMajor + have htag : sourceTag = 0 := + hmajorPair.1.symm + have hfields : sourceFields = [] := + hmajorPair.2 + subst sourceTag + subst sourceFields + cases halt : alts.toArray.find? + (fun alt => alt.cidx == 0) with + | none => simp [hpeel, halt] at hdispatch + | some alt => + cases alt with + | mk selectedTag fieldCount body => + cases fieldCount with + | zero => + have hbranch := hdispatch + simp [hpeel, halt] at hbranch + exact finish halt rfl Sim.ValuesGraph.nil rfl + (by simp) (by simpa [hpeel] using hbranch) + | succ fieldCount => + simp [hpeel, halt] at hdispatch + | succ n => + have hmajorPair : + 1 = sourceTag ∧ + [.lit (.nat n)] = sourceFields := by + simpa [IxIR0.majorCtor, hpeel] using hsourceMajor + have htag : sourceTag = 1 := + hmajorPair.1.symm + have hfields : sourceFields = [.lit (.nat n)] := + hmajorPair.2.symm + subst sourceTag + subst sourceFields + cases halt : alts.toArray.find? + (fun alt => alt.cidx == 1) with + | none => simp [hpeel, halt] at hdispatch + | some alt => + cases alt with + | mk selectedTag fieldCount body => + by_cases hfieldCount : fieldCount = 1 + · subst fieldCount + have hbranch := hdispatch + simp [hpeel, halt] at hbranch + exact finish halt rfl + (.cons .lit .nil) rfl (by simp [HasWorld]) + (by simpa [hpeel] using hbranch) + · simp [hpeel, halt, hfieldCount] at hdispatch + | erased => simp [IxIR0.majorCtor] at hsourceMajor + | @ctor sourceAddress sourceCtorTag sourceCtorFields loc + world rc cid targetFields hget haddress htag hfieldGraphs => + have hmajorPair : + sourceCtorTag = sourceTag ∧ + sourceCtorFields = sourceFields := by + simpa [IxIR0.majorCtor] using hsourceMajor + have hsourceTagEq : sourceTag = sourceCtorTag := + hmajorPair.1.symm + have hsourceFieldsEq : sourceFields = sourceCtorFields := + hmajorPair.2.symm + subst sourceTag + subst sourceFields + obtain ⟨ownedBox, hownedBox, hownedWorld⟩ := hmajorWorld + rw [hget] at hownedBox + have hboxEq : + (⟨world, rc, .ctorN cid targetFields⟩ : NodeBox) = + ownedBox := Option.some.inj hownedBox + subst ownedBox + dsimp only [NodeBox.world] at hownedWorld + subst world + cases halt : alts.toArray.find? + (fun alt => alt.cidx == cid.cidx) with + | none => simp [hget, halt] at hdispatch + | some alt => + cases alt with + | mk selectedTag fieldCount body => + by_cases hsize : targetFields.size = fieldCount + · have hbranch := htarget + rw [runCode_case_ctor rfl hget halt hsize] at hbranch + rw [Array.foldl_cons_eq_reverse_append] at hbranch + exact finish halt htag + (by simpa using hfieldGraphs) + (by simpa using hsize) + (hown.caseFieldsBorrowed hget) + hbranch + · simp [hget, halt, hsize] at hdispatch + | function hget hfun hcaptures => + simp [hget] at hdispatch + +/-- Declaration-facing recursor rule over the actual `lowerDecl` result. -/ +theorem lowerDecl_recursor_preservesAt + {ctx : Ctx} {limit : Nat} {src : IxIR0.Env} + (happly : ApplyOwnershipContractBelow ctx limit) + (hdecls : SourceDeclContractsBelow src ctx limit) + {fuel : Nat} {address : Ixon.Address} {numArgs : Nat} + {natLit : Bool} {rules : Array IxIR0.RecRule} + {state finalState : LowSt} {d : FnDef} + (hself : CurrentSelfContractBelow ctx d limit) + (hrun : + (lowerDecl src fuel (address, .recursor numArgs natLit rules)).run + state = .ok (some (address, .fn d)) finalState) + (hrepresented : ExtraRepresented ctx finalState) : + FnOwnershipPreservesAt ctx d + (List.replicate (numArgs + 1) .shared) limit := by + simp only [lowerDecl] at hrun + obtain ⟨actual, recursorState, hrecursorRun, hafterRecursor⟩ := + trackedBindRun_ok_inv hrun + have hpure : + some (address, Decl.fn actual) = some (address, Decl.fn d) ∧ + recursorState = finalState := by + simpa using hafterRecursor + have hd : actual = d := by + have hp := Option.some.inj hpure.1 + exact Decl.fn.inj (Prod.mk.inj hp).2 + have hrecursorState : recursorState = finalState := hpure.2 + subst actual + subst recursorState + intro store store' args value rest hlength hown hcodeRun + exact lowerRecursor_preservesAt + happly hdecls hself hrecursorRun hrepresented hlength hown hcodeRun + +/-- Declaration-facing semantic recursor rule over the actual `lowerDecl` +result. The declaration adapter contributes no runtime behavior; it only +recovers the exact generated recursor body and final compiler state used by +`lowerRecursor_valuePreservesAt_within_below`. -/ +theorem lowerDecl_recursor_valuePreservesAt_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {ctx : Ctx} {limit compilerFuel numArgs : Nat} + {natLit : Bool} {rules : Array IxIR0.RecRule} + {address : Ixon.Address} {sourceFunction : IxIR0.Value} + {state finalState : LowSt} {d : FnDef} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + (hsrc : src address = some (.recursor numArgs natLit rules)) + (hdecl : ctx.decls address = some (.fn d)) + (href : SourceRefValue sourceCtx address sourceFunction) + (hrun : + (lowerDecl src compilerFuel + (address, .recursor numArgs natLit rules)).run state = + .ok (some (address, .fn d)) finalState) + (hextends : ExtraExtends finalState ambient) : + FnValuePreservesAt (CompilerFunctionRel sourceCtx src ambient) + sourceCtx ctx d (List.replicate (numArgs + 1) .shared) + sourceFunction limit := by + simp only [lowerDecl] at hrun + obtain ⟨actual, recursorState, hrecursorRun, hafterRecursor⟩ := + trackedBindRun_ok_inv hrun + have hpure : + some (address, Decl.fn actual) = some (address, Decl.fn d) ∧ + recursorState = finalState := by + simpa using hafterRecursor + have hd : actual = d := by + have hp := Option.some.inj hpure.1 + exact Decl.fn.inj (Prod.mk.inj hp).2 + have hrecursorState : recursorState = finalState := hpure.2 + subst actual + subst recursorState + intro store store' args value sourceArgs sourceResult sourceRest rest + hlength hargs happlies hframe hown hcodeRun + exact lowerRecursor_valuePreservesAt_within_below + henv hrepresented hcontracts hvalues hsrc hdecl href + hrecursorRun hextends hlength hargs happlies hframe hown hcodeRun + +/-- Declaration-facing inversion of an ordinary successful `lowerFnBody`. +The returned expression proof is self-contract-free; only the canonical +entry cleanup and the actual body run are exposed. -/ +theorem lowerFnBody_run_sound_below_noRecSelf + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + (happly : ApplyOwnershipContractBelow ctx limit) + (hdecls : SourceDeclContractsBelow src ctx limit) + {fuel : Nat} {input : VEnv} {drops : List SlotDrop} + {world : Owned} {body : IxIR0.Expr} {state finalState : LowSt} + {code : Code} + (hrun : (lowerFnBody src (fuel + 1) input drops world body).run state = + .ok code finalState) + (hrepresented : ExtraRepresented ctx finalState) + (hno : NoRecSelf input) : + ∃ middle releaseEmit releaseState output emit av, + (releaseSlots input drops).run state = + .ok (middle, releaseEmit) releaseState ∧ + (lowerE src fuel middle world body).run releaseState = + .ok (output, emit, av) finalState ∧ + code = (releaseEmit ∘ emit) (.ret (av.toAtom output)) ∧ + LowerResultSoundBelow ctx cur limit middle output world emit av := by + simp only [lowerFnBody] at hrun + obtain ⟨releaseResult, releaseState, hreleaseRun, hafterRelease⟩ := + trackedBindRun_ok_inv hrun + rcases releaseResult with ⟨middle, releaseEmit⟩ + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + trackedBindRun_ok_inv hafterRelease + rcases bodyResult with ⟨output, emit, av⟩ + have hpure : + (releaseEmit ∘ emit) (.ret (av.toAtom output)) = code ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨hcode, hstate⟩ := hpure + subst bodyState + have hmiddleNo := releaseSlots_noRecSelf input hreleaseRun hno + refine ⟨middle, releaseEmit, releaseState, output, emit, av, + hreleaseRun, hbodyRun, hcode.symm, ?_⟩ + exact lowerE_run_sound_below_noRecSelf happly hdecls hbodyRun + hrepresented hmiddleNo + +/-- A successful ordinary function-body lowering over the canonical parameter +telescope preserves ownership at the exact evaluator index. Dead-entry release, +exact body consumption, logical-entry cardinality, and the self-free semantic +path are all discharged here. -/ +theorem lowerFnBody_parameterEntries_preservesAt + {ctx : Ctx} {limit : Nat} {src : IxIR0.Env} {fuel : Nat} + (happly : ApplyOwnershipContractBelow ctx limit) + (hdecls : SourceDeclContractsBelow src ctx limit) + (modes : List Uses) (world : Owned) (body : IxIR0.Expr) + {state finalState : LowSt} {code : Code} {papSafeFlag : Bool} + (hadmissible : ParameterDropsAdmissible modes + (fun index => countUses index body)) + (hrun : (lowerFnBody src (fuel + 1) + ⟨parameterEntries 0 modes (fun index => countUses index body), + modes.length⟩ + (parameterDrops 0 modes (fun index => countUses index body)) + world body).run state = .ok code finalState) + (hrepresented : ExtraRepresented ctx finalState) : + FnOwnershipPreservesAt ctx ⟨modes.length, world, papSafeFlag, code⟩ + (modes.map worldOfUses) limit := by + let remaining : Nat → Nat := fun index => countUses index body + let input : VEnv := + ⟨parameterEntries 0 modes remaining, modes.length⟩ + let drops := parameterDrops 0 modes remaining + have hrun' : + (lowerFnBody src (fuel + 1) input drops world body).run state = + .ok code finalState := by + simpa [input, drops, remaining] using hrun + obtain ⟨middle, releaseEmit, releaseState, output, emit, av, + hreleaseRun, hbodyRun, hcode, hbodySound⟩ := + lowerFnBody_run_sound_below_noRecSelf + (cur := (⟨modes.length, world, papSafeFlag, code⟩ : FnDef)) + happly hdecls hrun' hrepresented + (by simpa [input, remaining] using + parameterEntries_noRecSelf 0 modes remaining modes.length) + obtain ⟨plannedMiddle, plannedEmit, hplan, htracks⟩ := + parameterDrops_releasePlan_tracked 0 modes remaining + (by simpa [remaining] using hadmissible) + have hplan' : ReleasePlan input drops plannedMiddle plannedEmit := by + simpa [input, drops] using hplan + have hplanRun : (releaseSlots input drops).run state = + .ok (plannedMiddle, plannedEmit) state := hplan'.run state + have heq : + (plannedMiddle, plannedEmit) = (middle, releaseEmit) ∧ + state = releaseState := by + simpa using hplanRun.symm.trans hreleaseRun + obtain ⟨hmiddle, hstate⟩ := heq + cases hmiddle + subst releaseState + have hconsume := lowerE_consumesEntries hbodyRun + have hcount := lowerE_preservesEntryCount hbodyRun + have hmiddleLength : middle.entries.length = modes.length := by + calc + middle.entries.length = input.entries.length := hplan'.entries_length + _ = modes.length := by simp [input, remaining] + have hreleased : EntriesReleased output.entries := + hconsume.entriesReleased htracks (Eq.trans hcount hmiddleLength) + have hfull : LowerResultSoundBelow ctx + (⟨modes.length, world, papSafeFlag, code⟩ : FnDef) + limit input output world + (releaseEmit ∘ emit) av := + hbodySound.afterRelease hplan'.soundBelow + apply hfull.fnOwnershipPreservesAt + (FnEntryRealizes.parameterEntries modes remaining) + · simp + · exact hreleased + · exact hcode + +/-- Declaration-facing ordinary-definition rule. The theorem follows the +actual `lowerDecl` result rather than a separately supplied body plan. -/ +theorem lowerDecl_defn_preservesAt + {ctx : Ctx} {limit : Nat} {src : IxIR0.Env} {fuel : Nat} + (happly : ApplyOwnershipContractBelow ctx limit) + (hdecls : SourceDeclContractsBelow src ctx limit) + {address : Ixon.Address} {result : Owned} {body : IxIR0.Expr} + {state finalState : LowSt} {d : FnDef} + (hadmissible : ParameterDropsAdmissible (lamUses body) + (fun index => countUses index (stripLams body))) + (hrun : (lowerDecl src (fuel + 1) (address, .defn result body)).run + state = .ok (some (address, .fn d)) finalState) + (hrepresented : ExtraRepresented ctx finalState) : + FnOwnershipPreservesAt ctx d ((lamUses body).map worldOfUses) limit := by + simp only [lowerDecl] at hrun + obtain ⟨code, bodyState, hbodyRun, hpureRun⟩ := + trackedBindRun_ok_inv hrun + have hpure : + some (address, Decl.fn ⟨lamArity body, result, + result == .shared && papSafe body, code⟩) = + some (address, Decl.fn d) ∧ bodyState = finalState := by + simpa using hpureRun + have hd : d = ⟨lamArity body, result, + result == .shared && papSafe body, code⟩ := by + have hp := Option.some.inj hpure.1 + exact Decl.fn.inj (Prod.mk.inj hp).2.symm + cases hpure.2 + subst d + have hpreserves : FnOwnershipPreservesAt ctx + ⟨(lamUses body).length, result, + result == .shared && papSafe body, code⟩ + ((lamUses body).map worldOfUses) limit := + lowerFnBody_parameterEntries_preservesAt + happly hdecls (lamUses body) result (stripLams body) hadmissible + (by simpa using hbodyRun) hrepresented + have hfn : (⟨(lamUses body).length, result, + result == .shared && papSafe body, code⟩ : FnDef) = + ⟨lamArity body, result, + result == .shared && papSafe body, code⟩ := by + rw [lamUses_length] + rw [← hfn] + intro store store' args value rest hlength hown hcodeRun + exact hpreserves hlength hown hcodeRun + +/-- The complete bounded expression step with counted-binder release +discharged. Generated-declaration representation is now its only remaining +compile-state premise. -/ +theorem lowerE_run_sound_below_counted + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} + (hexpr : LowerEPreservesBelow ctx cur limit src fuel) + (hspine : LowerSpinePreservesBelow ctx cur limit src fuel) + (hargsNext : LowerArgsPreservesBelow ctx cur limit src (fuel + 1)) + (hrestNext : ApplyRestPreservesBelow ctx cur limit src (fuel + 1)) + (hrestNextExtra : ApplyRestExtraMonotone src (fuel + 1)) + (hborrow : LowerBorrowPreservesBelow ctx cur limit src fuel) + (hdecls : SourceDeclContractsBelow src ctx limit) + {input output : VEnv} {world : Owned} {expr : IxIR0.Expr} + {emit : Emit} {av : AVal} {state finalState : LowSt} + (hrepresented : ExtraRepresented ctx finalState) + (hrun : (lowerE src (fuel + 1) input world expr).run state = + .ok (output, emit, av) finalState) + (havailable : SelfAvailableBelow ctx cur limit input) : + LowerResultSoundBelow ctx cur limit input output world emit av := + lowerE_run_sound_below hexpr hspine hargsNext + (lowerExtraMonotone src (fuel + 1)).args hrestNext hrestNextExtra + hborrow hdecls + (fun body => lowerE_releasesTrackedFirst src fuel body) hrepresented hrun + havailable + +/-- Ambient whole-program form of the complete expression step. The final +context represents one later state, while `ExtraExtends` transports that +layout back to the successful expression run's own final state. -/ +theorem lowerE_run_sound_below_ambient + {ctx : Ctx} {cur : FnDef} {limit : Nat} {src : IxIR0.Env} + {fuel : Nat} + (hexpr : LowerEPreservesBelow ctx cur limit src fuel) + (hspine : LowerSpinePreservesBelow ctx cur limit src fuel) + (hargsNext : LowerArgsPreservesBelow ctx cur limit src (fuel + 1)) + (hrestNext : ApplyRestPreservesBelow ctx cur limit src (fuel + 1)) + (hrestNextExtra : ApplyRestExtraMonotone src (fuel + 1)) + (hborrow : LowerBorrowPreservesBelow ctx cur limit src fuel) + (hdecls : SourceDeclContractsBelow src ctx limit) + {input output : VEnv} {world : Owned} {expr : IxIR0.Expr} + {emit : Emit} {av : AVal} {state finalState ambient : LowSt} + (hambient : ExtraRepresented ctx ambient) + (hwithin : ExtraExtends finalState ambient) + (hrun : (lowerE src (fuel + 1) input world expr).run state = + .ok (output, emit, av) finalState) + (havailable : SelfAvailableBelow ctx cur limit input) : + LowerResultSoundBelow ctx cur limit input output world emit av := + lowerE_run_sound_below_counted hexpr hspine hargsNext hrestNext + hrestNextExtra hborrow hdecls (hambient.of_extends hwithin) hrun + havailable + +/-! ## Lifted-function entry layout -/ + +/-- The structural capture-entry builder realizes an ordered selected subset +of shared runtime arguments. `next` is the next absolute capture slot; it is +threaded in lockstep with the selected values, while unselected source entries +remain released logical placeholders. -/ +private theorem selectedEntriesFrom_entriesRealize + {Γ : VEnv} {env : List RVal} + (selected : Nat → Bool) (remaining : Nat → Nat) : + ∀ (indices : List Nat) (next : Nat) (values : List RVal), + values.length = (indices.filter selected).length → + 0 < Γ.depth → + next + values.length ≤ Γ.depth → + (∀ index, index < values.length → + env[Γ.rel (next + index)]? = values[index]?) → + EntriesRealize Γ env + (selectedEntriesFrom selected remaining indices next) + (rootsFor .shared values) := by + intro indices next values hlength hpositive hbound hslots + exact selectedEntriesFrom_traverse selected remaining + (Result := fun sourceIndices current entries => + ∀ runtimeValues, + runtimeValues.length = (sourceIndices.filter selected).length → + 0 < Γ.depth → + current + runtimeValues.length ≤ Γ.depth → + (∀ index, index < runtimeValues.length → + env[Γ.rel (current + index)]? = runtimeValues[index]?) → + EntriesRealize Γ env entries (rootsFor .shared runtimeValues)) + (hnil := by + intro current runtimeValues hlength _ _ _ + cases runtimeValues with + | nil => exact EntriesRealize.nil + | cons value values => simp at hlength) + (hfalse := by + intro entry entries current tail hselected ih runtimeValues hlength + hpositive hbound hslots + apply EntriesRealize.released (by omega) + apply ih runtimeValues + · simpa [hselected] using hlength + · exact hpositive + · exact hbound + · exact hslots) + (htrue := by + intro entry entries current tail hselected ih runtimeValues hlength + hpositive hbound hslots + cases runtimeValues with + | nil => simp [hselected] at hlength + | cons value values => + simp only [rootsFor, List.map_cons] + apply EntriesRealize.held + · exact Nat.lt_of_lt_of_le (by simp) hbound + · have hhead := hslots 0 (by simp) + simpa using hhead + · apply ih values + · simpa [hselected] using hlength + · exact hpositive + · simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hbound + · intro index hindex + have htail := hslots (index + 1) (by simp [hindex]) + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using htail) + indices next values hlength hpositive hbound hslots + +/-- Semantic companion to `selectedEntriesFrom_entriesRealize`. The first +`ValuesAt` witness supplies every logical source entry, while the filtered +witness and pointwise runtime graph supply exactly the held capture subset; +unselected entries remain present on the source side but own no root. -/ +private theorem selectedEntriesFrom_entriesValueGraph + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} + {store : Store} {Γ : VEnv} {env : List RVal} + {sourceEnv : List IxIR0.Value} + (selected : Nat → Bool) (remaining : Nat → Nat) : + ∀ (indices : List Nat) (next : Nat) + (allSources selectedSources : List IxIR0.Value) + (values : List RVal), + ValuesAt sourceEnv indices allSources → + ValuesAt sourceEnv (indices.filter selected) selectedSources → + Sim.ValuesGraph funRel store selectedSources values → + 0 < Γ.depth → + next + values.length ≤ Γ.depth → + (∀ index, index < values.length → + env[Γ.rel (next + index)]? = values[index]?) → + (∀ value, value ∈ values → HasWorld store .shared value) → + EntriesValueGraph funRel recSelfRel store Γ env + (selectedEntriesFrom selected remaining indices next) + allSources (rootsFor .shared values) := by + intro indices next allSources selectedSources values hall hselected hgraphs + hpositive hbound hslots hworlds + exact selectedEntriesFrom_traverse selected remaining + (Result := fun sourceIndices current entries => + ∀ allSourceValues selectedSourceValues runtimeValues, + ValuesAt sourceEnv sourceIndices allSourceValues → + ValuesAt sourceEnv (sourceIndices.filter selected) + selectedSourceValues → + Sim.ValuesGraph funRel store selectedSourceValues runtimeValues → + 0 < Γ.depth → + current + runtimeValues.length ≤ Γ.depth → + (∀ index, index < runtimeValues.length → + env[Γ.rel (current + index)]? = runtimeValues[index]?) → + (∀ value, value ∈ runtimeValues → HasWorld store .shared value) → + EntriesValueGraph funRel recSelfRel store Γ env entries + allSourceValues (rootsFor .shared runtimeValues)) + (hnil := by + intro current allSourceValues selectedSourceValues runtimeValues + hall hselected hgraphs _ _ _ _ + cases hall + cases hselected + cases hgraphs + exact EntriesValueGraph.nil) + (hfalse := by + intro entry entries current tail hselectedBit ih allSourceValues + selectedSourceValues runtimeValues hall hselected hgraphs hpositive + hbound hslots hworlds + cases hall with + | @cons _ source _ tailSources hsource htailAll => + simp only [List.filter_cons, hselectedBit, Bool.false_eq_true, + if_false] at hselected + apply EntriesValueGraph.released (by omega) + exact ih tailSources selectedSourceValues runtimeValues htailAll + hselected hgraphs hpositive hbound hslots hworlds) + (htrue := by + intro entry entries current tail hselectedBit ih allSourceValues + selectedSourceValues runtimeValues hall hselected hgraphs hpositive + hbound hslots hworlds + cases hall with + | @cons _ source _ tailSources hsource htailAll => + simp only [List.filter_cons, hselectedBit, ↓reduceIte] at hselected + cases hselected with + | @cons _ selectedSource _ selectedTail hselectedSource + hselectedTail => + cases hgraphs with + | @cons _ runtimeValue _ runtimeTail hvalue htailGraphs => + have hsourceEq : selectedSource = source := by + exact Option.some.inj (hselectedSource.symm.trans hsource) + subst selectedSource + simp only [rootsFor, List.map_cons] + apply EntriesValueGraph.held + · exact Nat.lt_of_lt_of_le (by simp) hbound + · have hhead := hslots 0 (by simp) + simpa using hhead + · exact hworlds runtimeValue (by simp) + · exact hvalue + · apply ih tailSources selectedTail runtimeTail htailAll + hselectedTail htailGraphs hpositive + · simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] + using hbound + · intro index hindex + have htail := hslots (index + 1) (by simp [hindex]) + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] + using htail + · intro value hvalueMem + exact hworlds value (by simp [hvalueMem])) + indices next allSources selectedSources values hall hselected hgraphs + hpositive hbound hslots hworlds + +/-- Reading a bottom-indexed absolute slot from the evaluator's reversed +function environment recovers the corresponding source-order argument. -/ +private theorem getElem?_reverse_at_absolute + {values : List α} {depth index : Nat} + (hlength : values.length = depth) (hindex : index < depth) : + values.reverse[depth - 1 - index]? = values[index]? := by + have hbound : depth - 1 - index < values.length := by omega + have hreverse := List.getElem?_reverse (l := values) hbound + have heq : values.length - 1 - (depth - 1 - index) = index := by omega + simpa [heq] using hreverse + +/-- Consecutive valid source-environment indices select the corresponding +list segment. -/ +private theorem ValuesAt.range'_of_get (sourceEnv : List IxIR0.Value) : + ∀ (start : Nat) (values : List IxIR0.Value), + (∀ offset, offset < values.length → + sourceEnv[start + offset]? = values[offset]?) → + ValuesAt sourceEnv (List.range' start values.length) values := by + intro start values + induction values generalizing start with + | nil => + intro _ + exact ValuesAt.nil + | cons head tail ih => + intro hget + have hhead : sourceEnv[start]? = some head := by + have h := hget 0 (by simp) + simpa using h + apply ValuesAt.cons hhead + have htail := ih (start + 1) (by + intro offset hoffset + have h := hget (offset + 1) (by simp [hoffset]) + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using h) + simpa [List.range'_succ] using htail + +/-- The full source environment is selected by its canonical index range. -/ +private theorem ValuesAt.range_self (sourceEnv : List IxIR0.Value) : + ValuesAt sourceEnv (List.range sourceEnv.length) sourceEnv := by + have h := ValuesAt.range'_of_get sourceEnv 0 sourceEnv (by + intro offset hoffset + simp) + simpa [List.range_eq_range'] using h + +/-- Semantic entry graph for a lifted function's public +capture-then-parameter calling convention. Runtime arguments are supplied +in public order, while both the evaluator stack and the leading source +parameter environment are reversed at function entry. -/ +theorem VEnvValueGraph.lifted + {funRel : Sim.FunctionRel} {recSelfRel : RecSelfRel} {store : Store} + (entryCount : Nat) (modes : List Uses) + (parameterRemaining : Nat → Nat) + (selected : Nat → Bool) (captureRemaining : Nat → Nat) + {sourceEnv selectedSources parameterSources : List IxIR0.Value} + {captureArgs parameterArgs : List RVal} {rest : List Root} + (hsourceLength : sourceEnv.length = entryCount) + (hselected : ValuesAt sourceEnv + ((List.range entryCount).filter selected) selectedSources) + (hcaptureLength : captureArgs.length = + ((List.range entryCount).filter selected).length) + (hparameterLength : parameterArgs.length = modes.length) + (hcaptures : Sim.ValuesGraph funRel store selectedSources captureArgs) + (hparameters : Sim.ValuesGraph funRel store parameterSources + parameterArgs) + (hpositive : 0 < modes.length) + (hshared : modes.map worldOfUses = + List.replicate modes.length .shared) + (hown : RootOwnership store + (rootsFor .shared (captureArgs ++ parameterArgs) ++ rest)) : + let captures := (List.range entryCount).filter selected + let Γ : VEnv := + ⟨Lower.parameterEntries captures.length modes parameterRemaining ++ + selectedEntriesFrom selected captureRemaining + (List.range entryCount) 0, + captures.length + modes.length⟩ + VEnvValueGraph funRel recSelfRel store Γ + (parameterSources.reverse ++ sourceEnv) + (captureArgs ++ parameterArgs).reverse + ((rootsForWorlds (modes.map worldOfUses) parameterArgs).reverse ++ + rootsFor .shared captureArgs) := by + dsimp only + let captures := (List.range entryCount).filter selected + let args := captureArgs ++ parameterArgs + let Γ : VEnv := + ⟨Lower.parameterEntries captures.length modes parameterRemaining ++ + selectedEntriesFrom selected captureRemaining + (List.range entryCount) 0, + captures.length + modes.length⟩ + have hcaptureLength' : captureArgs.length = captures.length := by + simpa [captures] using hcaptureLength + have htotal : args.length = captures.length + modes.length := by + simp [args, hcaptureLength', hparameterLength] + have hrootShape : rootsFor .shared args = + rootsFor .shared captureArgs ++ rootsFor .shared parameterArgs := by + simp [args, rootsFor] + have hparameterWorlds : ∀ root, + root ∈ rootsForWorlds (modes.map worldOfUses) parameterArgs → + HasWorld store root.world root.value := by + intro root hroot + rw [hshared, + rootsForWorlds_replicate_eq_rootsFor .shared hparameterLength] at hroot + apply hown.roots_world root + rw [hrootShape] + exact List.mem_append_left rest (List.mem_append_right _ hroot) + have hparameter₀ := parameterEntries_entriesValueGraph + (funRel := funRel) (recSelfRel := recSelfRel) (store := store) + parameterRemaining captures.length modes + (sourceArgs := parameterSources) (args := parameterArgs) + (suffix := captureArgs.reverse) hparameterLength + (by simp [hcaptureLength']) hparameters hparameterWorlds + have hparameter : EntriesValueGraph funRel recSelfRel store Γ + args.reverse + (Lower.parameterEntries captures.length modes parameterRemaining) + parameterSources.reverse + (rootsForWorlds (modes.map worldOfUses) parameterArgs).reverse := by + have htransport := hparameter₀.of_depth_eq (Δ := Γ) (by simp [Γ]) + have henv : args.reverse = + parameterArgs.reverse ++ captureArgs.reverse := by + simp [args, List.reverse_append] + simpa [henv] using htransport + have hall : ValuesAt sourceEnv (List.range entryCount) sourceEnv := by + rw [← hsourceLength] + exact ValuesAt.range_self sourceEnv + have hcaptureWorlds : ∀ value, value ∈ captureArgs → + HasWorld store .shared value := by + intro value hvalue + apply hown.roots_world ⟨.shared, value⟩ + rw [hrootShape] + apply List.mem_append_left rest + exact List.mem_append_left _ (by simpa [rootsFor] using hvalue) + have hcaptureEntries : EntriesValueGraph funRel recSelfRel store Γ + args.reverse + (selectedEntriesFrom selected captureRemaining + (List.range entryCount) 0) + sourceEnv (rootsFor .shared captureArgs) := by + apply selectedEntriesFrom_entriesValueGraph selected captureRemaining + (sourceEnv := sourceEnv) + · exact hall + · exact hselected + · exact hcaptures + · dsimp [Γ] + exact Nat.add_pos_right captures.length hpositive + · simp [Γ, hcaptureLength'] + · intro index hindex + have hindexArgs : index < args.length := by omega + have hindexTotal : index < captures.length + modes.length := by omega + have hreverse := getElem?_reverse_at_absolute + (values := args) htotal hindexTotal + have happend : args[index]? = captureArgs[index]? := by + exact List.getElem?_append_left + (by simpa [hcaptureLength'] using hindex) + simpa [Γ, VEnv.rel, htotal] using hreverse.trans happend + · exact hcaptureWorlds + refine ⟨?_, ?_⟩ + · simpa [Γ, args, Nat.add_comm] using htotal + · simpa [Γ, args] using hparameter.append hcaptureEntries + +/-- A lifted function's mixed logical environment realizes its public +capture-then-parameter calling convention. Captures occupy the first shared +argument prefix; the canonical parameter telescope follows it, and released +outer placeholders contribute no roots. -/ +theorem FnEntryRealizes.lifted + (entryCount : Nat) (modes : List Uses) + (parameterRemaining : Nat → Nat) + (selected : Nat → Bool) (captureRemaining : Nat → Nat) + (hpositive : 0 < modes.length) + (hshared : modes.map worldOfUses = + List.replicate modes.length .shared) : + let captures := (List.range entryCount).filter selected + FnEntryRealizes + ⟨Lower.parameterEntries captures.length modes parameterRemaining ++ + selectedEntriesFrom selected captureRemaining + (List.range entryCount) 0, + captures.length + modes.length⟩ + (List.replicate (captures.length + modes.length) .shared) := by + dsimp only + let captures := (List.range entryCount).filter selected + intro args hargs + have htotal : args.length = captures.length + modes.length := by + simpa [captures] using hargs + let captureArgs := args.take captures.length + let parameterArgs := args.drop captures.length + have hcapturesLe : captures.length ≤ args.length := by omega + have hcaptureLength : captureArgs.length = captures.length := by + simp [captureArgs, List.length_take, Nat.min_eq_left hcapturesLe] + have hparameterLength : parameterArgs.length = modes.length := by + simp [parameterArgs, List.length_drop, htotal] + have hsplit : captureArgs ++ parameterArgs = args := by + exact List.take_append_drop captures.length args + let Γ : VEnv := + ⟨Lower.parameterEntries captures.length modes parameterRemaining ++ + selectedEntriesFrom selected captureRemaining + (List.range entryCount) 0, + captures.length + modes.length⟩ + have hparameter₀ := parameterEntries_entriesRealize parameterRemaining + captures.length modes (args := parameterArgs) + (suffix := captureArgs.reverse) hparameterLength (by simp [hcaptureLength]) + have hparameter : EntriesRealize Γ args.reverse + (Lower.parameterEntries captures.length modes parameterRemaining) + (rootsForWorlds (modes.map worldOfUses) parameterArgs).reverse := by + have htransport := hparameter₀.of_depth_eq (Δ := Γ) (by simp [Γ]) + have henv : args.reverse = parameterArgs.reverse ++ captureArgs.reverse := by + rw [← hsplit, List.reverse_append] + simpa [henv] using htransport + have hcaptures : EntriesRealize Γ args.reverse + (selectedEntriesFrom selected captureRemaining + (List.range entryCount) 0) + (rootsFor .shared captureArgs) := by + apply selectedEntriesFrom_entriesRealize selected captureRemaining + · simpa [captures, hcaptureLength] + · dsimp [Γ] + omega + · simp [Γ, hcaptureLength] + · intro index hindex + have hindexArgs : index < args.length := by omega + have hindexTotal : index < captures.length + modes.length := by omega + have hreverse := getElem?_reverse_at_absolute + (values := args) htotal hindexTotal + have happend : args[index]? = captureArgs[index]? := by + rw [← hsplit] + exact List.getElem?_append_left + (by simpa [hcaptureLength] using hindex) + simpa [Γ, VEnv.rel, htotal] using hreverse.trans happend + refine ⟨(rootsForWorlds (modes.map worldOfUses) parameterArgs).reverse ++ + rootsFor .shared captureArgs, ?_, ?_⟩ + · refine ⟨?_, hparameter.append hcaptures⟩ + simpa [Γ] using htotal + · have hparameterRoots : + rootsForWorlds (modes.map worldOfUses) parameterArgs = + rootsFor .shared parameterArgs := by + rw [hshared] + exact rootsForWorlds_replicate_eq_rootsFor .shared hparameterLength + have htarget : + rootsForWorlds + (List.replicate (captures.length + modes.length) .shared) args = + rootsFor .shared captureArgs ++ rootsFor .shared parameterArgs := by + rw [rootsForWorlds_replicate_eq_rootsFor .shared htotal] + rw [← hsplit] + simp [rootsFor] + rw [hparameterRoots, htarget] + exact (List.reverse_perm _).append_right _ |>.trans List.perm_append_comm + +/-- Removing the leading lambda telescope shifts every older free-variable +index by exactly the telescope arity. -/ +theorem countUses_eq_stripLams_shift (expr : IxIR0.Expr) (index : Nat) : + countUses index expr = + countUses (lamArity expr + index) (stripLams expr) := by + induction expr generalizing index with + | lam uses body ih => + simp only [countUses, lamArity, stripLams] + rw [ih] + have heq : lamArity body + (index + 1) = + lamArity body + 1 + index := by omega + rw [heq] + | var => simp only [lamArity, Nat.zero_add, stripLams] + | ref => simp only [lamArity, Nat.zero_add, stripLams] + | app => simp only [lamArity, Nat.zero_add, stripLams] + | letE => simp only [lamArity, Nat.zero_add, stripLams] + | proj => simp only [lamArity, Nat.zero_add, stripLams] + | lit => simp only [lamArity, Nat.zero_add, stripLams] + | erased => simp only [lamArity, Nat.zero_add, stripLams] + +private theorem uses_eq_many_of_beq {uses : Uses} + (h : (uses == .many) = true) : uses = .many := by + cases uses with + | erased => exact Bool.noConfusion h + | linear => exact Bool.noConfusion h + | affine => exact Bool.noConfusion h + | many => rfl + +private theorem all_many_eq_replicate : + ∀ modes : List Uses, + modes.all (fun uses => uses == .many) = true → + modes = List.replicate modes.length .many := by + intro modes + induction modes with + | nil => simp + | cons mode modes ih => + intro hall + simp only [List.all_cons, Bool.and_eq_true] at hall + have hmode : mode = .many := uses_eq_many_of_beq hall.1 + subst mode + simp only [List.length_cons, List.replicate_succ, List.cons.injEq, true_and] + exact ih hall.2 + +/-- The executable `papSafe` check pins the entire lifted parameter telescope +to `many`, not merely its mapped ownership worlds. -/ +theorem papSafe_lamUses_eq_replicate {expr : IxIR0.Expr} + (hsafe : papSafe expr = true) : + lamUses expr = List.replicate (lamArity expr) .many := by + have hsafe' : (lamUses expr).all (fun uses => uses == .many) = true := by + simpa [papSafe] using hsafe + have hall := all_many_eq_replicate (lamUses expr) hsafe' + simpa using hall + +/-- Append the selected older-entry range to a tracked parameter prefix. The +selection bit is required to be exactly the canonical nonzero-count bit; this +turns both live captures and released placeholders into ordinary tracked +entries for the body-consumption theorem. -/ +theorem EntriesTrackCounts.frameSelectedRange + {Γ : VEnv} {baseCount : Nat} {counts : Nat → Nat} + (htracks : EntriesTrackCounts Γ baseCount counts) + (hlength : Γ.entries.length = baseCount) + (selected : Nat → Bool) (remaining : Nat → Nat) : + ∀ (start count next : Nat), + (∀ offset, offset < count → + selected (start + offset) = (counts (baseCount + offset) != 0)) → + (∀ offset, offset < count → + remaining (start + offset) = counts (baseCount + offset)) → + EntriesTrackCounts + (frameVEnvEntries Γ + (selectedEntriesFrom selected remaining + (List.range' start count) next)) + (baseCount + count) counts := by + intro start count + induction count generalizing Γ baseCount start with + | zero => + intro next _ _ + simpa [selectedEntriesFrom, frameVEnvEntries] using htracks + | succ count ih => + intro next hselected hremaining + have hselectedHead := hselected 0 (by omega) + have hremainingHead := hremaining 0 (by omega) + cases hhead : selected start with + | false => + have hzero : counts baseCount = 0 := by + simp [hhead] at hselectedHead + omega + have hremainingHead' : remaining start = 0 := by + simpa [hzero] using hremainingHead + let head : VEntry := .slot 0 0 .many false + let Γhead := frameVEnvEntries Γ [head] + have hheadTracks : EntriesTrackCounts Γhead (baseCount + 1) counts := by + have hcanonical := EntriesTrackCounts.frameCanonicalSlot + (abs := 0) (uses := .many) htracks hlength + simpa [Γhead, head, hzero] using hcanonical + have hheadLength : Γhead.entries.length = baseCount + 1 := by + simp [Γhead, head, frameVEnvEntries, hlength] + have htail := ih (Γ := Γhead) (baseCount := baseCount + 1) + hheadTracks hheadLength (start := start + 1) next + (fun offset hoffset => by + have h := hselected (offset + 1) (by omega) + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using h) + (fun offset hoffset => by + have h := hremaining (offset + 1) (by omega) + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using h) + simpa [List.range'_succ, selectedEntriesFrom, hhead, Γhead, head, + frameVEnvEntries, List.append_assoc, Nat.add_assoc, Nat.add_comm, + Nat.add_left_comm] using htail + | true => + have hnonzero : counts baseCount ≠ 0 := by + simpa [hhead] using hselectedHead + have hremainingHead' : remaining start = counts baseCount := by + simpa using hremainingHead + let head : VEntry := .slot next (remaining start) .many true + let Γhead := frameVEnvEntries Γ [head] + have hheadTracks : EntriesTrackCounts Γhead (baseCount + 1) counts := by + have hcanonical := EntriesTrackCounts.frameCanonicalSlot + (abs := next) (uses := .many) htracks hlength + have hheld : (counts baseCount != 0) = true := by simp [hnonzero] + rw [hheld] at hcanonical + simpa [Γhead, head, hremainingHead'] using hcanonical + have hheadLength : Γhead.entries.length = baseCount + 1 := by + simp [Γhead, head, frameVEnvEntries, hlength] + have htail := ih (Γ := Γhead) (baseCount := baseCount + 1) + hheadTracks hheadLength (start := start + 1) (next + 1) + (fun offset hoffset => by + have h := hselected (offset + 1) (by omega) + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using h) + (fun offset hoffset => by + have h := hremaining (offset + 1) (by omega) + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using h) + simpa [List.range'_succ, selectedEntriesFrom, hhead, Γhead, head, + frameVEnvEntries, List.append_assoc, Nat.add_assoc, Nat.add_comm, + Nat.add_left_comm] using htail + +/-- Every selected-entry frame consists solely of ordinary slots. -/ +theorem selectedEntriesFrom_noRecSelf + (selected : Nat → Bool) (remaining : Nat → Nat) : + ∀ (indices : List Nat) (next depth : Nat), + NoRecSelf + ⟨selectedEntriesFrom selected remaining indices next, depth⟩ := by + intro indices next depth + exact selectedEntriesFrom_traverse selected remaining + (Result := fun _ _ entries => NoRecSelf ⟨entries, depth⟩) + (hnil := fun _ => NoRecSelf.empty) + (hfalse := by + intro index rest current tail hselected htail + exact htail.consSlot 0 0 .many false) + (htrue := by + intro index rest current tail hselected htail + exact htail.consSlot current (remaining index) .many true) + indices next + +/-- Concatenating two self-free logical entry blocks remains self-free. -/ +theorem NoRecSelf.appendEntries + {left right : List VEntry} {depth : Nat} + (hleft : NoRecSelf ⟨left, depth⟩) + (hright : NoRecSelf ⟨right, depth⟩) : + NoRecSelf ⟨left ++ right, depth⟩ := by + apply NoRecSelf.of_mem_not_recSelf + intro entry hmember arity heq + rw [List.mem_append] at hmember + cases hmember with + | inl hleftMember => + obtain ⟨index, hget⟩ := List.mem_iff_getElem?.mp hleftMember + subst entry + exact hleft index arity hget + | inr hrightMember => + obtain ⟨index, hget⟩ := List.mem_iff_getElem?.mp hrightMember + subst entry + exact hright index arity hget + +/-- A successfully lowered lifted body preserves the all-shared public +capture-plus-parameter signature. This closes entry realization, generated +parameter cleanup, exact consumption of both parameter and captured-variable +entries, and the self-free body boundary in one declaration-level rule. -/ +theorem lowerFnBody_liftedEntries_preservesAt + {ctx : Ctx} {limit : Nat} {src : IxIR0.Env} {fuel : Nat} + (happly : ApplyOwnershipContractBelow ctx limit) + (hdecls : SourceDeclContractsBelow src ctx limit) + (entryCount : Nat) (modes : List Uses) (body : IxIR0.Expr) + (selected : Nat → Bool) + {state finalState : LowSt} {code : Code} + (hadmissible : ParameterDropsAdmissible modes + (fun index => countUses index body)) + (hselected : ∀ index, index < entryCount → + selected index = (countUses (modes.length + index) body != 0)) + (hpositive : 0 < modes.length) + (hshared : modes.map worldOfUses = + List.replicate modes.length .shared) + (hrun : (lowerFnBody src (fuel + 1) + (let captures := (List.range entryCount).filter selected + ⟨parameterEntries captures.length modes + (fun index => countUses index body) ++ + selectedEntriesFrom selected + (fun index => countUses (modes.length + index) body) + (List.range entryCount) 0, + captures.length + modes.length⟩) + (let captures := (List.range entryCount).filter selected + parameterDrops captures.length modes + (fun index => countUses index body)) + .shared body).run state = .ok code finalState) + (hrepresented : ExtraRepresented ctx finalState) : + let captures := (List.range entryCount).filter selected + FnOwnershipPreservesAt ctx + ⟨captures.length + modes.length, .shared, true, code⟩ + (List.replicate (captures.length + modes.length) .shared) limit := by + dsimp only + let captures := (List.range entryCount).filter selected + let parameterRemaining : Nat → Nat := fun index => countUses index body + let captureRemaining : Nat → Nat := + fun index => countUses (modes.length + index) body + let outerEntries := selectedEntriesFrom selected captureRemaining + (List.range entryCount) 0 + let input : VEnv := + ⟨parameterEntries captures.length modes parameterRemaining ++ outerEntries, + captures.length + modes.length⟩ + let drops := parameterDrops captures.length modes parameterRemaining + have hrun' : + (lowerFnBody src (fuel + 1) input drops .shared body).run state = + .ok code finalState := by + simpa [input, drops, outerEntries, parameterRemaining, captureRemaining, + captures] using hrun + have hno : NoRecSelf input := by + apply NoRecSelf.appendEntries + · exact parameterEntries_noRecSelf captures.length modes + parameterRemaining (captures.length + modes.length) + · simpa [outerEntries] using + selectedEntriesFrom_noRecSelf selected captureRemaining + (List.range entryCount) 0 (captures.length + modes.length) + obtain ⟨middle, releaseEmit, releaseState, output, emit, av, + hreleaseRun, hbodyRun, hcode, hbodySound⟩ := + lowerFnBody_run_sound_below_noRecSelf + (cur := + (⟨captures.length + modes.length, .shared, true, code⟩ : FnDef)) + happly hdecls hrun' hrepresented hno + obtain ⟨parameterOutput, plannedEmit, hparameterPlan, hparameterTracks⟩ := + parameterDrops_releasePlan_tracked_atDepth captures.length + (captures.length + modes.length) modes parameterRemaining + (by simpa [parameterRemaining] using hadmissible) + let plannedMiddle := frameVEnvEntries parameterOutput outerEntries + have hplan : ReleasePlan input drops plannedMiddle plannedEmit := by + have hframed := hparameterPlan.frameEntries outerEntries + simpa [input, drops, plannedMiddle, outerEntries, frameVEnvEntries] + using hframed + have hplanRun : (releaseSlots input drops).run state = + .ok (plannedMiddle, plannedEmit) state := hplan.run state + have heq : + (plannedMiddle, plannedEmit) = (middle, releaseEmit) ∧ + state = releaseState := by + simpa using hplanRun.symm.trans hreleaseRun + have hmiddle : plannedMiddle = middle := congrArg Prod.fst heq.1 + have hemit : plannedEmit = releaseEmit := congrArg Prod.snd heq.1 + subst middle + subst releaseEmit + have hstate := heq.2 + subst releaseState + have hparameterLength : parameterOutput.entries.length = modes.length := by + calc + parameterOutput.entries.length = + (parameterEntries captures.length modes parameterRemaining).length := + hparameterPlan.entries_length + _ = modes.length := parameterEntries_length _ _ _ + have htracks : EntriesTrackCounts plannedMiddle (modes.length + entryCount) + (fun index => countUses index body) := by + have hframed := hparameterTracks.frameSelectedRange hparameterLength + selected captureRemaining 0 entryCount 0 + (fun offset hoffset => by + simpa [captureRemaining] using hselected offset hoffset) + (fun offset hoffset => by + simp [captureRemaining, parameterRemaining]) + simpa [plannedMiddle, outerEntries, List.range_eq_range'] using hframed + have hconsume := lowerE_consumesEntries hbodyRun + have hcount := lowerE_preservesEntryCount hbodyRun + have hmiddleLength : plannedMiddle.entries.length = + modes.length + entryCount := by + calc + plannedMiddle.entries.length = input.entries.length := hplan.entries_length + _ = modes.length + entryCount := by + simp [input, outerEntries, parameterRemaining, captureRemaining] + have hreleased : EntriesReleased output.entries := + hconsume.entriesReleased htracks (Eq.trans hcount hmiddleLength) + have hfull : LowerResultSoundBelow ctx + (⟨captures.length + modes.length, .shared, true, code⟩ : FnDef) + limit input output .shared (plannedEmit ∘ emit) av := + hbodySound.afterRelease hplan.soundBelow + apply hfull.fnOwnershipPreservesAt + (FnEntryRealizes.lifted entryCount modes parameterRemaining selected + captureRemaining hpositive hshared) + · simp [captures] + · exact hreleased + · exact hcode + +/-- Semantic execution of one generated lifted body at an exact target +fuel. The stored capture prefix and the remaining lambda parameters are +separated explicitly: selected outer values populate the framed source +environment, while the complete supplied-parameter vector is reversed in +front of it, exactly as in the source evaluator. -/ +theorem lowerFnBody_liftedEntries_run_value_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {ctx : Ctx} {limit compilerFuel targetFuel : Nat} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + (entryCount : Nat) (modes : List Uses) (body : IxIR0.Expr) + (selected : Nat → Bool) + {state finalState : LowSt} {code : Code} + (hadmissible : ParameterDropsAdmissible modes + (fun index => countUses index body)) + (hselectDef : ∀ index, index < entryCount → + selected index = (countUses (modes.length + index) body != 0)) + (hpositive : 0 < modes.length) + (hshared : modes.map worldOfUses = + List.replicate modes.length .shared) + (hrun : (lowerFnBody src (compilerFuel + 1) + (let captures := (List.range entryCount).filter selected + ⟨parameterEntries captures.length modes + (fun index => countUses index body) ++ + selectedEntriesFrom selected + (fun index => countUses (modes.length + index) body) + (List.range entryCount) 0, + captures.length + modes.length⟩) + (let captures := (List.range entryCount).filter selected + parameterDrops captures.length modes + (fun index => countUses index body)) + .shared body).run state = .ok code finalState) + (hextends : ExtraExtends finalState ambient) + {sourceEnv selectedSources parameterSources : List IxIR0.Value} + {sourceResult : IxIR0.Value} + {store store' : Store} {captureArgs parameterArgs : List RVal} + {value : RVal} {sourceRest : List (Owned × IxIR0.Value)} + {rest : List Root} + (hsourceLength : sourceEnv.length = entryCount) + (hselectedValues : ValuesAt sourceEnv + ((List.range entryCount).filter selected) selectedSources) + (hcaptureLength : captureArgs.length = + ((List.range entryCount).filter selected).length) + (hparameterLength : parameterArgs.length = modes.length) + (hcaptureGraph : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store selectedSources + captureArgs) + (hparameterGraph : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store parameterSources + parameterArgs) + (hsource : ∃ sourceFuel, IxIR0.eval sourceCtx sourceFuel + (parameterSources.reverse ++ sourceEnv) body = .ok sourceResult) + (hframe : Sim.RootsGraph (CompilerFunctionRel sourceCtx src ambient) + store sourceRest rest) + (hown : RootOwnership store + (rootsFor .shared (captureArgs ++ parameterArgs) ++ rest)) + (htarget : targetFuel ≤ limit) + (hcodeRun : runCode ctx targetFuel + ⟨((List.range entryCount).filter selected).length + modes.length, + .shared, true, code⟩ store (captureArgs ++ parameterArgs).reverse code = + .ok (store', value)) : + Sim.ValueGraph (CompilerFunctionRel sourceCtx src ambient) store' + sourceResult value ∧ + Sim.RootsGraph (CompilerFunctionRel sourceCtx src ambient) store' + sourceRest rest := by + let captures := (List.range entryCount).filter selected + let parameterRemaining : Nat → Nat := fun index => countUses index body + let captureRemaining : Nat → Nat := + fun index => countUses (modes.length + index) body + let outerEntries := selectedEntriesFrom selected captureRemaining + (List.range entryCount) 0 + let input : VEnv := + ⟨parameterEntries captures.length modes parameterRemaining ++ outerEntries, + captures.length + modes.length⟩ + let drops := parameterDrops captures.length modes parameterRemaining + have hrun' : + (lowerFnBody src (compilerFuel + 1) input drops .shared body).run state = + .ok code finalState := by + simpa [input, drops, outerEntries, parameterRemaining, captureRemaining, + captures] using hrun + simp only [lowerFnBody] at hrun' + obtain ⟨releaseResult, releaseState, hreleaseRun, hafterRelease⟩ := + trackedBindRun_ok_inv hrun' + rcases releaseResult with ⟨middle, releaseEmit⟩ + obtain ⟨bodyResult, bodyState, hbodyRun, hafterBody⟩ := + trackedBindRun_ok_inv hafterRelease + rcases bodyResult with ⟨output, emit, av⟩ + have hpure : + (releaseEmit ∘ emit) (.ret (av.toAtom output)) = code ∧ + bodyState = finalState := by + simpa using hafterBody + obtain ⟨hcode, hbodyState⟩ := hpure + subst bodyState + have hinputNo : NoRecSelf input := by + apply NoRecSelf.appendEntries + · exact parameterEntries_noRecSelf captures.length modes + parameterRemaining (captures.length + modes.length) + · simpa [outerEntries] using + selectedEntriesFrom_noRecSelf selected captureRemaining + (List.range entryCount) 0 (captures.length + modes.length) + have hmiddleNo : NoRecSelf middle := + releaseSlots_noRecSelf input hreleaseRun hinputNo + obtain ⟨parameterOutput, plannedEmit, hparameterPlan, + hparameterTracks⟩ := + parameterDrops_releasePlan_tracked_atDepth captures.length + (captures.length + modes.length) modes parameterRemaining + (by simpa [parameterRemaining] using hadmissible) + let plannedMiddle := frameVEnvEntries parameterOutput outerEntries + have hplan : ReleasePlan input drops plannedMiddle plannedEmit := by + have hframed := hparameterPlan.frameEntries outerEntries + simpa [input, drops, plannedMiddle, outerEntries, frameVEnvEntries] + using hframed + have hplanRun : (releaseSlots input drops).run state = + .ok (plannedMiddle, plannedEmit) state := hplan.run state + have heq : + (plannedMiddle, plannedEmit) = (middle, releaseEmit) ∧ + state = releaseState := by + simpa using hplanRun.symm.trans hreleaseRun + have hmiddle : plannedMiddle = middle := congrArg Prod.fst heq.1 + have hemit : plannedEmit = releaseEmit := congrArg Prod.snd heq.1 + subst middle + subst releaseEmit + cases heq.2 + have hparameterOutputLength : parameterOutput.entries.length = + modes.length := by + calc + parameterOutput.entries.length = + (parameterEntries captures.length modes parameterRemaining).length := + hparameterPlan.entries_length + _ = modes.length := parameterEntries_length _ _ _ + have htracks : EntriesTrackCounts plannedMiddle + (modes.length + entryCount) (fun index => countUses index body) := by + have hframed := hparameterTracks.frameSelectedRange + hparameterOutputLength selected captureRemaining 0 entryCount 0 + (fun offset hoffset => by + simpa [captureRemaining] using hselectDef offset hoffset) + (fun offset hoffset => by + simp [captureRemaining, parameterRemaining]) + simpa [plannedMiddle, outerEntries, List.range_eq_range'] using hframed + have hconsume := lowerE_consumesEntries hbodyRun + have hcount := lowerE_preservesEntryCount hbodyRun + have hmiddleLength : plannedMiddle.entries.length = + modes.length + entryCount := by + calc + plannedMiddle.entries.length = input.entries.length := + hplan.entries_length + _ = modes.length + entryCount := by + simp [input, outerEntries, parameterRemaining, captureRemaining] + have hreleased : EntriesReleased output.entries := + hconsume.entriesReleased htracks (Eq.trans hcount hmiddleLength) + obtain ⟨sourceFuel, hsourceEval⟩ := hsource + have hbodySound : LowerResultValueSoundBelow + (CompilerFunctionRel sourceCtx src ambient) (fun _ _ => False) ctx + ⟨captures.length + modes.length, .shared, true, code⟩ + limit plannedMiddle + output (parameterSources.reverse ++ sourceEnv) + (parameterSources.reverse ++ sourceEnv) sourceResult .shared emit av := + lowerE_run_value_sound_within_noRecSelf_below + (recSelfRel := fun _ _ => False) + (cur := + (⟨captures.length + modes.length, .shared, true, code⟩ : FnDef)) + henv hrepresented hcontracts hvalues hsourceEval hbodyRun hextends + hmiddleNo + have hfull : LowerResultValueSoundBelow + (CompilerFunctionRel sourceCtx src ambient) (fun _ _ => False) ctx + ⟨captures.length + modes.length, .shared, true, code⟩ + limit input output + (parameterSources.reverse ++ sourceEnv) + (parameterSources.reverse ++ sourceEnv) sourceResult .shared + (plannedEmit ∘ emit) av := + hbodySound.afterRelease + (hplan.valueSoundBelow (parameterSources.reverse ++ sourceEnv)) + have hentryGraph : VEnvValueGraph + (CompilerFunctionRel sourceCtx src ambient) (fun _ _ => False) store + input (parameterSources.reverse ++ sourceEnv) + (captureArgs ++ parameterArgs).reverse + ((rootsForWorlds (modes.map worldOfUses) parameterArgs).reverse ++ + rootsFor .shared captureArgs) := by + simpa [input, outerEntries, parameterRemaining, captureRemaining, + captures] using + VEnvValueGraph.lifted (recSelfRel := fun _ _ => False) + entryCount modes parameterRemaining selected captureRemaining + hsourceLength hselectedValues hcaptureLength hparameterLength + hcaptureGraph hparameterGraph hpositive hshared hown + have hparameterRoots : + rootsForWorlds (modes.map worldOfUses) parameterArgs = + rootsFor .shared parameterArgs := by + rw [hshared] + exact rootsForWorlds_replicate_eq_rootsFor .shared hparameterLength + have hpre : GraphOwnsVEnv + (CompilerFunctionRel sourceCtx src ambient) (fun _ _ => False) input + (parameterSources.reverse ++ sourceEnv) sourceRest rest store + (captureArgs ++ parameterArgs).reverse := by + refine ⟨(rootsForWorlds + (modes.map worldOfUses) parameterArgs).reverse ++ + rootsFor .shared captureArgs, hentryGraph, hframe, ?_⟩ + have hrootPerm : + (rootsFor .shared (captureArgs ++ parameterArgs) ++ rest).Perm + (((rootsForWorlds (modes.map worldOfUses) parameterArgs).reverse ++ + rootsFor .shared captureArgs) ++ rest) := by + rw [hparameterRoots] + simp only [rootsFor, List.map_append] + exact (List.perm_append_comm.trans + ((List.reverse_perm + (parameterArgs.map fun value => (⟨.shared, value⟩ : Root))).symm + |>.append_right (captureArgs.map fun value => + (⟨.shared, value⟩ : Root)))).append_right rest + exact hown.perm hrootPerm + have hcodeRun' : runCode ctx targetFuel + ⟨captures.length + modes.length, .shared, true, code⟩ store + (captureArgs ++ parameterArgs).reverse + ((plannedEmit ∘ emit) (.ret (av.toAtom output))) = + .ok (store', value) := by + rw [hcode] + simpa [captures] using hcodeRun + exact hfull.closeGraph hreleased sourceRest rest htarget hpre hcodeRun' + +/-- A compiler-provenanced lifted pap computes its residual source closure +when the stored prefix plus the newly supplied arguments saturate the +generated declaration. This is the generated-function branch needed by +the semantic `applyGo` proof; unlike `FnValuePreservesAt`, selected outer +captures are target calling arguments but are not source applications. -/ +theorem invoke_lifted_value_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {ctx : Ctx} {limit fuel : Nat} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + {sourceFunction sourceResult : IxIR0.Value} + {address : Ixon.Address} {arity : Nat} + {captures sourceArgs : List IxIR0.Value} + {store store' : Store} {got args : List RVal} {value : RVal} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hlifted : CompilerLiftedFunctionRel src ambient sourceFunction address + arity captures) + (hgot : Sim.ValuesGraph (CompilerFunctionRel sourceCtx src ambient) + store captures got) + (hargs : Sim.ValuesGraph (CompilerFunctionRel sourceCtx src ambient) + store sourceArgs args) + (happlies : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) + (hframe : Sim.RootsGraph (CompilerFunctionRel sourceCtx src ambient) + store sourceRest rest) + (hown : RootOwnership store + (rootsFor .shared (got ++ args) ++ rest)) + (hfuel : fuel ≤ limit) + (hinvoke : invoke ctx fuel address (got ++ args) store = + .ok (store', value)) : + Sim.ValueGraph (CompilerFunctionRel sourceCtx src ambient) store' + sourceResult value ∧ + Sim.RootsGraph (CompilerFunctionRel sourceCtx src ambient) store' + sourceRest rest := by + obtain ⟨sourceEnv, expr, selectedSources, suppliedSources, hliftCode, + hselectedValues, hcaptures, harity, hprefix⟩ := hlifted + subst captures + subst arity + obtain ⟨bodyCompilerFuel, bodyInitial, bodyFinal, code, hsafe, + hbodyRun, hbodyExtends, hmember⟩ := hliftCode + have hselectedLength := hselectedValues.length + rw [← hselectedLength] at hmember + have hdecl : ctx.decls address = some (.fn + ⟨selectedSources.length + lamArity expr, .shared, true, code⟩) := + hrepresented.decl hmember + have hmodes := papSafe_lamUses_eq_replicate hsafe + have hadmissible : ParameterDropsAdmissible (lamUses expr) + (fun index => countUses index (stripLams expr)) := by + rw [hmodes] + exact parameterDropsAdmissible_replicate_many _ _ + have hselectDef : ∀ index, index < sourceEnv.length → + decide (0 < countUses index expr) = + (countUses ((lamUses expr).length + index) (stripLams expr) != 0) := by + intro index _ + rw [lamUses_length] + rw [← countUses_eq_stripLams_shift expr index] + cases countUses index expr <;> rfl + have hshared : (lamUses expr).map worldOfUses = + List.replicate (lamUses expr).length .shared := by + rw [hmodes] + simp [worldOfUses] + have hpositive : 0 < (lamUses expr).length := by + have hunder := hprefix.length_lt_lamArity + rw [lamUses_length] + omega + cases bodyCompilerFuel with + | zero => + exact (trackedThrowRun_not_ok + (by simpa [lowerFnBody] using hbodyRun)).elim + | succ compilerFuel => + let selectedArgs := got.take selectedSources.length + let suppliedArgs := got.drop selectedSources.length + have hgotSplit : selectedArgs ++ suppliedArgs = got := by + exact List.take_append_drop selectedSources.length got + have hselectedGraph : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store selectedSources + selectedArgs := by + simpa [selectedArgs] using hgot.take selectedSources.length + have hsuppliedGraph : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store suppliedSources + suppliedArgs := by + simpa [suppliedArgs] using hgot.drop selectedSources.length + have hparameterGraph : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store + (suppliedSources ++ sourceArgs) (suppliedArgs ++ args) := + hsuppliedGraph.append hargs + have hselectedArgsLength : selectedArgs.length = + (liftCaptureIndices sourceEnv.length expr).length := by + calc + selectedArgs.length = selectedSources.length := by + simpa [selectedArgs] using hselectedGraph.length.symm + _ = (liftCaptureIndices sourceEnv.length expr).length := + hselectedValues.length + have htotalSplit : selectedArgs ++ (suppliedArgs ++ args) = + got ++ args := by + rw [← List.append_assoc, hgotSplit] + have hownSplit : RootOwnership store + (rootsFor .shared (selectedArgs ++ (suppliedArgs ++ args)) ++ + rest) := by + rw [htotalSplit] + exact hown + have hbodyRun' : + (lowerFnBody src (compilerFuel + 1) + (liftedBodyVEnv sourceEnv.length expr) + (liftedBodyDrops sourceEnv.length expr) .shared + (stripLams expr)).run bodyInitial = .ok code bodyFinal := by + simpa using hbodyRun + cases fuel with + | zero => simp [invoke] at hinvoke + | succ innerFuel => + simp only [invoke, hdecl] at hinvoke + split at hinvoke + · contradiction + next hlength => + have htotalLength : (got ++ args).length = + selectedSources.length + lamArity expr := by + simpa using hlength + have hparameterLength : (suppliedArgs ++ args).length = + (lamUses expr).length := by + have hgotLength : got.length = + selectedSources.length + suppliedSources.length := by + simpa using hgot.length.symm + have hsuppliedLength : suppliedArgs.length = + suppliedSources.length := hsuppliedGraph.length.symm + simp only [List.length_append] at htotalLength ⊢ + rw [lamUses_length] + omega + have hlambdaLength : (suppliedSources ++ sourceArgs).length = + lamArity expr := by + calc + (suppliedSources ++ sourceArgs).length = + (suppliedArgs ++ args).length := hparameterGraph.length + _ = (lamUses expr).length := hparameterLength + _ = lamArity expr := lamUses_length expr + obtain ⟨sourceFuel, hsourceEval⟩ := + hprefix.saturate hlambdaLength happlies + cases hcodeEval : runCode ctx innerFuel + ⟨selectedSources.length + lamArity expr, .shared, true, code⟩ + store + (got ++ args).reverse code with + | error error => + rw [hcodeEval] at hinvoke + change (.error error : Except Err (Store × RVal)) = + .ok (store', value) at hinvoke + contradiction + | ok out => + rw [hcodeEval] at hinvoke + change checkResultWorld .shared out = .ok (store', value) at hinvoke + obtain ⟨hpair, _⟩ := checkResultWorld_ok hinvoke + subst out + have hcodeEval' : runCode ctx innerFuel + ⟨(liftCaptureIndices sourceEnv.length expr).length + + (lamUses expr).length, + .shared, true, code⟩ store + (selectedArgs ++ (suppliedArgs ++ args)).reverse code = + .ok (store', value) := by + rw [htotalSplit, ← hselectedLength, lamUses_length] + exact hcodeEval + exact lowerFnBody_liftedEntries_run_value_within_below + (compilerFuel := compilerFuel) (targetFuel := innerFuel) + henv hrepresented hcontracts hvalues sourceEnv.length + (lamUses expr) (stripLams expr) + (fun index => countUses index expr > 0) + hadmissible hselectDef hpositive hshared + (by simpa [liftedBodyVEnv, liftedBodyDrops, + liftCaptureIndices] using hbodyRun') + hbodyExtends (sourceEnv := sourceEnv) + (selectedSources := selectedSources) + (parameterSources := suppliedSources ++ sourceArgs) + (captureArgs := selectedArgs) + (parameterArgs := suppliedArgs ++ args) + (sourceResult := sourceResult) rfl + (by simpa [liftCaptureIndices] using hselectedValues) + (by simpa [liftCaptureIndices] using hselectedArgsLength) + hparameterLength hselectedGraph hparameterGraph + ⟨sourceFuel, hsourceEval⟩ hframe hownSplit (by omega) + hcodeEval' + +/-- Semantic companion of `applyGo_preparePap_owned`. Retaining the stored +pap values is a graph extension; consuming the old pap is a restriction, and +the exact post-state ownership roots keep every stored argument, new +argument, and caller-frame graph live across both steps. -/ +theorem applyGo_preparePap_valueGraphs + {funRel : Sim.FunctionRel} {ctx : Ctx} {fuel : Nat} + {store dupStore readyStore : Store} {loc rc : Nat} + {address : Ixon.Address} {arity : Nat} {got : Array RVal} + {args : List RVal} {captures sourceArgs : List IxIR0.Value} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hget : store.get? loc = some + ⟨.shared, rc, .papN address arity got⟩) + (hcaptures : Sim.ValuesGraph funRel store captures got.toList) + (hargs : Sim.ValuesGraph funRel store sourceArgs args) + (hframe : Sim.RootsGraph funRel store sourceRest rest) + (hown : RootOwnership store + (⟨.shared, .loc loc⟩ :: rootsFor .shared args ++ rest)) + (hdup : dupVals store got.toList = .ok dupStore) + (hdrop : dropVal ctx fuel dupStore (.loc loc) = .ok readyStore) : + Sim.ValuesGraph funRel readyStore captures got.toList ∧ + Sim.ValuesGraph funRel readyStore sourceArgs args ∧ + Sim.RootsGraph funRel readyStore sourceRest rest ∧ + RootOwnership readyStore + (rootsFor .shared (got.toList ++ args) ++ rest) := by + have hready : RootOwnership readyStore + (rootsFor .shared (got.toList ++ args) ++ rest) := + applyGo_preparePap_owned hget hown hdup hdrop + have hextends : StoreGraphExtends store dupStore := dupVals_extends hdup + have hrestricts : StoreGraphRestricts dupStore readyStore := + dropVal_restricts hdrop + have hcombined : Sim.ValuesGraph funRel dupStore + (captures ++ sourceArgs) (got.toList ++ args) := + (hcaptures.append hargs).monoStore hextends + have hcombinedReady : Sim.ValuesGraph funRel readyStore + (captures ++ sourceArgs) (got.toList ++ args) := by + apply hcombined.ofRestrictsIn hrestricts hready + intro runtime hmember + exact ⟨.shared, List.mem_append_left rest (by + simpa [rootsFor] using hmember)⟩ + obtain ⟨hcapturesReady, hargsReady⟩ := + hcombinedReady.splitAppend hcaptures.length + have hframeReady : Sim.RootsGraph funRel readyStore sourceRest rest := by + apply hframe.monoStore hextends |>.ofRestrictsIn hrestricts hready + intro root hmember + exact List.mem_append_right _ hmember + exact ⟨hcapturesReady, hargsReady, hframeReady, hready⟩ + +/-- Ownership half of lifted-function invocation, recovered directly from +the same exact generated-body provenance used by +`invoke_lifted_value_below`. -/ +theorem invoke_lifted_owned_below + {src : IxIR0.Env} {ambient : LowSt} {ctx : Ctx} {fuel : Nat} + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + {sourceFunction : IxIR0.Value} {address : Ixon.Address} {arity : Nat} + {captures : List IxIR0.Value} {runtimeArgs : List RVal} + {store store' : Store} {value : RVal} {rest : List Root} + (hlifted : CompilerLiftedFunctionRel src ambient sourceFunction address + arity captures) + (hown : RootOwnership store + (rootsFor .shared runtimeArgs ++ rest)) + (hinvoke : invoke ctx fuel address runtimeArgs store = + .ok (store', value)) : + RootOwnership store' (⟨.shared, value⟩ :: rest) := by + obtain ⟨sourceEnv, expr, selectedSources, suppliedSources, hliftCode, + hselectedValues, _, _, hprefix⟩ := hlifted + obtain ⟨bodyCompilerFuel, bodyInitial, bodyFinal, code, hsafe, + hbodyRun, hbodyExtends, hmember⟩ := hliftCode + have hdecl : ctx.decls address = some (.fn + ⟨(liftCaptureIndices sourceEnv.length expr).length + lamArity expr, + .shared, true, code⟩) := hrepresented.decl hmember + have hmodes := papSafe_lamUses_eq_replicate hsafe + have hadmissible : ParameterDropsAdmissible (lamUses expr) + (fun index => countUses index (stripLams expr)) := by + rw [hmodes] + exact parameterDropsAdmissible_replicate_many _ _ + have hselectDef : ∀ index, index < sourceEnv.length → + decide (0 < countUses index expr) = + (countUses ((lamUses expr).length + index) (stripLams expr) != 0) := by + intro index _ + rw [lamUses_length] + rw [← countUses_eq_stripLams_shift expr index] + cases countUses index expr <;> rfl + have hshared : (lamUses expr).map worldOfUses = + List.replicate (lamUses expr).length .shared := by + rw [hmodes] + simp [worldOfUses] + have hpositive : 0 < (lamUses expr).length := by + have hunder := hprefix.length_lt_lamArity + rw [lamUses_length] + omega + cases bodyCompilerFuel with + | zero => + exact (trackedThrowRun_not_ok + (by simpa [lowerFnBody] using hbodyRun)).elim + | succ compilerFuel => + have hbodyRun' : + (lowerFnBody src (compilerFuel + 1) + (liftedBodyVEnv sourceEnv.length expr) + (liftedBodyDrops sourceEnv.length expr) .shared + (stripLams expr)).run bodyInitial = .ok code bodyFinal := by + simpa using hbodyRun + have hbodyRepresented : ExtraRepresented ctx bodyFinal := + hrepresented.of_extends hbodyExtends + have hownership : FnOwnershipContractBelow ctx + ⟨(liftCaptureIndices sourceEnv.length expr).length + lamArity expr, + .shared, true, code⟩ + (List.replicate + ((liftCaptureIndices sourceEnv.length expr).length + + lamArity expr) .shared) fuel := by + constructor + · simp + · intro smaller hsmaller + have hpreserves : FnOwnershipPreservesAt ctx + ⟨(liftCaptureIndices sourceEnv.length expr).length + + (lamUses expr).length, + .shared, true, code⟩ + (List.replicate + ((liftCaptureIndices sourceEnv.length expr).length + + (lamUses expr).length) .shared) smaller := + lowerFnBody_liftedEntries_preservesAt + (limit := smaller) (fuel := compilerFuel) + (state := bodyInitial) (finalState := bodyFinal) (code := code) + (hcontracts.apply.below smaller) + (hcontracts.decls.below smaller) sourceEnv.length + (lamUses expr) (stripLams expr) + (fun index => countUses index expr > 0) + hadmissible hselectDef hpositive hshared + (by simpa [liftedBodyVEnv, liftedBodyDrops, + liftCaptureIndices] using hbodyRun') hbodyRepresented + intro callStore callStore' callArgs callValue callRest hlength + hcallOwn hcallRun + exact hpreserves + (by simpa [lamUses_length] using hlength) + (by simpa [lamUses_length] using hcallOwn) + (by simpa [lamUses_length] using hcallRun) + have hargsLength : runtimeArgs.length = + (liftCaptureIndices sourceEnv.length expr).length + + lamArity expr := by + simpa [declArity] using invoke_success_length hdecl hinvoke + have hroots : rootsForWorlds + (List.replicate + ((liftCaptureIndices sourceEnv.length expr).length + + lamArity expr) .shared) runtimeArgs = + rootsFor .shared runtimeArgs := + rootsForWorlds_replicate_eq_rootsFor .shared hargsLength + have hown' : RootOwnership store + (rootsForWorlds + (List.replicate + ((liftCaptureIndices sourceEnv.length expr).length + + lamArity expr) .shared) runtimeArgs ++ rest) := by + rwa [hroots] + exact invoke_fn_owned_below hdecl hownership hown' hinvoke + +/-- Saturating invocation for every origin admitted by +`CompilerFunctionRel`. Besides source-result and caller-frame graphs, the +paired ownership conclusion is retained for an over-application tail. -/ +theorem invoke_compilerFunction_value_owned_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {ctx : Ctx} {limit fuel : Nat} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) + (hwrapperValue : ∀ (memo : WrapperMemo) + (baseFunction : IxIR0.Value), + sourceCtx.env memo.source = some (.ctor memo.tag memo.arity) → + SourceRefValue sourceCtx memo.source baseFunction → + FnValueContract (CompilerFunctionRel sourceCtx src ambient) + sourceCtx ctx + ⟨memo.arity, .shared, true, + .letOp (.alloc .shared (ctorIdOf memo.source memo.tag) + (descendingVars memo.arity).toArray) (.ret (.var 0))⟩ + (List.replicate memo.arity .shared) baseFunction) + (hwrapperOwnership : ∀ memo : WrapperMemo, + FnOwnershipContract ctx + ⟨memo.arity, .shared, true, + .letOp (.alloc .shared (ctorIdOf memo.source memo.tag) + (descendingVars memo.arity).toArray) (.ret (.var 0))⟩ + (List.replicate memo.arity .shared)) + {sourceFunction sourceResult : IxIR0.Value} + {address : Ixon.Address} {arity : Nat} + {captures sourceArgs : List IxIR0.Value} + {store store' : Store} {got args : List RVal} {value : RVal} + {sourceRest : List (Owned × IxIR0.Value)} {rest : List Root} + (hrel : CompilerFunctionRel sourceCtx src ambient sourceFunction address + arity captures) + (hcaptures : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store captures got) + (hargs : Sim.ValuesGraph (CompilerFunctionRel sourceCtx src ambient) + store sourceArgs args) + (happlies : SourceApplies sourceCtx sourceFunction sourceArgs + sourceResult) + (hframe : Sim.RootsGraph (CompilerFunctionRel sourceCtx src ambient) + store sourceRest rest) + (hown : RootOwnership store + (rootsFor .shared (got ++ args) ++ rest)) + (hfuel : fuel ≤ limit) + (hinvoke : invoke ctx fuel address (got ++ args) store = + .ok (store', value)) : + Sim.ValueGraph (CompilerFunctionRel sourceCtx src ambient) store' + sourceResult value ∧ + Sim.RootsGraph (CompilerFunctionRel sourceCtx src ambient) store' + sourceRest rest ∧ + RootOwnership store' (⟨.shared, value⟩ :: rest) := by + cases hrel with + | @source relatedFunction baseFunction targetAddress targetArity + storedSources source hsrc heligible harity href hprefix hunder => + have hfullGraph : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store + (captures ++ sourceArgs) (got ++ args) := + hcaptures.append hargs + have hfullApply : SourceApplies sourceCtx baseFunction + (captures ++ sourceArgs) sourceResult := + hprefix.append happlies + cases source with + | defn result body => + obtain ⟨hresultShared, hsafe⟩ := heligible + subst result + obtain ⟨d, hdecl, harityDef, hresultDef, hownership⟩ := + hcontracts.decls.defn hsrc + have hvalueContract : FnValueContractBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + ((lamUses body).map worldOfUses) baseFunction limit := by + apply hvalues.decls.fnContract hsrc (by rfl) hdecl href + simpa using harityDef.symm + have hmodes := papSafe_lamUses_eq_replicate hsafe + have hworlds : (lamUses body).map worldOfUses = + List.replicate (lamUses body).length .shared := by + rw [hmodes] + simp [worldOfUses] + have htotalLength : (got ++ args).length = + (lamUses body).length := by + have hinvokeLength := invoke_success_length hdecl hinvoke + simpa [declArity, harityDef] using hinvokeLength + have hroots : rootsForWorlds + ((lamUses body).map worldOfUses) (got ++ args) = + rootsFor .shared (got ++ args) := by + rw [hworlds] + exact rootsForWorlds_replicate_eq_rootsFor .shared htotalLength + have hown' : RootOwnership store + (rootsForWorlds ((lamUses body).map worldOfUses) + (got ++ args) ++ rest) := by + rwa [hroots] + have hsemantic := invoke_fn_value_below hdecl + hvalueContract.arity_eq + (fun {smaller} hsmaller => hvalueContract.preserves + (Nat.lt_of_lt_of_le hsmaller hfuel)) + hfullGraph hfullApply hframe hown' hinvoke + have howned := invoke_fn_owned hdecl hownership hown' hinvoke + rw [hresultDef] at howned + exact ⟨hsemantic.1, hsemantic.2, howned⟩ + | ctor tag ctorArity => exact heligible.elim + | recursor numArgs natLit rules => + obtain ⟨d, hdecl, harityRec, hresultRec, hownership⟩ := + hcontracts.decls.recursor hsrc + have hvalueContract : FnValueContractBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx ctx d + (List.replicate (numArgs + 1) .shared) baseFunction limit := by + apply hvalues.decls.fnContract hsrc (by rfl) hdecl href + simpa using harityRec.symm + have htotalLength : (got ++ args).length = numArgs + 1 := by + have hinvokeLength := invoke_success_length hdecl hinvoke + simpa [declArity, harityRec] using hinvokeLength + have hroots : rootsForWorlds + (List.replicate (numArgs + 1) .shared) (got ++ args) = + rootsFor .shared (got ++ args) := + rootsForWorlds_replicate_eq_rootsFor .shared htotalLength + have hown' : RootOwnership store + (rootsForWorlds (List.replicate (numArgs + 1) .shared) + (got ++ args) ++ rest) := by + rwa [hroots] + have hsemantic := invoke_fn_value_below hdecl + hvalueContract.arity_eq + (fun {smaller} hsmaller => hvalueContract.preserves + (Nat.lt_of_lt_of_le hsmaller hfuel)) + hfullGraph hfullApply hframe hown' hinvoke + have howned := invoke_fn_owned hdecl hownership hown' hinvoke + rw [hresultRec] at howned + exact ⟨hsemantic.1, hsemantic.2, howned⟩ + | extern externArity => + have hdecl := hcontracts.decls.extern hsrc + have hlookup : sourceCtx.env address = + some (.extern externArity) := by + rw [henv] + exact hsrc + have hsourceLength : (captures ++ sourceArgs).length = + externArity := by + have hinvokeLength := invoke_success_length hdecl hinvoke + have hgraphLength := hfullGraph.length + simpa [declArity] using hgraphLength.trans hinvokeLength + cases fuel with + | zero => simp [invoke] at hinvoke + | succ innerFuel => + simp only [invoke, hdecl] at hinvoke + split at hinvoke + · contradiction + next _ => + cases horacle : callScalarOracle ctx address (got ++ args) with + | error error => + rw [horacle] at hinvoke + contradiction + | ok runtimeResult => + rw [horacle] at hinvoke + have hpair : (store, runtimeResult) = (store', value) := + Except.ok.inj hinvoke + cases hpair + have hvalueGraph := hvalues.extern.preserves hlookup href + hsourceLength hfullApply hfullGraph horacle + have hscalar := callScalarOracle_ok horacle + have howned : RootOwnership store + (⟨.shared, value⟩ :: rest) := + (hown.dropScalars hscalar.1).addNoLocation + (RVal.rvalLocation?_eq_none_of_isScalar hscalar.2) + exact ⟨hvalueGraph, hframe, howned⟩ + | @wrapper relatedFunction baseFunction storedSources memo hmember hsrc + href hprefix hunder => + let wrapperDef : FnDef := + ⟨memo.arity, .shared, true, + .letOp (.alloc .shared (ctorIdOf memo.source memo.tag) + (descendingVars memo.arity).toArray) (.ret (.var 0))⟩ + have hdecl : ctx.decls memo.wrapper = some (.fn wrapperDef) := by + simpa [wrapperDef, ctorWrapperDecl] using + hrepresented.wrapper hmember + have hlookup : sourceCtx.env memo.source = + some (.ctor memo.tag memo.arity) := by + rw [henv] + exact hsrc + have hfullGraph : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) store + (captures ++ sourceArgs) (got ++ args) := + hcaptures.append hargs + have hfullApply : SourceApplies sourceCtx baseFunction + (captures ++ sourceArgs) sourceResult := + hprefix.append happlies + have hvalueContract := hwrapperValue memo baseFunction hlookup href + have hownership := hwrapperOwnership memo + have htotalLength : (got ++ args).length = memo.arity := by + have hinvokeLength := invoke_success_length hdecl hinvoke + simpa [wrapperDef, declArity] using hinvokeLength + have hroots : rootsForWorlds + (List.replicate memo.arity .shared) (got ++ args) = + rootsFor .shared (got ++ args) := + rootsForWorlds_replicate_eq_rootsFor .shared htotalLength + have hown' : RootOwnership store + (rootsForWorlds (List.replicate memo.arity .shared) + (got ++ args) ++ rest) := by + rwa [hroots] + have hsemantic := invoke_fn_value_below hdecl hvalueContract.arity_eq + (fun {_} _ => hvalueContract.preserves) hfullGraph hfullApply hframe + hown' hinvoke + have howned := invoke_fn_owned hdecl hownership hown' hinvoke + exact ⟨hsemantic.1, hsemantic.2, howned⟩ + | lifted hlifted => + have hsemantic := invoke_lifted_value_below henv hrepresented + hcontracts hvalues hlifted hcaptures hargs happlies hframe hown hfuel + hinvoke + have howned := invoke_lifted_owned_below hrepresented hcontracts + hlifted hown hinvoke + exact ⟨hsemantic.1, hsemantic.2, howned⟩ + +/-- A successful lambda lowering adds the generated lifted declaration to the +compile state, and that declaration has the all-shared ownership contract +advertised by the emitted partial application. -/ +theorem lowerLam_generatedFn_preservesAt + {ctx : Ctx} {limit : Nat} {src : IxIR0.Env} {fuel : Nat} + (happly : ApplyOwnershipContractBelow ctx limit) + (hdecls : SourceDeclContractsBelow src ctx limit) + {input output : VEnv} {expr : IxIR0.Expr} + {state finalState : LowSt} {emit : Emit} {value : AVal} + (hpositive : 0 < lamArity expr) + (hrun : (lowerLam src (fuel + 1) input expr).run state = + .ok (output, emit, value) finalState) + (hrepresented : ExtraRepresented ctx finalState) : + let captures := (List.range input.entries.length).filter + (fun index => countUses index expr > 0) + ∃ address code, + (address, .fn + ⟨captures.length + lamArity expr, .shared, true, code⟩) ∈ + finalState.extra ∧ + ctx.decls address = some (.fn + ⟨captures.length + lamArity expr, .shared, true, code⟩) ∧ + FnOwnershipPreservesAt ctx + ⟨captures.length + lamArity expr, .shared, true, code⟩ + (List.replicate (captures.length + lamArity expr) .shared) limit := by + let captures := liftCaptureIndices input.entries.length expr + change ∃ address code, + (address, .fn + ⟨captures.length + lamArity expr, .shared, true, code⟩) ∈ + finalState.extra ∧ + ctx.decls address = some (.fn + ⟨captures.length + lamArity expr, .shared, true, code⟩) ∧ + FnOwnershipPreservesAt ctx + ⟨captures.length + lamArity expr, .shared, true, code⟩ + (List.replicate (captures.length + lamArity expr) .shared) limit + refine lowerLam_run_core + (Result := fun finalState _ _ _ => + ExtraRepresented ctx finalState → + ∃ address code, + (address, .fn + ⟨captures.length + lamArity expr, .shared, true, code⟩) ∈ + finalState.extra ∧ + ctx.decls address = some (.fn + ⟨captures.length + lamArity expr, .shared, true, code⟩) ∧ + FnOwnershipPreservesAt ctx + ⟨captures.length + lamArity expr, .shared, true, code⟩ + (List.replicate + (captures.length + lamArity expr) .shared) limit) + ?_ hrun hrepresented + intro bodyFuel _captureOutput _captureEmit _captureValues _captureState + fnAddr addressState code bodyState _hfuel hp _hcaptureRun _hfreshRun hbodyRun + hrepresented + let ambient : LowSt := + { bodyState with + extra := (fnAddr, .fn + ⟨captures.length + lamArity expr, .shared, true, code⟩) :: + bodyState.extra } + change ExtraRepresented ctx ambient at hrepresented + have hextends : ExtraExtends bodyState ambient := by + refine ⟨[(fnAddr, .fn + ⟨captures.length + lamArity expr, .shared, true, code⟩)], + [], ?_, ?_, ?_⟩ + · simp [ambient] + · simp [ambient] + · simp + have hbodyRepresented : ExtraRepresented ctx bodyState := + hrepresented.of_extends hextends + have hmember : + (fnAddr, .fn + ⟨captures.length + lamArity expr, .shared, true, code⟩) ∈ + ambient.extra := by + simp [ambient] + have hdecl := hrepresented.decl hmember + have hmodes := papSafe_lamUses_eq_replicate hp + have hadmissible : ParameterDropsAdmissible (lamUses expr) + (fun index => countUses index (stripLams expr)) := by + rw [hmodes] + exact parameterDropsAdmissible_replicate_many _ _ + have hselected : ∀ index, index < input.entries.length → + decide (0 < countUses index expr) = + (countUses ((lamUses expr).length + index) (stripLams expr) != 0) := by + intro index _ + rw [lamUses_length] + rw [← countUses_eq_stripLams_shift expr index] + cases countUses index expr <;> rfl + have hshared : (lamUses expr).map worldOfUses = + List.replicate (lamUses expr).length .shared := by + rw [hmodes] + simp [worldOfUses] + cases bodyFuel with + | zero => + exact (trackedThrowRun_not_ok + (by simpa [lowerFnBody] using hbodyRun)).elim + | succ innerFuel => + have hbodyRun' : + (lowerFnBody src (innerFuel + 1) + (let generatedCaptures := + (List.range input.entries.length).filter + (fun index => countUses index expr > 0) + ⟨parameterEntries generatedCaptures.length (lamUses expr) + (fun index => countUses index (stripLams expr)) ++ + selectedEntriesFrom + (fun index => countUses index expr > 0) + (fun index => countUses ((lamUses expr).length + index) + (stripLams expr)) + (List.range input.entries.length) 0, + generatedCaptures.length + (lamUses expr).length⟩) + (let generatedCaptures := + (List.range input.entries.length).filter + (fun index => countUses index expr > 0) + parameterDrops generatedCaptures.length (lamUses expr) + (fun index => countUses index (stripLams expr))) + .shared (stripLams expr)).run addressState = + .ok code bodyState := by + simpa [liftedBodyVEnv, liftedBodyDrops, liftCaptureIndices, + lamUses_length] using hbodyRun + have hpreserves : FnOwnershipPreservesAt ctx + ⟨captures.length + (lamUses expr).length, .shared, true, code⟩ + (List.replicate + (captures.length + (lamUses expr).length) .shared) limit := by + exact lowerFnBody_liftedEntries_preservesAt + (fuel := innerFuel) (state := addressState) + (finalState := bodyState) (code := code) + happly hdecls input.entries.length + (lamUses expr) (stripLams expr) + (fun index => countUses index expr > 0) + hadmissible hselected (by simpa using hpositive) hshared + hbodyRun' hbodyRepresented + refine ⟨fnAddr, code, hmember, hdecl, ?_⟩ + rw [lamUses_length] at hpreserves + exact hpreserves + +private theorem wrapperBindOk {error α β : Type} (value : α) + (next : α → Except error β) : + (Except.ok value >>= next) = next value := rfl + +private theorem wrapperBindErr {error α β : Type} (err : error) + (next : α → Except error β) : + ((Except.error err : Except error α) >>= next) = .error err := rfl + +private theorem descendingVars_resolveFrom (args suffix : List RVal) : + ∀ accum, + (descendingVars args.length).toArray.foldlM + (fun acc atom => do pure (acc ++ [← resolveAtom + (args.reverse ++ suffix) atom])) accum = + .ok (accum ++ args) := by + induction args generalizing suffix with + | nil => + intro accum + simp only [List.length_nil, descendingVars, List.foldlM_toArray, + List.foldlM_nil, List.append_nil] + rfl + | cons head tail ih => + intro accum + simp only [List.length_cons, descendingVars, List.foldlM_toArray, + List.foldlM_cons] + have hhead : resolveAtom ((head :: tail).reverse ++ suffix) + (.var tail.length) = .ok head := by + simp [resolveAtom] + rw [hhead, wrapperBindOk] + have htail := ih (head :: suffix) (accum ++ [head]) + simpa [List.append_assoc] using htail + +theorem descendingVars_resolveAtoms (args : List RVal) : + resolveAtoms args.reverse (descendingVars args.length).toArray = + .ok args := by + unfold resolveAtoms + simpa using descendingVars_resolveFrom args [] [] + +/-- A generated constructor eta-wrapper consumes its all-shared argument +vector and returns ownership of the freshly allocated shared constructor. -/ +theorem ctorWrapper_fnOwnershipContract (ctx : Ctx) + (source : Ixon.Address) (tag arity : Nat) : + FnOwnershipContract ctx + ⟨arity, .shared, true, + .letOp (.alloc .shared (ctorIdOf source tag) + (descendingVars arity).toArray) + (.ret (.var 0))⟩ + (List.replicate arity .shared) := by + constructor + · simp + · intro fuel store store' args value rest hlength hown hrun + have hargsLength : args.length = arity := by simpa using hlength + have hresolve : resolveAtoms args.reverse + (descendingVars arity).toArray = .ok args := by + rw [← hargsLength] + exact descendingVars_resolveAtoms args + have hroots : rootsForWorlds (List.replicate arity .shared) args = + rootsFor .shared args := + rootsForWorlds_replicate_eq_rootsFor .shared hargsLength + have hinput : RootOwnership store + (rootsFor .shared args ++ rest) := by + rwa [hroots] at hown + cases fuel with + | zero => simp [runCode] at hrun + | succ outerFuel => + cases outerFuel with + | zero => simp [runCode, runOp, wrapperBindErr] at hrun + | succ innerFuel => + simp only [runCode] at hrun + simp only [runOp] at hrun + rw [hresolve] at hrun + simp [resolveAtom, wrapperBindOk] at hrun + obtain ⟨hstore, hvalue⟩ := hrun + subst store' + subst value + apply RootOwnership.allocNode + · simpa [nodeChildren] using hinput + · trivial + +/-- A constructor eta-wrapper has the corresponding source semantics at +every target evaluator index. The wrapper's allocation is fresh, so the +argument graphs become constructor-field graphs while the caller frame is +transported through the one-node store extension. -/ +theorem ctorWrapper_fnValueContract + {funRel : Sim.FunctionRel} (sourceCtx : IxIR0.Ctx) (ctx : Ctx) + (source : Ixon.Address) (tag arity : Nat) + (sourceFunction : IxIR0.Value) + (hlookup : sourceCtx.env source = some (.ctor tag arity)) + (href : SourceRefValue sourceCtx source sourceFunction) : + FnValueContract funRel sourceCtx ctx + ⟨arity, .shared, true, + .letOp (.alloc .shared (ctorIdOf source tag) + (descendingVars arity).toArray) + (.ret (.var 0))⟩ + (List.replicate arity .shared) sourceFunction := by + constructor + · simp + · intro fuel store store' args value sourceArgs sourceResult + sourceRest rest hlength hargs hsource hframe hown hrun + have hargsLength : args.length = arity := by simpa using hlength + have hsourceArgsLength : sourceArgs.length = arity := by + simpa [hargsLength] using hargs.length + have hcanonical : SourceApplies sourceCtx sourceFunction sourceArgs + (.ctor source tag sourceArgs) := + sourceCtorRef_saturates hlookup href hsourceArgsLength + have hsourceResult : sourceResult = .ctor source tag sourceArgs := + hsource.deterministic hcanonical + subst sourceResult + have hresolve : resolveAtoms args.reverse + (descendingVars arity).toArray = .ok args := by + rw [← hargsLength] + exact descendingVars_resolveAtoms args + have hroots : rootsForWorlds (List.replicate arity .shared) args = + rootsFor .shared args := + rootsForWorlds_replicate_eq_rootsFor .shared hargsLength + have hinput : RootOwnership store + (rootsFor .shared args ++ rest) := by + rwa [hroots] at hown + cases fuel with + | zero => simp [runCode] at hrun + | succ outerFuel => + cases outerFuel with + | zero => simp [runCode, runOp, wrapperBindErr] at hrun + | succ innerFuel => + simp only [runCode] at hrun + simp only [runOp] at hrun + rw [hresolve] at hrun + simp [resolveAtom, wrapperBindOk] at hrun + obtain ⟨hstore, hvalue⟩ := hrun + subst store' + subst value + let node : Node := + .ctorN (ctorIdOf source tag) args.toArray + let allocated := store.allocNode .shared node + have hextends : Sim.StoreGraphExtends store allocated.1 := + Sim.StoreGraphExtends.allocNode store .shared node + have hfields : Sim.ValuesGraph funRel allocated.1 sourceArgs args := + hargs.monoStore hextends + have hresultGraph : Sim.ValueGraph funRel allocated.1 + (.ctor source tag sourceArgs) (.loc allocated.2) := by + apply Sim.ValueGraph.ctor + · exact Sim.HeapIso.get?_allocNode_new store .shared node + · rfl + · rfl + · simpa [node] using hfields + have hframeAfter : Sim.RootsGraph funRel allocated.1 + sourceRest rest := hframe.monoStore hextends + simpa [allocated, node] using And.intro hresultGraph hframeAfter + +/-- Exact semantic preservation for `applyGo` at the current evaluator +index. Declaration and recursive-application semantics are required only +strictly below this index through `hvalues`; generated lifted bodies are +recovered from their compiler provenance. -/ +theorem applyValuePreservesAt_within_below + {sourceCtx : IxIR0.Ctx} {src : IxIR0.Env} {ambient : LowSt} + {ctx : Ctx} {limit : Nat} + (henv : sourceCtx.env = src) + (hrepresented : ExtraRepresented ctx ambient) + (hcontracts : CompilerContracts src ctx) + (hvalues : CompilerValueContractsBelow + (CompilerFunctionRel sourceCtx src ambient) sourceCtx src ctx limit) : + ApplyValuePreservesAt (CompilerFunctionRel sourceCtx src ambient) + sourceCtx ctx limit := by + intro store store' function args value sourceFunction sourceArgs + sourceResult sourceRest rest hfunction hargs happlies hframe hown hrun + cases limit with + | zero => simp [applyGo] at hrun + | succ fuel => + cases hfunction with + | lit => simp [applyGo] at hrun + | erased => + have hsourceResult : sourceResult = .erased := + happlies.deterministic (SourceApplies.erased sourceCtx sourceArgs) + subst sourceResult + have hargsOwn : RootOwnership store + (rootsFor .shared args ++ rest) := + hown.dropNoLocation rfl + simp only [applyGo] at hrun + cases hdrop : dropMany ctx fuel store args with + | error error => + rw [hdrop, wrapperBindErr] at hrun + contradiction + | ok dropped => + rw [hdrop, wrapperBindOk] at hrun + have hrestOwn : RootOwnership dropped rest := + dropMany_preserves hargsOwn hdrop + have hrestrict : StoreGraphRestricts store dropped := + dropMany_restricts hdrop + injection hrun with hpair + cases hpair + exact ⟨.erased, + hframe.ofRestricts hrestrict hrestOwn⟩ + | @ctor sourceAddress sourceTag sourceFields loc boxWorld rc cid fields + hget haddress htag hfields => + simp [applyGo, hget] at hrun + | @function relatedFunction address arity captures loc rc got hget hfun + hgot => + simp only [applyGo] at hrun + rw [hget] at hrun + dsimp only at hrun + cases hdup : dupVals store got.toList with + | error error => + rw [hdup, wrapperBindErr] at hrun + contradiction + | ok dupStore => + rw [hdup, wrapperBindOk] at hrun + cases hdrop : dropVal ctx fuel dupStore (.loc loc) with + | error error => + rw [hdrop, wrapperBindErr] at hrun + contradiction + | ok readyStore => + rw [hdrop, wrapperBindOk] at hrun + let total := got.toList ++ args + obtain ⟨hgotReady, hargsReady, hframeReady, hready⟩ := + applyGo_preparePap_valueGraphs hget hgot hargs hframe hown + hdup hdrop + split at hrun + next hunder => + have hsourceUnder : (captures ++ sourceArgs).length < arity := by + have htotalGraph := hgotReady.append hargsReady + have hlength := htotalGraph.length + rw [hlength] + simpa [total] using hunder + have hnewRel := hfun.underfilledApply happlies hsourceUnder + injection hrun with hpair + cases hpair + let node : Node := .papN address arity total.toArray + let allocated := readyStore.allocNode .shared node + have hextends : StoreGraphExtends readyStore allocated.1 := + StoreGraphExtends.allocNode readyStore .shared node + have htotalGraph : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) allocated.1 + (captures ++ sourceArgs) total := by + exact (hgotReady.append hargsReady).monoStore hextends + have hresultGraph : Sim.ValueGraph + (CompilerFunctionRel sourceCtx src ambient) allocated.1 + sourceResult (.loc allocated.2) := by + apply Sim.ValueGraph.function + · exact Sim.HeapIso.get?_allocNode_new readyStore .shared node + · exact hnewRel + · simpa [node] using htotalGraph + have hframeAfter := hframeReady.monoStore hextends + simpa [allocated, node, total] using + And.intro hresultGraph hframeAfter + next hnotUnder => + split at hrun + next hexact => + have hsafety : ∃ declaration, + ctx.decls address = some declaration ∧ + declPapSafe declaration = true := by + cases hdecl : ctx.decls address with + | none => simp [hdecl] at hrun + | some declaration => + cases hpapsafe : declPapSafe declaration with + | false => simp [hdecl, hpapsafe] at hrun + | true => exact ⟨declaration, rfl, hpapsafe⟩ + obtain ⟨declaration, hdecl, hpapsafe⟩ := hsafety + simp only [hdecl, hpapsafe, if_true] at hrun + have hcalled := invoke_compilerFunction_value_owned_below + henv hrepresented hcontracts hvalues + (fun memo baseFunction hlookup href => + ctorWrapper_fnValueContract + (funRel := CompilerFunctionRel sourceCtx src ambient) + sourceCtx ctx memo.source memo.tag memo.arity + baseFunction hlookup href) + (fun memo => ctorWrapper_fnOwnershipContract ctx memo.source + memo.tag memo.arity) + hfun hgotReady hargsReady happlies hframeReady hready + (Nat.le_succ fuel) hrun + exact ⟨hcalled.1, hcalled.2.1⟩ + next hover => + have hsafety : ∃ declaration, + ctx.decls address = some declaration ∧ + declPapSafe declaration = true := by + cases hdecl : ctx.decls address with + | none => simp [hdecl] at hrun + | some declaration => + cases hpapsafe : declPapSafe declaration with + | false => simp [hdecl, hpapsafe] at hrun + | true => exact ⟨declaration, rfl, hpapsafe⟩ + obtain ⟨declaration, hdecl, hpapsafe⟩ := hsafety + simp only [hdecl, hpapsafe, if_true] at hrun + have hfunUnder := hfun.underfilled + have hgotUnder : got.toList.length < arity := by + have hlength := hgotReady.length + omega + have hgotLe : got.toList.length ≤ arity := + Nat.le_of_lt hgotUnder + have hoverLength : arity < total.length := by + have hnotExact : total.length ≠ arity := by + intro heq + apply hover + simpa [total] using heq + have hle : arity ≤ total.length := + Nat.le_of_not_gt hnotUnder + omega + let missing := arity - got.toList.length + have hmissing : got.toList.length + missing = arity := by + exact Nat.add_sub_of_le hgotLe + have hmissingLe : missing ≤ args.length := by + simp only [total, List.length_append] at hoverLength + omega + have htakeTotal : total.take arity = + got.toList ++ args.take missing := by + rw [List.take_append] + rw [List.take_of_length_le hgotLe] + have hdropTotal : total.drop arity = args.drop missing := by + rw [List.drop_append] + rw [List.drop_eq_nil_of_le hgotLe] + rfl + have hsourceWhole : SourceApplies sourceCtx sourceFunction + (sourceArgs.take missing ++ sourceArgs.drop missing) + sourceResult := by + rw [List.take_append_drop] + exact happlies + obtain ⟨middleSource, hprefixApply, htailApply⟩ := + hsourceWhole.split + have hprefixGraph := hargsReady.take missing + have htailGraph := hargsReady.drop missing + have htailWorld : ∀ runtime, + runtime ∈ args.drop missing → + HasWorld readyStore .shared runtime := by + intro runtime hmember + apply hready.roots_world ⟨.shared, runtime⟩ + apply List.mem_append_left rest + have hmemberArgs : runtime ∈ args := + List.mem_of_mem_drop hmember + have hmemberTotal : runtime ∈ total := by + exact List.mem_append_right got.toList hmemberArgs + simpa [total, rootsFor] using hmemberTotal + let tailSourceRest : List (Owned × IxIR0.Value) := + (sourceArgs.drop missing).map + (fun source => (.shared, source)) + let tailRoots : List Root := + rootsFor .shared (args.drop missing) + have htailFrame : Sim.RootsGraph + (CompilerFunctionRel sourceCtx src ambient) readyStore + tailSourceRest tailRoots := by + exact htailGraph.rootsGraph .shared htailWorld + have hcombinedFrame : Sim.RootsGraph + (CompilerFunctionRel sourceCtx src ambient) readyStore + (tailSourceRest ++ sourceRest) (tailRoots ++ rest) := + htailFrame.append hframeReady + have hrootsSplit : rootsFor .shared total = + rootsFor .shared (total.take arity) ++ + rootsFor .shared (total.drop arity) := by + unfold rootsFor + rw [← List.map_append] + exact congrArg _ (List.take_append_drop arity total).symm + have hpartition : RootOwnership readyStore + (rootsFor .shared (got.toList ++ args.take missing) ++ + (tailRoots ++ rest)) := by + have hsplit := hready + rw [hrootsSplit] at hsplit + rw [htakeTotal, hdropTotal] at hsplit + simpa [tailRoots, List.append_assoc] using hsplit + cases hinvoke : invoke ctx fuel address + (total.take arity) readyStore with + | error error => + rw [hinvoke, wrapperBindErr] at hrun + contradiction + | ok called => + rcases called with ⟨calledStore, calledValue⟩ + rw [hinvoke, wrapperBindOk] at hrun + have hinvokePrefix : invoke ctx fuel address + (got.toList ++ args.take missing) readyStore = + .ok (calledStore, calledValue) := by + rw [← htakeTotal] + exact hinvoke + have hcalled := invoke_compilerFunction_value_owned_below + henv hrepresented hcontracts hvalues + (fun memo baseFunction hlookup href => + ctorWrapper_fnValueContract + (funRel := CompilerFunctionRel sourceCtx src ambient) + sourceCtx ctx memo.source memo.tag memo.arity + baseFunction hlookup href) + (fun memo => ctorWrapper_fnOwnershipContract ctx + memo.source memo.tag memo.arity) + hfun hgotReady hprefixGraph hprefixApply hcombinedFrame + hpartition (Nat.le_succ fuel) hinvokePrefix + have htailLength : tailSourceRest.length = tailRoots.length := by + simp [tailSourceRest, tailRoots, rootsFor, + hargsReady.length] + obtain ⟨htailFrameAfter, hframeAfter⟩ := + hcalled.2.1.splitAppend htailLength + have htailGraphAfter : Sim.ValuesGraph + (CompilerFunctionRel sourceCtx src ambient) calledStore + (sourceArgs.drop missing) (args.drop missing) := by + exact htailFrameAfter.valuesGraph + have hrecursiveRun : applyGo ctx fuel calledStore calledValue + (args.drop missing) = .ok (store', value) := by + change applyGo ctx fuel calledStore calledValue + (total.drop arity) = .ok (store', value) at hrun + rw [hdropTotal] at hrun + exact hrun + exact hvalues.apply.preserves (Nat.lt_succ_self fuel) + hcalled.1 htailGraphAfter htailApply hframeAfter + hcalled.2.2 hrecursiveRun + +/-! ### Whole-pass semantic contract sealing -/ + +/-- A successful lookup in the source list environment identifies the exact +source declaration occurrence traversed by `lowerAllAction`. No no-duplicate +assumption is needed in this direction: `Env.ofList` returns an actual +`find?` member. -/ +theorem sourceEnv_ofList_lookup_mem + {decls : List (Ixon.Address × IxIR0.Decl)} + {address : Ixon.Address} {source : IxIR0.Decl} + (hlookup : IxIR0.Env.ofList decls address = some source) : + (address, source) ∈ decls := by + unfold IxIR0.Env.ofList at hlookup + obtain ⟨item, hfind, hvalue⟩ := + Option.map_eq_some_iff.mp hlookup + rcases item with ⟨itemAddress, itemSource⟩ + have hbeq : itemAddress == address := + List.find?_some + (p := fun item : Ixon.Address × IxIR0.Decl => + item.1 == address) hfind + have haddress : itemAddress = address := + Ixon.Address.eq_of_beq hbeq + have hsource : itemSource = source := by + simpa using hvalue + subst itemAddress + subst itemSource + exact List.mem_of_find?_eq_some hfind + +/-- The IxIR₁ list environment likewise returns an actual declaration +occurrence. This reverse lookup is the bridge from an exact raw target +context to the whole-pass declaration list. -/ +theorem targetEnv_ofList_lookup_mem + {decls : List (Ixon.Address × Decl)} + {address : Ixon.Address} {declaration : Decl} + (hlookup : Env.ofList decls address = some declaration) : + (address, declaration) ∈ decls := by + unfold Env.ofList at hlookup + obtain ⟨item, hfind, hvalue⟩ := + Option.map_eq_some_iff.mp hlookup + rcases item with ⟨itemAddress, itemDeclaration⟩ + have hbeq : itemAddress == address := + List.find?_some + (p := fun item : Ixon.Address × Decl => + item.1 == address) hfind + have haddress : itemAddress = address := + Ixon.Address.eq_of_beq hbeq + have hdeclaration : itemDeclaration = declaration := by + simpa using hvalue + subst itemAddress + subst itemDeclaration + exact List.mem_of_find?_eq_some hfind + +/-- Every callable source row traversed by the whole pass is the row selected +by its list environment. Validated addressed erasure supplies this premise +from its collision-free producer namespace. -/ +def SourceCallableRowsSelected + (decls : List (Ixon.Address × IxIR0.Decl)) : Prop := + ∀ {address source worlds result}, + (address, source) ∈ decls → + sourceCallableSignature source = some (worlds, result) → + IxIR0.Env.ofList decls address = some source + +/-- Recover the exact same-address callable declaration run selected by the +final target context. This is the semantic counterpart of the concrete +fixture's `addLowerDecl_run`, generalized to any successful whole pass. -/ +theorem lowerAllAction_callable_decl_trace + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} {address : Ixon.Address} {source : IxIR0.Decl} + {worlds : List Owned} {result : Owned} {d : FnDef} + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htarget : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hsrc : IxIR0.Env.ofList decls address = some source) + (hsignature : sourceCallableSignature source = some (worlds, result)) + (hdecl : ctx.decls address = some (.fn d)) : + ∃ itemInitial itemFinal, + (lowerDecl (IxIR0.Env.ofList decls) compilerFuel + (address, source)).run itemInitial = + .ok (some (address, .fn d)) itemFinal ∧ + ExtraExtends itemFinal finalState := by + obtain ⟨itemInitial, itemFinal, output, hrun, hextends, houtput⟩ := + lowerAllAction_decl_trace hlower (sourceEnv_ofList_lookup_mem hsrc) + obtain ⟨generated, hgenerated⟩ := + lowerDecl_output_fn_of_callable hsignature hrun + have hgeneratedDecl : ctx.decls address = some (.fn generated) := + htarget (houtput _ hgenerated) + have hd : generated = d := by + have heq : some (Decl.fn generated) = some (Decl.fn d) := + hgeneratedDecl.symm.trans hdecl + exact Decl.fn.inj (Option.some.inj heq) + subst generated + rw [hgenerated] at hrun + exact ⟨itemInitial, itemFinal, hrun, hextends⟩ + +/-- A successful whole pass determines the complete same-address layout of +every callable source declaration represented by its returned raw target +list. -/ +theorem lowerAllAction_sourceDeclLayout + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htarget : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) : + SourceDeclLayout (IxIR0.Env.ofList decls) ctx := by + constructor + · intro address source worlds result hsrc hsignature + obtain ⟨itemInitial, itemFinal, output, hrun, _, houtput⟩ := + lowerAllAction_decl_trace hlower + (sourceEnv_ofList_lookup_mem hsrc) + obtain ⟨d, hemitted, harity, hresult⟩ := + lowerDecl_output_fn_layout_of_callable hsignature hrun + exact ⟨d, htarget (houtput _ hemitted), harity, hresult⟩ + · intro address arity hsrc + obtain ⟨itemInitial, itemFinal, output, hrun, _, houtput⟩ := + lowerAllAction_decl_trace hlower + (sourceEnv_ofList_lookup_mem hsrc) + have hemitted : output = some (address, .extern arity) := by + symm + simpa [lowerDecl] using congrArg + (fun result : EStateM.Result String LowSt + (Option (Ixon.Address × Decl)) => + match result with + | .ok value _ => value + | .error _ _ => none) hrun + exact htarget (houtput _ hemitted) + +/-- A successful ordinary-definition lowering run exposes the PAP-safety bit +computed from the source result world and body. -/ +theorem lowerDecl_defn_papSafe_of_run + {src : IxIR0.Env} {fuel : Nat} {address : Ixon.Address} + {result : Owned} {body : IxIR0.Expr} {initial final : LowSt} + {d : FnDef} + (hrun : (lowerDecl src fuel (address, .defn result body)).run initial = + .ok (some (address, .fn d)) final) + (hresult : result = .shared) (hbody : papSafe body = true) : + d.papSafe = true := by + simp only [lowerDecl] at hrun + obtain ⟨code, bodyState, _, hpureRun⟩ := trackedBindRun_ok_inv hrun + have hpure : + some (address, Decl.fn ⟨lamArity body, result, + result == .shared && papSafe body, code⟩) = + some (address, Decl.fn d) ∧ bodyState = final := by + simpa using hpureRun + have hd : d = ⟨lamArity body, result, + result == .shared && papSafe body, code⟩ := by + have hp := Option.some.inj hpure.1 + exact Decl.fn.inj (Prod.mk.inj hp).2.symm + subst d + simp [hresult, hbody] + +/-- Generated recursor declarations always permit dynamic PAP entry. -/ +theorem lowerDecl_recursor_papSafe_of_run + {src : IxIR0.Env} {fuel numArgs : Nat} {address : Ixon.Address} + {natLit : Bool} {rules : Array IxIR0.RecRule} + {initial final : LowSt} {d : FnDef} + (hrun : (lowerDecl src fuel + (address, .recursor numArgs natLit rules)).run initial = + .ok (some (address, .fn d)) final) : + d.papSafe = true := by + simp only [lowerDecl] at hrun + obtain ⟨actual, recursorState, hrecursorRun, hafterRecursor⟩ := + trackedBindRun_ok_inv hrun + have hpure : + some (address, Decl.fn actual) = some (address, Decl.fn d) ∧ + recursorState = final := by + simpa using hafterRecursor + have hd : actual = d := by + have hp := Option.some.inj hpure.1 + exact Decl.fn.inj (Prod.mk.inj hp).2 + subst actual + simp only [lowerRecursor] at hrecursorRun + obtain ⟨alts, rulesState, _, hafterRules⟩ := + trackedBindRun_ok_inv hrecursorRun + have hshape : + (⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alts.toArray⟩ : FnDef) = d ∧ + rulesState = recursorState := by + simpa using hafterRules + rw [← hshape.1] + +/-- If the emitted function admits dynamic PAP entry, its source signature is +homogeneously shared. Definitions recover both facts from the committed +`papSafe` bit; recursors have that signature by construction. -/ +theorem lowerDecl_callable_signature_of_papSafe_run + {src : IxIR0.Env} {fuel : Nat} {address : Ixon.Address} + {source : IxIR0.Decl} {worlds : List Owned} {result : Owned} + {initial final : LowSt} {d : FnDef} + (hsignature : sourceCallableSignature source = some (worlds, result)) + (hrun : (lowerDecl src fuel (address, source)).run initial = + .ok (some (address, .fn d)) final) + (hsafe : d.papSafe = true) : + result = .shared ∧ + worlds = List.replicate worlds.length .shared := by + cases source with + | defn sourceResult body => + simp only [sourceCallableSignature, Option.some.injEq, + Prod.mk.injEq] at hsignature + obtain ⟨rfl, rfl⟩ := hsignature + simp only [lowerDecl] at hrun + obtain ⟨code, bodyState, _, hpureRun⟩ := + trackedBindRun_ok_inv hrun + have hpure : + some (address, Decl.fn + ⟨lamArity body, sourceResult, + sourceResult == .shared && papSafe body, code⟩) = + some (address, .fn d) ∧ bodyState = final := by + simpa using hpureRun + have hd : d = + ⟨lamArity body, sourceResult, + sourceResult == .shared && papSafe body, code⟩ := by + have hp := Option.some.inj hpure.1 + exact Decl.fn.inj (Prod.mk.inj hp).2.symm + subst d + change (sourceResult == .shared && papSafe body) = true at hsafe + simp only [Bool.and_eq_true] at hsafe + obtain ⟨hresultBeq, hbody⟩ := hsafe + have hresult : sourceResult = .shared := by + cases sourceResult <;> simp_all + have hmodes := papSafe_lamUses_eq_replicate hbody + refine ⟨hresult, ?_⟩ + rw [hmodes] + simp [worldOfUses] + | ctor tag arity => simp [sourceCallableSignature] at hsignature + | recursor numArgs natLit rules => + simp only [sourceCallableSignature, Option.some.injEq, + Prod.mk.injEq] at hsignature + obtain ⟨rfl, rfl⟩ := hsignature + refine ⟨rfl, ?_⟩ + simp + | extern arity => simp [sourceCallableSignature] at hsignature + +/-- Owner-sensitive PAP safety is a theorem of the concrete whole-pass +declaration trace, not an all-shared source-environment assumption. -/ +theorem lowerAllAction_sourcePapSafe + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htarget : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) : + SourcePapSafe (IxIR0.Env.ofList decls) ctx := by + intro address source worlds result d hsrc hsignature hdecl hsafe + obtain ⟨itemInitial, itemFinal, hrun, _⟩ := + lowerAllAction_callable_decl_trace hlower htarget hsrc hsignature hdecl + exact lowerDecl_callable_signature_of_papSafe_run + hsignature hrun hsafe + +/-- Every raw function returned by the whole pass came either from a selected +same-address callable source row or from the final generated-declaration +accumulator. This is the exact declaration partition consumed by +`FnDeclCovered`. -/ +theorem lowerAllAction_fn_mem_source_or_extra + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (hselected : SourceCallableRowsSelected decls) + {address : Ixon.Address} {d : FnDef} + (hmember : (address, .fn d) ∈ targetDecls) : + (∃ source worlds result, + IxIR0.Env.ofList decls address = some source ∧ + sourceCallableSignature source = some (worlds, result)) ∨ + (address, .fn d) ∈ finalState.extra := by + let src := IxIR0.Env.ofList decls + simp only [lowerAllAction] at hlower + obtain ⟨base, baseState, hbase, hafterBase⟩ := + trackedBindRun_ok_inv hlower + obtain ⟨compiledMain, mainState, hmain, hafterMain⟩ := + trackedBindRun_ok_inv hafterBase + obtain ⟨observed, getState, hget, hpure⟩ := + trackedBindRun_ok_inv hafterMain + have hget' : mainState = observed ∧ mainState = getState := by + simpa using hget + obtain ⟨hobserved, hgetState⟩ := hget' + subst observed + subst getState + have hpure' : + (base ++ mainState.extra, compiledMain) = + (targetDecls, mainCode) ∧ mainState = finalState := by + simpa using hpure + obtain ⟨hresult, hstate⟩ := hpure' + subst finalState + have hdecls : base ++ mainState.extra = targetDecls := + congrArg Prod.fst hresult + rw [← hdecls, List.mem_append] at hmember + cases hmember with + | inl hbaseMember => + obtain ⟨item, itemInitial, itemFinal, hitem, hitemRun⟩ := + listFilterMapM_result_trace (lowerDecl src compilerFuel) + decls hbase hbaseMember + rcases item with ⟨sourceAddress, source⟩ + obtain ⟨haddress, worlds, result, hsignature⟩ := + lowerDecl_fn_output_input_callable hitemRun + subst sourceAddress + exact Or.inl ⟨source, worlds, result, + hselected hitem hsignature, hsignature⟩ + | inr hextra => exact Or.inr hextra + +/-- With an exact raw target context, the whole-pass source/generated +partition closes declaration coverage without admitting synthetic aliases. -/ +theorem lowerAllAction_fnDeclCovered + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (hselected : SourceCallableRowsSelected decls) + (hctx : ctx.decls = Env.ofList targetDecls) : + FnDeclCovered (IxIR0.Env.ofList decls) ctx finalState := by + intro address d hdecl + have hlookup : Env.ofList targetDecls address = some (.fn d) := by + rw [← hctx] + exact hdecl + exact lowerAllAction_fn_mem_source_or_extra hlower hselected + (targetEnv_ofList_lookup_mem hlookup) + +/-- Every PAP admitted by the whole-pass compiler relation resolves to a +declaration whose content-addressed metadata permits dynamic PAP entry. The +proof is origin-sensitive: source definitions expose the computed bit, +recursors and generated functions are safe by construction, and externs are +scalar-only. -/ +theorem lowerAllAction_compilerFunction_declPapSafe + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htarget : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + {sourceFunction : IxIR0.Value} {address : Ixon.Address} + {arity : Nat} {captures : List IxIR0.Value} + (hrel : CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) + finalState sourceFunction address arity captures) : + ∃ declaration, ctx.decls address = some declaration ∧ + declPapSafe declaration = true := by + cases hrel with + | @source relatedFunction baseFunction targetAddress targetArity + storedSources source hsrc heligible harity href happly hunder => + cases source with + | defn result body => + obtain ⟨hresult, hbody⟩ := heligible + obtain ⟨d, hdecl, _, _, _⟩ := hcontracts.decls.defn hsrc + obtain ⟨itemInitial, itemFinal, hrun, _⟩ := + lowerAllAction_callable_decl_trace hlower htarget hsrc (by rfl) + hdecl + refine ⟨.fn d, hdecl, ?_⟩ + exact lowerDecl_defn_papSafe_of_run hrun hresult hbody + | ctor tag ctorArity => exact heligible.elim + | recursor numArgs natLit rules => + obtain ⟨d, hdecl, _, _, _⟩ := hcontracts.decls.recursor hsrc + obtain ⟨itemInitial, itemFinal, hrun, _⟩ := + lowerAllAction_callable_decl_trace hlower htarget hsrc (by rfl) + hdecl + refine ⟨.fn d, hdecl, ?_⟩ + exact lowerDecl_recursor_papSafe_of_run hrun + | extern externArity => + have hdecl := hcontracts.decls.extern hsrc + exact ⟨.extern externArity, hdecl, rfl⟩ + | @wrapper relatedFunction baseFunction storedSources memo hmember hsrc + href happly hunder => + refine ⟨ctorWrapperDecl memo.source memo.tag memo.arity, + hrepresented.wrapper hmember, ?_⟩ + simp [ctorWrapperDecl, declPapSafe] + | lifted hlifted => + obtain ⟨sourceEnv, expr, selected, supplied, hliftCode, _, _, _, _⟩ := + hlifted + obtain ⟨fuel, bodyInitial, generated, code, _, _, _, hmember⟩ := + hliftCode + refine ⟨.fn + ⟨(liftCaptureIndices sourceEnv.length expr).length + lamArity expr, + .shared, true, code⟩, + hrepresented.decl hmember, rfl⟩ + +/-- At one evaluator index, every source-backed callable emitted by an +actual whole-pass run satisfies its semantic function contract using only +the mutually recursive semantic contracts below that index. -/ +theorem lowerAllAction_sourceFnValuePreservesAt_within_below + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel limit : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htarget : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hvalues : CompilerValueContractsBelow + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx limit) : + SourceFnValuePreservesAt + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx limit := by + intro address source worlds result d sourceFunction + hsrc hsignature hdecl href + obtain ⟨itemInitial, itemFinal, hrun, hextends⟩ := + lowerAllAction_callable_decl_trace hlower htarget hsrc hsignature hdecl + cases source with + | defn sourceResult body => + simp only [sourceCallableSignature, Option.some.injEq, + Prod.mk.injEq] at hsignature + obtain ⟨rfl, rfl⟩ := hsignature + cases compilerFuel with + | zero => + simp only [lowerDecl] at hrun + obtain ⟨code, bodyState, hbodyRun, _⟩ := + trackedBindRun_ok_inv hrun + exact (trackedThrowRun_not_ok (by + simpa [lowerFnBody] using hbodyRun)).elim + | succ bodyFuel => + have hadmissible := lowerDecl_defn_parameterDropsAdmissible hrun + intro store store' args value sourceArgs sourceValue sourceRest rest + hlength hargs happlies hframe hown hcodeRun + exact lowerDecl_defn_valuePreservesAt_within_below + (compilerFuel := bodyFuel) (limit := limit) + henv hrepresented hcontracts hvalues hsrc href hadmissible + (by simpa [Nat.succ_eq_add_one] using hrun) hextends + hlength hargs happlies hframe hown hcodeRun + | ctor tag arity => + simp [sourceCallableSignature] at hsignature + | recursor numArgs natLit rules => + simp only [sourceCallableSignature, Option.some.injEq, + Prod.mk.injEq] at hsignature + obtain ⟨rfl, rfl⟩ := hsignature + intro store store' args value sourceArgs sourceValue sourceRest rest + hlength hargs happlies hframe hown hcodeRun + exact lowerDecl_recursor_valuePreservesAt_within_below + (compilerFuel := compilerFuel) (limit := limit) + henv hrepresented hcontracts hvalues hsrc hdecl href hrun hextends + hlength hargs happlies hframe hown hcodeRun + | extern arity => + simp [sourceCallableSignature] at hsignature + +/-- Seal the actual whole-pass declaration and `applyGo` producers by strong +evaluator-fuel induction. Generated lifted functions and constructor +wrappers need no separate semantic environment: their exact compiler +provenance is reconstructed inside the application producer. -/ +theorem lowerAllAction_compilerValueContracts + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htarget : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hextern : ExternValueContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx) : + CompilerValueContracts + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx (IxIR0.Env.ofList decls) ctx := by + apply compilerValueContracts_of_below_step hextern + intro limit hvalues + constructor + · exact lowerAllAction_sourceFnValuePreservesAt_within_below + henv hlower htarget hrepresented hcontracts hvalues + · exact applyValuePreservesAt_within_below + henv hrepresented hcontracts hvalues + +/-- Whole-main value agreement with semantic compiler contracts constructed +from this very whole-pass output. Only ownership contracts and the explicit +extern-oracle compatibility boundary remain as semantic premises. -/ +theorem lowerAllAction_main_value_graph_sealed + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} {sourceFuel targetFuel : Nat} + {sourceValue : IxIR0.Value} {targetStore : Store} + {targetValue : RVal} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htargetDecls : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hextern : ExternValueContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx) + (hsource : IxIR0.eval sourceCtx sourceFuel [] main = .ok sourceValue) + (htargetRun : runMain ctx mainCode targetFuel = + .ok (targetStore, targetValue)) : + Sim.ValueGraph + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + targetStore sourceValue targetValue := by + have hvalues := lowerAllAction_compilerValueContracts + henv hlower htargetDecls hrepresented hcontracts hextern + exact lowerAllAction_main_value_graph henv hlower hrepresented + hcontracts hvalues hsource htargetRun + +/-- Public semantic forward simulation after the semantic contract seal. +Target-run existence remains deliberately separate as the progress premise; +all value-agreement contracts now come from the actual compiler output. -/ +theorem lowerAllAction_semanticForwardSimulation_of_targetProgress_sealed + {sourceCtx : IxIR0.Ctx} + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} + {initial finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (henv : sourceCtx.env = IxIR0.Env.ofList decls) + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run initial = + .ok (targetDecls, mainCode) finalState) + (htargetDecls : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (hcontracts : CompilerContracts (IxIR0.Env.ofList decls) ctx) + (hextern : ExternValueContract + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) finalState) + sourceCtx ctx) + (hprogress : ∀ {sourceFuel sourceValue}, + IxIR0.eval sourceCtx sourceFuel [] main = .ok sourceValue → + ∃ targetFuel targetStore targetValue, + runMain ctx mainCode targetFuel = .ok (targetStore, targetValue)) : + SemanticForwardSimulation sourceCtx ctx main mainCode + (CompilerFunctionRel sourceCtx (IxIR0.Env.ofList decls) + finalState) := by + have hvalues := lowerAllAction_compilerValueContracts + henv hlower htargetDecls hrepresented hcontracts hextern + intro sourceFuel sourceValue hsource + exact lowerAllAction_semanticForwardSimulation_of_targetProgress + henv hlower hrepresented hcontracts hvalues hprogress hsource + +/-- Package the exact declaration shape and callable contract of a generated +constructor wrapper. -/ +theorem ctorWrapper_ownershipContract (ctx : Ctx) + (source : Ixon.Address) (tag arity : Nat) : + ∃ d, ctorWrapperDecl source tag arity = .fn d ∧ + d.result = .shared ∧ + FnOwnershipContract ctx d (List.replicate d.arity .shared) := by + refine ⟨⟨arity, .shared, true, + .letOp (.alloc .shared (ctorIdOf source tag) + (descendingVars arity).toArray) (.ret (.var 0))⟩, rfl, rfl, ?_⟩ + exact ctorWrapper_fnOwnershipContract ctx source tag arity + +/-! ### Ownership from generated-declaration provenance -/ + +/-- Every operationally provenanced generated function satisfies its exact +all-shared ownership transformer at the current evaluator index. -/ +theorem GeneratedDeclProvenance.fnPreservesAt + {ctx : Ctx} {limit : Nat} {src : IxIR0.Env} + (happly : ApplyOwnershipContractBelow ctx limit) + (hdecls : SourceDeclContractsBelow src ctx limit) + {state : LowSt} (hrepresented : ExtraRepresented ctx state) + {address : Ixon.Address} {d : FnDef} + (hprovenance : GeneratedDeclProvenance src state (address, .fn d)) : + d.result = .shared ∧ + FnOwnershipPreservesAt ctx d + (List.replicate d.arity .shared) limit := by + cases hprovenance with + | inl hwrapper => + obtain ⟨wrapperAddress, source, tag, arity, hitem⟩ := hwrapper + have haddress : address = wrapperAddress := congrArg Prod.fst hitem + have hdecl : (Decl.fn d) = ctorWrapperDecl source tag arity := + congrArg Prod.snd hitem + subst address + simp only [ctorWrapperDecl] at hdecl + have hd : d = + ⟨arity, .shared, true, + .letOp (.alloc .shared (ctorIdOf source tag) + (descendingVars arity).toArray) (.ret (.var 0))⟩ := + Decl.fn.inj hdecl + subst d + exact ⟨rfl, + (ctorWrapper_fnOwnershipContract ctx source tag arity).preserves⟩ + | inr hlifted => + obtain ⟨generatedAddress, entryCount, expr, bodyFuel, bodyInitial, + generated, code, hitem, hpositive, hsafe, hbodyRun, hgenerated, + hmember⟩ := hlifted + have haddress : address = generatedAddress := congrArg Prod.fst hitem + have hdecl : Decl.fn d = .fn + ⟨(liftCaptureIndices entryCount expr).length + lamArity expr, + .shared, true, code⟩ := congrArg Prod.snd hitem + subst address + have hd : d = + ⟨(liftCaptureIndices entryCount expr).length + lamArity expr, + .shared, true, code⟩ := Decl.fn.inj hdecl + subst d + have hbodyRepresented : ExtraRepresented ctx generated := + hrepresented.of_extends hgenerated + have hmodes := papSafe_lamUses_eq_replicate hsafe + have hadmissible : ParameterDropsAdmissible (lamUses expr) + (fun index => countUses index (stripLams expr)) := by + rw [hmodes] + exact parameterDropsAdmissible_replicate_many _ _ + have hselected : ∀ index, index < entryCount → + decide (0 < countUses index expr) = + (countUses ((lamUses expr).length + index) + (stripLams expr) != 0) := by + intro index _ + rw [lamUses_length] + rw [← countUses_eq_stripLams_shift expr index] + cases countUses index expr <;> rfl + have hshared : (lamUses expr).map worldOfUses = + List.replicate (lamUses expr).length .shared := by + rw [hmodes] + simp [worldOfUses] + cases bodyFuel with + | zero => + exact (trackedThrowRun_not_ok + (by simpa [lowerFnBody] using hbodyRun)).elim + | succ innerFuel => + have hbodyRun' : + (lowerFnBody src (innerFuel + 1) + (let captures := (List.range entryCount).filter + (fun index => countUses index expr > 0) + ⟨parameterEntries captures.length (lamUses expr) + (fun index => countUses index (stripLams expr)) ++ + selectedEntriesFrom + (fun index => countUses index expr > 0) + (fun index => countUses ((lamUses expr).length + index) + (stripLams expr)) + (List.range entryCount) 0, + captures.length + (lamUses expr).length⟩) + (let captures := (List.range entryCount).filter + (fun index => countUses index expr > 0) + parameterDrops captures.length (lamUses expr) + (fun index => countUses index (stripLams expr))) + .shared (stripLams expr)).run bodyInitial = + .ok code generated := by + simpa [liftedBodyVEnv, liftedBodyDrops, liftCaptureIndices, + lamUses_length] using hbodyRun + have hpreserves : FnOwnershipPreservesAt ctx + ⟨(liftCaptureIndices entryCount expr).length + + (lamUses expr).length, + .shared, true, code⟩ + (List.replicate + ((liftCaptureIndices entryCount expr).length + + (lamUses expr).length) .shared) limit := by + exact lowerFnBody_liftedEntries_preservesAt + (fuel := innerFuel) (state := bodyInitial) + (finalState := generated) (code := code) + happly hdecls entryCount (lamUses expr) (stripLams expr) + (fun index => countUses index expr > 0) + hadmissible hselected (by simpa [lamUses_length] using hpositive) + hshared hbodyRun' hbodyRepresented + refine ⟨rfl, ?_⟩ + rw [lamUses_length] at hpreserves + exact hpreserves + +/-- A provenanced extension from the empty compiler state supplies the +generated-function half of one contractive compiler step. -/ +theorem ExtraProvenanceExtends.extraFnPreservesAt_of_empty + {ctx : Ctx} {limit : Nat} {src : IxIR0.Env} {state : LowSt} + (hprovenance : ExtraProvenanceExtends src ({} : LowSt) state) + (hrepresented : ExtraRepresented ctx state) + (happly : ApplyOwnershipContractBelow ctx limit) + (hdecls : SourceDeclContractsBelow src ctx limit) : + ExtraFnPreservesAt ctx state limit := by + intro address d hmember + exact (hprovenance.provenance_of_empty hmember).fnPreservesAt + happly hdecls hrepresented + +/-- Generated result worlds are fixed by provenance alone, independently of +the semantic evaluator index. -/ +theorem ExtraProvenanceExtends.extraFnResultsShared_of_empty + {src : IxIR0.Env} {state : LowSt} + (hprovenance : ExtraProvenanceExtends src ({} : LowSt) state) : + ExtraFnResultsShared state := by + intro address d hmember + have horigin := hprovenance.provenance_of_empty hmember + cases horigin with + | inl hwrapper => + obtain ⟨wrapperAddress, source, tag, arity, hitem⟩ := hwrapper + have hdecl : Decl.fn d = ctorWrapperDecl source tag arity := + congrArg Prod.snd hitem + simp only [ctorWrapperDecl] at hdecl + exact congrArg FnDef.result (Decl.fn.inj hdecl) + | inr hlifted => + obtain ⟨generatedAddress, entryCount, expr, bodyFuel, bodyInitial, + generated, code, hitem, _⟩ := hlifted + have hdecl : Decl.fn d = .fn + ⟨(liftCaptureIndices entryCount expr).length + lamArity expr, + .shared, true, code⟩ := congrArg Prod.snd hitem + exact congrArg FnDef.result (Decl.fn.inj hdecl) + +/-- At one evaluator index, every source-backed function emitted by an +actual whole-program lowering run satisfies its ownership transformer from +the three strictly-smaller contract environments. -/ +theorem lowerAllAction_sourceFnPreservesAt + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel limit : Nat} + {finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run {} = + .ok (targetDecls, mainCode) finalState) + (htarget : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hrepresented : ExtraRepresented ctx finalState) + (happly : ApplyOwnershipContractBelow ctx limit) + (hdecls : SourceDeclContractsBelow + (IxIR0.Env.ofList decls) ctx limit) : + SourceFnPreservesAt (IxIR0.Env.ofList decls) ctx limit := by + intro address source worlds result d hsrc hsignature hdecl + obtain ⟨itemInitial, itemFinal, hrun, hextends⟩ := + lowerAllAction_callable_decl_trace hlower htarget + hsrc hsignature hdecl + have hitemRepresented : ExtraRepresented ctx itemFinal := + hrepresented.of_extends hextends + cases source with + | defn sourceResult body => + simp only [sourceCallableSignature, Option.some.injEq, + Prod.mk.injEq] at hsignature + obtain ⟨rfl, rfl⟩ := hsignature + cases compilerFuel with + | zero => + simp only [lowerDecl] at hrun + obtain ⟨code, bodyState, hbodyRun, _⟩ := + trackedBindRun_ok_inv hrun + exact (trackedThrowRun_not_ok (by + simpa [lowerFnBody] using hbodyRun)).elim + | succ bodyFuel => + intro store store' args value rest hlength hown hcodeRun + exact lowerDecl_defn_preservesAt + (fuel := bodyFuel) happly hdecls + (lowerDecl_defn_parameterDropsAdmissible hrun) + (by simpa [Nat.succ_eq_add_one] using hrun) + hitemRepresented hlength hown hcodeRun + | ctor tag arity => + simp [sourceCallableSignature] at hsignature + | recursor numArgs natLit rules => + simp only [sourceCallableSignature, Option.some.injEq, + Prod.mk.injEq] at hsignature + obtain ⟨rfl, rfl⟩ := hsignature + obtain ⟨self, hselfDecl, _, hself⟩ := + hdecls.recursorCurrentSelf hsrc + have hsame : self = d := by + have heq : some (Decl.fn self) = some (Decl.fn d) := + hselfDecl.symm.trans hdecl + exact Decl.fn.inj (Option.some.inj heq) + subst self + intro store store' args value rest hlength hown hcodeRun + exact lowerDecl_recursor_preservesAt + happly hdecls hself hrun hitemRepresented + hlength hown hcodeRun + | extern arity => + simp [sourceCallableSignature] at hsignature + +/-- A successful whole-program lowering from the empty compiler state seals +all ownership contracts of its exact raw target context. Source declarations, +lifted functions, constructor wrappers, and dynamic PAP entry are closed by +one evaluator-fuel induction; no generated-function contract is assumed. -/ +theorem lowerAllAction_compilerContracts + {decls : List (Ixon.Address × IxIR0.Decl)} {main : IxIR0.Expr} + {mainWorld : Owned} {compilerFuel : Nat} {finalState : LowSt} + {targetDecls : List (Ixon.Address × Decl)} {mainCode : Code} + {ctx : Ctx} + (hlower : + (lowerAllAction decls main mainWorld compilerFuel).run {} = + .ok (targetDecls, mainCode) finalState) + (htarget : ∀ {targetAddress targetDecl}, + (targetAddress, targetDecl) ∈ targetDecls → + ctx.decls targetAddress = some targetDecl) + (hselected : SourceCallableRowsSelected decls) + (hctx : ctx.decls = Env.ofList targetDecls) : + CompilerContracts (IxIR0.Env.ofList decls) ctx ∧ + ExtraFnContracts ctx finalState := by + have hprovenance := lowerAllAction_extraProvenance_empty hlower + have hrepresented : ExtraRepresented ctx finalState := + lowerAllAction_extraRepresented hlower fun hmember => + htarget (lowerAllAction_extra_mem_result hlower hmember) + apply compilerContracts_of_source_extra_below_step + (lowerAllAction_sourceDeclLayout hlower htarget) + (lowerAllAction_sourcePapSafe hlower htarget) + hprovenance.extraFnResultsShared_of_empty + (lowerAllAction_fnDeclCovered hlower hselected hctx) + intro limit hdecls _ happly + exact ⟨lowerAllAction_sourceFnPreservesAt + hlower htarget hrepresented happly hdecls, + hprovenance.extraFnPreservesAt_of_empty + hrepresented happly hdecls⟩ + +end Ix.Compiler.IxIR1.LowerSim diff --git a/Ix/Compiler/IxIR1/Mono.lean b/Ix/Compiler/IxIR1/Mono.lean new file mode 100644 index 000000000..cdbca429a --- /dev/null +++ b/Ix/Compiler/IxIR1/Mono.lean @@ -0,0 +1,1160 @@ +import Ix.Compiler.Fuel +import Ix.Compiler.IxIR1.Eval + +/-! +# Fuel monotonicity for the IxIR₁ evaluator + +Successful state-passing evaluation is stable under raising fuel for all +eight mutually recursive evaluator functions. Every reached non-fuel error +is stable as well. These are the target-side composition principles needed +by progress and settlement proofs: independently constructed observations +can be raised to one common fuel without changing their result. +-/ + +namespace Ix.Compiler.IxIR1 + +private theorem bindOk {error α β : Type} (value : α) + (next : α → Except error β) : + (Except.ok value >>= next) = next value := rfl + +private theorem bindErr {error α β : Type} (err : error) + (next : α → Except error β) : + ((Except.error err : Except error α) >>= next) = .error err := rfl + +private def MonoAt (fuel : Nat) : Prop := + (∀ ctx cur store env code out, + runCode ctx fuel cur store env code = .ok out → + runCode ctx (fuel + 1) cur store env code = .ok out) ∧ + (∀ ctx cur store env op out, + runOp ctx fuel cur store env op = .ok out → + runOp ctx (fuel + 1) cur store env op = .ok out) ∧ + (∀ ctx address args store out, + invoke ctx fuel address args store = .ok out → + invoke ctx (fuel + 1) address args store = .ok out) ∧ + (∀ ctx store function args out, + applyGo ctx fuel store function args = .ok out → + applyGo ctx (fuel + 1) store function args = .ok out) ∧ + (∀ ctx store value out, + dropVal ctx fuel store value = .ok out → + dropVal ctx (fuel + 1) store value = .ok out) ∧ + (∀ ctx store values out, + dropMany ctx fuel store values = .ok out → + dropMany ctx (fuel + 1) store values = .ok out) ∧ + (∀ ctx store value out, + dropUVal ctx fuel store value = .ok out → + dropUVal ctx (fuel + 1) store value = .ok out) ∧ + (∀ ctx store values out, + dropManyU ctx fuel store values = .ok out → + dropManyU ctx (fuel + 1) store values = .ok out) + +private theorem monoAt : ∀ fuel, MonoAt fuel := by + intro fuel + induction fuel with + | zero => + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro ctx cur store env code out h + rw [runCode.eq_def] at h + simp at h + · intro ctx cur store env op out h + rw [runOp.eq_def] at h + simp at h + · intro ctx address args store out h + rw [invoke.eq_def] at h + simp at h + · intro ctx store function args out h + rw [applyGo.eq_def] at h + simp at h + · intro ctx store value out h + rw [dropVal.eq_def] at h + simp at h + · intro ctx store values out h + rw [dropMany.eq_def] at h + simp at h + · intro ctx store value out h + rw [dropUVal.eq_def] at h + simp at h + · intro ctx store values out h + rw [dropManyU.eq_def] at h + simp at h + | succ fuel ih => + obtain ⟨ihCode, ihOp, ihInvoke, ihApply, ihDrop, ihDropMany, + ihDropU, ihDropManyU⟩ := ih + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro ctx cur store env code out h + cases code with + | ret atom => + rw [runCode.eq_def] at h ⊢ + dsimp only at h ⊢ + exact h + | letOp op rest => + rw [runCode.eq_def] at h ⊢ + dsimp only at h ⊢ + cases hop : runOp ctx fuel cur store env op with + | error err => + rw [hop, bindErr] at h + contradiction + | ok opOut => + rcases opOut with ⟨middle, value⟩ + rw [hop, bindOk] at h + rw [ihOp _ _ _ _ _ _ hop, bindOk] + exact ihCode _ _ _ _ _ _ h + | case scrut peelNat alts => + rw [runCode.eq_def] at h ⊢ + dsimp only at h ⊢ + cases hscrut : resolveAtom env scrut with + | error err => + rw [hscrut, bindErr] at h + contradiction + | ok scrutValue => + rw [hscrut, bindOk] at h + rw [bindOk] + cases scrutValue with + | loc loc => + dsimp only at h ⊢ + cases hbox : store.get? loc with + | none => simp [hbox] at h + | some box => + simp only [hbox] at h ⊢ + cases box with + | mk world rc node => + cases node with + | papN address arity args => simp at h + | ctorN cid fields => + cases halt : alts.find? + (fun alt => alt.cidx == cid.cidx) with + | none => simp [halt] at h + | some alt => + cases alt with + | mk cidx fieldCount body => + cases hsize : fields.size != fieldCount + · simp only [halt, hsize, Bool.false_eq_true, + if_false] at h ⊢ + exact ihCode _ _ _ _ _ _ h + · simp [halt, hsize] at h + | lit literal => + cases literal with + | str string => simp at h + | nat value => + cases hpeel : peelNat with + | false => simp [hpeel] at h + | true => + cases value with + | zero => + cases halt : alts.find? + (fun alt => alt.cidx == 0) with + | none => simp [hpeel, halt] at h + | some alt => + cases alt with + | mk cidx fieldCount body => + cases fieldCount with + | zero => + simp only [hpeel, halt] at h ⊢ + exact ihCode _ _ _ _ _ _ h + | succ fieldCount => simp [hpeel, halt] at h + | succ value => + cases halt : alts.find? + (fun alt => alt.cidx == 1) with + | none => simp [hpeel, halt] at h + | some alt => + cases alt with + | mk cidx fieldCount body => + cases fieldCount with + | zero => simp [hpeel, halt] at h + | succ fieldCount => + cases fieldCount with + | zero => + simp only [hpeel, halt] at h ⊢ + exact ihCode _ _ _ _ _ _ h + | succ fieldCount => simp [hpeel, halt] at h + | erased => simp at h + · intro ctx cur store env op out h + cases op with + | pure atom => + rw [runOp.eq_def] at h ⊢ + dsimp only at h ⊢ + exact h + | alloc world cid args => + rw [runOp.eq_def] at h ⊢ + dsimp only at h ⊢ + exact h + | reuse target cid args => + rw [runOp.eq_def] at h ⊢ + dsimp only at h ⊢ + exact h + | free target => + rw [runOp.eq_def] at h ⊢ + dsimp only at h ⊢ + exact h + | dup target => + rw [runOp.eq_def] at h ⊢ + dsimp only at h ⊢ + exact h + | drop target => + rw [runOp.eq_def] at h ⊢ + dsimp only at h ⊢ + cases htarget : resolveAtom env target with + | error err => + rw [htarget, bindErr] at h + contradiction + | ok targetValue => + rw [htarget, bindOk] at h + rw [bindOk] + cases targetValue with + | loc loc => + dsimp only at h ⊢ + cases hdrop : dropVal ctx fuel store (.loc loc) with + | error err => + rw [hdrop, bindErr] at h + contradiction + | ok dropped => + rw [hdrop, bindOk] at h + rw [ihDrop _ _ _ _ hdrop, bindOk] + exact h + | lit literal => exact h + | erased => exact h + | dropU target => + rw [runOp.eq_def] at h ⊢ + dsimp only at h ⊢ + cases htarget : resolveAtom env target with + | error err => + rw [htarget, bindErr] at h + contradiction + | ok targetValue => + rw [htarget, bindOk] at h + rw [bindOk] + cases targetValue with + | loc loc => + dsimp only at h ⊢ + cases hdrop : dropUVal ctx fuel store (.loc loc) with + | error err => + rw [hdrop, bindErr] at h + contradiction + | ok dropped => + rw [hdrop, bindOk] at h + rw [ihDropU _ _ _ _ hdrop, bindOk] + exact h + | lit literal => exact h + | erased => exact h + | fetch target field => + rw [runOp.eq_def] at h ⊢ + dsimp only at h ⊢ + exact h + | call address args => + rw [runOp.eq_def] at h ⊢ + dsimp only at h ⊢ + cases hargs : resolveAtoms env args with + | error err => + rw [hargs, bindErr] at h + contradiction + | ok values => + rw [hargs, bindOk] at h + rw [bindOk] + exact ihInvoke _ _ _ _ _ h + | callSelf args => + rw [runOp.eq_def] at h ⊢ + dsimp only at h ⊢ + cases hargs : resolveAtoms env args with + | error err => + rw [hargs, bindErr] at h + contradiction + | ok values => + rw [hargs, bindOk] at h + rw [bindOk] + cases harity : values.length != cur.arity + · simp only [harity, Bool.false_eq_true, if_false] at h ⊢ + cases hcode : runCode ctx fuel cur store values.reverse + cur.body with + | error err => + rw [hcode, bindErr] at h + contradiction + | ok result => + rw [hcode, bindOk] at h + rw [ihCode _ _ _ _ _ _ hcode, bindOk] + exact h + · simp [harity] at h + | papp address args => + rw [runOp.eq_def] at h ⊢ + dsimp only at h ⊢ + exact h + | apply function args => + rw [runOp.eq_def] at h ⊢ + dsimp only at h ⊢ + cases hfunction : resolveAtom env function with + | error err => + rw [hfunction, bindErr] at h + contradiction + | ok functionValue => + rw [hfunction, bindOk] at h + rw [bindOk] + cases hargs : resolveAtoms env args with + | error err => + rw [hargs, bindErr] at h + contradiction + | ok values => + rw [hargs, bindOk] at h + rw [bindOk] + exact ihApply _ _ _ _ _ h + | extern address args => + rw [runOp.eq_def] at h ⊢ + dsimp only at h ⊢ + exact h + · intro ctx address args store out h + rw [invoke.eq_def] at h ⊢ + dsimp only at h ⊢ + cases hdecl : ctx.decls address with + | none => simp [hdecl] at h + | some decl => + simp only [hdecl] at h ⊢ + cases decl with + | extern arity => exact h + | fn d => + dsimp only at h ⊢ + cases harity : args.length != d.arity + · simp only [harity, Bool.false_eq_true, if_false] at h ⊢ + cases hcode : runCode ctx fuel d store args.reverse d.body with + | error err => + rw [hcode, bindErr] at h + contradiction + | ok result => + rw [hcode, bindOk] at h + rw [ihCode _ _ _ _ _ _ hcode, bindOk] + exact h + · simp [harity] at h + · intro ctx store function args out h + rw [applyGo.eq_def] at h ⊢ + dsimp only at h ⊢ + cases function with + | lit literal => simp at h + | erased => + cases hdrop : dropMany ctx fuel store args with + | error err => + rw [hdrop, bindErr] at h + contradiction + | ok dropped => + rw [hdrop, bindOk] at h + rw [ihDropMany _ _ _ _ hdrop, bindOk] + exact h + | loc loc => + dsimp only at h ⊢ + cases hbox : store.get? loc with + | none => simp [hbox] at h + | some box => + simp only [hbox] at h ⊢ + cases box with + | mk world rc node => + cases node with + | ctorN cid fields => simp at h + | papN address arity captured => + dsimp only at h ⊢ + cases hdup : dupVals store captured.toList with + | error err => + rw [hdup, bindErr] at h + contradiction + | ok duplicated => + rw [hdup, bindOk] at h + rw [bindOk] + cases hdrop : dropVal ctx fuel duplicated (.loc loc) with + | error err => + rw [hdrop, bindErr] at h + contradiction + | ok ready => + rw [hdrop, bindOk] at h + rw [ihDrop _ _ _ _ hdrop, bindOk] + by_cases hunder : + (captured.toList ++ args).length < arity + · simp only [hunder] at h ⊢ + exact h + · simp only [hunder] at h ⊢ + cases hexact : + (captured.toList ++ args).length == arity + · simp only [hexact, Bool.false_eq_true, + if_false] at h ⊢ + cases hdecl : ctx.decls address with + | none => simp [hdecl] at h + | some decl => + cases hpapsafe : declPapSafe decl with + | false => simp [hdecl, hpapsafe] at h + | true => + simp only [hdecl, hpapsafe, if_true] at h ⊢ + cases hinvoke : invoke ctx fuel address + ((captured.toList ++ args).take arity) ready with + | error err => + rw [hinvoke, bindErr] at h + contradiction + | ok called => + rcases called with ⟨calledStore, calledValue⟩ + rw [hinvoke, bindOk] at h + rw [ihInvoke _ _ _ _ _ hinvoke, bindOk] + exact ihApply _ _ _ _ _ h + · simp only [hexact, if_true] at h ⊢ + cases hdecl : ctx.decls address with + | none => simp [hdecl] at h + | some decl => + cases hpapsafe : declPapSafe decl with + | false => simp [hdecl, hpapsafe] at h + | true => + simp only [hdecl, hpapsafe, if_true] at h ⊢ + exact ihInvoke _ _ _ _ _ h + · intro ctx store value out h + rw [dropVal.eq_def] at h ⊢ + dsimp only at h ⊢ + cases value with + | lit literal => exact h + | erased => exact h + | loc loc => + dsimp only at h ⊢ + cases hbox : store.get? loc with + | none => simp [hbox] at h + | some box => + simp only [hbox] at h ⊢ + cases box with + | mk world rc node => + cases world with + | unique => simp at h + | shared => + cases hrc : rc == 1 + · simp only [hrc, Bool.false_eq_true, if_false] at h ⊢ + exact h + · simp only [hrc, if_true] at h ⊢ + cases node with + | ctorN cid fields => + exact ihDropMany _ _ _ _ h + | papN address arity args => + exact ihDropMany _ _ _ _ h + · intro ctx store values out h + rw [dropMany.eq_def] at h ⊢ + dsimp only at h ⊢ + cases values with + | nil => exact h + | cons value rest => + dsimp only at h ⊢ + cases hdrop : dropVal ctx fuel store value with + | error err => + rw [hdrop, bindErr] at h + contradiction + | ok middle => + rw [hdrop, bindOk] at h + rw [ihDrop _ _ _ _ hdrop, bindOk] + exact ihDropMany _ _ _ _ h + · intro ctx store value out h + rw [dropUVal.eq_def] at h ⊢ + dsimp only at h ⊢ + cases value with + | lit literal => exact h + | erased => exact h + | loc loc => + dsimp only at h ⊢ + cases hbox : store.get? loc with + | none => simp [hbox] at h + | some box => + simp only [hbox] at h ⊢ + cases box with + | mk world rc node => + cases world with + | shared => simp at h + | unique => + cases node with + | papN address arity args => simp at h + | ctorN cid fields => + exact ihDropManyU _ _ _ _ h + · intro ctx store values out h + rw [dropManyU.eq_def] at h ⊢ + dsimp only at h ⊢ + cases values with + | nil => exact h + | cons value rest => + dsimp only at h ⊢ + cases hdrop : dropUVal ctx fuel store value with + | error err => + rw [hdrop, bindErr] at h + contradiction + | ok middle => + rw [hdrop, bindOk] at h + rw [ihDropU _ _ _ _ hdrop, bindOk] + exact ihDropManyU _ _ _ _ h + +/-! ## Persistence of terminal evaluator errors -/ + +/-- Any reached non-fuel error is stable when one unit of evaluator fuel is +added. The mutual proof covers stuck, memory, and closed-world failures that +may surface through calls, higher-order application, or recursive release. -/ +private def ErrorMonoAt (fuel : Nat) (error : Err) : Prop := + (∀ ctx cur store env code, + runCode ctx fuel cur store env code = .error (error) → + runCode ctx (fuel + 1) cur store env code = .error (error)) ∧ + (∀ ctx cur store env op, + runOp ctx fuel cur store env op = .error (error) → + runOp ctx (fuel + 1) cur store env op = .error (error)) ∧ + (∀ ctx address args store, + invoke ctx fuel address args store = .error (error) → + invoke ctx (fuel + 1) address args store = .error (error)) ∧ + (∀ ctx store function args, + applyGo ctx fuel store function args = .error (error) → + applyGo ctx (fuel + 1) store function args = .error (error)) ∧ + (∀ ctx store value, + dropVal ctx fuel store value = .error (error) → + dropVal ctx (fuel + 1) store value = .error (error)) ∧ + (∀ ctx store values, + dropMany ctx fuel store values = .error (error) → + dropMany ctx (fuel + 1) store values = .error (error)) ∧ + (∀ ctx store value, + dropUVal ctx fuel store value = .error (error) → + dropUVal ctx (fuel + 1) store value = .error (error)) ∧ + (∀ ctx store values, + dropManyU ctx fuel store values = .error (error) → + dropManyU ctx (fuel + 1) store values = .error (error)) + +private theorem errorMonoAt : ∀ fuel error, error ≠ .fuel → ErrorMonoAt fuel error := by + intro fuel + induction fuel with + | zero => + intro error hnonfuel + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro ctx cur store env code h + rw [runCode.eq_def] at h + simp_all + · intro ctx cur store env op h + rw [runOp.eq_def] at h + simp_all + · intro ctx address args store h + rw [invoke.eq_def] at h + simp_all + · intro ctx store function args h + rw [applyGo.eq_def] at h + simp_all + · intro ctx store value h + rw [dropVal.eq_def] at h + simp_all + · intro ctx store values h + rw [dropMany.eq_def] at h + simp_all + · intro ctx store value h + rw [dropUVal.eq_def] at h + simp_all + · intro ctx store values h + rw [dropManyU.eq_def] at h + simp_all + | succ fuel ih => + intro error hnonfuel + obtain ⟨ihCode, ihOp, ihInvoke, ihApply, ihDrop, ihDropMany, + ihDropU, ihDropManyU⟩ := ih error hnonfuel + obtain ⟨monoCode, monoOp, monoInvoke, monoApply, monoDrop, + monoDropMany, monoDropU, monoDropManyU⟩ := monoAt fuel + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro ctx cur store env code h + cases code with + | ret atom => + rw [runCode.eq_def] at h ⊢ + dsimp only at h ⊢ + exact h + | letOp op rest => + rw [runCode.eq_def] at h ⊢ + dsimp only at h ⊢ + cases hop : runOp ctx fuel cur store env op with + | error err => + rw [hop, bindErr] at h + have herr : err = error := Except.error.inj h + subst err + rw [ihOp _ _ _ _ _ hop, bindErr] + | ok opOut => + rcases opOut with ⟨middle, value⟩ + rw [hop, bindOk] at h + rw [monoOp _ _ _ _ _ _ hop, bindOk] + exact ihCode _ _ _ _ _ h + | case scrut peelNat alts => + rw [runCode.eq_def] at h ⊢ + dsimp only at h ⊢ + cases hscrut : resolveAtom env scrut with + | error err => + rw [hscrut, bindErr] at h + rw [bindErr] + exact h + | ok scrutValue => + rw [hscrut, bindOk] at h + rw [bindOk] + cases scrutValue with + | loc loc => + dsimp only at h ⊢ + cases hbox : store.get? loc with + | none => simp only [hbox] at h ⊢; exact h + | some box => + simp only [hbox] at h ⊢ + cases box with + | mk world rc node => + cases node with + | papN address arity args => exact h + | ctorN cid fields => + cases halt : alts.find? + (fun alt => alt.cidx == cid.cidx) with + | none => simp only [halt] at h ⊢; exact h + | some alt => + cases alt with + | mk cidx fieldCount body => + cases hsize : fields.size != fieldCount + · simp only [halt, hsize, Bool.false_eq_true, + if_false] at h ⊢ + exact ihCode _ _ _ _ _ h + · simp only [halt, hsize, if_true] at h ⊢ + exact h + | lit literal => + cases literal with + | str string => exact h + | nat value => + cases hpeel : peelNat with + | false => simp only [hpeel] at h ⊢; exact h + | true => + cases value with + | zero => + cases halt : alts.find? + (fun alt => alt.cidx == 0) with + | none => simp only [hpeel, halt] at h ⊢; exact h + | some alt => + cases alt with + | mk cidx fieldCount body => + cases fieldCount with + | zero => + simp only [hpeel, halt] at h ⊢ + exact ihCode _ _ _ _ _ h + | succ fieldCount => + simp only [hpeel, halt] at h ⊢ + exact h + | succ value => + cases halt : alts.find? + (fun alt => alt.cidx == 1) with + | none => simp only [hpeel, halt] at h ⊢; exact h + | some alt => + cases alt with + | mk cidx fieldCount body => + cases fieldCount with + | zero => + simp only [hpeel, halt] at h ⊢ + exact h + | succ fieldCount => + cases fieldCount with + | zero => + simp only [hpeel, halt] at h ⊢ + exact ihCode _ _ _ _ _ h + | succ fieldCount => + simp only [hpeel, halt] at h ⊢ + exact h + | erased => exact h + · intro ctx cur store env op h + cases op with + | pure atom => + rw [runOp.eq_def] at h ⊢; dsimp only at h ⊢; exact h + | alloc world cid args => + rw [runOp.eq_def] at h ⊢; dsimp only at h ⊢; exact h + | reuse target cid args => + rw [runOp.eq_def] at h ⊢; dsimp only at h ⊢; exact h + | free target => + rw [runOp.eq_def] at h ⊢; dsimp only at h ⊢; exact h + | dup target => + rw [runOp.eq_def] at h ⊢; dsimp only at h ⊢; exact h + | drop target => + rw [runOp.eq_def] at h ⊢ + dsimp only at h ⊢ + cases htarget : resolveAtom env target with + | error err => + rw [htarget, bindErr] at h + rw [bindErr] + exact h + | ok targetValue => + rw [htarget, bindOk] at h + rw [bindOk] + cases targetValue with + | loc loc => + dsimp only at h ⊢ + cases hdrop : dropVal ctx fuel store (.loc loc) with + | error err => + rw [hdrop, bindErr] at h + have herr : err = error := Except.error.inj h + subst err + rw [ihDrop _ _ _ hdrop, bindErr] + | ok dropped => + rw [hdrop, bindOk] at h + contradiction + | lit literal => exact h + | erased => exact h + | dropU target => + rw [runOp.eq_def] at h ⊢ + dsimp only at h ⊢ + cases htarget : resolveAtom env target with + | error err => + rw [htarget, bindErr] at h + rw [bindErr] + exact h + | ok targetValue => + rw [htarget, bindOk] at h + rw [bindOk] + cases targetValue with + | loc loc => + dsimp only at h ⊢ + cases hdrop : dropUVal ctx fuel store (.loc loc) with + | error err => + rw [hdrop, bindErr] at h + have herr : err = error := Except.error.inj h + subst err + rw [ihDropU _ _ _ hdrop, bindErr] + | ok dropped => + rw [hdrop, bindOk] at h + contradiction + | lit literal => exact h + | erased => exact h + | fetch target field => + rw [runOp.eq_def] at h ⊢; dsimp only at h ⊢; exact h + | call address args => + rw [runOp.eq_def] at h ⊢ + dsimp only at h ⊢ + cases hargs : resolveAtoms env args with + | error err => + rw [hargs, bindErr] at h + rw [bindErr] + exact h + | ok values => + rw [hargs, bindOk] at h + rw [bindOk] + exact ihInvoke _ _ _ _ h + | callSelf args => + rw [runOp.eq_def] at h ⊢ + dsimp only at h ⊢ + cases hargs : resolveAtoms env args with + | error err => + rw [hargs, bindErr] at h + rw [bindErr] + exact h + | ok values => + rw [hargs, bindOk] at h + rw [bindOk] + cases harity : values.length != cur.arity + · simp only [harity, Bool.false_eq_true, if_false] at h ⊢ + cases hcode : runCode ctx fuel cur store values.reverse + cur.body with + | error err => + rw [hcode, bindErr] at h + have herr : err = error := Except.error.inj h + subst err + rw [ihCode _ _ _ _ _ hcode, bindErr] + | ok result => + rw [hcode, bindOk] at h + rw [monoCode _ _ _ _ _ _ hcode, bindOk] + exact h + · simp only [harity, if_true] at h ⊢ + exact h + | papp address args => + rw [runOp.eq_def] at h ⊢; dsimp only at h ⊢; exact h + | apply function args => + rw [runOp.eq_def] at h ⊢ + dsimp only at h ⊢ + cases hfunction : resolveAtom env function with + | error err => + rw [hfunction, bindErr] at h + rw [bindErr] + exact h + | ok functionValue => + rw [hfunction, bindOk] at h + rw [bindOk] + cases hargs : resolveAtoms env args with + | error err => + rw [hargs, bindErr] at h + rw [bindErr] + exact h + | ok values => + rw [hargs, bindOk] at h + rw [bindOk] + exact ihApply _ _ _ _ h + | extern address args => + rw [runOp.eq_def] at h ⊢; dsimp only at h ⊢; exact h + · intro ctx address args store h + rw [invoke.eq_def] at h ⊢ + dsimp only at h ⊢ + cases hdecl : ctx.decls address with + | none => simp only [hdecl] at h ⊢; exact h + | some decl => + simp only [hdecl] at h ⊢ + cases decl with + | extern arity => exact h + | fn d => + dsimp only at h ⊢ + cases harity : args.length != d.arity + · simp only [harity, Bool.false_eq_true, if_false] at h ⊢ + cases hcode : runCode ctx fuel d store args.reverse d.body with + | error err => + rw [hcode, bindErr] at h + have herr : err = error := Except.error.inj h + subst err + rw [ihCode _ _ _ _ _ hcode, bindErr] + | ok result => + rw [hcode, bindOk] at h + rw [monoCode _ _ _ _ _ _ hcode, bindOk] + exact h + · simp only [harity, if_true] at h ⊢ + exact h + · intro ctx store function args h + rw [applyGo.eq_def] at h ⊢ + dsimp only at h ⊢ + cases function with + | lit literal => exact h + | erased => + cases hdrop : dropMany ctx fuel store args with + | error err => + rw [hdrop, bindErr] at h + have herr : err = error := Except.error.inj h + subst err + rw [ihDropMany _ _ _ hdrop, bindErr] + | ok dropped => + rw [hdrop, bindOk] at h + contradiction + | loc loc => + dsimp only at h ⊢ + cases hbox : store.get? loc with + | none => simp only [hbox] at h ⊢; exact h + | some box => + simp only [hbox] at h ⊢ + cases box with + | mk world rc node => + cases node with + | ctorN cid fields => exact h + | papN address arity captured => + dsimp only at h ⊢ + cases hdup : dupVals store captured.toList with + | error err => + rw [hdup, bindErr] at h + rw [bindErr] + exact h + | ok duplicated => + rw [hdup, bindOk] at h + rw [bindOk] + cases hdrop : dropVal ctx fuel duplicated (.loc loc) with + | error err => + rw [hdrop, bindErr] at h + have herr : err = error := Except.error.inj h + subst err + rw [ihDrop _ _ _ hdrop, bindErr] + | ok ready => + rw [hdrop, bindOk] at h + rw [monoDrop _ _ _ _ hdrop, bindOk] + by_cases hunder : + (captured.toList ++ args).length < arity + · simp only [hunder] at h ⊢ + exact h + · simp only [hunder] at h ⊢ + cases hexact : + (captured.toList ++ args).length == arity + · simp only [hexact, Bool.false_eq_true, + if_false] at h ⊢ + cases hdecl : ctx.decls address with + | none => simp only [hdecl] at h ⊢; exact h + | some decl => + cases hpapsafe : declPapSafe decl with + | false => + simp only [hdecl, hpapsafe, + Bool.false_eq_true, if_false] at h ⊢ + exact h + | true => + simp only [hdecl, hpapsafe, if_true] at h ⊢ + cases hinvoke : invoke ctx fuel address + ((captured.toList ++ args).take arity) ready with + | error err => + rw [hinvoke, bindErr] at h + have herr : err = error := Except.error.inj h + subst err + rw [ihInvoke _ _ _ _ hinvoke, bindErr] + | ok called => + rcases called with ⟨calledStore, calledValue⟩ + rw [hinvoke, bindOk] at h + rw [monoInvoke _ _ _ _ _ hinvoke, bindOk] + exact ihApply _ _ _ _ h + · simp only [hexact, if_true] at h ⊢ + cases hdecl : ctx.decls address with + | none => simp only [hdecl] at h ⊢; exact h + | some decl => + cases hpapsafe : declPapSafe decl with + | false => + simp only [hdecl, hpapsafe, + Bool.false_eq_true, if_false] at h ⊢ + exact h + | true => + simp only [hdecl, hpapsafe, if_true] at h ⊢ + exact ihInvoke _ _ _ _ h + · intro ctx store value h + rw [dropVal.eq_def] at h ⊢ + dsimp only at h ⊢ + cases value with + | lit literal => exact h + | erased => exact h + | loc loc => + dsimp only at h ⊢ + cases hbox : store.get? loc with + | none => simp only [hbox] at h ⊢; exact h + | some box => + simp only [hbox] at h ⊢ + cases box with + | mk world rc node => + cases world with + | unique => exact h + | shared => + cases hrc : rc == 1 + · simp only [hrc, Bool.false_eq_true, if_false] at h ⊢ + exact h + · simp only [hrc, if_true] at h ⊢ + cases node with + | ctorN cid fields => + exact ihDropMany _ _ _ h + | papN address arity args => + exact ihDropMany _ _ _ h + · intro ctx store values h + rw [dropMany.eq_def] at h ⊢ + dsimp only at h ⊢ + cases values with + | nil => exact h + | cons value rest => + dsimp only at h ⊢ + cases hdrop : dropVal ctx fuel store value with + | error err => + rw [hdrop, bindErr] at h + have herr : err = error := Except.error.inj h + subst err + rw [ihDrop _ _ _ hdrop, bindErr] + | ok middle => + rw [hdrop, bindOk] at h + rw [monoDrop _ _ _ _ hdrop, bindOk] + exact ihDropMany _ _ _ h + · intro ctx store value h + rw [dropUVal.eq_def] at h ⊢ + dsimp only at h ⊢ + cases value with + | lit literal => exact h + | erased => exact h + | loc loc => + dsimp only at h ⊢ + cases hbox : store.get? loc with + | none => simp only [hbox] at h ⊢; exact h + | some box => + simp only [hbox] at h ⊢ + cases box with + | mk world rc node => + cases world with + | shared => exact h + | unique => + cases node with + | papN address arity args => exact h + | ctorN cid fields => + exact ihDropManyU _ _ _ h + · intro ctx store values h + rw [dropManyU.eq_def] at h ⊢ + dsimp only at h ⊢ + cases values with + | nil => exact h + | cons value rest => + dsimp only at h ⊢ + cases hdrop : dropUVal ctx fuel store value with + | error err => + rw [hdrop, bindErr] at h + have herr : err = error := Except.error.inj h + subst err + rw [ihDropU _ _ _ hdrop, bindErr] + | ok middle => + rw [hdrop, bindOk] at h + rw [monoDropU _ _ _ _ hdrop, bindOk] + exact ihDropManyU _ _ _ h +/-- Successful code execution is stable under raising fuel. -/ +theorem runCode_mono {ctx : Ctx} {fuel larger : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {code : Code} + {out : Store × RVal} (hle : fuel ≤ larger) + (hrun : runCode ctx fuel cur store env code = .ok out) : + runCode ctx larger cur store env code = .ok out := by + exact fuel_mono_of_succ + (fun current h => (monoAt current).1 _ _ _ _ _ _ h) hle hrun + +/-- Every reached non-fuel code error persists when fuel is raised. -/ +theorem runCode_error_mono {ctx : Ctx} {fuel larger : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {code : Code} {error : Err} + (hle : fuel ≤ larger) (hne : error ≠ .fuel) + (hrun : runCode ctx fuel cur store env code = .error error) : + runCode ctx larger cur store env code = .error error := by + exact fuel_mono_of_succ + (fun current h => (errorMonoAt current error hne).1 _ _ _ _ _ h) + hle hrun + +/-- A dynamic memory error in code execution persists when fuel is raised. +Fuel may reveal more execution, but it cannot repair an already-reached +memory-discipline failure. -/ +theorem runCode_mem_mono {ctx : Ctx} {fuel larger : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {code : Code} {message : String} + (hle : fuel ≤ larger) + (hrun : runCode ctx fuel cur store env code = .error (.mem message)) : + runCode ctx larger cur store env code = .error (.mem message) := + runCode_error_mono hle (by simp) hrun + +/-- Successful primitive-operation execution is stable under raising fuel. -/ +theorem runOp_mono {ctx : Ctx} {fuel larger : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {op : Op} + {out : Store × RVal} (hle : fuel ≤ larger) + (hrun : runOp ctx fuel cur store env op = .ok out) : + runOp ctx larger cur store env op = .ok out := by + exact fuel_mono_of_succ + (fun current h => (monoAt current).2.1 _ _ _ _ _ _ h) hle hrun + +/-- Every reached non-fuel primitive-operation error persists when fuel is +raised. -/ +theorem runOp_error_mono {ctx : Ctx} {fuel larger : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {op : Op} {error : Err} + (hle : fuel ≤ larger) (hne : error ≠ .fuel) + (hrun : runOp ctx fuel cur store env op = .error error) : + runOp ctx larger cur store env op = .error error := by + exact fuel_mono_of_succ + (fun current h => (errorMonoAt current error hne).2.1 _ _ _ _ _ h) + hle hrun + +theorem runOp_mem_mono {ctx : Ctx} {fuel larger : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {op : Op} {message : String} + (hle : fuel ≤ larger) + (hrun : runOp ctx fuel cur store env op = .error (.mem message)) : + runOp ctx larger cur store env op = .error (.mem message) := + runOp_error_mono hle (by simp) hrun + +/-- Successful known invocation is stable under raising fuel. -/ +theorem invoke_mono {ctx : Ctx} {fuel larger : Nat} + {address : Ixon.Address} + {args : List RVal} {store : Store} {out : Store × RVal} + (hle : fuel ≤ larger) + (hrun : invoke ctx fuel address args store = .ok out) : + invoke ctx larger address args store = .ok out := by + exact fuel_mono_of_succ + (fun current h => (monoAt current).2.2.1 _ _ _ _ _ h) hle hrun + +theorem invoke_error_mono {ctx : Ctx} {fuel larger : Nat} + {address : Ixon.Address} {args : List RVal} {store : Store} + {error : Err} (hle : fuel ≤ larger) (hne : error ≠ .fuel) + (hrun : invoke ctx fuel address args store = .error error) : + invoke ctx larger address args store = .error error := by + exact fuel_mono_of_succ + (fun current h => (errorMonoAt current error hne).2.2.1 _ _ _ _ h) + hle hrun + +/-- Successful higher-order application is stable under raising fuel. -/ +theorem applyGo_mono {ctx : Ctx} {fuel larger : Nat} {store : Store} + {function : RVal} {args : List RVal} {out : Store × RVal} + (hle : fuel ≤ larger) + (hrun : applyGo ctx fuel store function args = .ok out) : + applyGo ctx larger store function args = .ok out := by + exact fuel_mono_of_succ + (fun current h => (monoAt current).2.2.2.1 _ _ _ _ _ h) hle hrun + +theorem applyGo_error_mono {ctx : Ctx} {fuel larger : Nat} {store : Store} + {function : RVal} {args : List RVal} {error : Err} + (hle : fuel ≤ larger) (hne : error ≠ .fuel) + (hrun : applyGo ctx fuel store function args = .error error) : + applyGo ctx larger store function args = .error error := by + exact fuel_mono_of_succ + (fun current h => + (errorMonoAt current error hne).2.2.2.1 _ _ _ _ h) + hle hrun + +/-- Successful shared deep drop is stable under raising fuel. -/ +theorem dropVal_mono {ctx : Ctx} {fuel larger : Nat} {store : Store} + {value : RVal} {out : Store} (hle : fuel ≤ larger) + (hrun : dropVal ctx fuel store value = .ok out) : + dropVal ctx larger store value = .ok out := by + exact fuel_mono_of_succ + (fun current h => (monoAt current).2.2.2.2.1 _ _ _ _ h) hle hrun + +theorem dropVal_error_mono {ctx : Ctx} {fuel larger : Nat} + {store : Store} {value : RVal} {error : Err} + (hle : fuel ≤ larger) (hne : error ≠ .fuel) + (hrun : dropVal ctx fuel store value = .error error) : + dropVal ctx larger store value = .error error := by + exact fuel_mono_of_succ + (fun current h => + (errorMonoAt current error hne).2.2.2.2.1 _ _ _ h) + hle hrun + +theorem dropMany_mono {ctx : Ctx} {fuel larger : Nat} {store : Store} + {values : List RVal} {out : Store} (hle : fuel ≤ larger) + (hrun : dropMany ctx fuel store values = .ok out) : + dropMany ctx larger store values = .ok out := by + exact fuel_mono_of_succ + (fun current h => (monoAt current).2.2.2.2.2.1 _ _ _ _ h) hle hrun + +theorem dropMany_error_mono {ctx : Ctx} {fuel larger : Nat} + {store : Store} {values : List RVal} {error : Err} + (hle : fuel ≤ larger) (hne : error ≠ .fuel) + (hrun : dropMany ctx fuel store values = .error error) : + dropMany ctx larger store values = .error error := by + exact fuel_mono_of_succ + (fun current h => + (errorMonoAt current error hne).2.2.2.2.2.1 _ _ _ h) + hle hrun + +/-- Successful unique deep free is stable under raising fuel. -/ +theorem dropUVal_mono {ctx : Ctx} {fuel larger : Nat} {store : Store} + {value : RVal} {out : Store} (hle : fuel ≤ larger) + (hrun : dropUVal ctx fuel store value = .ok out) : + dropUVal ctx larger store value = .ok out := by + exact fuel_mono_of_succ + (fun current h => (monoAt current).2.2.2.2.2.2.1 _ _ _ _ h) hle hrun + +theorem dropUVal_error_mono {ctx : Ctx} {fuel larger : Nat} + {store : Store} {value : RVal} {error : Err} + (hle : fuel ≤ larger) (hne : error ≠ .fuel) + (hrun : dropUVal ctx fuel store value = .error error) : + dropUVal ctx larger store value = .error error := by + exact fuel_mono_of_succ + (fun current h => + (errorMonoAt current error hne).2.2.2.2.2.2.1 _ _ _ h) + hle hrun + +theorem dropManyU_mono {ctx : Ctx} {fuel larger : Nat} {store : Store} + {values : List RVal} {out : Store} (hle : fuel ≤ larger) + (hrun : dropManyU ctx fuel store values = .ok out) : + dropManyU ctx larger store values = .ok out := by + exact fuel_mono_of_succ + (fun current h => (monoAt current).2.2.2.2.2.2.2 _ _ _ _ h) hle hrun + +theorem dropManyU_error_mono {ctx : Ctx} {fuel larger : Nat} + {store : Store} {values : List RVal} {error : Err} + (hle : fuel ≤ larger) (hne : error ≠ .fuel) + (hrun : dropManyU ctx fuel store values = .error error) : + dropManyU ctx larger store values = .error error := by + exact fuel_mono_of_succ + (fun current h => + (errorMonoAt current error hne).2.2.2.2.2.2.2 _ _ _ h) + hle hrun + +/-- Top-level specialization of `runCode_mono`. -/ +theorem runMain_mono {ctx : Ctx} {code : Code} {fuel larger : Nat} + {out : Store × RVal} (hle : fuel ≤ larger) + (hrun : runMain ctx code fuel = .ok out) : + runMain ctx code larger = .ok out := + runCode_mono hle hrun + +/-- Top-level specialization of `runCode_error_mono`. -/ +theorem runMain_error_mono {ctx : Ctx} {code : Code} + {fuel larger : Nat} {error : Err} (hle : fuel ≤ larger) + (hne : error ≠ .fuel) + (hrun : runMain ctx code fuel = .error error) : + runMain ctx code larger = .error error := + runCode_error_mono hle hne hrun + +/-- Reached ordinary stuckness persists when evaluator fuel is raised. -/ +theorem runMain_stuck_mono {ctx : Ctx} {code : Code} + {fuel larger : Nat} {message : String} (hle : fuel ≤ larger) + (hrun : runMain ctx code fuel = .error (.stuck message)) : + runMain ctx code larger = .error (.stuck message) := + runMain_error_mono hle (by simp) hrun + +/-- A reached closed-world lookup failure persists when fuel is raised. -/ +theorem runMain_unknownRef_mono {ctx : Ctx} {code : Code} + {fuel larger : Nat} {address : Ixon.Address} (hle : fuel ≤ larger) + (hrun : runMain ctx code fuel = .error (.unknownRef address)) : + runMain ctx code larger = .error (.unknownRef address) := + runMain_error_mono hle (by simp) hrun + +/-- Top-level specialization of `runCode_mem_mono`. -/ +theorem runMain_mem_mono {ctx : Ctx} {code : Code} + {fuel larger : Nat} {message : String} (hle : fuel ≤ larger) + (hrun : runMain ctx code fuel = .error (.mem message)) : + runMain ctx code larger = .error (.mem message) := + runCode_mem_mono hle hrun + +end Ix.Compiler.IxIR1 diff --git a/Ix/Compiler/IxIR1/MutualBlock.lean b/Ix/Compiler/IxIR1/MutualBlock.lean new file mode 100644 index 000000000..cfe45c73d --- /dev/null +++ b/Ix/Compiler/IxIR1/MutualBlock.lean @@ -0,0 +1,1240 @@ +import Ix.Compiler.IxIR1.Decode +import Ix.Compiler.IxIR1.Readdress + +/-! +# Cycle-safe IxIR₁ block identities + +Ordinary IxIR₁ declaration hashes can be computed only after every addressed +dependency is known. A source-backed function and one of its generated +closures may instead form a genuine address cycle. This module gives such a +strongly connected component a finite canonical spelling: edges within the +ordered block use local indices, external edges retain full addresses, the +symbolic block is hashed once, and executable member keys are independently +derived from that block identity and member index. + +The module is deliberately independent of SCC discovery. It is the checked +artifact boundary consumed by a later whole-program pass: strict canonical +decoding, scope validation, collision checks, materialization, and an erased +semantic audit. Native BLAKE3 calls remain confined to compiled producers, +ingress, and tests. +-/ + +namespace Ix.Compiler.IxIR1 + +open Ix.Compiler.Ixon (Address Owned) +open Ix.Compiler.IxIR + +namespace MutualBlock + +/-! ## Symbolic block syntax -/ + +/-- An address-bearing edge in a canonical block. -/ +inductive Ref where + | local (index : Nat) + | external (address : Address) + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- Constructor identity with a symbolic block edge. -/ +structure CtorId where + block : Ref + indIdx : Nat + cidx : Nat + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- IxIR₁ operations with every static address represented symbolically. -/ +inductive Op where + | pure (atom : Atom) + | alloc (world : Owned) (cid : CtorId) (args : Array Atom) + | reuse (target : Atom) (cid : CtorId) (args : Array Atom) + | free (target : Atom) + | dup (target : Atom) + | drop (target : Atom) + | dropU (target : Atom) + | fetch (target : Atom) (field : Nat) + | call (function : Ref) (args : Array Atom) + | callSelf (args : Array Atom) + | papp (function : Ref) (args : Array Atom) + | apply (function : Atom) (args : Array Atom) + | extern (function : Ref) (args : Array Atom) + +mutual + +/-- A symbolic case alternative. -/ +inductive Alt where + | mk (cidx fields : Nat) (body : Code) + +/-- Symbolic IxIR₁ code. -/ +inductive Code where + | ret (atom : Atom) + | letOp (operation : Op) (rest : Code) + | case (scrutinee : Atom) (peelNat : Bool) (alternatives : Array Alt) + +end + +/-- A saturated symbolic function. -/ +structure FnDef where + arity : Nat + result : Owned + papSafe : Bool + body : Code + +/-- A declaration in a symbolic IxIR₁ block. -/ +inductive Decl where + | fn (definition : FnDef) + | extern (arity : Nat) + +/-! ## Temporary-name abstraction and materialization -/ + +/-- First zero-based position of an address in an ordered key list. -/ +def localIndex? (keys : List Address) (address : Address) : Option Nat := + let rec loop : Nat → List Address → Option Nat + | _, [] => none + | index, key :: rest => + if key == address then some index else loop (index + 1) rest + loop 0 keys + +namespace Ref + +def abstract (keys : List Address) (address : Address) : Ref := + match localIndex? keys address with + | some index => .local index + | none => .external address + +def externalReferences : Ref → List Address + | .local _ => [] + | .external address => [address] + +def wellScoped (memberCount : Nat) : Ref → Bool + | .local index => index < memberCount + | .external _ => true + +def materialize (memberKeys : Array Address) : Ref → Except String Address + | .local index => + match memberKeys[index]? with + | some address => .ok address + | none => .error s!"IxIR1 block local reference {index} is out of range" + | .external address => .ok address + +end Ref + +namespace CtorId + +def abstract (keys : List Address) (cid : IxIR1.CtorId) : CtorId := + { block := Ref.abstract keys cid.block + indIdx := cid.indIdx + cidx := cid.cidx } + +def materialize (memberKeys : Array Address) + (cid : CtorId) : Except String IxIR1.CtorId := + return ⟨← cid.block.materialize memberKeys, cid.indIdx, cid.cidx⟩ + +def externalReferences (cid : CtorId) : List Address := + cid.block.externalReferences + +def wellScoped (memberCount : Nat) (cid : CtorId) : Bool := + cid.block.wellScoped memberCount + +end CtorId + +namespace Op + +def abstract (keys : List Address) : IxIR1.Op → Op + | .pure atom => .pure atom + | .alloc world cid args => .alloc world (CtorId.abstract keys cid) args + | .reuse target cid args => .reuse target (CtorId.abstract keys cid) args + | .free target => .free target + | .dup target => .dup target + | .drop target => .drop target + | .dropU target => .dropU target + | .fetch target field => .fetch target field + | .call function args => .call (Ref.abstract keys function) args + | .callSelf args => .callSelf args + | .papp function args => .papp (Ref.abstract keys function) args + | .apply function args => .apply function args + | .extern function args => .extern (Ref.abstract keys function) args + +def materialize (memberKeys : Array Address) : Op → Except String IxIR1.Op + | .pure atom => .ok (.pure atom) + | .alloc world cid args => + return .alloc world (← cid.materialize memberKeys) args + | .reuse target cid args => + return .reuse target (← cid.materialize memberKeys) args + | .free target => .ok (.free target) + | .dup target => .ok (.dup target) + | .drop target => .ok (.drop target) + | .dropU target => .ok (.dropU target) + | .fetch target field => .ok (.fetch target field) + | .call function args => + return .call (← function.materialize memberKeys) args + | .callSelf args => .ok (.callSelf args) + | .papp function args => + return .papp (← function.materialize memberKeys) args + | .apply function args => .ok (.apply function args) + | .extern function args => + return .extern (← function.materialize memberKeys) args + +def externalReferences : Op → List Address + | .alloc _ cid _ | .reuse _ cid _ => cid.externalReferences + | .call function _ | .papp function _ | .extern function _ => + function.externalReferences + | _ => [] + +def wellScoped (memberCount : Nat) : Op → Bool + | .alloc _ cid _ | .reuse _ cid _ => cid.wellScoped memberCount + | .call function _ | .papp function _ | .extern function _ => + function.wellScoped memberCount + | _ => true + +end Op + +mutual + +def Code.abstract (keys : List Address) : IxIR1.Code → Code + | .ret atom => .ret atom + | .letOp operation rest => + .letOp (Op.abstract keys operation) (Code.abstract keys rest) + | .case scrutinee peelNat alternatives => + .case scrutinee peelNat (alternatives.map (Alt.abstract keys)) + +def Alt.abstract (keys : List Address) : IxIR1.Alt → Alt + | .mk cidx fields body => .mk cidx fields (Code.abstract keys body) + +end + +mutual + +def Code.materialize (memberKeys : Array Address) : + Code → Except String IxIR1.Code + | .ret atom => .ok (.ret atom) + | .letOp operation rest => + return .letOp (← operation.materialize memberKeys) + (← Code.materialize memberKeys rest) + | .case scrutinee peelNat alternatives => + return .case scrutinee peelNat + (← alternatives.mapM (Alt.materialize memberKeys)) + +def Alt.materialize (memberKeys : Array Address) : + Alt → Except String IxIR1.Alt + | .mk cidx fields body => + return .mk cidx fields (← Code.materialize memberKeys body) + +end + +mutual + +def Code.externalReferences : Code → List Address + | .ret _ => [] + | .letOp operation rest => + operation.externalReferences ++ Code.externalReferences rest + | .case _ _ alternatives => + AltList.externalReferences alternatives.toList + +def Alt.externalReferences : Alt → List Address + | .mk _ _ body => Code.externalReferences body + +def AltList.externalReferences : List Alt → List Address + | [] => [] + | alternative :: rest => + Alt.externalReferences alternative ++ AltList.externalReferences rest + +end + +mutual + +def Code.wellScoped (memberCount : Nat) : Code → Bool + | .ret _ => true + | .letOp operation rest => + operation.wellScoped memberCount && Code.wellScoped memberCount rest + | .case _ _ alternatives => + AltList.wellScoped memberCount alternatives.toList + +def Alt.wellScoped (memberCount : Nat) : Alt → Bool + | .mk _ _ body => Code.wellScoped memberCount body + +def AltList.wellScoped (memberCount : Nat) : List Alt → Bool + | [] => true + | alternative :: rest => + Alt.wellScoped memberCount alternative && + AltList.wellScoped memberCount rest + +end + +namespace FnDef + +def abstract (keys : List Address) (definition : IxIR1.FnDef) : FnDef := + { arity := definition.arity + result := definition.result + papSafe := definition.papSafe + body := Code.abstract keys definition.body } + +def materialize (memberKeys : Array Address) + (definition : FnDef) : Except String IxIR1.FnDef := + return ⟨definition.arity, definition.result, definition.papSafe, + ← definition.body.materialize memberKeys⟩ + +def externalReferences (definition : FnDef) : List Address := + definition.body.externalReferences + +def wellScoped (memberCount : Nat) (definition : FnDef) : Bool := + definition.body.wellScoped memberCount + +end FnDef + +namespace Decl + +def abstract (keys : List Address) : IxIR1.Decl → Decl + | .fn definition => .fn (FnDef.abstract keys definition) + | .extern arity => .extern arity + +def materialize (memberKeys : Array Address) : + Decl → Except String IxIR1.Decl + | .fn definition => return .fn (← definition.materialize memberKeys) + | .extern arity => .ok (.extern arity) + +def externalReferences : Decl → List Address + | .fn definition => definition.externalReferences + | .extern _ => [] + +def wellScoped (memberCount : Nat) : Decl → Bool + | .fn definition => definition.wellScoped memberCount + | .extern _ => true + +end Decl + +/-- Abstract a transiently keyed ordered block. Keys affect only local-edge +classification and never enter the canonical bytes. -/ +def abstractMembers (members : List (Address × IxIR1.Decl)) : List Decl := + let keys := members.map (·.1) + members.map fun member => Decl.abstract keys member.2 + +/-! ## Executable structural equality -/ + +namespace Op + +def structurallyEq : Op → Op → Bool + | .pure left, .pure right => left == right + | .alloc lw lc la, .alloc rw rc ra => + lw == rw && lc == rc && la == ra + | .reuse lt lc la, .reuse rt rc ra => + lt == rt && lc == rc && la == ra + | .free left, .free right + | .dup left, .dup right + | .drop left, .drop right + | .dropU left, .dropU right => left == right + | .fetch lt lf, .fetch rt rf => lt == rt && lf == rf + | .call lf la, .call rf ra + | .papp lf la, .papp rf ra + | .extern lf la, .extern rf ra => lf == rf && la == ra + | .callSelf left, .callSelf right => left == right + | .apply lf la, .apply rf ra => lf == rf && la == ra + | _, _ => false + +theorem structurallyEq_eq_true_iff (left right : Op) : + structurallyEq left right = true ↔ left = right := by + cases left <;> cases right <;> + simp [structurallyEq, beq_iff_eq, and_assoc] + +end Op + +mutual + +def Code.structurallyEq : Code → Code → Bool + | .ret left, .ret right => left == right + | .letOp leftOp leftRest, .letOp rightOp rightRest => + Op.structurallyEq leftOp rightOp && + Code.structurallyEq leftRest rightRest + | .case ls lp la, .case rs rp ra => + ls == rs && lp == rp && + AltList.structurallyEq la.toList ra.toList + | _, _ => false + +def Alt.structurallyEq : Alt → Alt → Bool + | .mk lc lf lb, .mk rc rf rb => + lc == rc && lf == rf && Code.structurallyEq lb rb + +def AltList.structurallyEq : List Alt → List Alt → Bool + | [], [] => true + | left :: leftRest, right :: rightRest => + Alt.structurallyEq left right && + AltList.structurallyEq leftRest rightRest + | _, _ => false + +end + + +mutual + +theorem Code.structurallyEq_eq_true_iff (left right : Code) : + Code.structurallyEq left right = true ↔ left = right := by + cases left <;> cases right <;> + simp [Code.structurallyEq, Op.structurallyEq_eq_true_iff, + Code.structurallyEq_eq_true_iff, + AltList.structurallyEq_eq_true_iff, beq_iff_eq, and_assoc] + +theorem Alt.structurallyEq_eq_true_iff (left right : Alt) : + Alt.structurallyEq left right = true ↔ left = right := by + cases left + cases right + simp [Alt.structurallyEq, Code.structurallyEq_eq_true_iff, + beq_iff_eq, and_assoc] + +theorem AltList.structurallyEq_eq_true_iff (left right : List Alt) : + AltList.structurallyEq left right = true ↔ left = right := by + cases left with + | nil => cases right <;> simp [AltList.structurallyEq] + | cons left leftRest => + cases right with + | nil => simp [AltList.structurallyEq] + | cons right rightRest => + simp [AltList.structurallyEq, + Alt.structurallyEq_eq_true_iff, + AltList.structurallyEq_eq_true_iff] + +end + + +namespace FnDef + +def structurallyEq (left right : FnDef) : Bool := + left.arity == right.arity && left.result == right.result && + left.papSafe == right.papSafe && + Code.structurallyEq left.body right.body + +theorem structurallyEq_eq_true_iff (left right : FnDef) : + structurallyEq left right = true ↔ left = right := by + cases left + cases right + simp [structurallyEq, Code.structurallyEq_eq_true_iff, + beq_iff_eq, and_assoc] + +end FnDef + +namespace Decl + +def structurallyEq : Decl → Decl → Bool + | .fn left, .fn right => FnDef.structurallyEq left right + | .extern left, .extern right => left == right + | _, _ => false + +theorem structurallyEq_eq_true_iff (left right : Decl) : + structurallyEq left right = true ↔ left = right := by + cases left <;> cases right <;> + simp [structurallyEq, FnDef.structurallyEq_eq_true_iff, + beq_iff_eq] + +end Decl + +/-! ## Canonical bytes and identities -/ + +namespace Ref + +def bytes : Ref → ByteArray + | .local index => Encoding.tag 0 ++ Encoding.nat index + | .external address => Encoding.tag 1 ++ Encoding.address address + +end Ref + +namespace CtorId + +def bytes (cid : CtorId) : ByteArray := + cid.block.bytes ++ Encoding.nat cid.indIdx ++ Encoding.nat cid.cidx + +end CtorId + +namespace Op + +def bytes : Op → ByteArray + | .pure atom => Encoding.tag 0 ++ IxIR1.Atom.bytes atom + | .alloc world cid args => + Encoding.tag 1 ++ Encoding.tag world.toBits ++ cid.bytes ++ + Encoding.array IxIR1.Atom.bytes args + | .reuse target cid args => + Encoding.tag 2 ++ IxIR1.Atom.bytes target ++ cid.bytes ++ + Encoding.array IxIR1.Atom.bytes args + | .free target => Encoding.tag 3 ++ IxIR1.Atom.bytes target + | .dup target => Encoding.tag 4 ++ IxIR1.Atom.bytes target + | .drop target => Encoding.tag 5 ++ IxIR1.Atom.bytes target + | .dropU target => Encoding.tag 6 ++ IxIR1.Atom.bytes target + | .fetch target field => + Encoding.tag 7 ++ IxIR1.Atom.bytes target ++ Encoding.nat field + | .call function args => + Encoding.tag 8 ++ function.bytes ++ + Encoding.array IxIR1.Atom.bytes args + | .callSelf args => + Encoding.tag 9 ++ Encoding.array IxIR1.Atom.bytes args + | .papp function args => + Encoding.tag 10 ++ function.bytes ++ + Encoding.array IxIR1.Atom.bytes args + | .apply function args => + Encoding.tag 11 ++ IxIR1.Atom.bytes function ++ + Encoding.array IxIR1.Atom.bytes args + | .extern function args => + Encoding.tag 12 ++ function.bytes ++ + Encoding.array IxIR1.Atom.bytes args + +end Op + +mutual + +def Code.bytes : Code → ByteArray + | .ret atom => Encoding.tag 0 ++ IxIR1.Atom.bytes atom + | .letOp operation rest => Encoding.tag 1 ++ operation.bytes ++ rest.bytes + | .case scrutinee peelNat alternatives => + Encoding.tag 2 ++ IxIR1.Atom.bytes scrutinee ++ + Encoding.bool peelNat ++ Encoding.nat alternatives.size ++ + AltList.bytes alternatives.toList + +def Alt.bytes : Alt → ByteArray + | .mk cidx fields body => + Encoding.nat cidx ++ Encoding.nat fields ++ body.bytes + +def AltList.bytes : List Alt → ByteArray + | [] => ByteArray.empty + | head :: tail => head.bytes ++ AltList.bytes tail + +end + + +namespace FnDef + +def bytes (definition : FnDef) : ByteArray := + Encoding.nat definition.arity ++ Encoding.tag definition.result.toBits ++ + Encoding.bool definition.papSafe ++ definition.body.bytes + +end FnDef + +namespace Decl + +def bytes : Decl → ByteArray + | .fn definition => Encoding.tag 0 ++ definition.bytes + | .extern arity => Encoding.tag 1 ++ Encoding.nat arity + +end Decl + +namespace Block + +def addressDomain : ByteArray := + Encoding.domain "compilatrix/ixir1/mutual-block/2" ++ Encoding.tag 0 + +def preimage (members : List Decl) : ByteArray := + addressDomain ++ Encoding.list Decl.bytes members + +def address (members : List Decl) : Address := + Address.blake3 (preimage members) + +theorem address_eq_iff_preimage_eq (left right : List Decl) + (hcollision : Address.Blake3NoCollision (preimage left) (preimage right)) : + address left = address right ↔ preimage left = preimage right := by + constructor + · exact hcollision + · intro h + simp only [address] + rw [h] + +end Block + +namespace Member + +def addressDomain : ByteArray := + Encoding.domain "compilatrix/ixir1/mutual-member/1" ++ Encoding.tag 0 + +def preimage (block : Address) (index : Nat) : ByteArray := + addressDomain ++ Encoding.address block ++ Encoding.nat index + +def address (block : Address) (index : Nat) : Address := + Address.blake3 (preimage block index) + +theorem address_eq_iff_preimage_eq (leftBlock rightBlock : Address) + (leftIndex rightIndex : Nat) + (hcollision : Address.Blake3NoCollision + (preimage leftBlock leftIndex) (preimage rightBlock rightIndex)) : + address leftBlock leftIndex = address rightBlock rightIndex ↔ + preimage leftBlock leftIndex = preimage rightBlock rightIndex := by + constructor + · exact hcollision + · intro h + simp only [address] + rw [h] + +end Member + +/-! ## Strict block decoder -/ + +open Ix.Compiler.IxIR.Decode +open Ix.Compiler.Ixon + +def getRefTag : UInt8 → GetM Ref + | 0 => do return .local (← Decode.getNat) + | 1 => do return .external (← Decode.getAddress) + | tag => throw s!"IxIR1 block reference: invalid tag {tag}" + +def getRef : GetM Ref := do + getRefTag (← getU8) + +def getCtorId : GetM CtorId := do + return ⟨← getRef, ← Decode.getNat, ← Decode.getNat⟩ + +def getOpTag : UInt8 → GetM Op + | 0 => do return .pure (← IxIR1.getAtom) + | 1 => do + let world ← IxIR0.getOwned + let cid ← getCtorId + return .alloc world cid (← Decode.getArray IxIR1.getAtom) + | 2 => do + let target ← IxIR1.getAtom + let cid ← getCtorId + return .reuse target cid (← Decode.getArray IxIR1.getAtom) + | 3 => do return .free (← IxIR1.getAtom) + | 4 => do return .dup (← IxIR1.getAtom) + | 5 => do return .drop (← IxIR1.getAtom) + | 6 => do return .dropU (← IxIR1.getAtom) + | 7 => do return .fetch (← IxIR1.getAtom) (← Decode.getNat) + | 8 => do return .call (← getRef) (← Decode.getArray IxIR1.getAtom) + | 9 => do return .callSelf (← Decode.getArray IxIR1.getAtom) + | 10 => do return .papp (← getRef) (← Decode.getArray IxIR1.getAtom) + | 11 => do return .apply (← IxIR1.getAtom) (← Decode.getArray IxIR1.getAtom) + | 12 => do return .extern (← getRef) (← Decode.getArray IxIR1.getAtom) + | tag => throw s!"IxIR1 block operation: invalid tag {tag}" + +def getOp : GetM Op := do + getOpTag (← getU8) + +def getAlt (recur : GetM Code) : GetM Alt := do + return .mk (← Decode.getNat) (← Decode.getNat) (← recur) + +def getCodeTag (recur : GetM Code) : UInt8 → GetM Code + | 0 => do return .ret (← IxIR1.getAtom) + | 1 => do return .letOp (← getOp) (← recur) + | 2 => do + let scrutinee ← IxIR1.getAtom + let peelNat ← Decode.getBool + return .case scrutinee peelNat (← Decode.getArray (getAlt recur)) + | tag => throw s!"IxIR1 block code: invalid tag {tag}" + +def getCodeFuel : Nat → GetM Code + | 0 => throw "IxIR1 block code: recursion limit" + | fuel + 1 => do + getCodeTag (getCodeFuel fuel) (← getU8) + +def getCode : GetM Code := do + let state ← get + getCodeFuel (state.bytes.size + 1) + +def getFnDef : GetM FnDef := do + return ⟨← Decode.getNat, ← IxIR0.getOwned, ← Decode.getBool, + ← getCode⟩ + +def getDeclTag : UInt8 → GetM Decl + | 0 => do return .fn (← getFnDef) + | 1 => do return .extern (← Decode.getNat) + | tag => throw s!"IxIR1 block declaration: invalid tag {tag}" + +def getDecl : GetM Decl := do + getDeclTag (← getU8) + +def getBlockPreimage : GetM (List Decl) := do + Decode.expectBytes Block.addressDomain + Decode.getList getDecl + +def Block.decodePreimage (bytes : ByteArray) : Except String (List Decl) := + Decode.runCanonical getBlockPreimage Block.preimage bytes + +def Block.decodeArtifact (bytes : ByteArray) : Except String (List Decl) := do + let members ← Block.decodePreimage bytes + if members.isEmpty then + throw "IxIR1 mutual block must contain at least one member" + unless members.all (Decl.wellScoped members.length) do + throw "IxIR1 mutual block contains an out-of-range local reference" + return members + +/-! ### Cursor-relative decoder proofs -/ + +theorem getRef_spec : ∀ target : Ref, GetSpec getRef target.bytes target + | .local index => by + have hpayload := Decode.getSpecMap (Decode.getNat_spec index) Ref.local + have htotal := GetSpec.bind (next := getRefTag) + (Decode.getU8_tag_spec 0) hpayload + simpa only [getRef, Ref.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .external address => by + have hpayload := Decode.getSpecMap + (Decode.getAddress_spec address) Ref.external + have htotal := GetSpec.bind (next := getRefTag) + (Decode.getU8_tag_spec 1) hpayload + simpa only [getRef, Ref.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + +theorem getCtorId_spec (cid : CtorId) : + GetSpec getCtorId cid.bytes cid := by + have hspec := Decode.getSpecMap3 (getRef_spec cid.block) + (Decode.getNat_spec cid.indIdx) (Decode.getNat_spec cid.cidx) CtorId.mk + simpa [getCtorId, CtorId.bytes] using hspec + +private theorem getAtomArray_spec (atoms : Array Atom) : + GetSpec (Decode.getArray IxIR1.getAtom) + (Encoding.array IxIR1.Atom.bytes atoms) atoms := + Decode.getArray_spec IxIR1.getAtom IxIR1.Atom.bytes + IxIR1.getAtom_spec atoms + +theorem getOp_spec : ∀ operation : Op, + GetSpec getOp operation.bytes operation + | .pure atom => by + have hpayload := Decode.getSpecMap (IxIR1.getAtom_spec atom) Op.pure + have htotal := GetSpec.bind (next := getOpTag) + (Decode.getU8_tag_spec 0) hpayload + simpa only [getOp, Op.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .alloc world cid args => by + have hpayload := Decode.getSpecMap3 (IxIR0.getOwned_spec world) + (getCtorId_spec cid) (getAtomArray_spec args) Op.alloc + have htotal := GetSpec.bind (next := getOpTag) + (Decode.getU8_tag_spec 1) hpayload + simpa only [getOp, Op.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .reuse target cid args => by + have hpayload := Decode.getSpecMap3 (IxIR1.getAtom_spec target) + (getCtorId_spec cid) (getAtomArray_spec args) Op.reuse + have htotal := GetSpec.bind (next := getOpTag) + (Decode.getU8_tag_spec 2) hpayload + simpa only [getOp, Op.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .free target => by + have hpayload := Decode.getSpecMap (IxIR1.getAtom_spec target) Op.free + have htotal := GetSpec.bind (next := getOpTag) + (Decode.getU8_tag_spec 3) hpayload + simpa only [getOp, Op.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .dup target => by + have hpayload := Decode.getSpecMap (IxIR1.getAtom_spec target) Op.dup + have htotal := GetSpec.bind (next := getOpTag) + (Decode.getU8_tag_spec 4) hpayload + simpa only [getOp, Op.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .drop target => by + have hpayload := Decode.getSpecMap (IxIR1.getAtom_spec target) Op.drop + have htotal := GetSpec.bind (next := getOpTag) + (Decode.getU8_tag_spec 5) hpayload + simpa only [getOp, Op.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .dropU target => by + have hpayload := Decode.getSpecMap (IxIR1.getAtom_spec target) Op.dropU + have htotal := GetSpec.bind (next := getOpTag) + (Decode.getU8_tag_spec 6) hpayload + simpa only [getOp, Op.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .fetch target field => by + have hpayload := Decode.getSpecMap2 (IxIR1.getAtom_spec target) + (Decode.getNat_spec field) Op.fetch + have htotal := GetSpec.bind (next := getOpTag) + (Decode.getU8_tag_spec 7) hpayload + simpa only [getOp, Op.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .call function args => by + have hpayload := Decode.getSpecMap2 (getRef_spec function) + (getAtomArray_spec args) Op.call + have htotal := GetSpec.bind (next := getOpTag) + (Decode.getU8_tag_spec 8) hpayload + simpa only [getOp, Op.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .callSelf args => by + have hpayload := Decode.getSpecMap (getAtomArray_spec args) Op.callSelf + have htotal := GetSpec.bind (next := getOpTag) + (Decode.getU8_tag_spec 9) hpayload + simpa only [getOp, Op.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .papp function args => by + have hpayload := Decode.getSpecMap2 (getRef_spec function) + (getAtomArray_spec args) Op.papp + have htotal := GetSpec.bind (next := getOpTag) + (Decode.getU8_tag_spec 10) hpayload + simpa only [getOp, Op.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .apply function args => by + have hpayload := Decode.getSpecMap2 (IxIR1.getAtom_spec function) + (getAtomArray_spec args) Op.apply + have htotal := GetSpec.bind (next := getOpTag) + (Decode.getU8_tag_spec 11) hpayload + simpa only [getOp, Op.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .extern function args => by + have hpayload := Decode.getSpecMap2 (getRef_spec function) + (getAtomArray_spec args) Op.extern + have htotal := GetSpec.bind (next := getOpTag) + (Decode.getU8_tag_spec 12) hpayload + simpa only [getOp, Op.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + +theorem AltList.bytes_eq_listBytes (alternatives : List Alt) : + AltList.bytes alternatives = Decode.listBytes Alt.bytes alternatives := by + induction alternatives with + | nil => rfl + | cons head tail ih => simp [AltList.bytes, Decode.listBytes, ih] + +theorem AltList.member_size_le {alternative : Alt} + {alternatives : List Alt} (hmember : alternative ∈ alternatives) : + alternative.bytes.size ≤ (AltList.bytes alternatives).size := by + induction alternatives with + | nil => simp at hmember + | cons head tail ih => + simp only [List.mem_cons] at hmember + simp only [AltList.bytes, ByteArray.size_append] + rcases hmember with rfl | hmember + · omega + · have htail := ih hmember + omega + +theorem Alt.body_size_lt_bytes (cidx fields : Nat) (body : Code) : + body.bytes.size < (Alt.mk cidx fields body).bytes.size := by + simp only [Alt.bytes, ByteArray.size_append] + have hcidx := Decode.nat_size_pos cidx + have hfields := Decode.nat_size_pos fields + omega + +/-- Structural induction exposing every code body nested in an alternative +array. -/ +theorem Code.nested_induction (property : Code → Prop) + (hret : ∀ atom, property (.ret atom)) + (hlet : ∀ operation rest, property rest → + property (.letOp operation rest)) + (hcase : ∀ scrutinee peelNat alternatives, + (∀ cidx fields body, + Alt.mk cidx fields body ∈ alternatives.toList → property body) → + property (.case scrutinee peelNat alternatives)) + (code : Code) : property code := by + apply Code.rec + (motive_1 := fun alternative => match alternative with + | .mk _ _ body => property body) + (motive_2 := property) + (motive_3 := fun alternatives => ∀ cidx fields body, + Alt.mk cidx fields body ∈ alternatives.toList → property body) + (motive_4 := fun alternatives => ∀ cidx fields body, + Alt.mk cidx fields body ∈ alternatives → property body) + (mk := by intro cidx fields body hbody; exact hbody) + (ret := hret) + (letOp := by + intro operation rest hrest + exact hlet operation rest hrest) + (case := hcase) + (by intro alternatives halternatives; exact halternatives) + (by simp) + (by + intro head tail hhead htail cidx fields body hmember + simp only [List.mem_cons] at hmember + rcases hmember with hheadEq | htailMem + · cases hheadEq + exact hhead + · exact htail cidx fields body htailMem) + +theorem getCodeFuel_spec (code : Code) (fuel : Nat) + (hfuel : code.bytes.size < fuel) : + GetSpec (getCodeFuel fuel) code.bytes code := by + apply Code.nested_induction + (property := fun code => ∀ fuel, code.bytes.size < fuel → + GetSpec (getCodeFuel fuel) code.bytes code) + (code := code) + · intro atom fuel hfuel + cases fuel with + | zero => omega + | succ fuel => + have hpayload := Decode.getSpecMap + (IxIR1.getAtom_spec atom) Code.ret + have htotal := GetSpec.bind + (next := getCodeTag (getCodeFuel fuel)) + (Decode.getU8_tag_spec 0) hpayload + simpa only [getCodeFuel, Code.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + · intro operation rest hrest fuel hfuel + cases fuel with + | zero => omega + | succ fuel => + have hrestFuel : rest.bytes.size < fuel := by + simp only [Code.bytes, ByteArray.size_append, + Decode.tag_size] at hfuel + omega + have hpayload := Decode.getSpecMap2 (getOp_spec operation) + (hrest fuel hrestFuel) Code.letOp + have htotal := GetSpec.bind + (next := getCodeTag (getCodeFuel fuel)) + (Decode.getU8_tag_spec 1) hpayload + simpa only [getCodeFuel, Code.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + · intro scrutinee peelNat alternatives hchildren fuel hfuel + cases fuel with + | zero => omega + | succ fuel => + let admissible : Alt → Prop := fun alternative => + alternative ∈ alternatives.toList ∧ + match alternative with + | .mk _ _ body => body.bytes.size < fuel + have hadmissible : ∀ alternative ∈ alternatives.toList, + admissible alternative := by + intro alternative hmember + cases alternative with + | mk cidx fields body => + refine ⟨hmember, ?_⟩ + have hbody := Alt.body_size_lt_bytes cidx fields body + have halternative := AltList.member_size_le hmember + simp only [Code.bytes, ByteArray.size_append, + Decode.tag_size] at hfuel + omega + have hone : ∀ alternative, admissible alternative → + GetSpec (getAlt (getCodeFuel fuel)) + alternative.bytes alternative := by + intro alternative halternative + rcases halternative with ⟨hmember, hbodyFuel⟩ + cases alternative with + | mk cidx fields body => + have hspec := Decode.getSpecMap3 + (Decode.getNat_spec cidx) (Decode.getNat_spec fields) + (hchildren cidx fields body hmember fuel hbodyFuel) Alt.mk + simpa [getAlt, Alt.bytes] using hspec + have harray := Decode.getArray_spec_of + (getAlt (getCodeFuel fuel)) Alt.bytes admissible hone + alternatives hadmissible + rw [Decode.array_eq_counted, + ← AltList.bytes_eq_listBytes alternatives.toList] at harray + have hpayload := Decode.getSpecMap3 + (IxIR1.getAtom_spec scrutinee) + (Decode.getBool_spec peelNat) harray Code.case + have htotal := GetSpec.bind + (next := getCodeTag (getCodeFuel fuel)) + (Decode.getU8_tag_spec 2) hpayload + simpa only [getCodeFuel, Code.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + · exact hfuel + +theorem getCode_spec (code : Code) : + GetSpec getCode code.bytes code := by + intro pre suffix + let fuel := (pre ++ code.bytes ++ suffix).size + 1 + have hfuel : code.bytes.size < fuel := by + dsimp [fuel] + simp only [ByteArray.size_append] + omega + have hspec := getCodeFuel_spec code fuel hfuel pre suffix + simpa [getCode, fuel] using hspec + +theorem getFnDef_spec (definition : FnDef) : + GetSpec getFnDef definition.bytes definition := by + have hspec := Decode.getSpecMap4 (Decode.getNat_spec definition.arity) + (IxIR0.getOwned_spec definition.result) + (Decode.getBool_spec definition.papSafe) (getCode_spec definition.body) + FnDef.mk + simpa [getFnDef, FnDef.bytes] using hspec + +theorem getDecl_spec : ∀ declaration : Decl, + GetSpec getDecl declaration.bytes declaration + | .fn definition => by + have hpayload := Decode.getSpecMap (getFnDef_spec definition) Decl.fn + have htotal := GetSpec.bind (next := getDeclTag) + (Decode.getU8_tag_spec 0) hpayload + simpa only [getDecl, Decl.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + | .extern arity => by + have hpayload := Decode.getSpecMap (Decode.getNat_spec arity) Decl.extern + have htotal := GetSpec.bind (next := getDeclTag) + (Decode.getU8_tag_spec 1) hpayload + simpa only [getDecl, Decl.bytes, ByteArray.append_assoc, + ByteArray.append_empty] using htotal + +theorem getBlockPreimage_spec (members : List Decl) : + GetSpec getBlockPreimage (Block.preimage members) members := by + let next : Unit → GetM (List Decl) := fun _ => Decode.getList getDecl + have htotal := GetSpec.bind (next := next) + (Decode.expectBytes_spec Block.addressDomain) + (Decode.getList_spec getDecl Decl.bytes getDecl_spec members) + simpa [getBlockPreimage, Block.preimage, next] using htotal + +/-! ### Strict top-level codec laws -/ + +theorem Block.decodePreimage_roundtrip (members : List Decl) : + Block.decodePreimage (Block.preimage members) = .ok members := by + exact Decode.runCanonical_of_spec getBlockPreimage Block.preimage members + (getBlockPreimage_spec members) + +theorem Block.decodePreimage_canonical {bytes : ByteArray} + {members : List Decl} + (hdecode : Block.decodePreimage bytes = .ok members) : + Block.preimage members = bytes := by + exact Decode.runCanonical_canonical getBlockPreimage Block.preimage hdecode + +theorem Block.preimage_injective : Function.Injective Block.preimage := by + intro left right hbytes + have hok : (Except.ok left : Except String (List Decl)) = .ok right := by + calc + .ok left = Block.decodePreimage (Block.preimage left) := + (Block.decodePreimage_roundtrip left).symm + _ = Block.decodePreimage (Block.preimage right) := + congrArg Block.decodePreimage hbytes + _ = .ok right := Block.decodePreimage_roundtrip right + exact Except.ok.inj hok + +/-! ## Collision-checked construction and ingress materialization -/ + +namespace DeclList + +def structurallyEq : List Decl → List Decl → Bool + | [], [] => true + | left :: leftRest, right :: rightRest => + Decl.structurallyEq left right && structurallyEq leftRest rightRest + | _, _ => false + +theorem structurallyEq_eq_true_iff (left right : List Decl) : + structurallyEq left right = true ↔ left = right := by + induction left generalizing right with + | nil => cases right <;> simp [structurallyEq] + | cons left rest ih => + cases right with + | nil => simp [structurallyEq] + | cons right rightRest => + simp [structurallyEq, Decl.structurallyEq_eq_true_iff, ih] + +end DeclList + +/-- Old block-member key to its final derived key. -/ +abbrev Renaming := Readdress.Renaming + +/-- A completely materialized cycle-safe block. -/ +structure Result where + blockAddress : Address + blockMembers : List Decl + members : List (Address × IxIR1.Decl) + addressMap : Renaming + +namespace Result + +def transientAddresses (result : Result) : List Address := + result.addressMap.map (·.1) + +def derivedAddresses (result : Result) : List Address := + result.addressMap.map (·.2) + +def memberKeysDerived (result : Result) : Bool := + let rec loop : Nat → Renaming → Bool + | _, [] => true + | index, entry :: rest => + entry.2 == Member.address result.blockAddress index && + loop (index + 1) rest + loop 0 result.addressMap && + result.members.map (·.1) == result.derivedAddresses + +def blockStable (result : Result) : Bool := + DeclList.structurallyEq + (abstractMembers result.members) result.blockMembers + +def noTransientKeys (result : Result) : Bool := + !(result.members.map (·.1)).any result.transientAddresses.contains + +def noTransientReferences (result : Result) : Bool := + let references := result.members.flatMap fun member => + Readdress.Decl.references member.2 + !references.any result.transientAddresses.contains + +/-- Executable certificate that materialization is exactly the completed +address image of the transient block and that re-abstraction recovers the +canonical symbolic artifact. -/ +def semanticAudit (result : Result) + (raw : List (Address × IxIR1.Decl)) : Bool := + let rename := Readdress.Renaming.apply result.addressMap + let original := IxIR1.Env.ofList raw + let emitted := IxIR1.Env.ofList result.members + DeclList.structurallyEq result.blockMembers (abstractMembers raw) && + result.blockAddress == Block.address result.blockMembers && + result.memberKeysDerived && result.blockStable && + result.noTransientKeys && result.noTransientReferences && + raw.all (fun entry => + match original entry.1, emitted (rename entry.1) with + | some before, some after => + Readdress.Decl.structurallyEq after + (Readdress.Decl.mapAddresses rename before) + | _, _ => false) && + result.members.all (fun entry => + match emitted entry.1 with + | some declaration => + Readdress.Decl.structurallyEq + (Readdress.Decl.mapAddresses rename declaration) declaration + | none => false) + +end Result + +abbrev CertifiedResult (raw : List (Address × IxIR1.Decl)) := + { result : Result // result.semanticAudit raw = true } + +private def firstDuplicate? : List Address → Option Address + | [] => none + | address :: rest => + if rest.contains address then some address else firstDuplicate? rest + +private def firstOverlap? (left right : List Address) : Option Address := + left.find? right.contains + +private def deriveMap (block : Address) : + Nat → List (Address × IxIR1.Decl) → Renaming + | _, [] => [] + | index, member :: rest => + (member.1, Member.address block index) :: + deriveMap block (index + 1) rest + +/-- Materialized stored block, independent of transient producer names. -/ +structure Artifact where + blockAddress : Address + blockMembers : List Decl + members : List (Address × IxIR1.Decl) + +namespace Artifact + +def memberKeysDerived (artifact : Artifact) : Bool := + let rec loop : Nat → List (Address × IxIR1.Decl) → Bool + | _, [] => true + | index, member :: rest => + member.1 == Member.address artifact.blockAddress index && + loop (index + 1) rest + loop 0 artifact.members + +def stable (artifact : Artifact) : Bool := + DeclList.structurallyEq + (abstractMembers artifact.members) artifact.blockMembers + +def audit (artifact : Artifact) : Bool := + artifact.blockAddress == Block.address artifact.blockMembers && + artifact.members.length == artifact.blockMembers.length && + artifact.blockMembers.all + (Decl.wellScoped artifact.blockMembers.length) && + artifact.memberKeysDerived && artifact.stable + +end Artifact + +private def deriveKeys (block : Address) : Nat → Nat → List Address + | _, 0 => [] + | index, count + 1 => + Member.address block index :: deriveKeys block (index + 1) count + +/-- Validate and materialize a decoded symbolic block. -/ +def Block.materializeArtifact (reserved : List Address) + (blockMembers : List Decl) : Except String Artifact := do + if blockMembers.isEmpty then + throw "IxIR1 mutual block must contain at least one member" + unless blockMembers.all (Decl.wellScoped blockMembers.length) do + throw "IxIR1 mutual block contains an out-of-range local reference" + let blockAddress := Block.address blockMembers + if reserved.contains blockAddress then + throw s!"IxIR1 mutual-block identity collides with reserved identity {Address.toHex blockAddress}" + let external := blockMembers.flatMap Decl.externalReferences + if external.contains blockAddress then + throw s!"IxIR1 mutual-block identity collides with an external reference {Address.toHex blockAddress}" + let derived := deriveKeys blockAddress 0 blockMembers.length + if let some duplicate := firstDuplicate? derived then + throw s!"BLAKE3 collision between IxIR1 mutual-block member keys {Address.toHex duplicate}" + if derived.contains blockAddress then + throw s!"IxIR1 mutual-block member key collides with its block identity {Address.toHex blockAddress}" + if let some overlap := firstOverlap? derived reserved then + throw s!"IxIR1 mutual-block member key collides with reserved identity {Address.toHex overlap}" + if let some overlap := firstOverlap? derived external then + throw s!"IxIR1 mutual-block member key captures an external reference {Address.toHex overlap}" + let declarations ← blockMembers.mapM + (Decl.materialize derived.toArray) + let artifact : Artifact := + { blockAddress, blockMembers, members := derived.zip declarations } + unless artifact.audit do + throw "internal: decoded IxIR1 mutual block failed materialization audit" + return artifact + +def Block.decodeMaterialized (reserved : List Address) + (bytes : ByteArray) : Except String Artifact := do + Block.materializeArtifact reserved (← Block.decodeArtifact bytes) + +private def certify (raw : List (Address × IxIR1.Decl)) + (result : Result) : Except String (CertifiedResult raw) := + if haudit : result.semanticAudit raw then .ok ⟨result, haudit⟩ + else .error "internal: IxIR1 mutual-block materialization failed semantic audit" + +/-- Construct and certify one ordered cycle-safe block while protecting every +caller-owned external identity. -/ +def runCertified (reserved : List Address) + (raw : List (Address × IxIR1.Decl)) : + Except String (CertifiedResult raw) := do + if raw.isEmpty then + throw "IxIR1 mutual block must contain at least one member" + let transient := raw.map (·.1) + if let some duplicate := firstDuplicate? transient then + throw s!"duplicate IxIR1 mutual-block temporary address {Address.toHex duplicate}" + if let some overlap := firstOverlap? transient reserved then + throw s!"IxIR1 mutual-block temporary address overlaps reserved identity {Address.toHex overlap}" + let blockMembers := abstractMembers raw + unless blockMembers.all (Decl.wellScoped blockMembers.length) do + throw "internal: abstracted IxIR1 mutual block contains an out-of-range local reference" + let blockAddress := Block.address blockMembers + if transient.contains blockAddress then + throw s!"IxIR1 mutual-block identity overlaps temporary namespace {Address.toHex blockAddress}" + if reserved.contains blockAddress then + throw s!"IxIR1 mutual-block identity collides with reserved identity {Address.toHex blockAddress}" + let external := blockMembers.flatMap Decl.externalReferences + if external.contains blockAddress then + throw s!"IxIR1 mutual-block identity collides with an external reference {Address.toHex blockAddress}" + let addressMap := deriveMap blockAddress 0 raw + let derived := addressMap.map (·.2) + if let some duplicate := firstDuplicate? derived then + throw s!"BLAKE3 collision between IxIR1 mutual-block member keys {Address.toHex duplicate}" + if derived.contains blockAddress then + throw s!"IxIR1 mutual-block member key collides with its block identity {Address.toHex blockAddress}" + if let some overlap := firstOverlap? derived transient then + throw s!"IxIR1 mutual-block member key overlaps temporary namespace {Address.toHex overlap}" + if let some overlap := firstOverlap? derived reserved then + throw s!"IxIR1 mutual-block member key collides with reserved identity {Address.toHex overlap}" + if let some overlap := firstOverlap? derived external then + throw s!"IxIR1 mutual-block member key captures an external reference {Address.toHex overlap}" + let memberKeys := derived.toArray + let materialized ← blockMembers.mapM (Decl.materialize memberKeys) + let result : Result := + { blockAddress + blockMembers + members := derived.zip materialized + addressMap } + certify raw result + +def run (reserved : List Address) + (raw : List (Address × IxIR1.Decl)) : Except String Result := do + return (← runCertified reserved raw).1 + +theorem semanticAudit_of_run_eq_ok + {reserved : List Address} {raw : List (Address × IxIR1.Decl)} + {result : Result} (hrun : run reserved raw = .ok result) : + result.semanticAudit raw = true := by + unfold run at hrun + cases hcertified : runCertified reserved raw with + | error message => + rw [hcertified] at hrun + contradiction + | ok certified => + rw [hcertified] at hrun + have hvalue : certified.1 = result := by injection hrun + subst result + exact certified.2 + +/-! Pure structural format guards. Digest fixtures live in `Tests.lean`. -/ + +private def fixtureA : Address := Address.replicate 0xfa +private def fixtureB : Address := Address.replicate 0xfb +private def fixtureExternal : Address := Address.replicate 0xee + +#guard Ref.bytes (.local 128) == ByteArray.mk #[0, 128, 1] +#guard (Ref.bytes (.external fixtureExternal)).size == 33 +#guard Op.bytes (.call (.local 1) #[]) == ByteArray.mk #[8, 0, 1, 0] +#guard Decl.bytes (.fn ⟨0, .shared, true, + .letOp (.call (.local 1) #[]) (.ret .erased)⟩) == + ByteArray.mk #[0, 0, 1, 1, 1, 8, 0, 1, 0, 0, 2] +#guard + DeclList.structurallyEq + (abstractMembers + [(fixtureA, .fn ⟨0, .shared, true, + .letOp (.call fixtureB #[]) (.ret .erased)⟩), + (fixtureB, .fn ⟨0, .shared, true, + .letOp (.papp fixtureA #[]) (.ret .erased)⟩)]) + [.fn ⟨0, .shared, true, + .letOp (.call (.local 1) #[]) (.ret .erased)⟩, + .fn ⟨0, .shared, true, + .letOp (.papp (.local 0) #[]) (.ret .erased)⟩] + +end MutualBlock + +end Ix.Compiler.IxIR1 diff --git a/Ix/Compiler/IxIR1/NoReuse.lean b/Ix/Compiler/IxIR1/NoReuse.lean new file mode 100644 index 000000000..6067e4096 --- /dev/null +++ b/Ix/Compiler/IxIR1/NoReuse.lean @@ -0,0 +1,4076 @@ +import Ix.Compiler.IxIR1.Reclamation +import Ix.Compiler.IxIR1.LowerStateSim + +/-! +# Syntactic and dynamic absence of IxIR₁ reuse + +`Reclamation.AllocationOrderInvariant` is a semantic trace invariant. This +module supplies its compiler-facing premise: the current IxIR₀→IxIR₁ +lowerer never emits `Op.reuse`, and execution of a closed reuse-free program +therefore leaves the fresh store's reuse counter at zero. +-/ + +namespace Ix.Compiler.IxIR1.NoReuse + +open Ix.Compiler.IxIR1 +open Ix.Compiler.IxIR1.Lower + +private theorem bindOk {error α β : Type} (value : α) + (next : α → Except error β) : + (Except.ok value >>= next) = next value := rfl + +private theorem bindErr {error α β : Type} (err : error) + (next : α → Except error β) : + ((Except.error err : Except error α) >>= next) = .error err := rfl + +/-- The one instruction excluded by the current append-only lowerer. -/ +def OpNoReuse : Op → Prop + | .reuse .. => False + | _ => True + +mutual + +/-- Every operation and every recursively nested alternative is reuse-free. -/ +def CodeNoReuse : Code → Prop + | .ret _ => True + | .letOp op rest => OpNoReuse op ∧ CodeNoReuse rest + | .case _ _ alternatives => + ∀ alternative ∈ alternatives, AltNoReuse alternative + +def AltNoReuse : Alt → Prop + | .mk _ _ body => CodeNoReuse body + +end + +/-- Every callable function body in the runtime environment is reuse-free. -/ +def CtxNoReuse (ctx : Ctx) : Prop := + ∀ {address definition}, + ctx.decls address = some (.fn definition) → CodeNoReuse definition.body + +/-! ## Executable reflection + +The compiler proves reuse-freedom before content addressing, but the final +artifact may content-deduplicate declarations. These small structural checks +let downstream attachment boundaries validate the exact emitted syntax and +reflect the result back into the propositions consumed by simulation. -/ + +/-- Executable counterpart of `OpNoReuse`. -/ +def checkOp : Op → Bool + | .reuse .. => false + | _ => true + +mutual + +/-- Executable counterpart of `CodeNoReuse`. -/ +def checkCode : Code → Bool + | .ret _ => true + | .letOp operation rest => checkOp operation && checkCode rest + | .case _ _ alternatives => checkAlternatives alternatives.toList + +/-- Executable counterpart of `AltNoReuse`. -/ +def checkAlt : Alt → Bool + | .mk _ _ body => checkCode body + +/-- Structural list walk used beneath case-alternative arrays. -/ +def checkAlternatives : List Alt → Bool + | [] => true + | head :: tail => checkAlt head && checkAlternatives tail + +end + +theorem checkOp_eq_true_iff (operation : Op) : + checkOp operation = true ↔ OpNoReuse operation := by + cases operation <;> simp [checkOp, OpNoReuse] + +/-- The executable recursive syntax walk decides exactly `CodeNoReuse`. -/ +theorem checkCode_eq_true_iff (code : Code) : + checkCode code = true ↔ CodeNoReuse code := by + apply Code.rec + (motive_1 := fun operation => + checkOp operation = true ↔ OpNoReuse operation) + (motive_2 := fun alternative => + checkAlt alternative = true ↔ AltNoReuse alternative) + (motive_3 := fun code => + checkCode code = true ↔ CodeNoReuse code) + (motive_4 := fun alternatives => + checkAlternatives alternatives.toList = true ↔ + ∀ alternative ∈ alternatives, AltNoReuse alternative) + (motive_5 := fun alternatives => + checkAlternatives alternatives = true ↔ + ∀ alternative ∈ alternatives, AltNoReuse alternative) + (pure := by intros; simp [checkOp, OpNoReuse]) + (alloc := by intros; simp [checkOp, OpNoReuse]) + (reuse := by intros; simp [checkOp, OpNoReuse]) + (free := by intros; simp [checkOp, OpNoReuse]) + (dup := by intros; simp [checkOp, OpNoReuse]) + (drop := by intros; simp [checkOp, OpNoReuse]) + (dropU := by intros; simp [checkOp, OpNoReuse]) + (fetch := by intros; simp [checkOp, OpNoReuse]) + (call := by intros; simp [checkOp, OpNoReuse]) + (callSelf := by intros; simp [checkOp, OpNoReuse]) + (papp := by intros; simp [checkOp, OpNoReuse]) + (apply := by intros; simp [checkOp, OpNoReuse]) + (extern := by intros; simp [checkOp, OpNoReuse]) + (mk := by + intro cidx fields body hbody + simpa [checkAlt, AltNoReuse] using hbody) + (ret := by intros; simp [checkCode, CodeNoReuse]) + (letOp := by + intro operation rest hoperation hrest + simp [checkCode, CodeNoReuse, hoperation, hrest]) + (case := by + intro scrutinee peelNat alternatives halternatives + simpa [checkCode, CodeNoReuse] using halternatives) + (by + intro alternatives halternatives + simpa using halternatives) + (by simp [checkAlternatives]) + (by + intro head tail hhead htail + simp [checkAlternatives, hhead, htail]) + code + +/-- A difference-list emitter preserves reuse-free continuations. -/ +def EmitNoReuse (emit : Emit) : Prop := + ∀ code, CodeNoReuse code → CodeNoReuse (emit code) + +theorem emitNoReuse_id : EmitNoReuse (_root_.id : Emit) := by + intro code hcode + exact hcode + +theorem emitNoReuse_emitOp {op : Op} (hop : OpNoReuse op) : + EmitNoReuse (emitOp op) := by + intro code hcode + simpa [emitOp, CodeNoReuse] using And.intro hop hcode + +theorem emitNoReuse_comp {first second : Emit} + (hfirst : EmitNoReuse first) (hsecond : EmitNoReuse second) : + EmitNoReuse (first ∘ second) := by + intro code hcode + exact hfirst (second code) (hsecond code hcode) + +/-- Retaining pap captures changes only RC state. -/ +theorem dupVals_reuses {store store' : Store} {values : List RVal} + (heval : dupVals store values = .ok store') : + store'.reuses = store.reuses := by + induction values generalizing store with + | nil => + change (.ok store : Except Err Store) = .ok store' at heval + injection heval with hstore + subst store' + rfl + | cons head tail ih => + cases head with + | lit literal => + simp only [Ix.Compiler.IxIR1.dupVals, List.foldlM_cons] at heval + exact ih heval + | erased => + simp only [Ix.Compiler.IxIR1.dupVals, List.foldlM_cons] at heval + exact ih heval + | loc location => + simp only [Ix.Compiler.IxIR1.dupVals, List.foldlM_cons] at heval + cases hget : store.get? location with + | none => simp [hget, bindErr] at heval + | some box => + cases box with + | mk world rc node => + cases world with + | unique => simp [hget, bindErr] at heval + | shared => + simp only [hget] at heval + have htail := ih heval + simpa [Sim.incRcStore, Store.setBox, Store.rcTick] using htail + +private def DropReusesAt (fuel : Nat) : Prop := + (∀ ctx store value store', + dropVal ctx fuel store value = .ok store' → + store'.reuses = store.reuses) ∧ + (∀ ctx store values store', + dropMany ctx fuel store values = .ok store' → + store'.reuses = store.reuses) ∧ + (∀ ctx store value store', + dropUVal ctx fuel store value = .ok store' → + store'.reuses = store.reuses) ∧ + (∀ ctx store values store', + dropManyU ctx fuel store values = .ok store' → + store'.reuses = store.reuses) + +private theorem dropReusesAt : ∀ fuel, DropReusesAt fuel := by + intro fuel + induction fuel with + | zero => + refine ⟨?_, ?_, ?_, ?_⟩ + · intro ctx store value store' heval + rw [dropVal.eq_def] at heval + simp at heval + · intro ctx store values store' heval + rw [dropMany.eq_def] at heval + simp at heval + · intro ctx store value store' heval + rw [dropUVal.eq_def] at heval + simp at heval + · intro ctx store values store' heval + rw [dropManyU.eq_def] at heval + simp at heval + | succ fuel ih => + obtain ⟨ihVal, ihMany, ihUVal, ihUMany⟩ := ih + refine ⟨?_, ?_, ?_, ?_⟩ + · intro ctx store value store' heval + cases value with + | lit literal => + rw [dropVal.eq_def] at heval + dsimp only at heval + injection heval with hstore + subst store' + rfl + | erased => + rw [dropVal.eq_def] at heval + dsimp only at heval + injection heval with hstore + subst store' + rfl + | loc location => + rw [dropVal.eq_def] at heval + dsimp only at heval + cases hget : store.get? location with + | none => simp [hget] at heval + | some box => + rw [hget] at heval + cases box with + | mk world rc node => + cases world with + | unique => simp at heval + | shared => + dsimp only at heval + by_cases hrc : rc = 1 + · subst rc + have hbeq : ((1 : Nat) == 1) = true := by decide + rw [hbeq] at heval + cases node with + | ctorN cid fields => + have htail := ihMany _ _ _ _ heval + simpa [Store.rcTick, Store.kill] using htail + | papN address arity args => + have htail := ihMany _ _ _ _ heval + simpa [Store.rcTick, Store.kill] using htail + · have hbeq : (rc == 1) = false := by simp [hrc] + rw [hbeq] at heval + injection heval with hstore + subst store' + simp [Store.rcTick, Store.setBox] + · intro ctx store values store' heval + cases values with + | nil => + rw [dropMany.eq_def] at heval + dsimp only at heval + injection heval with hstore + subst store' + rfl + | cons value values => + rw [dropMany.eq_def] at heval + dsimp only at heval + cases hfirst : dropVal ctx fuel store value with + | error err => rw [hfirst, bindErr] at heval; contradiction + | ok middle => + rw [hfirst, bindOk] at heval + exact (ihMany _ _ _ _ heval).trans (ihVal _ _ _ _ hfirst) + · intro ctx store value store' heval + cases value with + | lit literal => + rw [dropUVal.eq_def] at heval + dsimp only at heval + injection heval with hstore + subst store' + rfl + | erased => + rw [dropUVal.eq_def] at heval + dsimp only at heval + injection heval with hstore + subst store' + rfl + | loc location => + rw [dropUVal.eq_def] at heval + dsimp only at heval + cases hget : store.get? location with + | none => simp [hget] at heval + | some box => + rw [hget] at heval + cases box with + | mk world rc node => + cases world with + | shared => simp at heval + | unique => + cases node with + | ctorN cid fields => + have htail := ihUMany _ _ _ _ heval + simpa [Store.kill] using htail + | papN address arity args => simp at heval + · intro ctx store values store' heval + cases values with + | nil => + rw [dropManyU.eq_def] at heval + dsimp only at heval + injection heval with hstore + subst store' + rfl + | cons value values => + rw [dropManyU.eq_def] at heval + dsimp only at heval + cases hfirst : dropUVal ctx fuel store value with + | error err => rw [hfirst, bindErr] at heval; contradiction + | ok middle => + rw [hfirst, bindOk] at heval + exact (ihUMany _ _ _ _ heval).trans (ihUVal _ _ _ _ hfirst) + +theorem dropVal_reuses {ctx : Ctx} {fuel : Nat} {store store' : Store} + {value : RVal} (heval : dropVal ctx fuel store value = .ok store') : + store'.reuses = store.reuses := + (dropReusesAt fuel).1 ctx store value store' heval + +theorem dropMany_reuses {ctx : Ctx} {fuel : Nat} {store store' : Store} + {values : List RVal} + (heval : dropMany ctx fuel store values = .ok store') : + store'.reuses = store.reuses := + (dropReusesAt fuel).2.1 ctx store values store' heval + +theorem dropUVal_reuses {ctx : Ctx} {fuel : Nat} {store store' : Store} + {value : RVal} (heval : dropUVal ctx fuel store value = .ok store') : + store'.reuses = store.reuses := + (dropReusesAt fuel).2.2.1 ctx store value store' heval + +theorem dropManyU_reuses {ctx : Ctx} {fuel : Nat} {store store' : Store} + {values : List RVal} + (heval : dropManyU ctx fuel store values = .ok store') : + store'.reuses = store.reuses := + (dropReusesAt fuel).2.2.2 ctx store values store' heval + +private def EvalReusesAt (fuel : Nat) : Prop := + (∀ ctx cur store env code store' value, + CtxNoReuse ctx → CodeNoReuse cur.body → CodeNoReuse code → + runCode ctx fuel cur store env code = .ok (store', value) → + store'.reuses = store.reuses) ∧ + (∀ ctx cur store env op store' value, + CtxNoReuse ctx → CodeNoReuse cur.body → OpNoReuse op → + runOp ctx fuel cur store env op = .ok (store', value) → + store'.reuses = store.reuses) ∧ + (∀ ctx address args store store' value, + CtxNoReuse ctx → + invoke ctx fuel address args store = .ok (store', value) → + store'.reuses = store.reuses) ∧ + (∀ ctx store function args store' value, + CtxNoReuse ctx → + applyGo ctx fuel store function args = .ok (store', value) → + store'.reuses = store.reuses) + +/-- Successful execution of reuse-free code in a reuse-free declaration +environment preserves the reuse counter exactly. -/ +private theorem evalReusesAt : ∀ fuel, EvalReusesAt fuel := by + intro fuel + induction fuel with + | zero => + refine ⟨?_, ?_, ?_, ?_⟩ + · intro ctx cur store env code store' value hctx hcur hcode heval + rw [runCode.eq_def] at heval + simp at heval + · intro ctx cur store env op store' value hctx hcur hop heval + rw [runOp.eq_def] at heval + simp at heval + · intro ctx address args store store' value hctx heval + rw [invoke.eq_def] at heval + simp at heval + · intro ctx store function args store' value hctx heval + rw [applyGo.eq_def] at heval + simp at heval + | succ fuel ih => + obtain ⟨ihCode, ihOp, ihInvoke, ihApply⟩ := ih + refine ⟨?_, ?_, ?_, ?_⟩ + · intro ctx cur store env code store' value hctx hcur hcode heval + cases code with + | ret atom => + rw [runCode.eq_def] at heval + dsimp only at heval + cases hresolve : resolveAtom env atom with + | error err => rw [hresolve, bindErr] at heval; contradiction + | ok result => + rw [hresolve, bindOk] at heval + have hpair := Except.ok.inj heval + cases hpair + rfl + | letOp op rest => + simp only [CodeNoReuse] at hcode + rw [runCode.eq_def] at heval + dsimp only at heval + cases hopEval : runOp ctx fuel cur store env op with + | error err => rw [hopEval, bindErr] at heval; contradiction + | ok result => + rcases result with ⟨middle, opValue⟩ + rw [hopEval, bindOk] at heval + exact (ihCode _ _ _ _ _ _ _ hctx hcur hcode.2 heval).trans + (ihOp _ _ _ _ _ _ _ hctx hcur hcode.1 hopEval) + | case scrut peelNat alternatives => + simp only [CodeNoReuse] at hcode + rw [runCode.eq_def] at heval + dsimp only at heval + cases hscrut : resolveAtom env scrut with + | error err => rw [hscrut, bindErr] at heval; contradiction + | ok scrutValue => + rw [hscrut, bindOk] at heval + cases scrutValue with + | loc location => + dsimp only at heval + cases hbox : store.get? location with + | none => simp [hbox] at heval + | some box => + simp only [hbox] at heval + cases box with + | mk world rc node => + cases node with + | papN address arity captured => simp at heval + | ctorN cid fields => + cases halt : alternatives.find? + (fun alternative => alternative.cidx == cid.cidx) with + | none => simp [halt] at heval + | some alternative => + have haltNo := hcode alternative + (Array.mem_of_find?_eq_some halt) + cases alternative with + | mk cidx fieldCount body => + simp only [AltNoReuse] at haltNo + cases hsize : fields.size != fieldCount + · simp only [halt, hsize, Bool.false_eq_true, + if_false] at heval + exact ihCode _ _ _ _ _ _ _ hctx hcur haltNo heval + · simp [halt, hsize] at heval + | lit literal => + cases literal with + | str string => simp at heval + | nat n => + cases hpeel : peelNat with + | false => simp [hpeel] at heval + | true => + cases n with + | zero => + cases halt : alternatives.find? + (fun alternative => alternative.cidx == 0) with + | none => simp [hpeel, halt] at heval + | some alternative => + have haltNo := hcode alternative + (Array.mem_of_find?_eq_some halt) + cases alternative with + | mk cidx fieldCount body => + simp only [AltNoReuse] at haltNo + cases fieldCount with + | zero => + simp only [hpeel, halt] at heval + exact ihCode _ _ _ _ _ _ _ hctx hcur haltNo heval + | succ fieldCount => simp [hpeel, halt] at heval + | succ n => + cases halt : alternatives.find? + (fun alternative => alternative.cidx == 1) with + | none => simp [hpeel, halt] at heval + | some alternative => + have haltNo := hcode alternative + (Array.mem_of_find?_eq_some halt) + cases alternative with + | mk cidx fieldCount body => + simp only [AltNoReuse] at haltNo + cases fieldCount with + | zero => simp [hpeel, halt] at heval + | succ fieldCount => + cases fieldCount with + | zero => + simp only [hpeel, halt] at heval + exact ihCode _ _ _ _ _ _ _ hctx hcur haltNo heval + | succ fieldCount => simp [hpeel, halt] at heval + | erased => simp at heval + · intro ctx cur store env op store' value hctx hcur hop heval + cases op with + | pure atom => + rw [runOp.eq_def] at heval + dsimp only at heval + cases hresolve : resolveAtom env atom with + | error err => rw [hresolve, bindErr] at heval; contradiction + | ok result => + rw [hresolve, bindOk] at heval + have hpair := Except.ok.inj heval + cases hpair + rfl + | alloc world cid atoms => + rw [runOp.eq_def] at heval + dsimp only at heval + cases hargs : resolveAtoms env atoms with + | error err => rw [hargs, bindErr] at heval; contradiction + | ok values => + rw [hargs, bindOk] at heval + have hpair := Except.ok.inj heval + cases hpair + simp [Store.allocNode] + | reuse target cid atoms => + simp [OpNoReuse] at hop + | free target => + rw [runOp.eq_def] at heval + dsimp only at heval + cases htarget : resolveAtom env target with + | error err => rw [htarget, bindErr] at heval; contradiction + | ok targetValue => + rw [htarget, bindOk] at heval + cases targetValue with + | lit literal => simp at heval + | erased => simp at heval + | loc location => + cases hbox : store.get? location with + | none => simp [hbox] at heval + | some box => + simp only [hbox] at heval + cases box with + | mk world rc node => + cases world with + | shared => simp at heval + | unique => + have hpair := Except.ok.inj heval + cases hpair + simp [Store.kill] + | dup target => + rw [runOp.eq_def] at heval + dsimp only at heval + cases htarget : resolveAtom env target with + | error err => rw [htarget, bindErr] at heval; contradiction + | ok targetValue => + rw [htarget, bindOk] at heval + cases targetValue with + | lit literal => + have hpair := Except.ok.inj heval + cases hpair + rfl + | erased => + have hpair := Except.ok.inj heval + cases hpair + rfl + | loc location => + cases hbox : store.get? location with + | none => simp [hbox] at heval + | some box => + simp only [hbox] at heval + cases box with + | mk world rc node => + cases world with + | unique => simp at heval + | shared => + have hpair := Except.ok.inj heval + cases hpair + simp [Store.setBox, Store.rcTick] + | drop target => + rw [runOp.eq_def] at heval + dsimp only at heval + cases htarget : resolveAtom env target with + | error err => rw [htarget, bindErr] at heval; contradiction + | ok targetValue => + rw [htarget, bindOk] at heval + cases targetValue with + | lit literal => + have hpair := Except.ok.inj heval + cases hpair + rfl + | erased => + have hpair := Except.ok.inj heval + cases hpair + rfl + | loc location => + dsimp only at heval + cases hdrop : dropVal ctx fuel store (.loc location) with + | error err => rw [hdrop, bindErr] at heval; contradiction + | ok dropped => + rw [hdrop, bindOk] at heval + have hpair := Except.ok.inj heval + cases hpair + exact dropVal_reuses hdrop + | dropU target => + rw [runOp.eq_def] at heval + dsimp only at heval + cases htarget : resolveAtom env target with + | error err => rw [htarget, bindErr] at heval; contradiction + | ok targetValue => + rw [htarget, bindOk] at heval + cases targetValue with + | lit literal => + have hpair := Except.ok.inj heval + cases hpair + rfl + | erased => + have hpair := Except.ok.inj heval + cases hpair + rfl + | loc location => + dsimp only at heval + cases hdrop : dropUVal ctx fuel store (.loc location) with + | error err => rw [hdrop, bindErr] at heval; contradiction + | ok dropped => + rw [hdrop, bindOk] at heval + have hpair := Except.ok.inj heval + cases hpair + exact dropUVal_reuses hdrop + | fetch target field => + rw [runOp.eq_def] at heval + dsimp only at heval + cases htarget : resolveAtom env target with + | error err => rw [htarget, bindErr] at heval; contradiction + | ok targetValue => + rw [htarget, bindOk] at heval + cases targetValue with + | lit literal => simp at heval + | erased => simp at heval + | loc location => + cases hbox : store.get? location with + | none => simp [hbox] at heval + | some box => + simp only [hbox] at heval + cases box with + | mk world rc node => + cases node with + | papN address arity captured => simp at heval + | ctorN cid fields => + cases hfield : fields[field]? with + | none => simp [hfield] at heval + | some result => + simp only [hfield] at heval + have hpair := Except.ok.inj heval + cases hpair + rfl + | call address atoms => + rw [runOp.eq_def] at heval + dsimp only at heval + cases hargs : resolveAtoms env atoms with + | error err => rw [hargs, bindErr] at heval; contradiction + | ok values => + rw [hargs, bindOk] at heval + exact ihInvoke _ _ _ _ _ _ hctx heval + | callSelf atoms => + rw [runOp.eq_def] at heval + dsimp only at heval + cases hargs : resolveAtoms env atoms with + | error err => rw [hargs, bindErr] at heval; contradiction + | ok values => + rw [hargs, bindOk] at heval + cases harity : values.length != cur.arity + · simp only [harity, Bool.false_eq_true, if_false] at heval + cases hbody : runCode ctx fuel cur store values.reverse + cur.body with + | error err => rw [hbody, bindErr] at heval; contradiction + | ok result => + rcases result with ⟨bodyStore, bodyValue⟩ + rw [hbody, bindOk] at heval + obtain ⟨hresult, _⟩ := Sim.checkResultWorld_ok heval + cases hresult + exact ihCode _ _ _ _ _ _ _ hctx hcur hcur hbody + · simp [harity] at heval + | papp address atoms => + rw [runOp.eq_def] at heval + dsimp only at heval + cases hargs : resolveAtoms env atoms with + | error err => rw [hargs, bindErr] at heval; contradiction + | ok values => + rw [hargs, bindOk] at heval + cases hdecl : ctx.decls address with + | none => simp [hdecl] at heval + | some declaration => + simp only [hdecl] at heval + by_cases hlength : values.length < declArity declaration + · simp only [hlength, if_true] at heval + have hpair := Except.ok.inj heval + cases hpair + simp [Store.allocNode] + · simp [hlength] at heval + | apply function atoms => + rw [runOp.eq_def] at heval + dsimp only at heval + cases hfunction : resolveAtom env function with + | error err => rw [hfunction, bindErr] at heval; contradiction + | ok functionValue => + rw [hfunction, bindOk] at heval + cases hargs : resolveAtoms env atoms with + | error err => rw [hargs, bindErr] at heval; contradiction + | ok values => + rw [hargs, bindOk] at heval + exact ihApply _ _ _ _ _ _ hctx heval + | extern address atoms => + rw [runOp.eq_def] at heval + dsimp only at heval + cases hargs : resolveAtoms env atoms with + | error err => rw [hargs, bindErr] at heval; contradiction + | ok values => + rw [hargs, bindOk] at heval + cases hcall : callScalarOracle ctx address values with + | error err => rw [hcall, bindErr] at heval; contradiction + | ok result => + rw [hcall, bindOk] at heval + have hpair := Except.ok.inj heval + cases hpair + rfl + · intro ctx address args store store' value hctx heval + rw [invoke.eq_def] at heval + dsimp only at heval + cases hdecl : ctx.decls address with + | none => simp [hdecl] at heval + | some declaration => + simp only [hdecl] at heval + cases declaration with + | extern arity => + cases harity : args.length != arity + · simp only [harity, Bool.false_eq_true, if_false] at heval + cases hcall : callScalarOracle ctx address args with + | error err => simp [hcall] at heval + | ok result => + simp only [hcall] at heval + have hpair := Except.ok.inj heval + cases hpair + rfl + · simp [harity] at heval + | fn definition => + cases harity : args.length != definition.arity + · simp only [harity, Bool.false_eq_true, if_false] at heval + cases hbody : runCode ctx fuel definition store args.reverse + definition.body with + | error err => rw [hbody, bindErr] at heval; contradiction + | ok result => + rcases result with ⟨bodyStore, bodyValue⟩ + rw [hbody, bindOk] at heval + obtain ⟨hresult, _⟩ := Sim.checkResultWorld_ok heval + cases hresult + have hbodyNo := hctx hdecl + exact ihCode _ _ _ _ _ _ _ hctx hbodyNo hbodyNo hbody + · simp [harity] at heval + · intro ctx store function args store' value hctx heval + rw [applyGo.eq_def] at heval + dsimp only at heval + cases function with + | lit literal => simp at heval + | erased => + cases hdrop : dropMany ctx fuel store args with + | error err => rw [hdrop, bindErr] at heval; contradiction + | ok dropped => + rw [hdrop, bindOk] at heval + have hpair := Except.ok.inj heval + cases hpair + exact dropMany_reuses hdrop + | loc location => + cases hbox : store.get? location with + | none => simp [hbox] at heval + | some box => + simp only [hbox] at heval + cases box with + | mk world rc node => + cases node with + | ctorN cid fields => simp at heval + | papN address arity captured => + dsimp only at heval + cases hdup : dupVals store captured.toList with + | error err => rw [hdup, bindErr] at heval; contradiction + | ok retained => + rw [hdup, bindOk] at heval + cases hdrop : dropVal ctx fuel retained (.loc location) with + | error err => rw [hdrop, bindErr] at heval; contradiction + | ok ready => + rw [hdrop, bindOk] at heval + have hdupReuse := dupVals_reuses hdup + have hdropReuse := dropVal_reuses hdrop + by_cases hunder : + (captured.toList ++ args).length < arity + · simp only [hunder, if_true] at heval + have hpair := Except.ok.inj heval + cases hpair + simpa [Store.allocNode] using + hdropReuse.trans hdupReuse + · simp only [hunder, if_false] at heval + by_cases hexact : + (captured.toList ++ args).length = arity + · simp only [hexact, beq_self_eq_true, if_true] + at heval + cases hdecl : ctx.decls address with + | none => simp [hdecl] at heval + | some declaration => + cases hpapsafe : declPapSafe declaration with + | false => simp [hdecl, hpapsafe] at heval + | true => + simp only [hdecl, hpapsafe, if_true] at heval + exact (ihInvoke _ _ _ _ _ _ hctx heval).trans + (hdropReuse.trans hdupReuse) + · have hbeq : + ((captured.toList ++ args).length == arity) = + false := by + exact beq_eq_false_iff_ne.mpr hexact + simp only [hbeq, Bool.false_eq_true, if_false] at heval + cases hdecl : ctx.decls address with + | none => simp [hdecl] at heval + | some declaration => + cases hpapsafe : declPapSafe declaration with + | false => simp [hdecl, hpapsafe] at heval + | true => + simp only [hdecl, hpapsafe, if_true] at heval + cases hinvoke : invoke ctx fuel address + ((captured.toList ++ args).take arity) ready with + | error err => + rw [hinvoke, bindErr] at heval + contradiction + | ok called => + rcases called with ⟨calledStore, calledValue⟩ + rw [hinvoke, bindOk] at heval + exact (ihApply _ _ _ _ _ _ hctx heval).trans + ((ihInvoke _ _ _ _ _ _ hctx hinvoke).trans + (hdropReuse.trans hdupReuse)) + +private def EvalPAPsUnderAt (fuel : Nat) : Prop := + (∀ ctx cur store env code store' value, + CtxNoReuse ctx → CodeNoReuse cur.body → CodeNoReuse code → + Reclamation.PAPsUnder store → + runCode ctx fuel cur store env code = .ok (store', value) → + Reclamation.PAPsUnder store') ∧ + (∀ ctx cur store env op store' value, + CtxNoReuse ctx → CodeNoReuse cur.body → OpNoReuse op → + Reclamation.PAPsUnder store → + runOp ctx fuel cur store env op = .ok (store', value) → + Reclamation.PAPsUnder store') ∧ + (∀ ctx address args store store' value, + CtxNoReuse ctx → Reclamation.PAPsUnder store → + invoke ctx fuel address args store = .ok (store', value) → + Reclamation.PAPsUnder store') ∧ + (∀ ctx store function args store' value, + CtxNoReuse ctx → Reclamation.PAPsUnder store → + applyGo ctx fuel store function args = .ok (store', value) → + Reclamation.PAPsUnder store') + +/-- Reuse-free execution preserves the strict under-saturation of every +live PAP. The induction follows dynamic calls and application chains; its +only PAP-producing branches are guarded by the evaluator's strict length +tests. -/ +private theorem evalPAPsUnderAt : ∀ fuel, EvalPAPsUnderAt fuel := by + intro fuel + induction fuel with + | zero => + refine ⟨?_, ?_, ?_, ?_⟩ + · intro ctx cur store env code store' value hctx hcur hcode hpaps heval + rw [runCode.eq_def] at heval + simp at heval + · intro ctx cur store env op store' value hctx hcur hop hpaps heval + rw [runOp.eq_def] at heval + simp at heval + · intro ctx address args store store' value hctx hpaps heval + rw [invoke.eq_def] at heval + simp at heval + · intro ctx store function args store' value hctx hpaps heval + rw [applyGo.eq_def] at heval + simp at heval + | succ fuel ih => + obtain ⟨ihCode, ihOp, ihInvoke, ihApply⟩ := ih + refine ⟨?_, ?_, ?_, ?_⟩ + · intro ctx cur store env code store' value hctx hcur hcode hpaps heval + cases code with + | ret atom => + rw [runCode.eq_def] at heval + dsimp only at heval + cases hresolve : resolveAtom env atom with + | error err => rw [hresolve, bindErr] at heval; contradiction + | ok result => + rw [hresolve, bindOk] at heval + have hpair := Except.ok.inj heval + cases hpair + exact hpaps + | letOp op rest => + simp only [CodeNoReuse] at hcode + rw [runCode.eq_def] at heval + dsimp only at heval + cases hopEval : runOp ctx fuel cur store env op with + | error err => rw [hopEval, bindErr] at heval; contradiction + | ok result => + rcases result with ⟨middle, opValue⟩ + rw [hopEval, bindOk] at heval + exact ihCode _ _ _ _ _ _ _ hctx hcur hcode.2 + (ihOp _ _ _ _ _ _ _ hctx hcur hcode.1 hpaps hopEval) heval + | case scrut peelNat alternatives => + simp only [CodeNoReuse] at hcode + rw [runCode.eq_def] at heval + dsimp only at heval + cases hscrut : resolveAtom env scrut with + | error err => rw [hscrut, bindErr] at heval; contradiction + | ok scrutValue => + rw [hscrut, bindOk] at heval + cases scrutValue with + | loc location => + dsimp only at heval + cases hbox : store.get? location with + | none => simp [hbox] at heval + | some box => + simp only [hbox] at heval + cases box with + | mk world rc node => + cases node with + | papN address arity captured => simp at heval + | ctorN cid fields => + cases halt : alternatives.find? + (fun alternative => alternative.cidx == cid.cidx) with + | none => simp [halt] at heval + | some alternative => + have haltNo := hcode alternative + (Array.mem_of_find?_eq_some halt) + cases alternative with + | mk cidx fieldCount body => + simp only [AltNoReuse] at haltNo + cases hsize : fields.size != fieldCount + · simp only [halt, hsize, Bool.false_eq_true, + if_false] at heval + exact ihCode _ _ _ _ _ _ _ hctx hcur haltNo hpaps + heval + · simp [halt, hsize] at heval + | lit literal => + cases literal with + | str string => simp at heval + | nat n => + cases hpeel : peelNat with + | false => simp [hpeel] at heval + | true => + cases n with + | zero => + cases halt : alternatives.find? + (fun alternative => alternative.cidx == 0) with + | none => simp [hpeel, halt] at heval + | some alternative => + have haltNo := hcode alternative + (Array.mem_of_find?_eq_some halt) + cases alternative with + | mk cidx fieldCount body => + simp only [AltNoReuse] at haltNo + cases fieldCount with + | zero => + simp only [hpeel, halt] at heval + exact ihCode _ _ _ _ _ _ _ hctx hcur haltNo hpaps + heval + | succ fieldCount => simp [hpeel, halt] at heval + | succ n => + cases halt : alternatives.find? + (fun alternative => alternative.cidx == 1) with + | none => simp [hpeel, halt] at heval + | some alternative => + have haltNo := hcode alternative + (Array.mem_of_find?_eq_some halt) + cases alternative with + | mk cidx fieldCount body => + simp only [AltNoReuse] at haltNo + cases fieldCount with + | zero => simp [hpeel, halt] at heval + | succ fieldCount => + cases fieldCount with + | zero => + simp only [hpeel, halt] at heval + exact ihCode _ _ _ _ _ _ _ hctx hcur haltNo hpaps + heval + | succ fieldCount => simp [hpeel, halt] at heval + | erased => simp at heval + · intro ctx cur store env op store' value hctx hcur hop hpaps heval + cases op with + | pure atom => + rw [runOp.eq_def] at heval + dsimp only at heval + cases hresolve : resolveAtom env atom with + | error err => rw [hresolve, bindErr] at heval; contradiction + | ok result => + rw [hresolve, bindOk] at heval + have hpair := Except.ok.inj heval + cases hpair + exact hpaps + | alloc world cid atoms => + rw [runOp.eq_def] at heval + dsimp only at heval + cases hargs : resolveAtoms env atoms with + | error err => rw [hargs, bindErr] at heval; contradiction + | ok values => + rw [hargs, bindOk] at heval + have hpair := Except.ok.inj heval + cases hpair + exact hpaps.allocCtor world cid values.toArray + | reuse target cid atoms => + simp [OpNoReuse] at hop + | free target => + rw [runOp.eq_def] at heval + dsimp only at heval + cases htarget : resolveAtom env target with + | error err => rw [htarget, bindErr] at heval; contradiction + | ok targetValue => + rw [htarget, bindOk] at heval + cases targetValue with + | lit literal => simp at heval + | erased => simp at heval + | loc location => + cases hbox : store.get? location with + | none => simp [hbox] at heval + | some box => + simp only [hbox] at heval + cases box with + | mk world rc node => + cases world with + | shared => simp at heval + | unique => + have hpair := Except.ok.inj heval + cases hpair + exact hpaps.kill hbox + | dup target => + rw [runOp.eq_def] at heval + dsimp only at heval + cases htarget : resolveAtom env target with + | error err => rw [htarget, bindErr] at heval; contradiction + | ok targetValue => + rw [htarget, bindOk] at heval + cases targetValue with + | lit literal => + have hpair := Except.ok.inj heval + cases hpair + exact hpaps + | erased => + have hpair := Except.ok.inj heval + cases hpair + exact hpaps + | loc location => + cases hbox : store.get? location with + | none => simp [hbox] at heval + | some box => + simp only [hbox] at heval + cases box with + | mk world rc node => + cases world with + | unique => simp at heval + | shared => + have hpair := Except.ok.inj heval + cases hpair + simpa [Sim.incRcStore] using hpaps.incRcStore hbox + | drop target => + rw [runOp.eq_def] at heval + dsimp only at heval + cases htarget : resolveAtom env target with + | error err => rw [htarget, bindErr] at heval; contradiction + | ok targetValue => + rw [htarget, bindOk] at heval + cases targetValue with + | lit literal => + have hpair := Except.ok.inj heval + cases hpair + exact hpaps + | erased => + have hpair := Except.ok.inj heval + cases hpair + exact hpaps + | loc location => + dsimp only at heval + cases hdrop : dropVal ctx fuel store (.loc location) with + | error err => rw [hdrop, bindErr] at heval; contradiction + | ok dropped => + rw [hdrop, bindOk] at heval + have hpair := Except.ok.inj heval + cases hpair + exact hpaps.dropVal hdrop + | dropU target => + rw [runOp.eq_def] at heval + dsimp only at heval + cases htarget : resolveAtom env target with + | error err => rw [htarget, bindErr] at heval; contradiction + | ok targetValue => + rw [htarget, bindOk] at heval + cases targetValue with + | lit literal => + have hpair := Except.ok.inj heval + cases hpair + exact hpaps + | erased => + have hpair := Except.ok.inj heval + cases hpair + exact hpaps + | loc location => + dsimp only at heval + cases hdrop : dropUVal ctx fuel store (.loc location) with + | error err => rw [hdrop, bindErr] at heval; contradiction + | ok dropped => + rw [hdrop, bindOk] at heval + have hpair := Except.ok.inj heval + cases hpair + exact hpaps.dropUVal hdrop + | fetch target field => + rw [runOp.eq_def] at heval + dsimp only at heval + cases htarget : resolveAtom env target with + | error err => rw [htarget, bindErr] at heval; contradiction + | ok targetValue => + rw [htarget, bindOk] at heval + cases targetValue with + | lit literal => simp at heval + | erased => simp at heval + | loc location => + cases hbox : store.get? location with + | none => simp [hbox] at heval + | some box => + simp only [hbox] at heval + cases box with + | mk world rc node => + cases node with + | papN address arity captured => simp at heval + | ctorN cid fields => + cases hfield : fields[field]? with + | none => simp [hfield] at heval + | some result => + simp only [hfield] at heval + have hpair := Except.ok.inj heval + cases hpair + exact hpaps + | call address atoms => + rw [runOp.eq_def] at heval + dsimp only at heval + cases hargs : resolveAtoms env atoms with + | error err => rw [hargs, bindErr] at heval; contradiction + | ok values => + rw [hargs, bindOk] at heval + exact ihInvoke _ _ _ _ _ _ hctx hpaps heval + | callSelf atoms => + rw [runOp.eq_def] at heval + dsimp only at heval + cases hargs : resolveAtoms env atoms with + | error err => rw [hargs, bindErr] at heval; contradiction + | ok values => + rw [hargs, bindOk] at heval + cases harity : values.length != cur.arity + · simp only [harity, Bool.false_eq_true, if_false] at heval + cases hbody : runCode ctx fuel cur store values.reverse + cur.body with + | error err => rw [hbody, bindErr] at heval; contradiction + | ok result => + rcases result with ⟨bodyStore, bodyValue⟩ + rw [hbody, bindOk] at heval + obtain ⟨hresult, _⟩ := Sim.checkResultWorld_ok heval + cases hresult + exact ihCode _ _ _ _ _ _ _ hctx hcur hcur hpaps hbody + · simp [harity] at heval + | papp address atoms => + rw [runOp.eq_def] at heval + dsimp only at heval + cases hargs : resolveAtoms env atoms with + | error err => rw [hargs, bindErr] at heval; contradiction + | ok values => + rw [hargs, bindOk] at heval + cases hdecl : ctx.decls address with + | none => simp [hdecl] at heval + | some declaration => + simp only [hdecl] at heval + by_cases hlength : values.length < declArity declaration + · simp only [hlength, if_true] at heval + have hpair := Except.ok.inj heval + cases hpair + exact hpaps.allocPap .shared address (declArity declaration) + values.toArray (by simpa using hlength) + · simp [hlength] at heval + | apply function atoms => + rw [runOp.eq_def] at heval + dsimp only at heval + cases hfunction : resolveAtom env function with + | error err => rw [hfunction, bindErr] at heval; contradiction + | ok functionValue => + rw [hfunction, bindOk] at heval + cases hargs : resolveAtoms env atoms with + | error err => rw [hargs, bindErr] at heval; contradiction + | ok values => + rw [hargs, bindOk] at heval + exact ihApply _ _ _ _ _ _ hctx hpaps heval + | extern address atoms => + rw [runOp.eq_def] at heval + dsimp only at heval + cases hargs : resolveAtoms env atoms with + | error err => rw [hargs, bindErr] at heval; contradiction + | ok values => + rw [hargs, bindOk] at heval + cases hcall : callScalarOracle ctx address values with + | error err => rw [hcall, bindErr] at heval; contradiction + | ok result => + rw [hcall, bindOk] at heval + have hpair := Except.ok.inj heval + cases hpair + exact hpaps + · intro ctx address args store store' value hctx hpaps heval + rw [invoke.eq_def] at heval + dsimp only at heval + cases hdecl : ctx.decls address with + | none => simp [hdecl] at heval + | some declaration => + simp only [hdecl] at heval + cases declaration with + | extern arity => + cases harity : args.length != arity + · simp only [harity, Bool.false_eq_true, if_false] at heval + cases hcall : callScalarOracle ctx address args with + | error err => simp [hcall] at heval + | ok result => + simp only [hcall] at heval + have hpair := Except.ok.inj heval + cases hpair + exact hpaps + · simp [harity] at heval + | fn definition => + cases harity : args.length != definition.arity + · simp only [harity, Bool.false_eq_true, if_false] at heval + cases hbody : runCode ctx fuel definition store args.reverse + definition.body with + | error err => rw [hbody, bindErr] at heval; contradiction + | ok result => + rcases result with ⟨bodyStore, bodyValue⟩ + rw [hbody, bindOk] at heval + obtain ⟨hresult, _⟩ := Sim.checkResultWorld_ok heval + cases hresult + have hbodyNo := hctx hdecl + exact ihCode _ _ _ _ _ _ _ hctx hbodyNo hbodyNo hpaps hbody + · simp [harity] at heval + · intro ctx store function args store' value hctx hpaps heval + rw [applyGo.eq_def] at heval + dsimp only at heval + cases function with + | lit literal => simp at heval + | erased => + cases hdrop : dropMany ctx fuel store args with + | error err => rw [hdrop, bindErr] at heval; contradiction + | ok dropped => + rw [hdrop, bindOk] at heval + have hpair := Except.ok.inj heval + cases hpair + exact hpaps.dropMany hdrop + | loc location => + cases hbox : store.get? location with + | none => simp [hbox] at heval + | some box => + simp only [hbox] at heval + cases box with + | mk world rc node => + cases node with + | ctorN cid fields => simp at heval + | papN address arity captured => + dsimp only at heval + cases hdup : dupVals store captured.toList with + | error err => rw [hdup, bindErr] at heval; contradiction + | ok retained => + rw [hdup, bindOk] at heval + cases hdrop : dropVal ctx fuel retained (.loc location) with + | error err => rw [hdrop, bindErr] at heval; contradiction + | ok ready => + rw [hdrop, bindOk] at heval + have hready := (hpaps.dupVals hdup).dropVal hdrop + by_cases hunder : + (captured.toList ++ args).length < arity + · simp only [hunder, if_true] at heval + have hpair := Except.ok.inj heval + cases hpair + exact hready.allocPap .shared address arity + (captured.toList ++ args).toArray + (by simpa using hunder) + · simp only [hunder, if_false] at heval + by_cases hexact : + (captured.toList ++ args).length = arity + · simp only [hexact, beq_self_eq_true, if_true] + at heval + cases hdecl : ctx.decls address with + | none => simp [hdecl] at heval + | some declaration => + cases hpapsafe : declPapSafe declaration with + | false => simp [hdecl, hpapsafe] at heval + | true => + simp only [hdecl, hpapsafe, if_true] at heval + exact ihInvoke _ _ _ _ _ _ hctx hready heval + · have hbeq : + ((captured.toList ++ args).length == arity) = + false := by + exact beq_eq_false_iff_ne.mpr hexact + simp only [hbeq, Bool.false_eq_true, if_false] at heval + cases hdecl : ctx.decls address with + | none => simp [hdecl] at heval + | some declaration => + cases hpapsafe : declPapSafe declaration with + | false => simp [hdecl, hpapsafe] at heval + | true => + simp only [hdecl, hpapsafe, if_true] at heval + cases hinvoke : invoke ctx fuel address + ((captured.toList ++ args).take arity) ready with + | error err => + rw [hinvoke, bindErr] at heval + contradiction + | ok called => + rcases called with ⟨calledStore, calledValue⟩ + rw [hinvoke, bindOk] at heval + exact ihApply _ _ _ _ _ _ hctx + (ihInvoke _ _ _ _ _ _ hctx hready hinvoke) + heval + +/-- Reuse-free source code preserves strict PAP under-saturation. -/ +theorem runCode_papsUnder {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store store' : Store} {env : List RVal} {code : Code} {value : RVal} + (hctx : CtxNoReuse ctx) (hcur : CodeNoReuse cur.body) + (hcode : CodeNoReuse code) (hpaps : Reclamation.PAPsUnder store) + (heval : runCode ctx fuel cur store env code = .ok (store', value)) : + Reclamation.PAPsUnder store' := + (evalPAPsUnderAt fuel).1 ctx cur store env code store' value + hctx hcur hcode hpaps heval + +/-- Operation-level PAP-shape preservation for a reuse-free instruction. -/ +theorem runOp_papsUnder {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store store' : Store} {env : List RVal} {op : Op} {value : RVal} + (hctx : CtxNoReuse ctx) (hcur : CodeNoReuse cur.body) + (hop : OpNoReuse op) (hpaps : Reclamation.PAPsUnder store) + (heval : runOp ctx fuel cur store env op = .ok (store', value)) : + Reclamation.PAPsUnder store' := + (evalPAPsUnderAt fuel).2.1 ctx cur store env op store' value + hctx hcur hop hpaps heval + +/-- Declared invocation preserves PAP shape in a reuse-free context. -/ +theorem invoke_papsUnder {ctx : Ctx} {fuel : Nat} + {address : Ixon.Address} {args : List RVal} {store store' : Store} + {value : RVal} (hctx : CtxNoReuse ctx) + (hpaps : Reclamation.PAPsUnder store) + (heval : invoke ctx fuel address args store = .ok (store', value)) : + Reclamation.PAPsUnder store' := + (evalPAPsUnderAt fuel).2.2.1 ctx address args store store' value hctx hpaps + heval + +/-- Higher-order application preserves PAP shape across all redispatches. -/ +theorem applyGo_papsUnder {ctx : Ctx} {fuel : Nat} + {store store' : Store} {function : RVal} {args : List RVal} + {value : RVal} (hctx : CtxNoReuse ctx) + (hpaps : Reclamation.PAPsUnder store) + (heval : applyGo ctx fuel store function args = .ok (store', value)) : + Reclamation.PAPsUnder store' := + (evalPAPsUnderAt fuel).2.2.2 ctx store function args store' value hctx + hpaps heval + +theorem runCode_reuses_eq {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store store' : Store} {env : List RVal} {code : Code} {value : RVal} + (hctx : CtxNoReuse ctx) (hcur : CodeNoReuse cur.body) + (hcode : CodeNoReuse code) + (heval : runCode ctx fuel cur store env code = .ok (store', value)) : + store'.reuses = store.reuses := + (evalReusesAt fuel).1 ctx cur store env code store' value + hctx hcur hcode heval + +/-- The operation-level projection of reuse-free execution. Exporting this +alongside `runCode_reuses_eq` lets later compositional simulations preserve +append-only heap invariants one instruction at a time. -/ +theorem runOp_reuses_eq {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store store' : Store} {env : List RVal} {op : Op} {value : RVal} + (hctx : CtxNoReuse ctx) (hcur : CodeNoReuse cur.body) + (hop : OpNoReuse op) + (heval : runOp ctx fuel cur store env op = .ok (store', value)) : + store'.reuses = store.reuses := + (evalReusesAt fuel).2.1 ctx cur store env op store' value + hctx hcur hop heval + +/-- Declared invocation preserves the reuse counter whenever every callable +body in the runtime context is reuse-free. -/ +theorem invoke_reuses_eq {ctx : Ctx} {fuel : Nat} + {address : Ixon.Address} {args : List RVal} {store store' : Store} + {value : RVal} (hctx : CtxNoReuse ctx) + (heval : invoke ctx fuel address args store = .ok (store', value)) : + store'.reuses = store.reuses := + (evalReusesAt fuel).2.2.1 ctx address args store store' value hctx heval + +/-- Higher-order application preserves the reuse counter in a reuse-free +runtime context, including every PAP branch and dynamically selected callee. -/ +theorem applyGo_reuses_eq {ctx : Ctx} {fuel : Nat} + {store store' : Store} {function : RVal} {args : List RVal} + {value : RVal} (hctx : CtxNoReuse ctx) + (heval : applyGo ctx fuel store function args = .ok (store', value)) : + store'.reuses = store.reuses := + (evalReusesAt fuel).2.2.2 ctx store function args store' value hctx heval + +/-- A successful fresh execution of a reuse-free closed program executes no +in-place reuse, so its counter remains definitionally zero. -/ +theorem runMain_reuses_eq_zero {ctx : Ctx} {fuel : Nat} {code : Code} + {store : Store} {value : RVal} (hctx : CtxNoReuse ctx) + (hcode : CodeNoReuse code) + (heval : runMain ctx code fuel = .ok (store, value)) : + store.reuses = 0 := by + exact (evalReusesAt fuel).1 ctx ⟨0, .shared, false, code⟩ ({} : Store) [] + code store value hctx hcode hcode heval + +/-- The exact counter equation contributed by the current lowerer. -/ +def ReuseFreeCostSpec (observation : LowerSim.CostObservation) : Prop := + observation.reuses = 0 + +/-- The current lowerer's general counter contract: no in-place reuse and no +more completed frees than allocations. -/ +def CurrentLowererCostSpec (observation : LowerSim.CostObservation) : Prop := + ReuseFreeCostSpec observation ∧ + LowerSim.AllocationFreeCostSpec observation + +/-- Reuse-free syntax and declarations expose their dynamic counter equation +through the generic target-only cost interface. -/ +theorem runCostInvariant_of_noReuse {ctx : Ctx} {code : Code} + (hctx : CtxNoReuse ctx) (hcode : CodeNoReuse code) : + LowerSim.RunCostInvariant ctx code ReuseFreeCostSpec := by + intro targetFuel targetStore targetValue hrun + exact runMain_reuses_eq_zero hctx hcode hrun + +/-- Reuse-free syntax combines its compiler-specific zero-reuse equation +with the evaluator's general allocation/free balance. -/ +theorem runCostInvariant_of_noReuse_with_allocationFree + {ctx : Ctx} {code : Code} + (hctx : CtxNoReuse ctx) (hcode : CodeNoReuse code) : + LowerSim.RunCostInvariant ctx code CurrentLowererCostSpec := by + intro targetFuel targetStore targetValue hrun + exact ⟨runMain_reuses_eq_zero hctx hcode hrun, + Ix.Compiler.IxIR1.Reclamation.runMain_frees_le_allocs hrun⟩ + +/-! ## Compiler syntax -/ + +def DeclNoReuse : Decl → Prop + | .fn definition => CodeNoReuse definition.body + | .extern _ => True + +def DeclListNoReuse (declarations : List (Ixon.Address × Decl)) : Prop := + ∀ declaration ∈ declarations, DeclNoReuse declaration.2 + +/-- Executable reuse-freedom check for one declaration. -/ +def checkDecl : Decl → Bool + | .fn definition => checkCode definition.body + | .extern _ => true + +/-- Executable reuse-freedom check for a finite declaration environment. -/ +def checkDeclarations (declarations : List (Ixon.Address × Decl)) : Bool := + declarations.all fun declaration => checkDecl declaration.2 + +theorem checkDecl_eq_true_iff (declaration : Decl) : + checkDecl declaration = true ↔ DeclNoReuse declaration := by + cases declaration with + | fn definition => + exact checkCode_eq_true_iff definition.body + | extern arity => + simp [checkDecl, DeclNoReuse] + +/-- The finite declaration check reflects exactly into `DeclListNoReuse`. -/ +theorem checkDeclarations_eq_true_iff + (declarations : List (Ixon.Address × Decl)) : + checkDeclarations declarations = true ↔ + DeclListNoReuse declarations := by + simp only [checkDeclarations, List.all_eq_true, DeclListNoReuse] + constructor + · intro checked declaration member + exact (checkDecl_eq_true_iff declaration.2).mp + (checked declaration member) + · intro noReuse declaration member + exact (checkDecl_eq_true_iff declaration.2).mpr + (noReuse declaration member) + +def StateNoReuse (state : LowSt) : Prop := + DeclListNoReuse state.extra + +theorem StateNoReuse.empty : StateNoReuse ({} : LowSt) := by + simp [StateNoReuse, DeclListNoReuse] + +/-- A compiler action preserves the reuse-free generated-declaration +invariant along every successful state transition. -/ +def PreservesStateNoReuse {α : Type} (action : LowerM α) : Prop := + ∀ {initial final result}, + StateNoReuse initial → + action.run initial = .ok result final → + StateNoReuse final + +private theorem stateBindRun_ok_inv {error state α β : Type} + {action : EStateM error state α} {next : α → EStateM error state β} + {initial final : state} {result : β} + (hrun : (action >>= next).run initial = .ok result final) : + ∃ value middle, + action.run initial = .ok value middle ∧ + (next value).run middle = .ok result final := by + change + (match action.run initial with + | .ok value nextState => (next value).run nextState + | .error err nextState => .error err nextState) = + .ok result final at hrun + cases haction : action.run initial with + | ok value middle => + rw [haction] at hrun + exact ⟨value, middle, rfl, hrun⟩ + | error err middle => + rw [haction] at hrun + contradiction + +private theorem stateThrowRun_not_ok {error state α : Type} + {err : error} {initial final : state} {result : α} + (hrun : (throw err : EStateM error state α).run initial = + .ok result final) : False := by + change EStateM.Result.error err initial = .ok result final at hrun + contradiction + +private theorem stateMapRun_ok_inv {α β : Type} {action : LowerM α} + {map : α → β} {initial final : LowSt} {result : β} + (hrun : (map <$> action).run initial = .ok result final) : + ∃ value, action.run initial = .ok value final ∧ map value = result := by + have hbind : (action >>= fun value => pure (map value)).run initial = + .ok result final := by + simpa only [bind_pure_comp] using hrun + obtain ⟨value, middle, haction, hpure⟩ := stateBindRun_ok_inv hbind + have hresult : map value = result ∧ middle = final := by + simpa using hpure + cases hresult.2 + exact ⟨value, haction, hresult.1⟩ + +theorem PreservesStateNoReuse.pure {α : Type} (value : α) : + PreservesStateNoReuse (pure value : LowerM α) := by + intro initial final result hinitial hrun + have hpure : value = result ∧ initial = final := by + simpa using hrun + rw [← hpure.2] + exact hinitial + +theorem PreservesStateNoReuse.throw {α : Type} (message : String) : + PreservesStateNoReuse (throw message : LowerM α) := by + intro initial final result hinitial hrun + exact (stateThrowRun_not_ok hrun).elim + +theorem PreservesStateNoReuse.throwBind {α β : Type} (message : String) + (next : α → LowerM β) : + PreservesStateNoReuse + ((EStateM.throw message : LowerM α) >>= next) := by + intro initial final result hinitial hrun + change EStateM.Result.error message initial = .ok result final at hrun + contradiction + +theorem PreservesStateNoReuse.get : + PreservesStateNoReuse (get : LowerM LowSt) := by + intro initial final result hinitial hrun + change EStateM.Result.ok initial initial = .ok result final at hrun + injection hrun with _ hstate + subst final + exact hinitial + +theorem PreservesStateNoReuse.bind {α β : Type} + {action : LowerM α} {next : α → LowerM β} + (haction : PreservesStateNoReuse action) + (hnext : ∀ value, PreservesStateNoReuse (next value)) : + PreservesStateNoReuse (action >>= next) := by + intro initial final result hinitial hrun + obtain ⟨value, middle, hfirst, hsecond⟩ := + stateBindRun_ok_inv hrun + exact hnext value (haction hinitial hfirst) hsecond + +theorem PreservesStateNoReuse.map {α β : Type} {action : LowerM α} + (haction : PreservesStateNoReuse action) (map : α → β) : + PreservesStateNoReuse (map <$> action) := by + have hbind : PreservesStateNoReuse + (action >>= fun value => (Pure.pure (map value) : LowerM β)) := + PreservesStateNoReuse.bind haction + (fun value => PreservesStateNoReuse.pure (map value)) + intro initial final result hinitial hrun + apply hbind hinitial + simpa only [bind_pure_comp] using hrun + +theorem PreservesStateNoReuse.listMapM {α β : Type} + (action : α → LowerM β) + (haction : ∀ value, PreservesStateNoReuse (action value)) : + ∀ values : List α, PreservesStateNoReuse (values.mapM action) + | [] => by + simpa using (PreservesStateNoReuse.pure ([] : List β)) + | value :: rest => by + rw [List.mapM_cons] + apply PreservesStateNoReuse.bind (haction value) + intro head + apply PreservesStateNoReuse.bind + (PreservesStateNoReuse.listMapM action haction rest) + intro tail + exact PreservesStateNoReuse.pure (head :: tail) + +theorem PreservesStateNoReuse.listFilterMapM {α β : Type} + (action : α → LowerM (Option β)) + (haction : ∀ value, PreservesStateNoReuse (action value)) : + ∀ values : List α, PreservesStateNoReuse (values.filterMapM action) + | [] => by + simpa using (PreservesStateNoReuse.pure ([] : List β)) + | value :: rest => by + rw [List.filterMapM_cons] + apply PreservesStateNoReuse.bind (haction value) + intro head + cases head with + | none => + exact PreservesStateNoReuse.listFilterMapM action haction rest + | some head => + apply PreservesStateNoReuse.bind + (PreservesStateNoReuse.listFilterMapM action haction rest) + intro tail + exact PreservesStateNoReuse.pure (head :: tail) + +theorem StateNoReuse.prepend {state : LowSt} + {item : Ixon.Address × Decl} (hitem : DeclNoReuse item.2) + (hstate : StateNoReuse state) : + StateNoReuse { state with extra := item :: state.extra } := by + intro declaration hmember + rw [List.mem_cons] at hmember + cases hmember with + | inl hhead => + subst declaration + exact hitem + | inr htail => exact hstate declaration htail + +theorem ctorWrapperDecl_noReuse (source : Ixon.Address) + (tag arity : Nat) : + DeclNoReuse (ctorWrapperDecl source tag arity) := by + simp [ctorWrapperDecl, DeclNoReuse, CodeNoReuse, OpNoReuse] + +theorem freshAddr_preservesStateNoReuse : + PreservesStateNoReuse freshAddr := by + intro initial final result hinitial hrun + change EStateM.Result.ok (synthAddr initial.fresh) + { initial with fresh := initial.fresh + 1 } = + .ok result final at hrun + have hstate : { initial with fresh := initial.fresh + 1 } = final := + congrArg + (fun outcome : EStateM.Result String LowSt Ixon.Address => + match outcome with + | .ok _ state | .error _ state => state) hrun + subst final + exact hinitial + +theorem pushExtra_preservesStateNoReuse + (item : Ixon.Address × Decl) (hitem : DeclNoReuse item.2) : + PreservesStateNoReuse (pushExtra item) := by + intro initial final result hinitial hrun + simp [pushExtra] at hrun + subst final + exact hinitial.prepend hitem + +theorem wrapperFor_preservesStateNoReuse (source : Ixon.Address) + (tag arity : Nat) : + PreservesStateNoReuse (wrapperFor source tag arity) := by + intro initial final result hinitial hrun + cases hcached : initial.wrappers.find? + (·.matches source tag arity) with + | none => + simp [wrapperFor, hcached] at hrun + have hstate : + { initial with + fresh := initial.fresh + 1 + wrappers := + ⟨source, tag, arity, synthAddr initial.fresh⟩ :: + initial.wrappers + extra := + (synthAddr initial.fresh, + ctorWrapperDecl source tag arity) :: initial.extra } = + final := by + exact congrArg + (fun outcome : EStateM.Result String LowSt Ixon.Address => + match outcome with + | .ok _ state | .error _ state => state) hrun + subst final + exact hinitial.prepend (ctorWrapperDecl_noReuse source tag arity) + | some memo => + simp [wrapperFor, hcached] at hrun + obtain ⟨_, hstate⟩ := hrun + subst final + exact hinitial + +theorem releaseSlots_emitNoReuse (input : VEnv) : + ∀ {drops output emit state finalState}, + (releaseSlots input drops).run state = .ok (output, emit) finalState → + EmitNoReuse emit := by + intro drops output emit state finalState hrun + exact releaseSlots_run_core + (Result := fun _ _ _ resultEmit => EmitNoReuse resultEmit) + (hnil := fun _ => emitNoReuse_id) + (haffine := by + intro entry abs rest initial final tailEmit htail + exact emitNoReuse_comp + (emitNoReuse_emitOp + (op := .dropU (.var (initial.rel abs))) + (by simp [OpNoReuse])) + htail) + (hmany := by + intro entry abs rest initial final tailEmit htail + exact emitNoReuse_comp + (emitNoReuse_emitOp + (op := .drop (.var (initial.rel abs))) + (by simp [OpNoReuse])) + htail) + hrun + +theorem applyRecursorFieldRetains_emitNoReuse (input : VEnv) + (retains : List RecursorFieldRetain) : + EmitNoReuse (applyRecursorFieldRetains input retains).2 := by + induction retains generalizing input with + | nil => exact emitNoReuse_id + | cons retain rest ih => + simp only [applyRecursorFieldRetains] + exact emitNoReuse_comp + (emitNoReuse_emitOp (op := .dup (.var (input.rel retain.fieldAbs))) + (by simp [OpNoReuse])) + (ih _) + +theorem releaseAll_emitNoReuse (input : VEnv) (values : List AVal) : + EmitNoReuse (releaseAll input values).2 := by + exact releaseAll_traverse_core + (Result := fun _ _ _ emit => EmitNoReuse emit) + (hnil := fun _ => emitNoReuse_id) + (hconst := fun htail => htail) + (hslot := by + intro initial abs rest output tailEmit htail + exact emitNoReuse_comp + (emitNoReuse_emitOp (op := .drop (.var (initial.rel abs))) + (by simp [OpNoReuse])) + htail) + input values + +theorem lowerCapture_emitNoReuse {expr : IxIR0.Expr} {input output : VEnv} + {index : Nat} {state finalState : LowSt} {emit : Emit} {value : AVal} + (hrun : (lowerCapture expr input index).run state = + .ok (output, emit, value) finalState) : + EmitNoReuse emit := by + cases hentry : input.entries[index]? with + | none => + exact (stateThrowRun_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | some entry => + cases entry with + | recSelf arity => + exact (stateThrowRun_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | slot abs remaining uses held => + cases held with + | false => + exact (stateThrowRun_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | true => + by_cases hunique : worldOfUses uses = .unique + · have huuEq : (Ixon.Owned.unique == Ixon.Owned.unique) = true := + by decide + exact (stateThrowRun_not_ok (by + simpa [lowerCapture, hentry, hunique, huuEq] using hrun)).elim + · have huniqueEq : + (worldOfUses uses == Ixon.Owned.unique) = false := by + cases uses <;> simp_all [worldOfUses] <;> decide + by_cases hmore : remaining > countUses index expr + · have hemit : emit = emitOp (.dup (.var + ((input.setEntry index + (.slot abs (remaining - countUses index expr) uses true)).rel + abs))) := by + have hpure := congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × AVal) => + match result with + | .ok result _ => result.2.1 + | .error _ _ => (_root_.id : Emit)) hrun + simpa [lowerCapture, hentry, huniqueEq, hmore] using hpure.symm + subst emit + exact emitNoReuse_emitOp + (op := .dup (.var + ((input.setEntry index + (.slot abs (remaining - countUses index expr) uses true)).rel + abs))) (by simp [OpNoReuse]) + · by_cases hequal : remaining = countUses index expr + · have hemit : emit = (_root_.id : Emit) := by + have hpure := congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × AVal) => + match result with + | .ok result _ => result.2.1 + | .error _ _ => (_root_.id : Emit)) hrun + simpa [lowerCapture, hentry, huniqueEq, hmore, hequal] + using hpure.symm + subst emit + exact emitNoReuse_id + · exact (stateThrowRun_not_ok (by + simpa [lowerCapture, hentry, huniqueEq, hmore, hequal] + using hrun)).elim + +theorem lowerCaptures_emitNoReuse (expr : IxIR0.Expr) : + ∀ {input captures state finalState output emit values}, + (lowerCaptures expr input captures).run state = + .ok (output, emit, values) finalState → + EmitNoReuse emit := by + intro input captures state finalState output emit values hrun + apply lowerCaptures_run_core + (Result := fun _ _ _ emit _ => EmitNoReuse emit) + (e := expr) (hrun := hrun) + · intro input + exact emitNoReuse_id + · intro index rest input middle output headEmit tailEmit headValue + tailValues state middleState hhead htail + exact emitNoReuse_comp (lowerCapture_emitNoReuse hhead) htail + +def LowerENoReuse (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {world : Ixon.Owned} {expr : IxIR0.Expr} + {state finalState : LowSt} {output : VEnv} {emit : Emit} + {value : AVal}, + (lowerE src fuel input world expr).run state = + .ok (output, emit, value) finalState → + EmitNoReuse emit + +def LowerBorrowNoReuse (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {expr : IxIR0.Expr} {state finalState : LowSt} + {output : VEnv} {emit : Emit} {value : AVal} {release : Bool}, + (lowerBorrow src fuel input expr).run state = + .ok (output, emit, value, release) finalState → + EmitNoReuse emit + +def LowerSpineNoReuse (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {world : Ixon.Owned} {head : IxIR0.Expr} + {args : List IxIR0.Expr} {state finalState : LowSt} + {output : VEnv} {emit : Emit} {value : AVal}, + (lowerSpine src fuel input world head args).run state = + .ok (output, emit, value) finalState → + EmitNoReuse emit + +def KnownCallNoReuse (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {build : Array Atom → Op} {count : Nat} + {argWorlds : List Ixon.Owned} {resultWorld : Ixon.Owned} + {args : List IxIR0.Expr} {state finalState : LowSt} + {output : VEnv} {emit : Emit} {value : AVal}, + (∀ atoms, OpNoReuse (build atoms)) → + (knownCall src fuel input build count argWorlds resultWorld args).run + state = .ok (output, emit, value) finalState → + EmitNoReuse emit + +def LowerArgsNoReuse (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {args : List (IxIR0.Expr × Ixon.Owned)} + {state finalState : LowSt} {output : VEnv} {emit : Emit} + {values : List AVal}, + (lowerArgs src fuel input args).run state = + .ok (output, emit, values) finalState → + EmitNoReuse emit + +def ApplyRestNoReuse (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {resultWorld : Ixon.Owned} {pre : Emit} + {function : AVal} {args : List IxIR0.Expr} + {state finalState : LowSt} {output : VEnv} {emit : Emit} + {value : AVal}, + EmitNoReuse pre → + (applyRest src fuel input resultWorld pre function args).run state = + .ok (output, emit, value) finalState → + EmitNoReuse emit + +def LowerLamNoReuse (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {expr : IxIR0.Expr} {state finalState : LowSt} + {output : VEnv} {emit : Emit} {value : AVal}, + (lowerLam src fuel input expr).run state = + .ok (output, emit, value) finalState → + EmitNoReuse emit + +def LowerFnBodyNoReuse (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ {input : VEnv} {drops : List SlotDrop} {world : Ixon.Owned} + {body : IxIR0.Expr} {state finalState : LowSt} {code : Code}, + (lowerFnBody src fuel input drops world body).run state = + .ok code finalState → + CodeNoReuse code + +structure LowerNoReuseCluster (src : IxIR0.Env) (fuel : Nat) : Prop where + expr : LowerENoReuse src fuel + borrow : LowerBorrowNoReuse src fuel + spine : LowerSpineNoReuse src fuel + knownCall : KnownCallNoReuse src fuel + args : LowerArgsNoReuse src fuel + applyRest : ApplyRestNoReuse src fuel + lam : LowerLamNoReuse src fuel + fnBody : LowerFnBodyNoReuse src fuel + +private theorem lowerNoReuse_zero (src : IxIR0.Env) : + LowerNoReuseCluster src 0 := by + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro input world expr state finalState output emit value hrun + exact (stateThrowRun_not_ok (by simpa [lowerE] using hrun)).elim + · intro input expr state finalState output emit value release hrun + exact (stateThrowRun_not_ok (by simpa [lowerBorrow] using hrun)).elim + · intro input world head args state finalState output emit value hrun + exact (stateThrowRun_not_ok (by simpa [lowerSpine] using hrun)).elim + · intro input build count argWorlds resultWorld args state finalState + output emit value hbuild hrun + exact (stateThrowRun_not_ok (by simpa [knownCall] using hrun)).elim + · intro input args state finalState output emit values hrun + exact (stateThrowRun_not_ok (by simpa [lowerArgs] using hrun)).elim + · intro input resultWorld pre function args state finalState output emit + value hpre hrun + exact (stateThrowRun_not_ok (by simpa [applyRest] using hrun)).elim + · intro input expr state finalState output emit value hrun + exact (stateThrowRun_not_ok (by simpa [lowerLam] using hrun)).elim + · intro input drops world body state finalState code hrun + exact (stateThrowRun_not_ok (by simpa [lowerFnBody] using hrun)).elim + +private theorem lowerArgsNoReuse_succ {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerENoReuse src fuel) (hargs : LowerArgsNoReuse src fuel) : + LowerArgsNoReuse src (fuel + 1) := by + intro input args state finalState output emit values hrun + cases args with + | nil => + have hpure : + (input, (_root_.id : Emit), []) = (output, emit, values) ∧ + state = finalState := by + simpa [lowerArgs] using hrun + cases hpure.1 + exact emitNoReuse_id + | cons head rest => + rcases head with ⟨expr, world⟩ + simp only [lowerArgs] at hrun + obtain ⟨headResult, middleState, hhead, hafterHead⟩ := + stateBindRun_ok_inv hrun + rcases headResult with ⟨middle, headEmit, headValue⟩ + obtain ⟨tailResult, tailState, htail, hpure⟩ := + stateBindRun_ok_inv hafterHead + rcases tailResult with ⟨actualOutput, tailEmit, tailValues⟩ + have hemit : headEmit ∘ tailEmit = emit := by + simpa using congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × List AVal) => + match result with + | .ok result _ => result.2.1 + | .error _ _ => (_root_.id : Emit)) hpure + subst emit + exact emitNoReuse_comp (hexpr hhead) (hargs htail) + +private theorem applyRestNoReuse_succ {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsNoReuse src fuel) : + ApplyRestNoReuse src (fuel + 1) := by + intro input resultWorld pre function args state finalState output emit value + hpre hrun + cases function with + | constA atom => + cases atom with + | erased => + simp only [applyRest] at hrun + obtain ⟨argsResult, argsState, hargsRun, hpure⟩ := + stateBindRun_ok_inv hrun + rcases argsResult with ⟨middle, argsEmit, values⟩ + have hemit : + pre ∘ argsEmit ∘ (releaseAll middle values).2 = emit := by + simpa using congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × AVal) => + match result with + | .ok result _ => result.2.1 + | .error _ _ => (_root_.id : Emit)) hpure + subst emit + have hargsNo : EmitNoReuse argsEmit := hargs hargsRun + have hprefix : EmitNoReuse (pre ∘ argsEmit) := + emitNoReuse_comp (first := pre) (second := argsEmit) hpre hargsNo + exact emitNoReuse_comp + (first := pre ∘ argsEmit) + (second := (releaseAll middle values).2) hprefix + (releaseAll_emitNoReuse middle values) + | var relative => + simp only [applyRest] at hrun + obtain ⟨_, checkedState, _, hafterCheck⟩ := + stateBindRun_ok_inv hrun + obtain ⟨argsResult, argsState, hargsRun, hpure⟩ := + stateBindRun_ok_inv hafterCheck + rcases argsResult with ⟨middle, argsEmit, values⟩ + have hemit : pre ∘ argsEmit ∘ emitOp (.apply + ((AVal.constA (.var relative)).toAtom middle) + (values.map (·.toAtom middle)).toArray) = emit := by + simpa using congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × AVal) => + match result with + | .ok result _ => result.2.1 + | .error _ _ => (_root_.id : Emit)) hpure + subst emit + have hargsNo : EmitNoReuse argsEmit := hargs hargsRun + have hprefix : EmitNoReuse (pre ∘ argsEmit) := + emitNoReuse_comp (first := pre) (second := argsEmit) hpre hargsNo + exact emitNoReuse_comp + (first := pre ∘ argsEmit) + (second := emitOp (.apply + ((AVal.constA (.var relative)).toAtom middle) + (values.map (·.toAtom middle)).toArray)) hprefix + (emitNoReuse_emitOp (by simp [OpNoReuse])) + | lit literal => + simp only [applyRest] at hrun + obtain ⟨_, checkedState, _, hafterCheck⟩ := + stateBindRun_ok_inv hrun + obtain ⟨argsResult, argsState, hargsRun, hpure⟩ := + stateBindRun_ok_inv hafterCheck + rcases argsResult with ⟨middle, argsEmit, values⟩ + have hemit : pre ∘ argsEmit ∘ emitOp (.apply + ((AVal.constA (.lit literal)).toAtom middle) + (values.map (·.toAtom middle)).toArray) = emit := by + simpa using congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × AVal) => + match result with + | .ok result _ => result.2.1 + | .error _ _ => (_root_.id : Emit)) hpure + subst emit + have hargsNo : EmitNoReuse argsEmit := hargs hargsRun + have hprefix : EmitNoReuse (pre ∘ argsEmit) := + emitNoReuse_comp (first := pre) (second := argsEmit) hpre hargsNo + exact emitNoReuse_comp + (first := pre ∘ argsEmit) + (second := emitOp (.apply + ((AVal.constA (.lit literal)).toAtom middle) + (values.map (·.toAtom middle)).toArray)) hprefix + (emitNoReuse_emitOp (by simp [OpNoReuse])) + | slotA abs => + simp only [applyRest] at hrun + obtain ⟨_, checkedState, _, hafterCheck⟩ := + stateBindRun_ok_inv hrun + obtain ⟨argsResult, argsState, hargsRun, hpure⟩ := + stateBindRun_ok_inv hafterCheck + rcases argsResult with ⟨middle, argsEmit, values⟩ + have hemit : pre ∘ argsEmit ∘ emitOp (.apply + ((AVal.slotA abs).toAtom middle) + (values.map (·.toAtom middle)).toArray) = emit := by + simpa using congrArg + (fun result : EStateM.Result String LowSt + (VEnv × Emit × AVal) => + match result with + | .ok result _ => result.2.1 + | .error _ _ => (_root_.id : Emit)) hpure + subst emit + have hargsNo : EmitNoReuse argsEmit := hargs hargsRun + have hprefix : EmitNoReuse (pre ∘ argsEmit) := + emitNoReuse_comp (first := pre) (second := argsEmit) hpre hargsNo + exact emitNoReuse_comp + (first := pre ∘ argsEmit) + (second := emitOp (.apply ((AVal.slotA abs).toAtom middle) + (values.map (·.toAtom middle)).toArray)) hprefix + (emitNoReuse_emitOp (by simp [OpNoReuse])) + +private theorem knownCallNoReuse_succ {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsNoReuse src fuel) + (hrest : ApplyRestNoReuse src fuel) : + KnownCallNoReuse src (fuel + 1) := by + intro input build count argWorlds resultWorld args state finalState output + emit value hbuild hrun + simp only [knownCall] at hrun + obtain ⟨argsResult, argsState, hargsRun, hafterArgs⟩ := + stateBindRun_ok_inv hrun + rcases argsResult with ⟨middle, argsEmit, values⟩ + by_cases hterminal : args.length ≤ count + · have hpure : + (middle.bump, + argsEmit ∘ emitOp + (build (values.map (·.toAtom middle)).toArray), + AVal.slotA middle.depth) = (output, emit, value) ∧ + argsState = finalState := by + simpa [hterminal] using hafterArgs + have hemit : argsEmit ∘ emitOp + (build (values.map (·.toAtom middle)).toArray) = emit := + congrArg (fun result : VEnv × Emit × AVal => result.2.1) hpure.1 + subst emit + have hargsNo : EmitNoReuse argsEmit := hargs hargsRun + exact emitNoReuse_comp (first := argsEmit) + (second := emitOp + (build (values.map (·.toAtom middle)).toArray)) hargsNo + (emitNoReuse_emitOp (hbuild _)) + · have hrestRun : + (applyRest src fuel middle.bump resultWorld + (argsEmit ∘ emitOp + (build (values.map (·.toAtom middle)).toArray)) + (.slotA middle.depth) + (args.drop count)).run argsState = + .ok (output, emit, value) finalState := by + simpa [hterminal] using hafterArgs + have hargsNo : EmitNoReuse argsEmit := hargs hargsRun + have hpre : EmitNoReuse (argsEmit ∘ emitOp + (build (values.map (·.toAtom middle)).toArray)) := + emitNoReuse_comp (first := argsEmit) + (second := emitOp + (build (values.map (·.toAtom middle)).toArray)) hargsNo + (emitNoReuse_emitOp (hbuild _)) + exact hrest hpre hrestRun + +private theorem lowerBorrow_dynamicNoReuse {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerENoReuse src fuel) + {input output : VEnv} {expr : IxIR0.Expr} + {state finalState : LowSt} {emit : Emit} {value : AVal} + {release : Bool} + {finish : (VEnv × Emit × AVal) → (VEnv × Emit × AVal × Bool)} + (hrun : (finish <$> lowerE src fuel input .shared expr).run state = + .ok (output, emit, value, release) finalState) + (hfinish : ∀ result, (finish result).2.1 = result.2.1) : + EmitNoReuse emit := by + obtain ⟨exprResult, hexprRun, hvalue⟩ := stateMapRun_ok_inv hrun + rcases exprResult with ⟨middle, middleEmit, middleValue⟩ + have hemit : middleEmit = emit := + calc + middleEmit = (finish (middle, middleEmit, middleValue)).2.1 := + (hfinish (middle, middleEmit, middleValue)).symm + _ = emit := congrArg + (fun result : VEnv × Emit × AVal × Bool => result.2.1) + hvalue + subst emit + exact hexpr hexprRun + +private theorem lowerBorrowVarNoReuse {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {index : Nat} {state finalState : LowSt} + {emit : Emit} {value : AVal} {release : Bool} + (hrun : (lowerBorrow src (fuel + 1) input (.var index)).run state = + .ok (output, emit, value, release) finalState) : + EmitNoReuse emit := by + cases hentry : input.entries[index]? with + | none => + exact (stateThrowRun_not_ok (by + simpa [lowerBorrow, hentry] using hrun)).elim + | some entry => + cases entry with + | recSelf arity => + exact (stateThrowRun_not_ok (by + simpa [lowerBorrow, hentry] using hrun)).elim + | slot abs remaining uses held => + cases held with + | false => + exact (stateThrowRun_not_ok (by + simpa [lowerBorrow, hentry] using hrun)).elim + | true => + by_cases hunique : worldOfUses uses = .unique + · have huuEq : (Ixon.Owned.unique == Ixon.Owned.unique) = true := + by decide + exact (stateThrowRun_not_ok (by + simpa [lowerBorrow, hentry, hunique, huuEq] using hrun)).elim + · have huniqueEq : + (worldOfUses uses == Ixon.Owned.unique) = false := by + cases uses <;> simp_all [worldOfUses] <;> decide + cases remaining with + | zero => + exact (stateThrowRun_not_ok (by + simpa [lowerBorrow, hentry, huniqueEq] using hrun)).elim + | succ remaining => + cases remaining with + | zero => + have hpure : + (input.setEntry index (.slot abs 0 uses false), + (_root_.id : Emit), AVal.slotA abs, true) = + (output, emit, value, release) ∧ + state = finalState := by + simpa [lowerBorrow, hentry, huniqueEq] using hrun + have hemit : (_root_.id : Emit) = emit := + congrArg + (fun result : VEnv × Emit × AVal × Bool => + result.2.1) hpure.1 + rw [← hemit] + exact emitNoReuse_id + | succ remaining => + have hpure : + (input.setEntry index + (.slot abs (remaining + 1) uses true), + (_root_.id : Emit), AVal.slotA abs, false) = + (output, emit, value, release) ∧ + state = finalState := by + simpa [lowerBorrow, hentry, huniqueEq] using hrun + have hemit : (_root_.id : Emit) = emit := + congrArg + (fun result : VEnv × Emit × AVal × Bool => + result.2.1) hpure.1 + rw [← hemit] + exact emitNoReuse_id + +private theorem lowerBorrowNoReuse_succ {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerENoReuse src fuel) : + LowerBorrowNoReuse src (fuel + 1) := by + intro input expr state finalState output emit value release hrun + cases expr with + | var index => exact lowerBorrowVarNoReuse hrun + | ref address => + exact lowerBorrow_dynamicNoReuse hexpr + (by simpa [lowerBorrow] using hrun) (fun _ => rfl) + | app function argument => + exact lowerBorrow_dynamicNoReuse hexpr + (by simpa [lowerBorrow] using hrun) (fun _ => rfl) + | lam uses body => + exact lowerBorrow_dynamicNoReuse hexpr + (by simpa [lowerBorrow] using hrun) (fun _ => rfl) + | letE uses bound body => + exact lowerBorrow_dynamicNoReuse hexpr + (by simpa [lowerBorrow] using hrun) (fun _ => rfl) + | proj index source => + exact lowerBorrow_dynamicNoReuse hexpr + (by simpa [lowerBorrow] using hrun) (fun _ => rfl) + | lit literal => + exact lowerBorrow_dynamicNoReuse hexpr + (by simpa [lowerBorrow] using hrun) (fun _ => rfl) + | erased => + exact lowerBorrow_dynamicNoReuse hexpr + (by simpa [lowerBorrow] using hrun) (fun _ => rfl) + +private theorem lowerEApplyRestNoReuse + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerENoReuse src fuel) + (hrest : ApplyRestNoReuse src fuel) + {input output : VEnv} {world : Ixon.Owned} {head : IxIR0.Expr} + {args : List IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {value : AVal} + (hrun : (do + let (middle, headEmit, function) ← + lowerE src fuel input .shared head + applyRest src fuel middle world headEmit function args).run state = + .ok (output, emit, value) finalState) : + EmitNoReuse emit := by + obtain ⟨headResult, middleState, hhead, htail⟩ := + stateBindRun_ok_inv hrun + rcases headResult with ⟨middle, headEmit, function⟩ + exact hrest (hexpr hhead) htail + +private theorem lowerSpineNoReuse_succ {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerENoReuse src fuel) + (hspine : LowerSpineNoReuse src fuel) + (hknown : KnownCallNoReuse src fuel) + (hrest : ApplyRestNoReuse src fuel) : + LowerSpineNoReuse src (fuel + 1) := by + intro input world head args state finalState output emit value hrun + have hsuEq : (Ixon.Owned.shared == Ixon.Owned.unique) = false := by + decide + cases head with + | app function argument => + exact hspine (by simpa [lowerSpine] using hrun) + | erased => + exact hrest emitNoReuse_id (by simpa [lowerSpine] using hrun) + | var index => + simp only [lowerSpine] at hrun + cases hentry : input.entries[index]? with + | none => + exact lowerEApplyRestNoReuse hexpr hrest (by + simpa [hentry] using hrun) + | some entry => + cases entry with + | slot abs remaining uses held => + exact lowerEApplyRestNoReuse hexpr hrest (by + simpa [hentry] using hrun) + | recSelf arity => + by_cases hunder : args.length < arity + · exact (stateThrowRun_not_ok (by + simpa [hentry, hunder] using hrun)).elim + · obtain ⟨_, checkedState, _, hknownRun⟩ := + stateBindRun_ok_inv (by simpa [hentry, hunder] using hrun) + exact hknown (by intro atoms; simp [OpNoReuse]) hknownRun + | ref address => + simp only [lowerSpine] at hrun + cases hsource : src address with + | none => + exact (stateThrowRun_not_ok (by + simpa [hsource] using hrun)).elim + | some declaration => + cases declaration with + | defn result body => + by_cases hunder : args.length < lamArity body + · cases world with + | unique => + exact (stateThrowRun_not_ok (by + simpa [hsource, hunder] using hrun)).elim + | shared => + cases result with + | unique => + exact (stateThrowRun_not_ok (by + simpa [hsource, hunder] using hrun)).elim + | shared => + cases hp : papSafe body with + | false => + exact (stateThrowRun_not_ok (by + simpa [hsource, hunder, hp, hsuEq] using hrun)).elim + | true => + exact hknown + (build := fun atoms => .papp address atoms) + (by intro atoms; simp [OpNoReuse]) (by + simpa [hsource, hunder, hp, hsuEq] using hrun) + · obtain ⟨_, checkedState, _, hknownRun⟩ := + stateBindRun_ok_inv (by + simpa [hsource, hunder] using hrun) + exact hknown (by intro atoms; simp [OpNoReuse]) hknownRun + | ctor tag arity => + by_cases hunder : args.length < arity + · cases world with + | unique => + exact (stateThrowRun_not_ok (by + simpa [hsource, hunder] using hrun)).elim + | shared => + obtain ⟨wrapper, wrapperState, _, hknownRun⟩ := + stateBindRun_ok_inv (by + simpa [hsource, hunder] using hrun) + exact hknown (by intro atoms; simp [OpNoReuse]) hknownRun + · exact hknown + (build := fun atoms => .alloc world (ctorIdOf address tag) atoms) + (by intro atoms; simp [OpNoReuse]) (by + simpa [hsource, hunder] using hrun) + | recursor numArgs natLit rules => + by_cases hunder : args.length < numArgs + 1 + · cases world with + | unique => + exact (stateThrowRun_not_ok (by + simpa [hsource, hunder] using hrun)).elim + | shared => + exact hknown + (build := fun atoms => .papp address atoms) + (by intro atoms; simp [OpNoReuse]) (by + simpa [hsource, hunder] using hrun) + · obtain ⟨_, checkedState, _, hknownRun⟩ := + stateBindRun_ok_inv (by + simpa [hsource, hunder] using hrun) + exact hknown (by intro atoms; simp [OpNoReuse]) hknownRun + | extern arity => + by_cases hunder : args.length < arity + · cases world with + | unique => + exact (stateThrowRun_not_ok (by + simpa [hsource, hunder] using hrun)).elim + | shared => + exact hknown + (build := fun atoms => .papp address atoms) + (by intro atoms; simp [OpNoReuse]) (by + simpa [hsource, hunder] using hrun) + · exact hknown + (build := fun atoms => .extern address atoms) + (by intro atoms; simp [OpNoReuse]) (by + simpa [hsource, hunder] using hrun) + | lam uses body => + exact lowerEApplyRestNoReuse hexpr hrest (by + simpa [lowerSpine] using hrun) + | letE uses bound body => + exact lowerEApplyRestNoReuse hexpr hrest (by + simpa [lowerSpine] using hrun) + | proj index source => + exact lowerEApplyRestNoReuse hexpr hrest (by + simpa [lowerSpine] using hrun) + | lit literal => + exact lowerEApplyRestNoReuse hexpr hrest (by + simpa [lowerSpine] using hrun) + +private theorem lowerEVarNoReuse {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Ixon.Owned} {index : Nat} + {state finalState : LowSt} {emit : Emit} {value : AVal} + (hrun : (lowerE src (fuel + 1) input world (.var index)).run state = + .ok (output, emit, value) finalState) : + EmitNoReuse emit := by + have hssNe : (Ixon.Owned.shared != Ixon.Owned.shared) = false := by + decide + have huuNe : (Ixon.Owned.unique != Ixon.Owned.unique) = false := by + decide + have hsuNe : (Ixon.Owned.shared != Ixon.Owned.unique) = true := by + decide + have husNe : (Ixon.Owned.unique != Ixon.Owned.shared) = true := by + decide + have hsuEq : (Ixon.Owned.shared == Ixon.Owned.unique) = false := by + decide + have huuEq : (Ixon.Owned.unique == Ixon.Owned.unique) = true := by + decide + cases hentry : input.entries[index]? with + | none => + exact (stateThrowRun_not_ok (by + simpa [lowerE, hentry] using hrun)).elim + | some entry => + cases entry with + | recSelf arity => + exact (stateThrowRun_not_ok (by + simpa [lowerE, hentry] using hrun)).elim + | slot abs remaining uses held => + cases held with + | false => + exact (stateThrowRun_not_ok (by + simpa [lowerE, hentry] using hrun)).elim + | true => + by_cases hworld : worldOfUses uses = world + · subst world + have hsame : + (worldOfUses uses != worldOfUses uses) = false := by + cases uses <;> decide + cases remaining with + | zero => + exact (stateThrowRun_not_ok (by + simpa [lowerE, hentry, hsame] using hrun)).elim + | succ remaining => + cases remaining with + | zero => + have hpure : + (input.setEntry index (.slot abs 0 uses false), + (_root_.id : Emit), AVal.slotA abs) = + (output, emit, value) ∧ state = finalState := by + simpa [lowerE, hentry, hsame] using hrun + have hemit : (_root_.id : Emit) = emit := + congrArg + (fun result : VEnv × Emit × AVal => result.2.1) + hpure.1 + rw [← hemit] + exact emitNoReuse_id + | succ remaining => + cases uses with + | erased => + have hpure : + let input' := input.setEntry index + (.slot abs (Nat.succ remaining) .erased true) + (input'.bump, + emitOp (.dup (.var (input'.rel abs))), + AVal.slotA input'.depth) = + (output, emit, value) ∧ state = finalState := by + simpa [lowerE, hentry, worldOfUses, hsame, hsuEq, + hssNe, huuNe, hsuNe, husNe, huuEq] using hrun + dsimp only at hpure + have hemit : + emitOp (.dup (.var + ((input.setEntry index + (.slot abs (Nat.succ remaining) .erased true)).rel + abs))) = emit := by + simpa using congrArg + (fun result : VEnv × Emit × AVal => result.2.1) + hpure.1 + rw [← hemit] + exact emitNoReuse_emitOp (by simp [OpNoReuse]) + | linear => + exact (stateThrowRun_not_ok (by + simpa [lowerE, hentry, worldOfUses, hsame, huuEq, + hssNe, huuNe, hsuNe, husNe, hsuEq] using hrun)).elim + | affine => + exact (stateThrowRun_not_ok (by + simpa [lowerE, hentry, worldOfUses, hsame, huuEq, + hssNe, huuNe, hsuNe, husNe, hsuEq] using hrun)).elim + | many => + have hpure : + let input' := input.setEntry index + (.slot abs (Nat.succ remaining) .many true) + (input'.bump, + emitOp (.dup (.var (input'.rel abs))), + AVal.slotA input'.depth) = + (output, emit, value) ∧ state = finalState := by + simpa [lowerE, hentry, worldOfUses, hsame, hsuEq, + hssNe, huuNe, hsuNe, husNe, huuEq] using hrun + dsimp only at hpure + have hemit : + emitOp (.dup (.var + ((input.setEntry index + (.slot abs (Nat.succ remaining) .many true)).rel + abs))) = emit := by + simpa using congrArg + (fun result : VEnv × Emit × AVal => result.2.1) + hpure.1 + rw [← hemit] + exact emitNoReuse_emitOp (by simp [OpNoReuse]) + · have hdiff : (worldOfUses uses != world) = true := by + cases uses <;> cases world <;> + simp_all [worldOfUses] <;> decide + cases uses <;> cases world + all_goals + try { exact (hworld (by rfl)).elim } + all_goals + exact (stateThrowRun_not_ok (by + simpa [lowerE, hentry, worldOfUses, hdiff, hssNe, huuNe, + hsuNe, husNe, hsuEq, huuEq] using hrun)).elim + +private theorem pureTripleRun_emitNoReuse + {expectedOutput output : VEnv} {expectedEmit emit : Emit} + {expectedValue value : AVal} {state finalState : LowSt} + (hexpected : EmitNoReuse expectedEmit) + (hrun : (pure (expectedOutput, expectedEmit, expectedValue) : + LowerM (VEnv × Emit × AVal)).run state = + .ok (output, emit, value) finalState) : + EmitNoReuse emit := by + have hpure : + (expectedOutput, expectedEmit, expectedValue) = + (output, emit, value) ∧ state = finalState := by + simpa using hrun + have hemit : expectedEmit = emit := + congrArg (fun result : VEnv × Emit × AVal => result.2.1) hpure.1 + rw [← hemit] + exact hexpected + +private theorem lowerERefNoReuse {src : IxIR0.Env} {fuel : Nat} + {input output : VEnv} {world : Ixon.Owned} + {address : Ixon.Address} {state finalState : LowSt} + {emit : Emit} {value : AVal} + (hrun : (lowerE src (fuel + 1) input world (.ref address)).run state = + .ok (output, emit, value) finalState) : + EmitNoReuse emit := by + have hsuEq : (Ixon.Owned.shared == Ixon.Owned.unique) = false := by + decide + cases hsource : src address with + | none => + exact (stateThrowRun_not_ok (by + simpa [lowerE, hsource] using hrun)).elim + | some declaration => + cases declaration with + | defn result body => + cases harity : lamArity body with + | zero => + obtain ⟨unitValue, _, hvalue⟩ := + stateMapRun_ok_inv (by + simpa [lowerE, hsource, harity] using hrun) + cases unitValue + have hemit : emitOp (.call address #[]) = emit := + congrArg (fun result : VEnv × Emit × AVal => result.2.1) + hvalue + rw [← hemit] + exact emitNoReuse_emitOp (by simp [OpNoReuse]) + | succ arity => + cases world with + | unique => + exact (stateThrowRun_not_ok (by + simpa [lowerE, hsource, harity] using hrun)).elim + | shared => + cases result with + | unique => + exact (stateThrowRun_not_ok (by + simpa [lowerE, hsource, harity] using hrun)).elim + | shared => + cases hp : papSafe body with + | false => + exact (stateThrowRun_not_ok (by + simpa [lowerE, hsource, harity, hp, hsuEq] + using hrun)).elim + | true => + exact pureTripleRun_emitNoReuse + (emitNoReuse_emitOp (op := .papp address #[]) + (by simp [OpNoReuse])) (by + simpa [lowerE, hsource, harity, hp, hsuEq] + using hrun) + | ctor tag arity => + cases arity with + | zero => + exact pureTripleRun_emitNoReuse + (emitNoReuse_emitOp + (op := .alloc world (ctorIdOf address tag) #[]) + (by simp [OpNoReuse])) (by + simpa [lowerE, hsource] using hrun) + | succ arity => + cases world with + | unique => + exact (stateThrowRun_not_ok (by + simpa [lowerE, hsource] using hrun)).elim + | shared => + obtain ⟨wrapper, _, hvalue⟩ := + stateMapRun_ok_inv (by + simpa [lowerE, hsource] using hrun) + have hemit : emitOp (.papp wrapper #[]) = emit := + congrArg (fun result : VEnv × Emit × AVal => result.2.1) + hvalue + rw [← hemit] + exact emitNoReuse_emitOp (by simp [OpNoReuse]) + | recursor numArgs natLit rules => + cases world with + | unique => + exact (stateThrowRun_not_ok (by + simpa [lowerE, hsource] using hrun)).elim + | shared => + exact pureTripleRun_emitNoReuse + (emitNoReuse_emitOp (op := .papp address #[]) + (by simp [OpNoReuse])) (by + simpa [lowerE, hsource] using hrun) + | extern arity => + cases arity with + | zero => + exact pureTripleRun_emitNoReuse + (emitNoReuse_emitOp (op := .extern address #[]) + (by simp [OpNoReuse])) (by + simpa [lowerE, hsource] using hrun) + | succ arity => + cases world with + | unique => + exact (stateThrowRun_not_ok (by + simpa [lowerE, hsource] using hrun)).elim + | shared => + exact pureTripleRun_emitNoReuse + (emitNoReuse_emitOp (op := .papp address #[]) + (by simp [OpNoReuse])) (by + simpa [lowerE, hsource] using hrun) + +private theorem lowerELetNoReuse {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerENoReuse src fuel) + {input output : VEnv} {world : Ixon.Owned} {uses : Ixon.Uses} + {bound body : IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {value : AVal} + (hrun : (lowerE src (fuel + 1) input world + (.letE uses bound body)).run state = + .ok (output, emit, value) finalState) : + EmitNoReuse emit := by + obtain ⟨boundResult, boundState, hbound, hafterBound⟩ := + stateBindRun_ok_inv (by simpa [lowerE] using hrun) + rcases boundResult with ⟨middle, boundEmit, boundValue⟩ + have hboundNo : EmitNoReuse boundEmit := hexpr hbound + cases boundValue with + | slotA abs => + by_cases hzero : countUses 0 body = 0 + · cases uses with + | erased => + obtain ⟨_, _, hthrow, _⟩ := stateBindRun_ok_inv (by + simpa [hzero] using hafterBound) + exact (stateThrowRun_not_ok hthrow).elim + | linear => + obtain ⟨_, _, hthrow, _⟩ := stateBindRun_ok_inv (by + simpa [hzero] using hafterBound) + exact (stateThrowRun_not_ok hthrow).elim + | affine => + obtain ⟨bodyResult, hbody, hvalue⟩ := + stateMapRun_ok_inv (by simpa [hzero] using hafterBound) + rcases bodyResult with ⟨bodyOutput, bodyEmit, bodyValue⟩ + have hemit : + boundEmit ∘ emitOp (.dropU (.var (middle.rel abs))) ∘ + bodyEmit = emit := by + exact congrArg + (fun result : VEnv × Emit × AVal => result.2.1) hvalue + rw [← hemit] + exact emitNoReuse_comp (first := boundEmit) + (second := emitOp (.dropU (.var (middle.rel abs))) ∘ bodyEmit) + hboundNo + (emitNoReuse_comp + (emitNoReuse_emitOp (by simp [OpNoReuse])) + (hexpr hbody)) + | many => + obtain ⟨bodyResult, hbody, hvalue⟩ := + stateMapRun_ok_inv (by simpa [hzero] using hafterBound) + rcases bodyResult with ⟨bodyOutput, bodyEmit, bodyValue⟩ + have hemit : + boundEmit ∘ emitOp (.drop (.var (middle.rel abs))) ∘ + bodyEmit = emit := by + exact congrArg + (fun result : VEnv × Emit × AVal => result.2.1) hvalue + rw [← hemit] + exact emitNoReuse_comp (first := boundEmit) + (second := emitOp (.drop (.var (middle.rel abs))) ∘ bodyEmit) + hboundNo + (emitNoReuse_comp + (emitNoReuse_emitOp (by simp [OpNoReuse])) + (hexpr hbody)) + · obtain ⟨bodyResult, hbody, hvalue⟩ := + stateMapRun_ok_inv (by simpa [hzero] using hafterBound) + rcases bodyResult with ⟨bodyOutput, bodyEmit, bodyValue⟩ + have hemit : boundEmit ∘ bodyEmit = emit := by + exact congrArg + (fun result : VEnv × Emit × AVal => result.2.1) hvalue + rw [← hemit] + exact emitNoReuse_comp hboundNo (hexpr hbody) + | constA atom => + by_cases hzero : countUses 0 body = 0 + · obtain ⟨bodyResult, hbody, hvalue⟩ := + stateMapRun_ok_inv (by simpa [hzero] using hafterBound) + rcases bodyResult with ⟨bodyOutput, bodyEmit, bodyValue⟩ + have hemit : + boundEmit ∘ emitOp (.pure atom) ∘ bodyEmit = emit := by + exact congrArg + (fun result : VEnv × Emit × AVal => result.2.1) hvalue + rw [← hemit] + exact emitNoReuse_comp (first := boundEmit) + (second := emitOp (.pure atom) ∘ bodyEmit) hboundNo + (emitNoReuse_comp + (emitNoReuse_emitOp (by simp [OpNoReuse])) + (hexpr hbody)) + · obtain ⟨bodyResult, hbody, hvalue⟩ := + stateMapRun_ok_inv (by simpa [hzero] using hafterBound) + rcases bodyResult with ⟨bodyOutput, bodyEmit, bodyValue⟩ + have hemit : + boundEmit ∘ emitOp (.pure atom) ∘ bodyEmit = emit := by + exact congrArg + (fun result : VEnv × Emit × AVal => result.2.1) hvalue + rw [← hemit] + exact emitNoReuse_comp (first := boundEmit) + (second := emitOp (.pure atom) ∘ bodyEmit) hboundNo + (emitNoReuse_comp + (emitNoReuse_emitOp (by simp [OpNoReuse])) + (hexpr hbody)) + +private theorem lowerEProjNoReuse {src : IxIR0.Env} {fuel : Nat} + (hborrow : LowerBorrowNoReuse src fuel) + {input output : VEnv} {world : Ixon.Owned} {index : Nat} + {source : IxIR0.Expr} {state finalState : LowSt} + {emit : Emit} {value : AVal} + (hrun : (lowerE src (fuel + 1) input world + (.proj index source)).run state = + .ok (output, emit, value) finalState) : + EmitNoReuse emit := by + cases world with + | unique => + simp [lowerE] at hrun + | shared => + obtain ⟨borrowResult, borrowState, hborrowRun, hafterBorrow⟩ := + stateBindRun_ok_inv (by simpa [lowerE] using hrun) + rcases borrowResult with ⟨middle, borrowEmit, borrowed, release⟩ + have hborrowNo : EmitNoReuse borrowEmit := hborrow hborrowRun + cases borrowed with + | constA atom => + cases atom with + | erased => + exact pureTripleRun_emitNoReuse hborrowNo (by + simpa using hafterBorrow) + | var relative => + exact pureTripleRun_emitNoReuse + (emitNoReuse_comp hborrowNo + (emitNoReuse_emitOp + (op := .fetch (.var relative) index) + (by simp [OpNoReuse]))) (by + simpa using hafterBorrow) + | lit literal => + exact pureTripleRun_emitNoReuse + (emitNoReuse_comp hborrowNo + (emitNoReuse_emitOp + (op := .fetch (.lit literal) index) + (by simp [OpNoReuse]))) (by + simpa using hafterBorrow) + | slotA abs => + cases release with + | false => + exact pureTripleRun_emitNoReuse + (emitNoReuse_comp (first := borrowEmit) + (second := emitOp (.fetch (.var (middle.rel abs)) index) ∘ + emitOp (.dup (.var (middle.bump.rel middle.depth)))) + hborrowNo + (emitNoReuse_comp + (emitNoReuse_emitOp (by simp [OpNoReuse])) + (emitNoReuse_emitOp (by simp [OpNoReuse])))) (by + simpa using hafterBorrow) + | true => + exact pureTripleRun_emitNoReuse + (emitNoReuse_comp (first := borrowEmit) + (second := emitOp (.fetch (.var (middle.rel abs)) index) ∘ + emitOp (.dup (.var (middle.bump.rel middle.depth))) ∘ + emitOp (.drop (.var (middle.bump.bump.rel abs)))) + hborrowNo + (emitNoReuse_comp + (emitNoReuse_emitOp (by simp [OpNoReuse])) + (emitNoReuse_comp + (emitNoReuse_emitOp (by simp [OpNoReuse])) + (emitNoReuse_emitOp (by simp [OpNoReuse]))))) (by + simpa using hafterBorrow) + +private theorem lowerENoReuse_succ {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerENoReuse src fuel) + (hspine : LowerSpineNoReuse src fuel) + (hborrow : LowerBorrowNoReuse src fuel) + (hlam : LowerLamNoReuse src fuel) : + LowerENoReuse src (fuel + 1) := by + intro input world expr state finalState output emit value hrun + cases expr with + | var index => exact lowerEVarNoReuse hrun + | ref address => exact lowerERefNoReuse hrun + | lit literal => + exact pureTripleRun_emitNoReuse emitNoReuse_id (by + simpa [lowerE] using hrun) + | erased => + exact pureTripleRun_emitNoReuse emitNoReuse_id (by + simpa [lowerE] using hrun) + | lam uses body => + cases world with + | unique => + have hthrow : + (throw + "function values live in the shared world (one-shot closures deferred)" : + LowerM (VEnv × Emit × AVal)).run state = + .ok (output, emit, value) finalState := by + simpa [lowerE] using hrun + exact (stateThrowRun_not_ok hthrow).elim + | shared => + exact hlam (by simpa [lowerE] using hrun) + | letE uses bound body => exact lowerELetNoReuse hexpr hrun + | app function argument => + exact hspine (by simpa [lowerE] using hrun) + | proj index source => exact lowerEProjNoReuse hborrow hrun + +private theorem lowerLamNoReuse_succ {src : IxIR0.Env} {fuel : Nat} : + LowerLamNoReuse src (fuel + 1) := by + intro input expr state finalState output emit value hrun + apply LowerSim.lowerLam_run_core + (Result := fun _ _ emit _ => EmitNoReuse emit) + (hrun := hrun) + intro _bodyFuel captureOutput captureEmit captureValues _captureState + fnAddress _addressState _code _bodyState _hfuel _hp hcaptureRun + _hfreshRun _hbodyRun + exact emitNoReuse_comp + (first := captureEmit) + (second := emitOp (.papp fnAddress + (captureValues.map (·.toAtom captureOutput)).toArray)) + (lowerCaptures_emitNoReuse expr hcaptureRun) + (emitNoReuse_emitOp (by simp [OpNoReuse])) + +private theorem lowerFnBodyNoReuse_succ {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerENoReuse src fuel) : + LowerFnBodyNoReuse src (fuel + 1) := by + intro input drops world body state finalState code hrun + simp only [lowerFnBody] at hrun + obtain ⟨releaseResult, releaseState, hrelease, hafterRelease⟩ := + stateBindRun_ok_inv hrun + rcases releaseResult with ⟨middle, releaseEmit⟩ + obtain ⟨bodyResult, bodyState, hbody, hpure⟩ := + stateBindRun_ok_inv hafterRelease + rcases bodyResult with ⟨output, emit, value⟩ + have hcode : + (releaseEmit ∘ emit) (.ret (value.toAtom output)) = code := by + simpa using congrArg + (fun result : EStateM.Result String LowSt Code => + match result with + | .ok result _ => result + | .error _ _ => .ret .erased) hpure + rw [← hcode] + apply emitNoReuse_comp (releaseSlots_emitNoReuse input hrelease) + (hexpr hbody) + simp [CodeNoReuse] + +private theorem lowerNoReuse_succ {src : IxIR0.Env} {fuel : Nat} + (hprev : LowerNoReuseCluster src fuel) : + LowerNoReuseCluster src (fuel + 1) := + { expr := lowerENoReuse_succ hprev.expr hprev.spine hprev.borrow hprev.lam + borrow := lowerBorrowNoReuse_succ hprev.expr + spine := lowerSpineNoReuse_succ hprev.expr hprev.spine + hprev.knownCall hprev.applyRest + knownCall := knownCallNoReuse_succ hprev.args hprev.applyRest + args := lowerArgsNoReuse_succ hprev.expr hprev.args + applyRest := applyRestNoReuse_succ hprev.args + lam := lowerLamNoReuse_succ + fnBody := lowerFnBodyNoReuse_succ hprev.expr } + +/-- Every successful mutually recursive expression-lowering action emits no +`reuse`, at every compiler fuel. -/ +theorem lowerNoReuse (src : IxIR0.Env) : + ∀ fuel, LowerNoReuseCluster src fuel := by + intro fuel + induction fuel with + | zero => exact lowerNoReuse_zero src + | succ fuel ih => + simpa [Nat.succ_eq_add_one] using lowerNoReuse_succ ih + +/-- Closing a successfully lowered function body with `ret` produces +reuse-free target code. -/ +theorem lowerFnBody_noReuse {src : IxIR0.Env} {fuel : Nat} + {input : VEnv} {drops : List SlotDrop} {world : Ixon.Owned} + {body : IxIR0.Expr} {state finalState : LowSt} {code : Code} + (hrun : (lowerFnBody src fuel input drops world body).run state = + .ok code finalState) : + CodeNoReuse code := + (lowerNoReuse src fuel).fnBody hrun + +/-! ## Generated-declaration state -/ + +theorem requireResultWorld_preservesStateNoReuse + (actual demand : Ixon.Owned) : + PreservesStateNoReuse (requireResultWorld actual demand) := by + cases actual <;> cases demand <;> + simp [requireResultWorld] <;> + first + | exact PreservesStateNoReuse.pure _ + | exact PreservesStateNoReuse.throw _ + +theorem releaseSlots_preservesStateNoReuse (input : VEnv) : + ∀ drops : List SlotDrop, + PreservesStateNoReuse (releaseSlots input drops) := by + exact releaseSlots_action_core + (ActionProperty := fun {α : Type} (action : LowerM α) => + PreservesStateNoReuse action) + (hpure := fun value => PreservesStateNoReuse.pure value) + (hbind := fun haction hnext => + PreservesStateNoReuse.bind haction hnext) + (hthrowBind := fun message next => + PreservesStateNoReuse.throwBind message next) + input + +theorem lowerCapture_preservesStateNoReuse (expr : IxIR0.Expr) + (input : VEnv) (index : Nat) : + PreservesStateNoReuse (lowerCapture expr input index) := by + intro state finalState result hstate hrun + cases hentry : input.entries[index]? with + | none => + exact (stateThrowRun_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | some entry => + cases entry with + | recSelf arity => + exact (stateThrowRun_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | slot abs remaining uses held => + cases held with + | false => + exact (stateThrowRun_not_ok (by + simpa [lowerCapture, hentry] using hrun)).elim + | true => + by_cases hunique : worldOfUses uses = .unique + · have huuEq : + (Ixon.Owned.unique == Ixon.Owned.unique) = true := by + decide + exact (stateThrowRun_not_ok (by + simpa [lowerCapture, hentry, hunique, huuEq] using hrun)).elim + · have huniqueEq : + (worldOfUses uses == Ixon.Owned.unique) = false := by + cases uses <;> simp_all [worldOfUses] <;> decide + by_cases hmore : remaining > countUses index expr + · have hfinal : state = finalState := by + have hfull : + ((input.setEntry index + (.slot abs (remaining - countUses index expr) + uses true)).bump, + emitOp (.dup (.var + ((input.setEntry index + (.slot abs (remaining - countUses index expr) + uses true)).rel abs))), + AVal.slotA + (input.setEntry index + (.slot abs (remaining - countUses index expr) + uses true)).depth) = result ∧ + state = finalState := by + simpa [lowerCapture, hentry, huniqueEq, hmore] using hrun + exact hfull.2 + subst finalState + exact hstate + · by_cases hequal : remaining = countUses index expr + · have hfinal : state = finalState := by + have hfull : + (input.setEntry index (.slot abs 0 uses false), + (_root_.id : Emit), AVal.slotA abs) = result ∧ + state = finalState := by + simpa [lowerCapture, hentry, huniqueEq, hmore, hequal] + using hrun + exact hfull.2 + subst finalState + exact hstate + · exact (stateThrowRun_not_ok (by + simpa [lowerCapture, hentry, huniqueEq, hmore, hequal] + using hrun)).elim + +theorem lowerCaptures_preservesStateNoReuse (expr : IxIR0.Expr) : + ∀ (input : VEnv) (captures : List Nat), + PreservesStateNoReuse (lowerCaptures expr input captures) := by + exact lowerCaptures_action_core + (e := expr) + (ActionProperty := fun {α : Type} (action : LowerM α) => + PreservesStateNoReuse action) + (hpure := fun value => PreservesStateNoReuse.pure value) + (hbind := fun haction hnext => + PreservesStateNoReuse.bind haction hnext) + (hcapture := lowerCapture_preservesStateNoReuse expr) + +def LowerEPreservesStateNoReuse (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ input world expr, + PreservesStateNoReuse (lowerE src fuel input world expr) + +def LowerBorrowPreservesStateNoReuse + (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ input expr, + PreservesStateNoReuse (lowerBorrow src fuel input expr) + +def LowerSpinePreservesStateNoReuse + (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ input world head args, + PreservesStateNoReuse (lowerSpine src fuel input world head args) + +def KnownCallPreservesStateNoReuse + (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ input build count argWorlds resultWorld args, + PreservesStateNoReuse + (knownCall src fuel input build count argWorlds resultWorld args) + +def LowerArgsPreservesStateNoReuse + (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ input args, + PreservesStateNoReuse (lowerArgs src fuel input args) + +def ApplyRestPreservesStateNoReuse + (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ input resultWorld pre function args, + PreservesStateNoReuse + (applyRest src fuel input resultWorld pre function args) + +def LowerLamPreservesStateNoReuse + (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ input expr, + PreservesStateNoReuse (lowerLam src fuel input expr) + +def LowerFnBodyPreservesStateNoReuse + (src : IxIR0.Env) (fuel : Nat) : Prop := + ∀ input drops world body, + PreservesStateNoReuse (lowerFnBody src fuel input drops world body) + +structure LowerStateNoReuseCluster + (src : IxIR0.Env) (fuel : Nat) : Prop where + expr : LowerEPreservesStateNoReuse src fuel + borrow : LowerBorrowPreservesStateNoReuse src fuel + spine : LowerSpinePreservesStateNoReuse src fuel + knownCall : KnownCallPreservesStateNoReuse src fuel + args : LowerArgsPreservesStateNoReuse src fuel + applyRest : ApplyRestPreservesStateNoReuse src fuel + lam : LowerLamPreservesStateNoReuse src fuel + fnBody : LowerFnBodyPreservesStateNoReuse src fuel + +private theorem lowerStateNoReuse_zero (src : IxIR0.Env) : + LowerStateNoReuseCluster src 0 := by + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro input world expr + simp only [lowerE] + exact PreservesStateNoReuse.throw _ + · intro input expr + simp only [lowerBorrow] + exact PreservesStateNoReuse.throw _ + · intro input world head args + simp only [lowerSpine] + exact PreservesStateNoReuse.throw _ + · intro input build count argWorlds resultWorld args + simp only [knownCall] + exact PreservesStateNoReuse.throw _ + · intro input args + simp only [lowerArgs] + exact PreservesStateNoReuse.throw _ + · intro input resultWorld pre function args + simp only [applyRest] + exact PreservesStateNoReuse.throw _ + · intro input expr + simp only [lowerLam] + exact PreservesStateNoReuse.throw _ + · intro input drops world body + simp only [lowerFnBody] + exact PreservesStateNoReuse.throw _ + +private theorem lowerFnBodyPreservesStateNoReuse_succ + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesStateNoReuse src fuel) : + LowerFnBodyPreservesStateNoReuse src (fuel + 1) := by + intro input drops world body + simp only [lowerFnBody] + apply PreservesStateNoReuse.bind + (releaseSlots_preservesStateNoReuse input drops) + intro releaseResult + rcases releaseResult with ⟨middle, releaseEmit⟩ + apply PreservesStateNoReuse.bind (hexpr middle world body) + intro bodyResult + rcases bodyResult with ⟨output, bodyEmit, value⟩ + exact PreservesStateNoReuse.pure + (releaseEmit (bodyEmit (.ret (value.toAtom output)))) + +private theorem lowerLamPreservesStateNoReuse_succ + {src : IxIR0.Env} {fuel : Nat} + (hfnBody : LowerFnBodyPreservesStateNoReuse src fuel) : + LowerLamPreservesStateNoReuse src (fuel + 1) := by + intro input expr initial finalState result hinitial hrun + rcases result with ⟨output, emit, value⟩ + apply LowerSim.lowerLam_run_core + (Result := fun finalState _ _ _ => StateNoReuse finalState) + (hrun := hrun) + intro bodyFuel _captureOutput _captureEmit _captureValues captureState + _fnAddress addressState code bodyState hfuel _hp hcaptureRun + hfreshRun hbodyRun + have hbodyFuel : bodyFuel = fuel := by + exact Nat.add_right_cancel hfuel + subst bodyFuel + have hcaptureState := + lowerCaptures_preservesStateNoReuse expr input _ hinitial hcaptureRun + have haddressState := + freshAddr_preservesStateNoReuse hcaptureState hfreshRun + have hbodyState := hfnBody _ _ _ _ haddressState hbodyRun + have hcode : CodeNoReuse code := lowerFnBody_noReuse hbodyRun + exact hbodyState.prepend hcode + +private theorem lowerArgsPreservesStateNoReuse_succ + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesStateNoReuse src fuel) + (hargs : LowerArgsPreservesStateNoReuse src fuel) : + LowerArgsPreservesStateNoReuse src (fuel + 1) := by + intro input args + cases args with + | nil => + simp only [lowerArgs] + exact PreservesStateNoReuse.pure _ + | cons head rest => + rcases head with ⟨expr, world⟩ + simp only [lowerArgs] + apply PreservesStateNoReuse.bind (hexpr input world expr) + intro headResult + rcases headResult with ⟨middle, headEmit, value⟩ + apply PreservesStateNoReuse.bind (hargs middle rest) + intro tailResult + rcases tailResult with ⟨output, tailEmit, values⟩ + exact PreservesStateNoReuse.pure + (output, headEmit ∘ tailEmit, value :: values) + +private theorem applyRestPreservesStateNoReuse_succ + {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsPreservesStateNoReuse src fuel) : + ApplyRestPreservesStateNoReuse src (fuel + 1) := by + intro input resultWorld pre function args + cases function with + | slotA abs => + simp only [applyRest] + apply PreservesStateNoReuse.bind + (requireResultWorld_preservesStateNoReuse .shared resultWorld) + intro unitValue + cases unitValue + apply PreservesStateNoReuse.bind + (hargs input (args.map (fun arg => (arg, Ixon.Owned.shared)))) + intro argsResult + rcases argsResult with ⟨output, argsEmit, values⟩ + exact PreservesStateNoReuse.pure + (output.bump, + pre ∘ argsEmit ∘ emitOp (.apply + ((AVal.slotA abs).toAtom output) + (values.map (·.toAtom output)).toArray), + AVal.slotA output.depth) + | constA atom => + cases atom with + | erased => + simp only [applyRest] + apply PreservesStateNoReuse.bind + (hargs input (args.map (fun arg => (arg, Ixon.Owned.shared)))) + intro argsResult + rcases argsResult with ⟨output, argsEmit, values⟩ + exact PreservesStateNoReuse.pure + ((releaseAll output values).1, + pre ∘ argsEmit ∘ (releaseAll output values).2, + AVal.constA .erased) + | var relative => + simp only [applyRest] + apply PreservesStateNoReuse.bind + (requireResultWorld_preservesStateNoReuse .shared resultWorld) + intro unitValue + cases unitValue + apply PreservesStateNoReuse.bind + (hargs input (args.map (fun arg => (arg, Ixon.Owned.shared)))) + intro argsResult + rcases argsResult with ⟨output, argsEmit, values⟩ + exact PreservesStateNoReuse.pure + (output.bump, + pre ∘ argsEmit ∘ emitOp (.apply + ((AVal.constA (.var relative)).toAtom output) + (values.map (·.toAtom output)).toArray), + AVal.slotA output.depth) + | lit literal => + simp only [applyRest] + apply PreservesStateNoReuse.bind + (requireResultWorld_preservesStateNoReuse .shared resultWorld) + intro unitValue + cases unitValue + apply PreservesStateNoReuse.bind + (hargs input (args.map (fun arg => (arg, Ixon.Owned.shared)))) + intro argsResult + rcases argsResult with ⟨output, argsEmit, values⟩ + exact PreservesStateNoReuse.pure + (output.bump, + pre ∘ argsEmit ∘ emitOp (.apply + ((AVal.constA (.lit literal)).toAtom output) + (values.map (·.toAtom output)).toArray), + AVal.slotA output.depth) + +private theorem knownCallPreservesStateNoReuse_succ + {src : IxIR0.Env} {fuel : Nat} + (hargs : LowerArgsPreservesStateNoReuse src fuel) + (hrest : ApplyRestPreservesStateNoReuse src fuel) : + KnownCallPreservesStateNoReuse src (fuel + 1) := by + intro input build count argWorlds resultWorld args + simp only [knownCall] + apply PreservesStateNoReuse.bind + (hargs input ((args.take count).zip (padWorlds argWorlds count))) + intro argsResult + rcases argsResult with ⟨output, argsEmit, values⟩ + by_cases hterminal : args.length ≤ count + · simp only [if_pos hterminal] + exact PreservesStateNoReuse.pure + (output.bump, + argsEmit ∘ emitOp + (build (values.map (·.toAtom output)).toArray), + AVal.slotA output.depth) + · simp only [if_neg hterminal] + exact hrest output.bump resultWorld + (argsEmit ∘ emitOp + (build (values.map (·.toAtom output)).toArray)) + (.slotA output.depth) (args.drop count) + +private theorem lowerBorrowVarPreservesStateNoReuse + (src : IxIR0.Env) (fuel : Nat) (input : VEnv) (index : Nat) : + PreservesStateNoReuse + (lowerBorrow src (fuel + 1) input (.var index)) := by + simp only [lowerBorrow] + cases hentry : input.entries[index]? with + | none => exact PreservesStateNoReuse.throw _ + | some entry => + cases entry with + | recSelf arity => exact PreservesStateNoReuse.throw _ + | slot abs remaining uses held => + cases held with + | false => exact PreservesStateNoReuse.throw _ + | true => + cases uses with + | linear => exact PreservesStateNoReuse.throw _ + | affine => exact PreservesStateNoReuse.throw _ + | erased => + cases remaining with + | zero => exact PreservesStateNoReuse.throw _ + | succ remaining => + cases remaining with + | zero => exact PreservesStateNoReuse.pure _ + | succ remaining => exact PreservesStateNoReuse.pure _ + | many => + cases remaining with + | zero => exact PreservesStateNoReuse.throw _ + | succ remaining => + cases remaining with + | zero => exact PreservesStateNoReuse.pure _ + | succ remaining => exact PreservesStateNoReuse.pure _ + +private theorem lowerBorrowDynamicPreservesStateNoReuse + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesStateNoReuse src fuel) + {input : VEnv} {expr : IxIR0.Expr} : + PreservesStateNoReuse (do + let (output, emit, value) ← + lowerE src fuel input .shared expr + let release := + match value with | .slotA _ => true | .constA _ => false + pure (output, emit, value, release)) := by + apply PreservesStateNoReuse.bind (hexpr input .shared expr) + intro exprResult + rcases exprResult with ⟨output, emit, value⟩ + exact PreservesStateNoReuse.pure + (output, emit, value, + match value with | .slotA _ => true | .constA _ => false) + +private theorem lowerBorrowPreservesStateNoReuse_succ + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesStateNoReuse src fuel) : + LowerBorrowPreservesStateNoReuse src (fuel + 1) := by + intro input expr + cases expr with + | var index => + exact (lowerBorrowVarPreservesStateNoReuse src fuel input index) + | ref address => + simp only [lowerBorrow] + exact lowerBorrowDynamicPreservesStateNoReuse hexpr + | app function argument => + simp only [lowerBorrow] + exact lowerBorrowDynamicPreservesStateNoReuse hexpr + | lam uses body => + simp only [lowerBorrow] + exact lowerBorrowDynamicPreservesStateNoReuse hexpr + | letE uses value body => + simp only [lowerBorrow] + exact lowerBorrowDynamicPreservesStateNoReuse hexpr + | proj index value => + simp only [lowerBorrow] + exact lowerBorrowDynamicPreservesStateNoReuse hexpr + | lit literal => + simp only [lowerBorrow] + exact lowerBorrowDynamicPreservesStateNoReuse hexpr + | erased => + simp only [lowerBorrow] + exact lowerBorrowDynamicPreservesStateNoReuse hexpr + +private theorem lowerEVarPreservesStateNoReuse + (src : IxIR0.Env) (fuel : Nat) (input : VEnv) + (world : Ixon.Owned) (index : Nat) : + PreservesStateNoReuse + (lowerE src (fuel + 1) input world (.var index)) := by + simp only [lowerE] + cases hentry : input.entries[index]? with + | none => exact PreservesStateNoReuse.throw _ + | some entry => + cases entry with + | recSelf arity => exact PreservesStateNoReuse.throw _ + | slot abs remaining uses held => + cases held with + | false => exact PreservesStateNoReuse.throw _ + | true => + cases remaining with + | zero => + cases uses <;> cases world <;> + first + | exact PreservesStateNoReuse.pure _ + | exact PreservesStateNoReuse.throw _ + | succ remaining => + cases remaining with + | zero => + cases uses <;> cases world <;> + first + | exact PreservesStateNoReuse.pure _ + | exact PreservesStateNoReuse.throw _ + | succ remaining => + cases uses <;> cases world <;> + first + | exact PreservesStateNoReuse.pure _ + | exact PreservesStateNoReuse.throw _ + +private theorem lowerERefPreservesStateNoReuse + (src : IxIR0.Env) (fuel : Nat) (input : VEnv) + (world : Ixon.Owned) (address : Ixon.Address) : + PreservesStateNoReuse + (lowerE src (fuel + 1) input world (.ref address)) := by + simp only [lowerE] + cases hsource : src address with + | none => + simp only + exact PreservesStateNoReuse.throw _ + | some declaration => + cases declaration with + | defn result body => + simp only + cases harity : lamArity body with + | zero => + apply PreservesStateNoReuse.bind + (requireResultWorld_preservesStateNoReuse result world) + intro unitValue + cases unitValue + exact PreservesStateNoReuse.pure _ + | succ arity => + cases result <;> cases world <;> cases hp : papSafe body <;> + first + | exact PreservesStateNoReuse.pure _ + | exact PreservesStateNoReuse.throw _ + | ctor tag arity => + simp only + cases arity with + | zero => exact PreservesStateNoReuse.pure _ + | succ arity => + cases world with + | unique => exact PreservesStateNoReuse.throw _ + | shared => + apply PreservesStateNoReuse.bind + (wrapperFor_preservesStateNoReuse address tag (arity + 1)) + intro wrapper + exact PreservesStateNoReuse.pure _ + | recursor numArgs natLit rules => + simp only + cases world <;> first + | exact PreservesStateNoReuse.pure _ + | exact PreservesStateNoReuse.throw _ + | extern arity => + simp only + cases arity with + | zero => exact PreservesStateNoReuse.pure _ + | succ arity => + cases world <;> first + | exact PreservesStateNoReuse.pure _ + | exact PreservesStateNoReuse.throw _ + +private theorem lowerELamPreservesStateNoReuse + {src : IxIR0.Env} {fuel : Nat} + (hlam : LowerLamPreservesStateNoReuse src fuel) + (input : VEnv) (world : Ixon.Owned) (uses : Ixon.Uses) + (body : IxIR0.Expr) : + PreservesStateNoReuse + (lowerE src (fuel + 1) input world (.lam uses body)) := by + cases world with + | unique => + simp only [lowerE] + exact PreservesStateNoReuse.throw _ + | shared => + have hsuEq : + (Ixon.Owned.shared == Ixon.Owned.unique) = false := by + decide + intro initial final result hinitial hrun + exact hlam input (.lam uses body) hinitial (by + simpa only [lowerE, hsuEq, Bool.false_eq_true, if_false] using hrun) + +private theorem lowerEProjPreservesStateNoReuse + {src : IxIR0.Env} {fuel : Nat} + (hborrow : LowerBorrowPreservesStateNoReuse src fuel) + (input : VEnv) (world : Ixon.Owned) (index : Nat) + (source : IxIR0.Expr) : + PreservesStateNoReuse + (lowerE src (fuel + 1) input world (.proj index source)) := by + cases world with + | unique => + simp only [lowerE] + exact PreservesStateNoReuse.throw _ + | shared => + simp only [lowerE] + apply PreservesStateNoReuse.bind (hborrow input source) + intro borrowResult + rcases borrowResult with ⟨output, emit, value, release⟩ + cases value with + | slotA abs => + cases release <;> exact PreservesStateNoReuse.pure _ + | constA atom => + cases atom <;> exact PreservesStateNoReuse.pure _ + +private theorem lowerELetPreservesStateNoReuse + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesStateNoReuse src fuel) + (input : VEnv) (world : Ixon.Owned) (uses : Ixon.Uses) + (value body : IxIR0.Expr) : + PreservesStateNoReuse + (lowerE src (fuel + 1) input world (.letE uses value body)) := by + simp only [lowerE] + apply PreservesStateNoReuse.bind + (hexpr input (worldOfUses uses) value) + intro valueResult + rcases valueResult with ⟨middle, valueEmit, boundValue⟩ + cases boundValue with + | slotA abs => + by_cases hzero : countUses 0 body = 0 + · simp only [hzero, beq_self_eq_true, if_true] + cases uses with + | erased => exact PreservesStateNoReuse.throwBind _ _ + | linear => exact PreservesStateNoReuse.throwBind _ _ + | affine => + apply PreservesStateNoReuse.bind + (PreservesStateNoReuse.pure _) + intro releaseEmit + apply PreservesStateNoReuse.bind (hexpr _ world body) + intro bodyResult + rcases bodyResult with ⟨output, bodyEmit, result⟩ + exact PreservesStateNoReuse.pure + (output.pop, valueEmit ∘ releaseEmit ∘ bodyEmit, result) + | many => + apply PreservesStateNoReuse.bind + (PreservesStateNoReuse.pure _) + intro releaseEmit + apply PreservesStateNoReuse.bind (hexpr _ world body) + intro bodyResult + rcases bodyResult with ⟨output, bodyEmit, result⟩ + exact PreservesStateNoReuse.pure + (output.pop, valueEmit ∘ releaseEmit ∘ bodyEmit, result) + · simp [hzero] + apply PreservesStateNoReuse.bind (hexpr _ world body) + intro bodyResult + rcases bodyResult with ⟨output, bodyEmit, result⟩ + exact PreservesStateNoReuse.pure + (output.pop, valueEmit ∘ bodyEmit, result) + | constA atom => + by_cases hzero : countUses 0 body = 0 + · simp only [hzero, beq_self_eq_true, if_true] + apply PreservesStateNoReuse.bind (hexpr _ world body) + intro bodyResult + rcases bodyResult with ⟨output, bodyEmit, result⟩ + exact PreservesStateNoReuse.pure + (output.pop, + valueEmit ∘ emitOp (.pure atom) ∘ bodyEmit, result) + · simp [hzero] + apply PreservesStateNoReuse.bind (hexpr _ world body) + intro bodyResult + rcases bodyResult with ⟨output, bodyEmit, result⟩ + exact PreservesStateNoReuse.pure + (output.pop, + valueEmit ∘ emitOp (.pure atom) ∘ bodyEmit, result) + +private theorem lowerEPreservesStateNoReuse_succ + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesStateNoReuse src fuel) + (hspine : LowerSpinePreservesStateNoReuse src fuel) + (hborrow : LowerBorrowPreservesStateNoReuse src fuel) + (hlam : LowerLamPreservesStateNoReuse src fuel) : + LowerEPreservesStateNoReuse src (fuel + 1) := by + intro input world expr + cases expr with + | var index => + exact (lowerEVarPreservesStateNoReuse src fuel input world index) + | ref address => + exact (lowerERefPreservesStateNoReuse src fuel input world address) + | lit literal => + simp only [lowerE] + exact PreservesStateNoReuse.pure _ + | erased => + simp only [lowerE] + exact PreservesStateNoReuse.pure _ + | lam uses body => + exact (lowerELamPreservesStateNoReuse hlam input world uses body) + | letE uses value body => + exact (lowerELetPreservesStateNoReuse + hexpr input world uses value body) + | app function argument => + simp only [lowerE] + exact hspine input world function [argument] + | proj index source => + exact (lowerEProjPreservesStateNoReuse + hborrow input world index source) + +private theorem lowerSpineDynamicPreservesStateNoReuse + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesStateNoReuse src fuel) + (hrest : ApplyRestPreservesStateNoReuse src fuel) + (input : VEnv) (world : Ixon.Owned) (head : IxIR0.Expr) + (args : List IxIR0.Expr) : + PreservesStateNoReuse (do + let (output, emit, function) ← + lowerE src fuel input .shared head + applyRest src fuel output world emit function args) := by + apply PreservesStateNoReuse.bind (hexpr input .shared head) + intro headResult + rcases headResult with ⟨output, emit, function⟩ + exact hrest output world emit function args + +private theorem lowerSpineVarPreservesStateNoReuse + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesStateNoReuse src fuel) + (hknown : KnownCallPreservesStateNoReuse src fuel) + (hrest : ApplyRestPreservesStateNoReuse src fuel) + (input : VEnv) (world : Ixon.Owned) (index : Nat) + (args : List IxIR0.Expr) : + PreservesStateNoReuse + (lowerSpine src (fuel + 1) input world (.var index) args) := by + simp only [lowerSpine] + cases hentry : input.entries[index]? with + | none => + simp only + exact lowerSpineDynamicPreservesStateNoReuse + hexpr hrest input world (.var index) args + | some entry => + cases entry with + | slot abs remaining uses held => + simp only + exact lowerSpineDynamicPreservesStateNoReuse + hexpr hrest input world (.var index) args + | recSelf arity => + simp only + by_cases hunder : args.length < arity + · simp only [if_pos hunder] + exact PreservesStateNoReuse.throw _ + · simp only [if_neg hunder] + apply PreservesStateNoReuse.bind + (requireResultWorld_preservesStateNoReuse .shared world) + intro unitValue + cases unitValue + exact hknown input (.callSelf ·) arity + (List.replicate arity .shared) world args + +private theorem lowerSpineRefPreservesStateNoReuse + {src : IxIR0.Env} {fuel : Nat} + (hknown : KnownCallPreservesStateNoReuse src fuel) + (input : VEnv) (world : Ixon.Owned) (address : Ixon.Address) + (args : List IxIR0.Expr) : + PreservesStateNoReuse + (lowerSpine src (fuel + 1) input world (.ref address) args) := by + simp only [lowerSpine] + cases hsource : src address with + | none => + simp only + exact PreservesStateNoReuse.throw _ + | some declaration => + cases declaration with + | defn result body => + simp only + by_cases hunder : args.length < lamArity body + · simp only [if_pos hunder] + cases world with + | unique => exact PreservesStateNoReuse.throw _ + | shared => + cases result with + | unique => exact PreservesStateNoReuse.throw _ + | shared => + cases hp : papSafe body with + | false => exact PreservesStateNoReuse.throw _ + | true => + exact hknown input (.papp address ·) args.length + (List.replicate args.length .shared) .shared args + · simp only [if_neg hunder] + apply PreservesStateNoReuse.bind + (requireResultWorld_preservesStateNoReuse result + (if args.length == lamArity body then world else .shared)) + intro unitValue + cases unitValue + exact hknown input (.call address ·) (lamArity body) + ((lamUses body).map worldOfUses) world args + | ctor tag arity => + simp only + by_cases hunder : args.length < arity + · simp only [if_pos hunder] + cases world with + | unique => exact PreservesStateNoReuse.throw _ + | shared => + apply PreservesStateNoReuse.bind + (wrapperFor_preservesStateNoReuse address tag arity) + intro wrapper + exact hknown input (.papp wrapper ·) args.length + (List.replicate args.length .shared) .shared args + · simp only [if_neg hunder] + exact hknown input (.alloc world (ctorIdOf address tag) ·) arity + (List.replicate arity world) world args + | recursor numArgs natLit rules => + simp only + by_cases hunder : args.length < numArgs + 1 + · simp only [if_pos hunder] + cases world with + | unique => exact PreservesStateNoReuse.throw _ + | shared => + exact hknown input (.papp address ·) args.length + (List.replicate args.length .shared) .shared args + · simp only [if_neg hunder] + apply PreservesStateNoReuse.bind + (requireResultWorld_preservesStateNoReuse .shared world) + intro unitValue + cases unitValue + exact hknown input (.call address ·) (numArgs + 1) + (List.replicate (numArgs + 1) .shared) world args + | extern arity => + simp only + by_cases hunder : args.length < arity + · simp only [if_pos hunder] + cases world with + | unique => exact PreservesStateNoReuse.throw _ + | shared => + exact hknown input (.papp address ·) args.length + (List.replicate args.length .shared) .shared args + · simp only [if_neg hunder] + exact hknown input (.extern address ·) arity + (List.replicate arity .shared) world args + +private theorem lowerSpinePreservesStateNoReuse_succ + {src : IxIR0.Env} {fuel : Nat} + (hexpr : LowerEPreservesStateNoReuse src fuel) + (hspine : LowerSpinePreservesStateNoReuse src fuel) + (hknown : KnownCallPreservesStateNoReuse src fuel) + (hrest : ApplyRestPreservesStateNoReuse src fuel) : + LowerSpinePreservesStateNoReuse src (fuel + 1) := by + intro input world head args + cases head with + | app function argument => + simp only [lowerSpine] + exact hspine input world function (argument :: args) + | erased => + simp only [lowerSpine] + exact hrest input world (_root_.id : Emit) (.constA .erased) args + | var index => + exact (lowerSpineVarPreservesStateNoReuse + hexpr hknown hrest input world index args) + | ref address => + exact (lowerSpineRefPreservesStateNoReuse + hknown input world address args) + | lam uses body => + simp only [lowerSpine] + exact lowerSpineDynamicPreservesStateNoReuse + hexpr hrest input world (.lam uses body) args + | letE uses value body => + simp only [lowerSpine] + exact lowerSpineDynamicPreservesStateNoReuse + hexpr hrest input world (.letE uses value body) args + | proj index source => + simp only [lowerSpine] + exact lowerSpineDynamicPreservesStateNoReuse + hexpr hrest input world (.proj index source) args + | lit literal => + simp only [lowerSpine] + exact lowerSpineDynamicPreservesStateNoReuse + hexpr hrest input world (.lit literal) args + +private theorem lowerStateNoReuse_succ + {src : IxIR0.Env} {fuel : Nat} + (hprev : LowerStateNoReuseCluster src fuel) : + LowerStateNoReuseCluster src (fuel + 1) := + { expr := lowerEPreservesStateNoReuse_succ + hprev.expr hprev.spine hprev.borrow hprev.lam + borrow := lowerBorrowPreservesStateNoReuse_succ hprev.expr + spine := lowerSpinePreservesStateNoReuse_succ + hprev.expr hprev.spine hprev.knownCall hprev.applyRest + knownCall := knownCallPreservesStateNoReuse_succ + hprev.args hprev.applyRest + args := lowerArgsPreservesStateNoReuse_succ hprev.expr hprev.args + applyRest := applyRestPreservesStateNoReuse_succ hprev.args + lam := lowerLamPreservesStateNoReuse_succ hprev.fnBody + fnBody := lowerFnBodyPreservesStateNoReuse_succ hprev.expr } + +/-- Every lowering-cluster action preserves reuse-freedom of the accumulated +generated declarations. -/ +theorem lowerStateNoReuse (src : IxIR0.Env) : + ∀ fuel, LowerStateNoReuseCluster src fuel := by + intro fuel + induction fuel with + | zero => exact lowerStateNoReuse_zero src + | succ fuel ih => + simpa [Nat.succ_eq_add_one] using lowerStateNoReuse_succ ih + +private theorem fieldRetainPlan_emitNoReuse + {input output : VEnv} {retains : List RecursorFieldRetain} + {emit : Emit} + (hplan : LowerSim.FieldRetainPlan input retains output emit) : + EmitNoReuse emit := by + induction hplan with + | nil => exact emitNoReuse_id + | retain hentry tail ih => + exact emitNoReuse_comp + (emitNoReuse_emitOp (by simp [OpNoReuse])) ih + +private theorem releasePlan_emitNoReuse + {input output : VEnv} {drops : List SlotDrop} {emit : Emit} + (hplan : LowerSim.ReleasePlan input drops output emit) : + EmitNoReuse emit := by + induction hplan with + | nil => exact emitNoReuse_id + | many hentry tail ih => + exact emitNoReuse_comp + (emitNoReuse_emitOp (by simp [OpNoReuse])) ih + | affine hentry tail ih => + exact emitNoReuse_comp + (emitNoReuse_emitOp (by simp [OpNoReuse])) ih + +/-- Every successfully generated recursor alternative is reuse-free. -/ +theorem lowerRecursorRule_noReuse + {src : IxIR0.Env} {fuel numArgs : Nat} + {rule : IxIR0.RecRule} {tag : Nat} + {state finalState : LowSt} {alternative : Alt} + (hrun : (lowerRecursorRule src fuel numArgs (rule, tag)).run state = + .ok alternative finalState) : + AltNoReuse alternative := by + obtain ⟨fieldOutput, fieldEmit, rhsInput, parameterEmit, + output, bodyEmit, value, hfield, hparameter, hbody, hshape⟩ := + LowerSim.lowerRecursorRule_run_plan_inv hrun + subst alternative + simp only [AltNoReuse] + exact fieldRetainPlan_emitNoReuse hfield _ + ((emitNoReuse_emitOp (op := .drop (.var (fieldOutput.rel numArgs))) + (by simp [OpNoReuse])) _ + (releasePlan_emitNoReuse hparameter _ + (((lowerNoReuse src fuel).expr hbody) _ + (by simp [CodeNoReuse])))) + +theorem lowerRecursorRule_preservesStateNoReuse + (src : IxIR0.Env) (fuel numArgs : Nat) + (item : IxIR0.RecRule × Nat) : + PreservesStateNoReuse (lowerRecursorRule src fuel numArgs item) := by + intro initial finalState alternative hinitial hrun + rcases item with ⟨rule, tag⟩ + obtain ⟨fieldOutput, fieldEmit, rhsInput, parameterEmit, + output, bodyEmit, value, hfield, hparameter, hbody, hshape⟩ := + LowerSim.lowerRecursorRule_run_plan_inv hrun + exact (lowerStateNoReuse src fuel).expr rhsInput .shared rule.rhs + hinitial hbody + +private theorem listMapM_altNoReuse {α : Type} + (action : α → LowerM Alt) + (haction : ∀ item {initial finalState alternative}, + (action item).run initial = .ok alternative finalState → + AltNoReuse alternative) : + ∀ (items : List α) {initial finalState : LowSt} + {alternatives : List Alt}, + (items.mapM action).run initial = .ok alternatives finalState → + ∀ alternative ∈ alternatives, AltNoReuse alternative := by + intro items + induction items with + | nil => + intro initial finalState alternatives hrun alternative hmember + have hpure : ([] : List Alt) = alternatives ∧ + initial = finalState := by + simpa using hrun + rw [← hpure.1] at hmember + simp at hmember + | cons head tail ih => + intro initial finalState alternatives hrun alternative hmember + simp only [List.mapM_cons] at hrun + obtain ⟨headAlt, middle, hhead, hafterHead⟩ := + stateBindRun_ok_inv hrun + obtain ⟨tailAlts, tailState, htail, hpure⟩ := + stateBindRun_ok_inv hafterHead + have hresult : headAlt :: tailAlts = alternatives ∧ + tailState = finalState := by + simpa using hpure + rw [← hresult.1] at hmember + simp only [List.mem_cons] at hmember + cases hmember with + | inl hselected => + subst alternative + exact haction head hhead + | inr hselected => exact ih htail alternative hselected + +theorem lowerRecursor_preservesStateNoReuse + (src : IxIR0.Env) (fuel numArgs : Nat) (natLit : Bool) + (rules : Array IxIR0.RecRule) : + PreservesStateNoReuse + (lowerRecursor src fuel numArgs natLit rules) := by + simp only [lowerRecursor] + apply PreservesStateNoReuse.bind + (PreservesStateNoReuse.listMapM + (lowerRecursorRule src fuel numArgs) + (lowerRecursorRule_preservesStateNoReuse src fuel numArgs) + rules.toList.zipIdx) + intro alternatives + exact PreservesStateNoReuse.pure + (⟨numArgs + 1, .shared, true, + .case (.var 0) natLit alternatives.toArray⟩ : FnDef) + +/-- A successfully lowered recursor has reuse-free alternatives. -/ +theorem lowerRecursor_noReuse + {src : IxIR0.Env} {fuel numArgs : Nat} {natLit : Bool} + {rules : Array IxIR0.RecRule} {state finalState : LowSt} + {definition : FnDef} + (hrun : (lowerRecursor src fuel numArgs natLit rules).run state = + .ok definition finalState) : + CodeNoReuse definition.body := by + obtain ⟨alternatives, halts, hdefinition⟩ := stateMapRun_ok_inv (by + simpa [lowerRecursor] using hrun) + have hall := listMapM_altNoReuse + (lowerRecursorRule src fuel numArgs) + (fun item _ _ _ hrun => lowerRecursorRule_noReuse hrun) + rules.toList.zipIdx halts + cases hdefinition + simp only [CodeNoReuse] + intro alternative hmember + exact hall alternative (by simpa using hmember) + +def OptionDeclNoReuse : Option (Ixon.Address × Decl) → Prop + | none => True + | some item => DeclNoReuse item.2 + +theorem lowerDecl_preservesStateNoReuse + (src : IxIR0.Env) (fuel : Nat) : + ∀ item, PreservesStateNoReuse (lowerDecl src fuel item) + | (address, .defn result body) => by + simp only [lowerDecl] + apply PreservesStateNoReuse.bind + ((lowerStateNoReuse src fuel).fnBody _ _ result _) + intro code + exact PreservesStateNoReuse.pure + (some (address, Decl.fn ⟨lamArity body, result, + result == .shared && papSafe body, code⟩)) + | (_, .ctor tag arity) => by + simp only [lowerDecl] + exact PreservesStateNoReuse.pure + (none : Option (Ixon.Address × Decl)) + | (address, .recursor numArgs natLit rules) => by + simp only [lowerDecl] + apply PreservesStateNoReuse.bind + (lowerRecursor_preservesStateNoReuse + src fuel numArgs natLit rules) + intro definition + exact PreservesStateNoReuse.pure + (some (address, Decl.fn definition)) + | (address, .extern arity) => by + simp only [lowerDecl] + exact PreservesStateNoReuse.pure + (some (address, Decl.extern arity)) + +/-- Every optional base declaration returned by `lowerDecl` is reuse-free. -/ +theorem lowerDecl_noReuse + {src : IxIR0.Env} {fuel : Nat} + {item : Ixon.Address × IxIR0.Decl} {state finalState : LowSt} + {output : Option (Ixon.Address × Decl)} + (hrun : (lowerDecl src fuel item).run state = + .ok output finalState) : + OptionDeclNoReuse output := by + rcases item with ⟨address, declaration⟩ + cases declaration with + | defn result body => + obtain ⟨code, hbody, houtput⟩ := stateMapRun_ok_inv (by + simpa [lowerDecl] using hrun) + cases houtput + exact lowerFnBody_noReuse hbody + | ctor tag arity => + have hpure : none = output ∧ state = finalState := by + simpa [lowerDecl] using hrun + rw [← hpure.1] + simp [OptionDeclNoReuse] + | recursor numArgs natLit rules => + obtain ⟨definition, hrecursor, houtput⟩ := stateMapRun_ok_inv (by + simpa [lowerDecl] using hrun) + cases houtput + exact lowerRecursor_noReuse hrecursor + | extern arity => + have hpure : some (address, Decl.extern arity) = output ∧ + state = finalState := by + simpa [lowerDecl] using hrun + rw [← hpure.1] + simp [OptionDeclNoReuse, DeclNoReuse] + +theorem DeclListNoReuse.append + {left right : List (Ixon.Address × Decl)} + (hleft : DeclListNoReuse left) + (hright : DeclListNoReuse right) : + DeclListNoReuse (left ++ right) := by + intro declaration hmember + rw [List.mem_append] at hmember + cases hmember with + | inl hleftMember => exact hleft declaration hleftMember + | inr hrightMember => exact hright declaration hrightMember + +private theorem listFilterMapM_declNoReuse {α : Type} + (action : α → LowerM (Option (Ixon.Address × Decl))) + (haction : ∀ item {initial finalState output}, + (action item).run initial = .ok output finalState → + OptionDeclNoReuse output) : + ∀ (items : List α) {initial finalState : LowSt} + {declarations : List (Ixon.Address × Decl)}, + (items.filterMapM action).run initial = + .ok declarations finalState → + DeclListNoReuse declarations := by + intro items + induction items with + | nil => + intro initial finalState declarations hrun + have hpure : ([] : List (Ixon.Address × Decl)) = declarations ∧ + initial = finalState := by + simpa using hrun + intro declaration hmember + rw [← hpure.1] at hmember + simp at hmember + | cons head tail ih => + intro initial finalState declarations hrun + rw [List.filterMapM_cons] at hrun + obtain ⟨headOutput, middle, hhead, hafterHead⟩ := + stateBindRun_ok_inv hrun + have hheadNo := haction head hhead + cases headOutput with + | none => + exact ih (by simpa only using hafterHead) + | some headDeclaration => + obtain ⟨tailDeclarations, tailState, htail, hpure⟩ := + stateBindRun_ok_inv hafterHead + have hresult : headDeclaration :: tailDeclarations = declarations ∧ + tailState = finalState := by + simpa [Function.comp_def] using hpure + intro declaration hmember + rw [← hresult.1] at hmember + simp only [List.mem_cons] at hmember + cases hmember with + | inl hselected => + subst declaration + exact hheadNo + | inr hselected => exact ih htail declaration hselected + +theorem lowerDecls_preservesStateNoReuse + (src : IxIR0.Env) (fuel : Nat) + (declarations : List (Ixon.Address × IxIR0.Decl)) : + PreservesStateNoReuse + (declarations.filterMapM (lowerDecl src fuel)) := + PreservesStateNoReuse.listFilterMapM (lowerDecl src fuel) + (lowerDecl_preservesStateNoReuse src fuel) declarations + +theorem lowerDecls_noReuse + {src : IxIR0.Env} {fuel : Nat} + {inputs : List (Ixon.Address × IxIR0.Decl)} + {state finalState : LowSt} + {declarations : List (Ixon.Address × Decl)} + (hrun : (inputs.filterMapM (lowerDecl src fuel)).run state = + .ok declarations finalState) : + DeclListNoReuse declarations := + listFilterMapM_declNoReuse (lowerDecl src fuel) + (fun _item _ _ _ hrun => lowerDecl_noReuse hrun) inputs hrun + +/-- Every declaration and the closed main body returned by a successful +whole-program lowering run are reuse-free; the final generated state carries +the same invariant. -/ +theorem lowerAllAction_noReuse + {declarations : List (Ixon.Address × IxIR0.Decl)} + {main : IxIR0.Expr} {mainWorld : Ixon.Owned} {fuel : Nat} + {targetDeclarations : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : LowSt} + (hrun : (lowerAllAction declarations main mainWorld fuel).run {} = + .ok (targetDeclarations, mainCode) finalState) : + DeclListNoReuse targetDeclarations ∧ + CodeNoReuse mainCode ∧ StateNoReuse finalState := by + let src := IxIR0.Env.ofList declarations + simp only [lowerAllAction] at hrun + obtain ⟨base, baseState, hbase, hafterBase⟩ := + stateBindRun_ok_inv hrun + obtain ⟨compiledMain, mainState, hmain, hafterMain⟩ := + stateBindRun_ok_inv hafterBase + obtain ⟨observed, getState, hget, hpure⟩ := + stateBindRun_ok_inv hafterMain + have hgetState : mainState = observed ∧ mainState = getState := by + simpa using hget + have hresult : + (base ++ observed.extra, compiledMain) = + (targetDeclarations, mainCode) ∧ + getState = finalState := by + simpa using hpure + have hbaseNo : DeclListNoReuse base := by + apply lowerDecls_noReuse hbase + have hbaseState : StateNoReuse baseState := by + apply lowerDecls_preservesStateNoReuse src fuel declarations + StateNoReuse.empty + simpa [src] using hbase + have hmainNo : CodeNoReuse compiledMain := lowerFnBody_noReuse hmain + have hmainState : StateNoReuse mainState := + (lowerStateNoReuse src fuel).fnBody ⟨[], 0⟩ [] mainWorld main + hbaseState hmain + have hdeclsEq : base ++ mainState.extra = targetDeclarations := by + rw [hgetState.1] + exact congrArg Prod.fst hresult.1 + have hmainEq : compiledMain = mainCode := + congrArg Prod.snd hresult.1 + have hfinalEq : mainState = finalState := + hgetState.2.trans hresult.2 + refine ⟨?_, ?_, ?_⟩ + · rw [← hdeclsEq] + exact hbaseNo.append hmainState + · rwa [← hmainEq] + · rwa [← hfinalEq] + +private theorem envOfList_some_mem + {entries : List (Ixon.Address × Decl)} {address : Ixon.Address} + {declaration : Decl} + (hlookup : Env.ofList entries address = some declaration) : + (address, declaration) ∈ entries := by + unfold Env.ofList at hlookup + obtain ⟨entry, hfind, hvalue⟩ := + Option.map_eq_some_iff.mp hlookup + rcases entry with ⟨entryAddress, entryDeclaration⟩ + have hbeq : entryAddress == address := + List.find?_some + (p := fun entry : Ixon.Address × Decl => entry.1 == address) hfind + have haddress : entryAddress = address := + Ixon.Address.eq_of_beq hbeq + have hdeclaration : entryDeclaration = declaration := by + simpa using hvalue + subst entryAddress + subst entryDeclaration + exact List.mem_of_find?_eq_some hfind + +/-- A declaration-list environment is reuse-free whenever every declaration +in the backing list is reuse-free. -/ +theorem ctxOfList_noReuse + {declarations : List (Ixon.Address × Decl)} + {oracle : Ixon.Address → List RVal → Option RVal} + (hdeclarations : DeclListNoReuse declarations) : + CtxNoReuse + ({ decls := Env.ofList declarations, oracle := oracle } : Ctx) := by + intro address definition hlookup + exact hdeclarations (address, .fn definition) + (envOfList_some_mem hlookup) + +/-- The exact declaration-list context returned by a successful whole pass is +reuse-free, including every lifted body and constructor wrapper accumulated in +the final compiler state. -/ +theorem lowerAllAction_ctxNoReuse + {declarations : List (Ixon.Address × IxIR0.Decl)} + {main : IxIR0.Expr} {mainWorld : Ixon.Owned} {compilerFuel : Nat} + {targetDeclarations : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : LowSt} {ctx : Ctx} + (hlower : + (lowerAllAction declarations main mainWorld compilerFuel).run {} = + .ok (targetDeclarations, mainCode) finalState) + (hdecls : ctx.decls = Env.ofList targetDeclarations) : + CtxNoReuse ctx := by + have houtput := lowerAllAction_noReuse hlower + intro address definition hlookup + rw [hdecls] at hlookup + exact houtput.1 (address, .fn definition) + (envOfList_some_mem hlookup) + +/-- The actual whole-pass output instantiates `CostRefinement` with the exact +equation `reuses = 0`. The source run and value graph remain semantically +relevant to the interface but are intentionally absent from the counter +proof. -/ +theorem lowerAllAction_reuseCostRefinement + {sourceCtx : IxIR0.Ctx} {funRel : Sim.FunctionRel} + {declarations : List (Ixon.Address × IxIR0.Decl)} + {main : IxIR0.Expr} {mainWorld : Ixon.Owned} {compilerFuel : Nat} + {targetDeclarations : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : LowSt} {ctx : Ctx} + (hlower : + (lowerAllAction declarations main mainWorld compilerFuel).run {} = + .ok (targetDeclarations, mainCode) finalState) + (hdecls : ctx.decls = Env.ofList targetDeclarations) : + LowerSim.CostRefinement sourceCtx ctx main mainCode funRel + (fun _ observation => ReuseFreeCostSpec observation) := by + apply LowerSim.RunCostInvariant.costRefinement + exact runCostInvariant_of_noReuse + (lowerAllAction_ctxNoReuse hlower hdecls) + (lowerAllAction_noReuse hlower).2.1 + +/-- The whole-pass output satisfies the current lowerer's combined counter +contract: `reuses = 0 ∧ frees ≤ allocs`. -/ +theorem lowerAllAction_costRefinement + {sourceCtx : IxIR0.Ctx} {funRel : Sim.FunctionRel} + {declarations : List (Ixon.Address × IxIR0.Decl)} + {main : IxIR0.Expr} {mainWorld : Ixon.Owned} {compilerFuel : Nat} + {targetDeclarations : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : LowSt} {ctx : Ctx} + (hlower : + (lowerAllAction declarations main mainWorld compilerFuel).run {} = + .ok (targetDeclarations, mainCode) finalState) + (hdecls : ctx.decls = Env.ofList targetDeclarations) : + LowerSim.CostRefinement sourceCtx ctx main mainCode funRel + (fun _ observation => CurrentLowererCostSpec observation) := by + apply LowerSim.RunCostInvariant.costRefinement + exact runCostInvariant_of_noReuse_with_allocationFree + (lowerAllAction_ctxNoReuse hlower hdecls) + (lowerAllAction_noReuse hlower).2.1 + +/-- The actual transient lowerer satisfies `LowerSim.Reclamation`: every +successful compiled-main execution can release its result and reach a store +with no live nodes. -/ +theorem lowerAllAction_reclamation + {declarations : List (Ixon.Address × IxIR0.Decl)} + {main : IxIR0.Expr} {mainWorld : Ixon.Owned} {compilerFuel : Nat} + {targetDeclarations : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : LowSt} {ctx : Ctx} + (hlower : + (lowerAllAction declarations main mainWorld compilerFuel).run {} = + .ok (targetDeclarations, mainCode) finalState) + (hdecls : ctx.decls = Env.ofList targetDeclarations) + (hrepresented : LowerSim.ExtraRepresented ctx finalState) + (hcontracts : + LowerSim.CompilerContracts (IxIR0.Env.ofList declarations) ctx) : + LowerSim.Reclamation ctx mainCode mainWorld := by + have houtput := lowerAllAction_noReuse hlower + have hctx : CtxNoReuse ctx := + lowerAllAction_ctxNoReuse hlower hdecls + apply LowerSim.reclamation_of_run_ownership_and_zero_reuses + · intro runFuel store value hrun + exact LowerSim.lowerAllAction_main_owned hlower hrepresented hcontracts + hrun + · intro runFuel store value hrun + exact runMain_reuses_eq_zero hctx houtput.2.1 hrun + +end Ix.Compiler.IxIR1.NoReuse diff --git a/Ix/Compiler/IxIR1/NoReuseAddressed.lean b/Ix/Compiler/IxIR1/NoReuseAddressed.lean new file mode 100644 index 000000000..a9a4f5496 --- /dev/null +++ b/Ix/Compiler/IxIR1/NoReuseAddressed.lean @@ -0,0 +1,325 @@ +import Ix.Compiler.IxIR1.NoReuse +import Ix.Compiler.IxIR1.LowerFullyAddressedSim + +/-! +# Reclamation across IxIR₁ address normalization + +Address normalization rewrites only declaration identities stored in code and +pap/constructor nodes. Locations, ownership counts, release behavior, and the +live-node metric are unchanged. This module transports the transient +lowerer's reclamation theorem to both content-addressed production boundaries. +-/ + +namespace Ix.Compiler.IxIR1.NoReuse + +open Ix.Compiler.IxIR1 + +@[simp] theorem storeMapAddresses_live + (rename : Ixon.Address → Ixon.Address) (store : Store) : + (Readdress.Store.mapAddresses rename store).live = store.live := by + simp only [Store.live, Readdress.Store.mapAddresses] + rw [Array.foldl_map] + simp + +/-- Reclamation is equivariant under every address renaming accepted by the +evaluator context relation. Address normalization changes declaration +identities beneath code and heap nodes, but leaves locations, result values, +release behavior, and the live-node count intact. -/ +theorem reclamation_mapAddresses + {rename : Ixon.Address → Ixon.Address} + {before after : Ctx} {code : Code} {world : Ixon.Owned} + (hcontexts : Readdress.Ctx.Renames rename before after) + (hreclamation : LowerSim.Reclamation before code world) : + LowerSim.Reclamation after + (Readdress.Code.mapAddresses rename code) world := by + intro runFuel mappedStore value hmappedRun + have htransport := + Readdress.runMain_mapAddresses hcontexts code runFuel + rw [hmappedRun] at htransport + cases hraw : runMain before code runFuel with + | error error => + rw [hraw] at htransport + contradiction + | ok output => + rcases output with ⟨rawStore, rawValue⟩ + rw [hraw] at htransport + have hresult : + mappedStore = Readdress.Store.mapAddresses rename rawStore ∧ + value = rawValue := by + simpa only [Readdress.mapRunResult_ok, Except.ok.injEq, + Prod.mk.injEq] using htransport + rcases hresult with ⟨hstore, hvalue⟩ + subst mappedStore + subst value + obtain ⟨releaseFuel, released, hrelease, hlive⟩ := + hreclamation hraw + refine ⟨releaseFuel, + Readdress.Store.mapAddresses rename released, ?_, ?_⟩ + · cases world with + | shared => + have hrelease' : + dropVal before releaseFuel rawStore rawValue = + .ok released := by + simpa [LowerSim.releaseResult] using hrelease + simp only [LowerSim.releaseResult] + rw [(Readdress.evalTransportAt hcontexts releaseFuel).dropVal, + hrelease'] + rfl + | unique => + have hrelease' : + dropUVal before releaseFuel rawStore rawValue = + .ok released := by + simpa [LowerSim.releaseResult] using hrelease + simp only [LowerSim.releaseResult] + rw [(Readdress.evalTransportAt hcontexts releaseFuel).dropUVal, + hrelease'] + rfl + · simpa using hlive + +/-- Every result-independent counter invariant survives a compatible address +renaming. The successful addressed run has the exact mapped raw store, and +`costObservation` ignores the address-bearing contents of its nodes. -/ +theorem runCostInvariant_mapAddresses + {rename : Ixon.Address → Ixon.Address} + {before after : Ctx} {code : Code} + {spec : LowerSim.CostObservation → Prop} + (hcontexts : Readdress.Ctx.Renames rename before after) + (hcost : LowerSim.RunCostInvariant before code spec) : + LowerSim.RunCostInvariant after + (Readdress.Code.mapAddresses rename code) spec := by + intro targetFuel mappedStore value hmappedRun + have htransport := + Readdress.runMain_mapAddresses hcontexts code targetFuel + rw [hmappedRun] at htransport + cases hraw : runMain before code targetFuel with + | error error => + rw [hraw] at htransport + contradiction + | ok output => + rcases output with ⟨rawStore, rawValue⟩ + rw [hraw] at htransport + have hresult : + mappedStore = Readdress.Store.mapAddresses rename rawStore ∧ + value = rawValue := by + simpa only [Readdress.mapRunResult_ok, Except.ok.injEq, + Prod.mk.injEq] using htransport + rcases hresult with ⟨hstore, hvalue⟩ + subst mappedStore + subst value + simpa using hcost hraw + +/-- The SCC-aware production boundary preserves any reclamation theorem +established for its certified pre-address execution context. -/ +theorem lowerAllFullyAddressed_reclamation_of_raw + {declarations : List (Ixon.Address × IxIR0.Decl)} + {main : IxIR0.Expr} {mainWorld : Ixon.Owned} {compilerFuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : Lower.LowSt} {result : ReaddressAll.Result} + (hlower : + (Lower.lowerAllAction declarations main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState) + (haddressed : + Lower.lowerAllFullyAddressed declarations main mainWorld compilerFuel = + .ok result) + (oracle : Ixon.Address → List RVal → Option RVal) + (hraw : LowerSim.Reclamation + (result.preAddressCtx raw oracle) mainCode mainWorld) : + LowerSim.Reclamation (result.addressedCtx oracle) result.main + mainWorld := by + have hrun := + Lower.readdressAll_run_of_lowerAllFullyAddressed_eq_ok + hlower haddressed + have haudit := ReaddressAll.semanticAudit_of_run_eq_ok hrun + rw [result.main_eq_mapAddresses haudit] + apply reclamation_mapAddresses + (result.renames_preAddressCtx haudit oracle) + exact hraw + +/-- Indexed-production analogue of +`lowerAllFullyAddressed_reclamation_of_raw`. -/ +theorem lowerAllIndexedFullyAddressed_reclamation_of_raw + {declarations : List (Ixon.Address × IxIR0.Decl)} + {main : IxIR0.Expr} {mainWorld : Ixon.Owned} {compilerFuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : Lower.LowSt} {result : ReaddressAll.Result} + (hlower : + (Lower.lowerAllIndexedAction declarations main mainWorld + compilerFuel).run {} = .ok (raw, mainCode) finalState) + (haddressed : + Lower.lowerAllIndexedFullyAddressed declarations main mainWorld + compilerFuel = .ok result) + (oracle : Ixon.Address → List RVal → Option RVal) + (hraw : LowerSim.Reclamation + (result.preAddressCtx raw oracle) mainCode mainWorld) : + LowerSim.Reclamation (result.addressedCtx oracle) result.main + mainWorld := by + have hrun := + Lower.readdressAll_run_of_lowerAllIndexedFullyAddressed_eq_ok + hlower haddressed + have haudit := ReaddressAll.semanticAudit_of_run_eq_ok hrun + rw [result.main_eq_mapAddresses haudit] + apply reclamation_mapAddresses + (result.renames_preAddressCtx haudit oracle) + exact hraw + +/-- Alias-free indexed-production reclamation transport. The raw theorem is +stated against the literal declaration-list context and crosses the final SCC +pass through its certified rebuild renaming. -/ +theorem lowerAllIndexedFullyAddressed_reclamation_of_exact_raw + {declarations : List (Ixon.Address × IxIR0.Decl)} + {main : IxIR0.Expr} {mainWorld : Ixon.Owned} {compilerFuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : Lower.LowSt} {result : ReaddressAll.Result} + (hlower : + (Lower.lowerAllIndexedAction declarations main mainWorld + compilerFuel).run {} = .ok (raw, mainCode) finalState) + (haddressed : + Lower.lowerAllIndexedFullyAddressed declarations main mainWorld + compilerFuel = .ok result) + (oracle : Ixon.Address → List RVal → Option RVal) + (hraw : LowerSim.Reclamation + (result.rebuildSourceCtx raw oracle) mainCode mainWorld) : + LowerSim.Reclamation (result.addressedCtx oracle) result.main + mainWorld := by + have hrun := + Lower.readdressAll_run_of_lowerAllIndexedFullyAddressed_eq_ok + hlower haddressed + have haudit := ReaddressAll.rebuildSemanticAudit_of_run_eq_ok hrun + rw [result.main_eq_rebuildMapAddresses haudit] + apply reclamation_mapAddresses + (result.renames_rebuildSourceCtx haudit oracle) + exact hraw + +/-- The indexed SCC-aware production boundary preserves every target-only +counter invariant already established for its certified raw execution +context. -/ +theorem lowerAllIndexedFullyAddressed_runCostInvariant_of_raw + {declarations : List (Ixon.Address × IxIR0.Decl)} + {main : IxIR0.Expr} {mainWorld : Ixon.Owned} {compilerFuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : Lower.LowSt} {result : ReaddressAll.Result} + {spec : LowerSim.CostObservation → Prop} + (hlower : + (Lower.lowerAllIndexedAction declarations main mainWorld + compilerFuel).run {} = .ok (raw, mainCode) finalState) + (haddressed : + Lower.lowerAllIndexedFullyAddressed declarations main mainWorld + compilerFuel = .ok result) + (oracle : Ixon.Address → List RVal → Option RVal) + (hraw : LowerSim.RunCostInvariant + (result.preAddressCtx raw oracle) mainCode spec) : + LowerSim.RunCostInvariant (result.addressedCtx oracle) result.main + spec := by + have hrun := + Lower.readdressAll_run_of_lowerAllIndexedFullyAddressed_eq_ok + hlower haddressed + have haudit := ReaddressAll.semanticAudit_of_run_eq_ok hrun + rw [result.main_eq_mapAddresses haudit] + intro targetFuel targetStore targetValue htarget + exact runCostInvariant_mapAddresses + (spec := spec) (result.renames_preAddressCtx haudit oracle) + hraw htarget + +/-- Alias-free transport of target-only counter invariants through complete +SCC addressing. -/ +theorem lowerAllIndexedFullyAddressed_runCostInvariant_of_exact_raw + {declarations : List (Ixon.Address × IxIR0.Decl)} + {main : IxIR0.Expr} {mainWorld : Ixon.Owned} {compilerFuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : Lower.LowSt} {result : ReaddressAll.Result} + {spec : LowerSim.CostObservation → Prop} + (hlower : + (Lower.lowerAllIndexedAction declarations main mainWorld + compilerFuel).run {} = .ok (raw, mainCode) finalState) + (haddressed : + Lower.lowerAllIndexedFullyAddressed declarations main mainWorld + compilerFuel = .ok result) + (oracle : Ixon.Address → List RVal → Option RVal) + (hraw : LowerSim.RunCostInvariant + (result.rebuildSourceCtx raw oracle) mainCode spec) : + LowerSim.RunCostInvariant (result.addressedCtx oracle) result.main + spec := by + have hrun := + Lower.readdressAll_run_of_lowerAllIndexedFullyAddressed_eq_ok + hlower haddressed + have haudit := ReaddressAll.rebuildSemanticAudit_of_run_eq_ok hrun + rw [result.main_eq_rebuildMapAddresses haudit] + intro targetFuel targetStore targetValue htarget + exact runCostInvariant_mapAddresses + (spec := spec) (result.renames_rebuildSourceCtx haudit oracle) + hraw htarget + +/-- The actual indexed, fully-addressed compiler output satisfies the first +concrete `CostRefinement` equation, `reuses = 0`, whenever its certified +pre-address context is reuse-free. This premise is explicit because the +semantic transport context also contains stable aliases, not just the raw +declaration list returned by lowering. -/ +theorem lowerAllIndexedFullyAddressed_reuseCostRefinement + {sourceCtx : IxIR0.Ctx} {funRel : Sim.FunctionRel} + {declarations : List (Ixon.Address × IxIR0.Decl)} + {main : IxIR0.Expr} {mainWorld : Ixon.Owned} {compilerFuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : Lower.LowSt} {result : ReaddressAll.Result} + (hlower : + (Lower.lowerAllIndexedAction declarations main mainWorld + compilerFuel).run {} = .ok (raw, mainCode) finalState) + (haddressed : + Lower.lowerAllIndexedFullyAddressed declarations main mainWorld + compilerFuel = .ok result) + (oracle : Ixon.Address → List RVal → Option RVal) + (hctx : CtxNoReuse (result.preAddressCtx raw oracle)) : + LowerSim.CostRefinement sourceCtx (result.addressedCtx oracle) + main result.main funRel + (fun _ observation => ReuseFreeCostSpec observation) := by + apply LowerSim.RunCostInvariant.costRefinement + have hlower' : + (Lower.lowerAllAction declarations main mainWorld compilerFuel).run {} = + .ok (raw, mainCode) finalState := by + simpa only [Lower.lowerAllIndexedAction_eq_lowerAllAction] using hlower + have hrawCost : LowerSim.RunCostInvariant + (result.preAddressCtx raw oracle) mainCode ReuseFreeCostSpec := by + intro targetFuel targetStore targetValue htarget + exact runCostInvariant_of_noReuse hctx + (lowerAllAction_noReuse hlower').2.1 htarget + intro targetFuel targetStore targetValue htarget + exact lowerAllIndexedFullyAddressed_runCostInvariant_of_raw + (spec := ReuseFreeCostSpec) hlower haddressed oracle hrawCost htarget + +/-- The indexed fully-addressed production output satisfies the complete +current-lowerer counter contract `reuses = 0 ∧ frees ≤ allocs`. -/ +theorem lowerAllIndexedFullyAddressed_costRefinement + {sourceCtx : IxIR0.Ctx} {funRel : Sim.FunctionRel} + {declarations : List (Ixon.Address × IxIR0.Decl)} + {main : IxIR0.Expr} {mainWorld : Ixon.Owned} {compilerFuel : Nat} + {raw : List (Ixon.Address × Decl)} {mainCode : Code} + {finalState : Lower.LowSt} {result : ReaddressAll.Result} + (hlower : + (Lower.lowerAllIndexedAction declarations main mainWorld + compilerFuel).run {} = .ok (raw, mainCode) finalState) + (haddressed : + Lower.lowerAllIndexedFullyAddressed declarations main mainWorld + compilerFuel = .ok result) + (oracle : Ixon.Address → List RVal → Option RVal) + (hctx : CtxNoReuse (result.preAddressCtx raw oracle)) : + LowerSim.CostRefinement sourceCtx (result.addressedCtx oracle) + main result.main funRel + (fun _ observation => CurrentLowererCostSpec observation) := by + have hreuses : LowerSim.CostRefinement sourceCtx + (result.addressedCtx oracle) main result.main funRel + (fun _ observation => ReuseFreeCostSpec observation) := + lowerAllIndexedFullyAddressed_reuseCostRefinement + (sourceCtx := sourceCtx) (funRel := funRel) + hlower haddressed oracle hctx + have hallocFree : LowerSim.CostRefinement sourceCtx + (result.addressedCtx oracle) main result.main funRel + (fun _ observation => LowerSim.AllocationFreeCostSpec observation) := + LowerSim.allocationFreeCostRefinement + change LowerSim.CostRefinement sourceCtx (result.addressedCtx oracle) + main result.main funRel (fun _ observation => + ReuseFreeCostSpec observation ∧ + LowerSim.AllocationFreeCostSpec observation) + apply LowerSim.CostRefinement.and + · exact hreuses + · exact hallocFree + +end Ix.Compiler.IxIR1.NoReuse diff --git a/Ix/Compiler/IxIR1/Optimizer.lean b/Ix/Compiler/IxIR1/Optimizer.lean new file mode 100644 index 000000000..877b4aee4 --- /dev/null +++ b/Ix/Compiler/IxIR1/Optimizer.lean @@ -0,0 +1,798 @@ +import Ix.Compiler.IxIR1.HPTCache +import Ix.Compiler.IxIR1.HPTPAPFuseProgram + +/-! +# Deterministic IxIR₁ optimizer harness + +This module is the control and observation boundary for whole-program IxIR₁ +optimization. It wraps the checked, fact-propagating HPT case simplifier +(impossible-alternative pruning plus exact unary case collapse), exact scalar +fetch forwarding after allocation/reuse, scalar and exact-leaf destruction +specialization, local PAP/application fusion, and checked rooted declaration +reachability with: + +- explicit harness and pass-policy versions; +- deterministic, fail-soft resource controls; +- exact static before/after observations; +- content-addressed input, output, certificate, and report identities; and +- an explicit disabled path that returns the input graph unchanged. + +The observations are structural compiler counters, not dynamic execution +counters. `instructions` counts each `ret`, `letOp`, and `case` node once; +operation-specific fields classify the operation bound by each `letOp`. +`codeBytes` is the sum of canonical function-body and main spellings, while +`storedArtifactBytes` follows the actual ordinary/mutual artifact framing. + +An exhausted optimizer budget, unsupported policy version, or failed graph +rebuild selects the unoptimized graph and records why. It never turns an +otherwise accepted program into a compiler rejection. +-/ + +namespace Ix.Compiler.IxIR1.Optimizer + +open Ix.Compiler.Ixon (Address) +open Ix.Compiler.IxIR + +def currentHarnessVersion : Nat := 5 +def currentCasePruneVersion : Nat := 3 +def currentFetchForwardVersion : Nat := 1 +def currentDestructionVersion : Nat := 1 +def currentPAPFuseVersion : Nat := 1 +def currentReachabilityVersion : Nat := Reachability.currentVersion + +/-! ## Structural observations -/ + +/-- Static control, call, and heap-operation counts over IxIR₁ code. -/ +structure Counts where + instructions : Nat := 0 + returns : Nat := 0 + cases : Nat := 0 + alternatives : Nat := 0 + allocations : Nat := 0 + reuses : Nat := 0 + frees : Nat := 0 + rcIncrements : Nat := 0 + rcDecrements : Nat := 0 + uniqueDrops : Nat := 0 + fetches : Nat := 0 + directCalls : Nat := 0 + selfCalls : Nat := 0 + papAllocations : Nat := 0 + applies : Nat := 0 + externCalls : Nat := 0 + deriving BEq, Repr, Inhabited + +def Counts.add (left right : Counts) : Counts := + { instructions := left.instructions + right.instructions + returns := left.returns + right.returns + cases := left.cases + right.cases + alternatives := left.alternatives + right.alternatives + allocations := left.allocations + right.allocations + reuses := left.reuses + right.reuses + frees := left.frees + right.frees + rcIncrements := left.rcIncrements + right.rcIncrements + rcDecrements := left.rcDecrements + right.rcDecrements + uniqueDrops := left.uniqueDrops + right.uniqueDrops + fetches := left.fetches + right.fetches + directCalls := left.directCalls + right.directCalls + selfCalls := left.selfCalls + right.selfCalls + papAllocations := left.papAllocations + right.papAllocations + applies := left.applies + right.applies + externCalls := left.externCalls + right.externCalls } + +private def countsOfOp : Op → Counts + | .pure _ => {} + | .alloc _ _ _ => { allocations := 1 } + | .reuse _ _ _ => { reuses := 1 } + | .free _ => { frees := 1 } + | .dup _ => { rcIncrements := 1 } + | .drop _ => { rcDecrements := 1 } + | .dropU _ => { uniqueDrops := 1 } + | .fetch _ _ => { fetches := 1 } + | .call _ _ => { directCalls := 1 } + | .callSelf _ => { selfCalls := 1 } + | .papp _ _ => { papAllocations := 1 } + | .apply _ _ => { applies := 1 } + | .extern _ _ => { externCalls := 1 } + +mutual + +def countsCode : Code → Counts + | .ret _ => { instructions := 1, returns := 1 } + | .letOp operation rest => + (countsOfOp operation).add + ((countsCode rest).add { instructions := 1 }) + | .case _ _ alternatives => + alternatives.foldl + (fun total alternative => total.add (countsAlternative alternative)) + { instructions := 1 + cases := 1 + alternatives := alternatives.size } + +def countsAlternative : Alt → Counts + | .mk _ _ body => countsCode body + +end + +/-- Deterministic whole-program static observation. -/ +structure Observation where + storedArtifacts : Nat := 0 + mutualBlocks : Nat := 0 + functions : Nat := 0 + externs : Nat := 0 + counts : Counts := {} + codeBytes : Nat := 0 + storedArtifactBytes : Nat := 0 + deriving BEq, Repr, Inhabited + +private def declarationCounts : Decl → Counts + | .fn function => countsCode function.body + | .extern _ => {} + +private def declarationCodeBytes : Decl → Nat + | .fn function => function.body.bytes.size + | .extern _ => 0 + +private def artifactStoredBytes : ReaddressAll.Artifact → Nat + | .stable _ declaration | .ordinary _ declaration => + declaration.preimage.size + | .mutual block => MutualBlock.Block.preimage block.blockMembers |>.size + +/-- Observe the exact addressed declaration graph plus its main code. -/ +def observe (program : List ReaddressAll.Artifact) (main : Code) : Observation := + let declarations := HPT.declarationEntries program + { storedArtifacts := program.length + mutualBlocks := program.countP fun + | .mutual _ => true + | _ => false + functions := declarations.countP fun + | (_, .fn _) => true + | _ => false + externs := declarations.countP fun + | (_, .extern _) => true + | _ => false + counts := declarations.foldl + (fun total entry => total.add (declarationCounts entry.2)) + (countsCode main) + codeBytes := declarations.foldl + (fun total entry => total + declarationCodeBytes entry.2) + main.bytes.size + storedArtifactBytes := program.foldl + (fun total artifact => total + artifactStoredBytes artifact) 0 } + +/-! ## Exact graph and certificate identities -/ + +private def graphDomain : ByteArray := + Encoding.domain "compilatrix/ixir1/optimizer-graph/1" ++ Encoding.tag 0 + +private def artifactBytes : ReaddressAll.Artifact → ByteArray + | .stable address declaration => + Encoding.tag 0 ++ Encoding.address address ++ + Encoding.blob declaration.preimage + | .ordinary address declaration => + Encoding.tag 1 ++ Encoding.address address ++ + Encoding.blob declaration.preimage + | .mutual block => + Encoding.tag 2 ++ Encoding.address block.blockAddress ++ + Encoding.blob (MutualBlock.Block.preimage block.blockMembers) + +/-- One digest commits to artifact kind/order, stable ABI rows, addressed +ordinary/mutual payloads, and the exact main code. -/ +def graphRoot (program : List ReaddressAll.Artifact) (main : Code) : Address := + Address.blake3 + (graphDomain ++ Encoding.list artifactBytes program ++ + Encoding.blob main.bytes) + +private def checkedStore (result : HPT.Result) : HPT.Cache.Store := + HPT.Cache.Store.ofResult result + +def certificateBytes (result : HPT.Result) : Nat := + (checkedStore result).framedSize + +def certificateRoot (result : HPT.Result) : Address := + Address.blake3 (HPT.Cache.encodeStore (checkedStore result)) + +/-! ## Versioned fail-soft policy -/ + +/-- Deterministic admission limits for the existing shrinking pass. HPT +production/checking has its own limits; these bound optimizer traversal and +report inputs after a checked analysis already exists. -/ +structure Budget where + maxInputInstructions : Nat := 16 * 1024 * 1024 + maxInputCodeBytes : Nat := 64 * 1024 * 1024 + maxCertificateBytes : Nat := 64 * 1024 * 1024 + deriving BEq, Repr + +structure CasePrunePolicy where + version : Nat := currentCasePruneVersion + enabled : Bool := true + budget : Budget := {} + deriving BEq, Repr + +structure FetchForwardPolicy where + version : Nat := currentFetchForwardVersion + enabled : Bool := true + deriving BEq, Repr + +structure DestructionPolicy where + version : Nat := currentDestructionVersion + enabled : Bool := true + deriving BEq, Repr + +structure PAPFusePolicy where + version : Nat := currentPAPFuseVersion + enabled : Bool := true + deriving BEq, Repr + +structure ReachabilityPolicy where + version : Nat := currentReachabilityVersion + enabled : Bool := true + /-- Additional exported declarations which must remain addressable even when + they are not reachable from top-level main. -/ + roots : List Address := [] + deriving BEq, Repr + +structure Policy where + version : Nat := currentHarnessVersion + casePrune : CasePrunePolicy := {} + fetchForward : FetchForwardPolicy := {} + destruction : DestructionPolicy := {} + papFuse : PAPFusePolicy := {} + reachability : ReachabilityPolicy := {} + deriving BEq, Repr + +def defaultPolicy : Policy := {} + +namespace Policy + +/-- Executable optimizer policy projected into the proof-facing composed +pass selection. Keeping this projection public ensures the harness and its +semantic theorem refer to literally the same pass bundle. -/ +def passes (policy : Policy) : HPT.OptimizeProgram.Passes := + { casePrune := policy.casePrune.enabled + fetchForward := policy.fetchForward.enabled + destroy := policy.destruction.enabled + papFuse := policy.papFuse.enabled + reachability := policy.reachability.enabled + roots := policy.reachability.roots } + +/-- Exact old-keyed declaration rows consumed by the optimizer's single +content-address rebuild. -/ +def rebuildEntries (policy : Policy) + (program : List ReaddressAll.Artifact) (summaries : HPT.SummaryEnv) + (main : Code) : List (Address × Decl) := + (HPT.OptimizeProgram.selectReachable policy.passes + (HPT.OptimizeProgram.rewriteEntries policy.passes + (HPT.programDeclEnv program) summaries + (HPT.declarationEntries program)) + (HPT.OptimizeProgram.rewriteMain policy.passes + (HPT.programDeclEnv program) summaries main).code).entries + +end Policy + +inductive SkipReason where + | unsupportedHarnessVersion (actual expected : Nat) + | unsupportedPassVersion (actual expected : Nat) + | unsupportedFetchForwardVersion (actual expected : Nat) + | unsupportedDestructionVersion (actual expected : Nat) + | unsupportedPAPFuseVersion (actual expected : Nat) + | unsupportedReachabilityVersion (actual expected : Nat) + | disabled + | instructionBudget (actual limit : Nat) + | codeByteBudget (actual limit : Nat) + | certificateByteBudget (actual limit : Nat) + | rebuildRejected + deriving BEq, Repr + +inductive Disposition where + | skipped (reason : SkipReason) + | unchanged + | changed + deriving BEq, Repr + +structure Report where + policy : Policy + disposition : Disposition + inputRoot : Address + outputRoot : Address + certificateRoot : Address + certificateBytes : Nat + before : Observation + after : Observation + removedAlternatives : Nat + collapsedCases : Nat + materializedFetches : Nat + forwardedFetches : Nat + elidedScalarDrops : Nat + specializedUniqueDrops : Nat + fusedPaps : Nat + underSaturatedPaps : Nat + exactlySaturatedPaps : Nat + overSaturatedPaps : Nat + removedDeclarations : Nat + /-- Populated only when the semantics-preserving rebuild rejected and the + harness selected the original graph. -/ + diagnostic : String := "" + deriving BEq, Repr + +private def natFields (values : List Nat) : ByteArray := + Encoding.list Encoding.nat values + +private def Counts.bytes (counts : Counts) : ByteArray := + natFields + [counts.instructions, counts.returns, counts.cases, counts.alternatives, + counts.allocations, counts.reuses, counts.frees, counts.rcIncrements, + counts.rcDecrements, counts.uniqueDrops, counts.fetches, + counts.directCalls, counts.selfCalls, counts.papAllocations, + counts.applies, counts.externCalls] + +private def Observation.bytes (observation : Observation) : ByteArray := + natFields + [observation.storedArtifacts, observation.mutualBlocks, + observation.functions, observation.externs] ++ + observation.counts.bytes ++ + natFields [observation.codeBytes, observation.storedArtifactBytes] + +private def Budget.bytes (budget : Budget) : ByteArray := + natFields [budget.maxInputInstructions, budget.maxInputCodeBytes, + budget.maxCertificateBytes] + +private def Policy.bytes (policy : Policy) : ByteArray := + Encoding.nat policy.version ++ Encoding.nat policy.casePrune.version ++ + Encoding.bool policy.casePrune.enabled ++ policy.casePrune.budget.bytes ++ + Encoding.nat policy.fetchForward.version ++ + Encoding.bool policy.fetchForward.enabled ++ + Encoding.nat policy.destruction.version ++ + Encoding.bool policy.destruction.enabled ++ + Encoding.nat policy.papFuse.version ++ Encoding.bool policy.papFuse.enabled ++ + Encoding.nat policy.reachability.version ++ + Encoding.bool policy.reachability.enabled ++ + Encoding.list Encoding.address policy.reachability.roots + +private def SkipReason.bytes : SkipReason → ByteArray + | .unsupportedHarnessVersion actual expected => + Encoding.tag 0 ++ natFields [actual, expected] + | .unsupportedPassVersion actual expected => + Encoding.tag 1 ++ natFields [actual, expected] + | .unsupportedPAPFuseVersion actual expected => + Encoding.tag 2 ++ natFields [actual, expected] + | .disabled => Encoding.tag 3 + | .instructionBudget actual limit => + Encoding.tag 4 ++ natFields [actual, limit] + | .codeByteBudget actual limit => + Encoding.tag 5 ++ natFields [actual, limit] + | .certificateByteBudget actual limit => + Encoding.tag 6 ++ natFields [actual, limit] + | .rebuildRejected => Encoding.tag 7 + | .unsupportedFetchForwardVersion actual expected => + Encoding.tag 8 ++ natFields [actual, expected] + | .unsupportedReachabilityVersion actual expected => + Encoding.tag 9 ++ natFields [actual, expected] + | .unsupportedDestructionVersion actual expected => + Encoding.tag 10 ++ natFields [actual, expected] + +private def Disposition.bytes : Disposition → ByteArray + | .skipped reason => Encoding.tag 0 ++ reason.bytes + | .unchanged => Encoding.tag 1 + | .changed => Encoding.tag 2 + +namespace Report + +def addressDomain : ByteArray := + Encoding.domain "compilatrix/ixir1/optimizer-report/6" ++ Encoding.tag 0 + +/-- Canonical machine-independent report spelling. -/ +def bytes (report : Report) : ByteArray := + addressDomain ++ report.policy.bytes ++ report.disposition.bytes ++ + Encoding.address report.inputRoot ++ Encoding.address report.outputRoot ++ + Encoding.address report.certificateRoot ++ + Encoding.nat report.certificateBytes ++ report.before.bytes ++ + report.after.bytes ++ Encoding.nat report.removedAlternatives ++ + Encoding.nat report.collapsedCases ++ + Encoding.nat report.materializedFetches ++ + Encoding.nat report.forwardedFetches ++ + Encoding.nat report.elidedScalarDrops ++ + Encoding.nat report.specializedUniqueDrops ++ + Encoding.nat report.fusedPaps ++ + Encoding.nat report.underSaturatedPaps ++ + Encoding.nat report.exactlySaturatedPaps ++ + Encoding.nat report.overSaturatedPaps ++ + Encoding.nat report.removedDeclarations ++ + Encoding.string report.diagnostic + +def address (report : Report) : Address := + Address.blake3 report.bytes + +end Report + +/-! ## Checked optimization execution -/ + +structure Outcome where + /-- `none` means the original graph is the selected output. -/ + rebuilt : Option ReaddressAll.Result + report : Report + +namespace Outcome + +def artifacts (outcome : Outcome) + (input : List ReaddressAll.Artifact) : List ReaddressAll.Artifact := + outcome.rebuilt.map (fun result => result.artifacts) |>.getD input + +def main (outcome : Outcome) (input : Code) : Code := + outcome.rebuilt.map (fun result => result.main) |>.getD input + +/-- Oracle seen by the selected input program. A rebuilt outcome pulls the +final oracle back through the optimizer's exact rebuild renaming; a skipped +outcome uses it literally. -/ +def sourceOracle (outcome : Outcome) (policy : Policy) + (program : List ReaddressAll.Artifact) (summaries : HPT.SummaryEnv) + (main : Code) (oracle : Address → List RVal → Option RVal) : + Address → List RVal → Option RVal := + match outcome.rebuilt with + | none => oracle + | some result => fun address arguments => + oracle (result.rebuildRename + (policy.rebuildEntries program summaries main) address) arguments + +/-- Old addressed program context from which the selected optimizer result is +proved. -/ +def sourceCtx (outcome : Outcome) (policy : Policy) + (program : List ReaddressAll.Artifact) (summaries : HPT.SummaryEnv) + (main : Code) (oracle : Address → List RVal → Option RVal) : Ctx := + { decls := HPT.programDeclEnv program + oracle := outcome.sourceOracle policy program summaries main oracle } + +/-- Runtime context of the fail-soft selected graph. -/ +def targetCtx (outcome : Outcome) (program : List ReaddressAll.Artifact) + (oracle : Address → List RVal → Option RVal) : Ctx := + match outcome.rebuilt with + | none => { decls := HPT.programDeclEnv program, oracle } + | some result => result.addressedCtx oracle + +/-- Result relation for the fail-soft harness. Skipping is literal equality. +A successful optimization first relates logical executions modulo allocation +history, then maps declaration identities stored in the optimized heap through +the single certified rebuild. -/ +def RunRefines (outcome : Outcome) (policy : Policy) + (program : List ReaddressAll.Artifact) (summaries : HPT.SummaryEnv) + (main : Code) (sourceOut targetOut : Store × RVal) : Prop := + match outcome.rebuilt with + | none => targetOut = sourceOut + | some result => + ∃ logicalOut, + targetOut = + (Readdress.Store.mapAddresses + (result.rebuildRename + (policy.rebuildEntries program summaries main)) logicalOut.1, + logicalOut.2) ∧ + Sim.RunHistoryIso HPT.OptimizeProgram.emptyHistoryIso + sourceOut logicalOut + +/-- The proof-facing selected context uses exactly the declaration environment +committed to by `Outcome.artifacts`. -/ +theorem targetCtx_decls (outcome : Outcome) + (program : List ReaddressAll.Artifact) + (oracle : Address → List RVal → Option RVal) : + (outcome.targetCtx program oracle).decls = + HPT.programDeclEnv (outcome.artifacts program) := by + cases hrebuilt : outcome.rebuilt with + | none => simp [targetCtx, artifacts, hrebuilt] + | some result => + have henv := HPT.OptimizeProgram.envOfList_declarationEntries + result.artifacts + change + Env.ofList + (result.artifacts.flatMap ReaddressAll.Artifact.declarations) = + HPT.programDeclEnv result.artifacts at henv + simpa only [targetCtx, artifacts, hrebuilt, Option.map_some, + Option.getD_some, ReaddressAll.Result.addressedCtx, + ReaddressAll.Result.asReaddressResult, + Readdress.Result.addressedCtx, Readdress.Result.declarations, + List.append_nil, ReaddressAll.Result.declarations] using henv + +end Outcome + +private def skipReason? (policy : Policy) (before : Observation) + (checkedBytes : Nat) : Option SkipReason := + if policy.version != currentHarnessVersion then + some (.unsupportedHarnessVersion policy.version currentHarnessVersion) + else if policy.casePrune.version != currentCasePruneVersion then + some (.unsupportedPassVersion policy.casePrune.version + currentCasePruneVersion) + else if policy.fetchForward.version != currentFetchForwardVersion then + some (.unsupportedFetchForwardVersion policy.fetchForward.version + currentFetchForwardVersion) + else if policy.destruction.version != currentDestructionVersion then + some (.unsupportedDestructionVersion policy.destruction.version + currentDestructionVersion) + else if policy.papFuse.version != currentPAPFuseVersion then + some (.unsupportedPAPFuseVersion policy.papFuse.version + currentPAPFuseVersion) + else if policy.reachability.version != currentReachabilityVersion then + some (.unsupportedReachabilityVersion policy.reachability.version + currentReachabilityVersion) + else if !policy.casePrune.enabled && !policy.fetchForward.enabled && + !policy.destruction.enabled && !policy.papFuse.enabled && + !policy.reachability.enabled then + some .disabled + else if before.counts.instructions > + policy.casePrune.budget.maxInputInstructions then + some (.instructionBudget before.counts.instructions + policy.casePrune.budget.maxInputInstructions) + else if before.codeBytes > policy.casePrune.budget.maxInputCodeBytes then + some (.codeByteBudget before.codeBytes + policy.casePrune.budget.maxInputCodeBytes) + else if checkedBytes > policy.casePrune.budget.maxCertificateBytes then + some (.certificateByteBudget checkedBytes + policy.casePrune.budget.maxCertificateBytes) + else + none + +private def skippedOutcome (policy : Policy) (reason : SkipReason) + (root checkedRoot : Address) (checkedBytes : Nat) + (before : Observation) (diagnostic : String := "") : Outcome := + { rebuilt := none + report := + { policy + disposition := .skipped reason + inputRoot := root + outputRoot := root + certificateRoot := checkedRoot + certificateBytes := checkedBytes + before + after := before + removedAlternatives := 0 + collapsedCases := 0 + materializedFetches := 0 + forwardedFetches := 0 + elidedScalarDrops := 0 + specializedUniqueDrops := 0 + fusedPaps := 0 + underSaturatedPaps := 0 + exactlySaturatedPaps := 0 + overSaturatedPaps := 0 + removedDeclarations := 0 + diagnostic } } + +private def runChecked (policy : Policy) + (program : List ReaddressAll.Artifact) (main : Code) + (summaries : HPT.SummaryEnv) (analysis : HPT.Result) : Outcome := + let before := observe program main + let inputRoot := graphRoot program main + let checkedBytes := certificateBytes analysis + let checkedRoot := certificateRoot analysis + match skipReason? policy before checkedBytes with + | some reason => + skippedOutcome policy reason inputRoot checkedRoot checkedBytes before + | none => + match HPT.OptimizeProgram.rebuildProgram policy.passes [] program summaries + main with + | .error message => + skippedOutcome policy .rebuildRejected inputRoot checkedRoot + checkedBytes before message + | .ok pruned => + let after := observe pruned.result.artifacts pruned.result.main + let outputRoot := graphRoot pruned.result.artifacts pruned.result.main + let caseChanges := pruned.changes.casePrune + let fetchChanges := pruned.changes.fetchForward + let destructionChanges := pruned.changes.destroy + let papChanges := pruned.changes.papFuse + { rebuilt := some pruned.result + report := + { policy + disposition := + if caseChanges.removedAlternatives == 0 && + caseChanges.collapsedCases == 0 && + caseChanges.materializedFetches == 0 && + fetchChanges.forwardedFetches == 0 && + destructionChanges.elidedScalarDrops == 0 && + destructionChanges.specializedUniqueDrops == 0 && + papChanges.fusedPaps == 0 && + pruned.changes.removedDeclarations == 0 then .unchanged + else .changed + inputRoot + outputRoot + certificateRoot := checkedRoot + certificateBytes := checkedBytes + before + after + removedAlternatives := caseChanges.removedAlternatives + collapsedCases := caseChanges.collapsedCases + materializedFetches := caseChanges.materializedFetches + forwardedFetches := fetchChanges.forwardedFetches + elidedScalarDrops := destructionChanges.elidedScalarDrops + specializedUniqueDrops := + destructionChanges.specializedUniqueDrops + fusedPaps := papChanges.fusedPaps + underSaturatedPaps := papChanges.underSaturated + exactlySaturatedPaps := papChanges.exactlySaturated + overSaturatedPaps := papChanges.overSaturated + removedDeclarations := pruned.changes.removedDeclarations } } + +/-- A selected rebuilt result can only come from the successful branch of the +same composed pass invocation used by the harness. -/ +private theorem runChecked_rebuilt_eq_some + {policy : Policy} {program : List ReaddressAll.Artifact} {main : Code} + {summaries : HPT.SummaryEnv} {analysis : HPT.Result} + {result : ReaddressAll.Result} + (hselected : + (runChecked policy program main summaries analysis).rebuilt = + some result) : + ∃ optimized, + HPT.OptimizeProgram.rebuildProgram policy.passes [] program summaries + main = .ok optimized ∧ + optimized.result = result := by + cases hskip : skipReason? policy (observe program main) + (certificateBytes analysis) with + | some reason => + simp [runChecked, hskip, skippedOutcome] at hselected + | none => + cases hrebuild : HPT.OptimizeProgram.rebuildProgram policy.passes [] + program summaries main with + | error message => + simp [runChecked, hskip, hrebuild, skippedOutcome] at hselected + | ok optimized => + refine ⟨optimized, rfl, ?_⟩ + simpa [runChecked, hskip, hrebuild] using hselected + +/-- Run the versioned harness from an in-process HPT production that already +crossed the ordinary checker. -/ +def runWithProducedHPT (policy : Policy) + (program : List ReaddressAll.Artifact) (main : Code) + {limits : HPT.Limits} + (production : HPT.Production limits program) : Outcome := + runChecked policy program main production.certificate.summaryEnv + production.result + +/-- Cached HPT hits and rebuilt rows carry the same whole-program checked +boundary, so they can drive the identical deterministic harness. -/ +def runWithCachedHPT (policy : Policy) + (program : List ReaddressAll.Artifact) (main : Code) + {limits : HPT.Cache.Limits} + (production : HPT.Cache.Production limits program) : Outcome := + runChecked policy program main production.certificate.summaryEnv + production.result + +/-- Proof-facing inversion of the produced-HPT harness's rebuilt branch. -/ +theorem rebuilt_eq_some_of_runWithProducedHPT + {policy : Policy} {program : List ReaddressAll.Artifact} {main : Code} + {limits : HPT.Limits} {production : HPT.Production limits program} + {result : ReaddressAll.Result} + (hselected : + (runWithProducedHPT policy program main production).rebuilt = + some result) : + ∃ optimized, + HPT.OptimizeProgram.rebuildProgram policy.passes [] program + production.certificate.summaryEnv main = .ok optimized ∧ + optimized.result = result := by + exact runChecked_rebuilt_eq_some hselected + +/-- Proof-facing inversion of the cached-HPT harness's rebuilt branch. -/ +theorem rebuilt_eq_some_of_runWithCachedHPT + {policy : Policy} {program : List ReaddressAll.Artifact} {main : Code} + {limits : HPT.Cache.Limits} + {production : HPT.Cache.Production limits program} + {result : ReaddressAll.Result} + (hselected : + (runWithCachedHPT policy program main production).rebuilt = + some result) : + ∃ optimized, + HPT.OptimizeProgram.rebuildProgram policy.passes [] program + production.certificate.summaryEnv main = .ok optimized ∧ + optimized.result = result := by + exact runChecked_rebuilt_eq_some hselected + +/-- Every directly produced fail-soft optimizer selection preserves a +successful execution at the same fuel under its explicit oracle pullback. -/ +theorem runMain_of_runWithProducedHPT_eq + {policy : Policy} {program : List ReaddressAll.Artifact} {main : Code} + {limits : HPT.Limits} {production : HPT.Production limits program} + {outcome : Outcome} + (houtcome : runWithProducedHPT policy program main production = outcome) + (oracle : Address → List RVal → Option RVal) (fuel : Nat) + {sourceOut : Store × RVal} + (hrun : runMain + (outcome.sourceCtx policy program production.certificate.summaryEnv + main oracle) main fuel = .ok sourceOut) : + ∃ targetOut, + runMain (outcome.targetCtx program oracle) (outcome.main main) fuel = + .ok targetOut ∧ + outcome.RunRefines policy program production.certificate.summaryEnv + main sourceOut targetOut := by + cases hrebuilt : outcome.rebuilt with + | none => + refine ⟨sourceOut, ?_, ?_⟩ + · simpa [Outcome.sourceCtx, Outcome.sourceOracle, + Outcome.targetCtx, Outcome.main, hrebuilt] using hrun + · simp [Outcome.RunRefines, hrebuilt] + | some result => + have hselected : + (runWithProducedHPT policy program main production).rebuilt = + some result := by + rw [houtcome, hrebuilt] + obtain ⟨optimized, hrebuild, hresult⟩ := + rebuilt_eq_some_of_runWithProducedHPT hselected + subst result + have hsource : + runMain + (HPT.OptimizeProgram.rebuildOriginalCtx optimized.result + (policy.rebuildEntries program + production.certificate.summaryEnv main) + (HPT.programDeclEnv program) oracle) + main fuel = .ok sourceOut := by + simpa [Outcome.sourceCtx, Outcome.sourceOracle, hrebuilt, + HPT.OptimizeProgram.rebuildOriginalCtx, + ReaddressAll.Result.rebuildSourceCtx] using hrun + obtain ⟨logicalOut, htarget, hhistory⟩ := + HPT.OptimizeProgram.runMain_rebuildProgram_of_runWith_eq_ok + production.checked hrebuild oracle fuel hsource + let targetOut : Store × RVal := + (Readdress.Store.mapAddresses + (optimized.result.rebuildRename + (policy.rebuildEntries program + production.certificate.summaryEnv main)) logicalOut.1, + logicalOut.2) + refine ⟨targetOut, ?_, ?_⟩ + · simpa [targetOut, Outcome.targetCtx, Outcome.main, hrebuilt, + Policy.rebuildEntries] using htarget + · simp only [Outcome.RunRefines, hrebuilt] + exact ⟨logicalOut, rfl, hhistory⟩ + +/-- Cached checked summaries expose the identical fail-soft successful-run +contract. -/ +theorem runMain_of_runWithCachedHPT_eq + {policy : Policy} {program : List ReaddressAll.Artifact} {main : Code} + {limits : HPT.Cache.Limits} + {production : HPT.Cache.Production limits program} + {outcome : Outcome} + (houtcome : runWithCachedHPT policy program main production = outcome) + (oracle : Address → List RVal → Option RVal) (fuel : Nat) + {sourceOut : Store × RVal} + (hrun : runMain + (outcome.sourceCtx policy program production.certificate.summaryEnv + main oracle) main fuel = .ok sourceOut) : + ∃ targetOut, + runMain (outcome.targetCtx program oracle) (outcome.main main) fuel = + .ok targetOut ∧ + outcome.RunRefines policy program production.certificate.summaryEnv + main sourceOut targetOut := by + cases hrebuilt : outcome.rebuilt with + | none => + refine ⟨sourceOut, ?_, ?_⟩ + · simpa [Outcome.sourceCtx, Outcome.sourceOracle, + Outcome.targetCtx, Outcome.main, hrebuilt] using hrun + · simp [Outcome.RunRefines, hrebuilt] + | some result => + have hselected : + (runWithCachedHPT policy program main production).rebuilt = + some result := by + rw [houtcome, hrebuilt] + obtain ⟨optimized, hrebuild, hresult⟩ := + rebuilt_eq_some_of_runWithCachedHPT hselected + subst result + have hsource : + runMain + (HPT.OptimizeProgram.rebuildOriginalCtx optimized.result + (policy.rebuildEntries program + production.certificate.summaryEnv main) + (HPT.programDeclEnv program) oracle) + main fuel = .ok sourceOut := by + simpa [Outcome.sourceCtx, Outcome.sourceOracle, hrebuilt, + HPT.OptimizeProgram.rebuildOriginalCtx, + ReaddressAll.Result.rebuildSourceCtx] using hrun + obtain ⟨logicalOut, htarget, hhistory⟩ := + HPT.OptimizeProgram.runMain_rebuildProgram_of_runWith_eq_ok + production.checked hrebuild oracle fuel hsource + let targetOut : Store × RVal := + (Readdress.Store.mapAddresses + (optimized.result.rebuildRename + (policy.rebuildEntries program + production.certificate.summaryEnv main)) logicalOut.1, + logicalOut.2) + refine ⟨targetOut, ?_, ?_⟩ + · simpa [targetOut, Outcome.targetCtx, Outcome.main, hrebuilt, + Policy.rebuildEntries] using htarget + · simp only [Outcome.RunRefines, hrebuilt] + exact ⟨logicalOut, rfl, hhistory⟩ + +end Ix.Compiler.IxIR1.Optimizer diff --git a/Ix/Compiler/IxIR1/OptimizerReclamation.lean b/Ix/Compiler/IxIR1/OptimizerReclamation.lean new file mode 100644 index 000000000..82bd62a6a --- /dev/null +++ b/Ix/Compiler/IxIR1/OptimizerReclamation.lean @@ -0,0 +1,256 @@ +import Ix.Compiler.IxIR1.Optimizer +import Ix.Compiler.IxIR1.NoReuseAddressed + +/-! +# Reclamation through the fail-soft IxIR₁ optimizer + +The optimizer's successful-run theorem is intentionally one-way, but that is +enough for closed-main reclamation once the source has one successful run. +The forwarded run supplies a target witness, evaluator determinism identifies +every other successful target run with that witness, allocation-history +isomorphism transports deep release, and the final exact rebuild transports +the released heap through its certified address map. +-/ + +namespace Ix.Compiler.IxIR1 + +open Ix.Compiler.Ixon (Address Owned) + +namespace LowerSim + +/-- Releasing a result does not inspect the declaration environment or +oracle. -/ +theorem releaseResult_ctx_eq (before after : Ctx) (world : Owned) + (fuel : Nat) (store : Store) (value : RVal) : + releaseResult after world fuel store value = + releaseResult before world fuel store value := by + cases world with + | shared => + exact Sim.dropVal_ctx_eq before after fuel store value + | unique => + exact Sim.dropUVal_ctx_eq before after fuel store value + +end LowerSim + +namespace Sim.RunHistoryIso + +/-- A related successful result can be released whenever its source result +can, and absence of live nodes survives the allocation-history relation. -/ +theorem releaseResult_live_eq_zero + {left right : Store} {before : HeapHistoryIso left right} + {sourceOut targetOut : Store × RVal} + (hresult : RunHistoryIso before sourceOut targetOut) + (ctx : Ctx) (world : Owned) {fuel : Nat} {released : Store} + (hrelease : LowerSim.releaseResult ctx world fuel sourceOut.1 sourceOut.2 = + .ok released) + (hlive : released.live = 0) : + ∃ targetReleased, + LowerSim.releaseResult ctx world fuel targetOut.1 targetOut.2 = + .ok targetReleased ∧ + targetReleased.live = 0 := by + obtain ⟨heap, _, hvalue⟩ := hresult + cases world with + | shared => + have hsource : dropVal ctx fuel sourceOut.1 sourceOut.2 = + .ok released := by + simpa [LowerSim.releaseResult] using hrelease + obtain ⟨targetReleased, htarget, hstores⟩ := + dropVal_historyIso heap hvalue hsource + exact ⟨targetReleased, by + simpa [LowerSim.releaseResult] using htarget, + hstores.right_live_eq_zero hlive⟩ + | unique => + have hsource : dropUVal ctx fuel sourceOut.1 sourceOut.2 = + .ok released := by + simpa [LowerSim.releaseResult] using hrelease + obtain ⟨targetReleased, htarget, hstores⟩ := + dropUVal_historyIso heap hvalue hsource + exact ⟨targetReleased, by + simpa [LowerSim.releaseResult] using htarget, + hstores.right_live_eq_zero hlive⟩ + +end Sim.RunHistoryIso + +namespace Readdress + +/-- A release witness commutes with a certified declaration-address image; +the address map changes no location liveness. -/ +theorem releaseResult_mapAddresses + {rename : Address → Address} {before after : Ctx} + (hcontexts : Ctx.Renames rename before after) + (world : Owned) {fuel : Nat} {store released : Store} {value : RVal} + (hrelease : LowerSim.releaseResult before world fuel store value = + .ok released) + (hlive : released.live = 0) : + LowerSim.releaseResult after world fuel (Store.mapAddresses rename store) + value = .ok (Store.mapAddresses rename released) ∧ + (Store.mapAddresses rename released).live = 0 := by + constructor + · cases world with + | shared => + have hsource : dropVal before fuel store value = .ok released := by + simpa [LowerSim.releaseResult] using hrelease + simp only [LowerSim.releaseResult] + rw [(evalTransportAt hcontexts fuel).dropVal, hsource] + rfl + | unique => + have hsource : dropUVal before fuel store value = .ok released := by + simpa [LowerSim.releaseResult] using hrelease + simp only [LowerSim.releaseResult] + rw [(evalTransportAt hcontexts fuel).dropUVal, hsource] + rfl + · simpa using hlive + +end Readdress + +namespace Optimizer.Outcome + +/-- A selected optimizer result inherits reclamation from one successful +source run. `hselected` exposes the exact rebuild only in the rebuilt branch; +the skipped branch is literal source equality. -/ +theorem reclamation_of_witness + {outcome : Optimizer.Outcome} {policy : Optimizer.Policy} + {program : List ReaddressAll.Artifact} {summaries : HPT.SummaryEnv} + {main : Code} {oracle : Address → List RVal → Option RVal} + {world : Owned} {fuel : Nat} {sourceOut targetOut : Store × RVal} + (hselected : ∀ {result}, outcome.rebuilt = some result → + ∃ optimized, + HPT.OptimizeProgram.rebuildProgram policy.passes [] program summaries + main = .ok optimized ∧ + optimized.result = result) + (hsource : runMain + (outcome.sourceCtx policy program summaries main oracle) main fuel = + .ok sourceOut) + (htarget : runMain (outcome.targetCtx program oracle) + (outcome.main main) fuel = .ok targetOut) + (hrefines : outcome.RunRefines policy program summaries main sourceOut + targetOut) + (hreclamation : LowerSim.Reclamation + (outcome.sourceCtx policy program summaries main oracle) main world) : + LowerSim.Reclamation (outcome.targetCtx program oracle) + (outcome.main main) world := by + intro runFuel runStore runValue hrun + have htargetRelease : + ∃ releaseFuel released, + LowerSim.releaseResult (outcome.targetCtx program oracle) world + releaseFuel targetOut.1 targetOut.2 = .ok released ∧ + released.live = 0 := by + cases hrebuilt : outcome.rebuilt with + | none => + have hout : targetOut = sourceOut := by + simpa [Optimizer.Outcome.RunRefines, hrebuilt] using hrefines + subst targetOut + simpa [Optimizer.Outcome.sourceCtx, Optimizer.Outcome.sourceOracle, + Optimizer.Outcome.targetCtx, Optimizer.Outcome.main, hrebuilt] using + hreclamation hsource + | some result => + obtain ⟨optimized, hrebuild, hresult⟩ := hselected hrebuilt + subst result + obtain ⟨logicalOut, htargetOut, hhistory⟩ := by + simpa only [Optimizer.Outcome.RunRefines, hrebuilt] using hrefines + subst targetOut + obtain ⟨releaseFuel, released, hrelease, hlive⟩ := + hreclamation hsource + obtain ⟨logicalReleased, hlogicalRelease, hlogicalLive⟩ := + hhistory.releaseResult_live_eq_zero + (outcome.sourceCtx policy program summaries main oracle) world + hrelease hlive + have hrebuildRaw := + HPT.OptimizeProgram.rebuild_of_rebuildProgram_eq_ok hrebuild + have haudit := + ReaddressAll.rebuildSemanticAudit_of_rebuild_eq_ok hrebuildRaw + let entries := policy.rebuildEntries program summaries main + have hlogicalRelease' : + LowerSim.releaseResult + (optimized.result.rebuildSourceCtx entries oracle) world + releaseFuel logicalOut.1 logicalOut.2 = + .ok logicalReleased := by + rw [LowerSim.releaseResult_ctx_eq + (outcome.sourceCtx policy program summaries main oracle) + (optimized.result.rebuildSourceCtx entries oracle)] + exact hlogicalRelease + have hmapped := Readdress.releaseResult_mapAddresses + (optimized.result.renames_rebuildSourceCtx + (raw := entries) + (main := (HPT.OptimizeProgram.rewriteMain policy.passes + (HPT.programDeclEnv program) summaries main).code) + (by simpa [entries, Optimizer.Policy.rebuildEntries] using haudit) + oracle) + world hlogicalRelease' hlogicalLive + refine ⟨releaseFuel, + Readdress.Store.mapAddresses + (optimized.result.rebuildRename entries) logicalReleased, ?_, ?_⟩ + · simpa [Optimizer.Outcome.targetCtx, Optimizer.Outcome.main, + hrebuilt, entries] using hmapped.1 + · exact hmapped.2 + have houtput : (runStore, runValue) = targetOut := + LowerSim.runMain_success_unique hrun htarget + cases houtput + exact htargetRelease + +end Optimizer.Outcome + +namespace Optimizer + +/-- Directly produced checked HPT results preserve reclamation through the +fail-soft optimizer selection. -/ +theorem reclamation_of_runWithProducedHPT_eq + {policy : Policy} {program : List ReaddressAll.Artifact} {main : Code} + {limits : HPT.Limits} {production : HPT.Production limits program} + {outcome : Outcome} + (houtcome : runWithProducedHPT policy program main production = outcome) + (oracle : Address → List RVal → Option RVal) (world : Owned) + (hprogress : ∃ fuel sourceOut, + runMain + (outcome.sourceCtx policy program production.certificate.summaryEnv + main oracle) + main fuel = .ok sourceOut) + (hreclamation : LowerSim.Reclamation + (outcome.sourceCtx policy program production.certificate.summaryEnv + main oracle) + main world) : + LowerSim.Reclamation (outcome.targetCtx program oracle) + (outcome.main main) world := by + obtain ⟨fuel, sourceOut, hsource⟩ := hprogress + obtain ⟨targetOut, htarget, hrefines⟩ := + runMain_of_runWithProducedHPT_eq houtcome oracle fuel hsource + exact outcome.reclamation_of_witness + (hselected := by + intro result hrebuilt + apply rebuilt_eq_some_of_runWithProducedHPT + rw [houtcome] + exact hrebuilt) + hsource htarget hrefines hreclamation + +/-- Cached checked HPT results expose the same reclamation contract. -/ +theorem reclamation_of_runWithCachedHPT_eq + {policy : Policy} {program : List ReaddressAll.Artifact} {main : Code} + {limits : HPT.Cache.Limits} + {production : HPT.Cache.Production limits program} {outcome : Outcome} + (houtcome : runWithCachedHPT policy program main production = outcome) + (oracle : Address → List RVal → Option RVal) (world : Owned) + (hprogress : ∃ fuel sourceOut, + runMain + (outcome.sourceCtx policy program production.certificate.summaryEnv + main oracle) + main fuel = .ok sourceOut) + (hreclamation : LowerSim.Reclamation + (outcome.sourceCtx policy program production.certificate.summaryEnv + main oracle) + main world) : + LowerSim.Reclamation (outcome.targetCtx program oracle) + (outcome.main main) world := by + obtain ⟨fuel, sourceOut, hsource⟩ := hprogress + obtain ⟨targetOut, htarget, hrefines⟩ := + runMain_of_runWithCachedHPT_eq houtcome oracle fuel hsource + exact outcome.reclamation_of_witness + (hselected := by + intro result hrebuilt + apply rebuilt_eq_some_of_runWithCachedHPT + rw [houtcome] + exact hrebuilt) + hsource htarget hrefines hreclamation + +end Optimizer + +end Ix.Compiler.IxIR1 diff --git a/Ix/Compiler/IxIR1/Progress.lean b/Ix/Compiler/IxIR1/Progress.lean new file mode 100644 index 000000000..2a4c1f6d9 --- /dev/null +++ b/Ix/Compiler/IxIR1/Progress.lean @@ -0,0 +1,739 @@ +import Ix.Compiler.IxIR1.Sim +import Ix.Compiler.IxIR1.Mono + +/-! +# Progress foundations for the IxIR₁ evaluator + +The ownership development proves partial correctness: if an evaluator call +succeeds, exact roots are conserved. Progress also needs the complementary +fact that well-owned states cannot take a dynamic memory-error branch. + +This file starts with the recursive release core. At every fuel, a shared +drop or unique deep free from its matching owned root either exhausts fuel or +succeeds while consuming exactly that root. In particular, no `.mem`, +ordinary `.stuck`, or closed-world error is reachable inside the deep-release +mutual recursion. +-/ + +namespace Ix.Compiler.IxIR1 + +open Ix.Compiler.Ixon (Owned) +open Ix.Compiler.IxIR1.Sim + +/-- The only permitted failure in a progress approximation is fuel +exhaustion. -/ +def SucceedsOrFuel {alpha : Type} (result : Except Err alpha) : Prop := + result = .error .fuel ∨ ∃ value, result = .ok value + +/-- A finite evaluator observation that has genuinely settled without a +memory-discipline failure or a closed-world lookup failure. Unlike +`SucceedsOrFuel`, this judgment still admits ordinary stuckness, but excludes +fuel exhaustion, `Err.mem`, and `Err.unknownRef`. The latter strengthening +lets the source-guided call/extern contracts expose their closed-world +content independently of the remaining projection-admissibility boundary. -/ +inductive SettlesWithoutMemory {alpha : Type} (result : Except Err alpha) : + Prop where + | success (value : alpha) (hrun : result = .ok value) + | stuck (message : String) (hrun : result = .error (.stuck message)) + +private theorem bindOk {error alpha beta : Type} (value : alpha) + (next : alpha → Except error beta) : + (Except.ok value >>= next) = next value := rfl + +private theorem bindErr {error alpha beta : Type} (err : error) + (next : alpha → Except error beta) : + ((Except.error err : Except error alpha) >>= next) = .error err := rfl + +/-! A proof-oriented count of live slots. Unlike the public counter-facing +`Store.live`, this recursive list presentation makes the strict decrease of +`Store.kill` transparent to the termination argument below. -/ + +private def liveSlotsList {alpha : Type} : List (Option alpha) → Nat + | [] => 0 + | none :: rest => liveSlotsList rest + | some _ :: rest => liveSlotsList rest + 1 + +private def Store.liveSlots (store : Store) : Nat := + liveSlotsList store.nodes.toList + +private theorem liveSlotsList_set_none {alpha : Type} : + ∀ {values : List (Option alpha)} {index : Nat} {value : alpha}, + values[index]? = some (some value) → + liveSlotsList (values.set index none) + 1 = liveSlotsList values + | [], index, value, hget => by simp at hget + | head :: tail, 0, value, hget => by + simp only [List.getElem?_cons_zero, Option.some.injEq] at hget + subst head + simp [liveSlotsList] + | head :: tail, index + 1, value, hget => by + simp only [List.getElem?_cons_succ] at hget + have ih := liveSlotsList_set_none hget + cases head <;> simp [liveSlotsList] at ih ⊢ <;> omega + +private theorem liveSlotsList_set_some {alpha : Type} : + ∀ {values : List (Option alpha)} {index : Nat} {old new : alpha}, + values[index]? = some (some old) → + liveSlotsList (values.set index (some new)) = liveSlotsList values + | [], index, old, new, hget => by simp at hget + | head :: tail, 0, old, new, hget => by + simp only [List.getElem?_cons_zero, Option.some.injEq] at hget + subst head + simp [liveSlotsList] + | head :: tail, index + 1, old, new, hget => by + simp only [List.getElem?_cons_succ] at hget + have ih := liveSlotsList_set_some (new := new) hget + cases head <;> simp [liveSlotsList] at ih ⊢ <;> omega + +private theorem Store.liveSlots_rcTick (store : Store) : + store.rcTick.liveSlots = store.liveSlots := rfl + +private theorem Store.liveSlots_kill {store : Store} {loc : Nat} + {box : NodeBox} (hget : store.get? loc = some box) : + (store.kill loc).liveSlots + 1 = store.liveSlots := by + have hnodes := nodes_get?_of_get? hget + have hlist : store.nodes.toList[loc]? = some (some box) := by + simpa using hnodes + simp only [Store.liveSlots, Store.kill, Array.toList_set!] + exact liveSlotsList_set_none hlist + +private theorem Store.liveSlots_setBox {store : Store} {loc : Nat} + {old new : NodeBox} (hget : store.get? loc = some old) : + (store.setBox loc new).liveSlots = store.liveSlots := by + have hnodes := nodes_get?_of_get? hget + have hlist : store.nodes.toList[loc]? = some (some old) := by + simpa using hnodes + simp only [Store.liveSlots, Store.setBox, Array.toList_set!] + exact liveSlotsList_set_some hlist + +private theorem Store.liveSlots_decRcStore {store : Store} {loc : Nat} + {box : NodeBox} (hget : store.get? loc = some box) : + (decRcStore store loc box).liveSlots = store.liveSlots := by + unfold decRcStore + rw [Store.liveSlots_setBox] + · exact Store.liveSlots_rcTick store + · simpa using hget + +private def DropSafeAt (ctx : Ctx) (fuel : Nat) : Prop := + (∀ store value rest, + RootOwnership store (⟨.shared, value⟩ :: rest) → + dropVal ctx fuel store value = .error .fuel ∨ + ∃ store', dropVal ctx fuel store value = .ok store' ∧ + RootOwnership store' rest) ∧ + (∀ store values rest, + RootOwnership store (rootsFor .shared values ++ rest) → + dropMany ctx fuel store values = .error .fuel ∨ + ∃ store', dropMany ctx fuel store values = .ok store' ∧ + RootOwnership store' rest) + +private def DropUSafeAt (ctx : Ctx) (fuel : Nat) : Prop := + (∀ store value rest, + RootOwnership store (⟨.unique, value⟩ :: rest) → + dropUVal ctx fuel store value = .error .fuel ∨ + ∃ store', dropUVal ctx fuel store value = .ok store' ∧ + RootOwnership store' rest) ∧ + (∀ store values rest, + RootOwnership store (rootsFor .unique values ++ rest) → + dropManyU ctx fuel store values = .error .fuel ∨ + ∃ store', dropManyU ctx fuel store values = .ok store' ∧ + RootOwnership store' rest) + +private def DropSafetyAt (ctx : Ctx) (fuel : Nat) : Prop := + DropSafeAt ctx fuel ∧ DropUSafeAt ctx fuel + +/-- Shared and unique deep-release safety follow one evaluator-fuel +traversal. The owner-sensitive single-root cases remain separate, while the +zero-fuel and sequential-release recursion are established together. -/ +private theorem dropSafetyAt (ctx : Ctx) : ∀ fuel, DropSafetyAt ctx fuel := by + intro fuel + induction fuel with + | zero => + refine ⟨⟨?_, ?_⟩, ⟨?_, ?_⟩⟩ + · intro store value rest hown + left + simp [dropVal] + · intro store values rest hown + left + simp [dropMany] + · intro store value rest hown + left + simp [dropUVal] + · intro store values rest hown + left + simp [dropManyU] + | succ fuel ih => + obtain ⟨⟨ihVal, ihMany⟩, ⟨ihUVal, ihManyU⟩⟩ := ih + refine ⟨⟨?_, ?_⟩, ⟨?_, ?_⟩⟩ + · intro store value rest hown + cases value with + | lit literal => + right + exact ⟨store, by simp [dropVal], hown.dropNoLocation rfl⟩ + | erased => + right + exact ⟨store, by simp [dropVal], hown.dropNoLocation rfl⟩ + | loc loc => + have hworld := hown.roots_world + (⟨.shared, .loc loc⟩ : Root) (by simp) + obtain ⟨box, hget, hboxWorld⟩ := hworld + cases box with + | mk world rc node => + change world = .shared at hboxWorld + subst world + by_cases hrc : rc = 1 + · subst rc + have htickGet : + store.rcTick.get? loc = some ⟨.shared, 1, node⟩ := by + simpa using hget + have hchildren : RootOwnership (store.rcTick.kill loc) + (rootsFor .shared (nodeChildren node) ++ rest) := + (hown.rcTick).killSharedOne htickGet + cases node with + | ctorN cid fields => + simpa [dropVal, hget] using + ihMany (store.rcTick.kill loc) fields.toList rest hchildren + | papN address arity args => + simpa [dropVal, hget] using + ihMany (store.rcTick.kill loc) args.toList rest hchildren + · have hrcPos : 0 < rc := hown.shared_rc_pos hget + have hrcMany : 1 < rc := by omega + right + exact ⟨decRcStore store loc ⟨.shared, rc, node⟩, + dropVal_shared_many (ctx := ctx) (fuel := fuel) + hrcMany hget, + hown.dropSharedMany hrcMany hget⟩ + · intro store values rest hown + cases values with + | nil => + right + exact ⟨store, by simp [dropMany], by + simpa [rootsFor] using hown⟩ + | cons value values => + have hfirstOwn : RootOwnership store + (⟨.shared, value⟩ :: + (rootsFor .shared values ++ rest)) := by + simpa [rootsFor] using hown + rcases ihVal store value _ hfirstOwn with + hfirstFuel | ⟨middle, hfirst, hmiddle⟩ + · left + rw [dropMany.eq_def] + dsimp only + rw [hfirstFuel, bindErr] + · rcases ihMany middle values rest hmiddle with + hrestFuel | ⟨store', hrest, hfinal⟩ + · left + rw [dropMany.eq_def] + dsimp only + rw [hfirst, bindOk] + exact hrestFuel + · right + refine ⟨store', ?_, hfinal⟩ + rw [dropMany.eq_def] + dsimp only + rw [hfirst, bindOk] + exact hrest + · intro store value rest hown + cases value with + | lit literal => + right + exact ⟨store, by simp [dropUVal], hown.dropNoLocation rfl⟩ + | erased => + right + exact ⟨store, by simp [dropUVal], hown.dropNoLocation rfl⟩ + | loc loc => + have hworld := hown.roots_world + (⟨.unique, .loc loc⟩ : Root) (by simp) + obtain ⟨box, hget, hboxWorld⟩ := hworld + cases box with + | mk world rc node => + change world = .unique at hboxWorld + subst world + have hrc : rc = 1 := (hown.counts hget).1 + subst rc + cases node with + | ctorN cid fields => + have hchildren : RootOwnership (store.kill loc) + (rootsFor .unique fields.toList ++ rest) := + hown.killUniqueOne hget + simpa [dropUVal, hget] using + ihManyU (store.kill loc) fields.toList rest hchildren + | papN address arity args => + have hshared : (Owned.unique : Owned) = .shared := + hown.pap_shared hget rfl + contradiction + · intro store values rest hown + cases values with + | nil => + right + exact ⟨store, by simp [dropManyU], by + simpa [rootsFor] using hown⟩ + | cons value values => + have hfirstOwn : RootOwnership store + (⟨.unique, value⟩ :: + (rootsFor .unique values ++ rest)) := by + simpa [rootsFor] using hown + rcases ihUVal store value _ hfirstOwn with + hfirstFuel | ⟨middle, hfirst, hmiddle⟩ + · left + rw [dropManyU.eq_def] + dsimp only + rw [hfirstFuel, bindErr] + · rcases ihManyU middle values rest hmiddle with + hrestFuel | ⟨store', hrest, hfinal⟩ + · left + rw [dropManyU.eq_def] + dsimp only + rw [hfirst, bindOk] + exact hrestFuel + · right + refine ⟨store', ?_, hfinal⟩ + rw [dropManyU.eq_def] + dsimp only + rw [hfirst, bindOk] + exact hrest + +/-- A well-owned shared root can only succeed or exhaust fuel during deep +release, and success consumes exactly that root. -/ +theorem dropVal_safe {ctx : Ctx} {fuel : Nat} {store : Store} + {value : RVal} {rest : List Root} + (hown : RootOwnership store (⟨.shared, value⟩ :: rest)) : + dropVal ctx fuel store value = .error .fuel ∨ + ∃ store', dropVal ctx fuel store value = .ok store' ∧ + RootOwnership store' rest := + (dropSafetyAt ctx fuel).1.1 store value rest hown + +/-- Sequential shared release has the same fuel-or-success progress +property. -/ +theorem dropMany_safe {ctx : Ctx} {fuel : Nat} {store : Store} + {values : List RVal} {rest : List Root} + (hown : RootOwnership store (rootsFor .shared values ++ rest)) : + dropMany ctx fuel store values = .error .fuel ∨ + ∃ store', dropMany ctx fuel store values = .ok store' ∧ + RootOwnership store' rest := + (dropSafetyAt ctx fuel).1.2 store values rest hown + +/-- A well-owned unique root can only succeed or exhaust fuel during deep +free, and success consumes exactly that root. -/ +theorem dropUVal_safe {ctx : Ctx} {fuel : Nat} {store : Store} + {value : RVal} {rest : List Root} + (hown : RootOwnership store (⟨.unique, value⟩ :: rest)) : + dropUVal ctx fuel store value = .error .fuel ∨ + ∃ store', dropUVal ctx fuel store value = .ok store' ∧ + RootOwnership store' rest := + (dropSafetyAt ctx fuel).2.1 store value rest hown + +/-- Sequential unique deep free has the same fuel-or-success progress +property. -/ +theorem dropManyU_safe {ctx : Ctx} {fuel : Nat} {store : Store} + {values : List RVal} {rest : List Root} + (hown : RootOwnership store (rootsFor .unique values ++ rest)) : + dropManyU ctx fuel store values = .error .fuel ∨ + ∃ store', dropManyU ctx fuel store values = .ok store' ∧ + RootOwnership store' rest := + (dropSafetyAt ctx fuel).2.2 store values rest hown + +/-! ## Deep-release termination -/ + +private def DropValProgressAt (ctx : Ctx) (store : Store) : Prop := + ∀ value rest, + RootOwnership store (⟨.shared, value⟩ :: rest) → + ∃ fuel store', + dropVal ctx fuel store value = .ok store' ∧ + RootOwnership store' rest ∧ + store'.liveSlots ≤ store.liveSlots + +private def DropManyProgressAt (ctx : Ctx) (store : Store) : Prop := + ∀ values rest, + RootOwnership store (rootsFor .shared values ++ rest) → + ∃ fuel store', + dropMany ctx fuel store values = .ok store' ∧ + RootOwnership store' rest ∧ + store'.liveSlots ≤ store.liveSlots + +/-- Unique single-root termination half of the combined deep-release +judgment. -/ +private def DropUValProgressAt (ctx : Ctx) (store : Store) : Prop := + ∀ value rest, + RootOwnership store (⟨.unique, value⟩ :: rest) → + ∃ fuel store', + dropUVal ctx fuel store value = .ok store' ∧ + RootOwnership store' rest ∧ + store'.liveSlots ≤ store.liveSlots + +/-- Unique sequential termination half of the combined deep-release +judgment. -/ +private def DropManyUProgressAt (ctx : Ctx) (store : Store) : Prop := + ∀ values rest, + RootOwnership store (rootsFor .unique values ++ rest) → + ∃ fuel store', + dropManyU ctx fuel store values = .ok store' ∧ + RootOwnership store' rest ∧ + store'.liveSlots ≤ store.liveSlots + +private def DropProgressAt (ctx : Ctx) (store : Store) : Prop := + (DropValProgressAt ctx store ∧ DropManyProgressAt ctx store) ∧ + (DropUValProgressAt ctx store ∧ DropManyUProgressAt ctx store) + +/-- Shared and unique deep-release termination use one strong induction on +the number of live heap slots. Each owner keeps its local destruction rule; +recursive child release and sequential fuel synchronization share the same +well-founded traversal. -/ +private theorem dropProgressAt (ctx : Ctx) : ∀ live store, + store.liveSlots = live → + DropProgressAt ctx store := by + intro live + induction live using Nat.strongRecOn with + | ind live ih => + have hval : ∀ store, store.liveSlots = live → + DropValProgressAt ctx store := by + intro store hlive value rest hown + cases value with + | lit literal => + exact ⟨1, store, by simp [dropVal], + hown.dropNoLocation rfl, Nat.le_refl _⟩ + | erased => + exact ⟨1, store, by simp [dropVal], + hown.dropNoLocation rfl, Nat.le_refl _⟩ + | loc loc => + have hworld := hown.roots_world + (⟨.shared, .loc loc⟩ : Root) (by simp) + obtain ⟨box, hget, hboxWorld⟩ := hworld + cases box with + | mk world rc node => + change world = .shared at hboxWorld + subst world + by_cases hrc : rc = 1 + · subst rc + have htickGet : + store.rcTick.get? loc = some ⟨.shared, 1, node⟩ := by + simpa using hget + let killed := store.rcTick.kill loc + have hkilledOwn : RootOwnership killed + (rootsFor .shared (nodeChildren node) ++ rest) := by + dsimp only [killed] + exact (hown.rcTick).killSharedOne htickGet + have hkilledEq : killed.liveSlots + 1 = live := by + have hk : killed.liveSlots + 1 = store.liveSlots := by + dsimp only [killed] + have hkill := Store.liveSlots_kill htickGet + rw [Store.liveSlots_rcTick] at hkill + exact hkill + exact hk.trans hlive + have hkilledLt : killed.liveSlots < live := by omega + have hsmall := ih killed.liveSlots hkilledLt killed rfl + cases node with + | ctorN cid fields => + obtain ⟨fuel, store', hrun, hown', hslots⟩ := + hsmall.1.2 fields.toList rest (by + simpa [nodeChildren] using hkilledOwn) + refine ⟨fuel + 1, store', ?_, hown', ?_⟩ + · simpa [dropVal, hget] using hrun + · exact Nat.le_trans hslots (by omega) + | papN address arity args => + obtain ⟨fuel, store', hrun, hown', hslots⟩ := + hsmall.1.2 args.toList rest (by + simpa [nodeChildren] using hkilledOwn) + refine ⟨fuel + 1, store', ?_, hown', ?_⟩ + · simpa [dropVal, hget] using hrun + · exact Nat.le_trans hslots (by omega) + · have hrcPos : 0 < rc := hown.shared_rc_pos hget + have hrcMany : 1 < rc := by omega + let store' := decRcStore store loc ⟨.shared, rc, node⟩ + refine ⟨1, store', ?_, ?_, ?_⟩ + · exact dropVal_shared_many (ctx := ctx) (fuel := 0) + hrcMany hget + · exact hown.dropSharedMany hrcMany hget + · exact Nat.le_of_eq (Store.liveSlots_decRcStore hget) + have hvalLe : ∀ store, store.liveSlots ≤ live → + DropValProgressAt ctx store := by + intro store hle + rcases Nat.eq_or_lt_of_le hle with heq | hlt + · exact hval store heq + · exact (ih store.liveSlots hlt store rfl).1.1 + have hmanyLe : ∀ values store rest, + store.liveSlots ≤ live → + RootOwnership store (rootsFor .shared values ++ rest) → + ∃ fuel store', + dropMany ctx fuel store values = .ok store' ∧ + RootOwnership store' rest ∧ + store'.liveSlots ≤ store.liveSlots := by + intro values + induction values with + | nil => + intro store rest hle hown + exact ⟨1, store, by simp [dropMany], by + simpa [rootsFor] using hown, Nat.le_refl _⟩ + | cons value values ihValues => + intro store rest hle hown + have hfirstOwn : RootOwnership store + (⟨.shared, value⟩ :: + (rootsFor .shared values ++ rest)) := by + simpa [rootsFor] using hown + obtain ⟨firstFuel, middle, hfirst, hmiddle, hmiddleSlots⟩ := + hvalLe store hle value _ hfirstOwn + obtain ⟨restFuel, store', hrest, hfinal, hfinalSlots⟩ := + ihValues middle rest (Nat.le_trans hmiddleSlots hle) hmiddle + let common := max firstFuel restFuel + have hfirst' : dropVal ctx common store value = .ok middle := + dropVal_mono (Nat.le_max_left _ _) hfirst + have hrest' : dropMany ctx common middle values = .ok store' := + dropMany_mono (Nat.le_max_right _ _) hrest + refine ⟨common + 1, store', ?_, hfinal, + Nat.le_trans hfinalSlots hmiddleSlots⟩ + rw [dropMany.eq_def] + dsimp only + rw [hfirst', bindOk] + exact hrest' + have hshared : ∀ store, store.liveSlots = live → + DropValProgressAt ctx store ∧ DropManyProgressAt ctx store := by + intro store hlive + exact ⟨hval store hlive, fun values rest hown => + hmanyLe values store rest (by omega) hown⟩ + have huval : ∀ store, store.liveSlots = live → + DropUValProgressAt ctx store := by + intro store hlive value rest hown + cases value with + | lit literal => + exact ⟨1, store, by simp [dropUVal], + hown.dropNoLocation rfl, Nat.le_refl _⟩ + | erased => + exact ⟨1, store, by simp [dropUVal], + hown.dropNoLocation rfl, Nat.le_refl _⟩ + | loc loc => + have hworld := hown.roots_world + (⟨.unique, .loc loc⟩ : Root) (by simp) + obtain ⟨box, hget, hboxWorld⟩ := hworld + cases box with + | mk world rc node => + change world = .unique at hboxWorld + subst world + have hrc : rc = 1 := (hown.counts hget).1 + subst rc + cases node with + | ctorN cid fields => + let killed := store.kill loc + have hkilledOwn : RootOwnership killed + (rootsFor .unique fields.toList ++ rest) := by + dsimp only [killed] + simpa [nodeChildren] using hown.killUniqueOne hget + have hkilledEq : killed.liveSlots + 1 = live := by + have hk : killed.liveSlots + 1 = store.liveSlots := by + dsimp only [killed] + exact Store.liveSlots_kill hget + exact hk.trans hlive + have hkilledLt : killed.liveSlots < live := by omega + have hsmall := ih killed.liveSlots hkilledLt killed rfl + obtain ⟨fuel, store', hrun, hown', hslots⟩ := + hsmall.2.2 fields.toList rest hkilledOwn + refine ⟨fuel + 1, store', ?_, hown', ?_⟩ + · simpa [dropUVal, hget] using hrun + · exact Nat.le_trans hslots (by omega) + | papN address arity args => + have hshared : (Owned.unique : Owned) = .shared := + hown.pap_shared hget rfl + contradiction + have huvalLe : ∀ store, store.liveSlots ≤ live → + DropUValProgressAt ctx store := by + intro store hle + rcases Nat.eq_or_lt_of_le hle with heq | hlt + · exact huval store heq + · exact (ih store.liveSlots hlt store rfl).2.1 + have hmanyULe : ∀ values store rest, + store.liveSlots ≤ live → + RootOwnership store (rootsFor .unique values ++ rest) → + ∃ fuel store', + dropManyU ctx fuel store values = .ok store' ∧ + RootOwnership store' rest ∧ + store'.liveSlots ≤ store.liveSlots := by + intro values + induction values with + | nil => + intro store rest hle hown + exact ⟨1, store, by simp [dropManyU], by + simpa [rootsFor] using hown, Nat.le_refl _⟩ + | cons value values ihValues => + intro store rest hle hown + have hfirstOwn : RootOwnership store + (⟨.unique, value⟩ :: + (rootsFor .unique values ++ rest)) := by + simpa [rootsFor] using hown + obtain ⟨firstFuel, middle, hfirst, hmiddle, hmiddleSlots⟩ := + huvalLe store hle value _ hfirstOwn + obtain ⟨restFuel, store', hrest, hfinal, hfinalSlots⟩ := + ihValues middle rest (Nat.le_trans hmiddleSlots hle) hmiddle + let common := max firstFuel restFuel + have hfirst' : dropUVal ctx common store value = .ok middle := + dropUVal_mono (Nat.le_max_left _ _) hfirst + have hrest' : dropManyU ctx common middle values = .ok store' := + dropManyU_mono (Nat.le_max_right _ _) hrest + refine ⟨common + 1, store', ?_, hfinal, + Nat.le_trans hfinalSlots hmiddleSlots⟩ + rw [dropManyU.eq_def] + dsimp only + rw [hfirst', bindOk] + exact hrest' + intro store hlive + exact ⟨hshared store hlive, + ⟨huval store hlive, fun values rest hown => + hmanyULe values store rest (by omega) hown⟩⟩ + +/-- Every well-owned shared root has some successful deep-release fuel. -/ +theorem dropVal_progress {ctx : Ctx} {store : Store} {value : RVal} + {rest : List Root} + (hown : RootOwnership store (⟨.shared, value⟩ :: rest)) : + ∃ fuel store', dropVal ctx fuel store value = .ok store' ∧ + RootOwnership store' rest := by + obtain ⟨fuel, store', hrun, hown', _⟩ := + (dropProgressAt ctx store.liveSlots store rfl).1.1 value rest hown + exact ⟨fuel, store', hrun, hown'⟩ + +/-- Every well-owned vector of shared roots has some successful sequential +release fuel. -/ +theorem dropMany_progress {ctx : Ctx} {store : Store} + {values : List RVal} {rest : List Root} + (hown : RootOwnership store (rootsFor .shared values ++ rest)) : + ∃ fuel store', dropMany ctx fuel store values = .ok store' ∧ + RootOwnership store' rest := by + obtain ⟨fuel, store', hrun, hown', _⟩ := + (dropProgressAt ctx store.liveSlots store rfl).1.2 values rest hown + exact ⟨fuel, store', hrun, hown'⟩ + +/-- Every well-owned unique root has some successful deep-free fuel. -/ +theorem dropUVal_progress {ctx : Ctx} {store : Store} {value : RVal} + {rest : List Root} + (hown : RootOwnership store (⟨.unique, value⟩ :: rest)) : + ∃ fuel store', dropUVal ctx fuel store value = .ok store' ∧ + RootOwnership store' rest := by + obtain ⟨fuel, store', hrun, hown', _⟩ := + (dropProgressAt ctx store.liveSlots store rfl).2.1 value rest hown + exact ⟨fuel, store', hrun, hown'⟩ + +/-- Every well-owned vector of unique roots has some successful sequential +deep-free fuel. -/ +theorem dropManyU_progress {ctx : Ctx} {store : Store} + {values : List RVal} {rest : List Root} + (hown : RootOwnership store (rootsFor .unique values ++ rest)) : + ∃ fuel store', dropManyU ctx fuel store values = .ok store' ∧ + RootOwnership store' rest := by + obtain ⟨fuel, store', hrun, hown', _⟩ := + (dropProgressAt ctx store.liveSlots store rfl).2.2 values rest hown + exact ⟨fuel, store', hrun, hown'⟩ + +/-! ## Callable progress contracts -/ + +/-- Successful body execution exists for every well-owned argument frame. +This is the total-correctness companion of `FnOwnershipContract`; keeping the +two contracts separate lets the established ownership development remain a +reusable partial-correctness layer. -/ +structure FnProgressContract (ctx : Ctx) (d : FnDef) + (argWorlds : List Owned) : Prop where + arity_eq : argWorlds.length = d.arity + progresses : ∀ {store : Store} {args : List RVal} {rest : List Root}, + args.length = argWorlds.length → + RootOwnership store (rootsForWorlds argWorlds args ++ rest) → + ∃ fuel store' value, + runCode ctx fuel d store args.reverse d.body = .ok (store', value) + +/-- Entering a known function terminates when its body has a progress +contract. The existing ownership contract proves the constructed body +result passes the evaluator's dynamic result-world check. -/ +theorem invoke_fn_progress {ctx : Ctx} {address : Ixon.Address} + {d : FnDef} {argWorlds : List Owned} {args : List RVal} + {store : Store} {rest : List Root} + (hdecl : ctx.decls address = some (.fn d)) + (hprogress : FnProgressContract ctx d argWorlds) + (hownership : FnOwnershipContract ctx d argWorlds) + (hlength : args.length = argWorlds.length) + (hown : RootOwnership store + (rootsForWorlds argWorlds args ++ rest)) : + ∃ fuel store' value, + invoke ctx fuel address args store = .ok (store', value) := by + obtain ⟨bodyFuel, store', value, hbody⟩ := + hprogress.progresses hlength hown + have hout : RootOwnership store' (⟨d.result, value⟩ :: rest) := + hownership.preserves hlength hown hbody + have hworld : HasWorld store' d.result value := + hout.roots_world ⟨d.result, value⟩ (by simp) + have hcheck : checkResultWorld d.result (store', value) = + .ok (store', value) := by + simp [checkResultWorld, rval_hasWorld_eq_true_iff.mpr hworld] + have harity : args.length = d.arity := + hlength.trans hprogress.arity_eq + refine ⟨bodyFuel + 1, store', value, ?_⟩ + rw [invoke.eq_def] + dsimp only + rw [hdecl] + dsimp only + simp only [harity] + simp + rw [hbody, bindOk] + exact hcheck + +/-- Operation-level direct-call progress, with exact result ownership ready +for the caller continuation. -/ +theorem runOp_call_progress {ctx : Ctx} {cur d : FnDef} + {address : Ixon.Address} {atoms : Array Atom} {args : List RVal} + {argWorlds : List Owned} {store : Store} {env : List RVal} + {rest : List Root} + (hargs : resolveAtoms env atoms = .ok args) + (hdecl : ctx.decls address = some (.fn d)) + (hprogress : FnProgressContract ctx d argWorlds) + (hownership : FnOwnershipContract ctx d argWorlds) + (hlength : args.length = argWorlds.length) + (hown : RootOwnership store + (rootsForWorlds argWorlds args ++ rest)) : + ∃ fuel store' value, + runOp ctx fuel cur store env (.call address atoms) = + .ok (store', value) ∧ + RootOwnership store' (⟨d.result, value⟩ :: rest) := by + obtain ⟨invokeFuel, store', value, hinvoke⟩ := + invoke_fn_progress hdecl hprogress hownership hlength hown + have hrun : runOp ctx (invokeFuel + 1) cur store env + (.call address atoms) = .ok (store', value) := by + rw [runOp.eq_def] + dsimp only + rw [hargs, bindOk] + exact hinvoke + refine ⟨invokeFuel + 1, store', value, hrun, ?_⟩ + exact runOp_call_owned (fuel := invokeFuel) hargs hdecl hownership + hown hrun + +/-- Recursive self-call progress. The progress contract supplies a body +run; its ownership twin proves that run passes `checkResultWorld`. -/ +theorem runOp_callSelf_progress {ctx : Ctx} {cur : FnDef} + {atoms : Array Atom} {args : List RVal} + {argWorlds : List Owned} {store : Store} {env : List RVal} + {rest : List Root} + (hargs : resolveAtoms env atoms = .ok args) + (hprogress : FnProgressContract ctx cur argWorlds) + (hownership : FnOwnershipContract ctx cur argWorlds) + (hlength : args.length = argWorlds.length) + (hown : RootOwnership store + (rootsForWorlds argWorlds args ++ rest)) : + ∃ fuel store' value, + runOp ctx fuel cur store env (.callSelf atoms) = + .ok (store', value) ∧ + RootOwnership store' (⟨cur.result, value⟩ :: rest) := by + obtain ⟨bodyFuel, store', value, hbody⟩ := + hprogress.progresses hlength hown + have hout : RootOwnership store' + (⟨cur.result, value⟩ :: rest) := + hownership.preserves hlength hown hbody + have hworld : HasWorld store' cur.result value := + hout.roots_world ⟨cur.result, value⟩ (by simp) + have hcheck : checkResultWorld cur.result (store', value) = + .ok (store', value) := by + simp [checkResultWorld, rval_hasWorld_eq_true_iff.mpr hworld] + have harity : args.length = cur.arity := + hlength.trans hprogress.arity_eq + have hrun : runOp ctx (bodyFuel + 1) cur store env + (.callSelf atoms) = .ok (store', value) := by + rw [runOp.eq_def] + dsimp only + rw [hargs, bindOk] + simp only [harity] + simp + rw [hbody, bindOk] + exact hcheck + exact ⟨bodyFuel + 1, store', value, hrun, hout⟩ + +end Ix.Compiler.IxIR1 diff --git a/Ix/Compiler/IxIR1/RcPotential.lean b/Ix/Compiler/IxIR1/RcPotential.lean new file mode 100644 index 000000000..97b2bd9e7 --- /dev/null +++ b/Ix/Compiler/IxIR1/RcPotential.lean @@ -0,0 +1,195 @@ +import Ix.Compiler.IxIR1.Sim + +namespace Ix.Compiler.IxIR1.CostTrace + +/-! ## Reference-count potential + +Raw reference-count traffic is not locally compositional across deep drop: +one source-level release may recursively visit an arbitrarily large heap. +The missing state is the outstanding shared reference-count mass. Each +successful shared `drop` trades exactly one unit of that potential for one +executed RC instruction, while a retain creates one unit and executes one RC +instruction. This makes deep release free in the amortized measure and +explains the tariff's factor of two for retained values. -/ + +def slotSharedRcPotential : Option NodeBox → Nat + | some ⟨.shared, rc, _⟩ => rc + | some ⟨.unique, _, _⟩ | none => 0 + +def sharedRcPotentialList : List (Option NodeBox) → Nat + | [] => 0 + | slot :: rest => slotSharedRcPotential slot + sharedRcPotentialList rest + +theorem sharedRcPotentialList_append (left right) : + sharedRcPotentialList (left ++ right) = + sharedRcPotentialList left + sharedRcPotentialList right := by + induction left with + | nil => simp [sharedRcPotentialList] + | cons head tail ih => + simp [sharedRcPotentialList, ih, Nat.add_assoc] + +/-- Sum of the reference counts in all live shared heap slots. -/ +def sharedRcPotential (store : Store) : Nat := + sharedRcPotentialList store.nodes.toList + +@[simp] theorem sharedRcPotential_rcTick (store : Store) : + sharedRcPotential store.rcTick = sharedRcPotential store := rfl + +/-- Executed RC instructions plus the shared ownership they leave pending. -/ +def amortizedRc (store : Store) : Nat := + store.rcops + sharedRcPotential store + +/-- Growth of the RC potential across a target-store transition. -/ +def RcPotentialGrowthLE (before after : Store) (allowance : Nat) : Prop := + amortizedRc after ≤ amortizedRc before + allowance + +theorem RcPotentialGrowthLE.refl (store : Store) : + RcPotentialGrowthLE store store 0 := by + simp [RcPotentialGrowthLE] + +theorem RcPotentialGrowthLE.trans {first middle last : Store} {left right} + (hleft : RcPotentialGrowthLE first middle left) + (hright : RcPotentialGrowthLE middle last right) : + RcPotentialGrowthLE first last (left + right) := by + simp only [RcPotentialGrowthLE] at hleft hright ⊢ + omega + +theorem RcPotentialGrowthLE.monoAllowance {before after : Store} + {smaller larger : Nat} (h : RcPotentialGrowthLE before after smaller) + (hle : smaller ≤ larger) : + RcPotentialGrowthLE before after larger := by + simp only [RcPotentialGrowthLE] at h ⊢ + omega + +/-- A potential bound started from an empty heap is an ordinary bound on +executed RC instructions. -/ +theorem RcPotentialGrowthLE.rcops_of_initial_zero + {before after : Store} {allowance : Nat} + (hgrowth : RcPotentialGrowthLE before after allowance) + (hpotential : sharedRcPotential before = 0) : + after.rcops ≤ before.rcops + allowance := by + simp only [RcPotentialGrowthLE, amortizedRc, hpotential, Nat.add_zero] + at hgrowth + omega + +theorem sharedRcPotentialList_set : + ∀ {slots : List (Option NodeBox)} {index : Nat} {old new}, + slots[index]? = some old → + sharedRcPotentialList (slots.set index new) + + slotSharedRcPotential old = + sharedRcPotentialList slots + slotSharedRcPotential new + | [], index, old, new, hget => by simp at hget + | head :: rest, 0, old, new, hget => by + simp only [List.getElem?_cons_zero, Option.some.injEq] at hget + subst head + simp [sharedRcPotentialList] + omega + | head :: rest, index + 1, old, new, hget => by + simp only [List.getElem?_cons_succ] at hget + have ih := sharedRcPotentialList_set (new := new) hget + simp only [List.set, sharedRcPotentialList] + omega + +theorem sharedRcPotential_setBox {store : Store} {location : Nat} + {old new : NodeBox} (hget : store.get? location = some old) : + sharedRcPotential (store.setBox location new) + + slotSharedRcPotential (some old) = + sharedRcPotential store + slotSharedRcPotential (some new) := by + have hnodes := Sim.nodes_get?_of_get? hget + have hlist : store.nodes.toList[location]? = some (some old) := by + simpa using hnodes + simp only [sharedRcPotential, Store.setBox, Array.toList_set!] + exact sharedRcPotentialList_set hlist + +theorem sharedRcPotential_kill {store : Store} {location : Nat} + {box : NodeBox} (hget : store.get? location = some box) : + sharedRcPotential (store.kill location) + + slotSharedRcPotential (some box) = sharedRcPotential store := by + have hnodes := Sim.nodes_get?_of_get? hget + have hlist : store.nodes.toList[location]? = some (some box) := by + simpa using hnodes + have hset := sharedRcPotentialList_set + (new := none) hlist + simpa [sharedRcPotential, Store.kill, Array.toList_set!, + slotSharedRcPotential] using hset + +theorem RcPotentialGrowthLE.allocNode (store : Store) + (world : Ixon.Owned) (node : Node) : + RcPotentialGrowthLE store (store.allocNode world node).1 1 := by + cases world <;> + simp [RcPotentialGrowthLE, amortizedRc, sharedRcPotential, + sharedRcPotentialList_append, sharedRcPotentialList, + slotSharedRcPotential, Store.allocNode] <;> + omega + +theorem amortizedRc_incRcStore {store : Store} {location rc : Nat} + {node : Node} + (hget : store.get? location = some ⟨.shared, rc, node⟩) : + amortizedRc + (Sim.incRcStore store location ⟨.shared, rc, node⟩) = + amortizedRc store + 2 := by + have hset := sharedRcPotential_setBox + (new := (⟨.shared, rc + 1, node⟩ : NodeBox)) + (by simpa using hget) + simp [slotSharedRcPotential] at hset + simp only [Sim.incRcStore, amortizedRc, sharedRcPotential_rcTick] + change store.rcops + 1 + + sharedRcPotential + (store.setBox location ⟨.shared, rc + 1, node⟩) = + store.rcops + sharedRcPotential store + 2 + omega + +theorem amortizedRc_tickKillSharedOne {store : Store} + {location : Nat} {node : Node} + (hget : store.get? location = some ⟨.shared, 1, node⟩) : + amortizedRc (store.rcTick.kill location) = amortizedRc store := by + have hgetTick : + store.rcTick.get? location = some ⟨.shared, 1, node⟩ := by + simpa using hget + have hkill := sharedRcPotential_kill hgetTick + have hpotential : + sharedRcPotential (store.rcTick.kill location) + 1 = + sharedRcPotential store := by + simpa [slotSharedRcPotential] using hkill + change store.rcops + 1 + + sharedRcPotential (store.rcTick.kill location) = + store.rcops + sharedRcPotential store + omega + +theorem amortizedRc_decRcStore {store : Store} {location rc : Nat} + {node : Node} (hrc : 1 < rc) + (hget : store.get? location = some ⟨.shared, rc, node⟩) : + amortizedRc + (Sim.decRcStore store location ⟨.shared, rc, node⟩) = + amortizedRc store := by + have hgetTick : + store.rcTick.get? location = some ⟨.shared, rc, node⟩ := by + simpa using hget + have hset := sharedRcPotential_setBox + (new := (⟨.shared, rc - 1, node⟩ : NodeBox)) hgetTick + have hpotential : + sharedRcPotential + (Sim.decRcStore store location ⟨.shared, rc, node⟩) + 1 = + sharedRcPotential store := by + simp only [Sim.decRcStore] + simp [slotSharedRcPotential] at hset + omega + change store.rcops + 1 + + sharedRcPotential + (Sim.decRcStore store location ⟨.shared, rc, node⟩) = + store.rcops + sharedRcPotential store + omega + +theorem amortizedRc_killUnique {store : Store} {location rc : Nat} + {node : Node} + (hget : store.get? location = some ⟨.unique, rc, node⟩) : + amortizedRc (store.kill location) = amortizedRc store := by + have hkill := sharedRcPotential_kill hget + have hpotential : sharedRcPotential (store.kill location) = + sharedRcPotential store := by + simpa [slotSharedRcPotential] using hkill + unfold amortizedRc + rw [hpotential] + rfl + +end Ix.Compiler.IxIR1.CostTrace diff --git a/Ix/Compiler/IxIR1/Reachability.lean b/Ix/Compiler/IxIR1/Reachability.lean new file mode 100644 index 000000000..f3d8cba02 --- /dev/null +++ b/Ix/Compiler/IxIR1/Reachability.lean @@ -0,0 +1,731 @@ +import Ix.Compiler.IxIR1.EvalRewrite +import Ix.Compiler.IxIR1.Serialize + +/-! +# Checked rooted declaration reachability + +This pass removes declarations which cannot be reached from top-level main or +an explicitly exported root. A certificate is checked against an exact graph +digest, root list, canonical retained list, and successor closure. + +Dynamic `apply` is deliberately conservative in version 1. If it occurs in +main or a retained declaration, the checker accepts only the complete +declaration set. Otherwise every executable declaration lookup is named by a +direct `call` or `papp`, and the exact evaluator proof below transports a run +through the filtered environment. `callSelf` stays within its already +retained owner; constructor identities and direct oracle calls do not perform +declaration lookup. +-/ + +namespace Ix.Compiler.IxIR1.Reachability + +open Ix.Compiler.Ixon (Address) +open Ix.Compiler.IxIR +open Ix.Compiler.IxIR1.Sim + +def currentVersion : Nat := 1 + +/-! ## Executable edge and safety walks -/ + +namespace Op + +/-- Declaration keys which this operation can look up without inspecting a +runtime value. -/ +def targets : Ix.Compiler.IxIR1.Op → List Address + | .call function _ | .papp function _ => [function] + | _ => [] + +def hasApply : Ix.Compiler.IxIR1.Op → Bool + | .apply _ _ => true + | _ => false + +/-- Version-1 safety: dynamic application requires the all-retained fallback; +direct calls and PAP creation must point outside the declaration domain or to +a retained declaration. -/ +def safe (keys retained : List Address) : Ix.Compiler.IxIR1.Op → Bool + | .call function _ | .papp function _ => + !keys.contains function || retained.contains function + | .apply _ _ => false + | _ => true + +end Op + +mutual + +def Code.targets : Code → List Address + | .ret _ => [] + | .letOp operation rest => Op.targets operation ++ Code.targets rest + | .case _ _ alternatives => AltList.targets alternatives.toList + +def Alt.targets : Alt → List Address + | .mk _ _ body => Code.targets body + +def AltList.targets : List Alt → List Address + | [] => [] + | alternative :: rest => Alt.targets alternative ++ AltList.targets rest + +end + +mutual + +def Code.hasApply : Code → Bool + | .ret _ => false + | .letOp operation rest => Op.hasApply operation || Code.hasApply rest + | .case _ _ alternatives => AltList.hasApply alternatives.toList + +def Alt.hasApply : Alt → Bool + | .mk _ _ body => Code.hasApply body + +def AltList.hasApply : List Alt → Bool + | [] => false + | alternative :: rest => + Alt.hasApply alternative || AltList.hasApply rest + +end + +mutual + +def Code.safe (keys retained : List Address) : Code → Bool + | .ret _ => true + | .letOp operation rest => + Op.safe keys retained operation && Code.safe keys retained rest + | .case _ _ alternatives => + AltList.safe keys retained alternatives.toList + +def Alt.safe (keys retained : List Address) : Alt → Bool + | .mk _ _ body => Code.safe keys retained body + +def AltList.safe (keys retained : List Address) : List Alt → Bool + | [] => true + | alternative :: rest => + Alt.safe keys retained alternative && AltList.safe keys retained rest + +end + +namespace Decl + +def safe (keys retained : List Address) : Decl → Bool + | .extern _ => true + | .fn function => Code.safe keys retained function.body + +end Decl + +/-! ## Certificate and deterministic producer -/ + +private def entryBytes (entry : Address × Decl) : ByteArray := + Encoding.address entry.1 ++ Encoding.blob entry.2.preimage + +private def inputDomain : ByteArray := + Encoding.domain "compilatrix/ixir1/reachability-input/1" ++ Encoding.tag 0 + +/-- Exact digest of the old-keyed declaration rows and main code checked by a +reachability certificate. -/ +def inputRoot (entries : List (Address × Decl)) (main : Code) : Address := + Address.blake3 + (inputDomain ++ Encoding.list entryBytes entries ++ + Encoding.blob main.bytes) + +structure Certificate where + version : Nat := currentVersion + inputRoot : Address + roots : List Address + retained : List Address + deriving BEq, Repr + +private def keysOf (entries : List (Address × Decl)) : List Address := + entries.map (fun entry => entry.1) + +private def canonicalRetained (keys retained : List Address) : Bool := + retained == keys.filter retained.contains + +private def allRetained (keys retained : List Address) : Bool := + keys.all retained.contains + +private def rootsRetained (keys retained roots : List Address) : Bool := + roots.all fun root => keys.contains root && retained.contains root + +private def retainedDeclarationsSafe (keys retained : List Address) + (entries : List (Address × Decl)) : Bool := + entries.all fun entry => + !retained.contains entry.1 || Decl.safe keys retained entry.2 + +/-- Executable certificate checker. A complete retained set is always safe. +Any proper subset must be statically closed and contain no dynamic `apply` in +main or a retained function. -/ +def validate (entries : List (Address × Decl)) (main : Code) + (expectedRoots : List Address) (certificate : Certificate) : Bool := + let keys := keysOf entries + certificate.version == currentVersion && + certificate.inputRoot == inputRoot entries main && + certificate.roots == expectedRoots && + canonicalRetained keys certificate.retained && + rootsRetained keys certificate.retained expectedRoots && + (allRetained keys certificate.retained || + (Code.safe keys certificate.retained main && + retainedDeclarationsSafe keys certificate.retained entries)) + +private def pushNew (known : List Address) (address : Address) : List Address := + if known.contains address then known else known ++ [address] + +private def addTargets (keys : List Address) (known : List Address) + (targets : List Address) : List Address := + targets.foldl (fun result target => + if keys.contains target then pushNew result target else result) known + +private def closureStep (keys : List Address) + (entries : List (Address × Decl)) (known : List Address) : List Address := + entries.foldl (fun result entry => + if result.contains entry.1 then + match entry.2 with + | .extern _ => result + | .fn function => addTargets keys result (Code.targets function.body) + else + result) known + +private def close (keys : List Address) (entries : List (Address × Decl)) : + Nat → List Address → List Address + | 0, known => known + | fuel + 1, known => close keys entries fuel (closureStep keys entries known) + +private def selectedHasApply (retained : List Address) + (entries : List (Address × Decl)) : Bool := + entries.any fun entry => + retained.contains entry.1 && + match entry.2 with + | .extern _ => false + | .fn function => Code.hasApply function.body + +/-- Untrusted deterministic producer. `run` and external callers always send +its output back through `validate`; this routine need not be trusted for +soundness or completeness. -/ +def produce (entries : List (Address × Decl)) (main : Code) + (roots : List Address) : Certificate := + let keys := keysOf entries + let seeded := addTargets keys roots (Code.targets main) + let discovered := close keys entries entries.length seeded + let retained := keys.filter discovered.contains + let needsOpenWorld := Code.hasApply main || selectedHasApply retained entries + { inputRoot := inputRoot entries main + roots + retained := if needsOpenWorld then keys else retained } + +structure Checked where + certificate : Certificate + deriving Repr + +/-- Public fail-closed checked-artifact API. -/ +def check (entries : List (Address × Decl)) (main : Code) + (roots : List Address) (certificate : Certificate) : + Except String Checked := + if validate entries main roots certificate then + .ok ⟨certificate⟩ + else + .error "invalid IxIR1 rooted-reachability certificate" + +theorem validate_of_check_eq_ok + {entries : List (Address × Decl)} {main : Code} + {roots : List Address} {certificate : Certificate} {checked : Checked} + (hcheck : check entries main roots certificate = .ok checked) : + validate entries main roots certificate = true := by + unfold check at hcheck + split at hcheck + · assumption + · contradiction + +def filterEntries (retained : List Address) + (entries : List (Address × Decl)) : List (Address × Decl) := + entries.filter fun entry => retained.contains entry.1 + +structure Outcome where + entries : List (Address × Decl) + certificate : Certificate + accepted : Bool + removedDeclarations : Nat + +/-- Produce, check, and apply reachability. An internal producer/checker +disagreement fails soft to the complete input list. -/ +def run (roots : List Address) (entries : List (Address × Decl)) + (main : Code) : Outcome := + let certificate := produce entries main roots + if validate entries main roots certificate then + let filtered := filterEntries certificate.retained entries + { entries := filtered + certificate + accepted := true + removedDeclarations := entries.length - filtered.length } + else + { entries + certificate + accepted := false + removedDeclarations := 0 } + +/-! ## Exact evaluator transport through a checked restriction -/ + +private theorem envOfList_some_mem + {entries : List (Address × Decl)} {address : Address} {declaration : Decl} + (hlookup : Env.ofList entries address = some declaration) : + (address, declaration) ∈ entries := by + unfold Env.ofList at hlookup + obtain ⟨entry, hfind, hvalue⟩ := Option.map_eq_some_iff.mp hlookup + rcases entry with ⟨entryAddress, entryDeclaration⟩ + have hbeq : entryAddress == address := + List.find?_some + (p := fun entry : Address × Decl => entry.1 == address) hfind + have haddress : entryAddress = address := Address.eq_of_beq hbeq + have hdeclaration : entryDeclaration = declaration := by + simpa using hvalue + subst entryAddress + subst entryDeclaration + exact List.mem_of_find?_eq_some hfind + +private theorem key_mem_of_envOfList_eq_some + {entries : List (Address × Decl)} {address : Address} {declaration : Decl} + (hlookup : Env.ofList entries address = some declaration) : + address ∈ keysOf entries := by + exact List.mem_map.mpr ⟨(address, declaration), envOfList_some_mem hlookup, + rfl⟩ + +theorem envOfList_filterEntries (retained : List Address) + (entries : List (Address × Decl)) (address : Address) : + Env.ofList (filterEntries retained entries) address = + if retained.contains address then Env.ofList entries address else none := by + unfold filterEntries Env.ofList + rw [List.find?_filter] + by_cases hretained : address ∈ retained + · have hpred : + (fun entry : Address × Decl => + decide (retained.contains entry.1 = true ∧ + (entry.1 == address) = true)) = + (fun entry : Address × Decl => entry.1 == address) := by + funext entry + by_cases hsame : entry.1 = address + · simp [hsame, hretained] + · simp [hsame] + rw [hpred] + simp [hretained] + · have hpred : + (fun entry : Address × Decl => + decide (retained.contains entry.1 = true ∧ + (entry.1 == address) = true)) = + (fun _ : Address × Decl => false) := by + funext entry + by_cases hsame : entry.1 = address + · simp [hsame, hretained] + · simp [hsame] + rw [hpred] + simp [hretained] + +private theorem envOfList_eq_none_of_key_not_mem + {entries : List (Address × Decl)} {address : Address} + (hmissing : address ∉ keysOf entries) : + Env.ofList entries address = none := by + cases hlookup : Env.ofList entries address with + | none => rfl + | some declaration => + exact (hmissing (key_mem_of_envOfList_eq_some hlookup)).elim + +private theorem envOfList_filterEntries_eq_of_safe + {entries : List (Address × Decl)} {retained : List Address} + {address : Address} + (hsafe : (!(keysOf entries).contains address || + retained.contains address) = true) : + Env.ofList (filterEntries retained entries) address = + Env.ofList entries address := by + rw [envOfList_filterEntries] + cases hretained : retained.contains address with + | true => simp + | false => + simp only [hretained] at hsafe + have hmissing : address ∉ keysOf entries := by + simpa using hsafe + simp [envOfList_eq_none_of_key_not_mem hmissing] + +private def sourceCtx (entries : List (Address × Decl)) + (oracle : Address → List RVal → Option RVal) : Ctx := + { decls := Env.ofList entries, oracle } + +private def filteredCtx (retained : List Address) + (entries : List (Address × Decl)) + (oracle : Address → List RVal → Option RVal) : Ctx := + { decls := Env.ofList (filterEntries retained entries), oracle } + +private theorem AltList.safe_of_mem {keys retained : List Address} + {alternatives : List Alt} {alternative : Alt} + (hsafe : AltList.safe keys retained alternatives = true) + (hmember : alternative ∈ alternatives) : + Alt.safe keys retained alternative = true := by + induction alternatives with + | nil => simp at hmember + | cons head rest ih => + simp only [AltList.safe, Bool.and_eq_true] at hsafe + cases hmember with + | head => exact hsafe.1 + | tail _ member => exact ih hsafe.2 member + +private theorem function_safe_of_lookup + {entries : List (Address × Decl)} {retained : List Address} + {address : Address} {function : FnDef} + (hentries : retainedDeclarationsSafe (keysOf entries) retained entries = + true) + (hlookup : Env.ofList entries address = some (.fn function)) + (hretained : retained.contains address = true) : + Code.safe (keysOf entries) retained function.body = true := by + have hmember : (address, .fn function) ∈ entries := + envOfList_some_mem hlookup + have hrow := List.all_eq_true.mp hentries _ hmember + have hrow' : address ∉ retained ∨ + Code.safe (keysOf entries) retained function.body = true := by + simpa [Decl.safe] using hrow + exact hrow'.resolve_left (by simpa using hretained) + +private theorem runCode_case_restricted_eq + {entries : List (Address × Decl)} {retained : List Address} + {oracle : Address → List RVal → Option RVal} {fuel : Nat} + (ih : ∀ (current : FnDef), + Code.safe (keysOf entries) retained current.body = true → + ∀ (store : Store) (environment : List RVal) (input : Code), + Code.safe (keysOf entries) retained input = true → + runCode (filteredCtx retained entries oracle) fuel current store + environment input = + runCode (sourceCtx entries oracle) fuel current store environment + input) + (current : FnDef) + (hcurrent : Code.safe (keysOf entries) retained current.body = true) + (store : Store) (environment : List RVal) (scrutinee : Atom) + (peelNat : Bool) (alternatives : Array Alt) + (hsafe : Code.safe (keysOf entries) retained + (.case scrutinee peelNat alternatives) = true) : + runCode (filteredCtx retained entries oracle) (fuel + 1) current store + environment (.case scrutinee peelNat alternatives) = + runCode (sourceCtx entries oracle) (fuel + 1) current store environment + (.case scrutinee peelNat alternatives) := by + simp only [Code.safe] at hsafe + simp only [runCode] + cases hscrutinee : resolveAtom environment scrutinee with + | error error => simp [bind, Except.bind] + | ok value => + simp only [bind, Except.bind] + cases value with + | erased => simp + | lit literal => + cases literal with + | str value => simp + | nat value => + simp only + cases peelNat with + | false => simp + | true => + simp only + cases value with + | zero => + simp only + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == 0) with + | none => simp + | some alternative => + have hmember : alternative ∈ alternatives := + Array.mem_of_find?_eq_some hfind + have haltSafe := AltList.safe_of_mem hsafe + (by simpa using hmember) + cases alternative with + | mk cidx fields body => + simp only [Alt.safe] at haltSafe + cases fields with + | zero => + simpa using ih current hcurrent store + environment body haltSafe + | succ fields => simp + | succ value => + simp only + cases hfind : alternatives.find? + (fun alternative => alternative.cidx == 1) with + | none => simp + | some alternative => + have hmember : alternative ∈ alternatives := + Array.mem_of_find?_eq_some hfind + have haltSafe := AltList.safe_of_mem hsafe + (by simpa using hmember) + cases alternative with + | mk cidx fields body => + simp only [Alt.safe] at haltSafe + cases fields with + | zero => simp + | succ fields => + cases fields with + | zero => + simpa using ih current hcurrent store + (.lit (.nat value) :: environment) + body haltSafe + | succ fields => simp + | loc location => + simp only + cases hget : store.get? location with + | none => simp + | some box => + simp only + cases hnode : box.node with + | papN function arity arguments => simp + | ctorN identity fields => + simp only + cases hfind : alternatives.find? + (fun alternative => + alternative.cidx == identity.cidx) with + | none => simp + | some alternative => + have hmember : alternative ∈ alternatives := + Array.mem_of_find?_eq_some hfind + have haltSafe := AltList.safe_of_mem hsafe + (by simpa using hmember) + cases alternative with + | mk cidx fieldCount body => + simp only [Alt.safe] at haltSafe + by_cases hfields : fields.size = fieldCount + · simpa [hfields] using + ih current hcurrent store + (fields.foldl + (fun result field => field :: result) + environment) body haltSafe + · simp [hfields] + +private structure RestrictedAt + (entries : List (Address × Decl)) (retained : List Address) + (oracle : Address → List RVal → Option RVal) + (entriesSafe : retainedDeclarationsSafe (keysOf entries) retained entries = + true) (fuel : Nat) : Prop where + runCode : ∀ (current : FnDef), + Code.safe (keysOf entries) retained current.body = true → + ∀ (store : Store) (environment : List RVal) (input : Code), + Code.safe (keysOf entries) retained input = true → + IxIR1.runCode (filteredCtx retained entries oracle) fuel current store + environment input = + IxIR1.runCode (sourceCtx entries oracle) fuel current store environment + input + runOp : ∀ (current : FnDef), + Code.safe (keysOf entries) retained current.body = true → + ∀ (store : Store) (environment : List RVal) (operation : Op), + Op.safe (keysOf entries) retained operation = true → + IxIR1.runOp (filteredCtx retained entries oracle) fuel current store + environment operation = + IxIR1.runOp (sourceCtx entries oracle) fuel current store environment + operation + invoke : ∀ (function : Address), + (!(keysOf entries).contains function || retained.contains function) = + true → + ∀ (arguments : List RVal) (store : Store), + IxIR1.invoke (filteredCtx retained entries oracle) fuel function + arguments store = + IxIR1.invoke (sourceCtx entries oracle) fuel function arguments store + +private theorem restrictedAt + (entries : List (Address × Decl)) (retained : List Address) + (oracle : Address → List RVal → Option RVal) + (entriesSafe : retainedDeclarationsSafe (keysOf entries) retained entries = + true) : + ∀ fuel, RestrictedAt entries retained oracle entriesSafe fuel := by + intro fuel + induction fuel with + | zero => + constructor <;> intros <;> + simp [runCode, runOp, IxIR1.invoke] + | succ fuel smaller => + refine ⟨?_, ?_, ?_⟩ + · intro current hcurrent store environment input hsafe + cases input with + | ret atom => simp [runCode] + | letOp operation rest => + simp only [Code.safe, Bool.and_eq_true] at hsafe + simp only [runCode] + rw [smaller.runOp current hcurrent store environment operation + hsafe.1] + cases hoperation : runOp (sourceCtx entries oracle) fuel current + store environment operation with + | error error => rfl + | ok output => + rcases output with ⟨next, value⟩ + exact smaller.runCode current hcurrent next + (value :: environment) rest hsafe.2 + | case scrutinee peelNat alternatives => + exact runCode_case_restricted_eq smaller.runCode current hcurrent + store environment scrutinee peelNat alternatives hsafe + · intro current hcurrent store environment operation hsafe + cases operation with + | pure atom => simp [runOp] + | alloc world identity arguments => simp [runOp] + | reuse target identity arguments => simp [runOp] + | free target => simp [runOp] + | dup target => simp [runOp] + | drop target => + simp only [runOp] + cases htarget : resolveAtom environment target with + | error error => simp [bind, Except.bind] + | ok value => + simp only [bind, Except.bind] + cases value with + | lit literal => rfl + | erased => rfl + | loc location => + change (do + let next ← dropVal + (filteredCtx retained entries oracle) fuel store + (.loc location) + .ok (next, RVal.erased)) = + (do + let next ← dropVal (sourceCtx entries oracle) fuel + store (.loc location) + .ok (next, RVal.erased)) + rw [dropVal_ctx_eq (sourceCtx entries oracle) + (filteredCtx retained entries oracle) fuel store + (.loc location)] + | dropU target => + simp only [runOp] + cases htarget : resolveAtom environment target with + | error error => simp [bind, Except.bind] + | ok value => + simp only [bind, Except.bind] + cases value with + | lit literal => rfl + | erased => rfl + | loc location => + change (do + let next ← dropUVal + (filteredCtx retained entries oracle) fuel store + (.loc location) + .ok (next, RVal.erased)) = + (do + let next ← dropUVal (sourceCtx entries oracle) fuel + store (.loc location) + .ok (next, RVal.erased)) + rw [dropUVal_ctx_eq (sourceCtx entries oracle) + (filteredCtx retained entries oracle) fuel store + (.loc location)] + | fetch target field => simp [runOp] + | call function arguments => + simp only [Op.safe] at hsafe + simp only [runOp] + cases harguments : resolveAtoms environment arguments with + | error error => rfl + | ok values => exact smaller.invoke function hsafe values store + | callSelf arguments => + simp only [runOp] + cases harguments : resolveAtoms environment arguments with + | error error => simp [bind, Except.bind] + | ok values => + simp only [bind, Except.bind] + by_cases harity : values.length = current.arity + · simp only [harity] + rw [smaller.runCode current hcurrent store values.reverse + current.body hcurrent] + · simp [harity] + | papp function arguments => + simp only [Op.safe] at hsafe + simp only [runOp] + cases harguments : resolveAtoms environment arguments with + | error error => rfl + | ok values => + simp only [bind, Except.bind] + have hlookup : + (filteredCtx retained entries oracle).decls function = + (sourceCtx entries oracle).decls function := + envOfList_filterEntries_eq_of_safe hsafe + rw [hlookup] + | apply function arguments => + simp [Op.safe] at hsafe + | extern function arguments => + simp [runOp, callScalarOracle, filteredCtx, sourceCtx] + · intro function hsafe arguments store + have hlookup : + (filteredCtx retained entries oracle).decls function = + (sourceCtx entries oracle).decls function := by + exact envOfList_filterEntries_eq_of_safe hsafe + simp only [IxIR1.invoke] + rw [hlookup] + cases hsource : Env.ofList entries function with + | none => simp [sourceCtx, hsource] + | some declaration => + have hkey : function ∈ keysOf entries := + key_mem_of_envOfList_eq_some hsource + have hkeyBool : (keysOf entries).contains function = true := by + simpa using hkey + have hretained : retained.contains function = true := by + have hsafe' : function ∉ keysOf entries ∨ + function ∈ retained := by + simpa using hsafe + have hmember := hsafe'.resolve_left (fun hmissing => + hmissing hkey) + simpa using hmember + cases declaration with + | extern arity => + simp [sourceCtx, hsource, filteredCtx, callScalarOracle] + | fn called => + have hcalledSafe := function_safe_of_lookup entriesSafe + hsource hretained + by_cases harity : arguments.length = called.arity + · have harityBool : + (arguments.length != called.arity) = false := by + simp [harity] + simp only [sourceCtx, hsource, harityBool, + Bool.false_eq_true, if_false] + have hbody := smaller.runCode called hcalledSafe store + arguments.reverse called.body hcalledSafe + simpa [sourceCtx] using congrArg + (fun output => output >>= checkResultWorld called.result) + hbody + · simp [sourceCtx, hsource, harity] + +private theorem filterEntries_eq_self_of_allRetained + {entries : List (Address × Decl)} {retained : List Address} + (hall : allRetained (keysOf entries) retained = true) : + filterEntries retained entries = entries := by + apply List.filter_eq_self.mpr + intro entry hmember + have hkey : entry.1 ∈ keysOf entries := by + exact List.mem_map.mpr ⟨entry, hmember, rfl⟩ + have hretained := List.all_eq_true.mp hall entry.1 hkey + simpa using hretained + +/-- A valid proper-subset certificate preserves the complete top-level +evaluator result exactly. The all-retained dynamic-apply fallback is the +degenerate equality case. -/ +theorem runMain_filterEntries_eq_of_validate + {entries : List (Address × Decl)} {main : Code} + {roots : List Address} {certificate : Certificate} + (hvalid : validate entries main roots certificate = true) + (oracle : Address → List RVal → Option RVal := fun _ _ => none) + (fuel : Nat := 100000) : + runMain + { decls := Env.ofList + (filterEntries certificate.retained entries) + oracle } + main fuel = + runMain { decls := Env.ofList entries, oracle } main fuel := by + simp only [validate, Bool.and_eq_true, Bool.or_eq_true] at hvalid + have hmode := hvalid.2 + cases hmode with + | inl hall => + have hentries : filterEntries certificate.retained entries = entries := + filterEntries_eq_self_of_allRetained hall + rw [hentries] + | inr hclosed => + let current : FnDef := ⟨0, .shared, false, main⟩ + have heq := + (restrictedAt entries certificate.retained oracle hclosed.2 fuel).runCode + current hclosed.1 {} [] main hclosed.1 + simpa [runMain, current, filteredCtx, sourceCtx] using heq + +/-- The produce/check/apply wrapper is fail-soft and exact whether its +internally produced certificate is accepted or rejected. -/ +theorem runMain_run_eq (roots : List Address) + (entries : List (Address × Decl)) (main : Code) + (oracle : Address → List RVal → Option RVal := fun _ _ => none) + (fuel : Nat := 100000) : + runMain { decls := Env.ofList (run roots entries main).entries, oracle } + main fuel = + runMain { decls := Env.ofList entries, oracle } main fuel := by + generalize hcertificate : produce entries main roots = certificate + cases hvalid : validate entries main roots certificate with + | false => simp [run, hcertificate, hvalid] + | true => + simp only [run, hcertificate, hvalid, if_true] + exact runMain_filterEntries_eq_of_validate hvalid oracle fuel + +end Ix.Compiler.IxIR1.Reachability diff --git a/Ix/Compiler/IxIR1/Readdress.lean b/Ix/Compiler/IxIR1/Readdress.lean new file mode 100644 index 000000000..5360f19b4 --- /dev/null +++ b/Ix/Compiler/IxIR1/Readdress.lean @@ -0,0 +1,593 @@ +import Ix.Compiler.IxIR1.Serialize + +/-! +# IxIR₁ generated-declaration readdressing + +The lowering proof works over transient names for lifted lambdas and +constructor wrappers. This module is the compiled artifact boundary: it +rewrites those names to the BLAKE3 address of each finished declaration. + +Generated declarations may refer to other generated declarations, so hashing +is dependency ordered. `callSelf` contains no address and therefore does not +form a dependency. A direct generated-address cycle fails closed, as do +temporary-name overlap with source declarations and an observed BLAKE3 +collision between distinct preimages. Identical generated declarations are +content-deduplicated deliberately. + +The hash call is native. Consequently `run` belongs in compiled entry points +and tests, not in elaboration-time `#guard`s. +-/ + +namespace Ix.Compiler.IxIR1 + +open Ix.Compiler.Ixon (Address) + +namespace Readdress + +/-- Old generated name to finished content address. -/ +abbrev Renaming := List (Address × Address) + +namespace Renaming + +/-- Look up one transient generated name. -/ +def lookup (mapping : Renaming) (address : Address) : Option Address := + (mapping.find? fun entry => entry.1 == address).map (·.2) + +/-- Rewrite an address when it names a generated declaration. -/ +def apply (mapping : Renaming) (address : Address) : Address := + (mapping.lookup address).getD address + +/-- Whether the domain already contains this generated name. -/ +def contains (mapping : Renaming) (address : Address) : Bool := + mapping.any fun entry => entry.1 == address + +end Renaming + +namespace CtorId + +/-- Rewrite the block identity carried by a constructor identity. -/ +def mapAddresses (rename : Address → Address) (constructor : CtorId) : CtorId := + { constructor with block := rename constructor.block } + +end CtorId + +namespace Op + +/-- Apply an address renaming to every address-bearing operation field. -/ +def mapAddresses (rename : Address → Address) : Op → Op + | .pure atom => .pure atom + | .alloc world cid args => + .alloc world (CtorId.mapAddresses rename cid) args + | .reuse target cid args => + .reuse target (CtorId.mapAddresses rename cid) args + | .free target => .free target + | .dup target => .dup target + | .drop target => .drop target + | .dropU target => .dropU target + | .fetch target field => .fetch target field + | .call function args => .call (rename function) args + | .callSelf args => .callSelf args + | .papp function args => .papp (rename function) args + | .apply function args => .apply function args + | .extern function args => .extern (rename function) args + +/-- Direct semantic address references carried by an operation. -/ +def references : Op → List Address + | .alloc _ cid _ | .reuse _ cid _ => [cid.block] + | .call function _ | .papp function _ | .extern function _ => [function] + | _ => [] + +end Op + +mutual + +/-- Apply an address renaming throughout code. -/ +def Code.mapAddresses (rename : Address → Address) : Code → Code + | .ret atom => .ret atom + | .letOp op rest => + .letOp (Op.mapAddresses rename op) (Code.mapAddresses rename rest) + | .case scrutinee peelNat alternatives => + .case scrutinee peelNat + (AltList.mapAddresses rename alternatives.toList).toArray + +/-- Apply an address renaming beneath one case alternative. -/ +def Alt.mapAddresses (rename : Address → Address) : Alt → Alt + | .mk constructor fields body => + .mk constructor fields (Code.mapAddresses rename body) + +/-- Executable walk beneath an alternative array. -/ +def AltList.mapAddresses (rename : Address → Address) : List Alt → List Alt + | [] => [] + | alternative :: rest => + Alt.mapAddresses rename alternative :: AltList.mapAddresses rename rest + +end + +/-! ## Executable structural equality + +The mutually nested `Code`/`Alt` syntax does not receive a lawful equality +instance from Lean's deriving machinery. Readdressing needs a proof-reflecting +comparison at its final semantic audit, so keep the small comparison here +beside the complete address walk. -/ + +namespace Op + +def structurallyEq : Op → Op → Bool + | .pure left, .pure right => left == right + | .alloc leftWorld leftCtor leftArgs, + .alloc rightWorld rightCtor rightArgs => + leftWorld == rightWorld && leftCtor == rightCtor && + leftArgs == rightArgs + | .reuse leftTarget leftCtor leftArgs, + .reuse rightTarget rightCtor rightArgs => + leftTarget == rightTarget && leftCtor == rightCtor && + leftArgs == rightArgs + | .free left, .free right + | .dup left, .dup right + | .drop left, .drop right + | .dropU left, .dropU right => left == right + | .fetch leftTarget leftField, .fetch rightTarget rightField => + leftTarget == rightTarget && leftField == rightField + | .call leftFunction leftArgs, .call rightFunction rightArgs + | .papp leftFunction leftArgs, .papp rightFunction rightArgs + | .extern leftFunction leftArgs, .extern rightFunction rightArgs => + leftFunction == rightFunction && leftArgs == rightArgs + | .callSelf left, .callSelf right => left == right + | .apply leftFunction leftArgs, .apply rightFunction rightArgs => + leftFunction == rightFunction && leftArgs == rightArgs + | _, _ => false + +theorem structurallyEq_eq_true_iff (left right : Op) : + structurallyEq left right = true ↔ left = right := by + cases left <;> cases right <;> + simp [structurallyEq, beq_iff_eq, and_assoc] + +end Op + +mutual + +def Code.structurallyEq : Code → Code → Bool + | .ret left, .ret right => left == right + | .letOp leftOp leftRest, .letOp rightOp rightRest => + Op.structurallyEq leftOp rightOp && + Code.structurallyEq leftRest rightRest + | .case leftScrutinee leftPeel leftAlternatives, + .case rightScrutinee rightPeel rightAlternatives => + leftScrutinee == rightScrutinee && leftPeel == rightPeel && + AltList.structurallyEq leftAlternatives.toList + rightAlternatives.toList + | _, _ => false + +def Alt.structurallyEq : Alt → Alt → Bool + | .mk leftConstructor leftFields leftBody, + .mk rightConstructor rightFields rightBody => + leftConstructor == rightConstructor && leftFields == rightFields && + Code.structurallyEq leftBody rightBody + +def AltList.structurallyEq : List Alt → List Alt → Bool + | [], [] => true + | left :: leftRest, right :: rightRest => + Alt.structurallyEq left right && + AltList.structurallyEq leftRest rightRest + | _, _ => false + +end + +mutual + +theorem Code.structurallyEq_eq_true_iff (left right : Code) : + Code.structurallyEq left right = true ↔ left = right := by + cases left <;> cases right <;> + simp [Code.structurallyEq, Op.structurallyEq_eq_true_iff, + Code.structurallyEq_eq_true_iff, + AltList.structurallyEq_eq_true_iff, beq_iff_eq, and_assoc] + +theorem Alt.structurallyEq_eq_true_iff (left right : Alt) : + Alt.structurallyEq left right = true ↔ left = right := by + cases left + cases right + simp [Alt.structurallyEq, Code.structurallyEq_eq_true_iff, + beq_iff_eq, and_assoc] + +theorem AltList.structurallyEq_eq_true_iff (left right : List Alt) : + AltList.structurallyEq left right = true ↔ left = right := by + cases left with + | nil => cases right <;> simp [AltList.structurallyEq] + | cons left leftRest => + cases right with + | nil => simp [AltList.structurallyEq] + | cons right rightRest => + simp [AltList.structurallyEq, + Alt.structurallyEq_eq_true_iff, + AltList.structurallyEq_eq_true_iff] + +end + +mutual + +/-- Direct and nested semantic address references carried by code. -/ +def Code.references : Code → List Address + | .ret _ => [] + | .letOp op rest => Op.references op ++ Code.references rest + | .case _ _ alternatives => AltList.references alternatives.toList + +/-- Semantic address references beneath one case alternative. -/ +def Alt.references : Alt → List Address + | .mk _ _ body => Code.references body + +/-- Executable reference walk beneath an alternative array. -/ +def AltList.references : List Alt → List Address + | [] => [] + | alternative :: rest => + Alt.references alternative ++ AltList.references rest + +end + +namespace FnDef + +/-- Apply an address renaming throughout a function declaration. -/ +def mapAddresses (rename : Address → Address) (definition : FnDef) : FnDef := + { definition with body := Code.mapAddresses rename definition.body } + +/-- Semantic address references carried by a function declaration. -/ +def references (definition : FnDef) : List Address := + Code.references definition.body + +def structurallyEq (left right : FnDef) : Bool := + left.arity == right.arity && left.result == right.result && + left.papSafe == right.papSafe && + Code.structurallyEq left.body right.body + +theorem structurallyEq_eq_true_iff (left right : FnDef) : + structurallyEq left right = true ↔ left = right := by + cases left + cases right + simp [structurallyEq, Code.structurallyEq_eq_true_iff, + beq_iff_eq, and_assoc] + +end FnDef + +namespace Decl + +/-- Apply an address renaming throughout a declaration. -/ +def mapAddresses (rename : Address → Address) : Decl → Decl + | .fn definition => .fn (FnDef.mapAddresses rename definition) + | .extern arity => .extern arity + +/-- Semantic address references carried by a declaration. -/ +def references : Decl → List Address + | .fn definition => FnDef.references definition + | .extern _ => [] + +def structurallyEq : Decl → Decl → Bool + | .fn left, .fn right => FnDef.structurallyEq left right + | .extern left, .extern right => left == right + | _, _ => false + +theorem structurallyEq_eq_true_iff (left right : Decl) : + structurallyEq left right = true ↔ left = right := by + cases left <;> cases right <;> + simp [structurallyEq, FnDef.structurallyEq_eq_true_iff, + beq_iff_eq] + +end Decl + +/-- One completely readdressed lowering result. Source-backed declaration +keys stay stable, while their bodies are rewritten to the generated content +addresses. `generated` contains only content-addressed declarations and may +be shorter than `addressMap` when identical declarations deduplicate. -/ +structure Result where + source : List (Address × Decl) + generated : List (Address × Decl) + main : Code + addressMap : Renaming + +/-- The environment spelling consumed by the evaluator and pipeline. -/ +def Result.declarations (result : Result) : List (Address × Decl) := + result.source ++ result.generated + +/-- Transient generated names, in dependency-resolution order. -/ +def Result.transientAddresses (result : Result) : List Address := + result.addressMap.map (·.1) + +/-- No emitted declaration key belongs to the transient namespace. -/ +def Result.noTransientKeys (result : Result) : Bool := + let transient := result.transientAddresses + !(result.declarations.map (·.1)).any transient.contains + +/-- No transient generated name remains in any emitted reference. -/ +def Result.noTransientReferences (result : Result) : Bool := + let transient := result.transientAddresses + let declarationReferences := + (result.source ++ result.generated).flatMap fun entry => + Decl.references entry.2 + !(declarationReferences ++ Code.references result.main).any transient.contains + +/-- Every emitted generated key is the canonical address of its declaration. +This audit executes BLAKE3 and therefore belongs in compiled tests. -/ +def Result.generatedAreAddressed (result : Result) : Bool := + result.generated.all fun entry => entry.1 == entry.2.address + +/-- Executable certificate that the emitted environment is the exact +declaration image of the pre-address environment at every raw key, and that +every emitted lookup is already stable under the completed renaming. The +second clause supplies semantic aliases for newly introduced content keys +without requiring an inverse address map. -/ +def Result.semanticAudit (result : Result) + (raw : List (Address × Decl)) (rawMain : Code) : Bool := + let rename := Renaming.apply result.addressMap + let emitted := Env.ofList result.declarations + let original := Env.ofList raw + Code.structurallyEq result.main (Code.mapAddresses rename rawMain) && + raw.all (fun entry => + match original entry.1, emitted (rename entry.1) with + | some before, some after => + Decl.structurallyEq after (Decl.mapAddresses rename before) + | _, _ => false) && + result.declarations.all (fun entry => + match emitted entry.1 with + | some declaration => + Decl.structurallyEq + (Decl.mapAddresses rename declaration) declaration + | none => false) + +/-- Every protected identity is fixed by the completed address map. The +production lowerer protects all original IxIR₀ declaration addresses, +including constructors that have no source-backed IxIR₁ declaration entry. -/ +def Result.protects (result : Result) (addresses : List Address) : Bool := + addresses.all fun address => + Renaming.apply result.addressMap address == address + +/-- Reflect one member of an executable protection check into equality. -/ +theorem Result.apply_eq_of_protects {result : Result} + {addresses : List Address} (hprotects : result.protects addresses = true) + {address : Address} (haddress : address ∈ addresses) : + Renaming.apply result.addressMap address = address := by + have hequal := (List.all_eq_true.mp hprotects) address haddress + exact Address.eq_of_beq hequal + +/-- A successful post-pass carries an erased proof of its semantic audit. +The subtype proof has no runtime representation in emitted artifacts. -/ +abbrev CertifiedResult (raw : List (Address × Decl)) (rawMain : Code) := + { result : Result // result.semanticAudit raw rawMain = true } + +private def certify (raw : List (Address × Decl)) (rawMain : Code) + (result : Result) : Except String (CertifiedResult raw rawMain) := + if haudit : result.semanticAudit raw rawMain then + .ok ⟨result, haudit⟩ + else + .error "internal: generated readdressing failed semantic audit" + +private def firstDuplicate? : List Address → Option Address + | [] => none + | address :: rest => + if rest.contains address then some address else firstDuplicate? rest + +private def firstOverlap? (keys : List Address) + (source : List (Address × Decl)) : Option Address := + keys.find? fun key => source.any fun entry => entry.1 == key + +private def referencesResolved (keys : List Address) + (mapping : Renaming) (declaration : Decl) : Bool := + (Decl.references declaration).all fun reference => + !keys.contains reference || mapping.contains reference + +/-- Remove and return the first declaration whose generated dependencies are +already in the renaming. The residual list preserves its original order. -/ +private def takeReady (keys : List Address) (mapping : Renaming) : + List (Address × Decl) → + Option ((Address × Decl) × List (Address × Decl)) + | [] => none + | entry :: rest => + if referencesResolved keys mapping entry.2 then + some (entry, rest) + else + match takeReady keys mapping rest with + | none => none + | some (ready, residual) => some (ready, entry :: residual) + +private def findDeclaration? (address : Address) : + List (Address × Decl) → Option Decl + | [] => none + | entry :: rest => + if entry.1 == address then some entry.2 + else findDeclaration? address rest + +private structure BuildState where + addressMap : Renaming := [] + /-- Reverse dependency order while building; reversed once at the end. -/ + generatedRev : List (Address × Decl) := [] + +private def samePreimage (left right : Decl) : Bool := + left.preimage == right.preimage + +/-- Record one finished declaration, content-deduplicating an identical +preimage and rejecting an observed address collision with different bytes. -/ +private def install (keys : List Address) + (source : List (Address × Decl)) (old : Address) + (declaration : Decl) (state : BuildState) : Except String BuildState := + let address := declaration.address + if keys.contains address then + .error s!"generated content address overlaps temporary namespace {Address.toHex address}" + else + match findDeclaration? address source with + | some _ => + .error s!"generated content address collides with source declaration key {Address.toHex address}" + | none => + match findDeclaration? address state.generatedRev with + | some found => + if samePreimage found declaration then + .ok { state with + addressMap := (old, address) :: state.addressMap } + else + .error s!"BLAKE3 collision while readdressing generated declaration {Address.toHex old}" + | none => + .ok + { addressMap := (old, address) :: state.addressMap + generatedRev := (address, declaration) :: state.generatedRev } + +private def build (keys : List Address) (source : List (Address × Decl)) : + Nat → List (Address × Decl) → BuildState → Except String BuildState + | 0, [], state => .ok state + | 0, _ :: _, _ => + .error "generated declaration address dependency cycle" + | _ + 1, [], state => .ok state + | fuel + 1, pending, state => + match takeReady keys state.addressMap pending with + | none => .error "generated declaration address dependency cycle" + | some ((old, declaration), residual) => do + let rewritten := Decl.mapAddresses + (Renaming.apply state.addressMap) declaration + let state ← install keys source old rewritten state + build keys source fuel residual state + +/-- Rewrite and content-address all generated declarations, retaining an +erased certificate that the resulting evaluator environment is the exact +semantic address image of the raw one. + +`source` contains source-backed declarations whose keys must remain stable; +`generated` contains transiently keyed lifts/wrappers. The result is +dependency ordered, exact-content deduplicated, and includes the complete +old-to-new provenance map. -/ +def runCertified (source generated : List (Address × Decl)) (main : Code) : + Except String (CertifiedResult (source ++ generated) main) := do + if generated.isEmpty then + return ← certify (source ++ generated) main + { source, generated := [], main, addressMap := [] } + let keys := generated.map (·.1) + if let some duplicate := firstDuplicate? keys then + throw s!"duplicate generated temporary address {Address.toHex duplicate}" + if let some overlap := firstOverlap? keys source then + throw s!"generated temporary address overlaps source declaration {Address.toHex overlap}" + let state ← build keys source keys.length generated {} + let addressMap := state.addressMap.reverse + let rename := Renaming.apply addressMap + let result : Result := + { source := source.map fun entry => + (entry.1, Decl.mapAddresses rename entry.2) + generated := state.generatedRev.reverse + main := Code.mapAddresses rename main + addressMap } + unless result.noTransientKeys do + throw "internal: generated readdressing emitted a transient key" + unless result.noTransientReferences do + throw "internal: generated readdressing left a transient reference" + certify (source ++ generated) main result + +/-- Artifact-facing projection of `runCertified`. -/ +def run (source generated : List (Address × Decl)) (main : Code) : + Except String Result := do + return (← runCertified source generated main).1 + +/-- Run the ordinary certified post-pass and additionally reject any result +whose renaming changes a caller-protected identity. This closes the +constructor-address gap at the production lowering boundary: constructors +are absent from the IxIR₁ declaration environment but their IxIR₀ keys still +occur in `CtorId.block` and must remain stable. -/ +def runProtected (reserved : List Address) + (source generated : List (Address × Decl)) (main : Code) : + Except String Result := do + let result ← run source generated main + if _hprotects : result.protects reserved then + return result + else + throw "generated address map rewrites a protected source identity" + +/-- A successful protected run is also a successful ordinary certified run +and carries the requested fixed-identity audit. -/ +theorem run_and_protects_of_runProtected_eq_ok + {reserved : List Address} + {source generated : List (Address × Decl)} {main : Code} + {result : Result} + (hrun : runProtected reserved source generated main = .ok result) : + run source generated main = .ok result ∧ + result.protects reserved = true := by + unfold runProtected at hrun + cases hbase : run source generated main with + | error message => + rw [hbase] at hrun + change Except.error message = Except.ok result at hrun + contradiction + | ok candidate => + rw [hbase] at hrun + change + (if candidate.protects reserved = true then + Except.ok candidate + else + Except.error + "generated address map rewrites a protected source identity") = + Except.ok result at hrun + by_cases hprotects : candidate.protects reserved = true + · rw [if_pos hprotects] at hrun + have hresult : candidate = result := by injection hrun + subst result + exact ⟨rfl, hprotects⟩ + · rw [if_neg hprotects] at hrun + contradiction + +/-- Every successful artifact-facing run retains the erased semantic +certificate constructed by `runCertified`. -/ +theorem semanticAudit_of_run_eq_ok + {source generated : List (Address × Decl)} {main : Code} + {result : Result} + (hrun : run source generated main = .ok result) : + result.semanticAudit (source ++ generated) main = true := by + unfold run at hrun + cases hcertified : runCertified source generated main with + | error message => + rw [hcertified] at hrun + contradiction + | ok certified => + rw [hcertified] at hrun + have hvalue : certified.1 = result := by injection hrun + subst result + exact certified.2 + +/-- Protected runs retain the same semantic audit as ordinary runs. -/ +theorem semanticAudit_of_runProtected_eq_ok + {reserved : List Address} + {source generated : List (Address × Decl)} {main : Code} + {result : Result} + (hrun : runProtected reserved source generated main = .ok result) : + result.semanticAudit (source ++ generated) main = true := + semanticAudit_of_run_eq_ok + (run_and_protects_of_runProtected_eq_ok hrun).1 + +/-! Pure structural format guards. Hashing behavior is pinned by the compiled +test executable. -/ + +private def fixtureOldA : Address := Address.replicate 0xFA +private def fixtureOldB : Address := Address.replicate 0xFB +private def fixtureNewA : Address := Address.replicate 0x0A +private def fixtureNewB : Address := Address.replicate 0x0B + +private def fixtureCode : Code := + .letOp (.call fixtureOldA #[]) + (.case (.var 0) false + #[.mk 0 0 (.letOp (.papp fixtureOldB #[]) (.ret (.var 0)))]) + +private def fixtureOps : List Op := + [.alloc .shared ⟨fixtureOldA, 0, 0⟩ #[], + .reuse .erased ⟨fixtureOldA, 0, 1⟩ #[], + .call fixtureOldA #[], + .papp fixtureOldB #[], + .extern fixtureOldA #[]] + +private def fixtureMap : Renaming := + [(fixtureOldA, fixtureNewA), (fixtureOldB, fixtureNewB)] + +#guard Code.references fixtureCode == [fixtureOldA, fixtureOldB] +#guard fixtureOps.flatMap Op.references == + [fixtureOldA, fixtureOldA, fixtureOldA, fixtureOldB, fixtureOldA] +#guard (fixtureOps.map (Op.mapAddresses (Renaming.apply fixtureMap))).flatMap + Op.references == + [fixtureNewA, fixtureNewA, fixtureNewA, fixtureNewB, fixtureNewA] +#guard + Code.references + (Code.mapAddresses + (Renaming.apply fixtureMap) + fixtureCode) == [fixtureNewA, fixtureNewB] + +end Readdress + +end Ix.Compiler.IxIR1 diff --git a/Ix/Compiler/IxIR1/ReaddressAll.lean b/Ix/Compiler/IxIR1/ReaddressAll.lean new file mode 100644 index 000000000..a41b75872 --- /dev/null +++ b/Ix/Compiler/IxIR1/ReaddressAll.lean @@ -0,0 +1,876 @@ +import Ix.Compiler.IxIR1.MutualBlock + +/-! +# Whole-program IxIR₁ content addressing + +Ordinary declaration hashing handles a dependency DAG, while +`IxIR1.MutualBlock` gives a finite spelling to genuine address cycles. This +module joins those two artifact forms. It discovers strongly connected +components across one flat IxIR₁ environment, processes the component DAG +from dependencies to users, hashes acyclic singletons as ordinary +declarations, and sends cyclic components through the mutual-block boundary. + +The pass is independent of lowering's current source/generated partition. +Function keys are producer names to readdress. `.extern` declaration keys +remain stable because they select an opaque oracle ABI not represented by the +arity-only declaration bytes; caller-owned identities absent from the +declaration environment (notably constructor blocks) are supplied separately +as `reserved`. The result retains a complete map (including identity entries +for stable externs) and ordered stable/ordinary/block artifact provenance for +later pipeline and proof integration. +-/ + +namespace Ix.Compiler.IxIR1 + +open Ix.Compiler.Ixon (Address) + +namespace ReaddressAll + +abbrev Renaming := Readdress.Renaming + +/-! ## Deterministic strongly connected components -/ + +/-- One SCC, with members retained in input declaration order. -/ +structure Component where + members : List (Address × Decl) + +namespace Component + +def keys (component : Component) : List Address := + component.members.map (·.1) + +/-- A singleton with an explicit self-address edge is cyclic. `callSelf` +does not carry an address and therefore remains an ordinary singleton. -/ +def cyclic (component : Component) : Bool := + match component.members with + | [(address, declaration)] => + (Readdress.Decl.references declaration).contains address + | _ :: _ :: _ => true + | _ => false + +end Component + +private structure GraphPartition where + /-- Source-index to SCC number. Numbers are assigned in user-to-dependency + topological order by the second Kosaraju pass. -/ + componentOf : Array Nat + componentCount : Nat + /-- Source-indexed internal dependency edges. -/ + edges : Array (Array Nat) + +/-- Iterative Kosaraju partitioning. Both depth-first passes use explicit +arrays as stacks, so a long dependency chain does not consume the native call +stack. Address lookup is hash-indexed; graph construction and both passes are +linear in declarations plus address-reference edges. -/ +private def graphPartition (raw : List (Address × Decl)) : GraphPartition := + Id.run do + let entries := raw.toArray + let count := entries.size + let mut keyIndex : Std.HashMap Address Nat := {} + let mut sourceIndex := 0 + for entry in entries do + keyIndex := keyIndex.insert entry.1 sourceIndex + sourceIndex := sourceIndex + 1 + + let mut edges : Array (Array Nat) := Array.replicate count #[] + let mut reverseEdges : Array (Array Nat) := Array.replicate count #[] + let mut edgeIndex := 0 + for entry in entries do + let mut outgoing : Array Nat := #[] + for reference in Readdress.Decl.references entry.2 do + match keyIndex.get? reference with + | none => pure () + | some dependency => outgoing := outgoing.push dependency + edges := edges.set! edgeIndex outgoing + for dependency in outgoing do + reverseEdges := reverseEdges.set! dependency + (reverseEdges[dependency]!.push edgeIndex) + edgeIndex := edgeIndex + 1 + + -- Finish times in the original user-to-dependency graph. + let mut visited := Array.replicate count false + let mut finished : Array Nat := #[] + for root in [:count] do + if !visited[root]! then + visited := visited.set! root true + let mut stack : Array (Nat × Nat) := #[(root, 0)] + while !stack.isEmpty do + let frame := stack.back! + let node := frame.1 + let next := frame.2 + let outgoing := edges[node]! + if next < outgoing.size then + stack := stack.set! (stack.size - 1) (node, next + 1) + let dependency := outgoing[next]! + if !visited[dependency]! then + visited := visited.set! dependency true + stack := stack.push (dependency, 0) + else + stack := stack.pop + finished := finished.push node + + -- Descending finish time over the transpose assigns components in + -- user-to-dependency topological order. + let mut componentOf := Array.replicate count count + let mut componentCount := 0 + for root in finished.reverse do + if componentOf[root]! == count then + componentOf := componentOf.set! root componentCount + let mut stack : Array Nat := #[root] + while !stack.isEmpty do + let node := stack.back! + stack := stack.pop + for user in reverseEdges[node]! do + if componentOf[user]! == count then + componentOf := componentOf.set! user componentCount + stack := stack.push user + componentCount := componentCount + 1 + return { componentOf, componentCount, edges } + +private def componentBuckets (raw : List (Address × Decl)) + (partition : GraphPartition) : Array (Array (Address × Decl)) := + Id.run do + let entries := raw.toArray + let mut buckets := Array.replicate partition.componentCount #[] + let mut sourceIndex := 0 + for entry in entries do + let component := partition.componentOf[sourceIndex]! + buckets := buckets.set! component + (buckets[component]!.push entry) + sourceIndex := sourceIndex + 1 + return buckets + +/-- Discover the SCC partition in first-member source order. Member order is +also the original declaration order, independent of DFS traversal details. -/ +def discoverComponents (raw : List (Address × Decl)) : List Component := + let partition := graphPartition raw + let buckets := componentBuckets raw partition + Id.run do + let mut emitted := Array.replicate partition.componentCount false + let mut components : Array Component := #[] + for index in [:raw.length] do + let component := partition.componentOf[index]! + if !emitted[component]! then + emitted := emitted.set! component true + components := components.push ⟨buckets[component]!.toList⟩ + return components.toList + +/-- Insert one component in a source-rank min heap. -/ +private def heapInsert (rank : Array Nat) (heap : Array Nat) + (component : Nat) : Array Nat := + Id.run do + let mut result := heap.push component + let mut index := result.size - 1 + let mut rising := true + while rising && index > 0 do + let parent := (index - 1) / 2 + if rank[result[index]!]! < rank[result[parent]!]! then + let childValue := result[index]! + let parentValue := result[parent]! + result := result.set! index parentValue + result := result.set! parent childValue + index := parent + else + rising := false + return result + +/-- Remove the source-rank-minimal component from a nonempty heap. -/ +private def heapTakeMin (rank : Array Nat) + (heap : Array Nat) : Nat × Array Nat := + Id.run do + let minimum := heap[0]! + let last := heap.back! + let mut result := heap.pop + if !result.isEmpty then + result := result.set! 0 last + let mut index := 0 + let mut falling := true + while falling do + let left := 2 * index + 1 + if left < result.size then + let right := left + 1 + let child := + if right < result.size && + rank[result[right]!]! < rank[result[left]!]! then + right + else + left + if rank[result[child]!]! < rank[result[index]!]! then + let parentValue := result[index]! + let childValue := result[child]! + result := result.set! index childValue + result := result.set! child parentValue + index := child + else + falling := false + else + falling := false + return (minimum, result) + +/-- SCCs in the same stable dependency-first order as repeatedly selecting +the first ready source component, implemented with a component DAG and a +source-rank min heap. -/ +private def discoverComponentsDependencyFirst + (raw : List (Address × Decl)) : List Component := + let partition := graphPartition raw + let buckets := componentBuckets raw partition + Id.run do + let count := partition.componentCount + let mut rank := Array.replicate count raw.length + for sourceIndex in [:partition.componentOf.size] do + let component := partition.componentOf[sourceIndex]! + if rank[component]! == raw.length then + rank := rank.set! component sourceIndex + + let mut dependencyCount := Array.replicate count 0 + let mut users : Array (Array Nat) := Array.replicate count #[] + -- `seen[dependency] == user` records that this component edge has already + -- been charged while traversing another member/reference of the same SCC. + let mut seen := Array.replicate count count + for sourceIndex in [:partition.componentOf.size] do + let user := partition.componentOf[sourceIndex]! + for dependencyIndex in partition.edges[sourceIndex]! do + let dependency := partition.componentOf[dependencyIndex]! + if dependency != user && seen[dependency]! != user then + seen := seen.set! dependency user + dependencyCount := dependencyCount.set! user + (dependencyCount[user]! + 1) + users := users.set! dependency (users[dependency]!.push user) + + let mut ready : Array Nat := #[] + for component in [:count] do + if dependencyCount[component]! == 0 then + ready := heapInsert rank ready component + + let mut components : Array Component := #[] + while !ready.isEmpty do + let (component, residual) := heapTakeMin rank ready + ready := residual + components := components.push ⟨buckets[component]!.toList⟩ + for user in users[component]! do + let remaining := dependencyCount[user]! - 1 + dependencyCount := dependencyCount.set! user remaining + if remaining == 0 then + ready := heapInsert rank ready user + return components.toList + +/-! ## Artifact/result model -/ + +/-- One dependency-ordered stored artifact. Equal ordinary declarations and +equal mutual blocks may be shared by several raw keys, so an artifact list can +be shorter than the complete address map. -/ +inductive Artifact where + | stable (address : Address) (declaration : Decl) + | ordinary (address : Address) (declaration : Decl) + | mutual (block : MutualBlock.Result) + +namespace Artifact + +def declarations : Artifact → List (Address × Decl) + | .stable address declaration => [(address, declaration)] + | .ordinary address declaration => [(address, declaration)] + | .mutual block => block.members + +def identities : Artifact → List Address + | .stable address _ => [address] + | .ordinary address _ => [address] + | .mutual block => block.blockAddress :: block.derivedAddresses + +def contentAddressed : Artifact → Bool + | .stable _ (.extern _) => true + | .stable _ _ => false + | .ordinary address declaration => address == declaration.address + | .mutual block => + block.blockAddress == MutualBlock.Block.address block.blockMembers && + block.memberKeysDerived && block.blockStable + +end Artifact + +/-- A fully readdressed flat IxIR₁ program. -/ +structure Result where + artifacts : List Artifact + main : Code + addressMap : Renaming + /-- Caller-owned identities absent from the declaration producer + environment. These are retained so constructor-key protection remains an + artifact-auditable fact rather than only a construction-time check. -/ + reserved : List Address + +private def allUnique : List Address → Bool + | [] => true + | address :: rest => !rest.contains address && allUnique rest + +namespace Result + +def declarations (result : Result) : List (Address × Decl) := + result.artifacts.flatMap Artifact.declarations + +/-- Forget artifact provenance while retaining the generic address-image +interface used by `ReaddressSim`. The generated-only pass's `Result` is also +the semantic carrier for an arbitrary certified declaration image. -/ +def asReaddressResult (result : Result) : Readdress.Result := + { source := result.declarations + generated := [] + main := result.main + addressMap := result.addressMap } + +def blocks (result : Result) : List MutualBlock.Result := + result.artifacts.filterMap fun + | .stable _ _ => none + | .ordinary _ _ => none + | .mutual block => some block + +def ordinary (result : Result) : List (Address × Decl) := + result.artifacts.filterMap fun + | .stable _ _ => none + | .ordinary address declaration => some (address, declaration) + | .mutual _ => none + +def stable (result : Result) : List (Address × Decl) := + result.artifacts.filterMap fun + | .stable address declaration => some (address, declaration) + | .ordinary _ _ | .mutual _ => none + +def blockAddresses (result : Result) : List Address := + result.blocks.map (·.blockAddress) + +def transientAddresses (result : Result) : List Address := + (result.addressMap.filter fun entry => entry.1 != entry.2).map (·.1) + +def finalAddresses (result : Result) : List Address := + result.declarations.map (·.1) + +def noTransientKeys (result : Result) : Bool := + !result.finalAddresses.any result.transientAddresses.contains + +def noTransientReferences (result : Result) : Bool := + let references := result.declarations.flatMap fun entry => + Readdress.Decl.references entry.2 + !(references ++ Readdress.Code.references result.main).any + result.transientAddresses.contains + +def contentAddressed (result : Result) : Bool := + result.artifacts.all Artifact.contentAddressed + +def protectsReserved (result : Result) : Bool := + result.reserved.all fun address => + Readdress.Renaming.apply result.addressMap address == address + +def mappingComplete (result : Result) + (raw : List (Address × Decl)) : Bool := + result.addressMap.length == raw.length && + raw.all fun entry => result.addressMap.contains entry.1 + +/-- Total address action used to transport an already-addressed graph without +adding semantic aliases to its source environment. Existing producer keys +move forward. A newly emitted key that was not already a producer key moves +back to one of its old (now unoccupied) producer spellings; every other +address stays fixed. -/ +def rebuildRename (result : Result) + (raw : List (Address × Decl)) (address : Address) : Address := + match Env.ofList raw address with + | some _ => Readdress.Renaming.apply result.addressMap address + | none => + match result.addressMap.find? fun entry => entry.2 == address with + | some entry => entry.1 + | none => address + +/-- Executable whole-program certificate. It checks the exact declaration +and main-code address image, fixed-point stability of every emitted lookup, +canonical ordinary/block identities, complete provenance, and absence of the +transient namespace. -/ +def semanticAudit (result : Result) + (raw : List (Address × Decl)) (rawMain : Code) : Bool := + result.asReaddressResult.semanticAudit raw rawMain && + (result.protectsReserved && result.mappingComplete raw && + result.contentAddressed && allUnique result.finalAddresses && + result.noTransientKeys && result.noTransientReferences) + +/-- Executable exact-source audit for rebuilding an already-addressed graph. +Besides the ordinary content-address image audit, it checks that +`rebuildRename` maps the main and every raw row to the emitted graph, that +reverse-image keys land in holes of the emitted environment, and that every +emitted declaration has a producer preimage. Those finite checks eliminate +the alias context needed by generic total readdressing. -/ +def rebuildSemanticAudit (result : Result) + (raw : List (Address × Decl)) (rawMain : Code) : Bool := + let rename := result.rebuildRename raw + let emitted := Env.ofList result.declarations + let original := Env.ofList raw + result.semanticAudit raw rawMain && + Readdress.Code.structurallyEq result.main + (Readdress.Code.mapAddresses rename rawMain) && + raw.all (fun entry => + match original entry.1, emitted (rename entry.1) with + | some before, some after => + Readdress.Decl.structurallyEq before entry.2 && + Readdress.Decl.structurallyEq after + (Readdress.Decl.mapAddresses rename before) + | _, _ => false) && + result.addressMap.all (fun entry => + (match original entry.2 with + | some _ => true + | none => (emitted entry.1).isNone) && + match original entry.1 with + | some _ => result.rebuildRename raw entry.1 == entry.2 + | none => false) && + result.declarations.all (fun entry => + result.addressMap.any fun mapping => mapping.2 == entry.1) + +/-- The whole-program audit contains the exact generic semantic image audit +consumed by evaluator equivariance. -/ +theorem semanticAudit_asReaddressResult {result : Result} + {raw : List (Address × Decl)} {rawMain : Code} + (haudit : result.semanticAudit raw rawMain = true) : + result.asReaddressResult.semanticAudit raw rawMain = true := by + simp only [semanticAudit, Bool.and_eq_true] at haudit + exact haudit.1 + +theorem protectsReserved_of_semanticAudit {result : Result} + {raw : List (Address × Decl)} {rawMain : Code} + (haudit : result.semanticAudit raw rawMain = true) : + result.protectsReserved = true := by + simp only [semanticAudit, Bool.and_eq_true] at haudit + exact haudit.2.1.1.1.1.1 + +/-- Pointwise constructor/reserved-identity stability exposed by the audited +artifact. -/ +theorem apply_reserved {result : Result} + {raw : List (Address × Decl)} {rawMain : Code} + (haudit : result.semanticAudit raw rawMain = true) + {address : Address} (haddress : address ∈ result.reserved) : + Readdress.Renaming.apply result.addressMap address = address := by + have hfixed := (List.all_eq_true.mp + (result.protectsReserved_of_semanticAudit haudit)) address haddress + exact Address.eq_of_beq hfixed + +end Result + +abbrev CertifiedResult (reserved : List Address) + (raw : List (Address × Decl)) (rawMain : Code) := + { result : Result // + result.semanticAudit raw rawMain = true ∧ result.reserved = reserved ∧ + result.rebuildSemanticAudit raw rawMain = true } + +/-- A rebuilt graph additionally certifies transport from the exact old-keyed +source environment, rather than only from the generic alias-bearing one. -/ +abbrev RebuildCertifiedResult (reserved : List Address) + (raw : List (Address × Decl)) (rawMain : Code) := + { result : Result // + result.semanticAudit raw rawMain = true ∧ result.reserved = reserved ∧ + result.rebuildSemanticAudit raw rawMain = true } + +/-! ## Dependency-ordered construction -/ + +private def firstDuplicate? : List Address → Option Address + | [] => none + | address :: rest => + if rest.contains address then some address else firstDuplicate? rest + +private def firstOverlap? (left right : List Address) : Option Address := + left.find? right.contains + +private def externalReferences (keys : List Address) + (raw : List (Address × Decl)) (main : Code) : List Address := + let references := raw.flatMap (fun entry => + Readdress.Decl.references entry.2) ++ Readdress.Code.references main + references.filter fun address => !keys.contains address + +private def stableExternKeys (raw : List (Address × Decl)) : List Address := + raw.filterMap fun + | (address, .extern _) => some address + | _ => none + +private structure BuildState where + addressMap : Renaming := [] + /-- Reverse dependency order while building. -/ + artifactsRev : List Artifact := [] + +namespace BuildState + +def declarationKeys (state : BuildState) : List Address := + state.artifactsRev.flatMap fun artifact => + (Artifact.declarations artifact).map (·.1) + +def blockAddresses (state : BuildState) : List Address := + state.artifactsRev.filterMap fun + | .stable _ _ => none + | .ordinary _ _ => none + | .mutual block => some block.blockAddress + +def usedIdentities (state : BuildState) : List Address := + state.artifactsRev.flatMap Artifact.identities + +def findOrdinary? (state : BuildState) (address : Address) : Option Decl := + let rec loop : List Artifact → Option Decl + | [] => none + | .stable _ _ :: rest => loop rest + | .ordinary found declaration :: rest => + if found == address then some declaration else loop rest + | .mutual _ :: rest => loop rest + loop state.artifactsRev + +def findBlock? (state : BuildState) + (address : Address) : Option MutualBlock.Result := + let rec loop : List Artifact → Option MutualBlock.Result + | [] => none + | .stable _ _ :: rest => loop rest + | .ordinary _ _ :: rest => loop rest + | .mutual block :: rest => + if block.blockAddress == address then some block else loop rest + loop state.artifactsRev + +end BuildState + +private def samePreimage (left right : Decl) : Bool := + left.preimage == right.preimage + +private def appendMap (state : BuildState) (mapping : Renaming) : BuildState := + { state with addressMap := state.addressMap ++ mapping } + +/-- Preserve an opaque extern ABI identity. Its declaration bytes encode +only arity and therefore cannot independently identify the oracle ledger. -/ +private def installStable (old : Address) (declaration : Decl) + (state : BuildState) : Except String BuildState := + match declaration with + | .extern _ => + .ok + { addressMap := state.addressMap ++ [(old, old)] + artifactsRev := .stable old declaration :: state.artifactsRev } + | _ => .error "internal: non-extern declaration reached stable installation" + +/-- Hash and install one acyclic singleton. -/ +private def installOrdinary (keys protectedIdentities : List Address) + (old : Address) (rawDeclaration : Decl) + (state : BuildState) : Except String BuildState := do + let declaration := Readdress.Decl.mapAddresses + (Readdress.Renaming.apply state.addressMap) rawDeclaration + let address := declaration.address + if keys.contains address then + throw s!"IxIR1 content address overlaps transient namespace {Address.toHex address}" + if protectedIdentities.contains address then + throw s!"IxIR1 content address collides with protected identity {Address.toHex address}" + match state.findOrdinary? address with + | some found => + if samePreimage found declaration then + return appendMap state [(old, address)] + else + throw s!"BLAKE3 collision while readdressing IxIR1 declaration {Address.toHex old}" + | none => + if state.usedIdentities.contains address then + .error s!"IxIR1 declaration address collides with a mutual-block identity {Address.toHex address}" + else + .ok + { addressMap := state.addressMap ++ [(old, address)] + artifactsRev := .ordinary address declaration :: state.artifactsRev } + +/-- Build or exact-content-deduplicate one cyclic component. -/ +private def installMutual (keys protectedIdentities : List Address) + (component : Component) (state : BuildState) : Except String BuildState := do + let localKeys := component.keys + let rename := Readdress.Renaming.apply state.addressMap + let rewritten := component.members.map fun entry => + (entry.1, Readdress.Decl.mapAddresses rename entry.2) + /- Protect every other producer key here. The one-block constructor already + protects this component's own transient keys and all of its external edges. -/ + let otherTransient := keys.filter fun address => !localKeys.contains address + let candidate ← MutualBlock.run + (protectedIdentities ++ otherTransient) rewritten + match state.findBlock? candidate.blockAddress with + | some existing => + if MutualBlock.DeclList.structurallyEq + existing.blockMembers candidate.blockMembers then + if existing.derivedAddresses == candidate.derivedAddresses then + return appendMap state candidate.addressMap + else + throw "internal: equal IxIR1 mutual blocks derived different member keys" + else + throw s!"BLAKE3 collision between IxIR1 mutual blocks {Address.toHex candidate.blockAddress}" + | none => + if state.usedIdentities.contains candidate.blockAddress then + .error s!"IxIR1 mutual-block identity collides with an emitted identity {Address.toHex candidate.blockAddress}" + else + match firstOverlap? candidate.derivedAddresses + state.usedIdentities with + | some overlap => + .error s!"IxIR1 mutual-block member key collides with an emitted identity {Address.toHex overlap}" + | none => + .ok + { addressMap := state.addressMap ++ candidate.addressMap + artifactsRev := .mutual candidate :: state.artifactsRev } + +private def installComponent (keys protectedIdentities : List Address) + (component : Component) (state : BuildState) : Except String BuildState := + if component.cyclic then + installMutual keys protectedIdentities component state + else + match component.members with + | [(old, declaration@(.extern _))] => + installStable old declaration state + | [(old, declaration)] => + installOrdinary keys protectedIdentities old declaration state + | _ => .error "internal: non-cyclic IxIR1 SCC was not a singleton" + +private def build (keys protectedIdentities : List Address) : + List Component → BuildState → Except String BuildState + | [], state => .ok state + | component :: rest, state => do + let state ← installComponent keys protectedIdentities component state + build keys protectedIdentities rest state + +private def certify (reserved : List Address) + (raw : List (Address × Decl)) (rawMain : Code) + (result : Result) : Except String (CertifiedResult reserved raw rawMain) := + if haudit : result.semanticAudit raw rawMain then + if hreserved : result.reserved = reserved then + if hexact : result.rebuildSemanticAudit raw rawMain then + .ok ⟨result, haudit, hreserved, hexact⟩ + else + .error "internal: whole-program IxIR1 readdressing failed exact-source semantic audit" + else + .error "internal: whole-program IxIR1 readdressing retained the wrong reserved identities" + else + .error "internal: whole-program IxIR1 readdressing failed semantic audit" + +/-- Discover, dependency-order, and content-address a complete flat IxIR₁ +environment. `reserved` contains caller-owned identities that are not +declaration producer keys (notably constructor/oracle identities). -/ +def runCertified (reserved : List Address) + (raw : List (Address × Decl)) (main : Code) : + Except String (CertifiedResult reserved raw main) := do + let keys := raw.map (·.1) + if let some duplicate := firstDuplicate? keys then + throw s!"duplicate IxIR1 declaration producer key {Address.toHex duplicate}" + if let some overlap := firstOverlap? keys reserved then + throw s!"IxIR1 declaration producer key overlaps reserved identity {Address.toHex overlap}" + let protectedIdentities := + reserved ++ stableExternKeys raw ++ externalReferences keys raw main + let components := discoverComponentsDependencyFirst raw + let state ← build keys protectedIdentities components {} + let result : Result := + { artifacts := state.artifactsRev.reverse + main := Readdress.Code.mapAddresses + (Readdress.Renaming.apply state.addressMap) main + addressMap := state.addressMap + reserved } + unless result.mappingComplete raw do + throw "internal: whole-program IxIR1 readdressing produced an incomplete map" + unless result.noTransientKeys do + throw "internal: whole-program IxIR1 readdressing emitted a transient key" + unless result.noTransientReferences do + throw "internal: whole-program IxIR1 readdressing left a transient reference" + unless result.protectsReserved do + throw "internal: whole-program IxIR1 readdressing rewrote a reserved identity" + certify reserved raw main result + +def run (reserved : List Address) + (raw : List (Address × Decl)) (main : Code) : Except String Result := do + return (← runCertified reserved raw main).1 + +/-! ## Rebuilding an already-addressed graph -/ + +/-- Domain-separated temporary producer name used only while rebuilding an +already-content-addressed graph. It cannot escape: `rebuildCertified` +re-certifies the final artifact against the caller's original keys. -/ +def rebuildTemporaryAddress (address : Address) : Address := + Address.blake3 + (IxIR.Encoding.domain "compilatrix/ixir1/rebuild-temporary/1" ++ + IxIR.Encoding.address address) + +/-- Existing extern keys are stable ABI identities; function keys receive a +temporary producer spelling before the ordinary SCC pass runs again. -/ +def rebuildTemporaryRenaming (raw : List (Address × Decl)) : Renaming := + raw.map fun entry => + match entry.2 with + | .fn _ => (entry.1, rebuildTemporaryAddress entry.1) + | .extern _ => (entry.1, entry.1) + +private def rebuildTemporaryKeys + (raw : List (Address × Decl)) : List Address := + raw.filterMap fun entry => + match entry.2 with + | .fn _ => some (rebuildTemporaryAddress entry.1) + | .extern _ => none + +private def composeRebuildMap (raw : List (Address × Decl)) + (temporary final : Renaming) : Renaming := + raw.map fun entry => + (entry.1, Readdress.Renaming.apply final + (Readdress.Renaming.apply temporary entry.1)) + +/-- Rebuild a graph whose current keys may already be its declaration or +mutual-block content addresses. The ordinary producer rejects output keys in +its transient namespace, so this adapter first alpha-renames function +producers into a domain-separated temporary namespace. Extern identities and +all caller-owned/external identities remain fixed. The returned result is +then certified directly against the original graph; neither a temporary key +nor the intermediate address map is exposed. -/ +def rebuildCertified (reserved : List Address) + (raw : List (Address × Decl)) (main : Code) : + Except String (RebuildCertifiedResult reserved raw main) := do + let keys := raw.map (·.1) + if let some duplicate := firstDuplicate? keys then + throw s!"duplicate IxIR1 declaration key while rebuilding {Address.toHex duplicate}" + let temporaryKeys := rebuildTemporaryKeys raw + let protectedIdentities := + keys ++ reserved ++ externalReferences keys raw main + if let some overlap := firstOverlap? temporaryKeys protectedIdentities then + throw s!"IxIR1 rebuild temporary address collides with an existing identity {Address.toHex overlap}" + if let some duplicate := firstDuplicate? temporaryKeys then + throw s!"BLAKE3 collision between IxIR1 rebuild temporary addresses {Address.toHex duplicate}" + let temporary := rebuildTemporaryRenaming raw + let rename := Readdress.Renaming.apply temporary + let temporaryRaw := raw.map fun entry => + (rename entry.1, Readdress.Decl.mapAddresses rename entry.2) + let temporaryMain := Readdress.Code.mapAddresses rename main + let intermediate ← runCertified reserved temporaryRaw temporaryMain + let result : Result := + { intermediate.1 with + addressMap := composeRebuildMap raw temporary + intermediate.1.addressMap + reserved } + if haudit : result.semanticAudit raw main then + if hreserved : result.reserved = reserved then + if hexact : result.rebuildSemanticAudit raw main then + return ⟨result, haudit, hreserved, hexact⟩ + else + throw "internal: IxIR1 rebuild failed exact-source semantic audit" + else + throw "internal: IxIR1 rebuild retained the wrong reserved identities" + else + throw "internal: IxIR1 rebuild failed semantic audit" + +/-- Unbundled already-addressed graph rebuild. -/ +def rebuild (reserved : List Address) + (raw : List (Address × Decl)) (main : Code) : Except String Result := do + return (← rebuildCertified reserved raw main).1 + +theorem semanticAudit_of_rebuild_eq_ok + {reserved : List Address} {raw : List (Address × Decl)} {main : Code} + {result : Result} (hrebuild : rebuild reserved raw main = .ok result) : + result.semanticAudit raw main = true := by + unfold rebuild at hrebuild + cases hcertified : rebuildCertified reserved raw main with + | error message => + rw [hcertified] at hrebuild + contradiction + | ok certified => + rw [hcertified] at hrebuild + have hvalue : certified.1 = result := by injection hrebuild + subst result + exact certified.2.1 + +theorem reserved_of_rebuild_eq_ok + {reserved : List Address} {raw : List (Address × Decl)} {main : Code} + {result : Result} (hrebuild : rebuild reserved raw main = .ok result) : + result.reserved = reserved := by + unfold rebuild at hrebuild + cases hcertified : rebuildCertified reserved raw main with + | error message => + rw [hcertified] at hrebuild + contradiction + | ok certified => + rw [hcertified] at hrebuild + have hvalue : certified.1 = result := by injection hrebuild + subst result + exact certified.2.2.1 + +theorem rebuildSemanticAudit_of_rebuild_eq_ok + {reserved : List Address} {raw : List (Address × Decl)} {main : Code} + {result : Result} (hrebuild : rebuild reserved raw main = .ok result) : + result.rebuildSemanticAudit raw main = true := by + unfold rebuild at hrebuild + cases hcertified : rebuildCertified reserved raw main with + | error message => + rw [hcertified] at hrebuild + contradiction + | ok certified => + rw [hcertified] at hrebuild + have hvalue : certified.1 = result := by injection hrebuild + subst result + exact certified.2.2.2 + +theorem semanticAudit_of_run_eq_ok + {reserved : List Address} {raw : List (Address × Decl)} {main : Code} + {result : Result} (hrun : run reserved raw main = .ok result) : + result.semanticAudit raw main = true := by + unfold run at hrun + cases hcertified : runCertified reserved raw main with + | error message => + rw [hcertified] at hrun + contradiction + | ok certified => + rw [hcertified] at hrun + have hvalue : certified.1 = result := by injection hrun + subst result + exact certified.2.1 + +theorem reserved_of_run_eq_ok + {reserved : List Address} {raw : List (Address × Decl)} {main : Code} + {result : Result} (hrun : run reserved raw main = .ok result) : + result.reserved = reserved := by + unfold run at hrun + cases hcertified : runCertified reserved raw main with + | error message => + rw [hcertified] at hrun + contradiction + | ok certified => + rw [hcertified] at hrun + have hvalue : certified.1 = result := by injection hrun + subst result + exact certified.2.2.1 + +/-- Every successful ordinary SCC pass supports transport from the exact raw +declaration environment, without installing aliases at newly emitted content +keys. -/ +theorem rebuildSemanticAudit_of_run_eq_ok + {reserved : List Address} {raw : List (Address × Decl)} {main : Code} + {result : Result} (hrun : run reserved raw main = .ok result) : + result.rebuildSemanticAudit raw main = true := by + unfold run at hrun + cases hcertified : runCertified reserved raw main with + | error message => + rw [hcertified] at hrun + contradiction + | ok certified => + rw [hcertified] at hrun + have hvalue : certified.1 = result := by injection hrun + subst result + exact certified.2.2.2 + +theorem protectsReserved_of_run_eq_ok + {reserved : List Address} {raw : List (Address × Decl)} {main : Code} + {result : Result} (hrun : run reserved raw main = .ok result) : + result.protectsReserved = true := + Result.protectsReserved_of_semanticAudit + (semanticAudit_of_run_eq_ok hrun) + +/-! Pure SCC/dispatch guards. Digest behavior is exercised by the compiled +test executable. -/ + +private def fixtureA : Address := Address.replicate 0xa1 +private def fixtureB : Address := Address.replicate 0xa2 +private def fixtureC : Address := Address.replicate 0xa3 +private def fixtureD : Address := Address.replicate 0xa4 + +private def fixtureRaw : List (Address × Decl) := + [(fixtureA, .fn ⟨1, .shared, true, + .letOp (.call fixtureB #[.var 0]) (.ret (.var 0))⟩), + (fixtureB, .fn ⟨0, .shared, true, + .letOp (.papp fixtureA #[]) (.ret .erased)⟩), + (fixtureC, .fn ⟨0, .shared, true, + .letOp (.call fixtureA #[]) (.ret .erased)⟩), + (fixtureD, .extern 0)] + +#guard (discoverComponents fixtureRaw).map Component.keys == + [[fixtureA, fixtureB], [fixtureC], [fixtureD]] +#guard (discoverComponents + [(fixtureA, .fn ⟨0, .shared, true, + .letOp (.call fixtureA #[]) (.ret .erased)⟩)]).all Component.cyclic +#guard !(discoverComponents + [(fixtureA, .fn ⟨0, .shared, true, + .letOp (.callSelf #[]) (.ret .erased)⟩)]).any Component.cyclic + +end ReaddressAll + +end Ix.Compiler.IxIR1 diff --git a/Ix/Compiler/IxIR1/ReaddressAllSim.lean b/Ix/Compiler/IxIR1/ReaddressAllSim.lean new file mode 100644 index 000000000..a801e59c7 --- /dev/null +++ b/Ix/Compiler/IxIR1/ReaddressAllSim.lean @@ -0,0 +1,355 @@ +import Ix.Compiler.IxIR1.ReaddressAll +import Ix.Compiler.IxIR1.ReaddressSim + +/-! +# Semantic transport for whole-program IxIR₁ readdressing + +`ReaddressAll.Result` retains richer stable/ordinary/block provenance than the +generated-only result, but its semantic core is the same exact address image. +This module projects that core into the already proved evaluator equivariance +interface and exposes concrete successful-run transport for the SCC pass. +-/ + +namespace Ix.Compiler.IxIR1 + +open Ix.Compiler.Ixon (Address) + +namespace ReaddressAll + +namespace Result + +def addressedCtx (result : Result) + (oracle : Address → List RVal → Option RVal := fun _ _ => none) : Ctx := + result.asReaddressResult.addressedCtx oracle + +def preAddressCtx (result : Result) + (raw : List (Address × Decl)) + (oracle : Address → List RVal → Option RVal := fun _ _ => none) : Ctx := + result.asReaddressResult.preAddressCtx raw oracle + +/-- Exact old-keyed source context for a certified rebuild. Unlike +`preAddressCtx`, its declaration environment contains no aliases. -/ +def rebuildSourceCtx (result : Result) + (raw : List (Address × Decl)) + (oracle : Address → List RVal → Option RVal := fun _ _ => none) : Ctx := + { decls := Env.ofList raw + oracle := fun address arguments => + oracle (result.rebuildRename raw address) arguments } + +theorem main_eq_mapAddresses {result : Result} + {raw : List (Address × Decl)} {main : Code} + (haudit : result.semanticAudit raw main = true) : + result.main = Readdress.Code.mapAddresses + (Readdress.Renaming.apply result.addressMap) main := by + exact result.asReaddressResult.main_eq_mapAddresses + (result.semanticAudit_asReaddressResult haudit) + +theorem renames_preAddressCtx {result : Result} + {raw : List (Address × Decl)} {main : Code} + (haudit : result.semanticAudit raw main = true) + (oracle : Address → List RVal → Option RVal) : + Readdress.Ctx.Renames + (Readdress.Renaming.apply result.addressMap) + (result.preAddressCtx raw oracle) (result.addressedCtx oracle) := by + exact result.asReaddressResult.renames_preAddressCtx + (result.semanticAudit_asReaddressResult haudit) oracle + +private theorem envOfList_some_mem + {entries : List (Address × Decl)} {address : Address} {declaration : Decl} + (hlookup : Env.ofList entries address = some declaration) : + (address, declaration) ∈ entries := by + unfold Env.ofList at hlookup + obtain ⟨entry, hfind, hvalue⟩ := Option.map_eq_some_iff.mp hlookup + rcases entry with ⟨entryAddress, entryDeclaration⟩ + have hbeq : entryAddress == address := + List.find?_some + (p := fun entry : Address × Decl => entry.1 == address) hfind + have haddress : entryAddress = address := Address.eq_of_beq hbeq + have hdeclaration : entryDeclaration = declaration := by + simpa using hvalue + subst entryAddress + subst entryDeclaration + exact List.mem_of_find?_eq_some hfind + +/-- The finite exact-source rebuild audit reflects into the total context +relation used by evaluator equivariance. -/ +theorem renames_rebuildSourceCtx {result : Result} + {raw : List (Address × Decl)} {main : Code} + (haudit : result.rebuildSemanticAudit raw main = true) + (oracle : Address → List RVal → Option RVal) : + Readdress.Ctx.Renames (result.rebuildRename raw) + (result.rebuildSourceCtx raw oracle) (result.addressedCtx oracle) := by + simp only [Result.rebuildSemanticAudit, Bool.and_eq_true] at haudit + constructor + · intro address + simp only [Result.addressedCtx, Result.rebuildSourceCtx, + Readdress.Result.addressedCtx, Readdress.Result.declarations, + Result.asReaddressResult, List.append_nil] + change Env.ofList result.declarations (result.rebuildRename raw address) = + (Env.ofList raw address).map + (Readdress.Decl.mapAddresses (result.rebuildRename raw)) + cases horiginal : Env.ofList raw address with + | some declaration => + have hmember : (address, declaration) ∈ raw := + envOfList_some_mem horiginal + have hrow := (List.all_eq_true.mp haudit.1.1.2) + (address, declaration) hmember + simp only [Result.rebuildRename, horiginal] at hrow + cases hemitted : Env.ofList result.declarations + (Readdress.Renaming.apply result.addressMap address) with + | none => simp [hemitted] at hrow + | some emitted => + simp only [hemitted, Bool.and_eq_true] at hrow + have hequal : emitted = Readdress.Decl.mapAddresses + (result.rebuildRename raw) declaration := + (Readdress.Decl.structurallyEq_eq_true_iff _ _).mp (by + simpa [horiginal, hemitted] using hrow.2) + simp [Result.rebuildRename, horiginal, hemitted, hequal] + | none => + cases hreverse : result.addressMap.find? + (fun entry => entry.2 == address) with + | some mapping => + rcases mapping with ⟨source, target⟩ + have htargetBeq : target == address := + List.find?_some + (p := fun entry : Address × Address => entry.2 == address) + hreverse + have htarget : target = address := Address.eq_of_beq htargetBeq + subst target + have hmember : (source, address) ∈ result.addressMap := + List.mem_of_find?_eq_some hreverse + have hpair := (List.all_eq_true.mp haudit.1.2) + (source, address) hmember + simp only [Bool.and_eq_true] at hpair + have hsafe := hpair.1 + simp only [horiginal] at hsafe + simp only [Result.rebuildRename, horiginal, hreverse, + Option.map_none] + simpa using hsafe + | none => + simp only [Result.rebuildRename, horiginal, hreverse, + Option.map_none] + cases hemitted : Env.ofList result.declarations address with + | none => rfl + | some declaration => + have hmember : (address, declaration) ∈ result.declarations := + envOfList_some_mem hemitted + have hcovered := (List.all_eq_true.mp haudit.2) + (address, declaration) hmember + obtain ⟨mapping, hmapping, hmaps⟩ := + List.any_eq_true.mp hcovered + have hmissing := (List.find?_eq_none.mp hreverse) + mapping hmapping + exact (hmissing hmaps).elim + · intro address arguments + rfl + +/-- Every literal raw row is selected by the exact source environment carried +by the rebuild audit. Ordinary initial addressing and rebuilding both expose +this fact through their successful-run certificates. -/ +theorem raw_lookup_of_mem_of_rebuildSemanticAudit {result : Result} + {raw : List (Address × Decl)} {main : Code} + (haudit : result.rebuildSemanticAudit raw main = true) + {address : Address} {declaration : Decl} + (hmember : (address, declaration) ∈ raw) : + Env.ofList raw address = some declaration := by + simp only [Result.rebuildSemanticAudit, Bool.and_eq_true] at haudit + have hrow := (List.all_eq_true.mp haudit.1.1.2) + (address, declaration) hmember + cases hlookup : Env.ofList raw address with + | none => simp [hlookup] at hrow + | some selected => + cases hemitted : Env.ofList result.declarations + (result.rebuildRename raw address) with + | none => simp [hlookup, hemitted] at hrow + | some emitted => + simp only [hlookup, hemitted, Bool.and_eq_true] at hrow + have hselected : selected = declaration := + (Readdress.Decl.structurallyEq_eq_true_iff _ _).mp hrow.1 + simpa [hlookup, hselected] + +/-- Every selected emitted declaration has an exact raw producer whose key +maps to the emitted key and whose declaration maps to the selected value. +This is the lookup-facing provenance needed to back-translate reachable +runtime heaps without requiring the rebuild map to be globally surjective. -/ +theorem declaration_preimage_of_lookup_of_rebuildSemanticAudit + {result : Result} {raw : List (Address × Decl)} {main : Code} + (haudit : result.rebuildSemanticAudit raw main = true) + {address : Address} {declaration : Decl} + (hlookup : Env.ofList result.declarations address = some declaration) : + ∃ sourceAddress sourceDeclaration, + Env.ofList raw sourceAddress = some sourceDeclaration ∧ + result.rebuildRename raw sourceAddress = address ∧ + Readdress.Decl.mapAddresses (result.rebuildRename raw) + sourceDeclaration = declaration := by + have hrenames := + result.renames_rebuildSourceCtx haudit (fun _ _ => none) + simp only [Result.rebuildSemanticAudit, Bool.and_eq_true] at haudit + have hmember : (address, declaration) ∈ result.declarations := + envOfList_some_mem hlookup + have hcovered := (List.all_eq_true.mp haudit.2) + (address, declaration) hmember + obtain ⟨mapping, mappingMember, mapsTo⟩ := + List.any_eq_true.mp hcovered + obtain ⟨sourceAddress, targetAddress⟩ := mapping + have targetEq : targetAddress = address := Address.eq_of_beq mapsTo + subst targetAddress + have hsourcePair := (List.all_eq_true.mp haudit.1.2) + (sourceAddress, address) mappingMember + simp only [Bool.and_eq_true] at hsourcePair + have hsource := hsourcePair.2 + cases sourceLookup : Env.ofList raw sourceAddress with + | none => simp [sourceLookup] at hsource + | some sourceDeclaration => + have renameEq : result.rebuildRename raw sourceAddress = address := by + exact Address.eq_of_beq (by simpa [sourceLookup] using hsource) + have relation := hrenames.decls sourceAddress + simp only [Result.addressedCtx, Result.rebuildSourceCtx, + Readdress.Result.addressedCtx, Readdress.Result.declarations, + Result.asReaddressResult, List.append_nil] at relation + rw [renameEq, hlookup, sourceLookup] at relation + simp only [Option.map_some, Option.some.injEq] at relation + exact ⟨sourceAddress, sourceDeclaration, sourceLookup, renameEq, + relation.symm⟩ + +theorem main_eq_rebuildMapAddresses {result : Result} + {raw : List (Address × Decl)} {main : Code} + (haudit : result.rebuildSemanticAudit raw main = true) : + result.main = Readdress.Code.mapAddresses + (result.rebuildRename raw) main := by + simp only [Result.rebuildSemanticAudit, Bool.and_eq_true] at haudit + exact (Readdress.Code.structurallyEq_eq_true_iff _ _).mp + haudit.1.1.1.2 + +end Result + +/-- A successful SCC pass transports the complete evaluator result, including +heap-retained constructor/PAP addresses, address-bearing errors, and counters. -/ +theorem runMain_of_run_eq_ok + {reserved : List Address} {raw : List (Address × Decl)} {main : Code} + {result : Result} + (hrun : run reserved raw main = .ok result) + (oracle : Address → List RVal → Option RVal := fun _ _ => none) + (fuel : Nat := 100000) : + runMain (result.addressedCtx oracle) result.main fuel = + Readdress.mapRunResult + (Readdress.Renaming.apply result.addressMap) + (runMain (result.preAddressCtx raw oracle) main fuel) := by + have haudit := semanticAudit_of_run_eq_ok hrun + rw [result.main_eq_mapAddresses haudit] + exact Readdress.runMain_mapAddresses + (result.renames_preAddressCtx haudit oracle) main fuel + +theorem runMain_success_of_run_eq_ok + {reserved : List Address} {raw : List (Address × Decl)} {main : Code} + {result : Result} + (hrun : run reserved raw main = .ok result) + (oracle : Address → List RVal → Option RVal) + {fuel : Nat} {store : Store} {value : RVal} + (hsource : runMain (result.preAddressCtx raw oracle) main fuel = + .ok (store, value)) : + runMain (result.addressedCtx oracle) result.main fuel = + .ok (Readdress.Store.mapAddresses + (Readdress.Renaming.apply result.addressMap) store, value) := by + rw [runMain_of_run_eq_ok hrun oracle fuel, hsource] + rfl + +/-- Exact-source transport for the ordinary SCC pass. Successful initial +content addressing now certifies the same alias-free source view as rebuilds. -/ +theorem runMain_exact_of_run_eq_ok + {reserved : List Address} {raw : List (Address × Decl)} {main : Code} + {result : Result} + (hrun : run reserved raw main = .ok result) + (oracle : Address → List RVal → Option RVal := fun _ _ => none) + (fuel : Nat := 100000) : + runMain (result.addressedCtx oracle) result.main fuel = + Readdress.mapRunResult (result.rebuildRename raw) + (runMain (result.rebuildSourceCtx raw oracle) main fuel) := by + have haudit := rebuildSemanticAudit_of_run_eq_ok hrun + rw [result.main_eq_rebuildMapAddresses haudit] + exact Readdress.runMain_mapAddresses + (result.renames_rebuildSourceCtx haudit oracle) main fuel + +/-- Successful-run specialization of ordinary exact-source transport. -/ +theorem runMain_exact_success_of_run_eq_ok + {reserved : List Address} {raw : List (Address × Decl)} {main : Code} + {result : Result} + (hrun : run reserved raw main = .ok result) + (oracle : Address → List RVal → Option RVal) + {fuel : Nat} {store : Store} {value : RVal} + (hsource : runMain (result.rebuildSourceCtx raw oracle) main fuel = + .ok (store, value)) : + runMain (result.addressedCtx oracle) result.main fuel = + .ok (Readdress.Store.mapAddresses + (result.rebuildRename raw) store, value) := by + rw [runMain_exact_of_run_eq_ok hrun oracle fuel, hsource] + rfl + +/-- The already-addressed rebuild adapter has the same complete evaluator +transport as the initial SCC pass. Its source context contains the original +rows plus the stable aliases required by total address equivariance. -/ +theorem runMain_of_rebuild_eq_ok + {reserved : List Address} {raw : List (Address × Decl)} {main : Code} + {result : Result} + (hrebuild : rebuild reserved raw main = .ok result) + (oracle : Address → List RVal → Option RVal := fun _ _ => none) + (fuel : Nat := 100000) : + runMain (result.addressedCtx oracle) result.main fuel = + Readdress.mapRunResult + (Readdress.Renaming.apply result.addressMap) + (runMain (result.preAddressCtx raw oracle) main fuel) := by + have haudit := semanticAudit_of_rebuild_eq_ok hrebuild + rw [result.main_eq_mapAddresses haudit] + exact Readdress.runMain_mapAddresses + (result.renames_preAddressCtx haudit oracle) main fuel + +/-- Successful-run specialization for rebuilding an already-addressed graph. -/ +theorem runMain_success_of_rebuild_eq_ok + {reserved : List Address} {raw : List (Address × Decl)} {main : Code} + {result : Result} + (hrebuild : rebuild reserved raw main = .ok result) + (oracle : Address → List RVal → Option RVal) + {fuel : Nat} {store : Store} {value : RVal} + (hsource : runMain (result.preAddressCtx raw oracle) main fuel = + .ok (store, value)) : + runMain (result.addressedCtx oracle) result.main fuel = + .ok (Readdress.Store.mapAddresses + (Readdress.Renaming.apply result.addressMap) store, value) := by + rw [runMain_of_rebuild_eq_ok hrebuild oracle fuel, hsource] + rfl + +/-- Exact-source transport for rebuilding an already-addressed graph. The +source declaration environment is precisely `Env.ofList raw`; no newly +emitted content key is installed as an alias. -/ +theorem runMain_exact_of_rebuild_eq_ok + {reserved : List Address} {raw : List (Address × Decl)} {main : Code} + {result : Result} + (hrebuild : rebuild reserved raw main = .ok result) + (oracle : Address → List RVal → Option RVal := fun _ _ => none) + (fuel : Nat := 100000) : + runMain (result.addressedCtx oracle) result.main fuel = + Readdress.mapRunResult (result.rebuildRename raw) + (runMain (result.rebuildSourceCtx raw oracle) main fuel) := by + have haudit := rebuildSemanticAudit_of_rebuild_eq_ok hrebuild + rw [result.main_eq_rebuildMapAddresses haudit] + exact Readdress.runMain_mapAddresses + (result.renames_rebuildSourceCtx haudit oracle) main fuel + +/-- Successful-run specialization of exact-source rebuild transport. -/ +theorem runMain_exact_success_of_rebuild_eq_ok + {reserved : List Address} {raw : List (Address × Decl)} {main : Code} + {result : Result} + (hrebuild : rebuild reserved raw main = .ok result) + (oracle : Address → List RVal → Option RVal) + {fuel : Nat} {store : Store} {value : RVal} + (hsource : runMain (result.rebuildSourceCtx raw oracle) main fuel = + .ok (store, value)) : + runMain (result.addressedCtx oracle) result.main fuel = + .ok (Readdress.Store.mapAddresses + (result.rebuildRename raw) store, value) := by + rw [runMain_exact_of_rebuild_eq_ok hrebuild oracle fuel, hsource] + rfl + +end ReaddressAll + +end Ix.Compiler.IxIR1 diff --git a/Ix/Compiler/IxIR1/ReaddressOwnership.lean b/Ix/Compiler/IxIR1/ReaddressOwnership.lean new file mode 100644 index 000000000..5359b867b --- /dev/null +++ b/Ix/Compiler/IxIR1/ReaddressOwnership.lean @@ -0,0 +1,158 @@ +import Ix.Compiler.IxIR1.Sim +import Ix.Compiler.IxIR1.ReaddressSim + +/-! +# Ownership invariance under IxIR₁ address renaming + +Readdressing changes declaration identities retained by constructor and PAP +nodes, but it leaves locations, ownership worlds, reference counts, and heap +edges unchanged. This file exposes that fact at the exact `RootOwnership` +boundary used by compiler simulations. +-/ + +namespace Ix.Compiler.IxIR1.Sim + +@[simp] theorem nodeChildren_mapAddresses + (rename : Ixon.Address → Ixon.Address) (node : IxIR1.Node) : + nodeChildren (IxIR1.Readdress.Node.mapAddresses rename node) = + nodeChildren node := by + cases node <;> rfl + +@[simp] theorem slotEdgeLocations_mapAddresses + (rename : Ixon.Address → Ixon.Address) + (slot : Option IxIR1.NodeBox) : + slotEdgeLocations + (slot.map (IxIR1.Readdress.NodeBox.mapAddresses rename)) = + slotEdgeLocations slot := by + cases slot with + | none => rfl + | some box => + simp [slotEdgeLocations, IxIR1.Readdress.NodeBox.mapAddresses, + nodeChildren_mapAddresses] + +@[simp] theorem edgeLocations_mapAddresses + (rename : Ixon.Address → Ixon.Address) (store : IxIR1.Store) : + edgeLocations (IxIR1.Readdress.Store.mapAddresses rename store) = + edgeLocations store := by + simp only [edgeLocations, IxIR1.Readdress.Store.mapAddresses, + Array.toList_map, List.flatMap_map] + apply congrArg (fun visit => List.flatMap visit store.nodes.toList) + funext slot + exact slotEdgeLocations_mapAddresses rename slot + +@[simp] theorem incoming_mapAddresses + (rename : Ixon.Address → Ixon.Address) (store : IxIR1.Store) + (roots : List Root) (location : Nat) : + incoming (IxIR1.Readdress.Store.mapAddresses rename store) roots location = + incoming store roots location := by + simp [incoming, edgeLocations_mapAddresses] + +/-- Heap-world evidence ignores the declaration identities stored below a +live node. -/ +theorem hasWorld_mapAddresses_iff + (rename : Ixon.Address → Ixon.Address) (store : IxIR1.Store) + (world : Ixon.Owned) (value : IxIR1.RVal) : + HasWorld (IxIR1.Readdress.Store.mapAddresses rename store) world value ↔ + HasWorld store world value := by + cases value with + | lit literal => simp [HasWorld] + | erased => simp [HasWorld] + | loc location => + simp only [HasWorld, IxIR1.Readdress.Store.get?_mapAddresses] + constructor + · rintro ⟨mapped, mappedAt, mappedWorld⟩ + cases originalAt : store.get? location with + | none => simp [originalAt] at mappedAt + | some original => + simp only [originalAt, Option.map_some, + Option.some.injEq] at mappedAt + subst mapped + exact ⟨original, rfl, by simpa using mappedWorld⟩ + · rintro ⟨original, originalAt, originalWorld⟩ + exact ⟨IxIR1.Readdress.NodeBox.mapAddresses rename original, + by simp [originalAt], by simpa using originalWorld⟩ + +/-- Exact root ownership is invariant under arbitrary declaration-address +renaming. Constructor/PAP identities are operational metadata rather than +heap edges; all ownership-relevant structure is unchanged. -/ +theorem rootOwnership_mapAddresses_iff + (rename : Ixon.Address → Ixon.Address) (store : IxIR1.Store) + (roots : List Root) : + RootOwnership (IxIR1.Readdress.Store.mapAddresses rename store) roots ↔ + RootOwnership store roots := by + constructor + · intro mappedOwnership + refine ⟨?_, ?_, ?_, ?_⟩ + · intro root member + exact (hasWorld_mapAddresses_iff rename store root.world + root.value).mp (mappedOwnership.roots_world root member) + · intro location box boxAt child childMember + have mappedAt : + (IxIR1.Readdress.Store.mapAddresses rename store).get? location = + some (IxIR1.Readdress.NodeBox.mapAddresses rename box) := by + simp [boxAt] + have mappedChild : child ∈ nodeChildren + (IxIR1.Readdress.NodeBox.mapAddresses rename box).node := by + simpa using childMember + exact (hasWorld_mapAddresses_iff rename store box.world child).mp + (by simpa using mappedOwnership.edges_world mappedAt child mappedChild) + · intro location box function arity arguments boxAt node + have mappedAt : + (IxIR1.Readdress.Store.mapAddresses rename store).get? location = + some (IxIR1.Readdress.NodeBox.mapAddresses rename box) := by + simp [boxAt] + have mappedNode : + (IxIR1.Readdress.NodeBox.mapAddresses rename box).node = + .papN (rename function) arity arguments := by + rw [IxIR1.Readdress.NodeBox.mapAddresses_node, node] + rfl + simpa using mappedOwnership.pap_shared mappedAt mappedNode + · intro location box boxAt + have mappedAt : + (IxIR1.Readdress.Store.mapAddresses rename store).get? location = + some (IxIR1.Readdress.NodeBox.mapAddresses rename box) := by + simp [boxAt] + simpa using mappedOwnership.counts mappedAt + · intro ownership + refine ⟨?_, ?_, ?_, ?_⟩ + · intro root member + exact (hasWorld_mapAddresses_iff rename store root.world + root.value).mpr (ownership.roots_world root member) + · intro location mappedBox mappedAt child childMember + cases boxAt : store.get? location with + | none => simp [boxAt] at mappedAt + | some box => + simp only [IxIR1.Readdress.Store.get?_mapAddresses, boxAt, + Option.map_some, Option.some.injEq] at mappedAt + subst mappedBox + have originalChild : child ∈ nodeChildren box.node := by + simpa using childMember + exact (hasWorld_mapAddresses_iff rename store box.world child).mpr + (ownership.edges_world boxAt child originalChild) + · intro location mappedBox function arity arguments mappedAt mappedNode + cases boxAt : store.get? location with + | none => simp [boxAt] at mappedAt + | some box => + simp only [IxIR1.Readdress.Store.get?_mapAddresses, boxAt, + Option.map_some, Option.some.injEq] at mappedAt + subst mappedBox + cases nodeEq : box.node with + | ctorN cid fields => + simp [IxIR1.Readdress.NodeBox.mapAddresses, + IxIR1.Readdress.Node.mapAddresses, nodeEq] at mappedNode + | papN originalFunction originalArity originalArguments => + have originalShared : box.world = .shared := + ownership.pap_shared (loc := location) (box := box) + (f := originalFunction) (arity := originalArity) + (args := originalArguments) boxAt nodeEq + simpa using originalShared + · intro location mappedBox mappedAt + cases boxAt : store.get? location with + | none => simp [boxAt] at mappedAt + | some box => + simp only [IxIR1.Readdress.Store.get?_mapAddresses, boxAt, + Option.map_some, Option.some.injEq] at mappedAt + subst mappedBox + simpa using ownership.counts boxAt + +end Ix.Compiler.IxIR1.Sim diff --git a/Ix/Compiler/IxIR1/ReaddressSim.lean b/Ix/Compiler/IxIR1/ReaddressSim.lean new file mode 100644 index 000000000..deebfd7d2 --- /dev/null +++ b/Ix/Compiler/IxIR1/ReaddressSim.lean @@ -0,0 +1,1735 @@ +import Ix.Compiler.IxIR1.Eval +import Ix.Compiler.IxIR1.Readdress + +/-! +# Semantic transport for IxIR₁ address renaming + +Content addressing changes declaration keys and every reference to those +keys. Runtime heaps also retain addresses in constructor identities and PAP +nodes, so semantic transport must cover the whole evaluator state rather than +only its input code. + +This module first defines the structural action of an arbitrary address map +on evaluator state and errors. `Ctx.Renames` is the exact forward lookup and +oracle compatibility required by the evaluator; it intentionally permits +non-injective maps when declarations with the same image are semantically the +same, which is the case used by exact-content deduplication. +-/ + +namespace Ix.Compiler.IxIR1 + +open Ix.Compiler.Ixon (Address) + +namespace Readdress + +namespace Node + +/-- Apply an address map to the identities retained in a heap node. -/ +def mapAddresses (rename : Address → Address) : Node → Node + | .ctorN constructor fields => + .ctorN (CtorId.mapAddresses rename constructor) fields + | .papN function arity arguments => + .papN (rename function) arity arguments + +end Node + +namespace NodeBox + +/-- Apply an address map beneath one live heap cell. -/ +def mapAddresses (rename : Address → Address) (box : NodeBox) : NodeBox := + { box with node := Node.mapAddresses rename box.node } + +end NodeBox + +namespace Store + +/-- Apply an address map to every live or dead heap cell. Locations, +ownership, reference counts, and all cost counters remain unchanged. -/ +def mapAddresses (rename : Address → Address) (store : Store) : Store := + { store with + nodes := store.nodes.map (Option.map (NodeBox.mapAddresses rename)) } + +end Store + +namespace Err + +/-- Address action on evaluator failures. Only a closed-world lookup failure +retains an address. -/ +def mapAddresses (rename : Address → Address) : Err → Err + | .fuel => .fuel + | .stuck message => .stuck message + | .mem message => .mem message + | .unknownRef address => .unknownRef (rename address) + +end Err + +/-- Address action on a store-returning evaluator result. -/ +def mapStoreResult (rename : Address → Address) : + Except Err Store → Except Err Store + | .ok store => .ok (Store.mapAddresses rename store) + | .error error => .error (Err.mapAddresses rename error) + +/-- Address action on an ordinary evaluator result. Runtime values contain +locations and scalars but no declaration addresses. -/ +def mapRunResult (rename : Address → Address) : + Except Err (Store × RVal) → Except Err (Store × RVal) + | .ok (store, value) => .ok (Store.mapAddresses rename store, value) + | .error error => .error (Err.mapAddresses rename error) + +/-- Address action on a scalar/runtime-value evaluator result. -/ +def mapValueResult (rename : Address → Address) : + Except Err RVal → Except Err RVal + | .ok value => .ok value + | .error error => .error (Err.mapAddresses rename error) + +/-- Address action on a list-of-runtime-values evaluator result. -/ +def mapValuesResult (rename : Address → Address) : + Except Err (List RVal) → Except Err (List RVal) + | .ok values => .ok values + | .error error => .error (Err.mapAddresses rename error) + +@[simp] private theorem except_ok_bind {Error Value Result : Type} + (value : Value) (next : Value → Except Error Result) : + (Except.ok value >>= next) = next value := rfl + +@[simp] private theorem except_error_bind {Error Value Result : Type} + (error : Error) (next : Value → Except Error Result) : + (Except.error error >>= next) = Except.error error := rfl + +@[simp] theorem mapRunResult_ok (rename : Address → Address) + (store : Store) (value : RVal) : + mapRunResult rename (.ok (store, value)) = + .ok (Store.mapAddresses rename store, value) := rfl + +@[simp] theorem mapRunResult_error (rename : Address → Address) + (error : Err) : + mapRunResult rename (.error error) = + .error (Err.mapAddresses rename error) := rfl + +@[simp] theorem mapStoreResult_ok (rename : Address → Address) + (store : Store) : + mapStoreResult rename (.ok store) = + .ok (Store.mapAddresses rename store) := rfl + +@[simp] theorem mapStoreResult_error (rename : Address → Address) + (error : Err) : + mapStoreResult rename (.error error) = + .error (Err.mapAddresses rename error) := rfl + +@[simp] theorem Err.mapAddresses_fuel (rename : Address → Address) : + Err.mapAddresses rename .fuel = .fuel := rfl + +@[simp] theorem Err.mapAddresses_stuck (rename : Address → Address) + (message : String) : + Err.mapAddresses rename (.stuck message) = .stuck message := rfl + +@[simp] theorem Err.mapAddresses_mem (rename : Address → Address) + (message : String) : + Err.mapAddresses rename (.mem message) = .mem message := rfl + +@[simp] theorem Err.mapAddresses_unknownRef (rename : Address → Address) + (address : Address) : + Err.mapAddresses rename (.unknownRef address) = + .unknownRef (rename address) := rfl + +namespace Ctx + +/-- The target context is the forward image of the source context at every +address that the source evaluator can request. The oracle condition is +separate because extern declarations and direct `extern` operations both +consult it. -/ +structure Renames (rename : Address → Address) (before after : Ctx) : Prop where + decls : ∀ address, + after.decls (rename address) = + (before.decls address).map (Decl.mapAddresses rename) + oracle : ∀ address arguments, + after.oracle (rename address) arguments = before.oracle address arguments + +end Ctx + +@[simp] theorem declPapSafe_mapAddresses (rename : Address → Address) + (declaration : Decl) : + declPapSafe (Decl.mapAddresses rename declaration) = + declPapSafe declaration := by + cases declaration <;> rfl + +/-! ## Certified readdressing contexts -/ + +private theorem envOfList_some_mem + {entries : List (Address × Decl)} {address : Address} {declaration : Decl} + (hlookup : Env.ofList entries address = some declaration) : + (address, declaration) ∈ entries := by + unfold Env.ofList at hlookup + obtain ⟨entry, hfind, hvalue⟩ := Option.map_eq_some_iff.mp hlookup + rcases entry with ⟨entryAddress, entryDeclaration⟩ + have hbeq : entryAddress == address := + List.find?_some + (p := fun entry : Address × Decl => entry.1 == address) hfind + have haddress : entryAddress = address := Address.eq_of_beq hbeq + have hdeclaration : entryDeclaration = declaration := by + simpa using hvalue + subst entryAddress + subst entryDeclaration + exact List.mem_of_find?_eq_some hfind + +theorem Result.main_eq_mapAddresses {result : Result} + {raw : List (Address × Decl)} {main : Code} + (haudit : result.semanticAudit raw main = true) : + result.main = + Code.mapAddresses (Renaming.apply result.addressMap) main := by + simp only [Result.semanticAudit, Bool.and_eq_true] at haudit + exact (Code.structurallyEq_eq_true_iff _ _).mp haudit.1.1 + +theorem Result.lookup_eq_mapAddresses {result : Result} + {raw : List (Address × Decl)} {main : Code} + (haudit : result.semanticAudit raw main = true) + {address : Address} {declaration : Decl} + (hlookup : Env.ofList raw address = some declaration) : + Env.ofList result.declarations + (Renaming.apply result.addressMap address) = + some (Decl.mapAddresses + (Renaming.apply result.addressMap) declaration) := by + simp only [Result.semanticAudit, Bool.and_eq_true] at haudit + have hmember : (address, declaration) ∈ raw := + envOfList_some_mem hlookup + have hentry := (List.all_eq_true.mp haudit.1.2) + (address, declaration) hmember + cases hemitted : Env.ofList result.declarations + (Renaming.apply result.addressMap address) with + | none => simp [hlookup, hemitted] at hentry + | some emitted => + have hequal : emitted = + Decl.mapAddresses (Renaming.apply result.addressMap) declaration := + (Decl.structurallyEq_eq_true_iff _ _).mp (by + simpa [hlookup, hemitted] using hentry) + simp [hequal] + +theorem Result.lookup_stable {result : Result} + {raw : List (Address × Decl)} {main : Code} + (haudit : result.semanticAudit raw main = true) + {address : Address} {declaration : Decl} + (hlookup : Env.ofList result.declarations address = some declaration) : + Decl.mapAddresses (Renaming.apply result.addressMap) declaration = + declaration := by + simp only [Result.semanticAudit, Bool.and_eq_true] at haudit + have hmember : (address, declaration) ∈ result.declarations := + envOfList_some_mem hlookup + have hentry := (List.all_eq_true.mp haudit.2) + (address, declaration) hmember + exact (Decl.structurallyEq_eq_true_iff _ _).mp (by + simpa [hlookup] using hentry) + +/-- The theorem-facing source environment contains the raw declaration at +every successful raw lookup. At an otherwise-unbound address it supplies +the stable emitted lookup of the renamed key; these aliases are exactly what +makes the context relation total after new content keys are introduced. -/ +def Result.preAddressEnv (result : Result) + (raw : List (Address × Decl)) : Env := + fun address => + match Env.ofList raw address with + | some declaration => some declaration + | none => + Env.ofList result.declarations + (Renaming.apply result.addressMap address) + +/-- Evaluator context for the emitted, content-addressed artifact. -/ +def Result.addressedCtx (result : Result) + (oracle : Address → List RVal → Option RVal := fun _ _ => none) : Ctx := + { decls := Env.ofList result.declarations, oracle } + +/-- Pull the addressed oracle back along the same map used for declarations. +Raw lookups remain exact; stable aliases cover newly introduced target keys. -/ +def Result.preAddressCtx (result : Result) + (raw : List (Address × Decl)) + (oracle : Address → List RVal → Option RVal := fun _ _ => none) : Ctx := + { decls := result.preAddressEnv raw + oracle := fun address arguments => + oracle (Renaming.apply result.addressMap address) arguments } + +@[simp] theorem Result.preAddressCtx_decls_of_lookup + (result : Result) (raw : List (Address × Decl)) + (oracle : Address → List RVal → Option RVal) + {address : Address} {declaration : Decl} + (hlookup : Env.ofList raw address = some declaration) : + (result.preAddressCtx raw oracle).decls address = some declaration := by + simp [Result.preAddressCtx, Result.preAddressEnv, hlookup] + +/-- A successful semantic audit constructs the exact total context relation +consumed by evaluator equivariance. -/ +theorem Result.renames_preAddressCtx {result : Result} + {raw : List (Address × Decl)} {main : Code} + (haudit : result.semanticAudit raw main = true) + (oracle : Address → List RVal → Option RVal) : + Ctx.Renames (Renaming.apply result.addressMap) + (result.preAddressCtx raw oracle) (result.addressedCtx oracle) := by + constructor + · intro address + simp only [Result.preAddressCtx, Result.addressedCtx, + Result.preAddressEnv] + cases hraw : Env.ofList raw address with + | some declaration => + simpa [hraw] using result.lookup_eq_mapAddresses haudit hraw + | none => + simp only + cases hemitted : Env.ofList result.declarations + (Renaming.apply result.addressMap address) with + | none => simp + | some declaration => + have hstable := result.lookup_stable haudit hemitted + simp [hstable] + · intro address arguments + rfl + +/-! ## Structural evaluator-state laws -/ + +@[simp] theorem NodeBox.mapAddresses_world (rename : Address → Address) + (box : NodeBox) : + (NodeBox.mapAddresses rename box).world = box.world := rfl + +@[simp] theorem NodeBox.mapAddresses_rc (rename : Address → Address) + (box : NodeBox) : + (NodeBox.mapAddresses rename box).rc = box.rc := rfl + +@[simp] theorem NodeBox.mapAddresses_node (rename : Address → Address) + (box : NodeBox) : + (NodeBox.mapAddresses rename box).node = + Node.mapAddresses rename box.node := rfl + +@[simp] theorem Store.mapAddresses_allocs (rename : Address → Address) + (store : Store) : + (Store.mapAddresses rename store).allocs = store.allocs := rfl + +@[simp] theorem Store.mapAddresses_reuses (rename : Address → Address) + (store : Store) : + (Store.mapAddresses rename store).reuses = store.reuses := rfl + +@[simp] theorem Store.mapAddresses_frees (rename : Address → Address) + (store : Store) : + (Store.mapAddresses rename store).frees = store.frees := rfl + +@[simp] theorem Store.mapAddresses_rcops (rename : Address → Address) + (store : Store) : + (Store.mapAddresses rename store).rcops = store.rcops := rfl + +@[simp] theorem Store.mapAddresses_empty (rename : Address → Address) : + Store.mapAddresses rename ({} : Store) = {} := by + simp [Store.mapAddresses] + +@[simp] theorem Store.get?_mapAddresses (rename : Address → Address) + (store : Store) (location : Nat) : + (Store.mapAddresses rename store).get? location = + (store.get? location).map (NodeBox.mapAddresses rename) := by + simp only [Store.mapAddresses, Store.get?, Array.getElem?_map] + cases hcell : store.nodes[location]? with + | none => simp + | some cell => + cases cell <;> simp + +@[simp] theorem Store.mapAddresses_setBox (rename : Address → Address) + (store : Store) (location : Nat) (box : NodeBox) : + Store.mapAddresses rename (store.setBox location box) = + (Store.mapAddresses rename store).setBox location + (NodeBox.mapAddresses rename box) := by + simp [Store.mapAddresses, Store.setBox] + +@[simp] theorem Store.mapAddresses_kill (rename : Address → Address) + (store : Store) (location : Nat) : + Store.mapAddresses rename (store.kill location) = + (Store.mapAddresses rename store).kill location := by + simp [Store.mapAddresses, Store.kill] + +@[simp] theorem Store.mapAddresses_rcTick (rename : Address → Address) + (store : Store) : + Store.mapAddresses rename store.rcTick = + (Store.mapAddresses rename store).rcTick := by + simp [Store.mapAddresses, Store.rcTick] + +@[simp] theorem Store.mapAddresses_allocNode_fst + (rename : Address → Address) (store : Store) + (world : Ixon.Owned) (node : Node) : + Store.mapAddresses rename (store.allocNode world node).1 = + ((Store.mapAddresses rename store).allocNode world + (Node.mapAddresses rename node)).1 := by + simp [Store.mapAddresses, Store.allocNode, NodeBox.mapAddresses] + +@[simp] theorem Store.mapAddresses_allocNode_snd + (rename : Address → Address) (store : Store) + (world : Ixon.Owned) (node : Node) : + (store.allocNode world node).2 = + ((Store.mapAddresses rename store).allocNode world + (Node.mapAddresses rename node)).2 := by + simp [Store.mapAddresses, Store.allocNode] + +@[simp] theorem Store.mapAddresses_countReuse + (rename : Address → Address) (store : Store) : + Store.mapAddresses rename { store with reuses := store.reuses + 1 } = + { Store.mapAddresses rename store with + reuses := (Store.mapAddresses rename store).reuses + 1 } := by + simp [Store.mapAddresses] + +@[simp] theorem RVal.hasWorld_mapAddresses + (rename : Address → Address) (store : Store) + (world : Ixon.Owned) (value : RVal) : + value.hasWorld (Store.mapAddresses rename store) world = + value.hasWorld store world := by + cases value with + | loc location => + cases hbox : store.get? location <;> simp [RVal.hasWorld, hbox] + | lit literal => simp [RVal.hasWorld] + | erased => simp [RVal.hasWorld] + +theorem checkResultWorld_mapAddresses + (rename : Address → Address) (world : Ixon.Owned) + (out : Store × RVal) : + checkResultWorld world + (Store.mapAddresses rename out.1, out.2) = + mapRunResult rename (checkResultWorld world out) := by + rcases out with ⟨store, value⟩ + by_cases hworld : value.hasWorld store world + · simp [checkResultWorld, mapRunResult, hworld] + · simp [checkResultWorld, mapRunResult, Err.mapAddresses, hworld] + +theorem resolveAtom_mapValueResult (rename : Address → Address) + (environment : List RVal) (atom : Atom) : + mapValueResult rename (resolveAtom environment atom) = + resolveAtom environment atom := by + cases atom with + | var index => + cases hvalue : environment[index]? <;> + simp [resolveAtom, mapValueResult, Err.mapAddresses, hvalue] + | lit literal => simp [resolveAtom, mapValueResult] + | erased => simp [resolveAtom, mapValueResult] + +private theorem resolveAtomsList_mapValuesResult + (rename : Address → Address) (environment : List RVal) + (atoms : List Atom) (initial : List RVal) : + mapValuesResult rename + (atoms.foldlM (fun accumulated atom => do + pure (accumulated ++ [← resolveAtom environment atom])) initial) = + atoms.foldlM (fun accumulated atom => do + pure (accumulated ++ [← resolveAtom environment atom])) initial := by + induction atoms generalizing initial with + | nil => + change (Except.ok initial : Except Err (List RVal)) = .ok initial + rfl + | cons atom rest ih => + simp only [List.foldlM_cons] + cases hresolve : resolveAtom environment atom with + | ok value => + change mapValuesResult rename + (rest.foldlM (fun accumulated atom => do + pure (accumulated ++ [← resolveAtom environment atom])) + (initial ++ [value])) = + rest.foldlM (fun accumulated atom => do + pure (accumulated ++ [← resolveAtom environment atom])) + (initial ++ [value]) + exact ih (initial ++ [value]) + | error error => + have hmapped := resolveAtom_mapValueResult rename environment atom + simp [hresolve, mapValueResult] at hmapped + change Except.error (Err.mapAddresses rename error) = + Except.error error + rw [hmapped] + +theorem resolveAtoms_mapValuesResult (rename : Address → Address) + (environment : List RVal) (atoms : Array Atom) : + mapValuesResult rename (resolveAtoms environment atoms) = + resolveAtoms environment atoms := by + simp only [resolveAtoms, ← Array.foldlM_toList] + exact resolveAtomsList_mapValuesResult rename environment atoms.toList [] + +theorem Err.mapAddresses_of_resolveAtom_error + (rename : Address → Address) (environment : List RVal) (atom : Atom) + {error : Err} (herror : resolveAtom environment atom = .error error) : + Err.mapAddresses rename error = error := by + have hmapped := resolveAtom_mapValueResult rename environment atom + simpa [herror, mapValueResult] using hmapped + +theorem Err.mapAddresses_of_resolveAtoms_error + (rename : Address → Address) (environment : List RVal) + (atoms : Array Atom) {error : Err} + (herror : resolveAtoms environment atoms = .error error) : + Err.mapAddresses rename error = error := by + have hmapped := resolveAtoms_mapValuesResult rename environment atoms + simpa [herror, mapValuesResult] using hmapped + +@[simp] theorem Alt.cidx_mapAddresses (rename : Address → Address) + (alternative : Alt) : + (Alt.mapAddresses rename alternative).cidx = alternative.cidx := by + cases alternative <;> rfl + +private theorem AltList.find?_mapAddresses (rename : Address → Address) + (constructor : Nat) (alternatives : List Alt) : + (AltList.mapAddresses rename alternatives).find? + (fun alternative => alternative.cidx == constructor) = + (alternatives.find? + (fun alternative => alternative.cidx == constructor)).map + (Alt.mapAddresses rename) := by + induction alternatives with + | nil => rfl + | cons alternative rest ih => + cases alternative with + | mk cidx fields body => + simp only [AltList.mapAddresses, Alt.mapAddresses, Alt.cidx, + List.find?_cons] + by_cases hmatch : cidx == constructor + · simp only [hmatch, Option.map_some] + rfl + · simp only [hmatch] + exact ih + +theorem AltArray.find?_mapAddresses (rename : Address → Address) + (constructor : Nat) (alternatives : Array Alt) : + ((AltList.mapAddresses rename alternatives.toList).toArray.find? + (fun alternative => alternative.cidx == constructor)) = + (alternatives.find? + (fun alternative => alternative.cidx == constructor)).map + (Alt.mapAddresses rename) := by + simpa only [← Array.find?_toList, List.toList_toArray] using + AltList.find?_mapAddresses rename constructor alternatives.toList + +@[simp] theorem Decl.declArity_mapAddresses (rename : Address → Address) + (declaration : Decl) : + declArity (Decl.mapAddresses rename declaration) = + declArity declaration := by + cases declaration <;> rfl + +@[simp] theorem FnDef.mapAddresses_arity (rename : Address → Address) + (definition : FnDef) : + (FnDef.mapAddresses rename definition).arity = definition.arity := rfl + +@[simp] theorem FnDef.mapAddresses_result (rename : Address → Address) + (definition : FnDef) : + (FnDef.mapAddresses rename definition).result = definition.result := rfl + +@[simp] theorem FnDef.mapAddresses_body (rename : Address → Address) + (definition : FnDef) : + (FnDef.mapAddresses rename definition).body = + Code.mapAddresses rename definition.body := rfl + +/-- Reference-count duplication is insensitive to declaration addresses and +commutes with the heap action exactly. -/ +theorem dupVals_mapAddresses (rename : Address → Address) + (store : Store) (values : List RVal) : + dupVals (Store.mapAddresses rename store) values = + mapStoreResult rename (dupVals store values) := by + induction values generalizing store with + | nil => + change Except.ok (Store.mapAddresses rename store) = + mapStoreResult rename (Except.ok store) + rfl + | cons value rest ih => + cases value with + | lit literal => + change dupVals (Store.mapAddresses rename store) rest = + mapStoreResult rename (dupVals store rest) + exact ih store + | erased => + change dupVals (Store.mapAddresses rename store) rest = + mapStoreResult rename (dupVals store rest) + exact ih store + | loc location => + cases hbox : store.get? location with + | none => + simp only [dupVals, List.foldlM_cons, + Store.get?_mapAddresses, hbox, Option.map_none] + change Except.error + (.mem s!"dup of a dead location {location}") = + mapStoreResult rename + (Except.error (.mem s!"dup of a dead location {location}")) + rfl + | some box => + cases hworld : box.world with + | unique => + simp only [dupVals, List.foldlM_cons, + Store.get?_mapAddresses, hbox, Option.map_some, + NodeBox.mapAddresses_world, hworld] + change Except.error (.mem "dup of a unique node") = + mapStoreResult rename + (Except.error (.mem "dup of a unique node")) + rfl + | shared => + simp only [dupVals, List.foldlM_cons, + Store.get?_mapAddresses, hbox, Option.map_some, + NodeBox.mapAddresses_world, hworld] + let next := + (store.setBox location + { box with rc := box.rc + 1 }).rcTick + have hnext : + ((Store.mapAddresses rename store).setBox location + { world := .shared + rc := (NodeBox.mapAddresses rename box).rc + 1 + node := (NodeBox.mapAddresses rename box).node }).rcTick = + Store.mapAddresses rename next := by + simp [next, NodeBox.mapAddresses, hworld] + have hsourceNext : + (store.setBox location + { world := .shared + rc := box.rc + 1 + node := box.node }).rcTick = next := by + simp [next, hworld] + rw [hnext] + rw [hsourceNext] + change dupVals (Store.mapAddresses rename next) rest = + mapStoreResult rename (dupVals next rest) + exact ih next + +/-- The scalar-only oracle boundary commutes with a context renaming. -/ +theorem callScalarOracle_mapAddresses + {rename : Address → Address} {before after : Ctx} + (contexts : Ctx.Renames rename before after) + (function : Address) (arguments : List RVal) : + callScalarOracle after (rename function) arguments = + mapValueResult rename + (callScalarOracle before function arguments) := by + simp only [callScalarOracle, contexts.oracle function arguments] + split + · simp_all [mapValueResult, Err.mapAddresses] + · cases horacle : before.oracle function arguments with + | none => simp [mapValueResult, Err.mapAddresses] + | some value => + by_cases hvalue : value.isScalar + · simp [hvalue, mapValueResult] + · simp [hvalue, mapValueResult, Err.mapAddresses] + +/-! ## Fueled evaluator equivariance -/ + +/-- All mutually recursive evaluator entries commute with an address map at +one common fuel index. Packaging them together mirrors the evaluator's +termination argument and lets every successor case consume the complete +strictly-smaller hypothesis. -/ +structure EvalTransportAt (rename : Address → Address) + (before after : Ctx) (fuel : Nat) : Prop where + runCode : ∀ (current : FnDef) (store : Store) + (environment : List RVal) (code : Code), + runCode after fuel (FnDef.mapAddresses rename current) + (Store.mapAddresses rename store) environment + (Code.mapAddresses rename code) = + mapRunResult rename + (runCode before fuel current store environment code) + runOp : ∀ (current : FnDef) (store : Store) + (environment : List RVal) (operation : Op), + runOp after fuel (FnDef.mapAddresses rename current) + (Store.mapAddresses rename store) environment + (Op.mapAddresses rename operation) = + mapRunResult rename + (runOp before fuel current store environment operation) + invoke : ∀ (function : Address) (arguments : List RVal) (store : Store), + IxIR1.invoke after fuel (rename function) arguments + (Store.mapAddresses rename store) = + mapRunResult rename + (IxIR1.invoke before fuel function arguments store) + applyGo : ∀ (store : Store) (function : RVal) (arguments : List RVal), + IxIR1.applyGo after fuel (Store.mapAddresses rename store) + function arguments = + mapRunResult rename + (IxIR1.applyGo before fuel store function arguments) + dropVal : ∀ (store : Store) (value : RVal), + IxIR1.dropVal after fuel (Store.mapAddresses rename store) value = + mapStoreResult rename (IxIR1.dropVal before fuel store value) + dropMany : ∀ (store : Store) (values : List RVal), + IxIR1.dropMany after fuel (Store.mapAddresses rename store) values = + mapStoreResult rename (IxIR1.dropMany before fuel store values) + dropUVal : ∀ (store : Store) (value : RVal), + IxIR1.dropUVal after fuel (Store.mapAddresses rename store) value = + mapStoreResult rename (IxIR1.dropUVal before fuel store value) + dropManyU : ∀ (store : Store) (values : List RVal), + IxIR1.dropManyU after fuel (Store.mapAddresses rename store) values = + mapStoreResult rename (IxIR1.dropManyU before fuel store values) + +/-- Exact evaluator equivariance at every fuel. -/ +theorem evalTransportAt {rename : Address → Address} {before after : Ctx} + (contexts : Ctx.Renames rename before after) : + ∀ fuel, EvalTransportAt rename before after fuel := by + intro fuel + induction fuel with + | zero => + constructor <;> intros <;> + simp [runCode, runOp, IxIR1.invoke, IxIR1.applyGo, + IxIR1.dropVal, IxIR1.dropMany, IxIR1.dropUVal, + IxIR1.dropManyU, mapRunResult, mapStoreResult, + Err.mapAddresses] + | succ fuel smaller => + refine { + runCode := ?_ + runOp := ?_ + invoke := ?_ + applyGo := ?_ + dropVal := ?_ + dropMany := ?_ + dropUVal := ?_ + dropManyU := ?_ } + · intro current store environment code + cases code with + | ret atom => + simp only [runCode, Code.mapAddresses] + cases hresolve : resolveAtom environment atom with + | error error => + have hmapped := Err.mapAddresses_of_resolveAtom_error + rename environment atom hresolve + simp [mapRunResult, hmapped] + | ok value => simp [mapRunResult] + | letOp operation rest => + simp only [runCode, Code.mapAddresses] + rw [smaller.runOp current store environment operation] + cases hop : runOp before fuel current store environment operation with + | error error => + change Except.error (Err.mapAddresses rename error) = + mapRunResult rename (Except.error error) + rfl + | ok out => + rcases out with ⟨next, value⟩ + simp only [mapRunResult] + exact smaller.runCode current next (value :: environment) rest + | case scrutinee peelNat alternatives => + simp only [runCode, Code.mapAddresses] + cases hresolve : resolveAtom environment scrutinee with + | error error => + have hmapped := Err.mapAddresses_of_resolveAtom_error + rename environment scrutinee hresolve + simp [mapRunResult, hmapped] + | ok value => + cases value with + | erased => simp [mapRunResult, Err.mapAddresses] + | lit literal => + cases literal with + | str string => simp [mapRunResult, Err.mapAddresses] + | nat number => + cases peelNat with + | false => simp [mapRunResult, Err.mapAddresses] + | true => + cases number with + | zero => + simp only [except_ok_bind] + rw [AltArray.find?_mapAddresses rename 0 + alternatives] + cases halt : alternatives.find? + (fun alternative => + alternative.cidx == 0) with + | none => + simp [mapRunResult, + Err.mapAddresses] + | some alternative => + cases alternative with + | mk constructor fields body => + cases fields with + | zero => + simp only [Option.map_some, + Alt.mapAddresses] + exact smaller.runCode current store + environment body + | succ fields => + simp [Alt.mapAddresses, + mapRunResult, + Err.mapAddresses] + | succ predecessor => + simp only [except_ok_bind] + rw [AltArray.find?_mapAddresses rename 1 + alternatives] + cases halt : alternatives.find? + (fun alternative => + alternative.cidx == 1) with + | none => + simp [mapRunResult, + Err.mapAddresses] + | some alternative => + cases alternative with + | mk constructor fields body => + cases fields with + | zero => + simp [Alt.mapAddresses, + mapRunResult, + Err.mapAddresses] + | succ fields => + cases fields with + | zero => + simp only [Option.map_some, + Alt.mapAddresses] + exact smaller.runCode current + store + (.lit (.nat predecessor) :: + environment) + body + | succ fields => + simp [Alt.mapAddresses, + mapRunResult, + Err.mapAddresses] + | loc location => + simp only [except_ok_bind] + cases hbox : store.get? location with + | none => + simp [Store.get?_mapAddresses, hbox, mapRunResult, + Err.mapAddresses] + | some box => + simp only [Store.get?_mapAddresses, hbox, + Option.map_some, NodeBox.mapAddresses_node] + cases hnode : box.node with + | papN function arity arguments => + simp [Node.mapAddresses, mapRunResult, + Err.mapAddresses] + | ctorN constructor fields => + simp only [Node.mapAddresses, + CtorId.mapAddresses] + rw [AltArray.find?_mapAddresses rename + constructor.cidx alternatives] + cases halt : alternatives.find? + (fun alternative => + alternative.cidx == constructor.cidx) with + | none => + simp [mapRunResult, Err.mapAddresses] + | some alternative => + cases alternative with + | mk alternativeConstructor fieldCount body => + simp only [Option.map_some, + Alt.mapAddresses] + by_cases hsize : + fields.size != fieldCount + · simp [hsize, mapRunResult, + Err.mapAddresses] + · simp only [hsize] + exact smaller.runCode current store + (fields.foldl + (fun accumulated field => + field :: accumulated) + environment) + body + · intro current store environment operation + cases operation with + | pure atom => + simp only [runOp, Op.mapAddresses] + cases hresolve : resolveAtom environment atom with + | error error => + have hmapped := Err.mapAddresses_of_resolveAtom_error + rename environment atom hresolve + simp [mapRunResult, hmapped] + | ok value => simp [mapRunResult] + | alloc world constructor atoms => + simp only [runOp, Op.mapAddresses] + cases hresolve : resolveAtoms environment atoms with + | error error => + have hmapped := Err.mapAddresses_of_resolveAtoms_error + rename environment atoms hresolve + simp [mapRunResult, hmapped] + | ok values => + change Except.ok + (((Store.mapAddresses rename store).allocNode world + (.ctorN (CtorId.mapAddresses rename constructor) + values.toArray)).1, + RVal.loc + (((Store.mapAddresses rename store).allocNode world + (.ctorN (CtorId.mapAddresses rename constructor) + values.toArray)).2)) = + Except.ok + (Store.mapAddresses rename + ((store.allocNode world + (.ctorN constructor values.toArray)).1), + RVal.loc + ((store.allocNode world + (.ctorN constructor values.toArray)).2)) + simp [Store.mapAddresses_allocNode_fst, Node.mapAddresses] + exact + (Store.mapAddresses_allocNode_snd rename store world + (.ctorN constructor values.toArray)).symm + | reuse target constructor atoms => + simp only [runOp, Op.mapAddresses] + cases hatoms : resolveAtoms environment atoms with + | error error => + have hmapped := Err.mapAddresses_of_resolveAtoms_error + rename environment atoms hatoms + simp [mapRunResult, hmapped] + | ok values => + cases htarget : resolveAtom environment target with + | error error => + have hmapped := Err.mapAddresses_of_resolveAtom_error + rename environment target htarget + simp [mapRunResult, hmapped] + | ok value => + cases value with + | lit literal => + simp [mapRunResult, Err.mapAddresses] + | erased => + simp [mapRunResult, Err.mapAddresses] + | loc location => + cases hbox : store.get? location with + | none => + simp [Store.get?_mapAddresses, hbox, mapRunResult, + Err.mapAddresses] + | some box => + cases hworld : box.world with + | shared => + simp [Store.get?_mapAddresses, hbox, hworld, + mapRunResult, Err.mapAddresses] + | unique => + simp only [except_ok_bind, + Store.get?_mapAddresses, hbox, + Option.map_some, NodeBox.mapAddresses_world, + hworld] + change Except.ok + ({ ((Store.mapAddresses rename store).setBox + location + ⟨.unique, 1, + .ctorN + (CtorId.mapAddresses rename constructor) + values.toArray⟩) with + reuses := + ((Store.mapAddresses rename store).setBox + location + ⟨.unique, 1, + .ctorN + (CtorId.mapAddresses rename + constructor) + values.toArray⟩).reuses + 1 }, + RVal.loc location) = + Except.ok + (Store.mapAddresses rename + { (store.setBox location + ⟨.unique, 1, + .ctorN constructor values.toArray⟩) with + reuses := + (store.setBox location + ⟨.unique, 1, + .ctorN constructor + values.toArray⟩).reuses + 1 }, + RVal.loc location) + simp [NodeBox.mapAddresses, + Node.mapAddresses] + | free target => + simp only [runOp, Op.mapAddresses] + cases htarget : resolveAtom environment target with + | error error => + have hmapped := Err.mapAddresses_of_resolveAtom_error + rename environment target htarget + simp [mapRunResult, hmapped] + | ok value => + cases value with + | lit literal => simp [mapRunResult, Err.mapAddresses] + | erased => simp [mapRunResult, Err.mapAddresses] + | loc location => + cases hbox : store.get? location with + | none => + simp [Store.get?_mapAddresses, hbox, mapRunResult, + Err.mapAddresses] + | some box => + cases hworld : box.world with + | shared => + simp [Store.get?_mapAddresses, hbox, hworld, + mapRunResult, Err.mapAddresses] + | unique => + simp [Store.get?_mapAddresses, hbox, hworld, + mapRunResult] + | dup target => + simp only [runOp, Op.mapAddresses] + cases htarget : resolveAtom environment target with + | error error => + have hmapped := Err.mapAddresses_of_resolveAtom_error + rename environment target htarget + simp [mapRunResult, hmapped] + | ok value => + cases value with + | lit literal => simp [mapRunResult] + | erased => simp [mapRunResult] + | loc location => + cases hbox : store.get? location with + | none => + simp [Store.get?_mapAddresses, hbox, mapRunResult, + Err.mapAddresses] + | some box => + cases hworld : box.world with + | unique => + simp [Store.get?_mapAddresses, hbox, hworld, + mapRunResult, Err.mapAddresses] + | shared => + simp only [except_ok_bind, + Store.get?_mapAddresses, hbox, + Option.map_some, NodeBox.mapAddresses_world, + hworld] + simp [mapRunResult, NodeBox.mapAddresses, hworld] + | drop target => + simp only [runOp, Op.mapAddresses] + cases htarget : resolveAtom environment target with + | error error => + have hmapped := Err.mapAddresses_of_resolveAtom_error + rename environment target htarget + simp [mapRunResult, hmapped] + | ok value => + cases value with + | lit literal => simp [mapRunResult] + | erased => simp [mapRunResult] + | loc location => + simp only [except_ok_bind] + rw [smaller.dropVal store (.loc location)] + cases hdrop : IxIR1.dropVal before fuel store + (.loc location) with + | error error => + change Except.error (Err.mapAddresses rename error) = + mapRunResult rename (Except.error error) + rfl + | ok next => + change Except.ok + (Store.mapAddresses rename next, RVal.erased) = + mapRunResult rename + (Except.ok (next, RVal.erased)) + rfl + | dropU target => + simp only [runOp, Op.mapAddresses] + cases htarget : resolveAtom environment target with + | error error => + have hmapped := Err.mapAddresses_of_resolveAtom_error + rename environment target htarget + simp [mapRunResult, hmapped] + | ok value => + cases value with + | lit literal => simp [mapRunResult] + | erased => simp [mapRunResult] + | loc location => + simp only [except_ok_bind] + rw [smaller.dropUVal store (.loc location)] + cases hdrop : IxIR1.dropUVal before fuel store + (.loc location) with + | error error => + change Except.error (Err.mapAddresses rename error) = + mapRunResult rename (Except.error error) + rfl + | ok next => + change Except.ok + (Store.mapAddresses rename next, RVal.erased) = + mapRunResult rename + (Except.ok (next, RVal.erased)) + rfl + | fetch target field => + simp only [runOp, Op.mapAddresses] + cases htarget : resolveAtom environment target with + | error error => + have hmapped := Err.mapAddresses_of_resolveAtom_error + rename environment target htarget + simp [mapRunResult, hmapped] + | ok value => + cases value with + | lit literal => simp [mapRunResult, Err.mapAddresses] + | erased => simp [mapRunResult, Err.mapAddresses] + | loc location => + simp only [except_ok_bind] + cases hbox : store.get? location with + | none => + simp [Store.get?_mapAddresses, hbox, mapRunResult, + Err.mapAddresses] + | some box => + simp only [Store.get?_mapAddresses, hbox, + Option.map_some, NodeBox.mapAddresses_node] + cases hnode : box.node with + | papN function arity arguments => + simp [Node.mapAddresses, mapRunResult, + Err.mapAddresses] + | ctorN constructor fields => + simp only [Node.mapAddresses] + cases hfield : fields[field]? with + | none => + simp [mapRunResult, Err.mapAddresses] + | some value => simp [mapRunResult] + | call function atoms => + simp only [runOp, Op.mapAddresses] + cases hresolve : resolveAtoms environment atoms with + | error error => + have hmapped := Err.mapAddresses_of_resolveAtoms_error + rename environment atoms hresolve + simp [mapRunResult, hmapped] + | ok arguments => + exact smaller.invoke function arguments store + | callSelf atoms => + simp only [runOp, Op.mapAddresses, + FnDef.mapAddresses_arity, FnDef.mapAddresses_body, + FnDef.mapAddresses_result] + cases hresolve : resolveAtoms environment atoms with + | error error => + have hmapped := Err.mapAddresses_of_resolveAtoms_error + rename environment atoms hresolve + simp [mapRunResult, hmapped] + | ok arguments => + simp only [except_ok_bind] + by_cases harity : arguments.length != current.arity + · simp [harity, mapRunResult, Err.mapAddresses] + · simp only [harity] + rw [smaller.runCode current store arguments.reverse + current.body] + cases hrun : runCode before fuel current store + arguments.reverse current.body with + | error error => + change Except.error (Err.mapAddresses rename error) = + mapRunResult rename (Except.error error) + rfl + | ok out => + rcases out with ⟨resultStore, value⟩ + simp only [mapRunResult] + exact checkResultWorld_mapAddresses rename current.result + (resultStore, value) + | papp function atoms => + simp only [runOp, Op.mapAddresses] + cases hresolve : resolveAtoms environment atoms with + | error error => + have hmapped := Err.mapAddresses_of_resolveAtoms_error + rename environment atoms hresolve + simp [mapRunResult, hmapped] + | ok arguments => + simp only [contexts.decls function] + cases hdecl : before.decls function with + | none => + simp [mapRunResult, Err.mapAddresses] + | some declaration => + simp only [Option.map_some, + Decl.declArity_mapAddresses] + by_cases hless : arguments.length < declArity declaration + · simp only [except_ok_bind, hless] + change Except.ok + (((Store.mapAddresses rename store).allocNode .shared + (.papN (rename function) + (declArity declaration) arguments.toArray)).1, + RVal.loc + (((Store.mapAddresses rename store).allocNode + .shared (.papN (rename function) + (declArity declaration) + arguments.toArray)).2)) = + Except.ok + (Store.mapAddresses rename + ((store.allocNode .shared + (.papN function (declArity declaration) + arguments.toArray)).1), + RVal.loc + ((store.allocNode .shared + (.papN function (declArity declaration) + arguments.toArray)).2)) + simp [Store.mapAddresses_allocNode_fst, + Node.mapAddresses] + exact + (Store.mapAddresses_allocNode_snd rename store .shared + (.papN function (declArity declaration) + arguments.toArray)).symm + · simp [hless, mapRunResult, Err.mapAddresses] + | apply function atoms => + simp only [runOp, Op.mapAddresses] + cases hfunction : resolveAtom environment function with + | error error => + have hmapped := Err.mapAddresses_of_resolveAtom_error + rename environment function hfunction + simp [mapRunResult, hmapped] + | ok value => + cases harguments : resolveAtoms environment atoms with + | error error => + have hmapped := Err.mapAddresses_of_resolveAtoms_error + rename environment atoms harguments + simp [mapRunResult, hmapped] + | ok arguments => + simp only [except_ok_bind] + exact smaller.applyGo store value arguments + | extern function atoms => + simp only [runOp, Op.mapAddresses] + cases hresolve : resolveAtoms environment atoms with + | error error => + have hmapped := Err.mapAddresses_of_resolveAtoms_error + rename environment atoms hresolve + simp [mapRunResult, hmapped] + | ok arguments => + simp only [except_ok_bind] + rw [callScalarOracle_mapAddresses contexts] + cases horacle : callScalarOracle before function arguments with + | error error => + change Except.error (Err.mapAddresses rename error) = + mapRunResult rename (Except.error error) + rfl + | ok value => + change Except.ok + (Store.mapAddresses rename store, value) = + mapRunResult rename (Except.ok (store, value)) + rfl + · intro function arguments store + simp only [IxIR1.invoke, contexts.decls function] + cases hdecl : before.decls function with + | none => + simp [mapRunResult, Err.mapAddresses] + | some declaration => + cases declaration with + | extern arity => + simp only [Option.map_some, Decl.mapAddresses] + by_cases harity : arguments.length != arity + · simp [harity, mapRunResult, Err.mapAddresses] + · simp only [harity] + rw [callScalarOracle_mapAddresses contexts] + cases horacle : callScalarOracle before function arguments with + | error error => + simp [mapValueResult, mapRunResult] + | ok value => + simp [mapValueResult, mapRunResult] + | fn definition => + simp only [Option.map_some, Decl.mapAddresses] + simp only [FnDef.mapAddresses_arity, + FnDef.mapAddresses_body, FnDef.mapAddresses_result] + by_cases harity : arguments.length != definition.arity + · simp [harity, mapRunResult, Err.mapAddresses] + · simp only [harity] + rw [smaller.runCode definition store arguments.reverse + definition.body] + cases hrun : runCode before fuel definition store + arguments.reverse definition.body with + | error error => + change Except.error (Err.mapAddresses rename error) = + mapRunResult rename (Except.error error) + rfl + | ok out => + rcases out with ⟨resultStore, value⟩ + simp only [mapRunResult] + exact checkResultWorld_mapAddresses rename + definition.result (resultStore, value) + · intro store function arguments + cases function with + | lit literal => + simp [IxIR1.applyGo, mapRunResult, Err.mapAddresses] + | erased => + simp only [IxIR1.applyGo] + rw [smaller.dropMany store arguments] + cases hdrop : IxIR1.dropMany before fuel store arguments with + | error error => + change Except.error (Err.mapAddresses rename error) = + mapRunResult rename (Except.error error) + rfl + | ok next => + change Except.ok (Store.mapAddresses rename next, RVal.erased) = + mapRunResult rename (Except.ok (next, RVal.erased)) + rfl + | loc location => + simp only [IxIR1.applyGo, Store.get?_mapAddresses] + cases hbox : store.get? location with + | none => + simp [mapRunResult, Err.mapAddresses] + | some box => + simp only [Option.map_some, + NodeBox.mapAddresses_node] + cases hnode : box.node with + | ctorN constructor fields => + simp [Node.mapAddresses, mapRunResult, + Err.mapAddresses] + | papN called arity captured => + simp only [Node.mapAddresses] + rw [dupVals_mapAddresses rename store captured.toList] + cases hdup : dupVals store captured.toList with + | error error => + change Except.error (Err.mapAddresses rename error) = + mapRunResult rename (Except.error error) + rfl + | ok duplicated => + simp only [mapStoreResult] + change (do + let dropped ← IxIR1.dropVal after fuel + (Store.mapAddresses rename duplicated) + (.loc location) + let total := captured.toList ++ arguments + if total.length < arity then + let (next, fresh) := dropped.allocNode .shared + (.papN (rename called) arity total.toArray) + .ok (next, .loc fresh) + else if total.length == arity then + match after.decls (rename called) with + | none => .error (.unknownRef (rename called)) + | some declaration => + if declPapSafe declaration then + IxIR1.invoke after fuel (rename called) + total dropped + else .error (.stuck + "shared pap targets a non-pap-safe declaration") + else + match after.decls (rename called) with + | none => .error (.unknownRef (rename called)) + | some declaration => + if declPapSafe declaration then do + let (next, value) ← IxIR1.invoke after fuel + (rename called) (total.take arity) dropped + IxIR1.applyGo after fuel next value + (total.drop arity) + else .error (.stuck + "shared pap targets a non-pap-safe declaration")) = + mapRunResult rename (do + let dropped ← IxIR1.dropVal before fuel duplicated + (.loc location) + let total := captured.toList ++ arguments + if total.length < arity then + let (next, fresh) := dropped.allocNode .shared + (.papN called arity total.toArray) + .ok (next, .loc fresh) + else if total.length == arity then + match before.decls called with + | none => .error (.unknownRef called) + | some declaration => + if declPapSafe declaration then + IxIR1.invoke before fuel called total dropped + else .error (.stuck + "shared pap targets a non-pap-safe declaration") + else + match before.decls called with + | none => .error (.unknownRef called) + | some declaration => + if declPapSafe declaration then do + let (next, value) ← IxIR1.invoke before fuel + called (total.take arity) dropped + IxIR1.applyGo before fuel next value + (total.drop arity) + else .error (.stuck + "shared pap targets a non-pap-safe declaration")) + rw [smaller.dropVal duplicated (.loc location)] + cases hdrop : IxIR1.dropVal before fuel duplicated + (.loc location) with + | error error => + change Except.error + (Err.mapAddresses rename error) = + mapRunResult rename (Except.error error) + rfl + | ok dropped => + simp only [mapStoreResult] + let total := captured.toList ++ arguments + change (if total.length < arity then + let (next, fresh) := + (Store.mapAddresses rename dropped).allocNode + .shared + (.papN (rename called) arity total.toArray) + .ok (next, .loc fresh) + else if total.length == arity then + match after.decls (rename called) with + | none => .error (.unknownRef (rename called)) + | some declaration => + if declPapSafe declaration then + IxIR1.invoke after fuel (rename called) + total (Store.mapAddresses rename dropped) + else .error (.stuck + "shared pap targets a non-pap-safe declaration") + else + match after.decls (rename called) with + | none => .error (.unknownRef (rename called)) + | some declaration => + if declPapSafe declaration then do + let (next, value) ← IxIR1.invoke after fuel + (rename called) (total.take arity) + (Store.mapAddresses rename dropped) + IxIR1.applyGo after fuel next value + (total.drop arity) + else .error (.stuck + "shared pap targets a non-pap-safe declaration")) = + mapRunResult rename + (if total.length < arity then + let (next, fresh) := dropped.allocNode .shared + (.papN called arity total.toArray) + .ok (next, .loc fresh) + else if total.length == arity then + match before.decls called with + | none => .error (.unknownRef called) + | some declaration => + if declPapSafe declaration then + IxIR1.invoke before fuel called total dropped + else .error (.stuck + "shared pap targets a non-pap-safe declaration") + else + match before.decls called with + | none => .error (.unknownRef called) + | some declaration => + if declPapSafe declaration then do + let (next, value) ← IxIR1.invoke before fuel + called (total.take arity) dropped + IxIR1.applyGo before fuel next value + (total.drop arity) + else .error (.stuck + "shared pap targets a non-pap-safe declaration")) + by_cases hless : total.length < arity + · simp only [hless] + change Except.ok + (((Store.mapAddresses rename dropped).allocNode + .shared (.papN (rename called) arity + total.toArray)).1, + RVal.loc + (((Store.mapAddresses rename dropped).allocNode + .shared (.papN (rename called) arity + total.toArray)).2)) = + Except.ok + (Store.mapAddresses rename + ((dropped.allocNode .shared + (.papN called arity total.toArray)).1), + RVal.loc + ((dropped.allocNode .shared + (.papN called arity total.toArray)).2)) + simp [Store.mapAddresses_allocNode_fst, + Node.mapAddresses] + exact + (Store.mapAddresses_allocNode_snd rename dropped + .shared + (.papN called arity total.toArray)).symm + · simp only [hless] + rw [contexts.decls called] + cases hdecl : before.decls called with + | none => + simp [hdecl, mapRunResult, Err.mapAddresses] + | some declaration => + simp only [hdecl, Option.map_some, + declPapSafe_mapAddresses] + cases hpapsafe : declPapSafe declaration with + | false => + simp [hpapsafe, mapRunResult, + Err.mapAddresses] + | true => + simp only [hpapsafe, if_true] + by_cases hequal : total.length == arity + · simp only [hequal] + exact smaller.invoke called total dropped + · simp only [hequal] + rw [smaller.invoke called (total.take arity) + dropped] + cases hinvoke : IxIR1.invoke before fuel + called (total.take arity) dropped with + | error error => + change Except.error + (Err.mapAddresses rename error) = + mapRunResult rename + (Except.error error) + rfl + | ok out => + rcases out with ⟨calledStore, value⟩ + simp only [mapRunResult] + exact smaller.applyGo calledStore value + (total.drop arity) + · intro store value + cases value with + | lit literal => simp [IxIR1.dropVal, mapStoreResult] + | erased => simp [IxIR1.dropVal, mapStoreResult] + | loc location => + simp only [IxIR1.dropVal, Store.get?_mapAddresses] + cases hbox : store.get? location with + | none => + simp [mapStoreResult, Err.mapAddresses] + | some box => + simp only [Option.map_some, + NodeBox.mapAddresses_world] + cases hworld : box.world with + | unique => + simp [mapStoreResult, Err.mapAddresses] + | shared => + simp only + by_cases hone : box.rc == 1 + · simp only [hone, ↓reduceIte, + NodeBox.mapAddresses_rc] + cases hnode : box.node with + | ctorN constructor fields => + simp only [hnode, NodeBox.mapAddresses_node, + Node.mapAddresses] + simpa only [Store.mapAddresses_rcTick, + Store.mapAddresses_kill] using + smaller.dropMany (store.rcTick.kill location) + fields.toList + | papN function arity arguments => + simp only [hnode, NodeBox.mapAddresses_node, + Node.mapAddresses] + simpa only [Store.mapAddresses_rcTick, + Store.mapAddresses_kill] using + smaller.dropMany (store.rcTick.kill location) + arguments.toList + · simp only [hone, NodeBox.mapAddresses_rc] + simp [Bool.false_eq_true, mapStoreResult, + NodeBox.mapAddresses] + · intro store values + cases values with + | nil => simp [IxIR1.dropMany, mapStoreResult] + | cons value rest => + simp only [IxIR1.dropMany] + rw [smaller.dropVal store value] + cases hdrop : IxIR1.dropVal before fuel store value with + | error error => + change Except.error (Err.mapAddresses rename error) = + mapStoreResult rename (Except.error error) + rfl + | ok next => + simp only [mapStoreResult] + exact smaller.dropMany next rest + · intro store value + cases value with + | lit literal => simp [IxIR1.dropUVal, mapStoreResult] + | erased => simp [IxIR1.dropUVal, mapStoreResult] + | loc location => + simp only [IxIR1.dropUVal, Store.get?_mapAddresses] + cases hbox : store.get? location with + | none => + simp [mapStoreResult, Err.mapAddresses] + | some box => + simp only [Option.map_some, + NodeBox.mapAddresses_world] + cases hworld : box.world with + | shared => + simp [mapStoreResult, Err.mapAddresses] + | unique => + simp only + cases hnode : box.node with + | ctorN constructor fields => + simp only [hnode, NodeBox.mapAddresses_node, + Node.mapAddresses] + simpa only [Store.mapAddresses_kill] using + smaller.dropManyU (store.kill location) + fields.toList + | papN function arity arguments => + simp [hnode, NodeBox.mapAddresses_node, + Node.mapAddresses, mapStoreResult, + Err.mapAddresses] + · intro store values + cases values with + | nil => simp [IxIR1.dropManyU, mapStoreResult] + | cons value rest => + simp only [IxIR1.dropManyU] + rw [smaller.dropUVal store value] + cases hdrop : IxIR1.dropUVal before fuel store value with + | error error => + change Except.error (Err.mapAddresses rename error) = + mapStoreResult rename (Except.error error) + rfl + | ok next => + simp only [mapStoreResult] + exact smaller.dropManyU next rest + +/-! ## Public evaluator transport interface -/ + +/-- Code evaluation is equivariant under every context-compatible address +renaming. This exposes the bundled mutual-induction result without requiring +clients to mention `EvalTransportAt`. -/ +theorem runCode_mapAddresses {rename : Address → Address} + {before after : Ctx} (contexts : Ctx.Renames rename before after) + (fuel : Nat) (current : FnDef) (store : Store) + (environment : List RVal) (code : Code) : + runCode after fuel (FnDef.mapAddresses rename current) + (Store.mapAddresses rename store) environment + (Code.mapAddresses rename code) = + mapRunResult rename + (runCode before fuel current store environment code) := + (evalTransportAt contexts fuel).runCode current store environment code + +/-- Single-operation evaluation is equivariant under every compatible +address renaming. -/ +theorem runOp_mapAddresses {rename : Address → Address} + {before after : Ctx} (contexts : Ctx.Renames rename before after) + (fuel : Nat) (current : FnDef) (store : Store) + (environment : List RVal) (operation : Op) : + runOp after fuel (FnDef.mapAddresses rename current) + (Store.mapAddresses rename store) environment + (Op.mapAddresses rename operation) = + mapRunResult rename + (runOp before fuel current store environment operation) := + (evalTransportAt contexts fuel).runOp current store environment operation + +/-- Known-function invocation is equivariant under a compatible address +renaming. -/ +theorem invoke_mapAddresses {rename : Address → Address} + {before after : Ctx} (contexts : Ctx.Renames rename before after) + (fuel : Nat) (function : Address) (arguments : List RVal) + (store : Store) : + IxIR1.invoke after fuel (rename function) arguments + (Store.mapAddresses rename store) = + mapRunResult rename + (IxIR1.invoke before fuel function arguments store) := + (evalTransportAt contexts fuel).invoke function arguments store + +/-- Dynamic application is equivariant under every context-compatible +address renaming. Runtime values themselves need no mapping: declaration +identities occur only in the context and in heap-resident PAP nodes. -/ +theorem applyGo_mapAddresses {rename : Address → Address} + {before after : Ctx} (contexts : Ctx.Renames rename before after) + (fuel : Nat) (store : Store) (function : RVal) + (arguments : List RVal) : + IxIR1.applyGo after fuel (Store.mapAddresses rename store) + function arguments = + mapRunResult rename + (IxIR1.applyGo before fuel store function arguments) := + (evalTransportAt contexts fuel).applyGo store function arguments + +/-- Successful reference-count duplication on a renamed heap reflects to the +original heap and preserves an exact heap preimage. -/ +theorem dupVals_success_preimage {rename : Address → Address} + {store store' : Store} {values : List RVal} + (run : dupVals (Store.mapAddresses rename store) values = .ok store') : + ∃ sourceStore', + dupVals store values = .ok sourceStore' ∧ + store' = Store.mapAddresses rename sourceStore' := by + rw [dupVals_mapAddresses] at run + cases sourceRun : dupVals store values with + | error error => simp [sourceRun, mapStoreResult] at run + | ok sourceStore' => + simp only [sourceRun, mapStoreResult, Except.ok.injEq] at run + exact ⟨sourceStore', rfl, run.symm⟩ + +/-- Successful shared destruction on a renamed heap reflects to the original +context and preserves an exact heap preimage. -/ +theorem dropVal_success_preimage {rename : Address → Address} + {before after : Ctx} (contexts : Ctx.Renames rename before after) + {fuel : Nat} {store store' : Store} {value : RVal} + (run : IxIR1.dropVal after fuel (Store.mapAddresses rename store) value = + .ok store') : + ∃ sourceStore', + IxIR1.dropVal before fuel store value = .ok sourceStore' ∧ + store' = Store.mapAddresses rename sourceStore' := by + rw [(evalTransportAt contexts fuel).dropVal] at run + cases sourceRun : IxIR1.dropVal before fuel store value with + | error error => simp [sourceRun, mapStoreResult] at run + | ok sourceStore' => + simp only [sourceRun, mapStoreResult, Except.ok.injEq] at run + exact ⟨sourceStore', rfl, run.symm⟩ + +/-- Successful destruction of a list of shared values on a renamed heap +reflects to the original context and preserves an exact heap preimage. -/ +theorem dropMany_success_preimage {rename : Address → Address} + {before after : Ctx} (contexts : Ctx.Renames rename before after) + {fuel : Nat} {store store' : Store} {values : List RVal} + (run : IxIR1.dropMany after fuel (Store.mapAddresses rename store) values = + .ok store') : + ∃ sourceStore', + IxIR1.dropMany before fuel store values = .ok sourceStore' ∧ + store' = Store.mapAddresses rename sourceStore' := by + rw [(evalTransportAt contexts fuel).dropMany] at run + cases sourceRun : IxIR1.dropMany before fuel store values with + | error error => simp [sourceRun, mapStoreResult] at run + | ok sourceStore' => + simp only [sourceRun, mapStoreResult, Except.ok.injEq] at run + exact ⟨sourceStore', rfl, run.symm⟩ + +/-- A successful dynamic application on a renamed heap comes from a +successful application on the original heap. No injectivity or surjectivity +of the address map is needed because the input heap is already an exact image +and mapped errors cannot become successes. -/ +theorem applyGo_success_preimage {rename : Address → Address} + {before after : Ctx} (contexts : Ctx.Renames rename before after) + {fuel : Nat} {store store' : Store} {function : RVal} + {arguments : List RVal} {value : RVal} + (run : IxIR1.applyGo after fuel (Store.mapAddresses rename store) + function arguments = .ok (store', value)) : + ∃ sourceStore', + IxIR1.applyGo before fuel store function arguments = + .ok (sourceStore', value) ∧ + store' = Store.mapAddresses rename sourceStore' := by + rw [applyGo_mapAddresses contexts] at run + cases sourceRun : IxIR1.applyGo before fuel store function arguments with + | error error => simp [sourceRun, mapRunResult] at run + | ok output => + obtain ⟨sourceStore', sourceValue⟩ := output + simp only [sourceRun, mapRunResult, Except.ok.injEq, + Prod.mk.injEq] at run + obtain ⟨storeEq, valueEq⟩ := run + subst sourceValue + exact ⟨sourceStore', rfl, storeEq.symm⟩ + +/-- Successful renamed code execution reflects to a successful source run +with the same runtime value and a heap preimage. -/ +theorem runCode_success_preimage {rename : Address → Address} + {before after : Ctx} (contexts : Ctx.Renames rename before after) + {fuel : Nat} {current : FnDef} {store store' : Store} + {environment : List RVal} {code : Code} {value : RVal} + (run : runCode after fuel (FnDef.mapAddresses rename current) + (Store.mapAddresses rename store) environment + (Code.mapAddresses rename code) = .ok (store', value)) : + ∃ sourceStore', + runCode before fuel current store environment code = + .ok (sourceStore', value) ∧ + store' = Store.mapAddresses rename sourceStore' := by + rw [runCode_mapAddresses contexts] at run + cases sourceRun : runCode before fuel current store environment code with + | error error => simp [sourceRun, mapRunResult] at run + | ok output => + obtain ⟨sourceStore', sourceValue⟩ := output + simp only [sourceRun, mapRunResult, Except.ok.injEq, + Prod.mk.injEq] at run + obtain ⟨storeEq, valueEq⟩ := run + subst sourceValue + exact ⟨sourceStore', rfl, storeEq.symm⟩ + +/-- Successful renamed operation execution reflects to a successful source +operation and a heap preimage. -/ +theorem runOp_success_preimage {rename : Address → Address} + {before after : Ctx} (contexts : Ctx.Renames rename before after) + {fuel : Nat} {current : FnDef} {store store' : Store} + {environment : List RVal} {operation : Op} {value : RVal} + (run : runOp after fuel (FnDef.mapAddresses rename current) + (Store.mapAddresses rename store) environment + (Op.mapAddresses rename operation) = .ok (store', value)) : + ∃ sourceStore', + runOp before fuel current store environment operation = + .ok (sourceStore', value) ∧ + store' = Store.mapAddresses rename sourceStore' := by + rw [runOp_mapAddresses contexts] at run + cases sourceRun : runOp before fuel current store environment operation with + | error error => simp [sourceRun, mapRunResult] at run + | ok output => + obtain ⟨sourceStore', sourceValue⟩ := output + simp only [sourceRun, mapRunResult, Except.ok.injEq, + Prod.mk.injEq] at run + obtain ⟨storeEq, valueEq⟩ := run + subst sourceValue + exact ⟨sourceStore', rfl, storeEq.symm⟩ + +/-- Successful invocation of a renamed declaration reflects to the original +declaration and produces a heap preimage. -/ +theorem invoke_success_preimage {rename : Address → Address} + {before after : Ctx} (contexts : Ctx.Renames rename before after) + {fuel : Nat} {function : Address} {arguments : List RVal} + {store store' : Store} {value : RVal} + (run : IxIR1.invoke after fuel (rename function) arguments + (Store.mapAddresses rename store) = .ok (store', value)) : + ∃ sourceStore', + IxIR1.invoke before fuel function arguments store = + .ok (sourceStore', value) ∧ + store' = Store.mapAddresses rename sourceStore' := by + rw [invoke_mapAddresses contexts] at run + cases sourceRun : IxIR1.invoke before fuel function arguments store with + | error error => simp [sourceRun, mapRunResult] at run + | ok output => + obtain ⟨sourceStore', sourceValue⟩ := output + simp only [sourceRun, mapRunResult, Except.ok.injEq, + Prod.mk.injEq] at run + obtain ⟨storeEq, valueEq⟩ := run + subst sourceValue + exact ⟨sourceStore', rfl, storeEq.symm⟩ + +/-- A fresh-store top-level run has exactly the renamed result, including +renamed errors and address-bearing heap nodes. -/ +theorem runMain_mapAddresses {rename : Address → Address} + {before after : Ctx} (contexts : Ctx.Renames rename before after) + (code : Code) (fuel : Nat := 100000) : + runMain after (Code.mapAddresses rename code) fuel = + mapRunResult rename (runMain before code fuel) := by + simpa [runMain, FnDef.mapAddresses] using + (runCode_mapAddresses contexts fuel + (⟨0, .shared, false, code⟩ : FnDef) ({} : Store) [] code) + +/-- The concrete content-addressing pass preserves a top-level run exactly. +The source side uses the certified pre-address context: it agrees with every +raw lookup and adds only stable aliases for newly introduced content keys. -/ +theorem runMain_of_run_eq_ok + {source generated : List (Address × Decl)} {main : Code} + {result : Result} + (hrun : Readdress.run source generated main = .ok result) + (oracle : Address → List RVal → Option RVal := fun _ _ => none) + (fuel : Nat := 100000) : + runMain (result.addressedCtx oracle) result.main fuel = + mapRunResult (Renaming.apply result.addressMap) + (runMain (result.preAddressCtx (source ++ generated) oracle) + main fuel) := by + have haudit := semanticAudit_of_run_eq_ok hrun + rw [result.main_eq_mapAddresses haudit] + exact runMain_mapAddresses + (result.renames_preAddressCtx haudit oracle) main fuel + +/-- Successful raw execution therefore produces the same runtime value, +the address-renamed heap, and identical instruction-level cost counters. -/ +theorem runMain_success_of_run_eq_ok + {source generated : List (Address × Decl)} {main : Code} + {result : Result} + (hrun : Readdress.run source generated main = .ok result) + (oracle : Address → List RVal → Option RVal) + {fuel : Nat} {store : Store} {value : RVal} + (hsource : + runMain (result.preAddressCtx (source ++ generated) oracle) main fuel = + .ok (store, value)) : + runMain (result.addressedCtx oracle) result.main fuel = + .ok (Store.mapAddresses (Renaming.apply result.addressMap) store, + value) := by + rw [runMain_of_run_eq_ok hrun oracle fuel, hsource] + rfl + +end Readdress + +end Ix.Compiler.IxIR1 diff --git a/Ix/Compiler/IxIR1/Reclamation.lean b/Ix/Compiler/IxIR1/Reclamation.lean new file mode 100644 index 000000000..cfc7b785c --- /dev/null +++ b/Ix/Compiler/IxIR1/Reclamation.lean @@ -0,0 +1,2500 @@ +import Ix.Compiler.IxIR1.Progress + +/-! +# IxIR₁ reclamation + +`Sim.RootOwnership` deliberately records exact external and internal owner +counts without imposing a heap topology. That is the right interface for +semantic simulation, but by itself it admits an unreachable cycle (and even +an isolated shared node with reference count zero). + +The executable lowerer currently allocates by appending and emits no in-place +`reuse`. Its runtime heaps therefore satisfy the separate history invariant +below: every live reference count is positive and every owning edge points +from a newer allocation to an older one. Exact ownership plus this finite +allocation order is enough to rule out every live node once the root list is +empty. +-/ + +namespace Ix.Compiler.IxIR1.Reclamation + +open Ix.Compiler.IxIR1 +open Ix.Compiler.IxIR1.Sim + +private theorem bindOk {error α β : Type} (value : α) + (next : α → Except error β) : + (Except.ok value >>= next) = next value := rfl + +private theorem bindErr {error α β : Type} (err : error) + (next : α → Except error β) : + ((Except.error err : Except error α) >>= next) = .error err := rfl + +/-- The trace-level heap fact maintained by append-only IxIR₁ execution. + +It is intentionally separate from `RootOwnership`: ownership proofs remain +insensitive to allocation history and `HeapIso`, while reclamation uses the +concrete append order of the current no-reuse lowerer. -/ +structure AllocationOrderInvariant (store : Store) : Prop where + rc_pos : ∀ {loc box}, store.get? loc = some box → 0 < box.rc + child_lt : ∀ {parent box childLoc}, + store.get? parent = some box → + RVal.loc childLoc ∈ nodeChildren box.node → + childLoc < parent + +/-- Every live partial-application node is genuinely partial: its stored +capture is strictly shorter than the arity at which it dispatches. The +source evaluator establishes this at both PAP allocation sites, but its +unchecked heap type cannot express the fact directly. -/ +structure PAPsUnder (store : Store) : Prop where + captured_lt : ∀ {location world rc address arity captured}, + store.get? location = + some ⟨world, rc, .papN address arity captured⟩ → + captured.size < arity + +namespace PAPsUnder + +/-- The empty heap contains no malformed PAP. -/ +theorem empty : PAPsUnder ({} : Store) := by + constructor + intro location world rc address arity captured found + simp [Store.get?] at found + +/-- Removing live nodes or changing only their reference counts preserves +PAP under-saturation. -/ +theorem ofRestricts {before after : Store} (h : PAPsUnder before) + (restricts : StoreGraphRestricts before after) : PAPsUnder after := by + constructor + intro location world rc address arity captured found + obtain ⟨beforeRc, beforeFound⟩ := restricts found + exact h.captured_lt beforeFound + +/-- A shared retain changes only the selected reference count. -/ +theorem incRcStore {store : Store} {location rc : Nat} {node : Node} + (h : PAPsUnder store) + (found : store.get? location = some ⟨.shared, rc, node⟩) : + PAPsUnder (Sim.incRcStore store location ⟨.shared, rc, node⟩) := + h.ofRestricts (StoreGraphRestricts.incRcStore found) + +/-- Killing a live slot cannot expose a malformed PAP. -/ +theorem kill {store : Store} {location : Nat} {box : NodeBox} + (h : PAPsUnder store) (found : store.get? location = some box) : + PAPsUnder (store.kill location) := + h.ofRestricts (StoreGraphRestricts.kill found) + +/-- Retaining a vector of shared values cannot change PAP payloads. -/ +theorem dupVals {store store' : Store} {values : List RVal} + (h : PAPsUnder store) (run : dupVals store values = .ok store') : + PAPsUnder store' := by + induction values generalizing store with + | nil => + change (.ok store : Except Err Store) = .ok store' at run + injection run with storeEq + subst store' + exact h + | cons head tail ih => + cases head with + | lit literal => + simp only [Ix.Compiler.IxIR1.dupVals, List.foldlM_cons] at run + exact ih h run + | erased => + simp only [Ix.Compiler.IxIR1.dupVals, List.foldlM_cons] at run + exact ih h run + | loc location => + simp only [Ix.Compiler.IxIR1.dupVals, List.foldlM_cons] at run + cases found : store.get? location with + | none => simp [found, bindErr] at run + | some box => + cases box with + | mk world rc node => + cases world with + | unique => simp [found, bindErr] at run + | shared => + simp only [found] at run + exact ih (h.incRcStore found) run + +/-- Appending a constructor preserves all existing PAP payloads. -/ +theorem allocCtor {store : Store} (h : PAPsUnder store) + (world : Ixon.Owned) (cid : CtorId) (fields : Array RVal) : + PAPsUnder (store.allocNode world (.ctorN cid fields)).1 := by + constructor + intro location boxWorld rc address arity captured found + by_cases fresh : location = store.nodes.size + · subst location + have allocated := HeapIso.get?_allocNode_new store world + (.ctorN cid fields) + have impossible : + (⟨boxWorld, rc, .papN address arity captured⟩ : NodeBox) = + ⟨world, 1, .ctorN cid fields⟩ := + Option.some.inj (found.symm.trans allocated) + cases impossible + · exact h.captured_lt (HeapIso.get?_of_allocNode_old fresh found) + +/-- Appending a checked under-saturated PAP preserves the global property. -/ +theorem allocPap {store : Store} (h : PAPsUnder store) + (world : Ixon.Owned) (address : Ixon.Address) (arity : Nat) + (captured : Array RVal) (under : captured.size < arity) : + PAPsUnder (store.allocNode world (.papN address arity captured)).1 := by + constructor + intro location boxWorld rc foundAddress foundArity foundCaptured found + by_cases fresh : location = store.nodes.size + · subst location + have allocated := HeapIso.get?_allocNode_new store world + (.papN address arity captured) + have boxEq : + (⟨boxWorld, rc, .papN foundAddress foundArity foundCaptured⟩ : + NodeBox) = ⟨world, 1, .papN address arity captured⟩ := + Option.some.inj (found.symm.trans allocated) + cases boxEq + exact under + · exact h.captured_lt (HeapIso.get?_of_allocNode_old fresh found) + +/-- Shared and unique recursive releases only remove nodes or alter RCs. -/ +theorem dropVal {ctx : Ctx} {fuel : Nat} {store store' : Store} + {value : RVal} (h : PAPsUnder store) + (run : Ix.Compiler.IxIR1.dropVal ctx fuel store value = .ok store') : + PAPsUnder store' := + h.ofRestricts (dropVal_restricts run) + +theorem dropMany {ctx : Ctx} {fuel : Nat} {store store' : Store} + {values : List RVal} (h : PAPsUnder store) + (run : Ix.Compiler.IxIR1.dropMany ctx fuel store values = .ok store') : + PAPsUnder store' := + h.ofRestricts (dropMany_restricts run) + +theorem dropUVal {ctx : Ctx} {fuel : Nat} {store store' : Store} + {value : RVal} (h : PAPsUnder store) + (run : Ix.Compiler.IxIR1.dropUVal ctx fuel store value = .ok store') : + PAPsUnder store' := + h.ofRestricts (dropUVal_restricts run) + +theorem dropManyU {ctx : Ctx} {fuel : Nat} {store store' : Store} + {values : List RVal} (h : PAPsUnder store) + (run : Ix.Compiler.IxIR1.dropManyU ctx fuel store values = .ok store') : + PAPsUnder store' := + h.ofRestricts (dropManyU_restricts run) + +end PAPsUnder + +/-- A runtime value names only a slot already present in the store. Unlike +`LiveRVal`, this deliberately permits a dead-but-allocated slot: stale values +can remain in an evaluator environment after their final release, but they +still cannot predict a future append location. -/ +def ValueInBounds (store : Store) : RVal → Prop + | .loc loc => loc < store.nodes.size + | .lit _ | .erased => True + +def ValuesInBounds (store : Store) (values : List RVal) : Prop := + ∀ value ∈ values, ValueInBounds store value + +theorem ValueInBounds.mono {before after : Store} {value : RVal} + (hsize : before.nodes.size ≤ after.nodes.size) + (h : ValueInBounds before value) : ValueInBounds after value := by + cases value with + | loc loc => exact Nat.lt_of_lt_of_le h hsize + | lit literal => trivial + | erased => trivial + +theorem ValuesInBounds.mono {before after : Store} {values : List RVal} + (hsize : before.nodes.size ≤ after.nodes.size) + (h : ValuesInBounds before values) : ValuesInBounds after values := by + intro value hvalue + exact (h value hvalue).mono hsize + +theorem ValuesInBounds.nil (store : Store) : ValuesInBounds store [] := by + simp [ValuesInBounds] + +theorem ValuesInBounds.cons {store : Store} {value : RVal} + {values : List RVal} (hvalue : ValueInBounds store value) + (hvalues : ValuesInBounds store values) : + ValuesInBounds store (value :: values) := by + intro found hfound + rcases List.mem_cons.mp hfound with rfl | htail + · exact hvalue + · exact hvalues found htail + +theorem ValuesInBounds.append {store : Store} {left right : List RVal} + (hleft : ValuesInBounds store left) + (hright : ValuesInBounds store right) : + ValuesInBounds store (left ++ right) := by + intro value hvalue + rcases List.mem_append.mp hvalue with hvalue | hvalue + · exact hleft value hvalue + · exact hright value hvalue + +theorem ValuesInBounds.reverse {store : Store} {values : List RVal} + (h : ValuesInBounds store values) : + ValuesInBounds store values.reverse := by + intro value hvalue + exact h value (by simpa using hvalue) + +theorem ValuesInBounds.take {store : Store} {values : List RVal} + (h : ValuesInBounds store values) (n : Nat) : + ValuesInBounds store (values.take n) := by + intro value hvalue + exact h value (List.mem_of_mem_take hvalue) + +theorem ValuesInBounds.drop {store : Store} {values : List RVal} + (h : ValuesInBounds store values) (n : Nat) : + ValuesInBounds store (values.drop n) := by + intro value hvalue + exact h value (List.mem_of_mem_drop hvalue) + +private theorem ValuesInBounds.foldlPrependList {store : Store} + {values env : List RVal} (hvalues : ValuesInBounds store values) + (henv : ValuesInBounds store env) : + ValuesInBounds store (values.foldl (fun acc value => value :: acc) env) := by + induction values generalizing env with + | nil => exact henv + | cons value values ih => + simp only [List.foldl_cons] + exact ih + (fun found hfound => + hvalues found (List.mem_cons_of_mem value hfound)) + (henv.cons (hvalues value (List.mem_cons_self))) + +theorem ValuesInBounds.foldlPrepend {store : Store} {values : Array RVal} + {env : List RVal} (hvalues : ValuesInBounds store values.toList) + (henv : ValuesInBounds store env) : + ValuesInBounds store (values.foldl (fun acc value => value :: acc) env) := by + rw [← Array.foldl_toList] + exact hvalues.foldlPrependList henv + +theorem RVal.inBounds_of_get? {store : Store} {loc : Nat} {box : NodeBox} + (hget : store.get? loc = some box) : + ValueInBounds store (RVal.loc loc) := + (Array.getElem?_eq_some_iff.mp (nodes_get?_of_get? hget)).1 + +/-- Backward edges in a live node are automatically allocated and bounded. -/ +theorem AllocationOrderInvariant.childrenInBounds {store : Store} + (h : AllocationOrderInvariant store) {parent : Nat} {box : NodeBox} + (hget : store.get? parent = some box) : + ValuesInBounds store (nodeChildren box.node) := by + intro child hchild + cases child with + | loc childLoc => + exact Nat.lt_trans (h.child_lt hget hchild) + (RVal.inBounds_of_get? hget) + | lit literal => trivial + | erased => trivial + +theorem resolveAtom_inBounds {store : Store} {env : List RVal} + {atom : Atom} {value : RVal} (henv : ValuesInBounds store env) + (hresolve : resolveAtom env atom = .ok value) : + ValueInBounds store value := by + cases atom with + | var idx => + cases hget : env[idx]? with + | none => simp [resolveAtom, hget] at hresolve + | some found => + simp [resolveAtom, hget] at hresolve + subst value + exact henv found (List.mem_of_getElem? hget) + | lit literal => + simp [resolveAtom] at hresolve + subst value + trivial + | erased => + simp [resolveAtom] at hresolve + subst value + trivial + +private theorem resolveAtomsList_inBounds {store : Store} + {env : List RVal} (henv : ValuesInBounds store env) : + ∀ (atoms : List Atom) (acc values : List RVal), + ValuesInBounds store acc → + atoms.foldlM + (fun acc atom => do + pure (acc ++ [← resolveAtom env atom])) acc = .ok values → + ValuesInBounds store values + | [], acc, values, hacc, heval => by + change (Except.ok acc : Except Err (List RVal)) = .ok values at heval + injection heval with hvalues + subst values + exact hacc + | atom :: atoms, acc, values, hacc, heval => by + simp only [List.foldlM_cons] at heval + cases hresolve : resolveAtom env atom with + | error err => simp [hresolve, bindErr] at heval + | ok value => + rw [hresolve, bindOk] at heval + apply resolveAtomsList_inBounds henv atoms (acc ++ [value]) values + · exact hacc.append + ((ValuesInBounds.nil store).cons + (resolveAtom_inBounds henv hresolve)) + · exact heval + +theorem resolveAtoms_inBounds {store : Store} {env : List RVal} + {atoms : Array Atom} {values : List RVal} + (henv : ValuesInBounds store env) + (heval : resolveAtoms env atoms = .ok values) : + ValuesInBounds store values := by + rw [resolveAtoms, ← Array.foldlM_toList] at heval + exact resolveAtomsList_inBounds henv atoms.toList [] values + (ValuesInBounds.nil store) heval + +/-! ## Counter and live-slot accounting -/ + +private def liveCountList {alpha : Type} : List (Option alpha) → Nat + | [] => 0 + | none :: rest => liveCountList rest + | some _ :: rest => liveCountList rest + 1 + +private theorem liveCountList_eq_zero_iff_no_some {alpha : Type} : + ∀ values : List (Option alpha), + liveCountList values = 0 ↔ ∀ value, some value ∉ values + | [] => by simp [liveCountList] + | none :: rest => by + simp [liveCountList, liveCountList_eq_zero_iff_no_some rest] + | some head :: rest => by + constructor + · intro hzero + simp [liveCountList] at hzero + · intro hnone + exact False.elim (hnone head (by simp)) + +private theorem foldl_live_eq {alpha : Type} + (values : List (Option alpha)) (acc : Nat) : + values.foldl (fun n value => if value.isSome then n + 1 else n) acc = + acc + liveCountList values := by + induction values generalizing acc with + | nil => simp [liveCountList] + | cons head tail ih => + cases head <;> simp [liveCountList, ih] <;> omega + +private theorem Store.live_eq_liveCountList (store : Store) : + store.live = liveCountList store.nodes.toList := by + rw [Store.live, ← Array.foldl_toList] + simpa using foldl_live_eq store.nodes.toList 0 + +/-- A store has no live nodes exactly when its slot array contains no live +box. This representation bridge is useful when a heap is related by a +location bijection rather than by literal array equality. -/ +theorem Store.live_eq_zero_iff_no_live_slot (store : Store) : + store.live = 0 ↔ ∀ box, some box ∉ store.nodes := by + rw [Store.live_eq_liveCountList] + simpa using liveCountList_eq_zero_iff_no_some store.nodes.toList + +private theorem liveCountList_set_none {alpha : Type} : + ∀ {values : List (Option alpha)} {index : Nat} {value : alpha}, + values[index]? = some (some value) → + liveCountList (values.set index none) + 1 = liveCountList values + | [], index, value, hget => by simp at hget + | head :: tail, 0, value, hget => by + simp only [List.getElem?_cons_zero, Option.some.injEq] at hget + subst head + simp [liveCountList] + | head :: tail, index + 1, value, hget => by + simp only [List.getElem?_cons_succ] at hget + have ih := liveCountList_set_none hget + cases head <;> simp [liveCountList] at ih ⊢ <;> omega + +private theorem liveCountList_set_some {alpha : Type} : + ∀ {values : List (Option alpha)} {index : Nat} {old new : alpha}, + values[index]? = some (some old) → + liveCountList (values.set index (some new)) = liveCountList values + | [], index, old, new, hget => by simp at hget + | head :: tail, 0, old, new, hget => by + simp only [List.getElem?_cons_zero, Option.some.injEq] at hget + subst head + simp [liveCountList] + | head :: tail, index + 1, old, new, hget => by + simp only [List.getElem?_cons_succ] at hget + have ih := liveCountList_set_some (new := new) hget + cases head <;> simp [liveCountList] at ih ⊢ <;> omega + +private theorem Store.live_allocNode (store : Store) (world : Ixon.Owned) + (node : Node) : + (store.allocNode world node).1.live = store.live + 1 := by + simp [Store.live, Store.allocNode] + +private theorem Store.live_kill {store : Store} {loc : Nat} + {box : NodeBox} (hget : store.get? loc = some box) : + (store.kill loc).live + 1 = store.live := by + have hnodes := nodes_get?_of_get? hget + have hlist : store.nodes.toList[loc]? = some (some box) := by + simpa using hnodes + rw [Store.live_eq_liveCountList, Store.live_eq_liveCountList] + simp only [Store.kill, Array.toList_set!] + exact liveCountList_set_none hlist + +private theorem Store.live_setBox {store : Store} {loc : Nat} + {old new : NodeBox} (hget : store.get? loc = some old) : + (store.setBox loc new).live = store.live := by + have hnodes := nodes_get?_of_get? hget + have hlist : store.nodes.toList[loc]? = some (some old) := by + simpa using hnodes + rw [Store.live_eq_liveCountList, Store.live_eq_liveCountList] + simp only [Store.setBox, Array.toList_set!] + exact liveCountList_set_some hlist + +/-- The store-history facts preserved by every successful evaluator entry. +Besides monotone slot capacity and reuse count, the two balance equations say +that allocation exactly accounts for new slots and for the sum of live nodes +and completed frees. -/ +structure StoreFootprint (before after : Store) : Prop where + nodes_size : before.nodes.size ≤ after.nodes.size + reuses : before.reuses ≤ after.reuses + allocation_balance : + after.nodes.size + before.allocs = before.nodes.size + after.allocs + live_balance : + after.live + after.frees + before.allocs = + before.live + before.frees + after.allocs + +theorem StoreFootprint.refl (store : Store) : StoreFootprint store store := by + constructor <;> omega + +theorem StoreFootprint.trans {first second third : Store} + (h₁ : StoreFootprint first second) (h₂ : StoreFootprint second third) : + StoreFootprint first third := by + constructor + · exact Nat.le_trans h₁.nodes_size h₂.nodes_size + · exact Nat.le_trans h₁.reuses h₂.reuses + · have hfirst := h₁.allocation_balance + have hsecond := h₂.allocation_balance + omega + · have hfirst := h₁.live_balance + have hsecond := h₂.live_balance + omega + +private theorem footprint_allocNode (store : Store) (world : Ixon.Owned) + (node : Node) : + StoreFootprint store (store.allocNode world node).1 := by + constructor + · simp [Store.allocNode] + · simp [Store.allocNode] + · simp [Store.allocNode] + omega + · rw [Store.live_allocNode] + simp [Store.allocNode] + omega + +private theorem footprint_setBox {store : Store} {loc : Nat} + {old new : NodeBox} (hget : store.get? loc = some old) : + StoreFootprint store (store.setBox loc new) := by + constructor + · simp [Store.setBox] + · simp [Store.setBox] + · simp [Store.setBox] + · rw [Store.live_setBox hget] + simp [Store.setBox] + +private theorem footprint_kill {store : Store} {loc : Nat} + {box : NodeBox} (hget : store.get? loc = some box) : + StoreFootprint store (store.kill loc) := by + constructor + · simp [Store.kill] + · simp [Store.kill] + · simp [Store.kill] + · have hlive := Store.live_kill hget + have hfrees : (store.kill loc).frees = store.frees + 1 := rfl + have hallocs : (store.kill loc).allocs = store.allocs := rfl + rw [hfrees, hallocs] + omega + +private theorem footprint_rcTick (store : Store) : + StoreFootprint store store.rcTick := by + constructor + · simp [Store.rcTick] + · simp [Store.rcTick] + · simp [Store.rcTick] + · change store.live + store.frees + store.allocs = + store.live + store.frees + store.allocs + rfl + +private theorem footprint_reuse {store : Store} {loc : Nat} + {old : NodeBox} (hget : store.get? loc = some old) (node : Node) : + StoreFootprint store + { store.setBox loc ⟨.unique, 1, node⟩ with + reuses := (store.setBox loc ⟨.unique, 1, node⟩).reuses + 1 } := by + have hset := footprint_setBox (new := ⟨.unique, 1, node⟩) hget + constructor + · simpa using hset.nodes_size + · simp [Store.setBox] + · simpa using hset.allocation_balance + · change (store.setBox loc ⟨.unique, 1, node⟩).live + + (store.setBox loc ⟨.unique, 1, node⟩).frees + store.allocs = + store.live + store.frees + + (store.setBox loc ⟨.unique, 1, node⟩).allocs + exact hset.live_balance + +private theorem footprint_incRcStore {store : Store} {loc : Nat} + {box : NodeBox} (hget : store.get? loc = some box) : + StoreFootprint store (Sim.incRcStore store loc box) := by + unfold Sim.incRcStore + exact (footprint_setBox (new := { box with rc := box.rc + 1 }) hget).trans + (footprint_rcTick _) + +private theorem footprint_decRcStore {store : Store} {loc : Nat} + {box : NodeBox} (hget : store.get? loc = some box) : + StoreFootprint store (Sim.decRcStore store loc box) := by + unfold Sim.decRcStore + apply (footprint_rcTick store).trans + apply footprint_setBox + simpa using hget + +/-- The pap-retain helper only updates RC state. -/ +theorem dupVals_footprint {store store' : Store} {values : List RVal} + (heval : dupVals store values = .ok store') : + StoreFootprint store store' := by + induction values generalizing store with + | nil => + change (.ok store : Except Err Store) = .ok store' at heval + injection heval with hstore + subst store' + exact StoreFootprint.refl store + | cons head tail ih => + cases head with + | lit literal => + simp only [Ix.Compiler.IxIR1.dupVals, List.foldlM_cons] at heval + exact ih heval + | erased => + simp only [Ix.Compiler.IxIR1.dupVals, List.foldlM_cons] at heval + exact ih heval + | loc loc => + simp only [Ix.Compiler.IxIR1.dupVals, List.foldlM_cons] at heval + cases hget : store.get? loc with + | none => simp [hget, bindErr] at heval + | some box => + cases box with + | mk world rc node => + cases world with + | unique => simp [hget, bindErr] at heval + | shared => + simp only [hget] at heval + exact (footprint_incRcStore hget).trans + (ih heval) + +private def FootprintAt (fuel : Nat) : Prop := + (∀ ctx cur store env code store' value, + runCode ctx fuel cur store env code = .ok (store', value) → + StoreFootprint store store') ∧ + (∀ ctx cur store env op store' value, + runOp ctx fuel cur store env op = .ok (store', value) → + StoreFootprint store store') ∧ + (∀ ctx address args store store' value, + invoke ctx fuel address args store = .ok (store', value) → + StoreFootprint store store') ∧ + (∀ ctx store function args store' value, + applyGo ctx fuel store function args = .ok (store', value) → + StoreFootprint store store') ∧ + (∀ ctx store value store', + dropVal ctx fuel store value = .ok store' → + StoreFootprint store store') ∧ + (∀ ctx store values store', + dropMany ctx fuel store values = .ok store' → + StoreFootprint store store') ∧ + (∀ ctx store value store', + dropUVal ctx fuel store value = .ok store' → + StoreFootprint store store') ∧ + (∀ ctx store values store', + dropManyU ctx fuel store values = .ok store' → + StoreFootprint store store') + +/-- Every successful evaluator entry is monotone in allocated slot capacity +and in the reuse counter. This history theorem is independent of ownership +and is what lets an equal endpoint reuse count rule out reuse in every +intermediate call. -/ +private theorem footprintAt : ∀ fuel, FootprintAt fuel := by + intro fuel + induction fuel with + | zero => + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro ctx cur store env code store' value h + rw [runCode.eq_def] at h + simp at h + · intro ctx cur store env op store' value h + rw [runOp.eq_def] at h + simp at h + · intro ctx address args store store' value h + rw [invoke.eq_def] at h + simp at h + · intro ctx store function args store' value h + rw [applyGo.eq_def] at h + simp at h + · intro ctx store value store' h + rw [dropVal.eq_def] at h + simp at h + · intro ctx store values store' h + rw [dropMany.eq_def] at h + simp at h + · intro ctx store value store' h + rw [dropUVal.eq_def] at h + simp at h + · intro ctx store values store' h + rw [dropManyU.eq_def] at h + simp at h + | succ fuel ih => + obtain ⟨ihCode, ihOp, ihInvoke, ihApply, ihDrop, ihDropMany, + ihDropU, ihDropManyU⟩ := ih + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro ctx cur store env code store' value h + cases code with + | ret atom => + rw [runCode.eq_def] at h + dsimp only at h + cases hresolve : resolveAtom env atom with + | error err => rw [hresolve, bindErr] at h; contradiction + | ok result => + rw [hresolve, bindOk] at h + have hpair := Except.ok.inj h + cases hpair + exact StoreFootprint.refl store + | letOp op rest => + rw [runCode.eq_def] at h + dsimp only at h + cases hop : runOp ctx fuel cur store env op with + | error err => rw [hop, bindErr] at h; contradiction + | ok opOut => + rcases opOut with ⟨middle, opValue⟩ + rw [hop, bindOk] at h + exact (ihOp _ _ _ _ _ _ _ hop).trans + (ihCode _ _ _ _ _ _ _ h) + | case scrut peelNat alts => + rw [runCode.eq_def] at h + dsimp only at h + cases hscrut : resolveAtom env scrut with + | error err => rw [hscrut, bindErr] at h; contradiction + | ok scrutValue => + rw [hscrut, bindOk] at h + cases scrutValue with + | loc loc => + dsimp only at h + cases hbox : store.get? loc with + | none => simp [hbox] at h + | some box => + simp only [hbox] at h + cases box with + | mk world rc node => + cases node with + | papN address arity args => simp at h + | ctorN cid fields => + cases halt : alts.find? + (fun alt => alt.cidx == cid.cidx) with + | none => simp [halt] at h + | some alt => + cases alt with + | mk cidx fieldCount body => + cases hsize : fields.size != fieldCount + · simp only [halt, hsize, Bool.false_eq_true, + if_false] at h + exact ihCode _ _ _ _ _ _ _ h + · simp [halt, hsize] at h + | lit literal => + cases literal with + | str string => simp at h + | nat n => + cases hpeel : peelNat with + | false => simp [hpeel] at h + | true => + cases n with + | zero => + cases halt : alts.find? (fun alt => alt.cidx == 0) with + | none => simp [hpeel, halt] at h + | some alt => + cases alt with + | mk cidx fieldCount body => + cases fieldCount with + | zero => + simp only [hpeel, halt] at h + exact ihCode _ _ _ _ _ _ _ h + | succ fieldCount => simp [hpeel, halt] at h + | succ n => + cases halt : alts.find? (fun alt => alt.cidx == 1) with + | none => simp [hpeel, halt] at h + | some alt => + cases alt with + | mk cidx fieldCount body => + cases fieldCount with + | zero => simp [hpeel, halt] at h + | succ fieldCount => + cases fieldCount with + | zero => + simp only [hpeel, halt] at h + exact ihCode _ _ _ _ _ _ _ h + | succ fieldCount => simp [hpeel, halt] at h + | erased => simp at h + · intro ctx cur store env op store' value h + cases op with + | pure atom => + rw [runOp.eq_def] at h + dsimp only at h + cases hresolve : resolveAtom env atom with + | error err => rw [hresolve, bindErr] at h; contradiction + | ok result => + rw [hresolve, bindOk] at h + have hpair := Except.ok.inj h + cases hpair + exact StoreFootprint.refl store + | alloc world cid atoms => + rw [runOp.eq_def] at h + dsimp only at h + cases hargs : resolveAtoms env atoms with + | error err => rw [hargs, bindErr] at h; contradiction + | ok values => + rw [hargs, bindOk] at h + have hpair := Except.ok.inj h + cases hpair + exact footprint_allocNode store world (.ctorN cid values.toArray) + | reuse target cid atoms => + rw [runOp.eq_def] at h + dsimp only at h + cases hargs : resolveAtoms env atoms with + | error err => rw [hargs, bindErr] at h; contradiction + | ok values => + rw [hargs, bindOk] at h + cases htarget : resolveAtom env target with + | error err => rw [htarget, bindErr] at h; contradiction + | ok targetValue => + rw [htarget, bindOk] at h + cases targetValue with + | lit literal => simp at h + | erased => simp at h + | loc loc => + cases hbox : store.get? loc with + | none => simp [hbox] at h + | some box => + simp only [hbox] at h + cases box with + | mk world rc node => + cases world with + | shared => simp at h + | unique => + dsimp only at h + have hpair := Except.ok.inj h + cases hpair + exact footprint_reuse hbox + (.ctorN cid values.toArray) + | free target => + rw [runOp.eq_def] at h + dsimp only at h + cases htarget : resolveAtom env target with + | error err => rw [htarget, bindErr] at h; contradiction + | ok targetValue => + rw [htarget, bindOk] at h + cases targetValue with + | lit literal => simp at h + | erased => simp at h + | loc loc => + cases hbox : store.get? loc with + | none => simp [hbox] at h + | some box => + simp only [hbox] at h + cases box with + | mk world rc node => + cases world with + | shared => simp at h + | unique => + have hpair := Except.ok.inj h + cases hpair + exact footprint_kill hbox + | dup target => + rw [runOp.eq_def] at h + dsimp only at h + cases htarget : resolveAtom env target with + | error err => rw [htarget, bindErr] at h; contradiction + | ok targetValue => + rw [htarget, bindOk] at h + cases targetValue with + | lit literal => + have hpair := Except.ok.inj h + cases hpair + exact StoreFootprint.refl store + | erased => + have hpair := Except.ok.inj h + cases hpair + exact StoreFootprint.refl store + | loc loc => + cases hbox : store.get? loc with + | none => simp [hbox] at h + | some box => + simp only [hbox] at h + cases box with + | mk world rc node => + cases world with + | unique => simp at h + | shared => + have hpair := Except.ok.inj h + cases hpair + exact footprint_incRcStore hbox + | drop target => + rw [runOp.eq_def] at h + dsimp only at h + cases htarget : resolveAtom env target with + | error err => rw [htarget, bindErr] at h; contradiction + | ok targetValue => + rw [htarget, bindOk] at h + cases targetValue with + | lit literal => + have hpair := Except.ok.inj h + cases hpair + exact StoreFootprint.refl store + | erased => + have hpair := Except.ok.inj h + cases hpair + exact StoreFootprint.refl store + | loc loc => + dsimp only at h + cases hdrop : dropVal ctx fuel store (.loc loc) with + | error err => rw [hdrop, bindErr] at h; contradiction + | ok dropped => + rw [hdrop, bindOk] at h + have hpair := Except.ok.inj h + cases hpair + exact ihDrop _ _ _ _ hdrop + | dropU target => + rw [runOp.eq_def] at h + dsimp only at h + cases htarget : resolveAtom env target with + | error err => rw [htarget, bindErr] at h; contradiction + | ok targetValue => + rw [htarget, bindOk] at h + cases targetValue with + | lit literal => + have hpair := Except.ok.inj h + cases hpair + exact StoreFootprint.refl store + | erased => + have hpair := Except.ok.inj h + cases hpair + exact StoreFootprint.refl store + | loc loc => + dsimp only at h + cases hdrop : dropUVal ctx fuel store (.loc loc) with + | error err => rw [hdrop, bindErr] at h; contradiction + | ok dropped => + rw [hdrop, bindOk] at h + have hpair := Except.ok.inj h + cases hpair + exact ihDropU _ _ _ _ hdrop + | fetch target field => + rw [runOp.eq_def] at h + dsimp only at h + cases htarget : resolveAtom env target with + | error err => rw [htarget, bindErr] at h; contradiction + | ok targetValue => + rw [htarget, bindOk] at h + cases targetValue with + | lit literal => simp at h + | erased => simp at h + | loc loc => + cases hbox : store.get? loc with + | none => simp [hbox] at h + | some box => + simp only [hbox] at h + cases box with + | mk world rc node => + cases node with + | papN address arity args => simp at h + | ctorN cid fields => + cases hfield : fields[field]? with + | none => simp [hfield] at h + | some result => + simp only [hfield] at h + have hpair := Except.ok.inj h + cases hpair + exact StoreFootprint.refl store + | call address atoms => + rw [runOp.eq_def] at h + dsimp only at h + cases hargs : resolveAtoms env atoms with + | error err => rw [hargs, bindErr] at h; contradiction + | ok values => + rw [hargs, bindOk] at h + exact ihInvoke _ _ _ _ _ _ h + | callSelf atoms => + rw [runOp.eq_def] at h + dsimp only at h + cases hargs : resolveAtoms env atoms with + | error err => rw [hargs, bindErr] at h; contradiction + | ok values => + rw [hargs, bindOk] at h + cases harity : values.length != cur.arity + · simp only [harity, Bool.false_eq_true, if_false] at h + cases hcode : runCode ctx fuel cur store values.reverse + cur.body with + | error err => rw [hcode, bindErr] at h; contradiction + | ok result => + rcases result with ⟨bodyStore, bodyValue⟩ + rw [hcode, bindOk] at h + obtain ⟨hresult, _⟩ := checkResultWorld_ok h + cases hresult + exact ihCode _ _ _ _ _ _ _ hcode + · simp [harity] at h + | papp address atoms => + rw [runOp.eq_def] at h + dsimp only at h + cases hargs : resolveAtoms env atoms with + | error err => rw [hargs, bindErr] at h; contradiction + | ok values => + rw [hargs, bindOk] at h + cases hdecl : ctx.decls address with + | none => simp [hdecl] at h + | some decl => + simp only [hdecl] at h + by_cases hlen : values.length < declArity decl + · simp only [hlen, if_true] at h + have hpair := Except.ok.inj h + cases hpair + exact footprint_allocNode store .shared + (.papN address (declArity decl) values.toArray) + · simp only [hlen, if_false] at h + contradiction + | apply function atoms => + rw [runOp.eq_def] at h + dsimp only at h + cases hfunction : resolveAtom env function with + | error err => rw [hfunction, bindErr] at h; contradiction + | ok functionValue => + rw [hfunction, bindOk] at h + cases hargs : resolveAtoms env atoms with + | error err => rw [hargs, bindErr] at h; contradiction + | ok values => + rw [hargs, bindOk] at h + exact ihApply _ _ _ _ _ _ h + | extern address atoms => + rw [runOp.eq_def] at h + dsimp only at h + cases hargs : resolveAtoms env atoms with + | error err => rw [hargs, bindErr] at h; contradiction + | ok values => + rw [hargs, bindOk] at h + cases hcall : callScalarOracle ctx address values with + | error err => rw [hcall, bindErr] at h; contradiction + | ok result => + rw [hcall, bindOk] at h + have hpair := Except.ok.inj h + cases hpair + exact StoreFootprint.refl store + · intro ctx address args store store' value h + rw [invoke.eq_def] at h + dsimp only at h + cases hdecl : ctx.decls address with + | none => simp [hdecl] at h + | some decl => + simp only [hdecl] at h + cases decl with + | extern arity => + cases harity : args.length != arity + · simp only [harity, Bool.false_eq_true, if_false] at h + cases hcall : callScalarOracle ctx address args with + | error err => simp [hcall] at h + | ok result => + simp only [hcall] at h + have hpair := Except.ok.inj h + cases hpair + exact StoreFootprint.refl store + · simp [harity] at h + | fn d => + cases harity : args.length != d.arity + · simp only [harity, Bool.false_eq_true, if_false] at h + cases hcode : runCode ctx fuel d store args.reverse d.body with + | error err => rw [hcode, bindErr] at h; contradiction + | ok result => + rcases result with ⟨bodyStore, bodyValue⟩ + rw [hcode, bindOk] at h + obtain ⟨hresult, _⟩ := checkResultWorld_ok h + cases hresult + exact ihCode _ _ _ _ _ _ _ hcode + · simp [harity] at h + · intro ctx store function args store' value h + rw [applyGo.eq_def] at h + dsimp only at h + cases function with + | lit literal => simp at h + | erased => + dsimp only at h + cases hdrop : dropMany ctx fuel store args with + | error err => rw [hdrop, bindErr] at h; contradiction + | ok dropped => + rw [hdrop, bindOk] at h + have hpair := Except.ok.inj h + cases hpair + exact ihDropMany _ _ _ _ hdrop + | loc loc => + dsimp only at h + cases hbox : store.get? loc with + | none => simp [hbox] at h + | some box => + simp only [hbox] at h + cases box with + | mk world rc node => + cases node with + | ctorN cid fields => + dsimp only at h + simp at h + | papN address arity captured => + dsimp only at h + cases hdup : dupVals store captured.toList with + | error err => rw [hdup, bindErr] at h; contradiction + | ok duplicated => + rw [hdup, bindOk] at h + cases hdrop : dropVal ctx fuel duplicated (.loc loc) with + | error err => rw [hdrop, bindErr] at h; contradiction + | ok ready => + rw [hdrop, bindOk] at h + have hprefix := (dupVals_footprint hdup).trans + (ihDrop _ _ _ _ hdrop) + by_cases hunder : + (captured.toList ++ args).length < arity + · simp only [hunder] at h + have hpair := Except.ok.inj h + cases hpair + exact hprefix.trans + (footprint_allocNode ready .shared + (.papN address arity + (captured.toList ++ args).toArray)) + · simp only [hunder] at h + cases hexact : + (captured.toList ++ args).length == arity + · simp only [hexact, Bool.false_eq_true, if_false] at h + cases hdecl : ctx.decls address with + | none => simp [hdecl] at h + | some decl => + cases hpapsafe : declPapSafe decl with + | false => simp [hdecl, hpapsafe] at h + | true => + simp only [hdecl, hpapsafe, if_true] at h + cases hinvoke : invoke ctx fuel address + ((captured.toList ++ args).take arity) ready with + | error err => + rw [hinvoke, bindErr] at h + contradiction + | ok called => + rcases called with ⟨calledStore, calledValue⟩ + rw [hinvoke, bindOk] at h + exact hprefix.trans + ((ihInvoke _ _ _ _ _ _ hinvoke).trans + (ihApply _ _ _ _ _ _ h)) + · simp only [hexact, if_true] at h + cases hdecl : ctx.decls address with + | none => simp [hdecl] at h + | some decl => + cases hpapsafe : declPapSafe decl with + | false => simp [hdecl, hpapsafe] at h + | true => + simp only [hdecl, hpapsafe, if_true] at h + exact hprefix.trans (ihInvoke _ _ _ _ _ _ h) + · intro ctx store value store' h + rw [dropVal.eq_def] at h + dsimp only at h + cases value with + | lit literal => + injection h with hstore + subst store' + exact StoreFootprint.refl store + | erased => + injection h with hstore + subst store' + exact StoreFootprint.refl store + | loc loc => + cases hbox : store.get? loc with + | none => simp [hbox] at h + | some box => + simp only [hbox] at h + cases box with + | mk world rc node => + cases world with + | unique => simp at h + | shared => + cases hrc : rc == 1 + · simp only [hrc, Bool.false_eq_true, if_false] at h + injection h with hstore + subst store' + exact footprint_decRcStore hbox + · simp only [hrc, if_true] at h + have hprefix := (footprint_rcTick store).trans + (footprint_kill (by simpa using hbox)) + cases node with + | ctorN cid fields => + exact hprefix.trans (ihDropMany _ _ _ _ h) + | papN address arity args => + exact hprefix.trans (ihDropMany _ _ _ _ h) + · intro ctx store values store' h + rw [dropMany.eq_def] at h + dsimp only at h + cases values with + | nil => + injection h with hstore + subst store' + exact StoreFootprint.refl store + | cons value rest => + dsimp only at h + cases hdrop : dropVal ctx fuel store value with + | error err => rw [hdrop, bindErr] at h; contradiction + | ok middle => + rw [hdrop, bindOk] at h + exact (ihDrop _ _ _ _ hdrop).trans + (ihDropMany _ _ _ _ h) + · intro ctx store value store' h + rw [dropUVal.eq_def] at h + dsimp only at h + cases value with + | lit literal => + injection h with hstore + subst store' + exact StoreFootprint.refl store + | erased => + injection h with hstore + subst store' + exact StoreFootprint.refl store + | loc loc => + cases hbox : store.get? loc with + | none => simp [hbox] at h + | some box => + simp only [hbox] at h + cases box with + | mk world rc node => + cases world with + | shared => simp at h + | unique => + cases node with + | papN address arity args => simp at h + | ctorN cid fields => + exact (footprint_kill hbox).trans + (ihDropManyU _ _ _ _ h) + · intro ctx store values store' h + rw [dropManyU.eq_def] at h + dsimp only at h + cases values with + | nil => + injection h with hstore + subst store' + exact StoreFootprint.refl store + | cons value rest => + dsimp only at h + cases hdrop : dropUVal ctx fuel store value with + | error err => rw [hdrop, bindErr] at h; contradiction + | ok middle => + rw [hdrop, bindOk] at h + exact (ihDropU _ _ _ _ hdrop).trans + (ihDropManyU _ _ _ _ h) + +theorem runCode_footprint {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store store' : Store} {env : List RVal} {code : Code} {value : RVal} + (heval : runCode ctx fuel cur store env code = .ok (store', value)) : + StoreFootprint store store' := + (footprintAt fuel).1 ctx cur store env code store' value heval + +theorem runOp_footprint {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store store' : Store} {env : List RVal} {op : Op} {value : RVal} + (heval : runOp ctx fuel cur store env op = .ok (store', value)) : + StoreFootprint store store' := + (footprintAt fuel).2.1 ctx cur store env op store' value heval + +theorem invoke_footprint {ctx : Ctx} {fuel : Nat} {address : Ixon.Address} + {args : List RVal} {store store' : Store} {value : RVal} + (heval : invoke ctx fuel address args store = .ok (store', value)) : + StoreFootprint store store' := + (footprintAt fuel).2.2.1 ctx address args store store' value heval + +theorem applyGo_footprint {ctx : Ctx} {fuel : Nat} {store store' : Store} + {function : RVal} {args : List RVal} {value : RVal} + (heval : applyGo ctx fuel store function args = .ok (store', value)) : + StoreFootprint store store' := + (footprintAt fuel).2.2.2.1 ctx store function args store' value heval + +theorem runMain_footprint {ctx : Ctx} {fuel : Nat} {code : Code} + {store : Store} {value : RVal} + (heval : runMain ctx code fuel = .ok (store, value)) : + StoreFootprint ({} : Store) store := + runCode_footprint heval + +/-- Every slot in a fresh successful run comes from exactly one allocation. +Reuse overwrites an existing live slot and therefore changes neither side. -/ +theorem runMain_nodes_size_eq_allocs {ctx : Ctx} {fuel : Nat} {code : Code} + {store : Store} {value : RVal} + (heval : runMain ctx code fuel = .ok (store, value)) : + store.nodes.size = store.allocs := by + have hbalance := (runMain_footprint heval).allocation_balance + simpa using hbalance + +/-- Fresh successful execution exactly partitions allocations into live nodes +and completed frees. In-place reuse preserves liveness and does not count as +either allocation or free. -/ +theorem runMain_live_add_frees_eq_allocs + {ctx : Ctx} {fuel : Nat} {code : Code} + {store : Store} {value : RVal} + (heval : runMain ctx code fuel = .ok (store, value)) : + store.live + store.frees = store.allocs := by + have hbalance := (runMain_footprint heval).live_balance + have hemptyLive : ({} : Store).live = 0 := rfl + rw [hemptyLive, Nat.zero_add] at hbalance + simpa using hbalance + +/-- A counter-only consequence of exact live-slot accounting. -/ +theorem runMain_frees_le_allocs {ctx : Ctx} {fuel : Nat} {code : Code} + {store : Store} {value : RVal} + (heval : runMain ctx code fuel = .ok (store, value)) : + store.frees ≤ store.allocs := by + have hbalance := runMain_live_add_frees_eq_allocs heval + omega + +theorem AllocationOrderInvariant.empty : + AllocationOrderInvariant ({} : Store) := by + constructor <;> intro <;> simp [Store.get?] at * + +/-- Membership in the flattened edge multiset has a concrete live parent. +This is the converse direction to `Sim.child_location_mem_edgeLocations`. +-/ +theorem parent_of_mem_edgeLocations {store : Store} {childLoc : Nat} + (h : childLoc ∈ edgeLocations store) : + ∃ parent box, store.get? parent = some box ∧ + RVal.loc childLoc ∈ nodeChildren box.node := by + rw [edgeLocations, List.mem_flatMap] at h + obtain ⟨slot, hslot, hedge⟩ := h + cases slot with + | none => simp [slotEdgeLocations] at hedge + | some box => + have harray : some box ∈ store.nodes := by simpa using hslot + obtain ⟨parent, hparentArray⟩ := + (Array.mem_iff_getElem?).mp harray + have hparent : store.get? parent = some box := by + rw [Store.get?, hparentArray] + rfl + change childLoc ∈ (nodeChildren box.node).filterMap rvalLocation? + at hedge + rw [List.mem_filterMap] at hedge + obtain ⟨child, hchild, hloc⟩ := hedge + cases child with + | loc loc => + simp [rvalLocation?] at hloc + subst loc + exact ⟨parent, box, hparent, hchild⟩ + | lit literal => simp [rvalLocation?] at hloc + | erased => simp [rvalLocation?] at hloc + +/-- With no external roots, a live node satisfying exact ownership has at +least one incoming heap edge. Positivity is needed only for the shared +case; unique ownership already fixes the incoming count at one. -/ +theorem incoming_pos_of_live {store : Store} + (hown : RootOwnership store []) + (horder : AllocationOrderInvariant store) + {loc : Nat} {box : NodeBox} (hget : store.get? loc = some box) : + 0 < incoming store [] loc := by + have hpos := horder.rc_pos hget + have hcount := hown.counts hget + cases box with + | mk world rc node => + cases world with + | shared => + change 0 < rc at hpos + change rc = incoming store [] loc at hcount + omega + | unique => + change 0 < rc at hpos + change rc = 1 ∧ incoming store [] loc = 1 at hcount + omega + +/-- Exact empty-root ownership and allocation order admit no live slot. + +Following the mandatory incoming edge moves to a strictly newer live parent. +The measure is the parent's remaining distance to the finite array bound, so +the impossible infinite ascent is rejected directly by Lean's termination +checker. -/ +theorem no_live_of_empty_roots {store : Store} + (hown : RootOwnership store []) + (horder : AllocationOrderInvariant store) + {loc : Nat} {box : NodeBox} (hget : store.get? loc = some box) : False := by + have hincoming := incoming_pos_of_live hown horder hget + have hedge : loc ∈ edgeLocations store := by + apply List.count_pos_iff.mp + simpa [incoming] using hincoming + obtain ⟨parent, parentBox, hparent, hchild⟩ := + parent_of_mem_edgeLocations hedge + have hlt : loc < parent := horder.child_lt hparent hchild + exact no_live_of_empty_roots hown horder hparent +termination_by store.nodes.size - loc +decreasing_by + have hlocBound : loc < store.nodes.size := + (Array.getElem?_eq_some_iff.mp (nodes_get?_of_get? hget)).1 + have hparentBound : parent < store.nodes.size := + (Array.getElem?_eq_some_iff.mp (nodes_get?_of_get? hparent)).1 + omega + +private theorem foldl_live_eq_acc_of_no_some : + ∀ (slots : List (Option NodeBox)) (acc : Nat), + (∀ box, some box ∉ slots) → + slots.foldl + (fun count slot => if slot.isSome then count + 1 else count) + acc = acc + | [], acc, _ => rfl + | none :: slots, acc, hnone => by + simp only [List.foldl_cons, Option.isSome_none, Bool.false_eq_true, + if_false] + apply foldl_live_eq_acc_of_no_some slots acc + intro box hbox + exact hnone box (by simp [hbox]) + | some head :: slots, acc, hnone => by + exact False.elim (hnone head (by simp)) + +/-- The finite empty-root reclamation theorem: exact ownership plus the +append-only trace invariant leaves the concrete store with zero live slots. +-/ +theorem live_eq_zero_of_empty_roots {store : Store} + (hown : RootOwnership store []) + (horder : AllocationOrderInvariant store) : + store.live = 0 := by + have hnoSome : ∀ box : NodeBox, some box ∉ store.nodes.toList := by + intro box hmem + have harray : some box ∈ store.nodes := by simpa using hmem + obtain ⟨loc, hloc⟩ := (Array.mem_iff_getElem?).mp harray + have hget : store.get? loc = some box := by + rw [Store.get?, hloc] + rfl + exact no_live_of_empty_roots hown horder hget + rw [Store.live, ← Array.foldl_toList] + exact foldl_live_eq_acc_of_no_some store.nodes.toList 0 hnoSome + +/-! ## Primitive preservation + +The current lowering is append-only. The lemmas in this section cover every +store mutation used by its allocation and release paths. There is +deliberately no preservation theorem for `reuseNodeStore`: overwriting an old +slot with references to newer slots invalidates the concrete location order. +-/ + +theorem AllocationOrderInvariant.rcTick {store : Store} + (h : AllocationOrderInvariant store) : + AllocationOrderInvariant store.rcTick := by + constructor + · intro loc box hget + exact h.rc_pos (by simpa using hget) + · intro parent box childLoc hget hchild + exact h.child_lt (by simpa using hget) hchild + +/-- Updating only the count of one live slot preserves allocation order when +the replacement count remains positive. -/ +theorem AllocationOrderInvariant.setRc {store : Store} {loc : Nat} + {box : NodeBox} {newRc : Nat} + (h : AllocationOrderInvariant store) + (hget : store.get? loc = some box) (hpos : 0 < newRc) : + AllocationOrderInvariant + (store.setBox loc { box with rc := newRc }) := by + constructor + · intro other otherBox hother + by_cases heq : loc = other + · subst other + have hupdated := get?_setBox_same + (new := { box with rc := newRc }) hget + have hboxeq : otherBox = { box with rc := newRc } := + Option.some.inj (hother.symm.trans hupdated) + subst otherBox + exact hpos + · exact h.rc_pos + (get?_of_setBox_other heq hget hother) + · intro parent parentBox childLoc hparent hchild + by_cases heq : loc = parent + · subst parent + have hupdated := get?_setBox_same + (new := { box with rc := newRc }) hget + have hboxeq : parentBox = { box with rc := newRc } := + Option.some.inj (hparent.symm.trans hupdated) + subst parentBox + exact h.child_lt hget hchild + · exact h.child_lt + (get?_of_setBox_other heq hget hparent) hchild + +theorem AllocationOrderInvariant.kill {store : Store} {loc : Nat} + {box : NodeBox} (h : AllocationOrderInvariant store) + (hget : store.get? loc = some box) : + AllocationOrderInvariant (store.kill loc) := by + constructor + · intro other otherBox hother + by_cases heq : loc = other + · subst other + rw [get?_kill_same hget] at hother + contradiction + · exact h.rc_pos (get?_of_kill_other heq hget hother) + · intro parent parentBox childLoc hparent hchild + by_cases heq : loc = parent + · subst parent + rw [get?_kill_same hget] at hparent + contradiction + · exact h.child_lt + (get?_of_kill_other heq hget hparent) hchild + +theorem AllocationOrderInvariant.incRcStore {store : Store} {loc : Nat} + {box : NodeBox} (h : AllocationOrderInvariant store) + (hget : store.get? loc = some box) : + AllocationOrderInvariant (incRcStore store loc box) := by + rw [Sim.incRcStore] + exact (h.setRc hget (by omega)).rcTick + +theorem AllocationOrderInvariant.decRcStore {store : Store} {loc rc : Nat} + {world : Ixon.Owned} {node : Node} + (h : AllocationOrderInvariant store) (hrc : 1 < rc) + (hget : store.get? loc = some ⟨world, rc, node⟩) : + AllocationOrderInvariant + (decRcStore store loc ⟨world, rc, node⟩) := by + rw [Sim.decRcStore] + apply h.rcTick.setRc (by simpa using hget) + change 0 < rc - 1 + omega + +/-- Appending a node whose location children are already allocated preserves +the concrete order: every child lies below the old array size, which is +exactly the fresh parent location. -/ +theorem AllocationOrderInvariant.allocNodeOfInBounds {store : Store} + {world : Ixon.Owned} {node : Node} + (h : AllocationOrderInvariant store) + (hchildren : ValuesInBounds store (nodeChildren node)) : + AllocationOrderInvariant (store.allocNode world node).1 := by + constructor + · intro loc box hget + by_cases hnew : loc = store.nodes.size + · subst loc + have hfresh := HeapIso.get?_allocNode_new store world node + have hboxeq : box = ⟨world, 1, node⟩ := + Option.some.inj (hget.symm.trans hfresh) + subst box + simp + · exact h.rc_pos (HeapIso.get?_of_allocNode_old hnew hget) + · intro parent box childLoc hget hchild + by_cases hnew : parent = store.nodes.size + · subst parent + have hfresh := HeapIso.get?_allocNode_new store world node + have hboxeq : box = ⟨world, 1, node⟩ := + Option.some.inj (hget.symm.trans hfresh) + subst box + exact hchildren (.loc childLoc) hchild + · exact h.child_lt + (HeapIso.get?_of_allocNode_old hnew hget) hchild + +/-- Ownership-facing allocation form: liveness is stronger than the allocated +location bound required by `allocNodeOfInBounds`. -/ +theorem AllocationOrderInvariant.allocNode {store : Store} + {world : Ixon.Owned} {node : Node} + (h : AllocationOrderInvariant store) + (hchildren : ∀ child ∈ nodeChildren node, LiveRVal store child) : + AllocationOrderInvariant (store.allocNode world node).1 := by + apply h.allocNodeOfInBounds + intro child hchild + cases child with + | loc childLoc => + obtain ⟨box, hget⟩ := hchildren (.loc childLoc) hchild + exact RVal.inBounds_of_get? hget + | lit literal => trivial + | erased => trivial + +private def SharedDropOrderAt (ctx : Ctx) (fuel : Nat) : Prop := + (∀ (store : Store) (value : RVal) (store' : Store), + AllocationOrderInvariant store → + dropVal ctx fuel store value = .ok store' → + AllocationOrderInvariant store') ∧ + (∀ (store : Store) (values : List RVal) (store' : Store), + AllocationOrderInvariant store → + dropMany ctx fuel store values = .ok store' → + AllocationOrderInvariant store') + +/-- Successful shared deep release preserves positivity and allocation order, +including every recursive final-owner child release. -/ +private theorem sharedDropOrderAt (ctx : Ctx) : + ∀ fuel, SharedDropOrderAt ctx fuel := by + intro fuel + induction fuel with + | zero => + refine ⟨?_, ?_⟩ + · intro store value store' horder heval + rw [dropVal.eq_def] at heval + simp at heval + · intro store values store' horder heval + rw [dropMany.eq_def] at heval + simp at heval + | succ fuel ih => + obtain ⟨ihVal, ihMany⟩ := ih + refine ⟨?_, ?_⟩ + · intro store value store' horder heval + cases value with + | lit literal => + rw [dropVal.eq_def] at heval + dsimp only at heval + injection heval with hstore + subst store' + exact horder + | erased => + rw [dropVal.eq_def] at heval + dsimp only at heval + injection heval with hstore + subst store' + exact horder + | loc loc => + rw [dropVal.eq_def] at heval + dsimp only at heval + cases hget : store.get? loc with + | none => + rw [hget] at heval + simp at heval + | some box => + rw [hget] at heval + cases box with + | mk world rc node => + cases world with + | unique => simp at heval + | shared => + dsimp only at heval + by_cases hrc : rc = 1 + · subst rc + have hbeq : ((1 : Nat) == 1) = true := by decide + rw [hbeq] at heval + have htickGet : + store.rcTick.get? loc = some ⟨.shared, 1, node⟩ := by + simpa using hget + have hprefix := horder.rcTick.kill htickGet + cases node with + | ctorN cid fields => + exact ihMany _ fields.toList store' hprefix heval + | papN fn arity args => + exact ihMany _ args.toList store' hprefix heval + · have hbeq : (rc == 1) = false := by simp [hrc] + rw [hbeq] at heval + have hpos : 0 < rc := horder.rc_pos hget + have hmany : 1 < rc := by omega + injection heval with hstore + subst store' + exact horder.decRcStore hmany hget + · intro store values store' horder heval + cases values with + | nil => + rw [dropMany.eq_def] at heval + dsimp only at heval + injection heval with hstore + subst store' + exact horder + | cons value values => + rw [dropMany.eq_def] at heval + dsimp only at heval + cases hfirst : dropVal ctx fuel store value with + | error err => + rw [hfirst, bindErr] at heval + simp at heval + | ok middle => + rw [hfirst, bindOk] at heval + exact ihMany middle values store' + (ihVal store value middle horder hfirst) heval + +theorem AllocationOrderInvariant.dropVal {ctx : Ctx} {fuel : Nat} + {store store' : Store} {value : RVal} + (h : AllocationOrderInvariant store) + (heval : dropVal ctx fuel store value = .ok store') : + AllocationOrderInvariant store' := + (sharedDropOrderAt ctx fuel).1 store value store' h heval + +theorem AllocationOrderInvariant.dropMany {ctx : Ctx} {fuel : Nat} + {store store' : Store} {values : List RVal} + (h : AllocationOrderInvariant store) + (heval : dropMany ctx fuel store values = .ok store') : + AllocationOrderInvariant store' := + (sharedDropOrderAt ctx fuel).2 store values store' h heval + +private def UniqueDropOrderAt (ctx : Ctx) (fuel : Nat) : Prop := + (∀ (store : Store) (value : RVal) (store' : Store), + AllocationOrderInvariant store → + dropUVal ctx fuel store value = .ok store' → + AllocationOrderInvariant store') ∧ + (∀ (store : Store) (values : List RVal) (store' : Store), + AllocationOrderInvariant store → + dropManyU ctx fuel store values = .ok store' → + AllocationOrderInvariant store') + +/-- Successful unique deep release only kills slots, so it preserves the +append order through its complete recursive constructor traversal. -/ +private theorem uniqueDropOrderAt (ctx : Ctx) : + ∀ fuel, UniqueDropOrderAt ctx fuel := by + intro fuel + induction fuel with + | zero => + refine ⟨?_, ?_⟩ + · intro store value store' horder heval + rw [dropUVal.eq_def] at heval + simp at heval + · intro store values store' horder heval + rw [dropManyU.eq_def] at heval + simp at heval + | succ fuel ih => + obtain ⟨ihVal, ihMany⟩ := ih + refine ⟨?_, ?_⟩ + · intro store value store' horder heval + cases value with + | lit literal => + rw [dropUVal.eq_def] at heval + dsimp only at heval + injection heval with hstore + subst store' + exact horder + | erased => + rw [dropUVal.eq_def] at heval + dsimp only at heval + injection heval with hstore + subst store' + exact horder + | loc loc => + rw [dropUVal.eq_def] at heval + dsimp only at heval + cases hget : store.get? loc with + | none => + rw [hget] at heval + simp at heval + | some box => + rw [hget] at heval + cases box with + | mk world rc node => + cases world with + | shared => simp at heval + | unique => + cases node with + | ctorN cid fields => + exact ihMany _ fields.toList store' + (horder.kill hget) heval + | papN fn arity args => simp at heval + · intro store values store' horder heval + cases values with + | nil => + rw [dropManyU.eq_def] at heval + dsimp only at heval + injection heval with hstore + subst store' + exact horder + | cons value values => + rw [dropManyU.eq_def] at heval + dsimp only at heval + cases hfirst : dropUVal ctx fuel store value with + | error err => + rw [hfirst, bindErr] at heval + simp at heval + | ok middle => + rw [hfirst, bindOk] at heval + exact ihMany middle values store' + (ihVal store value middle horder hfirst) heval + +theorem AllocationOrderInvariant.dropUVal {ctx : Ctx} {fuel : Nat} + {store store' : Store} {value : RVal} + (h : AllocationOrderInvariant store) + (heval : dropUVal ctx fuel store value = .ok store') : + AllocationOrderInvariant store' := + (uniqueDropOrderAt ctx fuel).1 store value store' h heval + +theorem AllocationOrderInvariant.dropManyU {ctx : Ctx} {fuel : Nat} + {store store' : Store} {values : List RVal} + (h : AllocationOrderInvariant store) + (heval : dropManyU ctx fuel store values = .ok store') : + AllocationOrderInvariant store' := + (uniqueDropOrderAt ctx fuel).2 store values store' h heval + +/-- Retaining any sequence of shared values changes only positive reference +counts and therefore preserves the trace invariant. -/ +theorem AllocationOrderInvariant.dupVals {store store' : Store} + {values : List RVal} (h : AllocationOrderInvariant store) + (heval : dupVals store values = .ok store') : + AllocationOrderInvariant store' := by + induction values generalizing store with + | nil => + change (.ok store : Except Err Store) = .ok store' at heval + injection heval with hstore + subst store' + exact h + | cons head tail ih => + cases head with + | lit literal => + simp only [Ix.Compiler.IxIR1.dupVals, List.foldlM_cons] at heval + exact ih h heval + | erased => + simp only [Ix.Compiler.IxIR1.dupVals, List.foldlM_cons] at heval + exact ih h heval + | loc loc => + simp only [Ix.Compiler.IxIR1.dupVals, List.foldlM_cons] at heval + cases hget : store.get? loc with + | none => simp [hget, bindErr] at heval + | some box => + cases box with + | mk world rc node => + cases world with + | unique => simp [hget, bindErr] at heval + | shared => + simp only [hget] at heval + exact ih (h.incRcStore hget) heval + +private structure OrderResult (before after : Store) (value : RVal) : Prop where + order : AllocationOrderInvariant after + valueInBounds : ValueInBounds after value + papsUnder : PAPsUnder before → PAPsUnder after + +private def OrderAt (fuel : Nat) : Prop := + (∀ ctx cur store env code store' value, + AllocationOrderInvariant store → ValuesInBounds store env → + store'.reuses = store.reuses → + runCode ctx fuel cur store env code = .ok (store', value) → + OrderResult store store' value) ∧ + (∀ ctx cur store env op store' value, + AllocationOrderInvariant store → ValuesInBounds store env → + store'.reuses = store.reuses → + runOp ctx fuel cur store env op = .ok (store', value) → + OrderResult store store' value) ∧ + (∀ ctx address args store store' value, + AllocationOrderInvariant store → ValuesInBounds store args → + store'.reuses = store.reuses → + invoke ctx fuel address args store = .ok (store', value) → + OrderResult store store' value) ∧ + (∀ ctx store function args store' value, + AllocationOrderInvariant store → ValueInBounds store function → + ValuesInBounds store args → store'.reuses = store.reuses → + applyGo ctx fuel store function args = .ok (store', value) → + OrderResult store store' value) + +/-- A successful trace whose endpoint reuse count is unchanged preserves the +append allocation order. The proof also establishes that its result cannot +name a future slot. `StoreFootprint` forces the same reuse equality at every +intermediate call, so even dynamically unreachable `reuse` instructions are +harmless and an executed one is contradictory. -/ +private theorem orderAt : ∀ fuel, OrderAt fuel := by + intro fuel + induction fuel with + | zero => + refine ⟨?_, ?_, ?_, ?_⟩ + · intro ctx cur store env code store' value horder henv hreuses heval + rw [runCode.eq_def] at heval + simp at heval + · intro ctx cur store env op store' value horder henv hreuses heval + rw [runOp.eq_def] at heval + simp at heval + · intro ctx address args store store' value horder hargs hreuses heval + rw [invoke.eq_def] at heval + simp at heval + · intro ctx store function args store' value horder hfunction hargs + hreuses heval + rw [applyGo.eq_def] at heval + simp at heval + | succ fuel ih => + obtain ⟨ihCode, ihOp, ihInvoke, ihApply⟩ := ih + refine ⟨?_, ?_, ?_, ?_⟩ + · intro ctx cur store env code store' value horder henv hreuses heval + cases code with + | ret atom => + rw [runCode.eq_def] at heval + dsimp only at heval + cases hresolve : resolveAtom env atom with + | error err => rw [hresolve, bindErr] at heval; contradiction + | ok result => + rw [hresolve, bindOk] at heval + have hpair := Except.ok.inj heval + cases hpair + exact ⟨horder, resolveAtom_inBounds henv hresolve, id⟩ + | letOp op rest => + rw [runCode.eq_def] at heval + dsimp only at heval + cases hop : runOp ctx fuel cur store env op with + | error err => rw [hop, bindErr] at heval; contradiction + | ok opOut => + rcases opOut with ⟨middle, opValue⟩ + rw [hop, bindOk] at heval + have hopFoot := runOp_footprint hop + have hrestFoot := runCode_footprint heval + have hopReusesLe : store.reuses ≤ middle.reuses := by + simpa using hopFoot.reuses + have hrestReusesLe : middle.reuses ≤ store'.reuses := by + simpa using hrestFoot.reuses + have hopReuses : middle.reuses = store.reuses := by omega + have hrestReuses : store'.reuses = middle.reuses := by omega + obtain ⟨hmiddleOrder, hopBound, hopPaps⟩ := + ihOp _ _ _ _ _ _ _ horder henv hopReuses hop + have henvMiddle : ValuesInBounds middle env := + henv.mono hopFoot.nodes_size + have tail := ihCode _ _ _ _ _ _ _ hmiddleOrder + (henvMiddle.cons hopBound) hrestReuses heval + exact ⟨tail.order, tail.valueInBounds, + fun hpaps => tail.papsUnder (hopPaps hpaps)⟩ + | case scrut peelNat alts => + rw [runCode.eq_def] at heval + dsimp only at heval + cases hscrut : resolveAtom env scrut with + | error err => rw [hscrut, bindErr] at heval; contradiction + | ok scrutValue => + rw [hscrut, bindOk] at heval + cases scrutValue with + | loc loc => + dsimp only at heval + cases hbox : store.get? loc with + | none => simp [hbox] at heval + | some box => + simp only [hbox] at heval + cases box with + | mk world rc node => + cases node with + | papN address arity args => simp at heval + | ctorN cid fields => + cases halt : alts.find? + (fun alt => alt.cidx == cid.cidx) with + | none => simp [halt] at heval + | some alt => + cases alt with + | mk cidx fieldCount body => + cases hsize : fields.size != fieldCount + · simp only [halt, hsize, Bool.false_eq_true, + if_false] at heval + have hfields := horder.childrenInBounds hbox + exact ihCode _ _ _ _ _ _ _ horder + (hfields.foldlPrepend henv) hreuses heval + · simp [halt, hsize] at heval + | lit literal => + cases literal with + | str string => simp at heval + | nat n => + cases hpeel : peelNat with + | false => simp [hpeel] at heval + | true => + cases n with + | zero => + cases halt : alts.find? (fun alt => alt.cidx == 0) with + | none => simp [hpeel, halt] at heval + | some alt => + cases alt with + | mk cidx fieldCount body => + cases fieldCount with + | zero => + simp only [hpeel, halt] at heval + exact ihCode _ _ _ _ _ _ _ horder henv hreuses heval + | succ fieldCount => simp [hpeel, halt] at heval + | succ n => + cases halt : alts.find? (fun alt => alt.cidx == 1) with + | none => simp [hpeel, halt] at heval + | some alt => + cases alt with + | mk cidx fieldCount body => + cases fieldCount with + | zero => simp [hpeel, halt] at heval + | succ fieldCount => + cases fieldCount with + | zero => + simp only [hpeel, halt] at heval + exact ihCode _ _ _ _ _ _ _ horder + (henv.cons (by trivial)) hreuses heval + | succ fieldCount => simp [hpeel, halt] at heval + | erased => simp at heval + · intro ctx cur store env op store' value horder henv hreuses heval + cases op with + | pure atom => + rw [runOp.eq_def] at heval + dsimp only at heval + cases hresolve : resolveAtom env atom with + | error err => rw [hresolve, bindErr] at heval; contradiction + | ok result => + rw [hresolve, bindOk] at heval + have hpair := Except.ok.inj heval + cases hpair + exact ⟨horder, resolveAtom_inBounds henv hresolve, id⟩ + | alloc world cid atoms => + rw [runOp.eq_def] at heval + dsimp only at heval + cases hresolve : resolveAtoms env atoms with + | error err => rw [hresolve, bindErr] at heval; contradiction + | ok values => + rw [hresolve, bindOk] at heval + have hpair := Except.ok.inj heval + cases hpair + have hvalues := resolveAtoms_inBounds henv hresolve + refine ⟨?_, ?_, ?_⟩ + · apply horder.allocNodeOfInBounds + simpa [nodeChildren] using hvalues + · simp [ValueInBounds, Store.allocNode] + · intro hpaps + exact hpaps.allocCtor world cid values.toArray + | reuse target cid atoms => + rw [runOp.eq_def] at heval + dsimp only at heval + cases hargs : resolveAtoms env atoms with + | error err => rw [hargs, bindErr] at heval; contradiction + | ok values => + rw [hargs, bindOk] at heval + cases htarget : resolveAtom env target with + | error err => rw [htarget, bindErr] at heval; contradiction + | ok targetValue => + rw [htarget, bindOk] at heval + cases targetValue with + | lit literal => simp at heval + | erased => simp at heval + | loc loc => + cases hbox : store.get? loc with + | none => simp [hbox] at heval + | some box => + simp only [hbox] at heval + cases box with + | mk world rc node => + cases world with + | shared => simp at heval + | unique => + have hpair := Except.ok.inj heval + cases hpair + simp [Store.setBox] at hreuses + | free target => + rw [runOp.eq_def] at heval + dsimp only at heval + cases htarget : resolveAtom env target with + | error err => rw [htarget, bindErr] at heval; contradiction + | ok targetValue => + rw [htarget, bindOk] at heval + cases targetValue with + | lit literal => simp at heval + | erased => simp at heval + | loc loc => + cases hbox : store.get? loc with + | none => simp [hbox] at heval + | some box => + simp only [hbox] at heval + cases box with + | mk world rc node => + cases world with + | shared => simp at heval + | unique => + have hpair := Except.ok.inj heval + cases hpair + exact ⟨horder.kill hbox, by trivial, + fun hpaps => hpaps.kill hbox⟩ + | dup target => + rw [runOp.eq_def] at heval + dsimp only at heval + cases htarget : resolveAtom env target with + | error err => rw [htarget, bindErr] at heval; contradiction + | ok targetValue => + rw [htarget, bindOk] at heval + cases targetValue with + | lit literal => + have hpair := Except.ok.inj heval + cases hpair + exact ⟨horder, by trivial, id⟩ + | erased => + have hpair := Except.ok.inj heval + cases hpair + exact ⟨horder, by trivial, id⟩ + | loc loc => + cases hbox : store.get? loc with + | none => simp [hbox] at heval + | some box => + simp only [hbox] at heval + cases box with + | mk world rc node => + cases world with + | unique => simp at heval + | shared => + have hpair := Except.ok.inj heval + cases hpair + refine ⟨horder.incRcStore hbox, + (RVal.inBounds_of_get? hbox).mono + (footprint_incRcStore hbox).nodes_size, ?_⟩ + intro hpaps + simpa [Sim.incRcStore] using hpaps.incRcStore hbox + | drop target => + rw [runOp.eq_def] at heval + dsimp only at heval + cases htarget : resolveAtom env target with + | error err => rw [htarget, bindErr] at heval; contradiction + | ok targetValue => + rw [htarget, bindOk] at heval + cases targetValue with + | lit literal => + have hpair := Except.ok.inj heval + cases hpair + exact ⟨horder, by trivial, id⟩ + | erased => + have hpair := Except.ok.inj heval + cases hpair + exact ⟨horder, by trivial, id⟩ + | loc loc => + dsimp only at heval + cases hdrop : dropVal ctx fuel store (.loc loc) with + | error err => rw [hdrop, bindErr] at heval; contradiction + | ok dropped => + rw [hdrop, bindOk] at heval + have hpair := Except.ok.inj heval + cases hpair + exact ⟨horder.dropVal hdrop, by trivial, + fun hpaps => hpaps.dropVal hdrop⟩ + | dropU target => + rw [runOp.eq_def] at heval + dsimp only at heval + cases htarget : resolveAtom env target with + | error err => rw [htarget, bindErr] at heval; contradiction + | ok targetValue => + rw [htarget, bindOk] at heval + cases targetValue with + | lit literal => + have hpair := Except.ok.inj heval + cases hpair + exact ⟨horder, by trivial, id⟩ + | erased => + have hpair := Except.ok.inj heval + cases hpair + exact ⟨horder, by trivial, id⟩ + | loc loc => + dsimp only at heval + cases hdrop : dropUVal ctx fuel store (.loc loc) with + | error err => rw [hdrop, bindErr] at heval; contradiction + | ok dropped => + rw [hdrop, bindOk] at heval + have hpair := Except.ok.inj heval + cases hpair + exact ⟨horder.dropUVal hdrop, by trivial, + fun hpaps => hpaps.dropUVal hdrop⟩ + | fetch target field => + rw [runOp.eq_def] at heval + dsimp only at heval + cases htarget : resolveAtom env target with + | error err => rw [htarget, bindErr] at heval; contradiction + | ok targetValue => + rw [htarget, bindOk] at heval + cases targetValue with + | lit literal => simp at heval + | erased => simp at heval + | loc loc => + cases hbox : store.get? loc with + | none => simp [hbox] at heval + | some box => + simp only [hbox] at heval + cases box with + | mk world rc node => + cases node with + | papN address arity args => simp at heval + | ctorN cid fields => + cases hfield : fields[field]? with + | none => simp [hfield] at heval + | some result => + simp only [hfield] at heval + have hpair := Except.ok.inj heval + have hstoreEq : store = store' := + congrArg Prod.fst hpair + have hvalueEq : result = value := + congrArg Prod.snd hpair + subst store' + subst value + have hmember : result ∈ fields.toList := by + simpa using + (Array.mem_iff_getElem?).2 ⟨field, hfield⟩ + exact ⟨horder, + horder.childrenInBounds hbox result + (by simpa [nodeChildren] using hmember), id⟩ + | call address atoms => + rw [runOp.eq_def] at heval + dsimp only at heval + cases hresolve : resolveAtoms env atoms with + | error err => rw [hresolve, bindErr] at heval; contradiction + | ok values => + rw [hresolve, bindOk] at heval + exact ihInvoke _ _ _ _ _ _ horder + (resolveAtoms_inBounds henv hresolve) hreuses heval + | callSelf atoms => + rw [runOp.eq_def] at heval + dsimp only at heval + cases hresolve : resolveAtoms env atoms with + | error err => rw [hresolve, bindErr] at heval; contradiction + | ok values => + rw [hresolve, bindOk] at heval + cases harity : values.length != cur.arity + · simp only [harity, Bool.false_eq_true, if_false] at heval + cases hcode : runCode ctx fuel cur store values.reverse + cur.body with + | error err => rw [hcode, bindErr] at heval; contradiction + | ok result => + rcases result with ⟨bodyStore, bodyValue⟩ + rw [hcode, bindOk] at heval + obtain ⟨hresult, _⟩ := checkResultWorld_ok heval + cases hresult + exact ihCode _ _ _ _ _ _ _ horder + (resolveAtoms_inBounds henv hresolve).reverse + hreuses hcode + · simp [harity] at heval + | papp address atoms => + rw [runOp.eq_def] at heval + dsimp only at heval + cases hresolve : resolveAtoms env atoms with + | error err => rw [hresolve, bindErr] at heval; contradiction + | ok values => + rw [hresolve, bindOk] at heval + cases hdecl : ctx.decls address with + | none => simp [hdecl] at heval + | some decl => + simp only [hdecl] at heval + by_cases hlen : values.length < declArity decl + · simp only [hlen, if_true] at heval + have hpair := Except.ok.inj heval + cases hpair + have hvalues := resolveAtoms_inBounds henv hresolve + refine ⟨?_, ?_, ?_⟩ + · apply horder.allocNodeOfInBounds + simpa [nodeChildren] using hvalues + · simp [ValueInBounds, Store.allocNode] + · intro hpaps + exact hpaps.allocPap .shared address (declArity decl) + values.toArray (by simpa using hlen) + · simp [hlen] at heval + | apply function atoms => + rw [runOp.eq_def] at heval + dsimp only at heval + cases hfunction : resolveAtom env function with + | error err => rw [hfunction, bindErr] at heval; contradiction + | ok functionValue => + rw [hfunction, bindOk] at heval + cases hresolve : resolveAtoms env atoms with + | error err => rw [hresolve, bindErr] at heval; contradiction + | ok values => + rw [hresolve, bindOk] at heval + exact ihApply _ _ _ _ _ _ horder + (resolveAtom_inBounds henv hfunction) + (resolveAtoms_inBounds henv hresolve) hreuses heval + | extern address atoms => + rw [runOp.eq_def] at heval + dsimp only at heval + cases hresolve : resolveAtoms env atoms with + | error err => rw [hresolve, bindErr] at heval; contradiction + | ok values => + rw [hresolve, bindOk] at heval + cases hcall : callScalarOracle ctx address values with + | error err => rw [hcall, bindErr] at heval; contradiction + | ok result => + rw [hcall, bindOk] at heval + have hpair := Except.ok.inj heval + have hstoreEq : store = store' := + congrArg Prod.fst hpair + have hvalueEq : result = value := + congrArg Prod.snd hpair + subst store' + subst value + have hscalar := (callScalarOracle_ok hcall).2 + refine ⟨horder, ?_, id⟩ + cases result <;> simp_all [RVal.isScalar, ValueInBounds] + · intro ctx address args store store' value horder hargs hreuses heval + rw [invoke.eq_def] at heval + dsimp only at heval + cases hdecl : ctx.decls address with + | none => simp [hdecl] at heval + | some decl => + simp only [hdecl] at heval + cases decl with + | extern arity => + cases harity : args.length != arity + · simp only [harity, Bool.false_eq_true, if_false] at heval + cases hcall : callScalarOracle ctx address args with + | error err => simp [hcall] at heval + | ok result => + simp only [hcall] at heval + have hpair := Except.ok.inj heval + have hstoreEq : store = store' := + congrArg Prod.fst hpair + have hvalueEq : result = value := + congrArg Prod.snd hpair + subst store' + subst value + have hscalar := (callScalarOracle_ok hcall).2 + refine ⟨horder, ?_, id⟩ + cases result <;> simp_all [RVal.isScalar, ValueInBounds] + · simp [harity] at heval + | fn d => + cases harity : args.length != d.arity + · simp only [harity, Bool.false_eq_true, if_false] at heval + cases hcode : runCode ctx fuel d store args.reverse d.body with + | error err => rw [hcode, bindErr] at heval; contradiction + | ok result => + rcases result with ⟨bodyStore, bodyValue⟩ + rw [hcode, bindOk] at heval + obtain ⟨hresult, _⟩ := checkResultWorld_ok heval + cases hresult + exact ihCode _ _ _ _ _ _ _ horder hargs.reverse + hreuses hcode + · simp [harity] at heval + · intro ctx store function args store' value horder hfunction hargs + hreuses heval + rw [applyGo.eq_def] at heval + dsimp only at heval + cases function with + | lit literal => simp at heval + | erased => + dsimp only at heval + cases hdrop : dropMany ctx fuel store args with + | error err => rw [hdrop, bindErr] at heval; contradiction + | ok dropped => + rw [hdrop, bindOk] at heval + have hpair := Except.ok.inj heval + cases hpair + exact ⟨horder.dropMany hdrop, by trivial, + fun hpaps => hpaps.dropMany hdrop⟩ + | loc loc => + dsimp only at heval + cases hbox : store.get? loc with + | none => simp [hbox] at heval + | some box => + simp only [hbox] at heval + cases box with + | mk world rc node => + cases node with + | ctorN cid fields => + dsimp only at heval + simp at heval + | papN address arity captured => + dsimp only at heval + cases hdup : dupVals store captured.toList with + | error err => rw [hdup, bindErr] at heval; contradiction + | ok duplicated => + rw [hdup, bindOk] at heval + cases hdrop : dropVal ctx fuel duplicated (.loc loc) with + | error err => rw [hdrop, bindErr] at heval; contradiction + | ok ready => + rw [hdrop, bindOk] at heval + have hdupFoot := dupVals_footprint hdup + have hdropFoot := (footprintAt fuel).2.2.2.2.1 + ctx duplicated (.loc loc) ready hdrop + have hprefix := hdupFoot.trans hdropFoot + have hreadyOrder := (horder.dupVals hdup).dropVal hdrop + have hcaptured := horder.childrenInBounds hbox + have htotal : + ValuesInBounds ready (captured.toList ++ args) := + (hcaptured.append hargs).mono hprefix.nodes_size + by_cases hunder : + (captured.toList ++ args).length < arity + · simp only [hunder] at heval + have hpair := Except.ok.inj heval + cases hpair + refine ⟨?_, ?_, ?_⟩ + · apply hreadyOrder.allocNodeOfInBounds + simpa [nodeChildren] using htotal + · simp [ValueInBounds, Store.allocNode] + · intro hpaps + exact ((hpaps.dupVals hdup).dropVal hdrop).allocPap + .shared address arity + (captured.toList ++ args).toArray + (by simpa using hunder) + · simp only [hunder] at heval + cases hexact : + (captured.toList ++ args).length == arity + · simp only [hexact, Bool.false_eq_true, if_false] + at heval + cases hdecl : ctx.decls address with + | none => simp [hdecl] at heval + | some decl => + cases hpapsafe : declPapSafe decl with + | false => simp [hdecl, hpapsafe] at heval + | true => + simp only [hdecl, hpapsafe, if_true] at heval + cases hinvoke : invoke ctx fuel address + ((captured.toList ++ args).take arity) ready with + | error err => + rw [hinvoke, bindErr] at heval + contradiction + | ok called => + rcases called with ⟨calledStore, calledValue⟩ + rw [hinvoke, bindOk] at heval + have hinvokeFoot := invoke_footprint hinvoke + have happlyFoot := applyGo_footprint heval + have hprefixReuseLe : + store.reuses ≤ ready.reuses := + hprefix.reuses + have hinvokeReuseLe : + ready.reuses ≤ calledStore.reuses := by + simpa using hinvokeFoot.reuses + have happlyReuseLe : + calledStore.reuses ≤ store'.reuses := by + simpa using happlyFoot.reuses + have hreadyReuse : + ready.reuses = store.reuses := by + omega + have hcalledReuse : + calledStore.reuses = ready.reuses := by omega + have hfinalReuse : + store'.reuses = calledStore.reuses := by omega + obtain ⟨hcalledOrder, hcalledValue, + hcalledPaps⟩ := + ihInvoke _ _ _ _ _ _ hreadyOrder + (htotal.take arity) hcalledReuse hinvoke + have hrestBounds : ValuesInBounds calledStore + ((captured.toList ++ args).drop arity) := + (htotal.drop arity).mono hinvokeFoot.nodes_size + have tail := ihApply _ _ _ _ _ _ hcalledOrder + hcalledValue hrestBounds hfinalReuse heval + exact ⟨tail.order, tail.valueInBounds, + fun hpaps => tail.papsUnder (hcalledPaps + ((hpaps.dupVals hdup).dropVal hdrop))⟩ + · simp only [hexact, if_true] at heval + cases hdecl : ctx.decls address with + | none => simp [hdecl] at heval + | some decl => + cases hpapsafe : declPapSafe decl with + | false => simp [hdecl, hpapsafe] at heval + | true => + simp only [hdecl, hpapsafe, if_true] at heval + have hinvokeFoot := invoke_footprint heval + have hprefixReuseLe : + store.reuses ≤ ready.reuses := + hprefix.reuses + have hinvokeReuseLe : + ready.reuses ≤ store'.reuses := by + simpa using hinvokeFoot.reuses + have hreadyReuse : ready.reuses = store.reuses := by + omega + have hfinalReuse : + store'.reuses = ready.reuses := by + omega + have called := ihInvoke _ _ _ _ _ _ hreadyOrder + htotal hfinalReuse heval + exact ⟨called.order, called.valueInBounds, + fun hpaps => called.papsUnder + ((hpaps.dupVals hdup).dropVal hdrop)⟩ + +theorem runCode_order_of_reuses_eq {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store store' : Store} {env : List RVal} {code : Code} {value : RVal} + (horder : AllocationOrderInvariant store) + (henv : ValuesInBounds store env) + (hreuses : store'.reuses = store.reuses) + (heval : runCode ctx fuel cur store env code = .ok (store', value)) : + AllocationOrderInvariant store' ∧ ValueInBounds store' value := by + have result := (orderAt fuel).1 ctx cur store env code store' value + horder henv hreuses heval + exact ⟨result.order, result.valueInBounds⟩ + +/-- The same dynamic no-reuse premise preserves strict PAP shape. -/ +theorem runCode_papsUnder_of_reuses_eq {ctx : Ctx} {fuel : Nat} + {cur : FnDef} {store store' : Store} {env : List RVal} {code : Code} + {value : RVal} (horder : AllocationOrderInvariant store) + (henv : ValuesInBounds store env) (hpaps : PAPsUnder store) + (hreuses : store'.reuses = store.reuses) + (heval : runCode ctx fuel cur store env code = .ok (store', value)) : + PAPsUnder store' := + ((orderAt fuel).1 ctx cur store env code store' value + horder henv hreuses heval).papsUnder hpaps + +/-- The operation-level projection of `runCode_order_of_reuses_eq`. This is +the compositional boundary used by local operation contracts: once a +primitive proves that it did not execute `reuse`, the shared evaluator +induction supplies allocation order and result boundedness. -/ +theorem runOp_order_of_reuses_eq {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store store' : Store} {env : List RVal} {op : Op} {value : RVal} + (horder : AllocationOrderInvariant store) + (henv : ValuesInBounds store env) + (hreuses : store'.reuses = store.reuses) + (heval : runOp ctx fuel cur store env op = .ok (store', value)) : + AllocationOrderInvariant store' ∧ ValueInBounds store' value := by + have result := (orderAt fuel).2.1 ctx cur store env op store' value + horder henv hreuses heval + exact ⟨result.order, result.valueInBounds⟩ + +theorem runOp_papsUnder_of_reuses_eq {ctx : Ctx} {fuel : Nat} + {cur : FnDef} {store store' : Store} {env : List RVal} {op : Op} + {value : RVal} (horder : AllocationOrderInvariant store) + (henv : ValuesInBounds store env) (hpaps : PAPsUnder store) + (hreuses : store'.reuses = store.reuses) + (heval : runOp ctx fuel cur store env op = .ok (store', value)) : + PAPsUnder store' := + ((orderAt fuel).2.1 ctx cur store env op store' value + horder henv hreuses heval).papsUnder hpaps + +/-- Declared-call projection of the allocation-order induction. Exposing +this alongside the code and operation forms lets run-indexed cost contracts +sequence a dynamically selected callee without rebuilding the evaluator +induction. -/ +theorem invoke_order_of_reuses_eq {ctx : Ctx} {fuel : Nat} + {address : Ixon.Address} {args : List RVal} {store store' : Store} + {value : RVal} (horder : AllocationOrderInvariant store) + (hargs : ValuesInBounds store args) + (hreuses : store'.reuses = store.reuses) + (heval : invoke ctx fuel address args store = .ok (store', value)) : + AllocationOrderInvariant store' ∧ ValueInBounds store' value := by + have result := (orderAt fuel).2.2.1 ctx address args store store' value + horder hargs hreuses heval + exact ⟨result.order, result.valueInBounds⟩ + +theorem invoke_papsUnder_of_reuses_eq {ctx : Ctx} {fuel : Nat} + {address : Ixon.Address} {args : List RVal} {store store' : Store} + {value : RVal} (horder : AllocationOrderInvariant store) + (hargs : ValuesInBounds store args) (hpaps : PAPsUnder store) + (hreuses : store'.reuses = store.reuses) + (heval : invoke ctx fuel address args store = .ok (store', value)) : + PAPsUnder store' := + ((orderAt fuel).2.2.1 ctx address args store store' value + horder hargs hreuses heval).papsUnder hpaps + +/-- Higher-order-application projection of the allocation-order induction. -/ +theorem applyGo_order_of_reuses_eq {ctx : Ctx} {fuel : Nat} + {store store' : Store} {function : RVal} {args : List RVal} + {value : RVal} (horder : AllocationOrderInvariant store) + (hfunction : ValueInBounds store function) + (hargs : ValuesInBounds store args) + (hreuses : store'.reuses = store.reuses) + (heval : applyGo ctx fuel store function args = .ok (store', value)) : + AllocationOrderInvariant store' ∧ ValueInBounds store' value := by + have result := (orderAt fuel).2.2.2 ctx store function args store' value + horder hfunction hargs hreuses heval + exact ⟨result.order, result.valueInBounds⟩ + +theorem applyGo_papsUnder_of_reuses_eq {ctx : Ctx} {fuel : Nat} + {store store' : Store} {function : RVal} {args : List RVal} + {value : RVal} (horder : AllocationOrderInvariant store) + (hfunction : ValueInBounds store function) + (hargs : ValuesInBounds store args) (hpaps : PAPsUnder store) + (hreuses : store'.reuses = store.reuses) + (heval : applyGo ctx fuel store function args = .ok (store', value)) : + PAPsUnder store' := + ((orderAt fuel).2.2.2 ctx store function args store' value + horder hfunction hargs hreuses heval).papsUnder hpaps + +/-- A fresh successful evaluator run with zero executed reuses is +allocation-ordered. No syntactic no-reuse scan is required: monotonicity of +the counter proves that every dynamically reached operation was append-only. +-/ +theorem runMain_order_of_reuses_eq_zero {ctx : Ctx} {fuel : Nat} + {code : Code} {store : Store} {value : RVal} + (heval : runMain ctx code fuel = .ok (store, value)) + (hreuses : store.reuses = 0) : + AllocationOrderInvariant store ∧ ValueInBounds store value := by + have result := (orderAt fuel).1 ctx ⟨0, .shared, false, code⟩ + ({} : Store) [] code + store value AllocationOrderInvariant.empty + (ValuesInBounds.nil ({} : Store)) hreuses heval + exact ⟨result.order, result.valueInBounds⟩ + +/-! ## Final-root release + +These are the reusable bridge from the existing exact-ownership simulation +to concrete leak freedom. The ownership proof consumes the sole root; the +parallel trace proof preserves allocation order; the empty-root theorem then +rules out every remaining slot. +-/ + +theorem shared_release_live_eq_zero {ctx : Ctx} {fuel : Nat} + {store released : Store} {value : RVal} + (hown : RootOwnership store [⟨.shared, value⟩]) + (horder : AllocationOrderInvariant store) + (heval : dropVal ctx fuel store value = .ok released) : + released.live = 0 := by + apply live_eq_zero_of_empty_roots + · exact Sim.dropVal_preserves hown heval + · exact horder.dropVal heval + +theorem unique_release_live_eq_zero {ctx : Ctx} {fuel : Nat} + {store released : Store} {value : RVal} + (hown : RootOwnership store [⟨.unique, value⟩]) + (horder : AllocationOrderInvariant store) + (heval : dropUVal ctx fuel store value = .ok released) : + released.live = 0 := by + apply live_eq_zero_of_empty_roots + · exact Sim.dropUVal_preserves hown heval + · exact horder.dropUVal heval + +/-- A well-owned, allocation-ordered shared result always has enough release +fuel, and that release empties the concrete heap. -/ +theorem shared_reclamation {ctx : Ctx} {store : Store} {value : RVal} + (hown : RootOwnership store [⟨.shared, value⟩]) + (horder : AllocationOrderInvariant store) : + ∃ fuel released, + dropVal ctx fuel store value = .ok released ∧ released.live = 0 := by + obtain ⟨fuel, released, heval, _⟩ := + dropVal_progress (ctx := ctx) hown + exact ⟨fuel, released, heval, + shared_release_live_eq_zero hown horder heval⟩ + +/-- The corresponding theorem for a unique final result. -/ +theorem unique_reclamation {ctx : Ctx} {store : Store} {value : RVal} + (hown : RootOwnership store [⟨.unique, value⟩]) + (horder : AllocationOrderInvariant store) : + ∃ fuel released, + dropUVal ctx fuel store value = .ok released ∧ released.live = 0 := by + obtain ⟨fuel, released, heval, _⟩ := + dropUVal_progress (ctx := ctx) hown + exact ⟨fuel, released, heval, + unique_release_live_eq_zero hown horder heval⟩ + +end Ix.Compiler.IxIR1.Reclamation diff --git a/Ix/Compiler/IxIR1/Serialize.lean b/Ix/Compiler/IxIR1/Serialize.lean new file mode 100644 index 000000000..7843d4ac4 --- /dev/null +++ b/Ix/Compiler/IxIR1/Serialize.lean @@ -0,0 +1,159 @@ +import Ix.Compiler.IxIR.Encoding +import Ix.Compiler.IxIR0.Serialize +import Ix.Compiler.IxIR1.Basic + +/-! +# IxIR₁ canonical hash preimages + +Every first-order operation, branch, and declaration has an explicit byte +spelling. The top-level declaration preimage is domain-separated as +`compilatrix/ixir1/decl/2`, followed by NUL and the declaration payload. Version +2 commits the owner-sensitive dynamic-PAP-entry bit on function declarations. +`callSelf` prevents an ordinary recursive function from placing its own digest +inside its preimage; other call and PAP edges retain exact 32-byte addresses. + +The mutually nested `Code`/`Alt` grammar is encoded with an explicit list walk, +matching the generated nested recursor while remaining executable by Lean's +code generator. +-/ + +namespace Ix.Compiler.IxIR1 + +open Ix.Compiler.Ixon (Address) +open Ix.Compiler.IxIR + +namespace Atom + +/-- Canonical atom payload. -/ +def bytes : Atom → ByteArray + | .var index => Encoding.tag 0 ++ Encoding.nat index + | .lit literal => Encoding.tag 1 ++ literal.bytes + | .erased => Encoding.tag 2 + +end Atom + +namespace CtorId + +/-- Canonical constructor identity. -/ +def bytes (cid : CtorId) : ByteArray := + Encoding.address cid.block ++ Encoding.nat cid.indIdx ++ + Encoding.nat cid.cidx + +end CtorId + +namespace Op + +/-- Canonical primitive-operation payload. -/ +def bytes : Op → ByteArray + | .pure atom => Encoding.tag 0 ++ atom.bytes + | .alloc world cid args => + Encoding.tag 1 ++ Encoding.tag world.toBits ++ cid.bytes ++ + Encoding.array Atom.bytes args + | .reuse target cid args => + Encoding.tag 2 ++ target.bytes ++ cid.bytes ++ + Encoding.array Atom.bytes args + | .free target => Encoding.tag 3 ++ target.bytes + | .dup target => Encoding.tag 4 ++ target.bytes + | .drop target => Encoding.tag 5 ++ target.bytes + | .dropU target => Encoding.tag 6 ++ target.bytes + | .fetch target field => + Encoding.tag 7 ++ target.bytes ++ Encoding.nat field + | .call function args => + Encoding.tag 8 ++ Encoding.address function ++ + Encoding.array Atom.bytes args + | .callSelf args => Encoding.tag 9 ++ Encoding.array Atom.bytes args + | .papp function args => + Encoding.tag 10 ++ Encoding.address function ++ + Encoding.array Atom.bytes args + | .apply function args => + Encoding.tag 11 ++ function.bytes ++ Encoding.array Atom.bytes args + | .extern function args => + Encoding.tag 12 ++ Encoding.address function ++ + Encoding.array Atom.bytes args + +end Op + +mutual + +/-- Canonical code payload. -/ +def Code.bytes : Code → ByteArray + | .ret atom => Encoding.tag 0 ++ atom.bytes + | .letOp op rest => Encoding.tag 1 ++ op.bytes ++ rest.bytes + | .case scrut peelNat alts => + Encoding.tag 2 ++ scrut.bytes ++ Encoding.bool peelNat ++ + Encoding.nat alts.size ++ AltList.bytes alts.toList + +/-- Canonical case-alternative payload. -/ +def Alt.bytes : Alt → ByteArray + | .mk cidx fields body => + Encoding.nat cidx ++ Encoding.nat fields ++ body.bytes + +/-- Executable order-preserving walk beneath an alternative array. -/ +def AltList.bytes : List Alt → ByteArray + | [] => ByteArray.empty + | head :: tail => head.bytes ++ AltList.bytes tail + +end + +namespace FnDef + +/-- Canonical saturated-function payload. -/ +def bytes (fn : FnDef) : ByteArray := + Encoding.nat fn.arity ++ Encoding.tag fn.result.toBits ++ + Encoding.bool fn.papSafe ++ fn.body.bytes + +end FnDef + +namespace Decl + +/-- The versioned domain prefix for IxIR₁ declaration identities. -/ +def addressDomain : ByteArray := + Encoding.domain "compilatrix/ixir1/decl/2" ++ Encoding.tag 0 + +/-- Canonical declaration payload, without the address domain. -/ +def payloadBytes : Decl → ByteArray + | .fn definition => Encoding.tag 0 ++ definition.bytes + | .extern arity => Encoding.tag 1 ++ Encoding.nat arity + +/-- Complete canonical hash preimage for one IxIR₁ declaration. -/ +def preimage (decl : Decl) : ByteArray := + addressDomain ++ payloadBytes decl + +/-- BLAKE3 content address of an IxIR₁ declaration. -/ +def address (decl : Decl) : Address := + Address.blake3 decl.preimage + +/-- Pair a declaration with its computed content address. -/ +def addressed (decl : Decl) : Address × Decl := + (decl.address, decl) + +/-- Address equality exposes byte identity under exactly the pairwise +collision premise for these two preimages. -/ +theorem address_eq_iff_preimage_eq (left right : Decl) + (hcollision : Address.Blake3NoCollision left.preimage right.preimage) : + left.address = right.address ↔ left.preimage = right.preimage := by + constructor + · exact hcollision + · intro h + simp only [address] + rw [h] + +@[simp] theorem addressed_fst (decl : Decl) : decl.addressed.1 = decl.address := + rfl + +@[simp] theorem addressed_snd (decl : Decl) : decl.addressed.2 = decl := + rfl + +end Decl + +/-! Small format-freezing structural vectors; BLAKE3 vectors live in the +compiled test executable because the current hash implementation is FFI. -/ + +#guard Atom.bytes (.lit (.nat 128)) == ByteArray.mk #[1, 0, 128, 1] +#guard Code.bytes (.case .erased false #[.mk 0 0 (.ret .erased)]) == + ByteArray.mk #[2, 2, 0, 1, 0, 0, 0, 2] +#guard Decl.payloadBytes (.fn ⟨1, .shared, true, .ret (.var 0)⟩) == + ByteArray.mk #[0, 1, 1, 1, 0, 0, 0] +#guard Decl.payloadBytes (.extern 128) == ByteArray.mk #[1, 128, 1] + +end Ix.Compiler.IxIR1 diff --git a/Ix/Compiler/IxIR1/Sim.lean b/Ix/Compiler/IxIR1/Sim.lean new file mode 100644 index 000000000..ec3d7dd13 --- /dev/null +++ b/Ix/Compiler/IxIR1/Sim.lean @@ -0,0 +1,6882 @@ +import Ix.Compiler.IxIR1.Eval +import Ix.Compiler.IxIR0.Eval + +/-! +# IxIR₀ → IxIR₁ memory-simulation foundations + +This file separates the four relations needed by the lowering proof: + +1. `ValueGraph` realizes a pure IxIR₀ value at an IxIR₁ scalar or live + heap root. Function-shaped values use an explicit correspondence oracle; + constructor data is checked recursively. +2. `RootOwnership` states the exact ownership equation for a multiset of + live roots. Shared refcounts equal incoming roots plus heap edges; unique + nodes have one incoming owner. Edges and roots remain in one ownership + world, and pap nodes are shared. +3. `HeapIso` identifies live heaps through a finite partial bijection of + locations. Dead slots and cost counters are intentionally absent. +4. `StoreGraphExtends` preserves existing node shapes while allowing RC-only + updates and unrelated allocation, so semantic graphs can survive ordinary + memory-management steps without demanding full heap isomorphism. + +The primitive lemmas below this foundation are the first layer of the formal +IxIR₀ → IxIR₁ simulation. They are kept independent of lowering so the +later compiler induction can reuse them for hand-written and generated code. +-/ + +namespace Ix.Compiler.IxIR1.Sim + +open Ix.Compiler.Ixon (Address Owned) +open Ix.Compiler.IxIR0 (Literal) + +/-! ## Pure values realized by a heap graph -/ + +/-- The lowering-specific correspondence for function-shaped values. +`captures` are the pure values stored in the target pap node. Lambda lifting +and known heads will instantiate this oracle in the compiler theorem. -/ +abbrev FunctionRel := + IxIR0.Value → Address → Nat → List IxIR0.Value → Prop + +mutual + + /-- A pure IxIR₀ value realized by an IxIR₁ scalar or live heap node. -/ + inductive ValueGraph (funRel : FunctionRel) (store : Store) : + IxIR0.Value → RVal → Prop where + | lit {l : Literal} : ValueGraph funRel store (.lit l) (.lit l) + | erased : ValueGraph funRel store .erased .erased + | ctor {adr : Address} {tag : Nat} {args : List IxIR0.Value} + {loc : Nat} {world : Owned} {rc : Nat} {cid : CtorId} + {fields : Array RVal} : + store.get? loc = some ⟨world, rc, .ctorN cid fields⟩ → + cid.block = adr → + cid.cidx = tag → + ValuesGraph funRel store args fields.toList → + ValueGraph funRel store (.ctor adr tag args) (.loc loc) + | function {v : IxIR0.Value} {f : Address} {arity : Nat} + {captures : List IxIR0.Value} {loc rc : Nat} {args : Array RVal} : + store.get? loc = some ⟨.shared, rc, .papN f arity args⟩ → + funRel v f arity captures → + ValuesGraph funRel store captures args.toList → + ValueGraph funRel store v (.loc loc) + + /-- Pointwise realization of node fields or pap captures. -/ + inductive ValuesGraph (funRel : FunctionRel) (store : Store) : + List IxIR0.Value → List RVal → Prop where + | nil : ValuesGraph funRel store [] [] + | cons {v : IxIR0.Value} {rv : RVal} + {vs : List IxIR0.Value} {rvs : List RVal} : + ValueGraph funRel store v rv → + ValuesGraph funRel store vs rvs → + ValuesGraph funRel store (v :: vs) (rv :: rvs) + +end + +/-- Pointwise value graphs have equal source and runtime vector lengths. -/ +@[simp] theorem ValuesGraph.length {funRel : FunctionRel} {store : Store} : + ∀ {values : List IxIR0.Value} {runtimeValues : List RVal}, + ValuesGraph funRel store values runtimeValues → + values.length = runtimeValues.length + | _, _, .nil => rfl + | _, _, .cons _ tail => by simp [tail.length] + +/-- Pointwise value graphs concatenate in lockstep. -/ +theorem ValuesGraph.append {funRel : FunctionRel} {store : Store} + {sourceLeft sourceRight : List IxIR0.Value} + {runtimeLeft runtimeRight : List RVal} + (hleft : ValuesGraph funRel store sourceLeft runtimeLeft) + (hright : ValuesGraph funRel store sourceRight runtimeRight) : + ValuesGraph funRel store (sourceLeft ++ sourceRight) + (runtimeLeft ++ runtimeRight) := by + induction sourceLeft generalizing runtimeLeft with + | nil => + cases hleft + simpa using hright + | cons source sourceLeft ih => + cases hleft with + | cons hhead htail => exact .cons hhead (ih htail) + +/-- Pointwise value graphs are insensitive to reversing both vectors. -/ +theorem ValuesGraph.reverse {funRel : FunctionRel} {store : Store} + : ∀ {sourceValues : List IxIR0.Value} {runtimeValues : List RVal}, + ValuesGraph funRel store sourceValues runtimeValues → + ValuesGraph funRel store sourceValues.reverse runtimeValues.reverse + | _, _, .nil => .nil + | _, _, .cons hhead htail => by + simpa [List.reverse_cons] using + htail.reverse.append (ValuesGraph.cons hhead ValuesGraph.nil) + +/-- Split a pointwise graph at corresponding source/runtime prefixes. -/ +theorem ValuesGraph.splitAppend {funRel : FunctionRel} {store : Store} + {sourceLeft sourceRight : List IxIR0.Value} + {runtimeLeft runtimeRight : List RVal} + (hlength : sourceLeft.length = runtimeLeft.length) + (graph : ValuesGraph funRel store (sourceLeft ++ sourceRight) + (runtimeLeft ++ runtimeRight)) : + ValuesGraph funRel store sourceLeft runtimeLeft ∧ + ValuesGraph funRel store sourceRight runtimeRight := by + induction sourceLeft generalizing runtimeLeft with + | nil => + have hruntime : runtimeLeft = [] := + List.length_eq_zero_iff.mp hlength.symm + subst runtimeLeft + exact ⟨.nil, by simpa using graph⟩ + | cons source sourceLeft ih => + cases runtimeLeft with + | nil => simp at hlength + | cons runtime runtimeLeft => + simp only [List.length_cons, Nat.succ.injEq] at hlength + change ValuesGraph funRel store + (source :: (sourceLeft ++ sourceRight)) + (runtime :: (runtimeLeft ++ runtimeRight)) at graph + cases graph with + | cons hhead htail => + obtain ⟨hleft, hright⟩ := ih hlength htail + exact ⟨.cons hhead hleft, hright⟩ + +/-- Restrict a pointwise graph to equal numeric prefixes. -/ +theorem ValuesGraph.take {funRel : FunctionRel} {store : Store} + {sourceValues : List IxIR0.Value} {runtimeValues : List RVal} + (graph : ValuesGraph funRel store sourceValues runtimeValues) + (count : Nat) : + ValuesGraph funRel store (sourceValues.take count) + (runtimeValues.take count) := by + have hsource := List.take_append_drop count sourceValues + have hruntime := List.take_append_drop count runtimeValues + have hlength : (sourceValues.take count).length = + (runtimeValues.take count).length := by + simp [graph.length] + have hwhole : ValuesGraph funRel store + (sourceValues.take count ++ sourceValues.drop count) + (runtimeValues.take count ++ runtimeValues.drop count) := by + simpa [hsource, hruntime] using graph + exact (hwhole.splitAppend hlength).1 + +/-- Restrict a pointwise graph to corresponding suffixes. -/ +theorem ValuesGraph.drop {funRel : FunctionRel} {store : Store} + {sourceValues : List IxIR0.Value} {runtimeValues : List RVal} + (graph : ValuesGraph funRel store sourceValues runtimeValues) + (count : Nat) : + ValuesGraph funRel store (sourceValues.drop count) + (runtimeValues.drop count) := by + have hsource := List.take_append_drop count sourceValues + have hruntime := List.take_append_drop count runtimeValues + have hlength : (sourceValues.take count).length = + (runtimeValues.take count).length := by + simp [graph.length] + have hwhole : ValuesGraph funRel store + (sourceValues.take count ++ sourceValues.drop count) + (runtimeValues.take count ++ runtimeValues.drop count) := by + simpa [hsource, hruntime] using graph + exact (hwhole.splitAppend hlength).2 + +/-- One-way preservation of live heap shape. Existing live locations keep +their world and node contents, while reference counts may change and the +target store may contain additional live nodes. This is exactly the store +relation under which pure `ValueGraph`s remain valid. -/ +def StoreGraphExtends (before after : Store) : Prop := + ∀ {loc world rc node}, + before.get? loc = some ⟨world, rc, node⟩ → + ∃ rc', after.get? loc = some ⟨world, rc', node⟩ + +/-- Reverse shape inclusion used by destructive operations. Every node still +live afterward existed beforehand with the same world and contents, though +its reference count may differ. Dropped nodes may disappear. -/ +def StoreGraphRestricts (before after : Store) : Prop := + ∀ {loc world rc node}, + after.get? loc = some ⟨world, rc, node⟩ → + ∃ rc', before.get? loc = some ⟨world, rc', node⟩ + +theorem StoreGraphExtends.refl (store : Store) : + StoreGraphExtends store store := by + intro loc world rc node hget + exact ⟨rc, hget⟩ + +theorem StoreGraphExtends.trans {first middle last : Store} + (h₁ : StoreGraphExtends first middle) + (h₂ : StoreGraphExtends middle last) : + StoreGraphExtends first last := by + intro loc world rc node hget + obtain ⟨middleRc, hmiddle⟩ := h₁ hget + exact h₂ hmiddle + +theorem StoreGraphRestricts.refl (store : Store) : + StoreGraphRestricts store store := by + intro loc world rc node hget + exact ⟨rc, hget⟩ + +theorem StoreGraphRestricts.trans {first middle last : Store} + (h₁ : StoreGraphRestricts first middle) + (h₂ : StoreGraphRestricts middle last) : + StoreGraphRestricts first last := by + intro loc world rc node hget + obtain ⟨middleRc, hmiddle⟩ := h₂ hget + exact h₁ hmiddle + +theorem StoreGraphRestricts.rcTick (store : Store) : + StoreGraphRestricts store store.rcTick := by + intro loc world rc node hget + exact ⟨rc, by simpa [Store.rcTick, Store.get?] using hget⟩ + +/-- Pure value realization ignores refcount changes and survives allocation +of unrelated nodes. The mutual recursor transports constructor fields and pap +captures through the same store relation. -/ +theorem ValueGraph.monoStore {funRel : FunctionRel} + {before after : Store} (hstore : StoreGraphExtends before after) + {value : IxIR0.Value} {runtimeValue : RVal} + (graph : ValueGraph funRel before value runtimeValue) : + ValueGraph funRel after value runtimeValue := by + refine ValueGraph.rec + (motive_1 := fun value runtimeValue _ => + ValueGraph funRel after value runtimeValue) + (motive_2 := fun values runtimeValues _ => + ValuesGraph funRel after values runtimeValues) + ?_ ?_ ?_ ?_ ?_ ?_ graph + · intro literal + exact .lit + · exact .erased + · intro address tag args loc world rc cid fields hget haddress htag + _ hfields + obtain ⟨rc', hget'⟩ := hstore hget + exact .ctor hget' haddress htag hfields + · intro value address arity captures loc rc args hget hfun _ hcaptures + obtain ⟨rc', hget'⟩ := hstore hget + exact .function hget' hfun hcaptures + · exact .nil + · intro value runtimeValue values runtimeValues _ _ hvalue hvalues + exact .cons hvalue hvalues + +/-- Pointwise value realization survives the same shape-preserving store +extension as a single value. This companion is especially useful when an +allocation turns an already-related argument vector into node fields. -/ +theorem ValuesGraph.monoStore {funRel : FunctionRel} + {before after : Store} (hstore : StoreGraphExtends before after) + {values : List IxIR0.Value} {runtimeValues : List RVal} + (graphs : ValuesGraph funRel before values runtimeValues) : + ValuesGraph funRel after values runtimeValues := by + refine ValuesGraph.rec + (motive_1 := fun value runtimeValue _ => + ValueGraph funRel after value runtimeValue) + (motive_2 := fun values runtimeValues _ => + ValuesGraph funRel after values runtimeValues) + ?_ ?_ ?_ ?_ ?_ ?_ graphs + · intro literal + exact .lit + · exact .erased + · intro address tag args loc world rc cid fields hget haddress htag + _ hfields + obtain ⟨rc', hget'⟩ := hstore hget + exact .ctor hget' haddress htag hfields + · intro value address arity captures loc rc args hget hfun _ hcaptures + obtain ⟨rc', hget'⟩ := hstore hget + exact .function hget' hfun hcaptures + · exact .nil + · intro value runtimeValue values runtimeValues _ _ hvalue hvalues + exact .cons hvalue hvalues + +/-- Pointwise graph lookup: a successful source-list lookup identifies the +runtime value at the same position together with its `ValueGraph`. -/ +theorem ValuesGraph.get? {funRel : FunctionRel} {store : Store} + {sourceValues : List IxIR0.Value} {runtimeValues : List RVal} + (graphs : ValuesGraph funRel store sourceValues runtimeValues) + {index : Nat} {sourceValue : IxIR0.Value} + (hsource : sourceValues[index]? = some sourceValue) : + ∃ runtimeValue, + runtimeValues[index]? = some runtimeValue ∧ + ValueGraph funRel store sourceValue runtimeValue := by + induction index generalizing sourceValues runtimeValues with + | zero => + cases graphs with + | nil => simp at hsource + | cons hvalue htail => + simp only [List.getElem?_cons_zero, Option.some.injEq] at hsource + subst sourceValue + exact ⟨_, rfl, hvalue⟩ + | succ index ih => + cases graphs with + | nil => simp at hsource + | cons hvalue htail => + rw [List.getElem?_cons_succ] at hsource + obtain ⟨runtimeValue, hruntime, hvalue⟩ := ih htail hsource + exact ⟨runtimeValue, by simpa using hruntime, hvalue⟩ + +/-- Once successful target execution identifies a constructor node, a +constructor-shaped source graph recovers the pointwise field graph. The +extra target-node premise is essential because the abstract `FunctionRel` +may otherwise relate an arbitrary source value to a pap. -/ +theorem ValueGraph.ctor_fields_of_get + {funRel : FunctionRel} {store : Store} + {address : Address} {tag : Nat} {sourceFields : List IxIR0.Value} + {loc rc : Nat} {world : Owned} {cid : CtorId} + {fields : Array RVal} + (graph : ValueGraph funRel store + (.ctor address tag sourceFields) (.loc loc)) + (hget : store.get? loc = some ⟨world, rc, .ctorN cid fields⟩) : + cid.block = address ∧ cid.cidx = tag ∧ + ValuesGraph funRel store sourceFields fields.toList := by + cases graph with + | ctor hgraphGet haddress htag hfields => + have hbox := Option.some.inj (hgraphGet.symm.trans hget) + cases hbox + exact ⟨haddress, htag, hfields⟩ + | function hgraphGet hfun hcaptures => + have hbox := Option.some.inj (hgraphGet.symm.trans hget) + have hnode := congrArg NodeBox.node hbox + contradiction + +/-- Inversion at the erased scalar. Literal graphs carry their literal and +both located graphs produce `.loc`, so a target execution that yields +`RVal.erased` pins the source side exactly. Note the converse fails: the +abstract `FunctionRel` may relate the source erased value to a pap node. -/ +theorem ValueGraph.eq_erased_of_erased {funRel : FunctionRel} {store : Store} + {sourceValue : IxIR0.Value} + (graph : ValueGraph funRel store sourceValue .erased) : + sourceValue = .erased := by + cases graph + rfl + +/-! ## Roots and exact ownership -/ + +/-- One external heap owner, annotated with the world in which it may be +consumed. Scalars carry no heap ownership but are valid in either world. -/ +structure Root where + world : Owned + value : RVal + deriving BEq, Repr + +/-- Scalars inhabit either world; a location inhabits the world stored in its +live `NodeBox`. -/ +def HasWorld (store : Store) (world : Owned) : RVal → Prop + | .loc loc => ∃ box, store.get? loc = some box ∧ box.world = world + | .lit _ | .erased => True + +/-- Heap-world evidence is monotone under shape-preserving store extension. -/ +theorem HasWorld.monoStore {before after : Store} + (hstore : StoreGraphExtends before after) + {world : Owned} {value : RVal} + (h : HasWorld before world value) : HasWorld after world value := by + cases value with + | loc loc => + obtain ⟨box, hget, hworld⟩ := h + cases box with + | mk boxWorld rc node => + obtain ⟨rc', hget'⟩ := hstore hget + exact ⟨⟨boxWorld, rc', node⟩, hget', hworld⟩ + | lit literal => trivial + | erased => trivial + +/-- The evaluator's executable result-world check is exactly the +propositional world predicate used by the memory simulation. -/ +theorem rval_hasWorld_eq_true_iff {store : Store} {world : Owned} + {value : RVal} : + RVal.hasWorld store world value = true ↔ HasWorld store world value := by + cases value with + | lit l => simp [RVal.hasWorld, HasWorld] + | erased => simp [RVal.hasWorld, HasWorld] + | loc loc => + simp only [RVal.hasWorld, HasWorld] + cases hbox : store.get? loc with + | none => simp + | some box => + simp only [Option.some.injEq, exists_eq_left'] + cases box.world <;> cases world <;> decide + +/-- Any successful dynamic result-boundary check returns the same value +and establishes its declared world. -/ +theorem checkResultWorld_ok {world : Owned} {out out' : Store × RVal} + (h : checkResultWorld world out = .ok out') : + out' = out ∧ HasWorld out.1 world out.2 := by + simp only [checkResultWorld] at h + split at h + next hw => + simp only [Except.ok.injEq] at h + subst out' + exact ⟨rfl, rval_hasWorld_eq_true_iff.mp hw⟩ + next => contradiction + +/-- Successful ownership-aware main execution exposes both its literal body +run and the checked result-world witness. This is the top-level analogue of +`invoke_fn_result_hasWorld`, with the exact synthetic current function kept +available to structured lowering simulations. -/ +theorem runOwnedMain_ok {ctx : Ctx} {world : Owned} {code : Code} + {fuel : Nat} {out : Store × RVal} + (run : runOwnedMain ctx world code fuel = .ok out) : + runCode ctx fuel ⟨0, world, false, code⟩ ({} : Store) [] code = + .ok out ∧ + HasWorld out.1 world out.2 := by + unfold runOwnedMain at run + cases bodyRun : + runCode ctx fuel ⟨0, world, false, code⟩ ({} : Store) [] code with + | error error => + simp only [bodyRun, bind, Except.bind] at run + contradiction + | ok bodyOut => + have checked : checkResultWorld world bodyOut = .ok out := by + simpa only [bodyRun, bind, Except.bind] using run + obtain ⟨outputEq, resultWorld⟩ := checkResultWorld_ok checked + subst out + exact ⟨rfl, resultWorld⟩ + +/-- A successful call to a function declaration returns a scalar or a +live location in the `FnDef.result` world. This is the first reusable +call-result ownership contract for the compiler simulation. -/ +theorem invoke_fn_result_hasWorld {ctx : Ctx} {fuel : Nat} + {f : Address} {args : List RVal} {store store' : Store} + {value : RVal} {d : FnDef} + (hdecl : ctx.decls f = some (.fn d)) + (hinvoke : invoke ctx fuel f args store = .ok (store', value)) : + HasWorld store' d.result value := by + cases fuel with + | zero => simp [invoke] at hinvoke + | succ fuel => + simp only [invoke, hdecl] at hinvoke + split at hinvoke + · contradiction + · cases hrun : runCode ctx fuel d store args.reverse d.body with + | error e => + rw [hrun] at hinvoke + change (.error e : Except Err (Store × RVal)) = + .ok (store', value) at hinvoke + contradiction + | ok out => + rw [hrun] at hinvoke + change checkResultWorld d.result out = .ok (store', value) at hinvoke + obtain ⟨hpair, hw⟩ := checkResultWorld_ok hinvoke + subst out + exact hw + +/-- Every successful invocation supplied exactly the declaration arity, +independently of whether the target is a function or scalar extern. -/ +theorem invoke_success_length {ctx : Ctx} {fuel : Nat} {f : Address} + {args : List RVal} {store store' : Store} {value : RVal} {d : Decl} + (hdecl : ctx.decls f = some d) + (hinvoke : invoke ctx fuel f args store = .ok (store', value)) : + args.length = declArity d := by + cases fuel with + | zero => simp [invoke] at hinvoke + | succ fuel => + cases d <;> simp only [invoke, hdecl] at hinvoke + all_goals + split at hinvoke + next hne => contradiction + next heq => simpa [declArity] using heq + +/-- Source values with ownership demands, realized by target roots. -/ +inductive RootsGraph (funRel : FunctionRel) (store : Store) : + List (Owned × IxIR0.Value) → List Root → Prop where + | nil : RootsGraph funRel store [] [] + | cons {world : Owned} {v : IxIR0.Value} {root : Root} + {vs : List (Owned × IxIR0.Value)} {roots : List Root} : + root.world = world → + HasWorld store world root.value → + ValueGraph funRel store v root.value → + RootsGraph funRel store vs roots → + RootsGraph funRel store ((world, v) :: vs) (root :: roots) + +@[simp] theorem RootsGraph.lengths {funRel : FunctionRel} {store : Store} + {sourceRoots : List (Owned × IxIR0.Value)} {roots : List Root} + (graph : RootsGraph funRel store sourceRoots roots) : + sourceRoots.length = roots.length := by + induction graph <;> simp_all + +/-- Concatenate two independently related root frames. -/ +theorem RootsGraph.append {funRel : FunctionRel} {store : Store} + {sourceLeft sourceRight : List (Owned × IxIR0.Value)} + {left right : List Root} + (hleft : RootsGraph funRel store sourceLeft left) + (hright : RootsGraph funRel store sourceRight right) : + RootsGraph funRel store (sourceLeft ++ sourceRight) (left ++ right) := by + induction hleft with + | nil => simpa using hright + | cons hrootWorld hworld hvalue _ ih => + exact .cons hrootWorld hworld hvalue ih + +/-- Split a related concatenated frame at a prefix whose source/runtime +lengths agree. The length premise prevents an arbitrary mismatched cut from +dividing the two lockstep lists at different positions. -/ +theorem RootsGraph.splitAppend {funRel : FunctionRel} {store : Store} + {sourceLeft sourceRight : List (Owned × IxIR0.Value)} + {left right : List Root} + (hlength : sourceLeft.length = left.length) + (graph : RootsGraph funRel store + (sourceLeft ++ sourceRight) (left ++ right)) : + RootsGraph funRel store sourceLeft left ∧ + RootsGraph funRel store sourceRight right := by + induction sourceLeft generalizing left with + | nil => + have hleft : left = [] := List.length_eq_zero_iff.mp hlength.symm + subst left + exact ⟨.nil, by simpa using graph⟩ + | cons source sourceLeft ih => + cases left with + | nil => simp at hlength + | cons root left => + rcases source with ⟨world, value⟩ + simp only [List.length_cons, Nat.succ.injEq] at hlength + change RootsGraph funRel store + ((world, value) :: (sourceLeft ++ sourceRight)) + (root :: (left ++ right)) at graph + cases graph with + | cons hrootWorld hworld hvalue htail => + obtain ⟨hprefix, hsuffix⟩ := ih hlength htail + exact ⟨.cons hrootWorld hworld hvalue hprefix, hsuffix⟩ + +/-- Root-list realization is monotone under the same heap-shape extension as +individual values. Root worlds and runtime values remain unchanged. -/ +theorem RootsGraph.monoStore {funRel : FunctionRel} + {before after : Store} (hstore : StoreGraphExtends before after) + {values : List (Owned × IxIR0.Value)} {roots : List Root} + (graph : RootsGraph funRel before values roots) : + RootsGraph funRel after values roots := by + induction graph with + | nil => exact .nil + | cons hworld hhasWorld hvalue _ ih => + exact .cons hworld (hhasWorld.monoStore hstore) + (hvalue.monoStore hstore) ih + +/-- The child references owned by a live node. -/ +def nodeChildren : Node → List RVal + | .ctorN _ fields => fields.toList + | .papN _ _ args => args.toList + +/-- Extract a location reference, ignoring scalars. -/ +def rvalLocation? : RVal → Option Nat + | .loc loc => some loc + | .lit _ | .erased => none + +def rootLocation? (root : Root) : Option Nat := rvalLocation? root.value + +/-- Location-owning edges contributed by one store slot. -/ +def slotEdgeLocations : Option NodeBox → List Nat + | none => [] + | some box => (nodeChildren box.node).filterMap rvalLocation? + +/-- All location-owning edges of live heap nodes. Dead slots contribute no +owners. Multiplicity is retained. -/ +def edgeLocations (store : Store) : List Nat := + store.nodes.toList.flatMap slotEdgeLocations + +/-- Incoming ownership multiplicity at `loc`: external roots plus live heap +edges. -/ +def incoming (store : Store) (roots : List Root) (loc : Nat) : Nat := + ((roots.filterMap rootLocation?) ++ edgeLocations store).count loc + +/-- Exact root/edge ownership invariant. Cost counters and dead slots do not +participate in it. -/ +structure RootOwnership (store : Store) (roots : List Root) : Prop where + roots_world : ∀ root ∈ roots, HasWorld store root.world root.value + edges_world : ∀ {loc box}, store.get? loc = some box → + ∀ child ∈ nodeChildren box.node, HasWorld store box.world child + pap_shared : ∀ {loc box f arity args}, + store.get? loc = some box → box.node = .papN f arity args → + box.world = .shared + counts : ∀ {loc box}, store.get? loc = some box → + match box.world with + | .shared => box.rc = incoming store roots loc + | .unique => box.rc = 1 ∧ incoming store roots loc = 1 + +/-- Exact ownership depends on the root multiset, not its presentation order. +Compiler environments use an ordered list, so moving an arbitrary source +entry to the distinguished result position relies on this bridge. -/ +theorem RootOwnership.perm {store : Store} {roots roots' : List Root} + (h : RootOwnership store roots) (hp : roots.Perm roots') : + RootOwnership store roots' := by + refine ⟨?_, h.edges_world, h.pap_shared, ?_⟩ + · intro root hroot + exact h.roots_world root (hp.mem_iff.mpr hroot) + · intro loc box hbox + have hcount := ((hp.filterMap rootLocation?).append_right + (edgeLocations store)).count_eq loc + have hincoming : incoming store roots loc = incoming store roots' loc := by + simpa [incoming] using hcount + rw [← hincoming] + exact h.counts hbox + +/-- A graph rooted at a value that remains live after a destructive store +restriction can be rebuilt in the post-state. Exact post-state ownership +supplies liveness for every recursive node edge. -/ +theorem ValueGraph.ofRestricts {funRel : FunctionRel} + {before after : Store} (hstore : StoreGraphRestricts before after) + {roots : List Root} (hown : RootOwnership after roots) + {value : IxIR0.Value} {runtimeValue : RVal} {world : Owned} + (hworld : HasWorld after world runtimeValue) + (graph : ValueGraph funRel before value runtimeValue) : + ValueGraph funRel after value runtimeValue := by + refine ValueGraph.rec + (motive_1 := fun source runtime _ => ∀ {supportWorld : Owned}, + HasWorld after supportWorld runtime → + ValueGraph funRel after source runtime) + (motive_2 := fun sources runtimes _ => ∀ {supportWorld : Owned}, + (∀ runtime, runtime ∈ runtimes → + HasWorld after supportWorld runtime) → + ValuesGraph funRel after sources runtimes) + ?_ ?_ ?_ ?_ ?_ ?_ graph hworld + · intro literal supportWorld _ + exact .lit + · intro supportWorld _ + exact .erased + · intro address tag args loc nodeWorld rc cid fields hget haddress htag + _ hfields supportWorld hlive + obtain ⟨afterBox, hafter, hafterWorld⟩ := hlive + rcases afterBox with ⟨afterWorld, afterRc, afterNode⟩ + change afterWorld = supportWorld at hafterWorld + subst supportWorld + obtain ⟨beforeRc, hbefore⟩ := hstore hafter + have hboxEq : + (⟨afterWorld, beforeRc, afterNode⟩ : NodeBox) = + ⟨nodeWorld, rc, .ctorN cid fields⟩ := + Option.some.inj (hbefore.symm.trans hget) + cases hboxEq + apply ValueGraph.ctor hafter haddress htag + apply hfields + intro child hchild + exact hown.edges_world hafter child + (by simpa [nodeChildren] using hchild) + · intro source address arity captures loc rc args hget hfun + _ hcaptures supportWorld hlive + obtain ⟨afterBox, hafter, hafterWorld⟩ := hlive + rcases afterBox with ⟨afterWorld, afterRc, afterNode⟩ + change afterWorld = supportWorld at hafterWorld + subst supportWorld + obtain ⟨beforeRc, hbefore⟩ := hstore hafter + have hboxEq : + (⟨afterWorld, beforeRc, afterNode⟩ : NodeBox) = + ⟨.shared, rc, .papN address arity args⟩ := + Option.some.inj (hbefore.symm.trans hget) + cases hboxEq + apply ValueGraph.function hafter hfun + apply hcaptures + intro child hchild + exact hown.edges_world hafter child + (by simpa [nodeChildren] using hchild) + · intro supportWorld _ + exact .nil + · intro source runtime sources runtimes _ _ hsource hsources + supportWorld hall + exact .cons + (hsource (hall runtime (by simp))) + (hsources (fun child hchild => hall child (by simp [hchild]))) + +private theorem rootsGraph_ofRestrictsSubset {funRel : FunctionRel} + {before after : Store} (hstore : StoreGraphRestricts before after) + {allRoots : List Root} (hown : RootOwnership after allRoots) + {sourceRoots : List (Owned × IxIR0.Value)} {roots : List Root} + (graphs : RootsGraph funRel before sourceRoots roots) : + (∀ root, root ∈ roots → root ∈ allRoots) → + RootsGraph funRel after sourceRoots roots := by + induction graphs with + | nil => + intro _ + exact .nil + | @cons world value root sourceTail rootTail hrootWorld _ hvalue + htail ih => + intro hsubset + have hrootLive : HasWorld after world root.value := by + have hrootWorld' := hown.roots_world root + (hsubset root (by simp)) + simpa [hrootWorld] using hrootWorld' + exact .cons hrootWorld hrootLive + (hvalue.ofRestricts hstore hown hrootLive) + (ih (fun candidate hmember => + hsubset candidate (by simp [hmember]))) + +theorem RootsGraph.ofRestrictsIn {funRel : FunctionRel} + {before after : Store} (hstore : StoreGraphRestricts before after) + {allRoots : List Root} (hown : RootOwnership after allRoots) + {sourceRoots : List (Owned × IxIR0.Value)} {roots : List Root} + (hsubset : ∀ root, root ∈ roots → root ∈ allRoots) + (graphs : RootsGraph funRel before sourceRoots roots) : + RootsGraph funRel after sourceRoots roots := + rootsGraph_ofRestrictsSubset hstore hown graphs hsubset + +/-- Every semantically related root in a surviving root list keeps its graph +under a destructive shape restriction. -/ +theorem RootsGraph.ofRestricts {funRel : FunctionRel} + {before after : Store} (hstore : StoreGraphRestricts before after) + {sourceRoots : List (Owned × IxIR0.Value)} {roots : List Root} + (hown : RootOwnership after roots) + (graphs : RootsGraph funRel before sourceRoots roots) : + RootsGraph funRel after sourceRoots roots := + graphs.ofRestrictsIn hstore hown (fun _ => id) + +/-- Pointwise source values survive a destructive restriction whenever each +runtime value is still represented by some root in the post-state ownership +set. The supporting root's world is existential because `ValuesGraph` itself +is intentionally world-agnostic. -/ +theorem ValuesGraph.ofRestrictsIn {funRel : FunctionRel} + {before after : Store} (hstore : StoreGraphRestricts before after) + {allRoots : List Root} (hown : RootOwnership after allRoots) + {sourceValues : List IxIR0.Value} {runtimeValues : List RVal} + (hsupport : ∀ runtime, runtime ∈ runtimeValues → + ∃ world, (⟨world, runtime⟩ : Root) ∈ allRoots) + (graphs : ValuesGraph funRel before sourceValues runtimeValues) : + ValuesGraph funRel after sourceValues runtimeValues := by + refine ValuesGraph.rec + (motive_1 := fun _ _ _ => True) + (motive_2 := fun sources runtimes _ => + (∀ runtime, runtime ∈ runtimes → + ∃ world, (⟨world, runtime⟩ : Root) ∈ allRoots) → + ValuesGraph funRel after sources runtimes) + ?_ ?_ ?_ ?_ ?_ ?_ graphs hsupport + · intro _ + trivial + · trivial + · simp + · simp + · intro _ + exact .nil + · intro source runtime sources runtimes hvalue _ _ htail + intro hremaining + obtain ⟨world, hroot⟩ := hremaining runtime (by simp) + exact .cons + (hvalue.ofRestricts hstore hown + (hown.roots_world ⟨world, runtime⟩ hroot)) + (htail (fun child hchild => + hremaining child (by simp [hchild]))) + +theorem RootOwnership.empty : RootOwnership ({} : Store) [] := by + refine ⟨?_, ?_, ?_, ?_⟩ + · simp + · intro loc box hbox + simp [Store.get?] at hbox + · intro loc box f arity args hbox + simp [Store.get?] at hbox + · intro loc box hbox + simp [Store.get?] at hbox + +/-- Every heap edge points to a live node. This is separated from exact owner +counts so graph closure can also be used by location isomorphism. -/ +def LiveRVal (store : Store) : RVal → Prop + | .loc loc => ∃ box, store.get? loc = some box + | .lit _ | .erased => True + +def StoreClosed (store : Store) : Prop := + ∀ {loc box}, store.get? loc = some box → + ∀ child ∈ nodeChildren box.node, LiveRVal store child + +theorem RootOwnership.storeClosed {store : Store} {roots : List Root} + (h : RootOwnership store roots) : StoreClosed store := by + intro loc box hbox child hchild + have hw := h.edges_world hbox child hchild + cases child with + | loc childLoc => + obtain ⟨childBox, hlive, _⟩ := hw + exact ⟨childBox, hlive⟩ + | lit l => trivial + | erased => trivial + +/-- Roots consumed as the fields/captures of one freshly allocated node. -/ +def rootsFor (world : Owned) (values : List RVal) : List Root := + values.map fun value => ⟨world, value⟩ + +/-- Roots for a heterogeneous function telescope. The arity equality in +`FnOwnershipContract` rules out the truncating mismatch cases. -/ +def rootsForWorlds : List Owned → List RVal → List Root + | world :: worlds, value :: values => + ⟨world, value⟩ :: rootsForWorlds worlds values + | _, _ => [] + +/-- Turn a pointwise value graph into a homogeneous root frame once every +runtime value is known live in the chosen ownership world. -/ +theorem ValuesGraph.rootsGraph {funRel : FunctionRel} {store : Store} + {sourceValues : List IxIR0.Value} {runtimeValues : List RVal} + (world : Owned) + (graphs : ValuesGraph funRel store sourceValues runtimeValues) + (hworld : ∀ runtime, runtime ∈ runtimeValues → + HasWorld store world runtime) : + RootsGraph funRel store + (sourceValues.map fun value => (world, value)) + (rootsFor world runtimeValues) := by + induction sourceValues generalizing runtimeValues with + | nil => + cases graphs + exact .nil + | cons source sources ih => + cases graphs with + | cons hvalue hvalues => + simp only [List.map_cons, rootsFor] + exact RootsGraph.cons rfl + (hworld _ (by simp)) hvalue + (ih hvalues (fun candidate hmember => + hworld candidate (by simp [hmember]))) + +/-- Forget the homogeneous ownership annotations of a root frame, recovering +the underlying pointwise value graph. -/ +theorem RootsGraph.valuesGraph {funRel : FunctionRel} {store : Store} + {sourceValues : List IxIR0.Value} {runtimeValues : List RVal} + {world : Owned} + (graphs : RootsGraph funRel store + (sourceValues.map fun value => (world, value)) + (rootsFor world runtimeValues)) : + ValuesGraph funRel store sourceValues runtimeValues := by + induction sourceValues generalizing runtimeValues with + | nil => + cases runtimeValues with + | nil => exact .nil + | cons runtime runtimes => cases graphs + | cons source sources ih => + cases runtimeValues with + | nil => cases graphs + | cons runtime runtimes => + simp only [List.map_cons, rootsFor] at graphs + cases graphs with + | cons _ _ hvalue htail => exact .cons hvalue (ih htail) + +/-- With matching telescope lengths, every runtime value occurs in the +heterogeneous root list at the world paired with one of its positions. -/ +theorem exists_root_mem_rootsForWorlds + {worlds : List Owned} {values : List RVal} + (hlength : worlds.length = values.length) + {value : RVal} (hvalue : value ∈ values) : + ∃ world, (⟨world, value⟩ : Root) ∈ + rootsForWorlds worlds values := by + induction values generalizing worlds with + | nil => simp at hvalue + | cons head tail ih => + cases worlds with + | nil => simp at hlength + | cons world worlds => + simp only [List.length_cons, Nat.succ.injEq] at hlength + rcases List.mem_cons.mp hvalue with rfl | htail + · exact ⟨world, by simp [rootsForWorlds]⟩ + · obtain ⟨foundWorld, hfound⟩ := ih hlength htail + exact ⟨foundWorld, by simp [rootsForWorlds, hfound]⟩ + +@[simp] theorem rootsForWorlds_cons (world : Owned) (worlds : List Owned) + (value : RVal) (values : List RVal) : + rootsForWorlds (world :: worlds) (value :: values) = + ⟨world, value⟩ :: rootsForWorlds worlds values := rfl + +/-- The semantic ownership obligation attached to one lowered function. +The argument worlds come from the corresponding IxIR₀ lambda telescope; +`FnDef` stores only the arity and result world. A future whole-program +compiler theorem will construct one contract per lowered declaration. -/ +structure FnOwnershipContract (ctx : Ctx) (d : FnDef) + (argWorlds : List Owned) : Prop where + arity_eq : argWorlds.length = d.arity + preserves : ∀ {fuel : Nat} {store store' : Store} {args : List RVal} + {value : RVal} {rest : List Root}, + args.length = argWorlds.length → + RootOwnership store (rootsForWorlds argWorlds args ++ rest) → + runCode ctx fuel d store args.reverse d.body = .ok (store', value) → + RootOwnership store' (⟨d.result, value⟩ :: rest) + +/-- Exact ownership preservation for one evaluator-fuel index. Separating +the fuel index from `FnOwnershipContract` makes recursive self calls +well-founded: a successful `callSelf` always enters the same body at a +strictly smaller index. -/ +def FnOwnershipPreservesAt (ctx : Ctx) (d : FnDef) + (argWorlds : List Owned) (fuel : Nat) : Prop := + ∀ {store store' : Store} {args : List RVal} {value : RVal} + {rest : List Root}, + args.length = argWorlds.length → + RootOwnership store (rootsForWorlds argWorlds args ++ rest) → + runCode ctx fuel d store args.reverse d.body = .ok (store', value) → + RootOwnership store' (⟨d.result, value⟩ :: rest) + +/-- A function contract available only below `limit`. This is the induction +hypothesis consumed while proving a recursive function at the exact index +`limit`; it deliberately cannot justify a same-index recursive call. -/ +structure FnOwnershipContractBelow (ctx : Ctx) (d : FnDef) + (argWorlds : List Owned) (limit : Nat) : Prop where + arity_eq : argWorlds.length = d.arity + preserves : ∀ {fuel : Nat}, fuel < limit → + FnOwnershipPreservesAt ctx d argWorlds fuel + +/-- An ordinary function contract can be restricted to any fuel prefix. -/ +theorem FnOwnershipContract.below {ctx : Ctx} {d : FnDef} + {argWorlds : List Owned} + (hcontract : FnOwnershipContract ctx d argWorlds) (limit : Nat) : + FnOwnershipContractBelow ctx d argWorlds limit := by + refine ⟨hcontract.arity_eq, ?_⟩ + intro fuel _ + exact hcontract.preserves + +/-- Fuel-prefix contracts are contravariant in their bound. -/ +theorem FnOwnershipContractBelow.mono {ctx : Ctx} {d : FnDef} + {argWorlds : List Owned} {smaller larger : Nat} + (hcontract : FnOwnershipContractBelow ctx d argWorlds larger) + (hbound : smaller ≤ larger) : + FnOwnershipContractBelow ctx d argWorlds smaller := by + refine ⟨hcontract.arity_eq, ?_⟩ + intro fuel hfuel + exact hcontract.preserves (Nat.lt_of_lt_of_le hfuel hbound) + +/-- Seal a contractive, one-fuel-step body proof into the public unbounded +function contract. At index `limit`, the producer receives ownership +preservation only for strictly smaller self invocations. Strong induction +then supplies every index without assuming the theorem being constructed. -/ +theorem fnOwnershipContract_of_below_step {ctx : Ctx} {d : FnDef} + {argWorlds : List Owned} + (harity : argWorlds.length = d.arity) + (hstep : ∀ limit, + FnOwnershipContractBelow ctx d argWorlds limit → + FnOwnershipPreservesAt ctx d argWorlds limit) : + FnOwnershipContract ctx d argWorlds := by + refine ⟨harity, ?_⟩ + intro fuel store store' args value rest hlength hown hrun + have hall : ∀ index, + FnOwnershipPreservesAt ctx d argWorlds index := by + intro index + induction index using Nat.strongRecOn with + | ind index ih => + apply hstep index + refine ⟨harity, ?_⟩ + intro prior hprior + exact ih prior hprior + exact hall fuel hlength hown hrun + +/-- Exact ownership contract for one case alternative. `entryRoots` describes +the roots consumed by the branch from the enclosing environment and exposed +field values; `rest` is an arbitrary caller continuation. Constructor fields +are borrows at dispatch, so their world evidence is supplied separately and +the alternative must explicitly retain any field it keeps. -/ +structure AltOwnershipContract (ctx : Ctx) (cur : FnDef) (alt : Alt) + (fieldWorld : Owned) + (entryValid : List RVal → Array RVal → Prop) + (entryRoots : List RVal → Array RVal → List Root) : Prop where + preserves : match alt with + | .mk _ fieldCount body => + ∀ {fuel : Nat} {store store' : Store} {env : List RVal} + {fields : Array RVal} {value : RVal} {rest : List Root}, + fields.size = fieldCount → + entryValid env fields → + RootOwnership store (entryRoots env fields ++ rest) → + (∀ field ∈ fields.toList, HasWorld store fieldWorld field) → + runCode ctx fuel cur store + (fields.foldl (fun branchEnv field => field :: branchEnv) env) + body = .ok (store', value) → + RootOwnership store' (⟨cur.result, value⟩ :: rest) + +/-- A case-alternative ownership contract restricted to evaluator indices +below `limit`. Recursive rule bodies use this form while their enclosing +recursor contract is being sealed. -/ +structure AltOwnershipContractBelow (ctx : Ctx) (cur : FnDef) (alt : Alt) + (fieldWorld : Owned) + (entryValid : List RVal → Array RVal → Prop) + (entryRoots : List RVal → Array RVal → List Root) + (limit : Nat) : Prop where + preserves : match alt with + | .mk _ fieldCount body => + ∀ {fuel : Nat} {store store' : Store} {env : List RVal} + {fields : Array RVal} {value : RVal} {rest : List Root}, + fuel < limit → + fields.size = fieldCount → + entryValid env fields → + RootOwnership store (entryRoots env fields ++ rest) → + (∀ field ∈ fields.toList, HasWorld store fieldWorld field) → + runCode ctx fuel cur store + (fields.foldl (fun branchEnv field => field :: branchEnv) env) + body = .ok (store', value) → + RootOwnership store' (⟨cur.result, value⟩ :: rest) + +/-- Restrict a completed alternative contract to a fuel prefix. -/ +theorem AltOwnershipContract.below {ctx : Ctx} {cur : FnDef} {alt : Alt} + {fieldWorld : Owned} + {entryValid : List RVal → Array RVal → Prop} + {entryRoots : List RVal → Array RVal → List Root} + (hcontract : AltOwnershipContract ctx cur alt fieldWorld + entryValid entryRoots) (limit : Nat) : + AltOwnershipContractBelow ctx cur alt fieldWorld + entryValid entryRoots limit := by + cases alt with + | mk tag fieldCount body => + refine ⟨?_⟩ + intro fuel store store' env fields value rest _ hsize hvalid hown + hfields hrun + exact hcontract.preserves hsize hvalid hown hfields hrun + +/-- Fuel-prefix alternative contracts are contravariant in their bound. -/ +theorem AltOwnershipContractBelow.mono {ctx : Ctx} {cur : FnDef} + {alt : Alt} {fieldWorld : Owned} + {entryValid : List RVal → Array RVal → Prop} + {entryRoots : List RVal → Array RVal → List Root} + {smaller larger : Nat} + (hcontract : AltOwnershipContractBelow ctx cur alt fieldWorld + entryValid entryRoots larger) + (hbound : smaller ≤ larger) : + AltOwnershipContractBelow ctx cur alt fieldWorld + entryValid entryRoots smaller := by + cases alt with + | mk tag fieldCount body => + refine ⟨?_⟩ + intro fuel store store' env fields value rest hfuel + exact hcontract.preserves (Nat.lt_of_lt_of_le hfuel hbound) + +/-- Whole-context higher-order ownership obligation. Shared paps consume one +function root and all supplied shared argument roots; every successful +partial, saturated, or over-applied `applyGo` returns one shared root while +preserving the unrelated continuation. Constructing this contract from all +lowered declarations and pap producers is the callable half of the eventual +whole-program compiler theorem. -/ +structure ApplyOwnershipContract (ctx : Ctx) : Prop where + preserves : ∀ {fuel : Nat} {store store' : Store} {function : RVal} + {args : List RVal} {value : RVal} {rest : List Root}, + RootOwnership store + (⟨.shared, function⟩ :: rootsFor .shared args ++ rest) → + applyGo ctx fuel store function args = .ok (store', value) → + RootOwnership store' (⟨.shared, value⟩ :: rest) + +/-- Exact ownership preservation for `applyGo` at one evaluator-fuel index. -/ +def ApplyOwnershipPreservesAt (ctx : Ctx) (fuel : Nat) : Prop := + ∀ {store store' : Store} {function : RVal} {args : List RVal} + {value : RVal} {rest : List Root}, + RootOwnership store + (⟨.shared, function⟩ :: rootsFor .shared args ++ rest) → + applyGo ctx fuel store function args = .ok (store', value) → + RootOwnership store' (⟨.shared, value⟩ :: rest) + +/-- Ownership preservation for one evaluator-fuel index and one fixed input +heap. Reachability-sensitive simulations use this boundary when their +compiler contract is valid on certified heap images rather than arbitrary +synthetic heaps. -/ +def ApplyOwnershipPreservesFrom (ctx : Ctx) (fuel : Nat) + (store : Store) : Prop := + ∀ {store' : Store} {function : RVal} {args : List RVal} + {value : RVal} {rest : List Root}, + RootOwnership store + (⟨.shared, function⟩ :: rootsFor .shared args ++ rest) → + applyGo ctx fuel store function args = .ok (store', value) → + RootOwnership store' (⟨.shared, value⟩ :: rest) + +/-- A whole-context application contract specializes to every fixed input +heap. -/ +theorem ApplyOwnershipContract.preservesFrom {ctx : Ctx} + (contract : ApplyOwnershipContract ctx) (fuel : Nat) (store : Store) : + ApplyOwnershipPreservesFrom ctx fuel store := by + intro store' function args value rest ownership run + exact contract.preserves ownership run + +/-- Higher-order application ownership restricted to indices below +`limit`. Saturating and over-applied paps invoke declarations at smaller +fuel, so this contract belongs in the same mutual fuel induction. -/ +structure ApplyOwnershipContractBelow (ctx : Ctx) (limit : Nat) : Prop where + preserves : ∀ {fuel : Nat}, fuel < limit → + ApplyOwnershipPreservesAt ctx fuel + +/-- Every function declaration marked safe for shared PAP entry has an +all-shared signature and preserves ownership below the supplied evaluator-fuel +bound. Externs need no stored contract because their successful ABI is +scalar-only. -/ +structure PapSafeDeclContractsBelow (ctx : Ctx) (limit : Nat) : Prop where + fn : ∀ {address d}, ctx.decls address = some (.fn d) → + d.papSafe = true → + d.result = .shared ∧ + FnOwnershipContractBelow ctx d + (List.replicate d.arity .shared) limit + +/-- Unbounded ownership contracts for every PAP-safe function declaration in +a target context. -/ +structure PapSafeDeclContracts (ctx : Ctx) : Prop where + fn : ∀ {address d}, ctx.decls address = some (.fn d) → + d.papSafe = true → + d.result = .shared ∧ + FnOwnershipContract ctx d (List.replicate d.arity .shared) + +/-- Restrict a completed application contract to a fuel prefix. -/ +theorem ApplyOwnershipContract.below {ctx : Ctx} + (hcontract : ApplyOwnershipContract ctx) (limit : Nat) : + ApplyOwnershipContractBelow ctx limit := by + refine ⟨?_⟩ + intro fuel _ + exact hcontract.preserves + +/-- Fuel-prefix application contracts are contravariant in the bound. -/ +theorem ApplyOwnershipContractBelow.mono {ctx : Ctx} + {smaller larger : Nat} + (hcontract : ApplyOwnershipContractBelow ctx larger) + (hbound : smaller ≤ larger) : + ApplyOwnershipContractBelow ctx smaller := by + refine ⟨?_⟩ + intro fuel hfuel + exact hcontract.preserves (Nat.lt_of_lt_of_le hfuel hbound) + +theorem PapSafeDeclContractsBelow.mono {ctx : Ctx} + {smaller larger : Nat} + (hdecls : PapSafeDeclContractsBelow ctx larger) + (hbound : smaller ≤ larger) : + PapSafeDeclContractsBelow ctx smaller := by + refine ⟨?_⟩ + intro address d hdecl hpapsafe + obtain ⟨hresult, hcontract⟩ := hdecls.fn hdecl hpapsafe + exact ⟨hresult, hcontract.mono hbound⟩ + +theorem PapSafeDeclContracts.below {ctx : Ctx} + (hdecls : PapSafeDeclContracts ctx) (limit : Nat) : + PapSafeDeclContractsBelow ctx limit := by + refine ⟨?_⟩ + intro address d hdecl hpapsafe + obtain ⟨hresult, hcontract⟩ := hdecls.fn hdecl hpapsafe + exact ⟨hresult, hcontract.below limit⟩ + +/-- Seal a contractive exact-fuel application proof into the public +unbounded `ApplyOwnershipContract`. -/ +theorem applyOwnershipContract_of_below_step {ctx : Ctx} + (hstep : ∀ limit, + ApplyOwnershipContractBelow ctx limit → + ApplyOwnershipPreservesAt ctx limit) : + ApplyOwnershipContract ctx := by + refine ⟨?_⟩ + intro fuel store store' function args value rest hown hrun + have hall : ∀ index, ApplyOwnershipPreservesAt ctx index := by + intro index + induction index using Nat.strongRecOn with + | ind index ih => + apply hstep index + refine ⟨?_⟩ + intro prior hprior + exact ih prior hprior + exact hall fuel hown hrun + +@[simp] theorem filterMap_rootLocation?_rootsFor (world : Owned) + (values : List RVal) : + (rootsFor world values).filterMap rootLocation? = + values.filterMap rvalLocation? := by + rw [rootsFor, List.filterMap_map] + have hfun : + (rootLocation? ∘ fun value => (Root.mk world value)) = + rvalLocation? := by + funext value + cases value <;> rfl + rw [hfun] + +theorem RootOwnership.incoming_eq_zero_of_dead {store : Store} + {roots : List Root} (h : RootOwnership store roots) {loc : Nat} + (hdead : store.get? loc = none) : incoming store roots loc = 0 := by + rw [incoming, List.count_eq_zero] + intro hmem + rcases List.mem_append.mp hmem with hroot | hedge + · rw [List.mem_filterMap] at hroot + obtain ⟨root, hroot, hloc⟩ := hroot + have hworld := h.roots_world root hroot + cases root with + | mk world value => + cases value with + | loc rootLoc => + simp [rootLocation?, rvalLocation?] at hloc + subst rootLoc + obtain ⟨box, hlive, _⟩ := hworld + rw [hdead] at hlive + contradiction + | lit l => simp [rootLocation?, rvalLocation?] at hloc + | erased => simp [rootLocation?, rvalLocation?] at hloc + · rw [edgeLocations, List.mem_flatMap] at hedge + obtain ⟨slot, hslot, hedge⟩ := hedge + cases slot with + | none => simp [slotEdgeLocations] at hedge + | some parentBox => + have harray : some parentBox ∈ store.nodes := by simpa using hslot + obtain ⟨parentLoc, hparentArray⟩ := + (Array.mem_iff_getElem?).mp harray + have hparent : store.get? parentLoc = some parentBox := by + rw [Store.get?, hparentArray] + rfl + change loc ∈ (nodeChildren parentBox.node).filterMap rvalLocation? + at hedge + rw [List.mem_filterMap] at hedge + obtain ⟨child, hchild, hloc⟩ := hedge + have hworld := h.edges_world hparent child hchild + cases child with + | loc childLoc => + simp [rvalLocation?] at hloc + subst childLoc + obtain ⟨box, hlive, _⟩ := hworld + rw [hdead] at hlive + contradiction + | lit l => simp [rvalLocation?] at hloc + | erased => simp [rvalLocation?] at hloc + +/-! ## Location renaming -/ + +/-- Runtime values agree modulo a location relation. -/ +inductive RValIso (locRel : Nat → Nat → Prop) : RVal → RVal → Prop where + | loc {left right : Nat} : locRel left right → + RValIso locRel (.loc left) (.loc right) + | lit {l : Literal} : RValIso locRel (.lit l) (.lit l) + | erased : RValIso locRel .erased .erased + +/-- Pointwise runtime-value isomorphism. -/ +inductive RValsIso (locRel : Nat → Nat → Prop) : + List RVal → List RVal → Prop where + | nil : RValsIso locRel [] [] + | cons {left right : RVal} {lefts rights : List RVal} : + RValIso locRel left right → + RValsIso locRel lefts rights → + RValsIso locRel (left :: lefts) (right :: rights) + +/-- Heap nodes agree in identity/arity and pointwise modulo locations. -/ +inductive NodeIso (locRel : Nat → Nat → Prop) : Node → Node → Prop where + | ctor {cid : CtorId} {left right : Array RVal} : + RValsIso locRel left.toList right.toList → + NodeIso locRel (.ctorN cid left) (.ctorN cid right) + | pap {f : Address} {arity : Nat} {left right : Array RVal} : + RValsIso locRel left.toList right.toList → + NodeIso locRel (.papN f arity left) (.papN f arity right) + +/-- Live boxes agree semantically. Refcounts are semantic ownership state; +cost counters are not. -/ +structure NodeBoxIso (locRel : Nat → Nat → Prop) + (left right : NodeBox) : Prop where + world : left.world = right.world + rc : left.rc = right.rc + node : NodeIso locRel left.node right.node + +/-- A finite partial bijection covering exactly the live locations of two +heaps. The relation itself is finite because both stores have finite arrays; +`related_live` forbids mappings outside their live supports. -/ +structure HeapIso (left right : Store) where + locRel : Nat → Nat → Prop + left_unique : ∀ {l r₁ r₂}, locRel l r₁ → locRel l r₂ → r₁ = r₂ + right_unique : ∀ {l₁ l₂ r}, locRel l₁ r → locRel l₂ r → l₁ = l₂ + left_total : ∀ {loc box}, left.get? loc = some box → + ∃ rightLoc, locRel loc rightLoc + right_total : ∀ {loc box}, right.get? loc = some box → + ∃ leftLoc, locRel leftLoc loc + related_live : ∀ {leftLoc rightLoc}, locRel leftLoc rightLoc → + ∃ leftBox rightBox, + left.get? leftLoc = some leftBox ∧ + right.get? rightLoc = some rightBox ∧ + NodeBoxIso locRel leftBox rightBox + +namespace RValIso + +theorem eq_of_location_eq {left right : RVal} + (h : RValIso (fun l r => l = r) left right) : left = right := by + cases h with + | loc related => cases related; rfl + | lit => rfl + | erased => rfl + +theorem mono {r₁ r₂ : Nat → Nat → Prop} + (hmono : ∀ {l r}, r₁ l r → r₂ l r) {v₁ v₂ : RVal} + (h : RValIso r₁ v₁ v₂) : RValIso r₂ v₁ v₂ := by + cases h with + | loc h => exact .loc (hmono h) + | lit => exact .lit + | erased => exact .erased + +theorem refl (v : RVal) : RValIso (fun l r => l = r) v v := by + cases v with + | loc l => exact .loc rfl + | lit l => exact .lit + | erased => exact .erased + +theorem symm {r : Nat → Nat → Prop} {v₁ v₂ : RVal} + (h : RValIso r v₁ v₂) : RValIso (fun x y => r y x) v₂ v₁ := by + cases h with + | loc h => exact .loc h + | lit => exact .lit + | erased => exact .erased + +theorem trans {r₁ r₂ : Nat → Nat → Prop} {v₁ v₂ v₃ : RVal} + (h₁ : RValIso r₁ v₁ v₂) (h₂ : RValIso r₂ v₂ v₃) : + RValIso (fun x z => ∃ y, r₁ x y ∧ r₂ y z) v₁ v₃ := by + cases h₁ <;> cases h₂ + · exact .loc ⟨_, ‹_›, ‹_›⟩ + · exact .lit + · exact .erased + +end RValIso + +/-- Every runtime value vector is related to itself by location equality. -/ +theorem RValsIso.refl : ∀ values : List RVal, + RValsIso (fun l r => l = r) values values + | [] => .nil + | v :: rest => .cons (RValIso.refl v) (RValsIso.refl rest) + +theorem RValsIso.eq_of_location_eq {left right : List RVal} + (h : RValsIso (fun l r => l = r) left right) : left = right := by + induction h with + | nil => rfl + | cons head tail ih => + rw [head.eq_of_location_eq, ih] + +private theorem rvalsIso_symm {r : Nat → Nat → Prop} : + ∀ {left right : List RVal}, RValsIso r left right → + RValsIso (fun x y => r y x) right left + | _, _, .nil => .nil + | _, _, .cons hv hvs => .cons hv.symm (rvalsIso_symm hvs) + +private theorem rvalsIso_mono {r₁ r₂ : Nat → Nat → Prop} + (hmono : ∀ {l r}, r₁ l r → r₂ l r) : + ∀ {left right : List RVal}, RValsIso r₁ left right → + RValsIso r₂ left right + | _, _, .nil => .nil + | _, _, .cons hv hvs => + .cons (hv.mono hmono) (rvalsIso_mono hmono hvs) + +private theorem rvalsIso_trans {r₁ r₂ : Nat → Nat → Prop} : + ∀ {left middle right : List RVal}, + RValsIso r₁ left middle → RValsIso r₂ middle right → + RValsIso (fun x z => ∃ y, r₁ x y ∧ r₂ y z) left right + | _, _, _, .nil, .nil => .nil + | _, _, _, .cons h₁ hs₁, .cons h₂ hs₂ => + .cons (h₁.trans h₂) (rvalsIso_trans hs₁ hs₂) + +namespace NodeIso + +theorem mono {r₁ r₂ : Nat → Nat → Prop} + (hmono : ∀ {l r}, r₁ l r → r₂ l r) {left right : Node} + (h : NodeIso r₁ left right) : NodeIso r₂ left right := by + cases h with + | ctor h => exact .ctor (rvalsIso_mono hmono h) + | pap h => exact .pap (rvalsIso_mono hmono h) + +theorem refl (node : Node) : NodeIso (fun l r => l = r) node node := by + cases node with + | ctorN cid fields => exact .ctor (RValsIso.refl fields.toList) + | papN f arity args => exact .pap (RValsIso.refl args.toList) + +theorem symm {r : Nat → Nat → Prop} {left right : Node} + (h : NodeIso r left right) : NodeIso (fun x y => r y x) right left := by + cases h with + | ctor h => exact .ctor (rvalsIso_symm h) + | pap h => exact .pap (rvalsIso_symm h) + +theorem trans {r₁ r₂ : Nat → Nat → Prop} {left middle right : Node} + (h₁ : NodeIso r₁ left middle) (h₂ : NodeIso r₂ middle right) : + NodeIso (fun x z => ∃ y, r₁ x y ∧ r₂ y z) left right := by + cases h₁ <;> cases h₂ + · exact .ctor (rvalsIso_trans ‹_› ‹_›) + · exact .pap (rvalsIso_trans ‹_› ‹_›) + +end NodeIso + +namespace NodeBoxIso + +theorem mono {r₁ r₂ : Nat → Nat → Prop} + (hmono : ∀ {l r}, r₁ l r → r₂ l r) + {left right : NodeBox} (h : NodeBoxIso r₁ left right) : + NodeBoxIso r₂ left right := + ⟨h.world, h.rc, h.node.mono hmono⟩ + +theorem refl (box : NodeBox) : + NodeBoxIso (fun l r => l = r) box box := + ⟨rfl, rfl, NodeIso.refl box.node⟩ + +theorem symm {r : Nat → Nat → Prop} {left right : NodeBox} + (h : NodeBoxIso r left right) : + NodeBoxIso (fun x y => r y x) right left := + ⟨h.world.symm, h.rc.symm, h.node.symm⟩ + +theorem trans {r₁ r₂ : Nat → Nat → Prop} + {left middle right : NodeBox} (h₁ : NodeBoxIso r₁ left middle) + (h₂ : NodeBoxIso r₂ middle right) : + NodeBoxIso (fun x z => ∃ y, r₁ x y ∧ r₂ y z) left right := + ⟨h₁.world.trans h₂.world, h₁.rc.trans h₂.rc, h₁.node.trans h₂.node⟩ + +end NodeBoxIso + +private def liveEq (store : Store) (left right : Nat) : Prop := + left = right ∧ ∃ box, store.get? left = some box + +private theorem rvalIso_live_refl (store : Store) {v : RVal} + (h : LiveRVal store v) : RValIso (liveEq store) v v := by + cases v with + | loc loc => exact .loc ⟨rfl, h⟩ + | lit l => exact .lit + | erased => exact .erased + +private theorem rvalsIso_live_refl (store : Store) : + ∀ {values : List RVal}, + (∀ v ∈ values, LiveRVal store v) → + RValsIso (liveEq store) values values + | [], _ => .nil + | v :: rest, h => + .cons (rvalIso_live_refl store (h v (by simp))) + (rvalsIso_live_refl store (fun x hx => h x (by simp [hx]))) + +private theorem nodeBoxIso_live_refl {store : Store} (closed : StoreClosed store) + {loc : Nat} {box : NodeBox} (hbox : store.get? loc = some box) : + NodeBoxIso (liveEq store) box box := by + refine ⟨rfl, rfl, ?_⟩ + cases hnode : box.node with + | ctorN cid fields => + exact .ctor (rvalsIso_live_refl store + (fun v hv => closed hbox v (by simpa [nodeChildren, hnode] using hv))) + | papN f arity args => + exact .pap (rvalsIso_live_refl store + (fun v hv => closed hbox v (by simpa [nodeChildren, hnode] using hv))) + +namespace HeapIso + +@[simp] theorem get?_fresh (store : Store) : + store.get? store.nodes.size = none := by + simp [Store.get?] + +@[simp] theorem get?_allocNode_new (store : Store) (world : Owned) + (node : Node) : + (store.allocNode world node).1.get? (store.allocNode world node).2 = + some ⟨world, 1, node⟩ := by + simp [Store.allocNode, Store.get?] + +theorem get?_allocNode_old {store : Store} {world : Owned} {node : Node} + {loc : Nat} {box : NodeBox} (h : store.get? loc = some box) : + (store.allocNode world node).1.get? loc = some box := by + have hne : loc ≠ store.nodes.size := by + intro heq + subst loc + rw [get?_fresh] at h + contradiction + simpa [Store.allocNode, Store.get?, Array.getElem?_push, hne] using h + +theorem get?_of_allocNode_old {store : Store} {world : Owned} {node : Node} + {loc : Nat} {box : NodeBox} (hne : loc ≠ store.nodes.size) + (h : (store.allocNode world node).1.get? loc = some box) : + store.get? loc = some box := by + simpa [Store.allocNode, Store.get?, Array.getElem?_push, hne] using h + +/-- Every heap is isomorphic to itself on live locations. -/ +def refl (store : Store) (closed : StoreClosed store) : HeapIso store store where + locRel := liveEq store + left_unique h₁ h₂ := h₁.1.symm.trans h₂.1 + right_unique h₁ h₂ := h₁.1.trans h₂.1.symm + left_total := by intro loc box h; exact ⟨loc, rfl, box, h⟩ + right_total := by intro loc box h; exact ⟨loc, rfl, box, h⟩ + related_live := by + intro leftLoc rightLoc h + obtain ⟨rfl, box, hbox⟩ := h + exact ⟨box, box, hbox, hbox, nodeBoxIso_live_refl closed hbox⟩ + +/-- Heap isomorphism is symmetric. -/ +def symm {left right : Store} (iso : HeapIso left right) : + HeapIso right left where + locRel := fun r l => iso.locRel l r + left_unique := iso.right_unique + right_unique := iso.left_unique + left_total := iso.right_total + right_total := iso.left_total + related_live := by + intro rightLoc leftLoc h + obtain ⟨leftBox, rightBox, hl, hr, hb⟩ := iso.related_live h + exact ⟨rightBox, leftBox, hr, hl, hb.symm⟩ + +/-- Composition of finite live-location bijections. -/ +def trans {left middle right : Store} (first : HeapIso left middle) + (second : HeapIso middle right) : HeapIso left right where + locRel := fun l r => ∃ m, first.locRel l m ∧ second.locRel m r + left_unique := by + intro l r₁ r₂ h₁ h₂ + obtain ⟨m₁, hl₁, hr₁⟩ := h₁ + obtain ⟨m₂, hl₂, hr₂⟩ := h₂ + have hm : m₁ = m₂ := first.left_unique hl₁ hl₂ + subst m₂ + exact second.left_unique hr₁ hr₂ + right_unique := by + intro l₁ l₂ r h₁ h₂ + obtain ⟨m₁, hl₁, hr₁⟩ := h₁ + obtain ⟨m₂, hl₂, hr₂⟩ := h₂ + have hm : m₁ = m₂ := second.right_unique hr₁ hr₂ + subst m₂ + exact first.right_unique hl₁ hl₂ + left_total := by + intro loc box hbox + obtain ⟨mid, hmid⟩ := first.left_total hbox + obtain ⟨leftBox, midBox, _, hmidLive, _⟩ := + first.related_live hmid + obtain ⟨rightLoc, hright⟩ := second.left_total hmidLive + exact ⟨rightLoc, mid, hmid, hright⟩ + right_total := by + intro loc box hbox + obtain ⟨mid, hmid⟩ := second.right_total hbox + obtain ⟨midBox, rightBox, hmidLive, _, _⟩ := + second.related_live hmid + obtain ⟨leftLoc, hleft⟩ := first.right_total hmidLive + exact ⟨leftLoc, mid, hleft, hmid⟩ + related_live := by + intro leftLoc rightLoc hrel + obtain ⟨midLoc, hleftRel, hrightRel⟩ := hrel + obtain ⟨leftBox, midBox₁, hleft, hmid₁, hbox₁⟩ := + first.related_live hleftRel + obtain ⟨midBox₂, rightBox, hmid₂, hright, hbox₂⟩ := + second.related_live hrightRel + have hm : midBox₁ = midBox₂ := Option.some.inj (hmid₁.symm.trans hmid₂) + subst midBox₂ + exact ⟨leftBox, rightBox, hleft, hright, hbox₁.trans hbox₂⟩ + +/-- Corresponding allocations extend the finite live-location bijection with +the two fresh append locations. -/ +def alloc {left right : Store} (iso : HeapIso left right) + {world : Owned} {leftNode rightNode : Node} + (hnode : NodeIso iso.locRel leftNode rightNode) : + HeapIso (left.allocNode world leftNode).1 + (right.allocNode world rightNode).1 := by + let leftLoc := left.nodes.size + let rightLoc := right.nodes.size + let extended : Nat → Nat → Prop := fun l r => + (l = leftLoc ∧ r = rightLoc) ∨ iso.locRel l r + have leftFresh : ∀ r, ¬ iso.locRel leftLoc r := by + intro r hrel + obtain ⟨leftBox, rightBox, hl, _, _⟩ := iso.related_live hrel + have : left.get? leftLoc = none := by + simp [leftLoc] + rw [this] at hl + contradiction + have rightFresh : ∀ l, ¬ iso.locRel l rightLoc := by + intro l hrel + obtain ⟨leftBox, rightBox, _, hr, _⟩ := iso.related_live hrel + have : right.get? rightLoc = none := by + simp [rightLoc] + rw [this] at hr + contradiction + refine + { locRel := extended + left_unique := ?_ + right_unique := ?_ + left_total := ?_ + right_total := ?_ + related_live := ?_ } + · intro l r₁ r₂ h₁ h₂ + rcases h₁ with h₁ | h₁ <;> rcases h₂ with h₂ | h₂ + · exact h₁.2.trans h₂.2.symm + · rw [h₁.1] at h₂ + exact False.elim (leftFresh r₂ h₂) + · rw [h₂.1] at h₁ + exact False.elim (leftFresh r₁ h₁) + · exact iso.left_unique h₁ h₂ + · intro l₁ l₂ r h₁ h₂ + rcases h₁ with h₁ | h₁ <;> rcases h₂ with h₂ | h₂ + · exact h₁.1.trans h₂.1.symm + · rw [h₁.2] at h₂ + exact False.elim (rightFresh l₂ h₂) + · rw [h₂.2] at h₁ + exact False.elim (rightFresh l₁ h₁) + · exact iso.right_unique h₁ h₂ + · intro loc box hbox + by_cases hnew : loc = leftLoc + · exact ⟨rightLoc, .inl ⟨hnew, rfl⟩⟩ + · have hold : left.get? loc = some box := by + apply get?_of_allocNode_old (by simpa [leftLoc] using hnew) hbox + obtain ⟨r, hr⟩ := iso.left_total hold + exact ⟨r, .inr hr⟩ + · intro loc box hbox + by_cases hnew : loc = rightLoc + · exact ⟨leftLoc, .inl ⟨rfl, hnew⟩⟩ + · have hold : right.get? loc = some box := by + apply get?_of_allocNode_old (by simpa [rightLoc] using hnew) hbox + obtain ⟨l, hl⟩ := iso.right_total hold + exact ⟨l, .inr hl⟩ + · intro l r hrel + rcases hrel with hnew | hold + · obtain ⟨rfl, rfl⟩ := hnew + refine ⟨⟨world, 1, leftNode⟩, ⟨world, 1, rightNode⟩, ?_, ?_, ?_⟩ + · exact get?_allocNode_new left world leftNode + · exact get?_allocNode_new right world rightNode + · exact ⟨rfl, rfl, hnode.mono (fun h => .inr h)⟩ + · obtain ⟨leftBox, rightBox, hl, hr, hb⟩ := iso.related_live hold + refine ⟨leftBox, rightBox, get?_allocNode_old hl, + get?_allocNode_old hr, hb.mono (fun h => .inr h)⟩ + +end HeapIso + +/-! ## Exact ownership under heap isomorphism -/ + +private theorem sum_map_eq_of_bijective_rel + {α β : Type} (rel : α → β → Prop) (leftValue : α → Nat) + (rightValue : β → Nat) : + ∀ (left : List α) (right : List β), + left.Nodup → right.Nodup → + (∀ x ∈ left, ∃ y ∈ right, rel x y) → + (∀ y ∈ right, ∃ x ∈ left, rel x y) → + (∀ {x y₁ y₂}, rel x y₁ → rel x y₂ → y₁ = y₂) → + (∀ {x₁ x₂ y}, rel x₁ y → rel x₂ y → x₁ = x₂) → + (∀ {x y}, rel x y → leftValue x = rightValue y) → + (left.map leftValue).sum = (right.map rightValue).sum := by + intro left + induction left with + | nil => + intro right _ _ _ rightTotal _ _ _ + cases right with + | nil => rfl + | cons y ys => + obtain ⟨x, member, _⟩ := rightTotal y (by simp) + simp at member + | cons x xs ih => + intro right leftNodup rightNodup leftTotal rightTotal + leftFunctional rightFunctional values + have xNotMem : x ∉ xs := (List.nodup_cons.mp leftNodup).1 + have xsNodup : xs.Nodup := (List.nodup_cons.mp leftNodup).2 + obtain ⟨y, yMember, related⟩ := leftTotal x (by simp) + obtain ⟨before, after, rightEq⟩ := List.mem_iff_append.mp yMember + subst right + let rightRest := before ++ after + have rearranged : (before ++ y :: after).Perm (y :: rightRest) := by + exact List.perm_middle + have rearrangedNodup : (y :: rightRest).Nodup := + rearranged.nodup rightNodup + have yNotMem : y ∉ rightRest := + (List.nodup_cons.mp rearrangedNodup).1 + have rightRestNodup : rightRest.Nodup := + (List.nodup_cons.mp rearrangedNodup).2 + have tailLeftTotal : ∀ candidate ∈ xs, + ∃ target ∈ rightRest, rel candidate target := by + intro candidate candidateMember + obtain ⟨target, targetMember, candidateRelated⟩ := + leftTotal candidate (by simp [candidateMember]) + have targetNe : target ≠ y := by + intro equal + subst target + have candidateEq : candidate = x := + rightFunctional candidateRelated related + subst candidate + exact xNotMem candidateMember + refine ⟨target, ?_, candidateRelated⟩ + change target ∈ before ++ after + rw [List.mem_append] + simp only [List.mem_append, List.mem_cons] at targetMember + rcases targetMember with inBefore | targetMember + · exact Or.inl inBefore + · rcases targetMember with equal | inAfter + · exact False.elim (targetNe equal) + · exact Or.inr inAfter + have tailRightTotal : ∀ target ∈ rightRest, + ∃ candidate ∈ xs, rel candidate target := by + intro target targetMember + have targetMemberOriginal : target ∈ before ++ y :: after := by + change target ∈ before ++ after at targetMember + rw [List.mem_append] at targetMember + rcases targetMember with inBefore | inAfter + · exact List.mem_append.mpr (Or.inl inBefore) + · exact List.mem_append.mpr + (Or.inr (List.mem_cons.mpr (Or.inr inAfter))) + obtain ⟨candidate, candidateMember, candidateRelated⟩ := + rightTotal target targetMemberOriginal + have candidateNe : candidate ≠ x := by + intro equal + subst candidate + have targetEq : target = y := + leftFunctional candidateRelated related + subst target + exact yNotMem targetMember + refine ⟨candidate, ?_, candidateRelated⟩ + exact List.mem_of_ne_of_mem candidateNe candidateMember + have tailSums := ih rightRest xsNodup rightRestNodup tailLeftTotal + tailRightTotal leftFunctional rightFunctional values + simp only [List.map_cons, List.sum_cons] + rw [values related, tailSums] + simp [rightRest, List.map_append, List.sum_append, Nat.add_left_comm] + +private def indexedBoxes : List (Option NodeBox) → Nat → + List (Nat × NodeBox) + | [], _ => [] + | none :: rest, start => indexedBoxes rest (start + 1) + | some box :: rest, start => + (start, box) :: indexedBoxes rest (start + 1) + +private theorem indexedBoxes_eq_zipIdx_filterMap + (entries : List (Option NodeBox)) (start : Nat) : + indexedBoxes entries start = + (entries.zipIdx start).filterMap fun (slot, location) => + slot.map fun box => (location, box) := by + induction entries generalizing start with + | nil => rfl + | cons head tail ih => + cases head <;> simp [indexedBoxes, ih] + +private def liveBoxes (store : Store) : List (Nat × NodeBox) := + indexedBoxes store.nodes.toList 0 + +private theorem mem_liveBoxes_iff {store : Store} {location : Nat} + {box : NodeBox} : + (location, box) ∈ liveBoxes store ↔ store.get? location = some box := by + constructor + · intro member + rw [liveBoxes, indexedBoxes_eq_zipIdx_filterMap, + List.mem_filterMap] at member + obtain ⟨entry, entryMember, mapped⟩ := member + rcases entry with ⟨slot, index⟩ + cases slot with + | none => simp at mapped + | some entryBox => + simp only [Option.map_some, Option.some.injEq, Prod.mk.injEq] at mapped + obtain ⟨locationEq, boxEq⟩ := mapped + subst index + subst entryBox + have indexed := List.mem_zipIdx entryMember + obtain ⟨_lower, upper, slotEq⟩ := indexed + have listAt : store.nodes.toList[location]? = some (some box) := by + rw [List.getElem?_eq_getElem (by simpa using upper)] + exact congrArg some slotEq.symm + have arrayAt : store.nodes[location]? = some (some box) := by + simpa using listAt + simp [Store.get?, arrayAt] + · intro found + have arrayAt : store.nodes[location]? = some (some box) := by + cases slot : store.nodes[location]? with + | none => simp [Store.get?, slot] at found + | some entry => + cases entry with + | none => simp [Store.get?, slot] at found + | some entryBox => + have boxEq : entryBox = box := by + simpa [Store.get?, slot] using found + subst entryBox + rfl + have listAt : store.nodes.toList[location]? = some (some box) := by + simpa using arrayAt + have zippedAt : store.nodes.toList.zipIdx[location]? = + some (some box, location) := by + rw [List.getElem?_zipIdx] + simpa using listAt + have zippedMember : (some box, location) ∈ + store.nodes.toList.zipIdx := List.mem_of_getElem? zippedAt + rw [liveBoxes, indexedBoxes_eq_zipIdx_filterMap, + List.mem_filterMap] + exact ⟨(some box, location), zippedMember, by simp⟩ + +private theorem indexedBoxes_location_ge + {entries : List (Option NodeBox)} {start location : Nat} + {box : NodeBox} (member : (location, box) ∈ indexedBoxes entries start) : + start ≤ location := by + induction entries generalizing start with + | nil => simp [indexedBoxes] at member + | cons head tail ih => + cases head with + | none => + exact Nat.le_trans (Nat.le_add_right start 1) + (ih (start := start + 1) member) + | some headBox => + simp only [indexedBoxes, List.mem_cons] at member + rcases member with equal | member + · exact Nat.le_of_eq (congrArg Prod.fst equal).symm + · exact Nat.le_trans (Nat.le_add_right start 1) + (ih (start := start + 1) member) + +private theorem indexedBoxes_nodup (entries : List (Option NodeBox)) : + ∀ start, (indexedBoxes entries start).Nodup := by + induction entries with + | nil => simp [indexedBoxes] + | cons head tail ih => + intro start + cases head with + | none => exact ih (start + 1) + | some box => + rw [indexedBoxes, List.nodup_cons] + refine ⟨?_, ih (start + 1)⟩ + intro member + have bound := indexedBoxes_location_ge member + omega + +private theorem liveBoxes_nodup (store : Store) : + (liveBoxes store).Nodup := by + exact indexedBoxes_nodup store.nodes.toList 0 + +private def boxEdgeCount (needle : Nat) (entry : Nat × NodeBox) : Nat := + ((nodeChildren entry.2.node).filterMap rvalLocation?).count needle + +private theorem edgeCount_indexedBoxes + (entries : List (Option NodeBox)) (start needle : Nat) : + (entries.flatMap slotEdgeLocations).count needle = + ((indexedBoxes entries start).map (boxEdgeCount needle)).sum := by + induction entries generalizing start with + | nil => rfl + | cons head tail ih => + cases head with + | none => simpa [indexedBoxes, slotEdgeLocations] using ih (start + 1) + | some box => + simp [indexedBoxes, slotEdgeLocations, boxEdgeCount, + List.count_append, ih (start + 1)] + +private theorem edgeLocations_count_eq_liveBoxes_sum + (store : Store) (needle : Nat) : + (edgeLocations store).count needle = + ((liveBoxes store).map (boxEdgeCount needle)).sum := by + exact edgeCount_indexedBoxes store.nodes.toList 0 needle + +private theorem RValsIso.locationCount_eq + {left right : Store} (iso : HeapIso left right) + {leftLoc rightLoc : Nat} (locations : iso.locRel leftLoc rightLoc) : + ∀ {leftValues rightValues : List RVal}, + RValsIso iso.locRel leftValues rightValues → + (leftValues.filterMap rvalLocation?).count leftLoc = + (rightValues.filterMap rvalLocation?).count rightLoc + | _, _, .nil => rfl + | _, _, .cons head tail => by + have tailEq := RValsIso.locationCount_eq iso locations tail + cases head with + | @loc headLeft headRight related => + have iff : headLeft = leftLoc ↔ headRight = rightLoc := by + constructor + · intro equal + subst_vars + exact iso.left_unique related locations + · intro equal + subst_vars + exact iso.right_unique related locations + by_cases leftEqual : headLeft = leftLoc + · have rightEqual := iff.mp leftEqual + simp [rvalLocation?, leftEqual, rightEqual, tailEq] + · have rightNe : headRight ≠ rightLoc := fun rightEqual => + leftEqual (iff.mpr rightEqual) + simp [rvalLocation?, leftEqual, rightNe, tailEq] + | lit => simpa [rvalLocation?, tailEq] + | erased => simpa [rvalLocation?, tailEq] + +private theorem NodeIso.edgeCount_eq + {left right : Store} (iso : HeapIso left right) + {leftLoc rightLoc : Nat} (locations : iso.locRel leftLoc rightLoc) + {leftNode rightNode : Node} (nodes : NodeIso iso.locRel leftNode rightNode) : + ((nodeChildren leftNode).filterMap rvalLocation?).count leftLoc = + ((nodeChildren rightNode).filterMap rvalLocation?).count rightLoc := by + cases nodes with + | ctor fields => + exact RValsIso.locationCount_eq iso locations fields + | pap args => + exact RValsIso.locationCount_eq iso locations args + +private def liveBoxRel {left right : Store} (iso : HeapIso left right) + (leftEntry rightEntry : Nat × NodeBox) : Prop := + iso.locRel leftEntry.1 rightEntry.1 ∧ + left.get? leftEntry.1 = some leftEntry.2 ∧ + right.get? rightEntry.1 = some rightEntry.2 + +private theorem HeapIso.edgeLocations_count_eq + {left right : Store} (iso : HeapIso left right) + {leftLoc rightLoc : Nat} (locations : iso.locRel leftLoc rightLoc) : + (edgeLocations left).count leftLoc = + (edgeLocations right).count rightLoc := by + rw [edgeLocations_count_eq_liveBoxes_sum, + edgeLocations_count_eq_liveBoxes_sum] + apply sum_map_eq_of_bijective_rel (liveBoxRel iso) + (boxEdgeCount leftLoc) (boxEdgeCount rightLoc) + (liveBoxes left) (liveBoxes right) + · exact liveBoxes_nodup left + · exact liveBoxes_nodup right + · intro leftEntry leftMember + rcases leftEntry with ⟨entryLoc, entryBox⟩ + have leftLive := mem_liveBoxes_iff.mp leftMember + obtain ⟨rightEntryLoc, related⟩ := iso.left_total leftLive + obtain ⟨relatedLeftBox, rightEntryBox, relatedLeftLive, + rightLive, _⟩ := iso.related_live related + have leftBoxEq : relatedLeftBox = entryBox := + Option.some.inj (relatedLeftLive.symm.trans leftLive) + subst relatedLeftBox + exact ⟨(rightEntryLoc, rightEntryBox), + mem_liveBoxes_iff.mpr rightLive, related, leftLive, rightLive⟩ + · intro rightEntry rightMember + rcases rightEntry with ⟨entryLoc, entryBox⟩ + have rightLive := mem_liveBoxes_iff.mp rightMember + obtain ⟨leftEntryLoc, related⟩ := iso.right_total rightLive + obtain ⟨leftEntryBox, relatedRightBox, leftLive, + relatedRightLive, _⟩ := iso.related_live related + have rightBoxEq : relatedRightBox = entryBox := + Option.some.inj (relatedRightLive.symm.trans rightLive) + subst relatedRightBox + exact ⟨(leftEntryLoc, leftEntryBox), + mem_liveBoxes_iff.mpr leftLive, related, leftLive, rightLive⟩ + · intro leftEntry rightEntry₁ rightEntry₂ first second + rcases leftEntry with ⟨leftEntryLoc, leftEntryBox⟩ + rcases rightEntry₁ with ⟨rightEntryLoc₁, rightEntryBox₁⟩ + rcases rightEntry₂ with ⟨rightEntryLoc₂, rightEntryBox₂⟩ + have locationEq : rightEntryLoc₁ = rightEntryLoc₂ := + iso.left_unique first.1 second.1 + subst rightEntryLoc₂ + have boxEq : rightEntryBox₁ = rightEntryBox₂ := + Option.some.inj (first.2.2.symm.trans second.2.2) + subst rightEntryBox₂ + rfl + · intro leftEntry₁ leftEntry₂ rightEntry first second + rcases leftEntry₁ with ⟨leftEntryLoc₁, leftEntryBox₁⟩ + rcases leftEntry₂ with ⟨leftEntryLoc₂, leftEntryBox₂⟩ + rcases rightEntry with ⟨rightEntryLoc, rightEntryBox⟩ + have locationEq : leftEntryLoc₁ = leftEntryLoc₂ := + iso.right_unique first.1 second.1 + subst leftEntryLoc₂ + have boxEq : leftEntryBox₁ = leftEntryBox₂ := + Option.some.inj (first.2.1.symm.trans second.2.1) + subst leftEntryBox₂ + rfl + · intro leftEntry rightEntry related + rcases leftEntry with ⟨leftEntryLoc, leftEntryBox⟩ + rcases rightEntry with ⟨rightEntryLoc, rightEntryBox⟩ + obtain ⟨relatedLeftBox, relatedRightBox, leftLive, rightLive, + boxes⟩ := iso.related_live related.1 + have leftBoxEq : relatedLeftBox = leftEntryBox := + Option.some.inj (leftLive.symm.trans related.2.1) + have rightBoxEq : relatedRightBox = rightEntryBox := + Option.some.inj (rightLive.symm.trans related.2.2) + subst relatedLeftBox + subst relatedRightBox + exact boxes.node.edgeCount_eq iso locations + +/-- External roots agree in ownership world and runtime value modulo a +location relation. -/ +structure RootIso (locRel : Nat → Nat → Prop) (left right : Root) : Prop where + world : left.world = right.world + value : RValIso locRel left.value right.value + +/-- Pointwise root-list agreement modulo a location relation. -/ +inductive RootsIso (locRel : Nat → Nat → Prop) : + List Root → List Root → Prop where + | nil : RootsIso locRel [] [] + | cons {left right : Root} {lefts rights : List Root} : + RootIso locRel left right → + RootsIso locRel lefts rights → + RootsIso locRel (left :: lefts) (right :: rights) + +namespace RootIso + +theorem mono {first second : Nat → Nat → Prop} + (lift : ∀ {left right}, first left right → second left right) + {left right : Root} (root : RootIso first left right) : + RootIso second left right := + ⟨root.world, root.value.mono lift⟩ + +theorem symm {locRel : Nat → Nat → Prop} {left right : Root} + (root : RootIso locRel left right) : + RootIso (fun rightLoc leftLoc => locRel leftLoc rightLoc) right left := + ⟨root.world.symm, root.value.symm⟩ + +/-- A heap isomorphism determines at most one root preimage for a fixed +target root. -/ +theorem left_eq_of_right {leftStore rightStore : Store} + (iso : HeapIso leftStore rightStore) + {left₁ left₂ right : Root} + (first : RootIso iso.locRel left₁ right) + (second : RootIso iso.locRel left₂ right) : left₁ = left₂ := by + rcases left₁ with ⟨leftWorld₁, leftValue₁⟩ + rcases left₂ with ⟨leftWorld₂, leftValue₂⟩ + rcases right with ⟨rightWorld, rightValue⟩ + have worldEq : leftWorld₁ = leftWorld₂ := + first.world.trans second.world.symm + subst leftWorld₂ + congr 1 + cases first.value with + | loc firstRelated => + cases second.value with + | loc secondRelated => + exact congrArg RVal.loc + (iso.right_unique firstRelated secondRelated) + | lit => cases second.value; rfl + | erased => cases second.value; rfl + +end RootIso + +namespace HeapIso + +/-- Heap-world evidence follows a related runtime value across a heap +isomorphism. -/ +theorem hasWorld {left right : Store} (iso : HeapIso left right) + {leftValue rightValue : RVal} + (value : RValIso iso.locRel leftValue rightValue) + {world : Ix.Compiler.Ixon.Owned} + (hasWorld : HasWorld left world leftValue) : + HasWorld right world rightValue := by + cases value with + | loc related => + obtain ⟨sourceBox, sourceLive, sourceWorld⟩ := hasWorld + obtain ⟨relatedSourceBox, targetBox, relatedSourceLive, targetLive, + boxes⟩ := iso.related_live related + have boxEq : sourceBox = relatedSourceBox := + Option.some.inj (sourceLive.symm.trans relatedSourceLive) + subst sourceBox + exact ⟨targetBox, targetLive, boxes.world.symm.trans sourceWorld⟩ + | lit => trivial + | erased => trivial + +end HeapIso + +namespace RootsIso + +theorem mono {first second : Nat → Nat → Prop} + (lift : ∀ {left right}, first left right → second left right) : + ∀ {left right : List Root}, RootsIso first left right → + RootsIso second left right + | _, _, .nil => .nil + | _, _, .cons head tail => .cons (head.mono lift) (tail.mono lift) + +theorem symm {locRel : Nat → Nat → Prop} : + ∀ {left right : List Root}, RootsIso locRel left right → + RootsIso (fun rightLoc leftLoc => locRel leftLoc rightLoc) right left + | _, _, .nil => .nil + | _, _, .cons head tail => .cons head.symm tail.symm + +/-- Homogeneous root framing preserves a pointwise runtime-value +isomorphism. -/ +theorem rootsFor {locRel : Nat → Nat → Prop} + (world : Ix.Compiler.Ixon.Owned) : + ∀ {left right : List RVal}, RValsIso locRel left right → + RootsIso locRel (rootsFor world left) (rootsFor world right) + | _, _, .nil => .nil + | _, _, .cons head tail => .cons ⟨rfl, head⟩ (rootsFor world tail) + +/-- Pointwise root isomorphisms concatenate. -/ +theorem append {locRel : Nat → Nat → Prop} + {leftPrefix rightPrefix leftSuffix rightSuffix : List Root} + (first : RootsIso locRel leftPrefix rightPrefix) + (suffix : RootsIso locRel leftSuffix rightSuffix) : + RootsIso locRel (leftPrefix ++ leftSuffix) + (rightPrefix ++ rightSuffix) := by + induction first with + | nil => exact suffix + | cons head tail ih => exact .cons head ih + +theorem tail {locRel : Nat → Nat → Prop} {left right : Root} + {lefts rights : List Root} + (roots : RootsIso locRel (left :: lefts) (right :: rights)) : + RootsIso locRel lefts rights := by + cases roots with + | cons head tail => exact tail + +/-- Dropping equal pointwise prefixes preserves root-list isomorphism. -/ +theorem drop {locRel : Nat → Nat → Prop} : + ∀ {left right : List Root}, RootsIso locRel left right → + ∀ count, RootsIso locRel (left.drop count) (right.drop count) + | _, _, .nil, count => by cases count <;> exact .nil + | _, _, .cons head tail, 0 => .cons head tail + | _, _, .cons head tail, count + 1 => tail.drop count + +theorem left_of_right_mem {locRel : Nat → Nat → Prop} : + ∀ {left right : List Root}, RootsIso locRel left right → + ∀ {rightRoot}, rightRoot ∈ right → + ∃ leftRoot, leftRoot ∈ left ∧ RootIso locRel leftRoot rightRoot + | _, _, .nil, _, member => by simp at member + | _, _, .cons head tail, rightRoot, member => by + simp only [List.mem_cons] at member + rcases member with equal | member + · subst rightRoot + exact ⟨_, by simp, head⟩ + · obtain ⟨leftRoot, leftMember, related⟩ := + tail.left_of_right_mem member + exact ⟨leftRoot, by simp [leftMember], related⟩ + +/-- Pointwise root preimages of the same target list are unique. -/ +theorem left_eq_of_right {leftStore rightStore : Store} + (iso : HeapIso leftStore rightStore) : + ∀ {left₁ left₂ right : List Root}, + RootsIso iso.locRel left₁ right → + RootsIso iso.locRel left₂ right → + left₁ = left₂ + | _, _, _, .nil, .nil => rfl + | _, _, _, .cons firstHead firstTail, .cons secondHead secondTail => by + have headEq := RootIso.left_eq_of_right iso firstHead secondHead + have tailEq := RootsIso.left_eq_of_right iso firstTail secondTail + rw [headEq, tailEq] + +/-- Reorder the target presentation of a pointwise root isomorphism while +applying the same permutation to its source presentation. -/ +theorem permuteRight {locRel : Nat → Nat → Prop} + {left right right' : List Root} + (roots : RootsIso locRel left right) (permutation : right.Perm right') : + ∃ left', left.Perm left' ∧ RootsIso locRel left' right' := by + induction permutation generalizing left with + | nil => + cases roots + exact ⟨[], .refl [], .nil⟩ + | cons root permutation ih => + cases roots with + | cons head tail => + obtain ⟨leftTail, tailPermutation, tailRoots⟩ := ih tail + exact ⟨_ :: leftTail, tailPermutation.cons _, .cons head tailRoots⟩ + | swap first second rest => + cases roots with + | cons firstRoot roots => + cases roots with + | cons secondRoot tail => + exact ⟨_, .swap _ _ _, .cons secondRoot (.cons firstRoot tail)⟩ + | trans first second firstIh secondIh => + obtain ⟨middleLeft, firstPerm, middleRoots⟩ := firstIh roots + obtain ⟨rightLeft, secondPerm, rightRoots⟩ := secondIh middleRoots + exact ⟨rightLeft, firstPerm.trans secondPerm, rightRoots⟩ + +private theorem values {locRel : Nat → Nat → Prop} : + ∀ {left right : List Root}, RootsIso locRel left right → + RValsIso locRel (left.map Root.value) (right.map Root.value) + | _, _, .nil => .nil + | _, _, .cons head tail => .cons head.value tail.values + +private theorem right_hasWorld {left right : Store} (iso : HeapIso left right) + {leftRoots rightRoots : List Root} + (roots : RootsIso iso.locRel leftRoots rightRoots) + (leftWorlds : ∀ root ∈ leftRoots, + HasWorld left root.world root.value) : + ∀ root ∈ rightRoots, HasWorld right root.world root.value := by + induction roots with + | nil => intro root member; simp at member + | @cons leftRoot rightRoot leftRoots rightRoots head tail ih => + intro root member + have tailWorlds : ∀ candidate ∈ leftRoots, + HasWorld left candidate.world candidate.value := by + intro candidate candidateMember + exact leftWorlds candidate (by simp [candidateMember]) + simp only [List.mem_cons] at member + rcases member with equal | member + · subst root + have leftWorld := leftWorlds leftRoot (by simp) + have rightWorld := iso.hasWorld head.value leftWorld + simpa [head.world] using rightWorld + · exact ih tailWorlds root member + +private theorem locationCount_eq {left right : Store} (iso : HeapIso left right) + {leftLoc rightLoc : Nat} (locations : iso.locRel leftLoc rightLoc) + {leftRoots rightRoots : List Root} + (roots : RootsIso iso.locRel leftRoots rightRoots) : + (leftRoots.filterMap rootLocation?).count leftLoc = + (rightRoots.filterMap rootLocation?).count rightLoc := by + have values := RValsIso.locationCount_eq iso locations roots.values + have locationFunction : + (rvalLocation? ∘ Root.value) = rootLocation? := by + funext root + rfl + simpa only [List.filterMap_map, locationFunction] using values + +end RootsIso + +namespace HeapIso + +/-- Incoming ownership multiplicity is invariant under corresponding heap +and root-list renamings. -/ +theorem incoming_eq {left right : Store} (iso : HeapIso left right) + {leftRoots rightRoots : List Root} + (roots : RootsIso iso.locRel leftRoots rightRoots) + {leftLoc rightLoc : Nat} (locations : iso.locRel leftLoc rightLoc) : + incoming left leftRoots leftLoc = incoming right rightRoots rightLoc := by + unfold incoming + rw [List.count_append, List.count_append, + roots.locationCount_eq iso locations, + iso.edgeLocations_count_eq locations] + +end HeapIso + +private theorem RValsIso.left_of_right_mem {locRel : Nat → Nat → Prop} : + ∀ {left right : List RVal}, RValsIso locRel left right → + ∀ {rightValue}, rightValue ∈ right → + ∃ leftValue, leftValue ∈ left ∧ + RValIso locRel leftValue rightValue + | _, _, .nil, _, member => by simp at member + | _, _, .cons head tail, rightValue, member => by + simp only [List.mem_cons] at member + rcases member with equal | member + · subst rightValue + exact ⟨_, by simp, head⟩ + · obtain ⟨leftValue, leftMember, related⟩ := + tail.left_of_right_mem member + exact ⟨leftValue, by simp [leftMember], related⟩ + +private theorem NodeIso.children {locRel : Nat → Nat → Prop} + {left right : Node} (nodes : NodeIso locRel left right) : + RValsIso locRel (nodeChildren left) (nodeChildren right) := by + cases nodes with + | ctor fields => exact fields + | pap args => exact args + +private theorem NodeIso.left_pap_of_right {locRel : Nat → Nat → Prop} + {left : Node} {f : Ix.Compiler.Ixon.Address} {arity : Nat} + {rightArgs : Array RVal} + (nodes : NodeIso locRel left (.papN f arity rightArgs)) : + ∃ leftArgs, left = .papN f arity leftArgs := by + cases nodes with + | pap fields => exact ⟨_, rfl⟩ + +namespace HeapIso + +/-- Exact ownership is invariant under a heap isomorphism when the external +root list is renamed pointwise by the same location relation. -/ +theorem rootOwnership {left right : Store} (iso : HeapIso left right) + {leftRoots rightRoots : List Root} + (roots : RootsIso iso.locRel leftRoots rightRoots) + (owned : RootOwnership left leftRoots) : + RootOwnership right rightRoots := by + refine ⟨roots.right_hasWorld iso owned.roots_world, ?_, ?_, ?_⟩ + · intro rightLoc rightBox rightLive child childMember + obtain ⟨leftLoc, related⟩ := iso.right_total rightLive + obtain ⟨leftBox, relatedRightBox, leftLive, relatedRightLive, + boxes⟩ := iso.related_live related + have rightBoxEq : relatedRightBox = rightBox := + Option.some.inj (relatedRightLive.symm.trans rightLive) + subst relatedRightBox + obtain ⟨leftChild, leftMember, children⟩ := + boxes.node.children.left_of_right_mem childMember + have leftWorld := owned.edges_world leftLive leftChild leftMember + have rightWorld := iso.hasWorld children leftWorld + simpa [boxes.world] using rightWorld + · intro rightLoc rightBox f arity args rightLive rightNode + obtain ⟨leftLoc, related⟩ := iso.right_total rightLive + obtain ⟨leftBox, relatedRightBox, leftLive, relatedRightLive, + boxes⟩ := iso.related_live related + have rightBoxEq : relatedRightBox = rightBox := + Option.some.inj (relatedRightLive.symm.trans rightLive) + subst relatedRightBox + have nodes : NodeIso iso.locRel leftBox.node (.papN f arity args) := by + simpa [rightNode] using boxes.node + obtain ⟨leftArgs, leftNode⟩ := nodes.left_pap_of_right + have leftShared := owned.pap_shared leftLive leftNode + exact boxes.world ▸ leftShared + · intro rightLoc rightBox rightLive + obtain ⟨leftLoc, related⟩ := iso.right_total rightLive + obtain ⟨leftBox, relatedRightBox, leftLive, relatedRightLive, + boxes⟩ := iso.related_live related + have rightBoxEq : relatedRightBox = rightBox := + Option.some.inj (relatedRightLive.symm.trans rightLive) + subst relatedRightBox + have leftCounts := owned.counts leftLive + have incomingEq := iso.incoming_eq roots related + rw [← boxes.world, ← boxes.rc, ← incomingEq] + exact leftCounts + +private theorem preimageRoot {left right : Store} (iso : HeapIso left right) + (root : Root) (world : HasWorld right root.world root.value) : + ∃ leftRoot, RootIso iso.locRel leftRoot root := by + rcases root with ⟨rootWorld, value⟩ + cases value with + | loc rightLoc => + obtain ⟨rightBox, rightLive, _rightWorld⟩ := world + obtain ⟨leftLoc, related⟩ := iso.right_total rightLive + exact ⟨⟨rootWorld, .loc leftLoc⟩, rfl, .loc related⟩ + | lit literal => + exact ⟨⟨rootWorld, .lit literal⟩, rfl, .lit⟩ + | erased => + exact ⟨⟨rootWorld, .erased⟩, rfl, .erased⟩ + +private theorem rootsIsoPreimage {left right : Store} + (iso : HeapIso left right) : + ∀ (rightRoots : List Root), + (∀ root ∈ rightRoots, HasWorld right root.world root.value) → + ∃ leftRoots, RootsIso iso.locRel leftRoots rightRoots + | [], _ => ⟨[], .nil⟩ + | root :: rest, worlds => by + obtain ⟨leftRoot, head⟩ := iso.preimageRoot root + (worlds root (by simp)) + obtain ⟨leftRest, tail⟩ := iso.rootsIsoPreimage rest + (fun candidate member => worlds candidate (by simp [member])) + exact ⟨leftRoot :: leftRest, .cons head tail⟩ + +/-- Pull an exact external-root presentation backward through a heap +isomorphism. The returned list preserves root order and worlds while replacing +each live location by its unique preimage. -/ +theorem rootOwnershipPreimage {left right : Store} (iso : HeapIso left right) + {rightRoots : List Root} (owned : RootOwnership right rightRoots) : + ∃ leftRoots, + RootsIso iso.locRel leftRoots rightRoots ∧ + RootOwnership left leftRoots := by + obtain ⟨leftRoots, roots⟩ := + iso.rootsIsoPreimage rightRoots owned.roots_world + exact ⟨leftRoots, roots, iso.symm.rootOwnership roots.symm owned⟩ + +/-- Pull a cons-root ownership presentation backward while fixing a known +preimage for its distinguished head. -/ +theorem rootOwnershipPreimageCons {left right : Store} + (iso : HeapIso left right) {leftRoot rightRoot : Root} + {rightRest : List Root} (head : RootIso iso.locRel leftRoot rightRoot) + (owned : RootOwnership right (rightRoot :: rightRest)) : + ∃ leftRest, + RootsIso iso.locRel (leftRoot :: leftRest) (rightRoot :: rightRest) ∧ + RootOwnership left (leftRoot :: leftRest) := by + obtain ⟨leftRest, tail⟩ := iso.rootsIsoPreimage rightRest + (fun root member => owned.roots_world root (by simp [member])) + let roots : RootsIso iso.locRel (leftRoot :: leftRest) + (rightRoot :: rightRest) := .cons head tail + exact ⟨leftRest, roots, iso.symm.rootOwnership roots.symm owned⟩ + +/-- Pull an ownership presentation backward while fixing any pointwise-related +root prefix and choosing only the ambient preimage tail. -/ +theorem rootOwnershipPreimageAppend {left right : Store} + (iso : HeapIso left right) + {leftPrefix rightPrefix rightRest : List Root} + (first : RootsIso iso.locRel leftPrefix rightPrefix) + (owned : RootOwnership right (rightPrefix ++ rightRest)) : + ∃ leftRest, + RootsIso iso.locRel (leftPrefix ++ leftRest) + (rightPrefix ++ rightRest) ∧ + RootOwnership left (leftPrefix ++ leftRest) := by + obtain ⟨leftRest, tail⟩ := iso.rootsIsoPreimage rightRest + (fun root member => owned.roots_world root + (List.mem_append_right rightPrefix member)) + let roots := first.append tail + exact ⟨leftRest, roots, iso.symm.rootOwnership roots.symm owned⟩ + +end HeapIso + +/-- Appending a fresh heap node preserves every existing live node shape. -/ +theorem StoreGraphExtends.allocNode (store : Store) (world : Owned) + (node : Node) : + StoreGraphExtends store (store.allocNode world node).1 := by + intro loc boxWorld rc oldNode hget + exact ⟨rc, HeapIso.get?_allocNode_old hget⟩ + +/-! ## Allocation and exact ownership -/ + +private theorem flatMap_set_eq_self {α β : Type} (f : α → List β) : + ∀ {values : List α} {idx : Nat} {old new : α}, + values[idx]? = some old → f new = f old → + (values.set idx new).flatMap f = values.flatMap f + | [], idx, old, new, hget, _ => by simp at hget + | value :: rest, 0, old, new, hget, hsame => by + simp at hget + subst old + simp [hsame] + | value :: rest, idx + 1, old, new, hget, hsame => by + simp only [List.getElem?_cons_succ] at hget + simp [flatMap_set_eq_self f hget hsame] + +theorem nodes_get?_of_get? {store : Store} {loc : Nat} {box : NodeBox} + (h : store.get? loc = some box) : + store.nodes[loc]? = some (some box) := by + rw [Store.get?, Option.bind_eq_some_iff] at h + obtain ⟨slot, hslot, hid⟩ := h + change slot = some box at hid + subst slot + exact hslot + +theorem get?_setBox_same {store : Store} {loc : Nat} {old new : NodeBox} + (h : store.get? loc = some old) : + (store.setBox loc new).get? loc = some new := by + have hnodes := nodes_get?_of_get? h + obtain ⟨hlt, _⟩ := Array.getElem?_eq_some_iff.mp hnodes + simp [Store.setBox, Store.get?, Array.set!_eq_setIfInBounds, hlt] + +theorem get?_setBox_other {store : Store} {loc other : Nat} + {old new box : NodeBox} (hne : loc ≠ other) + (hlive : store.get? loc = some old) (h : store.get? other = some box) : + (store.setBox loc new).get? other = some box := by + have hnodes := nodes_get?_of_get? hlive + obtain ⟨hlt, _⟩ := Array.getElem?_eq_some_iff.mp hnodes + simpa [Store.setBox, Store.get?, Array.set!_eq_setIfInBounds, + Array.getElem?_setIfInBounds, hlt, hne] using h + +theorem get?_of_setBox_other {store : Store} {loc other : Nat} + {old new box : NodeBox} (hne : loc ≠ other) + (hlive : store.get? loc = some old) + (h : (store.setBox loc new).get? other = some box) : + store.get? other = some box := by + have hnodes := nodes_get?_of_get? hlive + obtain ⟨hlt, _⟩ := Array.getElem?_eq_some_iff.mp hnodes + simpa [Store.setBox, Store.get?, Array.set!_eq_setIfInBounds, + Array.getElem?_setIfInBounds, hlt, hne] using h + +private theorem count_flatMap_set_remove {α β : Type} [BEq β] + (f : α → List β) (needle : β) : + ∀ {values : List α} {idx : Nat} {old new : α}, + values[idx]? = some old → f new = [] → + List.count needle ((values.set idx new).flatMap f) + + List.count needle (f old) = + List.count needle (values.flatMap f) + | [], idx, old, new, hget, _ => by simp at hget + | value :: rest, 0, old, new, hget, hempty => by + simp at hget + subst old + simp [hempty, List.count_append, Nat.add_comm] + | value :: rest, idx + 1, old, new, hget, hempty => by + simp only [List.getElem?_cons_succ] at hget + simp only [List.set, List.flatMap_cons, List.count_append] + have ih := count_flatMap_set_remove f needle hget hempty + omega + +private theorem count_flatMap_set_add {α β : Type} [BEq β] + (f : α → List β) (needle : β) : + ∀ {values : List α} {idx : Nat} {old new : α}, + values[idx]? = some old → f old = [] → + List.count needle ((values.set idx new).flatMap f) = + List.count needle (values.flatMap f) + + List.count needle (f new) + | [], idx, old, new, hget, _ => by simp at hget + | value :: rest, 0, old, new, hget, hempty => by + simp at hget + subst old + simp [hempty, List.count_append, Nat.add_comm] + | value :: rest, idx + 1, old, new, hget, hempty => by + simp only [List.getElem?_cons_succ] at hget + simp only [List.set, List.flatMap_cons, List.count_append] + have ih := count_flatMap_set_add f needle (new := new) hget hempty + omega + +theorem get?_kill_same {store : Store} {loc : Nat} {box : NodeBox} + (h : store.get? loc = some box) : (store.kill loc).get? loc = none := by + have hnodes := nodes_get?_of_get? h + obtain ⟨hlt, _⟩ := Array.getElem?_eq_some_iff.mp hnodes + simp [Store.kill, Store.get?, Array.set!_eq_setIfInBounds, hlt] + +theorem get?_kill_other {store : Store} {loc other : Nat} {box otherBox} + (hne : loc ≠ other) (hlive : store.get? loc = some box) + (h : store.get? other = some otherBox) : + (store.kill loc).get? other = some otherBox := by + have hnodes := nodes_get?_of_get? hlive + obtain ⟨hlt, _⟩ := Array.getElem?_eq_some_iff.mp hnodes + simpa [Store.kill, Store.get?, Array.set!_eq_setIfInBounds, + Array.getElem?_setIfInBounds, hlt, hne] using h + +theorem get?_of_kill_other {store : Store} {loc other : Nat} {box otherBox} + (hne : loc ≠ other) (hlive : store.get? loc = some box) + (h : (store.kill loc).get? other = some otherBox) : + store.get? other = some otherBox := by + have hnodes := nodes_get?_of_get? hlive + obtain ⟨hlt, _⟩ := Array.getElem?_eq_some_iff.mp hnodes + simpa [Store.kill, Store.get?, Array.set!_eq_setIfInBounds, + Array.getElem?_setIfInBounds, hlt, hne] using h + +/-- Killing one live node leaves every surviving node's shape unchanged. -/ +theorem StoreGraphRestricts.kill {store : Store} {loc : Nat} {box : NodeBox} + (hlive : store.get? loc = some box) : + StoreGraphRestricts store (store.kill loc) := by + intro other world rc node hafter + by_cases heq : loc = other + · subst other + rw [get?_kill_same hlive] at hafter + contradiction + · exact ⟨rc, get?_of_kill_other heq hlive hafter⟩ + +theorem count_edgeLocations_kill {store : Store} {loc : Nat} + {box : NodeBox} (needle : Nat) (h : store.get? loc = some box) : + List.count needle (edgeLocations (store.kill loc)) + + List.count needle ((nodeChildren box.node).filterMap rvalLocation?) = + List.count needle (edgeLocations store) := by + have hnodes := nodes_get?_of_get? h + have hlist : store.nodes.toList[loc]? = some (some box) := by + simpa using hnodes + rw [edgeLocations, edgeLocations, Store.kill, Array.toList_set!] + apply count_flatMap_set_remove slotEdgeLocations needle hlist + rfl + +theorem incoming_kill_one (store : Store) (loc : Nat) (world : Owned) + (node : Node) (rest : List Root) (needle : Nat) + (hget : store.get? loc = some ⟨world, 1, node⟩) : + incoming (store.kill loc) (rootsFor world (nodeChildren node) ++ rest) + needle + (if loc == needle then 1 else 0) = + incoming store (⟨world, .loc loc⟩ :: rest) needle := by + have hedge := count_edgeLocations_kill needle hget + by_cases heq : loc = needle + · subst needle + simp [incoming, List.filterMap_append, List.count_append, + rootLocation?, rvalLocation?] at hedge ⊢ + omega + · simp [incoming, List.filterMap_append, List.count_append, + rootLocation?, rvalLocation?, heq] at hedge ⊢ + omega + +theorem incoming_kill_shared_one (store : Store) (loc : Nat) (node : Node) + (rest : List Root) (needle : Nat) + (hget : store.get? loc = some ⟨.shared, 1, node⟩) : + incoming (store.kill loc) (rootsFor .shared (nodeChildren node) ++ rest) + needle + (if loc == needle then 1 else 0) = + incoming store (⟨.shared, .loc loc⟩ :: rest) needle := + incoming_kill_one store loc .shared node rest needle hget + +theorem incoming_kill_unique_one (store : Store) (loc : Nat) (node : Node) + (rest : List Root) (needle : Nat) + (hget : store.get? loc = some ⟨.unique, 1, node⟩) : + incoming (store.kill loc) (rootsFor .unique (nodeChildren node) ++ rest) + needle + (if loc == needle then 1 else 0) = + incoming store (⟨.unique, .loc loc⟩ :: rest) needle := + incoming_kill_one store loc .unique node rest needle hget + +private theorem sole_incoming_free_of_one {store : Store} {loc : Nat} + {world : Owned} {rest : List Root} + (hcount : 1 = incoming store (⟨world, .loc loc⟩ :: rest) loc) : + loc ∉ rest.filterMap rootLocation? ++ edgeLocations store := by + rw [incoming] at hcount + simp [rootLocation?, rvalLocation?, List.count] at hcount + intro hmem + rcases List.mem_append.mp hmem with hroot | hedge + · rw [List.mem_filterMap] at hroot + obtain ⟨root, hroot, hmap⟩ := hroot + exact hcount.1 loc root hroot hmap rfl + · exact hcount.2 loc hedge rfl + +/-- When a shared node has reference count one and its consuming root is +listed first, no root in the tail and no heap edge can also point to it. -/ +theorem RootOwnership.sole_incoming_free {store : Store} {loc : Nat} + {node : Node} {rest : List Root} + (hget : store.get? loc = some ⟨.shared, 1, node⟩) + (h : RootOwnership store (⟨.shared, .loc loc⟩ :: rest)) : + loc ∉ rest.filterMap rootLocation? ++ edgeLocations store := by + exact sole_incoming_free_of_one (h.counts hget) + +/-- A unique node's exact-one incoming equation excludes every other root or +heap edge from its consuming root. -/ +theorem RootOwnership.sole_incoming_free_unique {store : Store} {loc : Nat} + {node : Node} {rest : List Root} + (hget : store.get? loc = some ⟨.unique, 1, node⟩) + (h : RootOwnership store (⟨.unique, .loc loc⟩ :: rest)) : + loc ∉ rest.filterMap rootLocation? ++ edgeLocations store := by + have hcount := h.counts hget + exact sole_incoming_free_of_one hcount.2.symm + +theorem RootOwnership.sole_root_ne {store : Store} {loc : Nat} + {node : Node} {rest : List Root} + (hget : store.get? loc = some ⟨.shared, 1, node⟩) + (h : RootOwnership store (⟨.shared, .loc loc⟩ :: rest)) + {root : Root} (hroot : root ∈ rest) : root.value ≠ .loc loc := by + intro heq + have hfree := h.sole_incoming_free hget + apply hfree + apply List.mem_append_left + rw [List.mem_filterMap] + exact ⟨root, hroot, by simp [rootLocation?, heq, rvalLocation?]⟩ + +theorem child_location_mem_edgeLocations {store : Store} {parent : Nat} + {box : NodeBox} {childLoc : Nat} + (hparent : store.get? parent = some box) + (hchild : RVal.loc childLoc ∈ nodeChildren box.node) : + childLoc ∈ edgeLocations store := by + have harray : some box ∈ store.nodes := + (Array.mem_iff_getElem?).2 ⟨parent, nodes_get?_of_get? hparent⟩ + have hslot : some box ∈ store.nodes.toList := by simpa using harray + rw [edgeLocations, List.mem_flatMap] + refine ⟨some box, hslot, ?_⟩ + change childLoc ∈ (nodeChildren box.node).filterMap rvalLocation? + rw [List.mem_filterMap] + exact ⟨.loc childLoc, hchild, rfl⟩ + +theorem RootOwnership.sole_child_ne {store : Store} {loc : Nat} + {node : Node} {rest : List Root} + (hget : store.get? loc = some ⟨.shared, 1, node⟩) + (h : RootOwnership store (⟨.shared, .loc loc⟩ :: rest)) + {parent : Nat} {box : NodeBox} {child : RVal} + (hparent : store.get? parent = some box) + (hchild : child ∈ nodeChildren box.node) : child ≠ .loc loc := by + intro heq + subst child + have hfree := h.sole_incoming_free hget + apply hfree + apply List.mem_append_right + exact child_location_mem_edgeLocations hparent hchild + +theorem RootOwnership.sole_root_ne_unique {store : Store} {loc : Nat} + {node : Node} {rest : List Root} + (hget : store.get? loc = some ⟨.unique, 1, node⟩) + (h : RootOwnership store (⟨.unique, .loc loc⟩ :: rest)) + {root : Root} (hroot : root ∈ rest) : root.value ≠ .loc loc := by + intro heq + have hfree := h.sole_incoming_free_unique hget + apply hfree + apply List.mem_append_left + rw [List.mem_filterMap] + exact ⟨root, hroot, by simp [rootLocation?, heq, rvalLocation?]⟩ + +theorem RootOwnership.sole_child_ne_unique {store : Store} {loc : Nat} + {node : Node} {rest : List Root} + (hget : store.get? loc = some ⟨.unique, 1, node⟩) + (h : RootOwnership store (⟨.unique, .loc loc⟩ :: rest)) + {parent : Nat} {box : NodeBox} {child : RVal} + (hparent : store.get? parent = some box) + (hchild : child ∈ nodeChildren box.node) : child ≠ .loc loc := by + intro heq + subst child + have hfree := h.sole_incoming_free_unique hget + apply hfree + apply List.mem_append_right + exact child_location_mem_edgeLocations hparent hchild + +/-- Killing one live slot preserves the world of every value which does not +name that slot. -/ +theorem HasWorld.kill {store : Store} {loc : Nat} {box : NodeBox} + {world : Owned} {value : RVal} + (hlive : store.get? loc = some box) (hne : value ≠ .loc loc) + (h : HasWorld store world value) : + HasWorld (store.kill loc) world value := by + cases value with + | loc valueLoc => + obtain ⟨valueBox, hvalue, hworld⟩ := h + have hloc : loc ≠ valueLoc := by + intro heq + subst valueLoc + exact hne rfl + exact ⟨valueBox, get?_kill_other hloc hlive hvalue, hworld⟩ + | lit l => trivial + | erased => trivial + +/-- Ownership-facing form of in-place unique reuse. It kills and revives the +same slot, then restores the evaluator's counter behavior: one reuse and no +free. Its node array is extensionally the evaluator's direct overwrite. -/ +def reuseNodeStore (store : Store) (loc : Nat) (node : Node) : Store := + let revived := (store.kill loc).setBox loc ⟨.unique, 1, node⟩ + { revived with frees := store.frees, reuses := store.reuses + 1 } + +theorem reuseNodeStore_eq_direct (store : Store) (loc : Nat) (node : Node) : + reuseNodeStore store loc node = + let updated := store.setBox loc ⟨.unique, 1, node⟩ + { updated with reuses := updated.reuses + 1 } := by + cases store + simp [reuseNodeStore, Store.kill, Store.setBox, + Array.set!_eq_setIfInBounds] + +theorem get?_reuseNodeStore_same {store : Store} {loc : Nat} + {oldBox : NodeBox} {node : Node} + (hget : store.get? loc = some oldBox) : + (reuseNodeStore store loc node).get? loc = + some ⟨.unique, 1, node⟩ := by + have hnodes := nodes_get?_of_get? hget + obtain ⟨hlt, _⟩ := Array.getElem?_eq_some_iff.mp hnodes + simp [reuseNodeStore, Store.kill, Store.setBox, Store.get?, + Array.set!_eq_setIfInBounds, hlt] + +theorem get?_reuseNodeStore_other {store : Store} {loc other : Nat} + {oldBox otherBox : NodeBox} {node : Node} (hne : loc ≠ other) + (hlive : store.get? loc = some oldBox) + (hget : store.get? other = some otherBox) : + (reuseNodeStore store loc node).get? other = some otherBox := by + have hnodes := nodes_get?_of_get? hlive + obtain ⟨hlt, _⟩ := Array.getElem?_eq_some_iff.mp hnodes + simpa [reuseNodeStore, Store.kill, Store.setBox, Store.get?, + Array.set!_eq_setIfInBounds, Array.getElem?_setIfInBounds, hlt, hne] + using hget + +theorem get?_of_reuseNodeStore_other {store : Store} {loc other : Nat} + {oldBox otherBox : NodeBox} {node : Node} (hne : loc ≠ other) + (hlive : store.get? loc = some oldBox) + (hget : (reuseNodeStore store loc node).get? other = some otherBox) : + store.get? other = some otherBox := by + have hnodes := nodes_get?_of_get? hlive + obtain ⟨hlt, _⟩ := Array.getElem?_eq_some_iff.mp hnodes + simpa [reuseNodeStore, Store.kill, Store.setBox, Store.get?, + Array.set!_eq_setIfInBounds, Array.getElem?_setIfInBounds, hlt, hne] + using hget + +theorem count_edgeLocations_reuseNodeStore {store : Store} {loc : Nat} + {oldBox : NodeBox} {node : Node} (needle : Nat) + (hget : store.get? loc = some oldBox) : + List.count needle (edgeLocations (reuseNodeStore store loc node)) = + List.count needle (edgeLocations (store.kill loc)) + + List.count needle ((nodeChildren node).filterMap rvalLocation?) := by + have hnodes := nodes_get?_of_get? hget + obtain ⟨hlt, _⟩ := Array.getElem?_eq_some_iff.mp hnodes + have hslot : (store.kill loc).nodes.toList[loc]? = some none := by + simp [Store.kill, Array.set!_eq_setIfInBounds, hlt] + rw [edgeLocations, edgeLocations, reuseNodeStore, Store.setBox, + Array.toList_set!] + apply count_flatMap_set_add slotEdgeLocations needle hslot + rfl + +theorem incoming_reuseNodeStore_same (store : Store) (loc : Nat) + (oldBox : NodeBox) (node : Node) (rest : List Root) + (hget : store.get? loc = some oldBox) : + incoming (reuseNodeStore store loc node) + (⟨.unique, .loc loc⟩ :: rest) loc = + incoming (store.kill loc) + (rootsFor .unique (nodeChildren node) ++ rest) loc + 1 := by + have hedge := + count_edgeLocations_reuseNodeStore (node := node) loc hget + simp [incoming, List.filterMap_append, + rootLocation?, rvalLocation?, List.count] at hedge ⊢ + omega + +theorem incoming_reuseNodeStore_other (store : Store) (loc : Nat) + (oldBox : NodeBox) (node : Node) (rest : List Root) {other : Nat} + (hne : loc ≠ other) (hget : store.get? loc = some oldBox) : + incoming (reuseNodeStore store loc node) + (⟨.unique, .loc loc⟩ :: rest) other = + incoming (store.kill loc) + (rootsFor .unique (nodeChildren node) ++ rest) other := by + have hedge := + count_edgeLocations_reuseNodeStore (node := node) other hget + simp [incoming, List.filterMap_append, List.count_append, + rootLocation?, rvalLocation?, hne] at hedge ⊢ + omega + +theorem HasWorld.reuseNodeStore {store : Store} {loc : Nat} + {oldBox : NodeBox} {node : Node} {world : Owned} {value : RVal} + (hget : store.get? loc = some oldBox) + (h : HasWorld (store.kill loc) world value) : + HasWorld (reuseNodeStore store loc node) world value := by + cases value with + | loc valueLoc => + obtain ⟨valueBox, hvalue, hworld⟩ := h + have hne : loc ≠ valueLoc := by + intro heq + subst valueLoc + rw [get?_kill_same hget] at hvalue + contradiction + have hold : store.get? valueLoc = some valueBox := + get?_of_kill_other hne hget hvalue + exact ⟨valueBox, get?_reuseNodeStore_other hne hget hold, hworld⟩ + | lit literal => trivial + | erased => trivial + +/-- Ownership-facing form of in-place shared reuse. As for unique reuse, +the slot is killed and revived to expose the ownership transition while the +observable allocator counters are restored to the evaluator's direct +overwrite behavior: one reuse and no free. -/ +def reuseSharedNodeStore (store : Store) (loc : Nat) (node : Node) : Store := + let revived := (store.kill loc).setBox loc ⟨.shared, 1, node⟩ + { revived with frees := store.frees, reuses := store.reuses + 1 } + +theorem reuseSharedNodeStore_eq_direct (store : Store) (loc : Nat) + (node : Node) : + reuseSharedNodeStore store loc node = + let updated := store.setBox loc ⟨.shared, 1, node⟩ + { updated with reuses := updated.reuses + 1 } := by + cases store + simp [reuseSharedNodeStore, Store.kill, Store.setBox, + Array.set!_eq_setIfInBounds] + +theorem get?_reuseSharedNodeStore_same {store : Store} {loc : Nat} + {oldBox : NodeBox} {node : Node} + (hget : store.get? loc = some oldBox) : + (reuseSharedNodeStore store loc node).get? loc = + some ⟨.shared, 1, node⟩ := by + have hnodes := nodes_get?_of_get? hget + obtain ⟨hlt, _⟩ := Array.getElem?_eq_some_iff.mp hnodes + simp [reuseSharedNodeStore, Store.kill, Store.setBox, Store.get?, + Array.set!_eq_setIfInBounds, hlt] + +theorem get?_reuseSharedNodeStore_other {store : Store} {loc other : Nat} + {oldBox otherBox : NodeBox} {node : Node} (hne : loc ≠ other) + (hlive : store.get? loc = some oldBox) + (hget : store.get? other = some otherBox) : + (reuseSharedNodeStore store loc node).get? other = some otherBox := by + have hnodes := nodes_get?_of_get? hlive + obtain ⟨hlt, _⟩ := Array.getElem?_eq_some_iff.mp hnodes + simpa [reuseSharedNodeStore, Store.kill, Store.setBox, Store.get?, + Array.set!_eq_setIfInBounds, Array.getElem?_setIfInBounds, hlt, hne] + using hget + +theorem get?_of_reuseSharedNodeStore_other {store : Store} + {loc other : Nat} {oldBox otherBox : NodeBox} {node : Node} + (hne : loc ≠ other) (hlive : store.get? loc = some oldBox) + (hget : (reuseSharedNodeStore store loc node).get? other = + some otherBox) : + store.get? other = some otherBox := by + have hnodes := nodes_get?_of_get? hlive + obtain ⟨hlt, _⟩ := Array.getElem?_eq_some_iff.mp hnodes + simpa [reuseSharedNodeStore, Store.kill, Store.setBox, Store.get?, + Array.set!_eq_setIfInBounds, Array.getElem?_setIfInBounds, hlt, hne] + using hget + +theorem count_edgeLocations_reuseSharedNodeStore {store : Store} + {loc : Nat} {oldBox : NodeBox} {node : Node} (needle : Nat) + (hget : store.get? loc = some oldBox) : + List.count needle (edgeLocations (reuseSharedNodeStore store loc node)) = + List.count needle (edgeLocations (store.kill loc)) + + List.count needle ((nodeChildren node).filterMap rvalLocation?) := by + have hnodes := nodes_get?_of_get? hget + obtain ⟨hlt, _⟩ := Array.getElem?_eq_some_iff.mp hnodes + have hslot : (store.kill loc).nodes.toList[loc]? = some none := by + simp [Store.kill, Array.set!_eq_setIfInBounds, hlt] + rw [edgeLocations, edgeLocations, reuseSharedNodeStore, Store.setBox, + Array.toList_set!] + apply count_flatMap_set_add slotEdgeLocations needle hslot + rfl + +theorem incoming_reuseSharedNodeStore_same (store : Store) (loc : Nat) + (oldBox : NodeBox) (node : Node) (rest : List Root) + (hget : store.get? loc = some oldBox) : + incoming (reuseSharedNodeStore store loc node) + (⟨.shared, .loc loc⟩ :: rest) loc = + incoming (store.kill loc) + (rootsFor .shared (nodeChildren node) ++ rest) loc + 1 := by + have hedge := + count_edgeLocations_reuseSharedNodeStore (node := node) loc hget + simp [incoming, List.filterMap_append, + rootLocation?, rvalLocation?, List.count] at hedge ⊢ + omega + +theorem incoming_reuseSharedNodeStore_other (store : Store) (loc : Nat) + (oldBox : NodeBox) (node : Node) (rest : List Root) {other : Nat} + (hne : loc ≠ other) (hget : store.get? loc = some oldBox) : + incoming (reuseSharedNodeStore store loc node) + (⟨.shared, .loc loc⟩ :: rest) other = + incoming (store.kill loc) + (rootsFor .shared (nodeChildren node) ++ rest) other := by + have hedge := + count_edgeLocations_reuseSharedNodeStore (node := node) other hget + simp [incoming, List.filterMap_append, List.count_append, + rootLocation?, rvalLocation?, hne] at hedge ⊢ + omega + +theorem HasWorld.reuseSharedNodeStore {store : Store} {loc : Nat} + {oldBox : NodeBox} {node : Node} {world : Owned} {value : RVal} + (hget : store.get? loc = some oldBox) + (h : HasWorld (store.kill loc) world value) : + HasWorld (reuseSharedNodeStore store loc node) world value := by + cases value with + | loc valueLoc => + obtain ⟨valueBox, hvalue, hworld⟩ := h + have hne : loc ≠ valueLoc := by + intro heq + subst valueLoc + rw [get?_kill_same hget] at hvalue + contradiction + have hold : store.get? valueLoc = some valueBox := + get?_of_kill_other hne hget hvalue + exact ⟨valueBox, get?_reuseSharedNodeStore_other hne hget hold, + hworld⟩ + | lit literal => trivial + | erased => trivial + +/-- Store transition performed by a successful `dup` on a shared location. -/ +def incRcStore (store : Store) (loc : Nat) (box : NodeBox) : Store := + (store.setBox loc { box with rc := box.rc + 1 }).rcTick + +@[simp] theorem get?_rcTick (store : Store) (loc : Nat) : + store.rcTick.get? loc = store.get? loc := rfl + +/-- Reference-count instrumentation changes no ownership-relevant store +state. -/ +theorem RootOwnership.rcTick {store : Store} {roots : List Root} + (h : RootOwnership store roots) : RootOwnership store.rcTick roots := by + refine ⟨?_, ?_, ?_, ?_⟩ + · intro root hroot + simpa [HasWorld, Store.rcTick, Store.get?] using + h.roots_world root hroot + · intro loc box hbox child hchild + have hold : store.get? loc = some box := by simpa using hbox + simpa [HasWorld, Store.rcTick, Store.get?] using + h.edges_world hold child hchild + · intro loc box f arity args hbox hnode + apply h.pap_shared (loc := loc) (box := box) (f := f) + (arity := arity) (args := args) + · simpa using hbox + · exact hnode + · intro loc box hbox + have hold : store.get? loc = some box := by simpa using hbox + simpa [incoming, edgeLocations, Store.rcTick] using h.counts hold + +/-- Inverse allocation for the final shared owner: remove the node and turn +each outgoing field/capture edge into a temporary root for recursive drop. -/ +theorem RootOwnership.killSharedOne {store : Store} {loc : Nat} + {node : Node} {rest : List Root} + (hget : store.get? loc = some ⟨.shared, 1, node⟩) + (h : RootOwnership store (⟨.shared, .loc loc⟩ :: rest)) : + RootOwnership (store.kill loc) + (rootsFor .shared (nodeChildren node) ++ rest) := by + refine ⟨?_, ?_, ?_, ?_⟩ + · intro root hroot + rcases List.mem_append.mp hroot with hchildRoot | hrest + · rw [rootsFor, List.mem_map] at hchildRoot + obtain ⟨child, hchild, rfl⟩ := hchildRoot + apply HasWorld.kill hget (h.sole_child_ne hget hget hchild) + exact h.edges_world hget child hchild + · apply HasWorld.kill hget (h.sole_root_ne hget hrest) + apply h.roots_world root + exact List.mem_cons_of_mem _ hrest + · intro parent parentBox hparent child hchild + have hne : loc ≠ parent := by + intro heq + subst parent + rw [get?_kill_same hget] at hparent + contradiction + have hold : store.get? parent = some parentBox := + get?_of_kill_other hne hget hparent + apply HasWorld.kill hget (h.sole_child_ne hget hold hchild) + exact h.edges_world hold child hchild + · intro parent parentBox f arity args hparent hnode + have hne : loc ≠ parent := by + intro heq + subst parent + rw [get?_kill_same hget] at hparent + contradiction + have hold : store.get? parent = some parentBox := + get?_of_kill_other hne hget hparent + exact h.pap_shared hold hnode + · intro parent parentBox hparent + have hne : loc ≠ parent := by + intro heq + subst parent + rw [get?_kill_same hget] at hparent + contradiction + have hold : store.get? parent = some parentBox := + get?_of_kill_other hne hget hparent + have hincoming := + incoming_kill_shared_one store loc node rest parent hget + have hincoming' : + incoming (store.kill loc) + (rootsFor .shared (nodeChildren node) ++ rest) parent = + incoming store (⟨.shared, .loc loc⟩ :: rest) parent := by + simpa [hne] using hincoming + rw [hincoming'] + exact h.counts hold + +/-- Inverse allocation for a unique node: remove its sole-owned slot and turn +each outgoing field edge into a temporary unique root for recursive `dropU`. -/ +theorem RootOwnership.killUniqueOne {store : Store} {loc : Nat} + {node : Node} {rest : List Root} + (hget : store.get? loc = some ⟨.unique, 1, node⟩) + (h : RootOwnership store (⟨.unique, .loc loc⟩ :: rest)) : + RootOwnership (store.kill loc) + (rootsFor .unique (nodeChildren node) ++ rest) := by + refine ⟨?_, ?_, ?_, ?_⟩ + · intro root hroot + rcases List.mem_append.mp hroot with hchildRoot | hrest + · rw [rootsFor, List.mem_map] at hchildRoot + obtain ⟨child, hchild, rfl⟩ := hchildRoot + apply HasWorld.kill hget + (h.sole_child_ne_unique hget hget hchild) + exact h.edges_world hget child hchild + · apply HasWorld.kill hget (h.sole_root_ne_unique hget hrest) + apply h.roots_world root + exact List.mem_cons_of_mem _ hrest + · intro parent parentBox hparent child hchild + have hne : loc ≠ parent := by + intro heq + subst parent + rw [get?_kill_same hget] at hparent + contradiction + have hold : store.get? parent = some parentBox := + get?_of_kill_other hne hget hparent + apply HasWorld.kill hget + (h.sole_child_ne_unique hget hold hchild) + exact h.edges_world hold child hchild + · intro parent parentBox f arity args hparent hnode + have hne : loc ≠ parent := by + intro heq + subst parent + rw [get?_kill_same hget] at hparent + contradiction + have hold : store.get? parent = some parentBox := + get?_of_kill_other hne hget hparent + exact h.pap_shared hold hnode + · intro parent parentBox hparent + have hne : loc ≠ parent := by + intro heq + subst parent + rw [get?_kill_same hget] at hparent + contradiction + have hold : store.get? parent = some parentBox := + get?_of_kill_other hne hget hparent + have hincoming := + incoming_kill_unique_one store loc node rest parent hget + have hincoming' : + incoming (store.kill loc) + (rootsFor .unique (nodeChildren node) ++ rest) parent = + incoming store (⟨.unique, .loc loc⟩ :: rest) parent := by + simpa [hne] using hincoming + rw [hincoming'] + exact h.counts hold + +/-- Constructor nodes may inhabit either world; pap nodes are always shared. -/ +def NodeWorld (world : Owned) : Node → Prop + | .ctorN _ _ => True + | .papN _ _ _ => world = .shared + +/-- Fill the just-killed slot with a unique node. This is allocation into a +known dead in-bounds slot: child roots become edges and a fresh root for the +revived location is produced. -/ +theorem RootOwnership.reviveUnique {store : Store} {loc : Nat} + {oldBox : NodeBox} {node : Node} {rest : List Root} + (hget : store.get? loc = some oldBox) + (h : RootOwnership (store.kill loc) + (rootsFor .unique (nodeChildren node) ++ rest)) + (hworld : NodeWorld .unique node) : + RootOwnership (reuseNodeStore store loc node) + (⟨.unique, .loc loc⟩ :: rest) := by + let updated : NodeBox := ⟨.unique, 1, node⟩ + have hupdated : (reuseNodeStore store loc node).get? loc = + some updated := get?_reuseNodeStore_same hget + have targetWorld : + HasWorld (reuseNodeStore store loc node) .unique (.loc loc) := + ⟨updated, hupdated, rfl⟩ + have childWorld : ∀ child ∈ nodeChildren node, + HasWorld (store.kill loc) .unique child := by + intro child hchild + apply h.roots_world ⟨.unique, child⟩ + apply List.mem_append_left rest + simp [rootsFor, hchild] + refine ⟨?_, ?_, ?_, ?_⟩ + · intro root hroot + simp only [List.mem_cons] at hroot + rcases hroot with rfl | hrest + · exact targetWorld + · apply HasWorld.reuseNodeStore hget + apply h.roots_world root + exact List.mem_append_right _ hrest + · intro parent parentBox hparent child hchild + by_cases heq : loc = parent + · subst parent + have hboxeq : parentBox = updated := by + exact Option.some.inj (hparent.symm.trans hupdated) + subst parentBox + exact HasWorld.reuseNodeStore hget (childWorld child hchild) + · have hold : store.get? parent = some parentBox := + get?_of_reuseNodeStore_other heq hget hparent + have hkilled : (store.kill loc).get? parent = some parentBox := + get?_kill_other heq hget hold + exact HasWorld.reuseNodeStore hget + (h.edges_world hkilled child hchild) + · intro parent parentBox f arity args hparent hnode + by_cases heq : loc = parent + · subst parent + have hboxeq : parentBox = updated := by + exact Option.some.inj (hparent.symm.trans hupdated) + subst parentBox + change node = .papN f arity args at hnode + cases node <;> simp_all [NodeWorld] + · have hold : store.get? parent = some parentBox := + get?_of_reuseNodeStore_other heq hget hparent + have hkilled : (store.kill loc).get? parent = some parentBox := + get?_kill_other heq hget hold + exact h.pap_shared hkilled hnode + · intro parent parentBox hparent + by_cases heq : loc = parent + · subst parent + have hboxeq : parentBox = updated := by + exact Option.some.inj (hparent.symm.trans hupdated) + subst parentBox + have hzero := h.incoming_eq_zero_of_dead (get?_kill_same hget) + have hcount := + incoming_reuseNodeStore_same store loc oldBox node rest hget + rw [hzero] at hcount + exact ⟨rfl, hcount⟩ + · have hold : store.get? parent = some parentBox := + get?_of_reuseNodeStore_other heq hget hparent + have hkilled : (store.kill loc).get? parent = some parentBox := + get?_kill_other heq hget hold + have hcount := h.counts hkilled + rw [incoming_reuseNodeStore_other store loc oldBox node rest heq hget] + exact hcount + +/-- In-place unique reuse consumes the old node root and the selected new +field roots, then produces the same location as a root. `hpartition` is the +ownership-level free/allocate pairing: the old fields plus ambient roots are +the new fields plus the roots that remain outside the node, **as +multisets** (`List.Perm`). Permutation rather than list equality is what +same-arity field replacement produces — reusing `Cons(x, xs)` as +`Cons(x, acc)` moves `acc` out of the ambient roots and `xs` into them, +with no split making the two sides equal as lists. -/ +theorem RootOwnership.reuseNode {store : Store} {loc : Nat} + {oldNode newNode : Node} {before after : List Root} + (hget : store.get? loc = some ⟨.unique, 1, oldNode⟩) + (h : RootOwnership store (⟨.unique, .loc loc⟩ :: before)) + (hpartition : + (rootsFor .unique (nodeChildren oldNode) ++ before).Perm + (rootsFor .unique (nodeChildren newNode) ++ after)) + (hworld : NodeWorld .unique newNode) : + RootOwnership (reuseNodeStore store loc newNode) + (⟨.unique, .loc loc⟩ :: after) := by + have hready := (h.killUniqueOne hget).perm hpartition + exact hready.reviveUnique hget hworld + +/-- Fill a just-killed slot with a shared node. The proof is the shared +counterpart of `reviveUnique`: the replacement root has refcount one, and +the children supplied as temporary roots become the replacement's outgoing +shared edges. -/ +theorem RootOwnership.reviveShared {store : Store} {loc : Nat} + {oldBox : NodeBox} {node : Node} {rest : List Root} + (hget : store.get? loc = some oldBox) + (h : RootOwnership (store.kill loc) + (rootsFor .shared (nodeChildren node) ++ rest)) + (_hworld : NodeWorld .shared node) : + RootOwnership (reuseSharedNodeStore store loc node) + (⟨.shared, .loc loc⟩ :: rest) := by + let updated : NodeBox := ⟨.shared, 1, node⟩ + have hupdated : (reuseSharedNodeStore store loc node).get? loc = + some updated := get?_reuseSharedNodeStore_same hget + have targetWorld : + HasWorld (reuseSharedNodeStore store loc node) .shared (.loc loc) := + ⟨updated, hupdated, rfl⟩ + have childWorld : ∀ child ∈ nodeChildren node, + HasWorld (store.kill loc) .shared child := by + intro child hchild + apply h.roots_world ⟨.shared, child⟩ + apply List.mem_append_left rest + simp [rootsFor, hchild] + refine ⟨?_, ?_, ?_, ?_⟩ + · intro root hroot + simp only [List.mem_cons] at hroot + rcases hroot with rfl | hrest + · exact targetWorld + · apply HasWorld.reuseSharedNodeStore hget + apply h.roots_world root + exact List.mem_append_right _ hrest + · intro parent parentBox hparent child hchild + by_cases heq : loc = parent + · subst parent + have hboxeq : parentBox = updated := by + exact Option.some.inj (hparent.symm.trans hupdated) + subst parentBox + exact HasWorld.reuseSharedNodeStore hget (childWorld child hchild) + · have hold : store.get? parent = some parentBox := + get?_of_reuseSharedNodeStore_other heq hget hparent + have hkilled : (store.kill loc).get? parent = some parentBox := + get?_kill_other heq hget hold + exact HasWorld.reuseSharedNodeStore hget + (h.edges_world hkilled child hchild) + · intro parent parentBox f arity args hparent hnode + by_cases heq : loc = parent + · subst parent + have hboxeq : parentBox = updated := by + exact Option.some.inj (hparent.symm.trans hupdated) + subst parentBox + rfl + · have hold : store.get? parent = some parentBox := + get?_of_reuseSharedNodeStore_other heq hget hparent + have hkilled : (store.kill loc).get? parent = some parentBox := + get?_kill_other heq hget hold + exact h.pap_shared hkilled hnode + · intro parent parentBox hparent + by_cases heq : loc = parent + · subst parent + have hboxeq : parentBox = updated := by + exact Option.some.inj (hparent.symm.trans hupdated) + subst parentBox + have hzero := h.incoming_eq_zero_of_dead (get?_kill_same hget) + have hcount := + incoming_reuseSharedNodeStore_same store loc oldBox node rest hget + rw [hzero] at hcount + exact hcount.symm + · have hold : store.get? parent = some parentBox := + get?_of_reuseSharedNodeStore_other heq hget hparent + have hkilled : (store.kill loc).get? parent = some parentBox := + get?_kill_other heq hget hold + have hcount := h.counts hkilled + rw [incoming_reuseSharedNodeStore_other store loc oldBox node rest + heq hget] + exact hcount + +/-- In-place shared reuse consumes the unit-refcount parent root and the +selected replacement-field roots, then produces the reused location as a +shared root. As in unique reuse, the field/ambient accounting is stated as +a root-multiset permutation. -/ +theorem RootOwnership.reuseSharedNode {store : Store} {loc : Nat} + {oldNode newNode : Node} {before after : List Root} + (hget : store.get? loc = some ⟨.shared, 1, oldNode⟩) + (h : RootOwnership store (⟨.shared, .loc loc⟩ :: before)) + (hpartition : + (rootsFor .shared (nodeChildren oldNode) ++ before).Perm + (rootsFor .shared (nodeChildren newNode) ++ after)) + (hworld : NodeWorld .shared newNode) : + RootOwnership (reuseSharedNodeStore store loc newNode) + (⟨.shared, .loc loc⟩ :: after) := by + have hready := (h.killSharedOne hget).perm hpartition + exact hready.reviveShared hget hworld + +/-- Consuming a scalar root changes no heap ownership. -/ +theorem RootOwnership.dropNoLocation {store : Store} {world : Owned} + {value : RVal} {rest : List Root} + (hnone : rvalLocation? value = none) + (h : RootOwnership store (⟨world, value⟩ :: rest)) : + RootOwnership store rest := by + refine ⟨?_, ?_, ?_, ?_⟩ + · intro root hroot + exact h.roots_world root (List.mem_cons_of_mem _ hroot) + · exact h.edges_world + · exact h.pap_shared + · intro loc box hbox + simpa [incoming, rootLocation?, hnone] using h.counts hbox + +/-- Scalars may be added as roots without changing heap ownership. -/ +theorem RootOwnership.addNoLocation {store : Store} {world : Owned} + {value : RVal} {rest : List Root} + (hnone : rvalLocation? value = none) + (h : RootOwnership store rest) : + RootOwnership store (⟨world, value⟩ :: rest) := by + have hscalar : HasWorld store world value := by + cases value <;> simp_all [rvalLocation?, HasWorld] + refine ⟨?_, ?_, ?_, ?_⟩ + · intro root hroot + simp only [List.mem_cons] at hroot + rcases hroot with rfl | hrest + · exact hscalar + · exact h.roots_world root hrest + · exact h.edges_world + · exact h.pap_shared + · intro loc box hbox + simpa [incoming, rootLocation?, hnone] using h.counts hbox + +theorem RVal.rvalLocation?_eq_none_of_isScalar {value : RVal} + (hscalar : value.isScalar = true) : rvalLocation? value = none := by + cases value <;> simp_all [RVal.isScalar, rvalLocation?] + +/-- A scalar-only argument vector contributes no heap owners, so consuming +all of its logical roots leaves the ambient ownership state unchanged. -/ +theorem RootOwnership.dropScalars {store : Store} {world : Owned} + {rest : List Root} : + ∀ {values : List RVal}, values.all RVal.isScalar = true → + RootOwnership store (rootsFor world values ++ rest) → + RootOwnership store rest := by + intro values hscalar hown + induction values with + | nil => simpa [rootsFor] using hown + | cons value values ih => + simp only [List.all_cons, Bool.and_eq_true] at hscalar + have hcons : RootOwnership store + (⟨world, value⟩ :: (rootsFor world values ++ rest)) := by + simpa [rootsFor] using hown + exact ih hscalar.2 + (hcons.dropNoLocation + (RVal.rvalLocation?_eq_none_of_isScalar hscalar.1)) + +/-- Successful use of the v1 extern boundary certifies both sides of the +call as scalar-only. -/ +theorem callScalarOracle_ok {ctx : Ctx} {f : Address} + {args : List RVal} {value : RVal} + (hcall : callScalarOracle ctx f args = .ok value) : + args.all RVal.isScalar = true ∧ value.isScalar = true := by + cases hargs : args.all RVal.isScalar with + | false => simp [callScalarOracle, hargs] at hcall + | true => + cases horacle : ctx.oracle f args with + | none => simp [callScalarOracle, hargs, horacle] at hcall + | some result => + cases hresult : result.isScalar with + | false => simp [callScalarOracle, hargs, horacle, hresult] at hcall + | true => + simp [callScalarOracle, hargs, horacle, hresult] at hcall + subst value + exact ⟨rfl, hresult⟩ + +theorem RootOwnership.shared_rc_pos {store : Store} {loc rc : Nat} + {node : Node} {rest : List Root} + (hget : store.get? loc = some ⟨.shared, rc, node⟩) + (h : RootOwnership store (⟨.shared, .loc loc⟩ :: rest)) : 0 < rc := by + have hcount := h.counts hget + change rc = incoming store (⟨.shared, .loc loc⟩ :: rest) loc at hcount + rw [hcount, incoming] + simp [rootLocation?, rvalLocation?, List.count] + +theorem get?_incRcStore_same {store : Store} {loc : Nat} {box : NodeBox} + (h : store.get? loc = some box) : + (incRcStore store loc box).get? loc = + some { box with rc := box.rc + 1 } := by + rw [incRcStore, get?_rcTick] + exact get?_setBox_same (new := { box with rc := box.rc + 1 }) h + +theorem get?_incRcStore_other {store : Store} {loc other : Nat} + {box otherBox : NodeBox} (hne : loc ≠ other) + (hlive : store.get? loc = some box) + (h : store.get? other = some otherBox) : + (incRcStore store loc box).get? other = some otherBox := by + rw [incRcStore, get?_rcTick] + exact get?_setBox_other (new := { box with rc := box.rc + 1 }) + hne hlive h + +theorem get?_of_incRcStore_other {store : Store} {loc other : Nat} + {box otherBox : NodeBox} (hne : loc ≠ other) + (hlive : store.get? loc = some box) + (h : (incRcStore store loc box).get? other = some otherBox) : + store.get? other = some otherBox := by + apply get?_of_setBox_other (new := { box with rc := box.rc + 1 }) + hne hlive + rw [incRcStore, get?_rcTick] at h + exact h + +/-- Incrementing one shared refcount preserves every live node's semantic +shape; only the selected node's count changes. -/ +theorem StoreGraphExtends.incRcStore {store : Store} {loc rc : Nat} + {node : Node} + (hget : store.get? loc = some ⟨.shared, rc, node⟩) : + StoreGraphExtends store + (incRcStore store loc ⟨.shared, rc, node⟩) := by + intro other world otherRc otherNode hother + by_cases heq : loc = other + · subst other + have hbox : (⟨world, otherRc, otherNode⟩ : NodeBox) = + ⟨.shared, rc, node⟩ := + Option.some.inj (hother.symm.trans hget) + cases hbox + exact ⟨rc + 1, get?_incRcStore_same hget⟩ + · exact ⟨otherRc, get?_incRcStore_other heq hget hother⟩ + +/-- Incrementing one shared refcount also preserves every resulting live +node's prior semantic shape. This is the reverse inclusion counterpart of +`StoreGraphExtends.incRcStore`. -/ +theorem StoreGraphRestricts.incRcStore {store : Store} {loc rc : Nat} + {node : Node} + (hget : store.get? loc = some ⟨.shared, rc, node⟩) : + StoreGraphRestricts store + (incRcStore store loc ⟨.shared, rc, node⟩) := by + intro other world otherRc otherNode hother + by_cases heq : loc = other + · subst other + have hupdated := get?_incRcStore_same hget + have hbox : (⟨world, otherRc, otherNode⟩ : NodeBox) = + ⟨.shared, rc + 1, node⟩ := + Option.some.inj (hother.symm.trans hupdated) + cases hbox + exact ⟨rc, hget⟩ + · exact ⟨otherRc, get?_of_incRcStore_other heq hget hother⟩ + +theorem edgeLocations_incRcStore {store : Store} {loc : Nat} {box : NodeBox} + (h : store.get? loc = some box) : + edgeLocations (incRcStore store loc box) = edgeLocations store := by + have hnodes := nodes_get?_of_get? h + have hlist : store.nodes.toList[loc]? = some (some box) := by + simpa using hnodes + rw [edgeLocations, incRcStore, Store.rcTick, Store.setBox, + Array.toList_set!] + apply flatMap_set_eq_self slotEdgeLocations hlist + rfl + +theorem incoming_incRcStore_same (store : Store) (loc rc : Nat) + (node : Node) (rest : List Root) + (hget : store.get? loc = some ⟨.shared, rc, node⟩) : + incoming (incRcStore store loc ⟨.shared, rc, node⟩) + (⟨.shared, .loc loc⟩ :: ⟨.shared, .loc loc⟩ :: rest) loc = + incoming store (⟨.shared, .loc loc⟩ :: rest) loc + 1 := by + rw [incoming, incoming, edgeLocations_incRcStore hget] + simp [rootLocation?, rvalLocation?, List.count_append] + +theorem incoming_incRcStore_other (store : Store) (loc rc : Nat) + (node : Node) (rest : List Root) {other : Nat} (hne : loc ≠ other) + (hget : store.get? loc = some ⟨.shared, rc, node⟩) : + incoming (incRcStore store loc ⟨.shared, rc, node⟩) + (⟨.shared, .loc loc⟩ :: ⟨.shared, .loc loc⟩ :: rest) other = + incoming store (⟨.shared, .loc loc⟩ :: rest) other := by + rw [incoming, incoming, edgeLocations_incRcStore hget] + simp [rootLocation?, rvalLocation?, List.count_append, hne] + +theorem incoming_incRcStore_retain_same (store : Store) (loc rc : Nat) + (node : Node) (rest : List Root) + (hget : store.get? loc = some ⟨.shared, rc, node⟩) : + incoming (incRcStore store loc ⟨.shared, rc, node⟩) + (⟨.shared, .loc loc⟩ :: rest) loc = + incoming store rest loc + 1 := by + rw [incoming, incoming, edgeLocations_incRcStore hget] + simp [rootLocation?, rvalLocation?, List.count_append, Nat.add_comm] + +theorem incoming_incRcStore_retain_other (store : Store) (loc rc : Nat) + (node : Node) (rest : List Root) {other : Nat} (hne : loc ≠ other) + (hget : store.get? loc = some ⟨.shared, rc, node⟩) : + incoming (incRcStore store loc ⟨.shared, rc, node⟩) + (⟨.shared, .loc loc⟩ :: rest) other = + incoming store rest other := by + rw [incoming, incoming, edgeLocations_incRcStore hget] + simp [rootLocation?, rvalLocation?, List.count_append, hne] + +theorem HasWorld.incRcStore {store : Store} {loc rc : Nat} {node : Node} + {world : Owned} {value : RVal} + (hget : store.get? loc = some ⟨.shared, rc, node⟩) + (h : HasWorld store world value) : + HasWorld (incRcStore store loc ⟨.shared, rc, node⟩) world value := by + cases value with + | loc valueLoc => + obtain ⟨box, hbox, hworld⟩ := h + by_cases heq : loc = valueLoc + · subst valueLoc + have hboxeq : box = ⟨.shared, rc, node⟩ := by + exact Option.some.inj (hbox.symm.trans hget) + subst box + exact ⟨⟨.shared, rc + 1, node⟩, + get?_incRcStore_same hget, hworld⟩ + · exact ⟨box, get?_incRcStore_other heq hget hbox, hworld⟩ + | lit l => trivial + | erased => trivial + +/-- A successful shared `dup` retains the old root, returns a second root, +and increments exactly the corresponding reference count. -/ +theorem RootOwnership.dup {store : Store} {loc rc : Nat} {node : Node} + {rest : List Root} + (hget : store.get? loc = some ⟨.shared, rc, node⟩) + (h : RootOwnership store (⟨.shared, .loc loc⟩ :: rest)) : + RootOwnership (incRcStore store loc ⟨.shared, rc, node⟩) + (⟨.shared, .loc loc⟩ :: ⟨.shared, .loc loc⟩ :: rest) := by + let updated : NodeBox := ⟨.shared, rc + 1, node⟩ + have hupdated : + (incRcStore store loc ⟨.shared, rc, node⟩).get? loc = + some updated := by + exact get?_incRcStore_same hget + have targetWorld : + HasWorld (incRcStore store loc ⟨.shared, rc, node⟩) + .shared (.loc loc) := ⟨updated, hupdated, rfl⟩ + refine ⟨?_, ?_, ?_, ?_⟩ + · intro root hroot + simp only [List.mem_cons] at hroot + rcases hroot with rfl | rfl | hrest + · exact targetWorld + · exact targetWorld + · apply HasWorld.incRcStore hget + apply h.roots_world root + exact .tail _ hrest + · intro parent parentBox hparent child hchild + by_cases heq : loc = parent + · subst parent + have hboxeq : parentBox = updated := by + exact Option.some.inj (hparent.symm.trans hupdated) + subst parentBox + apply HasWorld.incRcStore hget + exact h.edges_world hget child hchild + · have hold : store.get? parent = some parentBox := + get?_of_incRcStore_other heq hget hparent + exact HasWorld.incRcStore hget (h.edges_world hold child hchild) + · intro parent parentBox f arity args hparent hnode + by_cases heq : loc = parent + · subst parent + have hboxeq : parentBox = updated := by + exact Option.some.inj (hparent.symm.trans hupdated) + subst parentBox + change node = .papN f arity args at hnode + exact h.pap_shared (loc := loc) + (box := (⟨.shared, rc, node⟩ : NodeBox)) hget hnode + · have hold : store.get? parent = some parentBox := + get?_of_incRcStore_other heq hget hparent + exact h.pap_shared hold hnode + · intro parent parentBox hparent + by_cases heq : loc = parent + · subst parent + have hboxeq : parentBox = updated := by + exact Option.some.inj (hparent.symm.trans hupdated) + subst parentBox + have hcount := h.counts hget + change rc = incoming store (⟨.shared, .loc loc⟩ :: rest) loc + at hcount + change rc + 1 = incoming + (incRcStore store loc ⟨.shared, rc, node⟩) + (⟨.shared, .loc loc⟩ :: ⟨.shared, .loc loc⟩ :: rest) loc + rw [incoming_incRcStore_same store loc rc node rest hget, hcount] + · have hold : store.get? parent = some parentBox := + get?_of_incRcStore_other heq hget hparent + have hcount := h.counts hold + rw [incoming_incRcStore_other store loc rc node rest heq hget] + exact hcount + +/-- Retain a borrowed shared value as a new external root. Unlike `dup`, the +borrow itself is an edge rather than an existing root, so this adds exactly +one root and increments the refcount once. -/ +theorem RootOwnership.retainShared {store : Store} {loc rc : Nat} + {node : Node} {rest : List Root} + (hget : store.get? loc = some ⟨.shared, rc, node⟩) + (h : RootOwnership store rest) : + RootOwnership (incRcStore store loc ⟨.shared, rc, node⟩) + (⟨.shared, .loc loc⟩ :: rest) := by + let updated : NodeBox := ⟨.shared, rc + 1, node⟩ + have hupdated : + (incRcStore store loc ⟨.shared, rc, node⟩).get? loc = + some updated := get?_incRcStore_same hget + have targetWorld : + HasWorld (incRcStore store loc ⟨.shared, rc, node⟩) + .shared (.loc loc) := ⟨updated, hupdated, rfl⟩ + refine ⟨?_, ?_, ?_, ?_⟩ + · intro root hroot + simp only [List.mem_cons] at hroot + rcases hroot with rfl | hrest + · exact targetWorld + · exact HasWorld.incRcStore hget (h.roots_world root hrest) + · intro parent parentBox hparent child hchild + by_cases heq : loc = parent + · subst parent + have hboxeq : parentBox = updated := by + exact Option.some.inj (hparent.symm.trans hupdated) + subst parentBox + exact HasWorld.incRcStore hget (h.edges_world hget child hchild) + · have hold : store.get? parent = some parentBox := + get?_of_incRcStore_other heq hget hparent + exact HasWorld.incRcStore hget (h.edges_world hold child hchild) + · intro parent parentBox f arity args hparent hnode + by_cases heq : loc = parent + · subst parent + have hboxeq : parentBox = updated := by + exact Option.some.inj (hparent.symm.trans hupdated) + subst parentBox + change node = .papN f arity args at hnode + exact h.pap_shared (loc := loc) + (box := (⟨.shared, rc, node⟩ : NodeBox)) hget hnode + · have hold : store.get? parent = some parentBox := + get?_of_incRcStore_other heq hget hparent + exact h.pap_shared hold hnode + · intro parent parentBox hparent + by_cases heq : loc = parent + · subst parent + have hboxeq : parentBox = updated := by + exact Option.some.inj (hparent.symm.trans hupdated) + subst parentBox + have hcount := h.counts hget + change rc = incoming store rest loc at hcount + change rc + 1 = incoming + (incRcStore store loc ⟨.shared, rc, node⟩) + (⟨.shared, .loc loc⟩ :: rest) loc + rw [incoming_incRcStore_retain_same store loc rc node rest hget, + hcount] + · have hold : store.get? parent = some parentBox := + get?_of_incRcStore_other heq hget hparent + have hcount := h.counts hold + rw [incoming_incRcStore_retain_other store loc rc node rest heq hget] + exact hcount + +/-- Store transition performed by a non-final shared `drop`. -/ +def decRcStore (store : Store) (loc : Nat) (box : NodeBox) : Store := + store.rcTick.setBox loc { box with rc := box.rc - 1 } + +theorem get?_decRcStore_same {store : Store} {loc : Nat} {box : NodeBox} + (h : store.get? loc = some box) : + (decRcStore store loc box).get? loc = + some { box with rc := box.rc - 1 } := by + apply get?_setBox_same + simpa using h + +theorem get?_decRcStore_other {store : Store} {loc other : Nat} + {box otherBox : NodeBox} (hne : loc ≠ other) + (hlive : store.get? loc = some box) + (h : store.get? other = some otherBox) : + (decRcStore store loc box).get? other = some otherBox := by + apply get?_setBox_other hne + · simpa using hlive + · simpa using h + +theorem get?_of_decRcStore_other {store : Store} {loc other : Nat} + {box otherBox : NodeBox} (hne : loc ≠ other) + (hlive : store.get? loc = some box) + (h : (decRcStore store loc box).get? other = some otherBox) : + store.get? other = some otherBox := by + have h' : store.rcTick.get? other = some otherBox := by + apply get?_of_setBox_other hne + · simpa using hlive + · exact h + simpa using h' + +/-- Decrementing a shared node's refcount preserves every live node shape. -/ +theorem StoreGraphRestricts.decRcStore {store : Store} {loc : Nat} + {box : NodeBox} (hlive : store.get? loc = some box) : + StoreGraphRestricts store (decRcStore store loc box) := by + intro other world rc node hafter + by_cases heq : loc = other + · subst other + have hupdated := get?_decRcStore_same hlive + have hboxEq : + ({ box with rc := box.rc - 1 } : NodeBox) = ⟨world, rc, node⟩ := + Option.some.inj (hupdated.symm.trans hafter) + cases box with + | mk boxWorld boxRc boxNode => + simp only at hboxEq + cases hboxEq + exact ⟨boxRc, hlive⟩ + · exact ⟨rc, get?_of_decRcStore_other heq hlive hafter⟩ + +theorem edgeLocations_decRcStore {store : Store} {loc : Nat} {box : NodeBox} + (h : store.get? loc = some box) : + edgeLocations (decRcStore store loc box) = edgeLocations store := by + have hnodes := nodes_get?_of_get? h + have hlist : store.nodes.toList[loc]? = some (some box) := by + simpa using hnodes + rw [edgeLocations, decRcStore, Store.setBox, Store.rcTick, + Array.toList_set!] + apply flatMap_set_eq_self slotEdgeLocations hlist + rfl + +theorem incoming_decRcStore_same (store : Store) (loc rc : Nat) + (node : Node) (rest : List Root) + (hget : store.get? loc = some ⟨.shared, rc, node⟩) : + incoming (decRcStore store loc ⟨.shared, rc, node⟩) rest loc + 1 = + incoming store (⟨.shared, .loc loc⟩ :: rest) loc := by + rw [incoming, incoming, edgeLocations_decRcStore hget] + simp [rootLocation?, rvalLocation?, List.count_append] + +theorem incoming_decRcStore_other (store : Store) (loc rc : Nat) + (node : Node) (rest : List Root) {other : Nat} (hne : loc ≠ other) + (hget : store.get? loc = some ⟨.shared, rc, node⟩) : + incoming (decRcStore store loc ⟨.shared, rc, node⟩) rest other = + incoming store (⟨.shared, .loc loc⟩ :: rest) other := by + rw [incoming, incoming, edgeLocations_decRcStore hget] + simp [rootLocation?, rvalLocation?, List.count_append, hne] + +theorem HasWorld.decRcStore {store : Store} {loc rc : Nat} {node : Node} + {world : Owned} {value : RVal} + (hget : store.get? loc = some ⟨.shared, rc, node⟩) + (h : HasWorld store world value) : + HasWorld (decRcStore store loc ⟨.shared, rc, node⟩) world value := by + cases value with + | loc valueLoc => + obtain ⟨box, hbox, hworld⟩ := h + by_cases heq : loc = valueLoc + · subst valueLoc + have hboxeq : box = ⟨.shared, rc, node⟩ := by + exact Option.some.inj (hbox.symm.trans hget) + subst box + exact ⟨⟨.shared, rc - 1, node⟩, + get?_decRcStore_same hget, hworld⟩ + · exact ⟨box, get?_decRcStore_other heq hget hbox, hworld⟩ + | lit l => trivial + | erased => trivial + +/-- A non-final shared `drop` consumes one root and decrements its positive +refcount. `dropVal_preserves` below combines this local branch with final-owner +reclamation through a mutual induction over the executable deep drop. -/ +theorem RootOwnership.dropSharedMany {store : Store} {loc rc : Nat} + {node : Node} {rest : List Root} (hrc : 1 < rc) + (hget : store.get? loc = some ⟨.shared, rc, node⟩) + (h : RootOwnership store (⟨.shared, .loc loc⟩ :: rest)) : + RootOwnership (decRcStore store loc ⟨.shared, rc, node⟩) rest := by + let updated : NodeBox := ⟨.shared, rc - 1, node⟩ + have hupdated : + (decRcStore store loc ⟨.shared, rc, node⟩).get? loc = + some updated := get?_decRcStore_same hget + refine ⟨?_, ?_, ?_, ?_⟩ + · intro root hroot + apply HasWorld.decRcStore hget + apply h.roots_world root + exact List.mem_cons_of_mem _ hroot + · intro parent parentBox hparent child hchild + by_cases heq : loc = parent + · subst parent + have hboxeq : parentBox = updated := by + exact Option.some.inj (hparent.symm.trans hupdated) + subst parentBox + apply HasWorld.decRcStore hget + exact h.edges_world hget child hchild + · have hold : store.get? parent = some parentBox := + get?_of_decRcStore_other heq hget hparent + exact HasWorld.decRcStore hget (h.edges_world hold child hchild) + · intro parent parentBox f arity args hparent hnode + by_cases heq : loc = parent + · subst parent + have hboxeq : parentBox = updated := by + exact Option.some.inj (hparent.symm.trans hupdated) + subst parentBox + change node = .papN f arity args at hnode + exact h.pap_shared (loc := loc) + (box := (⟨.shared, rc, node⟩ : NodeBox)) hget hnode + · have hold : store.get? parent = some parentBox := + get?_of_decRcStore_other heq hget hparent + exact h.pap_shared hold hnode + · intro parent parentBox hparent + by_cases heq : loc = parent + · subst parent + have hboxeq : parentBox = updated := by + exact Option.some.inj (hparent.symm.trans hupdated) + subst parentBox + have holdCount := h.counts hget + change rc = incoming store (⟨.shared, .loc loc⟩ :: rest) loc + at holdCount + change rc - 1 = incoming + (decRcStore store loc ⟨.shared, rc, node⟩) rest loc + have hdelta := incoming_decRcStore_same store loc rc node rest hget + omega + · have hold : store.get? parent = some parentBox := + get?_of_decRcStore_other heq hget hparent + have hcount := h.counts hold + rw [incoming_decRcStore_other store loc rc node rest heq hget] + exact hcount + +/-! The abstract store transitions above are definitionally the successful +branches of the executable evaluator. -/ + +private theorem bindOk {error α β : Type} (value : α) + (next : α → Except error β) : + (Except.ok value >>= next) = next value := rfl + +private theorem bindErr {error α β : Type} (err : error) + (next : α → Except error β) : + ((Except.error err : Except error α) >>= next) = .error err := rfl + +/-! A `case` dispatch borrows its scrutinee and fields: selecting a branch +does not mutate the store or add roots. The selected branch is responsible +for every retain/release operation. -/ + +theorem RootOwnership.caseFieldsBorrowed {store : Store} {roots : List Root} + {loc rc : Nat} {world : Owned} {cid : CtorId} {fields : Array RVal} + (hget : store.get? loc = some ⟨world, rc, .ctorN cid fields⟩) + (hown : RootOwnership store roots) : + ∀ field ∈ fields.toList, HasWorld store world field := by + intro field hfield + exact hown.edges_world hget field (by simpa [nodeChildren] using hfield) + +/-- Constructor-case dispatch is definitionally just entry into the selected +alternative with borrowed fields prepended to the environment. -/ +theorem runCode_case_ctor {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {scrut : Atom} {peelNat : Bool} + {alts : Array Alt} {loc rc : Nat} {world : Owned} {cid : CtorId} + {fields : Array RVal} {tag nf : Nat} {body : Code} + (hresolve : resolveAtom env scrut = .ok (.loc loc)) + (hget : store.get? loc = some ⟨world, rc, .ctorN cid fields⟩) + (halt : alts.find? (fun alt => alt.cidx == cid.cidx) = + some (.mk tag nf body)) + (hsize : fields.size = nf) : + runCode ctx (fuel + 1) cur store env (.case scrut peelNat alts) = + runCode ctx fuel cur store + (fields.foldl (fun e field => field :: e) env) body := by + rw [runCode.eq_def] + dsimp only + rw [hresolve, bindOk] + dsimp only + rw [hget] + dsimp only + rw [halt] + simp [hsize] + +/-- Exact constructor-case interface. The dispatcher preserves the incoming +root invariant and exposes only borrowed fields; a branch proof performs the +actual ownership transformation. -/ +theorem runCode_case_ctor_owned {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store store' : Store} {env : List RVal} {scrut : Atom} + {peelNat : Bool} {alts : Array Alt} {loc rc : Nat} {world : Owned} + {cid : CtorId} {fields : Array RVal} {tag nf : Nat} {body : Code} + {value : RVal} {roots : List Root} {rest : List Root} + (hresolve : resolveAtom env scrut = .ok (.loc loc)) + (hget : store.get? loc = some ⟨world, rc, .ctorN cid fields⟩) + (halt : alts.find? (fun alt => alt.cidx == cid.cidx) = + some (.mk tag nf body)) + (hsize : fields.size = nf) + (hown : RootOwnership store roots) + (hbranch : RootOwnership store roots → + (∀ field ∈ fields.toList, HasWorld store world field) → + runCode ctx fuel cur store + (fields.foldl (fun e field => field :: e) env) body = + .ok (store', value) → + RootOwnership store' (⟨cur.result, value⟩ :: rest)) + (hrun : runCode ctx (fuel + 1) cur store env + (.case scrut peelNat alts) = .ok (store', value)) : + RootOwnership store' (⟨cur.result, value⟩ :: rest) := by + rw [runCode_case_ctor hresolve hget halt hsize] at hrun + exact hbranch hown (hown.caseFieldsBorrowed hget) hrun + +/-- Constructor dispatch through a reusable alternative contract. The case +instruction supplies the field borrows; the selected alternative accounts +for every retain/release and preserves the caller continuation. -/ +theorem runCode_case_ctor_contract_owned {ctx : Ctx} {fuel : Nat} + {cur : FnDef} {store store' : Store} {env : List RVal} + {scrut : Atom} {peelNat : Bool} {alts : Array Alt} {loc rc : Nat} + {world : Owned} {cid : CtorId} {fields : Array RVal} {tag nf : Nat} + {body : Code} {value : RVal} {rest : List Root} + {entryValid : List RVal → Array RVal → Prop} + {entryRoots : List RVal → Array RVal → List Root} + (hresolve : resolveAtom env scrut = .ok (.loc loc)) + (hget : store.get? loc = some ⟨world, rc, .ctorN cid fields⟩) + (halt : alts.find? (fun alt => alt.cidx == cid.cidx) = + some (.mk tag nf body)) + (hsize : fields.size = nf) + (hcontract : AltOwnershipContract ctx cur (.mk tag nf body) + world entryValid entryRoots) + (hvalid : entryValid env fields) + (hown : RootOwnership store (entryRoots env fields ++ rest)) + (hrun : runCode ctx (fuel + 1) cur store env + (.case scrut peelNat alts) = .ok (store', value)) : + RootOwnership store' (⟨cur.result, value⟩ :: rest) := by + rw [runCode_case_ctor hresolve hget halt hsize] at hrun + exact hcontract.preserves hsize hvalid hown + (hown.caseFieldsBorrowed hget) hrun + +/-- A peeled zero literal enters the nullary alternative without changing +the store, environment, or roots. -/ +theorem runCode_case_nat_zero {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {scrut : Atom} {alts : Array Alt} + {tag : Nat} {body : Code} + (hresolve : resolveAtom env scrut = .ok (.lit (.nat 0))) + (halt : alts.find? (fun alt => alt.cidx == 0) = + some (.mk tag 0 body)) : + runCode ctx (fuel + 1) cur store env (.case scrut true alts) = + runCode ctx fuel cur store env body := by + rw [runCode.eq_def] + dsimp only + rw [hresolve, bindOk] + dsimp only + rw [halt] + simp + +/-- A peeled successor literal exposes its predecessor as an ownership-inert +literal binding. -/ +theorem runCode_case_nat_succ {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {scrut : Atom} {alts : Array Alt} + {n tag : Nat} {body : Code} + (hresolve : resolveAtom env scrut = .ok (.lit (.nat (n + 1)))) + (halt : alts.find? (fun alt => alt.cidx == 1) = + some (.mk tag 1 body)) : + runCode ctx (fuel + 1) cur store env (.case scrut true alts) = + runCode ctx fuel cur store (.lit (.nat n) :: env) body := by + rw [runCode.eq_def] + dsimp only + rw [hresolve, bindOk] + dsimp only + rw [halt] + simp + +/-- Exact root preservation wrapper for a peeled zero branch. -/ +theorem runCode_case_nat_zero_owned {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store store' : Store} {env : List RVal} {scrut : Atom} + {alts : Array Alt} {tag : Nat} {body : Code} {value : RVal} + {roots rest : List Root} + (hresolve : resolveAtom env scrut = .ok (.lit (.nat 0))) + (halt : alts.find? (fun alt => alt.cidx == 0) = + some (.mk tag 0 body)) + (hown : RootOwnership store roots) + (hbranch : RootOwnership store roots → + runCode ctx fuel cur store env body = .ok (store', value) → + RootOwnership store' (⟨cur.result, value⟩ :: rest)) + (hrun : runCode ctx (fuel + 1) cur store env + (.case scrut true alts) = .ok (store', value)) : + RootOwnership store' (⟨cur.result, value⟩ :: rest) := by + rw [runCode_case_nat_zero hresolve halt] at hrun + exact hbranch hown hrun + +/-- Exact root preservation wrapper for a peeled successor branch. -/ +theorem runCode_case_nat_succ_owned {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store store' : Store} {env : List RVal} {scrut : Atom} + {alts : Array Alt} {n tag : Nat} {body : Code} {value : RVal} + {roots rest : List Root} + (hresolve : resolveAtom env scrut = .ok (.lit (.nat (n + 1)))) + (halt : alts.find? (fun alt => alt.cidx == 1) = + some (.mk tag 1 body)) + (hown : RootOwnership store roots) + (hbranch : RootOwnership store roots → + runCode ctx fuel cur store (.lit (.nat n) :: env) body = + .ok (store', value) → + RootOwnership store' (⟨cur.result, value⟩ :: rest)) + (hrun : runCode ctx (fuel + 1) cur store env + (.case scrut true alts) = .ok (store', value)) : + RootOwnership store' (⟨cur.result, value⟩ :: rest) := by + rw [runCode_case_nat_succ hresolve halt] at hrun + exact hbranch hown hrun + +/-- Peeled zero dispatch through the same alternative-contract interface as +constructor cases. Its exposed field array is empty. -/ +theorem runCode_case_nat_zero_contract_owned {ctx : Ctx} {fuel : Nat} + {cur : FnDef} {store store' : Store} {env : List RVal} + {scrut : Atom} {alts : Array Alt} {tag : Nat} {body : Code} + {value : RVal} {rest : List Root} {fieldWorld : Owned} + {entryValid : List RVal → Array RVal → Prop} + {entryRoots : List RVal → Array RVal → List Root} + (hresolve : resolveAtom env scrut = .ok (.lit (.nat 0))) + (halt : alts.find? (fun alt => alt.cidx == 0) = + some (.mk tag 0 body)) + (hcontract : AltOwnershipContract ctx cur (.mk tag 0 body) + fieldWorld entryValid entryRoots) + (hvalid : entryValid env #[]) + (hown : RootOwnership store (entryRoots env #[] ++ rest)) + (hrun : runCode ctx (fuel + 1) cur store env + (.case scrut true alts) = .ok (store', value)) : + RootOwnership store' (⟨cur.result, value⟩ :: rest) := by + rw [runCode_case_nat_zero hresolve halt] at hrun + apply hcontract.preserves (fields := #[]) (by simp) hvalid hown + · simp + · simpa using hrun + +/-- Peeled successor dispatch exposes its scalar predecessor as a borrowed +unary field and then applies the selected alternative contract. -/ +theorem runCode_case_nat_succ_contract_owned {ctx : Ctx} {fuel : Nat} + {cur : FnDef} {store store' : Store} {env : List RVal} + {scrut : Atom} {alts : Array Alt} {n tag : Nat} {body : Code} + {value : RVal} {rest : List Root} {fieldWorld : Owned} + {entryValid : List RVal → Array RVal → Prop} + {entryRoots : List RVal → Array RVal → List Root} + (hresolve : resolveAtom env scrut = .ok (.lit (.nat (n + 1)))) + (halt : alts.find? (fun alt => alt.cidx == 1) = + some (.mk tag 1 body)) + (hcontract : AltOwnershipContract ctx cur (.mk tag 1 body) + fieldWorld entryValid entryRoots) + (hvalid : entryValid env #[.lit (.nat n)]) + (hown : RootOwnership store + (entryRoots env #[.lit (.nat n)] ++ rest)) + (hrun : runCode ctx (fuel + 1) cur store env + (.case scrut true alts) = .ok (store', value)) : + RootOwnership store' (⟨cur.result, value⟩ :: rest) := by + rw [runCode_case_nat_succ hresolve halt] at hrun + apply hcontract.preserves (fields := #[.lit (.nat n)]) (by simp) + hvalid hown + · intro field hfield + have : field = .lit (.nat n) := by simpa using hfield + subst field + trivial + · simpa using hrun + +/-- Constructor dispatch through an alternative contract available below +the enclosing case fuel. -/ +theorem runCode_case_ctor_contract_owned_below {ctx : Ctx} {fuel : Nat} + {cur : FnDef} {store store' : Store} {env : List RVal} + {scrut : Atom} {peelNat : Bool} {alts : Array Alt} {loc rc : Nat} + {world : Owned} {cid : CtorId} {fields : Array RVal} {tag nf : Nat} + {body : Code} {value : RVal} {rest : List Root} + {entryValid : List RVal → Array RVal → Prop} + {entryRoots : List RVal → Array RVal → List Root} + (hresolve : resolveAtom env scrut = .ok (.loc loc)) + (hget : store.get? loc = some ⟨world, rc, .ctorN cid fields⟩) + (halt : alts.find? (fun alt => alt.cidx == cid.cidx) = + some (.mk tag nf body)) + (hsize : fields.size = nf) + (hcontract : AltOwnershipContractBelow ctx cur (.mk tag nf body) + world entryValid entryRoots (fuel + 1)) + (hvalid : entryValid env fields) + (hown : RootOwnership store (entryRoots env fields ++ rest)) + (hrun : runCode ctx (fuel + 1) cur store env + (.case scrut peelNat alts) = .ok (store', value)) : + RootOwnership store' (⟨cur.result, value⟩ :: rest) := by + rw [runCode_case_ctor hresolve hget halt hsize] at hrun + exact hcontract.preserves (Nat.lt_succ_self fuel) hsize hvalid hown + (hown.caseFieldsBorrowed hget) hrun + +/-- Peeled-zero dispatch through a bounded nullary alternative contract. -/ +theorem runCode_case_nat_zero_contract_owned_below + {ctx : Ctx} {fuel : Nat} {cur : FnDef} {store store' : Store} + {env : List RVal} {scrut : Atom} {alts : Array Alt} {tag : Nat} + {body : Code} {value : RVal} {rest : List Root} + {fieldWorld : Owned} + {entryValid : List RVal → Array RVal → Prop} + {entryRoots : List RVal → Array RVal → List Root} + (hresolve : resolveAtom env scrut = .ok (.lit (.nat 0))) + (halt : alts.find? (fun alt => alt.cidx == 0) = + some (.mk tag 0 body)) + (hcontract : AltOwnershipContractBelow ctx cur (.mk tag 0 body) + fieldWorld entryValid entryRoots (fuel + 1)) + (hvalid : entryValid env #[]) + (hown : RootOwnership store (entryRoots env #[] ++ rest)) + (hrun : runCode ctx (fuel + 1) cur store env + (.case scrut true alts) = .ok (store', value)) : + RootOwnership store' (⟨cur.result, value⟩ :: rest) := by + rw [runCode_case_nat_zero hresolve halt] at hrun + apply hcontract.preserves (fields := #[]) (Nat.lt_succ_self fuel) + (by simp) hvalid hown + · simp + · simpa using hrun + +/-- Peeled-successor dispatch through a bounded unary alternative +contract. -/ +theorem runCode_case_nat_succ_contract_owned_below + {ctx : Ctx} {fuel : Nat} {cur : FnDef} {store store' : Store} + {env : List RVal} {scrut : Atom} {alts : Array Alt} {n tag : Nat} + {body : Code} {value : RVal} {rest : List Root} + {fieldWorld : Owned} + {entryValid : List RVal → Array RVal → Prop} + {entryRoots : List RVal → Array RVal → List Root} + (hresolve : resolveAtom env scrut = .ok (.lit (.nat (n + 1)))) + (halt : alts.find? (fun alt => alt.cidx == 1) = + some (.mk tag 1 body)) + (hcontract : AltOwnershipContractBelow ctx cur (.mk tag 1 body) + fieldWorld entryValid entryRoots (fuel + 1)) + (hvalid : entryValid env #[.lit (.nat n)]) + (hown : RootOwnership store + (entryRoots env #[.lit (.nat n)] ++ rest)) + (hrun : runCode ctx (fuel + 1) cur store env + (.case scrut true alts) = .ok (store', value)) : + RootOwnership store' (⟨cur.result, value⟩ :: rest) := by + rw [runCode_case_nat_succ hresolve halt] at hrun + apply hcontract.preserves (fields := #[.lit (.nat n)]) + (Nat.lt_succ_self fuel) (by simp) hvalid hown + · intro field hfield + have : field = .lit (.nat n) := by simpa using hfield + subst field + trivial + · simpa using hrun + +theorem dupVals_single {store : Store} {loc rc : Nat} {node : Node} + (hget : store.get? loc = some ⟨.shared, rc, node⟩) : + dupVals store [.loc loc] = + .ok (incRcStore store loc ⟨.shared, rc, node⟩) := by + simp [dupVals, hget, incRcStore] + +/-- `dupVals` turns one borrowed shared value into one owned root. Locations +increment once; scalar roots are ownership-inert. -/ +theorem dupVals_borrowed_preserves {store store' : Store} + {value : RVal} {roots : List Root} + (hown : RootOwnership store roots) + (hworld : HasWorld store .shared value) + (heval : dupVals store [value] = .ok store') : + RootOwnership store' (⟨.shared, value⟩ :: roots) := by + cases value with + | lit literal => + simp [dupVals] at heval + subst store' + exact hown.addNoLocation rfl + | erased => + simp [dupVals] at heval + subst store' + exact hown.addNoLocation rfl + | loc loc => + obtain ⟨box, hget, hboxWorld⟩ := hworld + cases box with + | mk world rc node => + change world = .shared at hboxWorld + subst world + rw [dupVals_single hget] at heval + injection heval with hstore + subst store' + exact hown.retainShared hget + +/-- Duplicating shared values cannot invalidate the world of any value that +was live beforehand. -/ +private theorem dupVals_hasWorld {store store' : Store} + {values : List RVal} + (heval : dupVals store values = .ok store') : + ∀ {world value}, HasWorld store world value → + HasWorld store' world value := by + induction values generalizing store with + | nil => + change (.ok store : Except Err Store) = .ok store' at heval + injection heval with hstore + subst store' + exact fun h => h + | cons head tail ih => + cases head with + | lit literal => + simp only [dupVals, List.foldlM_cons] at heval + exact ih heval + | erased => + simp only [dupVals, List.foldlM_cons] at heval + exact ih heval + | loc loc => + simp only [dupVals, List.foldlM_cons] at heval + cases hget : store.get? loc with + | none => simp [hget, bindErr] at heval + | some box => + cases box with + | mk boxWorld rc node => + cases boxWorld with + | unique => simp [hget, bindErr] at heval + | shared => + simp only [hget] at heval + exact ih heval ∘ HasWorld.incRcStore hget + +private theorem dupVals_cons_ok_inv {store store' : Store} + {head : RVal} {tail : List RVal} + (heval : dupVals store (head :: tail) = .ok store') : + ∃ middle, dupVals store [head] = .ok middle ∧ + dupVals middle tail = .ok store' := by + rw [show head :: tail = [head] ++ tail by rfl, dupVals, + List.foldlM_append] at heval + change (dupVals store [head] >>= fun middle => dupVals middle tail) = + .ok store' at heval + cases hmiddle : dupVals store [head] with + | error err => + rw [hmiddle, bindErr] at heval + contradiction + | ok middle => + refine ⟨middle, rfl, ?_⟩ + rw [hmiddle, bindOk] at heval + exact heval + +/-- Retaining one shared value changes at most a refcount and therefore +preserves every pre-existing live node shape. -/ +private theorem dupVals_single_extends {store store' : Store} + {value : RVal} (heval : dupVals store [value] = .ok store') : + StoreGraphExtends store store' := by + cases value with + | lit literal => + simp [dupVals] at heval + subst store' + exact StoreGraphExtends.refl store + | erased => + simp [dupVals] at heval + subst store' + exact StoreGraphExtends.refl store + | loc loc => + cases hget : store.get? loc with + | none => simp [dupVals, hget] at heval + | some box => + cases box with + | mk world rc node => + cases world with + | unique => simp [dupVals, hget] at heval + | shared => + have hresult : + (store.setBox loc + ⟨.shared, rc + 1, node⟩).rcTick = store' := by + simpa [dupVals, hget] using heval + subst store' + intro other otherWorld otherRc otherNode hother + exact (StoreGraphExtends.incRcStore hget) hother + +/-- `dupVals` is a sequence of refcount-only extensions. -/ +theorem dupVals_extends {store store' : Store} {values : List RVal} + (heval : dupVals store values = .ok store') : + StoreGraphExtends store store' := by + induction values generalizing store with + | nil => + change (.ok store : Except Err Store) = .ok store' at heval + injection heval with hstore + subst store' + exact StoreGraphExtends.refl store + | cons head tail ih => + obtain ⟨middle, hhead, htail⟩ := dupVals_cons_ok_inv heval + exact StoreGraphExtends.trans (dupVals_single_extends hhead) + (ih htail) + +/-- `dupVals` turns a list of borrowed shared values into owned roots. -/ +theorem dupVals_borrowedMany_preserves {store store' : Store} + {values : List RVal} {roots : List Root} + (hown : RootOwnership store roots) + (hworld : ∀ value ∈ values, HasWorld store .shared value) + (heval : dupVals store values = .ok store') : + RootOwnership store' (rootsFor .shared values ++ roots) := by + induction values generalizing store roots with + | nil => + change (.ok store : Except Err Store) = .ok store' at heval + injection heval with hstore + subst store' + simpa [rootsFor] using hown + | cons head tail ih => + obtain ⟨middle, hheadEval, htailEval⟩ := dupVals_cons_ok_inv heval + have hheadWorld : HasWorld store .shared head := + hworld head (by simp) + have hmiddle : RootOwnership middle (⟨.shared, head⟩ :: roots) := + dupVals_borrowed_preserves hown hheadWorld hheadEval + have htailWorld : ∀ value ∈ tail, + HasWorld middle .shared value := by + intro value hvalue + exact dupVals_hasWorld hheadEval (hworld value (by simp [hvalue])) + have htail := ih hmiddle htailWorld htailEval + apply htail.perm + simpa [rootsFor, List.append_assoc] using + (List.perm_append_comm (l₁ := rootsFor .shared tail) + (l₂ := [(⟨.shared, head⟩ : Root)])).append_right roots + +theorem runOp_dup {ctx : Ctx} {fuel : Nat} {cur : FnDef} {store : Store} + {env : List RVal} {target : Atom} {loc rc : Nat} {node : Node} + (hresolve : resolveAtom env target = .ok (.loc loc)) + (hget : store.get? loc = some ⟨.shared, rc, node⟩) : + runOp ctx (fuel + 1) cur store env (.dup target) = + .ok (incRcStore store loc ⟨.shared, rc, node⟩, .loc loc) := by + rw [runOp.eq_def] + dsimp only + rw [hresolve] + rw [bindOk] + simp only + rw [hget] + rfl + +/-- Executing `dup` on a borrowed shared value retains it as one owned root. +This is the operation-level interface used immediately after `fetch`. -/ +theorem runOp_retain_borrowed {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {target : Atom} {value : RVal} + {roots : List Root} + (hresolve : resolveAtom env target = .ok value) + (hworld : HasWorld store .shared value) + (hown : RootOwnership store roots) : + ∃ store', + runOp ctx (fuel + 1) cur store env (.dup target) = + .ok (store', value) ∧ + RootOwnership store' (⟨.shared, value⟩ :: roots) := by + cases value with + | lit literal => + refine ⟨store, ?_, hown.addNoLocation rfl⟩ + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + | erased => + refine ⟨store, ?_, hown.addNoLocation rfl⟩ + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + | loc loc => + obtain ⟨box, hget, hboxWorld⟩ := hworld + cases box with + | mk world rc node => + change world = .shared at hboxWorld + subst world + refine ⟨incRcStore store loc ⟨.shared, rc, node⟩, + runOp_dup hresolve hget, hown.retainShared hget⟩ + +/-- Semantic strengthening of `runOp_retain_borrowed`: refcount-only store +updates preserve the pure value graph for the retained result. -/ +theorem runOp_retain_borrowed_valueGraph + {funRel : FunctionRel} {sourceValue : IxIR0.Value} + {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {target : Atom} {value : RVal} + {roots : List Root} + (hresolve : resolveAtom env target = .ok value) + (hworld : HasWorld store .shared value) + (hgraph : ValueGraph funRel store sourceValue value) + (hown : RootOwnership store roots) : + ∃ store', + runOp ctx (fuel + 1) cur store env (.dup target) = + .ok (store', value) ∧ + StoreGraphExtends store store' ∧ + ValueGraph funRel store' sourceValue value ∧ + RootOwnership store' (⟨.shared, value⟩ :: roots) := by + cases value with + | lit literal => + refine ⟨store, ?_, StoreGraphExtends.refl store, hgraph, + hown.addNoLocation rfl⟩ + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + | erased => + refine ⟨store, ?_, StoreGraphExtends.refl store, hgraph, + hown.addNoLocation rfl⟩ + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + | loc loc => + obtain ⟨box, hget, hboxWorld⟩ := hworld + cases box with + | mk world rc node => + change world = .shared at hboxWorld + subst world + let store' := incRcStore store loc ⟨.shared, rc, node⟩ + have hstore : StoreGraphExtends store store' := + StoreGraphExtends.incRcStore hget + refine ⟨store', runOp_dup hresolve hget, hstore, + hgraph.monoStore hstore, hown.retainShared hget⟩ + +/-- Retaining one borrowed field preserves shared-world evidence for every +other field that a later step may retain. Locations transport through the +single RC update; scalar evidence is unchanged. -/ +theorem runOp_retain_borrowed_preserves_hasWorlds + {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {target : Atom} {value : RVal} + {roots : List Root} {borrowed : List RVal} + (hresolve : resolveAtom env target = .ok value) + (hworld : HasWorld store .shared value) + (hown : RootOwnership store roots) + (hborrowed : ∀ candidate ∈ borrowed, + HasWorld store .shared candidate) : + ∃ store', + runOp ctx (fuel + 1) cur store env (.dup target) = + .ok (store', value) ∧ + RootOwnership store' (⟨.shared, value⟩ :: roots) ∧ + ∀ candidate ∈ borrowed, + HasWorld store' .shared candidate := by + cases value with + | lit literal => + refine ⟨store, ?_, hown.addNoLocation rfl, hborrowed⟩ + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + | erased => + refine ⟨store, ?_, hown.addNoLocation rfl, hborrowed⟩ + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + | loc loc => + obtain ⟨box, hget, hboxWorld⟩ := hworld + cases box with + | mk world rc node => + change world = .shared at hboxWorld + subst world + refine ⟨incRcStore store loc ⟨.shared, rc, node⟩, + runOp_dup hresolve hget, hown.retainShared hget, ?_⟩ + intro candidate hmem + exact HasWorld.incRcStore hget (hborrowed candidate hmem) + +theorem runOp_reuse {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {target : Atom} {cid : CtorId} + {args : Array Atom} {values : List RVal} {loc rc : Nat} + {oldNode : Node} + (hargs : resolveAtoms env args = .ok values) + (hresolve : resolveAtom env target = .ok (.loc loc)) + (hget : store.get? loc = some ⟨.unique, rc, oldNode⟩) : + runOp ctx (fuel + 1) cur store env (.reuse target cid args) = + .ok (reuseNodeStore store loc (.ctorN cid values.toArray), .loc loc) := by + rw [runOp.eq_def] + dsimp only + rw [hargs, bindOk] + rw [hresolve, bindOk] + dsimp only + rw [hget] + dsimp only + rw [reuseNodeStore_eq_direct] + +/-- Exact ownership transfer across a direct invocation from a contract +available below the invocation fuel. A successful invocation at `fuel + 1` +runs the callee body at `fuel`, so the bound is strict exactly where the +mutual declaration induction needs it. -/ +theorem invoke_fn_owned_below {ctx : Ctx} {fuel : Nat} {f : Address} + {argWorlds : List Owned} {args : List RVal} {store store' : Store} + {value : RVal} {rest : List Root} {d : FnDef} + (hdecl : ctx.decls f = some (.fn d)) + (hcontract : FnOwnershipContractBelow ctx d argWorlds fuel) + (hown : RootOwnership store + (rootsForWorlds argWorlds args ++ rest)) + (hinvoke : invoke ctx fuel f args store = .ok (store', value)) : + RootOwnership store' (⟨d.result, value⟩ :: rest) := by + cases fuel with + | zero => simp [invoke] at hinvoke + | succ fuel => + simp only [invoke, hdecl] at hinvoke + split at hinvoke + · contradiction + next hlen => + have hargsLength : args.length = argWorlds.length := by + have hd : args.length = d.arity := by simpa using hlen + exact hd.trans hcontract.arity_eq.symm + cases hrun : runCode ctx fuel d store args.reverse d.body with + | error e => + rw [hrun] at hinvoke + change (.error e : Except Err (Store × RVal)) = + .ok (store', value) at hinvoke + contradiction + | ok out => + rw [hrun] at hinvoke + change checkResultWorld d.result out = .ok (store', value) at hinvoke + obtain ⟨hpair, _⟩ := checkResultWorld_ok hinvoke + subst out + exact hcontract.preserves (Nat.lt_succ_self fuel) + hargsLength hown hrun + +/-- Exact ownership transfer across a successful direct invocation: the +callee consumes its argument roots and returns one root in its declared +world, while every unrelated continuation root is preserved. -/ +theorem invoke_fn_owned {ctx : Ctx} {fuel : Nat} {f : Address} + {argWorlds : List Owned} {args : List RVal} {store store' : Store} + {value : RVal} {rest : List Root} {d : FnDef} + (hdecl : ctx.decls f = some (.fn d)) + (hcontract : FnOwnershipContract ctx d argWorlds) + (hown : RootOwnership store + (rootsForWorlds argWorlds args ++ rest)) + (hinvoke : invoke ctx fuel f args store = .ok (store', value)) : + RootOwnership store' (⟨d.result, value⟩ :: rest) := by + exact invoke_fn_owned_below hdecl (hcontract.below fuel) hown hinvoke + +private theorem rootsForWorlds_replicate_eq_rootsFor_apply (world : Owned) : + ∀ {values : List RVal} {count : Nat}, values.length = count → + rootsForWorlds (List.replicate count world) values = + rootsFor world values := by + intro values count hlength + induction values generalizing count with + | nil => + cases count <;> simp_all [rootsFor, rootsForWorlds] + | cons value values ih => + cases count with + | zero => simp at hlength + | succ count => + simp only [List.length_cons, Nat.succ.injEq] at hlength + simp [List.replicate_succ, rootsFor, ih hlength] + +/-- Invocation through a declaration approved for shared PAP entry consumes +shared argument roots and returns one shared root. Successful extern calls are +covered by their scalar-only ABI. -/ +theorem invoke_papSafe_owned_below {ctx : Ctx} {fuel : Nat} + (hdecls : PapSafeDeclContractsBelow ctx fuel) + {address : Address} {d : Decl} {args : List RVal} + {store store' : Store} {value : RVal} {rest : List Root} + (hdecl : ctx.decls address = some d) + (hpapSafe : declPapSafe d = true) + (hown : RootOwnership store (rootsFor .shared args ++ rest)) + (hrun : invoke ctx fuel address args store = .ok (store', value)) : + RootOwnership store' (⟨.shared, value⟩ :: rest) := by + cases d with + | fn fnDef => + obtain ⟨hresult, hcontract⟩ := hdecls.fn hdecl hpapSafe + have hworlds : rootsForWorlds + (List.replicate fnDef.arity .shared) args = + rootsFor .shared args := by + have hlength : args.length = fnDef.arity := by + cases fuel with + | zero => simp [invoke] at hrun + | succ innerFuel => + simp only [invoke, hdecl] at hrun + split at hrun + next hne => contradiction + next heq => simpa using heq + exact rootsForWorlds_replicate_eq_rootsFor_apply .shared hlength + have howned : RootOwnership store + (rootsForWorlds (List.replicate fnDef.arity .shared) args ++ rest) := by + rwa [hworlds] + have hout := invoke_fn_owned_below hdecl hcontract howned hrun + rwa [hresult] at hout + | extern arity => + cases fuel with + | zero => simp [invoke] at hrun + | succ innerFuel => + simp only [invoke, hdecl] at hrun + split at hrun + next hne => contradiction + next heq => + cases hcall : callScalarOracle ctx address args with + | error err => + rw [hcall] at hrun + contradiction + | ok result => + rw [hcall] at hrun + simp only at hrun + injection hrun with hpair + cases hpair + have hscalar := callScalarOracle_ok hcall + exact (hown.dropScalars hscalar.1).addNoLocation + (RVal.rvalLocation?_eq_none_of_isScalar hscalar.2) + +/-- The evaluator-level interface for a lowered direct call: resolving the +argument atoms and successfully invoking a function establishes the declared +world of the returned value. Exact root conservation is the next call proof. -/ +theorem runOp_call_result_hasWorld {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store store' : Store} {env : List RVal} {f : Address} + {args : Array Atom} {values : List RVal} {value : RVal} {d : FnDef} + (hargs : resolveAtoms env args = .ok values) + (hdecl : ctx.decls f = some (.fn d)) + (hrun : runOp ctx (fuel + 1) cur store env (.call f args) = + .ok (store', value)) : + HasWorld store' d.result value := by + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [hargs, bindOk] at hrun + exact invoke_fn_result_hasWorld hdecl hrun + +/-- Exact operation-level direct-call interface under the bounded contract +environment used by the mutual compiler induction. -/ +theorem runOp_call_owned_below {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store store' : Store} {env : List RVal} {f : Address} + {atoms : Array Atom} {args : List RVal} {value : RVal} {d : FnDef} + {argWorlds : List Owned} {rest : List Root} + (hargs : resolveAtoms env atoms = .ok args) + (hdecl : ctx.decls f = some (.fn d)) + (hcontract : FnOwnershipContractBelow ctx d argWorlds fuel) + (hown : RootOwnership store + (rootsForWorlds argWorlds args ++ rest)) + (hrun : runOp ctx (fuel + 1) cur store env (.call f atoms) = + .ok (store', value)) : + RootOwnership store' (⟨d.result, value⟩ :: rest) := by + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [hargs, bindOk] at hrun + exact invoke_fn_owned_below hdecl hcontract hown hrun + +/-- Exact operation-level direct-call interface used by completed compiler +contracts. -/ +theorem runOp_call_owned {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store store' : Store} {env : List RVal} {f : Address} + {atoms : Array Atom} {args : List RVal} {value : RVal} {d : FnDef} + {argWorlds : List Owned} {rest : List Root} + (hargs : resolveAtoms env atoms = .ok args) + (hdecl : ctx.decls f = some (.fn d)) + (hcontract : FnOwnershipContract ctx d argWorlds) + (hown : RootOwnership store + (rootsForWorlds argWorlds args ++ rest)) + (hrun : runOp ctx (fuel + 1) cur store env (.call f atoms) = + .ok (store', value)) : + RootOwnership store' (⟨d.result, value⟩ :: rest) := by + exact runOp_call_owned_below hargs hdecl (hcontract.below fuel) hown hrun + +/-- Exact operation-level interface for unknown higher-order application +under the bounded contract used by the mutual fuel induction. -/ +theorem runOp_apply_owned_below {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store store' : Store} {env : List RVal} {functionAtom : Atom} + {function : RVal} {atoms : Array Atom} {args : List RVal} + {value : RVal} {rest : List Root} + (hfunction : resolveAtom env functionAtom = .ok function) + (hargs : resolveAtoms env atoms = .ok args) + (hcontract : ApplyOwnershipContractBelow ctx (fuel + 1)) + (hown : RootOwnership store + (⟨.shared, function⟩ :: rootsFor .shared args ++ rest)) + (hrun : runOp ctx (fuel + 1) cur store env + (.apply functionAtom atoms) = .ok (store', value)) : + RootOwnership store' (⟨.shared, value⟩ :: rest) := by + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [hfunction, bindOk, hargs, bindOk] at hrun + exact hcontract.preserves (Nat.lt_succ_self fuel) hown hrun + +/-- Exact operation-level interface for unknown higher-order application. +The context contract hides pap saturation/over-application recursion while +retaining the ownership boundary required by `applyRest`. -/ +theorem runOp_apply_owned {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store store' : Store} {env : List RVal} {functionAtom : Atom} + {function : RVal} {atoms : Array Atom} {args : List RVal} + {value : RVal} {rest : List Root} + (hfunction : resolveAtom env functionAtom = .ok function) + (hargs : resolveAtoms env atoms = .ok args) + (hcontract : ApplyOwnershipContract ctx) + (hown : RootOwnership store + (⟨.shared, function⟩ :: rootsFor .shared args ++ rest)) + (hrun : runOp ctx (fuel + 1) cur store env + (.apply functionAtom atoms) = .ok (store', value)) : + RootOwnership store' (⟨.shared, value⟩ :: rest) := by + exact runOp_apply_owned_below hfunction hargs + (hcontract.below (fuel + 1)) hown hrun + +/-- `callSelf` enforces the same result-world contract from the current +function frame. -/ +theorem runOp_callSelf_result_hasWorld {ctx : Ctx} {fuel : Nat} + {cur : FnDef} {store store' : Store} {env : List RVal} + {args : Array Atom} {values : List RVal} {value : RVal} + (hargs : resolveAtoms env args = .ok values) + (hrun : runOp ctx (fuel + 1) cur store env (.callSelf args) = + .ok (store', value)) : + HasWorld store' cur.result value := by + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [hargs, bindOk] at hrun + split at hrun + · contradiction + · cases hcode : runCode ctx fuel cur store values.reverse cur.body with + | error e => + rw [hcode] at hrun + change (.error e : Except Err (Store × RVal)) = + .ok (store', value) at hrun + contradiction + | ok out => + rw [hcode] at hrun + change checkResultWorld cur.result out = .ok (store', value) at hrun + obtain ⟨hpair, hw⟩ := checkResultWorld_ok hrun + subst out + exact hw + +/-- Exact ownership transfer for a recursive self call from a contract +available below the operation's fuel bound. The evaluator enters `cur.body` +at `fuel`, strictly below `fuel + 1`; this is the operational decrease used +by the mutual declaration-contract seal. -/ +theorem runOp_callSelf_owned_below {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store store' : Store} {env : List RVal} {atoms : Array Atom} + {args : List RVal} {value : RVal} {argWorlds : List Owned} + {rest : List Root} + (hargs : resolveAtoms env atoms = .ok args) + (hcontract : FnOwnershipContractBelow ctx cur argWorlds (fuel + 1)) + (hown : RootOwnership store + (rootsForWorlds argWorlds args ++ rest)) + (hrun : runOp ctx (fuel + 1) cur store env (.callSelf atoms) = + .ok (store', value)) : + RootOwnership store' (⟨cur.result, value⟩ :: rest) := by + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [hargs, bindOk] at hrun + split at hrun + · contradiction + next hlen => + have hargsLength : args.length = argWorlds.length := by + have hd : args.length = cur.arity := by simpa using hlen + exact hd.trans hcontract.arity_eq.symm + cases hcode : runCode ctx fuel cur store args.reverse cur.body with + | error e => + rw [hcode] at hrun + change (.error e : Except Err (Store × RVal)) = + .ok (store', value) at hrun + contradiction + | ok out => + rw [hcode] at hrun + change checkResultWorld cur.result out = .ok (store', value) at hrun + obtain ⟨hpair, _⟩ := checkResultWorld_ok hrun + subst out + exact hcontract.preserves (Nat.lt_succ_self fuel) + hargsLength hown hcode + +/-- Exact ownership transfer for recursive self calls, under the current +function's public semantic contract. -/ +theorem runOp_callSelf_owned {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store store' : Store} {env : List RVal} {atoms : Array Atom} + {args : List RVal} {value : RVal} {argWorlds : List Owned} + {rest : List Root} + (hargs : resolveAtoms env atoms = .ok args) + (hcontract : FnOwnershipContract ctx cur argWorlds) + (hown : RootOwnership store + (rootsForWorlds argWorlds args ++ rest)) + (hrun : runOp ctx (fuel + 1) cur store env (.callSelf atoms) = + .ok (store', value)) : + RootOwnership store' (⟨cur.result, value⟩ :: rest) := by + exact runOp_callSelf_owned_below hargs (hcontract.below (fuel + 1)) + hown hrun + +/-- Exact ownership transfer across the scalar-only extern ABI. Successful +evaluation proves every argument and the result scalar, so argument roots +are ownership-inert, the store is unchanged, and the result may be recorded +in either demanded world. -/ +theorem runOp_extern_owned {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store store' : Store} {env : List RVal} {f : Address} + {atoms : Array Atom} {args : List RVal} {value : RVal} + {resultWorld : Owned} {rest : List Root} + (hargs : resolveAtoms env atoms = .ok args) + (hown : RootOwnership store (rootsFor .shared args ++ rest)) + (hrun : runOp ctx (fuel + 1) cur store env (.extern f atoms) = + .ok (store', value)) : + RootOwnership store' (⟨resultWorld, value⟩ :: rest) := by + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [hargs, bindOk] at hrun + cases horacle : callScalarOracle ctx f args with + | error err => + rw [horacle] at hrun + change (Except.error err : Except Err (Store × RVal)) = + .ok (store', value) at hrun + contradiction + | ok result => + rw [horacle] at hrun + change (Except.ok (store, result) : Except Err (Store × RVal)) = + .ok (store', value) at hrun + have hpair : (store, result) = (store', value) := Except.ok.inj hrun + cases hpair + have hscalar := callScalarOracle_ok horacle + exact (hown.dropScalars hscalar.1).addNoLocation + (RVal.rvalLocation?_eq_none_of_isScalar hscalar.2) + +theorem runOp_pure {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {target : Atom} {value : RVal} + (hresolve : resolveAtom env target = .ok value) : + runOp ctx (fuel + 1) cur store env (.pure target) = + .ok (store, value) := by + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + +/-- The lowering emits `pure` for scalar constants. Binding that result adds +an ownership-inert root in whichever world the continuation demands. -/ +theorem runOp_pure_scalar_owned {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {target : Atom} {value : RVal} + {world : Owned} {roots : List Root} + (hresolve : resolveAtom env target = .ok value) + (hnone : rvalLocation? value = none) + (hown : RootOwnership store roots) : + runOp ctx (fuel + 1) cur store env (.pure target) = + .ok (store, value) ∧ + RootOwnership store (⟨world, value⟩ :: roots) := + ⟨runOp_pure hresolve, hown.addNoLocation hnone⟩ + +theorem runOp_alloc {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {world : Owned} {cid : CtorId} + {args : Array Atom} {values : List RVal} + (hresolve : resolveAtoms env args = .ok values) : + runOp ctx (fuel + 1) cur store env (.alloc world cid args) = + .ok ((store.allocNode world (.ctorN cid values.toArray)).1, + .loc (store.allocNode world (.ctorN cid values.toArray)).2) := by + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + +theorem runOp_free {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {target : Atom} {loc rc : Nat} + {node : Node} + (hresolve : resolveAtom env target = .ok (.loc loc)) + (hget : store.get? loc = some ⟨.unique, rc, node⟩) : + runOp ctx (fuel + 1) cur store env (.free target) = + .ok (store.kill loc, .erased) := by + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + dsimp only + rw [hget] + +/-- The shallow-free evaluator branch consumes the unique parent root and +exposes its fields as unique roots, ready for reuse, transfer, or deep drop. -/ +theorem runOp_free_owned {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {target : Atom} {loc : Nat} + {node : Node} {rest : List Root} + (hresolve : resolveAtom env target = .ok (.loc loc)) + (hget : store.get? loc = some ⟨.unique, 1, node⟩) + (hown : RootOwnership store (⟨.unique, .loc loc⟩ :: rest)) : + runOp ctx (fuel + 1) cur store env (.free target) = + .ok (store.kill loc, .erased) ∧ + RootOwnership (store.kill loc) + (rootsFor .unique (nodeChildren node) ++ rest) := + ⟨runOp_free hresolve hget, hown.killUniqueOne hget⟩ + +theorem runOp_fetch {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {target : Atom} {loc rc i : Nat} + {world : Owned} {cid : CtorId} {fields : Array RVal} {value : RVal} + (hresolve : resolveAtom env target = .ok (.loc loc)) + (hget : store.get? loc = some ⟨world, rc, .ctorN cid fields⟩) + (hfield : fields[i]? = some value) : + runOp ctx (fuel + 1) cur store env (.fetch target i) = + .ok (store, value) := by + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + dsimp only + rw [hget] + dsimp only + rw [hfield] + +/-- A successful fetch returns an existing node edge as a borrow: the store +and root multiset are unchanged, while the returned value is known to inhabit +the parent's world. -/ +theorem RootOwnership.fetchBorrowed {store : Store} {roots : List Root} + {loc rc i : Nat} {world : Owned} {cid : CtorId} + {fields : Array RVal} {value : RVal} + (hget : store.get? loc = some ⟨world, rc, .ctorN cid fields⟩) + (hfield : fields[i]? = some value) + (h : RootOwnership store roots) : HasWorld store world value := by + have harray : value ∈ fields := + (Array.mem_iff_getElem?).2 ⟨i, hfield⟩ + have hlist : value ∈ fields.toList := by simpa using harray + exact h.edges_world hget value (by simpa [nodeChildren] using hlist) + +theorem runOp_fetch_borrowed {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {target : Atom} {roots : List Root} + {loc rc i : Nat} {cid : CtorId} {fields : Array RVal} {value : RVal} + (hresolve : resolveAtom env target = .ok (.loc loc)) + (hget : store.get? loc = some ⟨.shared, rc, .ctorN cid fields⟩) + (hfield : fields[i]? = some value) + (hown : RootOwnership store roots) : + runOp ctx (fuel + 1) cur store env (.fetch target i) = + .ok (store, value) ∧ + HasWorld store .shared value := + ⟨runOp_fetch hresolve hget hfield, hown.fetchBorrowed hget hfield⟩ + +/-- Fetch followed by the lowering's retain step produces one owned shared +field root while retaining every pre-existing root. -/ +theorem fetch_dupVals_preserves {store store' : Store} {roots : List Root} + {loc rc i : Nat} {cid : CtorId} {fields : Array RVal} {value : RVal} + (hget : store.get? loc = some ⟨.shared, rc, .ctorN cid fields⟩) + (hfield : fields[i]? = some value) + (hown : RootOwnership store roots) + (heval : dupVals store [value] = .ok store') : + RootOwnership store' (⟨.shared, value⟩ :: roots) := + dupVals_borrowed_preserves hown (hown.fetchBorrowed hget hfield) heval + +theorem runOp_drop {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store store' : Store} {env : List RVal} {target : Atom} {loc : Nat} + (hresolve : resolveAtom env target = .ok (.loc loc)) + (heval : dropVal ctx fuel store (.loc loc) = .ok store') : + runOp ctx (fuel + 1) cur store env (.drop target) = + .ok (store', .erased) := by + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + dsimp only + rw [heval, bindOk] + +theorem runOp_dropU {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store store' : Store} {env : List RVal} {target : Atom} {loc : Nat} + (hresolve : resolveAtom env target = .ok (.loc loc)) + (heval : dropUVal ctx fuel store (.loc loc) = .ok store') : + runOp ctx (fuel + 1) cur store env (.dropU target) = + .ok (store', .erased) := by + rw [runOp.eq_def] + dsimp only + rw [hresolve, bindOk] + dsimp only + rw [heval, bindOk] + +theorem dropVal_shared_many {ctx : Ctx} {fuel loc rc : Nat} {store : Store} + {node : Node} (hrc : 1 < rc) + (hget : store.get? loc = some ⟨.shared, rc, node⟩) : + dropVal ctx (fuel + 1) store (.loc loc) = + .ok (decRcStore store loc ⟨.shared, rc, node⟩) := by + rw [dropVal.eq_def] + dsimp only + rw [hget] + dsimp only + have hne : (rc == 1) = false := by + rw [beq_eq_false_iff_ne] + omega + rw [hne] + rfl + +private def DropPreservesAt (ctx : Ctx) (fuel : Nat) : Prop := + (∀ (store : Store) (value : RVal) (rest : List Root) (store' : Store), + RootOwnership store (⟨.shared, value⟩ :: rest) → + dropVal ctx fuel store value = .ok store' → + RootOwnership store' rest) ∧ + (∀ (store : Store) (values : List RVal) (rest : List Root) + (store' : Store), + RootOwnership store (rootsFor .shared values ++ rest) → + dropMany ctx fuel store values = .ok store' → + RootOwnership store' rest) + +private theorem dropPreservesAt (ctx : Ctx) : ∀ fuel, DropPreservesAt ctx fuel := by + intro fuel + induction fuel with + | zero => + refine ⟨?_, ?_⟩ + · intro store value rest store' hown heval + rw [dropVal.eq_def] at heval + simp at heval + · intro store values rest store' hown heval + rw [dropMany.eq_def] at heval + simp at heval + | succ fuel ih => + obtain ⟨ihVal, ihMany⟩ := ih + refine ⟨?_, ?_⟩ + · intro store value rest store' hown heval + cases value with + | lit literal => + rw [dropVal.eq_def] at heval + dsimp only at heval + injection heval with hstore + subst store' + exact hown.dropNoLocation rfl + | erased => + rw [dropVal.eq_def] at heval + dsimp only at heval + injection heval with hstore + subst store' + exact hown.dropNoLocation rfl + | loc loc => + rw [dropVal.eq_def] at heval + dsimp only at heval + cases hget : store.get? loc with + | none => + rw [hget] at heval + simp at heval + | some box => + rw [hget] at heval + cases box with + | mk world rc node => + cases world with + | unique => simp at heval + | shared => + dsimp only at heval + by_cases hrc : rc = 1 + · subst rc + have hbeq : ((1 : Nat) == 1) = true := by decide + rw [hbeq] at heval + have htickGet : + store.rcTick.get? loc = some ⟨.shared, 1, node⟩ := by + simpa using hget + have hkill := (hown.rcTick).killSharedOne htickGet + cases node with + | ctorN cid fields => + exact ihMany _ fields.toList rest store' hkill heval + | papN fn arity args => + exact ihMany _ args.toList rest store' hkill heval + · have hbeq : (rc == 1) = false := by simp [hrc] + rw [hbeq] at heval + have hrcPos : 0 < rc := hown.shared_rc_pos hget + have hrcMany : 1 < rc := by omega + injection heval with hstore + subst store' + exact hown.dropSharedMany hrcMany hget + · intro store values rest store' hown heval + cases values with + | nil => + rw [dropMany.eq_def] at heval + dsimp only at heval + injection heval with hstore + subst store' + simpa [rootsFor] using hown + | cons value values => + rw [dropMany.eq_def] at heval + dsimp only at heval + cases hfirst : dropVal ctx fuel store value with + | error err => + rw [hfirst, bindErr] at heval + simp at heval + | ok middle => + rw [hfirst, bindOk] at heval + have hfirstOwn : + RootOwnership store + (⟨.shared, value⟩ :: + (rootsFor .shared values ++ rest)) := by + simpa [rootsFor] using hown + have hmiddle : + RootOwnership middle (rootsFor .shared values ++ rest) := + ihVal store value _ middle hfirstOwn hfirst + exact ihMany middle values rest store' hmiddle heval + +/-- Every successful shared drop consumes exactly its input root while +preserving the exact ownership invariant, including recursive rc-zero +reclamation. -/ +theorem dropVal_preserves {ctx : Ctx} {fuel : Nat} {store store' : Store} + {value : RVal} {rest : List Root} + (hown : RootOwnership store (⟨.shared, value⟩ :: rest)) + (heval : dropVal ctx fuel store value = .ok store') : + RootOwnership store' rest := + (dropPreservesAt ctx fuel).1 store value rest store' hown heval + +/-- Successful sequential shared drops consume precisely the corresponding +temporary roots. -/ +theorem dropMany_preserves {ctx : Ctx} {fuel : Nat} {store store' : Store} + {values : List RVal} {rest : List Root} + (hown : RootOwnership store (rootsFor .shared values ++ rest)) + (heval : dropMany ctx fuel store values = .ok store') : + RootOwnership store' rest := + (dropPreservesAt ctx fuel).2 store values rest store' hown heval + +private def DropRestrictsAt (ctx : Ctx) (fuel : Nat) : Prop := + (∀ (store : Store) (value : RVal) (store' : Store), + dropVal ctx fuel store value = .ok store' → + StoreGraphRestricts store store') ∧ + (∀ (store : Store) (values : List RVal) (store' : Store), + dropMany ctx fuel store values = .ok store' → + StoreGraphRestricts store store') + +/-- Shared deep drop never changes the world or contents of a node that +survives it. The mutual induction follows the evaluator's recursive child +drop exactly; RC-only and kill steps compose through `StoreGraphRestricts`. -/ +private theorem dropRestrictsAt (ctx : Ctx) : + ∀ fuel, DropRestrictsAt ctx fuel := by + intro fuel + induction fuel with + | zero => + refine ⟨?_, ?_⟩ + · intro store value store' heval + rw [dropVal.eq_def] at heval + simp at heval + · intro store values store' heval + rw [dropMany.eq_def] at heval + simp at heval + | succ fuel ih => + obtain ⟨ihVal, ihMany⟩ := ih + refine ⟨?_, ?_⟩ + · intro store value store' heval + cases value with + | lit literal => + rw [dropVal.eq_def] at heval + dsimp only at heval + injection heval with hstore + subst store' + exact StoreGraphRestricts.refl store + | erased => + rw [dropVal.eq_def] at heval + dsimp only at heval + injection heval with hstore + subst store' + exact StoreGraphRestricts.refl store + | loc loc => + rw [dropVal.eq_def] at heval + dsimp only at heval + cases hget : store.get? loc with + | none => + rw [hget] at heval + simp at heval + | some box => + rw [hget] at heval + cases box with + | mk world rc node => + cases world with + | unique => simp at heval + | shared => + dsimp only at heval + by_cases hrc : rc = 1 + · subst rc + have hbeq : ((1 : Nat) == 1) = true := by decide + rw [hbeq] at heval + have htickGet : + store.rcTick.get? loc = some ⟨.shared, 1, node⟩ := by + simpa using hget + have hprefix : StoreGraphRestricts store + (store.rcTick.kill loc) := + StoreGraphRestricts.trans + (StoreGraphRestricts.rcTick store) + (StoreGraphRestricts.kill htickGet) + cases node with + | ctorN cid fields => + exact StoreGraphRestricts.trans hprefix + (ihMany _ fields.toList _ heval) + | papN fn arity args => + exact StoreGraphRestricts.trans hprefix + (ihMany _ args.toList _ heval) + · have hbeq : (rc == 1) = false := by simp [hrc] + rw [hbeq] at heval + injection heval with hstore + subst store' + exact StoreGraphRestricts.decRcStore hget + · intro store values store' heval + cases values with + | nil => + rw [dropMany.eq_def] at heval + dsimp only at heval + injection heval with hstore + subst store' + exact StoreGraphRestricts.refl store + | cons value values => + rw [dropMany.eq_def] at heval + dsimp only at heval + cases hfirst : dropVal ctx fuel store value with + | error err => + rw [hfirst, bindErr] at heval + simp at heval + | ok middle => + rw [hfirst, bindOk] at heval + exact StoreGraphRestricts.trans + (ihVal store value middle hfirst) + (ihMany middle values store' heval) + +theorem dropVal_restricts {ctx : Ctx} {fuel : Nat} + {store store' : Store} {value : RVal} + (heval : dropVal ctx fuel store value = .ok store') : + StoreGraphRestricts store store' := + (dropRestrictsAt ctx fuel).1 store value store' heval + +theorem dropMany_restricts {ctx : Ctx} {fuel : Nat} + {store store' : Store} {values : List RVal} + (heval : dropMany ctx fuel store values = .ok store') : + StoreGraphRestricts store store' := + (dropRestrictsAt ctx fuel).2 store values store' heval + +/-- The common prefix of every successful pap application: retain each +stored capture, consume the pap root, and expose the stored and newly supplied +arguments as one owned shared vector. -/ +theorem applyGo_preparePap_owned {ctx : Ctx} {fuel : Nat} + {store dupStore readyStore : Store} {loc rc : Nat} + {f : Address} {arity : Nat} {got : Array RVal} + {args : List RVal} {rest : List Root} + (hget : store.get? loc = some + ⟨.shared, rc, .papN f arity got⟩) + (hown : RootOwnership store + (⟨.shared, .loc loc⟩ :: rootsFor .shared args ++ rest)) + (hdup : dupVals store got.toList = .ok dupStore) + (hdrop : dropVal ctx fuel dupStore (.loc loc) = .ok readyStore) : + RootOwnership readyStore + (rootsFor .shared (got.toList ++ args) ++ rest) := by + have hgotWorld : ∀ value ∈ got.toList, + HasWorld store .shared value := by + intro value hvalue + exact hown.edges_world hget value (by simpa [nodeChildren] using hvalue) + have hduped : RootOwnership dupStore + (rootsFor .shared got.toList ++ + ⟨.shared, .loc loc⟩ :: rootsFor .shared args ++ rest) := by + simpa [List.append_assoc] using + dupVals_borrowedMany_preserves hown hgotWorld hdup + have hpapFirst : RootOwnership dupStore + (⟨.shared, .loc loc⟩ :: + rootsFor .shared got.toList ++ rootsFor .shared args ++ rest) := by + apply hduped.perm + simpa [List.append_assoc] using + (List.perm_append_comm + (l₁ := rootsFor .shared got.toList) + (l₂ := [(⟨.shared, .loc loc⟩ : Root)])).append_right + (rootsFor .shared args ++ rest) + have hready := dropVal_preserves hpapFirst hdrop + simpa [rootsFor, List.append_assoc] using hready + +private def DropUPreservesAt (ctx : Ctx) (fuel : Nat) : Prop := + (∀ (store : Store) (value : RVal) (rest : List Root) (store' : Store), + RootOwnership store (⟨.unique, value⟩ :: rest) → + dropUVal ctx fuel store value = .ok store' → + RootOwnership store' rest) ∧ + (∀ (store : Store) (values : List RVal) (rest : List Root) + (store' : Store), + RootOwnership store (rootsFor .unique values ++ rest) → + dropManyU ctx fuel store values = .ok store' → + RootOwnership store' rest) + +private theorem dropUPreservesAt (ctx : Ctx) : + ∀ fuel, DropUPreservesAt ctx fuel := by + intro fuel + induction fuel with + | zero => + refine ⟨?_, ?_⟩ + · intro store value rest store' hown heval + rw [dropUVal.eq_def] at heval + simp at heval + · intro store values rest store' hown heval + rw [dropManyU.eq_def] at heval + simp at heval + | succ fuel ih => + obtain ⟨ihVal, ihMany⟩ := ih + refine ⟨?_, ?_⟩ + · intro store value rest store' hown heval + cases value with + | lit literal => + rw [dropUVal.eq_def] at heval + dsimp only at heval + injection heval with hstore + subst store' + exact hown.dropNoLocation rfl + | erased => + rw [dropUVal.eq_def] at heval + dsimp only at heval + injection heval with hstore + subst store' + exact hown.dropNoLocation rfl + | loc loc => + rw [dropUVal.eq_def] at heval + dsimp only at heval + cases hget : store.get? loc with + | none => + rw [hget] at heval + simp at heval + | some box => + rw [hget] at heval + cases box with + | mk world rc node => + cases world with + | shared => simp at heval + | unique => + have hrc : rc = 1 := (hown.counts hget).1 + subst rc + cases node with + | ctorN cid fields => + have hkill := hown.killUniqueOne hget + exact ihMany _ fields.toList rest store' hkill heval + | papN fn arity args => simp at heval + · intro store values rest store' hown heval + cases values with + | nil => + rw [dropManyU.eq_def] at heval + dsimp only at heval + injection heval with hstore + subst store' + simpa [rootsFor] using hown + | cons value values => + rw [dropManyU.eq_def] at heval + dsimp only at heval + cases hfirst : dropUVal ctx fuel store value with + | error err => + rw [hfirst, bindErr] at heval + simp at heval + | ok middle => + rw [hfirst, bindOk] at heval + have hfirstOwn : + RootOwnership store + (⟨.unique, value⟩ :: + (rootsFor .unique values ++ rest)) := by + simpa [rootsFor] using hown + have hmiddle : + RootOwnership middle (rootsFor .unique values ++ rest) := + ihVal store value _ middle hfirstOwn hfirst + exact ihMany middle values rest store' hmiddle heval + +/-- Every successful unique deep drop consumes exactly its affine root and +recursively reclaims its constructor tree without touching refcounts. -/ +theorem dropUVal_preserves {ctx : Ctx} {fuel : Nat} {store store' : Store} + {value : RVal} {rest : List Root} + (hown : RootOwnership store (⟨.unique, value⟩ :: rest)) + (heval : dropUVal ctx fuel store value = .ok store') : + RootOwnership store' rest := + (dropUPreservesAt ctx fuel).1 store value rest store' hown heval + +/-- Successful sequential unique drops consume precisely their temporary +child roots. -/ +theorem dropManyU_preserves {ctx : Ctx} {fuel : Nat} {store store' : Store} + {values : List RVal} {rest : List Root} + (hown : RootOwnership store (rootsFor .unique values ++ rest)) + (heval : dropManyU ctx fuel store values = .ok store') : + RootOwnership store' rest := + (dropUPreservesAt ctx fuel).2 store values rest store' hown heval + +private def DropURestrictsAt (ctx : Ctx) (fuel : Nat) : Prop := + (∀ (store : Store) (value : RVal) (store' : Store), + dropUVal ctx fuel store value = .ok store' → + StoreGraphRestricts store store') ∧ + (∀ (store : Store) (values : List RVal) (store' : Store), + dropManyU ctx fuel store values = .ok store' → + StoreGraphRestricts store store') + +/-- Unique deep free likewise only removes nodes; all surviving locations +retain their worlds and node contents. -/ +private theorem dropURestrictsAt (ctx : Ctx) : + ∀ fuel, DropURestrictsAt ctx fuel := by + intro fuel + induction fuel with + | zero => + refine ⟨?_, ?_⟩ + · intro store value store' heval + rw [dropUVal.eq_def] at heval + simp at heval + · intro store values store' heval + rw [dropManyU.eq_def] at heval + simp at heval + | succ fuel ih => + obtain ⟨ihVal, ihMany⟩ := ih + refine ⟨?_, ?_⟩ + · intro store value store' heval + cases value with + | lit literal => + rw [dropUVal.eq_def] at heval + dsimp only at heval + injection heval with hstore + subst store' + exact StoreGraphRestricts.refl store + | erased => + rw [dropUVal.eq_def] at heval + dsimp only at heval + injection heval with hstore + subst store' + exact StoreGraphRestricts.refl store + | loc loc => + rw [dropUVal.eq_def] at heval + dsimp only at heval + cases hget : store.get? loc with + | none => + rw [hget] at heval + simp at heval + | some box => + rw [hget] at heval + cases box with + | mk world rc node => + cases world with + | shared => simp at heval + | unique => + cases node with + | ctorN cid fields => + have hprefix : StoreGraphRestricts store + (store.kill loc) := + StoreGraphRestricts.kill hget + have htail : StoreGraphRestricts (store.kill loc) store' := + ihMany (store.kill loc) fields.toList store' heval + intro other survivingWorld survivingRc survivingNode hafter + obtain ⟨middleRc, hmiddle⟩ := htail hafter + exact hprefix hmiddle + | papN fn arity args => simp at heval + · intro store values store' heval + cases values with + | nil => + rw [dropManyU.eq_def] at heval + dsimp only at heval + injection heval with hstore + subst store' + exact StoreGraphRestricts.refl store + | cons value values => + rw [dropManyU.eq_def] at heval + dsimp only at heval + cases hfirst : dropUVal ctx fuel store value with + | error err => + rw [hfirst, bindErr] at heval + simp at heval + | ok middle => + rw [hfirst, bindOk] at heval + exact StoreGraphRestricts.trans + (ihVal store value middle hfirst) + (ihMany middle values store' heval) + +theorem dropUVal_restricts {ctx : Ctx} {fuel : Nat} + {store store' : Store} {value : RVal} + (heval : dropUVal ctx fuel store value = .ok store') : + StoreGraphRestricts store store' := + (dropURestrictsAt ctx fuel).1 store value store' heval + +theorem dropManyU_restricts {ctx : Ctx} {fuel : Nat} + {store store' : Store} {values : List RVal} + (heval : dropManyU ctx fuel store values = .ok store') : + StoreGraphRestricts store store' := + (dropURestrictsAt ctx fuel).2 store values store' heval + +@[simp] theorem edgeLocations_allocNode (store : Store) (world : Owned) + (node : Node) : + edgeLocations (store.allocNode world node).1 = + edgeLocations store ++ (nodeChildren node).filterMap rvalLocation? := by + simp [edgeLocations, slotEdgeLocations, Store.allocNode, Array.toList_push, + nodeChildren] + +theorem incoming_allocNode_old (store : Store) (world : Owned) (node : Node) + (rest : List Root) {loc : Nat} (hne : loc ≠ store.nodes.size) : + incoming (store.allocNode world node).1 + (⟨world, .loc store.nodes.size⟩ :: rest) loc = + incoming store (rootsFor world (nodeChildren node) ++ rest) loc := by + simp [incoming, List.filterMap_append, List.count_append, + rootLocation?, rvalLocation?, Ne.symm hne, Nat.add_assoc, Nat.add_comm] + +theorem incoming_allocNode_new (store : Store) (world : Owned) (node : Node) + (rest : List Root) : + incoming (store.allocNode world node).1 + (⟨world, .loc store.nodes.size⟩ :: rest) store.nodes.size = + incoming store (rootsFor world (nodeChildren node) ++ rest) + store.nodes.size + 1 := by + simp [incoming, List.filterMap_append, List.count_append, + rootLocation?, rvalLocation?, Nat.add_assoc, Nat.add_comm, + Nat.add_left_comm] + +theorem HasWorld.allocNode {store : Store} {world node rootWorld value} + (h : HasWorld store rootWorld value) : + HasWorld (store.allocNode world node).1 rootWorld value := by + cases value with + | loc loc => + obtain ⟨box, hbox, hworld⟩ := h + exact ⟨box, HeapIso.get?_allocNode_old hbox, hworld⟩ + | lit l => trivial + | erased => trivial + +theorem HasWorld.allocNode_new (store : Store) (world : Owned) (node : Node) : + HasWorld (store.allocNode world node).1 world + (.loc store.nodes.size) := by + exact ⟨⟨world, 1, node⟩, HeapIso.get?_allocNode_new store world node, + rfl⟩ + +/-- Allocation consumes one root for every node child and produces one root +for the fresh node. The exact incoming-owner/refcount equation is preserved. -/ +theorem RootOwnership.allocNode {store : Store} {world : Owned} {node : Node} + {rest : List Root} + (h : RootOwnership store (rootsFor world (nodeChildren node) ++ rest)) + (hworld : NodeWorld world node) : + RootOwnership (store.allocNode world node).1 + (⟨world, .loc store.nodes.size⟩ :: rest) := by + have childWorld : ∀ child ∈ nodeChildren node, + HasWorld store world child := by + intro child hchild + apply h.roots_world ⟨world, child⟩ + apply List.mem_append_left rest + simp [rootsFor, hchild] + refine ⟨?_, ?_, ?_, ?_⟩ + · intro root hroot + simp only [List.mem_cons] at hroot + rcases hroot with rfl | hrest + · exact HasWorld.allocNode_new store world node + · apply HasWorld.allocNode + apply h.roots_world root + exact List.mem_append_right _ hrest + · intro loc box hbox child hchild + by_cases hnew : loc = store.nodes.size + · subst loc + have hboxeq : box = ⟨world, 1, node⟩ := by + exact Option.some.inj + (hbox.symm.trans (HeapIso.get?_allocNode_new store world node)) + subst box + exact HasWorld.allocNode (childWorld child hchild) + · have hold : store.get? loc = some box := + HeapIso.get?_of_allocNode_old hnew hbox + exact HasWorld.allocNode (h.edges_world hold child hchild) + · intro loc box f arity args hbox hnode + by_cases hnew : loc = store.nodes.size + · subst loc + have hboxeq : box = ⟨world, 1, node⟩ := by + exact Option.some.inj + (hbox.symm.trans (HeapIso.get?_allocNode_new store world node)) + subst box + change node = .papN f arity args at hnode + cases node <;> simp_all [NodeWorld] + · have hold : store.get? loc = some box := + HeapIso.get?_of_allocNode_old hnew hbox + exact h.pap_shared hold hnode + · intro loc box hbox + by_cases hnew : loc = store.nodes.size + · subst loc + have hboxeq : box = ⟨world, 1, node⟩ := by + exact Option.some.inj + (hbox.symm.trans (HeapIso.get?_allocNode_new store world node)) + subst box + have hzero := h.incoming_eq_zero_of_dead (HeapIso.get?_fresh store) + have hcount := incoming_allocNode_new store world node rest + rw [hzero] at hcount + cases world <;> simp_all + · have hold : store.get? loc = some box := + HeapIso.get?_of_allocNode_old hnew hbox + have hcount := h.counts hold + rw [incoming_allocNode_old store world node rest hnew] + exact hcount + +/-- The reference meaning of unique reuse: shallow-free the old node, then +append-allocate the replacement. -/ +theorem RootOwnership.freeAllocNode {store : Store} {loc : Nat} + {oldNode newNode : Node} {before after : List Root} + (hget : store.get? loc = some ⟨.unique, 1, oldNode⟩) + (h : RootOwnership store (⟨.unique, .loc loc⟩ :: before)) + (hpartition : + (rootsFor .unique (nodeChildren oldNode) ++ before).Perm + (rootsFor .unique (nodeChildren newNode) ++ after)) + (hworld : NodeWorld .unique newNode) : + RootOwnership ((store.kill loc).allocNode .unique newNode).1 + (⟨.unique, + .loc ((store.kill loc).allocNode .unique newNode).2⟩ :: after) := by + have hready := (h.killUniqueOne hget).perm hpartition + exact hready.allocNode hworld + +/-- Reference meaning of hot shared reuse: consume the final parent owner, +shallow-free the old node, and freshly allocate the replacement. -/ +theorem RootOwnership.freeAllocSharedNode {store : Store} {loc : Nat} + {oldNode newNode : Node} {before after : List Root} + (hget : store.get? loc = some ⟨.shared, 1, oldNode⟩) + (h : RootOwnership store (⟨.shared, .loc loc⟩ :: before)) + (hpartition : + (rootsFor .shared (nodeChildren oldNode) ++ before).Perm + (rootsFor .shared (nodeChildren newNode) ++ after)) + (hworld : NodeWorld .shared newNode) : + RootOwnership ((store.kill loc).allocNode .shared newNode).1 + (⟨.shared, + .loc ((store.kill loc).allocNode .shared newNode).2⟩ :: after) := by + have hready := (h.killSharedOne hget).perm hpartition + exact hready.allocNode hworld + +/-- Allocation consumes the resolved field roots and returns ownership of the +fresh constructor root. -/ +theorem runOp_alloc_owned {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {world : Owned} {cid : CtorId} + {args : Array Atom} {values : List RVal} {rest : List Root} + (hresolve : resolveAtoms env args = .ok values) + (hown : RootOwnership store (rootsFor world values ++ rest)) : + runOp ctx (fuel + 1) cur store env (.alloc world cid args) = + .ok ((store.allocNode world (.ctorN cid values.toArray)).1, + .loc (store.allocNode world (.ctorN cid values.toArray)).2) ∧ + RootOwnership (store.allocNode world (.ctorN cid values.toArray)).1 + (⟨world, + .loc (store.allocNode world (.ctorN cid values.toArray)).2⟩ :: + rest) := by + refine ⟨runOp_alloc hresolve, ?_⟩ + apply RootOwnership.allocNode + · simpa [nodeChildren] using hown + · trivial + +/-- Semantic strengthening of constructor allocation. Existing argument +graphs survive the fresh allocation and become the fields of the newly +related constructor root. -/ +theorem runOp_alloc_owned_valueGraph + {funRel : FunctionRel} {sourceValues : List IxIR0.Value} + {sourceAddress : Address} {sourceTag : Nat} + {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {world : Owned} {cid : CtorId} + {args : Array Atom} {values : List RVal} {rest : List Root} + (hresolve : resolveAtoms env args = .ok values) + (haddress : cid.block = sourceAddress) + (htag : cid.cidx = sourceTag) + (hvalues : ValuesGraph funRel store sourceValues values) + (hown : RootOwnership store (rootsFor world values ++ rest)) : + let allocated := store.allocNode world (.ctorN cid values.toArray) + runOp ctx (fuel + 1) cur store env (.alloc world cid args) = + .ok (allocated.1, .loc allocated.2) ∧ + StoreGraphExtends store allocated.1 ∧ + ValueGraph funRel allocated.1 + (.ctor sourceAddress sourceTag sourceValues) (.loc allocated.2) ∧ + RootOwnership allocated.1 + (⟨world, .loc allocated.2⟩ :: rest) := by + dsimp only + have hop := runOp_alloc_owned (ctx := ctx) (cur := cur) + (fuel := fuel) (cid := cid) (args := args) (values := values) + (rest := rest) hresolve hown + let allocated := store.allocNode world (.ctorN cid values.toArray) + have hstore : StoreGraphExtends store allocated.1 := + StoreGraphExtends.allocNode store world (.ctorN cid values.toArray) + refine ⟨hop.1, hstore, ?_, hop.2⟩ + apply ValueGraph.ctor + · exact HeapIso.get?_allocNode_new store world + (.ctorN cid values.toArray) + · exact haddress + · exact htag + · simpa using hvalues.monoStore hstore + +/-- Partial application consumes its shared captured-argument roots and +stores them as the edges of one fresh shared pap node. -/ +theorem runOp_papp_owned {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {f : Address} {d : Decl} + {atoms : Array Atom} {values : List RVal} {rest : List Root} + (hargs : resolveAtoms env atoms = .ok values) + (hdecl : ctx.decls f = some d) + (hunder : values.length < declArity d) + (hown : RootOwnership store (rootsFor .shared values ++ rest)) : + runOp ctx (fuel + 1) cur store env (.papp f atoms) = + .ok ((store.allocNode .shared + (.papN f (declArity d) values.toArray)).1, + .loc (store.allocNode .shared + (.papN f (declArity d) values.toArray)).2) ∧ + RootOwnership + (store.allocNode .shared + (.papN f (declArity d) values.toArray)).1 + (⟨.shared, .loc (store.allocNode .shared + (.papN f (declArity d) values.toArray)).2⟩ :: rest) := by + constructor + · rw [runOp.eq_def] + dsimp only + rw [hargs, bindOk, hdecl] + dsimp only + rw [if_pos hunder] + · apply RootOwnership.allocNode + · simpa [nodeChildren] using hown + · rfl + +/-- Semantic strengthening of partial-application allocation. The stored +argument prefix remains graph-related after the fresh allocation, and the +new pap root realizes the supplied source function value through `funRel`. -/ +theorem runOp_papp_owned_valueGraph + {funRel : FunctionRel} {sourceValue : IxIR0.Value} + {sourceValues : List IxIR0.Value} + {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store : Store} {env : List RVal} {f : Address} {d : Decl} + {atoms : Array Atom} {values : List RVal} {rest : List Root} + (hargs : resolveAtoms env atoms = .ok values) + (hdecl : ctx.decls f = some d) + (hunder : values.length < declArity d) + (hfun : funRel sourceValue f (declArity d) sourceValues) + (hvalues : ValuesGraph funRel store sourceValues values) + (hown : RootOwnership store (rootsFor .shared values ++ rest)) : + let allocated := store.allocNode .shared + (.papN f (declArity d) values.toArray) + runOp ctx (fuel + 1) cur store env (.papp f atoms) = + .ok (allocated.1, .loc allocated.2) ∧ + StoreGraphExtends store allocated.1 ∧ + ValueGraph funRel allocated.1 sourceValue (.loc allocated.2) ∧ + RootOwnership allocated.1 + (⟨.shared, .loc allocated.2⟩ :: rest) := by + dsimp only + have hop := runOp_papp_owned (ctx := ctx) (cur := cur) + (fuel := fuel) hargs hdecl hunder hown + let allocated := store.allocNode .shared + (.papN f (declArity d) values.toArray) + have hstore : StoreGraphExtends store allocated.1 := + StoreGraphExtends.allocNode store .shared + (.papN f (declArity d) values.toArray) + refine ⟨hop.1, hstore, ?_, hop.2⟩ + apply ValueGraph.function + · exact HeapIso.get?_allocNode_new store .shared + (.papN f (declArity d) values.toArray) + · exact hfun + · simpa using hvalues.monoStore hstore + +/-- Exact ownership preservation for one `applyGo` index, assuming all +function declarations and recursive application indices below it are already +available. The proof covers pap under-fill, saturation, and over-application. -/ +theorem applyOwnershipPreservesAt_of_papSafeDeclsBelow + {ctx : Ctx} {limit : Nat} + (hdecls : PapSafeDeclContractsBelow ctx limit) + (happly : ApplyOwnershipContractBelow ctx limit) : + ApplyOwnershipPreservesAt ctx limit := by + intro store store' function args value rest hown hrun + cases limit with + | zero => simp [applyGo] at hrun + | succ fuel => + cases function with + | lit literal => simp [applyGo] at hrun + | erased => + have hargsOwn : RootOwnership store + (rootsFor .shared args ++ rest) := + hown.dropNoLocation rfl + simp only [applyGo] at hrun + cases hdrop : dropMany ctx fuel store args with + | error err => + rw [hdrop, bindErr] at hrun + contradiction + | ok dropped => + rw [hdrop, bindOk] at hrun + injection hrun with hpair + cases hpair + exact (dropMany_preserves hargsOwn hdrop).addNoLocation rfl + | loc loc => + cases hget : store.get? loc with + | none => simp [applyGo, hget] at hrun + | some box => + cases box with + | mk boxWorld rc node => + cases node with + | ctorN cid fields => simp [applyGo, hget] at hrun + | papN address arity got => + have hboxWorld : boxWorld = .shared := + hown.pap_shared hget rfl + subst boxWorld + simp only [applyGo] at hrun + rw [hget] at hrun + dsimp only at hrun + cases hdup : dupVals store got.toList with + | error err => + rw [hdup, bindErr] at hrun + contradiction + | ok dupStore => + rw [hdup, bindOk] at hrun + cases hdrop : dropVal ctx fuel dupStore (.loc loc) with + | error err => + rw [hdrop, bindErr] at hrun + contradiction + | ok readyStore => + rw [hdrop, bindOk] at hrun + let total := got.toList ++ args + have hready : RootOwnership readyStore + (rootsFor .shared total ++ rest) := by + exact applyGo_preparePap_owned hget hown hdup hdrop + split at hrun + next hunder => + injection hrun with hpair + cases hpair + exact hready.allocNode rfl + next hnotUnder => + split at hrun + next hexact => + cases hdecl : ctx.decls address with + | none => simp [hdecl] at hrun + | some decl => + cases hpapsafe : declPapSafe decl with + | false => simp [hdecl, hpapsafe] at hrun + | true => + have hinvoke : invoke ctx fuel address total + readyStore = .ok (store', value) := by + simpa [hdecl, hpapsafe] using hrun + have hsmallDecls := + hdecls.mono (Nat.le_succ fuel) + exact invoke_papSafe_owned_below hsmallDecls hdecl + hpapsafe hready hinvoke + next hover => + cases hdecl : ctx.decls address with + | none => simp [hdecl] at hrun + | some decl => + cases hpapsafe : declPapSafe decl with + | false => simp [hdecl, hpapsafe] at hrun + | true => + simp only [hdecl, hpapsafe, if_true] at hrun + cases hinvoke : invoke ctx fuel address + (total.take arity) readyStore with + | error err => + rw [hinvoke, bindErr] at hrun + contradiction + | ok called => + rcases called with ⟨calledStore, result⟩ + rw [hinvoke, bindOk] at hrun + have hpartition : RootOwnership readyStore + (rootsFor .shared (total.take arity) ++ + (rootsFor .shared (total.drop arity) ++ rest)) := by + have hsplit := hready + have hrootsSplit : rootsFor .shared total = + rootsFor .shared (total.take arity) ++ + rootsFor .shared (total.drop arity) := by + unfold rootsFor + rw [← List.map_append] + exact congrArg _ + (List.take_append_drop arity total).symm + rw [hrootsSplit] at hsplit + simpa only [List.append_assoc] using hsplit + have hsmallDecls := hdecls.mono (Nat.le_succ fuel) + have hcalled := invoke_papSafe_owned_below hsmallDecls + hdecl hpapsafe hpartition hinvoke + exact happly.preserves (Nat.lt_succ_self fuel) + hcalled hrun + +/-- PAP-safe declaration contracts validate every successful shared PAP entry; +unsafe dynamic targets fail before invocation, while direct calls are +unaffected. -/ +theorem applyOwnershipContract_of_papSafeDecls {ctx : Ctx} + (hdecls : PapSafeDeclContracts ctx) : + ApplyOwnershipContract ctx := by + apply applyOwnershipContract_of_below_step + intro limit happly + exact applyOwnershipPreservesAt_of_papSafeDeclsBelow + (hdecls.below limit) happly + +theorem runOp_drop_owned {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store store' : Store} {env : List RVal} {target : Atom} {loc : Nat} + {rest : List Root} + (hresolve : resolveAtom env target = .ok (.loc loc)) + (heval : dropVal ctx fuel store (.loc loc) = .ok store') + (hown : RootOwnership store (⟨.shared, .loc loc⟩ :: rest)) : + runOp ctx (fuel + 1) cur store env (.drop target) = + .ok (store', .erased) ∧ + RootOwnership store' rest := + ⟨runOp_drop hresolve heval, dropVal_preserves hown heval⟩ + +theorem runOp_dropU_owned {ctx : Ctx} {fuel : Nat} {cur : FnDef} + {store store' : Store} {env : List RVal} {target : Atom} {loc : Nat} + {rest : List Root} + (hresolve : resolveAtom env target = .ok (.loc loc)) + (heval : dropUVal ctx fuel store (.loc loc) = .ok store') + (hown : RootOwnership store (⟨.unique, .loc loc⟩ :: rest)) : + runOp ctx (fuel + 1) cur store env (.dropU target) = + .ok (store', .erased) ∧ + RootOwnership store' rest := + ⟨runOp_dropU hresolve heval, dropUVal_preserves hown heval⟩ + +/-- A successful shared release of an arbitrary runtime value exposes both +the exact surviving ownership and the reverse heap-shape relation needed to +transport semantic graphs. Scalars leave the store unchanged; locations use +the corresponding deep-drop theorems. -/ +theorem runOp_drop_value_owned_restricts {ctx : Ctx} {fuel : Nat} + {cur : FnDef} {store store' : Store} {env : List RVal} + {target : Atom} {value result : RVal} {rest : List Root} + (hresolve : resolveAtom env target = .ok value) + (hown : RootOwnership store (⟨.shared, value⟩ :: rest)) + (hrun : runOp ctx (fuel + 1) cur store env (.drop target) = + .ok (store', result)) : + result = .erased ∧ StoreGraphRestricts store store' ∧ + RootOwnership store' rest := by + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [hresolve, bindOk] at hrun + cases value with + | lit literal => + change (Except.ok (store, RVal.erased) : + Except Err (Store × RVal)) = .ok (store', result) at hrun + have hpair : (store, RVal.erased) = (store', result) := + Except.ok.inj hrun + cases hpair + exact ⟨rfl, StoreGraphRestricts.refl store, + hown.dropNoLocation rfl⟩ + | erased => + change (Except.ok (store, RVal.erased) : + Except Err (Store × RVal)) = .ok (store', result) at hrun + have hpair : (store, RVal.erased) = (store', result) := + Except.ok.inj hrun + cases hpair + exact ⟨rfl, StoreGraphRestricts.refl store, + hown.dropNoLocation rfl⟩ + | loc loc => + dsimp only at hrun + cases hdrop : dropVal ctx fuel store (.loc loc) with + | error err => + rw [hdrop] at hrun + change (Except.error err : Except Err (Store × RVal)) = + .ok (store', result) at hrun + contradiction + | ok dropped => + rw [hdrop] at hrun + change (Except.ok (dropped, RVal.erased) : + Except Err (Store × RVal)) = .ok (store', result) at hrun + have hpair : (dropped, RVal.erased) = (store', result) := + Except.ok.inj hrun + cases hpair + exact ⟨rfl, dropVal_restricts hdrop, + dropVal_preserves hown hdrop⟩ + +/-- Affine destruction has the same semantic store interface as shared +release: it consumes one unique root and only removes heap nodes. -/ +theorem runOp_dropU_value_owned_restricts {ctx : Ctx} {fuel : Nat} + {cur : FnDef} {store store' : Store} {env : List RVal} + {target : Atom} {value result : RVal} {rest : List Root} + (hresolve : resolveAtom env target = .ok value) + (hown : RootOwnership store (⟨.unique, value⟩ :: rest)) + (hrun : runOp ctx (fuel + 1) cur store env (.dropU target) = + .ok (store', result)) : + result = .erased ∧ StoreGraphRestricts store store' ∧ + RootOwnership store' rest := by + rw [runOp.eq_def] at hrun + dsimp only at hrun + rw [hresolve, bindOk] at hrun + cases value with + | lit literal => + change (Except.ok (store, RVal.erased) : + Except Err (Store × RVal)) = .ok (store', result) at hrun + have hpair : (store, RVal.erased) = (store', result) := + Except.ok.inj hrun + cases hpair + exact ⟨rfl, StoreGraphRestricts.refl store, + hown.dropNoLocation rfl⟩ + | erased => + change (Except.ok (store, RVal.erased) : + Except Err (Store × RVal)) = .ok (store', result) at hrun + have hpair : (store, RVal.erased) = (store', result) := + Except.ok.inj hrun + cases hpair + exact ⟨rfl, StoreGraphRestricts.refl store, + hown.dropNoLocation rfl⟩ + | loc loc => + dsimp only at hrun + cases hdrop : dropUVal ctx fuel store (.loc loc) with + | error err => + rw [hdrop] at hrun + change (Except.error err : Except Err (Store × RVal)) = + .ok (store', result) at hrun + contradiction + | ok dropped => + rw [hdrop] at hrun + change (Except.ok (dropped, RVal.erased) : + Except Err (Store × RVal)) = .ok (store', result) at hrun + have hpair : (dropped, RVal.erased) = (store', result) := + Except.ok.inj hrun + cases hpair + exact ⟨rfl, dropUVal_restricts hdrop, + dropUVal_preserves hown hdrop⟩ + +/-- The live-location bijection used by reuse soundness. The reused target +slot corresponds to the specification's fresh append location; every other +live old location corresponds to itself. -/ +def reuseRel (store : Store) (target : Nat) (left right : Nat) : Prop := + (left = target ∧ right = store.nodes.size) ∨ + (left = right ∧ left ≠ target ∧ + ∃ box, store.get? left = some box) + +private theorem rvalsIso_refl_of_mem {rel : Nat → Nat → Prop} : + ∀ {values : List RVal}, + (∀ value ∈ values, RValIso rel value value) → + RValsIso rel values values + | [], _ => .nil + | value :: rest, h => + .cons (h value (by simp)) + (rvalsIso_refl_of_mem fun child hchild => + h child (by simp [hchild])) + +/-- In-place reuse and its shallow-free-plus-append-allocation specification +are isomorphic. Exact ownership supplies the critical fact that no surviving +edge can point to the consumed target slot. -/ +def HeapIso.reuse {store : Store} {target : Nat} {oldBox : NodeBox} + {newNode : Node} {rest : List Root} + (hget : store.get? target = some oldBox) + (hown : RootOwnership (reuseNodeStore store target newNode) + (⟨.unique, .loc target⟩ :: rest)) : + HeapIso (reuseNodeStore store target newNode) + ((store.kill target).allocNode .unique newNode).1 := by + let left := reuseNodeStore store target newNode + let right := ((store.kill target).allocNode .unique newNode).1 + let fresh := store.nodes.size + have hnew : left.get? target = some ⟨.unique, 1, newNode⟩ := by + exact get?_reuseNodeStore_same hget + have nodeSelfIso : ∀ {parent box}, left.get? parent = some box → + NodeIso (reuseRel store target) box.node box.node := by + intro parent box hparent + have childIso : ∀ child ∈ nodeChildren box.node, + RValIso (reuseRel store target) child child := by + intro child hchild + have hworld := hown.edges_world hparent child hchild + have hneValue := hown.sole_child_ne_unique hnew hparent hchild + cases child with + | loc childLoc => + obtain ⟨childBox, hchildLive, _⟩ := hworld + have hne : childLoc ≠ target := by + intro heq + subst childLoc + exact hneValue rfl + have hold : store.get? childLoc = some childBox := + get?_of_reuseNodeStore_other (Ne.symm hne) hget hchildLive + exact .loc (.inr ⟨rfl, hne, childBox, hold⟩) + | lit literal => exact .lit + | erased => exact .erased + cases hnode : box.node with + | ctorN cid fields => + apply NodeIso.ctor + apply rvalsIso_refl_of_mem + intro child hchild + apply childIso child + simpa [nodeChildren, hnode] using hchild + | papN fn arity args => + apply NodeIso.pap + apply rvalsIso_refl_of_mem + intro child hchild + apply childIso child + simpa [nodeChildren, hnode] using hchild + refine + { locRel := reuseRel store target + left_unique := ?_ + right_unique := ?_ + left_total := ?_ + right_total := ?_ + related_live := ?_ } + · intro loc right₁ right₂ h₁ h₂ + rcases h₁ with h₁ | h₁ <;> rcases h₂ with h₂ | h₂ + · exact h₁.2.trans h₂.2.symm + · exact False.elim (h₂.2.1 h₁.1) + · exact False.elim (h₁.2.1 h₂.1) + · exact h₁.1.symm.trans h₂.1 + · intro left₁ left₂ loc h₁ h₂ + rcases h₁ with h₁ | h₁ <;> rcases h₂ with h₂ | h₂ + · exact h₁.1.trans h₂.1.symm + · obtain ⟨box, hbox⟩ := h₂.2.2 + have heq : left₂ = store.nodes.size := h₂.1.trans h₁.2 + subst left₂ + rw [HeapIso.get?_fresh] at hbox + contradiction + · obtain ⟨box, hbox⟩ := h₁.2.2 + have heq : left₁ = store.nodes.size := h₁.1.trans h₂.2 + subst left₁ + rw [HeapIso.get?_fresh] at hbox + contradiction + · exact h₁.1.trans h₂.1.symm + · intro loc box hbox + by_cases heq : loc = target + · exact ⟨fresh, .inl ⟨heq, rfl⟩⟩ + · have hold : store.get? loc = some box := + get?_of_reuseNodeStore_other (Ne.symm heq) hget hbox + exact ⟨loc, .inr ⟨rfl, heq, box, hold⟩⟩ + · intro loc box hbox + by_cases heq : loc = fresh + · exact ⟨target, .inl ⟨rfl, heq⟩⟩ + · have hnotFresh : loc ≠ (store.kill target).nodes.size := by + simpa [fresh, Store.kill] using heq + have hkilled : (store.kill target).get? loc = some box := + HeapIso.get?_of_allocNode_old hnotFresh hbox + have hne : target ≠ loc := by + intro htarget + subst loc + rw [get?_kill_same hget] at hkilled + contradiction + have hold : store.get? loc = some box := + get?_of_kill_other hne hget hkilled + exact ⟨loc, .inr ⟨rfl, Ne.symm hne, box, hold⟩⟩ + · intro leftLoc rightLoc hrel + rcases hrel with hnewRel | holdRel + · obtain ⟨hleftLoc, hrightLoc⟩ := hnewRel + subst leftLoc + subst rightLoc + refine ⟨⟨.unique, 1, newNode⟩, ⟨.unique, 1, newNode⟩, + hnew, ?_, ?_⟩ + · have hrightNew := HeapIso.get?_allocNode_new + (store.kill target) .unique newNode + change ((store.kill target).allocNode .unique newNode).1.get? + (store.kill target).nodes.size = + some ⟨.unique, 1, newNode⟩ at hrightNew + have hsize : (store.kill target).nodes.size = store.nodes.size := by + simp [Store.kill] + rw [hsize] at hrightNew + exact hrightNew + · exact ⟨rfl, rfl, nodeSelfIso hnew⟩ + · obtain ⟨rfl, hne, oldLiveBox, hold⟩ := holdRel + have hleft : left.get? leftLoc = some oldLiveBox := + get?_reuseNodeStore_other (Ne.symm hne) hget hold + have hkilled : (store.kill target).get? leftLoc = some oldLiveBox := + get?_kill_other (Ne.symm hne) hget hold + have hright : right.get? leftLoc = some oldLiveBox := + HeapIso.get?_allocNode_old hkilled + exact ⟨oldLiveBox, oldLiveBox, hleft, hright, + ⟨rfl, rfl, nodeSelfIso hleft⟩⟩ + +/-- In-place shared reuse and its shallow-free-plus-append-allocation +specification are isomorphic. Unit shared ownership excludes every +surviving root and heap edge from the consumed slot, so the reused location +can correspond solely to the specification's fresh location. -/ +def HeapIso.reuseShared {store : Store} {target : Nat} {oldBox : NodeBox} + {newNode : Node} {rest : List Root} + (hget : store.get? target = some oldBox) + (hown : RootOwnership (reuseSharedNodeStore store target newNode) + (⟨.shared, .loc target⟩ :: rest)) : + HeapIso (reuseSharedNodeStore store target newNode) + ((store.kill target).allocNode .shared newNode).1 := by + let left := reuseSharedNodeStore store target newNode + let right := ((store.kill target).allocNode .shared newNode).1 + let fresh := store.nodes.size + have hnew : left.get? target = some ⟨.shared, 1, newNode⟩ := by + exact get?_reuseSharedNodeStore_same hget + have nodeSelfIso : ∀ {parent box}, left.get? parent = some box → + NodeIso (reuseRel store target) box.node box.node := by + intro parent box hparent + have childIso : ∀ child ∈ nodeChildren box.node, + RValIso (reuseRel store target) child child := by + intro child hchild + have hworld := hown.edges_world hparent child hchild + have hneValue := hown.sole_child_ne hnew hparent hchild + cases child with + | loc childLoc => + obtain ⟨childBox, hchildLive, _⟩ := hworld + have hne : childLoc ≠ target := by + intro heq + subst childLoc + exact hneValue rfl + have hold : store.get? childLoc = some childBox := + get?_of_reuseSharedNodeStore_other (Ne.symm hne) hget hchildLive + exact .loc (.inr ⟨rfl, hne, childBox, hold⟩) + | lit literal => exact .lit + | erased => exact .erased + cases hnode : box.node with + | ctorN cid fields => + apply NodeIso.ctor + apply rvalsIso_refl_of_mem + intro child hchild + apply childIso child + simpa [nodeChildren, hnode] using hchild + | papN fn arity args => + apply NodeIso.pap + apply rvalsIso_refl_of_mem + intro child hchild + apply childIso child + simpa [nodeChildren, hnode] using hchild + refine + { locRel := reuseRel store target + left_unique := ?_ + right_unique := ?_ + left_total := ?_ + right_total := ?_ + related_live := ?_ } + · intro loc right₁ right₂ h₁ h₂ + rcases h₁ with h₁ | h₁ <;> rcases h₂ with h₂ | h₂ + · exact h₁.2.trans h₂.2.symm + · exact False.elim (h₂.2.1 h₁.1) + · exact False.elim (h₁.2.1 h₂.1) + · exact h₁.1.symm.trans h₂.1 + · intro left₁ left₂ loc h₁ h₂ + rcases h₁ with h₁ | h₁ <;> rcases h₂ with h₂ | h₂ + · exact h₁.1.trans h₂.1.symm + · obtain ⟨box, hbox⟩ := h₂.2.2 + have heq : left₂ = store.nodes.size := h₂.1.trans h₁.2 + subst left₂ + rw [HeapIso.get?_fresh] at hbox + contradiction + · obtain ⟨box, hbox⟩ := h₁.2.2 + have heq : left₁ = store.nodes.size := h₁.1.trans h₂.2 + subst left₁ + rw [HeapIso.get?_fresh] at hbox + contradiction + · exact h₁.1.trans h₂.1.symm + · intro loc box hbox + by_cases heq : loc = target + · exact ⟨fresh, .inl ⟨heq, rfl⟩⟩ + · have hold : store.get? loc = some box := + get?_of_reuseSharedNodeStore_other (Ne.symm heq) hget hbox + exact ⟨loc, .inr ⟨rfl, heq, box, hold⟩⟩ + · intro loc box hbox + by_cases heq : loc = fresh + · exact ⟨target, .inl ⟨rfl, heq⟩⟩ + · have hnotFresh : loc ≠ (store.kill target).nodes.size := by + simpa [fresh, Store.kill] using heq + have hkilled : (store.kill target).get? loc = some box := + HeapIso.get?_of_allocNode_old hnotFresh hbox + have hne : target ≠ loc := by + intro htarget + subst loc + rw [get?_kill_same hget] at hkilled + contradiction + have hold : store.get? loc = some box := + get?_of_kill_other hne hget hkilled + exact ⟨loc, .inr ⟨rfl, Ne.symm hne, box, hold⟩⟩ + · intro leftLoc rightLoc hrel + rcases hrel with hnewRel | holdRel + · obtain ⟨hleftLoc, hrightLoc⟩ := hnewRel + subst leftLoc + subst rightLoc + refine ⟨⟨.shared, 1, newNode⟩, ⟨.shared, 1, newNode⟩, + hnew, ?_, ?_⟩ + · have hrightNew := HeapIso.get?_allocNode_new + (store.kill target) .shared newNode + change ((store.kill target).allocNode .shared newNode).1.get? + (store.kill target).nodes.size = + some ⟨.shared, 1, newNode⟩ at hrightNew + have hsize : (store.kill target).nodes.size = store.nodes.size := by + simp [Store.kill] + rw [hsize] at hrightNew + exact hrightNew + · exact ⟨rfl, rfl, nodeSelfIso hnew⟩ + · obtain ⟨rfl, hne, oldLiveBox, hold⟩ := holdRel + have hleft : left.get? leftLoc = some oldLiveBox := + get?_reuseSharedNodeStore_other (Ne.symm hne) hget hold + have hkilled : (store.kill target).get? leftLoc = some oldLiveBox := + get?_kill_other (Ne.symm hne) hget hold + have hright : right.get? leftLoc = some oldLiveBox := + HeapIso.get?_allocNode_old hkilled + exact ⟨oldLiveBox, oldLiveBox, hleft, hright, + ⟨rfl, rfl, nodeSelfIso hleft⟩⟩ + +/-- Full unique-reuse soundness. The in-place evaluator transition and the +shallow-free-plus-append-allocation specification both preserve exact +ownership, and their result roots correspond under a live-heap isomorphism. +The partition premise is a root-multiset equation (`List.Perm`): canonical +same-arity FBIP reuse permutes the roots without any common list split. -/ +theorem reuse_sound {store : Store} {target : Nat} {oldNode newNode : Node} + {before after : List Root} + (hget : store.get? target = some ⟨.unique, 1, oldNode⟩) + (hown : RootOwnership store (⟨.unique, .loc target⟩ :: before)) + (hpartition : + (rootsFor .unique (nodeChildren oldNode) ++ before).Perm + (rootsFor .unique (nodeChildren newNode) ++ after)) + (hworld : NodeWorld .unique newNode) : + ∃ iso : HeapIso (reuseNodeStore store target newNode) + ((store.kill target).allocNode .unique newNode).1, + RootOwnership (reuseNodeStore store target newNode) + (⟨.unique, .loc target⟩ :: after) ∧ + RootOwnership ((store.kill target).allocNode .unique newNode).1 + (⟨.unique, + .loc ((store.kill target).allocNode .unique newNode).2⟩ :: after) ∧ + iso.locRel target + ((store.kill target).allocNode .unique newNode).2 := by + have hinPlace := hown.reuseNode hget hpartition hworld + have hreference := hown.freeAllocNode hget hpartition hworld + let iso := HeapIso.reuse hget hinPlace + refine ⟨iso, hinPlace, hreference, ?_⟩ + change reuseRel store target target + ((store.kill target).allocNode .unique newNode).2 + exact .inl ⟨rfl, by simp [Store.kill, Store.allocNode]⟩ + +/-- Full hot shared-reuse soundness. Physical in-place replacement and the +logical shallow-free-plus-fresh-allocation path preserve exact ownership, +their result roots correspond, and their live heaps differ only by the +reused-slot/fresh-slot renaming. -/ +theorem reuse_shared_sound {store : Store} {target : Nat} + {oldNode newNode : Node} {before after : List Root} + (hget : store.get? target = some ⟨.shared, 1, oldNode⟩) + (hown : RootOwnership store (⟨.shared, .loc target⟩ :: before)) + (hpartition : + (rootsFor .shared (nodeChildren oldNode) ++ before).Perm + (rootsFor .shared (nodeChildren newNode) ++ after)) + (hworld : NodeWorld .shared newNode) : + ∃ iso : HeapIso (reuseSharedNodeStore store target newNode) + ((store.kill target).allocNode .shared newNode).1, + RootOwnership (reuseSharedNodeStore store target newNode) + (⟨.shared, .loc target⟩ :: after) ∧ + RootOwnership ((store.kill target).allocNode .shared newNode).1 + (⟨.shared, + .loc ((store.kill target).allocNode .shared newNode).2⟩ :: after) ∧ + iso.locRel target + ((store.kill target).allocNode .shared newNode).2 := by + have hinPlace := hown.reuseSharedNode hget hpartition hworld + have hreference := hown.freeAllocSharedNode hget hpartition hworld + let iso := HeapIso.reuseShared hget hinPlace + refine ⟨iso, hinPlace, hreference, ?_⟩ + change reuseRel store target target + ((store.kill target).allocNode .shared newNode).2 + exact .inl ⟨rfl, by simp [Store.kill, Store.allocNode]⟩ + +/-- The shared-reuse isomorphism self-relates every surviving external root. +This stronger interface lets a caller transport continuations containing old +live locations while mapping only the replaced result to its fresh logical +location. -/ +theorem reuse_shared_sound_with_survivors {store : Store} {target : Nat} + {oldNode newNode : Node} {before after : List Root} + (hget : store.get? target = some ⟨.shared, 1, oldNode⟩) + (hown : RootOwnership store (⟨.shared, .loc target⟩ :: before)) + (hpartition : + (rootsFor .shared (nodeChildren oldNode) ++ before).Perm + (rootsFor .shared (nodeChildren newNode) ++ after)) + (hworld : NodeWorld .shared newNode) : + ∃ iso : HeapIso (reuseSharedNodeStore store target newNode) + ((store.kill target).allocNode .shared newNode).1, + RootOwnership (reuseSharedNodeStore store target newNode) + (⟨.shared, .loc target⟩ :: after) ∧ + RootOwnership ((store.kill target).allocNode .shared newNode).1 + (⟨.shared, + .loc ((store.kill target).allocNode .shared newNode).2⟩ :: after) ∧ + iso.locRel target + ((store.kill target).allocNode .shared newNode).2 ∧ + ∀ root ∈ after, RValIso iso.locRel root.value root.value := by + have hinPlace := hown.reuseSharedNode hget hpartition hworld + have hreference := hown.freeAllocSharedNode hget hpartition hworld + let iso := HeapIso.reuseShared hget hinPlace + refine ⟨iso, hinPlace, hreference, ?_, ?_⟩ + · change reuseRel store target target + ((store.kill target).allocNode .shared newNode).2 + exact .inl ⟨rfl, by simp [Store.kill, Store.allocNode]⟩ + · intro root member + cases root with + | mk world value => + cases value with + | lit literal => exact .lit + | erased => exact .erased + | loc location => + have different : location ≠ target := by + intro same + apply hinPlace.sole_root_ne + (get?_reuseSharedNodeStore_same hget) member + simp [same] + obtain ⟨box, live, _⟩ := + hinPlace.roots_world ⟨world, .loc location⟩ (by simp [member]) + have oldLive : store.get? location = some box := + get?_of_reuseSharedNodeStore_other (Ne.symm different) hget + live + apply RValIso.loc + exact .inr ⟨rfl, different, box, oldLive⟩ + +/-! Value realization is insensitive to the concrete numbering of live heap +locations. The generated mutual induction principles let these two theorems +recurse through constructor fields and pap captures without adding a depth +index to the semantic relation. -/ + +theorem ValueGraph.transport {funRel : FunctionRel} {left right : Store} + (iso : HeapIso left right) {v : IxIR0.Value} {leftVal rightVal : RVal} + (graph : ValueGraph funRel left v leftVal) + (valueIso : RValIso iso.locRel leftVal rightVal) : + ValueGraph funRel right v rightVal := by + refine ValueGraph.rec + (motive_1 := fun v leftVal _ => ∀ {rightVal}, + RValIso iso.locRel leftVal rightVal → + ValueGraph funRel right v rightVal) + (motive_2 := fun values leftVals _ => ∀ {rightVals}, + RValsIso iso.locRel leftVals rightVals → + ValuesGraph funRel right values rightVals) + ?_ ?_ ?_ ?_ ?_ ?_ graph valueIso + · intro l rightVal hval + cases hval + exact .lit + · intro rightVal hval + cases hval + exact .erased + · intro adr tag args loc world rc cid fields hget hadr htag + hfields ihFields rightVal hval + cases hval with + | loc hloc => + obtain ⟨leftBox, rightBox, hleft, hright, hboxes⟩ := + iso.related_live hloc + have hlbox : leftBox = ⟨world, rc, .ctorN cid fields⟩ := by + exact Option.some.inj (hleft.symm.trans hget) + subst leftBox + cases rightBox with + | mk rightWorld rightRc rightNode => + obtain ⟨hworld, hrc, hnode⟩ := hboxes + change world = rightWorld at hworld + change rc = rightRc at hrc + change NodeIso iso.locRel (.ctorN cid fields) rightNode at hnode + subst rightWorld + subst rightRc + cases hnode with + | ctor hfieldIso => + exact .ctor hright hadr htag (ihFields hfieldIso) + · intro v f arity captures loc rc args hget hfun hargs ihArgs + rightVal hval + cases hval with + | loc hloc => + obtain ⟨leftBox, rightBox, hleft, hright, hboxes⟩ := + iso.related_live hloc + have hlbox : leftBox = ⟨.shared, rc, .papN f arity args⟩ := by + exact Option.some.inj (hleft.symm.trans hget) + subst leftBox + cases rightBox with + | mk rightWorld rightRc rightNode => + obtain ⟨hworld, hrc, hnode⟩ := hboxes + change Owned.shared = rightWorld at hworld + change rc = rightRc at hrc + change NodeIso iso.locRel (.papN f arity args) rightNode at hnode + subst rightWorld + subst rightRc + cases hnode with + | pap hargIso => + exact .function hright hfun (ihArgs hargIso) + · intro rightVals hvals + cases hvals + exact .nil + · intro v rv vs rvs hgraph hgraphs ihGraph ihGraphs rightVals hvals + cases hvals with + | cons hval hvals => exact .cons (ihGraph hval) (ihGraphs hvals) + +theorem ValuesGraph.transport {funRel : FunctionRel} {left right : Store} + (iso : HeapIso left right) {values : List IxIR0.Value} + {leftVals rightVals : List RVal} + (graphs : ValuesGraph funRel left values leftVals) + (valuesIso : RValsIso iso.locRel leftVals rightVals) : + ValuesGraph funRel right values rightVals := by + refine ValuesGraph.rec + (motive_1 := fun v leftVal _ => ∀ {rightVal}, + RValIso iso.locRel leftVal rightVal → + ValueGraph funRel right v rightVal) + (motive_2 := fun values leftVals _ => ∀ {rightVals}, + RValsIso iso.locRel leftVals rightVals → + ValuesGraph funRel right values rightVals) + ?_ ?_ ?_ ?_ ?_ ?_ graphs valuesIso + · intro l rightVal hval + cases hval + exact .lit + · intro rightVal hval + cases hval + exact .erased + · intro adr tag args loc world rc cid fields hget hadr htag + hfields ihFields rightVal hval + cases hval with + | loc hloc => + obtain ⟨leftBox, rightBox, hleft, hright, hboxes⟩ := + iso.related_live hloc + have hlbox : leftBox = ⟨world, rc, .ctorN cid fields⟩ := by + exact Option.some.inj (hleft.symm.trans hget) + subst leftBox + cases rightBox with + | mk rightWorld rightRc rightNode => + obtain ⟨hworld, hrc, hnode⟩ := hboxes + change world = rightWorld at hworld + change rc = rightRc at hrc + change NodeIso iso.locRel (.ctorN cid fields) rightNode at hnode + subst rightWorld + subst rightRc + cases hnode with + | ctor hfieldIso => + exact .ctor hright hadr htag (ihFields hfieldIso) + · intro v f arity captures loc rc args hget hfun hargs ihArgs + rightVal hval + cases hval with + | loc hloc => + obtain ⟨leftBox, rightBox, hleft, hright, hboxes⟩ := + iso.related_live hloc + have hlbox : leftBox = ⟨.shared, rc, .papN f arity args⟩ := by + exact Option.some.inj (hleft.symm.trans hget) + subst leftBox + cases rightBox with + | mk rightWorld rightRc rightNode => + obtain ⟨hworld, hrc, hnode⟩ := hboxes + change Owned.shared = rightWorld at hworld + change rc = rightRc at hrc + change NodeIso iso.locRel (.papN f arity args) rightNode at hnode + subst rightWorld + subst rightRc + cases hnode with + | pap hargIso => + exact .function hright hfun (ihArgs hargIso) + · intro rightVals hvals + cases hvals + exact .nil + · intro v rv vs rvs hgraph hgraphs ihGraph ihGraphs rightVals hvals + cases hvals with + | cons hval hvals => exact .cons (ihGraph hval) (ihGraphs hvals) + +/-! ## Primitive proof fixtures + +These derivations exercise the theorem API, rather than merely executing the +interpreter. They cover shared alias decrement/reclamation, zero-RC unique +deep-free, and in-place reuse versus a free-plus-allocation heap whose result +location is deliberately different, plus shallow-free and borrow/retain fetch +accounting. -/ + +private def fixtureNode : Node := .ctorN default #[] + +private def fixtureStore : Store := + (({} : Store).allocNode .shared fixtureNode).1 + +private def fixtureLoc : Nat := (({} : Store).allocNode .shared fixtureNode).2 + +theorem fixture_alloc_owned : + RootOwnership fixtureStore [⟨.shared, .loc fixtureLoc⟩] := by + apply RootOwnership.allocNode (store := ({} : Store)) + (world := .shared) (node := fixtureNode) (rest := []) + RootOwnership.empty + trivial + +theorem fixture_dup_owned : + RootOwnership + (incRcStore fixtureStore fixtureLoc ⟨.shared, 1, fixtureNode⟩) + [⟨.shared, .loc fixtureLoc⟩, ⟨.shared, .loc fixtureLoc⟩] := by + apply RootOwnership.dup + · exact HeapIso.get?_allocNode_new ({} : Store) .shared fixtureNode + · exact fixture_alloc_owned + +theorem fixture_drop_owned : + RootOwnership + (decRcStore + (incRcStore fixtureStore fixtureLoc ⟨.shared, 1, fixtureNode⟩) + fixtureLoc ⟨.shared, 2, fixtureNode⟩) + [⟨.shared, .loc fixtureLoc⟩] := by + apply RootOwnership.dropSharedMany (rc := 2) (by omega) + · exact get?_incRcStore_same + (HeapIso.get?_allocNode_new ({} : Store) .shared fixtureNode) + · exact fixture_dup_owned + +private def fixtureDupStore : Store := + incRcStore fixtureStore fixtureLoc ⟨.shared, 1, fixtureNode⟩ + +private def fixtureAliasedNode : Node := + .ctorN default #[.loc fixtureLoc, .loc fixtureLoc] + +private def fixtureAliasedStore : Store := + (fixtureDupStore.allocNode .shared fixtureAliasedNode).1 + +private def fixtureAliasedLoc : Nat := + (fixtureDupStore.allocNode .shared fixtureAliasedNode).2 + +theorem fixture_aliased_alloc_owned : + RootOwnership fixtureAliasedStore + [⟨.shared, .loc fixtureAliasedLoc⟩] := by + unfold fixtureAliasedStore fixtureAliasedLoc + apply RootOwnership.allocNode (store := fixtureDupStore) + (world := .shared) (node := fixtureAliasedNode) (rest := []) + · simpa [fixtureDupStore, fixtureAliasedNode, nodeChildren, rootsFor] + using fixture_dup_owned + · trivial + +private def fixtureAliasedAfterParent : Store := + fixtureAliasedStore.rcTick.kill fixtureAliasedLoc + +private def fixtureAliasedAfterFirstChild : Store := + decRcStore fixtureAliasedAfterParent fixtureLoc + ⟨.shared, 2, fixtureNode⟩ + +private def fixtureAliasedDroppedStore : Store := + fixtureAliasedAfterFirstChild.rcTick.kill fixtureLoc + +private def fixtureCtx : Ctx := { decls := Env.empty } + +private theorem fixture_aliased_parent_get : + fixtureAliasedStore.get? fixtureAliasedLoc = + some ⟨.shared, 1, fixtureAliasedNode⟩ := by + simp [fixtureAliasedStore, fixtureAliasedLoc] + +private theorem fixture_aliased_child_after_parent_get : + fixtureAliasedAfterParent.get? fixtureLoc = + some ⟨.shared, 2, fixtureNode⟩ := by + have hleaf : fixtureStore.get? fixtureLoc = + some ⟨.shared, 1, fixtureNode⟩ := + HeapIso.get?_allocNode_new ({} : Store) .shared fixtureNode + have hdup : fixtureDupStore.get? fixtureLoc = + some ⟨.shared, 2, fixtureNode⟩ := by + exact get?_incRcStore_same hleaf + have hchild : fixtureAliasedStore.get? fixtureLoc = + some ⟨.shared, 2, fixtureNode⟩ := by + exact HeapIso.get?_allocNode_old hdup + have hne : fixtureAliasedLoc ≠ fixtureLoc := by decide + unfold fixtureAliasedAfterParent + apply get?_kill_other hne + · simpa using fixture_aliased_parent_get + · simpa using hchild + +private theorem fixture_aliased_child_after_first_get : + fixtureAliasedAfterFirstChild.get? fixtureLoc = + some ⟨.shared, 1, fixtureNode⟩ := by + exact get?_decRcStore_same fixture_aliased_child_after_parent_get + +theorem fixture_aliased_drop_eval : + dropVal fixtureCtx 8 fixtureAliasedStore (.loc fixtureAliasedLoc) = + .ok fixtureAliasedDroppedStore := by + rw [dropVal.eq_def] + dsimp only + rw [fixture_aliased_parent_get] + dsimp only + have hone : ((1 : Nat) == 1) = true := by decide + rw [hone] + change dropMany fixtureCtx 7 fixtureAliasedAfterParent + [.loc fixtureLoc, .loc fixtureLoc] = .ok fixtureAliasedDroppedStore + rw [dropMany.eq_def] + dsimp only + rw [dropVal.eq_def] + dsimp only + rw [fixture_aliased_child_after_parent_get] + dsimp only + have htwo : ((2 : Nat) == 1) = false := by decide + rw [htwo] + simp only [Bool.false_eq_true, if_false, Nat.reduceSub, bindOk] + change dropMany fixtureCtx 6 fixtureAliasedAfterFirstChild + [.loc fixtureLoc] = .ok fixtureAliasedDroppedStore + rw [dropMany.eq_def] + dsimp only + rw [dropVal.eq_def] + dsimp only + rw [fixture_aliased_child_after_first_get] + dsimp only + rw [hone] + simp only [if_true, fixtureNode] + rw [dropMany.eq_def] + rw [bindOk] + rw [dropMany.eq_def] + rfl + +theorem fixture_aliased_drop_owned : + RootOwnership fixtureAliasedDroppedStore [] := + dropVal_preserves fixture_aliased_alloc_owned fixture_aliased_drop_eval + +theorem fixture_aliased_drop_live_zero : + fixtureAliasedDroppedStore.live = 0 := by + rfl + +theorem fixture_aliased_drop_counters : + fixtureAliasedDroppedStore.frees = 2 ∧ + fixtureAliasedDroppedStore.rcops = 4 := by + constructor <;> rfl + +private def fixtureUniqueLeafStore : Store := + (({} : Store).allocNode .unique fixtureNode).1 + +private def fixtureUniqueLeafLoc : Nat := + (({} : Store).allocNode .unique fixtureNode).2 + +theorem fixture_unique_leaf_owned : + RootOwnership fixtureUniqueLeafStore + [⟨.unique, .loc fixtureUniqueLeafLoc⟩] := by + apply RootOwnership.allocNode (store := ({} : Store)) + (world := .unique) (node := fixtureNode) (rest := []) + · exact RootOwnership.empty + · trivial + +private def fixtureUniqueParentNode : Node := + .ctorN default #[.loc fixtureUniqueLeafLoc] + +private def fixtureUniqueStore : Store := + (fixtureUniqueLeafStore.allocNode .unique fixtureUniqueParentNode).1 + +private def fixtureUniqueLoc : Nat := + (fixtureUniqueLeafStore.allocNode .unique fixtureUniqueParentNode).2 + +theorem fixture_unique_alloc_owned : + RootOwnership fixtureUniqueStore + [⟨.unique, .loc fixtureUniqueLoc⟩] := by + unfold fixtureUniqueStore fixtureUniqueLoc + apply RootOwnership.allocNode (store := fixtureUniqueLeafStore) + (world := .unique) (node := fixtureUniqueParentNode) (rest := []) + · simpa [fixtureUniqueParentNode, nodeChildren, rootsFor] + using fixture_unique_leaf_owned + · trivial + +private def fixtureUniqueAfterParent : Store := + fixtureUniqueStore.kill fixtureUniqueLoc + +private def fixtureUniqueDroppedStore : Store := + fixtureUniqueAfterParent.kill fixtureUniqueLeafLoc + +private theorem fixture_unique_parent_get : + fixtureUniqueStore.get? fixtureUniqueLoc = + some ⟨.unique, 1, fixtureUniqueParentNode⟩ := by + simp [fixtureUniqueStore, fixtureUniqueLoc] + +private theorem fixture_unique_child_after_parent_get : + fixtureUniqueAfterParent.get? fixtureUniqueLeafLoc = + some ⟨.unique, 1, fixtureNode⟩ := by + have hleaf : fixtureUniqueLeafStore.get? fixtureUniqueLeafLoc = + some ⟨.unique, 1, fixtureNode⟩ := by + simp [fixtureUniqueLeafStore, fixtureUniqueLeafLoc] + have hchild : fixtureUniqueStore.get? fixtureUniqueLeafLoc = + some ⟨.unique, 1, fixtureNode⟩ := + HeapIso.get?_allocNode_old hleaf + have hne : fixtureUniqueLoc ≠ fixtureUniqueLeafLoc := by decide + unfold fixtureUniqueAfterParent + exact get?_kill_other hne fixture_unique_parent_get hchild + +theorem fixture_unique_drop_eval : + dropUVal fixtureCtx 6 fixtureUniqueStore (.loc fixtureUniqueLoc) = + .ok fixtureUniqueDroppedStore := by + rw [dropUVal.eq_def] + dsimp only + rw [fixture_unique_parent_get] + change dropManyU fixtureCtx 5 fixtureUniqueAfterParent + [.loc fixtureUniqueLeafLoc] = .ok fixtureUniqueDroppedStore + rw [dropManyU.eq_def] + dsimp only + rw [dropUVal.eq_def] + dsimp only + rw [fixture_unique_child_after_parent_get] + simp only [fixtureNode] + rw [dropManyU.eq_def] + rw [bindOk] + rw [dropManyU.eq_def] + rfl + +theorem fixture_unique_drop_owned : + RootOwnership fixtureUniqueDroppedStore [] := + dropUVal_preserves fixture_unique_alloc_owned fixture_unique_drop_eval + +theorem fixture_unique_drop_live_zero : + fixtureUniqueDroppedStore.live = 0 := by + rfl + +theorem fixture_unique_drop_counters : + fixtureUniqueDroppedStore.frees = 2 ∧ + fixtureUniqueDroppedStore.rcops = 0 := by + constructor <;> rfl + +private def fixtureReuseCid : CtorId := + { block := default, indIdx := 0, cidx := 1 } + +private def fixtureReuseNode : Node := + .ctorN fixtureReuseCid #[.loc fixtureUniqueLeafLoc] + +private def fixtureReuseStore : Store := + reuseNodeStore fixtureUniqueStore fixtureUniqueLoc fixtureReuseNode + +private def fixtureReuseSpec : Store := + ((fixtureUniqueStore.kill fixtureUniqueLoc).allocNode + .unique fixtureReuseNode).1 + +private def fixtureReuseFresh : Nat := + ((fixtureUniqueStore.kill fixtureUniqueLoc).allocNode + .unique fixtureReuseNode).2 + +theorem fixture_reuse_sound : + ∃ iso : HeapIso fixtureReuseStore fixtureReuseSpec, + RootOwnership fixtureReuseStore + [⟨.unique, .loc fixtureUniqueLoc⟩] ∧ + RootOwnership fixtureReuseSpec + [⟨.unique, .loc fixtureReuseFresh⟩] ∧ + iso.locRel fixtureUniqueLoc fixtureReuseFresh := by + simpa [fixtureReuseStore, fixtureReuseSpec, fixtureReuseFresh] using + (reuse_sound + (hget := fixture_unique_parent_get) + (hown := fixture_unique_alloc_owned) + (hpartition := .of_eq (by rfl)) + (hworld := by + trivial) + (newNode := fixtureReuseNode) + (before := []) (after := [])) + +theorem fixture_reuse_locations_differ : + fixtureUniqueLoc ≠ fixtureReuseFresh := by + decide + +theorem fixture_reuse_costs_excluded_from_iso : + fixtureReuseStore.allocs = 2 ∧ + fixtureReuseStore.reuses = 1 ∧ + fixtureReuseStore.frees = 0 ∧ + fixtureReuseSpec.allocs = 3 ∧ + fixtureReuseSpec.reuses = 0 ∧ + fixtureReuseSpec.frees = 1 := by + constructor + · rfl + constructor + · rfl + constructor + · rfl + constructor + · rfl + constructor <;> rfl + +/-! Same-arity field-replacement reuse — the list-reverse shape. +`Cons(x, xs)` is reused in place as `Cons(x, acc)`: the consumed roots are +the old fields `{x, xs}` plus the ambient accumulator root `acc`, and the +supplied roots are the new fields `{x, acc}` plus the leftover `xs`. The +partition is a genuine non-identity permutation — the `#guard`s below check +executably that the two root lists are unequal yet multiset-equal, so the +old equality-shaped premise was uninstantiable here. -/ + +private def fixtureSwapAccStore : Store := + (({} : Store).allocNode .unique fixtureNode).1 + +private def fixtureSwapAccLoc : Nat := + (({} : Store).allocNode .unique fixtureNode).2 + +private def fixtureSwapXsStore : Store := + (fixtureSwapAccStore.allocNode .unique fixtureNode).1 + +private def fixtureSwapXsLoc : Nat := + (fixtureSwapAccStore.allocNode .unique fixtureNode).2 + +private def fixtureSwapXStore : Store := + (fixtureSwapXsStore.allocNode .unique fixtureNode).1 + +private def fixtureSwapXLoc : Nat := + (fixtureSwapXsStore.allocNode .unique fixtureNode).2 + +/-- The reused cell `Cons(x, xs)`. -/ +private def fixtureSwapOldNode : Node := + .ctorN fixtureReuseCid #[.loc fixtureSwapXLoc, .loc fixtureSwapXsLoc] + +/-- Its replacement `Cons(x, acc)` — same arity, second field swapped. -/ +private def fixtureSwapNewNode : Node := + .ctorN fixtureReuseCid #[.loc fixtureSwapXLoc, .loc fixtureSwapAccLoc] + +private def fixtureSwapStore : Store := + (fixtureSwapXStore.allocNode .unique fixtureSwapOldNode).1 + +private def fixtureSwapLoc : Nat := + (fixtureSwapXStore.allocNode .unique fixtureSwapOldNode).2 + +private def fixtureSwapBefore : List Root := + [⟨.unique, .loc fixtureSwapAccLoc⟩] + +private def fixtureSwapAfter : List Root := + [⟨.unique, .loc fixtureSwapXsLoc⟩] + +-- Unequal as lists (no before/after split can equate them)… +#guard ((rootsFor .unique (nodeChildren fixtureSwapOldNode) ++ + fixtureSwapBefore) == + (rootsFor .unique (nodeChildren fixtureSwapNewNode) ++ + fixtureSwapAfter)) == false + +-- …but equal as root multisets: exactly the permutation premise. +#guard (rootsFor .unique (nodeChildren fixtureSwapOldNode) ++ + fixtureSwapBefore).isPerm + (rootsFor .unique (nodeChildren fixtureSwapNewNode) ++ + fixtureSwapAfter) + +private theorem fixture_swap_acc_owned : + RootOwnership fixtureSwapAccStore + [⟨.unique, .loc fixtureSwapAccLoc⟩] := by + unfold fixtureSwapAccStore fixtureSwapAccLoc + apply RootOwnership.allocNode (store := ({} : Store)) + (world := .unique) (node := fixtureNode) (rest := []) + · exact RootOwnership.empty + · trivial + +private theorem fixture_swap_xs_owned : + RootOwnership fixtureSwapXsStore + [⟨.unique, .loc fixtureSwapXsLoc⟩, + ⟨.unique, .loc fixtureSwapAccLoc⟩] := by + unfold fixtureSwapXsStore fixtureSwapXsLoc + apply RootOwnership.allocNode (store := fixtureSwapAccStore) + (world := .unique) (node := fixtureNode) + (rest := [⟨.unique, .loc fixtureSwapAccLoc⟩]) + · simpa [fixtureNode, nodeChildren, rootsFor] using fixture_swap_acc_owned + · trivial + +private theorem fixture_swap_x_owned : + RootOwnership fixtureSwapXStore + [⟨.unique, .loc fixtureSwapXLoc⟩, + ⟨.unique, .loc fixtureSwapXsLoc⟩, + ⟨.unique, .loc fixtureSwapAccLoc⟩] := by + unfold fixtureSwapXStore fixtureSwapXLoc + apply RootOwnership.allocNode (store := fixtureSwapXsStore) + (world := .unique) (node := fixtureNode) + (rest := [⟨.unique, .loc fixtureSwapXsLoc⟩, + ⟨.unique, .loc fixtureSwapAccLoc⟩]) + · simpa [fixtureNode, nodeChildren, rootsFor] using fixture_swap_xs_owned + · trivial + +private theorem fixture_swap_alloc_owned : + RootOwnership fixtureSwapStore + (⟨.unique, .loc fixtureSwapLoc⟩ :: fixtureSwapBefore) := by + unfold fixtureSwapStore fixtureSwapLoc fixtureSwapBefore + apply RootOwnership.allocNode (store := fixtureSwapXStore) + (world := .unique) (node := fixtureSwapOldNode) + (rest := [⟨.unique, .loc fixtureSwapAccLoc⟩]) + · simpa [fixtureSwapOldNode, nodeChildren, rootsFor] using + fixture_swap_x_owned + · trivial + +private theorem fixture_swap_parent_get : + fixtureSwapStore.get? fixtureSwapLoc = + some ⟨.unique, 1, fixtureSwapOldNode⟩ := + HeapIso.get?_allocNode_new fixtureSwapXStore .unique fixtureSwapOldNode + +/-- The old field roots plus `acc` permute (cons of a transposition — +not an equality) to the new field roots plus `xs`. -/ +private theorem fixture_swap_partition : + (rootsFor .unique (nodeChildren fixtureSwapOldNode) ++ + fixtureSwapBefore).Perm + (rootsFor .unique (nodeChildren fixtureSwapNewNode) ++ + fixtureSwapAfter) := by + show List.Perm + ([⟨.unique, .loc fixtureSwapXLoc⟩, ⟨.unique, .loc fixtureSwapXsLoc⟩, + ⟨.unique, .loc fixtureSwapAccLoc⟩] : List Root) + ([⟨.unique, .loc fixtureSwapXLoc⟩, ⟨.unique, .loc fixtureSwapAccLoc⟩, + ⟨.unique, .loc fixtureSwapXsLoc⟩] : List Root) + exact .cons _ (.swap _ _ _) + +private def fixtureSwapReuseStore : Store := + reuseNodeStore fixtureSwapStore fixtureSwapLoc fixtureSwapNewNode + +private def fixtureSwapReuseSpec : Store := + ((fixtureSwapStore.kill fixtureSwapLoc).allocNode + .unique fixtureSwapNewNode).1 + +private def fixtureSwapReuseFresh : Nat := + ((fixtureSwapStore.kill fixtureSwapLoc).allocNode + .unique fixtureSwapNewNode).2 + +/-- `reuse_sound` applied across a genuinely permuted partition: in-place +reuse keeps `xs` alive as the leftover root while `acc` becomes the new +second field, and both runs stay exactly owned and isomorphic. -/ +theorem fixture_swap_reuse_sound : + ∃ iso : HeapIso fixtureSwapReuseStore fixtureSwapReuseSpec, + RootOwnership fixtureSwapReuseStore + (⟨.unique, .loc fixtureSwapLoc⟩ :: fixtureSwapAfter) ∧ + RootOwnership fixtureSwapReuseSpec + (⟨.unique, .loc fixtureSwapReuseFresh⟩ :: fixtureSwapAfter) ∧ + iso.locRel fixtureSwapLoc fixtureSwapReuseFresh := by + simpa [fixtureSwapReuseStore, fixtureSwapReuseSpec, + fixtureSwapReuseFresh] using + (reuse_sound + (hget := fixture_swap_parent_get) + (hown := fixture_swap_alloc_owned) + (hpartition := fixture_swap_partition) + (hworld := by trivial) + (newNode := fixtureSwapNewNode) + (before := fixtureSwapBefore) (after := fixtureSwapAfter)) + +private def fixtureCur : FnDef := + { arity := 0, result := .shared, papSafe := false, body := .ret .erased } + +private def fixtureIdAddr : Address := default + +private def fixtureIdFn : FnDef := + { arity := 1, result := .unique, papSafe := false, body := .ret (.var 0) } + +private def fixtureIdCtx : Ctx := + { decls := fun a => + if a = fixtureIdAddr then some (.fn fixtureIdFn) else none } + +/-- A one-argument identity demonstrates a non-circular function contract: +the unique argument root becomes the unique result root without changing the +store or unrelated roots. -/ +theorem fixture_id_contract : + FnOwnershipContract fixtureIdCtx fixtureIdFn [.unique] := by + refine ⟨rfl, ?_⟩ + intro fuel store store' args value rest hlength hown hrun + cases args with + | nil => simp at hlength + | cons arg tail => + cases tail with + | cons arg' tail => simp at hlength + | nil => + cases fuel with + | zero => simp [runCode] at hrun + | succ fuel => + rw [runCode.eq_def] at hrun + change (Except.ok (store, arg) : Except Err (Store × RVal)) = + Except.ok (store', value) at hrun + have hpair : (store, arg) = (store', value) := + Except.ok.inj hrun + cases hpair + simpa [fixtureIdFn, rootsForWorlds] using hown + +theorem fixture_call_eval : + runOp fixtureIdCtx 3 fixtureCur fixtureUniqueStore + [.loc fixtureUniqueLoc] (.call fixtureIdAddr #[.var 0]) = + .ok (fixtureUniqueStore, .loc fixtureUniqueLoc) := by + rw [runOp.eq_def] + dsimp only + rw [show resolveAtoms [.loc fixtureUniqueLoc] #[.var 0] = + .ok [.loc fixtureUniqueLoc] by rfl, bindOk] + rw [invoke.eq_def] + dsimp only + rw [show fixtureIdCtx.decls fixtureIdAddr = some (.fn fixtureIdFn) by + simp [fixtureIdCtx]] + dsimp only [fixtureIdFn] + simp only [List.length_cons, List.length_nil, Nat.reduceAdd] + have harity : ¬ (((1 : Nat) != 1) = true) := by decide + rw [if_neg harity] + rw [runCode.eq_def] + dsimp only + rw [show resolveAtom [.loc fixtureUniqueLoc].reverse (.var 0) = + .ok (.loc fixtureUniqueLoc) by rfl, bindOk] + rw [bindOk] + unfold checkResultWorld RVal.hasWorld + dsimp only + have hworld : ((Owned.unique == Owned.unique) = true) := by decide + simp [fixture_unique_parent_get, hworld] + +theorem fixture_call_owned : + RootOwnership fixtureUniqueStore + [⟨.unique, .loc fixtureUniqueLoc⟩] := by + exact runOp_call_owned + (ctx := fixtureIdCtx) (fuel := 2) (cur := fixtureCur) + (store := fixtureUniqueStore) (store' := fixtureUniqueStore) + (env := [.loc fixtureUniqueLoc]) (f := fixtureIdAddr) + (atoms := #[.var 0]) (args := [.loc fixtureUniqueLoc]) + (value := .loc fixtureUniqueLoc) (d := fixtureIdFn) + (argWorlds := [.unique]) (rest := []) + (by rfl) + (by simp [fixtureIdCtx]) + fixture_id_contract + (by simpa [rootsForWorlds] using fixture_unique_alloc_owned) + fixture_call_eval + +theorem fixture_free_eval : + runOp fixtureCtx 1 fixtureCur fixtureUniqueStore + [.loc fixtureUniqueLoc] (.free (.var 0)) = + .ok (fixtureUniqueStore.kill fixtureUniqueLoc, .erased) := by + apply runOp_free + · rfl + · exact fixture_unique_parent_get + +theorem fixture_free_owned : + RootOwnership (fixtureUniqueStore.kill fixtureUniqueLoc) + [⟨.unique, .loc fixtureUniqueLeafLoc⟩] := by + have hfree := + fixture_unique_alloc_owned.killUniqueOne fixture_unique_parent_get + simpa [fixtureUniqueParentNode, nodeChildren, rootsFor] using hfree + +private def fixtureCaseBody : Code := + .letOp (.free (.var 1)) (.ret (.var 1)) + +private def fixtureCaseAlts : Array Alt := + #[.mk 0 1 fixtureCaseBody] + +private def fixtureCaseCode : Code := + .case (.var 0) false fixtureCaseAlts + +private def fixtureCaseCur : FnDef := + { arity := 0, result := .unique, papSafe := false, body := fixtureCaseCode } + +theorem fixture_case_field_borrowed : + HasWorld fixtureUniqueStore .unique (.loc fixtureUniqueLeafLoc) := by + apply fixture_unique_alloc_owned.caseFieldsBorrowed + (loc := fixtureUniqueLoc) (rc := 1) (cid := default) + (fields := #[.loc fixtureUniqueLeafLoc]) + · simpa [fixtureUniqueParentNode] using fixture_unique_parent_get + · simp + +/-- The case fixture enters with a borrowed child, shallow-frees the unique +scrutinee, and returns that child as the sole unique root. -/ +theorem fixture_case_eval : + runCode fixtureCtx 3 fixtureCaseCur fixtureUniqueStore + [.loc fixtureUniqueLoc] fixtureCaseCode = + .ok (fixtureUniqueStore.kill fixtureUniqueLoc, + .loc fixtureUniqueLeafLoc) := by + unfold fixtureCaseCode + rw [runCode_case_ctor + (hresolve := by rfl) + (hget := by + simpa [fixtureUniqueParentNode] using fixture_unique_parent_get) + (halt := by rfl) (hsize := by rfl)] + change runCode fixtureCtx 2 fixtureCaseCur fixtureUniqueStore + [.loc fixtureUniqueLeafLoc, .loc fixtureUniqueLoc] fixtureCaseBody = + .ok (fixtureUniqueStore.kill fixtureUniqueLoc, + .loc fixtureUniqueLeafLoc) + unfold fixtureCaseBody + rw [runCode.eq_def] + dsimp only + rw [runOp_free (hresolve := by rfl) fixture_unique_parent_get] + rw [bindOk] + rw [runCode.eq_def] + rfl + +theorem fixture_case_owned : + RootOwnership (fixtureUniqueStore.kill fixtureUniqueLoc) + [⟨.unique, .loc fixtureUniqueLeafLoc⟩] := by + apply runCode_case_ctor_owned + (ctx := fixtureCtx) (fuel := 2) (cur := fixtureCaseCur) + (store := fixtureUniqueStore) + (store' := fixtureUniqueStore.kill fixtureUniqueLoc) + (env := [.loc fixtureUniqueLoc]) (scrut := .var 0) + (peelNat := false) (alts := fixtureCaseAlts) + (loc := fixtureUniqueLoc) (rc := 1) (world := .unique) + (cid := default) (fields := #[.loc fixtureUniqueLeafLoc]) + (tag := 0) (nf := 1) (body := fixtureCaseBody) + (value := .loc fixtureUniqueLeafLoc) + (roots := [⟨.unique, .loc fixtureUniqueLoc⟩]) (rest := []) + · rfl + · simpa [fixtureUniqueParentNode] using fixture_unique_parent_get + · rfl + · rfl + · exact fixture_unique_alloc_owned + · intro _ _ _ + simpa [fixtureCaseCur] using fixture_free_owned + · exact fixture_case_eval + +private def fixtureNatBody : Code := .ret (.var 0) + +private def fixtureNatAlts : Array Alt := + #[.mk 0 0 (.ret .erased), .mk 1 1 fixtureNatBody] + +private def fixtureNatCode : Code := + .case (.var 0) true fixtureNatAlts + +private def fixtureNatCur : FnDef := + { arity := 0, result := .shared, papSafe := false, body := fixtureNatCode } + +theorem fixture_nat_case_eval : + runCode fixtureCtx 2 fixtureNatCur ({} : Store) + [.lit (.nat 2)] fixtureNatCode = + .ok (({} : Store), .lit (.nat 1)) := by + unfold fixtureNatCode + rw [runCode_case_nat_succ (n := 1) + (hresolve := by rfl) (halt := by rfl)] + unfold fixtureNatBody + rw [runCode.eq_def] + rfl + +theorem fixture_nat_case_owned : + RootOwnership ({} : Store) [⟨.shared, .lit (.nat 1)⟩] := by + apply runCode_case_nat_succ_owned + (ctx := fixtureCtx) (fuel := 1) (cur := fixtureNatCur) + (store := ({} : Store)) (store' := ({} : Store)) + (env := [.lit (.nat 2)]) (scrut := .var 0) + (alts := fixtureNatAlts) (n := 1) (tag := 1) + (body := fixtureNatBody) (value := .lit (.nat 1)) + (roots := []) (rest := []) + · rfl + · rfl + · exact RootOwnership.empty + · intro _ _ + exact RootOwnership.empty.addNoLocation (world := .shared) (by rfl) + · exact fixture_nat_case_eval + +private theorem fixture_aliased_child_get : + fixtureAliasedStore.get? fixtureLoc = + some ⟨.shared, 2, fixtureNode⟩ := by + have hleaf : fixtureStore.get? fixtureLoc = + some ⟨.shared, 1, fixtureNode⟩ := + HeapIso.get?_allocNode_new ({} : Store) .shared fixtureNode + have hdup : fixtureDupStore.get? fixtureLoc = + some ⟨.shared, 2, fixtureNode⟩ := + get?_incRcStore_same hleaf + exact HeapIso.get?_allocNode_old hdup + +theorem fixture_fetch_eval : + runOp fixtureCtx 1 fixtureCur fixtureAliasedStore + [.loc fixtureAliasedLoc] (.fetch (.var 0) 0) = + .ok (fixtureAliasedStore, .loc fixtureLoc) := by + apply runOp_fetch + · rfl + · exact fixture_aliased_parent_get + · rfl + +private def fixtureFetchRetainedStore : Store := + incRcStore fixtureAliasedStore fixtureLoc + ⟨.shared, 2, fixtureNode⟩ + +theorem fixture_fetch_dup_eval : + dupVals fixtureAliasedStore [.loc fixtureLoc] = + .ok fixtureFetchRetainedStore := by + exact dupVals_single fixture_aliased_child_get + +theorem fixture_fetch_dup_owned : + RootOwnership fixtureFetchRetainedStore + [⟨.shared, .loc fixtureLoc⟩, + ⟨.shared, .loc fixtureAliasedLoc⟩] := by + apply fetch_dupVals_preserves + (hget := fixture_aliased_parent_get) (i := 0) + · rfl + · exact fixture_aliased_alloc_owned + · exact fixture_fetch_dup_eval + +theorem fixture_fetch_dup_rc : + fixtureFetchRetainedStore.get? fixtureLoc = + some ⟨.shared, 3, fixtureNode⟩ := + get?_incRcStore_same fixture_aliased_child_get + +end Ix.Compiler.IxIR1.Sim diff --git a/Ix/Compiler/IxIR1/ThesisBench.lean b/Ix/Compiler/IxIR1/ThesisBench.lean new file mode 100644 index 000000000..55e14ff22 --- /dev/null +++ b/Ix/Compiler/IxIR1/ThesisBench.lean @@ -0,0 +1,278 @@ +import Ix.Compiler.IxIR1.Lower + +/-! +# Counter-level thesis evidence + +Paired IxIR₀ programs are lowered and executed twice: once with all runtime +values shared, and once with the strongest modes the current restriction wall +admits. `eraseModes` makes "same program" executable rather than editorial: +each pair has identical syntax after removing `Uses` annotations. + +The observations include the result digest and exact IxIR₁ instruction +counters both before and after releasing the result. These are deterministic +interpreter counts, not wall-clock claims. The present compiler still cannot +destructure unique data and emits no `reuse`; accordingly this first suite +measures construction and reclamation only and pins `reuses = 0` on both sides. +-/ + +namespace Ix.Compiler.IxIR1.ThesisBench + +open Ix.Compiler.Ixon (Address Owned Uses) +open Ix.Compiler.IxIR0 +open Ix.Compiler.IxIR0.Examples +open Ix.Compiler.IxIR1.Lower + +/-! ## Mode-insensitive program shape -/ + +/-- Forget the lowering-only mode annotations from an IxIR₀ expression. -/ +def eraseModes : Expr → Expr + | .var index => .var index + | .ref address => .ref address + | .app function argument => + .app (eraseModes function) (eraseModes argument) + | .lam _ body => .lam .many (eraseModes body) + | .letE _ value body => + .letE .many (eraseModes value) (eraseModes body) + | .proj index value => .proj index (eraseModes value) + | .lit literal => .lit literal + | .erased => .erased + +/-! ## Executable observations -/ + +structure CounterSnapshot where + allocs : Nat + reuses : Nat + frees : Nat + rcops : Nat + live : Nat + deriving BEq, Repr + +def CounterSnapshot.ofStore (store : Store) : CounterSnapshot := + { allocs := store.allocs + reuses := store.reuses + frees := store.frees + rcops := store.rcops + live := store.live } + +inductive ResultDigest where + | nat (value : Nat) + | natPair (first second : Nat) + deriving BEq, Repr + +def digestTree? (tree : Tree) : Option ResultDigest := + match natT? tree with + | some value => some (.nat value) + | none => + match tree with + | .ctorT address 0 [first, second] => do + if address != pairMk then none + let first ← natT? first + let second ← natT? second + pure (.natPair first second) + | _ => none + +structure Observation where + result : ResultDigest + beforeRelease : CounterSnapshot + afterRelease : CounterSnapshot + deriving BEq, Repr + +/-- Compile, execute, decode, and release one closed benchmark. -/ +def observe (decls : List (Address × IxIR0.Decl)) (expression : Expr) + (world : Owned) : Option Observation := do + let (targetDecls, code) ← + (lowerAll decls expression world).toOption + let ctx : Ctx := + { decls := Env.ofList targetDecls, oracle := tgtOracle } + let (store, value) ← (runMain ctx code).toOption + let tree ← treeOfR store 1000 value + let result ← digestTree? tree + let released ← (releaseResult ctx 100000 store value).toOption + pure + { result + beforeRelease := .ofStore store + afterRelease := .ofStore released } + +structure BenchmarkReport where + name : String + sameProgram : Bool + allShared : Option Observation + modeDirected : Option Observation + deriving BEq, Repr + +/-! ## Three paired programs -/ + +/-- Build the same pair of unary naturals entirely in the shared world. -/ +def sharedPair : Expr := + .letE .many (natE 2) (.letE .many (natE 3) + (.app (.app (.ref pairMk) (.var 1)) (.var 0))) + +/-- The identical pair construction with linear bindings and a unique result. -/ +def modePair : Expr := + .letE .linear (natE 2) (.letE .linear (natE 3) + (.app (.app (.ref pairMk) (.var 1)) (.var 0))) + +/-- Construct `2̂`, discard it, and return `1̂` in the shared world. -/ +def sharedDead : Expr := .letE .many (natE 2) (natE 1) + +/-- The identical dead-value program with affine reclamation. -/ +def modeDead : Expr := .letE .affine (natE 2) (natE 1) + +private def keepSecondAddress : Address := synthAddr 700 + +private def sharedKeepSecondBody : Expr := + .lam .many (.lam .many (.var 0)) + +private def modeKeepSecondBody : Expr := + .lam .affine (.lam .many (.var 0)) + +private def sharedKeepSecondDecls : List (Address × IxIR0.Decl) := + declList ++ [(keepSecondAddress, .defn .shared sharedKeepSecondBody)] + +private def modeKeepSecondDecls : List (Address × IxIR0.Decl) := + declList ++ [(keepSecondAddress, .defn .shared modeKeepSecondBody)] + +/-- Apply `fun _ y => y` to unary `1̂` and `2̂`. Only the first +parameter's mode changes between declaration sets; the result stays shared. -/ +def keepSecondMain : Expr := + .app (.app (.ref keepSecondAddress) (natE 1)) (natE 2) + +def reports : List BenchmarkReport := + [ { name := "pair-tree" + sameProgram := eraseModes sharedPair == eraseModes modePair + allShared := observe declList sharedPair .shared + modeDirected := observe declList modePair .unique } + , { name := "dead-tree" + sameProgram := eraseModes sharedDead == eraseModes modeDead + allShared := observe declList sharedDead .shared + modeDirected := observe declList modeDead .unique } + , { name := "dead-parameter" + sameProgram := + eraseModes sharedKeepSecondBody == eraseModes modeKeepSecondBody + allShared := observe sharedKeepSecondDecls keepSecondMain .shared + modeDirected := observe modeKeepSecondDecls keepSecondMain .shared } ] + +private def snapshot (allocs reuses frees rcops live : Nat) : + CounterSnapshot := + { allocs, reuses, frees, rcops, live } + +private def observation (result : ResultDigest) + (beforeRelease afterRelease : CounterSnapshot) : Observation := + { result, beforeRelease, afterRelease } + +def expectedReports : List BenchmarkReport := + [ { name := "pair-tree", sameProgram := true + allShared := some <| observation (.natPair 2 3) + (snapshot 8 0 0 0 8) (snapshot 8 0 8 8 0) + modeDirected := some <| observation (.natPair 2 3) + (snapshot 8 0 0 0 8) (snapshot 8 0 8 0 0) } + , { name := "dead-tree", sameProgram := true + allShared := some <| observation (.nat 1) + (snapshot 5 0 3 3 2) (snapshot 5 0 5 5 0) + modeDirected := some <| observation (.nat 1) + (snapshot 5 0 3 0 2) (snapshot 5 0 5 0 0) } + , { name := "dead-parameter", sameProgram := true + allShared := some <| observation (.nat 2) + (snapshot 5 0 2 2 3) (snapshot 5 0 5 5 0) + modeDirected := some <| observation (.nat 2) + (snapshot 5 0 2 0 3) (snapshot 5 0 5 3 0) } ] + +#guard reports == expectedReports + +structure CounterTotals where + allocs : Nat := 0 + reuses : Nat := 0 + frees : Nat := 0 + rcops : Nat := 0 + deriving BEq, Repr + +def CounterTotals.addSnapshot (total : CounterTotals) + (snapshot : CounterSnapshot) : CounterTotals := + { allocs := total.allocs + snapshot.allocs + reuses := total.reuses + snapshot.reuses + frees := total.frees + snapshot.frees + rcops := total.rcops + snapshot.rcops } + +def releasedTotals (select : BenchmarkReport → Option Observation) : + List BenchmarkReport → CounterTotals + | [] => {} + | report :: rest => + let tail := releasedTotals select rest + match select report with + | some observed => tail.addSnapshot observed.afterRelease + | none => tail + +def allSharedTotals : CounterTotals := + releasedTotals (fun report => report.allShared) reports + +def modeDirectedTotals : CounterTotals := + releasedTotals (fun report => report.modeDirected) reports + +def savedRcOps : Nat := allSharedTotals.rcops - modeDirectedTotals.rcops + +#guard allSharedTotals == + ({ allocs := 18, reuses := 0, frees := 18, rcops := 18 } : + CounterTotals) +#guard modeDirectedTotals == + ({ allocs := 18, reuses := 0, frees := 18, rcops := 3 } : + CounterTotals) +#guard savedRcOps == 15 + +/-! ## Mode-adversarial boundaries + +These pairs share one mode-erased expression shape but sit on opposite sides +of a static rule. The exact diagnostics prevent a different rejection from +accidentally satisfying the fixture. -/ + +def sharedDuplicate : Expr := + .letE .many (natE 1) + (.app (.app (.ref pairMk) (.var 0)) (.var 0)) + +def linearDuplicate : Expr := + .letE .linear (natE 1) + (.app (.app (.ref pairMk) (.var 0)) (.var 0)) + +def deadLinear : Expr := .letE .linear (natE 2) (natE 1) + +def compileError? (expression : Expr) (world : Owned) : Option String := + match lowerAll declList expression world with + | .ok _ => none + | .error message => some message + +structure AdversarialReport where + name : String + sameProgram : Bool + accepted : Bool + rejectedError : Option String + deriving BEq, Repr + +def adversarialReports : List AdversarialReport := + [ { name := "duplicate-shared-vs-linear" + sameProgram := eraseModes sharedDuplicate == eraseModes linearDuplicate + accepted := (lowerAll declList sharedDuplicate .shared).isOk + rejectedError := compileError? linearDuplicate .unique } + , { name := "dead-affine-vs-linear" + sameProgram := eraseModes modeDead == eraseModes deadLinear + accepted := (lowerAll declList modeDead .unique).isOk + rejectedError := compileError? deadLinear .unique } ] + +#guard adversarialReports == + [ { name := "duplicate-shared-vs-linear", sameProgram := true + accepted := true + rejectedError := some "unique variable used more than once" } + , { name := "dead-affine-vs-linear", sameProgram := true + accepted := true + rejectedError := some "unused linear binding" } ] + +def mismatchRejections : List (String × Option String) := + [ ("dereliction", compileError? + (.letE .many (natE 1) (.app (.ref natSucc) (.var 0))) .unique) + , ("freeze", compileError? + (.letE .linear (natE 1) (.app (.ref natSucc) (.var 0))) .shared) ] + +#guard mismatchRejections == + [ ("dereliction", some "dereliction: shared value at unique demand") + , ("freeze", some + "freeze not in v0: unique value at non-unique sink (see docs/compiler/lowering-restrictions.md)") ] + +end Ix.Compiler.IxIR1.ThesisBench diff --git a/Ix/Compiler/IxIR1/WellModedGen.lean b/Ix/Compiler/IxIR1/WellModedGen.lean new file mode 100644 index 000000000..be1c0bd11 --- /dev/null +++ b/Ix/Compiler/IxIR1/WellModedGen.lean @@ -0,0 +1,552 @@ +import Ix.Compiler.IxIR1.Lower + +/-! +# Seeded well-moded IxIR₀ program generation + +A deterministic property corpus for the IxIR₀ → IxIR₁ differential boundary. +Positive templates generate closed programs inside the lowerer's current +ownership fragment and must pass source/target tree agreement plus target +leak-freedom. Adversarial templates sit exactly one mode boundary outside +that fragment and must fail lowering with a pinned diagnostic. + +Generation has no ambient randomness. Every case records the corpus seed, +case index, and PRNG state at the start of the case; `replay` reconstructs it +directly. Template-preserving shrink candidates retain the same expected +outcome, so a mismatch can be minimized without turning into an unrelated +open or ill-shaped expression. +-/ + +namespace Ix.Compiler.IxIR1.WellModedGen + +open Ix.Compiler.Ixon (Owned) +open Ix.Compiler.IxIR0 +open Ix.Compiler.IxIR0.Examples +open Ix.Compiler.IxIR1.Lower + +def defaultSeed : UInt64 := 0x243f6a8885a308d3 +def defaultCases : Nat := 280 + +/-! ## Replayable deterministic entropy -/ + +abbrev GenM := StateM UInt64 + +def next : GenM UInt64 := do + let state ← get + let state' := state * 6364136223846793005 + 1442695040888963407 + set state' + return state' + +def choose (bound : Nat) : GenM Nat := do + if bound == 0 then return 0 + return (← next).toNat % bound + +def chooseBool : GenM Bool := do + return (← choose 2) == 1 + +def chooseNat : GenM Nat := choose 7 + +def chooseNatList : GenM (List Nat) := do + let length ← choose 5 + let mut values := [] + for _ in [:length] do + values := (← chooseNat) :: values + return values.reverse + +/-! ## Closed program schemas -/ + +inductive NatForm where + | ctor + | literal + deriving BEq, DecidableEq, Repr, Inhabited + +def NatForm.expr : NatForm → Nat → Expr + | .ctor, n => natE n + | .literal, n => .lit (.nat n) + +def chooseNatForm : GenM NatForm := do + if ← chooseBool then return .ctor else return .literal + +inductive Kind where + | natAdd + | externAdd + | sharedDuplicate + | sharedProjection + | sharedDead + | listLength + | listAppend + | capturedLambda + | dynamicPap + | partialAdd + | uniquePair + | linearPair + | linearIdentity + | affineDead + | mixedDropFst + | mixedDropSnd + | erasedApp + | erasedProjection + | freezeNeeded + | dereliction + | duplicateUnique + | deadLinear + | uniqueProjection + | nonManyLambda + | partialNonMany + | sharedCallAtUnique + | uniqueCapture + | uniqueRecursor + deriving BEq, DecidableEq, Repr, Inhabited + +def allKinds : Array Kind := #[ + .natAdd, + .externAdd, + .sharedDuplicate, + .sharedProjection, + .sharedDead, + .listLength, + .listAppend, + .capturedLambda, + .dynamicPap, + .partialAdd, + .uniquePair, + .linearPair, + .linearIdentity, + .affineDead, + .mixedDropFst, + .mixedDropSnd, + .erasedApp, + .erasedProjection, + .freezeNeeded, + .dereliction, + .duplicateUnique, + .deadLinear, + .uniqueProjection, + .nonManyLambda, + .partialNonMany, + .sharedCallAtUnique, + .uniqueCapture, + .uniqueRecursor] + +inductive Template where + | natAdd (leftForm rightForm : NatForm) (left right : Nat) + | externAdd (left right : Nat) + | sharedDuplicate (value : Nat) + | sharedProjection (field left right : Nat) + | sharedDead (dead kept : Nat) + | listLength (values : List Nat) + | listAppend (left right : List Nat) + | capturedLambda (captured argument : Nat) + | dynamicPap (leftForm rightForm : NatForm) (left right : Nat) + | partialAdd (form : NatForm) (value : Nat) + | uniquePair (left right : Nat) + | linearPair (left right : Nat) + | linearIdentity (value : Nat) + | affineDead (dead kept : Nat) + | mixedDropFst (dead kept : Nat) + | mixedDropSnd (kept dead : Nat) + | erasedApp (argument : Nat) + | erasedProjection (field : Nat) + | freezeNeeded (value : Nat) + | dereliction (value : Nat) + | duplicateUnique (value : Nat) + | deadLinear (dead kept : Nat) + | uniqueProjection (field left right : Nat) + | nonManyLambda (argument result : Nat) + | partialNonMany (argument : Nat) + | sharedCallAtUnique (left right kept : Nat) + | uniqueCapture (value : Nat) + | uniqueRecursor (major : Nat) + deriving BEq, DecidableEq, Repr, Inhabited + +def Template.kind : Template → Kind + | .natAdd .. => .natAdd + | .externAdd .. => .externAdd + | .sharedDuplicate .. => .sharedDuplicate + | .sharedProjection .. => .sharedProjection + | .sharedDead .. => .sharedDead + | .listLength .. => .listLength + | .listAppend .. => .listAppend + | .capturedLambda .. => .capturedLambda + | .dynamicPap .. => .dynamicPap + | .partialAdd .. => .partialAdd + | .uniquePair .. => .uniquePair + | .linearPair .. => .linearPair + | .linearIdentity .. => .linearIdentity + | .affineDead .. => .affineDead + | .mixedDropFst .. => .mixedDropFst + | .mixedDropSnd .. => .mixedDropSnd + | .erasedApp .. => .erasedApp + | .erasedProjection .. => .erasedProjection + | .freezeNeeded .. => .freezeNeeded + | .dereliction .. => .dereliction + | .duplicateUnique .. => .duplicateUnique + | .deadLinear .. => .deadLinear + | .uniqueProjection .. => .uniqueProjection + | .nonManyLambda .. => .nonManyLambda + | .partialNonMany .. => .partialNonMany + | .sharedCallAtUnique .. => .sharedCallAtUnique + | .uniqueCapture .. => .uniqueCapture + | .uniqueRecursor .. => .uniqueRecursor + +private def app2 (fn left right : Expr) : Expr := + .app (.app fn left) right + +def Template.expr : Template → Expr + | .natAdd leftForm rightForm left right => + app2 (.ref natAddDef) (leftForm.expr left) (rightForm.expr right) + | .externAdd left right => + app2 (.ref natAddExt) (.lit (.nat left)) (.lit (.nat right)) + | .sharedDuplicate value => + .letE .many (natE value) + (app2 (.ref pairMk) (.var 0) (.var 0)) + | .sharedProjection field left right => + .proj (field % 2) (app2 (.ref pairMk) (natE left) (natE right)) + | .sharedDead dead kept => + .letE .many (natE dead) (natE kept) + | .listLength values => + .app (.ref lengthDef) (listE natE values) + | .listAppend left right => + app2 (.ref appendDef) (listE natE left) (listE natE right) + | .capturedLambda captured argument => + .app + (.lam .many + (.app + (.lam .many (app2 (.ref natAddDef) (.var 1) (.var 0))) + (natE argument))) + (natE captured) + | .dynamicPap leftForm rightForm left right => + .letE .many (.app (.ref natAddDef) (leftForm.expr left)) + (.app (.var 0) (rightForm.expr right)) + | .partialAdd form value => + .app (.ref natAddDef) (form.expr value) + | .uniquePair left right => + app2 (.ref pairMk) (natE left) (natE right) + | .linearPair left right => + .letE .linear (natE left) + (.letE .linear (natE right) + (app2 (.ref pairMk) (.var 1) (.var 0))) + | .linearIdentity value => + .letE .linear (natE value) (.var 0) + | .affineDead dead kept => + .letE .affine (natE dead) (natE kept) + | .mixedDropFst dead kept => + app2 (.ref dropFstDef) (natE dead) (natE kept) + | .mixedDropSnd kept dead => + app2 (.ref dropSndDef) (natE kept) (natE dead) + | .erasedApp argument => + .app .erased (natE argument) + | .erasedProjection field => + .proj field .erased + | .freezeNeeded value => + .letE .linear (natE value) (.app (.ref natSucc) (.var 0)) + | .dereliction value => + .letE .many (natE value) (.app (.ref natSucc) (.var 0)) + | .duplicateUnique value => + .letE .linear (natE value) + (app2 (.ref pairMk) (.var 0) (.var 0)) + | .deadLinear dead kept => + .letE .linear (natE dead) (natE kept) + | .uniqueProjection field left right => + .letE .linear (app2 (.ref pairMk) (natE left) (natE right)) + (.proj (field % 2) (.var 0)) + | .nonManyLambda argument result => + .app (.lam .affine (.lit (.nat result))) (natE argument) + | .partialNonMany argument => + .app (.ref dropFstDef) (natE argument) + | .sharedCallAtUnique left right kept => + .letE .affine + (app2 (.ref natAddDef) (natE left) (natE right)) + (natE kept) + | .uniqueCapture value => + .letE .linear (natE value) (.lam .many (.var 1)) + | .uniqueRecursor major => + .letE .linear (natE major) + (.app + (.app + (.app (.ref natRec) (natE 0)) + (.lam .many (.lam .many (.app (.ref natSucc) (.var 0))))) + (.var 0)) + +inductive Expectation where + | differential (world : Owned) + | lowerError (world : Owned) (message : String) + deriving BEq, DecidableEq, Repr, Inhabited + +def Template.expectation : Template → Expectation + | .uniquePair .. | .linearPair .. | .linearIdentity .. | .affineDead .. => + .differential .unique + | .freezeNeeded .. => + .lowerError .shared RestrictionKind.freeze.diagnostic + | .dereliction .. => + .lowerError .unique "dereliction: shared value at unique demand" + | .duplicateUnique .. => + .lowerError .unique "unique variable used more than once" + | .deadLinear .. => .lowerError .shared "unused linear binding" + | .uniqueProjection .. => + .lowerError .shared RestrictionKind.uniqueDestructuring.diagnostic + | .nonManyLambda .. | .partialNonMany .. => + .lowerError .shared RestrictionKind.sharedFunctionValues.diagnostic + | .sharedCallAtUnique .. => + .lowerError .shared "call result is shared at unique demand" + | .uniqueCapture .. => + .lowerError .shared RestrictionKind.uniqueCapture.diagnostic + | .uniqueRecursor .. => + .lowerError .shared RestrictionKind.modeMonomorphicRecursors.diagnostic + | _ => .differential .shared + +def genTemplate : Kind → GenM Template + | .natAdd => do + return .natAdd (← chooseNatForm) (← chooseNatForm) + (← chooseNat) (← chooseNat) + | .externAdd => return .externAdd (← chooseNat) (← chooseNat) + | .sharedDuplicate => return .sharedDuplicate (← chooseNat) + | .sharedProjection => + return .sharedProjection (← choose 2) (← chooseNat) (← chooseNat) + | .sharedDead => return .sharedDead (← chooseNat) (← chooseNat) + | .listLength => return .listLength (← chooseNatList) + | .listAppend => return .listAppend (← chooseNatList) (← chooseNatList) + | .capturedLambda => return .capturedLambda (← chooseNat) (← chooseNat) + | .dynamicPap => do + return .dynamicPap (← chooseNatForm) (← chooseNatForm) + (← chooseNat) (← chooseNat) + | .partialAdd => return .partialAdd (← chooseNatForm) (← chooseNat) + | .uniquePair => return .uniquePair (← chooseNat) (← chooseNat) + | .linearPair => return .linearPair (← chooseNat) (← chooseNat) + | .linearIdentity => return .linearIdentity (← chooseNat) + | .affineDead => return .affineDead (← chooseNat) (← chooseNat) + | .mixedDropFst => return .mixedDropFst (← chooseNat) (← chooseNat) + | .mixedDropSnd => return .mixedDropSnd (← chooseNat) (← chooseNat) + | .erasedApp => return .erasedApp (← chooseNat) + | .erasedProjection => return .erasedProjection (← choose 4) + | .freezeNeeded => return .freezeNeeded (← chooseNat) + | .dereliction => return .dereliction (← chooseNat) + | .duplicateUnique => return .duplicateUnique (← chooseNat) + | .deadLinear => return .deadLinear (← chooseNat) (← chooseNat) + | .uniqueProjection => + return .uniqueProjection (← choose 2) (← chooseNat) (← chooseNat) + | .nonManyLambda => return .nonManyLambda (← chooseNat) (← chooseNat) + | .partialNonMany => return .partialNonMany (← chooseNat) + | .sharedCallAtUnique => + return .sharedCallAtUnique (← chooseNat) (← chooseNat) (← chooseNat) + | .uniqueCapture => return .uniqueCapture (← chooseNat) + | .uniqueRecursor => return .uniqueRecursor (← chooseNat) + +/-! ## Template-preserving shrinking -/ + +private def shrinkNat (value : Nat) : List Nat := + if value == 0 then [] + else [0, value / 2].eraseDups + +private def shrinkNatList (values : List Nat) : List (List Nat) := + if values.isEmpty then [] + else + let zeros := values.map fun _ => 0 + ([[], values.take (values.length / 2)] ++ + if zeros == values then [] else [zeros]).eraseDups + +private def shrinkPair (make : Nat → Nat → Template) (left right : Nat) : + List Template := + (shrinkNat left).map (make · right) ++ + (shrinkNat right).map (make left) + +private def shrinkTriple (make : Nat → Nat → Nat → Template) + (first second third : Nat) : List Template := + (shrinkNat first).map (make · second third) ++ + (shrinkNat second).map (make first · third) ++ + (shrinkNat third).map (make first second) + +def Template.shrinks : Template → List Template + | .natAdd leftForm rightForm left right => + (if leftForm == .ctor then [.natAdd .literal rightForm left right] else []) ++ + (if rightForm == .ctor then [.natAdd leftForm .literal left right] else []) ++ + shrinkPair (.natAdd leftForm rightForm) left right + | .externAdd left right => shrinkPair .externAdd left right + | .sharedDuplicate value => (shrinkNat value).map .sharedDuplicate + | .sharedProjection field left right => + shrinkPair (.sharedProjection field) left right + | .sharedDead dead kept => shrinkPair .sharedDead dead kept + | .listLength values => (shrinkNatList values).map .listLength + | .listAppend left right => + (shrinkNatList left).map (.listAppend · right) ++ + (shrinkNatList right).map (.listAppend left) + | .capturedLambda captured argument => + shrinkPair .capturedLambda captured argument + | .dynamicPap leftForm rightForm left right => + (if leftForm == .ctor then [.dynamicPap .literal rightForm left right] + else []) ++ + (if rightForm == .ctor then [.dynamicPap leftForm .literal left right] + else []) ++ + shrinkPair (.dynamicPap leftForm rightForm) left right + | .partialAdd form value => + (if form == .ctor then [.partialAdd .literal value] else []) ++ + (shrinkNat value).map (.partialAdd form) + | .uniquePair left right => shrinkPair .uniquePair left right + | .linearPair left right => shrinkPair .linearPair left right + | .linearIdentity value => (shrinkNat value).map .linearIdentity + | .affineDead dead kept => shrinkPair .affineDead dead kept + | .mixedDropFst dead kept => shrinkPair .mixedDropFst dead kept + | .mixedDropSnd kept dead => shrinkPair .mixedDropSnd kept dead + | .erasedApp argument => (shrinkNat argument).map .erasedApp + | .erasedProjection field => (shrinkNat field).map .erasedProjection + | .freezeNeeded value => (shrinkNat value).map .freezeNeeded + | .dereliction value => (shrinkNat value).map .dereliction + | .duplicateUnique value => (shrinkNat value).map .duplicateUnique + | .deadLinear dead kept => shrinkPair .deadLinear dead kept + | .uniqueProjection field left right => + shrinkTriple .uniqueProjection field left right + | .nonManyLambda argument result => + shrinkPair .nonManyLambda argument result + | .partialNonMany argument => (shrinkNat argument).map .partialNonMany + | .sharedCallAtUnique left right kept => + shrinkTriple .sharedCallAtUnique left right kept + | .uniqueCapture value => (shrinkNat value).map .uniqueCapture + | .uniqueRecursor major => (shrinkNat major).map .uniqueRecursor + +/-! ## Cases, replay, checking, and failure minimization -/ + +structure Replay where + seed : UInt64 + index : Nat + state : UInt64 + deriving BEq, DecidableEq, Repr, Inhabited + +structure Case where + replayToken : Replay + kind : Kind + template : Template + deriving BEq, DecidableEq, Repr, Inhabited + +def generateAt (seed : UInt64) (index : Nat) (state : UInt64) : + Case × UInt64 := + let kind := allKinds[index % allKinds.size]! + let (template, nextState) := (genTemplate kind).run state + (⟨⟨seed, index, state⟩, kind, template⟩, nextState) + +def replay (token : Replay) : Case := + (generateAt token.seed token.index token.state).1 + +def Case.holds (test : Case) : Bool := + match test.template.expectation with + | .differential world => diffExpr test.template.expr world + | .lowerError world message => lowersErr test.template.expr world message + +def Case.withTemplate (test : Case) (template : Template) : Case := + { test with kind := template.kind, template } + +inductive FailureKind where + | replayDrift + | shrinkExpectationDrift + | propertyMismatch + deriving BEq, DecidableEq, Repr, Inhabited + +structure Failure where + kind : FailureKind + original : Case + minimized : Case + deriving BEq, DecidableEq, Repr, Inhabited + +def minimizeFailure : Nat → Case → Case + | 0, test => test + | fuel + 1, test => + match test.template.shrinks.find? fun template => + !(test.withTemplate template).holds with + | none => test + | some template => minimizeFailure fuel (test.withTemplate template) + +def checkCorpus (seed : UInt64 := defaultSeed) + (count : Nat := defaultCases) : Option Failure := Id.run do + let mut state := seed + for index in [:count] do + let (test, nextState) := generateAt seed index state + if replay test.replayToken != test then + return some ⟨.replayDrift, test, test⟩ + if !test.template.shrinks.all fun template => + template.expectation == test.template.expectation then + return some ⟨.shrinkExpectationDrift, test, test⟩ + if !test.holds then + return some ⟨.propertyMismatch, test, minimizeFailure 128 test⟩ + state := nextState + return none + +/-! ## A stable corpus fingerprint -/ + +private def mix (hash value : UInt64) : UInt64 := + hash * 1099511628211 + value + 1469598103934665603 + +private def mixNat (hash : UInt64) (value : Nat) : UInt64 := + mix hash value.toUInt64 + +private def mixForm (hash : UInt64) : NatForm → UInt64 + | .ctor => mix hash 0 + | .literal => mix hash 1 + +private def mixList (hash : UInt64) (values : List Nat) : UInt64 := + values.foldl mixNat (mixNat hash values.length) + +def Template.fingerprint : Template → UInt64 + | .natAdd lf rf left right => + mixNat (mixNat (mixForm (mixForm (mix 0 0) lf) rf) left) right + | .externAdd left right => mixNat (mixNat (mix 0 1) left) right + | .sharedDuplicate value => mixNat (mix 0 2) value + | .sharedProjection field left right => + mixNat (mixNat (mixNat (mix 0 3) field) left) right + | .sharedDead dead kept => mixNat (mixNat (mix 0 4) dead) kept + | .listLength values => mixList (mix 0 5) values + | .listAppend left right => mixList (mixList (mix 0 6) left) right + | .capturedLambda captured argument => + mixNat (mixNat (mix 0 7) captured) argument + | .dynamicPap lf rf left right => + mixNat (mixNat (mixForm (mixForm (mix 0 8) lf) rf) left) right + | .partialAdd form value => mixNat (mixForm (mix 0 9) form) value + | .uniquePair left right => mixNat (mixNat (mix 0 10) left) right + | .linearPair left right => mixNat (mixNat (mix 0 11) left) right + | .linearIdentity value => mixNat (mix 0 12) value + | .affineDead dead kept => mixNat (mixNat (mix 0 13) dead) kept + | .mixedDropFst dead kept => mixNat (mixNat (mix 0 14) dead) kept + | .mixedDropSnd kept dead => mixNat (mixNat (mix 0 15) kept) dead + | .erasedApp argument => mixNat (mix 0 16) argument + | .erasedProjection field => mixNat (mix 0 17) field + | .freezeNeeded value => mixNat (mix 0 18) value + | .dereliction value => mixNat (mix 0 19) value + | .duplicateUnique value => mixNat (mix 0 20) value + | .deadLinear dead kept => mixNat (mixNat (mix 0 21) dead) kept + | .uniqueProjection field left right => + mixNat (mixNat (mixNat (mix 0 22) field) left) right + | .nonManyLambda argument result => + mixNat (mixNat (mix 0 23) argument) result + | .partialNonMany argument => mixNat (mix 0 24) argument + | .sharedCallAtUnique left right kept => + mixNat (mixNat (mixNat (mix 0 25) left) right) kept + | .uniqueCapture value => mixNat (mix 0 26) value + | .uniqueRecursor major => mixNat (mix 0 27) major + +structure Summary where + checked : Nat + differential : Nat + expectedRejections : Nat + allKindsSeen : Bool + finalState : UInt64 + fingerprint : UInt64 + deriving BEq, DecidableEq, Repr, Inhabited + +def summarize (seed : UInt64 := defaultSeed) + (count : Nat := defaultCases) : Summary := Id.run do + let mut state := seed + let mut differential := 0 + let mut expectedRejections := 0 + let mut seen := Array.replicate allKinds.size false + let mut fingerprint : UInt64 := 0xcbf29ce484222325 + for index in [:count] do + let (test, nextState) := generateAt seed index state + match test.template.expectation with + | .differential _ => differential := differential + 1 + | .lowerError .. => expectedRejections := expectedRejections + 1 + seen := seen.set! (index % allKinds.size) true + fingerprint := mix fingerprint test.template.fingerprint + state := nextState + return ⟨count, differential, expectedRejections, + seen.all (fun covered => covered), state, fingerprint⟩ + +#guard allKinds.size == 28 + +end Ix.Compiler.IxIR1.WellModedGen diff --git a/Ix/Compiler/IxIR2/AllocationEvents.lean b/Ix/Compiler/IxIR2/AllocationEvents.lean new file mode 100644 index 000000000..a82537dd1 --- /dev/null +++ b/Ix/Compiler/IxIR2/AllocationEvents.lean @@ -0,0 +1,400 @@ +import Ix.Compiler.IxIR2.HeapAccounting +import Ix.Compiler.IxIR1.EvalIso + +/-! +# Allocation events, independently of physical storage + +An allocation instruction either acquires a fresh slot or fills a reserved +slot. Both count as one event. This auxiliary observation is separate from +the semantic heap and value relations. +-/ + +namespace Ix.Compiler.IxIR2.Eval + +open Ix.Compiler.Ixon (Owned) +open Ix.Compiler.IxIR1 (Node NodeBox RVal) + +def Store.allocationEvents (store : Store) : Nat := + store.heap.allocs + store.heap.reuses + +@[simp] theorem Store.allocationEvents_allocNode (store : Store) + (world : Owned) (node : Node) : + (store.allocNode world node).1.allocationEvents = store.allocationEvents + 1 := by + simp [Store.allocationEvents, IxIR1.Store.allocNode] + omega + +@[simp] theorem Store.allocationEvents_setBox (store : Store) + (location : Nat) (box : NodeBox) : + (store.setBox location box).allocationEvents = store.allocationEvents := rfl + +@[simp] theorem Store.allocationEvents_kill (store : Store) (location : Nat) : + (store.kill location).allocationEvents = store.allocationEvents := rfl + +@[simp] theorem Store.allocationEvents_reserve (store : Store) (location : Nat) : + (store.reserve location).allocationEvents = store.allocationEvents := rfl + +@[simp] theorem Store.allocationEvents_rcTick (store : Store) : + store.rcTick.allocationEvents = store.allocationEvents := rfl + +@[simp] theorem Store.allocationEvents_tickResetAttempt (store : Store) : + store.tickResetAttempt.allocationEvents = store.allocationEvents := rfl + +@[simp] theorem Store.allocationEvents_tickHotReset (store : Store) : + store.tickHotReset.allocationEvents = store.allocationEvents := rfl + +@[simp] theorem Store.allocationEvents_tickColdReset (store : Store) : + store.tickColdReset.allocationEvents = store.allocationEvents := rfl + +theorem Store.releaseReservation_allocationEvents {store output : Store} + {location : Nat} (run : store.releaseReservation location = .ok output) : + output.allocationEvents = store.allocationEvents := by + cases found : store.heap.nodes[location]? with + | none => simp [Store.releaseReservation, found] at run + | some slot => + cases slot with + | some box => simp [Store.releaseReservation, found] at run + | none => + simp only [Store.releaseReservation, found, Except.ok.injEq] at run + subst output + rfl + +theorem Store.reuseReservation_allocationEvents {store output : Store} + {location payloadUnits : Nat} {world : Owned} {node : Node} + (run : store.reuseReservation location world node payloadUnits = .ok output) : + output.allocationEvents = store.allocationEvents + 1 := by + cases found : store.heap.nodes[location]? with + | none => simp [Store.reuseReservation, found] at run + | some slot => + cases slot with + | some box => simp [Store.reuseReservation, found] at run + | none => + simp only [Store.reuseReservation, found, Except.ok.injEq] at run + subst output + change store.heap.allocs + (store.heap.reuses + 1) = + store.heap.allocs + store.heap.reuses + 1 + omega + +theorem retainShared_allocationEvents {store output : Store} {value : RVal} + (run : retainShared store value = .ok output) : + output.allocationEvents = store.allocationEvents := by + cases value with + | lit literal => cases run; rfl + | erased => cases run; rfl + | loc location => + cases found : store.get? location with + | none => simp [retainShared, found] at run + | some box => + by_cases shared : box.world = .shared + · simp [retainShared, found, shared] at run + subst output + rfl + · simp [retainShared, found, shared] at run + +theorem RetainSharedMany.allocationEvents {store output : Store} + {values : Array RVal} (run : RetainSharedMany store values output) : + output.allocationEvents = store.allocationEvents := by + change values.foldlM retainShared store = .ok output at run + rw [← Array.foldlM_toList] at run + have loop : ∀ (values : List RVal) {store output : Store}, + values.foldlM retainShared store = .ok output → + output.allocationEvents = store.allocationEvents := by + intro values + induction values with + | nil => intro store output run; cases run; rfl + | cons value rest ih => + intro store output run + rw [List.foldlM_cons] at run + cases head : retainShared store value with + | error error => simp [head, bind, Except.bind] at run + | ok middle => + simp only [head, bind, Except.bind] at run + exact (ih run).trans (retainShared_allocationEvents head) + exact loop values.toList run + +theorem releaseSharedWork_allocationCounters {fuel remaining : Nat} + {store output : Store} {values : List RVal} + (run : releaseSharedWork fuel store values = .ok (output, remaining)) : + output.heap.allocs = store.heap.allocs ∧ output.heap.reuses = store.heap.reuses := by + induction fuel generalizing store values with + | zero => + cases values with + | nil => cases run; exact ⟨rfl, rfl⟩ + | cons value rest => simp [releaseSharedWork] at run + | succ fuel ih => + cases values with + | nil => cases run; exact ⟨rfl, rfl⟩ + | cons value rest => + cases value with + | lit literal => exact ih run + | erased => exact ih run + | loc location => + cases found : store.get? location with + | none => simp [releaseSharedWork, found] at run + | some box => + by_cases shared : box.world = .shared + · by_cases zero : box.rc = 0 + · simp [releaseSharedWork, found, shared, zero] at run + · by_cases unitRC : box.rc = 1 + · simp only [releaseSharedWork, found, shared, bne_self_eq_false, + Bool.false_eq_true, ↓reduceIte, unitRC, beq_self_eq_true, + Nat.reduceBEq] at run + simpa only [Store.kill_heap, Store.rcTick_heap, + IxIR1.Store.kill, IxIR1.Store.rcTick] using ih run + · simp [releaseSharedWork, found, shared, zero, unitRC] at run + simpa only [Store.setBox_heap, Store.rcTick_heap, + IxIR1.Store.setBox, IxIR1.Store.rcTick] using ih run + · simp [releaseSharedWork, found, shared] at run + +theorem releaseSharedWork_allocationEvents {fuel remaining : Nat} + {store output : Store} {values : List RVal} + (run : releaseSharedWork fuel store values = .ok (output, remaining)) : + output.allocationEvents = store.allocationEvents := by + obtain ⟨allocs, reuses⟩ := releaseSharedWork_allocationCounters run + simp only [Store.allocationEvents, allocs, reuses] + +theorem releaseShared_allocationCounters {fuel remaining : Nat} + {store output : Store} {value : RVal} + (run : releaseShared fuel store value = .ok (output, remaining)) : + output.heap.allocs = store.heap.allocs ∧ output.heap.reuses = store.heap.reuses := + releaseSharedWork_allocationCounters run + +theorem releaseShared_allocationEvents {fuel remaining : Nat} + {store output : Store} {value : RVal} + (run : releaseShared fuel store value = .ok (output, remaining)) : + output.allocationEvents = store.allocationEvents := + releaseSharedWork_allocationEvents run + +theorem dropUniqueWork_allocationEvents {fuel remaining : Nat} + {store output : Store} {values : List RVal} + (run : dropUniqueWork fuel store values = .ok (output, remaining)) : + output.allocationEvents = store.allocationEvents := by + induction fuel generalizing store values with + | zero => + cases values with + | nil => cases run; rfl + | cons value rest => simp [dropUniqueWork] at run + | succ fuel ih => + cases values with + | nil => cases run; rfl + | cons value rest => + cases value with + | lit literal => exact ih run + | erased => exact ih run + | loc location => + cases found : store.get? location with + | none => simp [dropUniqueWork, found] at run + | some box => + by_cases unique : box.world = .unique + · cases node : box.node with + | papN address arity captured => simp [dropUniqueWork, found, unique, node] at run + | ctorN cid fields => + simp only [dropUniqueWork, found, unique, bne_self_eq_false, + Bool.false_eq_true, ↓reduceIte, node] at run + simpa only [Store.allocationEvents_kill] using ih run + · simp [dropUniqueWork, found, unique] at run + +theorem dropUnique_allocationEvents {fuel remaining : Nat} + {store output : Store} {value : RVal} + (run : dropUnique fuel store value = .ok (output, remaining)) : + output.allocationEvents = store.allocationEvents := dropUniqueWork_allocationEvents run + +/-- Equality of event increments, without subtraction or an assumption about +the incoming counters. It composes even when the two heaps have different +allocation and reuse histories. -/ +def AllocationDelta (baselineBefore baselineAfter rewrittenBefore rewrittenAfter : Store) : Prop := + baselineAfter.allocationEvents + rewrittenBefore.allocationEvents = + baselineBefore.allocationEvents + rewrittenAfter.allocationEvents + +namespace AllocationDelta + +theorem of_increments {baselineBefore baselineAfter rewrittenBefore rewrittenAfter : Store} + {count : Nat} + (baseline : baselineAfter.allocationEvents = baselineBefore.allocationEvents + count) + (rewritten : rewrittenAfter.allocationEvents = rewrittenBefore.allocationEvents + count) : + AllocationDelta baselineBefore baselineAfter rewrittenBefore rewrittenAfter := by + unfold AllocationDelta + omega + +theorem refl (baseline rewritten : Store) : AllocationDelta baseline baseline rewritten rewritten := by + unfold AllocationDelta + omega + +theorem trans {b₀ b₁ b₂ r₀ r₁ r₂ : Store} + (first : AllocationDelta b₀ b₁ r₀ r₁) (second : AllocationDelta b₁ b₂ r₁ r₂) : + AllocationDelta b₀ b₂ r₀ r₂ := by + unfold AllocationDelta at * + omega + +theorem preserves {b₀ b₁ r₀ r₁ : Store} (delta : AllocationDelta b₀ b₁ r₀ r₁) + (initial : b₀.allocationEvents = r₀.allocationEvents) : + b₁.allocationEvents = r₁.allocationEvents := by + unfold AllocationDelta at delta + omega + +end AllocationDelta + +/-- A partial application allocates precisely when its supplied arguments +remain below the closure's arity. All other successful dispatches allocate +nothing during this transfer. -/ +def applyAllocationEvents (store : Store) (function : RVal) + (arguments : Array RVal) : Nat := + match function with + | .loc location => + match store.get? location with + | some box => + match box.node with + | .papN _ arity captured => if (captured ++ arguments).size < arity then 1 else 0 + | _ => 0 + | none => 0 + | _ => 0 + +theorem applyAllocationEvents_history {baseline rewritten : Store} + (heap : IxIR1.Sim.HeapHistoryIso baseline.heap rewritten.heap) + {baselineFunction rewrittenFunction : RVal} + {baselineArguments rewrittenArguments : Array RVal} + (function : IxIR1.Sim.RValIso heap.locRel baselineFunction rewrittenFunction) + (argumentCount : baselineArguments.size = rewrittenArguments.size) : + applyAllocationEvents baseline baselineFunction baselineArguments = + applyAllocationEvents rewritten rewrittenFunction rewrittenArguments := by + cases function with + | lit => rfl + | erased => rfl + | loc locations => + rcases heap.related locations with ⟨leftDead, rightDead⟩ | + ⟨leftBox, rightBox, leftAt, rightAt, boxes⟩ + · simp [applyAllocationEvents, Store.get?, leftDead, rightDead] + · simp only [applyAllocationEvents, Store.get?, leftAt, rightAt] + have nodes := boxes.node + generalize leftBox.node = leftNode at nodes ⊢ + generalize rightBox.node = rightNode at nodes ⊢ + cases nodes with + | ctor fields => rfl + | pap captured => + have capturedCount := captured.lengths + simpa only [Array.length_toList, Array.size_append, + argumentCount] using congrArg + (fun size => if size + rewrittenArguments.size < _ then 1 else 0) capturedCount + +theorem ApplyTransferCase.allocationEvents {context : Context} + {interpretation : Interpretation} {store : Store} {heapFuel : Nat} + {arguments : Array RVal} {resume : Frame} {stack : List Continuation} + {function : RVal} {target : Machine} + (classified : ApplyTransferCase context interpretation store heapFuel + arguments resume stack function target) : + target.store.allocationEvents = store.allocationEvents + + applyAllocationEvents store function arguments := by + cases classified with + | erased released => + simpa [applyAllocationEvents] using releaseSharedWork_allocationEvents released + | papUnder boxAt shared node capturedUnder retained released totalUnder => + simp only [applyAllocationEvents, boxAt, node, totalUnder, ↓reduceIte, + Store.allocationEvents_allocNode] + rw [releaseSharedWork_allocationEvents released, retained.allocationEvents] + | papFn boxAt shared node capturedUnder retained released totalEnough + declaration papSafe suppliedArity nonempty => + simp only [applyAllocationEvents, boxAt, node, Nat.not_lt.mpr totalEnough, + ↓reduceIte, Nat.add_zero] + exact (releaseSharedWork_allocationEvents released).trans retained.allocationEvents + | papExtern boxAt shared node capturedUnder retained released totalEnough + declaration suppliedArity remainingEmpty called => + simp only [applyAllocationEvents, boxAt, node, Nat.not_lt.mpr totalEnough, + ↓reduceIte, Nat.add_zero] + exact (releaseSharedWork_allocationEvents released).trans retained.allocationEvents + +theorem ApplyTransfer.allocationEvents {context : Context} + {interpretation : Interpretation} {store : Store} {heapFuel : Nat} + {arguments : Array RVal} {resume : Frame} {stack : List Continuation} + {function : RVal} {target : Machine} + (transferred : ApplyTransfer context interpretation store heapFuel function + arguments resume stack target) : + target.store.allocationEvents = store.allocationEvents + + applyAllocationEvents store function arguments := transferred.classify.allocationEvents + +def instructionAllocationEvents (store : Store) (frame : Frame) : Instr → Nat + | .alloc .. | .allocWith .. | .papp .. => 1 + | .apply functionAtom argumentAtoms => + match resolveAtom frame.values functionAtom, resolveAtoms frame.values argumentAtoms with + | .ok function, .ok arguments => applyAllocationEvents store function arguments + | _, _ => 0 + | _ => 0 + +theorem InstructionTransferCase.allocationEvents {context : Context} + {interpretation : Interpretation} {store : Store} {heapFuel : Nat} + {frame : Frame} {stack : List Continuation} {instruction : Instr} {target : Machine} + (classified : InstructionTransferCase context interpretation store heapFuel + frame stack instruction target) : + target.store.allocationEvents = store.allocationEvents + + instructionAllocationEvents store frame instruction := by + cases classified <;> simp only [instructionAllocationEvents, Nat.add_zero, + Store.allocationEvents_allocNode, Store.allocationEvents_kill, + Store.allocationEvents_reserve, Store.allocationEvents_tickHotReset, + Store.allocationEvents_tickResetAttempt] + case allocWithPhysical reused => exact Store.reuseReservation_allocationEvents reused + case discardPhysical released => exact Store.releaseReservation_allocationEvents released + case resetSharedCold retained => simpa using retained.allocationEvents + case retainShared retained => exact retainShared_allocationEvents retained + case releaseShared released => exact releaseShared_allocationEvents released + case dropUnique dropped => exact dropUnique_allocationEvents dropped + case apply functionResolved argumentsResolved transferred => + simpa only [functionResolved, argumentsResolved] using transferred.allocationEvents + +def terminatorAllocationEvents (store : Store) (frame : Frame) + (stack : List Continuation) : Terminator → Nat + | .ret atom => + match stack, resolveAtom frame.values atom with + | .applyMore arguments _ :: _, .ok value => applyAllocationEvents store value arguments + | _, _ => 0 + | _ => 0 + +theorem TerminatorTransferCase.allocationEvents {context : Context} + {interpretation : Interpretation} {store : Store} {heapFuel : Nat} + {frame : Frame} {stack : List Continuation} {terminator : Terminator} {target : Machine} + (classified : TerminatorTransferCase context interpretation store heapFuel + frame stack terminator target) : + target.store.allocationEvents = store.allocationEvents + + terminatorAllocationEvents store frame stack terminator := by + cases classified <;> simp only [terminatorAllocationEvents, Nat.add_zero] + case retApplyMore resolved noCredits world transferred => + simpa only [resolved] using transferred.allocationEvents + +theorem Step.instructionAllocationEvents {context : Context} + {interpretation : Interpretation} {store : Store} {heapFuel : Nat} + {frame : Frame} {stack : List Continuation} {target : Machine} + (step : Step context interpretation ⟨store, heapFuel, .running frame stack⟩ target) + {block : Block} {instruction : Instr} + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instructionAt : block.instructions[frame.pc] = instruction) : + target.store.allocationEvents = store.allocationEvents + + instructionAllocationEvents store frame instruction := by + cases step.classify with + | instruction found bound atIndex classified => + have same := Option.some.inj (found.symm.trans blockAt) + subst_vars + exact classified.allocationEvents + | terminator found terminal atTerminator classified => + have same := Option.some.inj (found.symm.trans blockAt) + subst_vars + omega + +theorem Step.terminatorAllocationEvents {context : Context} + {interpretation : Interpretation} {store : Store} {heapFuel : Nat} + {frame : Frame} {stack : List Continuation} {target : Machine} + (step : Step context interpretation ⟨store, heapFuel, .running frame stack⟩ target) + {block : Block} {terminator : Terminator} + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminatorAt : block.terminator = terminator) : + target.store.allocationEvents = store.allocationEvents + + terminatorAllocationEvents store frame stack terminator := by + cases step.classify with + | instruction found bound atIndex classified => + have same := Option.some.inj (found.symm.trans blockAt) + subst_vars + omega + | terminator found terminal atTerminator classified => + have same := Option.some.inj (found.symm.trans blockAt) + subst_vars + exact classified.allocationEvents + +end Ix.Compiler.IxIR2.Eval diff --git a/Ix/Compiler/IxIR2/Basic.lean b/Ix/Compiler/IxIR2/Basic.lean new file mode 100644 index 000000000..8b1e2d3b7 --- /dev/null +++ b/Ix/Compiler/IxIR2/Basic.lean @@ -0,0 +1,156 @@ +import Ix.Compiler.IxIR1.Basic + +/-! +# IxIR₂: block-local ownership and reuse-credit IR + +IxIR₂ makes the ownership information needed for checked reuse explicit. +Values and reuse credits live in separate block-local register files. Block +parameters describe the complete capability environment at each control-flow +join, so the executable validator can check every block independently. + +This file is deliberately syntax-only. `Ix.Compiler.IxIR2.Validate` supplies +the bounded checker and its proof-facing acceptance predicate. +-/ + +namespace Ix.Compiler.IxIR2 + +open Ix.Compiler.Ixon (Address Owned) +open Ix.Compiler.IxIR0 (Literal) + +abbrev BlockId := Nat +abbrev ValueId := Nat +abbrev CreditId := Nat +abbrev LayoutId := Address +abbrev CtorId := IxIR1.CtorId + +/-- Block-local operands. Registers are numbered in definition order. -/ +inductive Atom where + | reg (id : ValueId) + | lit (literal : Literal) + | erased + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- Whether a function call transfers an argument root or merely observes it. -/ +inductive ParamPassing where + | owned + | borrowed + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +structure Param where + world : Owned + passing : ParamPassing + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- The checked call interface of one function. -/ +structure Signature where + params : Array Param + result : Owned + /-- May this function be entered through a shared partial application? -/ + papSafe : Bool + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- The ownership root that keeps a non-retaining view alive. -/ +inductive BorrowLender where + /-- A caller-owned root that this activation never consumes. -/ + | caller + /-- A prior owning value in the same block. -/ + | value (id : ValueId) + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- Capability available for one value at a block boundary or program point. -/ +inductive ValueCap where + | scalar + | owned (world : Owned) + | borrowed (world : Owned) (lender : BorrowLender) + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- A required credit is definitely present; an optional credit may be absent. -/ +inductive CreditCap where + | required (layout : LayoutId) + | optional (layout : LayoutId) + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- Checked representation information for one constructor in one world. -/ +structure CtorSchema where + layout : LayoutId + fields : Array Owned + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- Primitive instructions. Result values and credits are appended to their +respective register files in the order specified by the validator contract. -/ +inductive Instr where + | move (value : Atom) + | alloc (world : Owned) (cid : CtorId) (args : Array Atom) + | allocWith (credit : CreditId) (world : Owned) (cid : CtorId) + (args : Array Atom) + | discardCredit (credit : CreditId) + | takeUnique (target : Atom) (cid : CtorId) + | resetShared (target : Atom) (cid : CtorId) + | retainShared (target : Atom) + | releaseShared (target : Atom) + | dropUnique (target : Atom) + | freeUnique (target : Atom) (cid : CtorId) + | fetch (target : Atom) (cid : CtorId) (field : Nat) + | call (function : Address) (args : Array Atom) + | callSelf (args : Array Atom) + | papp (function : Address) (args : Array Atom) + | apply (function : Atom) (args : Array Atom) + | extern (function : Address) (args : Array Atom) + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- Complete arguments for one control-flow transfer. -/ +structure Edge where + target : BlockId + values : Array Atom + credits : Array CreditId + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +structure CtorAlt where + cid : CtorId + edge : Edge + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- Literal peeling bundled with constructor dispatch for a dynamically +represented IxIR₁ case scrutinee. The successor transfer implicitly prepends +the predecessor literal to the explicit edge arguments. -/ +structure NatPeel where + zero : Edge + succ : Edge + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +inductive Terminator where + | jump (edge : Edge) + | switchValue (scrutinee : Atom) (constructors : Array CtorAlt) + (natPeel : Option NatPeel) + | branchCredit (credit : CreditId) (someEdge noneEdge : Edge) + | ret (value : Atom) + | tailCall (function : Address) (args : Array Atom) + | tailCallSelf (args : Array Atom) + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +structure Block where + valueParams : Array ValueCap + creditParams : Array CreditCap + instructions : Array Instr + terminator : Terminator + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- Block `0` is the entry block. Block IDs are array indices. -/ +structure Function where + signature : Signature + blocks : Array Block + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +inductive Decl where + | fn (definition : Function) + | extern (arity : Nat) + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- A finite, content-addressed declaration world plus its distinguished main +function. The validator rejects duplicate declaration addresses. -/ +structure Program where + declarations : List (Address × Decl) + main : Function + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +end Ix.Compiler.IxIR2 diff --git a/Ix/Compiler/IxIR2/Borrow/Examples.lean b/Ix/Compiler/IxIR2/Borrow/Examples.lean new file mode 100644 index 000000000..788f80180 --- /dev/null +++ b/Ix/Compiler/IxIR2/Borrow/Examples.lean @@ -0,0 +1,149 @@ +import Ix.Compiler.IxIR2.Borrow.Replay + +/-! Negative ownership and peak-space neighbors for the borrowed ABI. +These hand-built programs test the optimizer boundary; the source gate +separately derives its positive witnesses through the Ixon compiler. -/ + +namespace Ix.Compiler.IxIR2.Borrow.Examples + +open Ix.Compiler.Ixon (Address) + +def readerAddress : Address := .replicate 1 +def workerAddress : Address := .replicate 2 +def captureAddress : Address := .replicate 3 +def readerBorrowed : Address := .replicate 11 +def workerBorrowed : Address := .replicate 12 +def leaf : CtorId := { block := .replicate 20, indIdx := 0, cidx := 0 } +def box : CtorId := { block := .replicate 20, indIdx := 0, cidx := 1 } +def layout : Address := .replicate 21 + +def context : Validate.Context := + { schemas := fun world cid => + if world == .shared && (cid == leaf || cid == box) then + some { layout, fields := if cid == leaf then #[] else #[.shared] } + else none } + +def unary : Signature := + { params := #[{ world := .shared, passing := .owned }], result := .shared, papSafe := true } + +def fn (instructions : Array Instr) (terminator : Terminator) : Function := + { signature := unary + blocks := #[{ valueParams := #[.owned .shared], creditParams := #[] + instructions, terminator }] } + +def reader : Function := fn #[.releaseShared (.reg 0)] (.ret (.lit (.nat 0))) + +def main (instructions : Array Instr := #[]) (terminator : Terminator := .ret (.lit (.nat 0))) : + Function := + { signature := { params := #[], result := .shared, papSafe := false } + blocks := #[{ valueParams := #[], creditParams := #[], instructions, terminator }] } + +def program (worker : Function) : Program := + { declarations := [(readerAddress, .fn reader), (workerAddress, .fn worker)] + main := main } + +def claims : List Summary := + [{ owner := readerAddress, borrowed := readerBorrowed }, + { owner := workerAddress, borrowed := workerBorrowed }] + +def accepted (program : Program) : Bool := (Validate.validate context program).isOk +def rejected (program : Program) : Bool := !(check {} context program claims).isOk + +def returnEscape : Program := program (fn #[] (.ret (.reg 0))) +def storeEscape : Program := program (fn #[.alloc .shared box #[.reg 0]] (.ret (.reg 1))) + +def capture : Function := + { signature := { unary with params := unary.params ++ unary.params } + blocks := #[{ + valueParams := #[.owned .shared, .owned .shared], creditParams := #[] + instructions := #[.releaseShared (.reg 0), .releaseShared (.reg 1)] + terminator := .ret (.lit (.nat 0)) }] } + +def captureEscape : Program := + { program (fn #[.papp captureAddress #[.reg 0]] (.ret (.reg 1))) with + declarations := (program (fn #[.papp captureAddress #[.reg 0]] (.ret (.reg 1)))).declarations ++ + [(captureAddress, .fn capture)] } + +def localTailLender : Program := program (fn + #[.releaseShared (.reg 0), .alloc .shared leaf #[]] + (.tailCall readerAddress #[.reg 1])) + +def laterReset : Program := program (fn + #[.retainShared (.reg 0), .call readerAddress #[.reg 1], .releaseShared (.reg 2), + .resetShared (.reg 0) leaf, .discardCredit 0] + (.ret (.lit (.nat 0)))) + +/-- Delaying an early release can increase peak space even if the ownership +validator accepts and two real RC operations disappear. Replay rejects it. -/ +def peakRegression : Program := + { program (fn + #[.retainShared (.reg 0), .call readerAddress #[.reg 1], .releaseShared (.reg 2), + .releaseShared (.reg 0), .alloc .shared leaf #[], .releaseShared (.reg 3)] + (.ret (.lit (.nat 0)))) with + main := main #[.alloc .shared leaf #[]] (.tailCall workerAddress #[.reg 0]) } + +def peakRejected : Bool := + match check {} context peakRegression claims with + | .error _ => false + | .ok rewritten => + match replay context {} rewritten with + | .error .peakIncrease => true + | _ => false + +def noGainRejected : Bool := + match check {} context peakRegression [] with + | .error _ => false + | .ok rewritten => + match replay context {} rewritten with + | .error .noImprovement => true + | _ => false + +def budgetRejected : Bool := + match check {} context peakRegression claims with + | .error _ => false + | .ok rewritten => + match replay context { control := 0 } rewritten with + | .error (.execution .controlFuel) => true + | _ => false + +def collisionRejected : Bool := + match check {} context (program reader) + [{ owner := readerAddress, borrowed := workerAddress }] with + | .error (.validation (.duplicateDeclaration _)) => true + | _ => false + +/-- Retaining a projected field creates an independent owned result. That +retain must survive even when the containing parameter is borrowed. -/ +def fieldRetainPreserved : Bool := + let source := program (fn + #[.fetch (.reg 0) box 0, .retainShared (.reg 1), .releaseShared (.reg 0)] + (.ret (.reg 2))) + accepted source && match check {} context source claims with + | .error _ => false + | .ok result => + match result.program.declarations.find? (fun entry => entry.1 == workerBorrowed) with + | some (_, .fn definition) => + definition.blocks[0]?.map (·.instructions) == + some #[.fetch (.reg 0) box 0, .retainShared (.reg 1)] + | _ => false + +#guard fieldRetainPreserved + +def guards : List (String × Bool) := + [("return-escape", accepted returnEscape && rejected returnEscape), + ("store-escape", accepted storeEscape && rejected storeEscape), + ("capture-escape", accepted captureEscape && rejected captureEscape), + ("local-tail-lender", accepted localTailLender && rejected localTailLender), + ("later-reset", accepted laterReset && rejected laterReset), + ("peak-regression", accepted peakRegression && peakRejected), + ("no-rc-gain", noGainRejected), + ("replay-budget", budgetRejected), + ("internal-label-collision", collisionRejected), + ("duplicate-summary", !(check {} context (program reader) (claims ++ claims)).isOk), + ("missing-summary-owner", !(check {} context (program reader) + [{ owner := .replicate 99, borrowed := readerBorrowed }]).isOk), + ("candidate-limit", !(check { maxCandidates := 0 } context (program reader) claims).isOk)] + +#guard guards.all (·.2) + +end Ix.Compiler.IxIR2.Borrow.Examples diff --git a/Ix/Compiler/IxIR2/Borrow/OpenCheck.lean b/Ix/Compiler/IxIR2/Borrow/OpenCheck.lean new file mode 100644 index 000000000..8b6bc238d --- /dev/null +++ b/Ix/Compiler/IxIR2/Borrow/OpenCheck.lean @@ -0,0 +1,175 @@ +import Ix.Compiler.IxIR2.Borrow.OpenSim + +/-! An open-input selector. All proposed summaries and all rewritten bodies +must have a finite structural derivation. Selection never evaluates an input. +The original main/factory continues to export the owned PAP entry. -/ + +namespace Ix.Compiler.IxIR2.Borrow.Open + +open Ix.Compiler.Ixon (Address) + +structure Policy where + enabled : Bool := true + maxDepth : Nat := 32 + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr + +def moduleMain (factoryAddress : Address) : Function := + { signature := { params := #[], result := .shared, papSafe := false } + blocks := #[{ + valueParams := #[], creditParams := #[], instructions := #[] + terminator := .tailCall factoryAddress #[] }] } + +def readerSchema? (definition : Function) : Option Schema := do + let entry ← definition.blocks[0]? + let .switchValue _ alternatives _ := entry.terminator | none + let zero ← alternatives[0]? + let succ ← alternatives[1]? + let zeroBlock ← definition.blocks[1]? + let succBlock ← definition.blocks[2]? + let .ret (.lit (.nat zeroResult)) := zeroBlock.terminator | none + let .ret (.lit (.nat succResult)) := succBlock.terminator | none + let schema : Schema := { zero := zero.cid, succ := succ.cid, zeroResult, succResult } + if definition == reader schema false then some schema else none + +def inferSchema (program : Program) : Option Schema := + program.declarations.findSome? fun + | (_, .fn definition) => readerSchema? definition + | _ => none + +def context (validation : Validate.Context) (program : Program) : Eval.Context := + .ofProgram program validation.schemas + +structure Export (validation : Validate.Context) (program : Program) where + factoryAddress : Address + entryAddress : Address + main : program.main = moduleMain factoryAddress + factoryAt : (context validation program).declarations factoryAddress = some (.fn (factory entryAddress)) + +def checkExport (validation : Validate.Context) (program : Program) : Option (Export validation program) := do + let block ← program.main.blocks[0]? + let .tailCall factoryAddress _ := block.terminator | none + let some (.fn declaration) := (context validation program).declarations factoryAddress | none + let first ← declaration.blocks[0]? + let instruction ← first.instructions[0]? + let .papp entryAddress _ := instruction | none + if hm : program.main = moduleMain factoryAddress then + if hf : (context validation program).declarations factoryAddress = some (.fn (factory entryAddress)) then + some ⟨factoryAddress, entryAddress, hm, hf⟩ + else none + else none + +structure Entry (beforeContext afterContext : Eval.Context) (schema : Schema) where + summary : Summary + before : Function + after : Function + beforeAt : beforeContext.declarations summary.owner = some (.fn before) + afterAt : afterContext.declarations summary.borrowed = some (.fn after) + wrapperAt : afterContext.declarations summary.owner = some (.fn (ownedWrapper summary.borrowed before)) + beforeBody : Body beforeContext schema false before + afterBody : Body afterContext schema true after + sameKind : beforeBody.isTwice = afterBody.isTwice + sameDepth : beforeBody.depth = afterBody.depth + +def checkEntry (beforeContext afterContext : Eval.Context) (schema : Schema) + (maxDepth : Nat) (summary : Summary) : Option (Entry beforeContext afterContext schema) := do + let some (.fn before) := beforeContext.declarations summary.owner | none + let some (.fn after) := afterContext.declarations summary.borrowed | none + let beforeBody ← recognizeBody beforeContext schema false maxDepth before + let afterBody ← recognizeBody afterContext schema true maxDepth after + if beforeAt : beforeContext.declarations summary.owner = some (.fn before) then + if afterAt : afterContext.declarations summary.borrowed = some (.fn after) then + if wrapperAt : afterContext.declarations summary.owner = some (.fn (ownedWrapper summary.borrowed before)) then + if sameKind : beforeBody.isTwice = afterBody.isTwice then + if sameDepth : beforeBody.depth = afterBody.depth then + some ⟨summary, before, after, beforeAt, afterAt, wrapperAt, beforeBody, afterBody, sameKind, sameDepth⟩ + else none + else none + else none + else none + else none + +inductive Rejection where + | disabled + | noCandidates + | schema + | rewrite (error : Borrow.Error) + | export + | body + | coverage + | noImprovement + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr + +structure Certificate (limits : Limits) (validation : Validate.Context) (baseline : Program) where + rewrite : Checked limits validation baseline + schema : Schema + distinct : schema.zero ≠ schema.succ + entries : List (Entry (context validation baseline) (context validation rewrite.program) schema) + coverage : entries.map (·.summary) = rewrite.summaries + exported : Export validation baseline + targetExported : Export validation rewrite.program + sameFactory : exported.factoryAddress = targetExported.factoryAddress + sameExport : exported.entryAddress = targetExported.entryAddress + entry : Entry (context validation baseline) (context validation rewrite.program) schema + entryMember : entry.summary ∈ rewrite.summaries + entryAddress : entry.summary.owner = exported.entryAddress + improvement : entry.beforeBody.isTwice = true + +def certify (limits : Limits) (validation : Validate.Context) (baseline : Program) + (summaries : List Summary) (policy : Policy := {}) : + Except Rejection (Certificate limits validation baseline) := do + let rewrite ← (Borrow.check limits validation baseline summaries).mapError Rejection.rewrite + let some schema := inferSchema baseline | throw .schema + if distinct : schema.zero ≠ schema.succ then + let some exported := checkExport validation baseline | throw .export + let some targetExported := checkExport validation rewrite.program | throw .export + let some entries := summaries.mapM (checkEntry (context validation baseline) + (context validation rewrite.program) schema policy.maxDepth) | throw .body + if coverage : entries.map (·.summary) = rewrite.summaries then + if sameFactory : exported.factoryAddress = targetExported.factoryAddress then + if sameExport : exported.entryAddress = targetExported.entryAddress then + let some entry := entries.find? (fun entry => entry.summary.owner == exported.entryAddress) | throw .export + if entryAddress : entry.summary.owner = exported.entryAddress then + if entryMember : entry.summary ∈ rewrite.summaries then + if improvement : entry.beforeBody.isTwice = true then + return ⟨rewrite, schema, distinct, entries, coverage, exported, targetExported, + sameFactory, sameExport, entry, entryMember, entryAddress, improvement⟩ + else throw .noImprovement + else throw .coverage + else throw .export + else throw .export + else throw .export + else throw .coverage + else throw .schema + +structure Selection (limits : Limits) (validation : Validate.Context) (baseline : Program) where + baselineChecked : Validate.Checked limits.validator validation baseline + inference : Inference + attempt : Except Rejection (Certificate limits validation baseline) + +def optimize {limits : Limits} {validation : Validate.Context} {baseline : Program} + (checked : Validate.Checked limits.validator validation baseline) (policy : Policy := {}) : + Selection limits validation baseline := + if !policy.enabled then ⟨checked, {}, .error .disabled⟩ else + let inference := infer limits validation baseline + let attempt := if inference.summaries.isEmpty then .error .noCandidates + else certify limits validation baseline inference.summaries policy + ⟨checked, inference, attempt⟩ + +def Selection.program {limits validation baseline} (selection : Selection limits validation baseline) : Program := + match selection.attempt with + | .ok certificate => certificate.rewrite.program + | .error _ => baseline + +theorem Selection.valid {limits validation baseline} (selection : Selection limits validation baseline) : + Validate.ValidWith limits.validator validation selection.program := by + cases h : selection.attempt with + | error _ => simpa [Selection.program, h] using + (show Validate.ValidWith limits.validator validation baseline from + ⟨selection.baselineChecked.stats, selection.baselineChecked.accepted⟩) + | ok certificate => simpa [Selection.program, h] using certificate.rewrite.valid + +theorem Selection.fallbackExact {limits validation baseline} (selection : Selection limits validation baseline) + {reason : Rejection} (fallback : selection.attempt = .error reason) : selection.program = baseline := by + simp [Selection.program, fallback] + +end Ix.Compiler.IxIR2.Borrow.Open diff --git a/Ix/Compiler/IxIR2/Borrow/OpenControl.lean b/Ix/Compiler/IxIR2/Borrow/OpenControl.lean new file mode 100644 index 000000000..bf70ae7ba --- /dev/null +++ b/Ix/Compiler/IxIR2/Borrow/OpenControl.lean @@ -0,0 +1,180 @@ +import Ix.Compiler.IxIR2.Borrow.OpenHeap + +namespace Ix.Compiler.IxIR2.Borrow.Open + +open Eval + +/-- A scalar-returning entry may halt or resume its immediate caller. The +caller's remaining continuation stack is arbitrary and is preserved. -/ +inductive Exit where + | halt + | resume (caller : Frame) (rest : List Continuation) + +def Exit.stack : Exit → List Continuation + | .halt => [] + | .resume caller rest => .resume caller :: rest + +def Exit.result (exit : Exit) (value : RVal) : Control := + match exit with + | .halt => .halted value + | .resume caller rest => .running { caller with values := caller.values.push value } rest + +def start (definition : Function) (location : Nat) (store : Store) (fuel : Nat) (exit : Exit) : Machine := + { store, heapFuel := fuel, control := .running { definition, values := #[.loc location] } exit.stack } + +def finish (store : Store) (fuel number : Nat) (exit : Exit) : Machine := + { store, heapFuel := fuel, control := exit.result (.lit (.nat number)) } + +/-- Every intermediate state preserves the lender's complete heap, not just +the final state. This composes under arbitrary suspended callers. -/ +inductive StableSteps (context : Context) (mode : Interpretation) : Nat → Machine → Machine → Prop where + | refl (machine : Machine) : StableSteps context mode 0 machine machine + | cons {count : Nat} {before middle after : Machine} {frame : Frame} {stack : List Continuation} + (running : before.control = .running frame stack) + (step : Step context mode before middle) (unchanged : middle.store = before.store) + (tail : StableSteps context mode count middle after) : + StableSteps context mode (count + 1) before after + +theorem StableSteps.steps {context mode count before after} + (trace : StableSteps context mode count before after) : Steps context mode count before after := by + induction trace with + | refl machine => exact .refl machine + | cons running step _ _ ih => exact .cons running step ih + +theorem StableSteps.one {context mode before after frame stack} + (step : Step context mode before after) (running : before.control = .running frame stack) + (unchanged : after.store = before.store) : StableSteps context mode 1 before after := + .cons running step unchanged (.refl after) + +theorem StableSteps.trans {context mode firstCount secondCount before middle after} + (first : StableSteps context mode firstCount before middle) + (second : StableSteps context mode secondCount middle after) : + StableSteps context mode (firstCount + secondCount) before after := by + induction first with + | refl => simpa using second + | cons running step unchanged _ ih => + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using + StableSteps.cons running step unchanged (ih second) + +theorem StableSteps.prefix {context mode count before after} + (trace : StableSteps context mode count before after) {prefixCount middle} + (initial : Steps context mode prefixCount before middle) (bound : prefixCount ≤ count) : + middle.store = before.store := by + induction trace generalizing prefixCount middle with + | refl => + have zero : prefixCount = 0 := by omega + subst prefixCount + cases initial + rfl + | @cons count before next after frame stack running step unchanged tail ih => + cases initial with + | refl => rfl + | cons _ head rest => + have eq := step.deterministic head + subst_vars + exact (ih rest (by omega)).trans unchanged + +theorem returnScalar {context : Context} {mode : Interpretation} {frame : Frame} {current : Block} + (store : Store) (fuel number : Nat) (exit : Exit) (atom : Atom) + (blockAt : frame.definition.blocks[frame.block]? = some current) + (pc : frame.pc = current.instructions.size) + (term : current.terminator = .ret atom) + (resolved : resolveAtom frame.values atom = .ok (.lit (.nat number))) + (credits : frame.credits = #[]) : + StableSteps context mode 1 + { store, heapFuel := fuel, control := .running frame exit.stack } + (finish store fuel number exit) := by + cases exit with + | halt => + exact StableSteps.one + (Step.retHalt rfl blockAt pc term resolved credits rfl) rfl rfl + | resume caller rest => + exact StableSteps.one + (Step.retResume rfl blockAt pc term resolved credits rfl) rfl rfl + +def readerFrame (schema : Schema) (borrowed : Bool) (major : Major) (location : Nat) : Frame := + { definition := reader schema borrowed + block := match major with | .zero => 1 | .succ _ => 2 + pc := major.fieldCost + values := #[.loc location] ++ major.fields } + +theorem readerPrefix (context : Context) (mode : Interpretation) (schema : Schema) (borrowed : Bool) + (distinct : schema.zero ≠ schema.succ) (major : Major) + {store : Store} {location rc : Nat} (view : major.At schema store location rc) + (fuel : Nat) (exit : Exit) : + StableSteps context mode (1 + major.fieldCost) + (start (reader schema borrowed) location store fuel exit) + { store, heapFuel := fuel, control := .running (readerFrame schema borrowed major location) exit.stack } := by + cases major with + | zero => + have step : Step context mode (start (reader schema borrowed) location store fuel exit) + { store, heapFuel := fuel + control := .running (readerFrame schema borrowed .zero location) exit.stack } := + Step.switchCtor (alternative := { + cid := schema.zero + edge := { target := 1, values := #[.reg 0], credits := #[] } }) + rfl rfl rfl rfl rfl view rfl (by simp [Major.cid]) (by + exact EdgeTransfer.baseline (values := #[.loc location]) rfl rfl rfl rfl rfl rfl) + exact StableSteps.one step rfl rfl + | succ field => + let middle : Machine := { + store, heapFuel := fuel + control := .running { definition := reader schema borrowed, block := 2, values := #[.loc location] } exit.stack } + have switch : Step context mode (start (reader schema borrowed) location store fuel exit) middle := + Step.switchCtor (alternative := { + cid := schema.succ + edge := { target := 2, values := #[.reg 0], credits := #[] } }) + rfl rfl rfl rfl rfl view rfl (by simp [Major.cid, distinct]) (by + exact EdgeTransfer.baseline (values := #[.loc location]) rfl rfl rfl rfl rfl rfl) + have fetch : Step context mode middle { + store, heapFuel := fuel + control := .running (readerFrame schema borrowed (.succ field) location) exit.stack } := + Step.fetch (machine := middle) (atom := .reg 0) (cid := schema.succ) + (field := 0) (value := field) rfl rfl + (by simp [reader, block, release]; omega) (by cases borrowed <;> rfl) rfl view rfl rfl + exact (StableSteps.one switch rfl rfl).trans (StableSteps.one fetch rfl rfl) + +theorem readerBorrowed (context : Context) (mode : Interpretation) (schema : Schema) + (distinct : schema.zero ≠ schema.succ) (major : Major) + {store : Store} {location rc : Nat} (view : major.At schema store location rc) + (fuel : Nat) (exit : Exit) : + StableSteps context mode (2 + major.fieldCost) + (start (reader schema true) location store fuel exit) + (finish store fuel (major.result schema) exit) := by + have headPath := readerPrefix context mode schema true distinct major view fuel exit + have ret : StableSteps context mode 1 + { store, heapFuel := fuel, control := .running (readerFrame schema true major location) exit.stack } + (finish store fuel (major.result schema) exit) := by + cases major with + | zero => exact returnScalar store fuel schema.zeroResult exit _ rfl rfl rfl rfl rfl + | succ field => exact returnScalar store fuel schema.succResult exit _ rfl rfl rfl rfl rfl + have count : 1 + major.fieldCost + 1 = 2 + major.fieldCost := by omega + simpa only [count] using headPath.trans ret + +theorem readerOwned (context : Context) (mode : Interpretation) (schema : Schema) + (distinct : schema.zero ≠ schema.succ) (major : Major) + {store output : Store} {location rc fuel remaining : Nat} + (view : major.At schema store location rc) + (released : releaseShared fuel store (.loc location) = .ok (output, remaining)) (exit : Exit) : + Steps context mode (3 + major.fieldCost) + (start (reader schema false) location store fuel exit) + (finish output remaining (major.result schema) exit) := by + have headPath := readerPrefix context mode schema false distinct major view fuel exit + let afterRelease : Frame := { readerFrame schema false major location with pc := major.fieldCost + 1 } + have drop : Step context mode + { store, heapFuel := fuel, control := .running (readerFrame schema false major location) exit.stack } + { store := output, heapFuel := remaining, control := .running afterRelease exit.stack } := by + cases major with + | zero => exact Step.releaseShared rfl rfl (by simp [readerFrame, reader, block, release, Major.fieldCost]) rfl rfl released + | succ field => exact Step.releaseShared rfl rfl (by simp [readerFrame, reader, block, release, Major.fieldCost]) rfl rfl released + have ret : StableSteps context mode 1 + { store := output, heapFuel := remaining, control := .running afterRelease exit.stack } + (finish output remaining (major.result schema) exit) := by + cases major with + | zero => exact returnScalar output remaining schema.zeroResult exit _ rfl rfl rfl rfl rfl + | succ field => exact returnScalar output remaining schema.succResult exit _ rfl rfl rfl rfl rfl + have count : 1 + major.fieldCost + 1 + 1 = 3 + major.fieldCost := by omega + simpa only [count] using + (headPath.steps.trans (drop.toSteps rfl)).trans ret.steps + +end Ix.Compiler.IxIR2.Borrow.Open diff --git a/Ix/Compiler/IxIR2/Borrow/OpenExamples.lean b/Ix/Compiler/IxIR2/Borrow/OpenExamples.lean new file mode 100644 index 000000000..bb9e03f8f --- /dev/null +++ b/Ix/Compiler/IxIR2/Borrow/OpenExamples.lean @@ -0,0 +1,104 @@ +import Ix.Compiler.IxIR2.Borrow.OpenResources +import Ix.Compiler.IxIR2.Borrow.Examples + +/-! Structural and lifetime neighbors for the open-input certificate. The +positive source/measurement boundary is supplied by Borrow.Runtime. -/ + +namespace Ix.Compiler.IxIR2.Borrow.Open.Examples + +open Ix.Compiler.Ixon (Address) + +def schema : Schema := { zero := Borrow.Examples.leaf, succ := Borrow.Examples.box, zeroResult := 11, succResult := 22 } +def readerAddress : Address := .replicate 1 +def workerAddress : Address := .replicate 2 +def factoryAddress : Address := .replicate 3 +def cycleAddress : Address := .replicate 4 +def callerAddress : Address := .replicate 5 +def readerBorrowed : Address := .replicate 11 +def workerBorrowed : Address := .replicate 12 +def cycleBorrowed : Address := .replicate 14 +def validation : Validate.Context := Borrow.Examples.context + +def baseline : Program := + { declarations := [(readerAddress, .fn (reader schema false)), + (workerAddress, .fn (twice false readerAddress)), (factoryAddress, .fn (factory workerAddress))] + main := moduleMain factoryAddress } + +def claims : List Summary := + [{ owner := readerAddress, borrowed := readerBorrowed }, { owner := workerAddress, borrowed := workerBorrowed }] + +def accepted : Bool := (certify {} validation baseline claims).isOk + +def cycle : Program := + { baseline with declarations := baseline.declarations ++ [(cycleAddress, .fn (forward false cycleAddress))] } + +def cycleClaims : List Summary := claims ++ [{ owner := cycleAddress, borrowed := cycleBorrowed }] + +def cycleRejected : Bool := + (Borrow.check {} validation cycle cycleClaims).isOk && + match certify {} validation cycle cycleClaims with + | .error .body => true + | _ => false + +/-- Baseline release before allocation is safe. Borrowing delays that final +release across the allocation, so B2 must reject it without sampling a heap. -/ +def allocatingReader : Function := + { reader schema false with + blocks := (reader schema false).blocks.set! 1 + (block false #[.releaseShared (.reg 0), .alloc .shared schema.zero #[], .releaseShared (.reg 1)] + (.ret (.lit (.nat 11)))) } + +def allocation : Program := + { baseline with declarations := baseline.declarations.map fun (address, declaration) => + (address, if address == readerAddress then .fn allocatingReader else declaration) } + +def allocationRejected : Bool := + (Borrow.check {} validation allocation claims).isOk && + match certify {} validation allocation claims with + | .error .schema => true + | _ => false + +def callbackFreeFallback : Bool := + match certify {} validation baseline claims { maxDepth := 0 } with + | .error .body => true + | _ => false + +def incompleteRejected : Bool := !(certify {} validation baseline + [{ owner := workerAddress, borrowed := workerBorrowed }]).isOk + +/-- A caller can borrow, regain its unchanged lender, then reset and discard +the slot. The caller itself is deliberately not rewritten to a borrowed ABI. -/ +def resettingCaller : Function := + { signature := signature false + blocks := #[block false #[.call workerBorrowed #[.reg 0], .resetShared (.reg 0) schema.zero, .discardCredit 0] + (.ret (.reg 1))] } + +def lenderThenReset : Bool := + match certify {} validation baseline claims with + | .error _ => false + | .ok result => + let program := { result.rewrite.program with + declarations := result.rewrite.program.declarations ++ [(callerAddress, .fn resettingCaller)] } + let allocated := ({} : Eval.Store).allocNode .shared (.ctorN schema.zero #[]) + (Validate.validate validation program).isOk && + match Eval.runFunction (context validation program) .physical resettingCaller #[.loc allocated.2] 100 100 allocated.1 with + | .error _ => false + | .ok output => output.value == .lit (.nat 11) && output.store.live == 0 && + output.store.heap.allocs == output.store.heap.frees && output.store.hotResets == 1 + +def localTailRejected : Bool := Borrow.Examples.accepted Borrow.Examples.localTailLender && Borrow.Examples.rejected Borrow.Examples.localTailLender +def laterResetRejected : Bool := Borrow.Examples.accepted Borrow.Examples.laterReset && Borrow.Examples.rejected Borrow.Examples.laterReset + +def guards : Array (String × Bool) := #[ + ("structural-open-certificate", accepted), + ("cyclic-summary-rejected", cycleRejected), + ("allocation-peak-hazard-rejected", allocationRejected), + ("structural-budget-fallback", callbackFreeFallback), + ("incomplete-summary-rejected", incompleteRejected), + ("borrow-then-reset", lenderThenReset), + ("local-tail-lender-rejected", localTailRejected), + ("later-reset-keeps-owned-parameter", laterResetRejected)] + +#guard guards.all (·.2) + +end Ix.Compiler.IxIR2.Borrow.Open.Examples diff --git a/Ix/Compiler/IxIR2/Borrow/OpenHeap.lean b/Ix/Compiler/IxIR2/Borrow/OpenHeap.lean new file mode 100644 index 000000000..5a8b18509 --- /dev/null +++ b/Ix/Compiler/IxIR2/Borrow/OpenHeap.lean @@ -0,0 +1,142 @@ +import Ix.Compiler.IxIR2.Borrow.OpenShape +import Ix.Compiler.IxIR1.Sim + +namespace Ix.Compiler.IxIR2.Borrow.Open + +open Eval + +/-- Only instrumentation differs after cancelling one retain/release pair. -/ +def bump (store : Store) (count : Nat) : Store := + { store with heap := { store.heap with rcops := store.heap.rcops + count } } + +@[simp] theorem bump_zero (store : Store) : bump store 0 = store := rfl + +@[simp] theorem bump_get (store : Store) (count location : Nat) : + (bump store count).get? location = store.get? location := rfl + +@[simp] theorem bump_set (store : Store) (count location : Nat) (box : NodeBox) : + (bump store count).setBox location box = bump (store.setBox location box) count := rfl + +@[simp] theorem bump_kill (store : Store) (count location : Nat) : + (bump store count).kill location = bump (store.kill location) count := rfl + +@[simp] theorem bump_tick (store : Store) (count : Nat) : + (bump store count).rcTick = bump store.rcTick count := by + simp [bump, Store.rcTick, IxIR1.Store.rcTick, Nat.add_right_comm] + +theorem releaseWork_bump {fuel remaining : Nat} {store output : Store} {values : List RVal} + (run : releaseSharedWork fuel store values = .ok (output, remaining)) (count : Nat) : + releaseSharedWork fuel (bump store count) values = .ok (bump output count, remaining) := by + induction fuel generalizing store values with + | zero => + cases values with + | nil => cases run; rfl + | cons => simp [releaseSharedWork] at run + | succ fuel ih => + cases values with + | nil => cases run; rfl + | cons value rest => + cases value with + | lit => exact ih run + | erased => exact ih run + | loc location => + cases found : store.get? location with + | none => simp [releaseSharedWork, found] at run + | some box => + by_cases shared : box.world = .shared + · by_cases zero : box.rc = 0 + · simp [releaseSharedWork, found, shared, zero] at run + · by_cases unit : box.rc = 1 + · simp only [releaseSharedWork, bump_get, found, shared, bne_self_eq_false, + Bool.false_eq_true, ↓reduceIte, unit, beq_self_eq_true, + Nat.reduceBEq, bump_tick, bump_kill] at run ⊢ + exact ih run + · simp only [releaseSharedWork, bump_get, found, shared, bne_self_eq_false, + Bool.false_eq_true, ↓reduceIte, beq_iff_eq, zero, unit, + bump_tick, bump_set] at run ⊢ + exact ih run + · simp [releaseSharedWork, found, shared] at run + +theorem release_bump {fuel remaining : Nat} {store output : Store} {value : RVal} + (run : releaseShared fuel store value = .ok (output, remaining)) (count : Nat) : + releaseShared fuel (bump store count) value = .ok (bump output count, remaining) := + releaseWork_bump run count + +def retained (store : Store) (location : Nat) (box : NodeBox) : Store := + (store.setBox location { box with rc := box.rc + 1 }).rcTick + +theorem retained_at {store : Store} {location : Nat} {box : NodeBox} + (found : store.get? location = some box) : + (retained store location box).get? location = some { box with rc := box.rc + 1 } := + IxIR1.Sim.get?_setBox_same found + +theorem retain_eq {store : Store} {location : Nat} {box : NodeBox} + (found : store.get? location = some box) (shared : box.world = .shared) : + retainShared store (.loc location) = .ok (retained store location box) := by + simp [retainShared, found, shared, retained] + +private theorem setBox_restore {store : Store} {location : Nat} {box : NodeBox} + (found : store.get? location = some box) : store.setBox location box = store := by + have slot := IxIR1.Sim.nodes_get?_of_get? found + obtain ⟨bound, valueAt⟩ := Array.getElem?_eq_some_iff.mp slot + have slots : store.heap.nodes.setIfInBounds location (some box) = store.heap.nodes := by + rw [Array.setIfInBounds, dif_pos bound, ← valueAt] + exact Array.set_getElem_self bound + simp only [Store.setBox, IxIR1.Store.setBox, Array.set!_eq_setIfInBounds, slots] + +/-- The temporary owner protects the entire reachable graph. Its first +release cannot recurse or free any node, even if the original owner aliases +other caller roots. It restores every slot and costs exactly two RC ticks. -/ +theorem retain_release_cancel {store : Store} {location : Nat} {box : NodeBox} + (found : store.get? location = some box) (shared : box.world = .shared) + (positive : 0 < box.rc) (fuel : Nat) : + releaseShared (fuel + 1) (retained store location box) (.loc location) = + .ok (bump store 2, fuel) := by + have retainedAt := retained_at found + have nonunit : box.rc + 1 ≠ 1 := by omega + simp only [releaseShared, releaseSharedWork, retainedAt, shared, bne_self_eq_false, + Bool.false_eq_true, ↓reduceIte, beq_iff_eq, + Nat.add_eq_zero_iff, Nat.one_ne_zero, and_false, nonunit, Nat.add_sub_cancel] + have restore := setBox_restore found + have cancelled : ((retained store location box).rcTick).setBox location box = bump store 2 := by + simp only [retained, Store.rcTick, Store.setBox, IxIR1.Store.rcTick, IxIR1.Store.setBox, + Array.set!_eq_setIfInBounds, Array.setIfInBounds_setIfInBounds] + have slots := congrArg (fun s : Store => s.heap.nodes) restore + simp only [Store.setBox, IxIR1.Store.setBox, Array.set!_eq_setIfInBounds] at slots + simp only [slots, bump, Nat.add_assoc] + simpa [← shared] using cancelled + +inductive Major where + | zero + | succ (field : RVal) + deriving Repr + +def Major.cid (schema : Schema) : Major → CtorId + | .zero => schema.zero + | .succ _ => schema.succ + +def Major.fields : Major → Array RVal + | .zero => #[] + | .succ field => #[field] + +def Major.result (schema : Schema) : Major → Nat + | .zero => schema.zeroResult + | .succ _ => schema.succResult + +def Major.fieldCost : Major → Nat + | .zero => 0 + | .succ _ => 1 + +def Major.At (schema : Schema) (major : Major) (store : Store) (location rc : Nat) : Prop := + store.get? location = some ⟨.shared, rc, .ctorN (major.cid schema) major.fields⟩ + +theorem Major.At.bump {schema major store location rc} + (found : Major.At schema major store location rc) (count : Nat) : + Major.At schema major (bump store count) location rc := found + +theorem Major.At.retained {schema major store location rc} + (found : Major.At schema major store location rc) : + Major.At schema major (retained store location ⟨.shared, rc, .ctorN (major.cid schema) major.fields⟩) + location (rc + 1) := retained_at found + +end Ix.Compiler.IxIR2.Borrow.Open diff --git a/Ix/Compiler/IxIR2/Borrow/OpenResources.lean b/Ix/Compiler/IxIR2/Borrow/OpenResources.lean new file mode 100644 index 000000000..63fbd4b4a --- /dev/null +++ b/Ix/Compiler/IxIR2/Borrow/OpenResources.lean @@ -0,0 +1,179 @@ +import Ix.Compiler.IxIR2.Borrow.OpenCheck +import Ix.Compiler.IxIR2.CreditReclamation + +namespace Ix.Compiler.IxIR2.Borrow.Open + +open Eval +open Ix.Compiler.IxIR1.Sim (RootOwnership) +open Ix.Compiler.IxIR1.Reclamation (AllocationOrderInvariant) + +theorem Entry.readWork_eq {beforeContext afterContext schema} (entry : Entry beforeContext afterContext schema) : + entry.beforeBody.readWork = entry.afterBody.readWork := by + simp only [Body.readWork, entry.sameKind] + +/-- Reusable function and continuation preservation. The only operational +premise is the ordinary final heap release; `Entry.total` constructs that +release internally for owned, allocation-ordered runtime inputs. -/ +theorem Entry.steps {beforeContext afterContext schema} (entry : Entry beforeContext afterContext schema) + (mode : Interpretation) (distinct : schema.zero ≠ schema.succ) (major : Major) + {store output : Store} {location rc fuel remaining : Nat} + (view : major.At schema store location rc) (positive : 0 < rc) + (released : releaseShared fuel store (.loc location) = .ok (output, remaining)) (exit : Exit) : + Steps beforeContext mode (entry.beforeBody.ownedCost major.fieldCost) + (start entry.before location store (fuel + 2 * entry.beforeBody.readWork) exit) + (finish (bump output (2 * entry.beforeBody.readWork)) remaining (major.result schema) exit) ∧ + Steps afterContext mode (entry.afterBody.readCost major.fieldCost + 3) + (start (ownedWrapper entry.summary.borrowed entry.before) location store + (fuel + entry.beforeBody.readWork) exit) + (finish output remaining (major.result schema) exit) := by + refine ⟨entry.beforeBody.ownedSteps mode distinct major view positive released exit, ?_⟩ + rw [entry.readWork_eq] + exact wrapper entry.afterAt (by rw [entry.afterBody.signature]; rfl) entry.afterBody.nonempty + mode major released exit (fun caller rest => entry.afterBody.borrowedSteps mode distinct major view fuel (.resume caller rest)) + +/-- Every borrowed prefix preserves the exact caller store. In particular, +the caller retains all ownership, refcounts, and constructor views required +by a later take/reset, after the borrowed activation has returned. -/ +theorem Entry.lenderLifetime {beforeContext afterContext schema} (entry : Entry beforeContext afterContext schema) + (mode : Interpretation) (distinct : schema.zero ≠ schema.succ) (major : Major) + {store : Store} {location rc : Nat} (view : major.At schema store location rc) + (fuel : Nat) (exit : Exit) {count : Nat} {middle : Machine} + (path : Steps afterContext mode count + (start entry.after location store (fuel + entry.afterBody.readWork) exit) middle) + (bound : count ≤ entry.afterBody.readCost major.fieldCost) : middle.store = store := + (entry.afterBody.borrowedSteps mode distinct major view fuel exit).prefix path bound + +structure Input (schema : Schema) (major : Major) (store : Store) (location rc : Nat) : Prop where + view : major.At schema store location rc + owned : RootOwnership store.heap [⟨.shared, .loc location⟩] + ordered : AllocationOrderInvariant store.heap + accounted : store.heap.allocs = store.live + store.heap.frees + peak : store.live ≤ store.peakLiveNodes + +def FullyReleased (store : Store) : Prop := + store.live = 0 ∧ store.heap.allocs = store.heap.frees ∧ store.heap.nodes.all Option.isNone = true + +theorem fullyReleased_of_zero {before output : Store} + (accounted : before.heap.allocs = before.live + before.heap.frees) + (balanced : HeapBalance before output) (empty : output.live = 0) : FullyReleased output := by + have frees : output.heap.allocs = output.heap.frees := by + unfold HeapBalance at balanced + omega + refine ⟨empty, frees, ?_⟩ + have none := Array.countP_eq_zero.mp ((Store.live_eq_countP output).symm.trans empty) + rw [Array.all_eq_true'] + intro slot member + have absent := none slot member + cases slot <;> simp_all + +theorem FullyReleased.bump {store : Store} (released : FullyReleased store) (count : Nat) : + FullyReleased (bump store count) := released + +theorem released_peak {store output : Store} {fuel remaining : Nat} {value : RVal} + (released : releaseShared fuel store value = .ok (output, remaining)) : + output.peakLiveNodes = store.peakLiveNodes := + congrArg Counters.peakLiveNodes (CreditRefinement.releaseWork_passive released) + +/-- The ownership and allocation-order invariants construct deep-release fuel +for every admitted heap, including arbitrary shared descendants. There is no +finite input matrix, source replay, or caller simulation obligation here. -/ +theorem Entry.total {beforeContext afterContext schema} (entry : Entry beforeContext afterContext schema) + (mode : Interpretation) (distinct : schema.zero ≠ schema.succ) (major : Major) + {store : Store} {location rc : Nat} (input : Input schema major store location rc) (exit : Exit) : + ∃ fuel output, + Steps beforeContext mode (entry.beforeBody.ownedCost major.fieldCost) + (start entry.before location store (fuel + 2 * entry.beforeBody.readWork) exit) + (finish (bump output (2 * entry.beforeBody.readWork)) 0 (major.result schema) exit) ∧ + Steps afterContext mode (entry.afterBody.readCost major.fieldCost + 3) + (start (ownedWrapper entry.summary.borrowed entry.before) location store + (fuel + entry.beforeBody.readWork) exit) + (finish output 0 (major.result schema) exit) ∧ + FullyReleased output ∧ FullyReleased (bump output (2 * entry.beforeBody.readWork)) ∧ + output.peakLiveNodes = store.peakLiveNodes ∧ + (bump output (2 * entry.beforeBody.readWork)).heap.rcops = + output.heap.rcops + 2 * entry.beforeBody.readWork := by + obtain ⟨fuel, output, released, empty⟩ := CreditRefinement.reclaim_progress input.owned input.ordered + have positive := RootOwnership.shared_rc_pos input.view input.owned + have paths := entry.steps mode distinct major input.view positive released exit + have clean := fullyReleased_of_zero input.accounted (releaseShared_heapBalance released) empty + exact ⟨fuel, output, paths.1, paths.2, clean, clean.bump _, released_peak released, rfl⟩ + +theorem Certificate.strictImprovement {limits validation baseline} + (certificate : Certificate limits validation baseline) + (mode : Interpretation) (major : Major) {store : Store} {location rc : Nat} + (input : Input certificate.schema major store location rc) (exit : Exit) : + ∃ fuel output, + Steps (context validation baseline) mode (certificate.entry.beforeBody.ownedCost major.fieldCost) + (start certificate.entry.before location store (fuel + 2) exit) + (finish (bump output 2) 0 (major.result certificate.schema) exit) ∧ + Steps (context validation certificate.rewrite.program) mode + (certificate.entry.afterBody.readCost major.fieldCost + 3) + (start (ownedWrapper certificate.entry.summary.borrowed certificate.entry.before) location store (fuel + 1) exit) + (finish output 0 (major.result certificate.schema) exit) ∧ + FullyReleased output ∧ FullyReleased (bump output 2) ∧ + output.peakLiveNodes = store.peakLiveNodes ∧ + output.heap.rcops < (bump output 2).heap.rcops := by + obtain ⟨fuel, output, before, after, clean, beforeClean, peak, _⟩ := + certificate.entry.total mode certificate.distinct major input exit + have work : certificate.entry.beforeBody.readWork = 1 := by + simp [Body.readWork, certificate.improvement] + refine ⟨fuel, output, ?_, ?_, clean, ?_, peak, ?_⟩ + · simpa [work] using before + · simpa [work] using after + · simpa [work] using beforeClean + · simp [bump] + +theorem Certificate.controlCost {limits validation baseline} + (certificate : Certificate limits validation baseline) (major : Major) : + certificate.entry.afterBody.readCost major.fieldCost + 3 = + certificate.entry.beforeBody.ownedCost major.fieldCost + 1 := by + have kind : certificate.entry.afterBody.isTwice = true := + certificate.entry.sameKind.symm.trans certificate.improvement + simp only [Body.readCost, Body.ownedCost, certificate.improvement, kind, ↓reduceIte] + rw [certificate.entry.sameDepth] + omega + +theorem initial_eq_start (definition : Function) (location fuel : Nat) (store : Store) + (peak : store.live ≤ store.peakLiveNodes) : + initialMachine definition #[.loc location] fuel store = start definition location store fuel .halt := by + change (Machine.mk { store with peakLiveNodes := max store.peakLiveNodes store.live } fuel + (.running { definition, values := #[.loc location] } [])) = _ + rw [Nat.max_eq_left peak] + rfl + +/-- The public runner executes exactly the two certified open functions. +Fuel is constructed from the input ownership invariant and each structural +control cost, rather than guessed by the selecting compiler. -/ +theorem Certificate.runFunctions {limits validation baseline} + (certificate : Certificate limits validation baseline) + (mode : Interpretation) (major : Major) {store : Store} {location rc : Nat} + (input : Input certificate.schema major store location rc) : + ∃ fuel output, + runFunction (context validation baseline) mode certificate.entry.before #[.loc location] + (certificate.entry.beforeBody.ownedCost major.fieldCost) (fuel + 2) store = + .ok { + store := bump output 2, value := .lit (.nat (major.result certificate.schema)) + controlRemaining := 0, heapRemaining := 0 } ∧ + runFunction (context validation certificate.rewrite.program) mode + (ownedWrapper certificate.entry.summary.borrowed certificate.entry.before) #[.loc location] + (certificate.entry.afterBody.readCost major.fieldCost + 3) (fuel + 1) store = + .ok { + store := output, value := .lit (.nat (major.result certificate.schema)) + controlRemaining := 0, heapRemaining := 0 } ∧ + FullyReleased output ∧ FullyReleased (bump output 2) ∧ + output.peakLiveNodes = store.peakLiveNodes := by + obtain ⟨fuel, output, before, after, clean, beforeClean, peak, _⟩ := + certificate.strictImprovement mode major input .halt + refine ⟨fuel, output, ?_, ?_, clean, beforeClean, peak⟩ + · rw [runFunction_eq_runMachine (by rw [certificate.entry.beforeBody.signature]; rfl) + certificate.entry.beforeBody.nonempty, initial_eq_start _ _ _ _ input.peak] + exact before.runMachine_halted + · have arity : (#[.loc location] : Array RVal).size = + (ownedWrapper certificate.entry.summary.borrowed certificate.entry.before).signature.params.size := by + change 1 = certificate.entry.before.signature.params.size + rw [certificate.entry.beforeBody.signature] + rfl + rw [runFunction_eq_runMachine arity (by rfl), initial_eq_start _ _ _ _ input.peak] + exact after.runMachine_halted + +end Ix.Compiler.IxIR2.Borrow.Open diff --git a/Ix/Compiler/IxIR2/Borrow/OpenShape.lean b/Ix/Compiler/IxIR2/Borrow/OpenShape.lean new file mode 100644 index 000000000..5e43393fe --- /dev/null +++ b/Ix/Compiler/IxIR2/Borrow/OpenShape.lean @@ -0,0 +1,151 @@ +import Ix.Compiler.IxIR2.Borrow.Rewrite +import Ix.Compiler.IxIR2.Eval + +/-! Structural certificates for allocation-free borrowed readers. The +certificate contains syntax and declaration lookup facts, never an execution +of a runtime argument. The semantic proof is in `OpenSim`. -/ + +namespace Ix.Compiler.IxIR2.Borrow.Open + +open Ix.Compiler.Ixon (Address) + +structure Schema where + zero : CtorId + succ : CtorId + zeroResult : Nat + succResult : Nat + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr + +def signature (borrowed : Bool) : Signature := + { params := #[{ world := .shared, passing := if borrowed then .borrowed else .owned }] + result := .shared + papSafe := !borrowed } + +def capability (borrowed : Bool) : ValueCap := + if borrowed then .borrowed .shared .caller else .owned .shared + +def block (borrowed : Bool) (instructions : Array Instr) (terminator : Terminator) : Block := + { valueParams := #[capability borrowed], creditParams := #[], instructions, terminator } + +def release (borrowed : Bool) : Array Instr := + if borrowed then #[] else #[.releaseShared (.reg 0)] + +def reader (schema : Schema) (borrowed : Bool) : Function := + { signature := signature borrowed + blocks := #[ + block borrowed #[] (.switchValue (.reg 0) #[ + { cid := schema.zero, edge := { target := 1, values := #[.reg 0], credits := #[] } }, + { cid := schema.succ, edge := { target := 2, values := #[.reg 0], credits := #[] } }] none), + block borrowed (release borrowed) (.ret (.lit (.nat schema.zeroResult))), + block borrowed (#[.fetch (.reg 0) schema.succ 0] ++ release borrowed) + (.ret (.lit (.nat schema.succResult))) ] } + +def forward (borrowed : Bool) (address : Address) : Function := + { signature := signature borrowed + blocks := #[block borrowed #[] (.tailCall address #[.reg 0])] } + +def twice (borrowed : Bool) (address : Address) : Function := + { signature := signature borrowed + blocks := #[block borrowed #[ + if borrowed then .move (.reg 0) else .retainShared (.reg 0), + .call address #[.reg 1], .releaseShared (.reg 2)] (.tailCall address #[.reg 0])] } + +def factory (address : Address) : Function := + { signature := { params := #[], result := .shared, papSafe := true } + blocks := #[{ valueParams := #[], creditParams := #[], instructions := #[.papp address #[]] + terminator := .ret (.reg 0) }] } + +/-- A finite declaration derivation rules out unresolved calls and recursive +cycles. Its depth is independent of every runtime value and heap. -/ +inductive Chain (context : Eval.Context) (schema : Schema) (borrowed : Bool) : Function → Type where + | reader : Chain context schema borrowed (reader schema borrowed) + | forward (address : Address) (callee : Function) + (found : context.declarations address = some (.fn callee)) + (tail : Chain context schema borrowed callee) : + Chain context schema borrowed (forward borrowed address) + +def Chain.depth {context schema borrowed definition} : + Chain context schema borrowed definition → Nat + | .reader => 0 + | .forward _ _ _ tail => tail.depth + 1 + +def recognizeChain (context : Eval.Context) (schema : Schema) (borrowed : Bool) : + Nat → (definition : Function) → Option (Chain context schema borrowed definition) + | 0, _ => none + | fuel + 1, definition => + if exact : definition = reader schema borrowed then + some (exact ▸ Chain.reader) + else do + let some entry := definition.blocks[0]? | none + let .tailCall address _ := entry.terminator | none + let some (.fn callee) := context.declarations address | none + let tail ← recognizeChain context schema borrowed fuel callee + if found : context.declarations address = some (.fn callee) then + if exact : definition = forward borrowed address then + some (exact ▸ Chain.forward address callee found tail) + else none + else none + +inductive Body (context : Eval.Context) (schema : Schema) (borrowed : Bool) : Function → Type where + | chain {definition : Function} (chain : Chain context schema borrowed definition) : + Body context schema borrowed definition + | twice (address : Address) (callee : Function) + (found : context.declarations address = some (.fn callee)) + (chain : Chain context schema borrowed callee) : + Body context schema borrowed (twice borrowed address) + +def Body.isTwice {context schema borrowed definition} : Body context schema borrowed definition → Bool + | .chain _ => false + | .twice .. => true + +def Body.depth {context schema borrowed definition} : Body context schema borrowed definition → Nat + | .chain derivation => derivation.depth + | .twice _ _ _ derivation => derivation.depth + +def Body.readWork {context schema borrowed definition} (body : Body context schema borrowed definition) : Nat := + if body.isTwice then 1 else 0 + +def Body.readCost {context schema borrowed definition} (body : Body context schema borrowed definition) + (fieldCost : Nat) : Nat := + if body.isTwice then 2 * body.depth + 8 + 2 * fieldCost else body.depth + 2 + fieldCost + +def Body.ownedCost {context schema borrowed definition} (body : Body context schema borrowed definition) + (fieldCost : Nat) : Nat := + if body.isTwice then 2 * body.depth + 10 + 2 * fieldCost else body.depth + 3 + fieldCost + +def recognizeBody (context : Eval.Context) (schema : Schema) (borrowed : Bool) + (fuel : Nat) (definition : Function) : Option (Body context schema borrowed definition) := do + match recognizeChain context schema borrowed fuel definition with + | some chain => some (.chain chain) + | none => + let some entry := definition.blocks[0]? | none + let .tailCall address _ := entry.terminator | none + let some (.fn callee) := context.declarations address | none + let chain ← recognizeChain context schema borrowed fuel callee + if found : context.declarations address = some (.fn callee) then + if exact : definition = twice borrowed address then + some (exact ▸ Body.twice address callee found chain) + else none + else none + +theorem Chain.signature {context schema borrowed definition} + (chain : Chain context schema borrowed definition) : definition.signature = signature borrowed := by + cases chain <;> rfl + +theorem Chain.nonempty {context schema borrowed definition} + (chain : Chain context schema borrowed definition) : definition.blocks.isEmpty = false := by + cases chain <;> rfl + +theorem Body.signature {context schema borrowed definition} + (body : Body context schema borrowed definition) : definition.signature = signature borrowed := by + cases body with + | chain chain => exact chain.signature + | twice => rfl + +theorem Body.nonempty {context schema borrowed definition} + (body : Body context schema borrowed definition) : definition.blocks.isEmpty = false := by + cases body with + | chain derivation => exact derivation.nonempty + | twice => rfl + +end Ix.Compiler.IxIR2.Borrow.Open diff --git a/Ix/Compiler/IxIR2/Borrow/OpenSim.lean b/Ix/Compiler/IxIR2/Borrow/OpenSim.lean new file mode 100644 index 000000000..31e3898b2 --- /dev/null +++ b/Ix/Compiler/IxIR2/Borrow/OpenSim.lean @@ -0,0 +1,188 @@ +import Ix.Compiler.IxIR2.Borrow.OpenControl + +namespace Ix.Compiler.IxIR2.Borrow.Open + +open Eval +open Ix.Compiler.Ixon (Address) + +theorem Chain.borrowedSteps {context : Context} {schema : Schema} {definition : Function} + (chain : Chain context schema true definition) (mode : Interpretation) + (distinct : schema.zero ≠ schema.succ) (major : Major) + {store : Store} {location rc : Nat} (view : major.At schema store location rc) + (fuel : Nat) (exit : Exit) : + StableSteps context mode (chain.depth + 2 + major.fieldCost) + (start definition location store fuel exit) (finish store fuel (major.result schema) exit) := by + induction chain with + | reader => exact readerBorrowed context mode schema distinct major view fuel exit + | forward address callee found tail ih => + have step : Step context mode (start (Open.forward true address) location store fuel exit) + (start callee location store fuel exit) := + Step.tailCallFn rfl rfl rfl rfl rfl rfl found + (by rw [tail.signature]; rfl) tail.nonempty + have count : 1 + (tail.depth + 2 + major.fieldCost) = tail.depth + 1 + 2 + major.fieldCost := by omega + simpa only [Chain.depth, count] using (StableSteps.one step rfl rfl).trans ih + +theorem Chain.ownedSteps {context : Context} {schema : Schema} {definition : Function} + (chain : Chain context schema false definition) (mode : Interpretation) + (distinct : schema.zero ≠ schema.succ) (major : Major) + {store output : Store} {location rc fuel remaining : Nat} + (view : major.At schema store location rc) + (released : releaseShared fuel store (.loc location) = .ok (output, remaining)) (exit : Exit) : + Steps context mode (chain.depth + 3 + major.fieldCost) + (start definition location store fuel exit) (finish output remaining (major.result schema) exit) := by + induction chain with + | reader => exact readerOwned context mode schema distinct major view released exit + | forward address callee found tail ih => + have step : Step context mode (start (Open.forward false address) location store fuel exit) + (start callee location store fuel exit) := + Step.tailCallFn rfl rfl rfl rfl rfl rfl found + (by rw [tail.signature]; rfl) tail.nonempty + have count : 1 + (tail.depth + 3 + major.fieldCost) = tail.depth + 1 + 3 + major.fieldCost := by omega + simpa only [Chain.depth, count] using (step.toSteps rfl).trans ih + +def twiceSaved (borrowed : Bool) (address : Address) (location : Nat) : Frame := + { definition := twice borrowed address, pc := 2, values := #[.loc location, .loc location] } + +def twiceResumed (borrowed : Bool) (address : Address) (location number : Nat) : Frame := + { twiceSaved borrowed address location with values := #[.loc location, .loc location, .lit (.nat number)] } + +theorem twiceBorrowed {context : Context} {schema : Schema} {address : Address} {callee : Function} + (found : context.declarations address = some (.fn callee)) + (chain : Chain context schema true callee) (mode : Interpretation) + (distinct : schema.zero ≠ schema.succ) (major : Major) + {store : Store} {location rc : Nat} (view : major.At schema store location rc) + (fuel : Nat) (exit : Exit) : + StableSteps context mode (2 * chain.depth + 8 + 2 * major.fieldCost) + (start (twice true address) location store (fuel + 1) exit) + (finish store fuel (major.result schema) exit) := by + let moved : Machine := { + store, heapFuel := fuel + 1 + control := .running { definition := twice true address, pc := 1, values := #[.loc location, .loc location] } exit.stack } + let saved := twiceSaved true address location + let resumed := twiceResumed true address location (major.result schema) + let next : Machine := { + store, heapFuel := fuel + control := .running { resumed with pc := 3 } exit.stack } + have move : Step context mode (start (twice true address) location store (fuel + 1) exit) moved := + Step.move (machine := start (twice true address) location store (fuel + 1) exit) + (atom := .reg 0) (value := .loc location) rfl rfl (by change 0 < 3; omega) rfl rfl + have call : Step context mode moved (start callee location store (fuel + 1) (.resume saved exit.stack)) := + Step.callFn (machine := moved) (arguments := #[.reg 1]) (values := #[.loc location]) + rfl rfl (by change 1 < 3; omega) rfl rfl rfl found + (by rw [chain.signature]; rfl) chain.nonempty + have first := chain.borrowedSteps mode distinct major view (fuel + 1) (.resume saved exit.stack) + have discard : Step context mode (finish store (fuel + 1) (major.result schema) (.resume saved exit.stack)) next := + Step.releaseShared rfl rfl (by change 2 < 3; omega) rfl rfl + (by simp [releaseShared, releaseSharedWork, finish, resumed, twiceResumed]) + have tailCall : Step context mode next (start callee location store fuel exit) := + Step.tailCallFn rfl rfl rfl rfl rfl rfl found + (by rw [chain.signature]; rfl) chain.nonempty + have second := chain.borrowedSteps mode distinct major view fuel exit + have path := (((((StableSteps.one move rfl rfl).trans (StableSteps.one call rfl rfl)).trans first).trans + (StableSteps.one discard rfl rfl)).trans (StableSteps.one tailCall rfl rfl)).trans second + have count : 1 + 1 + (chain.depth + 2 + major.fieldCost) + 1 + 1 + + (chain.depth + 2 + major.fieldCost) = 2 * chain.depth + 8 + 2 * major.fieldCost := by omega + simpa only [count] using path + +theorem twiceOwned {context : Context} {schema : Schema} {address : Address} {callee : Function} + (found : context.declarations address = some (.fn callee)) + (chain : Chain context schema false callee) (mode : Interpretation) + (distinct : schema.zero ≠ schema.succ) (major : Major) + {store output : Store} {location rc fuel remaining : Nat} + (view : major.At schema store location rc) (positive : 0 < rc) + (released : releaseShared fuel store (.loc location) = .ok (output, remaining)) (exit : Exit) : + Steps context mode (2 * chain.depth + 10 + 2 * major.fieldCost) + (start (twice false address) location store (fuel + 2) exit) + (finish (bump output 2) remaining (major.result schema) exit) := by + let box : NodeBox := ⟨.shared, rc, .ctorN (major.cid schema) major.fields⟩ + let held := retained store location box + let moved : Machine := { + store := held, heapFuel := fuel + 2 + control := .running { definition := twice false address, pc := 1, values := #[.loc location, .loc location] } exit.stack } + let saved := twiceSaved false address location + let resumed := twiceResumed false address location (major.result schema) + let next : Machine := { + store := bump store 2, heapFuel := fuel + control := .running { resumed with pc := 3 } exit.stack } + have retain : Step context mode (start (twice false address) location store (fuel + 2) exit) moved := + Step.retainShared (machine := start (twice false address) location store (fuel + 2) exit) + (atom := .reg 0) (value := .loc location) rfl rfl (by change 0 < 3; omega) rfl rfl (retain_eq view rfl) + have call : Step context mode moved (start callee location held (fuel + 2) (.resume saved exit.stack)) := + Step.callFn (machine := moved) (arguments := #[.reg 1]) (values := #[.loc location]) + rfl rfl (by change 1 < 3; omega) rfl rfl rfl found + (by rw [chain.signature]; rfl) chain.nonempty + have first := chain.ownedSteps mode distinct major view.retained + (retain_release_cancel view rfl positive (fuel + 1)) (.resume saved exit.stack) + have discard : Step context mode (finish (bump store 2) (fuel + 1) (major.result schema) (.resume saved exit.stack)) next := + Step.releaseShared rfl rfl (by change 2 < 3; omega) rfl rfl + (by simp [releaseShared, releaseSharedWork, finish, resumed, twiceResumed]) + have tailCall : Step context mode next (start callee location (bump store 2) fuel exit) := + Step.tailCallFn rfl rfl rfl rfl rfl rfl found + (by rw [chain.signature]; rfl) chain.nonempty + have second := chain.ownedSteps mode distinct major (view.bump 2) (release_bump released 2) exit + have path := (((((retain.toSteps rfl).trans (call.toSteps rfl)).trans first).trans + (discard.toSteps rfl)).trans (tailCall.toSteps rfl)).trans second + have count : 1 + 1 + (chain.depth + 3 + major.fieldCost) + 1 + 1 + + (chain.depth + 3 + major.fieldCost) = 2 * chain.depth + 10 + 2 * major.fieldCost := by omega + simpa only [count] using path + +/-- One exact owned wrapper brackets the borrowed execution with a live +lender, performs the ordinary final release, and resumes the caller. -/ +theorem wrapper {context : Context} {schema : Schema} {borrowed : Address} {callee baseline : Function} + (found : context.declarations borrowed = some (.fn callee)) + (arity : callee.signature.params.size = 1) (nonempty : callee.blocks.isEmpty = false) + (mode : Interpretation) (major : Major) {store output : Store} {location fuel remaining work count : Nat} + (released : releaseShared fuel store (.loc location) = .ok (output, remaining)) + (exit : Exit) + (run : ∀ caller rest, + StableSteps context mode count + (start callee location store (fuel + work) (.resume caller rest)) + (finish store fuel (major.result schema) (.resume caller rest))) : + Steps context mode (count + 3) + (start (ownedWrapper borrowed baseline) location store (fuel + work) exit) + (finish output remaining (major.result schema) exit) := by + let saved : Frame := { definition := ownedWrapper borrowed baseline, pc := 1, values := #[.loc location] } + let resumed : Frame := { saved with values := #[.loc location, .lit (.nat (major.result schema))] } + let next : Machine := { + store := output, heapFuel := remaining + control := .running { resumed with pc := 2 } exit.stack } + have call : Step context mode + (start (ownedWrapper borrowed baseline) location store (fuel + work) exit) + (start callee location store (fuel + work) (.resume saved exit.stack)) := + Step.callFn (machine := start (ownedWrapper borrowed baseline) location store (fuel + work) exit) + (values := #[.loc location]) rfl rfl (by change 0 < 2; omega) rfl rfl rfl found + (by simpa using arity.symm) nonempty + have drop : Step context mode (finish store fuel (major.result schema) (.resume saved exit.stack)) next := + Step.releaseShared rfl rfl (by change 1 < 2; omega) rfl rfl released + have ret : StableSteps context mode 1 next (finish output remaining (major.result schema) exit) := + returnScalar output remaining (major.result schema) exit _ rfl rfl rfl rfl rfl + have path := (((call.toSteps rfl).trans (run saved exit.stack).steps).trans (drop.toSteps rfl)).trans ret.steps + have counts : 1 + count + 1 + 1 = count + 3 := by omega + simpa only [counts] using path + +theorem Body.borrowedSteps {context : Context} {schema : Schema} {definition : Function} + (body : Body context schema true definition) (mode : Interpretation) + (distinct : schema.zero ≠ schema.succ) (major : Major) + {store : Store} {location rc : Nat} (view : major.At schema store location rc) + (fuel : Nat) (exit : Exit) : + StableSteps context mode (body.readCost major.fieldCost) + (start definition location store (fuel + body.readWork) exit) + (finish store fuel (major.result schema) exit) := by + cases body with + | chain chain => exact chain.borrowedSteps mode distinct major view fuel exit + | twice address callee found chain => exact twiceBorrowed found chain mode distinct major view fuel exit + +theorem Body.ownedSteps {context : Context} {schema : Schema} {definition : Function} + (body : Body context schema false definition) (mode : Interpretation) + (distinct : schema.zero ≠ schema.succ) (major : Major) + {store output : Store} {location rc fuel remaining : Nat} + (view : major.At schema store location rc) (positive : 0 < rc) + (released : releaseShared fuel store (.loc location) = .ok (output, remaining)) (exit : Exit) : + Steps context mode (body.ownedCost major.fieldCost) + (start definition location store (fuel + 2 * body.readWork) exit) + (finish (bump output (2 * body.readWork)) remaining (major.result schema) exit) := by + cases body with + | chain chain => exact chain.ownedSteps mode distinct major view released exit + | twice address callee found chain => exact twiceOwned found chain mode distinct major view positive released exit + +end Ix.Compiler.IxIR2.Borrow.Open diff --git a/Ix/Compiler/IxIR2/Borrow/Replay.lean b/Ix/Compiler/IxIR2/Borrow/Replay.lean new file mode 100644 index 000000000..77599e118 --- /dev/null +++ b/Ix/Compiler/IxIR2/Borrow/Replay.lean @@ -0,0 +1,166 @@ +import Ix.Compiler.IxIR2.Borrow.Rewrite +import Ix.Compiler.IxIR2.Eval + +/-! Closed-program translation validation for borrowed calls. Structural +validation is necessary but does not prove that moving a release preserves +results or peak space. This boundary therefore derives finite execution +certificates internally for the exact baseline and reconstructed program. +Only scalar results, complete reclamation, a strict RC improvement, and no +increase in peak live heap nodes can select the optional rewrite. It makes +no claim about open functions on arbitrary runtime arguments. -/ + +namespace Ix.Compiler.IxIR2.Borrow + +structure Budget where + control : Nat := 1000 + heap : Nat := 1000 + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr + +inductive ReplayError where + | execution (error : Eval.Error) + | nonScalar + | notClosed + | resultMismatch + | reclamation + | noImprovement + | peakIncrease + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr + +def run (context : Validate.Context) (budget : Budget) (program : Program) : + Except Eval.Error Eval.Result := + Eval.runMain (Eval.Context.ofProgram program context.schemas) .physical + program budget.control budget.heap + +structure Execution (context : Validate.Context) (budget : Budget) (program : Program) where + result : Eval.Result + number : Nat + ran : run context budget program = .ok result + scalar : result.value = .lit (.nat number) + arity : program.main.signature.params.size = 0 + nonempty : program.main.blocks.isEmpty = false + +def execute (context : Validate.Context) (budget : Budget) (program : Program) : + Except ReplayError (Execution context budget program) := do + if arity : program.main.signature.params.size = 0 then + if nonempty : program.main.blocks.isEmpty = false then + match ran : run context budget program with + | .error error => .error (.execution error) + | .ok result => + match scalar : result.value with + | .lit (.nat number) => pure ⟨result, number, ran, scalar, arity, nonempty⟩ + | _ => .error .nonScalar + else .error .notClosed + else .error .notClosed + +/-- Reclamation checks actual slots as well as counters. -/ +def Reclaimed (store : Eval.Store) : Prop := + store.heap.live = 0 ∧ store.heap.allocs = store.heap.frees ∧ + store.heap.nodes.all Option.isNone = true + +instance (store : Eval.Store) : Decidable (Reclaimed store) := + inferInstanceAs (Decidable (_ ∧ _ ∧ _)) + +structure Improved (limits : Limits) (context : Validate.Context) + (budget : Budget) (baseline : Program) where + rewrite : Checked limits context baseline + before : Execution context budget baseline + after : Execution context budget rewrite.program + same : before.number = after.number + beforeReclaimed : Reclaimed before.result.store + afterReclaimed : Reclaimed after.result.store + fewerRC : after.result.store.heap.rcops < before.result.store.heap.rcops + peak : after.result.store.peakLiveNodes ≤ before.result.store.peakLiveNodes + +def replay {limits : Limits} (context : Validate.Context) (budget : Budget) + {baseline : Program} (rewrite : Checked limits context baseline) : + Except ReplayError (Improved limits context budget baseline) := do + let before ← execute context budget baseline + let after ← execute context budget rewrite.program + if same : before.number = after.number then + if beforeReclaimed : Reclaimed before.result.store then + if afterReclaimed : Reclaimed after.result.store then + if fewerRC : after.result.store.heap.rcops < before.result.store.heap.rcops then + if peak : after.result.store.peakLiveNodes ≤ before.result.store.peakLiveNodes then + pure ⟨rewrite, before, after, same, beforeReclaimed, afterReclaimed, fewerRC, peak⟩ + else .error .peakIncrease + else .error .noImprovement + else .error .reclamation + else .error .reclamation + else .error .resultMismatch + +inductive Fallback where + | noCandidates + | rewrite (error : Error) + | replay (error : ReplayError) + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr + +inductive Decision (limits : Limits) (context : Validate.Context) + (budget : Budget) (baseline : Program) where + | baseline (reason : Fallback) + | improved (result : Improved limits context budget baseline) + +structure Selection (limits : Limits) (context : Validate.Context) + (budget : Budget) (baseline : Program) where + baselineChecked : Validate.Checked limits.validator context baseline + inference : Inference + decision : Decision limits context budget baseline + +def Selection.program {limits context budget baseline} + (selected : Selection limits context budget baseline) : Program := + match selected.decision with + | .baseline _ => baseline + | .improved result => result.rewrite.program + +def optimize {limits : Limits} {context : Validate.Context} {baseline : Program} + (baselineChecked : Validate.Checked limits.validator context baseline) + (budget : Budget := {}) : Selection limits context budget baseline := + let inference := infer limits context baseline + let decision := if inference.summaries.isEmpty then .baseline .noCandidates else + match check limits context baseline inference.summaries with + | .error error => .baseline (.rewrite error) + | .ok rewrite => + match replay context budget rewrite with + | .error error => .baseline (.replay error) + | .ok result => .improved result + ⟨baselineChecked, inference, decision⟩ + +theorem Execution.steps {context budget program} (execution : Execution context budget program) : + ∃ count, + budget.control = count + execution.result.controlRemaining ∧ + Eval.Steps (Eval.Context.ofProgram program context.schemas) .physical count + (Eval.initialMachine program.main #[] budget.heap) + { store := execution.result.store, heapFuel := execution.result.heapRemaining + control := .halted (.lit (.nat execution.number)) } := by + have ran := execution.ran + unfold run at ran + rw [Eval.runMain_eq_runMachine execution.arity execution.nonempty] at ran + simpa only [execution.scalar] using Eval.runMachine_steps ran + +theorem Improved.preservation {limits context budget baseline} + (result : Improved limits context budget baseline) : + result.before.result.value = result.after.result.value := by + rw [result.before.scalar, result.after.scalar, result.same] + +theorem Improved.resources {limits context budget baseline} + (result : Improved limits context budget baseline) : + Reclaimed result.before.result.store ∧ Reclaimed result.after.result.store ∧ + result.after.result.store.heap.rcops < result.before.result.store.heap.rcops ∧ + result.after.result.store.peakLiveNodes ≤ result.before.result.store.peakLiveNodes := + ⟨result.beforeReclaimed, result.afterReclaimed, result.fewerRC, result.peak⟩ + +theorem Selection.valid {limits context budget baseline} + (selected : Selection limits context budget baseline) : + Validate.ValidWith limits.validator context selected.program := by + cases h : selected.decision with + | baseline _ => + simpa [Selection.program, h] using + (show Validate.ValidWith limits.validator context baseline from + ⟨selected.baselineChecked.stats, selected.baselineChecked.accepted⟩) + | improved result => simpa [Selection.program, h] using result.rewrite.valid + +theorem Selection.fallbackExact {limits context budget baseline} + (selected : Selection limits context budget baseline) {reason : Fallback} + (fallback : selected.decision = .baseline reason) : selected.program = baseline := by + simp [Selection.program, fallback] + +end Ix.Compiler.IxIR2.Borrow diff --git a/Ix/Compiler/IxIR2/Borrow/Rewrite.lean b/Ix/Compiler/IxIR2/Borrow/Rewrite.lean new file mode 100644 index 000000000..a83b532c5 --- /dev/null +++ b/Ix/Compiler/IxIR2/Borrow/Rewrite.lean @@ -0,0 +1,185 @@ +import Ix.Compiler.IxIR2.Validate +import Ix.Compiler.Ixon.Hash + +/-! Bounded proposals for a borrowed ABI. Summaries are claims, not facts: +the checker reconstructs every variant from the exact baseline and validates +the complete program, including all owned wrappers and their call sites. +The first version borrows one shared parameter and rejects credit effects +and recursive calls. It leaves constructor-field retains intact. -/ + +namespace Ix.Compiler.IxIR2.Borrow + +open Ix.Compiler.Ixon (Address) + +structure Summary where + owner : Address + borrowed : Address + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr + +structure Limits where + maxCandidates : Nat := 32 + maxRounds : Nat := 16 + maxAttempts : Nat := 256 + validator : Validate.Limits := Validate.defaultLimits + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr + +inductive Error where + | limit + | missingOwner (owner : Address) + | signature (owner : Address) + | unsupported (owner : Address) + | duplicateSummary + | validation (error : Validate.Error) + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr + +/-- This is an internal label, not a persistent IxIR₂ content address. +Collisions are rejected by whole-program validation. -/ +def borrowedAddress (owner : Address) : Address := + Address.blake3 ("compilatrix/borrowed-entry/1\x00".toUTF8 ++ owner.hash) + +def eligible (definition : Function) : Bool := + definition.signature.params == #[{ world := .shared, passing := .owned }] && + definition.signature.result == .shared + +def borrowedAt? (summaries : List Summary) (owner : Address) : Option Address := + (summaries.find? fun summary => summary.owner == owner).map (·.borrowed) + +private def loanAtom (loans : Array Bool) : Atom → Bool + | .reg id => loans[id]?.getD false + | .lit _ | .erased => false + +private def borrowedCap : ValueCap → ValueCap + | .owned .shared => .borrowed .shared .caller + | cap => cap + +/-- Replace root retains by non-consuming moves so result-register numbering +does not change. Releases have no result and can simply be removed. Fetches +produce field views, whose later retains remain real ownership operations. -/ +def rewriteBlock (owner : Address) (summaries : List Summary) (block : Block) : + Except Error Block := do + if !block.creditParams.isEmpty then throw (.unsupported owner) + let mut loans := block.valueParams.map (· == .owned .shared) + let mut instructions := #[] + for instruction in block.instructions do + match instruction with + | .retainShared atom => + let loan := loanAtom loans atom + instructions := instructions.push (if loan then .move atom else instruction) + loans := loans.push loan + | .move atom => + instructions := instructions.push instruction + loans := loans.push (loanAtom loans atom) + | .releaseShared atom => + if !loanAtom loans atom then instructions := instructions.push instruction + | .call target args => + instructions := instructions.push (.call ((borrowedAt? summaries target).getD target) args) + loans := loans.push false + | .alloc .. | .fetch .. | .papp .. | .apply .. => + instructions := instructions.push instruction + loans := loans.push false + | .dropUnique .. | .freeUnique .. => + instructions := instructions.push instruction + | .allocWith .. | .discardCredit .. | .takeUnique .. | .resetShared .. | + .callSelf .. | .extern .. => throw (.unsupported owner) + let terminator ← match block.terminator with + | .tailCall target args => + pure (.tailCall ((borrowedAt? summaries target).getD target) args) + | .tailCallSelf .. | .branchCredit .. => throw (.unsupported owner) + | terminator => pure terminator + return { block with valueParams := block.valueParams.map borrowedCap + instructions, terminator } + +def rewriteFunction (owner : Address) (summaries : List Summary) + (definition : Function) : Except Error Function := do + if !eligible definition then throw (.signature owner) + let blocks ← definition.blocks.mapM (rewriteBlock owner summaries) + return { + signature := { definition.signature with + params := #[{ world := .shared, passing := .borrowed }], papSafe := false } + blocks } + +/-- Dynamic/PAP entry still owns its argument. Its wrapper keeps the lender +alive during the borrowed call and performs the final release on return. -/ +def ownedWrapper (borrowed : Address) (definition : Function) : Function := + { signature := definition.signature + blocks := #[{ + valueParams := #[.owned .shared], creditParams := #[] + instructions := #[.call borrowed #[.reg 0], .releaseShared (.reg 0)] + terminator := .ret (.reg 1) }] } + +def rebuild (limits : Limits) (baseline : Program) (summaries : List Summary) : + Except Error Program := do + if summaries.length > limits.maxCandidates then throw .limit + if summaries.any fun summary => + (summaries.filter fun other => other.owner == summary.owner).length != 1 then + throw .duplicateSummary + let mut variants := [] + for summary in summaries do + let some (_, .fn definition) := baseline.declarations.find? (fun entry => entry.1 == summary.owner) + | throw (.missingOwner summary.owner) + variants := variants ++ [(summary.borrowed, .fn (← rewriteFunction summary.owner summaries definition))] + let declarations := baseline.declarations.map fun (owner, declaration) => + match borrowedAt? summaries owner, declaration with + | some borrowed, .fn definition => (owner, .fn (ownedWrapper borrowed definition)) + | _, _ => (owner, declaration) + return { baseline with declarations := declarations ++ variants } + +structure Checked (limits : Limits) (context : Validate.Context) (baseline : Program) where + summaries : List Summary + program : Program + produced : rebuild limits baseline summaries = .ok program + baselineChecked : Validate.Checked limits.validator context baseline + checked : Validate.Checked limits.validator context program + +def check (limits : Limits) (context : Validate.Context) (baseline : Program) + (summaries : List Summary) : Except Error (Checked limits context baseline) := do + let baselineChecked ← match h : Validate.validateWith limits.validator context baseline with + | .error error => .error (.validation error) + | .ok stats => pure (Validate.Checked.mk stats h) + match h : rebuild limits baseline summaries with + | .error error => .error error + | .ok program => + match checked : Validate.validateWith limits.validator context program with + | .error error => .error (.validation error) + | .ok stats => return { + summaries, program, produced := h, baselineChecked + checked := ⟨stats, checked⟩ } + +structure Inference where + summaries : List Summary := [] + attempts : Nat := 0 + rounds : Nat := 0 + rejected : Nat := 0 + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr + +/-- Bounded dependency iteration. Each new claim is checked with all earlier +claims. A failed attempt does not evict the last checked set. This version +does not infer cyclic SCCs; a cycle without an accepted seed is left owned. -/ +def infer (limits : Limits) (context : Validate.Context) (baseline : Program) : + Inference := Id.run do + let candidates := baseline.declarations.filterMap fun + | (owner, .fn definition) => if eligible definition then some owner else none + | _ => none + if candidates.length > limits.maxCandidates then return {} + let mut state : Inference := {} + for _ in [:limits.maxRounds] do + let before := state.summaries.length + state := { state with rounds := state.rounds + 1 } + for owner in candidates do + if state.attempts < limits.maxAttempts && (borrowedAt? state.summaries owner).isNone then + let proposed := state.summaries ++ [{ owner, borrowed := borrowedAddress owner }] + state := { state with attempts := state.attempts + 1 } + match check limits context baseline proposed with + | .ok _ => state := { state with summaries := proposed } + | .error _ => state := { state with rejected := state.rejected + 1 } + if state.summaries.length == before || state.attempts == limits.maxAttempts then break + return state + +theorem Checked.valid {limits context baseline} (result : Checked limits context baseline) : + Validate.ValidWith limits.validator context result.program := + ⟨result.checked.stats, result.checked.accepted⟩ + +theorem Checked.exactRewrite {limits context baseline} (result : Checked limits context baseline) : + rebuild limits baseline result.summaries = .ok result.program := result.produced + +end Ix.Compiler.IxIR2.Borrow diff --git a/Ix/Compiler/IxIR2/CallEval.lean b/Ix/Compiler/IxIR2/CallEval.lean new file mode 100644 index 000000000..4aee119ab --- /dev/null +++ b/Ix/Compiler/IxIR2/CallEval.lean @@ -0,0 +1,373 @@ +import Ix.Compiler.IxIR2.Eval + +/-! +# Execution with continuation-owned credits + +The v1 dispatcher changes only direct non-tail calls. It saves the complete +caller frame once and enters the callee with no credits. All other instructions +and every terminator use the original evaluator, including its checks against +abandoning a credit on return or transferring it across a forbidden boundary. +The v0 runner is extensionally equal to the original runner. +-/ + +namespace Ix.Compiler.IxIR2.Eval.Policy + +open Ix.Compiler.Ixon (Address) + +inductive DirectCall where + | function (address : Address) (arguments : Array Atom) + | self (arguments : Array Atom) + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr + +def DirectCall.instruction : DirectCall → Instr + | .function address arguments => .call address arguments + | .self arguments => .callSelf arguments + +def DirectCall.ofInstruction? : Instr → Option DirectCall + | .call address arguments => some (.function address arguments) + | .callSelf arguments => some (.self arguments) + | _ => none + +def DirectCall.arguments : DirectCall → Array Atom + | .function _ arguments | .self arguments => arguments + +def DirectCall.definition (context : Context) (frame : Frame) : + DirectCall → Except Error Function + | .self _ => .ok frame.definition + | .function address _ => + match context.declarations address with + | some (.fn definition) => .ok definition + | some (.extern _) => .error (.stuck "call must not target an extern") + | none => .error (.unknownRef address) + +/-- Inspect exactly the current instruction, without interpreting a missing +block, a terminator, or an invalid program counter as a call. -/ +def directCall? (frame : Frame) : Option DirectCall := do + let block ← frame.definition.blocks[frame.block]? + DirectCall.ofInstruction? (← block.instructions[frame.pc]?) + +def suspendCall (context : Context) (machine : Machine) (frame : Frame) + (stack : List Continuation) (call : DirectCall) : Except Error Machine := do + let values ← resolveAtoms frame.values call.arguments + let definition ← call.definition context frame + let callee ← enterFunction definition values + let caller : Frame := { frame with pc := frame.pc + 1 } + return { machine with control := .running callee (.resume caller :: stack) } + +def step (policy : CreditPolicy) (context : Context) + (interpretation : Interpretation) (machine : Machine) : Except Error Machine := + match policy, machine.control with + | .suspendedCallsV1, .running frame stack => + match directCall? frame with + | some call => suspendCall context machine frame stack call + | none => Eval.step context interpretation machine + | _, _ => Eval.step context interpretation machine + +def Step (policy : CreditPolicy) (context : Context) + (interpretation : Interpretation) (before after : Machine) : Prop := + step policy context interpretation before = .ok after + +@[simp] theorem step_v0 (context : Context) (interpretation : Interpretation) + (machine : Machine) : + step .callLocalV0 context interpretation machine = + Eval.step context interpretation machine := rfl + +theorem step_of_noCall {context : Context} {interpretation : Interpretation} + {machine : Machine} {frame : Frame} {stack : List Continuation} + (running : machine.control = .running frame stack) + (noCall : directCall? frame = none) : + step .suspendedCallsV1 context interpretation machine = + Eval.step context interpretation machine := by + simp [step, running, noCall] + +theorem step_of_call {context : Context} {interpretation : Interpretation} + {machine : Machine} {frame : Frame} {stack : List Continuation} + {call : DirectCall} (running : machine.control = .running frame stack) + (atCall : directCall? frame = some call) : + step .suspendedCallsV1 context interpretation machine = + suspendCall context machine frame stack call := by + simp [step, running, atCall] + +inductive Steps (policy : CreditPolicy) (context : Context) + (interpretation : Interpretation) : Nat → Machine → Machine → Prop where + | refl (machine : Machine) : Steps policy context interpretation 0 machine machine + | cons {count : Nat} {before middle after : Machine} + {frame : Frame} {stack : List Continuation} + (running : before.control = .running frame stack) + (head : Step policy context interpretation before middle) + (tail : Steps policy context interpretation count middle after) : + Steps policy context interpretation (count + 1) before after + +theorem Step.deterministic {policy : CreditPolicy} {context : Context} + {interpretation : Interpretation} {before left right : Machine} + (leftStep : Step policy context interpretation before left) + (rightStep : Step policy context interpretation before right) : left = right := + Except.ok.inj (leftStep.symm.trans rightStep) + +theorem Steps.trans {policy : CreditPolicy} {context : Context} + {interpretation : Interpretation} {firstCount secondCount : Nat} + {before middle after : Machine} + (first : Steps policy context interpretation firstCount before middle) + (second : Steps policy context interpretation secondCount middle after) : + Steps policy context interpretation (firstCount + secondCount) before after := by + induction first with + | refl => simpa using second + | cons running head tail ih => + simpa only [Nat.succ_add] using Steps.cons running head (ih second) + +def runMachine (policy : CreditPolicy) (context : Context) + (interpretation : Interpretation) : Nat → Machine → Except Error Result + | controlFuel, { store, heapFuel, control := .halted value } => + .ok { store, value, controlRemaining := controlFuel, heapRemaining := heapFuel } + | 0, { control := .running .., .. } => .error .controlFuel + | controlFuel + 1, machine@{ control := .running .., .. } => do + let next ← step policy context interpretation machine + runMachine policy context interpretation controlFuel next + +def runFunction (policy : CreditPolicy) (context : Context) + (interpretation : Interpretation) (definition : Function) + (arguments : Array RVal) (controlFuel heapFuel : Nat) (store : Store := {}) : + Except Error Result := do + let _ ← enterFunction definition arguments + runMachine policy context interpretation controlFuel + (initialMachine definition arguments heapFuel store) + +def runMain (policy : CreditPolicy) (context : Context) + (interpretation : Interpretation) (program : Program) + (controlFuel : Nat := 100000) (heapFuel : Nat := 100000) : Except Error Result := + runFunction policy context interpretation program.main #[] controlFuel heapFuel + +theorem runMachine_v0 (context : Context) (interpretation : Interpretation) + (controlFuel : Nat) (machine : Machine) : + runMachine .callLocalV0 context interpretation controlFuel machine = + Eval.runMachine context interpretation controlFuel machine := by + induction controlFuel generalizing machine with + | zero => cases machine with | mk store heapFuel control => cases control <;> rfl + | succ fuel ih => + cases machine with + | mk store heapFuel control => + cases control with + | halted value => rfl + | running frame stack => + simp only [runMachine, Eval.runMachine, step_v0] + cases Eval.step context interpretation + { store, heapFuel, control := .running frame stack } <;> + simp only [bind, Except.bind, ih] + +theorem runFunction_v0 (context : Context) (interpretation : Interpretation) + (definition : Function) (arguments : Array RVal) (controlFuel heapFuel : Nat) + (store : Store) : + runFunction .callLocalV0 context interpretation definition arguments + controlFuel heapFuel store = + Eval.runFunction context interpretation definition arguments + controlFuel heapFuel store := by + unfold runFunction Eval.runFunction enterFunction + split + · rfl + · split + · rfl + · simpa only [bind, Except.bind, pure, Except.pure, initialMachine] using + runMachine_v0 context interpretation controlFuel + (initialMachine definition arguments heapFuel store) + +theorem runMain_v0 (context : Context) (interpretation : Interpretation) + (program : Program) (controlFuel heapFuel : Nat) : + runMain .callLocalV0 context interpretation program controlFuel heapFuel = + Eval.runMain context interpretation program controlFuel heapFuel := + runFunction_v0 .. + +theorem runMachine_steps {policy : CreditPolicy} {context : Context} + {interpretation : Interpretation} {controlFuel : Nat} {machine : Machine} + {result : Result} + (run : runMachine policy context interpretation controlFuel machine = .ok result) : + ∃ count, controlFuel = count + result.controlRemaining ∧ + Steps policy context interpretation count machine + { store := result.store, heapFuel := result.heapRemaining, + control := .halted result.value } := by + induction controlFuel generalizing machine with + | zero => + rcases machine with ⟨store, heapFuel, control⟩ + cases control with + | halted value => + simp only [runMachine, Except.ok.injEq] at run + subst result + exact ⟨0, by simp, .refl _⟩ + | running frame stack => cases run + | succ controlFuel ih => + rcases machine with ⟨store, heapFuel, control⟩ + cases control with + | halted value => + simp only [runMachine, Except.ok.injEq] at run + subst result + exact ⟨0, by simp, .refl _⟩ + | running frame stack => + simp only [runMachine] at run + cases stepped : step policy context interpretation + { store, heapFuel, control := .running frame stack } with + | error error => simp [stepped, bind, Except.bind] at run + | ok next => + simp only [stepped, bind, Except.bind] at run + obtain ⟨count, budget, steps⟩ := ih run + exact ⟨count + 1, by omega, .cons rfl stepped steps⟩ + +theorem Steps.runMachine {policy : CreditPolicy} {context : Context} + {interpretation : Interpretation} {count controlFuel : Nat} + {before after : Machine} + (steps : Steps policy context interpretation count before after) : + Policy.runMachine policy context interpretation (count + controlFuel) before = + Policy.runMachine policy context interpretation controlFuel after := by + induction steps with + | refl => simp only [Nat.zero_add] + | @cons count before middle after frame stack running head tail ih => + rw [Nat.succ_add] + cases before with + | mk store heapFuel control => + simp only at running + subst control + simp only [Policy.runMachine] + rw [head] + simp only [bind, Except.bind] + exact ih + +/-- The executable call has one saved caller and a callee with empty credits. +The heap and remaining heap budget stay unchanged at the call transition. -/ +theorem suspendCall_iff {context : Context} {machine target : Machine} + {frame : Frame} {stack : List Continuation} {call : DirectCall} : + suspendCall context machine frame stack call = .ok target ↔ + ∃ values definition, + resolveAtoms frame.values call.arguments = .ok values ∧ + call.definition context frame = .ok definition ∧ + values.size = definition.signature.params.size ∧ + definition.blocks.isEmpty = false ∧ + target = { machine with + control := .running { definition, values } + (.resume { frame with pc := frame.pc + 1 } :: stack) } := by + unfold suspendCall + cases resolved : resolveAtoms frame.values call.arguments with + | error error => simp [bind, Except.bind] + | ok values => + cases found : call.definition context frame with + | error error => simp [bind, Except.bind] + | ok definition => + by_cases arity : values.size = definition.signature.params.size + · cases empty : definition.blocks.isEmpty with + | true => simp_all [enterFunction, bind, Except.bind] + | false => + simp_all [enterFunction, bind, Except.bind, pure, Except.pure] + exact eq_comm + · simp [enterFunction, arity, bind, Except.bind] + +theorem Step.classify {policy : CreditPolicy} {context : Context} + {interpretation : Interpretation} {before after : Machine} + (stepped : Step policy context interpretation before after) : + Eval.Step context interpretation before after ∨ + ∃ frame stack call, + policy = .suspendedCallsV1 ∧ before.control = .running frame stack ∧ + directCall? frame = some call ∧ + suspendCall context before frame stack call = .ok after := by + cases policy with + | callLocalV0 => exact .inl stepped + | suspendedCallsV1 => + cases control : before.control with + | halted value => exact .inl (by simpa [Step, Eval.Step, step, control] using stepped) + | running frame stack => + cases atCall : directCall? frame with + | none => exact .inl (by simpa [Step, Eval.Step, step, control, atCall] using stepped) + | some call => + exact .inr ⟨frame, stack, call, rfl, rfl, atCall, + by simpa [Step, step, control, atCall] using stepped⟩ + +theorem directCall?_atInstruction {frame : Frame} {block : Block} + {instruction : Instr} (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instructionAt : block.instructions[frame.pc] = instruction) : + directCall? frame = DirectCall.ofInstruction? instruction := by + simp [directCall?, blockAt, Array.getElem?_eq_getElem pc, instructionAt] + +theorem directCall?_atTerminator {frame : Frame} {block : Block} + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) : directCall? frame = none := by + simp [directCall?, blockAt, pc] + +/-- Every successful old step is also a successful v1 step with exactly the +same machine. Thus the new policy preserves all existing accepted executions. -/ +theorem of_originalStep {context : Context} {interpretation : Interpretation} + {before after : Machine} (original : Eval.Step context interpretation before after) : + Step .suspendedCallsV1 context interpretation before after := by + cases original.classify with + | halted => rfl + | instruction blockAt pc instructionAt classified => + have original := classified.step blockAt pc instructionAt + have atCall := directCall?_atInstruction blockAt pc instructionAt + cases classified <;> + try { simpa only [Step, Eval.Step, step, atCall, + DirectCall.ofInstruction?] using original } + all_goals simp_all [Step, step, DirectCall.ofInstruction?, suspendCall, + DirectCall.arguments, DirectCall.definition, enterFunction, + bind, Except.bind, pure, Except.pure] + | terminator blockAt pc terminatorAt classified => + have original := classified.step blockAt pc terminatorAt + have noCall := directCall?_atTerminator blockAt pc + simpa only [Step, Eval.Step, step, noCall] using original + +theorem of_originalSteps {context : Context} {interpretation : Interpretation} + {count : Nat} {before after : Machine} + (original : Eval.Steps context interpretation count before after) : + Steps .suspendedCallsV1 context interpretation count before after := by + induction original with + | refl => exact .refl _ + | cons running head tail ih => exact .cons running (of_originalStep head) ih + +theorem of_originalRun {context : Context} {interpretation : Interpretation} + {controlFuel : Nat} {machine : Machine} {result : Result} + (original : Eval.runMachine context interpretation controlFuel machine = .ok result) : + runMachine .suspendedCallsV1 context interpretation controlFuel machine = .ok result := by + obtain ⟨count, budget, steps⟩ := Eval.runMachine_steps original + rw [budget, (of_originalSteps steps).runMachine] + simp only [runMachine] + +theorem runFunction_eq_runMachine {policy : CreditPolicy} {context : Context} + {interpretation : Interpretation} {definition : Function} + {arguments : Array RVal} {controlFuel heapFuel : Nat} {store : Store} + (arity : arguments.size = definition.signature.params.size) + (nonempty : definition.blocks.isEmpty = false) : + runFunction policy context interpretation definition arguments controlFuel heapFuel store = + runMachine policy context interpretation controlFuel + (initialMachine definition arguments heapFuel store) := by + simp [runFunction, enterFunction, arity, nonempty, bind, Except.bind] + +theorem runMain_eq_runMachine {policy : CreditPolicy} {context : Context} + {interpretation : Interpretation} {program : Program} {controlFuel heapFuel : Nat} + (arity : program.main.signature.params.size = 0) + (nonempty : program.main.blocks.isEmpty = false) : + runMain policy context interpretation program controlFuel heapFuel = + runMachine policy context interpretation controlFuel + (initialMachine program.main #[] heapFuel) := by + apply runFunction_eq_runMachine + · simpa using arity.symm + · exact nonempty + +theorem Steps.cancelPrefixToHalted {policy : CreditPolicy} {context : Context} + {interpretation : Interpretation} {prefixCount totalCount : Nat} + {before middle final : Machine} {store : Store} {heapFuel : Nat} {value : RVal} + (prefixSteps : Steps policy context interpretation prefixCount before middle) + (total : Steps policy context interpretation totalCount before final) + (halted : final = { store, heapFuel, control := .halted value }) : + ∃ suffixCount, totalCount = prefixCount + suffixCount ∧ + Steps policy context interpretation suffixCount middle final := by + induction prefixSteps generalizing totalCount final with + | refl => exact ⟨totalCount, by simp, total⟩ + | @cons prefixCount before prefixMiddle middle frame stack running head tail ih => + cases total with + | refl => + have controls : Control.running frame stack = .halted value := by + rw [← running] + exact congrArg Machine.control halted + contradiction + | cons totalRunning totalHead totalTail => + have middleEq := head.deterministic totalHead + subst middleEq + obtain ⟨suffixCount, countEq, suffix⟩ := ih totalTail halted + exact ⟨suffixCount, by omega, suffix⟩ + +end Ix.Compiler.IxIR2.Eval.Policy diff --git a/Ix/Compiler/IxIR2/CallEvalFuel.lean b/Ix/Compiler/IxIR2/CallEvalFuel.lean new file mode 100644 index 000000000..bc299b325 --- /dev/null +++ b/Ix/Compiler/IxIR2/CallEvalFuel.lean @@ -0,0 +1,60 @@ +import Ix.Compiler.IxIR2.CallEval +import Ix.Compiler.IxIR2.EvalFuel + +/-! Successful policy executions have budget-independent values and stores. -/ + +namespace Ix.Compiler.IxIR2.Eval.Policy + +theorem Step.addHeapFuel {policy : CreditPolicy} {context : Context} {interpretation : Interpretation} + {before after : Machine} (stepped : Step policy context interpretation before after) (extra : Nat) : + Step policy context interpretation (before.addHeapFuel extra) (after.addHeapFuel extra) := by + cases policy with + | callLocalV0 => exact Eval.Step.addHeapFuel stepped extra + | suspendedCallsV1 => + rcases stepped.classify with original | ⟨frame, stack, call, _, running, atCall, suspended⟩ + · exact of_originalStep (original.addHeapFuel extra) + · obtain ⟨values, definition, resolved, found, arity, nonempty, rfl⟩ := suspendCall_iff.mp suspended + simp only [Step, step, Machine.addHeapFuel, running, atCall] + exact suspendCall_iff.mpr ⟨values, definition, resolved, found, arity, nonempty, rfl⟩ + +theorem Steps.addHeapFuel {policy : CreditPolicy} {context : Context} {interpretation : Interpretation} + {count : Nat} {before after : Machine} + (steps : Steps policy context interpretation count before after) (extra : Nat) : + Steps policy context interpretation count (before.addHeapFuel extra) (after.addHeapFuel extra) := by + induction steps with + | refl => exact .refl _ + | cons running head tail ih => exact .cons running (head.addHeapFuel extra) ih + +theorem Steps.halted_unique {policy : CreditPolicy} {context : Context} {interpretation : Interpretation} + {leftCount rightCount : Nat} {before : Machine} + {leftStore rightStore : Store} {leftFuel rightFuel : Nat} {leftValue rightValue : RVal} + (left : Steps policy context interpretation leftCount before + { store := leftStore, heapFuel := leftFuel, control := .halted leftValue }) + (right : Steps policy context interpretation rightCount before + { store := rightStore, heapFuel := rightFuel, control := .halted rightValue }) : + leftCount = rightCount ∧ leftStore = rightStore ∧ leftFuel = rightFuel ∧ leftValue = rightValue := by + obtain ⟨count, budget, suffix⟩ := left.cancelPrefixToHalted right rfl + cases suffix with + | refl => exact ⟨by omega, rfl, rfl, rfl⟩ + | cons running => contradiction + +theorem runMain_success_unique {policy : CreditPolicy} {source : Program} {context : Context} + {interpretation : Interpretation} {leftControl rightControl leftHeap rightHeap : Nat} + {left right : Result} (arity : source.main.signature.params.size = 0) + (nonempty : source.main.blocks.isEmpty = false) + (leftRun : runMain policy context interpretation source leftControl leftHeap = .ok left) + (rightRun : runMain policy context interpretation source rightControl rightHeap = .ok right) : + left.store = right.store ∧ left.value = right.value := by + rw [runMain_eq_runMachine arity nonempty] at leftRun rightRun + obtain ⟨leftCount, _, leftSteps⟩ := runMachine_steps leftRun + obtain ⟨rightCount, _, rightSteps⟩ := runMachine_steps rightRun + have leftFunded := leftSteps.addHeapFuel rightHeap + have rightFunded := rightSteps.addHeapFuel leftHeap + have common : (initialMachine source.main #[] rightHeap).addHeapFuel leftHeap = + (initialMachine source.main #[] leftHeap).addHeapFuel rightHeap := by + simp [initialMachine, Machine.addHeapFuel, Nat.add_comm] + rw [common] at rightFunded + obtain ⟨_, stores, _, values⟩ := leftFunded.halted_unique rightFunded + exact ⟨stores, values⟩ + +end Ix.Compiler.IxIR2.Eval.Policy diff --git a/Ix/Compiler/IxIR2/CallResources.lean b/Ix/Compiler/IxIR2/CallResources.lean new file mode 100644 index 000000000..4b4527b84 --- /dev/null +++ b/Ix/Compiler/IxIR2/CallResources.lean @@ -0,0 +1,107 @@ +import Ix.Compiler.IxIR2.CallEval +import Ix.Compiler.IxIR2.Resources +import Ix.Compiler.IxIR2.CostSteps +import Ix.Compiler.IxIR2.EvalFuel + +/-! +# Resources of executions with suspended credits + +Reservations held by every continuation already participate in the physical +allocation balance. A direct call transfers that ownership to one saved frame +without changing the heap or the total number of credits. Existing return, +allocation, discard, and edge rules discharge the same balance. Cost and peak +invariants therefore hold for every actual step of either versioned policy. +-/ + +namespace Ix.Compiler.IxIR2.Eval.Policy + +theorem suspendCall_resources {context : Context} {before after : Machine} + {frame : Frame} {stack : List Continuation} {call : DirectCall} + (running : before.control = .running frame stack) + (called : suspendCall context before frame stack call = .ok after) : + after.store = before.store ∧ after.heapFuel = before.heapFuel ∧ + after.presentCredits = before.presentCredits := by + obtain ⟨values, definition, _, _, _, _, rfl⟩ := suspendCall_iff.mp called + refine ⟨rfl, rfl, ?_⟩ + cases before with + | mk store heapFuel control => + simp only at running + subst control + simp [Machine.presentCredits_running, Frame.presentCredits, + Continuation.presentCredits] + +theorem Step.allocationAccounting {policy : CreditPolicy} {context : Context} + {before after : Machine} (stepped : Step policy context .physical before after) + (accounted : before.AllocationAccounting) : after.AllocationAccounting := by + rcases stepped.classify with original | ⟨frame, stack, call, _, running, _, called⟩ + · exact original.allocationAccounting accounted + · obtain ⟨storeEq, _, creditsEq⟩ := suspendCall_resources running called + simpa only [Machine.AllocationAccounting, storeEq, creditsEq] using accounted + +theorem Steps.allocationAccounting {policy : CreditPolicy} {context : Context} + {count : Nat} {before after : Machine} + (steps : Steps policy context .physical count before after) + (accounted : before.AllocationAccounting) : after.AllocationAccounting := by + induction steps with + | refl => exact accounted + | cons running head tail ih => exact ih (head.allocationAccounting accounted) + +theorem runMachine_allocationAccounting {policy : CreditPolicy} {context : Context} + {controlFuel : Nat} {machine : Machine} {result : Result} + (run : runMachine policy context .physical controlFuel machine = .ok result) + (accounted : machine.AllocationAccounting) : + result.store.live + result.store.heap.frees = result.store.heap.allocs := by + obtain ⟨count, _, steps⟩ := runMachine_steps run + simpa [Machine.AllocationAccounting, Machine.presentCredits] using + steps.allocationAccounting accounted + +theorem runMain_allocationAccounting {policy : CreditPolicy} {context : Context} + {program : Program} {controlFuel heapFuel : Nat} {result : Result} + (arity : program.main.signature.params.size = 0) + (nonempty : program.main.blocks.isEmpty = false) + (run : runMain policy context .physical program controlFuel heapFuel = .ok result) : + result.store.live + result.store.heap.frees = result.store.heap.allocs := by + rw [runMain_eq_runMachine arity nonempty] at run + exact runMachine_allocationAccounting run (initialMachine_allocationAccounting ..) + +theorem Step.costs {policy : CreditPolicy} {context : Context} + {interpretation : Interpretation} {before after : Machine} + (stepped : Step policy context interpretation before after) : + before.store.heap.rcops ≤ after.store.heap.rcops ∧ + before.store.peakLiveNodes ≤ after.store.peakLiveNodes ∧ + (before.store.live ≤ before.store.peakLiveNodes → + after.store.live ≤ after.store.peakLiveNodes) := by + rcases stepped.classify with original | ⟨frame, stack, call, _, running, _, called⟩ + · exact ⟨original.rcops_mono, original.peakLive_mono, original.preservesPeakBound⟩ + · have stores := (suspendCall_resources running called).1 + simp only [stores] + exact ⟨Nat.le_refl _, Nat.le_refl _, id⟩ + +theorem Steps.costs {policy : CreditPolicy} {context : Context} + {interpretation : Interpretation} {count : Nat} {before after : Machine} + (steps : Steps policy context interpretation count before after) : + before.store.heap.rcops ≤ after.store.heap.rcops ∧ + before.store.peakLiveNodes ≤ after.store.peakLiveNodes ∧ + (before.store.live ≤ before.store.peakLiveNodes → + after.store.live ≤ after.store.peakLiveNodes) := by + induction steps with + | refl => exact ⟨Nat.le_refl _, Nat.le_refl _, id⟩ + | cons running head tail ih => + exact ⟨Nat.le_trans head.costs.1 ih.1, + Nat.le_trans head.costs.2.1 ih.2.1, ih.2.2 ∘ head.costs.2.2⟩ + +theorem runMachine_prefix_costs {policy : CreditPolicy} {context : Context} + {interpretation : Interpretation} {controlFuel prefixCount : Nat} + {initial middle : Machine} {result : Result} + (run : runMachine policy context interpretation controlFuel initial = .ok result) + (prefixSteps : Steps policy context interpretation prefixCount initial middle) + (initialPeak : initial.store.live ≤ initial.store.peakLiveNodes) : + middle.store.heap.rcops ≤ result.store.heap.rcops ∧ + middle.store.peakLiveNodes ≤ result.store.peakLiveNodes ∧ + middle.store.live ≤ result.store.peakLiveNodes := by + obtain ⟨count, _, execution⟩ := runMachine_steps run + obtain ⟨suffixCount, _, suffix⟩ := prefixSteps.cancelPrefixToHalted execution rfl + exact ⟨suffix.costs.1, suffix.costs.2.1, + Nat.le_trans (prefixSteps.costs.2.2 initialPeak) suffix.costs.2.1⟩ + +end Ix.Compiler.IxIR2.Eval.Policy diff --git a/Ix/Compiler/IxIR2/CallReuse.lean b/Ix/Compiler/IxIR2/CallReuse.lean new file mode 100644 index 000000000..baf8f58b7 --- /dev/null +++ b/Ix/Compiler/IxIR2/CallReuse.lean @@ -0,0 +1,280 @@ +import Ix.Compiler.IxIR2.Reuse +import Ix.Compiler.IxIR2.CallEval +import Ix.Compiler.IxIR2.CreditFree + +/-! +# Checked shared reuse across direct calls + +The v1 pass recognizes a consuming constructor prefix followed by a nonempty +straight-line sequence of direct calls, an allocation, and a return. Reset +exposes the owned fields; moves retain the original result-register numbering. +The optional credit stays in the caller until the matching allocation. Every +accepted site retains exact syntax, last-use, and representation evidence. +-/ + +namespace Ix.Compiler.IxIR2.CallReuse + +open Ix.Compiler.Ixon (Address) + +def policy : CreditPolicy := .suspendedCallsV1 + +def policyTag : String := "shared-call-reuse/1" + +/-- Structural source facts used by the executable simulation. The ordinary +compiler produces this subset; unsupported checked input uses the baseline. -/ +def functionReady (definition : Function) : Bool := + CreditFree.function definition && + definition.blocks.all (fun block => block.creditParams.isEmpty) && + match definition.blocks[0]? with + | none => false + | some entry => entry.valueParams.size == definition.signature.params.size + +def programReady (source : Program) : Bool := + functionReady source.main && source.declarations.all (fun (_, declaration) => + match declaration with + | .fn definition => functionReady definition + | .extern _ => true) + +theorem functionReady_creditFree {definition : Function} + (ready : functionReady definition = true) : CreditFree.function definition = true := by + simp only [functionReady, Bool.and_eq_true] at ready + exact ready.1.1 + +theorem functionReady_entry {definition : Function} {entry : Block} + (ready : functionReady definition = true) (found : definition.blocks[0]? = some entry) : + entry.valueParams.size = definition.signature.params.size := by + simp only [functionReady, Bool.and_eq_true] at ready + have checked := ready.2 + simpa only [found, beq_iff_eq] using checked + +theorem functionReady_credits {definition : Function} {block : Block} {blockId : Nat} + (ready : functionReady definition = true) (found : definition.blocks[blockId]? = some block) : + block.creditParams = #[] := by + simp only [functionReady, Bool.and_eq_true] at ready + have checked := ready.1.2 + obtain ⟨bound, atBlock⟩ := Array.getElem?_eq_some_iff.mp found + have empty := Array.all_eq_true.mp checked blockId bound + simpa only [atBlock, Array.isEmpty_iff] using empty + +structure Shape where + valueParams : Array ValueCap + source : ValueId + sourceConstructor : CtorId + fieldCount : Nat + calls : Array Instr + allocationConstructor : CtorId + allocationArguments : Array Atom + result : Atom + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr + +def Shape.fetches (shape : Shape) : Array Instr := + (List.range shape.fieldCount).toArray.map fun field => + .fetch (.reg shape.source) shape.sourceConstructor field + +def Shape.retains (shape : Shape) : Array Instr := + (List.range shape.fieldCount).toArray.map fun field => + .retainShared (.reg (shape.valueParams.size + field)) + +def Shape.moves (shape : Shape) : Array Instr := + (List.range shape.fieldCount).toArray.map fun field => + .move (.reg (shape.valueParams.size + field)) + +def Shape.baseline (shape : Shape) : Block := + { valueParams := shape.valueParams + creditParams := #[] + instructions := shape.fetches ++ shape.retains ++ + #[.releaseShared (.reg shape.source)] ++ shape.calls ++ + #[.alloc .shared shape.allocationConstructor shape.allocationArguments] + terminator := .ret shape.result } + +def Shape.target (shape : Shape) : Block := + { valueParams := shape.valueParams + creditParams := #[] + instructions := #[.resetShared (.reg shape.source) shape.sourceConstructor] ++ + shape.moves ++ shape.calls ++ + #[.allocWith 0 .shared shape.allocationConstructor shape.allocationArguments] + terminator := .ret shape.result } + +/-- Reuse the established exact-layout checker, independently of its v0 +tail-call shape recognizer. -/ +def Shape.layoutInput (shape : Shape) : Reuse.Shape := + { parameterCount := shape.valueParams.size + source := shape.source + sourceConstructor := shape.sourceConstructor + fieldCount := shape.fieldCount + releasePosition := 2 * shape.fieldCount + allocationConstructor := shape.allocationConstructor + allocationArguments := shape.allocationArguments + tailArguments := #[] } + +def propose? (block : Block) : Option Shape := do + let .fetch (.reg source) sourceConstructor 0 ← block.instructions[0]? | none + let release ← block.instructions.findIdx? fun instruction => + instruction == .releaseShared (.reg source) + let fieldCount := release / 2 + let .alloc .shared allocationConstructor allocationArguments ← block.instructions.back? | none + let .ret result := block.terminator | none + return { + valueParams := block.valueParams, source, sourceConstructor, fieldCount + calls := block.instructions.extract (release + 1) (block.instructions.size - 1) + allocationConstructor, allocationArguments, result } + +structure Site (limits : Validate.Limits) (context : Validate.Context) (block : Block) where + shape : Shape + exact : block = shape.baseline + fieldsPositive : 0 < shape.fieldCount + sourceOwned : shape.valueParams[shape.source]? = some (.owned .shared) + callsNonempty : shape.calls.isEmpty = false + directCalls : shape.calls.all (Eval.Policy.DirectCall.ofInstruction? · |>.isSome) = true + placement : Reuse.Placement block + placementProduced : Reuse.inferPlacementWith limits block shape.source + (2 * shape.fieldCount) = .ok (some placement) + representation : Reuse.Representation + representationProduced : Reuse.representation? context shape.layoutInput = some representation + +def inspect (limits : Validate.Limits) (context : Validate.Context) (block : Block) : + Option (Site limits context block) := do + let shape ← propose? block + if exact : block = shape.baseline then + if fieldsPositive : 0 < shape.fieldCount then + if sourceOwned : shape.valueParams[shape.source]? = some (.owned .shared) then + if callsNonempty : shape.calls.isEmpty = false then + if directCalls : shape.calls.all + (Eval.Policy.DirectCall.ofInstruction? · |>.isSome) = true then + match placed : Reuse.inferPlacementWith limits block shape.source + (2 * shape.fieldCount) with + | .ok (some placement) => + match represented : Reuse.representation? context shape.layoutInput with + | some representation => some { + shape, exact, fieldsPositive, sourceOwned, callsNonempty, directCalls + placement, placementProduced := placed + representation, representationProduced := represented } + | none => none + | _ => none + else none + else none + else none + else none + else none + +inductive Decision (limits : Validate.Limits) (context : Validate.Context) (block : Block) where + | unchanged (rejected : inspect limits context block = none) + | accepted (site : Site limits context block) + (produced : inspect limits context block = some site) + +def decideBlock (limits : Validate.Limits) (context : Validate.Context) (block : Block) : + Decision limits context block := + match produced : inspect limits context block with + | none => .unchanged produced + | some site => .accepted site produced + +def Decision.target {limits : Validate.Limits} {context : Validate.Context} {block : Block} : + Decision limits context block → Block + | .unchanged _ => block + | .accepted site _ => site.shape.target + +def rewriteBlock (limits : Validate.Limits) (context : Validate.Context) (block : Block) : Block := + (decideBlock limits context block).target + +def rewriteFunction (limits : Validate.Limits) (context : Validate.Context) + (definition : Function) : Function := + { definition with blocks := definition.blocks.map (rewriteBlock limits context) } + +def rewriteProgram (limits : Validate.Limits) (context : Validate.Context) (source : Program) : Program := + { declarations := source.declarations.map fun (address, declaration) => + (address, match declaration with + | .fn definition => .fn (rewriteFunction limits context definition) + | .extern arity => .extern arity) + main := rewriteFunction limits context source.main } + +structure Report where + scannedBlocks : Nat := 0 + rewritten : Nat := 0 + suspendedCallSites : Nat := 0 + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +def reportBlock (limits : Validate.Limits) (context : Validate.Context) + (report : Report) (block : Block) : Report := + match inspect limits context block with + | none => { report with scannedBlocks := report.scannedBlocks + 1 } + | some site => + { scannedBlocks := report.scannedBlocks + 1 + rewritten := report.rewritten + 1 + suspendedCallSites := report.suspendedCallSites + site.shape.calls.size } + +def report (limits : Validate.Limits) (context : Validate.Context) (source : Program) : Report := + let declarations := source.declarations.foldl (fun current (_, declaration) => + match declaration with + | .extern _ => current + | .fn definition => definition.blocks.foldl (reportBlock limits context) current) {} + source.main.blocks.foldl (reportBlock limits context) declarations + +structure Output (limits : Validate.Limits) (context : Validate.Context) (source : Program) where + sourceChecked : Validate.Checked limits context source + sourceReady : programReady source = true + targetChecked : Validate.CheckedWithPolicy policy limits context + (rewriteProgram limits context source) + +def Output.target {limits : Validate.Limits} {context : Validate.Context} {source : Program} + (_output : Output limits context source) : Program := rewriteProgram limits context source + +inductive Error where + | invalidSource (error : Validate.Error) + | unsupportedSource + | invalidTarget (error : Validate.Error) + deriving Repr + +def optimizeWith (limits : Validate.Limits) (context : Validate.Context) (source : Program) : + Except Error (Output limits context source) := + match sourceAccepted : Validate.validateWith limits context source with + | .error error => .error (.invalidSource error) + | .ok sourceStats => + if sourceReady : programReady source = true then + match targetAccepted : Validate.validateWithPolicy policy limits context + (rewriteProgram limits context source) with + | .error error => .error (.invalidTarget error) + | .ok targetStats => .ok { + sourceChecked := ⟨sourceStats, sourceAccepted⟩ + sourceReady + targetChecked := ⟨targetStats, targetAccepted⟩ } + else .error .unsupportedSource + +inductive Selection (limits : Validate.Limits) (context : Validate.Context) (source : Program) where + | optimized (output : Output limits context source) + (produced : optimizeWith limits context source = .ok output) + | baseline (checked : Validate.Checked limits context source) (error : Error) + (rejected : optimizeWith limits context source = .error error) + +def Selection.target {limits : Validate.Limits} {context : Validate.Context} {source : Program} : + Selection limits context source → Program + | .optimized output _ => output.target + | .baseline _ _ _ => source + +def Selection.policy {limits : Validate.Limits} {context : Validate.Context} {source : Program} : + Selection limits context source → CreditPolicy + | .optimized _ _ => CallReuse.policy + | .baseline _ _ _ => .callLocalV0 + +def selectChecked (limits : Validate.Limits) (context : Validate.Context) (source : Program) + (checked : Validate.Checked limits context source) : Selection limits context source := + match produced : optimizeWith limits context source with + | .ok output => .optimized output produced + | .error error => .baseline checked error produced + +theorem Selection.valid {limits : Validate.Limits} {context : Validate.Context} {source : Program} + (selection : Selection limits context source) : + ∃ stats, Validate.validateWithPolicy selection.policy limits context selection.target = .ok stats := by + cases selection with + | optimized output produced => exact ⟨output.targetChecked.stats, output.targetChecked.accepted⟩ + | baseline checked error rejected => exact ⟨checked.stats, checked.accepted⟩ + +theorem rewriteFunction_signature (limits : Validate.Limits) (context : Validate.Context) + (definition : Function) : + (rewriteFunction limits context definition).signature = definition.signature := rfl + +theorem rewriteFunction_blockCount (limits : Validate.Limits) (context : Validate.Context) + (definition : Function) : + (rewriteFunction limits context definition).blocks.size = definition.blocks.size := by + simp [rewriteFunction] + +end Ix.Compiler.IxIR2.CallReuse diff --git a/Ix/Compiler/IxIR2/CallReuseApply.lean b/Ix/Compiler/IxIR2/CallReuseApply.lean new file mode 100644 index 000000000..e4ecf4490 --- /dev/null +++ b/Ix/Compiler/IxIR2/CallReuseApply.lean @@ -0,0 +1,147 @@ +import Ix.Compiler.IxIR2.CallReuseTransition + +/-! Complete partial and residual application under a growing history map. -/ + +namespace Ix.Compiler.IxIR2.CallReuse.Sim + +open Eval +open Ix.Compiler.IxIR1.Sim (RValIso RValsIso NodeBoxIso) + +structure TransferRel (limits : Validate.Limits) (validation : Validate.Context) + (context : Context) (before after : Array Nat) (leftBefore rightBefore : Store) + (leftAfter rightAfter : Machine) : Prop where + transition : HeapTransition context before after leftBefore leftAfter.store rightBefore rightAfter.store + fuel : leftAfter.heapFuel ≤ rightAfter.heapFuel + control : ControlRel limits validation after leftAfter.control rightAfter.control + +theorem HeapMap.papView {left right : Store} {mapping : Array Nat} + (heap : HeapMap left right mapping) {l r : Nat} {box : NodeBox} + {address : Ixon.Address} {arity : Nat} {captured : Array RVal} + (mapped : MapRel mapping l r) (found : left.get? l = some box) + (node : box.node = .papN address arity captured) : + ∃ targetBox targetCaptured, + right.get? r = some targetBox ∧ NodeBoxIso (MapRel mapping) box targetBox ∧ + targetBox.node = .papN address arity targetCaptured ∧ + RValsIso (MapRel mapping) captured.toList targetCaptured.toList := by + obtain ⟨targetBox, targetAt, boxes⟩ := heap.forward mapped found + have nodes := boxes.node + rw [node] at nodes + cases targetNode : targetBox.node with + | ctorN cid fields => rw [targetNode] at nodes; cases nodes + | papN targetAddress targetArity targetCaptured => + rw [targetNode] at nodes + cases nodes with + | pap captured => exact ⟨targetBox, targetCaptured, targetAt, boxes, targetNode, captured⟩ + +theorem apply_related {limits : Validate.Limits} {validation : Validate.Context} + {leftContext rightContext : Context} {mapping : Array Nat} + {leftStore rightStore : Store} {leftFuel rightFuel : Nat} + {leftFunction rightFunction : RVal} {leftArguments rightArguments : Array RVal} + {block : Block} {leftResume rightResume : Frame} {leftStack rightStack : List Continuation} + {leftAfter : Machine} + (contexts : ContextRel limits validation leftContext rightContext) + (readyContext : ContextReady leftContext) + (state : HeapState leftContext mapping leftStore rightStore) (fuel : leftFuel ≤ rightFuel) + (function : RValIso (MapRel mapping) leftFunction rightFunction) + (arguments : RValsIso (MapRel mapping) leftArguments.toList rightArguments.toList) + (resume : FrameRel limits validation mapping block leftResume rightResume) + (positive : 0 < leftResume.pc) (stack : StackRel limits validation mapping leftStack rightStack) + (transferred : ApplyTransfer leftContext .physical leftStore leftFuel leftFunction + leftArguments leftResume leftStack leftAfter) : + ∃ after rightAfter, + ApplyTransfer rightContext .physical rightStore rightFuel rightFunction + rightArguments rightResume rightStack rightAfter ∧ + TransferRel limits validation leftContext mapping after leftStore rightStore leftAfter rightAfter := by + cases transferred.classify with + | erased released => + cases function + obtain ⟨rightOut, rightRemaining, targetRun, remaining, transition⟩ := + state.releaseWork fuel arguments released + exact ⟨mapping, _, ApplyTransfer.erased targetRun, + ⟨transition, remaining, .running (resume.pushResult positive .erased) stack⟩⟩ + | @papUnder location box address arity captured retainedStore releasedStore outHeapFuel + found shared node capturedUnder retained released totalUnder => + cases function with + | @loc _ targetLocation mapped => + obtain ⟨targetBox, targetCaptured, targetAt, boxes, targetNode, capturedRel⟩ := + state.heap.papView mapped found node + obtain ⟨targetRetained, targetRetain, retaining⟩ := state.retainMany capturedRel retained + obtain ⟨targetReleased, targetFuel, targetRelease, remaining, releasing⟩ := + retaining.state.releaseWork fuel (.cons (.loc mapped) .nil) released + have total : RValsIso (MapRel mapping) (captured ++ leftArguments).toList + (targetCaptured ++ rightArguments).toList := by + simpa only [Array.toList_append] using capturedRel.append arguments + have allocating := releasing.state.alloc (world := .shared) + (leftNode := .papN address arity (captured ++ leftArguments)) (.pap total) trivial + have moved := (retaining.trans releasing).trans allocating + have newValue : RValIso (MapRel (mapping.push targetReleased.heap.nodes.size)) + (.loc releasedStore.heap.nodes.size) (.loc targetReleased.heap.nodes.size) := + .loc (by rw [← releasing.state.heap.size]; exact MapRel.fresh ..) + refine ⟨_, _, ApplyTransfer.papUnder targetAt (boxes.world.symm.trans shared) + targetNode (by rw [← values_size capturedRel]; exact capturedUnder) + targetRetain targetRelease (by rw [← values_size total]; exact totalUnder), + ⟨moved, remaining, .running (sourceBlock := block) ?_ (stack.mono allocating.extension)⟩⟩ + exact (resume.mono allocating.extension).pushResult positive newValue + | @papFn location box address arity captured retainedStore releasedStore outHeapFuel definition + found shared node capturedUnder retained released totalEnough declaration papSafe suppliedArity nonempty => + cases function with + | @loc _ targetLocation mapped => + obtain ⟨targetBox, targetCaptured, targetAt, boxes, targetNode, capturedRel⟩ := + state.heap.papView mapped found node + obtain ⟨targetRetained, targetRetain, retaining⟩ := state.retainMany capturedRel retained + obtain ⟨targetReleased, targetFuel, targetRelease, remainingFuel, releasing⟩ := + retaining.state.releaseWork fuel (.cons (.loc mapped) .nil) released + have total : RValsIso (MapRel mapping) (captured ++ leftArguments).toList + (targetCaptured ++ rightArguments).toList := by + simpa only [Array.toList_append] using capturedRel.append arguments + have supplied := values_extract total 0 arity + have residual : RValsIso (MapRel mapping) + ((captured ++ leftArguments).extract arity (captured ++ leftArguments).size).toList + ((targetCaptured ++ rightArguments).extract arity + (targetCaptured ++ rightArguments).size).toList := by + simpa only [values_size total] using values_extract total arity (captured ++ leftArguments).size + obtain ⟨entryBlock, entry⟩ := FrameRel.functionEntry (limits := limits) + (validation := validation) (readyContext declaration) supplied suppliedArity + have empty : ((captured ++ leftArguments).extract arity (captured ++ leftArguments).size).isEmpty = + ((targetCaptured ++ rightArguments).extract arity + (targetCaptured ++ rightArguments).size).isEmpty := by + simp only [Array.isEmpty, values_size residual] + refine ⟨mapping, _, ApplyTransfer.papFn targetAt (boxes.world.symm.trans shared) + targetNode (by rw [← values_size capturedRel]; exact capturedUnder) + targetRetain targetRelease (by rw [← values_size total]; exact totalEnough) + (contexts.function declaration) papSafe + (by simpa only [rewriteFunction_signature, ← values_size supplied] using suppliedArity) + (rewriteFunction_nonempty nonempty), + ⟨retaining.trans releasing, remainingFuel, .running entry (.cons ?_ stack)⟩⟩ + rw [empty] + split + · exact .resume resume positive + · exact .applyMore resume positive residual + | @papExtern location box address arity expectedArity captured retainedStore releasedStore outHeapFuel value + found shared node capturedUnder retained released totalEnough declaration suppliedArity remainingEmpty called => + cases function with + | @loc _ targetLocation mapped => + obtain ⟨targetBox, targetCaptured, targetAt, boxes, targetNode, capturedRel⟩ := + state.heap.papView mapped found node + obtain ⟨targetRetained, targetRetain, retaining⟩ := state.retainMany capturedRel retained + obtain ⟨targetReleased, targetFuel, targetRelease, remainingFuel, releasing⟩ := + retaining.state.releaseWork fuel (.cons (.loc mapped) .nil) released + have total : RValsIso (MapRel mapping) (captured ++ leftArguments).toList + (targetCaptured ++ rightArguments).toList := by + simpa only [Array.toList_append] using capturedRel.append arguments + have supplied := values_extract total 0 arity + have residual : RValsIso (MapRel mapping) + ((captured ++ leftArguments).extract arity (captured ++ leftArguments).size).toList + ((targetCaptured ++ rightArguments).extract arity + (targetCaptured ++ rightArguments).size).toList := by + simpa only [values_size total] using values_extract total arity (captured ++ leftArguments).size + obtain ⟨targetCalled, valueRel⟩ := scalarOracle_related contexts supplied called + refine ⟨mapping, _, ApplyTransfer.papExtern targetAt (boxes.world.symm.trans shared) + targetNode (by rw [← values_size capturedRel]; exact capturedUnder) + targetRetain targetRelease (by rw [← values_size total]; exact totalEnough) + (contexts.extern declaration) (by rw [← values_size supplied]; exact suppliedArity) + (by simpa only [Array.isEmpty_iff_size_eq_zero, values_size residual] using remainingEmpty) + targetCalled, + ⟨retaining.trans releasing, remainingFuel, .running (resume.pushResult positive valueRel) stack⟩⟩ + +end Ix.Compiler.IxIR2.CallReuse.Sim diff --git a/Ix/Compiler/IxIR2/CallReuseBody.lean b/Ix/Compiler/IxIR2/CallReuseBody.lean new file mode 100644 index 000000000..e218112d2 --- /dev/null +++ b/Ix/Compiler/IxIR2/CallReuseBody.lean @@ -0,0 +1,137 @@ +import Ix.Compiler.IxIR2.CallReuseShape + +/-! Suspended calls and the allocation that consumes the caller's optional credit. -/ + +namespace Ix.Compiler.IxIR2.CallReuse.Sim + +open Eval +open Ix.Compiler.IxIR1.Sim (RValIso RValsIso) + +theorem callInstruction_related {limits : Validate.Limits} {validation : Validate.Context} + {leftContext rightContext : Context} {mapping : Array Nat} + {leftStore rightStore : Store} {leftFuel rightFuel : Nat} + {block targetBlock : Block} {leftFrame rightFrame : Frame} + {leftStack rightStack : List Continuation} {call : Policy.DirectCall} {leftAfter : Machine} + (contexts : ContextRel limits validation leftContext rightContext) + (readyContext : ContextReady leftContext) + (machines : MachineRel limits validation leftContext mapping + { store := leftStore, heapFuel := leftFuel, control := .running leftFrame leftStack } + { store := rightStore, heapFuel := rightFuel, control := .running rightFrame rightStack }) + (frames : FrameRel limits validation mapping block leftFrame rightFrame) + (advanced : FrameRel limits validation mapping block + { leftFrame with pc := leftFrame.pc + 1 } { rightFrame with pc := rightFrame.pc + 1 }) + (stack : StackRel limits validation mapping leftStack rightStack) + (targetAt : rightFrame.definition.blocks[rightFrame.block]? = some targetBlock) + (targetPC : rightFrame.pc < targetBlock.instructions.size) + (targetInstruction : targetBlock.instructions[rightFrame.pc] = call.instruction) + (classified : InstructionTransferCase leftContext .physical leftStore leftFuel + leftFrame leftStack call.instruction leftAfter) : + ∃ rightAfter, + Policy.Step .suspendedCallsV1 rightContext .physical + { store := rightStore, heapFuel := rightFuel, control := .running rightFrame rightStack } rightAfter ∧ + TransferRel limits validation leftContext mapping mapping leftStore rightStore leftAfter rightAfter := by + cases call with + | function address arguments => + cases classified with + | callFn noCredits resolved declaration arity nonempty => + obtain ⟨target, stepped, related, _, targetStore⟩ := directCall_related contexts readyContext machines + frames advanced stack targetAt targetPC targetInstruction resolved + (by simp [Policy.DirectCall.definition, declaration]) arity nonempty + exact ⟨target, stepped, ⟨by simpa only [targetStore] using HeapTransition.refl machines.heapState, + related.fuel, related.control⟩⟩ + | self arguments => + cases classified with + | callSelf noCredits resolved arity nonempty => + obtain ⟨target, stepped, related, _, targetStore⟩ := directCall_related contexts readyContext machines + frames advanced stack targetAt targetPC targetInstruction resolved rfl arity nonempty + exact ⟨target, stepped, ⟨by simpa only [targetStore] using HeapTransition.refl machines.heapState, + related.fuel, related.control⟩⟩ + +theorem bodyAllocation_related {limits : Validate.Limits} {validation : Validate.Context} + {leftContext rightContext : Context} {mapping : Array Nat} + {leftStore rightStore : Store} {leftFuel rightFuel : Nat} + {block : Block} {leftFrame rightFrame : Frame} {leftStack rightStack : List Continuation} + {site : Site limits validation block} {credit : Credit} {leftAfter : Machine} + (contexts : ContextRel limits validation leftContext rightContext) + (schemas : leftContext.schemas = validation.schemas) + (machines : MachineRel limits validation leftContext mapping + { store := leftStore, heapFuel := leftFuel, control := .running leftFrame leftStack } + { store := rightStore, heapFuel := rightFuel, control := .running rightFrame rightStack }) + (frames : FrameRel limits validation mapping block leftFrame rightFrame) + (stack : StackRel limits validation mapping leftStack rightStack) + (produced : inspect limits validation block = some site) + (leftPC : leftFrame.pc = 2 * site.shape.fieldCount + 1 + site.shape.calls.size) + (rightPC : rightFrame.pc = site.shape.fieldCount + 1 + site.shape.calls.size) + (credits : rightFrame.credits = #[some credit]) + (layout : credit.layout = site.representation.layout) (physical : PhysicalCredit credit) + (classified : InstructionTransferCase leftContext .physical leftStore leftFuel leftFrame leftStack + (.alloc .shared site.shape.allocationConstructor site.shape.allocationArguments) leftAfter) : + ∃ after rightAfter, + Policy.Step .suspendedCallsV1 rightContext .physical + { store := rightStore, heapFuel := rightFuel, control := .running rightFrame rightStack } rightAfter ∧ + TransferRel limits validation leftContext mapping after leftStore rightStore leftAfter rightAfter := by + cases classified with + | @alloc _ _ _ schema values schemaAt resolved fields => + obtain ⟨sourceSchema, allocationSchema, _, allocationAt, _, _, _, allocationLayout⟩ := site.schemas + have schemaSame : schema = allocationSchema := by + rw [← schemas, schemaAt] at allocationAt + exact Option.some.inj allocationAt + subst allocationSchema + have creditLayout := layout.trans allocationLayout + have targetSchema : rightContext.schemas .shared site.shape.allocationConstructor = some schema := by + rw [← contexts.schemas] + exact schemaAt + obtain ⟨targetValues, targetResolved, valuesRel⟩ := ReuseSim.resolveAtoms_iso frames.values resolved + have targetFields := machines.heap.fieldWorlds valuesRel fields + have taken : CreditTake { rightFrame with pc := rightFrame.pc + 1 } 0 + { rightFrame with pc := rightFrame.pc + 1, credits := #[none] } credit := by + have atCredit : ({ rightFrame with pc := rightFrame.pc + 1 } : Frame).credits[0]? = + some (some credit) := by simp [credits] + simpa [credits, Array.setIfInBounds] using CreditTake.of_lookup (CreditLookup.of_getElem atCredit) + have finished := frames.finishBody produced leftPC rightPC + have positive : 0 < ({ leftFrame with pc := leftFrame.pc + 1 } : Frame).pc := by simp + have targetAt : rightFrame.definition.blocks[rightFrame.block]? = some site.shape.target := by + simpa only [rewriteBlock_accepted produced] using frames.targetAt + have targetFound : site.shape.target.instructions[rightFrame.pc]? = + some (.allocWith 0 .shared site.shape.allocationConstructor site.shape.allocationArguments) := by + rw [rightPC] + exact site.shape.target_alloc_at + obtain ⟨targetPC, targetInstruction⟩ := Array.getElem?_eq_some_iff.mp targetFound + rcases physical with absent | ⟨location, present⟩ + · have allocating := machines.heapState.alloc (world := .shared) + (leftNode := .ctorN site.shape.allocationConstructor values) (.ctor valuesRel) + ⟨schema, schemaAt, fields.size⟩ + have valueRel : RValIso (MapRel (mapping.push rightStore.heap.nodes.size)) + (.loc leftStore.heap.nodes.size) (.loc rightStore.heap.nodes.size) := + .loc (by rw [← machines.heap.size]; exact MapRel.fresh ..) + have targetCase := InstructionTransferCase.allocWithAbsent + (context := rightContext) (interpretation := .physical) (heapFuel := rightFuel) + (stack := rightStack) targetSchema targetResolved targetFields taken creditLayout absent + exact ⟨_, _, Policy.of_originalStep (targetCase.step targetAt targetPC targetInstruction), + ⟨allocating, machines.fuel, + .running ((finished.mono allocating.extension).pushResult positive valueRel) + (stack.mono allocating.extension)⟩⟩ + · have empty : rightStore.EmptySlot location := machines.reservations.empty location (by + simp [Machine.reservations, Frame.reservations, Frame.liveCredits, credits, + Credit.reservation?, present]) + have succeeds : ∃ output, rightStore.reuseReservation location .shared + (.ctorN site.shape.allocationConstructor targetValues) schema.fields.size = .ok output := by + change rightStore.heap.nodes[location]? = some none at empty + simp only [Store.reuseReservation, empty] + exact ⟨_, rfl⟩ + obtain ⟨output, reused⟩ := succeeds + have allocating := machines.heapState.reuse + (leftNode := .ctorN site.shape.allocationConstructor values) (.ctor valuesRel) + ⟨schema, schemaAt, fields.size⟩ reused + have valueRel : RValIso (MapRel (mapping.push location)) + (.loc leftStore.heap.nodes.size) (.loc location) := + .loc (by rw [← machines.heap.size]; exact MapRel.fresh ..) + have targetCase := InstructionTransferCase.allocWithPhysical + (context := rightContext) (heapFuel := rightFuel) (stack := rightStack) rfl + targetSchema targetResolved targetFields taken creditLayout present reused + exact ⟨_, _, Policy.of_originalStep (targetCase.step targetAt targetPC targetInstruction), + ⟨allocating, machines.fuel, + .running ((finished.mono allocating.extension).pushResult positive valueRel) + (stack.mono allocating.extension)⟩⟩ + +end Ix.Compiler.IxIR2.CallReuse.Sim diff --git a/Ix/Compiler/IxIR2/CallReuseCalls.lean b/Ix/Compiler/IxIR2/CallReuseCalls.lean new file mode 100644 index 000000000..9f7fb9451 --- /dev/null +++ b/Ix/Compiler/IxIR2/CallReuseCalls.lean @@ -0,0 +1,71 @@ +import Ix.Compiler.IxIR2.CallReuseControl + +/-! +# Corresponding calls with suspended caller credits + +The callee receives related ordinary arguments and an empty credit file. +The complete caller relation, including its pending credit and next program +counter, is stored once in the continuation. Heap and cost state is unchanged. +-/ + +namespace Ix.Compiler.IxIR2.CallReuse.Sim + +open Eval +open Ix.Compiler.IxIR1.Sim (RValsIso) + +theorem directCall_related {limits : Validate.Limits} {validation : Validate.Context} + {leftContext rightContext : Context} {mapping : Array Nat} + {leftStore rightStore : Store} {leftFuel rightFuel : Nat} + {block targetBlock : Block} {leftFrame rightFrame : Frame} + {leftStack rightStack : List Continuation} {call : Policy.DirectCall} + {arguments : Array RVal} {definition : Function} + (contexts : ContextRel limits validation leftContext rightContext) + (readyContext : ContextReady leftContext) + (machines : MachineRel limits validation leftContext mapping + { store := leftStore, heapFuel := leftFuel, control := .running leftFrame leftStack } + { store := rightStore, heapFuel := rightFuel, control := .running rightFrame rightStack }) + (frames : FrameRel limits validation mapping block leftFrame rightFrame) + (advanced : FrameRel limits validation mapping block + { leftFrame with pc := leftFrame.pc + 1 } { rightFrame with pc := rightFrame.pc + 1 }) + (stack : StackRel limits validation mapping leftStack rightStack) + (targetAt : rightFrame.definition.blocks[rightFrame.block]? = some targetBlock) + (targetPC : rightFrame.pc < targetBlock.instructions.size) + (targetInstruction : targetBlock.instructions[rightFrame.pc] = call.instruction) + (resolved : resolveAtoms leftFrame.values call.arguments = .ok arguments) + (found : call.definition leftContext leftFrame = .ok definition) + (arity : arguments.size = definition.signature.params.size) + (nonempty : definition.blocks.isEmpty = false) : + ∃ target, + Policy.Step .suspendedCallsV1 rightContext .physical + { store := rightStore, heapFuel := rightFuel, control := .running rightFrame rightStack } target ∧ + MachineRel limits validation leftContext mapping + { store := leftStore, heapFuel := leftFuel + control := .running { definition, values := arguments } + (.resume { leftFrame with pc := leftFrame.pc + 1 } :: leftStack) } target ∧ + CostDelta leftStore leftStore rightStore target.store ∧ target.store = rightStore := by + obtain ⟨targetArguments, targetResolved, argumentsRelated⟩ := + ReuseSim.resolveAtoms_iso frames.values resolved + have targetDefinition := directCall_definition contexts frames found + have definitionReady := directCall_ready readyContext frames.ready found + have sizes : arguments.size = targetArguments.size := by simpa using argumentsRelated.lengths + have targetArity : targetArguments.size = + (rewriteFunction limits validation definition).signature.params.size := by + simpa only [rewriteFunction_signature] using sizes.symm.trans arity + have targetNonempty := rewriteFunction_nonempty (limits := limits) (context := validation) nonempty + obtain ⟨entryBlock, entryFrames⟩ := FrameRel.functionEntry + (limits := limits) (validation := validation) definitionReady argumentsRelated arity + let target : Machine := + { store := rightStore, heapFuel := rightFuel + control := .running + { definition := rewriteFunction limits validation definition, values := targetArguments } + (.resume { rightFrame with pc := rightFrame.pc + 1 } :: rightStack) } + have stepped : Policy.Step .suspendedCallsV1 rightContext .physical + { store := rightStore, heapFuel := rightFuel, control := .running rightFrame rightStack } target := + directCall_step rfl targetAt targetPC targetInstruction targetResolved + targetDefinition targetArity targetNonempty + refine ⟨target, stepped, ?_, .refl leftStore rightStore, rfl⟩ + exact ⟨machines.heap, machines.ordered, machines.shaped, machines.fuel, + .running entryFrames (.cons (.resume advanced (by simp)) stack), + stepped.reservationOwnership machines.reservations⟩ + +end Ix.Compiler.IxIR2.CallReuse.Sim diff --git a/Ix/Compiler/IxIR2/CallReuseControl.lean b/Ix/Compiler/IxIR2/CallReuseControl.lean new file mode 100644 index 000000000..0a5b7464d --- /dev/null +++ b/Ix/Compiler/IxIR2/CallReuseControl.lean @@ -0,0 +1,370 @@ +import Ix.Compiler.IxIR2.CallReuse +import Ix.Compiler.IxIR2.CallReuseHeapShape +import Ix.Compiler.IxIR2.ReservationSteps + +/-! +# Compiler control correspondence for suspended reuse + +The pass preserves declaration addresses, block identities, and all register +numbers after its consuming prefix. A saved caller records its exact position +and optional credit until the matching allocation. Allocation history extends +all saved value correspondences without changing this control evidence. +-/ + +namespace Ix.Compiler.IxIR2.CallReuse + +theorem rewriteBlock_valueParams (limits : Validate.Limits) (context : Validate.Context) + (block : Block) : (rewriteBlock limits context block).valueParams = block.valueParams := by + unfold rewriteBlock + cases decideBlock limits context block with + | unchanged => rfl + | accepted site produced => simp only [Decision.target, Shape.target, site.exact, Shape.baseline] + +theorem rewriteBlock_creditParams (limits : Validate.Limits) (context : Validate.Context) + (block : Block) : (rewriteBlock limits context block).creditParams = block.creditParams := by + unfold rewriteBlock + cases decideBlock limits context block with + | unchanged => rfl + | accepted site produced => simp only [Decision.target, Shape.target, site.exact, Shape.baseline] + +theorem rewriteBlock_rejected {limits : Validate.Limits} {context : Validate.Context} {block : Block} + (rejected : inspect limits context block = none) : rewriteBlock limits context block = block := by + unfold rewriteBlock decideBlock + split + · rfl + · rename_i site found + rw [rejected] at found + cases found + +theorem rewriteBlock_accepted {limits : Validate.Limits} {context : Validate.Context} {block : Block} + {site : Site limits context block} (produced : inspect limits context block = some site) : + rewriteBlock limits context block = site.shape.target := by + unfold rewriteBlock decideBlock + split + · rename_i missing + rw [produced] at missing + cases missing + · rename_i foundSite found + have same := Option.some.inj (found.symm.trans produced) + subst foundSite + rfl + +theorem rewriteFunction_block {limits : Validate.Limits} {context : Validate.Context} + {definition : Function} {block : Block} {blockId : Nat} + (found : definition.blocks[blockId]? = some block) : + (rewriteFunction limits context definition).blocks[blockId]? = + some (rewriteBlock limits context block) := by + simp [rewriteFunction, Array.getElem?_map, found] + +theorem rewriteFunction_nonempty {limits : Validate.Limits} {context : Validate.Context} + {definition : Function} (nonempty : definition.blocks.isEmpty = false) : + (rewriteFunction limits context definition).blocks.isEmpty = false := by + simpa [rewriteFunction] using nonempty + +namespace Sim + +open Eval +open Ix.Compiler.Ixon (Address) +open Ix.Compiler.IxIR1.Sim (RValIso RValsIso) + +def rewriteDecl (limits : Validate.Limits) (validation : Validate.Context) : Decl → Decl + | .fn definition => .fn (rewriteFunction limits validation definition) + | .extern arity => .extern arity + +structure ContextRel (limits : Validate.Limits) (validation : Validate.Context) + (left right : Context) : Prop where + schemas : left.schemas = right.schemas + oracle : left.oracle = right.oracle + declarations : ∀ address, right.declarations address = + (left.declarations address).map (rewriteDecl limits validation) + +theorem ContextRel.ofProgram (limits : Validate.Limits) (validation : Validate.Context) + (source : Program) (oracle : Address → List RVal → Option RVal := fun _ _ => none) : + ContextRel limits validation (Context.ofProgram source validation.schemas oracle) + (Context.ofProgram (rewriteProgram limits validation source) validation.schemas oracle) := by + refine ⟨rfl, rfl, ?_⟩ + intro address + simp only [Context.ofProgram, rewriteProgram, List.find?_map, Option.map_map, + Function.comp_def] + rfl + +theorem ContextRel.function {limits : Validate.Limits} {validation : Validate.Context} + {left right : Context} (contexts : ContextRel limits validation left right) + {address : Address} {definition : Function} (found : left.declarations address = some (.fn definition)) : + right.declarations address = some (.fn (rewriteFunction limits validation definition)) := by + rw [contexts.declarations, found] + rfl + +theorem ContextRel.extern {limits : Validate.Limits} {validation : Validate.Context} + {left right : Context} (contexts : ContextRel limits validation left right) + {address : Address} {arity : Nat} (found : left.declarations address = some (.extern arity)) : + right.declarations address = some (.extern arity) := by + rw [contexts.declarations, found] + rfl + +def ContextReady (context : Context) : Prop := + ∀ {address definition}, context.declarations address = some (.fn definition) → + functionReady definition = true + +theorem programReady_context {source : Program} {schemas oracle} + (ready : programReady source = true) : ContextReady (Context.ofProgram source schemas oracle) := by + intro address definition found + simp only [programReady, Bool.and_eq_true] at ready + simp only [Context.ofProgram] at found + cases lookup : source.declarations.find? (fun entry => entry.1 == address) with + | none => simp [lookup] at found + | some entry => + simp only [lookup, Option.map_some, Option.some.injEq] at found + have member := List.mem_of_find?_eq_some lookup + have checked := List.all_eq_true.mp ready.2 entry member + simpa only [found] using checked + +def PhysicalCredit (credit : Credit) : Prop := + credit.presence = .absent ∨ ∃ location, credit.presence = .present (some location) + +/-- Stable points before a consuming prefix and after its release. Calls in +the body retain the same one-element credit file in their saved caller. -/ +inductive Position (limits : Validate.Limits) (validation : Validate.Context) (block : Block) : + Nat → Nat → Array (Option Credit) → Prop where + | unchanged {pc : Nat} {credits : Array (Option Credit)} + (rejected : inspect limits validation block = none) + (cleared : credits.any Option.isSome = false) : Position limits validation block pc pc credits + | entry (site : Site limits validation block) + (produced : inspect limits validation block = some site) : + Position limits validation block 0 0 #[] + | body (site : Site limits validation block) + (produced : inspect limits validation block = some site) + (offset : Nat) (within : offset ≤ site.shape.calls.size) (credit : Credit) + (layout : credit.layout = site.representation.layout) (physical : PhysicalCredit credit) : + Position limits validation block (2 * site.shape.fieldCount + 1 + offset) + (site.shape.fieldCount + 1 + offset) #[some credit] + | finished (site : Site limits validation block) + (produced : inspect limits validation block = some site) : + Position limits validation block (2 * site.shape.fieldCount + site.shape.calls.size + 2) + (site.shape.fieldCount + site.shape.calls.size + 2) #[none] + +structure FrameRel (limits : Validate.Limits) (validation : Validate.Context) (mapping : Array Nat) + (sourceBlock : Block) (left right : Frame) : Prop where + definition : right.definition = rewriteFunction limits validation left.definition + ready : functionReady left.definition = true + blockId : right.block = left.block + sourceAt : left.definition.blocks[left.block]? = some sourceBlock + values : RValsIso (MapRel mapping) left.values.toList right.values.toList + leftCredits : left.credits = #[] + position : Position limits validation sourceBlock left.pc right.pc right.credits + entryCount : left.pc = 0 → left.values.size = sourceBlock.valueParams.size + +theorem FrameRel.targetAt {limits : Validate.Limits} {validation : Validate.Context} + {mapping : Array Nat} {sourceBlock : Block} {left right : Frame} + (frames : FrameRel limits validation mapping sourceBlock left right) : + right.definition.blocks[right.block]? = some (rewriteBlock limits validation sourceBlock) := by + rw [frames.definition, frames.blockId] + exact rewriteFunction_block frames.sourceAt + +theorem FrameRel.mono {limits : Validate.Limits} {validation : Validate.Context} + {before after : Array Nat} {sourceBlock : Block} {left right : Frame} + (frames : FrameRel limits validation before sourceBlock left right) + (lift : ∀ {l r}, MapRel before l r → MapRel after l r) : + FrameRel limits validation after sourceBlock left right := + { frames with values := frames.values.mono lift } + +theorem Position.atEntry (limits : Validate.Limits) (validation : Validate.Context) (block : Block) : + Position limits validation block 0 0 #[] := by + cases decideBlock limits validation block with + | unchanged rejected => exact .unchanged rejected (by simp) + | accepted site produced => exact .entry site produced + +theorem FrameRel.atEntry {limits : Validate.Limits} {validation : Validate.Context} + {mapping : Array Nat} {definition : Function} {block : Block} {blockId : Nat} + {leftValues rightValues : Array RVal} (ready : functionReady definition = true) + (found : definition.blocks[blockId]? = some block) + (values : RValsIso (MapRel mapping) leftValues.toList rightValues.toList) + (arity : leftValues.size = block.valueParams.size) : + FrameRel limits validation mapping block + { definition, block := blockId, values := leftValues } + { definition := rewriteFunction limits validation definition, block := blockId, values := rightValues } := + ⟨rfl, ready, rfl, found, values, rfl, Position.atEntry .., fun _ => arity⟩ + +theorem FrameRel.functionEntry {limits : Validate.Limits} {validation : Validate.Context} + {mapping : Array Nat} {definition : Function} {leftValues rightValues : Array RVal} + (ready : functionReady definition = true) + (values : RValsIso (MapRel mapping) leftValues.toList rightValues.toList) + (arity : leftValues.size = definition.signature.params.size) : + ∃ block, FrameRel limits validation mapping block + { definition, values := leftValues } + { definition := rewriteFunction limits validation definition, values := rightValues } := by + cases found : definition.blocks[0]? with + | none => simp [functionReady, found] at ready + | some block => + exact ⟨block, FrameRel.atEntry ready found values + (arity.trans (functionReady_entry ready found).symm)⟩ + +theorem FrameRel.pushResult {limits : Validate.Limits} {validation : Validate.Context} + {mapping : Array Nat} {block : Block} {left right : Frame} {leftValue rightValue : RVal} + (frames : FrameRel limits validation mapping block left right) (positive : 0 < left.pc) + (value : RValIso (MapRel mapping) leftValue rightValue) : + FrameRel limits validation mapping block + { left with values := left.values.push leftValue } + { right with values := right.values.push rightValue } := + { frames with + values := by simpa only [Array.toList_push] using frames.values.append (.cons value .nil) + entryCount := by intro zero; simp only at zero; omega } + +theorem Position.unchanged_parts {limits : Validate.Limits} {validation : Validate.Context} + {block : Block} {leftPC rightPC : Nat} {credits : Array (Option Credit)} + (position : Position limits validation block leftPC rightPC credits) + (rejected : inspect limits validation block = none) : + leftPC = rightPC ∧ credits.any Option.isSome = false := by + cases position with + | unchanged missing cleared => exact ⟨rfl, cleared⟩ + | entry site produced => rw [rejected] at produced; cases produced + | body site produced offset within credit layout physical => rw [rejected] at produced; cases produced + | finished site produced => rw [rejected] at produced; cases produced + +theorem FrameRel.unchanged {limits : Validate.Limits} {validation : Validate.Context} + {mapping : Array Nat} {block : Block} {left right : Frame} + (frames : FrameRel limits validation mapping block left right) + (rejected : inspect limits validation block = none) : left.pc = right.pc ∧ NoLiveCredits right := + frames.position.unchanged_parts rejected + +theorem FrameRel.advanceUnchanged {limits : Validate.Limits} {validation : Validate.Context} + {mapping : Array Nat} {block : Block} {left right : Frame} + (frames : FrameRel limits validation mapping block left right) + (rejected : inspect limits validation block = none) : + FrameRel limits validation mapping block { left with pc := left.pc + 1 } { right with pc := right.pc + 1 } := by + obtain ⟨pc, cleared⟩ := frames.unchanged rejected + exact { frames with + position := by rw [pc]; exact .unchanged rejected cleared + entryCount := by intro zero; simp only at zero; omega } + +inductive ContinuationRel (limits : Validate.Limits) (validation : Validate.Context) (mapping : Array Nat) : + Continuation → Continuation → Prop where + | resume {sourceBlock : Block} {left right : Frame} + (frames : FrameRel limits validation mapping sourceBlock left right) + (afterInstruction : 0 < left.pc) : + ContinuationRel limits validation mapping (.resume left) (.resume right) + | applyMore {sourceBlock : Block} {left right : Frame} {leftArguments rightArguments : Array RVal} + (frames : FrameRel limits validation mapping sourceBlock left right) (afterInstruction : 0 < left.pc) + (arguments : RValsIso (MapRel mapping) leftArguments.toList rightArguments.toList) : + ContinuationRel limits validation mapping (.applyMore leftArguments left) (.applyMore rightArguments right) + +inductive StackRel (limits : Validate.Limits) (validation : Validate.Context) (mapping : Array Nat) : + List Continuation → List Continuation → Prop where + | nil : StackRel limits validation mapping [] [] + | cons {left right : Continuation} {lefts rights : List Continuation} + (head : ContinuationRel limits validation mapping left right) + (tail : StackRel limits validation mapping lefts rights) : + StackRel limits validation mapping (left :: lefts) (right :: rights) + +theorem ContinuationRel.mono {limits : Validate.Limits} {validation : Validate.Context} + {before after : Array Nat} {left right : Continuation} + (related : ContinuationRel limits validation before left right) + (lift : ∀ {l r}, MapRel before l r → MapRel after l r) : + ContinuationRel limits validation after left right := by + cases related with + | resume frames positive => exact .resume (frames.mono lift) positive + | applyMore frames positive arguments => exact .applyMore (frames.mono lift) positive (arguments.mono lift) + +theorem StackRel.mono {limits : Validate.Limits} {validation : Validate.Context} + {before after : Array Nat} {left right : List Continuation} + (related : StackRel limits validation before left right) + (lift : ∀ {l r}, MapRel before l r → MapRel after l r) : StackRel limits validation after left right := by + induction related with + | nil => exact .nil + | cons head tail ih => exact .cons (head.mono lift) ih + +inductive ControlRel (limits : Validate.Limits) (validation : Validate.Context) (mapping : Array Nat) : + Control → Control → Prop where + | halted {left right : RVal} (values : RValIso (MapRel mapping) left right) : + ControlRel limits validation mapping (.halted left) (.halted right) + | running {sourceBlock : Block} {left right : Frame} {leftStack rightStack : List Continuation} + (frames : FrameRel limits validation mapping sourceBlock left right) + (stack : StackRel limits validation mapping leftStack rightStack) : + ControlRel limits validation mapping (.running left leftStack) (.running right rightStack) + +structure MachineRel (limits : Validate.Limits) (validation : Validate.Context) (sourceContext : Context) + (mapping : Array Nat) (left right : Machine) : Prop where + heap : HeapMap left.store right.store mapping + ordered : Ordered left.store + shaped : Shaped sourceContext left.store + fuel : left.heapFuel ≤ right.heapFuel + control : ControlRel limits validation mapping left.control right.control + reservations : right.ReservationOwnership + +theorem initialMachine_related {limits : Validate.Limits} {validation : Validate.Context} + {sourceContext : Context} {definition : Function} {heapFuel : Nat} + (ready : functionReady definition = true) (arity : definition.signature.params.size = 0) : + MachineRel limits validation sourceContext #[] + (initialMachine definition #[] heapFuel) + (initialMachine (rewriteFunction limits validation definition) #[] heapFuel) := by + obtain ⟨block, frames⟩ := FrameRel.functionEntry (limits := limits) (validation := validation) + (mapping := #[]) ready (RValsIso.nil) arity.symm + exact ⟨HeapMap.empty, Ordered.empty, NodeProperty.empty _, Nat.le_refl _, + .running frames .nil, Policy.initialMachine_reservationOwnership ..⟩ + +theorem directCall_definition {limits : Validate.Limits} {validation : Validate.Context} + {leftContext rightContext : Context} {mapping : Array Nat} {block : Block} + {left right : Frame} (contexts : ContextRel limits validation leftContext rightContext) + (frames : FrameRel limits validation mapping block left right) + {call : Policy.DirectCall} {definition : Function} + (found : call.definition leftContext left = .ok definition) : + call.definition rightContext right = .ok (rewriteFunction limits validation definition) := by + cases call with + | self arguments => + simp only [Policy.DirectCall.definition, Except.ok.injEq] at found + subst definition + simp only [Policy.DirectCall.definition, frames.definition] + | function address arguments => + cases declared : leftContext.declarations address with + | none => simp [Policy.DirectCall.definition, declared] at found + | some declaration => + cases declaration with + | extern arity => simp [Policy.DirectCall.definition, declared] at found + | fn callee => + simp only [Policy.DirectCall.definition, declared, Except.ok.injEq] at found + subst callee + simp only [Policy.DirectCall.definition, contexts.function declared] + +theorem directCall_ready {context : Context} (readyContext : ContextReady context) + {frame : Frame} (ready : functionReady frame.definition = true) + {call : Policy.DirectCall} {definition : Function} + (found : call.definition context frame = .ok definition) : functionReady definition = true := by + cases call with + | self arguments => + simp only [Policy.DirectCall.definition, Except.ok.injEq] at found + exact found ▸ ready + | function address arguments => + cases declared : context.declarations address with + | none => simp [Policy.DirectCall.definition, declared] at found + | some declaration => + cases declaration with + | extern arity => simp [Policy.DirectCall.definition, declared] at found + | fn callee => + simp only [Policy.DirectCall.definition, declared, Except.ok.injEq] at found + subst callee + exact readyContext declared + +theorem directCall_step {context : Context} {interpretation : Interpretation} {machine : Machine} + {frame : Frame} {stack : List Continuation} {block : Block} {call : Policy.DirectCall} + {values : Array RVal} {definition : Function} + (running : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = call.instruction) + (resolved : resolveAtoms frame.values call.arguments = .ok values) + (found : call.definition context frame = .ok definition) + (arity : values.size = definition.signature.params.size) + (nonempty : definition.blocks.isEmpty = false) : + Policy.Step .suspendedCallsV1 context interpretation machine + { machine with + control := .running { definition, values } + (.resume { frame with pc := frame.pc + 1 } :: stack) } := by + have atCall : Policy.directCall? frame = some call := by + rw [Policy.directCall?_atInstruction blockAt pc instruction] + cases call <;> rfl + simp only [Policy.Step, Policy.step, running, atCall] + exact Policy.suspendCall_iff.mpr ⟨values, definition, resolved, found, arity, nonempty, rfl⟩ + +end Sim + +end Ix.Compiler.IxIR2.CallReuse diff --git a/Ix/Compiler/IxIR2/CallReuseHeapShape.lean b/Ix/Compiler/IxIR2/CallReuseHeapShape.lean new file mode 100644 index 000000000..6b84a9138 --- /dev/null +++ b/Ix/Compiler/IxIR2/CallReuseHeapShape.lean @@ -0,0 +1,208 @@ +import Ix.Compiler.IxIR2.CallReuseOrder + +/-! +# Runtime constructor shapes from baseline allocation + +Reference-count changes and destruction preserve every surviving node's +world and payload. Constructor allocation obtains its payload length from +the evaluator's successful field check. +-/ + +namespace Ix.Compiler.IxIR2.CallReuse.Sim + +open Ix.Compiler.IxIR2.Eval +open Ix.Compiler.Ixon (Owned) +open Ix.Compiler.IxIR1.Sim (RValsIso) + +structure NodeProperty (property : Owned → Node → Prop) (store : Store) : Prop where + holds : ∀ {location box}, store.get? location = some box → property box.world box.node + +namespace NodeProperty + +theorem empty (property : Owned → Node → Prop) : NodeProperty property ({} : Store) := by + constructor + intro location box found + simp [Store.get?, IxIR1.Store.get?] at found + +theorem congr {property : Owned → Node → Prop} {left right : Store} + (valid : NodeProperty property left) (nodes : right.heap.nodes = left.heap.nodes) : + NodeProperty property right := by + constructor + intro location box found + exact valid.holds (by simpa only [Store.get?, IxIR1.Store.get?, nodes] using found) + +theorem rcTick {property : Owned → Node → Prop} {store : Store} + (valid : NodeProperty property store) : NodeProperty property store.rcTick := ⟨valid.holds⟩ + +theorem setRc {property : Owned → Node → Prop} {store : Store} {location rc : Nat} + {box : NodeBox} (valid : NodeProperty property store) (found : store.get? location = some box) : + NodeProperty property (store.setBox location { box with rc }) := by + constructor + intro other otherBox after + by_cases same : location = other + · subst other + have updated := IxIR1.Sim.get?_setBox_same (new := { box with rc }) found + have equal : otherBox = { box with rc } := Option.some.inj (after.symm.trans updated) + subst otherBox + exact valid.holds (box := box) found + · exact valid.holds (IxIR1.Sim.get?_of_setBox_other same found after) + +theorem kill {property : Owned → Node → Prop} {store : Store} {location : Nat} {box : NodeBox} + (valid : NodeProperty property store) (found : store.get? location = some box) : + NodeProperty property (store.kill location) := by + constructor + intro other otherBox after + by_cases same : location = other + · subst other + have missing := IxIR1.Sim.get?_kill_same found + change (store.heap.kill location).get? location = some otherBox at after + rw [missing] at after + cases after + · exact valid.holds (IxIR1.Sim.get?_of_kill_other same found after) + +theorem alloc {property : Owned → Node → Prop} {store : Store} {world : Owned} {node : Node} + (valid : NodeProperty property store) (new : property world node) : + NodeProperty property (store.allocNode world node).1 := by + constructor + intro location box found + by_cases fresh : location = store.heap.nodes.size + · subst location + have atNew := IxIR1.Sim.HeapIso.get?_allocNode_new store.heap world node + have same : box = ⟨world, 1, node⟩ := Option.some.inj (found.symm.trans atNew) + subst box + exact new + · exact valid.holds (IxIR1.Sim.HeapIso.get?_of_allocNode_old fresh found) + +theorem retain {property : Owned → Node → Prop} {store output : Store} {value : RVal} + (valid : NodeProperty property store) (run : retainShared store value = .ok output) : + NodeProperty property output := by + cases value with + | lit => cases run; exact valid + | erased => cases run; exact valid + | loc location => + cases found : store.get? location with + | none => simp [retainShared, found] at run + | some box => + by_cases shared : box.world = .shared + · simp only [retainShared, found, shared, bne_self_eq_false, Bool.false_eq_true, + ↓reduceIte, Except.ok.injEq] at run + subst output + simpa only [shared] using (valid.setRc (rc := box.rc + 1) found).rcTick + · simp [retainShared, found, shared] at run + +theorem retainMany {property : Owned → Node → Prop} {store output : Store} {values : Array RVal} + (valid : NodeProperty property store) (run : RetainSharedMany store values output) : + NodeProperty property output := by + have loop : ∀ (values : List RVal) {store output : Store}, NodeProperty property store → + values.foldlM retainShared store = .ok output → NodeProperty property output := by + intro values + induction values with + | nil => intro store output valid run; cases run; exact valid + | cons head tail ih => + intro store output valid run + rw [List.foldlM_cons] at run + cases first : retainShared store head with + | error error => simp [first, bind, Except.bind] at run + | ok middle => + simp only [first, bind, Except.bind] at run + exact ih (valid.retain first) run + change values.foldlM retainShared store = .ok output at run + rw [← Array.foldlM_toList] at run + exact loop values.toList valid run + +theorem releaseWork {property : Owned → Node → Prop} {fuel remaining : Nat} + {store output : Store} {values : List RVal} (valid : NodeProperty property store) + (run : releaseSharedWork fuel store values = .ok (output, remaining)) : + NodeProperty property output := by + induction fuel generalizing store values with + | zero => + cases values with + | nil => cases run; exact valid + | cons value rest => simp [releaseSharedWork] at run + | succ fuel ih => + cases values with + | nil => cases run; exact valid + | cons value rest => + cases value with + | lit => exact ih valid run + | erased => exact ih valid run + | loc location => + cases found : store.get? location with + | none => simp [releaseSharedWork, found] at run + | some box => + by_cases shared : box.world = .shared + · by_cases zero : box.rc = 0 + · simp [releaseSharedWork, found, shared, zero] at run + · by_cases unitRC : box.rc = 1 + · simp only [releaseSharedWork, found, shared, bne_self_eq_false, + Bool.false_eq_true, ↓reduceIte, unitRC, beq_self_eq_true] at run + exact ih (valid.rcTick.kill found) run + · simp [releaseSharedWork, found, shared, zero, unitRC] at run + exact ih (valid.rcTick.setRc (rc := box.rc - 1) found) + (by simpa only [shared] using run) + · simp [releaseSharedWork, found, shared] at run + +theorem dropWork {property : Owned → Node → Prop} {fuel remaining : Nat} + {store output : Store} {values : List RVal} (valid : NodeProperty property store) + (run : dropUniqueWork fuel store values = .ok (output, remaining)) : + NodeProperty property output := by + induction fuel generalizing store values with + | zero => + cases values with + | nil => cases run; exact valid + | cons value rest => simp [dropUniqueWork] at run + | succ fuel ih => + cases values with + | nil => cases run; exact valid + | cons value rest => + cases value with + | lit => exact ih valid run + | erased => exact ih valid run + | loc location => + cases found : store.get? location with + | none => simp [dropUniqueWork, found] at run + | some box => + by_cases unique : box.world = .unique + · cases node : box.node with + | papN address arity arguments => simp [dropUniqueWork, found, unique, node] at run + | ctorN cid fields => + simp only [dropUniqueWork, found, unique, bne_self_eq_false, + Bool.false_eq_true, ↓reduceIte, node] at run + exact ih (valid.kill found) run + · simp [dropUniqueWork, found, unique] at run + +end NodeProperty + +def ShapedNode (context : Context) (world : Owned) : Node → Prop + | .ctorN cid fields => ∃ schema, context.schemas world cid = some schema ∧ + fields.size = schema.fields.size + | .papN .. => True + +abbrev Shaped (context : Context) (store : Store) : Prop := + NodeProperty (ShapedNode context) store + +theorem Shaped.fields {context : Context} {store : Store} {location : Nat} + {box : NodeBox} {world : Owned} {cid : CtorId} {fields : Array RVal} {schema : CtorSchema} + (shaped : Shaped context store) (view : ConstructorView store location world cid box fields) + (schemaAt : context.schemas world cid = some schema) : fields.size = schema.fields.size := by + obtain ⟨found, boxWorld, node⟩ := view.parts + have shape := shaped.holds found + rw [boxWorld, node] at shape + obtain ⟨actualSchema, actualAt, sizes⟩ := shape + have equal := Option.some.inj (actualAt.symm.trans schemaAt) + subst actualSchema + exact sizes + +theorem HeapMap.fieldWorlds {left right : Store} {mapping : Array Nat} + (heap : HeapMap left right mapping) {leftValues rightValues : Array RVal} {schema : CtorSchema} + (related : RValsIso (MapRel mapping) leftValues.toList rightValues.toList) + (checked : FieldWorlds left schema leftValues) : FieldWorlds right schema rightValues := by + have forward : ∀ {lefts rights : List RVal}, RValsIso (MapRel mapping) lefts rights → + FieldValuesWorldForward left right lefts rights := by + intro lefts rights related + induction related with + | nil => exact .nil + | cons head tail ih => exact .cons (fun _ valid => heap.hasWorld head valid) ih + exact checked.forward (forward related) + +end Ix.Compiler.IxIR2.CallReuse.Sim diff --git a/Ix/Compiler/IxIR2/CallReuseInstructions.lean b/Ix/Compiler/IxIR2/CallReuseInstructions.lean new file mode 100644 index 000000000..876a6b62c --- /dev/null +++ b/Ix/Compiler/IxIR2/CallReuseInstructions.lean @@ -0,0 +1,151 @@ +import Ix.Compiler.IxIR2.CallReuseApply + +/-! Forward simulation of every ordinary instruction in an unchanged block. -/ + +namespace Ix.Compiler.IxIR2.CallReuse.Sim + +open Eval +open Ix.Compiler.IxIR1.Sim (RValIso RValsIso) + +theorem values_scalar {mapping : Array Nat} {left right : Array RVal} + (related : RValsIso (MapRel mapping) left.toList right.toList) : + left.all RVal.isScalar = right.all RVal.isScalar := by + rw [← Array.all_toList, ← Array.all_toList] + generalize left.toList = leftList at related ⊢ + generalize right.toList = rightList at related ⊢ + induction related with + | nil => rfl + | cons head tail ih => cases head <;> simp only [List.all_cons, RVal.isScalar, ih] + +theorem instruction_related {limits : Validate.Limits} {validation : Validate.Context} + {leftContext rightContext : Context} {mapping : Array Nat} + {leftStore rightStore : Store} {leftFuel rightFuel : Nat} + {block : Block} {leftFrame rightFrame : Frame} {leftStack rightStack : List Continuation} + {instruction : Instr} {leftAfter : Machine} + (contexts : ContextRel limits validation leftContext rightContext) + (readyContext : ContextReady leftContext) + (state : HeapState leftContext mapping leftStore rightStore) (fuel : leftFuel ≤ rightFuel) + (frames : FrameRel limits validation mapping block leftFrame rightFrame) + (stack : StackRel limits validation mapping leftStack rightStack) + (rejected : inspect limits validation block = none) + (free : CreditFree.instruction instruction = true) + (classified : InstructionTransferCase leftContext .physical leftStore leftFuel leftFrame + leftStack instruction leftAfter) : + ∃ after rightAfter, + InstructionTransferCase rightContext .physical rightStore rightFuel rightFrame + rightStack instruction rightAfter ∧ + TransferRel limits validation leftContext mapping after leftStore rightStore leftAfter rightAfter := by + have advanced := frames.advanceUnchanged rejected + have positive : 0 < ({ leftFrame with pc := leftFrame.pc + 1 } : Frame).pc := by simp + have cleared := (frames.unchanged rejected).2 + cases classified <;> try simp only [CreditFree.instruction, Bool.false_eq_true] at free + case move atom value resolved => + obtain ⟨targetValue, targetResolved, valueRel⟩ := ReuseSim.resolveAtom_iso frames.values resolved + exact ⟨mapping, _, .move targetResolved, + ⟨.refl state, fuel, .running (advanced.pushResult positive valueRel) stack⟩⟩ + case alloc world cid arguments schema values schemaAt resolved fields => + obtain ⟨targetValues, targetResolved, valuesRel⟩ := ReuseSim.resolveAtoms_iso frames.values resolved + have allocating := state.alloc (world := world) (leftNode := .ctorN cid values) + (.ctor valuesRel) ⟨schema, schemaAt, fields.size⟩ + have valueRel : RValIso (MapRel (mapping.push rightStore.heap.nodes.size)) + (.loc leftStore.heap.nodes.size) (.loc rightStore.heap.nodes.size) := + .loc (by rw [← state.heap.size]; exact MapRel.fresh ..) + exact ⟨_, _, .alloc (by rw [← contexts.schemas]; exact schemaAt) + targetResolved (state.heap.fieldWorlds valuesRel fields), + ⟨allocating, fuel, .running ((advanced.mono allocating.extension).pushResult positive valueRel) + (stack.mono allocating.extension)⟩⟩ + case retainShared atom value output resolved retained => + obtain ⟨targetValue, targetResolved, valueRel⟩ := ReuseSim.resolveAtom_iso frames.values resolved + obtain ⟨targetOutput, targetRetain, retaining⟩ := state.retain valueRel retained + exact ⟨mapping, _, .retainShared targetResolved targetRetain, + ⟨retaining, fuel, .running (advanced.pushResult positive valueRel) stack⟩⟩ + case releaseShared atom value output remaining resolved released => + obtain ⟨targetValue, targetResolved, valueRel⟩ := ReuseSim.resolveAtom_iso frames.values resolved + obtain ⟨targetOutput, targetFuel, targetRelease, remainingFuel, releasing⟩ := + state.releaseWork fuel (.cons valueRel .nil) released + exact ⟨mapping, _, .releaseShared targetResolved targetRelease, + ⟨releasing, remainingFuel, .running advanced stack⟩⟩ + case dropUnique atom value output remaining resolved dropped => + obtain ⟨targetValue, targetResolved, valueRel⟩ := ReuseSim.resolveAtom_iso frames.values resolved + obtain ⟨targetOutput, targetFuel, targetDrop, remainingFuel, dropping⟩ := + state.dropWork fuel (.cons valueRel .nil) dropped + exact ⟨mapping, _, .dropUnique targetResolved targetDrop, + ⟨dropping, remainingFuel, .running advanced stack⟩⟩ + case freeUnique atom cid location box fields resolved viewed scalarFields => + obtain ⟨targetValue, targetResolved, valueRel⟩ := ReuseSim.resolveAtom_iso frames.values resolved + cases valueRel with + | @loc _ targetLocation mapped => + obtain ⟨targetBox, targetFields, targetView, boxes, fieldsRel⟩ := + state.heap.constructorView mapped viewed + exact ⟨mapping, _, .freeUnique targetResolved targetView + (by rw [← values_scalar fieldsRel]; exact scalarFields), + ⟨state.freeUnique mapped viewed.parts.1, fuel, .running advanced stack⟩⟩ + case fetch atom cid field location box fields value resolved boxAt node fieldAt => + obtain ⟨targetValue, targetResolved, valueRel⟩ := ReuseSim.resolveAtom_iso frames.values resolved + cases valueRel with + | @loc _ targetLocation mapped => + obtain ⟨targetBox, targetFields, targetView, boxes, fieldsRel⟩ := + state.heap.constructorView mapped (ConstructorView.of_box boxAt rfl node) + obtain ⟨targetField, targetFieldAt, fieldRel⟩ := fieldsRel.get? (by simpa using fieldAt) + exact ⟨mapping, _, .fetch targetResolved targetView.parts.1 targetView.parts.2.2 + (by simpa using targetFieldAt), + ⟨.refl state, fuel, .running (advanced.pushResult positive fieldRel) stack⟩⟩ + case callFn address atoms arguments definition noCredits resolved declaration arity nonempty => + obtain ⟨targetArguments, targetResolved, argumentsRel⟩ := ReuseSim.resolveAtoms_iso frames.values resolved + obtain ⟨entryBlock, entry⟩ := FrameRel.functionEntry (limits := limits) + (validation := validation) (readyContext declaration) argumentsRel arity + exact ⟨mapping, _, .callFn cleared targetResolved (contexts.function declaration) + (by simpa only [rewriteFunction_signature, ← values_size argumentsRel] using arity) + (rewriteFunction_nonempty nonempty), + ⟨.refl state, fuel, .running entry (.cons (.resume advanced positive) stack)⟩⟩ + case callSelf atoms arguments noCredits resolved arity nonempty => + obtain ⟨targetArguments, targetResolved, argumentsRel⟩ := ReuseSim.resolveAtoms_iso frames.values resolved + obtain ⟨entryBlock, entry⟩ := FrameRel.functionEntry (limits := limits) + (validation := validation) frames.ready argumentsRel arity + have targetArity : targetArguments.size = rightFrame.definition.signature.params.size := by + simpa only [frames.definition, rewriteFunction_signature, ← values_size argumentsRel] using arity + have targetNonempty : rightFrame.definition.blocks.isEmpty = false := by + simpa only [frames.definition] using rewriteFunction_nonempty (limits := limits) + (context := validation) nonempty + refine ⟨mapping, _, .callSelf cleared targetResolved targetArity targetNonempty, + ⟨.refl state, fuel, .running (sourceBlock := entryBlock) ?_ + (.cons (.resume advanced positive) stack)⟩⟩ + simpa only [frames.definition] using entry + case pappFn address atoms arguments definition noCredits declaration papSafe resolved under => + obtain ⟨targetArguments, targetResolved, argumentsRel⟩ := ReuseSim.resolveAtoms_iso frames.values resolved + have allocating := state.alloc (world := .shared) + (leftNode := .papN address definition.signature.params.size arguments) (.pap argumentsRel) trivial + have valueRel : RValIso (MapRel (mapping.push rightStore.heap.nodes.size)) + (.loc leftStore.heap.nodes.size) (.loc rightStore.heap.nodes.size) := + .loc (by rw [← state.heap.size]; exact MapRel.fresh ..) + exact ⟨_, _, .pappFn cleared (contexts.function declaration) papSafe targetResolved + (by simpa only [rewriteFunction_signature, ← values_size argumentsRel] using under), + ⟨allocating, fuel, .running ((advanced.mono allocating.extension).pushResult positive valueRel) + (stack.mono allocating.extension)⟩⟩ + case pappExtern address atoms arguments arity noCredits declaration resolved under => + obtain ⟨targetArguments, targetResolved, argumentsRel⟩ := ReuseSim.resolveAtoms_iso frames.values resolved + have allocating := state.alloc (world := .shared) + (leftNode := .papN address arity arguments) (.pap argumentsRel) trivial + have valueRel : RValIso (MapRel (mapping.push rightStore.heap.nodes.size)) + (.loc leftStore.heap.nodes.size) (.loc rightStore.heap.nodes.size) := + .loc (by rw [← state.heap.size]; exact MapRel.fresh ..) + exact ⟨_, _, .pappExtern cleared (contexts.extern declaration) targetResolved + (by rw [← values_size argumentsRel]; exact under), + ⟨allocating, fuel, .running ((advanced.mono allocating.extension).pushResult positive valueRel) + (stack.mono allocating.extension)⟩⟩ + case apply functionAtom argumentAtoms function arguments noCredits functionResolved argumentsResolved transferred => + obtain ⟨targetFunction, targetFunctionResolved, functionRel⟩ := + ReuseSim.resolveAtom_iso frames.values functionResolved + obtain ⟨targetArguments, targetArgumentsResolved, argumentsRel⟩ := + ReuseSim.resolveAtoms_iso frames.values argumentsResolved + obtain ⟨after, target, transfer, related⟩ := apply_related contexts readyContext state fuel + functionRel argumentsRel advanced positive stack transferred + exact ⟨after, target, .apply cleared targetFunctionResolved targetArgumentsResolved transfer, related⟩ + case extern address atoms arguments arity value noCredits resolved declaration argumentArity called => + obtain ⟨targetArguments, targetResolved, argumentsRel⟩ := ReuseSim.resolveAtoms_iso frames.values resolved + obtain ⟨targetCalled, valueRel⟩ := scalarOracle_related contexts argumentsRel called + exact ⟨mapping, _, .extern cleared targetResolved (contexts.extern declaration) + (by rw [← values_size argumentsRel]; exact argumentArity) targetCalled, + ⟨.refl state, fuel, .running (advanced.pushResult positive valueRel) stack⟩⟩ + +end Ix.Compiler.IxIR2.CallReuse.Sim diff --git a/Ix/Compiler/IxIR2/CallReuseMain.lean b/Ix/Compiler/IxIR2/CallReuseMain.lean new file mode 100644 index 000000000..ea21a70a7 --- /dev/null +++ b/Ix/Compiler/IxIR2/CallReuseMain.lean @@ -0,0 +1,91 @@ +import Ix.Compiler.IxIR2.CallReuseSimulation +import Ix.Compiler.IxIR2.CallEvalFuel + +/-! Executable whole-main refinement for the actual v1 compiler output. -/ + +namespace Ix.Compiler.IxIR2.CallReuse + +open Eval +open Sim + +theorem Output.mainSimulation {limits : Validate.Limits} {validation : Validate.Context} {source : Program} + (output : Output limits validation source) {controlFuel heapFuel : Nat} {baseline : Result} + (arity : source.main.signature.params.size = 0) (nonempty : source.main.blocks.isEmpty = false) + (run : Eval.runMain (Context.ofProgram source validation.schemas) .physical source + controlFuel heapFuel = .ok baseline) : + ∃ selectedControl selected mapping, + Policy.runMain policy (Context.ofProgram output.target validation.schemas) .physical output.target + selectedControl heapFuel = .ok selected ∧ + HeapMap baseline.store selected.store mapping ∧ + IxIR1.Sim.RValIso (MapRel mapping) baseline.value selected.value ∧ + baseline.heapRemaining ≤ selected.heapRemaining ∧ + baseline.store.allocationEvents = selected.store.allocationEvents ∧ + baseline.store.CostBounds selected.store := by + have mainReady : functionReady source.main = true := by + have ready := output.sourceReady + simp only [programReady, Bool.and_eq_true] at ready + exact ready.1 + rw [Eval.runMain_eq_runMachine arity nonempty] at run + obtain ⟨count, _, steps⟩ := Eval.runMachine_steps run + have initial := initialMachine_related (limits := limits) (validation := validation) + (sourceContext := Context.ofProgram source validation.schemas) (heapFuel := heapFuel) mainReady arity + obtain ⟨mapping, selectedCount, selectedFinal, targetSteps, related⟩ := + simulate_to_halt (ContextRel.ofProgram limits validation source) + (programReady_context output.sourceReady) rfl initial steps ⟨baseline.value, rfl⟩ + rcases selectedFinal with ⟨selectedStore, selectedFuel, selectedControl⟩ + cases related.control with + | halted values => + rename_i selectedValue + let selected : Result := + { store := selectedStore, value := selectedValue, controlRemaining := 0, heapRemaining := selectedFuel } + refine ⟨selectedCount, selected, mapping, ?_, related.transition.state.heap, values, related.fuel, ?_, ?_⟩ + · rw [Policy.runMain_eq_runMachine + (show output.target.main.signature.params.size = 0 from arity) + (rewriteFunction_nonempty nonempty)] + have executed := targetSteps.runMachine (controlFuel := 0) + simpa only [Nat.add_zero, Policy.runMachine, policy, Output.target, rewriteProgram, selected] using executed + · have counted := related.transition.events + change baseline.store.allocationEvents + 0 = selected.store.allocationEvents + 0 at counted + simpa only [Nat.add_zero] using counted + · exact related.transition.costs.preserves (Store.CostBounds.refl {}) + +theorem Selection.mainEntry {limits : Validate.Limits} {validation : Validate.Context} + {source : Program} (selection : Selection limits validation source) + (arity : source.main.signature.params.size = 0) (nonempty : source.main.blocks.isEmpty = false) : + selection.target.main.signature.params.size = 0 ∧ selection.target.main.blocks.isEmpty = false := by + cases selection with + | optimized output produced => exact ⟨arity, rewriteFunction_nonempty nonempty⟩ + | baseline checked error rejected => exact ⟨arity, nonempty⟩ + +/-- The chosen policy executes the actual checked selection. At a closed +compiler endpoint the allocation-history map gives the existing semantic heap +relation, including fallback to the unchanged checked baseline. -/ +theorem Selection.mainSimulation {limits : Validate.Limits} {validation : Validate.Context} + {source : Program} (selection : Selection limits validation source) + {controlFuel heapFuel : Nat} {baseline : Result} + (arity : source.main.signature.params.size = 0) (nonempty : source.main.blocks.isEmpty = false) + (run : Eval.runMain (Context.ofProgram source validation.schemas) .physical source + controlFuel heapFuel = .ok baseline) + (closed : IxIR1.Sim.StoreClosed baseline.store.heap) + (live : IxIR1.Sim.LiveRVal baseline.store.heap baseline.value) : + ∃ selectedControl selected locRel, + Policy.runMain selection.policy (Context.ofProgram selection.target validation.schemas) + .physical selection.target selectedControl heapFuel = .ok selected ∧ + ReuseSim.StableHeapRel baseline.store selected.store locRel ∧ + IxIR1.Sim.RValIso locRel baseline.value selected.value ∧ + baseline.heapRemaining ≤ selected.heapRemaining ∧ + baseline.store.allocationEvents = selected.store.allocationEvents ∧ + baseline.CostBounds selected := by + cases selection with + | optimized output produced => + obtain ⟨control, selected, mapping, executed, heaps, values, budget, events, costs⟩ := + output.mainSimulation arity nonempty run + exact ⟨control, selected, LiveMapRel baseline.store mapping, executed, + heaps.toStable closed, heaps.toHeapIso_value closed values live, budget, events, costs⟩ + | baseline checked error rejected => + exact ⟨controlFuel, baseline, Eq, + by simpa only [Selection.policy, Selection.target, Policy.runMain_v0] using run, + .contents ⟨rfl⟩, + IxIR1.Sim.RValIso.refl _, Nat.le_refl _, rfl, Store.CostBounds.refl _⟩ + +end Ix.Compiler.IxIR2.CallReuse diff --git a/Ix/Compiler/IxIR2/CallReuseOrder.lean b/Ix/Compiler/IxIR2/CallReuseOrder.lean new file mode 100644 index 000000000..72776ccdc --- /dev/null +++ b/Ix/Compiler/IxIR2/CallReuseOrder.lean @@ -0,0 +1,197 @@ +import Ix.Compiler.IxIR2.ReuseHeapMapResults + +/-! +# Baseline allocation order for call-spanning reuse + +Fresh baseline allocation keeps positive counts and edges to older slots. +This trace property rules out a self-field in the constructor consumed by a +hot prefix. It is independent of exact external root counts. +-/ + +namespace Ix.Compiler.IxIR2.CallReuse.Sim + +open Ix.Compiler.IxIR2.Eval +open Ix.Compiler.Ixon (Owned) +open Ix.Compiler.IxIR1.Sim (NodeIso RValsIso) +open Ix.Compiler.IxIR1.Reclamation (AllocationOrderInvariant) + +def Ordered (store : Store) : Prop := AllocationOrderInvariant store.heap + +theorem Ordered.empty : Ordered ({} : Store) := AllocationOrderInvariant.empty + +theorem Ordered.congr {before after : Store} (ordered : Ordered before) + (nodes : after.heap.nodes = before.heap.nodes) : Ordered after := by + have get : ∀ location, after.heap.get? location = before.heap.get? location := by + intro location + simp only [IxIR1.Store.get?, nodes] + exact ⟨fun found => ordered.rc_pos (by simpa only [get] using found), + fun found child => ordered.child_lt (by simpa only [get] using found) child⟩ + +theorem Ordered.retain {store output : Store} (ordered : Ordered store) {value : RVal} + (run : retainShared store value = .ok output) : Ordered output := by + cases value with + | lit => cases run; exact ordered + | erased => cases run; exact ordered + | loc location => + cases found : store.get? location with + | none => simp [retainShared, found] at run + | some box => + by_cases shared : box.world = .shared + · simp only [retainShared, found, shared, bne_self_eq_false, Bool.false_eq_true, + ↓reduceIte, Except.ok.injEq] at run + subst output + have result := (AllocationOrderInvariant.setRc ordered found + (newRc := box.rc + 1) (by omega)).rcTick + simpa only [Ordered, Store.setBox_heap, Store.rcTick_heap, shared] using result + · simp [retainShared, found, shared] at run + +theorem Ordered.retainMany {store output : Store} (ordered : Ordered store) {values : Array RVal} + (run : RetainSharedMany store values output) : Ordered output := by + have loop : ∀ (values : List RVal) {store output : Store}, Ordered store → + values.foldlM retainShared store = .ok output → Ordered output := by + intro values + induction values with + | nil => intro store output ordered run; cases run; exact ordered + | cons head tail ih => + intro store output ordered run + rw [List.foldlM_cons] at run + cases first : retainShared store head with + | error error => simp [first, bind, Except.bind] at run + | ok middle => + simp only [first, bind, Except.bind] at run + exact ih (ordered.retain first) run + change values.foldlM retainShared store = .ok output at run + rw [← Array.foldlM_toList] at run + exact loop values.toList ordered run + +theorem Ordered.releaseWork {fuel remaining : Nat} {store output : Store} {values : List RVal} + (ordered : Ordered store) + (run : releaseSharedWork fuel store values = .ok (output, remaining)) : Ordered output := by + induction fuel generalizing store values with + | zero => + cases values with + | nil => cases run; exact ordered + | cons value rest => simp [releaseSharedWork] at run + | succ fuel ih => + cases values with + | nil => cases run; exact ordered + | cons value rest => + cases value with + | lit => exact ih ordered run + | erased => exact ih ordered run + | loc location => + cases found : store.get? location with + | none => simp [releaseSharedWork, found] at run + | some box => + by_cases shared : box.world = .shared + · by_cases zero : box.rc = 0 + · simp [releaseSharedWork, found, shared, zero] at run + · by_cases unitRC : box.rc = 1 + · simp only [releaseSharedWork, found, shared, bne_self_eq_false, + Bool.false_eq_true, ↓reduceIte, unitRC, beq_self_eq_true] at run + exact ih (store := store.rcTick.kill location) + (AllocationOrderInvariant.rcTick ordered |>.kill found) run + · simp [releaseSharedWork, found, shared, zero, unitRC] at run + have preserved := (AllocationOrderInvariant.rcTick ordered).setRc found + (newRc := box.rc - 1) (by omega) + exact ih (store := store.rcTick.setBox location { box with rc := box.rc - 1 }) + preserved (by simpa only [shared] using run) + · simp [releaseSharedWork, found, shared] at run + +theorem Ordered.dropWork {fuel remaining : Nat} {store output : Store} {values : List RVal} + (ordered : Ordered store) + (run : dropUniqueWork fuel store values = .ok (output, remaining)) : Ordered output := by + induction fuel generalizing store values with + | zero => + cases values with + | nil => cases run; exact ordered + | cons value rest => simp [dropUniqueWork] at run + | succ fuel ih => + cases values with + | nil => cases run; exact ordered + | cons value rest => + cases value with + | lit => exact ih ordered run + | erased => exact ih ordered run + | loc location => + cases found : store.get? location with + | none => simp [dropUniqueWork, found] at run + | some box => + by_cases unique : box.world = .unique + · cases node : box.node with + | papN address arity arguments => simp [dropUniqueWork, found, unique, node] at run + | ctorN cid fields => + simp only [dropUniqueWork, found, unique, bne_self_eq_false, + Bool.false_eq_true, ↓reduceIte, node] at run + exact ih (store := store.kill location) + (AllocationOrderInvariant.kill ordered found) run + · simp [dropUniqueWork, found, unique] at run + +theorem HeapMap.valuesBounded {left right : Store} {mapping : Array Nat} + (heap : HeapMap left right mapping) {leftValues rightValues : List RVal} + (related : RValsIso (MapRel mapping) leftValues rightValues) : + IxIR1.Reclamation.ValuesInBounds left.heap leftValues := by + induction related with + | nil => simp [IxIR1.Reclamation.ValuesInBounds] + | cons head tail ih => + intro value member + simp only [List.mem_cons] at member + rcases member with rfl | member + · cases head with + | loc mapped => + change _ < left.heap.nodes.size + rw [← heap.size] + exact mapped.bound + | lit => trivial + | erased => trivial + · exact ih value member + +theorem Ordered.alloc {left right : Store} {mapping : Array Nat} + (ordered : Ordered left) (heap : HeapMap left right mapping) + {world : Owned} {leftNode rightNode : Node} + (related : NodeIso (MapRel mapping) leftNode rightNode) : + Ordered (left.allocNode world leftNode).1 := + AllocationOrderInvariant.allocNodeOfInBounds ordered + (heap.valuesBounded (nodeChildren_iso related)) + +/-- The actual successful retain/release prefix cancels against shallow +removal. Allocation order supplies the missing self-edge exclusion internally. -/ +theorem hotPrefix_order {store retained output : Store} {target : Nat} {cid : CtorId} + {fields : Array RVal} {fieldFuel remaining : Nat} (ordered : Ordered store) + (targetAt : store.get? target = some ⟨.shared, 1, .ctorN cid fields⟩) + (retains : RetainSharedMany store fields retained) + (releases : releaseShared (fieldFuel + 1) retained (.loc target) = .ok (output, remaining)) : + ReuseSim.HeapContentsEq output (store.kill target) := by + have different : ∀ value ∈ fields.toList, value ≠ .loc target := by + intro value member same + subst value + have impossible := ordered.child_lt targetAt (show .loc target ∈ + IxIR1.Sim.nodeChildren (.ctorN cid fields) from member) + omega + have retainsList : RetainSharedMany store fields.toList.toArray retained := by simpa using retains + have retainedTarget := ReuseSim.RetainSharedMany.preserves_box targetAt different retainsList + have childRelease : releaseSharedWork fieldFuel (retained.rcTick.kill target) fields.toList = + .ok (output, remaining) := by + simpa [releaseShared, releaseSharedWork, retainedTarget] using releases + have afterKill := ReuseSim.RetainSharedMany.kill_commute targetAt different retainsList + have positives : ∀ value ∈ fields.toList, ReuseSim.SharedPositive (store.kill target) value := by + intro value member + have world := retainMany_world retains value member + have positive : ReuseSim.SharedPositive store value := by + cases value with + | lit => trivial + | erased => trivial + | loc location => + cases found : store.get? location with + | none => simp [RVal.hasWorld, found] at world + | some box => + have shared : box.world = .shared := by simpa [RVal.hasWorld, found] using world + rcases box with ⟨boxWorld, rc, node⟩ + dsimp at shared + subst boxWorld + exact ⟨rc, node, found, ordered.rc_pos found⟩ + exact positive.kill targetAt (different value member) + exact ReuseSim.retainedFields_release_roundtrip + (releaseStart := retained.rcTick.kill target) positives afterKill ⟨rfl⟩ childRelease + +end Ix.Compiler.IxIR2.CallReuse.Sim diff --git a/Ix/Compiler/IxIR2/CallReusePrefix.lean b/Ix/Compiler/IxIR2/CallReusePrefix.lean new file mode 100644 index 000000000..c42e14898 --- /dev/null +++ b/Ix/Compiler/IxIR2/CallReusePrefix.lean @@ -0,0 +1,183 @@ +import Ix.Compiler.IxIR2.CallReusePrefixHeap + +/-! Actual target reset and move steps synchronize with the extracted baseline prefix. -/ + +namespace Ix.Compiler.IxIR2.CallReuse.Sim + +open Eval +open Ix.Compiler.IxIR1.Sim (RValIso RValsIso) + +theorem move_prefix_control (shape : Shape) {context : Context} {frame : Frame} + {parameters fields : Array RVal} {store : Store} {heapFuel : Nat} {stack : List Continuation} + (blockAt : frame.definition.blocks[frame.block]? = some shape.target) + (parameterCount : parameters.size = shape.valueParams.size) (fieldCount : fields.size = shape.fieldCount) : + Eval.Steps context .physical shape.fieldCount + { store, heapFuel, control := .running { frame with pc := 1, values := parameters ++ fields } stack } + { store, heapFuel, control := .running + { frame with pc := shape.fieldCount + 1, values := parameters ++ fields ++ fields } stack } := by + have loop : ∀ count, count ≤ shape.fieldCount → Eval.Steps context .physical count + { store, heapFuel, control := .running { frame with pc := 1, values := parameters ++ fields } stack } + { store, heapFuel, control := .running + { frame with pc := 1 + count, values := prefixValues (parameters ++ fields) fields count } stack } := by + intro count within + induction count with + | zero => + simpa [prefixValues] using (Eval.Steps.refl + ({ store, heapFuel, control := .running { frame with pc := 1, values := parameters ++ fields } stack } : Machine)) + | succ count ih => + have before := ih (by omega) + have bound : count < fields.size := by omega + have atInstruction := shape.move_at (field := count) (by omega) + obtain ⟨pc, instruction⟩ := Array.getElem?_eq_some_iff.mp atInstruction + have resolved : resolveAtom (prefixValues (parameters ++ fields) fields count) + (.reg (shape.valueParams.size + count)) = .ok fields[count] := by + simp only [prefixValues, resolveAtom, Array.getElem?_append, Array.size_append, + ← parameterCount, Nat.add_lt_add_iff_left, bound, ↓reduceIte, + show ¬parameters.size + count < parameters.size by omega, Nat.add_sub_cancel_left, + Array.getElem?_eq_getElem bound] + have one := (InstructionTransferCase.move (context := context) + (interpretation := .physical) (store := store) (heapFuel := heapFuel) + (frame := { frame with pc := 1 + count, values := prefixValues (parameters ++ fields) fields count }) + (stack := stack) resolved).step blockAt pc instruction + have advanced := before.trans (one.toSteps rfl) + simpa only [prefixValues_succ bound, Nat.add_assoc] using advanced + have allFields : (fields.toList.take shape.fieldCount).toArray = fields := by + rw [← fieldCount] + have size : fields.size = fields.toList.length := Array.length_toList.symm + rw [size, List.take_length] + simpa only [prefixValues, allFields, Nat.add_comm 1] using loop shape.fieldCount (Nat.le_refl _) + +theorem FrameRel.afterPrefix {limits : Validate.Limits} {validation : Validate.Context} + {mapping : Array Nat} {block : Block} {left right : Frame} + (frames : FrameRel limits validation mapping block left right) + {site : Site limits validation block} (produced : inspect limits validation block = some site) + {leftFields rightFields : Array RVal} (fields : RValsIso (MapRel mapping) leftFields.toList rightFields.toList) + {credit : Credit} (layout : credit.layout = site.representation.layout) (physical : PhysicalCredit credit) : + FrameRel limits validation mapping block + { left with pc := 2 * site.shape.fieldCount + 1, values := left.values ++ leftFields ++ leftFields } + { right with + pc := site.shape.fieldCount + 1 + values := right.values ++ rightFields ++ rightFields + credits := #[some credit] } := by + exact { frames with + values := by simpa only [Array.toList_append] using (frames.values.append fields).append fields + position := by simpa only [Nat.add_zero] using Position.body site produced 0 (Nat.zero_le _) credit layout physical + entryCount := by intro zero; simp only at zero; omega } + +theorem reset_prefix_related {limits : Validate.Limits} {validation : Validate.Context} + {leftContext rightContext : Context} {mapping : Array Nat} + {leftStore rightStore retained released : Store} {leftFuel rightFuel remaining : Nat} + {block : Block} {leftFrame rightFrame : Frame} {leftStack rightStack : List Continuation} + {site : Site limits validation block} {location rc : Nat} {fields : Array RVal} + (contexts : ContextRel limits validation leftContext rightContext) + (schemas : leftContext.schemas = validation.schemas) + (machines : MachineRel limits validation leftContext mapping + { store := leftStore, heapFuel := leftFuel, control := .running leftFrame leftStack } + { store := rightStore, heapFuel := rightFuel, control := .running rightFrame rightStack }) + (frames : FrameRel limits validation mapping block leftFrame rightFrame) + (stack : StackRel limits validation mapping leftStack rightStack) + (produced : inspect limits validation block = some site) + (leftPC : leftFrame.pc = 0) (rightPC : rightFrame.pc = 0) (credits : rightFrame.credits = #[]) + (resolved : resolveAtom leftFrame.values (.reg site.shape.source) = .ok (.loc location)) + (found : leftStore.get? location = some ⟨.shared, rc, .ctorN site.shape.sourceConstructor fields⟩) + (fieldCount : fields.size = site.shape.fieldCount) + (retains : RetainSharedMany leftStore fields retained) + (releases : releaseShared leftFuel retained (.loc location) = .ok (released, remaining)) : + ∃ rightAfter, + Policy.Steps .suspendedCallsV1 rightContext .physical (site.shape.fieldCount + 1) + { store := rightStore, heapFuel := rightFuel, control := .running rightFrame rightStack } rightAfter ∧ + TransferRel limits validation leftContext mapping mapping leftStore rightStore + { store := released, heapFuel := remaining + control := .running + { leftFrame with + pc := 2 * site.shape.fieldCount + 1 + values := leftFrame.values ++ fields ++ fields } leftStack } rightAfter := by + obtain ⟨targetValue, targetResolved, valueRel⟩ := ReuseSim.resolveAtom_iso frames.values resolved + cases valueRel with + | @loc _ targetLocation mapped => + obtain ⟨targetBox, targetFields, targetView, boxes, fieldsRel⟩ := + machines.heap.constructorView mapped (ConstructorView.of_box found rfl rfl) + have targetBoxEq : targetBox = ⟨.shared, rc, .ctorN site.shape.sourceConstructor targetFields⟩ := by + have world := boxes.world + have count := boxes.rc + have node := targetView.parts.2.2 + cases targetBox + simp_all + have targetAt := targetView.parts.1 + rw [targetBoxEq] at targetAt + have targetConstructor := ConstructorView.of_box targetAt rfl rfl + have targetFieldCount : targetFields.size = site.shape.fieldCount := (values_size fieldsRel).symm.trans fieldCount + have parameterCount : rightFrame.values.size = site.shape.valueParams.size := by + have count := frames.entryCount leftPC + have sourceCount : block.valueParams.size = site.shape.valueParams.size := by + simp only [site.exact, Shape.baseline] + exact (values_size frames.values).symm.trans (count.trans sourceCount) + obtain ⟨sourceSchema, _, sourceAt, _, _, _, sourceLayout, _⟩ := site.schemas + have targetSchema : rightContext.schemas .shared site.shape.sourceConstructor = some sourceSchema := by + rw [← contexts.schemas, schemas] + exact sourceAt + have targetBlockAt : rightFrame.definition.blocks[rightFrame.block]? = some site.shape.target := by + simpa only [rewriteBlock_accepted produced] using frames.targetAt + have resetAt : site.shape.target.instructions[rightFrame.pc]? = + some (.resetShared (.reg site.shape.source) site.shape.sourceConstructor) := by + rw [rightPC] + exact site.shape.reset_at + obtain ⟨resetPC, resetInstruction⟩ := Array.getElem?_eq_some_iff.mp resetAt + have finish : ∀ (targetStore : Store) (credit : Credit), + credit.layout = site.representation.layout → PhysicalCredit credit → + Eval.Step rightContext .physical + { store := rightStore, heapFuel := rightFuel, control := .running rightFrame rightStack } + { store := targetStore, heapFuel := rightFuel + control := .running + { rightFrame with + pc := 1 + values := rightFrame.values ++ targetFields + credits := #[some credit] } rightStack } → + HeapTransition leftContext mapping mapping leftStore released rightStore targetStore → + ∃ rightAfter, + Policy.Steps .suspendedCallsV1 rightContext .physical (site.shape.fieldCount + 1) + { store := rightStore, heapFuel := rightFuel, control := .running rightFrame rightStack } rightAfter ∧ + TransferRel limits validation leftContext mapping mapping leftStore rightStore + { store := released, heapFuel := remaining + control := .running + { leftFrame with + pc := 2 * site.shape.fieldCount + 1 + values := leftFrame.values ++ fields ++ fields } leftStack } rightAfter := by + intro targetStore credit layout physical reset transition + have moves := move_prefix_control site.shape (context := rightContext) + (frame := { rightFrame with credits := #[some credit] }) + (store := targetStore) (heapFuel := rightFuel) (stack := rightStack) + targetBlockAt parameterCount targetFieldCount + have actual := (reset.toSteps rfl).trans moves + let target : Machine := + { store := targetStore, heapFuel := rightFuel + control := .running + { rightFrame with + pc := site.shape.fieldCount + 1 + values := rightFrame.values ++ targetFields ++ targetFields + credits := #[some credit] } rightStack } + refine ⟨target, ?_, ⟨transition, ?_, .running (frames.afterPrefix produced fieldsRel layout physical) stack⟩⟩ + · simpa only [Nat.add_comm 1] using Policy.of_originalSteps actual + · exact Nat.le_trans (ReuseSim.releaseShared_remaining_le releases) machines.fuel + by_cases unit : rc = 1 + · subst rc + have transition := machines.heapState.hotPrefix mapped found retains releases + apply finish _ { layout := sourceSchema.layout, presence := .present (some targetLocation) } + sourceLayout.symm (.inr ⟨targetLocation, rfl⟩) _ transition + have reset := (InstructionTransferCase.resetSharedPhysicalHot + (context := rightContext) (heapFuel := rightFuel) (stack := rightStack) + rfl targetSchema targetResolved targetConstructor rfl).step targetBlockAt resetPC resetInstruction + simpa only [rightPC, credits, Nat.zero_add, Array.push_empty, ReuseSim.physicalHotResetStore] using reset + · have many : 1 < rc := by + have positive : 0 < rc := machines.ordered.rc_pos found + omega + obtain ⟨targetStore, targetRetains, transition⟩ := + machines.heapState.coldPrefix mapped targetAt many fieldsRel retains releases + apply finish targetStore { layout := sourceSchema.layout, presence := .absent } + sourceLayout.symm (.inl rfl) _ transition + have reset := (InstructionTransferCase.resetSharedCold + (context := rightContext) (interpretation := .physical) (heapFuel := rightFuel) (stack := rightStack) + targetSchema targetResolved targetConstructor many targetRetains).step targetBlockAt resetPC resetInstruction + simpa only [rightPC, credits, Nat.zero_add, Array.push_empty] using reset + +end Ix.Compiler.IxIR2.CallReuse.Sim diff --git a/Ix/Compiler/IxIR2/CallReusePrefixHeap.lean b/Ix/Compiler/IxIR2/CallReusePrefixHeap.lean new file mode 100644 index 000000000..9c01d02fb --- /dev/null +++ b/Ix/Compiler/IxIR2/CallReusePrefixHeap.lean @@ -0,0 +1,72 @@ +import Ix.Compiler.IxIR2.CallReusePrefixTrace + +/-! Hot and cold reset facts derived from the actual baseline retain/release pair. -/ + +namespace Ix.Compiler.IxIR2.CallReuse.Sim + +open Eval +open Ix.Compiler.IxIR1.Sim (RValsIso) + +theorem HeapState.hotPrefix {context : Context} {mapping : Array Nat} + {left right retained released : Store} {leftLocation rightLocation : Nat} + {cid : CtorId} {fields : Array RVal} {heapFuel remaining : Nat} + (state : HeapState context mapping left right) + (mapped : MapRel mapping leftLocation rightLocation) + (found : left.get? leftLocation = some ⟨.shared, 1, .ctorN cid fields⟩) + (retains : RetainSharedMany left fields retained) + (releases : releaseShared heapFuel retained (.loc leftLocation) = .ok (released, remaining)) : + HeapTransition context mapping mapping left released right + (ReuseSim.physicalHotResetStore right rightLocation) := by + cases heapFuel with + | zero => simp [releaseShared, releaseSharedWork] at releases + | succ fuel => + have contents := hotPrefix_order state.ordered found retains releases + have heap := (state.heap.reserve mapped found).congr contents.nodes + (show (ReuseSim.physicalHotResetStore right rightLocation).heap.nodes = + (right.reserve rightLocation).heap.nodes from rfl) + have retainedObs := retains.observations + have releasedObs := releaseShared_observations releases + refine ⟨⟨heap, (state.ordered.retainMany retains).releaseWork releases, + (state.shaped.retainMany retains).releaseWork releases⟩, + MapExtends.refl mapping, ⟨?_, ?_⟩, ?_⟩ + · change right.heap.rcops + left.heap.rcops ≤ released.heap.rcops + right.heap.rcops + omega + · intro before + change right.peakLiveNodes ≤ released.peakLiveNodes + rw [releasedObs.2.2.1, retainedObs.2.2.1] + exact before + · rw [releaseSharedWork_allocationEvents releases, retains.allocationEvents] + change left.allocationEvents + right.allocationEvents = right.allocationEvents + left.allocationEvents + omega + +theorem HeapState.coldPrefix {context : Context} {mapping : Array Nat} + {left right retained released : Store} {leftLocation rightLocation rc : Nat} + {cid : CtorId} {leftFields rightFields : Array RVal} {heapFuel remaining : Nat} + (state : HeapState context mapping left right) + (mapped : MapRel mapping leftLocation rightLocation) + (rightAt : right.get? rightLocation = some ⟨.shared, rc, .ctorN cid rightFields⟩) + (many : 1 < rc) (fields : RValsIso (MapRel mapping) leftFields.toList rightFields.toList) + (retains : RetainSharedMany left leftFields retained) + (releases : releaseShared heapFuel retained (.loc leftLocation) = .ok (released, remaining)) : + ∃ rightOutput, + RetainSharedMany + (ReuseSim.coldResetStartStore right rightLocation ⟨.shared, rc, .ctorN cid rightFields⟩) + rightFields rightOutput ∧ + HeapTransition context mapping mapping left released right rightOutput := by + cases heapFuel with + | zero => simp [releaseShared, releaseSharedWork] at releases + | succ fuel => + obtain ⟨rightRetained, targetRetains, retaining⟩ := state.retainMany fields retains + obtain ⟨rightReleased, rightRemaining, targetReleases, _, releasing⟩ := + retaining.state.releaseWork (Nat.le_refl _) (.cons (.loc mapped) .nil) releases + obtain ⟨retainedRC, _, commutedRelease, commutedRetain, _⟩ := + ReuseSim.coldPrefix_commutes (heapFuel := fuel) rightAt many targetRetains + have same := Except.ok.inj (targetReleases.symm.trans commutedRelease) + cases same + have paired := retaining.trans releasing + refine ⟨_, commutedRetain, ⟨⟨paired.state.heap.congr rfl rfl, + paired.state.ordered, paired.state.shaped⟩, MapExtends.refl mapping, ?_, ?_⟩⟩ + · exact ⟨paired.costs.rcops, paired.costs.peakLive⟩ + · exact paired.events + +end Ix.Compiler.IxIR2.CallReuse.Sim diff --git a/Ix/Compiler/IxIR2/CallReusePrefixTrace.lean b/Ix/Compiler/IxIR2/CallReusePrefixTrace.lean new file mode 100644 index 000000000..b6e2b5ba7 --- /dev/null +++ b/Ix/Compiler/IxIR2/CallReusePrefixTrace.lean @@ -0,0 +1,252 @@ +import Ix.Compiler.IxIR2.CallReuseBody + +/-! The successful baseline execution supplies every fact needed by a reset prefix. -/ + +namespace Ix.Compiler.IxIR2.CallReuse.Sim + +open Eval + +theorem step_instruction {context : Context} {interpretation : Interpretation} + {store : Store} {heapFuel : Nat} {frame : Frame} {stack : List Continuation} + {block : Block} {instruction : Instr} {target : Machine} + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) (instructionAt : block.instructions[frame.pc] = instruction) + (stepped : Eval.Step context interpretation { store, heapFuel, control := .running frame stack } target) : + InstructionTransferCase context interpretation store heapFuel frame stack instruction target := by + cases stepped.classify with + | instruction found _ atInstruction classified => + have blocks := Option.some.inj (found.symm.trans blockAt) + cases blocks + have instructions := atInstruction.symm.trans instructionAt + cases instructions + exact classified + | terminator found atEnd _ _ => + have blocks := Option.some.inj (found.symm.trans blockAt) + cases blocks + omega + +theorem instruction_head {context : Context} {interpretation : Interpretation} + {store : Store} {heapFuel count : Nat} {frame : Frame} {stack : List Continuation} + {block : Block} {instruction : Instr} {final : Machine} + (blockAt : frame.definition.blocks[frame.block]? = some block) + (found : block.instructions[frame.pc]? = some instruction) + (halted : ∃ value, final.control = .halted value) + (steps : Eval.Steps context interpretation count + { store, heapFuel, control := .running frame stack } final) : + ∃ remaining next, count = remaining + 1 ∧ + InstructionTransferCase context interpretation store heapFuel frame stack instruction next ∧ + Eval.Steps context interpretation remaining next final := by + cases steps with + | refl => obtain ⟨value, impossible⟩ := halted; cases impossible + | cons _ head tail => + obtain ⟨pc, instructionAt⟩ := Array.getElem?_eq_some_iff.mp found + exact ⟨_, _, rfl, step_instruction blockAt pc instructionAt head, tail⟩ + +def prefixValues (parameters fields : Array RVal) (count : Nat) : Array RVal := + parameters ++ (fields.toList.take count).toArray + +theorem prefixValues_succ {parameters fields : Array RVal} {count : Nat} + (bound : count < fields.size) : + (prefixValues parameters fields count).push fields[count] = prefixValues parameters fields (count + 1) := by + apply Array.toList_inj.mp + simp only [prefixValues, Array.toList_push, Array.toList_append] + rw [← List.take_append_getElem (l := fields.toList) (i := count) (by simpa using bound)] + simp [List.append_assoc] + +theorem resolve_parameter_append {parameters suffix : Array RVal} {source : Nat} {value : RVal} + (bound : source < parameters.size) (resolved : resolveAtom parameters (.reg source) = .ok value) : + resolveAtom (parameters ++ suffix) (.reg source) = .ok value := by + simpa only [resolveAtom, Array.getElem?_append_left bound] using resolved + +theorem fetch_prefix_inverse {limits : Validate.Limits} {validation : Validate.Context} {block : Block} + (site : Site limits validation block) {context : Context} {definition : Function} {blockId : Nat} + {parameters fields : Array RVal} {store : Store} {heapFuel total : Nat} {stack : List Continuation} + {location : Nat} {box : NodeBox} {final : Machine} + (blockAt : definition.blocks[blockId]? = some block) + (parameterCount : parameters.size = site.shape.valueParams.size) + (resolved : resolveAtom parameters (.reg site.shape.source) = .ok (.loc location)) + (boxAt : store.get? location = some box) (node : box.node = .ctorN site.shape.sourceConstructor fields) + (halted : ∃ value, final.control = .halted value) + (steps : Eval.Steps context .physical total + { store, heapFuel, control := .running { definition, block := blockId, values := parameters } stack } final) + (count : Nat) (within : count ≤ site.shape.fieldCount) : + ∃ remaining, total = count + remaining ∧ count ≤ fields.size ∧ + Eval.Steps context .physical remaining + { store, heapFuel + control := .running + { definition, block := blockId, pc := count, values := prefixValues parameters fields count } stack } final := by + induction count with + | zero => exact ⟨total, by omega, by omega, by simpa [prefixValues] using steps⟩ + | succ count ih => + obtain ⟨remaining, totalCount, fieldBound, rest⟩ := ih (by omega) + have instructionAt : block.instructions[count]? = + some (.fetch (.reg site.shape.source) site.shape.sourceConstructor count) := by + simpa only [site.exact] using site.shape.fetch_at (field := count) (by omega) + obtain ⟨afterCount, next, remainingCount, head, tail⟩ := + instruction_head blockAt instructionAt halted rest + cases head with + | @fetch _ _ _ otherLocation otherBox otherFields value sourceResolved foundBox foundNode fieldAt => + have root := resolve_parameter_append + (suffix := (fields.toList.take count).toArray) + (by rw [parameterCount]; exact site.sourceBound) resolved + have locations := Except.ok.inj (sourceResolved.symm.trans root) + cases locations + have boxes := Option.some.inj (foundBox.symm.trans boxAt) + cases boxes + have payloads := IxIR1.Node.ctorN.inj (foundNode.symm.trans node) + cases payloads.2 + obtain ⟨currentBound, valueAt⟩ := Array.getElem?_eq_some_iff.mp fieldAt + subst value + refine ⟨afterCount, by omega, by omega, ?_⟩ + simpa only [prefixValues_succ currentBound] using tail + +theorem retain_suffix_inverse {limits : Validate.Limits} {validation : Validate.Context} {block : Block} + (site : Site limits validation block) {context : Context} {definition : Function} {blockId : Nat} + {parameters fields : Array RVal} {store : Store} {heapFuel total : Nat} {stack : List Continuation} + {final : Machine} (blockAt : definition.blocks[blockId]? = some block) + (parameterCount : parameters.size = site.shape.valueParams.size) + (fieldCount : fields.size = site.shape.fieldCount) + (halted : ∃ value, final.control = .halted value) (remaining : List RVal) : + ∀ (processed : List RVal), fields.toList = processed ++ remaining → + Eval.Steps context .physical total + { store, heapFuel + control := .running + { definition, block := blockId, pc := site.shape.fieldCount + processed.length, + values := parameters ++ fields ++ processed.toArray } stack } final → + ∃ afterCount retained, total = remaining.length + afterCount ∧ + RetainSharedMany store remaining.toArray retained ∧ + Eval.Steps context .physical afterCount + { store := retained, heapFuel + control := .running + { definition, block := blockId, pc := 2 * site.shape.fieldCount, + values := parameters ++ fields ++ fields } stack } final := by + induction remaining generalizing total store with + | nil => + intro processed split steps + have processedEq : processed.toArray = fields := by + simpa using congrArg List.toArray split.symm + have processedSize : processed.length = site.shape.fieldCount := by + simpa only [List.size_toArray, fieldCount] using congrArg Array.size processedEq + exact ⟨total, store, by simp, RetainSharedMany.empty store, + by simpa only [processedEq, processedSize, Nat.two_mul] using steps⟩ + | cons value remaining ih => + intro processed split steps + have within : processed.length < site.shape.fieldCount := by + have sizes := congrArg List.length split + simp only [Array.length_toList, List.length_append, List.length_cons, fieldCount] at sizes + omega + have instructionAt : block.instructions[site.shape.fieldCount + processed.length]? = + some (.retainShared (.reg (site.shape.valueParams.size + processed.length))) := by + simpa only [site.exact] using site.shape.retain_at within + obtain ⟨nextCount, next, totalCount, head, tail⟩ := instruction_head blockAt instructionAt halted steps + cases head with + | @retainShared _ otherValue output resolved retained => + have fieldAt : fields[processed.length]? = some value := by + have atList : fields.toList[processed.length]? = some value := by rw [split]; simp + simpa using atList + have resolveValue : resolveAtom (parameters ++ fields ++ processed.toArray) + (.reg (site.shape.valueParams.size + processed.length)) = .ok value := by + simp only [resolveAtom, Array.getElem?_append, Array.size_append, Nat.add_lt_add_iff_left, ← parameterCount, + show ¬parameters.size + processed.length < parameters.size by omega, + show processed.length < fields.size by omega, fieldAt, + ↓reduceIte, Nat.add_sub_cancel_left] + have same := Except.ok.inj (resolved.symm.trans resolveValue) + subst otherValue + have advancedValues : (parameters ++ fields ++ processed.toArray).push value = + parameters ++ fields ++ (processed ++ [value]).toArray := by + apply Array.toList_inj.mp + simp + have nextSteps : Eval.Steps context .physical nextCount + { store := output, heapFuel + control := .running + { definition, block := blockId, pc := site.shape.fieldCount + (processed ++ [value]).length, + values := parameters ++ fields ++ (processed ++ [value]).toArray } stack } final := by + simpa [advancedValues, List.length_append, Nat.add_assoc] using tail + obtain ⟨afterCount, output, restCount, retainedRest, rest⟩ := + ih (processed ++ [value]) (by simpa [List.append_assoc] using split) nextSteps + exact ⟨afterCount, output, by simp only [List.length_cons]; omega, + RetainSharedMany.cons retained retainedRest, rest⟩ + +theorem baseline_prefix_trace {limits : Validate.Limits} {validation : Validate.Context} {block : Block} + (site : Site limits validation block) {context : Context} {definition : Function} {blockId : Nat} + {parameters : Array RVal} {store : Store} {heapFuel total : Nat} {stack : List Continuation} + {final : Machine} (blockAt : definition.blocks[blockId]? = some block) + (parameterCount : parameters.size = site.shape.valueParams.size) + (schemas : context.schemas = validation.schemas) (ordered : Ordered store) (shaped : Shaped context store) + (halted : ∃ value, final.control = .halted value) + (steps : Eval.Steps context .physical total + { store, heapFuel, control := .running { definition, block := blockId, values := parameters } stack } final) : + ∃ location box fields retained released remainingFuel remainingCount, + resolveAtom parameters (.reg site.shape.source) = .ok (.loc location) ∧ + store.get? location = some box ∧ box.world = .shared ∧ + box.node = .ctorN site.shape.sourceConstructor fields ∧ fields.size = site.shape.fieldCount ∧ + RetainSharedMany store fields retained ∧ + releaseShared heapFuel retained (.loc location) = .ok (released, remainingFuel) ∧ + total = 2 * site.shape.fieldCount + 1 + remainingCount ∧ + Eval.Steps context .physical remainingCount + { store := released, heapFuel := remainingFuel + control := .running + { definition, block := blockId, pc := 2 * site.shape.fieldCount + 1, + values := parameters ++ fields ++ fields } stack } final := by + have firstAt : block.instructions[0]? = + some (.fetch (.reg site.shape.source) site.shape.sourceConstructor 0) := by + simpa only [site.exact] using site.shape.fetch_at site.fieldsPositive + obtain ⟨_, _, _, first, _⟩ := instruction_head blockAt firstAt halted steps + cases first with + | @fetch _ _ _ location box fields firstValue resolved boxAt node _ => + obtain ⟨afterFetchCount, fetchCount, fieldBound, afterFetch⟩ := + fetch_prefix_inverse site blockAt parameterCount resolved boxAt node halted steps + site.shape.fieldCount (Nat.le_refl _) + let opened := (fields.toList.take site.shape.fieldCount).toArray + have openedSize : opened.size = site.shape.fieldCount := by + simp only [opened, List.size_toArray, List.length_take, Array.length_toList, + Nat.min_eq_left fieldBound] + obtain ⟨afterRetainCount, retained, retainCount, retains, afterRetain⟩ := + retain_suffix_inverse site (fields := opened) blockAt parameterCount openedSize halted + opened.toList [] (by simp) (by simpa [prefixValues, opened] using afterFetch) + have retainedFields : RetainSharedMany store opened retained := by simpa using retains + have releaseAt : block.instructions[2 * site.shape.fieldCount]? = + some (.releaseShared (.reg site.shape.source)) := by + simpa only [site.exact] using site.shape.release_at + obtain ⟨remainingCount, _, releaseCount, head, tail⟩ := + instruction_head blockAt releaseAt halted afterRetain + cases head with + | @releaseShared _ releasedValue released remainingFuel sourceResolved releases => + have root : resolveAtom (parameters ++ opened ++ opened) (.reg site.shape.source) = + .ok (.loc location) := by + simpa only [Array.append_assoc] using resolve_parameter_append + (suffix := opened ++ opened) (by rw [parameterCount]; exact site.sourceBound) resolved + have same := Except.ok.inj (sourceResolved.symm.trans root) + subst releasedValue + have avoids : ∀ value ∈ opened.toList, value ≠ .loc location := by + intro value member same + subst value + have original : .loc location ∈ fields.toList := by + exact List.mem_of_mem_take (by simpa only [opened, List.toList_toArray] using member) + have older := ordered.child_lt boxAt (by simpa only [node, IxIR1.Sim.nodeChildren] using original) + omega + have retainedAt := ReuseSim.RetainSharedMany.preserves_box boxAt avoids retains + have shared : box.world = .shared := by + cases heapFuel with + | zero => simp [releaseShared, releaseSharedWork] at releases + | succ fuel => + by_cases same : box.world = .shared + · exact same + · simp [releaseShared, releaseSharedWork, retainedAt, same] at releases + obtain ⟨sourceSchema, _, sourceAt, _, schemaFields, _, _, _⟩ := site.schemas + have fieldCount : fields.size = site.shape.fieldCount := by + have arity := shaped.fields (ConstructorView.of_box boxAt shared node) + (by rw [schemas]; exact sourceAt) + simpa only [schemaFields, Array.size_replicate] using arity + have openedEq : opened = fields := by + simp only [opened, ← fieldCount] + have size : fields.size = fields.toList.length := Array.length_toList.symm + rw [size, List.take_length] + refine ⟨location, box, fields, retained, released, remainingFuel, remainingCount, + resolved, boxAt, shared, node, fieldCount, ?_, releases, ?_, ?_⟩ + · simpa only [openedEq] using retainedFields + · simp only [Array.length_toList, openedSize] at retainCount + omega + · simpa only [openedEq] using tail + +end Ix.Compiler.IxIR2.CallReuse.Sim diff --git a/Ix/Compiler/IxIR2/CallReuseProgress.lean b/Ix/Compiler/IxIR2/CallReuseProgress.lean new file mode 100644 index 000000000..5a8344a06 --- /dev/null +++ b/Ix/Compiler/IxIR2/CallReuseProgress.lean @@ -0,0 +1,127 @@ +import Ix.Compiler.IxIR2.CallReusePrefix + +/-! Every synchronization point after a reset or in an unchanged block advances. -/ + +namespace Ix.Compiler.IxIR2.CallReuse.Sim + +open Eval + +theorem step_terminator {context : Context} {interpretation : Interpretation} + {store : Store} {heapFuel : Nat} {frame : Frame} {stack : List Continuation} + {block : Block} {target : Machine} + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (stepped : Eval.Step context interpretation { store, heapFuel, control := .running frame stack } target) : + TerminatorTransferCase context interpretation store heapFuel frame stack block.terminator target := by + cases stepped.classify with + | instruction found beforeEnd _ _ => + have blocks := Option.some.inj (found.symm.trans blockAt) + cases blocks + omega + | terminator found _ atTerminator classified => + have blocks := Option.some.inj (found.symm.trans blockAt) + cases blocks + simpa only [atTerminator] using classified + +theorem Position.entry_parts {limits : Validate.Limits} {validation : Validate.Context} {block : Block} + {leftPC rightPC : Nat} {credits : Array (Option Credit)} + (position : Position limits validation block leftPC rightPC credits) + {site : Site limits validation block} (produced : inspect limits validation block = some site) + (zero : leftPC = 0) : rightPC = 0 ∧ credits = #[] := by + cases position with + | unchanged rejected cleared => rw [rejected] at produced; cases produced + | entry => exact ⟨rfl, rfl⟩ + | body => omega + | finished => omega + +theorem Frame.entry_eq {frame : Frame} (pc : frame.pc = 0) (credits : frame.credits = #[]) : + frame = { definition := frame.definition, block := frame.block, values := frame.values } := by + cases frame + simp_all + +theorem stable_step_related {limits : Validate.Limits} {validation : Validate.Context} + {leftContext rightContext : Context} {mapping : Array Nat} + {leftStore rightStore : Store} {leftFuel rightFuel : Nat} + {block : Block} {leftFrame rightFrame : Frame} {leftStack rightStack : List Continuation} + {leftAfter : Machine} + (contexts : ContextRel limits validation leftContext rightContext) + (readyContext : ContextReady leftContext) (schemas : leftContext.schemas = validation.schemas) + (machines : MachineRel limits validation leftContext mapping + { store := leftStore, heapFuel := leftFuel, control := .running leftFrame leftStack } + { store := rightStore, heapFuel := rightFuel, control := .running rightFrame rightStack }) + (frames : FrameRel limits validation mapping block leftFrame rightFrame) + (stack : StackRel limits validation mapping leftStack rightStack) + (outside : leftFrame.pc ≠ 0 ∨ inspect limits validation block = none) + (stepped : Eval.Step leftContext .physical + { store := leftStore, heapFuel := leftFuel, control := .running leftFrame leftStack } leftAfter) : + ∃ after rightAfter, + Policy.Step .suspendedCallsV1 rightContext .physical + { store := rightStore, heapFuel := rightFuel, control := .running rightFrame rightStack } rightAfter ∧ + TransferRel limits validation leftContext mapping after leftStore rightStore leftAfter rightAfter := by + rcases leftFrame with ⟨leftDefinition, leftBlock, leftPC, leftValues, leftCredits⟩ + rcases rightFrame with ⟨rightDefinition, rightBlock, rightPC, rightValues, rightCredits⟩ + have position := frames.position + cases position with + | unchanged rejected cleared => + have targetAt : rightDefinition.blocks[rightBlock]? = some block := by + simpa only [rewriteBlock_rejected rejected] using frames.targetAt + cases stepped.classify with + | instruction found pc instructionAt classified => + have blocks := Option.some.inj (found.symm.trans frames.sourceAt) + cases blocks + have free := CreditFree.instructionAt (functionReady_creditFree frames.ready) frames.sourceAt pc + rw [instructionAt] at free + obtain ⟨after, target, targetCase, related⟩ := instruction_related contexts readyContext + machines.heapState machines.fuel frames stack rejected free classified + exact ⟨after, target, Policy.of_originalStep (targetCase.step targetAt pc instructionAt), related⟩ + | terminator found pc terminatorAt classified => + have blocks := Option.some.inj (found.symm.trans frames.sourceAt) + cases blocks + obtain ⟨after, target, targetCase, related⟩ := terminator_related contexts readyContext + machines.heapState machines.fuel frames stack cleared classified + exact ⟨after, target, Policy.of_originalStep (targetCase.step targetAt pc terminatorAt), related⟩ + | entry site produced => + rcases outside with nonzero | rejected + · exact False.elim (nonzero rfl) + · rw [rejected] at produced; cases produced + | body site produced offset within credit layout physical => + have targetAt : rightDefinition.blocks[rightBlock]? = some site.shape.target := by + simpa only [rewriteBlock_accepted produced] using frames.targetAt + by_cases beforeAllocation : offset < site.shape.calls.size + · obtain ⟨call, callAt⟩ := site.call_exists beforeAllocation + have sourceInstruction : block.instructions[2 * site.shape.fieldCount + 1 + offset]? = some call.instruction := by + simp only [site.exact, site.shape.call_at beforeAllocation, + Array.getElem?_eq_getElem beforeAllocation, callAt] + have targetInstruction : site.shape.target.instructions[site.shape.fieldCount + 1 + offset]? = + some call.instruction := by + simp only [site.shape.target_call_at beforeAllocation, + Array.getElem?_eq_getElem beforeAllocation, callAt] + obtain ⟨sourcePC, sourceOpcode⟩ := Array.getElem?_eq_some_iff.mp sourceInstruction + obtain ⟨targetPC, targetOpcode⟩ := Array.getElem?_eq_some_iff.mp targetInstruction + have classified := step_instruction frames.sourceAt sourcePC sourceOpcode stepped + have advanced := frames.advanceBody produced beforeAllocation rfl rfl rfl layout physical + obtain ⟨target, targetStep, related⟩ := callInstruction_related contexts readyContext machines + frames advanced stack targetAt targetPC targetOpcode classified + exact ⟨mapping, target, targetStep, related⟩ + · have atAllocation : offset = site.shape.calls.size := by omega + subst offset + have sourceInstruction : block.instructions[2 * site.shape.fieldCount + 1 + site.shape.calls.size]? = + some (.alloc .shared site.shape.allocationConstructor site.shape.allocationArguments) := by + simpa only [site.exact] using site.shape.alloc_at + obtain ⟨sourcePC, sourceOpcode⟩ := Array.getElem?_eq_some_iff.mp sourceInstruction + exact bodyAllocation_related contexts schemas machines frames stack produced rfl rfl rfl layout physical + (step_instruction frames.sourceAt sourcePC sourceOpcode stepped) + | finished site produced => + have sourcePC : 2 * site.shape.fieldCount + site.shape.calls.size + 2 = block.instructions.size := by + simp only [site.exact, Shape.baseline_size] + have targetPC : site.shape.fieldCount + site.shape.calls.size + 2 = site.shape.target.instructions.size := by simp + have targetAt : rightDefinition.blocks[rightBlock]? = some site.shape.target := by + simpa only [rewriteBlock_accepted produced] using frames.targetAt + have classified := step_terminator frames.sourceAt sourcePC stepped + obtain ⟨after, target, targetCase, related⟩ := terminator_related contexts readyContext + machines.heapState machines.fuel frames stack (by simp [NoLiveCredits]) classified + have sameTerminator : site.shape.target.terminator = block.terminator := by + simp only [site.exact, Shape.target, Shape.baseline] + exact ⟨after, target, Policy.of_originalStep (targetCase.step targetAt targetPC sameTerminator), related⟩ + +end Ix.Compiler.IxIR2.CallReuse.Sim diff --git a/Ix/Compiler/IxIR2/CallReuseShape.lean b/Ix/Compiler/IxIR2/CallReuseShape.lean new file mode 100644 index 000000000..6a168ad30 --- /dev/null +++ b/Ix/Compiler/IxIR2/CallReuseShape.lean @@ -0,0 +1,158 @@ +import Ix.Compiler.IxIR2.CallReuseTerminators + +/-! Exact instruction coordinates of the recognized source and generated block. -/ + +namespace Ix.Compiler.IxIR2.CallReuse + +@[simp] theorem Shape.fetches_size (shape : Shape) : shape.fetches.size = shape.fieldCount := by + simp [Shape.fetches] + +@[simp] theorem Shape.retains_size (shape : Shape) : shape.retains.size = shape.fieldCount := by + simp [Shape.retains] + +@[simp] theorem Shape.moves_size (shape : Shape) : shape.moves.size = shape.fieldCount := by + simp [Shape.moves] + +@[simp] theorem Shape.baseline_size (shape : Shape) : + shape.baseline.instructions.size = 2 * shape.fieldCount + shape.calls.size + 2 := by + simp [Shape.baseline]; omega + +@[simp] theorem Shape.target_size (shape : Shape) : + shape.target.instructions.size = shape.fieldCount + shape.calls.size + 2 := by + simp [Shape.target]; omega + +theorem Shape.fetch_at (shape : Shape) {field : Nat} (within : field < shape.fieldCount) : + shape.baseline.instructions[field]? = + some (.fetch (.reg shape.source) shape.sourceConstructor field) := by + simp (discharger := omega) [Shape.baseline, Array.getElem?_append, Shape.fetches, + Shape.retains, Array.getElem?_range, within] + +theorem Shape.retain_at (shape : Shape) {field : Nat} (within : field < shape.fieldCount) : + shape.baseline.instructions[shape.fieldCount + field]? = + some (.retainShared (.reg (shape.valueParams.size + field))) := by + simp (discharger := omega) [Shape.baseline, Array.getElem?_append, Shape.fetches, + Shape.retains, Array.getElem?_push, Array.getElem?_range, within, + show ¬shape.fieldCount + field < shape.fieldCount by omega, + show field < shape.fieldCount + 1 by omega, show field ≠ shape.fieldCount by omega] + +theorem Shape.release_at (shape : Shape) : + shape.baseline.instructions[2 * shape.fieldCount]? = some (.releaseShared (.reg shape.source)) := by + simp (discharger := omega) [Shape.baseline, Array.getElem?_append, Shape.fetches, + Shape.retains, Array.getElem?_push, Nat.two_mul] + +theorem Shape.call_at (shape : Shape) {offset : Nat} (within : offset < shape.calls.size) : + shape.baseline.instructions[2 * shape.fieldCount + 1 + offset]? = shape.calls[offset]? := by + simp (discharger := omega) [Shape.baseline, Array.getElem?_append, Array.getElem?_push, + Nat.two_mul, Nat.add_assoc, + show ¬shape.fieldCount + (shape.fieldCount + (1 + offset)) < shape.fieldCount by omega, + show shape.fieldCount + (1 + offset) - (shape.fieldCount + 1) = offset by omega, + show offset ≠ shape.calls.size by omega] + +theorem Shape.alloc_at (shape : Shape) : + shape.baseline.instructions[2 * shape.fieldCount + 1 + shape.calls.size]? = + some (.alloc .shared shape.allocationConstructor shape.allocationArguments) := by + simp (discharger := omega) [Shape.baseline, Array.getElem?_append, Array.getElem?_push, + Nat.two_mul, Nat.add_assoc, + show ¬shape.fieldCount + (shape.fieldCount + (1 + shape.calls.size)) < shape.fieldCount by omega, + show shape.fieldCount + (1 + shape.calls.size) - (shape.fieldCount + 1) = shape.calls.size by omega] + +theorem Shape.reset_at (shape : Shape) : + shape.target.instructions[0]? = some (.resetShared (.reg shape.source) shape.sourceConstructor) := by + simp [Shape.target, Array.getElem?_append] + +theorem Shape.move_at (shape : Shape) {field : Nat} (within : field < shape.fieldCount) : + shape.target.instructions[1 + field]? = some (.move (.reg (shape.valueParams.size + field))) := by + simp (discharger := omega) [Shape.target, Array.getElem?_append, Shape.moves, within, + Nat.add_comm 1 field, Array.getElem?_range] + +theorem Shape.target_call_at (shape : Shape) {offset : Nat} (within : offset < shape.calls.size) : + shape.target.instructions[shape.fieldCount + 1 + offset]? = shape.calls[offset]? := by + simp (discharger := omega) [Shape.target, Array.getElem?_append, Array.getElem?_push, + Nat.add_assoc, Nat.add_sub_assoc, + show ¬shape.fieldCount + offset < shape.fieldCount by omega, + show offset ≠ shape.calls.size by omega] + +theorem Shape.target_alloc_at (shape : Shape) : + shape.target.instructions[shape.fieldCount + 1 + shape.calls.size]? = + some (.allocWith 0 .shared shape.allocationConstructor shape.allocationArguments) := by + simp (discharger := omega) [Shape.target, Array.getElem?_append, Array.getElem?_push, + Nat.add_assoc, Nat.add_sub_assoc, + show ¬shape.fieldCount + shape.calls.size < shape.fieldCount by omega] + +theorem Site.sourceBound {limits : Validate.Limits} {validation : Validate.Context} {block : Block} + (site : Site limits validation block) : site.shape.source < site.shape.valueParams.size := + (Array.getElem?_eq_some_iff.mp site.sourceOwned).1 + +theorem Site.schemas {limits : Validate.Limits} {validation : Validate.Context} {block : Block} + (site : Site limits validation block) : + ∃ sourceSchema allocationSchema, + validation.schemas .shared site.shape.sourceConstructor = some sourceSchema ∧ + validation.schemas .shared site.shape.allocationConstructor = some allocationSchema ∧ + sourceSchema.fields = Array.replicate site.shape.fieldCount .shared ∧ + allocationSchema.fields = sourceSchema.fields ∧ + site.representation.layout = sourceSchema.layout ∧ + site.representation.layout = allocationSchema.layout := by + obtain ⟨source, allocation, sourceAt, allocationAt, fields, allocationFields, layouts, represented⟩ := + Reuse.representation?_sound site.representationProduced + exact ⟨source, allocation, sourceAt, allocationAt, fields, allocationFields, + represented, represented.trans layouts⟩ + +theorem Site.call_exists {limits : Validate.Limits} {validation : Validate.Context} {block : Block} + (site : Site limits validation block) {offset : Nat} (within : offset < site.shape.calls.size) : + ∃ call : Eval.Policy.DirectCall, site.shape.calls[offset] = call.instruction := by + have checked := Array.all_eq_true.mp site.directCalls offset within + cases found : site.shape.calls[offset] <;> + simp only [found, Eval.Policy.DirectCall.ofInstruction?, Option.isSome_none, Bool.false_eq_true] at checked + case call address arguments => exact ⟨.function address arguments, rfl⟩ + case callSelf arguments => exact ⟨.self arguments, rfl⟩ + +namespace Sim + +open Eval + +theorem FrameRel.advanceBody {limits : Validate.Limits} {validation : Validate.Context} + {mapping : Array Nat} {block : Block} {left right : Frame} + (frames : FrameRel limits validation mapping block left right) + {site : Site limits validation block} (produced : inspect limits validation block = some site) + {offset : Nat} (within : offset < site.shape.calls.size) {credit : Credit} + (leftPC : left.pc = 2 * site.shape.fieldCount + 1 + offset) + (rightPC : right.pc = site.shape.fieldCount + 1 + offset) + (credits : right.credits = #[some credit]) (layout : credit.layout = site.representation.layout) + (physical : PhysicalCredit credit) : + FrameRel limits validation mapping block + { left with pc := left.pc + 1 } { right with pc := right.pc + 1 } := by + exact { frames with + position := by + simp only + rw [leftPC, rightPC, credits] + simpa only [Nat.add_assoc] using Position.body site produced (offset + 1) (by omega) credit layout physical + entryCount := by intro zero; simp only at zero; omega } + +theorem TransferRel.machineRel {limits : Validate.Limits} {validation : Validate.Context} + {context : Context} {before after : Array Nat} {leftBefore rightBefore : Store} + {leftAfter rightAfter : Machine} + (related : TransferRel limits validation context before after leftBefore rightBefore leftAfter rightAfter) + (reservations : rightAfter.ReservationOwnership) : + MachineRel limits validation context after leftAfter rightAfter := + ⟨related.transition.state.heap, related.transition.state.ordered, related.transition.state.shaped, + related.fuel, related.control, reservations⟩ + +theorem FrameRel.finishBody {limits : Validate.Limits} {validation : Validate.Context} + {mapping : Array Nat} {block : Block} {left right : Frame} + (frames : FrameRel limits validation mapping block left right) + {site : Site limits validation block} (produced : inspect limits validation block = some site) + (leftPC : left.pc = 2 * site.shape.fieldCount + 1 + site.shape.calls.size) + (rightPC : right.pc = site.shape.fieldCount + 1 + site.shape.calls.size) : + FrameRel limits validation mapping block + { left with pc := left.pc + 1 } { right with pc := right.pc + 1, credits := #[none] } := by + exact { frames with + position := by + simp only + rw [show left.pc + 1 = 2 * site.shape.fieldCount + site.shape.calls.size + 2 by omega, + show right.pc + 1 = site.shape.fieldCount + site.shape.calls.size + 2 by omega] + exact Position.finished site produced + entryCount := by intro zero; simp only at zero; omega } + +end Sim + +end Ix.Compiler.IxIR2.CallReuse diff --git a/Ix/Compiler/IxIR2/CallReuseSimulation.lean b/Ix/Compiler/IxIR2/CallReuseSimulation.lean new file mode 100644 index 000000000..bbe401fe3 --- /dev/null +++ b/Ix/Compiler/IxIR2/CallReuseSimulation.lean @@ -0,0 +1,88 @@ +import Ix.Compiler.IxIR2.CallReuseProgress + +/-! Whole finite executions of the actual checked block rewrite. -/ + +namespace Ix.Compiler.IxIR2.CallReuse.Sim + +open Eval + +def Simulates (limits : Validate.Limits) (validation : Validate.Context) + (leftContext rightContext : Context) (mapping : Array Nat) + (left right final : Machine) : Prop := + ∃ after targetCount targetFinal, + Policy.Steps .suspendedCallsV1 rightContext .physical targetCount right targetFinal ∧ + TransferRel limits validation leftContext mapping after left.store right.store final targetFinal + +/-- The compiler trace reconstructs caller suspension, every callee operation, +the reset prefixes, and final credit consumption. No root-liveness or cost +premise is supplied at a synchronization point. -/ +theorem simulate_to_halt {limits : Validate.Limits} {validation : Validate.Context} + {leftContext rightContext : Context} {mapping : Array Nat} {left right final : Machine} {count : Nat} + (contexts : ContextRel limits validation leftContext rightContext) + (readyContext : ContextReady leftContext) (schemas : leftContext.schemas = validation.schemas) + (machines : MachineRel limits validation leftContext mapping left right) + (steps : Eval.Steps leftContext .physical count left final) + (halted : ∃ value, final.control = .halted value) : + Simulates limits validation leftContext rightContext mapping left right final := by + induction count using Nat.strongRecOn generalizing mapping left right with + | ind count ih => + have completeSuffix : ∀ {middleCount targetCount : Nat} {nextMap : Array Nat} + {leftMiddle rightMiddle : Machine}, middleCount < count → + Eval.Steps leftContext .physical middleCount leftMiddle final → + Policy.Steps .suspendedCallsV1 rightContext .physical targetCount right rightMiddle → + TransferRel limits validation leftContext mapping nextMap left.store right.store leftMiddle rightMiddle → + Simulates limits validation leftContext rightContext mapping left right final := by + intro middleCount targetCount nextMap leftMiddle rightMiddle smaller tail targetPrefix transferred + have nextMachines := transferred.machineRel + (targetPrefix.reservationOwnership machines.reservations) + obtain ⟨lastMap, lastCount, targetFinal, rest, related⟩ := ih middleCount smaller nextMachines tail + exact ⟨lastMap, targetCount + lastCount, targetFinal, targetPrefix.trans rest, + ⟨transferred.transition.trans related.transition, related.fuel, related.control⟩⟩ + rcases left with ⟨leftStore, leftFuel, leftControl⟩ + rcases right with ⟨rightStore, rightFuel, rightControl⟩ + cases machines.control with + | halted values => + cases steps with + | refl => exact ⟨mapping, 0, _, .refl _, ⟨.refl machines.heapState, machines.fuel, .halted values⟩⟩ + | cons running _ _ => cases running + | @running block leftFrame rightFrame leftStack rightStack frames stack => + have ordinary : (leftFrame.pc ≠ 0 ∨ inspect limits validation block = none) → + Simulates limits validation leftContext rightContext mapping + { store := leftStore, heapFuel := leftFuel, control := .running leftFrame leftStack } + { store := rightStore, heapFuel := rightFuel, control := .running rightFrame rightStack } final := by + intro outside + cases steps with + | refl => obtain ⟨value, impossible⟩ := halted; cases impossible + | cons _ head tail => + obtain ⟨nextMap, target, targetStep, related⟩ := + stable_step_related contexts readyContext schemas machines frames stack outside head + exact completeSuffix (by omega) tail (.cons rfl targetStep (.refl _)) related + by_cases zero : leftFrame.pc = 0 + · cases decideBlock limits validation block with + | unchanged rejected => exact ordinary (.inr rejected) + | accepted site produced => + obtain ⟨targetZero, targetCredits⟩ := frames.position.entry_parts produced zero + have parameterCount : leftFrame.values.size = site.shape.valueParams.size := by + simpa only [site.exact, Shape.baseline] using frames.entryCount zero + have canonical := Frame.entry_eq zero frames.leftCredits + have canonicalSteps : Eval.Steps leftContext .physical count + { store := leftStore, heapFuel := leftFuel + control := .running + { definition := leftFrame.definition, block := leftFrame.block, values := leftFrame.values } + leftStack } final := by + simpa only [← canonical] using steps + obtain ⟨location, box, fields, retained, released, remainingFuel, remainingCount, + resolved, found, shared, node, fieldCount, retains, releases, counts, tail⟩ := + baseline_prefix_trace site frames.sourceAt parameterCount schemas machines.ordered + machines.shaped halted canonicalSteps + rcases box with ⟨world, rc, payload⟩ + dsimp only at shared node + subst world + subst payload + obtain ⟨target, targetPrefix, related⟩ := reset_prefix_related contexts schemas machines + frames stack produced zero targetZero targetCredits resolved found fieldCount retains releases + apply completeSuffix (middleCount := remainingCount) (by omega) _ targetPrefix related + simpa only [frames.leftCredits] using tail + · exact ordinary (.inl zero) + +end Ix.Compiler.IxIR2.CallReuse.Sim diff --git a/Ix/Compiler/IxIR2/CallReuseTerminators.lean b/Ix/Compiler/IxIR2/CallReuseTerminators.lean new file mode 100644 index 000000000..3cb31aee9 --- /dev/null +++ b/Ix/Compiler/IxIR2/CallReuseTerminators.lean @@ -0,0 +1,155 @@ +import Ix.Compiler.IxIR2.CallReuseInstructions + +/-! CFG edges, returns, tail calls, and residual application preserve the trace relation. -/ + +namespace Ix.Compiler.IxIR2.CallReuse.Sim + +open Eval +open Ix.Compiler.IxIR1.Sim (RValIso RValsIso) + +theorem creditTakeMany_empty {frame after : Frame} {ids : Array CreditId} {credits : Array Credit} + (empty : frame.credits = #[]) (taken : CreditTakeMany frame ids after credits) : + ids = #[] ∧ after = frame ∧ credits = #[] := by + have sequence := taken.sequence + have parts : ∀ {frame after : Frame} {ids : List CreditId} {credits : List Credit}, + CreditTakeSequence frame ids after credits → frame.credits = #[] → + ids = [] ∧ after = frame ∧ credits = [] := by + intro frame after ids credits sequence empty + cases sequence with + | nil => exact ⟨rfl, rfl, rfl⟩ + | cons head tail => + have found := head.target_eq.2 + simp [empty] at found + obtain ⟨idsEmpty, rfl, creditsEmpty⟩ := parts sequence empty + exact ⟨by simpa using congrArg List.toArray idsEmpty, rfl, + by simpa using congrArg List.toArray creditsEmpty⟩ + +theorem edge_related {limits : Validate.Limits} {validation : Validate.Context} + {mapping : Array Nat} {block : Block} {left right leftAfter : Frame} + {edge : Edge} {leftImplicit rightImplicit : Array RVal} + (frames : FrameRel limits validation mapping block left right) + (cleared : NoLiveCredits right) + (implicitValues : RValsIso (MapRel mapping) leftImplicit.toList rightImplicit.toList) + (transferred : EdgeTransfer left edge leftImplicit leftAfter) : + ∃ targetBlock rightAfter, EdgeTransfer right edge rightImplicit rightAfter ∧ + FrameRel limits validation mapping targetBlock leftAfter rightAfter := by + obtain ⟨values, credits, after, targetBlock, resolved, taken, _, blockAt, arity, _, rfl⟩ := transferred.parts + obtain ⟨idsEmpty, rfl, rfl⟩ := creditTakeMany_empty frames.leftCredits taken + obtain ⟨targetValues, targetResolved, valuesRel⟩ := ReuseSim.resolveAtoms_iso frames.values resolved + have targetAt : right.definition.blocks[edge.target]? = + some (rewriteBlock limits validation targetBlock) := by + rw [frames.definition] + exact rewriteFunction_block blockAt + have emptyParams := functionReady_credits frames.ready blockAt + have targetTake : CreditTakeMany right edge.credits right #[] := by + rw [idsEmpty] + exact (CreditTakeSequence.nil right).toMany + have allValues : RValsIso (MapRel mapping) (leftImplicit ++ values).toList + (rightImplicit ++ targetValues).toList := by + simpa only [Array.toList_append] using implicitValues.append valuesRel + refine ⟨targetBlock, _, EdgeTransfer.of_parts targetResolved targetTake cleared targetAt + (by rw [rewriteBlock_valueParams, ← values_size allValues]; exact arity) + (by simp [rewriteBlock_creditParams, emptyParams]), ?_⟩ + have entry := FrameRel.atEntry (limits := limits) (validation := validation) + frames.ready blockAt allValues arity + simpa only [Array.map_empty, frames.definition] using entry + +theorem terminator_related {limits : Validate.Limits} {validation : Validate.Context} + {leftContext rightContext : Context} {mapping : Array Nat} + {leftStore rightStore : Store} {leftFuel rightFuel : Nat} + {block : Block} {leftFrame rightFrame : Frame} {leftStack rightStack : List Continuation} + {terminator : Terminator} {leftAfter : Machine} + (contexts : ContextRel limits validation leftContext rightContext) + (readyContext : ContextReady leftContext) + (state : HeapState leftContext mapping leftStore rightStore) (fuel : leftFuel ≤ rightFuel) + (frames : FrameRel limits validation mapping block leftFrame rightFrame) + (stack : StackRel limits validation mapping leftStack rightStack) + (cleared : NoLiveCredits rightFrame) + (classified : TerminatorTransferCase leftContext .physical leftStore leftFuel leftFrame + leftStack terminator leftAfter) : + ∃ after rightAfter, + TerminatorTransferCase rightContext .physical rightStore rightFuel rightFrame + rightStack terminator rightAfter ∧ + TransferRel limits validation leftContext mapping after leftStore rightStore leftAfter rightAfter := by + cases classified with + | jump transferred => + obtain ⟨targetBlock, rightAfter, edge, related⟩ := edge_related frames cleared .nil transferred + exact ⟨mapping, _, .jump edge, ⟨.refl state, fuel, .running related stack⟩⟩ + | switchCtor resolved boxAt node alternativeAt transferred => + obtain ⟨targetValue, targetResolved, valueRel⟩ := ReuseSim.resolveAtom_iso frames.values resolved + cases valueRel with + | @loc _ targetLocation mapped => + obtain ⟨targetBox, targetFields, targetView, boxes, fieldsRel⟩ := + state.heap.constructorView mapped (ConstructorView.of_box boxAt rfl node) + obtain ⟨targetBlock, rightAfter, edge, related⟩ := edge_related frames cleared .nil transferred + exact ⟨mapping, _, .switchCtor targetResolved targetView.parts.1 targetView.parts.2.2 + alternativeAt edge, ⟨.refl state, fuel, .running related stack⟩⟩ + | switchNatZero resolved transferred => + obtain ⟨targetValue, targetResolved, valueRel⟩ := ReuseSim.resolveAtom_iso frames.values resolved + cases valueRel + obtain ⟨targetBlock, rightAfter, edge, related⟩ := edge_related frames cleared .nil transferred + exact ⟨mapping, _, .switchNatZero targetResolved edge, ⟨.refl state, fuel, .running related stack⟩⟩ + | switchNatSucc resolved transferred => + obtain ⟨targetValue, targetResolved, valueRel⟩ := ReuseSim.resolveAtom_iso frames.values resolved + cases valueRel + obtain ⟨targetBlock, rightAfter, edge, related⟩ := + edge_related frames cleared (.cons .lit .nil) transferred + exact ⟨mapping, _, .switchNatSucc targetResolved edge, ⟨.refl state, fuel, .running related stack⟩⟩ + | branchPresent lookedUp present transferred => + have found := (CreditTake.of_lookup lookedUp).target_eq.2 + simp [frames.leftCredits] at found + | branchAbsent lookedUp absent transferred => + have found := (CreditTake.of_lookup lookedUp).target_eq.2 + simp [frames.leftCredits] at found + | retResume resolved noCredits world => + obtain ⟨targetValue, targetResolved, valueRel⟩ := ReuseSim.resolveAtom_iso frames.values resolved + have targetWorld : RVal.hasWorld rightStore rightFrame.definition.signature.result targetValue = true := by + rw [frames.definition, rewriteFunction_signature] + exact state.heap.hasWorld valueRel world + cases stack with + | cons head tail => + cases head with + | resume caller positive => + exact ⟨mapping, _, .retResume targetResolved cleared targetWorld, + ⟨.refl state, fuel, .running (caller.pushResult positive valueRel) tail⟩⟩ + | retHalt resolved noCredits world => + obtain ⟨targetValue, targetResolved, valueRel⟩ := ReuseSim.resolveAtom_iso frames.values resolved + have targetWorld : RVal.hasWorld rightStore rightFrame.definition.signature.result targetValue = true := by + rw [frames.definition, rewriteFunction_signature] + exact state.heap.hasWorld valueRel world + cases stack + exact ⟨mapping, _, .retHalt targetResolved cleared targetWorld, + ⟨.refl state, fuel, .halted valueRel⟩⟩ + | retApplyMore resolved noCredits world transferred => + obtain ⟨targetValue, targetResolved, valueRel⟩ := ReuseSim.resolveAtom_iso frames.values resolved + have targetWorld : RVal.hasWorld rightStore rightFrame.definition.signature.result targetValue = true := by + rw [frames.definition, rewriteFunction_signature] + exact state.heap.hasWorld valueRel world + cases stack with + | cons head tail => + cases head with + | applyMore caller positive arguments => + obtain ⟨after, target, targetApply, related⟩ := apply_related contexts readyContext state fuel + valueRel arguments caller positive tail transferred + exact ⟨after, target, .retApplyMore targetResolved cleared targetWorld targetApply, related⟩ + | tailCallFn noCredits resolved declaration arity nonempty => + obtain ⟨targetArguments, targetResolved, argumentsRel⟩ := ReuseSim.resolveAtoms_iso frames.values resolved + obtain ⟨entryBlock, entry⟩ := FrameRel.functionEntry (limits := limits) + (validation := validation) (readyContext declaration) argumentsRel arity + exact ⟨mapping, _, .tailCallFn cleared targetResolved (contexts.function declaration) + (by simpa only [rewriteFunction_signature, ← values_size argumentsRel] using arity) + (rewriteFunction_nonempty nonempty), ⟨.refl state, fuel, .running entry stack⟩⟩ + | tailCallSelf noCredits resolved arity nonempty => + obtain ⟨targetArguments, targetResolved, argumentsRel⟩ := ReuseSim.resolveAtoms_iso frames.values resolved + obtain ⟨entryBlock, entry⟩ := FrameRel.functionEntry (limits := limits) + (validation := validation) frames.ready argumentsRel arity + have targetArity : targetArguments.size = rightFrame.definition.signature.params.size := by + simpa only [frames.definition, rewriteFunction_signature, ← values_size argumentsRel] using arity + have targetNonempty : rightFrame.definition.blocks.isEmpty = false := by + simpa only [frames.definition] using rewriteFunction_nonempty (limits := limits) + (context := validation) nonempty + refine ⟨mapping, _, .tailCallSelf cleared targetResolved targetArity targetNonempty, + ⟨.refl state, fuel, .running (sourceBlock := entryBlock) ?_ stack⟩⟩ + simpa only [frames.definition] using entry + +end Ix.Compiler.IxIR2.CallReuse.Sim diff --git a/Ix/Compiler/IxIR2/CallReuseTransition.lean b/Ix/Compiler/IxIR2/CallReuseTransition.lean new file mode 100644 index 000000000..de0a239fd --- /dev/null +++ b/Ix/Compiler/IxIR2/CallReuseTransition.lean @@ -0,0 +1,220 @@ +import Ix.Compiler.IxIR2.CallReuseCalls + +/-! Compositional heap and cost facts for corresponding executable operations. -/ + +namespace Ix.Compiler.IxIR2.CallReuse.Sim + +open Eval +open Ix.Compiler.Ixon (Owned) +open Ix.Compiler.IxIR1.Sim (RValIso RValsIso NodeIso) + +def MapExtends (before after : Array Nat) : Prop := + ∀ {left right}, MapRel before left right → MapRel after left right + +theorem MapExtends.refl (mapping : Array Nat) : MapExtends mapping mapping := fun h => h + +theorem MapExtends.trans {first middle last : Array Nat} + (one : MapExtends first middle) (two : MapExtends middle last) : MapExtends first last := + fun h => two (one h) + +theorem MapExtends.push (mapping : Array Nat) (target : Nat) : + MapExtends mapping (mapping.push target) := fun h => h.push target + +structure HeapState (context : Context) (mapping : Array Nat) (left right : Store) : Prop where + heap : HeapMap left right mapping + ordered : Ordered left + shaped : Shaped context left + +theorem MachineRel.heapState {limits : Validate.Limits} {validation : Validate.Context} + {context : Context} {mapping : Array Nat} {left right : Machine} + (machines : MachineRel limits validation context mapping left right) : + HeapState context mapping left.store right.store := + ⟨machines.heap, machines.ordered, machines.shaped⟩ + +structure HeapTransition (context : Context) (before after : Array Nat) + (leftBefore leftAfter rightBefore rightAfter : Store) : Prop where + state : HeapState context after leftAfter rightAfter + extension : MapExtends before after + costs : CostDelta leftBefore leftAfter rightBefore rightAfter + events : leftAfter.allocationEvents + rightBefore.allocationEvents = + rightAfter.allocationEvents + leftBefore.allocationEvents + +theorem HeapTransition.refl {context : Context} {mapping : Array Nat} {left right : Store} + (state : HeapState context mapping left right) : + HeapTransition context mapping mapping left left right right := + ⟨state, MapExtends.refl mapping, .refl left right, by omega⟩ + +theorem HeapTransition.trans {context : Context} {first middle last : Array Nat} + {l₀ l₁ l₂ r₀ r₁ r₂ : Store} + (one : HeapTransition context first middle l₀ l₁ r₀ r₁) + (two : HeapTransition context middle last l₁ l₂ r₁ r₂) : + HeapTransition context first last l₀ l₂ r₀ r₂ := + ⟨two.state, MapExtends.trans one.extension two.extension, one.costs.trans two.costs, + by have _ := one.events; have _ := two.events; omega⟩ + +theorem HeapState.alloc {context : Context} {mapping : Array Nat} {left right : Store} + (state : HeapState context mapping left right) {world : Owned} {leftNode rightNode : Node} + (nodes : NodeIso (MapRel mapping) leftNode rightNode) + (shaped : ShapedNode context world leftNode) : + HeapTransition context mapping (mapping.push right.heap.nodes.size) + left (left.allocNode world leftNode).1 right (right.allocNode world rightNode).1 := by + have heap := state.heap.alloc (world := world) nodes + refine ⟨⟨heap, state.ordered.alloc state.heap nodes, state.shaped.alloc shaped⟩, + MapExtends.push mapping right.heap.nodes.size, ?_, by simp; omega⟩ + apply state.heap.costDelta heap (events := 1) + (charge := if world = .shared then 1 else 0) + · cases world <;> simp + · cases world <;> simp + · rfl + · rfl + +theorem HeapState.retain {context : Context} {mapping : Array Nat} {left right leftOut : Store} + (state : HeapState context mapping left right) {leftValue rightValue : RVal} + (values : RValIso (MapRel mapping) leftValue rightValue) + (run : retainShared left leftValue = .ok leftOut) : + ∃ rightOut, retainShared right rightValue = .ok rightOut ∧ + HeapTransition context mapping mapping left leftOut right rightOut := by + obtain ⟨rightOut, targetRun, heap⟩ := state.heap.retain values run + have leftObs := retainShared_observations run + have rightObs := retainShared_observations targetRun + have refs : referenceCount leftValue = referenceCount rightValue := by cases values <;> rfl + refine ⟨rightOut, targetRun, ⟨⟨heap, state.ordered.retain run, state.shaped.retain run⟩, + MapExtends.refl mapping, ?_, ?_⟩⟩ + · apply state.heap.costDelta heap (events := 0) (charge := 2 * (referenceCount leftValue : Int)) + · omega + · omega + · exact leftObs.2.2.1 + · exact rightObs.2.2.1 + · rw [retainShared_allocationEvents run, retainShared_allocationEvents targetRun] + omega + +theorem HeapState.reuse {context : Context} {mapping : Array Nat} {left right rightOut : Store} + (state : HeapState context mapping left right) {world : Owned} {leftNode rightNode : Node} + {location payload : Nat} (nodes : NodeIso (MapRel mapping) leftNode rightNode) + (shaped : ShapedNode context world leftNode) + (run : right.reuseReservation location world rightNode payload = .ok rightOut) : + HeapTransition context mapping (mapping.push location) + left (left.allocNode world leftNode).1 right rightOut := by + have heap := state.heap.reuse nodes run + have observed := Store.reuseReservation_observations run + refine ⟨⟨heap, state.ordered.alloc state.heap nodes, state.shaped.alloc shaped⟩, + MapExtends.push mapping location, ?_, ?_⟩ + · apply state.heap.costDelta heap (events := 1) + (charge := if world = .shared then 1 else 0) + · cases world <;> simp + · have potential := observed.2.1 + cases world <;> simp_all + · rfl + · exact observed.2.2.1 + · rw [Store.allocationEvents_allocNode, Store.reuseReservation_allocationEvents run] + omega + +theorem HeapState.retainMany {context : Context} {mapping : Array Nat} {left right leftOut : Store} + (state : HeapState context mapping left right) {leftValues rightValues : Array RVal} + (values : RValsIso (MapRel mapping) leftValues.toList rightValues.toList) + (run : RetainSharedMany left leftValues leftOut) : + ∃ rightOut, RetainSharedMany right rightValues rightOut ∧ + HeapTransition context mapping mapping left leftOut right rightOut := by + obtain ⟨rightOut, targetRun, heap⟩ := state.heap.retainMany values run + have leftObs := run.observations + have rightObs := targetRun.observations + have refs := referenceCountList_iso values + refine ⟨rightOut, targetRun, ⟨⟨heap, state.ordered.retainMany run, state.shaped.retainMany run⟩, + MapExtends.refl mapping, ?_, ?_⟩⟩ + · apply state.heap.costDelta heap (events := 0) + (charge := 2 * (referenceCountList leftValues.toList : Int)) + · omega + · omega + · exact leftObs.2.2.1 + · exact rightObs.2.2.1 + · rw [run.allocationEvents, targetRun.allocationEvents] + omega + +theorem HeapState.releaseWork {context : Context} {mapping : Array Nat} + {left right leftOut : Store} {leftFuel rightFuel leftRemaining : Nat} + (state : HeapState context mapping left right) (fuel : leftFuel ≤ rightFuel) + {leftValues rightValues : List RVal} (values : RValsIso (MapRel mapping) leftValues rightValues) + (run : releaseSharedWork leftFuel left leftValues = .ok (leftOut, leftRemaining)) : + ∃ rightOut rightRemaining, + releaseSharedWork rightFuel right rightValues = .ok (rightOut, rightRemaining) ∧ + leftRemaining ≤ rightRemaining ∧ + HeapTransition context mapping mapping left leftOut right rightOut := by + obtain ⟨rightOut, targetRun, heap⟩ := state.heap.releaseWork values run + have raised := releaseSharedWork_addFuel targetRun (rightFuel - leftFuel) + rw [Nat.add_sub_of_le fuel] at raised + have leftObs := releaseSharedWork_observations run + have rightObs := releaseSharedWork_observations targetRun + refine ⟨rightOut, leftRemaining + (rightFuel - leftFuel), raised, by omega, + ⟨⟨heap, state.ordered.releaseWork run, state.shaped.releaseWork run⟩, MapExtends.refl mapping, ?_, ?_⟩⟩ + · apply state.heap.costDelta heap (events := 0) (charge := 0) + · omega + · omega + · exact leftObs.2.2.1 + · exact rightObs.2.2.1 + · rw [releaseSharedWork_allocationEvents run, releaseSharedWork_allocationEvents targetRun] + omega + +theorem HeapState.dropWork {context : Context} {mapping : Array Nat} + {left right leftOut : Store} {leftFuel rightFuel leftRemaining : Nat} + (state : HeapState context mapping left right) (fuel : leftFuel ≤ rightFuel) + {leftValues rightValues : List RVal} (values : RValsIso (MapRel mapping) leftValues rightValues) + (run : dropUniqueWork leftFuel left leftValues = .ok (leftOut, leftRemaining)) : + ∃ rightOut rightRemaining, + dropUniqueWork rightFuel right rightValues = .ok (rightOut, rightRemaining) ∧ + leftRemaining ≤ rightRemaining ∧ + HeapTransition context mapping mapping left leftOut right rightOut := by + obtain ⟨rightOut, targetRun, heap⟩ := state.heap.dropWork values run + have raised := dropUniqueWork_addFuel targetRun (rightFuel - leftFuel) + rw [Nat.add_sub_of_le fuel] at raised + have leftObs := dropUniqueWork_observations run + have rightObs := dropUniqueWork_observations targetRun + refine ⟨rightOut, leftRemaining + (rightFuel - leftFuel), raised, by omega, + ⟨⟨heap, state.ordered.dropWork run, state.shaped.dropWork run⟩, MapExtends.refl mapping, ?_, ?_⟩⟩ + · apply state.heap.costDelta heap (events := 0) (charge := 0) + · omega + · omega + · exact leftObs.2.2.1 + · exact rightObs.2.2.1 + · rw [dropUniqueWork_allocationEvents run, dropUniqueWork_allocationEvents targetRun] + omega + +theorem HeapState.freeUnique {context : Context} {mapping : Array Nat} {left right : Store} + (state : HeapState context mapping left right) {l r : Nat} {box : NodeBox} + (mapped : MapRel mapping l r) (found : left.get? l = some box) : + HeapTransition context mapping mapping left (left.kill l) right (right.kill r) := by + have heap := state.heap.kill mapped found + refine ⟨⟨heap, state.ordered.kill found, state.shaped.kill found⟩, MapExtends.refl mapping, + ⟨by change right.heap.rcops + left.heap.rcops ≤ left.heap.rcops + right.heap.rcops; omega, + fun bound => bound⟩, by simp; omega⟩ + +theorem values_size {mapping : Array Nat} {left right : Array RVal} + (related : RValsIso (MapRel mapping) left.toList right.toList) : left.size = right.size := + by simpa using related.lengths + +theorem values_extract {mapping : Array Nat} {left right : Array RVal} + (related : RValsIso (MapRel mapping) left.toList right.toList) (start stop : Nat) : + RValsIso (MapRel mapping) (left.extract start stop).toList (right.extract start stop).toList := by + simp only [Array.toList_extract, List.extract_eq_take_drop] + exact (related.drop start).take (stop - start) + +theorem scalarOracle_related {limits : Validate.Limits} {validation : Validate.Context} + {leftContext rightContext : Context} {mapping : Array Nat} + (contexts : ContextRel limits validation leftContext rightContext) + {left right : Array RVal} {address : Ixon.Address} {value : RVal} + (values : RValsIso (MapRel mapping) left.toList right.toList) + (called : ScalarOracleCall leftContext address left value) : + ScalarOracleCall rightContext address right value ∧ RValIso (MapRel mapping) value value := by + obtain ⟨inputs, result⟩ := called.scalar + have scalar : (left.toList.all IxIR1.RVal.isScalar) = true := by + rw [Array.all_toList] + apply Array.all_eq_true.mpr + intro i bound + have valid := Array.all_eq_true.mp inputs i bound + cases valueAt : left[i] <;> simp_all only [RVal.isScalar, IxIR1.RVal.isScalar] + have equal := values.eq_of_allScalar scalar + have same : left = right := Array.toList_inj.mp equal + subst right + refine ⟨called.congrOracle contexts.oracle, ?_⟩ + cases value <;> simp_all [RVal.isScalar] <;> constructor + +end Ix.Compiler.IxIR2.CallReuse.Sim diff --git a/Ix/Compiler/IxIR2/CostObservations.lean b/Ix/Compiler/IxIR2/CostObservations.lean new file mode 100644 index 000000000..58a7c10d5 --- /dev/null +++ b/Ix/Compiler/IxIR2/CostObservations.lean @@ -0,0 +1,470 @@ +import Ix.Compiler.IxIR1.RcPotential +import Ix.Compiler.IxIR2.AllocationEvents + +/-! +# RC and peak-live observations of actual heap operations + +The shared-reference potential is the existing IxIR₁ cost algebra. These +observations remain independent of semantic heap and value correspondence. +-/ + +namespace Ix.Compiler.IxIR2.Eval + +open Ix.Compiler.Ixon (Owned) +open Ix.Compiler.IxIR1 (Node NodeBox RVal) +open Ix.Compiler.IxIR1.CostTrace + +def Store.pendingRC (store : Store) : Nat := sharedRcPotential store.heap + +def Store.amortizedRC (store : Store) : Nat := amortizedRc store.heap + +def referenceCount : RVal → Nat + | .loc _ => 1 + | _ => 0 + +def referenceCountList : List RVal → Nat + | [] => 0 + | value :: rest => referenceCount value + referenceCountList rest + +theorem referenceCountList_iso {locRel : Nat → Nat → Prop} + {left right : List RVal} (values : IxIR1.Sim.RValsIso locRel left right) : + referenceCountList left = referenceCountList right := by + induction values with + | nil => rfl + | cons head tail ih => cases head <;> simp [referenceCountList, referenceCount, ih] + +@[simp] theorem Store.amortizedRC_allocNode (store : Store) (world : Owned) (node : Node) : + (store.allocNode world node).1.amortizedRC = + store.amortizedRC + (if world = .shared then 1 else 0) := by + cases world <;> simp [Store.amortizedRC, amortizedRc, sharedRcPotential, + sharedRcPotentialList_append, sharedRcPotentialList, slotSharedRcPotential, + IxIR1.Store.allocNode] <;> omega + +@[simp] theorem Store.peakLive_allocNode (store : Store) (world : Owned) (node : Node) : + (store.allocNode world node).1.peakLiveNodes = + max store.peakLiveNodes (store.allocNode world node).1.live := rfl + +@[simp] theorem Store.rcops_allocNode (store : Store) (world : Owned) (node : Node) : + (store.allocNode world node).1.heap.rcops = store.heap.rcops := rfl + +theorem retainShared_observations {store output : Store} {value : RVal} + (run : retainShared store value = .ok output) : + output.heap.rcops = store.heap.rcops + referenceCount value ∧ + output.amortizedRC = store.amortizedRC + 2 * referenceCount value ∧ + output.peakLiveNodes = store.peakLiveNodes ∧ output.live = store.live := by + cases value with + | lit literal => cases run; exact ⟨rfl, rfl, rfl, rfl⟩ + | erased => cases run; exact ⟨rfl, rfl, rfl, rfl⟩ + | loc location => + cases found : store.get? location with + | none => simp [retainShared, found] at run + | some box => + by_cases shared : box.world = .shared + · simp [retainShared, found, shared] at run + subst output + have rc := amortizedRc_incRcStore (store := store.heap) + (location := location) (rc := box.rc) (node := box.node) + (by rcases box with ⟨world, rc, node⟩; dsimp at shared; subst world; exact found) + refine ⟨rfl, ?_, rfl, ?_⟩ + · simpa [Store.amortizedRC, IxIR1.Sim.incRcStore, Store.rcTick, + Store.setBox, referenceCount, shared] using rc + · exact Store.live_setBox found + · simp [retainShared, found, shared] at run + +theorem RetainSharedMany.observations {store output : Store} {values : Array RVal} + (run : RetainSharedMany store values output) : + output.heap.rcops = store.heap.rcops + referenceCountList values.toList ∧ + output.amortizedRC = store.amortizedRC + 2 * referenceCountList values.toList ∧ + output.peakLiveNodes = store.peakLiveNodes ∧ output.live = store.live := by + change values.foldlM retainShared store = .ok output at run + rw [← Array.foldlM_toList] at run + have loop : ∀ (values : List RVal) {store output : Store}, + values.foldlM retainShared store = .ok output → + output.heap.rcops = store.heap.rcops + referenceCountList values ∧ + output.amortizedRC = store.amortizedRC + 2 * referenceCountList values ∧ + output.peakLiveNodes = store.peakLiveNodes ∧ output.live = store.live := by + intro values + induction values with + | nil => intro store output run; cases run; exact ⟨rfl, rfl, rfl, rfl⟩ + | cons value rest ih => + intro store output run + rw [List.foldlM_cons] at run + cases head : retainShared store value with + | error error => simp [head, bind, Except.bind] at run + | ok middle => + simp only [head, bind, Except.bind] at run + obtain ⟨firstRC, firstPotential, firstPeak, firstLive⟩ := retainShared_observations head + obtain ⟨tailRC, tailPotential, tailPeak, tailLive⟩ := ih run + simp only [referenceCountList] + exact ⟨by omega, by omega, tailPeak.trans firstPeak, tailLive.trans firstLive⟩ + exact loop values.toList run + +theorem releaseSharedWork_observations {fuel remaining : Nat} + {store output : Store} {values : List RVal} + (run : releaseSharedWork fuel store values = .ok (output, remaining)) : + store.heap.rcops ≤ output.heap.rcops ∧ output.amortizedRC = store.amortizedRC ∧ + output.peakLiveNodes = store.peakLiveNodes ∧ output.live ≤ store.live := by + induction fuel generalizing store values with + | zero => + cases values with + | nil => cases run; exact ⟨Nat.le_refl _, rfl, rfl, Nat.le_refl _⟩ + | cons value rest => simp [releaseSharedWork] at run + | succ fuel ih => + cases values with + | nil => cases run; exact ⟨Nat.le_refl _, rfl, rfl, Nat.le_refl _⟩ + | cons value rest => + cases value with + | lit literal => exact ih run + | erased => exact ih run + | loc location => + cases found : store.get? location with + | none => simp [releaseSharedWork, found] at run + | some box => + by_cases shared : box.world = .shared + · by_cases zero : box.rc = 0 + · simp [releaseSharedWork, found, shared, zero] at run + · by_cases unitRC : box.rc = 1 + · simp only [releaseSharedWork, found, shared, bne_self_eq_false, + Bool.false_eq_true, ↓reduceIte, unitRC, beq_self_eq_true, + Nat.reduceBEq] at run + obtain ⟨rc, potential, peak, live⟩ := ih run + have conserved := amortizedRc_tickKillSharedOne + (store := store.heap) (location := location) (node := box.node) + (by rcases box with ⟨world, rc, node⟩ + dsimp at shared unitRC; subst world; subst rc; exact found) + have removed := Store.live_kill (store := store.rcTick) found + refine ⟨?_, potential.trans ?_, peak, ?_⟩ + · change store.heap.rcops + 1 ≤ output.heap.rcops at rc; omega + · simpa [Store.amortizedRC, Store.kill, Store.rcTick] using conserved + · change (store.rcTick.kill location).live + 1 = store.live at removed + omega + · simp [releaseSharedWork, found, shared, zero, unitRC] at run + obtain ⟨rc, potential, peak, live⟩ := ih run + have conserved := amortizedRc_decRcStore + (store := store.heap) (location := location) (rc := box.rc) + (node := box.node) (by omega) + (by rcases box with ⟨world, rc, node⟩ + dsimp at shared; subst world; exact found) + have unchanged := Store.live_setBox (store := store.rcTick) + (new := ⟨.shared, box.rc - 1, box.node⟩) found + refine ⟨?_, potential.trans ?_, peak, ?_⟩ + · change store.heap.rcops + 1 ≤ output.heap.rcops at rc; omega + · simpa [Store.amortizedRC, IxIR1.Sim.decRcStore, Store.setBox, + Store.rcTick] using conserved + · change (store.rcTick.setBox location _).live = store.live at unchanged + omega + · simp [releaseSharedWork, found, shared] at run + +theorem releaseShared_observations {fuel remaining : Nat} {store output : Store} {value : RVal} + (run : releaseShared fuel store value = .ok (output, remaining)) : + store.heap.rcops ≤ output.heap.rcops ∧ output.amortizedRC = store.amortizedRC ∧ + output.peakLiveNodes = store.peakLiveNodes ∧ output.live ≤ store.live := + releaseSharedWork_observations run + +theorem dropUniqueWork_observations {fuel remaining : Nat} + {store output : Store} {values : List RVal} + (run : dropUniqueWork fuel store values = .ok (output, remaining)) : + output.heap.rcops = store.heap.rcops ∧ output.amortizedRC = store.amortizedRC ∧ + output.peakLiveNodes = store.peakLiveNodes ∧ output.live ≤ store.live := by + induction fuel generalizing store values with + | zero => + cases values with + | nil => cases run; exact ⟨rfl, rfl, rfl, Nat.le_refl _⟩ + | cons value rest => simp [dropUniqueWork] at run + | succ fuel ih => + cases values with + | nil => cases run; exact ⟨rfl, rfl, rfl, Nat.le_refl _⟩ + | cons value rest => + cases value with + | lit literal => exact ih run + | erased => exact ih run + | loc location => + cases found : store.get? location with + | none => simp [dropUniqueWork, found] at run + | some box => + by_cases unique : box.world = .unique + · cases node : box.node with + | papN address arity captured => simp [dropUniqueWork, found, unique, node] at run + | ctorN cid fields => + simp only [dropUniqueWork, found, unique, bne_self_eq_false, + Bool.false_eq_true, ↓reduceIte, node] at run + obtain ⟨rc, potential, peak, live⟩ := ih run + have conserved := amortizedRc_killUnique + (store := store.heap) (location := location) (rc := box.rc) + (node := box.node) + (by rcases box with ⟨world, rc, node⟩ + dsimp at unique; subst world; exact found) + have removed := Store.live_kill found + refine ⟨rc, potential.trans ?_, peak, by omega⟩ + simpa [Store.amortizedRC, Store.kill] using conserved + · simp [dropUniqueWork, found, unique] at run + +theorem dropUnique_observations {fuel remaining : Nat} {store output : Store} {value : RVal} + (run : dropUnique fuel store value = .ok (output, remaining)) : + output.heap.rcops = store.heap.rcops ∧ output.amortizedRC = store.amortizedRC ∧ + output.peakLiveNodes = store.peakLiveNodes ∧ output.live ≤ store.live := + dropUniqueWork_observations run + +@[simp] theorem Store.amortizedRC_tickResetAttempt (store : Store) : + store.tickResetAttempt.amortizedRC = store.amortizedRC := rfl + +@[simp] theorem Store.amortizedRC_tickHotReset (store : Store) : + store.tickHotReset.amortizedRC = store.amortizedRC := rfl + +@[simp] theorem Store.amortizedRC_tickColdReset (store : Store) : + store.tickColdReset.amortizedRC = store.amortizedRC := rfl + +theorem Store.amortizedRC_kill {store : Store} {location : Nat} {box : NodeBox} + (found : store.get? location = some box) : + (store.kill location).amortizedRC + slotSharedRcPotential (some box) = + store.amortizedRC := by + have removed := sharedRcPotential_kill (store := store.heap) found + unfold Store.amortizedRC amortizedRc + change store.heap.rcops + sharedRcPotential (store.heap.kill location) + _ = _ + omega + +theorem Store.amortizedRC_reserve {store : Store} {location : Nat} {box : NodeBox} + (found : store.get? location = some box) : + (store.reserve location).amortizedRC + slotSharedRcPotential (some box) = + store.amortizedRC := by + have removed := Store.amortizedRC_kill found + simpa [Store.amortizedRC, amortizedRc, sharedRcPotential, Store.reserve, + Store.kill, IxIR1.Store.kill, IxIR1.Store.setBox] using removed + +theorem Store.amortizedRC_decrement {store : Store} {location : Nat} {box : NodeBox} + (found : store.get? location = some box) (shared : box.world = .shared) + (many : 1 < box.rc) : + ((store.setBox location { box with rc := box.rc - 1 }).rcTick).amortizedRC = + store.amortizedRC := by + have changed := sharedRcPotential_setBox (store := store.heap) + (new := { box with rc := box.rc - 1 }) found + have slot : slotSharedRcPotential (some box) = box.rc := by + rcases box with ⟨world, rc, node⟩ + dsimp at shared + subst world + rfl + rw [slot] at changed + simp only [slotSharedRcPotential, shared] at changed + unfold Store.amortizedRC amortizedRc + change store.heap.rcops + 1 + sharedRcPotential (store.heap.setBox location _) = _ + simp only [shared] + omega + +theorem Store.releaseReservation_observations {store output : Store} {location : Nat} + (run : store.releaseReservation location = .ok output) : + output.heap.rcops = store.heap.rcops ∧ output.amortizedRC = store.amortizedRC ∧ + output.peakLiveNodes = store.peakLiveNodes ∧ output.live = store.live := by + cases found : store.heap.nodes[location]? with + | none => simp [Store.releaseReservation, found] at run + | some slot => + cases slot with + | some box => simp [Store.releaseReservation, found] at run + | none => + simp only [Store.releaseReservation, found, Except.ok.injEq] at run + subst output + exact ⟨rfl, rfl, rfl, rfl⟩ + +theorem Store.reuseReservation_observations {store output : Store} + {location payloadUnits : Nat} {world : Owned} {node : Node} + (run : store.reuseReservation location world node payloadUnits = .ok output) : + output.heap.rcops = store.heap.rcops ∧ + output.amortizedRC = store.amortizedRC + (if world = .shared then 1 else 0) ∧ + output.peakLiveNodes = max store.peakLiveNodes output.live ∧ + output.live = store.live + 1 := by + have live := (Store.reuseReservation_accounting run).1 + cases found : store.heap.nodes[location]? with + | none => simp [Store.reuseReservation, found] at run + | some slot => + cases slot with + | some box => simp [Store.reuseReservation, found] at run + | none => + simp only [Store.reuseReservation, found, Except.ok.injEq] at run + subst output + refine ⟨rfl, ?_, rfl, live⟩ + have changed := sharedRcPotentialList_set + (new := some (NodeBox.mk world 1 node)) + (show store.heap.nodes.toList[location]? = some none by simpa using found) + cases world <;> + simp only [slotSharedRcPotential, Nat.add_zero] at changed <;> + simp [Store.amortizedRC, amortizedRc, sharedRcPotential, changed, + Array.toList_setIfInBounds, Nat.add_assoc] + +/-- RC work performed by dynamic application, including the outstanding +references it creates. Deep release is already included by conservation. -/ +def applyRCCharge (store : Store) (function : RVal) (arguments : Array RVal) : Int := + match function with + | .loc location => + match store.get? location with + | some box => + match box.node with + | .papN _ _ captured => + 2 * (referenceCountList captured.toList : Int) + + (applyAllocationEvents store function arguments : Int) + | _ => 0 + | none => 0 + | _ => 0 + +theorem applyRCCharge_history {baseline rewritten : Store} + (heap : IxIR1.Sim.HeapHistoryIso baseline.heap rewritten.heap) + {baselineFunction rewrittenFunction : RVal} + {baselineArguments rewrittenArguments : Array RVal} + (function : IxIR1.Sim.RValIso heap.locRel baselineFunction rewrittenFunction) + (argumentCount : baselineArguments.size = rewrittenArguments.size) : + applyRCCharge baseline baselineFunction baselineArguments = + applyRCCharge rewritten rewrittenFunction rewrittenArguments := by + have allocations := applyAllocationEvents_history heap function argumentCount + cases function with + | lit => rfl + | erased => rfl + | loc locations => + rcases heap.related locations with ⟨leftDead, rightDead⟩ | + ⟨leftBox, rightBox, leftAt, rightAt, boxes⟩ + · simp [applyRCCharge, Store.get?, leftDead, rightDead] + · simp only [applyRCCharge, Store.get?, leftAt, rightAt] + have nodes := boxes.node + generalize leftBox.node = leftNode at nodes ⊢ + generalize rightBox.node = rightNode at nodes ⊢ + cases nodes with + | ctor fields => rfl + | pap captured => simp only [referenceCountList_iso captured, allocations] + +theorem ApplyTransferCase.rcCharge {context : Context} {interpretation : Interpretation} + {store : Store} {heapFuel : Nat} {arguments : Array RVal} {resume : Frame} + {stack : List Continuation} {function : RVal} {target : Machine} + (classified : ApplyTransferCase context interpretation store heapFuel + arguments resume stack function target) : + (target.store.amortizedRC : Int) = store.amortizedRC + + applyRCCharge store function arguments := by + cases classified with + | erased released => + have conserved := (releaseSharedWork_observations released).2.1 + simpa only [applyRCCharge, Int.add_zero] using congrArg (fun n : Nat => (n : Int)) conserved + | papUnder boxAt shared node capturedUnder retained released totalUnder => + have first := retained.observations.2.1 + have second := (releaseSharedWork_observations released).2.1 + simp only [applyRCCharge, boxAt, node, applyAllocationEvents, totalUnder, + ↓reduceIte, Store.amortizedRC_allocNode, Int.natCast_add] + omega + | papFn boxAt shared node capturedUnder retained released totalEnough + declaration papSafe suppliedArity nonempty => + have first := retained.observations.2.1 + have second := (releaseSharedWork_observations released).2.1 + simp only [applyRCCharge, boxAt, node, applyAllocationEvents, + Nat.not_lt.mpr totalEnough, ↓reduceIte, Int.natCast_zero, Int.add_zero] + omega + | papExtern boxAt shared node capturedUnder retained released totalEnough + declaration suppliedArity remainingEmpty called => + have first := retained.observations.2.1 + have second := (releaseSharedWork_observations released).2.1 + simp only [applyRCCharge, boxAt, node, applyAllocationEvents, + Nat.not_lt.mpr totalEnough, ↓reduceIte, Int.natCast_zero, Int.add_zero] + omega + +theorem ApplyTransferCase.peakLive {context : Context} {interpretation : Interpretation} + {store : Store} {heapFuel : Nat} {arguments : Array RVal} {resume : Frame} + {stack : List Continuation} {function : RVal} {target : Machine} + (classified : ApplyTransferCase context interpretation store heapFuel + arguments resume stack function target) : + target.store.peakLiveNodes = + if applyAllocationEvents store function arguments = 0 then store.peakLiveNodes + else max store.peakLiveNodes target.store.live := by + cases classified with + | erased released => exact (releaseSharedWork_observations released).2.2.1 + | papUnder boxAt shared node capturedUnder retained released totalUnder => + have first := retained.observations.2.2.1 + have second := (releaseSharedWork_observations released).2.2.1 + simp only [applyAllocationEvents, boxAt, node, totalUnder, ↓reduceIte, + Nat.one_ne_zero, Store.peakLive_allocNode, second, first] + | papFn boxAt shared node capturedUnder retained released totalEnough + declaration papSafe suppliedArity nonempty => + have first := retained.observations.2.2.1 + have second := (releaseSharedWork_observations released).2.2.1 + simp only [applyAllocationEvents, boxAt, node, Nat.not_lt.mpr totalEnough, + ↓reduceIte, second, first] + | papExtern boxAt shared node capturedUnder retained released totalEnough + declaration suppliedArity remainingEmpty called => + have first := retained.observations.2.2.1 + have second := (releaseSharedWork_observations released).2.2.1 + simp only [applyAllocationEvents, boxAt, node, Nat.not_lt.mpr totalEnough, + ↓reduceIte, second, first] + +theorem ApplyTransferCase.live_le {context : Context} {interpretation : Interpretation} + {store : Store} {heapFuel : Nat} {arguments : Array RVal} {resume : Frame} + {stack : List Continuation} {function : RVal} {target : Machine} + (classified : ApplyTransferCase context interpretation store heapFuel + arguments resume stack function target) : + target.store.live ≤ store.live + applyAllocationEvents store function arguments := by + cases classified with + | erased released => exact (releaseSharedWork_observations released).2.2.2 + | papUnder boxAt shared node capturedUnder retained released totalUnder => + have first := retained.observations.2.2.2 + have second := (releaseSharedWork_observations released).2.2.2 + simp only [applyAllocationEvents, boxAt, node, totalUnder, ↓reduceIte, + Store.live_allocNode] + omega + | papFn boxAt shared node capturedUnder retained released totalEnough + declaration papSafe suppliedArity nonempty => + have first := retained.observations.2.2.2 + have second := (releaseSharedWork_observations released).2.2.2 + simp only [applyAllocationEvents, boxAt, node, Nat.not_lt.mpr totalEnough, + ↓reduceIte, Nat.add_zero] + omega + | papExtern boxAt shared node capturedUnder retained released totalEnough + declaration suppliedArity remainingEmpty called => + have first := retained.observations.2.2.2 + have second := (releaseSharedWork_observations released).2.2.2 + simp only [applyAllocationEvents, boxAt, node, Nat.not_lt.mpr totalEnough, + ↓reduceIte, Nat.add_zero] + omega + +theorem ApplyTransfer.rcCharge {context : Context} {interpretation : Interpretation} + {store : Store} {heapFuel : Nat} {arguments : Array RVal} {resume : Frame} + {stack : List Continuation} {function : RVal} {target : Machine} + (transferred : ApplyTransfer context interpretation store heapFuel function + arguments resume stack target) : + (target.store.amortizedRC : Int) = store.amortizedRC + + applyRCCharge store function arguments := transferred.classify.rcCharge + +theorem ApplyTransfer.peakLive {context : Context} {interpretation : Interpretation} + {store : Store} {heapFuel : Nat} {arguments : Array RVal} {resume : Frame} + {stack : List Continuation} {function : RVal} {target : Machine} + (transferred : ApplyTransfer context interpretation store heapFuel function + arguments resume stack target) : + target.store.peakLiveNodes = + if applyAllocationEvents store function arguments = 0 then store.peakLiveNodes + else max store.peakLiveNodes target.store.live := transferred.classify.peakLive + +theorem ApplyTransfer.live_le {context : Context} {interpretation : Interpretation} + {store : Store} {heapFuel : Nat} {arguments : Array RVal} {resume : Frame} + {stack : List Continuation} {function : RVal} {target : Machine} + (transferred : ApplyTransfer context interpretation store heapFuel function + arguments resume stack target) : + target.store.live ≤ store.live + applyAllocationEvents store function arguments := + transferred.classify.live_le + +theorem ApplyTransfer.rcops_mono {context : Context} {interpretation : Interpretation} + {store : Store} {heapFuel : Nat} {arguments : Array RVal} {resume : Frame} + {stack : List Continuation} {function : RVal} {target : Machine} + (transferred : ApplyTransfer context interpretation store heapFuel function + arguments resume stack target) : store.heap.rcops ≤ target.store.heap.rcops := by + cases transferred.classify with + | erased released => exact (releaseSharedWork_observations released).1 + | papUnder boxAt shared node capturedUnder retained released totalUnder => + have first := retained.observations.1 + have second := (releaseSharedWork_observations released).1 + simp only [Store.rcops_allocNode] + omega + | papFn boxAt shared node capturedUnder retained released totalEnough + declaration papSafe suppliedArity nonempty => + have first := retained.observations.1 + have second := (releaseSharedWork_observations released).1 + dsimp only + omega + | papExtern boxAt shared node capturedUnder retained released totalEnough + declaration suppliedArity remainingEmpty called => + have first := retained.observations.1 + have second := (releaseSharedWork_observations released).1 + dsimp only + omega + +end Ix.Compiler.IxIR2.Eval diff --git a/Ix/Compiler/IxIR2/CostSteps.lean b/Ix/Compiler/IxIR2/CostSteps.lean new file mode 100644 index 000000000..aa9a243a7 --- /dev/null +++ b/Ix/Compiler/IxIR2/CostSteps.lean @@ -0,0 +1,371 @@ +import Ix.Compiler.IxIR2.CostObservations + +/-! +# RC charges and peak observations of successful machine steps + +Every allocation occurs at the end of its heap operation. The exact peak +equation therefore includes all internal heap work, even for dynamic apply. +-/ + +namespace Ix.Compiler.IxIR2.Eval + +open Ix.Compiler.IxIR1.CostTrace + +private theorem slotSharedRC (box : NodeBox) : + slotSharedRcPotential (some box) = if box.world = .shared then box.rc else 0 := by + rcases box with ⟨world, rc, node⟩ + cases world <;> rfl + +def resetRCCharge (store : Store) : RVal → Int + | .loc location => + match store.get? location with + | some box => + if box.rc = 1 then -1 + else match box.node with + | .ctorN _ fields => 2 * (referenceCountList fields.toList : Int) + | _ => 0 + | none => 0 + | _ => 0 + +theorem resetRCCharge_history {baseline rewritten : Store} + (heap : IxIR1.Sim.HeapHistoryIso baseline.heap rewritten.heap) + {baselineValue rewrittenValue : RVal} + (values : IxIR1.Sim.RValIso heap.locRel baselineValue rewrittenValue) : + resetRCCharge baseline baselineValue = resetRCCharge rewritten rewrittenValue := by + cases values with + | lit => rfl + | erased => rfl + | loc locations => + rcases heap.related locations with ⟨leftDead, rightDead⟩ | + ⟨leftBox, rightBox, leftAt, rightAt, boxes⟩ + · simp [resetRCCharge, Store.get?, leftDead, rightDead] + · simp only [resetRCCharge, Store.get?, leftAt, rightAt, boxes.rc] + have nodes := boxes.node + generalize leftBox.node = leftNode at nodes ⊢ + generalize rightBox.node = rightNode at nodes ⊢ + cases nodes with + | ctor fields => simp only [referenceCountList_iso fields] + | pap captured => rfl + +def instructionRCCharge (store : Store) (frame : Frame) : Instr → Int + | .alloc world .. | .allocWith _ world .. => if world = .shared then 1 else 0 + | .papp .. => 1 + | .retainShared atom => + match resolveAtom frame.values atom with + | .ok value => 2 * (referenceCount value : Int) + | _ => 0 + | .resetShared atom _ => + match resolveAtom frame.values atom with + | .ok value => resetRCCharge store value + | _ => 0 + | .apply functionAtom argumentAtoms => + match resolveAtom frame.values functionAtom, resolveAtoms frame.values argumentAtoms with + | .ok function, .ok arguments => applyRCCharge store function arguments + | _, _ => 0 + | _ => 0 + +theorem InstructionTransferCase.rcCharge {context : Context} + {interpretation : Interpretation} {store : Store} {heapFuel : Nat} + {frame : Frame} {stack : List Continuation} {instruction : Instr} {target : Machine} + (classified : InstructionTransferCase context interpretation store heapFuel + frame stack instruction target) : + (target.store.amortizedRC : Int) = store.amortizedRC + + instructionRCCharge store frame instruction := by + cases classified <;> simp only [instructionRCCharge, Int.add_zero, + Store.amortizedRC_allocNode, Int.natCast_add, Store.amortizedRC_tickHotReset, + ↓reduceIte] <;> try rfl + case alloc => split <;> simp_all + case allocWithAbsent => split <;> simp_all + case allocWithLogical => split <;> simp_all + case allocWithPhysical reused => + have counted := (Store.reuseReservation_observations reused).2.1 + split <;> simp_all + case discardPhysical released => + exact congrArg (fun n : Nat => (n : Int)) + (Store.releaseReservation_observations released).2.1 + case takeUniqueLogical viewed unitRC => + have removed := Store.amortizedRC_kill viewed.parts.1 + simpa only [slotSharedRC, viewed.parts.2.1, reduceCtorEq, ↓reduceIte, Nat.add_zero] + using congrArg (fun n : Nat => (n : Int)) removed + case takeUniquePhysical viewed unitRC => + have removed := Store.amortizedRC_reserve viewed.parts.1 + simpa only [slotSharedRC, viewed.parts.2.1, reduceCtorEq, ↓reduceIte, Nat.add_zero] + using congrArg (fun n : Nat => (n : Int)) removed + case resetSharedLogicalHot resolved viewed unitRC => + have removed := Store.amortizedRC_kill (store := store.tickResetAttempt) viewed.parts.1 + simp only [slotSharedRC, viewed.parts.2.1, ↓reduceIte, unitRC, + Store.amortizedRC_tickResetAttempt] at removed + simp only [resolved, resetRCCharge, viewed.parts.1, unitRC, ↓reduceIte] + omega + case resetSharedPhysicalHot resolved viewed unitRC => + have removed := Store.amortizedRC_reserve (store := store.tickResetAttempt) viewed.parts.1 + simp only [slotSharedRC, viewed.parts.2.1, ↓reduceIte, unitRC, + Store.amortizedRC_tickResetAttempt] at removed + simp only [resolved, resetRCCharge, viewed.parts.1, unitRC, ↓reduceIte] + omega + case resetSharedCold resolved viewed many retained => + have counted := retained.observations.2.1 + have changed := Store.amortizedRC_decrement (store := store.tickResetAttempt) + viewed.parts.1 viewed.parts.2.1 many + rw [Store.amortizedRC_tickColdReset, changed, Store.amortizedRC_tickResetAttempt] at counted + simp only [resolved, resetRCCharge, viewed.parts.1, viewed.parts.2.2] + split <;> omega + case retainShared resolved retained => + have counted := (retainShared_observations retained).2.1 + simp only [resolved] + omega + case releaseShared released => + exact congrArg (fun n : Nat => (n : Int)) (releaseShared_observations released).2.1 + case dropUnique dropped => + exact congrArg (fun n : Nat => (n : Int)) (dropUnique_observations dropped).2.1 + case freeUnique viewed scalarFields => + have removed := Store.amortizedRC_kill viewed.parts.1 + simpa only [slotSharedRC, viewed.parts.2.1, reduceCtorEq, ↓reduceIte, Nat.add_zero] + using congrArg (fun n : Nat => (n : Int)) removed + case apply functionResolved argumentsResolved transferred => + simpa only [functionResolved, argumentsResolved] using transferred.rcCharge + +theorem InstructionTransferCase.peakLive {context : Context} + {interpretation : Interpretation} {store : Store} {heapFuel : Nat} + {frame : Frame} {stack : List Continuation} {instruction : Instr} {target : Machine} + (classified : InstructionTransferCase context interpretation store heapFuel + frame stack instruction target) : + target.store.peakLiveNodes = + if instructionAllocationEvents store frame instruction = 0 then store.peakLiveNodes + else max store.peakLiveNodes target.store.live := by + cases classified <;> simp only [instructionAllocationEvents, ↓reduceIte, + Nat.one_ne_zero, Store.peakLive_allocNode] <;> try rfl + case allocWithPhysical reused => exact (Store.reuseReservation_observations reused).2.2.1 + case discardPhysical released => exact (Store.releaseReservation_observations released).2.2.1 + case resetSharedCold retained => exact retained.observations.2.2.1 + case retainShared retained => exact (retainShared_observations retained).2.2.1 + case releaseShared released => exact (releaseShared_observations released).2.2.1 + case dropUnique dropped => exact (dropUnique_observations dropped).2.2.1 + case apply functionResolved argumentsResolved transferred => + simpa only [functionResolved, argumentsResolved] using transferred.peakLive + +theorem InstructionTransferCase.live_le {context : Context} + {interpretation : Interpretation} {store : Store} {heapFuel : Nat} + {frame : Frame} {stack : List Continuation} {instruction : Instr} {target : Machine} + (classified : InstructionTransferCase context interpretation store heapFuel + frame stack instruction target) : + target.store.live ≤ store.live + instructionAllocationEvents store frame instruction := by + cases classified <;> simp only [instructionAllocationEvents, Nat.add_zero, + Store.live_allocNode, Nat.le_refl] + case allocWithPhysical reused => exact Nat.le_of_eq (Store.reuseReservation_accounting reused).1 + case discardPhysical released => exact Nat.le_of_eq (Store.releaseReservation_accounting released).1 + case takeUniqueLogical viewed unitRC => have removed := Store.live_kill viewed.parts.1; omega + case takeUniquePhysical viewed unitRC => have removed := Store.live_reserve viewed.parts.1; omega + case resetSharedLogicalHot viewed unitRC => + have removed := Store.live_kill (store := store.tickResetAttempt) viewed.parts.1 + change (store.tickResetAttempt.kill _).live + 1 = store.live at removed + change (store.tickResetAttempt.kill _).live ≤ store.live + omega + case resetSharedPhysicalHot viewed unitRC => + have removed := Store.live_reserve (store := store.tickResetAttempt) viewed.parts.1 + change (store.tickResetAttempt.reserve _).live + 1 = store.live at removed + change (store.tickResetAttempt.reserve _).live ≤ store.live + omega + case resetSharedCold viewed many retained => + have counted := retained.observations.2.2.2 + exact Nat.le_of_eq (counted.trans (Store.live_setBox viewed.parts.1)) + case retainShared retained => exact Nat.le_of_eq (retainShared_observations retained).2.2.2 + case releaseShared released => exact (releaseShared_observations released).2.2.2 + case dropUnique dropped => exact (dropUnique_observations dropped).2.2.2 + case freeUnique viewed scalarFields => have removed := Store.live_kill viewed.parts.1; omega + case apply functionResolved argumentsResolved transferred => + simpa only [functionResolved, argumentsResolved] using transferred.live_le + +def terminatorRCCharge (store : Store) (frame : Frame) + (stack : List Continuation) : Terminator → Int + | .ret atom => + match stack, resolveAtom frame.values atom with + | .applyMore arguments _ :: _, .ok value => applyRCCharge store value arguments + | _, _ => 0 + | _ => 0 + +theorem TerminatorTransferCase.rcCharge {context : Context} + {interpretation : Interpretation} {store : Store} {heapFuel : Nat} + {frame : Frame} {stack : List Continuation} {terminator : Terminator} {target : Machine} + (classified : TerminatorTransferCase context interpretation store heapFuel + frame stack terminator target) : + (target.store.amortizedRC : Int) = store.amortizedRC + + terminatorRCCharge store frame stack terminator := by + cases classified <;> simp only [terminatorRCCharge, Int.add_zero] + case retApplyMore resolved noCredits world transferred => + simpa only [resolved] using transferred.rcCharge + +theorem TerminatorTransferCase.peakLive {context : Context} + {interpretation : Interpretation} {store : Store} {heapFuel : Nat} + {frame : Frame} {stack : List Continuation} {terminator : Terminator} {target : Machine} + (classified : TerminatorTransferCase context interpretation store heapFuel + frame stack terminator target) : + target.store.peakLiveNodes = + if terminatorAllocationEvents store frame stack terminator = 0 then store.peakLiveNodes + else max store.peakLiveNodes target.store.live := by + cases classified <;> simp only [terminatorAllocationEvents, ↓reduceIte] + case retApplyMore resolved noCredits world transferred => + simpa only [resolved] using transferred.peakLive + +theorem TerminatorTransferCase.live_le {context : Context} + {interpretation : Interpretation} {store : Store} {heapFuel : Nat} + {frame : Frame} {stack : List Continuation} {terminator : Terminator} {target : Machine} + (classified : TerminatorTransferCase context interpretation store heapFuel + frame stack terminator target) : + target.store.live ≤ store.live + terminatorAllocationEvents store frame stack terminator := by + cases classified <;> simp only [terminatorAllocationEvents, Nat.add_zero, Nat.le_refl] + case retApplyMore resolved noCredits world transferred => + simpa only [resolved] using transferred.live_le + +theorem InstructionTransferCase.rcops_mono {context : Context} + {interpretation : Interpretation} {store : Store} {heapFuel : Nat} + {frame : Frame} {stack : List Continuation} {instruction : Instr} {target : Machine} + (classified : InstructionTransferCase context interpretation store heapFuel + frame stack instruction target) : store.heap.rcops ≤ target.store.heap.rcops := by + cases classified <;> try exact Nat.le_refl _ + case allocWithPhysical reused => + exact Nat.le_of_eq (Store.reuseReservation_observations reused).1.symm + case discardPhysical released => + exact Nat.le_of_eq (Store.releaseReservation_observations released).1.symm + case resetSharedCold retained => + have counted := retained.observations.1 + change _ = store.heap.rcops + 1 + _ at counted + dsimp only + omega + case retainShared retained => + have counted := (retainShared_observations retained).1 + dsimp only + omega + case releaseShared released => exact (releaseShared_observations released).1 + case dropUnique dropped => exact Nat.le_of_eq (dropUnique_observations dropped).1.symm + case apply transferred => exact transferred.rcops_mono + +theorem TerminatorTransferCase.rcops_mono {context : Context} + {interpretation : Interpretation} {store : Store} {heapFuel : Nat} + {frame : Frame} {stack : List Continuation} {terminator : Terminator} {target : Machine} + (classified : TerminatorTransferCase context interpretation store heapFuel + frame stack terminator target) : store.heap.rcops ≤ target.store.heap.rcops := by + cases classified <;> try exact Nat.le_refl _ + case retApplyMore transferred => exact transferred.rcops_mono + +theorem Step.instructionCosts {context : Context} + {interpretation : Interpretation} {store : Store} {heapFuel : Nat} + {frame : Frame} {stack : List Continuation} {target : Machine} + (step : Step context interpretation ⟨store, heapFuel, .running frame stack⟩ target) + {block : Block} {instruction : Instr} + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instructionAt : block.instructions[frame.pc] = instruction) : + (target.store.amortizedRC : Int) = store.amortizedRC + + instructionRCCharge store frame instruction ∧ + target.store.peakLiveNodes = + if Eval.instructionAllocationEvents store frame instruction = 0 then store.peakLiveNodes + else max store.peakLiveNodes target.store.live := by + cases step.classify with + | instruction found bound atIndex classified => + have same := Option.some.inj (found.symm.trans blockAt) + subst_vars + exact ⟨classified.rcCharge, classified.peakLive⟩ + | terminator found terminal atTerminator classified => + have same := Option.some.inj (found.symm.trans blockAt) + subst_vars + omega + +theorem Step.terminatorCosts {context : Context} + {interpretation : Interpretation} {store : Store} {heapFuel : Nat} + {frame : Frame} {stack : List Continuation} {target : Machine} + (step : Step context interpretation ⟨store, heapFuel, .running frame stack⟩ target) + {block : Block} {terminator : Terminator} + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminatorAt : block.terminator = terminator) : + (target.store.amortizedRC : Int) = store.amortizedRC + + terminatorRCCharge store frame stack terminator ∧ + target.store.peakLiveNodes = + if Eval.terminatorAllocationEvents store frame stack terminator = 0 then store.peakLiveNodes + else max store.peakLiveNodes target.store.live := by + cases step.classify with + | instruction found bound atIndex classified => + have same := Option.some.inj (found.symm.trans blockAt) + subst_vars + omega + | terminator found terminal atTerminator classified => + have same := Option.some.inj (found.symm.trans blockAt) + subst_vars + exact ⟨classified.rcCharge, classified.peakLive⟩ + +/-- The stored peak includes the complete successful heap operation. -/ +theorem Step.peakRecords {context : Context} {interpretation : Interpretation} + {before after : Machine} (step : Step context interpretation before after) : + ∃ events, + after.store.peakLiveNodes = + (if events = 0 then before.store.peakLiveNodes + else max before.store.peakLiveNodes after.store.live) ∧ + after.store.live ≤ before.store.live + events := by + cases step.classify with + | halted => exact ⟨0, rfl, Nat.le_refl _⟩ + | instruction found pc atIndex classified => exact ⟨_, classified.peakLive, classified.live_le⟩ + | terminator found pc atTerminator classified => exact ⟨_, classified.peakLive, classified.live_le⟩ + +theorem Step.peakLive_mono {context : Context} {interpretation : Interpretation} + {before after : Machine} (step : Step context interpretation before after) : + before.store.peakLiveNodes ≤ after.store.peakLiveNodes := by + obtain ⟨events, recorded, _live⟩ := step.peakRecords + rw [recorded] + split + · exact Nat.le_refl _ + · exact Nat.le_max_left _ _ + +theorem Step.preservesPeakBound {context : Context} {interpretation : Interpretation} + {before after : Machine} (step : Step context interpretation before after) + (initial : before.store.live ≤ before.store.peakLiveNodes) : + after.store.live ≤ after.store.peakLiveNodes := by + obtain ⟨events, recorded, live⟩ := step.peakRecords + rw [recorded] + split + · omega + · exact Nat.le_max_right _ _ + +theorem Step.rcops_mono {context : Context} {interpretation : Interpretation} + {before after : Machine} (step : Step context interpretation before after) : + before.store.heap.rcops ≤ after.store.heap.rcops := by + cases step.classify with + | halted => exact Nat.le_refl _ + | instruction found pc atIndex classified => exact classified.rcops_mono + | terminator found pc atTerminator classified => exact classified.rcops_mono + +theorem Steps.costs_mono {context : Context} {interpretation : Interpretation} + {count : Nat} {before after : Machine} + (steps : Steps context interpretation count before after) : + before.store.heap.rcops ≤ after.store.heap.rcops ∧ + before.store.peakLiveNodes ≤ after.store.peakLiveNodes := by + induction steps with + | refl => exact ⟨Nat.le_refl _, Nat.le_refl _⟩ + | cons running head tail ih => + exact ⟨Nat.le_trans head.rcops_mono ih.1, Nat.le_trans head.peakLive_mono ih.2⟩ + +theorem Steps.preservesPeakBound {context : Context} {interpretation : Interpretation} + {count : Nat} {before after : Machine} + (steps : Steps context interpretation count before after) + (initial : before.store.live ≤ before.store.peakLiveNodes) : + after.store.live ≤ after.store.peakLiveNodes := by + induction steps with + | refl => exact initial + | cons running head tail ih => exact ih (head.preservesPeakBound initial) + +/-- Every intermediate state of a successful execution is bounded by its +actual final counters. This includes reset, branch, and reuse macro states. -/ +theorem runMachine_prefix_costs {context : Context} {interpretation : Interpretation} + {controlFuel prefixCount : Nat} {initial middle : Machine} {result : Result} + (run : runMachine context interpretation controlFuel initial = .ok result) + (prefixSteps : Steps context interpretation prefixCount initial middle) + (initialPeak : initial.store.live ≤ initial.store.peakLiveNodes) : + middle.store.heap.rcops ≤ result.store.heap.rcops ∧ + middle.store.peakLiveNodes ≤ result.store.peakLiveNodes ∧ + middle.store.live ≤ result.store.peakLiveNodes := by + obtain ⟨count, _fuel, execution⟩ := runMachine_steps run + obtain ⟨suffixCount, _count, suffix⟩ := prefixSteps.cancelPrefixToHalted execution rfl + have costs := suffix.costs_mono + exact ⟨costs.1, costs.2, Nat.le_trans (prefixSteps.preservesPeakBound initialPeak) costs.2⟩ + +end Ix.Compiler.IxIR2.Eval diff --git a/Ix/Compiler/IxIR2/CreditApply.lean b/Ix/Compiler/IxIR2/CreditApply.lean new file mode 100644 index 000000000..8c0774554 --- /dev/null +++ b/Ix/Compiler/IxIR2/CreditApply.lean @@ -0,0 +1,166 @@ +import Ix.Compiler.IxIR2.CreditControl +import Ix.Compiler.IxIR2.CreditHeap + +/-! Partial application and return-time residual application. -/ + +namespace Ix.Compiler.IxIR2.CreditRefinement + +open Eval +open Ix.Compiler.IxIR1.Sim (RValIso RValsIso NodeBoxIso) +open CallReuse.Sim (MapRel HeapMap) + +structure TransferRel (before after : Array Nat) (left right : Machine) : Prop where + heap : HeapRel after left.store right.store + extension : MapExtends before after + fuel : left.heapFuel = right.heapFuel + control : ControlRel after left.control right.control + +structure MachineRel (mapping : Array Nat) (left right : Machine) : Prop where + heap : HeapRel mapping left.store right.store + fuel : left.heapFuel = right.heapFuel + control : ControlRel mapping left.control right.control + reservations : right.ReservationOwnership + +theorem TransferRel.machine {before after : Array Nat} {left right : Machine} + (related : TransferRel before after left right) (owned : right.ReservationOwnership) : + MachineRel after left right := ⟨related.heap, related.fuel, related.control, owned⟩ + +theorem HeapRel.fieldWorlds {left right : Store} {mapping : Array Nat} + (state : HeapRel mapping left right) {leftValues rightValues : Array RVal} {schema : CtorSchema} + (related : RValsIso (MapRel mapping) leftValues.toList rightValues.toList) + (checked : FieldWorlds left schema leftValues) : FieldWorlds right schema rightValues := by + have forward : ∀ {lefts rights : List RVal}, RValsIso (MapRel mapping) lefts rights → + FieldValuesWorldForward left right lefts rights := by + intro lefts rights related + induction related with + | nil => exact .nil + | cons head tail ih => exact .cons (fun _ valid => state.heap.hasWorld head valid) ih + exact checked.forward (forward related) + +theorem HeapRel.papView {left right : Store} {mapping : Array Nat} + (state : HeapRel mapping left right) {l r : Nat} {box : NodeBox} + {address : Ixon.Address} {arity : Nat} {captured : Array RVal} + (mapped : MapRel mapping l r) (found : left.get? l = some box) + (node : box.node = .papN address arity captured) : + ∃ targetBox targetCaptured, + right.get? r = some targetBox ∧ NodeBoxIso (MapRel mapping) box targetBox ∧ + targetBox.node = .papN address arity targetCaptured ∧ + RValsIso (MapRel mapping) captured.toList targetCaptured.toList := by + obtain ⟨targetBox, targetAt, boxes⟩ := state.heap.forward mapped found + have nodes := boxes.node + rw [node] at nodes + cases targetNode : targetBox.node with + | ctorN cid fields => rw [targetNode] at nodes; cases nodes + | papN targetAddress targetArity targetCaptured => + rw [targetNode] at nodes + cases nodes with + | pap captured => exact ⟨targetBox, targetCaptured, targetAt, boxes, targetNode, captured⟩ + +/-- Dynamic dispatch preserves the actual result and the remaining traversal +budget. The same proof serves ordinary application and every `applyMore` +continuation, while retaining all caller credit files. -/ +theorem apply_related {context : Context} {mapping : Array Nat} + {leftStore rightStore : Store} {heapFuel : Nat} + {leftFunction rightFunction : RVal} {leftArguments rightArguments : Array RVal} + {leftResume rightResume : Frame} {leftStack rightStack : List Continuation} + {leftAfter : Machine} + (state : HeapRel mapping leftStore rightStore) + (function : RValIso (MapRel mapping) leftFunction rightFunction) + (arguments : RValsIso (MapRel mapping) leftArguments.toList rightArguments.toList) + (resume : FrameRel mapping leftResume rightResume) + (stack : StackRel mapping leftStack rightStack) + (transferred : ApplyTransfer context .logical leftStore heapFuel leftFunction + leftArguments leftResume leftStack leftAfter) : + ∃ after rightAfter, + ApplyTransfer context .physical rightStore heapFuel rightFunction + rightArguments rightResume rightStack rightAfter ∧ + TransferRel mapping after leftAfter rightAfter := by + cases transferred.classify with + | erased released => + cases function + obtain ⟨rightOut, targetRun, heap⟩ := state.releaseWork arguments released + exact ⟨mapping, _, .erased targetRun, + ⟨heap, MapExtends.refl _, rfl, .running (resume.push .erased) stack⟩⟩ + | @papUnder location box address arity captured retainedStore releasedStore remaining + found shared node capturedUnder retained released totalUnder => + cases function with + | @loc _ targetLocation mapped => + obtain ⟨targetBox, targetCaptured, targetAt, boxes, targetNode, capturedRel⟩ := + state.papView mapped found node + obtain ⟨targetRetained, targetRetain, retaining⟩ := state.retainMany capturedRel retained + obtain ⟨targetReleased, targetRelease, releasing⟩ := + retaining.releaseWork (.cons (.loc mapped) .nil) released + have total : RValsIso (MapRel mapping) (captured ++ leftArguments).toList + (targetCaptured ++ rightArguments).toList := by + simpa only [Array.toList_append] using capturedRel.append arguments + have allocating := releasing.alloc (world := .shared) + (leftNode := .papN address arity (captured ++ leftArguments)) (.pap total) + have extension : MapExtends mapping (mapping.push targetReleased.heap.nodes.size) := + MapExtends.push mapping targetReleased.heap.nodes.size + have newValue : RValIso (MapRel (mapping.push targetReleased.heap.nodes.size)) + (.loc releasedStore.heap.nodes.size) (.loc targetReleased.heap.nodes.size) := + .loc (by rw [← releasing.heap.size]; exact MapRel.fresh ..) + exact ⟨_, _, .papUnder targetAt (boxes.world.symm.trans shared) + targetNode (by rw [← values_size capturedRel]; exact capturedUnder) + targetRetain targetRelease (by rw [← values_size total]; exact totalUnder), + ⟨allocating, extension, rfl, + .running ((resume.mono extension).push newValue) (stack.mono extension)⟩⟩ + | @papFn location box address arity captured retainedStore releasedStore remaining definition + found shared node capturedUnder retained released totalEnough declaration papSafe suppliedArity nonempty => + cases function with + | @loc _ targetLocation mapped => + obtain ⟨targetBox, targetCaptured, targetAt, boxes, targetNode, capturedRel⟩ := + state.papView mapped found node + obtain ⟨targetRetained, targetRetain, retaining⟩ := state.retainMany capturedRel retained + obtain ⟨targetReleased, targetRelease, releasing⟩ := + retaining.releaseWork (.cons (.loc mapped) .nil) released + have total : RValsIso (MapRel mapping) (captured ++ leftArguments).toList + (targetCaptured ++ rightArguments).toList := by + simpa only [Array.toList_append] using capturedRel.append arguments + have supplied := values_extract total 0 arity + have residual : RValsIso (MapRel mapping) + ((captured ++ leftArguments).extract arity (captured ++ leftArguments).size).toList + ((targetCaptured ++ rightArguments).extract arity + (targetCaptured ++ rightArguments).size).toList := by + simpa only [values_size total] using values_extract total arity (captured ++ leftArguments).size + have empty : ((captured ++ leftArguments).extract arity (captured ++ leftArguments).size).isEmpty = + ((targetCaptured ++ rightArguments).extract arity + (targetCaptured ++ rightArguments).size).isEmpty := by + simp only [Array.isEmpty, values_size residual] + refine ⟨mapping, _, .papFn targetAt (boxes.world.symm.trans shared) + targetNode (by rw [← values_size capturedRel]; exact capturedUnder) + targetRetain targetRelease (by rw [← values_size total]; exact totalEnough) + declaration papSafe (by rw [← values_size supplied]; exact suppliedArity) nonempty, + ⟨releasing, MapExtends.refl _, rfl, .running (.entry definition supplied) (.cons ?_ stack)⟩⟩ + rw [empty] + split + · exact .resume resume + · exact .applyMore resume residual + | @papExtern location box address arity expectedArity captured retainedStore releasedStore remaining value + found shared node capturedUnder retained released totalEnough declaration suppliedArity remainingEmpty called => + cases function with + | @loc _ targetLocation mapped => + obtain ⟨targetBox, targetCaptured, targetAt, boxes, targetNode, capturedRel⟩ := + state.papView mapped found node + obtain ⟨targetRetained, targetRetain, retaining⟩ := state.retainMany capturedRel retained + obtain ⟨targetReleased, targetRelease, releasing⟩ := + retaining.releaseWork (.cons (.loc mapped) .nil) released + have total : RValsIso (MapRel mapping) (captured ++ leftArguments).toList + (targetCaptured ++ rightArguments).toList := by + simpa only [Array.toList_append] using capturedRel.append arguments + have supplied := values_extract total 0 arity + have residual : RValsIso (MapRel mapping) + ((captured ++ leftArguments).extract arity (captured ++ leftArguments).size).toList + ((targetCaptured ++ rightArguments).extract arity + (targetCaptured ++ rightArguments).size).toList := by + simpa only [values_size total] using values_extract total arity (captured ++ leftArguments).size + obtain ⟨targetCalled, valueRel⟩ := scalarOracle_related supplied called + exact ⟨mapping, _, .papExtern targetAt (boxes.world.symm.trans shared) + targetNode (by rw [← values_size capturedRel]; exact capturedUnder) + targetRetain targetRelease (by rw [← values_size total]; exact totalEnough) + declaration (by rw [← values_size supplied]; exact suppliedArity) + (by simpa only [Array.isEmpty_iff_size_eq_zero, values_size residual] using remainingEmpty) + targetCalled, + ⟨releasing, MapExtends.refl _, rfl, .running (resume.push valueRel) stack⟩⟩ + +end Ix.Compiler.IxIR2.CreditRefinement diff --git a/Ix/Compiler/IxIR2/CreditControl.lean b/Ix/Compiler/IxIR2/CreditControl.lean new file mode 100644 index 000000000..2dfc4df0e --- /dev/null +++ b/Ix/Compiler/IxIR2/CreditControl.lean @@ -0,0 +1,150 @@ +import Ix.Compiler.IxIR2.CreditRelation + +/-! Register resolution and linear credit transfer for the same CFG. -/ + +namespace Ix.Compiler.IxIR2.CreditRefinement + +open Eval +open Ix.Compiler.IxIR1.Sim (RValIso RValsIso) +open CallReuse.Sim (MapRel HeapMap) + +theorem values_size {mapping : Array Nat} {left right : Array RVal} + (related : RValsIso (MapRel mapping) left.toList right.toList) : + left.size = right.size := by simpa using related.lengths + +theorem values_extract {mapping : Array Nat} {left right : Array RVal} + (related : RValsIso (MapRel mapping) left.toList right.toList) (start stop : Nat) : + RValsIso (MapRel mapping) (left.extract start stop).toList + (right.extract start stop).toList := by + simp only [Array.toList_extract, List.extract_eq_take_drop] + exact (related.drop start).take (stop - start) + +theorem values_scalar {mapping : Array Nat} {left right : Array RVal} + (related : RValsIso (MapRel mapping) left.toList right.toList) : + left.all RVal.isScalar = right.all RVal.isScalar := by + rw [← Array.all_toList, ← Array.all_toList] + generalize left.toList = leftList at related ⊢ + generalize right.toList = rightList at related ⊢ + induction related with + | nil => rfl + | cons head tail ih => cases head <;> simp only [List.all_cons, RVal.isScalar, ih] + +theorem scalarOracle_related {context : Context} {mapping : Array Nat} + {left right : Array RVal} {address : Ixon.Address} {value : RVal} + (values : RValsIso (MapRel mapping) left.toList right.toList) + (called : ScalarOracleCall context address left value) : + ScalarOracleCall context address right value ∧ RValIso (MapRel mapping) value value := by + obtain ⟨inputs, result⟩ := called.scalar + have scalar : left.toList.all IxIR1.RVal.isScalar = true := by + rw [Array.all_toList] + apply Array.all_eq_true.mpr + intro i bound + have valid := Array.all_eq_true.mp inputs i bound + cases valueAt : left[i] <;> simp_all only [RVal.isScalar, IxIR1.RVal.isScalar] + have same : left = right := Array.toList_inj.mp (values.eq_of_allScalar scalar) + subst right + refine ⟨called, ?_⟩ + cases value <;> simp_all [RVal.isScalar] <;> constructor + +theorem FrameRel.noCredits {mapping : Array Nat} {left right : Frame} + (related : FrameRel mapping left right) (cleared : NoLiveCredits left) : + NoLiveCredits right := by + change right.credits.any Option.isSome = false + change left.credits.any Option.isSome = false at cleared + rw [← Array.any_toList] at cleared ⊢ + rw [← related.credits.any] + exact cleared + +theorem FrameRel.presentCredits {mapping : Array Nat} {left right : Frame} + (related : FrameRel mapping left right) : left.presentCredits = right.presentCredits := by + simp only [Frame.presentCredits, creditPresentCount_eq_countP, ← Array.countP_toList] + exact related.credits.weight + +theorem FrameRel.creditLookup {mapping : Array Nat} {left right : Frame} + (related : FrameRel mapping left right) {index : Nat} {credit : Credit} + (lookedUp : CreditLookup left index credit) : + ∃ target, CreditLookup right index target ∧ CreditRel credit target := by + have found := (CreditTake.of_lookup lookedUp).target_eq.2 + obtain ⟨target, targetAt, credits⟩ := related.credits.get? (by simpa using found) + exact ⟨target, .of_getElem (by simpa using targetAt), credits⟩ + +theorem FrameRel.creditTake {mapping : Array Nat} {left right after : Frame} + (related : FrameRel mapping left right) {index : Nat} {credit : Credit} + (taken : CreditTake left index after credit) : + ∃ target targetCredit, CreditTake right index target targetCredit ∧ + FrameRel mapping after target ∧ CreditRel credit targetCredit := by + obtain ⟨rfl, found⟩ := taken.target_eq + obtain ⟨targetCredit, targetAt, credits⟩ := related.credits.get? (by simpa using found) + refine ⟨_, targetCredit, .of_lookup (.of_getElem (by simpa using targetAt)), ?_, credits⟩ + exact { related with + credits := by + simpa only [Array.toList_setIfInBounds] using related.credits.setNone index } + +theorem FrameRel.creditSequence {mapping : Array Nat} {left right after : Frame} + (related : FrameRel mapping left right) {indices : List Nat} {credits : List Credit} + (taken : CreditTakeSequence left indices after credits) : + ∃ target targetCredits, CreditTakeSequence right indices target targetCredits ∧ + FrameRel mapping after target ∧ CreditsRel (credits.map some) (targetCredits.map some) := by + induction taken generalizing right with + | nil => exact ⟨right, [], .nil _, related, .nil⟩ + | cons head tail ih => + obtain ⟨middle, targetCredit, first, frames, credit⟩ := related.creditTake head + obtain ⟨target, targetCredits, rest, frames, credits⟩ := ih frames + exact ⟨target, targetCredit :: targetCredits, .cons first rest, frames, + .cons (.live credit) credits⟩ + +theorem FrameRel.creditMany {mapping : Array Nat} {left right after : Frame} + (related : FrameRel mapping left right) {indices : Array Nat} {credits : Array Credit} + (taken : CreditTakeMany left indices after credits) : + ∃ target targetCredits, CreditTakeMany right indices target targetCredits ∧ + FrameRel mapping after target ∧ + CreditsRel (credits.map some).toList (targetCredits.map some).toList := by + obtain ⟨target, targetCredits, steps, frames, credits⟩ := related.creditSequence taken.sequence + exact ⟨target, targetCredits.toArray, by simpa using steps.toMany, + frames, by simpa using credits⟩ + +theorem FrameRel.edge {mapping : Array Nat} {left right after : Frame} + (related : FrameRel mapping left right) {edge : Edge} {leftImplicit rightImplicit : Array RVal} + (implicitValues : RValsIso (MapRel mapping) leftImplicit.toList rightImplicit.toList) + (transferred : EdgeTransfer left edge leftImplicit after) : + ∃ target, EdgeTransfer right edge rightImplicit target ∧ FrameRel mapping after target := by + obtain ⟨values, credits, middle, block, resolved, taken, cleared, blockAt, + valueArity, creditArity, rfl⟩ := transferred.parts + obtain ⟨targetValues, targetResolved, valueRel⟩ := ReuseSim.resolveAtoms_iso related.values resolved + obtain ⟨targetMiddle, targetCredits, targetTaken, middleRel, creditsRel⟩ := related.creditMany taken + have combined : RValsIso (MapRel mapping) (leftImplicit ++ values).toList + (rightImplicit ++ targetValues).toList := by + simpa only [Array.toList_append] using implicitValues.append valueRel + refine ⟨_, .of_parts targetResolved targetTaken (middleRel.noCredits cleared) + (by rw [← middleRel.definition]; exact blockAt) + (by rw [← values_size combined]; exact valueArity) ?_, ?_⟩ + · have sizes := creditsRel.lengths + simp only [Array.length_toList, Array.size_map] at sizes + omega + · exact ⟨middleRel.definition, rfl, rfl, combined, creditsRel⟩ + +theorem ContinuationRel.presentCredits {mapping : Array Nat} {left right : Continuation} + (related : ContinuationRel mapping left right) : left.presentCredits = right.presentCredits := by + cases related with + | resume frames => exact frames.presentCredits + | applyMore frames values => exact frames.presentCredits + +theorem StackRel.presentCredits {mapping : Array Nat} {left right : List Continuation} + (related : StackRel mapping left right) : + (left.map Continuation.presentCredits).sum = (right.map Continuation.presentCredits).sum := by + induction related with + | nil => rfl + | cons head tail ih => simp only [List.map_cons, List.sum_cons, head.presentCredits, ih] + +theorem reservedCredit {store : Store} {frame after : Frame} {stack : List Continuation} + {index location : Nat} {credit : Credit} + (owned : (Machine.mk store 0 (.running frame stack)).ReservationOwnership) + (taken : CreditTake frame index after credit) + (present : credit.presence = .present (some location)) : Store.EmptySlot store location := by + apply owned.empty + change location ∈ frame.reservations ++ stack.flatMap Continuation.reservations + apply List.mem_append_left + apply taken.reservations.mem_iff.mpr + simp [Credit.reservation?, present] + +end Ix.Compiler.IxIR2.CreditRefinement diff --git a/Ix/Compiler/IxIR2/CreditExamples.lean b/Ix/Compiler/IxIR2/CreditExamples.lean new file mode 100644 index 000000000..bd3c20d36 --- /dev/null +++ b/Ix/Compiler/IxIR2/CreditExamples.lean @@ -0,0 +1,325 @@ +import Ix.Compiler.IxIR2.CreditRefinement + +/-! +# Full-credit regression gate + +These independently written CFGs exercise combinations beyond the existing +single-candidate optimizer fixtures. Every accepted program runs through the +actual policy runners; comparisons check the whole trace, result shape, +exact costs, and complete reclamation. Guards execute during library builds. +-/ + +namespace Ix.Compiler.IxIR2.CreditRefinement.Examples + +open Eval +open Ix.Compiler.Ixon (Address Owned) + +private def blockAddress : Address := Address.replicate 0xb1 +private def layout : LayoutId := Address.replicate 0xb2 +private def pairLayout : LayoutId := Address.replicate 0xb3 +private def fieldLayout : LayoutId := Address.replicate 0xb4 +private def helperAddress : Address := Address.replicate 0xb5 +private def nestedAddress : Address := Address.replicate 0xb6 +private def leaf : CtorId := ⟨blockAddress, 0, 0⟩ +private def pair : CtorId := ⟨blockAddress, 0, 1⟩ +private def field : CtorId := ⟨blockAddress, 0, 2⟩ + +private def schemas (world : Owned) (cid : CtorId) : Option CtorSchema := + if cid == leaf then some ⟨layout, #[]⟩ + else if cid == pair then some ⟨pairLayout, #[world, world]⟩ + else if cid == field then some ⟨fieldLayout, #[world]⟩ + else none + +private def signature (world : Owned := .unique) : Signature := ⟨#[], world, false⟩ +private def validation : Validate.Context := { schemas } + +private def accepts (policy : CreditPolicy) (program : Program) : Bool := + (Validate.validateWithPolicy policy Validate.defaultLimits validation program).isOk + +private def rejects (policy : CreditPolicy) (kind : Validate.Violation) (program : Program) : Bool := + match Validate.validateWithPolicy policy Validate.defaultLimits validation program with + | .error (.invalid _ actual _) => actual == kind + | _ => false + +private def run (policy : CreditPolicy) (interpretation : Interpretation) (program : Program) + (control : Nat := 3000) (heap : Nat := 2000) : Except Error Result := + Policy.runMain policy (Context.ofProgram program schemas) interpretation program control heap + +private def laws (logical physical : Store) (credits : Nat) : Bool := + decide (CounterLaw logical.snapshot physical.snapshot credits) && + logical.peakLiveNodes == physical.peakLiveNodes && + physical.live + physical.heap.frees + credits == physical.heap.allocs + +private def reclaimed (world : Owned) (result : Result) : Bool := + match reclaim world 2000 result.store result.value with + | .ok (store, _) => store.live == 0 && store.heap.allocs == store.heap.frees + | _ => false + +private def trace : Nat → CreditPolicy → Context → Machine → Machine → Bool + | 0, _, _, _, _ => false + | fuel + 1, policy, context, logical, physical => + laws logical.store physical.store physical.presentCredits && + match logical.control, physical.control with + | .halted _, .halted _ => true + | .running .., .running .. => + match Policy.step policy context .logical logical, + Policy.step policy context .physical physical with + | .ok left, .ok right => trace fuel policy context left right + | _, _ => false + | _, _ => false + +private def traceMatches (policy : CreditPolicy) (program : Program) : Bool := + trace 3000 policy (Context.ofProgram program schemas) + (initialMachine program.main #[] 2000) (initialMachine program.main #[] 2000) + +private def leafAt (store : Store) (value : RVal) : Bool := + match value with + | .loc location => match store.get? location with + | some ⟨.unique, 1, .ctorN cid fields⟩ => cid == leaf && fields.isEmpty + | _ => false + | _ => false + +private def pairResult (result : Result) : Bool := + match result.value with + | .loc location => match result.store.get? location with + | some ⟨.unique, 1, .ctorN cid #[left, right]⟩ => + cid == pair && left != right && leafAt result.store left && leafAt result.store right + | _ => false + | _ => false + +private def fieldResult (world : Owned) (value : Nat) (result : Result) : Bool := + match result.value with + | .loc location => match result.store.get? location with + | some ⟨actualWorld, 1, .ctorN cid #[.lit (.nat actual)]⟩ => + actualWorld == world && cid == field && actual == value + | _ => false + | _ => false + +/-! Two live reservations cross a back edge in reverse order. Nested callees +allocate while those slots remain owned by a suspended caller. -/ + +private def nested : Function := + { signature := signature + blocks := #[ + { valueParams := #[], creditParams := #[] + instructions := #[.alloc .unique leaf #[], .dropUnique (.reg 0)] + terminator := .ret (.lit (.nat 17)) }] } + +private def helper : Function := + { signature := signature + blocks := #[ + { valueParams := #[], creditParams := #[] + instructions := #[.alloc .unique leaf #[], .dropUnique (.reg 0), .call nestedAddress #[]] + terminator := .ret (.reg 1) }] } + +private def pairedLoop (iterations : Nat) (calls : Bool) : Program := + { declarations := [(helperAddress, .fn helper), (nestedAddress, .fn nested)] + main := + { signature := signature + blocks := #[ + { valueParams := #[], creditParams := #[] + instructions := #[.alloc .unique leaf #[], .alloc .unique leaf #[], + .takeUnique (.reg 0) leaf, .takeUnique (.reg 1) leaf] + terminator := .jump { target := 1, values := #[.lit (.nat iterations)], credits := #[0, 1] } }, + { valueParams := #[.scalar], creditParams := #[.required layout, .required layout] + instructions := #[] + terminator := .switchValue (.reg 0) #[] (some + { zero := { target := 3, values := #[], credits := #[0, 1] } + succ := { target := 2, values := #[], credits := #[0, 1] } }) }, + { valueParams := #[.scalar], creditParams := #[.required layout, .required layout] + instructions := if calls then #[.call helperAddress #[], .dropUnique (.reg 1)] else #[] + terminator := .jump { target := 1, values := #[.reg 0], credits := #[1, 0] } }, + { valueParams := #[], creditParams := #[.required layout, .required layout] + instructions := #[.allocWith 0 .unique leaf #[], .allocWith 1 .unique leaf #[], + .alloc .unique pair #[.reg 0, .reg 1]] + terminator := .ret (.reg 2) }] } } + +private def pairedCheck (policy : CreditPolicy) (iterations : Nat) (calls : Bool) : Bool := + let program := pairedLoop iterations calls + accepts policy program && traceMatches policy program && + match run policy .logical program, run policy .physical program 3100 2100 with + | .ok logical, .ok physical => + let extra := if calls then 2 * iterations else 0 + pairResult logical && pairResult physical && laws logical.store physical.store 0 && + logical.store.heap.allocs == 5 + extra && logical.store.heap.frees == 2 + extra && + physical.store.heap.allocs == 3 + extra && physical.store.heap.frees == extra && + physical.store.heap.reuses == 2 && physical.store.heap.rcops == 0 && + physical.store.peakLiveNodes == 3 && reclaimed .unique logical && reclaimed .unique physical + | _, _ => false + +#guard [0, 1, 2, 3, 16, 64].all fun count => + pairedCheck .callLocalV0 count false && pairedCheck .suspendedCallsV1 count false && + pairedCheck .suspendedCallsV1 count true +#guard rejects .callLocalV0 .credit (pairedLoop 2 true) + +private def advance (policy : CreditPolicy) (program : Program) (interpretation : Interpretation) + (count : Nat) : Except Error Machine := + count.fold (fun _ _ state => state.bind (Policy.step policy (Context.ofProgram program schemas) interpretation)) + (.ok (initialMachine program.main #[] 2000)) + +/-! At step 11 the nested callee is active, with two caller reservations and +two continuation frames. Fresh allocation uses the next slot after both +reservations; it cannot occupy either one. -/ +#guard match advance .suspendedCallsV1 (pairedLoop 1 true) .logical 11, + advance .suspendedCallsV1 (pairedLoop 1 true) .physical 11 with + | .ok logical, .ok physical => + physical.presentCredits == 2 && physical.reservations == [0, 1] && + (match physical.store.heap.nodes[0]? with | some none => true | _ => false) && + (match physical.store.heap.nodes[1]? with | some none => true | _ => false) && + physical.store.heap.nodes.size == 4 && physical.store.live == 1 && + laws logical.store physical.store 2 && + match physical.control with + | .running _ stack => stack.length == 2 + | _ => false + | _, _ => false + +/-! Required unique, present optional shared, and absent optional shared +credits coexist. The cold reset's old shared alias survives until released. -/ + +private def mixed : Program := + { declarations := [] + main := + { signature := signature + blocks := #[ + { valueParams := #[], creditParams := #[] + instructions := #[ + .alloc .unique field #[.lit (.nat 11)], + .alloc .shared field #[.lit (.nat 22)], + .alloc .shared field #[.lit (.nat 33)], .retainShared (.reg 2), + .takeUnique (.reg 0) field, .resetShared (.reg 1) field, .resetShared (.reg 2) field, + .allocWith 0 .unique field #[.reg 4], .allocWith 1 .shared field #[.reg 5], + .allocWith 2 .shared field #[.reg 6], + .releaseShared (.reg 3), .releaseShared (.reg 8), .releaseShared (.reg 9)] + terminator := .ret (.reg 7) }] } } + +private def mixedCheck (policy : CreditPolicy) : Bool := + accepts policy mixed && traceMatches policy mixed && + match run policy .logical mixed, run policy .physical mixed 3100 2100 with + | .ok logical, .ok physical => + fieldResult .unique 11 logical && fieldResult .unique 11 physical && + laws logical.store physical.store 0 && + logical.store.heap.allocs == 6 && logical.store.heap.frees == 5 && + physical.store.heap.allocs == 4 && physical.store.heap.frees == 3 && + physical.store.heap.reuses == 2 && physical.store.heap.rcops == 5 && + physical.store.resetAttempts == 2 && physical.store.hotResets == 1 && + physical.store.coldResets == 1 && physical.store.reusedPayloadUnits == 2 && + physical.store.peakLiveNodes == 4 && reclaimed .unique logical && reclaimed .unique physical + | _, _ => false + +#guard mixedCheck .callLocalV0 && mixedCheck .suspendedCallsV1 +#guard match advance .suspendedCallsV1 mixed .logical 7, advance .suspendedCallsV1 mixed .physical 7 with + | .ok logical, .ok physical => + laws logical.store physical.store 2 && physical.presentCredits == 2 && + match physical.control with + | .running frame [] => frame.credits.size == 3 && + frame.credits[2]? == some (some { layout := fieldLayout, presence := .absent }) + | _ => false + | _, _ => false + +/-! Both optional-credit branches reach the same join. One slot is reused, +while another present or absent credit is explicitly discarded. -/ + +private def diamond (cold : Bool) : Program := + { declarations := [] + main := + { signature := signature .shared + blocks := #[ + { valueParams := #[], creditParams := #[] + instructions := #[.alloc .shared field #[.lit (.nat 41)]] ++ + (if cold then #[.retainShared (.reg 0)] else #[]) ++ + #[.resetShared (.reg 0) field] + terminator := .branchCredit 0 + { target := 1, values := if cold then #[.reg 1, .reg 2] else #[.lit (.nat 0), .reg 1], credits := #[0] } + { target := 2, values := if cold then #[.reg 1, .reg 2] else #[.lit (.nat 0), .reg 1], credits := #[0] } }, + { valueParams := #[.owned .shared, .owned .shared], creditParams := #[.required fieldLayout] + instructions := #[] + terminator := .jump { target := 3, values := #[.reg 0, .reg 1], credits := #[0] } }, + { valueParams := #[.owned .shared, .owned .shared], creditParams := #[.optional fieldLayout] + instructions := #[] + terminator := .jump { target := 3, values := #[.reg 0, .reg 1], credits := #[0] } }, + { valueParams := #[.owned .shared, .owned .shared], creditParams := #[.optional fieldLayout] + instructions := #[.allocWith 0 .shared field #[.reg 1], .releaseShared (.reg 0), + .alloc .shared leaf #[]] ++ + (if cold then #[.retainShared (.reg 3)] else #[]) ++ + #[.resetShared (.reg 3) leaf, .discardCredit 1] ++ + (if cold then #[.releaseShared (.reg 4)] else #[]) + terminator := .ret (.reg 2) }] } } + +#guard [CreditPolicy.callLocalV0, .suspendedCallsV1].all fun policy => + [false, true].all fun cold => + let program := diamond cold + accepts policy program && traceMatches policy program && + match run policy .logical program, run policy .physical program with + | .ok logical, .ok physical => + fieldResult .shared 41 logical && fieldResult .shared 41 physical && + laws logical.store physical.store 0 && physical.store.heap.reuses == (if cold then 0 else 1) && + reclaimed .shared logical && reclaimed .shared physical + | _, _ => false + +/-! A borrowed parameter is read while the caller retains its owner and a +separate reservation. The caller subsequently reuses that reservation. -/ + +private def borrowed : Function := + { signature := ⟨#[⟨.unique, .borrowed⟩], .unique, false⟩ + blocks := #[ + { valueParams := #[.borrowed .unique .caller], creditParams := #[] + instructions := #[.fetch (.reg 0) field 0] + terminator := .ret (.lit (.nat 17)) }] } + +private def borrowCall : Program := + { declarations := [(helperAddress, .fn borrowed)] + main := + { signature := signature + blocks := #[ + { valueParams := #[], creditParams := #[] + instructions := #[.alloc .unique field #[.lit (.nat 51)], .alloc .unique leaf #[], + .takeUnique (.reg 1) leaf, .call helperAddress #[.reg 0], .dropUnique (.reg 2), + .allocWith 0 .unique leaf #[], .dropUnique (.reg 3)] + terminator := .ret (.reg 0) }] } } + +#guard accepts .suspendedCallsV1 borrowCall && traceMatches .suspendedCallsV1 borrowCall +#guard rejects .callLocalV0 .credit borrowCall +#guard match run .suspendedCallsV1 .logical borrowCall, run .suspendedCallsV1 .physical borrowCall with + | .ok logical, .ok physical => + fieldResult .unique 51 logical && fieldResult .unique 51 physical && + physical.store.heap.rcops == 0 && physical.store.heap.reuses == 1 && + reclaimed .unique logical && reclaimed .unique physical + | _, _ => false + +/-! Malformed artifacts keep their existing rejection boundary. -/ + +private def replaceBlock (program : Program) (id : Nat) (update : Block → Block) : Program := + { program with main := { program.main with blocks := program.main.blocks.modify id update } } + +#guard rejects .suspendedCallsV1 .credit (replaceBlock (pairedLoop 1 false) 2 fun block => + { block with terminator := .jump { target := 1, values := #[.reg 0], credits := #[0, 0] } }) +#guard rejects .suspendedCallsV1 .credit (replaceBlock (pairedLoop 1 false) 3 fun block => + { block with + instructions := #[.allocWith 0 .unique field #[.lit (.nat 0)], .discardCredit 1] + terminator := .ret (.reg 0) }) +#guard rejects .suspendedCallsV1 .credit (replaceBlock (pairedLoop 1 false) 3 fun block => + { block with + instructions := #[.discardCredit 0, .discardCredit 0, .discardCredit 1] + terminator := .ret (.lit (.nat 0)) }) +#guard rejects .suspendedCallsV1 .resources (replaceBlock (pairedLoop 1 false) 3 fun block => + { block with instructions := #[], terminator := .ret (.lit (.nat 0)) }) +#guard rejects .suspendedCallsV1 .credit (replaceBlock (pairedLoop 1 true) 2 fun block => + { block with instructions := #[], terminator := .tailCall helperAddress #[] }) +#guard [Instr.papp helperAddress #[], .apply .erased #[], .extern helperAddress #[]].all fun instruction => + rejects .suspendedCallsV1 .credit (replaceBlock (pairedLoop 1 true) 2 fun block => + { block with instructions := #[instruction] }) +#guard rejects .suspendedCallsV1 .borrow (replaceBlock borrowCall 0 fun block => + { block with + instructions := #[.alloc .unique field #[.lit (.nat 51)], .fetch (.reg 0) field 0, + .dropUnique (.reg 0)] + terminator := .ret (.reg 1) }) + +/-! Runner fuel is a budget, not a claim of divergence or semantic failure. -/ +#guard match run .suspendedCallsV1 .logical (pairedLoop 1 true) 0 100 with + | .error .controlFuel => true + | _ => false +#guard match run .suspendedCallsV1 .physical (pairedLoop 1 true) 100 0 with + | .error .heapFuel => true + | _ => false + +end Ix.Compiler.IxIR2.CreditRefinement.Examples diff --git a/Ix/Compiler/IxIR2/CreditFree.lean b/Ix/Compiler/IxIR2/CreditFree.lean new file mode 100644 index 000000000..43a88e8a5 --- /dev/null +++ b/Ix/Compiler/IxIR2/CreditFree.lean @@ -0,0 +1,32 @@ +import Ix.Compiler.IxIR2.Basic + +/-! The baseline instruction subset has no credit creation or consumption. +This executable certificate is independent of the ordinary ownership validator. +It lets clients transfer an entire execution between the two interpretations. -/ + +namespace Ix.Compiler.IxIR2.CreditFree + +def instruction : Instr → Bool + | .allocWith .. | .discardCredit .. | .takeUnique .. | .resetShared .. => false + | _ => true + +def function (definition : Function) : Bool := + definition.blocks.all fun block => block.instructions.all instruction + +def program (source : Program) : Bool := + function source.main && source.declarations.all fun entry => + match entry.2 with + | .fn definition => function definition + | .extern _ => true + +theorem instructionAt {definition : Function} {block : Block} + {blockId index : Nat} (free : function definition = true) + (blockAt : definition.blocks[blockId]? = some block) + (bound : index < block.instructions.size) : + instruction block.instructions[index] = true := by + obtain ⟨blockBound, blockEq⟩ := Array.getElem?_eq_some_iff.mp blockAt + subst block + exact Array.all_eq_true.mp + (Array.all_eq_true.mp free blockId blockBound) index bound + +end Ix.Compiler.IxIR2.CreditFree diff --git a/Ix/Compiler/IxIR2/CreditHeap.lean b/Ix/Compiler/IxIR2/CreditHeap.lean new file mode 100644 index 000000000..0d645acf6 --- /dev/null +++ b/Ix/Compiler/IxIR2/CreditHeap.lean @@ -0,0 +1,185 @@ +import Ix.Compiler.IxIR2.CreditHeapObservations +import Ix.Compiler.IxIR2.CallReuseOrder + +/-! Heap operations with exact logical/physical cost agreement. -/ + +namespace Ix.Compiler.IxIR2.CreditRefinement + +open Eval +open Ix.Compiler.Ixon (Owned) +open Ix.Compiler.IxIR1.Sim (RValIso RValsIso NodeIso NodeBoxIso) +open CallReuse.Sim (MapRel HeapMap Ordered) +open Ix.Compiler.IxIR1.Reclamation (AllocationOrderInvariant) + +/-- Reuse changes fresh allocation and free counts. Allocation events, RC, +peak live nodes, and reset decisions agree throughout execution. -/ +structure HeapRel (mapping : Array Nat) (left right : Store) : Prop where + heap : HeapMap left right mapping + events : left.allocationEvents = right.allocationEvents + rcops : left.heap.rcops = right.heap.rcops + peak : left.peakLiveNodes = right.peakLiveNodes + attempts : left.resetAttempts = right.resetAttempts + hot : left.hotResets = right.hotResets + cold : left.coldResets = right.coldResets + ordered : Ordered left + +theorem HeapRel.empty : HeapRel #[] ({} : Store) ({} : Store) := + ⟨.empty, rfl, rfl, rfl, rfl, rfl, rfl, .empty⟩ + +theorem HeapRel.passive {mapping : Array Nat} {left right leftOut rightOut : Store} + (state : HeapRel mapping left right) (heap : HeapMap leftOut rightOut mapping) + (leftPassive : passiveCounters leftOut = passiveCounters left) + (rightPassive : passiveCounters rightOut = passiveCounters right) + (rcops : leftOut.heap.rcops = rightOut.heap.rcops) (ordered : Ordered leftOut) : + HeapRel mapping leftOut rightOut := by + have eventsLeft := congrArg (fun c => c.allocs + c.reuses) leftPassive + have eventsRight := congrArg (fun c => c.allocs + c.reuses) rightPassive + refine ⟨heap, eventsLeft.trans (state.events.trans eventsRight.symm), rcops, ?_, ?_, ?_, ?_, ordered⟩ + · exact (congrArg Counters.peakLiveNodes leftPassive).trans + (state.peak.trans (congrArg Counters.peakLiveNodes rightPassive).symm) + · exact (congrArg Counters.resetAttempts leftPassive).trans + (state.attempts.trans (congrArg Counters.resetAttempts rightPassive).symm) + · exact (congrArg Counters.hotResets leftPassive).trans + (state.hot.trans (congrArg Counters.hotResets rightPassive).symm) + · exact (congrArg Counters.coldResets leftPassive).trans + (state.cold.trans (congrArg Counters.coldResets rightPassive).symm) + +theorem HeapRel.alloc {mapping : Array Nat} {left right : Store} + (state : HeapRel mapping left right) {world : Owned} {leftNode rightNode : Node} + (nodes : NodeIso (MapRel mapping) leftNode rightNode) : + HeapRel (mapping.push right.heap.nodes.size) + (left.allocNode world leftNode).1 (right.allocNode world rightNode).1 := by + have heap := state.heap.alloc (world := world) nodes + refine ⟨heap, by simp only [Store.allocationEvents_allocNode, state.events], + state.rcops, ?_, state.attempts, state.hot, state.cold, state.ordered.alloc state.heap nodes⟩ + simp only [Store.peakLive_allocNode, state.peak, heap.live_eq] + +theorem HeapRel.kill {mapping : Array Nat} {left right : Store} + (state : HeapRel mapping left right) {l r : Nat} {box : NodeBox} + (mapped : MapRel mapping l r) (found : left.get? l = some box) : + HeapRel mapping (left.kill l) (right.kill r) := + ⟨state.heap.kill mapped found, state.events, state.rcops, state.peak, + state.attempts, state.hot, state.cold, AllocationOrderInvariant.kill state.ordered found⟩ + +theorem HeapRel.reserve {mapping : Array Nat} {left right : Store} + (state : HeapRel mapping left right) {l r : Nat} {box : NodeBox} + (mapped : MapRel mapping l r) (found : left.get? l = some box) : + HeapRel mapping (left.kill l) (right.reserve r) := + ⟨state.heap.reserve mapped found, state.events, state.rcops, state.peak, + state.attempts, state.hot, state.cold, AllocationOrderInvariant.kill state.ordered found⟩ + +theorem HeapRel.setBox {mapping : Array Nat} {left right : Store} + (state : HeapRel mapping left right) {l r : Nat} {old newLeft newRight : NodeBox} + (mapped : MapRel mapping l r) (found : left.get? l = some old) + (boxes : NodeBoxIso (MapRel mapping) newLeft newRight) + (ordered : Ordered (left.setBox l newLeft)) : + HeapRel mapping (left.setBox l newLeft) (right.setBox r newRight) := + ⟨state.heap.setBox mapped found boxes, state.events, state.rcops, state.peak, + state.attempts, state.hot, state.cold, ordered⟩ + +theorem HeapRel.rcTick {mapping : Array Nat} {left right : Store} + (state : HeapRel mapping left right) : HeapRel mapping left.rcTick right.rcTick := + ⟨state.heap.rcTick, state.events, congrArg (· + 1) state.rcops, state.peak, + state.attempts, state.hot, state.cold, AllocationOrderInvariant.rcTick state.ordered⟩ + +theorem HeapRel.tickAttempt {mapping : Array Nat} {left right : Store} + (state : HeapRel mapping left right) : + HeapRel mapping left.tickResetAttempt right.tickResetAttempt := + ⟨state.heap.congr rfl rfl, state.events, state.rcops, state.peak, + congrArg (· + 1) state.attempts, state.hot, state.cold, state.ordered⟩ + +theorem HeapRel.tickHot {mapping : Array Nat} {left right : Store} + (state : HeapRel mapping left right) : + HeapRel mapping left.tickHotReset right.tickHotReset := + ⟨state.heap.congr rfl rfl, state.events, state.rcops, state.peak, + state.attempts, congrArg (· + 1) state.hot, state.cold, state.ordered⟩ + +theorem HeapRel.tickCold {mapping : Array Nat} {left right : Store} + (state : HeapRel mapping left right) : + HeapRel mapping left.tickColdReset right.tickColdReset := + ⟨state.heap.congr rfl rfl, state.events, state.rcops, state.peak, + state.attempts, state.hot, congrArg (· + 1) state.cold, state.ordered⟩ + +theorem HeapRel.reuse {mapping : Array Nat} {left right rightOut : Store} + (state : HeapRel mapping left right) {location payload : Nat} {world : Owned} + {leftNode rightNode : Node} (nodes : NodeIso (MapRel mapping) leftNode rightNode) + (run : right.reuseReservation location world rightNode payload = .ok rightOut) : + HeapRel (mapping.push location) (left.allocNode world leftNode).1 rightOut := by + have heap := state.heap.reuse nodes run + have observed := Store.reuseReservation_observations run + have events := Store.reuseReservation_allocationEvents run + refine ⟨heap, by rw [Store.allocationEvents_allocNode, events, state.events], + state.rcops.trans observed.1.symm, ?_, ?_, ?_, ?_, state.ordered.alloc state.heap nodes⟩ + · rw [Store.peakLive_allocNode, observed.2.2.1, state.peak, heap.live_eq] + all_goals + unfold Store.reuseReservation at run + split at run + · cases run + first | exact state.attempts | exact state.hot | exact state.cold + · cases run + +theorem HeapRel.discard {mapping : Array Nat} {left right rightOut : Store} + (state : HeapRel mapping left right) {location : Nat} + (run : right.releaseReservation location = .ok rightOut) : + HeapRel mapping left rightOut := by + unfold Store.releaseReservation at run + split at run + · cases run + exact ⟨state.heap.congr rfl rfl, state.events, state.rcops, state.peak, + state.attempts, state.hot, state.cold, state.ordered⟩ + · cases run + +theorem HeapRel.retain {mapping : Array Nat} {left right leftOut : Store} + (state : HeapRel mapping left right) {leftValue rightValue : RVal} + (values : RValIso (MapRel mapping) leftValue rightValue) + (run : retainShared left leftValue = .ok leftOut) : + ∃ rightOut, retainShared right rightValue = .ok rightOut ∧ HeapRel mapping leftOut rightOut := by + obtain ⟨rightOut, targetRun, heap⟩ := state.heap.retain values run + refine ⟨rightOut, targetRun, state.passive heap (retain_passive run) + (retain_passive targetRun) ?_ (state.ordered.retain run)⟩ + have leftRC := (retainShared_observations run).1 + have rightRC := (retainShared_observations targetRun).1 + have refs : referenceCount leftValue = referenceCount rightValue := by cases values <;> rfl + rw [leftRC, rightRC, state.rcops, refs] + +theorem HeapRel.retainMany {mapping : Array Nat} {left right leftOut : Store} + (state : HeapRel mapping left right) {leftValues rightValues : Array RVal} + (values : RValsIso (MapRel mapping) leftValues.toList rightValues.toList) + (run : RetainSharedMany left leftValues leftOut) : + ∃ rightOut, RetainSharedMany right rightValues rightOut ∧ HeapRel mapping leftOut rightOut := by + obtain ⟨rightOut, targetRun, heap⟩ := state.heap.retainMany values run + refine ⟨rightOut, targetRun, state.passive heap (retainMany_passive run) + (retainMany_passive targetRun) ?_ (state.ordered.retainMany run)⟩ + rw [run.observations.1, targetRun.observations.1, state.rcops, referenceCountList_iso values] + +theorem HeapRel.releaseWork {mapping : Array Nat} {left right leftOut : Store} + (state : HeapRel mapping left right) {fuel remaining : Nat} + {leftValues rightValues : List RVal} (values : RValsIso (MapRel mapping) leftValues rightValues) + (run : releaseSharedWork fuel left leftValues = .ok (leftOut, remaining)) : + ∃ rightOut, releaseSharedWork fuel right rightValues = .ok (rightOut, remaining) ∧ + HeapRel mapping leftOut rightOut := by + obtain ⟨rightOut, targetRun, heap⟩ := state.heap.releaseWork values run + refine ⟨rightOut, targetRun, state.passive heap (releaseWork_passive run) + (releaseWork_passive targetRun) ?_ (state.ordered.releaseWork run)⟩ + have beforePending := state.heap.pendingRC_eq + have afterPending := heap.pendingRC_eq + have leftRC := (releaseSharedWork_observations run).2.1 + have rightRC := (releaseSharedWork_observations targetRun).2.1 + change leftOut.heap.rcops + leftOut.pendingRC = left.heap.rcops + left.pendingRC at leftRC + change rightOut.heap.rcops + rightOut.pendingRC = right.heap.rcops + right.pendingRC at rightRC + have initial := state.rcops + omega + +theorem HeapRel.dropWork {mapping : Array Nat} {left right leftOut : Store} + (state : HeapRel mapping left right) {fuel remaining : Nat} + {leftValues rightValues : List RVal} (values : RValsIso (MapRel mapping) leftValues rightValues) + (run : dropUniqueWork fuel left leftValues = .ok (leftOut, remaining)) : + ∃ rightOut, dropUniqueWork fuel right rightValues = .ok (rightOut, remaining) ∧ + HeapRel mapping leftOut rightOut := by + obtain ⟨rightOut, targetRun, heap⟩ := state.heap.dropWork values run + exact ⟨rightOut, targetRun, state.passive heap (dropWork_passive run) + (dropWork_passive targetRun) ((dropUniqueWork_observations run).1.trans + (state.rcops.trans (dropUniqueWork_observations targetRun).1.symm)) + (state.ordered.dropWork run)⟩ + +end Ix.Compiler.IxIR2.CreditRefinement diff --git a/Ix/Compiler/IxIR2/CreditHeapObservations.lean b/Ix/Compiler/IxIR2/CreditHeapObservations.lean new file mode 100644 index 000000000..7a89823f5 --- /dev/null +++ b/Ix/Compiler/IxIR2/CreditHeapObservations.lean @@ -0,0 +1,113 @@ +import Ix.Compiler.IxIR2.CreditRelation + +/-! Counters untouched by retain and recursive destruction. -/ + +namespace Ix.Compiler.IxIR2.CreditRefinement + +open Eval + +/-- Recursive heap traversal changes RC and free counts; every other counter +is preserved. Live nodes are tracked separately by the heap relation. -/ +def passiveCounters (store : Store) : Counters := + { store.counters with frees := 0, rcops := 0 } + +theorem retain_passive {store output : Store} {value : RVal} + (run : retainShared store value = .ok output) : + passiveCounters output = passiveCounters store := by + cases value with + | lit => cases run; rfl + | erased => cases run; rfl + | loc location => + cases found : store.get? location with + | none => simp [retainShared, found] at run + | some box => + by_cases shared : box.world = .shared + · simp [retainShared, found, shared] at run + subst output + rfl + · simp [retainShared, found, shared] at run + +theorem retainMany_passive {store output : Store} {values : Array RVal} + (run : RetainSharedMany store values output) : + passiveCounters output = passiveCounters store := by + change values.foldlM retainShared store = .ok output at run + rw [← Array.foldlM_toList] at run + have loop : ∀ (values : List RVal) {store output : Store}, + values.foldlM retainShared store = .ok output → + passiveCounters output = passiveCounters store := by + intro values + induction values with + | nil => intro store output run; cases run; rfl + | cons head tail ih => + intro store output run + rw [List.foldlM_cons] at run + cases first : retainShared store head with + | error error => simp [first, bind, Except.bind] at run + | ok middle => + simp only [first, bind, Except.bind] at run + exact (ih run).trans (retain_passive first) + exact loop values.toList run + +theorem releaseWork_passive {fuel remaining : Nat} {store output : Store} {values : List RVal} + (run : releaseSharedWork fuel store values = .ok (output, remaining)) : + passiveCounters output = passiveCounters store := by + induction fuel generalizing store values with + | zero => + cases values with + | nil => cases run; rfl + | cons => simp [releaseSharedWork] at run + | succ fuel ih => + cases values with + | nil => cases run; rfl + | cons value rest => + cases value with + | lit => exact ih run + | erased => exact ih run + | loc location => + cases found : store.get? location with + | none => simp [releaseSharedWork, found] at run + | some box => + by_cases shared : box.world = .shared + · by_cases zero : box.rc = 0 + · simp [releaseSharedWork, found, shared, zero] at run + · by_cases unit : box.rc = 1 + · simp only [releaseSharedWork, found, shared, bne_self_eq_false, + Bool.false_eq_true, ↓reduceIte, unit, beq_self_eq_true, + Nat.reduceBEq] at run + have preserved := ih run + exact preserved + · simp [releaseSharedWork, found, shared, zero, unit] at run + have preserved := ih run + exact preserved + · simp [releaseSharedWork, found, shared] at run + +theorem dropWork_passive {fuel remaining : Nat} {store output : Store} {values : List RVal} + (run : dropUniqueWork fuel store values = .ok (output, remaining)) : + passiveCounters output = passiveCounters store := by + induction fuel generalizing store values with + | zero => + cases values with + | nil => cases run; rfl + | cons => simp [dropUniqueWork] at run + | succ fuel ih => + cases values with + | nil => cases run; rfl + | cons value rest => + cases value with + | lit => exact ih run + | erased => exact ih run + | loc location => + cases found : store.get? location with + | none => simp [dropUniqueWork, found] at run + | some box => + by_cases unique : box.world = .unique + · cases node : box.node with + | papN => simp [dropUniqueWork, found, unique, node] at run + | ctorN cid fields => + simp only [dropUniqueWork, found, unique, bne_self_eq_false, + Bool.false_eq_true, ↓reduceIte, node] at run + have preserved := ih run + exact preserved + · simp [dropUniqueWork, found, unique] at run + +end Ix.Compiler.IxIR2.CreditRefinement diff --git a/Ix/Compiler/IxIR2/CreditInstructions.lean b/Ix/Compiler/IxIR2/CreditInstructions.lean new file mode 100644 index 000000000..0b5a5a250 --- /dev/null +++ b/Ix/Compiler/IxIR2/CreditInstructions.lean @@ -0,0 +1,230 @@ +import Ix.Compiler.IxIR2.CreditApply + +/-! Every instruction of the logical/physical credit language. -/ + +namespace Ix.Compiler.IxIR2.CreditRefinement + +open Eval +open Ix.Compiler.IxIR1.Sim (RValIso RValsIso) +open CallReuse.Sim (MapRel) + +theorem instruction_related {context : Context} {mapping : Array Nat} + {leftStore rightStore : Store} {heapFuel : Nat} + {leftFrame rightFrame : Frame} {leftStack rightStack : List Continuation} + {instruction : Instr} {leftAfter : Machine} + (state : HeapRel mapping leftStore rightStore) + (frames : FrameRel mapping leftFrame rightFrame) + (stack : StackRel mapping leftStack rightStack) + (owned : (Machine.mk rightStore 0 (.running rightFrame rightStack)).ReservationOwnership) + (classified : InstructionTransferCase context .logical leftStore heapFuel leftFrame + leftStack instruction leftAfter) : + ∃ after rightAfter, + InstructionTransferCase context .physical rightStore heapFuel rightFrame + rightStack instruction rightAfter ∧ TransferRel mapping after leftAfter rightAfter := by + have advanced := frames.advance + cases classified + case move atom value resolved => + obtain ⟨targetValue, targetResolved, valueRel⟩ := ReuseSim.resolveAtom_iso frames.values resolved + exact ⟨mapping, _, .move targetResolved, + ⟨state, MapExtends.refl _, rfl, .running (advanced.push valueRel) stack⟩⟩ + case alloc world cid arguments schema values schemaAt resolved fields => + obtain ⟨targetValues, targetResolved, valuesRel⟩ := ReuseSim.resolveAtoms_iso frames.values resolved + have allocating := state.alloc (world := world) (leftNode := .ctorN cid values) (.ctor valuesRel) + have extension : MapExtends mapping (mapping.push rightStore.heap.nodes.size) := + MapExtends.push mapping rightStore.heap.nodes.size + have valueRel : RValIso (MapRel (mapping.push rightStore.heap.nodes.size)) + (.loc leftStore.heap.nodes.size) (.loc rightStore.heap.nodes.size) := + .loc (by rw [← state.heap.size]; exact MapRel.fresh ..) + exact ⟨_, _, .alloc schemaAt targetResolved (state.fieldWorlds valuesRel fields), + ⟨allocating, extension, rfl, + .running ((advanced.mono extension).push valueRel) (stack.mono extension)⟩⟩ + case allocWithAbsent index credit world cid arguments schema values next + schemaAt resolved fields taken layout absent => + obtain ⟨targetValues, targetResolved, valuesRel⟩ := ReuseSim.resolveAtoms_iso frames.values resolved + obtain ⟨targetNext, targetCredit, targetTaken, nextRel, creditRel⟩ := advanced.creditTake taken + cases creditRel with + | present => cases absent + | absent creditLayout => + have allocating := state.alloc (world := world) (leftNode := .ctorN cid values) (.ctor valuesRel) + have extension : MapExtends mapping (mapping.push rightStore.heap.nodes.size) := + MapExtends.push mapping rightStore.heap.nodes.size + have valueRel : RValIso (MapRel (mapping.push rightStore.heap.nodes.size)) + (.loc leftStore.heap.nodes.size) (.loc rightStore.heap.nodes.size) := + .loc (by rw [← state.heap.size]; exact MapRel.fresh ..) + exact ⟨_, _, .allocWithAbsent schemaAt targetResolved (state.fieldWorlds valuesRel fields) + targetTaken layout rfl, ⟨allocating, extension, rfl, + .running ((nextRel.mono extension).push valueRel) (stack.mono extension)⟩⟩ + case allocWithLogical index credit world cid arguments schema values next + mode schemaAt resolved fields taken layout present => + obtain ⟨targetValues, targetResolved, valuesRel⟩ := ReuseSim.resolveAtoms_iso frames.values resolved + obtain ⟨targetNext, targetCredit, targetTaken, nextRel, creditRel⟩ := advanced.creditTake taken + cases creditRel with + | absent => cases present + | present creditLayout location => + have empty := reservedCredit (frame := { rightFrame with pc := rightFrame.pc + 1 }) + owned targetTaken rfl + obtain ⟨output, reused⟩ : ∃ output, + rightStore.reuseReservation location world (.ctorN cid targetValues) + schema.fields.size = .ok output := by + unfold Store.reuseReservation + rw [empty] + exact ⟨_, rfl⟩ + have allocating := state.reuse (leftNode := .ctorN cid values) (.ctor valuesRel) reused + have extension : MapExtends mapping (mapping.push location) := MapExtends.push mapping location + have valueRel : RValIso (MapRel (mapping.push location)) + (.loc leftStore.heap.nodes.size) (.loc location) := + .loc (by rw [← state.heap.size]; exact MapRel.fresh ..) + exact ⟨_, _, .allocWithPhysical rfl schemaAt targetResolved (state.fieldWorlds valuesRel fields) + targetTaken layout rfl reused, ⟨allocating, extension, rfl, + .running ((nextRel.mono extension).push valueRel) (stack.mono extension)⟩⟩ + case allocWithPhysical => contradiction + case discardAbsent index credit next taken absent => + obtain ⟨targetNext, targetCredit, targetTaken, nextRel, creditRel⟩ := advanced.creditTake taken + cases creditRel with + | present => cases absent + | absent => exact ⟨mapping, _, .discardAbsent targetTaken rfl, + ⟨state, MapExtends.refl _, rfl, .running nextRel stack⟩⟩ + case discardLogical index credit next mode taken present => + obtain ⟨targetNext, targetCredit, targetTaken, nextRel, creditRel⟩ := advanced.creditTake taken + cases creditRel with + | absent => cases present + | present creditLayout location => + have empty := reservedCredit (frame := { rightFrame with pc := rightFrame.pc + 1 }) + owned targetTaken rfl + obtain ⟨output, released⟩ : ∃ output, + rightStore.releaseReservation location = .ok output := by + unfold Store.releaseReservation + rw [empty] + exact ⟨_, rfl⟩ + exact ⟨mapping, _, .discardPhysical rfl targetTaken rfl released, + ⟨state.discard released, MapExtends.refl _, rfl, .running nextRel stack⟩⟩ + case discardPhysical => contradiction + case takeUniqueLogical atom cid schema location box fields mode schemaAt resolved viewed unitRC => + obtain ⟨targetValue, targetResolved, valueRel⟩ := ReuseSim.resolveAtom_iso frames.values resolved + cases valueRel with + | @loc _ targetLocation mapped => + obtain ⟨targetBox, targetFields, targetView, boxes, fieldsRel⟩ := + state.heap.constructorView mapped viewed + exact ⟨mapping, _, .takeUniquePhysical rfl schemaAt targetResolved targetView + (boxes.rc.symm.trans unitRC), + ⟨state.reserve mapped viewed.parts.1, MapExtends.refl _, rfl, + .running (advanced.appendCredit fieldsRel (.present schema.layout targetLocation)) stack⟩⟩ + case takeUniquePhysical => contradiction + case resetSharedLogicalHot atom cid schema location box fields mode schemaAt resolved viewed unitRC => + obtain ⟨targetValue, targetResolved, valueRel⟩ := ReuseSim.resolveAtom_iso frames.values resolved + cases valueRel with + | @loc _ targetLocation mapped => + obtain ⟨targetBox, targetFields, targetView, boxes, fieldsRel⟩ := + state.heap.constructorView mapped viewed + exact ⟨mapping, _, .resetSharedPhysicalHot rfl schemaAt targetResolved targetView + (boxes.rc.symm.trans unitRC), + ⟨(state.tickAttempt.reserve mapped viewed.parts.1).tickHot, MapExtends.refl _, rfl, + .running (advanced.appendCredit fieldsRel (.present schema.layout targetLocation)) stack⟩⟩ + case resetSharedPhysicalHot => contradiction + case resetSharedCold atom cid schema location box fields output schemaAt resolved viewed many retained => + obtain ⟨targetValue, targetResolved, valueRel⟩ := ReuseSim.resolveAtom_iso frames.values resolved + cases valueRel with + | @loc _ targetLocation mapped => + obtain ⟨targetBox, targetFields, targetView, boxes, fieldsRel⟩ := + state.heap.constructorView mapped viewed + have changed := ((state.tickAttempt.setBox mapped viewed.parts.1 + (newLeft := { box with rc := box.rc - 1 }) + (newRight := { targetBox with rc := targetBox.rc - 1 }) + ⟨boxes.world, congrArg (· - 1) boxes.rc, boxes.node⟩ + (IxIR1.Reclamation.AllocationOrderInvariant.setRc state.ordered viewed.parts.1 + (newRc := box.rc - 1) (by omega))).rcTick).tickCold + obtain ⟨targetOutput, targetRetained, heap⟩ := changed.retainMany fieldsRel retained + exact ⟨mapping, _, .resetSharedCold schemaAt targetResolved targetView + (by rw [← boxes.rc]; exact many) targetRetained, + ⟨heap, MapExtends.refl _, rfl, + .running (advanced.appendCredit fieldsRel (.absent schema.layout)) stack⟩⟩ + case retainShared atom value output resolved retained => + obtain ⟨targetValue, targetResolved, valueRel⟩ := ReuseSim.resolveAtom_iso frames.values resolved + obtain ⟨targetOutput, targetRun, heap⟩ := state.retain valueRel retained + exact ⟨mapping, _, .retainShared targetResolved targetRun, + ⟨heap, MapExtends.refl _, rfl, .running (advanced.push valueRel) stack⟩⟩ + case releaseShared atom value output remaining resolved released => + obtain ⟨targetValue, targetResolved, valueRel⟩ := ReuseSim.resolveAtom_iso frames.values resolved + obtain ⟨targetOutput, targetRun, heap⟩ := state.releaseWork (.cons valueRel .nil) released + exact ⟨mapping, _, .releaseShared targetResolved targetRun, + ⟨heap, MapExtends.refl _, rfl, .running advanced stack⟩⟩ + case dropUnique atom value output remaining resolved dropped => + obtain ⟨targetValue, targetResolved, valueRel⟩ := ReuseSim.resolveAtom_iso frames.values resolved + obtain ⟨targetOutput, targetRun, heap⟩ := state.dropWork (.cons valueRel .nil) dropped + exact ⟨mapping, _, .dropUnique targetResolved targetRun, + ⟨heap, MapExtends.refl _, rfl, .running advanced stack⟩⟩ + case freeUnique atom cid location box fields resolved viewed scalarFields => + obtain ⟨targetValue, targetResolved, valueRel⟩ := ReuseSim.resolveAtom_iso frames.values resolved + cases valueRel with + | @loc _ targetLocation mapped => + obtain ⟨targetBox, targetFields, targetView, boxes, fieldsRel⟩ := + state.heap.constructorView mapped viewed + exact ⟨mapping, _, .freeUnique targetResolved targetView + (by rw [← values_scalar fieldsRel]; exact scalarFields), + ⟨state.kill mapped viewed.parts.1, MapExtends.refl _, rfl, .running advanced stack⟩⟩ + case fetch atom cid field location box fields value resolved boxAt node fieldAt => + obtain ⟨targetValue, targetResolved, valueRel⟩ := ReuseSim.resolveAtom_iso frames.values resolved + cases valueRel with + | @loc _ targetLocation mapped => + obtain ⟨targetBox, targetFields, targetView, boxes, fieldsRel⟩ := + state.heap.constructorView mapped (ConstructorView.of_box boxAt rfl node) + obtain ⟨targetField, targetFieldAt, fieldRel⟩ := fieldsRel.get? (by simpa using fieldAt) + exact ⟨mapping, _, .fetch targetResolved targetView.parts.1 targetView.parts.2.2 + (by simpa using targetFieldAt), + ⟨state, MapExtends.refl _, rfl, .running (advanced.push fieldRel) stack⟩⟩ + case callFn address atoms arguments definition noCredits resolved declaration arity nonempty => + obtain ⟨targetArguments, targetResolved, argumentsRel⟩ := ReuseSim.resolveAtoms_iso frames.values resolved + exact ⟨mapping, _, .callFn (frames.noCredits noCredits) targetResolved declaration + (by rw [← values_size argumentsRel]; exact arity) nonempty, + ⟨state, MapExtends.refl _, rfl, + .running (.entry definition argumentsRel) (.cons (.resume advanced) stack)⟩⟩ + case callSelf atoms arguments noCredits resolved arity nonempty => + obtain ⟨targetArguments, targetResolved, argumentsRel⟩ := ReuseSim.resolveAtoms_iso frames.values resolved + refine ⟨mapping, _, .callSelf (frames.noCredits noCredits) targetResolved + (by rw [← values_size argumentsRel, ← frames.definition]; exact arity) + (by rw [← frames.definition]; exact nonempty), + ⟨state, MapExtends.refl _, rfl, .running ?_ (.cons (.resume advanced) stack)⟩⟩ + simpa only [frames.definition] using FrameRel.entry leftFrame.definition argumentsRel + case pappFn address atoms arguments definition noCredits declaration papSafe resolved under => + obtain ⟨targetArguments, targetResolved, argumentsRel⟩ := ReuseSim.resolveAtoms_iso frames.values resolved + have allocating := state.alloc (world := .shared) + (leftNode := .papN address definition.signature.params.size arguments) (.pap argumentsRel) + have extension : MapExtends mapping (mapping.push rightStore.heap.nodes.size) := + MapExtends.push mapping rightStore.heap.nodes.size + have valueRel : RValIso (MapRel (mapping.push rightStore.heap.nodes.size)) + (.loc leftStore.heap.nodes.size) (.loc rightStore.heap.nodes.size) := + .loc (by rw [← state.heap.size]; exact MapRel.fresh ..) + exact ⟨_, _, .pappFn (frames.noCredits noCredits) declaration papSafe targetResolved + (by rw [← values_size argumentsRel]; exact under), + ⟨allocating, extension, rfl, + .running ((advanced.mono extension).push valueRel) (stack.mono extension)⟩⟩ + case pappExtern address atoms arguments arity noCredits declaration resolved under => + obtain ⟨targetArguments, targetResolved, argumentsRel⟩ := ReuseSim.resolveAtoms_iso frames.values resolved + have allocating := state.alloc (world := .shared) + (leftNode := .papN address arity arguments) (.pap argumentsRel) + have extension : MapExtends mapping (mapping.push rightStore.heap.nodes.size) := + MapExtends.push mapping rightStore.heap.nodes.size + have valueRel : RValIso (MapRel (mapping.push rightStore.heap.nodes.size)) + (.loc leftStore.heap.nodes.size) (.loc rightStore.heap.nodes.size) := + .loc (by rw [← state.heap.size]; exact MapRel.fresh ..) + exact ⟨_, _, .pappExtern (frames.noCredits noCredits) declaration targetResolved + (by rw [← values_size argumentsRel]; exact under), + ⟨allocating, extension, rfl, + .running ((advanced.mono extension).push valueRel) (stack.mono extension)⟩⟩ + case apply functionAtom argumentAtoms function arguments noCredits functionResolved argumentsResolved transferred => + obtain ⟨targetFunction, targetFunctionResolved, functionRel⟩ := + ReuseSim.resolveAtom_iso frames.values functionResolved + obtain ⟨targetArguments, targetArgumentsResolved, argumentsRel⟩ := + ReuseSim.resolveAtoms_iso frames.values argumentsResolved + obtain ⟨after, target, transfer, related⟩ := + apply_related state functionRel argumentsRel advanced stack transferred + exact ⟨after, target, .apply (frames.noCredits noCredits) + targetFunctionResolved targetArgumentsResolved transfer, related⟩ + case extern address atoms arguments arity value noCredits resolved declaration argumentArity called => + obtain ⟨targetArguments, targetResolved, argumentsRel⟩ := ReuseSim.resolveAtoms_iso frames.values resolved + obtain ⟨targetCalled, valueRel⟩ := scalarOracle_related argumentsRel called + exact ⟨mapping, _, .extern (frames.noCredits noCredits) targetResolved declaration + (by rw [← values_size argumentsRel]; exact argumentArity) targetCalled, + ⟨state, MapExtends.refl _, rfl, .running (advanced.push valueRel) stack⟩⟩ + +end Ix.Compiler.IxIR2.CreditRefinement diff --git a/Ix/Compiler/IxIR2/CreditPolicy.lean b/Ix/Compiler/IxIR2/CreditPolicy.lean new file mode 100644 index 000000000..ed39452a9 --- /dev/null +++ b/Ix/Compiler/IxIR2/CreditPolicy.lean @@ -0,0 +1,24 @@ +import Ix.Compiler.IxIR2.Basic + +/-! +# Versioned credit boundaries + +The original policy keeps credits local to a call. The second policy permits +only direct non-tail calls to suspend credits in their owning continuation. +Neither policy passes credits as arguments or permits a live credit at return, +tail call, partial application, dynamic application, or an extern boundary. +-/ + +namespace Ix.Compiler.IxIR2 + +inductive CreditPolicy where + | callLocalV0 + | suspendedCallsV1 + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- An explicit artifact input; changing a credit boundary changes this tag. -/ +def CreditPolicy.tag : CreditPolicy → String + | .callLocalV0 => "call-local/0" + | .suspendedCallsV1 => "suspended-direct-calls/1" + +end Ix.Compiler.IxIR2 diff --git a/Ix/Compiler/IxIR2/CreditReclamation.lean b/Ix/Compiler/IxIR2/CreditReclamation.lean new file mode 100644 index 000000000..704377ea0 --- /dev/null +++ b/Ix/Compiler/IxIR2/CreditReclamation.lean @@ -0,0 +1,163 @@ +import Ix.Compiler.IxIR2.CreditSimulation +import Ix.Compiler.IxIR2.LowerSim + +/-! +# Owned results and complete reclamation + +Successful execution and counter refinement need no optimizer-specific +ownership history. Complete reclamation has an explicit domain: the logical +result owns the remaining heap. Allocation order is derived by the execution +bridge, and release fuel is constructed internally from that ownership fact. +-/ + +namespace Ix.Compiler.IxIR2.CreditRefinement + +open Eval +open Ix.Compiler.Ixon (Owned) +open Ix.Compiler.IxIR1.Sim (RootOwnership HeapIso HasWorld LiveRVal RValIso) +open Ix.Compiler.IxIR1.Reclamation (AllocationOrderInvariant) +open CallReuse.Sim (MapRel) + +theorem live_of_world {store : IxIR1.Store} {world : Owned} {value : RVal} + (valid : HasWorld store world value) : LiveRVal store value := by + cases value with + | lit => trivial + | erased => trivial + | loc location => + obtain ⟨box, found, _⟩ := valid + exact ⟨box, found⟩ + +/-- The allocation-history relation restricts to the established finite +live-heap bijection at every closed logical endpoint. -/ +def OutcomeRel.ownedIso {mapping : Array Nat} {logical physical : Result} + (related : OutcomeRel mapping logical physical) {world : Owned} + (owned : RootOwnership logical.store.heap [⟨world, logical.value⟩]) : + HeapIso logical.store.heap physical.store.heap := + related.heap.heap.toHeapIso owned.storeClosed + +theorem OutcomeRel.ownedValue {mapping : Array Nat} {logical physical : Result} + (related : OutcomeRel mapping logical physical) {world : Owned} + (owned : RootOwnership logical.store.heap [⟨world, logical.value⟩]) : + RValIso (related.ownedIso owned).locRel logical.value physical.value := + related.heap.heap.toHeapIso_value owned.storeClosed related.value + (live_of_world (owned.roots_world ⟨world, logical.value⟩ (by simp))) + +theorem OutcomeRel.ownership {mapping : Array Nat} {logical physical : Result} + (related : OutcomeRel mapping logical physical) {world : Owned} + (owned : RootOwnership logical.store.heap [⟨world, logical.value⟩]) : + RootOwnership physical.store.heap [⟨world, physical.value⟩] := by + have roots : IxIR1.Sim.RootsIso (related.ownedIso owned).locRel + [⟨world, logical.value⟩] [⟨world, physical.value⟩] := + .cons ⟨rfl, related.ownedValue owned⟩ .nil + exact (related.ownedIso owned).rootOwnership roots owned + +theorem OutcomeRel.valueGraph {mapping : Array Nat} {logical physical : Result} + (related : OutcomeRel mapping logical physical) {world : Owned} + (owned : RootOwnership logical.store.heap [⟨world, logical.value⟩]) + {functions : IxIR1.Sim.FunctionRel} {value : IxIR0.Value} + (graph : IxIR1.Sim.ValueGraph functions logical.store.heap value logical.value) : + IxIR1.Sim.ValueGraph functions physical.store.heap value physical.value := + graph.transport (related.ownedIso owned) (related.ownedValue owned) + +def reclaim (world : Owned) (fuel : Nat) (store : Store) (value : RVal) : + Except Error (Store × Nat) := + match world with + | .shared => releaseShared fuel store value + | .unique => dropUnique fuel store value + +theorem reclaim_passive {world : Owned} {fuel remaining : Nat} {store output : Store} {value : RVal} + (run : reclaim world fuel store value = .ok (output, remaining)) : + passiveCounters output = passiveCounters store := by + cases world with + | shared => exact releaseWork_passive run + | unique => exact dropWork_passive run + +theorem reclaim_balance {world : Owned} {fuel remaining : Nat} {store output : Store} {value : RVal} + (run : reclaim world fuel store value = .ok (output, remaining)) : HeapBalance store output := by + cases world with + | shared => exact releaseShared_heapBalance run + | unique => exact dropUnique_heapBalance run + +theorem HeapRel.reclaim {mapping : Array Nat} {left right output : Store} + (state : HeapRel mapping left right) {world : Owned} {fuel remaining : Nat} + {leftValue rightValue : RVal} (values : RValIso (MapRel mapping) leftValue rightValue) + (run : reclaim world fuel left leftValue = .ok (output, remaining)) : + ∃ target, reclaim world fuel right rightValue = .ok (target, remaining) ∧ + HeapRel mapping output target := by + cases world with + | shared => exact state.releaseWork (.cons values .nil) run + | unique => exact state.dropWork (.cons values .nil) run + +/-- The existing ownership progress proof supplies a finite release budget. +The bridge from IxIR₁ destruction is used only for its identical heap rules; +all actual IxIR₂ diagnostics and costs are retained by heap congruence. -/ +theorem reclaim_progress {store : Store} {value : RVal} {world : Owned} + (owned : RootOwnership store.heap [⟨world, value⟩]) + (ordered : AllocationOrderInvariant store.heap) : + ∃ fuel output, reclaim world fuel store value = .ok (output, 0) ∧ output.live = 0 := by + let bare : Store := { heap := store.heap } + have stores : Lower.Sim.StoreRel store.heap bare := ⟨rfl, rfl, rfl, rfl, rfl⟩ + have same : ReuseSim.HeapContentsEq bare store := ⟨rfl⟩ + cases world with + | shared => + obtain ⟨sourceFuel, sourceOut, sourceRun, sourceEmpty⟩ := + IxIR1.Reclamation.shared_reclamation (ctx := { decls := fun _ => none }) owned ordered + have positive : Lower.Sim.PositiveSharedRC store.heap := fun found _ => ordered.rc_pos found + obtain ⟨fuel, bareOut, bareRun, related, _⟩ := + Lower.Sim.dropVal_simulates_releaseSharedWork positive stores sourceRun + obtain ⟨output, run, contents⟩ := same.releaseShared bareRun + refine ⟨fuel, output, run, ?_⟩ + have bareEmpty : bareOut.live = 0 := by + change bareOut.heap.live = 0 + rw [related.heap] + exact sourceEmpty + rw [Store.live_eq_countP, ← contents.nodes, ← Store.live_eq_countP] + exact bareEmpty + | unique => + obtain ⟨sourceFuel, sourceOut, sourceRun, sourceEmpty⟩ := + IxIR1.Reclamation.unique_reclamation (ctx := { decls := fun _ => none }) owned ordered + obtain ⟨fuel, bareOut, bareRun, related⟩ := + Lower.Sim.dropUVal_simulates_dropUniqueWork stores sourceRun + obtain ⟨output, run, contents⟩ := same.dropUnique bareRun + refine ⟨fuel, output, run, ?_⟩ + have bareEmpty : bareOut.live = 0 := by + change bareOut.heap.live = 0 + rw [related.heap] + exact sourceEmpty + rw [Store.live_eq_countP, ← contents.nodes, ← Store.live_eq_countP] + exact bareEmpty + +structure ReclamationRel (mapping : Array Nat) (logical physical : Store) : Prop where + heap : HeapRel mapping logical physical + logicalEmpty : logical.live = 0 + physicalEmpty : physical.live = 0 + logicalFreed : logical.heap.allocs = logical.heap.frees + physicalFreed : physical.heap.allocs = physical.heap.frees + counters : CounterLaw logical.snapshot physical.snapshot 0 + +/-- Both actual heaps reclaim completely, with the same independent release +budget and the same comparative allocation, free, RC, and peak observations. -/ +theorem OutcomeRel.reclamation {mapping : Array Nat} {logical physical : Result} + (related : OutcomeRel mapping logical physical) {world : Owned} + (owned : RootOwnership logical.store.heap [⟨world, logical.value⟩]) : + ∃ fuel left right, + reclaim world fuel logical.store logical.value = .ok (left, 0) ∧ + reclaim world fuel physical.store physical.value = .ok (right, 0) ∧ + ReclamationRel mapping left right := by + obtain ⟨fuel, left, leftRun, leftEmpty⟩ := reclaim_progress owned related.heap.ordered + obtain ⟨right, rightRun, heap⟩ := related.heap.reclaim related.value leftRun + have rightEmpty := heap.heap.right_empty leftEmpty + have leftBalance := reclaim_balance leftRun + have rightBalance := reclaim_balance rightRun + have leftInitial := related.logicalAccounting + have rightInitial := related.accounted + unfold HeapBalance at leftBalance rightBalance + have leftAccount : left.live + left.heap.frees = left.heap.allocs := by omega + have rightAccount : right.live + right.heap.frees + 0 = right.heap.allocs := by omega + have noReuses : left.heap.reuses = 0 := + (congrArg Counters.reuses (reclaim_passive leftRun)).trans related.logicalReuses + exact ⟨fuel, left, right, leftRun, rightRun, + ⟨heap, leftEmpty, rightEmpty, by omega, by omega, + heap.counterLaw leftAccount noReuses rightAccount⟩⟩ + +end Ix.Compiler.IxIR2.CreditRefinement diff --git a/Ix/Compiler/IxIR2/CreditRefinement.lean b/Ix/Compiler/IxIR2/CreditRefinement.lean new file mode 100644 index 000000000..87c36e076 --- /dev/null +++ b/Ix/Compiler/IxIR2/CreditRefinement.lean @@ -0,0 +1,138 @@ +import Ix.Compiler.IxIR2.CreditReclamation +import Ix.Compiler.IxIR2.CallEvalFuel + +/-! +# General logical/physical credit refinement + +The execution bridge covers both credit policies and every instruction, +including branches, loops, borrowed arguments, PAPs, scalar externs, and +continuation-owned caller credits. Successful logical execution supplies a +physical execution with the same budgets. Independent successful budgets +give the same heap/value observations. + +The checked entry point fixes the exact program, schemas, and credit policy. +Validation acceptance is not a proof of semantic root ownership: the owned +endpoint states that additional assumption explicitly. No optimizer-specific +step, progress, target-heap, or resource premise is required. +-/ + +namespace Ix.Compiler.IxIR2.Eval.Policy + +theorem Steps.deterministic {policy : CreditPolicy} {context : Context} + {interpretation : Interpretation} {count : Nat} {before left right : Machine} + (one : Steps policy context interpretation count before left) + (two : Steps policy context interpretation count before right) : left = right := by + induction one generalizing right with + | refl => cases two; rfl + | cons running head tail ih => + cases two with + | cons _ otherHead otherTail => + have same := head.deterministic otherHead + subst same + exact ih otherTail + +theorem Steps.take {policy : CreditPolicy} {context : Context} + {interpretation : Interpretation} {count prefixLength : Nat} {before after : Machine} + (steps : Steps policy context interpretation count before after) (bound : prefixLength ≤ count) : + ∃ middle, Steps policy context interpretation prefixLength before middle ∧ + Steps policy context interpretation (count - prefixLength) middle after := by + induction steps generalizing prefixLength with + | refl => + have zero : prefixLength = 0 := by omega + subst prefixLength + exact ⟨_, .refl _, .refl _⟩ + | @cons count before middle after frame stack running head tail ih => + cases prefixLength with + | zero => exact ⟨before, .refl _, .cons running head tail⟩ + | succ prefixLength => + obtain ⟨target, front, back⟩ := ih (prefixLength := prefixLength) (by omega) + exact ⟨target, .cons running head front, by simpa using back⟩ + +end Ix.Compiler.IxIR2.Eval.Policy + +namespace Ix.Compiler.IxIR2.CreditRefinement + +open Eval +open Ix.Compiler.IxIR1.Sim (RootOwnership) + +/-- Any physical prefix of a successful logical main has its corresponding +logical prefix. Reservations include every suspended caller frame. -/ +theorem runMain_prefix_resources {policy : CreditPolicy} {context : Context} {program : Program} + {controlFuel heapFuel count : Nat} {logical : Result} {physicalPrefix : Machine} + (run : Policy.runMain policy context .logical program controlFuel heapFuel = .ok logical) + (prefixRun : Policy.Steps policy context .physical count + (initialMachine program.main #[] heapFuel) physicalPrefix) : + ∃ mapping logicalPrefix, + Policy.Steps policy context .logical count + (initialMachine program.main #[] heapFuel) logicalPrefix ∧ + MachineRel mapping logicalPrefix physicalPrefix ∧ physicalPrefix.AllocationAccounting ∧ + CounterLaw logicalPrefix.store.snapshot physicalPrefix.store.snapshot physicalPrefix.presentCredits := by + obtain ⟨arity, nonempty⟩ := main_shape run + rw [Policy.runMain_eq_runMachine arity nonempty] at run + obtain ⟨total, _, logicalSteps⟩ := Policy.runMachine_steps run + obtain ⟨_, matched, matchedSteps, related, _, _⟩ := prefix_resources logicalSteps + rcases matched with ⟨store, fuel, control⟩ + have controls := related.control + dsimp only at controls + cases controls with + | halted values => + obtain ⟨suffix, length, _⟩ := prefixRun.cancelPrefixToHalted matchedSteps rfl + obtain ⟨left, leftPrefix, _⟩ := logicalSteps.take (prefixLength := count) (by omega) + obtain ⟨mapping, right, rightPrefix, machines, accounted, counters⟩ := prefix_resources leftPrefix + have same := rightPrefix.deterministic prefixRun + subst right + exact ⟨mapping, left, leftPrefix, machines, accounted, counters⟩ + +/-- Successful runs may choose control and traversal budgets independently. +Their semantic observations do not depend on those choices. -/ +theorem runMain_refines_independent {policy : CreditPolicy} {context : Context} {program : Program} + {logicalControl logicalHeap physicalControl physicalHeap : Nat} {logical physical : Result} + (leftRun : Policy.runMain policy context .logical program logicalControl logicalHeap = .ok logical) + (rightRun : Policy.runMain policy context .physical program physicalControl physicalHeap = .ok physical) : + ∃ mapping, OutcomeRel mapping logical physical := by + obtain ⟨arity, nonempty⟩ := main_shape leftRun + obtain ⟨mapping, target, targetRun, related⟩ := runMain_refines leftRun + obtain ⟨stores, values⟩ := Policy.runMain_success_unique arity nonempty targetRun rightRun + refine ⟨mapping, ?_⟩ + exact ⟨stores ▸ related.heap, values ▸ related.value, + stores ▸ related.counters, stores ▸ related.accounted⟩ + +/-- The exact checked program and policy execute with the matching physical +result. Acceptance is retained at the API boundary; the operational theorem +is stronger and does not require it. -/ +theorem checked_runMain_refines {policy : CreditPolicy} {limits : Validate.Limits} + {validation : Validate.Context} {program : Program} + (_checked : Validate.CheckedWithPolicy policy limits validation program) + {oracle : Ixon.Address → List RVal → Option RVal} {controlFuel heapFuel : Nat} {logical : Result} + (run : Policy.runMain policy (Context.ofProgram program validation.schemas oracle) + .logical program controlFuel heapFuel = .ok logical) : + ∃ mapping physical, + Policy.runMain policy (Context.ofProgram program validation.schemas oracle) + .physical program controlFuel heapFuel = .ok physical ∧ + ResultRel mapping logical physical := + runMain_refines run + +/-- Owned checked programs preserve root ownership and reclaim both actual +heaps completely. The reclamation budget is constructed from the logical +ownership premise and the allocation order derived by execution. -/ +theorem checked_runMain_owned {policy : CreditPolicy} {limits : Validate.Limits} + {validation : Validate.Context} {program : Program} + (checked : Validate.CheckedWithPolicy policy limits validation program) + {oracle : Ixon.Address → List RVal → Option RVal} {controlFuel heapFuel : Nat} {logical : Result} + (run : Policy.runMain policy (Context.ofProgram program validation.schemas oracle) + .logical program controlFuel heapFuel = .ok logical) + (owned : RootOwnership logical.store.heap [⟨program.main.signature.result, logical.value⟩]) : + ∃ mapping physical, + Policy.runMain policy (Context.ofProgram program validation.schemas oracle) + .physical program controlFuel heapFuel = .ok physical ∧ + ResultRel mapping logical physical ∧ + RootOwnership physical.store.heap [⟨program.main.signature.result, physical.value⟩] ∧ + ∃ fuel left right, + reclaim program.main.signature.result fuel logical.store logical.value = .ok (left, 0) ∧ + reclaim program.main.signature.result fuel physical.store physical.value = .ok (right, 0) ∧ + ReclamationRel mapping left right := by + obtain ⟨mapping, physical, physicalRun, related⟩ := checked_runMain_refines checked run + exact ⟨mapping, physical, physicalRun, related, related.toOutcomeRel.ownership owned, + related.toOutcomeRel.reclamation owned⟩ + +end Ix.Compiler.IxIR2.CreditRefinement diff --git a/Ix/Compiler/IxIR2/CreditRelation.lean b/Ix/Compiler/IxIR2/CreditRelation.lean new file mode 100644 index 000000000..b6e780031 --- /dev/null +++ b/Ix/Compiler/IxIR2/CreditRelation.lean @@ -0,0 +1,195 @@ +import Ix.Compiler.IxIR2.ReuseHeapMapResults +import Ix.Compiler.IxIR2.EvalCounter +import Ix.Compiler.IxIR2.ReservationSteps + +/-! +# Logical and physical credit states + +The program, block, and instruction positions are identical. Allocation +history relates every register, including old names in suspended callers. +Only live heap locations must be injective. Credits agree in layout and +presence; physical reservations are owned separately across the whole stack. +No relation in this module mentions an optimizer or a rewrite trace. +-/ + +namespace Ix.Compiler.IxIR2.CreditRefinement + +open Eval +open Ix.Compiler.IxIR1.Sim (RValIso RValsIso) +open CallReuse.Sim (MapRel HeapMap) + +def MapExtends (before after : Array Nat) : Prop := + ∀ {left right}, MapRel before left right → MapRel after left right + +theorem MapExtends.refl (mapping : Array Nat) : MapExtends mapping mapping := fun h => h + +theorem MapExtends.trans {first middle last : Array Nat} + (one : MapExtends first middle) (two : MapExtends middle last) : + MapExtends first last := fun h => two (one h) + +theorem MapExtends.push (mapping : Array Nat) (location : Nat) : + MapExtends mapping (mapping.push location) := fun h => h.push location + +inductive CreditRel : Credit → Credit → Prop where + | absent (layout : LayoutId) : + CreditRel ⟨layout, .absent⟩ ⟨layout, .absent⟩ + | present (layout : LayoutId) (location : Nat) : + CreditRel ⟨layout, .present none⟩ ⟨layout, .present (some location)⟩ + +theorem CreditRel.layout {left right : Credit} (related : CreditRel left right) : + left.layout = right.layout := by cases related <;> rfl + +theorem CreditRel.isPresent {left right : Credit} (related : CreditRel left right) : + left.isPresent = right.isPresent := by cases related <;> rfl + +inductive CreditSlotRel : Option Credit → Option Credit → Prop where + | consumed : CreditSlotRel none none + | live {left right : Credit} (credit : CreditRel left right) : + CreditSlotRel (some left) (some right) + +inductive CreditsRel : List (Option Credit) → List (Option Credit) → Prop where + | nil : CreditsRel [] [] + | cons {left right lefts rights} (head : CreditSlotRel left right) + (tail : CreditsRel lefts rights) : CreditsRel (left :: lefts) (right :: rights) + +theorem CreditsRel.lengths {left right : List (Option Credit)} + (related : CreditsRel left right) : left.length = right.length := by + induction related with + | nil => rfl + | cons _ _ ih => simp only [List.length_cons, ih] + +theorem CreditsRel.get? {left right : List (Option Credit)} + (related : CreditsRel left right) {index : Nat} {credit : Credit} + (found : left[index]? = some (some credit)) : + ∃ target, right[index]? = some (some target) ∧ CreditRel credit target := by + induction related generalizing index with + | nil => simp at found + | cons head tail ih => + cases index with + | zero => + simp only [List.getElem?_cons_zero, Option.some.injEq] at found + subst_vars + cases head with + | live credit => exact ⟨_, rfl, credit⟩ + | succ index => exact ih found + +theorem CreditsRel.setNone {left right : List (Option Credit)} + (related : CreditsRel left right) (index : Nat) : + CreditsRel (left.set index none) (right.set index none) := by + induction related generalizing index with + | nil => simp; exact .nil + | cons head tail ih => + cases index with + | zero => exact .cons .consumed tail + | succ index => exact .cons head (ih index) + +theorem CreditsRel.append {left right moreLeft moreRight : List (Option Credit)} + (related : CreditsRel left right) (more : CreditsRel moreLeft moreRight) : + CreditsRel (left ++ moreLeft) (right ++ moreRight) := by + induction related with + | nil => exact more + | cons head tail ih => exact .cons head ih + +theorem CreditsRel.any {left right : List (Option Credit)} + (related : CreditsRel left right) : + left.any Option.isSome = right.any Option.isSome := by + induction related with + | nil => rfl + | cons head tail ih => cases head <;> simp [List.any_cons, ih] + +theorem CreditsRel.weight {left right : List (Option Credit)} + (related : CreditsRel left right) : + left.countP (fun c => c.any Credit.isPresent) = + right.countP (fun c => c.any Credit.isPresent) := by + induction related with + | nil => rfl + | cons head tail ih => + cases head with + | consumed => simpa using ih + | live credit => simp only [List.countP_cons, Option.any_some, credit.isPresent, ih] + +structure FrameRel (mapping : Array Nat) (left right : Frame) : Prop where + definition : left.definition = right.definition + block : left.block = right.block + pc : left.pc = right.pc + values : RValsIso (MapRel mapping) left.values.toList right.values.toList + credits : CreditsRel left.credits.toList right.credits.toList + +theorem FrameRel.mono {before after : Array Nat} {left right : Frame} + (related : FrameRel before left right) (extension : MapExtends before after) : + FrameRel after left right := { related with values := related.values.mono extension } + +theorem FrameRel.advance {mapping : Array Nat} {left right : Frame} + (related : FrameRel mapping left right) : + FrameRel mapping { left with pc := left.pc + 1 } { right with pc := right.pc + 1 } := + { related with pc := congrArg (· + 1) related.pc } + +theorem FrameRel.push {mapping : Array Nat} {left right : Frame} + (related : FrameRel mapping left right) {leftValue rightValue : RVal} + (value : RValIso (MapRel mapping) leftValue rightValue) : + FrameRel mapping { left with values := left.values.push leftValue } + { right with values := right.values.push rightValue } := + { related with values := by simpa using related.values.append (.cons value .nil) } + +theorem FrameRel.appendCredit {mapping : Array Nat} {left right : Frame} + (related : FrameRel mapping left right) {leftValues rightValues : Array RVal} + (values : RValsIso (MapRel mapping) leftValues.toList rightValues.toList) + {leftCredit rightCredit : Credit} (credit : CreditRel leftCredit rightCredit) : + FrameRel mapping + { left with + values := left.values ++ leftValues + credits := left.credits.push (some leftCredit) } + { right with + values := right.values ++ rightValues + credits := right.credits.push (some rightCredit) } := + { related with + values := by simpa using related.values.append values + credits := by simpa using related.credits.append (.cons (.live credit) .nil) } + +theorem FrameRel.entry {mapping : Array Nat} (definition : Function) + {left right : Array RVal} (values : RValsIso (MapRel mapping) left.toList right.toList) : + FrameRel mapping { definition, values := left } { definition, values := right } := + ⟨rfl, rfl, rfl, values, .nil⟩ + +inductive ContinuationRel (mapping : Array Nat) : Continuation → Continuation → Prop where + | resume {left right : Frame} (frames : FrameRel mapping left right) : + ContinuationRel mapping (.resume left) (.resume right) + | applyMore {left right : Frame} {leftValues rightValues : Array RVal} + (frames : FrameRel mapping left right) + (values : RValsIso (MapRel mapping) leftValues.toList rightValues.toList) : + ContinuationRel mapping (.applyMore leftValues left) (.applyMore rightValues right) + +inductive StackRel (mapping : Array Nat) : List Continuation → List Continuation → Prop where + | nil : StackRel mapping [] [] + | cons {left right lefts rights} (head : ContinuationRel mapping left right) + (tail : StackRel mapping lefts rights) : StackRel mapping (left :: lefts) (right :: rights) + +theorem ContinuationRel.mono {before after : Array Nat} {left right : Continuation} + (related : ContinuationRel before left right) (extension : MapExtends before after) : + ContinuationRel after left right := by + cases related with + | resume frames => exact .resume (frames.mono extension) + | applyMore frames values => exact .applyMore (frames.mono extension) (values.mono extension) + +theorem StackRel.mono {before after : Array Nat} {left right : List Continuation} + (related : StackRel before left right) (extension : MapExtends before after) : + StackRel after left right := by + induction related with + | nil => exact .nil + | cons head tail ih => exact .cons (head.mono extension) ih + +inductive ControlRel (mapping : Array Nat) : Control → Control → Prop where + | halted {left right : RVal} (values : RValIso (MapRel mapping) left right) : + ControlRel mapping (.halted left) (.halted right) + | running {left right : Frame} {leftStack rightStack : List Continuation} + (frames : FrameRel mapping left right) (stack : StackRel mapping leftStack rightStack) : + ControlRel mapping (.running left leftStack) (.running right rightStack) + +theorem ControlRel.mono {before after : Array Nat} {left right : Control} + (related : ControlRel before left right) (extension : MapExtends before after) : + ControlRel after left right := by + cases related with + | halted values => exact .halted (values.mono extension) + | running frames stack => exact .running (frames.mono extension) (stack.mono extension) + +end Ix.Compiler.IxIR2.CreditRefinement diff --git a/Ix/Compiler/IxIR2/CreditResources.lean b/Ix/Compiler/IxIR2/CreditResources.lean new file mode 100644 index 000000000..1b48df46d --- /dev/null +++ b/Ix/Compiler/IxIR2/CreditResources.lean @@ -0,0 +1,152 @@ +import Ix.Compiler.IxIR2.CreditSteps + +/-! Logical allocation accounting and the complete all-prefix counter law. -/ + +namespace Ix.Compiler.IxIR2.CreditRefinement + +open Eval + +/-- Logical execution balances live nodes and frees, and never performs a +physical reuse. Reset diagnostics do not affect either fact. -/ +def LogicalEffect (before after : Store) : Prop := + HeapBalance before after ∧ after.heap.reuses = before.heap.reuses + +theorem LogicalEffect.refl (store : Store) : LogicalEffect store store := ⟨.refl _, rfl⟩ + +theorem LogicalEffect.trans {first middle last : Store} + (one : LogicalEffect first middle) (two : LogicalEffect middle last) : + LogicalEffect first last := ⟨one.1.trans two.1, two.2.trans one.2⟩ + +theorem LogicalEffect.alloc (store : Store) (world : Ixon.Owned) (node : Node) : + LogicalEffect store (store.allocNode world node).1 := ⟨.allocNode .., rfl⟩ + +theorem LogicalEffect.kill {store : Store} {location : Nat} {box : NodeBox} + (found : store.get? location = some box) : LogicalEffect store (store.kill location) := + ⟨.kill found, rfl⟩ + +theorem LogicalEffect.retain {store output : Store} {value : RVal} + (run : retainShared store value = .ok output) : LogicalEffect store output := + ⟨retainShared_heapBalance run, congrArg Counters.reuses (retain_passive run)⟩ + +theorem LogicalEffect.retainMany {store output : Store} {values : Array RVal} + (run : RetainSharedMany store values output) : LogicalEffect store output := + ⟨run.heapBalance, congrArg Counters.reuses (retainMany_passive run)⟩ + +theorem LogicalEffect.releaseWork {store output : Store} {fuel remaining : Nat} {values : List RVal} + (run : releaseSharedWork fuel store values = .ok (output, remaining)) : LogicalEffect store output := + ⟨releaseSharedWork_heapBalance run, congrArg Counters.reuses (releaseWork_passive run)⟩ + +theorem LogicalEffect.dropWork {store output : Store} {fuel remaining : Nat} {values : List RVal} + (run : dropUniqueWork fuel store values = .ok (output, remaining)) : LogicalEffect store output := + ⟨dropUniqueWork_heapBalance run, congrArg Counters.reuses (dropWork_passive run)⟩ + +theorem apply_logicalEffect {context : Context} {interpretation : Interpretation} + {store : Store} {heapFuel : Nat} {function : RVal} {arguments : Array RVal} + {resume : Frame} {stack : List Continuation} {target : Machine} + (transferred : ApplyTransfer context interpretation store heapFuel function arguments resume stack target) : + LogicalEffect store target.store := by + cases transferred.classify with + | erased released => exact LogicalEffect.releaseWork released + | papUnder _ _ _ _ retained released _ => + exact ((LogicalEffect.retainMany retained).trans + (LogicalEffect.releaseWork released)).trans (LogicalEffect.alloc ..) + | papFn _ _ _ _ retained released _ _ _ _ _ => + exact (LogicalEffect.retainMany retained).trans (LogicalEffect.releaseWork released) + | papExtern _ _ _ _ retained released _ _ _ _ _ => + exact (LogicalEffect.retainMany retained).trans (LogicalEffect.releaseWork released) + +theorem instruction_logicalEffect {context : Context} {store : Store} {heapFuel : Nat} + {frame : Frame} {stack : List Continuation} {instruction : Instr} {target : Machine} + (classified : InstructionTransferCase context .logical store heapFuel frame stack instruction target) : + LogicalEffect store target.store := by + cases classified <;> try contradiction + case move => exact LogicalEffect.refl _ + case alloc => exact LogicalEffect.alloc .. + case allocWithAbsent => exact LogicalEffect.alloc .. + case allocWithLogical => exact LogicalEffect.alloc .. + case discardAbsent => exact LogicalEffect.refl _ + case discardLogical => exact LogicalEffect.refl _ + case takeUniqueLogical viewed unitRC => exact LogicalEffect.kill viewed.parts.1 + case resetSharedLogicalHot viewed unitRC => exact LogicalEffect.kill viewed.parts.1 + case resetSharedCold target cid schema location box fields output schemaAt resolved viewed many retained => + refine ⟨(HeapBalance.setBox (new := { box with rc := box.rc - 1 }) viewed.parts.1).trans retained.heapBalance, ?_⟩ + exact congrArg Counters.reuses (retainMany_passive retained) + case retainShared retained => exact LogicalEffect.retain retained + case releaseShared released => exact LogicalEffect.releaseWork released + case dropUnique dropped => exact LogicalEffect.dropWork dropped + case freeUnique viewed scalarFields => exact LogicalEffect.kill viewed.parts.1 + case fetch => exact LogicalEffect.refl _ + case callFn => exact LogicalEffect.refl _ + case callSelf => exact LogicalEffect.refl _ + case pappFn => exact LogicalEffect.alloc .. + case pappExtern => exact LogicalEffect.alloc .. + case apply transferred => exact apply_logicalEffect transferred + case extern => exact LogicalEffect.refl _ + +theorem terminator_logicalEffect {context : Context} {store : Store} {heapFuel : Nat} + {frame : Frame} {stack : List Continuation} {terminator : Terminator} {target : Machine} + (classified : TerminatorTransferCase context .logical store heapFuel frame stack terminator target) : + LogicalEffect store target.store := by + cases classified <;> first + | exact LogicalEffect.refl _ + | (apply apply_logicalEffect; assumption) + +theorem step_logicalEffect {policy : CreditPolicy} {context : Context} {before after : Machine} + (stepped : Policy.Step policy context .logical before after) : + LogicalEffect before.store after.store := by + rcases stepped.classify with original | ⟨frame, stack, call, _, running, _, called⟩ + · cases original.classify with + | halted => exact LogicalEffect.refl _ + | instruction _ _ _ classified => exact instruction_logicalEffect classified + | terminator _ _ _ classified => exact terminator_logicalEffect classified + · rw [(Policy.suspendCall_resources running called).1] + exact LogicalEffect.refl _ + +theorem steps_logicalEffect {policy : CreditPolicy} {context : Context} {before after : Machine} + {count : Nat} (steps : Policy.Steps policy context .logical count before after) : + LogicalEffect before.store after.store := by + induction steps with + | refl => exact LogicalEffect.refl _ + | cons running head tail ih => exact (step_logicalEffect head).trans ih + +theorem HeapRel.counterLaw {mapping : Array Nat} {left right : Store} {credits : Nat} + (state : HeapRel mapping left right) + (balanced : left.live + left.heap.frees = left.heap.allocs) + (logicalReuses : left.heap.reuses = 0) + (physical : right.live + right.heap.frees + credits = right.heap.allocs) : + CounterLaw left.snapshot right.snapshot credits := by + have events := state.events + change left.heap.allocs + left.heap.reuses = right.heap.allocs + right.heap.reuses at events + have live := state.heap.live_eq + exact ⟨by dsimp [Store.snapshot, Store.counters]; omega, + by dsimp [Store.snapshot, Store.counters]; omega, + state.rcops, live, state.attempts, state.hot, state.cold⟩ + +theorem MachineRel.counterLaw {mapping : Array Nat} {left right : Machine} + (machines : MachineRel mapping left right) + (balanced : left.store.live + left.store.heap.frees = left.store.heap.allocs) + (logicalReuses : left.store.heap.reuses = 0) + (physical : right.AllocationAccounting) : + CounterLaw left.store.snapshot right.store.snapshot right.presentCredits := + machines.heap.counterLaw balanced logicalReuses physical + +/-- The full specification's intermediate counter equations hold for every +logical prefix and its actual physical counterpart. All caller reservations +are included in the outstanding-credit term. -/ +theorem prefix_resources {policy : CreditPolicy} {context : Context} {definition : Function} + {heapFuel count : Nat} {left : Machine} + (steps : Policy.Steps policy context .logical count (initialMachine definition #[] heapFuel) left) : + ∃ mapping right, Policy.Steps policy context .physical count + (initialMachine definition #[] heapFuel) right ∧ + MachineRel mapping left right ∧ right.AllocationAccounting ∧ + CounterLaw left.store.snapshot right.store.snapshot right.presentCredits := by + obtain ⟨mapping, right, targetSteps, machines, _⟩ := steps_related (initial_related definition heapFuel) steps + have logical := steps_logicalEffect steps + have balanced : left.store.live + left.store.heap.frees = left.store.heap.allocs := by + simpa [HeapBalance, initialMachine, Store.live, IxIR1.Store.live] using logical.1 + have noReuses : left.store.heap.reuses = 0 := logical.2 + have physical := targetSteps.allocationAccounting (initialMachine_allocationAccounting ..) + exact ⟨mapping, right, targetSteps, machines, physical, + machines.counterLaw balanced noReuses physical⟩ + +end Ix.Compiler.IxIR2.CreditRefinement diff --git a/Ix/Compiler/IxIR2/CreditSimulation.lean b/Ix/Compiler/IxIR2/CreditSimulation.lean new file mode 100644 index 000000000..4c8f7765d --- /dev/null +++ b/Ix/Compiler/IxIR2/CreditSimulation.lean @@ -0,0 +1,90 @@ +import Ix.Compiler.IxIR2.CreditResources + +/-! Public successful-main refinement for both credit policies. -/ + +namespace Ix.Compiler.IxIR2.CreditRefinement + +open Eval +open Ix.Compiler.IxIR1.Sim (RValIso) +open CallReuse.Sim (MapRel) + +/-- Budget-independent observations of a completed execution. -/ +structure OutcomeRel (mapping : Array Nat) (logical physical : Result) : Prop where + heap : HeapRel mapping logical.store physical.store + value : RValIso (MapRel mapping) logical.value physical.value + counters : CounterLaw logical.store.snapshot physical.store.snapshot 0 + accounted : physical.store.live + physical.store.heap.frees = physical.store.heap.allocs + +structure ResultRel (mapping : Array Nat) (logical physical : Result) : Prop + extends OutcomeRel mapping logical physical where + control : logical.controlRemaining = physical.controlRemaining + traversal : logical.heapRemaining = physical.heapRemaining + +theorem OutcomeRel.logicalReuses {mapping : Array Nat} {logical physical : Result} + (related : OutcomeRel mapping logical physical) : logical.store.heap.reuses = 0 := by + have events := related.heap.events + have allocs := related.counters.allocs + change logical.store.heap.allocs + logical.store.heap.reuses = + physical.store.heap.allocs + physical.store.heap.reuses at events + change logical.store.heap.allocs = physical.store.heap.allocs + physical.store.heap.reuses at allocs + omega + +theorem OutcomeRel.logicalAccounting {mapping : Array Nat} {logical physical : Result} + (related : OutcomeRel mapping logical physical) : + logical.store.live + logical.store.heap.frees = logical.store.heap.allocs := by + have allocs := related.counters.allocs + have frees := related.counters.frees + have live := related.counters.live + have physical := related.accounted + dsimp only [Store.snapshot, Store.counters] at allocs frees live + omega + +theorem main_shape {policy : CreditPolicy} {context : Context} {program : Program} + {interpretation : Interpretation} {controlFuel heapFuel : Nat} {result : Result} + (run : Policy.runMain policy context interpretation program controlFuel heapFuel = .ok result) : + program.main.signature.params.size = 0 ∧ program.main.blocks.isEmpty = false := by + by_cases arity : program.main.signature.params.size = 0 + · refine ⟨arity, ?_⟩ + cases empty : program.main.blocks.isEmpty with + | false => rfl + | true => simp [Policy.runMain, Policy.runFunction, enterFunction, arity, empty, + bind, Except.bind] at run + · simp [Policy.runMain, Policy.runFunction, enterFunction, Ne.symm arity, + bind, Except.bind] at run + +/-- A successful logical main executes physically with the same control and +traversal budgets. The theorem covers the whole instruction language and +derives all heap, continuation, reservation, and cost facts internally. -/ +theorem runMain_refines {policy : CreditPolicy} {context : Context} {program : Program} + {controlFuel heapFuel : Nat} {logical : Result} + (run : Policy.runMain policy context .logical program controlFuel heapFuel = .ok logical) : + ∃ mapping physical, + Policy.runMain policy context .physical program controlFuel heapFuel = .ok physical ∧ + ResultRel mapping logical physical := by + obtain ⟨arity, nonempty⟩ := main_shape run + rw [Policy.runMain_eq_runMachine arity nonempty] at run + obtain ⟨count, budget, steps⟩ := Policy.runMachine_steps run + obtain ⟨mapping, target, targetSteps, machines, accounted, counters⟩ := prefix_resources steps + rcases target with ⟨store, fuel, control⟩ + have controls := machines.control + dsimp only at controls + cases controls with + | halted values => + refine ⟨mapping, ⟨store, _, logical.controlRemaining, fuel⟩, ?_, + ⟨⟨machines.heap, values, counters, accounted⟩, rfl, machines.fuel⟩⟩ + rw [Policy.runMain_eq_runMachine arity nonempty, budget, targetSteps.runMachine] + simp only [Policy.runMachine] + +/-- Legacy v0 clients obtain the same full-credit guarantee for the original +runner. This strictly extends the credit-free interpretation bridge. -/ +theorem runMain_v0_refines {context : Context} {program : Program} + {controlFuel heapFuel : Nat} {logical : Result} + (run : Eval.runMain context .logical program controlFuel heapFuel = .ok logical) : + ∃ mapping physical, + Eval.runMain context .physical program controlFuel heapFuel = .ok physical ∧ + ResultRel mapping logical physical := by + have policyRun : Policy.runMain .callLocalV0 context .logical program controlFuel heapFuel = .ok logical := + (Policy.runMain_v0 ..).trans run + simpa only [Policy.runMain_v0] using runMain_refines policyRun + +end Ix.Compiler.IxIR2.CreditRefinement diff --git a/Ix/Compiler/IxIR2/CreditSteps.lean b/Ix/Compiler/IxIR2/CreditSteps.lean new file mode 100644 index 000000000..d1a29999f --- /dev/null +++ b/Ix/Compiler/IxIR2/CreditSteps.lean @@ -0,0 +1,120 @@ +import Ix.Compiler.IxIR2.CreditTerminators + +/-! The complete small-step bridge, including continuation-owned v1 credits. -/ + +namespace Ix.Compiler.IxIR2.CreditRefinement + +open Eval + +theorem original_step_related {context : Context} {mapping : Array Nat} + {left right leftAfter : Machine} (machines : MachineRel mapping left right) + (stepped : Eval.Step context .logical left leftAfter) : + ∃ after rightAfter, Eval.Step context .physical right rightAfter ∧ + TransferRel mapping after leftAfter rightAfter := by + rcases left with ⟨leftStore, leftFuel, leftControl⟩ + rcases right with ⟨rightStore, rightFuel, rightControl⟩ + have fuels := machines.fuel + dsimp only at fuels + subst rightFuel + cases machines.control with + | halted values => + have same := Except.ok.inj stepped + subst leftAfter + exact ⟨mapping, _, rfl, + ⟨machines.heap, MapExtends.refl _, rfl, .halted values⟩⟩ + | running frames stack => + cases stepped.classify with + | instruction blockAt pc instructionAt classified => + obtain ⟨after, target, targetCase, related⟩ := + instruction_related machines.heap frames stack machines.reservations classified + exact ⟨after, target, targetCase.step + (by rw [← frames.definition, ← frames.block]; exact blockAt) + (by rw [← frames.pc]; exact pc) + (by simpa only [← frames.pc] using instructionAt), related⟩ + | terminator blockAt pc terminatorAt classified => + obtain ⟨after, target, targetCase, related⟩ := + terminator_related machines.heap frames stack classified + exact ⟨after, target, targetCase.step + (by rw [← frames.definition, ← frames.block]; exact blockAt) + (by rw [← frames.pc]; exact pc) terminatorAt, related⟩ + +theorem FrameRel.directCall {mapping : Array Nat} {left right : Frame} + (frames : FrameRel mapping left right) : Policy.directCall? left = Policy.directCall? right := by + unfold Policy.directCall? + rw [frames.definition, frames.block, frames.pc] + +theorem FrameRel.callDefinition {mapping : Array Nat} {left right : Frame} + (frames : FrameRel mapping left right) (context : Context) (call : Policy.DirectCall) : + call.definition context left = call.definition context right := by + cases call with + | function => rfl + | self => simp only [Policy.DirectCall.definition, frames.definition] + +theorem step_related {policy : CreditPolicy} {context : Context} {mapping : Array Nat} + {left right leftAfter : Machine} (machines : MachineRel mapping left right) + (stepped : Policy.Step policy context .logical left leftAfter) : + ∃ after rightAfter, Policy.Step policy context .physical right rightAfter ∧ + TransferRel mapping after leftAfter rightAfter := by + rcases stepped.classify with original | ⟨frame, stack, call, rfl, running, atCall, called⟩ + · obtain ⟨after, target, targetStep, related⟩ := original_step_related machines original + refine ⟨after, target, ?_, related⟩ + cases policy with + | callLocalV0 => exact targetStep + | suspendedCallsV1 => exact Policy.of_originalStep targetStep + · rcases left with ⟨leftStore, leftFuel, leftControl⟩ + rcases right with ⟨rightStore, rightFuel, rightControl⟩ + dsimp only at running + subst leftControl + have controls := machines.control + dsimp only at controls + cases controls with + | @running _ rightFrame _ rightStack frames stacks => + obtain ⟨values, definition, resolved, defined, arity, nonempty, rfl⟩ := + Policy.suspendCall_iff.mp called + obtain ⟨targetValues, targetResolved, valuesRel⟩ := + ReuseSim.resolveAtoms_iso frames.values resolved + have targetAt : Policy.directCall? rightFrame = some call := + frames.directCall.symm.trans atCall + have targetCall := (Policy.suspendCall_iff + (machine := Machine.mk rightStore rightFuel (.running rightFrame rightStack)) + (frame := rightFrame) (stack := rightStack) (call := call)).mpr + ⟨targetValues, definition, targetResolved, + (frames.callDefinition context call).symm.trans defined, + (values_size valuesRel).symm.trans arity, nonempty, rfl⟩ + refine ⟨mapping, Machine.mk rightStore rightFuel + (.running { definition, values := targetValues } + (.resume { rightFrame with pc := rightFrame.pc + 1 } :: rightStack)), ?_, + ⟨machines.heap, MapExtends.refl _, machines.fuel, + .running (.entry definition valuesRel) (.cons (.resume frames.advance) stacks)⟩⟩ + simpa only [Policy.Step, Policy.step, targetAt] using targetCall + +/-- Every finite logical prefix has a physical prefix of the same length, +with equal remaining heap fuel, exact observation agreement, and unique +reservations across all active and suspended frames. -/ +theorem steps_related {policy : CreditPolicy} {context : Context} {mapping : Array Nat} + {left right leftAfter : Machine} {count : Nat} + (machines : MachineRel mapping left right) + (steps : Policy.Steps policy context .logical count left leftAfter) : + ∃ after rightAfter, Policy.Steps policy context .physical count right rightAfter ∧ + MachineRel after leftAfter rightAfter ∧ MapExtends mapping after := by + induction steps generalizing mapping right with + | refl => exact ⟨mapping, right, .refl _, machines, MapExtends.refl _⟩ + | @cons count left middle final frame stack running head tail ih => + obtain ⟨middleMap, targetMiddle, targetHead, transferred⟩ := step_related machines head + have next := transferred.machine (targetHead.reservationOwnership machines.reservations) + obtain ⟨after, target, targetTail, related, extension⟩ := ih next + rcases right with ⟨rightStore, rightFuel, rightControl⟩ + have controls := machines.control + rw [running] at controls + cases controls with + | running frames stacks => + exact ⟨after, target, .cons rfl targetHead targetTail, related, + MapExtends.trans transferred.extension extension⟩ + +theorem initial_related (definition : Function) (heapFuel : Nat) : + MachineRel #[] (initialMachine definition #[] heapFuel) + (initialMachine definition #[] heapFuel) := + ⟨.empty, rfl, .running (.entry definition .nil) .nil, + Policy.initialMachine_reservationOwnership ..⟩ + +end Ix.Compiler.IxIR2.CreditRefinement diff --git a/Ix/Compiler/IxIR2/CreditTerminators.lean b/Ix/Compiler/IxIR2/CreditTerminators.lean new file mode 100644 index 000000000..9ca8ddfee --- /dev/null +++ b/Ix/Compiler/IxIR2/CreditTerminators.lean @@ -0,0 +1,98 @@ +import Ix.Compiler.IxIR2.CreditInstructions + +/-! Jumps, dispatch, returns, and both tail-call forms. -/ + +namespace Ix.Compiler.IxIR2.CreditRefinement + +open Eval +open Ix.Compiler.IxIR1.Sim (RValIso RValsIso) +open CallReuse.Sim (MapRel) + +theorem terminator_related {context : Context} {mapping : Array Nat} + {leftStore rightStore : Store} {heapFuel : Nat} + {leftFrame rightFrame : Frame} {leftStack rightStack : List Continuation} + {terminator : Terminator} {leftAfter : Machine} + (state : HeapRel mapping leftStore rightStore) + (frames : FrameRel mapping leftFrame rightFrame) + (stack : StackRel mapping leftStack rightStack) + (classified : TerminatorTransferCase context .logical leftStore heapFuel leftFrame + leftStack terminator leftAfter) : + ∃ after rightAfter, + TerminatorTransferCase context .physical rightStore heapFuel rightFrame + rightStack terminator rightAfter ∧ TransferRel mapping after leftAfter rightAfter := by + cases classified with + | jump transferred => + obtain ⟨target, targetTransfer, nextRel⟩ := frames.edge .nil transferred + exact ⟨mapping, _, .jump targetTransfer, + ⟨state, MapExtends.refl _, rfl, .running nextRel stack⟩⟩ + | switchCtor resolved boxAt node alternativeAt transferred => + obtain ⟨targetValue, targetResolved, valueRel⟩ := ReuseSim.resolveAtom_iso frames.values resolved + cases valueRel with + | @loc _ targetLocation mapped => + obtain ⟨targetBox, targetFields, targetView, boxes, fieldsRel⟩ := + state.heap.constructorView mapped (ConstructorView.of_box boxAt rfl node) + obtain ⟨target, targetTransfer, nextRel⟩ := frames.edge .nil transferred + exact ⟨mapping, _, .switchCtor targetResolved targetView.parts.1 targetView.parts.2.2 + alternativeAt targetTransfer, + ⟨state, MapExtends.refl _, rfl, .running nextRel stack⟩⟩ + | switchNatZero resolved transferred => + obtain ⟨targetValue, targetResolved, valueRel⟩ := ReuseSim.resolveAtom_iso frames.values resolved + cases valueRel + obtain ⟨target, targetTransfer, nextRel⟩ := frames.edge .nil transferred + exact ⟨mapping, _, .switchNatZero targetResolved targetTransfer, + ⟨state, MapExtends.refl _, rfl, .running nextRel stack⟩⟩ + | switchNatSucc resolved transferred => + obtain ⟨targetValue, targetResolved, valueRel⟩ := ReuseSim.resolveAtom_iso frames.values resolved + cases valueRel + obtain ⟨target, targetTransfer, nextRel⟩ := frames.edge (.cons .lit .nil) transferred + exact ⟨mapping, _, .switchNatSucc targetResolved targetTransfer, + ⟨state, MapExtends.refl _, rfl, .running nextRel stack⟩⟩ + | branchPresent lookedUp present transferred => + obtain ⟨targetCredit, targetLookup, creditRel⟩ := frames.creditLookup lookedUp + obtain ⟨target, targetTransfer, nextRel⟩ := frames.edge .nil transferred + exact ⟨mapping, _, .branchPresent targetLookup (creditRel.isPresent.symm.trans present) targetTransfer, + ⟨state, MapExtends.refl _, rfl, .running nextRel stack⟩⟩ + | branchAbsent lookedUp absent transferred => + obtain ⟨targetCredit, targetLookup, creditRel⟩ := frames.creditLookup lookedUp + obtain ⟨target, targetTransfer, nextRel⟩ := frames.edge .nil transferred + exact ⟨mapping, _, .branchAbsent targetLookup (creditRel.isPresent.symm.trans absent) targetTransfer, + ⟨state, MapExtends.refl _, rfl, .running nextRel stack⟩⟩ + | retResume resolved noCredits world => + cases stack with + | cons head rest => + cases head with + | resume caller => + obtain ⟨targetValue, targetResolved, valueRel⟩ := ReuseSim.resolveAtom_iso frames.values resolved + exact ⟨mapping, _, .retResume targetResolved (frames.noCredits noCredits) + (by rw [← frames.definition]; exact state.heap.hasWorld valueRel world), + ⟨state, MapExtends.refl _, rfl, .running (caller.push valueRel) rest⟩⟩ + | retHalt resolved noCredits world => + cases stack + obtain ⟨targetValue, targetResolved, valueRel⟩ := ReuseSim.resolveAtom_iso frames.values resolved + exact ⟨mapping, _, .retHalt targetResolved (frames.noCredits noCredits) + (by rw [← frames.definition]; exact state.heap.hasWorld valueRel world), + ⟨state, MapExtends.refl _, rfl, .halted valueRel⟩⟩ + | retApplyMore resolved noCredits world transferred => + cases stack with + | cons head rest => + cases head with + | applyMore caller arguments => + obtain ⟨targetValue, targetResolved, valueRel⟩ := ReuseSim.resolveAtom_iso frames.values resolved + obtain ⟨after, target, targetTransfer, related⟩ := + apply_related state valueRel arguments caller rest transferred + exact ⟨after, target, .retApplyMore targetResolved (frames.noCredits noCredits) + (by rw [← frames.definition]; exact state.heap.hasWorld valueRel world) targetTransfer, related⟩ + | tailCallFn noCredits resolved declaration arity nonempty => + obtain ⟨targetArguments, targetResolved, argumentsRel⟩ := ReuseSim.resolveAtoms_iso frames.values resolved + exact ⟨mapping, _, .tailCallFn (frames.noCredits noCredits) targetResolved declaration + (by rw [← values_size argumentsRel]; exact arity) nonempty, + ⟨state, MapExtends.refl _, rfl, .running (.entry _ argumentsRel) stack⟩⟩ + | tailCallSelf noCredits resolved arity nonempty => + obtain ⟨targetArguments, targetResolved, argumentsRel⟩ := ReuseSim.resolveAtoms_iso frames.values resolved + refine ⟨mapping, _, .tailCallSelf (frames.noCredits noCredits) targetResolved + (by rw [← values_size argumentsRel, ← frames.definition]; exact arity) + (by rw [← frames.definition]; exact nonempty), + ⟨state, MapExtends.refl _, rfl, .running ?_ stack⟩⟩ + simpa only [frames.definition] using FrameRel.entry leftFrame.definition argumentsRel + +end Ix.Compiler.IxIR2.CreditRefinement diff --git a/Ix/Compiler/IxIR2/Eval.lean b/Ix/Compiler/IxIR2/Eval.lean new file mode 100644 index 000000000..9a9f48ba1 --- /dev/null +++ b/Ix/Compiler/IxIR2/Eval.lean @@ -0,0 +1,5334 @@ +import Ix.Compiler.IxIR1.Eval +import Ix.Compiler.IxIR2.Validate + +/-! +# Logical and physical execution for IxIR₂ + +The two interpretations share one small-step control machine. Logical +execution frees a consumed constructor immediately and allocates freshly at +`allocWith`; physical execution reserves the slot and either reuses or +releases it. Calls are represented by an explicit continuation stack, so the +total runner spends exactly one control unit per IxIR₂ instruction or +terminator. Recursive heap traversal has an independent budget. +-/ + +namespace Ix.Compiler.IxIR2.Eval + +open Ix.Compiler.Ixon (Address Owned) +open Ix.Compiler.IxIR2 + +abbrev RVal := IxIR1.RVal +abbrev Node := IxIR1.Node +abbrev NodeBox := IxIR1.NodeBox + +inductive Interpretation where + | logical + | physical + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +inductive Error where + | controlFuel + | heapFuel + | stuck (detail : String) + | mem (detail : String) + | unknownRef (address : Address) + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- Counters shared by the logical and physical observations. -/ +structure Counters where + allocs : Nat := 0 + reuses : Nat := 0 + frees : Nat := 0 + rcops : Nat := 0 + resetAttempts : Nat := 0 + hotResets : Nat := 0 + coldResets : Nat := 0 + reusedPayloadUnits : Nat := 0 + peakLiveNodes : Nat := 0 + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- The IxIR₁ heap representation is reused deliberately. IxIR₂ adds reset +observations while preserving the existing constructor/PAP runtime boundary. -/ +structure Store where + heap : IxIR1.Store := {} + resetAttempts : Nat := 0 + hotResets : Nat := 0 + coldResets : Nat := 0 + reusedPayloadUnits : Nat := 0 + peakLiveNodes : Nat := 0 + deriving Repr, Inhabited + +def Store.get? (store : Store) (location : Nat) : Option NodeBox := + store.heap.get? location + +def Store.live (store : Store) : Nat := store.heap.live + +def Store.counters (store : Store) : Counters := + { allocs := store.heap.allocs + reuses := store.heap.reuses + frees := store.heap.frees + rcops := store.heap.rcops + resetAttempts := store.resetAttempts + hotResets := store.hotResets + coldResets := store.coldResets + reusedPayloadUnits := store.reusedPayloadUnits + peakLiveNodes := store.peakLiveNodes } + +private def Store.withPeak (store : Store) : Store := + { store with peakLiveNodes := max store.peakLiveNodes store.live } + +@[simp] theorem Store.withPeak_heap (store : Store) : + store.withPeak.heap = store.heap := by + rfl + +def Store.allocNode (store : Store) (world : Owned) (node : Node) : + Store × Nat := + let (heap, location) := store.heap.allocNode world node + ({ store with heap }.withPeak, location) + +@[simp] theorem Store.allocNode_heap (store : Store) (world : Owned) + (node : Node) : + (store.allocNode world node).1.heap = + (store.heap.allocNode world node).1 := by + rfl + +@[simp] theorem Store.allocNode_location (store : Store) (world : Owned) + (node : Node) : + (store.allocNode world node).2 = + (store.heap.allocNode world node).2 := by + rfl + +def Store.setBox (store : Store) (location : Nat) (box : NodeBox) : Store := + { store with heap := store.heap.setBox location box } + +@[simp] theorem Store.setBox_heap (store : Store) (location : Nat) + (box : NodeBox) : + (store.setBox location box).heap = store.heap.setBox location box := by + rfl + +def Store.kill (store : Store) (location : Nat) : Store := + { store with heap := store.heap.kill location } + +@[simp] theorem Store.kill_heap (store : Store) (location : Nat) : + (store.kill location).heap = store.heap.kill location := by + rfl + +def Store.rcTick (store : Store) : Store := + { store with heap := store.heap.rcTick } + +@[simp] theorem Store.rcTick_heap (store : Store) : + store.rcTick.heap = store.heap.rcTick := by + rfl + +/-- Remove a live node without counting a free. The physical credit becomes +the sole authority for this empty slot. -/ +def Store.reserve (store : Store) (location : Nat) : Store := + { store with + heap := { store.heap with + nodes := store.heap.nodes.setIfInBounds location none } } + +def Store.releaseReservation (store : Store) (location : Nat) : + Except Error Store := + match (store.heap.nodes)[location]? with + | some none => + .ok { store with heap := { store.heap with frees := store.heap.frees + 1 } } + | _ => .error (.mem "release of a non-reserved physical slot") + +def Store.reuseReservation (store : Store) (location : Nat) (world : Owned) + (node : Node) (payloadUnits : Nat) : Except Error Store := + match (store.heap.nodes)[location]? with + | some none => + let box : NodeBox := { world, rc := 1, node } + let heap := + { store.heap with + nodes := store.heap.nodes.setIfInBounds location (some box) + reuses := store.heap.reuses + 1 } + .ok ({ store with + heap + reusedPayloadUnits := store.reusedPayloadUnits + payloadUnits }).withPeak + | _ => .error (.mem "reuse of a non-reserved physical slot") + +def Store.tickResetAttempt (store : Store) : Store := + { store with resetAttempts := store.resetAttempts + 1 } + +def Store.tickHotReset (store : Store) : Store := + { store with hotResets := store.hotResets + 1 } + +def Store.tickColdReset (store : Store) : Store := + { store with coldResets := store.coldResets + 1 } + +inductive CreditPresence where + | absent + /-- `none` in the logical interpretation, the reserved slot in physical. -/ + | present (reservation : Option Nat) + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +structure Credit where + layout : LayoutId + presence : CreditPresence + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +def Credit.isPresent : Credit → Bool + | { presence := .present _, .. } => true + | { presence := .absent, .. } => false + +private def Credit.presentFor (interpretation : Interpretation) + (layout : LayoutId) (location : Nat) : Credit := + match interpretation with + | .logical => { layout, presence := .present none } + | .physical => { layout, presence := .present (some location) } + +structure Context where + declarations : Address → Option Decl := fun _ => none + schemas : Owned → CtorId → Option CtorSchema := fun _ _ => none + oracle : Address → List RVal → Option RVal := fun _ _ => none + +def Context.ofProgram (program : Program) + (schemas : Owned → CtorId → Option CtorSchema) + (oracle : Address → List RVal → Option RVal := fun _ _ => none) : Context := + { declarations := fun address => + (program.declarations.find? fun entry => entry.1 == address).map (·.2) + schemas + oracle } + +def RVal.isScalar : RVal → Bool + | .loc _ => false + | .lit _ | .erased => true + +def RVal.hasWorld (store : Store) (world : Owned) : RVal → Bool + | .loc location => + match store.get? location with + | some box => box.world == world + | none => false + | .lit _ | .erased => true + +def resolveAtom (values : Array RVal) : Atom → Except Error RVal + | .reg id => + match (values)[id]? with + | some value => .ok value + | none => .error (.stuck s!"unknown value register {id}") + | .lit literal => .ok (.lit literal) + | .erased => .ok .erased + +def resolveAtoms (values : Array RVal) (atoms : Array Atom) : + Except Error (Array RVal) := + atoms.foldlM (fun output atom => do + return output.push (← resolveAtom values atom)) #[] + +private def lookupSchema (context : Context) (world : Owned) (cid : CtorId) : + Except Error CtorSchema := + match context.schemas world cid with + | some schema => .ok schema + | none => .error (.stuck "missing constructor schema") + +private def requireCtor (store : Store) (location : Nat) (world : Owned) + (cid : CtorId) : Except Error (NodeBox × Array RVal) := do + let box ← match store.get? location with + | some box => pure box + | none => .error (.mem s!"dead constructor location {location}") + if box.world != world then + .error (.mem "constructor ownership-world mismatch") + else + match box.node with + | .ctorN actual fields => + if actual == cid then return (box, fields) + else .error (.stuck "constructor identity mismatch") + | .papN .. => .error (.stuck "constructor operation on a PAP") + +/-! ## Heap-only recursive primitives -/ + +/-- Increment one shared reference, leaving scalar values unchanged. -/ +def retainShared (store : Store) (value : RVal) : Except Error Store := + match value with + | .lit _ | .erased => .ok store + | .loc location => + match store.get? location with + | none => .error (.mem s!"retain of dead location {location}") + | some box => + if box.world != .shared then + .error (.mem "retain of a unique node") + else + .ok ((store.setBox location { box with rc := box.rc + 1 }).rcTick) + +private def retainSharedMany (store : Store) (values : Array RVal) : + Except Error Store := + values.foldlM retainShared store + +/-- Deep shared release. Every work-list item, including a scalar leaf, +consumes one heap-traversal unit; control fuel is not visible here. -/ +def releaseSharedWork : Nat → Store → List RVal → Except Error (Store × Nat) + | fuel, store, [] => .ok (store, fuel) + | 0, _, _ :: _ => .error .heapFuel + | fuel + 1, store, value :: rest => + match value with + | .lit _ | .erased => releaseSharedWork fuel store rest + | .loc location => + match store.get? location with + | none => .error (.mem s!"release of dead location {location}") + | some box => + if box.world != .shared then + .error (.mem "release of a unique node") + else + let store := store.rcTick + if box.rc == 0 then + .error (.mem "shared node has zero refcount") + else if box.rc == 1 then + let children := match box.node with + | .ctorN _ fields => fields.toList + | .papN _ _ arguments => arguments.toList + releaseSharedWork fuel (store.kill location) (children ++ rest) + else + releaseSharedWork fuel + (store.setBox location { box with rc := box.rc - 1 }) rest + +def releaseShared (heapFuel : Nat) (store : Store) (value : RVal) : + Except Error (Store × Nat) := + releaseSharedWork heapFuel store [value] + +/-- Deep unique destruction with a separate work-list budget. -/ +def dropUniqueWork : Nat → Store → List RVal → Except Error (Store × Nat) + | fuel, store, [] => .ok (store, fuel) + | 0, _, _ :: _ => .error .heapFuel + | fuel + 1, store, value :: rest => + match value with + | .lit _ | .erased => dropUniqueWork fuel store rest + | .loc location => + match store.get? location with + | none => .error (.mem s!"dropUnique of dead location {location}") + | some box => + if box.world != .unique then + .error (.mem "dropUnique of a shared node") + else + match box.node with + | .papN .. => .error (.mem "dropUnique of a PAP") + | .ctorN _ fields => + dropUniqueWork fuel (store.kill location) + (fields.toList ++ rest) + +def dropUnique (heapFuel : Nat) (store : Store) (value : RVal) : + Except Error (Store × Nat) := + dropUniqueWork heapFuel store [value] + +/-! ## Small-step control machine -/ + +structure Frame where + definition : Function + block : BlockId := 0 + pc : Nat := 0 + values : Array RVal := #[] + credits : Array (Option Credit) := #[] + deriving Repr, Inhabited + +inductive Continuation where + | resume (frame : Frame) + | applyMore (arguments : Array RVal) (frame : Frame) + deriving Repr, Inhabited + +inductive Control where + | running (frame : Frame) (stack : List Continuation) + | halted (value : RVal) + deriving Repr, Inhabited + +structure Machine where + store : Store := {} + heapFuel : Nat := 0 + control : Control + deriving Repr, Inhabited + +structure Result where + store : Store + value : RVal + controlRemaining : Nat + heapRemaining : Nat + deriving Repr, Inhabited + +def creditPresentCount (credits : Array (Option Credit)) : Nat := + credits.foldl (fun total credit => + match credit with + | some credit => if credit.isPresent then total + 1 else total + | none => total) 0 + +def Frame.presentCredits (frame : Frame) : Nat := + creditPresentCount frame.credits + +def Continuation.presentCredits : Continuation → Nat + | .resume frame | .applyMore _ frame => frame.presentCredits + +def Machine.presentCredits (machine : Machine) : Nat := + match machine.control with + | .halted _ => 0 + | .running frame stack => + frame.presentCredits + + stack.foldl (fun total continuation => + total + continuation.presentCredits) 0 + +private def Frame.advance (frame : Frame) : Frame := + { frame with pc := frame.pc + 1 } + +private def Frame.pushValue (frame : Frame) (value : RVal) : Frame := + { frame with values := frame.values.push value } + +private def Frame.pushValues (frame : Frame) (values : Array RVal) : Frame := + { frame with values := frame.values ++ values } + +private def Frame.pushCredit (frame : Frame) (credit : Credit) : Frame := + { frame with credits := frame.credits.push (some credit) } + +private def Frame.hasCredits (frame : Frame) : Bool := + frame.credits.any Option.isSome + +private def currentBlock (frame : Frame) : Except Error Block := + match (frame.definition.blocks)[frame.block]? with + | some block => .ok block + | none => .error (.stuck s!"missing current block {frame.block}") + +/-- Shared entry check for both versioned credit policies. Every callee starts +with an empty credit register file; caller credits stay in its continuation. -/ +def enterFunction (definition : Function) (arguments : Array RVal) : + Except Error Frame := + if arguments.size != definition.signature.params.size then + .error (.stuck "function argument arity mismatch") + else if definition.blocks.isEmpty then + .error (.stuck "function has no entry block") + else + .ok { definition, values := arguments } + +private def creditAt (frame : Frame) (id : CreditId) : Except Error Credit := + match (frame.credits)[id]? with + | some (some credit) => .ok credit + | some none => .error (.mem s!"credit {id} was already consumed") + | none => .error (.stuck s!"unknown credit register {id}") + +private def takeCredit (frame : Frame) (id : CreditId) : + Except Error (Frame × Credit) := do + let credit ← creditAt frame id + return ({ frame with credits := frame.credits.setIfInBounds id none }, credit) + +private def takeCredits (frame : Frame) (ids : Array CreditId) : + Except Error (Frame × Array Credit) := + ids.foldlM (fun state id => do + let (frame, credit) ← takeCredit state.1 id + return (frame, state.2.push credit)) (frame, #[]) + +private def checkFieldWorlds (store : Store) (schema : CtorSchema) + (values : Array RVal) : Except Error Unit := do + if values.size != schema.fields.size then + .error (.stuck "constructor field-count mismatch") + else + for pair in values.toList.zip schema.fields.toList do + if !pair.1.hasWorld store pair.2 then + .error (.mem "constructor field ownership-world mismatch") + +/-- Public semantic premise used by allocation reduction and simulation +lemmas. Its executable witness remains shared with the evaluator. -/ +def FieldWorlds (store : Store) (schema : CtorSchema) + (values : Array RVal) : Prop := + checkFieldWorlds store schema values = .ok () + +/-- The executable field check certifies the actual runtime payload arity. -/ +theorem FieldWorlds.size {store : Store} {schema : CtorSchema} {values : Array RVal} + (checked : FieldWorlds store schema values) : values.size = schema.fields.size := by + by_cases same : values.size = schema.fields.size + · exact same + · simp [FieldWorlds, checkFieldWorlds, same] at checked + +/-- A uniform constructor schema accepts an equally sized value vector when +every value inhabits that world. Baseline pipeline schemas have exactly this +form, so semantic simulation can discharge the evaluator's executable field +check from source ownership evidence. -/ +theorem FieldWorlds.of_replicate {store : Store} {schema : CtorSchema} + {values : Array RVal} {world : Owned} {count : Nat} + (schemaFields : schema.fields = Array.replicate count world) + (valueCount : values.size = count) + (worlds : ∀ value ∈ values.toList, + RVal.hasWorld store world value = true) : + FieldWorlds store schema values := by + have loop : ∀ entries : List RVal, + (∀ value ∈ entries, RVal.hasWorld store world value = true) → + (for pair in entries.zip (List.replicate entries.length world) do + if !RVal.hasWorld store pair.2 pair.1 then + Except.error + (Error.mem "constructor field ownership-world mismatch")) = + Except.ok PUnit.unit := by + intro entries entryWorlds + induction entries with + | nil => rfl + | cons value rest ih => + have head := entryWorlds value (by simp) + have tail : ∀ candidate ∈ rest, + RVal.hasWorld store world candidate = true := by + intro candidate member + exact entryWorlds candidate (by simp [member]) + simp only [List.length_cons, List.replicate_succ, + List.zip_cons_cons, List.forIn_cons] + have headFalse : + (!RVal.hasWorld store world value) = false := by + simp [head] + rw [headFalse] + simp only [Bool.false_eq_true, ↓reduceIte, bind, Except.bind, + pure, Except.pure] + exact ih tail + unfold FieldWorlds checkFieldWorlds + rw [schemaFields] + have sizes : + (values.size != (Array.replicate count world).size) = false := by + simp [valueCount] + rw [sizes] + simp only [Bool.false_eq_true, ↓reduceIte, Array.toList_replicate] + have lengthEq : values.toList.length = count := by + simpa using valueCount + rw [← lengthEq] + rw [loop values.toList worlds] + +/-- Inversion of `of_replicate`: a successful uniform-schema check exposes +both the exact field count and the dynamic world of every field. -/ +theorem FieldWorlds.to_replicate {store : Store} {schema : CtorSchema} + {values : Array RVal} {world : Owned} {count : Nat} + (schemaFields : schema.fields = Array.replicate count world) + (worlds : FieldWorlds store schema values) : + values.size = count ∧ + ∀ value ∈ values.toList, + RVal.hasWorld store world value = true := by + have loop : ∀ entries : List RVal, + (for pair in entries.zip (List.replicate entries.length world) do + if !RVal.hasWorld store pair.2 pair.1 then + Except.error + (Error.mem "constructor field ownership-world mismatch")) = + Except.ok PUnit.unit → + ∀ value ∈ entries, + RVal.hasWorld store world value = true := by + intro entries + induction entries with + | nil => simp + | cons head tail ih => + intro run value member + simp only [List.length_cons, List.replicate_succ, + List.zip_cons_cons, List.forIn_cons] at run + have headWorld : RVal.hasWorld store world head = true := by + cases found : RVal.hasWorld store world head with + | false => + simp only [found, Bool.not_false, ↓reduceIte, bind, + Except.bind] at run + cases run + | true => rfl + have tailRun : + (for pair in tail.zip (List.replicate tail.length world) do + if !RVal.hasWorld store pair.2 pair.1 then + Except.error + (Error.mem + "constructor field ownership-world mismatch")) = + Except.ok PUnit.unit := by + simpa [headWorld] using run + simp only [List.mem_cons] at member + rcases member with rfl | member + · exact headWorld + · exact ih tailRun value member + unfold FieldWorlds checkFieldWorlds at worlds + rw [schemaFields] at worlds + by_cases valueCount : values.size = count + · have sizes : + (values.size != (Array.replicate count world).size) = false := by + simp [valueCount] + rw [sizes] at worlds + simp only [Bool.false_eq_true, ↓reduceIte, + Array.toList_replicate] at worlds + have lengthEq : values.toList.length = count := by + simpa using valueCount + rw [← lengthEq] at worlds + exact ⟨valueCount, loop values.toList worlds⟩ + · have sizes : + (values.size != (Array.replicate count world).size) = true := by + simp [valueCount] + rw [sizes] at worlds + simp at worlds + +/-- Constructor-field validation depends on a store only through the dynamic +world observed for each field value. This congruence theorem lets semantic +simulations transport `FieldWorlds` across a heap relation without unfolding +the evaluator's private checker. -/ +theorem FieldWorlds.congrStore {left right : Store} {schema : CtorSchema} + {values : Array RVal} + (sameWorlds : ∀ world value, + RVal.hasWorld left world value = RVal.hasWorld right world value) + (worlds : FieldWorlds left schema values) : + FieldWorlds right schema values := by + unfold FieldWorlds checkFieldWorlds at worlds ⊢ + simpa only [← sameWorlds] using worlds + +/-- Pointwise value relation used by the public field-check transport seam. -/ +inductive FieldValuesWorldEq (left right : Store) : + List RVal → List RVal → Prop where + | nil : FieldValuesWorldEq left right [] [] + | cons {leftValue rightValue : RVal} {lefts rights : List RVal} + (head : ∀ world, + RVal.hasWorld left world leftValue = + RVal.hasWorld right world rightValue) + (tail : FieldValuesWorldEq left right lefts rights) : + FieldValuesWorldEq left right (leftValue :: lefts) + (rightValue :: rights) + +theorem FieldValuesWorldEq.length_eq {left right : Store} : + ∀ {lefts rights : List RVal}, + FieldValuesWorldEq left right lefts rights → + lefts.length = rights.length + | _, _, .nil => rfl + | _, _, .cons _ tail => by simp [tail.length_eq] + +/-- Constructor-field validation transports across pointwise values that make +the same dynamic ownership observation. This is the allocation-facing +equivariance interface: clients need not unfold the private checker or require +the two value vectors to use identical concrete heap locations. -/ +theorem FieldWorlds.transport {left right : Store} {schema : CtorSchema} + {leftValues rightValues : Array RVal} + (related : FieldValuesWorldEq left right + leftValues.toList rightValues.toList) + (worlds : FieldWorlds left schema leftValues) : + FieldWorlds right schema rightValues := by + have sizes : leftValues.size = rightValues.size := by + simpa using related.length_eq + have loop : ∀ {lefts rights : List RVal}, + FieldValuesWorldEq left right lefts rights → + ∀ schemaFields : List Owned, + ((for pair in lefts.zip schemaFields do + if !pair.1.hasWorld left pair.2 then + Except.error + (Error.mem "constructor field ownership-world mismatch")) : + Except Error Unit) = + ((for pair in rights.zip schemaFields do + if !pair.1.hasWorld right pair.2 then + Except.error + (Error.mem "constructor field ownership-world mismatch")) : + Except Error Unit) := by + intro lefts rights valuesRelated + induction valuesRelated with + | nil => intro schemaFields; simp + | cons valueRelated tailRelated ih => + intro schemaFields + cases schemaFields with + | nil => rfl + | cons world rest => + simp only [List.zip_cons_cons, List.forIn_cons] + rw [valueRelated world] + split <;> simp only [bind, Except.bind, pure, Except.pure] + exact ih rest + unfold FieldWorlds checkFieldWorlds at worlds ⊢ + rw [← sizes] + rw [← loop related schema.fields.toList] + exact worlds + +/-- Pointwise preservation of successful world observations. Dead historical +registers need not have the same observations after physical reuse. -/ +inductive FieldValuesWorldForward (left right : Store) : List RVal → List RVal → Prop where + | nil : FieldValuesWorldForward left right [] [] + | cons {leftValue rightValue : RVal} {lefts rights : List RVal} + (head : ∀ world, RVal.hasWorld left world leftValue = true → + RVal.hasWorld right world rightValue = true) + (tail : FieldValuesWorldForward left right lefts rights) : + FieldValuesWorldForward left right (leftValue :: lefts) (rightValue :: rights) + +theorem FieldValuesWorldForward.length_eq {left right : Store} : + ∀ {lefts rights : List RVal}, FieldValuesWorldForward left right lefts rights → + lefts.length = rights.length + | _, _, .nil => rfl + | _, _, .cons _ tail => by simp [tail.length_eq] + +theorem FieldWorlds.forward {left right : Store} {schema : CtorSchema} + {leftValues rightValues : Array RVal} + (related : FieldValuesWorldForward left right leftValues.toList rightValues.toList) + (worlds : FieldWorlds left schema leftValues) : FieldWorlds right schema rightValues := by + have sizes : leftValues.size = rightValues.size := by simpa using related.length_eq + have loop : ∀ {lefts rights : List RVal}, + FieldValuesWorldForward left right lefts rights → ∀ schemaFields : List Owned, + ((for pair in lefts.zip schemaFields do + if !pair.1.hasWorld left pair.2 then + Except.error (Error.mem "constructor field ownership-world mismatch")) : + Except Error Unit) = .ok () → + ((for pair in rights.zip schemaFields do + if !pair.1.hasWorld right pair.2 then + Except.error (Error.mem "constructor field ownership-world mismatch")) : + Except Error Unit) = .ok () := by + intro lefts rights related + induction related with + | nil => intro schemaFields checked; simpa using checked + | @cons leftValue rightValue lefts rights head tail ih => + intro schemaFields checked + cases schemaFields with + | nil => rfl + | cons world rest => + simp only [List.zip_cons_cons, List.forIn_cons] at checked ⊢ + cases observed : RVal.hasWorld left world leftValue with + | false => simp [observed, bind, Except.bind] at checked + | true => + have rightObserved := head world observed + simp [observed, bind, Except.bind, pure, Except.pure] at checked + simpa [rightObserved, bind, Except.bind, pure, Except.pure] using + ih rest (by simpa [bind, Except.bind, pure, Except.pure] using checked) + have arity := worlds.size + unfold FieldWorlds checkFieldWorlds at worlds ⊢ + simp only [← sizes, arity, bne_self_eq_false, Bool.false_eq_true, ↓reduceIte] at worlds ⊢ + exact loop related schema.fields.toList worlds + +private def callScalarOracle (context : Context) (address : Address) + (arguments : Array RVal) : Except Error RVal := + if !arguments.all RVal.isScalar then + .error (.mem "extern heap arguments require an ownership policy") + else + match context.oracle address arguments.toList with + | none => .error (.unknownRef address) + | some value => + if value.isScalar then .ok value + else .error (.mem "extern heap results require an ownership policy") + +private def declarationArity : Decl → Nat + | .fn definition => definition.signature.params.size + | .extern arity => arity + +private def declarationPapSafe : Decl → Bool + | .fn definition => definition.signature.papSafe + | .extern _ => true + +private def ensureCallBoundary (frame : Frame) : Except Error Unit := + if frame.hasCredits then + .error (.mem "reuse credit crossed a call boundary") + else + return () + +private def resumeImmediate (store : Store) (heapFuel : Nat) (value : RVal) + (frame : Frame) (stack : List Continuation) : Machine := + { store := store + heapFuel := heapFuel + control := .running (frame.pushValue value) stack } + +private def beginApply (context : Context) (_interpretation : Interpretation) + (store : Store) (heapFuel : Nat) (function : RVal) + (arguments : Array RVal) (resume : Frame) (stack : List Continuation) : + Except Error Machine := do + match function with + | .lit _ => .error (.stuck "apply of a scalar literal") + | .erased => + let (store, heapFuel) ← + releaseSharedWork heapFuel store arguments.toList + return resumeImmediate store heapFuel .erased resume stack + | .loc location => + let box ← match store.get? location with + | some box => pure box + | none => .error (.mem s!"apply of dead location {location}") + if box.world != .shared then + .error (.mem "apply of a unique node") + else + match box.node with + | .ctorN .. => .error (.stuck "apply of a constructor node") + | .papN address arity captured => + if captured.size >= arity then + .error (.stuck "malformed saturated PAP") + else + let store ← retainSharedMany store captured + let (store, heapFuel) ← + releaseSharedWork heapFuel store [.loc location] + let total := captured ++ arguments + if total.size < arity then + let (store, location) := + store.allocNode .shared (.papN address arity total) + return resumeImmediate store heapFuel (.loc location) resume stack + else + let declaration ← match context.declarations address with + | some declaration => pure declaration + | none => .error (.unknownRef address) + if !declarationPapSafe declaration then + .error (.stuck "shared PAP targets a non-pap-safe function") + else + let supplied := total.extract 0 arity + let rest := total.extract arity total.size + match declaration with + | .fn definition => + let callee ← enterFunction definition supplied + let continuation : Continuation := + if rest.isEmpty then Continuation.resume resume + else Continuation.applyMore rest resume + let nextMachine : Machine := + { store := store + heapFuel := heapFuel + control := .running callee (continuation :: stack) } + return nextMachine + | .extern expectedArity => + if supplied.size != expectedArity then + .error (.stuck "extern PAP arity mismatch") + else if !rest.isEmpty then + .error (.stuck "over-application of a scalar extern result") + else + let value ← callScalarOracle context address supplied + return resumeImmediate store heapFuel value resume stack + +private def transferEdge (frame : Frame) (edge : Edge) + (implicitValues : Array RVal := #[]) : Except Error Frame := do + let values ← resolveAtoms frame.values edge.values + let (frame, credits) ← takeCredits frame edge.credits + if frame.hasCredits then + .error (.mem "edge abandoned a live reuse credit") + else + let target ← match (frame.definition.blocks)[edge.target]? with + | some block => pure block + | none => .error (.stuck s!"edge targets missing block {edge.target}") + let values := implicitValues ++ values + if values.size != target.valueParams.size then + .error (.stuck "edge value arity mismatch") + else if credits.size != target.creditParams.size then + .error (.stuck "edge credit arity mismatch") + else + return { frame with + block := edge.target + pc := 0 + values + credits := credits.map some } + +private def runInstruction (context : Context) + (interpretation : Interpretation) (machine : Machine) (frame : Frame) + (stack : List Continuation) (instruction : Instr) : Except Error Machine := do + let next := frame.advance + match instruction with + | .move atom => + let value ← resolveAtom frame.values atom + return { machine with control := .running (next.pushValue value) stack } + | .alloc world cid arguments => + let schema ← lookupSchema context world cid + let values ← resolveAtoms frame.values arguments + checkFieldWorlds machine.store schema values + let (store, location) := machine.store.allocNode world (.ctorN cid values) + return { machine with + store + control := .running (next.pushValue (.loc location)) stack } + | .allocWith creditId world cid arguments => + let schema ← lookupSchema context world cid + let values ← resolveAtoms frame.values arguments + checkFieldWorlds machine.store schema values + let (next, credit) ← takeCredit next creditId + if credit.layout != schema.layout then + .error (.mem "allocWith credit layout mismatch") + else + match interpretation, credit.presence with + | _, .absent => + let (store, location) := + machine.store.allocNode world (.ctorN cid values) + return { machine with + store + control := .running (next.pushValue (.loc location)) stack } + | .logical, .present none => + let (store, location) := + machine.store.allocNode world (.ctorN cid values) + return { machine with + store + control := .running (next.pushValue (.loc location)) stack } + | .physical, .present (some location) => + let store ← machine.store.reuseReservation location world + (.ctorN cid values) schema.fields.size + return { machine with + store + control := .running (next.pushValue (.loc location)) stack } + | _, .present _ => + .error (.mem "credit reservation belongs to the other interpretation") + | .discardCredit creditId => + let (next, credit) ← takeCredit next creditId + let store ← match interpretation, credit.presence with + | _, .absent => pure machine.store + | .logical, .present none => pure machine.store + | .physical, .present (some location) => + machine.store.releaseReservation location + | _, .present _ => + .error (.mem "credit reservation belongs to the other interpretation") + return { machine with store, control := .running next stack } + | .takeUnique target cid => + let schema ← lookupSchema context .unique cid + match ← resolveAtom frame.values target with + | .loc location => + let (box, fields) ← requireCtor machine.store location .unique cid + if box.rc != 1 then + .error (.mem "unique constructor has a non-unit refcount") + else + let store := match interpretation with + | .logical => machine.store.kill location + | .physical => machine.store.reserve location + let credit := Credit.presentFor interpretation schema.layout location + let next := (next.pushValues fields).pushCredit credit + return { machine with store, control := .running next stack } + | _ => .error (.mem "takeUnique requires a constructor location") + | .resetShared target cid => + let schema ← lookupSchema context .shared cid + match ← resolveAtom frame.values target with + | .loc location => + let (box, fields) ← requireCtor machine.store location .shared cid + let store := machine.store.tickResetAttempt + if box.rc == 0 then + .error (.mem "shared constructor has zero refcount") + else if box.rc == 1 then + let store := (match interpretation with + | .logical => store.kill location + | .physical => store.reserve location).tickHotReset + let credit := Credit.presentFor interpretation schema.layout location + let next := (next.pushValues fields).pushCredit credit + return { machine with store, control := .running next stack } + else + let store := + ((store.setBox location { box with rc := box.rc - 1 }).rcTick).tickColdReset + let store ← retainSharedMany store fields + let credit : Credit := { layout := schema.layout, presence := .absent } + let next := (next.pushValues fields).pushCredit credit + return { machine with store, control := .running next stack } + | _ => .error (.mem "resetShared requires a constructor location") + | .retainShared target => + let value ← resolveAtom frame.values target + let store ← retainShared machine.store value + return { machine with + store + control := .running (next.pushValue value) stack } + | .releaseShared target => + let value ← resolveAtom frame.values target + let (store, heapFuel) ← releaseShared machine.heapFuel machine.store value + return { store, heapFuel, control := .running next stack } + | .dropUnique target => + let value ← resolveAtom frame.values target + let (store, heapFuel) ← dropUnique machine.heapFuel machine.store value + return { store, heapFuel, control := .running next stack } + | .freeUnique target cid => + match ← resolveAtom frame.values target with + | .loc location => + let (_, fields) ← requireCtor machine.store location .unique cid + if !fields.all RVal.isScalar then + .error (.mem "freeUnique requires an all-scalar constructor") + else + return { machine with + store := machine.store.kill location + control := .running next stack } + | _ => .error (.mem "freeUnique requires a constructor location") + | .fetch target cid field => + match ← resolveAtom frame.values target with + | .loc location => + let box ← match machine.store.get? location with + | some box => pure box + | none => .error (.mem s!"fetch from dead location {location}") + match box.node with + | .papN .. => .error (.stuck "fetch from a PAP") + | .ctorN actual fields => + if actual != cid then + .error (.stuck "fetch constructor identity mismatch") + else + match (fields)[field]? with + | some value => + return { machine with + control := .running (next.pushValue value) stack } + | none => .error (.stuck s!"fetch field {field} out of range") + | _ => .error (.stuck "fetch from a non-location") + | .call address arguments => + ensureCallBoundary frame + let values ← resolveAtoms frame.values arguments + match context.declarations address with + | some (.fn definition) => + let callee ← enterFunction definition values + return { machine with + control := .running callee (.resume next :: stack) } + | some (.extern _) => .error (.stuck "call must not target an extern") + | none => .error (.unknownRef address) + | .callSelf arguments => + ensureCallBoundary frame + let values ← resolveAtoms frame.values arguments + let callee ← enterFunction frame.definition values + return { machine with control := .running callee (.resume next :: stack) } + | .papp address arguments => + ensureCallBoundary frame + let values ← resolveAtoms frame.values arguments + let declaration ← match context.declarations address with + | some declaration => pure declaration + | none => .error (.unknownRef address) + let arity := declarationArity declaration + if !declarationPapSafe declaration then + .error (.stuck "PAP target is not papSafe") + else if values.size >= arity then + .error (.stuck "papp must be strictly under-saturated") + else + let (store, location) := + machine.store.allocNode .shared (.papN address arity values) + return { machine with + store + control := .running (next.pushValue (.loc location)) stack } + | .apply function arguments => + ensureCallBoundary frame + let function ← resolveAtom frame.values function + let arguments ← resolveAtoms frame.values arguments + beginApply context interpretation machine.store machine.heapFuel function + arguments next stack + | .extern address arguments => + ensureCallBoundary frame + let values ← resolveAtoms frame.values arguments + match context.declarations address with + | some (.extern arity) => + if values.size != arity then + .error (.stuck "extern arity mismatch") + else + let value ← callScalarOracle context address values + return { machine with control := .running (next.pushValue value) stack } + | some (.fn _) => .error (.stuck "extern instruction targets a function") + | none => .error (.unknownRef address) + +private def finishReturn (context : Context) + (interpretation : Interpretation) (machine : Machine) (frame : Frame) + (stack : List Continuation) (value : RVal) : Except Error Machine := do + if frame.hasCredits then + .error (.mem "function returned with a live reuse credit") + else if !value.hasWorld machine.store frame.definition.signature.result then + .error (.mem "function result ownership-world mismatch") + else + match stack with + | [] => return { machine with control := .halted value } + | .resume caller :: rest => + return { machine with control := .running (caller.pushValue value) rest } + | .applyMore arguments caller :: rest => + beginApply context interpretation machine.store machine.heapFuel value + arguments caller rest + +private def runTerminator (context : Context) + (interpretation : Interpretation) (machine : Machine) (frame : Frame) + (stack : List Continuation) (terminator : Terminator) : Except Error Machine := do + match terminator with + | .jump edge => + let frame ← transferEdge frame edge + return { machine with control := .running frame stack } + | .switchValue scrutinee constructors natPeel => + match ← resolveAtom frame.values scrutinee with + | .loc location => + let box ← match machine.store.get? location with + | some box => pure box + | none => .error (.mem s!"switch on dead location {location}") + match box.node with + | .papN .. => .error (.stuck "switch on a PAP") + | .ctorN cid _ => + match constructors.find? fun alternative => alternative.cid == cid with + | none => .error (.stuck "missing constructor alternative") + | some alternative => + let frame ← transferEdge frame alternative.edge + return { machine with control := .running frame stack } + | .lit (.nat number) => + match natPeel with + | none => .error (.stuck "Nat switch without literal peeling") + | some peel => + match number with + | 0 => + let frame ← transferEdge frame peel.zero + return { machine with control := .running frame stack } + | predecessor + 1 => + let frame ← transferEdge frame peel.succ #[.lit (.nat predecessor)] + return { machine with control := .running frame stack } + | .lit (.str _) | .erased => .error (.stuck "switch on a non-Nat scalar") + | .branchCredit credit someEdge noneEdge => + let credit ← creditAt frame credit + let edge := if credit.isPresent then someEdge else noneEdge + let frame ← transferEdge frame edge + return { machine with control := .running frame stack } + | .ret atom => + let value ← resolveAtom frame.values atom + finishReturn context interpretation machine frame stack value + | .tailCall address arguments => + ensureCallBoundary frame + let values ← resolveAtoms frame.values arguments + match context.declarations address with + | some (.fn definition) => + let frame ← enterFunction definition values + return { machine with control := .running frame stack } + | some (.extern _) => .error (.stuck "tailCall must not target an extern") + | none => .error (.unknownRef address) + | .tailCallSelf arguments => + ensureCallBoundary frame + let values ← resolveAtoms frame.values arguments + let frame ← enterFunction frame.definition values + return { machine with control := .running frame stack } + +/-- One control transition: exactly one IxIR₂ instruction or terminator. -/ +def step (context : Context) (interpretation : Interpretation) + (machine : Machine) : Except Error Machine := do + match machine.control with + | .halted _ => return machine + | .running frame stack => + let block ← currentBlock frame + if h : frame.pc < block.instructions.size then + runInstruction context interpretation machine frame stack + block.instructions[frame.pc] + else if frame.pc == block.instructions.size then + runTerminator context interpretation machine frame stack block.terminator + else + .error (.stuck "program counter passed the block terminator") + +/-- Unfueled small-step relation underlying the total runner. -/ +def Step (context : Context) (interpretation : Interpretation) + (before after : Machine) : Prop := + step context interpretation before = .ok after + +/-- Public proof interface for one checked CFG-edge transfer. It exposes the +resulting frame without making simulation clients unfold the evaluator's +private dispatcher. -/ +def EdgeTransfer (frame : Frame) (edge : Edge) + (implicitValues : Array RVal) (target : Frame) : Prop := + transferEdge frame edge implicitValues = .ok target + +/-- Public proof interface for one dynamic-application dispatch. Both an +`apply` instruction and an `applyMore` return continuation enter the same +private executable worker; exposing its exact successful equation here keeps +their semantic proofs on one control boundary. -/ +def ApplyTransfer (context : Context) (interpretation : Interpretation) + (store : Store) (heapFuel : Nat) (function : RVal) + (arguments : Array RVal) (resume : Frame) + (stack : List Continuation) (target : Machine) : Prop := + beginApply context interpretation store heapFuel function arguments resume + stack = .ok target + +/-- Public equation for one scalar-only external call. -/ +def ScalarOracleCall (context : Context) (address : Address) + (arguments : Array RVal) (value : RVal) : Prop := + callScalarOracle context address arguments = .ok value + +theorem ScalarOracleCall.congrOracle {left right : Context} + {address : Address} {arguments : Array RVal} {value : RVal} + (oracles : left.oracle = right.oracle) + (called : ScalarOracleCall left address arguments value) : + ScalarOracleCall right address arguments value := by + unfold ScalarOracleCall callScalarOracle at called ⊢ + rw [← oracles] + exact called + +/-- A successful scalar oracle boundary certifies that both its full argument +vector and returned value are scalar. -/ +theorem ScalarOracleCall.scalar {context : Context} {address : Address} + {arguments : Array RVal} {value : RVal} + (called : ScalarOracleCall context address arguments value) : + arguments.all RVal.isScalar = true ∧ value.isScalar = true := by + by_cases argumentsScalar : arguments.all RVal.isScalar = true + · refine ⟨argumentsScalar, ?_⟩ + cases oracleAt : context.oracle address arguments.toList with + | none => + simp [ScalarOracleCall, callScalarOracle, argumentsScalar, + oracleAt] at called + | some result => + by_cases resultScalar : result.isScalar = true + · simp [ScalarOracleCall, callScalarOracle, argumentsScalar, + oracleAt, resultScalar] at called + cases called + exact resultScalar + · simp [ScalarOracleCall, callScalarOracle, argumentsScalar, + oracleAt, resultScalar] at called + · simp [ScalarOracleCall, callScalarOracle, argumentsScalar] at called + +/-- Public equation for the shared-value retain loop used while opening a +PAP. The implementation remains centralized in the evaluator while +simulation clients can relate it to IxIR₁'s `dupVals`. -/ +def RetainSharedMany (store : Store) (values : Array RVal) + (target : Store) : Prop := + retainSharedMany store values = .ok target + +/-- Public equation for looking up a live credit without consuming it. This +is the semantic premise used by `branchCredit`. -/ +def CreditLookup (frame : Frame) (id : CreditId) (credit : Credit) : Prop := + creditAt frame id = .ok credit + +/-- Public equation for consuming one linear credit from a frame. Allocation +and discard rules use the returned frame directly, keeping the private slot +update centralized in the evaluator. -/ +def CreditTake (frame : Frame) (id : CreditId) (target : Frame) + (credit : Credit) : Prop := + takeCredit frame id = .ok (target, credit) + +/-- Public equation for transferring a vector of linear credits across a CFG +edge. -/ +def CreditTakeMany (frame : Frame) (ids : Array CreditId) (target : Frame) + (credits : Array Credit) : Prop := + takeCredits frame ids = .ok (target, credits) + +/-- A structural view of batch credit consumption. It exposes the sequence +of successful single-credit takes without exposing the evaluator's private +fold implementation. -/ +inductive CreditTakeSequence : + Frame → List CreditId → Frame → List Credit → Prop where + | nil (frame : Frame) : CreditTakeSequence frame [] frame [] + | cons {frame middle target : Frame} {id : CreditId} + {ids : List CreditId} {credit : Credit} {credits : List Credit} + (head : CreditTake frame id middle credit) + (tail : CreditTakeSequence middle ids target credits) : + CreditTakeSequence frame (id :: ids) target (credit :: credits) + +private theorem takeCredit_changeDefinition (frame : Frame) (id : CreditId) + (definition : Function) : + takeCredit { frame with definition } id = + (takeCredit frame id).map (fun output => + ({ output.1 with definition }, output.2)) := by + unfold takeCredit creditAt + cases found : frame.credits[id]? with + | none => + simp [bind, Except.bind, Except.map] + | some slot => + cases slot with + | none => + simp [bind, Except.bind, Except.map] + | some credit => + simp [bind, Except.bind, pure, Except.pure, Except.map] + +theorem CreditLookup.congrDefinition {frame : Frame} {id : CreditId} + {credit : Credit} (definition : Function) + (lookedUp : CreditLookup frame id credit) : + CreditLookup { frame with definition } id credit := by + unfold CreditLookup creditAt at lookedUp ⊢ + simpa using lookedUp + +theorem CreditTake.congrDefinition {frame target : Frame} {id : CreditId} + {credit : Credit} (definition : Function) + (taken : CreditTake frame id target credit) : + CreditTake { frame with definition } id + { target with definition } credit := by + unfold CreditTake at taken ⊢ + rw [takeCredit_changeDefinition, taken] + rfl + +/-- Successful single-credit consumption exposes the exact frame update and +the live slot that was removed. -/ +theorem CreditTake.target_eq {frame target : Frame} {id : CreditId} + {credit : Credit} (taken : CreditTake frame id target credit) : + target = { frame with + credits := frame.credits.setIfInBounds id none } ∧ + frame.credits[id]? = some (some credit) := by + unfold CreditTake takeCredit creditAt at taken + cases found : frame.credits[id]? with + | none => + simp [found, bind, Except.bind] at taken + | some slot => + cases slot with + | none => + simp [found, bind, Except.bind] at taken + | some foundCredit => + simp [found, bind, Except.bind, pure, Except.pure] at taken + obtain ⟨rfl, rfl⟩ := taken + exact ⟨rfl, rfl⟩ + +private theorem takeCredits_changeDefinition (frame : Frame) + (ids : Array CreditId) (definition : Function) : + takeCredits { frame with definition } ids = + (takeCredits frame ids).map (fun output => + ({ output.1 with definition }, output.2)) := by + unfold takeCredits + rw [← Array.foldlM_toList, ← Array.foldlM_toList] + let transform : Frame × Array Credit → Frame × Array Credit := + fun state => ({ state.1 with definition }, state.2) + let takeStep : Frame × Array Credit → CreditId → + Except Error (Frame × Array Credit) := + fun state id => do + let (next, credit) ← takeCredit state.1 id + return (next, state.2.push credit) + have one : ∀ (state : Frame × Array Credit) (id : CreditId), + takeStep (transform state) id = + (takeStep state id).map transform := by + intro state id + simp only [takeStep, transform] + rw [takeCredit_changeDefinition] + cases taken : takeCredit state.1 id with + | error error => + simp [bind, Except.bind, Except.map] + | ok output => + obtain ⟨next, credit⟩ := output + simp [bind, Except.bind, pure, Except.pure, Except.map] + have loop : ∀ (remaining : List CreditId) + (state : Frame × Array Credit), + List.foldlM takeStep (transform state) remaining = + (List.foldlM takeStep state remaining).map transform := by + intro remaining + induction remaining with + | nil => intro state; rfl + | cons id tail ih => + intro state + simp only [List.foldlM_cons] + cases taken : takeStep state id with + | error error => + have transformed := one state id + rw [taken] at transformed + simp only [Except.map] at transformed + rw [transformed] + simp [bind, Except.bind, Except.map] + | ok next => + have transformed := one state id + rw [taken] at transformed + simp only [Except.map] at transformed + rw [transformed] + simpa [bind, Except.bind, Except.map] using ih next + exact loop ids.toList (frame, #[]) + +/-- Consuming credits changes only the credit file of a frame. -/ +theorem CreditTakeMany.definition {frame target : Frame} + {ids : Array CreditId} {credits : Array Credit} + (taken : CreditTakeMany frame ids target credits) : + target.definition = frame.definition := by + unfold CreditTakeMany at taken + have preserved := + takeCredits_changeDefinition frame ids frame.definition + have inputEq : { frame with definition := frame.definition } = frame := by + cases frame + rfl + rw [inputEq, taken] at preserved + simp only [Except.map, Except.ok.injEq, Prod.mk.injEq] at preserved + have definitions := congrArg Frame.definition preserved.1 + simpa using definitions + +/-- Successful batch consumption decomposes into the corresponding sequence +of successful single-credit takes. -/ +theorem CreditTakeMany.sequence {frame target : Frame} + {ids : Array CreditId} {credits : Array Credit} + (taken : CreditTakeMany frame ids target credits) : + CreditTakeSequence frame ids.toList target credits.toList := by + let takeStep : Frame × Array Credit → CreditId → + Except Error (Frame × Array Credit) := + fun state id => do + let (next, credit) ← takeCredit state.1 id + return (next, state.2.push credit) + have loop : ∀ (remaining : List CreditId) (current : Frame) + (initial : Array Credit) {final : Frame} {output : Array Credit}, + List.foldlM takeStep (current, initial) remaining = + .ok (final, output) → + ∃ suffix : List Credit, + CreditTakeSequence current remaining final suffix ∧ + output.toList = initial.toList ++ suffix := by + intro remaining + induction remaining with + | nil => + intro current initial final output run + simp only [List.foldlM_nil] at run + obtain ⟨rfl, rfl⟩ := run + exact ⟨[], .nil current, by simp⟩ + | cons id rest ih => + intro current initial final output run + rw [List.foldlM_cons] at run + cases headRun : takeCredit current id with + | error error => + simp [takeStep, headRun, bind, Except.bind] at run + | ok result => + obtain ⟨middle, credit⟩ := result + simp only [takeStep, headRun, bind, Except.bind, pure, + Except.pure] at run + obtain ⟨suffix, tail, outputEq⟩ := + ih middle (initial.push credit) run + refine ⟨credit :: suffix, .cons ?_ tail, ?_⟩ + · exact headRun + · simp [outputEq, List.append_assoc] + unfold CreditTakeMany takeCredits at taken + rw [← Array.foldlM_toList] at taken + change List.foldlM takeStep (frame, #[]) ids.toList = + .ok (target, credits) at taken + obtain ⟨suffix, sequence, outputEq⟩ := loop ids.toList frame #[] taken + have suffixEq : credits.toList = suffix := by simpa using outputEq + subst suffix + exact sequence + +/-- A sequence of successful single-credit takes reconstructs the evaluator's +batch operation. -/ +theorem CreditTakeSequence.toMany {frame target : Frame} + {ids : List CreditId} {credits : List Credit} + (sequence : CreditTakeSequence frame ids target credits) : + CreditTakeMany frame ids.toArray target credits.toArray := by + let takeStep : Frame × Array Credit → CreditId → + Except Error (Frame × Array Credit) := + fun state id => do + let (next, credit) ← takeCredit state.1 id + return (next, state.2.push credit) + have loop : ∀ {current final : Frame} {remaining : List CreditId} + {output : List Credit}, + CreditTakeSequence current remaining final output → + ∀ initial : Array Credit, + List.foldlM takeStep (current, initial) remaining = + .ok (final, initial ++ output.toArray) := by + intro current final remaining output sequence + induction sequence with + | nil current => + intro initial + rfl + | @cons current middle final id remaining credit output head tail ih => + intro initial + rw [List.foldlM_cons] + unfold CreditTake at head + have headStep : takeStep (current, initial) id = + .ok (middle, initial.push credit) := by + dsimp only [takeStep] + rw [head] + rfl + rw [headStep] + simp only [bind, Except.bind] + rw [ih (initial.push credit)] + congr 2 + apply Array.toList_inj.mp + simp + unfold CreditTakeMany takeCredits + rw [← Array.foldlM_toList] + change List.foldlM takeStep (frame, #[]) ids = + .ok (target, credits.toArray) + simpa using loop sequence #[] + +/-- No unconsumed credit remains in this frame. -/ +def NoLiveCredits (frame : Frame) : Prop := + frame.credits.any Option.isSome = false + +/-- Public equation for the ownership- and identity-checked constructor view +used by destructive operations. -/ +def ConstructorView (store : Store) (location : Nat) (world : Owned) + (cid : CtorId) (box : NodeBox) (fields : Array RVal) : Prop := + requireCtor store location world cid = .ok (box, fields) + +/-- Constructor inspection is extensional in the selected heap lookup. -/ +theorem ConstructorView.congrStore {left right : Store} {location : Nat} + {world : Owned} {cid : CtorId} {box : NodeBox} + {fields : Array RVal} + (same : left.get? location = right.get? location) + (viewed : ConstructorView left location world cid box fields) : + ConstructorView right location world cid box fields := by + unfold ConstructorView requireCtor at viewed ⊢ + rw [← same] + exact viewed + +/-- A successful checked constructor view exposes the exact live box, +ownership world, and constructor payload that justified it. -/ +theorem ConstructorView.parts {store : Store} {location : Nat} + {world : Owned} {cid : CtorId} {box : NodeBox} + {fields : Array RVal} + (viewed : ConstructorView store location world cid box fields) : + store.get? location = some box ∧ + box.world = world ∧ box.node = .ctorN cid fields := by + unfold ConstructorView requireCtor at viewed + cases boxAt : store.get? location with + | none => + simp [boxAt, bind, Except.bind] at viewed + | some foundBox => + simp only [boxAt, bind, Except.bind, pure, Except.pure] at viewed + by_cases worldEq : foundBox.world = world + · simp [worldEq] at viewed + cases node : foundBox.node with + | papN address arity arguments => simp [node] at viewed + | ctorN actual actualFields => + simp only [node] at viewed + by_cases cidEq : actual = cid + · subst actual + simp at viewed + obtain ⟨rfl, rfl⟩ := viewed + exact ⟨rfl, worldEq, node⟩ + · simp [cidEq] at viewed + · simp [worldEq] at viewed + +theorem CreditLookup.of_getElem {frame : Frame} {id : CreditId} + {credit : Credit} + (found : frame.credits[id]? = some (some credit)) : + CreditLookup frame id credit := by + unfold CreditLookup creditAt + rw [found] + +theorem CreditTake.of_lookup {frame : Frame} {id : CreditId} + {credit : Credit} (found : CreditLookup frame id credit) : + CreditTake frame id + { frame with credits := frame.credits.setIfInBounds id none } + credit := by + unfold CreditTake takeCredit + unfold CreditLookup at found + rw [found] + rfl + +theorem CreditTakeMany.single {frame target : Frame} {id : CreditId} + {credit : Credit} (taken : CreditTake frame id target credit) : + CreditTakeMany frame #[id] target #[credit] := by + unfold CreditTakeMany takeCredits + unfold CreditTake at taken + simp [taken] + rfl + +theorem ConstructorView.of_box {store : Store} {location : Nat} + {world : Owned} {cid : CtorId} {box : NodeBox} + {fields : Array RVal} + (boxAt : store.get? location = some box) + (boxWorld : box.world = world) + (node : box.node = .ctorN cid fields) : + ConstructorView store location world cid box fields := by + unfold ConstructorView requireCtor + rw [boxAt] + simp [boxWorld, node] + rfl + +theorem RetainSharedMany.empty (store : Store) : + RetainSharedMany store #[] store := by + rfl + +theorem RetainSharedMany.cons {store middle target : Store} + {value : RVal} {values : List RVal} + (head : retainShared store value = .ok middle) + (tail : RetainSharedMany middle values.toArray target) : + RetainSharedMany store (value :: values).toArray target := by + unfold RetainSharedMany retainSharedMany at tail ⊢ + rw [← Array.foldlM_toList] at tail ⊢ + change List.foldlM retainShared middle values = .ok target at tail + change (do + let next ← retainShared store value + List.foldlM retainShared next values) = .ok target + rw [head] + exact tail + +/-- Invert a successful nonempty batch retain into its first retain and the +remaining batch. This is the elimination counterpart of +`RetainSharedMany.cons`; clients can reason inductively without unfolding the +private executable fold. -/ +theorem RetainSharedMany.cons_inv {store target : Store} + {value : RVal} {values : List RVal} + (run : RetainSharedMany store (value :: values).toArray target) : + ∃ middle, + retainShared store value = .ok middle ∧ + RetainSharedMany middle values.toArray target := by + unfold RetainSharedMany retainSharedMany at run + rw [← Array.foldlM_toList] at run + change (do + let middle ← retainShared store value + List.foldlM retainShared middle values) = .ok target at run + cases head : retainShared store value with + | error error => + rw [head] at run + contradiction + | ok middle => + refine ⟨middle, rfl, ?_⟩ + unfold RetainSharedMany retainSharedMany + rw [← Array.foldlM_toList] + simpa only [head, bind, Except.bind] using run + +/-- Applying an erased function releases the supplied shared arguments and +resumes the caller immediately with the erased value. -/ +theorem ApplyTransfer.erased {context : Context} + {interpretation : Interpretation} {store outStore : Store} + {heapFuel outHeapFuel : Nat} {arguments : Array RVal} + {resume : Frame} {stack : List Continuation} + (released : releaseSharedWork heapFuel store arguments.toList = + .ok (outStore, outHeapFuel)) : + ApplyTransfer context interpretation store heapFuel .erased arguments + resume stack + { store := outStore + heapFuel := outHeapFuel + control := .running + { resume with values := resume.values.push .erased } stack } := by + unfold ApplyTransfer beginApply resumeImmediate Frame.pushValue + rw [released] + rfl + +/-- Opening an under-saturated PAP retains its captured arguments, consumes +the old PAP owner, allocates the longer PAP, and resumes the caller in the +same control step. -/ +theorem ApplyTransfer.papUnder {context : Context} + {interpretation : Interpretation} {store retainedStore releasedStore : Store} + {heapFuel outHeapFuel : Nat} {location : Nat} {box : NodeBox} + {address : Address} {arity : Nat} {captured arguments : Array RVal} + {resume : Frame} {stack : List Continuation} + (boxAt : store.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (retained : RetainSharedMany store captured retainedStore) + (released : releaseSharedWork heapFuel retainedStore [.loc location] = + .ok (releasedStore, outHeapFuel)) + (totalUnder : (captured ++ arguments).size < arity) : + let allocation := releasedStore.allocNode .shared + (.papN address arity (captured ++ arguments)) + ApplyTransfer context interpretation store heapFuel (.loc location) + arguments resume stack + { store := allocation.1 + heapFuel := outHeapFuel + control := .running + { resume with values := resume.values.push (.loc allocation.2) } + stack } := by + dsimp only + unfold RetainSharedMany at retained + unfold ApplyTransfer beginApply + simp only + rw [boxAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [shared] + rw [if_neg (by decide)] + rw [node] + simp only + rw [if_neg (by omega)] + rw [retained] + simp only + rw [released] + simp only + rw [if_pos totalUnder] + rfl + +/-- Opening a saturated or over-saturated PAP enters its checked function +target. Remaining arguments are represented by the evaluator's explicit +`applyMore` continuation; exact saturation uses an ordinary resume. -/ +theorem ApplyTransfer.papFn {context : Context} + {interpretation : Interpretation} {store retainedStore releasedStore : Store} + {heapFuel outHeapFuel : Nat} {location : Nat} {box : NodeBox} + {address : Address} {arity : Nat} {captured arguments : Array RVal} + {definition : Function} {resume : Frame} {stack : List Continuation} + (boxAt : store.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (retained : RetainSharedMany store captured retainedStore) + (released : releaseSharedWork heapFuel retainedStore [.loc location] = + .ok (releasedStore, outHeapFuel)) + (totalEnough : arity ≤ (captured ++ arguments).size) + (declaration : context.declarations address = some (.fn definition)) + (papSafe : definition.signature.papSafe = true) + (suppliedArity : + ((captured ++ arguments).extract 0 arity).size = + definition.signature.params.size) + (nonempty : definition.blocks.isEmpty = false) : + let total := captured ++ arguments + let supplied := total.extract 0 arity + let remaining := total.extract arity total.size + let callee : Frame := { definition, values := supplied } + let continuation : Continuation := + if remaining.isEmpty then .resume resume + else .applyMore remaining resume + ApplyTransfer context interpretation store heapFuel (.loc location) + arguments resume stack + { store := releasedStore + heapFuel := outHeapFuel + control := .running callee (continuation :: stack) } := by + dsimp only + unfold RetainSharedMany at retained + unfold ApplyTransfer beginApply + simp only + rw [boxAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [shared] + rw [if_neg (by decide)] + rw [node] + simp only + rw [if_neg (by omega)] + rw [retained] + simp only + rw [released] + simp only + rw [if_neg (Nat.not_lt.mpr totalEnough)] + rw [declaration] + simp only + simp only [declarationPapSafe, papSafe, Bool.not_true, Bool.false_eq_true, + ↓reduceIte] + have arityGuard : ¬ + ((((captured ++ arguments).extract 0 arity).size != + definition.signature.params.size) = true) := by + intro unequal + exact (bne_iff_ne.mp unequal) suppliedArity + have blockGuard : ¬ (definition.blocks.isEmpty = true) := by + simp [nonempty] + unfold enterFunction + rw [if_neg arityGuard, if_neg blockGuard] + +/-- A PAP may also target a scalar extern declaration. Successful extern +application is necessarily exactly saturated because a scalar result cannot +be fed through `applyMore`; it resumes the suspended frame immediately. -/ +theorem ApplyTransfer.papExtern {context : Context} + {interpretation : Interpretation} {store retainedStore releasedStore : Store} + {heapFuel outHeapFuel : Nat} {location : Nat} {box : NodeBox} + {address : Address} {arity expectedArity : Nat} + {captured arguments : Array RVal} {value : RVal} + {resume : Frame} {stack : List Continuation} + (boxAt : store.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (retained : RetainSharedMany store captured retainedStore) + (released : releaseSharedWork heapFuel retainedStore [.loc location] = + .ok (releasedStore, outHeapFuel)) + (totalEnough : arity ≤ (captured ++ arguments).size) + (declaration : context.declarations address = + some (.extern expectedArity)) + (suppliedArity : + ((captured ++ arguments).extract 0 arity).size = expectedArity) + (remainingEmpty : + ((captured ++ arguments).extract arity + (captured ++ arguments).size).isEmpty = true) + (called : ScalarOracleCall context address + ((captured ++ arguments).extract 0 arity) value) : + ApplyTransfer context interpretation store heapFuel (.loc location) + arguments resume stack + { store := releasedStore + heapFuel := outHeapFuel + control := .running + { resume with values := resume.values.push value } stack } := by + unfold RetainSharedMany at retained + unfold ApplyTransfer beginApply resumeImmediate Frame.pushValue + simp only + rw [boxAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [shared] + rw [if_neg (by decide)] + rw [node] + simp only + rw [if_neg (by omega)] + rw [retained] + simp only + rw [released] + simp only + rw [if_neg (Nat.not_lt.mpr totalEnough)] + rw [declaration] + simp only [declarationPapSafe, Bool.not_true, Bool.false_eq_true, + ↓reduceIte] + have arityGuard : ¬ + ((((captured ++ arguments).extract 0 arity).size != expectedArity) = + true) := by + intro unequal + exact (bne_iff_ne.mp unequal) suppliedArity + rw [if_neg arityGuard] + rw [remainingEmpty] + simp only [Bool.not_true, Bool.false_eq_true, ↓reduceIte] + unfold ScalarOracleCall at called + rw [called] + +/-- Exhaustive successful shapes of the dynamic-application worker. This +indexed relation records the runtime evidence hidden by `beginApply` while +fixing its exact output machine, so clients can eliminate an arbitrary +`ApplyTransfer` without unfolding the private dispatcher. -/ +inductive ApplyTransferCase (context : Context) + (interpretation : Interpretation) (store : Store) (heapFuel : Nat) + (arguments : Array RVal) (resume : Frame) (stack : List Continuation) : + RVal → Machine → Prop where + | erased {outStore : Store} {outHeapFuel : Nat} + (released : releaseSharedWork heapFuel store arguments.toList = + .ok (outStore, outHeapFuel)) : + ApplyTransferCase context interpretation store heapFuel arguments + resume stack .erased + { store := outStore + heapFuel := outHeapFuel + control := .running + { resume with values := resume.values.push .erased } stack } + | papUnder {location : Nat} {box : NodeBox} {address : Address} + {arity : Nat} {captured : Array RVal} + {retainedStore releasedStore : Store} {outHeapFuel : Nat} + (boxAt : store.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (retained : RetainSharedMany store captured retainedStore) + (released : releaseSharedWork heapFuel retainedStore [.loc location] = + .ok (releasedStore, outHeapFuel)) + (totalUnder : (captured ++ arguments).size < arity) : + ApplyTransferCase context interpretation store heapFuel arguments + resume stack (.loc location) + (let allocation := releasedStore.allocNode .shared + (.papN address arity (captured ++ arguments)) + { store := allocation.1 + heapFuel := outHeapFuel + control := .running + { resume with + values := resume.values.push (.loc allocation.2) } stack }) + | papFn {location : Nat} {box : NodeBox} {address : Address} + {arity : Nat} {captured : Array RVal} + {retainedStore releasedStore : Store} {outHeapFuel : Nat} + {definition : Function} + (boxAt : store.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (retained : RetainSharedMany store captured retainedStore) + (released : releaseSharedWork heapFuel retainedStore [.loc location] = + .ok (releasedStore, outHeapFuel)) + (totalEnough : arity ≤ (captured ++ arguments).size) + (declaration : context.declarations address = some (.fn definition)) + (papSafe : definition.signature.papSafe = true) + (suppliedArity : + ((captured ++ arguments).extract 0 arity).size = + definition.signature.params.size) + (nonempty : definition.blocks.isEmpty = false) : + ApplyTransferCase context interpretation store heapFuel arguments + resume stack (.loc location) + (let total := captured ++ arguments + let supplied := total.extract 0 arity + let remaining := total.extract arity total.size + let callee : Frame := { definition, values := supplied } + let continuation : Continuation := + if remaining.isEmpty then .resume resume + else .applyMore remaining resume + { store := releasedStore + heapFuel := outHeapFuel + control := .running callee (continuation :: stack) }) + | papExtern {location : Nat} {box : NodeBox} {address : Address} + {arity expectedArity : Nat} {captured : Array RVal} + {retainedStore releasedStore : Store} {outHeapFuel : Nat} + {value : RVal} + (boxAt : store.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (retained : RetainSharedMany store captured retainedStore) + (released : releaseSharedWork heapFuel retainedStore [.loc location] = + .ok (releasedStore, outHeapFuel)) + (totalEnough : arity ≤ (captured ++ arguments).size) + (declaration : context.declarations address = + some (.extern expectedArity)) + (suppliedArity : + ((captured ++ arguments).extract 0 arity).size = expectedArity) + (remainingEmpty : + ((captured ++ arguments).extract arity + (captured ++ arguments).size).isEmpty = true) + (called : ScalarOracleCall context address + ((captured ++ arguments).extract 0 arity) value) : + ApplyTransferCase context interpretation store heapFuel arguments + resume stack (.loc location) + { store := releasedStore + heapFuel := outHeapFuel + control := .running + { resume with values := resume.values.push value } stack } + +/-- Every explicit successful application shape reconstructs the public +transfer equation. -/ +theorem ApplyTransferCase.transfer {context : Context} + {interpretation : Interpretation} {store : Store} {heapFuel : Nat} + {function : RVal} {arguments : Array RVal} {resume : Frame} + {stack : List Continuation} {target : Machine} + (classified : ApplyTransferCase context interpretation store heapFuel + arguments resume stack function target) : + ApplyTransfer context interpretation store heapFuel function arguments + resume stack target := by + cases classified with + | erased released => exact ApplyTransfer.erased released + | papUnder boxAt shared node capturedUnder retained released totalUnder => + exact ApplyTransfer.papUnder boxAt shared node capturedUnder retained + released totalUnder + | papFn boxAt shared node capturedUnder retained released totalEnough + declaration papSafe suppliedArity nonempty => + exact ApplyTransfer.papFn boxAt shared node capturedUnder retained + released totalEnough declaration papSafe suppliedArity nonempty + | papExtern boxAt shared node capturedUnder retained released totalEnough + declaration suppliedArity remainingEmpty called => + exact ApplyTransfer.papExtern boxAt shared node capturedUnder retained + released totalEnough declaration suppliedArity remainingEmpty called + +/-- Invert an arbitrary successful dynamic dispatch into exactly one of the +four public runtime shapes. -/ +theorem ApplyTransfer.classify {context : Context} + {interpretation : Interpretation} {store : Store} {heapFuel : Nat} + {function : RVal} {arguments : Array RVal} {resume : Frame} + {stack : List Continuation} {target : Machine} + (transferred : ApplyTransfer context interpretation store heapFuel + function arguments resume stack target) : + ApplyTransferCase context interpretation store heapFuel arguments + resume stack function target := by + unfold ApplyTransfer beginApply at transferred + simp only [bind, Except.bind, pure, Except.pure] at transferred + cases function with + | lit literal => + simp at transferred + | erased => + cases released : releaseSharedWork heapFuel store arguments.toList with + | error error => + simp [released] at transferred + | ok output => + obtain ⟨outStore, outHeapFuel⟩ := output + simp [released, resumeImmediate, Frame.pushValue] at transferred + subst target + exact .erased released + | loc location => + cases boxAt : store.get? location with + | none => + simp [boxAt] at transferred + | some box => + cases box with + | mk world rc node => + cases world with + | unique => + simp [boxAt] at transferred + | shared => + cases node with + | ctorN cid fields => + simp [boxAt] at transferred + | papN address arity captured => + have sharedEq : + (Owned.shared != Owned.shared) = false := by decide + simp only [boxAt, sharedEq, Bool.false_eq_true, if_false] + at transferred + by_cases capturedUnder : captured.size < arity + · have capturedNotEnough : ¬arity ≤ captured.size := + Nat.not_le_of_gt capturedUnder + simp only [capturedNotEnough, ↓reduceIte] + at transferred + cases retainedRun : retainSharedMany store captured with + | error error => + simp only [retainedRun] at transferred + cases transferred + | ok retainedStore => + simp only [retainedRun] at transferred + cases releasedRun : releaseSharedWork heapFuel + retainedStore [.loc location] with + | error error => + simp only [releasedRun] at transferred + cases transferred + | ok output => + simp only [releasedRun] at transferred + obtain ⟨releasedStore, outHeapFuel⟩ := output + by_cases totalUnder : + (captured ++ arguments).size < arity + · simp only [if_pos totalUnder] at transferred + injection transferred with targetEq + subst target + exact .papUnder boxAt rfl rfl capturedUnder + retainedRun releasedRun totalUnder + · have totalEnough : + arity ≤ (captured ++ arguments).size := + Nat.le_of_not_gt totalUnder + simp only [if_neg totalUnder] at transferred + cases declarationAt : + context.declarations address with + | none => + simp only [declarationAt] at transferred + cases transferred + | some declaration => + simp only [declarationAt] at transferred + cases declaration with + | fn definition => + cases papSafe : + definition.signature.papSafe with + | false => + simp only [declarationPapSafe, + papSafe, Bool.not_false, + if_true] + at transferred + cases transferred + | true => + simp only [declarationPapSafe, + papSafe, Bool.not_true, + Bool.false_eq_true, if_false] + at transferred + by_cases suppliedArity : + ((captured ++ arguments).extract + 0 arity).size = + definition.signature.params.size + · have arityMatch : + (((captured ++ arguments).extract + 0 arity).size != + definition.signature.params.size) = + false := by + exact Bool.eq_false_iff.mpr + (fun mismatch => + (bne_iff_ne.mp mismatch) + suppliedArity) + cases blockEmpty : + definition.blocks.isEmpty with + | true => + simp only [enterFunction, + arityMatch, + Bool.false_eq_true, + if_false, blockEmpty, + if_true] + at transferred + cases transferred + | false => + simp only [enterFunction, + arityMatch, + Bool.false_eq_true, + if_false, blockEmpty] + at transferred + injection transferred with + targetEq + subst target + exact .papFn boxAt rfl rfl + capturedUnder retainedRun + releasedRun totalEnough + declarationAt papSafe + suppliedArity blockEmpty + · have arityMismatch : + (((captured ++ arguments).extract + 0 arity).size != + definition.signature.params.size) = + true := by + exact bne_iff_ne.mpr + suppliedArity + simp only [enterFunction, + arityMismatch, if_true] + at transferred + cases transferred + | extern expectedArity => + simp only [declarationPapSafe, + Bool.not_true, + Bool.false_eq_true, ↓reduceIte] + at transferred + by_cases suppliedArity : + ((captured ++ arguments).extract + 0 arity).size = expectedArity + · have arityMatch : + (((captured ++ arguments).extract + 0 arity).size != + expectedArity) = false := by + exact Bool.eq_false_iff.mpr + (fun mismatch => + (bne_iff_ne.mp mismatch) + suppliedArity) + simp only [arityMatch, + Bool.false_eq_true, if_false] + at transferred + cases remainingEmpty : + ((captured ++ arguments).extract + arity + (captured ++ arguments).size).isEmpty + with + | false => + simp only [remainingEmpty, + Bool.not_false, if_true] + at transferred + cases transferred + | true => + simp only [remainingEmpty, + Bool.not_true, + Bool.false_eq_true, if_false] + at transferred + cases called : callScalarOracle + context address + ((captured ++ arguments).extract + 0 arity) with + | error error => + simp only [called] + at transferred + cases transferred + | ok value => + simp only [called] + at transferred + injection transferred with + targetEq + subst target + exact .papExtern boxAt rfl rfl + capturedUnder retainedRun + releasedRun totalEnough + declarationAt suppliedArity + remainingEmpty called + · have arityMismatch : + (((captured ++ arguments).extract + 0 arity).size != + expectedArity) = true := by + exact bne_iff_ne.mpr + suppliedArity + simp only [arityMismatch, if_true] + at transferred + cases transferred + · have capturedEnough : arity ≤ captured.size := + Nat.le_of_not_gt capturedUnder + simp only [capturedEnough, ↓reduceIte] at transferred + cases transferred + +/-- General checked edge transfer from public value-resolution and linear +credit premises. This is the proof seam used by optional-credit branches. -/ +theorem EdgeTransfer.of_parts {frame after : Frame} {edge : Edge} + {implicitValues values : Array RVal} {credits : Array Credit} + {block : Block} + (resolved : resolveAtoms frame.values edge.values = .ok values) + (taken : CreditTakeMany frame edge.credits after credits) + (cleared : NoLiveCredits after) + (blockAt : after.definition.blocks[edge.target]? = some block) + (valueArity : (implicitValues ++ values).size = block.valueParams.size) + (creditArity : credits.size = block.creditParams.size) : + EdgeTransfer frame edge implicitValues + { after with + block := edge.target + pc := 0 + values := implicitValues ++ values + credits := credits.map some } := by + unfold EdgeTransfer transferEdge + rw [resolved] + simp only [bind, Except.bind] + unfold CreditTakeMany at taken + rw [taken] + simp only + have noLive : after.hasCredits = false := by + unfold Frame.hasCredits + exact cleared + rw [noLive] + simp only [Bool.false_eq_true, ↓reduceIte] + rw [blockAt] + simp [pure, Except.pure, valueArity, creditArity] + +/-- Invert a successful edge transfer into its value resolution, linear +credit consumption, target lookup, ABI checks, and exact successor frame. -/ +theorem EdgeTransfer.parts {frame target : Frame} {edge : Edge} + {implicitValues : Array RVal} + (transferred : EdgeTransfer frame edge implicitValues target) : + ∃ values credits after block, + resolveAtoms frame.values edge.values = .ok values ∧ + CreditTakeMany frame edge.credits after credits ∧ + NoLiveCredits after ∧ + after.definition.blocks[edge.target]? = some block ∧ + (implicitValues ++ values).size = block.valueParams.size ∧ + credits.size = block.creditParams.size ∧ + target = { after with + block := edge.target + pc := 0 + values := implicitValues ++ values + credits := credits.map some } := by + unfold EdgeTransfer transferEdge at transferred + cases resolved : resolveAtoms frame.values edge.values with + | error error => + rw [resolved] at transferred + contradiction + | ok values => + rw [resolved] at transferred + simp only [bind, Except.bind] at transferred + cases taken : takeCredits frame edge.credits with + | error error => + rw [taken] at transferred + contradiction + | ok output => + obtain ⟨after, credits⟩ := output + rw [taken] at transferred + simp only at transferred + cases live : after.hasCredits with + | true => + rw [live] at transferred + simp at transferred + | false => + rw [live] at transferred + simp only [Bool.false_eq_true, ↓reduceIte] at transferred + cases blockAt : after.definition.blocks[edge.target]? with + | none => + rw [blockAt] at transferred + contradiction + | some block => + rw [blockAt] at transferred + simp only [pure, Except.pure] at transferred + cases valueMismatch : + ((implicitValues ++ values).size != + block.valueParams.size) with + | true => + rw [valueMismatch] at transferred + simp at transferred + | false => + rw [valueMismatch] at transferred + simp only [Bool.false_eq_true, ↓reduceIte] at transferred + cases creditMismatch : + (credits.size != block.creditParams.size) with + | true => + rw [creditMismatch] at transferred + simp at transferred + | false => + rw [creditMismatch] at transferred + simp only [Bool.false_eq_true, ↓reduceIte] at transferred + have valueArity : (implicitValues ++ values).size = + block.valueParams.size := by + simpa using valueMismatch + have creditArity : credits.size = + block.creditParams.size := by + simpa using creditMismatch + have targetEq := Except.ok.inj transferred + refine ⟨values, credits, after, block, rfl, ?_, ?_, + ?_, valueArity, creditArity, targetEq.symm⟩ + · exact taken + · unfold NoLiveCredits + exact live + · exact blockAt + +/-- Baseline lowering carries no credits. Resolving its explicit edge values, +finding the target block, and matching the two target arities therefore +determines the exact successor frame. -/ +theorem EdgeTransfer.baseline {frame : Frame} {edge : Edge} + {implicitValues values : Array RVal} {block : Block} + (resolved : resolveAtoms frame.values edge.values = .ok values) + (frameCredits : frame.credits = #[]) + (edgeCredits : edge.credits = #[]) + (blockAt : frame.definition.blocks[edge.target]? = some block) + (valueArity : (implicitValues ++ values).size = block.valueParams.size) + (blockCredits : block.creditParams = #[]) : + EdgeTransfer frame edge implicitValues + { frame with + block := edge.target + pc := 0 + values := implicitValues ++ values + credits := #[] } := by + have noLive : frame.hasCredits = false := by + simp [Frame.hasCredits, frameCredits] + have taken : takeCredits frame edge.credits = .ok (frame, #[]) := by + rw [edgeCredits] + rfl + unfold EdgeTransfer transferEdge + rw [resolved] + simp only [bind, Except.bind] + rw [taken] + simp only + rw [noLive] + simp only [Bool.false_eq_true, ↓reduceIte] + rw [blockAt] + simp [pure, Except.pure, valueArity, blockCredits] + +/-- A successful edge transfer is insensitive to replacing the enclosing +function definition when the selected target block keeps the same incoming +value and credit ABI. The resulting frame changes only its definition. -/ +theorem EdgeTransfer.congrDefinition {frame target : Frame} {edge : Edge} + {implicitValues : Array RVal} {definition : Function} + {sourceBlock rewrittenBlock : Block} + (sourceAt : frame.definition.blocks[edge.target]? = some sourceBlock) + (rewrittenAt : definition.blocks[edge.target]? = some rewrittenBlock) + (valueParams : rewrittenBlock.valueParams = sourceBlock.valueParams) + (creditParams : rewrittenBlock.creditParams = sourceBlock.creditParams) + (transferred : EdgeTransfer frame edge implicitValues target) : + EdgeTransfer { frame with definition } edge implicitValues + { target with definition } := by + unfold EdgeTransfer transferEdge at transferred ⊢ + cases resolved : resolveAtoms frame.values edge.values with + | error error => + rw [resolved] at transferred + contradiction + | ok values => + rw [resolved] at transferred + simp only [bind, Except.bind] at transferred ⊢ + cases taken : takeCredits frame edge.credits with + | error error => + rw [taken] at transferred + contradiction + | ok output => + obtain ⟨after, credits⟩ := output + rw [taken] at transferred + simp only at transferred + have afterDefinition : after.definition = frame.definition := + CreditTakeMany.definition taken + have rewrittenTaken := + takeCredits_changeDefinition frame edge.credits definition + rw [taken] at rewrittenTaken + simp only [Except.map] at rewrittenTaken + rw [rewrittenTaken] + simp only + have rewrittenLive : + ({ after with definition }).hasCredits = after.hasCredits := rfl + cases live : after.hasCredits with + | true => + rw [live] at transferred + simp only [↓reduceIte] at transferred + simp at transferred + | false => + rw [live] at transferred + simp only [Bool.false_eq_true, ↓reduceIte] at transferred + rw [rewrittenLive, live] + simp only [Bool.false_eq_true, ↓reduceIte] + rw [afterDefinition, sourceAt] at transferred + simp only [pure, Except.pure] at transferred + rw [rewrittenAt] + simp only [pure, Except.pure] + cases valueArity : + ((implicitValues ++ values).size != + sourceBlock.valueParams.size) with + | true => + rw [valueArity] at transferred + simp only [↓reduceIte] at transferred + simp at transferred + | false => + rw [valueArity] at transferred + simp only [Bool.false_eq_true, ↓reduceIte] at transferred + rw [valueParams, valueArity] + simp only [Bool.false_eq_true, ↓reduceIte] + cases creditArity : + (credits.size != sourceBlock.creditParams.size) with + | true => + rw [creditArity] at transferred + simp only [↓reduceIte] at transferred + simp at transferred + | false => + rw [creditArity] at transferred + simp only [Bool.false_eq_true, ↓reduceIte] at transferred + rw [creditParams, creditArity] + simp only [Bool.false_eq_true, ↓reduceIte] + cases transferred + rfl + +/-- Every successful transfer selected a concrete block at its edge target. -/ +theorem EdgeTransfer.targetBlock {frame target : Frame} {edge : Edge} + {implicitValues : Array RVal} + (transferred : EdgeTransfer frame edge implicitValues target) : + ∃ block, frame.definition.blocks[edge.target]? = some block := by + unfold EdgeTransfer transferEdge at transferred + cases resolved : resolveAtoms frame.values edge.values with + | error error => + rw [resolved] at transferred + contradiction + | ok values => + rw [resolved] at transferred + simp only [bind, Except.bind] at transferred + cases taken : takeCredits frame edge.credits with + | error error => + rw [taken] at transferred + contradiction + | ok output => + obtain ⟨after, credits⟩ := output + rw [taken] at transferred + simp only at transferred + have afterDefinition : after.definition = frame.definition := + CreditTakeMany.definition taken + cases live : after.hasCredits with + | true => + rw [live] at transferred + simp at transferred + | false => + rw [live] at transferred + simp only [Bool.false_eq_true, ↓reduceIte] at transferred + cases found : after.definition.blocks[edge.target]? with + | none => + rw [found] at transferred + contradiction + | some block => + exact ⟨block, by simpa [afterDefinition] using found⟩ + +/-- An edge transfer retains its enclosing function definition. -/ +theorem EdgeTransfer.definition {frame target : Frame} {edge : Edge} + {implicitValues : Array RVal} + (transferred : EdgeTransfer frame edge implicitValues target) : + target.definition = frame.definition := by + obtain ⟨block, blockAt⟩ := transferred.targetBlock + have changed := transferred.congrDefinition + (definition := frame.definition) blockAt blockAt rfl rfl + have inputEq : { frame with definition := frame.definition } = frame := by + cases frame + rfl + rw [inputEq] at changed + unfold EdgeTransfer at transferred changed + have targetEq : target = { target with definition := frame.definition } := + Except.ok.inj (transferred.symm.trans changed) + have definitions := congrArg Frame.definition targetEq + simpa using definitions + +/-- Reduction rule for the present arm of an optional-credit branch. The +credit is transferred by the selected edge, rather than consumed by the +terminator itself. -/ +theorem Step.branchCreditPresent {context : Context} + {interpretation : Interpretation} {machine : Machine} + {frame target : Frame} {stack : List Continuation} {block : Block} + {creditId : CreditId} {credit : Credit} {someEdge noneEdge : Edge} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminator : block.terminator = + .branchCredit creditId someEdge noneEdge) + (lookedUp : CreditLookup frame creditId credit) + (present : credit.isPresent = true) + (transferred : EdgeTransfer frame someEdge #[] target) : + Step context interpretation machine + { machine with control := .running target stack } := by + unfold Step step currentBlock runTerminator + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + have pcBeq : (frame.pc == block.instructions.size) = true := + beq_iff_eq.mpr pc + rw [dif_neg (by omega), if_pos pcBeq, terminator] + simp only + unfold CreditLookup at lookedUp + rw [lookedUp] + simp only + rw [present] + unfold EdgeTransfer at transferred + simp [transferred] + +/-- Reduction rule for the absent arm of an optional-credit branch. -/ +theorem Step.branchCreditAbsent {context : Context} + {interpretation : Interpretation} {machine : Machine} + {frame target : Frame} {stack : List Continuation} {block : Block} + {creditId : CreditId} {credit : Credit} {someEdge noneEdge : Edge} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminator : block.terminator = + .branchCredit creditId someEdge noneEdge) + (lookedUp : CreditLookup frame creditId credit) + (absent : credit.isPresent = false) + (transferred : EdgeTransfer frame noneEdge #[] target) : + Step context interpretation machine + { machine with control := .running target stack } := by + unfold Step step currentBlock runTerminator + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + have pcBeq : (frame.pc == block.instructions.size) = true := + beq_iff_eq.mpr pc + rw [dif_neg (by omega), if_pos pcBeq, terminator] + simp only + unfold CreditLookup at lookedUp + rw [lookedUp] + simp only + rw [absent] + unfold EdgeTransfer at transferred + simp [transferred] + +/-- Reduction rule for an ordinary block jump. -/ +theorem Step.jump {context : Context} {interpretation : Interpretation} + {machine : Machine} {frame target : Frame} + {stack : List Continuation} {block : Block} {edge : Edge} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminator : block.terminator = .jump edge) + (transferred : EdgeTransfer frame edge #[] target) : + Step context interpretation machine + { machine with control := .running target stack } := by + unfold Step step currentBlock runTerminator + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + have pcBeq : (frame.pc == block.instructions.size) = true := + beq_iff_eq.mpr pc + rw [dif_neg (by omega), if_pos pcBeq, terminator] + unfold EdgeTransfer at transferred + simp [transferred] + +/-- Reduction rule for constructor dispatch through an exact alternative. -/ +theorem Step.switchCtor {context : Context} + {interpretation : Interpretation} {machine : Machine} + {frame target : Frame} {stack : List Continuation} {block : Block} + {scrutinee : Atom} {constructors : Array CtorAlt} + {natPeel : Option NatPeel} {location : Nat} {box : NodeBox} + {cid : CtorId} {fields : Array RVal} {alternative : CtorAlt} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminator : block.terminator = + .switchValue scrutinee constructors natPeel) + (resolved : resolveAtom frame.values scrutinee = .ok (.loc location)) + (boxAt : machine.store.get? location = some box) + (node : box.node = .ctorN cid fields) + (alternativeAt : constructors.find? (fun candidate => + candidate.cid == cid) = some alternative) + (transferred : EdgeTransfer frame alternative.edge #[] target) : + Step context interpretation machine + { machine with control := .running target stack } := by + unfold Step step currentBlock runTerminator + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + have pcBeq : (frame.pc == block.instructions.size) = true := + beq_iff_eq.mpr pc + rw [dif_neg (by omega), if_pos pcBeq, terminator] + simp only + rw [resolved] + simp only + rw [boxAt] + simp only + rw [node] + simp only + rw [alternativeAt] + unfold EdgeTransfer at transferred + simp [transferred] + +/-- Reduction rule for the zero branch of a literal-Nat switch. -/ +theorem Step.switchNatZero {context : Context} + {interpretation : Interpretation} {machine : Machine} + {frame target : Frame} {stack : List Continuation} {block : Block} + {scrutinee : Atom} {constructors : Array CtorAlt} {peel : NatPeel} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminator : block.terminator = + .switchValue scrutinee constructors (some peel)) + (resolved : resolveAtom frame.values scrutinee = .ok (.lit (.nat 0))) + (transferred : EdgeTransfer frame peel.zero #[] target) : + Step context interpretation machine + { machine with control := .running target stack } := by + unfold Step step currentBlock runTerminator + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + have pcBeq : (frame.pc == block.instructions.size) = true := + beq_iff_eq.mpr pc + rw [dif_neg (by omega), if_pos pcBeq, terminator] + simp only + rw [resolved] + unfold EdgeTransfer at transferred + simp [transferred] + +/-- Reduction rule for the successor branch of a literal-Nat switch. The +predecessor is the branch's one implicit leading value. -/ +theorem Step.switchNatSucc {context : Context} + {interpretation : Interpretation} {machine : Machine} + {frame target : Frame} {stack : List Continuation} {block : Block} + {scrutinee : Atom} {constructors : Array CtorAlt} {peel : NatPeel} + {predecessor : Nat} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminator : block.terminator = + .switchValue scrutinee constructors (some peel)) + (resolved : resolveAtom frame.values scrutinee = + .ok (.lit (.nat (predecessor + 1)))) + (transferred : EdgeTransfer frame peel.succ + #[.lit (.nat predecessor)] target) : + Step context interpretation machine + { machine with control := .running target stack } := by + unfold Step step currentBlock runTerminator + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + have pcBeq : (frame.pc == block.instructions.size) = true := + beq_iff_eq.mpr pc + rw [dif_neg (by omega), if_pos pcBeq, terminator] + simp only + rw [resolved] + unfold EdgeTransfer at transferred + simp [transferred] + +/-- Reduction rule for returning a value to an ordinary suspended caller. -/ +theorem Step.retResume {context : Context} {interpretation : Interpretation} + {machine : Machine} {frame caller : Frame} + {rest : List Continuation} {block : Block} + {atom : Atom} {value : RVal} + (control : machine.control = + .running frame (.resume caller :: rest)) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminator : block.terminator = .ret atom) + (resolved : resolveAtom frame.values atom = .ok value) + (noCredits : frame.credits = #[]) + (world : value.hasWorld machine.store + frame.definition.signature.result = true) : + Step context interpretation machine + { machine with + control := .running + { caller with values := caller.values.push value } rest } := by + unfold Step step currentBlock runTerminator finishReturn + Frame.pushValue + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + have pcBeq : (frame.pc == block.instructions.size) = true := + beq_iff_eq.mpr pc + rw [dif_neg (by omega), if_pos pcBeq, terminator] + simp [resolved, Frame.hasCredits, noCredits, world] + +/-- Reduction rule for a direct tail call to a compiler function. -/ +theorem Step.tailCallFn {context : Context} + {interpretation : Interpretation} {machine : Machine} + {frame : Frame} {stack : List Continuation} {block : Block} + {address : Address} {arguments : Array Atom} {values : Array RVal} + {definition : Function} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminator : block.terminator = .tailCall address arguments) + (noCredits : frame.credits = #[]) + (resolved : resolveAtoms frame.values arguments = .ok values) + (declaration : context.declarations address = some (.fn definition)) + (arity : values.size = definition.signature.params.size) + (nonempty : definition.blocks.isEmpty = false) : + Step context interpretation machine + { machine with + control := .running { definition, values } stack } := by + unfold Step step currentBlock runTerminator ensureCallBoundary + Frame.hasCredits enterFunction + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + have pcBeq : (frame.pc == block.instructions.size) = true := + beq_iff_eq.mpr pc + rw [dif_neg (by omega), if_pos pcBeq, terminator] + simp [noCredits, resolved, declaration, arity, nonempty] + +/-- Reduction rule for a tail-recursive self call. -/ +theorem Step.tailCallSelf {context : Context} + {interpretation : Interpretation} {machine : Machine} + {frame : Frame} {stack : List Continuation} {block : Block} + {arguments : Array Atom} {values : Array RVal} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminator : block.terminator = .tailCallSelf arguments) + (noCredits : frame.credits = #[]) + (resolved : resolveAtoms frame.values arguments = .ok values) + (arity : values.size = frame.definition.signature.params.size) + (nonempty : frame.definition.blocks.isEmpty = false) : + Step context interpretation machine + { machine with + control := .running { definition := frame.definition, values } + stack } := by + unfold Step step currentBlock runTerminator ensureCallBoundary + Frame.hasCredits enterFunction + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + have pcBeq : (frame.pc == block.instructions.size) = true := + beq_iff_eq.mpr pc + rw [dif_neg (by omega), if_pos pcBeq, terminator] + simp [noCredits, resolved, arity, nonempty] + +/-- Tail-recursive self call after all credit slots have been consumed. In +contrast to the baseline-specialized `tailCallSelf` rule above, this rule +accepts a nonempty credit file containing only `none`; `allocWith` produces +exactly that state after consuming a rewrite credit. -/ +theorem Step.tailCallSelfCleared {context : Context} + {interpretation : Interpretation} {machine : Machine} + {frame : Frame} {stack : List Continuation} {block : Block} + {arguments : Array Atom} {values : Array RVal} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminator : block.terminator = .tailCallSelf arguments) + (noCredits : NoLiveCredits frame) + (resolved : resolveAtoms frame.values arguments = .ok values) + (arity : values.size = frame.definition.signature.params.size) + (nonempty : frame.definition.blocks.isEmpty = false) : + Step context interpretation machine + { machine with + control := .running { definition := frame.definition, values } + stack } := by + unfold Step step currentBlock runTerminator ensureCallBoundary + Frame.hasCredits enterFunction + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + have pcBeq : (frame.pc == block.instructions.size) = true := + beq_iff_eq.mpr pc + rw [dif_neg (by omega), if_pos pcBeq, terminator] + unfold NoLiveCredits at noCredits + simp [noCredits, resolved, arity, nonempty] + +/-- Reduction rule for returning from the outermost frame. -/ +theorem Step.retHalt {context : Context} {interpretation : Interpretation} + {machine : Machine} {frame : Frame} {block : Block} + {atom : Atom} {value : RVal} + (control : machine.control = .running frame []) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminator : block.terminator = .ret atom) + (resolved : resolveAtom frame.values atom = .ok value) + (noCredits : frame.credits = #[]) + (world : value.hasWorld machine.store + frame.definition.signature.result = true) : + Step context interpretation machine + { machine with control := .halted value } := by + unfold Step step currentBlock runTerminator finishReturn + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + have pcBeq : (frame.pc == block.instructions.size) = true := + beq_iff_eq.mpr pc + rw [dif_neg (by omega), if_pos pcBeq, terminator] + simp [resolved, Frame.hasCredits, noCredits, world] + +/-- Reduction rule for the public small-step relation at a `move` +instruction. Simulation proofs can use this rule without depending on the +evaluator's private instruction dispatcher. -/ +theorem Step.move {context : Context} {interpretation : Interpretation} + {machine : Machine} {frame : Frame} {stack : List Continuation} + {block : Block} {atom : Atom} {value : RVal} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = .move atom) + (resolved : resolveAtom frame.values atom = .ok value) : + Step context interpretation machine + { machine with + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values.push value } + stack } := by + unfold Step step currentBlock runInstruction Frame.advance Frame.pushValue + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + simp only + rw [resolved] + +/-- Reduction rule for a checked ordinary allocation. -/ +theorem Step.alloc {context : Context} {interpretation : Interpretation} + {machine : Machine} {frame : Frame} {stack : List Continuation} + {block : Block} {world : Owned} {cid : CtorId} + {arguments : Array Atom} {schema : CtorSchema} + {values : Array RVal} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = + .alloc world cid arguments) + (schemaAt : context.schemas world cid = some schema) + (resolved : resolveAtoms frame.values arguments = .ok values) + (fields : FieldWorlds machine.store schema values) : + let allocation := machine.store.allocNode world (.ctorN cid values) + Step context interpretation machine + { machine with + store := allocation.1 + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values.push (.loc allocation.2) } + stack } := by + unfold Step step currentBlock runInstruction Frame.advance Frame.pushValue + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + simp only + unfold lookupSchema + rw [schemaAt] + simp only + rw [resolved] + simp only + unfold FieldWorlds at fields + rw [fields] + +/-- An absent credit is consumed and allocation falls back to a fresh slot in +either interpretation. -/ +theorem Step.allocWithAbsent {context : Context} + {interpretation : Interpretation} {machine : Machine} + {frame next : Frame} {stack : List Continuation} {block : Block} + {creditId : CreditId} {credit : Credit} {world : Owned} {cid : CtorId} + {arguments : Array Atom} {schema : CtorSchema} {values : Array RVal} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = + .allocWith creditId world cid arguments) + (schemaAt : context.schemas world cid = some schema) + (resolved : resolveAtoms frame.values arguments = .ok values) + (fields : FieldWorlds machine.store schema values) + (taken : CreditTake { frame with pc := frame.pc + 1 } + creditId next credit) + (layout : credit.layout = schema.layout) + (absent : credit.presence = .absent) : + let allocation := machine.store.allocNode world (.ctorN cid values) + Step context interpretation machine + { machine with + store := allocation.1 + control := .running + { next with values := next.values.push (.loc allocation.2) } + stack } := by + dsimp only + unfold Step step currentBlock runInstruction Frame.advance + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + simp only + unfold lookupSchema + rw [schemaAt] + simp only + rw [resolved] + simp only + unfold FieldWorlds at fields + rw [fields] + simp only + unfold CreditTake at taken + rw [taken] + simp [layout, absent, Frame.pushValue] + +/-- A present logical credit records the reset opportunity but still allocates +a fresh semantic node. -/ +theorem Step.allocWithLogical {context : Context} {machine : Machine} + {frame next : Frame} {stack : List Continuation} {block : Block} + {creditId : CreditId} {credit : Credit} {world : Owned} {cid : CtorId} + {arguments : Array Atom} {schema : CtorSchema} {values : Array RVal} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = + .allocWith creditId world cid arguments) + (schemaAt : context.schemas world cid = some schema) + (resolved : resolveAtoms frame.values arguments = .ok values) + (fields : FieldWorlds machine.store schema values) + (taken : CreditTake { frame with pc := frame.pc + 1 } + creditId next credit) + (layout : credit.layout = schema.layout) + (present : credit.presence = .present none) : + let allocation := machine.store.allocNode world (.ctorN cid values) + Step context .logical machine + { machine with + store := allocation.1 + control := .running + { next with values := next.values.push (.loc allocation.2) } + stack } := by + dsimp only + unfold Step step currentBlock runInstruction Frame.advance + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + simp only + unfold lookupSchema + rw [schemaAt] + simp only + rw [resolved] + simp only + unfold FieldWorlds at fields + rw [fields] + simp only + unfold CreditTake at taken + rw [taken] + simp [layout, present, Frame.pushValue] + +/-- A present physical credit reuses its reserved slot after an exact layout +check. -/ +theorem Step.allocWithPhysical {context : Context} {machine : Machine} + {frame next : Frame} {stack : List Continuation} {block : Block} + {creditId : CreditId} {credit : Credit} {world : Owned} {cid : CtorId} + {arguments : Array Atom} {schema : CtorSchema} {values : Array RVal} + {location : Nat} {store : Store} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = + .allocWith creditId world cid arguments) + (schemaAt : context.schemas world cid = some schema) + (resolved : resolveAtoms frame.values arguments = .ok values) + (fields : FieldWorlds machine.store schema values) + (taken : CreditTake { frame with pc := frame.pc + 1 } + creditId next credit) + (layout : credit.layout = schema.layout) + (present : credit.presence = .present (some location)) + (reused : machine.store.reuseReservation location world + (.ctorN cid values) schema.fields.size = .ok store) : + Step context .physical machine + { machine with + store + control := .running + { next with values := next.values.push (.loc location) } + stack } := by + unfold Step step currentBlock runInstruction Frame.advance + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + simp only + unfold lookupSchema + rw [schemaAt] + simp only + rw [resolved] + simp only + unfold FieldWorlds at fields + rw [fields] + simp only + unfold CreditTake at taken + rw [taken] + simp only + rw [layout] + have sameLayout : (schema.layout != schema.layout) = false := by + simp + rw [sameLayout] + simp only [Bool.false_eq_true, ↓reduceIte] + rw [present] + simp only + rw [reused] + rfl + +/-- Discarding an absent credit changes neither the heap nor the advanced +frame beyond consuming the credit slot. -/ +theorem Step.discardCreditAbsent {context : Context} + {interpretation : Interpretation} {machine : Machine} + {frame next : Frame} {stack : List Continuation} {block : Block} + {creditId : CreditId} {credit : Credit} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = .discardCredit creditId) + (taken : CreditTake { frame with pc := frame.pc + 1 } + creditId next credit) + (absent : credit.presence = .absent) : + Step context interpretation machine + { machine with control := .running next stack } := by + unfold Step step currentBlock runInstruction Frame.advance + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + simp only + unfold CreditTake at taken + rw [taken] + simp [absent] + +/-- Discarding a present logical credit needs no physical heap action. -/ +theorem Step.discardCreditLogical {context : Context} {machine : Machine} + {frame next : Frame} {stack : List Continuation} {block : Block} + {creditId : CreditId} {credit : Credit} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = .discardCredit creditId) + (taken : CreditTake { frame with pc := frame.pc + 1 } + creditId next credit) + (present : credit.presence = .present none) : + Step context .logical machine + { machine with control := .running next stack } := by + unfold Step step currentBlock runInstruction Frame.advance + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + simp only + unfold CreditTake at taken + rw [taken] + simp [present] + +/-- Discarding a present physical credit releases its reserved slot. -/ +theorem Step.discardCreditPhysical {context : Context} {machine : Machine} + {frame next : Frame} {stack : List Continuation} {block : Block} + {creditId : CreditId} {credit : Credit} {location : Nat} {store : Store} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = .discardCredit creditId) + (taken : CreditTake { frame with pc := frame.pc + 1 } + creditId next credit) + (present : credit.presence = .present (some location)) + (released : machine.store.releaseReservation location = .ok store) : + Step context .physical machine + { machine with store, control := .running next stack } := by + unfold Step step currentBlock runInstruction Frame.advance + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + simp only + unfold CreditTake at taken + rw [taken] + simp only + rw [present] + simp only + rw [released] + +/-- Logical unique extraction kills the constructor and yields its fields plus +a reservation-free required credit. -/ +theorem Step.takeUniqueLogical {context : Context} {machine : Machine} + {frame : Frame} {stack : List Continuation} {block : Block} + {target : Atom} {cid : CtorId} {schema : CtorSchema} {location : Nat} + {box : NodeBox} {fields : Array RVal} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = .takeUnique target cid) + (schemaAt : context.schemas .unique cid = some schema) + (resolved : resolveAtom frame.values target = .ok (.loc location)) + (viewed : ConstructorView machine.store location .unique cid box fields) + (unitRC : box.rc = 1) : + Step context .logical machine + { machine with + store := machine.store.kill location + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values ++ fields + credits := frame.credits.push (some + { layout := schema.layout, presence := .present none }) } + stack } := by + unfold Step step currentBlock runInstruction + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + simp only + unfold lookupSchema + rw [schemaAt] + simp only + rw [resolved] + simp only + unfold ConstructorView at viewed + rw [viewed] + simp [unitRC, Credit.presentFor, Frame.advance, Frame.pushValues, + Frame.pushCredit] + +/-- Physical unique extraction reserves the constructor slot and records its +location in the required credit. -/ +theorem Step.takeUniquePhysical {context : Context} {machine : Machine} + {frame : Frame} {stack : List Continuation} {block : Block} + {target : Atom} {cid : CtorId} {schema : CtorSchema} {location : Nat} + {box : NodeBox} {fields : Array RVal} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = .takeUnique target cid) + (schemaAt : context.schemas .unique cid = some schema) + (resolved : resolveAtom frame.values target = .ok (.loc location)) + (viewed : ConstructorView machine.store location .unique cid box fields) + (unitRC : box.rc = 1) : + Step context .physical machine + { machine with + store := machine.store.reserve location + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values ++ fields + credits := frame.credits.push (some + { layout := schema.layout, + presence := .present (some location) }) } + stack } := by + unfold Step step currentBlock runInstruction + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + simp only + unfold lookupSchema + rw [schemaAt] + simp only + rw [resolved] + simp only + unfold ConstructorView at viewed + rw [viewed] + simp [unitRC, Credit.presentFor, Frame.advance, Frame.pushValues, + Frame.pushCredit] + +/-- A unit-refcount logical shared reset takes the hot path, kills the source +node, and exposes a reservation-free present credit. -/ +theorem Step.resetSharedLogicalHot {context : Context} {machine : Machine} + {frame : Frame} {stack : List Continuation} {block : Block} + {target : Atom} {cid : CtorId} {schema : CtorSchema} {location : Nat} + {box : NodeBox} {fields : Array RVal} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = .resetShared target cid) + (schemaAt : context.schemas .shared cid = some schema) + (resolved : resolveAtom frame.values target = .ok (.loc location)) + (viewed : ConstructorView machine.store location .shared cid box fields) + (unitRC : box.rc = 1) : + Step context .logical machine + { machine with + store := ((machine.store.tickResetAttempt).kill location).tickHotReset + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values ++ fields + credits := frame.credits.push (some + { layout := schema.layout, presence := .present none }) } + stack } := by + unfold Step step currentBlock runInstruction + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + simp only + unfold lookupSchema + rw [schemaAt] + simp only + rw [resolved] + simp only + unfold ConstructorView at viewed + rw [viewed] + simp [unitRC, Credit.presentFor, Frame.advance, Frame.pushValues, + Frame.pushCredit] + +/-- A unit-refcount physical shared reset reserves the source slot and exposes +its location in a present credit. -/ +theorem Step.resetSharedPhysicalHot {context : Context} {machine : Machine} + {frame : Frame} {stack : List Continuation} {block : Block} + {target : Atom} {cid : CtorId} {schema : CtorSchema} {location : Nat} + {box : NodeBox} {fields : Array RVal} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = .resetShared target cid) + (schemaAt : context.schemas .shared cid = some schema) + (resolved : resolveAtom frame.values target = .ok (.loc location)) + (viewed : ConstructorView machine.store location .shared cid box fields) + (unitRC : box.rc = 1) : + Step context .physical machine + { machine with + store := + ((machine.store.tickResetAttempt).reserve location).tickHotReset + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values ++ fields + credits := frame.credits.push (some + { layout := schema.layout, + presence := .present (some location) }) } + stack } := by + unfold Step step currentBlock runInstruction + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + simp only + unfold lookupSchema + rw [schemaAt] + simp only + rw [resolved] + simp only + unfold ConstructorView at viewed + rw [viewed] + simp [unitRC, Credit.presentFor, Frame.advance, Frame.pushValues, + Frame.pushCredit] + +/-- A multiply referenced shared reset takes the common cold path in either +interpretation: decrement the parent, retain its projected fields, and emit +an absent optional credit. -/ +theorem Step.resetSharedCold {context : Context} + {interpretation : Interpretation} {machine : Machine} + {frame : Frame} {stack : List Continuation} {block : Block} + {target : Atom} {cid : CtorId} {schema : CtorSchema} {location : Nat} + {box : NodeBox} {fields : Array RVal} {store : Store} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = .resetShared target cid) + (schemaAt : context.schemas .shared cid = some schema) + (resolved : resolveAtom frame.values target = .ok (.loc location)) + (viewed : ConstructorView machine.store location .shared cid box fields) + (shared : 1 < box.rc) + (retained : RetainSharedMany + ((((machine.store.tickResetAttempt).setBox location + { box with rc := box.rc - 1 }).rcTick).tickColdReset) + fields store) : + Step context interpretation machine + { machine with + store + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values ++ fields + credits := frame.credits.push (some + { layout := schema.layout, presence := .absent }) } + stack } := by + unfold Step step currentBlock runInstruction + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + simp only + unfold lookupSchema + rw [schemaAt] + simp only + rw [resolved] + simp only + unfold ConstructorView at viewed + rw [viewed] + simp only + have nonzero : (box.rc == 0) = false := by + apply beq_eq_false_iff_ne.mpr + omega + have nonunit : (box.rc == 1) = false := by + apply beq_eq_false_iff_ne.mpr + omega + rw [nonzero, nonunit] + simp only [Bool.false_eq_true, ↓reduceIte] + unfold RetainSharedMany at retained + rw [retained] + rfl + +/-- Reduction rule for a successful shared retain. -/ +theorem Step.retainShared {context : Context} + {interpretation : Interpretation} {machine : Machine} + {frame : Frame} {stack : List Continuation} {block : Block} + {atom : Atom} {value : RVal} {store : Store} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = .retainShared atom) + (resolved : resolveAtom frame.values atom = .ok value) + (retained : retainShared machine.store value = .ok store) : + Step context interpretation machine + { machine with + store + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values.push value } + stack } := by + unfold Step step currentBlock runInstruction Frame.advance Frame.pushValue + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + simp only + rw [resolved] + simp only + rw [retained] + +/-- Reduction rule for a successful deep shared release. -/ +theorem Step.releaseShared {context : Context} + {interpretation : Interpretation} {machine : Machine} + {frame : Frame} {stack : List Continuation} {block : Block} + {atom : Atom} {value : RVal} {store : Store} {heapFuel : Nat} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = .releaseShared atom) + (resolved : resolveAtom frame.values atom = .ok value) + (released : releaseShared machine.heapFuel machine.store value = + .ok (store, heapFuel)) : + Step context interpretation machine + { store, heapFuel, + control := .running { frame with pc := frame.pc + 1 } stack } := by + unfold Step step currentBlock runInstruction Frame.advance + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + simp only + rw [resolved] + simp only + rw [released] + +/-- Reduction rule for a successful deep unique drop. -/ +theorem Step.dropUnique {context : Context} + {interpretation : Interpretation} {machine : Machine} + {frame : Frame} {stack : List Continuation} {block : Block} + {atom : Atom} {value : RVal} {store : Store} {heapFuel : Nat} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = .dropUnique atom) + (resolved : resolveAtom frame.values atom = .ok value) + (dropped : dropUnique machine.heapFuel machine.store value = + .ok (store, heapFuel)) : + Step context interpretation machine + { store, heapFuel, + control := .running { frame with pc := frame.pc + 1 } stack } := by + unfold Step step currentBlock runInstruction Frame.advance + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + simp only + rw [resolved] + simp only + rw [dropped] + +/-- Reduction rule for a checked all-scalar unique constructor free. -/ +theorem Step.freeUnique {context : Context} + {interpretation : Interpretation} {machine : Machine} + {frame : Frame} {stack : List Continuation} {block : Block} + {atom : Atom} {cid : CtorId} {location : Nat} + {box : NodeBox} {fields : Array RVal} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = .freeUnique atom cid) + (resolved : resolveAtom frame.values atom = .ok (.loc location)) + (boxAt : machine.store.get? location = some box) + (unique : box.world = .unique) + (node : box.node = .ctorN cid fields) + (scalarFields : fields.all RVal.isScalar = true) : + Step context interpretation machine + { machine with + store := machine.store.kill location + control := .running { frame with pc := frame.pc + 1 } stack } := by + unfold Step step currentBlock runInstruction Frame.advance requireCtor + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + simp only + rw [resolved] + simp only + rw [boxAt] + simp [unique, node, scalarFields] + +/-- Reduction rule for a successful checked constructor projection. -/ +theorem Step.fetch {context : Context} {interpretation : Interpretation} + {machine : Machine} {frame : Frame} {stack : List Continuation} + {block : Block} {atom : Atom} {cid : CtorId} {field location : Nat} + {box : NodeBox} {fields : Array RVal} {value : RVal} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = .fetch atom cid field) + (resolved : resolveAtom frame.values atom = .ok (.loc location)) + (boxAt : machine.store.get? location = some box) + (node : box.node = .ctorN cid fields) + (fieldAt : fields[field]? = some value) : + Step context interpretation machine + { machine with + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values.push value } + stack } := by + unfold Step step currentBlock runInstruction Frame.advance Frame.pushValue + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + simp only + rw [resolved] + simp only + rw [boxAt] + simp only + rw [node] + simp [fieldAt] + +/-- Reduction rule for entering a directly addressed compiler function and +suspending the advanced caller frame. -/ +theorem Step.callFn {context : Context} {interpretation : Interpretation} + {machine : Machine} {frame : Frame} + {stack : List Continuation} {block : Block} + {address : Address} {arguments : Array Atom} {values : Array RVal} + {definition : Function} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = .call address arguments) + (noCredits : frame.credits = #[]) + (resolved : resolveAtoms frame.values arguments = .ok values) + (declaration : context.declarations address = some (.fn definition)) + (arity : values.size = definition.signature.params.size) + (nonempty : definition.blocks.isEmpty = false) : + Step context interpretation machine + { machine with + control := .running { definition, values } + (.resume { frame with pc := frame.pc + 1 } :: stack) } := by + unfold Step step currentBlock runInstruction ensureCallBoundary + Frame.hasCredits Frame.advance enterFunction + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + simp [noCredits, resolved, declaration, arity, nonempty] + +/-- Reduction rule for entering the current function recursively and +suspending the advanced caller frame. -/ +theorem Step.callSelf {context : Context} {interpretation : Interpretation} + {machine : Machine} {frame : Frame} + {stack : List Continuation} {block : Block} + {arguments : Array Atom} {values : Array RVal} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = .callSelf arguments) + (noCredits : frame.credits = #[]) + (resolved : resolveAtoms frame.values arguments = .ok values) + (arity : values.size = frame.definition.signature.params.size) + (nonempty : frame.definition.blocks.isEmpty = false) : + Step context interpretation machine + { machine with + control := .running { definition := frame.definition, values } + (.resume { frame with pc := frame.pc + 1 } :: stack) } := by + unfold Step step currentBlock runInstruction ensureCallBoundary + Frame.hasCredits Frame.advance enterFunction + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + simp [noCredits, resolved, arity, nonempty] + +/-- Reduction rule for allocating a strictly under-saturated PAP whose target +is a compiler function. Baseline lowering carries no credits, so its call +boundary is discharged by the empty credit file. -/ +theorem Step.pappFn {context : Context} {interpretation : Interpretation} + {machine : Machine} {frame : Frame} {stack : List Continuation} + {block : Block} {address : Address} {arguments : Array Atom} + {values : Array RVal} {definition : Function} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = .papp address arguments) + (noCredits : frame.credits = #[]) + (declaration : context.declarations address = some (.fn definition)) + (papSafe : definition.signature.papSafe = true) + (resolved : resolveAtoms frame.values arguments = .ok values) + (under : values.size < definition.signature.params.size) : + let allocation := machine.store.allocNode .shared + (.papN address definition.signature.params.size values) + Step context interpretation machine + { machine with + store := allocation.1 + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values.push (.loc allocation.2) } + stack } := by + dsimp only + unfold Step step currentBlock runInstruction Frame.advance Frame.pushValue + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + simp [ensureCallBoundary, Frame.hasCredits, noCredits, resolved, + declaration, declarationArity, declarationPapSafe, papSafe, + Nat.not_le.mpr under] + rfl + +/-- Reduction rule for a scalar external call. -/ +theorem Step.extern {context : Context} {interpretation : Interpretation} + {machine : Machine} {frame : Frame} {stack : List Continuation} + {block : Block} {address : Address} {arguments : Array Atom} + {values : Array RVal} {arity : Nat} {value : RVal} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = .extern address arguments) + (noCredits : frame.credits = #[]) + (resolved : resolveAtoms frame.values arguments = .ok values) + (declaration : context.declarations address = some (.extern arity)) + (argumentArity : values.size = arity) + (called : ScalarOracleCall context address values value) : + Step context interpretation machine + { machine with + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values.push value } + stack } := by + unfold Step step currentBlock runInstruction ensureCallBoundary + Frame.hasCredits Frame.advance Frame.pushValue + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + simp [noCredits, resolved, declaration, argumentArity] + unfold ScalarOracleCall at called + rw [called] + +/-- Reduction rule for dynamic application. Operand resolution and the +advanced caller coordinate are discharged here; the shared `ApplyTransfer` +relation describes whether dispatch resumes immediately, enters a PAP target, +or installs an `applyMore` continuation. -/ +theorem Step.apply {context : Context} {interpretation : Interpretation} + {machine target : Machine} {frame : Frame} + {stack : List Continuation} {block : Block} + {functionAtom : Atom} {argumentAtoms : Array Atom} + {function : RVal} {arguments : Array RVal} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = + .apply functionAtom argumentAtoms) + (noCredits : frame.credits = #[]) + (functionResolved : resolveAtom frame.values functionAtom = .ok function) + (argumentsResolved : + resolveAtoms frame.values argumentAtoms = .ok arguments) + (transferred : ApplyTransfer context interpretation machine.store + machine.heapFuel function arguments { frame with pc := frame.pc + 1 } + stack target) : + Step context interpretation machine target := by + unfold Step step currentBlock runInstruction ensureCallBoundary + Frame.hasCredits Frame.advance + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + simp [noCredits, functionResolved, argumentsResolved] + simpa [ApplyTransfer, noCredits] using transferred + +/-- Returning through an over-application continuation dispatches the +callee's value through the same `ApplyTransfer` relation used by the original +`apply` instruction. -/ +theorem Step.retApplyMore {context : Context} + {interpretation : Interpretation} {machine target : Machine} + {frame caller : Frame} {arguments : Array RVal} + {rest : List Continuation} {block : Block} + {atom : Atom} {value : RVal} + (control : machine.control = + .running frame (.applyMore arguments caller :: rest)) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminator : block.terminator = .ret atom) + (resolved : resolveAtom frame.values atom = .ok value) + (noCredits : frame.credits = #[]) + (world : value.hasWorld machine.store + frame.definition.signature.result = true) + (transferred : ApplyTransfer context interpretation machine.store + machine.heapFuel value arguments caller rest target) : + Step context interpretation machine target := by + unfold Step step currentBlock runTerminator finishReturn + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + have pcBeq : (frame.pc == block.instructions.size) = true := + beq_iff_eq.mpr pc + rw [dif_neg (by omega), if_pos pcBeq, terminator] + simp [resolved, Frame.hasCredits, noCredits, world] + exact transferred + +/-! ## Exhaustive call-boundary rules + +The baseline-facing rules above use an empty credit array because lowered +source frames never allocate credit registers. Generated helper frames and +the raw evaluator can instead reach a call boundary with a nonempty array +whose every slot has been consumed. The following rules expose that full +successful evaluator domain through `NoLiveCredits`. -/ + +/-- Return to an ordinary continuation after every credit slot has been +consumed, including a nonempty file of `none` entries. -/ +theorem Step.retResumeCleared {context : Context} + {interpretation : Interpretation} {machine : Machine} + {frame caller : Frame} {rest : List Continuation} {block : Block} + {atom : Atom} {value : RVal} + (control : machine.control = + .running frame (.resume caller :: rest)) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminator : block.terminator = .ret atom) + (resolved : resolveAtom frame.values atom = .ok value) + (noCredits : NoLiveCredits frame) + (world : value.hasWorld machine.store + frame.definition.signature.result = true) : + Step context interpretation machine + { machine with + control := .running + { caller with values := caller.values.push value } rest } := by + unfold Step step currentBlock runTerminator finishReturn Frame.pushValue + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + have pcBeq : (frame.pc == block.instructions.size) = true := + beq_iff_eq.mpr pc + rw [dif_neg (by omega), if_pos pcBeq, terminator] + unfold NoLiveCredits at noCredits + simp [resolved, Frame.hasCredits, noCredits, world] + +/-- Return from the outermost frame after every credit slot has been +consumed. -/ +theorem Step.retHaltCleared {context : Context} + {interpretation : Interpretation} {machine : Machine} + {frame : Frame} {block : Block} {atom : Atom} {value : RVal} + (control : machine.control = .running frame []) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminator : block.terminator = .ret atom) + (resolved : resolveAtom frame.values atom = .ok value) + (noCredits : NoLiveCredits frame) + (world : value.hasWorld machine.store + frame.definition.signature.result = true) : + Step context interpretation machine + { machine with control := .halted value } := by + unfold Step step currentBlock runTerminator finishReturn + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + have pcBeq : (frame.pc == block.instructions.size) = true := + beq_iff_eq.mpr pc + rw [dif_neg (by omega), if_pos pcBeq, terminator] + unfold NoLiveCredits at noCredits + simp [resolved, Frame.hasCredits, noCredits, world] + +/-- Return through an over-application continuation after every credit slot +has been consumed. -/ +theorem Step.retApplyMoreCleared {context : Context} + {interpretation : Interpretation} {machine target : Machine} + {frame caller : Frame} {arguments : Array RVal} + {rest : List Continuation} {block : Block} + {atom : Atom} {value : RVal} + (control : machine.control = + .running frame (.applyMore arguments caller :: rest)) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminator : block.terminator = .ret atom) + (resolved : resolveAtom frame.values atom = .ok value) + (noCredits : NoLiveCredits frame) + (world : value.hasWorld machine.store + frame.definition.signature.result = true) + (transferred : ApplyTransfer context interpretation machine.store + machine.heapFuel value arguments caller rest target) : + Step context interpretation machine target := by + unfold Step step currentBlock runTerminator finishReturn + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + have pcBeq : (frame.pc == block.instructions.size) = true := + beq_iff_eq.mpr pc + rw [dif_neg (by omega), if_pos pcBeq, terminator] + unfold NoLiveCredits at noCredits + simp [resolved, Frame.hasCredits, noCredits, world] + exact transferred + +/-- Direct tail-call entry with an arbitrary fully consumed credit file. -/ +theorem Step.tailCallFnCleared {context : Context} + {interpretation : Interpretation} {machine : Machine} + {frame : Frame} {stack : List Continuation} {block : Block} + {address : Address} {arguments : Array Atom} {values : Array RVal} + {definition : Function} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminator : block.terminator = .tailCall address arguments) + (noCredits : NoLiveCredits frame) + (resolved : resolveAtoms frame.values arguments = .ok values) + (declaration : context.declarations address = some (.fn definition)) + (arity : values.size = definition.signature.params.size) + (nonempty : definition.blocks.isEmpty = false) : + Step context interpretation machine + { machine with + control := .running { definition, values } stack } := by + unfold Step step currentBlock runTerminator ensureCallBoundary + Frame.hasCredits enterFunction + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + have pcBeq : (frame.pc == block.instructions.size) = true := + beq_iff_eq.mpr pc + rw [dif_neg (by omega), if_pos pcBeq, terminator] + unfold NoLiveCredits at noCredits + simp [noCredits, resolved, declaration, arity, nonempty] + +/-- Direct call entry with an arbitrary fully consumed credit file. -/ +theorem Step.callFnCleared {context : Context} + {interpretation : Interpretation} {machine : Machine} + {frame : Frame} {stack : List Continuation} {block : Block} + {address : Address} {arguments : Array Atom} {values : Array RVal} + {definition : Function} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = .call address arguments) + (noCredits : NoLiveCredits frame) + (resolved : resolveAtoms frame.values arguments = .ok values) + (declaration : context.declarations address = some (.fn definition)) + (arity : values.size = definition.signature.params.size) + (nonempty : definition.blocks.isEmpty = false) : + Step context interpretation machine + { machine with + control := .running { definition, values } + (.resume { frame with pc := frame.pc + 1 } :: stack) } := by + unfold Step step currentBlock runInstruction ensureCallBoundary + Frame.hasCredits Frame.advance enterFunction + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + unfold NoLiveCredits at noCredits + simp [noCredits, resolved, declaration, arity, nonempty] + +/-- Recursive call entry with an arbitrary fully consumed credit file. -/ +theorem Step.callSelfCleared {context : Context} + {interpretation : Interpretation} {machine : Machine} + {frame : Frame} {stack : List Continuation} {block : Block} + {arguments : Array Atom} {values : Array RVal} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = .callSelf arguments) + (noCredits : NoLiveCredits frame) + (resolved : resolveAtoms frame.values arguments = .ok values) + (arity : values.size = frame.definition.signature.params.size) + (nonempty : frame.definition.blocks.isEmpty = false) : + Step context interpretation machine + { machine with + control := .running { definition := frame.definition, values } + (.resume { frame with pc := frame.pc + 1 } :: stack) } := by + unfold Step step currentBlock runInstruction ensureCallBoundary + Frame.hasCredits Frame.advance enterFunction + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + unfold NoLiveCredits at noCredits + simp [noCredits, resolved, arity, nonempty] + +/-- Function-targeted PAP construction with an arbitrary fully consumed +credit file. -/ +theorem Step.pappFnCleared {context : Context} + {interpretation : Interpretation} {machine : Machine} + {frame : Frame} {stack : List Continuation} {block : Block} + {address : Address} {arguments : Array Atom} {values : Array RVal} + {definition : Function} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = .papp address arguments) + (noCredits : NoLiveCredits frame) + (declaration : context.declarations address = some (.fn definition)) + (papSafe : definition.signature.papSafe = true) + (resolved : resolveAtoms frame.values arguments = .ok values) + (under : values.size < definition.signature.params.size) : + let allocation := machine.store.allocNode .shared + (.papN address definition.signature.params.size values) + Step context interpretation machine + { machine with + store := allocation.1 + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values.push (.loc allocation.2) } + stack } := by + dsimp only + unfold Step step currentBlock runInstruction Frame.advance Frame.pushValue + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + unfold NoLiveCredits at noCredits + simp [ensureCallBoundary, Frame.hasCredits, noCredits, resolved, + declaration, declarationArity, declarationPapSafe, papSafe, + Nat.not_le.mpr under] + rfl + +/-- Extern-targeted PAP construction is a genuine successful evaluator +shape when the captured vector is strictly under-saturated. -/ +theorem Step.pappExternCleared {context : Context} + {interpretation : Interpretation} {machine : Machine} + {frame : Frame} {stack : List Continuation} {block : Block} + {address : Address} {arguments : Array Atom} {values : Array RVal} + {arity : Nat} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = .papp address arguments) + (noCredits : NoLiveCredits frame) + (declaration : context.declarations address = some (.extern arity)) + (resolved : resolveAtoms frame.values arguments = .ok values) + (under : values.size < arity) : + let allocation := machine.store.allocNode .shared + (.papN address arity values) + Step context interpretation machine + { machine with + store := allocation.1 + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values.push (.loc allocation.2) } + stack } := by + dsimp only + unfold Step step currentBlock runInstruction Frame.advance Frame.pushValue + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + unfold NoLiveCredits at noCredits + simp [ensureCallBoundary, Frame.hasCredits, noCredits, resolved, + declaration, declarationArity, declarationPapSafe, + Nat.not_le.mpr under] + rfl + +/-- Scalar extern invocation with an arbitrary fully consumed credit file. -/ +theorem Step.externCleared {context : Context} + {interpretation : Interpretation} {machine : Machine} + {frame : Frame} {stack : List Continuation} {block : Block} + {address : Address} {arguments : Array Atom} + {values : Array RVal} {arity : Nat} {value : RVal} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = .extern address arguments) + (noCredits : NoLiveCredits frame) + (resolved : resolveAtoms frame.values arguments = .ok values) + (declaration : context.declarations address = some (.extern arity)) + (argumentArity : values.size = arity) + (called : ScalarOracleCall context address values value) : + Step context interpretation machine + { machine with + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values.push value } + stack } := by + unfold Step step currentBlock runInstruction ensureCallBoundary + Frame.hasCredits Frame.advance Frame.pushValue + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + unfold NoLiveCredits at noCredits + simp [noCredits, resolved, declaration, argumentArity] + unfold ScalarOracleCall at called + rw [called] + +/-- Dynamic application with an arbitrary fully consumed credit file. -/ +theorem Step.applyCleared {context : Context} + {interpretation : Interpretation} {machine target : Machine} + {frame : Frame} {stack : List Continuation} {block : Block} + {functionAtom : Atom} {argumentAtoms : Array Atom} + {function : RVal} {arguments : Array RVal} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = + .apply functionAtom argumentAtoms) + (noCredits : NoLiveCredits frame) + (functionResolved : resolveAtom frame.values functionAtom = .ok function) + (argumentsResolved : + resolveAtoms frame.values argumentAtoms = .ok arguments) + (transferred : ApplyTransfer context interpretation machine.store + machine.heapFuel function arguments { frame with pc := frame.pc + 1 } + stack target) : + Step context interpretation machine target := by + unfold Step step currentBlock runInstruction ensureCallBoundary + Frame.hasCredits Frame.advance + rw [control] + simp only + rw [blockAt] + simp only [bind, Except.bind, pure, Except.pure] + rw [dif_pos pc, instruction] + unfold NoLiveCredits at noCredits + simp [noCredits, functionResolved, argumentsResolved] + simpa [ApplyTransfer, noCredits] using transferred + +/-! ## Exhaustive successful-step classification -/ + +/-- Public equation for the private instruction worker at a canonical running +machine. -/ +def InstructionTransfer (context : Context) + (interpretation : Interpretation) (store : Store) (heapFuel : Nat) + (frame : Frame) (stack : List Continuation) (instruction : Instr) + (target : Machine) : Prop := + runInstruction context interpretation + { store, heapFuel, control := .running frame stack } + frame stack instruction = .ok target + +/-- Every successful runtime shape of one IxIR₂ instruction. The relation is +indexed by the instruction and exact output machine, so eliminating it exposes +all dynamic evidence needed by simulation clients. -/ +inductive InstructionTransferCase (context : Context) + (interpretation : Interpretation) (store : Store) (heapFuel : Nat) + (frame : Frame) (stack : List Continuation) : Instr → Machine → Prop where + | move {atom : Atom} {value : RVal} + (resolved : resolveAtom frame.values atom = .ok value) : + InstructionTransferCase context interpretation store heapFuel frame stack + (.move atom) + { store, heapFuel + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values.push value } + stack } + | alloc {world : Owned} {cid : CtorId} {arguments : Array Atom} + {schema : CtorSchema} {values : Array RVal} + (schemaAt : context.schemas world cid = some schema) + (resolved : resolveAtoms frame.values arguments = .ok values) + (fields : FieldWorlds store schema values) : + InstructionTransferCase context interpretation store heapFuel frame stack + (.alloc world cid arguments) + (let allocation := store.allocNode world (.ctorN cid values) + { store := allocation.1, heapFuel + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values.push (.loc allocation.2) } + stack }) + | allocWithAbsent {creditId : CreditId} {credit : Credit} + {world : Owned} {cid : CtorId} {arguments : Array Atom} + {schema : CtorSchema} {values : Array RVal} {next : Frame} + (schemaAt : context.schemas world cid = some schema) + (resolved : resolveAtoms frame.values arguments = .ok values) + (fields : FieldWorlds store schema values) + (taken : CreditTake { frame with pc := frame.pc + 1 } + creditId next credit) + (layout : credit.layout = schema.layout) + (absent : credit.presence = .absent) : + InstructionTransferCase context interpretation store heapFuel frame stack + (.allocWith creditId world cid arguments) + (let allocation := store.allocNode world (.ctorN cid values) + { store := allocation.1, heapFuel + control := .running + { next with values := next.values.push (.loc allocation.2) } + stack }) + | allocWithLogical {creditId : CreditId} {credit : Credit} + {world : Owned} {cid : CtorId} {arguments : Array Atom} + {schema : CtorSchema} {values : Array RVal} {next : Frame} + (mode : interpretation = .logical) + (schemaAt : context.schemas world cid = some schema) + (resolved : resolveAtoms frame.values arguments = .ok values) + (fields : FieldWorlds store schema values) + (taken : CreditTake { frame with pc := frame.pc + 1 } + creditId next credit) + (layout : credit.layout = schema.layout) + (present : credit.presence = .present none) : + InstructionTransferCase context interpretation store heapFuel frame stack + (.allocWith creditId world cid arguments) + (let allocation := store.allocNode world (.ctorN cid values) + { store := allocation.1, heapFuel + control := .running + { next with values := next.values.push (.loc allocation.2) } + stack }) + | allocWithPhysical {creditId : CreditId} {credit : Credit} + {world : Owned} {cid : CtorId} {arguments : Array Atom} + {schema : CtorSchema} {values : Array RVal} {next : Frame} + {location : Nat} {outStore : Store} + (mode : interpretation = .physical) + (schemaAt : context.schemas world cid = some schema) + (resolved : resolveAtoms frame.values arguments = .ok values) + (fields : FieldWorlds store schema values) + (taken : CreditTake { frame with pc := frame.pc + 1 } + creditId next credit) + (layout : credit.layout = schema.layout) + (present : credit.presence = .present (some location)) + (reused : store.reuseReservation location world (.ctorN cid values) + schema.fields.size = .ok outStore) : + InstructionTransferCase context interpretation store heapFuel frame stack + (.allocWith creditId world cid arguments) + { store := outStore, heapFuel + control := .running + { next with values := next.values.push (.loc location) } stack } + | discardAbsent {creditId : CreditId} {credit : Credit} {next : Frame} + (taken : CreditTake { frame with pc := frame.pc + 1 } + creditId next credit) + (absent : credit.presence = .absent) : + InstructionTransferCase context interpretation store heapFuel frame stack + (.discardCredit creditId) + { store, heapFuel, control := .running next stack } + | discardLogical {creditId : CreditId} {credit : Credit} {next : Frame} + (mode : interpretation = .logical) + (taken : CreditTake { frame with pc := frame.pc + 1 } + creditId next credit) + (present : credit.presence = .present none) : + InstructionTransferCase context interpretation store heapFuel frame stack + (.discardCredit creditId) + { store, heapFuel, control := .running next stack } + | discardPhysical {creditId : CreditId} {credit : Credit} {next : Frame} + {location : Nat} {outStore : Store} + (mode : interpretation = .physical) + (taken : CreditTake { frame with pc := frame.pc + 1 } + creditId next credit) + (present : credit.presence = .present (some location)) + (released : store.releaseReservation location = .ok outStore) : + InstructionTransferCase context interpretation store heapFuel frame stack + (.discardCredit creditId) + { store := outStore, heapFuel, control := .running next stack } + | takeUniqueLogical {target : Atom} {cid : CtorId} + {schema : CtorSchema} {location : Nat} {box : NodeBox} + {fields : Array RVal} + (mode : interpretation = .logical) + (schemaAt : context.schemas .unique cid = some schema) + (resolved : resolveAtom frame.values target = .ok (.loc location)) + (viewed : ConstructorView store location .unique cid box fields) + (unitRC : box.rc = 1) : + InstructionTransferCase context interpretation store heapFuel frame stack + (.takeUnique target cid) + { store := store.kill location, heapFuel + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values ++ fields + credits := frame.credits.push (some + { layout := schema.layout, presence := .present none }) } + stack } + | takeUniquePhysical {target : Atom} {cid : CtorId} + {schema : CtorSchema} {location : Nat} {box : NodeBox} + {fields : Array RVal} + (mode : interpretation = .physical) + (schemaAt : context.schemas .unique cid = some schema) + (resolved : resolveAtom frame.values target = .ok (.loc location)) + (viewed : ConstructorView store location .unique cid box fields) + (unitRC : box.rc = 1) : + InstructionTransferCase context interpretation store heapFuel frame stack + (.takeUnique target cid) + { store := store.reserve location, heapFuel + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values ++ fields + credits := frame.credits.push (some + { layout := schema.layout, + presence := .present (some location) }) } + stack } + | resetSharedLogicalHot {target : Atom} {cid : CtorId} + {schema : CtorSchema} {location : Nat} {box : NodeBox} + {fields : Array RVal} + (mode : interpretation = .logical) + (schemaAt : context.schemas .shared cid = some schema) + (resolved : resolveAtom frame.values target = .ok (.loc location)) + (viewed : ConstructorView store location .shared cid box fields) + (unitRC : box.rc = 1) : + InstructionTransferCase context interpretation store heapFuel frame stack + (.resetShared target cid) + { store := ((store.tickResetAttempt).kill location).tickHotReset + heapFuel + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values ++ fields + credits := frame.credits.push (some + { layout := schema.layout, presence := .present none }) } + stack } + | resetSharedPhysicalHot {target : Atom} {cid : CtorId} + {schema : CtorSchema} {location : Nat} {box : NodeBox} + {fields : Array RVal} + (mode : interpretation = .physical) + (schemaAt : context.schemas .shared cid = some schema) + (resolved : resolveAtom frame.values target = .ok (.loc location)) + (viewed : ConstructorView store location .shared cid box fields) + (unitRC : box.rc = 1) : + InstructionTransferCase context interpretation store heapFuel frame stack + (.resetShared target cid) + { store := ((store.tickResetAttempt).reserve location).tickHotReset + heapFuel + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values ++ fields + credits := frame.credits.push (some + { layout := schema.layout, + presence := .present (some location) }) } + stack } + | resetSharedCold {target : Atom} {cid : CtorId} + {schema : CtorSchema} {location : Nat} {box : NodeBox} + {fields : Array RVal} {outStore : Store} + (schemaAt : context.schemas .shared cid = some schema) + (resolved : resolveAtom frame.values target = .ok (.loc location)) + (viewed : ConstructorView store location .shared cid box fields) + (shared : 1 < box.rc) + (retained : RetainSharedMany + ((((store.tickResetAttempt).setBox location + { box with rc := box.rc - 1 }).rcTick).tickColdReset) + fields outStore) : + InstructionTransferCase context interpretation store heapFuel frame stack + (.resetShared target cid) + { store := outStore, heapFuel + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values ++ fields + credits := frame.credits.push (some + { layout := schema.layout, presence := .absent }) } + stack } + | retainShared {target : Atom} {value : RVal} {outStore : Store} + (resolved : resolveAtom frame.values target = .ok value) + (retained : Eval.retainShared store value = .ok outStore) : + InstructionTransferCase context interpretation store heapFuel frame stack + (.retainShared target) + { store := outStore, heapFuel + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values.push value } + stack } + | releaseShared {target : Atom} {value : RVal} {outStore : Store} + {outHeapFuel : Nat} + (resolved : resolveAtom frame.values target = .ok value) + (released : Eval.releaseShared heapFuel store value = + .ok (outStore, outHeapFuel)) : + InstructionTransferCase context interpretation store heapFuel frame stack + (.releaseShared target) + { store := outStore, heapFuel := outHeapFuel + control := .running { frame with pc := frame.pc + 1 } stack } + | dropUnique {target : Atom} {value : RVal} {outStore : Store} + {outHeapFuel : Nat} + (resolved : resolveAtom frame.values target = .ok value) + (dropped : Eval.dropUnique heapFuel store value = + .ok (outStore, outHeapFuel)) : + InstructionTransferCase context interpretation store heapFuel frame stack + (.dropUnique target) + { store := outStore, heapFuel := outHeapFuel + control := .running { frame with pc := frame.pc + 1 } stack } + | freeUnique {target : Atom} {cid : CtorId} {location : Nat} + {box : NodeBox} {fields : Array RVal} + (resolved : resolveAtom frame.values target = .ok (.loc location)) + (viewed : ConstructorView store location .unique cid box fields) + (scalarFields : fields.all RVal.isScalar = true) : + InstructionTransferCase context interpretation store heapFuel frame stack + (.freeUnique target cid) + { store := store.kill location, heapFuel + control := .running { frame with pc := frame.pc + 1 } stack } + | fetch {target : Atom} {cid : CtorId} {field location : Nat} + {box : NodeBox} {fields : Array RVal} {value : RVal} + (resolved : resolveAtom frame.values target = .ok (.loc location)) + (boxAt : store.get? location = some box) + (node : box.node = .ctorN cid fields) + (fieldAt : fields[field]? = some value) : + InstructionTransferCase context interpretation store heapFuel frame stack + (.fetch target cid field) + { store, heapFuel + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values.push value } + stack } + | callFn {address : Address} {arguments : Array Atom} + {values : Array RVal} {definition : Function} + (noCredits : NoLiveCredits frame) + (resolved : resolveAtoms frame.values arguments = .ok values) + (declaration : context.declarations address = some (.fn definition)) + (arity : values.size = definition.signature.params.size) + (nonempty : definition.blocks.isEmpty = false) : + InstructionTransferCase context interpretation store heapFuel frame stack + (.call address arguments) + { store, heapFuel + control := .running { definition, values } + (.resume { frame with pc := frame.pc + 1 } :: stack) } + | callSelf {arguments : Array Atom} {values : Array RVal} + (noCredits : NoLiveCredits frame) + (resolved : resolveAtoms frame.values arguments = .ok values) + (arity : values.size = frame.definition.signature.params.size) + (nonempty : frame.definition.blocks.isEmpty = false) : + InstructionTransferCase context interpretation store heapFuel frame stack + (.callSelf arguments) + { store, heapFuel + control := .running { definition := frame.definition, values } + (.resume { frame with pc := frame.pc + 1 } :: stack) } + | pappFn {address : Address} {arguments : Array Atom} + {values : Array RVal} {definition : Function} + (noCredits : NoLiveCredits frame) + (declaration : context.declarations address = some (.fn definition)) + (papSafe : definition.signature.papSafe = true) + (resolved : resolveAtoms frame.values arguments = .ok values) + (under : values.size < definition.signature.params.size) : + InstructionTransferCase context interpretation store heapFuel frame stack + (.papp address arguments) + (let allocation := store.allocNode .shared + (.papN address definition.signature.params.size values) + { store := allocation.1, heapFuel + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values.push (.loc allocation.2) } + stack }) + | pappExtern {address : Address} {arguments : Array Atom} + {values : Array RVal} {arity : Nat} + (noCredits : NoLiveCredits frame) + (declaration : context.declarations address = some (.extern arity)) + (resolved : resolveAtoms frame.values arguments = .ok values) + (under : values.size < arity) : + InstructionTransferCase context interpretation store heapFuel frame stack + (.papp address arguments) + (let allocation := store.allocNode .shared + (.papN address arity values) + { store := allocation.1, heapFuel + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values.push (.loc allocation.2) } + stack }) + | apply {functionAtom : Atom} {argumentAtoms : Array Atom} + {function : RVal} {arguments : Array RVal} {target : Machine} + (noCredits : NoLiveCredits frame) + (functionResolved : resolveAtom frame.values functionAtom = .ok function) + (argumentsResolved : + resolveAtoms frame.values argumentAtoms = .ok arguments) + (transferred : ApplyTransfer context interpretation store heapFuel + function arguments { frame with pc := frame.pc + 1 } stack target) : + InstructionTransferCase context interpretation store heapFuel frame stack + (.apply functionAtom argumentAtoms) target + | extern {address : Address} {argumentAtoms : Array Atom} + {arguments : Array RVal} {arity : Nat} {value : RVal} + (noCredits : NoLiveCredits frame) + (resolved : resolveAtoms frame.values argumentAtoms = .ok arguments) + (declaration : context.declarations address = some (.extern arity)) + (argumentArity : arguments.size = arity) + (called : ScalarOracleCall context address arguments value) : + InstructionTransferCase context interpretation store heapFuel frame stack + (.extern address argumentAtoms) + { store, heapFuel + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values.push value } + stack } + +/-- Each classified instruction shape reconstructs the public small step once +the enclosing block lookup and program-counter facts are supplied. -/ +theorem InstructionTransferCase.step {context : Context} + {interpretation : Interpretation} {store : Store} {heapFuel : Nat} + {frame : Frame} {stack : List Continuation} + {instruction : Instr} {target : Machine} + (classified : InstructionTransferCase context interpretation store + heapFuel frame stack instruction target) + {block : Block} + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instructionAt : block.instructions[frame.pc] = instruction) : + Step context interpretation + { store, heapFuel, control := .running frame stack } target := by + cases classified with + | move resolved => + exact Step.move rfl blockAt pc instructionAt resolved + | alloc schemaAt resolved fields => + exact Step.alloc rfl blockAt pc instructionAt schemaAt resolved fields + | allocWithAbsent schemaAt resolved fields taken layout absent => + exact Step.allocWithAbsent rfl blockAt pc instructionAt schemaAt + resolved fields taken layout absent + | allocWithLogical mode schemaAt resolved fields taken layout present => + cases mode + exact Step.allocWithLogical rfl blockAt pc instructionAt schemaAt + resolved fields taken layout present + | allocWithPhysical mode schemaAt resolved fields taken layout present reused => + cases mode + exact Step.allocWithPhysical rfl blockAt pc instructionAt schemaAt + resolved fields taken layout present reused + | discardAbsent taken absent => + exact Step.discardCreditAbsent rfl blockAt pc instructionAt taken absent + | discardLogical mode taken present => + cases mode + exact Step.discardCreditLogical rfl blockAt pc instructionAt taken present + | discardPhysical mode taken present released => + cases mode + exact Step.discardCreditPhysical rfl blockAt pc instructionAt taken + present released + | takeUniqueLogical mode schemaAt resolved viewed unitRC => + cases mode + exact Step.takeUniqueLogical rfl blockAt pc instructionAt schemaAt + resolved viewed unitRC + | takeUniquePhysical mode schemaAt resolved viewed unitRC => + cases mode + exact Step.takeUniquePhysical rfl blockAt pc instructionAt schemaAt + resolved viewed unitRC + | resetSharedLogicalHot mode schemaAt resolved viewed unitRC => + cases mode + exact Step.resetSharedLogicalHot rfl blockAt pc instructionAt schemaAt + resolved viewed unitRC + | resetSharedPhysicalHot mode schemaAt resolved viewed unitRC => + cases mode + exact Step.resetSharedPhysicalHot rfl blockAt pc instructionAt schemaAt + resolved viewed unitRC + | resetSharedCold schemaAt resolved viewed shared retained => + exact Step.resetSharedCold rfl blockAt pc instructionAt schemaAt resolved + viewed shared retained + | retainShared resolved retained => + exact Step.retainShared rfl blockAt pc instructionAt resolved retained + | releaseShared resolved released => + exact Step.releaseShared rfl blockAt pc instructionAt resolved released + | dropUnique resolved dropped => + exact Step.dropUnique rfl blockAt pc instructionAt resolved dropped + | freeUnique resolved viewed scalarFields => + obtain ⟨boxAt, unique, node⟩ := viewed.parts + exact Step.freeUnique rfl blockAt pc instructionAt resolved boxAt unique + node scalarFields + | fetch resolved boxAt node fieldAt => + exact Step.fetch rfl blockAt pc instructionAt resolved boxAt node fieldAt + | callFn noCredits resolved declaration arity nonempty => + exact Step.callFnCleared rfl blockAt pc instructionAt noCredits resolved + declaration arity nonempty + | callSelf noCredits resolved arity nonempty => + exact Step.callSelfCleared rfl blockAt pc instructionAt noCredits resolved + arity nonempty + | pappFn noCredits declaration papSafe resolved under => + exact Step.pappFnCleared rfl blockAt pc instructionAt noCredits declaration + papSafe resolved under + | pappExtern noCredits declaration resolved under => + exact Step.pappExternCleared rfl blockAt pc instructionAt noCredits + declaration resolved under + | apply noCredits functionResolved argumentsResolved transferred => + exact Step.applyCleared rfl blockAt pc instructionAt noCredits + functionResolved argumentsResolved transferred + | extern noCredits resolved declaration argumentArity called => + exact Step.externCleared rfl blockAt pc instructionAt noCredits resolved + declaration argumentArity called + +/-- Invert an arbitrary successful instruction-worker equation into its exact +runtime case. -/ +theorem InstructionTransfer.classify {context : Context} + {interpretation : Interpretation} {store : Store} {heapFuel : Nat} + {frame : Frame} {stack : List Continuation} + {instruction : Instr} {target : Machine} + (transferred : InstructionTransfer context interpretation store heapFuel + frame stack instruction target) : + InstructionTransferCase context interpretation store heapFuel frame stack + instruction target := by + unfold InstructionTransfer runInstruction at transferred + simp only [bind, Except.bind, pure, Except.pure] at transferred + cases instruction with + | move atom => + cases resolved : resolveAtom frame.values atom with + | error error => simp [resolved] at transferred + | ok value => + simp [resolved, Frame.advance, Frame.pushValue] at transferred + subst target + exact .move resolved + | alloc world cid arguments => + cases schemaAt : context.schemas world cid with + | none => simp [lookupSchema, schemaAt] at transferred + | some schema => + simp only [lookupSchema, schemaAt] at transferred + cases resolved : resolveAtoms frame.values arguments with + | error error => simp [resolved] at transferred + | ok values => + simp only [resolved] at transferred + cases fields : checkFieldWorlds store schema values with + | error error => simp [fields] at transferred + | ok checkedUnit => + cases checkedUnit + simp [fields, Frame.advance, Frame.pushValue] at transferred + subst target + exact .alloc schemaAt resolved fields + | allocWith creditId world cid arguments => + cases schemaAt : context.schemas world cid with + | none => simp [lookupSchema, schemaAt] at transferred + | some schema => + simp only [lookupSchema, schemaAt] at transferred + cases resolved : resolveAtoms frame.values arguments with + | error error => simp [resolved] at transferred + | ok values => + simp only [resolved] at transferred + cases fields : checkFieldWorlds store schema values with + | error error => simp [fields] at transferred + | ok checkedUnit => + cases checkedUnit + simp only [fields] at transferred + cases taken : takeCredit frame.advance creditId with + | error error => simp [taken] at transferred + | ok output => + obtain ⟨next, credit⟩ := output + simp only [taken] at transferred + have taken' : CreditTake + { frame with pc := frame.pc + 1 } + creditId next credit := by + simpa [CreditTake, Frame.advance] using taken + by_cases layout : credit.layout = schema.layout + · cases presence : credit.presence with + | absent => + simp [layout, presence, Frame.pushValue] + at transferred + subst target + exact .allocWithAbsent schemaAt resolved fields + taken' layout presence + | present reservation => + cases interpretation with + | logical => + cases reservation with + | none => + simp [layout, presence, Frame.pushValue] + at transferred + subst target + exact .allocWithLogical rfl schemaAt + resolved fields taken' layout presence + | some location => + simp [layout, presence] at transferred + | physical => + cases reservation with + | none => + simp [layout, presence] at transferred + | some location => + cases reused : store.reuseReservation + location world (.ctorN cid values) + schema.fields.size with + | error error => + simp [layout, presence, reused] + at transferred + | ok outStore => + simp [layout, presence, reused, + Frame.pushValue] + at transferred + subst target + exact .allocWithPhysical rfl schemaAt + resolved fields taken' layout + presence reused + · simp [layout] at transferred + | discardCredit creditId => + cases taken : takeCredit frame.advance creditId with + | error error => simp [taken] at transferred + | ok output => + obtain ⟨next, credit⟩ := output + simp only [taken] at transferred + have taken' : CreditTake { frame with pc := frame.pc + 1 } + creditId next credit := by + simpa [CreditTake, Frame.advance] using taken + cases presence : credit.presence with + | absent => + simp [presence] at transferred + subst target + exact .discardAbsent taken' presence + | present reservation => + cases interpretation with + | logical => + cases reservation with + | none => + simp [presence] at transferred + subst target + exact .discardLogical rfl taken' presence + | some location => simp [presence] at transferred + | physical => + cases reservation with + | none => simp [presence] at transferred + | some location => + cases released : store.releaseReservation location with + | error error => simp [presence, released] at transferred + | ok outStore => + simp [presence, released] at transferred + subst target + exact .discardPhysical rfl taken' presence released + | takeUnique targetAtom cid => + cases schemaAt : context.schemas .unique cid with + | none => simp [lookupSchema, schemaAt] at transferred + | some schema => + simp only [lookupSchema, schemaAt] at transferred + cases resolved : resolveAtom frame.values targetAtom with + | error error => simp [resolved] at transferred + | ok value => + cases value with + | lit literal => simp [resolved] at transferred + | erased => simp [resolved] at transferred + | loc location => + simp only [resolved] at transferred + cases viewed : requireCtor store location .unique cid with + | error error => simp [viewed] at transferred + | ok output => + obtain ⟨box, fields⟩ := output + simp only [viewed] at transferred + by_cases unitRC : box.rc = 1 + · cases interpretation with + | logical => + simp [unitRC, Credit.presentFor, Frame.advance, + Frame.pushValues, Frame.pushCredit] at transferred + subst target + exact .takeUniqueLogical rfl schemaAt resolved + viewed unitRC + | physical => + simp [unitRC, Credit.presentFor, Frame.advance, + Frame.pushValues, Frame.pushCredit] at transferred + subst target + exact .takeUniquePhysical rfl schemaAt resolved + viewed unitRC + · simp [unitRC] at transferred + | resetShared targetAtom cid => + cases schemaAt : context.schemas .shared cid with + | none => simp [lookupSchema, schemaAt] at transferred + | some schema => + simp only [lookupSchema, schemaAt] at transferred + cases resolved : resolveAtom frame.values targetAtom with + | error error => simp [resolved] at transferred + | ok value => + cases value with + | lit literal => simp [resolved] at transferred + | erased => simp [resolved] at transferred + | loc location => + simp only [resolved] at transferred + cases viewed : requireCtor store location .shared cid with + | error error => simp [viewed] at transferred + | ok output => + obtain ⟨box, fields⟩ := output + simp only [viewed] at transferred + by_cases zero : box.rc = 0 + · simp [zero] at transferred + · by_cases unitRC : box.rc = 1 + · cases interpretation with + | logical => + simp [unitRC, Credit.presentFor, + Frame.advance, Frame.pushValues, + Frame.pushCredit] at transferred + subst target + exact .resetSharedLogicalHot rfl schemaAt + resolved viewed unitRC + | physical => + simp [unitRC, Credit.presentFor, + Frame.advance, Frame.pushValues, + Frame.pushCredit] at transferred + subst target + exact .resetSharedPhysicalHot rfl schemaAt + resolved viewed unitRC + · have shared : 1 < box.rc := by omega + let beforeRetain := + ((((store.tickResetAttempt).setBox location + { box with rc := box.rc - 1 }).rcTick).tickColdReset) + cases retained : retainSharedMany beforeRetain fields with + | error error => + simp [zero, unitRC, beforeRetain, retained] + at transferred + | ok outStore => + simp [zero, unitRC, beforeRetain, retained, + Frame.advance, Frame.pushValues, + Frame.pushCredit] at transferred + subst target + exact .resetSharedCold schemaAt resolved viewed + shared retained + | retainShared targetAtom => + cases resolved : resolveAtom frame.values targetAtom with + | error error => simp [resolved] at transferred + | ok value => + simp only [resolved] at transferred + cases retained : Eval.retainShared store value with + | error error => simp [retained] at transferred + | ok outStore => + simp [retained, Frame.advance, Frame.pushValue] at transferred + subst target + exact .retainShared resolved retained + | releaseShared targetAtom => + cases resolved : resolveAtom frame.values targetAtom with + | error error => simp [resolved] at transferred + | ok value => + simp only [resolved] at transferred + cases released : Eval.releaseShared heapFuel store value with + | error error => simp [released] at transferred + | ok output => + obtain ⟨outStore, outHeapFuel⟩ := output + simp [released, Frame.advance] at transferred + subst target + exact .releaseShared resolved released + | dropUnique targetAtom => + cases resolved : resolveAtom frame.values targetAtom with + | error error => simp [resolved] at transferred + | ok value => + simp only [resolved] at transferred + cases dropped : Eval.dropUnique heapFuel store value with + | error error => simp [dropped] at transferred + | ok output => + obtain ⟨outStore, outHeapFuel⟩ := output + simp [dropped, Frame.advance] at transferred + subst target + exact .dropUnique resolved dropped + | freeUnique targetAtom cid => + cases resolved : resolveAtom frame.values targetAtom with + | error error => simp [resolved] at transferred + | ok value => + cases value with + | lit literal => simp [resolved] at transferred + | erased => simp [resolved] at transferred + | loc location => + simp only [resolved] at transferred + cases viewed : requireCtor store location .unique cid with + | error error => simp [viewed] at transferred + | ok output => + obtain ⟨box, fields⟩ := output + simp only [viewed] at transferred + cases scalarFields : fields.all RVal.isScalar with + | false => simp [scalarFields] at transferred + | true => + simp [scalarFields, Frame.advance] at transferred + subst target + exact .freeUnique resolved viewed scalarFields + | fetch targetAtom cid field => + cases resolved : resolveAtom frame.values targetAtom with + | error error => simp [resolved] at transferred + | ok value => + cases value with + | lit literal => simp [resolved] at transferred + | erased => simp [resolved] at transferred + | loc location => + simp only [resolved] at transferred + cases boxAt : store.get? location with + | none => simp [boxAt] at transferred + | some box => + simp only [boxAt] at transferred + cases node : box.node with + | papN address arity captured => simp [node] at transferred + | ctorN actual fields => + simp only [node] at transferred + by_cases same : actual = cid + · subst actual + cases fieldAt : fields[field]? with + | none => simp [fieldAt] at transferred + | some fieldValue => + simp [fieldAt, Frame.advance, Frame.pushValue] + at transferred + subst target + exact .fetch resolved boxAt node fieldAt + · simp [same] at transferred + | call address arguments => + cases live : frame.hasCredits with + | true => simp [ensureCallBoundary, live] at transferred + | false => + have noCredits : NoLiveCredits frame := by + simpa [NoLiveCredits, Frame.hasCredits] using live + simp only [ensureCallBoundary, live, Bool.false_eq_true, + ↓reduceIte, pure, Except.pure] at transferred + cases resolved : resolveAtoms frame.values arguments with + | error error => simp [resolved] at transferred + | ok values => + simp only [resolved] at transferred + cases declaration : context.declarations address with + | none => simp [declaration] at transferred + | some declared => + simp only [declaration] at transferred + cases declared with + | extern arity => simp at transferred + | fn definition => + by_cases arity : + values.size = definition.signature.params.size + · cases empty : definition.blocks.isEmpty with + | true => + simp [enterFunction, arity, empty] at transferred + | false => + simp [enterFunction, arity, empty, Frame.advance] + at transferred + subst target + exact .callFn noCredits resolved declaration arity + empty + · simp [enterFunction, arity] at transferred + | callSelf arguments => + cases live : frame.hasCredits with + | true => simp [ensureCallBoundary, live] at transferred + | false => + have noCredits : NoLiveCredits frame := by + simpa [NoLiveCredits, Frame.hasCredits] using live + simp only [ensureCallBoundary, live, Bool.false_eq_true, + ↓reduceIte, pure, Except.pure] at transferred + cases resolved : resolveAtoms frame.values arguments with + | error error => simp [resolved] at transferred + | ok values => + simp only [resolved] at transferred + by_cases arity : + values.size = frame.definition.signature.params.size + · cases empty : frame.definition.blocks.isEmpty with + | true => + simp [enterFunction, arity, empty] + at transferred + | false => + simp [enterFunction, arity, empty, Frame.advance] + at transferred + subst target + exact .callSelf noCredits resolved arity empty + · simp [enterFunction, arity] at transferred + | papp address arguments => + cases live : frame.hasCredits with + | true => simp [ensureCallBoundary, live] at transferred + | false => + have noCredits : NoLiveCredits frame := by + simpa [NoLiveCredits, Frame.hasCredits] using live + simp only [ensureCallBoundary, live, Bool.false_eq_true, + ↓reduceIte, pure, Except.pure] at transferred + cases resolved : resolveAtoms frame.values arguments with + | error error => simp [resolved] at transferred + | ok values => + simp only [resolved] at transferred + cases declaration : context.declarations address with + | none => simp [declaration] at transferred + | some declared => + simp only [declaration] at transferred + cases declared with + | fn definition => + cases papSafe : definition.signature.papSafe with + | false => + simp [declarationPapSafe, papSafe] at transferred + | true => + by_cases under : + values.size < definition.signature.params.size + · have notEnough : ¬ + definition.signature.params.size ≤ + values.size := Nat.not_le_of_gt under + simp [declarationArity, declarationPapSafe, + papSafe, notEnough, Frame.advance, + Frame.pushValue] at transferred + subst target + exact .pappFn noCredits declaration papSafe + resolved under + · have enough : definition.signature.params.size ≤ + values.size := Nat.le_of_not_gt under + simp [declarationArity, declarationPapSafe, + papSafe, enough] at transferred + | extern arity => + by_cases under : values.size < arity + · have notEnough : ¬arity ≤ values.size := + Nat.not_le_of_gt under + simp [declarationArity, declarationPapSafe, + notEnough, Frame.advance, Frame.pushValue] + at transferred + subst target + exact .pappExtern noCredits declaration resolved under + · have enough : arity ≤ values.size := + Nat.le_of_not_gt under + simp [declarationArity, declarationPapSafe, enough] + at transferred + | apply functionAtom argumentAtoms => + cases live : frame.hasCredits with + | true => simp [ensureCallBoundary, live] at transferred + | false => + have noCredits : NoLiveCredits frame := by + simpa [NoLiveCredits, Frame.hasCredits] using live + simp only [ensureCallBoundary, live, Bool.false_eq_true, + ↓reduceIte, pure, Except.pure] at transferred + cases functionResolved : resolveAtom frame.values functionAtom with + | error error => simp [functionResolved] at transferred + | ok function => + simp only [functionResolved] at transferred + cases argumentsResolved : + resolveAtoms frame.values argumentAtoms with + | error error => simp [argumentsResolved] at transferred + | ok arguments => + simp only [argumentsResolved] at transferred + change ApplyTransfer context interpretation store heapFuel + function arguments { frame with pc := frame.pc + 1 } + stack target at transferred + exact .apply noCredits functionResolved argumentsResolved + transferred + | extern address arguments => + cases live : frame.hasCredits with + | true => simp [ensureCallBoundary, live] at transferred + | false => + have noCredits : NoLiveCredits frame := by + simpa [NoLiveCredits, Frame.hasCredits] using live + simp only [ensureCallBoundary, live, Bool.false_eq_true, + ↓reduceIte, pure, Except.pure] at transferred + cases resolved : resolveAtoms frame.values arguments with + | error error => simp [resolved] at transferred + | ok values => + simp only [resolved] at transferred + cases declaration : context.declarations address with + | none => simp [declaration] at transferred + | some declared => + simp only [declaration] at transferred + cases declared with + | fn definition => simp at transferred + | extern arity => + by_cases argumentArity : values.size = arity + · cases called : callScalarOracle context address values with + | error error => simp [argumentArity, called] at transferred + | ok value => + simp [argumentArity, called, Frame.advance, + Frame.pushValue] at transferred + subst target + exact .extern noCredits resolved declaration + argumentArity called + · simp [argumentArity] at transferred + +/-- Public equation for the private terminator worker at a canonical running +machine. -/ +def TerminatorTransfer (context : Context) + (interpretation : Interpretation) (store : Store) (heapFuel : Nat) + (frame : Frame) (stack : List Continuation) (terminator : Terminator) + (target : Machine) : Prop := + runTerminator context interpretation + { store, heapFuel, control := .running frame stack } + frame stack terminator = .ok target + +/-- Every successful runtime shape of one IxIR₂ terminator. -/ +inductive TerminatorTransferCase (context : Context) + (interpretation : Interpretation) (store : Store) (heapFuel : Nat) + (frame : Frame) : List Continuation → Terminator → Machine → Prop where + | jump {stack : List Continuation} {edge : Edge} {target : Frame} + (transferred : EdgeTransfer frame edge #[] target) : + TerminatorTransferCase context interpretation store heapFuel frame stack + (.jump edge) + { store, heapFuel, control := .running target stack } + | switchCtor {stack : List Continuation} {scrutinee : Atom} + {constructors : Array CtorAlt} {natPeel : Option NatPeel} + {location : Nat} {box : NodeBox} {cid : CtorId} + {fields : Array RVal} {alternative : CtorAlt} {target : Frame} + (resolved : resolveAtom frame.values scrutinee = .ok (.loc location)) + (boxAt : store.get? location = some box) + (node : box.node = .ctorN cid fields) + (alternativeAt : constructors.find? (fun candidate => + candidate.cid == cid) = some alternative) + (transferred : EdgeTransfer frame alternative.edge #[] target) : + TerminatorTransferCase context interpretation store heapFuel frame stack + (.switchValue scrutinee constructors natPeel) + { store, heapFuel, control := .running target stack } + | switchNatZero {stack : List Continuation} {scrutinee : Atom} + {constructors : Array CtorAlt} {peel : NatPeel} {target : Frame} + (resolved : resolveAtom frame.values scrutinee = + .ok (.lit (.nat 0))) + (transferred : EdgeTransfer frame peel.zero #[] target) : + TerminatorTransferCase context interpretation store heapFuel frame stack + (.switchValue scrutinee constructors (some peel)) + { store, heapFuel, control := .running target stack } + | switchNatSucc {stack : List Continuation} {scrutinee : Atom} + {constructors : Array CtorAlt} {peel : NatPeel} {predecessor : Nat} + {target : Frame} + (resolved : resolveAtom frame.values scrutinee = + .ok (.lit (.nat (predecessor + 1)))) + (transferred : EdgeTransfer frame peel.succ + #[.lit (.nat predecessor)] target) : + TerminatorTransferCase context interpretation store heapFuel frame stack + (.switchValue scrutinee constructors (some peel)) + { store, heapFuel, control := .running target stack } + | branchPresent {stack : List Continuation} {creditId : CreditId} + {credit : Credit} {someEdge noneEdge : Edge} {target : Frame} + (lookedUp : CreditLookup frame creditId credit) + (present : credit.isPresent = true) + (transferred : EdgeTransfer frame someEdge #[] target) : + TerminatorTransferCase context interpretation store heapFuel frame stack + (.branchCredit creditId someEdge noneEdge) + { store, heapFuel, control := .running target stack } + | branchAbsent {stack : List Continuation} {creditId : CreditId} + {credit : Credit} {someEdge noneEdge : Edge} {target : Frame} + (lookedUp : CreditLookup frame creditId credit) + (absent : credit.isPresent = false) + (transferred : EdgeTransfer frame noneEdge #[] target) : + TerminatorTransferCase context interpretation store heapFuel frame stack + (.branchCredit creditId someEdge noneEdge) + { store, heapFuel, control := .running target stack } + | retResume {caller : Frame} {rest : List Continuation} + {atom : Atom} {value : RVal} + (resolved : resolveAtom frame.values atom = .ok value) + (noCredits : NoLiveCredits frame) + (world : value.hasWorld store frame.definition.signature.result = true) : + TerminatorTransferCase context interpretation store heapFuel frame + (.resume caller :: rest) (.ret atom) + { store, heapFuel + control := .running + { caller with values := caller.values.push value } rest } + | retHalt {atom : Atom} {value : RVal} + (resolved : resolveAtom frame.values atom = .ok value) + (noCredits : NoLiveCredits frame) + (world : value.hasWorld store frame.definition.signature.result = true) : + TerminatorTransferCase context interpretation store heapFuel frame + [] (.ret atom) { store, heapFuel, control := .halted value } + | retApplyMore {caller : Frame} {arguments : Array RVal} + {rest : List Continuation} {atom : Atom} {value : RVal} + {target : Machine} + (resolved : resolveAtom frame.values atom = .ok value) + (noCredits : NoLiveCredits frame) + (world : value.hasWorld store frame.definition.signature.result = true) + (transferred : ApplyTransfer context interpretation store heapFuel value + arguments caller rest target) : + TerminatorTransferCase context interpretation store heapFuel frame + (.applyMore arguments caller :: rest) (.ret atom) target + | tailCallFn {stack : List Continuation} {address : Address} + {argumentAtoms : Array Atom} {arguments : Array RVal} + {definition : Function} + (noCredits : NoLiveCredits frame) + (resolved : resolveAtoms frame.values argumentAtoms = .ok arguments) + (declaration : context.declarations address = some (.fn definition)) + (arity : arguments.size = definition.signature.params.size) + (nonempty : definition.blocks.isEmpty = false) : + TerminatorTransferCase context interpretation store heapFuel frame stack + (.tailCall address argumentAtoms) + { store, heapFuel + control := .running { definition, values := arguments } stack } + | tailCallSelf {stack : List Continuation} {argumentAtoms : Array Atom} + {arguments : Array RVal} + (noCredits : NoLiveCredits frame) + (resolved : resolveAtoms frame.values argumentAtoms = .ok arguments) + (arity : arguments.size = frame.definition.signature.params.size) + (nonempty : frame.definition.blocks.isEmpty = false) : + TerminatorTransferCase context interpretation store heapFuel frame stack + (.tailCallSelf argumentAtoms) + { store, heapFuel + control := .running + { definition := frame.definition, values := arguments } stack } + +/-- Each classified terminator shape reconstructs the public small step once +the enclosing terminal position is supplied. -/ +theorem TerminatorTransferCase.step {context : Context} + {interpretation : Interpretation} {store : Store} {heapFuel : Nat} + {frame : Frame} {stack : List Continuation} + {terminator : Terminator} {target : Machine} + (classified : TerminatorTransferCase context interpretation store + heapFuel frame stack terminator target) + {block : Block} + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminatorAt : block.terminator = terminator) : + Step context interpretation + { store, heapFuel, control := .running frame stack } target := by + cases classified with + | jump transferred => + exact Step.jump rfl blockAt pc terminatorAt transferred + | switchCtor resolved boxAt node alternativeAt transferred => + exact Step.switchCtor rfl blockAt pc terminatorAt resolved boxAt node + alternativeAt transferred + | switchNatZero resolved transferred => + exact Step.switchNatZero rfl blockAt pc terminatorAt resolved transferred + | switchNatSucc resolved transferred => + exact Step.switchNatSucc rfl blockAt pc terminatorAt resolved transferred + | branchPresent lookedUp present transferred => + exact Step.branchCreditPresent rfl blockAt pc terminatorAt lookedUp + present transferred + | branchAbsent lookedUp absent transferred => + exact Step.branchCreditAbsent rfl blockAt pc terminatorAt lookedUp absent + transferred + | retResume resolved noCredits world => + exact Step.retResumeCleared rfl blockAt pc terminatorAt resolved noCredits + world + | retHalt resolved noCredits world => + exact Step.retHaltCleared rfl blockAt pc terminatorAt resolved noCredits + world + | retApplyMore resolved noCredits world transferred => + exact Step.retApplyMoreCleared rfl blockAt pc terminatorAt resolved + noCredits world transferred + | tailCallFn noCredits resolved declaration arity nonempty => + exact Step.tailCallFnCleared rfl blockAt pc terminatorAt noCredits + resolved declaration arity nonempty + | tailCallSelf noCredits resolved arity nonempty => + exact Step.tailCallSelfCleared rfl blockAt pc terminatorAt noCredits + resolved arity nonempty + +/-- Invert an arbitrary successful terminator-worker equation into its exact +runtime case. -/ +theorem TerminatorTransfer.classify {context : Context} + {interpretation : Interpretation} {store : Store} {heapFuel : Nat} + {frame : Frame} {stack : List Continuation} + {terminator : Terminator} {target : Machine} + (transferred : TerminatorTransfer context interpretation store heapFuel + frame stack terminator target) : + TerminatorTransferCase context interpretation store heapFuel frame stack + terminator target := by + unfold TerminatorTransfer runTerminator at transferred + simp only [bind, Except.bind, pure, Except.pure] at transferred + cases terminator with + | jump edge => + cases edgeRun : transferEdge frame edge with + | error error => simp [edgeRun] at transferred + | ok targetFrame => + simp [edgeRun] at transferred + subst target + exact .jump edgeRun + | switchValue scrutinee constructors natPeel => + cases resolved : resolveAtom frame.values scrutinee with + | error error => simp [resolved] at transferred + | ok value => + cases value with + | erased => simp [resolved] at transferred + | loc location => + simp only [resolved] at transferred + cases boxAt : store.get? location with + | none => simp [boxAt] at transferred + | some box => + simp only [boxAt] at transferred + cases node : box.node with + | papN address arity arguments => + simp [node] at transferred + | ctorN cid fields => + simp only [node] at transferred + cases alternativeAt : constructors.find? + (fun candidate => candidate.cid == cid) with + | none => simp [alternativeAt] at transferred + | some alternative => + simp only [alternativeAt] at transferred + cases edgeRun : transferEdge frame alternative.edge with + | error error => simp [edgeRun] at transferred + | ok targetFrame => + simp [edgeRun] at transferred + subst target + exact .switchCtor resolved boxAt node alternativeAt + edgeRun + | lit literal => + cases literal with + | str string => simp [resolved] at transferred + | nat number => + cases natPeel with + | none => simp [resolved] at transferred + | some peel => + cases number with + | zero => + simp only [resolved] at transferred + cases edgeRun : transferEdge frame peel.zero with + | error error => simp [edgeRun] at transferred + | ok targetFrame => + simp [edgeRun] at transferred + subst target + exact .switchNatZero resolved edgeRun + | succ predecessor => + simp only [resolved] at transferred + cases edgeRun : transferEdge frame peel.succ + #[.lit (.nat predecessor)] with + | error error => simp [edgeRun] at transferred + | ok targetFrame => + simp [edgeRun] at transferred + subst target + exact .switchNatSucc resolved edgeRun + | branchCredit creditId someEdge noneEdge => + cases lookedUp : creditAt frame creditId with + | error error => simp [lookedUp] at transferred + | ok credit => + simp only [lookedUp] at transferred + cases present : credit.isPresent with + | false => + cases edgeRun : transferEdge frame noneEdge with + | error error => simp [present, edgeRun] at transferred + | ok targetFrame => + simp [present, edgeRun] at transferred + subst target + exact .branchAbsent lookedUp present edgeRun + | true => + cases edgeRun : transferEdge frame someEdge with + | error error => simp [present, edgeRun] at transferred + | ok targetFrame => + simp [present, edgeRun] at transferred + subst target + exact .branchPresent lookedUp present edgeRun + | ret atom => + cases resolved : resolveAtom frame.values atom with + | error error => simp [resolved] at transferred + | ok value => + simp only [resolved] at transferred + unfold finishReturn at transferred + simp only [pure, Except.pure] at transferred + cases live : frame.hasCredits with + | true => simp [live] at transferred + | false => + have noCredits : NoLiveCredits frame := by + simpa [NoLiveCredits, Frame.hasCredits] using live + simp only [live, Bool.false_eq_true, ↓reduceIte] at transferred + cases world : value.hasWorld store + frame.definition.signature.result with + | false => simp [world] at transferred + | true => + simp only [world, Bool.not_true, Bool.false_eq_true, + ↓reduceIte] at transferred + cases stack with + | nil => + simp at transferred + subst target + exact .retHalt resolved noCredits world + | cons continuation rest => + cases continuation with + | resume caller => + simp [Frame.pushValue] at transferred + subst target + exact .retResume resolved noCredits world + | applyMore arguments caller => + change ApplyTransfer context interpretation store + heapFuel value arguments caller rest target + at transferred + exact .retApplyMore resolved noCredits world + transferred + | tailCall address argumentAtoms => + cases live : frame.hasCredits with + | true => simp [ensureCallBoundary, live] at transferred + | false => + have noCredits : NoLiveCredits frame := by + simpa [NoLiveCredits, Frame.hasCredits] using live + simp only [ensureCallBoundary, live, Bool.false_eq_true, + ↓reduceIte, pure, Except.pure] at transferred + cases resolved : resolveAtoms frame.values argumentAtoms with + | error error => simp [resolved] at transferred + | ok arguments => + simp only [resolved] at transferred + cases declaration : context.declarations address with + | none => simp [declaration] at transferred + | some declared => + simp only [declaration] at transferred + cases declared with + | extern arity => simp at transferred + | fn definition => + by_cases arity : + arguments.size = definition.signature.params.size + · cases empty : definition.blocks.isEmpty with + | true => + simp [enterFunction, arity, empty] at transferred + | false => + simp [enterFunction, arity, empty] at transferred + subst target + exact .tailCallFn noCredits resolved declaration + arity empty + · simp [enterFunction, arity] at transferred + | tailCallSelf argumentAtoms => + cases live : frame.hasCredits with + | true => simp [ensureCallBoundary, live] at transferred + | false => + have noCredits : NoLiveCredits frame := by + simpa [NoLiveCredits, Frame.hasCredits] using live + simp only [ensureCallBoundary, live, Bool.false_eq_true, + ↓reduceIte, pure, Except.pure] at transferred + cases resolved : resolveAtoms frame.values argumentAtoms with + | error error => simp [resolved] at transferred + | ok arguments => + simp only [resolved] at transferred + by_cases arity : + arguments.size = frame.definition.signature.params.size + · cases empty : frame.definition.blocks.isEmpty with + | true => simp [enterFunction, arity, empty] at transferred + | false => + simp [enterFunction, arity, empty] at transferred + subst target + exact .tailCallSelf noCredits resolved arity empty + · simp [enterFunction, arity] at transferred + +/-- Exhaustive successful shapes of the public one-step evaluator. -/ +inductive StepCase (context : Context) (interpretation : Interpretation) : + Machine → Machine → Prop where + | halted {store : Store} {heapFuel : Nat} {value : RVal} : + StepCase context interpretation + { store, heapFuel, control := .halted value } + { store, heapFuel, control := .halted value } + | instruction {store : Store} {heapFuel : Nat} {frame : Frame} + {stack : List Continuation} {block : Block} {instruction : Instr} + {target : Machine} + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instructionAt : block.instructions[frame.pc] = instruction) + (classified : InstructionTransferCase context interpretation store + heapFuel frame stack instruction target) : + StepCase context interpretation + { store, heapFuel, control := .running frame stack } target + | terminator {store : Store} {heapFuel : Nat} {frame : Frame} + {stack : List Continuation} {block : Block} {terminator : Terminator} + {target : Machine} + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminatorAt : block.terminator = terminator) + (classified : TerminatorTransferCase context interpretation store + heapFuel frame stack terminator target) : + StepCase context interpretation + { store, heapFuel, control := .running frame stack } target + +/-- Every classified whole-step shape reconstructs the public evaluator +equation. -/ +theorem StepCase.step {context : Context} {interpretation : Interpretation} + {before after : Machine} + (classified : StepCase context interpretation before after) : + Step context interpretation before after := by + cases classified with + | halted => rfl + | instruction blockAt pc instructionAt instructionCase => + exact instructionCase.step blockAt pc instructionAt + | terminator blockAt pc terminatorAt terminatorCase => + exact terminatorCase.step blockAt pc terminatorAt + +/-- Every successful public step is either the halted self-step, one exact +instruction runtime shape, or one exact terminator runtime shape. -/ +theorem Step.classify {context : Context} {interpretation : Interpretation} + {before after : Machine} + (stepped : Step context interpretation before after) : + StepCase context interpretation before after := by + unfold Step step at stepped + cases before with + | mk store heapFuel control => + cases control with + | halted value => + change Except.ok + { store, heapFuel, control := .halted value } = .ok after + at stepped + injection stepped with afterEq + subst after + exact .halted + | running frame stack => + unfold currentBlock at stepped + cases blockAt : frame.definition.blocks[frame.block]? with + | none => + simp [blockAt, bind, Except.bind] at stepped + | some block => + simp only [blockAt, bind, Except.bind] + at stepped + by_cases pc : frame.pc < block.instructions.size + · rw [dif_pos pc] at stepped + change InstructionTransfer context interpretation store + heapFuel frame stack block.instructions[frame.pc] after + at stepped + exact .instruction blockAt pc rfl stepped.classify + · rw [dif_neg pc] at stepped + by_cases terminal : frame.pc = block.instructions.size + · have terminalBool : + (frame.pc == block.instructions.size) = true := + beq_iff_eq.mpr terminal + rw [terminalBool] at stepped + change TerminatorTransfer context interpretation store + heapFuel frame stack block.terminator after at stepped + exact .terminator blockAt terminal rfl stepped.classify + · have terminalBool : + (frame.pc == block.instructions.size) = false := + Bool.eq_false_iff.mpr (by + intro equal + exact terminal (beq_iff_eq.mp equal)) + rw [terminalBool] at stepped + simp at stepped + +/-- A finite sequence of genuine running-state transitions. Requiring the +source of each transition to be running prevents the evaluator's halted +self-step from pretending to consume control fuel. -/ +inductive Steps (context : Context) (interpretation : Interpretation) : + Nat → Machine → Machine → Prop where + | refl (machine : Machine) : Steps context interpretation 0 machine machine + | cons {count : Nat} {before middle after : Machine} + {frame : Frame} {stack : List Continuation} + (running : before.control = .running frame stack) + (head : Step context interpretation before middle) + (tail : Steps context interpretation count middle after) : + Steps context interpretation (Nat.succ count) before after + +/-- One running small step is a one-element finite execution. -/ +theorem Step.toSteps {context : Context} {interpretation : Interpretation} + {before after : Machine} {frame : Frame} {stack : List Continuation} + (running : before.control = .running frame stack) + (step : Step context interpretation before after) : + Steps context interpretation 1 before after := + .cons running step (.refl after) + +/-- The evaluator's one-step relation is deterministic because it is the +successful graph of the executable `step` function. -/ +theorem Step.deterministic {context : Context} + {interpretation : Interpretation} {before left right : Machine} + (leftStep : Step context interpretation before left) + (rightStep : Step context interpretation before right) : + left = right := by + exact Except.ok.inj (leftStep.symm.trans rightStep) + +/-- Finite executions compose and their exact step counts add. -/ +theorem Steps.trans {context : Context} {interpretation : Interpretation} + {firstCount secondCount : Nat} {before middle after : Machine} + (first : Steps context interpretation firstCount before middle) + (second : Steps context interpretation secondCount middle after) : + Steps context interpretation (firstCount + secondCount) before after := by + induction first with + | refl => simpa using second + | cons running head tail ih => + simpa only [Nat.succ_add] using + (Steps.cons running head (ih second)) + +/-- Any finite prefix of an execution that eventually halts can be cancelled +from the unique execution path. In particular the prefix cannot run past the +halted endpoint, because `Steps` admits transitions only from running states. -/ +theorem Steps.cancelPrefixToHalted {context : Context} + {interpretation : Interpretation} + {prefixCount totalCount : Nat} {before middle final : Machine} + {store : Store} {heapFuel : Nat} {value : RVal} + (prefixSteps : Steps context interpretation prefixCount before middle) + (total : Steps context interpretation totalCount before final) + (halted : final = { store, heapFuel, control := .halted value }) : + ∃ suffixCount, + totalCount = prefixCount + suffixCount ∧ + Steps context interpretation suffixCount middle final := by + induction prefixSteps generalizing totalCount final with + | refl machine => + exact ⟨totalCount, by simp, total⟩ + | @cons prefixCount before prefixMiddle middle frame stack running head tail + ih => + cases total with + | refl => + have controls : Control.running frame stack = .halted value := by + rw [← running] + exact congrArg Machine.control halted + contradiction + | @cons totalCount _ totalMiddle final totalFrame totalStack + totalRunning totalHead totalTail => + have middleEq : prefixMiddle = totalMiddle := + head.deterministic totalHead + subst totalMiddle + obtain ⟨suffixCount, countEq, suffix⟩ := + ih totalTail halted + exact ⟨suffixCount, by omega, suffix⟩ + +/-- Total runner with a control budget independent of `Machine.heapFuel`. -/ +def runMachine (context : Context) (interpretation : Interpretation) : + Nat → Machine → Except Error Result + | controlFuel, { store, heapFuel, control := .halted value } => + let result : Result := + { store := store + value := value + controlRemaining := controlFuel + heapRemaining := heapFuel } + .ok result + | 0, { store := _, heapFuel := _, control := .running .. } => + .error .controlFuel + | controlFuel + 1, + machine@{ store := _, heapFuel := _, control := .running .. } => do + let machine ← step context interpretation machine + runMachine context interpretation controlFuel machine + +/-- Exact machine state from which `runFunction` starts after its entry checks +succeed. Keeping this constructor public lets compiler simulations connect a +certified entry block to the finite-step runner without unfolding private +evaluator helpers. -/ +def initialMachine (definition : Function) (arguments : Array RVal) + (heapFuel : Nat) (store : Store := {}) : Machine := + { store := store.withPeak + heapFuel + control := .running { definition, values := arguments } [] } + +/-- A fresh initial machine has the literal empty target store; peak tracking +does not perturb it. -/ +@[simp] theorem initialMachine_store_empty (definition : Function) + (arguments : Array RVal) (heapFuel : Nat) : + (initialMachine definition arguments heapFuel).store = ({} : Store) := by + rfl + +def runFunction (context : Context) (interpretation : Interpretation) + (definition : Function) (arguments : Array RVal) (controlFuel heapFuel : Nat) + (store : Store := {}) : Except Error Result := do + let frame ← enterFunction definition arguments + runMachine context interpretation controlFuel + { store := store.withPeak, heapFuel, control := .running frame [] } + +/-- Public reduction of a successful function-entry check to the exact +initial machine. -/ +theorem runFunction_eq_runMachine {context : Context} + {interpretation : Interpretation} {definition : Function} + {arguments : Array RVal} {controlFuel heapFuel : Nat} {store : Store} + (arity : arguments.size = definition.signature.params.size) + (nonempty : definition.blocks.isEmpty = false) : + runFunction context interpretation definition arguments controlFuel + heapFuel store = + runMachine context interpretation controlFuel + (initialMachine definition arguments heapFuel store) := by + simp [runFunction, initialMachine, enterFunction, arity, nonempty] + rfl + +def runMain (context : Context) (interpretation : Interpretation) + (program : Program) (controlFuel : Nat := 100000) + (heapFuel : Nat := 100000) : Except Error Result := + runFunction context interpretation program.main #[] controlFuel heapFuel + +/-- Public main-entry specialization of `runFunction_eq_runMachine`. -/ +theorem runMain_eq_runMachine {context : Context} + {interpretation : Interpretation} {program : Program} + {controlFuel heapFuel : Nat} + (arity : program.main.signature.params.size = 0) + (nonempty : program.main.blocks.isEmpty = false) : + runMain context interpretation program controlFuel heapFuel = + runMachine context interpretation controlFuel + (initialMachine program.main #[] heapFuel) := by + unfold runMain + apply runFunction_eq_runMachine + · simpa using arity.symm + · exact nonempty + +/-- Running a finite execution prefix spends exactly its step count from the +control budget and leaves evaluation of the suffix unchanged. -/ +theorem Steps.runMachine {context : Context} + {interpretation : Interpretation} {count controlFuel : Nat} + {before after : Machine} + (steps : Steps context interpretation count before after) : + Ix.Compiler.IxIR2.Eval.runMachine context interpretation + (count + controlFuel) before = + Ix.Compiler.IxIR2.Eval.runMachine context interpretation + controlFuel after := by + induction steps with + | refl => simp only [Nat.zero_add] + | @cons count before middle after frame stack running head tail ih => + rw [Nat.succ_add] + cases before with + | mk store heapFuel beforeControl => + simp only at running + subst beforeControl + simp only [Ix.Compiler.IxIR2.Eval.runMachine] + rw [head] + simp only [bind, Except.bind] + exact ih + +/-- A finite execution ending in a halt gives an exact successful runner +witness with no unused control fuel. -/ +theorem Steps.runMachine_halted {context : Context} + {interpretation : Interpretation} {count : Nat} + {before : Machine} {store : Store} {heapFuel : Nat} {value : RVal} + (steps : Steps context interpretation count before + { store, heapFuel, control := .halted value }) : + Ix.Compiler.IxIR2.Eval.runMachine context interpretation count before = + .ok + { store + value + controlRemaining := 0 + heapRemaining := heapFuel } := by + simpa [Ix.Compiler.IxIR2.Eval.runMachine] using + (steps.runMachine (controlFuel := 0)) + +/-- A successful runner exposes its exact finite execution and the unused +control budget. The execution stops at the reported halted store and value. -/ +theorem runMachine_steps {context : Context} {interpretation : Interpretation} + {controlFuel : Nat} {machine : Machine} {result : Result} + (run : runMachine context interpretation controlFuel machine = .ok result) : + ∃ count, + controlFuel = count + result.controlRemaining ∧ + Steps context interpretation count machine + { store := result.store + heapFuel := result.heapRemaining + control := .halted result.value } := by + induction controlFuel generalizing machine with + | zero => + rcases machine with ⟨store, heapFuel, control⟩ + cases control with + | halted value => + simp only [runMachine, Except.ok.injEq] at run + subst result + exact ⟨0, by simp, .refl _⟩ + | running frame stack => cases run + | succ controlFuel ih => + rcases machine with ⟨store, heapFuel, control⟩ + cases control with + | halted value => + simp only [runMachine, Except.ok.injEq] at run + subst result + exact ⟨0, by simp, .refl _⟩ + | running frame stack => + simp only [runMachine] at run + cases stepped : step context interpretation + { store, heapFuel, control := .running frame stack } with + | error error => simp [stepped, bind, Except.bind] at run + | ok next => + simp only [stepped, bind, Except.bind] at run + obtain ⟨count, budget, steps⟩ := ih run + exact ⟨count + 1, by omega, .cons rfl stepped steps⟩ + + +end Ix.Compiler.IxIR2.Eval diff --git a/Ix/Compiler/IxIR2/EvalCounter.lean b/Ix/Compiler/IxIR2/EvalCounter.lean new file mode 100644 index 000000000..6fae3ffc6 --- /dev/null +++ b/Ix/Compiler/IxIR2/EvalCounter.lean @@ -0,0 +1,273 @@ +import Ix.Compiler.IxIR1.Sim +import Ix.Compiler.IxIR2.Eval + +/-! +# IxIR₂ credit-counter algebra + +`CounterLaw` is the numeric projection of the logical/physical heap relation. +The local lemmas below cover every operation that can change the number of +present credits. They are intentionally independent of a particular CFG; +the later heap-isomorphism simulation composes these deltas along machine +steps. +-/ + +namespace Ix.Compiler.IxIR2.Eval + +/-! ## Credit-local heap relation -/ + +/-- Runtime credits agree in layout and presence. A present physical credit +additionally owns an actual empty in-bounds slot; the logical credit carries +layout only because its corresponding node has already been freed. -/ +inductive CreditIso (physical : Store) : Option Credit → Option Credit → Prop + | consumed : CreditIso physical none none + | absent (layout : LayoutId) : + CreditIso physical + (some { layout, presence := .absent }) + (some { layout, presence := .absent }) + | present (layout : LayoutId) (slot : Nat) + (reserved : (physical.heap.nodes)[slot]? = some none) : + CreditIso physical + (some { layout, presence := .present none }) + (some { layout, presence := .present (some slot) }) + +inductive CreditsIso (physical : Store) : + List (Option Credit) → List (Option Credit) → Prop + | nil : CreditsIso physical [] [] + | cons {logicalCredit physicalCredit logicalCredits physicalCredits} : + CreditIso physical logicalCredit physicalCredit → + CreditsIso physical logicalCredits physicalCredits → + CreditsIso physical (logicalCredit :: logicalCredits) + (physicalCredit :: physicalCredits) + +/-- Counter state plus the derived live-node observation. -/ +structure Snapshot where + counters : Counters + live : Nat + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +def Store.snapshot (store : Store) : Snapshot := + { counters := store.counters, live := store.live } + +/-- The advertised intermediate relation, extended with the reset observations +that both interpretations share. -/ +structure CounterLaw (logical physical : Snapshot) (presentCredits : Nat) : + Prop where + allocs : logical.counters.allocs = + physical.counters.allocs + physical.counters.reuses + frees : logical.counters.frees = + physical.counters.frees + physical.counters.reuses + presentCredits + rcops : logical.counters.rcops = physical.counters.rcops + live : logical.live = physical.live + resetAttempts : logical.counters.resetAttempts = + physical.counters.resetAttempts + hotResets : logical.counters.hotResets = physical.counters.hotResets + coldResets : logical.counters.coldResets = physical.counters.coldResets + +instance (logical physical : Snapshot) (presentCredits : Nat) : + Decidable (CounterLaw logical physical presentCredits) := + if allocs : logical.counters.allocs = + physical.counters.allocs + physical.counters.reuses then + if frees : logical.counters.frees = + physical.counters.frees + physical.counters.reuses + presentCredits then + if rcops : logical.counters.rcops = physical.counters.rcops then + if live : logical.live = physical.live then + if attempts : logical.counters.resetAttempts = + physical.counters.resetAttempts then + if hot : logical.counters.hotResets = physical.counters.hotResets then + if cold : logical.counters.coldResets = + physical.counters.coldResets then + isTrue ⟨allocs, frees, rcops, live, attempts, hot, cold⟩ + else isFalse fun relation => cold relation.coldResets + else isFalse fun relation => hot relation.hotResets + else isFalse fun relation => attempts relation.resetAttempts + else isFalse fun relation => live relation.live + else isFalse fun relation => rcops relation.rcops + else isFalse fun relation => frees relation.frees + else isFalse fun relation => allocs relation.allocs + +/-- The interface used by the later logical/physical step simulation: a live +heap bijection, pointwise credit authority, and the numeric counter law. -/ +structure CreditHeapIso (logical physical : Store) + (logicalCredits physicalCredits : Array (Option Credit)) where + heap : IxIR1.Sim.HeapIso logical.heap physical.heap + credits : CreditsIso physical logicalCredits.toList physicalCredits.toList + counters : CounterLaw logical.snapshot physical.snapshot + (creditPresentCount physicalCredits) + +namespace Snapshot + +def logicalTake (state : Snapshot) : Snapshot := + { state with + counters := { state.counters with frees := state.counters.frees + 1 } + live := state.live - 1 } + +def physicalTake (state : Snapshot) : Snapshot := + { state with live := state.live - 1 } + +def logicalHotReset (state : Snapshot) : Snapshot := + { logicalTake state with + counters := + { (logicalTake state).counters with + resetAttempts := state.counters.resetAttempts + 1 + hotResets := state.counters.hotResets + 1 } } + +def physicalHotReset (state : Snapshot) : Snapshot := + { physicalTake state with + counters := + { (physicalTake state).counters with + resetAttempts := state.counters.resetAttempts + 1 + hotResets := state.counters.hotResets + 1 } } + +def logicalReuse (state : Snapshot) : Snapshot := + { state with + counters := { state.counters with allocs := state.counters.allocs + 1 } + live := state.live + 1 } + +def physicalReuse (state : Snapshot) (payloadUnits : Nat) : Snapshot := + { state with + counters := + { state.counters with + reuses := state.counters.reuses + 1 + reusedPayloadUnits := state.counters.reusedPayloadUnits + payloadUnits } + live := state.live + 1 } + +def logicalDiscard (state : Snapshot) : Snapshot := state + +def physicalDiscard (state : Snapshot) : Snapshot := + { state with + counters := { state.counters with frees := state.counters.frees + 1 } } + +def freshAlloc (state : Snapshot) : Snapshot := + { state with + counters := { state.counters with allocs := state.counters.allocs + 1 } + live := state.live + 1 } + +def coldReset (state : Snapshot) (rcDelta : Nat) : Snapshot := + { state with + counters := + { state.counters with + rcops := state.counters.rcops + rcDelta + resetAttempts := state.counters.resetAttempts + 1 + coldResets := state.counters.coldResets + 1 } } + +end Snapshot + +namespace CounterLaw + +theorem empty : CounterLaw (default : Snapshot) (default : Snapshot) 0 := by + constructor <;> rfl + +theorem afterTake {logical physical : Snapshot} {presentCredits : Nat} + (relation : CounterLaw logical physical presentCredits) : + CounterLaw logical.logicalTake physical.physicalTake + (presentCredits + 1) := by + rcases relation with ⟨allocs, frees, rcops, live, attempts, hot, cold⟩ + constructor + · exact allocs + · simp only [Snapshot.logicalTake, Snapshot.physicalTake] + omega + · exact rcops + · simp only [Snapshot.logicalTake, Snapshot.physicalTake] + omega + · exact attempts + · exact hot + · exact cold + +theorem afterHotReset {logical physical : Snapshot} {presentCredits : Nat} + (relation : CounterLaw logical physical presentCredits) : + CounterLaw logical.logicalHotReset physical.physicalHotReset + (presentCredits + 1) := by + rcases relation with ⟨allocs, frees, rcops, live, attempts, hot, cold⟩ + constructor + · exact allocs + · simp only [Snapshot.logicalHotReset, Snapshot.physicalHotReset, + Snapshot.logicalTake, Snapshot.physicalTake] + omega + · exact rcops + · simp only [Snapshot.logicalHotReset, Snapshot.physicalHotReset, + Snapshot.logicalTake, Snapshot.physicalTake] + omega + · simp only [Snapshot.logicalHotReset, Snapshot.physicalHotReset, + Snapshot.logicalTake, Snapshot.physicalTake] + omega + · simp only [Snapshot.logicalHotReset, Snapshot.physicalHotReset, + Snapshot.logicalTake, Snapshot.physicalTake] + omega + · exact cold + +theorem afterReuse {logical physical : Snapshot} {presentCredits : Nat} + (payloadUnits : Nat) + (relation : CounterLaw logical physical (presentCredits + 1)) : + CounterLaw logical.logicalReuse (physical.physicalReuse payloadUnits) + presentCredits := by + rcases relation with ⟨allocs, frees, rcops, live, attempts, hot, cold⟩ + constructor + · simp only [Snapshot.logicalReuse, Snapshot.physicalReuse] + omega + · simp only [Snapshot.logicalReuse, Snapshot.physicalReuse] + omega + · exact rcops + · simp only [Snapshot.logicalReuse, Snapshot.physicalReuse] + omega + · exact attempts + · exact hot + · exact cold + +theorem afterDiscard {logical physical : Snapshot} {presentCredits : Nat} + (relation : CounterLaw logical physical (presentCredits + 1)) : + CounterLaw logical.logicalDiscard physical.physicalDiscard + presentCredits := by + rcases relation with ⟨allocs, frees, rcops, live, attempts, hot, cold⟩ + constructor + · exact allocs + · simp only [Snapshot.logicalDiscard, Snapshot.physicalDiscard] + omega + · exact rcops + · exact live + · exact attempts + · exact hot + · exact cold + +theorem afterFreshAlloc {logical physical : Snapshot} {presentCredits : Nat} + (relation : CounterLaw logical physical presentCredits) : + CounterLaw logical.freshAlloc physical.freshAlloc presentCredits := by + rcases relation with ⟨allocs, frees, rcops, live, attempts, hot, cold⟩ + constructor + · simp only [Snapshot.freshAlloc] + omega + · simpa only [Snapshot.freshAlloc] using frees + · exact rcops + · simp only [Snapshot.freshAlloc] + omega + · exact attempts + · exact hot + · exact cold + +theorem afterColdReset {logical physical : Snapshot} {presentCredits rcDelta : Nat} + (relation : CounterLaw logical physical presentCredits) : + CounterLaw (logical.coldReset rcDelta) (physical.coldReset rcDelta) + presentCredits := by + rcases relation with ⟨allocs, frees, rcops, live, attempts, hot, cold⟩ + constructor + · exact allocs + · exact frees + · simp only [Snapshot.coldReset] + omega + · exact live + · simp only [Snapshot.coldReset] + omega + · exact hot + · simp only [Snapshot.coldReset] + omega + +/-- At a validated terminal state there are no present credits, yielding the +terminal free equation directly. -/ +theorem terminalFrees {logical physical : Snapshot} + (relation : CounterLaw logical physical 0) : + logical.counters.frees = + physical.counters.frees + physical.counters.reuses := by + simpa using relation.frees + +end CounterLaw + +end Ix.Compiler.IxIR2.Eval diff --git a/Ix/Compiler/IxIR2/EvalExamples.lean b/Ix/Compiler/IxIR2/EvalExamples.lean new file mode 100644 index 000000000..6705618ee --- /dev/null +++ b/Ix/Compiler/IxIR2/EvalExamples.lean @@ -0,0 +1,388 @@ +import Ix.Compiler.IxIR2.EvalCounter + +/-! +# Executable IxIR₂ logical/physical witnesses + +The fixtures run the same validated programs under both interpretations. They +pin the intermediate present-credit equation, terminal reuse/discard laws, +hot and cold reset decisions, and the separation of control from recursive +heap-traversal fuel. +-/ + +namespace Ix.Compiler.IxIR2.Eval.Examples + +open Ix.Compiler.Ixon (Address Owned) +open Ix.Compiler.IxIR2 + +private def blockAddress : Address := Address.replicate 0x61 +private def layout : LayoutId := Address.replicate 0x62 +private def functionAddress : Address := Address.replicate 0x63 + +private def nodeCtor : CtorId := + { block := blockAddress, indIdx := 0, cidx := 0 } + +private def schemas : Owned → CtorId → Option CtorSchema + | .unique, cid => + if cid == nodeCtor then + some { layout, fields := #[.unique] } + else + none + | .shared, cid => + if cid == nodeCtor then + some { layout, fields := #[.shared] } + else + none + +private def signature (result : Owned) : Signature := + { params := #[], result, papSafe := false } + +private def validationContext : Validate.Context := { schemas } + +private def validates (program : Program) : Bool := + match Validate.validate validationContext program with + | .ok _ => true + | .error _ => false + +private def run (interpretation : Interpretation) (program : Program) + (controlFuel : Nat := 100) (heapFuel : Nat := 100) : Except Error Result := + runMain (Context.ofProgram program schemas) interpretation program + controlFuel heapFuel + +private def lawHolds (logical physical : Store) (presentCredits : Nat) : Bool := + let left := logical.counters + let right := physical.counters + left.allocs == right.allocs + right.reuses && + left.frees == right.frees + right.reuses + presentCredits && + left.rcops == right.rcops && + logical.live == physical.live && + left.resetAttempts == right.resetAttempts && + left.hotResets == right.hotResets && + left.coldResets == right.coldResets + +private def returnedCtor (result : Result) : Option (CtorId × Array RVal) := + match result.value with + | .loc location => + match result.store.get? location with + | some { node := .ctorN cid fields, .. } => some (cid, fields) + | _ => none + | _ => none + +private def sameCtorResult (left right : Result) : Bool := + returnedCtor left == returnedCtor right + +/-! ## Unique required-credit reuse -/ + +private def uniqueReuse : Program := + { declarations := [] + main := + { signature := signature .unique + blocks := #[ + { valueParams := #[] + creditParams := #[] + instructions := #[ + .alloc .unique nodeCtor #[.lit (.nat 7)], + .takeUnique (.reg 0) nodeCtor, + .allocWith 0 .unique nodeCtor #[.reg 1]] + terminator := .ret (.reg 2) }] } } + +#guard validates uniqueReuse + +private def uniqueLogical := run .logical uniqueReuse 4 0 +private def uniquePhysical := run .physical uniqueReuse 4 0 + +#guard match uniqueLogical, uniquePhysical with + | .ok logical, .ok physical => + sameCtorResult logical physical && + logical.controlRemaining == 0 && physical.controlRemaining == 0 && + logical.heapRemaining == 0 && physical.heapRemaining == 0 && + logical.store.counters.allocs == 2 && + logical.store.counters.frees == 1 && + logical.store.counters.reuses == 0 && + physical.store.counters.allocs == 1 && + physical.store.counters.frees == 0 && + physical.store.counters.reuses == 1 && + physical.store.counters.reusedPayloadUnits == 1 && + lawHolds logical.store physical.store 0 + | _, _ => false + +/-! The state after `takeUnique` has one present credit and already satisfies +the intermediate equation. -/ + +private def initialMachine (program : Program) : Machine := + { heapFuel := 0 + control := .running { definition := program.main } [] } + +private def stepToTake (interpretation : Interpretation) : Except Error Machine := do + let context := Context.ofProgram uniqueReuse schemas + let first ← step context interpretation (initialMachine uniqueReuse) + step context interpretation first + +private def afterTakeLogical := stepToTake .logical +private def afterTakePhysical := stepToTake .physical + +#guard match afterTakeLogical, afterTakePhysical with + | .ok logical, .ok physical => + logical.presentCredits == 1 && physical.presentCredits == 1 && + logical.store.live == 0 && physical.store.live == 0 && + physical.store.live + physical.store.counters.frees + physical.presentCredits == + physical.store.counters.allocs && + lawHolds logical.store physical.store physical.presentCredits + | _, _ => false + +/-! ## Credit discard -/ + +private def uniqueDiscard : Program := + { declarations := [] + main := + { signature := signature .unique + blocks := #[ + { valueParams := #[] + creditParams := #[] + instructions := #[ + .alloc .unique nodeCtor #[.lit (.nat 9)], + .takeUnique (.reg 0) nodeCtor, + .discardCredit 0] + terminator := .ret (.reg 1) }] } } + +#guard validates uniqueDiscard + +#guard match run .logical uniqueDiscard 4 0, run .physical uniqueDiscard 4 0 with + | .ok logical, .ok physical => + logical.value == physical.value && + logical.store.counters.allocs == 1 && + physical.store.counters.allocs == 1 && + logical.store.counters.frees == 1 && + physical.store.counters.frees == 1 && + logical.store.counters.reuses == 0 && + physical.store.counters.reuses == 0 && + logical.store.live == 0 && physical.store.live == 0 && + lawHolds logical.store physical.store 0 + | _, _ => false + +/-! ## Hot shared reset and optional-credit branching -/ + +private def hotReset : Program := + { declarations := [] + main := + { signature := signature .shared + blocks := #[ + { valueParams := #[] + creditParams := #[] + instructions := #[ + .alloc .shared nodeCtor #[.lit (.nat 11)], + .resetShared (.reg 0) nodeCtor] + terminator := .branchCredit 0 + { target := 1, values := #[.reg 1], credits := #[0] } + { target := 2, values := #[.reg 1], credits := #[0] } }, + { valueParams := #[.owned .shared] + creditParams := #[.required layout] + instructions := #[.allocWith 0 .shared nodeCtor #[.reg 0]] + terminator := .ret (.reg 1) }, + { valueParams := #[.owned .shared] + creditParams := #[.optional layout] + instructions := #[.allocWith 0 .shared nodeCtor #[.reg 0]] + terminator := .ret (.reg 1) }] } } + +#guard validates hotReset + +#guard match run .logical hotReset 5 0, run .physical hotReset 5 0 with + | .ok logical, .ok physical => + sameCtorResult logical physical && + logical.store.counters.resetAttempts == 1 && + physical.store.counters.resetAttempts == 1 && + logical.store.counters.hotResets == 1 && + physical.store.counters.hotResets == 1 && + logical.store.counters.coldResets == 0 && + physical.store.counters.coldResets == 0 && + physical.store.counters.reuses == 1 && + lawHolds logical.store physical.store 0 + | _, _ => false + +/-! ## Cold shared reset -/ + +private def coldReset : Program := + { declarations := [] + main := + { signature := signature .shared + blocks := #[ + { valueParams := #[] + creditParams := #[] + instructions := #[ + .alloc .shared nodeCtor #[.lit (.nat 13)], + .retainShared (.reg 0), + .resetShared (.reg 0) nodeCtor] + terminator := .branchCredit 0 + { target := 1, values := #[.reg 1, .reg 2], credits := #[0] } + { target := 2, values := #[.reg 1, .reg 2], credits := #[0] } }, + { valueParams := #[.owned .shared, .owned .shared] + creditParams := #[.required layout] + instructions := #[ + .allocWith 0 .shared nodeCtor #[.reg 1], + .releaseShared (.reg 0)] + terminator := .ret (.reg 2) }, + { valueParams := #[.owned .shared, .owned .shared] + creditParams := #[.optional layout] + instructions := #[ + .allocWith 0 .shared nodeCtor #[.reg 1], + .releaseShared (.reg 0)] + terminator := .ret (.reg 2) }] } } + +#guard validates coldReset + +#guard match run .logical coldReset 7 2, run .physical coldReset 7 2 with + | .ok logical, .ok physical => + sameCtorResult logical physical && + logical.store.counters.resetAttempts == 1 && + physical.store.counters.resetAttempts == 1 && + logical.store.counters.hotResets == 0 && + physical.store.counters.hotResets == 0 && + logical.store.counters.coldResets == 1 && + physical.store.counters.coldResets == 1 && + logical.store.counters.rcops == 3 && + physical.store.counters.rcops == 3 && + logical.heapRemaining == 0 && physical.heapRemaining == 0 && + physical.store.counters.reuses == 0 && + lawHolds logical.store physical.store 0 + | _, _ => false + +/-! Heap traversal cannot steal control fuel, and control exhaustion is +reported independently of abundant heap fuel. -/ + +#guard match run .physical coldReset 7 1 with + | .error .heapFuel => true + | _ => false + +#guard match run .physical coldReset 6 100 with + | .error .controlFuel => true + | _ => false + +/-! ## Explicit call-stack/PAP execution -/ + +private def papIdentity : Function := + { signature := + { params := #[{ world := .shared, passing := .owned }] + result := .shared + papSafe := true } + blocks := #[ + { valueParams := #[.owned .shared] + creditParams := #[] + instructions := #[] + terminator := .ret (.reg 0) }] } + +private def papApply : Program := + { declarations := [(functionAddress, .fn papIdentity)] + main := + { signature := signature .shared + blocks := #[ + { valueParams := #[] + creditParams := #[] + instructions := #[ + .alloc .shared nodeCtor #[.lit (.nat 17)], + .papp functionAddress #[], + .apply (.reg 1) #[.reg 0]] + terminator := .ret (.reg 2) }] } } + +#guard validates papApply + +#guard match run .logical papApply 5 1, run .physical papApply 5 1 with + | .ok logical, .ok physical => + sameCtorResult logical physical && + logical.controlRemaining == 0 && physical.controlRemaining == 0 && + logical.heapRemaining == 0 && physical.heapRemaining == 0 && + logical.store.counters.allocs == 2 && + physical.store.counters.allocs == 2 && + logical.store.counters.frees == 1 && + physical.store.counters.frees == 1 && + logical.store.counters.rcops == 1 && + physical.store.counters.rcops == 1 && + lawHolds logical.store physical.store 0 + | _, _ => false + +private def papFirst : Function := + { signature := + { params := #[ + { world := .shared, passing := .owned }, + { world := .shared, passing := .owned }] + result := .shared + papSafe := true } + blocks := #[ + { valueParams := #[.owned .shared, .owned .shared] + creditParams := #[] + instructions := #[.releaseShared (.reg 1)] + terminator := .ret (.reg 0) }] } + +/-- Applying one argument to an empty binary PAP must take the under-saturated +branch and allocate a longer PAP before the second application saturates it. -/ +private def papUnderApply : Program := + { declarations := [(functionAddress, .fn papFirst)] + main := + { signature := signature .shared + blocks := #[ + { valueParams := #[] + creditParams := #[] + instructions := #[ + .alloc .shared nodeCtor #[.lit (.nat 17)], + .alloc .shared nodeCtor #[.lit (.nat 23)], + .papp functionAddress #[], + .apply (.reg 2) #[.reg 0], + .apply (.reg 3) #[.reg 1]] + terminator := .ret (.reg 4) }] } } + +#guard validates papUnderApply + +#guard match run .logical papUnderApply 8 5, + run .physical papUnderApply 8 5 with + | .ok logical, .ok physical => + sameCtorResult logical physical && + returnedCtor logical == some (nodeCtor, #[.lit (.nat 17)]) && + logical.controlRemaining == 0 && physical.controlRemaining == 0 && + logical.heapRemaining == 0 && physical.heapRemaining == 0 && + logical.store.counters.allocs == 4 && + physical.store.counters.allocs == 4 && + logical.store.counters.frees == 3 && + physical.store.counters.frees == 3 && + logical.store.counters.rcops == 5 && + physical.store.counters.rcops == 5 && + logical.store.peakLiveNodes == 3 && + physical.store.peakLiveNodes == 3 && + lawHolds logical.store physical.store 0 + | _, _ => false + +/-- Over-applying an identity PAP to another identity PAP and a constructor +forces the first callee return through `applyMore`, which then saturates the +returned PAP with the residual constructor owner. -/ +private def papOverApply : Program := + { declarations := [(functionAddress, .fn papIdentity)] + main := + { signature := signature .shared + blocks := #[ + { valueParams := #[] + creditParams := #[] + instructions := #[ + .alloc .shared nodeCtor #[.lit (.nat 31)], + .papp functionAddress #[], + .papp functionAddress #[], + .apply (.reg 2) #[.reg 1, .reg 0]] + terminator := .ret (.reg 3) }] } } + +#guard validates papOverApply + +#guard match run .logical papOverApply 7 2, + run .physical papOverApply 7 2 with + | .ok logical, .ok physical => + sameCtorResult logical physical && + returnedCtor logical == some (nodeCtor, #[.lit (.nat 31)]) && + logical.controlRemaining == 0 && physical.controlRemaining == 0 && + logical.heapRemaining == 0 && physical.heapRemaining == 0 && + logical.store.counters.allocs == 3 && + physical.store.counters.allocs == 3 && + logical.store.counters.frees == 2 && + physical.store.counters.frees == 2 && + logical.store.counters.rcops == 2 && + physical.store.counters.rcops == 2 && + logical.store.peakLiveNodes == 3 && + physical.store.peakLiveNodes == 3 && + lawHolds logical.store physical.store 0 + | _, _ => false + +end Ix.Compiler.IxIR2.Eval.Examples diff --git a/Ix/Compiler/IxIR2/EvalFuel.lean b/Ix/Compiler/IxIR2/EvalFuel.lean new file mode 100644 index 000000000..a3e467f53 --- /dev/null +++ b/Ix/Compiler/IxIR2/EvalFuel.lean @@ -0,0 +1,205 @@ +import Ix.Compiler.IxIR2.Eval + +/-! Successful executions have budget-independent values and heaps. Extra +heap fuel is carried through each step unchanged, then deterministic finite +execution compares runs with a common initial budget. -/ + +namespace Ix.Compiler.IxIR2.Eval + +theorem releaseSharedWork_addFuel {fuel : Nat} {store output : Store} + {values : List RVal} {remaining : Nat} + (run : releaseSharedWork fuel store values = .ok (output, remaining)) + (extra : Nat) : + releaseSharedWork (fuel + extra) store values = .ok (output, remaining + extra) := by + induction fuel generalizing store values output remaining with + | zero => + cases values with + | nil => + simp [releaseSharedWork] at run + obtain ⟨rfl, rfl⟩ := run + simp [releaseSharedWork] + | cons => simp [releaseSharedWork] at run + | succ fuel ih => + cases values with + | nil => + simp [releaseSharedWork] at run + obtain ⟨rfl, rfl⟩ := run + simp [releaseSharedWork] + | cons value values => + cases value with + | lit literal => + simpa [releaseSharedWork, Nat.succ_add] using ih run + | erased => + simpa [releaseSharedWork, Nat.succ_add] using ih run + | loc location => + cases found : store.get? location with + | none => simp [releaseSharedWork, found] at run + | some box => + cases world : box.world with + | unique => simp [releaseSharedWork, found, world] at run + | shared => + by_cases zero : box.rc = 0 + · simp [releaseSharedWork, found, world, zero] at run + · by_cases unit : box.rc = 1 + · cases node : box.node with + | ctorN cid fields => + simp [releaseSharedWork, Nat.succ_add, found, world, + unit, node] at run ⊢ + exact ih run + | papN address arity arguments => + simp [releaseSharedWork, Nat.succ_add, found, world, + unit, node] at run ⊢ + exact ih run + · simp [releaseSharedWork, Nat.succ_add, found, world, + zero, unit] at run ⊢ + exact ih run + +theorem dropUniqueWork_addFuel {fuel : Nat} {store output : Store} + {values : List RVal} {remaining : Nat} + (run : dropUniqueWork fuel store values = .ok (output, remaining)) + (extra : Nat) : + dropUniqueWork (fuel + extra) store values = .ok (output, remaining + extra) := by + induction fuel generalizing store values output remaining with + | zero => + cases values with + | nil => + simp [dropUniqueWork] at run + obtain ⟨rfl, rfl⟩ := run + simp [dropUniqueWork] + | cons => simp [dropUniqueWork] at run + | succ fuel ih => + cases values with + | nil => + simp [dropUniqueWork] at run + obtain ⟨rfl, rfl⟩ := run + simp [dropUniqueWork] + | cons value values => + cases value with + | lit literal => + simpa [dropUniqueWork, Nat.succ_add] using ih run + | erased => + simpa [dropUniqueWork, Nat.succ_add] using ih run + | loc location => + cases found : store.get? location with + | none => simp [dropUniqueWork, found] at run + | some box => + cases world : box.world with + | shared => simp [dropUniqueWork, found, world] at run + | unique => + cases node : box.node with + | papN => simp [dropUniqueWork, found, world, node] at run + | ctorN cid fields => + simp [dropUniqueWork, Nat.succ_add, found, world, node] at run ⊢ + exact ih run + +def Machine.addHeapFuel (machine : Machine) (extra : Nat) : Machine := + { machine with heapFuel := machine.heapFuel + extra } + +theorem ApplyTransfer.addHeapFuel {context : Context} {interpretation : Interpretation} + {store : Store} {heapFuel : Nat} {function : RVal} {arguments : Array RVal} + {resume : Frame} {stack : List Continuation} {target : Machine} + (transferred : ApplyTransfer context interpretation store heapFuel function + arguments resume stack target) (extra : Nat) : + ApplyTransfer context interpretation store (heapFuel + extra) function + arguments resume stack (target.addHeapFuel extra) := by + cases transferred.classify with + | erased released => + exact (ApplyTransferCase.erased (releaseSharedWork_addFuel released extra)).transfer + | papUnder a b c d e released g => + exact (ApplyTransferCase.papUnder a b c d e + (releaseSharedWork_addFuel released extra) g).transfer + | papFn a b c d e released g h i j k => + exact (ApplyTransferCase.papFn a b c d e + (releaseSharedWork_addFuel released extra) g h i j k).transfer + | papExtern a b c d e released g h i j k => + exact (ApplyTransferCase.papExtern a b c d e + (releaseSharedWork_addFuel released extra) g h i j k).transfer + +private theorem instructionAddHeapFuel {context : Context} {interpretation : Interpretation} + {store : Store} {heapFuel : Nat} {frame : Frame} {stack : List Continuation} + {instruction : Instr} {target : Machine} + (classified : InstructionTransferCase context interpretation store heapFuel frame + stack instruction target) (extra : Nat) : + InstructionTransferCase context interpretation store (heapFuel + extra) frame + stack instruction (target.addHeapFuel extra) := by + cases classified <;> try (constructor <;> assumption) + case allocWithLogical a b c d e f g => exact .allocWithLogical a b c d e f g + case discardLogical a b c => exact .discardLogical a b c + case releaseShared resolved released => + exact .releaseShared resolved (releaseSharedWork_addFuel released extra) + case dropUnique resolved dropped => + exact .dropUnique resolved (dropUniqueWork_addFuel dropped extra) + case apply a b c transferred => exact .apply a b c (transferred.addHeapFuel extra) + +private theorem terminatorAddHeapFuel {context : Context} {interpretation : Interpretation} + {store : Store} {heapFuel : Nat} {frame : Frame} {stack : List Continuation} + {terminator : Terminator} {target : Machine} + (classified : TerminatorTransferCase context interpretation store heapFuel frame + stack terminator target) (extra : Nat) : + TerminatorTransferCase context interpretation store (heapFuel + extra) frame + stack terminator (target.addHeapFuel extra) := by + cases classified with + | jump h => exact .jump h + | switchCtor a b c d e => exact .switchCtor a b c d e + | switchNatZero a b => exact .switchNatZero a b + | switchNatSucc a b => exact .switchNatSucc a b + | branchPresent a b c => exact .branchPresent a b c + | branchAbsent a b c => exact .branchAbsent a b c + | retResume a b c => exact .retResume a b c + | retHalt a b c => exact .retHalt a b c + | retApplyMore a b c d => exact .retApplyMore a b c (d.addHeapFuel extra) + | tailCallFn a b c d e => exact .tailCallFn a b c d e + | tailCallSelf a b c d => exact .tailCallSelf a b c d + +theorem Step.addHeapFuel {context : Context} {interpretation : Interpretation} + {before after : Machine} (stepped : Step context interpretation before after) + (extra : Nat) : + Step context interpretation (before.addHeapFuel extra) (after.addHeapFuel extra) := by + cases stepped.classify with + | halted => rfl + | instruction a b c classified => exact (instructionAddHeapFuel classified extra).step a b c + | terminator a b c classified => exact (terminatorAddHeapFuel classified extra).step a b c + +theorem Steps.addHeapFuel {context : Context} {interpretation : Interpretation} + {count : Nat} {before after : Machine} + (steps : Steps context interpretation count before after) (extra : Nat) : + Steps context interpretation count (before.addHeapFuel extra) (after.addHeapFuel extra) := by + induction steps with + | refl => exact .refl _ + | cons running head tail ih => exact .cons running (head.addHeapFuel extra) ih + +theorem Steps.halted_unique {context : Context} {interpretation : Interpretation} + {leftCount rightCount : Nat} {before : Machine} + {leftStore rightStore : Store} {leftFuel rightFuel : Nat} {leftValue rightValue : RVal} + (left : Steps context interpretation leftCount before + { store := leftStore, heapFuel := leftFuel, control := .halted leftValue }) + (right : Steps context interpretation rightCount before + { store := rightStore, heapFuel := rightFuel, control := .halted rightValue }) : + leftCount = rightCount ∧ leftStore = rightStore ∧ leftFuel = rightFuel ∧ leftValue = rightValue := by + obtain ⟨count, budget, suffix⟩ := left.cancelPrefixToHalted right rfl + cases suffix with + | refl => exact ⟨by omega, rfl, rfl, rfl⟩ + | cons running => contradiction + +/-- Any two successful main runs of the same program and interpretation +return the same value and complete store, even with different budgets. -/ +theorem runMain_success_unique {source : Program} {context : Context} + {interpretation : Interpretation} {leftControl rightControl leftHeap rightHeap : Nat} + {left right : Result} (arity : source.main.signature.params.size = 0) + (nonempty : source.main.blocks.isEmpty = false) + (leftRun : runMain context interpretation source leftControl leftHeap = .ok left) + (rightRun : runMain context interpretation source rightControl rightHeap = .ok right) : + left.store = right.store ∧ left.value = right.value := by + rw [runMain_eq_runMachine arity nonempty] at leftRun rightRun + obtain ⟨leftCount, _, leftSteps⟩ := runMachine_steps leftRun + obtain ⟨rightCount, _, rightSteps⟩ := runMachine_steps rightRun + have leftFunded := leftSteps.addHeapFuel rightHeap + have rightFunded := rightSteps.addHeapFuel leftHeap + have common : (initialMachine source.main #[] rightHeap).addHeapFuel leftHeap = + (initialMachine source.main #[] leftHeap).addHeapFuel rightHeap := by + simp [initialMachine, Machine.addHeapFuel, Nat.add_comm] + rw [common] at rightFunded + obtain ⟨_, stores, _, values⟩ := leftFunded.halted_unique rightFunded + exact ⟨stores, values⟩ + +end Ix.Compiler.IxIR2.Eval diff --git a/Ix/Compiler/IxIR2/HeapAccounting.lean b/Ix/Compiler/IxIR2/HeapAccounting.lean new file mode 100644 index 000000000..8f13b2c31 --- /dev/null +++ b/Ix/Compiler/IxIR2/HeapAccounting.lean @@ -0,0 +1,361 @@ +import Ix.Compiler.IxIR2.Eval +import Ix.Compiler.IxIR1.Reclamation +import Init.Data.Array.Count + +/-! +# Allocation accounting for physical heap operations + +A reserved slot is absent from the live-node array but has not been freed. +The machine accounting theorem adds its live credit to the heap balance. +These lemmas describe actual successful heap operations, independently of +the semantic heap relation and of any optimization savings claim. +-/ + +namespace Ix.Compiler.IxIR2.Eval + +open Ix.Compiler.Ixon (Owned) +open Ix.Compiler.IxIR1 (Node NodeBox RVal) + +private theorem foldl_countP {α : Type} (p : α → Bool) (values : List α) + (initial : Nat) : + values.foldl (fun total value => if p value then total + 1 else total) initial = + initial + values.countP p := by + induction values generalizing initial with + | nil => simp + | cons value rest ih => + simp only [List.foldl_cons, List.countP_cons, ih] + split <;> omega + +theorem Store.live_eq_countP (store : Store) : + store.live = store.heap.nodes.countP Option.isSome := by + rw [Store.live, IxIR1.Store.live, ← Array.foldl_toList, foldl_countP] + simp + +private theorem countP_update {α : Type} {values : Array α} {index : Nat} + {old new : α} (p : α → Bool) (found : values[index]? = some old) : + (values.setIfInBounds index new).countP p + (if p old then 1 else 0) = + values.countP p + (if p new then 1 else 0) := by + have bound : index < values.size := (Array.getElem?_eq_some_iff.mp found).1 + have atIndex : values[index] = old := (Array.getElem?_eq_some_iff.mp found).2 + have lower := Array.boole_getElem_le_countP (p := p) bound + rw [atIndex] at lower + simp only [Array.setIfInBounds, bound, ↓reduceDIte, Array.countP_set, atIndex] + omega + +theorem Store.live_setBox {store : Store} {location : Nat} {old new : NodeBox} + (found : store.get? location = some old) : + (store.setBox location new).live = store.live := by + have slot : store.heap.nodes[location]? = some (some old) := + IxIR1.Sim.nodes_get?_of_get? found + have update := countP_update (new := some new) Option.isSome slot + simpa [Store.live_eq_countP, Store.setBox, IxIR1.Store.setBox] using update + +theorem Store.live_reserve {store : Store} {location : Nat} {box : NodeBox} + (found : store.get? location = some box) : + (store.reserve location).live + 1 = store.live := by + have slot : store.heap.nodes[location]? = some (some box) := + IxIR1.Sim.nodes_get?_of_get? found + simpa [Store.live_eq_countP, Store.reserve] using + (countP_update (new := none) Option.isSome slot) + +theorem Store.live_kill {store : Store} {location : Nat} {box : NodeBox} + (found : store.get? location = some box) : + (store.kill location).live + 1 = store.live := by + simpa [Store.live_eq_countP, Store.kill, IxIR1.Store.kill, Store.reserve] using + Store.live_reserve found + +theorem Store.live_allocNode (store : Store) (world : Owned) (node : Node) : + (store.allocNode world node).1.live = store.live + 1 := by + simp [Store.live_eq_countP, IxIR1.Store.allocNode] + +/-- Ordinary heap operations preserve live nodes plus completed frees, +relative to fresh allocations. This relation permits different RC counters. -/ +def HeapBalance (before after : Store) : Prop := + after.live + after.heap.frees + before.heap.allocs = + before.live + before.heap.frees + after.heap.allocs + +namespace HeapBalance + +theorem refl (store : Store) : HeapBalance store store := rfl + +theorem trans {first second third : Store} + (left : HeapBalance first second) (right : HeapBalance second third) : + HeapBalance first third := by + unfold HeapBalance at * + omega + +theorem allocNode (store : Store) (world : Owned) (node : Node) : + HeapBalance store (store.allocNode world node).1 := by + unfold HeapBalance + rw [Store.live_allocNode] + simp only [Store.allocNode_heap, IxIR1.Store.allocNode] + omega + +theorem setBox {store : Store} {location : Nat} {old new : NodeBox} + (found : store.get? location = some old) : + HeapBalance store (store.setBox location new) := by + unfold HeapBalance + rw [Store.live_setBox found] + rfl + +theorem kill {store : Store} {location : Nat} {box : NodeBox} + (found : store.get? location = some box) : + HeapBalance store (store.kill location) := by + have live := Store.live_kill found + unfold HeapBalance + simp only [Store.kill_heap, IxIR1.Store.kill] + omega + +theorem rcTick (store : Store) : HeapBalance store store.rcTick := rfl + +end HeapBalance + +theorem retainShared_heapBalance {store output : Store} {value : RVal} + (run : retainShared store value = .ok output) : HeapBalance store output := by + cases value with + | lit literal => cases run; exact .refl _ + | erased => cases run; exact .refl _ + | loc location => + cases found : store.get? location with + | none => simp [retainShared, found] at run + | some box => + by_cases shared : box.world = .shared + · simp [retainShared, found, shared] at run + subst output + exact (HeapBalance.setBox found).trans (.rcTick _) + · simp [retainShared, found, shared] at run + +theorem RetainSharedMany.heapBalance {store output : Store} {values : Array RVal} + (run : RetainSharedMany store values output) : HeapBalance store output := by + change values.foldlM retainShared store = .ok output at run + rw [← Array.foldlM_toList] at run + have loop : ∀ (values : List RVal) {store output : Store}, + values.foldlM retainShared store = .ok output → HeapBalance store output := by + intro values + induction values with + | nil => intro store output run; cases run; exact .refl _ + | cons value rest ih => + intro store output run + rw [List.foldlM_cons] at run + cases head : retainShared store value with + | error error => simp [head, bind, Except.bind] at run + | ok middle => + simp only [head, bind, Except.bind] at run + exact (retainShared_heapBalance head).trans (ih run) + exact loop values.toList run + +theorem releaseSharedWork_heapBalance {fuel remaining : Nat} {store output : Store} + {values : List RVal} + (run : releaseSharedWork fuel store values = .ok (output, remaining)) : + HeapBalance store output := by + induction fuel generalizing store values with + | zero => + cases values with + | nil => cases run; exact .refl _ + | cons value rest => simp [releaseSharedWork] at run + | succ fuel ih => + cases values with + | nil => cases run; exact .refl _ + | cons value rest => + cases value with + | lit literal => exact ih run + | erased => exact ih run + | loc location => + cases found : store.get? location with + | none => simp [releaseSharedWork, found] at run + | some box => + by_cases shared : box.world = .shared + · by_cases zero : box.rc = 0 + · simp [releaseSharedWork, found, shared, zero] at run + · by_cases unitRC : box.rc = 1 + · simp only [releaseSharedWork, found, shared, bne_self_eq_false, + Bool.false_eq_true, ↓reduceIte, unitRC, beq_self_eq_true] at run + have tickAt : store.rcTick.get? location = some box := found + exact (HeapBalance.rcTick store).trans + ((HeapBalance.kill tickAt).trans (ih run)) + · simp [releaseSharedWork, found, shared, zero, unitRC] at run + have tickAt : store.rcTick.get? location = some box := found + exact (HeapBalance.rcTick store).trans + ((HeapBalance.setBox tickAt).trans (ih run)) + · simp [releaseSharedWork, found, shared] at run + +theorem releaseShared_heapBalance {fuel remaining : Nat} {store output : Store} + {value : RVal} (run : releaseShared fuel store value = .ok (output, remaining)) : + HeapBalance store output := releaseSharedWork_heapBalance run + +theorem dropUniqueWork_heapBalance {fuel remaining : Nat} {store output : Store} + {values : List RVal} + (run : dropUniqueWork fuel store values = .ok (output, remaining)) : + HeapBalance store output := by + induction fuel generalizing store values with + | zero => + cases values with + | nil => cases run; exact .refl _ + | cons value rest => simp [dropUniqueWork] at run + | succ fuel ih => + cases values with + | nil => cases run; exact .refl _ + | cons value rest => + cases value with + | lit literal => exact ih run + | erased => exact ih run + | loc location => + cases found : store.get? location with + | none => simp [dropUniqueWork, found] at run + | some box => + by_cases unique : box.world = .unique + · cases node : box.node with + | papN address arity captured => simp [dropUniqueWork, found, unique, node] at run + | ctorN cid fields => + simp only [dropUniqueWork, found, unique, bne_self_eq_false, + Bool.false_eq_true, ↓reduceIte, node] at run + exact (HeapBalance.kill found).trans (ih run) + · simp [dropUniqueWork, found, unique] at run + +theorem dropUnique_heapBalance {fuel remaining : Nat} {store output : Store} + {value : RVal} (run : dropUnique fuel store value = .ok (output, remaining)) : + HeapBalance store output := dropUniqueWork_heapBalance run + +theorem Store.releaseReservation_accounting {store output : Store} {location : Nat} + (run : store.releaseReservation location = .ok output) : + output.live = store.live ∧ output.heap.allocs = store.heap.allocs ∧ + output.heap.frees = store.heap.frees + 1 := by + cases found : store.heap.nodes[location]? with + | none => simp [Store.releaseReservation, found] at run + | some slot => + cases slot with + | some box => simp [Store.releaseReservation, found] at run + | none => + simp only [Store.releaseReservation, found, Except.ok.injEq] at run + subst output + exact ⟨rfl, rfl, rfl⟩ + +theorem Store.reuseReservation_accounting {store output : Store} + {location payloadUnits : Nat} {world : Owned} {node : Node} + (run : store.reuseReservation location world node payloadUnits = .ok output) : + output.live = store.live + 1 ∧ output.heap.allocs = store.heap.allocs ∧ + output.heap.frees = store.heap.frees := by + cases found : store.heap.nodes[location]? with + | none => simp [Store.reuseReservation, found] at run + | some slot => + cases slot with + | some box => simp [Store.reuseReservation, found] at run + | none => + simp only [Store.reuseReservation, found, Except.ok.injEq] at run + subst output + refine ⟨?_, rfl, rfl⟩ + simpa [Store.live_eq_countP] using + (countP_update (new := some (NodeBox.mk world 1 node)) Option.isSome found) + +/-! ## Credits retained by frames and continuations -/ + +def Credit.weight (credit : Credit) : Nat := if credit.isPresent then 1 else 0 + +theorem Credit.weight_absent {credit : Credit} (absent : credit.presence = .absent) : + credit.weight = 0 := by + rcases credit with ⟨layout, presence⟩ + cases absent + rfl + +theorem Credit.weight_present {credit : Credit} {reservation : Option Nat} + (present : credit.presence = .present reservation) : credit.weight = 1 := by + rcases credit with ⟨layout, presence⟩ + cases present + rfl + +theorem creditPresentCount_eq_countP (credits : Array (Option Credit)) : + creditPresentCount credits = credits.countP (·.any Credit.isPresent) := by + have worker : (fun (total : Nat) (credit : Option Credit) => + match credit with + | some credit => if credit.isPresent then total + 1 else total + | none => total) = + (fun total credit => if credit.any Credit.isPresent then total + 1 else total) := by + funext total credit + cases credit <;> rfl + unfold creditPresentCount + calc + _ = credits.foldl + (fun total credit => if credit.any Credit.isPresent then total + 1 else total) 0 := + congrArg (fun f : Nat → Option Credit → Nat => credits.foldl f 0) worker + _ = _ := by + rw [← Array.foldl_toList, foldl_countP] + simp + +@[simp] theorem creditPresentCount_empty : creditPresentCount #[] = 0 := rfl + +@[simp] theorem creditPresentCount_push (credits : Array (Option Credit)) (credit : Credit) : + creditPresentCount (credits.push (some credit)) = + creditPresentCount credits + credit.weight := by + simp [creditPresentCount_eq_countP, ← Array.countP_toList, Credit.weight] + +theorem creditPresentCount_map_some (credits : Array Credit) : + creditPresentCount (credits.map some) = (credits.toList.map Credit.weight).sum := by + rw [creditPresentCount_eq_countP, ← Array.countP_toList] + simp only [Array.toList_map, List.countP_map] + have listCount : ∀ credits : List Credit, + credits.countP (fun credit => (some credit).any Credit.isPresent) = + (credits.map Credit.weight).sum := by + intro credits + induction credits with + | nil => rfl + | cons credit rest ih => + simp only [Option.any_some] at ih + simp [List.countP_cons, Credit.weight, ih, Nat.add_comm] + exact listCount credits.toList + +theorem CreditTake.presentCredits {frame target : Frame} {id : CreditId} + {credit : Credit} (taken : CreditTake frame id target credit) : + target.presentCredits + credit.weight = frame.presentCredits := by + obtain ⟨targetEq, found⟩ := taken.target_eq + rw [targetEq] + simpa [Frame.presentCredits, creditPresentCount_eq_countP, Credit.weight] using + (countP_update (new := none) (·.any Credit.isPresent) found) + +theorem CreditTakeSequence.presentCredits {frame target : Frame} + {ids : List CreditId} {credits : List Credit} + (taken : CreditTakeSequence frame ids target credits) : + target.presentCredits + (credits.map Credit.weight).sum = frame.presentCredits := by + induction taken with + | nil => simp + | cons head tail ih => + have first := head.presentCredits + simp only [List.map_cons, List.sum_cons] + omega + +theorem CreditTakeMany.presentCredits {frame target : Frame} + {ids : Array CreditId} {credits : Array Credit} + (taken : CreditTakeMany frame ids target credits) : + target.presentCredits + creditPresentCount (credits.map some) = frame.presentCredits := by + rw [creditPresentCount_map_some] + exact taken.sequence.presentCredits + +theorem NoLiveCredits.presentCredits {frame : Frame} (cleared : NoLiveCredits frame) : + frame.presentCredits = 0 := by + rw [Frame.presentCredits, creditPresentCount_eq_countP, Array.countP_eq_zero] + intro slot member + have absent := (Array.any_eq_false'.mp cleared) slot member + cases slot <;> simp_all + +theorem EdgeTransfer.presentCredits {frame target : Frame} {edge : Edge} + {implicitValues : Array RVal} (transfer : EdgeTransfer frame edge implicitValues target) : + target.presentCredits = frame.presentCredits := by + obtain ⟨values, credits, after, block, _, taken, cleared, _, _, _, targetEq⟩ := transfer.parts + have count := taken.presentCredits + rw [cleared.presentCredits, Nat.zero_add] at count + subst target + exact count + +private theorem foldl_weight {α : Type} (weight : α → Nat) (values : List α) (initial : Nat) : + values.foldl (fun total value => total + weight value) initial = + initial + (values.map weight).sum := by + induction values generalizing initial with + | nil => simp + | cons value rest ih => simp [ih, Nat.add_assoc] + +theorem Machine.presentCredits_running (store : Store) (heapFuel : Nat) + (frame : Frame) (stack : List Continuation) : + (Machine.mk store heapFuel (.running frame stack)).presentCredits = + frame.presentCredits + (stack.map Continuation.presentCredits).sum := by + simp [Machine.presentCredits, foldl_weight] + +end Ix.Compiler.IxIR2.Eval diff --git a/Ix/Compiler/IxIR2/Interpretation.lean b/Ix/Compiler/IxIR2/Interpretation.lean new file mode 100644 index 000000000..f9fdc2223 --- /dev/null +++ b/Ix/Compiler/IxIR2/Interpretation.lean @@ -0,0 +1,270 @@ +import Ix.Compiler.IxIR2.CreditFree +import Ix.Compiler.IxIR2.Eval + +/-! Exact interpretation independence for programs without credit operations. +Calls, recursive calls, edges, and residual PAP application preserve the +inventory of function bodies. No heap or fuel observation is weakened. -/ + +namespace Ix.Compiler.IxIR2.Eval + +theorem ApplyTransfer.interpretation {context : Context} + {first second : Interpretation} {store : Store} {heapFuel : Nat} + {function : RVal} {arguments : Array RVal} {resume : Frame} + {stack : List Continuation} {target : Machine} + (transferred : ApplyTransfer context first store heapFuel function + arguments resume stack target) : + ApplyTransfer context second store heapFuel function arguments resume + stack target := transferred + +theorem InstructionTransfer.interpretation {context : Context} + {first second : Interpretation} {store : Store} {heapFuel : Nat} + {frame : Frame} {stack : List Continuation} {instruction : Instr} + {target : Machine} (free : CreditFree.instruction instruction = true) + (transferred : InstructionTransfer context first store heapFuel frame + stack instruction target) : + InstructionTransfer context second store heapFuel frame stack + instruction target := by + cases instruction <;> first | exact transferred | contradiction + +theorem TerminatorTransfer.interpretation {context : Context} + {first second : Interpretation} {store : Store} {heapFuel : Nat} + {frame : Frame} {stack : List Continuation} {terminator : Terminator} + {target : Machine} + (transferred : TerminatorTransfer context first store heapFuel frame + stack terminator target) : + TerminatorTransfer context second store heapFuel frame stack + terminator target := transferred + +private theorem instructionCaseInterpretation {context : Context} + {first second : Interpretation} {store : Store} {heapFuel : Nat} + {frame : Frame} {stack : List Continuation} {instruction : Instr} + {target : Machine} (free : CreditFree.instruction instruction = true) + (classified : InstructionTransferCase context first store heapFuel frame + stack instruction target) : + InstructionTransferCase context second store heapFuel frame stack + instruction target := by + cases classified <;> try contradiction + all_goals first + | (constructor <;> assumption) + | (apply InstructionTransferCase.apply <;> first + | assumption + | (apply ApplyTransfer.interpretation; assumption)) + +private theorem terminatorCaseInterpretation {context : Context} + {first second : Interpretation} {store : Store} {heapFuel : Nat} + {frame : Frame} {stack : List Continuation} {terminator : Terminator} + {target : Machine} + (classified : TerminatorTransferCase context first store heapFuel frame + stack terminator target) : + TerminatorTransferCase context second store heapFuel frame stack + terminator target := by + cases classified with + | jump h => exact .jump h + | switchCtor a b c d e => exact .switchCtor a b c d e + | switchNatZero a b => exact .switchNatZero a b + | switchNatSucc a b => exact .switchNatSucc a b + | branchPresent a b c => exact .branchPresent a b c + | branchAbsent a b c => exact .branchAbsent a b c + | retResume a b c => exact .retResume a b c + | retHalt a b c => exact .retHalt a b c + | retApplyMore a b c d => exact .retApplyMore a b c d.interpretation + | tailCallFn a b c d e => exact .tailCallFn a b c d e + | tailCallSelf a b c d => exact .tailCallSelf a b c d + +private def continuationFunction : Continuation → Function + | .resume frame | .applyMore _ frame => frame.definition + +private def stackFunctions (predicate : Function → Prop) + (stack : List Continuation) : Prop := + ∀ continuation ∈ stack, predicate (continuationFunction continuation) + +private def machineFunctions (predicate : Function → Prop) + (machine : Machine) : Prop := + match machine.control with + | .halted _ => True + | .running frame stack => predicate frame.definition ∧ stackFunctions predicate stack + +private theorem applyFunctions {predicate : Function → Prop} + {context : Context} {interpretation : Interpretation} + (declarations : ∀ address definition, + context.declarations address = some (.fn definition) → predicate definition) + {store : Store} {heapFuel : Nat} {function : RVal} + {arguments : Array RVal} {resume : Frame} {stack : List Continuation} + {target : Machine} (caller : predicate resume.definition) + (saved : stackFunctions predicate stack) + (transferred : ApplyTransfer context interpretation store heapFuel + function arguments resume stack target) : machineFunctions predicate target := by + cases transferred.classify with + | erased | papUnder | papExtern => exact ⟨caller, saved⟩ + | papFn _ _ _ _ _ _ _ declaration _ _ _ => + refine ⟨declarations _ _ declaration, ?_⟩ + intro continuation member + simp only [List.mem_cons] at member + rcases member with equal | member + · subst continuation + split <;> exact caller + · exact saved _ member + +private theorem instructionFunctions {predicate : Function → Prop} + {context : Context} {interpretation : Interpretation} + (declarations : ∀ address definition, + context.declarations address = some (.fn definition) → predicate definition) + {store : Store} {heapFuel : Nat} {frame : Frame} + {stack : List Continuation} {instruction : Instr} {target : Machine} + (current : predicate frame.definition) (saved : stackFunctions predicate stack) + (free : CreditFree.instruction instruction = true) + (transferred : InstructionTransferCase context interpretation store heapFuel + frame stack instruction target) : machineFunctions predicate target := by + cases transferred <;> try contradiction + case apply transferred => + exact applyFunctions declarations + (resume := { frame with pc := frame.pc + 1 }) current saved transferred + all_goals first + | exact ⟨current, saved⟩ + | (refine ⟨?_, ?_⟩ + · first | exact current | exact declarations _ _ (by assumption) + · intro continuation member + rcases List.mem_cons.mp member with equal | member + · subst continuation; exact current + · exact saved _ member) + +private theorem terminatorFunctions {predicate : Function → Prop} + {context : Context} {interpretation : Interpretation} + (declarations : ∀ address definition, + context.declarations address = some (.fn definition) → predicate definition) + {store : Store} {heapFuel : Nat} {frame : Frame} + {stack : List Continuation} {terminator : Terminator} {target : Machine} + (current : predicate frame.definition) (saved : stackFunctions predicate stack) + (transferred : TerminatorTransferCase context interpretation store heapFuel + frame stack terminator target) : machineFunctions predicate target := by + cases transferred with + | jump edge | switchCtor _ _ _ _ edge | switchNatZero _ edge + | switchNatSucc _ edge | branchPresent _ _ edge | branchAbsent _ _ edge => + exact ⟨edge.definition.symm ▸ current, saved⟩ + | retResume => + exact ⟨saved _ (List.mem_cons_self), fun continuation member => + saved continuation (List.mem_cons_of_mem _ member)⟩ + | retHalt => trivial + | retApplyMore _ _ _ transferred => + exact applyFunctions declarations (saved _ List.mem_cons_self) + (fun continuation member => saved continuation (List.mem_cons_of_mem _ member)) + transferred + | tailCallFn _ _ declaration _ _ => exact ⟨declarations _ _ declaration, saved⟩ + | tailCallSelf => exact ⟨current, saved⟩ + +private theorem stepInterpretation {context : Context} + {first second : Interpretation} + (declarations : ∀ address definition, + context.declarations address = some (.fn definition) → + CreditFree.function definition = true) + {before after : Machine} + (free : machineFunctions (fun definition => CreditFree.function definition = true) before) + (stepped : Step context first before after) : + Step context second before after ∧ + machineFunctions (fun definition => CreditFree.function definition = true) after := by + cases stepped.classify with + | halted => exact ⟨rfl, trivial⟩ + | instruction blockAt pc instructionAt classified => + have instructionFree := CreditFree.instructionAt free.1 blockAt pc + rw [instructionAt] at instructionFree + refine ⟨?_, instructionFunctions declarations free.1 free.2 instructionFree classified⟩ + exact (instructionCaseInterpretation instructionFree classified).step + blockAt pc instructionAt + | terminator blockAt pc terminatorAt classified => + refine ⟨?_, terminatorFunctions declarations free.1 free.2 classified⟩ + exact (terminatorCaseInterpretation classified).step blockAt pc terminatorAt + +private theorem stepsInterpretation {context : Context} + {first second : Interpretation} + (declarations : ∀ address definition, + context.declarations address = some (.fn definition) → + CreditFree.function definition = true) + {count : Nat} {before after : Machine} + (free : machineFunctions (fun definition => CreditFree.function definition = true) before) + (steps : Steps context first count before after) : + Steps context second count before after := by + induction steps with + | refl => exact .refl _ + | cons running head tail ih => + obtain ⟨head, nextFree⟩ := stepInterpretation declarations free head + exact .cons running head (ih nextFree) + +/-- Change credit interpretation without changing any successful runner +observation, including both remaining budgets and every heap counter. -/ +theorem runMachine_creditFree {context : Context} {first second : Interpretation} + (declarations : ∀ address definition, + context.declarations address = some (.fn definition) → + CreditFree.function definition = true) + {definition : Function} (free : CreditFree.function definition = true) + {arguments : Array RVal} {store : Store} + {controlFuel heapFuel : Nat} {result : Result} + (run : runMachine context first controlFuel + (initialMachine definition arguments heapFuel store) = .ok result) : + runMachine context second controlFuel + (initialMachine definition arguments heapFuel store) = .ok result := by + obtain ⟨count, budget, steps⟩ := runMachine_steps run + have transported : Steps context second count + (initialMachine definition arguments heapFuel store) + { store := result.store, heapFuel := result.heapRemaining, + control := .halted result.value } := + stepsInterpretation declarations ⟨free, by simp [stackFunctions]⟩ steps + rw [budget, transported.runMachine] + cases result with + | mk store value controlRemaining heapRemaining => + cases controlRemaining <;> rfl + +private theorem programDeclarations {source : Program} + (free : CreditFree.program source = true) + {schemas : Ixon.Owned → CtorId → Option CtorSchema} + {oracle : Ixon.Address → List RVal → Option RVal} + (address : Ixon.Address) (definition : Function) + (found : (Context.ofProgram source schemas oracle).declarations address = + some (.fn definition)) : CreditFree.function definition = true := by + obtain ⟨entry, member, value⟩ := Option.map_eq_some_iff.mp found + simp only [CreditFree.program, Bool.and_eq_true] at free + have entryFree := List.all_eq_true.mp free.2 entry (List.mem_of_find?_eq_some member) + rw [value] at entryFree + exact entryFree + +/-- Declared runtime functions inherit the complete baseline interpretation +boundary, for arbitrary arguments and initial heaps. -/ +theorem runFunction_creditFree {source : Program} + (free : CreditFree.program source = true) + {schemas : Ixon.Owned → CtorId → Option CtorSchema} + {oracle : Ixon.Address → List RVal → Option RVal} + {address : Ixon.Address} {definition : Function} + (declared : (Context.ofProgram source schemas oracle).declarations address = some (.fn definition)) + {arguments : Array RVal} {store : Store} + {first second : Interpretation} {controlFuel heapFuel : Nat} {result : Result} + (arity : arguments.size = definition.signature.params.size) + (nonempty : definition.blocks.isEmpty = false) + (run : runFunction (Context.ofProgram source schemas oracle) first definition + arguments controlFuel heapFuel store = .ok result) : + runFunction (Context.ofProgram source schemas oracle) second definition + arguments controlFuel heapFuel store = .ok result := by + rw [runFunction_eq_runMachine arity nonempty] at run ⊢ + exact runMachine_creditFree (programDeclarations free) (programDeclarations free address definition declared) run + +/-- The complete credit-free main boundary. The same schemas and scalar +oracle are used on both sides; the validated compiler additionally closes +the extern boundary. -/ +theorem runMain_creditFree {source : Program} + (free : CreditFree.program source = true) + {schemas : Ixon.Owned → CtorId → Option CtorSchema} + {oracle : Ixon.Address → List RVal → Option RVal} + {first second : Interpretation} {controlFuel heapFuel : Nat} + {result : Result} + (arity : source.main.signature.params.size = 0) + (nonempty : source.main.blocks.isEmpty = false) + (run : runMain (Context.ofProgram source schemas oracle) first source + controlFuel heapFuel = .ok result) : + runMain (Context.ofProgram source schemas oracle) second source + controlFuel heapFuel = .ok result := by + rw [runMain_eq_runMachine arity nonempty] at run ⊢ + have mainFree : CreditFree.function source.main = true := by + simp only [CreditFree.program, Bool.and_eq_true] at free + exact free.1 + exact runMachine_creditFree (programDeclarations free) + mainFree run + +end Ix.Compiler.IxIR2.Eval diff --git a/Ix/Compiler/IxIR2/Liveness.lean b/Ix/Compiler/IxIR2/Liveness.lean new file mode 100644 index 000000000..ebaaaee82 --- /dev/null +++ b/Ix/Compiler/IxIR2/Liveness.lean @@ -0,0 +1,909 @@ +import Ix.Compiler.IxIR2.Validate + +/-! +# Checked block-local liveness for IxIR₂ + +This is the first liveness artifact consumed by reuse insertion. A proposal +stores one conservative last-use bound per value register. Bounds use the +encoding `0 = unused` and `position + 1 = live through position`; therefore a +proposal may safely keep a value live longer than necessary. The checker +replays every value operand in instructions, terminators, and CFG edges and +rejects any uncovered use under explicit resource limits. + +The artifact is deliberately block-local at this stage. Interprocedural +parameter/result liveness and dead-parameter rewriting remain separate +roadmap work, while reset placement only needs the checked local fact that the +consumed scrutinee has no later use in its block. +-/ + +namespace Ix.Compiler.IxIR2.Liveness + +open Ix.Compiler.IxIR2 + +/-- One syntactic value-register use at an instruction position. The block +terminator occupies position `block.instructions.size`. -/ +structure Use where + value : ValueId + position : Nat + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +private def recordAtom (position : Nat) (uses : Array Use) : Atom → Array Use + | .reg value => uses.push { value, position } + | .lit _ | .erased => uses + +private def recordAtoms (position : Nat) (uses : Array Use) + (atoms : Array Atom) : Array Use := + atoms.foldl (recordAtom position) uses + +private def recordEdge (position : Nat) (uses : Array Use) + (edge : Edge) : Array Use := + recordAtoms position uses edge.values + +private def recordInstruction (position : Nat) (uses : Array Use) : + Instr → Array Use + | .move value => recordAtom position uses value + | .alloc _ _ arguments | .allocWith _ _ _ arguments => + recordAtoms position uses arguments + | .discardCredit _ => uses + | .takeUnique target _ | .resetShared target _ | + .retainShared target | .releaseShared target | .dropUnique target | + .freeUnique target _ | .fetch target _ _ => + recordAtom position uses target + | .call _ arguments | .callSelf arguments | .papp _ arguments | + .extern _ arguments => + recordAtoms position uses arguments + | .apply function arguments => + recordAtoms position (recordAtom position uses function) arguments + +private def recordTerminator (position : Nat) (uses : Array Use) : + Terminator → Array Use + | .jump edge => recordEdge position uses edge + | .switchValue scrutinee constructors natPeel => + let uses := recordAtom position uses scrutinee + let uses := constructors.foldl (fun current alternative => + recordEdge position current alternative.edge) uses + match natPeel with + | none => uses + | some peel => + recordEdge position (recordEdge position uses peel.zero) peel.succ + | .branchCredit _ someEdge noneEdge => + recordEdge position (recordEdge position uses someEdge) noneEdge + | .ret value => recordAtom position uses value + | .tailCall _ arguments | .tailCallSelf arguments => + recordAtoms position uses arguments + +private def scanInstruction (state : Nat × Array Use) + (instruction : Instr) : Nat × Array Use := + (state.1 + 1, recordInstruction state.1 state.2 instruction) + +/-- Complete, deterministic value-use inventory for one block. -/ +def blockUses (block : Block) : Array Use := + let state := block.instructions.foldl scanInstruction (0, #[]) + recordTerminator state.1 state.2 block.terminator + +/-- Declarative membership of an atom among an instruction's runtime value +operands. This mirrors `recordInstruction` but is proof-facing and does not +expose the accumulator used by the executable inventory. -/ +inductive InstrUsesAtom : Instr → Atom → Prop where + | move {atom} : InstrUsesAtom (.move atom) atom + | alloc {world cid arguments atom} : atom ∈ arguments.toList → + InstrUsesAtom (.alloc world cid arguments) atom + | allocWith {credit world cid arguments atom} : atom ∈ arguments.toList → + InstrUsesAtom (.allocWith credit world cid arguments) atom + | takeUnique {target cid} : InstrUsesAtom (.takeUnique target cid) target + | resetShared {target cid} : InstrUsesAtom (.resetShared target cid) target + | retainShared {target} : InstrUsesAtom (.retainShared target) target + | releaseShared {target} : InstrUsesAtom (.releaseShared target) target + | dropUnique {target} : InstrUsesAtom (.dropUnique target) target + | freeUnique {target cid} : InstrUsesAtom (.freeUnique target cid) target + | fetch {target cid field} : InstrUsesAtom (.fetch target cid field) target + | call {function arguments atom} : atom ∈ arguments.toList → + InstrUsesAtom (.call function arguments) atom + | callSelf {arguments atom} : atom ∈ arguments.toList → + InstrUsesAtom (.callSelf arguments) atom + | papp {function arguments atom} : atom ∈ arguments.toList → + InstrUsesAtom (.papp function arguments) atom + | applyFunction {function arguments} : + InstrUsesAtom (.apply function arguments) function + | applyArgument {function arguments atom} : atom ∈ arguments.toList → + InstrUsesAtom (.apply function arguments) atom + | extern {function arguments atom} : atom ∈ arguments.toList → + InstrUsesAtom (.extern function arguments) atom + +/-- Declarative membership among an edge's transferred value operands. -/ +inductive EdgeUsesAtom (edge : Edge) : Atom → Prop where + | value {atom} : atom ∈ edge.values.toList → EdgeUsesAtom edge atom + +/-- Declarative membership among a terminator's direct and edge value +operands. -/ +inductive TerminatorUsesAtom : Terminator → Atom → Prop where + | jump {edge atom} : EdgeUsesAtom edge atom → + TerminatorUsesAtom (.jump edge) atom + | switchScrutinee {scrutinee constructors natPeel} : + TerminatorUsesAtom (.switchValue scrutinee constructors natPeel) + scrutinee + | switchCtor {scrutinee constructors natPeel alternative atom} : + alternative ∈ constructors.toList → EdgeUsesAtom alternative.edge atom → + TerminatorUsesAtom (.switchValue scrutinee constructors natPeel) atom + | switchNatZero {scrutinee constructors peel atom} : + EdgeUsesAtom peel.zero atom → + TerminatorUsesAtom (.switchValue scrutinee constructors (some peel)) atom + | switchNatSucc {scrutinee constructors peel atom} : + EdgeUsesAtom peel.succ atom → + TerminatorUsesAtom (.switchValue scrutinee constructors (some peel)) atom + | branchSome {credit someEdge noneEdge atom} : + EdgeUsesAtom someEdge atom → + TerminatorUsesAtom (.branchCredit credit someEdge noneEdge) atom + | branchNone {credit someEdge noneEdge atom} : + EdgeUsesAtom noneEdge atom → + TerminatorUsesAtom (.branchCredit credit someEdge noneEdge) atom + | ret {atom} : TerminatorUsesAtom (.ret atom) atom + | tailCall {function arguments atom} : atom ∈ arguments.toList → + TerminatorUsesAtom (.tailCall function arguments) atom + | tailCallSelf {arguments atom} : atom ∈ arguments.toList → + TerminatorUsesAtom (.tailCallSelf arguments) atom + +private theorem recordAtom_preserves {position : Nat} {uses : Array Use} + {atom : Atom} {use : Use} (member : use ∈ uses) : + use ∈ recordAtom position uses atom := by + cases atom <;> simp [recordAtom, member] + +private theorem foldRecordAtoms_preserves {position : Nat} + {uses : Array Use} {atoms : List Atom} {use : Use} + (member : use ∈ uses) : + use ∈ atoms.foldl (recordAtom position) uses := by + induction atoms generalizing uses with + | nil => exact member + | cons atom rest ih => + simp only [List.foldl_cons] + exact ih (recordAtom_preserves member) + +private theorem foldRecordAtoms_reg {position value : Nat} + {uses : Array Use} {atoms : List Atom} {atom : Atom} + (member : atom ∈ atoms) (register : atom = .reg value) : + { value, position } ∈ atoms.foldl (recordAtom position) uses := by + induction atoms generalizing uses with + | nil => simp at member + | cons head rest ih => + simp only [List.foldl_cons] + rcases List.mem_cons.mp member with same | tail + · subst head + subst atom + apply foldRecordAtoms_preserves + simp [recordAtom] + · exact ih tail + +private theorem recordAtoms_preserves {position : Nat} {uses : Array Use} + {atoms : Array Atom} {use : Use} (member : use ∈ uses) : + use ∈ recordAtoms position uses atoms := by + unfold recordAtoms + rw [← Array.foldl_toList] + exact foldRecordAtoms_preserves member + +private theorem recordAtoms_reg {position value : Nat} + {uses : Array Use} {atoms : Array Atom} {atom : Atom} + (member : atom ∈ atoms.toList) (register : atom = .reg value) : + { value, position } ∈ recordAtoms position uses atoms := by + unfold recordAtoms + rw [← Array.foldl_toList] + exact foldRecordAtoms_reg member register + +private theorem recordInstruction_preserves {position : Nat} + {uses : Array Use} {instruction : Instr} {use : Use} + (member : use ∈ uses) : + use ∈ recordInstruction position uses instruction := by + cases instruction with + | move atom => exact recordAtom_preserves member + | alloc world cid arguments => exact recordAtoms_preserves member + | allocWith credit world cid arguments => + exact recordAtoms_preserves member + | discardCredit credit => exact member + | takeUnique target cid => exact recordAtom_preserves member + | resetShared target cid => exact recordAtom_preserves member + | retainShared target => exact recordAtom_preserves member + | releaseShared target => exact recordAtom_preserves member + | dropUnique target => exact recordAtom_preserves member + | freeUnique target cid => exact recordAtom_preserves member + | fetch target cid field => exact recordAtom_preserves member + | call function arguments => exact recordAtoms_preserves member + | callSelf arguments => exact recordAtoms_preserves member + | papp function arguments => exact recordAtoms_preserves member + | apply function arguments => + exact recordAtoms_preserves (recordAtom_preserves member) + | extern function arguments => exact recordAtoms_preserves member + +private theorem recordInstruction_reg {position value : Nat} + {uses : Array Use} {instruction : Instr} {atom : Atom} + (operand : InstrUsesAtom instruction atom) + (register : atom = .reg value) : + { value, position } ∈ recordInstruction position uses instruction := by + cases operand with + | move => + cases register + simp [recordInstruction, recordAtom] + | alloc member => + exact recordAtoms_reg member register + | allocWith member => + exact recordAtoms_reg member register + | takeUnique => + cases register + simp [recordInstruction, recordAtom] + | resetShared => + cases register + simp [recordInstruction, recordAtom] + | retainShared => + cases register + simp [recordInstruction, recordAtom] + | releaseShared => + cases register + simp [recordInstruction, recordAtom] + | dropUnique => + cases register + simp [recordInstruction, recordAtom] + | freeUnique => + cases register + simp [recordInstruction, recordAtom] + | fetch => + cases register + simp [recordInstruction, recordAtom] + | call member => + exact recordAtoms_reg member register + | callSelf member => + exact recordAtoms_reg member register + | papp member => + exact recordAtoms_reg member register + | applyFunction => + cases register + apply recordAtoms_preserves + simp [recordAtom] + | applyArgument member => + exact recordAtoms_reg member register + | extern member => + exact recordAtoms_reg member register + +private theorem recordEdge_preserves {position : Nat} {uses : Array Use} + {edge : Edge} {use : Use} (member : use ∈ uses) : + use ∈ recordEdge position uses edge := + recordAtoms_preserves member + +private theorem recordEdge_reg {position value : Nat} {uses : Array Use} + {edge : Edge} {atom : Atom} (operand : EdgeUsesAtom edge atom) + (register : atom = .reg value) : + { value, position } ∈ recordEdge position uses edge := by + cases operand with + | value member => exact recordAtoms_reg member register + +private theorem foldCtorEdges_preserves {position : Nat} + {uses : Array Use} {constructors : List CtorAlt} {use : Use} + (member : use ∈ uses) : + use ∈ constructors.foldl + (fun current alternative => recordEdge position current alternative.edge) + uses := by + induction constructors generalizing uses with + | nil => exact member + | cons alternative rest ih => + simp only [List.foldl_cons] + exact ih (recordEdge_preserves member) + +private theorem foldCtorEdges_reg {position value : Nat} + {uses : Array Use} {constructors : List CtorAlt} + {alternative : CtorAlt} {atom : Atom} + (member : alternative ∈ constructors) + (operand : EdgeUsesAtom alternative.edge atom) + (register : atom = .reg value) : + { value, position } ∈ constructors.foldl + (fun current candidate => recordEdge position current candidate.edge) + uses := by + induction constructors generalizing uses with + | nil => simp at member + | cons head rest ih => + simp only [List.foldl_cons] + rcases List.mem_cons.mp member with same | tail + · subst head + apply foldCtorEdges_preserves + exact recordEdge_reg operand register + · exact ih tail + +private theorem recordTerminator_preserves {position : Nat} + {uses : Array Use} {terminator : Terminator} {use : Use} + (member : use ∈ uses) : + use ∈ recordTerminator position uses terminator := by + cases terminator with + | jump edge => exact recordEdge_preserves member + | switchValue scrutinee constructors natPeel => + have afterScrutinee : use ∈ recordAtom position uses scrutinee := + recordAtom_preserves member + have afterConstructors : use ∈ constructors.foldl + (fun current alternative => + recordEdge position current alternative.edge) + (recordAtom position uses scrutinee) := by + rw [← Array.foldl_toList] + exact foldCtorEdges_preserves afterScrutinee + cases natPeel with + | none => exact afterConstructors + | some peel => + exact recordEdge_preserves + (recordEdge_preserves afterConstructors) + | branchCredit credit someEdge noneEdge => + exact recordEdge_preserves (recordEdge_preserves member) + | ret atom => exact recordAtom_preserves member + | tailCall function arguments => exact recordAtoms_preserves member + | tailCallSelf arguments => exact recordAtoms_preserves member + +private theorem foldInstructions_preserves {state : Nat × Array Use} + {instructions : List Instr} {use : Use} (member : use ∈ state.2) : + use ∈ (instructions.foldl scanInstruction state).2 := by + induction instructions generalizing state with + | nil => exact member + | cons instruction rest ih => + simp only [List.foldl_cons] + apply ih + exact recordInstruction_preserves member + +private theorem foldInstructions_reg (instructions : List Instr) : + ∀ {start : Nat} {uses : Array Use} {index : Nat} + {instruction : Instr} {atom : Atom} {value : Nat}, + instructions[index]? = some instruction → + InstrUsesAtom instruction atom → + atom = .reg value → + (⟨value, start + index⟩ : Use) ∈ + (instructions.foldl scanInstruction (start, uses)).2 := by + induction instructions with + | nil => + intro start uses index instruction atom value found + simp at found + | cons head rest ih => + intro start uses index instruction atom value found operand register + cases index with + | zero => + simp only [List.getElem?_cons_zero, Option.some.injEq] at found + subst instruction + simp only [List.foldl_cons, Nat.add_zero] + apply foldInstructions_preserves + change (⟨value, start⟩ : Use) ∈ + recordInstruction start uses head + exact recordInstruction_reg operand register + | succ index => + simp only [List.getElem?_cons_succ] at found + simp only [List.foldl_cons] + have recorded := ih (start := start + 1) + (uses := recordInstruction start uses head) found operand register + simpa [scanInstruction, Nat.add_assoc, Nat.add_comm, + Nat.add_left_comm] using recorded + +private theorem foldInstructions_position (instructions : List Instr) + (start : Nat) (uses : Array Use) : + (instructions.foldl scanInstruction (start, uses)).1 = + start + instructions.length := by + induction instructions generalizing start uses with + | nil => simp + | cons instruction rest ih => + simp only [List.foldl_cons] + rw [ih] + simp only [scanInstruction, List.length_cons] + omega + +private theorem recordTerminator_reg {position value : Nat} + {uses : Array Use} {terminator : Terminator} {atom : Atom} + (operand : TerminatorUsesAtom terminator atom) + (register : atom = .reg value) : + { value, position } ∈ recordTerminator position uses terminator := by + cases operand with + | jump edgeOperand => exact recordEdge_reg edgeOperand register + | @switchScrutinee scrutinee constructors natPeel => + cases register + unfold recordTerminator + have afterScrutinee : (⟨value, position⟩ : Use) ∈ + recordAtom position uses (.reg value) := by + simp [recordAtom] + have afterConstructors : (⟨value, position⟩ : Use) ∈ + constructors.foldl + (fun current alternative => + recordEdge position current alternative.edge) + (recordAtom position uses (.reg value)) := by + rw [← Array.foldl_toList] + exact foldCtorEdges_preserves afterScrutinee + cases natPeel with + | none => exact afterConstructors + | some peel => + exact recordEdge_preserves + (recordEdge_preserves afterConstructors) + | @switchCtor scrutinee constructors natPeel alternative atom member + edgeOperand => + cases natPeel with + | none => + simp only [recordTerminator] + rw [← Array.foldl_toList] + exact foldCtorEdges_reg member edgeOperand register + | some peel => + simp only [recordTerminator] + apply recordEdge_preserves + apply recordEdge_preserves + rw [← Array.foldl_toList] + exact foldCtorEdges_reg member edgeOperand register + | switchNatZero edgeOperand => + unfold recordTerminator + apply recordEdge_preserves + exact recordEdge_reg edgeOperand register + | switchNatSucc edgeOperand => + unfold recordTerminator + exact recordEdge_reg edgeOperand register + | branchSome edgeOperand => + unfold recordTerminator + apply recordEdge_preserves + exact recordEdge_reg edgeOperand register + | branchNone edgeOperand => + unfold recordTerminator + exact recordEdge_reg edgeOperand register + | ret => + cases register + simp [recordTerminator, recordAtom] + | tailCall member => + exact recordAtoms_reg member register + | tailCallSelf member => + exact recordAtoms_reg member register + +/-- Every declarative register operand of an indexed instruction occurs in +the executable block-use inventory at that instruction's position. -/ +theorem instruction_reg_mem_blockUses {block : Block} {position : Nat} + {instruction : Instr} {atom : Atom} {value : Nat} + (found : block.instructions[position]? = some instruction) + (operand : InstrUsesAtom instruction atom) + (register : atom = .reg value) : + (⟨value, position⟩ : Use) ∈ blockUses block := by + unfold blockUses + rw [← Array.foldl_toList] + apply recordTerminator_preserves + have listFound : block.instructions.toList[position]? = some instruction := by + simpa using found + have recorded := foldInstructions_reg block.instructions.toList + (start := 0) (uses := (#[] : Array Use)) listFound operand register + simpa using recorded + +/-- Every declarative direct register operand of a terminator occurs at the +terminator position in the executable block-use inventory. -/ +theorem terminator_reg_mem_blockUses {block : Block} {atom : Atom} + {value : Nat} (operand : TerminatorUsesAtom block.terminator atom) + (register : atom = .reg value) : + (⟨value, block.instructions.size⟩ : Use) ∈ blockUses block := by + unfold blockUses + rw [← Array.foldl_toList] + have position : + (block.instructions.toList.foldl scanInstruction (0, #[])).1 = + block.instructions.size := by + simpa using foldInstructions_position block.instructions.toList 0 #[] + rw [← position] + exact recordTerminator_reg operand register + +private theorem mem_recordAtom {position : Nat} {uses : Array Use} + {atom : Atom} {use : Use} + (member : use ∈ recordAtom position uses atom) : + use ∈ uses ∨ + (use.position = position ∧ atom = .reg use.value) := by + cases atom with + | reg value => + simp only [recordAtom, Array.mem_push] at member + cases member with + | inl member => exact .inl member + | inr same => + subst use + exact .inr ⟨rfl, rfl⟩ + | lit literal => exact .inl member + | erased => exact .inl member + +private theorem mem_foldRecordAtoms {position : Nat} {uses : Array Use} + {atoms : List Atom} {use : Use} + (member : use ∈ atoms.foldl (recordAtom position) uses) : + use ∈ uses ∨ + ∃ atom ∈ atoms, + use.position = position ∧ atom = .reg use.value := by + induction atoms generalizing uses with + | nil => exact .inl member + | cons head tail ih => + simp only [List.foldl_cons] at member + cases ih member with + | inl first => + cases mem_recordAtom first with + | inl previous => exact .inl previous + | inr added => + exact .inr ⟨head, by simp, added⟩ + | inr later => + obtain ⟨atom, atomMem, added⟩ := later + exact .inr ⟨atom, by simp [atomMem], added⟩ + +private theorem mem_recordAtoms {position : Nat} {uses : Array Use} + {atoms : Array Atom} {use : Use} + (member : use ∈ recordAtoms position uses atoms) : + use ∈ uses ∨ + ∃ atom ∈ atoms.toList, + use.position = position ∧ atom = .reg use.value := by + unfold recordAtoms at member + rw [← Array.foldl_toList] at member + exact mem_foldRecordAtoms member + +private theorem mem_recordInstruction {position : Nat} {uses : Array Use} + {instruction : Instr} {use : Use} + (member : use ∈ recordInstruction position uses instruction) : + use ∈ uses ∨ + (use.position = position ∧ + InstrUsesAtom instruction (.reg use.value)) := by + cases instruction with + | move atom => + cases mem_recordAtom member with + | inl previous => exact .inl previous + | inr added => + exact .inr ⟨added.1, added.2 ▸ .move⟩ + | alloc world cid arguments => + cases mem_recordAtoms member with + | inl previous => exact .inl previous + | inr added => + obtain ⟨atom, atomMem, positionEq, atomEq⟩ := added + exact .inr ⟨positionEq, atomEq ▸ .alloc atomMem⟩ + | allocWith credit world cid arguments => + cases mem_recordAtoms member with + | inl previous => exact .inl previous + | inr added => + obtain ⟨atom, atomMem, positionEq, atomEq⟩ := added + exact .inr ⟨positionEq, atomEq ▸ .allocWith atomMem⟩ + | discardCredit credit => exact .inl member + | takeUnique target cid => + cases mem_recordAtom member with + | inl previous => exact .inl previous + | inr added => exact .inr ⟨added.1, added.2 ▸ .takeUnique⟩ + | resetShared target cid => + cases mem_recordAtom member with + | inl previous => exact .inl previous + | inr added => exact .inr ⟨added.1, added.2 ▸ .resetShared⟩ + | retainShared target => + cases mem_recordAtom member with + | inl previous => exact .inl previous + | inr added => exact .inr ⟨added.1, added.2 ▸ .retainShared⟩ + | releaseShared target => + cases mem_recordAtom member with + | inl previous => exact .inl previous + | inr added => exact .inr ⟨added.1, added.2 ▸ .releaseShared⟩ + | dropUnique target => + cases mem_recordAtom member with + | inl previous => exact .inl previous + | inr added => exact .inr ⟨added.1, added.2 ▸ .dropUnique⟩ + | freeUnique target cid => + cases mem_recordAtom member with + | inl previous => exact .inl previous + | inr added => exact .inr ⟨added.1, added.2 ▸ .freeUnique⟩ + | fetch target cid field => + cases mem_recordAtom member with + | inl previous => exact .inl previous + | inr added => exact .inr ⟨added.1, added.2 ▸ .fetch⟩ + | call function arguments => + cases mem_recordAtoms member with + | inl previous => exact .inl previous + | inr added => + obtain ⟨atom, atomMem, positionEq, atomEq⟩ := added + exact .inr ⟨positionEq, atomEq ▸ .call atomMem⟩ + | callSelf arguments => + cases mem_recordAtoms member with + | inl previous => exact .inl previous + | inr added => + obtain ⟨atom, atomMem, positionEq, atomEq⟩ := added + exact .inr ⟨positionEq, atomEq ▸ .callSelf atomMem⟩ + | papp function arguments => + cases mem_recordAtoms member with + | inl previous => exact .inl previous + | inr added => + obtain ⟨atom, atomMem, positionEq, atomEq⟩ := added + exact .inr ⟨positionEq, atomEq ▸ .papp atomMem⟩ + | apply function arguments => + cases mem_recordAtoms member with + | inl beforeArguments => + cases mem_recordAtom beforeArguments with + | inl previous => exact .inl previous + | inr added => + exact .inr ⟨added.1, added.2 ▸ .applyFunction⟩ + | inr added => + obtain ⟨atom, atomMem, positionEq, atomEq⟩ := added + exact .inr ⟨positionEq, atomEq ▸ .applyArgument atomMem⟩ + | extern function arguments => + cases mem_recordAtoms member with + | inl previous => exact .inl previous + | inr added => + obtain ⟨atom, atomMem, positionEq, atomEq⟩ := added + exact .inr ⟨positionEq, atomEq ▸ .extern atomMem⟩ + +private theorem mem_recordEdge {position : Nat} {uses : Array Use} + {edge : Edge} {use : Use} + (member : use ∈ recordEdge position uses edge) : + use ∈ uses ∨ + (use.position = position ∧ + EdgeUsesAtom edge (.reg use.value)) := by + cases mem_recordAtoms member with + | inl previous => exact .inl previous + | inr added => + obtain ⟨atom, atomMem, positionEq, atomEq⟩ := added + exact .inr ⟨positionEq, atomEq ▸ .value atomMem⟩ + +private theorem mem_foldCtorEdges {position : Nat} {uses : Array Use} + {constructors : List CtorAlt} {use : Use} + (member : use ∈ constructors.foldl + (fun current alternative => + recordEdge position current alternative.edge) uses) : + use ∈ uses ∨ + ∃ alternative ∈ constructors, + use.position = position ∧ + EdgeUsesAtom alternative.edge (.reg use.value) := by + induction constructors generalizing uses with + | nil => exact .inl member + | cons head tail ih => + simp only [List.foldl_cons] at member + cases ih member with + | inl first => + cases mem_recordEdge first with + | inl previous => exact .inl previous + | inr added => exact .inr ⟨head, by simp, added⟩ + | inr later => + obtain ⟨alternative, alternativeMem, added⟩ := later + exact .inr ⟨alternative, by simp [alternativeMem], added⟩ + +private theorem mem_recordTerminator {position : Nat} {uses : Array Use} + {terminator : Terminator} {use : Use} + (member : use ∈ recordTerminator position uses terminator) : + use ∈ uses ∨ + (use.position = position ∧ + TerminatorUsesAtom terminator (.reg use.value)) := by + cases terminator with + | jump edge => + cases mem_recordEdge member with + | inl previous => exact .inl previous + | inr added => exact .inr ⟨added.1, .jump added.2⟩ + | switchValue scrutinee constructors natPeel => + cases natPeel with + | none => + simp only [recordTerminator] at member + rw [← Array.foldl_toList] at member + cases mem_foldCtorEdges member with + | inl beforeConstructors => + cases mem_recordAtom beforeConstructors with + | inl previous => exact .inl previous + | inr added => + exact .inr ⟨added.1, added.2 ▸ .switchScrutinee⟩ + | inr added => + obtain ⟨alternative, alternativeMem, positionEq, operand⟩ := + added + exact .inr ⟨positionEq, + .switchCtor (by simpa using alternativeMem) operand⟩ + | some peel => + simp only [recordTerminator] at member + cases mem_recordEdge member with + | inr added => exact .inr ⟨added.1, .switchNatSucc added.2⟩ + | inl beforeSucc => + cases mem_recordEdge beforeSucc with + | inr added => exact .inr ⟨added.1, .switchNatZero added.2⟩ + | inl beforeNat => + rw [← Array.foldl_toList] at beforeNat + cases mem_foldCtorEdges beforeNat with + | inl beforeConstructors => + cases mem_recordAtom beforeConstructors with + | inl previous => exact .inl previous + | inr added => + exact .inr + ⟨added.1, added.2 ▸ .switchScrutinee⟩ + | inr added => + obtain ⟨alternative, alternativeMem, positionEq, + operand⟩ := added + exact .inr ⟨positionEq, + .switchCtor (by simpa using alternativeMem) operand⟩ + | branchCredit credit someEdge noneEdge => + cases mem_recordEdge member with + | inr added => exact .inr ⟨added.1, .branchNone added.2⟩ + | inl beforeNone => + cases mem_recordEdge beforeNone with + | inl previous => exact .inl previous + | inr added => exact .inr ⟨added.1, .branchSome added.2⟩ + | ret atom => + cases mem_recordAtom member with + | inl previous => exact .inl previous + | inr added => exact .inr ⟨added.1, added.2 ▸ .ret⟩ + | tailCall function arguments => + cases mem_recordAtoms member with + | inl previous => exact .inl previous + | inr added => + obtain ⟨atom, atomMem, positionEq, atomEq⟩ := added + exact .inr ⟨positionEq, atomEq ▸ .tailCall atomMem⟩ + | tailCallSelf arguments => + cases mem_recordAtoms member with + | inl previous => exact .inl previous + | inr added => + obtain ⟨atom, atomMem, positionEq, atomEq⟩ := added + exact .inr ⟨positionEq, atomEq ▸ .tailCallSelf atomMem⟩ + +private theorem mem_foldInstructions (instructions : List Instr) : + ∀ {start : Nat} {uses : Array Use} {use : Use}, + use ∈ (instructions.foldl scanInstruction (start, uses)).2 → + use ∈ uses ∨ + ∃ index instruction, + instructions[index]? = some instruction ∧ + use.position = start + index ∧ + InstrUsesAtom instruction (.reg use.value) := by + induction instructions with + | nil => + intro start uses use member + exact .inl member + | cons head tail ih => + intro start uses use member + simp only [List.foldl_cons] at member + have classified := ih (start := start + 1) + (uses := recordInstruction start uses head) (use := use) + (by simpa [scanInstruction] using member) + cases classified with + | inl first => + cases mem_recordInstruction first with + | inl previous => exact .inl previous + | inr added => + exact .inr ⟨0, head, by simp, by simpa using added.1, + added.2⟩ + | inr later => + obtain ⟨index, instruction, found, positionEq, operand⟩ := later + exact .inr ⟨index + 1, instruction, by simpa using found, + by omega, operand⟩ + +/-- Every executable use-inventory entry comes from either the instruction +at its recorded position or the block terminator. Together with the forward +lemmas above, this makes `blockUses` a faithful syntax inventory. -/ +theorem mem_blockUses {block : Block} {use : Use} + (member : use ∈ blockUses block) : + (∃ instruction, + block.instructions[use.position]? = some instruction ∧ + InstrUsesAtom instruction (.reg use.value)) ∨ + (use.position = block.instructions.size ∧ + TerminatorUsesAtom block.terminator (.reg use.value)) := by + unfold blockUses at member + rw [← Array.foldl_toList] at member + cases mem_recordTerminator member with + | inl beforeTerminator => + have classified := mem_foldInstructions block.instructions.toList + (start := 0) (uses := #[]) beforeTerminator + cases classified with + | inl empty => simp at empty + | inr instructionUse => + obtain ⟨index, instruction, found, positionEq, operand⟩ := + instructionUse + left + have positionEq' : use.position = index := by simpa using positionEq + exact ⟨instruction, by rw [positionEq']; simpa using found, + operand⟩ + | inr terminatorUse => + right + refine ⟨terminatorUse.1.trans ?_, terminatorUse.2⟩ + simpa using foldInstructions_position block.instructions.toList 0 #[] + +/-- Dense conservative last-use vector. Entry `0` means no claimed use; +entry `position + 1` means live through at least that position. -/ +structure BlockSummary where + lastUses : Array Nat + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +private def growTo (values : Array Nat) (size : Nat) : Array Nat := + if size ≤ values.size then values + else values ++ Array.replicate (size - values.size) 0 + +private def recordLastUse (values : Array Nat) (use : Use) : Array Nat := + let values := growTo values (use.value + 1) + let previous := (values[use.value]?).getD 0 + values.setIfInBounds use.value (max previous (use.position + 1)) + +/-- Exact local solution produced by the default planner. The checker does +not rely on exactness and also accepts conservative larger bounds. -/ +def inferBlock (block : Block) : BlockSummary := + { lastUses := (blockUses block).foldl recordLastUse + (Array.replicate block.valueParams.size 0) } + +def BlockSummary.lastUse? (summary : BlockSummary) + (value : ValueId) : Option Nat := do + let encoded ← summary.lastUses[value]? + match encoded with + | 0 => none + | position + 1 => some position + +/-- Does this proposal cover this particular semantic operand use? -/ +def coversUse (summary : BlockSummary) (use : Use) : Bool := + match summary.lastUses[use.value]? with + | some bound => use.position < bound + | none => false + +/-- Every syntactic semantic use must be included. Extra liveness is safe. -/ +def covers (block : Block) (summary : BlockSummary) : Bool := + (blockUses block).all (coversUse summary) + +structure Stats where + uses : Nat + valueSlots : Nat + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +inductive Resource where + | uses + | valueSlots + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +inductive Error where + | limit (resource : Resource) (actual maximum : Nat) + | uncoveredUse + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- A checked conservative local solution. The retained equation is the +proof-facing reflection boundary for individual-use theorems. -/ +structure CheckedBlock (block : Block) where + summary : BlockSummary + stats : Stats + accepted : covers block summary = true + +def checkBlockWith (limits : Validate.Limits) (block : Block) + (summary : BlockSummary) : Except Error (CheckedBlock block) := + let uses := blockUses block + if uses.size > limits.maxFlowWork then + .error (.limit .uses uses.size limits.maxFlowWork) + else if summary.lastUses.size > limits.maxValueRegisters then + .error (.limit .valueSlots summary.lastUses.size limits.maxValueRegisters) + else if accepted : covers block summary = true then + .ok { summary + stats := { uses := uses.size, valueSlots := summary.lastUses.size } + accepted } + else + .error .uncoveredUse + +def checkBlock (block : Block) (summary : BlockSummary) : + Except Error (CheckedBlock block) := + checkBlockWith Validate.defaultLimits block summary + +/-- Run the default exact planner through the same untrusted-artifact checker +used for externally supplied conservative proposals. -/ +def inferCheckedWith (limits : Validate.Limits) (block : Block) : + Except Error (CheckedBlock block) := + let uses := blockUses block + if uses.size > limits.maxFlowWork then + .error (.limit .uses uses.size limits.maxFlowWork) + else + let requiredSlots := uses.foldl + (fun size use => max size (use.value + 1)) block.valueParams.size + if requiredSlots > limits.maxValueRegisters then + .error (.limit .valueSlots requiredSlots limits.maxValueRegisters) + else + checkBlockWith limits block (inferBlock block) + +def inferChecked (block : Block) : Except Error (CheckedBlock block) := + inferCheckedWith Validate.defaultLimits block + +namespace CheckedBlock + +/-- Every indexed source use is covered by the retained checked proposal. -/ +theorem coversAt {block : Block} (checked : CheckedBlock block) + (index : Nat) (bound : index < (blockUses block).size) : + coversUse checked.summary (blockUses block)[index] = true := by + exact (Array.all_eq_true.mp checked.accepted) index bound + +/-- A checked exact bound at `position` excludes every later syntactic use of +that register in the block. -/ +theorem no_use_after {block : Block} (checked : CheckedBlock block) + {value : ValueId} {position : Nat} + (last : checked.summary.lastUse? value = some position) : + ∀ index, (bound : index < (blockUses block).size) → + (blockUses block)[index].value = value → + (blockUses block)[index].position ≤ position := by + intro index bound sameValue + have covered := checked.coversAt index bound + unfold coversUse at covered + have encoded : checked.summary.lastUses[value]? = some (position + 1) := by + cases found : checked.summary.lastUses[value]? with + | none => simp [BlockSummary.lastUse?, found] at last + | some valueBound => + cases valueBound with + | zero => simp [BlockSummary.lastUse?, found] at last + | succ predecessor => + simp [BlockSummary.lastUse?, found] at last + subst predecessor + rfl + rw [sameValue, encoded] at covered + simp only at covered + exact Nat.le_of_lt_succ (of_decide_eq_true covered) + +end CheckedBlock + +end Ix.Compiler.IxIR2.Liveness diff --git a/Ix/Compiler/IxIR2/LivenessExamples.lean b/Ix/Compiler/IxIR2/LivenessExamples.lean new file mode 100644 index 000000000..cba6182ee --- /dev/null +++ b/Ix/Compiler/IxIR2/LivenessExamples.lean @@ -0,0 +1,96 @@ +import Ix.Compiler.IxIR2.Liveness + +/-! +# Checked liveness examples + +The fixture deliberately places value uses in an instruction, the +terminator scrutinee, a constructor edge, and both literal-peel edges. It +checks exact inference, conservative over-approximation, uncovered-use +rejection, and both resource gates exposed by the block-local checker. +-/ + +namespace Ix.Compiler.IxIR2.Liveness.Examples + +open Ix.Compiler.IxIR2 + +private def edge (target : BlockId) (values : Array Atom) : Edge := + { target, values, credits := #[] } + +def mixedBlock : Block := + { valueParams := #[.scalar, .scalar] + creditParams := #[] + instructions := #[ + .move (.reg 0), + .apply (.reg 1) #[.reg 2]] + terminator := .switchValue (.reg 3) #[ + { cid := default, edge := edge 1 #[.reg 0] }] + (some { + zero := edge 2 #[.reg 1] + succ := edge 3 #[.reg 3] }) } + +def expectedUses : Array Use := #[ + { value := 0, position := 0 }, + { value := 1, position := 1 }, + { value := 2, position := 1 }, + { value := 3, position := 2 }, + { value := 0, position := 2 }, + { value := 1, position := 2 }, + { value := 3, position := 2 }] + +def exactSummary : BlockSummary := { lastUses := #[3, 3, 2, 3] } + +/-- Extra liveness is accepted: each claimed bound may exceed the exact +last-use position by an arbitrary amount. -/ +def conservativeSummary : BlockSummary := { lastUses := #[4, 5, 3, 4] } + +/-- Register two is last used by the `apply` instruction at position one; +the checked certificate rules out a later use even though other values occur +on successor edges. -/ +theorem registerTwoNoUseAfter (checked : CheckedBlock mixedBlock) + (last : checked.summary.lastUse? 2 = some 1) : + ∀ index, (bound : index < (blockUses mixedBlock).size) → + (blockUses mixedBlock)[index].value = 2 → + (blockUses mixedBlock)[index].position ≤ 1 := + checked.no_use_after last + +def suite : Bool := + blockUses mixedBlock == expectedUses && + inferBlock mixedBlock == exactSummary && + (match inferChecked mixedBlock with + | .ok checked => + checked.summary == exactSummary && + checked.stats == { uses := 7, valueSlots := 4 } + | .error _ => false) && + (match checkBlock mixedBlock conservativeSummary with + | .ok checked => checked.summary == conservativeSummary + | .error _ => false) && + (match checkBlock mixedBlock { lastUses := #[3, 3, 1, 3] } with + | .error .uncoveredUse => true + | _ => false) && + (match checkBlock mixedBlock { lastUses := #[3, 3, 2] } with + | .error .uncoveredUse => true + | _ => false) && + (match checkBlockWith + { Validate.defaultLimits with maxFlowWork := 6 } + mixedBlock exactSummary with + | .error (.limit .uses 7 6) => true + | _ => false) && + (match checkBlockWith + { Validate.defaultLimits with maxValueRegisters := 3 } + mixedBlock exactSummary with + | .error (.limit .valueSlots 4 3) => true + | _ => false) + +#guard suite + +/-- Proof-carrying result of the executable certificate/rejection suite. -/ +structure CheckedSuite : Type where + accepted : suite = true + +def checkSuite : Except String CheckedSuite := + if accepted : suite = true then + .ok { accepted } + else + .error "checked block-liveness suite failed" + +end Ix.Compiler.IxIR2.Liveness.Examples diff --git a/Ix/Compiler/IxIR2/Lower.lean b/Ix/Compiler/IxIR2/Lower.lean new file mode 100644 index 000000000..76599acde --- /dev/null +++ b/Ix/Compiler/IxIR2/Lower.lean @@ -0,0 +1,7324 @@ +import Ix.Compiler.IxIR2.Validate +import Ix.Compiler.IxIR2.CreditFree + +/-! +# Structured IxIR₁ to IxIR₂ lowering + +IxIR₁ deliberately erases two facts that IxIR₂ must check: function-parameter +worlds and the full constructor identity at `fetch`, `free`, and case sites. +The lowering context supplies exactly those owner-sensitive facts. Everything +else here is producer-computed: blocks, SSA ordinals, capability transfer, +edge parameters, scalar-leaf facts, and the proof-facing validation equation. + +The baseline is intentionally conservative. Function parameters use the +owned IxIR₁ calling convention, raw `reuse` is rejected, and every live source +environment slot is transferred at a join. Parameter reduction, borrowing, +and reset/reuse insertion are later checked transformations over this output. + +Successful lowering also retains a recursive `CodeTrace` mirroring the exact +source-code derivation. Its checked block order and instruction coordinates +let semantic proofs recover generated CFG facts from trace membership instead +of accepting those coordinates as caller-supplied premises. +-/ + +namespace Ix.Compiler.IxIR2.Lower + +open Ix.Compiler.Ixon (Address Owned) +open Ix.Compiler.IxIR2 + +/-- A stable source-code coordinate. `branches` records alternative indices +from outermost to innermost; `offset` counts `letOp`s in the current arm. -/ +structure SourceSite where + owner : Validate.Owner + branches : List Nat := [] + offset : Nat := 0 + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +def SourceSite.next (site : SourceSite) : SourceSite := + { site with offset := site.offset + 1 } + +def SourceSite.alternative (site : SourceSite) (index : Nat) : SourceSite := + { site with branches := site.branches ++ [index], offset := 0 } + +/-- Facts retained from validated IxIR₀/IxIR₁ production. Missing facts +fail closed at the operation that needs them. -/ +structure Context where + /-- Parameter worlds in call order for each addressed IxIR₁ function. -/ + parameterWorlds : Address → Option (Array Owned) := fun _ => none + schemas : Owned → CtorId → Option CtorSchema := fun _ _ => none + /-- Exact constructor at one IxIR₁ projection. -/ + fetchCtor : SourceSite → Option CtorId := fun _ => none + /-- Checked all-scalar constructor at one IxIR₁ shallow free. -/ + scalarFreeCtor : SourceSite → Option CtorId := fun _ => none + /-- Full constructor identities for an IxIR₁ alternative. More than one + identity is permitted because IxIR₁ dispatch retains only tag/arity; + checked lowering emits one IxIR₂ edge for every producer-admitted full + identity. An empty list permits a Nat-only alternative. -/ + caseCtors : SourceSite → Nat → List CtorId := fun _ _ => [] + /-- Generic tooling may preserve scalar externs. The certified pipeline + leaves this false. -/ + allowExtern : Bool := false + /-- Structural recursion budget for one source-code path. -/ + maxDepth : Nat := 100000 + +structure Input where + declarations : List (Address × IxIR1.Decl) + main : IxIR1.Code + mainResult : Owned + +/-- View the source main as a closed synthetic function, matching the target +machine's uniform function/frame representation. -/ +def Input.mainDefinition (input : Input) : IxIR1.FnDef := + { arity := 0 + result := input.mainResult + papSafe := false + body := input.main } + +inductive Error where + | duplicateDeclaration (address : Address) + | missingParameterWorlds (address : Address) + | signature (owner : Validate.Owner) (detail : String) + | source (site : SourceSite) (detail : String) + | ownership (site : SourceSite) (detail : String) + | schema (site : SourceSite) (detail : String) + | unsupported (site : SourceSite) (detail : String) + | resources (site : SourceSite) + | internal (detail : String) + | validation (error : Validate.Error) + deriving BEq, Repr + +inductive TargetPosition where + | instruction (index : Nat) + | terminator + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- Capability tracked for one source de Bruijn binding while constructing +an SSA block. Retaining this producer-computed state in the flat position +trace lets semantic clients recover ownership worlds without replaying the +private lowering monad. -/ +inductive BindingCap where + | scalar + | owned (world : Owned) + | borrowed (world : Owned) (lender : BorrowLender) + | dead + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- One source position's producer-computed target coordinate. A source arm +may occur more than once when the same IxIR₁ alternative serves both a +constructor and a literal-Nat path. -/ +structure PositionTrace where + source : SourceSite + block : BlockId + target : TargetPosition + /-- Source-slot capabilities immediately before this source operation or + terminator. The checked trace audits their live/dead shape against the + recursive code trace before exposing them to simulation. -/ + sourceCapabilities : Array BindingCap + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- Exact environment-to-parameter transfer generated at one edge. -/ +structure EdgeTrace where + source : SourceSite + sourceBlock : BlockId + target : BlockId + /-- Source-slot map at the end of the predecessor block. Live slots name + operands in that frame; consumed slots are absent. -/ + sourceInputMap : Array (Option Atom) + targetParams : Array ValueCap + implicitScalars : Nat := 0 + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- Shift register operands across a prefix of implicit block parameters. +Literals and erased operands are independent of the register file. -/ +def shiftAtom (amount : Nat) : Atom → Atom + | .reg id => .reg (id + amount) + | .lit literal => .lit literal + | .erased => .erased + +/-- The proof-side successor map generated for a CFG edge. Implicit scalar +parameters occupy the prefix; every live explicit source slot is shifted past +that prefix while a consumed slot remains absent. -/ +def EdgeTrace.sourceMapOf (implicitScalars : Nat) + (explicitMap : Array (Option Atom)) : Array (Option Atom) := + let implicitMap := (List.range implicitScalars).toArray.map fun index => + some (.reg index) + implicitMap ++ explicitMap.map fun + | none => none + | some atom => some (shiftAtom implicitScalars atom) + +/-- Explicit edge operands derived from a predecessor source map. A consumed +slot is represented by the inert erased value so block-parameter ordinals +remain aligned with source de Bruijn slots. -/ +def EdgeTrace.explicitValuesOf + (sourceInputMap : Array (Option Atom)) : Array Atom := + sourceInputMap.map fun + | none => .erased + | some atom => atom + +/-- Before any implicit prefix is added, every live successor source slot is +the same-position block parameter. -/ +def EdgeTrace.explicitMapOf + (sourceInputMap : Array (Option Atom)) : Array (Option Atom) := + sourceInputMap.mapIdx fun index slot => + match slot with + | none => none + | some _ => some (.reg index) + +/-- Explicit operands carried by this exact generated edge. -/ +def EdgeTrace.explicitValues (trace : EdgeTrace) : Array Atom := + EdgeTrace.explicitValuesOf trace.sourceInputMap + +/-- Proof-side map for the source environment visible on entry to the +successor. Live slots name successor block-local registers; consumed slots +are absent. Implicit scalar values (currently Nat predecessors) occupy the +prefix. -/ +def EdgeTrace.sourceMap (trace : EdgeTrace) : Array (Option Atom) := + EdgeTrace.sourceMapOf trace.implicitScalars + (EdgeTrace.explicitMapOf trace.sourceInputMap) + +namespace InputMap + +/-- Translate one source atom through a partial source-slot map. -/ +def translateAtom (mapping : Array (Option Atom)) : IxIR1.Atom → Option Atom + | .var index => (mapping[index]?).bind id + | .lit literal => some (.lit literal) + | .erased => some .erased + +/-- Translate a source operand vector pointwise and in order. -/ +def translateAtoms (mapping : Array (Option Atom)) + (atoms : Array IxIR1.Atom) : Option (Array Atom) := do + let translated ← atoms.toList.mapM (translateAtom mapping) + return translated.toArray + +/-- A successor proof map may forget live slots but cannot retarget one. -/ +def Forgets (next current : Array (Option Atom)) : Prop := + ∀ (index : Nat) (atom : Atom), + next[index]? = some (some atom) → + current[index]? = some (some atom) + +/-- Finite executable check for `Forgets`. -/ +def checksForgets (next current : Array (Option Atom)) : Bool := + (List.range next.size).all fun index => + match next[index]? with + | some (some atom) => current[index]? == some (some atom) + | _ => true + +/-- Reflect the finite forgetting check into its proof-facing relation. -/ +theorem forgets_of_check {next current : Array (Option Atom)} + (checked : checksForgets next current = true) : + Forgets next current := by + intro index atom nextAt + have bound : index < next.size := + (Array.getElem?_eq_some_iff.mp nextAt).1 + have member : index ∈ List.range next.size := List.mem_range.mpr bound + have point := List.all_eq_true.mp checked index member + simp [nextAt] at point + exact point + +end InputMap + +/-- Derivation-shaped output of one successful `compileCode` call. Unlike +the flat position and edge indexes below, this tree preserves the exact +recursive structure on which the block-compositional simulation proceeds. +Terminal nodes retain the installed block; instruction nodes retain the +pre/post source maps and recursive continuation; switch nodes retain their +locally generated edges and recursive child runs in production order. -/ +inductive CodeTrace where + | ret (source : SourceSite) (sourceBlock : BlockId) + (sourceInputMap : Array (Option Atom)) + (entryValueCount : Nat) + (sourceAtom : IxIR1.Atom) (targetAtom : Atom) (generated : Block) + | tailCall (source : SourceSite) (sourceBlock : BlockId) + (sourceInputMap : Array (Option Atom)) (entryValueCount : Nat) + (address : Address) + (arguments : Array IxIR1.Atom) (generated : Block) + | tailCallSelf (source : SourceSite) (sourceBlock : BlockId) + (sourceInputMap : Array (Option Atom)) (entryValueCount : Nat) + (arguments : Array IxIR1.Atom) (generated : Block) + | letOp (source : SourceSite) (sourceBlock : BlockId) + (sourceInputMap nextInputMap : Array (Option Atom)) + (entryValueCount : Nat) + (operation : IxIR1.Op) (targetIndex : Nat) + (targetInstruction : Instr) (next : CodeTrace) + | switchValue (source : SourceSite) (sourceBlock : BlockId) + (sourceInputMap : Array (Option Atom)) (entryValueCount : Nat) + (sourceScrutinee : IxIR1.Atom) (peelNat : Bool) + (alternatives : Array IxIR1.Alt) (targetScrutinee : Atom) + (generated : Block) (outgoing : List EdgeTrace) + (children : List CodeTrace) + +/-- Root source coordinate of one recursive compiler run. -/ +def CodeTrace.source : CodeTrace → SourceSite + | .ret source .. | .tailCall source .. | .tailCallSelf source .. + | .letOp source .. | .switchValue source .. => source + +/-- Block in which one recursive compiler run begins. -/ +def CodeTrace.sourceBlock : CodeTrace → BlockId + | .ret _ block .. | .tailCall _ block .. | .tailCallSelf _ block .. + | .letOp _ block .. | .switchValue _ block .. => block + +/-- Proof map visible at the beginning of one recursive compiler run. -/ +def CodeTrace.sourceInputMap : CodeTrace → Array (Option Atom) + | .ret _ _ input .. | .tailCall _ _ input .. + | .tailCallSelf _ _ input .. | .letOp _ _ input .. + | .switchValue _ _ input .. => input + +/-- Number of target value registers present when this recursive compiler +run begins. -/ +def CodeTrace.entryValueCount : CodeTrace → Nat + | .ret _ _ _ count .. | .tailCall _ _ _ count .. + | .tailCallSelf _ _ _ count .. | .letOp _ _ _ _ count .. + | .switchValue _ _ _ count .. => count + +/-- Exact IxIR₁ code consumed by one recursive compiler call. The source +syntax is reconstructed from constructor payloads, so instruction +continuations recurse through the same tree used by the semantic proof. -/ +def CodeTrace.sourceCode : CodeTrace → IxIR1.Code + | .ret _ _ _ _ source _ _ => .ret source + | .tailCall _ _ _ _ address arguments _ => + .letOp (.call address arguments) (.ret (.var 0)) + | .tailCallSelf _ _ _ _ arguments _ => + .letOp (.callSelf arguments) (.ret (.var 0)) + | .letOp _ _ _ _ _ operation _ _ next => + .letOp operation next.sourceCode + | .switchValue _ _ _ _ scrutinee peelNat alternatives _ _ _ _ => + .case scrutinee peelNat alternatives + +/-- Installed blocks in reservation/production order. A `letOp` remains in +its continuation's block, while a switch owns its terminal block and then the +blocks recursively produced for its children. -/ +def CodeTrace.blocks : CodeTrace → List (BlockId × Block) + | .ret _ block _ _ _ _ generated + | .tailCall _ block _ _ _ _ generated + | .tailCallSelf _ block _ _ _ generated => [(block, generated)] + | .letOp _ _ _ _ _ _ _ _ next => next.blocks + | .switchValue _ block _ _ _ _ _ _ generated _ children => + (block, generated) :: children.flatMap CodeTrace.blocks + +/-- The block completed by a compiler call before descending into any switch +children. Leading instruction nodes share their continuation's block. -/ +def CodeTrace.headBlock : CodeTrace → BlockId × Block + | .ret _ block _ _ _ _ generated + | .tailCall _ block _ _ _ _ generated + | .tailCallSelf _ block _ _ _ generated + | .switchValue _ block _ _ _ _ _ _ generated _ _ => (block, generated) + | .letOp _ _ _ _ _ _ _ _ next => next.headBlock + +/-- Target program counter at which this recursive compiler call begins. +Terminal/switch nodes begin at their completed instruction-array length; +instruction nodes begin at their retained instruction coordinate. -/ +def CodeTrace.entryPc : CodeTrace → Nat + | .ret _ _ _ _ _ _ generated + | .tailCall _ _ _ _ _ _ generated + | .tailCallSelf _ _ _ _ _ generated + | .switchValue _ _ _ _ _ _ _ _ generated _ _ => + generated.instructions.size + | .letOp _ _ _ _ _ _ index _ _ => index + +/-- Flat producer position corresponding to the beginning of this recursive +trace node. -/ +def CodeTrace.targetPosition : CodeTrace → TargetPosition + | .letOp _ _ _ _ _ _ index _ _ => .instruction index + | .ret .. | .tailCall .. | .tailCallSelf .. | .switchValue .. => + .terminator + +/-- The completed head block is always present in the recursive block list. -/ +theorem CodeTrace.headBlock_mem_blocks : + ∀ trace : CodeTrace, trace.headBlock ∈ trace.blocks + | .ret .. => by simp [CodeTrace.headBlock, CodeTrace.blocks] + | .tailCall .. => by simp [CodeTrace.headBlock, CodeTrace.blocks] + | .tailCallSelf .. => by simp [CodeTrace.headBlock, CodeTrace.blocks] + | .letOp _ _ _ _ _ _ _ _ next => by + simpa [CodeTrace.headBlock, CodeTrace.blocks] using + CodeTrace.headBlock_mem_blocks next + | .switchValue .. => by simp [CodeTrace.headBlock, CodeTrace.blocks] + +/-- Immediate recursive compiler calls. Instruction nodes have one +continuation; switch nodes expose every constructor/Nat child in production +order; terminal nodes have none. -/ +def CodeTrace.children : CodeTrace → List CodeTrace + | .letOp _ _ _ _ _ _ _ _ next => [next] + | .switchValue _ _ _ _ _ _ _ _ _ _ children => children + | _ => [] + +/-- Local block-entry ABI check for one recursive compiler node. Nodes that +begin after an already emitted instruction do not introduce a target block +entry and therefore impose no parameter-count condition. -/ +def CodeTrace.entryValueCountMatches (trace : CodeTrace) : Bool := + if trace.entryPc == 0 then + trace.entryValueCount == trace.headBlock.2.valueParams.size + else + true + +mutual + +/-- Executable recursive audit that every compiler node beginning at target +PC zero has exactly the value-register count declared by its completed head +block's parameter ABI. -/ +def CodeTrace.entryValueCountsMatch : CodeTrace → Bool + | trace@(.ret ..) | trace@(.tailCall ..) | trace@(.tailCallSelf ..) => + trace.entryValueCountMatches + | trace@(.letOp _ _ _ _ _ _ _ _ next) => + trace.entryValueCountMatches && next.entryValueCountsMatch + | trace@(.switchValue _ _ _ _ _ _ _ _ _ _ children) => + trace.entryValueCountMatches && + codeTraceListEntryValueCountsMatch children + +private def codeTraceListEntryValueCountsMatch : List CodeTrace → Bool + | [] => true + | trace :: rest => + trace.entryValueCountsMatch && + codeTraceListEntryValueCountsMatch rest + +end + +/-- Reflexive/transitive reachability through the exact recursive compiler +call tree. -/ +inductive CodeTrace.Descendant (root : CodeTrace) : CodeTrace → Prop where + | refl : Descendant root root + | step {parent child : CodeTrace} : + Descendant root parent → child ∈ parent.children → + Descendant root child + +/-- Blocks produced by an immediate recursive call remain in the parent's +flattened canonical block list. -/ +theorem CodeTrace.blocks_subset_of_child {parent child : CodeTrace} + (childMem : child ∈ parent.children) : + ∀ {entry : BlockId × Block}, entry ∈ child.blocks → + entry ∈ parent.blocks := by + cases parent with + | ret _ _ _ _ _ _ _ => + simp [CodeTrace.children] at childMem + | tailCall _ _ _ _ _ _ _ => + simp [CodeTrace.children] at childMem + | tailCallSelf _ _ _ _ _ _ => + simp [CodeTrace.children] at childMem + | letOp _ _ _ _ _ _ _ _ next => + simp [CodeTrace.children] at childMem + subst child + intro entry member + simpa [CodeTrace.blocks] using member + | switchValue source block input entryValueCount sourceScrutinee peel alternatives + targetScrutinee generated outgoing children => + intro entry member + simp only [CodeTrace.children] at childMem + simp only [CodeTrace.blocks, List.mem_cons] + right + exact List.mem_flatMap.mpr ⟨child, childMem, member⟩ + +/-- Every descendant's blocks remain blocks of the root compiler run. -/ +theorem CodeTrace.Descendant.blocks_subset {root child : CodeTrace} + (descendant : Descendant root child) : + ∀ {entry : BlockId × Block}, entry ∈ child.blocks → + entry ∈ root.blocks := by + induction descendant with + | refl => exact fun member => member + | @step parent child parentDescendant childMem ih => + intro entry member + exact ih (CodeTrace.blocks_subset_of_child childMem member) + +namespace CodeTrace + +/-- Extract the local block-entry ABI check from the recursive certificate. -/ +theorem entryValueCountMatches_of_match {trace : CodeTrace} + (matched : trace.entryValueCountsMatch = true) : + trace.entryValueCountMatches = true := by + cases trace with + | ret source block input entryValueCount sourceAtom targetAtom generated => + simpa [CodeTrace.entryValueCountsMatch] using matched + | tailCall source block input entryValueCount address arguments generated => + simpa [CodeTrace.entryValueCountsMatch] using matched + | tailCallSelf source block input entryValueCount arguments generated => + simpa [CodeTrace.entryValueCountsMatch] using matched + | letOp source block input nextInput entryValueCount operation index + instruction next => + simp only [CodeTrace.entryValueCountsMatch, Bool.and_eq_true] at matched + exact matched.1 + | switchValue source block input entryValueCount sourceScrutinee peel + alternatives targetScrutinee generated outgoing children => + simp only [CodeTrace.entryValueCountsMatch, Bool.and_eq_true] at matched + exact matched.1 + +/-- At a checked target block entry, the retained target value count is +exactly the completed head block's value-parameter count. -/ +theorem entryValueCount_eq_headParams_of_match + {trace : CodeTrace} (matched : trace.entryValueCountsMatch = true) + (pc : trace.entryPc = 0) : + trace.entryValueCount = trace.headBlock.2.valueParams.size := by + have localMatch := CodeTrace.entryValueCountMatches_of_match matched + change (if trace.entryPc == 0 then + trace.entryValueCount == trace.headBlock.2.valueParams.size + else true) = true at localMatch + rw [if_pos (beq_iff_eq.mpr pc)] at localMatch + exact beq_iff_eq.mp localMatch + +private theorem codeTraceListEntryValueCountsMatch_of_mem + {traces : List CodeTrace} {child : CodeTrace} + (matched : codeTraceListEntryValueCountsMatch traces = true) + (member : child ∈ traces) : child.entryValueCountsMatch = true := by + induction traces with + | nil => simp at member + | cons head tail ih => + simp only [codeTraceListEntryValueCountsMatch, Bool.and_eq_true] at matched + simp only [List.mem_cons] at member + cases member with + | inl equal => simpa [equal] using matched.1 + | inr member => exact ih matched.2 member + +/-- The recursive block-entry ABI audit is inherited by every immediate +compiler continuation or switch child. -/ +theorem entryValueCountsMatch_of_child {parent child : CodeTrace} + (matched : parent.entryValueCountsMatch = true) + (member : child ∈ parent.children) : + child.entryValueCountsMatch = true := by + cases parent with + | ret source block input entryValueCount sourceAtom targetAtom generated => + simp [CodeTrace.children] at member + | tailCall source block input entryValueCount address arguments generated => + simp [CodeTrace.children] at member + | tailCallSelf source block input entryValueCount arguments generated => + simp [CodeTrace.children] at member + | letOp source block input nextInput entryValueCount operation index + instruction next => + simp [CodeTrace.children] at member + subst child + simp only [CodeTrace.entryValueCountsMatch, Bool.and_eq_true] at matched + exact matched.2 + | switchValue source block input entryValueCount sourceScrutinee peel + alternatives targetScrutinee generated outgoing children => + simp only [CodeTrace.entryValueCountsMatch, Bool.and_eq_true] at matched + exact codeTraceListEntryValueCountsMatch_of_mem + matched.2 member + +/-- Every recursive descendant inherits the checked block-entry target-value +ABI certificate. -/ +theorem Descendant.entryValueCountsMatch {root child : CodeTrace} + (descendant : Descendant root child) + (matched : root.entryValueCountsMatch = true) : + child.entryValueCountsMatch = true := by + induction descendant with + | refl => exact matched + | @step parent child parentDescendant childMem ih => + exact CodeTrace.entryValueCountsMatch_of_child ih childMem + +section InductTree + +variable (motive : CodeTrace → Prop) + (retCase : ∀ source block input entryValueCount sourceAtom targetAtom generated, + motive (.ret source block input entryValueCount sourceAtom targetAtom generated)) + (tailCallCase : ∀ source block input entryValueCount address arguments generated, + motive (.tailCall source block input entryValueCount address arguments generated)) + (tailCallSelfCase : ∀ source block input entryValueCount arguments generated, + motive (.tailCallSelf source block input entryValueCount arguments generated)) + (letOpCase : ∀ source block input nextInput entryValueCount operation targetIndex + targetInstruction next, + motive next → + motive (.letOp source block input nextInput entryValueCount operation targetIndex + targetInstruction next)) + (switchCase : ∀ source block input entryValueCount sourceScrutinee peel alternatives + targetScrutinee generated outgoing children, + (∀ child, child ∈ children → motive child) → + motive (.switchValue source block input entryValueCount sourceScrutinee peel alternatives + targetScrutinee generated outgoing children)) + +include retCase tailCallCase tailCallSelfCase letOpCase switchCase + +mutual + +private theorem inductTreeCore : (trace : CodeTrace) → motive trace + | .ret source block input entryValueCount sourceAtom targetAtom generated => + retCase source block input entryValueCount sourceAtom targetAtom generated + | .tailCall source block input entryValueCount address arguments generated => + tailCallCase source block input entryValueCount address arguments generated + | .tailCallSelf source block input entryValueCount arguments generated => + tailCallSelfCase source block input entryValueCount arguments generated + | .letOp source block input nextInput entryValueCount operation targetIndex + targetInstruction next => + letOpCase source block input nextInput entryValueCount operation targetIndex + targetInstruction next (inductTreeCore next) + | .switchValue source block input entryValueCount sourceScrutinee peel alternatives + targetScrutinee generated outgoing children => + switchCase source block input entryValueCount sourceScrutinee peel alternatives + targetScrutinee generated outgoing children + (inductTreeListCore children) + +private theorem inductTreeListCore : + (traces : List CodeTrace) → ∀ child, child ∈ traces → motive child + | [], child, member => by + let _ := retCase + let _ := tailCallCase + let _ := tailCallSelfCase + let _ := letOpCase + let _ := switchCase + simp at member + | head :: tail, child, member => by + simp only [List.mem_cons] at member + cases member with + | inl equal => + subst child + exact inductTreeCore head + | inr member => exact inductTreeListCore tail child member + +end + +/-- Tree induction that exposes hypotheses for every switch child nested in +the list. This is the proof principle used by the semantic simulation; it +avoids rebuilding recursion from the flat position/edge indexes. -/ +theorem inductTree (trace : CodeTrace) : motive trace := + inductTreeCore motive retCase tailCallCase tailCallSelfCase letOpCase + switchCase trace + +end InductTree + +end CodeTrace + +/-- Exact source-operation/target-instruction syntax correspondence for the +baseline lowering subset. Constructor identities erased by IxIR₁ are checked +elsewhere; all retained operands, addresses, fields, and worlds agree here. -/ +def operationMatches (input : Array (Option Atom)) : IxIR1.Op → Instr → Bool + | .pure source, .move target => + InputMap.translateAtom input source == some target + | .alloc sourceWorld sourceCtor sourceArgs, + .alloc targetWorld targetCtor targetArgs => + sourceWorld == targetWorld && sourceCtor == targetCtor && + InputMap.translateAtoms input sourceArgs == some targetArgs + | .free source, .freeUnique target _ + | .dup source, .retainShared target + | .drop source, .releaseShared target + | .dropU source, .dropUnique target => + InputMap.translateAtom input source == some target + | .fetch source sourceField, .fetch target _ targetField => + sourceField == targetField && + InputMap.translateAtom input source == some target + | .call sourceAddress sourceArgs, .call targetAddress targetArgs + | .papp sourceAddress sourceArgs, .papp targetAddress targetArgs + | .extern sourceAddress sourceArgs, .extern targetAddress targetArgs => + sourceAddress == targetAddress && + InputMap.translateAtoms input sourceArgs == some targetArgs + | .callSelf sourceArgs, .callSelf targetArgs => + InputMap.translateAtoms input sourceArgs == some targetArgs + | .apply sourceFunction sourceArgs, .apply targetFunction targetArgs => + InputMap.translateAtom input sourceFunction == some targetFunction && + InputMap.translateAtoms input sourceArgs == some targetArgs + | _, _ => false + +/-- Proof-facing form of `operationMatches`. It exposes exactly the retained +operand/address/field syntax while intentionally leaving erased constructor +identity at fetch/free sites to the owner-keyed provenance sidecars. -/ +def OperationSyntax (input : Array (Option Atom)) : IxIR1.Op → Instr → Prop + | .pure source, .move target => + InputMap.translateAtom input source = some target + | .alloc sourceWorld sourceCtor sourceArgs, + .alloc targetWorld targetCtor targetArgs => + sourceWorld = targetWorld ∧ sourceCtor = targetCtor ∧ + InputMap.translateAtoms input sourceArgs = some targetArgs + | .free source, .freeUnique target _ + | .dup source, .retainShared target + | .drop source, .releaseShared target + | .dropU source, .dropUnique target => + InputMap.translateAtom input source = some target + | .fetch source sourceField, .fetch target _ targetField => + sourceField = targetField ∧ + InputMap.translateAtom input source = some target + | .call sourceAddress sourceArgs, .call targetAddress targetArgs + | .papp sourceAddress sourceArgs, .papp targetAddress targetArgs + | .extern sourceAddress sourceArgs, .extern targetAddress targetArgs => + sourceAddress = targetAddress ∧ + InputMap.translateAtoms input sourceArgs = some targetArgs + | .callSelf sourceArgs, .callSelf targetArgs => + InputMap.translateAtoms input sourceArgs = some targetArgs + | .apply sourceFunction sourceArgs, .apply targetFunction targetArgs => + InputMap.translateAtom input sourceFunction = some targetFunction ∧ + InputMap.translateAtoms input sourceArgs = some targetArgs + | _, _ => False + +/-- Reflect executable operation syntax checking into its proof-facing form. -/ +theorem operationSyntax_of_match {input : Array (Option Atom)} + {source : IxIR1.Op} {target : Instr} + (matched : operationMatches input source target = true) : + OperationSyntax input source target := by + cases source <;> cases target <;> + simp_all [operationMatches, OperationSyntax, Bool.and_eq_true] + +mutual + +/-- Executable syntax/terminator coherence for the recursive compiler trace. -/ +def CodeTrace.syntaxMatches : CodeTrace → Bool + | .ret _ _ input _ sourceAtom targetAtom generated => + (InputMap.translateAtom input sourceAtom == some targetAtom) && + (generated.terminator == .ret targetAtom) + | .tailCall _ _ input _ sourceAddress sourceArgs generated => + match generated.terminator with + | .tailCall targetAddress targetArgs => + sourceAddress == targetAddress && + (InputMap.translateAtoms input sourceArgs == some targetArgs) + | _ => false + | .tailCallSelf _ _ input _ sourceArgs generated => + match generated.terminator with + | .tailCallSelf targetArgs => + InputMap.translateAtoms input sourceArgs == some targetArgs + | _ => false + | .letOp _ _ input _ _ operation _ instruction next => + operationMatches input operation instruction && next.syntaxMatches + | .switchValue _ _ input _ sourceScrutinee _ _ targetScrutinee generated + _ children => + (InputMap.translateAtom input sourceScrutinee == some targetScrutinee) && + (match generated.terminator with + | .switchValue actual _ _ => actual == targetScrutinee + | _ => false) && + codeTraceListSyntaxMatches children + +private def codeTraceListSyntaxMatches : List CodeTrace → Bool + | [] => true + | trace :: rest => + trace.syntaxMatches && codeTraceListSyntaxMatches rest + +end + +/-- Local syntax facts at an instruction trace node. -/ +theorem CodeTrace.letOpSyntax_of_match + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {operation : IxIR1.Op} {index : Nat} {instruction : Instr} + {next : CodeTrace} + (matched : (CodeTrace.letOp source block input nextInput entryValueCount + operation index instruction next).syntaxMatches = true) : + operationMatches input operation instruction = true ∧ + next.syntaxMatches = true := by + simpa [CodeTrace.syntaxMatches, Bool.and_eq_true] using matched + +/-- Proof-facing source/target operation syntax at one checked instruction +trace node. -/ +theorem CodeTrace.letOpOperationSyntax_of_match + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {operation : IxIR1.Op} {index : Nat} {instruction : Instr} + {next : CodeTrace} + (matched : (CodeTrace.letOp source block input nextInput entryValueCount + operation index instruction next).syntaxMatches = true) : + OperationSyntax input operation instruction := + operationSyntax_of_match (CodeTrace.letOpSyntax_of_match matched).1 + +/-- Local syntax and terminator facts at a return trace node. -/ +theorem CodeTrace.retSyntax_of_match + {source : SourceSite} {block : BlockId} + {input : Array (Option Atom)} {entryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {generated : Block} + (matched : (CodeTrace.ret source block input entryValueCount sourceAtom + targetAtom generated).syntaxMatches = true) : + InputMap.translateAtom input sourceAtom = some targetAtom ∧ + generated.terminator = .ret targetAtom := by + change ((InputMap.translateAtom input sourceAtom == some targetAtom) && + (generated.terminator == Terminator.ret targetAtom)) = true at matched + simp only [Bool.and_eq_true] at matched + exact ⟨beq_iff_eq.mp matched.1, beq_iff_eq.mp matched.2⟩ + +/-- A coherent addressed tail-call node exposes the exact emitted argument +vector and terminator. -/ +theorem CodeTrace.tailCallSyntax_of_match + {source : SourceSite} {block : BlockId} + {input : Array (Option Atom)} {entryValueCount : Nat} + {address : Address} {sourceArgs : Array IxIR1.Atom} + {generated : Block} + (matched : (CodeTrace.tailCall source block input entryValueCount address + sourceArgs generated).syntaxMatches = true) : + ∃ targetArgs, + InputMap.translateAtoms input sourceArgs = some targetArgs ∧ + generated.terminator = .tailCall address targetArgs := by + cases terminatorEq : generated.terminator with + | jump edge => simp [CodeTrace.syntaxMatches, terminatorEq] at matched + | switchValue scrutinee constructors natPeel => + simp [CodeTrace.syntaxMatches, terminatorEq] at matched + | branchCredit credit someEdge noneEdge => + simp [CodeTrace.syntaxMatches, terminatorEq] at matched + | ret value => simp [CodeTrace.syntaxMatches, terminatorEq] at matched + | tailCall targetAddress targetArgs => + simp only [CodeTrace.syntaxMatches, terminatorEq, Bool.and_eq_true] at matched + have addressEq : address = targetAddress := beq_iff_eq.mp matched.1 + subst targetAddress + exact ⟨targetArgs, beq_iff_eq.mp matched.2, rfl⟩ + | tailCallSelf targetArgs => + simp [CodeTrace.syntaxMatches, terminatorEq] at matched + +/-- A coherent self-tail-call node exposes the exact emitted argument vector +and terminator. -/ +theorem CodeTrace.tailCallSelfSyntax_of_match + {source : SourceSite} {block : BlockId} + {input : Array (Option Atom)} {entryValueCount : Nat} + {sourceArgs : Array IxIR1.Atom} {generated : Block} + (matched : (CodeTrace.tailCallSelf source block input entryValueCount + sourceArgs generated).syntaxMatches = true) : + ∃ targetArgs, + InputMap.translateAtoms input sourceArgs = some targetArgs ∧ + generated.terminator = .tailCallSelf targetArgs := by + cases terminatorEq : generated.terminator with + | jump edge => simp [CodeTrace.syntaxMatches, terminatorEq] at matched + | switchValue scrutinee constructors natPeel => + simp [CodeTrace.syntaxMatches, terminatorEq] at matched + | branchCredit credit someEdge noneEdge => + simp [CodeTrace.syntaxMatches, terminatorEq] at matched + | ret value => simp [CodeTrace.syntaxMatches, terminatorEq] at matched + | tailCall targetAddress targetArgs => + simp [CodeTrace.syntaxMatches, terminatorEq] at matched + | tailCallSelf targetArgs => + simp only [CodeTrace.syntaxMatches, terminatorEq] at matched + exact ⟨targetArgs, beq_iff_eq.mp matched, rfl⟩ + +/-- A coherent switch node exposes its translated scrutinee and exact emitted +switch terminator payload. -/ +theorem CodeTrace.switchSyntax_of_match + {source : SourceSite} {block : BlockId} + {input : Array (Option Atom)} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {targetScrutinee : Atom} + {generated : Block} {outgoing : List EdgeTrace} + {children : List CodeTrace} + (matched : (CodeTrace.switchValue source block input entryValueCount + sourceScrutinee peelNat alternatives targetScrutinee generated outgoing + children).syntaxMatches = true) : + ∃ constructors natPeel, + InputMap.translateAtom input sourceScrutinee = some targetScrutinee ∧ + generated.terminator = + .switchValue targetScrutinee constructors natPeel := by + cases terminatorEq : generated.terminator with + | jump edge => simp [CodeTrace.syntaxMatches, terminatorEq] at matched + | switchValue actual constructors natPeel => + simp only [CodeTrace.syntaxMatches, terminatorEq, Bool.and_eq_true] at matched + have scrutineeEq : actual = targetScrutinee := beq_iff_eq.mp matched.1.2 + subst actual + exact ⟨constructors, natPeel, beq_iff_eq.mp matched.1.1, rfl⟩ + | branchCredit credit someEdge noneEdge => + simp [CodeTrace.syntaxMatches, terminatorEq] at matched + | ret value => simp [CodeTrace.syntaxMatches, terminatorEq] at matched + | tailCall targetAddress targetArgs => + simp [CodeTrace.syntaxMatches, terminatorEq] at matched + | tailCallSelf targetArgs => + simp [CodeTrace.syntaxMatches, terminatorEq] at matched + +private theorem codeTraceListSyntaxMatches_of_mem + {traces : List CodeTrace} {child : CodeTrace} + (matched : codeTraceListSyntaxMatches traces = true) + (member : child ∈ traces) : child.syntaxMatches = true := by + induction traces with + | nil => simp at member + | cons head tail ih => + simp only [codeTraceListSyntaxMatches, Bool.and_eq_true] at matched + simp only [List.mem_cons] at member + cases member with + | inl equal => simpa [equal] using matched.1 + | inr member => exact ih matched.2 member + +/-- Syntax coherence is inherited by every immediate recursive call. -/ +theorem CodeTrace.syntaxMatches_of_child {parent child : CodeTrace} + (matched : parent.syntaxMatches = true) + (member : child ∈ parent.children) : + child.syntaxMatches = true := by + cases parent with + | ret _ _ _ _ _ _ _ | tailCall _ _ _ _ _ _ _ + | tailCallSelf _ _ _ _ _ _ => + simp [CodeTrace.children] at member + | letOp source block input nextInput entryValueCount operation index + instruction next => + simp [CodeTrace.children] at member + subst child + exact (CodeTrace.letOpSyntax_of_match matched).2 + | switchValue source block input entryValueCount sourceScrutinee peel + alternatives targetScrutinee generated outgoing children => + simp only [CodeTrace.syntaxMatches, Bool.and_eq_true] at matched + exact codeTraceListSyntaxMatches_of_mem matched.2 member + +/-- Every descendant of a syntax-coherent compiler trace retains exact +source operands and target instruction/terminator syntax. -/ +theorem CodeTrace.Descendant.syntaxMatches {root child : CodeTrace} + (descendant : Descendant root child) + (matched : root.syntaxMatches = true) : + child.syntaxMatches = true := by + induction descendant with + | refl => exact matched + | @step parent child parentDescendant childMem ih => + exact CodeTrace.syntaxMatches_of_child ih childMem + +/-- Value-register delta for the syntax-directed baseline instruction subset. +Credit-producing/consuming optimized instructions are deliberately absent. -/ +def Instr.baselineValueDelta : Instr → Option Nat + | .move _ | .alloc .. | .retainShared _ | .fetch .. + | .call .. | .callSelf _ | .papp .. | .apply .. | .extern .. => some 1 + | .releaseShared _ | .dropUnique _ | .freeUnique .. => some 0 + | .allocWith .. | .discardCredit _ | .takeUnique .. | .resetShared .. => none + +/-- Proof-map atom installed for the new IxIR₁ binder produced by one +baseline target instruction. -/ +def Instr.baselineBinderAtom (entryValueCount : Nat) : Instr → Option Atom + | .move _ | .alloc .. | .retainShared _ | .fetch .. + | .call .. | .callSelf _ | .papp .. | .apply .. | .extern .. => + some (.reg entryValueCount) + | .releaseShared _ | .dropUnique _ | .freeUnique .. => some .erased + | .allocWith .. | .discardCredit _ | .takeUnique .. | .resetShared .. => none + +mutual + +/-- Executable internal coherence check for instruction coordinates retained +by the recursive trace. -/ +def CodeTrace.instructionsMatch : CodeTrace → Bool + | .ret .. | .tailCall .. | .tailCallSelf .. => true + | .letOp source block _ nextInput entryValueCount _ index instruction next => + match Instr.baselineValueDelta instruction with + | some delta => + (next.source == source.next) && + (next.sourceBlock == block) && + (next.sourceInputMap == nextInput) && + (next.entryPc == index + 1) && + (next.entryValueCount == entryValueCount + delta) && + (next.headBlock.1 == block) && + (next.headBlock.2.instructions[index]? == some instruction) && + next.instructionsMatch + | none => false + | .switchValue _ _ _ _ _ _ _ _ _ _ children => + codeTraceListInstructionsMatch children + +private def codeTraceListInstructionsMatch : List CodeTrace → Bool + | [] => true + | trace :: rest => + trace.instructionsMatch && codeTraceListInstructionsMatch rest + +end + +mutual + +/-- Executable coherence check for proof-map progression at every recursive +instruction node. The new binder is retained at the head; every older slot +may stay identical or become dead, but can never be retargeted. -/ +def CodeTrace.inputMapsMatch : CodeTrace → Bool + | .ret .. | .tailCall .. | .tailCallSelf .. => true + | .letOp _ _ input nextInput entryValueCount _ _ instruction next => + match Instr.baselineBinderAtom entryValueCount instruction with + | some head => + (nextInput.size == input.size + 1) && + (nextInput[0]? == some (some head)) && + InputMap.checksForgets nextInput (#[some head] ++ input) && + next.inputMapsMatch + | none => false + | .switchValue _ _ _ _ _ _ _ _ _ _ children => + codeTraceListInputMapsMatch children + +private def codeTraceListInputMapsMatch : List CodeTrace → Bool + | [] => true + | trace :: rest => + trace.inputMapsMatch && codeTraceListInputMapsMatch rest + +end + + +/-- Decode the local proof-map coherence at an instruction node. -/ +theorem CodeTrace.inputMapForgets_of_match + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {operation : IxIR1.Op} + {index : Nat} {instruction : Instr} {next : CodeTrace} + {head : Atom} + (matched : (CodeTrace.letOp source block input nextInput entryValueCount + operation index instruction next).inputMapsMatch = true) + (binder : Instr.baselineBinderAtom entryValueCount instruction = + some head) : + nextInput.size = input.size + 1 ∧ + nextInput[0]? = some (some head) ∧ + InputMap.Forgets nextInput (#[some head] ++ input) ∧ + next.inputMapsMatch = true := by + change (match Instr.baselineBinderAtom entryValueCount instruction with + | some actual => + (nextInput.size == input.size + 1) && + (nextInput[0]? == some (some actual)) && + InputMap.checksForgets nextInput (#[some actual] ++ input) && + next.inputMapsMatch + | none => false) = true at matched + rw [binder] at matched + simp only [Bool.and_eq_true] at matched + exact ⟨beq_iff_eq.mp matched.1.1.1, + beq_iff_eq.mp matched.1.1.2, + InputMap.forgets_of_check matched.1.2, matched.2⟩ + +/-- Every retained instruction binder grows the source proof map by exactly +one slot, even when its target instruction is effect-only. -/ +theorem CodeTrace.inputMapSize_of_match + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {operation : IxIR1.Op} + {index : Nat} {instruction : Instr} {next : CodeTrace} + (matched : (CodeTrace.letOp source block input nextInput entryValueCount + operation index instruction next).inputMapsMatch = true) : + nextInput.size = input.size + 1 := by + cases binder : Instr.baselineBinderAtom entryValueCount instruction with + | none => simp [CodeTrace.inputMapsMatch, binder] at matched + | some head => + exact (CodeTrace.inputMapForgets_of_match matched binder).1 + +/-- Structural facts certified at one instruction/continuation node. -/ +structure CodeTrace.LetOpMatch + (source : SourceSite) (block : BlockId) + (input nextInput : Array (Option Atom)) (entryValueCount : Nat) + (operation : IxIR1.Op) + (index : Nat) (instruction : Instr) (next : CodeTrace) : Prop where + nextSource : next.source = source.next + nextBlock : next.sourceBlock = block + nextInput : next.sourceInputMap = nextInput + nextPc : next.entryPc = index + 1 + nextValueCount : next.entryValueCount = entryValueCount + + ((Instr.baselineValueDelta instruction).getD 0) + headBlock : next.headBlock.1 = block + instructionAt : next.headBlock.2.instructions[index]? = some instruction + nextInstructions : next.instructionsMatch = true + +/-- Decode the executable instruction-node coherence check into the exact +source-site, environment-map, block, and instruction equalities used by the +semantic induction. -/ +theorem CodeTrace.letOpMatch_of_match + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {operation : IxIR1.Op} + {index : Nat} {instruction : Instr} {next : CodeTrace} + (matched : (CodeTrace.letOp source block input nextInput entryValueCount + operation index instruction next).instructionsMatch = true) : + CodeTrace.LetOpMatch source block input nextInput entryValueCount operation + index instruction next := by + change (match Instr.baselineValueDelta instruction with + | some delta => + (next.source == source.next) && + (next.sourceBlock == block) && + (next.sourceInputMap == nextInput) && + (next.entryPc == index + 1) && + (next.entryValueCount == entryValueCount + delta) && + (next.headBlock.1 == block) && + (next.headBlock.2.instructions[index]? == some instruction) && + next.instructionsMatch + | none => false) = true at matched + cases deltaEq : Instr.baselineValueDelta instruction with + | none => simp [deltaEq] at matched + | some delta => + rw [deltaEq] at matched + simp only [Bool.and_eq_true] at matched + obtain ⟨⟨⟨⟨⟨⟨⟨nextSource, nextBlock⟩, nextInput⟩, + nextPc⟩, nextValueCount⟩, headBlock⟩, instructionAt⟩, + nextInstructions⟩ := matched + exact + { nextSource := beq_iff_eq.mp nextSource + nextBlock := beq_iff_eq.mp nextBlock + nextInput := beq_iff_eq.mp nextInput + nextPc := beq_iff_eq.mp nextPc + nextValueCount := by + simpa [deltaEq] using (beq_iff_eq.mp nextValueCount) + headBlock := beq_iff_eq.mp headBlock + instructionAt := beq_iff_eq.mp instructionAt + nextInstructions } + +/-- A coherent recursive trace positioned at its completed block terminator +and exposing a target self tail call is itself the corresponding source +self-tail node. A nested instruction node is excluded by its retained +instruction slot, while every other terminal trace kind emits a distinct +terminator constructor. -/ +theorem CodeTrace.tailCallSelf_of_terminal + (trace : CodeTrace) {targetArgs : Array Atom} + (syntaxMatch : trace.syntaxMatches = true) + (instructions : trace.instructionsMatch = true) + (terminalPc : trace.entryPc = trace.headBlock.2.instructions.size) + (terminator : trace.headBlock.2.terminator = + .tailCallSelf targetArgs) : + ∃ (source : SourceSite) (block : BlockId) + (input : Array (Option Atom)) (entryValueCount : Nat) + (sourceArgs : Array IxIR1.Atom) (generated : Block), + trace = .tailCallSelf source block input entryValueCount sourceArgs + generated ∧ + InputMap.translateAtoms input sourceArgs = some targetArgs := by + cases trace with + | ret source block input entryValueCount sourceAtom targetAtom generated => + simp only [CodeTrace.headBlock] at terminator + have emitted := (CodeTrace.retSyntax_of_match syntaxMatch).2 + rw [emitted] at terminator + cases terminator + | tailCall source block input entryValueCount address sourceArgs generated => + simp only [CodeTrace.headBlock] at terminator + obtain ⟨target, _translated, emitted⟩ := + CodeTrace.tailCallSyntax_of_match syntaxMatch + rw [emitted] at terminator + cases terminator + | tailCallSelf source block input entryValueCount sourceArgs generated => + simp only [CodeTrace.headBlock] at terminator + obtain ⟨target, translated, emitted⟩ := + CodeTrace.tailCallSelfSyntax_of_match syntaxMatch + have targetEq : target = targetArgs := by + rw [emitted] at terminator + injection terminator + subst target + exact ⟨source, block, input, entryValueCount, sourceArgs, generated, + rfl, translated⟩ + | letOp source block input nextInput entryValueCount operation index + instruction next => + have matched := CodeTrace.letOpMatch_of_match instructions + have bound := (Array.getElem?_eq_some_iff.mp matched.instructionAt).1 + simp only [CodeTrace.entryPc, CodeTrace.headBlock] at terminalPc + omega + | switchValue source block input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children => + simp only [CodeTrace.headBlock] at terminator + obtain ⟨constructors, natPeel, _translated, emitted⟩ := + CodeTrace.switchSyntax_of_match syntaxMatch + rw [emitted] at terminator + cases terminator + +/-- A coherent instruction trace points to the exact retained instruction in +the completed block shared with its continuation. -/ +theorem CodeTrace.instructionAt_of_match + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {operation : IxIR1.Op} + {index : Nat} {instruction : Instr} {next : CodeTrace} + (matched : (CodeTrace.letOp source block input nextInput entryValueCount + operation index instruction next).instructionsMatch = true) : + next.headBlock.2.instructions[index]? = some instruction := + (CodeTrace.letOpMatch_of_match matched).instructionAt + +/-- Instruction coherence also identifies the recursive run's completed head +block with the block in which that source run began. -/ +theorem CodeTrace.headBlock_eq_sourceBlock_of_match {trace : CodeTrace} + (matched : trace.instructionsMatch = true) : + trace.headBlock.1 = trace.sourceBlock := by + cases trace with + | ret source sourceBlock sourceInput entryValueCount sourceAtom targetAtom generated => rfl + | tailCall source sourceBlock sourceInput entryValueCount address arguments generated => rfl + | tailCallSelf source sourceBlock sourceInput entryValueCount arguments generated => rfl + | letOp source block input nextInput entryValueCount operation index instruction next => + exact (CodeTrace.letOpMatch_of_match matched).headBlock + | switchValue source sourceBlock sourceInput entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children => rfl + +private theorem codeTraceListInstructionsMatch_of_mem + {traces : List CodeTrace} {child : CodeTrace} + (matched : codeTraceListInstructionsMatch traces = true) + (member : child ∈ traces) : child.instructionsMatch = true := by + induction traces with + | nil => simp at member + | cons head tail ih => + simp only [codeTraceListInstructionsMatch, Bool.and_eq_true] at matched + simp only [List.mem_cons] at member + cases member with + | inl equal => simpa [equal] using matched.1 + | inr member => exact ih matched.2 member + +/-- Instruction coherence is inherited by every immediate recursive call. -/ +theorem CodeTrace.instructionsMatch_of_child {parent child : CodeTrace} + (matched : parent.instructionsMatch = true) + (member : child ∈ parent.children) : + child.instructionsMatch = true := by + cases parent with + | ret _ _ _ _ _ _ _ | tailCall _ _ _ _ _ _ _ + | tailCallSelf _ _ _ _ _ _ => + simp [CodeTrace.children] at member + | letOp source block input nextInput entryValueCount operation index instruction next => + simp [CodeTrace.children] at member + subst child + exact (CodeTrace.letOpMatch_of_match matched).nextInstructions + | switchValue source block input entryValueCount sourceScrutinee peel alternatives + targetScrutinee generated outgoing children => + exact codeTraceListInstructionsMatch_of_mem matched member + +/-- Every descendant of a coherent compiler trace is instruction-coherent. -/ +theorem CodeTrace.Descendant.instructionsMatch {root child : CodeTrace} + (descendant : Descendant root child) + (matched : root.instructionsMatch = true) : + child.instructionsMatch = true := by + induction descendant with + | refl => exact matched + | @step parent child parentDescendant childMem ih => + exact CodeTrace.instructionsMatch_of_child ih childMem + +private theorem codeTraceListInputMapsMatch_of_mem + {traces : List CodeTrace} {child : CodeTrace} + (matched : codeTraceListInputMapsMatch traces = true) + (member : child ∈ traces) : child.inputMapsMatch = true := by + induction traces with + | nil => simp at member + | cons head tail ih => + simp only [codeTraceListInputMapsMatch, Bool.and_eq_true] at matched + simp only [List.mem_cons] at member + cases member with + | inl equal => simpa [equal] using matched.1 + | inr member => exact ih matched.2 member + +/-- Proof-map coherence is inherited by every immediate recursive call. -/ +theorem CodeTrace.inputMapsMatch_of_child {parent child : CodeTrace} + (matched : parent.inputMapsMatch = true) + (member : child ∈ parent.children) : + child.inputMapsMatch = true := by + cases parent with + | ret _ _ _ _ _ _ _ | tailCall _ _ _ _ _ _ _ + | tailCallSelf _ _ _ _ _ _ => + simp [CodeTrace.children] at member + | letOp source block input nextInput entryValueCount operation index instruction next => + simp [CodeTrace.children] at member + subst child + cases binder : Instr.baselineBinderAtom entryValueCount instruction with + | none => simp [CodeTrace.inputMapsMatch, binder] at matched + | some head => + exact (CodeTrace.inputMapForgets_of_match matched binder).2.2.2 + | switchValue source block input entryValueCount sourceScrutinee peel alternatives + targetScrutinee generated outgoing children => + exact codeTraceListInputMapsMatch_of_mem matched member + +/-- Every descendant of a coherent compiler trace has coherent proof-map +progression. -/ +theorem CodeTrace.Descendant.inputMapsMatch {root child : CodeTrace} + (descendant : Descendant root child) + (matched : root.inputMapsMatch = true) : + child.inputMapsMatch = true := by + induction descendant with + | refl => exact matched + | @step parent child parentDescendant childMem ih => + exact CodeTrace.inputMapsMatch_of_child ih childMem + +private def sourceOpEq : IxIR1.Op → IxIR1.Op → Bool + | .pure left, .pure right => left == right + | .alloc lw lc la, .alloc rw rc ra => + lw == rw && lc == rc && la == ra + | .reuse lt lc la, .reuse rt rc ra => + lt == rt && lc == rc && la == ra + | .free left, .free right + | .dup left, .dup right + | .drop left, .drop right + | .dropU left, .dropU right => left == right + | .fetch lt lf, .fetch rt rf => lt == rt && lf == rf + | .call lf la, .call rf ra + | .papp lf la, .papp rf ra + | .extern lf la, .extern rf ra => lf == rf && la == ra + | .callSelf left, .callSelf right => left == right + | .apply lf la, .apply rf ra => lf == rf && la == ra + | _, _ => false + +private theorem sourceOpEq_eq_true_iff (left right : IxIR1.Op) : + sourceOpEq left right = true ↔ left = right := by + cases left <;> cases right <;> + simp [sourceOpEq, beq_iff_eq, and_assoc] + +mutual + +private def sourceCodeEq : IxIR1.Code → IxIR1.Code → Bool + | .ret left, .ret right => left == right + | .letOp leftOp leftRest, .letOp rightOp rightRest => + sourceOpEq leftOp rightOp && sourceCodeEq leftRest rightRest + | .case ls lp la, .case rs rp ra => + ls == rs && lp == rp && sourceAltListEq la.toList ra.toList + | _, _ => false + +private def sourceAltEq : IxIR1.Alt → IxIR1.Alt → Bool + | .mk lc lf lb, .mk rc rf rb => + lc == rc && lf == rf && sourceCodeEq lb rb + +private def sourceAltListEq : List IxIR1.Alt → List IxIR1.Alt → Bool + | [], [] => true + | left :: leftRest, right :: rightRest => + sourceAltEq left right && sourceAltListEq leftRest rightRest + | _, _ => false + +end + +mutual + +private theorem sourceCodeEq_eq_true_iff + (left right : IxIR1.Code) : + sourceCodeEq left right = true ↔ left = right := by + cases left <;> cases right <;> + simp [sourceCodeEq, sourceOpEq_eq_true_iff, + sourceCodeEq_eq_true_iff, sourceAltListEq_eq_true_iff, + beq_iff_eq, and_assoc] + +private theorem sourceAltEq_eq_true_iff + (left right : IxIR1.Alt) : + sourceAltEq left right = true ↔ left = right := by + cases left + cases right + simp [sourceAltEq, sourceCodeEq_eq_true_iff, beq_iff_eq, and_assoc] + +private theorem sourceAltListEq_eq_true_iff + (left right : List IxIR1.Alt) : + sourceAltListEq left right = true ↔ left = right := by + cases left with + | nil => cases right <;> simp [sourceAltListEq] + | cons left leftRest => + cases right with + | nil => simp [sourceAltListEq] + | cons right rightRest => + simp [sourceAltListEq, sourceAltEq_eq_true_iff, + sourceAltListEq_eq_true_iff] + +end + +/-- Locate the unique source alternative selected by a constructor tag, +retaining its source-array ordinal for `SourceSite.alternative`. Successful +lowering rejects duplicate tags before constructing a switch trace. -/ +def sourceAlternativeAtTag? (alternatives : Array IxIR1.Alt) (tag : Nat) : + Option (IxIR1.Alt × Nat) := + alternatives.toList.zipIdx.find? fun pair => + match pair.1 with + | .mk candidate _ _ => candidate == tag + +/-- Forgetting the retained source ordinal recovers the evaluator's ordinary +first-matching-alternative lookup. -/ +theorem sourceAlternativeAtTag?_map_fst + (alternatives : Array IxIR1.Alt) (tag : Nat) : + (sourceAlternativeAtTag? alternatives tag).map Prod.fst = + alternatives.find? (fun alternative => + match alternative with + | .mk candidate _ _ => candidate == tag) := by + rw [sourceAlternativeAtTag?] + rw [← Array.find?_toList] + let predicate : IxIR1.Alt → Bool := fun alternative => + match alternative with + | .mk candidate _ _ => candidate == tag + change Option.map Prod.fst + (alternatives.toList.zipIdx.find? (predicate ∘ Prod.fst)) = + alternatives.toList.find? predicate + rw [← List.find?_map] + simp only [List.zipIdx_map_fst] + +/-- Lift the evaluator's successful alternative lookup to the indexed form +retained by a lowering trace. -/ +theorem sourceAlternativeAtTag?_of_find? + {alternatives : Array IxIR1.Alt} {tag : Nat} + {alternative : IxIR1.Alt} + (found : alternatives.find? (fun candidate => + match candidate with + | .mk candidateTag _ _ => candidateTag == tag) = some alternative) : + ∃ index, + sourceAlternativeAtTag? alternatives tag = some (alternative, index) := by + have mapped : + (sourceAlternativeAtTag? alternatives tag).map Prod.fst = + some alternative := by + rw [sourceAlternativeAtTag?_map_fst, found] + obtain ⟨pair, pairFound, first⟩ := Option.map_eq_some_iff.mp mapped + obtain ⟨selected, index⟩ := pair + simp only at first + subst selected + exact ⟨index, pairFound⟩ + +/-- A successful tag lookup retains the literal source-array ordinal of the +selected alternative. -/ +theorem sourceAlternativeAtTag?_getElem? {alternatives : Array IxIR1.Alt} + {tag : Nat} {alternative : IxIR1.Alt} {index : Nat} + (found : sourceAlternativeAtTag? alternatives tag = + some (alternative, index)) : + alternatives[index]? = some alternative := by + have member : (alternative, index) ∈ alternatives.toList.zipIdx := + List.mem_of_find?_eq_some found + have selected : alternatives.toList[index]? = some alternative := + List.mk_mem_zipIdx_iff_getElem?.mp member + simpa using selected + +/-- The constructor tag stored in a successful lookup is the searched tag. -/ +theorem sourceAlternativeAtTag?_tag {alternatives : Array IxIR1.Alt} + {tag actualTag fieldCount : Nat} {body : IxIR1.Code} {index : Nat} + (found : sourceAlternativeAtTag? alternatives tag = + some (.mk actualTag fieldCount body, index)) : + actualTag = tag := by + have matched := List.find?_some found + exact beq_iff_eq.mp matched + +/-- Source proof map after a constructor edge and its generated field-fetch +prologue. IxIR₁ binds fields in reverse order, while IxIR₂ appends fetch +results in increasing field order. -/ +def constructorChildInputMap (parameterCount fieldCount : Nat) : + Array (Option Atom) := + (List.range fieldCount).reverse.toArray.map fun field => + some (.reg (parameterCount + field)) + +/-- Executable certificate for the exact fetch prefix inserted before a +constructor alternative's source body. -/ +def fetchPrologueMatches (instructions : Array Instr) (target : Atom) + (cid : CtorId) (fieldCount : Nat) : Bool := + (List.range fieldCount).all fun field => + instructions[field]? == some (.fetch target cid field) + +/-- Every certified field ordinal names the exact generated fetch. -/ +theorem fetchPrologueAt_of_match {instructions : Array Instr} {target : Atom} + {cid : CtorId} {fieldCount field : Nat} + (matched : fetchPrologueMatches instructions target cid fieldCount = true) + (bound : field < fieldCount) : + instructions[field]? = some (.fetch target cid field) := by + have member : field ∈ List.range fieldCount := List.mem_range.mpr bound + have checked := List.all_eq_true.mp matched field member + exact beq_iff_eq.mp checked + +/-- Exact association of one emitted constructor target, its retained edge, +and the recursive compiler call for the corresponding source alternative. -/ +def constructorBranchMatches (source : SourceSite) (sourceBlock : BlockId) + (sourceInputMap : Array (Option Atom)) + (sourceScrutinee : IxIR1.Atom) (alternatives : Array IxIR1.Alt) + (target : CtorAlt) (edge : EdgeTrace) (child : CodeTrace) : Bool := + match sourceAlternativeAtTag? alternatives target.cid.cidx, + InputMap.translateAtom (EdgeTrace.explicitMapOf sourceInputMap) + sourceScrutinee with + | some (.mk tag fieldCount body, alternativeIndex), some childScrutinee => + (tag == target.cid.cidx) && + (edge.source == source) && + (edge.sourceBlock == sourceBlock) && + (edge.sourceInputMap == sourceInputMap) && + (edge.implicitScalars == 0) && + (edge.targetParams.size == + edge.implicitScalars + edge.sourceInputMap.size) && + (edge.target == target.edge.target) && + (target.edge.values == edge.explicitValues) && + target.edge.credits.isEmpty && + (child.source == source.alternative alternativeIndex) && + sourceCodeEq child.sourceCode body && + (child.sourceBlock == edge.target) && + (child.sourceInputMap == + constructorChildInputMap edge.targetParams.size fieldCount ++ + EdgeTrace.explicitMapOf edge.sourceInputMap) && + (child.entryPc == fieldCount) && + (child.entryValueCount == edge.targetParams.size + fieldCount) && + (child.headBlock.1 == edge.target) && + (child.headBlock.2.valueParams == edge.targetParams) && + child.headBlock.2.creditParams.isEmpty && + fetchPrologueMatches child.headBlock.2.instructions childScrutinee + target.cid fieldCount + | _, _ => false + +/-- Exact association for one literal-Nat edge. The successor edge has one +implicit scalar parameter; the zero edge has none. -/ +def natBranchMatches (source : SourceSite) (sourceBlock : BlockId) + (sourceInputMap : Array (Option Atom)) (alternatives : Array IxIR1.Alt) + (tag fieldCount implicitScalars : Nat) (target : Edge) + (edge : EdgeTrace) (child : CodeTrace) : Bool := + match sourceAlternativeAtTag? alternatives tag with + | some (.mk actualTag actualFieldCount body, alternativeIndex) => + (actualTag == tag) && + (actualFieldCount == fieldCount) && + (edge.source == source) && + (edge.sourceBlock == sourceBlock) && + (edge.sourceInputMap == sourceInputMap) && + (edge.implicitScalars == implicitScalars) && + (edge.targetParams.size == + edge.implicitScalars + edge.sourceInputMap.size) && + (edge.target == target.target) && + (target.values == edge.explicitValues) && + target.credits.isEmpty && + (child.source == source.alternative alternativeIndex) && + sourceCodeEq child.sourceCode body && + (child.sourceBlock == edge.target) && + (child.sourceInputMap == edge.sourceMap) && + (child.entryPc == 0) && + (child.entryValueCount == edge.targetParams.size) && + (child.headBlock.1 == edge.target) && + (child.headBlock.2.valueParams == edge.targetParams) && + child.headBlock.2.creditParams.isEmpty && + (if implicitScalars == 1 then + edge.targetParams[0]? == some .scalar + else implicitScalars == 0) + | none => false + +/-- Proof-facing facts reflected from one successful constructor-branch +association check. -/ +structure ConstructorBranchMatch (source : SourceSite) + (sourceBlock : BlockId) (sourceInputMap : Array (Option Atom)) + (sourceScrutinee : IxIR1.Atom) (alternatives : Array IxIR1.Alt) + (target : CtorAlt) (edge : EdgeTrace) (child : CodeTrace) : Type where + alternativeIndex : Nat + tag : Nat + fieldCount : Nat + body : IxIR1.Code + childScrutinee : Atom + sourceAlternative : sourceAlternativeAtTag? alternatives target.cid.cidx = + some (.mk tag fieldCount body, alternativeIndex) + translatedScrutinee : + InputMap.translateAtom (EdgeTrace.explicitMapOf sourceInputMap) + sourceScrutinee = some childScrutinee + constructorTag : tag = target.cid.cidx + edgeSource : edge.source = source + edgeSourceBlock : edge.sourceBlock = sourceBlock + edgeSourceInput : edge.sourceInputMap = sourceInputMap + edgeImplicitScalars : edge.implicitScalars = 0 + edgeParameterCount : edge.targetParams.size = + edge.implicitScalars + edge.sourceInputMap.size + edgeTarget : edge.target = target.edge.target + edgeValues : target.edge.values = edge.explicitValues + edgeCredits : target.edge.credits.isEmpty = true + childSource : child.source = source.alternative alternativeIndex + childCode : child.sourceCode = body + childBlock : child.sourceBlock = edge.target + childInput : child.sourceInputMap = + constructorChildInputMap edge.targetParams.size fieldCount ++ + EdgeTrace.explicitMapOf edge.sourceInputMap + childPc : child.entryPc = fieldCount + childValueCount : child.entryValueCount = + edge.targetParams.size + fieldCount + childHeadBlock : child.headBlock.1 = edge.target + childParams : child.headBlock.2.valueParams = edge.targetParams + childCredits : child.headBlock.2.creditParams.isEmpty = true + fetchPrologue : fetchPrologueMatches child.headBlock.2.instructions + childScrutinee target.cid fieldCount = true + +/-- Reflect an executable constructor association into exact source, edge, +child, and fetch-prologue facts. -/ +def constructorBranchMatch_of_match + {source : SourceSite} {sourceBlock : BlockId} + {sourceInputMap : Array (Option Atom)} + {sourceScrutinee : IxIR1.Atom} {alternatives : Array IxIR1.Alt} + {target : CtorAlt} {edge : EdgeTrace} {child : CodeTrace} + (matched : constructorBranchMatches source sourceBlock sourceInputMap + sourceScrutinee alternatives target edge child = true) : + ConstructorBranchMatch source sourceBlock sourceInputMap sourceScrutinee + alternatives target edge child := by + unfold constructorBranchMatches at matched + generalize alternativeEq : + sourceAlternativeAtTag? alternatives target.cid.cidx = alternative at matched + cases alternative with + | none => simp at matched + | some pair => + obtain ⟨alternative, alternativeIndex⟩ := pair + cases alternative with + | mk tag fieldCount body => + generalize translatedEq : + InputMap.translateAtom + (EdgeTrace.explicitMapOf sourceInputMap) sourceScrutinee = + translated at matched + cases translated with + | none => simp at matched + | some childScrutinee => + simp only [Bool.and_eq_true] at matched + obtain ⟨rest, fetchPrologue⟩ := matched + obtain ⟨rest, childCredits⟩ := rest + obtain ⟨rest, childParams⟩ := rest + obtain ⟨rest, childHeadBlock⟩ := rest + obtain ⟨rest, childValueCount⟩ := rest + obtain ⟨rest, childPc⟩ := rest + obtain ⟨rest, childInput⟩ := rest + obtain ⟨rest, childBlock⟩ := rest + obtain ⟨rest, childCode⟩ := rest + obtain ⟨rest, childSource⟩ := rest + obtain ⟨rest, edgeCredits⟩ := rest + obtain ⟨rest, edgeValues⟩ := rest + obtain ⟨rest, edgeTarget⟩ := rest + obtain ⟨rest, edgeParameterCount⟩ := rest + obtain ⟨rest, edgeImplicitScalars⟩ := rest + obtain ⟨rest, edgeSourceInput⟩ := rest + obtain ⟨rest, edgeSourceBlock⟩ := rest + obtain ⟨constructorTag, edgeSource⟩ := rest + exact + { alternativeIndex + tag + fieldCount + body + childScrutinee + sourceAlternative := alternativeEq + translatedScrutinee := translatedEq + constructorTag := beq_iff_eq.mp constructorTag + edgeSource := beq_iff_eq.mp edgeSource + edgeSourceBlock := beq_iff_eq.mp edgeSourceBlock + edgeSourceInput := beq_iff_eq.mp edgeSourceInput + edgeImplicitScalars := beq_iff_eq.mp edgeImplicitScalars + edgeParameterCount := beq_iff_eq.mp edgeParameterCount + edgeTarget := beq_iff_eq.mp edgeTarget + edgeValues := beq_iff_eq.mp edgeValues + edgeCredits + childSource := beq_iff_eq.mp childSource + childCode := (sourceCodeEq_eq_true_iff _ _).mp childCode + childBlock := beq_iff_eq.mp childBlock + childInput := beq_iff_eq.mp childInput + childPc := beq_iff_eq.mp childPc + childValueCount := beq_iff_eq.mp childValueCount + childHeadBlock := beq_iff_eq.mp childHeadBlock + childParams := beq_iff_eq.mp childParams + childCredits + fetchPrologue } + +/-- Proof-facing facts reflected from one successful literal-Nat branch +association check. -/ +structure NatBranchMatch (source : SourceSite) (sourceBlock : BlockId) + (sourceInputMap : Array (Option Atom)) (alternatives : Array IxIR1.Alt) + (tag fieldCount implicitScalars : Nat) (target : Edge) + (edge : EdgeTrace) (child : CodeTrace) : Type where + alternativeIndex : Nat + body : IxIR1.Code + sourceAlternative : sourceAlternativeAtTag? alternatives tag = + some (.mk tag fieldCount body, alternativeIndex) + edgeSource : edge.source = source + edgeSourceBlock : edge.sourceBlock = sourceBlock + edgeSourceInput : edge.sourceInputMap = sourceInputMap + edgeImplicitScalars : edge.implicitScalars = implicitScalars + edgeParameterCount : edge.targetParams.size = + edge.implicitScalars + edge.sourceInputMap.size + edgeTarget : edge.target = target.target + edgeValues : target.values = edge.explicitValues + edgeCredits : target.credits.isEmpty = true + childSource : child.source = source.alternative alternativeIndex + childCode : child.sourceCode = body + childBlock : child.sourceBlock = edge.target + childInput : child.sourceInputMap = edge.sourceMap + childPc : child.entryPc = 0 + childValueCount : child.entryValueCount = edge.targetParams.size + childHeadBlock : child.headBlock.1 = edge.target + childParams : child.headBlock.2.valueParams = edge.targetParams + childCredits : child.headBlock.2.creditParams.isEmpty = true + implicitConvention : + (if implicitScalars == 1 then + edge.targetParams[0]? == some .scalar + else implicitScalars == 0) = true + +/-- Reflect an executable Nat association into exact source, edge, child, and +implicit-predecessor facts. -/ +def natBranchMatch_of_match + {source : SourceSite} {sourceBlock : BlockId} + {sourceInputMap : Array (Option Atom)} {alternatives : Array IxIR1.Alt} + {tag fieldCount implicitScalars : Nat} {target : Edge} + {edge : EdgeTrace} {child : CodeTrace} + (matched : natBranchMatches source sourceBlock sourceInputMap alternatives + tag fieldCount implicitScalars target edge child = true) : + NatBranchMatch source sourceBlock sourceInputMap alternatives tag + fieldCount implicitScalars target edge child := by + unfold natBranchMatches at matched + generalize alternativeEq : + sourceAlternativeAtTag? alternatives tag = alternative at matched + cases alternative with + | none => simp at matched + | some pair => + obtain ⟨alternative, alternativeIndex⟩ := pair + cases alternative with + | mk actualTag actualFieldCount body => + simp only [Bool.and_eq_true] at matched + obtain ⟨rest, implicitConvention⟩ := matched + obtain ⟨rest, childCredits⟩ := rest + obtain ⟨rest, childParams⟩ := rest + obtain ⟨rest, childHeadBlock⟩ := rest + obtain ⟨rest, childValueCount⟩ := rest + obtain ⟨rest, childPc⟩ := rest + obtain ⟨rest, childInput⟩ := rest + obtain ⟨rest, childBlock⟩ := rest + obtain ⟨rest, childCode⟩ := rest + obtain ⟨rest, childSource⟩ := rest + obtain ⟨rest, edgeCredits⟩ := rest + obtain ⟨rest, edgeValues⟩ := rest + obtain ⟨rest, edgeTarget⟩ := rest + obtain ⟨rest, edgeParameterCount⟩ := rest + obtain ⟨rest, edgeImplicitScalars⟩ := rest + obtain ⟨rest, edgeSourceInput⟩ := rest + obtain ⟨rest, edgeSourceBlock⟩ := rest + obtain ⟨rest, edgeSource⟩ := rest + obtain ⟨actualTagEq, actualFieldCountEq⟩ := rest + have tagEq : actualTag = tag := beq_iff_eq.mp actualTagEq + have fieldCountEq : actualFieldCount = fieldCount := + beq_iff_eq.mp actualFieldCountEq + subst actualTag + subst actualFieldCount + exact + { alternativeIndex + body + sourceAlternative := alternativeEq + edgeSource := beq_iff_eq.mp edgeSource + edgeSourceBlock := beq_iff_eq.mp edgeSourceBlock + edgeSourceInput := beq_iff_eq.mp edgeSourceInput + edgeImplicitScalars := beq_iff_eq.mp edgeImplicitScalars + edgeParameterCount := beq_iff_eq.mp edgeParameterCount + edgeTarget := beq_iff_eq.mp edgeTarget + edgeValues := beq_iff_eq.mp edgeValues + edgeCredits + childSource := beq_iff_eq.mp childSource + childCode := (sourceCodeEq_eq_true_iff _ _).mp childCode + childBlock := beq_iff_eq.mp childBlock + childInput := beq_iff_eq.mp childInput + childPc := beq_iff_eq.mp childPc + childValueCount := beq_iff_eq.mp childValueCount + childHeadBlock := beq_iff_eq.mp childHeadBlock + childParams := beq_iff_eq.mp childParams + childCredits + implicitConvention } + +/-- Local switch certificate. Constructor targets consume the first parallel +edge/child entries in emitted order; an optional Nat zero/successor pair +consumes exactly the final two. No unassociated edge or child is permitted. -/ +def switchNodeBranchesMatch (source : SourceSite) (sourceBlock : BlockId) + (sourceInputMap : Array (Option Atom)) + (sourceScrutinee : IxIR1.Atom) (peelNat : Bool) + (alternatives : Array IxIR1.Alt) (generated : Block) + (outgoing : List EdgeTrace) (children : List CodeTrace) : Bool := + match generated.terminator with + | .switchValue _ constructors natPeel => + let constructorCount := constructors.size + let natCount := if natPeel.isSome then 2 else 0 + (outgoing.length == constructorCount + natCount) && + (children.length == constructorCount + natCount) && + (constructors.toList.zipIdx.all fun pair => + match outgoing[pair.2]?, children[pair.2]? with + | some edge, some child => + constructorBranchMatches source sourceBlock sourceInputMap + sourceScrutinee alternatives pair.1 edge child + | _, _ => false) && + match peelNat, natPeel with + | false, none => true + | true, some peel => + match outgoing[constructorCount]?, children[constructorCount]?, + outgoing[constructorCount + 1]?, children[constructorCount + 1]? + with + | some zeroEdge, some zeroChild, some succEdge, some succChild => + natBranchMatches source sourceBlock sourceInputMap alternatives + 0 0 0 peel.zero zeroEdge zeroChild && + natBranchMatches source sourceBlock sourceInputMap alternatives + 1 1 1 peel.succ succEdge succChild + | _, _, _, _ => false + | _, _ => false + | _ => false + +/-- A checked switch exposes its exact emitted target vectors, with no spare +edge or child and with Nat presence agreeing with the source flag. -/ +theorem switchBranchShape_of_match + {source : SourceSite} {sourceBlock : BlockId} + {sourceInputMap : Array (Option Atom)} + {sourceScrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {generated : Block} + {outgoing : List EdgeTrace} {children : List CodeTrace} + (matched : switchNodeBranchesMatch source sourceBlock sourceInputMap + sourceScrutinee peelNat alternatives generated outgoing children = true) : + ∃ targetScrutinee constructors natPeel, + generated.terminator = + .switchValue targetScrutinee constructors natPeel ∧ + outgoing.length = constructors.size + + (if natPeel.isSome then 2 else 0) ∧ + children.length = constructors.size + + (if natPeel.isSome then 2 else 0) ∧ + peelNat = natPeel.isSome := by + cases terminatorEq : generated.terminator with + | jump edge => simp [switchNodeBranchesMatch, terminatorEq] at matched + | branchCredit credit someEdge noneEdge => + simp [switchNodeBranchesMatch, terminatorEq] at matched + | ret value => simp [switchNodeBranchesMatch, terminatorEq] at matched + | tailCall function arguments => + simp [switchNodeBranchesMatch, terminatorEq] at matched + | tailCallSelf arguments => + simp [switchNodeBranchesMatch, terminatorEq] at matched + | switchValue targetScrutinee constructors natPeel => + simp only [switchNodeBranchesMatch, terminatorEq, Bool.and_eq_true] at matched + obtain ⟨⟨⟨outgoingLength, childrenLength⟩, _⟩, natMatched⟩ := matched + refine ⟨targetScrutinee, constructors, natPeel, rfl, + beq_iff_eq.mp outgoingLength, beq_iff_eq.mp childrenLength, ?_⟩ + cases peelNat <;> cases natPeel <;> simp_all + +/-- Select one constructor association from a checked switch once its three +parallel entries are named. The list-shape theorem above supplies their +existence; this definition supplies all semantic facts. -/ +def constructorBranchMatchAt_of_switch_match + {source : SourceSite} {sourceBlock : BlockId} + {sourceInputMap : Array (Option Atom)} + {sourceScrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {generated : Block} + {outgoing : List EdgeTrace} {children : List CodeTrace} + {targetScrutinee : Atom} {constructors : Array CtorAlt} + {natPeel : Option NatPeel} {index : Nat} {target : CtorAlt} + {edge : EdgeTrace} {child : CodeTrace} + (matched : switchNodeBranchesMatch source sourceBlock sourceInputMap + sourceScrutinee peelNat alternatives generated outgoing children = true) + (terminator : generated.terminator = + .switchValue targetScrutinee constructors natPeel) + (targetAt : constructors[index]? = some target) + (edgeAt : outgoing[index]? = some edge) + (childAt : children[index]? = some child) : + ConstructorBranchMatch source sourceBlock sourceInputMap sourceScrutinee + alternatives target edge child := by + unfold switchNodeBranchesMatch at matched + rw [terminator] at matched + simp only [Bool.and_eq_true] at matched + obtain ⟨⟨⟨_, _⟩, constructorsMatched⟩, _⟩ := matched + have targetListAt : constructors.toList[index]? = some target := by + simpa using targetAt + have member : (target, index) ∈ constructors.toList.zipIdx := + List.mk_mem_zipIdx_iff_getElem?.mpr targetListAt + have branchMatched := + List.all_eq_true.mp constructorsMatched (target, index) member + simp [edgeAt, childAt] at branchMatched + exact constructorBranchMatch_of_match branchMatched + +/-- Select the checked Nat-zero association at the first post-constructor +ordinal. -/ +def natZeroBranchMatchAt_of_switch_match + {source : SourceSite} {sourceBlock : BlockId} + {sourceInputMap : Array (Option Atom)} + {sourceScrutinee : IxIR1.Atom} {alternatives : Array IxIR1.Alt} + {generated : Block} {outgoing : List EdgeTrace} + {children : List CodeTrace} {targetScrutinee : Atom} + {constructors : Array CtorAlt} {peel : NatPeel} + {edge : EdgeTrace} {child : CodeTrace} + (matched : switchNodeBranchesMatch source sourceBlock sourceInputMap + sourceScrutinee true alternatives generated outgoing children = true) + (terminator : generated.terminator = + .switchValue targetScrutinee constructors (some peel)) + (edgeAt : outgoing[constructors.size]? = some edge) + (childAt : children[constructors.size]? = some child) : + NatBranchMatch source sourceBlock sourceInputMap alternatives 0 0 0 + peel.zero edge child := by + unfold switchNodeBranchesMatch at matched + rw [terminator] at matched + simp only [Bool.and_eq_true] at matched + obtain ⟨⟨⟨_, _⟩, _⟩, natMatched⟩ := matched + cases succEdgeAt : outgoing[constructors.size + 1]? with + | none => simp [edgeAt, childAt, succEdgeAt] at natMatched + | some succEdge => + cases succChildAt : children[constructors.size + 1]? with + | none => simp [edgeAt, childAt, succEdgeAt, succChildAt] at natMatched + | some succChild => + simp [edgeAt, childAt, succEdgeAt, succChildAt, + Bool.and_eq_true] at natMatched + exact natBranchMatch_of_match natMatched.1 + +/-- Select the checked Nat-successor association at the second +post-constructor ordinal. -/ +def natSuccBranchMatchAt_of_switch_match + {source : SourceSite} {sourceBlock : BlockId} + {sourceInputMap : Array (Option Atom)} + {sourceScrutinee : IxIR1.Atom} {alternatives : Array IxIR1.Alt} + {generated : Block} {outgoing : List EdgeTrace} + {children : List CodeTrace} {targetScrutinee : Atom} + {constructors : Array CtorAlt} {peel : NatPeel} + {edge : EdgeTrace} {child : CodeTrace} + (matched : switchNodeBranchesMatch source sourceBlock sourceInputMap + sourceScrutinee true alternatives generated outgoing children = true) + (terminator : generated.terminator = + .switchValue targetScrutinee constructors (some peel)) + (edgeAt : outgoing[constructors.size + 1]? = some edge) + (childAt : children[constructors.size + 1]? = some child) : + NatBranchMatch source sourceBlock sourceInputMap alternatives 1 1 1 + peel.succ edge child := by + unfold switchNodeBranchesMatch at matched + rw [terminator] at matched + simp only [Bool.and_eq_true] at matched + obtain ⟨⟨⟨_, _⟩, _⟩, natMatched⟩ := matched + cases zeroEdgeAt : outgoing[constructors.size]? with + | none => simp [edgeAt, childAt, zeroEdgeAt] at natMatched + | some zeroEdge => + cases zeroChildAt : children[constructors.size]? with + | none => simp [edgeAt, childAt, zeroEdgeAt, zeroChildAt] at natMatched + | some zeroChild => + simp [edgeAt, childAt, zeroEdgeAt, zeroChildAt, + Bool.and_eq_true] at natMatched + exact natBranchMatch_of_match natMatched.2 + +/-- Both literal-Nat branches selected from one checked switch. Keeping their +parallel list coordinates in one record lets semantic clients enter either +child without repeating list-length or lookup reasoning. -/ +structure NatBranchPairMatch (source : SourceSite) (sourceBlock : BlockId) + (sourceInputMap : Array (Option Atom)) + (alternatives : Array IxIR1.Alt) (constructors : Array CtorAlt) + (peel : NatPeel) (outgoing : List EdgeTrace) + (children : List CodeTrace) : Type where + zeroEdge : EdgeTrace + zeroChild : CodeTrace + succEdge : EdgeTrace + succChild : CodeTrace + zeroEdgeAt : outgoing[constructors.size]? = some zeroEdge + zeroChildAt : children[constructors.size]? = some zeroChild + succEdgeAt : outgoing[constructors.size + 1]? = some succEdge + succChildAt : children[constructors.size + 1]? = some succChild + zero : NatBranchMatch source sourceBlock sourceInputMap alternatives + 0 0 0 peel.zero zeroEdge zeroChild + succ : NatBranchMatch source sourceBlock sourceInputMap alternatives + 1 1 1 peel.succ succEdge succChild + +/-- Reflect the complete zero/successor pair from a checked Nat switch. -/ +def natBranchPairMatch_of_switch_match + {source : SourceSite} {sourceBlock : BlockId} + {sourceInputMap : Array (Option Atom)} + {sourceScrutinee : IxIR1.Atom} {alternatives : Array IxIR1.Alt} + {generated : Block} {outgoing : List EdgeTrace} + {children : List CodeTrace} {targetScrutinee : Atom} + {constructors : Array CtorAlt} {peel : NatPeel} + (matched : switchNodeBranchesMatch source sourceBlock sourceInputMap + sourceScrutinee true alternatives generated outgoing children = true) + (terminator : generated.terminator = + .switchValue targetScrutinee constructors (some peel)) : + NatBranchPairMatch source sourceBlock sourceInputMap alternatives + constructors peel outgoing children := by + unfold switchNodeBranchesMatch at matched + rw [terminator] at matched + simp only [Bool.and_eq_true] at matched + obtain ⟨⟨⟨_, _⟩, _⟩, natMatched⟩ := matched + cases zeroEdgeAt : outgoing[constructors.size]? with + | none => simp [zeroEdgeAt] at natMatched + | some zeroEdge => + cases zeroChildAt : children[constructors.size]? with + | none => simp [zeroEdgeAt, zeroChildAt] at natMatched + | some zeroChild => + cases succEdgeAt : outgoing[constructors.size + 1]? with + | none => + simp [zeroEdgeAt, zeroChildAt, succEdgeAt] at natMatched + | some succEdge => + cases succChildAt : children[constructors.size + 1]? with + | none => + simp [zeroEdgeAt, zeroChildAt, succEdgeAt, succChildAt] + at natMatched + | some succChild => + simp only [zeroEdgeAt, zeroChildAt, succEdgeAt, succChildAt, + Bool.and_eq_true] at natMatched + exact + { zeroEdge + zeroChild + succEdge + succChild + zeroEdgeAt + zeroChildAt + succEdgeAt + succChildAt + zero := natBranchMatch_of_match natMatched.1 + succ := natBranchMatch_of_match natMatched.2 } + +mutual + +/-- Recursive switch/child/prologue coherence for a whole compiler trace. -/ +def CodeTrace.switchBranchesMatch : CodeTrace → Bool + | .ret .. | .tailCall .. | .tailCallSelf .. => true + | .letOp _ _ _ _ _ _ _ _ next => next.switchBranchesMatch + | .switchValue source block input _ sourceScrutinee peelNat alternatives _ + generated outgoing children => + switchNodeBranchesMatch source block input sourceScrutinee peelNat + alternatives generated outgoing children && + codeTraceListSwitchBranchesMatch children + +private def codeTraceListSwitchBranchesMatch : List CodeTrace → Bool + | [] => true + | trace :: rest => + trace.switchBranchesMatch && codeTraceListSwitchBranchesMatch rest + +end + +/-- Extract the local switch association check from the recursive trace +certificate. -/ +theorem CodeTrace.switchNodeBranchesMatch_of_match + {source : SourceSite} {block : BlockId} + {input : Array (Option Atom)} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {targetScrutinee : Atom} + {generated : Block} {outgoing : List EdgeTrace} + {children : List CodeTrace} + (matched : (CodeTrace.switchValue source block input entryValueCount + sourceScrutinee peelNat alternatives targetScrutinee generated outgoing + children).switchBranchesMatch = true) : + switchNodeBranchesMatch source block input sourceScrutinee peelNat + alternatives generated outgoing children = true := by + change (switchNodeBranchesMatch source block input sourceScrutinee peelNat + alternatives generated outgoing children && + codeTraceListSwitchBranchesMatch children) = true at matched + simp only [Bool.and_eq_true] at matched + exact matched.1 + +private theorem codeTraceListSwitchBranchesMatch_of_mem + {traces : List CodeTrace} {child : CodeTrace} + (matched : codeTraceListSwitchBranchesMatch traces = true) + (member : child ∈ traces) : child.switchBranchesMatch = true := by + induction traces with + | nil => simp at member + | cons head tail ih => + simp only [codeTraceListSwitchBranchesMatch, Bool.and_eq_true] at matched + simp only [List.mem_cons] at member + cases member with + | inl equal => simpa [equal] using matched.1 + | inr member => exact ih matched.2 member + +/-- Switch coherence is inherited by every immediate recursive call. -/ +theorem CodeTrace.switchBranchesMatch_of_child {parent child : CodeTrace} + (matched : parent.switchBranchesMatch = true) + (member : child ∈ parent.children) : + child.switchBranchesMatch = true := by + cases parent with + | ret _ _ _ _ _ _ _ | tailCall _ _ _ _ _ _ _ + | tailCallSelf _ _ _ _ _ _ => + simp [CodeTrace.children] at member + | letOp source block input nextInput entryValueCount operation index + instruction next => + simp [CodeTrace.children] at member + subst child + simpa [CodeTrace.switchBranchesMatch] using matched + | switchValue source block input entryValueCount sourceScrutinee peel + alternatives targetScrutinee generated outgoing children => + simp only [CodeTrace.switchBranchesMatch, Bool.and_eq_true] at matched + exact codeTraceListSwitchBranchesMatch_of_mem matched.2 member + +/-- Every descendant inherits exact switch-edge/child/prologue coherence. -/ +theorem CodeTrace.Descendant.switchBranchesMatch {root child : CodeTrace} + (descendant : Descendant root child) + (matched : root.switchBranchesMatch = true) : + child.switchBranchesMatch = true := by + induction descendant with + | refl => exact matched + | @step parent child parentDescendant childMem ih => + exact CodeTrace.switchBranchesMatch_of_child ih childMem + +/-! ## Allocation-schema evidence retained for semantic simulation -/ + +/-- The schema fact needed by one ordinary source allocation: the lookup is +present, has exactly the source operand count, and is uniform in the source +allocation world required by IxIR₂ v0. -/ +private def allocationSchemaMatches + (schemas : Owned → CtorId → Option CtorSchema) : IxIR1.Op → Bool + | .alloc world identity arguments => + match schemas world identity with + | some schema => + schema.fields == Array.replicate arguments.size world + | none => false + | _ => true + +mutual + +/-- Recursive allocation-schema coherence for one compiler derivation. This +is checked after ordinary validation and retained by `Checked`, avoiding any +later inversion of the validator's dataflow implementation. -/ +def CodeTrace.allocationSchemasMatch + (schemas : Owned → CtorId → Option CtorSchema) : CodeTrace → Bool + | .ret .. | .tailCall .. | .tailCallSelf .. => true + | .letOp _ _ _ _ _ operation _ _ next => + allocationSchemaMatches schemas operation && + next.allocationSchemasMatch schemas + | .switchValue _ _ _ _ _ _ _ _ _ _ children => + codeTraceListAllocationSchemasMatch schemas children + +private def codeTraceListAllocationSchemasMatch + (schemas : Owned → CtorId → Option CtorSchema) : + List CodeTrace → Bool + | [] => true + | trace :: rest => + trace.allocationSchemasMatch schemas && + codeTraceListAllocationSchemasMatch schemas rest + +end + +/-- Reflect the exact schema lookup and uniform field vector at one retained +ordinary allocation node. -/ +theorem CodeTrace.allocationSchema_of_match + (schemas : Owned → CtorId → Option CtorSchema) + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {world : Owned} {identity : CtorId} + {arguments : Array IxIR1.Atom} {index : Nat} + {instruction : Instr} {next : CodeTrace} + (matched : (CodeTrace.letOp source block input nextInput entryValueCount + (.alloc world identity arguments) index instruction next).allocationSchemasMatch + schemas = true) : + ∃ schema, schemas world identity = some schema ∧ + schema.fields = Array.replicate arguments.size world := by + change (allocationSchemaMatches schemas (.alloc world identity arguments) && + next.allocationSchemasMatch schemas) = true at matched + simp only [Bool.and_eq_true] at matched + have localMatch := matched.1 + unfold allocationSchemaMatches at localMatch + cases lookup : schemas world identity with + | none => simp [lookup] at localMatch + | some schema => + refine ⟨schema, rfl, ?_⟩ + exact beq_iff_eq.mp (by simpa [lookup] using localMatch) + +private theorem codeTraceListAllocationSchemasMatch_of_mem + (schemas : Owned → CtorId → Option CtorSchema) + {traces : List CodeTrace} {child : CodeTrace} + (matched : codeTraceListAllocationSchemasMatch schemas traces = true) + (member : child ∈ traces) : + child.allocationSchemasMatch schemas = true := by + induction traces with + | nil => simp at member + | cons head tail ih => + simp only [codeTraceListAllocationSchemasMatch, + Bool.and_eq_true] at matched + simp only [List.mem_cons] at member + cases member with + | inl equal => simpa [equal] using matched.1 + | inr member => exact ih matched.2 member + +/-- Allocation-schema coherence is inherited by every immediate recursive +compiler call. -/ +theorem CodeTrace.allocationSchemasMatch_of_child + (schemas : Owned → CtorId → Option CtorSchema) + {parent child : CodeTrace} + (matched : parent.allocationSchemasMatch schemas = true) + (member : child ∈ parent.children) : + child.allocationSchemasMatch schemas = true := by + cases parent with + | ret _ _ _ _ _ _ _ | tailCall _ _ _ _ _ _ _ + | tailCallSelf _ _ _ _ _ _ => + simp [CodeTrace.children] at member + | letOp source block input nextInput entryValueCount operation index + instruction next => + simp [CodeTrace.children] at member + subst child + simp only [CodeTrace.allocationSchemasMatch, Bool.and_eq_true] at matched + exact matched.2 + | switchValue source block input entryValueCount sourceScrutinee peel + alternatives targetScrutinee generated outgoing children => + exact codeTraceListAllocationSchemasMatch_of_mem schemas matched member + +/-- Every recursive trace descendant inherits the checked allocation-schema +facts of its root. -/ +theorem CodeTrace.Descendant.allocationSchemasMatch + (schemas : Owned → CtorId → Option CtorSchema) + {root child : CodeTrace} (descendant : Descendant root child) + (matched : root.allocationSchemasMatch schemas = true) : + child.allocationSchemasMatch schemas = true := by + induction descendant with + | refl => exact matched + | @step parent child parentDescendant childMem ih => + exact CodeTrace.allocationSchemasMatch_of_child schemas ih childMem + + +/-- Executable structural equality for retained IxIR₁ function sources. -/ +def functionSourceEq (left right : IxIR1.FnDef) : Bool := + left.arity == right.arity && left.result == right.result && + left.papSafe == right.papSafe && sourceCodeEq left.body right.body + +/-- Reflection theorem for retained IxIR₁ function-source equality. -/ +theorem functionSourceEq_eq_true_iff + (left right : IxIR1.FnDef) : + functionSourceEq left right = true ↔ left = right := by + cases left + cases right + simp [functionSourceEq, sourceCodeEq_eq_true_iff, + beq_iff_eq, and_assoc] + +private def sourceDeclEq : IxIR1.Decl → IxIR1.Decl → Bool + | .extern left, .extern right => left == right + | .fn left, .fn right => functionSourceEq left right + | _, _ => false + +private theorem sourceDeclEq_eq_true_iff (left right : IxIR1.Decl) : + sourceDeclEq left right = true ↔ left = right := by + cases left <;> cases right <;> + simp [sourceDeclEq, functionSourceEq_eq_true_iff, beq_iff_eq] + +private def sourceEntryEq + (left right : Address × IxIR1.Decl) : Bool := + left.1 == right.1 && sourceDeclEq left.2 right.2 + +private theorem sourceEntryEq_eq_true_iff + (left right : Address × IxIR1.Decl) : + sourceEntryEq left right = true ↔ left = right := by + obtain ⟨leftAddress, leftDecl⟩ := left + obtain ⟨rightAddress, rightDecl⟩ := right + simp [sourceEntryEq, sourceDeclEq_eq_true_iff, beq_iff_eq] + +private def sourceDeclListEq : + List (Address × IxIR1.Decl) → List (Address × IxIR1.Decl) → Bool + | [], [] => true + | left :: leftRest, right :: rightRest => + sourceEntryEq left right && sourceDeclListEq leftRest rightRest + | _, _ => false + +private theorem sourceDeclListEq_eq_true_iff + (left right : List (Address × IxIR1.Decl)) : + sourceDeclListEq left right = true ↔ left = right := by + induction left generalizing right with + | nil => cases right <;> simp [sourceDeclListEq] + | cons head tail ih => + cases right with + | nil => simp [sourceDeclListEq] + | cons rightHead rightTail => + simp [sourceDeclListEq, sourceEntryEq_eq_true_iff, ih] + +/-- Executable equality for lowering inputs. Source syntax deliberately lacks +global `BEq` instances, so the producer reuses its exact structural source +comparators at this boundary. -/ +def inputEq (left right : Input) : Bool := + sourceDeclListEq left.declarations right.declarations && + sourceCodeEq left.main right.main && left.mainResult == right.mainResult + +/-- Reflection theorem for the checked lowering-input equality. -/ +theorem inputEq_eq_true_iff (left right : Input) : + inputEq left right = true ↔ left = right := by + cases left + cases right + simp [inputEq, sourceDeclListEq_eq_true_iff, + sourceCodeEq_eq_true_iff, beq_iff_eq, and_assoc] + +/-- Canonical proof map at a function entry: source de Bruijn parameters are +reversed onto target call-order registers. -/ +def entryInputMap (arity : Nat) : Array (Option Atom) := + (List.range arity).toArray.map fun sourceIndex => + some (.reg (arity - 1 - sourceIndex)) + + +/-- Exact source/target identity retained around one recursive compiler +derivation. Parameter ownership is intentionally target-only, while arity, +result world, PAP safety, and code remain the source function's facts. -/ +structure FunctionSourceMatch (source : IxIR1.FnDef) (generated : Function) + (root : CodeTrace) : Prop where + code : root.sourceCode = source.body + arity : generated.signature.params.size = source.arity + result : generated.signature.result = source.result + papSafe : generated.signature.papSafe = source.papSafe + entryBlock : root.sourceBlock = 0 + entryPc : root.entryPc = 0 + entryValueCount : root.entryValueCount = source.arity + entryInput : root.sourceInputMap = entryInputMap source.arity + +/-- Executable producer check for `FunctionSourceMatch`. -/ +def functionSourceMatches (source : IxIR1.FnDef) (generated : Function) + (root : CodeTrace) : Bool := + sourceCodeEq root.sourceCode source.body && + (generated.signature.params.size == source.arity) && + (generated.signature.result == source.result) && + (generated.signature.papSafe == source.papSafe) && + (root.sourceBlock == 0) && + (root.entryPc == 0) && + (root.entryValueCount == source.arity) && + (root.sourceInputMap == entryInputMap source.arity) + +/-- Turn the executable source-identity check into the proof-facing record. -/ +theorem functionSourceMatch_of_match {source : IxIR1.FnDef} + {generated : Function} {root : CodeTrace} + (matched : functionSourceMatches source generated root = true) : + FunctionSourceMatch source generated root := by + simp only [functionSourceMatches, Bool.and_eq_true] at matched + rcases matched with ⟨⟨⟨⟨⟨⟨⟨code, arity⟩, result⟩, papSafe⟩, + entryBlock⟩, entryPc⟩, entryValueCount⟩, entryInput⟩ + exact + { code := (sourceCodeEq_eq_true_iff _ _).mp code + arity := beq_iff_eq.mp arity + result := beq_iff_eq.mp result + papSafe := beq_iff_eq.mp papSafe + entryBlock := beq_iff_eq.mp entryBlock + entryPc := beq_iff_eq.mp entryPc + entryValueCount := beq_iff_eq.mp entryValueCount + entryInput := beq_iff_eq.mp entryInput } + +/-- One source function and the exact recursive compiler derivation that +produced its target function. -/ +structure FunctionTrace where + owner : Validate.Owner + source : IxIR1.FnDef + generated : Function + root : CodeTrace + /-- The recursive compiler run begins at this owner's empty branch path and + zero source offset. -/ + rootSource : root.source = ({ owner := owner } : SourceSite) + /-- The recursive trace reconstructs the literal source body, and the + generated signature preserves every non-ownership source signature fact. -/ + sourceOrder : FunctionSourceMatch source generated root + /-- Every instruction node names the exact instruction retained at its + final generated block coordinate. -/ + instructionOrder : root.instructionsMatch = true + /-- Every instruction continuation keeps or forgets source slots without + retargeting them. -/ + inputMapOrder : root.inputMapsMatch = true + /-- Every recursive compiler node at target PC zero has the value-register + count declared by its completed head block's parameter ABI. -/ + entryValueCountOrder : root.entryValueCountsMatch = true + /-- Every retained source operand translates to the target operand emitted + at that node, and every terminal node retains its exact terminator. -/ + syntaxOrder : root.syntaxMatches = true + /-- Every switch target is associated in order with exactly one generated + edge and recursive child; constructor children additionally certify their + field-fetch prologue and Nat children their implicit-prefix convention. -/ + switchBranchOrder : root.switchBranchesMatch = true + /-- Every retained terminal block is exactly the corresponding generated + block, in canonical block-id order. The producer checks this internal + invariant once after finishing the mutable block array. -/ + blockOrder : root.blocks = + generated.blocks.toList.zipIdx.map fun pair => (pair.2, pair.1) + +/-- External identity of a retained function trace at an artifact boundary. -/ +structure FunctionTraceMatch (trace : FunctionTrace) (owner : Validate.Owner) + (source : IxIR1.FnDef) (generated : Function) : Prop where + owner : trace.owner = owner + source : trace.source = source + generated : trace.generated = generated + +/-- Executable check tying a function trace to an external source/target +pair. The trace's internal source/signature/code certificate remains separate. -/ +def functionTraceMatches (trace : FunctionTrace) (owner : Validate.Owner) + (source : IxIR1.FnDef) (generated : Function) : Bool := + (trace.owner == owner) && functionSourceEq trace.source source && + (trace.generated == generated) + +/-- Reflect the executable external trace-identity check. -/ +theorem functionTraceMatch_of_match {trace : FunctionTrace} + {owner : Validate.Owner} {source : IxIR1.FnDef} {generated : Function} + (matched : functionTraceMatches trace owner source generated = true) : + FunctionTraceMatch trace owner source generated := by + simp only [functionTraceMatches, Bool.and_eq_true] at matched + exact + { owner := beq_iff_eq.mp matched.1.1 + source := (functionSourceEq_eq_true_iff _ _).mp matched.1.2 + generated := beq_iff_eq.mp matched.2 } + +namespace FunctionTrace + +/-- The recursive derivation is rooted at the literal retained source body. -/ +theorem rootSourceCode (trace : FunctionTrace) : + trace.root.sourceCode = trace.source.body := + trace.sourceOrder.code + +/-- Generated parameter ownership may be richer, but arity is unchanged. -/ +theorem sourceArity (trace : FunctionTrace) : + trace.generated.signature.params.size = trace.source.arity := + trace.sourceOrder.arity + +/-- Lowering preserves the declared result world. -/ +theorem sourceResult (trace : FunctionTrace) : + trace.generated.signature.result = trace.source.result := + trace.sourceOrder.result + +/-- Lowering preserves the source PAP-entry policy. -/ +theorem sourcePapSafe (trace : FunctionTrace) : + trace.generated.signature.papSafe = trace.source.papSafe := + trace.sourceOrder.papSafe + +/-- Every retained compiler derivation starts at CFG block zero. -/ +theorem entryBlock (trace : FunctionTrace) : + trace.root.sourceBlock = 0 := + trace.sourceOrder.entryBlock + +/-- Every retained compiler derivation starts before its first instruction. -/ +theorem entryPc (trace : FunctionTrace) : + trace.root.entryPc = 0 := + trace.sourceOrder.entryPc + +/-- Entry value-register count is exactly the source arity. -/ +theorem entryValueCount (trace : FunctionTrace) : + trace.root.entryValueCount = trace.source.arity := + trace.sourceOrder.entryValueCount + +/-- Every retained compiler derivation starts with the canonical reversed +source-parameter map. -/ +theorem entryInput (trace : FunctionTrace) : + trace.root.sourceInputMap = entryInputMap trace.source.arity := + trace.sourceOrder.entryInput + +/-- The completed root block is the function entry block. -/ +theorem rootHeadBlock (trace : FunctionTrace) : + trace.root.headBlock.1 = 0 := + (CodeTrace.headBlock_eq_sourceBlock_of_match trace.instructionOrder).trans + trace.entryBlock + +/-- Indexing the derivation's canonical block list yields exactly the block +at that identifier in the generated function. This is the direct bridge +from recursive trace induction to evaluator block lookup. -/ +theorem blockAt (trace : FunctionTrace) (id : BlockId) : + trace.root.blocks[id]? = + (trace.generated.blocks[id]?).map fun block => (id, block) := by + rw [trace.blockOrder] + simp [Function.comp_def] + +/-- Any block reached through recursive trace traversal is the actual block +installed at its retained identifier. This membership-oriented form is what +the semantic induction uses for switch children, whose block-list ordinal is +not carried separately by the induction hypothesis. -/ +theorem blockAt_of_mem (trace : FunctionTrace) {id : BlockId} {block : Block} + (member : (id, block) ∈ trace.root.blocks) : + trace.generated.blocks[id]? = some block := by + rw [trace.blockOrder] at member + simp only [List.mem_map] at member + obtain ⟨⟨candidate, index⟩, zipped, equal⟩ := member + have indexEq : index = id := congrArg Prod.fst equal + have blockEq : candidate = block := congrArg Prod.snd equal + subst index + subst candidate + simpa using (List.mk_mem_zipIdx_iff_getElem?.mp zipped) + +/-- The head block exposed by the recursive derivation is executable directly +from the generated function, without a caller-supplied block-lookup premise. -/ +theorem headBlockAt (trace : FunctionTrace) : + trace.generated.blocks[trace.root.headBlock.1]? = + some trace.root.headBlock.2 := + trace.blockAt_of_mem trace.root.headBlock_mem_blocks + +/-- Every successfully retained function has its certified entry/head block. -/ +theorem generatedNonempty (trace : FunctionTrace) : + trace.generated.blocks.isEmpty = false := by + have found := trace.headBlockAt + apply Array.isEmpty_eq_false_iff.mpr + intro empty + rw [empty] at found + simp at found + +/-- Every recursive continuation or switch child names its exact executable +head block in the generated function. This removes block lookup as a premise +from induction hypotheses over `CodeTrace.Descendant`. -/ +theorem descendantHeadBlockAt (trace : FunctionTrace) {child : CodeTrace} + (descendant : trace.root.Descendant child) : + trace.generated.blocks[child.headBlock.1]? = some child.headBlock.2 := + trace.blockAt_of_mem + (descendant.blocks_subset child.headBlock_mem_blocks) + +/-- Every recursive continuation/switch child inherits the producer's exact +instruction-coordinate certificate. -/ +theorem descendantInstructionsMatch (trace : FunctionTrace) + {child : CodeTrace} (descendant : trace.root.Descendant child) : + child.instructionsMatch = true := + descendant.instructionsMatch trace.instructionOrder + +/-- Every recursive continuation/switch child inherits proof-map +progression coherence. -/ +theorem descendantInputMapsMatch (trace : FunctionTrace) + {child : CodeTrace} (descendant : trace.root.Descendant child) : + child.inputMapsMatch = true := + descendant.inputMapsMatch trace.inputMapOrder + +/-- Every recursive continuation or switch child beginning at target PC zero +has exactly the target values declared by its head block's parameter ABI. -/ +theorem descendantEntryValueCount (trace : FunctionTrace) + {child : CodeTrace} (descendant : trace.root.Descendant child) + (pc : child.entryPc = 0) : + child.entryValueCount = child.headBlock.2.valueParams.size := + CodeTrace.entryValueCount_eq_headParams_of_match + (descendant.entryValueCountsMatch trace.entryValueCountOrder) pc + +/-- Every recursive continuation/switch child inherits exact source/target +operand and terminator syntax. -/ +theorem descendantSyntaxMatches (trace : FunctionTrace) + {child : CodeTrace} (descendant : trace.root.Descendant child) : + child.syntaxMatches = true := + descendant.syntaxMatches trace.syntaxOrder + +/-- Every recursive continuation/switch child inherits exact branch-edge, +child-body, successor-map, and constructor-prologue coherence. -/ +theorem descendantSwitchBranchesMatch (trace : FunctionTrace) + {child : CodeTrace} (descendant : trace.root.Descendant child) : + child.switchBranchesMatch = true := + descendant.switchBranchesMatch trace.switchBranchOrder + +/-- A recursive instruction node exposes its checked proof-facing operation +syntax directly from trace membership. -/ +theorem descendantOperationSyntax (trace : FunctionTrace) + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {operation : IxIR1.Op} {index : Nat} {instruction : Instr} + {next : CodeTrace} + (descendant : trace.root.Descendant + (.letOp source block input nextInput entryValueCount operation index + instruction next)) : + OperationSyntax input operation instruction := + CodeTrace.letOpOperationSyntax_of_match + (trace.descendantSyntaxMatches descendant) + +/-- A recursive instruction node carries all exact continuation metadata and +names an instruction in the generated function's actual block array. -/ +theorem descendantLetOpMatch (trace : FunctionTrace) + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {operation : IxIR1.Op} + {index : Nat} {instruction : Instr} {next : CodeTrace} + (descendant : trace.root.Descendant + (.letOp source block input nextInput entryValueCount operation index + instruction next)) : + CodeTrace.LetOpMatch source block input nextInput entryValueCount operation + index instruction next ∧ + trace.generated.blocks[block]? = some next.headBlock.2 := by + have matched := trace.descendantInstructionsMatch descendant + have localMatch := CodeTrace.letOpMatch_of_match matched + refine ⟨localMatch, ?_⟩ + have blockAt := trace.descendantHeadBlockAt descendant + simpa [CodeTrace.headBlock, localMatch.headBlock] using blockAt + +end FunctionTrace + +structure Trace where + positions : List PositionTrace := [] + edges : List EdgeTrace := [] + functions : List FunctionTrace := [] + +/-! ## Producer-retained source capabilities -/ + +/-- Live/dead and representation agreement between one producer capability +and the corresponding partial source-slot map entry. Scalars may retain any +scalar-compatible atom; owners and borrows must name concrete SSA registers; +a consumed binding must be absent. -/ +def BindingCap.matchesInput : BindingCap → Option Atom → Bool + | .dead, none => true + | .dead, some _ => false + | .scalar, some _ => true + | .owned _, some (.reg _) | .borrowed _ _, some (.reg _) => true + | .owned _, _ | .borrowed _ _, _ | .scalar, none => false + +/-- Exact agreement between a producer-side source capability and the +capability declared for a target block parameter. Dead bindings have no +target-parameter counterpart; their source input-map entry is absent. -/ +def BindingCap.matchesParameter : BindingCap → ValueCap → Bool + | .scalar, .scalar => true + | .owned sourceWorld, .owned targetWorld => sourceWorld == targetWorld + | .borrowed sourceWorld sourceLender, + .borrowed targetWorld targetLender => + sourceWorld == targetWorld && sourceLender == targetLender + | _, _ => false + +/-- Every live source slot that still names an inherited block parameter +retains exactly that parameter's declared capability. Registers appended by +instructions are intentionally outside this check; their capability flow is +audited by the operation-specific transition predicates below. -/ +def PositionTrace.parameterCapabilitiesMatch (position : PositionTrace) + (input : Array (Option Atom)) (parameters : Array ValueCap) : Bool := + (List.range input.size).all fun sourceIndex => + match input[sourceIndex]? with + | some (some (.reg targetIndex)) => + match parameters[targetIndex]? with + | none => true + | some parameter => + match position.sourceCapabilities[sourceIndex]? with + | some capability => capability.matchesParameter parameter + | none => false + | _ => true + +/-- Reflection of parameter-capability coherence without specializing the +parameter kind. In particular, an inherited target parameter can never be +backed by a dead producer binding. -/ +theorem PositionTrace.capability_of_parameterCapabilitiesMatch + {position : PositionTrace} {input : Array (Option Atom)} + {parameters : Array ValueCap} + (matched : position.parameterCapabilitiesMatch input parameters = true) + {sourceIndex targetIndex : Nat} {parameter : ValueCap} + (inputAt : input[sourceIndex]? = some (some (.reg targetIndex))) + (parameterAt : parameters[targetIndex]? = some parameter) : + ∃ capability, + position.sourceCapabilities[sourceIndex]? = some capability ∧ + capability.matchesParameter parameter = true := by + have inputBound : sourceIndex < input.size := + (Array.getElem?_eq_some_iff.mp inputAt).1 + have point := List.all_eq_true.mp matched sourceIndex + (List.mem_range.mpr inputBound) + simp only [inputAt] at point + rw [parameterAt] at point + cases capabilityAt : position.sourceCapabilities[sourceIndex]? with + | none => simp [capabilityAt] at point + | some capability => + exact ⟨capability, rfl, by + simpa [capabilityAt] using point⟩ + +/-- Reflection of parameter-capability coherence for an owned parameter. +This is the ownership bridge used by semantic clients: a source slot mapped +to an owned target parameter is itself the exact producer owner. -/ +theorem PositionTrace.owned_of_parameterCapabilitiesMatch + {position : PositionTrace} {input : Array (Option Atom)} + {parameters : Array ValueCap} + (matched : position.parameterCapabilitiesMatch input parameters = true) + {sourceIndex targetIndex : Nat} {world : Owned} + (inputAt : input[sourceIndex]? = some (some (.reg targetIndex))) + (parameterAt : parameters[targetIndex]? = some (.owned world)) : + position.sourceCapabilities[sourceIndex]? = some (.owned world) := by + have inputBound : sourceIndex < input.size := + (Array.getElem?_eq_some_iff.mp inputAt).1 + have point := List.all_eq_true.mp matched sourceIndex + (List.mem_range.mpr inputBound) + simp only [inputAt] at point + rw [parameterAt] at point + cases capabilityAt : position.sourceCapabilities[sourceIndex]? with + | none => simp [capabilityAt] at point + | some capability => + cases capability with + | scalar => simp [capabilityAt, BindingCap.matchesParameter] at point + | owned actualWorld => + have worldEq : actualWorld = world := by + exact beq_iff_eq.mp (by + simpa [capabilityAt, BindingCap.matchesParameter] using point) + subst actualWorld + rfl + | borrowed actualWorld lender => + simp [capabilityAt, BindingCap.matchesParameter] at point + | dead => simp [capabilityAt, BindingCap.matchesParameter] at point + +/-- Whether a source capability may cross an owned boundary in `expected`. +Scalars are accepted in either world; concrete owners must match exactly; +borrows and dead bindings cannot be consumed. -/ +def BindingCap.canConsume (expected : Owned) : BindingCap → Bool + | .scalar => true + | .owned actual => actual == expected + | .borrowed .. | .dead => false + +/-- Capability of a source operand at one retained position. -/ +def sourceCapability? (capabilities : Array BindingCap) : + IxIR1.Atom → Option BindingCap + | .lit _ | .erased => some .scalar + | .var index => capabilities[index]? + +/-- Retire a borrow whose dynamic lifetime is rooted at a consumed SSA owner. +Other capabilities, including caller-rooted borrows, are unchanged. -/ +def BindingCap.retireLender (lender : ValueId) : BindingCap → BindingCap + | .borrowed world (.value actual) => + if actual == lender then .dead else .borrowed world (.value actual) + | capability => capability + +/-- Retire every source borrow rooted at one consumed target register. -/ +def retireLenderCapabilities (capabilities : Array BindingCap) + (lender : ValueId) : Array BindingCap := + capabilities.map (BindingCap.retireLender lender) + +/-- Consume one source owner and retire all of its target-register loans. The +retained source input map supplies the exact SSA lender identity. -/ +def retireOwnerCapabilities? (capabilities : Array BindingCap) + (input : Array (Option Atom)) (index : Nat) : + Option (Array BindingCap) := + match input[index]? with + | some (some (.reg lender)) => + some (retireLenderCapabilities + (capabilities.setIfInBounds index .dead) lender) + | _ => none + +/-- Retiring one owner and its loans preserves source-slot cardinality. -/ +theorem retireOwnerCapabilities?_size + {capabilities remaining : Array BindingCap} + {input : Array (Option Atom)} {index : Nat} + (retired : retireOwnerCapabilities? capabilities input index = + some remaining) : + remaining.size = capabilities.size := by + unfold retireOwnerCapabilities? at retired + split at retired <;> try contradiction + next lender _ => + injection retired with remainingEq + subst remaining + simp [retireLenderCapabilities] + +/-- Capability vector produced by the lowerer's `pure`/`move` rule. Scalars +and borrows are copied; an owned source slot is consumed before the same owner +is rebound at the new de Bruijn head, and loans rooted at the old SSA owner +are retired. -/ +def moveCapabilities? (capabilities : Array BindingCap) + (input : Array (Option Atom)) (source : IxIR1.Atom) : + Option (Array BindingCap) := + match sourceCapability? capabilities source with + | none | some .dead => none + | some capability => + let remaining? := + match source, capability with + | .var index, .owned _ => + retireOwnerCapabilities? capabilities input index + | _, _ => some capabilities + remaining?.map fun remaining => #[capability] ++ remaining + +/-- One retained before/after position pair agrees with the exact +`pure`/`move` capability effect. -/ +def PositionTrace.moveMatches (before after : PositionTrace) + (input : Array (Option Atom)) (source : IxIR1.Atom) : Bool := + match moveCapabilities? before.sourceCapabilities input source with + | some expected => expected == after.sourceCapabilities + | none => false + +/-- A flat producer position names this exact recursive trace coordinate and +its capability vector has the same live/dead shape as the proof input map. -/ +def PositionTrace.coordinateMatches (position : PositionTrace) + (source : SourceSite) (block : BlockId) (target : TargetPosition) + (input : Array (Option Atom)) : Bool := + position.source == source && position.block == block && + position.target == target && + position.sourceCapabilities.size == input.size && + (List.range input.size).all fun index => + match position.sourceCapabilities[index]?, input[index]? with + | some capability, some slot => capability.matchesInput slot + | _, _ => false + +/-- A matching flat coordinate carries exactly one capability for every +source slot in the recursive trace input map. -/ +theorem PositionTrace.sourceCapabilities_size_of_coordinateMatch + {position : PositionTrace} {source : SourceSite} {block : BlockId} + {target : TargetPosition} {input : Array (Option Atom)} + (matched : position.coordinateMatches source block target input = true) : + position.sourceCapabilities.size = input.size := by + unfold PositionTrace.coordinateMatches at matched + simp only [Bool.and_eq_true] at matched + exact beq_iff_eq.mp matched.1.2 + +/-- An owned capability at a matching producer position names an exact SSA +register in the recursive source input map. -/ +theorem PositionTrace.inputReg_of_owned_coordinateMatch + {position : PositionTrace} {source : SourceSite} {block : BlockId} + {target : TargetPosition} {input : Array (Option Atom)} + (matched : position.coordinateMatches source block target input = true) + {index : Nat} {world : Owned} + (capabilityAt : position.sourceCapabilities[index]? = + some (.owned world)) : + ∃ id, input[index]? = some (some (.reg id)) := by + have sizeEq := position.sourceCapabilities_size_of_coordinateMatch matched + have bound : index < input.size := by + rw [← sizeEq] + exact (Array.getElem?_eq_some_iff.mp capabilityAt).1 + unfold PositionTrace.coordinateMatches at matched + simp only [Bool.and_eq_true] at matched + have point := List.all_eq_true.mp matched.2 index + (List.mem_range.mpr bound) + rw [capabilityAt] at point + cases inputAt : input[index]? with + | none => simp [inputAt] at point + | some slot => + cases slot with + | none => simp [inputAt, BindingCap.matchesInput] at point + | some atom => + cases atom with + | reg id => exact ⟨id, rfl⟩ + | lit literal | erased => + simp [inputAt, BindingCap.matchesInput] at point + +/-- Whether the flat producer index contains the exact coordinate and +live/dead capability shape for one recursive code node. -/ +def CodeTrace.positionMatches (positions : List PositionTrace) + (trace : CodeTrace) : Bool := + positions.any fun position => + position.coordinateMatches trace.source trace.sourceBlock + trace.targetPosition trace.sourceInputMap + +mutual + +/-- Every recursive code node has a matching producer position. This is the +whole-trace coordinate audit used to select dynamic ownership invariants on +both sides of an instruction or branch transition. -/ +def CodeTrace.positionsMatch + (positions : List PositionTrace) : CodeTrace → Bool + | trace@(.ret ..) | trace@(.tailCall ..) | trace@(.tailCallSelf ..) => + trace.positionMatches positions + | trace@(.letOp _ _ _ _ _ _ _ _ next) => + trace.positionMatches positions && next.positionsMatch positions + | trace@(.switchValue _ _ _ _ _ _ _ _ _ _ children) => + trace.positionMatches positions && + codeTraceListPositionsMatch positions children + +private def codeTraceListPositionsMatch + (positions : List PositionTrace) : List CodeTrace → Bool + | [] => true + | trace :: rest => + trace.positionsMatch positions && + codeTraceListPositionsMatch positions rest + +end + +/-- Project the current node's flat-position audit from recursive +whole-subtree coherence. -/ +theorem CodeTrace.positionMatches_of_positionsMatch + (positions : List PositionTrace) {trace : CodeTrace} + (matched : trace.positionsMatch positions = true) : + trace.positionMatches positions = true := by + cases trace <;> + simp_all [CodeTrace.positionsMatch, Bool.and_eq_true] + +/-- Reflect the exact producer position for any recursively audited node. -/ +theorem CodeTrace.position_of_positionsMatch + (positions : List PositionTrace) {trace : CodeTrace} + (matched : trace.positionsMatch positions = true) : + ∃ position, position ∈ positions ∧ + position.coordinateMatches trace.source trace.sourceBlock + trace.targetPosition trace.sourceInputMap = true := by + exact List.any_eq_true.mp + (trace.positionMatches_of_positionsMatch positions matched) + +private theorem codeTraceListPositionsMatch_of_mem + (positions : List PositionTrace) + {traces : List CodeTrace} {child : CodeTrace} + (matched : codeTraceListPositionsMatch positions traces = true) + (member : child ∈ traces) : + child.positionsMatch positions = true := by + induction traces with + | nil => simp at member + | cons head tail ih => + simp only [codeTraceListPositionsMatch, Bool.and_eq_true] at matched + simp only [List.mem_cons] at member + cases member with + | inl equal => simpa [equal] using matched.1 + | inr member => exact ih matched.2 member + +/-- Position coherence is inherited by every immediate recursive compiler +call. -/ +theorem CodeTrace.positionsMatch_of_child + (positions : List PositionTrace) {parent child : CodeTrace} + (matched : parent.positionsMatch positions = true) + (member : child ∈ parent.children) : + child.positionsMatch positions = true := by + cases parent with + | ret _ _ _ _ _ _ _ | tailCall _ _ _ _ _ _ _ + | tailCallSelf _ _ _ _ _ _ => + simp [CodeTrace.children] at member + | letOp source block input nextInput entryValueCount operation index + instruction next => + simp [CodeTrace.children] at member + subst child + simp only [CodeTrace.positionsMatch, Bool.and_eq_true] at matched + exact matched.2 + | switchValue source block input entryValueCount sourceScrutinee peel + alternatives targetScrutinee generated outgoing children => + have childrenMatched : + codeTraceListPositionsMatch positions children = true := by + simp only [CodeTrace.positionsMatch, Bool.and_eq_true] at matched + exact matched.2 + exact codeTraceListPositionsMatch_of_mem positions childrenMatched member + +/-- Every recursive descendant inherits whole-position coherence. -/ +theorem CodeTrace.Descendant.positionsMatch + (positions : List PositionTrace) {root child : CodeTrace} + (descendant : Descendant root child) + (matched : root.positionsMatch positions = true) : + child.positionsMatch positions = true := by + induction descendant with + | refl => exact matched + | @step parent child parentDescendant childMem ih => + exact CodeTrace.positionsMatch_of_child positions ih childMem + +/-- Whole-program producer-position coordinate audit. -/ +def Trace.positionsMatch (trace : Trace) : Bool := + trace.functions.all fun functionTrace => + functionTrace.root.positionsMatch trace.positions + +/-- Project whole-program position coherence to one retained function. -/ +theorem Trace.functionPositionsMatch {trace : Trace} + (matched : trace.positionsMatch = true) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ trace.functions) : + functionTrace.root.positionsMatch trace.positions = true := + List.all_eq_true.mp matched functionTrace member + +/-! ### Producer capabilities at inherited block parameters -/ + +/-- Every flat producer position naming this recursive node agrees with the +capabilities declared by the node's inherited block parameters. -/ +def CodeTrace.positionParameterCapabilitiesMatch + (positions : List PositionTrace) (trace : CodeTrace) : Bool := + positions.all fun position => + if position.coordinateMatches trace.source trace.sourceBlock + trace.targetPosition trace.sourceInputMap then + position.parameterCapabilitiesMatch trace.sourceInputMap + trace.headBlock.2.valueParams + else + true + +mutual + +/-- Recursive audit connecting every source capability vector to the target +block parameters still named by its input map. -/ +def CodeTrace.parameterCapabilitiesMatch + (positions : List PositionTrace) : CodeTrace → Bool + | trace@(.ret ..) | trace@(.tailCall ..) | trace@(.tailCallSelf ..) => + trace.positionParameterCapabilitiesMatch positions + | trace@(.letOp _ _ _ _ _ _ _ _ next) => + trace.positionParameterCapabilitiesMatch positions && + next.parameterCapabilitiesMatch positions + | trace@(.switchValue _ _ _ _ _ _ _ _ _ _ children) => + trace.positionParameterCapabilitiesMatch positions && + codeTraceListParameterCapabilitiesMatch positions children + +private def codeTraceListParameterCapabilitiesMatch + (positions : List PositionTrace) : List CodeTrace → Bool + | [] => true + | trace :: rest => + trace.parameterCapabilitiesMatch positions && + codeTraceListParameterCapabilitiesMatch positions rest + +end + +/-- Project the current node's parameter-capability audit from recursive +whole-subtree coherence. -/ +theorem CodeTrace.positionParameterCapabilitiesMatch_of_match + (positions : List PositionTrace) {trace : CodeTrace} + (matched : trace.parameterCapabilitiesMatch positions = true) : + trace.positionParameterCapabilitiesMatch positions = true := by + cases trace <;> + simp_all [CodeTrace.parameterCapabilitiesMatch, Bool.and_eq_true] + +/-- Reflect parameter-capability agreement for any matching flat position at +the current recursive trace node. -/ +theorem CodeTrace.positionParameterCapabilities_of_match + (positions : List PositionTrace) {trace : CodeTrace} + (matched : trace.parameterCapabilitiesMatch positions = true) + {position : PositionTrace} (member : position ∈ positions) + (coordinate : position.coordinateMatches trace.source trace.sourceBlock + trace.targetPosition trace.sourceInputMap = true) : + position.parameterCapabilitiesMatch trace.sourceInputMap + trace.headBlock.2.valueParams = true := by + have localMatch := trace.positionParameterCapabilitiesMatch_of_match positions + matched + have point := List.all_eq_true.mp localMatch position member + rw [if_pos coordinate] at point + exact point + +private theorem codeTraceListParameterCapabilitiesMatch_of_mem + (positions : List PositionTrace) + {traces : List CodeTrace} {child : CodeTrace} + (matched : codeTraceListParameterCapabilitiesMatch positions traces = true) + (member : child ∈ traces) : + child.parameterCapabilitiesMatch positions = true := by + induction traces with + | nil => simp at member + | cons head tail ih => + simp only [codeTraceListParameterCapabilitiesMatch, + Bool.and_eq_true] at matched + simp only [List.mem_cons] at member + cases member with + | inl equal => simpa [equal] using matched.1 + | inr member => exact ih matched.2 member + +/-- Parameter-capability coherence is inherited by every immediate recursive +compiler call. -/ +theorem CodeTrace.parameterCapabilitiesMatch_of_child + (positions : List PositionTrace) {parent child : CodeTrace} + (matched : parent.parameterCapabilitiesMatch positions = true) + (member : child ∈ parent.children) : + child.parameterCapabilitiesMatch positions = true := by + cases parent with + | ret _ _ _ _ _ _ _ | tailCall _ _ _ _ _ _ _ + | tailCallSelf _ _ _ _ _ _ => + simp [CodeTrace.children] at member + | letOp source block input nextInput entryValueCount operation index + instruction next => + simp [CodeTrace.children] at member + subst child + simp only [CodeTrace.parameterCapabilitiesMatch, + Bool.and_eq_true] at matched + exact matched.2 + | switchValue source block input entryValueCount sourceScrutinee peel + alternatives targetScrutinee generated outgoing children => + have childrenMatched : + codeTraceListParameterCapabilitiesMatch positions children = true := + by + simp only [CodeTrace.parameterCapabilitiesMatch, + Bool.and_eq_true] at matched + exact matched.2 + exact codeTraceListParameterCapabilitiesMatch_of_mem positions + childrenMatched member + +/-- Every recursive descendant inherits parameter-capability coherence. -/ +theorem CodeTrace.Descendant.parameterCapabilitiesMatch + (positions : List PositionTrace) {root child : CodeTrace} + (descendant : Descendant root child) + (matched : root.parameterCapabilitiesMatch positions = true) : + child.parameterCapabilitiesMatch positions = true := by + induction descendant with + | refl => exact matched + | @step parent child parentDescendant childMem ih => + exact CodeTrace.parameterCapabilitiesMatch_of_child positions ih + childMem + +/-- Whole-program audit of producer capabilities against inherited target +block parameters. -/ +def Trace.parameterCapabilitiesMatch (trace : Trace) : Bool := + trace.functions.all fun functionTrace => + functionTrace.root.parameterCapabilitiesMatch trace.positions + +/-- Project the whole-program parameter-capability audit to one retained +function. -/ +theorem Trace.functionParameterCapabilitiesMatch {trace : Trace} + (matched : trace.parameterCapabilitiesMatch = true) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ trace.functions) : + functionTrace.root.parameterCapabilitiesMatch trace.positions = true := + List.all_eq_true.mp matched functionTrace member + +/-! ### Producer capability flow for `pure` / `move` -/ + +/-- Every flat position naming the continuation of this `pure` node is paired +with a current position whose capability vector evolves by `moveCapabilities?`. +The separate whole-position audit guarantees that the continuation set is +nonempty. -/ +def CodeTrace.pureTransitionMatches (positions : List PositionTrace) + (current next : CodeTrace) (source : IxIR1.Atom) : Bool := + positions.all fun after => + if after.coordinateMatches next.source next.sourceBlock + next.targetPosition next.sourceInputMap then + positions.any fun before => + before.coordinateMatches current.source current.sourceBlock + current.targetPosition current.sourceInputMap && + before.moveMatches after current.sourceInputMap source + else + true + +mutual + +/-- Recursive audit of every `pure` capability transition in a code tree. -/ +def CodeTrace.pureCapabilitiesMatch + (positions : List PositionTrace) : CodeTrace → Bool + | .ret .. | .tailCall .. | .tailCallSelf .. => true + | trace@(.letOp _ _ _ _ _ operation _ _ next) => + (match operation with + | .pure source => trace.pureTransitionMatches positions next source + | _ => true) && + next.pureCapabilitiesMatch positions + | .switchValue _ _ _ _ _ _ _ _ _ _ children => + codeTraceListPureCapabilitiesMatch positions children + +private def codeTraceListPureCapabilitiesMatch + (positions : List PositionTrace) : List CodeTrace → Bool + | [] => true + | trace :: rest => + trace.pureCapabilitiesMatch positions && + codeTraceListPureCapabilitiesMatch positions rest + +end + +/-- Reflect the checked before-position for an arbitrary matching +continuation position of one `pure` node. -/ +theorem CodeTrace.pureTransition_of_match + (positions : List PositionTrace) + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {index : Nat} {targetAtom : Atom} + {next : CodeTrace} {after : PositionTrace} + (matched : (CodeTrace.letOp source block input nextInput entryValueCount + (.pure sourceAtom) index (.move targetAtom) next + ).pureCapabilitiesMatch positions = true) + (afterMember : after ∈ positions) + (afterCoordinate : after.coordinateMatches next.source next.sourceBlock + next.targetPosition next.sourceInputMap = true) : + ∃ before, before ∈ positions ∧ + before.coordinateMatches source block (.instruction index) input = true ∧ + before.moveMatches after input sourceAtom = true := by + change (CodeTrace.pureTransitionMatches positions + (.letOp source block input nextInput entryValueCount + (.pure sourceAtom) index (.move targetAtom) next) + next sourceAtom && next.pureCapabilitiesMatch positions) = true at matched + simp only [Bool.and_eq_true] at matched + have point := List.all_eq_true.mp matched.1 after afterMember + rw [if_pos afterCoordinate] at point + obtain ⟨before, beforeMember, beforeMatch⟩ := List.any_eq_true.mp point + simp only [Bool.and_eq_true] at beforeMatch + exact ⟨before, beforeMember, by + simpa [CodeTrace.source, CodeTrace.sourceBlock, CodeTrace.targetPosition, + CodeTrace.sourceInputMap] using beforeMatch.1, beforeMatch.2⟩ + +private theorem codeTraceListPureCapabilitiesMatch_of_mem + (positions : List PositionTrace) + {traces : List CodeTrace} {child : CodeTrace} + (matched : codeTraceListPureCapabilitiesMatch positions traces = true) + (member : child ∈ traces) : + child.pureCapabilitiesMatch positions = true := by + induction traces with + | nil => simp at member + | cons head tail ih => + simp only [codeTraceListPureCapabilitiesMatch, + Bool.and_eq_true] at matched + simp only [List.mem_cons] at member + cases member with + | inl equal => simpa [equal] using matched.1 + | inr member => exact ih matched.2 member + +/-- `pure` capability-flow coherence is inherited by immediate recursive +compiler calls. -/ +theorem CodeTrace.pureCapabilitiesMatch_of_child + (positions : List PositionTrace) {parent child : CodeTrace} + (matched : parent.pureCapabilitiesMatch positions = true) + (member : child ∈ parent.children) : + child.pureCapabilitiesMatch positions = true := by + cases parent with + | ret _ _ _ _ _ _ _ | tailCall _ _ _ _ _ _ _ + | tailCallSelf _ _ _ _ _ _ => + simp [CodeTrace.children] at member + | letOp source block input nextInput entryValueCount operation index + instruction next => + simp [CodeTrace.children] at member + subst child + simp only [CodeTrace.pureCapabilitiesMatch, + Bool.and_eq_true] at matched + exact matched.2 + | switchValue source block input entryValueCount sourceScrutinee peel + alternatives targetScrutinee generated outgoing children => + exact codeTraceListPureCapabilitiesMatch_of_mem positions matched member + +/-- Every recursive descendant inherits the checked `pure` capability-flow +audit. -/ +theorem CodeTrace.Descendant.pureCapabilitiesMatch + (positions : List PositionTrace) {root child : CodeTrace} + (descendant : Descendant root child) + (matched : root.pureCapabilitiesMatch positions = true) : + child.pureCapabilitiesMatch positions = true := by + induction descendant with + | refl => exact matched + | @step parent child parentDescendant childMem ih => + exact CodeTrace.pureCapabilitiesMatch_of_child positions ih childMem + +/-- Whole-program `pure` capability-flow audit. -/ +def Trace.pureCapabilitiesMatch (trace : Trace) : Bool := + trace.functions.all fun functionTrace => + functionTrace.root.pureCapabilitiesMatch trace.positions + +/-- Project whole-program `pure` capability flow to one retained function. -/ +theorem Trace.functionPureCapabilitiesMatch {trace : Trace} + (matched : trace.pureCapabilitiesMatch = true) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ trace.functions) : + functionTrace.root.pureCapabilitiesMatch trace.positions = true := + List.all_eq_true.mp matched functionTrace member + +/-! ### Producer capability flow for `dup` / `retainShared` -/ + +/-- Capability vector produced by the lowerer's shared-retain rule. Scalars +remain scalar; an owned or borrowed shared value produces a new shared owner +without consuming the source slot. -/ +def dupCapabilities? (capabilities : Array BindingCap) + (source : IxIR1.Atom) : Option (Array BindingCap) := + match sourceCapability? capabilities source with + | some .scalar => some (#[.scalar] ++ capabilities) + | some (.owned .shared) | some (.borrowed .shared _) => + some (#[.owned .shared] ++ capabilities) + | none | some (.owned .unique) | some (.borrowed .unique _) | + some .dead => none + +/-- One retained before/after position pair agrees with the exact +`dup`/`retainShared` capability effect. -/ +def PositionTrace.dupMatches (before after : PositionTrace) + (source : IxIR1.Atom) : Bool := + match dupCapabilities? before.sourceCapabilities source with + | some expected => expected == after.sourceCapabilities + | none => false + +/-- Every flat position naming the continuation of this `dup` node is paired +with a current position whose capability vector evolves by `dupCapabilities?`. +-/ +def CodeTrace.dupTransitionMatches (positions : List PositionTrace) + (current next : CodeTrace) (source : IxIR1.Atom) : Bool := + positions.all fun after => + if after.coordinateMatches next.source next.sourceBlock + next.targetPosition next.sourceInputMap then + positions.any fun before => + before.coordinateMatches current.source current.sourceBlock + current.targetPosition current.sourceInputMap && + before.dupMatches after source + else + true + +mutual + +/-- Recursive audit of every `dup` capability transition in a code tree. -/ +def CodeTrace.dupCapabilitiesMatch + (positions : List PositionTrace) : CodeTrace → Bool + | .ret .. | .tailCall .. | .tailCallSelf .. => true + | trace@(.letOp _ _ _ _ _ operation _ _ next) => + (match operation with + | .dup source => trace.dupTransitionMatches positions next source + | _ => true) && + next.dupCapabilitiesMatch positions + | .switchValue _ _ _ _ _ _ _ _ _ _ children => + codeTraceListDupCapabilitiesMatch positions children + +private def codeTraceListDupCapabilitiesMatch + (positions : List PositionTrace) : List CodeTrace → Bool + | [] => true + | trace :: rest => + trace.dupCapabilitiesMatch positions && + codeTraceListDupCapabilitiesMatch positions rest + +end + +/-- Reflect the checked before-position for an arbitrary matching +continuation position of one `dup` node. -/ +theorem CodeTrace.dupTransition_of_match + (positions : List PositionTrace) + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {index : Nat} {targetAtom : Atom} + {next : CodeTrace} {after : PositionTrace} + (matched : (CodeTrace.letOp source block input nextInput entryValueCount + (.dup sourceAtom) index (.retainShared targetAtom) next + ).dupCapabilitiesMatch positions = true) + (afterMember : after ∈ positions) + (afterCoordinate : after.coordinateMatches next.source next.sourceBlock + next.targetPosition next.sourceInputMap = true) : + ∃ before, before ∈ positions ∧ + before.coordinateMatches source block (.instruction index) input = true ∧ + before.dupMatches after sourceAtom = true := by + change (CodeTrace.dupTransitionMatches positions + (.letOp source block input nextInput entryValueCount + (.dup sourceAtom) index (.retainShared targetAtom) next) + next sourceAtom && next.dupCapabilitiesMatch positions) = true at matched + simp only [Bool.and_eq_true] at matched + have point := List.all_eq_true.mp matched.1 after afterMember + rw [if_pos afterCoordinate] at point + obtain ⟨before, beforeMember, beforeMatch⟩ := List.any_eq_true.mp point + simp only [Bool.and_eq_true] at beforeMatch + exact ⟨before, beforeMember, by + simpa [CodeTrace.source, CodeTrace.sourceBlock, CodeTrace.targetPosition, + CodeTrace.sourceInputMap] using beforeMatch.1, beforeMatch.2⟩ + +private theorem codeTraceListDupCapabilitiesMatch_of_mem + (positions : List PositionTrace) + {traces : List CodeTrace} {child : CodeTrace} + (matched : codeTraceListDupCapabilitiesMatch positions traces = true) + (member : child ∈ traces) : + child.dupCapabilitiesMatch positions = true := by + induction traces with + | nil => simp at member + | cons head tail ih => + simp only [codeTraceListDupCapabilitiesMatch, + Bool.and_eq_true] at matched + simp only [List.mem_cons] at member + cases member with + | inl equal => simpa [equal] using matched.1 + | inr member => exact ih matched.2 member + +/-- `dup` capability-flow coherence is inherited by immediate recursive +compiler calls. -/ +theorem CodeTrace.dupCapabilitiesMatch_of_child + (positions : List PositionTrace) {parent child : CodeTrace} + (matched : parent.dupCapabilitiesMatch positions = true) + (member : child ∈ parent.children) : + child.dupCapabilitiesMatch positions = true := by + cases parent with + | ret _ _ _ _ _ _ _ | tailCall _ _ _ _ _ _ _ + | tailCallSelf _ _ _ _ _ _ => + simp [CodeTrace.children] at member + | letOp source block input nextInput entryValueCount operation index + instruction next => + simp [CodeTrace.children] at member + subst child + simp only [CodeTrace.dupCapabilitiesMatch, + Bool.and_eq_true] at matched + exact matched.2 + | switchValue source block input entryValueCount sourceScrutinee peel + alternatives targetScrutinee generated outgoing children => + exact codeTraceListDupCapabilitiesMatch_of_mem positions matched member + +/-- Every recursive descendant inherits the checked `dup` capability-flow +audit. -/ +theorem CodeTrace.Descendant.dupCapabilitiesMatch + (positions : List PositionTrace) {root child : CodeTrace} + (descendant : Descendant root child) + (matched : root.dupCapabilitiesMatch positions = true) : + child.dupCapabilitiesMatch positions = true := by + induction descendant with + | refl => exact matched + | @step parent child parentDescendant childMem ih => + exact CodeTrace.dupCapabilitiesMatch_of_child positions ih childMem + +/-- Whole-program `dup` capability-flow audit. -/ +def Trace.dupCapabilitiesMatch (trace : Trace) : Bool := + trace.functions.all fun functionTrace => + functionTrace.root.dupCapabilitiesMatch trace.positions + +/-- Project whole-program `dup` capability flow to one retained function. -/ +theorem Trace.functionDupCapabilitiesMatch {trace : Trace} + (matched : trace.dupCapabilitiesMatch = true) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ trace.functions) : + functionTrace.root.dupCapabilitiesMatch trace.positions = true := + List.all_eq_true.mp matched functionTrace member + +/-! ### Producer capability flow for `fetch` -/ + +/-- Capability vector accepted by the ownership simulation for the lowerer's +non-consuming projection rule. The baseline schema is uniform in the +constructor world, so the projected value is borrowed in that same world. +An owned constructor lends through its translated register; an existing +borrow preserves its original lender. -/ +def fetchCapabilities? (capabilities : Array BindingCap) + (source : IxIR1.Atom) (target : Atom) : Option (Array BindingCap) := + match sourceCapability? capabilities source with + | some (.owned world) => + match target with + | .reg id => + some (#[.borrowed world (.value id)] ++ capabilities) + | .lit _ | .erased => none + | some (.borrowed world lender) => + some (#[.borrowed world lender] ++ capabilities) + | none | some .scalar | some .dead => none + +/-- One retained before/after position pair agrees with the exact +baseline-compatible `fetch` capability effect. -/ +def PositionTrace.fetchMatches (before after : PositionTrace) + (source : IxIR1.Atom) (target : Atom) : Bool := + match fetchCapabilities? before.sourceCapabilities source target with + | some expected => expected == after.sourceCapabilities + | none => false + +/-- Every flat position naming the continuation of this `fetch` node is +paired with a current position whose capability vector evolves by +`fetchCapabilities?`. -/ +def CodeTrace.fetchTransitionMatches (positions : List PositionTrace) + (current next : CodeTrace) (source : IxIR1.Atom) (target : Atom) : Bool := + positions.all fun after => + if after.coordinateMatches next.source next.sourceBlock + next.targetPosition next.sourceInputMap then + positions.any fun before => + before.coordinateMatches current.source current.sourceBlock + current.targetPosition current.sourceInputMap && + before.fetchMatches after source target + else + true + +mutual + +/-- Recursive audit of every `fetch` capability transition in a code tree. -/ +def CodeTrace.fetchCapabilitiesMatch + (positions : List PositionTrace) : CodeTrace → Bool + | .ret .. | .tailCall .. | .tailCallSelf .. => true + | trace@(.letOp _ _ _ _ _ operation _ instruction next) => + (match operation, instruction with + | .fetch source _, .fetch target _ _ => + trace.fetchTransitionMatches positions next source target + | .fetch .., _ => false + | _, _ => true) && + next.fetchCapabilitiesMatch positions + | .switchValue _ _ _ _ _ _ _ _ _ _ children => + codeTraceListFetchCapabilitiesMatch positions children + +private def codeTraceListFetchCapabilitiesMatch + (positions : List PositionTrace) : List CodeTrace → Bool + | [] => true + | trace :: rest => + trace.fetchCapabilitiesMatch positions && + codeTraceListFetchCapabilitiesMatch positions rest + +end + +/-- Reflect the checked before-position for an arbitrary matching +continuation position of one `fetch` node. -/ +theorem CodeTrace.fetchTransition_of_match + (positions : List PositionTrace) + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {sourceField index : Nat} + {targetAtom : Atom} {targetCid : CtorId} {targetField : Nat} + {next : CodeTrace} {after : PositionTrace} + (matched : (CodeTrace.letOp source block input nextInput entryValueCount + (.fetch sourceAtom sourceField) index + (.fetch targetAtom targetCid targetField) next + ).fetchCapabilitiesMatch positions = true) + (afterMember : after ∈ positions) + (afterCoordinate : after.coordinateMatches next.source next.sourceBlock + next.targetPosition next.sourceInputMap = true) : + ∃ before, before ∈ positions ∧ + before.coordinateMatches source block (.instruction index) input = true ∧ + before.fetchMatches after sourceAtom targetAtom = true := by + change (CodeTrace.fetchTransitionMatches positions + (.letOp source block input nextInput entryValueCount + (.fetch sourceAtom sourceField) index + (.fetch targetAtom targetCid targetField) next) + next sourceAtom targetAtom && next.fetchCapabilitiesMatch positions) = + true at matched + simp only [Bool.and_eq_true] at matched + have point := List.all_eq_true.mp matched.1 after afterMember + rw [if_pos afterCoordinate] at point + obtain ⟨before, beforeMember, beforeMatch⟩ := List.any_eq_true.mp point + simp only [Bool.and_eq_true] at beforeMatch + exact ⟨before, beforeMember, by + simpa [CodeTrace.source, CodeTrace.sourceBlock, CodeTrace.targetPosition, + CodeTrace.sourceInputMap] using beforeMatch.1, beforeMatch.2⟩ + +private theorem codeTraceListFetchCapabilitiesMatch_of_mem + (positions : List PositionTrace) + {traces : List CodeTrace} {child : CodeTrace} + (matched : codeTraceListFetchCapabilitiesMatch positions traces = true) + (member : child ∈ traces) : + child.fetchCapabilitiesMatch positions = true := by + induction traces with + | nil => simp at member + | cons head tail ih => + simp only [codeTraceListFetchCapabilitiesMatch, + Bool.and_eq_true] at matched + simp only [List.mem_cons] at member + cases member with + | inl equal => simpa [equal] using matched.1 + | inr member => exact ih matched.2 member + +/-- `fetch` capability-flow coherence is inherited by immediate recursive +compiler calls. -/ +theorem CodeTrace.fetchCapabilitiesMatch_of_child + (positions : List PositionTrace) {parent child : CodeTrace} + (matched : parent.fetchCapabilitiesMatch positions = true) + (member : child ∈ parent.children) : + child.fetchCapabilitiesMatch positions = true := by + cases parent with + | ret _ _ _ _ _ _ _ | tailCall _ _ _ _ _ _ _ + | tailCallSelf _ _ _ _ _ _ => + simp [CodeTrace.children] at member + | letOp source block input nextInput entryValueCount operation index + instruction next => + simp [CodeTrace.children] at member + subst child + simp only [CodeTrace.fetchCapabilitiesMatch, + Bool.and_eq_true] at matched + exact matched.2 + | switchValue source block input entryValueCount sourceScrutinee peel + alternatives targetScrutinee generated outgoing children => + exact codeTraceListFetchCapabilitiesMatch_of_mem positions matched member + +/-- Every recursive descendant inherits the checked `fetch` capability-flow +audit. -/ +theorem CodeTrace.Descendant.fetchCapabilitiesMatch + (positions : List PositionTrace) {root child : CodeTrace} + (descendant : Descendant root child) + (matched : root.fetchCapabilitiesMatch positions = true) : + child.fetchCapabilitiesMatch positions = true := by + induction descendant with + | refl => exact matched + | @step parent child parentDescendant childMem ih => + exact CodeTrace.fetchCapabilitiesMatch_of_child positions ih childMem + +/-- Whole-program `fetch` capability-flow audit. -/ +def Trace.fetchCapabilitiesMatch (trace : Trace) : Bool := + trace.functions.all fun functionTrace => + functionTrace.root.fetchCapabilitiesMatch trace.positions + +/-- Project whole-program `fetch` capability flow to one retained function. -/ +theorem Trace.functionFetchCapabilitiesMatch {trace : Trace} + (matched : trace.fetchCapabilitiesMatch = true) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ trace.functions) : + functionTrace.root.fetchCapabilitiesMatch trace.positions = true := + List.all_eq_true.mp matched functionTrace member + +/-! ### Shared owned-boundary capability consumption -/ + +/-- Consume one source operand at an owned boundary, mirroring +`consumeExpected`. Scalars are ownership-inert; an exact owner and all loans +rooted at its SSA register are retired; borrows, dead slots, and wrong-world +owners fail closed. -/ +def consumeCapability? (capabilities : Array BindingCap) + (input : Array (Option Atom)) (world : Owned) (source : IxIR1.Atom) : + Option (Array BindingCap) := + match source, sourceCapability? capabilities source with + | _, some .scalar => some capabilities + | .var index, some (.owned actual) => + if actual == world then + retireOwnerCapabilities? capabilities input index + else + none + | _, _ => none + +/-- Sequential owned-boundary consumption in source argument order. -/ +def consumeCapabilitiesList? (capabilities : Array BindingCap) + (input : Array (Option Atom)) + (world : Owned) : List IxIR1.Atom → Option (Array BindingCap) + | [] => some capabilities + | source :: rest => do + let remaining ← consumeCapability? capabilities input world source + consumeCapabilitiesList? remaining input world rest + +/-- Sequentially consume a heterogeneous owned parameter telescope. The +two lists must have identical cardinality; each argument is checked and +retired in the world of its corresponding parameter. -/ +def consumeCapabilitiesWorlds? (capabilities : Array BindingCap) + (input : Array (Option Atom)) : + List Owned → List IxIR1.Atom → Option (Array BindingCap) + | [], [] => some capabilities + | world :: worlds, source :: sources => do + let remaining ← consumeCapability? capabilities input world source + consumeCapabilitiesWorlds? remaining input worlds sources + | _, _ => none + +/-- A successful heterogeneous consumption has matching parameter and +argument cardinalities. -/ +theorem consumeCapabilitiesWorlds?_length + {capabilities remaining : Array BindingCap} + {input : Array (Option Atom)} {worlds : List Owned} + {sources : List IxIR1.Atom} + (consumed : consumeCapabilitiesWorlds? capabilities input worlds sources = + some remaining) : + worlds.length = sources.length := by + induction worlds generalizing capabilities sources with + | nil => + cases sources with + | nil => rfl + | cons source rest => simp [consumeCapabilitiesWorlds?] at consumed + | cons world worlds ih => + cases sources with + | nil => simp [consumeCapabilitiesWorlds?] at consumed + | cons source sources => + simp only [consumeCapabilitiesWorlds?] at consumed + cases step : consumeCapability? capabilities input world source with + | none => simp [step] at consumed + | some next => + simp only [step] at consumed + simp [ih consumed] + +/-! ### Exact capability flow for destructive operations -/ + +/-- The ownership world and operand consumed by a baseline destruction +operation. Other operations do not participate in this audit. -/ +def destructionSpec? : IxIR1.Op → Option (Owned × IxIR1.Atom) + | .free source => some (.unique, source) + | .drop source => some (.shared, source) + | .dropU source => some (.unique, source) + | _ => none + +/-- Exact continuation capability vector after destruction: consume the +selected owner (and retire its rooted loans), then bind the erased scalar +result at the de Bruijn head. -/ +def destructionCapabilities? (capabilities : Array BindingCap) + (input : Array (Option Atom)) (world : Owned) + (source : IxIR1.Atom) : Option (Array BindingCap) := do + let remaining ← consumeCapability? capabilities input world source + return #[.scalar] ++ remaining + +/-- One retained destruction before/after pair has the exact +consume-and-bind-scalar effect. -/ +def PositionTrace.destructionResultMatches (before after : PositionTrace) + (input : Array (Option Atom)) (world : Owned) + (source : IxIR1.Atom) : Bool := + match destructionCapabilities? before.sourceCapabilities input world source with + | some expected => expected == after.sourceCapabilities + | none => false + +/-- Every continuation position of one destruction node has an exact +capability predecessor. -/ +def CodeTrace.destructionTransitionMatches (positions : List PositionTrace) + (current next : CodeTrace) (world : Owned) + (source : IxIR1.Atom) : Bool := + positions.all fun after => + if after.coordinateMatches next.source next.sourceBlock + next.targetPosition next.sourceInputMap then + positions.any fun before => + before.coordinateMatches current.source current.sourceBlock + current.targetPosition current.sourceInputMap && + before.destructionResultMatches after current.sourceInputMap world + source + else + true + +mutual + +/-- Recursive exact capability audit for shallow free and shared/unique deep +destruction. -/ +def CodeTrace.destructionCapabilitiesMatch + (positions : List PositionTrace) : CodeTrace → Bool + | .ret .. | .tailCall .. | .tailCallSelf .. => true + | trace@(.letOp _ _ _ _ _ operation _ _ next) => + (match destructionSpec? operation with + | some (world, source) => + trace.destructionTransitionMatches positions next world source + | none => true) && + next.destructionCapabilitiesMatch positions + | .switchValue _ _ _ _ _ _ _ _ _ _ children => + codeTraceListDestructionCapabilitiesMatch positions children + +private def codeTraceListDestructionCapabilitiesMatch + (positions : List PositionTrace) : List CodeTrace → Bool + | [] => true + | trace :: rest => + trace.destructionCapabilitiesMatch positions && + codeTraceListDestructionCapabilitiesMatch positions rest + +end + +/-- Reflect the exact capability predecessor of any matching continuation +position at an audited destruction node. -/ +theorem CodeTrace.destructionTransition_of_match + (positions : List PositionTrace) + {sourceSite : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {operation : IxIR1.Op} {world : Owned} {sourceAtom : IxIR1.Atom} + {index : Nat} {instruction : Instr} {next : CodeTrace} + {after : PositionTrace} + (operationMatch : destructionSpec? operation = some (world, sourceAtom)) + (matched : (CodeTrace.letOp sourceSite block input nextInput + entryValueCount operation index instruction next + ).destructionCapabilitiesMatch positions = true) + (afterMember : after ∈ positions) + (afterCoordinate : after.coordinateMatches next.source next.sourceBlock + next.targetPosition next.sourceInputMap = true) : + ∃ before, before ∈ positions ∧ + before.coordinateMatches sourceSite block (.instruction index) input = + true ∧ + before.destructionResultMatches after input world sourceAtom = true := by + change (((match destructionSpec? operation with + | some (world, source) => + (CodeTrace.letOp sourceSite block input nextInput entryValueCount + operation index instruction next).destructionTransitionMatches + positions next world source + | none => true) && + next.destructionCapabilitiesMatch positions) = true) at matched + rw [operationMatch] at matched + simp only [Bool.and_eq_true] at matched + have point := List.all_eq_true.mp matched.1 after afterMember + rw [if_pos afterCoordinate] at point + obtain ⟨before, beforeMember, beforeMatch⟩ := List.any_eq_true.mp point + simp only [Bool.and_eq_true] at beforeMatch + exact ⟨before, beforeMember, by + simpa [CodeTrace.source, CodeTrace.sourceBlock, CodeTrace.targetPosition, + CodeTrace.sourceInputMap] using beforeMatch.1, beforeMatch.2⟩ + +private theorem codeTraceListDestructionCapabilitiesMatch_of_mem + (positions : List PositionTrace) {traces : List CodeTrace} + {child : CodeTrace} + (matched : codeTraceListDestructionCapabilitiesMatch positions traces = + true) + (member : child ∈ traces) : + child.destructionCapabilitiesMatch positions = true := by + induction traces with + | nil => simp at member + | cons head tail ih => + simp only [codeTraceListDestructionCapabilitiesMatch, + Bool.and_eq_true] at matched + simp only [List.mem_cons] at member + cases member with + | inl equal => simpa [equal] using matched.1 + | inr member => exact ih matched.2 member + +/-- Destruction capability coherence is inherited by every immediate +recursive compiler call. -/ +theorem CodeTrace.destructionCapabilitiesMatch_of_child + (positions : List PositionTrace) {parent child : CodeTrace} + (matched : parent.destructionCapabilitiesMatch positions = true) + (member : child ∈ parent.children) : + child.destructionCapabilitiesMatch positions = true := by + cases parent with + | ret _ _ _ _ _ _ _ | tailCall _ _ _ _ _ _ _ + | tailCallSelf _ _ _ _ _ _ => + simp [CodeTrace.children] at member + | letOp source block input nextInput entryValueCount operation index + instruction next => + simp [CodeTrace.children] at member + subst child + simp only [CodeTrace.destructionCapabilitiesMatch, + Bool.and_eq_true] at matched + exact matched.2 + | switchValue source block input entryValueCount sourceScrutinee peel + alternatives targetScrutinee generated outgoing children => + exact codeTraceListDestructionCapabilitiesMatch_of_mem positions matched + member + +/-- Every recursive descendant inherits checked destruction capability +coherence. -/ +theorem CodeTrace.Descendant.destructionCapabilitiesMatch + (positions : List PositionTrace) {root child : CodeTrace} + (descendant : Descendant root child) + (matched : root.destructionCapabilitiesMatch positions = true) : + child.destructionCapabilitiesMatch positions = true := by + induction descendant with + | refl => exact matched + | @step parent child parentDescendant childMem ih => + exact CodeTrace.destructionCapabilitiesMatch_of_child positions ih + childMem + +/-- Whole-program destructive capability-flow audit. -/ +def Trace.destructionCapabilitiesMatch (trace : Trace) : Bool := + trace.functions.all fun functionTrace => + functionTrace.root.destructionCapabilitiesMatch trace.positions + +/-- Project whole-program destruction capability flow to one retained +function. -/ +theorem Trace.functionDestructionCapabilitiesMatch {trace : Trace} + (matched : trace.destructionCapabilitiesMatch = true) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ trace.functions) : + functionTrace.root.destructionCapabilitiesMatch trace.positions = true := + List.all_eq_true.mp matched functionTrace member + +/-! ### Exact producer capability flow for ordinary allocation -/ + +/-- Consuming one operand changes capability state, never its cardinality. -/ +theorem consumeCapability?_size {capabilities remaining : Array BindingCap} + {input : Array (Option Atom)} {world : Owned} {source : IxIR1.Atom} + (consumed : consumeCapability? capabilities input world source = + some remaining) : + remaining.size = capabilities.size := by + cases source with + | lit literal => + simp [consumeCapability?, sourceCapability?] at consumed + subst remaining + rfl + | erased => + simp [consumeCapability?, sourceCapability?] at consumed + subst remaining + rfl + | var index => + cases capabilityAt : capabilities[index]? with + | none => simp [consumeCapability?, sourceCapability?, capabilityAt] at consumed + | some capability => + cases capability with + | scalar => + simp [consumeCapability?, sourceCapability?, capabilityAt] at consumed + subst remaining + rfl + | borrowed actual lender => + simp [consumeCapability?, sourceCapability?, capabilityAt] at consumed + | dead => + simp [consumeCapability?, sourceCapability?, capabilityAt] at consumed + | owned actual => + simp [consumeCapability?, sourceCapability?, capabilityAt] at consumed + obtain ⟨_, remainingEq⟩ := consumed + exact retireOwnerCapabilities?_size remainingEq + +/-- Sequential consumption preserves the source-slot cardinality. -/ +theorem consumeCapabilitiesList?_size + {capabilities remaining : Array BindingCap} {world : Owned} + {input : Array (Option Atom)} {sources : List IxIR1.Atom} + (consumed : consumeCapabilitiesList? capabilities input world sources = + some remaining) : + remaining.size = capabilities.size := by + induction sources generalizing capabilities with + | nil => + simp [consumeCapabilitiesList?] at consumed + subst remaining + rfl + | cons source rest ih => + simp only [consumeCapabilitiesList?] at consumed + cases step : consumeCapability? capabilities input world source with + | none => simp [step] at consumed + | some next => + simp only [step] at consumed + exact (ih consumed).trans (consumeCapability?_size step) + +/-- Heterogeneous consumption preserves source-slot cardinality. -/ +theorem consumeCapabilitiesWorlds?_size + {capabilities remaining : Array BindingCap} + {input : Array (Option Atom)} {worlds : List Owned} + {sources : List IxIR1.Atom} + (consumed : consumeCapabilitiesWorlds? capabilities input worlds sources = + some remaining) : + remaining.size = capabilities.size := by + induction worlds generalizing capabilities sources with + | nil => + cases sources with + | nil => + simp [consumeCapabilitiesWorlds?] at consumed + subst remaining + rfl + | cons source rest => simp [consumeCapabilitiesWorlds?] at consumed + | cons world worlds ih => + cases sources with + | nil => simp [consumeCapabilitiesWorlds?] at consumed + | cons source sources => + simp only [consumeCapabilitiesWorlds?] at consumed + cases step : consumeCapability? capabilities input world source with + | none => simp [step] at consumed + | some next => + simp only [step] at consumed + exact (ih consumed).trans (consumeCapability?_size step) + +/-- Exact capability vector after an ordinary uniform-world allocation. -/ +def allocationCapabilities? (capabilities : Array BindingCap) + (input : Array (Option Atom)) (world : Owned) + (arguments : Array IxIR1.Atom) : + Option (Array BindingCap) := do + let remaining ← consumeCapabilitiesList? capabilities input world + arguments.toList + return #[.owned world] ++ remaining + +/-- One retained allocation before/after pair has the exact sequential +consume-and-bind capability effect. -/ +def PositionTrace.allocationResultMatches (before after : PositionTrace) + (input : Array (Option Atom)) (world : Owned) + (arguments : Array IxIR1.Atom) : Bool := + match allocationCapabilities? before.sourceCapabilities input world + arguments with + | some expected => expected == after.sourceCapabilities + | none => false + +/-- Checked allocation-specific projection of one producer position. Besides +coordinate/live-map agreement, every source field operand is scalar or an +owner in the allocation world. -/ +def PositionTrace.allocationMatches (position : PositionTrace) + (source : SourceSite) (block : BlockId) (index : Nat) + (input : Array (Option Atom)) (world : Owned) + (arguments : Array IxIR1.Atom) : Bool := + position.coordinateMatches source block (.instruction index) input && + arguments.toList.all fun argument => + match sourceCapability? position.sourceCapabilities argument with + | some capability => capability.canConsume world + | none => false + +/-- Every continuation position of one ordinary allocation is paired with a +current position carrying its exact sequential consumption effect. -/ +def CodeTrace.allocationTransitionMatches (positions : List PositionTrace) + (current next : CodeTrace) (world : Owned) + (arguments : Array IxIR1.Atom) : Bool := + positions.all fun after => + if after.coordinateMatches next.source next.sourceBlock + next.targetPosition next.sourceInputMap then + positions.any fun before => + before.coordinateMatches current.source current.sourceBlock + current.targetPosition current.sourceInputMap && + before.allocationResultMatches after current.sourceInputMap world + arguments + else + true + +mutual + +/-- Every ordinary constructor or function-PAP allocation node has an exact +sequential consume-and-bind continuation. Constructor allocations additionally +retain their schema-facing producer position; recursive continuations and +switch children satisfy the same audit. -/ +def CodeTrace.allocationCapabilitiesMatch + (positions : List PositionTrace) : CodeTrace → Bool + | .ret .. | .tailCall .. | .tailCallSelf .. => true + | trace@(.letOp source block input _ _ operation index _ next) => + (match operation with + | .alloc world _ arguments => + (positions.any fun position => + position.allocationMatches source block index input world arguments) && + trace.allocationTransitionMatches positions next world arguments + | .papp _ arguments => + trace.allocationTransitionMatches positions next .shared arguments + | _ => true) && + next.allocationCapabilitiesMatch positions + | .switchValue _ _ _ _ _ _ _ _ _ _ children => + codeTraceListAllocationCapabilitiesMatch positions children + +private def codeTraceListAllocationCapabilitiesMatch + (positions : List PositionTrace) : List CodeTrace → Bool + | [] => true + | trace :: rest => + trace.allocationCapabilitiesMatch positions && + codeTraceListAllocationCapabilitiesMatch positions rest + +end + +/-- Reflect the retained producer position at one audited allocation node. -/ +theorem CodeTrace.allocationPosition_of_capabilities_match + (positions : List PositionTrace) + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {world : Owned} {identity : CtorId} + {arguments : Array IxIR1.Atom} {index : Nat} + {instruction : Instr} {next : CodeTrace} + (matched : (CodeTrace.letOp source block input nextInput entryValueCount + (.alloc world identity arguments) index instruction next + ).allocationCapabilitiesMatch positions = true) : + ∃ position, position ∈ positions ∧ + position.allocationMatches source block index input world arguments = + true := by + change (((positions.any fun position => + position.allocationMatches source block index input world arguments) && + (CodeTrace.letOp source block input nextInput entryValueCount + (.alloc world identity arguments) index instruction next + ).allocationTransitionMatches positions next world arguments) && + next.allocationCapabilitiesMatch positions) = true at matched + simp only [Bool.and_eq_true] at matched + exact List.any_eq_true.mp matched.1.1 + +/-- Reflect the exact producer capability predecessor of any matching +continuation position at an audited ordinary allocation. -/ +theorem CodeTrace.allocationTransition_of_capabilities_match + (positions : List PositionTrace) + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {world : Owned} {identity : CtorId} + {arguments : Array IxIR1.Atom} {index : Nat} + {instruction : Instr} {next : CodeTrace} {after : PositionTrace} + (matched : (CodeTrace.letOp source block input nextInput entryValueCount + (.alloc world identity arguments) index instruction next + ).allocationCapabilitiesMatch positions = true) + (afterMember : after ∈ positions) + (afterCoordinate : after.coordinateMatches next.source next.sourceBlock + next.targetPosition next.sourceInputMap = true) : + ∃ before, before ∈ positions ∧ + before.coordinateMatches source block (.instruction index) input = true ∧ + before.allocationResultMatches after input world arguments = true := by + change (((positions.any fun position => + position.allocationMatches source block index input world arguments) && + (CodeTrace.letOp source block input nextInput entryValueCount + (.alloc world identity arguments) index instruction next + ).allocationTransitionMatches positions next world arguments) && + next.allocationCapabilitiesMatch positions) = true at matched + simp only [Bool.and_eq_true] at matched + have point := List.all_eq_true.mp matched.1.2 after afterMember + rw [if_pos afterCoordinate] at point + obtain ⟨before, beforeMember, beforeMatch⟩ := List.any_eq_true.mp point + simp only [Bool.and_eq_true] at beforeMatch + exact ⟨before, beforeMember, by + simpa [CodeTrace.source, CodeTrace.sourceBlock, CodeTrace.targetPosition, + CodeTrace.sourceInputMap] using beforeMatch.1, beforeMatch.2⟩ + +/-- Reflect the exact shared capture consumption and fresh PAP-owner binding +at any audited function partial application. -/ +theorem CodeTrace.pappTransition_of_capabilities_match + (positions : List PositionTrace) + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {address : Address} {arguments : Array IxIR1.Atom} {index : Nat} + {instruction : Instr} {next : CodeTrace} {after : PositionTrace} + (matched : (CodeTrace.letOp source block input nextInput entryValueCount + (.papp address arguments) index instruction next + ).allocationCapabilitiesMatch positions = true) + (afterMember : after ∈ positions) + (afterCoordinate : after.coordinateMatches next.source next.sourceBlock + next.targetPosition next.sourceInputMap = true) : + ∃ before, before ∈ positions ∧ + before.coordinateMatches source block (.instruction index) input = true ∧ + before.allocationResultMatches after input .shared arguments = true := by + change (((CodeTrace.letOp source block input nextInput entryValueCount + (.papp address arguments) index instruction next + ).allocationTransitionMatches positions next .shared arguments && + next.allocationCapabilitiesMatch positions) = true) at matched + simp only [Bool.and_eq_true] at matched + have point := List.all_eq_true.mp matched.1 after afterMember + rw [if_pos afterCoordinate] at point + obtain ⟨before, beforeMember, beforeMatch⟩ := List.any_eq_true.mp point + simp only [Bool.and_eq_true] at beforeMatch + exact ⟨before, beforeMember, by + simpa [CodeTrace.source, CodeTrace.sourceBlock, CodeTrace.targetPosition, + CodeTrace.sourceInputMap] using beforeMatch.1, beforeMatch.2⟩ + +/-- An audited allocation position has the exact capability/input-map +cardinality. -/ +theorem PositionTrace.sourceCapabilities_size_of_allocationMatch + {position : PositionTrace} {source : SourceSite} {block : BlockId} + {index : Nat} {input : Array (Option Atom)} {world : Owned} + {arguments : Array IxIR1.Atom} + (matched : position.allocationMatches source block index input world + arguments = true) : + position.sourceCapabilities.size = input.size := by + unfold PositionTrace.allocationMatches at matched + simp only [Bool.and_eq_true] at matched + exact sourceCapabilities_size_of_coordinateMatch matched.1 + +/-- Allocation-specific matching includes the generic recursive-node +coordinate match used by the dynamic ownership invariant. -/ +theorem PositionTrace.coordinateMatches_of_allocationMatch + {position : PositionTrace} {source : SourceSite} {block : BlockId} + {index : Nat} {input : Array (Option Atom)} {world : Owned} + {arguments : Array IxIR1.Atom} + (matched : position.allocationMatches source block index input world + arguments = true) : + position.coordinateMatches source block (.instruction index) input = + true := by + unfold PositionTrace.allocationMatches at matched + simp only [Bool.and_eq_true] at matched + exact matched.1 + +/-- Every retained allocation argument resolves through a scalar or an exact +owner in the allocation world. -/ +theorem PositionTrace.sourceCapability_canConsume_of_allocationMatch + {position : PositionTrace} {source : SourceSite} {block : BlockId} + {index : Nat} {input : Array (Option Atom)} {world : Owned} + {arguments : Array IxIR1.Atom} + (matched : position.allocationMatches source block index input world + arguments = true) {argument : IxIR1.Atom} + (member : argument ∈ arguments.toList) : + ∃ capability, + sourceCapability? position.sourceCapabilities argument = + some capability ∧ + capability.canConsume world = true := by + unfold PositionTrace.allocationMatches at matched + simp only [Bool.and_eq_true] at matched + have argumentsMatched := matched.2 + have argumentMatched := + List.all_eq_true.mp argumentsMatched argument member + cases capabilityAt : sourceCapability? position.sourceCapabilities argument with + | none => simp [capabilityAt] at argumentMatched + | some capability => + exact ⟨capability, rfl, by simpa [capabilityAt] using argumentMatched⟩ + +private theorem codeTraceListAllocationCapabilitiesMatch_of_mem + (positions : List PositionTrace) + {traces : List CodeTrace} {child : CodeTrace} + (matched : codeTraceListAllocationCapabilitiesMatch positions traces = true) + (member : child ∈ traces) : + child.allocationCapabilitiesMatch positions = true := by + induction traces with + | nil => simp at member + | cons head tail ih => + simp only [codeTraceListAllocationCapabilitiesMatch, + Bool.and_eq_true] at matched + simp only [List.mem_cons] at member + cases member with + | inl equal => simpa [equal] using matched.1 + | inr member => exact ih matched.2 member + +/-- Allocation-capability coherence is inherited by every immediate +recursive compiler call. -/ +theorem CodeTrace.allocationCapabilitiesMatch_of_child + (positions : List PositionTrace) {parent child : CodeTrace} + (matched : parent.allocationCapabilitiesMatch positions = true) + (member : child ∈ parent.children) : + child.allocationCapabilitiesMatch positions = true := by + cases parent with + | ret _ _ _ _ _ _ _ | tailCall _ _ _ _ _ _ _ + | tailCallSelf _ _ _ _ _ _ => + simp [CodeTrace.children] at member + | letOp source block input nextInput entryValueCount operation index + instruction next => + simp [CodeTrace.children] at member + subst child + simp only [CodeTrace.allocationCapabilitiesMatch, + Bool.and_eq_true] at matched + exact matched.2 + | switchValue source block input entryValueCount sourceScrutinee peel + alternatives targetScrutinee generated outgoing children => + exact codeTraceListAllocationCapabilitiesMatch_of_mem positions matched + member + +/-- Every recursive descendant inherits the producer capability audit. -/ +theorem CodeTrace.Descendant.allocationCapabilitiesMatch + (positions : List PositionTrace) {root child : CodeTrace} + (descendant : Descendant root child) + (matched : root.allocationCapabilitiesMatch positions = true) : + child.allocationCapabilitiesMatch positions = true := by + induction descendant with + | refl => exact matched + | @step parent child parentDescendant childMem ih => + exact CodeTrace.allocationCapabilitiesMatch_of_child positions ih childMem + +/-- Whole-program producer capability audit. -/ +def Trace.allocationCapabilitiesMatch (trace : Trace) : Bool := + trace.functions.all fun functionTrace => + functionTrace.root.allocationCapabilitiesMatch trace.positions + +/-- Project the whole capability audit to one retained function. -/ +theorem Trace.functionAllocationCapabilitiesMatch {trace : Trace} + (matched : trace.allocationCapabilitiesMatch = true) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ trace.functions) : + functionTrace.root.allocationCapabilitiesMatch trace.positions = true := + List.all_eq_true.mp matched functionTrace member + +/-- Does this capability contribute an external ownership root? -/ +def BindingCap.hasOwnedRoot : BindingCap → Bool + | .owned _ => true + | .scalar | .borrowed .. | .dead => false + +/-- Is this capability a borrow whose provenance would have to cross a +suspended source call? -/ +def BindingCap.isBorrowed : BindingCap → Bool + | .borrowed .. => true + | .scalar | .owned _ | .dead => false + +def noOwnedRoots (capabilities : Array BindingCap) : Bool := + capabilities.toList.all fun capability => !capability.hasOwnedRoot + +def noBorrows (capabilities : Array BindingCap) : Bool := + capabilities.toList.all fun capability => !capability.isBorrowed + +/-! ### Borrow-free producer state at terminal allocations + +The reset/reuse pass only recognizes allocations whose recursive source +continuation is a self tail call. At that boundary every value which can +survive the allocation is about to cross the owned call ABI, so the producer +must have retired all outstanding borrows. Keep this as a focused recursive +audit: ordinary allocations may legitimately coexist with live borrows. -/ + +/-- Check every producer position for one terminal allocation coordinate. +Nonmatching flat positions are irrelevant to the recursive trace node. -/ +def terminalAllocationPositionsNoBorrows (positions : List PositionTrace) + (source : SourceSite) (block : BlockId) + (input : Array (Option Atom)) (index : Nat) : Bool := + positions.all fun position => + if position.coordinateMatches source block (.instruction index) input then + noBorrows position.sourceCapabilities + else + true + +mutual + +/-- Recursive producer audit for allocations immediately followed by a +self-tail terminal. This is precisely the allocation shape consumed by the +dynamic reset/reuse recognizer. -/ +def CodeTrace.terminalAllocationNoBorrows + (positions : List PositionTrace) : CodeTrace → Bool + | .ret .. | .tailCall .. | .tailCallSelf .. => true + | .letOp source block input _ _ operation index _ next => + (match operation, next with + | .alloc .., .tailCallSelf .. => + terminalAllocationPositionsNoBorrows positions source block input + index + | _, _ => true) && + next.terminalAllocationNoBorrows positions + | .switchValue _ _ _ _ _ _ _ _ _ _ children => + codeTraceListTerminalAllocationNoBorrows positions children + +private def codeTraceListTerminalAllocationNoBorrows + (positions : List PositionTrace) : List CodeTrace → Bool + | [] => true + | trace :: rest => + trace.terminalAllocationNoBorrows positions && + codeTraceListTerminalAllocationNoBorrows positions rest + +end + +/-- Reflect the focused audit at one named producer position. -/ +theorem CodeTrace.terminalAllocationPositionNoBorrows_of_match + (positions : List PositionTrace) + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {world : Owned} {identity : CtorId} {arguments : Array IxIR1.Atom} + {index : Nat} {instruction : Instr} + {tailSource : SourceSite} {tailBlock : BlockId} + {tailInput : Array (Option Atom)} {tailEntryValueCount : Nat} + {tailArguments : Array IxIR1.Atom} {generated : Block} + (matched : (CodeTrace.letOp source block input nextInput entryValueCount + (.alloc world identity arguments) index instruction + (.tailCallSelf tailSource tailBlock tailInput tailEntryValueCount + tailArguments generated)).terminalAllocationNoBorrows positions = + true) + {position : PositionTrace} (member : position ∈ positions) + (coordinate : position.coordinateMatches source block + (.instruction index) input = true) : + noBorrows position.sourceCapabilities = true := by + change (terminalAllocationPositionsNoBorrows positions source block input + index && _) = true at matched + simp only [Bool.and_eq_true] at matched + have point := List.all_eq_true.mp matched.1 position member + rw [if_pos coordinate] at point + exact point + +private theorem codeTraceListTerminalAllocationNoBorrows_of_mem + (positions : List PositionTrace) + {traces : List CodeTrace} {child : CodeTrace} + (matched : codeTraceListTerminalAllocationNoBorrows positions traces = true) + (member : child ∈ traces) : + child.terminalAllocationNoBorrows positions = true := by + induction traces with + | nil => simp at member + | cons head tail ih => + simp only [codeTraceListTerminalAllocationNoBorrows, + Bool.and_eq_true] at matched + simp only [List.mem_cons] at member + cases member with + | inl equal => simpa [equal] using matched.1 + | inr member => exact ih matched.2 member + +/-- The terminal-allocation audit is inherited by every immediate recursive +compiler call. -/ +theorem CodeTrace.terminalAllocationNoBorrows_of_child + (positions : List PositionTrace) {parent child : CodeTrace} + (matched : parent.terminalAllocationNoBorrows positions = true) + (member : child ∈ parent.children) : + child.terminalAllocationNoBorrows positions = true := by + cases parent with + | ret _ _ _ _ _ _ _ | tailCall _ _ _ _ _ _ _ + | tailCallSelf _ _ _ _ _ _ => + simp [CodeTrace.children] at member + | letOp source block input nextInput entryValueCount operation index + instruction next => + simp [CodeTrace.children] at member + subst child + simp only [CodeTrace.terminalAllocationNoBorrows, + Bool.and_eq_true] at matched + exact matched.2 + | switchValue source block input entryValueCount sourceScrutinee peel + alternatives targetScrutinee generated outgoing children => + exact codeTraceListTerminalAllocationNoBorrows_of_mem positions matched + member + +/-- Every recursive descendant inherits the focused terminal-allocation +borrow audit. -/ +theorem CodeTrace.Descendant.terminalAllocationNoBorrows + (positions : List PositionTrace) {root child : CodeTrace} + (descendant : Descendant root child) + (matched : root.terminalAllocationNoBorrows positions = true) : + child.terminalAllocationNoBorrows positions = true := by + induction descendant with + | refl => exact matched + | @step parent child parentDescendant childMem ih => + exact CodeTrace.terminalAllocationNoBorrows_of_child positions ih + childMem + +/-- Whole-program audit for borrow-free terminal allocation coordinates. -/ +def Trace.terminalAllocationNoBorrows (trace : Trace) : Bool := + trace.functions.all fun functionTrace => + functionTrace.root.terminalAllocationNoBorrows trace.positions + +/-- Project the whole-program audit to one retained function. -/ +theorem Trace.functionTerminalAllocationNoBorrows {trace : Trace} + (matched : trace.terminalAllocationNoBorrows = true) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ trace.functions) : + functionTrace.root.terminalAllocationNoBorrows trace.positions = true := + List.all_eq_true.mp matched functionTrace member + +/-! ### Exact producer capability flow for dynamic application -/ + +/-- Exact continuation capability vector after dynamic application. The +function value and every newly supplied argument cross the shared owned +boundary in source order; the dynamically returned value is then bound as a +fresh shared owner. -/ +def applyCapabilities? (capabilities : Array BindingCap) + (input : Array (Option Atom)) (function : IxIR1.Atom) + (arguments : Array IxIR1.Atom) : Option (Array BindingCap) := do + let remaining ← consumeCapability? capabilities input .shared function + let remaining ← consumeCapabilitiesList? remaining input .shared + arguments.toList + return #[.owned .shared] ++ remaining + +/-- One retained dynamic-application before/after pair has the exact +consume-function/consume-arguments/bind-result effect. -/ +def PositionTrace.applyResultMatches (before after : PositionTrace) + (input : Array (Option Atom)) (function : IxIR1.Atom) + (arguments : Array IxIR1.Atom) : Bool := + match applyCapabilities? before.sourceCapabilities input function arguments with + | some expected => + noBorrows expected && expected == after.sourceCapabilities + | none => false + +/-- Every continuation position of one dynamic application has an exact +capability predecessor. -/ +def CodeTrace.applyTransitionMatches (positions : List PositionTrace) + (current next : CodeTrace) (function : IxIR1.Atom) + (arguments : Array IxIR1.Atom) : Bool := + positions.all fun after => + if after.coordinateMatches next.source next.sourceBlock + next.targetPosition next.sourceInputMap then + positions.any fun before => + before.coordinateMatches current.source current.sourceBlock + current.targetPosition current.sourceInputMap && + before.applyResultMatches after current.sourceInputMap function + arguments + else + true + +mutual + +/-- Recursive exact capability audit for dynamic application. -/ +def CodeTrace.applyCapabilitiesMatch + (positions : List PositionTrace) : CodeTrace → Bool + | .ret .. | .tailCall .. | .tailCallSelf .. => true + | trace@(.letOp _ _ _ _ _ operation _ _ next) => + (match operation with + | .apply function arguments => + trace.applyTransitionMatches positions next function arguments + | _ => true) && + next.applyCapabilitiesMatch positions + | .switchValue _ _ _ _ _ _ _ _ _ _ children => + codeTraceListApplyCapabilitiesMatch positions children + +private def codeTraceListApplyCapabilitiesMatch + (positions : List PositionTrace) : List CodeTrace → Bool + | [] => true + | trace :: rest => + trace.applyCapabilitiesMatch positions && + codeTraceListApplyCapabilitiesMatch positions rest + +end + +/-- Reflect the exact producer capability predecessor of any matching +continuation position at an audited dynamic application. -/ +theorem CodeTrace.applyTransition_of_capabilities_match + (positions : List PositionTrace) + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {function : IxIR1.Atom} {arguments : Array IxIR1.Atom} {index : Nat} + {instruction : Instr} {next : CodeTrace} {after : PositionTrace} + (matched : (CodeTrace.letOp source block input nextInput entryValueCount + (.apply function arguments) index instruction next + ).applyCapabilitiesMatch positions = true) + (afterMember : after ∈ positions) + (afterCoordinate : after.coordinateMatches next.source next.sourceBlock + next.targetPosition next.sourceInputMap = true) : + ∃ before, before ∈ positions ∧ + before.coordinateMatches source block (.instruction index) input = true ∧ + before.applyResultMatches after input function arguments = true := by + change (((CodeTrace.letOp source block input nextInput entryValueCount + (.apply function arguments) index instruction next + ).applyTransitionMatches positions next function arguments && + next.applyCapabilitiesMatch positions) = true) at matched + simp only [Bool.and_eq_true] at matched + have point := List.all_eq_true.mp matched.1 after afterMember + rw [if_pos afterCoordinate] at point + obtain ⟨before, beforeMember, beforeMatch⟩ := List.any_eq_true.mp point + simp only [Bool.and_eq_true] at beforeMatch + exact ⟨before, beforeMember, by + simpa [CodeTrace.source, CodeTrace.sourceBlock, CodeTrace.targetPosition, + CodeTrace.sourceInputMap] using beforeMatch.1, beforeMatch.2⟩ + +private theorem codeTraceListApplyCapabilitiesMatch_of_mem + (positions : List PositionTrace) + {traces : List CodeTrace} {child : CodeTrace} + (matched : codeTraceListApplyCapabilitiesMatch positions traces = true) + (member : child ∈ traces) : + child.applyCapabilitiesMatch positions = true := by + induction traces with + | nil => simp at member + | cons head tail ih => + simp only [codeTraceListApplyCapabilitiesMatch, + Bool.and_eq_true] at matched + simp only [List.mem_cons] at member + cases member with + | inl equal => simpa [equal] using matched.1 + | inr member => exact ih matched.2 member + +/-- Dynamic-application capability coherence is inherited by every immediate +recursive compiler call. -/ +theorem CodeTrace.applyCapabilitiesMatch_of_child + (positions : List PositionTrace) {parent child : CodeTrace} + (matched : parent.applyCapabilitiesMatch positions = true) + (member : child ∈ parent.children) : + child.applyCapabilitiesMatch positions = true := by + cases parent with + | ret _ _ _ _ _ _ _ | tailCall _ _ _ _ _ _ _ + | tailCallSelf _ _ _ _ _ _ => + simp [CodeTrace.children] at member + | letOp source block input nextInput entryValueCount operation index + instruction next => + simp [CodeTrace.children] at member + subst child + simp only [CodeTrace.applyCapabilitiesMatch, + Bool.and_eq_true] at matched + exact matched.2 + | switchValue source block input entryValueCount sourceScrutinee peel + alternatives targetScrutinee generated outgoing children => + exact codeTraceListApplyCapabilitiesMatch_of_mem positions matched member + +/-- Every recursive descendant inherits checked dynamic-application +capability coherence. -/ +theorem CodeTrace.Descendant.applyCapabilitiesMatch + (positions : List PositionTrace) {root child : CodeTrace} + (descendant : Descendant root child) + (matched : root.applyCapabilitiesMatch positions = true) : + child.applyCapabilitiesMatch positions = true := by + induction descendant with + | refl => exact matched + | @step parent child parentDescendant childMem ih => + exact CodeTrace.applyCapabilitiesMatch_of_child positions ih childMem + +/-- Whole-program dynamic-application capability-flow audit. -/ +def Trace.applyCapabilitiesMatch (trace : Trace) : Bool := + trace.functions.all fun functionTrace => + functionTrace.root.applyCapabilitiesMatch trace.positions + +/-- Project the whole dynamic-application audit to one retained function. -/ +theorem Trace.functionApplyCapabilitiesMatch {trace : Trace} + (matched : trace.applyCapabilitiesMatch = true) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ trace.functions) : + functionTrace.root.applyCapabilitiesMatch trace.positions = true := + List.all_eq_true.mp matched functionTrace member + +/-! ### Exact producer capability flow for calls and returns -/ + +/-- The baseline call ABI accepts only owned parameters. Keeping this +projection executable makes a future borrowed-parameter ABI an explicit +extension rather than silently treating a borrow as a transfer. -/ +def ownedParameterWorlds? : List Param → Option (List Owned) + | [] => some [] + | parameter :: rest => + if parameter.passing == .owned then + (ownedParameterWorlds? rest).map (parameter.world :: ·) + else + none + +/-- Capability vector visible in source de Bruijn order at a target function +entry. Target parameters arrive in call order, hence the reversal. -/ +def entryCapabilities (signature : Signature) : Array BindingCap := + signature.params.toList.reverse.map (fun parameter => + match parameter.passing with + | .owned => .owned parameter.world + | .borrowed => .borrowed parameter.world .caller) |>.toArray + +/-! ### PAP-safe function-entry capabilities -/ + +/-- A PAP-safe retained function must expose the all-owned/shared entry +capability vector required by dynamic saturation. Keeping this check in the +artifact audit makes the runtime PAP boundary independent of validator +implementation details. -/ +def FunctionTrace.sharedPapEntryCapabilitiesMatch + (trace : FunctionTrace) : Bool := + if trace.generated.signature.papSafe then + entryCapabilities trace.generated.signature == + Array.replicate trace.generated.signature.params.size (.owned .shared) + else + true + +/-- Whole-program PAP-entry capability audit. -/ +def Trace.sharedPapEntryCapabilitiesMatch (trace : Trace) : Bool := + trace.functions.all FunctionTrace.sharedPapEntryCapabilitiesMatch + +/-- Project the PAP-entry audit to one retained function. -/ +theorem Trace.functionSharedPapEntryCapabilitiesMatch {trace : Trace} + (matched : trace.sharedPapEntryCapabilitiesMatch = true) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ trace.functions) : + functionTrace.sharedPapEntryCapabilitiesMatch = true := + List.all_eq_true.mp matched functionTrace member + +/-- Consume the arguments of one baseline call using its owned parameter +telescope. -/ +def callRemainingCapabilities? (capabilities : Array BindingCap) + (input : Array (Option Atom)) (signature : Signature) + (arguments : Array IxIR1.Atom) : Option (Array BindingCap) := do + let worlds ← ownedParameterWorlds? signature.params.toList + consumeCapabilitiesWorlds? capabilities input worlds arguments.toList + +/-- Exact ordinary-call continuation state: transferred argument owners are +retired, no borrow remains suspended in the baseline ABI, and the returned +owner is bound at the source-environment head. -/ +def PositionTrace.callResultMatches (before after : PositionTrace) + (input : Array (Option Atom)) (signature : Signature) + (arguments : Array IxIR1.Atom) : Bool := + match callRemainingCapabilities? before.sourceCapabilities input signature + arguments with + | some remaining => + noBorrows remaining && + (#[.owned signature.result] ++ remaining) == after.sourceCapabilities + | none => false + +/-- Every matching predecessor/continuation pair of an ordinary call has the +same exact consume/suspend/result-bind transition. Quantifying both sides +prevents duplicate flat coordinates from choosing different suspended root +frames. -/ +def CodeTrace.callTransitionMatches (positions : List PositionTrace) + (current next : CodeTrace) (signature : Signature) + (arguments : Array IxIR1.Atom) : Bool := + positions.all fun after => + if after.coordinateMatches next.source next.sourceBlock + next.targetPosition next.sourceInputMap then + positions.all fun before => + if before.coordinateMatches current.source current.sourceBlock + current.targetPosition current.sourceInputMap then + before.callResultMatches after current.sourceInputMap signature + arguments + else + true + else + true + +/-- A tail call transfers every local owner before discarding its frame. -/ +def PositionTrace.tailCallMatches (position : PositionTrace) + (source : SourceSite) (block : BlockId) + (input : Array (Option Atom)) (signature : Signature) + (arguments : Array IxIR1.Atom) : Bool := + position.coordinateMatches source block .terminator input && + match callRemainingCapabilities? position.sourceCapabilities input + signature arguments with + | some remaining => noOwnedRoots remaining + | none => false + +/-- A source return transfers exactly its declared result owner and leaves no +other local owner behind. Scalars remain ownership-inert. -/ +def PositionTrace.returnMatches (position : PositionTrace) + (source : SourceSite) (block : BlockId) + (input : Array (Option Atom)) (result : Owned) + (atom : IxIR1.Atom) : Bool := + position.coordinateMatches source block .terminator input && + match consumeCapability? position.sourceCapabilities input result atom with + | some remaining => noOwnedRoots remaining + | none => false + +/-- Lookup the checked target signature used to audit an addressed source +call. -/ +def targetSignature? (declarations : List (Address × Decl)) + (address : Address) : Option Signature := do + let declaration ← + (declarations.find? fun entry => entry.1 == address).map (fun entry => entry.2) + match declaration with + | .fn definition => some definition.signature + | .extern _ => none + +/-- All flat positions matching one function root carry the canonical entry +capability vector of its emitted signature. -/ +def FunctionTrace.entryCapabilitiesMatch (trace : FunctionTrace) + (positions : List PositionTrace) : Bool := + positions.all fun position => + if position.coordinateMatches trace.root.source trace.root.sourceBlock + trace.root.targetPosition trace.root.sourceInputMap then + position.sourceCapabilities == entryCapabilities trace.generated.signature + else + true + +mutual + +/-- Recursive call/return capability audit for one retained function. -/ +def CodeTrace.callCapabilitiesMatch (positions : List PositionTrace) + (declarations : List (Address × Decl)) (current : Signature) : + CodeTrace → Bool + | trace@(.ret source block input _ atom _ _) => + positions.all fun position => + if position.coordinateMatches trace.source trace.sourceBlock + trace.targetPosition trace.sourceInputMap then + position.returnMatches source block input current.result atom + else + true + | .tailCall source block input _ address arguments _ => + match targetSignature? declarations address with + | some signature => signature.result == current.result && + positions.any fun position => + position.tailCallMatches source block input signature arguments + | none => false + | .tailCallSelf source block input _ arguments _ => + positions.any fun position => + position.tailCallMatches source block input current arguments + | trace@(.letOp _ _ _ _ _ operation _ _ next) => + (match operation with + | .call address arguments => + match targetSignature? declarations address with + | some signature => + trace.callTransitionMatches positions next signature arguments + | none => false + | .callSelf arguments => + trace.callTransitionMatches positions next current arguments + | _ => true) && + next.callCapabilitiesMatch positions declarations current + | .switchValue _ _ _ _ _ _ _ _ _ _ children => + codeTraceListCallCapabilitiesMatch positions declarations current children + +private def codeTraceListCallCapabilitiesMatch + (positions : List PositionTrace) + (declarations : List (Address × Decl)) (current : Signature) : + List CodeTrace → Bool + | [] => true + | trace :: rest => + trace.callCapabilitiesMatch positions declarations current && + codeTraceListCallCapabilitiesMatch positions declarations current rest + +end + +/-- One retained function has canonical entry capabilities and exact +call/return ownership flow throughout its recursive trace. -/ +def FunctionTrace.callCapabilitiesMatch (trace : FunctionTrace) + (positions : List PositionTrace) + (declarations : List (Address × Decl)) : Bool := + trace.entryCapabilitiesMatch positions && + trace.root.callCapabilitiesMatch positions declarations + trace.generated.signature + +/-- Whole-program call/return capability-flow audit. -/ +def FunctionTrace.targetSignatureMatches (trace : FunctionTrace) + (declarations : List (Address × Decl)) : Bool := + match trace.owner with + | .main => true + | .declaration address => + targetSignature? declarations address == some trace.generated.signature + +/-- Whole-program call/return capability-flow audit. Besides local flow, each +declaration-owned trace is tied to the signature selected by the executable +target declaration lookup used at call sites. -/ +def Trace.callCapabilitiesMatch (trace : Trace) + (declarations : List (Address × Decl)) : Bool := + (trace.functions.all fun functionTrace => + functionTrace.callCapabilitiesMatch trace.positions declarations) && + (trace.functions.all fun functionTrace => + functionTrace.targetSignatureMatches declarations) + +private theorem codeTraceListCallCapabilitiesMatch_of_mem + (positions : List PositionTrace) + (declarations : List (Address × Decl)) (current : Signature) + {traces : List CodeTrace} {child : CodeTrace} + (matched : codeTraceListCallCapabilitiesMatch positions declarations + current traces = true) + (member : child ∈ traces) : + child.callCapabilitiesMatch positions declarations current = true := by + induction traces with + | nil => simp at member + | cons head tail ih => + simp only [codeTraceListCallCapabilitiesMatch, + Bool.and_eq_true] at matched + simp only [List.mem_cons] at member + cases member with + | inl equal => simpa [equal] using matched.1 + | inr member => exact ih matched.2 member + +/-- Call/return capability coherence is inherited by every recursive child. -/ +theorem CodeTrace.callCapabilitiesMatch_of_child + (positions : List PositionTrace) + (declarations : List (Address × Decl)) (current : Signature) + {parent child : CodeTrace} + (matched : parent.callCapabilitiesMatch positions declarations current = + true) + (member : child ∈ parent.children) : + child.callCapabilitiesMatch positions declarations current = true := by + cases parent with + | ret _ _ _ _ _ _ _ | tailCall _ _ _ _ _ _ _ + | tailCallSelf _ _ _ _ _ _ => + simp [CodeTrace.children] at member + | letOp source block input nextInput entryValueCount operation index + instruction next => + simp [CodeTrace.children] at member + subst child + simp only [CodeTrace.callCapabilitiesMatch, + Bool.and_eq_true] at matched + exact matched.2 + | switchValue source block input entryValueCount sourceScrutinee peel + alternatives targetScrutinee generated outgoing children => + exact codeTraceListCallCapabilitiesMatch_of_mem positions declarations + current matched member + +/-- Every recursive descendant inherits checked call/return capability flow. -/ +theorem CodeTrace.Descendant.callCapabilitiesMatch + (positions : List PositionTrace) + (declarations : List (Address × Decl)) (current : Signature) + {root child : CodeTrace} (descendant : Descendant root child) + (matched : root.callCapabilitiesMatch positions declarations current = + true) : + child.callCapabilitiesMatch positions declarations current = true := by + induction descendant with + | refl => exact matched + | @step parent child parentDescendant childMem ih => + exact CodeTrace.callCapabilitiesMatch_of_child positions declarations + current ih childMem + +/-- Project the whole-program call audit to one retained function. -/ +theorem Trace.functionCallCapabilitiesMatch {trace : Trace} + {declarations : List (Address × Decl)} + (matched : trace.callCapabilitiesMatch declarations = true) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ trace.functions) : + functionTrace.callCapabilitiesMatch trace.positions declarations = true := + by + simp only [Trace.callCapabilitiesMatch, Bool.and_eq_true] at matched + exact List.all_eq_true.mp matched.1 functionTrace member + +/-- A declaration-owned retained trace has the exact signature selected by +the call audit's target lookup. -/ +theorem Trace.targetSignature_of_call_match {trace : Trace} + {declarations : List (Address × Decl)} + (matched : trace.callCapabilitiesMatch declarations = true) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ trace.functions) + {address : Address} (owner : functionTrace.owner = .declaration address) : + targetSignature? declarations address = + some functionTrace.generated.signature := by + simp only [Trace.callCapabilitiesMatch, Bool.and_eq_true] at matched + have point := List.all_eq_true.mp matched.2 functionTrace member + unfold FunctionTrace.targetSignatureMatches at point + rw [owner] at point + exact beq_iff_eq.mp point + +/-- Recover canonical entry capabilities from a checked function audit. -/ +theorem FunctionTrace.entryCapabilities_of_call_match + {trace : FunctionTrace} {positions : List PositionTrace} + {declarations : List (Address × Decl)} + (matched : trace.callCapabilitiesMatch positions declarations = true) + {position : PositionTrace} (member : position ∈ positions) + (coordinate : position.coordinateMatches trace.root.source + trace.root.sourceBlock trace.root.targetPosition + trace.root.sourceInputMap = true) : + position.sourceCapabilities = entryCapabilities trace.generated.signature := by + simp only [FunctionTrace.callCapabilitiesMatch, Bool.and_eq_true] at matched + have point := List.all_eq_true.mp matched.1 position member + rw [if_pos coordinate] at point + exact beq_iff_eq.mp point + +/-- Reflect an addressed ordinary call's exact predecessor and continuation +effect. -/ +theorem CodeTrace.callTransition_of_capabilities_match + (positions : List PositionTrace) + (declarations : List (Address × Decl)) (current : Signature) + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {address : Address} {signature : Signature} + {arguments : Array IxIR1.Atom} {index : Nat} {instruction : Instr} + {next : CodeTrace} {before after : PositionTrace} + (signatureAt : targetSignature? declarations address = some signature) + (matched : (CodeTrace.letOp source block input nextInput entryValueCount + (.call address arguments) index instruction next).callCapabilitiesMatch positions + declarations current = true) + (beforeMember : before ∈ positions) + (beforeCoordinate : before.coordinateMatches source block + (.instruction index) input = true) + (afterMember : after ∈ positions) + (afterCoordinate : after.coordinateMatches next.source next.sourceBlock + next.targetPosition next.sourceInputMap = true) : + before.callResultMatches after input signature arguments = true := by + simp only [CodeTrace.callCapabilitiesMatch, signatureAt, + Bool.and_eq_true] at matched + have transition := matched.1 + have point := List.all_eq_true.mp transition after afterMember + rw [if_pos afterCoordinate] at point + have beforePoint := List.all_eq_true.mp point before beforeMember + rw [if_pos (by + simpa [CodeTrace.source, CodeTrace.sourceBlock, CodeTrace.targetPosition, + CodeTrace.sourceInputMap] using beforeCoordinate)] at beforePoint + exact beforePoint + +/-- Reflect a self call's exact predecessor and continuation effect. -/ +theorem CodeTrace.callSelfTransition_of_capabilities_match + (positions : List PositionTrace) + (declarations : List (Address × Decl)) (current : Signature) + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {arguments : Array IxIR1.Atom} {index : Nat} {instruction : Instr} + {next : CodeTrace} {before after : PositionTrace} + (matched : (CodeTrace.letOp source block input nextInput entryValueCount + (.callSelf arguments) index instruction next).callCapabilitiesMatch + positions declarations current = true) + (beforeMember : before ∈ positions) + (beforeCoordinate : before.coordinateMatches source block + (.instruction index) input = true) + (afterMember : after ∈ positions) + (afterCoordinate : after.coordinateMatches next.source next.sourceBlock + next.targetPosition next.sourceInputMap = true) : + before.callResultMatches after input current arguments = true := by + simp only [CodeTrace.callCapabilitiesMatch, Bool.and_eq_true] at matched + have point := List.all_eq_true.mp matched.1 after afterMember + rw [if_pos afterCoordinate] at point + have beforePoint := List.all_eq_true.mp point before beforeMember + rw [if_pos (by + simpa [CodeTrace.source, CodeTrace.sourceBlock, CodeTrace.targetPosition, + CodeTrace.sourceInputMap] using beforeCoordinate)] at beforePoint + exact beforePoint + +/-- Reflect the exact terminal transfer at a checked addressed tail call. -/ +theorem CodeTrace.tailCallPosition_of_capabilities_match + (positions : List PositionTrace) + (declarations : List (Address × Decl)) (current : Signature) + {source : SourceSite} {block : BlockId} + {input : Array (Option Atom)} {entryValueCount : Nat} + {address : Address} {signature : Signature} + {arguments : Array IxIR1.Atom} {generated : Block} + (signatureAt : targetSignature? declarations address = some signature) + (matched : (CodeTrace.tailCall source block input entryValueCount address + arguments generated).callCapabilitiesMatch positions declarations current = + true) : + ∃ position, position ∈ positions ∧ + position.tailCallMatches source block input signature arguments = true := by + change (match targetSignature? declarations address with + | some found => found.result == current.result && + positions.any fun position => + position.tailCallMatches source block input found arguments + | none => false) = true at matched + rw [signatureAt] at matched + simp only [Bool.and_eq_true] at matched + exact List.any_eq_true.mp matched.2 + +/-- A checked addressed tail call preserves the dynamic result world. This +is needed when source completion crosses a replaced caller frame. -/ +theorem CodeTrace.tailCallResult_of_capabilities_match + (positions : List PositionTrace) + (declarations : List (Address × Decl)) (current : Signature) + {source : SourceSite} {block : BlockId} + {input : Array (Option Atom)} {entryValueCount : Nat} + {address : Address} {signature : Signature} + {arguments : Array IxIR1.Atom} {generated : Block} + (signatureAt : targetSignature? declarations address = some signature) + (matched : (CodeTrace.tailCall source block input entryValueCount address + arguments generated).callCapabilitiesMatch positions declarations current = + true) : + signature.result = current.result := by + simp only [CodeTrace.callCapabilitiesMatch, signatureAt, + Bool.and_eq_true, beq_iff_eq] at matched + exact matched.1 + +/-- Reflect the exact terminal transfer at a checked self tail call. -/ +theorem CodeTrace.tailCallSelfPosition_of_capabilities_match + (positions : List PositionTrace) + (declarations : List (Address × Decl)) (current : Signature) + {source : SourceSite} {block : BlockId} + {input : Array (Option Atom)} {entryValueCount : Nat} + {arguments : Array IxIR1.Atom} {generated : Block} + (matched : (CodeTrace.tailCallSelf source block input entryValueCount + arguments generated).callCapabilitiesMatch positions declarations current = + true) : + ∃ position, position ∈ positions ∧ + position.tailCallMatches source block input current arguments = true := by + exact List.any_eq_true.mp matched + +/-- Reflect the exact return transfer at one checked terminal position. -/ +theorem CodeTrace.returnPositionMatch_of_capabilities_match + (positions : List PositionTrace) + (declarations : List (Address × Decl)) (current : Signature) + {source : SourceSite} {block : BlockId} + {input : Array (Option Atom)} {entryValueCount : Nat} + {atom : IxIR1.Atom} {target : Atom} {generated : Block} + (matched : (CodeTrace.ret source block input entryValueCount atom target + generated).callCapabilitiesMatch positions declarations current = true) + {position : PositionTrace} (member : position ∈ positions) + (coordinate : position.coordinateMatches source block .terminator input = + true) : + position.returnMatches source block input current.result atom = true := by + change (positions.all fun candidate => + if candidate.coordinateMatches source block .terminator input then + candidate.returnMatches source block input current.result atom + else true) = true at matched + have point := List.all_eq_true.mp matched position member + rw [if_pos coordinate] at point + exact point + +/-! ### Producer capability flow across switch edges -/ + +/-- The first source slot whose live owner is carried by a given predecessor +register. This is the source-index form of the lowerer's private +`ownerParameter?` search. -/ +def edgeOwnerIndex? (capabilities : Array BindingCap) + (input : Array (Option Atom)) (lender : ValueId) : Option Nat := + (List.range capabilities.size).find? fun index => + match capabilities[index]?, input[index]? with + | some (.owned _), some (some (.reg actual)) => actual == lender + | _, _ => false + +/-- Rebase one producer capability onto the canonical same-index registers of +a generated CFG edge. Local borrows are accepted only when the lowerer's +selected owner has the same world as the borrow. -/ +def BindingCap.rebaseEdge? (capabilities : Array BindingCap) + (input : Array (Option Atom)) : BindingCap → Option BindingCap + | .scalar => some .scalar + | .owned world => some (.owned world) + | .borrowed world .caller => some (.borrowed world .caller) + | .borrowed world (.value lender) => + match edgeOwnerIndex? capabilities input lender with + | some ownerIndex => + match capabilities[ownerIndex]? with + | some (.owned ownerWorld) => + if ownerWorld == world then + some (.borrowed world (.value ownerIndex)) + else + none + | _ => none + | none => none + | .dead => some .dead + +/-- Canonical capability vector after a generated edge has copied every live +source slot into the same-index target parameter. -/ +def edgeCapabilities? (capabilities : Array BindingCap) + (input : Array (Option Atom)) : Option (Array BindingCap) := + if capabilities.toList.all fun capability => + (capability.rebaseEdge? capabilities input).isSome then + some (capabilities.map fun capability => + (capability.rebaseEdge? capabilities input).getD .dead) + else + none + +/-- Edge rebasing preserves the producer capability-vector cardinality. -/ +theorem edgeCapabilities?_size + {capabilities output : Array BindingCap} + {input : Array (Option Atom)} + (result : edgeCapabilities? capabilities input = some output) : + output.size = capabilities.size := by + unfold edgeCapabilities? at result + split at result + · injection result with outputEq + subst output + simp + · contradiction + +/-- Shift local lender registers across an implicit block-parameter prefix. -/ +def BindingCap.shiftLender (amount : Nat) : BindingCap → BindingCap + | .borrowed world (.value lender) => + .borrowed world (.value (lender + amount)) + | capability => capability + +/-- Exact capability vector at a constructor child: the edge-rebased source +slots are preceded by borrowed fields in reverse source-binding order. -/ +def constructorChildCapabilities? + (schemas : Owned → CtorId → Option CtorSchema) + (input : Array (Option Atom)) (scrutinee : IxIR1.Atom) (cid : CtorId) + (capabilities : Array BindingCap) : Option (Array BindingCap) := + match edgeCapabilities? capabilities input with + | none => none + | some rebased => + match scrutinee with + | .var sourceIndex => + match rebased[sourceIndex]? with + | some (.owned world) => + match schemas world cid with + | some schema => + let fields := schema.fields.map fun fieldWorld => + BindingCap.borrowed fieldWorld (.value sourceIndex) + some (fields.reverse ++ rebased) + | none => none + | some (.borrowed world lender) => + match schemas world cid with + | some schema => + let fields := schema.fields.map fun fieldWorld => + BindingCap.borrowed fieldWorld lender + some (fields.reverse ++ rebased) + | none => none + | _ => none + | .lit _ | .erased => none + +/-- Exact capability vector at a literal-zero child. -/ +def natZeroChildCapabilities? (input : Array (Option Atom)) + (capabilities : Array BindingCap) : Option (Array BindingCap) := + edgeCapabilities? capabilities input + +/-- Exact capability vector at a literal-successor child. The peeled scalar +occupies register zero, so every local lender is shifted once. -/ +def natSuccChildCapabilities? (input : Array (Option Atom)) + (capabilities : Array BindingCap) : Option (Array BindingCap) := + match edgeCapabilities? capabilities input with + | some rebased => + some (#[.scalar] ++ rebased.map (BindingCap.shiftLender 1)) + | none => none + +/-- Every matching child position has a producer predecessor whose capability +vector evolves by `expected`. The whole-position audit separately guarantees +that both coordinate sets are inhabited. -/ +def CodeTrace.branchTransitionMatches (positions : List PositionTrace) + (current child : CodeTrace) + (expected : Array BindingCap → Option (Array BindingCap)) : Bool := + positions.all fun after => + if after.coordinateMatches child.source child.sourceBlock + child.targetPosition child.sourceInputMap then + positions.any fun before => + before.coordinateMatches current.source current.sourceBlock + current.targetPosition current.sourceInputMap && + (expected before.sourceCapabilities == + some after.sourceCapabilities) + else + true + +/-- Local switch ownership-flow audit. Constructor children use their selected +schema; optional Nat children occupy the two canonical post-constructor +ordinals. Structural branch coherence independently certifies those ordinals. -/ +def CodeTrace.switchNodeCapabilitiesMatch + (schemas : Owned → CtorId → Option CtorSchema) + (positions : List PositionTrace) : CodeTrace → Bool + | trace@(.switchValue _ _ input _ sourceScrutinee peelNat _ _ generated _ + children) => + match generated.terminator with + | .switchValue _ constructors natPeel => + (constructors.toList.zipIdx.all fun pair => + match children[pair.2]? with + | some child => + trace.branchTransitionMatches positions child fun before => + constructorChildCapabilities? schemas input sourceScrutinee + pair.1.cid before + | none => false) && + match peelNat, natPeel with + | false, none => true + | true, some _ => + match children[constructors.size]?, + children[constructors.size + 1]? with + | some zeroChild, some succChild => + trace.branchTransitionMatches positions zeroChild + (natZeroChildCapabilities? input) && + trace.branchTransitionMatches positions succChild + (natSuccChildCapabilities? input) + | _, _ => false + | _, _ => false + | _ => false + | _ => true + +mutual + +/-- Recursive audit of every switch capability transition in a code tree. -/ +def CodeTrace.switchCapabilitiesMatch + (schemas : Owned → CtorId → Option CtorSchema) + (positions : List PositionTrace) : CodeTrace → Bool + | .ret .. | .tailCall .. | .tailCallSelf .. => true + | .letOp _ _ _ _ _ _ _ _ next => + next.switchCapabilitiesMatch schemas positions + | trace@(.switchValue _ _ _ _ _ _ _ _ _ _ children) => + trace.switchNodeCapabilitiesMatch schemas positions && + codeTraceListSwitchCapabilitiesMatch schemas positions children + +private def codeTraceListSwitchCapabilitiesMatch + (schemas : Owned → CtorId → Option CtorSchema) + (positions : List PositionTrace) : List CodeTrace → Bool + | [] => true + | trace :: rest => + trace.switchCapabilitiesMatch schemas positions && + codeTraceListSwitchCapabilitiesMatch schemas positions rest + +end + +/-- Whole-program switch capability-flow audit. -/ +def Trace.switchCapabilitiesMatch (trace : Trace) + (schemas : Owned → CtorId → Option CtorSchema) : Bool := + trace.functions.all fun functionTrace => + functionTrace.root.switchCapabilitiesMatch schemas trace.positions + +/-- Reflect the producer predecessor of one matching switch-child position. -/ +theorem CodeTrace.branchTransition_of_match + (positions : List PositionTrace) {current child : CodeTrace} + {expected : Array BindingCap → Option (Array BindingCap)} + {after : PositionTrace} + (matched : current.branchTransitionMatches positions child expected = true) + (afterMember : after ∈ positions) + (afterCoordinate : after.coordinateMatches child.source child.sourceBlock + child.targetPosition child.sourceInputMap = true) : + ∃ before, before ∈ positions ∧ + before.coordinateMatches current.source current.sourceBlock + current.targetPosition current.sourceInputMap = true ∧ + expected before.sourceCapabilities = some after.sourceCapabilities := by + have point := List.all_eq_true.mp matched after afterMember + rw [if_pos afterCoordinate] at point + obtain ⟨before, beforeMember, beforeMatch⟩ := List.any_eq_true.mp point + simp only [Bool.and_eq_true] at beforeMatch + exact ⟨before, beforeMember, beforeMatch.1, + beq_iff_eq.mp beforeMatch.2⟩ + +/-- Select the checked constructor capability transition at one exact +parallel branch ordinal. -/ +theorem CodeTrace.constructorBranchTransition_of_switch_match + (schemas : Owned → CtorId → Option CtorSchema) + (positions : List PositionTrace) + {source : SourceSite} {block : BlockId} + {input : Array (Option Atom)} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {targetScrutinee : Atom} + {generated : Block} {outgoing : List EdgeTrace} + {children : List CodeTrace} {constructors : Array CtorAlt} + {natPeel : Option NatPeel} {index : Nat} {target : CtorAlt} + {child : CodeTrace} {after : PositionTrace} + (matched : (CodeTrace.switchValue source block input entryValueCount + sourceScrutinee peelNat alternatives targetScrutinee generated outgoing + children).switchNodeCapabilitiesMatch schemas positions = true) + (terminator : generated.terminator = + .switchValue targetScrutinee constructors natPeel) + (targetAt : constructors[index]? = some target) + (childAt : children[index]? = some child) + (afterMember : after ∈ positions) + (afterCoordinate : after.coordinateMatches child.source child.sourceBlock + child.targetPosition child.sourceInputMap = true) : + ∃ before, before ∈ positions ∧ + before.coordinateMatches source block .terminator input = true ∧ + constructorChildCapabilities? schemas input sourceScrutinee target.cid + before.sourceCapabilities = some after.sourceCapabilities := by + have matched' := matched + simp only [CodeTrace.switchNodeCapabilitiesMatch, terminator, + Bool.and_eq_true] at matched' + have targetListAt : constructors.toList[index]? = some target := by + simpa using targetAt + have targetMember : (target, index) ∈ constructors.toList.zipIdx := + List.mk_mem_zipIdx_iff_getElem?.mpr targetListAt + have point := List.all_eq_true.mp matched'.1 (target, index) targetMember + simp only [childAt] at point + have transition := CodeTrace.branchTransition_of_match positions point + afterMember afterCoordinate + simpa [CodeTrace.source, CodeTrace.sourceBlock, CodeTrace.targetPosition, + CodeTrace.sourceInputMap] using transition + +/-- Select the checked literal-zero capability transition at its canonical +post-constructor ordinal. -/ +theorem CodeTrace.natZeroBranchTransition_of_switch_match + (schemas : Owned → CtorId → Option CtorSchema) + (positions : List PositionTrace) + {source : SourceSite} {block : BlockId} + {input : Array (Option Atom)} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {alternatives : Array IxIR1.Alt} + {targetScrutinee : Atom} {generated : Block} + {outgoing : List EdgeTrace} {children : List CodeTrace} + {constructors : Array CtorAlt} {peel : NatPeel} + {zeroChild succChild : CodeTrace} {after : PositionTrace} + (matched : (CodeTrace.switchValue source block input entryValueCount + sourceScrutinee true alternatives targetScrutinee generated outgoing + children).switchNodeCapabilitiesMatch schemas positions = true) + (terminator : generated.terminator = + .switchValue targetScrutinee constructors (some peel)) + (zeroChildAt : children[constructors.size]? = some zeroChild) + (succChildAt : children[constructors.size + 1]? = some succChild) + (afterMember : after ∈ positions) + (afterCoordinate : after.coordinateMatches zeroChild.source + zeroChild.sourceBlock zeroChild.targetPosition zeroChild.sourceInputMap = + true) : + ∃ before, before ∈ positions ∧ + before.coordinateMatches source block .terminator input = true ∧ + natZeroChildCapabilities? input before.sourceCapabilities = + some after.sourceCapabilities := by + have matched' := matched + simp only [CodeTrace.switchNodeCapabilitiesMatch, terminator, zeroChildAt, + succChildAt, Bool.and_eq_true] at matched' + have transition := CodeTrace.branchTransition_of_match positions + matched'.2.1 afterMember afterCoordinate + simpa [CodeTrace.source, CodeTrace.sourceBlock, CodeTrace.targetPosition, + CodeTrace.sourceInputMap] using transition + +/-- Select the checked literal-successor capability transition at its +canonical post-constructor ordinal. -/ +theorem CodeTrace.natSuccBranchTransition_of_switch_match + (schemas : Owned → CtorId → Option CtorSchema) + (positions : List PositionTrace) + {source : SourceSite} {block : BlockId} + {input : Array (Option Atom)} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {alternatives : Array IxIR1.Alt} + {targetScrutinee : Atom} {generated : Block} + {outgoing : List EdgeTrace} {children : List CodeTrace} + {constructors : Array CtorAlt} {peel : NatPeel} + {zeroChild succChild : CodeTrace} {after : PositionTrace} + (matched : (CodeTrace.switchValue source block input entryValueCount + sourceScrutinee true alternatives targetScrutinee generated outgoing + children).switchNodeCapabilitiesMatch schemas positions = true) + (terminator : generated.terminator = + .switchValue targetScrutinee constructors (some peel)) + (zeroChildAt : children[constructors.size]? = some zeroChild) + (succChildAt : children[constructors.size + 1]? = some succChild) + (afterMember : after ∈ positions) + (afterCoordinate : after.coordinateMatches succChild.source + succChild.sourceBlock succChild.targetPosition succChild.sourceInputMap = + true) : + ∃ before, before ∈ positions ∧ + before.coordinateMatches source block .terminator input = true ∧ + natSuccChildCapabilities? input before.sourceCapabilities = + some after.sourceCapabilities := by + have matched' := matched + simp only [CodeTrace.switchNodeCapabilitiesMatch, terminator, zeroChildAt, + succChildAt, Bool.and_eq_true] at matched' + have transition := CodeTrace.branchTransition_of_match positions + matched'.2.2 afterMember afterCoordinate + simpa [CodeTrace.source, CodeTrace.sourceBlock, CodeTrace.targetPosition, + CodeTrace.sourceInputMap] using transition + +private theorem codeTraceListSwitchCapabilitiesMatch_of_mem + (schemas : Owned → CtorId → Option CtorSchema) + (positions : List PositionTrace) + {traces : List CodeTrace} {child : CodeTrace} + (matched : codeTraceListSwitchCapabilitiesMatch schemas positions traces = + true) + (member : child ∈ traces) : + child.switchCapabilitiesMatch schemas positions = true := by + induction traces with + | nil => simp at member + | cons head tail ih => + simp only [codeTraceListSwitchCapabilitiesMatch, + Bool.and_eq_true] at matched + simp only [List.mem_cons] at member + cases member with + | inl equal => simpa [equal] using matched.1 + | inr member => exact ih matched.2 member + +/-- Switch capability-flow coherence is inherited by every immediate +recursive compiler call. -/ +theorem CodeTrace.switchCapabilitiesMatch_of_child + (schemas : Owned → CtorId → Option CtorSchema) + (positions : List PositionTrace) {parent child : CodeTrace} + (matched : parent.switchCapabilitiesMatch schemas positions = true) + (member : child ∈ parent.children) : + child.switchCapabilitiesMatch schemas positions = true := by + cases parent with + | ret _ _ _ _ _ _ _ | tailCall _ _ _ _ _ _ _ + | tailCallSelf _ _ _ _ _ _ => + simp [CodeTrace.children] at member + | letOp source block input nextInput entryValueCount operation index + instruction next => + simp [CodeTrace.children] at member + subst child + exact matched + | switchValue source block input entryValueCount sourceScrutinee peel + alternatives targetScrutinee generated outgoing children => + simp only [CodeTrace.switchCapabilitiesMatch, + Bool.and_eq_true] at matched + exact codeTraceListSwitchCapabilitiesMatch_of_mem schemas positions + matched.2 member + +/-- Every recursive descendant inherits the checked switch capability-flow +audit. -/ +theorem CodeTrace.Descendant.switchCapabilitiesMatch + (schemas : Owned → CtorId → Option CtorSchema) + (positions : List PositionTrace) {root child : CodeTrace} + (descendant : Descendant root child) + (matched : root.switchCapabilitiesMatch schemas positions = true) : + child.switchCapabilitiesMatch schemas positions = true := by + induction descendant with + | refl => exact matched + | @step parent child parentDescendant childMem ih => + exact CodeTrace.switchCapabilitiesMatch_of_child schemas positions ih + childMem + +/-- Project whole-program switch capability flow to one retained function. -/ +theorem Trace.functionSwitchCapabilitiesMatch {trace : Trace} + {schemas : Owned → CtorId → Option CtorSchema} + (matched : trace.switchCapabilitiesMatch schemas = true) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ trace.functions) : + functionTrace.root.switchCapabilitiesMatch schemas trace.positions = true := + List.all_eq_true.mp matched functionTrace member + +/-- Every retained function derivation agrees with the checked constructor +schemas at its ordinary allocation nodes. -/ +def Trace.allocationSchemasMatch (trace : Trace) + (schemas : Owned → CtorId → Option CtorSchema) : Bool := + trace.functions.all fun functionTrace => + functionTrace.root.allocationSchemasMatch schemas + +/-- Project whole-trace allocation-schema coherence to one retained function. -/ +theorem Trace.functionAllocationSchemasMatch {trace : Trace} + {schemas : Owned → CtorId → Option CtorSchema} + (matched : trace.allocationSchemasMatch schemas = true) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ trace.functions) : + functionTrace.root.allocationSchemasMatch schemas = true := by + exact List.all_eq_true.mp matched functionTrace member + +/-- Executable whole-program alignment of source declarations, emitted target +declarations, and retained function traces. Externs consume no trace; each +function consumes one exact owner/source/target trace; the sole remaining +trace must be the closed main. -/ +def programTraceMatches : + List (Address × IxIR1.Decl) → List (Address × Decl) → + List FunctionTrace → IxIR1.FnDef → Function → Bool + | [], [], [trace], mainSource, mainGenerated => + functionTraceMatches trace .main mainSource mainGenerated + | (sourceAddress, .extern sourceArity) :: sourceRest, + (targetAddress, .extern targetArity) :: targetRest, + traces, mainSource, mainGenerated => + sourceAddress == targetAddress && sourceArity == targetArity && + programTraceMatches sourceRest targetRest traces mainSource mainGenerated + | (sourceAddress, .fn sourceDefinition) :: sourceRest, + (targetAddress, .fn targetDefinition) :: targetRest, + trace :: traces, mainSource, mainGenerated => + sourceAddress == targetAddress && + functionTraceMatches trace (.declaration sourceAddress) + sourceDefinition targetDefinition && + programTraceMatches sourceRest targetRest traces mainSource mainGenerated + | _, _, _, _, _ => false + +/-- Proof-facing declaration/trace alignment reflected from +`programTraceMatches`. -/ +inductive ProgramTraceOrder (mainSource : IxIR1.FnDef) + (mainGenerated : Function) : + List (Address × IxIR1.Decl) → List (Address × Decl) → + List FunctionTrace → Prop where + | main {trace : FunctionTrace} + (matched : FunctionTraceMatch trace .main mainSource mainGenerated) : + ProgramTraceOrder mainSource mainGenerated [] [] [trace] + | extern {address : Address} {arity : Nat} + {sourceRest : List (Address × IxIR1.Decl)} + {targetRest : List (Address × Decl)} + {traces : List FunctionTrace} + (rest : ProgramTraceOrder mainSource mainGenerated sourceRest targetRest + traces) : + ProgramTraceOrder mainSource mainGenerated + ((address, .extern arity) :: sourceRest) + ((address, .extern arity) :: targetRest) traces + | function {address : Address} {sourceDefinition : IxIR1.FnDef} + {targetDefinition : Function} + {sourceRest : List (Address × IxIR1.Decl)} + {targetRest : List (Address × Decl)} + {trace : FunctionTrace} {traces : List FunctionTrace} + (matched : FunctionTraceMatch trace (.declaration address) + sourceDefinition targetDefinition) + (rest : ProgramTraceOrder mainSource mainGenerated sourceRest targetRest + traces) : + ProgramTraceOrder mainSource mainGenerated + ((address, .fn sourceDefinition) :: sourceRest) + ((address, .fn targetDefinition) :: targetRest) (trace :: traces) + +/-- Reflect the executable whole-program trace-order check. -/ +theorem programTraceOrder_of_match + {source : List (Address × IxIR1.Decl)} + {target : List (Address × Decl)} {traces : List FunctionTrace} + {mainSource : IxIR1.FnDef} {mainGenerated : Function} + (matched : programTraceMatches source target traces mainSource + mainGenerated = true) : + ProgramTraceOrder mainSource mainGenerated source target traces := by + induction source generalizing target traces with + | nil => + cases target with + | cons targetEntry targetRest => + simp [programTraceMatches] at matched + | nil => + cases traces with + | nil => simp [programTraceMatches] at matched + | cons trace rest => + cases rest with + | nil => + exact .main (functionTraceMatch_of_match + (by simpa [programTraceMatches] using matched)) + | cons next tail => simp [programTraceMatches] at matched + | cons sourceEntry sourceRest ih => + obtain ⟨sourceAddress, sourceDeclaration⟩ := sourceEntry + cases target with + | nil => simp [programTraceMatches] at matched + | cons targetEntry targetRest => + obtain ⟨targetAddress, targetDeclaration⟩ := targetEntry + cases sourceDeclaration with + | extern sourceArity => + cases targetDeclaration with + | fn targetDefinition => + simp [programTraceMatches] at matched + | extern targetArity => + simp only [programTraceMatches, Bool.and_eq_true] at matched + have addressEq : sourceAddress = targetAddress := + beq_iff_eq.mp matched.1.1 + have arityEq : sourceArity = targetArity := + beq_iff_eq.mp matched.1.2 + subst targetAddress + subst targetArity + exact .extern (ih matched.2) + | fn sourceDefinition => + cases targetDeclaration with + | extern targetArity => + simp [programTraceMatches] at matched + | fn targetDefinition => + cases traces with + | nil => simp [programTraceMatches] at matched + | cons trace rest => + simp only [programTraceMatches, Bool.and_eq_true] at matched + have addressEq : sourceAddress = targetAddress := + beq_iff_eq.mp matched.1.1 + subst targetAddress + exact .function + (functionTraceMatch_of_match matched.1.2) + (ih matched.2) + +/-- Every source function occurrence in a checked program order has the +corresponding emitted declaration and retained exact function trace. -/ +theorem ProgramTraceOrder.function_exists_of_source_mem + {mainSource : IxIR1.FnDef} {mainGenerated : Function} + {source : List (Address × IxIR1.Decl)} + {target : List (Address × Decl)} {traces : List FunctionTrace} + (order : ProgramTraceOrder mainSource mainGenerated source target traces) + {address : Address} {sourceDefinition : IxIR1.FnDef} + (member : (address, .fn sourceDefinition) ∈ source) : + ∃ targetDefinition trace, + (address, .fn targetDefinition) ∈ target ∧ + trace ∈ traces ∧ + FunctionTraceMatch trace (.declaration address) sourceDefinition + targetDefinition := by + induction order with + | main matched => simp at member + | @extern headAddress arity sourceRest targetRest traces rest ih => + simp only [List.mem_cons] at member + cases member with + | inl equal => simp at equal + | inr member => + obtain ⟨targetDefinition, trace, targetMember, traceMember, + traceMatch⟩ := ih member + exact ⟨targetDefinition, trace, List.mem_cons_of_mem _ targetMember, + traceMember, traceMatch⟩ + | @function headAddress headSource headTarget sourceRest targetRest trace traces + matched rest ih => + simp only [List.mem_cons] at member + cases member with + | inl equal => + cases equal + exact ⟨headTarget, trace, by simp, by simp, matched⟩ + | inr member => + obtain ⟨targetDefinition, childTrace, targetMember, traceMember, + traceMatch⟩ := ih member + exact ⟨targetDefinition, childTrace, + List.mem_cons_of_mem _ targetMember, + List.mem_cons_of_mem _ traceMember, traceMatch⟩ + +/-- Source and target declaration lookup traverse the same checked order. +Consequently a source function selected by first-binding-wins lookup has the +exact emitted definition and retained trace selected at the corresponding +target address, even if the raw lists contain repeated keys. -/ +theorem ProgramTraceOrder.function_exists_of_source_lookup + {mainSource : IxIR1.FnDef} {mainGenerated : Function} + {source : List (Address × IxIR1.Decl)} + {target : List (Address × Decl)} {traces : List FunctionTrace} + (order : ProgramTraceOrder mainSource mainGenerated source target traces) + {address : Address} {sourceDefinition : IxIR1.FnDef} + (lookup : IxIR1.Env.ofList source address = + some (.fn sourceDefinition)) : + ∃ targetDefinition trace, + (target.find? fun entry => entry.1 == address).map (·.2) = + some (.fn targetDefinition) ∧ + trace ∈ traces ∧ + FunctionTraceMatch trace (.declaration address) sourceDefinition + targetDefinition := by + induction order with + | main matched => + simp [IxIR1.Env.ofList] at lookup + | @extern headAddress arity sourceRest targetRest traces rest ih => + by_cases same : headAddress = address + · subst address + simp [IxIR1.Env.ofList] at lookup + · have tailLookup : IxIR1.Env.ofList sourceRest address = + some (.fn sourceDefinition) := by + simpa [IxIR1.Env.ofList, same] using lookup + obtain ⟨targetDefinition, trace, targetLookup, traceMember, + traceMatch⟩ := ih tailLookup + exact ⟨targetDefinition, trace, by simpa [same] using targetLookup, + traceMember, traceMatch⟩ + | @function headAddress headSource headTarget sourceRest targetRest trace + traces matched rest ih => + by_cases same : headAddress = address + · subst address + have sourceEq : headSource = sourceDefinition := by + simpa [IxIR1.Env.ofList] using lookup + subst sourceDefinition + exact ⟨headTarget, trace, by simp, by simp, matched⟩ + · have tailLookup : IxIR1.Env.ofList sourceRest address = + some (.fn sourceDefinition) := by + simpa [IxIR1.Env.ofList, same] using lookup + obtain ⟨targetDefinition, childTrace, targetLookup, traceMember, + traceMatch⟩ := ih tailLookup + exact ⟨targetDefinition, childTrace, + by simpa [same] using targetLookup, + List.mem_cons_of_mem _ traceMember, traceMatch⟩ + +/-- Symmetric lookup form of the declaration-order theorem. A target function +selected by first-binding-wins lookup comes from the exact source function and +retained trace at the same address; an extern entry can therefore never be +mistaken for a function in either direction. -/ +theorem ProgramTraceOrder.function_exists_of_target_lookup + {mainSource : IxIR1.FnDef} {mainGenerated : Function} + {source : List (Address × IxIR1.Decl)} + {target : List (Address × Decl)} {traces : List FunctionTrace} + (order : ProgramTraceOrder mainSource mainGenerated source target traces) + {address : Address} {targetDefinition : Function} + (lookup : (target.find? fun entry => entry.1 == address).map (·.2) = + some (.fn targetDefinition)) : + ∃ sourceDefinition trace, + IxIR1.Env.ofList source address = some (.fn sourceDefinition) ∧ + trace ∈ traces ∧ + FunctionTraceMatch trace (.declaration address) sourceDefinition + targetDefinition := by + induction order with + | main matched => simp at lookup + | @extern headAddress arity sourceRest targetRest traces rest ih => + by_cases same : headAddress = address + · subst address + simp at lookup + · have tailLookup : + (targetRest.find? fun entry => entry.1 == address).map (·.2) = + some (.fn targetDefinition) := by + simpa [same] using lookup + obtain ⟨sourceDefinition, trace, sourceLookup, traceMember, + traceMatch⟩ := ih tailLookup + exact ⟨sourceDefinition, trace, + by simpa [IxIR1.Env.ofList, same] using sourceLookup, + traceMember, traceMatch⟩ + | @function headAddress headSource headTarget sourceRest targetRest trace + traces matched rest ih => + by_cases same : headAddress = address + · subst address + have targetEq : headTarget = targetDefinition := by + simpa using lookup + subst targetDefinition + exact ⟨headSource, trace, by simp [IxIR1.Env.ofList], by simp, matched⟩ + · have tailLookup : + (targetRest.find? fun entry => entry.1 == address).map (·.2) = + some (.fn targetDefinition) := by + simpa [same] using lookup + obtain ⟨sourceDefinition, childTrace, sourceLookup, traceMember, + traceMatch⟩ := ih tailLookup + exact ⟨sourceDefinition, childTrace, + by simpa [IxIR1.Env.ofList, same] using sourceLookup, + List.mem_cons_of_mem _ traceMember, traceMatch⟩ + +/-- A target extern selected by first-binding-wins lookup is the matching +source extern. In particular, a checked function declaration cannot be +observed as an extern on only one side of the lowering boundary. -/ +theorem ProgramTraceOrder.extern_of_target_lookup + {mainSource : IxIR1.FnDef} {mainGenerated : Function} + {source : List (Address × IxIR1.Decl)} + {target : List (Address × Decl)} {traces : List FunctionTrace} + (order : ProgramTraceOrder mainSource mainGenerated source target traces) + {address : Address} {arity : Nat} + (lookup : (target.find? fun entry => entry.1 == address).map (·.2) = + some (.extern arity)) : + IxIR1.Env.ofList source address = some (.extern arity) := by + induction order with + | main matched => simp at lookup + | @extern headAddress headArity sourceRest targetRest traces rest ih => + by_cases same : headAddress = address + · subst address + have arityEq : headArity = arity := by simpa using lookup + subst arity + simp [IxIR1.Env.ofList] + · have tailLookup : + (targetRest.find? fun entry => entry.1 == address).map (·.2) = + some (.extern arity) := by + simpa [same] using lookup + simpa [IxIR1.Env.ofList, same] using ih tailLookup + | @function headAddress headSource headTarget sourceRest targetRest trace + traces matched rest ih => + by_cases same : headAddress = address + · subst address + simp at lookup + · have tailLookup : + (targetRest.find? fun entry => entry.1 == address).map (·.2) = + some (.extern arity) := by + simpa [same] using lookup + simpa [IxIR1.Env.ofList, same] using ih tailLookup + +/-- A retained trace whose certified owner is `main` is the unique final main +entry of the whole-program declaration/trace alignment. -/ +theorem ProgramTraceOrder.main_of_mem_owner + {mainSource : IxIR1.FnDef} {mainGenerated : Function} + {source : List (Address × IxIR1.Decl)} + {target : List (Address × Decl)} {traces : List FunctionTrace} + (order : ProgramTraceOrder mainSource mainGenerated source target traces) + {trace : FunctionTrace} + (member : trace ∈ traces) (owner : trace.owner = .main) : + FunctionTraceMatch trace .main mainSource mainGenerated := by + induction order with + | main matched => + simp only [List.mem_singleton] at member + subst trace + exact matched + | @extern address arity sourceRest targetRest traces rest ih => + exact ih member + | @function address sourceDefinition targetDefinition sourceRest targetRest + head traces matched rest ih => + simp only [List.mem_cons] at member + cases member with + | inl equal => + subst trace + rw [matched.owner] at owner + cases owner + | inr member => exact ih member + +structure Artifact where + source : Input + program : Program + validationContext : Validate.Context + trace : Trace + mainTrace : FunctionTrace + /-- The distinguished synthetic-main derivation is retained in the exact + whole-program trace consumed by recursive simulation. -/ + mainTraceMember : mainTrace ∈ trace.functions + mainTraceOrder : FunctionTraceMatch mainTrace .main source.mainDefinition + program.main + /-- Exact declaration/function-trace order, ending in the retained main. -/ + functionTraceOrder : programTraceMatches source.declarations + program.declarations trace.functions source.mainDefinition program.main = true + +namespace Artifact + +/-- Proof-facing whole-program declaration/function-trace alignment. -/ +theorem functionTraceOrderProof (artifact : Artifact) : + ProgramTraceOrder artifact.source.mainDefinition artifact.program.main + artifact.source.declarations artifact.program.declarations + artifact.trace.functions := + programTraceOrder_of_match artifact.functionTraceOrder + +/-- Resolve one retained source function occurrence to its emitted definition +and exact recursive trace. -/ +theorem functionTrace_of_source_mem (artifact : Artifact) + {address : Address} {sourceDefinition : IxIR1.FnDef} + (member : (address, .fn sourceDefinition) ∈ + artifact.source.declarations) : + ∃ targetDefinition trace, + (address, .fn targetDefinition) ∈ artifact.program.declarations ∧ + trace ∈ artifact.trace.functions ∧ + FunctionTraceMatch trace (.declaration address) sourceDefinition + targetDefinition := + artifact.functionTraceOrderProof.function_exists_of_source_mem member + +/-- Lookup-facing form of `functionTrace_of_source_mem`, aligned with the +declaration function installed by `Eval.Context.ofProgram`. -/ +theorem functionTrace_of_source_lookup (artifact : Artifact) + {address : Address} {sourceDefinition : IxIR1.FnDef} + (lookup : IxIR1.Env.ofList artifact.source.declarations address = + some (.fn sourceDefinition)) : + ∃ targetDefinition trace, + (artifact.program.declarations.find? fun entry => + entry.1 == address).map (·.2) = some (.fn targetDefinition) ∧ + trace ∈ artifact.trace.functions ∧ + FunctionTraceMatch trace (.declaration address) sourceDefinition + targetDefinition := + artifact.functionTraceOrderProof.function_exists_of_source_lookup lookup + +/-- Lookup-facing inverse of `functionTrace_of_source_lookup`, used by +forward target execution proofs to recover the exact retained source callee. -/ +theorem functionTrace_of_target_lookup (artifact : Artifact) + {address : Address} {targetDefinition : Function} + (lookup : (artifact.program.declarations.find? fun entry => + entry.1 == address).map (·.2) = some (.fn targetDefinition)) : + ∃ sourceDefinition trace, + IxIR1.Env.ofList artifact.source.declarations address = + some (.fn sourceDefinition) ∧ + trace ∈ artifact.trace.functions ∧ + FunctionTraceMatch trace (.declaration address) sourceDefinition + targetDefinition := + artifact.functionTraceOrderProof.function_exists_of_target_lookup lookup + +/-- Resolve a target extern lookup to the exact source extern selected at the +same address. -/ +theorem sourceExtern_of_target_lookup (artifact : Artifact) + {address : Address} {arity : Nat} + (lookup : (artifact.program.declarations.find? fun entry => + entry.1 == address).map (·.2) = some (.extern arity)) : + IxIR1.Env.ofList artifact.source.declarations address = + some (.extern arity) := + artifact.functionTraceOrderProof.extern_of_target_lookup lookup + +/-- The distinguished trace is the source main's trace. -/ +theorem mainOwner (artifact : Artifact) : + artifact.mainTrace.owner = .main := + artifact.mainTraceOrder.owner + +/-- The distinguished trace retains the exact synthetic source main. -/ +theorem mainSource (artifact : Artifact) : + artifact.mainTrace.source = artifact.source.mainDefinition := + artifact.mainTraceOrder.source + +/-- The distinguished trace generated the target program's actual main. -/ +theorem mainGenerated (artifact : Artifact) : + artifact.mainTrace.generated = artifact.program.main := + artifact.mainTraceOrder.generated + +/-- The emitted main remains closed. -/ +theorem mainArity (artifact : Artifact) : + artifact.program.main.signature.params.size = 0 := by + have arity := artifact.mainTrace.sourceArity + rw [artifact.mainGenerated, artifact.mainSource] at arity + simpa [Input.mainDefinition] using arity + +/-- The recursive main derivation reconstructs the literal input main code. -/ +theorem mainRootSourceCode (artifact : Artifact) : + artifact.mainTrace.root.sourceCode = artifact.source.main := by + rw [artifact.mainTrace.rootSourceCode, artifact.mainSource] + rfl + +/-- A closed source main starts with the empty source-slot map. -/ +theorem mainEntryInput (artifact : Artifact) : + artifact.mainTrace.root.sourceInputMap = #[] := by + rw [artifact.mainTrace.entryInput, artifact.mainSource] + simp [Input.mainDefinition, entryInputMap] + +/-- The trace's completed root block is the actual block-zero entry of the +emitted target main. -/ +theorem mainHeadBlockAt (artifact : Artifact) : + artifact.program.main.blocks[0]? = + some artifact.mainTrace.root.headBlock.2 := by + have blockAt := artifact.mainTrace.headBlockAt + rw [artifact.mainGenerated, artifact.mainTrace.rootHeadBlock] at blockAt + exact blockAt + +/-- The retained entry-block witness discharges the evaluator's nonempty-main +entry check. -/ +theorem mainNonempty (artifact : Artifact) : + artifact.program.main.blocks.isEmpty = false := by + have found := artifact.mainHeadBlockAt + obtain ⟨bound, _⟩ := Array.getElem?_eq_some_iff.mp found + simpa [Array.isEmpty] using (Nat.ne_of_gt bound) + +end Artifact + +/-- A successful lower-and-check result retains the exact validator equation, +so later simulation files never need to trust a Boolean acceptance claim. -/ +structure Checked where + artifact : Artifact + stats : Validate.Stats + accepted : Validate.validate artifact.validationContext artifact.program = + .ok stats + /-- The emitted baseline contains no credit operations. This checked + syntactic inventory supports exact interpretation independence. -/ + creditFree : CreditFree.program artifact.program = true + /-- Every recursive derivation node is represented by a flat producer + position with the exact source/block/target coordinate and input-map + capability shape. -/ + positionCoordinates : artifact.trace.positionsMatch = true + /-- Every live source slot that names an inherited target block parameter + carries exactly that parameter's declared ownership capability. -/ + parameterCapabilities : artifact.trace.parameterCapabilitiesMatch = true + /-- Every retained `pure` node has the producer's exact move/copy/consume + transition between its current and continuation capability vectors. -/ + pureCapabilities : artifact.trace.pureCapabilitiesMatch = true + /-- Every retained `dup` node has the producer's exact scalar-copy or + shared-owner retention transition. -/ + dupCapabilities : artifact.trace.dupCapabilitiesMatch = true + /-- Every retained `fetch` node borrows in the source constructor world and + retains the producer's exact lender. -/ + fetchCapabilities : artifact.trace.fetchCapabilitiesMatch = true + /-- Every retained shallow/deep destruction node consumes its exact owner, + retires rooted loans, and binds the erased scalar result. -/ + destructionCapabilities : + artifact.trace.destructionCapabilitiesMatch = true + /-- The post-validation semantic projection used by allocation simulation: + every retained source allocation has the exact uniform target schema. -/ + allocationSchemas : artifact.trace.allocationSchemasMatch + artifact.validationContext.schemas = true + /-- Every retained constructor or function-PAP allocation is paired with + the producer's exact pre-operation capability vector and exact sequential + consume-and-bind continuation, checked against its recursive input map and + owned operand world. -/ + allocationCapabilities : artifact.trace.allocationCapabilitiesMatch = true + /-- Every allocation immediately followed by a recursive self tail call is + reached only after the producer has retired all outstanding borrows. -/ + terminalAllocationNoBorrows : + artifact.trace.terminalAllocationNoBorrows = true + /-- Every retained dynamic application consumes its function operand and + supplied arguments at the shared boundary, then binds one shared result + owner. -/ + applyCapabilities : artifact.trace.applyCapabilitiesMatch = true + /-- Every PAP-safe retained function has the canonical all-owned/shared + entry capability vector used by dynamic exact and over-saturation. -/ + sharedPapEntryCapabilities : + artifact.trace.sharedPapEntryCapabilitiesMatch = true + /-- Every switch edge rebases local lenders exactly; constructor children + prepend schema-world field borrows and Nat-successor children shift lenders + across their implicit scalar parameter. -/ + switchCapabilities : artifact.trace.switchCapabilitiesMatch + artifact.validationContext.schemas = true + /-- Function entries, ordinary and tail calls, and returns implement the + exact baseline ownership-transfer ABI. -/ + callCapabilities : artifact.trace.callCapabilitiesMatch + artifact.program.declarations = true + +namespace Checked + +/-- Every returned checked artifact satisfies the public bounded-validity +predicate by construction. -/ +theorem valid (checked : Checked) : + Validate.Valid checked.artifact.validationContext checked.artifact.program := + ⟨checked.stats, checked.accepted⟩ + +/-- Recover the borrow-free producer vector at a terminal allocation node. -/ +theorem terminalAllocationPositionNoBorrows (checked : Checked) + {functionTrace : FunctionTrace} + (functionMember : functionTrace ∈ checked.artifact.trace.functions) + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {world : Owned} {identity : CtorId} {arguments : Array IxIR1.Atom} + {index : Nat} {instruction : Instr} + {tailSource : SourceSite} {tailBlock : BlockId} + {tailInput : Array (Option Atom)} {tailEntryValueCount : Nat} + {tailArguments : Array IxIR1.Atom} {generated : Block} + (descendant : functionTrace.root.Descendant + (.letOp source block input nextInput entryValueCount + (.alloc world identity arguments) index instruction + (.tailCallSelf tailSource tailBlock tailInput tailEntryValueCount + tailArguments generated))) + {position : PositionTrace} + (positionMember : position ∈ checked.artifact.trace.positions) + (coordinate : position.coordinateMatches source block + (.instruction index) input = true) : + noBorrows position.sourceCapabilities = true := by + have rootMatch := checked.artifact.trace.functionTerminalAllocationNoBorrows + checked.terminalAllocationNoBorrows functionMember + have localMatch := descendant.terminalAllocationNoBorrows + checked.artifact.trace.positions rootMatch + exact CodeTrace.terminalAllocationPositionNoBorrows_of_match + checked.artifact.trace.positions localMatch positionMember coordinate + +/-- Recover the exact flat producer position for any recursive trace node in +a retained function. -/ +theorem position (checked : Checked) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ checked.artifact.trace.functions) + {trace : CodeTrace} + (descendant : functionTrace.root.Descendant trace) : + ∃ position, position ∈ checked.artifact.trace.positions ∧ + position.coordinateMatches trace.source trace.sourceBlock + trace.targetPosition trace.sourceInputMap = true := by + have rootMatch := Trace.functionPositionsMatch + checked.positionCoordinates member + exact CodeTrace.position_of_positionsMatch checked.artifact.trace.positions + (descendant.positionsMatch checked.artifact.trace.positions rootMatch) + +/-- Recover the exact producer owner behind an inherited owned target +parameter at any retained recursive trace node. -/ +theorem ownedParameterCapability (checked : Checked) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ checked.artifact.trace.functions) + {trace : CodeTrace} + (descendant : functionTrace.root.Descendant trace) + {position : PositionTrace} + (positionMember : position ∈ checked.artifact.trace.positions) + (coordinate : position.coordinateMatches trace.source trace.sourceBlock + trace.targetPosition trace.sourceInputMap = true) + {sourceIndex targetIndex : Nat} {world : Owned} + (inputAt : trace.sourceInputMap[sourceIndex]? = + some (some (.reg targetIndex))) + (parameterAt : trace.headBlock.2.valueParams[targetIndex]? = + some (.owned world)) : + position.sourceCapabilities[sourceIndex]? = some (.owned world) := by + have rootMatch := Trace.functionParameterCapabilitiesMatch + checked.parameterCapabilities member + have localMatch := descendant.parameterCapabilitiesMatch + checked.artifact.trace.positions rootMatch + have positionMatch := trace.positionParameterCapabilities_of_match + checked.artifact.trace.positions localMatch positionMember coordinate + exact position.owned_of_parameterCapabilitiesMatch positionMatch inputAt + parameterAt + +/-- Recover the producer capability corresponding to any inherited target +block parameter. The reflected `matchesParameter` equation retains the exact +scalar/owned/borrowed kind and excludes a consumed source binding. -/ +theorem parameterCapability (checked : Checked) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ checked.artifact.trace.functions) + {trace : CodeTrace} + (descendant : functionTrace.root.Descendant trace) + {position : PositionTrace} + (positionMember : position ∈ checked.artifact.trace.positions) + (coordinate : position.coordinateMatches trace.source trace.sourceBlock + trace.targetPosition trace.sourceInputMap = true) + {sourceIndex targetIndex : Nat} {parameter : ValueCap} + (inputAt : trace.sourceInputMap[sourceIndex]? = + some (some (.reg targetIndex))) + (parameterAt : trace.headBlock.2.valueParams[targetIndex]? = + some parameter) : + ∃ capability, + position.sourceCapabilities[sourceIndex]? = some capability ∧ + capability.matchesParameter parameter = true := by + have rootMatch := Trace.functionParameterCapabilitiesMatch + checked.parameterCapabilities member + have localMatch := descendant.parameterCapabilitiesMatch + checked.artifact.trace.positions rootMatch + have positionMatch := trace.positionParameterCapabilities_of_match + checked.artifact.trace.positions localMatch positionMember coordinate + exact position.capability_of_parameterCapabilitiesMatch positionMatch inputAt + parameterAt + +/-- Recover the local switch capability audit at any retained switch node. -/ +theorem switchNodeCapabilities (checked : Checked) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ checked.artifact.trace.functions) + {source : SourceSite} {block : BlockId} + {input : Array (Option Atom)} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {targetScrutinee : Atom} + {generated : Block} {outgoing : List EdgeTrace} + {children : List CodeTrace} + (descendant : functionTrace.root.Descendant + (.switchValue source block input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children)) : + (CodeTrace.switchValue source block input entryValueCount sourceScrutinee + peelNat alternatives targetScrutinee generated outgoing children + ).switchNodeCapabilitiesMatch + checked.artifact.validationContext.schemas + checked.artifact.trace.positions = true := by + have rootMatch := Trace.functionSwitchCapabilitiesMatch + checked.switchCapabilities member + have nodeMatch := descendant.switchCapabilitiesMatch + checked.artifact.validationContext.schemas + checked.artifact.trace.positions rootMatch + change ((CodeTrace.switchValue source block input entryValueCount + sourceScrutinee peelNat alternatives targetScrutinee generated outgoing + children).switchNodeCapabilitiesMatch + checked.artifact.validationContext.schemas + checked.artifact.trace.positions && + codeTraceListSwitchCapabilitiesMatch + checked.artifact.validationContext.schemas + checked.artifact.trace.positions children) = true at nodeMatch + simp only [Bool.and_eq_true] at nodeMatch + exact nodeMatch.1 + +/-- Recover the exact constructor-child capability transition at a checked +switch ordinal. -/ +theorem constructorBranchTransition (checked : Checked) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ checked.artifact.trace.functions) + {source : SourceSite} {block : BlockId} + {input : Array (Option Atom)} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {targetScrutinee : Atom} + {generated : Block} {outgoing : List EdgeTrace} + {children : List CodeTrace} {constructors : Array CtorAlt} + {natPeel : Option NatPeel} {index : Nat} {target : CtorAlt} + {child : CodeTrace} + (descendant : functionTrace.root.Descendant + (.switchValue source block input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children)) + (terminator : generated.terminator = + .switchValue targetScrutinee constructors natPeel) + (targetAt : constructors[index]? = some target) + (childAt : children[index]? = some child) + {after : PositionTrace} + (afterMember : after ∈ checked.artifact.trace.positions) + (afterCoordinate : after.coordinateMatches child.source child.sourceBlock + child.targetPosition child.sourceInputMap = true) : + ∃ before, before ∈ checked.artifact.trace.positions ∧ + before.coordinateMatches source block .terminator input = true ∧ + constructorChildCapabilities? + checked.artifact.validationContext.schemas input sourceScrutinee + target.cid before.sourceCapabilities = + some after.sourceCapabilities := by + exact CodeTrace.constructorBranchTransition_of_switch_match + checked.artifact.validationContext.schemas + checked.artifact.trace.positions + (checked.switchNodeCapabilities member descendant) terminator targetAt + childAt afterMember afterCoordinate + +/-- A checked constructor-child transition fixes the selected schema arity. +The child coordinate counts both the edge-rebased source vector and every +borrowed constructor field, so comparison with the source alternative is +exact rather than merely a lower bound from the generated fetch prologue. -/ +theorem constructorBranchSchemaArity + (checked : Checked) {functionTrace : FunctionTrace} + (member : functionTrace ∈ checked.artifact.trace.functions) + {site : SourceSite} {blockId : BlockId} {input : Array (Option Atom)} + {entryValueCount : Nat} {sourceScrutinee : IxIR1.Atom} + {peelNat : Bool} {alternatives : Array IxIR1.Alt} + {targetScrutinee : Atom} {generated : Block} + {outgoing : List EdgeTrace} {children : List CodeTrace} + {constructors : Array CtorAlt} {targetPeel : Option NatPeel} + {index : Nat} {target : CtorAlt} {edge : EdgeTrace} + {child : CodeTrace} + (descendant : functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children)) + (terminator : generated.terminator = + .switchValue targetScrutinee constructors targetPeel) + (targetAt : constructors[index]? = some target) + (childAt : children[index]? = some child) + (branch : ConstructorBranchMatch site blockId input sourceScrutinee + alternatives target edge child) : + ∃ world schema, + checked.artifact.validationContext.schemas world target.cid = + some schema ∧ + schema.fields.size = branch.fieldCount := by + have childMember : child ∈ children := List.mem_of_getElem? childAt + have childDescendant : functionTrace.root.Descendant child := + .step descendant childMember + obtain ⟨after, afterMember, afterCoordinate⟩ := + checked.position member childDescendant + obtain ⟨before, _beforeMember, beforeCoordinate, transition⟩ := + checked.constructorBranchTransition member descendant terminator targetAt + childAt afterMember afterCoordinate + have beforeSize : before.sourceCapabilities.size = input.size := + before.sourceCapabilities_size_of_coordinateMatch beforeCoordinate + have afterSize : after.sourceCapabilities.size = child.sourceInputMap.size := + after.sourceCapabilities_size_of_coordinateMatch afterCoordinate + have childSize : child.sourceInputMap.size = + branch.fieldCount + input.size := by + rw [branch.childInput] + simp [constructorChildInputMap, EdgeTrace.explicitMapOf, + branch.edgeSourceInput] + unfold constructorChildCapabilities? at transition + cases rebasedEq : edgeCapabilities? before.sourceCapabilities input with + | none => simp [rebasedEq] at transition + | some rebased => + simp only [rebasedEq] at transition + cases sourceScrutinee with + | lit literal => simp at transition + | erased => simp at transition + | var sourceIndex => + cases capabilityEq : rebased[sourceIndex]? with + | none => simp [capabilityEq] at transition + | some capability => + cases capability with + | scalar => simp [capabilityEq] at transition + | dead => simp [capabilityEq] at transition + | owned world => + cases schemaEq : checked.artifact.validationContext.schemas + world target.cid with + | none => simp [capabilityEq, schemaEq] at transition + | some schema => + simp only [capabilityEq, schemaEq] at transition + injection transition with afterEq + have rebasedSize : rebased.size = + before.sourceCapabilities.size := + edgeCapabilities?_size rebasedEq + refine ⟨world, schema, schemaEq, ?_⟩ + have sizeEq := congrArg Array.size afterEq + simp only [Array.size_append, Array.size_reverse, + Array.size_map] at sizeEq + omega + | borrowed world lender => + cases schemaEq : checked.artifact.validationContext.schemas + world target.cid with + | none => simp [capabilityEq, schemaEq] at transition + | some schema => + simp only [capabilityEq, schemaEq] at transition + injection transition with afterEq + have rebasedSize : rebased.size = + before.sourceCapabilities.size := + edgeCapabilities?_size rebasedEq + refine ⟨world, schema, schemaEq, ?_⟩ + have sizeEq := congrArg Array.size afterEq + simp only [Array.size_append, Array.size_reverse, + Array.size_map] at sizeEq + omega + +/-- Recover the exact literal-zero child capability transition. -/ +theorem natZeroBranchTransition (checked : Checked) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ checked.artifact.trace.functions) + {source : SourceSite} {block : BlockId} + {input : Array (Option Atom)} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {alternatives : Array IxIR1.Alt} + {targetScrutinee : Atom} {generated : Block} + {outgoing : List EdgeTrace} {children : List CodeTrace} + {constructors : Array CtorAlt} {peel : NatPeel} + {zeroChild succChild : CodeTrace} + (descendant : functionTrace.root.Descendant + (.switchValue source block input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children)) + (terminator : generated.terminator = + .switchValue targetScrutinee constructors (some peel)) + (zeroChildAt : children[constructors.size]? = some zeroChild) + (succChildAt : children[constructors.size + 1]? = some succChild) + {after : PositionTrace} + (afterMember : after ∈ checked.artifact.trace.positions) + (afterCoordinate : after.coordinateMatches zeroChild.source + zeroChild.sourceBlock zeroChild.targetPosition zeroChild.sourceInputMap = + true) : + ∃ before, before ∈ checked.artifact.trace.positions ∧ + before.coordinateMatches source block .terminator input = true ∧ + natZeroChildCapabilities? input before.sourceCapabilities = + some after.sourceCapabilities := by + exact CodeTrace.natZeroBranchTransition_of_switch_match + checked.artifact.validationContext.schemas + checked.artifact.trace.positions + (checked.switchNodeCapabilities member descendant) terminator zeroChildAt + succChildAt afterMember afterCoordinate + +/-- Recover the exact literal-successor child capability transition. -/ +theorem natSuccBranchTransition (checked : Checked) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ checked.artifact.trace.functions) + {source : SourceSite} {block : BlockId} + {input : Array (Option Atom)} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {alternatives : Array IxIR1.Alt} + {targetScrutinee : Atom} {generated : Block} + {outgoing : List EdgeTrace} {children : List CodeTrace} + {constructors : Array CtorAlt} {peel : NatPeel} + {zeroChild succChild : CodeTrace} + (descendant : functionTrace.root.Descendant + (.switchValue source block input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children)) + (terminator : generated.terminator = + .switchValue targetScrutinee constructors (some peel)) + (zeroChildAt : children[constructors.size]? = some zeroChild) + (succChildAt : children[constructors.size + 1]? = some succChild) + {after : PositionTrace} + (afterMember : after ∈ checked.artifact.trace.positions) + (afterCoordinate : after.coordinateMatches succChild.source + succChild.sourceBlock succChild.targetPosition succChild.sourceInputMap = + true) : + ∃ before, before ∈ checked.artifact.trace.positions ∧ + before.coordinateMatches source block .terminator input = true ∧ + natSuccChildCapabilities? input before.sourceCapabilities = + some after.sourceCapabilities := by + exact CodeTrace.natSuccBranchTransition_of_switch_match + checked.artifact.validationContext.schemas + checked.artifact.trace.positions + (checked.switchNodeCapabilities member descendant) terminator zeroChildAt + succChildAt afterMember afterCoordinate + +/-- Recover the producer capability predecessor of any matching continuation +position at a retained `pure`/`move` node. -/ +theorem pureTransition (checked : Checked) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ checked.artifact.trace.functions) + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {index : Nat} {targetAtom : Atom} + {next : CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp source block input nextInput entryValueCount + (.pure sourceAtom) index (.move targetAtom) next)) + {after : PositionTrace} + (afterMember : after ∈ checked.artifact.trace.positions) + (afterCoordinate : after.coordinateMatches next.source next.sourceBlock + next.targetPosition next.sourceInputMap = true) : + ∃ before, before ∈ checked.artifact.trace.positions ∧ + before.coordinateMatches source block (.instruction index) input = true ∧ + before.moveMatches after input sourceAtom = true := by + have rootMatch := Trace.functionPureCapabilitiesMatch + checked.pureCapabilities member + exact CodeTrace.pureTransition_of_match checked.artifact.trace.positions + (descendant.pureCapabilitiesMatch checked.artifact.trace.positions + rootMatch) afterMember afterCoordinate + +/-- Recover the producer capability predecessor of any matching continuation +position at a retained `dup`/`retainShared` node. -/ +theorem dupTransition (checked : Checked) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ checked.artifact.trace.functions) + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {index : Nat} {targetAtom : Atom} + {next : CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp source block input nextInput entryValueCount + (.dup sourceAtom) index (.retainShared targetAtom) next)) + {after : PositionTrace} + (afterMember : after ∈ checked.artifact.trace.positions) + (afterCoordinate : after.coordinateMatches next.source next.sourceBlock + next.targetPosition next.sourceInputMap = true) : + ∃ before, before ∈ checked.artifact.trace.positions ∧ + before.coordinateMatches source block (.instruction index) input = true ∧ + before.dupMatches after sourceAtom = true := by + have rootMatch := Trace.functionDupCapabilitiesMatch + checked.dupCapabilities member + exact CodeTrace.dupTransition_of_match checked.artifact.trace.positions + (descendant.dupCapabilitiesMatch checked.artifact.trace.positions + rootMatch) afterMember afterCoordinate + +/-- Recover the producer capability predecessor of any matching continuation +position at a retained `fetch` node. -/ +theorem fetchTransition (checked : Checked) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ checked.artifact.trace.functions) + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {sourceField index : Nat} + {targetAtom : Atom} {targetCid : CtorId} {targetField : Nat} + {next : CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp source block input nextInput entryValueCount + (.fetch sourceAtom sourceField) index + (.fetch targetAtom targetCid targetField) next)) + {after : PositionTrace} + (afterMember : after ∈ checked.artifact.trace.positions) + (afterCoordinate : after.coordinateMatches next.source next.sourceBlock + next.targetPosition next.sourceInputMap = true) : + ∃ before, before ∈ checked.artifact.trace.positions ∧ + before.coordinateMatches source block (.instruction index) input = true ∧ + before.fetchMatches after sourceAtom targetAtom = true := by + have rootMatch := Trace.functionFetchCapabilitiesMatch + checked.fetchCapabilities member + exact CodeTrace.fetchTransition_of_match checked.artifact.trace.positions + (descendant.fetchCapabilitiesMatch checked.artifact.trace.positions + rootMatch) afterMember afterCoordinate + +/-- Recover the exact consume/loan-retirement/scalar-bind transition at any +retained destruction node. -/ +theorem destructionTransition (checked : Checked) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ checked.artifact.trace.functions) + {sourceSite : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {operation : IxIR1.Op} {world : Owned} {sourceAtom : IxIR1.Atom} + {index : Nat} {instruction : Instr} {next : CodeTrace} + (operationMatch : destructionSpec? operation = some (world, sourceAtom)) + (descendant : functionTrace.root.Descendant + (.letOp sourceSite block input nextInput entryValueCount operation index + instruction next)) + {after : PositionTrace} + (afterMember : after ∈ checked.artifact.trace.positions) + (afterCoordinate : after.coordinateMatches next.source next.sourceBlock + next.targetPosition next.sourceInputMap = true) : + ∃ before, before ∈ checked.artifact.trace.positions ∧ + before.coordinateMatches sourceSite block (.instruction index) input = + true ∧ + before.destructionResultMatches after input world sourceAtom = true := by + have rootMatch := Trace.functionDestructionCapabilitiesMatch + checked.destructionCapabilities member + exact CodeTrace.destructionTransition_of_match + checked.artifact.trace.positions operationMatch + (descendant.destructionCapabilitiesMatch + checked.artifact.trace.positions rootMatch) + afterMember afterCoordinate + +/-- Recover the exact checked schema at any retained ordinary allocation in a +function trace belonging to this artifact. -/ +theorem allocationSchema (checked : Checked) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ checked.artifact.trace.functions) + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {world : Owned} {identity : CtorId} + {arguments : Array IxIR1.Atom} {index : Nat} + {instruction : Instr} {next : CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp source block input nextInput entryValueCount + (.alloc world identity arguments) index instruction next)) : + ∃ schema, + checked.artifact.validationContext.schemas world identity = some schema ∧ + schema.fields = Array.replicate arguments.size world := by + have rootMatch := checked.artifact.trace.functionAllocationSchemasMatch + checked.allocationSchemas member + exact CodeTrace.allocationSchema_of_match + checked.artifact.validationContext.schemas + (descendant.allocationSchemasMatch + checked.artifact.validationContext.schemas rootMatch) + +/-- Recover the producer capability position at any retained allocation. -/ +theorem allocationPosition (checked : Checked) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ checked.artifact.trace.functions) + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {world : Owned} {identity : CtorId} + {arguments : Array IxIR1.Atom} {index : Nat} + {instruction : Instr} {next : CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp source block input nextInput entryValueCount + (.alloc world identity arguments) index instruction next)) : + ∃ position, position ∈ checked.artifact.trace.positions ∧ + position.allocationMatches source block index input world arguments = + true := by + have rootMatch := Trace.functionAllocationCapabilitiesMatch + checked.allocationCapabilities member + exact CodeTrace.allocationPosition_of_capabilities_match + checked.artifact.trace.positions + (descendant.allocationCapabilitiesMatch + checked.artifact.trace.positions rootMatch) + +/-- Recover the exact sequential consume-and-bind transition at any retained +ordinary allocation. -/ +theorem allocationTransition (checked : Checked) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ checked.artifact.trace.functions) + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {world : Owned} {identity : CtorId} + {arguments : Array IxIR1.Atom} {index : Nat} + {instruction : Instr} {next : CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp source block input nextInput entryValueCount + (.alloc world identity arguments) index instruction next)) + {after : PositionTrace} + (afterMember : after ∈ checked.artifact.trace.positions) + (afterCoordinate : after.coordinateMatches next.source next.sourceBlock + next.targetPosition next.sourceInputMap = true) : + ∃ before, before ∈ checked.artifact.trace.positions ∧ + before.coordinateMatches source block (.instruction index) input = true ∧ + before.allocationResultMatches after input world arguments = true := by + have rootMatch := Trace.functionAllocationCapabilitiesMatch + checked.allocationCapabilities member + exact CodeTrace.allocationTransition_of_capabilities_match + checked.artifact.trace.positions + (descendant.allocationCapabilitiesMatch + checked.artifact.trace.positions rootMatch) + afterMember afterCoordinate + +/-- Recover the exact shared capture consumption and fresh-owner transition at +any retained function partial application. -/ +theorem pappTransition (checked : Checked) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ checked.artifact.trace.functions) + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {address : Address} {arguments : Array IxIR1.Atom} {index : Nat} + {instruction : Instr} {next : CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp source block input nextInput entryValueCount + (.papp address arguments) index instruction next)) + {after : PositionTrace} + (afterMember : after ∈ checked.artifact.trace.positions) + (afterCoordinate : after.coordinateMatches next.source next.sourceBlock + next.targetPosition next.sourceInputMap = true) : + ∃ before, before ∈ checked.artifact.trace.positions ∧ + before.coordinateMatches source block (.instruction index) input = true ∧ + before.allocationResultMatches after input .shared arguments = true := by + have rootMatch := Trace.functionAllocationCapabilitiesMatch + checked.allocationCapabilities member + exact CodeTrace.pappTransition_of_capabilities_match + checked.artifact.trace.positions + (descendant.allocationCapabilitiesMatch + checked.artifact.trace.positions rootMatch) + afterMember afterCoordinate + +/-- Recover the exact shared function/argument consumption and shared-result +binding transition at any retained dynamic application. -/ +theorem applyTransition (checked : Checked) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ checked.artifact.trace.functions) + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {function : IxIR1.Atom} {arguments : Array IxIR1.Atom} {index : Nat} + {instruction : Instr} {next : CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp source block input nextInput entryValueCount + (.apply function arguments) index instruction next)) + {after : PositionTrace} + (afterMember : after ∈ checked.artifact.trace.positions) + (afterCoordinate : after.coordinateMatches next.source next.sourceBlock + next.targetPosition next.sourceInputMap = true) : + ∃ before, before ∈ checked.artifact.trace.positions ∧ + before.coordinateMatches source block (.instruction index) input = true ∧ + before.applyResultMatches after input function arguments = true := by + have rootMatch := Trace.functionApplyCapabilitiesMatch + checked.applyCapabilities member + exact CodeTrace.applyTransition_of_capabilities_match + checked.artifact.trace.positions + (descendant.applyCapabilitiesMatch checked.artifact.trace.positions + rootMatch) + afterMember afterCoordinate + +/-- A caller-selected schema lookup at a retained allocation is necessarily +the exact uniform schema certified by the checked compiler trace. -/ +theorem allocationSchemaFields (checked : Checked) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ checked.artifact.trace.functions) + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {world : Owned} {identity : CtorId} + {arguments : Array IxIR1.Atom} {index : Nat} + {instruction : Instr} {next : CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp source block input nextInput entryValueCount + (.alloc world identity arguments) index instruction next)) + {schema : CtorSchema} + (schemaAt : checked.artifact.validationContext.schemas world identity = + some schema) : + schema.fields = Array.replicate arguments.size world := by + obtain ⟨found, foundAt, fields⟩ := checked.allocationSchema member descendant + have equal : found = schema := Option.some.inj (foundAt.symm.trans schemaAt) + simpa [equal] using fields + +/-- Recover the complete call/return capability audit for one retained +function. -/ +theorem functionCallCapabilitiesMatch (checked : Checked) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ checked.artifact.trace.functions) : + functionTrace.callCapabilitiesMatch checked.artifact.trace.positions + checked.artifact.program.declarations = true := + checked.artifact.trace.functionCallCapabilitiesMatch + checked.callCapabilities member + +/-- Recover the canonical capability vector at any retained function root. -/ +theorem entryCapabilities (checked : Checked) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ checked.artifact.trace.functions) + {position : PositionTrace} + (positionMember : position ∈ checked.artifact.trace.positions) + (coordinate : position.coordinateMatches functionTrace.root.source + functionTrace.root.sourceBlock functionTrace.root.targetPosition + functionTrace.root.sourceInputMap = true) : + position.sourceCapabilities = + Lower.entryCapabilities functionTrace.generated.signature := by + exact FunctionTrace.entryCapabilities_of_call_match + (checked.functionCallCapabilitiesMatch member) positionMember coordinate + +/-- PAP safety in a checked artifact exposes the exact all-owned/shared +capability vector expected at the dynamically selected callee root. -/ +theorem papSafeEntryCapabilities (checked : Checked) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ checked.artifact.trace.functions) + (papSafe : functionTrace.generated.signature.papSafe = true) : + Lower.entryCapabilities functionTrace.generated.signature = + Array.replicate functionTrace.generated.signature.params.size + (.owned .shared) := by + have point := checked.artifact.trace.functionSharedPapEntryCapabilitiesMatch + checked.sharedPapEntryCapabilities member + unfold FunctionTrace.sharedPapEntryCapabilitiesMatch at point + rw [papSafe] at point + exact beq_iff_eq.mp point + +/-- A retained declaration trace exposes the exact signature used by checked +addressed calls. -/ +theorem targetSignature (checked : Checked) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ checked.artifact.trace.functions) + {address : Address} (owner : functionTrace.owner = .declaration address) : + targetSignature? checked.artifact.program.declarations address = + some functionTrace.generated.signature := + checked.artifact.trace.targetSignature_of_call_match + checked.callCapabilities member owner + +/-- Recover an addressed ordinary call's exact consume/suspend/result-bind +transition. -/ +theorem callTransition (checked : Checked) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ checked.artifact.trace.functions) + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {address : Address} {signature : Signature} + {arguments : Array IxIR1.Atom} {index : Nat} {instruction : Instr} + {next : CodeTrace} {before : PositionTrace} + (signatureAt : targetSignature? checked.artifact.program.declarations + address = some signature) + (descendant : functionTrace.root.Descendant + (.letOp source block input nextInput entryValueCount + (.call address arguments) index instruction next)) + (beforeMember : before ∈ checked.artifact.trace.positions) + (beforeCoordinate : before.coordinateMatches source block + (.instruction index) input = true) + {after : PositionTrace} + (afterMember : after ∈ checked.artifact.trace.positions) + (afterCoordinate : after.coordinateMatches next.source next.sourceBlock + next.targetPosition next.sourceInputMap = true) : + before.callResultMatches after input signature arguments = true := by + have rootMatch := checked.functionCallCapabilitiesMatch member + simp only [FunctionTrace.callCapabilitiesMatch, + Bool.and_eq_true] at rootMatch + exact CodeTrace.callTransition_of_capabilities_match + checked.artifact.trace.positions checked.artifact.program.declarations + functionTrace.generated.signature signatureAt + (descendant.callCapabilitiesMatch checked.artifact.trace.positions + checked.artifact.program.declarations + functionTrace.generated.signature rootMatch.2) + beforeMember beforeCoordinate afterMember afterCoordinate + +/-- Recover a self call's exact consume/suspend/result-bind transition. -/ +theorem callSelfTransition (checked : Checked) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ checked.artifact.trace.functions) + {source : SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount : Nat} + {arguments : Array IxIR1.Atom} {index : Nat} {instruction : Instr} + {next : CodeTrace} {before : PositionTrace} + (descendant : functionTrace.root.Descendant + (.letOp source block input nextInput entryValueCount + (.callSelf arguments) index instruction next)) + (beforeMember : before ∈ checked.artifact.trace.positions) + (beforeCoordinate : before.coordinateMatches source block + (.instruction index) input = true) + {after : PositionTrace} + (afterMember : after ∈ checked.artifact.trace.positions) + (afterCoordinate : after.coordinateMatches next.source next.sourceBlock + next.targetPosition next.sourceInputMap = true) : + before.callResultMatches after input + functionTrace.generated.signature arguments = true := by + have rootMatch := checked.functionCallCapabilitiesMatch member + simp only [FunctionTrace.callCapabilitiesMatch, + Bool.and_eq_true] at rootMatch + exact CodeTrace.callSelfTransition_of_capabilities_match + checked.artifact.trace.positions checked.artifact.program.declarations + functionTrace.generated.signature + (descendant.callCapabilitiesMatch checked.artifact.trace.positions + checked.artifact.program.declarations + functionTrace.generated.signature rootMatch.2) + beforeMember beforeCoordinate afterMember afterCoordinate + +/-- Recover an addressed tail call's exact all-local-owner transfer. -/ +theorem tailCallPosition (checked : Checked) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ checked.artifact.trace.functions) + {source : SourceSite} {block : BlockId} + {input : Array (Option Atom)} {entryValueCount : Nat} + {address : Address} {signature : Signature} + {arguments : Array IxIR1.Atom} {generated : Block} + (signatureAt : targetSignature? checked.artifact.program.declarations + address = some signature) + (descendant : functionTrace.root.Descendant + (.tailCall source block input entryValueCount address arguments generated)) : + ∃ position, position ∈ checked.artifact.trace.positions ∧ + position.tailCallMatches source block input signature arguments = true := by + have rootMatch := checked.functionCallCapabilitiesMatch member + simp only [FunctionTrace.callCapabilitiesMatch, + Bool.and_eq_true] at rootMatch + exact CodeTrace.tailCallPosition_of_capabilities_match + checked.artifact.trace.positions checked.artifact.program.declarations + functionTrace.generated.signature signatureAt + (descendant.callCapabilitiesMatch checked.artifact.trace.positions + checked.artifact.program.declarations + functionTrace.generated.signature rootMatch.2) + +/-- Recover result ownership agreement at an addressed tail call. -/ +theorem tailCallResult (checked : Checked) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ checked.artifact.trace.functions) + {source : SourceSite} {block : BlockId} + {input : Array (Option Atom)} {entryValueCount : Nat} + {address : Address} {signature : Signature} + {arguments : Array IxIR1.Atom} {generated : Block} + (signatureAt : targetSignature? checked.artifact.program.declarations + address = some signature) + (descendant : functionTrace.root.Descendant + (.tailCall source block input entryValueCount address arguments generated)) : + signature.result = functionTrace.generated.signature.result := by + have rootMatch := checked.functionCallCapabilitiesMatch member + simp only [FunctionTrace.callCapabilitiesMatch, + Bool.and_eq_true] at rootMatch + exact CodeTrace.tailCallResult_of_capabilities_match + checked.artifact.trace.positions checked.artifact.program.declarations + functionTrace.generated.signature signatureAt + (descendant.callCapabilitiesMatch checked.artifact.trace.positions + checked.artifact.program.declarations + functionTrace.generated.signature rootMatch.2) + +/-- Recover a self tail call's exact all-local-owner transfer. -/ +theorem tailCallSelfPosition (checked : Checked) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ checked.artifact.trace.functions) + {source : SourceSite} {block : BlockId} + {input : Array (Option Atom)} {entryValueCount : Nat} + {arguments : Array IxIR1.Atom} {generated : Block} + (descendant : functionTrace.root.Descendant + (.tailCallSelf source block input entryValueCount arguments generated)) : + ∃ position, position ∈ checked.artifact.trace.positions ∧ + position.tailCallMatches source block input + functionTrace.generated.signature arguments = true := by + have rootMatch := checked.functionCallCapabilitiesMatch member + simp only [FunctionTrace.callCapabilitiesMatch, + Bool.and_eq_true] at rootMatch + exact CodeTrace.tailCallSelfPosition_of_capabilities_match + checked.artifact.trace.positions checked.artifact.program.declarations + functionTrace.generated.signature + (descendant.callCapabilitiesMatch checked.artifact.trace.positions + checked.artifact.program.declarations + functionTrace.generated.signature rootMatch.2) + +/-- Recover the exact result-owner transfer at a retained return. -/ +theorem returnPositionMatch (checked : Checked) + {functionTrace : FunctionTrace} + (member : functionTrace ∈ checked.artifact.trace.functions) + {source : SourceSite} {block : BlockId} + {input : Array (Option Atom)} {entryValueCount : Nat} + {atom : IxIR1.Atom} {target : Atom} {generated : Block} + (descendant : functionTrace.root.Descendant + (.ret source block input entryValueCount atom target generated)) + {position : PositionTrace} + (positionMember : position ∈ checked.artifact.trace.positions) + (coordinate : position.coordinateMatches source block .terminator input = + true) : + position.returnMatches source block input + functionTrace.generated.signature.result atom = true := by + have rootMatch := checked.functionCallCapabilitiesMatch member + simp only [FunctionTrace.callCapabilitiesMatch, + Bool.and_eq_true] at rootMatch + exact CodeTrace.returnPositionMatch_of_capabilities_match + checked.artifact.trace.positions checked.artifact.program.declarations + functionTrace.generated.signature + (descendant.callCapabilitiesMatch checked.artifact.trace.positions + checked.artifact.program.declarations + functionTrace.generated.signature rootMatch.2) + positionMember coordinate + +end Checked + +private def sourceDeclAt? + (declarations : List (Address × IxIR1.Decl)) (address : Address) : + Option IxIR1.Decl := + (declarations.find? fun entry => entry.1 == address).map (fun entry => entry.2) + +private def duplicateAddress? : + List (Address × IxIR1.Decl) → Option Address + | [] => none + | (address, _) :: rest => + if rest.any fun entry => entry.1 == address then some address + else duplicateAddress? rest + +private def signatureOf (context : Context) (owner : Validate.Owner) + (address : Address) (definition : IxIR1.FnDef) : Except Error Signature := do + let worlds ← match context.parameterWorlds address with + | some worlds => pure worlds + | none => .error (.missingParameterWorlds address) + if worlds.size != definition.arity then + .error (.signature owner "parameter-world arity does not match IxIR₁") + else + let parameters := worlds.map fun world => + ({ world, passing := .owned } : Param) + let signature : Signature := + { params := parameters + result := definition.result + papSafe := definition.papSafe } + if signature.papSafe && + !(signature.result == .shared && + signature.params.all fun parameter => parameter.world == .shared) then + .error (.signature owner "IxIR₁ papSafe declaration is not all-shared") + else + return signature + +private def declarationSignature (context : Context) + (declarations : List (Address × IxIR1.Decl)) (site : SourceSite) + (address : Address) : Except Error Signature := do + match sourceDeclAt? declarations address with + | some (.fn definition) => + signatureOf context (.declaration address) address definition + | some (.extern _) => + .error (.source site "compiler call expected a function declaration") + | none => .error (.source site "call target is not declared") + +structure Binding where + atom : Atom + cap : BindingCap + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +abbrev SourceEnv := Array Binding + +/-- Runtime operand retained for a live compiler binding. -/ +def Binding.inputAtom (binding : Binding) : Option Atom := + match binding.cap with + | .dead => none + | _ => some binding.atom + +def SourceEnv.inputMap (env : SourceEnv) : Array (Option Atom) := + env.map Binding.inputAtom + +structure Local where + env : SourceEnv + valueParams : Array ValueCap + instructions : Array Instr := #[] + nextValue : Nat + +def Local.inputMap (cursor : Local) : Array (Option Atom) := + cursor.env.inputMap + +private def sourceAtom (site : SourceSite) (env : SourceEnv) : + IxIR1.Atom → Except Error (Atom × BindingCap) + | .lit literal => return (.lit literal, .scalar) + | .erased => return (.erased, .scalar) + | .var index => + match env[index]? with + | none => .error (.source site s!"unbound IxIR₁ variable {index}") + | some { cap := .dead, .. } => + .error (.ownership site s!"IxIR₁ variable {index} was already consumed") + | some binding => return (binding.atom, binding.cap) + +private def setDead (site : SourceSite) (env : SourceEnv) (index : Nat) : + Except Error SourceEnv := + match env[index]? with + | none => .error (.source site s!"unbound IxIR₁ variable {index}") + | some binding => + let consumed := env.setIfInBounds index { binding with cap := .dead } + match binding.atom with + | .reg lender => + return consumed.map fun candidate => + { candidate with + cap := candidate.cap.retireLender lender } + | .lit _ | .erased => return consumed + +private def consumeExpected (site : SourceSite) (expected : Owned) + (env : SourceEnv) (source : IxIR1.Atom) : + Except Error (SourceEnv × Atom) := do + let (atom, capability) ← sourceAtom site env source + match source, capability with + | .lit _, .scalar | .erased, .scalar => return (env, atom) + | .var _, .scalar => return (env, atom) + | .var index, .owned world => + if world == expected then return (← setDead site env index, atom) + else .error (.ownership site "operand has the wrong ownership world") + | .var _, .borrowed .. => + .error (.ownership site "a borrowed value cannot cross an owned boundary") + | _, .dead => + .error (.internal "dead source binding escaped sourceAtom") + | _, _ => .error (.ownership site "invalid scalar capability") + +private def consumeConcrete (site : SourceSite) (expected : Owned) + (env : SourceEnv) (source : IxIR1.Atom) : + Except Error (SourceEnv × ValueId) := do + let (atom, capability) ← sourceAtom site env source + match source, atom, capability with + | .var index, .reg id, .owned world => + if world == expected then return (← setDead site env index, id) + else .error (.ownership site "constructor operand has the wrong world") + | .var _, _, .scalar => + .error (.ownership site "a concrete constructor location was required") + | .var _, _, .borrowed .. => + .error (.ownership site "a borrowed constructor cannot be consumed") + | _, _, _ => + .error (.ownership site "a concrete constructor register was required") + +private def observeExpected (site : SourceSite) (expected : Owned) + (env : SourceEnv) (source : IxIR1.Atom) : Except Error Atom := do + let (atom, capability) ← sourceAtom site env source + match capability with + | .scalar => return atom + | .owned world | .borrowed world _ => + if world == expected then return atom + else .error (.ownership site "observed operand has the wrong world") + | .dead => .error (.internal "dead source binding escaped sourceAtom") + +private def requireScalar (site : SourceSite) (env : SourceEnv) + (source : IxIR1.Atom) : Except Error Atom := do + let (atom, capability) ← sourceAtom site env source + match capability with + | .scalar => return atom + | _ => .error (.ownership site "extern operands must be statically scalar") + +private def consumeArguments (site : SourceSite) (env : SourceEnv) + (arguments : Array IxIR1.Atom) (worlds : Array Owned) : + Except Error (SourceEnv × Array Atom) := do + if arguments.size != worlds.size then + .error (.source site "operand count does not match its ownership signature") + else + let (env, reversed) ← + (arguments.toList.zip worlds.toList).foldlM (fun state pair => do + let (env, atom) ← consumeExpected site pair.2 state.1 pair.1 + return (env, atom :: state.2)) (env, []) + return (env, reversed.reverse.toArray) + +private def consumeSharedArguments (site : SourceSite) (env : SourceEnv) + (arguments : Array IxIR1.Atom) : Except Error (SourceEnv × Array Atom) := + consumeArguments site env arguments (Array.replicate arguments.size .shared) + +private def bindResult (cursor : Local) (instruction : Instr) + (capability : BindingCap) : Local := + { cursor with + env := #[{ atom := .reg cursor.nextValue, cap := capability }] ++ cursor.env + instructions := cursor.instructions.push instruction + nextValue := cursor.nextValue + 1 } + +private def bindEffect (cursor : Local) (instruction : Instr) : Local := + { cursor with + env := #[{ atom := .erased, cap := .scalar }] ++ cursor.env + instructions := cursor.instructions.push instruction } + +private structure EdgeView where + params : Array ValueCap + sourceInputMap : Array (Option Atom) + childEnv : SourceEnv + +private def EdgeView.arguments (view : EdgeView) : Array Atom := + EdgeTrace.explicitValuesOf view.sourceInputMap + +private def ownerParameter? (env : SourceEnv) (lender : ValueId) : Option Nat := + (List.range env.size).find? fun index => + match env[index]? with + | some { atom := .reg id, cap := .owned _ } => id == lender + | _ => false + +private def edgeView (site : SourceSite) (env : SourceEnv) : + Except Error EdgeView := do + let rec go (index : Nat) (params : Array ValueCap) + (child : SourceEnv) : Except Error EdgeView := + if h : index < env.size then + let binding := env[index] + match binding.cap with + | .dead => + go (index + 1) (params.push .scalar) + (child.push { atom := .reg index, cap := .dead }) + | .scalar => + go (index + 1) (params.push .scalar) + (child.push { atom := .reg index, cap := .scalar }) + | .owned world => + go (index + 1) (params.push (.owned world)) + (child.push { atom := .reg index, cap := .owned world }) + | .borrowed world .caller => + go (index + 1) (params.push (.borrowed world .caller)) + (child.push { atom := .reg index, cap := .borrowed world .caller }) + | .borrowed world (.value lender) => + match ownerParameter? env lender with + | none => + .error (.ownership site "edge borrow has no transferred lender") + | some targetLender => + go (index + 1) + (params.push (.borrowed world (.value targetLender))) + (child.push + { atom := .reg index + cap := .borrowed world (.value targetLender) }) + else + return { params, sourceInputMap := env.inputMap, childEnv := child } + go 0 #[] #[] + +private def shiftLender (amount : Nat) : BorrowLender → BorrowLender + | .caller => .caller + | .value id => .value (id + amount) + +private def shiftBinding (amount : Nat) (binding : Binding) : Binding := + { atom := shiftAtom amount binding.atom + cap := match binding.cap with + | .borrowed world lender => .borrowed world (shiftLender amount lender) + | capability => capability } + +structure BuildState where + blocks : Array (Option Block) := #[] + scalarLeaves : List Validate.ScalarLeafFact := [] + positions : List PositionTrace := [] + edges : List EdgeTrace := [] + +abbrev BuildM := EStateM Error BuildState + +private def reserveBlock : BuildM BlockId := do + let state ← get + let id := state.blocks.size + set { state with blocks := state.blocks.push none } + return id + +private def installBlock (id : BlockId) (block : Block) : BuildM Unit := do + let state ← get + match state.blocks[id]? with + | some none => set { state with blocks := state.blocks.setIfInBounds id (some block) } + | some (some _) => throw (.internal s!"block {id} was installed twice") + | none => throw (.internal s!"block {id} was never reserved") + +private def recordPosition (source : SourceSite) (block : BlockId) + (target : TargetPosition) (env : SourceEnv) : BuildM Unit := + modify fun state => + { state with + positions := + { source, block, target + sourceCapabilities := env.map (·.cap) } :: state.positions } + +private def recordEdge (source : SourceSite) (sourceBlock target : BlockId) + (view : EdgeView) (implicitScalars : Nat := 0) : BuildM EdgeTrace := do + let trace : EdgeTrace := + { source + sourceBlock + target + sourceInputMap := view.sourceInputMap + targetParams := view.params + implicitScalars } + modify fun state => { state with edges := trace :: state.edges } + return trace + +private def recordScalarLeaf (owner : Validate.Owner) (block : BlockId) + (value : ValueId) (cid : CtorId) : BuildM Unit := + modify fun state => + { state with scalarLeaves := { owner, block, value, cid } :: state.scalarLeaves } + +private def lookupSchema (context : Context) (site : SourceSite) + (world : Owned) (cid : CtorId) : BuildM CtorSchema := + match context.schemas world cid with + | some schema => return schema + | none => throw (.schema site "missing constructor schema") + +private def liftExcept : Except Error α → BuildM α + | .ok value => return value + | .error error => throw error + +private def lowerInstruction (context : Context) + (declarations : List (Address × IxIR1.Decl)) (signature : Signature) + (block : BlockId) (site : SourceSite) (cursor : Local) + (operation : IxIR1.Op) : BuildM Local := do + match operation with + | .pure source => + let (atom, capability) ← liftExcept (sourceAtom site cursor.env source) + let env ← match source, capability with + | .var index, .owned _ => liftExcept (setDead site cursor.env index) + | _, _ => pure cursor.env + return (bindResult { cursor with env } (.move atom) capability) + | .alloc world cid arguments => + let schema ← lookupSchema context site world cid + let (env, atoms) ← liftExcept + (consumeArguments site cursor.env arguments schema.fields) + return bindResult { cursor with env } (.alloc world cid atoms) (.owned world) + | .reuse .. => + throw (.unsupported site "raw IxIR₁ reuse is outside the baseline subset") + | .free target => + let cid ← match context.scalarFreeCtor site with + | some cid => pure cid + | none => throw (.schema site "missing checked scalar-leaf free fact") + let _ ← lookupSchema context site .unique cid + let (env, value) ← liftExcept + (consumeConcrete site .unique cursor.env target) + recordScalarLeaf site.owner block value cid + return bindEffect { cursor with env } (.freeUnique (.reg value) cid) + | .dup target => + let (atom, capability) ← liftExcept (sourceAtom site cursor.env target) + match capability with + | .scalar => + return bindResult cursor (.retainShared atom) .scalar + | .owned .shared | .borrowed .shared _ => + return bindResult cursor (.retainShared atom) (.owned .shared) + | .owned .unique | .borrowed .unique _ => + throw (.ownership site "IxIR₁ dup requires a shared operand") + | .dead => throw (.internal "dead source binding escaped sourceAtom") + | .drop target => + let (env, atom) ← liftExcept + (consumeExpected site .shared cursor.env target) + return bindEffect { cursor with env } (.releaseShared atom) + | .dropU target => + let (env, atom) ← liftExcept + (consumeExpected site .unique cursor.env target) + return bindEffect { cursor with env } (.dropUnique atom) + | .fetch target field => + let cid ← match context.fetchCtor site with + | some cid => pure cid + | none => throw (.schema site "missing exact fetch constructor") + let (atom, capability) ← liftExcept (sourceAtom site cursor.env target) + let (world, lender) ← match capability, atom with + | .owned world, .reg id => pure (world, BorrowLender.value id) + | .borrowed world lender, _ => pure (world, lender) + | .scalar, _ => throw (.ownership site "fetch requires a constructor") + | .owned _, _ => throw (.internal "owned source binding is not a register") + | .dead, _ => throw (.internal "dead source binding escaped sourceAtom") + let schema ← lookupSchema context site world cid + let fieldWorld ← match schema.fields[field]? with + | some fieldWorld => pure fieldWorld + | none => throw (.schema site s!"constructor field {field} is out of bounds") + return bindResult cursor (.fetch atom cid field) (.borrowed fieldWorld lender) + | .call address arguments => + let callee ← liftExcept + (declarationSignature context declarations site address) + let worlds := callee.params.map (fun parameter => parameter.world) + let (env, atoms) ← liftExcept + (consumeArguments site cursor.env arguments worlds) + return bindResult { cursor with env } (.call address atoms) + (.owned callee.result) + | .callSelf arguments => + let worlds := signature.params.map (fun parameter => parameter.world) + let (env, atoms) ← liftExcept + (consumeArguments site cursor.env arguments worlds) + return bindResult { cursor with env } (.callSelf atoms) + (.owned signature.result) + | .papp address arguments => + match sourceDeclAt? declarations address with + | none => throw (.source site "partial-application target is not declared") + | some (.extern arity) => + if !context.allowExtern then + throw (.unsupported site "extern partial applications are disabled") + else if arguments.size >= arity then + throw (.source site "partial application is not under-saturated") + else + let atoms ← arguments.toList.mapM fun argument => + liftExcept (requireScalar site cursor.env argument) + return bindResult cursor (.papp address atoms.toArray) (.owned .shared) + | some (.fn _) => + let callee ← liftExcept + (declarationSignature context declarations site address) + if !callee.papSafe || arguments.size >= callee.params.size then + throw (.source site "partial application target is not safely under-saturated") + else + let worlds := (callee.params.extract 0 arguments.size).map + (fun parameter => parameter.world) + let (env, atoms) ← liftExcept + (consumeArguments site cursor.env arguments worlds) + return bindResult { cursor with env } (.papp address atoms) + (.owned .shared) + | .apply function arguments => + let (env, function) ← liftExcept + (consumeExpected site .shared cursor.env function) + let (env, atoms) ← liftExcept + (consumeSharedArguments site env arguments) + return bindResult { cursor with env } (.apply function atoms) + (.owned .shared) + | .extern address arguments => + if !context.allowExtern then + throw (.unsupported site "extern instructions are disabled") + else + match sourceDeclAt? declarations address with + | some (.extern arity) => + if arguments.size != arity then + throw (.source site "extern arity mismatch") + else + let atoms ← arguments.toList.mapM fun argument => + liftExcept (requireScalar site cursor.env argument) + return bindResult cursor (.extern address atoms.toArray) .scalar + | _ => throw (.source site "extern target is not an extern declaration") + +private def initialEnv (signature : Signature) : SourceEnv := + let size := signature.params.size + (List.range size).foldl (fun env sourceIndex => + let targetIndex := size - 1 - sourceIndex + match signature.params[targetIndex]? with + | some parameter => + env.push + { atom := .reg targetIndex + cap := match parameter.passing with + | .owned => .owned parameter.world + | .borrowed => .borrowed parameter.world .caller } + | none => env) #[] + +private def duplicateAltTag? : List IxIR1.Alt → Option Nat + | [] => none + | .mk tag _ _ :: rest => + if rest.any fun + | .mk other _ _ => other == tag then some tag + else duplicateAltTag? rest + +private def finishBlocks (state : BuildState) : Except Error (Array Block) := + state.blocks.toList.mapM (fun (candidate : Option Block) => + match candidate with + | some block => (Except.ok block : Except Error Block) + | none => Except.error (Error.internal "reserved block was not installed")) + |>.map List.toArray + +/-- Fuel-bounded recursive block compiler. Exposing this worker and its state +is the proof seam for induction over the exact instruction/block generation +run retained by `CheckedRun`; production callers continue through `lower`. -/ +def compileCode (context : Context) + (declarations : List (Address × IxIR1.Decl)) (signature : Signature) + (fuel : Nat) (block : BlockId) (site : SourceSite) + (cursor : Local) (code : IxIR1.Code) : BuildM CodeTrace := do + match fuel with + | 0 => throw (.resources site) + | fuel + 1 => + match code with + | .ret source => + let (env, atom) ← liftExcept + (consumeExpected site signature.result cursor.env source) + recordPosition site block .terminator cursor.env + let generated : Block := + { valueParams := cursor.valueParams + creditParams := #[] + instructions := cursor.instructions + terminator := .ret atom } + installBlock block generated + let _ := env + return .ret site block cursor.inputMap cursor.nextValue source atom + generated + | .letOp (.call address arguments) (.ret (.var 0)) => + match sourceDeclAt? declarations address with + | some (.fn _) => + let callee ← liftExcept + (declarationSignature context declarations site address) + if callee.result == signature.result then + let worlds := callee.params.map (fun parameter => parameter.world) + let (tailEnv, atoms) ← liftExcept + (consumeArguments site cursor.env arguments worlds) + recordPosition site block .terminator cursor.env + let resultEnv : SourceEnv := + #[{ atom := .erased, cap := .owned callee.result }] ++ tailEnv + recordPosition site.next block .terminator resultEnv + let generated : Block := + { valueParams := cursor.valueParams + creditParams := #[] + instructions := cursor.instructions + terminator := .tailCall address atoms } + installBlock block generated + return .tailCall site block cursor.inputMap cursor.nextValue + address arguments generated + else + let inputMap := cursor.inputMap + let positionEnv := cursor.env + let entryValueCount := cursor.nextValue + let index := cursor.instructions.size + let cursor ← lowerInstruction context declarations signature block + site cursor (.call address arguments) + let targetInstruction ← match cursor.instructions[index]? with + | some instruction => pure instruction + | none => throw (.internal + "lowered call was not appended at its trace index") + recordPosition site block (.instruction index) positionEnv + let next ← compileCode context declarations signature fuel block + site.next cursor (.ret (.var 0)) + return .letOp site block inputMap cursor.inputMap + entryValueCount (.call address arguments) index + targetInstruction next + | _ => + let inputMap := cursor.inputMap + let positionEnv := cursor.env + let entryValueCount := cursor.nextValue + let index := cursor.instructions.size + let cursor ← lowerInstruction context declarations signature block + site cursor (.call address arguments) + let targetInstruction ← match cursor.instructions[index]? with + | some instruction => pure instruction + | none => throw (.internal + "lowered call was not appended at its trace index") + recordPosition site block (.instruction index) positionEnv + let next ← compileCode context declarations signature fuel block + site.next cursor (.ret (.var 0)) + return .letOp site block inputMap cursor.inputMap entryValueCount + (.call address arguments) index targetInstruction next + | .letOp (.callSelf arguments) (.ret (.var 0)) => + let worlds := signature.params.map (fun parameter => parameter.world) + let (tailEnv, atoms) ← liftExcept + (consumeArguments site cursor.env arguments worlds) + recordPosition site block .terminator cursor.env + let resultEnv : SourceEnv := + #[{ atom := .erased, cap := .owned signature.result }] ++ tailEnv + recordPosition site.next block .terminator resultEnv + let generated : Block := + { valueParams := cursor.valueParams + creditParams := #[] + instructions := cursor.instructions + terminator := .tailCallSelf atoms } + installBlock block generated + return .tailCallSelf site block cursor.inputMap cursor.nextValue + arguments generated + | .letOp operation rest => + let inputMap := cursor.inputMap + let positionEnv := cursor.env + let entryValueCount := cursor.nextValue + let index := cursor.instructions.size + let cursor ← lowerInstruction context declarations signature block + site cursor operation + let targetInstruction ← match cursor.instructions[index]? with + | some instruction => pure instruction + | none => throw (.internal + "lowered instruction was not appended at its trace index") + recordPosition site block (.instruction index) positionEnv + let next ← compileCode context declarations signature fuel block + site.next cursor rest + return .letOp site block inputMap cursor.inputMap entryValueCount + operation index targetInstruction next + | .case scrutinee peelNat alternatives => + if let some tag := duplicateAltTag? alternatives.toList then + throw (.source site s!"duplicate IxIR₁ case tag {tag}") + let (_, scrutineeCap) ← liftExcept + (sourceAtom site cursor.env scrutinee) + let world ← match scrutineeCap with + | .owned world | .borrowed world _ => pure world + | .scalar => pure .shared + | .dead => throw (.internal "dead source binding escaped sourceAtom") + let view ← liftExcept (edgeView site cursor.env) + let mut constructorTargets : Array CtorAlt := #[] + let mut outgoing : Array EdgeTrace := #[] + let mut children : Array CodeTrace := #[] + for pair in alternatives.toList.zipIdx do + let (.mk tag fieldCount altBody, altIndex) := pair + let caseCtors := context.caseCtors site altIndex + if caseCtors.isEmpty then + if peelNat then pure () + else throw (.schema site + "non-Nat case alternative lacks a constructor identity") + for cid in caseCtors do + if cid.cidx != tag then + throw (.schema site "case constructor tag does not match IxIR₁") + let schema ← lookupSchema context site world cid + if schema.fields.size != fieldCount then + throw (.schema site "case field count does not match constructor schema") + let child ← reserveBlock + let childSite := site.alternative altIndex + let (scrutinee, scrutineeCapability) ← liftExcept + (sourceAtom childSite view.childEnv scrutinee) + let lender ← match scrutineeCapability, scrutinee with + | .owned _, .reg id => pure (BorrowLender.value id) + | .borrowed _ lender, _ => pure lender + | _, _ => throw (.ownership childSite "constructor arm lost its scrutinee") + let mut childLocal : Local := + { env := view.childEnv + valueParams := view.params + nextValue := view.params.size } + let mut fields : SourceEnv := #[] + for field in List.range fieldCount do + let fieldWorld := schema.fields[field]! + let resultId := childLocal.nextValue + childLocal := + { childLocal with + instructions := childLocal.instructions.push + (.fetch scrutinee cid field) + nextValue := resultId + 1 } + fields := fields.push + { atom := .reg resultId + cap := .borrowed fieldWorld lender } + childLocal := + { childLocal with env := fields.reverse ++ childLocal.env } + let edge ← recordEdge site block child view + let childTrace ← compileCode context declarations signature fuel child + childSite childLocal altBody + outgoing := outgoing.push edge + children := children.push childTrace + constructorTargets := constructorTargets.push + { cid, edge := { target := child, values := view.arguments, credits := #[] } } + let natPeel ← if peelNat then do + let zero ← match sourceAlternativeAtTag? alternatives 0 with + | some (.mk _ 0 body, index) => pure (body, index) + | _ => throw (.source site "Nat peel requires a nullary zero arm") + let succ ← match sourceAlternativeAtTag? alternatives 1 with + | some (.mk _ 1 body, index) => pure (body, index) + | _ => throw (.source site "Nat peel requires a unary successor arm") + let zeroBlock ← reserveBlock + let zeroSite := site.alternative zero.2 + let zeroEdge ← recordEdge site block zeroBlock view + let zeroTrace ← compileCode context declarations signature fuel + zeroBlock zeroSite + { env := view.childEnv + valueParams := view.params + nextValue := view.params.size } zero.1 + outgoing := outgoing.push zeroEdge + children := children.push zeroTrace + let succBlock ← reserveBlock + let succSite := site.alternative succ.2 + let shifted := view.childEnv.map (shiftBinding 1) + let succEnv := + #[{ atom := .reg 0, cap := .scalar }] ++ shifted + let succParams := #[.scalar] ++ view.params + let succEdge ← recordEdge site block succBlock + { view with params := succParams } 1 + let succTrace ← compileCode context declarations signature fuel + succBlock succSite + { env := succEnv + valueParams := succParams + nextValue := succParams.size } succ.1 + outgoing := outgoing.push succEdge + children := children.push succTrace + pure (some + { zero := { target := zeroBlock, values := view.arguments, credits := #[] } + succ := { target := succBlock, values := view.arguments, credits := #[] } }) + else + pure none + if constructorTargets.isEmpty && natPeel.isNone then + throw (.source site "case has no translated alternatives") + let (targetScrutinee, _) ← + liftExcept (sourceAtom site cursor.env scrutinee) + recordPosition site block .terminator cursor.env + let generated : Block := + { valueParams := cursor.valueParams + creditParams := #[] + instructions := cursor.instructions + terminator := + .switchValue targetScrutinee constructorTargets natPeel } + installBlock block generated + return .switchValue site block cursor.inputMap cursor.nextValue + scrutinee peelNat alternatives targetScrutinee generated + outgoing.toList children.toList +termination_by fuel + +private def compileFunction (context : Context) + (declarations : List (Address × IxIR1.Decl)) (owner : Validate.Owner) + (signature : Signature) (source : IxIR1.FnDef) : + Except Error (Function × List Validate.ScalarLeafFact × Trace) := + let action : BuildM CodeTrace := do + let entry ← reserveBlock + if entry != 0 then throw (.internal "function entry block is not zero") + let params := signature.params.map fun parameter => + match parameter.passing with + | .owned => .owned parameter.world + | .borrowed => .borrowed parameter.world .caller + compileCode context declarations signature context.maxDepth entry { owner } + { env := initialEnv signature + valueParams := params + nextValue := params.size } source.body + match action.run {} with + | .error error _ => .error error + | .ok root state => do + let blocks ← finishBlocks state + let generated : Function := ⟨signature, blocks⟩ + let expectedBlocks : List (BlockId × Block) := + blocks.toList.zipIdx.map fun pair => (pair.2, pair.1) + if sourceCoherent : functionSourceMatches source generated root then + if coherent : root.blocks == expectedBlocks then + have blockOrder : root.blocks = expectedBlocks := + beq_iff_eq.mp coherent + if instructionCoherent : root.instructionsMatch then + if inputMapsCoherent : root.inputMapsMatch then + if entryValueCountsCoherent : root.entryValueCountsMatch then + if syntaxCoherent : root.syntaxMatches then + if switchCoherent : root.switchBranchesMatch then + if rootSourceCoherent : + root.source == ({ owner := owner } : SourceSite) then + let functionTrace : FunctionTrace := + { owner, source, generated, root + rootSource := beq_iff_eq.mp rootSourceCoherent + sourceOrder := functionSourceMatch_of_match sourceCoherent + instructionOrder := instructionCoherent + inputMapOrder := inputMapsCoherent + entryValueCountOrder := entryValueCountsCoherent + syntaxOrder := syntaxCoherent + switchBranchOrder := switchCoherent + blockOrder := by + simpa [generated, expectedBlocks] using blockOrder } + let trace : Trace := + { positions := state.positions.reverse + edges := state.edges.reverse + functions := [functionTrace] } + return (generated, state.scalarLeaves.reverse, trace) + else + throw (.internal + "recursive trace root has the wrong source coordinate") + else + throw (.internal + "recursive trace switch branches do not match generated edges") + else + throw (.internal + "recursive trace source and target syntax do not match") + else + throw (.internal + "recursive trace block-entry value counts do not match block parameters") + else + throw (.internal + "recursive trace source maps retarget a retained slot") + else + throw (.internal + "recursive trace instruction coordinates do not match its blocks") + else + throw (.internal "recursive trace does not match installed block order") + else + throw (.internal + "recursive trace does not match its retained source function") + +private def appendTrace (left right : Trace) : Trace := + { positions := left.positions ++ right.positions + edges := left.edges ++ right.edges + functions := left.functions ++ right.functions } + +/-- Syntax-directed baseline lowering. This constructs all validator sidecars +that depend on target block/register identities, but does not hide validation; +use `lowerChecked` at an artifact boundary. -/ +def lower (context : Context) (input : Input) : Except Error Artifact := do + let _ ← match duplicateAddress? input.declarations with + | some address => Except.error (.duplicateDeclaration address) + | none => Except.ok () + let mut declarations : List (Address × Decl) := [] + let mut scalarLeaves : List Validate.ScalarLeafFact := [] + let mut trace : Trace := {} + for entry in input.declarations do + match entry.2 with + | .extern arity => + declarations := declarations ++ [(entry.1, .extern arity)] + | .fn definition => + let owner := Validate.Owner.declaration entry.1 + let signature ← signatureOf context owner entry.1 definition + let (lowered, leaves, functionTrace) ← + compileFunction context input.declarations owner signature definition + declarations := declarations ++ [(entry.1, .fn lowered)] + scalarLeaves := scalarLeaves ++ leaves + trace := appendTrace trace functionTrace + let mainSignature : Signature := + { params := #[], result := input.mainResult, papSafe := false } + let mainSource := input.mainDefinition + let (main, mainLeaves, mainTrace) ← + compileFunction context input.declarations .main mainSignature mainSource + let mainTraceWitness : { trace // trace ∈ mainTrace.functions } ← + match membersEq : mainTrace.functions with + | [functionTrace] => + pure ⟨functionTrace, by simp [membersEq]⟩ + | _ => throw (.internal + "main compiler run did not retain exactly one function trace") + let mainFunctionTrace := mainTraceWitness.1 + let validationContext : Validate.Context := + { schemas := context.schemas + scalarLeaves := scalarLeaves ++ mainLeaves + allowExtern := context.allowExtern } + let program : Program := { declarations, main } + let fullTrace := appendTrace trace mainTrace + if mainCoherent : functionTraceMatches mainFunctionTrace .main + input.mainDefinition program.main then + if functionsCoherent : programTraceMatches input.declarations + program.declarations fullTrace.functions input.mainDefinition + program.main then + let artifact : Artifact := + { source := input + program + validationContext + trace := fullTrace + mainTrace := mainFunctionTrace + mainTraceMember := by + change mainFunctionTrace ∈ trace.functions ++ mainTrace.functions + exact List.mem_append_right trace.functions mainTraceWitness.2 + mainTraceOrder := functionTraceMatch_of_match mainCoherent + functionTraceOrder := functionsCoherent } + return artifact + else + throw (.internal + "retained function traces do not match lowered declarations") + else + throw (.internal "retained main trace does not match the lowered artifact") + +/-- The validation schema oracle in a successfully lowered artifact is the +exact oracle supplied to the lowerer. -/ +theorem validationSchemas_of_lower + {context : Context} {input : Input} {artifact : Artifact} + (produced : lower context input = .ok artifact) : + artifact.validationContext.schemas = context.schemas := by + unfold lower at produced + simp_all [Except.bind, bind, pure] + all_goals split at produced <;> try simp_all + all_goals split at produced <;> try simp_all + all_goals split at produced <;> try simp_all + all_goals split at produced <;> try simp_all + all_goals simp only [Except.pure] at produced + all_goals split at produced <;> try simp_all + all_goals split at produced <;> try simp_all + all_goals subst artifact + all_goals rfl + +/-- Proof-facing execution record for checked lowering. The ordinary +`lowerChecked` API projects the same checked artifact, while simulation can +retain the exact producer equation without executing the lowerer twice. -/ +structure CheckedRun (context : Context) (input : Input) where + checked : Checked + produced : lower context input = .ok checked.artifact + /-- The checked artifact retains the exact input passed to this run. -/ + source : checked.artifact.source = input + +namespace CheckedRun + +/-- The artifact named by the retained producer equation is validator-valid. -/ +theorem valid {context : Context} {input : Input} + (run : CheckedRun context input) : + Validate.Valid run.checked.artifact.validationContext + run.checked.artifact.program := + run.checked.valid + +end CheckedRun + +/-- Lower and validate once while retaining both exact executable equations. -/ +def lowerCheckedWithTrace (context : Context) (input : Input) : + Except Error (CheckedRun context input) := + match produced : lower context input with + | .error error => .error error + | .ok artifact => + if creditFree : CreditFree.program artifact.program then + match accepted : Validate.validate artifact.validationContext + artifact.program with + | .error error => .error (.validation error) + | .ok stats => + if positionsMatched : artifact.trace.positionsMatch then + if parameterCapabilitiesMatched : + artifact.trace.parameterCapabilitiesMatch then + if pureMatched : artifact.trace.pureCapabilitiesMatch then + if dupMatched : artifact.trace.dupCapabilitiesMatch then + if fetchMatched : artifact.trace.fetchCapabilitiesMatch then + if destructionMatched : + artifact.trace.destructionCapabilitiesMatch then + if schemasMatched : artifact.trace.allocationSchemasMatch + artifact.validationContext.schemas then + if capabilitiesMatched : + artifact.trace.allocationCapabilitiesMatch then + if terminalAllocationsBorrowFree : + artifact.trace.terminalAllocationNoBorrows then + if applyMatched : artifact.trace.applyCapabilitiesMatch then + if sharedPapEntriesMatched : + artifact.trace.sharedPapEntryCapabilitiesMatch then + if switchMatched : artifact.trace.switchCapabilitiesMatch + artifact.validationContext.schemas then + if callsMatched : artifact.trace.callCapabilitiesMatch + artifact.program.declarations then + if sourceMatched : inputEq artifact.source input then + .ok + { checked := + { artifact, stats, accepted, creditFree + positionCoordinates := positionsMatched + parameterCapabilities := + parameterCapabilitiesMatched + pureCapabilities := pureMatched + dupCapabilities := dupMatched + fetchCapabilities := fetchMatched + destructionCapabilities := destructionMatched + allocationSchemas := schemasMatched + allocationCapabilities := capabilitiesMatched + terminalAllocationNoBorrows := + terminalAllocationsBorrowFree + applyCapabilities := applyMatched + sharedPapEntryCapabilities := + sharedPapEntriesMatched + switchCapabilities := switchMatched + callCapabilities := callsMatched } + produced + source := + (inputEq_eq_true_iff _ _).mp sourceMatched } + else + .error (.internal + "lowered artifact retained the wrong source input") + else + .error (.internal + "call/return traces lack exact capability transitions") + else + .error (.internal + "switch traces lack exact capability transitions") + else + .error (.internal + "PAP-safe functions lack shared entry capabilities") + else + .error (.internal + "dynamic-application traces lack exact capability transitions") + else + .error (.internal + "terminal allocations retain borrowed capabilities") + else + .error (.internal + "allocation/PAP traces lack exact capability transitions") + else + .error (.internal + "validator accepted inconsistent allocation schemas") + else + .error (.internal + "destruction traces lack exact capability transitions") + else + .error (.internal + "fetch traces lack producer capability transitions") + else + .error (.internal + "dup traces lack producer capability transitions") + else + .error (.internal + "pure traces lack producer capability transitions") + else + .error (.internal + "source capabilities disagree with inherited block parameters") + else + .error (.internal + "recursive traces lack producer position coordinates") + else + .error (.internal "baseline lowering emitted a credit operation") + +/-- Lower and immediately validate the exact artifact returned to the caller. -/ +def lowerChecked (context : Context) (input : Input) : Except Error Checked := do + return (← lowerCheckedWithTrace context input).checked + +end Ix.Compiler.IxIR2.Lower diff --git a/Ix/Compiler/IxIR2/LowerExamples.lean b/Ix/Compiler/IxIR2/LowerExamples.lean new file mode 100644 index 000000000..78b60e78a --- /dev/null +++ b/Ix/Compiler/IxIR2/LowerExamples.lean @@ -0,0 +1,351 @@ +import Ix.Compiler.IxIR1.Eval +import Ix.Compiler.IxIR2.Eval +import Ix.Compiler.IxIR2.Lower + +/-! +# Executable structured-lowering witnesses + +These fixtures exercise producer-generated block parameters rather than +hand-written IxIR₂. They require `lowerChecked`, inspect its CFG/trace, and +compare successful IxIR₁ execution with logical IxIR₂ execution. +-/ + +namespace Ix.Compiler.IxIR2.Lower.Examples + +open Ix.Compiler.Ixon (Address Owned) +open Ix.Compiler.IxIR2 + +private def natAddress : Address := Address.replicate 0x71 +private def inspectAddress : Address := Address.replicate 0x72 +private def blockAddress : Address := Address.replicate 0x73 +private def nilLayout : LayoutId := Address.replicate 0x74 +private def consLayout : LayoutId := Address.replicate 0x75 + +private def nilCtor : CtorId := + { block := blockAddress, indIdx := 0, cidx := 0 } + +private def consCtor : CtorId := + { block := blockAddress, indIdx := 0, cidx := 1 } + +private def schemas : Owned → CtorId → Option CtorSchema + | .shared, cid => + if cid == nilCtor then + some { layout := nilLayout, fields := #[] } + else if cid == consCtor then + some { layout := consLayout, fields := #[.shared] } + else + none + | .unique, cid => + if cid == nilCtor then + some { layout := nilLayout, fields := #[] } + else + none + +private def sourceContext (input : Input) : IxIR1.Ctx := + { decls := IxIR1.Env.ofList input.declarations } + +private def targetFunction? (artifact : Artifact) (address : Address) : + Option Function := + let declaration : Option Decl := + (artifact.program.declarations.find? + fun entry => entry.1 == address).map (fun entry => entry.2) + match declaration with + | some (Decl.fn definition) => some definition + | _ => none + +private def targetRun (artifact : Artifact) (controlFuel heapFuel : Nat) := + Eval.runMain + (Eval.Context.ofProgram artifact.program artifact.validationContext.schemas) + .logical artifact.program controlFuel heapFuel + +/-! ## Literal-Nat case and tail transfer -/ + +private def natBody : IxIR1.Code := + .case (.var 0) true #[ + .mk 0 0 + (.letOp (.drop (.var 0)) (.ret (.lit (.nat 1)))), + .mk 1 1 + (.letOp (.drop (.var 1)) (.ret (.lit (.nat 0))))] + +private def natInput : Input := + { declarations := + [(natAddress, + .fn { arity := 1, result := .shared, papSafe := true, body := natBody })] + main := + .letOp (.call natAddress #[.lit (.nat 7)]) (.ret (.var 0)) + mainResult := .shared } + +private def natContext : Context := + { parameterWorlds := fun address => + if address == natAddress then some #[.shared] else none + schemas } + +private def loweredNat := lowerChecked natContext natInput + +#guard match loweredNat with + | .ok checked => + checked.stats.functions == 2 && checked.stats.blocks == 4 && + checked.stats.edges == 2 && checked.artifact.trace.edges.length == 2 && + functionTraceMatches checked.artifact.mainTrace .main + natInput.mainDefinition checked.artifact.program.main && + (match checked.artifact.trace.functions with + | [natTrace, mainTrace] => + natTrace.owner == Validate.Owner.declaration natAddress && + mainTrace.owner == Validate.Owner.main && + functionSourceMatches natTrace.source natTrace.generated + natTrace.root && + functionSourceMatches mainTrace.source mainTrace.generated + mainTrace.root && + natTrace.source.arity == 1 && + natTrace.source.result == .shared && + natTrace.source.papSafe && + mainTrace.source.arity == 0 && + mainTrace.source.result == .shared && + !mainTrace.source.papSafe && + (match natTrace.source.body with + | .case (.var 0) true alternatives => alternatives.size == 2 + | _ => false) && + (match mainTrace.source.body with + | .letOp (.call address arguments) (.ret (.var 0)) => + address == natAddress && arguments == #[.lit (.nat 7)] + | _ => false) && + natTrace.root.blocks.length == 3 && + mainTrace.root.blocks.length == 1 && + natTrace.root.switchBranchesMatch && + mainTrace.root.switchBranchesMatch && + match natTrace.root, mainTrace.root with + | .switchValue _ 0 inputMap 1 _ _ _ _ generated outgoing children, + .tailCall _ 0 mainMap 0 _ _ mainGenerated => + inputMap == #[some (.reg 0)] && mainMap.isEmpty && + outgoing.length == 2 && children.length == 2 && + natTrace.generated.blocks[0]? == some generated && + mainTrace.generated.blocks[0]? == some mainGenerated + | _, _ => false + | _ => false) && + (match checked.artifact.trace.edges with + | [zero, succ] => + zero.sourceInputMap == #[some (.reg 0)] && + zero.sourceMap == #[some (.reg 0)] && + zero.explicitValues == #[.reg 0] && + zero.implicitScalars == 0 && + succ.sourceInputMap == #[some (.reg 0)] && + succ.sourceMap == #[some (.reg 0), some (.reg 1)] && + succ.explicitValues == #[.reg 0] && + succ.implicitScalars == 1 + | _ => false) && + match targetFunction? checked.artifact natAddress with + | some definition => + definition.blocks.size == 3 && + match checked.artifact.program.main.blocks[0]? with + | some block => + match block.terminator with + | .tailCall address arguments => + address == natAddress && arguments == #[.lit (.nat 7)] + | _ => false + | _ => false + | none => false + | .error _ => false + +#guard match IxIR1.runMain (sourceContext natInput) natInput.main 20, loweredNat with + | .ok source, .ok checked => + match targetRun checked.artifact 4 1 with + | .ok target => + source.2 == target.value && target.value == .lit (.nat 0) && + source.1.live == 0 && target.store.live == 0 && + target.controlRemaining == 0 && target.heapRemaining == 0 + | .error _ => false + | _, _ => false + +/-! ## Constructor dispatch, fetched field, and explicit join environments -/ + +private def inspectBody : IxIR1.Code := + .case (.var 0) false #[ + .mk 0 0 + (.letOp (.drop (.var 0)) (.ret (.lit (.nat 0)))), + .mk 1 1 + (.letOp (.dup (.var 0)) + (.letOp (.drop (.var 2)) (.ret (.var 1))))] + +private def constructorInput : Input := + { declarations := + [(inspectAddress, + .fn + { arity := 1 + result := .shared + papSafe := true + body := inspectBody })] + main := + .letOp (.alloc .shared nilCtor #[]) + (.letOp (.alloc .shared consCtor #[.var 0]) + (.letOp (.call inspectAddress #[.var 0]) (.ret (.var 0)))) + mainResult := .shared } + +private def constructorContext : Context := + { parameterWorlds := fun address => + if address == inspectAddress then some #[.shared] else none + schemas + caseCtors := fun site alternative => + if site.owner == Validate.Owner.declaration inspectAddress && + site.branches.isEmpty && site.offset == 0 then + if alternative == 0 then [nilCtor] + else if alternative == 1 then [consCtor] + else [] + else + [] } + +private def loweredConstructor := lowerChecked constructorContext constructorInput + +#guard match loweredConstructor with + | .ok checked => + checked.stats.blocks == 4 && checked.stats.edges == 2 && + checked.artifact.trace.edges.length == 2 && + checked.artifact.trace.positionsMatch && + checked.artifact.trace.pureCapabilitiesMatch && + checked.artifact.trace.dupCapabilitiesMatch && + checked.artifact.trace.fetchCapabilitiesMatch && + checked.artifact.trace.allocationCapabilitiesMatch && + checked.artifact.trace.positions.any fun position => + position.source.owner == Validate.Owner.main && + position.source.branches.isEmpty && + position.source.offset == 1 && position.block == 0 && + position.target == .instruction 1 && + position.sourceCapabilities == #[.owned .shared] && + match targetFunction? checked.artifact inspectAddress with + | some definition => + definition.blocks.size == 3 && + definition.blocks[2]!.instructions[0]? == + some (.fetch (.reg 0) consCtor 0) + | none => false + | .error _ => false + +private def returnedCtorIxIR1 (out : IxIR1.Store × IxIR1.RVal) : + Option CtorId := + match out.2 with + | .loc location => + match out.1.get? location with + | some { node := .ctorN cid _, .. } => some cid + | _ => none + | _ => none + +private def returnedCtorIxIR2 (out : Eval.Result) : Option CtorId := + match out.value with + | .loc location => + match out.store.get? location with + | some { node := .ctorN cid _, .. } => some cid + | _ => none + | _ => none + +#guard match + IxIR1.runMain (sourceContext constructorInput) constructorInput.main 50, + loweredConstructor with + | .ok source, .ok checked => + match targetRun checked.artifact 8 2 with + | .ok target => + returnedCtorIxIR1 source == some nilCtor && + returnedCtorIxIR2 target == some nilCtor && + source.1.live == 1 && target.store.live == 1 && + source.1.allocs == target.store.counters.allocs && + source.1.frees == target.store.counters.frees && + source.1.rcops == target.store.counters.rcops && + target.controlRemaining == 0 && target.heapRemaining == 0 + | .error _ => false + | _, _ => false + +/-! ## Owner-sensitive scalar-leaf facts -/ + +private def freeInput : Input := + { declarations := [] + main := + .letOp (.alloc .unique nilCtor #[]) + (.letOp (.free (.var 0)) (.ret .erased)) + mainResult := .shared } + +private def freeContext : Context := + { schemas + scalarFreeCtor := fun site => + if site.owner == Validate.Owner.main && site.branches.isEmpty && + site.offset == 1 then some nilCtor else none } + +#guard match lowerChecked freeContext freeInput with + | .ok checked => + checked.artifact.validationContext.scalarLeaves == + [{ owner := .main, block := 0, value := 0, cid := nilCtor }] && + match targetRun checked.artifact 3 0 with + | .ok target => + target.value == .erased && target.store.live == 0 && + target.store.counters.allocs == 1 && + target.store.counters.frees == 1 + | .error _ => false + | .error _ => false + +/-! ## Dead ownership slots at CFG edges -/ + +/-- `pure` moves the only owner into a new source binder. The older runtime +slot still contains the same location in IxIR₁, but it is dead and must not +be related to the successor's deliberately erased block parameter. -/ +private def deadEdgeInput : Input := + { declarations := [] + main := + .letOp (.alloc .shared nilCtor #[]) + (.letOp (.pure (.var 0)) + (.case (.var 0) false #[ + .mk 0 0 + (.letOp (.drop (.var 0)) (.ret (.lit (.nat 9))))])) + mainResult := .shared } + +private def deadEdgeContext : Context := + { schemas + caseCtors := fun site alternative => + if site.owner == Validate.Owner.main && site.branches.isEmpty && + site.offset == 2 && alternative == 0 then + [nilCtor] + else + [] } + +private def loweredDeadEdge := lowerChecked deadEdgeContext deadEdgeInput + +#guard match loweredDeadEdge with + | .ok checked => + match checked.artifact.trace.edges with + | [edge] => + edge.sourceInputMap == #[some (.reg 1), none] && + edge.sourceMap == #[some (.reg 0), none] && + edge.explicitValues == #[.reg 1, .erased] && + edge.targetParams == #[.owned .shared, .scalar] && + edge.implicitScalars == 0 + | _ => false + | .error _ => false + +#guard match + IxIR1.runMain (sourceContext deadEdgeInput) deadEdgeInput.main 20, + loweredDeadEdge with + | .ok source, .ok checked => + match targetRun checked.artifact 5 10 with + | .ok target => + source.2 == .lit (.nat 9) && target.value == source.2 && + source.1.live == 0 && target.store.live == 0 && + target.controlRemaining == 0 + | .error _ => false + | _, _ => false + +/-! ## Fail-closed source boundaries -/ + +private def reuseInput : Input := + { declarations := [] + main := + .letOp (.alloc .unique nilCtor #[]) + (.letOp (.reuse (.var 0) nilCtor #[]) (.ret (.var 0))) + mainResult := .unique } + +#guard match lowerChecked freeContext reuseInput with + | .error (.unsupported { owner := .main, branches := [], offset := 1 } + "raw IxIR₁ reuse is outside the baseline subset") => true + | _ => false + +private def missingWorlds : Context := { schemas } + +#guard match lowerChecked missingWorlds natInput with + | .error (.missingParameterWorlds address) => address == natAddress + | _ => false + +end Ix.Compiler.IxIR2.Lower.Examples diff --git a/Ix/Compiler/IxIR2/LowerSim.lean b/Ix/Compiler/IxIR2/LowerSim.lean new file mode 100644 index 000000000..5ff941a17 --- /dev/null +++ b/Ix/Compiler/IxIR2/LowerSim.lean @@ -0,0 +1,12906 @@ +import Ix.Compiler.IxIR1.NoReuse +import Ix.Compiler.IxIR2.Eval +import Ix.Compiler.IxIR2.Lower + +/-! +# Compositional simulation interface for structured lowering + +This file fixes the theorem shape before the proof is scaled over every +instruction. Its foundation packages source allocation order and bounded +roots into a no-reuse-preserved recursive runtime invariant, and uses partial +source-slot maps so ownership-dead +bindings cannot resolve across a CFG edge, discharges scalar and vector +operand resolution, extends or safely forgets related environments across +value and erased bindings, establishes canonical call-entry environments, +derives canonical successor environments from actual generated-edge operand +resolution (including implicit scalar prefixes), +and closes the public small-step cases for IxIR₁ `pure`/IxIR₂ `move`, exact +ordinary constructor allocation, scalar and heap-bearing shared-retain paths, +scalar and fully recursive shared-release paths, scalar unique drop, checked +scalar-leaf unique free, general recursive unique destruction, checked +non-consuming projection, exact function-PAP allocation, direct/self call +entry with exact source call equations, tail entry with its source-shell +equations, constructor/Nat branch composition, under-saturated PAP extension, +exact/over-saturated PAP callee entry, return-time `applyMore` redispatch, and +both resumed and outermost returns. +-/ + +namespace Ix.Compiler.IxIR2.Lower.Sim + +open Ix.Compiler.IxIR2 + +abbrev RVal := IxIR1.RVal + +/-- The structured baseline executes against exactly the IxIR₁ heap and +does not exercise any reset/reuse-credit counters. Peak-live accounting is a +target-only observation and is intentionally omitted. -/ +structure StoreRel (source : IxIR1.Store) (target : Eval.Store) : Prop where + heap : target.heap = source + resetAttempts : target.resetAttempts = 0 + hotResets : target.hotResets = 0 + coldResets : target.coldResets = 0 + reusedPayloadUnits : target.reusedPayloadUnits = 0 + +/-- Fresh source and target stores satisfy the exact baseline relation. -/ +theorem StoreRel.initial : + StoreRel ({} : IxIR1.Store) ({} : Eval.Store) := by + constructor <;> rfl + +/-- Exact baseline heap correspondence transports the source propositional +world predicate to the target evaluator's executable world check. -/ +theorem StoreRel.hasWorld_eq_true_iff {source : IxIR1.Store} + {target : Eval.Store} (relation : StoreRel source target) + {world : Ix.Compiler.Ixon.Owned} {value : RVal} : + Eval.RVal.hasWorld target world value = true ↔ + IxIR1.Sim.HasWorld source world value := by + cases value with + | lit literal => simp [Eval.RVal.hasWorld, IxIR1.Sim.HasWorld] + | erased => simp [Eval.RVal.hasWorld, IxIR1.Sim.HasWorld] + | loc location => + simp only [Eval.RVal.hasWorld, Eval.Store.get?, relation.heap, + IxIR1.Sim.HasWorld] + cases found : source.get? location with + | none => simp + | some box => simp [beq_iff_eq] + +/-- Uniform source-world evidence discharges the target allocation check for +the uniform baseline schema carried by the pipeline. -/ +theorem StoreRel.fieldWorlds_replicate {source : IxIR1.Store} + {target : Eval.Store} (relation : StoreRel source target) + {schema : CtorSchema} {values : Array RVal} + {world : Ix.Compiler.Ixon.Owned} {count : Nat} + (schemaFields : schema.fields = Array.replicate count world) + (valueCount : values.size = count) + (worlds : ∀ value ∈ values.toList, + IxIR1.Sim.HasWorld source world value) : + Eval.FieldWorlds target schema values := by + apply Eval.FieldWorlds.of_replicate schemaFields valueCount + intro value member + exact relation.hasWorld_eq_true_iff.mpr (worlds value member) + +/-- Exact source ownership of the values consumed into a constructor is a +direct sufficient premise for the target's uniform-schema field check. -/ +theorem StoreRel.fieldWorlds_replicate_of_ownership + {source : IxIR1.Store} {target : Eval.Store} + (relation : StoreRel source target) + {schema : CtorSchema} {values : Array RVal} + {world : Ix.Compiler.Ixon.Owned} {count : Nat} + {rest : List IxIR1.Sim.Root} + (schemaFields : schema.fields = Array.replicate count world) + (valueCount : values.size = count) + (ownership : IxIR1.Sim.RootOwnership source + (IxIR1.Sim.rootsFor world values.toList ++ rest)) : + Eval.FieldWorlds target schema values := by + apply relation.fieldWorlds_replicate schemaFields valueCount + intro value member + apply ownership.roots_world ⟨world, value⟩ + apply List.mem_append_left + rw [IxIR1.Sim.rootsFor, List.mem_map] + exact ⟨value, member, rfl⟩ + +/-- A checked lowering supplies the exact uniform schema and operand arity at +one retained source allocation. Combined with source root ownership, this +discharges the target evaluator's entire `FieldWorlds` premise. -/ +theorem StoreRel.fieldWorlds_of_checked_allocation + {checked : Lower.Checked} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ checked.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount index : Nat} + {world : Ix.Compiler.Ixon.Owned} {identity : CtorId} + {sourceArguments : Array IxIR1.Atom} {instruction : Instr} + {next : Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.alloc world identity sourceArguments) index instruction next)) + {sourceStore : IxIR1.Store} {targetStore : Eval.Store} + (relation : StoreRel sourceStore targetStore) + {source : List RVal} {values : List RVal} {schema : CtorSchema} + (resolved : IxIR1.resolveAtoms source sourceArguments = .ok values) + (schemaAt : checked.artifact.validationContext.schemas world identity = + some schema) + {rest : List IxIR1.Sim.Root} + (ownership : IxIR1.Sim.RootOwnership sourceStore + (IxIR1.Sim.rootsFor world values ++ rest)) : + Eval.FieldWorlds targetStore schema values.toArray := by + apply relation.fieldWorlds_replicate_of_ownership + (checked.allocationSchemaFields functionMember descendant schemaAt) + · simpa using IxIR1.resolveAtoms_length resolved + · exact ownership + +/-- Ordinary allocation preserves the exact baseline store relation. -/ +theorem StoreRel.alloc {source : IxIR1.Store} {target : Eval.Store} + (relation : StoreRel source target) (world : Ix.Compiler.Ixon.Owned) + (node : IxIR1.Node) : + StoreRel (source.allocNode world node).1 + (target.allocNode world node).1 := by + constructor + · rw [Eval.Store.allocNode_heap, relation.heap] + · change target.resetAttempts = 0 + exact relation.resetAttempts + · change target.hotResets = 0 + exact relation.hotResets + · change target.coldResets = 0 + exact relation.coldResets + · change target.reusedPayloadUnits = 0 + exact relation.reusedPayloadUnits + +/-- Related stores choose the same fresh location. -/ +theorem StoreRel.alloc_location {source : IxIR1.Store} + {target : Eval.Store} (relation : StoreRel source target) + (world : Ix.Compiler.Ixon.Owned) (node : IxIR1.Node) : + (target.allocNode world node).2 = + (source.allocNode world node).2 := by + rw [Eval.Store.allocNode_location, relation.heap] + +/-- Updating the same node preserves exact heap correspondence. -/ +theorem StoreRel.setBox {source : IxIR1.Store} {target : Eval.Store} + (relation : StoreRel source target) (location : Nat) + (box : IxIR1.NodeBox) : + StoreRel (source.setBox location box) (target.setBox location box) := by + constructor + · rw [Eval.Store.setBox_heap, relation.heap] + · exact relation.resetAttempts + · exact relation.hotResets + · exact relation.coldResets + · exact relation.reusedPayloadUnits + +/-- Killing the same location preserves exact heap correspondence. -/ +theorem StoreRel.kill {source : IxIR1.Store} {target : Eval.Store} + (relation : StoreRel source target) (location : Nat) : + StoreRel (source.kill location) (target.kill location) := by + constructor + · rw [Eval.Store.kill_heap, relation.heap] + · exact relation.resetAttempts + · exact relation.hotResets + · exact relation.coldResets + · exact relation.reusedPayloadUnits + +/-- Charging the same RC operation preserves exact store correspondence. -/ +theorem StoreRel.rcTick {source : IxIR1.Store} {target : Eval.Store} + (relation : StoreRel source target) : + StoreRel source.rcTick target.rcTick := by + constructor + · rw [Eval.Store.rcTick_heap, relation.heap] + · exact relation.resetAttempts + · exact relation.hotResets + · exact relation.coldResets + · exact relation.reusedPayloadUnits + +/-! ## Source capability ownership -/ + +/-- Dynamic interpretation of one producer-retained source capability. +Scalars must really be non-locations; owners and borrows must name a live +value in their static world; consumed bindings impose no pointwise fact. -/ +def CapabilityHolds (store : IxIR1.Store) (capability : Lower.BindingCap) + (value : RVal) : Prop := + match capability with + | .scalar => IxIR1.Sim.rvalLocation? value = none + | .owned world | .borrowed world _ => + IxIR1.Sim.HasWorld store world value + | .dead => True + +/-- Incrementing one shared reference count preserves every pre-existing +capability fact. -/ +theorem CapabilityHolds.incRcStore {store : IxIR1.Store} {location rc : Nat} + {node : IxIR1.Node} {capability : Lower.BindingCap} {value : RVal} + (found : store.get? location = some ⟨.shared, rc, node⟩) + (holds : CapabilityHolds store capability value) : + CapabilityHolds + (IxIR1.Sim.incRcStore store location ⟨.shared, rc, node⟩) + capability value := by + cases capability with + | scalar => exact holds + | dead => trivial + | owned world => + exact IxIR1.Sim.HasWorld.incRcStore found holds + | borrowed world lender => + exact IxIR1.Sim.HasWorld.incRcStore found holds + +/-- Fresh allocation preserves every capability fact about pre-existing +values. -/ +theorem CapabilityHolds.allocNode {store : IxIR1.Store} + {allocationWorld : Ix.Compiler.Ixon.Owned} {node : IxIR1.Node} + {capability : Lower.BindingCap} {value : RVal} + (holds : CapabilityHolds store capability value) : + CapabilityHolds (store.allocNode allocationWorld node).1 capability + value := by + cases capability with + | scalar => exact holds + | dead => trivial + | owned world => exact IxIR1.Sim.HasWorld.allocNode holds + | borrowed world lender => exact IxIR1.Sim.HasWorld.allocNode holds + +/-- Exact external owners selected from a capability vector. Scalars, +borrows, and dead source slots contribute no ownership root. -/ +def rootsForCapabilities : List Lower.BindingCap → List RVal → + List IxIR1.Sim.Root + | .owned world :: capabilities, value :: values => + ⟨world, value⟩ :: rootsForCapabilities capabilities values + | _ :: capabilities, _ :: values => + rootsForCapabilities capabilities values + | _, _ => [] + +/-- The world annotation on one external root may be replaced when the same +runtime value is known in the new world. Incoming ownership multiplicity only +depends on the root's location, so all exact count equations are unchanged. -/ +theorem RootOwnership_reworldHead + {store : IxIR1.Store} {oldWorld newWorld : Ix.Compiler.Ixon.Owned} + {value : RVal} {rest : List IxIR1.Sim.Root} + (ownership : IxIR1.Sim.RootOwnership store + (⟨oldWorld, value⟩ :: rest)) + (world : IxIR1.Sim.HasWorld store newWorld value) : + IxIR1.Sim.RootOwnership store (⟨newWorld, value⟩ :: rest) := by + refine ⟨?_, ownership.edges_world, ownership.pap_shared, ?_⟩ + · intro root member + simp only [List.mem_cons] at member + cases member with + | inl equal => + subst root + exact world + | inr member => + exact ownership.roots_world root (by simp [member]) + · intro location box found + have incomingEq : IxIR1.Sim.incoming store + (⟨oldWorld, value⟩ :: rest) location = + IxIR1.Sim.incoming store + (⟨newWorld, value⟩ :: rest) location := rfl + rw [← incomingEq] + exact ownership.counts found + +/-- A producer borrow is supported by a retained owner when it is the owner +itself or is reachable through zero or more node-child edges. The relation +retains the exact pre-state heap path so destructive simulation can rebuild +that path in a restricted post-state from the surviving lender root. -/ +inductive BorrowSupport (store : IxIR1.Store) (root : RVal) : RVal → Prop where + | refl : BorrowSupport store root root + | child {location : Nat} {box : IxIR1.NodeBox} {value : RVal} : + BorrowSupport store root (.loc location) → + store.get? location = some box → + value ∈ IxIR1.Sim.nodeChildren box.node → + BorrowSupport store root value + +namespace BorrowSupport + +/-- Exact heap ownership propagates the lender's world along every retained +borrow-support edge. -/ +theorem hasWorld {store : IxIR1.Store} {roots : List IxIR1.Sim.Root} + (ownership : IxIR1.Sim.RootOwnership store roots) + {root value : RVal} {world : Ix.Compiler.Ixon.Owned} + (rootWorld : IxIR1.Sim.HasWorld store world root) + (support : BorrowSupport store root value) : + IxIR1.Sim.HasWorld store world value := by + induction support with + | refl => exact rootWorld + | @child location box value _ found member ih => + obtain ⟨actualBox, actualFound, actualWorld⟩ := ih + have boxEq : box = actualBox := + Option.some.inj (found.symm.trans actualFound) + subst actualBox + simpa [actualWorld] using ownership.edges_world found value member + +/-- Borrow support survives a shape-preserving store extension such as RC +increment or append allocation. -/ +theorem monoStore {before after : IxIR1.Store} + (extension : IxIR1.Sim.StoreGraphExtends before after) + {root value : RVal} (support : BorrowSupport before root value) : + BorrowSupport after root value := by + induction support with + | refl => exact .refl + | @child location box value _ found member ih => + cases box with + | mk world rc node => + obtain ⟨afterRc, afterFound⟩ := extension found + exact .child ih afterFound member + +/-- A borrow path rooted at a value that survives a destructive restriction +can be rebuilt in the post-state. Post-state exact ownership supplies the +liveness of each next child; reverse shape inclusion identifies the same +node contents in the pre-state. -/ +theorem ofRestricts {before after : IxIR1.Store} + (restriction : IxIR1.Sim.StoreGraphRestricts before after) + {roots : List IxIR1.Sim.Root} + (ownership : IxIR1.Sim.RootOwnership after roots) + {root value : RVal} {world : Ix.Compiler.Ixon.Owned} + (rootWorld : IxIR1.Sim.HasWorld after world root) + (support : BorrowSupport before root value) : + BorrowSupport after root value ∧ + IxIR1.Sim.HasWorld after world value := by + induction support with + | refl => exact ⟨.refl, rootWorld⟩ + | @child location beforeBox value _ beforeFound member ih => + obtain ⟨parentSupport, parentWorld⟩ := ih + obtain ⟨afterBox, afterFound, afterWorld⟩ := parentWorld + cases afterBox with + | mk boxWorld boxRc node => + obtain ⟨beforeRc, matchingBefore⟩ := restriction afterFound + have beforeBoxEq : + beforeBox = ⟨boxWorld, beforeRc, node⟩ := + Option.some.inj (beforeFound.symm.trans matchingBefore) + subst beforeBox + have valueWorld : + IxIR1.Sim.HasWorld after boxWorld value := + ownership.edges_world afterFound value member + have boxWorldEq : boxWorld = world := by + simpa only using afterWorld + refine ⟨.child parentSupport afterFound member, ?_⟩ + rw [boxWorldEq] at valueWorld + exact valueWorld + +end BorrowSupport + +/-- Rebinding an owned source slot at the de Bruijn head preserves the exact +root multiset: the old occurrence is marked dead and the same root is moved +to the front. -/ +theorem rootsForCapabilities_setDead_perm : + ∀ {capabilities : List Lower.BindingCap} {source : List RVal} + {index : Nat} {world : Ix.Compiler.Ixon.Owned} {value : RVal}, + capabilities[index]? = some (.owned world) → + source[index]? = some value → + ((⟨world, value⟩ : IxIR1.Sim.Root) :: + rootsForCapabilities (capabilities.set index .dead) source).Perm + (rootsForCapabilities capabilities source) := by + intro capabilities source index + induction index generalizing capabilities source with + | zero => + cases capabilities with + | nil => simp + | cons capability capabilities => + cases source with + | nil => simp + | cons head tail => + intro world value capabilityAt sourceAt + simp only [List.getElem?_cons_zero, Option.some.injEq] at capabilityAt sourceAt + subst capability + subst head + simp [rootsForCapabilities] + | succ index ih => + cases capabilities with + | nil => simp + | cons capability capabilities => + cases source with + | nil => simp + | cons head tail => + intro world value capabilityAt sourceAt + simp only [List.getElem?_cons_succ] at capabilityAt sourceAt + have tailPerm := ih capabilityAt sourceAt + cases capability with + | owned headWorld => + exact (List.Perm.swap _ _ _).trans + (List.Perm.cons (⟨headWorld, head⟩ : IxIR1.Sim.Root) + tailPerm) + | scalar | borrowed | dead => + simpa [rootsForCapabilities] using tailPerm + +/-- An owned capability contributes its exact source value to the ownership +root list. -/ +theorem rootsForCapabilities_owned_mem + {capabilities : Array Lower.BindingCap} {source : List RVal} + {index : Nat} {world : Ix.Compiler.Ixon.Owned} {value : RVal} + (capabilityAt : capabilities[index]? = some (.owned world)) + (sourceAt : source[index]? = some value) : + (⟨world, value⟩ : IxIR1.Sim.Root) ∈ + rootsForCapabilities capabilities.toList source := by + have moved := rootsForCapabilities_setDead_perm + (capabilities := capabilities.toList) (source := source) + (index := index) (world := world) (value := value) + (by simpa using capabilityAt) (by simpa using sourceAt) + exact moved.mem_iff.mp (by simp) + +/-- Semantic provenance for one borrowed capability. A local borrow is +supported by the owned source slot whose retained target atom is its exact +SSA lender. A caller-rooted borrow is supported by one framed external root +that remains part of whole-machine ownership while the callee is active. -/ +def BorrowProvenance (store : IxIR1.Store) (source : List RVal) + (input : Array (Option Atom)) + (capabilities : Array Lower.BindingCap) + (frameRoots : List IxIR1.Sim.Root) + (world : Ix.Compiler.Ixon.Owned) (lender : BorrowLender) + (value : RVal) : Prop := + match lender with + | .caller => + ∃ root, root ∈ frameRoots ∧ root.world = world ∧ + BorrowSupport store root.value value + | .value lenderId => + ∃ (ownerIndex : Nat) (ownerValue : RVal), + input[ownerIndex]? = some (some (Atom.reg lenderId)) ∧ + capabilities[ownerIndex]? = + some (Lower.BindingCap.owned world) ∧ + source[ownerIndex]? = some ownerValue ∧ + BorrowSupport store ownerValue value + +/-- Every owned source slot names the SSA register that acts as a possible +local borrow lender. -/ +def OwnedInputRegisters (input : Array (Option Atom)) + (capabilities : Array Lower.BindingCap) : Prop := + ∀ {index : Nat} {world : Ix.Compiler.Ixon.Owned}, + capabilities[index]? = some (.owned world) → + ∃ id, input[index]? = some (some (.reg id)) + +/-- Coordinate coherence supplies the owned-register condition used by +semantic lender transport. -/ +theorem OwnedInputRegisters.ofCoordinate + {position : Lower.PositionTrace} {source : Lower.SourceSite} + {block : BlockId} {target : Lower.TargetPosition} + {input : Array (Option Atom)} + (coordinate : position.coordinateMatches source block target input = + true) : + OwnedInputRegisters input position.sourceCapabilities := by + intro index world capabilityAt + exact position.inputReg_of_owned_coordinateMatch coordinate capabilityAt + +namespace BorrowProvenance + +/-- Prefixing one result binder transports every pre-existing borrow whose +capability tail is unchanged. The successor's checked owned-register shape +and proof-map forgetting relation recover the same concrete SSA lender at the +shifted source index. -/ +private theorem prependUnchanged + {before after : IxIR1.Store} + (extension : IxIR1.Sim.StoreGraphExtends before after) + {source : List RVal} {input afterInput : Array (Option Atom)} + {capabilities : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + {headCapability : Lower.BindingCap} {headValue : RVal} {headAtom : Atom} + (forgets : Lower.InputMap.Forgets afterInput + (#[some headAtom] ++ input)) + (afterOwners : OwnedInputRegisters afterInput + (#[headCapability] ++ capabilities)) + {world : Ix.Compiler.Ixon.Owned} {lender : BorrowLender} {value : RVal} + (provenance : BorrowProvenance before source input capabilities + frameRoots world lender value) : + BorrowProvenance after (headValue :: source) afterInput + (#[headCapability] ++ capabilities) frameRoots world lender value := by + cases lender with + | caller => + obtain ⟨root, member, rootWorld, support⟩ := provenance + exact ⟨root, member, rootWorld, support.monoStore extension⟩ + | value lenderId => + obtain ⟨ownerIndex, ownerValue, inputAt, capabilityAt, sourceAt, + support⟩ := provenance + have shiftedCapability : + (#[headCapability] ++ capabilities)[ownerIndex + 1]? = + some (.owned world) := by + simpa [Array.getElem?_append] using capabilityAt + obtain ⟨actualId, afterInputAt⟩ := + afterOwners shiftedCapability + have currentInputAt : + (#[some headAtom] ++ input)[ownerIndex + 1]? = + some (some (.reg actualId)) := + forgets (ownerIndex + 1) (.reg actualId) afterInputAt + have oldActual : input[ownerIndex]? = + some (some (.reg actualId)) := by + simpa [Array.getElem?_append] using currentInputAt + have actualEq : actualId = lenderId := by + have atomEq : (Atom.reg actualId) = .reg lenderId := + Option.some.inj (Option.some.inj (oldActual.symm.trans inputAt)) + injection atomEq + subst actualId + refine ⟨ownerIndex + 1, ownerValue, afterInputAt, + shiftedCapability, ?_, support.monoStore extension⟩ + simpa using sourceAt + +/-- When the new result is not itself borrowed, all successor borrow +provenance comes from the unchanged capability tail. -/ +private theorem prependNonBorrowed + {before after : IxIR1.Store} + (extension : IxIR1.Sim.StoreGraphExtends before after) + {source : List RVal} {input afterInput : Array (Option Atom)} + {capabilities : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + (oldBorrows : ∀ {index : Nat} {world : Ix.Compiler.Ixon.Owned} + {lender : BorrowLender} {value : RVal}, + capabilities[index]? = some (.borrowed world lender) → + source[index]? = some value → + BorrowProvenance before source input capabilities frameRoots world + lender value) + {headCapability : Lower.BindingCap} {headValue : RVal} {headAtom : Atom} + (headNotBorrowed : ∀ world lender, + headCapability ≠ .borrowed world lender) + (forgets : Lower.InputMap.Forgets afterInput + (#[some headAtom] ++ input)) + (afterOwners : OwnedInputRegisters afterInput + (#[headCapability] ++ capabilities)) : + ∀ {index : Nat} {world : Ix.Compiler.Ixon.Owned} + {lender : BorrowLender} {value : RVal}, + (#[headCapability] ++ capabilities)[index]? = + some (.borrowed world lender) → + (headValue :: source)[index]? = some value → + BorrowProvenance after (headValue :: source) afterInput + (#[headCapability] ++ capabilities) frameRoots world lender value := by + intro index world lender value capabilityAt valueAt + cases index with + | zero => + simp [Array.getElem?_append] at capabilityAt + exact (headNotBorrowed world lender capabilityAt).elim + | succ index => + simp [Array.getElem?_append] at capabilityAt valueAt + exact prependUnchanged extension forgets afterOwners + (oldBorrows capabilityAt valueAt) + +/-- Extending a borrow by one concrete heap edge preserves its recorded +lender while extending the semantic support path. -/ +private theorem child + {store : IxIR1.Store} {source : List RVal} + {input : Array (Option Atom)} + {capabilities : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + {world : Ix.Compiler.Ixon.Owned} {lender : BorrowLender} + {location : Nat} {box : IxIR1.NodeBox} {value : RVal} + (provenance : BorrowProvenance store source input capabilities frameRoots + world lender (.loc location)) + (found : store.get? location = some box) + (member : value ∈ IxIR1.Sim.nodeChildren box.node) : + BorrowProvenance store source input capabilities frameRoots world lender + value := by + cases lender with + | caller => + obtain ⟨root, rootMember, rootWorld, support⟩ := provenance + exact ⟨root, rootMember, rootWorld, .child support found member⟩ + | value lenderId => + obtain ⟨ownerIndex, ownerValue, ownerInput, ownerCapability, + ownerValueAt, support⟩ := provenance + exact ⟨ownerIndex, ownerValue, ownerInput, ownerCapability, + ownerValueAt, .child support found member⟩ + +/-- Exact ownership turns recorded lender provenance into the dynamic world +fact required by the borrowed capability. -/ +theorem hasWorld {store : IxIR1.Store} {source : List RVal} + {input : Array (Option Atom)} + {capabilities : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + {world : Ix.Compiler.Ixon.Owned} {lender : BorrowLender} + {value : RVal} + (ownership : IxIR1.Sim.RootOwnership store + (rootsForCapabilities capabilities.toList source ++ frameRoots)) + (provenance : BorrowProvenance store source input capabilities frameRoots + world lender value) : + IxIR1.Sim.HasWorld store world value := by + cases lender with + | caller => + obtain ⟨root, rootMember, rootWorld, support⟩ := provenance + have rootHas : IxIR1.Sim.HasWorld store world root.value := by + simpa [rootWorld] using ownership.roots_world root + (List.mem_append_right _ rootMember) + exact support.hasWorld ownership rootHas + | value lenderId => + obtain ⟨ownerIndex, ownerValue, ownerInput, ownerCapability, + ownerValueAt, support⟩ := provenance + have ownerHas : IxIR1.Sim.HasWorld store world ownerValue := + ownership.roots_world ⟨world, ownerValue⟩ + (List.mem_append_left _ + (rootsForCapabilities_owned_mem ownerCapability ownerValueAt)) + exact support.hasWorld ownership ownerHas + +/-- Provenance rooted at a surviving owner transports across a destructive +store restriction. -/ +theorem ofRestricts {before after : IxIR1.Store} {source : List RVal} + {input : Array (Option Atom)} + {capabilities : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + (restriction : IxIR1.Sim.StoreGraphRestricts before after) + (ownership : IxIR1.Sim.RootOwnership after + (rootsForCapabilities capabilities.toList source ++ frameRoots)) + {world : Ix.Compiler.Ixon.Owned} {lender : BorrowLender} + {value : RVal} + (provenance : BorrowProvenance before source input capabilities frameRoots + world lender value) : + BorrowProvenance after source input capabilities frameRoots world lender + value := by + cases lender with + | caller => + obtain ⟨root, rootMember, rootWorld, support⟩ := provenance + have rootHas : IxIR1.Sim.HasWorld after world root.value := by + simpa [rootWorld] using ownership.roots_world root + (List.mem_append_right _ rootMember) + exact ⟨root, rootMember, rootWorld, + (support.ofRestricts restriction ownership rootHas).1⟩ + | value lenderId => + obtain ⟨ownerIndex, ownerValue, ownerInput, ownerCapability, + ownerValueAt, support⟩ := provenance + have ownerHas : IxIR1.Sim.HasWorld after world ownerValue := + ownership.roots_world ⟨world, ownerValue⟩ + (List.mem_append_left _ + (rootsForCapabilities_owned_mem ownerCapability ownerValueAt)) + exact ⟨ownerIndex, ownerValue, ownerInput, ownerCapability, + ownerValueAt, + (support.ofRestricts restriction ownership ownerHas).1⟩ + +end BorrowProvenance + +/-- Dynamic source ownership at one producer capability position. The +pointwise clause supplies world/scalar safety for operand checks; exact root +ownership includes suspended caller roots, and every borrow carries an exact +semantic path from its producer-recorded local or caller lender. -/ +structure SourceOwnershipInvariant (store : IxIR1.Store) + (source : List RVal) (input : Array (Option Atom)) + (capabilities : Array Lower.BindingCap) + (frameRoots : List IxIR1.Sim.Root) : Prop where + length : source.length = capabilities.size + holds : ∀ {index : Nat} {capability : Lower.BindingCap} {value : RVal}, + capabilities[index]? = some capability → + source[index]? = some value → + CapabilityHolds store capability value + ownership : IxIR1.Sim.RootOwnership store + (rootsForCapabilities capabilities.toList source ++ frameRoots) + borrows : ∀ {index : Nat} {world : Ix.Compiler.Ixon.Owned} + {lender : BorrowLender} {value : RVal}, + capabilities[index]? = some (.borrowed world lender) → + source[index]? = some value → + BorrowProvenance store source input capabilities frameRoots world lender + value + +/-- Trace-indexed form threaded by the recursive worker. It is deliberately +generic over the matching flat producer position, so switch children and +instruction continuations can select their own capability vector. -/ +def SourceOwnershipAt (positions : List Lower.PositionTrace) + (trace : Lower.CodeTrace) (store : IxIR1.Store) + (source : List RVal) (frameRoots : List IxIR1.Sim.Root) : Prop := + ∀ position, + position ∈ positions → + position.coordinateMatches trace.source trace.sourceBlock + trace.targetPosition trace.sourceInputMap = true → + SourceOwnershipInvariant store source trace.sourceInputMap + position.sourceCapabilities frameRoots + +namespace SourceOwnershipAt + +private theorem sourceMapOf_zero_for_ownership + (explicitMap : Array (Option Atom)) : + Lower.EdgeTrace.sourceMapOf 0 explicitMap = explicitMap := by + apply Array.ext + · simp [Lower.EdgeTrace.sourceMapOf] + · intro index leftBound rightBound + simp [Lower.EdgeTrace.sourceMapOf] + cases explicitMap[index] with + | none => rfl + | some atom => cases atom <;> rfl + +/-- Any empty-input trace begins with the exact empty dynamic ownership +state. In particular this constructs the invariant at the closed synthetic +main root from the retained zero-arity input map. -/ +theorem empty {positions : List Lower.PositionTrace} + {trace : Lower.CodeTrace} + (inputEmpty : trace.sourceInputMap.size = 0) : + SourceOwnershipAt positions trace ({} : IxIR1.Store) [] [] := by + intro position _ coordinate + have capabilitySize := + position.sourceCapabilities_size_of_coordinateMatch coordinate + have capabilitiesEmpty : position.sourceCapabilities = #[] := + Array.eq_empty_of_size_eq_zero (capabilitySize.trans inputEmpty) + rw [capabilitiesEmpty] + have traceInputEmpty : trace.sourceInputMap = #[] := + Array.eq_empty_of_size_eq_zero inputEmpty + rw [traceInputEmpty] + refine ⟨rfl, ?_, ?_, ?_⟩ + · intro index capability value capabilityAt + simp at capabilityAt + · simpa [rootsForCapabilities] using IxIR1.Sim.RootOwnership.empty + · intro index world lender value capabilityAt + simp at capabilityAt + +end SourceOwnershipAt + +namespace SourceOwnershipInvariant + +/-- Empty main entry has no owned roots, framed roots, or scalar obligations. -/ +theorem empty : + SourceOwnershipInvariant ({} : IxIR1.Store) [] #[] #[] [] := by + refine ⟨rfl, ?_, ?_, ?_⟩ + · intro index capability value capabilityAt + simp at capabilityAt + · simpa [rootsForCapabilities] using IxIR1.Sim.RootOwnership.empty + · intro index world lender value capabilityAt + simp at capabilityAt + +/-- Focus an arbitrary producer owner at the head of the exact root list. +The remaining list still contains every suspended-frame root, which is the +shape needed by physical-reuse stack-avoidance arguments. -/ +theorem focusOwned + {store : IxIR1.Store} {source : List RVal} + {input : Array (Option Atom)} + {capabilities : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + (invariant : SourceOwnershipInvariant store source input capabilities + frameRoots) + {index : Nat} {world : Ix.Compiler.Ixon.Owned} {value : RVal} + (capabilityAt : capabilities[index]? = some (.owned world)) + (sourceAt : source[index]? = some value) : + ∃ rest, + IxIR1.Sim.RootOwnership store (⟨world, value⟩ :: rest) ∧ + ∀ root ∈ frameRoots, root ∈ rest := by + have rootMember : (⟨world, value⟩ : IxIR1.Sim.Root) ∈ + rootsForCapabilities capabilities.toList source := + rootsForCapabilities_owned_mem capabilityAt sourceAt + obtain ⟨before, after, rootsEq⟩ := List.mem_iff_append.mp rootMember + let rest := (after ++ frameRoots) ++ before + refine ⟨rest, ?_, ?_⟩ + · apply invariant.ownership.perm + rw [rootsEq] + simpa [rest, List.append_assoc] using + (List.perm_append_comm + (l₁ := before) + (l₂ := (⟨world, value⟩ : IxIR1.Sim.Root) :: + (after ++ frameRoots))) + · intro root member + simp [rest, member] + +/-- A capability accepted at an owned boundary dynamically inhabits the +requested world. -/ +theorem hasWorld_of_canConsume {store : IxIR1.Store} + {capability : Lower.BindingCap} {value : RVal} + {world : Ix.Compiler.Ixon.Owned} + (holds : CapabilityHolds store capability value) + (accepted : capability.canConsume world = true) : + IxIR1.Sim.HasWorld store world value := by + cases capability <;> cases value <;> + simp_all [CapabilityHolds, Lower.BindingCap.canConsume, + IxIR1.Sim.rvalLocation?, IxIR1.Sim.HasWorld, beq_iff_eq] + +/-- Resolve one statically accepted source operand to a value in the requested +world. -/ +theorem resolveAtom_hasWorld {store : IxIR1.Store} {source : List RVal} + {input : Array (Option Atom)} + {capabilities : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + (invariant : SourceOwnershipInvariant store source input capabilities + frameRoots) + {atom : IxIR1.Atom} {capability : Lower.BindingCap} + {world : Ix.Compiler.Ixon.Owned} {value : RVal} + (capabilityAt : Lower.sourceCapability? capabilities atom = + some capability) + (accepted : capability.canConsume world = true) + (resolved : IxIR1.resolveAtom source atom = .ok value) : + IxIR1.Sim.HasWorld store world value := by + cases atom with + | lit literal => + have valueEq : (.lit literal : RVal) = value := by + simpa [IxIR1.resolveAtom] using resolved + subst value + trivial + | erased => + have valueEq : (.erased : RVal) = value := by + simpa [IxIR1.resolveAtom] using resolved + subst value + trivial + | var index => + simp only [Lower.sourceCapability?] at capabilityAt + cases sourceAt : source[index]? with + | none => simp [IxIR1.resolveAtom, sourceAt] at resolved + | some found => + have valueEq : found = value := by + simpa [IxIR1.resolveAtom, sourceAt] using resolved + subst found + exact hasWorld_of_canConsume + (invariant.holds capabilityAt sourceAt) accepted + +/-- Retiring loans rooted at one SSA lender preserves every surviving +pointwise capability fact. -/ +private theorem retireLenderCapabilities_holds + {store : IxIR1.Store} {source : List RVal} + {capabilities : Array Lower.BindingCap} {lender : ValueId} + (holds : ∀ {index : Nat} {capability : Lower.BindingCap} {value : RVal}, + capabilities[index]? = some capability → + source[index]? = some value → + CapabilityHolds store capability value) : + ∀ {index : Nat} {capability : Lower.BindingCap} {value : RVal}, + (Lower.retireLenderCapabilities capabilities lender)[index]? = + some capability → + source[index]? = some value → + CapabilityHolds store capability value := by + intro index capability value capabilityAt valueAt + rw [Lower.retireLenderCapabilities, Array.getElem?_map] at capabilityAt + cases oldAt : capabilities[index]? with + | none => simp [oldAt] at capabilityAt + | some oldCapability => + have oldHolds := holds oldAt valueAt + simp only [oldAt, Option.map_some, Option.some.injEq] at capabilityAt + cases oldCapability with + | scalar | owned | dead => + subst capability + exact oldHolds + | borrowed world oldLender => + cases oldLender with + | caller => + subst capability + exact oldHolds + | value actual => + by_cases same : actual = lender + · simp [Lower.BindingCap.retireLender, same] at capabilityAt + subst capability + trivial + · simp [Lower.BindingCap.retireLender, same] at capabilityAt + subst capability + exact oldHolds + +/-- Loan retirement does not change the exact owned-root multiset because +borrowed and dead slots are both ownership-inert. -/ +private theorem rootsForCapabilities_retireLenderList + (lender : ValueId) : + ∀ (capabilities : List Lower.BindingCap) (source : List RVal), + rootsForCapabilities + (capabilities.map (Lower.BindingCap.retireLender lender)) source = + rootsForCapabilities capabilities source := by + intro capabilities + induction capabilities with + | nil => intro source; simp [rootsForCapabilities] + | cons capability capabilities ih => + intro source + cases source with + | nil => simp [rootsForCapabilities] + | cons value values => + cases capability with + | scalar | owned | dead => + simp [Lower.BindingCap.retireLender, rootsForCapabilities, ih] + | borrowed world oldLender => + cases oldLender with + | caller => + simp [Lower.BindingCap.retireLender, + rootsForCapabilities, ih] + | value actual => + by_cases same : actual = lender <;> + simp [Lower.BindingCap.retireLender, same, + rootsForCapabilities, ih] + +private theorem rootsForCapabilities_retireLenderCapabilities + (capabilities : Array Lower.BindingCap) (source : List RVal) + (lender : ValueId) : + rootsForCapabilities + (Lower.retireLenderCapabilities capabilities lender).toList source = + rootsForCapabilities capabilities.toList source := by + simpa [Lower.retireLenderCapabilities] using + rootsForCapabilities_retireLenderList lender capabilities.toList source + +/-- Retiring one owner and its rooted loans preserves all surviving dynamic +facts and removes exactly that owner's root. -/ +private theorem retireOwnerCapabilities_ownership + {store : IxIR1.Store} {source : List RVal} + {capabilities remaining : Array Lower.BindingCap} + {input : Array (Option Atom)} {sourceIndex : Nat} + {world : Ix.Compiler.Ixon.Owned} {value : RVal} + (holds : ∀ {index : Nat} {capability : Lower.BindingCap} + {selected : RVal}, + capabilities[index]? = some capability → + source[index]? = some selected → + CapabilityHolds store capability selected) + (capabilityAt : capabilities[sourceIndex]? = + some (.owned world)) + (sourceAt : source[sourceIndex]? = some value) + (retired : Lower.retireOwnerCapabilities? capabilities input sourceIndex = + some remaining) : + (∀ {index : Nat} {capability : Lower.BindingCap} {selected : RVal}, + remaining[index]? = some capability → + source[index]? = some selected → + CapabilityHolds store capability selected) ∧ + (((⟨world, value⟩ : IxIR1.Sim.Root) :: + rootsForCapabilities remaining.toList source).Perm + (rootsForCapabilities capabilities.toList source)) := by + unfold Lower.retireOwnerCapabilities? at retired + split at retired <;> try contradiction + next lender inputAt => + injection retired with remainingEq + subst remaining + have sourceBound : sourceIndex < capabilities.size := + (Array.getElem?_eq_some_iff.mp capabilityAt).1 + let consumed := capabilities.setIfInBounds sourceIndex .dead + have consumedHolds : + ∀ {index : Nat} {capability : Lower.BindingCap} {selected : RVal}, + consumed[index]? = some capability → + source[index]? = some selected → + CapabilityHolds store capability selected := by + intro index capability selected capabilityAt' selectedAt + by_cases same : sourceIndex = index + · subst index + simp [consumed, sourceBound] at capabilityAt' + subst capability + trivial + · have oldCapability : capabilities[index]? = some capability := by + simpa [consumed, Array.getElem?_setIfInBounds, same] using + capabilityAt' + exact holds oldCapability selectedAt + refine ⟨retireLenderCapabilities_holds consumedHolds, ?_⟩ + rw [rootsForCapabilities_retireLenderCapabilities] + have movedRoot := rootsForCapabilities_setDead_perm + (capabilities := capabilities.toList) (source := source) + (index := sourceIndex) (world := world) (value := value) + (by simpa using capabilityAt) (by simpa using sourceAt) + simpa [consumed, Array.toList_setIfInBounds] using movedRoot + +/-- A borrow surviving exact owner retirement retains valid provenance. A +local surviving lender cannot be the consumed register (that loan would have +become dead), and its distinct owned source slot is unchanged by both the +point update and lender-retirement map. -/ +private theorem retireOwnerCapabilities_borrows + {store : IxIR1.Store} {source : List RVal} + {input : Array (Option Atom)} + {capabilities remaining : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + (oldBorrows : ∀ {index : Nat} {world : Ix.Compiler.Ixon.Owned} + {lender : BorrowLender} {value : RVal}, + capabilities[index]? = some (.borrowed world lender) → + source[index]? = some value → + BorrowProvenance store source input capabilities frameRoots world lender + value) + {consumedIndex : Nat} {consumedWorld : Ix.Compiler.Ixon.Owned} + (consumedCapability : capabilities[consumedIndex]? = + some (.owned consumedWorld)) + (retired : Lower.retireOwnerCapabilities? capabilities input + consumedIndex = some remaining) + {index : Nat} {world : Ix.Compiler.Ixon.Owned} + {lender : BorrowLender} {value : RVal} + (remainingAt : remaining[index]? = some (.borrowed world lender)) + (valueAt : source[index]? = some value) : + BorrowProvenance store source input remaining frameRoots world lender + value := by + unfold Lower.retireOwnerCapabilities? at retired + split at retired <;> try contradiction + next consumedLender consumedInput => + injection retired with remainingEq + subst remaining + have consumedBound : consumedIndex < capabilities.size := + (Array.getElem?_eq_some_iff.mp consumedCapability).1 + by_cases sameIndex : consumedIndex = index + · subst index + have killedAt : + (Lower.retireLenderCapabilities + (capabilities.setIfInBounds consumedIndex .dead) + consumedLender)[consumedIndex]? = some .dead := by + rw [Lower.retireLenderCapabilities, Array.getElem?_map] + simp [consumedBound, Lower.BindingCap.retireLender] + rw [killedAt] at remainingAt + cases remainingAt + · have setAt : + (capabilities.setIfInBounds consumedIndex .dead)[index]? = + capabilities[index]? := by + simp [sameIndex] + rw [Lower.retireLenderCapabilities, Array.getElem?_map, setAt] at remainingAt + cases oldAt : capabilities[index]? with + | none => simp [oldAt] at remainingAt + | some oldCapability => + cases oldCapability with + | scalar | owned | dead => + simp [oldAt, Lower.BindingCap.retireLender] at remainingAt + | borrowed oldWorld oldLender => + cases oldLender with + | caller => + simp only [oldAt, Option.map_some, + Lower.BindingCap.retireLender, + Option.some.injEq] at remainingAt + rcases remainingAt with ⟨rfl, rfl⟩ + obtain ⟨root, rootMember, rootWorld, support⟩ := + oldBorrows oldAt valueAt + exact ⟨root, rootMember, rootWorld, support⟩ + | value oldLenderId => + by_cases sameLender : oldLenderId = consumedLender + · simp [oldAt, Lower.BindingCap.retireLender, + sameLender] at remainingAt + · simp [oldAt, Lower.BindingCap.retireLender, + sameLender] at remainingAt + rcases remainingAt with ⟨rfl, rfl⟩ + obtain ⟨ownerIndex, ownerValue, ownerInput, + ownerCapability, ownerValueAt, support⟩ := + oldBorrows oldAt valueAt + have ownerNe : consumedIndex ≠ ownerIndex := by + intro equal + subst ownerIndex + have atomEq : + (Atom.reg consumedLender) = .reg oldLenderId := + Option.some.inj + (Option.some.inj (consumedInput.symm.trans ownerInput)) + have lenderEq : consumedLender = oldLenderId := by + injection atomEq + exact sameLender lenderEq.symm + have ownerSetAt : + (capabilities.setIfInBounds consumedIndex .dead + )[ownerIndex]? = some (.owned oldWorld) := by + simpa [Array.getElem?_setIfInBounds, ownerNe] using + ownerCapability + have remainingOwner : + (Lower.retireLenderCapabilities + (capabilities.setIfInBounds consumedIndex .dead) + consumedLender)[ownerIndex]? = + some (.owned oldWorld) := by + rw [Lower.retireLenderCapabilities, Array.getElem?_map, + ownerSetAt] + rfl + exact ⟨ownerIndex, ownerValue, ownerInput, + remainingOwner, ownerValueAt, support⟩ + +/-- The exact producer `pure`/`move` capability effect preserves dynamic +source ownership. Scalars and borrows are copied without changing the root +multiset; an owned value moves its existing root from the consumed slot to the +new head. -/ +theorem move {store : IxIR1.Store} {source : List RVal} + {input afterInput : Array (Option Atom)} + {capabilities afterCapabilities : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + (invariant : SourceOwnershipInvariant store source input capabilities + frameRoots) + {headAtom : Atom} + (forgets : Lower.InputMap.Forgets afterInput (#[some headAtom] ++ input)) + (afterOwners : OwnedInputRegisters afterInput afterCapabilities) + {atom : IxIR1.Atom} {value : RVal} + (resolved : IxIR1.resolveAtom source atom = .ok value) + (transition : Lower.moveCapabilities? capabilities input atom = + some afterCapabilities) : + SourceOwnershipInvariant store (value :: source) afterInput + afterCapabilities frameRoots := by + cases atom with + | lit literal => + simp only [Lower.moveCapabilities?, Lower.sourceCapability?] at transition + injection transition with afterEq + subst afterCapabilities + have valueEq : value = .lit literal := by + simpa [IxIR1.resolveAtom] using resolved.symm + subst value + refine ⟨by simp [Array.size_append, Nat.add_comm, invariant.length], + ?_, ?_, ?_⟩ + · intro index capability value capabilityAt valueAt + cases index with + | zero => + simp [Array.getElem?_append] at capabilityAt valueAt + subst capability + subst value + trivial + | succ index => + simp [Array.getElem?_append] at capabilityAt valueAt + exact invariant.holds capabilityAt valueAt + · simpa [rootsForCapabilities] using invariant.ownership + · intro index world lender selected capabilityAt selectedAt + cases index with + | zero => simp [Array.getElem?_append] at capabilityAt + | succ index => + simp [Array.getElem?_append] at capabilityAt selectedAt + exact BorrowProvenance.prependUnchanged + (IxIR1.Sim.StoreGraphExtends.refl store) forgets afterOwners + (invariant.borrows capabilityAt selectedAt) + | erased => + simp only [Lower.moveCapabilities?, Lower.sourceCapability?] at transition + injection transition with afterEq + subst afterCapabilities + have valueEq : value = .erased := by + simpa [IxIR1.resolveAtom] using resolved.symm + subst value + refine ⟨by simp [Array.size_append, Nat.add_comm, invariant.length], + ?_, ?_, ?_⟩ + · intro index capability value capabilityAt valueAt + cases index with + | zero => + simp [Array.getElem?_append] at capabilityAt valueAt + subst capability + subst value + trivial + | succ index => + simp [Array.getElem?_append] at capabilityAt valueAt + exact invariant.holds capabilityAt valueAt + · simpa [rootsForCapabilities] using invariant.ownership + · intro index world lender selected capabilityAt selectedAt + cases index with + | zero => simp [Array.getElem?_append] at capabilityAt + | succ index => + simp [Array.getElem?_append] at capabilityAt selectedAt + exact BorrowProvenance.prependUnchanged + (IxIR1.Sim.StoreGraphExtends.refl store) forgets afterOwners + (invariant.borrows capabilityAt selectedAt) + | var sourceIndex => + cases sourceAt : source[sourceIndex]? with + | none => simp [IxIR1.resolveAtom, sourceAt] at resolved + | some found => + have valueEq : found = value := by + simpa [IxIR1.resolveAtom, sourceAt] using resolved + subst found + cases capabilityAt : capabilities[sourceIndex]? with + | none => + simp [Lower.moveCapabilities?, Lower.sourceCapability?, + capabilityAt] at transition + | some capability => + cases capability with + | dead => + simp [Lower.moveCapabilities?, Lower.sourceCapability?, + capabilityAt] at transition + | scalar => + simp only [Lower.moveCapabilities?, + Lower.sourceCapability?, capabilityAt] at transition + injection transition with afterEq + subst afterCapabilities + refine ⟨by simp [Array.size_append, Nat.add_comm, + invariant.length], ?_, ?_, ?_⟩ + · intro index capability value capabilityAt' valueAt + cases index with + | zero => + simp [Array.getElem?_append] at capabilityAt' valueAt + subst capability + subst value + exact invariant.holds capabilityAt sourceAt + | succ index => + simp [Array.getElem?_append] at capabilityAt' valueAt + exact invariant.holds capabilityAt' valueAt + · simpa [rootsForCapabilities] using invariant.ownership + · intro index world lender selected capabilityAt' selectedAt + cases index with + | zero => simp [Array.getElem?_append] at capabilityAt' + | succ index => + simp [Array.getElem?_append] at capabilityAt' selectedAt + exact BorrowProvenance.prependUnchanged + (IxIR1.Sim.StoreGraphExtends.refl store) forgets + afterOwners + (invariant.borrows capabilityAt' selectedAt) + | borrowed world lender => + simp only [Lower.moveCapabilities?, + Lower.sourceCapability?, capabilityAt] at transition + injection transition with afterEq + subst afterCapabilities + refine ⟨by simp [Array.size_append, Nat.add_comm, + invariant.length], ?_, ?_, ?_⟩ + · intro index capability value capabilityAt' valueAt + cases index with + | zero => + simp [Array.getElem?_append] at capabilityAt' valueAt + subst capability + subst value + exact invariant.holds capabilityAt sourceAt + | succ index => + simp [Array.getElem?_append] at capabilityAt' valueAt + exact invariant.holds capabilityAt' valueAt + · simpa [rootsForCapabilities] using invariant.ownership + · intro index actualWorld actualLender selected + capabilityAt' selectedAt + cases index with + | zero => + simp [Array.getElem?_append] at capabilityAt' selectedAt + rcases capabilityAt' with ⟨rfl, rfl⟩ + subst selected + exact BorrowProvenance.prependUnchanged + (IxIR1.Sim.StoreGraphExtends.refl store) forgets + afterOwners + (invariant.borrows capabilityAt sourceAt) + | succ index => + simp [Array.getElem?_append] at capabilityAt' selectedAt + exact BorrowProvenance.prependUnchanged + (IxIR1.Sim.StoreGraphExtends.refl store) forgets + afterOwners + (invariant.borrows capabilityAt' selectedAt) + | owned world => + simp only [Lower.moveCapabilities?, + Lower.sourceCapability?, capabilityAt] at transition + cases retiredEq : Lower.retireOwnerCapabilities? + capabilities input sourceIndex with + | none => simp [retiredEq] at transition + | some remaining => + simp only [retiredEq, Option.map_some, + Option.some.injEq] at transition + subst afterCapabilities + obtain ⟨remainingHolds, movedRoot⟩ := + retireOwnerCapabilities_ownership invariant.holds + capabilityAt sourceAt retiredEq + have remainingSize : remaining.size = capabilities.size := + Lower.retireOwnerCapabilities?_size retiredEq + refine ⟨by simp [Array.size_append, remainingSize, + invariant.length, Nat.add_comm], ?_, ?_, ?_⟩ + · intro index capability selected capabilityAt' selectedAt + cases index with + | zero => + simp [Array.getElem?_append] at capabilityAt' selectedAt + subst capability + subst selected + exact invariant.holds capabilityAt sourceAt + | succ index => + simp [Array.getElem?_append] at capabilityAt' selectedAt + exact remainingHolds capabilityAt' selectedAt + · apply invariant.ownership.perm + simpa [rootsForCapabilities, List.append_assoc] using + movedRoot.symm.append_right frameRoots + · intro index actualWorld lender selected capabilityAt' + selectedAt + cases index with + | zero => + simp [Array.getElem?_append] at capabilityAt' + | succ index => + simp [Array.getElem?_append] at capabilityAt' selectedAt + have remainingProvenance := + retireOwnerCapabilities_borrows invariant.borrows + capabilityAt retiredEq capabilityAt' selectedAt + exact BorrowProvenance.prependUnchanged + (IxIR1.Sim.StoreGraphExtends.refl store) forgets + afterOwners remainingProvenance + +/-- The exact producer `dup`/`retainShared` capability effect preserves +dynamic source ownership. A borrowed shared value gains its first external +root; an owned shared value gains a second root; scalars are ownership-inert. +-/ +theorem dup {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {sourceCurrent : IxIR1.FnDef} {store outputStore : IxIR1.Store} + {source : List RVal} + {input afterInput : Array (Option Atom)} + {capabilities afterCapabilities : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + (invariant : SourceOwnershipInvariant store source input capabilities + frameRoots) + {headAtom : Atom} + (forgets : Lower.InputMap.Forgets afterInput (#[some headAtom] ++ input)) + (afterOwners : OwnedInputRegisters afterInput afterCapabilities) + {atom : IxIR1.Atom} {value : RVal} + (resolved : IxIR1.resolveAtom source atom = .ok value) + (transition : Lower.dupCapabilities? capabilities atom = + some afterCapabilities) + (operationRun : IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent store + source (.dup atom) = .ok (outputStore, value)) : + SourceOwnershipInvariant outputStore (value :: source) afterInput + afterCapabilities frameRoots := by + obtain ⟨selected, selectedResolved, selectedOutput⟩ := + IxIR1.runOp_dup_success operationRun + have selectedEq : selected = value := by + exact Except.ok.inj (selectedResolved.symm.trans resolved) + subst selected + cases atom with + | lit literal => + simp only [Lower.dupCapabilities?, Lower.sourceCapability?] at transition + injection transition with afterEq + subst afterCapabilities + have valueEq : value = .lit literal := by + simpa [IxIR1.resolveAtom] using resolved.symm + subst value + have outputEq : (outputStore, IxIR1.RVal.lit literal) = + (store, IxIR1.RVal.lit literal) := selectedOutput + have storeEq : outputStore = store := congrArg Prod.fst outputEq + subst outputStore + refine ⟨by simp [Array.size_append, Nat.add_comm, invariant.length], + ?_, ?_, ?_⟩ + · intro index capability value capabilityAt valueAt + cases index with + | zero => + simp [Array.getElem?_append] at capabilityAt valueAt + subst capability + subst value + trivial + | succ index => + simp [Array.getElem?_append] at capabilityAt valueAt + exact invariant.holds capabilityAt valueAt + · simpa [rootsForCapabilities] using invariant.ownership + · exact BorrowProvenance.prependNonBorrowed + (IxIR1.Sim.StoreGraphExtends.refl store) invariant.borrows + (by intros; simp) forgets afterOwners + | erased => + simp only [Lower.dupCapabilities?, Lower.sourceCapability?] at transition + injection transition with afterEq + subst afterCapabilities + have valueEq : value = .erased := by + simpa [IxIR1.resolveAtom] using resolved.symm + subst value + have outputEq : (outputStore, IxIR1.RVal.erased) = + (store, IxIR1.RVal.erased) := selectedOutput + have storeEq : outputStore = store := congrArg Prod.fst outputEq + subst outputStore + refine ⟨by simp [Array.size_append, Nat.add_comm, invariant.length], + ?_, ?_, ?_⟩ + · intro index capability value capabilityAt valueAt + cases index with + | zero => + simp [Array.getElem?_append] at capabilityAt valueAt + subst capability + subst value + trivial + | succ index => + simp [Array.getElem?_append] at capabilityAt valueAt + exact invariant.holds capabilityAt valueAt + · simpa [rootsForCapabilities] using invariant.ownership + · exact BorrowProvenance.prependNonBorrowed + (IxIR1.Sim.StoreGraphExtends.refl store) invariant.borrows + (by intros; simp) forgets afterOwners + | var sourceIndex => + cases sourceAt : source[sourceIndex]? with + | none => simp [IxIR1.resolveAtom, sourceAt] at resolved + | some found => + have valueEq : found = value := by + simpa [IxIR1.resolveAtom, sourceAt] using resolved + subst found + cases capabilityAt : capabilities[sourceIndex]? with + | none => + simp [Lower.dupCapabilities?, Lower.sourceCapability?, + capabilityAt] at transition + | some capability => + cases capability with + | dead => + simp [Lower.dupCapabilities?, Lower.sourceCapability?, + capabilityAt] at transition + | owned world => + cases world with + | unique => + simp [Lower.dupCapabilities?, Lower.sourceCapability?, + capabilityAt] at transition + | shared => + simp only [Lower.dupCapabilities?, + Lower.sourceCapability?, capabilityAt] at transition + injection transition with afterEq + subst afterCapabilities + have sourceBound : sourceIndex < capabilities.size := + (Array.getElem?_eq_some_iff.mp capabilityAt).1 + cases value with + | lit literal => + have outputEq : (outputStore, IxIR1.RVal.lit literal) = + (store, IxIR1.RVal.lit literal) := selectedOutput + have storeEq : outputStore = store := + congrArg Prod.fst outputEq + subst outputStore + refine ⟨by simp [Array.size_append, Nat.add_comm, + invariant.length], ?_, ?_, ?_⟩ + · intro index capability value capabilityAt' valueAt + cases index with + | zero => + simp [Array.getElem?_append] at capabilityAt' valueAt + subst capability + subst value + trivial + | succ index => + simp [Array.getElem?_append] at capabilityAt' valueAt + exact invariant.holds capabilityAt' valueAt + · simpa [rootsForCapabilities] using + invariant.ownership.addNoLocation rfl + · exact BorrowProvenance.prependNonBorrowed + (IxIR1.Sim.StoreGraphExtends.refl store) + invariant.borrows (by intros; simp) forgets + afterOwners + | erased => + have outputEq : (outputStore, IxIR1.RVal.erased) = + (store, IxIR1.RVal.erased) := selectedOutput + have storeEq : outputStore = store := + congrArg Prod.fst outputEq + subst outputStore + refine ⟨by simp [Array.size_append, Nat.add_comm, + invariant.length], ?_, ?_, ?_⟩ + · intro index capability value capabilityAt' valueAt + cases index with + | zero => + simp [Array.getElem?_append] at capabilityAt' valueAt + subst capability + subst value + trivial + | succ index => + simp [Array.getElem?_append] at capabilityAt' valueAt + exact invariant.holds capabilityAt' valueAt + · simpa [rootsForCapabilities] using + invariant.ownership.addNoLocation rfl + · exact BorrowProvenance.prependNonBorrowed + (IxIR1.Sim.StoreGraphExtends.refl store) + invariant.borrows (by intros; simp) forgets + afterOwners + | loc location => + obtain ⟨box, foundBox, shared, outputEq⟩ := + selectedOutput + cases box with + | mk boxWorld rc node => + change boxWorld = .shared at shared + subst boxWorld + have storeEq : outputStore = + IxIR1.Sim.incRcStore store location + ⟨.shared, rc, node⟩ := by + simpa [IxIR1.Sim.incRcStore] using + congrArg Prod.fst outputEq + subst outputStore + refine ⟨by simp [Array.size_append, Nat.add_comm, + invariant.length], ?_, ?_, ?_⟩ + · intro index capability value capabilityAt' valueAt + cases index with + | zero => + simp [Array.getElem?_append] at capabilityAt' valueAt + subst capability + subst value + exact IxIR1.Sim.HasWorld.incRcStore foundBox + (invariant.holds capabilityAt sourceAt) + | succ index => + simp [Array.getElem?_append] at capabilityAt' valueAt + exact (invariant.holds capabilityAt' valueAt).incRcStore + foundBox + · have movedRoot := rootsForCapabilities_setDead_perm + (capabilities := capabilities.toList) + (source := source) (index := sourceIndex) + (world := .shared) + (value := IxIR1.RVal.loc location) + (by simpa using capabilityAt) + (by simpa using sourceAt) + have oldFirst := invariant.ownership.perm + (by + simpa [Array.toList_setIfInBounds, + rootsForCapabilities, + List.append_assoc] using + movedRoot.symm.append_right frameRoots) + have duplicated := oldFirst.dup foundBox + apply duplicated.perm + simpa [Array.toList_setIfInBounds, + rootsForCapabilities, + List.append_assoc] using + (List.Perm.cons + (⟨.shared, IxIR1.RVal.loc location⟩ : IxIR1.Sim.Root) + movedRoot).append_right frameRoots + · exact BorrowProvenance.prependNonBorrowed + (IxIR1.Sim.StoreGraphExtends.incRcStore + foundBox) invariant.borrows + (by intros; simp) forgets afterOwners + | borrowed world lender => + cases world with + | unique => + simp [Lower.dupCapabilities?, Lower.sourceCapability?, + capabilityAt] at transition + | shared => + simp only [Lower.dupCapabilities?, + Lower.sourceCapability?, capabilityAt] at transition + injection transition with afterEq + subst afterCapabilities + cases value with + | lit literal => + have outputEq : (outputStore, IxIR1.RVal.lit literal) = + (store, IxIR1.RVal.lit literal) := selectedOutput + have storeEq : outputStore = store := + congrArg Prod.fst outputEq + subst outputStore + refine ⟨by simp [Array.size_append, Nat.add_comm, + invariant.length], ?_, ?_, ?_⟩ + · intro index capability value capabilityAt' valueAt + cases index with + | zero => + simp [Array.getElem?_append] at capabilityAt' valueAt + subst capability + subst value + trivial + | succ index => + simp [Array.getElem?_append] at capabilityAt' valueAt + exact invariant.holds capabilityAt' valueAt + · simpa [rootsForCapabilities] using + invariant.ownership.addNoLocation rfl + · exact BorrowProvenance.prependNonBorrowed + (IxIR1.Sim.StoreGraphExtends.refl store) + invariant.borrows (by intros; simp) forgets + afterOwners + | erased => + have outputEq : (outputStore, IxIR1.RVal.erased) = + (store, IxIR1.RVal.erased) := selectedOutput + have storeEq : outputStore = store := + congrArg Prod.fst outputEq + subst outputStore + refine ⟨by simp [Array.size_append, Nat.add_comm, + invariant.length], ?_, ?_, ?_⟩ + · intro index capability value capabilityAt' valueAt + cases index with + | zero => + simp [Array.getElem?_append] at capabilityAt' valueAt + subst capability + subst value + trivial + | succ index => + simp [Array.getElem?_append] at capabilityAt' valueAt + exact invariant.holds capabilityAt' valueAt + · simpa [rootsForCapabilities] using + invariant.ownership.addNoLocation rfl + · exact BorrowProvenance.prependNonBorrowed + (IxIR1.Sim.StoreGraphExtends.refl store) + invariant.borrows (by intros; simp) forgets + afterOwners + | loc location => + obtain ⟨box, foundBox, shared, outputEq⟩ := + selectedOutput + cases box with + | mk boxWorld rc node => + change boxWorld = .shared at shared + subst boxWorld + have storeEq : outputStore = + IxIR1.Sim.incRcStore store location + ⟨.shared, rc, node⟩ := by + simpa [IxIR1.Sim.incRcStore] using + congrArg Prod.fst outputEq + subst outputStore + refine ⟨by simp [Array.size_append, Nat.add_comm, + invariant.length], ?_, ?_, ?_⟩ + · intro index capability value capabilityAt' valueAt + cases index with + | zero => + simp [Array.getElem?_append] at capabilityAt' valueAt + subst capability + subst value + exact IxIR1.Sim.HasWorld.incRcStore foundBox + (invariant.holds capabilityAt sourceAt) + | succ index => + simp [Array.getElem?_append] at capabilityAt' valueAt + exact (invariant.holds capabilityAt' valueAt).incRcStore + foundBox + · simpa [rootsForCapabilities] using + invariant.ownership.retainShared foundBox + · exact BorrowProvenance.prependNonBorrowed + (IxIR1.Sim.StoreGraphExtends.incRcStore + foundBox) invariant.borrows + (by intros; simp) forgets afterOwners + | scalar => + simp only [Lower.dupCapabilities?, Lower.sourceCapability?, + capabilityAt] at transition + injection transition with afterEq + subst afterCapabilities + have scalarHolds := invariant.holds capabilityAt sourceAt + cases value with + | loc location => + simp [CapabilityHolds, IxIR1.Sim.rvalLocation?] at scalarHolds + | lit literal => + have outputEq : (outputStore, IxIR1.RVal.lit literal) = + (store, IxIR1.RVal.lit literal) := selectedOutput + have storeEq : outputStore = store := + congrArg Prod.fst outputEq + subst outputStore + refine ⟨by simp [Array.size_append, Nat.add_comm, + invariant.length], ?_, ?_, ?_⟩ + · intro index capability value capabilityAt' valueAt + cases index with + | zero => + simp [Array.getElem?_append] at capabilityAt' valueAt + subst capability + subst value + exact scalarHolds + | succ index => + simp [Array.getElem?_append] at capabilityAt' valueAt + exact invariant.holds capabilityAt' valueAt + · simpa [rootsForCapabilities] using invariant.ownership + · exact BorrowProvenance.prependNonBorrowed + (IxIR1.Sim.StoreGraphExtends.refl store) + invariant.borrows (by intros; simp) forgets + afterOwners + | erased => + have outputEq : (outputStore, IxIR1.RVal.erased) = + (store, IxIR1.RVal.erased) := selectedOutput + have storeEq : outputStore = store := + congrArg Prod.fst outputEq + subst outputStore + refine ⟨by simp [Array.size_append, Nat.add_comm, + invariant.length], ?_, ?_, ?_⟩ + · intro index capability value capabilityAt' valueAt + cases index with + | zero => + simp [Array.getElem?_append] at capabilityAt' valueAt + subst capability + subst value + exact scalarHolds + | succ index => + simp [Array.getElem?_append] at capabilityAt' valueAt + exact invariant.holds capabilityAt' valueAt + · simpa [rootsForCapabilities] using invariant.ownership + · exact BorrowProvenance.prependNonBorrowed + (IxIR1.Sim.StoreGraphExtends.refl store) + invariant.borrows (by intros; simp) forgets + afterOwners + +/-- The baseline-compatible producer `fetch` effect preserves exact dynamic +ownership. The parent capability proves the selected edge inhabits the +constructor world; the new borrowed head contributes no external root. -/ +theorem fetch {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {sourceCurrent : IxIR1.FnDef} {store outputStore : IxIR1.Store} + {source : List RVal} + {input afterInput : Array (Option Atom)} + {capabilities afterCapabilities : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + (invariant : SourceOwnershipInvariant store source input capabilities + frameRoots) + {headAtom : Atom} + (forgets : Lower.InputMap.Forgets afterInput (#[some headAtom] ++ input)) + (afterOwners : OwnedInputRegisters afterInput afterCapabilities) + {sourceAtom : IxIR1.Atom} {sourceField : Nat} {targetAtom : Atom} + {value : RVal} + (translated : Lower.InputMap.translateAtom input sourceAtom = + some targetAtom) + (transition : Lower.fetchCapabilities? capabilities sourceAtom targetAtom = + some afterCapabilities) + (operationRun : IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent + store source (.fetch sourceAtom sourceField) = + .ok (outputStore, value)) : + SourceOwnershipInvariant outputStore (value :: source) afterInput + afterCapabilities frameRoots := by + obtain ⟨location, box, identity, fields, runtimeValue, sourceResolved, + sourceGet, node, fieldAt, outputEq⟩ := + IxIR1.runOp_fetch_success operationRun + have storeEq : outputStore = store := congrArg Prod.fst outputEq + have valueEq : value = runtimeValue := congrArg Prod.snd outputEq + subst outputStore + subst runtimeValue + have prependBorrowed : ∀ {world lender}, + IxIR1.Sim.HasWorld store world (.loc location) → + BorrowProvenance store source input capabilities frameRoots world lender + (.loc location) → + OwnedInputRegisters afterInput + (#[.borrowed world lender] ++ capabilities) → + SourceOwnershipInvariant store (value :: source) + afterInput (#[.borrowed world lender] ++ capabilities) + frameRoots := by + intro world lender parentWorld parentProvenance successorOwners + obtain ⟨parentBox, parentGet, parentWorldEq⟩ := parentWorld + have parentBoxEq : parentBox = box := + Option.some.inj (parentGet.symm.trans sourceGet) + subst parentBox + have resultWorld : IxIR1.Sim.HasWorld store world value := by + have fieldMember : value ∈ fields := + (Array.mem_iff_getElem?).2 ⟨sourceField, fieldAt⟩ + have childMember : value ∈ IxIR1.Sim.nodeChildren box.node := by + rw [node] + simpa [IxIR1.Sim.nodeChildren] using fieldMember + have edgeWorld := invariant.ownership.edges_world sourceGet value + childMember + simpa [parentWorldEq] using edgeWorld + have fieldMember : value ∈ fields := + (Array.mem_iff_getElem?).2 ⟨sourceField, fieldAt⟩ + have childMember : value ∈ IxIR1.Sim.nodeChildren box.node := by + rw [node] + simpa [IxIR1.Sim.nodeChildren] using fieldMember + refine ⟨by simp [Array.size_append, Nat.add_comm, invariant.length], + ?_, ?_, ?_⟩ + · intro index capability selectedValue capabilityAt valueAt + cases index with + | zero => + simp [Array.getElem?_append] at capabilityAt valueAt + subst capability + subst selectedValue + exact resultWorld + | succ index => + simp [Array.getElem?_append] at capabilityAt valueAt + exact invariant.holds capabilityAt valueAt + · simpa [rootsForCapabilities] using invariant.ownership + · intro index actualWorld actualLender selected capabilityAt selectedAt + cases index with + | zero => + simp [Array.getElem?_append] at capabilityAt selectedAt + rcases capabilityAt with ⟨rfl, rfl⟩ + subst selected + exact BorrowProvenance.prependUnchanged + (IxIR1.Sim.StoreGraphExtends.refl store) forgets successorOwners + (BorrowProvenance.child parentProvenance sourceGet childMember) + | succ index => + simp [Array.getElem?_append] at capabilityAt selectedAt + exact BorrowProvenance.prependUnchanged + (IxIR1.Sim.StoreGraphExtends.refl store) forgets successorOwners + (invariant.borrows capabilityAt selectedAt) + cases sourceAtom with + | lit literal => + simp [IxIR1.resolveAtom] at sourceResolved + | erased => + simp [IxIR1.resolveAtom] at sourceResolved + | var sourceIndex => + cases sourceAt : source[sourceIndex]? with + | none => simp [IxIR1.resolveAtom, sourceAt] at sourceResolved + | some found => + have foundEq : found = .loc location := by + simpa [IxIR1.resolveAtom, sourceAt] using sourceResolved + subst found + cases capabilityAt : capabilities[sourceIndex]? with + | none => + simp [Lower.fetchCapabilities?, Lower.sourceCapability?, + capabilityAt] at transition + | some capability => + cases capability with + | scalar => + simp [Lower.fetchCapabilities?, Lower.sourceCapability?, + capabilityAt] at transition + | dead => + simp [Lower.fetchCapabilities?, Lower.sourceCapability?, + capabilityAt] at transition + | owned world => + cases targetAtom with + | lit literal => + simp [Lower.fetchCapabilities?, Lower.sourceCapability?, + capabilityAt] at transition + | erased => + simp [Lower.fetchCapabilities?, Lower.sourceCapability?, + capabilityAt] at transition + | reg id => + simp only [Lower.fetchCapabilities?, + Lower.sourceCapability?, capabilityAt] at transition + injection transition with afterEq + subst afterCapabilities + have inputAt : input[sourceIndex]? = + some (some (.reg id)) := by + cases foundInput : input[sourceIndex]? with + | none => + simp [Lower.InputMap.translateAtom, foundInput] + at translated + | some slot => + cases slot with + | none => + simp [Lower.InputMap.translateAtom, foundInput] + at translated + | some actual => + have actualEq : actual = .reg id := by + simpa [Lower.InputMap.translateAtom, + foundInput] using translated + subst actual + rfl + have parentProvenance : BorrowProvenance store source + input capabilities frameRoots world (.value id) + (.loc location) := + ⟨sourceIndex, .loc location, inputAt, capabilityAt, + sourceAt, .refl⟩ + exact prependBorrowed + (invariant.holds capabilityAt sourceAt) + parentProvenance afterOwners + | borrowed world lender => + simp only [Lower.fetchCapabilities?, + Lower.sourceCapability?, capabilityAt] at transition + injection transition with afterEq + subst afterCapabilities + exact prependBorrowed + (invariant.holds capabilityAt sourceAt) + (invariant.borrows capabilityAt sourceAt) afterOwners + +end SourceOwnershipInvariant + +namespace SourceOwnershipAt + +/-- A checked `pure`/`move` node transports the trace-indexed dynamic +ownership invariant to its exact recursive continuation. -/ +theorem pure {checked : Lower.Checked} + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ checked.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount index : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {next : Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.pure sourceAtom) index (.move targetAtom) next)) + {store : IxIR1.Store} {source : List RVal} {value : RVal} + {frameRoots : List IxIR1.Sim.Root} + (ownership : SourceOwnershipAt checked.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.pure sourceAtom) index (.move targetAtom) next) store source + frameRoots) + (resolved : IxIR1.resolveAtom source sourceAtom = .ok value) : + SourceOwnershipAt checked.artifact.trace.positions next store + (value :: source) frameRoots := by + intro after afterMember afterCoordinate + obtain ⟨before, beforeMember, beforeCoordinate, transitionMatch⟩ := + checked.pureTransition functionMember descendant afterMember + afterCoordinate + have beforeInvariant := ownership before beforeMember (by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceBlock, + Lower.CodeTrace.targetPosition, Lower.CodeTrace.sourceInputMap] using + beforeCoordinate) + change SourceOwnershipInvariant store source input + before.sourceCapabilities frameRoots at beforeInvariant + have mapFacts := Lower.CodeTrace.inputMapForgets_of_match + (functionTrace.descendantInputMapsMatch descendant) (by rfl) + have letOpMatch := functionTrace.descendantLetOpMatch descendant + have forgets : Lower.InputMap.Forgets next.sourceInputMap + (#[some (.reg entryValueCount)] ++ input) := by + simpa [letOpMatch.1.nextInput] using mapFacts.2.2.1 + have afterOwners : OwnedInputRegisters next.sourceInputMap + after.sourceCapabilities := + OwnedInputRegisters.ofCoordinate afterCoordinate + unfold Lower.PositionTrace.moveMatches at transitionMatch + cases transitionEq : Lower.moveCapabilities? + before.sourceCapabilities input sourceAtom with + | none => simp [transitionEq] at transitionMatch + | some expected => + have expectedEq : expected = after.sourceCapabilities := by + simpa [transitionEq, beq_iff_eq] using transitionMatch + apply beforeInvariant.move forgets afterOwners resolved + simpa [expectedEq] using transitionEq + +/-- A checked `dup`/`retainShared` node transports trace-indexed dynamic +ownership to its exact recursive continuation. -/ +theorem dup {checked : Lower.Checked} + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ checked.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount index : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {next : Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.dup sourceAtom) index (.retainShared targetAtom) next)) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {store outputStore : IxIR1.Store} {source : List RVal} {value : RVal} + {frameRoots : List IxIR1.Sim.Root} + (ownership : SourceOwnershipAt checked.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.dup sourceAtom) index (.retainShared targetAtom) next) store source + frameRoots) + (resolved : IxIR1.resolveAtom source sourceAtom = .ok value) + (operationRun : IxIR1.runOp sourceContext (sourceFuel + 1) + functionTrace.source store source (.dup sourceAtom) = + .ok (outputStore, value)) : + SourceOwnershipAt checked.artifact.trace.positions next outputStore + (value :: source) frameRoots := by + intro after afterMember afterCoordinate + obtain ⟨before, beforeMember, beforeCoordinate, transitionMatch⟩ := + checked.dupTransition functionMember descendant afterMember + afterCoordinate + have beforeInvariant := ownership before beforeMember (by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceBlock, + Lower.CodeTrace.targetPosition, Lower.CodeTrace.sourceInputMap] using + beforeCoordinate) + change SourceOwnershipInvariant store source input + before.sourceCapabilities frameRoots at beforeInvariant + have mapFacts := Lower.CodeTrace.inputMapForgets_of_match + (functionTrace.descendantInputMapsMatch descendant) (by rfl) + have letOpMatch := functionTrace.descendantLetOpMatch descendant + have forgets : Lower.InputMap.Forgets next.sourceInputMap + (#[some (.reg entryValueCount)] ++ input) := by + simpa [letOpMatch.1.nextInput] using mapFacts.2.2.1 + have afterOwners : OwnedInputRegisters next.sourceInputMap + after.sourceCapabilities := + OwnedInputRegisters.ofCoordinate afterCoordinate + unfold Lower.PositionTrace.dupMatches at transitionMatch + cases transitionEq : Lower.dupCapabilities? + before.sourceCapabilities sourceAtom with + | none => simp [transitionEq] at transitionMatch + | some expected => + have expectedEq : expected = after.sourceCapabilities := by + simpa [transitionEq, beq_iff_eq] using transitionMatch + apply beforeInvariant.dup forgets afterOwners resolved + (sourceFuel := sourceFuel) + (operationRun := operationRun) + simpa [expectedEq] using transitionEq + +/-- A checked `fetch` node transports trace-indexed dynamic ownership to its +exact recursive continuation without an external transition premise. -/ +theorem fetch {checked : Lower.Checked} + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ checked.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount index : Nat} + {sourceAtom : IxIR1.Atom} {sourceField : Nat} + {targetAtom : Atom} {targetCid : IxIR1.CtorId} {targetField : Nat} + {next : Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.fetch sourceAtom sourceField) index + (.fetch targetAtom targetCid targetField) next)) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {store outputStore : IxIR1.Store} {source : List RVal} {value : RVal} + {frameRoots : List IxIR1.Sim.Root} + (ownership : SourceOwnershipAt checked.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.fetch sourceAtom sourceField) index + (.fetch targetAtom targetCid targetField) next) store source + frameRoots) + (operationRun : IxIR1.runOp sourceContext (sourceFuel + 1) + functionTrace.source store source (.fetch sourceAtom sourceField) = + .ok (outputStore, value)) : + SourceOwnershipAt checked.artifact.trace.positions next outputStore + (value :: source) frameRoots := by + intro after afterMember afterCoordinate + obtain ⟨before, beforeMember, beforeCoordinate, transitionMatch⟩ := + checked.fetchTransition functionMember descendant afterMember + afterCoordinate + have beforeInvariant := ownership before beforeMember (by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceBlock, + Lower.CodeTrace.targetPosition, Lower.CodeTrace.sourceInputMap] using + beforeCoordinate) + change SourceOwnershipInvariant store source input + before.sourceCapabilities frameRoots at beforeInvariant + have mapFacts := Lower.CodeTrace.inputMapForgets_of_match + (functionTrace.descendantInputMapsMatch descendant) (by rfl) + have letOpMatch := functionTrace.descendantLetOpMatch descendant + have forgets : Lower.InputMap.Forgets next.sourceInputMap + (#[some (.reg entryValueCount)] ++ input) := by + simpa [letOpMatch.1.nextInput] using mapFacts.2.2.1 + have afterOwners : OwnedInputRegisters next.sourceInputMap + after.sourceCapabilities := + OwnedInputRegisters.ofCoordinate afterCoordinate + have translated := + (functionTrace.descendantOperationSyntax descendant).2 + unfold Lower.PositionTrace.fetchMatches at transitionMatch + cases transitionEq : Lower.fetchCapabilities? + before.sourceCapabilities sourceAtom targetAtom with + | none => simp [transitionEq] at transitionMatch + | some expected => + have expectedEq : expected = after.sourceCapabilities := by + simpa [transitionEq, beq_iff_eq] using transitionMatch + apply beforeInvariant.fetch forgets afterOwners translated + (sourceFuel := sourceFuel) + (operationRun := operationRun) + simpa [expectedEq] using transitionEq + +end SourceOwnershipAt + +namespace SourceOwnershipInvariant + +private def sourceResolveStep (source : List RVal) + (values : List RVal) (atom : IxIR1.Atom) : + Except IxIR1.Err (List RVal) := do + pure (values ++ [← IxIR1.resolveAtom source atom]) + +private inductive SourceAtomsResolve (source : List RVal) : + List IxIR1.Atom → List RVal → Prop where + | nil : SourceAtomsResolve source [] [] + | cons (head : IxIR1.resolveAtom source atom = .ok value) + (tail : SourceAtomsResolve source atoms values) : + SourceAtomsResolve source (atom :: atoms) (value :: values) + +namespace SourceAtomsResolve + +private theorem ofFoldlM {source : List RVal} : + ∀ atoms accumulator output, + atoms.foldlM (sourceResolveStep source) accumulator = .ok output → + ∃ values, SourceAtomsResolve source atoms values ∧ + output = accumulator ++ values := by + intro atoms + induction atoms with + | nil => + intro accumulator output run + simp only [List.foldlM_nil, pure, Except.pure] at run + injection run with outputEq + subst output + exact ⟨[], .nil, by simp⟩ + | cons atom atoms ih => + intro accumulator output run + simp only [List.foldlM_cons] at run + cases headRun : IxIR1.resolveAtom source atom with + | error error => + have step : sourceResolveStep source accumulator atom = + .error error := by + simp [sourceResolveStep, headRun, bind, Except.bind] + rw [step] at run + simp only [bind, Except.bind] at run + contradiction + | ok value => + have step : sourceResolveStep source accumulator atom = + .ok (accumulator ++ [value]) := by + simp [sourceResolveStep, headRun, bind, Except.bind, + pure, Except.pure] + rw [step] at run + simp only [bind, Except.bind] at run + obtain ⟨values, valuesRun, outputEq⟩ := + ih (accumulator ++ [value]) output run + refine ⟨value :: values, .cons headRun valuesRun, ?_⟩ + rw [outputEq] + simp [List.append_assoc] + +private theorem ofResolveAtoms {source : List RVal} + {atoms : Array IxIR1.Atom} {values : List RVal} + (resolved : IxIR1.resolveAtoms source atoms = .ok values) : + SourceAtomsResolve source atoms.toList values := by + unfold IxIR1.resolveAtoms at resolved + rw [← Array.foldlM_toList] at resolved + change atoms.toList.foldlM (sourceResolveStep source) [] = + .ok values at resolved + obtain ⟨found, relation, valuesEq⟩ := + ofFoldlM atoms.toList [] values resolved + simp only [List.nil_append] at valuesEq + subst found + exact relation + +private theorem length {source : List RVal} {atoms : List IxIR1.Atom} + {values : List RVal} (resolved : SourceAtomsResolve source atoms values) : + atoms.length = values.length := by + induction resolved with + | nil => rfl + | cons _ _ ih => simp [ih] + +private theorem worlds {store : IxIR1.Store} {source : List RVal} + {input : Array (Option Atom)} + {capabilities : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + (invariant : SourceOwnershipInvariant store source input capabilities + frameRoots) + {world : Ix.Compiler.Ixon.Owned} : + ∀ {atoms values}, SourceAtomsResolve source atoms values → + (∀ atom ∈ atoms, + ∃ capability, + Lower.sourceCapability? capabilities atom = some capability ∧ + capability.canConsume world = true) → + ∀ value ∈ values, IxIR1.Sim.HasWorld store world value := by + intro atoms values relation + induction relation with + | nil => simp + | @cons atom value atoms values head tail ih => + intro accepted candidate member + simp only [List.mem_cons] at member + cases member with + | inl equal => + subst candidate + obtain ⟨capability, capabilityAt, canConsume⟩ := + accepted atom (by simp) + exact invariant.resolveAtom_hasWorld capabilityAt canConsume head + | inr member => + apply ih + · intro tailAtom tailMember + exact accepted tailAtom (by simp [tailMember]) + · exact member + +end SourceAtomsResolve + +/-- One exact producer consumption moves the selected ownership token behind +an arbitrary already-consumed prefix. Scalar arguments are admitted as inert +roots; owned variables are removed from their source slot by permutation. -/ +private theorem consumeCapability_ownership + {store : IxIR1.Store} {source : List RVal} + {capabilities remaining : Array Lower.BindingCap} + {input : Array (Option Atom)} + {world : Ix.Compiler.Ixon.Owned} {atom : IxIR1.Atom} {value : RVal} + {consumedRoots : List IxIR1.Sim.Root} + {suffixRoots : List IxIR1.Sim.Root} + (holds : ∀ {index : Nat} {capability : Lower.BindingCap} + {selected : RVal}, + capabilities[index]? = some capability → + source[index]? = some selected → + CapabilityHolds store capability selected) + (ownership : IxIR1.Sim.RootOwnership store + (consumedRoots ++ rootsForCapabilities capabilities.toList source ++ + suffixRoots)) + (resolved : IxIR1.resolveAtom source atom = .ok value) + (consumed : Lower.consumeCapability? capabilities input world atom = + some remaining) : + (∀ {index : Nat} {capability : Lower.BindingCap} {selected : RVal}, + remaining[index]? = some capability → + source[index]? = some selected → + CapabilityHolds store capability selected) ∧ + IxIR1.Sim.RootOwnership store + (consumedRoots ++ [(⟨world, value⟩ : IxIR1.Sim.Root)] ++ + rootsForCapabilities remaining.toList source ++ suffixRoots) := by + have addScalar (scalar : IxIR1.Sim.rvalLocation? value = none) : + IxIR1.Sim.RootOwnership store + (consumedRoots ++ [(⟨world, value⟩ : IxIR1.Sim.Root)] ++ + rootsForCapabilities capabilities.toList source ++ suffixRoots) := by + have added := ownership.addNoLocation (world := world) scalar + apply added.perm + simpa [List.append_assoc] using + (List.perm_append_comm + (l₁ := [(⟨world, value⟩ : IxIR1.Sim.Root)]) + (l₂ := consumedRoots)).append_right + (rootsForCapabilities capabilities.toList source ++ suffixRoots) + cases atom with + | lit literal => + simp only [Lower.consumeCapability?, Lower.sourceCapability?] at consumed + injection consumed with remainingEq + subst remaining + have valueEq : value = .lit literal := by + simpa [IxIR1.resolveAtom] using resolved.symm + subst value + exact ⟨holds, addScalar rfl⟩ + | erased => + simp only [Lower.consumeCapability?, Lower.sourceCapability?] at consumed + injection consumed with remainingEq + subst remaining + have valueEq : value = .erased := by + simpa [IxIR1.resolveAtom] using resolved.symm + subst value + exact ⟨holds, addScalar rfl⟩ + | var sourceIndex => + cases sourceAt : source[sourceIndex]? with + | none => simp [IxIR1.resolveAtom, sourceAt] at resolved + | some found => + have foundEq : found = value := by + simpa [IxIR1.resolveAtom, sourceAt] using resolved + subst found + cases capabilityAt : capabilities[sourceIndex]? with + | none => + simp [Lower.consumeCapability?, Lower.sourceCapability?, + capabilityAt] at consumed + | some capability => + cases capability with + | borrowed actual lender => + simp [Lower.consumeCapability?, Lower.sourceCapability?, + capabilityAt] at consumed + | dead => + simp [Lower.consumeCapability?, Lower.sourceCapability?, + capabilityAt] at consumed + | scalar => + simp only [Lower.consumeCapability?, + Lower.sourceCapability?, capabilityAt] at consumed + injection consumed with remainingEq + subst remaining + have scalarHolds := holds capabilityAt sourceAt + exact ⟨holds, addScalar (by + simpa [CapabilityHolds] using scalarHolds)⟩ + | owned actual => + simp [Lower.consumeCapability?, Lower.sourceCapability?, + capabilityAt] at consumed + obtain ⟨actualEq, remainingEq⟩ := consumed + subst actual + obtain ⟨remainingHolds, movedRoot⟩ := + retireOwnerCapabilities_ownership holds capabilityAt + sourceAt remainingEq + refine ⟨remainingHolds, ?_⟩ + apply ownership.perm + simpa [List.append_assoc] using + (movedRoot.symm.append_left consumedRoots).append_right + suffixRoots + +/-- One owned-boundary capability update preserves provenance for every +borrow that remains live after the update. -/ +private theorem consumeCapability_borrows + {store : IxIR1.Store} {source : List RVal} + {input : Array (Option Atom)} + {capabilities remaining : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + (oldBorrows : ∀ {index : Nat} {world : Ix.Compiler.Ixon.Owned} + {lender : BorrowLender} {value : RVal}, + capabilities[index]? = some (.borrowed world lender) → + source[index]? = some value → + BorrowProvenance store source input capabilities frameRoots world lender + value) + {world : Ix.Compiler.Ixon.Owned} {atom : IxIR1.Atom} + (consumed : Lower.consumeCapability? capabilities input world atom = + some remaining) : + ∀ {index : Nat} {borrowWorld : Ix.Compiler.Ixon.Owned} + {lender : BorrowLender} {value : RVal}, + remaining[index]? = some (.borrowed borrowWorld lender) → + source[index]? = some value → + BorrowProvenance store source input remaining frameRoots borrowWorld + lender value := by + cases atom with + | lit literal => + simp only [Lower.consumeCapability?, Lower.sourceCapability?] at consumed + injection consumed with remainingEq + subst remaining + exact oldBorrows + | erased => + simp only [Lower.consumeCapability?, Lower.sourceCapability?] at consumed + injection consumed with remainingEq + subst remaining + exact oldBorrows + | var sourceIndex => + cases capabilityAt : capabilities[sourceIndex]? with + | none => + simp [Lower.consumeCapability?, Lower.sourceCapability?, + capabilityAt] at consumed + | some capability => + cases capability with + | scalar => + simp only [Lower.consumeCapability?, Lower.sourceCapability?, + capabilityAt] at consumed + injection consumed with remainingEq + subst remaining + exact oldBorrows + | borrowed borrowWorld lender | dead => + simp [Lower.consumeCapability?, Lower.sourceCapability?, + capabilityAt] at consumed + | owned actual => + simp [Lower.consumeCapability?, Lower.sourceCapability?, + capabilityAt] at consumed + obtain ⟨actualEq, remainingEq⟩ := consumed + subst actual + exact retireOwnerCapabilities_borrows oldBorrows capabilityAt + remainingEq + +/-- Sequential exact producer consumption accumulates the resolved argument +roots in source order ahead of the surviving source-owner roots. -/ +private theorem consumeCapabilitiesList_ownership + {store : IxIR1.Store} {source : List RVal} + {capabilities remaining : Array Lower.BindingCap} + {input : Array (Option Atom)} + {world : Ix.Compiler.Ixon.Owned} + {atoms : List IxIR1.Atom} {values : List RVal} + {consumedRoots : List IxIR1.Sim.Root} + {suffixRoots : List IxIR1.Sim.Root} + (holds : ∀ {index : Nat} {capability : Lower.BindingCap} + {selected : RVal}, + capabilities[index]? = some capability → + source[index]? = some selected → + CapabilityHolds store capability selected) + (ownership : IxIR1.Sim.RootOwnership store + (consumedRoots ++ rootsForCapabilities capabilities.toList source ++ + suffixRoots)) + (resolved : SourceAtomsResolve source atoms values) + (consumed : Lower.consumeCapabilitiesList? capabilities input world atoms = + some remaining) : + (∀ {index : Nat} {capability : Lower.BindingCap} {selected : RVal}, + remaining[index]? = some capability → + source[index]? = some selected → + CapabilityHolds store capability selected) ∧ + IxIR1.Sim.RootOwnership store + (consumedRoots ++ IxIR1.Sim.rootsFor world values ++ + rootsForCapabilities remaining.toList source ++ suffixRoots) := by + induction resolved generalizing capabilities consumedRoots with + | nil => + simp only [Lower.consumeCapabilitiesList?] at consumed + injection consumed with remainingEq + subst remaining + refine ⟨holds, ?_⟩ + simpa [IxIR1.Sim.rootsFor, List.append_assoc] using ownership + | @cons atom value atoms values head tail ih => + simp only [Lower.consumeCapabilitiesList?] at consumed + cases step : Lower.consumeCapability? capabilities input world atom with + | none => simp [step] at consumed + | some nextCapabilities => + simp only [step] at consumed + obtain ⟨nextHolds, nextOwnership⟩ := + consumeCapability_ownership holds ownership head step + have recursive := ih nextHolds nextOwnership consumed + refine ⟨recursive.1, ?_⟩ + simpa [IxIR1.Sim.rootsFor, List.append_assoc] using recursive.2 + +/-- Heterogeneous call-argument consumption accumulates one exact root in +the world of each owned parameter, ahead of the surviving caller roots. -/ +private theorem consumeCapabilitiesWorlds_ownership + {store : IxIR1.Store} {source : List RVal} + {capabilities remaining : Array Lower.BindingCap} + {input : Array (Option Atom)} + {worlds : List Ix.Compiler.Ixon.Owned} + {atoms : List IxIR1.Atom} {values : List RVal} + {consumedRoots suffixRoots : List IxIR1.Sim.Root} + (holds : ∀ {index : Nat} {capability : Lower.BindingCap} + {selected : RVal}, + capabilities[index]? = some capability → + source[index]? = some selected → + CapabilityHolds store capability selected) + (ownership : IxIR1.Sim.RootOwnership store + (consumedRoots ++ rootsForCapabilities capabilities.toList source ++ + suffixRoots)) + (resolved : SourceAtomsResolve source atoms values) + (consumed : Lower.consumeCapabilitiesWorlds? capabilities input worlds + atoms = some remaining) : + (∀ {index : Nat} {capability : Lower.BindingCap} {selected : RVal}, + remaining[index]? = some capability → + source[index]? = some selected → + CapabilityHolds store capability selected) ∧ + IxIR1.Sim.RootOwnership store + (consumedRoots ++ IxIR1.Sim.rootsForWorlds worlds values ++ + rootsForCapabilities remaining.toList source ++ suffixRoots) := by + induction resolved generalizing capabilities worlds consumedRoots with + | nil => + cases worlds with + | nil => + simp only [Lower.consumeCapabilitiesWorlds?] at consumed + injection consumed with remainingEq + subst remaining + exact ⟨holds, by simpa [IxIR1.Sim.rootsForWorlds, + List.append_assoc] using ownership⟩ + | cons world worlds => + simp [Lower.consumeCapabilitiesWorlds?] at consumed + | @cons atom value atoms values head tail ih => + cases worlds with + | nil => simp [Lower.consumeCapabilitiesWorlds?] at consumed + | cons world worlds => + simp only [Lower.consumeCapabilitiesWorlds?] at consumed + cases step : Lower.consumeCapability? capabilities input world atom with + | none => simp [step] at consumed + | some nextCapabilities => + simp only [step] at consumed + obtain ⟨nextHolds, nextOwnership⟩ := + consumeCapability_ownership holds ownership head step + have recursive := ih nextHolds nextOwnership consumed + refine ⟨recursive.1, ?_⟩ + simpa [IxIR1.Sim.rootsForWorlds, List.append_assoc] using + recursive.2 + +/-- Successful projection of the baseline owned call ABI identifies the +entry capability vector as the reversed parameter-world telescope. -/ +private theorem ownedParameterWorlds?_entryCapabilities + {signature : Signature} {worlds : List Ix.Compiler.Ixon.Owned} + (projected : Lower.ownedParameterWorlds? signature.params.toList = + some worlds) : + (Lower.entryCapabilities signature).toList = + worlds.reverse.map Lower.BindingCap.owned := by + unfold Lower.entryCapabilities + have listShape : ∀ {parameters : List Param} + {parameterWorlds : List Ix.Compiler.Ixon.Owned}, + Lower.ownedParameterWorlds? parameters = some parameterWorlds → + parameters.map (fun parameter => + match parameter.passing with + | .owned => Lower.BindingCap.owned parameter.world + | .borrowed => Lower.BindingCap.borrowed parameter.world .caller) = + parameterWorlds.map Lower.BindingCap.owned := by + intro parameters parameterWorlds projection + induction parameters generalizing parameterWorlds with + | nil => + simp [Lower.ownedParameterWorlds?] at projection + subst parameterWorlds + simp + | cons parameter rest ih => + rcases parameter with ⟨world, passing⟩ + cases passing with + | borrowed => + simp [Lower.ownedParameterWorlds?] at projection + | owned => + simp only [Lower.ownedParameterWorlds?, beq_self_eq_true, + if_true] at projection + cases restProjection : Lower.ownedParameterWorlds? rest with + | none => simp [restProjection] at projection + | some restWorlds => + simp only [restProjection, Option.map_some, + Option.some.injEq] at projection + subst parameterWorlds + simp [ih restProjection] + change (signature.params.toList.reverse.map (fun parameter => + match parameter.passing with + | .owned => Lower.BindingCap.owned parameter.world + | .borrowed => Lower.BindingCap.borrowed parameter.world .caller)) = + worlds.reverse.map Lower.BindingCap.owned + calc + _ = (signature.params.toList.map (fun parameter => + match parameter.passing with + | .owned => Lower.BindingCap.owned parameter.world + | .borrowed => Lower.BindingCap.borrowed parameter.world + .caller)).reverse := List.map_reverse + _ = (worlds.map Lower.BindingCap.owned).reverse := + congrArg List.reverse (listShape projected) + _ = _ := List.map_reverse.symm + +/-- Owned capabilities and a same-length value vector denote the canonical +heterogeneous root telescope. -/ +private theorem rootsForCapabilities_owned + {worlds : List Ix.Compiler.Ixon.Owned} {values : List RVal} + (length : worlds.length = values.length) : + rootsForCapabilities (worlds.map Lower.BindingCap.owned) values = + IxIR1.Sim.rootsForWorlds worlds values := by + induction worlds generalizing values with + | nil => + cases values with + | nil => rfl + | cons value values => simp at length + | cons world worlds ih => + cases values with + | nil => simp at length + | cons value values => + simp only [List.length_cons, Nat.succ.injEq] at length + simp [rootsForCapabilities, IxIR1.Sim.rootsForWorlds, ih length] + +/-- Reversing two same-length heterogeneous telescopes reverses their root +list without changing any world/value pairing. -/ +private theorem rootsForWorlds_reverse + {worlds : List Ix.Compiler.Ixon.Owned} {values : List RVal} + (length : worlds.length = values.length) : + IxIR1.Sim.rootsForWorlds worlds.reverse values.reverse = + (IxIR1.Sim.rootsForWorlds worlds values).reverse := by + induction worlds generalizing values with + | nil => + cases values with + | nil => rfl + | cons value values => simp at length + | cons world worlds ih => + cases values with + | nil => simp at length + | cons value values => + simp only [List.length_cons, Nat.succ.injEq] at length + rw [List.reverse_cons, List.reverse_cons] + have appendShape : ∀ {leftWorlds : List Ix.Compiler.Ixon.Owned} + {leftValues : List RVal}, + leftWorlds.length = leftValues.length → + IxIR1.Sim.rootsForWorlds (leftWorlds ++ [world]) + (leftValues ++ [value]) = + IxIR1.Sim.rootsForWorlds leftWorlds leftValues ++ + [⟨world, value⟩] := by + intro leftWorlds leftValues leftLength + induction leftWorlds generalizing leftValues with + | nil => + cases leftValues with + | nil => rfl + | cons head tail => simp at leftLength + | cons headWorld tailWorlds appendIh => + cases leftValues with + | nil => simp at leftLength + | cons headValue tailValues => + simp only [List.length_cons, Nat.succ.injEq] at leftLength + simp [IxIR1.Sim.rootsForWorlds, + appendIh leftLength] + rw [appendShape (by simpa using length), ih length] + simp [IxIR1.Sim.rootsForWorlds] + +/-- The exact entry roots are a presentation-order permutation of the +source-order call argument roots. -/ +private theorem entryRoots_perm + {signature : Signature} {worlds : List Ix.Compiler.Ixon.Owned} + {values : List RVal} + (projected : Lower.ownedParameterWorlds? signature.params.toList = + some worlds) + (length : worlds.length = values.length) : + (rootsForCapabilities (Lower.entryCapabilities signature).toList + values.reverse).Perm (IxIR1.Sim.rootsForWorlds worlds values) := by + rw [ownedParameterWorlds?_entryCapabilities projected] + rw [rootsForCapabilities_owned (by simpa using length)] + rw [rootsForWorlds_reverse length] + exact List.reverse_perm _ + +/-- If the call audit says no local owner survives, the dynamic root +projection of that capability vector is empty for every source environment. -/ +private theorem rootsForCapabilities_eq_nil_of_noOwnedRoots + {capabilities : Array Lower.BindingCap} {source : List RVal} + (noOwners : Lower.noOwnedRoots capabilities = true) : + rootsForCapabilities capabilities.toList source = [] := by + unfold Lower.noOwnedRoots at noOwners + have listResult : ∀ (caps : List Lower.BindingCap) (values : List RVal), + caps.all (fun capability => !capability.hasOwnedRoot) = true → + rootsForCapabilities caps values = [] := by + intro caps + induction caps with + | nil => intro values _; rfl + | cons capability rest ih => + intro values noOwners + cases values with + | nil => simp [rootsForCapabilities] + | cons value values => + simp only [List.all_cons, Bool.and_eq_true] at noOwners + cases capability with + | owned world => + simp [Lower.BindingCap.hasOwnedRoot] at noOwners + | scalar => + simpa [rootsForCapabilities] using ih values noOwners.2 + | borrowed world lender => + simpa [rootsForCapabilities] using ih values noOwners.2 + | dead => + simpa [rootsForCapabilities] using ih values noOwners.2 + exact listResult capabilities.toList source noOwners + +/-- Exact checked call consumption constructs the complete callee-entry +ownership invariant. Surviving caller owners become the suspended frame +suffix; transferred argument owners become the callee's canonical local +roots. -/ +theorem callEntryInvariant + {store : IxIR1.Store} {source : List RVal} + {input calleeInput : Array (Option Atom)} + {capabilities remaining : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} {signature : Signature} + {arguments : Array IxIR1.Atom} {values : List RVal} + (invariant : SourceOwnershipInvariant store source input capabilities + frameRoots) + (resolved : IxIR1.resolveAtoms source arguments = .ok values) + (consumed : Lower.callRemainingCapabilities? capabilities input signature + arguments = some remaining) : + SourceOwnershipInvariant store values.reverse calleeInput + (Lower.entryCapabilities signature) + (rootsForCapabilities remaining.toList source ++ frameRoots) := by + unfold Lower.callRemainingCapabilities? at consumed + cases projectedEq : Lower.ownedParameterWorlds? + signature.params.toList with + | none => simp [projectedEq] at consumed + | some worlds => + simp only [projectedEq, Option.bind_eq_bind, Option.bind_some] at consumed + have resolvedRelation := SourceAtomsResolve.ofResolveAtoms resolved + have valueLength : arguments.toList.length = values.length := + SourceAtomsResolve.length resolvedRelation + have worldLength : worlds.length = arguments.toList.length := + Lower.consumeCapabilitiesWorlds?_length consumed + have worldsValuesLength : worlds.length = values.length := + worldLength.trans valueLength + obtain ⟨remainingHolds, readyOwnership⟩ := + consumeCapabilitiesWorlds_ownership + (consumedRoots := []) (suffixRoots := frameRoots) + invariant.holds (by simpa using invariant.ownership) + resolvedRelation consumed + have entryShape := ownedParameterWorlds?_entryCapabilities projectedEq + have entrySize : (Lower.entryCapabilities signature).size = + worlds.length := by + simpa using congrArg List.length entryShape + have entryPerm := entryRoots_perm projectedEq worldsValuesLength + have entryOwnership : IxIR1.Sim.RootOwnership store + (rootsForCapabilities (Lower.entryCapabilities signature).toList + values.reverse ++ + (rootsForCapabilities remaining.toList source ++ frameRoots)) := by + apply readyOwnership.perm + simpa [List.append_assoc] using + entryPerm.symm.append_right + (rootsForCapabilities remaining.toList source ++ frameRoots) + refine ⟨?_, ?_, entryOwnership, ?_⟩ + · simpa using worldsValuesLength.symm.trans entrySize.symm + · intro index capability selected capabilityAt selectedAt + have capabilityListAt : + (Lower.entryCapabilities signature).toList[index]? = + some capability := by + simpa using capabilityAt + have capabilityMember : capability ∈ + (Lower.entryCapabilities signature).toList := + List.mem_of_getElem? capabilityListAt + rw [entryShape] at capabilityMember + simp only [List.mem_map] at capabilityMember + obtain ⟨world, _, capabilityEq⟩ := capabilityMember + subst capability + have rootMember := rootsForCapabilities_owned_mem capabilityAt + selectedAt + exact entryOwnership.roots_world ⟨world, selected⟩ + (List.mem_append_left _ rootMember) + · intro index world lender selected capabilityAt selectedAt + have capabilityListAt : + (Lower.entryCapabilities signature).toList[index]? = + some (.borrowed world lender) := by + simpa using capabilityAt + have capabilityMember : (.borrowed world lender : Lower.BindingCap) ∈ + (Lower.entryCapabilities signature).toList := + List.mem_of_getElem? capabilityListAt + rw [entryShape] at capabilityMember + simp at capabilityMember + +/-- Ordinary-call capability consumption preserves the pointwise semantic +meaning and array shape of every surviving caller slot. This is the exact +fact needed to justify the caller frame while it is suspended. -/ +theorem callRemainingHolds + {store : IxIR1.Store} {source : List RVal} + {input : Array (Option Atom)} + {capabilities remaining : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} {signature : Signature} + {arguments : Array IxIR1.Atom} {values : List RVal} + (invariant : SourceOwnershipInvariant store source input capabilities + frameRoots) + (resolved : IxIR1.resolveAtoms source arguments = .ok values) + (consumed : Lower.callRemainingCapabilities? capabilities input signature + arguments = some remaining) : + remaining.size = capabilities.size ∧ + ∀ {index : Nat} {capability : Lower.BindingCap} {selected : RVal}, + remaining[index]? = some capability → + source[index]? = some selected → + CapabilityHolds store capability selected := by + unfold Lower.callRemainingCapabilities? at consumed + cases projectedEq : Lower.ownedParameterWorlds? + signature.params.toList with + | none => simp [projectedEq] at consumed + | some worlds => + simp only [projectedEq, Option.bind_eq_bind, Option.bind_some] at consumed + have resolvedRelation := SourceAtomsResolve.ofResolveAtoms resolved + obtain ⟨remainingHolds, _⟩ := + consumeCapabilitiesWorlds_ownership + (consumedRoots := []) (suffixRoots := frameRoots) + invariant.holds (by simpa using invariant.ownership) + resolvedRelation consumed + exact ⟨Lower.consumeCapabilitiesWorlds?_size consumed, remainingHolds⟩ + +/-- Dynamic-application capability consumption exposes the exact shared +root multiset consumed by the function and argument operands. The surviving +capability roots and framed roots remain as an explicit suffix, so evaluator +progress can be reconstructed without assuming a source execution. -/ +theorem applyInputOwnership + {store : IxIR1.Store} {source : List RVal} + {input : Array (Option Atom)} + {capabilities afterFunction remaining : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + {function : IxIR1.Atom} {functionValue : RVal} + {arguments : Array IxIR1.Atom} {values : List RVal} + (invariant : SourceOwnershipInvariant store source input capabilities + frameRoots) + (functionResolved : IxIR1.resolveAtom source function = .ok functionValue) + (argumentsResolved : IxIR1.resolveAtoms source arguments = .ok values) + (functionConsumed : Lower.consumeCapability? capabilities input .shared + function = some afterFunction) + (argumentsConsumed : Lower.consumeCapabilitiesList? afterFunction input + .shared arguments.toList = some remaining) : + IxIR1.Sim.RootOwnership store + (⟨.shared, functionValue⟩ :: + IxIR1.Sim.rootsFor .shared values ++ + rootsForCapabilities remaining.toList source ++ frameRoots) := by + obtain ⟨afterFunctionHolds, afterFunctionOwnership⟩ := + consumeCapability_ownership (consumedRoots := []) + (suffixRoots := frameRoots) invariant.holds + (by simpa using invariant.ownership) functionResolved functionConsumed + have resolvedRelation := SourceAtomsResolve.ofResolveAtoms + argumentsResolved + obtain ⟨_remainingHolds, readyOwnership⟩ := + consumeCapabilitiesList_ownership + (consumedRoots := [(⟨.shared, functionValue⟩ : IxIR1.Sim.Root)]) + (suffixRoots := frameRoots) afterFunctionHolds + (by simpa using afterFunctionOwnership) resolvedRelation + argumentsConsumed + simpa [List.append_assoc] using readyOwnership + +/-- Dynamic-application capability consumption preserves the pointwise +semantic meaning and array shape of every surviving caller slot. This is the +shared-function analogue of `callRemainingHolds`, used to justify a caller +frame suspended while a PAP callee executes. -/ +theorem applyRemainingHolds + {store : IxIR1.Store} {source : List RVal} + {input : Array (Option Atom)} + {capabilities afterFunction remaining : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + {function : IxIR1.Atom} {functionValue : RVal} + {arguments : Array IxIR1.Atom} {values : List RVal} + (invariant : SourceOwnershipInvariant store source input capabilities + frameRoots) + (functionResolved : IxIR1.resolveAtom source function = .ok functionValue) + (argumentsResolved : IxIR1.resolveAtoms source arguments = .ok values) + (functionConsumed : Lower.consumeCapability? capabilities input .shared + function = some afterFunction) + (argumentsConsumed : Lower.consumeCapabilitiesList? afterFunction input + .shared arguments.toList = some remaining) : + remaining.size = capabilities.size ∧ + ∀ {index : Nat} {capability : Lower.BindingCap} {selected : RVal}, + remaining[index]? = some capability → + source[index]? = some selected → + CapabilityHolds store capability selected := by + obtain ⟨afterFunctionHolds, afterFunctionOwnership⟩ := + consumeCapability_ownership (consumedRoots := []) + (suffixRoots := frameRoots) invariant.holds + (by simpa using invariant.ownership) functionResolved functionConsumed + have resolvedRelation := SourceAtomsResolve.ofResolveAtoms argumentsResolved + obtain ⟨remainingHolds, _⟩ := + consumeCapabilitiesList_ownership + (consumedRoots := [(⟨.shared, functionValue⟩ : IxIR1.Sim.Root)]) + (suffixRoots := frameRoots) afterFunctionHolds + (by simpa using afterFunctionOwnership) resolvedRelation + argumentsConsumed + exact ⟨(Lower.consumeCapabilitiesList?_size argumentsConsumed).trans + (Lower.consumeCapability?_size functionConsumed), remainingHolds⟩ + +/-- A capability vector accepted by the ordinary-call suspension audit has +no borrowed slot at any index. -/ +private theorem borrowed_impossible_of_noBorrows + {capabilities : Array Lower.BindingCap} + (noBorrows : Lower.noBorrows capabilities = true) + {index : Nat} {world : Ix.Compiler.Ixon.Owned} + {lender : BorrowLender} + (capabilityAt : capabilities[index]? = some (.borrowed world lender)) : + False := by + have listAt : capabilities.toList[index]? = + some (.borrowed world lender) := by + simpa using capabilityAt + have member : (.borrowed world lender : Lower.BindingCap) ∈ + capabilities.toList := List.mem_of_getElem? listAt + unfold Lower.noBorrows at noBorrows + have point := List.all_eq_true.mp noBorrows _ member + simp [Lower.BindingCap.isBorrowed] at point + +/-- Reinstall an ordinary caller after its callee returns. Scalar/dead facts +survive independently of the heap, surviving owners are justified by the +returned framed root ownership, and the call audit rules out suspended +borrows. -/ +theorem callResultInvariant + {beforeStore afterStore : IxIR1.Store} {source : List RVal} + {input afterInput : Array (Option Atom)} + {capabilities remaining : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} {signature : Signature} + {arguments : Array IxIR1.Atom} {values : List RVal} {value : RVal} + (invariant : SourceOwnershipInvariant beforeStore source input capabilities + frameRoots) + (resolved : IxIR1.resolveAtoms source arguments = .ok values) + (consumed : Lower.callRemainingCapabilities? capabilities input signature + arguments = some remaining) + (noBorrows : Lower.noBorrows remaining = true) + (resultOwnership : IxIR1.Sim.RootOwnership afterStore + (⟨signature.result, value⟩ :: + (rootsForCapabilities remaining.toList source ++ frameRoots))) : + SourceOwnershipInvariant afterStore (value :: source) afterInput + (#[.owned signature.result] ++ remaining) frameRoots := by + unfold Lower.callRemainingCapabilities? at consumed + cases projectedEq : Lower.ownedParameterWorlds? + signature.params.toList with + | none => simp [projectedEq] at consumed + | some worlds => + simp only [projectedEq, Option.bind_eq_bind, Option.bind_some] at consumed + have resolvedRelation := SourceAtomsResolve.ofResolveAtoms resolved + obtain ⟨remainingHolds, _⟩ := consumeCapabilitiesWorlds_ownership + (consumedRoots := []) (suffixRoots := frameRoots) invariant.holds + (by simpa using invariant.ownership) resolvedRelation consumed + have remainingSize := Lower.consumeCapabilitiesWorlds?_size consumed + refine ⟨?_, ?_, ?_, ?_⟩ + · simp [Array.size_append, remainingSize, invariant.length, + Nat.add_comm] + · intro index capability selected capabilityAt selectedAt + cases index with + | zero => + simp [Array.getElem?_append] at capabilityAt selectedAt + subst capability + subst selected + exact resultOwnership.roots_world + ⟨signature.result, value⟩ (by simp) + | succ index => + simp [Array.getElem?_append] at capabilityAt selectedAt + cases capability with + | scalar => + simpa [CapabilityHolds] using + remainingHolds capabilityAt selectedAt + | dead => trivial + | borrowed world lender => + exact False.elim + (borrowed_impossible_of_noBorrows noBorrows capabilityAt) + | owned world => + exact resultOwnership.roots_world ⟨world, selected⟩ (by + simp [rootsForCapabilities_owned_mem capabilityAt selectedAt]) + · simpa [rootsForCapabilities, List.append_assoc] using resultOwnership + · intro index world lender selected capabilityAt selectedAt + cases index with + | zero => simp [Array.getElem?_append] at capabilityAt + | succ index => + simp [Array.getElem?_append] at capabilityAt selectedAt + exact False.elim + (borrowed_impossible_of_noBorrows noBorrows capabilityAt) + +/-- Sequential owned-boundary consumption preserves every surviving borrow's +exact lender provenance. -/ +private theorem consumeCapabilitiesList_borrows + {store : IxIR1.Store} {source : List RVal} + {input : Array (Option Atom)} + {capabilities remaining : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + (oldBorrows : ∀ {index : Nat} {world : Ix.Compiler.Ixon.Owned} + {lender : BorrowLender} {value : RVal}, + capabilities[index]? = some (.borrowed world lender) → + source[index]? = some value → + BorrowProvenance store source input capabilities frameRoots world lender + value) + {world : Ix.Compiler.Ixon.Owned} {atoms : List IxIR1.Atom} + (consumed : Lower.consumeCapabilitiesList? capabilities input world atoms = + some remaining) : + ∀ {index : Nat} {borrowWorld : Ix.Compiler.Ixon.Owned} + {lender : BorrowLender} {value : RVal}, + remaining[index]? = some (.borrowed borrowWorld lender) → + source[index]? = some value → + BorrowProvenance store source input remaining frameRoots borrowWorld + lender value := by + induction atoms generalizing capabilities with + | nil => + simp only [Lower.consumeCapabilitiesList?] at consumed + injection consumed with remainingEq + subst remaining + exact oldBorrows + | cons atom atoms ih => + simp only [Lower.consumeCapabilitiesList?] at consumed + cases step : Lower.consumeCapability? capabilities input world atom with + | none => simp [step] at consumed + | some nextCapabilities => + simp only [step] at consumed + exact ih (consumeCapability_borrows oldBorrows step) consumed + +/-- After one owner has been consumed, a destructive store restriction and +the exact surviving roots suffice to bind the erased scalar result and rebuild +all pointwise capability and borrow facts. -/ +private theorem prependScalarAfterRestriction + {before after : IxIR1.Store} {source : List RVal} + {input afterInput : Array (Option Atom)} + {capabilities remaining : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + (invariant : SourceOwnershipInvariant before source input capabilities + frameRoots) + {headAtom : Atom} + (forgets : Lower.InputMap.Forgets afterInput + (#[some headAtom] ++ input)) + (afterOwners : OwnedInputRegisters afterInput + (#[.scalar] ++ remaining)) + {world : Ix.Compiler.Ixon.Owned} {atom : IxIR1.Atom} {value : RVal} + (resolved : IxIR1.resolveAtom source atom = .ok value) + (consumed : Lower.consumeCapability? capabilities input world atom = + some remaining) + (restriction : IxIR1.Sim.StoreGraphRestricts before after) + (ownership : IxIR1.Sim.RootOwnership after + (rootsForCapabilities remaining.toList source ++ frameRoots)) : + SourceOwnershipInvariant after (.erased :: source) afterInput + (#[.scalar] ++ remaining) frameRoots := by + obtain ⟨remainingHolds, _⟩ := + consumeCapability_ownership (consumedRoots := []) + (suffixRoots := frameRoots) invariant.holds + (by simpa using invariant.ownership) resolved consumed + have remainingBorrows : + ∀ {index : Nat} {borrowWorld : Ix.Compiler.Ixon.Owned} + {lender : BorrowLender} {borrowedValue : RVal}, + remaining[index]? = some (.borrowed borrowWorld lender) → + source[index]? = some borrowedValue → + BorrowProvenance before source input remaining frameRoots borrowWorld + lender borrowedValue := + consumeCapability_borrows invariant.borrows consumed + have postBorrows : + ∀ {index : Nat} {borrowWorld : Ix.Compiler.Ixon.Owned} + {lender : BorrowLender} {borrowedValue : RVal}, + remaining[index]? = some (.borrowed borrowWorld lender) → + source[index]? = some borrowedValue → + BorrowProvenance after source input remaining frameRoots borrowWorld + lender borrowedValue := by + intro index borrowWorld lender borrowedValue capabilityAt valueAt + exact BorrowProvenance.ofRestricts restriction ownership + (remainingBorrows capabilityAt valueAt) + have remainingSize : remaining.size = capabilities.size := + Lower.consumeCapability?_size consumed + refine ⟨by + simp [Array.size_append, invariant.length, remainingSize, Nat.add_comm], + ?_, ?_, ?_⟩ + · intro index capability selected capabilityAt selectedAt + cases index with + | zero => + simp [Array.getElem?_append] at capabilityAt selectedAt + subst capability + subst selected + rfl + | succ index => + simp [Array.getElem?_append] at capabilityAt selectedAt + cases capability with + | scalar => exact remainingHolds capabilityAt selectedAt + | dead => trivial + | owned actual => + exact ownership.roots_world ⟨actual, selected⟩ + (List.mem_append_left _ + (rootsForCapabilities_owned_mem capabilityAt selectedAt)) + | borrowed actual lender => + exact (postBorrows capabilityAt selectedAt).hasWorld ownership + · simpa [rootsForCapabilities] using ownership + · exact BorrowProvenance.prependNonBorrowed + (IxIR1.Sim.StoreGraphExtends.refl after) postBorrows + (by intros; simp) forgets afterOwners + +/-- Exact shared destruction consumes its selected shared owner, transports all +surviving lender paths through the restricted heap, and binds the erased +result. -/ +theorem drop {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {sourceCurrent : IxIR1.FnDef} {store outputStore : IxIR1.Store} + {source : List RVal} + {input afterInput : Array (Option Atom)} + {capabilities afterCapabilities : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + (invariant : SourceOwnershipInvariant store source input capabilities + frameRoots) + {headAtom : Atom} + (forgets : Lower.InputMap.Forgets afterInput + (#[some headAtom] ++ input)) + (afterOwners : OwnedInputRegisters afterInput afterCapabilities) + {atom : IxIR1.Atom} {result : RVal} + (transition : Lower.destructionCapabilities? capabilities input .shared + atom = some afterCapabilities) + (operationRun : IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent + store source (.drop atom) = .ok (outputStore, result)) : + SourceOwnershipInvariant outputStore (result :: source) afterInput + afterCapabilities frameRoots := by + obtain ⟨value, resolved, _⟩ := IxIR1.runOp_drop_success operationRun + cases consumedEq : Lower.consumeCapability? capabilities input .shared atom with + | none => + simp [Lower.destructionCapabilities?, consumedEq] at transition + | some remaining => + have afterEq : #[.scalar] ++ remaining = afterCapabilities := by + simpa [Lower.destructionCapabilities?, consumedEq] using transition + subst afterCapabilities + obtain ⟨_, readyOwnership⟩ := + consumeCapability_ownership (consumedRoots := []) + (suffixRoots := frameRoots) invariant.holds + (by simpa using invariant.ownership) resolved consumedEq + have readyOwnership' : IxIR1.Sim.RootOwnership store + (⟨.shared, value⟩ :: + (rootsForCapabilities remaining.toList source ++ frameRoots)) := by + simpa [List.append_assoc] using readyOwnership + obtain ⟨resultEq, restriction, postOwnership⟩ := + IxIR1.Sim.runOp_drop_value_owned_restricts resolved readyOwnership' + operationRun + subst result + exact prependScalarAfterRestriction invariant forgets afterOwners + resolved consumedEq restriction postOwnership + +/-- Exact unique recursive destruction has the same ownership interface as +shared destruction, specialized to a unique consumed root. -/ +theorem dropU {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {sourceCurrent : IxIR1.FnDef} {store outputStore : IxIR1.Store} + {source : List RVal} + {input afterInput : Array (Option Atom)} + {capabilities afterCapabilities : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + (invariant : SourceOwnershipInvariant store source input capabilities + frameRoots) + {headAtom : Atom} + (forgets : Lower.InputMap.Forgets afterInput + (#[some headAtom] ++ input)) + (afterOwners : OwnedInputRegisters afterInput afterCapabilities) + {atom : IxIR1.Atom} {result : RVal} + (transition : Lower.destructionCapabilities? capabilities input .unique + atom = some afterCapabilities) + (operationRun : IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent + store source (.dropU atom) = .ok (outputStore, result)) : + SourceOwnershipInvariant outputStore (result :: source) afterInput + afterCapabilities frameRoots := by + obtain ⟨value, resolved, _⟩ := IxIR1.runOp_dropU_success operationRun + cases consumedEq : Lower.consumeCapability? capabilities input .unique atom with + | none => + simp [Lower.destructionCapabilities?, consumedEq] at transition + | some remaining => + have afterEq : #[.scalar] ++ remaining = afterCapabilities := by + simpa [Lower.destructionCapabilities?, consumedEq] using transition + subst afterCapabilities + obtain ⟨_, readyOwnership⟩ := + consumeCapability_ownership (consumedRoots := []) + (suffixRoots := frameRoots) invariant.holds + (by simpa using invariant.ownership) resolved consumedEq + have readyOwnership' : IxIR1.Sim.RootOwnership store + (⟨.unique, value⟩ :: + (rootsForCapabilities remaining.toList source ++ frameRoots)) := by + simpa [List.append_assoc] using readyOwnership + obtain ⟨resultEq, restriction, postOwnership⟩ := + IxIR1.Sim.runOp_dropU_value_owned_restricts resolved readyOwnership' + operationRun + subst result + exact prependScalarAfterRestriction invariant forgets afterOwners + resolved consumedEq restriction postOwnership + +/-- Checked scalar-leaf shallow free consumes the selected unique owner. The +freed constructor's scalar fields contribute no surviving heap roots, while +all unrelated owners and lender paths transport through the one-node kill. -/ +theorem free {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {sourceCurrent : IxIR1.FnDef} {store outputStore : IxIR1.Store} + {source : List RVal} + {input afterInput : Array (Option Atom)} + {capabilities afterCapabilities : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + (invariant : SourceOwnershipInvariant store source input capabilities + frameRoots) + {headAtom : Atom} + (forgets : Lower.InputMap.Forgets afterInput + (#[some headAtom] ++ input)) + (afterOwners : OwnedInputRegisters afterInput afterCapabilities) + {atom : IxIR1.Atom} {location : Nat} {box : IxIR1.NodeBox} + {identity : CtorId} {fields : Array RVal} {result : RVal} + (transition : Lower.destructionCapabilities? capabilities input .unique + atom = some afterCapabilities) + (resolved : IxIR1.resolveAtom source atom = .ok (.loc location)) + (sourceGet : store.get? location = some box) + (unique : box.world = .unique) + (node : box.node = .ctorN identity fields) + (scalarFields : fields.all IxIR1.RVal.isScalar = true) + (operationRun : IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent + store source (.free atom) = .ok (outputStore, result)) : + SourceOwnershipInvariant outputStore (result :: source) afterInput + afterCapabilities frameRoots := by + cases consumedEq : Lower.consumeCapability? capabilities input .unique atom with + | none => + simp [Lower.destructionCapabilities?, consumedEq] at transition + | some remaining => + have afterEq : #[.scalar] ++ remaining = afterCapabilities := by + simpa [Lower.destructionCapabilities?, consumedEq] using transition + subst afterCapabilities + obtain ⟨_, readyOwnership⟩ := + consumeCapability_ownership (consumedRoots := []) + (suffixRoots := frameRoots) invariant.holds + (by simpa using invariant.ownership) resolved consumedEq + have readyOwnership' : IxIR1.Sim.RootOwnership store + (⟨.unique, (.loc location : RVal)⟩ :: + (rootsForCapabilities remaining.toList source ++ frameRoots)) := by + simpa [List.append_assoc] using readyOwnership + cases box with + | mk actualWorld rc actualNode => + simp only at unique node sourceGet + subst actualWorld + have rcOne : rc = 1 := (readyOwnership'.counts sourceGet).1 + subst rc + have killedOwnership := readyOwnership'.killUniqueOne sourceGet + have scalarChildren : + (IxIR1.Sim.nodeChildren actualNode).all IxIR1.RVal.isScalar = + true := by + rw [node] + simpa [IxIR1.Sim.nodeChildren] using scalarFields + have postOwnership : IxIR1.Sim.RootOwnership + (store.kill location) + (rootsForCapabilities remaining.toList source ++ frameRoots) := + killedOwnership.dropScalars scalarChildren + have expectedRun := IxIR1.Sim.runOp_free + (ctx := sourceContext) (fuel := sourceFuel) (cur := sourceCurrent) + resolved sourceGet + have outputEq : + (store.kill location, (.erased : RVal)) = + (outputStore, result) := + Except.ok.inj (expectedRun.symm.trans operationRun) + have outputStoreEq : store.kill location = outputStore := + congrArg Prod.fst outputEq + have resultEq : (.erased : RVal) = result := + congrArg Prod.snd outputEq + subst outputStore + subst result + exact prependScalarAfterRestriction invariant forgets afterOwners + resolved consumedEq (IxIR1.Sim.StoreGraphRestricts.kill sourceGet) + postOwnership + +/-- The checked producer capability vector and the dynamic ownership +invariant establish every field world needed by target allocation. -/ +theorem resolveAtoms_hasWorld + {store : IxIR1.Store} {source : List RVal} + {position : Lower.PositionTrace} + {site : Lower.SourceSite} {block : BlockId} {index : Nat} + {input : Array (Option Atom)} {world : Ix.Compiler.Ixon.Owned} + {frameRoots : List IxIR1.Sim.Root} + (invariant : SourceOwnershipInvariant store source input + position.sourceCapabilities frameRoots) + {arguments : Array IxIR1.Atom} {values : List RVal} + (positionMatch : position.allocationMatches site block index input world + arguments = true) + (resolved : IxIR1.resolveAtoms source arguments = .ok values) : + ∀ value ∈ values, IxIR1.Sim.HasWorld store world value := by + apply SourceAtomsResolve.worlds invariant + (SourceAtomsResolve.ofResolveAtoms resolved) + intro atom member + exact position.sourceCapability_canConsume_of_allocationMatch + positionMatch member + +/-- Before a checked allocation mutates the store, its sequential capability +consumption already exposes the exact constructor-field roots followed by all +surviving source and suspended-frame roots. This is the pre-allocation +accounting boundary used by reuse proofs that need a root partition rather +than only the post-allocation invariant. -/ +theorem allocationReadyOwnership + {store : IxIR1.Store} {source values : List RVal} + {input : Array (Option Atom)} + {capabilities afterCapabilities : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + (invariant : SourceOwnershipInvariant store source input capabilities + frameRoots) + {world : Ix.Compiler.Ixon.Owned} {arguments : Array IxIR1.Atom} + (resolved : IxIR1.resolveAtoms source arguments = .ok values) + (transition : Lower.allocationCapabilities? capabilities input world + arguments = some afterCapabilities) : + ∃ remaining, + Lower.consumeCapabilitiesList? capabilities input world + arguments.toList = some remaining ∧ + afterCapabilities = #[.owned world] ++ remaining ∧ + IxIR1.Sim.RootOwnership store + (IxIR1.Sim.rootsFor world values ++ + rootsForCapabilities remaining.toList source ++ frameRoots) := by + cases consumeEq : Lower.consumeCapabilitiesList? capabilities input world + arguments.toList with + | none => + simp [Lower.allocationCapabilities?, consumeEq] at transition + | some remaining => + have afterEq : #[.owned world] ++ remaining = afterCapabilities := by + simpa [Lower.allocationCapabilities?, consumeEq] using transition + have resolvedRelation := SourceAtomsResolve.ofResolveAtoms resolved + obtain ⟨_remainingHolds, readyOwnership⟩ := + consumeCapabilitiesList_ownership (consumedRoots := []) + (suffixRoots := frameRoots) invariant.holds + (by simpa using invariant.ownership) resolvedRelation consumeEq + exact ⟨remaining, rfl, afterEq.symm, + by simpa [List.append_assoc] using readyOwnership⟩ + +/-- The exact producer ordinary-allocation transition consumes every field +owner into the new constructor and exposes ownership of the fresh result. +All surviving source capability facts transport across the append allocation. -/ +theorem alloc {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {sourceCurrent : IxIR1.FnDef} {store outputStore : IxIR1.Store} + {source : List RVal} + {input afterInput : Array (Option Atom)} + {capabilities afterCapabilities : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + (invariant : SourceOwnershipInvariant store source input capabilities + frameRoots) + {headAtom : Atom} + (forgets : Lower.InputMap.Forgets afterInput (#[some headAtom] ++ input)) + (afterOwners : OwnedInputRegisters afterInput afterCapabilities) + {world : Ix.Compiler.Ixon.Owned} {identity : CtorId} + {arguments : Array IxIR1.Atom} {value : RVal} + (transition : Lower.allocationCapabilities? capabilities input world + arguments = + some afterCapabilities) + (operationRun : IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent + store source (.alloc world identity arguments) = + .ok (outputStore, value)) : + SourceOwnershipInvariant outputStore (value :: source) afterInput + afterCapabilities frameRoots := by + obtain ⟨values, resolved, outputEq⟩ := + IxIR1.runOp_alloc_success operationRun + have outputStoreEq : outputStore = + (store.allocNode world (.ctorN identity values.toArray)).1 := + congrArg Prod.fst outputEq + have valueEq : value = + .loc (store.allocNode world (.ctorN identity values.toArray)).2 := + congrArg Prod.snd outputEq + subst outputStore + subst value + cases consumeEq : Lower.consumeCapabilitiesList? capabilities input world + arguments.toList with + | none => + simp [Lower.allocationCapabilities?, consumeEq] at transition + | some remaining => + have afterEq : + #[.owned world] ++ remaining = afterCapabilities := by + simpa [Lower.allocationCapabilities?, consumeEq] using transition + subst afterCapabilities + have resolvedRelation := SourceAtomsResolve.ofResolveAtoms resolved + obtain ⟨remainingHolds, readyOwnership⟩ := + consumeCapabilitiesList_ownership (consumedRoots := []) + (suffixRoots := frameRoots) + invariant.holds (by simpa using invariant.ownership) + resolvedRelation consumeEq + have readyOwnership' : IxIR1.Sim.RootOwnership store + (IxIR1.Sim.rootsFor world values ++ + rootsForCapabilities remaining.toList source ++ frameRoots) := by + simpa using readyOwnership + have allocatedOwnership := + (IxIR1.Sim.runOp_alloc_owned + (ctx := sourceContext) (fuel := sourceFuel) + (cur := sourceCurrent) (cid := identity) (args := arguments) + resolved + (by simpa [List.append_assoc] using readyOwnership')).2 + have remainingSize : remaining.size = capabilities.size := + Lower.consumeCapabilitiesList?_size consumeEq + have remainingBorrows : + ∀ {index : Nat} {borrowWorld : Ix.Compiler.Ixon.Owned} + {lender : BorrowLender} {borrowedValue : RVal}, + remaining[index]? = some (.borrowed borrowWorld lender) → + source[index]? = some borrowedValue → + BorrowProvenance store source input remaining frameRoots + borrowWorld lender borrowedValue := + consumeCapabilitiesList_borrows invariant.borrows consumeEq + refine ⟨by + simp [Array.size_append, remainingSize, invariant.length, + Nat.add_comm], ?_, ?_, ?_⟩ + · intro index capability selected capabilityAt selectedAt + cases index with + | zero => + simp [Array.getElem?_append] at capabilityAt selectedAt + subst capability + subst selected + exact IxIR1.Sim.HasWorld.allocNode_new store world + (.ctorN identity values.toArray) + | succ index => + simp [Array.getElem?_append] at capabilityAt selectedAt + exact (remainingHolds capabilityAt selectedAt).allocNode + · simpa [rootsForCapabilities] using allocatedOwnership + · exact BorrowProvenance.prependNonBorrowed + (IxIR1.Sim.StoreGraphExtends.allocNode store world + (.ctorN identity values.toArray)) remainingBorrows + (by intros; simp) forgets afterOwners + +/-- Function partial application consumes its shared capture owners into a +fresh shared PAP node and exposes the fresh PAP owner. -/ +theorem papp {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {sourceCurrent : IxIR1.FnDef} {store outputStore : IxIR1.Store} + {source : List RVal} + {input afterInput : Array (Option Atom)} + {capabilities afterCapabilities : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + (invariant : SourceOwnershipInvariant store source input capabilities + frameRoots) + {headAtom : Atom} + (forgets : Lower.InputMap.Forgets afterInput (#[some headAtom] ++ input)) + (afterOwners : OwnedInputRegisters afterInput afterCapabilities) + {function : Ix.Compiler.Ixon.Address} + {arguments : Array IxIR1.Atom} {value : RVal} + (transition : Lower.allocationCapabilities? capabilities input .shared + arguments = + some afterCapabilities) + (operationRun : IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent + store source (.papp function arguments) = + .ok (outputStore, value)) : + SourceOwnershipInvariant outputStore (value :: source) afterInput + afterCapabilities frameRoots := by + obtain ⟨values, declaration, resolved, declarationAt, under, outputEq⟩ := + IxIR1.runOp_papp_success operationRun + have outputStoreEq : outputStore = + (store.allocNode .shared + (.papN function (IxIR1.declArity declaration) values.toArray)).1 := + congrArg Prod.fst outputEq + have valueEq : value = + .loc (store.allocNode .shared + (.papN function (IxIR1.declArity declaration) values.toArray)).2 := + congrArg Prod.snd outputEq + subst outputStore + subst value + cases consumeEq : Lower.consumeCapabilitiesList? capabilities input .shared + arguments.toList with + | none => + simp [Lower.allocationCapabilities?, consumeEq] at transition + | some remaining => + have afterEq : + #[.owned .shared] ++ remaining = afterCapabilities := by + simpa [Lower.allocationCapabilities?, consumeEq] using transition + subst afterCapabilities + have resolvedRelation := SourceAtomsResolve.ofResolveAtoms resolved + obtain ⟨remainingHolds, readyOwnership⟩ := + consumeCapabilitiesList_ownership (consumedRoots := []) + (suffixRoots := frameRoots) + invariant.holds (by simpa using invariant.ownership) + resolvedRelation consumeEq + have readyOwnership' : IxIR1.Sim.RootOwnership store + (IxIR1.Sim.rootsFor .shared values ++ + rootsForCapabilities remaining.toList source ++ frameRoots) := by + simpa using readyOwnership + have allocatedOwnership := + (IxIR1.Sim.runOp_papp_owned + (ctx := sourceContext) (fuel := sourceFuel) + (cur := sourceCurrent) (f := function) (atoms := arguments) + resolved declarationAt under + (by simpa [List.append_assoc] using readyOwnership')).2 + have remainingSize : remaining.size = capabilities.size := + Lower.consumeCapabilitiesList?_size consumeEq + have remainingBorrows : + ∀ {index : Nat} {borrowWorld : Ix.Compiler.Ixon.Owned} + {lender : BorrowLender} {borrowedValue : RVal}, + remaining[index]? = some (.borrowed borrowWorld lender) → + source[index]? = some borrowedValue → + BorrowProvenance store source input remaining frameRoots + borrowWorld lender borrowedValue := + consumeCapabilitiesList_borrows invariant.borrows consumeEq + refine ⟨by + simp [Array.size_append, remainingSize, invariant.length, + Nat.add_comm], ?_, ?_, ?_⟩ + · intro index capability selected capabilityAt selectedAt + cases index with + | zero => + simp [Array.getElem?_append] at capabilityAt selectedAt + subst capability + subst selected + exact IxIR1.Sim.HasWorld.allocNode_new store .shared + (.papN function (IxIR1.declArity declaration) values.toArray) + | succ index => + simp [Array.getElem?_append] at capabilityAt selectedAt + exact (remainingHolds capabilityAt selectedAt).allocNode + · simpa [rootsForCapabilities] using allocatedOwnership + · exact BorrowProvenance.prependNonBorrowed + (IxIR1.Sim.StoreGraphExtends.allocNode store .shared + (.papN function (IxIR1.declArity declaration) values.toArray)) + remainingBorrows (by intros; simp) forgets afterOwners + +private theorem rootsForCapabilities_replicate_owned + (world : Ix.Compiler.Ixon.Owned) : ∀ (values : List RVal), + rootsForCapabilities + (List.replicate values.length (Lower.BindingCap.owned world)) values = + IxIR1.Sim.rootsFor world values := by + intro values + induction values with + | nil => rfl + | cons value values ih => + simp [List.replicate_succ, rootsForCapabilities, + IxIR1.Sim.rootsFor, ih] + +/-- A same-length all-shared owned capability vector realizes the canonical +reversed source environment at a dynamically selected PAP callee entry. -/ +theorem sharedEntry {store : IxIR1.Store} {values : List RVal} + {input : Array (Option Atom)} {capabilities : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + (shape : capabilities = + Array.replicate values.length (.owned .shared)) + (ownership : IxIR1.Sim.RootOwnership store + (IxIR1.Sim.rootsFor .shared values ++ frameRoots)) : + SourceOwnershipInvariant store values.reverse input capabilities + frameRoots := by + subst capabilities + have rootsEq : + rootsForCapabilities + (Array.replicate values.length + (Lower.BindingCap.owned .shared)).toList values.reverse = + (IxIR1.Sim.rootsFor .shared values).reverse := by + calc + _ = IxIR1.Sim.rootsFor .shared values.reverse := by + simpa using rootsForCapabilities_replicate_owned .shared + values.reverse + _ = _ := by simp [IxIR1.Sim.rootsFor, List.map_reverse] + have entryOwnership : IxIR1.Sim.RootOwnership store + (rootsForCapabilities + (Array.replicate values.length + (Lower.BindingCap.owned .shared)).toList values.reverse ++ + frameRoots) := by + apply ownership.perm + rw [rootsEq] + exact (List.reverse_perm (IxIR1.Sim.rootsFor .shared values)).symm + |>.append_right frameRoots + refine ⟨by simp, ?_, entryOwnership, ?_⟩ + · intro index capability selected capabilityAt selectedAt + have capabilityEq : capability = .owned .shared := by + simp only [Array.getElem?_replicate] at capabilityAt + split at capabilityAt + next bound => exact Option.some.inj capabilityAt |>.symm + next bound => contradiction + subst capability + exact entryOwnership.roots_world ⟨.shared, selected⟩ + (List.mem_append_left _ + (rootsForCapabilities_owned_mem capabilityAt selectedAt)) + · intro index world lender selected capabilityAt selectedAt + simp only [Array.getElem?_replicate] at capabilityAt + split at capabilityAt + next bound => cases capabilityAt + next bound => contradiction + +/-- Consume a dynamic PAP function and its newly supplied arguments, then +replay the PAP retain/release prefix. The resulting roots are split between +the first callee entry and any residual `applyMore` arguments; surviving +caller owners remain as the final suspended-frame suffix. -/ +theorem preparePapEntry {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {store retainedStore readyStore : IxIR1.Store} {source : List RVal} + {input : Array (Option Atom)} + {capabilities afterFunction remaining : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + {functionAtom : IxIR1.Atom} {argumentAtoms : Array IxIR1.Atom} + {location rc : Nat} {address : Ix.Compiler.Ixon.Address} {arity : Nat} + {captured : Array RVal} {arguments supplied residual : List RVal} + (invariant : SourceOwnershipInvariant store source input capabilities + frameRoots) + (functionResolved : IxIR1.resolveAtom source functionAtom = + .ok (.loc location)) + (argumentsResolved : IxIR1.resolveAtoms source argumentAtoms = + .ok arguments) + (functionConsumed : Lower.consumeCapability? capabilities input .shared + functionAtom = some afterFunction) + (argumentsConsumed : Lower.consumeCapabilitiesList? afterFunction input + .shared argumentAtoms.toList = some remaining) + (papAt : store.get? location = + some ⟨.shared, rc, .papN address arity captured⟩) + (retained : IxIR1.dupVals store captured.toList = .ok retainedStore) + (released : IxIR1.dropVal sourceContext sourceFuel retainedStore + (.loc location) = .ok readyStore) + (split : captured.toList ++ arguments = supplied ++ residual) : + IxIR1.Sim.RootOwnership readyStore + (IxIR1.Sim.rootsFor .shared supplied ++ + IxIR1.Sim.rootsFor .shared residual ++ + rootsForCapabilities remaining.toList source ++ frameRoots) := by + obtain ⟨afterFunctionHolds, afterFunctionOwnership⟩ := + consumeCapability_ownership (consumedRoots := []) + (suffixRoots := frameRoots) invariant.holds + (by simpa using invariant.ownership) functionResolved functionConsumed + have resolvedRelation := SourceAtomsResolve.ofResolveAtoms argumentsResolved + obtain ⟨_, readyOwnership⟩ := + consumeCapabilitiesList_ownership + (consumedRoots := + [(⟨.shared, .loc location⟩ : IxIR1.Sim.Root)]) + (suffixRoots := frameRoots) afterFunctionHolds + (by simpa using afterFunctionOwnership) resolvedRelation + argumentsConsumed + have papOwnership := IxIR1.Sim.applyGo_preparePap_owned papAt + (by simpa [List.append_assoc] using readyOwnership) retained released + rw [split] at papOwnership + simpa [IxIR1.Sim.rootsFor, List.append_assoc] using papOwnership + +/-- Dynamic application consumes the shared function root and every supplied +shared argument root. A preservation law for this exact input heap returns +one shared result root while the checked suspension rule excludes borrows +from the surviving source frame. -/ +theorem applyFrom {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {sourceCurrent : IxIR1.FnDef} {store outputStore : IxIR1.Store} + {source : List RVal} + {input afterInput : Array (Option Atom)} + {capabilities afterCapabilities : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + (invariant : SourceOwnershipInvariant store source input capabilities + frameRoots) + {function : IxIR1.Atom} {arguments : Array IxIR1.Atom} {value : RVal} + (transition : Lower.applyCapabilities? capabilities input function + arguments = some afterCapabilities) + (noBorrows : Lower.noBorrows afterCapabilities = true) + (preserves : IxIR1.Sim.ApplyOwnershipPreservesFrom sourceContext + sourceFuel store) + (operationRun : IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent + store source (.apply function arguments) = .ok (outputStore, value)) : + SourceOwnershipInvariant outputStore (value :: source) afterInput + afterCapabilities frameRoots := by + obtain ⟨functionValue, values, functionResolved, argumentsResolved, + applyRun⟩ := + IxIR1.runOp_apply_success operationRun + unfold Lower.applyCapabilities? at transition + cases functionConsume : Lower.consumeCapability? capabilities input .shared + function with + | none => simp [functionConsume] at transition + | some afterFunction => + simp only [functionConsume, Option.bind_eq_bind, Option.bind_some] at transition + cases argumentsConsume : Lower.consumeCapabilitiesList? afterFunction + input .shared arguments.toList with + | none => simp [argumentsConsume] at transition + | some remaining => + have afterEq : + #[.owned .shared] ++ remaining = afterCapabilities := by + simpa [argumentsConsume] using transition + subst afterCapabilities + obtain ⟨afterFunctionHolds, afterFunctionOwnership⟩ := + consumeCapability_ownership (consumedRoots := []) + (suffixRoots := frameRoots) invariant.holds + (by simpa using invariant.ownership) functionResolved + functionConsume + have resolvedRelation := SourceAtomsResolve.ofResolveAtoms + argumentsResolved + obtain ⟨remainingHolds, readyOwnership⟩ := + consumeCapabilitiesList_ownership + (consumedRoots := + [(⟨.shared, functionValue⟩ : IxIR1.Sim.Root)]) + (suffixRoots := frameRoots) afterFunctionHolds + (by simpa using afterFunctionOwnership) resolvedRelation + argumentsConsume + have resultOwnership : IxIR1.Sim.RootOwnership outputStore + (⟨.shared, value⟩ :: + (rootsForCapabilities remaining.toList source ++ + frameRoots)) := by + exact preserves + (by simpa [List.append_assoc] using readyOwnership) applyRun + have remainingSize : remaining.size = capabilities.size := + (Lower.consumeCapabilitiesList?_size argumentsConsume).trans + (Lower.consumeCapability?_size functionConsume) + refine ⟨?_, ?_, ?_, ?_⟩ + · simp [Array.size_append, remainingSize, invariant.length, + Nat.add_comm] + · intro index capability selected capabilityAt selectedAt + cases index with + | zero => + simp [Array.getElem?_append] at capabilityAt selectedAt + subst capability + subst selected + exact resultOwnership.roots_world ⟨.shared, value⟩ (by simp) + | succ index => + simp [Array.getElem?_append] at capabilityAt selectedAt + cases capability with + | scalar => + simpa [CapabilityHolds] using + remainingHolds capabilityAt selectedAt + | dead => trivial + | borrowed world lender => + have fullAt : + (#[.owned .shared] ++ remaining)[index + 1]? = + some (.borrowed world lender) := by + simp [Array.getElem?_append, capabilityAt] + exact False.elim + (borrowed_impossible_of_noBorrows noBorrows fullAt) + | owned world => + exact resultOwnership.roots_world ⟨world, selected⟩ (by + simp [rootsForCapabilities_owned_mem capabilityAt + selectedAt]) + · simpa [rootsForCapabilities, List.append_assoc] using + resultOwnership + · intro index world lender selected capabilityAt selectedAt + exact False.elim + (borrowed_impossible_of_noBorrows noBorrows capabilityAt) + +/-- The traditional whole-context contract specializes the fixed-input rule +used by `applyFrom`. -/ +theorem apply {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {sourceCurrent : IxIR1.FnDef} {store outputStore : IxIR1.Store} + {source : List RVal} + {input afterInput : Array (Option Atom)} + {capabilities afterCapabilities : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + (invariant : SourceOwnershipInvariant store source input capabilities + frameRoots) + {function : IxIR1.Atom} {arguments : Array IxIR1.Atom} {value : RVal} + (transition : Lower.applyCapabilities? capabilities input function + arguments = some afterCapabilities) + (noBorrows : Lower.noBorrows afterCapabilities = true) + (contract : IxIR1.Sim.ApplyOwnershipContract sourceContext) + (operationRun : IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent + store source (.apply function arguments) = .ok (outputStore, value)) : + SourceOwnershipInvariant outputStore (value :: source) afterInput + afterCapabilities frameRoots := + invariant.applyFrom transition noBorrows + (contract.preservesFrom sourceFuel store) operationRun + +end SourceOwnershipInvariant + +namespace SourceOwnershipAt + +/-- A checked ordinary allocation transports trace-indexed ownership through +its exact sequential argument consumption and fresh-result binding. -/ +theorem alloc {checked : Lower.Checked} + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ checked.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount index : Nat} + {sourceWorld targetWorld : Ix.Compiler.Ixon.Owned} + {sourceCid targetCid : CtorId} + {sourceArguments : Array IxIR1.Atom} {targetArguments : Array Atom} + {next : Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next)) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {store outputStore : IxIR1.Store} {source : List RVal} {value : RVal} + {frameRoots : List IxIR1.Sim.Root} + (ownership : SourceOwnershipAt checked.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next) store source + frameRoots) + (operationRun : IxIR1.runOp sourceContext (sourceFuel + 1) + functionTrace.source store source + (.alloc sourceWorld sourceCid sourceArguments) = + .ok (outputStore, value)) : + SourceOwnershipAt checked.artifact.trace.positions next outputStore + (value :: source) frameRoots := by + intro after afterMember afterCoordinate + obtain ⟨before, beforeMember, beforeCoordinate, transitionMatch⟩ := + checked.allocationTransition functionMember descendant afterMember + afterCoordinate + have beforeInvariant := ownership before beforeMember (by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceBlock, + Lower.CodeTrace.targetPosition, Lower.CodeTrace.sourceInputMap] using + beforeCoordinate) + change SourceOwnershipInvariant store source input + before.sourceCapabilities frameRoots at beforeInvariant + have mapFacts := Lower.CodeTrace.inputMapForgets_of_match + (functionTrace.descendantInputMapsMatch descendant) (by rfl) + have letOpMatch := functionTrace.descendantLetOpMatch descendant + have forgets : Lower.InputMap.Forgets next.sourceInputMap + (#[some (.reg entryValueCount)] ++ input) := by + simpa [letOpMatch.1.nextInput] using mapFacts.2.2.1 + have afterOwners : OwnedInputRegisters next.sourceInputMap + after.sourceCapabilities := + OwnedInputRegisters.ofCoordinate afterCoordinate + unfold Lower.PositionTrace.allocationResultMatches at transitionMatch + cases transitionEq : Lower.allocationCapabilities? + before.sourceCapabilities input sourceWorld sourceArguments with + | none => simp [transitionEq] at transitionMatch + | some expected => + have expectedEq : expected = after.sourceCapabilities := by + simpa [transitionEq, beq_iff_eq] using transitionMatch + apply beforeInvariant.alloc forgets afterOwners (sourceFuel := sourceFuel) + (operationRun := operationRun) + simpa [expectedEq] using transitionEq + +/-- A checked function partial application transports trace-indexed ownership +through shared capture consumption and fresh PAP-owner binding. -/ +theorem papp {checked : Lower.Checked} + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ checked.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount index : Nat} + {sourceAddress targetAddress : Ix.Compiler.Ixon.Address} + {sourceArguments : Array IxIR1.Atom} {targetArguments : Array Atom} + {next : Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.papp sourceAddress sourceArguments) index + (.papp targetAddress targetArguments) next)) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {store outputStore : IxIR1.Store} {source : List RVal} {value : RVal} + {frameRoots : List IxIR1.Sim.Root} + (ownership : SourceOwnershipAt checked.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.papp sourceAddress sourceArguments) index + (.papp targetAddress targetArguments) next) store source + frameRoots) + (operationRun : IxIR1.runOp sourceContext (sourceFuel + 1) + functionTrace.source store source + (.papp sourceAddress sourceArguments) = + .ok (outputStore, value)) : + SourceOwnershipAt checked.artifact.trace.positions next outputStore + (value :: source) frameRoots := by + intro after afterMember afterCoordinate + obtain ⟨before, beforeMember, beforeCoordinate, transitionMatch⟩ := + checked.pappTransition functionMember descendant afterMember + afterCoordinate + have beforeInvariant := ownership before beforeMember (by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceBlock, + Lower.CodeTrace.targetPosition, Lower.CodeTrace.sourceInputMap] using + beforeCoordinate) + change SourceOwnershipInvariant store source input + before.sourceCapabilities frameRoots at beforeInvariant + have mapFacts := Lower.CodeTrace.inputMapForgets_of_match + (functionTrace.descendantInputMapsMatch descendant) (by rfl) + have letOpMatch := functionTrace.descendantLetOpMatch descendant + have forgets : Lower.InputMap.Forgets next.sourceInputMap + (#[some (.reg entryValueCount)] ++ input) := by + simpa [letOpMatch.1.nextInput] using mapFacts.2.2.1 + have afterOwners : OwnedInputRegisters next.sourceInputMap + after.sourceCapabilities := + OwnedInputRegisters.ofCoordinate afterCoordinate + unfold Lower.PositionTrace.allocationResultMatches at transitionMatch + cases transitionEq : Lower.allocationCapabilities? + before.sourceCapabilities input .shared sourceArguments with + | none => simp [transitionEq] at transitionMatch + | some expected => + have expectedEq : expected = after.sourceCapabilities := by + simpa [transitionEq, beq_iff_eq] using transitionMatch + apply beforeInvariant.papp forgets afterOwners (sourceFuel := sourceFuel) + (operationRun := operationRun) + simpa [expectedEq] using transitionEq + +/-- A checked dynamic application transports trace-indexed ownership through +the shared function/argument boundary using a preservation law for its exact +input heap, then reinstalls the surviving source frame around the returned +shared owner. -/ +theorem applyFrom {checked : Lower.Checked} + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ checked.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount index : Nat} + {sourceFunction : IxIR1.Atom} {sourceArguments : Array IxIR1.Atom} + {targetFunction : Atom} {targetArguments : Array Atom} + {next : Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next)) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {store outputStore : IxIR1.Store} {source : List RVal} {value : RVal} + {frameRoots : List IxIR1.Sim.Root} + (ownership : SourceOwnershipAt checked.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + store source frameRoots) + (preserves : IxIR1.Sim.ApplyOwnershipPreservesFrom sourceContext + sourceFuel store) + (operationRun : IxIR1.runOp sourceContext (sourceFuel + 1) + functionTrace.source store source + (.apply sourceFunction sourceArguments) = .ok (outputStore, value)) : + SourceOwnershipAt checked.artifact.trace.positions next outputStore + (value :: source) frameRoots := by + intro after afterMember afterCoordinate + obtain ⟨before, beforeMember, beforeCoordinate, transitionMatch⟩ := + checked.applyTransition functionMember descendant afterMember + afterCoordinate + have beforeInvariant := ownership before beforeMember (by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceBlock, + Lower.CodeTrace.targetPosition, Lower.CodeTrace.sourceInputMap] using + beforeCoordinate) + change SourceOwnershipInvariant store source input + before.sourceCapabilities frameRoots at beforeInvariant + unfold Lower.PositionTrace.applyResultMatches at transitionMatch + cases transitionEq : Lower.applyCapabilities? + before.sourceCapabilities input sourceFunction sourceArguments with + | none => simp [transitionEq] at transitionMatch + | some expected => + simp only [transitionEq, Bool.and_eq_true, beq_iff_eq] at transitionMatch + have transition : Lower.applyCapabilities? + before.sourceCapabilities input sourceFunction sourceArguments = + some after.sourceCapabilities := by + simpa [transitionMatch.2] using transitionEq + have noBorrows : Lower.noBorrows after.sourceCapabilities = true := by + simpa [transitionMatch.2] using transitionMatch.1 + exact beforeInvariant.applyFrom transition noBorrows preserves operationRun + +/-- The whole-context application contract remains a compatibility wrapper +around the reachable-heap `applyFrom` interface. -/ +theorem apply {checked : Lower.Checked} + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ checked.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount index : Nat} + {sourceFunction : IxIR1.Atom} {sourceArguments : Array IxIR1.Atom} + {targetFunction : Atom} {targetArguments : Array Atom} + {next : Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next)) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {store outputStore : IxIR1.Store} {source : List RVal} {value : RVal} + {frameRoots : List IxIR1.Sim.Root} + (ownership : SourceOwnershipAt checked.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + store source frameRoots) + (contract : IxIR1.Sim.ApplyOwnershipContract sourceContext) + (operationRun : IxIR1.runOp sourceContext (sourceFuel + 1) + functionTrace.source store source + (.apply sourceFunction sourceArguments) = .ok (outputStore, value)) : + SourceOwnershipAt checked.artifact.trace.positions next outputStore + (value :: source) frameRoots := + applyFrom functionMember descendant ownership + (contract.preservesFrom sourceFuel store) operationRun + +/-- A checked dynamic PAP application constructs the first callee's exact +entry ownership from the caller's current capability state. Exact +saturation uses an empty residual list; over-saturation frames the residual +shared arguments ahead of the surviving caller roots for `applyMore`. -/ +theorem applyPapEntry {checked : Lower.Checked} + {callerTrace calleeTrace : Lower.FunctionTrace} + (callerMember : callerTrace ∈ checked.artifact.trace.functions) + (calleeMember : calleeTrace ∈ checked.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount index : Nat} + {sourceFunction : IxIR1.Atom} {sourceArguments : Array IxIR1.Atom} + {instruction : Instr} {next : Lower.CodeTrace} + (descendant : callerTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index instruction next)) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {sourceStore retainedStore readyStore : IxIR1.Store} + {source : List RVal} {location rc : Nat} + {address : Ix.Compiler.Ixon.Address} {arity : Nat} + {captured : Array RVal} {arguments supplied residual : List RVal} + {frameRoots : List IxIR1.Sim.Root} + (ownership : SourceOwnershipAt checked.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index instruction next) + sourceStore source frameRoots) + (functionResolved : IxIR1.resolveAtom source sourceFunction = + .ok (.loc location)) + (argumentsResolved : IxIR1.resolveAtoms source sourceArguments = + .ok arguments) + (papAt : sourceStore.get? location = + some ⟨.shared, rc, .papN address arity captured⟩) + (retained : IxIR1.dupVals sourceStore captured.toList = .ok retainedStore) + (released : IxIR1.dropVal sourceContext sourceFuel retainedStore + (.loc location) = .ok readyStore) + (split : captured.toList ++ arguments = supplied ++ residual) + (entryArity : supplied.length = + calleeTrace.generated.signature.params.size) + (papSafe : calleeTrace.generated.signature.papSafe = true) : + ∃ before afterFunction remaining, + before ∈ checked.artifact.trace.positions ∧ + before.coordinateMatches site blockId (.instruction index) input = true ∧ + Lower.consumeCapability? before.sourceCapabilities input .shared + sourceFunction = some afterFunction ∧ + Lower.consumeCapabilitiesList? afterFunction input .shared + sourceArguments.toList = some remaining ∧ + Lower.noBorrows (#[.owned .shared] ++ remaining) = true ∧ + IxIR1.Sim.RootOwnership readyStore + (IxIR1.Sim.rootsFor .shared supplied ++ + IxIR1.Sim.rootsFor .shared residual ++ + rootsForCapabilities remaining.toList source ++ frameRoots) ∧ + SourceOwnershipAt checked.artifact.trace.positions calleeTrace.root + readyStore supplied.reverse + (IxIR1.Sim.rootsFor .shared residual ++ + rootsForCapabilities remaining.toList source ++ frameRoots) := by + have nextDescendant : callerTrace.root.Descendant next := + .step descendant (by simp [Lower.CodeTrace.children]) + obtain ⟨after, afterMember, afterCoordinate⟩ := + checked.position callerMember nextDescendant + obtain ⟨before, beforeMember, beforeCoordinate, transition⟩ := + checked.applyTransition callerMember descendant afterMember afterCoordinate + unfold Lower.PositionTrace.applyResultMatches at transition + unfold Lower.applyCapabilities? at transition + cases functionConsumed : Lower.consumeCapability? before.sourceCapabilities + input .shared sourceFunction with + | none => simp [functionConsumed] at transition + | some afterFunction => + simp only [functionConsumed, Option.bind_eq_bind, Option.bind_some] at transition + cases argumentsConsumed : Lower.consumeCapabilitiesList? afterFunction + input .shared sourceArguments.toList with + | none => simp [argumentsConsumed] at transition + | some remaining => + simp only [argumentsConsumed, Option.bind_some] at transition + change (Lower.noBorrows (#[.owned .shared] ++ remaining) && + (#[.owned .shared] ++ remaining == + after.sourceCapabilities)) = true at transition + simp only [Bool.and_eq_true, beq_iff_eq] at transition + have beforeInvariant := ownership before beforeMember (by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceBlock, + Lower.CodeTrace.targetPosition, + Lower.CodeTrace.sourceInputMap] using beforeCoordinate) + change SourceOwnershipInvariant sourceStore source input + before.sourceCapabilities frameRoots at beforeInvariant + have readyOwnership := beforeInvariant.preparePapEntry + functionResolved argumentsResolved functionConsumed + argumentsConsumed papAt retained released split + have entryShape : + Lower.entryCapabilities calleeTrace.generated.signature = + Array.replicate supplied.length (.owned .shared) := by + simpa [entryArity] using + checked.papSafeEntryCapabilities calleeMember papSafe + have calleeOwnership : SourceOwnershipAt + checked.artifact.trace.positions calleeTrace.root readyStore + supplied.reverse + (IxIR1.Sim.rootsFor .shared residual ++ + rootsForCapabilities remaining.toList source ++ + frameRoots) := by + intro entry entryMember entryCoordinate + rw [checked.entryCapabilities calleeMember entryMember + entryCoordinate] + exact SourceOwnershipInvariant.sharedEntry entryShape + (by simpa [List.append_assoc] using readyOwnership) + exact ⟨before, afterFunction, remaining, beforeMember, + beforeCoordinate, functionConsumed, argumentsConsumed, + transition.1, readyOwnership, calleeOwnership⟩ + +/-- A checked scalar-leaf shallow free derives its continuation ownership from +the exact destruction capability transition and the certified concrete leaf. -/ +theorem free {checked : Lower.Checked} + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ checked.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount index : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {targetCid : CtorId} + {next : Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.free sourceAtom) index (.freeUnique targetAtom targetCid) next)) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {store outputStore : IxIR1.Store} {source : List RVal} {value : RVal} + {location : Nat} {box : IxIR1.NodeBox} {identity : CtorId} + {fields : Array RVal} {frameRoots : List IxIR1.Sim.Root} + (ownership : SourceOwnershipAt checked.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.free sourceAtom) index (.freeUnique targetAtom targetCid) next) + store source frameRoots) + (resolved : IxIR1.resolveAtom source sourceAtom = .ok (.loc location)) + (sourceGet : store.get? location = some box) + (unique : box.world = .unique) + (node : box.node = .ctorN identity fields) + (scalarFields : fields.all IxIR1.RVal.isScalar = true) + (operationRun : IxIR1.runOp sourceContext (sourceFuel + 1) + functionTrace.source store source (.free sourceAtom) = + .ok (outputStore, value)) : + SourceOwnershipAt checked.artifact.trace.positions next outputStore + (value :: source) frameRoots := by + intro after afterMember afterCoordinate + obtain ⟨before, beforeMember, beforeCoordinate, transitionMatch⟩ := + checked.destructionTransition functionMember (by rfl) descendant afterMember + afterCoordinate + have beforeInvariant := ownership before beforeMember (by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceBlock, + Lower.CodeTrace.targetPosition, Lower.CodeTrace.sourceInputMap] using + beforeCoordinate) + change SourceOwnershipInvariant store source input + before.sourceCapabilities frameRoots at beforeInvariant + have mapFacts := Lower.CodeTrace.inputMapForgets_of_match + (functionTrace.descendantInputMapsMatch descendant) (by rfl) + have letOpMatch := functionTrace.descendantLetOpMatch descendant + have forgets : Lower.InputMap.Forgets next.sourceInputMap + (#[some .erased] ++ input) := by + simpa [letOpMatch.1.nextInput] using mapFacts.2.2.1 + have afterOwners : OwnedInputRegisters next.sourceInputMap + after.sourceCapabilities := + OwnedInputRegisters.ofCoordinate afterCoordinate + unfold Lower.PositionTrace.destructionResultMatches at transitionMatch + cases transitionEq : Lower.destructionCapabilities? + before.sourceCapabilities input .unique sourceAtom with + | none => simp [transitionEq] at transitionMatch + | some expected => + have expectedEq : expected = after.sourceCapabilities := by + simpa [transitionEq, beq_iff_eq] using transitionMatch + apply beforeInvariant.free forgets afterOwners + (sourceFuel := sourceFuel) (operationRun := operationRun) + (resolved := resolved) (sourceGet := sourceGet) (unique := unique) + (node := node) (scalarFields := scalarFields) + simpa [expectedEq] using transitionEq + +/-- A checked shared destruction derives its dynamic ownership transition from +the producer's exact consume-and-retire capability effect. -/ +theorem drop {checked : Lower.Checked} + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ checked.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount index : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {next : Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.drop sourceAtom) index (.releaseShared targetAtom) next)) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {store outputStore : IxIR1.Store} {source : List RVal} {value : RVal} + {frameRoots : List IxIR1.Sim.Root} + (ownership : SourceOwnershipAt checked.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.drop sourceAtom) index (.releaseShared targetAtom) next) store source + frameRoots) + (operationRun : IxIR1.runOp sourceContext (sourceFuel + 1) + functionTrace.source store source (.drop sourceAtom) = + .ok (outputStore, value)) : + SourceOwnershipAt checked.artifact.trace.positions next outputStore + (value :: source) frameRoots := by + intro after afterMember afterCoordinate + obtain ⟨before, beforeMember, beforeCoordinate, transitionMatch⟩ := + checked.destructionTransition functionMember (by rfl) descendant afterMember + afterCoordinate + have beforeInvariant := ownership before beforeMember (by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceBlock, + Lower.CodeTrace.targetPosition, Lower.CodeTrace.sourceInputMap] using + beforeCoordinate) + change SourceOwnershipInvariant store source input + before.sourceCapabilities frameRoots at beforeInvariant + have mapFacts := Lower.CodeTrace.inputMapForgets_of_match + (functionTrace.descendantInputMapsMatch descendant) (by rfl) + have letOpMatch := functionTrace.descendantLetOpMatch descendant + have forgets : Lower.InputMap.Forgets next.sourceInputMap + (#[some .erased] ++ input) := by + simpa [letOpMatch.1.nextInput] using mapFacts.2.2.1 + have afterOwners : OwnedInputRegisters next.sourceInputMap + after.sourceCapabilities := + OwnedInputRegisters.ofCoordinate afterCoordinate + unfold Lower.PositionTrace.destructionResultMatches at transitionMatch + cases transitionEq : Lower.destructionCapabilities? + before.sourceCapabilities input .shared sourceAtom with + | none => simp [transitionEq] at transitionMatch + | some expected => + have expectedEq : expected = after.sourceCapabilities := by + simpa [transitionEq, beq_iff_eq] using transitionMatch + apply beforeInvariant.drop forgets afterOwners (sourceFuel := sourceFuel) + (operationRun := operationRun) + simpa [expectedEq] using transitionEq + +/-- A checked unique recursive destruction derives the continuation ownership +invariant without an external semantic-transition premise. -/ +theorem dropU {checked : Lower.Checked} + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ checked.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount index : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {next : Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.dropU sourceAtom) index (.dropUnique targetAtom) next)) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {store outputStore : IxIR1.Store} {source : List RVal} {value : RVal} + {frameRoots : List IxIR1.Sim.Root} + (ownership : SourceOwnershipAt checked.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.dropU sourceAtom) index (.dropUnique targetAtom) next) store source + frameRoots) + (operationRun : IxIR1.runOp sourceContext (sourceFuel + 1) + functionTrace.source store source (.dropU sourceAtom) = + .ok (outputStore, value)) : + SourceOwnershipAt checked.artifact.trace.positions next outputStore + (value :: source) frameRoots := by + intro after afterMember afterCoordinate + obtain ⟨before, beforeMember, beforeCoordinate, transitionMatch⟩ := + checked.destructionTransition functionMember (by rfl) descendant afterMember + afterCoordinate + have beforeInvariant := ownership before beforeMember (by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceBlock, + Lower.CodeTrace.targetPosition, Lower.CodeTrace.sourceInputMap] using + beforeCoordinate) + change SourceOwnershipInvariant store source input + before.sourceCapabilities frameRoots at beforeInvariant + have mapFacts := Lower.CodeTrace.inputMapForgets_of_match + (functionTrace.descendantInputMapsMatch descendant) (by rfl) + have letOpMatch := functionTrace.descendantLetOpMatch descendant + have forgets : Lower.InputMap.Forgets next.sourceInputMap + (#[some .erased] ++ input) := by + simpa [letOpMatch.1.nextInput] using mapFacts.2.2.1 + have afterOwners : OwnedInputRegisters next.sourceInputMap + after.sourceCapabilities := + OwnedInputRegisters.ofCoordinate afterCoordinate + unfold Lower.PositionTrace.destructionResultMatches at transitionMatch + cases transitionEq : Lower.destructionCapabilities? + before.sourceCapabilities input .unique sourceAtom with + | none => simp [transitionEq] at transitionMatch + | some expected => + have expectedEq : expected = after.sourceCapabilities := by + simpa [transitionEq, beq_iff_eq] using transitionMatch + apply beforeInvariant.dropU forgets afterOwners (sourceFuel := sourceFuel) + (operationRun := operationRun) + simpa [expectedEq] using transitionEq + +/-- A checked addressed call consumes its argument owners and constructs the +callee's canonical entry invariant. The exact surviving caller roots are +returned as the suspended frame suffix. -/ +theorem callEntry {checked : Lower.Checked} + {callerTrace calleeTrace : Lower.FunctionTrace} + (callerMember : callerTrace ∈ checked.artifact.trace.functions) + (calleeMember : calleeTrace ∈ checked.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount index : Nat} + {address : Ix.Compiler.Ixon.Address} + {sourceArguments : Array IxIR1.Atom} {instruction : Instr} + {next : Lower.CodeTrace} + (descendant : callerTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.call address sourceArguments) index instruction next)) + (signatureAt : Lower.targetSignature? + checked.artifact.program.declarations address = + some calleeTrace.generated.signature) + {store : IxIR1.Store} {source values : List RVal} + {frameRoots : List IxIR1.Sim.Root} + (ownership : SourceOwnershipAt checked.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.call address sourceArguments) index instruction next) + store source frameRoots) + (resolved : IxIR1.resolveAtoms source sourceArguments = .ok values) : + ∃ before remaining, + before ∈ checked.artifact.trace.positions ∧ + before.coordinateMatches site blockId (.instruction index) input = true ∧ + Lower.callRemainingCapabilities? before.sourceCapabilities input + calleeTrace.generated.signature sourceArguments = some remaining ∧ + Lower.noBorrows remaining = true ∧ + SourceOwnershipAt checked.artifact.trace.positions calleeTrace.root store + values.reverse + (rootsForCapabilities remaining.toList source ++ frameRoots) := by + obtain ⟨before, beforeMember, beforeCoordinate⟩ := + checked.position callerMember descendant + have beforeCoordinate' : before.coordinateMatches site blockId + (.instruction index) input = true := by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceBlock, + Lower.CodeTrace.targetPosition, Lower.CodeTrace.sourceInputMap] using + beforeCoordinate + have nextDescendant : callerTrace.root.Descendant next := + .step descendant (by simp [Lower.CodeTrace.children]) + obtain ⟨after, afterMember, afterCoordinate⟩ := + checked.position callerMember nextDescendant + have transition := checked.callTransition callerMember signatureAt descendant + beforeMember beforeCoordinate' afterMember afterCoordinate + unfold Lower.PositionTrace.callResultMatches at transition + cases consumedEq : Lower.callRemainingCapabilities? + before.sourceCapabilities input calleeTrace.generated.signature + sourceArguments with + | none => simp [consumedEq] at transition + | some remaining => + simp only [consumedEq, Bool.and_eq_true, beq_iff_eq] at transition + refine ⟨before, remaining, beforeMember, beforeCoordinate', consumedEq, + transition.1, ?_⟩ + have beforeInvariant := ownership before beforeMember (by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceBlock, + Lower.CodeTrace.targetPosition, Lower.CodeTrace.sourceInputMap] using + beforeCoordinate) + change SourceOwnershipInvariant store source input + before.sourceCapabilities frameRoots at beforeInvariant + intro entry entryMember entryCoordinate + have entryEq := checked.entryCapabilities calleeMember entryMember + entryCoordinate + rw [entryEq] + exact beforeInvariant.callEntryInvariant resolved consumedEq + +/-- Recursive self-call entry has the same exact ownership transfer, using +the current checked signature as its ABI. -/ +theorem callSelfEntry {checked : Lower.Checked} + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ checked.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount index : Nat} + {sourceArguments : Array IxIR1.Atom} {instruction : Instr} + {next : Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.callSelf sourceArguments) index instruction next)) + {store : IxIR1.Store} {source values : List RVal} + {frameRoots : List IxIR1.Sim.Root} + (ownership : SourceOwnershipAt checked.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.callSelf sourceArguments) index instruction next) + store source frameRoots) + (resolved : IxIR1.resolveAtoms source sourceArguments = .ok values) : + ∃ before remaining, + before ∈ checked.artifact.trace.positions ∧ + before.coordinateMatches site blockId (.instruction index) input = true ∧ + Lower.callRemainingCapabilities? before.sourceCapabilities input + functionTrace.generated.signature sourceArguments = some remaining ∧ + Lower.noBorrows remaining = true ∧ + SourceOwnershipAt checked.artifact.trace.positions functionTrace.root + store values.reverse + (rootsForCapabilities remaining.toList source ++ frameRoots) := by + obtain ⟨before, beforeMember, beforeCoordinate⟩ := + checked.position functionMember descendant + have beforeCoordinate' : before.coordinateMatches site blockId + (.instruction index) input = true := by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceBlock, + Lower.CodeTrace.targetPosition, Lower.CodeTrace.sourceInputMap] using + beforeCoordinate + have nextDescendant : functionTrace.root.Descendant next := + .step descendant (by simp [Lower.CodeTrace.children]) + obtain ⟨after, afterMember, afterCoordinate⟩ := + checked.position functionMember nextDescendant + have transition := checked.callSelfTransition functionMember descendant + beforeMember beforeCoordinate' afterMember afterCoordinate + unfold Lower.PositionTrace.callResultMatches at transition + cases consumedEq : Lower.callRemainingCapabilities? + before.sourceCapabilities input functionTrace.generated.signature + sourceArguments with + | none => simp [consumedEq] at transition + | some remaining => + simp only [consumedEq, Bool.and_eq_true, beq_iff_eq] at transition + refine ⟨before, remaining, beforeMember, beforeCoordinate', consumedEq, + transition.1, ?_⟩ + have beforeInvariant := ownership before beforeMember (by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceBlock, + Lower.CodeTrace.targetPosition, Lower.CodeTrace.sourceInputMap] using + beforeCoordinate) + change SourceOwnershipInvariant store source input + before.sourceCapabilities frameRoots at beforeInvariant + intro entry entryMember entryCoordinate + have entryEq := checked.entryCapabilities functionMember entryMember + entryCoordinate + rw [entryEq] + exact beforeInvariant.callEntryInvariant resolved consumedEq + +/-- A checked addressed tail call transfers every local owner into the +callee, so the enclosing suspended-frame suffix is preserved exactly. -/ +theorem tailCallEntry {checked : Lower.Checked} + {callerTrace calleeTrace : Lower.FunctionTrace} + (callerMember : callerTrace ∈ checked.artifact.trace.functions) + (calleeMember : calleeTrace ∈ checked.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Array (Option Atom)} {entryValueCount : Nat} + {address : Ix.Compiler.Ixon.Address} + {sourceArguments : Array IxIR1.Atom} {generated : Block} + (descendant : callerTrace.root.Descendant + (.tailCall site blockId input entryValueCount address sourceArguments + generated)) + (signatureAt : Lower.targetSignature? + checked.artifact.program.declarations address = + some calleeTrace.generated.signature) + {store : IxIR1.Store} {source values : List RVal} + {frameRoots : List IxIR1.Sim.Root} + (ownership : SourceOwnershipAt checked.artifact.trace.positions + (.tailCall site blockId input entryValueCount address sourceArguments + generated) store source frameRoots) + (resolved : IxIR1.resolveAtoms source sourceArguments = .ok values) : + SourceOwnershipAt checked.artifact.trace.positions calleeTrace.root store + values.reverse frameRoots := by + obtain ⟨before, beforeMember, transition⟩ := + checked.tailCallPosition callerMember signatureAt descendant + unfold Lower.PositionTrace.tailCallMatches at transition + simp only [Bool.and_eq_true] at transition + cases consumedEq : Lower.callRemainingCapabilities? + before.sourceCapabilities input calleeTrace.generated.signature + sourceArguments with + | none => simp [consumedEq] at transition + | some remaining => + simp only [consumedEq] at transition + have noRoots := SourceOwnershipInvariant.rootsForCapabilities_eq_nil_of_noOwnedRoots + (source := source) transition.2 + have beforeInvariant := ownership before beforeMember (by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceBlock, + Lower.CodeTrace.targetPosition, Lower.CodeTrace.sourceInputMap] using + transition.1) + change SourceOwnershipInvariant store source input + before.sourceCapabilities frameRoots at beforeInvariant + intro entry entryMember entryCoordinate + have entryEq := checked.entryCapabilities calleeMember entryMember + entryCoordinate + rw [entryEq] + simpa [noRoots] using + beforeInvariant.callEntryInvariant (calleeInput := calleeTrace.root.sourceInputMap) + resolved consumedEq + +/-- A checked recursive tail call likewise transfers every local owner and +re-enters the same root with the unchanged enclosing frame suffix. -/ +theorem tailCallSelfEntry {checked : Lower.Checked} + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ checked.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Array (Option Atom)} {entryValueCount : Nat} + {sourceArguments : Array IxIR1.Atom} {generated : Block} + (descendant : functionTrace.root.Descendant + (.tailCallSelf site blockId input entryValueCount sourceArguments + generated)) + {store : IxIR1.Store} {source values : List RVal} + {frameRoots : List IxIR1.Sim.Root} + (ownership : SourceOwnershipAt checked.artifact.trace.positions + (.tailCallSelf site blockId input entryValueCount sourceArguments + generated) store source frameRoots) + (resolved : IxIR1.resolveAtoms source sourceArguments = .ok values) : + SourceOwnershipAt checked.artifact.trace.positions functionTrace.root store + values.reverse frameRoots := by + obtain ⟨before, beforeMember, transition⟩ := + checked.tailCallSelfPosition functionMember descendant + unfold Lower.PositionTrace.tailCallMatches at transition + simp only [Bool.and_eq_true] at transition + cases consumedEq : Lower.callRemainingCapabilities? + before.sourceCapabilities input functionTrace.generated.signature + sourceArguments with + | none => simp [consumedEq] at transition + | some remaining => + simp only [consumedEq] at transition + have noRoots := SourceOwnershipInvariant.rootsForCapabilities_eq_nil_of_noOwnedRoots + (source := source) transition.2 + have beforeInvariant := ownership before beforeMember (by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceBlock, + Lower.CodeTrace.targetPosition, Lower.CodeTrace.sourceInputMap] using + transition.1) + change SourceOwnershipInvariant store source input + before.sourceCapabilities frameRoots at beforeInvariant + intro entry entryMember entryCoordinate + have entryEq := checked.entryCapabilities functionMember entryMember + entryCoordinate + rw [entryEq] + simpa [noRoots] using + beforeInvariant.callEntryInvariant + (calleeInput := functionTrace.root.sourceInputMap) resolved consumedEq + +/-- At a checked return, consuming the declared result leaves exactly that +result root followed by the suspended caller-frame roots. -/ +theorem returnRoot {checked : Lower.Checked} + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ checked.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Array (Option Atom)} {entryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {generated : Block} + (descendant : functionTrace.root.Descendant + (.ret site blockId input entryValueCount sourceAtom targetAtom generated)) + {store : IxIR1.Store} {source : List RVal} {value : RVal} + {frameRoots : List IxIR1.Sim.Root} + (ownership : SourceOwnershipAt checked.artifact.trace.positions + (.ret site blockId input entryValueCount sourceAtom targetAtom generated) + store source frameRoots) + (resolved : IxIR1.resolveAtom source sourceAtom = .ok value) : + IxIR1.Sim.RootOwnership store + (⟨functionTrace.generated.signature.result, value⟩ :: frameRoots) := by + obtain ⟨position, positionMember, coordinate⟩ := + checked.position functionMember descendant + have coordinate' : position.coordinateMatches site blockId .terminator input = + true := by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceBlock, + Lower.CodeTrace.targetPosition, Lower.CodeTrace.sourceInputMap] using + coordinate + have transition := checked.returnPositionMatch functionMember descendant + positionMember coordinate' + unfold Lower.PositionTrace.returnMatches at transition + simp only [Bool.and_eq_true] at transition + cases consumedEq : Lower.consumeCapability? position.sourceCapabilities input + functionTrace.generated.signature.result sourceAtom with + | none => simp [consumedEq] at transition + | some remaining => + simp only [consumedEq] at transition + have invariant := ownership position positionMember coordinate + change SourceOwnershipInvariant store source input + position.sourceCapabilities frameRoots at invariant + obtain ⟨_, readyOwnership⟩ := + SourceOwnershipInvariant.consumeCapability_ownership + (consumedRoots := []) (suffixRoots := frameRoots) invariant.holds + (by simpa using invariant.ownership) resolved consumedEq + have noRoots := + SourceOwnershipInvariant.rootsForCapabilities_eq_nil_of_noOwnedRoots + (source := source) transition.2 + simpa [noRoots] using readyOwnership + +/-- Restore an addressed ordinary-call continuation directly from the +callee's terminal framed ownership, with no caller-supplied post-call +ownership premise. -/ +theorem callResult {checked : Lower.Checked} + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ checked.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount index : Nat} + {address : Ix.Compiler.Ixon.Address} {signature : Signature} + {sourceArguments : Array IxIR1.Atom} {instruction : Instr} + {next : Lower.CodeTrace} + (signatureAt : Lower.targetSignature? + checked.artifact.program.declarations address = some signature) + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.call address sourceArguments) index instruction next)) + {before : Lower.PositionTrace} {remaining : Array Lower.BindingCap} + (beforeMember : before ∈ checked.artifact.trace.positions) + (beforeCoordinate : before.coordinateMatches site blockId + (.instruction index) input = true) + {beforeStore afterStore : IxIR1.Store} {source values : List RVal} + {value : RVal} {frameRoots : List IxIR1.Sim.Root} + (ownership : SourceOwnershipAt checked.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.call address sourceArguments) index instruction next) + beforeStore source frameRoots) + (resolved : IxIR1.resolveAtoms source sourceArguments = .ok values) + (consumed : Lower.callRemainingCapabilities? before.sourceCapabilities input + signature sourceArguments = some remaining) + (resultOwnership : IxIR1.Sim.RootOwnership afterStore + (⟨signature.result, value⟩ :: + (rootsForCapabilities remaining.toList source ++ frameRoots))) : + SourceOwnershipAt checked.artifact.trace.positions next afterStore + (value :: source) frameRoots := by + have beforeInvariant := ownership before beforeMember (by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceBlock, + Lower.CodeTrace.targetPosition, Lower.CodeTrace.sourceInputMap] using + beforeCoordinate) + change SourceOwnershipInvariant beforeStore source input + before.sourceCapabilities frameRoots at beforeInvariant + intro after afterMember afterCoordinate + have transition := checked.callTransition functionMember signatureAt + descendant beforeMember beforeCoordinate afterMember afterCoordinate + unfold Lower.PositionTrace.callResultMatches at transition + simp only [consumed, Bool.and_eq_true, beq_iff_eq] at transition + rw [← transition.2] + exact beforeInvariant.callResultInvariant resolved consumed transition.1 + resultOwnership + +/-- Restore a recursive ordinary-call continuation from the callee's exact +terminal ownership. -/ +theorem callSelfResult {checked : Lower.Checked} + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ checked.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount index : Nat} + {sourceArguments : Array IxIR1.Atom} {instruction : Instr} + {next : Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.callSelf sourceArguments) index instruction next)) + {before : Lower.PositionTrace} {remaining : Array Lower.BindingCap} + (beforeMember : before ∈ checked.artifact.trace.positions) + (beforeCoordinate : before.coordinateMatches site blockId + (.instruction index) input = true) + {beforeStore afterStore : IxIR1.Store} {source values : List RVal} + {value : RVal} {frameRoots : List IxIR1.Sim.Root} + (ownership : SourceOwnershipAt checked.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.callSelf sourceArguments) index instruction next) + beforeStore source frameRoots) + (resolved : IxIR1.resolveAtoms source sourceArguments = .ok values) + (consumed : Lower.callRemainingCapabilities? before.sourceCapabilities input + functionTrace.generated.signature sourceArguments = some remaining) + (resultOwnership : IxIR1.Sim.RootOwnership afterStore + (⟨functionTrace.generated.signature.result, value⟩ :: + (rootsForCapabilities remaining.toList source ++ frameRoots))) : + SourceOwnershipAt checked.artifact.trace.positions next afterStore + (value :: source) frameRoots := by + have beforeInvariant := ownership before beforeMember (by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceBlock, + Lower.CodeTrace.targetPosition, Lower.CodeTrace.sourceInputMap] using + beforeCoordinate) + change SourceOwnershipInvariant beforeStore source input + before.sourceCapabilities frameRoots at beforeInvariant + intro after afterMember afterCoordinate + have transition := checked.callSelfTransition functionMember descendant + beforeMember beforeCoordinate afterMember afterCoordinate + unfold Lower.PositionTrace.callResultMatches at transition + simp only [consumed, Bool.and_eq_true, beq_iff_eq] at transition + rw [← transition.2] + exact beforeInvariant.callResultInvariant resolved consumed transition.1 + resultOwnership + +end SourceOwnershipAt + +/-- Checked allocation derives its target field-world evidence from the +producer capability position and the dynamic ownership invariant at that +recursive trace node. No allocation-shaped root list is supplied by the +caller. -/ +theorem StoreRel.fieldWorlds_of_checked_allocation_capabilities + {checked : Lower.Checked} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ checked.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount index : Nat} + {world : Ix.Compiler.Ixon.Owned} {identity : CtorId} + {sourceArguments : Array IxIR1.Atom} {instruction : Instr} + {next : Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.alloc world identity sourceArguments) index instruction next)) + {sourceStore : IxIR1.Store} {targetStore : Eval.Store} + (relation : StoreRel sourceStore targetStore) + {source : List RVal} {values : List RVal} {schema : CtorSchema} + {frameRoots : List IxIR1.Sim.Root} + (ownershipAt : SourceOwnershipAt checked.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.alloc world identity sourceArguments) index instruction next) + sourceStore source frameRoots) + (resolved : IxIR1.resolveAtoms source sourceArguments = .ok values) + (schemaAt : checked.artifact.validationContext.schemas world identity = + some schema) : + Eval.FieldWorlds targetStore schema values.toArray := by + obtain ⟨position, positionMember, positionMatch⟩ := + checked.allocationPosition functionMember descendant + have coordinate := + position.coordinateMatches_of_allocationMatch positionMatch + have ownership := ownershipAt position positionMember (by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceBlock, + Lower.CodeTrace.targetPosition, Lower.CodeTrace.sourceInputMap] using + coordinate) + change SourceOwnershipInvariant sourceStore source input + position.sourceCapabilities frameRoots at ownership + apply relation.fieldWorlds_replicate + (checked.allocationSchemaFields functionMember descendant schemaAt) + · simpa using IxIR1.resolveAtoms_length resolved + · exact ownership.resolveAtoms_hasWorld positionMatch resolved + +/-- The exact source-side condition needed to reconcile shared release: +IxIR₁ historically permits decrementing a malformed live node from zero, +whereas IxIR₂ rejects that state. No allocation-order or ownership-graph +assumption is needed by the recursive work-list correspondence. -/ +def PositiveSharedRC (store : IxIR1.Store) : Prop := + ∀ {location box}, store.get? location = some box → + box.world = .shared → 0 < box.rc + +/-- The source runtime facts threaded by the recursive structured simulation. +Allocation order supplies the strict live-RC premise required by destructive +IxIR₂ steps, bounded roots prevent stale evaluator bindings from naming +future append locations, and live PAPs retain the source evaluator's strict +under-saturation guarantee. -/ +structure SourceRuntimeInvariant (store : IxIR1.Store) + (roots : List RVal) : Prop where + order : IxIR1.Reclamation.AllocationOrderInvariant store + rootsInBounds : IxIR1.Reclamation.ValuesInBounds store roots + papsUnder : IxIR1.Reclamation.PAPsUnder store + +namespace SourceRuntimeInvariant + +/-- The empty source machine establishes the recursive runtime invariant. -/ +theorem empty : SourceRuntimeInvariant ({} : IxIR1.Store) [] := + ⟨IxIR1.Reclamation.AllocationOrderInvariant.empty, + IxIR1.Reclamation.ValuesInBounds.nil _, + IxIR1.Reclamation.PAPsUnder.empty⟩ + +/-- Allocation order is stronger than the shared-only positivity premise used +by the exact destructive-step simulation. -/ +theorem positiveSharedRC {store : IxIR1.Store} {roots : List RVal} + (invariant : SourceRuntimeInvariant store roots) : + PositiveSharedRC store := by + intro location box found _ + exact invariant.order.rc_pos found + +/-- Heap-world evidence for an owned root implies that its location, when +present, lies within the current append-only node array. -/ +private theorem hasWorld_valueInBounds {store : IxIR1.Store} + {world : Ix.Compiler.Ixon.Owned} {value : RVal} + (hasWorld : IxIR1.Sim.HasWorld store world value) : + IxIR1.Reclamation.ValueInBounds store value := by + cases value with + | loc location => + obtain ⟨box, found, _⟩ := hasWorld + exact IxIR1.Reclamation.RVal.inBounds_of_get? found + | lit literal => trivial + | erased => trivial + +/-- Canonical shared callee-entry roots provide the bounded environment half +of the runtime invariant; allocation order is supplied by the PAP +retain/release prefix. -/ +theorem sharedEntry {store : IxIR1.Store} {values : List RVal} + {frameRoots : List IxIR1.Sim.Root} + (order : IxIR1.Reclamation.AllocationOrderInvariant store) + (papsUnder : IxIR1.Reclamation.PAPsUnder store) + (ownership : IxIR1.Sim.RootOwnership store + (IxIR1.Sim.rootsFor .shared values ++ frameRoots)) : + SourceRuntimeInvariant store values.reverse := by + have bounds : IxIR1.Reclamation.ValuesInBounds store values := by + intro value member + apply hasWorld_valueInBounds + apply ownership.roots_world ⟨.shared, value⟩ + exact List.mem_append_left _ (by + simpa [IxIR1.Sim.rootsFor] using member) + exact ⟨order, bounds.reverse, papsUnder⟩ + +/-- Resolving one source atom cannot manufacture a future heap location. -/ +theorem resolveAtom {store : IxIR1.Store} {roots : List RVal} + (invariant : SourceRuntimeInvariant store roots) + {atom : IxIR1.Atom} {value : RVal} + (resolved : IxIR1.resolveAtom roots atom = .ok value) : + IxIR1.Reclamation.ValueInBounds store value := + IxIR1.Reclamation.resolveAtom_inBounds invariant.rootsInBounds resolved + +/-- A resolved source argument vector is a valid root set in the unchanged +store. -/ +theorem resolveAtoms {store : IxIR1.Store} {roots : List RVal} + (invariant : SourceRuntimeInvariant store roots) + {atoms : Array IxIR1.Atom} {values : List RVal} + (resolved : IxIR1.resolveAtoms roots atoms = .ok values) : + SourceRuntimeInvariant store values := + ⟨invariant.order, + IxIR1.Reclamation.resolveAtoms_inBounds invariant.rootsInBounds resolved, + invariant.papsUnder⟩ + +/-- Call entry reverses source arguments into the callee's de Bruijn +environment without changing their boundedness. -/ +theorem resolveAtomsReverse {store : IxIR1.Store} {roots : List RVal} + (invariant : SourceRuntimeInvariant store roots) + {atoms : Array IxIR1.Atom} {values : List RVal} + (resolved : IxIR1.resolveAtoms roots atoms = .ok values) : + SourceRuntimeInvariant store values.reverse := + ⟨invariant.order, + (IxIR1.Reclamation.resolveAtoms_inBounds + invariant.rootsInBounds resolved).reverse, + invariant.papsUnder⟩ + +/-- Constructor dispatch prepends the live node's fields, in the evaluator's +reverse field order, to the child environment. Allocation order proves every +field is already bounded. -/ +theorem constructorBranch {store : IxIR1.Store} {roots : List RVal} + (invariant : SourceRuntimeInvariant store roots) + {location : Nat} {box : IxIR1.NodeBox} {cid : CtorId} + {fields : Array RVal} + (found : store.get? location = some box) + (node : box.node = .ctorN cid fields) : + SourceRuntimeInvariant store (fields.toList.reverse ++ roots) := by + have fieldBounds : + IxIR1.Reclamation.ValuesInBounds store fields.toList := by + have children := invariant.order.childrenInBounds found + simpa [IxIR1.Sim.nodeChildren, node] using children + exact ⟨invariant.order, + fieldBounds.reverse.append invariant.rootsInBounds, + invariant.papsUnder⟩ + +/-- Peeling a Nat successor adds only a scalar predecessor to the child +environment, so the heap component of the invariant is unchanged. -/ +theorem natSuccessor {store : IxIR1.Store} {roots : List RVal} + (invariant : SourceRuntimeInvariant store roots) (predecessor : Nat) : + SourceRuntimeInvariant store (.lit (.nat predecessor) :: roots) := + ⟨invariant.order, + IxIR1.Reclamation.ValuesInBounds.cons (by trivial) + invariant.rootsInBounds, + invariant.papsUnder⟩ + +/-- A successful source code run that executes no reuse preserves allocation +order, keeps the old environment bounded, and adds the result as a bounded +root. -/ +theorem runCode {ctx : IxIR1.Ctx} {fuel : Nat} {cur : IxIR1.FnDef} + {store store' : IxIR1.Store} {env : List RVal} {code : IxIR1.Code} + {value : RVal} (invariant : SourceRuntimeInvariant store env) + (reuses : store'.reuses = store.reuses) + (run : IxIR1.runCode ctx fuel cur store env code = .ok (store', value)) : + SourceRuntimeInvariant store' (value :: env) := by + have ordered := IxIR1.Reclamation.runCode_order_of_reuses_eq + invariant.order invariant.rootsInBounds reuses run + have oldRoots := invariant.rootsInBounds.mono + (IxIR1.Reclamation.runCode_footprint run).nodes_size + have papsUnder := IxIR1.Reclamation.runCode_papsUnder_of_reuses_eq + invariant.order invariant.rootsInBounds invariant.papsUnder reuses run + exact ⟨ordered.1, + IxIR1.Reclamation.ValuesInBounds.cons ordered.2 oldRoots, + papsUnder⟩ + +/-- Operation-level form of `runCode`; this is the induction rule used at a +generated nonterminal instruction. -/ +theorem runOp {ctx : IxIR1.Ctx} {fuel : Nat} {cur : IxIR1.FnDef} + {store store' : IxIR1.Store} {env : List RVal} {op : IxIR1.Op} + {value : RVal} (invariant : SourceRuntimeInvariant store env) + (reuses : store'.reuses = store.reuses) + (run : IxIR1.runOp ctx fuel cur store env op = .ok (store', value)) : + SourceRuntimeInvariant store' (value :: env) := by + have ordered := IxIR1.Reclamation.runOp_order_of_reuses_eq + invariant.order invariant.rootsInBounds reuses run + have oldRoots := invariant.rootsInBounds.mono + (IxIR1.Reclamation.runOp_footprint run).nodes_size + have papsUnder := IxIR1.Reclamation.runOp_papsUnder_of_reuses_eq + invariant.order invariant.rootsInBounds invariant.papsUnder reuses run + exact ⟨ordered.1, + IxIR1.Reclamation.ValuesInBounds.cons ordered.2 oldRoots, + papsUnder⟩ + +/-- A successful declared invocation preserves the invariant on its argument +roots and adds the returned value. -/ +theorem invoke {ctx : IxIR1.Ctx} {fuel : Nat} {address : Ixon.Address} + {args : List RVal} {store store' : IxIR1.Store} {value : RVal} + (invariant : SourceRuntimeInvariant store args) + (reuses : store'.reuses = store.reuses) + (run : IxIR1.invoke ctx fuel address args store = .ok (store', value)) : + SourceRuntimeInvariant store' (value :: args) := by + have ordered := IxIR1.Reclamation.invoke_order_of_reuses_eq + invariant.order invariant.rootsInBounds reuses run + have oldRoots := invariant.rootsInBounds.mono + (IxIR1.Reclamation.invoke_footprint run).nodes_size + have papsUnder := IxIR1.Reclamation.invoke_papsUnder_of_reuses_eq + invariant.order invariant.rootsInBounds invariant.papsUnder reuses run + exact ⟨ordered.1, + IxIR1.Reclamation.ValuesInBounds.cons ordered.2 oldRoots, + papsUnder⟩ + +/-- A successful higher-order application preserves the function/argument +root set and adds its result. -/ +theorem applyGo {ctx : IxIR1.Ctx} {fuel : Nat} + {store store' : IxIR1.Store} {function : RVal} {args : List RVal} + {value : RVal} + (invariant : SourceRuntimeInvariant store (function :: args)) + (reuses : store'.reuses = store.reuses) + (run : IxIR1.applyGo ctx fuel store function args = .ok (store', value)) : + SourceRuntimeInvariant store' (value :: function :: args) := by + have ordered := IxIR1.Reclamation.applyGo_order_of_reuses_eq + invariant.order (invariant.rootsInBounds _ (by simp)) + (fun argument member => invariant.rootsInBounds argument (by simp [member])) + reuses run + have oldRoots := invariant.rootsInBounds.mono + (IxIR1.Reclamation.applyGo_footprint run).nodes_size + have papsUnder := IxIR1.Reclamation.applyGo_papsUnder_of_reuses_eq + invariant.order (invariant.rootsInBounds _ (by simp)) + (fun argument member => invariant.rootsInBounds argument (by + simp [member])) invariant.papsUnder reuses run + exact ⟨ordered.1, + IxIR1.Reclamation.ValuesInBounds.cons ordered.2 oldRoots, + papsUnder⟩ + +/-- Reuse-free syntax discharges the counter premise of `runCode`. -/ +theorem runCodeNoReuse {ctx : IxIR1.Ctx} {fuel : Nat} {cur : IxIR1.FnDef} + {store store' : IxIR1.Store} {env : List RVal} {code : IxIR1.Code} + {value : RVal} (invariant : SourceRuntimeInvariant store env) + (hctx : IxIR1.NoReuse.CtxNoReuse ctx) + (hcur : IxIR1.NoReuse.CodeNoReuse cur.body) + (hcode : IxIR1.NoReuse.CodeNoReuse code) + (run : IxIR1.runCode ctx fuel cur store env code = .ok (store', value)) : + SourceRuntimeInvariant store' (value :: env) := + invariant.runCode + (IxIR1.NoReuse.runCode_reuses_eq hctx hcur hcode run) run + +/-- Reuse-free syntax discharges the counter premise of `runOp`. -/ +theorem runOpNoReuse {ctx : IxIR1.Ctx} {fuel : Nat} {cur : IxIR1.FnDef} + {store store' : IxIR1.Store} {env : List RVal} {op : IxIR1.Op} + {value : RVal} (invariant : SourceRuntimeInvariant store env) + (hctx : IxIR1.NoReuse.CtxNoReuse ctx) + (hcur : IxIR1.NoReuse.CodeNoReuse cur.body) + (hop : IxIR1.NoReuse.OpNoReuse op) + (run : IxIR1.runOp ctx fuel cur store env op = .ok (store', value)) : + SourceRuntimeInvariant store' (value :: env) := + invariant.runOp + (IxIR1.NoReuse.runOp_reuses_eq hctx hcur hop run) run + +/-- Context no-reuse discharges the counter premise of declared invocation. -/ +theorem invokeNoReuse {ctx : IxIR1.Ctx} {fuel : Nat} + {address : Ixon.Address} {args : List RVal} + {store store' : IxIR1.Store} {value : RVal} + (invariant : SourceRuntimeInvariant store args) + (hctx : IxIR1.NoReuse.CtxNoReuse ctx) + (run : IxIR1.invoke ctx fuel address args store = .ok (store', value)) : + SourceRuntimeInvariant store' (value :: args) := + invariant.invoke (IxIR1.NoReuse.invoke_reuses_eq hctx run) run + +/-- Context no-reuse discharges the counter premise of higher-order +application. -/ +theorem applyGoNoReuse {ctx : IxIR1.Ctx} {fuel : Nat} + {store store' : IxIR1.Store} {function : RVal} {args : List RVal} + {value : RVal} + (invariant : SourceRuntimeInvariant store (function :: args)) + (hctx : IxIR1.NoReuse.CtxNoReuse ctx) + (run : IxIR1.applyGo ctx fuel store function args = .ok (store', value)) : + SourceRuntimeInvariant store' (value :: function :: args) := + invariant.applyGo (IxIR1.NoReuse.applyGo_reuses_eq hctx run) run + +end SourceRuntimeInvariant + +private theorem sourceNodesGet_of_get {store : IxIR1.Store} + {location : Nat} {box : IxIR1.NodeBox} + (found : store.get? location = some box) : + store.nodes[location]? = some (some box) := by + rw [IxIR1.Store.get?, Option.bind_eq_some_iff] at found + obtain ⟨slot, slotAt, equal⟩ := found + change slot = some box at equal + subst slot + exact slotAt + +private theorem sourceGet_setBox_same {store : IxIR1.Store} + {location : Nat} {old new : IxIR1.NodeBox} + (found : store.get? location = some old) : + (store.setBox location new).get? location = some new := by + have nodesAt := sourceNodesGet_of_get found + obtain ⟨inBounds, _⟩ := Array.getElem?_eq_some_iff.mp nodesAt + simp [IxIR1.Store.setBox, IxIR1.Store.get?, + Array.set!_eq_setIfInBounds, inBounds] + +private theorem sourceGet_of_setBox_other {store : IxIR1.Store} + {location other : Nat} {old new box : IxIR1.NodeBox} + (different : location ≠ other) + (live : store.get? location = some old) + (found : (store.setBox location new).get? other = some box) : + store.get? other = some box := by + have nodesAt := sourceNodesGet_of_get live + obtain ⟨inBounds, _⟩ := Array.getElem?_eq_some_iff.mp nodesAt + simpa [IxIR1.Store.setBox, IxIR1.Store.get?, + Array.set!_eq_setIfInBounds, Array.getElem?_setIfInBounds, + inBounds, different] using found + +private theorem sourceGet_kill_same {store : IxIR1.Store} + {location : Nat} {box : IxIR1.NodeBox} + (found : store.get? location = some box) : + (store.kill location).get? location = none := by + have nodesAt := sourceNodesGet_of_get found + obtain ⟨inBounds, _⟩ := Array.getElem?_eq_some_iff.mp nodesAt + simp [IxIR1.Store.kill, IxIR1.Store.get?, + Array.set!_eq_setIfInBounds, inBounds] + +private theorem sourceGet_of_kill_other {store : IxIR1.Store} + {location other : Nat} {old box : IxIR1.NodeBox} + (different : location ≠ other) + (live : store.get? location = some old) + (found : (store.kill location).get? other = some box) : + store.get? other = some box := by + have nodesAt := sourceNodesGet_of_get live + obtain ⟨inBounds, _⟩ := Array.getElem?_eq_some_iff.mp nodesAt + simpa [IxIR1.Store.kill, IxIR1.Store.get?, + Array.set!_eq_setIfInBounds, Array.getElem?_setIfInBounds, + inBounds, different] using found + +theorem PositiveSharedRC.rcTick {store : IxIR1.Store} + (positive : PositiveSharedRC store) : PositiveSharedRC store.rcTick := by + intro location box found shared + exact positive (by + simpa [IxIR1.Store.rcTick, IxIR1.Store.get?] using found) shared + +theorem PositiveSharedRC.setRc {store : IxIR1.Store} {location : Nat} + {box : IxIR1.NodeBox} {newRC : Nat} + (positive : PositiveSharedRC store) + (found : store.get? location = some box) (newPositive : 0 < newRC) : + PositiveSharedRC (store.setBox location { box with rc := newRC }) := by + intro other otherBox otherFound otherShared + by_cases equal : location = other + · subst other + have updated := sourceGet_setBox_same + (new := { box with rc := newRC }) found + have boxEqual : otherBox = { box with rc := newRC } := + Option.some.inj (otherFound.symm.trans updated) + subst otherBox + exact newPositive + · exact positive + (sourceGet_of_setBox_other equal found otherFound) otherShared + +theorem PositiveSharedRC.kill {store : IxIR1.Store} {location : Nat} + {box : IxIR1.NodeBox} (positive : PositiveSharedRC store) + (found : store.get? location = some box) : + PositiveSharedRC (store.kill location) := by + intro other otherBox otherFound otherShared + by_cases equal : location = other + · subst other + rw [sourceGet_kill_same found] at otherFound + contradiction + · exact positive (sourceGet_of_kill_other equal found otherFound) + otherShared + +/-- A proof-side source-slot map. `none` marks a source binding whose ownership +has already been consumed. The target register remains physically present +inside its current SSA block, but no later source operand may resolve through +that slot. -/ +abbrev EnvMap := Array (Option Atom) + +/-- Translate one live source atom through an explicit source-slot-to-target- +atom map. The executable compiler certificate and runtime simulation share +this single definition; dead entries deliberately fail translation. -/ +abbrev translateAtom (mapping : EnvMap) : IxIR1.Atom → Option Atom := + Lower.InputMap.translateAtom mapping + +/-- Every live source environment slot resolves through its generated target +atom to the same runtime value. Dead ownership slots are deliberately absent +from this semantic premise. -/ +def EnvRel (source : List RVal) (target : Array RVal) + (mapping : EnvMap) : Prop := + ∀ (index : Nat) (value : RVal) (atom : Atom), + source[index]? = some value → + mapping[index]? = some (some atom) → + Eval.resolveAtom target atom = .ok value + +/-- The empty source environment is related to the empty proof map. -/ +theorem EnvRel.empty (target : Array RVal := #[]) : + EnvRel [] target #[] := by + intro index value atom sourceGet + simp at sourceGet + +/-- Two live source slots mapped to the same target register contain the same +runtime value. -/ +private theorem EnvRel.source_eq_of_same_reg + {source : List RVal} {target : Array RVal} {input : EnvMap} + (relation : EnvRel source target input) + {leftIndex rightIndex register : Nat} {leftValue rightValue : RVal} + (leftSource : source[leftIndex]? = some leftValue) + (rightSource : source[rightIndex]? = some rightValue) + (leftInput : input[leftIndex]? = some (some (.reg register))) + (rightInput : input[rightIndex]? = some (some (.reg register))) : + leftValue = rightValue := by + have leftResolved := relation leftIndex leftValue (.reg register) + leftSource leftInput + have rightResolved := relation rightIndex rightValue (.reg register) + rightSource rightInput + exact Except.ok.inj (leftResolved.symm.trans rightResolved) + +/-- A successful static edge-owner search identifies a live owned source slot +whose predecessor atom is exactly the requested lender register. -/ +private theorem edgeOwnerIndex?_facts + {capabilities : Array Lower.BindingCap} {input : EnvMap} + {lender ownerIndex : Nat} + (found : Lower.edgeOwnerIndex? capabilities input lender = + some ownerIndex) : + ∃ world, + capabilities[ownerIndex]? = some (.owned world) ∧ + input[ownerIndex]? = some (some (.reg lender)) := by + unfold Lower.edgeOwnerIndex? at found + have member := List.mem_of_find?_eq_some found + have matched := List.find?_some found + have bound : ownerIndex < capabilities.size := by + simpa using (List.mem_range.mp member) + cases capabilityAt : capabilities[ownerIndex]? with + | none => simp [capabilityAt] at matched + | some capability => + cases capability with + | scalar | borrowed | dead => simp [capabilityAt] at matched + | owned world => + cases inputAt : input[ownerIndex]? with + | none => simp [capabilityAt, inputAt] at matched + | some slot => + cases slot with + | none => simp [capabilityAt, inputAt] at matched + | some atom => + cases atom with + | lit literal => simp [capabilityAt, inputAt] at matched + | erased => simp [capabilityAt, inputAt] at matched + | reg actual => + have actualEq : actual = lender := + beq_iff_eq.mp (by + simpa [capabilityAt, inputAt] using matched) + subst actual + exact ⟨world, rfl, rfl⟩ + +/-- Edge rebasing changes only borrow-lender names (or maps an invalid lender +to `dead`); it preserves every dynamic pointwise capability fact. -/ +private theorem CapabilityHolds.rebaseEdge + {store : IxIR1.Store} {value : RVal} + {allCapabilities : Array Lower.BindingCap} {input : EnvMap} + {capability : Lower.BindingCap} + (holds : CapabilityHolds store capability value) : + CapabilityHolds store + ((capability.rebaseEdge? allCapabilities input).getD .dead) value := by + cases capability with + | scalar => simpa [Lower.BindingCap.rebaseEdge?, CapabilityHolds] using holds + | owned world => + simpa [Lower.BindingCap.rebaseEdge?, CapabilityHolds] using holds + | dead => simp [Lower.BindingCap.rebaseEdge?, CapabilityHolds] + | borrowed world lender => + cases lender with + | caller => + simpa [Lower.BindingCap.rebaseEdge?, CapabilityHolds] using holds + | value lender => + cases owner : Lower.edgeOwnerIndex? allCapabilities input lender with + | none => + simp [Lower.BindingCap.rebaseEdge?, owner, + CapabilityHolds] + | some ownerIndex => + simp only [Lower.BindingCap.rebaseEdge?, owner] + generalize lookupEq : allCapabilities[ownerIndex]? = lookup + cases lookup with + | none => simp [CapabilityHolds] + | some ownerCapability => + cases ownerCapability with + | scalar => simp [CapabilityHolds] + | borrowed ownerWorld ownerLender => + simp [CapabilityHolds] + | dead => simp [CapabilityHolds] + | owned ownerWorld => + by_cases same : ownerWorld = world + · simpa [same, CapabilityHolds] using holds + · simp [same, CapabilityHolds] + +/-- Edge rebasing does not change which source slots contribute ownership +roots. -/ +private theorem rootsForCapabilities_rebaseEdge + (allCapabilities : Array Lower.BindingCap) (input : EnvMap) : + ∀ (capabilities : List Lower.BindingCap) (source : List RVal), + rootsForCapabilities + (capabilities.map fun capability => + (capability.rebaseEdge? allCapabilities input).getD .dead) + source = + rootsForCapabilities capabilities source := by + intro capabilities + induction capabilities with + | nil => intro source; simp [rootsForCapabilities] + | cons capability capabilities ih => + intro source + cases source with + | nil => simp [rootsForCapabilities] + | cons value values => + cases capability with + | scalar => + change rootsForCapabilities + (capabilities.map fun capability => + (capability.rebaseEdge? allCapabilities input).getD .dead) + values = rootsForCapabilities capabilities values + exact ih values + | owned world => + change (⟨world, value⟩ : IxIR1.Sim.Root) :: + rootsForCapabilities + (capabilities.map fun capability => + (capability.rebaseEdge? allCapabilities input).getD + .dead) + values = + ⟨world, value⟩ :: rootsForCapabilities capabilities values + exact congrArg (List.cons ⟨world, value⟩) (ih values) + | dead => + change rootsForCapabilities + (capabilities.map fun capability => + (capability.rebaseEdge? allCapabilities input).getD .dead) + values = rootsForCapabilities capabilities values + exact ih values + | borrowed world lender => + cases lender with + | caller => + change rootsForCapabilities + (capabilities.map fun capability => + (capability.rebaseEdge? allCapabilities input).getD + .dead) + values = rootsForCapabilities capabilities values + exact ih values + | value lender => + cases owner : Lower.edgeOwnerIndex? allCapabilities input + lender with + | none => + simpa only [List.map_cons, + Lower.BindingCap.rebaseEdge?, owner, + Option.getD_none, + rootsForCapabilities] using ih values + | some ownerIndex => + simp only [List.map_cons, + Lower.BindingCap.rebaseEdge?, owner] + generalize lookupEq : + allCapabilities[ownerIndex]? = lookup + cases lookup with + | none => + change rootsForCapabilities + (capabilities.map fun capability => + (capability.rebaseEdge? allCapabilities + input).getD .dead) + values = rootsForCapabilities capabilities values + exact ih values + | some ownerCapability => + cases ownerCapability with + | scalar | borrowed | dead => + change rootsForCapabilities + (capabilities.map fun capability => + (capability.rebaseEdge? allCapabilities + input).getD .dead) + values = rootsForCapabilities capabilities values + exact ih values + | owned ownerWorld => + by_cases same : ownerWorld = world + · have sameBool : + (ownerWorld == world) = true := by + simpa using same + simpa [Lower.BindingCap.rebaseEdge?, sameBool, + rootsForCapabilities] using ih values + · have different : + ¬ ((ownerWorld == world) = true) := by + simpa using same + simpa [Lower.BindingCap.rebaseEdge?, different, + rootsForCapabilities] using ih values + +namespace SourceOwnershipInvariant + +/-- Crossing a canonical generated CFG edge preserves exact dynamic source +ownership. Local borrow lenders are renamed from predecessor SSA registers to +the same-index successor parameters selected by the checked edge audit. -/ +theorem edge + {store : IxIR1.Store} {source : List RVal} {target : Array RVal} + {input : EnvMap} {capabilities afterCapabilities : + Array Lower.BindingCap} {frameRoots : List IxIR1.Sim.Root} + (invariant : SourceOwnershipInvariant store source input capabilities + frameRoots) + (environments : EnvRel source target input) + (transition : Lower.edgeCapabilities? capabilities input = + some afterCapabilities) : + SourceOwnershipInvariant store source + (Lower.EdgeTrace.explicitMapOf input) afterCapabilities frameRoots := by + unfold Lower.edgeCapabilities? at transition + split at transition <;> try contradiction + injection transition with afterEq + subst afterCapabilities + refine ⟨?_, ?_, ?_, ?_⟩ + · simpa using invariant.length + · intro index capability value capabilityAt valueAt + rw [Array.getElem?_map] at capabilityAt + cases oldAt : capabilities[index]? with + | none => simp [oldAt] at capabilityAt + | some oldCapability => + simp only [oldAt, Option.map_some, Option.some.injEq] at capabilityAt + subst capability + exact CapabilityHolds.rebaseEdge + (invariant.holds oldAt valueAt) + · simpa [Array.toList_map, + rootsForCapabilities_rebaseEdge] using invariant.ownership + · intro index world lender value capabilityAt valueAt + rw [Array.getElem?_map] at capabilityAt + cases oldAt : capabilities[index]? with + | none => simp [oldAt] at capabilityAt + | some oldCapability => + simp only [oldAt, Option.map_some, Option.some.injEq] at capabilityAt + cases oldCapability with + | scalar => + simp [Lower.BindingCap.rebaseEdge?] at capabilityAt + | owned oldWorld => + simp [Lower.BindingCap.rebaseEdge?] at capabilityAt + | dead => + simp [Lower.BindingCap.rebaseEdge?] at capabilityAt + | borrowed oldWorld oldLender => + cases oldLender with + | caller => + have outputEq : + Lower.BindingCap.borrowed oldWorld .caller = + .borrowed world lender := by + simpa [Lower.BindingCap.rebaseEdge?] using capabilityAt + injection outputEq with worldEq lenderEq + subst world + subst lender + exact invariant.borrows oldAt valueAt + | value oldLender => + cases owner : Lower.edgeOwnerIndex? capabilities input + oldLender with + | none => + simp [Lower.BindingCap.rebaseEdge?, owner] at capabilityAt + | some ownerIndex => + obtain ⟨ownerWorld, ownerCapability, ownerInput⟩ := + edgeOwnerIndex?_facts owner + by_cases sameWorld : ownerWorld = oldWorld + · subst ownerWorld + have outputEq : + Lower.BindingCap.borrowed oldWorld + (.value ownerIndex) = + .borrowed world lender := by + simpa [Lower.BindingCap.rebaseEdge?, owner, + ownerCapability] using capabilityAt + injection outputEq with worldEq lenderEq + subst world + subst lender + obtain ⟨oldOwnerIndex, oldOwnerValue, oldOwnerInput, + oldOwnerCapability, oldOwnerSource, support⟩ := + invariant.borrows oldAt valueAt + have ownerBound : ownerIndex < capabilities.size := + (Array.getElem?_eq_some_iff.mp ownerCapability).1 + have sourceBound : ownerIndex < source.length := by + rw [invariant.length] + exact ownerBound + let ownerValue := source[ownerIndex] + have ownerSource : + source[ownerIndex]? = some ownerValue := + List.getElem?_eq_some_iff.mpr ⟨sourceBound, rfl⟩ + have ownerValueEq : ownerValue = oldOwnerValue := + environments.source_eq_of_same_reg ownerSource + oldOwnerSource ownerInput oldOwnerInput + have successorInput : + (Lower.EdgeTrace.explicitMapOf input)[ownerIndex]? = + some (some (.reg ownerIndex)) := by + unfold Lower.EdgeTrace.explicitMapOf + rw [Array.getElem?_mapIdx] + simp [ownerInput] + have successorCapability : + (capabilities.map fun capability => + (capability.rebaseEdge? capabilities input).getD + .dead)[ownerIndex]? = + some (.owned oldWorld) := by + rw [Array.getElem?_map, ownerCapability] + rfl + refine ⟨ownerIndex, ownerValue, successorInput, + successorCapability, ownerSource, ?_⟩ + simpa [ownerValueEq] using support + · simp [Lower.BindingCap.rebaseEdge?, owner, + ownerCapability, sameWorld] at capabilityAt + +/-- Shifting a local lender register does not change the pointwise meaning of +its capability. -/ +private theorem CapabilityHolds.shiftLender + {store : IxIR1.Store} {value : RVal} {amount : Nat} + {capability : Lower.BindingCap} + (holds : CapabilityHolds store capability value) : + CapabilityHolds store (capability.shiftLender amount) value := by + cases capability with + | scalar | owned | dead => exact holds + | borrowed world lender => + cases lender <;> exact holds + +/-- Lender-register shifts are ownership-inert. -/ +private theorem rootsForCapabilities_shiftLender (amount : Nat) : + ∀ (capabilities : List Lower.BindingCap) (source : List RVal), + rootsForCapabilities + (capabilities.map (Lower.BindingCap.shiftLender amount)) source = + rootsForCapabilities capabilities source := by + intro capabilities + induction capabilities with + | nil => intro source; simp [rootsForCapabilities] + | cons capability capabilities ih => + intro source + cases source with + | nil => simp [rootsForCapabilities] + | cons value values => + cases capability with + | scalar | owned | dead => + simp [Lower.BindingCap.shiftLender, rootsForCapabilities, ih] + | borrowed world lender => + cases lender <;> + simp [Lower.BindingCap.shiftLender, rootsForCapabilities, ih] + +/-- Prefixing one scalar successor parameter and shifting every local lender +by one preserves exact dynamic source ownership. -/ +theorem prependScalarShift + {store : IxIR1.Store} {source : List RVal} {input : EnvMap} + {capabilities : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} {scalarValue : RVal} + (invariant : SourceOwnershipInvariant store source input capabilities + frameRoots) + (scalar : IxIR1.Sim.rvalLocation? scalarValue = none) : + SourceOwnershipInvariant store (scalarValue :: source) + (Lower.EdgeTrace.sourceMapOf 1 input) + (#[.scalar] ++ capabilities.map (Lower.BindingCap.shiftLender 1)) + frameRoots := by + refine ⟨?_, ?_, ?_, ?_⟩ + · simp [invariant.length, Array.size_append, Nat.add_comm] + · intro index capability value capabilityAt valueAt + cases index with + | zero => + simp [Array.getElem?_append] at capabilityAt valueAt + subst capability + subst value + exact scalar + | succ index => + simp [Array.getElem?_append] at capabilityAt valueAt + cases oldAt : capabilities[index]? with + | none => simp [oldAt] at capabilityAt + | some oldCapability => + simp only [oldAt, Option.some.injEq] at capabilityAt + obtain ⟨candidate, rfl, shifted⟩ := capabilityAt + subst capability + exact CapabilityHolds.shiftLender + (invariant.holds oldAt valueAt) + · simpa [Array.toList_append, Array.toList_map, rootsForCapabilities, + rootsForCapabilities_shiftLender] using invariant.ownership + · intro index world lender value capabilityAt valueAt + cases index with + | zero => simp [Array.getElem?_append] at capabilityAt + | succ index => + simp [Array.getElem?_append] at capabilityAt valueAt + cases oldAt : capabilities[index]? with + | none => simp [oldAt] at capabilityAt + | some oldCapability => + simp only [oldAt, Option.some.injEq] at capabilityAt + cases oldCapability with + | scalar => simp [Lower.BindingCap.shiftLender] at capabilityAt + | owned oldWorld => + simp [Lower.BindingCap.shiftLender] at capabilityAt + | dead => simp [Lower.BindingCap.shiftLender] at capabilityAt + | borrowed oldWorld oldLender => + cases oldLender with + | caller => + have outputEq : + Lower.BindingCap.borrowed oldWorld .caller = + .borrowed world lender := by + simpa [Lower.BindingCap.shiftLender] using capabilityAt + injection outputEq with worldEq lenderEq + subst world + subst lender + exact invariant.borrows oldAt valueAt + | value oldLender => + have outputEq : + Lower.BindingCap.borrowed oldWorld + (.value (oldLender + 1)) = + .borrowed world lender := by + simpa [Lower.BindingCap.shiftLender] using capabilityAt + injection outputEq with worldEq lenderEq + subst world + subst lender + obtain ⟨ownerIndex, ownerValue, ownerInput, + ownerCapability, ownerSource, support⟩ := + invariant.borrows oldAt valueAt + have successorInput : + (Lower.EdgeTrace.sourceMapOf 1 input + )[ownerIndex + 1]? = + some (some (.reg (oldLender + 1))) := by + unfold Lower.EdgeTrace.sourceMapOf + simp [Array.getElem?_append, ownerInput, + Lower.shiftAtom] + have successorCapability : + (#[.scalar] ++ capabilities.map + (Lower.BindingCap.shiftLender 1))[ownerIndex + 1]? = + some (.owned oldWorld) := by + simp [Array.getElem?_append, ownerCapability, + Lower.BindingCap.shiftLender] + have successorSource : + (scalarValue :: source)[ownerIndex + 1]? = + some ownerValue := by + simpa [Nat.add_comm] using ownerSource + exact ⟨ownerIndex + 1, ownerValue, successorInput, + successorCapability, successorSource, support⟩ + +/-- A checked Nat-zero edge is exactly the canonical edge transform. -/ +theorem natZero + {store : IxIR1.Store} {source : List RVal} {target : Array RVal} + {input : EnvMap} {capabilities afterCapabilities : + Array Lower.BindingCap} {frameRoots : List IxIR1.Sim.Root} + (invariant : SourceOwnershipInvariant store source input capabilities + frameRoots) + (environments : EnvRel source target input) + (transition : Lower.natZeroChildCapabilities? input capabilities = + some afterCapabilities) : + SourceOwnershipInvariant store source + (Lower.EdgeTrace.explicitMapOf input) afterCapabilities frameRoots := by + exact invariant.edge environments transition + +/-- A checked Nat-successor edge rebases predecessor lenders, prefixes the +peeled scalar, and shifts local successor-register lenders exactly once. -/ +theorem natSucc + {store : IxIR1.Store} {source : List RVal} {target : Array RVal} + {input : EnvMap} {capabilities afterCapabilities : + Array Lower.BindingCap} {frameRoots : List IxIR1.Sim.Root} + {predecessor : Nat} + (invariant : SourceOwnershipInvariant store source input capabilities + frameRoots) + (environments : EnvRel source target input) + (transition : Lower.natSuccChildCapabilities? input capabilities = + some afterCapabilities) : + SourceOwnershipInvariant store (.lit (.nat predecessor) :: source) + (Lower.EdgeTrace.sourceMapOf 1 + (Lower.EdgeTrace.explicitMapOf input)) + afterCapabilities frameRoots := by + unfold Lower.natSuccChildCapabilities? at transition + cases rebasedEq : Lower.edgeCapabilities? capabilities input with + | none => simp [rebasedEq] at transition + | some rebased => + simp [rebasedEq] at transition + subst afterCapabilities + apply prependScalarShift (invariant.edge environments rebasedEq) + rfl + +/-- Prefixing equally-sized source, input, and capability vectors preserves +the provenance of every borrow in the old suffix. -/ +private theorem prependBorrowProvenancePrefix + {store : IxIR1.Store} {source prefixValues : List RVal} + {input prefixInput : EnvMap} + {capabilities prefixCapabilities : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + (inputSize : prefixInput.size = prefixValues.length) + (capabilitySize : prefixCapabilities.size = prefixValues.length) + {world : Ix.Compiler.Ixon.Owned} {lender : BorrowLender} {value : RVal} + (provenance : BorrowProvenance store source input capabilities frameRoots + world lender value) : + BorrowProvenance store (prefixValues ++ source) (prefixInput ++ input) + (prefixCapabilities ++ capabilities) frameRoots world lender value := by + cases lender with + | caller => exact provenance + | value lenderId => + obtain ⟨ownerIndex, ownerValue, ownerInput, ownerCapability, + ownerSource, support⟩ := provenance + refine ⟨prefixValues.length + ownerIndex, ownerValue, ?_, ?_, ?_, + support⟩ + · simpa [Array.getElem?_append, inputSize] using ownerInput + · simpa [Array.getElem?_append, capabilitySize] using ownerCapability + · rw [List.getElem?_append_right (by omega)] + simpa using ownerSource + +/-- A uniform borrowed capability prefix contributes no ownership roots. -/ +private theorem rootsForCapabilities_borrowedPrefix + (world : Ix.Compiler.Ixon.Owned) (lender : BorrowLender) : + ∀ (prefixValues : List RVal) (capabilities : List Lower.BindingCap) + (source : List RVal), + rootsForCapabilities + (List.replicate prefixValues.length (.borrowed world lender) ++ + capabilities) + (prefixValues ++ source) = + rootsForCapabilities capabilities source := by + intro prefixValues + induction prefixValues with + | nil => intro capabilities source; simp + | cons value values ih => + intro capabilities source + rw [show (value :: values).length = Nat.succ values.length by rfl, + List.replicate_succ] + exact ih capabilities source + +/-- Prepending constructor fields as uniform borrows extends one retained +scrutinee-lender path to every fetched field while leaving the exact root +multiset unchanged. -/ +theorem constructorFields + {store : IxIR1.Store} {source : List RVal} {input : EnvMap} + {capabilities : Array Lower.BindingCap} + {frameRoots : List IxIR1.Sim.Root} + {fields : Array RVal} {location : Nat} {box : IxIR1.NodeBox} + {cid : CtorId} {world : Ix.Compiler.Ixon.Owned} + {lender : BorrowLender} {parameterCount : Nat} + (invariant : SourceOwnershipInvariant store source input capabilities + frameRoots) + (provenance : BorrowProvenance store source input capabilities frameRoots + world lender (.loc location)) + (found : store.get? location = some box) + (node : box.node = .ctorN cid fields) : + SourceOwnershipInvariant store (fields.toList.reverse ++ source) + (Lower.constructorChildInputMap parameterCount fields.size ++ input) + (Array.replicate fields.size (.borrowed world lender) ++ capabilities) + frameRoots := by + let prefixValues := fields.toList.reverse + let prefixInput := Lower.constructorChildInputMap parameterCount fields.size + let prefixCapabilities := + Array.replicate fields.size (Lower.BindingCap.borrowed world lender) + have prefixLength : prefixValues.length = fields.size := by + simp [prefixValues] + have inputSize : prefixInput.size = prefixValues.length := by + simp [prefixInput, Lower.constructorChildInputMap, prefixLength] + have capabilitySize : prefixCapabilities.size = prefixValues.length := by + simp [prefixCapabilities, prefixLength] + have extendField : ∀ {value : RVal}, value ∈ fields.toList → + BorrowProvenance store (prefixValues ++ source) + (prefixInput ++ input) (prefixCapabilities ++ capabilities) + frameRoots world lender value := by + intro value member + apply prependBorrowProvenancePrefix inputSize capabilitySize + apply BorrowProvenance.child provenance found + simpa [IxIR1.Sim.nodeChildren, node] using member + refine ⟨?_, ?_, ?_, ?_⟩ + · simp [invariant.length] + · intro index capability value capabilityAt valueAt + by_cases prefixIndex : index < fields.size + · have prefixValueAt : prefixValues[index]? = some value := by + have bound : index < prefixValues.length := by + simpa [prefixLength] using prefixIndex + rw [List.getElem?_append_left bound] at valueAt + exact valueAt + have fieldMember : value ∈ fields.toList := by + have reverseMember : value ∈ prefixValues := + List.mem_of_getElem? prefixValueAt + simpa [prefixValues] using reverseMember + have capabilityEq : capability = .borrowed world lender := by + have prefixBound : index < prefixCapabilities.size := by + simpa [prefixCapabilities] using prefixIndex + rw [Array.getElem?_append, if_pos prefixBound] at capabilityAt + simpa [prefixCapabilities, prefixIndex] using capabilityAt.symm + subst capability + exact BorrowProvenance.hasWorld invariant.ownership + (BorrowProvenance.child provenance found + (by simpa [IxIR1.Sim.nodeChildren, node] using fieldMember)) + · let sourceIndex := index - fields.size + have afterPrefix : fields.size ≤ index := Nat.le_of_not_gt prefixIndex + have oldValueAt : source[sourceIndex]? = some value := by + rw [List.getElem?_append_right (by + simpa [prefixValues, prefixLength] using afterPrefix)] at valueAt + simpa [sourceIndex, prefixValues, prefixLength] using valueAt + have oldCapabilityAt : capabilities[sourceIndex]? = + some capability := by + rw [Array.getElem?_append] at capabilityAt + have notPrefix : ¬ index < prefixCapabilities.size := by + simpa [prefixCapabilities] using prefixIndex + rw [if_neg notPrefix] at capabilityAt + simpa [sourceIndex, prefixCapabilities] using capabilityAt + exact invariant.holds oldCapabilityAt oldValueAt + · rw [Array.toList_append] + have roots := rootsForCapabilities_borrowedPrefix world lender + prefixValues capabilities.toList source + rw [prefixLength] at roots + have rootsEq : + rootsForCapabilities + (prefixCapabilities.toList ++ capabilities.toList) + (prefixValues ++ source) = + rootsForCapabilities capabilities.toList source := by + simpa [prefixCapabilities] using roots + rw [rootsEq] + exact invariant.ownership + · intro index actualWorld actualLender value capabilityAt valueAt + by_cases prefixIndex : index < fields.size + · have prefixValueAt : prefixValues[index]? = some value := by + have bound : index < prefixValues.length := by + simpa [prefixLength] using prefixIndex + rw [List.getElem?_append_left bound] at valueAt + exact valueAt + have fieldMember : value ∈ fields.toList := by + have reverseMember : value ∈ prefixValues := + List.mem_of_getElem? prefixValueAt + simpa [prefixValues] using reverseMember + have equalities : world = actualWorld ∧ lender = actualLender := by + have prefixBound : index < prefixCapabilities.size := by + simpa [prefixCapabilities] using prefixIndex + rw [Array.getElem?_append, if_pos prefixBound] at capabilityAt + simpa [prefixCapabilities, prefixIndex] using capabilityAt + rcases equalities with ⟨rfl, rfl⟩ + exact extendField fieldMember + · let sourceIndex := index - fields.size + have afterPrefix : fields.size ≤ index := Nat.le_of_not_gt prefixIndex + have oldValueAt : source[sourceIndex]? = some value := by + rw [List.getElem?_append_right (by + simpa [prefixValues, prefixLength] using afterPrefix)] at valueAt + simpa [sourceIndex, prefixValues, prefixLength] using valueAt + have oldCapabilityAt : capabilities[sourceIndex]? = + some (.borrowed actualWorld actualLender) := by + rw [Array.getElem?_append] at capabilityAt + have notPrefix : ¬ index < prefixCapabilities.size := by + simpa [prefixCapabilities] using prefixIndex + rw [if_neg notPrefix] at capabilityAt + simpa [sourceIndex, prefixCapabilities] using capabilityAt + exact prependBorrowProvenancePrefix inputSize capabilitySize + (invariant.borrows oldCapabilityAt oldValueAt) + +/-- Successful translation of a source variable through the canonical edge +map exposes its exact same-index successor register. -/ +private theorem explicitMapOf_at_of_translate_var + {input : EnvMap} {sourceIndex : Nat} {targetAtom : Atom} + (translated : Lower.InputMap.translateAtom + (Lower.EdgeTrace.explicitMapOf input) (.var sourceIndex) = + some targetAtom) : + (Lower.EdgeTrace.explicitMapOf input)[sourceIndex]? = + some (some (.reg sourceIndex)) := by + unfold Lower.InputMap.translateAtom at translated + cases mapped : (Lower.EdgeTrace.explicitMapOf input)[sourceIndex]? with + | none => simp [mapped] at translated + | some slot => + cases slot with + | none => simp [mapped] at translated + | some atom => + have atomEq : atom = targetAtom := by + simpa [mapped] using translated + unfold Lower.EdgeTrace.explicitMapOf at mapped + rw [Array.getElem?_mapIdx] at mapped + cases inputAt : input[sourceIndex]? with + | none => simp [inputAt] at mapped + | some slot => + cases slot with + | none => simp [inputAt] at mapped + | some sourceAtom => + have registerEq : atom = .reg sourceIndex := by + simpa [inputAt] using mapped.symm + simp [registerEq] + +/-- The complete checked constructor-child transform: edge rebasing chooses +the scrutinee lender, a uniform schema supplies the borrowed field prefix, +and the runtime constructor supplies the concrete support edges. -/ +theorem constructor + {schemas : Ix.Compiler.Ixon.Owned → CtorId → Option CtorSchema} + {store : IxIR1.Store} {source : List RVal} {target : Array RVal} + {input : EnvMap} {capabilities afterCapabilities : + Array Lower.BindingCap} {frameRoots : List IxIR1.Sim.Root} + {sourceScrutinee : IxIR1.Atom} {targetScrutinee : Atom} + {cid : CtorId} {fields : Array RVal} {location : Nat} + {box : IxIR1.NodeBox} {parameterCount : Nat} + (invariant : SourceOwnershipInvariant store source input capabilities + frameRoots) + (environments : EnvRel source target input) + (transition : Lower.constructorChildCapabilities? schemas input + sourceScrutinee cid capabilities = some afterCapabilities) + (translated : Lower.InputMap.translateAtom + (Lower.EdgeTrace.explicitMapOf input) sourceScrutinee = + some targetScrutinee) + (sourceResolved : IxIR1.resolveAtom source sourceScrutinee = + .ok (.loc location)) + (found : store.get? location = some box) + (node : box.node = .ctorN cid fields) + (schemaFields : ∀ {world schema}, schemas world cid = some schema → + ∃ count, schema.fields = Array.replicate count world) + (afterSize : afterCapabilities.size = + fields.size + capabilities.size) : + SourceOwnershipInvariant store (fields.toList.reverse ++ source) + (Lower.constructorChildInputMap parameterCount fields.size ++ + Lower.EdgeTrace.explicitMapOf input) + afterCapabilities frameRoots := by + unfold Lower.constructorChildCapabilities? at transition + cases rebasedEq : Lower.edgeCapabilities? capabilities input with + | none => simp [rebasedEq] at transition + | some rebased => + have edgeInvariant := invariant.edge environments rebasedEq + cases sourceScrutinee with + | lit literal => simp [rebasedEq] at transition + | erased => simp [rebasedEq] at transition + | var sourceIndex => + have successorInput := + explicitMapOf_at_of_translate_var translated + cases sourceAt : source[sourceIndex]? with + | none => simp [IxIR1.resolveAtom, sourceAt] at sourceResolved + | some scrutineeValue => + have scrutineeEq : scrutineeValue = .loc location := by + simpa [IxIR1.resolveAtom, sourceAt] using sourceResolved + subst scrutineeValue + cases capabilityAt : rebased[sourceIndex]? with + | none => simp [rebasedEq, capabilityAt] at transition + | some capability => + cases capability with + | scalar => + simp [rebasedEq, capabilityAt] at transition + | dead => + simp [rebasedEq, capabilityAt] at transition + | owned world => + cases schemaAt : schemas world cid with + | none => + simp [rebasedEq, capabilityAt, schemaAt] at transition + | some schema => + simp [rebasedEq, capabilityAt, schemaAt] at transition + subst afterCapabilities + obtain ⟨count, schemaUniform⟩ := + schemaFields schemaAt + have rebasedSize : rebased.size = capabilities.size := + edgeInvariant.length.symm.trans invariant.length + have countEq : count = fields.size := by + simp [schemaUniform, rebasedSize] at afterSize + omega + subst count + have provenance : BorrowProvenance store source + (Lower.EdgeTrace.explicitMapOf input) rebased + frameRoots world (.value sourceIndex) + (.loc location) := + ⟨sourceIndex, .loc location, successorInput, + capabilityAt, sourceAt, .refl⟩ + have fieldsInvariant := constructorFields + edgeInvariant provenance found node + (parameterCount := parameterCount) + simpa [schemaUniform] using fieldsInvariant + | borrowed world lender => + cases schemaAt : schemas world cid with + | none => + simp [rebasedEq, capabilityAt, schemaAt] at transition + | some schema => + simp [rebasedEq, capabilityAt, schemaAt] at transition + subst afterCapabilities + obtain ⟨count, schemaUniform⟩ := + schemaFields schemaAt + have rebasedSize : rebased.size = capabilities.size := + edgeInvariant.length.symm.trans invariant.length + have countEq : count = fields.size := by + simp [schemaUniform, rebasedSize] at afterSize + omega + subst count + have provenance := + edgeInvariant.borrows capabilityAt sourceAt + have fieldsInvariant := constructorFields + edgeInvariant provenance found node + (parameterCount := parameterCount) + simpa [schemaUniform] using fieldsInvariant + +end SourceOwnershipInvariant + +namespace SourceOwnershipAt + +/-- Checked literal-zero branch selection transports ownership to every +matching position in the exact recursive child. -/ +theorem switchNatZero + (checked : Lower.Checked) {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ checked.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} {input : EnvMap} + {entryValueCount : Nat} {sourceScrutinee : IxIR1.Atom} + {alternatives : Array IxIR1.Alt} {targetScrutinee : Atom} + {generated : Block} {outgoing : List Lower.EdgeTrace} + {children : List Lower.CodeTrace} {constructors : Array CtorAlt} + {peel : NatPeel} + (descendant : functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children)) + (terminator : generated.terminator = + .switchValue targetScrutinee constructors (some peel)) + (branches : Lower.NatBranchPairMatch site blockId input alternatives + constructors peel outgoing children) + {store : IxIR1.Store} {source : List RVal} {target : Array RVal} + {frameRoots : List IxIR1.Sim.Root} + (ownership : SourceOwnershipAt checked.artifact.trace.positions + (.switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children) + store source frameRoots) + (environments : EnvRel source target input) : + SourceOwnershipAt checked.artifact.trace.positions branches.zeroChild + store source frameRoots := by + intro after afterMember afterCoordinate + obtain ⟨before, beforeMember, beforeCoordinate, transition⟩ := + checked.natZeroBranchTransition functionMember descendant terminator + branches.zeroChildAt branches.succChildAt afterMember afterCoordinate + have current := ownership before beforeMember beforeCoordinate + have current' : SourceOwnershipInvariant store source input + before.sourceCapabilities frameRoots := by + simpa [Lower.CodeTrace.sourceInputMap] using current + have next := current'.natZero environments transition + have childInput : branches.zeroChild.sourceInputMap = + Lower.EdgeTrace.explicitMapOf input := by + rw [branches.zero.childInput] + unfold Lower.EdgeTrace.sourceMap + rw [branches.zero.edgeImplicitScalars, sourceMapOf_zero_for_ownership, + branches.zero.edgeSourceInput] + rw [childInput] + exact next + +/-- Checked literal-successor branch selection transports ownership through +the peeled scalar prefix and its one-register lender shift. -/ +theorem switchNatSucc + (checked : Lower.Checked) {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ checked.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} {input : EnvMap} + {entryValueCount : Nat} {sourceScrutinee : IxIR1.Atom} + {alternatives : Array IxIR1.Alt} {targetScrutinee : Atom} + {generated : Block} {outgoing : List Lower.EdgeTrace} + {children : List Lower.CodeTrace} {constructors : Array CtorAlt} + {peel : NatPeel} + (descendant : functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children)) + (terminator : generated.terminator = + .switchValue targetScrutinee constructors (some peel)) + (branches : Lower.NatBranchPairMatch site blockId input alternatives + constructors peel outgoing children) + {store : IxIR1.Store} {source : List RVal} {target : Array RVal} + {frameRoots : List IxIR1.Sim.Root} {predecessor : Nat} + (ownership : SourceOwnershipAt checked.artifact.trace.positions + (.switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children) + store source frameRoots) + (environments : EnvRel source target input) : + SourceOwnershipAt checked.artifact.trace.positions branches.succChild + store (.lit (.nat predecessor) :: source) frameRoots := by + intro after afterMember afterCoordinate + obtain ⟨before, beforeMember, beforeCoordinate, transition⟩ := + checked.natSuccBranchTransition functionMember descendant terminator + branches.zeroChildAt branches.succChildAt afterMember afterCoordinate + have current := ownership before beforeMember beforeCoordinate + have current' : SourceOwnershipInvariant store source input + before.sourceCapabilities frameRoots := by + simpa [Lower.CodeTrace.sourceInputMap] using current + have next := current'.natSucc + (predecessor := predecessor) environments transition + have childInput : branches.succChild.sourceInputMap = + Lower.EdgeTrace.sourceMapOf 1 + (Lower.EdgeTrace.explicitMapOf input) := by + rw [branches.succ.childInput] + unfold Lower.EdgeTrace.sourceMap + rw [branches.succ.edgeImplicitScalars, + branches.succ.edgeSourceInput] + rw [childInput] + exact next + +/-- Checked constructor branch selection transports ownership to every +matching child position. Coordinate sizes force the uniform pipeline schema +arity to equal the concrete runtime field vector. -/ +theorem switchCtor + (checked : Lower.Checked) {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ checked.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} {input : EnvMap} + {entryValueCount : Nat} {sourceScrutinee : IxIR1.Atom} + {peelNat : Bool} {alternatives : Array IxIR1.Alt} + {targetScrutinee : Atom} {generated : Block} + {outgoing : List Lower.EdgeTrace} {children : List Lower.CodeTrace} + {constructors : Array CtorAlt} {targetPeel : Option NatPeel} + {index : Nat} {targetBranch : CtorAlt} {edge : Lower.EdgeTrace} + {child : Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children)) + (terminator : generated.terminator = + .switchValue targetScrutinee constructors targetPeel) + (targetAt : constructors[index]? = some targetBranch) + (childAt : children[index]? = some child) + (branch : Lower.ConstructorBranchMatch site blockId input + sourceScrutinee alternatives targetBranch edge child) + {store : IxIR1.Store} {source : List RVal} {targetValues : Array RVal} + {frameRoots : List IxIR1.Sim.Root} {location : Nat} + {box : IxIR1.NodeBox} {cid : CtorId} {fields : Array RVal} + (ownership : SourceOwnershipAt checked.artifact.trace.positions + (.switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children) + store source frameRoots) + (environments : EnvRel source targetValues input) + (sourceResolved : IxIR1.resolveAtom source sourceScrutinee = + .ok (.loc location)) + (found : store.get? location = some box) + (node : box.node = .ctorN cid fields) + (targetCid : targetBranch.cid = cid) + (fieldArity : fields.size = branch.fieldCount) + (schemaFields : ∀ {world schema}, + checked.artifact.validationContext.schemas world cid = some schema → + ∃ count, schema.fields = Array.replicate count world) : + SourceOwnershipAt checked.artifact.trace.positions child store + (fields.toList.reverse ++ source) frameRoots := by + intro after afterMember afterCoordinate + obtain ⟨before, beforeMember, beforeCoordinate, transition⟩ := + checked.constructorBranchTransition functionMember descendant terminator + targetAt childAt afterMember afterCoordinate + have current := ownership before beforeMember beforeCoordinate + have current' : SourceOwnershipInvariant store source input + before.sourceCapabilities frameRoots := by + simpa [Lower.CodeTrace.sourceInputMap] using current + have beforeSize : before.sourceCapabilities.size = input.size := + before.sourceCapabilities_size_of_coordinateMatch beforeCoordinate + have afterCoordinateSize : + after.sourceCapabilities.size = child.sourceInputMap.size := + after.sourceCapabilities_size_of_coordinateMatch afterCoordinate + have afterSize : after.sourceCapabilities.size = + fields.size + before.sourceCapabilities.size := by + calc + after.sourceCapabilities.size = child.sourceInputMap.size := + afterCoordinateSize + _ = branch.fieldCount + input.size := by + rw [branch.childInput] + simp [Lower.constructorChildInputMap, + Lower.EdgeTrace.explicitMapOf, branch.edgeSourceInput] + _ = fields.size + before.sourceCapabilities.size := by + rw [← fieldArity, beforeSize] + rw [targetCid] at transition + have next := current'.constructor environments transition + branch.translatedScrutinee sourceResolved found node schemaFields afterSize + (parameterCount := edge.targetParams.size) + have childInput : child.sourceInputMap = + Lower.constructorChildInputMap edge.targetParams.size fields.size ++ + Lower.EdgeTrace.explicitMapOf input := by + rw [branch.childInput, ← fieldArity, branch.edgeSourceInput] + rw [childInput] + exact next + +end SourceOwnershipAt + +/-- Runtime frame invariant at one recursive compiler-trace node. This is the +state threaded by the block-compositional semantic induction. -/ +structure CodeStateRel (functionTrace : Lower.FunctionTrace) + (trace : Lower.CodeTrace) (source : List RVal) + (frame : Eval.Frame) : Prop where + definition : frame.definition = functionTrace.generated + block : frame.block = trace.sourceBlock + pc : frame.pc = trace.entryPc + valueCount : frame.values.size = trace.entryValueCount + sourceCount : source.length = trace.sourceInputMap.size + environments : EnvRel source frame.values trace.sourceInputMap + +/-- A source result-world fact is exactly the executable world check required +by a target return from the related generated function. -/ +theorem CodeStateRel.resultWorld {functionTrace : Lower.FunctionTrace} + {trace : Lower.CodeTrace} {source : List RVal} {frame : Eval.Frame} + (state : CodeStateRel functionTrace trace source frame) + {sourceStore : IxIR1.Store} {targetStore : Eval.Store} + (stores : StoreRel sourceStore targetStore) {value : RVal} + (world : IxIR1.Sim.HasWorld sourceStore functionTrace.source.result value) : + Eval.RVal.hasWorld targetStore frame.definition.signature.result value = + true := by + apply stores.hasWorld_eq_true_iff.mpr + rw [state.definition, functionTrace.sourceResult] + exact world + +/-- A related frame at a recursive trace descendant executes the exact head +block certified by that function trace. -/ +theorem CodeStateRel.blockAt {functionTrace : Lower.FunctionTrace} + {trace : Lower.CodeTrace} {source : List RVal} {frame : Eval.Frame} + (state : CodeStateRel functionTrace trace source frame) + (descendant : functionTrace.root.Descendant trace) : + frame.definition.blocks[frame.block]? = some trace.headBlock.2 := by + have matched := functionTrace.descendantInstructionsMatch descendant + have blockId := Lower.CodeTrace.headBlock_eq_sourceBlock_of_match matched + have blockAt := functionTrace.descendantHeadBlockAt descendant + simpa [state.definition, state.block, blockId] using blockAt + +/-- A related instruction-node state points at the exact retained instruction +inside the generated function, including the evaluator's strict PC bound. -/ +theorem CodeStateRel.instructionAt {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : EnvMap} {entryValueCount index : Nat} + {operation : IxIR1.Op} {instruction : Instr} {next : Lower.CodeTrace} + {source : List RVal} {frame : Eval.Frame} + (state : CodeStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount operation index + instruction next) source frame) + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount operation index + instruction next)) : + frame.definition.blocks[frame.block]? = some next.headBlock.2 ∧ + frame.pc < next.headBlock.2.instructions.size ∧ + next.headBlock.2.instructions[frame.pc]? = some instruction := by + obtain ⟨localMatch, _⟩ := functionTrace.descendantLetOpMatch descendant + have framePc : frame.pc = index := by + simpa [Lower.CodeTrace.entryPc] using state.pc + obtain ⟨indexBound, _⟩ := + Array.getElem?_eq_some_iff.mp localMatch.instructionAt + refine ⟨state.blockAt descendant, ?_, ?_⟩ + · simpa [framePc] using indexBound + · simpa [framePc] using localMatch.instructionAt + +/-- Generic recursive-state hand-off after one retained baseline instruction. +The operation proof supplies only the concrete successor-frame equalities and +environment relation; the checked trace supplies definition, block, PC, +register-count, and proof-map progression to the recursive continuation. -/ +theorem CodeStateRel.letOpNext {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : EnvMap} {entryValueCount index : Nat} + {operation : IxIR1.Op} {instruction : Instr} {next : Lower.CodeTrace} + {source nextSource : List RVal} {frame nextFrame : Eval.Frame} + (state : CodeStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount operation index + instruction next) source frame) + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount operation index + instruction next)) + (definition : nextFrame.definition = frame.definition) + (block : nextFrame.block = frame.block) + (pc : nextFrame.pc = frame.pc + 1) + (valueCount : nextFrame.values.size = frame.values.size + + (Lower.Instr.baselineValueDelta instruction).getD 0) + (sourceCount : nextSource.length = source.length + 1) + (environments : EnvRel nextSource nextFrame.values nextInput) : + CodeStateRel functionTrace next nextSource nextFrame := by + obtain ⟨localMatch, _⟩ := functionTrace.descendantLetOpMatch descendant + have frameBlock : frame.block = blockId := by + simpa [Lower.CodeTrace.sourceBlock] using state.block + have framePc : frame.pc = index := by + simpa [Lower.CodeTrace.entryPc] using state.pc + constructor + · exact definition.trans state.definition + · exact block.trans (frameBlock.trans localMatch.nextBlock.symm) + · calc + nextFrame.pc = frame.pc + 1 := pc + _ = index + 1 := by rw [framePc] + _ = next.entryPc := localMatch.nextPc.symm + · calc + nextFrame.values.size = frame.values.size + + (Lower.Instr.baselineValueDelta instruction).getD 0 := valueCount + _ = entryValueCount + + (Lower.Instr.baselineValueDelta instruction).getD 0 := by + simpa [Lower.CodeTrace.entryValueCount] using + congrArg (fun count => count + + (Lower.Instr.baselineValueDelta instruction).getD 0) + state.valueCount + _ = next.entryValueCount := localMatch.nextValueCount.symm + · have currentSourceCount : source.length = input.size := by + simpa [Lower.CodeTrace.sourceInputMap] using state.sourceCount + have mapsMatched := functionTrace.descendantInputMapsMatch descendant + have mapSize := Lower.CodeTrace.inputMapSize_of_match mapsMatched + calc + nextSource.length = source.length + 1 := sourceCount + _ = input.size + 1 := by rw [currentSourceCount] + _ = nextInput.size := mapSize.symm + _ = next.sourceInputMap.size := by rw [localMatch.nextInput] + · simpa [localMatch.nextInput] using environments + +/-- A successor proof map may forget live slots but cannot retarget one. This +is the ownership-consumption step needed between the operation-local lemmas +and the compiler's cursor relation. -/ +abbrev EnvMap.Forgets (next current : EnvMap) : Prop := + Lower.InputMap.Forgets next current + +/-- Forgetting consumed bindings preserves the environment relation. -/ +theorem EnvRel.forget {source : List RVal} {target : Array RVal} + {current next : EnvMap} (relation : EnvRel source target current) + (forgets : EnvMap.Forgets next current) : + EnvRel source target next := by + intro index value atom sourceGet mapped + exact relation index value atom sourceGet (forgets index atom mapped) + +/-- Specialize safe forgetting to one checked recursive instruction node. +The caller supplies the canonical binder-plus-predecessor relation produced by +the operation lemma; the trace certificate converts it to the exact successor +map retained by the compiler. -/ +theorem EnvRel.forgetTracedLetOp + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : EnvMap} {entryValueCount index : Nat} + {operation : IxIR1.Op} {instruction : Instr} {next : Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount operation index + instruction next)) + {source : List RVal} {target : Array RVal} {head : Atom} + (relation : EnvRel source target (#[some head] ++ input)) + (binder : Lower.Instr.baselineBinderAtom entryValueCount instruction = + some head) : + EnvRel source target nextInput := by + have mapsMatched := functionTrace.descendantInputMapsMatch descendant + have mapFacts := Lower.CodeTrace.inputMapForgets_of_match mapsMatched binder + exact relation.forget mapFacts.2.2.1 + +/-- Value-producing specialization: rewrite the runtime append ordinal to the +compiler-certified entry count before applying checked map forgetting. -/ +theorem EnvRel.forgetTracedValue + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : EnvMap} {entryValueCount index : Nat} + {operation : IxIR1.Op} {instruction : Instr} {next : Lower.CodeTrace} + {source nextSource : List RVal} {frame : Eval.Frame} + (state : CodeStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount operation index + instruction next) source frame) + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount operation index + instruction next)) + {target : Array RVal} + (relation : EnvRel nextSource target + (#[some (.reg frame.values.size)] ++ input)) + (binder : Lower.Instr.baselineBinderAtom entryValueCount instruction = + some (.reg entryValueCount)) : + EnvRel nextSource target nextInput := by + have canonical : EnvRel nextSource target + (#[some (.reg entryValueCount)] ++ input) := by + simpa [state.valueCount, Lower.CodeTrace.entryValueCount, + Lower.CodeTrace.sourceInputMap] using relation + exact canonical.forgetTracedLetOp descendant binder + +/-- Effect-only specialization for instructions whose IxIR₁ result binder +maps to the inert erased atom and does not append a target value register. -/ +theorem EnvRel.forgetTracedErased + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : EnvMap} {entryValueCount index : Nat} + {operation : IxIR1.Op} {instruction : Instr} {next : Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount operation index + instruction next)) + {source : List RVal} {target : Array RVal} + (relation : EnvRel source target (#[some .erased] ++ input)) + (binder : Lower.Instr.baselineBinderAtom entryValueCount instruction = + some .erased) : + EnvRel source target nextInput := + relation.forgetTracedLetOp descendant binder + +/-- The proof map at a function entry reverses source de Bruijn parameter +slots onto target call-order registers. -/ +def entryMap (arity : Nat) : EnvMap := + Lower.entryInputMap arity + +/-- A resolved target argument vector is related to the source callee's +reversed de Bruijn environment by the canonical entry map. -/ +theorem EnvRel.entry (values : Array RVal) : + EnvRel values.toList.reverse values (entryMap values.size) := by + intro index value atom sourceGet mapped + obtain ⟨indexBound, _⟩ := List.getElem?_eq_some_iff.mp sourceGet + have originalBound : index < values.toList.length := by + simpa using indexBound + have targetGet : + values[values.size - 1 - index]? = some value := by + rw [List.getElem?_reverse (l := values.toList) originalBound] + at sourceGet + simpa using sourceGet + have atomEq : atom = .reg (values.size - 1 - index) := by + unfold entryMap Lower.entryInputMap at mapped + rw [Array.getElem?_map, List.getElem?_toArray, + List.getElem?_range (by simpa using indexBound)] at mapped + simpa using Option.some.inj mapped.symm + subst atom + simp [Eval.resolveAtom, targetGet] + +/-- Any retained function trace starts in `CodeStateRel` when its resolved +arguments are installed in call order and the source environment uses the +IxIR₁ reversed de Bruijn convention. -/ +theorem functionEntryCodeState (trace : Lower.FunctionTrace) + (values : Array RVal) + (arity : values.size = trace.source.arity) : + CodeStateRel trace trace.root values.toList.reverse + { definition := trace.generated, values } := by + constructor + · rfl + · simpa using trace.entryBlock.symm + · simpa using trace.entryPc.symm + · simpa [trace.entryValueCount] using arity + · rw [trace.entryInput, ← arity] + simp [Lower.entryInputMap] + · rw [trace.entryInput, ← arity] + exact EnvRel.entry values + +/-- Exact target frame used for a lowered artifact's closed main. -/ +def initialMainFrame (artifact : Lower.Artifact) : Eval.Frame := + { definition := artifact.program.main } + +/-- Exact target machine used for a lowered artifact's closed main. -/ +def initialMainMachine (artifact : Lower.Artifact) (heapFuel : Nat) : + Eval.Machine := + Eval.initialMachine artifact.program.main #[] heapFuel + +/-- All structural and semantic relations needed by the root trace induction +hold at the exact machine state consumed by `runMain`. -/ +theorem initialMainState (artifact : Lower.Artifact) (heapFuel : Nat) : + let frame := initialMainFrame artifact + let machine := initialMainMachine artifact heapFuel + machine.control = .running frame [] ∧ + frame.definition = artifact.mainTrace.generated ∧ + frame.block = artifact.mainTrace.root.sourceBlock ∧ + frame.pc = artifact.mainTrace.root.entryPc ∧ + EnvRel [] frame.values artifact.mainTrace.root.sourceInputMap ∧ + StoreRel ({} : IxIR1.Store) machine.store ∧ + frame.definition.blocks[frame.block]? = + some artifact.mainTrace.root.headBlock.2 := by + dsimp only + refine ⟨rfl, artifact.mainGenerated.symm, ?_, ?_, ?_, ?_, ?_⟩ + · simpa [initialMainFrame] using artifact.mainTrace.entryBlock.symm + · simpa [initialMainFrame] using artifact.mainTrace.entryPc.symm + · rw [artifact.mainEntryInput] + exact EnvRel.empty + · change StoreRel ({} : IxIR1.Store) + (Eval.initialMachine artifact.program.main #[] heapFuel).store + rw [Eval.initialMachine_store_empty] + exact StoreRel.initial + · simpa [initialMainFrame] using artifact.mainHeadBlockAt + +/-- The exact initial main frame satisfies the recursive trace-state +invariant at the artifact's distinguished root. -/ +theorem initialMainCodeState (artifact : Lower.Artifact) : + CodeStateRel artifact.mainTrace artifact.mainTrace.root [] + (initialMainFrame artifact) := by + constructor + · exact artifact.mainGenerated.symm + · simpa [initialMainFrame] using artifact.mainTrace.entryBlock.symm + · simpa [initialMainFrame] using artifact.mainTrace.entryPc.symm + · rw [artifact.mainTrace.entryValueCount, artifact.mainSource] + rfl + · rw [artifact.mainEntryInput] + rfl + · rw [artifact.mainEntryInput] + exact EnvRel.empty + +/-- `runMain` starts from exactly the machine named by `initialMainState`. -/ +theorem runMain_eq_initialMainMachine (artifact : Lower.Artifact) + (context : Eval.Context) (interpretation : Eval.Interpretation) + (controlFuel heapFuel : Nat) : + Eval.runMain context interpretation artifact.program controlFuel heapFuel = + Eval.runMachine context interpretation controlFuel + (initialMainMachine artifact heapFuel) := by + exact Eval.runMain_eq_runMachine artifact.mainArity artifact.mainNonempty + +/-- Shifting a register operand past a value prefix preserves its resolution +in the suffix register file. -/ +theorem resolveAtom_shift {suffix : Array RVal} {atom : Atom} {value : RVal} + (prefixValues : Array RVal) + (resolved : Eval.resolveAtom suffix atom = .ok value) : + Eval.resolveAtom (prefixValues ++ suffix) + (Lower.shiftAtom prefixValues.size atom) = .ok value := by + cases atom with + | reg index => + cases found : suffix[index]? with + | none => simp [Eval.resolveAtom, found] at resolved + | some candidate => + have candidateEq : candidate = value := by + simpa [Eval.resolveAtom, found] using resolved + subst candidate + have notPrefix : + ¬index + prefixValues.size < prefixValues.size := + Nat.not_lt_of_ge (Nat.le_add_left prefixValues.size index) + have offset : + index + prefixValues.size - prefixValues.size = index := + Nat.add_sub_cancel_right index prefixValues.size + simp [Lower.shiftAtom, Eval.resolveAtom, Array.getElem?_append, + notPrefix, offset, found] + | lit literal => exact resolved + | erased => exact resolved + +/-- Shifting an operand across a zero-width prefix is the identity. -/ +@[simp] theorem shiftAtom_zero (atom : Atom) : + Lower.shiftAtom 0 atom = atom := by + cases atom <;> simp [Lower.shiftAtom] + +/-- A zero-width implicit prefix leaves the explicit successor map +unchanged. -/ +theorem sourceMapOf_zero (explicitMap : Array (Option Atom)) : + Lower.EdgeTrace.sourceMapOf 0 explicitMap = explicitMap := by + apply Array.ext + · simp [Lower.EdgeTrace.sourceMapOf] + · intro index leftBound rightBound + simp [Lower.EdgeTrace.sourceMapOf] + cases explicitMap[index] <;> rfl + +/-- Prefixing implicit scalar block parameters preserves an explicit +successor environment relation. This is exactly the map shape emitted in an +`EdgeTrace`, including register shifting and absent consumed slots. -/ +theorem EnvRel.sourceMapOf {source : List RVal} + {explicitValues : Array RVal} {explicitMap : EnvMap} + (relation : EnvRel source explicitValues explicitMap) + (implicitValues : Array RVal) : + EnvRel (implicitValues.toList ++ source) + (implicitValues ++ explicitValues) + (Lower.EdgeTrace.sourceMapOf implicitValues.size explicitMap) := by + intro index value atom sourceGet mapped + by_cases prefixIndex : index < implicitValues.size + · have valueAt : implicitValues[index]? = some value := by + have listAt : implicitValues.toList[index]? = some value := by + simpa [List.getElem?_append_left prefixIndex] using sourceGet + simpa using listAt + have atomEq : atom = .reg index := by + unfold Lower.EdgeTrace.sourceMapOf at mapped + simp only [Array.getElem?_append, Array.size_map, List.size_toArray, + List.length_range, prefixIndex, if_pos, Array.getElem?_map, + List.getElem?_toArray, List.getElem?_range prefixIndex, + Option.map_some, Option.some.injEq] at mapped + exact mapped.symm + subst atom + simp only [Eval.resolveAtom] + rw [Array.getElem?_append, if_pos prefixIndex, valueAt] + · have afterPrefix : implicitValues.size ≤ index := + Nat.le_of_not_gt prefixIndex + let explicitIndex := index - implicitValues.size + have sourceAt : source[explicitIndex]? = some value := by + rw [List.getElem?_append_right (by simpa using afterPrefix)] at sourceGet + simpa [explicitIndex] using sourceGet + unfold Lower.EdgeTrace.sourceMapOf at mapped + simp only [Array.getElem?_append, Array.size_map, List.size_toArray, + List.length_range, prefixIndex, Array.getElem?_map] at mapped + cases explicitAt : explicitMap[explicitIndex]? with + | none => simp [explicitIndex, explicitAt] at mapped + | some slot => + cases slot with + | none => simp [explicitIndex, explicitAt] at mapped + | some explicitAtom => + have mappedAt : + explicitMap[explicitIndex]? = some (some explicitAtom) := explicitAt + have atomEq : + atom = Lower.shiftAtom implicitValues.size explicitAtom := by + simpa [explicitIndex, explicitAt] using mapped.symm + subst atom + exact resolveAtom_shift implicitValues + (relation explicitIndex value explicitAtom sourceAt mappedAt) + +/-- A generated edge trace and the baseline evaluator transfer agree on the +exact successor frame and establish its proof-side source environment. This +is the CFG hand-off used by constructor branches (with no implicit values) +and Nat-successor branches (with the predecessor prefix). -/ +theorem simulate_traced_edge_transfer + {frame : Eval.Frame} {edge : Edge} {trace : Lower.EdgeTrace} + {block : Block} {source : List RVal} {explicitMap : EnvMap} + {implicitValues explicitValues : Array RVal} + (edgeTarget : edge.target = trace.target) + (edgeValues : edge.values = trace.explicitValues) + (edgeCredits : edge.credits = #[]) + (traceMap : trace.sourceMap = + Lower.EdgeTrace.sourceMapOf trace.implicitScalars explicitMap) + (implicitCount : trace.implicitScalars = implicitValues.size) + (resolved : Eval.resolveAtoms frame.values trace.explicitValues = + .ok explicitValues) + (environments : EnvRel source explicitValues explicitMap) + (frameCredits : frame.credits = #[]) + (blockAt : frame.definition.blocks[trace.target]? = some block) + (blockParams : block.valueParams = trace.targetParams) + (valueArity : (implicitValues ++ explicitValues).size = + trace.targetParams.size) + (blockCredits : block.creditParams = #[]) : + let target : Eval.Frame := + { frame with + block := trace.target + pc := 0 + values := implicitValues ++ explicitValues + credits := #[] } + Eval.EdgeTransfer frame edge implicitValues target ∧ + EnvRel (implicitValues.toList ++ source) target.values trace.sourceMap := by + dsimp only + have targetResolved : Eval.resolveAtoms frame.values edge.values = + .ok explicitValues := by simpa [edgeValues] using resolved + have targetBlock : frame.definition.blocks[edge.target]? = some block := by + simpa [edgeTarget] using blockAt + have targetArity : (implicitValues ++ explicitValues).size = + block.valueParams.size := by + rw [blockParams] + exact valueArity + constructor + · simpa [edgeTarget] using Eval.EdgeTransfer.baseline targetResolved + frameCredits edgeCredits targetBlock targetArity blockCredits + · simpa [traceMap, implicitCount] using + environments.sourceMapOf implicitValues + +/-- Operand resolution is representation-independent once the generated +environment map is related. This is the common first step of the `move`, +memory-operation, call, return, and switch simulation cases. -/ +theorem resolveAtom_of_envRel {source : List RVal} {target : Array RVal} + {mapping : EnvMap} (relation : EnvRel source target mapping) + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {value : RVal} + (translated : translateAtom mapping sourceAtom = some targetAtom) + (resolved : IxIR1.resolveAtom source sourceAtom = .ok value) : + Eval.resolveAtom target targetAtom = .ok value := by + cases sourceAtom with + | var index => + have sourceGet : source[index]? = some value := by + cases found : source[index]? with + | none => simp [IxIR1.resolveAtom, found] at resolved + | some candidate => + have equal : candidate = value := by + simpa [IxIR1.resolveAtom, found] using resolved + exact congrArg some equal + cases mappedGet : mapping[index]? with + | none => + simp [Lower.InputMap.translateAtom, mappedGet] at translated + | some slot => + cases slot with + | none => + simp [Lower.InputMap.translateAtom, mappedGet] at translated + | some mappedAtom => + have atomEq : mappedAtom = targetAtom := by + simpa [Lower.InputMap.translateAtom, mappedGet] using translated + subst mappedAtom + exact relation index value targetAtom sourceGet mappedGet + | lit literal => + simp only [Lower.InputMap.translateAtom, Option.some.injEq] at translated + subst targetAtom + simp only [IxIR1.resolveAtom, Except.ok.injEq] at resolved + subst value + rfl + | erased => + simp only [Lower.InputMap.translateAtom, Option.some.injEq] at translated + subst targetAtom + simp only [IxIR1.resolveAtom, Except.ok.injEq] at resolved + subst value + rfl + +/-- A translated target operand can be reflected back to its source operand +when the checked environment map has the certified source length. -/ +theorem resolveAtom_of_envRel_target {source : List IxIR1.RVal} + {target : Array IxIR1.RVal} {mapping : EnvMap} + (relation : EnvRel source target mapping) + (sourceCount : source.length = mapping.size) + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {value : IxIR1.RVal} + (translated : translateAtom mapping sourceAtom = some targetAtom) + (resolved : Eval.resolveAtom target targetAtom = .ok value) : + IxIR1.resolveAtom source sourceAtom = .ok value := by + cases sourceAtom with + | var index => + cases mappedGet : mapping[index]? with + | none => + simp [Lower.InputMap.translateAtom, mappedGet] at translated + | some slot => + cases slot with + | none => + simp [Lower.InputMap.translateAtom, mappedGet] at translated + | some mappedAtom => + have atomEq : mappedAtom = targetAtom := by + simpa [Lower.InputMap.translateAtom, mappedGet] using translated + subst mappedAtom + have mapBound : index < mapping.size := + (Array.getElem?_eq_some_iff.mp mappedGet).1 + have sourceBound : index < source.length := by + rw [sourceCount] + exact mapBound + let sourceValue := source[index] + have sourceGet : source[index]? = some sourceValue := by + simp [sourceValue, sourceBound] + have targetSource := relation index sourceValue targetAtom + sourceGet mappedGet + have valueEq : sourceValue = value := + Except.ok.inj (targetSource.symm.trans resolved) + simp [IxIR1.resolveAtom, sourceGet, valueEq] + | lit literal => + simp only [Lower.InputMap.translateAtom, Option.some.injEq] at translated + subst targetAtom + simp only [Eval.resolveAtom, Except.ok.injEq] at resolved + subst value + rfl + | erased => + simp only [Lower.InputMap.translateAtom, Option.some.injEq] at translated + subst targetAtom + simp only [Eval.resolveAtom, Except.ok.injEq] at resolved + subst value + rfl + +/-- Appending a new SSA value does not change resolution of any atom that was +already valid in the frame. -/ +theorem resolveAtom_push_old {target : Array RVal} {atom : Atom} + {value extra : RVal} + (resolved : Eval.resolveAtom target atom = .ok value) : + Eval.resolveAtom (target.push extra) atom = .ok value := by + cases atom with + | lit literal => exact resolved + | erased => exact resolved + | reg index => + have notEnd : index ≠ target.size := by + intro equal + subst index + simp [Eval.resolveAtom] at resolved + simpa [Eval.resolveAtom, Array.getElem?_push, notEnd] using resolved + +/-- Appending any value suffix preserves resolution of atoms that were valid +in the original register file. -/ +theorem resolveAtom_append_old {target suffix : Array RVal} {atom : Atom} + {value : RVal} + (resolved : Eval.resolveAtom target atom = .ok value) : + Eval.resolveAtom (target ++ suffix) atom = .ok value := by + cases atom with + | lit literal => exact resolved + | erased => exact resolved + | reg index => + cases found : target[index]? with + | none => simp [Eval.resolveAtom, found] at resolved + | some candidate => + have bound : index < target.size := + (Array.getElem?_eq_some_iff.mp found).1 + simpa [Eval.resolveAtom, Array.getElem?_append, bound, found] using + resolved + +/-- Result-producing instructions prepend one source de Bruijn binding while +appending one target SSA register. -/ +theorem EnvRel.bindValue {source : List RVal} {target : Array RVal} + {mapping : EnvMap} (relation : EnvRel source target mapping) + (value : RVal) : + EnvRel (value :: source) (target.push value) + (#[some (.reg target.size)] ++ mapping) := by + intro index candidate atom sourceGet mapped + cases index with + | zero => + simp only [List.getElem?_cons_zero, Option.some.injEq] at sourceGet + subst candidate + have atomEq : atom = .reg target.size := by + simpa [Array.getElem?_append] using mapped.symm + subst atom + simp [Eval.resolveAtom] + | succ index => + have oldGet : source[index]? = some candidate := by + simpa using sourceGet + have oldMapped : mapping[index]? = some (some atom) := by + simpa [Array.getElem?_append] using mapped + exact resolveAtom_push_old + (relation index candidate atom oldGet oldMapped) + +/-- Generic value-producing continuation state. This is shared by ordinary +one-step operations, direct calls after their callee returns, and dynamic +application after its PAP chain eventually resumes the original caller. -/ +theorem CodeStateRel.letOpValueNext + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : EnvMap} {entryValueCount index : Nat} + {operation : IxIR1.Op} {instruction : Instr} {next : Lower.CodeTrace} + {source : List RVal} {frame : Eval.Frame} + (state : CodeStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount operation index + instruction next) source frame) + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount operation index + instruction next)) + (binder : Lower.Instr.baselineBinderAtom entryValueCount instruction = + some (.reg entryValueCount)) + (delta : Lower.Instr.baselineValueDelta instruction = some 1) + (value : RVal) : + let nextFrame : Eval.Frame := + { frame with + pc := frame.pc + 1 + values := frame.values.push value } + CodeStateRel functionTrace next (value :: source) nextFrame := by + dsimp only + have canonical := state.environments.bindValue value + have nextEnvironments := canonical.forgetTracedValue state descendant binder + exact state.letOpNext descendant rfl rfl rfl + (by simp [delta]) rfl nextEnvironments + +/-- Constructor alternatives prepend source fields in reverse order while +their generated fetch prologue appends target registers in field order. This +is the exact environment shape retained in `constructorChildInputMap`. -/ +theorem EnvRel.constructorFields {source : List RVal} + {target fields : Array RVal} {mapping : EnvMap} + (relation : EnvRel source target mapping) : + EnvRel (fields.toList.reverse ++ source) (target ++ fields) + (Lower.constructorChildInputMap target.size fields.size ++ mapping) := by + intro index value atom sourceGet mapped + by_cases prefixIndex : index < fields.size + · have sourcePrefix : fields.toList.reverse[index]? = some value := by + have prefixIndex' : index < fields.toList.reverse.length := by + simpa using prefixIndex + rw [List.getElem?_append_left prefixIndex'] at sourceGet + exact sourceGet + have originalBound : index < fields.toList.length := by + simpa using prefixIndex + rw [List.getElem?_reverse (l := fields.toList) originalBound] at sourcePrefix + let fieldIndex := fields.size - 1 - index + have fieldAt : fields[fieldIndex]? = some value := by + simpa [fieldIndex] using sourcePrefix + have atomEq : atom = .reg (target.size + fieldIndex) := by + have rangeAt : (List.range fields.size).reverse[index]? = + some fieldIndex := by + rw [List.getElem?_reverse (l := List.range fields.size) + (by simpa using prefixIndex)] + have fieldIndexBound : fieldIndex < fields.size := by + dsimp [fieldIndex] + omega + have rangeField : (List.range fields.size)[fieldIndex]? = + some fieldIndex := List.getElem?_range fieldIndexBound + simpa [fieldIndex] using rangeField + have mapAt : + (Lower.constructorChildInputMap target.size fields.size)[index]? = + some (some (.reg (target.size + fieldIndex))) := by + unfold Lower.constructorChildInputMap + rw [Array.getElem?_map, List.getElem?_toArray, rangeAt] + rfl + have mapPrefix : index < + (Lower.constructorChildInputMap target.size fields.size).size := by + simpa [Lower.constructorChildInputMap] using prefixIndex + rw [Array.getElem?_append, if_pos mapPrefix, mapAt] at mapped + simpa using mapped.symm + subst atom + have afterTarget : ¬target.size + fieldIndex < target.size := by omega + simp [Eval.resolveAtom, Array.getElem?_append, afterTarget, fieldAt] + · have afterPrefix : fields.size ≤ index := Nat.le_of_not_gt prefixIndex + let sourceIndex := index - fields.size + have sourceAt : source[sourceIndex]? = some value := by + rw [List.getElem?_append_right (by simpa using afterPrefix)] at sourceGet + simpa [sourceIndex] using sourceGet + unfold Lower.constructorChildInputMap at mapped + simp only [Array.getElem?_append, Array.size_map, List.size_toArray, + List.length_reverse, List.length_range, prefixIndex] at mapped + exact resolveAtom_append_old + (relation sourceIndex value atom sourceAt + (by simpa [sourceIndex] using mapped)) + +/-- Effect-only IxIR₂ instructions append no SSA value; their IxIR₁ result +binder is represented directly by the erased atom. -/ +theorem EnvRel.bindErased {source : List RVal} {target : Array RVal} + {mapping : EnvMap} (relation : EnvRel source target mapping) : + EnvRel (.erased :: source) target (#[some .erased] ++ mapping) := by + intro index candidate atom sourceGet mapped + cases index with + | zero => + simp only [List.getElem?_cons_zero, Option.some.injEq] at sourceGet + subst candidate + have atomEq : atom = .erased := by + simpa [Array.getElem?_append] using mapped.symm + subst atom + rfl + | succ index => + have oldGet : source[index]? = some candidate := by + simpa using sourceGet + have oldMapped : mapping[index]? = some (some atom) := by + simpa [Array.getElem?_append] using mapped + exact relation index candidate atom oldGet oldMapped + +/-- A target `move` takes exactly one public small step, preserving the store, +stack, and credits while advancing the program counter and appending its +resolved value. This packages the evaluator reduction needed by the source +`pure` instruction case. -/ +theorem step_move {context : Eval.Context} + {interpretation : Eval.Interpretation} {machine : Eval.Machine} + {frame : Eval.Frame} {stack : List Eval.Continuation} {block : Block} + {atom : Atom} {value : RVal} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = .move atom) + (resolved : Eval.resolveAtom frame.values atom = .ok value) : + Eval.Step context interpretation machine + { machine with + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values.push value } + stack } := by + exact Eval.Step.move control blockAt pc instruction resolved + +/-- The source `pure`/target `move` boundary preserves operand meaning and the +environment relation needed by the continuation. -/ +theorem pure_move_preserves {source : List RVal} {target : Array RVal} + {mapping : EnvMap} (relation : EnvRel source target mapping) + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {value : RVal} + (translated : translateAtom mapping sourceAtom = some targetAtom) + (resolved : IxIR1.resolveAtom source sourceAtom = .ok value) : + Eval.resolveAtom target targetAtom = .ok value ∧ + EnvRel (value :: source) (target.push value) + (#[some (.reg target.size)] ++ mapping) := by + exact ⟨resolveAtom_of_envRel relation translated resolved, + relation.bindValue value⟩ + +/-- First instruction-level simulation case: a related IxIR₁ `pure` operand +drives the generated IxIR₂ `move` step, and the successor environments are +again related. -/ +theorem simulate_pure_move {context : Eval.Context} + {interpretation : Eval.Interpretation} {machine : Eval.Machine} + {frame : Eval.Frame} {stack : List Eval.Continuation} {block : Block} + {source : List RVal} {mapping : EnvMap} + (relation : EnvRel source frame.values mapping) + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {value : RVal} + (translated : translateAtom mapping sourceAtom = some targetAtom) + (sourceResolved : IxIR1.resolveAtom source sourceAtom = .ok value) + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = .move targetAtom) : + Eval.Step context interpretation machine + { machine with + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values.push value } + stack } ∧ + EnvRel (value :: source) (frame.values.push value) + (#[some (.reg frame.values.size)] ++ mapping) := by + have targetResolved : + Eval.resolveAtom frame.values targetAtom = .ok value := + resolveAtom_of_envRel relation translated sourceResolved + exact ⟨step_move control blockAt pc instruction targetResolved, + relation.bindValue value⟩ + +/-- Trace-facing `pure`/`move` case. Recursive-trace membership supplies the +actual generated block, instruction coordinate, and translated target +operand; callers retain only runtime frame alignment and source resolution. -/ +theorem simulate_traced_pure_move {context : Eval.Context} + {interpretation : Eval.Interpretation} {machine : Eval.Machine} + {frame : Eval.Frame} {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.pure sourceAtom) index (.move targetAtom) next)) + {source : List RVal} {value : RVal} + (relation : EnvRel source frame.values input) + (sourceResolved : IxIR1.resolveAtom source sourceAtom = .ok value) + (definition : frame.definition = functionTrace.generated) + (frameBlock : frame.block = blockId) + (framePc : frame.pc = index) + (entryValues : entryValueCount = frame.values.size) + (sourceCount : source.length = input.size) + (control : machine.control = .running frame stack) : + Eval.Step context interpretation machine + { machine with + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values.push value } + stack } ∧ + EnvRel (value :: source) (frame.values.push value) nextInput := by + have translated : translateAtom input sourceAtom = some targetAtom := by + simpa [Lower.OperationSyntax] using + functionTrace.descendantOperationSyntax descendant + obtain ⟨localMatch, generatedBlock⟩ := + functionTrace.descendantLetOpMatch descendant + have blockAt : + frame.definition.blocks[frame.block]? = some next.headBlock.2 := by + simpa [definition, frameBlock] using generatedBlock + obtain ⟨indexBound, instructionAt⟩ := + Array.getElem?_eq_some_iff.mp localMatch.instructionAt + have pcBound : frame.pc < next.headBlock.2.instructions.size := by + simpa [framePc] using indexBound + have instruction : + next.headBlock.2.instructions[frame.pc] = .move targetAtom := by + simpa [framePc] using instructionAt + have simulated := simulate_pure_move + (context := context) (interpretation := interpretation) + relation translated sourceResolved control blockAt pcBound instruction + exact ⟨simulated.1, + simulated.2.forgetTracedValue + (show CodeStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.pure sourceAtom) index (.move targetAtom) next) source frame from + { definition + block := by simpa [Lower.CodeTrace.sourceBlock] using frameBlock + pc := by simpa [Lower.CodeTrace.entryPc] using framePc + valueCount := by + simpa [Lower.CodeTrace.entryValueCount] using entryValues.symm + sourceCount := by + simpa [Lower.CodeTrace.sourceInputMap] using sourceCount + environments := relation }) + descendant rfl⟩ + +/-- Recursive-state form of the trace-facing `pure`/`move` case. Besides the +one target step, it establishes the exact `CodeStateRel` expected by the +continuation trace, including compiler-certified block and PC progression. -/ +theorem simulate_traced_pure_move_state {context : Eval.Context} + {interpretation : Eval.Interpretation} {machine : Eval.Machine} + {frame : Eval.Frame} {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.pure sourceAtom) index (.move targetAtom) next)) + {source : List RVal} {value : RVal} + (state : CodeStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.pure sourceAtom) index (.move targetAtom) next) source frame) + (sourceResolved : IxIR1.resolveAtom source sourceAtom = .ok value) + (control : machine.control = .running frame stack) : + let nextFrame : Eval.Frame := + { frame with + pc := frame.pc + 1 + values := frame.values.push value } + Eval.Step context interpretation machine + { machine with control := .running nextFrame stack } ∧ + CodeStateRel functionTrace next (value :: source) nextFrame := by + dsimp only + have frameBlock : frame.block = blockId := by + simpa [Lower.CodeTrace.sourceBlock] using state.block + have framePc : frame.pc = index := by + simpa [Lower.CodeTrace.entryPc] using state.pc + have entryValues : entryValueCount = frame.values.size := by + simpa [Lower.CodeTrace.entryValueCount] using state.valueCount.symm + have simulated := simulate_traced_pure_move + (context := context) (interpretation := interpretation) + descendant state.environments sourceResolved state.definition + frameBlock framePc entryValues + (by simpa [Lower.CodeTrace.sourceInputMap] using state.sourceCount) + control + refine ⟨simulated.1, state.letOpNext descendant rfl rfl rfl ?_ rfl + simulated.2⟩ + simp [Lower.Instr.baselineValueDelta] + +/-- Successful-run form of the `pure`/`move` induction case. Source +evaluation is inverted into its exact atom-resolution and continuation run, +while the target takes one step into the recursive trace state. A later +semantic induction only has to apply its continuation hypothesis to the +returned `runCode` equation and `CodeStateRel`. -/ +theorem simulate_traced_pure_move_success_step + {sourceContext : IxIR1.Ctx} {sourceCurrent : IxIR1.FnDef} + {sourceFuel : Nat} {context : Eval.Context} + {interpretation : Eval.Interpretation} {machine : Eval.Machine} + {frame : Eval.Frame} {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.pure sourceAtom) index (.move targetAtom) next)) + {sourceStore : IxIR1.Store} {source : List RVal} + {sourceOutput : IxIR1.Store × RVal} + (state : CodeStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.pure sourceAtom) index (.move targetAtom) next) source frame) + (stores : StoreRel sourceStore machine.store) + (sourceRun : IxIR1.runCode sourceContext (sourceFuel + 2) + sourceCurrent sourceStore source + (.letOp (.pure sourceAtom) next.sourceCode) = .ok sourceOutput) + (control : machine.control = .running frame stack) : + ∃ value nextFrame, + nextFrame = + { frame with + pc := frame.pc + 1 + values := frame.values.push value } ∧ + IxIR1.resolveAtom source sourceAtom = .ok value ∧ + IxIR1.runCode sourceContext (sourceFuel + 1) sourceCurrent + sourceStore (value :: source) next.sourceCode = .ok sourceOutput ∧ + Eval.Step context interpretation machine + { machine with control := .running nextFrame stack } ∧ + StoreRel sourceStore + ({ machine with control := .running nextFrame stack } : + Eval.Machine).store ∧ + CodeStateRel functionTrace next (value :: source) nextFrame := by + dsimp only + obtain ⟨middleStore, operationValue, operationRun, continuationRun⟩ := + IxIR1.runCode_letOp_success sourceRun + obtain ⟨value, sourceResolved, operationOutput⟩ := + IxIR1.runOp_pure_success operationRun + have middleStoreEq : middleStore = sourceStore := + congrArg Prod.fst operationOutput + have operationValueEq : operationValue = value := + congrArg Prod.snd operationOutput + subst middleStore + subst operationValue + obtain ⟨targetStep, nextState⟩ := + simulate_traced_pure_move_state descendant state sourceResolved control + exact ⟨value, + { frame with + pc := frame.pc + 1 + values := frame.values.push value }, + rfl, sourceResolved, continuationRun, targetStep, stores, nextState⟩ + +/-- Retaining a scalar is operationally inert. -/ +theorem retainShared_of_scalar {store : Eval.Store} {value : RVal} + (scalar : Eval.RVal.isScalar value = true) : + Eval.retainShared store value = .ok store := by + cases value <;> simp [Eval.RVal.isScalar, Eval.retainShared] at scalar ⊢ + +/-- Releasing a scalar leaves the store unchanged and spends exactly the one +heap-traversal unit used to inspect the work-list item. -/ +theorem releaseShared_of_scalar {store : Eval.Store} {value : RVal} + (heapFuel : Nat) (scalar : Eval.RVal.isScalar value = true) : + Eval.releaseShared (heapFuel + 1) store value = .ok (store, heapFuel) := by + cases value <;> + simp [Eval.RVal.isScalar, Eval.releaseShared, + Eval.releaseSharedWork] at scalar ⊢ + +/-- Dropping a unique scalar has the same one-item heap-budget behavior as a +shared scalar release. -/ +theorem dropUnique_of_scalar {store : Eval.Store} {value : RVal} + (heapFuel : Nat) (scalar : Eval.RVal.isScalar value = true) : + Eval.dropUnique (heapFuel + 1) store value = .ok (store, heapFuel) := by + cases value <;> + simp [Eval.RVal.isScalar, Eval.dropUnique, + Eval.dropUniqueWork] at scalar ⊢ + +/-- IxIR₁ shared dropping is inert on one scalar whenever its recursive fuel +is positive. -/ +theorem sourceDropVal_of_scalar {context : IxIR1.Ctx} + {store : IxIR1.Store} {value : RVal} (fuel : Nat) + (scalar : Eval.RVal.isScalar value = true) : + IxIR1.dropVal context (fuel + 1) store value = .ok store := by + cases value <;> + simp [Eval.RVal.isScalar, IxIR1.dropVal] at scalar ⊢ + +/-- IxIR₁ unique dropping is likewise inert on one scalar. -/ +theorem sourceDropUVal_of_scalar {context : IxIR1.Ctx} + {store : IxIR1.Store} {value : RVal} (fuel : Nat) + (scalar : Eval.RVal.isScalar value = true) : + IxIR1.dropUVal context (fuel + 1) store value = .ok store := by + cases value <;> + simp [Eval.RVal.isScalar, IxIR1.dropUVal] at scalar ⊢ + +/-- A scalar list needs one more unit of IxIR₁ recursive fuel than its length, +because the source list worker also inspects the empty tail. -/ +theorem sourceDropMany_of_scalars {context : IxIR1.Ctx} + {store : IxIR1.Store} {values : List RVal} + (scalars : values.all Eval.RVal.isScalar = true) : + IxIR1.dropMany context (values.length + 1) store values = .ok store := by + induction values with + | nil => simp [IxIR1.dropMany] + | cons value values ih => + simp only [List.all_cons, Bool.and_eq_true] at scalars + have head := sourceDropVal_of_scalar (context := context) + (store := store) values.length scalars.1 + rw [show (value :: values).length + 1 = + (values.length + 1) + 1 by simp] + rw [IxIR1.dropMany.eq_def] + simp only + rw [head] + simp only [bind, Except.bind] + exact ih scalars.2 + +/-- The unique source list worker has the same scalar-list fuel equation. -/ +theorem sourceDropManyU_of_scalars {context : IxIR1.Ctx} + {store : IxIR1.Store} {values : List RVal} + (scalars : values.all Eval.RVal.isScalar = true) : + IxIR1.dropManyU context (values.length + 1) store values = .ok store := by + induction values with + | nil => simp [IxIR1.dropManyU] + | cons value values ih => + simp only [List.all_cons, Bool.and_eq_true] at scalars + have head := sourceDropUVal_of_scalar (context := context) + (store := store) values.length scalars.1 + rw [show (value :: values).length + 1 = + (values.length + 1) + 1 by simp] + rw [IxIR1.dropManyU.eq_def] + simp only + rw [head] + simp only [bind, Except.bind] + exact ih scalars.2 + +/-- IxIR₂ spends exactly one heap unit per scalar shared-release work item. -/ +theorem releaseSharedWork_of_scalars {store : Eval.Store} + {values : List RVal} (heapFuel : Nat) + (scalars : values.all Eval.RVal.isScalar = true) : + Eval.releaseSharedWork (heapFuel + values.length) store values = + .ok (store, heapFuel) := by + induction values generalizing heapFuel with + | nil => simp [Eval.releaseSharedWork] + | cons value values ih => + simp only [List.all_cons, Bool.and_eq_true] at scalars + rw [show heapFuel + (value :: values).length = + (heapFuel + values.length) + 1 by + simp only [List.length_cons] + omega] + cases value with + | loc location => simp [Eval.RVal.isScalar] at scalars + | lit literal => + simp only [Eval.releaseSharedWork] + exact ih heapFuel scalars.2 + | erased => + simp only [Eval.releaseSharedWork] + exact ih heapFuel scalars.2 + +/-- IxIR₂ unique destruction has the same exact scalar work-list budget. -/ +theorem dropUniqueWork_of_scalars {store : Eval.Store} + {values : List RVal} (heapFuel : Nat) + (scalars : values.all Eval.RVal.isScalar = true) : + Eval.dropUniqueWork (heapFuel + values.length) store values = + .ok (store, heapFuel) := by + induction values generalizing heapFuel with + | nil => simp [Eval.dropUniqueWork] + | cons value values ih => + simp only [List.all_cons, Bool.and_eq_true] at scalars + rw [show heapFuel + (value :: values).length = + (heapFuel + values.length) + 1 by + simp only [List.length_cons] + omega] + cases value with + | loc location => simp [Eval.RVal.isScalar] at scalars + | lit literal => + simp only [Eval.dropUniqueWork] + exact ih heapFuel scalars.2 + | erased => + simp only [Eval.dropUniqueWork] + exact ih heapFuel scalars.2 + +/-- Exact-budget shared-release work on a prefix composes with an +independently budgeted suffix. Recursive final-owner expansion stays in the +prefix because the target prepends the released node's children. -/ +theorem releaseSharedWork_append {firstFuel secondFuel : Nat} + {store middle output : Eval.Store} {first second : List RVal} + {remaining : Nat} + (firstRun : Eval.releaseSharedWork firstFuel store first = + .ok (middle, 0)) + (secondRun : Eval.releaseSharedWork secondFuel middle second = + .ok (output, remaining)) : + Eval.releaseSharedWork (firstFuel + secondFuel) store (first ++ second) = + .ok (output, remaining) := by + induction firstFuel generalizing store first middle with + | zero => + cases first with + | nil => + simp only [Eval.releaseSharedWork, Except.ok.injEq, Prod.mk.injEq] + at firstRun + obtain ⟨rfl, _⟩ := firstRun + simpa [Eval.releaseSharedWork] using secondRun + | cons value first => simp [Eval.releaseSharedWork] at firstRun + | succ firstFuel ih => + cases first with + | nil => simp [Eval.releaseSharedWork] at firstRun + | cons value first => + cases value with + | lit literal => + have prefix' : + Eval.releaseSharedWork firstFuel store first = + .ok (middle, 0) := by + simpa [Eval.releaseSharedWork] using firstRun + have combined := ih prefix' secondRun + simpa [Eval.releaseSharedWork, Nat.succ_add] using combined + | erased => + have prefix' : + Eval.releaseSharedWork firstFuel store first = + .ok (middle, 0) := by + simpa [Eval.releaseSharedWork] using firstRun + have combined := ih prefix' secondRun + simpa [Eval.releaseSharedWork, Nat.succ_add] using combined + | loc location => + cases boxAt : store.get? location with + | none => simp [Eval.releaseSharedWork, boxAt] at firstRun + | some box => + cases world : box.world with + | unique => + simp [Eval.releaseSharedWork, boxAt, world] at firstRun + | shared => + by_cases zero : box.rc = 0 + · simp [Eval.releaseSharedWork, boxAt, world, zero] + at firstRun + · by_cases unit : box.rc = 1 + · cases node : box.node with + | ctorN cid fields => + have prefix' : + Eval.releaseSharedWork firstFuel + (store.rcTick.kill location) + (fields.toList ++ first) = + .ok (middle, 0) := by + simpa [Eval.releaseSharedWork, boxAt, world, + zero, unit, node] using firstRun + have combined := ih prefix' secondRun + simpa [Eval.releaseSharedWork, boxAt, world, + zero, unit, node, Nat.succ_add, + List.append_assoc] using combined + | papN address arity arguments => + have prefix' : + Eval.releaseSharedWork firstFuel + (store.rcTick.kill location) + (arguments.toList ++ first) = + .ok (middle, 0) := by + simpa [Eval.releaseSharedWork, boxAt, world, + zero, unit, node] using firstRun + have combined := ih prefix' secondRun + simpa [Eval.releaseSharedWork, boxAt, world, + zero, unit, node, Nat.succ_add, + List.append_assoc] using combined + · have prefix' : + Eval.releaseSharedWork firstFuel + (store.rcTick.setBox location + { box with rc := box.rc - 1 }) first = + .ok (middle, 0) := by + simpa [Eval.releaseSharedWork, boxAt, world, + zero, unit] using firstRun + have combined := ih prefix' secondRun + simpa [Eval.releaseSharedWork, boxAt, world, + zero, unit, Nat.succ_add] using combined + +/-- A successful shared-release work list consumes a store/value-determined +amount of heap fuel. Different initial budgets therefore produce the same +store and differ only by their residual suffix. -/ +theorem releaseSharedWork_success_unique + {leftFuel rightFuel : Nat} + {store leftStore rightStore : Eval.Store} + {values : List RVal} {leftRemaining rightRemaining : Nat} + (left : Eval.releaseSharedWork leftFuel store values = + .ok (leftStore, leftRemaining)) + (right : Eval.releaseSharedWork rightFuel store values = + .ok (rightStore, rightRemaining)) : + leftStore = rightStore ∧ + leftFuel + rightRemaining = rightFuel + leftRemaining := by + induction leftFuel generalizing rightFuel store values leftStore rightStore + leftRemaining rightRemaining with + | zero => + cases values with + | nil => + simp [Eval.releaseSharedWork] at left right + obtain ⟨rfl, rfl⟩ := left + obtain ⟨rfl, rfl⟩ := right + exact ⟨rfl, by omega⟩ + | cons value values => simp [Eval.releaseSharedWork] at left + | succ leftFuel ih => + cases values with + | nil => + simp [Eval.releaseSharedWork] at left right + obtain ⟨rfl, rfl⟩ := left + obtain ⟨rfl, rfl⟩ := right + exact ⟨rfl, by omega⟩ + | cons value values => + cases rightFuel with + | zero => simp [Eval.releaseSharedWork] at right + | succ rightFuel => + cases value with + | lit literal => + obtain ⟨storeEq, fuelEq⟩ := + ih (rightFuel := rightFuel) left right + exact ⟨storeEq, by omega⟩ + | erased => + obtain ⟨storeEq, fuelEq⟩ := + ih (rightFuel := rightFuel) left right + exact ⟨storeEq, by omega⟩ + | loc location => + cases found : store.get? location with + | none => simp [Eval.releaseSharedWork, found] at left + | some box => + cases world : box.world with + | unique => + simp [Eval.releaseSharedWork, found, world] at left + | shared => + by_cases zero : box.rc = 0 + · simp [Eval.releaseSharedWork, found, world, zero] + at left + · by_cases unit : box.rc = 1 + · cases node : box.node with + | ctorN cid fields => + obtain ⟨storeEq, fuelEq⟩ := + ih (rightFuel := rightFuel) + (store := store.rcTick.kill location) + (values := fields.toList ++ values) + (by simpa [Eval.releaseSharedWork, found, + world, zero, unit, node] using left) + (by simpa [Eval.releaseSharedWork, found, + world, zero, unit, node] using right) + exact ⟨storeEq, by omega⟩ + | papN address arity arguments => + obtain ⟨storeEq, fuelEq⟩ := + ih (rightFuel := rightFuel) + (store := store.rcTick.kill location) + (values := arguments.toList ++ values) + (by simpa [Eval.releaseSharedWork, found, + world, zero, unit, node] using left) + (by simpa [Eval.releaseSharedWork, found, + world, zero, unit, node] using right) + exact ⟨storeEq, by omega⟩ + · obtain ⟨storeEq, fuelEq⟩ := + ih (rightFuel := rightFuel) + (store := store.rcTick.setBox location + { box with rc := box.rc - 1 }) + (values := values) + (by simpa [Eval.releaseSharedWork, found, + world, zero, unit] using left) + (by simpa [Eval.releaseSharedWork, found, + world, zero, unit] using right) + exact ⟨storeEq, by omega⟩ + +/-- An exact shared-release traversal can carry any independently chosen heap +fuel suffix through unchanged. This is the backward-budget framing rule used +when a destructive instruction is prefixed to an already funded continuation. -/ +theorem releaseSharedWork_add_suffix {localFuel suffix : Nat} + {store output : Eval.Store} {values : List RVal} + (run : Eval.releaseSharedWork localFuel store values = .ok (output, 0)) : + Eval.releaseSharedWork (localFuel + suffix) store values = + .ok (output, suffix) := by + have emptyRun : Eval.releaseSharedWork suffix output [] = + .ok (output, suffix) := by + simp [Eval.releaseSharedWork] + simpa using releaseSharedWork_append run emptyRun + +/-- Single-value wrapper of `releaseSharedWork_add_suffix`. -/ +theorem releaseShared_add_suffix {localFuel suffix : Nat} + {store output : Eval.Store} {value : RVal} + (run : Eval.releaseShared localFuel store value = .ok (output, 0)) : + Eval.releaseShared (localFuel + suffix) store value = + .ok (output, suffix) := by + exact releaseSharedWork_add_suffix run + +/-- Exact-budget unique work on a prefix composes with an independently +budgeted suffix. The zero remaining fuel pins the split point unambiguously. -/ +theorem dropUniqueWork_append {firstFuel secondFuel : Nat} + {store middle output : Eval.Store} {first second : List RVal} + {remaining : Nat} + (firstRun : Eval.dropUniqueWork firstFuel store first = .ok (middle, 0)) + (secondRun : Eval.dropUniqueWork secondFuel middle second = + .ok (output, remaining)) : + Eval.dropUniqueWork (firstFuel + secondFuel) store (first ++ second) = + .ok (output, remaining) := by + induction firstFuel generalizing store first middle with + | zero => + cases first with + | nil => + simp only [Eval.dropUniqueWork, Except.ok.injEq, Prod.mk.injEq] + at firstRun + obtain ⟨rfl, _⟩ := firstRun + simpa [Eval.dropUniqueWork] using secondRun + | cons value first => simp [Eval.dropUniqueWork] at firstRun + | succ firstFuel ih => + cases first with + | nil => simp [Eval.dropUniqueWork] at firstRun + | cons value first => + cases value with + | lit literal => + have prefix' : + Eval.dropUniqueWork firstFuel store first = + .ok (middle, 0) := by + simpa [Eval.dropUniqueWork] using firstRun + have combined := ih prefix' secondRun + simpa [Eval.dropUniqueWork, Nat.succ_add] using combined + | erased => + have prefix' : + Eval.dropUniqueWork firstFuel store first = + .ok (middle, 0) := by + simpa [Eval.dropUniqueWork] using firstRun + have combined := ih prefix' secondRun + simpa [Eval.dropUniqueWork, Nat.succ_add] using combined + | loc location => + cases boxAt : store.get? location with + | none => simp [Eval.dropUniqueWork, boxAt] at firstRun + | some box => + cases world : box.world with + | shared => + simp [Eval.dropUniqueWork, boxAt, world] at firstRun + | unique => + cases node : box.node with + | papN address arity arguments => + simp [Eval.dropUniqueWork, boxAt, world, node] + at firstRun + | ctorN cid fields => + have prefix' : + Eval.dropUniqueWork firstFuel + (store.kill location) + (fields.toList ++ first) = + .ok (middle, 0) := by + simpa [Eval.dropUniqueWork, boxAt, world, node] + using firstRun + have combined := ih prefix' secondRun + simpa [Eval.dropUniqueWork, boxAt, world, node, + Nat.succ_add, List.append_assoc] using combined + +/-- A successful unique-drop work list consumes a store/value-determined +amount of heap fuel. Different initial budgets therefore produce the same +store and differ only by their residual suffix. -/ +theorem dropUniqueWork_success_unique + {leftFuel rightFuel : Nat} + {store leftStore rightStore : Eval.Store} + {values : List RVal} {leftRemaining rightRemaining : Nat} + (left : Eval.dropUniqueWork leftFuel store values = + .ok (leftStore, leftRemaining)) + (right : Eval.dropUniqueWork rightFuel store values = + .ok (rightStore, rightRemaining)) : + leftStore = rightStore ∧ + leftFuel + rightRemaining = rightFuel + leftRemaining := by + induction leftFuel generalizing rightFuel store values leftStore rightStore + leftRemaining rightRemaining with + | zero => + cases values with + | nil => + simp [Eval.dropUniqueWork] at left right + obtain ⟨rfl, rfl⟩ := left + obtain ⟨rfl, rfl⟩ := right + exact ⟨rfl, by omega⟩ + | cons value values => simp [Eval.dropUniqueWork] at left + | succ leftFuel ih => + cases values with + | nil => + simp [Eval.dropUniqueWork] at left right + obtain ⟨rfl, rfl⟩ := left + obtain ⟨rfl, rfl⟩ := right + exact ⟨rfl, by omega⟩ + | cons value values => + cases rightFuel with + | zero => simp [Eval.dropUniqueWork] at right + | succ rightFuel => + cases value with + | lit literal => + obtain ⟨storeEq, fuelEq⟩ := + ih (rightFuel := rightFuel) left right + exact ⟨storeEq, by omega⟩ + | erased => + obtain ⟨storeEq, fuelEq⟩ := + ih (rightFuel := rightFuel) left right + exact ⟨storeEq, by omega⟩ + | loc location => + cases found : store.get? location with + | none => simp [Eval.dropUniqueWork, found] at left + | some box => + cases world : box.world with + | shared => + simp [Eval.dropUniqueWork, found, world] at left + | unique => + cases node : box.node with + | papN address arity arguments => + simp [Eval.dropUniqueWork, found, world, node] + at left + | ctorN cid fields => + obtain ⟨storeEq, fuelEq⟩ := + ih (rightFuel := rightFuel) + (store := store.kill location) + (values := fields.toList ++ values) + (by simpa [Eval.dropUniqueWork, found, + world, node] using left) + (by simpa [Eval.dropUniqueWork, found, + world, node] using right) + exact ⟨storeEq, by omega⟩ + +/-- An exact unique-drop traversal can carry any independently chosen heap +fuel suffix through unchanged. -/ +theorem dropUniqueWork_add_suffix {localFuel suffix : Nat} + {store output : Eval.Store} {values : List RVal} + (run : Eval.dropUniqueWork localFuel store values = .ok (output, 0)) : + Eval.dropUniqueWork (localFuel + suffix) store values = + .ok (output, suffix) := by + have emptyRun : Eval.dropUniqueWork suffix output [] = + .ok (output, suffix) := by + simp [Eval.dropUniqueWork] + simpa using dropUniqueWork_append run emptyRun + +/-- Single-value wrapper of `dropUniqueWork_add_suffix`. -/ +theorem dropUnique_add_suffix {localFuel suffix : Nat} + {store output : Eval.Store} {value : RVal} + (run : Eval.dropUnique localFuel store value = .ok (output, 0)) : + Eval.dropUnique (localFuel + suffix) store value = + .ok (output, suffix) := by + exact dropUniqueWork_add_suffix run + +/-- At a fixed IxIR₁ recursive fuel, successful shared release of one value +has an exact-store IxIR₂ work-list execution. Positivity is both the one +extra source premise and a preserved output fact. -/ +def SharedValSimAt (context : IxIR1.Ctx) (fuel : Nat) : Prop := + ∀ {sourceStore : IxIR1.Store} {targetStore : Eval.Store} + {value : RVal} {sourceOut : IxIR1.Store}, + PositiveSharedRC sourceStore → + StoreRel sourceStore targetStore → + IxIR1.dropVal context fuel sourceStore value = .ok sourceOut → + ∃ targetFuel targetOut, + Eval.releaseSharedWork targetFuel targetStore [value] = + .ok (targetOut, 0) ∧ + StoreRel sourceOut targetOut ∧ + PositiveSharedRC sourceOut + +/-- The list half of the mutually recursive shared-release correspondence. -/ +def SharedManySimAt (context : IxIR1.Ctx) (fuel : Nat) : Prop := + ∀ {sourceStore : IxIR1.Store} {targetStore : Eval.Store} + {values : List RVal} {sourceOut : IxIR1.Store}, + PositiveSharedRC sourceStore → + StoreRel sourceStore targetStore → + IxIR1.dropMany context fuel sourceStore values = .ok sourceOut → + ∃ targetFuel targetOut, + Eval.releaseSharedWork targetFuel targetStore values = + .ok (targetOut, 0) ∧ + StoreRel sourceOut targetOut ∧ + PositiveSharedRC sourceOut + +/-- Successful recursive IxIR₁ shared destruction is simulated by the flat +IxIR₂ work list. The positivity premise excludes exactly IxIR₁'s legacy +zero-refcount decrement case; target fuel remains independently existential. -/ +theorem sharedReleaseWork_simulation (context : IxIR1.Ctx) : + ∀ fuel, SharedValSimAt context fuel ∧ SharedManySimAt context fuel := by + intro fuel + induction fuel with + | zero => + constructor + · unfold SharedValSimAt + intro sourceStore targetStore value sourceOut positive stores sourceRun + simp [IxIR1.dropVal] at sourceRun + · unfold SharedManySimAt + intro sourceStore targetStore values sourceOut positive stores sourceRun + simp [IxIR1.dropMany] at sourceRun + | succ fuel ih => + have valueIH : SharedValSimAt context fuel := ih.1 + have manyIH : SharedManySimAt context fuel := ih.2 + unfold SharedValSimAt at valueIH + unfold SharedManySimAt at manyIH + constructor + · unfold SharedValSimAt + intro sourceStore targetStore value sourceOut positive stores sourceRun + cases value with + | lit literal => + simp only [IxIR1.dropVal] at sourceRun + cases sourceRun + refine ⟨1, targetStore, ?_, stores, positive⟩ + simp [Eval.releaseSharedWork] + | erased => + simp only [IxIR1.dropVal] at sourceRun + cases sourceRun + refine ⟨1, targetStore, ?_, stores, positive⟩ + simp [Eval.releaseSharedWork] + | loc location => + rw [IxIR1.dropVal.eq_def] at sourceRun + dsimp only at sourceRun + cases sourceGet : sourceStore.get? location with + | none => simp [sourceGet] at sourceRun + | some box => + cases world : box.world with + | unique => simp [sourceGet, world] at sourceRun + | shared => + have targetGet : + targetStore.get? location = some box := by + unfold Eval.Store.get? + rw [stores.heap] + exact sourceGet + have countPositive : 0 < box.rc := + positive sourceGet world + have nonzero : box.rc ≠ 0 := by omega + have tickGet : + sourceStore.rcTick.get? location = some box := by + simpa [IxIR1.Store.rcTick, IxIR1.Store.get?] + using sourceGet + by_cases unit : box.rc = 1 + · cases node : box.node with + | ctorN cid fields => + have childRun : + IxIR1.dropMany context fuel + (sourceStore.rcTick.kill location) + fields.toList = .ok sourceOut := by + simpa [sourceGet, world, unit, node] + using sourceRun + have prefixPositive : + PositiveSharedRC + (sourceStore.rcTick.kill location) := + PositiveSharedRC.kill + (PositiveSharedRC.rcTick positive) tickGet + obtain ⟨targetFuel, targetOut, targetRun, + outputStores, outputPositive⟩ := + manyIH prefixPositive + ((stores.rcTick).kill location) childRun + refine ⟨targetFuel + 1, targetOut, ?_, + outputStores, outputPositive⟩ + simpa [Eval.releaseSharedWork, targetGet, world, + nonzero, unit, node] using targetRun + | papN address arity arguments => + have childRun : + IxIR1.dropMany context fuel + (sourceStore.rcTick.kill location) + arguments.toList = .ok sourceOut := by + simpa [sourceGet, world, unit, node] + using sourceRun + have prefixPositive : + PositiveSharedRC + (sourceStore.rcTick.kill location) := + PositiveSharedRC.kill + (PositiveSharedRC.rcTick positive) tickGet + obtain ⟨targetFuel, targetOut, targetRun, + outputStores, outputPositive⟩ := + manyIH prefixPositive + ((stores.rcTick).kill location) childRun + refine ⟨targetFuel + 1, targetOut, ?_, + outputStores, outputPositive⟩ + simpa [Eval.releaseSharedWork, targetGet, world, + nonzero, unit, node] using targetRun + · have unitTest : (box.rc == 1) = false := by + simp [unit] + have directRun : + (.ok (sourceStore.rcTick.setBox location + { box with rc := box.rc - 1 }) : + Except IxIR1.Err IxIR1.Store) = + .ok sourceOut := by + simpa [sourceGet, world, unitTest] using sourceRun + injection directRun with outputEqual + subst sourceOut + have decrementedPositive : 0 < box.rc - 1 := by omega + have outputPositive : + PositiveSharedRC + (sourceStore.rcTick.setBox location + { box with rc := box.rc - 1 }) := + PositiveSharedRC.setRc + (PositiveSharedRC.rcTick positive) tickGet + decrementedPositive + refine ⟨1, + targetStore.rcTick.setBox location + { box with rc := box.rc - 1 }, ?_, + (stores.rcTick).setBox location + { box with rc := box.rc - 1 }, outputPositive⟩ + simp [Eval.releaseSharedWork, targetGet, world, + nonzero, unit] + · unfold SharedManySimAt + intro sourceStore targetStore values sourceOut positive stores sourceRun + cases values with + | nil => + simp only [IxIR1.dropMany] at sourceRun + cases sourceRun + refine ⟨0, targetStore, ?_, stores, positive⟩ + simp [Eval.releaseSharedWork] + | cons value values => + rw [IxIR1.dropMany.eq_def] at sourceRun + dsimp only at sourceRun + cases valueRun : IxIR1.dropVal context fuel sourceStore value with + | error error => + simp [valueRun, bind, Except.bind] at sourceRun + | ok middleStore => + simp only [valueRun, bind, Except.bind] at sourceRun + obtain ⟨valueFuel, targetMiddle, targetValueRun, + middleStores, middlePositive⟩ := + valueIH positive stores valueRun + obtain ⟨valuesFuel, targetOut, targetValuesRun, + outputStores, outputPositive⟩ := + manyIH middlePositive middleStores sourceRun + refine ⟨valueFuel + valuesFuel, targetOut, ?_, + outputStores, outputPositive⟩ + simpa using + (releaseSharedWork_append targetValueRun targetValuesRun) + +/-- Public value projection of the mutual recursive shared-release theorem. -/ +theorem dropVal_simulates_releaseSharedWork {context : IxIR1.Ctx} + {fuel : Nat} {sourceStore : IxIR1.Store} {targetStore : Eval.Store} + {value : RVal} {sourceOut : IxIR1.Store} + (positive : PositiveSharedRC sourceStore) + (stores : StoreRel sourceStore targetStore) + (sourceRun : IxIR1.dropVal context fuel sourceStore value = .ok sourceOut) : + ∃ targetFuel targetOut, + Eval.releaseSharedWork targetFuel targetStore [value] = + .ok (targetOut, 0) ∧ + StoreRel sourceOut targetOut ∧ + PositiveSharedRC sourceOut := + (sharedReleaseWork_simulation context fuel).1 positive stores sourceRun + +/-- Public list projection of the mutual recursive shared-release theorem. -/ +theorem dropMany_simulates_releaseSharedWork {context : IxIR1.Ctx} + {fuel : Nat} {sourceStore : IxIR1.Store} {targetStore : Eval.Store} + {values : List RVal} {sourceOut : IxIR1.Store} + (positive : PositiveSharedRC sourceStore) + (stores : StoreRel sourceStore targetStore) + (sourceRun : + IxIR1.dropMany context fuel sourceStore values = .ok sourceOut) : + ∃ targetFuel targetOut, + Eval.releaseSharedWork targetFuel targetStore values = + .ok (targetOut, 0) ∧ + StoreRel sourceOut targetOut ∧ + PositiveSharedRC sourceOut := + (sharedReleaseWork_simulation context fuel).2 positive stores sourceRun + +/-- At a fixed IxIR₁ recursive fuel, one successful unique-value drop has an +exact-store IxIR₂ work-list execution with some exact target budget. -/ +def UniqueValSimAt (context : IxIR1.Ctx) (fuel : Nat) : Prop := + ∀ {sourceStore : IxIR1.Store} {targetStore : Eval.Store} + {value : RVal} {sourceOut : IxIR1.Store}, + StoreRel sourceStore targetStore → + IxIR1.dropUVal context fuel sourceStore value = .ok sourceOut → + ∃ targetFuel targetOut, + Eval.dropUniqueWork targetFuel targetStore [value] = + .ok (targetOut, 0) ∧ + StoreRel sourceOut targetOut + +/-- The list half of the mutually recursive unique-drop correspondence. -/ +def UniqueManySimAt (context : IxIR1.Ctx) (fuel : Nat) : Prop := + ∀ {sourceStore : IxIR1.Store} {targetStore : Eval.Store} + {values : List RVal} {sourceOut : IxIR1.Store}, + StoreRel sourceStore targetStore → + IxIR1.dropManyU context fuel sourceStore values = .ok sourceOut → + ∃ targetFuel targetOut, + Eval.dropUniqueWork targetFuel targetStore values = + .ok (targetOut, 0) ∧ + StoreRel sourceOut targetOut + +/-- Successful recursive IxIR₁ unique destruction is simulated by the flat +IxIR₂ work list. Target fuel is existential because the source budgets tree +depth/list recursion while the target counts visited runtime values. -/ +theorem uniqueDropWork_simulation (context : IxIR1.Ctx) : + ∀ fuel, UniqueValSimAt context fuel ∧ UniqueManySimAt context fuel := by + intro fuel + induction fuel with + | zero => + constructor + · unfold UniqueValSimAt + intro sourceStore targetStore value sourceOut stores sourceRun + simp [IxIR1.dropUVal] at sourceRun + · unfold UniqueManySimAt + intro sourceStore targetStore values sourceOut stores sourceRun + simp [IxIR1.dropManyU] at sourceRun + | succ fuel ih => + have valueIH : UniqueValSimAt context fuel := ih.1 + have manyIH : UniqueManySimAt context fuel := ih.2 + unfold UniqueValSimAt at valueIH + unfold UniqueManySimAt at manyIH + constructor + · unfold UniqueValSimAt + intro sourceStore targetStore value sourceOut stores sourceRun + cases value with + | lit literal => + simp only [IxIR1.dropUVal] at sourceRun + cases sourceRun + refine ⟨1, targetStore, ?_, stores⟩ + simp [Eval.dropUniqueWork] + | erased => + simp only [IxIR1.dropUVal] at sourceRun + cases sourceRun + refine ⟨1, targetStore, ?_, stores⟩ + simp [Eval.dropUniqueWork] + | loc location => + rw [IxIR1.dropUVal.eq_def] at sourceRun + dsimp only at sourceRun + cases sourceGet : sourceStore.get? location with + | none => simp [sourceGet] at sourceRun + | some box => + cases world : box.world with + | shared => simp [sourceGet, world] at sourceRun + | unique => + cases node : box.node with + | papN address arity arguments => + simp [sourceGet, world, node] at sourceRun + | ctorN cid fields => + simp only [sourceGet, world, node] at sourceRun + have targetGet : + targetStore.get? location = some box := by + unfold Eval.Store.get? + rw [stores.heap] + exact sourceGet + obtain ⟨targetFuel, targetOut, targetRun, outputStores⟩ := + manyIH (stores.kill location) sourceRun + refine ⟨targetFuel + 1, targetOut, ?_, outputStores⟩ + simpa [Eval.dropUniqueWork, targetGet, world, node] + using targetRun + · unfold UniqueManySimAt + intro sourceStore targetStore values sourceOut stores sourceRun + cases values with + | nil => + simp only [IxIR1.dropManyU] at sourceRun + cases sourceRun + refine ⟨0, targetStore, ?_, stores⟩ + simp [Eval.dropUniqueWork] + | cons value values => + rw [IxIR1.dropManyU.eq_def] at sourceRun + dsimp only at sourceRun + cases valueRun : IxIR1.dropUVal context fuel sourceStore value with + | error error => + simp [valueRun, bind, Except.bind] at sourceRun + | ok middleStore => + simp only [valueRun, bind, Except.bind] at sourceRun + obtain ⟨valueFuel, targetMiddle, targetValueRun, + middleStores⟩ := valueIH stores valueRun + obtain ⟨valuesFuel, targetOut, targetValuesRun, + outputStores⟩ := manyIH middleStores sourceRun + refine ⟨valueFuel + valuesFuel, targetOut, ?_, outputStores⟩ + simpa using + (dropUniqueWork_append targetValueRun targetValuesRun) + +/-- Public value projection of the mutual recursive unique-drop theorem. -/ +theorem dropUVal_simulates_dropUniqueWork {context : IxIR1.Ctx} + {fuel : Nat} {sourceStore : IxIR1.Store} {targetStore : Eval.Store} + {value : RVal} {sourceOut : IxIR1.Store} + (stores : StoreRel sourceStore targetStore) + (sourceRun : + IxIR1.dropUVal context fuel sourceStore value = .ok sourceOut) : + ∃ targetFuel targetOut, + Eval.dropUniqueWork targetFuel targetStore [value] = + .ok (targetOut, 0) ∧ + StoreRel sourceOut targetOut := + (uniqueDropWork_simulation context fuel).1 stores sourceRun + +/-- Public list projection of the mutual recursive unique-drop theorem. -/ +theorem dropManyU_simulates_dropUniqueWork {context : IxIR1.Ctx} + {fuel : Nat} {sourceStore : IxIR1.Store} {targetStore : Eval.Store} + {values : List RVal} {sourceOut : IxIR1.Store} + (stores : StoreRel sourceStore targetStore) + (sourceRun : + IxIR1.dropManyU context fuel sourceStore values = .ok sourceOut) : + ∃ targetFuel targetOut, + Eval.dropUniqueWork targetFuel targetStore values = + .ok (targetOut, 0) ∧ + StoreRel sourceOut targetOut := + (uniqueDropWork_simulation context fuel).2 stores sourceRun + +/-- The scalar branch of IxIR₁ `dup` and IxIR₂ `retainShared` is an +identical store-preserving step. -/ +theorem simulate_dup_retain_scalar {sourceContext : IxIR1.Ctx} + {sourceCurrent : IxIR1.FnDef} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {block : Block} + {sourceStore : IxIR1.Store} {source : List RVal} + {mapping : EnvMap} + (stores : StoreRel sourceStore machine.store) + (environments : EnvRel source frame.values mapping) + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {value : RVal} + (translated : translateAtom mapping sourceAtom = some targetAtom) + (sourceResolved : IxIR1.resolveAtom source sourceAtom = .ok value) + (scalar : Eval.RVal.isScalar value = true) + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = + .retainShared targetAtom) : + IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.dup sourceAtom) = .ok (sourceStore, value) ∧ + Eval.Step context interpretation machine + { machine with + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values.push value } + stack } ∧ + StoreRel sourceStore machine.store ∧ + EnvRel (value :: source) (frame.values.push value) + (#[some (.reg frame.values.size)] ++ mapping) := by + have targetResolved : + Eval.resolveAtom frame.values targetAtom = .ok value := + resolveAtom_of_envRel environments translated sourceResolved + have targetStep := Eval.Step.retainShared (context := context) + (interpretation := interpretation) control blockAt pc instruction + targetResolved (retainShared_of_scalar scalar) + refine ⟨?_, targetStep, stores, environments.bindValue value⟩ + unfold IxIR1.runOp + simp only + rw [sourceResolved] + cases value with + | loc location => simp [Eval.RVal.isScalar] at scalar + | lit literal => rfl + | erased => rfl + +/-- The heap-bearing branch increments the same shared node and RC counter in +both exact stores before binding the retained location. -/ +theorem simulate_dup_retain_shared {sourceContext : IxIR1.Ctx} + {sourceCurrent : IxIR1.FnDef} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {block : Block} + {sourceStore : IxIR1.Store} {source : List RVal} + {mapping : EnvMap} + (stores : StoreRel sourceStore machine.store) + (environments : EnvRel source frame.values mapping) + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + {location : Nat} {box : IxIR1.NodeBox} + (translated : translateAtom mapping sourceAtom = some targetAtom) + (sourceResolved : + IxIR1.resolveAtom source sourceAtom = .ok (.loc location)) + (sourceGet : sourceStore.get? location = some box) + (shared : box.world = .shared) + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = + .retainShared targetAtom) : + let nextBox := { box with rc := box.rc + 1 } + let sourceStore' := (sourceStore.setBox location nextBox).rcTick + let targetStore' := (machine.store.setBox location nextBox).rcTick + IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.dup sourceAtom) = .ok (sourceStore', .loc location) ∧ + Eval.Step context interpretation machine + { machine with + store := targetStore' + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values.push (.loc location) } + stack } ∧ + StoreRel sourceStore' targetStore' ∧ + EnvRel (.loc location :: source) + (frame.values.push (.loc location)) + (#[some (.reg frame.values.size)] ++ mapping) := by + dsimp only + have targetResolved : + Eval.resolveAtom frame.values targetAtom = .ok (.loc location) := + resolveAtom_of_envRel environments translated sourceResolved + have targetGet : machine.store.get? location = some box := by + unfold Eval.Store.get? + rw [stores.heap] + exact sourceGet + have retained : + Eval.retainShared machine.store (.loc location) = + .ok ((machine.store.setBox location + { box with rc := box.rc + 1 }).rcTick) := by + unfold Eval.retainShared + simp only + rw [targetGet] + simp only + rw [shared] + rfl + have targetStep := Eval.Step.retainShared (context := context) + (interpretation := interpretation) control blockAt pc instruction + targetResolved retained + refine ⟨?_, targetStep, + (stores.setBox location { box with rc := box.rc + 1 }).rcTick, + environments.bindValue (.loc location)⟩ + unfold IxIR1.runOp + simp only + rw [sourceResolved] + simp only [bind, Except.bind] + rw [sourceGet] + simp only + rw [shared] + +/-- Trace-facing scalar retain transition. -/ +theorem simulate_traced_dup_retain_scalar_state {sourceContext : IxIR1.Ctx} + {sourceCurrent : IxIR1.FnDef} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.dup sourceAtom) index (.retainShared targetAtom) next)) + {sourceStore : IxIR1.Store} {source : List RVal} {value : RVal} + (state : CodeStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.dup sourceAtom) index (.retainShared targetAtom) next) source frame) + (stores : StoreRel sourceStore machine.store) + (sourceResolved : IxIR1.resolveAtom source sourceAtom = .ok value) + (scalar : Eval.RVal.isScalar value = true) + (control : machine.control = .running frame stack) : + let nextFrame : Eval.Frame := + { frame with + pc := frame.pc + 1 + values := frame.values.push value } + IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.dup sourceAtom) = .ok (sourceStore, value) ∧ + Eval.Step context interpretation machine + { machine with control := .running nextFrame stack } ∧ + StoreRel sourceStore machine.store ∧ + CodeStateRel functionTrace next (value :: source) nextFrame := by + dsimp only + have translated : translateAtom input sourceAtom = some targetAtom := by + simpa [Lower.OperationSyntax] using + functionTrace.descendantOperationSyntax descendant + obtain ⟨blockAt, pcBound, instructionAt⟩ := state.instructionAt descendant + have instruction : + next.headBlock.2.instructions[frame.pc] = .retainShared targetAtom := + (Array.getElem?_eq_some_iff.mp instructionAt).2 + obtain ⟨sourceRun, targetStep, nextStores, canonical⟩ := + simulate_dup_retain_scalar stores state.environments translated + sourceResolved scalar control blockAt pcBound instruction + have nextEnvironments := canonical.forgetTracedValue state descendant + (show Lower.Instr.baselineBinderAtom entryValueCount + (.retainShared targetAtom) = some (.reg entryValueCount) by rfl) + refine ⟨sourceRun, targetStep, nextStores, + state.letOpNext descendant rfl rfl rfl ?_ rfl nextEnvironments⟩ + simp [Lower.Instr.baselineValueDelta] + +/-- Trace-facing heap-bearing shared retain transition. -/ +theorem simulate_traced_dup_retain_shared_state {sourceContext : IxIR1.Ctx} + {sourceCurrent : IxIR1.FnDef} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.dup sourceAtom) index (.retainShared targetAtom) next)) + {sourceStore : IxIR1.Store} {source : List RVal} + {location : Nat} {box : IxIR1.NodeBox} + (state : CodeStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.dup sourceAtom) index (.retainShared targetAtom) next) source frame) + (stores : StoreRel sourceStore machine.store) + (sourceResolved : + IxIR1.resolveAtom source sourceAtom = .ok (.loc location)) + (sourceGet : sourceStore.get? location = some box) + (shared : box.world = .shared) + (control : machine.control = .running frame stack) : + let nextBox := { box with rc := box.rc + 1 } + let sourceStore' := (sourceStore.setBox location nextBox).rcTick + let targetStore' := (machine.store.setBox location nextBox).rcTick + let nextFrame : Eval.Frame := + { frame with + pc := frame.pc + 1 + values := frame.values.push (.loc location) } + IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.dup sourceAtom) = .ok (sourceStore', .loc location) ∧ + Eval.Step context interpretation machine + { machine with + store := targetStore' + control := .running nextFrame stack } ∧ + StoreRel sourceStore' targetStore' ∧ + CodeStateRel functionTrace next (.loc location :: source) nextFrame := by + dsimp only + have translated : translateAtom input sourceAtom = some targetAtom := by + simpa [Lower.OperationSyntax] using + functionTrace.descendantOperationSyntax descendant + obtain ⟨blockAt, pcBound, instructionAt⟩ := state.instructionAt descendant + have instruction : + next.headBlock.2.instructions[frame.pc] = .retainShared targetAtom := + (Array.getElem?_eq_some_iff.mp instructionAt).2 + obtain ⟨sourceRun, targetStep, nextStores, canonical⟩ := + simulate_dup_retain_shared stores state.environments translated + sourceResolved sourceGet shared control blockAt pcBound instruction + have nextEnvironments := canonical.forgetTracedValue state descendant + (show Lower.Instr.baselineBinderAtom entryValueCount + (.retainShared targetAtom) = some (.reg entryValueCount) by rfl) + refine ⟨sourceRun, targetStep, nextStores, + state.letOpNext descendant rfl rfl rfl ?_ rfl nextEnvironments⟩ + simp [Lower.Instr.baselineValueDelta] + +/-- A scalar IxIR₁ shared drop and its effect-only IxIR₂ release leave the +exact store and runtime environments unchanged. The target accounts for the +single scalar work-list visit in its independent heap budget. -/ +theorem simulate_drop_release_scalar {sourceContext : IxIR1.Ctx} + {sourceCurrent : IxIR1.FnDef} {sourceFuel targetHeapFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {block : Block} + {sourceStore : IxIR1.Store} {source : List RVal} + {mapping : EnvMap} + (stores : StoreRel sourceStore machine.store) + (environments : EnvRel source frame.values mapping) + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {value : RVal} + (translated : translateAtom mapping sourceAtom = some targetAtom) + (sourceResolved : IxIR1.resolveAtom source sourceAtom = .ok value) + (scalar : Eval.RVal.isScalar value = true) + (heapFuel : machine.heapFuel = targetHeapFuel + 1) + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = + .releaseShared targetAtom) : + IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.drop sourceAtom) = .ok (sourceStore, .erased) ∧ + Eval.Step context interpretation machine + { store := machine.store + heapFuel := targetHeapFuel + control := .running { frame with pc := frame.pc + 1 } stack } ∧ + StoreRel sourceStore machine.store ∧ + EnvRel (.erased :: source) frame.values + (#[some .erased] ++ mapping) := by + have targetResolved : + Eval.resolveAtom frame.values targetAtom = .ok value := + resolveAtom_of_envRel environments translated sourceResolved + have released : + Eval.releaseShared machine.heapFuel machine.store value = + .ok (machine.store, targetHeapFuel) := by + rw [heapFuel] + exact releaseShared_of_scalar targetHeapFuel scalar + have targetStep := Eval.Step.releaseShared (context := context) + (interpretation := interpretation) control blockAt pc instruction + targetResolved released + refine ⟨?_, targetStep, stores, environments.bindErased⟩ + unfold IxIR1.runOp + simp only + rw [sourceResolved] + cases value with + | loc location => simp [Eval.RVal.isScalar] at scalar + | lit literal => rfl + | erased => rfl + +/-- A scalar IxIR₁ unique drop and its effect-only IxIR₂ counterpart preserve +the exact store while spending one target heap-traversal unit. -/ +theorem simulate_dropU_dropUnique_scalar {sourceContext : IxIR1.Ctx} + {sourceCurrent : IxIR1.FnDef} {sourceFuel targetHeapFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {block : Block} + {sourceStore : IxIR1.Store} {source : List RVal} + {mapping : EnvMap} + (stores : StoreRel sourceStore machine.store) + (environments : EnvRel source frame.values mapping) + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {value : RVal} + (translated : translateAtom mapping sourceAtom = some targetAtom) + (sourceResolved : IxIR1.resolveAtom source sourceAtom = .ok value) + (scalar : Eval.RVal.isScalar value = true) + (heapFuel : machine.heapFuel = targetHeapFuel + 1) + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = .dropUnique targetAtom) : + IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.dropU sourceAtom) = .ok (sourceStore, .erased) ∧ + Eval.Step context interpretation machine + { store := machine.store + heapFuel := targetHeapFuel + control := .running { frame with pc := frame.pc + 1 } stack } ∧ + StoreRel sourceStore machine.store ∧ + EnvRel (.erased :: source) frame.values + (#[some .erased] ++ mapping) := by + have targetResolved : + Eval.resolveAtom frame.values targetAtom = .ok value := + resolveAtom_of_envRel environments translated sourceResolved + have dropped : + Eval.dropUnique machine.heapFuel machine.store value = + .ok (machine.store, targetHeapFuel) := by + rw [heapFuel] + exact dropUnique_of_scalar targetHeapFuel scalar + have targetStep := Eval.Step.dropUnique (context := context) + (interpretation := interpretation) control blockAt pc instruction + targetResolved dropped + refine ⟨?_, targetStep, stores, environments.bindErased⟩ + unfold IxIR1.runOp + simp only + rw [sourceResolved] + cases value with + | loc location => simp [Eval.RVal.isScalar] at scalar + | lit literal => rfl + | erased => rfl + +/-- Trace-facing scalar shared-drop transition. -/ +theorem simulate_traced_drop_release_scalar_state {sourceContext : IxIR1.Ctx} + {sourceCurrent : IxIR1.FnDef} {sourceFuel targetHeapFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.drop sourceAtom) index (.releaseShared targetAtom) next)) + {sourceStore : IxIR1.Store} {source : List RVal} {value : RVal} + (state : CodeStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.drop sourceAtom) index (.releaseShared targetAtom) next) source frame) + (stores : StoreRel sourceStore machine.store) + (sourceResolved : IxIR1.resolveAtom source sourceAtom = .ok value) + (scalar : Eval.RVal.isScalar value = true) + (heapFuel : machine.heapFuel = targetHeapFuel + 1) + (control : machine.control = .running frame stack) : + let nextFrame : Eval.Frame := { frame with pc := frame.pc + 1 } + IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.drop sourceAtom) = .ok (sourceStore, .erased) ∧ + Eval.Step context interpretation machine + { store := machine.store + heapFuel := targetHeapFuel + control := .running nextFrame stack } ∧ + StoreRel sourceStore machine.store ∧ + CodeStateRel functionTrace next (.erased :: source) nextFrame := by + dsimp only + have translated : translateAtom input sourceAtom = some targetAtom := by + simpa [Lower.OperationSyntax] using + functionTrace.descendantOperationSyntax descendant + obtain ⟨blockAt, pcBound, instructionAt⟩ := state.instructionAt descendant + have instruction : + next.headBlock.2.instructions[frame.pc] = .releaseShared targetAtom := + (Array.getElem?_eq_some_iff.mp instructionAt).2 + obtain ⟨sourceRun, targetStep, nextStores, canonical⟩ := + simulate_drop_release_scalar stores state.environments translated + sourceResolved scalar heapFuel control blockAt pcBound instruction + have nextEnvironments := canonical.forgetTracedErased descendant + (show Lower.Instr.baselineBinderAtom entryValueCount + (.releaseShared targetAtom) = some .erased by rfl) + refine ⟨sourceRun, targetStep, nextStores, + state.letOpNext descendant rfl rfl rfl ?_ rfl nextEnvironments⟩ + simp [Lower.Instr.baselineValueDelta] + +/-- Trace-facing scalar unique-drop transition. -/ +theorem simulate_traced_dropU_dropUnique_scalar_state + {sourceContext : IxIR1.Ctx} + {sourceCurrent : IxIR1.FnDef} {sourceFuel targetHeapFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.dropU sourceAtom) index (.dropUnique targetAtom) next)) + {sourceStore : IxIR1.Store} {source : List RVal} {value : RVal} + (state : CodeStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.dropU sourceAtom) index (.dropUnique targetAtom) next) source frame) + (stores : StoreRel sourceStore machine.store) + (sourceResolved : IxIR1.resolveAtom source sourceAtom = .ok value) + (scalar : Eval.RVal.isScalar value = true) + (heapFuel : machine.heapFuel = targetHeapFuel + 1) + (control : machine.control = .running frame stack) : + let nextFrame : Eval.Frame := { frame with pc := frame.pc + 1 } + IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.dropU sourceAtom) = .ok (sourceStore, .erased) ∧ + Eval.Step context interpretation machine + { store := machine.store + heapFuel := targetHeapFuel + control := .running nextFrame stack } ∧ + StoreRel sourceStore machine.store ∧ + CodeStateRel functionTrace next (.erased :: source) nextFrame := by + dsimp only + have translated : translateAtom input sourceAtom = some targetAtom := by + simpa [Lower.OperationSyntax] using + functionTrace.descendantOperationSyntax descendant + obtain ⟨blockAt, pcBound, instructionAt⟩ := state.instructionAt descendant + have instruction : + next.headBlock.2.instructions[frame.pc] = .dropUnique targetAtom := + (Array.getElem?_eq_some_iff.mp instructionAt).2 + obtain ⟨sourceRun, targetStep, nextStores, canonical⟩ := + simulate_dropU_dropUnique_scalar stores state.environments translated + sourceResolved scalar heapFuel control blockAt pcBound instruction + have nextEnvironments := canonical.forgetTracedErased descendant + (show Lower.Instr.baselineBinderAtom entryValueCount + (.dropUnique targetAtom) = some .erased by rfl) + refine ⟨sourceRun, targetStep, nextStores, + state.letOpNext descendant rfl rfl rfl ?_ rfl nextEnvironments⟩ + simp [Lower.Instr.baselineValueDelta] + +/-- Every successful recursive IxIR₁ unique-location drop has a sufficient +IxIR₂ heap budget that drives one effect-only `dropUnique` step to the same +exact heap. The theorem exposes the locally chosen budget explicitly; later +block composition can add slack and combine these finite witnesses. -/ +theorem simulate_dropU_dropUnique_recursive + {sourceContext : IxIR1.Ctx} {sourceCurrent : IxIR1.FnDef} + {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {block : Block} + {sourceStore sourceStore' : IxIR1.Store} {source : List RVal} + {mapping : EnvMap} + (stores : StoreRel sourceStore machine.store) + (environments : EnvRel source frame.values mapping) + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {location : Nat} + (translated : translateAtom mapping sourceAtom = some targetAtom) + (sourceResolved : + IxIR1.resolveAtom source sourceAtom = .ok (.loc location)) + (sourceDropped : + IxIR1.dropUVal sourceContext sourceFuel sourceStore (.loc location) = + .ok sourceStore') + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = + .dropUnique targetAtom) : + ∃ targetHeapFuel targetStore, + IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.dropU sourceAtom) = .ok (sourceStore', .erased) ∧ + Eval.Step context interpretation + { machine with heapFuel := targetHeapFuel } + { store := targetStore + heapFuel := 0 + control := .running { frame with pc := frame.pc + 1 } stack } ∧ + StoreRel sourceStore' targetStore ∧ + EnvRel (.erased :: source) frame.values + (#[some .erased] ++ mapping) := by + have targetResolved : + Eval.resolveAtom frame.values targetAtom = .ok (.loc location) := + resolveAtom_of_envRel environments translated sourceResolved + obtain ⟨targetHeapFuel, targetStore, targetRun, outputStores⟩ := + dropUVal_simulates_dropUniqueWork stores sourceDropped + have targetDropped : + Eval.dropUnique targetHeapFuel machine.store (.loc location) = + .ok (targetStore, 0) := by + simpa [Eval.dropUnique] using targetRun + have beforeControl : + ({ machine with heapFuel := targetHeapFuel } : Eval.Machine).control = + .running frame stack := by + simpa using control + have targetStep := Eval.Step.dropUnique (context := context) + (interpretation := interpretation) beforeControl blockAt pc instruction + targetResolved targetDropped + refine ⟨targetHeapFuel, targetStore, ?_, targetStep, outputStores, + environments.bindErased⟩ + unfold IxIR1.runOp + simp only + rw [sourceResolved] + simp only [bind, Except.bind] + rw [sourceDropped] + +/-- Every successful recursive IxIR₁ shared-location drop from a positive-RC +heap has a sufficient IxIR₂ budget for one effect-only `releaseShared` step +to the same exact heap. Positivity is returned for subsequent instructions. -/ +theorem simulate_drop_release_recursive + {sourceContext : IxIR1.Ctx} {sourceCurrent : IxIR1.FnDef} + {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {block : Block} + {sourceStore sourceStore' : IxIR1.Store} {source : List RVal} + {mapping : EnvMap} + (positive : PositiveSharedRC sourceStore) + (stores : StoreRel sourceStore machine.store) + (environments : EnvRel source frame.values mapping) + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {location : Nat} + (translated : translateAtom mapping sourceAtom = some targetAtom) + (sourceResolved : + IxIR1.resolveAtom source sourceAtom = .ok (.loc location)) + (sourceDropped : + IxIR1.dropVal sourceContext sourceFuel sourceStore (.loc location) = + .ok sourceStore') + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = + .releaseShared targetAtom) : + ∃ targetHeapFuel targetStore, + IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.drop sourceAtom) = .ok (sourceStore', .erased) ∧ + Eval.Step context interpretation + { machine with heapFuel := targetHeapFuel } + { store := targetStore + heapFuel := 0 + control := .running { frame with pc := frame.pc + 1 } stack } ∧ + StoreRel sourceStore' targetStore ∧ + PositiveSharedRC sourceStore' ∧ + EnvRel (.erased :: source) frame.values + (#[some .erased] ++ mapping) := by + have targetResolved : + Eval.resolveAtom frame.values targetAtom = .ok (.loc location) := + resolveAtom_of_envRel environments translated sourceResolved + obtain ⟨targetHeapFuel, targetStore, targetRun, outputStores, + outputPositive⟩ := + dropVal_simulates_releaseSharedWork positive stores sourceDropped + have targetReleased : + Eval.releaseShared targetHeapFuel machine.store (.loc location) = + .ok (targetStore, 0) := by + simpa [Eval.releaseShared] using targetRun + have beforeControl : + ({ machine with heapFuel := targetHeapFuel } : Eval.Machine).control = + .running frame stack := by + simpa using control + have targetStep := Eval.Step.releaseShared (context := context) + (interpretation := interpretation) beforeControl blockAt pc instruction + targetResolved targetReleased + refine ⟨targetHeapFuel, targetStore, ?_, targetStep, outputStores, + outputPositive, environments.bindErased⟩ + unfold IxIR1.runOp + simp only + rw [sourceResolved] + simp only [bind, Except.bind] + rw [sourceDropped] + +/-- Trace-facing recursive unique drop. A successful source recursive drop +selects a sufficient target heap budget, while the trace supplies all target +syntax and the exact continuation state. -/ +theorem simulate_traced_dropU_dropUnique_recursive_state + {sourceContext : IxIR1.Ctx} {sourceCurrent : IxIR1.FnDef} + {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.dropU sourceAtom) index (.dropUnique targetAtom) next)) + {sourceStore sourceStore' : IxIR1.Store} {source : List RVal} + {location : Nat} + (state : CodeStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.dropU sourceAtom) index (.dropUnique targetAtom) next) source frame) + (stores : StoreRel sourceStore machine.store) + (sourceResolved : + IxIR1.resolveAtom source sourceAtom = .ok (.loc location)) + (sourceDropped : + IxIR1.dropUVal sourceContext sourceFuel sourceStore (.loc location) = + .ok sourceStore') + (control : machine.control = .running frame stack) : + ∃ targetHeapFuel targetStore, + let nextFrame : Eval.Frame := { frame with pc := frame.pc + 1 } + IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.dropU sourceAtom) = .ok (sourceStore', .erased) ∧ + Eval.Step context interpretation + { machine with heapFuel := targetHeapFuel } + { store := targetStore + heapFuel := 0 + control := .running nextFrame stack } ∧ + StoreRel sourceStore' targetStore ∧ + CodeStateRel functionTrace next (.erased :: source) nextFrame := by + have translated : translateAtom input sourceAtom = some targetAtom := by + simpa [Lower.OperationSyntax] using + functionTrace.descendantOperationSyntax descendant + obtain ⟨blockAt, pcBound, instructionAt⟩ := state.instructionAt descendant + have instruction : + next.headBlock.2.instructions[frame.pc] = .dropUnique targetAtom := + (Array.getElem?_eq_some_iff.mp instructionAt).2 + obtain ⟨targetHeapFuel, targetStore, sourceRun, targetStep, + nextStores, canonical⟩ := + simulate_dropU_dropUnique_recursive stores state.environments translated + sourceResolved sourceDropped control blockAt pcBound instruction + refine ⟨targetHeapFuel, targetStore, ?_⟩ + dsimp only + have nextEnvironments := canonical.forgetTracedErased descendant + (show Lower.Instr.baselineBinderAtom entryValueCount + (.dropUnique targetAtom) = some .erased by rfl) + refine ⟨sourceRun, targetStep, nextStores, + state.letOpNext descendant rfl rfl rfl ?_ rfl nextEnvironments⟩ + simp [Lower.Instr.baselineValueDelta] + +/-- Trace-facing recursive shared drop, including preservation of the source +positive-reference-count invariant needed by subsequent recursive releases. -/ +theorem simulate_traced_drop_release_recursive_state + {sourceContext : IxIR1.Ctx} {sourceCurrent : IxIR1.FnDef} + {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.drop sourceAtom) index (.releaseShared targetAtom) next)) + {sourceStore sourceStore' : IxIR1.Store} {source : List RVal} + {location : Nat} + (state : CodeStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.drop sourceAtom) index (.releaseShared targetAtom) next) source frame) + (positive : PositiveSharedRC sourceStore) + (stores : StoreRel sourceStore machine.store) + (sourceResolved : + IxIR1.resolveAtom source sourceAtom = .ok (.loc location)) + (sourceDropped : + IxIR1.dropVal sourceContext sourceFuel sourceStore (.loc location) = + .ok sourceStore') + (control : machine.control = .running frame stack) : + ∃ targetHeapFuel targetStore, + let nextFrame : Eval.Frame := { frame with pc := frame.pc + 1 } + IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.drop sourceAtom) = .ok (sourceStore', .erased) ∧ + Eval.Step context interpretation + { machine with heapFuel := targetHeapFuel } + { store := targetStore + heapFuel := 0 + control := .running nextFrame stack } ∧ + StoreRel sourceStore' targetStore ∧ + PositiveSharedRC sourceStore' ∧ + CodeStateRel functionTrace next (.erased :: source) nextFrame := by + have translated : translateAtom input sourceAtom = some targetAtom := by + simpa [Lower.OperationSyntax] using + functionTrace.descendantOperationSyntax descendant + obtain ⟨blockAt, pcBound, instructionAt⟩ := state.instructionAt descendant + have instruction : + next.headBlock.2.instructions[frame.pc] = .releaseShared targetAtom := + (Array.getElem?_eq_some_iff.mp instructionAt).2 + obtain ⟨targetHeapFuel, targetStore, sourceRun, targetStep, + nextStores, nextPositive, canonical⟩ := + simulate_drop_release_recursive positive stores state.environments + translated sourceResolved sourceDropped control blockAt pcBound instruction + refine ⟨targetHeapFuel, targetStore, ?_⟩ + dsimp only + have nextEnvironments := canonical.forgetTracedErased descendant + (show Lower.Instr.baselineBinderAtom entryValueCount + (.releaseShared targetAtom) = some .erased by rfl) + refine ⟨sourceRun, targetStep, nextStores, nextPositive, + state.letOpNext descendant rfl rfl rfl ?_ rfl nextEnvironments⟩ + simp [Lower.Instr.baselineValueDelta] + +/-- Releasing a shared node with more than one owner decrements the same +refcount and charges the same RC operation in both exact stores. This is the +non-recursive heap-bearing branch of deep shared release. -/ +theorem simulate_drop_release_shared_nonunit {sourceContext : IxIR1.Ctx} + {sourceCurrent : IxIR1.FnDef} + {sourceDropFuel targetHeapFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {block : Block} + {sourceStore : IxIR1.Store} {source : List RVal} + {mapping : EnvMap} + (stores : StoreRel sourceStore machine.store) + (environments : EnvRel source frame.values mapping) + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + {location : Nat} {box : IxIR1.NodeBox} + (translated : translateAtom mapping sourceAtom = some targetAtom) + (sourceResolved : + IxIR1.resolveAtom source sourceAtom = .ok (.loc location)) + (sourceGet : sourceStore.get? location = some box) + (shared : box.world = .shared) + (nonzero : box.rc ≠ 0) + (nonunit : box.rc ≠ 1) + (heapFuel : machine.heapFuel = targetHeapFuel + 1) + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = + .releaseShared targetAtom) : + let nextBox := { box with rc := box.rc - 1 } + let sourceStore' := sourceStore.rcTick.setBox location nextBox + let targetStore' := machine.store.rcTick.setBox location nextBox + IxIR1.runOp sourceContext ((sourceDropFuel + 1) + 1) sourceCurrent + sourceStore source (.drop sourceAtom) = + .ok (sourceStore', .erased) ∧ + Eval.Step context interpretation machine + { store := targetStore' + heapFuel := targetHeapFuel + control := .running { frame with pc := frame.pc + 1 } stack } ∧ + StoreRel sourceStore' targetStore' ∧ + EnvRel (.erased :: source) frame.values + (#[some .erased] ++ mapping) := by + dsimp only + have targetResolved : + Eval.resolveAtom frame.values targetAtom = .ok (.loc location) := + resolveAtom_of_envRel environments translated sourceResolved + have targetGet : machine.store.get? location = some box := by + unfold Eval.Store.get? + rw [stores.heap] + exact sourceGet + have released : + Eval.releaseShared machine.heapFuel machine.store (.loc location) = + .ok (machine.store.rcTick.setBox location + { box with rc := box.rc - 1 }, targetHeapFuel) := by + rw [heapFuel] + simp [Eval.releaseShared, Eval.releaseSharedWork, targetGet, shared, + nonzero, nonunit] + have targetStep := Eval.Step.releaseShared (context := context) + (interpretation := interpretation) control blockAt pc instruction + targetResolved released + refine ⟨?_, targetStep, (stores.rcTick).setBox location + { box with rc := box.rc - 1 }, environments.bindErased⟩ + unfold IxIR1.runOp + simp only + rw [sourceResolved] + simp only [bind, Except.bind] + rw [IxIR1.dropVal.eq_def] + simp only + rw [sourceGet] + simp [shared, nonunit] + +/-- Deep-dropping a unique constructor whose children are all scalar kills the +same node in both stores. IxIR₂ spends one heap unit on the constructor plus +one per field; IxIR₁ additionally needs fuel to inspect the empty list tail. -/ +theorem simulate_dropU_dropUnique_scalar_ctor + {sourceContext : IxIR1.Ctx} {sourceCurrent : IxIR1.FnDef} + {targetHeapFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {block : Block} + {sourceStore : IxIR1.Store} {source : List RVal} + {mapping : EnvMap} + (stores : StoreRel sourceStore machine.store) + (environments : EnvRel source frame.values mapping) + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + {cid : IxIR1.CtorId} {location : Nat} + {box : IxIR1.NodeBox} {fields : Array RVal} + (translated : translateAtom mapping sourceAtom = some targetAtom) + (sourceResolved : + IxIR1.resolveAtom source sourceAtom = .ok (.loc location)) + (sourceGet : sourceStore.get? location = some box) + (unique : box.world = .unique) + (node : box.node = .ctorN cid fields) + (scalarFields : fields.toList.all Eval.RVal.isScalar = true) + (heapFuel : machine.heapFuel = + (targetHeapFuel + fields.toList.length) + 1) + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = + .dropUnique targetAtom) : + IxIR1.runOp sourceContext ((fields.toList.length + 2) + 1) + sourceCurrent sourceStore source (.dropU sourceAtom) = + .ok (sourceStore.kill location, .erased) ∧ + Eval.Step context interpretation machine + { store := machine.store.kill location + heapFuel := targetHeapFuel + control := .running { frame with pc := frame.pc + 1 } stack } ∧ + StoreRel (sourceStore.kill location) + (machine.store.kill location) ∧ + EnvRel (.erased :: source) frame.values + (#[some .erased] ++ mapping) := by + have targetResolved : + Eval.resolveAtom frame.values targetAtom = .ok (.loc location) := + resolveAtom_of_envRel environments translated sourceResolved + have targetGet : machine.store.get? location = some box := by + unfold Eval.Store.get? + rw [stores.heap] + exact sourceGet + have sourceDropped : + IxIR1.dropUVal sourceContext (fields.toList.length + 2) sourceStore + (.loc location) = .ok (sourceStore.kill location) := by + rw [IxIR1.dropUVal.eq_def] + simp only + rw [sourceGet] + simp only + rw [unique, node] + exact sourceDropManyU_of_scalars scalarFields + have targetDropped : + Eval.dropUnique machine.heapFuel machine.store (.loc location) = + .ok (machine.store.kill location, targetHeapFuel) := by + rw [heapFuel] + unfold Eval.dropUnique + simp only [Eval.dropUniqueWork] + rw [targetGet] + simp only + rw [unique, node] + simpa using (dropUniqueWork_of_scalars + (store := machine.store.kill location) targetHeapFuel scalarFields) + have targetStep := Eval.Step.dropUnique (context := context) + (interpretation := interpretation) control blockAt pc instruction + targetResolved targetDropped + refine ⟨?_, targetStep, stores.kill location, + environments.bindErased⟩ + unfold IxIR1.runOp + simp only + rw [sourceResolved] + simp only [bind, Except.bind] + rw [sourceDropped] + +/-- Releasing the final owner of an all-scalar shared constructor charges one +RC operation, kills that constructor, and traverses only inert scalar fields +in both machines. -/ +theorem simulate_drop_release_shared_unit_scalar_ctor + {sourceContext : IxIR1.Ctx} {sourceCurrent : IxIR1.FnDef} + {targetHeapFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {block : Block} + {sourceStore : IxIR1.Store} {source : List RVal} + {mapping : EnvMap} + (stores : StoreRel sourceStore machine.store) + (environments : EnvRel source frame.values mapping) + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + {cid : IxIR1.CtorId} {location : Nat} + {box : IxIR1.NodeBox} {fields : Array RVal} + (translated : translateAtom mapping sourceAtom = some targetAtom) + (sourceResolved : + IxIR1.resolveAtom source sourceAtom = .ok (.loc location)) + (sourceGet : sourceStore.get? location = some box) + (shared : box.world = .shared) + (unit : box.rc = 1) + (node : box.node = .ctorN cid fields) + (scalarFields : fields.toList.all Eval.RVal.isScalar = true) + (heapFuel : machine.heapFuel = + (targetHeapFuel + fields.toList.length) + 1) + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = + .releaseShared targetAtom) : + IxIR1.runOp sourceContext ((fields.toList.length + 2) + 1) + sourceCurrent sourceStore source (.drop sourceAtom) = + .ok (sourceStore.rcTick.kill location, .erased) ∧ + Eval.Step context interpretation machine + { store := machine.store.rcTick.kill location + heapFuel := targetHeapFuel + control := .running { frame with pc := frame.pc + 1 } stack } ∧ + StoreRel (sourceStore.rcTick.kill location) + (machine.store.rcTick.kill location) ∧ + EnvRel (.erased :: source) frame.values + (#[some .erased] ++ mapping) := by + have targetResolved : + Eval.resolveAtom frame.values targetAtom = .ok (.loc location) := + resolveAtom_of_envRel environments translated sourceResolved + have targetGet : machine.store.get? location = some box := by + unfold Eval.Store.get? + rw [stores.heap] + exact sourceGet + have sourceDropped : + IxIR1.dropVal sourceContext (fields.toList.length + 2) sourceStore + (.loc location) = + .ok (sourceStore.rcTick.kill location) := by + rw [IxIR1.dropVal.eq_def] + simp only + rw [sourceGet] + simp only + rw [shared, unit, node] + exact sourceDropMany_of_scalars scalarFields + have targetReleased : + Eval.releaseShared machine.heapFuel machine.store (.loc location) = + .ok (machine.store.rcTick.kill location, targetHeapFuel) := by + rw [heapFuel] + unfold Eval.releaseShared + simp only [Eval.releaseSharedWork] + rw [targetGet] + simp only + rw [shared, unit, node] + simpa using (releaseSharedWork_of_scalars + (store := machine.store.rcTick.kill location) targetHeapFuel scalarFields) + have targetStep := Eval.Step.releaseShared (context := context) + (interpretation := interpretation) control blockAt pc instruction + targetResolved targetReleased + refine ⟨?_, targetStep, (stores.rcTick).kill location, + environments.bindErased⟩ + unfold IxIR1.runOp + simp only + rw [sourceResolved] + simp only [bind, Except.bind] + rw [sourceDropped] + +/-- A checked scalar-leaf IxIR₁ free and IxIR₂ `freeUnique` kill the same +unique constructor location and bind the source's erased effect result. -/ +theorem simulate_free_freeUnique {sourceContext : IxIR1.Ctx} + {sourceCurrent : IxIR1.FnDef} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {block : Block} + {sourceStore : IxIR1.Store} {source : List RVal} + {mapping : EnvMap} + (stores : StoreRel sourceStore machine.store) + (environments : EnvRel source frame.values mapping) + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + {cid : IxIR1.CtorId} {location : Nat} + {box : IxIR1.NodeBox} {fields : Array RVal} + (translated : translateAtom mapping sourceAtom = some targetAtom) + (sourceResolved : + IxIR1.resolveAtom source sourceAtom = .ok (.loc location)) + (sourceGet : sourceStore.get? location = some box) + (unique : box.world = .unique) + (node : box.node = .ctorN cid fields) + (scalarFields : fields.all Eval.RVal.isScalar = true) + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = + .freeUnique targetAtom cid) : + IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.free sourceAtom) = + .ok (sourceStore.kill location, .erased) ∧ + Eval.Step context interpretation machine + { machine with + store := machine.store.kill location + control := .running { frame with pc := frame.pc + 1 } stack } ∧ + StoreRel (sourceStore.kill location) + (machine.store.kill location) ∧ + EnvRel (.erased :: source) frame.values + (#[some .erased] ++ mapping) := by + have targetResolved : + Eval.resolveAtom frame.values targetAtom = .ok (.loc location) := + resolveAtom_of_envRel environments translated sourceResolved + have targetGet : machine.store.get? location = some box := by + unfold Eval.Store.get? + rw [stores.heap] + exact sourceGet + have targetStep := Eval.Step.freeUnique (context := context) + (interpretation := interpretation) control blockAt pc instruction + targetResolved targetGet unique node scalarFields + refine ⟨?_, targetStep, stores.kill location, environments.bindErased⟩ + unfold IxIR1.runOp + simp only + rw [sourceResolved] + simp only [bind, Except.bind] + rw [sourceGet] + simp only + rw [unique] + +/-- Trace-facing checked shallow free. The trace discharges operand and +instruction-coordinate facts while the exact constructor/scalar-leaf runtime +facts remain the owner-keyed provenance boundary. -/ +theorem simulate_traced_free_freeUnique_state {sourceContext : IxIR1.Ctx} + {sourceCurrent : IxIR1.FnDef} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + {targetCid : IxIR1.CtorId} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.free sourceAtom) index (.freeUnique targetAtom targetCid) next)) + {sourceStore : IxIR1.Store} {source : List RVal} + {location : Nat} {box : IxIR1.NodeBox} {fields : Array RVal} + (state : CodeStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.free sourceAtom) index (.freeUnique targetAtom targetCid) next) + source frame) + (stores : StoreRel sourceStore machine.store) + (sourceResolved : + IxIR1.resolveAtom source sourceAtom = .ok (.loc location)) + (sourceGet : sourceStore.get? location = some box) + (unique : box.world = .unique) + (node : box.node = .ctorN targetCid fields) + (scalarFields : fields.all Eval.RVal.isScalar = true) + (control : machine.control = .running frame stack) : + let nextFrame : Eval.Frame := { frame with pc := frame.pc + 1 } + IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.free sourceAtom) = + .ok (sourceStore.kill location, .erased) ∧ + Eval.Step context interpretation machine + { machine with + store := machine.store.kill location + control := .running nextFrame stack } ∧ + StoreRel (sourceStore.kill location) (machine.store.kill location) ∧ + CodeStateRel functionTrace next (.erased :: source) nextFrame := by + dsimp only + have translated : translateAtom input sourceAtom = some targetAtom := by + simpa [Lower.OperationSyntax] using + functionTrace.descendantOperationSyntax descendant + obtain ⟨blockAt, pcBound, instructionAt⟩ := state.instructionAt descendant + have instruction : + next.headBlock.2.instructions[frame.pc] = + .freeUnique targetAtom targetCid := + (Array.getElem?_eq_some_iff.mp instructionAt).2 + obtain ⟨sourceRun, targetStep, nextStores, canonical⟩ := + simulate_free_freeUnique stores state.environments translated + sourceResolved sourceGet unique node scalarFields control blockAt pcBound + instruction + have nextEnvironments := canonical.forgetTracedErased descendant + (show Lower.Instr.baselineBinderAtom entryValueCount + (.freeUnique targetAtom targetCid) = some .erased by rfl) + refine ⟨sourceRun, targetStep, nextStores, + state.letOpNext descendant rfl rfl rfl ?_ rfl nextEnvironments⟩ + simp [Lower.Instr.baselineValueDelta] + +/-- A checked IxIR₂ fetch refines the corresponding non-consuming IxIR₁ +projection when the owner's exact constructor sidecar identifies the runtime +node. Both machines keep the store unchanged and bind the same field value. -/ +theorem simulate_fetch {sourceContext : IxIR1.Ctx} + {sourceCurrent : IxIR1.FnDef} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {block : Block} + {sourceStore : IxIR1.Store} {source : List RVal} + {mapping : EnvMap} + (stores : StoreRel sourceStore machine.store) + (environments : EnvRel source frame.values mapping) + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + {cid : IxIR1.CtorId} {field location : Nat} + {box : IxIR1.NodeBox} {fields : Array RVal} {value : RVal} + (translated : translateAtom mapping sourceAtom = some targetAtom) + (sourceResolved : + IxIR1.resolveAtom source sourceAtom = .ok (.loc location)) + (sourceGet : sourceStore.get? location = some box) + (node : box.node = .ctorN cid fields) + (fieldAt : fields[field]? = some value) + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = + .fetch targetAtom cid field) : + IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.fetch sourceAtom field) = .ok (sourceStore, value) ∧ + Eval.Step context interpretation machine + { machine with + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values.push value } + stack } ∧ + StoreRel sourceStore machine.store ∧ + EnvRel (value :: source) (frame.values.push value) + (#[some (.reg frame.values.size)] ++ mapping) := by + have targetResolved : + Eval.resolveAtom frame.values targetAtom = .ok (.loc location) := + resolveAtom_of_envRel environments translated sourceResolved + have targetGet : machine.store.get? location = some box := by + unfold Eval.Store.get? + rw [stores.heap] + exact sourceGet + have targetStep := Eval.Step.fetch (context := context) + (interpretation := interpretation) control blockAt pc instruction + targetResolved targetGet node fieldAt + refine ⟨?_, targetStep, stores, environments.bindValue value⟩ + unfold IxIR1.runOp + simp only + rw [sourceResolved] + simp only [bind, Except.bind] + rw [sourceGet] + simp only + rw [node] + simp only + rw [fieldAt] + +/-- Trace-facing non-consuming projection. The checked trace supplies operand, +field, target coordinate, continuation map, and recursive-state progression; +the runtime constructor identity remains the provenance obligation. -/ +theorem simulate_traced_fetch_state {sourceContext : IxIR1.Ctx} + {sourceCurrent : IxIR1.FnDef} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + {sourceField targetField : Nat} {targetCid : IxIR1.CtorId} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.fetch sourceAtom sourceField) index + (.fetch targetAtom targetCid targetField) next)) + {sourceStore : IxIR1.Store} {source : List RVal} + {location : Nat} {box : IxIR1.NodeBox} + {fields : Array RVal} {value : RVal} + (state : CodeStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.fetch sourceAtom sourceField) index + (.fetch targetAtom targetCid targetField) next) source frame) + (stores : StoreRel sourceStore machine.store) + (sourceResolved : + IxIR1.resolveAtom source sourceAtom = .ok (.loc location)) + (sourceGet : sourceStore.get? location = some box) + (node : box.node = .ctorN targetCid fields) + (fieldAt : fields[sourceField]? = some value) + (control : machine.control = .running frame stack) : + let nextFrame : Eval.Frame := + { frame with + pc := frame.pc + 1 + values := frame.values.push value } + IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.fetch sourceAtom sourceField) = .ok (sourceStore, value) ∧ + Eval.Step context interpretation machine + { machine with control := .running nextFrame stack } ∧ + StoreRel sourceStore machine.store ∧ + CodeStateRel functionTrace next (value :: source) nextFrame := by + dsimp only + have operationSyntax := functionTrace.descendantOperationSyntax descendant + change sourceField = targetField ∧ + Lower.InputMap.translateAtom input sourceAtom = some targetAtom at operationSyntax + obtain ⟨fieldEq, translated⟩ := operationSyntax + subst targetField + obtain ⟨blockAt, pcBound, instructionAt⟩ := state.instructionAt descendant + have instruction : + next.headBlock.2.instructions[frame.pc] = + .fetch targetAtom targetCid sourceField := + (Array.getElem?_eq_some_iff.mp instructionAt).2 + obtain ⟨sourceRun, targetStep, nextStores, canonical⟩ := simulate_fetch + stores state.environments translated sourceResolved sourceGet node fieldAt + control blockAt pcBound instruction + have nextEnvironments := canonical.forgetTracedValue state descendant + (show Lower.Instr.baselineBinderAtom entryValueCount + (.fetch targetAtom targetCid sourceField) = + some (.reg entryValueCount) by rfl) + refine ⟨sourceRun, targetStep, nextStores, + state.letOpNext descendant rfl rfl rfl ?_ rfl nextEnvironments⟩ + simp [Lower.Instr.baselineValueDelta] + +/-- Pointwise translation of an operand vector. Keeping this relation +separate from the executable translators makes it compose directly with +generated instruction equations. -/ +inductive AtomsListRel (mapping : EnvMap) : + List IxIR1.Atom → List Atom → Prop where + | nil : AtomsListRel mapping [] [] + | cons : translateAtom mapping sourceAtom = some targetAtom → + AtomsListRel mapping sourceAtoms targetAtoms → + AtomsListRel mapping (sourceAtom :: sourceAtoms) + (targetAtom :: targetAtoms) + +def AtomsRel (mapping : EnvMap) (source : Array IxIR1.Atom) + (target : Array Atom) : Prop := + AtomsListRel mapping source.toList target.toList + +private theorem atomsListRel_of_mapM (mapping : EnvMap) : + ∀ (source : List IxIR1.Atom) (target : List Atom), + source.mapM (translateAtom mapping) = some target → + AtomsListRel mapping source target + | [], target, translated => by + simp at translated + subst target + exact .nil + | sourceAtom :: sourceAtoms, target, translated => by + cases atomEq : translateAtom mapping sourceAtom with + | none => simp [List.mapM_cons, atomEq] at translated + | some targetAtom => + cases restEq : sourceAtoms.mapM (translateAtom mapping) with + | none => simp [List.mapM_cons, atomEq, restEq] at translated + | some targetAtoms => + have targetEq : target = targetAtom :: targetAtoms := by + simpa [List.mapM_cons, atomEq, restEq] using translated.symm + subst target + exact .cons atomEq + (atomsListRel_of_mapM mapping sourceAtoms targetAtoms restEq) + +/-- Reflect the producer's executable vector translation into the +pointwise relation consumed by the semantic operand-resolution lemmas. -/ +theorem atomsRel_of_translateAtoms {mapping : EnvMap} + {source : Array IxIR1.Atom} {target : Array Atom} + (translated : Lower.InputMap.translateAtoms mapping source = some target) : + AtomsRel mapping source target := by + unfold Lower.InputMap.translateAtoms at translated + cases mapped : source.toList.mapM (translateAtom mapping) with + | none => simp [mapped] at translated + | some targetAtoms => + have targetEq : target = targetAtoms.toArray := by + simpa [mapped] using translated.symm + subst target + unfold AtomsRel + simpa using atomsListRel_of_mapM mapping source.toList targetAtoms mapped + +private theorem except_bind_eq_ok {ε α β : Type} {input : Except ε α} + {next : α → Except ε β} {output : β} + (bound : input.bind next = .ok output) : + ∃ value, input = .ok value ∧ next value = .ok output := by + cases input with + | error error => cases bound + | ok value => exact ⟨value, rfl, bound⟩ + +/-- Pointwise account of a successful target operand-vector resolution. -/ +inductive ResolvedAtomsList (target : Array RVal) : + List Atom → List RVal → Prop where + | nil : ResolvedAtomsList target [] [] + | cons : Eval.resolveAtom target atom = .ok value → + ResolvedAtomsList target atoms values → + ResolvedAtomsList target (atom :: atoms) (value :: values) + +def ResolvedAtoms (target : Array RVal) (atoms : Array Atom) + (values : Array RVal) : Prop := + ResolvedAtomsList target atoms.toList values.toList + +private theorem resolveFold_rel {target : Array RVal} : + ∀ (atoms : List Atom) (accumulator output : Array RVal), + List.foldlM + (fun values atom => do + return values.push (← Eval.resolveAtom target atom)) + accumulator atoms = .ok output → + ∃ values, ResolvedAtomsList target atoms values ∧ + output = accumulator ++ values.toArray := by + intro atoms + induction atoms with + | nil => + intro accumulator output resolved + simp only [List.foldlM_nil] at resolved + change Except.ok accumulator = Except.ok output at resolved + have outputEqual : accumulator = output := Except.ok.inj resolved + subst output + exact ⟨[], .nil, by simp⟩ + | cons atom atoms ih => + intro accumulator output resolved + simp only [List.foldlM_cons] at resolved + obtain ⟨nextAccumulator, headResolved, tailResolved⟩ := + except_bind_eq_ok resolved + obtain ⟨value, atomResolved, pushed⟩ := + except_bind_eq_ok headResolved + have nextEqual : nextAccumulator = accumulator.push value := by + simpa using Except.ok.inj pushed.symm + subst nextAccumulator + obtain ⟨values, valuesResolved, outputEqual⟩ := + ih (accumulator.push value) output tailResolved + refine ⟨value :: values, .cons atomResolved valuesResolved, ?_⟩ + rw [outputEqual] + apply Array.ext' + simp + +/-- `resolveAtoms` retains the exact input/output order pointwise. -/ +theorem resolvedAtoms_of_resolveAtoms {target : Array RVal} + {atoms : Array Atom} {values : Array RVal} + (resolved : Eval.resolveAtoms target atoms = .ok values) : + ResolvedAtoms target atoms values := by + unfold Eval.resolveAtoms at resolved + rw [← Array.foldlM_toList] at resolved + obtain ⟨resolvedValues, pointwise, outputEqual⟩ := + resolveFold_rel atoms.toList #[] values resolved + have valuesEqual : values = resolvedValues.toArray := by + simpa using outputEqual + subst values + simpa [ResolvedAtoms] using pointwise + +theorem ResolvedAtomsList.getElem? {target : Array RVal} + {atoms : List Atom} {values : List RVal} + (relation : ResolvedAtomsList target atoms values) + {index : Nat} {atom : Atom} (found : atoms[index]? = some atom) : + ∃ value, values[index]? = some value ∧ + Eval.resolveAtom target atom = .ok value := by + induction relation generalizing index atom with + | nil => simp at found + | @cons headAtom headValue tailAtoms tailValues head tail ih => + cases index with + | zero => + have atomEqual : headAtom = atom := by simpa using found + subst atom + exact ⟨headValue, by simp, head⟩ + | succ index => + obtain ⟨value, valueAt, resolved⟩ := ih (by simpa using found) + exact ⟨value, by simpa using valueAt, resolved⟩ + +private def sourceResolveTargetStep (source : List IxIR1.RVal) + (output : List IxIR1.RVal) (atom : IxIR1.Atom) : + Except IxIR1.Err (List IxIR1.RVal) := do + return output ++ [← IxIR1.resolveAtom source atom] + +private theorem resolveSourceFold_of_envRel_target + {source : List IxIR1.RVal} {target : Array IxIR1.RVal} + {mapping : EnvMap} (relation : EnvRel source target mapping) + (sourceCount : source.length = mapping.size) : + {sourceAtoms : List IxIR1.Atom} → {targetAtoms : List Atom} → + {values : List IxIR1.RVal} → + AtomsListRel mapping sourceAtoms targetAtoms → + ResolvedAtomsList target targetAtoms values → + ∀ accumulator, + List.foldlM (sourceResolveTargetStep source) accumulator sourceAtoms = + (Except.ok (accumulator ++ values) : + Except IxIR1.Err (List IxIR1.RVal)) := by + intro sourceAtoms targetAtoms values atoms resolved + induction atoms generalizing values with + | nil => + cases resolved + intro accumulator + simp only [List.foldlM_nil, List.append_nil] + rfl + | @cons sourceAtom targetAtom sourceAtoms targetAtoms translated tail ih => + cases resolved with + | @cons _ value _ values targetResolved tailResolved => + intro accumulator + have sourceResolved := resolveAtom_of_envRel_target relation + sourceCount translated targetResolved + simp only [List.foldlM_cons] + simp only [sourceResolveTargetStep, sourceResolved] + change List.foldlM (sourceResolveTargetStep source) + (accumulator ++ [value]) sourceAtoms = + .ok (accumulator ++ (value :: values)) + simpa [List.append_assoc] using + ih tailResolved (accumulator ++ [value]) + +/-- Successful resolution of a translated target operand vector reflects to +the exact source vector and preserves result order. -/ +theorem resolveAtoms_of_envRel_target {source : List IxIR1.RVal} + {target : Array IxIR1.RVal} {mapping : EnvMap} + (relation : EnvRel source target mapping) + (sourceCount : source.length = mapping.size) + {sourceAtoms : Array IxIR1.Atom} {targetAtoms : Array Atom} + (atoms : AtomsRel mapping sourceAtoms targetAtoms) + {values : Array IxIR1.RVal} + (resolved : Eval.resolveAtoms target targetAtoms = .ok values) : + IxIR1.resolveAtoms source sourceAtoms = .ok values.toList := by + have pointwise := resolvedAtoms_of_resolveAtoms resolved + unfold IxIR1.resolveAtoms + rw [← Array.foldlM_toList] + change List.foldlM (sourceResolveTargetStep source) [] sourceAtoms.toList = + .ok values.toList + simpa using resolveSourceFold_of_envRel_target relation sourceCount atoms + pointwise [] + +/-- Structural relation emitted by `edgeView`: each live source slot becomes +the same-position successor register and carries its current target operand; +dead slots impose no resolution premise. -/ +def EdgeArgsRel (currentMap explicitMap : EnvMap) + (arguments : Array Atom) : Prop := + ∀ (index : Nat) (successorAtom : Atom), + explicitMap[index]? = some (some successorAtom) → + ∃ argument, + successorAtom = .reg index ∧ + currentMap[index]? = some (some argument) ∧ + arguments[index]? = some argument + +/-- The three edge tables derived from one retained predecessor map satisfy +`EdgeArgsRel` by construction. -/ +theorem EdgeArgsRel.canonical (sourceInputMap : EnvMap) : + EdgeArgsRel sourceInputMap + (Lower.EdgeTrace.explicitMapOf sourceInputMap) + (Lower.EdgeTrace.explicitValuesOf sourceInputMap) := by + intro index successorAtom mapped + unfold Lower.EdgeTrace.explicitMapOf at mapped + rw [Array.getElem?_mapIdx] at mapped + cases inputAt : sourceInputMap[index]? with + | none => simp [inputAt] at mapped + | some slot => + cases slot with + | none => simp [inputAt] at mapped + | some argument => + have successorEqual : successorAtom = .reg index := by + simpa [inputAt] using mapped.symm + refine ⟨argument, successorEqual, rfl, ?_⟩ + unfold Lower.EdgeTrace.explicitValuesOf + rw [Array.getElem?_map] + simp [inputAt] + +/-- Resolving a generated edge's explicit arguments converts the parent +environment relation into the successor's same-position register relation. +Consumed slots remain absent and therefore require no source lookup. -/ +theorem EnvRel.of_edge_arguments {source : List RVal} + {target values : Array RVal} {currentMap explicitMap : EnvMap} + {arguments : Array Atom} + (environments : EnvRel source target currentMap) + (edgeArguments : EdgeArgsRel currentMap explicitMap arguments) + (resolved : Eval.resolveAtoms target arguments = .ok values) : + EnvRel source values explicitMap := by + have pointwise := resolvedAtoms_of_resolveAtoms resolved + intro index value successorAtom sourceAt mapped + obtain ⟨argument, successorEqual, currentAt, argumentAt⟩ := + edgeArguments index successorAtom mapped + have argumentResolved : Eval.resolveAtom target argument = .ok value := + environments index value argument sourceAt currentAt + have argumentAtList : arguments.toList[index]? = some argument := by + simpa using argumentAt + obtain ⟨resolvedValue, valueAtList, resolvedValueEq⟩ := + pointwise.getElem? argumentAtList + have resolvedValueEqual : resolvedValue = value := by + rw [argumentResolved] at resolvedValueEq + exact (Except.ok.inj resolvedValueEq).symm + subst resolvedValue + have valueAt : values[index]? = some value := by + simpa using valueAtList + subst successorAtom + simp [Eval.resolveAtom, valueAt] + +/-- Parent-facing form of `simulate_traced_edge_transfer`. The compiler need +only prove the structural `EdgeArgsRel`; actual operand resolution derives the +explicit successor relation before implicit parameters are prefixed. -/ +theorem simulate_traced_edge_transfer_from_parent + {frame : Eval.Frame} {edge : Edge} {trace : Lower.EdgeTrace} + {block : Block} {source : List RVal} + {currentMap explicitMap : EnvMap} + {implicitValues explicitValues : Array RVal} + (edgeTarget : edge.target = trace.target) + (edgeValues : edge.values = trace.explicitValues) + (edgeCredits : edge.credits = #[]) + (traceMap : trace.sourceMap = + Lower.EdgeTrace.sourceMapOf trace.implicitScalars explicitMap) + (implicitCount : trace.implicitScalars = implicitValues.size) + (environments : EnvRel source frame.values currentMap) + (edgeArguments : + EdgeArgsRel currentMap explicitMap trace.explicitValues) + (resolved : Eval.resolveAtoms frame.values trace.explicitValues = + .ok explicitValues) + (frameCredits : frame.credits = #[]) + (blockAt : frame.definition.blocks[trace.target]? = some block) + (blockParams : block.valueParams = trace.targetParams) + (valueArity : (implicitValues ++ explicitValues).size = + trace.targetParams.size) + (blockCredits : block.creditParams = #[]) : + let target : Eval.Frame := + { frame with + block := trace.target + pc := 0 + values := implicitValues ++ explicitValues + credits := #[] } + Eval.EdgeTransfer frame edge implicitValues target ∧ + EnvRel (implicitValues.toList ++ source) target.values trace.sourceMap := by + apply simulate_traced_edge_transfer edgeTarget edgeValues edgeCredits + traceMap implicitCount resolved + · exact environments.of_edge_arguments edgeArguments resolved + · exact frameCredits + · exact blockAt + · exact blockParams + · exact valueArity + · exact blockCredits + +/-- Canonical generated-edge hand-off. Both the explicit argument vector and +the successor source map are computed projections of the trace's retained +parent map, so the recursive compiler proof supplies only its current +environment invariant. -/ +theorem simulate_generated_edge_transfer + {frame : Eval.Frame} {edge : Edge} {trace : Lower.EdgeTrace} + {block : Block} {source : List RVal} + {implicitValues explicitValues : Array RVal} + (edgeTarget : edge.target = trace.target) + (edgeValues : edge.values = trace.explicitValues) + (edgeCredits : edge.credits = #[]) + (implicitCount : trace.implicitScalars = implicitValues.size) + (environments : EnvRel source frame.values trace.sourceInputMap) + (resolved : Eval.resolveAtoms frame.values trace.explicitValues = + .ok explicitValues) + (frameCredits : frame.credits = #[]) + (blockAt : frame.definition.blocks[trace.target]? = some block) + (blockParams : block.valueParams = trace.targetParams) + (valueArity : (implicitValues ++ explicitValues).size = + trace.targetParams.size) + (blockCredits : block.creditParams = #[]) : + let target : Eval.Frame := + { frame with + block := trace.target + pc := 0 + values := implicitValues ++ explicitValues + credits := #[] } + Eval.EdgeTransfer frame edge implicitValues target ∧ + EnvRel (implicitValues.toList ++ source) target.values trace.sourceMap := by + have edgeArguments : EdgeArgsRel trace.sourceInputMap + (Lower.EdgeTrace.explicitMapOf trace.sourceInputMap) + trace.explicitValues := by + simpa [Lower.EdgeTrace.explicitValues] using + EdgeArgsRel.canonical trace.sourceInputMap + apply simulate_traced_edge_transfer_from_parent edgeTarget edgeValues + edgeCredits (by rfl) implicitCount environments edgeArguments resolved + frameCredits blockAt blockParams valueArity blockCredits + +/-- Runtime readiness of one generated baseline edge. Operand resolution and +the implicit/explicit value-count equation are the only dynamic facts not +already fixed by `EdgeTrace`. -/ +def EdgeRuntimeReady (frame : Eval.Frame) (trace : Lower.EdgeTrace) : Prop := + ∃ values, + Eval.resolveAtoms frame.values trace.explicitValues = .ok values ∧ + trace.implicitScalars + values.size = trace.targetParams.size + +private theorem resolveFold_exists_of_pointwise (target : Array RVal) : + ∀ (atoms : List Atom) (accumulator : Array RVal), + (∀ (index : Nat) (atom : Atom), atoms[index]? = some atom → + ∃ value, Eval.resolveAtom target atom = .ok value) → + ∃ output, + List.foldlM + (fun values atom => do + return values.push (← Eval.resolveAtom target atom)) + accumulator atoms = .ok output ∧ + output.size = accumulator.size + atoms.length + | [], accumulator, _ => ⟨accumulator, rfl, by simp⟩ + | atom :: atoms, accumulator, pointwise => by + obtain ⟨value, resolved⟩ := pointwise 0 atom (by rfl) + have tailPointwise : ∀ (index : Nat) (tailAtom : Atom), + atoms[index]? = some tailAtom → + ∃ value, Eval.resolveAtom target tailAtom = .ok value := by + intro index tailAtom found + exact pointwise (index + 1) tailAtom (by simpa using found) + obtain ⟨output, folded, outputSize⟩ := + resolveFold_exists_of_pointwise target atoms + (accumulator.push value) tailPointwise + refine ⟨output, ?_, ?_⟩ + · rw [List.foldlM_cons] + rw [resolved] + exact folded + · simp only [Array.size_push, List.length_cons] at outputSize ⊢ + omega + +/-- A finite operand vector resolves whenever each indexed operand does. -/ +theorem resolveAtoms_exists_of_pointwise {target : Array RVal} + {atoms : Array Atom} + (pointwise : ∀ (index : Nat) (atom : Atom), + atoms[index]? = some atom → + ∃ value, Eval.resolveAtom target atom = .ok value) : + ∃ values, + Eval.resolveAtoms target atoms = .ok values ∧ + values.size = atoms.size := by + have listPointwise : ∀ (index : Nat) (atom : Atom), + atoms.toList[index]? = some atom → + ∃ value, Eval.resolveAtom target atom = .ok value := by + intro index atom found + exact pointwise index atom (by simpa using found) + obtain ⟨values, resolved, valueCount⟩ := + resolveFold_exists_of_pointwise target atoms.toList #[] listPointwise + refine ⟨values, ?_, ?_⟩ + · unfold Eval.resolveAtoms + rw [← Array.foldlM_toList] + exact resolved + · simpa using valueCount + +/-- The canonical explicit operand vector of a generated edge is dynamically +ready whenever its complete source environment is related. The retained edge +arity equation supplies the implicit-prefix count. -/ +theorem edgeRuntimeReady_of_envRel {source : List RVal} + {frame : Eval.Frame} {trace : Lower.EdgeTrace} + (environments : EnvRel source frame.values trace.sourceInputMap) + (sourceCount : source.length = trace.sourceInputMap.size) + (parameterCount : trace.targetParams.size = + trace.implicitScalars + trace.sourceInputMap.size) : + EdgeRuntimeReady frame trace := by + obtain ⟨values, resolved, valueCount⟩ := + resolveAtoms_exists_of_pointwise + (target := frame.values) (atoms := trace.explicitValues) (by + intro index atom found + unfold Lower.EdgeTrace.explicitValues + Lower.EdgeTrace.explicitValuesOf at found + rw [Array.getElem?_map] at found + cases slotAt : trace.sourceInputMap[index]? with + | none => simp [slotAt] at found + | some slot => + cases slot with + | none => + have atomEq : atom = .erased := by + simpa [slotAt] using found.symm + subst atom + exact ⟨.erased, rfl⟩ + | some mappedAtom => + have atomEq : atom = mappedAtom := by + simpa [slotAt] using found.symm + subst atom + have mapBound : index < trace.sourceInputMap.size := + (Array.getElem?_eq_some_iff.mp slotAt).1 + have sourceBound : index < source.length := by + rw [sourceCount] + exact mapBound + let value := source[index] + have sourceAt : source[index]? = some value := + List.getElem?_eq_some_iff.mpr ⟨sourceBound, rfl⟩ + exact ⟨value, + environments index value mappedAtom sourceAt slotAt⟩) + refine ⟨values, resolved, ?_⟩ + calc + trace.implicitScalars + values.size = + trace.implicitScalars + trace.sourceInputMap.size := by + rw [valueCount] + simp [Lower.EdgeTrace.explicitValues, + Lower.EdgeTrace.explicitValuesOf] + _ = trace.targetParams.size := parameterCount.symm + +private theorem array_eq_empty_of_isEmpty {values : Array α} + (empty : values.isEmpty = true) : values = #[] := by + apply Array.ext' + simpa [Array.isEmpty] using empty + +/-- Frame after executing the first `count` generated constructor-field +fetches. -/ +def fetchPrefixFrame (frame : Eval.Frame) (fields : Array RVal) + (count : Nat) : Eval.Frame := + { frame with + pc := count + values := frame.values ++ fields.extract 0 count } + +/-- Internal induction for the constructor fetch prologue. -/ +private theorem simulate_fetch_prologue_from + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {block : Block} + {atom : Atom} {cid : CtorId} {location : Nat} + {box : IxIR1.NodeBox} {fields : Array RVal} + (blockAt : frame.definition.blocks[frame.block]? = some block) + (prologue : Lower.fetchPrologueMatches block.instructions atom cid + fields.size = true) + (resolved : Eval.resolveAtom frame.values atom = .ok (.loc location)) + (boxAt : machine.store.get? location = some box) + (node : box.node = .ctorN cid fields) : + ∀ (remaining index : Nat), index + remaining = fields.size → + Eval.Steps context interpretation remaining + { machine with + control := .running (fetchPrefixFrame frame fields index) stack } + { machine with + control := .running (fetchPrefixFrame frame fields fields.size) stack } := by + intro remaining + induction remaining with + | zero => + intro index total + have indexEq : index = fields.size := by omega + subst index + exact .refl _ + | succ remaining ih => + intro index total + have indexBound : index < fields.size := by omega + have instructionAt := Lower.fetchPrologueAt_of_match prologue indexBound + obtain ⟨pcBound, instruction⟩ := + Array.getElem?_eq_some_iff.mp instructionAt + have fieldAt : fields[index]? = some fields[index] := + Array.getElem?_eq_some_iff.mpr ⟨indexBound, rfl⟩ + have currentResolved : + Eval.resolveAtom (fetchPrefixFrame frame fields index).values atom = + .ok (.loc location) := by + simpa [fetchPrefixFrame] using + resolveAtom_append_old + (suffix := fields.extract 0 index) resolved + have currentBlockAt : + (fetchPrefixFrame frame fields index).definition.blocks[(fetchPrefixFrame + frame fields index).block]? = some block := by + simpa [fetchPrefixFrame] using blockAt + have currentPc : + (fetchPrefixFrame frame fields index).pc < block.instructions.size := by + simpa [fetchPrefixFrame] using pcBound + have currentInstruction : + block.instructions[(fetchPrefixFrame frame fields index).pc] = + .fetch atom cid index := by + simpa [fetchPrefixFrame] using instruction + have headRaw := Eval.Step.fetch + (context := context) (interpretation := interpretation) + (machine := { machine with + control := .running (fetchPrefixFrame frame fields index) stack }) + (frame := fetchPrefixFrame frame fields index) + (value := fields[index]) rfl currentBlockAt currentPc + currentInstruction currentResolved boxAt node fieldAt + have extractSucc : fields.extract 0 (index + 1) = + (fields.extract 0 index).push fields[index] := + Array.extract_succ_right (by omega) indexBound + have nextFrame : + { fetchPrefixFrame frame fields index with + pc := (fetchPrefixFrame frame fields index).pc + 1 + values := (fetchPrefixFrame frame fields index).values.push + fields[index] } = + fetchPrefixFrame frame fields (index + 1) := by + cases frame + unfold fetchPrefixFrame + rw [extractSucc, Array.push_append] + have head : Eval.Step context interpretation + { machine with + control := .running (fetchPrefixFrame frame fields index) stack } + { machine with + control := .running (fetchPrefixFrame frame fields (index + 1)) stack } := by + rw [nextFrame] at headRaw + exact headRaw + have tail := ih (index + 1) (by omega) + exact .cons rfl head tail + +/-- Execute a complete certified constructor fetch prologue. The target takes +exactly one control step per field and ends with all fields appended in source +constructor order. -/ +theorem simulate_fetch_prologue + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {block : Block} + {atom : Atom} {cid : CtorId} {location : Nat} + {box : IxIR1.NodeBox} {fields : Array RVal} + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (startPc : frame.pc = 0) + (prologue : Lower.fetchPrologueMatches block.instructions atom cid + fields.size = true) + (resolved : Eval.resolveAtom frame.values atom = .ok (.loc location)) + (boxAt : machine.store.get? location = some box) + (node : box.node = .ctorN cid fields) : + let finalFrame : Eval.Frame := + { frame with + pc := fields.size + values := frame.values ++ fields } + Eval.Steps context interpretation fields.size machine + { machine with control := .running finalFrame stack } := by + dsimp only + have steps := simulate_fetch_prologue_from + (context := context) (interpretation := interpretation) + (stack := stack) + blockAt prologue resolved boxAt node fields.size 0 (by simp) + have startFrame : fetchPrefixFrame frame fields 0 = frame := by + cases frame + simp_all [fetchPrefixFrame] + have startMachine : + { machine with control := .running frame stack } = machine := by + cases machine + simp_all + rw [startFrame, startMachine] at steps + simpa [fetchPrefixFrame] using steps + +/-- A certified constructor switch, generated edge transfer, and exact field +fetch prologue compose into the recursive constructor child's `CodeStateRel`. +The result also retains the parent runtime facts, exact edge-entry frame, and +certified child prologue needed by downstream rewrite-aware simulation. The +only non-trace premises are the runtime node, source alternative selected by +that node, and its field arity. Generated-edge operand readiness follows from +the complete source environment invariant. -/ +theorem simulate_traced_switch_ctor_state + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input : EnvMap} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {targetScrutinee : Atom} + {generated : Block} {outgoing : List Lower.EdgeTrace} + {children : List Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children)) + {sourceStore : IxIR1.Store} {source : List RVal} + {location : Nat} {box : IxIR1.NodeBox} {cid : CtorId} + {fields : Array RVal} + (state : CodeStateRel functionTrace + (.switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children) source frame) + (stores : StoreRel sourceStore machine.store) + (sourceResolved : IxIR1.resolveAtom source sourceScrutinee = + .ok (.loc location)) + (sourceGet : sourceStore.get? location = some box) + (node : box.node = .ctorN cid fields) + {tag fieldCount alternativeIndex : Nat} {body : IxIR1.Code} + (sourceAlternative : Lower.sourceAlternativeAtTag? alternatives cid.cidx = + some (.mk tag fieldCount body, alternativeIndex)) + (fieldArity : fields.size = fieldCount) + {constructors : Array CtorAlt} {targetPeel : Option NatPeel} + {index : Nat} {target : CtorAlt} {edge : Lower.EdgeTrace} + {child : Lower.CodeTrace} + (terminator : generated.terminator = + .switchValue targetScrutinee constructors targetPeel) + (targetAt : constructors[index]? = some target) + (targetAlternative : constructors.find? (fun candidate => + candidate.cid == cid) = some target) + (edgeAt : outgoing[index]? = some edge) + (childAt : children[index]? = some child) + (control : machine.control = .running frame stack) + (frameCredits : frame.credits = #[]) : + ∃ finalFrame edgeFrame childScrutinee, + child.source = site.alternative alternativeIndex ∧ + child.sourceCode = body ∧ + Eval.Steps context interpretation (1 + fields.size) machine + { machine with control := .running finalFrame stack } ∧ + (∀ heapFuel, + Eval.Steps context interpretation (1 + fields.size) + { machine with heapFuel } + { { machine with control := .running finalFrame stack } with + heapFuel }) ∧ + finalFrame.credits = #[] ∧ + StoreRel sourceStore machine.store ∧ + CodeStateRel functionTrace child + (fields.toList.reverse ++ source) finalFrame ∧ + frame.definition.blocks[frame.block]? = some generated ∧ + frame.pc = generated.instructions.size ∧ + Eval.resolveAtom frame.values targetScrutinee = + .ok (.loc location) ∧ + machine.store.get? location = some box ∧ + Eval.EdgeTransfer frame target.edge #[] edgeFrame ∧ + Eval.Step context interpretation machine + { machine with control := .running edgeFrame stack } ∧ + edgeFrame.definition.blocks[edgeFrame.block]? = + some child.headBlock.2 ∧ + edgeFrame.pc = 0 ∧ + Eval.resolveAtom edgeFrame.values childScrutinee = + .ok (.loc location) ∧ + Lower.fetchPrologueMatches child.headBlock.2.instructions + childScrutinee cid fields.size = true ∧ + finalFrame = { edgeFrame with + pc := fields.size + values := edgeFrame.values ++ fields } := by + have recursiveMatched := + functionTrace.descendantSwitchBranchesMatch descendant + have localMatched := + Lower.CodeTrace.switchNodeBranchesMatch_of_match recursiveMatched + have branch := Lower.constructorBranchMatchAt_of_switch_match + localMatched terminator targetAt edgeAt childAt + have targetCid : target.cid = cid := by + have matched : (target.cid == cid) = true := Array.find?_some + (p := fun candidate : CtorAlt => candidate.cid == cid) + (a := target) (xs := constructors) targetAlternative + exact beq_iff_eq.mp matched + have branchAlternative := branch.sourceAlternative + rw [targetCid, sourceAlternative] at branchAlternative + have alternativeEqual := Option.some.inj branchAlternative + have sourceTag : branch.tag = tag := by + exact (congrArg (fun alternative : IxIR1.Alt × Nat => + match alternative.1 with | .mk tag _ _ => tag) alternativeEqual).symm + have sourceFieldCount : branch.fieldCount = fieldCount := by + exact (congrArg (fun alternative : IxIR1.Alt × Nat => + match alternative.1 with | .mk _ fields _ => fields) alternativeEqual).symm + have sourceBody : branch.body = body := by + exact (congrArg (fun alternative : IxIR1.Alt × Nat => + match alternative.1 with | .mk _ _ body => body) alternativeEqual).symm + have sourceAlternativeIndex : branch.alternativeIndex = alternativeIndex := + (congrArg Prod.snd alternativeEqual).symm + have edgeMember : edge ∈ outgoing := List.mem_of_getElem? edgeAt + have childMember : child ∈ children := List.mem_of_getElem? childAt + have childDescendant : functionTrace.root.Descendant child := + .step descendant childMember + have ready : EdgeRuntimeReady frame edge := + edgeRuntimeReady_of_envRel + (by simpa [Lower.CodeTrace.sourceInputMap, branch.edgeSourceInput] + using state.environments) + (by simpa [Lower.CodeTrace.sourceInputMap, branch.edgeSourceInput] + using state.sourceCount) + branch.edgeParameterCount + obtain ⟨explicitValues, edgeResolved, edgeArity⟩ := ready + let edgeFrame : Eval.Frame := + { frame with + block := edge.target + pc := 0 + values := #[] ++ explicitValues + credits := #[] } + let finalFrame : Eval.Frame := + { edgeFrame with + pc := fields.size + values := edgeFrame.values ++ fields } + have edgeCredits : target.edge.credits = #[] := + array_eq_empty_of_isEmpty branch.edgeCredits + have blockCredits : child.headBlock.2.creditParams = #[] := + array_eq_empty_of_isEmpty branch.childCredits + have childBlockAt : + frame.definition.blocks[edge.target]? = some child.headBlock.2 := by + have found := functionTrace.descendantHeadBlockAt childDescendant + rw [state.definition] + simpa [branch.childHeadBlock] using found + have parentEnvironments : EnvRel source frame.values edge.sourceInputMap := by + have current : EnvRel source frame.values input := by + simpa [Lower.CodeTrace.sourceInputMap] using state.environments + simpa [branch.edgeSourceInput] using current + have valueArity : (#[] ++ explicitValues).size = edge.targetParams.size := by + simpa [branch.edgeImplicitScalars] using edgeArity + obtain ⟨transferred, edgeEnvironments⟩ := + simulate_generated_edge_transfer branch.edgeTarget.symm branch.edgeValues + edgeCredits (by simpa using branch.edgeImplicitScalars) + parentEnvironments edgeResolved frameCredits childBlockAt + branch.childParams valueArity blockCredits + have parentBlockAt : + frame.definition.blocks[frame.block]? = some generated := by + simpa [Lower.CodeTrace.headBlock] using state.blockAt descendant + have parentPc : frame.pc = generated.instructions.size := by + simpa [Lower.CodeTrace.entryPc] using state.pc + have syntaxMatched := functionTrace.descendantSyntaxMatches descendant + obtain ⟨_, _, translated, _⟩ := + Lower.CodeTrace.switchSyntax_of_match syntaxMatched + have targetResolved : Eval.resolveAtom frame.values targetScrutinee = + .ok (.loc location) := + resolveAtom_of_envRel state.environments translated sourceResolved + have targetGet : machine.store.get? location = some box := by + unfold Eval.Store.get? + rw [stores.heap] + exact sourceGet + have switchStep : Eval.Step context interpretation machine + { machine with control := .running edgeFrame stack } := by + apply Eval.Step.switchCtor control parentBlockAt parentPc terminator + targetResolved targetGet node targetAlternative + simpa [edgeFrame] using transferred + have explicitEnvironments : EnvRel source edgeFrame.values + (Lower.EdgeTrace.explicitMapOf edge.sourceInputMap) := by + have sourceMapZero : edge.sourceMap = + Lower.EdgeTrace.explicitMapOf edge.sourceInputMap := by + unfold Lower.EdgeTrace.sourceMap + rw [branch.edgeImplicitScalars] + exact sourceMapOf_zero _ + rw [sourceMapZero] at edgeEnvironments + simpa [edgeFrame] using edgeEnvironments + have childTranslated : + Lower.InputMap.translateAtom + (Lower.EdgeTrace.explicitMapOf edge.sourceInputMap) sourceScrutinee = + some branch.childScrutinee := by + simpa [branch.edgeSourceInput] using branch.translatedScrutinee + have childResolved : Eval.resolveAtom edgeFrame.values + branch.childScrutinee = .ok (.loc location) := + resolveAtom_of_envRel explicitEnvironments childTranslated sourceResolved + have prologue : Lower.fetchPrologueMatches child.headBlock.2.instructions + branch.childScrutinee cid fields.size = true := by + simpa [targetCid, sourceFieldCount, fieldArity] using branch.fetchPrologue + have prologueSteps : Eval.Steps context interpretation fields.size + { machine with control := .running edgeFrame stack } + { machine with control := .running finalFrame stack } := by + apply simulate_fetch_prologue + (machine := { machine with control := .running edgeFrame stack }) + (frame := edgeFrame) (stack := stack) rfl + (show edgeFrame.definition.blocks[edgeFrame.block]? = + some child.headBlock.2 by simpa [edgeFrame] using childBlockAt) + (by rfl) prologue childResolved targetGet node + have targetSteps : Eval.Steps context interpretation (1 + fields.size) + machine { machine with control := .running finalFrame stack } := + (switchStep.toSteps control).trans prologueSteps + have targetStepsPreserving : ∀ heapFuel, + Eval.Steps context interpretation (1 + fields.size) + { machine with heapFuel } + { { machine with control := .running finalFrame stack } with + heapFuel } := by + intro heapFuel + let fundedMachine : Eval.Machine := { machine with heapFuel } + have fundedControl : fundedMachine.control = .running frame stack := by + simpa [fundedMachine] using control + have fundedGet : fundedMachine.store.get? location = some box := by + simpa [fundedMachine] using targetGet + have fundedSwitch : Eval.Step context interpretation fundedMachine + { fundedMachine with control := .running edgeFrame stack } := by + apply Eval.Step.switchCtor fundedControl parentBlockAt parentPc terminator + targetResolved fundedGet node targetAlternative + simpa [edgeFrame] using transferred + have fundedPrologue : Eval.Steps context interpretation fields.size + { fundedMachine with control := .running edgeFrame stack } + { fundedMachine with control := .running finalFrame stack } := by + apply simulate_fetch_prologue + (machine := { fundedMachine with + control := .running edgeFrame stack }) + (frame := edgeFrame) (stack := stack) rfl + (show edgeFrame.definition.blocks[edgeFrame.block]? = + some child.headBlock.2 by simpa [edgeFrame] using childBlockAt) + (by rfl) prologue childResolved fundedGet node + have fundedSteps := (fundedSwitch.toSteps fundedControl).trans + fundedPrologue + simpa [fundedMachine] using fundedSteps + have finalEnvironments : EnvRel (fields.toList.reverse ++ source) + finalFrame.values child.sourceInputMap := by + have extended := explicitEnvironments.constructorFields (fields := fields) + have edgeValueCount : edgeFrame.values.size = edge.targetParams.size := by + simpa [edgeFrame] using valueArity + simpa [finalFrame, branch.childInput, edgeValueCount, sourceFieldCount, + fieldArity] using extended + have explicitValueCount : explicitValues.size = edge.targetParams.size := by + simpa using valueArity + have childState : CodeStateRel functionTrace child + (fields.toList.reverse ++ source) finalFrame := by + constructor + · simpa [finalFrame, edgeFrame] using state.definition + · simpa [finalFrame, edgeFrame] using branch.childBlock.symm + · simpa [finalFrame, sourceFieldCount, fieldArity] using branch.childPc.symm + · calc + finalFrame.values.size = edge.targetParams.size + fields.size := by + simp [finalFrame, edgeFrame, explicitValueCount] + _ = edge.targetParams.size + branch.fieldCount := by + rw [sourceFieldCount, fieldArity] + _ = child.entryValueCount := branch.childValueCount.symm + · rw [branch.childInput] + have currentCount : source.length = input.size := by + simpa [Lower.CodeTrace.sourceInputMap] using state.sourceCount + simp [Lower.constructorChildInputMap, fieldArity, + Lower.EdgeTrace.explicitMapOf, sourceFieldCount, + branch.edgeSourceInput, currentCount] + · exact finalEnvironments + exact ⟨finalFrame, edgeFrame, branch.childScrutinee, + branch.childSource.trans + (congrArg (fun index => site.alternative index) + sourceAlternativeIndex), + branch.childCode.trans sourceBody, + targetSteps, targetStepsPreserving, rfl, stores, childState, + parentBlockAt, parentPc, targetResolved, targetGet, transferred, switchStep, + by simpa [edgeFrame] using childBlockAt, rfl, childResolved, prologue, rfl⟩ + +/-- A certified literal-zero switch step enters the exact recursive child +state. All branch/edge/body coordinates, generated-edge operand readiness, +and the successor proof map follow from the retained trace invariant. -/ +theorem simulate_traced_switch_nat_zero_state + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input : EnvMap} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {alternatives : Array IxIR1.Alt} + {targetScrutinee : Atom} {generated : Block} + {outgoing : List Lower.EdgeTrace} {children : List Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children)) + {source : List RVal} + (state : CodeStateRel functionTrace + (.switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children) source frame) + (sourceResolved : IxIR1.resolveAtom source sourceScrutinee = + .ok (.lit (.nat 0))) + (control : machine.control = .running frame stack) + (frameCredits : frame.credits = #[]) : + ∃ (constructors : Array CtorAlt) (peel : NatPeel) + (branches : Lower.NatBranchPairMatch site blockId input alternatives + constructors peel outgoing children) (childFrame : Eval.Frame), + generated.terminator = + .switchValue targetScrutinee constructors (some peel) ∧ + branches.zeroEdge ∈ outgoing ∧ + branches.zeroChild ∈ children ∧ + Lower.sourceAlternativeAtTag? alternatives 0 = + some (.mk 0 0 branches.zero.body, + branches.zero.alternativeIndex) ∧ + branches.zeroChild.source = + site.alternative branches.zero.alternativeIndex ∧ + branches.zeroChild.sourceCode = branches.zero.body ∧ + Eval.Step context interpretation machine + { machine with control := .running childFrame stack } ∧ + (∀ heapFuel, + Eval.Step context interpretation { machine with heapFuel } + { { machine with control := .running childFrame stack } with + heapFuel }) ∧ + childFrame.credits = #[] ∧ + CodeStateRel functionTrace branches.zeroChild source childFrame := by + have recursiveMatched := + functionTrace.descendantSwitchBranchesMatch descendant + have localMatched := + Lower.CodeTrace.switchNodeBranchesMatch_of_match recursiveMatched + have syntaxMatched := functionTrace.descendantSyntaxMatches descendant + obtain ⟨constructors, natPeel, translated, terminator⟩ := + Lower.CodeTrace.switchSyntax_of_match syntaxMatched + cases natPeel with + | none => + simp [Lower.switchNodeBranchesMatch, terminator] at localMatched + | some peel => + let branches := Lower.natBranchPairMatch_of_switch_match + localMatched terminator + have edgeMember : branches.zeroEdge ∈ outgoing := + List.mem_of_getElem? branches.zeroEdgeAt + have childMember : branches.zeroChild ∈ children := + List.mem_of_getElem? branches.zeroChildAt + have childDescendant : + functionTrace.root.Descendant branches.zeroChild := + .step descendant childMember + have ready : EdgeRuntimeReady frame branches.zeroEdge := + edgeRuntimeReady_of_envRel + (by simpa [Lower.CodeTrace.sourceInputMap, + branches.zero.edgeSourceInput] using state.environments) + (by simpa [Lower.CodeTrace.sourceInputMap, + branches.zero.edgeSourceInput] using state.sourceCount) + branches.zero.edgeParameterCount + obtain ⟨explicitValues, edgeResolved, edgeArity⟩ := ready + let childFrame : Eval.Frame := + { frame with + block := branches.zeroEdge.target + pc := 0 + values := #[] ++ explicitValues + credits := #[] } + have edgeCredits : peel.zero.credits = #[] := + array_eq_empty_of_isEmpty branches.zero.edgeCredits + have blockCredits : + branches.zeroChild.headBlock.2.creditParams = #[] := + array_eq_empty_of_isEmpty branches.zero.childCredits + have childBlockAt : + frame.definition.blocks[branches.zeroEdge.target]? = + some branches.zeroChild.headBlock.2 := by + have found := functionTrace.descendantHeadBlockAt childDescendant + rw [state.definition] + simpa [branches.zero.childHeadBlock] using found + have parentEnvironments : EnvRel source frame.values + branches.zeroEdge.sourceInputMap := by + have current : EnvRel source frame.values input := by + simpa [Lower.CodeTrace.sourceInputMap] using state.environments + simpa [branches.zero.edgeSourceInput] using current + have valueArity : (#[] ++ explicitValues).size = + branches.zeroEdge.targetParams.size := by + simpa [branches.zero.edgeImplicitScalars] using edgeArity + obtain ⟨transferred, childEnvironments⟩ := + simulate_generated_edge_transfer + branches.zero.edgeTarget.symm branches.zero.edgeValues edgeCredits + (by simpa using branches.zero.edgeImplicitScalars) + parentEnvironments edgeResolved frameCredits childBlockAt + branches.zero.childParams valueArity blockCredits + have parentBlockAt : + frame.definition.blocks[frame.block]? = some generated := by + simpa [Lower.CodeTrace.headBlock] using state.blockAt descendant + have parentPc : frame.pc = generated.instructions.size := by + simpa [Lower.CodeTrace.entryPc] using state.pc + have targetResolved : Eval.resolveAtom frame.values targetScrutinee = + .ok (.lit (.nat 0)) := + resolveAtom_of_envRel state.environments translated sourceResolved + have targetStep : Eval.Step context interpretation machine + { machine with control := .running childFrame stack } := by + apply Eval.Step.switchNatZero control parentBlockAt parentPc terminator + targetResolved + simpa [childFrame] using transferred + have targetStepPreserving : ∀ heapFuel, + Eval.Step context interpretation { machine with heapFuel } + { { machine with control := .running childFrame stack } with + heapFuel } := by + intro heapFuel + let fundedMachine : Eval.Machine := { machine with heapFuel } + have fundedControl : fundedMachine.control = + .running frame stack := by + simpa [fundedMachine] using control + have fundedStep : Eval.Step context interpretation fundedMachine + { fundedMachine with control := .running childFrame stack } := by + apply Eval.Step.switchNatZero fundedControl parentBlockAt parentPc + terminator targetResolved + simpa [childFrame] using transferred + simpa [fundedMachine] using fundedStep + have childState : CodeStateRel functionTrace branches.zeroChild source + childFrame := by + constructor + · simpa [childFrame] using state.definition + · simpa [childFrame] using branches.zero.childBlock.symm + · simpa [childFrame] using branches.zero.childPc.symm + · calc + childFrame.values.size = branches.zeroEdge.targetParams.size := by + simpa [childFrame] using valueArity + _ = branches.zeroChild.entryValueCount := + branches.zero.childValueCount.symm + · rw [branches.zero.childInput] + simpa [Lower.EdgeTrace.sourceMap, Lower.EdgeTrace.sourceMapOf, + Lower.EdgeTrace.explicitMapOf, + branches.zero.edgeImplicitScalars, + branches.zero.edgeSourceInput, Lower.CodeTrace.sourceInputMap] + using state.sourceCount + · simpa [childFrame, branches.zero.childInput] using + childEnvironments + exact ⟨constructors, peel, branches, childFrame, terminator, edgeMember, + childMember, branches.zero.sourceAlternative, + branches.zero.childSource, branches.zero.childCode, targetStep, + targetStepPreserving, rfl, childState⟩ + +/-- A certified literal-successor switch step preserves the peeled +predecessor as the child environment's implicit leading scalar and enters the +exact recursive child state. -/ +theorem simulate_traced_switch_nat_succ_state + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input : EnvMap} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {alternatives : Array IxIR1.Alt} + {targetScrutinee : Atom} {generated : Block} + {outgoing : List Lower.EdgeTrace} {children : List Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children)) + {source : List RVal} {predecessor : Nat} + (state : CodeStateRel functionTrace + (.switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children) source frame) + (sourceResolved : IxIR1.resolveAtom source sourceScrutinee = + .ok (.lit (.nat (predecessor + 1)))) + (control : machine.control = .running frame stack) + (frameCredits : frame.credits = #[]) : + ∃ (constructors : Array CtorAlt) (peel : NatPeel) + (branches : Lower.NatBranchPairMatch site blockId input alternatives + constructors peel outgoing children) (childFrame : Eval.Frame), + generated.terminator = + .switchValue targetScrutinee constructors (some peel) ∧ + branches.succEdge ∈ outgoing ∧ + branches.succChild ∈ children ∧ + Lower.sourceAlternativeAtTag? alternatives 1 = + some (.mk 1 1 branches.succ.body, + branches.succ.alternativeIndex) ∧ + branches.succChild.source = + site.alternative branches.succ.alternativeIndex ∧ + branches.succChild.sourceCode = branches.succ.body ∧ + Eval.Step context interpretation machine + { machine with control := .running childFrame stack } ∧ + (∀ heapFuel, + Eval.Step context interpretation { machine with heapFuel } + { { machine with control := .running childFrame stack } with + heapFuel }) ∧ + childFrame.credits = #[] ∧ + CodeStateRel functionTrace branches.succChild + (.lit (.nat predecessor) :: source) childFrame := by + have recursiveMatched := + functionTrace.descendantSwitchBranchesMatch descendant + have localMatched := + Lower.CodeTrace.switchNodeBranchesMatch_of_match recursiveMatched + have syntaxMatched := functionTrace.descendantSyntaxMatches descendant + obtain ⟨constructors, natPeel, translated, terminator⟩ := + Lower.CodeTrace.switchSyntax_of_match syntaxMatched + cases natPeel with + | none => + simp [Lower.switchNodeBranchesMatch, terminator] at localMatched + | some peel => + let branches := Lower.natBranchPairMatch_of_switch_match + localMatched terminator + have edgeMember : branches.succEdge ∈ outgoing := + List.mem_of_getElem? branches.succEdgeAt + have childMember : branches.succChild ∈ children := + List.mem_of_getElem? branches.succChildAt + have childDescendant : + functionTrace.root.Descendant branches.succChild := + .step descendant childMember + have ready : EdgeRuntimeReady frame branches.succEdge := + edgeRuntimeReady_of_envRel + (by simpa [Lower.CodeTrace.sourceInputMap, + branches.succ.edgeSourceInput] using state.environments) + (by simpa [Lower.CodeTrace.sourceInputMap, + branches.succ.edgeSourceInput] using state.sourceCount) + branches.succ.edgeParameterCount + obtain ⟨explicitValues, edgeResolved, edgeArity⟩ := ready + let implicitValues : Array RVal := #[.lit (.nat predecessor)] + let childFrame : Eval.Frame := + { frame with + block := branches.succEdge.target + pc := 0 + values := implicitValues ++ explicitValues + credits := #[] } + have edgeCredits : peel.succ.credits = #[] := + array_eq_empty_of_isEmpty branches.succ.edgeCredits + have blockCredits : + branches.succChild.headBlock.2.creditParams = #[] := + array_eq_empty_of_isEmpty branches.succ.childCredits + have childBlockAt : + frame.definition.blocks[branches.succEdge.target]? = + some branches.succChild.headBlock.2 := by + have found := functionTrace.descendantHeadBlockAt childDescendant + rw [state.definition] + simpa [branches.succ.childHeadBlock] using found + have parentEnvironments : EnvRel source frame.values + branches.succEdge.sourceInputMap := by + have current : EnvRel source frame.values input := by + simpa [Lower.CodeTrace.sourceInputMap] using state.environments + simpa [branches.succ.edgeSourceInput] using current + have valueArity : (implicitValues ++ explicitValues).size = + branches.succEdge.targetParams.size := by + simpa [implicitValues, branches.succ.edgeImplicitScalars] using + edgeArity + obtain ⟨transferred, childEnvironments⟩ := + simulate_generated_edge_transfer + branches.succ.edgeTarget.symm branches.succ.edgeValues edgeCredits + (by simpa [implicitValues] using branches.succ.edgeImplicitScalars) + parentEnvironments edgeResolved frameCredits childBlockAt + branches.succ.childParams valueArity blockCredits + have parentBlockAt : + frame.definition.blocks[frame.block]? = some generated := by + simpa [Lower.CodeTrace.headBlock] using state.blockAt descendant + have parentPc : frame.pc = generated.instructions.size := by + simpa [Lower.CodeTrace.entryPc] using state.pc + have targetResolved : Eval.resolveAtom frame.values targetScrutinee = + .ok (.lit (.nat (predecessor + 1))) := + resolveAtom_of_envRel state.environments translated sourceResolved + have targetStep : Eval.Step context interpretation machine + { machine with control := .running childFrame stack } := by + apply Eval.Step.switchNatSucc control parentBlockAt parentPc terminator + targetResolved + simpa [childFrame, implicitValues] using transferred + have targetStepPreserving : ∀ heapFuel, + Eval.Step context interpretation { machine with heapFuel } + { { machine with control := .running childFrame stack } with + heapFuel } := by + intro heapFuel + let fundedMachine : Eval.Machine := { machine with heapFuel } + have fundedControl : fundedMachine.control = + .running frame stack := by + simpa [fundedMachine] using control + have fundedStep : Eval.Step context interpretation fundedMachine + { fundedMachine with control := .running childFrame stack } := by + apply Eval.Step.switchNatSucc fundedControl parentBlockAt parentPc + terminator targetResolved + simpa [childFrame, implicitValues] using transferred + simpa [fundedMachine] using fundedStep + have childState : CodeStateRel functionTrace branches.succChild + (.lit (.nat predecessor) :: source) childFrame := by + constructor + · simpa [childFrame] using state.definition + · simpa [childFrame] using branches.succ.childBlock.symm + · simpa [childFrame] using branches.succ.childPc.symm + · calc + childFrame.values.size = branches.succEdge.targetParams.size := by + simpa [childFrame] using valueArity + _ = branches.succChild.entryValueCount := + branches.succ.childValueCount.symm + · rw [branches.succ.childInput] + have currentCount : source.length = input.size := by + simpa [Lower.CodeTrace.sourceInputMap] using state.sourceCount + simp [Lower.EdgeTrace.sourceMap, Lower.EdgeTrace.sourceMapOf, + Lower.EdgeTrace.explicitMapOf, + branches.succ.edgeImplicitScalars, + branches.succ.edgeSourceInput, currentCount, Nat.add_comm] + · simpa [childFrame, implicitValues, branches.succ.childInput] using + childEnvironments + exact ⟨constructors, peel, branches, childFrame, terminator, edgeMember, + childMember, branches.succ.sourceAlternative, + branches.succ.childSource, branches.succ.childCode, targetStep, + targetStepPreserving, rfl, childState⟩ + +private theorem resolveFold_of_envRel {source : List RVal} + {target : Array RVal} {mapping : EnvMap} + (relation : EnvRel source target mapping) + {sourceAtoms : List IxIR1.Atom} {targetAtoms : List Atom} + (atoms : AtomsListRel mapping sourceAtoms targetAtoms) : + ∀ (accumulator output : List RVal), + List.foldlM + (fun values atom => do + return values ++ [← IxIR1.resolveAtom source atom]) + accumulator sourceAtoms = .ok output → + List.foldlM + (fun values atom => do + return values.push (← Eval.resolveAtom target atom)) + accumulator.toArray targetAtoms = .ok output.toArray := by + induction atoms with + | nil => + intro accumulator output resolved + simp only [List.foldlM_nil] at resolved ⊢ + cases resolved + rfl + | @cons sourceAtom targetAtom sourceAtoms targetAtoms translated _ ih => + intro accumulator output resolved + simp only [List.foldlM_cons] at resolved ⊢ + obtain ⟨nextAccumulator, headResolved, tailResolved⟩ := + except_bind_eq_ok resolved + obtain ⟨value, sourceResolved, nextResolved⟩ := + except_bind_eq_ok headResolved + have nextEqual : nextAccumulator = accumulator ++ [value] := by + simpa using Except.ok.inj nextResolved.symm + subst nextAccumulator + have targetResolved : + Eval.resolveAtom target targetAtom = .ok value := + resolveAtom_of_envRel relation translated sourceResolved + rw [targetResolved] + have appendArray : + (accumulator ++ [value]).toArray = accumulator.toArray.push value := by + apply Array.ext' + simp + change List.foldlM + (fun values atom => do + return values.push (← Eval.resolveAtom target atom)) + (accumulator.toArray.push value) targetAtoms = .ok output.toArray + rw [← appendArray] + exact ih (accumulator ++ [value]) output tailResolved + +/-- Operand-vector resolution agrees pointwise, including result order. -/ +theorem resolveAtoms_of_envRel {source : List RVal} {target : Array RVal} + {mapping : EnvMap} (relation : EnvRel source target mapping) + {sourceAtoms : Array IxIR1.Atom} {targetAtoms : Array Atom} + (atoms : AtomsRel mapping sourceAtoms targetAtoms) + {values : List RVal} + (resolved : IxIR1.resolveAtoms source sourceAtoms = .ok values) : + Eval.resolveAtoms target targetAtoms = .ok values.toArray := by + unfold Eval.resolveAtoms + rw [← Array.foldlM_toList] + apply resolveFold_of_envRel relation atoms [] values + simpa only [IxIR1.resolveAtoms, Array.foldlM_toList] using resolved + +/-- Ordinary allocation is the first heap-changing instruction case. The +source and target allocate the same constructor at the same fresh location +under either interpretation, preserve the exact baseline store relation, and +bind related result slots. -/ +theorem simulate_alloc {sourceContext : IxIR1.Ctx} + {sourceCurrent : IxIR1.FnDef} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} + {frame : Eval.Frame} {stack : List Eval.Continuation} {block : Block} + {sourceStore : IxIR1.Store} {source : List RVal} + {mapping : EnvMap} + (stores : StoreRel sourceStore machine.store) + (environments : EnvRel source frame.values mapping) + {world : Ix.Compiler.Ixon.Owned} {cid : IxIR1.CtorId} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} {schema : CtorSchema} + {values : List RVal} + (arguments : AtomsRel mapping sourceArguments targetArguments) + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (fields : Eval.FieldWorlds machine.store schema values.toArray) + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = + .alloc world cid targetArguments) + (schemaAt : context.schemas world cid = some schema) : + let node := IxIR1.Node.ctorN cid values.toArray + let sourceAllocation := sourceStore.allocNode world node + let targetAllocation := machine.store.allocNode world node + IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.alloc world cid sourceArguments) = + .ok (sourceAllocation.1, .loc sourceAllocation.2) ∧ + Eval.Step context interpretation machine + { machine with + store := targetAllocation.1 + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values.push (.loc sourceAllocation.2) } + stack } ∧ + StoreRel sourceAllocation.1 targetAllocation.1 ∧ + EnvRel (.loc sourceAllocation.2 :: source) + (frame.values.push (.loc sourceAllocation.2)) + (#[some (.reg frame.values.size)] ++ mapping) := by + dsimp only + have targetResolved : + Eval.resolveAtoms frame.values targetArguments = .ok values.toArray := + resolveAtoms_of_envRel environments arguments sourceResolved + have locationEq : + (machine.store.allocNode world (.ctorN cid values.toArray)).2 = + (sourceStore.allocNode world (.ctorN cid values.toArray)).2 := + stores.alloc_location world (.ctorN cid values.toArray) + have targetStep := Eval.Step.alloc (interpretation := interpretation) + control blockAt pc instruction schemaAt targetResolved fields + dsimp only at targetStep + rw [locationEq] at targetStep + refine ⟨?_, targetStep, + stores.alloc world (.ctorN cid values.toArray), ?_⟩ + · unfold IxIR1.runOp + simp only + rw [sourceResolved] + rfl + · exact environments.bindValue + (.loc (sourceStore.allocNode world (.ctorN cid values.toArray)).2) + +/-- Trace-facing allocation transition. Checked operation syntax supplies the +world, constructor, and target operand vector; recursive-state helpers supply +the instruction coordinate and exact continuation state. -/ +theorem simulate_traced_alloc_state {sourceContext : IxIR1.Ctx} + {sourceCurrent : IxIR1.FnDef} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} + {frame : Eval.Frame} {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceWorld targetWorld : Ix.Compiler.Ixon.Owned} + {sourceCid targetCid : IxIR1.CtorId} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next)) + {sourceStore : IxIR1.Store} {source : List RVal} + {schema : CtorSchema} {values : List RVal} + (state : CodeStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next) source frame) + (stores : StoreRel sourceStore machine.store) + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (fields : Eval.FieldWorlds machine.store schema values.toArray) + (control : machine.control = .running frame stack) + (schemaAt : context.schemas sourceWorld sourceCid = some schema) : + let node := IxIR1.Node.ctorN sourceCid values.toArray + let sourceAllocation := sourceStore.allocNode sourceWorld node + let targetAllocation := machine.store.allocNode sourceWorld node + let nextFrame : Eval.Frame := + { frame with + pc := frame.pc + 1 + values := frame.values.push (.loc sourceAllocation.2) } + IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.alloc sourceWorld sourceCid sourceArguments) = + .ok (sourceAllocation.1, .loc sourceAllocation.2) ∧ + Eval.Step context interpretation machine + { machine with + store := targetAllocation.1 + control := .running nextFrame stack } ∧ + StoreRel sourceAllocation.1 targetAllocation.1 ∧ + CodeStateRel functionTrace next + (.loc sourceAllocation.2 :: source) nextFrame := by + dsimp only + have operationSyntax := functionTrace.descendantOperationSyntax descendant + change sourceWorld = targetWorld ∧ sourceCid = targetCid ∧ + Lower.InputMap.translateAtoms input sourceArguments = + some targetArguments at operationSyntax + obtain ⟨worldEq, cidEq, translated⟩ := operationSyntax + subst targetWorld + subst targetCid + have arguments : AtomsRel input sourceArguments targetArguments := + atomsRel_of_translateAtoms translated + obtain ⟨blockAt, pcBound, instructionAt⟩ := state.instructionAt descendant + have instruction : + next.headBlock.2.instructions[frame.pc] = + .alloc sourceWorld sourceCid targetArguments := + (Array.getElem?_eq_some_iff.mp instructionAt).2 + obtain ⟨sourceRun, targetStep, nextStores, canonical⟩ := simulate_alloc + stores state.environments arguments sourceResolved fields control blockAt + pcBound instruction schemaAt + have nextEnvironments := canonical.forgetTracedValue state descendant + (show Lower.Instr.baselineBinderAtom entryValueCount + (.alloc sourceWorld sourceCid targetArguments) = + some (.reg entryValueCount) by rfl) + refine ⟨sourceRun, targetStep, nextStores, + state.letOpNext descendant rfl rfl rfl ?_ rfl nextEnvironments⟩ + simp [Lower.Instr.baselineValueDelta] + +/-- Checked-artifact allocation transition. The retained schema and producer +capability certificates select the dynamic source ownership invariant, so +recursive simulation callers supply neither a target-only `FieldWorlds` +witness nor an allocation-shaped root list. -/ +theorem simulate_traced_alloc_checked_state + {sourceContext : IxIR1.Ctx} {sourceCurrent : IxIR1.FnDef} + {sourceFuel : Nat} {context : Eval.Context} + {interpretation : Eval.Interpretation} {machine : Eval.Machine} + {frame : Eval.Frame} {stack : List Eval.Continuation} + {checked : Lower.Checked} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ checked.artifact.trace.functions) + (contextSchemas : context.schemas = + checked.artifact.validationContext.schemas) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceWorld targetWorld : Ix.Compiler.Ixon.Owned} + {sourceCid targetCid : IxIR1.CtorId} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next)) + {sourceStore : IxIR1.Store} {source : List RVal} + {schema : CtorSchema} {values : List RVal} + {frameRoots : List IxIR1.Sim.Root} + (state : CodeStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next) source frame) + (stores : StoreRel sourceStore machine.store) + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (control : machine.control = .running frame stack) + (schemaAt : context.schemas sourceWorld sourceCid = some schema) + (ownership : SourceOwnershipAt checked.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next) + sourceStore source frameRoots) : + let node := IxIR1.Node.ctorN sourceCid values.toArray + let sourceAllocation := sourceStore.allocNode sourceWorld node + let targetAllocation := machine.store.allocNode sourceWorld node + let nextFrame : Eval.Frame := + { frame with + pc := frame.pc + 1 + values := frame.values.push (.loc sourceAllocation.2) } + IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.alloc sourceWorld sourceCid sourceArguments) = + .ok (sourceAllocation.1, .loc sourceAllocation.2) ∧ + Eval.Step context interpretation machine + { machine with + store := targetAllocation.1 + control := .running nextFrame stack } ∧ + StoreRel sourceAllocation.1 targetAllocation.1 ∧ + CodeStateRel functionTrace next + (.loc sourceAllocation.2 :: source) nextFrame := by + have checkedSchemaAt : checked.artifact.validationContext.schemas + sourceWorld sourceCid = some schema := by + rw [← contextSchemas] + exact schemaAt + have fields := stores.fieldWorlds_of_checked_allocation_capabilities + functionMember descendant ownership sourceResolved checkedSchemaAt + exact simulate_traced_alloc_state descendant state stores sourceResolved + fields control schemaAt + +/-- Successful-run form of checked ordinary allocation. Source evaluation +determines the field vector and exact fresh location; the checked schema, +producer capabilities, and trace-indexed ownership invariant discharge +`FieldWorlds`. -/ +theorem simulate_traced_alloc_checked_success_step + {sourceContext : IxIR1.Ctx} {sourceCurrent : IxIR1.FnDef} + {sourceFuel : Nat} {context : Eval.Context} {machine : Eval.Machine} + {frame : Eval.Frame} {stack : List Eval.Continuation} + {checked : Lower.Checked} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ checked.artifact.trace.functions) + (contextSchemas : context.schemas = + checked.artifact.validationContext.schemas) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceWorld targetWorld : Ix.Compiler.Ixon.Owned} + {sourceCid targetCid : IxIR1.CtorId} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next)) + {sourceStore : IxIR1.Store} {source : List RVal} + {frameRoots : List IxIR1.Sim.Root} + {sourceOutput : IxIR1.Store × RVal} + (state : CodeStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next) source frame) + (stores : StoreRel sourceStore machine.store) + (sourceRun : IxIR1.runCode sourceContext (sourceFuel + 2) + sourceCurrent sourceStore source + (.letOp (.alloc sourceWorld sourceCid sourceArguments) + next.sourceCode) = .ok sourceOutput) + (control : machine.control = .running frame stack) + {schema : CtorSchema} + (schemaAt : context.schemas sourceWorld sourceCid = some schema) + (ownership : SourceOwnershipAt checked.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next) + sourceStore source frameRoots) : + ∃ values sourceAllocation targetAllocation nextFrame, + sourceAllocation = sourceStore.allocNode sourceWorld + (.ctorN sourceCid values.toArray) ∧ + targetAllocation = machine.store.allocNode sourceWorld + (.ctorN sourceCid values.toArray) ∧ + IxIR1.resolveAtoms source sourceArguments = .ok values ∧ + IxIR1.runCode sourceContext (sourceFuel + 1) sourceCurrent + sourceAllocation.1 (.loc sourceAllocation.2 :: source) + next.sourceCode = .ok sourceOutput ∧ + nextFrame = + { frame with + pc := frame.pc + 1 + values := frame.values.push (.loc sourceAllocation.2) } ∧ + Eval.Step context .logical machine + { machine with + store := targetAllocation.1 + control := .running nextFrame stack } ∧ + StoreRel sourceAllocation.1 targetAllocation.1 ∧ + CodeStateRel functionTrace next + (.loc sourceAllocation.2 :: source) nextFrame := by + obtain ⟨middleStore, operationValue, operationRun, continuationRun⟩ := + IxIR1.runCode_letOp_success sourceRun + obtain ⟨values, sourceResolved, operationOutput⟩ := + IxIR1.runOp_alloc_success operationRun + have middleStoreEq : middleStore = + (sourceStore.allocNode sourceWorld + (.ctorN sourceCid values.toArray)).1 := + congrArg Prod.fst operationOutput + have operationValueEq : operationValue = + .loc (sourceStore.allocNode sourceWorld + (.ctorN sourceCid values.toArray)).2 := + congrArg Prod.snd operationOutput + subst middleStore + subst operationValue + obtain ⟨_, targetStep, nextStores, nextState⟩ := + simulate_traced_alloc_checked_state + (sourceContext := sourceContext) (sourceCurrent := sourceCurrent) + (sourceFuel := sourceFuel) functionMember contextSchemas descendant state + stores sourceResolved control schemaAt ownership + exact ⟨values, + sourceStore.allocNode sourceWorld (.ctorN sourceCid values.toArray), + machine.store.allocNode sourceWorld (.ctorN sourceCid values.toArray), + { frame with + pc := frame.pc + 1 + values := frame.values.push + (.loc (sourceStore.allocNode sourceWorld + (.ctorN sourceCid values.toArray)).2) }, + rfl, rfl, sourceResolved, continuationRun, rfl, targetStep, nextStores, + nextState⟩ + +/-- Strictly under-saturated partial application allocates the same shared PAP +node in IxIR₁ and IxIR₂. The declaration premises are the function-level +context correspondence that the later whole-program induction will supply. -/ +theorem simulate_papp_fn {sourceContext : IxIR1.Ctx} + {sourceCurrent sourceDefinition : IxIR1.FnDef} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {targetDefinition : Function} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {block : Block} + {sourceStore : IxIR1.Store} {source : List RVal} + {mapping : EnvMap} + (stores : StoreRel sourceStore machine.store) + (environments : EnvRel source frame.values mapping) + {address : Ix.Compiler.Ixon.Address} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} {values : List RVal} + (arguments : AtomsRel mapping sourceArguments targetArguments) + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (sourceDeclaration : + sourceContext.decls address = some (.fn sourceDefinition)) + (targetDeclaration : + context.declarations address = some (.fn targetDefinition)) + (arity : + targetDefinition.signature.params.size = sourceDefinition.arity) + (papSafe : targetDefinition.signature.papSafe = true) + (under : values.length < sourceDefinition.arity) + (noCredits : frame.credits = #[]) + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = + .papp address targetArguments) : + let node := IxIR1.Node.papN address sourceDefinition.arity values.toArray + let sourceAllocation := sourceStore.allocNode .shared node + let targetAllocation := machine.store.allocNode .shared node + IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.papp address sourceArguments) = + .ok (sourceAllocation.1, .loc sourceAllocation.2) ∧ + Eval.Step context interpretation machine + { machine with + store := targetAllocation.1 + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values.push (.loc sourceAllocation.2) } + stack } ∧ + StoreRel sourceAllocation.1 targetAllocation.1 ∧ + EnvRel (.loc sourceAllocation.2 :: source) + (frame.values.push (.loc sourceAllocation.2)) + (#[some (.reg frame.values.size)] ++ mapping) := by + dsimp only + have targetResolved : + Eval.resolveAtoms frame.values targetArguments = .ok values.toArray := + resolveAtoms_of_envRel environments arguments sourceResolved + have targetUnder : + values.toArray.size < targetDefinition.signature.params.size := by + simpa [arity] using under + have targetStep := Eval.Step.pappFn (interpretation := interpretation) + control blockAt pc instruction noCredits targetDeclaration papSafe + targetResolved targetUnder + rw [arity] at targetStep + dsimp only at targetStep + have locationEq : + (machine.store.allocNode .shared + (.papN address sourceDefinition.arity values.toArray)).2 = + (sourceStore.allocNode .shared + (.papN address sourceDefinition.arity values.toArray)).2 := + stores.alloc_location .shared + (.papN address sourceDefinition.arity values.toArray) + rw [locationEq] at targetStep + refine ⟨?_, targetStep, + stores.alloc .shared + (.papN address sourceDefinition.arity values.toArray), + environments.bindValue + (.loc (sourceStore.allocNode .shared + (.papN address sourceDefinition.arity values.toArray)).2)⟩ + unfold IxIR1.runOp + simp only + rw [sourceResolved] + simp only [bind, Except.bind] + rw [sourceDeclaration] + unfold IxIR1.declArity + simp only + rw [if_pos under] + +/-- Trace-facing function partial application. Address/argument syntax, +instruction coordinates, successor map, and recursive state are all recovered +from the checked derivation. -/ +theorem simulate_traced_papp_fn_state {sourceContext : IxIR1.Ctx} + {sourceCurrent sourceDefinition : IxIR1.FnDef} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {targetDefinition : Function} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAddress targetAddress : Ix.Compiler.Ixon.Address} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.papp sourceAddress sourceArguments) index + (.papp targetAddress targetArguments) next)) + {sourceStore : IxIR1.Store} {source : List RVal} + {values : List RVal} + (state : CodeStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.papp sourceAddress sourceArguments) index + (.papp targetAddress targetArguments) next) source frame) + (stores : StoreRel sourceStore machine.store) + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (sourceDeclaration : + sourceContext.decls sourceAddress = some (.fn sourceDefinition)) + (targetDeclaration : + context.declarations sourceAddress = some (.fn targetDefinition)) + (arity : targetDefinition.signature.params.size = sourceDefinition.arity) + (papSafe : targetDefinition.signature.papSafe = true) + (under : values.length < sourceDefinition.arity) + (noCredits : frame.credits = #[]) + (control : machine.control = .running frame stack) : + let node := IxIR1.Node.papN sourceAddress sourceDefinition.arity + values.toArray + let sourceAllocation := sourceStore.allocNode .shared node + let targetAllocation := machine.store.allocNode .shared node + let nextFrame : Eval.Frame := + { frame with + pc := frame.pc + 1 + values := frame.values.push (.loc sourceAllocation.2) } + IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.papp sourceAddress sourceArguments) = + .ok (sourceAllocation.1, .loc sourceAllocation.2) ∧ + Eval.Step context interpretation machine + { machine with + store := targetAllocation.1 + control := .running nextFrame stack } ∧ + StoreRel sourceAllocation.1 targetAllocation.1 ∧ + CodeStateRel functionTrace next + (.loc sourceAllocation.2 :: source) nextFrame := by + dsimp only + have operationSyntax := functionTrace.descendantOperationSyntax descendant + change sourceAddress = targetAddress ∧ + Lower.InputMap.translateAtoms input sourceArguments = + some targetArguments at operationSyntax + obtain ⟨addressEq, translated⟩ := operationSyntax + subst targetAddress + have arguments : AtomsRel input sourceArguments targetArguments := + atomsRel_of_translateAtoms translated + obtain ⟨blockAt, pcBound, instructionAt⟩ := state.instructionAt descendant + have instruction : + next.headBlock.2.instructions[frame.pc] = + .papp sourceAddress targetArguments := + (Array.getElem?_eq_some_iff.mp instructionAt).2 + obtain ⟨sourceRun, targetStep, nextStores, canonical⟩ := simulate_papp_fn + stores state.environments arguments sourceResolved sourceDeclaration + targetDeclaration arity papSafe under noCredits control blockAt pcBound + instruction + have nextEnvironments := canonical.forgetTracedValue state descendant + (show Lower.Instr.baselineBinderAtom entryValueCount + (.papp sourceAddress targetArguments) = some (.reg entryValueCount) by rfl) + refine ⟨sourceRun, targetStep, nextStores, + state.letOpNext descendant rfl rfl rfl ?_ rfl nextEnvironments⟩ + simp [Lower.Instr.baselineValueDelta] + +/-- One captured PAP value is retained identically by the IxIR₁ and IxIR₂ +heap primitives. -/ +private theorem dupVals_single_simulates_retainShared + {sourceStore sourceOut : IxIR1.Store} + {targetStore : Eval.Store} {value : RVal} + (stores : StoreRel sourceStore targetStore) + (sourceRun : IxIR1.dupVals sourceStore [value] = .ok sourceOut) : + ∃ targetOut, + Eval.retainShared targetStore value = .ok targetOut ∧ + StoreRel sourceOut targetOut := by + cases value with + | lit literal => + simp [IxIR1.dupVals] at sourceRun + subst sourceOut + exact ⟨targetStore, by simp [Eval.retainShared], stores⟩ + | erased => + simp [IxIR1.dupVals] at sourceRun + subst sourceOut + exact ⟨targetStore, by simp [Eval.retainShared], stores⟩ + | loc location => + cases sourceGet : sourceStore.get? location with + | none => simp [IxIR1.dupVals, sourceGet] at sourceRun + | some box => + cases box with + | mk world rc node => + cases world with + | unique => simp [IxIR1.dupVals, sourceGet] at sourceRun + | shared => + have targetGet : targetStore.get? location = + some ⟨.shared, rc, node⟩ := by + unfold Eval.Store.get? + rw [stores.heap] + exact sourceGet + have sourceEq : + sourceOut = + (sourceStore.setBox location + ⟨.shared, rc + 1, node⟩).rcTick := by + simpa [IxIR1.dupVals, sourceGet] using sourceRun.symm + subst sourceOut + refine ⟨(targetStore.setBox location + ⟨.shared, rc + 1, node⟩).rcTick, ?_, + (stores.setBox location + ⟨.shared, rc + 1, node⟩).rcTick⟩ + simp [Eval.retainShared, targetGet] + +private theorem dupVals_cons_ok_inv {store store' : IxIR1.Store} + {head : RVal} {tail : List RVal} + (run : IxIR1.dupVals store (head :: tail) = .ok store') : + ∃ middle, + IxIR1.dupVals store [head] = .ok middle ∧ + IxIR1.dupVals middle tail = .ok store' := by + rw [show head :: tail = [head] ++ tail by rfl, IxIR1.dupVals, + List.foldlM_append] at run + change (IxIR1.dupVals store [head] >>= fun middle => + IxIR1.dupVals middle tail) = .ok store' at run + cases middleRun : IxIR1.dupVals store [head] with + | error error => + rw [middleRun] at run + simp only [bind, Except.bind] at run + contradiction + | ok middle => + refine ⟨middle, rfl, ?_⟩ + rw [middleRun] at run + simp only [bind, Except.bind] at run + exact run + +/-- IxIR₁'s PAP-capture duplication loop and IxIR₂'s retain loop produce +exactly related stores for the same ordered value vector. -/ +theorem dupVals_simulates_retainSharedMany + {sourceStore sourceOut : IxIR1.Store} + {targetStore : Eval.Store} (values : List RVal) + (stores : StoreRel sourceStore targetStore) + (sourceRun : IxIR1.dupVals sourceStore values = .ok sourceOut) : + ∃ targetOut, + Eval.RetainSharedMany targetStore values.toArray targetOut ∧ + StoreRel sourceOut targetOut := by + induction values generalizing sourceStore targetStore with + | nil => + change (.ok sourceStore : Except IxIR1.Err IxIR1.Store) = + .ok sourceOut at sourceRun + injection sourceRun with sourceEq + subst sourceOut + exact ⟨targetStore, Eval.RetainSharedMany.empty targetStore, stores⟩ + | cons value values ih => + obtain ⟨sourceMiddle, sourceFirst, sourceRest⟩ := + dupVals_cons_ok_inv sourceRun + obtain ⟨targetMiddle, targetFirst, middleStores⟩ := + dupVals_single_simulates_retainShared stores sourceFirst + obtain ⟨targetOut, targetRest, outStores⟩ := + ih middleStores sourceRest + exact ⟨targetOut, + Eval.RetainSharedMany.cons targetFirst targetRest, outStores⟩ + +private theorem PositiveSharedRC.dupValsSingle + {store out : IxIR1.Store} {value : RVal} + (positive : PositiveSharedRC store) + (run : IxIR1.dupVals store [value] = .ok out) : + PositiveSharedRC out := by + cases value with + | lit literal => + simp [IxIR1.dupVals] at run + subst out + exact positive + | erased => + simp [IxIR1.dupVals] at run + subst out + exact positive + | loc location => + cases found : store.get? location with + | none => simp [IxIR1.dupVals, found] at run + | some box => + cases box with + | mk world rc node => + cases world with + | unique => simp [IxIR1.dupVals, found] at run + | shared => + have outEq : out = + (store.setBox location + ⟨.shared, rc + 1, node⟩).rcTick := by + simpa [IxIR1.dupVals, found] using run.symm + subst out + have updated : PositiveSharedRC + (store.setBox location + ⟨.shared, rc + 1, node⟩) := by + intro other otherBox otherFound otherShared + exact positive.setRc + (location := location) + (box := (⟨.shared, rc, node⟩ : IxIR1.NodeBox)) + (newRC := rc + 1) found (Nat.zero_lt_succ rc) + otherFound otherShared + intro other otherBox otherFound otherShared + exact PositiveSharedRC.rcTick updated otherFound otherShared + +/-- Retaining a finite PAP capture preserves positive refcounts for every +live shared node. -/ +theorem PositiveSharedRC.dupVals {store out : IxIR1.Store} + (positive : PositiveSharedRC store) (values : List RVal) + (run : IxIR1.dupVals store values = .ok out) : + PositiveSharedRC out := by + induction values generalizing store with + | nil => + change (.ok store : Except IxIR1.Err IxIR1.Store) = .ok out at run + injection run with equal + subst out + exact positive + | cons value values ih => + obtain ⟨middle, first, rest⟩ := dupVals_cons_ok_inv run + exact ih (positive.dupValsSingle first) rest + +/-- The heap preparation common to every shared-PAP application branch. +IxIR₁'s ordered capture duplication and consuming PAP drop determine an exact +IxIR₂ retain loop, sufficient heap budget, release result, and both +intermediate store relations. -/ +theorem simulate_apply_pap_prepare + {sourceContext : IxIR1.Ctx} {sourceFuel location : Nat} + {sourceStore sourceRetained sourceReleased : IxIR1.Store} + {targetStore : Eval.Store} {captured : Array RVal} + (stores : StoreRel sourceStore targetStore) + (positive : PositiveSharedRC sourceStore) + (sourceRetain : + IxIR1.dupVals sourceStore captured.toList = .ok sourceRetained) + (sourceRelease : IxIR1.dropVal sourceContext sourceFuel sourceRetained + (.loc location) = .ok sourceReleased) : + ∃ (targetRetained targetReleased : Eval.Store) (targetHeapFuel : Nat), + Eval.RetainSharedMany targetStore captured targetRetained ∧ + StoreRel sourceRetained targetRetained ∧ + Eval.releaseSharedWork targetHeapFuel targetRetained [.loc location] = + .ok (targetReleased, 0) ∧ + StoreRel sourceReleased targetReleased := by + obtain ⟨targetRetained, targetRetain, retainedStores⟩ := + dupVals_simulates_retainSharedMany captured.toList stores sourceRetain + have targetRetain' : + Eval.RetainSharedMany targetStore captured targetRetained := by + simpa using targetRetain + have retainedPositive : PositiveSharedRC sourceRetained := by + intro retainedLocation retainedBox retainedGet retainedShared + exact positive.dupVals captured.toList sourceRetain retainedGet + retainedShared + obtain ⟨targetHeapFuel, targetReleased, targetRelease, releasedStores, + _⟩ := + dropVal_simulates_releaseSharedWork retainedPositive retainedStores + sourceRelease + exact ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain', + retainedStores, targetRelease, releasedStores⟩ + +/-- Direct simulation of the erased `applyGo` branch used after an +`applyMore` return. Releasing the residual source arguments determines an +exact target release budget and immediate erased resumption. -/ +theorem simulate_applyGo_erased + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {sourceStore sourceReleased : IxIR1.Store} + {targetStore : Eval.Store} {values : List RVal} + {resume : Eval.Frame} {stack : List Eval.Continuation} + (positive : PositiveSharedRC sourceStore) + (stores : StoreRel sourceStore targetStore) + (sourceRelease : IxIR1.dropMany sourceContext sourceFuel sourceStore + values = .ok sourceReleased) : + ∃ (targetHeapFuel : Nat) (targetReleased : Eval.Store), + IxIR1.applyGo sourceContext (sourceFuel + 1) sourceStore .erased values = + .ok (sourceReleased, .erased) ∧ + Eval.ApplyTransfer context interpretation targetStore targetHeapFuel + .erased values.toArray resume stack + { store := targetReleased + heapFuel := 0 + control := .running + { resume with values := resume.values.push .erased } stack } ∧ + StoreRel sourceReleased targetReleased ∧ + PositiveSharedRC sourceReleased := by + obtain ⟨targetHeapFuel, targetReleased, targetRelease, releasedStores, + releasedPositive⟩ := + dropMany_simulates_releaseSharedWork positive stores sourceRelease + have transferred := Eval.ApplyTransfer.erased + (context := context) (interpretation := interpretation) + (resume := resume) (stack := stack) (by simpa using targetRelease) + refine ⟨targetHeapFuel, targetReleased, ?_, transferred, releasedStores, + releasedPositive⟩ + rw [IxIR1.applyGo.eq_def] + dsimp only + rw [sourceRelease] + rfl + +/-- Direct simulation of the under-saturated PAP `applyGo` branch. This is +the return-time counterpart of `simulate_apply_pap_under`: it starts from an +already resolved function value and residual value list, as supplied by an +`applyMore` continuation. -/ +theorem simulate_applyGo_pap_under + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {sourceStore sourceRetained sourceReleased : IxIR1.Store} + {targetStore : Eval.Store} {location : Nat} {box : IxIR1.NodeBox} + {address : Ix.Compiler.Ixon.Address} {arity : Nat} + {captured : Array RVal} {values : List RVal} + {resume : Eval.Frame} {stack : List Eval.Continuation} + (stores : StoreRel sourceStore targetStore) + (positive : PositiveSharedRC sourceStore) + (sourceGet : sourceStore.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (sourceRetain : + IxIR1.dupVals sourceStore captured.toList = .ok sourceRetained) + (sourceRelease : IxIR1.dropVal sourceContext sourceFuel sourceRetained + (.loc location) = .ok sourceReleased) + (totalUnder : (captured.toList ++ values).length < arity) : + let pap := IxIR1.Node.papN address arity (captured ++ values.toArray) + let sourceAllocation := sourceReleased.allocNode .shared pap + ∃ (targetRetained targetReleased : Eval.Store) (targetHeapFuel : Nat), + Eval.RetainSharedMany targetStore captured targetRetained ∧ + StoreRel sourceRetained targetRetained ∧ + Eval.releaseSharedWork targetHeapFuel targetRetained [.loc location] = + .ok (targetReleased, 0) ∧ + StoreRel sourceReleased targetReleased ∧ + let targetAllocation := targetReleased.allocNode .shared pap + IxIR1.applyGo sourceContext (sourceFuel + 1) sourceStore + (.loc location) values = + .ok (sourceAllocation.1, .loc sourceAllocation.2) ∧ + Eval.ApplyTransfer context interpretation targetStore targetHeapFuel + (.loc location) values.toArray resume stack + { store := targetAllocation.1 + heapFuel := 0 + control := .running + { resume with + values := resume.values.push (.loc sourceAllocation.2) } + stack } ∧ + StoreRel sourceAllocation.1 targetAllocation.1 := by + dsimp only + obtain ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + retainedStores, targetRelease, releasedStores⟩ := + simulate_apply_pap_prepare stores positive sourceRetain sourceRelease + have targetGet : targetStore.get? location = some box := by + unfold Eval.Store.get? + rw [stores.heap] + exact sourceGet + have targetUnder : (captured ++ values.toArray).size < arity := by + simpa using totalUnder + have transferred := Eval.ApplyTransfer.papUnder + (context := context) (interpretation := interpretation) + (resume := resume) (stack := stack) targetGet shared node capturedUnder + targetRetain targetRelease targetUnder + let pap := IxIR1.Node.papN address arity (captured ++ values.toArray) + let sourceAllocation := sourceReleased.allocNode .shared pap + let targetAllocation := targetReleased.allocNode .shared pap + have locationEq : targetAllocation.2 = sourceAllocation.2 := by + exact releasedStores.alloc_location .shared pap + dsimp only at transferred + dsimp only [targetAllocation, sourceAllocation, pap] at locationEq + rw [locationEq] at transferred + have sourceRun : + IxIR1.applyGo sourceContext (sourceFuel + 1) sourceStore + (.loc location) values = + .ok (sourceAllocation.1, .loc sourceAllocation.2) := by + rw [IxIR1.applyGo.eq_def] + dsimp only + rw [sourceGet] + simp only + rw [node] + simp only + rw [sourceRetain] + simp only [bind, Except.bind] + rw [sourceRelease] + simp only + rw [if_pos totalUnder] + have payloadEq : + (captured.toList ++ values).toArray = captured ++ values.toArray := by + apply Array.toList_inj.mp + simp + rw [payloadEq] + exact ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + retainedStores, targetRelease, releasedStores, sourceRun, + by simpa [targetAllocation, sourceAllocation, pap] using transferred, + releasedStores.alloc .shared pap⟩ + +/-- Direct exact-saturation simulation for a resolved `applyGo`. It enters +the matched callee under an ordinary resume continuation and exposes the +literal source invocation equation used by recursive `applyMore` simulation. -/ +theorem simulate_applyGo_pap_saturated_enter + {sourceContext : IxIR1.Ctx} {sourceDefinition : IxIR1.FnDef} + {sourceFuel : Nat} {context : Eval.Context} + {interpretation : Eval.Interpretation} + {targetDefinition : Function} {calleeTrace : Lower.FunctionTrace} + {sourceStore sourceRetained sourceReleased : IxIR1.Store} + {targetStore : Eval.Store} {location : Nat} {box : IxIR1.NodeBox} + {address : Ix.Compiler.Ixon.Address} {arity : Nat} + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration address) sourceDefinition targetDefinition) + {captured : Array RVal} {values : List RVal} + {resume : Eval.Frame} {stack : List Eval.Continuation} + (stores : StoreRel sourceStore targetStore) + (positive : PositiveSharedRC sourceStore) + (sourceGet : sourceStore.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (sourceRetain : + IxIR1.dupVals sourceStore captured.toList = .ok sourceRetained) + (sourceRelease : IxIR1.dropVal sourceContext sourceFuel sourceRetained + (.loc location) = .ok sourceReleased) + (totalExact : (captured.toList ++ values).length = arity) + (papArity : arity = sourceDefinition.arity) + (sourceDeclaration : + sourceContext.decls address = some (.fn sourceDefinition)) + (sourcePapSafe : sourceDefinition.papSafe = true) + (targetDeclaration : + context.declarations address = some (.fn targetDefinition)) : + let sourceTotal := captured.toList ++ values + let targetTotal := captured ++ values.toArray + let calleeFrame : Eval.Frame := + { definition := targetDefinition, values := targetTotal } + ∃ (targetRetained targetReleased : Eval.Store) (targetHeapFuel : Nat), + Eval.RetainSharedMany targetStore captured targetRetained ∧ + StoreRel sourceRetained targetRetained ∧ + Eval.releaseSharedWork targetHeapFuel targetRetained [.loc location] = + .ok (targetReleased, 0) ∧ + StoreRel sourceReleased targetReleased ∧ + IxIR1.applyGo sourceContext (sourceFuel + 1) sourceStore + (.loc location) values = + IxIR1.invoke sourceContext sourceFuel address sourceTotal + sourceReleased ∧ + Eval.ApplyTransfer context interpretation targetStore targetHeapFuel + (.loc location) values.toArray resume stack + { store := targetReleased + heapFuel := 0 + control := .running calleeFrame (.resume resume :: stack) } ∧ + CodeStateRel calleeTrace calleeTrace.root sourceTotal.reverse + calleeFrame := by + dsimp only + obtain ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + retainedStores, targetRelease, releasedStores⟩ := + simulate_apply_pap_prepare stores positive sourceRetain sourceRelease + have targetGet : targetStore.get? location = some box := by + unfold Eval.Store.get? + rw [stores.heap] + exact sourceGet + let sourceTotal := captured.toList ++ values + let targetTotal := captured ++ values.toArray + have totalArrayEq : sourceTotal.toArray = targetTotal := by + apply Array.toList_inj.mp + simp [sourceTotal, targetTotal] + have targetSize : targetTotal.size = arity := by + simpa [sourceTotal, targetTotal] using totalExact + have targetPapSafe : targetDefinition.signature.papSafe = true := by + calc + targetDefinition.signature.papSafe = + calleeTrace.generated.signature.papSafe := by + rw [calleeMatch.generated] + _ = calleeTrace.source.papSafe := calleeTrace.sourcePapSafe + _ = sourceDefinition.papSafe := congrArg IxIR1.FnDef.papSafe + calleeMatch.source + _ = true := sourcePapSafe + have targetParamArity : + targetDefinition.signature.params.size = arity := by + calc + targetDefinition.signature.params.size = + calleeTrace.generated.signature.params.size := by + rw [calleeMatch.generated] + _ = calleeTrace.source.arity := calleeTrace.sourceArity + _ = sourceDefinition.arity := congrArg IxIR1.FnDef.arity + calleeMatch.source + _ = arity := papArity.symm + have suppliedEq : targetTotal.extract 0 arity = targetTotal := by + rw [← targetSize] + exact Array.extract_size + have suppliedArity : + (targetTotal.extract 0 arity).size = + targetDefinition.signature.params.size := by + rw [suppliedEq, targetSize, targetParamArity] + have targetNonempty : targetDefinition.blocks.isEmpty = false := by + simpa [calleeMatch.generated] using calleeTrace.generatedNonempty + have transferred := Eval.ApplyTransfer.papFn + (context := context) (interpretation := interpretation) + (resume := resume) (stack := stack) targetGet shared node capturedUnder + targetRetain targetRelease + (by simpa [targetTotal] using Nat.le_of_eq targetSize.symm) + targetDeclaration targetPapSafe suppliedArity targetNonempty + dsimp only at transferred + have remainingEmpty : + (targetTotal.extract arity targetTotal.size).isEmpty = true := by + simp [Array.isEmpty, Array.size_extract] + omega + rw [suppliedEq, remainingEmpty] at transferred + simp only [if_true] at transferred + have sourceRun : + IxIR1.applyGo sourceContext (sourceFuel + 1) sourceStore + (.loc location) values = + IxIR1.invoke sourceContext sourceFuel address sourceTotal + sourceReleased := by + rw [IxIR1.applyGo.eq_def] + dsimp only + rw [sourceGet] + simp only + rw [node] + simp only + rw [sourceRetain] + simp only [bind, Except.bind] + rw [sourceRelease] + simp only + rw [if_neg (by omega)] + rw [if_pos (beq_iff_eq.mpr (by + simpa [sourceTotal] using totalExact))] + rw [sourceDeclaration] + simp [IxIR1.declPapSafe, sourcePapSafe, sourceTotal] + have entryArity : targetTotal.size = calleeTrace.source.arity := by + calc + targetTotal.size = arity := targetSize + _ = sourceDefinition.arity := papArity + _ = calleeTrace.source.arity := by rw [calleeMatch.source] + have calleeState := functionEntryCodeState calleeTrace targetTotal entryArity + have sourceEnvironment : targetTotal.toList.reverse = sourceTotal.reverse := by + rw [← totalArrayEq] + rw [sourceEnvironment] at calleeState + exact ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + retainedStores, targetRelease, releasedStores, sourceRun, + by simpa [targetTotal] using transferred, + by simpa [calleeMatch.generated, sourceTotal, targetTotal] using calleeState⟩ + +/-- Direct over-saturation simulation for a resolved `applyGo`. It enters +the first matched callee under a new `applyMore` continuation and proves that +the retained target suffix is exactly the source residual argument list. -/ +theorem simulate_applyGo_pap_over_enter + {sourceContext : IxIR1.Ctx} {sourceDefinition : IxIR1.FnDef} + {sourceFuel : Nat} {context : Eval.Context} + {interpretation : Eval.Interpretation} + {targetDefinition : Function} {calleeTrace : Lower.FunctionTrace} + {sourceStore sourceRetained sourceReleased : IxIR1.Store} + {targetStore : Eval.Store} {location : Nat} {box : IxIR1.NodeBox} + {address : Ix.Compiler.Ixon.Address} {arity : Nat} + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration address) sourceDefinition targetDefinition) + {captured : Array RVal} {values : List RVal} + {resume : Eval.Frame} {stack : List Eval.Continuation} + (stores : StoreRel sourceStore targetStore) + (positive : PositiveSharedRC sourceStore) + (sourceGet : sourceStore.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (sourceRetain : + IxIR1.dupVals sourceStore captured.toList = .ok sourceRetained) + (sourceRelease : IxIR1.dropVal sourceContext sourceFuel sourceRetained + (.loc location) = .ok sourceReleased) + (totalOver : arity < (captured.toList ++ values).length) + (papArity : arity = sourceDefinition.arity) + (sourceDeclaration : + sourceContext.decls address = some (.fn sourceDefinition)) + (sourcePapSafe : sourceDefinition.papSafe = true) + (targetDeclaration : + context.declarations address = some (.fn targetDefinition)) : + let sourceTotal := captured.toList ++ values + let sourceSupplied := sourceTotal.take arity + let sourceRemaining := sourceTotal.drop arity + let targetTotal := captured ++ values.toArray + let targetSupplied := targetTotal.extract 0 arity + let targetRemaining := targetTotal.extract arity targetTotal.size + let calleeFrame : Eval.Frame := + { definition := targetDefinition, values := targetSupplied } + ∃ (targetRetained targetReleased : Eval.Store) (targetHeapFuel : Nat), + Eval.RetainSharedMany targetStore captured targetRetained ∧ + StoreRel sourceRetained targetRetained ∧ + Eval.releaseSharedWork targetHeapFuel targetRetained [.loc location] = + .ok (targetReleased, 0) ∧ + StoreRel sourceReleased targetReleased ∧ + IxIR1.applyGo sourceContext (sourceFuel + 1) sourceStore + (.loc location) values = + (do + let (nextStore, result) ← + IxIR1.invoke sourceContext sourceFuel address sourceSupplied + sourceReleased + IxIR1.applyGo sourceContext sourceFuel nextStore result + sourceRemaining) ∧ + Eval.ApplyTransfer context interpretation targetStore targetHeapFuel + (.loc location) values.toArray resume stack + { store := targetReleased + heapFuel := 0 + control := .running calleeFrame + (.applyMore targetRemaining resume :: stack) } ∧ + targetRemaining.toList = sourceRemaining ∧ + CodeStateRel calleeTrace calleeTrace.root sourceSupplied.reverse + calleeFrame := by + dsimp only + obtain ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + retainedStores, targetRelease, releasedStores⟩ := + simulate_apply_pap_prepare stores positive sourceRetain sourceRelease + have targetGet : targetStore.get? location = some box := by + unfold Eval.Store.get? + rw [stores.heap] + exact sourceGet + let sourceTotal := captured.toList ++ values + let sourceSupplied := sourceTotal.take arity + let sourceRemaining := sourceTotal.drop arity + let targetTotal := captured ++ values.toArray + let targetSupplied := targetTotal.extract 0 arity + let targetRemaining := targetTotal.extract arity targetTotal.size + have totalArrayEq : sourceTotal.toArray = targetTotal := by + apply Array.toList_inj.mp + simp [sourceTotal, targetTotal] + have targetOver : arity < targetTotal.size := by + simpa [sourceTotal, targetTotal] using totalOver + have suppliedArrayEq : targetSupplied = sourceSupplied.toArray := by + calc + targetSupplied = targetTotal.take arity := Array.take_eq_extract.symm + _ = sourceTotal.toArray.take arity := by rw [totalArrayEq] + _ = sourceSupplied.toArray := List.take_toArray + have remainingArrayEq : targetRemaining = sourceRemaining.toArray := by + calc + targetRemaining = targetTotal.extract arity := rfl + _ = sourceTotal.toArray.extract arity := by rw [totalArrayEq] + _ = sourceRemaining.toArray := List.toArray_drop.symm + have remainingListEq : targetRemaining.toList = sourceRemaining := by + rw [remainingArrayEq] + have targetPapSafe : targetDefinition.signature.papSafe = true := by + calc + targetDefinition.signature.papSafe = + calleeTrace.generated.signature.papSafe := by + rw [calleeMatch.generated] + _ = calleeTrace.source.papSafe := calleeTrace.sourcePapSafe + _ = sourceDefinition.papSafe := congrArg IxIR1.FnDef.papSafe + calleeMatch.source + _ = true := sourcePapSafe + have targetParamArity : + targetDefinition.signature.params.size = arity := by + calc + targetDefinition.signature.params.size = + calleeTrace.generated.signature.params.size := by + rw [calleeMatch.generated] + _ = calleeTrace.source.arity := calleeTrace.sourceArity + _ = sourceDefinition.arity := congrArg IxIR1.FnDef.arity + calleeMatch.source + _ = arity := papArity.symm + have suppliedSize : targetSupplied.size = arity := by + simp [targetSupplied, Array.size_extract] + omega + have suppliedArity : + targetSupplied.size = targetDefinition.signature.params.size := by + rw [suppliedSize, targetParamArity] + have targetNonempty : targetDefinition.blocks.isEmpty = false := by + simpa [calleeMatch.generated] using calleeTrace.generatedNonempty + have transferred := Eval.ApplyTransfer.papFn + (context := context) (interpretation := interpretation) + (resume := resume) (stack := stack) targetGet shared node capturedUnder + targetRetain targetRelease (Nat.le_of_lt targetOver) targetDeclaration + targetPapSafe suppliedArity targetNonempty + dsimp only at transferred + have remainingNonempty : targetRemaining.isEmpty = false := by + simp [Array.isEmpty, targetRemaining, Array.size_extract] + omega + rw [remainingNonempty] at transferred + have sourceRun : + IxIR1.applyGo sourceContext (sourceFuel + 1) sourceStore + (.loc location) values = + (do + let (nextStore, result) ← + IxIR1.invoke sourceContext sourceFuel address sourceSupplied + sourceReleased + IxIR1.applyGo sourceContext sourceFuel nextStore result + sourceRemaining) := by + rw [IxIR1.applyGo.eq_def] + dsimp only + rw [sourceGet] + simp only + rw [node] + simp only + rw [sourceRetain] + simp only [bind, Except.bind] + rw [sourceRelease] + simp only + rw [if_neg (by omega)] + rw [if_neg (by + intro exactGuard + have exactEq := beq_iff_eq.mp exactGuard + omega)] + rw [sourceDeclaration] + simp [IxIR1.declPapSafe, sourcePapSafe, sourceTotal, sourceSupplied, + sourceRemaining] + have entryArity : targetSupplied.size = calleeTrace.source.arity := by + calc + targetSupplied.size = arity := suppliedSize + _ = sourceDefinition.arity := papArity + _ = calleeTrace.source.arity := by rw [calleeMatch.source] + have calleeState := functionEntryCodeState calleeTrace targetSupplied + entryArity + have sourceEnvironment : + targetSupplied.toList.reverse = sourceSupplied.reverse := by + rw [suppliedArrayEq] + rw [sourceEnvironment] at calleeState + have calleeState' : CodeStateRel calleeTrace calleeTrace.root + sourceSupplied.reverse + { definition := targetDefinition, values := targetSupplied } := by + simpa only [calleeMatch.generated] using calleeState + exact ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + retainedStores, targetRelease, releasedStores, sourceRun, + by simpa [targetTotal, targetSupplied, targetRemaining] using transferred, + remainingListEq, calleeState'⟩ + +/-- The under-saturated dynamic-application branch is simulated without an +opaque target heap witness. IxIR₁'s capture duplication and PAP release +derive the exact IxIR₂ retain/release work, after which both sides allocate +the same longer PAP at the same fresh location. -/ +theorem simulate_apply_pap_under + {sourceContext : IxIR1.Ctx} {sourceCurrent : IxIR1.FnDef} + {sourceFuel : Nat} {context : Eval.Context} + {interpretation : Eval.Interpretation} + {sourceStore sourceRetained sourceReleased : IxIR1.Store} + {targetStore : Eval.Store} {source : List RVal} + {sourceFunction : IxIR1.Atom} + {sourceArguments : Array IxIR1.Atom} + {location : Nat} {box : IxIR1.NodeBox} + {address : Ix.Compiler.Ixon.Address} {arity : Nat} + {captured : Array RVal} {values : List RVal} + {resume : Eval.Frame} {stack : List Eval.Continuation} + (stores : StoreRel sourceStore targetStore) + (positive : PositiveSharedRC sourceStore) + (functionResolved : + IxIR1.resolveAtom source sourceFunction = .ok (.loc location)) + (argumentsResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (sourceGet : sourceStore.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (sourceRetain : + IxIR1.dupVals sourceStore captured.toList = .ok sourceRetained) + (sourceRelease : IxIR1.dropVal sourceContext sourceFuel sourceRetained + (.loc location) = .ok sourceReleased) + (totalUnder : (captured.toList ++ values).length < arity) : + let pap := IxIR1.Node.papN address arity (captured ++ values.toArray) + let sourceAllocation := sourceReleased.allocNode .shared pap + ∃ (targetRetained targetReleased : Eval.Store) (targetHeapFuel : Nat), + Eval.RetainSharedMany targetStore captured targetRetained ∧ + StoreRel sourceRetained targetRetained ∧ + Eval.releaseSharedWork targetHeapFuel targetRetained [.loc location] = + .ok (targetReleased, 0) ∧ + StoreRel sourceReleased targetReleased ∧ + let targetAllocation := targetReleased.allocNode .shared pap + IxIR1.runOp sourceContext (sourceFuel + 2) sourceCurrent sourceStore + source (.apply sourceFunction sourceArguments) = + .ok (sourceAllocation.1, .loc sourceAllocation.2) ∧ + Eval.ApplyTransfer context interpretation targetStore targetHeapFuel + (.loc location) values.toArray resume stack + { store := targetAllocation.1 + heapFuel := 0 + control := .running + { resume with + values := resume.values.push (.loc sourceAllocation.2) } + stack } ∧ + StoreRel sourceAllocation.1 targetAllocation.1 := by + dsimp only + obtain ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain', + retainedStores, targetRelease, releasedStores⟩ := + simulate_apply_pap_prepare stores positive sourceRetain sourceRelease + have targetGet : targetStore.get? location = some box := by + unfold Eval.Store.get? + rw [stores.heap] + exact sourceGet + have targetUnder : (captured ++ values.toArray).size < arity := by + simpa using totalUnder + have transferred := Eval.ApplyTransfer.papUnder + (context := context) (interpretation := interpretation) + (resume := resume) (stack := stack) + targetGet shared node capturedUnder targetRetain' targetRelease targetUnder + let pap := IxIR1.Node.papN address arity (captured ++ values.toArray) + let sourceAllocation := sourceReleased.allocNode .shared pap + let targetAllocation := targetReleased.allocNode .shared pap + have locationEq : targetAllocation.2 = sourceAllocation.2 := by + exact releasedStores.alloc_location .shared pap + dsimp only at transferred + dsimp only [targetAllocation, sourceAllocation, pap] at locationEq + rw [locationEq] at transferred + have sourceRun : + IxIR1.runOp sourceContext (sourceFuel + 2) sourceCurrent sourceStore + source (.apply sourceFunction sourceArguments) = + .ok (sourceAllocation.1, .loc sourceAllocation.2) := by + rw [IxIR1.runOp.eq_def] + dsimp only + rw [functionResolved] + simp only [bind, Except.bind] + rw [argumentsResolved] + simp only + rw [IxIR1.applyGo.eq_def] + dsimp only + rw [sourceGet] + simp only + rw [node] + simp only + rw [sourceRetain] + simp only [bind, Except.bind] + rw [sourceRelease] + simp only + rw [if_pos totalUnder] + have payloadEq : + (captured.toList ++ values).toArray = captured ++ values.toArray := by + apply Array.toList_inj.mp + simp + rw [payloadEq] + exact ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain', + retainedStores, targetRelease, releasedStores, sourceRun, + by simpa [targetAllocation, sourceAllocation, pap] using transferred, + releasedStores.alloc .shared pap⟩ + +/-- Exact saturation exposes the literal IxIR₁ invocation equation while the +IxIR₂ dispatcher enters the matched callee root under an ordinary resume +continuation. PAP capture retains and the consuming old-PAP release are +derived from the source heap operations rather than supplied as target +witnesses. -/ +theorem simulate_apply_pap_saturated_enter + {sourceContext : IxIR1.Ctx} + {sourceCurrent sourceDefinition : IxIR1.FnDef} + {sourceFuel : Nat} {context : Eval.Context} + {interpretation : Eval.Interpretation} + {targetDefinition : Function} {calleeTrace : Lower.FunctionTrace} + {sourceStore sourceRetained sourceReleased : IxIR1.Store} + {targetStore : Eval.Store} {source : List RVal} + {sourceFunction : IxIR1.Atom} + {sourceArguments : Array IxIR1.Atom} + {location : Nat} {box : IxIR1.NodeBox} + {address : Ix.Compiler.Ixon.Address} {arity : Nat} + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration address) sourceDefinition targetDefinition) + {captured : Array RVal} {values : List RVal} + {resume : Eval.Frame} {stack : List Eval.Continuation} + (stores : StoreRel sourceStore targetStore) + (positive : PositiveSharedRC sourceStore) + (functionResolved : + IxIR1.resolveAtom source sourceFunction = .ok (.loc location)) + (argumentsResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (sourceGet : sourceStore.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (sourceRetain : + IxIR1.dupVals sourceStore captured.toList = .ok sourceRetained) + (sourceRelease : IxIR1.dropVal sourceContext sourceFuel sourceRetained + (.loc location) = .ok sourceReleased) + (totalExact : (captured.toList ++ values).length = arity) + (papArity : arity = sourceDefinition.arity) + (sourceDeclaration : + sourceContext.decls address = some (.fn sourceDefinition)) + (sourcePapSafe : sourceDefinition.papSafe = true) + (targetDeclaration : + context.declarations address = some (.fn targetDefinition)) : + let sourceTotal := captured.toList ++ values + let targetTotal := captured ++ values.toArray + let calleeFrame : Eval.Frame := + { definition := targetDefinition, values := targetTotal } + ∃ (targetRetained targetReleased : Eval.Store) (targetHeapFuel : Nat), + Eval.RetainSharedMany targetStore captured targetRetained ∧ + StoreRel sourceRetained targetRetained ∧ + Eval.releaseSharedWork targetHeapFuel targetRetained [.loc location] = + .ok (targetReleased, 0) ∧ + StoreRel sourceReleased targetReleased ∧ + IxIR1.runOp sourceContext (sourceFuel + 2) sourceCurrent sourceStore + source (.apply sourceFunction sourceArguments) = + IxIR1.invoke sourceContext sourceFuel address sourceTotal + sourceReleased ∧ + Eval.ApplyTransfer context interpretation targetStore targetHeapFuel + (.loc location) values.toArray resume stack + { store := targetReleased + heapFuel := 0 + control := .running calleeFrame (.resume resume :: stack) } ∧ + CodeStateRel calleeTrace calleeTrace.root sourceTotal.reverse + calleeFrame := by + dsimp only + obtain ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + retainedStores, targetRelease, releasedStores⟩ := + simulate_apply_pap_prepare stores positive sourceRetain sourceRelease + have targetGet : targetStore.get? location = some box := by + unfold Eval.Store.get? + rw [stores.heap] + exact sourceGet + let sourceTotal := captured.toList ++ values + let targetTotal := captured ++ values.toArray + have totalArrayEq : sourceTotal.toArray = targetTotal := by + apply Array.toList_inj.mp + simp [sourceTotal, targetTotal] + have targetSize : targetTotal.size = arity := by + simpa [sourceTotal, targetTotal] using totalExact + have targetPapSafe : targetDefinition.signature.papSafe = true := by + calc + targetDefinition.signature.papSafe = + calleeTrace.generated.signature.papSafe := by + rw [calleeMatch.generated] + _ = calleeTrace.source.papSafe := calleeTrace.sourcePapSafe + _ = sourceDefinition.papSafe := congrArg IxIR1.FnDef.papSafe + calleeMatch.source + _ = true := sourcePapSafe + have targetParamArity : + targetDefinition.signature.params.size = arity := by + calc + targetDefinition.signature.params.size = + calleeTrace.generated.signature.params.size := by + rw [calleeMatch.generated] + _ = calleeTrace.source.arity := calleeTrace.sourceArity + _ = sourceDefinition.arity := congrArg IxIR1.FnDef.arity + calleeMatch.source + _ = arity := papArity.symm + have suppliedEq : targetTotal.extract 0 arity = targetTotal := by + rw [← targetSize] + exact Array.extract_size + have suppliedArity : + (targetTotal.extract 0 arity).size = + targetDefinition.signature.params.size := by + rw [suppliedEq, targetSize, targetParamArity] + have targetNonempty : targetDefinition.blocks.isEmpty = false := by + simpa [calleeMatch.generated] using calleeTrace.generatedNonempty + have transferred := Eval.ApplyTransfer.papFn + (context := context) (interpretation := interpretation) + (resume := resume) (stack := stack) + targetGet shared node capturedUnder targetRetain targetRelease + (by simpa [targetTotal] using Nat.le_of_eq targetSize.symm) + targetDeclaration targetPapSafe suppliedArity + targetNonempty + dsimp only at transferred + have remainingEmpty : + (targetTotal.extract arity targetTotal.size).isEmpty = true := by + simp [Array.isEmpty, Array.size_extract] + omega + rw [suppliedEq, remainingEmpty] at transferred + simp only [if_true] at transferred + have sourceRun : + IxIR1.runOp sourceContext (sourceFuel + 2) sourceCurrent sourceStore + source (.apply sourceFunction sourceArguments) = + IxIR1.invoke sourceContext sourceFuel address sourceTotal + sourceReleased := by + rw [IxIR1.runOp.eq_def] + dsimp only + rw [functionResolved] + simp only [bind, Except.bind] + rw [argumentsResolved] + simp only + rw [IxIR1.applyGo.eq_def] + dsimp only + rw [sourceGet] + simp only + rw [node] + simp only + rw [sourceRetain] + simp only [bind, Except.bind] + rw [sourceRelease] + simp only + rw [if_neg (by omega)] + rw [if_pos (beq_iff_eq.mpr (by simpa [sourceTotal] using totalExact))] + rw [sourceDeclaration] + simp [IxIR1.declPapSafe, sourcePapSafe, sourceTotal] + have entryArity : targetTotal.size = calleeTrace.source.arity := by + calc + targetTotal.size = arity := targetSize + _ = sourceDefinition.arity := papArity + _ = calleeTrace.source.arity := by rw [calleeMatch.source] + have calleeState := functionEntryCodeState calleeTrace targetTotal entryArity + have sourceEnvironment : targetTotal.toList.reverse = sourceTotal.reverse := by + rw [← totalArrayEq] + rw [sourceEnvironment] at calleeState + exact ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + retainedStores, targetRelease, releasedStores, sourceRun, + by simpa [targetTotal] using transferred, + by simpa [calleeMatch.generated, sourceTotal, targetTotal] using calleeState⟩ + +/-- Over-application exposes the IxIR₁ invoke-then-apply equation and enters +the same matched target callee under an explicit `applyMore` continuation. +The residual target vector is proved to be exactly the source `drop` suffix, +which is the induction hand-off when the callee later returns. -/ +theorem simulate_apply_pap_over_enter + {sourceContext : IxIR1.Ctx} + {sourceCurrent sourceDefinition : IxIR1.FnDef} + {sourceFuel : Nat} {context : Eval.Context} + {interpretation : Eval.Interpretation} + {targetDefinition : Function} {calleeTrace : Lower.FunctionTrace} + {sourceStore sourceRetained sourceReleased : IxIR1.Store} + {targetStore : Eval.Store} {source : List RVal} + {sourceFunction : IxIR1.Atom} + {sourceArguments : Array IxIR1.Atom} + {location : Nat} {box : IxIR1.NodeBox} + {address : Ix.Compiler.Ixon.Address} {arity : Nat} + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration address) sourceDefinition targetDefinition) + {captured : Array RVal} {values : List RVal} + {resume : Eval.Frame} {stack : List Eval.Continuation} + (stores : StoreRel sourceStore targetStore) + (positive : PositiveSharedRC sourceStore) + (functionResolved : + IxIR1.resolveAtom source sourceFunction = .ok (.loc location)) + (argumentsResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (sourceGet : sourceStore.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (sourceRetain : + IxIR1.dupVals sourceStore captured.toList = .ok sourceRetained) + (sourceRelease : IxIR1.dropVal sourceContext sourceFuel sourceRetained + (.loc location) = .ok sourceReleased) + (totalOver : arity < (captured.toList ++ values).length) + (papArity : arity = sourceDefinition.arity) + (sourceDeclaration : + sourceContext.decls address = some (.fn sourceDefinition)) + (sourcePapSafe : sourceDefinition.papSafe = true) + (targetDeclaration : + context.declarations address = some (.fn targetDefinition)) : + let sourceTotal := captured.toList ++ values + let sourceSupplied := sourceTotal.take arity + let sourceRemaining := sourceTotal.drop arity + let targetTotal := captured ++ values.toArray + let targetSupplied := targetTotal.extract 0 arity + let targetRemaining := targetTotal.extract arity targetTotal.size + let calleeFrame : Eval.Frame := + { definition := targetDefinition, values := targetSupplied } + ∃ (targetRetained targetReleased : Eval.Store) (targetHeapFuel : Nat), + Eval.RetainSharedMany targetStore captured targetRetained ∧ + StoreRel sourceRetained targetRetained ∧ + Eval.releaseSharedWork targetHeapFuel targetRetained [.loc location] = + .ok (targetReleased, 0) ∧ + StoreRel sourceReleased targetReleased ∧ + IxIR1.runOp sourceContext (sourceFuel + 2) sourceCurrent sourceStore + source (.apply sourceFunction sourceArguments) = + (do + let (nextStore, result) ← + IxIR1.invoke sourceContext sourceFuel address sourceSupplied + sourceReleased + IxIR1.applyGo sourceContext sourceFuel nextStore result + sourceRemaining) ∧ + Eval.ApplyTransfer context interpretation targetStore targetHeapFuel + (.loc location) values.toArray resume stack + { store := targetReleased + heapFuel := 0 + control := .running calleeFrame + (.applyMore targetRemaining resume :: stack) } ∧ + targetRemaining.toList = sourceRemaining ∧ + CodeStateRel calleeTrace calleeTrace.root sourceSupplied.reverse + calleeFrame := by + dsimp only + obtain ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + retainedStores, targetRelease, releasedStores⟩ := + simulate_apply_pap_prepare stores positive sourceRetain sourceRelease + have targetGet : targetStore.get? location = some box := by + unfold Eval.Store.get? + rw [stores.heap] + exact sourceGet + let sourceTotal := captured.toList ++ values + let sourceSupplied := sourceTotal.take arity + let sourceRemaining := sourceTotal.drop arity + let targetTotal := captured ++ values.toArray + let targetSupplied := targetTotal.extract 0 arity + let targetRemaining := targetTotal.extract arity targetTotal.size + have totalArrayEq : sourceTotal.toArray = targetTotal := by + apply Array.toList_inj.mp + simp [sourceTotal, targetTotal] + have targetOver : arity < targetTotal.size := by + simpa [sourceTotal, targetTotal] using totalOver + have suppliedArrayEq : targetSupplied = sourceSupplied.toArray := by + calc + targetSupplied = targetTotal.take arity := Array.take_eq_extract.symm + _ = sourceTotal.toArray.take arity := by rw [totalArrayEq] + _ = sourceSupplied.toArray := List.take_toArray + have remainingArrayEq : targetRemaining = sourceRemaining.toArray := by + calc + targetRemaining = targetTotal.extract arity := rfl + _ = sourceTotal.toArray.extract arity := by rw [totalArrayEq] + _ = sourceRemaining.toArray := List.toArray_drop.symm + have remainingListEq : targetRemaining.toList = sourceRemaining := by + rw [remainingArrayEq] + have targetPapSafe : targetDefinition.signature.papSafe = true := by + calc + targetDefinition.signature.papSafe = + calleeTrace.generated.signature.papSafe := by + rw [calleeMatch.generated] + _ = calleeTrace.source.papSafe := calleeTrace.sourcePapSafe + _ = sourceDefinition.papSafe := congrArg IxIR1.FnDef.papSafe + calleeMatch.source + _ = true := sourcePapSafe + have targetParamArity : + targetDefinition.signature.params.size = arity := by + calc + targetDefinition.signature.params.size = + calleeTrace.generated.signature.params.size := by + rw [calleeMatch.generated] + _ = calleeTrace.source.arity := calleeTrace.sourceArity + _ = sourceDefinition.arity := congrArg IxIR1.FnDef.arity + calleeMatch.source + _ = arity := papArity.symm + have suppliedSize : targetSupplied.size = arity := by + simp [targetSupplied, Array.size_extract] + omega + have suppliedArity : + targetSupplied.size = targetDefinition.signature.params.size := by + rw [suppliedSize, targetParamArity] + have targetNonempty : targetDefinition.blocks.isEmpty = false := by + simpa [calleeMatch.generated] using calleeTrace.generatedNonempty + have transferred := Eval.ApplyTransfer.papFn + (context := context) (interpretation := interpretation) + (resume := resume) (stack := stack) + targetGet shared node capturedUnder targetRetain targetRelease + (Nat.le_of_lt targetOver) targetDeclaration targetPapSafe suppliedArity + targetNonempty + dsimp only at transferred + have remainingNonempty : targetRemaining.isEmpty = false := by + simp [Array.isEmpty, targetRemaining, Array.size_extract] + omega + rw [remainingNonempty] at transferred + have sourceRun : + IxIR1.runOp sourceContext (sourceFuel + 2) sourceCurrent sourceStore + source (.apply sourceFunction sourceArguments) = + (do + let (nextStore, result) ← + IxIR1.invoke sourceContext sourceFuel address sourceSupplied + sourceReleased + IxIR1.applyGo sourceContext sourceFuel nextStore result + sourceRemaining) := by + rw [IxIR1.runOp.eq_def] + dsimp only + rw [functionResolved] + simp only [bind, Except.bind] + rw [argumentsResolved] + simp only + rw [IxIR1.applyGo.eq_def] + dsimp only + rw [sourceGet] + simp only + rw [node] + simp only + rw [sourceRetain] + simp only [bind, Except.bind] + rw [sourceRelease] + simp only + rw [if_neg (by omega)] + rw [if_neg (by + intro exactGuard + have exactEq := beq_iff_eq.mp exactGuard + omega)] + rw [sourceDeclaration] + simp [IxIR1.declPapSafe, sourcePapSafe, sourceTotal, sourceSupplied, + sourceRemaining] + have entryArity : targetSupplied.size = calleeTrace.source.arity := by + calc + targetSupplied.size = arity := suppliedSize + _ = sourceDefinition.arity := papArity + _ = calleeTrace.source.arity := by rw [calleeMatch.source] + have calleeState := functionEntryCodeState calleeTrace targetSupplied + entryArity + have sourceEnvironment : + targetSupplied.toList.reverse = sourceSupplied.reverse := by + rw [suppliedArrayEq] + rw [sourceEnvironment] at calleeState + have calleeState' : CodeStateRel calleeTrace calleeTrace.root + sourceSupplied.reverse + { definition := targetDefinition, values := targetSupplied } := by + simpa only [calleeMatch.generated] using calleeState + exact ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + retainedStores, targetRelease, releasedStores, sourceRun, + by simpa [targetTotal, targetSupplied, targetRemaining] using transferred, + remainingListEq, + calleeState'⟩ + +/-- Trace-facing dynamic-application dispatch. The checked derivation +supplies both translated operand families and the exact instruction +coordinate. `ApplyTransfer` then selects the evaluator's immediate, exact +call, or over-application path while the second conclusion retains the exact +caller continuation state established whenever that path ultimately resumes +with a value. -/ +theorem simulate_traced_apply_transfer_state + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine target : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceFunction : IxIR1.Atom} {targetFunction : Atom} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next)) + {source : List RVal} {function : RVal} {values : List RVal} + (state : CodeStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) source frame) + (sourceFunctionResolved : + IxIR1.resolveAtom source sourceFunction = .ok function) + (sourceArgumentsResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (noCredits : frame.credits = #[]) + (control : machine.control = .running frame stack) + (transferred : Eval.ApplyTransfer context interpretation machine.store + machine.heapFuel function values.toArray + { frame with pc := frame.pc + 1 } stack target) : + Eval.Step context interpretation machine target ∧ + ∀ value, + CodeStateRel functionTrace next (value :: source) + { frame with + pc := frame.pc + 1 + values := frame.values.push value } := by + have operationSyntax := functionTrace.descendantOperationSyntax descendant + change Lower.InputMap.translateAtom input sourceFunction = + some targetFunction ∧ + Lower.InputMap.translateAtoms input sourceArguments = + some targetArguments at operationSyntax + obtain ⟨functionTranslated, argumentsTranslated⟩ := operationSyntax + have arguments : AtomsRel input sourceArguments targetArguments := + atomsRel_of_translateAtoms argumentsTranslated + have targetFunctionResolved : + Eval.resolveAtom frame.values targetFunction = .ok function := + resolveAtom_of_envRel state.environments functionTranslated + sourceFunctionResolved + have targetArgumentsResolved : + Eval.resolveAtoms frame.values targetArguments = .ok values.toArray := + resolveAtoms_of_envRel state.environments arguments + sourceArgumentsResolved + obtain ⟨blockAt, pcBound, instructionAt⟩ := state.instructionAt descendant + have instruction : + next.headBlock.2.instructions[frame.pc] = + .apply targetFunction targetArguments := + (Array.getElem?_eq_some_iff.mp instructionAt).2 + constructor + · exact Eval.Step.apply control blockAt pcBound instruction noCredits + targetFunctionResolved targetArgumentsResolved transferred + · intro value + exact state.letOpValueNext descendant rfl rfl value + +/-- Trace-facing exact saturation combines the source invocation equation, +derived PAP heap preparation, the emitted `apply` step, exact callee-root +state, and the caller state that an ordinary resumed return must establish. -/ +theorem simulate_traced_apply_pap_saturated_enter_state + {sourceContext : IxIR1.Ctx} + {sourceCurrent sourceDefinition : IxIR1.FnDef} + {sourceFuel : Nat} {context : Eval.Context} + {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {callerTrace calleeTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceFunction : IxIR1.Atom} {targetFunction : Atom} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : callerTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next)) + {targetDefinition : Function} + {sourceStore sourceRetained sourceReleased : IxIR1.Store} + {source : List RVal} {location : Nat} {box : IxIR1.NodeBox} + {address : Ix.Compiler.Ixon.Address} {arity : Nat} + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration address) sourceDefinition targetDefinition) + {captured : Array RVal} {values : List RVal} + (state : CodeStateRel callerTrace + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) source frame) + (stores : StoreRel sourceStore machine.store) + (positive : PositiveSharedRC sourceStore) + (functionResolved : + IxIR1.resolveAtom source sourceFunction = .ok (.loc location)) + (argumentsResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (sourceGet : sourceStore.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (sourceRetain : + IxIR1.dupVals sourceStore captured.toList = .ok sourceRetained) + (sourceRelease : IxIR1.dropVal sourceContext sourceFuel sourceRetained + (.loc location) = .ok sourceReleased) + (totalExact : (captured.toList ++ values).length = arity) + (papArity : arity = sourceDefinition.arity) + (sourceDeclaration : + sourceContext.decls address = some (.fn sourceDefinition)) + (sourcePapSafe : sourceDefinition.papSafe = true) + (targetDeclaration : + context.declarations address = some (.fn targetDefinition)) + (noCredits : frame.credits = #[]) + (control : machine.control = .running frame stack) : + let sourceTotal := captured.toList ++ values + let targetTotal := captured ++ values.toArray + let resume : Eval.Frame := { frame with pc := frame.pc + 1 } + let calleeFrame : Eval.Frame := + { definition := targetDefinition, values := targetTotal } + let targetMachine : Eval.Machine := + { store := machine.store + heapFuel := 0 + control := .running calleeFrame (.resume resume :: stack) } + ∃ (targetRetained targetReleased : Eval.Store) (targetHeapFuel : Nat), + Eval.RetainSharedMany machine.store captured targetRetained ∧ + StoreRel sourceRetained targetRetained ∧ + Eval.releaseSharedWork targetHeapFuel targetRetained [.loc location] = + .ok (targetReleased, 0) ∧ + StoreRel sourceReleased targetReleased ∧ + IxIR1.runOp sourceContext (sourceFuel + 2) sourceCurrent sourceStore + source (.apply sourceFunction sourceArguments) = + IxIR1.invoke sourceContext sourceFuel address sourceTotal + sourceReleased ∧ + Eval.Step context interpretation + { machine with heapFuel := targetHeapFuel } + { targetMachine with store := targetReleased } ∧ + CodeStateRel calleeTrace calleeTrace.root sourceTotal.reverse + calleeFrame ∧ + ∀ value, + CodeStateRel callerTrace next (value :: source) + { frame with + pc := frame.pc + 1 + values := frame.values.push value } := by + dsimp only + obtain ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + retainedStores, targetRelease, releasedStores, sourceRun, transferred, + calleeState⟩ := + simulate_apply_pap_saturated_enter + (resume := { frame with pc := frame.pc + 1 }) calleeMatch stores positive + functionResolved argumentsResolved sourceGet shared node capturedUnder + sourceRetain sourceRelease totalExact papArity sourceDeclaration + sourcePapSafe targetDeclaration + have beforeControl : + ({ machine with heapFuel := targetHeapFuel } : Eval.Machine).control = + .running frame stack := by + simpa using control + obtain ⟨targetStep, callerState⟩ := + simulate_traced_apply_transfer_state descendant state functionResolved + argumentsResolved noCredits beforeControl transferred + exact ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + retainedStores, targetRelease, releasedStores, sourceRun, targetStep, + calleeState, callerState⟩ + +/-- Trace-facing over-application combines the source invoke-then-apply +equation with the emitted entry step, exact callee-root state, and residual +argument identity needed by the later `retApplyMore` transition. -/ +theorem simulate_traced_apply_pap_over_enter_state + {sourceContext : IxIR1.Ctx} + {sourceCurrent sourceDefinition : IxIR1.FnDef} + {sourceFuel : Nat} {context : Eval.Context} + {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {callerTrace calleeTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceFunction : IxIR1.Atom} {targetFunction : Atom} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : callerTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next)) + {targetDefinition : Function} + {sourceStore sourceRetained sourceReleased : IxIR1.Store} + {source : List RVal} {location : Nat} {box : IxIR1.NodeBox} + {address : Ix.Compiler.Ixon.Address} {arity : Nat} + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration address) sourceDefinition targetDefinition) + {captured : Array RVal} {values : List RVal} + (state : CodeStateRel callerTrace + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) source frame) + (stores : StoreRel sourceStore machine.store) + (positive : PositiveSharedRC sourceStore) + (functionResolved : + IxIR1.resolveAtom source sourceFunction = .ok (.loc location)) + (argumentsResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (sourceGet : sourceStore.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (sourceRetain : + IxIR1.dupVals sourceStore captured.toList = .ok sourceRetained) + (sourceRelease : IxIR1.dropVal sourceContext sourceFuel sourceRetained + (.loc location) = .ok sourceReleased) + (totalOver : arity < (captured.toList ++ values).length) + (papArity : arity = sourceDefinition.arity) + (sourceDeclaration : + sourceContext.decls address = some (.fn sourceDefinition)) + (sourcePapSafe : sourceDefinition.papSafe = true) + (targetDeclaration : + context.declarations address = some (.fn targetDefinition)) + (noCredits : frame.credits = #[]) + (control : machine.control = .running frame stack) : + let sourceTotal := captured.toList ++ values + let sourceSupplied := sourceTotal.take arity + let sourceRemaining := sourceTotal.drop arity + let targetTotal := captured ++ values.toArray + let targetSupplied := targetTotal.extract 0 arity + let targetRemaining := targetTotal.extract arity targetTotal.size + let resume : Eval.Frame := { frame with pc := frame.pc + 1 } + let calleeFrame : Eval.Frame := + { definition := targetDefinition, values := targetSupplied } + let targetMachine : Eval.Machine := + { store := machine.store + heapFuel := 0 + control := .running calleeFrame + (.applyMore targetRemaining resume :: stack) } + ∃ (targetRetained targetReleased : Eval.Store) (targetHeapFuel : Nat), + Eval.RetainSharedMany machine.store captured targetRetained ∧ + StoreRel sourceRetained targetRetained ∧ + Eval.releaseSharedWork targetHeapFuel targetRetained [.loc location] = + .ok (targetReleased, 0) ∧ + StoreRel sourceReleased targetReleased ∧ + IxIR1.runOp sourceContext (sourceFuel + 2) sourceCurrent sourceStore + source (.apply sourceFunction sourceArguments) = + (do + let (nextStore, result) ← + IxIR1.invoke sourceContext sourceFuel address sourceSupplied + sourceReleased + IxIR1.applyGo sourceContext sourceFuel nextStore result + sourceRemaining) ∧ + Eval.Step context interpretation + { machine with heapFuel := targetHeapFuel } + { targetMachine with store := targetReleased } ∧ + targetRemaining.toList = sourceRemaining ∧ + CodeStateRel calleeTrace calleeTrace.root sourceSupplied.reverse + calleeFrame ∧ + ∀ value, + CodeStateRel callerTrace next (value :: source) + { frame with + pc := frame.pc + 1 + values := frame.values.push value } := by + dsimp only + obtain ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + retainedStores, targetRelease, releasedStores, sourceRun, transferred, + remainingEq, calleeState⟩ := + simulate_apply_pap_over_enter + (resume := { frame with pc := frame.pc + 1 }) calleeMatch stores positive + functionResolved argumentsResolved sourceGet shared node capturedUnder + sourceRetain sourceRelease totalOver papArity sourceDeclaration + sourcePapSafe targetDeclaration + have beforeControl : + ({ machine with heapFuel := targetHeapFuel } : Eval.Machine).control = + .running frame stack := by + simpa using control + obtain ⟨targetStep, callerState⟩ := + simulate_traced_apply_transfer_state descendant state functionResolved + argumentsResolved noCredits beforeControl transferred + exact ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + retainedStores, targetRelease, releasedStores, sourceRun, targetStep, + remainingEq, calleeState, callerState⟩ + +/-- A saturated addressed source call reduces to argument resolution followed +by `invoke`. Exposing this equation keeps the recursive simulation from +unfolding `runOp` at every call site. -/ +theorem source_runOp_call_eq + {sourceContext : IxIR1.Ctx} {sourceCurrent : IxIR1.FnDef} + {sourceFuel : Nat} {sourceStore : IxIR1.Store} + {source : List RVal} {address : Ix.Compiler.Ixon.Address} + {sourceArguments : Array IxIR1.Atom} {values : List RVal} + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) : + IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.call address sourceArguments) = + IxIR1.invoke sourceContext sourceFuel address values sourceStore := by + rw [IxIR1.runOp.eq_def] + simp only + rw [sourceResolved] + rfl + +/-- A saturated source self-call reduces to the current body and its dynamic +result-world check. -/ +theorem source_runOp_callSelf_eq + {sourceContext : IxIR1.Ctx} {sourceCurrent : IxIR1.FnDef} + {sourceFuel : Nat} {sourceStore : IxIR1.Store} + {source : List RVal} + {sourceArguments : Array IxIR1.Atom} {values : List RVal} + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (argumentArity : sourceCurrent.arity = values.length) : + IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.callSelf sourceArguments) = (do + let out ← IxIR1.runCode sourceContext sourceFuel sourceCurrent + sourceStore values.reverse sourceCurrent.body + IxIR1.checkResultWorld sourceCurrent.result out) := by + rw [IxIR1.runOp.eq_def] + simp only + rw [sourceResolved] + simp only [bind, Except.bind] + rw [argumentArity] + simp + +/-- The compiler-recognized tail-call shell is observationally just the +addressed invocation; its trailing `ret (.var 0)` contributes no result +change and consumes the second source fuel layer. -/ +theorem source_runCode_tail_call_eq + {sourceContext : IxIR1.Ctx} {sourceCurrent : IxIR1.FnDef} + {sourceFuel : Nat} {sourceStore : IxIR1.Store} + {source : List RVal} {address : Ix.Compiler.Ixon.Address} + {sourceArguments : Array IxIR1.Atom} {values : List RVal} + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) : + IxIR1.runCode sourceContext (sourceFuel + 2) sourceCurrent sourceStore + source (.letOp (.call address sourceArguments) (.ret (.var 0))) = + IxIR1.invoke sourceContext sourceFuel address values sourceStore := by + rw [IxIR1.runCode.eq_def] + simp only + rw [source_runOp_call_eq sourceResolved] + cases invokeRun : + IxIR1.invoke sourceContext sourceFuel address values sourceStore with + | error error => rfl + | ok output => + rcases output with ⟨nextStore, value⟩ + simp only [bind, Except.bind] + rw [IxIR1.runCode.eq_def] + rfl + +/-- The self-tail-call shell likewise reduces to the current function body +and its result-world check without retaining an extra source continuation. -/ +theorem source_runCode_tail_callSelf_eq + {sourceContext : IxIR1.Ctx} {sourceCurrent : IxIR1.FnDef} + {sourceFuel : Nat} {sourceStore : IxIR1.Store} + {source : List RVal} + {sourceArguments : Array IxIR1.Atom} {values : List RVal} + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (argumentArity : sourceCurrent.arity = values.length) : + IxIR1.runCode sourceContext (sourceFuel + 2) sourceCurrent sourceStore + source (.letOp (.callSelf sourceArguments) (.ret (.var 0))) = (do + let out ← IxIR1.runCode sourceContext sourceFuel sourceCurrent + sourceStore values.reverse sourceCurrent.body + IxIR1.checkResultWorld sourceCurrent.result out) := by + rw [IxIR1.runCode.eq_def] + simp only + rw [source_runOp_callSelf_eq sourceResolved argumentArity] + cases callRun : (do + let out ← IxIR1.runCode sourceContext sourceFuel sourceCurrent + sourceStore values.reverse sourceCurrent.body + IxIR1.checkResultWorld sourceCurrent.result out) with + | error error => rfl + | ok output => + rcases output with ⟨nextStore, value⟩ + simp only [bind, Except.bind] + rw [IxIR1.runCode.eq_def] + rfl + +/-- A direct-call instruction resolves the same argument vector, enters the +addressed target function in one step, and establishes its canonical reversed +source-parameter environment. The function-body induction supplies the +subsequent execution under the pushed continuation. -/ +theorem simulate_call_fn_enter {context : Eval.Context} + {interpretation : Eval.Interpretation} {machine : Eval.Machine} + {frame : Eval.Frame} {stack : List Eval.Continuation} {block : Block} + {source : List RVal} {mapping : EnvMap} + (environments : EnvRel source frame.values mapping) + {address : Ix.Compiler.Ixon.Address} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} {values : List RVal} + {definition : Function} + (arguments : AtomsRel mapping sourceArguments targetArguments) + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (declaration : context.declarations address = some (.fn definition)) + (arity : definition.signature.params.size = values.length) + (nonempty : definition.blocks.isEmpty = false) + (noCredits : frame.credits = #[]) + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = + .call address targetArguments) : + Eval.Step context interpretation machine + { machine with + control := .running + { definition, values := values.toArray } + (.resume { frame with pc := frame.pc + 1 } :: stack) } ∧ + EnvRel values.reverse values.toArray (entryMap values.length) := by + have targetResolved : + Eval.resolveAtoms frame.values targetArguments = .ok values.toArray := + resolveAtoms_of_envRel environments arguments sourceResolved + have targetArity : + values.toArray.size = definition.signature.params.size := by + simp [arity] + exact ⟨Eval.Step.callFn control blockAt pc instruction noCredits + targetResolved declaration targetArity nonempty, + EnvRel.entry values.toArray⟩ + +/-- A recursive self-call has the same entry relation as an addressed call. -/ +theorem simulate_call_self_enter {context : Eval.Context} + {interpretation : Eval.Interpretation} {machine : Eval.Machine} + {frame : Eval.Frame} {stack : List Eval.Continuation} {block : Block} + {source : List RVal} {mapping : EnvMap} + (environments : EnvRel source frame.values mapping) + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} {values : List RVal} + (arguments : AtomsRel mapping sourceArguments targetArguments) + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (arity : frame.definition.signature.params.size = values.length) + (nonempty : frame.definition.blocks.isEmpty = false) + (noCredits : frame.credits = #[]) + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc < block.instructions.size) + (instruction : block.instructions[frame.pc] = + .callSelf targetArguments) : + Eval.Step context interpretation machine + { machine with + control := .running + { definition := frame.definition, values := values.toArray } + (.resume { frame with pc := frame.pc + 1 } :: stack) } ∧ + EnvRel values.reverse values.toArray (entryMap values.length) := by + have targetResolved : + Eval.resolveAtoms frame.values targetArguments = .ok values.toArray := + resolveAtoms_of_envRel environments arguments sourceResolved + have targetArity : + values.toArray.size = frame.definition.signature.params.size := by + simp [arity] + exact ⟨Eval.Step.callSelf control blockAt pc instruction noCredits + targetResolved targetArity nonempty, + EnvRel.entry values.toArray⟩ + +/-- Trace-facing addressed call entry. The caller trace supplies emitted call +syntax and coordinates; an exact callee `FunctionTraceMatch` turns the target +entry frame into the callee root `CodeStateRel`. -/ +theorem simulate_traced_call_fn_enter_state {context : Eval.Context} + {interpretation : Eval.Interpretation} {machine : Eval.Machine} + {frame : Eval.Frame} {stack : List Eval.Continuation} + {functionTrace calleeTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAddress targetAddress : Ix.Compiler.Ixon.Address} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.call sourceAddress sourceArguments) index + (.call targetAddress targetArguments) next)) + {sourceDefinition : IxIR1.FnDef} {targetDefinition : Function} + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration sourceAddress) sourceDefinition targetDefinition) + {source : List RVal} {values : List RVal} + (state : CodeStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.call sourceAddress sourceArguments) index + (.call targetAddress targetArguments) next) source frame) + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (argumentArity : sourceDefinition.arity = values.length) + (declaration : + context.declarations sourceAddress = some (.fn targetDefinition)) + (noCredits : frame.credits = #[]) + (control : machine.control = .running frame stack) : + let calleeFrame : Eval.Frame := + { definition := targetDefinition, values := values.toArray } + Eval.Step context interpretation machine + { machine with + control := .running calleeFrame + (.resume { frame with pc := frame.pc + 1 } :: stack) } ∧ + CodeStateRel calleeTrace calleeTrace.root values.reverse calleeFrame := by + dsimp only + have operationSyntax := functionTrace.descendantOperationSyntax descendant + change sourceAddress = targetAddress ∧ + Lower.InputMap.translateAtoms input sourceArguments = + some targetArguments at operationSyntax + obtain ⟨addressEq, translated⟩ := operationSyntax + subst targetAddress + have arguments : AtomsRel input sourceArguments targetArguments := + atomsRel_of_translateAtoms translated + have targetArity : + targetDefinition.signature.params.size = values.length := by + calc + targetDefinition.signature.params.size = + calleeTrace.generated.signature.params.size := by + rw [calleeMatch.generated] + _ = calleeTrace.source.arity := calleeTrace.sourceArity + _ = sourceDefinition.arity := congrArg IxIR1.FnDef.arity calleeMatch.source + _ = values.length := argumentArity + have targetNonempty : targetDefinition.blocks.isEmpty = false := by + simpa [calleeMatch.generated] using calleeTrace.generatedNonempty + obtain ⟨blockAt, pcBound, instructionAt⟩ := state.instructionAt descendant + have instruction : + next.headBlock.2.instructions[frame.pc] = + .call sourceAddress targetArguments := + (Array.getElem?_eq_some_iff.mp instructionAt).2 + have entered := simulate_call_fn_enter + (context := context) (interpretation := interpretation) + state.environments arguments + sourceResolved declaration targetArity targetNonempty noCredits control + blockAt pcBound instruction + have entryArity : values.toArray.size = calleeTrace.source.arity := by + simpa [calleeMatch.source] using argumentArity.symm + have calleeState := functionEntryCodeState calleeTrace values.toArray entryArity + exact ⟨entered.1, by + simpa [calleeMatch.generated] using calleeState⟩ + +/-- Trace-facing recursive self-call entry into the same function-trace root. -/ +theorem simulate_traced_call_self_enter_state {context : Eval.Context} + {interpretation : Eval.Interpretation} {machine : Eval.Machine} + {frame : Eval.Frame} {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.callSelf sourceArguments) index (.callSelf targetArguments) next)) + {source : List RVal} {values : List RVal} + (state : CodeStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.callSelf sourceArguments) index (.callSelf targetArguments) next) + source frame) + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (argumentArity : functionTrace.source.arity = values.length) + (noCredits : frame.credits = #[]) + (control : machine.control = .running frame stack) : + let calleeFrame : Eval.Frame := + { definition := frame.definition, values := values.toArray } + Eval.Step context interpretation machine + { machine with + control := .running calleeFrame + (.resume { frame with pc := frame.pc + 1 } :: stack) } ∧ + CodeStateRel functionTrace functionTrace.root values.reverse calleeFrame := by + dsimp only + have translated : Lower.InputMap.translateAtoms input sourceArguments = + some targetArguments := by + simpa [Lower.OperationSyntax] using + functionTrace.descendantOperationSyntax descendant + have arguments : AtomsRel input sourceArguments targetArguments := + atomsRel_of_translateAtoms translated + have targetArity : + frame.definition.signature.params.size = values.length := by + calc + frame.definition.signature.params.size = + functionTrace.generated.signature.params.size := by + rw [state.definition] + _ = functionTrace.source.arity := functionTrace.sourceArity + _ = values.length := argumentArity + have targetNonempty : frame.definition.blocks.isEmpty = false := by + simpa [state.definition] using functionTrace.generatedNonempty + obtain ⟨blockAt, pcBound, instructionAt⟩ := state.instructionAt descendant + have instruction : + next.headBlock.2.instructions[frame.pc] = + .callSelf targetArguments := + (Array.getElem?_eq_some_iff.mp instructionAt).2 + have entered := simulate_call_self_enter + (context := context) (interpretation := interpretation) + state.environments arguments + sourceResolved targetArity targetNonempty noCredits control blockAt pcBound + instruction + have entryArity : values.toArray.size = functionTrace.source.arity := by + simpa using argumentArity.symm + have calleeState := functionEntryCodeState functionTrace values.toArray + entryArity + exact ⟨entered.1, by simpa [state.definition] using calleeState⟩ + +/-- Tail calls enter the addressed callee without growing the continuation +stack while preserving the same canonical entry relation. -/ +theorem simulate_tail_call_fn_enter {context : Eval.Context} + {interpretation : Eval.Interpretation} {machine : Eval.Machine} + {frame : Eval.Frame} {stack : List Eval.Continuation} {block : Block} + {source : List RVal} {mapping : EnvMap} + (environments : EnvRel source frame.values mapping) + {address : Ix.Compiler.Ixon.Address} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} {values : List RVal} + {definition : Function} + (arguments : AtomsRel mapping sourceArguments targetArguments) + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (declaration : context.declarations address = some (.fn definition)) + (arity : definition.signature.params.size = values.length) + (nonempty : definition.blocks.isEmpty = false) + (noCredits : frame.credits = #[]) + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminator : block.terminator = .tailCall address targetArguments) : + Eval.Step context interpretation machine + { machine with + control := .running + { definition, values := values.toArray } stack } ∧ + EnvRel values.reverse values.toArray (entryMap values.length) := by + have targetResolved : + Eval.resolveAtoms frame.values targetArguments = .ok values.toArray := + resolveAtoms_of_envRel environments arguments sourceResolved + have targetArity : + values.toArray.size = definition.signature.params.size := by + simp [arity] + exact ⟨Eval.Step.tailCallFn control blockAt pc terminator noCredits + targetResolved declaration targetArity nonempty, + EnvRel.entry values.toArray⟩ + +/-- Tail-recursive self entry likewise preserves the continuation stack. -/ +theorem simulate_tail_call_self_enter {context : Eval.Context} + {interpretation : Eval.Interpretation} {machine : Eval.Machine} + {frame : Eval.Frame} {stack : List Eval.Continuation} {block : Block} + {source : List RVal} {mapping : EnvMap} + (environments : EnvRel source frame.values mapping) + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} {values : List RVal} + (arguments : AtomsRel mapping sourceArguments targetArguments) + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (arity : frame.definition.signature.params.size = values.length) + (nonempty : frame.definition.blocks.isEmpty = false) + (noCredits : frame.credits = #[]) + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminator : block.terminator = .tailCallSelf targetArguments) : + Eval.Step context interpretation machine + { machine with + control := .running + { definition := frame.definition, values := values.toArray } + stack } ∧ + EnvRel values.reverse values.toArray (entryMap values.length) := by + have targetResolved : + Eval.resolveAtoms frame.values targetArguments = .ok values.toArray := + resolveAtoms_of_envRel environments arguments sourceResolved + have targetArity : + values.toArray.size = frame.definition.signature.params.size := by + simp [arity] + exact ⟨Eval.Step.tailCallSelf control blockAt pc terminator noCredits + targetResolved targetArity nonempty, + EnvRel.entry values.toArray⟩ + +/-- Trace-facing addressed tail-call entry. The checked terminal trace +provides the target argument vector, executable block, PC, and terminator. -/ +theorem simulate_traced_tail_call_fn_enter_state {context : Eval.Context} + {interpretation : Eval.Interpretation} {machine : Eval.Machine} + {frame : Eval.Frame} {stack : List Eval.Continuation} + {functionTrace calleeTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input : EnvMap} {entryValueCount : Nat} + {address : Ix.Compiler.Ixon.Address} + {sourceArguments : Array IxIR1.Atom} {generated : Block} + (descendant : functionTrace.root.Descendant + (.tailCall site blockId input entryValueCount address sourceArguments + generated)) + {sourceDefinition : IxIR1.FnDef} {targetDefinition : Function} + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration address) sourceDefinition targetDefinition) + {source : List RVal} {values : List RVal} + (state : CodeStateRel functionTrace + (.tailCall site blockId input entryValueCount address sourceArguments + generated) source frame) + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (argumentArity : sourceDefinition.arity = values.length) + (declaration : context.declarations address = some (.fn targetDefinition)) + (noCredits : frame.credits = #[]) + (control : machine.control = .running frame stack) : + let calleeFrame : Eval.Frame := + { definition := targetDefinition, values := values.toArray } + Eval.Step context interpretation machine + { machine with + control := .running calleeFrame stack } ∧ + CodeStateRel calleeTrace calleeTrace.root values.reverse calleeFrame := by + dsimp only + have syntaxMatched := functionTrace.descendantSyntaxMatches descendant + obtain ⟨targetArguments, translated, terminator⟩ := + Lower.CodeTrace.tailCallSyntax_of_match syntaxMatched + have arguments : AtomsRel input sourceArguments targetArguments := + atomsRel_of_translateAtoms translated + have blockAt : + frame.definition.blocks[frame.block]? = some generated := by + simpa [Lower.CodeTrace.headBlock] using state.blockAt descendant + have pc : frame.pc = generated.instructions.size := by + simpa [Lower.CodeTrace.entryPc] using state.pc + have targetArity : + targetDefinition.signature.params.size = values.length := by + calc + targetDefinition.signature.params.size = + calleeTrace.generated.signature.params.size := by + rw [calleeMatch.generated] + _ = calleeTrace.source.arity := calleeTrace.sourceArity + _ = sourceDefinition.arity := congrArg IxIR1.FnDef.arity calleeMatch.source + _ = values.length := argumentArity + have targetNonempty : targetDefinition.blocks.isEmpty = false := by + simpa [calleeMatch.generated] using calleeTrace.generatedNonempty + have entered := simulate_tail_call_fn_enter + (context := context) (interpretation := interpretation) + state.environments arguments sourceResolved declaration targetArity + targetNonempty noCredits control blockAt pc terminator + have entryArity : values.toArray.size = calleeTrace.source.arity := by + simpa [calleeMatch.source] using argumentArity.symm + have calleeState := functionEntryCodeState calleeTrace values.toArray entryArity + exact ⟨entered.1, by + simpa [calleeMatch.generated] using calleeState⟩ + +/-- Trace-facing self-tail-call entry. All generated syntax and coordinates +come from the checked recursive derivation. -/ +theorem simulate_traced_tail_call_self_enter_state {context : Eval.Context} + {interpretation : Eval.Interpretation} {machine : Eval.Machine} + {frame : Eval.Frame} {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input : EnvMap} {entryValueCount : Nat} + {sourceArguments : Array IxIR1.Atom} {generated : Block} + (descendant : functionTrace.root.Descendant + (.tailCallSelf site blockId input entryValueCount sourceArguments + generated)) + {source : List RVal} {values : List RVal} + (state : CodeStateRel functionTrace + (.tailCallSelf site blockId input entryValueCount sourceArguments + generated) source frame) + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (argumentArity : functionTrace.source.arity = values.length) + (noCredits : frame.credits = #[]) + (control : machine.control = .running frame stack) : + let calleeFrame : Eval.Frame := + { definition := frame.definition, values := values.toArray } + Eval.Step context interpretation machine + { machine with + control := .running calleeFrame stack } ∧ + CodeStateRel functionTrace functionTrace.root values.reverse + calleeFrame := by + dsimp only + have syntaxMatched := functionTrace.descendantSyntaxMatches descendant + obtain ⟨targetArguments, translated, terminator⟩ := + Lower.CodeTrace.tailCallSelfSyntax_of_match syntaxMatched + have arguments : AtomsRel input sourceArguments targetArguments := + atomsRel_of_translateAtoms translated + have blockAt : + frame.definition.blocks[frame.block]? = some generated := by + simpa [Lower.CodeTrace.headBlock] using state.blockAt descendant + have pc : frame.pc = generated.instructions.size := by + simpa [Lower.CodeTrace.entryPc] using state.pc + have targetArity : + frame.definition.signature.params.size = values.length := by + calc + frame.definition.signature.params.size = + functionTrace.generated.signature.params.size := by + rw [state.definition] + _ = functionTrace.source.arity := functionTrace.sourceArity + _ = values.length := argumentArity + have targetNonempty : frame.definition.blocks.isEmpty = false := by + simpa [state.definition] using functionTrace.generatedNonempty + have entered := simulate_tail_call_self_enter + (context := context) (interpretation := interpretation) + state.environments arguments sourceResolved targetArity targetNonempty + noCredits control blockAt pc terminator + have entryArity : values.toArray.size = functionTrace.source.arity := by + simpa using argumentArity.symm + have calleeState := functionEntryCodeState functionTrace values.toArray + entryArity + exact ⟨entered.1, by simpa [state.definition] using calleeState⟩ + +/-- Trace-facing addressed calls now expose both sides of the recursive +induction seam: the exact IxIR₁ `invoke` equation and the genuine target entry +step into the matched callee root. The heap relation is unchanged by entry. -/ +theorem simulate_traced_call_fn_enter_source_state + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace calleeTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAddress targetAddress : Ix.Compiler.Ixon.Address} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.call sourceAddress sourceArguments) index + (.call targetAddress targetArguments) next)) + {sourceDefinition : IxIR1.FnDef} {targetDefinition : Function} + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration sourceAddress) sourceDefinition targetDefinition) + {sourceStore : IxIR1.Store} {source : List RVal} + {values : List RVal} + (state : CodeStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.call sourceAddress sourceArguments) index + (.call targetAddress targetArguments) next) source frame) + (stores : StoreRel sourceStore machine.store) + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (argumentArity : sourceDefinition.arity = values.length) + (declaration : + context.declarations sourceAddress = some (.fn targetDefinition)) + (noCredits : frame.credits = #[]) + (control : machine.control = .running frame stack) : + let calleeFrame : Eval.Frame := + { definition := targetDefinition, values := values.toArray } + IxIR1.runOp sourceContext (sourceFuel + 1) functionTrace.source + sourceStore source (.call sourceAddress sourceArguments) = + IxIR1.invoke sourceContext sourceFuel sourceAddress values sourceStore ∧ + Eval.Step context interpretation machine + { machine with + control := .running calleeFrame + (.resume { frame with pc := frame.pc + 1 } :: stack) } ∧ + StoreRel sourceStore machine.store ∧ + CodeStateRel calleeTrace calleeTrace.root values.reverse calleeFrame := by + dsimp only + obtain ⟨targetStep, calleeState⟩ := + simulate_traced_call_fn_enter_state + (context := context) (interpretation := interpretation) + descendant calleeMatch state sourceResolved argumentArity declaration + noCredits control + exact ⟨source_runOp_call_eq sourceResolved, targetStep, stores, calleeState⟩ + +/-- Recursive self-call entry has the same paired source/target seam, with +the source equation naming the current function body and result-world check. -/ +theorem simulate_traced_call_self_enter_source_state + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.callSelf sourceArguments) index (.callSelf targetArguments) next)) + {sourceStore : IxIR1.Store} {source : List RVal} + {values : List RVal} + (state : CodeStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.callSelf sourceArguments) index (.callSelf targetArguments) next) + source frame) + (stores : StoreRel sourceStore machine.store) + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (argumentArity : functionTrace.source.arity = values.length) + (noCredits : frame.credits = #[]) + (control : machine.control = .running frame stack) : + let calleeFrame : Eval.Frame := + { definition := frame.definition, values := values.toArray } + IxIR1.runOp sourceContext (sourceFuel + 1) functionTrace.source + sourceStore source (.callSelf sourceArguments) = (do + let out ← IxIR1.runCode sourceContext sourceFuel functionTrace.source + sourceStore values.reverse functionTrace.source.body + IxIR1.checkResultWorld functionTrace.source.result out) ∧ + Eval.Step context interpretation machine + { machine with + control := .running calleeFrame + (.resume { frame with pc := frame.pc + 1 } :: stack) } ∧ + StoreRel sourceStore machine.store ∧ + CodeStateRel functionTrace functionTrace.root values.reverse + calleeFrame := by + dsimp only + obtain ⟨targetStep, calleeState⟩ := + simulate_traced_call_self_enter_state + (context := context) (interpretation := interpretation) + descendant state sourceResolved argumentArity noCredits control + exact ⟨source_runOp_callSelf_eq sourceResolved argumentArity, + targetStep, stores, calleeState⟩ + +/-- A traced addressed tail call discards both source and target caller +continuations: the compiler-recognized source shell is exactly `invoke`, and +the target enters the same matched callee root with the existing stack. -/ +theorem simulate_traced_tail_call_fn_enter_source_state + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace calleeTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input : EnvMap} {entryValueCount : Nat} + {address : Ix.Compiler.Ixon.Address} + {sourceArguments : Array IxIR1.Atom} {generated : Block} + (descendant : functionTrace.root.Descendant + (.tailCall site blockId input entryValueCount address sourceArguments + generated)) + {sourceDefinition : IxIR1.FnDef} {targetDefinition : Function} + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration address) sourceDefinition targetDefinition) + {sourceStore : IxIR1.Store} {source : List RVal} + {values : List RVal} + (state : CodeStateRel functionTrace + (.tailCall site blockId input entryValueCount address sourceArguments + generated) source frame) + (stores : StoreRel sourceStore machine.store) + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (argumentArity : sourceDefinition.arity = values.length) + (declaration : context.declarations address = some (.fn targetDefinition)) + (noCredits : frame.credits = #[]) + (control : machine.control = .running frame stack) : + let calleeFrame : Eval.Frame := + { definition := targetDefinition, values := values.toArray } + IxIR1.runCode sourceContext (sourceFuel + 2) functionTrace.source + sourceStore source + (.letOp (.call address sourceArguments) (.ret (.var 0))) = + IxIR1.invoke sourceContext sourceFuel address values sourceStore ∧ + Eval.Step context interpretation machine + { machine with control := .running calleeFrame stack } ∧ + StoreRel sourceStore machine.store ∧ + CodeStateRel calleeTrace calleeTrace.root values.reverse calleeFrame := by + dsimp only + obtain ⟨targetStep, calleeState⟩ := + simulate_traced_tail_call_fn_enter_state + (context := context) (interpretation := interpretation) + descendant calleeMatch state sourceResolved argumentArity declaration + noCredits control + exact ⟨source_runCode_tail_call_eq sourceResolved, + targetStep, stores, calleeState⟩ + +/-- Self-tail calls expose the analogous current-body source equation and +enter the same trace root without growing either continuation stack. -/ +theorem simulate_traced_tail_call_self_enter_source_state + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input : EnvMap} {entryValueCount : Nat} + {sourceArguments : Array IxIR1.Atom} {generated : Block} + (descendant : functionTrace.root.Descendant + (.tailCallSelf site blockId input entryValueCount sourceArguments + generated)) + {sourceStore : IxIR1.Store} {source : List RVal} + {values : List RVal} + (state : CodeStateRel functionTrace + (.tailCallSelf site blockId input entryValueCount sourceArguments + generated) source frame) + (stores : StoreRel sourceStore machine.store) + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (argumentArity : functionTrace.source.arity = values.length) + (noCredits : frame.credits = #[]) + (control : machine.control = .running frame stack) : + let calleeFrame : Eval.Frame := + { definition := frame.definition, values := values.toArray } + IxIR1.runCode sourceContext (sourceFuel + 2) functionTrace.source + sourceStore source + (.letOp (.callSelf sourceArguments) (.ret (.var 0))) = (do + let out ← IxIR1.runCode sourceContext sourceFuel functionTrace.source + sourceStore values.reverse functionTrace.source.body + IxIR1.checkResultWorld functionTrace.source.result out) ∧ + Eval.Step context interpretation machine + { machine with control := .running calleeFrame stack } ∧ + StoreRel sourceStore machine.store ∧ + CodeStateRel functionTrace functionTrace.root values.reverse + calleeFrame := by + dsimp only + obtain ⟨targetStep, calleeState⟩ := + simulate_traced_tail_call_self_enter_state + (context := context) (interpretation := interpretation) + descendant state sourceResolved argumentArity noCredits control + exact ⟨source_runCode_tail_callSelf_eq sourceResolved argumentArity, + targetStep, stores, calleeState⟩ + +/-- Generic instruction/continuation composition for the code induction. +Once an operation-local theorem supplies one target step and the continuation +hypothesis starts from its successor state, exact finite executions compose +without equating source fuel to target control steps. -/ +theorem simulate_letOp_continuation {sourceContext : IxIR1.Ctx} + {sourceCurrent : IxIR1.FnDef} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine middle targetOut : Eval.Machine} + {frame : Eval.Frame} {stack : List Eval.Continuation} + {sourceStore middleStore outStore : IxIR1.Store} + {source : List RVal} {operation : IxIR1.Op} {rest : IxIR1.Code} + {value outValue : RVal} {continuationCount : Nat} + (running : machine.control = .running frame stack) + (sourceOperation : IxIR1.runOp sourceContext sourceFuel sourceCurrent + sourceStore source operation = .ok (middleStore, value)) + (targetOperation : + Eval.Step context interpretation machine middle) + (sourceContinuation : IxIR1.runCode sourceContext sourceFuel + sourceCurrent middleStore (value :: source) rest = + .ok (outStore, outValue)) + (targetContinuation : Eval.Steps context interpretation + continuationCount middle targetOut) : + IxIR1.runCode sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.letOp operation rest) = .ok (outStore, outValue) ∧ + Eval.Steps context interpretation (Nat.succ continuationCount) + machine targetOut := by + constructor + · rw [IxIR1.runCode.eq_def] + simp only + rw [sourceOperation] + exact sourceContinuation + · exact .cons running targetOperation targetContinuation + +/-- Constructor-case composition: source dispatch selects the same branch as +the target's full-constructor switch, whose one control step composes directly +with the branch induction hypothesis. The branch execution starts after the +generated edge transfer (and any constructor-field fetch prologue). -/ +theorem simulate_case_ctor_branch {sourceContext : IxIR1.Ctx} + {sourceCurrent : IxIR1.FnDef} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine targetOut : Eval.Machine} {frame target : Eval.Frame} + {stack : List Eval.Continuation} {block : Block} + {sourceStore sourceOut : IxIR1.Store} {source : List RVal} + {mapping : EnvMap} + (stores : StoreRel sourceStore machine.store) + (environments : EnvRel source frame.values mapping) + {sourceScrutinee : IxIR1.Atom} {targetScrutinee : Atom} + {location : Nat} {box : IxIR1.NodeBox} {cid : IxIR1.CtorId} + {fields : Array RVal} {sourceAlternatives : Array IxIR1.Alt} + {sourcePeelNat : Bool} {tag fieldCount : Nat} {body : IxIR1.Code} + {value : RVal} + {constructors : Array CtorAlt} {targetPeelNat : Option NatPeel} + {alternative : CtorAlt} {branchCount : Nat} + (translated : + translateAtom mapping sourceScrutinee = some targetScrutinee) + (sourceResolved : + IxIR1.resolveAtom source sourceScrutinee = .ok (.loc location)) + (sourceGet : sourceStore.get? location = some box) + (node : box.node = .ctorN cid fields) + (sourceAlternative : sourceAlternatives.find? (fun candidate => + candidate.cidx == cid.cidx) = + some (.mk tag fieldCount body)) + (fieldArity : fields.size = fieldCount) + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminator : block.terminator = + .switchValue targetScrutinee constructors targetPeelNat) + (targetAlternative : constructors.find? (fun candidate => + candidate.cid == cid) = some alternative) + (transferred : Eval.EdgeTransfer frame alternative.edge #[] target) + (sourceBranch : IxIR1.runCode sourceContext sourceFuel sourceCurrent + sourceStore (fields.toList.reverse ++ source) body = + .ok (sourceOut, value)) + (targetBranch : Eval.Steps context interpretation branchCount + { machine with control := .running target stack } targetOut) : + IxIR1.runCode sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.case sourceScrutinee sourcePeelNat sourceAlternatives) = + .ok (sourceOut, value) ∧ + Eval.Steps context interpretation (Nat.succ branchCount) + machine targetOut := by + have targetResolved : + Eval.resolveAtom frame.values targetScrutinee = .ok (.loc location) := + resolveAtom_of_envRel environments translated sourceResolved + have targetGet : machine.store.get? location = some box := by + unfold Eval.Store.get? + rw [stores.heap] + exact sourceGet + have targetStep := Eval.Step.switchCtor (context := context) + (interpretation := interpretation) control blockAt pc terminator + targetResolved targetGet node targetAlternative transferred + constructor + · rw [IxIR1.runCode.eq_def] + simp only + rw [sourceResolved] + simp only [bind, Except.bind] + rw [sourceGet] + simp only + rw [node] + simp only + rw [sourceAlternative] + simp [fieldArity, sourceBranch] + · exact .cons control targetStep targetBranch + +/-- Literal-Nat zero dispatch composes one target switch step with the zero +branch induction hypothesis. -/ +theorem simulate_case_nat_zero_branch {sourceContext : IxIR1.Ctx} + {sourceCurrent : IxIR1.FnDef} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine targetOut : Eval.Machine} {frame target : Eval.Frame} + {stack : List Eval.Continuation} {block : Block} + {sourceStore sourceOut : IxIR1.Store} {source : List RVal} + {mapping : EnvMap} + (environments : EnvRel source frame.values mapping) + {sourceScrutinee : IxIR1.Atom} {targetScrutinee : Atom} + {sourceAlternatives : Array IxIR1.Alt} {body : IxIR1.Code} + {value : RVal} + {constructors : Array CtorAlt} {peel : NatPeel} + {branchCount : Nat} + (translated : + translateAtom mapping sourceScrutinee = some targetScrutinee) + (sourceResolved : + IxIR1.resolveAtom source sourceScrutinee = .ok (.lit (.nat 0))) + (sourceAlternative : sourceAlternatives.find? (fun candidate => + candidate.cidx == 0) = + some (.mk 0 0 body)) + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminator : block.terminator = + .switchValue targetScrutinee constructors (some peel)) + (transferred : Eval.EdgeTransfer frame peel.zero #[] target) + (sourceBranch : IxIR1.runCode sourceContext sourceFuel sourceCurrent + sourceStore source body = .ok (sourceOut, value)) + (targetBranch : Eval.Steps context interpretation branchCount + { machine with control := .running target stack } targetOut) : + IxIR1.runCode sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.case sourceScrutinee true sourceAlternatives) = + .ok (sourceOut, value) ∧ + Eval.Steps context interpretation (Nat.succ branchCount) + machine targetOut := by + have targetResolved : + Eval.resolveAtom frame.values targetScrutinee = .ok (.lit (.nat 0)) := + resolveAtom_of_envRel environments translated sourceResolved + have targetStep := Eval.Step.switchNatZero (context := context) + (interpretation := interpretation) control blockAt pc terminator + targetResolved transferred + constructor + · rw [IxIR1.runCode.eq_def] + simp only + rw [sourceResolved] + simp only [bind, Except.bind] + rw [sourceAlternative] + exact sourceBranch + · exact .cons control targetStep targetBranch + +/-- Literal-Nat successor dispatch preserves the peeled predecessor and +composes one target switch step with the successor-branch induction +hypothesis. -/ +theorem simulate_case_nat_succ_branch {sourceContext : IxIR1.Ctx} + {sourceCurrent : IxIR1.FnDef} {sourceFuel predecessor : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine targetOut : Eval.Machine} {frame target : Eval.Frame} + {stack : List Eval.Continuation} {block : Block} + {sourceStore sourceOut : IxIR1.Store} {source : List RVal} + {mapping : EnvMap} + (environments : EnvRel source frame.values mapping) + {sourceScrutinee : IxIR1.Atom} {targetScrutinee : Atom} + {sourceAlternatives : Array IxIR1.Alt} {body : IxIR1.Code} + {value : RVal} + {constructors : Array CtorAlt} {peel : NatPeel} + {branchCount : Nat} + (translated : + translateAtom mapping sourceScrutinee = some targetScrutinee) + (sourceResolved : IxIR1.resolveAtom source sourceScrutinee = + .ok (.lit (.nat (predecessor + 1)))) + (sourceAlternative : sourceAlternatives.find? (fun candidate => + candidate.cidx == 1) = + some (.mk 1 1 body)) + (control : machine.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminator : block.terminator = + .switchValue targetScrutinee constructors (some peel)) + (transferred : Eval.EdgeTransfer frame peel.succ + #[.lit (.nat predecessor)] target) + (sourceBranch : IxIR1.runCode sourceContext sourceFuel sourceCurrent + sourceStore (.lit (.nat predecessor) :: source) body = + .ok (sourceOut, value)) + (targetBranch : Eval.Steps context interpretation branchCount + { machine with control := .running target stack } targetOut) : + IxIR1.runCode sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.case sourceScrutinee true sourceAlternatives) = + .ok (sourceOut, value) ∧ + Eval.Steps context interpretation (Nat.succ branchCount) + machine targetOut := by + have targetResolved : Eval.resolveAtom frame.values targetScrutinee = + .ok (.lit (.nat (predecessor + 1))) := + resolveAtom_of_envRel environments translated sourceResolved + have targetStep := Eval.Step.switchNatSucc (context := context) + (interpretation := interpretation) control blockAt pc terminator + targetResolved transferred + constructor + · rw [IxIR1.runCode.eq_def] + simp only + rw [sourceResolved] + simp only [bind, Except.bind] + rw [sourceAlternative] + exact sourceBranch + · exact .cons control targetStep targetBranch + +/-- A callee return under an over-application continuation performs the same +return-value resolution as an ordinary return, then dispatches that value and +the retained residual vector through the shared `ApplyTransfer` boundary. -/ +theorem simulate_ret_apply_more {sourceContext : IxIR1.Ctx} + {sourceCurrent : IxIR1.FnDef} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine target : Eval.Machine} {frame caller : Eval.Frame} + {arguments : Array RVal} {rest : List Eval.Continuation} {block : Block} + {sourceStore : IxIR1.Store} {source : List RVal} {mapping : EnvMap} + (stores : StoreRel sourceStore machine.store) + (environments : EnvRel source frame.values mapping) + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {value : RVal} + (translated : translateAtom mapping sourceAtom = some targetAtom) + (sourceResolved : IxIR1.resolveAtom source sourceAtom = .ok value) + (control : machine.control = + .running frame (.applyMore arguments caller :: rest)) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminator : block.terminator = .ret targetAtom) + (noCredits : frame.credits = #[]) + (world : Eval.RVal.hasWorld machine.store + frame.definition.signature.result value = true) + (transferred : Eval.ApplyTransfer context interpretation machine.store + machine.heapFuel value arguments caller rest target) : + IxIR1.runCode sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.ret sourceAtom) = .ok (sourceStore, value) ∧ + Eval.Steps context interpretation 1 machine target ∧ + StoreRel sourceStore machine.store := by + have targetResolved : Eval.resolveAtom frame.values targetAtom = .ok value := + resolveAtom_of_envRel environments translated sourceResolved + have targetStep := Eval.Step.retApplyMore (context := context) + (interpretation := interpretation) control blockAt pc terminator + targetResolved noCredits world transferred + refine ⟨?_, targetStep.toSteps control, stores⟩ + unfold IxIR1.runCode + simp only + rw [sourceResolved] + rfl + +/-- Trace-facing over-application return. The retained callee derivation +supplies its exact return syntax and coordinate; the caller supplies only the +next dynamic `ApplyTransfer` result for the already-certified residual vector. -/ +theorem simulate_traced_ret_apply_more_state + {sourceContext : IxIR1.Ctx} + {sourceCurrent : IxIR1.FnDef} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine target : Eval.Machine} {frame caller : Eval.Frame} + {arguments : Array RVal} {rest : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input : EnvMap} {entryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {generated : Block} + (descendant : functionTrace.root.Descendant + (.ret site blockId input entryValueCount sourceAtom targetAtom generated)) + {sourceStore : IxIR1.Store} {source : List RVal} {value : RVal} + (state : CodeStateRel functionTrace + (.ret site blockId input entryValueCount sourceAtom targetAtom generated) + source frame) + (stores : StoreRel sourceStore machine.store) + (sourceResolved : IxIR1.resolveAtom source sourceAtom = .ok value) + (control : machine.control = + .running frame (.applyMore arguments caller :: rest)) + (noCredits : frame.credits = #[]) + (world : Eval.RVal.hasWorld machine.store + frame.definition.signature.result value = true) + (transferred : Eval.ApplyTransfer context interpretation machine.store + machine.heapFuel value arguments caller rest target) : + IxIR1.runCode sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.ret sourceAtom) = .ok (sourceStore, value) ∧ + Eval.Steps context interpretation 1 machine target ∧ + StoreRel sourceStore machine.store := by + have syntaxMatched := functionTrace.descendantSyntaxMatches descendant + obtain ⟨translated, terminator⟩ := + Lower.CodeTrace.retSyntax_of_match syntaxMatched + have blockAt : frame.definition.blocks[frame.block]? = some generated := by + simpa [Lower.CodeTrace.headBlock] using state.blockAt descendant + have pc : frame.pc = generated.instructions.size := by + simpa [Lower.CodeTrace.entryPc] using state.pc + exact simulate_ret_apply_more stores state.environments translated + sourceResolved control blockAt pc terminator noCredits world transferred + +/-- The non-outer return base case resumes the suspended target caller and +establishes the source result binding relation needed by its continuation. -/ +theorem simulate_ret_resume {sourceContext : IxIR1.Ctx} + {sourceCurrent : IxIR1.FnDef} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame caller : Eval.Frame} + {rest : List Eval.Continuation} {block : Block} + {sourceStore : IxIR1.Store} {source callerSource : List RVal} + {mapping callerMapping : EnvMap} + (stores : StoreRel sourceStore machine.store) + (environments : EnvRel source frame.values mapping) + (callerEnvironments : + EnvRel callerSource caller.values callerMapping) + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {value : RVal} + (translated : translateAtom mapping sourceAtom = some targetAtom) + (sourceResolved : IxIR1.resolveAtom source sourceAtom = .ok value) + (control : machine.control = + .running frame (.resume caller :: rest)) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminator : block.terminator = .ret targetAtom) + (noCredits : frame.credits = #[]) + (world : Eval.RVal.hasWorld machine.store + frame.definition.signature.result value = true) : + IxIR1.runCode sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.ret sourceAtom) = .ok (sourceStore, value) ∧ + Eval.Steps context interpretation 1 machine + { machine with + control := .running + { caller with values := caller.values.push value } rest } ∧ + StoreRel sourceStore machine.store ∧ + EnvRel (value :: callerSource) (caller.values.push value) + (#[some (.reg caller.values.size)] ++ callerMapping) := by + have targetResolved : + Eval.resolveAtom frame.values targetAtom = .ok value := + resolveAtom_of_envRel environments translated sourceResolved + have targetStep := Eval.Step.retResume (context := context) + (interpretation := interpretation) control blockAt pc terminator + targetResolved noCredits world + refine ⟨?_, targetStep.toSteps control, stores, + callerEnvironments.bindValue value⟩ + unfold IxIR1.runCode + simp only + rw [sourceResolved] + rfl + +/-- Trace-facing resumed return. As in the outermost case, recursive trace +membership supplies the executable block, terminal PC, translated operand, +and return terminator; the caller relation is extended with the result. -/ +theorem simulate_traced_ret_resume_state {sourceContext : IxIR1.Ctx} + {sourceCurrent : IxIR1.FnDef} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame caller : Eval.Frame} + {rest : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input : EnvMap} {entryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {generated : Block} + (descendant : functionTrace.root.Descendant + (.ret site blockId input entryValueCount sourceAtom targetAtom generated)) + {sourceStore : IxIR1.Store} {source callerSource : List RVal} + {callerMapping : EnvMap} {value : RVal} + (state : CodeStateRel functionTrace + (.ret site blockId input entryValueCount sourceAtom targetAtom generated) + source frame) + (stores : StoreRel sourceStore machine.store) + (callerEnvironments : + EnvRel callerSource caller.values callerMapping) + (sourceResolved : IxIR1.resolveAtom source sourceAtom = .ok value) + (control : machine.control = + .running frame (.resume caller :: rest)) + (noCredits : frame.credits = #[]) + (world : Eval.RVal.hasWorld machine.store + frame.definition.signature.result value = true) : + IxIR1.runCode sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.ret sourceAtom) = .ok (sourceStore, value) ∧ + Eval.Steps context interpretation 1 machine + { machine with + control := .running + { caller with values := caller.values.push value } rest } ∧ + StoreRel sourceStore machine.store ∧ + EnvRel (value :: callerSource) (caller.values.push value) + (#[some (.reg caller.values.size)] ++ callerMapping) := by + have syntaxMatched := functionTrace.descendantSyntaxMatches descendant + obtain ⟨translated, terminator⟩ := + Lower.CodeTrace.retSyntax_of_match syntaxMatched + have blockAt : + frame.definition.blocks[frame.block]? = some generated := by + simpa [Lower.CodeTrace.headBlock] using state.blockAt descendant + have pc : frame.pc = generated.instructions.size := by + simpa [Lower.CodeTrace.entryPc] using state.pc + exact simulate_ret_resume stores state.environments callerEnvironments + translated sourceResolved control blockAt pc terminator noCredits world + +/-- Complete a traced value-producing caller instruction when a traced callee +returns. This is the call-stack hand-off needed by recursive function +induction: the callee return step, checked caller map forgetting, and caller +PC/register progression produce the caller continuation's `CodeStateRel`. -/ +theorem simulate_traced_return_to_letOp_state + {sourceContext : IxIR1.Ctx} {sourceCurrent : IxIR1.FnDef} + {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {calleeFrame callerFrame : Eval.Frame} + {rest : List Eval.Continuation} + {callerTrace calleeTrace : Lower.FunctionTrace} + {callSite : Lower.SourceSite} {callBlock : BlockId} + {callInput nextInput : EnvMap} {callEntryValueCount callIndex : Nat} + {operation : IxIR1.Op} {instruction : Instr} {next : Lower.CodeTrace} + (callerDescendant : callerTrace.root.Descendant + (.letOp callSite callBlock callInput nextInput callEntryValueCount + operation callIndex instruction next)) + {returnSite : Lower.SourceSite} {returnBlock : BlockId} + {returnInput : EnvMap} {returnEntryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {generated : Block} + (calleeDescendant : calleeTrace.root.Descendant + (.ret returnSite returnBlock returnInput returnEntryValueCount sourceAtom + targetAtom generated)) + {sourceStore : IxIR1.Store} {calleeSource callerSource : List RVal} + {value : RVal} + (callerState : CodeStateRel callerTrace + (.letOp callSite callBlock callInput nextInput callEntryValueCount + operation callIndex instruction next) callerSource callerFrame) + (calleeState : CodeStateRel calleeTrace + (.ret returnSite returnBlock returnInput returnEntryValueCount sourceAtom + targetAtom generated) calleeSource calleeFrame) + (binder : Lower.Instr.baselineBinderAtom callEntryValueCount instruction = + some (.reg callEntryValueCount)) + (delta : Lower.Instr.baselineValueDelta instruction = some 1) + (stores : StoreRel sourceStore machine.store) + (sourceResolved : + IxIR1.resolveAtom calleeSource sourceAtom = .ok value) + (control : machine.control = .running calleeFrame + (.resume { callerFrame with pc := callerFrame.pc + 1 } :: rest)) + (noCredits : calleeFrame.credits = #[]) + (world : Eval.RVal.hasWorld machine.store + calleeFrame.definition.signature.result value = true) : + let nextCallerFrame : Eval.Frame := + { callerFrame with + pc := callerFrame.pc + 1 + values := callerFrame.values.push value } + IxIR1.runCode sourceContext (sourceFuel + 1) sourceCurrent sourceStore + calleeSource (.ret sourceAtom) = .ok (sourceStore, value) ∧ + Eval.Steps context interpretation 1 machine + { machine with control := .running nextCallerFrame rest } ∧ + StoreRel sourceStore machine.store ∧ + CodeStateRel callerTrace next (value :: callerSource) + nextCallerFrame := by + dsimp only + have callerEnvironments : EnvRel callerSource + ({ callerFrame with pc := callerFrame.pc + 1 } : Eval.Frame).values + callInput := by + simpa [Lower.CodeTrace.sourceInputMap] using callerState.environments + obtain ⟨sourceRun, targetSteps, nextStores, canonical⟩ := + simulate_traced_ret_resume_state calleeDescendant calleeState stores + callerEnvironments sourceResolved control noCredits world + have canonical' : EnvRel (value :: callerSource) + (callerFrame.values.push value) + (#[some (.reg callerFrame.values.size)] ++ callInput) := by + simpa using canonical + have nextEnvironments := canonical'.forgetTracedValue callerState + callerDescendant binder + refine ⟨sourceRun, ?_, nextStores, + callerState.letOpNext callerDescendant rfl rfl rfl ?_ rfl + nextEnvironments⟩ + · simpa using targetSteps + · simp [delta] + +/-- Baseline logical execution preserves the exact IxIR₁ heap and value. +Later credit insertion weakens this to heap isomorphism; keeping the stronger +baseline relation makes that proof boundary explicit. -/ +structure OutcomeRel (source : IxIR1.Store × RVal) + (target : Eval.Result) extends StoreRel source.1 target.store where + value : target.value = source.2 + +/-- The terminal block case: a related source return and outermost target +return take one genuine control step to the same value and preserve the exact +baseline store relation. -/ +theorem simulate_ret_halt {sourceContext : IxIR1.Ctx} + {sourceCurrent : IxIR1.FnDef} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} {block : Block} + {sourceStore : IxIR1.Store} {source : List RVal} {mapping : EnvMap} + (stores : StoreRel sourceStore machine.store) + (environments : EnvRel source frame.values mapping) + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {value : RVal} + (translated : translateAtom mapping sourceAtom = some targetAtom) + (sourceResolved : IxIR1.resolveAtom source sourceAtom = .ok value) + (control : machine.control = .running frame []) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminator : block.terminator = .ret targetAtom) + (noCredits : frame.credits = #[]) + (world : Eval.RVal.hasWorld machine.store + frame.definition.signature.result value = true) : + IxIR1.runCode sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.ret sourceAtom) = .ok (sourceStore, value) ∧ + Eval.Steps context interpretation 1 machine + { machine with control := .halted value } ∧ + StoreRel sourceStore machine.store := by + have targetResolved : + Eval.resolveAtom frame.values targetAtom = .ok value := + resolveAtom_of_envRel environments translated sourceResolved + have targetStep := Eval.Step.retHalt (context := context) + (interpretation := interpretation) control blockAt pc terminator + targetResolved noCredits world + refine ⟨?_, targetStep.toSteps control, stores⟩ + unfold IxIR1.runCode + simp only + rw [sourceResolved] + rfl + +/-- Trace-facing outermost return case. The recursive derivation supplies the +exact executable block, terminal PC, translated operand, and retained return +terminator, leaving only source resolution and runtime side conditions. -/ +theorem simulate_traced_ret_halt_state {sourceContext : IxIR1.Ctx} + {sourceCurrent : IxIR1.FnDef} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input : EnvMap} {entryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {generated : Block} + (descendant : functionTrace.root.Descendant + (.ret site blockId input entryValueCount sourceAtom targetAtom generated)) + {sourceStore : IxIR1.Store} {source : List RVal} {value : RVal} + (state : CodeStateRel functionTrace + (.ret site blockId input entryValueCount sourceAtom targetAtom generated) + source frame) + (stores : StoreRel sourceStore machine.store) + (sourceResolved : IxIR1.resolveAtom source sourceAtom = .ok value) + (control : machine.control = .running frame []) + (noCredits : frame.credits = #[]) + (world : Eval.RVal.hasWorld machine.store + frame.definition.signature.result value = true) : + IxIR1.runCode sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.ret sourceAtom) = .ok (sourceStore, value) ∧ + Eval.Steps context interpretation 1 machine + { machine with control := .halted value } ∧ + StoreRel sourceStore machine.store := by + have syntaxMatched := functionTrace.descendantSyntaxMatches descendant + obtain ⟨translated, terminator⟩ := + Lower.CodeTrace.retSyntax_of_match syntaxMatched + have blockAt : + frame.definition.blocks[frame.block]? = some generated := by + simpa [Lower.CodeTrace.headBlock] using state.blockAt descendant + have pc : frame.pc = generated.instructions.size := by + simpa [Lower.CodeTrace.entryPc] using state.pc + exact simulate_ret_halt stores state.environments translated sourceResolved + control blockAt pc terminator noCredits world + +/-- Successful-run terminal case for the recursive semantic induction. +Inverting source success supplies atom resolution and the unchanged store; +the source result contract is then transported through `CodeStateRel` to +discharge the target evaluator's executable return-world check. -/ +theorem simulate_traced_ret_halt_success + {sourceContext : IxIR1.Ctx} {sourceCurrent : IxIR1.FnDef} + {sourceFuel : Nat} {context : Eval.Context} + {interpretation : Eval.Interpretation} {machine : Eval.Machine} + {frame : Eval.Frame} {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input : EnvMap} {entryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {generated : Block} + (descendant : functionTrace.root.Descendant + (.ret site blockId input entryValueCount sourceAtom targetAtom generated)) + {sourceStore : IxIR1.Store} {source : List RVal} + {sourceOutput : IxIR1.Store × RVal} + (state : CodeStateRel functionTrace + (.ret site blockId input entryValueCount sourceAtom targetAtom generated) + source frame) + (stores : StoreRel sourceStore machine.store) + (sourceRun : IxIR1.runCode sourceContext (sourceFuel + 1) + sourceCurrent sourceStore source (.ret sourceAtom) = .ok sourceOutput) + (resultWorld : IxIR1.Sim.HasWorld sourceOutput.1 + functionTrace.source.result sourceOutput.2) + (control : machine.control = .running frame []) + (noCredits : frame.credits = #[]) : + ∃ value, + sourceOutput = (sourceStore, value) ∧ + Eval.Steps context interpretation 1 machine + { machine with control := .halted value } ∧ + StoreRel sourceStore machine.store := by + obtain ⟨value, sourceResolved, outputEq⟩ := + IxIR1.runCode_ret_success sourceRun + subst sourceOutput + have targetWorld := state.resultWorld stores resultWorld + obtain ⟨_, targetSteps, nextStores⟩ := + simulate_traced_ret_halt_state + (sourceContext := sourceContext) (sourceCurrent := sourceCurrent) + (sourceFuel := sourceFuel) descendant state stores sourceResolved control + noCredits targetWorld + exact ⟨value, rfl, targetSteps, nextStores⟩ + +/-- Runner-facing form of the terminal block case. The exact one-step witness +selects a control budget of one and produces the public baseline outcome. -/ +theorem simulate_ret_halt_runMachine {sourceContext : IxIR1.Ctx} + {sourceCurrent : IxIR1.FnDef} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} {block : Block} + {sourceStore : IxIR1.Store} {source : List RVal} {mapping : EnvMap} + (stores : StoreRel sourceStore machine.store) + (environments : EnvRel source frame.values mapping) + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {value : RVal} + (translated : translateAtom mapping sourceAtom = some targetAtom) + (sourceResolved : IxIR1.resolveAtom source sourceAtom = .ok value) + (control : machine.control = .running frame []) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (pc : frame.pc = block.instructions.size) + (terminator : block.terminator = .ret targetAtom) + (noCredits : frame.credits = #[]) + (world : Eval.RVal.hasWorld machine.store + frame.definition.signature.result value = true) : + let targetOut : Eval.Result := + { store := machine.store + value + controlRemaining := 0 + heapRemaining := machine.heapFuel } + IxIR1.runCode sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.ret sourceAtom) = .ok (sourceStore, value) ∧ + Eval.runMachine context interpretation 1 machine = .ok targetOut ∧ + OutcomeRel (sourceStore, value) targetOut := by + dsimp only + obtain ⟨sourceRun, targetSteps, _⟩ := simulate_ret_halt + stores environments translated sourceResolved control blockAt pc + terminator noCredits world + refine ⟨sourceRun, targetSteps.runMachine_halted, ?_⟩ + exact { stores with value := rfl } + +/-- The block-compositional proof's public whole-main endpoint. Fuel is not +equated: source success existentially obtains independent target control and +heap-traversal budgets. -/ +def SuccessfulMainSimulation (sourceContext : IxIR1.Ctx) + (targetContext : Eval.Context) (sourceMain : IxIR1.Code) + (sourceResult : Ix.Compiler.Ixon.Owned) (targetProgram : Program) : Prop := + ∀ {sourceFuel sourceOut}, + IxIR1.runOwnedMain sourceContext sourceResult sourceMain sourceFuel = + .ok sourceOut → + ∃ controlFuel heapFuel targetOut, + Eval.runMain targetContext .logical targetProgram controlFuel heapFuel = + .ok targetOut ∧ + OutcomeRel sourceOut targetOut + +end Ix.Compiler.IxIR2.Lower.Sim diff --git a/Ix/Compiler/IxIR2/Pipeline.lean b/Ix/Compiler/IxIR2/Pipeline.lean new file mode 100644 index 000000000..9b9201b12 --- /dev/null +++ b/Ix/Compiler/IxIR2/Pipeline.lean @@ -0,0 +1,3548 @@ +import Ix.Compiler.Pipeline +import Ix.Compiler.LoweredCompilation +import Ix.Compiler.IxIR2.Lower +import Ix.Compiler.Ixon.Hash +import Ix.Compiler.IxIR1.Serialize +import Ix.Compiler.IxIR1.NoReuse + +/-! +# Validated pipeline attachment for structured IxIR₂ lowering + +This module consumes the proof-facing validated IxIR₁ pipeline result, carries +function-parameter worlds through its final address map, derives baseline +whole-value constructor schemas, and immediately runs the checked IxIR₂ +lowerer while retaining its exact producer equation. + +IxIR₁ erased exact constructor identities at projections, shallow frees, and +cases. Addressed IxIR₀ mutual-block provenance recovers recursor-case +identities exactly through the final IxIR₁ owner map. Checked HPT summaries +and path-local transfer replay recover exact projection/free identities when +their producers are precise; ambiguous facts still fail closed. +-/ + +namespace Ix.Compiler.IxIR2.Pipeline + +open Ix.Compiler.Ixon (Address Owned) +open Ix.Compiler.IxIR +open Ix.Compiler.IxIR2 + +inductive Error where + | pipeline (error : Ix.Compiler.Pipeline.Error) + | hpt (message : String) + | parameterArity (producer : Address) (expected actual : Nat) + | parameterConflict (address : Address) + | recursorOriginConflict (address : Address) + | lowering (error : Lower.Error) + deriving Repr + +/-- Constructor information and exact mutual-block membership still present +in the addressed IxIR₀ graph. -/ +structure ConstructorInfo where + identity : CtorId + arity : Nat + group : Option Address := none + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr + +/-- Exact final IxIR₁ owner to addressed IxIR₀ mutual-block origin for a +compiler-produced recursor function. -/ +structure RecursorOrigin where + owner : Address + group : Address + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr + +/-- Executable erased-information tables attached to one exact IxIR₁ input. -/ +structure Sidecars where + input : Lower.Input + parameterEntries : List (Address × Array Owned) + constructors : List ConstructorInfo + recursorOrigins : List RecursorOrigin := [] + /-- Checked HPT claims for the exact addressed IxIR₁ graph. Hand-built + sidecars default to no interprocedural claims; path-local allocation facts + remain available without them. -/ + hptCertificate : IxIR1.HPT.Certificate := { artifacts := [] } + +private def lookupParameterWorlds + (entries : List (Address × Array Owned)) (address : Address) : + Option (Array Owned) := + (entries.find? fun entry => entry.1 == address).map (·.2) + +private def sourceDeclAt? + (declarations : List (Address × IxIR0.Decl)) (address : Address) : + Option IxIR0.Decl := + (declarations.find? fun entry => entry.1 == address).map (·.2) + +private def parameterWorldsFor + (source : List (Address × IxIR0.Decl)) (producer : Address) + (definition : IxIR1.FnDef) : Except Error (Array Owned) := do + let worlds := match sourceDeclAt? source producer with + | some (.defn _ body) => + (IxIR1.Lower.lamUses body).map IxIR1.Lower.worldOfUses |>.toArray + | some (.recursor arguments _ _) => + Array.replicate (arguments + 1) .shared + | some (.extern arity) => Array.replicate arity .shared + | some (.ctor ..) | none => Array.replicate definition.arity .shared + if worlds.size = definition.arity then + return worlds + else + .error (.parameterArity producer definition.arity worlds.size) + +private def insertParameterWorlds + (entries : List (Address × Array Owned)) (address : Address) + (worlds : Array Owned) : Except Error (List (Address × Array Owned)) := + match entries.find? fun entry => entry.1 == address with + | none => .ok (entries ++ [(address, worlds)]) + | some entry => + if entry.2 == worlds then .ok entries + else .error (.parameterConflict address) + +private def buildParameterWorlds + (source : List (Address × IxIR0.Decl)) + (raw : List (Address × IxIR1.Decl)) + (addressMap : IxIR1.ReaddressAll.Renaming) : + Except Error (List (Address × Array Owned)) := + raw.foldlM (fun entries entry => + match entry.2 with + | .extern _ => pure entries + | .fn definition => do + let worlds ← parameterWorldsFor source entry.1 definition + let address := IxIR1.Readdress.Renaming.apply addressMap entry.1 + insertParameterWorlds entries address worlds) [] + +private def sourceGroup? + (blocks : List IxIR0.MutualBlock.Result) (address : Address) : + Option Address := do + let block ← blocks.find? fun block => + block.members.any fun member => member.1 == address + return block.blockAddress + +private def constructorInfos + (source : List (Address × IxIR0.Decl)) + (blocks : List IxIR0.MutualBlock.Result) : List ConstructorInfo := + source.filterMap fun + | (address, .ctor tag arity) => + some + { identity := IxIR1.Lower.ctorIdOf address tag + arity + group := sourceGroup? blocks address } + | _ => none + +private def insertRecursorOrigin (origins : List RecursorOrigin) + (owner group : Address) : Except Error (List RecursorOrigin) := + match origins.find? fun origin => origin.owner == owner with + | none => .ok (origins ++ [{ owner, group }]) + | some origin => + if origin.group == group then .ok origins + else .error (.recursorOriginConflict owner) + +/-- Derive exact recursor-owner origins from the addressed IxIR₀ block graph +and the complete raw-to-final IxIR₁ map. Incompatible origins collapsed to +one final owner fail closed. -/ +def deriveRecursorOrigins + (source : List (Address × IxIR0.Decl)) + (blocks : List IxIR0.MutualBlock.Result) + (raw : List (Address × IxIR1.Decl)) + (addressMap : IxIR1.ReaddressAll.Renaming) : + Except Error (List RecursorOrigin) := + raw.foldlM (fun origins entry => + match sourceDeclAt? source entry.1, entry.2, + sourceGroup? blocks entry.1 with + | some (.recursor ..), .fn _, some group => + let owner := IxIR1.Readdress.Renaming.apply addressMap entry.1 + insertRecursorOrigin origins owner group + | _, _, _ => pure origins) [] + +/-- Baseline layouts are content-addressed independently by world and full +constructor identity. No reuse credit is emitted by this lowering, but using +the final representation key now prevents the two ownership worlds from being +accidentally conflated by later passes. -/ +def baselineLayout (world : Owned) (identity : CtorId) : LayoutId := + Address.blake3 + (ByteArray.mk #[0x63, 0x78, 0x32, 0x6c, 0x61, 0x79, 0x30, 0x00] ++ + Encoding.tag world.toBits ++ identity.bytes) + +private def schema? (constructors : List ConstructorInfo) + (world : Owned) (identity : CtorId) : Option CtorSchema := do + let info ← constructors.find? fun candidate => + candidate.identity == identity + return { layout := baselineLayout world identity + fields := Array.replicate info.arity world } + +private def ownerCode? (input : Lower.Input) : + Validate.Owner → Option IxIR1.Code + | .main => some input.main + | .declaration address => do + let entry ← input.declarations.find? fun entry => entry.1 == address + match entry.2 with + | .fn definition => some definition.body + | .extern _ => none + +private def terminalCode : IxIR1.Code → IxIR1.Code + | .letOp _ rest => terminalCode rest + | code => code + +private theorem terminalCode_mapAddresses (rename : Address → Address) + (code : IxIR1.Code) : + terminalCode (IxIR1.Readdress.Code.mapAddresses rename code) = + IxIR1.Readdress.Code.mapAddresses rename (terminalCode code) := by + cases code with + | ret atom => rfl + | letOp operation rest => exact terminalCode_mapAddresses rename rest + | case scrutinee peelNat alternatives => rfl +termination_by sizeOf code + +private def branchCode? : IxIR1.Code → List Nat → Option IxIR1.Code + | code, [] => some code + | code, alternative :: rest => + match terminalCode code with + | .case _ _ alternatives => do + let selected ← alternatives[alternative]? + match selected with + | .mk _ _ body => branchCode? body rest + | _ => none + termination_by _ branches => branches.length + +private theorem branchCode?_mapAddresses (rename : Address → Address) + (code : IxIR1.Code) (branches : List Nat) : + branchCode? (IxIR1.Readdress.Code.mapAddresses rename code) branches = + (branchCode? code branches).map + (IxIR1.Readdress.Code.mapAddresses rename) := by + induction branches generalizing code with + | nil => simp [branchCode?] + | cons alternative rest ih => + simp only [branchCode?] + rw [terminalCode_mapAddresses] + cases terminalEq : terminalCode code with + | ret atom => simp [IxIR1.Readdress.Code.mapAddresses] + | letOp operation next => + simp [IxIR1.Readdress.Code.mapAddresses] + | case scrutinee peelNat alternatives => + simp only [IxIR1.Readdress.Code.mapAddresses] + have mappedAlternatives : + (IxIR1.Readdress.AltList.mapAddresses rename + alternatives.toList).toArray = + alternatives.map + (IxIR1.Readdress.Alt.mapAddresses rename) := by + apply Array.toList_inj.mp + simp only [Array.toList_map] + change IxIR1.Readdress.AltList.mapAddresses rename + alternatives.toList = + List.map (IxIR1.Readdress.Alt.mapAddresses rename) + alternatives.toList + induction alternatives.toList with + | nil => rfl + | cons head tail ih => + simp only [IxIR1.Readdress.AltList.mapAddresses, + List.map_cons, ih] + rw [mappedAlternatives, Array.getElem?_map] + cases selectedEq : alternatives[alternative]? with + | none => simp + | some selected => + obtain ⟨cidx, fields, body⟩ := selected + simp [IxIR1.Readdress.Alt.mapAddresses, ih] + +/-- Syntax-only branch replay is likewise a fold over its path. -/ +private theorem branchCode?_append (code : IxIR1.Code) + (front back : List Nat) : + branchCode? code (front ++ back) = + (branchCode? code front).bind (fun suffix => branchCode? suffix back) := by + induction front generalizing code with + | nil => + simp only [List.nil_append, branchCode?, Option.bind] + | cons alternative front ih => + simp only [List.cons_append, branchCode?] + cases terminalEq : terminalCode code with + | ret atom => + simp + | letOp operation rest => + simp + | case scrutinee peelNat alternatives => + cases selectedEq : alternatives[alternative]? with + | none => + simp [selectedEq] + | some selected => + cases selected with + | mk cidx fields body => + simp [selectedEq, ih] + +private def codeAfter? : Nat → IxIR1.Code → Option IxIR1.Code + | 0, code => some code + | offset + 1, .letOp _ rest => codeAfter? offset rest + | _ + 1, _ => none + +private theorem codeAfter?_mapAddresses (rename : Address → Address) + (offset : Nat) (code : IxIR1.Code) : + codeAfter? offset (IxIR1.Readdress.Code.mapAddresses rename code) = + (codeAfter? offset code).map + (IxIR1.Readdress.Code.mapAddresses rename) := by + induction offset generalizing code with + | zero => rfl + | succ offset ih => + cases code with + | ret atom => rfl + | letOp operation rest => exact ih rest + | case scrutinee peelNat alternatives => rfl + +private def codeAtSite? (input : Lower.Input) (site : Lower.SourceSite) : + Option IxIR1.Code := do + let owner ← ownerCode? input site.owner + let branch ← branchCode? owner site.branches + codeAfter? site.offset branch + +/-- Literal IxIR₁ source suffix named by a lowering coordinate, independent +of HPT success. -/ +def Sidecars.sourceCodeAt? (sidecars : Sidecars) + (site : Lower.SourceSite) : Option IxIR1.Code := + codeAtSite? sidecars.input site + +private theorem ownerCode?_addressImage (input : Lower.Input) + (rename : Address → Address) + (mainImage : ∃ rawMain, + IxIR1.Readdress.Code.mapAddresses rename rawMain = input.main) + (declarationImage : ∀ {address definition}, + IxIR1.Env.ofList input.declarations address = some (.fn definition) → + ∃ rawDefinition, + IxIR1.Readdress.FnDef.mapAddresses rename rawDefinition = + definition) + {owner : Validate.Owner} {code : IxIR1.Code} + (found : ownerCode? input owner = some code) : + ∃ rawCode, + IxIR1.Readdress.Code.mapAddresses rename rawCode = code := by + cases owner with + | main => + simp only [ownerCode?, Option.some.injEq] at found + subst code + exact mainImage + | declaration address => + cases entryEq : input.declarations.find? + (fun entry => entry.1 == address) with + | none => simp [ownerCode?, entryEq] at found + | some entry => + cases declarationEq : entry.2 with + | extern arity => simp [ownerCode?, entryEq, declarationEq] at found + | fn definition => + have lookup : IxIR1.Env.ofList input.declarations address = + some (.fn definition) := by + simp [IxIR1.Env.ofList, entryEq, declarationEq] + obtain ⟨rawDefinition, definitionImage⟩ := + declarationImage lookup + have codeEq : code = definition.body := by + simpa [ownerCode?, entryEq, declarationEq] using found.symm + subst code + refine ⟨rawDefinition.body, ?_⟩ + have bodyImage := congrArg IxIR1.FnDef.body definitionImage + simpa [IxIR1.Readdress.FnDef.mapAddresses] using bodyImage + +/-- Every literal source suffix recovered from a sidecar remains in the +image of an address action whenever the sidecar's main and selected function +declarations are images. Branch selection and source offsets only select +subterms; neither can manufacture a new declaration identity. -/ +theorem Sidecars.sourceCodeAt?_addressImage (sidecars : Sidecars) + (rename : Address → Address) + (mainImage : ∃ rawMain, + IxIR1.Readdress.Code.mapAddresses rename rawMain = sidecars.input.main) + (declarationImage : ∀ {address definition}, + IxIR1.Env.ofList sidecars.input.declarations address = + some (.fn definition) → + ∃ rawDefinition, + IxIR1.Readdress.FnDef.mapAddresses rename rawDefinition = + definition) + {site : Lower.SourceSite} {code : IxIR1.Code} + (found : sidecars.sourceCodeAt? site = some code) : + ∃ rawCode, + IxIR1.Readdress.Code.mapAddresses rename rawCode = code := by + unfold Sidecars.sourceCodeAt? codeAtSite? at found + cases ownerEq : ownerCode? sidecars.input site.owner with + | none => simp [ownerEq] at found + | some ownerCode => + simp only [ownerEq] at found + cases branchEq : branchCode? ownerCode site.branches with + | none => simp [branchEq] at found + | some branchCode => + simp [branchEq] at found + obtain ⟨rawOwner, ownerImage⟩ := ownerCode?_addressImage + sidecars.input rename mainImage declarationImage ownerEq + have branchTransport := + branchCode?_mapAddresses rename rawOwner site.branches + rw [ownerImage, branchEq] at branchTransport + cases rawBranchEq : branchCode? rawOwner site.branches with + | none => simp [rawBranchEq] at branchTransport + | some rawBranch => + simp only [rawBranchEq, Option.map_some, + Option.some.injEq] at branchTransport + have codeTransport := + codeAfter?_mapAddresses rename site.offset rawBranch + rw [← branchTransport, found] at codeTransport + cases rawCodeEq : codeAfter? site.offset rawBranch with + | none => simp [rawCodeEq] at codeTransport + | some rawCode => + simp only [rawCodeEq, Option.map_some, + Option.some.injEq] at codeTransport + exact ⟨rawCode, codeTransport.symm⟩ + +private def nextSourceCode? : IxIR1.Code → Option IxIR1.Code + | .letOp _ rest => some rest + | _ => none + +private theorem codeAfter?_succ (offset : Nat) (code : IxIR1.Code) : + codeAfter? (offset + 1) code = + (codeAfter? offset code).bind nextSourceCode? := by + induction offset generalizing code with + | zero => + cases code <;> rfl + | succ offset ih => + cases code with + | ret atom => rfl + | case scrutinee peelNat alternatives => rfl + | letOp operation rest => + exact ih rest + +private theorem terminalCode_of_codeAfter_case (offset : Nat) + (code : IxIR1.Code) (scrutinee : IxIR1.Atom) (peelNat : Bool) + (alternatives : Array IxIR1.Alt) + (found : codeAfter? offset code = + some (.case scrutinee peelNat alternatives)) : + terminalCode code = .case scrutinee peelNat alternatives := by + induction offset generalizing code with + | zero => + simp only [codeAfter?] at found + cases found + rfl + | succ offset ih => + cases code with + | ret atom => + simp [codeAfter?] at found + | case scrutinee' peelNat' alternatives' => + simp [codeAfter?] at found + | letOp operation rest => + simp only [codeAfter?] at found + exact ih rest found + +/-- Literal source coordinates advance in lockstep with a `letOp` trace. -/ +theorem Sidecars.sourceCodeAt?_next (sidecars : Sidecars) + {site : Lower.SourceSite} {operation : IxIR1.Op} {rest : IxIR1.Code} + (sourceAt : sidecars.sourceCodeAt? site = + some (.letOp operation rest)) : + sidecars.sourceCodeAt? site.next = some rest := by + unfold Sidecars.sourceCodeAt? codeAtSite? at sourceAt ⊢ + simp only [Lower.SourceSite.next] + cases ownerEq : ownerCode? sidecars.input site.owner with + | none => + simp [ownerEq] at sourceAt + | some ownerCode => + simp [ownerEq] at sourceAt ⊢ + cases branchEq : branchCode? ownerCode site.branches with + | none => + simp [branchEq] at sourceAt + | some branchCode => + simp [branchEq] at sourceAt ⊢ + rw [codeAfter?_succ] + cases offsetEq : codeAfter? site.offset branchCode with + | none => + simp [offsetEq] at sourceAt + | some currentCode => + simp [offsetEq] at sourceAt ⊢ + have currentEq : currentCode = .letOp operation rest := + sourceAt + subst currentCode + rfl + +/-- Literal source coordinates select the exact body stored at an appended +case-alternative index. -/ +theorem Sidecars.sourceCodeAt?_alternative (sidecars : Sidecars) + {site : Lower.SourceSite} {scrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {index cidx fields : Nat} + {body : IxIR1.Code} + (sourceAt : sidecars.sourceCodeAt? site = + some (.case scrutinee peelNat alternatives)) + (selected : alternatives[index]? = some (.mk cidx fields body)) : + sidecars.sourceCodeAt? (site.alternative index) = some body := by + unfold Sidecars.sourceCodeAt? codeAtSite? at sourceAt ⊢ + simp only [Lower.SourceSite.alternative] + cases ownerEq : ownerCode? sidecars.input site.owner with + | none => + simp [ownerEq] at sourceAt + | some ownerCode => + simp [ownerEq] at sourceAt ⊢ + cases branchEq : branchCode? ownerCode site.branches with + | none => + simp [branchEq] at sourceAt + | some branchCode => + simp [branchEq] at sourceAt + have terminalEq := terminalCode_of_codeAfter_case site.offset + branchCode scrutinee peelNat alternatives sourceAt + rw [branchCode?_append, branchEq] + simp [branchCode?, terminalEq, selected, codeAfter?] + +/-! ## Path-local producer facts + +`SourceSite` records exactly the branch path and `letOp` offset traversed by +the structured lowerer. Replay the checked HPT transfer along only that path +to recover the abstract environment at the operation being lowered. Every +lookup remains partial: invalid coordinates, missing call summaries, and an +HPT error all fail closed. -/ + +private def mainAnalysisOwner : Address := Address.replicate 0 + +private structure AnalysisRoot where + owner : Address + current : IxIR1.FnDef + facts : List IxIR1.HPT.Fact + code : IxIR1.Code + +private def analysisRoot? (sidecars : Sidecars) : + Validate.Owner → Option AnalysisRoot + | .main => + -- A missing synthetic-owner summary makes `callSelf` fail closed and + -- is the semantic owner-compatibility contract used for source main. + match sidecars.hptCertificate.summaryEnv mainAnalysisOwner with + | some _ => none + | none => some + { owner := mainAnalysisOwner + current := sidecars.input.mainDefinition + facts := [] + code := sidecars.input.main } + | .declaration address => do + let entry ← sidecars.input.declarations.find? fun entry => + entry.1 == address + match entry.2 with + | .extern _ => none + | .fn current => + some + ({ owner := address + current + facts := List.replicate current.arity IxIR1.HPT.Fact.top + code := current.body } : AnalysisRoot) + +/-- The exact source definition used by path-local analysis for one lowering +owner. A missing result is the same fail-closed condition as `siteFacts?`. -/ +def Sidecars.analysisCurrent? (sidecars : Sidecars) + (owner : Validate.Owner) : Option IxIR1.FnDef := + (analysisRoot? sidecars owner).map (fun root => root.current) + +/-- One retained lowering trace resolves to the exact function definition +used by path-local HPT replay. A missing synthetic-main analysis is permitted +because all of its facts fail closed; a missing declaration analysis is not. -/ +def Sidecars.functionTraceSourceMatches (sidecars : Sidecars) + (trace : Lower.FunctionTrace) : Bool := + match sidecars.analysisCurrent? trace.owner with + | some current => Lower.functionSourceEq current trace.source + | none => trace.owner == .main + +/-- Whole-trace source/HPT owner alignment checked at attachment time. -/ +def Sidecars.traceSourcesMatch (sidecars : Sidecars) + (trace : Lower.Trace) : Bool := + trace.functions.all sidecars.functionTraceSourceMatches + +/-- Reuse-freedom check over the exact final declaration environment and +every source function retained by the lowering trace. Checking the emitted +graph closes the content-deduplication gap between the raw compiler theorem +and the universally quantified evaluator context contract. -/ +def Sidecars.sourceNoReuse (sidecars : Sidecars) + (trace : Lower.Trace) : Bool := + IxIR1.NoReuse.checkDeclarations sidecars.input.declarations && + trace.functions.all fun functionTrace => + IxIR1.NoReuse.checkCode functionTrace.source.body + +/-! Every constructor allocation retained by the producer must name a +sidecar constructor with the same field arity. This finite executable audit +is the static half of the runtime constructor-universe invariant used by +ambiguous switch coverage. -/ + +def Sidecars.constructorKnown (sidecars : Sidecars) (identity : CtorId) + (arity : Nat) : Bool := + match sidecars.constructors.find? fun info => info.identity == identity with + | some info => info.arity == arity + | none => false + +def Sidecars.operationConstructorsKnown (sidecars : Sidecars) : + IxIR1.Op → Bool + | .alloc _ identity arguments | .reuse _ identity arguments => + sidecars.constructorKnown identity arguments.size + | _ => true + +mutual + +def Sidecars.codeConstructorsKnown (sidecars : Sidecars) : + IxIR1.Code → Bool + | .ret _ => true + | .letOp operation rest => + sidecars.operationConstructorsKnown operation && + sidecars.codeConstructorsKnown rest + | .case _ _ alternatives => + sidecars.alternativesConstructorsKnown alternatives.toList + +private def Sidecars.alternativesConstructorsKnown (sidecars : Sidecars) : + List IxIR1.Alt → Bool + | [] => true + | .mk _ _ body :: alternatives => + sidecars.codeConstructorsKnown body && + sidecars.alternativesConstructorsKnown alternatives + +end + +private theorem Sidecars.alternativesConstructorsKnown_of_mem + (sidecars : Sidecars) {alternatives : List IxIR1.Alt} + {cidx fields : Nat} {body : IxIR1.Code} + (known : sidecars.alternativesConstructorsKnown alternatives = true) + (member : (.mk cidx fields body : IxIR1.Alt) ∈ alternatives) : + sidecars.codeConstructorsKnown body = true := by + induction alternatives with + | nil => simp at member + | cons head tail ih => + cases head with + | mk headTag headFields headBody => + simp only [Sidecars.alternativesConstructorsKnown, + Bool.and_eq_true] at known + simp only [List.mem_cons] at member + cases member with + | inl equal => + cases equal + exact known.1 + | inr member => exact ih known.2 member + +/-- A constructor-allocation audit over a case projects to every source +alternative body. -/ +theorem Sidecars.codeConstructorsKnown_alternative (sidecars : Sidecars) + {scrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {cidx fields : Nat} + {body : IxIR1.Code} + (known : sidecars.codeConstructorsKnown + (.case scrutinee peelNat alternatives) = true) + (member : (.mk cidx fields body : IxIR1.Alt) ∈ alternatives) : + sidecars.codeConstructorsKnown body = true := by + exact sidecars.alternativesConstructorsKnown_of_mem known + (by simpa using member) + +mutual + +/-- Constructor-producing operations retained by one recursive lowering trace +all belong to the producer's constructor universe. This trace-shaped copy of +the source audit makes the fact project directly to any simulated suffix. -/ +def Sidecars.codeTraceConstructorsKnown (sidecars : Sidecars) : + Lower.CodeTrace → Bool + | .ret .. | .tailCall .. | .tailCallSelf .. => true + | .letOp _ _ _ _ _ operation _ _ next => + sidecars.operationConstructorsKnown operation && + sidecars.codeTraceConstructorsKnown next + | .switchValue _ _ _ _ _ _ _ _ _ _ children => + sidecars.codeTraceConstructorListKnown children + +private def Sidecars.codeTraceConstructorListKnown (sidecars : Sidecars) : + List Lower.CodeTrace → Bool + | [] => true + | trace :: traces => + sidecars.codeTraceConstructorsKnown trace && + sidecars.codeTraceConstructorListKnown traces + +end + +def Sidecars.traceConstructorsKnown (sidecars : Sidecars) + (trace : Lower.Trace) : Bool := + trace.functions.all fun functionTrace => + sidecars.codeConstructorsKnown functionTrace.source.body && + sidecars.codeTraceConstructorsKnown functionTrace.root + +private theorem Sidecars.codeTraceConstructorListKnown_of_mem + (sidecars : Sidecars) {traces : List Lower.CodeTrace} + {trace : Lower.CodeTrace} + (known : sidecars.codeTraceConstructorListKnown traces = true) + (member : trace ∈ traces) : + sidecars.codeTraceConstructorsKnown trace = true := by + induction traces with + | nil => simp at member + | cons head tail ih => + simp only [Sidecars.codeTraceConstructorListKnown, + Bool.and_eq_true] at known + simp only [List.mem_cons] at member + cases member with + | inl equal => simpa [equal] using known.1 + | inr member => exact ih known.2 member + +/-- The constructor-allocation audit is inherited by an immediate recursive +compiler call. -/ +theorem Sidecars.codeTraceConstructorsKnown_of_child (sidecars : Sidecars) + {parent child : Lower.CodeTrace} + (known : sidecars.codeTraceConstructorsKnown parent = true) + (member : child ∈ parent.children) : + sidecars.codeTraceConstructorsKnown child = true := by + cases parent with + | ret _ _ _ _ _ _ _ | tailCall _ _ _ _ _ _ _ + | tailCallSelf _ _ _ _ _ _ => + simp [Lower.CodeTrace.children] at member + | letOp site block input nextInput entryValueCount operation index + instruction next => + simp [Lower.CodeTrace.children] at member + subst child + have both : sidecars.operationConstructorsKnown operation = true ∧ + sidecars.codeTraceConstructorsKnown next = true := by + simpa only [Sidecars.codeTraceConstructorsKnown, + Bool.and_eq_true] using known + exact both.2 + | switchValue site block input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children => + exact sidecars.codeTraceConstructorListKnown_of_mem known member + +/-- The constructor-allocation audit is inherited by every recursive +descendant of a retained compiler derivation. -/ +theorem Sidecars.codeTraceConstructorsKnown_descendant (sidecars : Sidecars) + {root child : Lower.CodeTrace} + (known : sidecars.codeTraceConstructorsKnown root = true) + (descendant : root.Descendant child) : + sidecars.codeTraceConstructorsKnown child = true := by + induction descendant with + | refl => exact known + | @step parent child parentDescendant childMember ih => + exact sidecars.codeTraceConstructorsKnown_of_child ih childMember + +/-- Local PAP-safety check for the one source operation that can allocate a +partial-application node. Missing and non-function declarations fail closed. -/ +private def Sidecars.pappOperationSafe (sidecars : Sidecars) : + IxIR1.Op → Bool + | .papp address _ => + match IxIR1.Env.ofList sidecars.input.declarations address with + | some (.fn definition) => definition.papSafe + | _ => false + | _ => true + +mutual + +/-- Recursive PAP-safety check over one retained compiler derivation. -/ +def Sidecars.pappSafeTrace (sidecars : Sidecars) : Lower.CodeTrace → Bool + | .ret .. | .tailCall .. | .tailCallSelf .. => true + | .letOp _ _ _ _ _ operation _ _ next => + sidecars.pappOperationSafe operation && sidecars.pappSafeTrace next + | .switchValue _ _ _ _ _ _ _ _ _ _ children => + sidecars.pappSafeTraces children + +/-- Structural list walk beneath switch children. -/ +def Sidecars.pappSafeTraces (sidecars : Sidecars) : + List Lower.CodeTrace → Bool + | [] => true + | trace :: rest => + sidecars.pappSafeTrace trace && sidecars.pappSafeTraces rest + +end + +/-- Whole-program PAP-safety check over all retained source derivations. -/ +def Sidecars.tracePappsSafe (sidecars : Sidecars) + (trace : Lower.Trace) : Bool := + trace.functions.all fun functionTrace => + sidecars.pappSafeTrace functionTrace.root + +/-- A successful recursive check exposes the declaration flag required by a +local retained `papp`. -/ +theorem Sidecars.pappSafe_of_traceMatch (sidecars : Sidecars) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount index : Nat} + {address : Address} {arguments : Array IxIR1.Atom} + {instruction : Instr} {next : Lower.CodeTrace} + {definition : IxIR1.FnDef} + (matched : sidecars.pappSafeTrace + (.letOp site blockId input nextInput entryValueCount + (.papp address arguments) index instruction next) = true) + (lookup : IxIR1.Env.ofList sidecars.input.declarations address = + some (.fn definition)) : + definition.papSafe = true := by + simp only [Sidecars.pappSafeTrace, Bool.and_eq_true] at matched + simpa [Sidecars.pappOperationSafe, lookup] using matched.1 + +private theorem Sidecars.pappSafeTraces_of_mem (sidecars : Sidecars) + {traces : List Lower.CodeTrace} {child : Lower.CodeTrace} + (matched : sidecars.pappSafeTraces traces = true) + (member : child ∈ traces) : + sidecars.pappSafeTrace child = true := by + induction traces with + | nil => simp at member + | cons head tail ih => + simp only [Sidecars.pappSafeTraces, Bool.and_eq_true] at matched + simp only [List.mem_cons] at member + rcases member with rfl | member + · exact matched.1 + · exact ih matched.2 member + +/-- PAP-safety is inherited by every immediate recursive compiler call. -/ +theorem Sidecars.pappSafeTrace_of_child (sidecars : Sidecars) + {parent child : Lower.CodeTrace} + (matched : sidecars.pappSafeTrace parent = true) + (member : child ∈ parent.children) : + sidecars.pappSafeTrace child = true := by + cases parent with + | ret _ _ _ _ _ _ _ | tailCall _ _ _ _ _ _ _ + | tailCallSelf _ _ _ _ _ _ => + simp [Lower.CodeTrace.children] at member + | letOp site block input nextInput count operation index instruction next => + simp [Lower.CodeTrace.children] at member + subst child + simp only [Sidecars.pappSafeTrace, Bool.and_eq_true] at matched + exact matched.2 + | switchValue site block input count sourceScrutinee peel alternatives + targetScrutinee generated outgoing children => + exact sidecars.pappSafeTraces_of_mem matched member + +/-- Every recursive trace descendant inherits the root PAP-safety check. -/ +theorem Sidecars.pappSafeTrace_descendant (sidecars : Sidecars) + {root child : Lower.CodeTrace} + (descendant : root.Descendant child) + (matched : sidecars.pappSafeTrace root = true) : + sidecars.pappSafeTrace child = true := by + induction descendant with + | refl => exact matched + | @step parent child parentDescendant childMember ih => + exact sidecars.pappSafeTrace_of_child ih childMember + +/-- Reflect whole-trace alignment for one retained function whose analysis +root is present. -/ +theorem Sidecars.functionTraceSource_eq_of_match + (sidecars : Sidecars) {trace : Lower.Trace} + (matched : sidecars.traceSourcesMatch trace = true) + {functionTrace : Lower.FunctionTrace} + (member : functionTrace ∈ trace.functions) + {current : IxIR1.FnDef} + (currentAt : sidecars.analysisCurrent? functionTrace.owner = + some current) : + current = functionTrace.source := by + have localMatch := List.all_eq_true.mp matched functionTrace member + unfold Sidecars.functionTraceSourceMatches at localMatch + rw [currentAt] at localMatch + exact (Lower.functionSourceEq_eq_true_iff _ _).mp localMatch + +/-- Every recovered analysis root satisfies the owner contract required by +operation soundness: declaration roots name their exact stored definition, +while the synthetic main owner has no summary. -/ +private theorem analysisRoot_ownerCompatible (sidecars : Sidecars) + {owner : Validate.Owner} {root : AnalysisRoot} + (found : analysisRoot? sidecars owner = some root) : + IxIR1.HPT.AnalysisOwnerCompatible + (IxIR1.Env.ofList sidecars.input.declarations) + sidecars.hptCertificate.summaryEnv root.owner root.current := by + cases owner with + | main => + cases summaryEq : + sidecars.hptCertificate.summaryEnv mainAnalysisOwner with + | none => + simp [analysisRoot?, summaryEq] at found + subst root + exact Or.inr summaryEq + | some summary => + simp [analysisRoot?, summaryEq] at found + | declaration address => + cases entryEq : sidecars.input.declarations.find? + (fun entry => entry.1 == address) with + | none => + simp [analysisRoot?, entryEq] at found + | some entry => + cases declarationEq : entry.2 with + | extern arity => + simp [analysisRoot?, entryEq, declarationEq] at found + | fn current => + simp [analysisRoot?, entryEq, declarationEq] at found + subst root + exact Or.inl (by + simp [IxIR1.Env.ofList, entryEq, declarationEq]) + +/-- Every recoverable analysis root starts from the standard top parameter +environment. The synthetic main is the zero-arity instance. -/ +private theorem analysisRoot_facts (sidecars : Sidecars) + {owner : Validate.Owner} {root : AnalysisRoot} + (found : analysisRoot? sidecars owner = some root) : + root.facts = + List.replicate root.current.arity IxIR1.HPT.Fact.top := by + cases owner with + | main => + cases summaryEq : + sidecars.hptCertificate.summaryEnv mainAnalysisOwner with + | none => + simp [analysisRoot?, summaryEq, Lower.Input.mainDefinition] at found + subst root + rfl + | some summary => + simp [analysisRoot?, summaryEq] at found + | declaration address => + cases entryEq : sidecars.input.declarations.find? + (fun entry => entry.1 == address) with + | none => + simp [analysisRoot?, entryEq] at found + | some entry => + cases declarationEq : entry.2 with + | extern arity => + simp [analysisRoot?, entryEq, declarationEq] at found + | fn current => + simp [analysisRoot?, entryEq, declarationEq] at found + subst root + rfl + +/-- HPT and syntax-only site replay start from the same owner body. -/ +private theorem analysisRoot_sourceCode (sidecars : Sidecars) + {owner : Validate.Owner} {root : AnalysisRoot} + (found : analysisRoot? sidecars owner = some root) : + ownerCode? sidecars.input owner = some root.code := by + cases owner with + | main => + cases summaryEq : + sidecars.hptCertificate.summaryEnv mainAnalysisOwner with + | none => + simp [analysisRoot?, summaryEq] at found + subst root + rfl + | some summary => + simp [analysisRoot?, summaryEq] at found + | declaration address => + cases entryEq : sidecars.input.declarations.find? + (fun entry => entry.1 == address) with + | none => + simp [analysisRoot?, entryEq] at found + | some entry => + cases declarationEq : entry.2 with + | extern arity => + simp [analysisRoot?, entryEq, declarationEq] at found + | fn current => + simp [analysisRoot?, entryEq, declarationEq] at found + subst root + simp [ownerCode?, entryEq, declarationEq] + +/-- The analysis root's retained syntax is exactly its retained definition +body. -/ +private theorem analysisRoot_code (sidecars : Sidecars) + {owner : Validate.Owner} {root : AnalysisRoot} + (found : analysisRoot? sidecars owner = some root) : + root.code = root.current.body := by + cases owner with + | main => + cases summaryEq : + sidecars.hptCertificate.summaryEnv mainAnalysisOwner with + | none => + simp [analysisRoot?, summaryEq, Lower.Input.mainDefinition] at found + subst root + rfl + | some summary => + simp [analysisRoot?, summaryEq] at found + | declaration address => + cases entryEq : sidecars.input.declarations.find? + (fun entry => entry.1 == address) with + | none => + simp [analysisRoot?, entryEq] at found + | some entry => + cases declarationEq : entry.2 with + | extern arity => + simp [analysisRoot?, entryEq, declarationEq] at found + | fn current => + simp [analysisRoot?, entryEq, declarationEq] at found + subst root + rfl + +/-- A recoverable function owner names its exact literal source body at the +empty branch path and zero offset. -/ +theorem Sidecars.sourceCodeAt?_root (sidecars : Sidecars) + {owner : Validate.Owner} {current : IxIR1.FnDef} + (currentAt : sidecars.analysisCurrent? owner = some current) : + sidecars.sourceCodeAt? ({ owner := owner } : Lower.SourceSite) = + some current.body := by + unfold Sidecars.analysisCurrent? at currentAt + cases rootEq : analysisRoot? sidecars owner with + | none => + simp [rootEq] at currentAt + | some root => + rw [rootEq] at currentAt + have currentEq : root.current = current := Option.some.inj currentAt + have rootCode := analysisRoot_sourceCode sidecars rootEq + have codeEq := analysisRoot_code sidecars rootEq + unfold Sidecars.sourceCodeAt? codeAtSite? + simp [rootCode, branchCode?, codeAfter?, codeEq, currentEq] + +/-- The synthetic main coordinate always names the literal input main, +independently of whether HPT admits a root for its reserved analysis owner. -/ +theorem Sidecars.sourceCodeAt?_main (sidecars : Sidecars) : + sidecars.sourceCodeAt? + ({ owner := .main } : Lower.SourceSite) = some sidecars.input.main := by + simp [Sidecars.sourceCodeAt?, codeAtSite?, ownerCode?, branchCode?, + codeAfter?] + +private def advanceFacts (declarations : IxIR1.HPT.DeclEnv) + (summaries : IxIR1.HPT.SummaryEnv) (root : AnalysisRoot) + (facts : List IxIR1.HPT.Fact) (operation : IxIR1.Op) : + Except String (List IxIR1.HPT.Fact) := do + let bound ← IxIR1.HPT.analyzeOp declarations summaries root.owner + root.current facts operation + return bound :: facts.map IxIR1.HPT.Fact.forgetHeap + +private def analyzeToTerminal (declarations : IxIR1.HPT.DeclEnv) + (summaries : IxIR1.HPT.SummaryEnv) (root : AnalysisRoot) : + List IxIR1.HPT.Fact → IxIR1.Code → + Except String (List IxIR1.HPT.Fact × IxIR1.Code) + | facts, .letOp operation rest => do + let facts ← advanceFacts declarations summaries root facts operation + analyzeToTerminal declarations summaries root facts rest + | facts, code => .ok (facts, code) + termination_by _ code => sizeOf code + +/-- Successful abstract transfer does not alter the literal terminal suffix. -/ +private theorem analyzeToTerminal_code + (declarations : IxIR1.HPT.DeclEnv) + (summaries : IxIR1.HPT.SummaryEnv) (root : AnalysisRoot) + (facts : List IxIR1.HPT.Fact) (code : IxIR1.Code) + (outputFacts : List IxIR1.HPT.Fact) (outputCode : IxIR1.Code) + (found : analyzeToTerminal declarations summaries root facts code = + .ok (outputFacts, outputCode)) : + terminalCode code = outputCode := by + cases code with + | ret atom => + simp only [analyzeToTerminal] at found + cases found + rfl + | case scrutinee peelNat alternatives => + simp only [analyzeToTerminal] at found + cases found + rfl + | letOp operation rest => + simp only [analyzeToTerminal] at found + cases advanced : + advanceFacts declarations summaries root facts operation with + | error error => + simp [advanced] at found + | ok nextFacts => + rw [advanced] at found + simp only [bind, Except.bind] at found + exact analyzeToTerminal_code declarations summaries root nextFacts + rest outputFacts outputCode found +termination_by sizeOf code + +private def selectAlternative (facts : List IxIR1.HPT.Fact) + (code : IxIR1.Code) (alternative : Nat) : + Except String (List IxIR1.HPT.Fact × IxIR1.Code) := + match code with + | .case scrutinee peelNat alternatives => do + let scrutineeFact ← IxIR1.HPT.resolveAtomFact facts scrutinee + let selected ← match alternatives[alternative]? with + | some selected => pure selected + | none => throw "IxIR₂ source-site alternative is absent" + match selected with + | .mk cidx fields body => + .ok (scrutineeFact.caseFields peelNat cidx fields ++ facts, body) + | _ => throw "IxIR₂ source-site branch path does not reach a case" + +private def enterAlternative (declarations : IxIR1.HPT.DeclEnv) + (summaries : IxIR1.HPT.SummaryEnv) (root : AnalysisRoot) + (facts : List IxIR1.HPT.Fact) (code : IxIR1.Code) + (alternative : Nat) : + Except String (List IxIR1.HPT.Fact × IxIR1.Code) := do + let (facts, terminal) ← + analyzeToTerminal declarations summaries root facts code + selectAlternative facts terminal alternative + +/-- Successful abstract branch entry selects the same literal child body as +syntax-only branch replay. -/ +private theorem enterAlternative_code (declarations : IxIR1.HPT.DeclEnv) + (summaries : IxIR1.HPT.SummaryEnv) (root : AnalysisRoot) + (facts : List IxIR1.HPT.Fact) (code : IxIR1.Code) + (alternative : Nat) (outputFacts : List IxIR1.HPT.Fact) + (outputCode : IxIR1.Code) + (found : enterAlternative declarations summaries root facts code + alternative = .ok (outputFacts, outputCode)) : + branchCode? code [alternative] = some outputCode := by + unfold enterAlternative at found + cases terminalEq : + analyzeToTerminal declarations summaries root facts code with + | error error => + simp [terminalEq] at found + | ok terminalResult => + obtain ⟨terminalFacts, terminal⟩ := terminalResult + rw [terminalEq] at found + simp only [bind, Except.bind] at found + have terminalCodeEq := analyzeToTerminal_code declarations summaries + root facts code terminalFacts terminal terminalEq + cases terminal with + | ret atom => + simp [selectAlternative] at found + | letOp operation rest => + simp [selectAlternative] at found + | case scrutinee peelNat alternatives => + cases abstractEq : + IxIR1.HPT.resolveAtomFact terminalFacts scrutinee with + | error error => + simp [selectAlternative, abstractEq] at found + | ok scrutineeFact => + cases selectedEq : alternatives[alternative]? with + | none => + simp [selectAlternative, abstractEq, selectedEq] at found + change Except.error + "IxIR₂ source-site alternative is absent" = + Except.ok (outputFacts, outputCode) at found + contradiction + | some selected => + cases selected with + | mk cidx fields body => + simp [selectAlternative, abstractEq, selectedEq] at found + rw [← found.2] + simp [branchCode?, terminalCodeEq, selectedEq] + +private def analyzeBranchPath (declarations : IxIR1.HPT.DeclEnv) + (summaries : IxIR1.HPT.SummaryEnv) (root : AnalysisRoot) : + List IxIR1.HPT.Fact → IxIR1.Code → List Nat → + Except String (List IxIR1.HPT.Fact × IxIR1.Code) + | facts, code, [] => .ok (facts, code) + | facts, code, alternative :: branches => do + let (facts, code) ← enterAlternative declarations summaries root facts + code alternative + analyzeBranchPath declarations summaries root facts code branches + termination_by _ _ branches => branches.length + +/-- Branch-path replay is a monadic fold over the recorded alternative +indices, so an appended path can be replayed from the prefix result. -/ +private theorem analyzeBranchPath_append + (declarations : IxIR1.HPT.DeclEnv) + (summaries : IxIR1.HPT.SummaryEnv) (root : AnalysisRoot) + (facts : List IxIR1.HPT.Fact) (code : IxIR1.Code) + (front back : List Nat) : + analyzeBranchPath declarations summaries root facts code + (front ++ back) = + (analyzeBranchPath declarations summaries root facts code front).bind + (fun result => analyzeBranchPath declarations summaries root + result.1 result.2 back) := by + induction front generalizing facts code with + | nil => + simp only [List.nil_append, analyzeBranchPath, Except.bind] + | cons alternative front ih => + simp only [List.cons_append, analyzeBranchPath] + cases entered : enterAlternative declarations summaries root facts code + alternative with + | error error => rfl + | ok result => + obtain ⟨nextFacts, nextCode⟩ := result + simp only [bind, Except.bind] + exact ih nextFacts nextCode + +/-- Successful HPT branch replay retains the exact syntax-only child suffix. -/ +private theorem analyzeBranchPath_code + (declarations : IxIR1.HPT.DeclEnv) + (summaries : IxIR1.HPT.SummaryEnv) (root : AnalysisRoot) + (facts : List IxIR1.HPT.Fact) (code : IxIR1.Code) + (branches : List Nat) (outputFacts : List IxIR1.HPT.Fact) + (outputCode : IxIR1.Code) + (found : analyzeBranchPath declarations summaries root facts code + branches = .ok (outputFacts, outputCode)) : + branchCode? code branches = some outputCode := by + induction branches generalizing facts code with + | nil => + simp only [analyzeBranchPath] at found + cases found + simp only [branchCode?] + | cons alternative branches ih => + simp only [analyzeBranchPath] at found + cases entered : enterAlternative declarations summaries root facts code + alternative with + | error error => + simp [entered] at found + | ok enteredResult => + obtain ⟨nextFacts, nextCode⟩ := enteredResult + rw [entered] at found + simp only [bind, Except.bind] at found + have headCode := enterAlternative_code declarations summaries root + facts code alternative nextFacts nextCode entered + have tailCode := ih nextFacts nextCode found + change branchCode? code ([alternative] ++ branches) = some outputCode + rw [branchCode?_append, headCode] + simp only [Option.bind] + exact tailCode + +private def analyzeOffset (declarations : IxIR1.HPT.DeclEnv) + (summaries : IxIR1.HPT.SummaryEnv) (root : AnalysisRoot) : + Nat → List IxIR1.HPT.Fact → IxIR1.Code → + Except String (List IxIR1.HPT.Fact × IxIR1.Code) + | 0, facts, code => .ok (facts, code) + | offset + 1, facts, .letOp operation rest => do + let facts ← advanceFacts declarations summaries root facts operation + analyzeOffset declarations summaries root offset facts rest + | _ + 1, _, _ => throw "IxIR₂ source-site offset exceeds its branch" + +/-- Successful abstract offset replay retains the exact literal source +suffix selected by syntax-only replay. -/ +private theorem analyzeOffset_code (declarations : IxIR1.HPT.DeclEnv) + (summaries : IxIR1.HPT.SummaryEnv) (root : AnalysisRoot) + (offset : Nat) (facts : List IxIR1.HPT.Fact) (code : IxIR1.Code) + (outputFacts : List IxIR1.HPT.Fact) (outputCode : IxIR1.Code) + (found : analyzeOffset declarations summaries root offset facts code = + .ok (outputFacts, outputCode)) : + codeAfter? offset code = some outputCode := by + induction offset generalizing facts code with + | zero => + simp only [analyzeOffset] at found + cases found + rfl + | succ offset ih => + cases code with + | ret atom => + simp [analyzeOffset] at found + | case scrutinee peelNat alternatives => + simp [analyzeOffset] at found + | letOp operation rest => + simp only [analyzeOffset] at found + cases advanced : + advanceFacts declarations summaries root facts operation with + | error error => + simp [advanced] at found + | ok nextFacts => + rw [advanced] at found + simp only [bind, Except.bind] at found + exact ih nextFacts rest found + +/-- A syntactically valid offset splits whole-arm abstract replay at exactly +that suffix, including preservation of any abstract failure before it. -/ +private theorem analyzeToTerminal_eq_analyzeOffset_bind + (declarations : IxIR1.HPT.DeclEnv) + (summaries : IxIR1.HPT.SummaryEnv) (root : AnalysisRoot) + (offset : Nat) (facts : List IxIR1.HPT.Fact) (code suffix : IxIR1.Code) + (codeAt : codeAfter? offset code = some suffix) : + analyzeToTerminal declarations summaries root facts code = + (analyzeOffset declarations summaries root offset facts code).bind + (fun result => analyzeToTerminal declarations summaries root + result.1 result.2) := by + induction offset generalizing facts code with + | zero => + simp only [analyzeOffset, Except.bind] + | succ offset ih => + cases code with + | ret atom => + simp [codeAfter?] at codeAt + | case scrutinee peelNat alternatives => + simp [codeAfter?] at codeAt + | letOp operation rest => + simp only [codeAfter?] at codeAt + simp only [analyzeToTerminal, analyzeOffset] + cases advanced : + advanceFacts declarations summaries root facts operation with + | error error => + simp only [bind, Except.bind] + | ok nextFacts => + simp only [bind, Except.bind] + exact ih nextFacts rest codeAt + +/-- If a valid offset lands on a case, advancing the whole arm to its terminal +code produces exactly the same fact environment and case. -/ +private theorem analyzeToTerminal_of_analyzeOffset_case + (declarations : IxIR1.HPT.DeclEnv) + (summaries : IxIR1.HPT.SummaryEnv) (root : AnalysisRoot) + (offset : Nat) (facts : List IxIR1.HPT.Fact) (code : IxIR1.Code) + (currentFacts : List IxIR1.HPT.Fact) (scrutinee : IxIR1.Atom) + (peelNat : Bool) (alternatives : Array IxIR1.Alt) + (found : analyzeOffset declarations summaries root offset facts code = + .ok (currentFacts, .case scrutinee peelNat alternatives)) : + analyzeToTerminal declarations summaries root facts code = + .ok (currentFacts, .case scrutinee peelNat alternatives) := by + induction offset generalizing facts code with + | zero => + simp only [analyzeOffset] at found + cases found + simp only [analyzeToTerminal] + | succ offset ih => + cases code with + | ret atom => + simp [analyzeOffset] at found + | case scrutinee' peelNat' alternatives' => + simp [analyzeOffset] at found + | letOp operation rest => + simp only [analyzeOffset] at found + cases advanced : + advanceFacts declarations summaries root facts operation with + | error error => + simp [advanced] at found + | ok nextFacts => + rw [advanced] at found + simp only [bind, Except.bind] at found + simp only [analyzeToTerminal] + rw [advanced] + simp only [bind, Except.bind] + exact ih nextFacts rest found + +private def advanceAnalyzedPair (declarations : IxIR1.HPT.DeclEnv) + (summaries : IxIR1.HPT.SummaryEnv) (root : AnalysisRoot) : + List IxIR1.HPT.Fact × IxIR1.Code → + Except String (List IxIR1.HPT.Fact × IxIR1.Code) + | (facts, .letOp operation rest) => do + let facts ← advanceFacts declarations summaries root facts operation + return (facts, rest) + | _ => throw "IxIR₂ source-site offset exceeds its branch" + +/-- Replaying one additional source offset is exactly one transfer from the +already replayed pair. This is the executable recurrence used by the dynamic +site-environment invariant. -/ +private theorem analyzeOffset_succ (declarations : IxIR1.HPT.DeclEnv) + (summaries : IxIR1.HPT.SummaryEnv) (root : AnalysisRoot) + (offset : Nat) (facts : List IxIR1.HPT.Fact) (code : IxIR1.Code) : + analyzeOffset declarations summaries root (offset + 1) facts code = + (analyzeOffset declarations summaries root offset facts code).bind + (advanceAnalyzedPair declarations summaries root) := by + induction offset generalizing facts code with + | zero => + cases code <;> rfl + | succ offset ih => + cases code with + | ret atom => rfl + | case scrutinee peelNat alternatives => rfl + | letOp operation rest => + simp only [analyzeOffset] + cases advanced : + advanceFacts declarations summaries root facts operation with + | error error => rfl + | ok nextFacts => + simp only [bind, Except.bind] + exact ih nextFacts rest + +/-- Abstract environment and exact source suffix recovered at one lowering +coordinate by path-local HPT replay. -/ +structure SiteFacts where + facts : List IxIR1.HPT.Fact + code : IxIR1.Code + +/-- Select one case alternative from an already recovered terminal site. +This is the local transfer performed when the compiler changes from `site` +to `site.alternative index`. -/ +def SiteFacts.alternative? (analyzed : SiteFacts) + (index : Nat) : Option SiteFacts := + match selectAlternative analyzed.facts analyzed.code index with + | .ok (facts, code) => some { facts, code } + | .error _ => none + +def Sidecars.siteFacts? (sidecars : Sidecars) + (site : Lower.SourceSite) : Option SiteFacts := do + let root ← analysisRoot? sidecars site.owner + let declarations := IxIR1.Env.ofList sidecars.input.declarations + let summaries := sidecars.hptCertificate.summaryEnv + let (branchFacts, branchCode) ← + match analyzeBranchPath declarations summaries root root.facts root.code + site.branches with + | .ok result => some result + | .error _ => none + let (facts, code) ← + match analyzeOffset declarations summaries root site.offset branchFacts + branchCode with + | .ok result => some result + | .error _ => none + return { facts, code } + +/-- Whenever HPT replay succeeds, its retained code is the literal source +suffix named by the same coordinate. -/ +theorem Sidecars.siteFacts?_sourceCodeAt (sidecars : Sidecars) + {site : Lower.SourceSite} {analyzed : SiteFacts} + (found : sidecars.siteFacts? site = some analyzed) : + sidecars.sourceCodeAt? site = some analyzed.code := by + unfold Sidecars.siteFacts? at found + cases rootEq : analysisRoot? sidecars site.owner with + | none => + simp [rootEq] at found + | some root => + rw [rootEq] at found + have rootCode := analysisRoot_sourceCode sidecars rootEq + cases branchEq : analyzeBranchPath + (IxIR1.Env.ofList sidecars.input.declarations) + sidecars.hptCertificate.summaryEnv root root.facts root.code + site.branches with + | error error => + simp [branchEq] at found + | ok branchResult => + obtain ⟨branchFacts, branchCode⟩ := branchResult + simp [branchEq] at found + have branchSource := analyzeBranchPath_code + (IxIR1.Env.ofList sidecars.input.declarations) + sidecars.hptCertificate.summaryEnv root root.facts root.code + site.branches branchFacts branchCode branchEq + cases offsetEq : analyzeOffset + (IxIR1.Env.ofList sidecars.input.declarations) + sidecars.hptCertificate.summaryEnv root site.offset branchFacts + branchCode with + | error error => + simp [offsetEq] at found + | ok offsetResult => + obtain ⟨outputFacts, outputCode⟩ := offsetResult + simp [offsetEq] at found + have analyzedEq : + ({ facts := outputFacts, code := outputCode } : SiteFacts) = + analyzed := found + subst analyzed + have offsetSource := analyzeOffset_code + (IxIR1.Env.ofList sidecars.input.declarations) + sidecars.hptCertificate.summaryEnv root site.offset branchFacts + branchCode outputFacts outputCode offsetEq + unfold Sidecars.sourceCodeAt? codeAtSite? + simp [rootCode, branchSource, offsetSource] + +/-- At a valid terminal case coordinate, appending one branch index to the +source site is exactly local alternative selection from the recovered pair. -/ +theorem Sidecars.siteFacts?_alternative (sidecars : Sidecars) + {site : Lower.SourceSite} {index : Nat} {current : SiteFacts} + {scrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} + (currentFound : sidecars.siteFacts? site = some current) + (codeAt : current.code = .case scrutinee peelNat alternatives) : + sidecars.siteFacts? (site.alternative index) = + current.alternative? index := by + unfold Sidecars.siteFacts? at currentFound ⊢ + simp only [Lower.SourceSite.alternative] + cases rootEq : analysisRoot? sidecars site.owner with + | none => + simp [rootEq] at currentFound + | some root => + rw [rootEq] at currentFound + cases branchEq : analyzeBranchPath + (IxIR1.Env.ofList sidecars.input.declarations) + sidecars.hptCertificate.summaryEnv root root.facts root.code + site.branches with + | error error => + simp [branchEq] at currentFound + | ok branchResult => + obtain ⟨branchFacts, branchCode⟩ := branchResult + simp [branchEq] at currentFound + cases offsetEq : analyzeOffset + (IxIR1.Env.ofList sidecars.input.declarations) + sidecars.hptCertificate.summaryEnv root site.offset branchFacts + branchCode with + | error error => + simp [offsetEq] at currentFound + | ok currentResult => + obtain ⟨currentFacts, currentCode⟩ := currentResult + simp [offsetEq] at currentFound + have currentEq : + ({ facts := currentFacts, code := currentCode } : SiteFacts) = + current := currentFound + subst current + have currentCodeEq : currentCode = + .case scrutinee peelNat alternatives := codeAt + subst currentCode + have terminalEq := analyzeToTerminal_of_analyzeOffset_case + (IxIR1.Env.ofList sidecars.input.declarations) + sidecars.hptCertificate.summaryEnv root site.offset branchFacts + branchCode currentFacts scrutinee peelNat alternatives offsetEq + simp only [bind, Option.bind] + rw [analyzeBranchPath_append, branchEq] + simp only [Except.bind] + simp [analyzeBranchPath, enterAlternative, terminalEq, + analyzeOffset, SiteFacts.alternative?] + cases selectedEq : selectAlternative currentFacts + (.case scrutinee peelNat alternatives) index with + | error error => + simp + | ok selected => + obtain ⟨selectedFacts, selectedCode⟩ := selected + simp + +/-- If replay has failed by a syntactically valid terminal case coordinate, +the appended branch also fails closed. In particular, branch entry cannot +resurrect facts lost by an earlier abstract transfer. -/ +theorem Sidecars.siteFacts?_alternative_eq_none (sidecars : Sidecars) + {site : Lower.SourceSite} {index : Nat} {scrutinee : IxIR1.Atom} + {peelNat : Bool} {alternatives : Array IxIR1.Alt} + (sourceAt : sidecars.sourceCodeAt? site = + some (.case scrutinee peelNat alternatives)) + (currentNone : sidecars.siteFacts? site = none) : + sidecars.siteFacts? (site.alternative index) = none := by + unfold Sidecars.sourceCodeAt? codeAtSite? at sourceAt + unfold Sidecars.siteFacts? at currentNone ⊢ + simp only [Lower.SourceSite.alternative] + cases rootEq : analysisRoot? sidecars site.owner with + | none => + simp + | some root => + rw [rootEq] at currentNone + have rootCode := analysisRoot_sourceCode sidecars rootEq + simp [rootCode] at sourceAt + cases branchEq : analyzeBranchPath + (IxIR1.Env.ofList sidecars.input.declarations) + sidecars.hptCertificate.summaryEnv root root.facts root.code + site.branches with + | error error => + simp only [bind, Option.bind] + rw [analyzeBranchPath_append, branchEq] + simp only [Except.bind] + | ok branchResult => + obtain ⟨branchFacts, branchCode⟩ := branchResult + have branchSource := analyzeBranchPath_code + (IxIR1.Env.ofList sidecars.input.declarations) + sidecars.hptCertificate.summaryEnv root root.facts root.code + site.branches branchFacts branchCode branchEq + rw [branchSource] at sourceAt + simp only [Option.bind] at sourceAt + cases offsetEq : analyzeOffset + (IxIR1.Env.ofList sidecars.input.declarations) + sidecars.hptCertificate.summaryEnv root site.offset branchFacts + branchCode with + | ok currentResult => + obtain ⟨currentFacts, currentCode⟩ := currentResult + simp [branchEq, offsetEq] at currentNone + | error error => + have terminalEq := analyzeToTerminal_eq_analyzeOffset_bind + (IxIR1.Env.ofList sidecars.input.declarations) + sidecars.hptCertificate.summaryEnv root site.offset branchFacts + branchCode (.case scrutinee peelNat alternatives) sourceAt + rw [offsetEq] at terminalEq + simp only [Except.bind] at terminalEq + simp only [bind, Option.bind] + rw [analyzeBranchPath_append, branchEq] + simp only [Except.bind] + simp [analyzeBranchPath, enterAlternative, terminalEq] + +/-- At a syntactically valid case coordinate, branch replay is total as a +fail-closed recurrence: either the current query is already `none`, or the +selected local transfer determines the child query. -/ +theorem Sidecars.siteFacts?_alternative_of_sourceCodeAt (sidecars : Sidecars) + {site : Lower.SourceSite} {index : Nat} {scrutinee : IxIR1.Atom} + {peelNat : Bool} {alternatives : Array IxIR1.Alt} + (sourceAt : sidecars.sourceCodeAt? site = + some (.case scrutinee peelNat alternatives)) : + sidecars.siteFacts? (site.alternative index) = + (sidecars.siteFacts? site).bind + (fun current => current.alternative? index) := by + cases currentEq : sidecars.siteFacts? site with + | none => + rw [sidecars.siteFacts?_alternative_eq_none sourceAt currentEq] + simp only [Option.bind] + | some current => + have recoveredSource := sidecars.siteFacts?_sourceCodeAt currentEq + have codeAt : current.code = + .case scrutinee peelNat alternatives := + Option.some.inj (recoveredSource.symm.trans sourceAt) + rw [sidecars.siteFacts?_alternative currentEq codeAt] + simp only [Option.bind] + +/-- Advance an already recovered site result by one linear source operation. +`none` is the fail-closed state for a terminal suffix, a missing analysis +root, or an abstract transfer error. -/ +def Sidecars.advanceSiteFacts? (sidecars : Sidecars) + (site : Lower.SourceSite) (analyzed : SiteFacts) : Option SiteFacts := do + let root ← analysisRoot? sidecars site.owner + let declarations := IxIR1.Env.ofList sidecars.input.declarations + let summaries := sidecars.hptCertificate.summaryEnv + let (facts, code) ← + match advanceAnalyzedPair declarations summaries root + (analyzed.facts, analyzed.code) with + | .ok result => some result + | .error _ => none + return { facts, code } + +/-- Path-local replay commutes with the compiler's linear source coordinate: +querying `site.next` is the same as querying `site` and advancing its recovered +pair once. -/ +theorem Sidecars.siteFacts?_next (sidecars : Sidecars) + (site : Lower.SourceSite) : + sidecars.siteFacts? site.next = + (sidecars.siteFacts? site).bind + (sidecars.advanceSiteFacts? site) := by + unfold Sidecars.siteFacts? Sidecars.advanceSiteFacts? + simp only [Lower.SourceSite.next] + cases rootEq : analysisRoot? sidecars site.owner with + | none => + simp + | some root => + cases branchEq : analyzeBranchPath + (IxIR1.Env.ofList sidecars.input.declarations) + sidecars.hptCertificate.summaryEnv root root.facts root.code + site.branches with + | error error => + simp [branchEq] + | ok branchResult => + obtain ⟨branchFacts, branchCode⟩ := branchResult + simp [branchEq] + rw [analyzeOffset_succ] + cases offsetEq : analyzeOffset + (IxIR1.Env.ofList sidecars.input.declarations) + sidecars.hptCertificate.summaryEnv root site.offset branchFacts + branchCode with + | error error => + simp only [Except.bind] + simp only [Option.bind] + | ok offsetResult => + obtain ⟨facts, code⟩ := offsetResult + cases advancedEq : advanceAnalyzedPair + (IxIR1.Env.ofList sidecars.input.declarations) + sidecars.hptCertificate.summaryEnv root (facts, code) with + | error error => + simp only [Except.bind, Option.bind] + | ok advanced => + obtain ⟨nextFacts, nextCode⟩ := advanced + simp only [Except.bind, Option.bind] + +/-- Concrete interpretation of every recovered fact environment at one +source coordinate. If replay has already failed closed, the predicate is +vacuous and remains so at later linear coordinates. -/ +def Sidecars.SiteEnvironmentHolds (sidecars : Sidecars) + (store : IxIR1.Store) (site : Lower.SourceSite) + (values : List IxIR1.RVal) : Prop := + ∀ analyzed, sidecars.siteFacts? site = some analyzed → + IxIR1.HPT.EnvironmentHolds + (IxIR1.Env.ofList sidecars.input.declarations) + store analyzed.facts values + +/-- Any recoverable function root starts with a concrete environment matching +its top parameter facts. This includes the closed synthetic main. -/ +theorem Sidecars.siteEnvironmentHolds_root (sidecars : Sidecars) + {owner : Validate.Owner} {current : IxIR1.FnDef} + {store : IxIR1.Store} {values : List IxIR1.RVal} + (currentAt : sidecars.analysisCurrent? owner = some current) + (valueCount : values.length = current.arity) : + sidecars.SiteEnvironmentHolds store + ({ owner := owner } : Lower.SourceSite) values := by + intro analyzed siteFound + unfold Sidecars.analysisCurrent? at currentAt + cases rootEq : analysisRoot? sidecars owner with + | none => + simp [rootEq] at currentAt + | some root => + rw [rootEq] at currentAt + have currentEq : root.current = current := Option.some.inj currentAt + subst current + unfold Sidecars.siteFacts? at siteFound + simp [rootEq, analyzeBranchPath, analyzeOffset] at siteFound + cases siteFound + rw [analysisRoot_facts sidecars rootEq, ← valueCount] + exact IxIR1.HPT.EnvironmentHolds.top_replicate + (IxIR1.Env.ofList sidecars.input.declarations) store values + +/-- The closed synthetic main begins with the empty concrete environment. +If its reserved analysis owner collides with a summary, replay fails closed +and the predicate is vacuous. -/ +theorem Sidecars.siteEnvironmentHolds_main (sidecars : Sidecars) + {store : IxIR1.Store} : + sidecars.SiteEnvironmentHolds store + ({ owner := .main } : Lower.SourceSite) [] := by + intro analyzed siteFound + unfold Sidecars.siteFacts? at siteFound + cases summaryEq : + sidecars.hptCertificate.summaryEnv mainAnalysisOwner with + | none => + simp [analysisRoot?, summaryEq, analyzeBranchPath, analyzeOffset] + at siteFound + cases siteFound + exact IxIR1.HPT.EnvironmentHolds.nil + | some summary => + simp [analysisRoot?, summaryEq] at siteFound + +/-- Entering a selected constructor alternative prepends the concrete fields +in the evaluator's binder order and preserves the enclosing environment. -/ +theorem Sidecars.siteEnvironmentHolds_alternative_ctor_of_siteFacts + (sidecars : Sidecars) + {store : IxIR1.Store} {site : Lower.SourceSite} + {values : List IxIR1.RVal} {current : SiteFacts} + {scrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {index cidx fieldCount : Nat} + {body : IxIR1.Code} {location : Nat} {box : IxIR1.NodeBox} + {identity : CtorId} {fields : Array IxIR1.RVal} + (currentFound : sidecars.siteFacts? site = some current) + (codeAt : current.code = .case scrutinee peelNat alternatives) + (selected : alternatives[index]? = + some (.mk cidx fieldCount body)) + (environment : sidecars.SiteEnvironmentHolds store site values) + (resolved : IxIR1.resolveAtom values scrutinee = .ok (.loc location)) + (sourceGet : store.get? location = some box) + (node : box.node = .ctorN identity fields) + (tag : identity.cidx = cidx) + (fieldCountEq : fields.size = fieldCount) : + sidecars.SiteEnvironmentHolds store (site.alternative index) + (fields.toList.reverse ++ values) := by + intro next nextFound + rw [sidecars.siteFacts?_alternative currentFound codeAt] at nextFound + unfold SiteFacts.alternative? at nextFound + rw [codeAt] at nextFound + cases abstractEq : IxIR1.HPT.resolveAtomFact current.facts scrutinee with + | error error => + simp [selectAlternative, abstractEq] at nextFound + | ok scrutineeFact => + simp [selectAlternative, abstractEq, selected] at nextFound + cases nextFound + have currentEnvironment := environment current currentFound + have scrutineeHolds := IxIR1.HPT.resolveAtom_sound currentEnvironment + abstractEq resolved + exact + (IxIR1.HPT.Fact.caseFields_ctor_holds peelNat cidx fieldCount + scrutineeHolds sourceGet node tag fieldCountEq).append + currentEnvironment + +/-- The selected zero Nat alternative has no new binders, so its recovered +environment is exactly the enclosing one. -/ +theorem Sidecars.siteEnvironmentHolds_alternative_natZero_of_siteFacts + (sidecars : Sidecars) + {store : IxIR1.Store} {site : Lower.SourceSite} + {values : List IxIR1.RVal} {current : SiteFacts} + {scrutinee : IxIR1.Atom} {alternatives : Array IxIR1.Alt} + {index : Nat} {body : IxIR1.Code} + (currentFound : sidecars.siteFacts? site = some current) + (codeAt : current.code = .case scrutinee true alternatives) + (selected : alternatives[index]? = some (.mk 0 0 body)) + (environment : sidecars.SiteEnvironmentHolds store site values) : + sidecars.SiteEnvironmentHolds store (site.alternative index) values := by + intro next nextFound + rw [sidecars.siteFacts?_alternative currentFound codeAt] at nextFound + unfold SiteFacts.alternative? at nextFound + rw [codeAt] at nextFound + cases abstractEq : IxIR1.HPT.resolveAtomFact current.facts scrutinee with + | error error => + simp [selectAlternative, abstractEq] at nextFound + | ok scrutineeFact => + simp [selectAlternative, abstractEq, selected] at nextFound + cases nextFound + have currentEnvironment := environment current currentFound + have binders : IxIR1.HPT.EnvironmentHolds + (IxIR1.Env.ofList sidecars.input.declarations) store + (scrutineeFact.caseFields true 0 0) [] := by + simpa [IxIR1.HPT.Fact.caseFields, + IxIR1.HPT.Fact.joinFieldVectors] using + (IxIR1.HPT.EnvironmentHolds.nil : + IxIR1.HPT.EnvironmentHolds + (IxIR1.Env.ofList sidecars.input.declarations) store [] []) + exact binders.append currentEnvironment + +/-- The selected successor Nat alternative prepends the exact predecessor +fact and value before the enclosing environment. -/ +theorem Sidecars.siteEnvironmentHolds_alternative_natSucc_of_siteFacts + (sidecars : Sidecars) + {store : IxIR1.Store} {site : Lower.SourceSite} + {values : List IxIR1.RVal} {current : SiteFacts} + {scrutinee : IxIR1.Atom} {alternatives : Array IxIR1.Alt} + {index predecessor : Nat} {body : IxIR1.Code} + (currentFound : sidecars.siteFacts? site = some current) + (codeAt : current.code = .case scrutinee true alternatives) + (selected : alternatives[index]? = some (.mk 1 1 body)) + (environment : sidecars.SiteEnvironmentHolds store site values) + (resolved : IxIR1.resolveAtom values scrutinee = + .ok (.lit (.nat (predecessor + 1)))) : + sidecars.SiteEnvironmentHolds store (site.alternative index) + (.lit (.nat predecessor) :: values) := by + intro next nextFound + rw [sidecars.siteFacts?_alternative currentFound codeAt] at nextFound + unfold SiteFacts.alternative? at nextFound + rw [codeAt] at nextFound + cases abstractEq : IxIR1.HPT.resolveAtomFact current.facts scrutinee with + | error error => + simp [selectAlternative, abstractEq] at nextFound + | ok scrutineeFact => + simp [selectAlternative, abstractEq, selected] at nextFound + cases nextFound + have currentEnvironment := environment current currentFound + have scrutineeHolds := IxIR1.HPT.resolveAtom_sound currentEnvironment + abstractEq resolved + exact + (IxIR1.HPT.Fact.caseFields_natSucc_holds scrutineeHolds).append + currentEnvironment + +/-- Source-facing constructor branch transport. Earlier HPT failure is +preserved as `none`; otherwise the concrete field vector satisfies the +selected branch facts. -/ +theorem Sidecars.siteEnvironmentHolds_alternative_ctor (sidecars : Sidecars) + {store : IxIR1.Store} {site : Lower.SourceSite} + {values : List IxIR1.RVal} {scrutinee : IxIR1.Atom} + {peelNat : Bool} {alternatives : Array IxIR1.Alt} + {index cidx fieldCount : Nat} {body : IxIR1.Code} + {location : Nat} {box : IxIR1.NodeBox} {identity : CtorId} + {fields : Array IxIR1.RVal} + (sourceAt : sidecars.sourceCodeAt? site = + some (.case scrutinee peelNat alternatives)) + (selected : alternatives[index]? = + some (.mk cidx fieldCount body)) + (environment : sidecars.SiteEnvironmentHolds store site values) + (resolved : IxIR1.resolveAtom values scrutinee = .ok (.loc location)) + (sourceGet : store.get? location = some box) + (node : box.node = .ctorN identity fields) + (tag : identity.cidx = cidx) + (fieldCountEq : fields.size = fieldCount) : + sidecars.SiteEnvironmentHolds store (site.alternative index) + (fields.toList.reverse ++ values) := by + cases currentEq : sidecars.siteFacts? site with + | none => + intro next nextFound + rw [sidecars.siteFacts?_alternative_eq_none sourceAt currentEq] + at nextFound + contradiction + | some current => + have recoveredSource := sidecars.siteFacts?_sourceCodeAt currentEq + have codeAt : current.code = + .case scrutinee peelNat alternatives := + Option.some.inj (recoveredSource.symm.trans sourceAt) + exact sidecars.siteEnvironmentHolds_alternative_ctor_of_siteFacts + currentEq codeAt selected environment resolved sourceGet node tag + fieldCountEq + +/-- Source-facing zero Nat branch transport, including the fail-closed HPT +case. -/ +theorem Sidecars.siteEnvironmentHolds_alternative_natZero + (sidecars : Sidecars) + {store : IxIR1.Store} {site : Lower.SourceSite} + {values : List IxIR1.RVal} {scrutinee : IxIR1.Atom} + {alternatives : Array IxIR1.Alt} {index : Nat} {body : IxIR1.Code} + (sourceAt : sidecars.sourceCodeAt? site = + some (.case scrutinee true alternatives)) + (selected : alternatives[index]? = some (.mk 0 0 body)) + (environment : sidecars.SiteEnvironmentHolds store site values) : + sidecars.SiteEnvironmentHolds store (site.alternative index) values := by + cases currentEq : sidecars.siteFacts? site with + | none => + intro next nextFound + rw [sidecars.siteFacts?_alternative_eq_none sourceAt currentEq] + at nextFound + contradiction + | some current => + have recoveredSource := sidecars.siteFacts?_sourceCodeAt currentEq + have codeAt : current.code = .case scrutinee true alternatives := + Option.some.inj (recoveredSource.symm.trans sourceAt) + exact sidecars.siteEnvironmentHolds_alternative_natZero_of_siteFacts + currentEq codeAt selected environment + +/-- Source-facing successor Nat branch transport, including the fail-closed +HPT case. -/ +theorem Sidecars.siteEnvironmentHolds_alternative_natSucc + (sidecars : Sidecars) + {store : IxIR1.Store} {site : Lower.SourceSite} + {values : List IxIR1.RVal} {scrutinee : IxIR1.Atom} + {alternatives : Array IxIR1.Alt} {index predecessor : Nat} + {body : IxIR1.Code} + (sourceAt : sidecars.sourceCodeAt? site = + some (.case scrutinee true alternatives)) + (selected : alternatives[index]? = some (.mk 1 1 body)) + (environment : sidecars.SiteEnvironmentHolds store site values) + (resolved : IxIR1.resolveAtom values scrutinee = + .ok (.lit (.nat (predecessor + 1)))) : + sidecars.SiteEnvironmentHolds store (site.alternative index) + (.lit (.nat predecessor) :: values) := by + cases currentEq : sidecars.siteFacts? site with + | none => + intro next nextFound + rw [sidecars.siteFacts?_alternative_eq_none sourceAt currentEq] + at nextFound + contradiction + | some current => + have recoveredSource := sidecars.siteFacts?_sourceCodeAt currentEq + have codeAt : current.code = .case scrutinee true alternatives := + Option.some.inj (recoveredSource.symm.trans sourceAt) + exact sidecars.siteEnvironmentHolds_alternative_natSucc_of_siteFacts + currentEq codeAt selected environment resolved + +/-- One successful concrete source operation transports the recovered HPT +environment to `site.next`. Abstract failure remains `none`; abstract success +uses operation soundness for the new head fact and forgets heap detail from +the preserved tail. -/ +theorem Sidecars.siteEnvironmentHolds_next (sidecars : Sidecars) + {sourceContext : IxIR1.Ctx} {sourceCurrent : IxIR1.FnDef} + {sourceFuel : Nat} {sourceStore outputStore : IxIR1.Store} + {source : List IxIR1.RVal} {operation : IxIR1.Op} + {value : IxIR1.RVal} {site : Lower.SourceSite} {rest : IxIR1.Code} + (postFixpoint : IxIR1.HPT.LocalPostFixpoint + (IxIR1.Env.ofList sidecars.input.declarations) + sidecars.hptCertificate.summaryEnv) + (sourceDeclarations : sourceContext.decls = + IxIR1.Env.ofList sidecars.input.declarations) + (currentAt : sidecars.analysisCurrent? site.owner = some sourceCurrent) + (environment : sidecars.SiteEnvironmentHolds sourceStore site source) + (sourceAt : sidecars.sourceCodeAt? site = + some (.letOp operation rest)) + (sourceRun : IxIR1.runOp sourceContext sourceFuel sourceCurrent + sourceStore source operation = .ok (outputStore, value)) : + sidecars.SiteEnvironmentHolds outputStore site.next (value :: source) := by + intro nextAnalyzed nextFound + rw [sidecars.siteFacts?_next] at nextFound + cases currentEq : sidecars.siteFacts? site with + | none => + rw [currentEq] at nextFound + contradiction + | some current => + have currentEnvironment := environment current currentEq + have recoveredSource := sidecars.siteFacts?_sourceCodeAt currentEq + have codeEq : current.code = .letOp operation rest := + Option.some.inj (recoveredSource.symm.trans sourceAt) + rw [currentEq] at nextFound + simp only [Option.bind] at nextFound + unfold Sidecars.advanceSiteFacts? at nextFound + cases rootEq : analysisRoot? sidecars site.owner with + | none => + simp [rootEq] at nextFound + | some root => + have currentRoot : root.current = sourceCurrent := by + unfold Sidecars.analysisCurrent? at currentAt + rw [rootEq] at currentAt + exact Option.some.inj currentAt + subst sourceCurrent + have ownerCompatible := analysisRoot_ownerCompatible sidecars rootEq + rw [codeEq] at nextFound + cases abstractEq : IxIR1.HPT.analyzeOp + (IxIR1.Env.ofList sidecars.input.declarations) + sidecars.hptCertificate.summaryEnv root.owner root.current + current.facts operation with + | error error => + simp [rootEq, advanceAnalyzedPair, advanceFacts, abstractEq] + at nextFound + change none = some nextAnalyzed at nextFound + contradiction + | ok bound => + simp [rootEq, advanceAnalyzedPair, advanceFacts, abstractEq] + at nextFound + change some + ({ + facts := bound :: + current.facts.map IxIR1.HPT.Fact.forgetHeap + code := rest + } : SiteFacts) = some nextAnalyzed at nextFound + cases nextFound + exact IxIR1.HPT.EnvironmentHolds.cons + (IxIR1.HPT.analyzeOp_sound_ownerCompatible postFixpoint + sourceDeclarations ownerCompatible currentEnvironment + abstractEq sourceRun) + currentEnvironment.forgetHeap + +/-- Linear transport only needs the concrete evaluator's current function to +agree when path-local analysis actually has a root. If analysis fails closed +for the owner, every site predicate is vacuous and remains so at `site.next`. +This form covers the synthetic main even when its reserved analysis address +collides with a declaration summary. -/ +theorem Sidecars.siteEnvironmentHolds_next_of_currentCompatible + (sidecars : Sidecars) + {sourceContext : IxIR1.Ctx} {sourceCurrent : IxIR1.FnDef} + {sourceFuel : Nat} {sourceStore outputStore : IxIR1.Store} + {source : List IxIR1.RVal} {operation : IxIR1.Op} + {value : IxIR1.RVal} {site : Lower.SourceSite} {rest : IxIR1.Code} + (postFixpoint : IxIR1.HPT.LocalPostFixpoint + (IxIR1.Env.ofList sidecars.input.declarations) + sidecars.hptCertificate.summaryEnv) + (sourceDeclarations : sourceContext.decls = + IxIR1.Env.ofList sidecars.input.declarations) + (currentCompatible : ∀ current, + sidecars.analysisCurrent? site.owner = some current → + current = sourceCurrent) + (environment : sidecars.SiteEnvironmentHolds sourceStore site source) + (sourceAt : sidecars.sourceCodeAt? site = + some (.letOp operation rest)) + (sourceRun : IxIR1.runOp sourceContext sourceFuel sourceCurrent + sourceStore source operation = .ok (outputStore, value)) : + sidecars.SiteEnvironmentHolds outputStore site.next + (value :: source) := by + cases currentEq : sidecars.analysisCurrent? site.owner with + | some current => + have currentMatches := currentCompatible current currentEq + subst current + exact sidecars.siteEnvironmentHolds_next postFixpoint + sourceDeclarations currentEq environment sourceAt sourceRun + | none => + intro analyzed nextFound + unfold Sidecars.analysisCurrent? at currentEq + cases rootEq : analysisRoot? sidecars site.owner with + | none => + unfold Sidecars.siteFacts? at nextFound + simp [Lower.SourceSite.next, rootEq] at nextFound + | some root => + rw [rootEq] at currentEq + simp at currentEq + +/-- Resolve one source operand in the recovered site environment and retain it +only when the abstract value has one exact constructor identity. -/ +def Sidecars.exactConstructorAt? (sidecars : Sidecars) + (site : Lower.SourceSite) (atom : IxIR1.Atom) : + Option (IxIR1.HPT.Fact × CtorId) := do + let analyzed ← sidecars.siteFacts? site + let fact ← match IxIR1.HPT.resolveAtomFact analyzed.facts atom with + | .ok fact => some fact + | .error _ => none + let identity ← fact.exactConstructor? + return (fact, identity) + +/-- Successful exact-constructor extraction exposes every checked executable +premise needed to connect the chosen identity to HPT soundness. -/ +theorem Sidecars.exactConstructorAt?_eq_some (sidecars : Sidecars) + {site : Lower.SourceSite} {atom : IxIR1.Atom} + {fact : IxIR1.HPT.Fact} {identity : CtorId} + (found : sidecars.exactConstructorAt? site atom = some (fact, identity)) : + ∃ analyzed, + sidecars.siteFacts? site = some analyzed ∧ + IxIR1.HPT.resolveAtomFact analyzed.facts atom = .ok fact ∧ + fact.exactConstructor? = some identity := by + cases analyzedEq : sidecars.siteFacts? site with + | none => + simp [Sidecars.exactConstructorAt?, analyzedEq] at found + | some analyzed => + cases resolvedEq : IxIR1.HPT.resolveAtomFact analyzed.facts atom with + | error error => + simp [Sidecars.exactConstructorAt?, analyzedEq, resolvedEq] at found + | ok resolved => + cases exactEq : resolved.exactConstructor? with + | none => + simp [Sidecars.exactConstructorAt?, analyzedEq, resolvedEq, + exactEq] at found + | some resolvedIdentity => + simp [Sidecars.exactConstructorAt?, analyzedEq, resolvedEq, + exactEq] at found + rcases found with ⟨rfl, rfl⟩ + exact ⟨analyzed, rfl, resolvedEq, exactEq⟩ + +/-- An exact constructor selected by a source-site sidecar is the constructor +stored at the concrete operand location whenever the replayed abstract +environment describes the current source environment. -/ +theorem Sidecars.exactConstructorAt?_runtime (sidecars : Sidecars) + {site : Lower.SourceSite} {atom : IxIR1.Atom} + {fact : IxIR1.HPT.Fact} {identity : CtorId} + {declarations : IxIR1.HPT.DeclEnv} {store : IxIR1.Store} + {values : List IxIR1.RVal} {location : Nat} + (found : sidecars.exactConstructorAt? site atom = some (fact, identity)) + (environment : ∀ analyzed, + sidecars.siteFacts? site = some analyzed → + IxIR1.HPT.EnvironmentHolds declarations store analyzed.facts values) + (resolved : IxIR1.resolveAtom values atom = .ok (.loc location)) : + ∃ box fields, + store.get? location = some box ∧ + box.node = .ctorN identity fields := by + obtain ⟨analyzed, siteFound, abstractResolved, exact⟩ := + sidecars.exactConstructorAt?_eq_some found + have factHolds := IxIR1.HPT.resolveAtom_sound + (environment analyzed siteFound) abstractResolved resolved + exact IxIR1.HPT.Fact.exactConstructor?_holds_loc exact factHolds + +/-- The constructor identity carried by any concrete node reached by the +selected operand agrees with the exact identity chosen by the sidecar. -/ +theorem Sidecars.exactConstructorAt?_matches_node (sidecars : Sidecars) + {site : Lower.SourceSite} {atom : IxIR1.Atom} + {fact : IxIR1.HPT.Fact} {identity runtimeIdentity : CtorId} + {declarations : IxIR1.HPT.DeclEnv} {store : IxIR1.Store} + {values : List IxIR1.RVal} {location : Nat} + {box : IxIR1.NodeBox} {fields : Array IxIR1.RVal} + (found : sidecars.exactConstructorAt? site atom = some (fact, identity)) + (environment : ∀ analyzed, + sidecars.siteFacts? site = some analyzed → + IxIR1.HPT.EnvironmentHolds declarations store analyzed.facts values) + (resolved : IxIR1.resolveAtom values atom = .ok (.loc location)) + (sourceGet : store.get? location = some box) + (node : box.node = .ctorN runtimeIdentity fields) : + runtimeIdentity = identity := by + obtain ⟨exactBox, exactFields, exactGet, exactNode⟩ := + sidecars.exactConstructorAt?_runtime found environment resolved + have boxEq : exactBox = box := + Option.some.inj (exactGet.symm.trans sourceGet) + subst exactBox + rw [node] at exactNode + injection exactNode + +/-- Resolve one source operand in the recovered site environment and retain it +only when HPT describes one exact constructor whose complete field vector is +scalar. Unlike `exactConstructorAt?`, this is strong enough to justify the +target evaluator's shallow-free side condition. -/ +def Sidecars.scalarLeafAt? (sidecars : Sidecars) + (site : Lower.SourceSite) (atom : IxIR1.Atom) : + Option (IxIR1.HPT.Fact × CtorId) := do + let analyzed ← sidecars.siteFacts? site + let fact ← match IxIR1.HPT.resolveAtomFact analyzed.facts atom with + | .ok fact => some fact + | .error _ => none + let leaf ← IxIR1.HPT.Destroy.exactLeaf? fact + return (fact, leaf.identity) + +/-- Successful scalar-leaf extraction exposes the checked HPT premises used +by its concrete soundness theorem. -/ +theorem Sidecars.scalarLeafAt?_eq_some (sidecars : Sidecars) + {site : Lower.SourceSite} {atom : IxIR1.Atom} + {fact : IxIR1.HPT.Fact} {identity : CtorId} + (found : sidecars.scalarLeafAt? site atom = some (fact, identity)) : + ∃ analyzed leaf, + sidecars.siteFacts? site = some analyzed ∧ + IxIR1.HPT.resolveAtomFact analyzed.facts atom = .ok fact ∧ + IxIR1.HPT.Destroy.exactLeaf? fact = some leaf ∧ + leaf.identity = identity := by + cases analyzedEq : sidecars.siteFacts? site with + | none => + simp [Sidecars.scalarLeafAt?, analyzedEq] at found + | some analyzed => + cases resolvedEq : IxIR1.HPT.resolveAtomFact analyzed.facts atom with + | error error => + simp [Sidecars.scalarLeafAt?, analyzedEq, resolvedEq] at found + | ok resolved => + cases leafEq : IxIR1.HPT.Destroy.exactLeaf? resolved with + | none => + simp [Sidecars.scalarLeafAt?, analyzedEq, resolvedEq, + leafEq] at found + | some leaf => + simp [Sidecars.scalarLeafAt?, analyzedEq, resolvedEq, + leafEq] at found + rcases found with ⟨rfl, rfl⟩ + exact ⟨analyzed, leaf, rfl, resolvedEq, leafEq, rfl⟩ + +/-- A scalar leaf selected by a source-site sidecar determines both the +constructor and the all-scalar field condition of the concrete operand. -/ +theorem Sidecars.scalarLeafAt?_runtime (sidecars : Sidecars) + {site : Lower.SourceSite} {atom : IxIR1.Atom} + {fact : IxIR1.HPT.Fact} {identity : CtorId} + {declarations : IxIR1.HPT.DeclEnv} {store : IxIR1.Store} + {values : List IxIR1.RVal} {location : Nat} + (found : sidecars.scalarLeafAt? site atom = some (fact, identity)) + (environment : ∀ analyzed, + sidecars.siteFacts? site = some analyzed → + IxIR1.HPT.EnvironmentHolds declarations store analyzed.facts values) + (resolved : IxIR1.resolveAtom values atom = .ok (.loc location)) : + ∃ box fields, + store.get? location = some box ∧ + box.node = .ctorN identity fields ∧ + fields.all IxIR1.RVal.isScalar = true := by + obtain ⟨analyzed, leaf, siteFound, abstractResolved, exactLeaf, + leafIdentity⟩ := sidecars.scalarLeafAt?_eq_some found + have factHolds := IxIR1.HPT.resolveAtom_sound + (environment analyzed siteFound) abstractResolved resolved + obtain ⟨runtimeLocation, box, fields, valueEq, sourceGet, node, + scalarFields⟩ := + IxIR1.HPT.Destroy.exactLeaf?_holds exactLeaf factHolds + injection valueEq with locationEq + subst runtimeLocation + rw [leafIdentity] at node + exact ⟨box, fields, sourceGet, node, by simpa using scalarFields⟩ + +/-- The stronger scalar-leaf lookup agrees with any concrete constructor node +at the selected operand and simultaneously proves its field vector scalar. -/ +theorem Sidecars.scalarLeafAt?_matches_node (sidecars : Sidecars) + {site : Lower.SourceSite} {atom : IxIR1.Atom} + {fact : IxIR1.HPT.Fact} {identity runtimeIdentity : CtorId} + {declarations : IxIR1.HPT.DeclEnv} {store : IxIR1.Store} + {values : List IxIR1.RVal} {location : Nat} + {box : IxIR1.NodeBox} {fields : Array IxIR1.RVal} + (found : sidecars.scalarLeafAt? site atom = some (fact, identity)) + (environment : ∀ analyzed, + sidecars.siteFacts? site = some analyzed → + IxIR1.HPT.EnvironmentHolds declarations store analyzed.facts values) + (resolved : IxIR1.resolveAtom values atom = .ok (.loc location)) + (sourceGet : store.get? location = some box) + (node : box.node = .ctorN runtimeIdentity fields) : + runtimeIdentity = identity ∧ fields.all IxIR1.RVal.isScalar = true := by + obtain ⟨exactBox, exactFields, exactGet, exactNode, scalarFields⟩ := + sidecars.scalarLeafAt?_runtime found environment resolved + have boxEq : exactBox = box := + Option.some.inj (exactGet.symm.trans sourceGet) + subst exactBox + have constructorEq : + (.ctorN runtimeIdentity fields : IxIR1.Node) = + .ctorN identity exactFields := node.symm.trans exactNode + injection constructorEq with identityEq fieldsEq + subst identity + subst exactFields + exact ⟨rfl, scalarFields⟩ + +private def constructorInfo? (sidecars : Sidecars) (identity : CtorId) : + Option ConstructorInfo := + sidecars.constructors.find? fun info => info.identity == identity + +def Sidecars.fetchCtor? (sidecars : Sidecars) + (site : Lower.SourceSite) : Option CtorId := do + let analyzed ← sidecars.siteFacts? site + match analyzed.code with + | .letOp (.fetch target field) _ => do + let (_, identity) ← sidecars.exactConstructorAt? site target + let info ← constructorInfo? sidecars identity + if field < info.arity then some identity else none + | _ => none + +def Sidecars.scalarFreeCtor? (sidecars : Sidecars) + (site : Lower.SourceSite) : Option CtorId := do + let analyzed ← sidecars.siteFacts? site + match analyzed.code with + | .letOp (.free target) _ => do + let (_, identity) ← sidecars.scalarLeafAt? site target + let info ← constructorInfo? sidecars identity + if info.arity == 0 then some identity else none + | _ => none + +def Sidecars.caseCtors (sidecars : Sidecars) (site : Lower.SourceSite) + (alternative : Nat) : List CtorId := + match codeAtSite? sidecars.input site with + | some (.case scrutinee _ alternatives) => + match alternatives[alternative]? with + | some (.mk tag fields _) => + match sidecars.exactConstructorAt? site scrutinee with + | some (_, identity) => + match constructorInfo? sidecars identity with + | some info => + if identity.cidx == tag && info.arity == fields then + [identity] + else + [] + | none => [] + | none => + (sidecars.constructors.filter fun info => + info.identity.cidx == tag && info.arity == fields).map + (·.identity) |>.eraseDups + | none => [] + | _ => [] + +/-- The exact lowering context computed for this attachment. Case lowering +prefers an exact path-local HPT identity and otherwise emits every +producer-known full identity matching the erased source tag and arity. +Projection and shallow-free facts remain deliberately partial and fail closed +when their identity is ambiguous. -/ +def Sidecars.context (sidecars : Sidecars) (maxDepth : Nat := 100000) : + Lower.Context := + { parameterWorlds := lookupParameterWorlds sidecars.parameterEntries + schemas := schema? sidecars.constructors + fetchCtor := sidecars.fetchCtor? + scalarFreeCtor := sidecars.scalarFreeCtor? + caseCtors := sidecars.caseCtors + allowExtern := false + maxDepth } + +/-! ## Extern-free trace coverage + +The attachment's lowering context disables scalar extern boundaries. Retain +that fail-closed decision as a recursive trace certificate so the semantic +worker can eliminate an apparent successful source `extern` branch without +replaying the compiler or validator. -/ + +mutual + +/-- No recursive node in one compiler trace contains a source extern +operation. -/ +def Sidecars.codeExternFree (_sidecars : Sidecars) : Lower.CodeTrace → Bool + | .ret .. | .tailCall .. | .tailCallSelf .. => true + | .letOp _ _ _ _ _ (.extern _ _) _ _ _ => false + | .letOp _ _ _ _ _ _ _ _ next => _sidecars.codeExternFree next + | .switchValue _ _ _ _ _ _ _ _ _ _ children => + _sidecars.codeExternFreeList children + +private def Sidecars.codeExternFreeList (sidecars : Sidecars) : + List Lower.CodeTrace → Bool + | [] => true + | trace :: traces => + sidecars.codeExternFree trace && sidecars.codeExternFreeList traces + +end + +/-- Whole-trace extern exclusion checked at attachment time. -/ +def Sidecars.traceExternFree (sidecars : Sidecars) + (trace : Lower.Trace) : Bool := + trace.functions.all fun functionTrace => + sidecars.codeExternFree functionTrace.root + +private theorem Sidecars.codeExternFreeList_of_mem (sidecars : Sidecars) + {traces : List Lower.CodeTrace} {trace : Lower.CodeTrace} + (matched : sidecars.codeExternFreeList traces = true) + (member : trace ∈ traces) : + sidecars.codeExternFree trace = true := by + induction traces with + | nil => simp at member + | cons head tail ih => + simp only [Sidecars.codeExternFreeList, Bool.and_eq_true] at matched + simp only [List.mem_cons] at member + cases member with + | inl equal => simpa [equal] using matched.1 + | inr member => exact ih matched.2 member + +/-- Extern exclusion is inherited by every immediate recursive child. -/ +theorem Sidecars.codeExternFree_of_child (sidecars : Sidecars) + {parent child : Lower.CodeTrace} + (matched : sidecars.codeExternFree parent = true) + (member : child ∈ parent.children) : + sidecars.codeExternFree child = true := by + cases parent with + | ret _ _ _ _ _ _ _ | tailCall _ _ _ _ _ _ _ + | tailCallSelf _ _ _ _ _ _ => + simp [Lower.CodeTrace.children] at member + | letOp site block input nextInput entryValueCount operation index + instruction next => + simp [Lower.CodeTrace.children] at member + subst child + cases operation <;> + simp_all [Sidecars.codeExternFree] + | switchValue site block input entryValueCount scrutinee peel alternatives + target generated outgoing children => + exact sidecars.codeExternFreeList_of_mem matched member + +/-- Extern exclusion is inherited by every recursive descendant. -/ +theorem Sidecars.codeExternFree_descendant (sidecars : Sidecars) + {root child : Lower.CodeTrace} + (matched : sidecars.codeExternFree root = true) + (descendant : root.Descendant child) : + sidecars.codeExternFree child = true := by + induction descendant with + | refl => exact matched + | @step parent child parentDescendant childMember ih => + exact sidecars.codeExternFree_of_child ih childMember + +/-- Whole-trace extern exclusion selects any retained function root. -/ +theorem Sidecars.functionCodeExternFree (sidecars : Sidecars) + {trace : Lower.Trace} {functionTrace : Lower.FunctionTrace} + (matched : sidecars.traceExternFree trace = true) + (member : functionTrace ∈ trace.functions) : + sidecars.codeExternFree functionTrace.root = true := + List.all_eq_true.mp matched functionTrace member + +/-! ## Scalar-leaf trace coverage + +The lowerer records a validator fact for every emitted `freeUnique`. The +following independent executable check ties every such recursive trace node +back to the stronger HPT scalar-leaf lookup used by `scalarFreeCtor?`. Its +reflected descendant theorem lets simulation recover that semantic evidence +from attachment membership instead of accepting it from a caller. -/ + +private def Sidecars.scalarLeafInstructionMatches (sidecars : Sidecars) + (site : Lower.SourceSite) : IxIR1.Op → Instr → Bool + | .free source, .freeUnique _ identity => + match sidecars.scalarLeafAt? site source with + | some (_, selectedIdentity) => selectedIdentity == identity + | none => false + | _, _ => true + +mutual + +/-- Every shallow-free node in one recursive compiler trace has exact +all-scalar HPT evidence at its literal source coordinate. -/ +def Sidecars.codeScalarLeavesMatch (sidecars : Sidecars) : + Lower.CodeTrace → Bool + | .ret .. | .tailCall .. | .tailCallSelf .. => true + | .letOp site _ _ _ _ operation _ instruction next => + sidecars.scalarLeafInstructionMatches site operation instruction && + sidecars.codeScalarLeavesMatch next + | .switchValue _ _ _ _ _ _ _ _ _ _ children => + sidecars.codeScalarLeafListMatches children + +private def Sidecars.codeScalarLeafListMatches (sidecars : Sidecars) : + List Lower.CodeTrace → Bool + | [] => true + | trace :: traces => + sidecars.codeScalarLeavesMatch trace && + sidecars.codeScalarLeafListMatches traces + +end + +/-- Whole-trace scalar-leaf coverage checked at attachment time. -/ +def Sidecars.traceScalarLeavesMatch (sidecars : Sidecars) + (trace : Lower.Trace) : Bool := + trace.functions.all fun functionTrace => + sidecars.codeScalarLeavesMatch functionTrace.root + +private theorem Sidecars.codeScalarLeafListMatch_of_mem + (sidecars : Sidecars) {traces : List Lower.CodeTrace} + {trace : Lower.CodeTrace} + (matched : sidecars.codeScalarLeafListMatches traces = true) + (member : trace ∈ traces) : + sidecars.codeScalarLeavesMatch trace = true := by + induction traces with + | nil => simp at member + | cons head tail ih => + simp only [Sidecars.codeScalarLeafListMatches, Bool.and_eq_true] at matched + simp only [List.mem_cons] at member + cases member with + | inl equal => simpa [equal] using matched.1 + | inr member => exact ih matched.2 member + +/-- Scalar-leaf coverage is inherited by every immediate recursive compiler +call. -/ +theorem Sidecars.codeScalarLeavesMatch_of_child (sidecars : Sidecars) + {parent child : Lower.CodeTrace} + (matched : sidecars.codeScalarLeavesMatch parent = true) + (member : child ∈ parent.children) : + sidecars.codeScalarLeavesMatch child = true := by + cases parent with + | ret _ _ _ _ _ _ _ | tailCall _ _ _ _ _ _ _ + | tailCallSelf _ _ _ _ _ _ => + simp [Lower.CodeTrace.children] at member + | letOp site block input nextInput entryValueCount operation index + instruction next => + simp [Lower.CodeTrace.children] at member + subst child + simp only [Sidecars.codeScalarLeavesMatch, Bool.and_eq_true] at matched + exact matched.2 + | switchValue site block input entryValueCount scrutinee peel alternatives + target generated outgoing children => + exact sidecars.codeScalarLeafListMatch_of_mem matched member + +/-- Scalar-leaf coverage is inherited by every recursive descendant. -/ +theorem Sidecars.codeScalarLeavesMatch_descendant (sidecars : Sidecars) + {root child : Lower.CodeTrace} + (matched : sidecars.codeScalarLeavesMatch root = true) + (descendant : root.Descendant child) : + sidecars.codeScalarLeavesMatch child = true := by + induction descendant with + | refl => exact matched + | @step parent child parentDescendant childMember ih => + exact sidecars.codeScalarLeavesMatch_of_child ih childMember + +/-- Whole-trace coverage selects any retained function root. -/ +theorem Sidecars.functionCodeScalarLeavesMatch (sidecars : Sidecars) + {trace : Lower.Trace} {functionTrace : Lower.FunctionTrace} + (matched : sidecars.traceScalarLeavesMatch trace = true) + (member : functionTrace ∈ trace.functions) : + sidecars.codeScalarLeavesMatch functionTrace.root = true := + List.all_eq_true.mp matched functionTrace member + +/-- Reflection at one shallow-free trace node recovers the exact HPT fact and +constructor identity consumed by its target instruction. -/ +theorem Sidecars.scalarLeafAt?_of_codeScalarLeavesMatch + (sidecars : Sidecars) + {site : Lower.SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount index : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {identity : CtorId} + {next : Lower.CodeTrace} + (matched : sidecars.codeScalarLeavesMatch + (.letOp site block input nextInput entryValueCount + (.free sourceAtom) index (.freeUnique targetAtom identity) next) = true) : + ∃ fact, + sidecars.scalarLeafAt? site sourceAtom = some (fact, identity) := by + simp only [Sidecars.codeScalarLeavesMatch, Bool.and_eq_true] at matched + have head := matched.1 + unfold Sidecars.scalarLeafInstructionMatches at head + cases selected : sidecars.scalarLeafAt? site sourceAtom with + | none => simp [selected] at head + | some pair => + obtain ⟨fact, selectedIdentity⟩ := pair + have identityEq : selectedIdentity = identity := by + exact (beq_iff_eq.mp (by simpa [selected] using head)) + exact ⟨fact, by simp [identityEq]⟩ + +/-! ## Exact-fetch trace coverage + +The lowering context selects source projections from exact HPT constructor +facts. This independent recursive check records that every retained source +fetch uses that same identity, so attachment-facing simulation can recover the +erased constructor fact from trace membership alone. -/ + +private def Sidecars.exactFetchInstructionMatches (sidecars : Sidecars) + (site : Lower.SourceSite) : IxIR1.Op → Instr → Bool + | .fetch source _, .fetch _ identity _ => + match sidecars.exactConstructorAt? site source with + | some (_, selectedIdentity) => selectedIdentity == identity + | none => false + | _, _ => true + +mutual + +/-- Every source-fetch node in one recursive compiler trace retains exact HPT +constructor evidence at its literal source coordinate. -/ +def Sidecars.codeExactFetchesMatch (sidecars : Sidecars) : + Lower.CodeTrace → Bool + | .ret .. | .tailCall .. | .tailCallSelf .. => true + | .letOp site _ _ _ _ operation _ instruction next => + sidecars.exactFetchInstructionMatches site operation instruction && + sidecars.codeExactFetchesMatch next + | .switchValue _ _ _ _ _ _ _ _ _ _ children => + sidecars.codeExactFetchListMatches children + +private def Sidecars.codeExactFetchListMatches (sidecars : Sidecars) : + List Lower.CodeTrace → Bool + | [] => true + | trace :: traces => + sidecars.codeExactFetchesMatch trace && + sidecars.codeExactFetchListMatches traces + +end + +/-- Whole-trace exact-fetch coverage checked at attachment time. -/ +def Sidecars.traceExactFetchesMatch (sidecars : Sidecars) + (trace : Lower.Trace) : Bool := + trace.functions.all fun functionTrace => + sidecars.codeExactFetchesMatch functionTrace.root + +private theorem Sidecars.codeExactFetchListMatch_of_mem + (sidecars : Sidecars) {traces : List Lower.CodeTrace} + {trace : Lower.CodeTrace} + (matched : sidecars.codeExactFetchListMatches traces = true) + (member : trace ∈ traces) : + sidecars.codeExactFetchesMatch trace = true := by + induction traces with + | nil => simp at member + | cons head tail ih => + simp only [Sidecars.codeExactFetchListMatches, Bool.and_eq_true] at matched + simp only [List.mem_cons] at member + cases member with + | inl equal => simpa [equal] using matched.1 + | inr member => exact ih matched.2 member + +/-- Exact-fetch coverage is inherited by every immediate recursive compiler +call. -/ +theorem Sidecars.codeExactFetchesMatch_of_child (sidecars : Sidecars) + {parent child : Lower.CodeTrace} + (matched : sidecars.codeExactFetchesMatch parent = true) + (member : child ∈ parent.children) : + sidecars.codeExactFetchesMatch child = true := by + cases parent with + | ret _ _ _ _ _ _ _ | tailCall _ _ _ _ _ _ _ + | tailCallSelf _ _ _ _ _ _ => + simp [Lower.CodeTrace.children] at member + | letOp site block input nextInput entryValueCount operation index + instruction next => + simp [Lower.CodeTrace.children] at member + subst child + simp only [Sidecars.codeExactFetchesMatch, Bool.and_eq_true] at matched + exact matched.2 + | switchValue site block input entryValueCount scrutinee peel alternatives + target generated outgoing children => + exact sidecars.codeExactFetchListMatch_of_mem matched member + +/-- Exact-fetch coverage is inherited by every recursive descendant. -/ +theorem Sidecars.codeExactFetchesMatch_descendant (sidecars : Sidecars) + {root child : Lower.CodeTrace} + (matched : sidecars.codeExactFetchesMatch root = true) + (descendant : root.Descendant child) : + sidecars.codeExactFetchesMatch child = true := by + induction descendant with + | refl => exact matched + | @step parent child parentDescendant childMember ih => + exact sidecars.codeExactFetchesMatch_of_child ih childMember + +/-- Whole-trace exact-fetch coverage selects any retained function root. -/ +theorem Sidecars.functionCodeExactFetchesMatch (sidecars : Sidecars) + {trace : Lower.Trace} {functionTrace : Lower.FunctionTrace} + (matched : sidecars.traceExactFetchesMatch trace = true) + (member : functionTrace ∈ trace.functions) : + sidecars.codeExactFetchesMatch functionTrace.root = true := + List.all_eq_true.mp matched functionTrace member + +/-- Reflection at one source-fetch trace node recovers the exact HPT fact and +constructor identity consumed by its target instruction. -/ +theorem Sidecars.exactConstructorAt?_of_codeExactFetchesMatch + (sidecars : Sidecars) + {site : Lower.SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount index : Nat} + {sourceAtom : IxIR1.Atom} {sourceField : Nat} + {targetAtom : Atom} {targetField : Nat} {identity : CtorId} + {next : Lower.CodeTrace} + (matched : sidecars.codeExactFetchesMatch + (.letOp site block input nextInput entryValueCount + (.fetch sourceAtom sourceField) index + (.fetch targetAtom identity targetField) next) = true) : + ∃ fact, + sidecars.exactConstructorAt? site sourceAtom = + some (fact, identity) := by + simp only [Sidecars.codeExactFetchesMatch, Bool.and_eq_true] at matched + have head := matched.1 + unfold Sidecars.exactFetchInstructionMatches at head + cases selected : sidecars.exactConstructorAt? site sourceAtom with + | none => simp [selected] at head + | some pair => + obtain ⟨fact, selectedIdentity⟩ := pair + have identityEq : selectedIdentity = identity := by + exact (beq_iff_eq.mp (by simpa [selected] using head)) + exact ⟨fact, by simp [identityEq]⟩ + +/-! ## Exact-constructor switch coverage + +When path-local HPT has already reduced a case scrutinee to one constructor, +the emitted switch must contain that exact identity. This check is separate +from structural switch coherence: it connects the erased source operand fact +to the concrete constructor table retained by the target terminator. Cases +whose HPT fact is not exact remain deliberately unconstrained here and are +handled by the residual dynamic coverage contract in `PipelineSim`. +-/ + +private def Sidecars.exactCaseTargetMatches (sidecars : Sidecars) + (site : Lower.SourceSite) (sourceScrutinee : IxIR1.Atom) + (generated : Block) : Bool := + match sidecars.exactConstructorAt? site sourceScrutinee with + | none => true + | some (_, identity) => + match generated.terminator with + | .switchValue _ constructors _ => + (constructors.find? fun target => target.cid == identity).isSome + | _ => false + +mutual + +/-- Every exact-HPT case in one recursive compiler trace has a target branch +for the selected constructor identity. -/ +def Sidecars.codeExactCaseTargetsMatch (sidecars : Sidecars) : + Lower.CodeTrace → Bool + | .ret .. | .tailCall .. | .tailCallSelf .. => true + | .letOp _ _ _ _ _ _ _ _ next => + sidecars.codeExactCaseTargetsMatch next + | .switchValue site _ _ _ sourceScrutinee _ _ _ generated _ children => + sidecars.exactCaseTargetMatches site sourceScrutinee generated && + sidecars.codeExactCaseTargetListMatches children + +private def Sidecars.codeExactCaseTargetListMatches (sidecars : Sidecars) : + List Lower.CodeTrace → Bool + | [] => true + | trace :: traces => + sidecars.codeExactCaseTargetsMatch trace && + sidecars.codeExactCaseTargetListMatches traces + +end + +/-- Whole-trace exact-HPT constructor-switch coverage checked at attachment +time. -/ +def Sidecars.traceExactCaseTargetsMatch (sidecars : Sidecars) + (trace : Lower.Trace) : Bool := + trace.functions.all fun functionTrace => + sidecars.codeExactCaseTargetsMatch functionTrace.root + +private theorem Sidecars.codeExactCaseTargetListMatch_of_mem + (sidecars : Sidecars) {traces : List Lower.CodeTrace} + {trace : Lower.CodeTrace} + (matched : sidecars.codeExactCaseTargetListMatches traces = true) + (member : trace ∈ traces) : + sidecars.codeExactCaseTargetsMatch trace = true := by + induction traces with + | nil => simp at member + | cons head tail ih => + simp only [Sidecars.codeExactCaseTargetListMatches, + Bool.and_eq_true] at matched + simp only [List.mem_cons] at member + cases member with + | inl equal => simpa [equal] using matched.1 + | inr member => exact ih matched.2 member + +/-- Exact-case coverage is inherited by every immediate recursive compiler +call. -/ +theorem Sidecars.codeExactCaseTargetsMatch_of_child (sidecars : Sidecars) + {parent child : Lower.CodeTrace} + (matched : sidecars.codeExactCaseTargetsMatch parent = true) + (member : child ∈ parent.children) : + sidecars.codeExactCaseTargetsMatch child = true := by + cases parent with + | ret _ _ _ _ _ _ _ | tailCall _ _ _ _ _ _ _ + | tailCallSelf _ _ _ _ _ _ => + simp [Lower.CodeTrace.children] at member + | letOp site block input nextInput entryValueCount operation index + instruction next => + simp [Lower.CodeTrace.children] at member + subst child + exact matched + | switchValue site block input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children => + simp only [Sidecars.codeExactCaseTargetsMatch, + Bool.and_eq_true] at matched + exact sidecars.codeExactCaseTargetListMatch_of_mem matched.2 member + +/-- Exact-case coverage is inherited by every recursive descendant. -/ +theorem Sidecars.codeExactCaseTargetsMatch_descendant (sidecars : Sidecars) + {root child : Lower.CodeTrace} + (matched : sidecars.codeExactCaseTargetsMatch root = true) + (descendant : root.Descendant child) : + sidecars.codeExactCaseTargetsMatch child = true := by + induction descendant with + | refl => exact matched + | @step parent child parentDescendant childMember ih => + exact sidecars.codeExactCaseTargetsMatch_of_child ih childMember + +/-- Whole-trace exact-case coverage selects any retained function root. -/ +theorem Sidecars.functionCodeExactCaseTargetsMatch (sidecars : Sidecars) + {trace : Lower.Trace} {functionTrace : Lower.FunctionTrace} + (matched : sidecars.traceExactCaseTargetsMatch trace = true) + (member : functionTrace ∈ trace.functions) : + sidecars.codeExactCaseTargetsMatch functionTrace.root = true := + List.all_eq_true.mp matched functionTrace member + +/-- Reflection at one switch node recovers an emitted target for the exact +constructor selected by HPT. -/ +theorem Sidecars.exactCaseTarget_of_codeExactCaseTargetsMatch + (sidecars : Sidecars) + {site : Lower.SourceSite} {block : BlockId} + {input : Array (Option Atom)} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {targetScrutinee : Atom} + {generated : Block} {outgoing : List Lower.EdgeTrace} + {children : List Lower.CodeTrace} {fact : IxIR1.HPT.Fact} + {identity : CtorId} {constructors : Array CtorAlt} + {natPeel : Option NatPeel} + (matched : sidecars.codeExactCaseTargetsMatch + (.switchValue site block input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children) = true) + (selected : sidecars.exactConstructorAt? site sourceScrutinee = + some (fact, identity)) + (terminator : generated.terminator = + .switchValue targetScrutinee constructors natPeel) : + ∃ target, constructors.find? (fun candidate => + candidate.cid == identity) = some target := by + simp only [Sidecars.codeExactCaseTargetsMatch, + Bool.and_eq_true] at matched + have localMatch := matched.1 + unfold Sidecars.exactCaseTargetMatches at localMatch + rw [selected, terminator] at localMatch + cases found : constructors.find? (fun candidate => + candidate.cid == identity) with + | none => simp [found] at localMatch + | some target => exact ⟨target, rfl⟩ + +/-! ## Residual constructor-switch coverage + +When path-local HPT is not exact, IxIR₁ may still select any producer-known +constructor with the alternative's erased tag and arity. The baseline lowerer +emits each of those full identities. This independent attachment check records +that coverage over the retained recursive trace. -/ + +private def Sidecars.residualConstructorTargetMatches + (constructors : Array CtorAlt) (alternative : IxIR1.Alt) + (info : ConstructorInfo) : Bool := + match alternative with + | .mk tag fields _ => + if info.identity.cidx == tag && info.arity == fields then + (constructors.find? fun target => target.cid == info.identity).isSome + else + true + +private def Sidecars.residualCaseTargetsMatch (sidecars : Sidecars) + (site : Lower.SourceSite) (sourceScrutinee : IxIR1.Atom) + (alternatives : Array IxIR1.Alt) (generated : Block) : Bool := + match sidecars.exactConstructorAt? site sourceScrutinee with + | some _ => true + | none => + match generated.terminator with + | .switchValue _ constructors _ => + alternatives.toList.all fun alternative => + sidecars.constructors.all fun info => + Sidecars.residualConstructorTargetMatches constructors + alternative info + | _ => false + +mutual + +/-- Every HPT-ambiguous case in one recursive compiler trace covers every +producer-known constructor compatible with its selected IxIR₁ arm. -/ +def Sidecars.codeResidualCaseTargetsMatch (sidecars : Sidecars) : + Lower.CodeTrace → Bool + | .ret .. | .tailCall .. | .tailCallSelf .. => true + | .letOp _ _ _ _ _ _ _ _ next => + sidecars.codeResidualCaseTargetsMatch next + | .switchValue site _ _ _ sourceScrutinee _ alternatives _ generated _ + children => + sidecars.residualCaseTargetsMatch site sourceScrutinee alternatives + generated && + sidecars.codeResidualCaseTargetListMatches children + +private def Sidecars.codeResidualCaseTargetListMatches + (sidecars : Sidecars) : List Lower.CodeTrace → Bool + | [] => true + | trace :: traces => + sidecars.codeResidualCaseTargetsMatch trace && + sidecars.codeResidualCaseTargetListMatches traces + +end + +/-- Whole-trace residual constructor-switch coverage checked at attachment +time. -/ +def Sidecars.traceResidualCaseTargetsMatch (sidecars : Sidecars) + (trace : Lower.Trace) : Bool := + trace.functions.all fun functionTrace => + sidecars.codeResidualCaseTargetsMatch functionTrace.root + +private theorem Sidecars.codeResidualCaseTargetListMatch_of_mem + (sidecars : Sidecars) {traces : List Lower.CodeTrace} + {trace : Lower.CodeTrace} + (matched : sidecars.codeResidualCaseTargetListMatches traces = true) + (member : trace ∈ traces) : + sidecars.codeResidualCaseTargetsMatch trace = true := by + induction traces with + | nil => simp at member + | cons head tail ih => + simp only [Sidecars.codeResidualCaseTargetListMatches, + Bool.and_eq_true] at matched + simp only [List.mem_cons] at member + cases member with + | inl equal => simpa [equal] using matched.1 + | inr member => exact ih matched.2 member + +/-- Residual-case coverage is inherited by every immediate recursive +compiler call. -/ +theorem Sidecars.codeResidualCaseTargetsMatch_of_child (sidecars : Sidecars) + {parent child : Lower.CodeTrace} + (matched : sidecars.codeResidualCaseTargetsMatch parent = true) + (member : child ∈ parent.children) : + sidecars.codeResidualCaseTargetsMatch child = true := by + cases parent with + | ret _ _ _ _ _ _ _ | tailCall _ _ _ _ _ _ _ + | tailCallSelf _ _ _ _ _ _ => + simp [Lower.CodeTrace.children] at member + | letOp site block input nextInput entryValueCount operation index + instruction next => + simp [Lower.CodeTrace.children] at member + subst child + exact matched + | switchValue site block input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children => + simp only [Sidecars.codeResidualCaseTargetsMatch, + Bool.and_eq_true] at matched + exact sidecars.codeResidualCaseTargetListMatch_of_mem matched.2 member + +/-- Residual-case coverage is inherited by every recursive descendant. -/ +theorem Sidecars.codeResidualCaseTargetsMatch_descendant + (sidecars : Sidecars) {root child : Lower.CodeTrace} + (matched : sidecars.codeResidualCaseTargetsMatch root = true) + (descendant : root.Descendant child) : + sidecars.codeResidualCaseTargetsMatch child = true := by + induction descendant with + | refl => exact matched + | @step parent child parentDescendant childMember ih => + exact sidecars.codeResidualCaseTargetsMatch_of_child ih childMember + +/-- Whole-trace residual coverage selects any retained function root. -/ +theorem Sidecars.functionCodeResidualCaseTargetsMatch (sidecars : Sidecars) + {trace : Lower.Trace} {functionTrace : Lower.FunctionTrace} + (matched : sidecars.traceResidualCaseTargetsMatch trace = true) + (member : functionTrace ∈ trace.functions) : + sidecars.codeResidualCaseTargetsMatch functionTrace.root = true := + List.all_eq_true.mp matched functionTrace member + +/-- Reflection at one HPT-ambiguous switch: any producer constructor matching +the concrete source arm has a corresponding emitted target. -/ +theorem Sidecars.residualCaseTarget_of_codeResidualCaseTargetsMatch + (sidecars : Sidecars) + {site : Lower.SourceSite} {block : BlockId} + {input : Array (Option Atom)} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {targetScrutinee : Atom} + {generated : Block} {outgoing : List Lower.EdgeTrace} + {children : List Lower.CodeTrace} {identity : CtorId} + {arity alternativeIndex : Nat} {body : IxIR1.Code} + {constructors : Array CtorAlt} {natPeel : Option NatPeel} + (matched : sidecars.codeResidualCaseTargetsMatch + (.switchValue site block input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children) = true) + (ambiguous : sidecars.exactConstructorAt? site sourceScrutinee = none) + (known : ∃ info ∈ sidecars.constructors, + info.identity = identity ∧ info.arity = arity) + (sourceAlternative : Lower.sourceAlternativeAtTag? alternatives + identity.cidx = some + (.mk identity.cidx arity body, alternativeIndex)) + (terminator : generated.terminator = + .switchValue targetScrutinee constructors natPeel) : + ∃ target, constructors.find? (fun candidate => + candidate.cid == identity) = some target := by + simp only [Sidecars.codeResidualCaseTargetsMatch, + Bool.and_eq_true] at matched + have localMatch := matched.1 + unfold Sidecars.residualCaseTargetsMatch at localMatch + rw [ambiguous, terminator] at localMatch + obtain ⟨info, infoMember, infoIdentity, infoArity⟩ := known + have alternativeAt : alternatives[alternativeIndex]? = + some (.mk identity.cidx arity body) := + Lower.sourceAlternativeAtTag?_getElem? sourceAlternative + have alternativeMember : (.mk identity.cidx arity body : IxIR1.Alt) ∈ + alternatives.toList := by + simpa using + (Array.mem_iff_getElem?.mpr ⟨alternativeIndex, alternativeAt⟩) + have alternativeMatch := List.all_eq_true.mp localMatch + (.mk identity.cidx arity body) alternativeMember + have infoMatch := List.all_eq_true.mp alternativeMatch info infoMember + unfold Sidecars.residualConstructorTargetMatches at infoMatch + rw [infoIdentity, infoArity] at infoMatch + simp only [beq_self_eq_true, Bool.true_and, if_true] at infoMatch + cases found : constructors.find? (fun candidate => + candidate.cid == identity) with + | none => simp [found] at infoMatch + | some target => exact ⟨target, rfl⟩ + +/-- Every constructor schema emitted by the baseline pipeline is uniform in +the ownership world used to look it up. This is the static fact consumed by +the allocation-simulation proof to discharge the evaluator's field checks. -/ +theorem Sidecars.schema_fields_replicate (sidecars : Sidecars) + {maxDepth : Nat} {world : Owned} {identity : CtorId} + {schema : CtorSchema} + (found : (sidecars.context maxDepth).schemas world identity = + some schema) : + ∃ count, schema.fields = Array.replicate count world := by + change schema? sidecars.constructors world identity = some schema at found + unfold schema? at found + cases lookup : sidecars.constructors.find? + (fun candidate => candidate.identity == identity) with + | none => simp [lookup] at found + | some info => + simp [lookup] at found + subst schema + exact ⟨info.arity, rfl⟩ + +/-- A constructor-universe witness and a schema lookup share the same +identity-indexed sidecar row, so the runtime node arity is the schema arity. -/ +theorem Sidecars.schema_fields_of_constructorKnown (sidecars : Sidecars) + {maxDepth : Nat} {world : Owned} {identity : CtorId} {arity : Nat} + {schema : CtorSchema} + (known : sidecars.constructorKnown identity arity = true) + (found : (sidecars.context maxDepth).schemas world identity = some schema) : + schema.fields = Array.replicate arity world := by + change schema? sidecars.constructors world identity = some schema at found + unfold schema? at found + unfold Sidecars.constructorKnown at known + cases lookup : sidecars.constructors.find? + (fun candidate => candidate.identity == identity) with + | none => simp [lookup] at known + | some info => + simp [lookup] at found known + subst schema + simpa [known] + +/-- Sidecars paired with the checked HPT production from which their +interprocedural facts were taken. -/ +structure BuiltSidecars + {constants : List (Address × Ixon.Constant)} {mainAddress : Address} + {config : Ix.Compiler.Pipeline.Config} {mainWorld : Owned} + {eraseFuel lowerFuel : Nat} + (compilation : Ix.Compiler.Pipeline.ValidatedCompilation constants + mainAddress config mainWorld eraseFuel lowerFuel) where + sidecars : Sidecars + hpt : IxIR1.HPT.Production IxIR1.HPT.defaultProducerLimits.checker + compilation.lowering.result.artifacts + certificateProduced : sidecars.hptCertificate = hpt.certificate + inputProduced : sidecars.input = + { declarations := compilation.artifact.targetDecls + main := compilation.artifact.main + mainResult := mainWorld } + +/-- Build the sidecars for the exact addressed graph retained by validated +compilation. Parameter conflicts caused by IxIR₁ identities that erased +distinct ownership signatures fail closed before IxIR₂ lowering. The HPT +producer crosses its ordinary checked boundary before any summary is exposed +to a site query. -/ +def buildSidecars + {constants : List (Address × Ixon.Constant)} {mainAddress : Address} + {config : Ix.Compiler.Pipeline.Config} {mainWorld : Owned} + {eraseFuel lowerFuel : Nat} + (compilation : Ix.Compiler.Pipeline.ValidatedCompilation constants + mainAddress config mainWorld eraseFuel lowerFuel) : + Except Error (BuiltSidecars compilation) := do + let artifact := compilation.artifact + let hpt ← match IxIR1.HPT.produce compilation.lowering.result.artifacts with + | .ok production => pure production + | .error message => .error (.hpt message) + let parameterEntries ← buildParameterWorlds + compilation.erasure.result.declarations compilation.lowering.raw + compilation.lowering.result.addressMap + let recursorOrigins ← deriveRecursorOrigins + compilation.erasure.result.declarations + compilation.erasure.result.addressed.blocks compilation.lowering.raw + compilation.lowering.result.addressMap + let sidecars : Sidecars := + { input := + { declarations := artifact.targetDecls + main := artifact.main + mainResult := mainWorld } + parameterEntries + constructors := constructorInfos + compilation.erasure.result.declarations + compilation.erasure.result.addressed.blocks + recursorOrigins + hptCertificate := hpt.certificate } + return { + sidecars + hpt + certificateProduced := rfl + inputProduced := rfl + } + +/-- Common checked attachment for an exact ownership-lowered program. The +Ixon frontend and checked IxIR₀ transformations share this backend boundary. -/ +structure CompiledAttachment (mainWorld : Owned) (lowerFuel : Nat) where + source : Ix.Compiler.Pipeline.LoweredCompilation mainWorld lowerFuel + sidecars : Sidecars + hpt : IxIR1.HPT.Production IxIR1.HPT.defaultProducerLimits.checker + source.lowering.result.artifacts + hptCertificateProduced : sidecars.hptCertificate = hpt.certificate + inputProduced : sidecars.input = + { declarations := source.targetDecls + main := source.lowering.result.main + mainResult := mainWorld } + maxDepth : Nat + loweringContext : Lower.Context + contextProduced : loweringContext = sidecars.context maxDepth + target : Lower.Checked + targetProduced : Lower.lower loweringContext sidecars.input = .ok target.artifact + targetSchemasProduced : target.artifact.validationContext.schemas = loweringContext.schemas + targetSourceProduced : target.artifact.source = sidecars.input + traceSourcesProduced : sidecars.traceSourcesMatch target.artifact.trace = true + traceExternFreeProduced : sidecars.traceExternFree target.artifact.trace = true + traceExactFetchesProduced : sidecars.traceExactFetchesMatch target.artifact.trace = true + traceExactCaseTargetsProduced : sidecars.traceExactCaseTargetsMatch target.artifact.trace = true + traceResidualCaseTargetsProduced : sidecars.traceResidualCaseTargetsMatch target.artifact.trace = true + traceScalarLeavesProduced : sidecars.traceScalarLeavesMatch target.artifact.trace = true + sourceNoReuseProduced : sidecars.sourceNoReuse target.artifact.trace = true + sourceConstructorsProduced : sidecars.traceConstructorsKnown target.artifact.trace = true + pappSafeProduced : sidecars.tracePappsSafe target.artifact.trace = true + +/-- A validated source/IxIR₁ compilation paired with the exact checked IxIR₂ +artifact produced from it. -/ +structure Attached + (constants : List (Address × Ixon.Constant)) (mainAddress : Address) + (config : Ix.Compiler.Pipeline.Config) (mainWorld : Owned) + (eraseFuel lowerFuel : Nat) where + source : Ix.Compiler.Pipeline.ValidatedCompilation constants mainAddress + config mainWorld eraseFuel lowerFuel + sidecars : Sidecars + hpt : IxIR1.HPT.Production IxIR1.HPT.defaultProducerLimits.checker + source.lowering.result.artifacts + hptCertificateProduced : sidecars.hptCertificate = hpt.certificate + inputProduced : sidecars.input = + { declarations := source.artifact.targetDecls + main := source.artifact.main + mainResult := mainWorld } + maxDepth : Nat + loweringContext : Lower.Context + contextProduced : loweringContext = sidecars.context maxDepth + target : Lower.Checked + targetProduced : + Lower.lower loweringContext sidecars.input = .ok target.artifact + targetSchemasProduced : + target.artifact.validationContext.schemas = loweringContext.schemas + targetSourceProduced : target.artifact.source = sidecars.input + traceSourcesProduced : + sidecars.traceSourcesMatch target.artifact.trace = true + traceExternFreeProduced : + sidecars.traceExternFree target.artifact.trace = true + traceExactFetchesProduced : + sidecars.traceExactFetchesMatch target.artifact.trace = true + traceExactCaseTargetsProduced : + sidecars.traceExactCaseTargetsMatch target.artifact.trace = true + traceResidualCaseTargetsProduced : + sidecars.traceResidualCaseTargetsMatch target.artifact.trace = true + traceScalarLeavesProduced : + sidecars.traceScalarLeavesMatch target.artifact.trace = true + sourceNoReuseProduced : + sidecars.sourceNoReuse target.artifact.trace = true + sourceConstructorsProduced : + sidecars.traceConstructorsKnown target.artifact.trace = true + pappSafeProduced : + sidecars.tracePappsSafe target.artifact.trace = true + +/-- Preserve the public Ixon attachment while projecting the common backend +certificate. No compiler, analysis, or validator is rerun. -/ +def Attached.compiled + {constants : List (Address × Ixon.Constant)} {mainAddress : Address} + {config : Ix.Compiler.Pipeline.Config} {mainWorld : Owned} + {eraseFuel lowerFuel : Nat} + (attached : Attached constants mainAddress config mainWorld eraseFuel lowerFuel) : + CompiledAttachment mainWorld lowerFuel := + { source := attached.source.lowered + sidecars := attached.sidecars + hpt := attached.hpt + hptCertificateProduced := attached.hptCertificateProduced + inputProduced := attached.inputProduced + maxDepth := attached.maxDepth + loweringContext := attached.loweringContext + contextProduced := attached.contextProduced + target := attached.target + targetProduced := attached.targetProduced + targetSchemasProduced := attached.targetSchemasProduced + targetSourceProduced := attached.targetSourceProduced + traceSourcesProduced := attached.traceSourcesProduced + traceExternFreeProduced := attached.traceExternFreeProduced + traceExactFetchesProduced := attached.traceExactFetchesProduced + traceExactCaseTargetsProduced := attached.traceExactCaseTargetsProduced + traceResidualCaseTargetsProduced := attached.traceResidualCaseTargetsProduced + traceScalarLeavesProduced := attached.traceScalarLeavesProduced + sourceNoReuseProduced := attached.sourceNoReuseProduced + sourceConstructorsProduced := attached.sourceConstructorsProduced + pappSafeProduced := attached.pappSafeProduced } + +instance {constants : List (Address × Ixon.Constant)} {mainAddress : Address} + {config : Ix.Compiler.Pipeline.Config} {mainWorld : Owned} {eraseFuel lowerFuel : Nat} : + CoeOut (Attached constants mainAddress config mainWorld eraseFuel lowerFuel) + (CompiledAttachment mainWorld lowerFuel) := ⟨Attached.compiled⟩ + +/-- Whenever path-local HPT admits the synthetic main owner, its retained +definition is the exact main function named by the checked lowering trace. +If the reserved analysis address collides with a declaration summary, the +premise is impossible and linear transport remains fail closed. -/ +theorem CompiledAttachment.mainAnalysisCurrentCompatible + {mainWorld : Owned} + {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) : + ∀ current, + attached.sidecars.analysisCurrent? .main = some current → + current = attached.target.artifact.mainTrace.source := by + intro current currentAt + unfold Sidecars.analysisCurrent? at currentAt + cases summaryEq : attached.sidecars.hptCertificate.summaryEnv + mainAnalysisOwner with + | none => + simp [analysisRoot?, summaryEq] at currentAt + rw [attached.target.artifact.mainSource, + attached.targetSourceProduced] + exact currentAt.symm + | some summary => + simp [analysisRoot?, summaryEq] at currentAt + +/-- Every retained declaration/function trace in an attachment agrees with +the function used by HPT replay whenever that replay root is present. -/ +theorem CompiledAttachment.functionTraceAnalysisCurrentCompatible + {mainWorld : Owned} + {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {functionTrace : Lower.FunctionTrace} + (member : functionTrace ∈ attached.target.artifact.trace.functions) : + ∀ current, + attached.sidecars.analysisCurrent? functionTrace.owner = some current → + current = functionTrace.source := by + intro current currentAt + exact attached.sidecars.functionTraceSource_eq_of_match + attached.traceSourcesProduced member currentAt + +/-- Every retained non-main function has a recovered HPT analysis root naming +its exact retained source definition. The whole-trace alignment check permits +a missing root only for the distinguished synthetic main. -/ +theorem CompiledAttachment.functionTraceAnalysisCurrent + {mainWorld : Owned} + {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {functionTrace : Lower.FunctionTrace} + (member : functionTrace ∈ attached.target.artifact.trace.functions) + (notMain : functionTrace.owner ≠ .main) : + attached.sidecars.analysisCurrent? functionTrace.owner = + some functionTrace.source := by + have localMatch := List.all_eq_true.mp attached.traceSourcesProduced + functionTrace member + cases currentEq : attached.sidecars.analysisCurrent? functionTrace.owner with + | none => + unfold Sidecars.functionTraceSourceMatches at localMatch + rw [currentEq] at localMatch + exact False.elim (notMain (beq_iff_eq.mp localMatch)) + | some current => + have currentSource := + attached.functionTraceAnalysisCurrentCompatible member current currentEq + exact congrArg some currentSource + +/-- No retained descendant can be a source extern operation. The executable +attachment check turns the lowerer's disabled extern boundary into the exact +contradiction used by the exhaustive evaluator inversion. -/ +theorem CompiledAttachment.sourceExtern_impossible + {mainWorld : Owned} + {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {functionTrace : Lower.FunctionTrace} + (member : functionTrace ∈ attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount index : Nat} + {address : Address} {arguments : Array IxIR1.Atom} + {instruction : Instr} {next : Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp site block input nextInput entryValueCount + (.extern address arguments) index instruction next)) : False := by + have rootMatch := attached.sidecars.functionCodeExternFree + attached.traceExternFreeProduced member + have localMatch := attached.sidecars.codeExternFree_descendant rootMatch + descendant + simp [Sidecars.codeExternFree] at localMatch + +/-- Every retained source-fetch descendant of an attachment recovers the +exact constructor HPT evidence selected by the lowering context. -/ +theorem CompiledAttachment.exactConstructorAt?_of_fetch_descendant + {mainWorld : Owned} + {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {functionTrace : Lower.FunctionTrace} + (member : functionTrace ∈ attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount index : Nat} + {sourceAtom : IxIR1.Atom} {sourceField : Nat} + {targetAtom : Atom} {targetField : Nat} {identity : CtorId} + {next : Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp site block input nextInput entryValueCount + (.fetch sourceAtom sourceField) index + (.fetch targetAtom identity targetField) next)) : + ∃ fact, + attached.sidecars.exactConstructorAt? site sourceAtom = + some (fact, identity) := by + have rootMatch := attached.sidecars.functionCodeExactFetchesMatch + attached.traceExactFetchesProduced member + have childMatch := attached.sidecars.codeExactFetchesMatch_descendant + rootMatch descendant + exact attached.sidecars.exactConstructorAt?_of_codeExactFetchesMatch + childMatch + +/-- Every exact constructor fact at a retained switch names an actual emitted +constructor target. Structural trace coherence supplies the parallel edge and +child coordinates later; this theorem supplies the formerly erased identity +lookup. -/ +theorem CompiledAttachment.exactCaseTarget_of_switch_descendant + {mainWorld : Owned} + {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {functionTrace : Lower.FunctionTrace} + (member : functionTrace ∈ attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {block : BlockId} + {input : Array (Option Atom)} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {targetScrutinee : Atom} + {generated : Block} {outgoing : List Lower.EdgeTrace} + {children : List Lower.CodeTrace} {fact : IxIR1.HPT.Fact} + {identity : CtorId} {constructors : Array CtorAlt} + {natPeel : Option NatPeel} + (descendant : functionTrace.root.Descendant + (.switchValue site block input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children)) + (selected : attached.sidecars.exactConstructorAt? site sourceScrutinee = + some (fact, identity)) + (terminator : generated.terminator = + .switchValue targetScrutinee constructors natPeel) : + ∃ target, constructors.find? (fun candidate => + candidate.cid == identity) = some target := by + have rootMatch := attached.sidecars.functionCodeExactCaseTargetsMatch + attached.traceExactCaseTargetsProduced member + have childMatch := + attached.sidecars.codeExactCaseTargetsMatch_descendant rootMatch descendant + exact attached.sidecars.exactCaseTarget_of_codeExactCaseTargetsMatch + childMatch selected terminator + +/-- Every retained shallow-free descendant of an attachment recovers the +exact scalar-leaf HPT evidence selected by the lowering context. -/ +theorem CompiledAttachment.scalarLeafAt?_of_free_descendant + {mainWorld : Owned} + {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {functionTrace : Lower.FunctionTrace} + (member : functionTrace ∈ attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {block : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount index : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {identity : CtorId} + {next : Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp site block input nextInput entryValueCount + (.free sourceAtom) index (.freeUnique targetAtom identity) next)) : + ∃ fact, + attached.sidecars.scalarLeafAt? site sourceAtom = + some (fact, identity) := by + have rootMatch := attached.sidecars.functionCodeScalarLeavesMatch + attached.traceScalarLeavesProduced member + have childMatch := attached.sidecars.codeScalarLeavesMatch_descendant + rootMatch descendant + exact attached.sidecars.scalarLeafAt?_of_codeScalarLeavesMatch childMatch + +/-- An attached artifact retains the exact sidecar-produced context, so its +schema lookups expose the pipeline's uniform ownership-world invariant. -/ +theorem CompiledAttachment.schema_fields_replicate + {mainWorld : Owned} + {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {world : Owned} {identity : CtorId} {schema : CtorSchema} + (found : attached.loweringContext.schemas world identity = some schema) : + ∃ count, schema.fields = Array.replicate count world := by + rw [attached.contextProduced] at found + exact attached.sidecars.schema_fields_replicate found + +/-- Attachment-facing form of the exact constructor/schema arity bridge. -/ +theorem CompiledAttachment.schema_fields_of_constructorKnown + {mainWorld : Owned} + {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {world : Owned} {identity : CtorId} {arity : Nat} + {schema : CtorSchema} + (known : attached.sidecars.constructorKnown identity arity = true) + (found : attached.loweringContext.schemas world identity = some schema) : + schema.fields = Array.replicate arity world := by + rw [attached.contextProduced] at found + exact attached.sidecars.schema_fields_of_constructorKnown known found + +/-- The HPT facts consulted by this attachment are the exact claims admitted +by the ordinary post-fixpoint checker for its retained IxIR₁ artifact graph. -/ +theorem CompiledAttachment.hptPostFixpoint + {mainWorld : Owned} + {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) : + attached.sidecars.hptCertificate.postFixpoint + attached.source.lowering.result.artifacts = true := by + rw [attached.hptCertificateProduced] + exact attached.hpt.postFixpoint + +/-- Propositional local form consumed by operation and code soundness. -/ +theorem CompiledAttachment.hptLocalPostFixpoint + {mainWorld : Owned} + {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) : + IxIR1.HPT.LocalPostFixpoint + (IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + attached.sidecars.hptCertificate.summaryEnv := + IxIR1.HPT.localPostFixpoint_of_postFixpoint attached.hptPostFixpoint + +/-- The sidecar lookup environment is exactly the declaration environment +checked by its HPT production, not merely an extensionally compatible input. -/ +theorem CompiledAttachment.sidecarDeclarationEnvironment + {mainWorld : Owned} + {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) : + IxIR1.Env.ofList attached.sidecars.input.declarations = + IxIR1.HPT.programDeclEnv + attached.source.lowering.result.artifacts := by + rw [attached.inputProduced] + change IxIR1.Env.ofList + (IxIR1.HPT.declarationEntries + attached.source.lowering.result.artifacts) = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts + exact IxIR1.HPT.OptimizeProgram.envOfList_declarationEntries + attached.source.lowering.result.artifacts + +/-- The fail-closed attachment check discharges reuse-freedom for any source +evaluator context pinned to the attached declaration environment. -/ +theorem CompiledAttachment.sourceContextNoReuse + {mainWorld : Owned} + {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv + attached.source.lowering.result.artifacts) : + IxIR1.NoReuse.CtxNoReuse sourceContext := by + have declarationCheck : IxIR1.NoReuse.checkDeclarations + attached.sidecars.input.declarations = true := by + have checked := attached.sourceNoReuseProduced + simp only [Sidecars.sourceNoReuse, Bool.and_eq_true] at checked + exact checked.1 + have declarationsNoReuse : IxIR1.NoReuse.DeclListNoReuse + attached.sidecars.input.declarations := + (IxIR1.NoReuse.checkDeclarations_eq_true_iff _).mp declarationCheck + have canonical : IxIR1.NoReuse.CtxNoReuse + ({ decls := IxIR1.Env.ofList attached.sidecars.input.declarations + oracle := sourceContext.oracle } : IxIR1.Ctx) := + IxIR1.NoReuse.ctxOfList_noReuse declarationsNoReuse + intro address definition lookup + apply canonical + rw [attached.sidecarDeclarationEnvironment, ← sourceDeclarations] + exact lookup + +/-- Every retained source function has passed the executable reuse-freedom +check carried by the attachment. -/ +theorem CompiledAttachment.functionTraceNoReuse + {mainWorld : Owned} + {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {functionTrace : Lower.FunctionTrace} + (member : functionTrace ∈ attached.target.artifact.trace.functions) : + IxIR1.NoReuse.CodeNoReuse functionTrace.source.body := by + have traceCheck : attached.target.artifact.trace.functions.all + (fun trace => IxIR1.NoReuse.checkCode trace.source.body) = true := by + have checked := attached.sourceNoReuseProduced + simp only [Sidecars.sourceNoReuse, Bool.and_eq_true] at checked + exact checked.2 + have functionCheck := List.all_eq_true.mp traceCheck functionTrace member + exact (IxIR1.NoReuse.checkCode_eq_true_iff _).mp functionCheck + +/-- Every retained partial-application site resolves to a declaration whose +source PAP-safety flag is true. The context identity premise is the same one +used by the simulation worker. -/ +theorem CompiledAttachment.pappSafe + {mainWorld : Owned} + {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv + attached.source.lowering.result.artifacts) + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Array (Option Atom)} {entryValueCount index : Nat} + {address : Address} {arguments : Array IxIR1.Atom} + {instruction : Instr} {next : Lower.CodeTrace} + {definition : IxIR1.FnDef} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.papp address arguments) index instruction next)) + (lookup : sourceContext.decls address = some (.fn definition)) : + definition.papSafe = true := by + have rootCheck : attached.sidecars.pappSafeTrace functionTrace.root = true := + List.all_eq_true.mp attached.pappSafeProduced functionTrace functionMember + have localCheck := attached.sidecars.pappSafeTrace_descendant descendant + rootCheck + apply attached.sidecars.pappSafe_of_traceMatch localCheck + rw [attached.sidecarDeclarationEnvironment, ← sourceDeclarations] + exact lookup + +/-- Local HPT post-fixpoint in the exact environment consumed by source-site +replay and its dynamic environment invariant. -/ +theorem CompiledAttachment.hptSidecarLocalPostFixpoint + {mainWorld : Owned} + {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) : + IxIR1.HPT.LocalPostFixpoint + (IxIR1.Env.ofList attached.sidecars.input.declarations) + attached.sidecars.hptCertificate.summaryEnv := by + rw [attached.sidecarDeclarationEnvironment] + exact attached.hptLocalPostFixpoint + +/-- Artifact-facing linear transport: the attachment discharges both the HPT +post-fixpoint and the identity of the declaration environment checked by it. -/ +theorem CompiledAttachment.siteEnvironmentHolds_next + {mainWorld : Owned} + {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceCurrent : IxIR1.FnDef} + {sourceFuel : Nat} {sourceStore outputStore : IxIR1.Store} + {source : List IxIR1.RVal} {operation : IxIR1.Op} + {value : IxIR1.RVal} {site : Lower.SourceSite} {rest : IxIR1.Code} + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (currentAt : attached.sidecars.analysisCurrent? site.owner = + some sourceCurrent) + (environment : attached.sidecars.SiteEnvironmentHolds sourceStore site + source) + (sourceAt : attached.sidecars.sourceCodeAt? site = + some (.letOp operation rest)) + (sourceRun : IxIR1.runOp sourceContext sourceFuel sourceCurrent + sourceStore source operation = .ok (outputStore, value)) : + attached.sidecars.SiteEnvironmentHolds outputStore site.next + (value :: source) := by + exact attached.sidecars.siteEnvironmentHolds_next + attached.hptSidecarLocalPostFixpoint + (sourceDeclarations.trans attached.sidecarDeclarationEnvironment.symm) + currentAt environment sourceAt sourceRun + + +/-! Existing theorem names remain available for direct application. -/ +namespace Attached +export CompiledAttachment ( + mainAnalysisCurrentCompatible + functionTraceAnalysisCurrentCompatible + functionTraceAnalysisCurrent + sourceExtern_impossible + exactConstructorAt?_of_fetch_descendant + exactCaseTarget_of_switch_descendant + scalarLeafAt?_of_free_descendant + schema_fields_replicate + schema_fields_of_constructorKnown + hptPostFixpoint + hptLocalPostFixpoint + sidecarDeclarationEnvironment + sourceContextNoReuse + functionTraceNoReuse + pappSafe + hptSidecarLocalPostFixpoint + siteEnvironmentHolds_next) +end Attached + +/-- Sidecars and HPT evidence for the common ownership-lowered boundary. -/ +structure BuiltCompiledSidecars {mainWorld : Owned} {lowerFuel : Nat} + (source : Ix.Compiler.Pipeline.LoweredCompilation mainWorld lowerFuel) where + sidecars : Sidecars + hpt : IxIR1.HPT.Production IxIR1.HPT.defaultProducerLimits.checker + source.lowering.result.artifacts + certificateProduced : sidecars.hptCertificate = hpt.certificate + inputProduced : sidecars.input = + { declarations := source.targetDecls + main := source.lowering.result.main + mainResult := mainWorld } + +/-- The returned attachment names the exact checked compiler input supplied +to this invocation, even when a frontend has transformed the literal erasure. -/ +abbrev CompiledRun {mainWorld : Owned} {lowerFuel : Nat} + (source : Ix.Compiler.Pipeline.LoweredCompilation mainWorld lowerFuel) := + { attached : CompiledAttachment mainWorld lowerFuel // attached.source = source } + +/-- Attach and validate structured baseline IxIR₂ in one fail-closed step. -/ +def attachCompiled {mainWorld : Owned} {lowerFuel : Nat} + (compilation : Ix.Compiler.Pipeline.LoweredCompilation mainWorld lowerFuel) + (built : BuiltCompiledSidecars compilation) + (maxDepth : Nat := 100000) : + Except Error (CompiledRun compilation) := do + let sidecars := built.sidecars + let loweringContext := sidecars.context maxDepth + let targetRun ← match Lower.lowerCheckedWithTrace loweringContext + sidecars.input with + | .ok checked => pure checked + | .error error => .error (.lowering error) + if traceSourcesCoherent : + sidecars.traceSourcesMatch targetRun.checked.artifact.trace then + if traceExternFree : + sidecars.traceExternFree targetRun.checked.artifact.trace then + if traceExactFetchesCoherent : + sidecars.traceExactFetchesMatch targetRun.checked.artifact.trace then + if traceExactCaseTargetsCoherent : + sidecars.traceExactCaseTargetsMatch + targetRun.checked.artifact.trace then + if traceResidualCaseTargetsCoherent : + sidecars.traceResidualCaseTargetsMatch + targetRun.checked.artifact.trace then + if traceScalarLeavesCoherent : + sidecars.traceScalarLeavesMatch targetRun.checked.artifact.trace then + if sourceNoReuse : + sidecars.sourceNoReuse targetRun.checked.artifact.trace then + if sourceConstructorsKnown : + sidecars.traceConstructorsKnown + targetRun.checked.artifact.trace then + if pappsSafe : + sidecars.tracePappsSafe targetRun.checked.artifact.trace then + return ⟨ + { source := compilation + sidecars + hpt := built.hpt + hptCertificateProduced := built.certificateProduced + inputProduced := built.inputProduced + maxDepth + loweringContext + contextProduced := rfl + target := targetRun.checked + targetProduced := targetRun.produced + targetSchemasProduced := Lower.validationSchemas_of_lower targetRun.produced + targetSourceProduced := targetRun.source + traceSourcesProduced := traceSourcesCoherent + traceExternFreeProduced := traceExternFree + traceExactFetchesProduced := traceExactFetchesCoherent + traceExactCaseTargetsProduced := traceExactCaseTargetsCoherent + traceResidualCaseTargetsProduced := traceResidualCaseTargetsCoherent + traceScalarLeavesProduced := traceScalarLeavesCoherent + sourceNoReuseProduced := sourceNoReuse + sourceConstructorsProduced := sourceConstructorsKnown + pappSafeProduced := pappsSafe }, rfl⟩ + else + throw (.lowering (.internal + "partial application targets a PAP-unsafe declaration")) + else + throw (.lowering (.internal + "source constructor allocation escaped the producer universe")) + else + throw (.lowering (.internal + "source artifact unexpectedly contains a reuse operation")) + else + throw (.lowering (.internal + "shallow-free traces lack exact scalar-leaf HPT evidence")) + else + throw (.lowering (.internal + "ambiguous-HPT case traces lack producer constructor coverage")) + else + throw (.lowering (.internal + "exact-HPT case traces lack their constructor target")) + else + throw (.lowering (.internal + "fetch traces lack exact-constructor HPT evidence")) + else + throw (.lowering (.internal + "extern operation escaped the disabled lowering boundary")) + else + throw (.lowering (.internal + "function traces do not match path-local HPT owners")) + +/-- Restore the public source-facing record from the exact common attachment. +The identity proof transports only dependent certificates; executable fields +are the same compiler and analysis results. -/ +def Attached.ofCompiled + {constants : List (Address × Ixon.Constant)} {mainAddress : Address} + {config : Ix.Compiler.Pipeline.Config} {mainWorld : Owned} {eraseFuel lowerFuel : Nat} + (source : Ix.Compiler.Pipeline.ValidatedCompilation constants mainAddress config + mainWorld eraseFuel lowerFuel) + (run : CompiledRun source.lowered) : + Attached constants mainAddress config mainWorld eraseFuel lowerFuel := by + rcases run with ⟨attached, produced⟩ + rcases attached with ⟨compiler, sidecars, hpt, hptProduced, inputProduced, maxDepth, + loweringContext, contextProduced, target, targetProduced, targetSchemasProduced, + targetSourceProduced, traceSourcesProduced, traceExternFreeProduced, + traceExactFetchesProduced, traceExactCaseTargetsProduced, traceResidualCaseTargetsProduced, + traceScalarLeavesProduced, sourceNoReuseProduced, sourceConstructorsProduced, pappSafeProduced⟩ + cases produced + exact { + source, sidecars, hpt, hptCertificateProduced := hptProduced, inputProduced, + maxDepth, loweringContext, contextProduced, target, targetProduced, targetSchemasProduced, + targetSourceProduced, traceSourcesProduced, traceExternFreeProduced, traceExactFetchesProduced, + traceExactCaseTargetsProduced, traceResidualCaseTargetsProduced, traceScalarLeavesProduced, + sourceNoReuseProduced, sourceConstructorsProduced, pappSafeProduced } + +def attach + {constants : List (Address × Ixon.Constant)} {mainAddress : Address} + {config : Ix.Compiler.Pipeline.Config} {mainWorld : Owned} {eraseFuel lowerFuel : Nat} + (compilation : Ix.Compiler.Pipeline.ValidatedCompilation constants mainAddress config + mainWorld eraseFuel lowerFuel) + (maxDepth : Nat := 100000) : + Except Error (Attached constants mainAddress config mainWorld eraseFuel lowerFuel) := do + let built ← buildSidecars compilation + let run ← attachCompiled compilation.lowered + { sidecars := built.sidecars, hpt := built.hpt + certificateProduced := built.certificateProduced, inputProduced := built.inputProduced } + maxDepth + return Attached.ofCompiled compilation run + +/-- Validator-gated source compilation and checked structured IxIR₂ +attachment as one executable endpoint. The ordinary production API remains +IxIR₁ while exact source-provenance coverage is still being generalized. -/ +def compileValidated (constants : List (Address × Ixon.Constant)) + (mainAddress : Address) (config : Ix.Compiler.Pipeline.Config := {}) + (mainWorld : Owned := .shared) + (checkFuel : Nat := Ixon.UsageCheck.defaultFuel) + (eraseFuel : Nat := Erase.defaultFuel) + (validateFuel : Nat := Erase.defaultFuel) + (lowerFuel : Nat := 10000) (maxDepth : Nat := 100000) : + Except Error (Attached constants mainAddress config mainWorld + eraseFuel lowerFuel) := do + let compilation ← + match Ix.Compiler.Pipeline.compileValidatedWithTrace constants mainAddress + config mainWorld checkFuel eraseFuel validateFuel lowerFuel with + | .ok compilation => pure compilation + | .error error => .error (.pipeline error) + attach compilation maxDepth + +end Ix.Compiler.IxIR2.Pipeline diff --git a/Ix/Compiler/IxIR2/PipelineAllocation.lean b/Ix/Compiler/IxIR2/PipelineAllocation.lean new file mode 100644 index 000000000..85fd6ad66 --- /dev/null +++ b/Ix/Compiler/IxIR2/PipelineAllocation.lean @@ -0,0 +1,124 @@ +import Ix.Compiler.IxIR2.PipelineResources +import Ix.Compiler.IxIR2.ReuseAllocation + +/-! +# Allocation and free laws for the selected shared-main compiler + +The owned source execution and checked attachment derive the baseline's zero +reuse count. The actual rewrite execution supplies allocation-event equality; +R2 supplies terminal accounting and shared-result reclamation. No comparative +counter or compiler-state invariant is a caller premise. +-/ + +namespace Ix.Compiler.IxIR2.Pipeline + +/-- The actual owned execution of a compiled shared main performs no baseline +reuse. This is derived from the lowering trace and transported by exact +baseline heap correspondence. -/ +theorem CompiledAttachment.baselineNoReuses + {fuel : Nat} (attached : CompiledAttachment .shared fuel) + {sourceFuel : Nat} {store : IxIR1.Store} {value : IxIR1.RVal} + (ownedRun : IxIR1.runOwnedMain attached.simulationSourceContext + attached.target.artifact.source.mainResult attached.target.artifact.source.main + sourceFuel = .ok (store, value)) + {baseline : Eval.Result} (related : Lower.Sim.OutcomeRel (store, value) baseline) : + baseline.store.heap.reuses = 0 := by + have mainWorld : attached.target.artifact.source.mainResult = .shared := by + rw [attached.targetSourceProduced, attached.inputProduced] + have bodyRun := (IxIR1.Sim.runOwnedMain_ok ownedRun).1 + rw [mainWorld] at bodyRun + have noReuse := attached.functionTraceNoReuse attached.target.artifact.mainTraceMember + rw [attached.target.artifact.mainSource] at noReuse + rw [related.heap] + exact IxIR1.NoReuse.runMain_reuses_eq_zero + (attached.sourceContextNoReuse rfl) noReuse bodyRun + +/-- Both physical executions and their exact allocation/free laws, including +complete reclamation of both shared results. Optimized and checked baseline +selection use the same public theorem. -/ +theorem CompiledAttachment.selectedPhysicalMainAllocationLaws + {fuel : Nat} (attached : CompiledAttachment .shared fuel) + (selection : Reuse.Selection Validate.defaultLimits + attached.target.artifact.validationContext attached.target.artifact.program) + {sourceFuel : Nat} {sourceOut : IxIR1.Store × IxIR1.RVal} + (ownedRun : IxIR1.runOwnedMain attached.simulationSourceContext + attached.target.artifact.source.mainResult attached.target.artifact.source.main + sourceFuel = .ok sourceOut) : + ∃ baselineControl selectedControl heapFuel baseline selected locRel, + Eval.runMain attached.simulationTargetContext .physical + attached.target.artifact.program baselineControl heapFuel = .ok baseline ∧ + Eval.runMain + (Eval.Context.ofProgram selection.target attached.target.artifact.validationContext.schemas) + .physical selection.target selectedControl heapFuel = .ok selected ∧ + Lower.Sim.OutcomeRel sourceOut baseline ∧ + ReuseSim.StableHeapRel baseline.store selected.store locRel ∧ + IxIR1.Sim.RValIso locRel baseline.value selected.value ∧ + baseline.SharedResources ∧ selected.SharedResources ∧ + baseline.AllocationLaws selected ∧ baseline.ReclaimedAllocationLaws selected := by + obtain ⟨baselineControl, heapFuel, baseline, baselineRun, baselineRelation⟩ := + attached.successfulPhysicalMainSimulation ownedRun + obtain ⟨selectedControl, selected, locRel, selectedRun, heaps, values, _budget, events⟩ := + ReuseLiveSim.selectedPhysicalMainSimulationWithAllocationEvents selection baselineRun + have baselineAccounted := Eval.runMain_allocationAccounting + attached.target.artifact.mainArity attached.target.artifact.mainNonempty baselineRun + have selectedAccounted := attached.selectedAllocationAccounting selection selectedRun + obtain ⟨releaseFuel, baselineReleased, baselineRelease, baselineEmpty⟩ := + attached.baselineSharedReclamation ownedRun baselineRelation + obtain ⟨selectedReleased, selectedRelease, selectedEmpty⟩ := + heaps.sharedReclamation values baselineRelease baselineEmpty + have baselineResources := Eval.Result.sharedResources_of_release + baselineAccounted baselineRelease baselineEmpty + have selectedResources := Eval.Result.sharedResources_of_release + selectedAccounted selectedRelease selectedEmpty + have laws := Eval.Result.AllocationLaws.of_accounting heaps events + (attached.baselineNoReuses ownedRun baselineRelation) baselineAccounted selectedAccounted + exact ⟨baselineControl, selectedControl, heapFuel, baseline, selected, locRel, + baselineRun, selectedRun, baselineRelation, heaps, values, + baselineResources, selectedResources, laws, + laws.reclaimed heaps values baselineResources selectedResources⟩ + +/-- The laws concern any actual successful runs of the baseline and selected +programs, including independent sufficient choices of control and heap fuel. -/ +theorem CompiledAttachment.successfulPhysicalAllocationLaws + {fuel : Nat} (attached : CompiledAttachment .shared fuel) + (selection : Reuse.Selection Validate.defaultLimits + attached.target.artifact.validationContext attached.target.artifact.program) + {sourceFuel : Nat} {sourceOut : IxIR1.Store × IxIR1.RVal} + (ownedRun : IxIR1.runOwnedMain attached.simulationSourceContext + attached.target.artifact.source.mainResult attached.target.artifact.source.main + sourceFuel = .ok sourceOut) + {baselineControl baselineHeap selectedControl selectedHeap : Nat} + {baseline selected : Eval.Result} + (baselineRun : Eval.runMain attached.simulationTargetContext .physical + attached.target.artifact.program baselineControl baselineHeap = .ok baseline) + (selectedRun : Eval.runMain + (Eval.Context.ofProgram selection.target attached.target.artifact.validationContext.schemas) + .physical selection.target selectedControl selectedHeap = .ok selected) : + baseline.AllocationLaws selected ∧ baseline.ReclaimedAllocationLaws selected := by + obtain ⟨witnessBaselineControl, witnessSelectedControl, witnessHeap, witnessBaseline, + witnessSelected, locRel, witnessBaselineRun, witnessSelectedRun, + _baselineRelation, _heaps, _values, _baselineResources, _selectedResources, + laws, reclaimed⟩ := attached.selectedPhysicalMainAllocationLaws selection ownedRun + obtain ⟨baselineStores, baselineValues⟩ := Eval.runMain_success_unique + attached.target.artifact.mainArity attached.target.artifact.mainNonempty + witnessBaselineRun baselineRun + obtain ⟨selectedStores, selectedValues⟩ := Eval.runMain_success_unique + (attached.selectedMainEntry selection).1 (attached.selectedMainEntry selection).2 + witnessSelectedRun selectedRun + refine ⟨⟨?_, ?_⟩, ?_⟩ + · simpa only [baselineStores, selectedStores] using laws.allocations + · simpa only [baselineStores, selectedStores] using laws.frees + · simpa only [Eval.Result.ReclaimedAllocationLaws, baselineStores, baselineValues, + selectedStores, selectedValues] using reclaimed + +/-- A selected result is compared with an actual physical run of the checked +baseline, retaining its resources and both pre- and post-release laws. -/ +def CompiledAttachment.AllocationComparison + {fuel : Nat} (attached : CompiledAttachment .shared fuel) (selected : Eval.Result) : Prop := + ∃ baselineControl baselineHeap baseline, + Eval.runMain attached.simulationTargetContext .physical attached.target.artifact.program + baselineControl baselineHeap = .ok baseline ∧ + baseline.SharedResources ∧ baseline.AllocationLaws selected ∧ + baseline.ReclaimedAllocationLaws selected + +end Ix.Compiler.IxIR2.Pipeline diff --git a/Ix/Compiler/IxIR2/PipelineCallReuse.lean b/Ix/Compiler/IxIR2/PipelineCallReuse.lean new file mode 100644 index 000000000..dcf913bab --- /dev/null +++ b/Ix/Compiler/IxIR2/PipelineCallReuse.lean @@ -0,0 +1,168 @@ +import Ix.Compiler.IxIR2.PipelineCosts +import Ix.Compiler.IxIR2.CallReuseMain +import Ix.Compiler.IxIR2.CallResources + +/-! +# Compiler costs and reclamation with suspended call credits + +The common checked lowering trace derives endpoint closure and a live result. +The actual selected execution supplies the unchanged semantic heap relation, +allocation events, RC and peak bounds. Physical accounting and shared release +then give R4's complete resource laws for both policy selection branches. +-/ + +namespace Ix.Compiler.IxIR2.Pipeline + +theorem CompiledAttachment.baselineClosed + {fuel : Nat} (attached : CompiledAttachment .shared fuel) + {sourceFuel : Nat} {store : IxIR1.Store} {value : IxIR1.RVal} + (ownedRun : IxIR1.runOwnedMain attached.simulationSourceContext + attached.target.artifact.source.mainResult attached.target.artifact.source.main + sourceFuel = .ok (store, value)) + {baseline : Eval.Result} (related : Lower.Sim.OutcomeRel (store, value) baseline) : + IxIR1.Sim.StoreClosed baseline.store.heap ∧ + IxIR1.Sim.LiveRVal baseline.store.heap baseline.value := by + have mainWorld : attached.target.artifact.source.mainResult = .shared := by + rw [attached.targetSourceProduced, attached.inputProduced] + have bodyRun := (IxIR1.Sim.runOwnedMain_ok ownedRun).1 + rw [mainWorld] at bodyRun + have run : IxIR1.runMain attached.simulationSourceContext + attached.target.artifact.source.main sourceFuel = .ok (store, value) := bodyRun + rw [attached.simulationSourceContext_eq_addressedCtx, + attached.targetSourceProduced, attached.inputProduced] at run + have ownership := attached.source.owned (fun _ _ => none) run + rw [related.heap, related.value] + refine ⟨ownership.storeClosed, ?_⟩ + have world := ownership.roots_world ⟨.shared, value⟩ (by simp) + cases value with + | loc location => exact ⟨world.choose, world.choose_spec.1⟩ + | lit literal => trivial + | erased => trivial + +def CompiledAttachment.CallPrefixCostBounds + {fuel : Nat} (attached : CompiledAttachment .shared fuel) + (selection : CallReuse.Selection Validate.defaultLimits + attached.target.artifact.validationContext attached.target.artifact.program) + (heapFuel : Nat) (baseline : Eval.Result) : Prop := + ∀ {count : Nat} {middle : Eval.Machine}, + Eval.Policy.Steps selection.policy + (Eval.Context.ofProgram selection.target attached.target.artifact.validationContext.schemas) + .physical count (Eval.initialMachine selection.target.main #[] heapFuel) middle → + middle.store.heap.rcops ≤ baseline.store.heap.rcops ∧ + middle.store.peakLiveNodes ≤ baseline.store.peakLiveNodes ∧ + middle.store.live ≤ baseline.store.peakLiveNodes + +theorem CompiledAttachment.selectedCallPrefixCostBounds + {fuel : Nat} (attached : CompiledAttachment .shared fuel) + (selection : CallReuse.Selection Validate.defaultLimits + attached.target.artifact.validationContext attached.target.artifact.program) + {controlFuel heapFuel : Nat} {baseline selected : Eval.Result} + (selectedRun : Eval.Policy.runMain selection.policy + (Eval.Context.ofProgram selection.target attached.target.artifact.validationContext.schemas) + .physical selection.target controlFuel heapFuel = .ok selected) + (costs : baseline.CostBounds selected) : attached.CallPrefixCostBounds selection heapFuel baseline := by + have entry := selection.mainEntry attached.target.artifact.mainArity attached.target.artifact.mainNonempty + rw [Eval.Policy.runMain_eq_runMachine entry.1 entry.2] at selectedRun + intro count middle prefixSteps + have observed := Eval.Policy.runMachine_prefix_costs selectedRun prefixSteps (Nat.le_refl 0) + exact ⟨Nat.le_trans observed.1 costs.rcops, + Nat.le_trans observed.2.1 costs.peakLive, Nat.le_trans observed.2.2 costs.peakLive⟩ + +/-- All compiler-state, heap, and cost invariants are reconstructed internally +from successful owned execution and the exact checked selection. -/ +theorem CompiledAttachment.selectedCallPhysicalMainCostLaws + {fuel : Nat} (attached : CompiledAttachment .shared fuel) + (selection : CallReuse.Selection Validate.defaultLimits + attached.target.artifact.validationContext attached.target.artifact.program) + {sourceFuel : Nat} {sourceOut : IxIR1.Store × IxIR1.RVal} + (ownedRun : IxIR1.runOwnedMain attached.simulationSourceContext + attached.target.artifact.source.mainResult attached.target.artifact.source.main + sourceFuel = .ok sourceOut) : + ∃ baselineControl selectedControl heapFuel baseline selected locRel, + Eval.runMain attached.simulationTargetContext .physical + attached.target.artifact.program baselineControl heapFuel = .ok baseline ∧ + Eval.Policy.runMain selection.policy + (Eval.Context.ofProgram selection.target attached.target.artifact.validationContext.schemas) + .physical selection.target selectedControl heapFuel = .ok selected ∧ + Lower.Sim.OutcomeRel sourceOut baseline ∧ + ReuseSim.StableHeapRel baseline.store selected.store locRel ∧ + IxIR1.Sim.RValIso locRel baseline.value selected.value ∧ + baseline.SharedResources ∧ selected.SharedResources ∧ + baseline.AllocationLaws selected ∧ baseline.CostBounds selected ∧ + baseline.ReclaimedCostLaws selected ∧ attached.CallPrefixCostBounds selection heapFuel baseline := by + obtain ⟨baselineControl, heapFuel, baseline, baselineRun, baselineRelation⟩ := + attached.successfulPhysicalMainSimulation ownedRun + have closure := attached.baselineClosed ownedRun baselineRelation + obtain ⟨selectedControl, selected, locRel, selectedRun, heaps, values, _budget, events, costs⟩ := + selection.mainSimulation attached.target.artifact.mainArity attached.target.artifact.mainNonempty + baselineRun closure.1 closure.2 + have baselineAccounted := Eval.runMain_allocationAccounting + attached.target.artifact.mainArity attached.target.artifact.mainNonempty baselineRun + have entry := selection.mainEntry attached.target.artifact.mainArity attached.target.artifact.mainNonempty + have selectedAccounted := Eval.Policy.runMain_allocationAccounting entry.1 entry.2 selectedRun + obtain ⟨releaseFuel, baselineReleased, baselineRelease, baselineEmpty⟩ := + attached.baselineSharedReclamation ownedRun baselineRelation + obtain ⟨selectedReleased, selectedRelease, selectedEmpty⟩ := + heaps.sharedReclamation values baselineRelease baselineEmpty + have baselineResources := Eval.Result.sharedResources_of_release + baselineAccounted baselineRelease baselineEmpty + have selectedResources := Eval.Result.sharedResources_of_release + selectedAccounted selectedRelease selectedEmpty + have allocations := Eval.Result.AllocationLaws.of_accounting heaps events + (attached.baselineNoReuses ownedRun baselineRelation) baselineAccounted selectedAccounted + have reclaimed := allocations.reclaimed heaps values baselineResources selectedResources + exact ⟨baselineControl, selectedControl, heapFuel, baseline, selected, locRel, + baselineRun, selectedRun, baselineRelation, heaps, values, baselineResources, + selectedResources, allocations, costs, costs.reclaimed heaps reclaimed, + attached.selectedCallPrefixCostBounds selection selectedRun costs⟩ + +/-- The laws apply to actual successful runs with independent sufficient +control and heap budgets, including every prefix of the selected run. -/ +theorem CompiledAttachment.successfulCallPhysicalCostLaws + {fuel : Nat} (attached : CompiledAttachment .shared fuel) + (selection : CallReuse.Selection Validate.defaultLimits + attached.target.artifact.validationContext attached.target.artifact.program) + {sourceFuel : Nat} {sourceOut : IxIR1.Store × IxIR1.RVal} + (ownedRun : IxIR1.runOwnedMain attached.simulationSourceContext + attached.target.artifact.source.mainResult attached.target.artifact.source.main + sourceFuel = .ok sourceOut) + {baselineControl baselineHeap selectedControl selectedHeap : Nat} + {baseline selected : Eval.Result} + (baselineRun : Eval.runMain attached.simulationTargetContext .physical + attached.target.artifact.program baselineControl baselineHeap = .ok baseline) + (selectedRun : Eval.Policy.runMain selection.policy + (Eval.Context.ofProgram selection.target attached.target.artifact.validationContext.schemas) + .physical selection.target selectedControl selectedHeap = .ok selected) : + selected.SharedResources ∧ baseline.AllocationLaws selected ∧ baseline.CostBounds selected ∧ + baseline.ReclaimedCostLaws selected ∧ attached.CallPrefixCostBounds selection selectedHeap baseline := by + obtain ⟨witnessBaselineControl, witnessSelectedControl, witnessHeap, witnessBaseline, + witnessSelected, locRel, witnessBaselineRun, witnessSelectedRun, + _baselineRelation, _heaps, _values, _baselineResources, resources, + allocations, costs, reclaimed, _prefixes⟩ := attached.selectedCallPhysicalMainCostLaws selection ownedRun + obtain ⟨baselineStores, baselineValues⟩ := Eval.runMain_success_unique + attached.target.artifact.mainArity attached.target.artifact.mainNonempty witnessBaselineRun baselineRun + have entry := selection.mainEntry attached.target.artifact.mainArity attached.target.artifact.mainNonempty + obtain ⟨selectedStores, selectedValues⟩ := Eval.Policy.runMain_success_unique + entry.1 entry.2 witnessSelectedRun selectedRun + have actualCosts : baseline.CostBounds selected := by + simpa only [Eval.Result.CostBounds, baselineStores, selectedStores] using costs + refine ⟨?_, ⟨?_, ?_⟩, actualCosts, ?_, + attached.selectedCallPrefixCostBounds selection selectedRun actualCosts⟩ + · simpa only [Eval.Result.SharedResources, selectedStores, selectedValues] using resources + · simpa only [baselineStores, selectedStores] using allocations.allocations + · simpa only [baselineStores, selectedStores] using allocations.frees + · simpa only [Eval.Result.ReclaimedCostLaws, baselineStores, baselineValues, + selectedStores, selectedValues] using reclaimed + +def CompiledAttachment.CallCostComparison + {fuel : Nat} (attached : CompiledAttachment .shared fuel) + (selection : CallReuse.Selection Validate.defaultLimits + attached.target.artifact.validationContext attached.target.artifact.program) + (selectedHeap : Nat) (selected : Eval.Result) : Prop := + ∃ baselineControl baselineHeap baseline, + Eval.runMain attached.simulationTargetContext .physical attached.target.artifact.program + baselineControl baselineHeap = .ok baseline ∧ + baseline.SharedResources ∧ baseline.AllocationLaws selected ∧ baseline.CostBounds selected ∧ + baseline.ReclaimedCostLaws selected ∧ attached.CallPrefixCostBounds selection selectedHeap baseline + +end Ix.Compiler.IxIR2.Pipeline diff --git a/Ix/Compiler/IxIR2/PipelineCosts.lean b/Ix/Compiler/IxIR2/PipelineCosts.lean new file mode 100644 index 000000000..5584fcb46 --- /dev/null +++ b/Ix/Compiler/IxIR2/PipelineCosts.lean @@ -0,0 +1,177 @@ +import Ix.Compiler.IxIR2.PipelineAllocation + +/-! +# Comparative costs for the actual selected shared-main compiler + +RC and peak bounds cover both selection branches and independent sufficient +execution budgets. All intermediate selected states are bounded by the actual +baseline's final counters. Shared reclamation retains the same cost bounds and +R3's allocation/free laws. +-/ + +namespace Ix.Compiler.IxIR2.Eval + +theorem Result.ReclaimedCostLaws.allocations {baseline selected : Result} + (laws : baseline.ReclaimedCostLaws selected) : baseline.ReclaimedAllocationLaws selected := by + obtain ⟨fuel, baselineReleased, selectedReleased, remaining, baselineRun, selectedRun, + baselineEmpty, selectedEmpty, baselineBalance, selectedBalance, frees, _costs⟩ := laws + exact ⟨fuel, baselineReleased, selectedReleased, remaining, baselineRun, selectedRun, + baselineEmpty, selectedEmpty, baselineBalance, selectedBalance, frees⟩ + +/-- Extend the exact R3 reclamation witnesses with RC and peak bounds. -/ +theorem Result.CostBounds.reclaimed {baseline selected : Result} {locRel : Nat → Nat → Prop} + (costs : baseline.CostBounds selected) + (heaps : ReuseSim.StableHeapRel baseline.store selected.store locRel) + (allocations : baseline.ReclaimedAllocationLaws selected) : + baseline.ReclaimedCostLaws selected := by + obtain ⟨fuel, baselineReleased, selectedReleased, remaining, baselineRun, selectedRun, + baselineEmpty, selectedEmpty, baselineBalance, selectedBalance, frees⟩ := allocations + exact ⟨fuel, baselineReleased, selectedReleased, remaining, baselineRun, selectedRun, + baselineEmpty, selectedEmpty, baselineBalance, selectedBalance, frees, + costs.releaseShared heaps baselineRun selectedRun baselineEmpty selectedEmpty⟩ + +end Ix.Compiler.IxIR2.Eval + +namespace Ix.Compiler.IxIR2.Pipeline + +/-- The RC and peak bounds concern any two actual successful physical runs, +with independent choices of sufficient control and heap fuel. -/ +theorem CompiledAttachment.successfulPhysicalCostBounds + {world : Ixon.Owned} {fuel : Nat} (attached : CompiledAttachment world fuel) + (selection : Reuse.Selection Validate.defaultLimits + attached.target.artifact.validationContext attached.target.artifact.program) + {baselineControl baselineHeap selectedControl selectedHeap : Nat} + {baseline selected : Eval.Result} + (baselineRun : Eval.runMain attached.simulationTargetContext .physical + attached.target.artifact.program baselineControl baselineHeap = .ok baseline) + (selectedRun : Eval.runMain + (Eval.Context.ofProgram selection.target attached.target.artifact.validationContext.schemas) + .physical selection.target selectedControl selectedHeap = .ok selected) : + baseline.CostBounds selected := by + obtain ⟨control, result, locRel, run, _heaps, _values, _fuel, _events, costs⟩ := + ReuseLiveSim.selectedPhysicalMainSimulationWithCosts selection baselineRun + obtain ⟨stores, _values⟩ := Eval.runMain_success_unique + (attached.selectedMainEntry selection).1 (attached.selectedMainEntry selection).2 run selectedRun + simpa only [Eval.Result.CostBounds, stores] using costs + +/-- Every actual selected prefix, including all internal macro states, fits +within the physical baseline's terminal RC count and peak-live count. -/ +def CompiledAttachment.PrefixCostBounds + {world : Ixon.Owned} {fuel : Nat} (attached : CompiledAttachment world fuel) + (selection : Reuse.Selection Validate.defaultLimits + attached.target.artifact.validationContext attached.target.artifact.program) + (heapFuel : Nat) (baseline : Eval.Result) : Prop := + ∀ {count : Nat} {middle : Eval.Machine}, + Eval.Steps (Eval.Context.ofProgram selection.target attached.target.artifact.validationContext.schemas) + .physical count (Eval.initialMachine selection.target.main #[] heapFuel) middle → + middle.store.heap.rcops ≤ baseline.store.heap.rcops ∧ + middle.store.peakLiveNodes ≤ baseline.store.peakLiveNodes ∧ + middle.store.live ≤ baseline.store.peakLiveNodes + +theorem CompiledAttachment.selectedPrefixCostBounds + {world : Ixon.Owned} {fuel : Nat} (attached : CompiledAttachment world fuel) + (selection : Reuse.Selection Validate.defaultLimits + attached.target.artifact.validationContext attached.target.artifact.program) + {controlFuel heapFuel : Nat} {baseline selected : Eval.Result} + (selectedRun : Eval.runMain + (Eval.Context.ofProgram selection.target attached.target.artifact.validationContext.schemas) + .physical selection.target controlFuel heapFuel = .ok selected) + (costs : baseline.CostBounds selected) : attached.PrefixCostBounds selection heapFuel baseline := by + rw [Eval.runMain_eq_runMachine (attached.selectedMainEntry selection).1 + (attached.selectedMainEntry selection).2] at selectedRun + intro count middle prefixSteps + have observed := Eval.runMachine_prefix_costs selectedRun prefixSteps (Nat.le_refl 0) + exact ⟨Nat.le_trans observed.1 costs.rcops, + Nat.le_trans observed.2.1 costs.peakLive, Nat.le_trans observed.2.2 costs.peakLive⟩ + +/-- Owned execution derives the same semantic and resource endpoints as R3, +and the compiler trace supplies RC and peak bounds without new caller premises. -/ +theorem CompiledAttachment.selectedPhysicalMainCostLaws + {fuel : Nat} (attached : CompiledAttachment .shared fuel) + (selection : Reuse.Selection Validate.defaultLimits + attached.target.artifact.validationContext attached.target.artifact.program) + {sourceFuel : Nat} {sourceOut : IxIR1.Store × IxIR1.RVal} + (ownedRun : IxIR1.runOwnedMain attached.simulationSourceContext + attached.target.artifact.source.mainResult attached.target.artifact.source.main + sourceFuel = .ok sourceOut) : + ∃ baselineControl selectedControl heapFuel baseline selected locRel, + Eval.runMain attached.simulationTargetContext .physical + attached.target.artifact.program baselineControl heapFuel = .ok baseline ∧ + Eval.runMain + (Eval.Context.ofProgram selection.target attached.target.artifact.validationContext.schemas) + .physical selection.target selectedControl heapFuel = .ok selected ∧ + Lower.Sim.OutcomeRel sourceOut baseline ∧ + ReuseSim.StableHeapRel baseline.store selected.store locRel ∧ + IxIR1.Sim.RValIso locRel baseline.value selected.value ∧ + baseline.SharedResources ∧ selected.SharedResources ∧ + baseline.AllocationLaws selected ∧ baseline.CostBounds selected ∧ + baseline.ReclaimedCostLaws selected ∧ attached.PrefixCostBounds selection heapFuel baseline := by + obtain ⟨baselineControl, selectedControl, heapFuel, baseline, selected, locRel, + baselineRun, selectedRun, baselineRelation, heaps, values, baselineResources, + selectedResources, allocations, reclaimed⟩ := attached.selectedPhysicalMainAllocationLaws selection ownedRun + have costs := attached.successfulPhysicalCostBounds selection baselineRun selectedRun + exact ⟨baselineControl, selectedControl, heapFuel, baseline, selected, locRel, + baselineRun, selectedRun, baselineRelation, heaps, values, baselineResources, + selectedResources, allocations, costs, costs.reclaimed heaps reclaimed, + attached.selectedPrefixCostBounds selection selectedRun costs⟩ + +/-- Full counter and reclamation laws for arbitrary actual successful runs; +the prefix bound uses the selected run's own traversal budget. -/ +theorem CompiledAttachment.successfulPhysicalCostLaws + {fuel : Nat} (attached : CompiledAttachment .shared fuel) + (selection : Reuse.Selection Validate.defaultLimits + attached.target.artifact.validationContext attached.target.artifact.program) + {sourceFuel : Nat} {sourceOut : IxIR1.Store × IxIR1.RVal} + (ownedRun : IxIR1.runOwnedMain attached.simulationSourceContext + attached.target.artifact.source.mainResult attached.target.artifact.source.main + sourceFuel = .ok sourceOut) + {baselineControl baselineHeap selectedControl selectedHeap : Nat} + {baseline selected : Eval.Result} + (baselineRun : Eval.runMain attached.simulationTargetContext .physical + attached.target.artifact.program baselineControl baselineHeap = .ok baseline) + (selectedRun : Eval.runMain + (Eval.Context.ofProgram selection.target attached.target.artifact.validationContext.schemas) + .physical selection.target selectedControl selectedHeap = .ok selected) : + baseline.AllocationLaws selected ∧ baseline.CostBounds selected ∧ + baseline.ReclaimedCostLaws selected ∧ attached.PrefixCostBounds selection selectedHeap baseline := by + obtain ⟨witnessBaselineControl, witnessSelectedControl, witnessHeap, witnessBaseline, + witnessSelected, locRel, witnessBaselineRun, witnessSelectedRun, + _baselineRelation, _heaps, _values, _baselineResources, _selectedResources, + allocations, costs, reclaimed, _prefixes⟩ := attached.selectedPhysicalMainCostLaws selection ownedRun + obtain ⟨baselineStores, baselineValues⟩ := Eval.runMain_success_unique + attached.target.artifact.mainArity attached.target.artifact.mainNonempty witnessBaselineRun baselineRun + obtain ⟨selectedStores, selectedValues⟩ := Eval.runMain_success_unique + (attached.selectedMainEntry selection).1 (attached.selectedMainEntry selection).2 + witnessSelectedRun selectedRun + have actualCosts : baseline.CostBounds selected := by + simpa only [Eval.Result.CostBounds, baselineStores, selectedStores] using costs + refine ⟨⟨?_, ?_⟩, actualCosts, ?_, attached.selectedPrefixCostBounds selection selectedRun actualCosts⟩ + · simpa only [baselineStores, selectedStores] using allocations.allocations + · simpa only [baselineStores, selectedStores] using allocations.frees + · simpa only [Eval.Result.ReclaimedCostLaws, baselineStores, baselineValues, + selectedStores, selectedValues] using reclaimed + +/-- Compare the selected result and every prefix of its execution with one +actual checked baseline, preserving both R2 resources and R3's counter laws. -/ +def CompiledAttachment.CostComparison + {fuel : Nat} (attached : CompiledAttachment .shared fuel) + (selection : Reuse.Selection Validate.defaultLimits + attached.target.artifact.validationContext attached.target.artifact.program) + (selectedHeap : Nat) (selected : Eval.Result) : Prop := + ∃ baselineControl baselineHeap baseline, + Eval.runMain attached.simulationTargetContext .physical attached.target.artifact.program + baselineControl baselineHeap = .ok baseline ∧ + baseline.SharedResources ∧ baseline.AllocationLaws selected ∧ baseline.CostBounds selected ∧ + baseline.ReclaimedCostLaws selected ∧ attached.PrefixCostBounds selection selectedHeap baseline + +theorem CompiledAttachment.CostComparison.allocations + {fuel : Nat} {attached : CompiledAttachment .shared fuel} + {selection : Reuse.Selection Validate.defaultLimits + attached.target.artifact.validationContext attached.target.artifact.program} + {heapFuel : Nat} {selected : Eval.Result} + (comparison : attached.CostComparison selection heapFuel selected) : + attached.AllocationComparison selected := by + obtain ⟨control, heap, baseline, run, resources, allocations, _costs, reclaimed, _prefixes⟩ := comparison + exact ⟨control, heap, baseline, run, resources, allocations, reclaimed.allocations⟩ + +end Ix.Compiler.IxIR2.Pipeline diff --git a/Ix/Compiler/IxIR2/PipelineInvoke.lean b/Ix/Compiler/IxIR2/PipelineInvoke.lean new file mode 100644 index 000000000..7510b5bf0 --- /dev/null +++ b/Ix/Compiler/IxIR2/PipelineInvoke.lean @@ -0,0 +1,84 @@ +import Ix.Compiler.IxIR2.PipelinePhysical + +/-! Successful runtime invocation through the actual structured lowering. +Entry ownership, reachable-heap provenance, and runtime invariants are the +usual semantic ABI obligations; all callee simulations come from the checked +attachment's existing recursive trace worker. -/ + +namespace Ix.Compiler.IxIR2.Pipeline + +theorem CompiledAttachment.successfulFunctionSimulation + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {address : Ixon.Address} {definition : Function} + (declared : attached.simulationTargetContext.declarations address = some (.fn definition)) + (papSafe : definition.signature.papSafe = true) + (values : Array IxIR1.RVal) + {sourceFuel : Nat} {store : IxIR1.Store} {output : IxIR1.Store × IxIR1.RVal} + (run : IxIR1.invoke attached.simulationSourceContext sourceFuel address values.toList store = .ok output) + (ownership : IxIR1.Sim.RootOwnership store (IxIR1.Sim.rootsFor .shared values.toList)) + (runtime : Lower.Sim.SourceRuntimeInvariant store values.toList.reverse) + (image : attached.SourceStoreImage store) : + ∃ controlFuel heapFuel targetOutput, + Eval.runFunction attached.simulationTargetContext .physical definition values controlFuel heapFuel + { heap := store } = .ok targetOutput ∧ + Lower.Sim.OutcomeRel output targetOutput := by + obtain ⟨bodyFuel, _, invoked⟩ := IxIR1.invoke_success run + cases invoked with + | extern found _ _ _ => + exact False.elim (attached.sourceDeclaration_not_extern rfl found) + | @fn sourceDefinition bodyOutput found arity bodyRun checked => + obtain ⟨targetDefinition, trace, member, matched, targetAt⟩ := + attached.functionTrace_of_source_declaration rfl rfl found + have same : targetDefinition = definition := + Decl.fn.inj (Option.some.inj (targetAt.symm.trans declared)) + subst targetDefinition + obtain ⟨outputEq, world⟩ := IxIR1.Sim.checkResultWorld_ok checked + subst bodyOutput + have sourceArity : values.size = trace.source.arity := by + simpa [matched.source] using arity + have targetArity : values.size = definition.signature.params.size := by + simpa [matched.generated] using sourceArity.trans trace.sourceArity.symm + have nonempty : definition.blocks.isEmpty = false := by + have head := trace.headBlockAt + rw [trace.rootHeadBlock, matched.generated] at head + obtain ⟨bound, _⟩ := Array.getElem?_eq_some_iff.mp head + simpa [Array.isEmpty] using (Nat.ne_of_gt bound) + let frame : Eval.Frame := { definition, values } + let machine := Eval.initialMachine definition values 0 { heap := store } + have state : attached.sidecars.TraceStateRel trace trace.root store values.toList.reverse frame := by + simpa [frame, matched.generated] using attached.functionEntryTraceState member values sourceArity + have stores : Lower.Sim.StoreRel store machine.store := by constructor <;> rfl + have entryOwnership : Lower.Sim.SourceOwnershipAt attached.target.artifact.trace.positions + trace.root store values.toList.reverse [] := by + intro position positionMember coordinate + rw [attached.target.entryCapabilities member positionMember coordinate] + have shape := attached.target.papSafeEntryCapabilities member (by simpa [matched.generated] using papSafe) + apply Lower.Sim.SourceOwnershipInvariant.sharedEntry + · simpa [matched.generated, targetArity] using shape + · simpa using ownership + have executed : IxIR1.runCode attached.simulationSourceContext bodyFuel trace.source store + values.toList.reverse trace.root.sourceCode = .ok output := by + simpa [trace.rootSourceCode, matched.source] using bodyRun + have resultWorld : IxIR1.Sim.HasWorld output.1 trace.source.result output.2 := by + simpa [matched.source] using world + have reached := (attached.successfulTraceSimulation attached.simulationSourceContext + attached.simulationTargetContext attached.successfulSimulationContracts bodyFuel) + member Lower.CodeTrace.Descendant.refl state stores runtime entryOwnership executed resultWorld + (show machine.control = .running frame [] from rfl) (show frame.credits = #[] from rfl) image + (attached.haltReturnHandler attached.simulationSourceContext attached.simulationTargetContext .logical trace output) + obtain ⟨heapFuel, controlFuel, final, steps, halted, finalStores⟩ := reached + cases final with + | mk targetStore heapRemaining finalControl => + dsimp only at halted + subst finalControl + let targetOutput : Eval.Result := { store := targetStore, value := output.2, controlRemaining := 0, heapRemaining } + have logical : Eval.runFunction attached.simulationTargetContext .logical definition values controlFuel heapFuel + { heap := store } = .ok targetOutput := by + rw [Eval.runFunction_eq_runMachine targetArity nonempty] + simpa [machine, targetOutput, Eval.initialMachine] using steps.runMachine_halted + exact ⟨controlFuel, heapFuel, targetOutput, + Eval.runFunction_creditFree attached.target.creditFree declared targetArity nonempty logical, + { finalStores with value := rfl }⟩ + +end Ix.Compiler.IxIR2.Pipeline diff --git a/Ix/Compiler/IxIR2/PipelinePhysical.lean b/Ix/Compiler/IxIR2/PipelinePhysical.lean new file mode 100644 index 000000000..9e634114b --- /dev/null +++ b/Ix/Compiler/IxIR2/PipelinePhysical.lean @@ -0,0 +1,48 @@ +import Ix.Compiler.IxIR2.PipelineSim +import Ix.Compiler.IxIR2.Interpretation + +/-! The validated baseline's exact logical-to-physical execution boundary. -/ + +namespace Ix.Compiler.IxIR2.Pipeline + +/-- The emitted baseline has identical successful main runs under both +interpretations. The attachment supplies the complete instruction inventory +and entry facts; callers supply only the run being transported. -/ +theorem CompiledAttachment.mainInterpretation + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {first second : Eval.Interpretation} {controlFuel heapFuel : Nat} + {result : Eval.Result} + (run : Eval.runMain attached.simulationTargetContext first + attached.target.artifact.program controlFuel heapFuel = .ok result) : + Eval.runMain attached.simulationTargetContext second + attached.target.artifact.program controlFuel heapFuel = .ok result := + Eval.runMain_creditFree attached.target.creditFree + attached.target.artifact.mainArity attached.target.artifact.mainNonempty run + +/-- Compose the existing logical whole-main theorem with exact baseline +interpretation independence. The source heap and value remain unchanged. -/ +theorem CompiledAttachment.successfulPhysicalMainSimulation + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceFuel : Nat} {sourceOut : IxIR1.Store × IxIR1.RVal} + (run : IxIR1.runOwnedMain attached.simulationSourceContext + attached.target.artifact.source.mainResult + attached.target.artifact.source.main sourceFuel = .ok sourceOut) : + ∃ controlFuel heapFuel targetOut, + Eval.runMain attached.simulationTargetContext .physical + attached.target.artifact.program controlFuel heapFuel = .ok targetOut ∧ + Lower.Sim.OutcomeRel sourceOut targetOut := by + obtain ⟨controlFuel, heapFuel, targetOut, logicalRun, related⟩ := + attached.successfulCanonicalMainSimulation run + exact ⟨controlFuel, heapFuel, targetOut, attached.mainInterpretation logicalRun, related⟩ + + +/-! Existing theorem names remain available for direct application. -/ +namespace Attached +export CompiledAttachment ( + mainInterpretation + successfulPhysicalMainSimulation) +end Attached + +end Ix.Compiler.IxIR2.Pipeline diff --git a/Ix/Compiler/IxIR2/PipelineResources.lean b/Ix/Compiler/IxIR2/PipelineResources.lean new file mode 100644 index 000000000..60974d15f --- /dev/null +++ b/Ix/Compiler/IxIR2/PipelineResources.lean @@ -0,0 +1,140 @@ +import Ix.Compiler.IxIR2.PipelinePhysical +import Ix.Compiler.IxIR2.ReuseLiveSim +import Ix.Compiler.IxIR2.ReuseResources +import Ix.Compiler.IxIR2.EvalFuel + +/-! +# Terminal resources for the selected compiler output + +The common checked shared-main attachment supplies reclamation for its owned +IxIR₁ execution. Exact baseline lowering and the existing selected semantic +relation transport the release; actual physical execution supplies allocation +accounting independently of that relation. +-/ + +namespace Ix.Compiler.IxIR2.Pipeline + +open Ix.Compiler.Ixon (Owned) + +theorem CompiledAttachment.selectedMainEntry + {world : Owned} {fuel : Nat} (attached : CompiledAttachment world fuel) + (selection : Reuse.Selection Validate.defaultLimits + attached.target.artifact.validationContext attached.target.artifact.program) : + selection.target.main.signature.params.size = 0 ∧ + selection.target.main.blocks.isEmpty = false := by + cases selection with + | optimized output produced => + change output.target.main.signature.params.size = 0 ∧ + output.target.main.blocks.isEmpty = false + rw [← output.trace_target] + exact ⟨by rw [output.trace.target_main_signature]; exact attached.target.artifact.mainArity, + output.trace.main.definition_blocks_nonempty attached.target.artifact.mainNonempty⟩ + | baseline error rejected => + exact ⟨attached.target.artifact.mainArity, attached.target.artifact.mainNonempty⟩ + +/-- Successful owned execution of the exact shared compiler input supplies a +release for any exactly related baseline result. No heap premise is supplied. -/ +theorem CompiledAttachment.baselineSharedReclamation + {fuel : Nat} (attached : CompiledAttachment .shared fuel) + {sourceFuel : Nat} {store : IxIR1.Store} {value : IxIR1.RVal} + (ownedRun : IxIR1.runOwnedMain attached.simulationSourceContext + attached.target.artifact.source.mainResult attached.target.artifact.source.main + sourceFuel = .ok (store, value)) + {baseline : Eval.Result} (related : Lower.Sim.OutcomeRel (store, value) baseline) : + ∃ releaseFuel released, + Eval.releaseShared releaseFuel baseline.store baseline.value = .ok (released, 0) ∧ + released.live = 0 := by + have mainWorld : attached.target.artifact.source.mainResult = .shared := by + rw [attached.targetSourceProduced, attached.inputProduced] + have bodyRun := (IxIR1.Sim.runOwnedMain_ok ownedRun).1 + rw [mainWorld] at bodyRun + have run : IxIR1.runMain attached.simulationSourceContext + attached.target.artifact.source.main sourceFuel = .ok (store, value) := bodyRun + have noReuse := attached.functionTraceNoReuse attached.target.artifact.mainTraceMember + rw [attached.target.artifact.mainSource] at noReuse + have reuses := IxIR1.NoReuse.runMain_reuses_eq_zero + (attached.sourceContextNoReuse rfl) noReuse run + have order := (IxIR1.Reclamation.runMain_order_of_reuses_eq_zero run reuses).1 + have positive : Lower.Sim.PositiveSharedRC store := by + intro location box found shared + exact order.rc_pos found + have addressedRun : IxIR1.runMain + (attached.source.lowering.result.addressedCtx (fun _ _ => none)) + attached.source.lowering.result.main sourceFuel = .ok (store, value) := by + rw [attached.simulationSourceContext_eq_addressedCtx, attached.targetSourceProduced, + attached.inputProduced] at run + exact run + obtain ⟨sourceReleaseFuel, sourceReleased, sourceRelease, sourceEmpty⟩ := + attached.source.reclamation (fun _ _ => none) addressedRun + obtain ⟨releaseFuel, released, release, stores, positiveOut⟩ := + Lower.Sim.dropVal_simulates_releaseSharedWork positive related.toStoreRel sourceRelease + refine ⟨releaseFuel, released, ?_, ?_⟩ + · rw [related.value] + exact release + · change released.heap.live = 0 + rw [stores.heap] + exact sourceEmpty + +/-- Every actual successful physical main of the selected program accounts +for all allocations, including checked fallback to the baseline. -/ +theorem CompiledAttachment.selectedAllocationAccounting + {world : Owned} {fuel : Nat} (attached : CompiledAttachment world fuel) + (selection : Reuse.Selection Validate.defaultLimits + attached.target.artifact.validationContext attached.target.artifact.program) + {context : Eval.Context} {controlFuel heapFuel : Nat} {result : Eval.Result} + (run : Eval.runMain context .physical selection.target controlFuel heapFuel = .ok result) : + result.store.live + result.store.heap.frees = result.store.heap.allocs := + Eval.runMain_allocationAccounting (attached.selectedMainEntry selection).1 + (attached.selectedMainEntry selection).2 run + +/-- The existing baseline simulation plus selected reuse preserves semantics +and derives terminal resources for the same actual selected execution. -/ +theorem CompiledAttachment.selectedPhysicalMainResources + {fuel : Nat} (attached : CompiledAttachment .shared fuel) + (selection : Reuse.Selection Validate.defaultLimits + attached.target.artifact.validationContext attached.target.artifact.program) + {sourceFuel : Nat} {sourceOut : IxIR1.Store × IxIR1.RVal} + (ownedRun : IxIR1.runOwnedMain attached.simulationSourceContext + attached.target.artifact.source.mainResult attached.target.artifact.source.main + sourceFuel = .ok sourceOut) : + ∃ controlFuel heapFuel result baseline locRel, + Eval.runMain + (Eval.Context.ofProgram selection.target attached.target.artifact.validationContext.schemas) + .physical selection.target controlFuel heapFuel = .ok result ∧ + Lower.Sim.OutcomeRel sourceOut baseline ∧ + ReuseSim.StableHeapRel baseline.store result.store locRel ∧ + IxIR1.Sim.RValIso locRel baseline.value result.value ∧ + result.SharedResources := by + obtain ⟨baselineControl, heapFuel, baseline, baselineRun, baselineRelation⟩ := + attached.successfulPhysicalMainSimulation ownedRun + obtain ⟨releaseFuel, released, release, empty⟩ := + attached.baselineSharedReclamation ownedRun baselineRelation + obtain ⟨controlFuel, result, locRel, run, heaps, values, budget⟩ := + ReuseLiveSim.selectedPhysicalMainSimulation selection baselineRun + obtain ⟨output, outputRelease, outputEmpty⟩ := heaps.sharedReclamation values release empty + exact ⟨controlFuel, heapFuel, result, baseline, locRel, run, baselineRelation, heaps, values, + Eval.Result.sharedResources_of_release + (attached.selectedAllocationAccounting selection run) outputRelease outputEmpty⟩ + +/-- The resource guarantee applies to any successful execution of the actual +selection, including a different sufficient choice of control and heap fuel. -/ +theorem CompiledAttachment.selectedSuccessfulSharedResources + {fuel : Nat} (attached : CompiledAttachment .shared fuel) + (selection : Reuse.Selection Validate.defaultLimits + attached.target.artifact.validationContext attached.target.artifact.program) + {sourceFuel : Nat} {sourceOut : IxIR1.Store × IxIR1.RVal} + (ownedRun : IxIR1.runOwnedMain attached.simulationSourceContext + attached.target.artifact.source.mainResult attached.target.artifact.source.main + sourceFuel = .ok sourceOut) + {controlFuel heapFuel : Nat} {result : Eval.Result} + (run : Eval.runMain + (Eval.Context.ofProgram selection.target attached.target.artifact.validationContext.schemas) + .physical selection.target controlFuel heapFuel = .ok result) : result.SharedResources := by + obtain ⟨witnessControl, witnessHeap, witness, baseline, locRel, witnessRun, + baselineRelation, heaps, values, resources⟩ := + attached.selectedPhysicalMainResources selection ownedRun + obtain ⟨stores, values⟩ := Eval.runMain_success_unique + (attached.selectedMainEntry selection).1 (attached.selectedMainEntry selection).2 witnessRun run + simpa only [Eval.Result.SharedResources, stores, values] using resources + +end Ix.Compiler.IxIR2.Pipeline diff --git a/Ix/Compiler/IxIR2/PipelineSim.lean b/Ix/Compiler/IxIR2/PipelineSim.lean new file mode 100644 index 000000000..2ae39cb78 --- /dev/null +++ b/Ix/Compiler/IxIR2/PipelineSim.lean @@ -0,0 +1,11102 @@ +import Ix.Compiler.IxIR2.LowerSim +import Ix.Compiler.IxIR2.Pipeline +import Ix.Compiler.IxIR1.EvalHistory +import Ix.Compiler.IxIR1.ReaddressOwnership +import Ix.Compiler.LoweredCompilationSim + +/-! +# HPT-backed simulation adapters for the structured IxIR₂ pipeline + +This module composes the executable source-site sidecars with the local +IxIR₁-to-IxIR₂ simulation rules. Keeping the adapters here avoids making +the executable pipeline depend on the full simulation development. +-/ + +namespace Ix.Compiler.IxIR2.Pipeline + +open Ix.Compiler.IxIR2 + +/-- The recursive IxIR₂ trace state paired with the two source-side facts +needed by the HPT-backed simulation: its retained coordinate names the exact +IxIR₁ suffix, and the concrete source environment satisfies the facts +replayed at that coordinate. -/ +structure Sidecars.TraceStateRel (sidecars : Sidecars) + (functionTrace : Lower.FunctionTrace) (trace : Lower.CodeTrace) + (sourceStore : IxIR1.Store) (source : List IxIR1.RVal) + (frame : Eval.Frame) : Prop where + sourceCode : sidecars.sourceCodeAt? trace.source = some trace.sourceCode + owner : trace.source.owner = functionTrace.owner + environment : sidecars.SiteEnvironmentHolds sourceStore trace.source source + target : Lower.Sim.CodeStateRel functionTrace trace source frame + +/-- The compiler's root-coordinate certificate and retained function syntax +identify the same source body recovered by the sidecar. -/ +theorem Sidecars.sourceCodeAt?_functionRoot (sidecars : Sidecars) + {functionTrace : Lower.FunctionTrace} + (currentAt : sidecars.analysisCurrent? functionTrace.owner = + some functionTrace.source) : + sidecars.sourceCodeAt? functionTrace.root.source = + some functionTrace.root.sourceCode := by + rw [functionTrace.rootSource, functionTrace.rootSourceCode] + exact sidecars.sourceCodeAt?_root currentAt + +/-- Any retained function begins in the combined trace/HPT state when its +resolved arguments are installed in call order. -/ +theorem Sidecars.functionEntryTraceState (sidecars : Sidecars) + {functionTrace : Lower.FunctionTrace} {sourceStore : IxIR1.Store} + (currentAt : sidecars.analysisCurrent? functionTrace.owner = + some functionTrace.source) + (values : Array IxIR1.RVal) + (arity : values.size = functionTrace.source.arity) : + sidecars.TraceStateRel functionTrace functionTrace.root sourceStore + values.toList.reverse + { definition := functionTrace.generated, values } := by + constructor + · exact sidecars.sourceCodeAt?_functionRoot currentAt + · rw [functionTrace.rootSource] + · rw [functionTrace.rootSource] + apply sidecars.siteEnvironmentHolds_root currentAt + simpa using arity + · exact Lower.Sim.functionEntryCodeState functionTrace values arity + +/-- Every retained declaration trace starts in the combined state. Attachment +alignment supplies the exact HPT analysis root, so recursive call simulation +needs no separately reconstructed source function. -/ +theorem CompiledAttachment.declarationFunctionEntryTraceState + {mainWorld : Ixon.Owned} + {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {functionTrace : Lower.FunctionTrace} {sourceStore : IxIR1.Store} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + (notMain : functionTrace.owner ≠ .main) + (values : Array IxIR1.RVal) + (arity : values.size = functionTrace.source.arity) : + attached.sidecars.TraceStateRel functionTrace functionTrace.root + sourceStore values.toList.reverse + { definition := functionTrace.generated, values } := by + exact attached.sidecars.functionEntryTraceState + (attached.functionTraceAnalysisCurrent functionMember notMain) values arity + +/-- A retained synthetic-main trace also has a combined entry state at any +store. Whole-program trace order identifies its literal closed source body; +its zero arity reduces the argument environment to the empty main root. -/ +theorem CompiledAttachment.mainFunctionEntryTraceState + {mainWorld : Ixon.Owned} + {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {functionTrace : Lower.FunctionTrace} {sourceStore : IxIR1.Store} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + (owner : functionTrace.owner = .main) + (values : Array IxIR1.RVal) + (arity : values.size = functionTrace.source.arity) : + attached.sidecars.TraceStateRel functionTrace functionTrace.root + sourceStore values.toList.reverse + { definition := functionTrace.generated, values } := by + have mainMatch := attached.target.artifact.functionTraceOrderProof + |>.main_of_mem_owner functionMember owner + have sourceArityZero : functionTrace.source.arity = 0 := by + rw [mainMatch.source, attached.targetSourceProduced] + rfl + have valuesEmpty : values = #[] := + Array.eq_empty_of_size_eq_zero (arity.trans sourceArityZero) + subst values + constructor + · simpa [functionTrace.rootSource, owner, functionTrace.rootSourceCode, + mainMatch.source, attached.targetSourceProduced, + Lower.Input.mainDefinition] using + attached.sidecars.sourceCodeAt?_main + · rw [functionTrace.rootSource] + · rw [functionTrace.rootSource, owner] + exact attached.sidecars.siteEnvironmentHolds_main + · exact Lower.Sim.functionEntryCodeState functionTrace #[] (by + simp [sourceArityZero]) + +/-- Every retained function, including the fail-closed synthetic main, starts +in the combined state for its canonical reversed argument environment. -/ +theorem CompiledAttachment.functionEntryTraceState + {mainWorld : Ixon.Owned} + {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {functionTrace : Lower.FunctionTrace} {sourceStore : IxIR1.Store} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + (values : Array IxIR1.RVal) + (arity : values.size = functionTrace.source.arity) : + attached.sidecars.TraceStateRel functionTrace functionTrace.root + sourceStore values.toList.reverse + { definition := functionTrace.generated, values } := by + by_cases owner : functionTrace.owner = .main + · exact attached.mainFunctionEntryTraceState functionMember owner values arity + · exact attached.declarationFunctionEntryTraceState functionMember owner + values arity + +/-- The exact checked target main starts in the combined source/HPT/target +trace state with empty source store and environment. -/ +theorem CompiledAttachment.initialMainTraceState + {mainWorld : Ixon.Owned} + {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) : + attached.sidecars.TraceStateRel + attached.target.artifact.mainTrace + attached.target.artifact.mainTrace.root ({} : IxIR1.Store) [] + (Lower.Sim.initialMainFrame attached.target.artifact) := by + constructor + · rw [attached.target.artifact.mainTrace.rootSource, + attached.target.artifact.mainOwner, + attached.target.artifact.mainRootSourceCode, + attached.targetSourceProduced] + exact attached.sidecars.sourceCodeAt?_main + · rw [attached.target.artifact.mainTrace.rootSource] + · rw [attached.target.artifact.mainTrace.rootSource, + attached.target.artifact.mainOwner] + exact attached.sidecars.siteEnvironmentHolds_main + · exact Lower.Sim.initialMainCodeState attached.target.artifact + +/-- The checked synthetic main also starts with the exact trace-indexed +ownership state: both its source environment and retained input map are +empty, so there are no external owner tokens to account for. -/ +theorem CompiledAttachment.initialMainSourceOwnership + {mainWorld : Ixon.Owned} + {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) : + Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + attached.target.artifact.mainTrace.root ({} : IxIR1.Store) [] [] := by + apply Lower.Sim.SourceOwnershipAt.empty + rw [attached.target.artifact.mainEntryInput] + rfl + +/-- Generic linear induction step for the combined state. The operation's +target simulation supplies only the next target `CodeStateRel`; source syntax +and the HPT environment advance from the retained trace and successful source +operation. -/ +theorem Sidecars.TraceStateRel.next + {sidecars : Sidecars} {functionTrace : Lower.FunctionTrace} + {sourceContext : IxIR1.Ctx} {sourceCurrent : IxIR1.FnDef} + {sourceFuel : Nat} {sourceStore outputStore : IxIR1.Store} + {source : List IxIR1.RVal} {operation : IxIR1.Op} + {value : IxIR1.RVal} {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {instruction : Instr} {next : Lower.CodeTrace} + {frame nextFrame : Eval.Frame} + (state : sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount operation index + instruction next) sourceStore source frame) + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount operation index + instruction next)) + (postFixpoint : IxIR1.HPT.LocalPostFixpoint + (IxIR1.Env.ofList sidecars.input.declarations) + sidecars.hptCertificate.summaryEnv) + (sourceDeclarations : sourceContext.decls = + IxIR1.Env.ofList sidecars.input.declarations) + (currentCompatible : ∀ current, + sidecars.analysisCurrent? site.owner = some current → + current = sourceCurrent) + (sourceRun : IxIR1.runOp sourceContext sourceFuel sourceCurrent + sourceStore source operation = .ok (outputStore, value)) + (nextTarget : Lower.Sim.CodeStateRel functionTrace next + (value :: source) nextFrame) : + sidecars.TraceStateRel functionTrace next outputStore + (value :: source) nextFrame := by + have continuation := (functionTrace.descendantLetOpMatch descendant).1 + have sourceAt : sidecars.sourceCodeAt? site = + some (.letOp operation next.sourceCode) := by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceCode] using + state.sourceCode + have nextSourceAt := sidecars.sourceCodeAt?_next sourceAt + have nextEnvironment := + sidecars.siteEnvironmentHolds_next_of_currentCompatible postFixpoint + sourceDeclarations currentCompatible state.environment sourceAt sourceRun + constructor + · rw [continuation.nextSource] + exact nextSourceAt + · rw [continuation.nextSource] + exact state.owner + · rw [continuation.nextSource] + exact nextEnvironment + · exact nextTarget + +/-- Attachment-facing linear transport. The attachment supplies the checked +HPT post-fixpoint and rewrites the source evaluator's declaration environment +to the exact sidecar environment; callers retain only function-owner +compatibility and the local successful operation. -/ +theorem CompiledAttachment.traceState_next + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceCurrent : IxIR1.FnDef} + {sourceFuel : Nat} {sourceStore outputStore : IxIR1.Store} + {source : List IxIR1.RVal} {operation : IxIR1.Op} + {value : IxIR1.RVal} {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {instruction : Instr} {next : Lower.CodeTrace} + {frame nextFrame : Eval.Frame} {functionTrace : Lower.FunctionTrace} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount operation index + instruction next) sourceStore source frame) + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount operation index + instruction next)) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (currentCompatible : ∀ current, + attached.sidecars.analysisCurrent? functionTrace.owner = some current → + current = sourceCurrent) + (sourceRun : IxIR1.runOp sourceContext sourceFuel sourceCurrent + sourceStore source operation = .ok (outputStore, value)) + (nextTarget : Lower.Sim.CodeStateRel functionTrace next + (value :: source) nextFrame) : + attached.sidecars.TraceStateRel functionTrace next outputStore + (value :: source) nextFrame := by + apply state.next descendant attached.hptSidecarLocalPostFixpoint + (sourceDeclarations.trans attached.sidecarDeclarationEnvironment.symm) + · intro current currentAt + apply currentCompatible current + rw [← state.owner] + exact currentAt + · exact sourceRun + · exact nextTarget + +/-- Declaration-trace specialization: the attachment's whole-trace alignment +discharges current-function compatibility for any retained function member. -/ +theorem CompiledAttachment.traceState_next_of_member + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {sourceStore outputStore : IxIR1.Store} + {source : List IxIR1.RVal} {operation : IxIR1.Op} + {value : IxIR1.RVal} {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {instruction : Instr} {next : Lower.CodeTrace} + {frame nextFrame : Eval.Frame} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount operation index + instruction next) sourceStore source frame) + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount operation index + instruction next)) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceRun : IxIR1.runOp sourceContext sourceFuel functionTrace.source + sourceStore source operation = .ok (outputStore, value)) + (nextTarget : Lower.Sim.CodeStateRel functionTrace next + (value :: source) nextFrame) : + attached.sidecars.TraceStateRel functionTrace next outputStore + (value :: source) nextFrame := by + exact attached.traceState_next state descendant sourceDeclarations + (attached.functionTraceAnalysisCurrentCompatible functionMember) + sourceRun nextTarget + +/-- Distinguished-main specialization. It remains valid when main analysis +fails closed, and otherwise uses the producer-certified main source. -/ +theorem CompiledAttachment.mainTraceState_next + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {sourceStore outputStore : IxIR1.Store} + {source : List IxIR1.RVal} {operation : IxIR1.Op} + {value : IxIR1.RVal} {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {instruction : Instr} {next : Lower.CodeTrace} + {frame nextFrame : Eval.Frame} + (state : attached.sidecars.TraceStateRel + attached.target.artifact.mainTrace + (.letOp site blockId input nextInput entryValueCount operation index + instruction next) sourceStore source frame) + (descendant : attached.target.artifact.mainTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount operation index + instruction next)) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceRun : IxIR1.runOp sourceContext sourceFuel + attached.target.artifact.mainTrace.source sourceStore source operation = + .ok (outputStore, value)) + (nextTarget : Lower.Sim.CodeStateRel + attached.target.artifact.mainTrace next (value :: source) nextFrame) : + attached.sidecars.TraceStateRel attached.target.artifact.mainTrace next + outputStore (value :: source) nextFrame := by + apply attached.traceState_next state descendant sourceDeclarations + · intro current currentAt + apply attached.mainAnalysisCurrentCompatible current + rw [← attached.target.artifact.mainOwner] + exact currentAt + · exact sourceRun + · exact nextTarget + +/-- The traced `pure`/`move` operation advances the attachment's combined +source/HPT/target state in one target step. -/ +theorem CompiledAttachment.simulate_traced_pure_move_state + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} {context : Eval.Context} + {interpretation : Eval.Interpretation} {machine : Eval.Machine} + {frame : Eval.Frame} {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.pure sourceAtom) index (.move targetAtom) next)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {value : IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.pure sourceAtom) index (.move targetAtom) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceResolved : IxIR1.resolveAtom source sourceAtom = .ok value) + (control : machine.control = .running frame stack) : + let nextFrame : Eval.Frame := + { frame with + pc := frame.pc + 1 + values := frame.values.push value } + IxIR1.runOp sourceContext (sourceFuel + 1) functionTrace.source sourceStore + source (.pure sourceAtom) = .ok (sourceStore, value) ∧ + Eval.Step context interpretation machine + { machine with control := .running nextFrame stack } ∧ + Lower.Sim.StoreRel sourceStore machine.store ∧ + attached.sidecars.TraceStateRel functionTrace next sourceStore + (value :: source) nextFrame := by + dsimp only + have sourceOperation : + IxIR1.runOp sourceContext (sourceFuel + 1) functionTrace.source sourceStore + source (.pure sourceAtom) = .ok (sourceStore, value) := by + unfold IxIR1.runOp + simp [sourceResolved] + obtain ⟨targetStep, nextTarget⟩ := + Lower.Sim.simulate_traced_pure_move_state descendant state.target + sourceResolved control + have nextState := attached.traceState_next_of_member functionMember state + descendant sourceDeclarations sourceOperation nextTarget + exact ⟨sourceOperation, targetStep, stores, nextState⟩ + +/-- Successful-source-run induction form of `pure`/`move`: invert the source +`letOp`, take the target step, and return the smaller-fuel continuation with +the combined trace state. -/ +theorem CompiledAttachment.simulate_traced_pure_move_success_step + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} {context : Eval.Context} + {interpretation : Eval.Interpretation} {machine : Eval.Machine} + {frame : Eval.Frame} {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.pure sourceAtom) index (.move targetAtom) next)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {sourceOutput : IxIR1.Store × IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.pure sourceAtom) index (.move targetAtom) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceRun : IxIR1.runCode sourceContext (sourceFuel + 2) + functionTrace.source sourceStore source + (.letOp (.pure sourceAtom) next.sourceCode) = .ok sourceOutput) + (control : machine.control = .running frame stack) : + ∃ value nextFrame, + nextFrame = + { frame with + pc := frame.pc + 1 + values := frame.values.push value } ∧ + IxIR1.resolveAtom source sourceAtom = .ok value ∧ + IxIR1.runCode sourceContext (sourceFuel + 1) functionTrace.source + sourceStore (value :: source) next.sourceCode = .ok sourceOutput ∧ + Eval.Step context interpretation machine + { machine with control := .running nextFrame stack } ∧ + Lower.Sim.StoreRel sourceStore + ({ machine with control := .running nextFrame stack } : + Eval.Machine).store ∧ + attached.sidecars.TraceStateRel functionTrace next sourceStore + (value :: source) nextFrame := by + obtain ⟨middleStore, operationValue, operationRun, continuationRun⟩ := + IxIR1.runCode_letOp_success sourceRun + obtain ⟨value, sourceResolved, operationOutput⟩ := + IxIR1.runOp_pure_success operationRun + have middleStoreEq : middleStore = sourceStore := + congrArg Prod.fst operationOutput + have operationValueEq : operationValue = value := + congrArg Prod.snd operationOutput + subst middleStore + subst operationValue + obtain ⟨_, targetStep, nextStores, nextState⟩ := + attached.simulate_traced_pure_move_state (sourceFuel := sourceFuel) + functionMember descendant state stores + sourceDeclarations sourceResolved control + exact ⟨value, + { frame with + pc := frame.pc + 1 + values := frame.values.push value }, + rfl, sourceResolved, continuationRun, targetStep, nextStores, nextState⟩ + +/-- Checked ordinary allocation advances the attachment's combined state. +Function membership supplies the schema/capability certificates and exact +HPT owner/current compatibility for the recursive continuation. -/ +theorem CompiledAttachment.simulate_traced_alloc_checked_state + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} + {frame : Eval.Frame} {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + (contextSchemas : context.schemas = + attached.target.artifact.validationContext.schemas) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceWorld targetWorld : Ixon.Owned} + {sourceCid targetCid : IxIR1.CtorId} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + {schema : CtorSchema} {values : List IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (control : machine.control = .running frame stack) + (schemaAt : context.schemas sourceWorld sourceCid = some schema) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next) + sourceStore source frameRoots) : + let node := IxIR1.Node.ctorN sourceCid values.toArray + let sourceAllocation := sourceStore.allocNode sourceWorld node + let targetAllocation := machine.store.allocNode sourceWorld node + let nextFrame : Eval.Frame := + { frame with + pc := frame.pc + 1 + values := frame.values.push (.loc sourceAllocation.2) } + IxIR1.runOp sourceContext (sourceFuel + 1) functionTrace.source sourceStore + source (.alloc sourceWorld sourceCid sourceArguments) = + .ok (sourceAllocation.1, .loc sourceAllocation.2) ∧ + Eval.Step context interpretation machine + { machine with + store := targetAllocation.1 + control := .running nextFrame stack } ∧ + Lower.Sim.StoreRel sourceAllocation.1 targetAllocation.1 ∧ + attached.sidecars.TraceStateRel functionTrace next sourceAllocation.1 + (.loc sourceAllocation.2 :: source) nextFrame := by + dsimp only + obtain ⟨sourceRun, targetStep, nextStores, nextTarget⟩ := + Lower.Sim.simulate_traced_alloc_checked_state + (sourceContext := sourceContext) + (sourceCurrent := functionTrace.source) (sourceFuel := sourceFuel) + (interpretation := interpretation) + (checked := attached.target) functionMember contextSchemas descendant + state.target stores sourceResolved control schemaAt ownership + have nextState := attached.traceState_next_of_member functionMember state + descendant sourceDeclarations sourceRun nextTarget + exact ⟨sourceRun, targetStep, nextStores, nextState⟩ + +/-- Successful-source-run form of attached checked allocation. Source +evaluation determines the exact field vector and fresh location; the result +contains the smaller-fuel continuation and combined recursive state. -/ +theorem CompiledAttachment.simulate_traced_alloc_checked_success_step + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {machine : Eval.Machine} + {frame : Eval.Frame} {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + (contextSchemas : context.schemas = + attached.target.artifact.validationContext.schemas) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceWorld targetWorld : Ixon.Owned} + {sourceCid targetCid : IxIR1.CtorId} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + {sourceOutput : IxIR1.Store × IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceRun : IxIR1.runCode sourceContext (sourceFuel + 2) + functionTrace.source sourceStore source + (.letOp (.alloc sourceWorld sourceCid sourceArguments) + next.sourceCode) = .ok sourceOutput) + (control : machine.control = .running frame stack) + {schema : CtorSchema} + (schemaAt : context.schemas sourceWorld sourceCid = some schema) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next) + sourceStore source frameRoots) : + ∃ values sourceAllocation targetAllocation nextFrame, + sourceAllocation = sourceStore.allocNode sourceWorld + (.ctorN sourceCid values.toArray) ∧ + targetAllocation = machine.store.allocNode sourceWorld + (.ctorN sourceCid values.toArray) ∧ + IxIR1.resolveAtoms source sourceArguments = .ok values ∧ + IxIR1.runCode sourceContext (sourceFuel + 1) functionTrace.source + sourceAllocation.1 (.loc sourceAllocation.2 :: source) + next.sourceCode = .ok sourceOutput ∧ + nextFrame = + { frame with + pc := frame.pc + 1 + values := frame.values.push (.loc sourceAllocation.2) } ∧ + Eval.Step context .logical machine + { machine with + store := targetAllocation.1 + control := .running nextFrame stack } ∧ + Lower.Sim.StoreRel sourceAllocation.1 targetAllocation.1 ∧ + attached.sidecars.TraceStateRel functionTrace next sourceAllocation.1 + (.loc sourceAllocation.2 :: source) nextFrame := by + obtain ⟨middleStore, operationValue, operationRun, continuationRun⟩ := + IxIR1.runCode_letOp_success sourceRun + obtain ⟨values, sourceResolved, operationOutput⟩ := + IxIR1.runOp_alloc_success operationRun + have middleStoreEq : middleStore = + (sourceStore.allocNode sourceWorld + (.ctorN sourceCid values.toArray)).1 := + congrArg Prod.fst operationOutput + have operationValueEq : operationValue = + .loc (sourceStore.allocNode sourceWorld + (.ctorN sourceCid values.toArray)).2 := + congrArg Prod.snd operationOutput + subst middleStore + subst operationValue + obtain ⟨_, targetStep, nextStores, nextState⟩ := + attached.simulate_traced_alloc_checked_state + (sourceFuel := sourceFuel) functionMember contextSchemas descendant state + stores sourceDeclarations sourceResolved control schemaAt ownership + exact ⟨values, + sourceStore.allocNode sourceWorld (.ctorN sourceCid values.toArray), + machine.store.allocNode sourceWorld (.ctorN sourceCid values.toArray), + { frame with + pc := frame.pc + 1 + values := frame.values.push + (.loc (sourceStore.allocNode sourceWorld + (.ctorN sourceCid values.toArray)).2) }, + rfl, rfl, sourceResolved, continuationRun, rfl, targetStep, nextStores, + nextState⟩ + +/-- Scalar `dup`/`retainShared` advances the combined attachment state without +changing either heap. -/ +theorem CompiledAttachment.simulate_traced_dup_retain_scalar_state + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.dup sourceAtom) index (.retainShared targetAtom) next)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {value : IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.dup sourceAtom) index (.retainShared targetAtom) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceResolved : IxIR1.resolveAtom source sourceAtom = .ok value) + (scalar : Eval.RVal.isScalar value = true) + (control : machine.control = .running frame stack) : + let nextFrame : Eval.Frame := + { frame with + pc := frame.pc + 1 + values := frame.values.push value } + IxIR1.runOp sourceContext (sourceFuel + 1) functionTrace.source sourceStore + source (.dup sourceAtom) = .ok (sourceStore, value) ∧ + Eval.Step context interpretation machine + { machine with control := .running nextFrame stack } ∧ + Lower.Sim.StoreRel sourceStore machine.store ∧ + attached.sidecars.TraceStateRel functionTrace next sourceStore + (value :: source) nextFrame := by + dsimp only + obtain ⟨sourceRun, targetStep, nextStores, nextTarget⟩ := + Lower.Sim.simulate_traced_dup_retain_scalar_state + (sourceContext := sourceContext) + (sourceCurrent := functionTrace.source) (sourceFuel := sourceFuel) + descendant state.target stores sourceResolved scalar control + have nextState := attached.traceState_next_of_member functionMember state + descendant sourceDeclarations sourceRun nextTarget + exact ⟨sourceRun, targetStep, nextStores, nextState⟩ + +/-- Heap-bearing shared `dup`/`retainShared` advances the combined attachment +state through the matched reference-count update. -/ +theorem CompiledAttachment.simulate_traced_dup_retain_shared_state + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.dup sourceAtom) index (.retainShared targetAtom) next)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {location : Nat} {box : IxIR1.NodeBox} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.dup sourceAtom) index (.retainShared targetAtom) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceResolved : + IxIR1.resolveAtom source sourceAtom = .ok (.loc location)) + (sourceGet : sourceStore.get? location = some box) + (shared : box.world = .shared) + (control : machine.control = .running frame stack) : + let nextBox := { box with rc := box.rc + 1 } + let sourceStore' := (sourceStore.setBox location nextBox).rcTick + let targetStore' := (machine.store.setBox location nextBox).rcTick + let nextFrame : Eval.Frame := + { frame with + pc := frame.pc + 1 + values := frame.values.push (.loc location) } + IxIR1.runOp sourceContext (sourceFuel + 1) functionTrace.source sourceStore + source (.dup sourceAtom) = .ok (sourceStore', .loc location) ∧ + Eval.Step context interpretation machine + { machine with + store := targetStore' + control := .running nextFrame stack } ∧ + Lower.Sim.StoreRel sourceStore' targetStore' ∧ + attached.sidecars.TraceStateRel functionTrace next sourceStore' + (.loc location :: source) nextFrame := by + dsimp only + obtain ⟨sourceRun, targetStep, nextStores, nextTarget⟩ := + Lower.Sim.simulate_traced_dup_retain_shared_state + (sourceContext := sourceContext) + (sourceCurrent := functionTrace.source) (sourceFuel := sourceFuel) + descendant state.target stores sourceResolved sourceGet shared control + have nextState := attached.traceState_next_of_member functionMember state + descendant sourceDeclarations sourceRun nextTarget + exact ⟨sourceRun, targetStep, nextStores, nextState⟩ + +/-- Scalar shared release advances the combined state while consuming one +unit of target heap work and leaving both heaps unchanged. -/ +theorem CompiledAttachment.simulate_traced_drop_release_scalar_state + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel targetHeapFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.drop sourceAtom) index (.releaseShared targetAtom) next)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {value : IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.drop sourceAtom) index (.releaseShared targetAtom) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceResolved : IxIR1.resolveAtom source sourceAtom = .ok value) + (scalar : Eval.RVal.isScalar value = true) + (heapFuel : machine.heapFuel = targetHeapFuel + 1) + (control : machine.control = .running frame stack) : + let nextFrame : Eval.Frame := { frame with pc := frame.pc + 1 } + IxIR1.runOp sourceContext (sourceFuel + 1) functionTrace.source sourceStore + source (.drop sourceAtom) = .ok (sourceStore, .erased) ∧ + Eval.Step context interpretation machine + { store := machine.store + heapFuel := targetHeapFuel + control := .running nextFrame stack } ∧ + Lower.Sim.StoreRel sourceStore machine.store ∧ + attached.sidecars.TraceStateRel functionTrace next sourceStore + (.erased :: source) nextFrame := by + dsimp only + obtain ⟨sourceRun, targetStep, nextStores, nextTarget⟩ := + Lower.Sim.simulate_traced_drop_release_scalar_state + (sourceContext := sourceContext) + (sourceCurrent := functionTrace.source) (sourceFuel := sourceFuel) + descendant state.target stores sourceResolved scalar heapFuel control + have nextState := attached.traceState_next_of_member functionMember state + descendant sourceDeclarations sourceRun nextTarget + exact ⟨sourceRun, targetStep, nextStores, nextState⟩ + +/-- Scalar unique drop advances the combined state while consuming one unit +of target heap work and leaving both heaps unchanged. -/ +theorem CompiledAttachment.simulate_traced_dropU_dropUnique_scalar_state + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel targetHeapFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.dropU sourceAtom) index (.dropUnique targetAtom) next)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {value : IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.dropU sourceAtom) index (.dropUnique targetAtom) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceResolved : IxIR1.resolveAtom source sourceAtom = .ok value) + (scalar : Eval.RVal.isScalar value = true) + (heapFuel : machine.heapFuel = targetHeapFuel + 1) + (control : machine.control = .running frame stack) : + let nextFrame : Eval.Frame := { frame with pc := frame.pc + 1 } + IxIR1.runOp sourceContext (sourceFuel + 1) functionTrace.source sourceStore + source (.dropU sourceAtom) = .ok (sourceStore, .erased) ∧ + Eval.Step context interpretation machine + { store := machine.store + heapFuel := targetHeapFuel + control := .running nextFrame stack } ∧ + Lower.Sim.StoreRel sourceStore machine.store ∧ + attached.sidecars.TraceStateRel functionTrace next sourceStore + (.erased :: source) nextFrame := by + dsimp only + obtain ⟨sourceRun, targetStep, nextStores, nextTarget⟩ := + Lower.Sim.simulate_traced_dropU_dropUnique_scalar_state + (sourceContext := sourceContext) + (sourceCurrent := functionTrace.source) (sourceFuel := sourceFuel) + descendant state.target stores sourceResolved scalar heapFuel control + have nextState := attached.traceState_next_of_member functionMember state + descendant sourceDeclarations sourceRun nextTarget + exact ⟨sourceRun, targetStep, nextStores, nextState⟩ + +/-- Recursive unique destruction selects a sufficient target heap budget and +advances the combined attachment state to the exact post-drop heap. -/ +theorem CompiledAttachment.simulate_traced_dropU_dropUnique_recursive_state + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.dropU sourceAtom) index (.dropUnique targetAtom) next)) + {sourceStore sourceStore' : IxIR1.Store} + {source : List IxIR1.RVal} {location : Nat} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.dropU sourceAtom) index (.dropUnique targetAtom) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceResolved : + IxIR1.resolveAtom source sourceAtom = .ok (.loc location)) + (sourceDropped : + IxIR1.dropUVal sourceContext sourceFuel sourceStore (.loc location) = + .ok sourceStore') + (control : machine.control = .running frame stack) : + ∃ targetHeapFuel targetStore, + let nextFrame : Eval.Frame := { frame with pc := frame.pc + 1 } + IxIR1.runOp sourceContext (sourceFuel + 1) functionTrace.source + sourceStore source (.dropU sourceAtom) = + .ok (sourceStore', .erased) ∧ + Eval.Step context interpretation + { machine with heapFuel := targetHeapFuel } + { store := targetStore + heapFuel := 0 + control := .running nextFrame stack } ∧ + Lower.Sim.StoreRel sourceStore' targetStore ∧ + attached.sidecars.TraceStateRel functionTrace next sourceStore' + (.erased :: source) nextFrame := by + obtain ⟨targetHeapFuel, targetStore, sourceRun, targetStep, nextStores, + nextTarget⟩ := + Lower.Sim.simulate_traced_dropU_dropUnique_recursive_state + (sourceCurrent := functionTrace.source) descendant state.target stores + sourceResolved sourceDropped control + refine ⟨targetHeapFuel, targetStore, ?_⟩ + dsimp only + have nextState := attached.traceState_next_of_member functionMember state + descendant sourceDeclarations sourceRun nextTarget + exact ⟨sourceRun, targetStep, nextStores, nextState⟩ + +/-- Framed recursive unique destruction. Its locally sufficient traversal +budget can be prefixed to any independently funded continuation. -/ +theorem CompiledAttachment.simulate_traced_dropU_dropUnique_recursive_state_framed + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.dropU sourceAtom) index (.dropUnique targetAtom) next)) + {sourceStore sourceStore' : IxIR1.Store} + {source : List IxIR1.RVal} {location : Nat} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.dropU sourceAtom) index (.dropUnique targetAtom) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceResolved : + IxIR1.resolveAtom source sourceAtom = .ok (.loc location)) + (sourceDropped : + IxIR1.dropUVal sourceContext sourceFuel sourceStore (.loc location) = + .ok sourceStore') + (control : machine.control = .running frame stack) : + ∃ localFuel targetStore, + let nextFrame : Eval.Frame := { frame with pc := frame.pc + 1 } + IxIR1.runOp sourceContext (sourceFuel + 1) functionTrace.source + sourceStore source (.dropU sourceAtom) = + .ok (sourceStore', .erased) ∧ + Eval.dropUnique localFuel machine.store (.loc location) = + .ok (targetStore, 0) ∧ + (∀ suffixFuel, + Eval.Step context interpretation + { machine with heapFuel := localFuel + suffixFuel } + { store := targetStore + heapFuel := suffixFuel + control := .running nextFrame stack }) ∧ + Lower.Sim.StoreRel sourceStore' targetStore ∧ + attached.sidecars.TraceStateRel functionTrace next sourceStore' + (.erased :: source) nextFrame := by + have translated : Lower.Sim.translateAtom input sourceAtom = + some targetAtom := by + simpa [Lower.OperationSyntax] using + functionTrace.descendantOperationSyntax descendant + obtain ⟨blockAt, pcBound, instructionAt⟩ := + state.target.instructionAt descendant + have instruction : + next.headBlock.2.instructions[frame.pc] = .dropUnique targetAtom := + (Array.getElem?_eq_some_iff.mp instructionAt).2 + have targetResolved : + Eval.resolveAtom frame.values targetAtom = .ok (.loc location) := + Lower.Sim.resolveAtom_of_envRel state.target.environments translated + sourceResolved + obtain ⟨localFuel, targetStore, targetRun, nextStores⟩ := + Lower.Sim.dropUVal_simulates_dropUniqueWork stores sourceDropped + have exactDrop : + Eval.dropUnique localFuel machine.store (.loc location) = + .ok (targetStore, 0) := by + simpa [Eval.dropUnique] using targetRun + have targetStep : ∀ suffixFuel, + Eval.Step context interpretation + { machine with heapFuel := localFuel + suffixFuel } + { store := targetStore + heapFuel := suffixFuel + control := .running { frame with pc := frame.pc + 1 } stack } := by + intro suffixFuel + have framedDrop : + Eval.dropUnique (localFuel + suffixFuel) machine.store + (.loc location) = .ok (targetStore, suffixFuel) := + Lower.Sim.dropUnique_add_suffix exactDrop + have beforeControl : + ({ machine with heapFuel := localFuel + suffixFuel } : + Eval.Machine).control = .running frame stack := by + simpa using control + exact Eval.Step.dropUnique (context := context) + (interpretation := interpretation) beforeControl blockAt pcBound + instruction targetResolved framedDrop + have sourceRun : + IxIR1.runOp sourceContext (sourceFuel + 1) functionTrace.source + sourceStore source (.dropU sourceAtom) = + .ok (sourceStore', .erased) := by + unfold IxIR1.runOp + simp only + rw [sourceResolved] + simp only [bind, Except.bind] + rw [sourceDropped] + have canonical := state.target.environments.bindErased + have nextEnvironments := canonical.forgetTracedErased descendant + (show Lower.Instr.baselineBinderAtom entryValueCount + (.dropUnique targetAtom) = some .erased by rfl) + have nextTarget : Lower.Sim.CodeStateRel functionTrace next + (.erased :: source) { frame with pc := frame.pc + 1 } := by + refine state.target.letOpNext descendant rfl rfl rfl ?_ rfl + nextEnvironments + simp [Lower.Instr.baselineValueDelta] + have nextState := attached.traceState_next_of_member functionMember state + descendant sourceDeclarations sourceRun nextTarget + exact ⟨localFuel, targetStore, sourceRun, exactDrop, targetStep, nextStores, + nextState⟩ + +/-- Recursive shared destruction selects a sufficient target heap budget, +preserves positive shared reference counts, and advances the combined state. -/ +theorem CompiledAttachment.simulate_traced_drop_release_recursive_state + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.drop sourceAtom) index (.releaseShared targetAtom) next)) + {sourceStore sourceStore' : IxIR1.Store} + {source : List IxIR1.RVal} {location : Nat} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.drop sourceAtom) index (.releaseShared targetAtom) next) + sourceStore source frame) + (positive : Lower.Sim.PositiveSharedRC sourceStore) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceResolved : + IxIR1.resolveAtom source sourceAtom = .ok (.loc location)) + (sourceDropped : + IxIR1.dropVal sourceContext sourceFuel sourceStore (.loc location) = + .ok sourceStore') + (control : machine.control = .running frame stack) : + ∃ targetHeapFuel targetStore, + let nextFrame : Eval.Frame := { frame with pc := frame.pc + 1 } + IxIR1.runOp sourceContext (sourceFuel + 1) functionTrace.source + sourceStore source (.drop sourceAtom) = + .ok (sourceStore', .erased) ∧ + Eval.Step context interpretation + { machine with heapFuel := targetHeapFuel } + { store := targetStore + heapFuel := 0 + control := .running nextFrame stack } ∧ + Lower.Sim.StoreRel sourceStore' targetStore ∧ + Lower.Sim.PositiveSharedRC sourceStore' ∧ + attached.sidecars.TraceStateRel functionTrace next sourceStore' + (.erased :: source) nextFrame := by + obtain ⟨targetHeapFuel, targetStore, sourceRun, targetStep, nextStores, + nextPositive, nextTarget⟩ := + Lower.Sim.simulate_traced_drop_release_recursive_state + (sourceCurrent := functionTrace.source) descendant state.target positive + stores sourceResolved sourceDropped control + refine ⟨targetHeapFuel, targetStore, ?_⟩ + dsimp only + have nextState := attached.traceState_next_of_member functionMember state + descendant sourceDeclarations sourceRun nextTarget + exact ⟨sourceRun, targetStep, nextStores, nextPositive, nextState⟩ + +/-- Framed recursive shared destruction. The local traversal budget is +selected from the successful source drop, while an arbitrary continuation +budget passes through the target work list unchanged. -/ +theorem CompiledAttachment.simulate_traced_drop_release_recursive_state_framed + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.drop sourceAtom) index (.releaseShared targetAtom) next)) + {sourceStore sourceStore' : IxIR1.Store} + {source : List IxIR1.RVal} {location : Nat} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.drop sourceAtom) index (.releaseShared targetAtom) next) + sourceStore source frame) + (positive : Lower.Sim.PositiveSharedRC sourceStore) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceResolved : + IxIR1.resolveAtom source sourceAtom = .ok (.loc location)) + (sourceDropped : + IxIR1.dropVal sourceContext sourceFuel sourceStore (.loc location) = + .ok sourceStore') + (control : machine.control = .running frame stack) : + ∃ localFuel targetStore, + let nextFrame : Eval.Frame := { frame with pc := frame.pc + 1 } + IxIR1.runOp sourceContext (sourceFuel + 1) functionTrace.source + sourceStore source (.drop sourceAtom) = + .ok (sourceStore', .erased) ∧ + Eval.releaseShared localFuel machine.store (.loc location) = + .ok (targetStore, 0) ∧ + (∀ suffixFuel, + Eval.Step context interpretation + { machine with heapFuel := localFuel + suffixFuel } + { store := targetStore + heapFuel := suffixFuel + control := .running nextFrame stack }) ∧ + Lower.Sim.StoreRel sourceStore' targetStore ∧ + Lower.Sim.PositiveSharedRC sourceStore' ∧ + attached.sidecars.TraceStateRel functionTrace next sourceStore' + (.erased :: source) nextFrame := by + have translated : Lower.Sim.translateAtom input sourceAtom = + some targetAtom := by + simpa [Lower.OperationSyntax] using + functionTrace.descendantOperationSyntax descendant + obtain ⟨blockAt, pcBound, instructionAt⟩ := + state.target.instructionAt descendant + have instruction : + next.headBlock.2.instructions[frame.pc] = + .releaseShared targetAtom := + (Array.getElem?_eq_some_iff.mp instructionAt).2 + have targetResolved : + Eval.resolveAtom frame.values targetAtom = .ok (.loc location) := + Lower.Sim.resolveAtom_of_envRel state.target.environments translated + sourceResolved + obtain ⟨localFuel, targetStore, targetRun, nextStores, nextPositive⟩ := + Lower.Sim.dropVal_simulates_releaseSharedWork positive stores sourceDropped + have exactRelease : + Eval.releaseShared localFuel machine.store (.loc location) = + .ok (targetStore, 0) := by + simpa [Eval.releaseShared] using targetRun + have targetStep : ∀ suffixFuel, + Eval.Step context interpretation + { machine with heapFuel := localFuel + suffixFuel } + { store := targetStore + heapFuel := suffixFuel + control := .running { frame with pc := frame.pc + 1 } stack } := by + intro suffixFuel + have framedRelease : + Eval.releaseShared (localFuel + suffixFuel) machine.store + (.loc location) = .ok (targetStore, suffixFuel) := + Lower.Sim.releaseShared_add_suffix exactRelease + have beforeControl : + ({ machine with heapFuel := localFuel + suffixFuel } : + Eval.Machine).control = .running frame stack := by + simpa using control + exact Eval.Step.releaseShared (context := context) + (interpretation := interpretation) beforeControl blockAt pcBound + instruction targetResolved framedRelease + have sourceRun : + IxIR1.runOp sourceContext (sourceFuel + 1) functionTrace.source + sourceStore source (.drop sourceAtom) = + .ok (sourceStore', .erased) := by + unfold IxIR1.runOp + simp only + rw [sourceResolved] + simp only [bind, Except.bind] + rw [sourceDropped] + have canonical := state.target.environments.bindErased + have nextEnvironments := canonical.forgetTracedErased descendant + (show Lower.Instr.baselineBinderAtom entryValueCount + (.releaseShared targetAtom) = some .erased by rfl) + have nextTarget : Lower.Sim.CodeStateRel functionTrace next + (.erased :: source) { frame with pc := frame.pc + 1 } := by + refine state.target.letOpNext descendant rfl rfl rfl ?_ rfl + nextEnvironments + simp [Lower.Instr.baselineValueDelta] + have nextState := attached.traceState_next_of_member functionMember state + descendant sourceDeclarations sourceRun nextTarget + exact ⟨localFuel, targetStore, sourceRun, exactRelease, targetStep, nextStores, + nextPositive, nextState⟩ + +/-- A strictly under-saturated function partial application allocates the +matched PAP node and advances the attachment's combined recursive state. -/ +theorem CompiledAttachment.simulate_traced_papp_fn_state + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {targetDefinition : Function} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {sourceDefinition : IxIR1.FnDef} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAddress targetAddress : Ixon.Address} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.papp sourceAddress sourceArguments) index + (.papp targetAddress targetArguments) next)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {values : List IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.papp sourceAddress sourceArguments) index + (.papp targetAddress targetArguments) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (sourceDeclaration : + sourceContext.decls sourceAddress = some (.fn sourceDefinition)) + (targetDeclaration : + context.declarations sourceAddress = some (.fn targetDefinition)) + (arity : + targetDefinition.signature.params.size = sourceDefinition.arity) + (papSafe : targetDefinition.signature.papSafe = true) + (under : values.length < sourceDefinition.arity) + (noCredits : frame.credits = #[]) + (control : machine.control = .running frame stack) : + let node := IxIR1.Node.papN sourceAddress sourceDefinition.arity + values.toArray + let sourceAllocation := sourceStore.allocNode .shared node + let targetAllocation := machine.store.allocNode .shared node + let nextFrame : Eval.Frame := + { frame with + pc := frame.pc + 1 + values := frame.values.push (.loc sourceAllocation.2) } + IxIR1.runOp sourceContext (sourceFuel + 1) functionTrace.source sourceStore + source (.papp sourceAddress sourceArguments) = + .ok (sourceAllocation.1, .loc sourceAllocation.2) ∧ + Eval.Step context interpretation machine + { machine with + store := targetAllocation.1 + control := .running nextFrame stack } ∧ + Lower.Sim.StoreRel sourceAllocation.1 targetAllocation.1 ∧ + attached.sidecars.TraceStateRel functionTrace next sourceAllocation.1 + (.loc sourceAllocation.2 :: source) nextFrame := by + dsimp only + obtain ⟨sourceRun, targetStep, nextStores, nextTarget⟩ := + Lower.Sim.simulate_traced_papp_fn_state + (sourceCurrent := functionTrace.source) descendant state.target stores + sourceResolved sourceDeclaration targetDeclaration arity papSafe under + noCredits control + have nextState := attached.traceState_next_of_member functionMember state + descendant sourceDeclarations sourceRun nextTarget + exact ⟨sourceRun, targetStep, nextStores, nextState⟩ + +/-! ## Combined dynamic-application transitions -/ + +/-- Any successful dynamic-application transfer advances the attachment's +combined caller continuation. The target dispatcher supplies the emitted +step and its future caller `CodeStateRel`; the completed source operation +advances the exact HPT coordinate and environment. -/ +theorem CompiledAttachment.simulate_traced_apply_transfer_state + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine target : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceFunction : IxIR1.Atom} {targetFunction : Atom} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next)) + {sourceStore outputStore : IxIR1.Store} + {source : List IxIR1.RVal} {function : IxIR1.RVal} + {values : List IxIR1.RVal} {value : IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + sourceStore source frame) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceFunctionResolved : + IxIR1.resolveAtom source sourceFunction = .ok function) + (sourceArgumentsResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (sourceRun : IxIR1.runOp sourceContext sourceFuel functionTrace.source + sourceStore source (.apply sourceFunction sourceArguments) = + .ok (outputStore, value)) + (noCredits : frame.credits = #[]) + (control : machine.control = .running frame stack) + (transferred : Eval.ApplyTransfer context interpretation machine.store + machine.heapFuel function values.toArray + { frame with pc := frame.pc + 1 } stack target) : + Eval.Step context interpretation machine target ∧ + attached.sidecars.TraceStateRel functionTrace next outputStore + (value :: source) + { frame with + pc := frame.pc + 1 + values := frame.values.push value } := by + obtain ⟨targetStep, nextTargets⟩ := + Lower.Sim.simulate_traced_apply_transfer_state descendant state.target + sourceFunctionResolved sourceArgumentsResolved noCredits control + transferred + have nextState := attached.traceState_next_of_member functionMember state + descendant sourceDeclarations sourceRun (nextTargets value) + exact ⟨targetStep, nextState⟩ + +/-- Applying an erased function releases the resolved residual arguments and +advances the emitted `apply` instruction directly to the combined caller +continuation with an erased result. -/ +theorem CompiledAttachment.simulate_traced_apply_erased_state + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceFunction : IxIR1.Atom} {targetFunction : Atom} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next)) + {sourceStore sourceReleased : IxIR1.Store} + {source : List IxIR1.RVal} {values : List IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (positive : Lower.Sim.PositiveSharedRC sourceStore) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (functionResolved : + IxIR1.resolveAtom source sourceFunction = .ok .erased) + (argumentsResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (sourceRelease : IxIR1.dropMany sourceContext sourceFuel sourceStore + values = .ok sourceReleased) + (noCredits : frame.credits = #[]) + (control : machine.control = .running frame stack) : + ∃ (targetHeapFuel : Nat) (targetReleased : Eval.Store), + IxIR1.runOp sourceContext (sourceFuel + 2) functionTrace.source + sourceStore source (.apply sourceFunction sourceArguments) = + .ok (sourceReleased, .erased) ∧ + Eval.Step context interpretation + { machine with heapFuel := targetHeapFuel } + { store := targetReleased + heapFuel := 0 + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values.push .erased } stack } ∧ + Lower.Sim.StoreRel sourceReleased targetReleased ∧ + Lower.Sim.PositiveSharedRC sourceReleased ∧ + attached.sidecars.TraceStateRel functionTrace next sourceReleased + (.erased :: source) + { frame with + pc := frame.pc + 1 + values := frame.values.push .erased } := by + obtain ⟨targetHeapFuel, targetReleased, sourceApply, transferred, + nextStores, nextPositive⟩ := + Lower.Sim.simulate_applyGo_erased + (resume := { frame with pc := frame.pc + 1 }) (stack := stack) + positive stores sourceRelease + have sourceRun : + IxIR1.runOp sourceContext (sourceFuel + 2) functionTrace.source + sourceStore source (.apply sourceFunction sourceArguments) = + .ok (sourceReleased, .erased) := by + rw [IxIR1.runOp.eq_def] + dsimp only + rw [functionResolved] + simp only [bind, Except.bind] + rw [argumentsResolved] + exact sourceApply + have beforeControl : + ({ machine with heapFuel := targetHeapFuel } : Eval.Machine).control = + .running frame stack := by + simpa using control + obtain ⟨targetStep, nextState⟩ := + attached.simulate_traced_apply_transfer_state functionMember descendant + state sourceDeclarations functionResolved argumentsResolved sourceRun + noCredits beforeControl transferred + exact ⟨targetHeapFuel, targetReleased, sourceRun, targetStep, nextStores, + nextPositive, nextState⟩ + +/-- Under-saturating a shared PAP completes in the dispatcher itself and +therefore advances directly to the caller's combined continuation state. -/ +theorem CompiledAttachment.simulate_traced_apply_pap_under_state + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceFunction : IxIR1.Atom} {targetFunction : Atom} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next)) + {sourceStore sourceRetained sourceReleased : IxIR1.Store} + {source : List IxIR1.RVal} {location : Nat} {box : IxIR1.NodeBox} + {address : Ixon.Address} {arity : Nat} + {captured : Array IxIR1.RVal} {values : List IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (positive : Lower.Sim.PositiveSharedRC sourceStore) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (functionResolved : + IxIR1.resolveAtom source sourceFunction = .ok (.loc location)) + (argumentsResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (sourceGet : sourceStore.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (sourceRetain : + IxIR1.dupVals sourceStore captured.toList = .ok sourceRetained) + (sourceRelease : IxIR1.dropVal sourceContext sourceFuel sourceRetained + (.loc location) = .ok sourceReleased) + (totalUnder : (captured.toList ++ values).length < arity) + (noCredits : frame.credits = #[]) + (control : machine.control = .running frame stack) : + let pap := IxIR1.Node.papN address arity (captured ++ values.toArray) + let sourceAllocation := sourceReleased.allocNode .shared pap + ∃ (targetRetained targetReleased : Eval.Store) (targetHeapFuel : Nat), + Eval.RetainSharedMany machine.store captured targetRetained ∧ + Lower.Sim.StoreRel sourceRetained targetRetained ∧ + Eval.releaseSharedWork targetHeapFuel targetRetained [.loc location] = + .ok (targetReleased, 0) ∧ + Lower.Sim.StoreRel sourceReleased targetReleased ∧ + let targetAllocation := targetReleased.allocNode .shared pap + IxIR1.runOp sourceContext (sourceFuel + 2) functionTrace.source + sourceStore source (.apply sourceFunction sourceArguments) = + .ok (sourceAllocation.1, .loc sourceAllocation.2) ∧ + Eval.Step context interpretation + { machine with heapFuel := targetHeapFuel } + { store := targetAllocation.1 + heapFuel := 0 + control := .running + { frame with + pc := frame.pc + 1 + values := frame.values.push (.loc sourceAllocation.2) } + stack } ∧ + Lower.Sim.StoreRel sourceAllocation.1 targetAllocation.1 ∧ + attached.sidecars.TraceStateRel functionTrace next + sourceAllocation.1 (.loc sourceAllocation.2 :: source) + { frame with + pc := frame.pc + 1 + values := frame.values.push (.loc sourceAllocation.2) } := by + dsimp only + obtain ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + retainedStores, targetRelease, releasedStores, sourceRun, transferred, + nextStores⟩ := + Lower.Sim.simulate_apply_pap_under + (sourceCurrent := functionTrace.source) + (resume := { frame with pc := frame.pc + 1 }) + (stack := stack) stores positive functionResolved argumentsResolved + sourceGet shared node capturedUnder sourceRetain sourceRelease + totalUnder + have beforeControl : + ({ machine with heapFuel := targetHeapFuel } : Eval.Machine).control = + .running frame stack := by + simpa using control + obtain ⟨targetStep, nextState⟩ := + attached.simulate_traced_apply_transfer_state functionMember descendant + state sourceDeclarations functionResolved argumentsResolved sourceRun + noCredits beforeControl transferred + exact ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + retainedStores, targetRelease, releasedStores, sourceRun, targetStep, + nextStores, nextState⟩ + +/-- Exact PAP saturation enters the retained callee in the combined state. +The suspended caller continuation is returned as a builder indexed by the +eventual successful source application, which is precisely the recursive +callee-result handoff needed by the whole-code induction. -/ +theorem CompiledAttachment.simulate_traced_apply_pap_saturated_enter_state + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {callerTrace calleeTrace : Lower.FunctionTrace} + (callerMember : callerTrace ∈ attached.target.artifact.trace.functions) + (calleeMember : calleeTrace ∈ attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceFunction : IxIR1.Atom} {targetFunction : Atom} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : callerTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next)) + {sourceDefinition : IxIR1.FnDef} {targetDefinition : Function} + {sourceStore sourceRetained sourceReleased : IxIR1.Store} + {source : List IxIR1.RVal} {location : Nat} {box : IxIR1.NodeBox} + {address : Ixon.Address} {arity : Nat} + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration address) sourceDefinition targetDefinition) + {captured : Array IxIR1.RVal} {values : List IxIR1.RVal} + (state : attached.sidecars.TraceStateRel callerTrace + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (positive : Lower.Sim.PositiveSharedRC sourceStore) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (functionResolved : + IxIR1.resolveAtom source sourceFunction = .ok (.loc location)) + (argumentsResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (sourceGet : sourceStore.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (sourceRetain : + IxIR1.dupVals sourceStore captured.toList = .ok sourceRetained) + (sourceRelease : IxIR1.dropVal sourceContext sourceFuel sourceRetained + (.loc location) = .ok sourceReleased) + (totalExact : (captured.toList ++ values).length = arity) + (papArity : arity = sourceDefinition.arity) + (sourceDeclaration : + sourceContext.decls address = some (.fn sourceDefinition)) + (sourcePapSafe : sourceDefinition.papSafe = true) + (targetDeclaration : + context.declarations address = some (.fn targetDefinition)) + (noCredits : frame.credits = #[]) + (control : machine.control = .running frame stack) : + let sourceTotal := captured.toList ++ values + let targetTotal := captured ++ values.toArray + let resume : Eval.Frame := { frame with pc := frame.pc + 1 } + let calleeFrame : Eval.Frame := + { definition := targetDefinition, values := targetTotal } + let targetMachine : Eval.Machine := + { store := machine.store + heapFuel := 0 + control := .running calleeFrame (.resume resume :: stack) } + ∃ (targetRetained targetReleased : Eval.Store) (targetHeapFuel : Nat), + Eval.RetainSharedMany machine.store captured targetRetained ∧ + Lower.Sim.StoreRel sourceRetained targetRetained ∧ + Eval.releaseSharedWork targetHeapFuel targetRetained [.loc location] = + .ok (targetReleased, 0) ∧ + Lower.Sim.StoreRel sourceReleased targetReleased ∧ + IxIR1.runOp sourceContext (sourceFuel + 2) callerTrace.source + sourceStore source (.apply sourceFunction sourceArguments) = + IxIR1.invoke sourceContext sourceFuel address sourceTotal + sourceReleased ∧ + Eval.Step context interpretation + { machine with heapFuel := targetHeapFuel } + { targetMachine with store := targetReleased } ∧ + attached.sidecars.TraceStateRel calleeTrace calleeTrace.root + sourceReleased sourceTotal.reverse calleeFrame ∧ + ∀ (outputStore : IxIR1.Store) (value : IxIR1.RVal), + IxIR1.runOp sourceContext (sourceFuel + 2) callerTrace.source + sourceStore source (.apply sourceFunction sourceArguments) = + .ok (outputStore, value) → + attached.sidecars.TraceStateRel callerTrace next outputStore + (value :: source) + { frame with + pc := frame.pc + 1 + values := frame.values.push value } := by + dsimp only + obtain ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + retainedStores, targetRelease, releasedStores, sourceEquation, + targetStep, _, callerTargets⟩ := + Lower.Sim.simulate_traced_apply_pap_saturated_enter_state + (sourceCurrent := callerTrace.source) descendant calleeMatch state.target + stores positive functionResolved argumentsResolved sourceGet shared node + capturedUnder sourceRetain sourceRelease totalExact papArity + sourceDeclaration sourcePapSafe targetDeclaration noCredits control + have entryArity : + (captured ++ values.toArray).size = calleeTrace.source.arity := by + calc + (captured ++ values.toArray).size = + (captured.toList ++ values).length := by simp + _ = arity := totalExact + _ = sourceDefinition.arity := papArity + _ = calleeTrace.source.arity := by rw [calleeMatch.source] + have calleeState := attached.functionEntryTraceState + (sourceStore := sourceReleased) calleeMember + (captured ++ values.toArray) entryArity + have combinedCallee : attached.sidecars.TraceStateRel calleeTrace + calleeTrace.root sourceReleased (captured.toList ++ values).reverse + { definition := targetDefinition + values := captured ++ values.toArray } := by + simpa [calleeMatch.generated] using calleeState + have callerContinuation : + ∀ (outputStore : IxIR1.Store) (value : IxIR1.RVal), + IxIR1.runOp sourceContext (sourceFuel + 2) callerTrace.source + sourceStore source (.apply sourceFunction sourceArguments) = + .ok (outputStore, value) → + attached.sidecars.TraceStateRel callerTrace next outputStore + (value :: source) + { frame with + pc := frame.pc + 1 + values := frame.values.push value } := by + intro outputStore value sourceRun + exact attached.traceState_next_of_member callerMember state descendant + sourceDeclarations sourceRun (callerTargets value) + exact ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + retainedStores, targetRelease, releasedStores, sourceEquation, targetStep, + combinedCallee, callerContinuation⟩ + +/-- Over-saturating a shared PAP enters the first retained callee in the +combined state and preserves the exact residual argument vector for the +`applyMore` continuation. As in exact saturation, successful completion of +the whole source operation builds the original caller's combined successor. -/ +theorem CompiledAttachment.simulate_traced_apply_pap_over_enter_state + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {callerTrace calleeTrace : Lower.FunctionTrace} + (callerMember : callerTrace ∈ attached.target.artifact.trace.functions) + (calleeMember : calleeTrace ∈ attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceFunction : IxIR1.Atom} {targetFunction : Atom} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : callerTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next)) + {sourceDefinition : IxIR1.FnDef} {targetDefinition : Function} + {sourceStore sourceRetained sourceReleased : IxIR1.Store} + {source : List IxIR1.RVal} {location : Nat} {box : IxIR1.NodeBox} + {address : Ixon.Address} {arity : Nat} + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration address) sourceDefinition targetDefinition) + {captured : Array IxIR1.RVal} {values : List IxIR1.RVal} + (state : attached.sidecars.TraceStateRel callerTrace + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (positive : Lower.Sim.PositiveSharedRC sourceStore) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (functionResolved : + IxIR1.resolveAtom source sourceFunction = .ok (.loc location)) + (argumentsResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (sourceGet : sourceStore.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (sourceRetain : + IxIR1.dupVals sourceStore captured.toList = .ok sourceRetained) + (sourceRelease : IxIR1.dropVal sourceContext sourceFuel sourceRetained + (.loc location) = .ok sourceReleased) + (totalOver : arity < (captured.toList ++ values).length) + (papArity : arity = sourceDefinition.arity) + (sourceDeclaration : + sourceContext.decls address = some (.fn sourceDefinition)) + (sourcePapSafe : sourceDefinition.papSafe = true) + (targetDeclaration : + context.declarations address = some (.fn targetDefinition)) + (noCredits : frame.credits = #[]) + (control : machine.control = .running frame stack) : + let sourceTotal := captured.toList ++ values + let sourceSupplied := sourceTotal.take arity + let sourceRemaining := sourceTotal.drop arity + let targetTotal := captured ++ values.toArray + let targetSupplied := targetTotal.extract 0 arity + let targetRemaining := targetTotal.extract arity targetTotal.size + let resume : Eval.Frame := { frame with pc := frame.pc + 1 } + let calleeFrame : Eval.Frame := + { definition := targetDefinition, values := targetSupplied } + let targetMachine : Eval.Machine := + { store := machine.store + heapFuel := 0 + control := .running calleeFrame + (.applyMore targetRemaining resume :: stack) } + ∃ (targetRetained targetReleased : Eval.Store) (targetHeapFuel : Nat), + Eval.RetainSharedMany machine.store captured targetRetained ∧ + Lower.Sim.StoreRel sourceRetained targetRetained ∧ + Eval.releaseSharedWork targetHeapFuel targetRetained [.loc location] = + .ok (targetReleased, 0) ∧ + Lower.Sim.StoreRel sourceReleased targetReleased ∧ + IxIR1.runOp sourceContext (sourceFuel + 2) callerTrace.source + sourceStore source (.apply sourceFunction sourceArguments) = + (do + let (nextStore, result) ← + IxIR1.invoke sourceContext sourceFuel address sourceSupplied + sourceReleased + IxIR1.applyGo sourceContext sourceFuel nextStore result + sourceRemaining) ∧ + Eval.Step context interpretation + { machine with heapFuel := targetHeapFuel } + { targetMachine with store := targetReleased } ∧ + targetRemaining.toList = sourceRemaining ∧ + attached.sidecars.TraceStateRel calleeTrace calleeTrace.root + sourceReleased sourceSupplied.reverse calleeFrame ∧ + ∀ (outputStore : IxIR1.Store) (value : IxIR1.RVal), + IxIR1.runOp sourceContext (sourceFuel + 2) callerTrace.source + sourceStore source (.apply sourceFunction sourceArguments) = + .ok (outputStore, value) → + attached.sidecars.TraceStateRel callerTrace next outputStore + (value :: source) + { frame with + pc := frame.pc + 1 + values := frame.values.push value } := by + dsimp only + obtain ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + retainedStores, targetRelease, releasedStores, sourceEquation, + targetStep, remainingEq, _, callerTargets⟩ := + Lower.Sim.simulate_traced_apply_pap_over_enter_state + (sourceCurrent := callerTrace.source) descendant calleeMatch state.target + stores positive functionResolved argumentsResolved sourceGet shared node + capturedUnder sourceRetain sourceRelease totalOver papArity + sourceDeclaration sourcePapSafe targetDeclaration noCredits control + let sourceTotal := captured.toList ++ values + let sourceSupplied := sourceTotal.take arity + let targetTotal := captured ++ values.toArray + let targetSupplied := targetTotal.extract 0 arity + have totalArrayEq : sourceTotal.toArray = targetTotal := by + apply Array.toList_inj.mp + simp [sourceTotal, targetTotal] + have suppliedArrayEq : targetSupplied = sourceSupplied.toArray := by + calc + targetSupplied = targetTotal.take arity := Array.take_eq_extract.symm + _ = sourceTotal.toArray.take arity := by rw [totalArrayEq] + _ = sourceSupplied.toArray := List.take_toArray + have targetOver : arity < targetTotal.size := by + simpa [sourceTotal, targetTotal] using totalOver + have suppliedSize : targetSupplied.size = arity := by + simp [targetSupplied, Array.size_extract] + omega + have entryArity : targetSupplied.size = calleeTrace.source.arity := by + calc + targetSupplied.size = arity := suppliedSize + _ = sourceDefinition.arity := papArity + _ = calleeTrace.source.arity := by rw [calleeMatch.source] + have calleeState := attached.functionEntryTraceState + (sourceStore := sourceReleased) calleeMember targetSupplied entryArity + have sourceEnvironment : + targetSupplied.toList.reverse = sourceSupplied.reverse := by + rw [suppliedArrayEq] + rw [sourceEnvironment] at calleeState + have combinedCallee : attached.sidecars.TraceStateRel calleeTrace + calleeTrace.root sourceReleased sourceSupplied.reverse + { definition := targetDefinition, values := targetSupplied } := by + simpa [calleeMatch.generated] using calleeState + have callerContinuation : + ∀ (outputStore : IxIR1.Store) (value : IxIR1.RVal), + IxIR1.runOp sourceContext (sourceFuel + 2) callerTrace.source + sourceStore source (.apply sourceFunction sourceArguments) = + .ok (outputStore, value) → + attached.sidecars.TraceStateRel callerTrace next outputStore + (value :: source) + { frame with + pc := frame.pc + 1 + values := frame.values.push value } := by + intro outputStore value sourceRun + exact attached.traceState_next_of_member callerMember state descendant + sourceDeclarations sourceRun (callerTargets value) + exact ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + retainedStores, targetRelease, releasedStores, sourceEquation, targetStep, + remainingEq, combinedCallee, callerContinuation⟩ + +/-! ## Combined call-stack transitions -/ + +/-- An addressed source call enters the matched retained declaration in the +combined source/HPT/target state. Whole-trace attachment alignment recovers +the callee's exact HPT root. -/ +theorem CompiledAttachment.simulate_traced_call_fn_enter_state + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace calleeTrace : Lower.FunctionTrace} + (calleeMember : calleeTrace ∈ attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAddress targetAddress : Ixon.Address} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.call sourceAddress sourceArguments) index + (.call targetAddress targetArguments) next)) + {sourceDefinition : IxIR1.FnDef} {targetDefinition : Function} + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration sourceAddress) sourceDefinition targetDefinition) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {values : List IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.call sourceAddress sourceArguments) index + (.call targetAddress targetArguments) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (argumentArity : sourceDefinition.arity = values.length) + (declaration : + context.declarations sourceAddress = some (.fn targetDefinition)) + (noCredits : frame.credits = #[]) + (control : machine.control = .running frame stack) : + let calleeFrame : Eval.Frame := + { definition := targetDefinition, values := values.toArray } + IxIR1.runOp sourceContext (sourceFuel + 1) functionTrace.source + sourceStore source (.call sourceAddress sourceArguments) = + IxIR1.invoke sourceContext sourceFuel sourceAddress values sourceStore ∧ + Eval.Step context interpretation machine + { machine with + control := .running calleeFrame + (.resume { frame with pc := frame.pc + 1 } :: stack) } ∧ + Lower.Sim.StoreRel sourceStore machine.store ∧ + attached.sidecars.TraceStateRel calleeTrace calleeTrace.root sourceStore + values.reverse calleeFrame := by + dsimp only + obtain ⟨sourceEquation, targetStep, nextStores, _⟩ := + Lower.Sim.simulate_traced_call_fn_enter_source_state + (sourceContext := sourceContext) (sourceFuel := sourceFuel) + (context := context) (interpretation := interpretation) + descendant calleeMatch state.target stores sourceResolved argumentArity + declaration noCredits control + have entryArity : values.toArray.size = calleeTrace.source.arity := by + simpa [calleeMatch.source] using argumentArity.symm + have calleeState := attached.functionEntryTraceState + (sourceStore := sourceStore) calleeMember values.toArray entryArity + exact ⟨sourceEquation, targetStep, nextStores, by + simpa [calleeMatch.generated] using calleeState⟩ + +/-- A recursive self-call in any retained function enters the same trace root +in the combined state while preserving the suspended caller continuation. -/ +theorem CompiledAttachment.simulate_traced_call_self_enter_state + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.callSelf sourceArguments) index (.callSelf targetArguments) next)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {values : List IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.callSelf sourceArguments) index (.callSelf targetArguments) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (argumentArity : functionTrace.source.arity = values.length) + (noCredits : frame.credits = #[]) + (control : machine.control = .running frame stack) : + let calleeFrame : Eval.Frame := + { definition := frame.definition, values := values.toArray } + IxIR1.runOp sourceContext (sourceFuel + 1) functionTrace.source + sourceStore source (.callSelf sourceArguments) = (do + let out ← IxIR1.runCode sourceContext sourceFuel functionTrace.source + sourceStore values.reverse functionTrace.source.body + IxIR1.checkResultWorld functionTrace.source.result out) ∧ + Eval.Step context interpretation machine + { machine with + control := .running calleeFrame + (.resume { frame with pc := frame.pc + 1 } :: stack) } ∧ + Lower.Sim.StoreRel sourceStore machine.store ∧ + attached.sidecars.TraceStateRel functionTrace functionTrace.root + sourceStore values.reverse calleeFrame := by + dsimp only + obtain ⟨sourceEquation, targetStep, nextStores, _⟩ := + Lower.Sim.simulate_traced_call_self_enter_source_state + (sourceContext := sourceContext) (sourceFuel := sourceFuel) + (context := context) (interpretation := interpretation) + descendant state.target stores sourceResolved argumentArity noCredits + control + have entryArity : values.toArray.size = functionTrace.source.arity := by + simpa using argumentArity.symm + have calleeState := attached.functionEntryTraceState + (sourceStore := sourceStore) functionMember values.toArray entryArity + exact ⟨sourceEquation, targetStep, nextStores, by + simpa [state.target.definition] using calleeState⟩ + +/-- An addressed tail call transfers directly into the matched declaration's +combined root state without retaining a caller continuation. -/ +theorem CompiledAttachment.simulate_traced_tail_call_fn_enter_state + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace calleeTrace : Lower.FunctionTrace} + (calleeMember : calleeTrace ∈ attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {address : Ixon.Address} {sourceArguments : Array IxIR1.Atom} + {generated : Block} + (descendant : functionTrace.root.Descendant + (.tailCall site blockId input entryValueCount address sourceArguments + generated)) + {sourceDefinition : IxIR1.FnDef} {targetDefinition : Function} + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration address) sourceDefinition targetDefinition) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {values : List IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.tailCall site blockId input entryValueCount address sourceArguments + generated) sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (argumentArity : sourceDefinition.arity = values.length) + (declaration : + context.declarations address = some (.fn targetDefinition)) + (noCredits : frame.credits = #[]) + (control : machine.control = .running frame stack) : + let calleeFrame : Eval.Frame := + { definition := targetDefinition, values := values.toArray } + IxIR1.runCode sourceContext (sourceFuel + 2) functionTrace.source + sourceStore source + (.letOp (.call address sourceArguments) (.ret (.var 0))) = + IxIR1.invoke sourceContext sourceFuel address values sourceStore ∧ + Eval.Step context interpretation machine + { machine with control := .running calleeFrame stack } ∧ + Lower.Sim.StoreRel sourceStore machine.store ∧ + attached.sidecars.TraceStateRel calleeTrace calleeTrace.root sourceStore + values.reverse calleeFrame := by + dsimp only + obtain ⟨sourceEquation, targetStep, nextStores, _⟩ := + Lower.Sim.simulate_traced_tail_call_fn_enter_source_state + (sourceContext := sourceContext) (sourceFuel := sourceFuel) + (context := context) (interpretation := interpretation) + descendant calleeMatch state.target stores sourceResolved argumentArity + declaration noCredits control + have entryArity : values.toArray.size = calleeTrace.source.arity := by + simpa [calleeMatch.source] using argumentArity.symm + have calleeState := attached.functionEntryTraceState + (sourceStore := sourceStore) calleeMember values.toArray entryArity + exact ⟨sourceEquation, targetStep, nextStores, by + simpa [calleeMatch.generated] using calleeState⟩ + +/-- A self-tail-call in any retained function re-enters its own combined root +state while preserving the existing continuation stack. -/ +theorem CompiledAttachment.simulate_traced_tail_call_self_enter_state + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceArguments : Array IxIR1.Atom} {generated : Block} + (descendant : functionTrace.root.Descendant + (.tailCallSelf site blockId input entryValueCount sourceArguments + generated)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {values : List IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.tailCallSelf site blockId input entryValueCount sourceArguments + generated) sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (argumentArity : functionTrace.source.arity = values.length) + (noCredits : frame.credits = #[]) + (control : machine.control = .running frame stack) : + let calleeFrame : Eval.Frame := + { definition := frame.definition, values := values.toArray } + IxIR1.runCode sourceContext (sourceFuel + 2) functionTrace.source + sourceStore source + (.letOp (.callSelf sourceArguments) (.ret (.var 0))) = (do + let out ← IxIR1.runCode sourceContext sourceFuel functionTrace.source + sourceStore values.reverse functionTrace.source.body + IxIR1.checkResultWorld functionTrace.source.result out) ∧ + Eval.Step context interpretation machine + { machine with control := .running calleeFrame stack } ∧ + Lower.Sim.StoreRel sourceStore machine.store ∧ + attached.sidecars.TraceStateRel functionTrace functionTrace.root + sourceStore values.reverse calleeFrame := by + dsimp only + obtain ⟨sourceEquation, targetStep, nextStores, _⟩ := + Lower.Sim.simulate_traced_tail_call_self_enter_source_state + (sourceContext := sourceContext) (sourceFuel := sourceFuel) + (context := context) (interpretation := interpretation) + descendant state.target stores sourceResolved argumentArity noCredits + control + have entryArity : values.toArray.size = functionTrace.source.arity := by + simpa using argumentArity.symm + have calleeState := attached.functionEntryTraceState + (sourceStore := sourceStore) functionMember values.toArray entryArity + exact ⟨sourceEquation, targetStep, nextStores, by + simpa [state.target.definition] using calleeState⟩ + +/-- A successful callee return under `applyMore` performs one target +redispatch step from the combined callee state. Source return inversion and +the retained result contract discharge atom resolution and the evaluator's +dynamic world check; the supplied `ApplyTransfer` selects the next PAP branch. -/ +theorem CompiledAttachment.simulate_traced_ret_apply_more_success + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine target : Eval.Machine} {frame caller : Eval.Frame} + {arguments : Array IxIR1.RVal} {rest : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {generated : Block} + (descendant : functionTrace.root.Descendant + (.ret site blockId input entryValueCount sourceAtom targetAtom generated)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {sourceOutput : IxIR1.Store × IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.ret site blockId input entryValueCount sourceAtom targetAtom generated) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (sourceRun : IxIR1.runCode sourceContext (sourceFuel + 1) + functionTrace.source sourceStore source (.ret sourceAtom) = + .ok sourceOutput) + (resultWorld : IxIR1.Sim.HasWorld sourceOutput.1 + functionTrace.source.result sourceOutput.2) + (control : machine.control = + .running frame (.applyMore arguments caller :: rest)) + (noCredits : frame.credits = #[]) + (transferred : Eval.ApplyTransfer context interpretation machine.store + machine.heapFuel sourceOutput.2 arguments caller rest target) : + ∃ value, + sourceOutput = (sourceStore, value) ∧ + Eval.Steps context interpretation 1 machine target ∧ + Lower.Sim.StoreRel sourceStore machine.store := by + obtain ⟨value, sourceResolved, outputEq⟩ := + IxIR1.runCode_ret_success sourceRun + subst sourceOutput + have targetWorld := state.target.resultWorld stores resultWorld + obtain ⟨_, targetSteps, nextStores⟩ := + Lower.Sim.simulate_traced_ret_apply_more_state + (sourceContext := sourceContext) + (sourceCurrent := functionTrace.source) (sourceFuel := sourceFuel) + descendant state.target stores sourceResolved control noCredits + targetWorld transferred + exact ⟨value, rfl, targetSteps, nextStores⟩ + +/-- Returning a PAP into `applyMore` at exact saturation enters the next +retained callee in one target step and establishes its full combined root +state. This is the recursive exact-saturation handoff for over-application +chains. -/ +theorem CompiledAttachment.simulate_traced_ret_apply_more_pap_saturated_enter_state + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {returnFuel applyFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame caller : Eval.Frame} + {rest : List Eval.Continuation} + {returningTrace calleeTrace : Lower.FunctionTrace} + (calleeMember : calleeTrace ∈ attached.target.artifact.trace.functions) + {returnSite : Lower.SourceSite} {returnBlock : BlockId} + {returnInput : Lower.Sim.EnvMap} {returnEntryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {returnGenerated : Block} + (returnDescendant : returningTrace.root.Descendant + (.ret returnSite returnBlock returnInput returnEntryValueCount sourceAtom + targetAtom returnGenerated)) + {sourceDefinition : IxIR1.FnDef} {targetDefinition : Function} + {sourceStore sourceRetained sourceReleased : IxIR1.Store} + {source : List IxIR1.RVal} {location : Nat} {box : IxIR1.NodeBox} + {address : Ixon.Address} {arity : Nat} + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration address) sourceDefinition targetDefinition) + {captured : Array IxIR1.RVal} {values : List IxIR1.RVal} + (state : attached.sidecars.TraceStateRel returningTrace + (.ret returnSite returnBlock returnInput returnEntryValueCount sourceAtom + targetAtom returnGenerated) sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (positive : Lower.Sim.PositiveSharedRC sourceStore) + (sourceResolved : + IxIR1.resolveAtom source sourceAtom = .ok (.loc location)) + (resultWorld : IxIR1.Sim.HasWorld sourceStore + returningTrace.source.result (.loc location)) + (control : machine.control = + .running frame (.applyMore values.toArray caller :: rest)) + (noCredits : frame.credits = #[]) + (sourceGet : sourceStore.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (sourceRetain : + IxIR1.dupVals sourceStore captured.toList = .ok sourceRetained) + (sourceRelease : IxIR1.dropVal sourceContext applyFuel sourceRetained + (.loc location) = .ok sourceReleased) + (totalExact : (captured.toList ++ values).length = arity) + (papArity : arity = sourceDefinition.arity) + (sourceDeclaration : + sourceContext.decls address = some (.fn sourceDefinition)) + (sourcePapSafe : sourceDefinition.papSafe = true) + (targetDeclaration : + context.declarations address = some (.fn targetDefinition)) : + let sourceTotal := captured.toList ++ values + let targetTotal := captured ++ values.toArray + let calleeFrame : Eval.Frame := + { definition := targetDefinition, values := targetTotal } + ∃ (targetRetained targetReleased : Eval.Store) (targetHeapFuel : Nat), + Eval.RetainSharedMany machine.store captured targetRetained ∧ + Lower.Sim.StoreRel sourceRetained targetRetained ∧ + Eval.releaseSharedWork targetHeapFuel targetRetained [.loc location] = + .ok (targetReleased, 0) ∧ + Lower.Sim.StoreRel sourceReleased targetReleased ∧ + IxIR1.runCode sourceContext (returnFuel + 1) returningTrace.source + sourceStore source (.ret sourceAtom) = + .ok (sourceStore, .loc location) ∧ + IxIR1.applyGo sourceContext (applyFuel + 1) sourceStore + (.loc location) values = + IxIR1.invoke sourceContext applyFuel address sourceTotal + sourceReleased ∧ + Eval.Steps context interpretation 1 + { machine with heapFuel := targetHeapFuel } + { store := targetReleased + heapFuel := 0 + control := .running calleeFrame (.resume caller :: rest) } ∧ + attached.sidecars.TraceStateRel calleeTrace calleeTrace.root + sourceReleased sourceTotal.reverse calleeFrame := by + dsimp only + obtain ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + retainedStores, targetRelease, releasedStores, sourceApply, transferred, + _⟩ := + Lower.Sim.simulate_applyGo_pap_saturated_enter + (resume := caller) (stack := rest) calleeMatch stores positive sourceGet + shared node capturedUnder sourceRetain sourceRelease totalExact papArity + sourceDeclaration sourcePapSafe targetDeclaration + have beforeControl : + ({ machine with heapFuel := targetHeapFuel } : Eval.Machine).control = + .running frame (.applyMore values.toArray caller :: rest) := by + simpa using control + have targetWorld := state.target.resultWorld stores resultWorld + obtain ⟨sourceReturn, targetSteps, _⟩ := + Lower.Sim.simulate_traced_ret_apply_more_state + (sourceContext := sourceContext) + (sourceCurrent := returningTrace.source) (sourceFuel := returnFuel) + (machine := { machine with heapFuel := targetHeapFuel }) + returnDescendant state.target stores sourceResolved beforeControl + noCredits targetWorld transferred + have entryArity : + (captured ++ values.toArray).size = calleeTrace.source.arity := by + calc + (captured ++ values.toArray).size = + (captured.toList ++ values).length := by simp + _ = arity := totalExact + _ = sourceDefinition.arity := papArity + _ = calleeTrace.source.arity := by rw [calleeMatch.source] + have calleeState := attached.functionEntryTraceState + (sourceStore := sourceReleased) calleeMember + (captured ++ values.toArray) entryArity + have combinedCallee : attached.sidecars.TraceStateRel calleeTrace + calleeTrace.root sourceReleased (captured.toList ++ values).reverse + { definition := targetDefinition + values := captured ++ values.toArray } := by + simpa [calleeMatch.generated] using calleeState + exact ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + retainedStores, targetRelease, releasedStores, sourceReturn, sourceApply, + targetSteps, combinedCallee⟩ + +/-- Returning a PAP into `applyMore` with excess residual arguments enters +the next retained callee in the combined state and installs another exact +`applyMore` suffix. This is the recursive over-saturation handoff. -/ +theorem CompiledAttachment.simulate_traced_ret_apply_more_pap_over_enter_state + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {returnFuel applyFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame caller : Eval.Frame} + {rest : List Eval.Continuation} + {returningTrace calleeTrace : Lower.FunctionTrace} + (calleeMember : calleeTrace ∈ attached.target.artifact.trace.functions) + {returnSite : Lower.SourceSite} {returnBlock : BlockId} + {returnInput : Lower.Sim.EnvMap} {returnEntryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {returnGenerated : Block} + (returnDescendant : returningTrace.root.Descendant + (.ret returnSite returnBlock returnInput returnEntryValueCount sourceAtom + targetAtom returnGenerated)) + {sourceDefinition : IxIR1.FnDef} {targetDefinition : Function} + {sourceStore sourceRetained sourceReleased : IxIR1.Store} + {source : List IxIR1.RVal} {location : Nat} {box : IxIR1.NodeBox} + {address : Ixon.Address} {arity : Nat} + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration address) sourceDefinition targetDefinition) + {captured : Array IxIR1.RVal} {values : List IxIR1.RVal} + (state : attached.sidecars.TraceStateRel returningTrace + (.ret returnSite returnBlock returnInput returnEntryValueCount sourceAtom + targetAtom returnGenerated) sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (positive : Lower.Sim.PositiveSharedRC sourceStore) + (sourceResolved : + IxIR1.resolveAtom source sourceAtom = .ok (.loc location)) + (resultWorld : IxIR1.Sim.HasWorld sourceStore + returningTrace.source.result (.loc location)) + (control : machine.control = + .running frame (.applyMore values.toArray caller :: rest)) + (noCredits : frame.credits = #[]) + (sourceGet : sourceStore.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (sourceRetain : + IxIR1.dupVals sourceStore captured.toList = .ok sourceRetained) + (sourceRelease : IxIR1.dropVal sourceContext applyFuel sourceRetained + (.loc location) = .ok sourceReleased) + (totalOver : arity < (captured.toList ++ values).length) + (papArity : arity = sourceDefinition.arity) + (sourceDeclaration : + sourceContext.decls address = some (.fn sourceDefinition)) + (sourcePapSafe : sourceDefinition.papSafe = true) + (targetDeclaration : + context.declarations address = some (.fn targetDefinition)) : + let sourceTotal := captured.toList ++ values + let sourceSupplied := sourceTotal.take arity + let sourceRemaining := sourceTotal.drop arity + let targetTotal := captured ++ values.toArray + let targetSupplied := targetTotal.extract 0 arity + let targetRemaining := targetTotal.extract arity targetTotal.size + let calleeFrame : Eval.Frame := + { definition := targetDefinition, values := targetSupplied } + ∃ (targetRetained targetReleased : Eval.Store) (targetHeapFuel : Nat), + Eval.RetainSharedMany machine.store captured targetRetained ∧ + Lower.Sim.StoreRel sourceRetained targetRetained ∧ + Eval.releaseSharedWork targetHeapFuel targetRetained [.loc location] = + .ok (targetReleased, 0) ∧ + Lower.Sim.StoreRel sourceReleased targetReleased ∧ + IxIR1.runCode sourceContext (returnFuel + 1) returningTrace.source + sourceStore source (.ret sourceAtom) = + .ok (sourceStore, .loc location) ∧ + IxIR1.applyGo sourceContext (applyFuel + 1) sourceStore + (.loc location) values = + (do + let (nextStore, result) ← + IxIR1.invoke sourceContext applyFuel address sourceSupplied + sourceReleased + IxIR1.applyGo sourceContext applyFuel nextStore result + sourceRemaining) ∧ + Eval.Steps context interpretation 1 + { machine with heapFuel := targetHeapFuel } + { store := targetReleased + heapFuel := 0 + control := .running calleeFrame + (.applyMore targetRemaining caller :: rest) } ∧ + targetRemaining.toList = sourceRemaining ∧ + attached.sidecars.TraceStateRel calleeTrace calleeTrace.root + sourceReleased sourceSupplied.reverse calleeFrame := by + dsimp only + obtain ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + retainedStores, targetRelease, releasedStores, sourceApply, transferred, + remainingEq, _⟩ := + Lower.Sim.simulate_applyGo_pap_over_enter + (resume := caller) (stack := rest) calleeMatch stores positive sourceGet + shared node capturedUnder sourceRetain sourceRelease totalOver papArity + sourceDeclaration sourcePapSafe targetDeclaration + have beforeControl : + ({ machine with heapFuel := targetHeapFuel } : Eval.Machine).control = + .running frame (.applyMore values.toArray caller :: rest) := by + simpa using control + have targetWorld := state.target.resultWorld stores resultWorld + obtain ⟨sourceReturn, targetSteps, _⟩ := + Lower.Sim.simulate_traced_ret_apply_more_state + (sourceContext := sourceContext) + (sourceCurrent := returningTrace.source) (sourceFuel := returnFuel) + (machine := { machine with heapFuel := targetHeapFuel }) + returnDescendant state.target stores sourceResolved beforeControl + noCredits targetWorld transferred + let sourceTotal := captured.toList ++ values + let sourceSupplied := sourceTotal.take arity + let targetTotal := captured ++ values.toArray + let targetSupplied := targetTotal.extract 0 arity + have totalArrayEq : sourceTotal.toArray = targetTotal := by + apply Array.toList_inj.mp + simp [sourceTotal, targetTotal] + have suppliedArrayEq : targetSupplied = sourceSupplied.toArray := by + calc + targetSupplied = targetTotal.take arity := Array.take_eq_extract.symm + _ = sourceTotal.toArray.take arity := by rw [totalArrayEq] + _ = sourceSupplied.toArray := List.take_toArray + have targetOver : arity < targetTotal.size := by + simpa [sourceTotal, targetTotal] using totalOver + have suppliedSize : targetSupplied.size = arity := by + simp [targetSupplied, Array.size_extract] + omega + have entryArity : targetSupplied.size = calleeTrace.source.arity := by + calc + targetSupplied.size = arity := suppliedSize + _ = sourceDefinition.arity := papArity + _ = calleeTrace.source.arity := by rw [calleeMatch.source] + have calleeState := attached.functionEntryTraceState + (sourceStore := sourceReleased) calleeMember targetSupplied entryArity + have sourceEnvironment : + targetSupplied.toList.reverse = sourceSupplied.reverse := by + rw [suppliedArrayEq] + rw [sourceEnvironment] at calleeState + have combinedCallee : attached.sidecars.TraceStateRel calleeTrace + calleeTrace.root sourceReleased sourceSupplied.reverse + { definition := targetDefinition, values := targetSupplied } := by + simpa [calleeMatch.generated] using calleeState + exact ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + retainedStores, targetRelease, releasedStores, sourceReturn, sourceApply, + targetSteps, remainingEq, combinedCallee⟩ + +/-- Returning a PAP into `applyMore` below saturation extends the PAP and +resumes the waiting caller immediately. The source and target allocate the +same longer PAP at the related fresh location. -/ +theorem CompiledAttachment.simulate_traced_ret_apply_more_pap_under_state + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {returnFuel applyFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame caller : Eval.Frame} + {rest : List Eval.Continuation} {returningTrace : Lower.FunctionTrace} + {returnSite : Lower.SourceSite} {returnBlock : BlockId} + {returnInput : Lower.Sim.EnvMap} {returnEntryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {returnGenerated : Block} + (returnDescendant : returningTrace.root.Descendant + (.ret returnSite returnBlock returnInput returnEntryValueCount sourceAtom + targetAtom returnGenerated)) + {sourceStore sourceRetained sourceReleased : IxIR1.Store} + {source : List IxIR1.RVal} {location : Nat} {box : IxIR1.NodeBox} + {address : Ixon.Address} {arity : Nat} + {captured : Array IxIR1.RVal} {values : List IxIR1.RVal} + (state : attached.sidecars.TraceStateRel returningTrace + (.ret returnSite returnBlock returnInput returnEntryValueCount sourceAtom + targetAtom returnGenerated) sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (positive : Lower.Sim.PositiveSharedRC sourceStore) + (sourceResolved : + IxIR1.resolveAtom source sourceAtom = .ok (.loc location)) + (resultWorld : IxIR1.Sim.HasWorld sourceStore + returningTrace.source.result (.loc location)) + (control : machine.control = + .running frame (.applyMore values.toArray caller :: rest)) + (noCredits : frame.credits = #[]) + (sourceGet : sourceStore.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (sourceRetain : + IxIR1.dupVals sourceStore captured.toList = .ok sourceRetained) + (sourceRelease : IxIR1.dropVal sourceContext applyFuel sourceRetained + (.loc location) = .ok sourceReleased) + (totalUnder : (captured.toList ++ values).length < arity) : + let pap := IxIR1.Node.papN address arity (captured ++ values.toArray) + let sourceAllocation := sourceReleased.allocNode .shared pap + ∃ (targetRetained targetReleased : Eval.Store) (targetHeapFuel : Nat), + Eval.RetainSharedMany machine.store captured targetRetained ∧ + Lower.Sim.StoreRel sourceRetained targetRetained ∧ + Eval.releaseSharedWork targetHeapFuel targetRetained [.loc location] = + .ok (targetReleased, 0) ∧ + Lower.Sim.StoreRel sourceReleased targetReleased ∧ + let targetAllocation := targetReleased.allocNode .shared pap + IxIR1.runCode sourceContext (returnFuel + 1) returningTrace.source + sourceStore source (.ret sourceAtom) = + .ok (sourceStore, .loc location) ∧ + IxIR1.applyGo sourceContext (applyFuel + 1) sourceStore + (.loc location) values = + .ok (sourceAllocation.1, .loc sourceAllocation.2) ∧ + Eval.Steps context interpretation 1 + { machine with heapFuel := targetHeapFuel } + { store := targetAllocation.1 + heapFuel := 0 + control := .running + { caller with + values := caller.values.push (.loc sourceAllocation.2) } + rest } ∧ + Lower.Sim.StoreRel sourceAllocation.1 targetAllocation.1 := by + dsimp only + obtain ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + retainedStores, targetRelease, releasedStores, sourceApply, transferred, + nextStores⟩ := + Lower.Sim.simulate_applyGo_pap_under + (resume := caller) (stack := rest) stores positive sourceGet shared node + capturedUnder sourceRetain sourceRelease totalUnder + have beforeControl : + ({ machine with heapFuel := targetHeapFuel } : Eval.Machine).control = + .running frame (.applyMore values.toArray caller :: rest) := by + simpa using control + have targetWorld := state.target.resultWorld stores resultWorld + obtain ⟨sourceReturn, targetSteps, _⟩ := + Lower.Sim.simulate_traced_ret_apply_more_state + (sourceContext := sourceContext) + (sourceCurrent := returningTrace.source) (sourceFuel := returnFuel) + (machine := { machine with heapFuel := targetHeapFuel }) + returnDescendant state.target stores sourceResolved beforeControl + noCredits targetWorld transferred + exact ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + retainedStores, targetRelease, releasedStores, sourceReturn, sourceApply, + targetSteps, nextStores⟩ + +/-- Returning `erased` into `applyMore` releases every residual shared +argument and resumes the waiting caller with `erased`, preserving the exact +store relation and positive shared-reference-count invariant. -/ +theorem CompiledAttachment.simulate_traced_ret_apply_more_erased_state + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {returnFuel applyFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame caller : Eval.Frame} + {rest : List Eval.Continuation} {returningTrace : Lower.FunctionTrace} + {returnSite : Lower.SourceSite} {returnBlock : BlockId} + {returnInput : Lower.Sim.EnvMap} {returnEntryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {returnGenerated : Block} + (returnDescendant : returningTrace.root.Descendant + (.ret returnSite returnBlock returnInput returnEntryValueCount sourceAtom + targetAtom returnGenerated)) + {sourceStore sourceReleased : IxIR1.Store} + {source : List IxIR1.RVal} {values : List IxIR1.RVal} + (state : attached.sidecars.TraceStateRel returningTrace + (.ret returnSite returnBlock returnInput returnEntryValueCount sourceAtom + targetAtom returnGenerated) sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (positive : Lower.Sim.PositiveSharedRC sourceStore) + (sourceResolved : IxIR1.resolveAtom source sourceAtom = .ok .erased) + (resultWorld : IxIR1.Sim.HasWorld sourceStore + returningTrace.source.result .erased) + (control : machine.control = + .running frame (.applyMore values.toArray caller :: rest)) + (noCredits : frame.credits = #[]) + (sourceRelease : IxIR1.dropMany sourceContext applyFuel sourceStore + values = .ok sourceReleased) : + ∃ (targetHeapFuel : Nat) (targetReleased : Eval.Store), + IxIR1.runCode sourceContext (returnFuel + 1) returningTrace.source + sourceStore source (.ret sourceAtom) = .ok (sourceStore, .erased) ∧ + IxIR1.applyGo sourceContext (applyFuel + 1) sourceStore .erased values = + .ok (sourceReleased, .erased) ∧ + Eval.Steps context interpretation 1 + { machine with heapFuel := targetHeapFuel } + { store := targetReleased + heapFuel := 0 + control := .running + { caller with values := caller.values.push .erased } rest } ∧ + Lower.Sim.StoreRel sourceReleased targetReleased ∧ + Lower.Sim.PositiveSharedRC sourceReleased := by + obtain ⟨targetHeapFuel, targetReleased, sourceApply, transferred, + nextStores, nextPositive⟩ := + Lower.Sim.simulate_applyGo_erased + (resume := caller) (stack := rest) positive stores sourceRelease + have beforeControl : + ({ machine with heapFuel := targetHeapFuel } : Eval.Machine).control = + .running frame (.applyMore values.toArray caller :: rest) := by + simpa using control + have targetWorld := state.target.resultWorld stores resultWorld + obtain ⟨sourceReturn, targetSteps, _⟩ := + Lower.Sim.simulate_traced_ret_apply_more_state + (sourceContext := sourceContext) + (sourceCurrent := returningTrace.source) (sourceFuel := returnFuel) + (machine := { machine with heapFuel := targetHeapFuel }) + returnDescendant state.target stores sourceResolved beforeControl + noCredits targetWorld transferred + exact ⟨targetHeapFuel, targetReleased, sourceReturn, sourceApply, + targetSteps, nextStores, nextPositive⟩ + +/-- A callee return under an ordinary resume continuation restores the exact +caller continuation in the combined state. The completed source operation +advances the suspended caller's HPT environment across its `letOp`, while the +target return theorem supplies checked map forgetting and frame progression. -/ +theorem CompiledAttachment.simulate_traced_return_to_letOp_state + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel operationFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {calleeFrame callerFrame : Eval.Frame} + {rest : List Eval.Continuation} + {callerTrace calleeTrace : Lower.FunctionTrace} + (callerMember : callerTrace ∈ attached.target.artifact.trace.functions) + {callSite : Lower.SourceSite} {callBlock : BlockId} + {callInput nextInput : Lower.Sim.EnvMap} + {callEntryValueCount callIndex : Nat} + {operation : IxIR1.Op} {instruction : Instr} {next : Lower.CodeTrace} + (callerDescendant : callerTrace.root.Descendant + (.letOp callSite callBlock callInput nextInput callEntryValueCount + operation callIndex instruction next)) + {returnSite : Lower.SourceSite} {returnBlock : BlockId} + {returnInput : Lower.Sim.EnvMap} {returnEntryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {generated : Block} + (calleeDescendant : calleeTrace.root.Descendant + (.ret returnSite returnBlock returnInput returnEntryValueCount sourceAtom + targetAtom generated)) + {callerStore outputStore : IxIR1.Store} + {calleeSource callerSource : List IxIR1.RVal} {value : IxIR1.RVal} + (callerState : attached.sidecars.TraceStateRel callerTrace + (.letOp callSite callBlock callInput nextInput callEntryValueCount + operation callIndex instruction next) + callerStore callerSource callerFrame) + (calleeState : attached.sidecars.TraceStateRel calleeTrace + (.ret returnSite returnBlock returnInput returnEntryValueCount sourceAtom + targetAtom generated) outputStore calleeSource calleeFrame) + (binder : Lower.Instr.baselineBinderAtom callEntryValueCount instruction = + some (.reg callEntryValueCount)) + (delta : Lower.Instr.baselineValueDelta instruction = some 1) + (stores : Lower.Sim.StoreRel outputStore machine.store) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceOperation : IxIR1.runOp sourceContext operationFuel + callerTrace.source callerStore callerSource operation = + .ok (outputStore, value)) + (sourceResolved : + IxIR1.resolveAtom calleeSource sourceAtom = .ok value) + (control : machine.control = .running calleeFrame + (.resume { callerFrame with pc := callerFrame.pc + 1 } :: rest)) + (noCredits : calleeFrame.credits = #[]) + (world : Eval.RVal.hasWorld machine.store + calleeFrame.definition.signature.result value = true) : + let nextCallerFrame : Eval.Frame := + { callerFrame with + pc := callerFrame.pc + 1 + values := callerFrame.values.push value } + IxIR1.runCode sourceContext (sourceFuel + 1) calleeTrace.source outputStore + calleeSource (.ret sourceAtom) = .ok (outputStore, value) ∧ + Eval.Steps context interpretation 1 machine + { machine with control := .running nextCallerFrame rest } ∧ + Lower.Sim.StoreRel outputStore machine.store ∧ + attached.sidecars.TraceStateRel callerTrace next outputStore + (value :: callerSource) nextCallerFrame := by + dsimp only + obtain ⟨sourceReturn, targetSteps, nextStores, nextTarget⟩ := + Lower.Sim.simulate_traced_return_to_letOp_state + (sourceContext := sourceContext) (sourceCurrent := calleeTrace.source) + (sourceFuel := sourceFuel) (context := context) + (interpretation := interpretation) callerDescendant calleeDescendant + callerState.target calleeState.target binder delta stores sourceResolved + control noCredits world + have nextState := attached.traceState_next_of_member callerMember callerState + callerDescendant sourceDeclarations sourceOperation nextTarget + exact ⟨sourceReturn, targetSteps, nextStores, nextState⟩ + +/-- An attached terminal source return halts the target in one step. The +combined state carries the exact target trace relation and its retained source +result contract supplies the executable target-world check. -/ +theorem CompiledAttachment.simulate_traced_ret_halt_success + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {generated : Block} + (descendant : functionTrace.root.Descendant + (.ret site blockId input entryValueCount sourceAtom targetAtom generated)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {sourceOutput : IxIR1.Store × IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.ret site blockId input entryValueCount sourceAtom targetAtom generated) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (sourceRun : IxIR1.runCode sourceContext (sourceFuel + 1) + functionTrace.source sourceStore source (.ret sourceAtom) = + .ok sourceOutput) + (resultWorld : IxIR1.Sim.HasWorld sourceOutput.1 + functionTrace.source.result sourceOutput.2) + (control : machine.control = .running frame []) + (noCredits : frame.credits = #[]) : + ∃ value, + sourceOutput = (sourceStore, value) ∧ + Eval.Steps context interpretation 1 machine + { machine with control := .halted value } ∧ + Lower.Sim.StoreRel sourceStore machine.store := by + exact Lower.Sim.simulate_traced_ret_halt_success + (sourceContext := sourceContext) (sourceCurrent := functionTrace.source) + (sourceFuel := sourceFuel) (context := context) + (interpretation := interpretation) descendant state.target stores + sourceRun resultWorld control noCredits + +/-- Successful source-case execution expressed in the indexed alternative +vocabulary retained by the compiler trace. -/ +inductive IndexedCaseSuccess (ctx : IxIR1.Ctx) (fuel : Nat) + (cur : IxIR1.FnDef) (store : IxIR1.Store) (env : List IxIR1.RVal) + (scrutinee : IxIR1.Atom) (peelNat : Bool) + (alternatives : Array IxIR1.Alt) + (output : IxIR1.Store × IxIR1.RVal) : Prop + | ctorBranch {location : Nat} {box : IxIR1.NodeBox} + {cid : IxIR1.CtorId} {fields : Array IxIR1.RVal} + {fieldCount alternativeIndex : Nat} {body : IxIR1.Code} + (resolved : IxIR1.resolveAtom env scrutinee = .ok (.loc location)) + (found : store.get? location = some box) + (node : box.node = .ctorN cid fields) + (selected : Lower.sourceAlternativeAtTag? alternatives cid.cidx = + some (.mk cid.cidx fieldCount body, alternativeIndex)) + (fieldArity : fields.size = fieldCount) + (branchRun : IxIR1.runCode ctx fuel cur store + (fields.toList.reverse ++ env) body = .ok output) + | natZero {alternativeIndex : Nat} {body : IxIR1.Code} + (peels : peelNat = true) + (resolved : IxIR1.resolveAtom env scrutinee = + .ok (.lit (.nat 0))) + (selected : Lower.sourceAlternativeAtTag? alternatives 0 = + some (.mk 0 0 body, alternativeIndex)) + (branchRun : IxIR1.runCode ctx fuel cur store env body = .ok output) + | natSucc {predecessor alternativeIndex : Nat} {body : IxIR1.Code} + (peels : peelNat = true) + (resolved : IxIR1.resolveAtom env scrutinee = + .ok (.lit (.nat (predecessor + 1)))) + (selected : Lower.sourceAlternativeAtTag? alternatives 1 = + some (.mk 1 1 body, alternativeIndex)) + (branchRun : IxIR1.runCode ctx fuel cur store + (.lit (.nat predecessor) :: env) body = .ok output) + +/-- The exact target-side coordinates needed to enter one emitted +constructor branch. Keeping the terminator, constructor, edge, and child +lookups in one witness prevents the exhaustive worker from carrying four +independently quantified but necessarily parallel indices. -/ +structure ConstructorSwitchSelection (targetScrutinee : Atom) + (generated : Block) (outgoing : List Lower.EdgeTrace) + (children : List Lower.CodeTrace) (cid : CtorId) : Type where + constructors : Array CtorAlt + targetPeel : Option NatPeel + index : Nat + target : CtorAlt + edge : Lower.EdgeTrace + child : Lower.CodeTrace + terminator : generated.terminator = + .switchValue targetScrutinee constructors targetPeel + targetAt : constructors[index]? = some target + targetAlternative : constructors.find? (fun candidate => + candidate.cid == cid) = some target + edgeAt : outgoing[index]? = some edge + childAt : children[index]? = some child + +/-- An exact path-local HPT constructor fact determines a complete emitted +switch selection. Attachment checks provide the identity lookup; recursive +trace coherence supplies the parallel target, edge, and child ordinals. -/ +theorem CompiledAttachment.constructorSwitchSelection_of_exactHPT_nonempty + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {targetScrutinee : Atom} + {generated : Block} {outgoing : List Lower.EdgeTrace} + {children : List Lower.CodeTrace} {fact : IxIR1.HPT.Fact} + {identity : CtorId} + (descendant : functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children)) + (selected : attached.sidecars.exactConstructorAt? site sourceScrutinee = + some (fact, identity)) : + Nonempty (ConstructorSwitchSelection targetScrutinee generated outgoing + children identity) := by + obtain ⟨constructors, targetPeel, _, terminator⟩ := + Lower.CodeTrace.switchSyntax_of_match + (functionTrace.descendantSyntaxMatches descendant) + obtain ⟨target, targetAlternative⟩ := + attached.exactCaseTarget_of_switch_descendant functionMember descendant + selected terminator + have targetMember : target ∈ constructors := + Array.mem_of_find?_eq_some targetAlternative + obtain ⟨index, targetAt⟩ := + (Array.mem_iff_getElem?).mp targetMember + have branchMatch := Lower.CodeTrace.switchNodeBranchesMatch_of_match + (functionTrace.descendantSwitchBranchesMatch descendant) + have branchMatch' := branchMatch + unfold Lower.switchNodeBranchesMatch at branchMatch' + rw [terminator] at branchMatch' + simp only [Bool.and_eq_true] at branchMatch' + obtain ⟨⟨⟨outgoingLength, childrenLength⟩, _⟩, _⟩ := branchMatch' + have targetBound : index < constructors.size := + (Array.getElem?_eq_some_iff.mp targetAt).1 + have edgeBound : index < outgoing.length := by + have lengthEq := beq_iff_eq.mp outgoingLength + omega + have childBound : index < children.length := by + have lengthEq := beq_iff_eq.mp childrenLength + omega + let edge := outgoing[index]'edgeBound + let child := children[index]'childBound + have edgeAt : outgoing[index]? = some edge := + List.getElem?_eq_some_iff.mpr ⟨edgeBound, rfl⟩ + have childAt : children[index]? = some child := + List.getElem?_eq_some_iff.mpr ⟨childBound, rfl⟩ + exact ⟨ + { constructors + targetPeel + index + target + edge + child + terminator + targetAt + targetAlternative + edgeAt + childAt }⟩ + +/-- Proof-relevant form of +`constructorSwitchSelection_of_exactHPT_nonempty`. The executable attachment +check determines a unique first matching target; classical choice only +forgets the implementation details of extracting its parallel trace index. -/ +noncomputable def CompiledAttachment.constructorSwitchSelection_of_exactHPT + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {targetScrutinee : Atom} + {generated : Block} {outgoing : List Lower.EdgeTrace} + {children : List Lower.CodeTrace} {fact : IxIR1.HPT.Fact} + {identity : CtorId} + (descendant : functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children)) + (selected : attached.sidecars.exactConstructorAt? site sourceScrutinee = + some (fact, identity)) : + ConstructorSwitchSelection targetScrutinee generated outgoing children + identity := + Classical.choice + (attached.constructorSwitchSelection_of_exactHPT_nonempty functionMember + descendant selected) + +/-- At runtime, the exact HPT identity is the concrete constructor stored at +the resolved source location. Consequently the static attachment selection is +already the selection required by constructor dispatch. -/ +noncomputable def CompiledAttachment.constructorSwitchSelection_of_exactHPT_runtime + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {targetScrutinee : Atom} + {generated : Block} {outgoing : List Lower.EdgeTrace} + {children : List Lower.CodeTrace} {fact : IxIR1.HPT.Fact} + {identity cid : CtorId} + (descendant : functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {frame : Eval.Frame} {location : Nat} {box : IxIR1.NodeBox} + {fields : Array IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children) + sourceStore source frame) + (selected : attached.sidecars.exactConstructorAt? site sourceScrutinee = + some (fact, identity)) + (resolved : IxIR1.resolveAtom source sourceScrutinee = + .ok (.loc location)) + (sourceGet : sourceStore.get? location = some box) + (node : box.node = .ctorN cid fields) : + ConstructorSwitchSelection targetScrutinee generated outgoing children + cid := by + have identityEq : cid = identity := + attached.sidecars.exactConstructorAt?_matches_node selected + state.environment resolved sourceGet node + simpa [identityEq] using + attached.constructorSwitchSelection_of_exactHPT functionMember descendant + selected + +/-- Source `case` success immediately selects the exact source ordinal used by +the lowering trace, in addition to exposing the smaller-fuel branch run. -/ +theorem indexedCaseSuccess_of_run + {ctx : IxIR1.Ctx} {fuel : Nat} {cur : IxIR1.FnDef} + {store : IxIR1.Store} {env : List IxIR1.RVal} + {scrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} + {output : IxIR1.Store × IxIR1.RVal} + (run : IxIR1.runCode ctx (fuel + 1) cur store env + (.case scrutinee peelNat alternatives) = .ok output) : + IndexedCaseSuccess ctx fuel cur store env scrutinee peelNat alternatives + output := by + cases IxIR1.runCode_case_success run with + | @ctorBranch location box cid fields fieldCount body resolved found node + selected fieldArity branchRun => + have predicateEq : + (fun alternative : IxIR1.Alt => + alternative.cidx == cid.cidx) = + (fun alternative => + match alternative with + | .mk candidate _ _ => candidate == cid.cidx) := by + funext alternative + cases alternative + rfl + have evaluatorSelected : + alternatives.find? (fun alternative => + match alternative with + | .mk candidate _ _ => candidate == cid.cidx) = + some (.mk cid.cidx fieldCount body) := by + rw [← predicateEq] + exact selected + obtain ⟨alternativeIndex, indexed⟩ := + Lower.sourceAlternativeAtTag?_of_find? evaluatorSelected + exact .ctorBranch resolved found node indexed fieldArity branchRun + | @natZero body peels resolved selected branchRun => + have predicateEq : + (fun alternative : IxIR1.Alt => alternative.cidx == 0) = + (fun alternative => + match alternative with + | .mk candidate _ _ => candidate == 0) := by + funext alternative + cases alternative + rfl + have evaluatorSelected : + alternatives.find? (fun alternative => + match alternative with + | .mk candidate _ _ => candidate == 0) = + some (.mk 0 0 body) := by + rw [← predicateEq] + exact selected + obtain ⟨alternativeIndex, indexed⟩ := + Lower.sourceAlternativeAtTag?_of_find? evaluatorSelected + exact .natZero peels resolved indexed branchRun + | @natSucc predecessor body peels resolved selected branchRun => + have predicateEq : + (fun alternative : IxIR1.Alt => alternative.cidx == 1) = + (fun alternative => + match alternative with + | .mk candidate _ _ => candidate == 1) := by + funext alternative + cases alternative + rfl + have evaluatorSelected : + alternatives.find? (fun alternative => + match alternative with + | .mk candidate _ _ => candidate == 1) = + some (.mk 1 1 body) := by + rw [← predicateEq] + exact selected + obtain ⟨alternativeIndex, indexed⟩ := + Lower.sourceAlternativeAtTag?_of_find? evaluatorSelected + exact .natSucc peels resolved indexed branchRun + +/-- Enter a constructor switch child while advancing source syntax, the HPT +environment, and the target recursive state together. -/ +theorem Sidecars.TraceStateRel.constructorChild + {sidecars : Sidecars} {functionTrace : Lower.FunctionTrace} + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {targetScrutinee : Atom} + {generated : Block} {outgoing : List Lower.EdgeTrace} + {children : List Lower.CodeTrace} {frame childFrame : Eval.Frame} + {identity : CtorId} {tag fieldCount alternativeIndex : Nat} + {body : IxIR1.Code} {child : Lower.CodeTrace} + {location : Nat} {box : IxIR1.NodeBox} + {fields : Array IxIR1.RVal} + (state : sidecars.TraceStateRel functionTrace + (.switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children) + sourceStore source frame) + (sourceAlternative : Lower.sourceAlternativeAtTag? alternatives + identity.cidx = some (.mk tag fieldCount body, alternativeIndex)) + (childSource : child.source = site.alternative alternativeIndex) + (childCode : child.sourceCode = body) + (sourceResolved : IxIR1.resolveAtom source sourceScrutinee = + .ok (.loc location)) + (sourceGet : sourceStore.get? location = some box) + (node : box.node = .ctorN identity fields) + (fieldArity : fields.size = fieldCount) + (childTarget : Lower.Sim.CodeStateRel functionTrace child + (fields.toList.reverse ++ source) childFrame) : + sidecars.TraceStateRel functionTrace child sourceStore + (fields.toList.reverse ++ source) childFrame := by + have sourceAt : sidecars.sourceCodeAt? site = + some (.case sourceScrutinee peelNat alternatives) := by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceCode] using + state.sourceCode + have selected := + Lower.sourceAlternativeAtTag?_getElem? sourceAlternative + have sourceTag := Lower.sourceAlternativeAtTag?_tag sourceAlternative + have childSourceAt := sidecars.sourceCodeAt?_alternative sourceAt selected + have childEnvironment := sidecars.siteEnvironmentHolds_alternative_ctor + sourceAt selected state.environment sourceResolved sourceGet node + sourceTag.symm fieldArity + constructor + · rw [childSource, childCode] + exact childSourceAt + · rw [childSource] + exact state.owner + · rw [childSource] + exact childEnvironment + · exact childTarget + +/-- Enter the zero branch of a literal-Nat switch in the combined recursive +state. -/ +theorem Sidecars.TraceStateRel.natZeroChild + {sidecars : Sidecars} {functionTrace : Lower.FunctionTrace} + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {alternatives : Array IxIR1.Alt} + {targetScrutinee : Atom} {generated : Block} + {outgoing : List Lower.EdgeTrace} {children : List Lower.CodeTrace} + {frame childFrame : Eval.Frame} {alternativeIndex : Nat} + {body : IxIR1.Code} {child : Lower.CodeTrace} + (state : sidecars.TraceStateRel functionTrace + (.switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children) + sourceStore source frame) + (sourceAlternative : Lower.sourceAlternativeAtTag? alternatives 0 = + some (.mk 0 0 body, alternativeIndex)) + (childSource : child.source = site.alternative alternativeIndex) + (childCode : child.sourceCode = body) + (childTarget : Lower.Sim.CodeStateRel functionTrace child source + childFrame) : + sidecars.TraceStateRel functionTrace child sourceStore source + childFrame := by + have sourceAt : sidecars.sourceCodeAt? site = + some (.case sourceScrutinee true alternatives) := by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceCode] using + state.sourceCode + have selected := + Lower.sourceAlternativeAtTag?_getElem? sourceAlternative + have childSourceAt := sidecars.sourceCodeAt?_alternative sourceAt selected + have childEnvironment := sidecars.siteEnvironmentHolds_alternative_natZero + sourceAt selected state.environment + constructor + · rw [childSource, childCode] + exact childSourceAt + · rw [childSource] + exact state.owner + · rw [childSource] + exact childEnvironment + · exact childTarget + +/-- Enter the successor branch of a literal-Nat switch, preserving the peeled +predecessor in the combined recursive state. -/ +theorem Sidecars.TraceStateRel.natSuccChild + {sidecars : Sidecars} {functionTrace : Lower.FunctionTrace} + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {alternatives : Array IxIR1.Alt} + {targetScrutinee : Atom} {generated : Block} + {outgoing : List Lower.EdgeTrace} {children : List Lower.CodeTrace} + {frame childFrame : Eval.Frame} {alternativeIndex predecessor : Nat} + {body : IxIR1.Code} {child : Lower.CodeTrace} + (state : sidecars.TraceStateRel functionTrace + (.switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children) + sourceStore source frame) + (sourceAlternative : Lower.sourceAlternativeAtTag? alternatives 1 = + some (.mk 1 1 body, alternativeIndex)) + (childSource : child.source = site.alternative alternativeIndex) + (childCode : child.sourceCode = body) + (sourceResolved : IxIR1.resolveAtom source sourceScrutinee = + .ok (.lit (.nat (predecessor + 1)))) + (childTarget : Lower.Sim.CodeStateRel functionTrace child + (.lit (.nat predecessor) :: source) childFrame) : + sidecars.TraceStateRel functionTrace child sourceStore + (.lit (.nat predecessor) :: source) childFrame := by + have sourceAt : sidecars.sourceCodeAt? site = + some (.case sourceScrutinee true alternatives) := by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceCode] using + state.sourceCode + have selected := + Lower.sourceAlternativeAtTag?_getElem? sourceAlternative + have childSourceAt := sidecars.sourceCodeAt?_alternative sourceAt selected + have childEnvironment := sidecars.siteEnvironmentHolds_alternative_natSucc + sourceAt selected state.environment sourceResolved + constructor + · rw [childSource, childCode] + exact childSourceAt + · rw [childSource] + exact state.owner + · rw [childSource] + exact childEnvironment + · exact childTarget + +/-- Constructor dispatch composed with source-site/HPT transport. The result +enters the exact recursive child in the combined simulation state. -/ +theorem Sidecars.simulate_traced_switch_ctor_state_hpt + (sidecars : Sidecars) + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {targetScrutinee : Atom} + {generated : Block} {outgoing : List Lower.EdgeTrace} + {children : List Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {location : Nat} {box : IxIR1.NodeBox} {cid : CtorId} + {fields : Array IxIR1.RVal} + (state : sidecars.TraceStateRel functionTrace + (.switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (sourceResolved : IxIR1.resolveAtom source sourceScrutinee = + .ok (.loc location)) + (sourceGet : sourceStore.get? location = some box) + (node : box.node = .ctorN cid fields) + {tag fieldCount alternativeIndex : Nat} {body : IxIR1.Code} + (sourceAlternative : Lower.sourceAlternativeAtTag? alternatives cid.cidx = + some (.mk tag fieldCount body, alternativeIndex)) + (fieldArity : fields.size = fieldCount) + {constructors : Array CtorAlt} {targetPeel : Option NatPeel} + {index : Nat} {target : CtorAlt} {edge : Lower.EdgeTrace} + {child : Lower.CodeTrace} + (terminator : generated.terminator = + .switchValue targetScrutinee constructors targetPeel) + (targetAt : constructors[index]? = some target) + (targetAlternative : constructors.find? (fun candidate => + candidate.cid == cid) = some target) + (edgeAt : outgoing[index]? = some edge) + (childAt : children[index]? = some child) + (control : machine.control = .running frame stack) + (frameCredits : frame.credits = #[]) : + ∃ finalFrame, + child.source = site.alternative alternativeIndex ∧ + child.sourceCode = body ∧ + Eval.Steps context interpretation (1 + fields.size) machine + { machine with control := .running finalFrame stack } ∧ + Lower.Sim.StoreRel sourceStore machine.store ∧ + sidecars.TraceStateRel functionTrace child sourceStore + (fields.toList.reverse ++ source) finalFrame := by + obtain ⟨finalFrame, _edgeFrame, _childScrutinee, childSource, childCode, + targetSteps, _, _, nextStores, childTarget, _parentBlockAt, _parentPc, + _targetResolved, _targetGet, _transferred, _switchStep, _childBlockAt, + _childPc, _childResolved, _prologue⟩ := + Lower.Sim.simulate_traced_switch_ctor_state descendant state.target stores + sourceResolved sourceGet node sourceAlternative fieldArity terminator + targetAt targetAlternative edgeAt childAt control frameCredits + have childState := state.constructorChild sourceAlternative childSource + childCode sourceResolved sourceGet node fieldArity childTarget + exact ⟨finalFrame, childSource, childCode, targetSteps, nextStores, + childState⟩ + +/-- Literal-zero dispatch composed with source-site/HPT transport. -/ +theorem Sidecars.simulate_traced_switch_nat_zero_state_hpt + (sidecars : Sidecars) + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {alternatives : Array IxIR1.Alt} + {targetScrutinee : Atom} {generated : Block} + {outgoing : List Lower.EdgeTrace} {children : List Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + (state : sidecars.TraceStateRel functionTrace + (.switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children) + sourceStore source frame) + (sourceResolved : IxIR1.resolveAtom source sourceScrutinee = + .ok (.lit (.nat 0))) + (control : machine.control = .running frame stack) + (frameCredits : frame.credits = #[]) : + ∃ alternativeIndex body edge child childFrame, + edge ∈ outgoing ∧ child ∈ children ∧ + Lower.sourceAlternativeAtTag? alternatives 0 = + some (.mk 0 0 body, alternativeIndex) ∧ + child.source = site.alternative alternativeIndex ∧ + child.sourceCode = body ∧ + Eval.Step context interpretation machine + { machine with control := .running childFrame stack } ∧ + sidecars.TraceStateRel functionTrace child sourceStore source + childFrame := by + obtain ⟨constructors, peel, branches, childFrame, _, edgeMember, + childMember, sourceAlternative, childSource, childCode, targetStep, + _, _, childTarget⟩ := + Lower.Sim.simulate_traced_switch_nat_zero_state descendant state.target + sourceResolved control frameCredits + have childState := state.natZeroChild sourceAlternative childSource + childCode childTarget + exact ⟨branches.zero.alternativeIndex, branches.zero.body, + branches.zeroEdge, branches.zeroChild, childFrame, edgeMember, + childMember, sourceAlternative, childSource, childCode, targetStep, + childState⟩ + +/-- Literal-successor dispatch composed with source-site/HPT transport. -/ +theorem Sidecars.simulate_traced_switch_nat_succ_state_hpt + (sidecars : Sidecars) + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {alternatives : Array IxIR1.Alt} + {targetScrutinee : Atom} {generated : Block} + {outgoing : List Lower.EdgeTrace} {children : List Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {predecessor : Nat} + (state : sidecars.TraceStateRel functionTrace + (.switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children) + sourceStore source frame) + (sourceResolved : IxIR1.resolveAtom source sourceScrutinee = + .ok (.lit (.nat (predecessor + 1)))) + (control : machine.control = .running frame stack) + (frameCredits : frame.credits = #[]) : + ∃ alternativeIndex body edge child childFrame, + edge ∈ outgoing ∧ child ∈ children ∧ + Lower.sourceAlternativeAtTag? alternatives 1 = + some (.mk 1 1 body, alternativeIndex) ∧ + child.source = site.alternative alternativeIndex ∧ + child.sourceCode = body ∧ + Eval.Step context interpretation machine + { machine with control := .running childFrame stack } ∧ + sidecars.TraceStateRel functionTrace child sourceStore + (.lit (.nat predecessor) :: source) childFrame := by + obtain ⟨constructors, peel, branches, childFrame, _, edgeMember, + childMember, sourceAlternative, childSource, childCode, targetStep, + _, _, childTarget⟩ := + Lower.Sim.simulate_traced_switch_nat_succ_state descendant state.target + sourceResolved control frameCredits + have childState := state.natSuccChild sourceAlternative childSource + childCode sourceResolved childTarget + exact ⟨branches.succ.alternativeIndex, branches.succ.body, + branches.succEdge, branches.succChild, childFrame, edgeMember, + childMember, sourceAlternative, childSource, childCode, targetStep, + childState⟩ + +/-- HPT discharges both erased premises of the traced shallow-free simulation: +the concrete constructor identity and its all-scalar field vector. -/ +theorem Sidecars.simulate_traced_free_freeUnique_state_hpt + (sidecars : Sidecars) + {sourceContext : IxIR1.Ctx} {sourceCurrent : IxIR1.FnDef} + {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + {targetCid runtimeCid : IxIR1.CtorId} {fact : IxIR1.HPT.Fact} + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {location : Nat} {box : IxIR1.NodeBox} {fields : Array IxIR1.RVal} + (selected : sidecars.scalarLeafAt? site sourceAtom = + some (fact, targetCid)) + (environment : sidecars.SiteEnvironmentHolds sourceStore site source) + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.free sourceAtom) index (.freeUnique targetAtom targetCid) next)) + (state : Lower.Sim.CodeStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.free sourceAtom) index (.freeUnique targetAtom targetCid) next) + source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (sourceResolved : + IxIR1.resolveAtom source sourceAtom = .ok (.loc location)) + (sourceGet : sourceStore.get? location = some box) + (unique : box.world = .unique) + (node : box.node = .ctorN runtimeCid fields) + (control : machine.control = .running frame stack) : + let nextFrame : Eval.Frame := { frame with pc := frame.pc + 1 } + IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.free sourceAtom) = + .ok (sourceStore.kill location, .erased) ∧ + Eval.Step context interpretation machine + { machine with + store := machine.store.kill location + control := .running nextFrame stack } ∧ + Lower.Sim.StoreRel (sourceStore.kill location) + (machine.store.kill location) ∧ + Lower.Sim.CodeStateRel functionTrace next (.erased :: source) + nextFrame := by + obtain ⟨identity, scalarFields⟩ := + sidecars.scalarLeafAt?_matches_node selected environment sourceResolved + sourceGet node + subst runtimeCid + exact Lower.Sim.simulate_traced_free_freeUnique_state descendant state + stores sourceResolved sourceGet unique node scalarFields control + +/-- HPT discharges the constructor-identity premise of the traced fetch +simulation. A successful source fetch inversion supplies the remaining +generic node and field premises without trusting the emitted identity. -/ +theorem Sidecars.simulate_traced_fetch_state_hpt + (sidecars : Sidecars) + {sourceContext : IxIR1.Ctx} {sourceCurrent : IxIR1.FnDef} + {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + {sourceField targetField : Nat} + {targetCid runtimeCid : IxIR1.CtorId} {fact : IxIR1.HPT.Fact} + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {location : Nat} {box : IxIR1.NodeBox} + {fields : Array IxIR1.RVal} {value : IxIR1.RVal} + (selected : sidecars.exactConstructorAt? site sourceAtom = + some (fact, targetCid)) + (environment : sidecars.SiteEnvironmentHolds sourceStore site source) + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.fetch sourceAtom sourceField) index + (.fetch targetAtom targetCid targetField) next)) + (state : Lower.Sim.CodeStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.fetch sourceAtom sourceField) index + (.fetch targetAtom targetCid targetField) next) source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (sourceResolved : + IxIR1.resolveAtom source sourceAtom = .ok (.loc location)) + (sourceGet : sourceStore.get? location = some box) + (node : box.node = .ctorN runtimeCid fields) + (fieldAt : fields[sourceField]? = some value) + (control : machine.control = .running frame stack) : + let nextFrame : Eval.Frame := + { frame with + pc := frame.pc + 1 + values := frame.values.push value } + IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.fetch sourceAtom sourceField) = .ok (sourceStore, value) ∧ + Eval.Step context interpretation machine + { machine with control := .running nextFrame stack } ∧ + Lower.Sim.StoreRel sourceStore machine.store ∧ + Lower.Sim.CodeStateRel functionTrace next (value :: source) + nextFrame := by + have identity := sidecars.exactConstructorAt?_matches_node selected + environment sourceResolved sourceGet node + subst runtimeCid + exact Lower.Sim.simulate_traced_fetch_state descendant state stores + sourceResolved sourceGet node fieldAt control + +/-- Successful source execution plus a held site environment supplies every +runtime fetch premise, including the constructor identity erased from IxIR₁. -/ +theorem Sidecars.simulate_traced_fetch_state_of_run_hpt + (sidecars : Sidecars) + {sourceContext : IxIR1.Ctx} {sourceCurrent : IxIR1.FnDef} + {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + {sourceField targetField : Nat} + {targetCid : IxIR1.CtorId} {fact : IxIR1.HPT.Fact} + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {value : IxIR1.RVal} + (selected : sidecars.exactConstructorAt? site sourceAtom = + some (fact, targetCid)) + (environment : sidecars.SiteEnvironmentHolds sourceStore site source) + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.fetch sourceAtom sourceField) index + (.fetch targetAtom targetCid targetField) next)) + (state : Lower.Sim.CodeStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.fetch sourceAtom sourceField) index + (.fetch targetAtom targetCid targetField) next) source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (sourceRun : + IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.fetch sourceAtom sourceField) = .ok (sourceStore, value)) + (control : machine.control = .running frame stack) : + let nextFrame : Eval.Frame := + { frame with + pc := frame.pc + 1 + values := frame.values.push value } + IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.fetch sourceAtom sourceField) = .ok (sourceStore, value) ∧ + Eval.Step context interpretation machine + { machine with control := .running nextFrame stack } ∧ + Lower.Sim.StoreRel sourceStore machine.store ∧ + Lower.Sim.CodeStateRel functionTrace next (value :: source) + nextFrame := by + obtain ⟨location, box, runtimeCid, fields, runtimeValue, + sourceResolved, sourceGet, node, fieldAt, output⟩ := + IxIR1.runOp_fetch_success sourceRun + have valueEq : value = runtimeValue := by + exact congrArg Prod.snd output + subst runtimeValue + exact sidecars.simulate_traced_fetch_state_hpt selected environment + descendant state stores sourceResolved sourceGet node fieldAt control + +/-- A successful source shallow free determines its killed location. The +strong scalar-leaf HPT selection supplies both erased safety checks required +by `freeUnique`. -/ +theorem Sidecars.simulate_traced_free_freeUnique_state_of_run_hpt + (sidecars : Sidecars) + {sourceContext : IxIR1.Ctx} {sourceCurrent : IxIR1.FnDef} + {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + {targetCid : IxIR1.CtorId} {fact : IxIR1.HPT.Fact} + {sourceStore outputStore : IxIR1.Store} + {source : List IxIR1.RVal} + (selected : sidecars.scalarLeafAt? site sourceAtom = + some (fact, targetCid)) + (environment : sidecars.SiteEnvironmentHolds sourceStore site source) + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.free sourceAtom) index (.freeUnique targetAtom targetCid) next)) + (state : Lower.Sim.CodeStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.free sourceAtom) index (.freeUnique targetAtom targetCid) next) + source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (sourceRun : + IxIR1.runOp sourceContext (sourceFuel + 1) sourceCurrent sourceStore + source (.free sourceAtom) = .ok (outputStore, .erased)) + (control : machine.control = .running frame stack) : + ∃ location, + outputStore = sourceStore.kill location ∧ + let nextFrame : Eval.Frame := { frame with pc := frame.pc + 1 } + Eval.Step context interpretation machine + { machine with + store := machine.store.kill location + control := .running nextFrame stack } ∧ + Lower.Sim.StoreRel (sourceStore.kill location) + (machine.store.kill location) ∧ + Lower.Sim.CodeStateRel functionTrace next (.erased :: source) + nextFrame := by + obtain ⟨location, box, sourceResolved, sourceGet, unique, output⟩ := + IxIR1.runOp_free_success sourceRun + obtain ⟨exactBox, fields, exactGet, node, scalarFields⟩ := + sidecars.scalarLeafAt?_runtime selected environment sourceResolved + have boxEq : exactBox = box := + Option.some.inj (exactGet.symm.trans sourceGet) + subst exactBox + obtain ⟨_, targetStep, nextStores, nextState⟩ := + Lower.Sim.simulate_traced_free_freeUnique_state + (sourceContext := sourceContext) (sourceCurrent := sourceCurrent) + (sourceFuel := sourceFuel) descendant state stores sourceResolved + sourceGet unique node scalarFields control + exact ⟨location, congrArg Prod.fst output, targetStep, nextStores, + nextState⟩ + +/-- Attachment-facing fetch induction step. Trace membership recovers the +attachment-checked exact-constructor HPT evidence; the identity adapter +performs the target transition, and the checked post-fixpoint advances the +combined state to the recursive continuation. -/ +theorem CompiledAttachment.simulate_traced_fetch_state_of_run_hpt + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + {sourceField targetField : Nat} + {targetCid : IxIR1.CtorId} + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {value : IxIR1.RVal} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.fetch sourceAtom sourceField) index + (.fetch targetAtom targetCid targetField) next)) + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.fetch sourceAtom sourceField) index + (.fetch targetAtom targetCid targetField) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceRun : + IxIR1.runOp sourceContext (sourceFuel + 1) functionTrace.source sourceStore + source (.fetch sourceAtom sourceField) = .ok (sourceStore, value)) + (control : machine.control = .running frame stack) : + let nextFrame : Eval.Frame := + { frame with + pc := frame.pc + 1 + values := frame.values.push value } + IxIR1.runOp sourceContext (sourceFuel + 1) functionTrace.source sourceStore + source (.fetch sourceAtom sourceField) = .ok (sourceStore, value) ∧ + Eval.Step context interpretation machine + { machine with control := .running nextFrame stack } ∧ + Lower.Sim.StoreRel sourceStore machine.store ∧ + attached.sidecars.TraceStateRel functionTrace next sourceStore + (value :: source) nextFrame := by + obtain ⟨fact, selected⟩ := + attached.exactConstructorAt?_of_fetch_descendant functionMember descendant + obtain ⟨_, targetStep, nextStores, nextTarget⟩ := + attached.sidecars.simulate_traced_fetch_state_of_run_hpt selected + state.environment descendant state.target stores sourceRun control + have nextState := attached.traceState_next_of_member functionMember state + descendant sourceDeclarations sourceRun nextTarget + exact ⟨sourceRun, targetStep, nextStores, nextState⟩ + +/-- Attachment-facing shallow-free induction step. Trace membership recovers +the attachment-checked scalar-leaf HPT evidence, so all erased target safety, +source-coordinate, and continuation-state obligations are internal. -/ +theorem CompiledAttachment.simulate_traced_free_freeUnique_state_of_run_hpt + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + {targetCid : IxIR1.CtorId} + {sourceStore outputStore : IxIR1.Store} + {source : List IxIR1.RVal} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.free sourceAtom) index (.freeUnique targetAtom targetCid) next)) + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.free sourceAtom) index (.freeUnique targetAtom targetCid) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceRun : + IxIR1.runOp sourceContext (sourceFuel + 1) functionTrace.source sourceStore + source (.free sourceAtom) = .ok (outputStore, .erased)) + (control : machine.control = .running frame stack) : + ∃ location, + outputStore = sourceStore.kill location ∧ + let nextFrame : Eval.Frame := { frame with pc := frame.pc + 1 } + Eval.Step context interpretation machine + { machine with + store := machine.store.kill location + control := .running nextFrame stack } ∧ + Lower.Sim.StoreRel (sourceStore.kill location) + (machine.store.kill location) ∧ + attached.sidecars.TraceStateRel functionTrace next outputStore + (.erased :: source) nextFrame := by + obtain ⟨fact, selected⟩ := + attached.scalarLeafAt?_of_free_descendant functionMember descendant + obtain ⟨location, outputStoreEq, targetStep, nextStores, nextTarget⟩ := + attached.sidecars.simulate_traced_free_freeUnique_state_of_run_hpt + selected state.environment descendant state.target stores + sourceRun control + subst outputStore + have nextState := attached.traceState_next_of_member functionMember state + descendant sourceDeclarations sourceRun nextTarget + exact ⟨location, rfl, targetStep, nextStores, nextState⟩ + +/-! ## Continuation-passing recursive simulation interface -/ + +/-- A target-machine postcondition indexed by the source store and value that +the current IxIR₁ computation has produced. Keeping those indices explicit +lets a callee-return handler resume the suspended source continuation before +the eventual whole-main postcondition is discharged. -/ +abbrev SourceMachinePost := + IxIR1.Store → IxIR1.RVal → Eval.Machine → Prop + +/-- Finite target execution from `machine` to a state satisfying the supplied +source-indexed postcondition. The exact control-step count remains available +for the final `runMachine`/`runMain` budget witness. -/ +def ReachesPost (context : Eval.Context) + (interpretation : Eval.Interpretation) (post : SourceMachinePost) + (sourceStore : IxIR1.Store) (value : IxIR1.RVal) + (machine : Eval.Machine) : Prop := + ∃ count final, + Eval.Steps context interpretation count machine final ∧ + post sourceStore value final + +/-- A postcondition already true at the current machine needs no target +control step. -/ +theorem ReachesPost.refl {context : Eval.Context} + {interpretation : Eval.Interpretation} {post : SourceMachinePost} + {sourceStore : IxIR1.Store} {value : IxIR1.RVal} + {machine : Eval.Machine} (holds : post sourceStore value machine) : + ReachesPost context interpretation post sourceStore value machine := by + exact ⟨0, machine, .refl machine, holds⟩ + +/-- Prefix a finite postcondition witness by another finite target execution. +This is the CPS composition rule used after every emitted instruction, switch +transfer, call entry, and return transition. -/ +theorem ReachesPost.prepend {context : Eval.Context} + {interpretation : Eval.Interpretation} {post : SourceMachinePost} + {sourceStore : IxIR1.Store} {value : IxIR1.RVal} + {before middle : Eval.Machine} {prefixCount : Nat} + (initial : Eval.Steps context interpretation prefixCount before middle) + (tail : ReachesPost context interpretation post sourceStore value middle) : + ReachesPost context interpretation post sourceStore value before := by + obtain ⟨tailCount, final, tailSteps, finalPost⟩ := tail + exact ⟨prefixCount + tailCount, final, initial.trans tailSteps, finalPost⟩ + +/-- One genuine running target step followed by a successful CPS tail. -/ +theorem ReachesPost.step {context : Eval.Context} + {interpretation : Eval.Interpretation} {post : SourceMachinePost} + {sourceStore : IxIR1.Store} {value : IxIR1.RVal} + {before middle : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + (running : before.control = .running frame stack) + (head : Eval.Step context interpretation before middle) + (tail : ReachesPost context interpretation post sourceStore value middle) : + ReachesPost context interpretation post sourceStore value before := by + exact tail.prepend (head.toSteps running) + +/-- A machine control/store shape admits some sufficient initial heap budget +for a finite execution satisfying `post`. Heap fuel is selected backward +from the continuation: non-destructive steps preserve the chosen suffix, +while recursive release/drop steps prepend their own exact traversal cost. -/ +def BudgetedReachesPost (context : Eval.Context) + (interpretation : Eval.Interpretation) (post : SourceMachinePost) + (sourceStore : IxIR1.Store) (value : IxIR1.RVal) + (machine : Eval.Machine) : Prop := + ∃ heapFuel, + ReachesPost context interpretation post sourceStore value + { machine with heapFuel } + +/-- Prefix an already funded continuation by target steps that preserve every +chosen heap budget. -/ +theorem BudgetedReachesPost.prependPreserving {context : Eval.Context} + {interpretation : Eval.Interpretation} {post : SourceMachinePost} + {sourceStore : IxIR1.Store} {value : IxIR1.RVal} + {before middle : Eval.Machine} {prefixCount : Nat} + (initial : ∀ heapFuel, + Eval.Steps context interpretation prefixCount + { before with heapFuel } { middle with heapFuel }) + (tail : BudgetedReachesPost context interpretation post sourceStore value + middle) : + BudgetedReachesPost context interpretation post sourceStore value + before := by + obtain ⟨heapFuel, tail⟩ := tail + exact ⟨heapFuel, tail.prepend (initial heapFuel)⟩ + +/-- Prefix an already funded continuation by a target execution whose local +heap cost is framed over the continuation's chosen suffix. -/ +theorem BudgetedReachesPost.prependFramed {context : Eval.Context} + {interpretation : Eval.Interpretation} {post : SourceMachinePost} + {sourceStore : IxIR1.Store} {value : IxIR1.RVal} + {before middle : Eval.Machine} {prefixCount localFuel : Nat} + (initial : ∀ suffixFuel, + Eval.Steps context interpretation prefixCount + { before with heapFuel := localFuel + suffixFuel } + { middle with heapFuel := suffixFuel }) + (tail : BudgetedReachesPost context interpretation post sourceStore value + middle) : + BudgetedReachesPost context interpretation post sourceStore value + before := by + obtain ⟨suffixFuel, tail⟩ := tail + exact ⟨localFuel + suffixFuel, tail.prepend (initial suffixFuel)⟩ + +/-! ## Runtime constructor-universe closure + +Ambiguous IxIR₁ cases erase the inductive block component of constructor +identity and dispatch only on `cidx`. The lowerer therefore emits every +producer-known full identity compatible with an arm. The following invariant +is the dynamic half of that argument: every live source constructor was +allocated by a statically audited operation in the attached program. -/ + +/-- Every live constructor node belongs to the producer's finite constructor +universe, with the arity recorded by the sidecar. -/ +structure Sidecars.SourceConstructorsValid (sidecars : Sidecars) + (store : IxIR1.Store) : Prop where + constructorKnown : ∀ {location world rc identity fields}, + store.get? location = + some ⟨world, rc, .ctorN identity fields⟩ → + sidecars.constructorKnown identity fields.size = true + +/-- Every callable source definition has passed the constructor-allocation +audit. -/ +def Sidecars.ContextConstructorsKnown (sidecars : Sidecars) + (context : IxIR1.Ctx) : Prop := + ∀ {address definition}, + context.decls address = some (.fn definition) → + sidecars.codeConstructorsKnown definition.body = true + +namespace Sidecars.SourceConstructorsValid + +/-- The empty source heap contains no constructor outside the universe. -/ +theorem empty (sidecars : Sidecars) : + sidecars.SourceConstructorsValid ({} : IxIR1.Store) := by + constructor + intro location world rc identity fields found + simp [IxIR1.Store.get?] at found + +/-- Removing nodes or changing only reference counts preserves membership in +the constructor universe. -/ +theorem ofRestricts {sidecars : Sidecars} {before after : IxIR1.Store} + (valid : sidecars.SourceConstructorsValid before) + (restricts : IxIR1.Sim.StoreGraphRestricts before after) : + sidecars.SourceConstructorsValid after := by + constructor + intro location world rc identity fields found + obtain ⟨beforeRc, beforeFound⟩ := restricts found + exact valid.constructorKnown beforeFound + +/-- Appending a constructor whose identity/arity is audited preserves the +global invariant. -/ +theorem allocCtor {sidecars : Sidecars} {store : IxIR1.Store} + (valid : sidecars.SourceConstructorsValid store) + (world : Ixon.Owned) (identity : CtorId) + (fields : Array IxIR1.RVal) + (known : sidecars.constructorKnown identity fields.size = true) : + sidecars.SourceConstructorsValid + (store.allocNode world (.ctorN identity fields)).1 := by + constructor + intro location boxWorld rc foundIdentity foundFields found + by_cases fresh : location = store.nodes.size + · subst location + have allocated := IxIR1.Sim.HeapIso.get?_allocNode_new store world + (.ctorN identity fields) + have boxEq : + (⟨boxWorld, rc, .ctorN foundIdentity foundFields⟩ : IxIR1.NodeBox) = + ⟨world, 1, .ctorN identity fields⟩ := + Option.some.inj (found.symm.trans allocated) + cases boxEq + exact known + · exact valid.constructorKnown + (IxIR1.Sim.HeapIso.get?_of_allocNode_old fresh found) + +/-- Appending a PAP introduces no constructor node. -/ +theorem allocPap {sidecars : Sidecars} {store : IxIR1.Store} + (valid : sidecars.SourceConstructorsValid store) + (world : Ixon.Owned) (address : Ixon.Address) (arity : Nat) + (captured : Array IxIR1.RVal) : + sidecars.SourceConstructorsValid + (store.allocNode world (.papN address arity captured)).1 := by + constructor + intro location boxWorld rc identity fields found + by_cases fresh : location = store.nodes.size + · subst location + have allocated := IxIR1.Sim.HeapIso.get?_allocNode_new store world + (.papN address arity captured) + have impossible : + (⟨boxWorld, rc, .ctorN identity fields⟩ : IxIR1.NodeBox) = + ⟨world, 1, .papN address arity captured⟩ := + Option.some.inj (found.symm.trans allocated) + cases impossible + · exact valid.constructorKnown + (IxIR1.Sim.HeapIso.get?_of_allocNode_old fresh found) + +/-- Replacing a live slot by a known constructor preserves the invariant. +The result shape includes the evaluator's reuse-counter tick. -/ +theorem reuseCtor {sidecars : Sidecars} {store : IxIR1.Store} + (valid : sidecars.SourceConstructorsValid store) + {location : Nat} {old : IxIR1.NodeBox} + (live : store.get? location = some old) + (identity : CtorId) (fields : Array IxIR1.RVal) + (known : sidecars.constructorKnown identity fields.size = true) : + sidecars.SourceConstructorsValid + { store.setBox location + ⟨.unique, 1, .ctorN identity fields⟩ with + reuses := + (store.setBox location + ⟨.unique, 1, .ctorN identity fields⟩).reuses + 1 } := by + constructor + intro other world rc foundIdentity foundFields found + change (store.setBox location + ⟨.unique, 1, .ctorN identity fields⟩).get? other = + some ⟨world, rc, .ctorN foundIdentity foundFields⟩ at found + by_cases same : location = other + · subst other + have updated := IxIR1.Sim.get?_setBox_same + (new := (⟨.unique, 1, .ctorN identity fields⟩ : IxIR1.NodeBox)) live + have boxEq : + (⟨world, rc, .ctorN foundIdentity foundFields⟩ : IxIR1.NodeBox) = + ⟨.unique, 1, .ctorN identity fields⟩ := + Option.some.inj (found.symm.trans updated) + cases boxEq + exact known + · exact valid.constructorKnown + (IxIR1.Sim.get?_of_setBox_other same live found) + +/-- Retaining shared roots changes reference counts only. -/ +theorem dupVals {sidecars : Sidecars} {store store' : IxIR1.Store} + {values : List IxIR1.RVal} + (valid : sidecars.SourceConstructorsValid store) + (run : IxIR1.dupVals store values = .ok store') : + sidecars.SourceConstructorsValid store' := by + induction values generalizing store with + | nil => + change (.ok store : Except IxIR1.Err IxIR1.Store) = .ok store' at run + injection run with storeEq + subst store' + exact valid + | cons head tail ih => + cases head with + | lit literal => + simp only [IxIR1.dupVals, List.foldlM_cons] at run + exact ih valid run + | erased => + simp only [IxIR1.dupVals, List.foldlM_cons] at run + exact ih valid run + | loc location => + simp only [IxIR1.dupVals, List.foldlM_cons] at run + cases found : store.get? location with + | none => simp [found] at run + | some box => + cases box with + | mk world rc node => + cases world with + | unique => simp [found] at run + | shared => + simp only [found] at run + exact ih + (valid.ofRestricts + (IxIR1.Sim.StoreGraphRestricts.incRcStore found)) + run + +/-- Shared destruction can only remove nodes or alter reference counts. -/ +theorem dropVal {sidecars : Sidecars} {context : IxIR1.Ctx} {fuel : Nat} + {store store' : IxIR1.Store} {value : IxIR1.RVal} + (valid : sidecars.SourceConstructorsValid store) + (run : IxIR1.dropVal context fuel store value = .ok store') : + sidecars.SourceConstructorsValid store' := + valid.ofRestricts (IxIR1.Sim.dropVal_restricts run) + +/-- Dropping a list likewise cannot introduce a constructor. -/ +theorem dropMany {sidecars : Sidecars} {context : IxIR1.Ctx} {fuel : Nat} + {store store' : IxIR1.Store} {values : List IxIR1.RVal} + (valid : sidecars.SourceConstructorsValid store) + (run : IxIR1.dropMany context fuel store values = .ok store') : + sidecars.SourceConstructorsValid store' := + valid.ofRestricts (IxIR1.Sim.dropMany_restricts run) + +/-- Unique destruction also only removes nodes. -/ +theorem dropUVal {sidecars : Sidecars} {context : IxIR1.Ctx} {fuel : Nat} + {store store' : IxIR1.Store} {value : IxIR1.RVal} + (valid : sidecars.SourceConstructorsValid store) + (run : IxIR1.dropUVal context fuel store value = .ok store') : + sidecars.SourceConstructorsValid store' := + valid.ofRestricts (IxIR1.Sim.dropUVal_restricts run) + +end Sidecars.SourceConstructorsValid + +/-- Reflect a successful finite-universe lookup into the constructor-info +witness consumed by residual switch coverage. -/ +theorem Sidecars.constructorKnown_witness (sidecars : Sidecars) + {identity : CtorId} {arity : Nat} + (known : sidecars.constructorKnown identity arity = true) : + ∃ info ∈ sidecars.constructors, + info.identity = identity ∧ info.arity = arity := by + unfold Sidecars.constructorKnown at known + cases found : sidecars.constructors.find? + (fun info => info.identity == identity) with + | none => simp [found] at known + | some info => + have matched := List.find?_some found + have identityEq : info.identity = identity := beq_iff_eq.mp matched + exact ⟨info, List.mem_of_find?_eq_some found, identityEq, + beq_iff_eq.mp (by simpa [found] using known)⟩ + +/-- The source-body half of the attachment audit selects any retained +function. -/ +theorem CompiledAttachment.functionCodeConstructorsKnown + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {functionTrace : Lower.FunctionTrace} + (member : functionTrace ∈ attached.target.artifact.trace.functions) : + attached.sidecars.codeConstructorsKnown + functionTrace.source.body = true := by + have functionKnown := List.all_eq_true.mp + attached.sourceConstructorsProduced functionTrace member + simp only [Bool.and_eq_true] at functionKnown + exact functionKnown.1 + +/-- The trace-shaped half of the attachment audit selects any retained +function root. -/ +theorem CompiledAttachment.functionTraceConstructorsKnown + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {functionTrace : Lower.FunctionTrace} + (member : functionTrace ∈ attached.target.artifact.trace.functions) : + attached.sidecars.codeTraceConstructorsKnown functionTrace.root = true := by + have functionKnown := List.all_eq_true.mp + attached.sourceConstructorsProduced functionTrace member + simp only [Bool.and_eq_true] at functionKnown + exact functionKnown.2 + +/-- Every operation at a retained simulated suffix passed the producer +constructor audit. -/ +theorem CompiledAttachment.descendantOperationConstructorsKnown + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {functionTrace : Lower.FunctionTrace} + (member : functionTrace ∈ attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {operation : IxIR1.Op} {instruction : Instr} {next : Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount operation index + instruction next)) : + attached.sidecars.operationConstructorsKnown operation = true := by + have localKnown := attached.sidecars.codeTraceConstructorsKnown_descendant + (attached.functionTraceConstructorsKnown member) descendant + simp only [Sidecars.codeTraceConstructorsKnown, + Bool.and_eq_true] at localKnown + exact localKnown.1 + +/-- A declaration-compatible source evaluator context inherits the audited +constructor-allocation property from the attached function trace. -/ +theorem CompiledAttachment.sourceContextConstructorsKnown + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv + attached.source.lowering.result.artifacts) : + attached.sidecars.ContextConstructorsKnown sourceContext := by + intro address definition lookup + have sidecarLookup : IxIR1.Env.ofList + attached.sidecars.input.declarations address = + some (.fn definition) := by + rw [attached.sidecarDeclarationEnvironment, ← sourceDeclarations] + exact lookup + have artifactLookup : IxIR1.Env.ofList + attached.target.artifact.source.declarations address = + some (.fn definition) := by + rw [attached.targetSourceProduced] + exact sidecarLookup + obtain ⟨targetDefinition, functionTrace, targetLookup, member, matched⟩ := + attached.target.artifact.functionTrace_of_source_lookup artifactLookup + simpa [matched.source] using + attached.functionCodeConstructorsKnown member + +private def EvalConstructorsValidAt (sidecars : Sidecars) + (fuel : Nat) : Prop := + (∀ context current store environment code store' value, + sidecars.ContextConstructorsKnown context → + sidecars.codeConstructorsKnown current.body = true → + sidecars.codeConstructorsKnown code = true → + sidecars.SourceConstructorsValid store → + IxIR1.runCode context fuel current store environment code = + .ok (store', value) → + sidecars.SourceConstructorsValid store') ∧ + (∀ context current store environment operation store' value, + sidecars.ContextConstructorsKnown context → + sidecars.codeConstructorsKnown current.body = true → + sidecars.operationConstructorsKnown operation = true → + sidecars.SourceConstructorsValid store → + IxIR1.runOp context fuel current store environment operation = + .ok (store', value) → + sidecars.SourceConstructorsValid store') ∧ + (∀ context address arguments store store' value, + sidecars.ContextConstructorsKnown context → + sidecars.SourceConstructorsValid store → + IxIR1.invoke context fuel address arguments store = .ok (store', value) → + sidecars.SourceConstructorsValid store') ∧ + (∀ context store function arguments store' value, + sidecars.ContextConstructorsKnown context → + sidecars.SourceConstructorsValid store → + IxIR1.applyGo context fuel store function arguments = + .ok (store', value) → + sidecars.SourceConstructorsValid store') + +private theorem constructorsBindOk {error α β : Type} (value : α) + (next : α → Except error β) : + ((Except.ok value : Except error α) >>= next) = next value := rfl + +private theorem constructorsBindError {error α β : Type} (failure : error) + (next : α → Except error β) : + ((Except.error failure : Except error α) >>= next) = .error failure := rfl + +/-- Source evaluation preserves the producer constructor universe. The +induction follows calls and higher-order application; fresh constructor and +reuse sites are the only branches that need their local executable audit. -/ +private theorem evalConstructorsValidAt (sidecars : Sidecars) : + ∀ fuel, EvalConstructorsValidAt sidecars fuel := by + intro fuel + induction fuel with + | zero => + refine ⟨?_, ?_, ?_, ?_⟩ + · intro context current store environment code store' value contextKnown + currentKnown codeKnown valid run + rw [IxIR1.runCode.eq_def] at run + simp at run + · intro context current store environment operation store' value + contextKnown currentKnown operationKnown valid run + rw [IxIR1.runOp.eq_def] at run + simp at run + · intro context address arguments store store' value contextKnown valid run + rw [IxIR1.invoke.eq_def] at run + simp at run + · intro context store function arguments store' value contextKnown valid run + rw [IxIR1.applyGo.eq_def] at run + simp at run + | succ fuel ih => + obtain ⟨ihCode, ihOperation, ihInvoke, ihApply⟩ := ih + refine ⟨?_, ?_, ?_, ?_⟩ + · intro context current store environment code store' value contextKnown + currentKnown codeKnown valid run + cases code with + | ret atom => + rw [IxIR1.runCode.eq_def] at run + dsimp only at run + cases resolved : IxIR1.resolveAtom environment atom with + | error error => simp [resolved] at run + | ok result => + rw [resolved, constructorsBindOk] at run + have pair := Except.ok.inj run + cases pair + exact valid + | letOp operation rest => + simp only [Sidecars.codeConstructorsKnown, + Bool.and_eq_true] at codeKnown + rw [IxIR1.runCode.eq_def] at run + dsimp only at run + cases operationRun : IxIR1.runOp context fuel current store + environment operation with + | error error => simp [operationRun] at run + | ok result => + rcases result with ⟨middle, operationValue⟩ + rw [operationRun, constructorsBindOk] at run + exact ihCode _ _ _ _ _ _ _ contextKnown currentKnown + codeKnown.2 + (ihOperation _ _ _ _ _ _ _ contextKnown currentKnown + codeKnown.1 valid operationRun) + run + | case scrutinee peelNat alternatives => + rw [IxIR1.runCode.eq_def] at run + dsimp only at run + cases resolved : IxIR1.resolveAtom environment scrutinee with + | error error => simp [resolved] at run + | ok scrutineeValue => + rw [resolved, constructorsBindOk] at run + cases scrutineeValue with + | loc location => + cases found : store.get? location with + | none => simp [found] at run + | some box => + simp only [found] at run + cases box with + | mk world rc node => + cases node with + | papN address arity captured => simp at run + | ctorN identity fields => + cases selected : alternatives.find? + (fun alternative => + alternative.cidx == identity.cidx) with + | none => simp [selected] at run + | some alternative => + have alternativeMember : alternative ∈ + alternatives := + Array.mem_of_find?_eq_some selected + cases alternative with + | mk cidx fieldCount body => + have bodyKnown := + sidecars.codeConstructorsKnown_alternative + codeKnown alternativeMember + cases sizeMismatch : + fields.size != fieldCount + · simp only [selected, sizeMismatch, + Bool.false_eq_true, if_false] at run + exact ihCode _ _ _ _ _ _ _ contextKnown + currentKnown bodyKnown valid run + · simp [selected, sizeMismatch] at run + | lit literal => + cases literal with + | str string => simp at run + | nat n => + cases peel : peelNat with + | false => simp [peel] at run + | true => + cases n with + | zero => + cases selected : alternatives.find? + (fun alternative => + alternative.cidx == 0) with + | none => simp [peel, selected] at run + | some alternative => + have alternativeMember : alternative ∈ + alternatives := + Array.mem_of_find?_eq_some selected + cases alternative with + | mk cidx fieldCount body => + have bodyKnown := + sidecars.codeConstructorsKnown_alternative + codeKnown alternativeMember + cases fieldCount with + | zero => + simp only [peel, selected] at run + exact ihCode _ _ _ _ _ _ _ + contextKnown currentKnown bodyKnown + valid run + | succ fieldCount => + simp [peel, selected] at run + | succ n => + cases selected : alternatives.find? + (fun alternative => + alternative.cidx == 1) with + | none => simp [peel, selected] at run + | some alternative => + have alternativeMember : alternative ∈ + alternatives := + Array.mem_of_find?_eq_some selected + cases alternative with + | mk cidx fieldCount body => + have bodyKnown := + sidecars.codeConstructorsKnown_alternative + codeKnown alternativeMember + cases fieldCount with + | zero => simp [peel, selected] at run + | succ fieldCount => + cases fieldCount with + | zero => + simp only [peel, selected] at run + exact ihCode _ _ _ _ _ _ _ + contextKnown currentKnown + bodyKnown valid run + | succ fieldCount => + simp [peel, selected] at run + | erased => simp at run + · intro context current store environment operation store' value + contextKnown currentKnown operationKnown valid run + cases operation with + | pure atom => + rw [IxIR1.runOp.eq_def] at run + dsimp only at run + cases resolved : IxIR1.resolveAtom environment atom with + | error error => simp [resolved] at run + | ok result => + rw [resolved, constructorsBindOk] at run + have pair := Except.ok.inj run + cases pair + exact valid + | alloc world identity atoms => + simp only [Sidecars.operationConstructorsKnown] at operationKnown + rw [IxIR1.runOp.eq_def] at run + dsimp only at run + cases resolved : IxIR1.resolveAtoms environment atoms with + | error error => simp [resolved] at run + | ok values => + rw [resolved, constructorsBindOk] at run + have pair := Except.ok.inj run + cases pair + have size : values.toArray.size = atoms.size := by + simpa using IxIR1.resolveAtoms_length resolved + exact valid.allocCtor world identity values.toArray + (by simpa [size] using operationKnown) + | reuse target identity atoms => + simp only [Sidecars.operationConstructorsKnown] at operationKnown + rw [IxIR1.runOp.eq_def] at run + dsimp only at run + cases argumentsResolved : IxIR1.resolveAtoms environment atoms with + | error error => simp [argumentsResolved] at run + | ok values => + rw [argumentsResolved, constructorsBindOk] at run + cases targetResolved : IxIR1.resolveAtom environment target with + | error error => simp [targetResolved] at run + | ok targetValue => + rw [targetResolved, constructorsBindOk] at run + cases targetValue with + | lit literal => simp at run + | erased => simp at run + | loc location => + cases found : store.get? location with + | none => simp [found] at run + | some box => + simp only [found] at run + cases box with + | mk world rc node => + cases world with + | shared => simp at run + | unique => + have pair := Except.ok.inj run + cases pair + have size : values.toArray.size = atoms.size := + by + simpa using + IxIR1.resolveAtoms_length + argumentsResolved + exact valid.reuseCtor found identity + values.toArray + (by simpa [size] using operationKnown) + | free target => + rw [IxIR1.runOp.eq_def] at run + dsimp only at run + cases resolved : IxIR1.resolveAtom environment target with + | error error => simp [resolved] at run + | ok targetValue => + rw [resolved, constructorsBindOk] at run + cases targetValue with + | lit literal => simp at run + | erased => simp at run + | loc location => + cases found : store.get? location with + | none => simp [found] at run + | some box => + simp only [found] at run + cases box with + | mk world rc node => + cases world with + | shared => simp at run + | unique => + have pair := Except.ok.inj run + cases pair + exact valid.ofRestricts + (IxIR1.Sim.StoreGraphRestricts.kill found) + | dup target => + rw [IxIR1.runOp.eq_def] at run + dsimp only at run + cases resolved : IxIR1.resolveAtom environment target with + | error error => simp [resolved] at run + | ok targetValue => + rw [resolved, constructorsBindOk] at run + cases targetValue with + | lit literal => + have pair := Except.ok.inj run + cases pair + exact valid + | erased => + have pair := Except.ok.inj run + cases pair + exact valid + | loc location => + cases found : store.get? location with + | none => simp [found] at run + | some box => + simp only [found] at run + cases box with + | mk world rc node => + cases world with + | unique => simp at run + | shared => + have pair := Except.ok.inj run + cases pair + simpa [IxIR1.Sim.incRcStore] using + valid.ofRestricts + (IxIR1.Sim.StoreGraphRestricts.incRcStore + found) + | drop target => + rw [IxIR1.runOp.eq_def] at run + dsimp only at run + cases resolved : IxIR1.resolveAtom environment target with + | error error => simp [resolved] at run + | ok targetValue => + rw [resolved, constructorsBindOk] at run + cases targetValue with + | lit literal => + have pair := Except.ok.inj run + cases pair + exact valid + | erased => + have pair := Except.ok.inj run + cases pair + exact valid + | loc location => + dsimp only at run + cases dropped : IxIR1.dropVal context fuel store + (.loc location) with + | error error => simp [dropped] at run + | ok droppedStore => + rw [dropped, constructorsBindOk] at run + have pair := Except.ok.inj run + cases pair + exact valid.dropVal dropped + | dropU target => + rw [IxIR1.runOp.eq_def] at run + dsimp only at run + cases resolved : IxIR1.resolveAtom environment target with + | error error => simp [resolved] at run + | ok targetValue => + rw [resolved, constructorsBindOk] at run + cases targetValue with + | lit literal => + have pair := Except.ok.inj run + cases pair + exact valid + | erased => + have pair := Except.ok.inj run + cases pair + exact valid + | loc location => + dsimp only at run + cases dropped : IxIR1.dropUVal context fuel store + (.loc location) with + | error error => simp [dropped] at run + | ok droppedStore => + rw [dropped, constructorsBindOk] at run + have pair := Except.ok.inj run + cases pair + exact valid.dropUVal dropped + | fetch target field => + rw [IxIR1.runOp.eq_def] at run + dsimp only at run + cases resolved : IxIR1.resolveAtom environment target with + | error error => simp [resolved] at run + | ok targetValue => + rw [resolved, constructorsBindOk] at run + cases targetValue with + | lit literal => simp at run + | erased => simp at run + | loc location => + cases found : store.get? location with + | none => simp [found] at run + | some box => + simp only [found] at run + cases box with + | mk world rc node => + cases node with + | papN address arity captured => simp at run + | ctorN identity fields => + cases fieldFound : fields[field]? with + | none => simp [fieldFound] at run + | some result => + simp only [fieldFound] at run + have pair := Except.ok.inj run + cases pair + exact valid + | call address atoms => + rw [IxIR1.runOp.eq_def] at run + dsimp only at run + cases resolved : IxIR1.resolveAtoms environment atoms with + | error error => simp [resolved] at run + | ok values => + rw [resolved, constructorsBindOk] at run + exact ihInvoke _ _ _ _ _ _ contextKnown valid run + | callSelf atoms => + rw [IxIR1.runOp.eq_def] at run + dsimp only at run + cases resolved : IxIR1.resolveAtoms environment atoms with + | error error => simp [resolved] at run + | ok values => + rw [resolved, constructorsBindOk] at run + cases arityMismatch : values.length != current.arity + · have sameArity : values.length = current.arity := by + simpa using arityMismatch + simp [sameArity] at run + cases bodyRun : IxIR1.runCode context fuel current store + values.reverse current.body with + | error error => + rw [bodyRun, constructorsBindError] at run + contradiction + | ok result => + rcases result with ⟨bodyStore, bodyValue⟩ + rw [bodyRun, constructorsBindOk] at run + obtain ⟨resultEq, _⟩ := IxIR1.Sim.checkResultWorld_ok run + cases resultEq + exact ihCode _ _ _ _ _ _ _ contextKnown currentKnown + currentKnown valid bodyRun + · have different : values.length ≠ current.arity := + bne_iff_ne.mp arityMismatch + simp [different] at run + | papp address atoms => + rw [IxIR1.runOp.eq_def] at run + dsimp only at run + cases resolved : IxIR1.resolveAtoms environment atoms with + | error error => simp [resolved] at run + | ok values => + rw [resolved, constructorsBindOk] at run + cases declarationFound : context.decls address with + | none => simp [declarationFound] at run + | some declaration => + simp only [declarationFound] at run + by_cases under : values.length < IxIR1.declArity declaration + · simp only [under, if_true] at run + have pair := Except.ok.inj run + cases pair + exact valid.allocPap .shared address + (IxIR1.declArity declaration) values.toArray + · simp [under] at run + | apply function atoms => + rw [IxIR1.runOp.eq_def] at run + dsimp only at run + cases functionResolved : IxIR1.resolveAtom environment function with + | error error => simp [functionResolved] at run + | ok functionValue => + rw [functionResolved, constructorsBindOk] at run + cases argumentsResolved : IxIR1.resolveAtoms environment atoms with + | error error => simp [argumentsResolved] at run + | ok values => + rw [argumentsResolved, constructorsBindOk] at run + exact ihApply _ _ _ _ _ _ contextKnown valid run + | extern address atoms => + rw [IxIR1.runOp.eq_def] at run + dsimp only at run + cases resolved : IxIR1.resolveAtoms environment atoms with + | error error => simp [resolved] at run + | ok values => + rw [resolved, constructorsBindOk] at run + cases called : IxIR1.callScalarOracle context address values with + | error error => simp [called] at run + | ok result => + rw [called, constructorsBindOk] at run + have pair := Except.ok.inj run + cases pair + exact valid + · intro context address arguments store store' value contextKnown valid run + rw [IxIR1.invoke.eq_def] at run + dsimp only at run + cases declarationFound : context.decls address with + | none => simp [declarationFound] at run + | some declaration => + simp only [declarationFound] at run + cases declaration with + | extern arity => + cases arityMismatch : arguments.length != arity + · simp only [arityMismatch, Bool.false_eq_true, if_false] at run + cases called : IxIR1.callScalarOracle context address + arguments with + | error error => simp [called] at run + | ok result => + simp only [called] at run + have pair := Except.ok.inj run + cases pair + exact valid + · simp [arityMismatch] at run + | fn definition => + cases arityMismatch : arguments.length != definition.arity + · simp only [arityMismatch, Bool.false_eq_true, if_false] at run + cases bodyRun : IxIR1.runCode context fuel definition store + arguments.reverse definition.body with + | error error => simp [bodyRun] at run + | ok result => + rcases result with ⟨bodyStore, bodyValue⟩ + rw [bodyRun, constructorsBindOk] at run + obtain ⟨resultEq, _⟩ := IxIR1.Sim.checkResultWorld_ok run + cases resultEq + have bodyKnown := contextKnown declarationFound + exact ihCode _ _ _ _ _ _ _ contextKnown bodyKnown + bodyKnown valid bodyRun + · simp [arityMismatch] at run + · intro context store function arguments store' value contextKnown valid run + rw [IxIR1.applyGo.eq_def] at run + dsimp only at run + cases function with + | lit literal => simp at run + | erased => + cases dropped : IxIR1.dropMany context fuel store arguments with + | error error => simp [dropped] at run + | ok droppedStore => + rw [dropped, constructorsBindOk] at run + have pair := Except.ok.inj run + cases pair + exact valid.dropMany dropped + | loc location => + cases found : store.get? location with + | none => simp [found] at run + | some box => + simp only [found] at run + cases box with + | mk world rc node => + cases node with + | ctorN identity fields => simp at run + | papN address arity captured => + dsimp only at run + cases retained : IxIR1.dupVals store captured.toList with + | error error => simp [retained] at run + | ok retainedStore => + rw [retained, constructorsBindOk] at run + cases released : IxIR1.dropVal context fuel + retainedStore (.loc location) with + | error error => simp [released] at run + | ok readyStore => + rw [released, constructorsBindOk] at run + have readyValid := + (valid.dupVals retained).dropVal released + by_cases under : + (captured.toList ++ arguments).length < arity + · simp only [under, if_true] at run + have pair := Except.ok.inj run + cases pair + exact readyValid.allocPap .shared address arity + (captured.toList ++ arguments).toArray + · simp only [under, if_false] at run + by_cases exactArity : + (captured.toList ++ arguments).length = arity + · simp only [exactArity, beq_self_eq_true, + if_true] at run + cases declarationFound : + context.decls address with + | none => simp [declarationFound] at run + | some declaration => + cases papSafe : + IxIR1.declPapSafe declaration with + | false => + simp [declarationFound, papSafe] at run + | true => + simp only [declarationFound, papSafe, + if_true] at run + exact ihInvoke _ _ _ _ _ _ + contextKnown readyValid run + · have notExact : + ((captured.toList ++ arguments).length == + arity) = false := + beq_eq_false_iff_ne.mpr exactArity + simp only [notExact, Bool.false_eq_true, + if_false] at run + cases declarationFound : + context.decls address with + | none => simp [declarationFound] at run + | some declaration => + cases papSafe : + IxIR1.declPapSafe declaration with + | false => + simp [declarationFound, papSafe] at run + | true => + simp only [declarationFound, papSafe, + if_true] at run + cases invoked : IxIR1.invoke context + fuel address + ((captured.toList ++ arguments).take + arity) readyStore with + | error error => simp [invoked] at run + | ok called => + rcases called with + ⟨calledStore, calledValue⟩ + simp only [invoked] at run + exact ihApply _ _ _ _ _ _ + contextKnown + (ihInvoke _ _ _ _ _ _ + contextKnown readyValid invoked) + run + +/-- Operation-level projection of constructor-universe preservation. -/ +theorem Sidecars.SourceConstructorsValid.runOp + {sidecars : Sidecars} {context : IxIR1.Ctx} {fuel : Nat} + {current : IxIR1.FnDef} {store store' : IxIR1.Store} + {environment : List IxIR1.RVal} {operation : IxIR1.Op} + {value : IxIR1.RVal} + (contextKnown : sidecars.ContextConstructorsKnown context) + (currentKnown : sidecars.codeConstructorsKnown current.body = true) + (operationKnown : sidecars.operationConstructorsKnown operation = true) + (valid : sidecars.SourceConstructorsValid store) + (run : IxIR1.runOp context fuel current store environment operation = + .ok (store', value)) : + sidecars.SourceConstructorsValid store' := + (evalConstructorsValidAt sidecars fuel).2.1 _ _ _ _ _ _ _ contextKnown + currentKnown operationKnown valid run + +/-- Higher-order application projection of constructor-universe +preservation. -/ +theorem Sidecars.SourceConstructorsValid.applyGo + {sidecars : Sidecars} {context : IxIR1.Ctx} {fuel : Nat} + {store store' : IxIR1.Store} {function : IxIR1.RVal} + {arguments : List IxIR1.RVal} {value : IxIR1.RVal} + (contextKnown : sidecars.ContextConstructorsKnown context) + (valid : sidecars.SourceConstructorsValid store) + (run : IxIR1.applyGo context fuel store function arguments = + .ok (store', value)) : + sidecars.SourceConstructorsValid store' := + (evalConstructorsValidAt sidecars fuel).2.2.2 _ _ _ _ _ _ contextKnown + valid run + +/-- A final source heap is reachable through the attachment's certified +raw-to-emitted address action. This is deliberately an image predicate rather +than an injectivity requirement: several raw declarations may share one +content address. -/ +def CompiledAttachment.SourceStoreImage + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) (store : IxIR1.Store) : Prop := + ∃ sourceStore, + IxIR1.Readdress.Store.mapAddresses + (attached.source.lowering.result.rebuildRename + attached.source.lowering.raw) sourceStore = store ∧ + attached.sidecars.SourceConstructorsValid store + +/-- CPS boundary for a function return under one exact target continuation +stack. A handler is deliberately universal over the returning function and +terminal trace coordinates: the recursive worker discovers the actual `ret` +leaf, while the handler owns what happens after that return (halt, ordinary +resume, or `applyMore`). This lets tail calls reuse the enclosing handler +without rebuilding the unchanged target stack. -/ +def SuccessfulReturnHandler + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + (sourceContext : IxIR1.Ctx) (context : Eval.Context) + (interpretation : Eval.Interpretation) + (_functionTrace : Lower.FunctionTrace) + (frameRoots : List IxIR1.Sim.Root) + (stack : List Eval.Continuation) + (expected : IxIR1.Store × IxIR1.RVal) + (outcome : IxIR1.Store × IxIR1.RVal) + (post : SourceMachinePost) : Prop := + ∀ {returningTrace : Lower.FunctionTrace} + {sourceFuel : Nat} {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {generated : Block} + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {frame : Eval.Frame} {machine : Eval.Machine}, + returningTrace ∈ attached.target.artifact.trace.functions → + returningTrace.root.Descendant + (.ret site blockId input entryValueCount sourceAtom targetAtom + generated) → + attached.sidecars.TraceStateRel returningTrace + (.ret site blockId input entryValueCount sourceAtom targetAtom + generated) sourceStore source frame → + Lower.Sim.StoreRel sourceStore machine.store → + Lower.Sim.SourceRuntimeInvariant sourceStore source → + Lower.Sim.SourceOwnershipAt attached.target.artifact.trace.positions + (.ret site blockId input entryValueCount sourceAtom targetAtom generated) + sourceStore source frameRoots → + IxIR1.runCode sourceContext (sourceFuel + 1) returningTrace.source + sourceStore source (.ret sourceAtom) = .ok expected → + IxIR1.Sim.HasWorld expected.1 returningTrace.source.result expected.2 → + machine.control = .running frame stack → + frame.credits = #[] → + attached.SourceStoreImage sourceStore → + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine + +/-- The exact-fuel semantic worker property. Its source recursion is +continuation-passing: local trace steps keep the handler, ordinary calls build +a `.resume` handler for their callee, and over-application builds an +`applyMore` handler. This is the induction predicate whose closure at every +fuel yields `SuccessfulMainSimulation`. -/ +def SuccessfulTraceSimulationAt + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + (sourceContext : IxIR1.Ctx) (context : Eval.Context) + (interpretation : Eval.Interpretation) (fuel : Nat) : Prop := + ∀ {functionTrace : Lower.FunctionTrace} {trace : Lower.CodeTrace} + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + {sourceOutput : IxIR1.Store × IxIR1.RVal} + {outcome : IxIR1.Store × IxIR1.RVal} + {frame : Eval.Frame} {machine : Eval.Machine} + {stack : List Eval.Continuation} {post : SourceMachinePost}, + functionTrace ∈ attached.target.artifact.trace.functions → + functionTrace.root.Descendant trace → + attached.sidecars.TraceStateRel functionTrace trace sourceStore source + frame → + Lower.Sim.StoreRel sourceStore machine.store → + Lower.Sim.SourceRuntimeInvariant sourceStore source → + Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions trace sourceStore source + frameRoots → + IxIR1.runCode sourceContext fuel functionTrace.source sourceStore source + trace.sourceCode = .ok sourceOutput → + IxIR1.Sim.HasWorld sourceOutput.1 functionTrace.source.result + sourceOutput.2 → + machine.control = .running frame stack → + frame.credits = #[] → + attached.SourceStoreImage sourceStore → + SuccessfulReturnHandler attached sourceContext context interpretation + functionTrace frameRoots stack sourceOutput outcome post → + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine + +/-- Canonical IxIR₁ evaluator context named by an attached source artifact. -/ +def CompiledAttachment.simulationSourceContext + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) : IxIR1.Ctx := + { decls := + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts } + +/-- The canonical source context used by the IxIR₂ simulation is exactly +the final emitted IxIR₁ context with its closed-world oracle. -/ +theorem CompiledAttachment.simulationSourceContext_eq_addressedCtx + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) : + attached.simulationSourceContext = + attached.source.lowering.result.addressedCtx (fun _ _ => none) := by + unfold CompiledAttachment.simulationSourceContext + IxIR1.ReaddressAll.Result.addressedCtx + IxIR1.ReaddressAll.Result.asReaddressResult + IxIR1.ReaddressAll.Result.declarations + IxIR1.Readdress.Result.addressedCtx + IxIR1.Readdress.Result.declarations + simp only [List.append_nil] + congr 1 + change IxIR1.HPT.programDeclEnv + attached.source.lowering.result.artifacts = + IxIR1.Env.ofList (IxIR1.HPT.declarationEntries + attached.source.lowering.result.artifacts) + exact (IxIR1.HPT.OptimizeProgram.envOfList_declarationEntries + attached.source.lowering.result.artifacts).symm + +/-- The successful fully addressed lowering retained by an attachment exposes +the executable exact-source audit used by all raw-to-emitted provenance +arguments. -/ +theorem CompiledAttachment.sourceRebuildSemanticAudit + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) : + attached.source.lowering.result.rebuildSemanticAudit + attached.source.lowering.raw attached.source.lowering.mainCode = true := by + have hrun := + IxIR1.Lower.readdressAll_run_of_lowerAllIndexedFullyAddressed_eq_ok + attached.source.lowering.lowerRun + attached.source.lowering.addressedRun + exact IxIR1.ReaddressAll.rebuildSemanticAudit_of_run_eq_ok hrun + +/-- The rebuild audit supplies the exact context relation from the raw +lowerer output to the final emitted source context used by IxIR₂. -/ +theorem CompiledAttachment.sourceContextRenames + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) : + IxIR1.Readdress.Ctx.Renames + (attached.source.lowering.result.rebuildRename + attached.source.lowering.raw) + (attached.source.exactTargetCtx (fun _ _ => none)) + attached.simulationSourceContext := by + rw [attached.simulationSourceContext_eq_addressedCtx] + unfold Ix.Compiler.Pipeline.LoweredCompilation.exactTargetCtx + exact attached.source.lowering.result.renames_rebuildSourceCtx + attached.sourceRebuildSemanticAudit + (fun _ _ => none) + +/-- Declaration equality is enough to instantiate the raw-to-emitted context +relation for an arbitrary final oracle. The raw oracle is pulled back through +the same total address action. -/ +theorem CompiledAttachment.sourceContextRenamesOfDeclarations + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + (sourceContext : IxIR1.Ctx) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) : + IxIR1.Readdress.Ctx.Renames + (attached.source.lowering.result.rebuildRename + attached.source.lowering.raw) + (attached.source.exactTargetCtx sourceContext.oracle) sourceContext := by + have contexts := + attached.source.lowering.result.renames_rebuildSourceCtx + attached.sourceRebuildSemanticAudit sourceContext.oracle + unfold Ix.Compiler.Pipeline.LoweredCompilation.exactTargetCtx + have targetEq : attached.source.lowering.result.addressedCtx + sourceContext.oracle = sourceContext := by + cases sourceContext with + | mk declarations oracle => + simp only at sourceDeclarations + unfold IxIR1.ReaddressAll.Result.addressedCtx + IxIR1.ReaddressAll.Result.asReaddressResult + IxIR1.ReaddressAll.Result.declarations + IxIR1.Readdress.Result.addressedCtx + IxIR1.Readdress.Result.declarations + simp only [List.append_nil] + congr 1 + rw [sourceDeclarations] + exact IxIR1.HPT.OptimizeProgram.envOfList_declarationEntries + attached.source.lowering.result.artifacts + rw [targetEq] at contexts + exact contexts + +/-- Every literal source suffix retained by the checked IxIR₂ sidecar has an +exact raw IxIR₁ syntax preimage. The proof combines source-site traversal with +the rebuild audit's selected-declaration producer witness, so it remains valid +when content addressing merges equal declarations. -/ +theorem CompiledAttachment.sourceCodeAddressImage + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {site : Lower.SourceSite} {code : IxIR1.Code} + (found : attached.sidecars.sourceCodeAt? site = some code) : + ∃ rawCode, + IxIR1.Readdress.Code.mapAddresses + (attached.source.lowering.result.rebuildRename + attached.source.lowering.raw) rawCode = code := by + refine attached.sidecars.sourceCodeAt?_addressImage + (attached.source.lowering.result.rebuildRename + attached.source.lowering.raw) ?_ ?_ found + · refine ⟨attached.source.lowering.mainCode, ?_⟩ + rw [attached.inputProduced] + exact (attached.source.lowering.result.main_eq_rebuildMapAddresses + attached.sourceRebuildSemanticAudit).symm + · intro address definition lookup + rw [attached.inputProduced] at lookup + change IxIR1.Env.ofList attached.source.lowering.result.declarations + address = some (.fn definition) at lookup + obtain ⟨sourceAddress, sourceDeclaration, sourceLookup, renameEq, + declarationImage⟩ := + attached.source.lowering.result + |>.declaration_preimage_of_lookup_of_rebuildSemanticAudit + attached.sourceRebuildSemanticAudit lookup + cases sourceDeclaration with + | extern arity => + simp [IxIR1.Readdress.Decl.mapAddresses] at declarationImage + | fn sourceDefinition => + simp only [IxIR1.Readdress.Decl.mapAddresses, + IxIR1.Decl.fn.injEq] at declarationImage + exact ⟨sourceDefinition, declarationImage⟩ + +/-- Every retained IxIR₂ function trace names a final IxIR₁ function whose +body has an exact raw syntax preimage. Signature metadata is unchanged by +readdressing, so the body witness lifts to the complete function record. -/ +theorem CompiledAttachment.functionSourceAddressImage + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) : + ∃ rawDefinition, + IxIR1.Readdress.FnDef.mapAddresses + (attached.source.lowering.result.rebuildRename + attached.source.lowering.raw) rawDefinition = functionTrace.source := by + have rootFound : attached.sidecars.sourceCodeAt? + functionTrace.root.source = some functionTrace.root.sourceCode := by + by_cases owner : functionTrace.owner = .main + · have mainMatch := attached.target.artifact.functionTraceOrderProof + |>.main_of_mem_owner functionMember owner + simpa [functionTrace.rootSource, owner, functionTrace.rootSourceCode, + mainMatch.source, attached.targetSourceProduced, + Lower.Input.mainDefinition] using + attached.sidecars.sourceCodeAt?_main + · exact attached.sidecars.sourceCodeAt?_functionRoot + (attached.functionTraceAnalysisCurrent functionMember owner) + obtain ⟨rawBody, bodyImage⟩ := attached.sourceCodeAddressImage rootFound + rw [functionTrace.rootSourceCode] at bodyImage + cases sourceEq : functionTrace.source with + | mk arity result papSafe body => + have bodyImage' : IxIR1.Readdress.Code.mapAddresses + (attached.source.lowering.result.rebuildRename + attached.source.lowering.raw) rawBody = body := by + simpa [sourceEq] using bodyImage + refine ⟨⟨arity, result, papSafe, rawBody⟩, ?_⟩ + simpa [IxIR1.Readdress.FnDef.mapAddresses] using bodyImage' + +/-- At a retained `letOp`, both the current function and the exact operation +are raw syntax images. This packages the two syntax premises consumed by +single-operation evaluator reflection. -/ +theorem CompiledAttachment.letOpAddressImages + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {operation : IxIR1.Op} {instruction : Instr} {next : Lower.CodeTrace} + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {frame : Eval.Frame} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount operation index + instruction next) sourceStore source frame) : + ∃ rawCurrent rawOperation, + IxIR1.Readdress.FnDef.mapAddresses + (attached.source.lowering.result.rebuildRename + attached.source.lowering.raw) rawCurrent = functionTrace.source ∧ + IxIR1.Readdress.Op.mapAddresses + (attached.source.lowering.result.rebuildRename + attached.source.lowering.raw) rawOperation = operation := by + obtain ⟨rawCurrent, currentImage⟩ := + attached.functionSourceAddressImage functionMember + have sourceAt : attached.sidecars.sourceCodeAt? site = + some (.letOp operation next.sourceCode) := by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceCode] using + state.sourceCode + obtain ⟨rawCode, codeImage⟩ := attached.sourceCodeAddressImage sourceAt + cases rawCode with + | ret atom => + simp [IxIR1.Readdress.Code.mapAddresses] at codeImage + | case scrutinee peelNat alternatives => + simp [IxIR1.Readdress.Code.mapAddresses] at codeImage + | letOp rawOperation rawNext => + simp only [IxIR1.Readdress.Code.mapAddresses, + IxIR1.Code.letOp.injEq] at codeImage + exact ⟨rawCurrent, rawOperation, currentImage, codeImage.1⟩ + +/-- The validated IxIR₁ compiler constructs the higher-order ownership +contract on the exact raw context, before final declaration readdressing. -/ +theorem CompiledAttachment.rawApplyOwnership + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) : + IxIR1.Sim.ApplyOwnershipContract + (attached.source.exactTargetCtx (fun _ _ => none)) := + (attached.source.exactCompilerContracts (fun _ _ => none)).1.apply + +/-- The empty source heap is an exact image for every attachment. -/ +theorem CompiledAttachment.sourceStoreImage_empty + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) : + attached.SourceStoreImage ({} : IxIR1.Store) := by + exact ⟨{}, by simp [IxIR1.Readdress.Store.mapAddresses], + Sidecars.SourceConstructorsValid.empty attached.sidecars⟩ + +/-- Every successful retained source operation preserves exact raw heap-image +provenance. The sidecar supplies raw preimages for the current function and +operation, while evaluator reflection supplies the output heap witness. -/ +theorem CompiledAttachment.runOp_preservesSourceStoreImage + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {operation : IxIR1.Op} {instruction : Instr} {next : Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount operation index + instruction next)) + {store store' : IxIR1.Store} {source : List IxIR1.RVal} + {frame : Eval.Frame} {fuel : Nat} {value : IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount operation index + instruction next) store source frame) + (image : attached.SourceStoreImage store) + (run : IxIR1.runOp sourceContext fuel + functionTrace.source store source operation = .ok (store', value)) : + attached.SourceStoreImage store' := by + obtain ⟨rawStore, storeImage, constructorsValid⟩ := image + have outputConstructors : + attached.sidecars.SourceConstructorsValid store' := + constructorsValid.runOp + (attached.sourceContextConstructorsKnown sourceDeclarations) + (attached.functionCodeConstructorsKnown functionMember) + (attached.descendantOperationConstructorsKnown functionMember descendant) + run + obtain ⟨rawCurrent, rawOperation, currentImage, operationImage⟩ := + attached.letOpAddressImages functionMember state + rw [← storeImage, ← currentImage, ← operationImage] at run + obtain ⟨rawStore', rawRun, outputImage⟩ := + IxIR1.Readdress.runOp_success_preimage + (attached.sourceContextRenamesOfDeclarations sourceContext + sourceDeclarations) run + exact ⟨rawStore', outputImage.symm, outputConstructors⟩ + +/-- Reference-count duplication preserves the attachment's exact heap-image +predicate, including the intermediate stores used to enter PAP callees. -/ +theorem CompiledAttachment.dupVals_preservesSourceStoreImage + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {store store' : IxIR1.Store} {values : List IxIR1.RVal} + (image : attached.SourceStoreImage store) + (run : IxIR1.dupVals store values = .ok store') : + attached.SourceStoreImage store' := by + obtain ⟨rawStore, storeImage, constructorsValid⟩ := image + have outputConstructors := constructorsValid.dupVals run + subst store + obtain ⟨rawStore', rawRun, outputImage⟩ := + IxIR1.Readdress.dupVals_success_preimage run + exact ⟨rawStore', outputImage.symm, outputConstructors⟩ + +/-- Shared destruction preserves exact heap-image provenance in every final +context whose declarations agree with the attached source artifact. -/ +theorem CompiledAttachment.dropVal_preservesSourceStoreImage + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {fuel : Nat} {store store' : IxIR1.Store} {value : IxIR1.RVal} + (image : attached.SourceStoreImage store) + (run : IxIR1.dropVal sourceContext fuel store value = .ok store') : + attached.SourceStoreImage store' := by + obtain ⟨rawStore, storeImage, constructorsValid⟩ := image + have outputConstructors := constructorsValid.dropVal run + subst store + obtain ⟨rawStore', rawRun, outputImage⟩ := + IxIR1.Readdress.dropVal_success_preimage + (attached.sourceContextRenamesOfDeclarations sourceContext + sourceDeclarations) run + exact ⟨rawStore', outputImage.symm, outputConstructors⟩ + +/-- List destruction preserves exact heap-image provenance in every compatible +final source context. -/ +theorem CompiledAttachment.dropMany_preservesSourceStoreImage + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {fuel : Nat} {store store' : IxIR1.Store} {values : List IxIR1.RVal} + (image : attached.SourceStoreImage store) + (run : IxIR1.dropMany sourceContext fuel store values = .ok store') : + attached.SourceStoreImage store' := by + obtain ⟨rawStore, storeImage, constructorsValid⟩ := image + have outputConstructors := constructorsValid.dropMany run + subst store + obtain ⟨rawStore', rawRun, outputImage⟩ := + IxIR1.Readdress.dropMany_success_preimage + (attached.sourceContextRenamesOfDeclarations sourceContext + sourceDeclarations) run + exact ⟨rawStore', outputImage.symm, outputConstructors⟩ + +/-- A successful application from the compiler-certified raw context has an +identical run in the emitted context on the address-renamed heap, and the +renamed output retains exact root ownership. This is the forward image needed +by compiled executions; it deliberately makes no claim about arbitrary final +heaps that are not images of raw heaps. -/ +theorem CompiledAttachment.applyGo_exactImage + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {fuel : Nat} {store store' : IxIR1.Store} + {function : IxIR1.RVal} {args : List IxIR1.RVal} + {value : IxIR1.RVal} {rest : List IxIR1.Sim.Root} + (ownership : IxIR1.Sim.RootOwnership store + (⟨.shared, function⟩ :: + IxIR1.Sim.rootsFor .shared args ++ rest)) + (run : IxIR1.applyGo + (attached.source.exactTargetCtx (fun _ _ => none)) + fuel store function args = .ok (store', value)) : + IxIR1.applyGo attached.simulationSourceContext fuel + (IxIR1.Readdress.Store.mapAddresses + (attached.source.lowering.result.rebuildRename + attached.source.lowering.raw) store) + function args = + .ok + (IxIR1.Readdress.Store.mapAddresses + (attached.source.lowering.result.rebuildRename + attached.source.lowering.raw) store', value) ∧ + IxIR1.Sim.RootOwnership + (IxIR1.Readdress.Store.mapAddresses + (attached.source.lowering.result.rebuildRename + attached.source.lowering.raw) store') + (⟨.shared, value⟩ :: rest) := by + constructor + · rw [IxIR1.Readdress.applyGo_mapAddresses + attached.sourceContextRenames, run] + rfl + · apply (IxIR1.Sim.rootOwnership_mapAddresses_iff + (attached.source.lowering.result.rebuildRename + attached.source.lowering.raw) store' + (⟨.shared, value⟩ :: rest)).mpr + exact attached.rawApplyOwnership.preserves ownership run + +/-- On an exact source-heap image, every successful emitted-context +application both preserves the image invariant and obtains its ownership +postcondition from the compiler-certified raw contract. This is the +worker-facing direction of `applyGo_exactImage`. -/ +theorem CompiledAttachment.applyGo_owned_of_sourceStoreImage + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {fuel : Nat} {store store' : IxIR1.Store} + {function : IxIR1.RVal} {args : List IxIR1.RVal} + {value : IxIR1.RVal} {rest : List IxIR1.Sim.Root} + (image : attached.SourceStoreImage store) + (ownership : IxIR1.Sim.RootOwnership store + (⟨.shared, function⟩ :: + IxIR1.Sim.rootsFor .shared args ++ rest)) + (run : IxIR1.applyGo attached.simulationSourceContext fuel store + function args = .ok (store', value)) : + attached.SourceStoreImage store' ∧ + IxIR1.Sim.RootOwnership store' (⟨.shared, value⟩ :: rest) := by + obtain ⟨sourceStore, sourceStoreEq, constructorsValid⟩ := image + have outputConstructors : + attached.sidecars.SourceConstructorsValid store' := + constructorsValid.applyGo + (attached.sourceContextConstructorsKnown (sourceDeclarations := rfl)) run + subst store + obtain ⟨sourceStore', sourceRun, outputStoreEq⟩ := + IxIR1.Readdress.applyGo_success_preimage + attached.sourceContextRenames run + have sourceOwnership : IxIR1.Sim.RootOwnership sourceStore + (⟨.shared, function⟩ :: + IxIR1.Sim.rootsFor .shared args ++ rest) := + (IxIR1.Sim.rootOwnership_mapAddresses_iff + (attached.source.lowering.result.rebuildRename + attached.source.lowering.raw) sourceStore + (⟨.shared, function⟩ :: + IxIR1.Sim.rootsFor .shared args ++ rest)).mp ownership + have sourceOutputOwnership : IxIR1.Sim.RootOwnership sourceStore' + (⟨.shared, value⟩ :: rest) := + attached.rawApplyOwnership.preserves sourceOwnership sourceRun + constructor + · exact ⟨sourceStore', outputStoreEq.symm, outputConstructors⟩ + · rw [outputStoreEq] + exact (IxIR1.Sim.rootOwnership_mapAddresses_iff + (attached.source.lowering.result.rebuildRename + attached.source.lowering.raw) sourceStore' + (⟨.shared, value⟩ :: rest)).mpr sourceOutputOwnership + +/-- Declaration-compatible source contexts obtain the same image-restricted +application theorem for their own oracle. This is the generic trace-worker +form; certified programs contain no externs, but retaining the oracle exactly +keeps the evaluator transport statement total. -/ +theorem CompiledAttachment.applyGo_owned_of_sourceStoreImage_of_declarations + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {fuel : Nat} {store store' : IxIR1.Store} + {function : IxIR1.RVal} {args : List IxIR1.RVal} + {value : IxIR1.RVal} {rest : List IxIR1.Sim.Root} + (image : attached.SourceStoreImage store) + (ownership : IxIR1.Sim.RootOwnership store + (⟨.shared, function⟩ :: + IxIR1.Sim.rootsFor .shared args ++ rest)) + (run : IxIR1.applyGo sourceContext fuel store function args = + .ok (store', value)) : + attached.SourceStoreImage store' ∧ + IxIR1.Sim.RootOwnership store' (⟨.shared, value⟩ :: rest) := by + obtain ⟨sourceStore, sourceStoreEq, constructorsValid⟩ := image + have outputConstructors : + attached.sidecars.SourceConstructorsValid store' := + constructorsValid.applyGo + (attached.sourceContextConstructorsKnown sourceDeclarations) run + subst store + let contexts := attached.sourceContextRenamesOfDeclarations sourceContext + sourceDeclarations + obtain ⟨sourceStore', sourceRun, outputStoreEq⟩ := + IxIR1.Readdress.applyGo_success_preimage contexts run + have sourceOwnership : IxIR1.Sim.RootOwnership sourceStore + (⟨.shared, function⟩ :: + IxIR1.Sim.rootsFor .shared args ++ rest) := + (IxIR1.Sim.rootOwnership_mapAddresses_iff + (attached.source.lowering.result.rebuildRename + attached.source.lowering.raw) sourceStore + (⟨.shared, function⟩ :: + IxIR1.Sim.rootsFor .shared args ++ rest)).mp ownership + have rawContract : IxIR1.Sim.ApplyOwnershipContract + (attached.source.exactTargetCtx sourceContext.oracle) := + (attached.source.exactCompilerContracts sourceContext.oracle).1.apply + have sourceOutputOwnership : IxIR1.Sim.RootOwnership sourceStore' + (⟨.shared, value⟩ :: rest) := + rawContract.preserves sourceOwnership sourceRun + constructor + · exact ⟨sourceStore', outputStoreEq.symm, outputConstructors⟩ + · rw [outputStoreEq] + exact (IxIR1.Sim.rootOwnership_mapAddresses_iff + (attached.source.lowering.result.rebuildRename + attached.source.lowering.raw) sourceStore' + (⟨.shared, value⟩ :: rest)).mpr sourceOutputOwnership + +/-- The generic image theorem exposes precisely the fixed-input law required +by checked trace ownership. -/ +theorem CompiledAttachment.applyOwnershipPreservesFrom_sourceStoreImage_of_declarations + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {fuel : Nat} {store : IxIR1.Store} + (image : attached.SourceStoreImage store) : + IxIR1.Sim.ApplyOwnershipPreservesFrom sourceContext fuel store := by + intro store' function args value rest ownership run + exact (attached.applyGo_owned_of_sourceStoreImage_of_declarations + sourceDeclarations image ownership run).2 + +/-- Exact heap-image provenance specializes the raw compiler theorem to the +fixed-input ownership interface consumed by trace simulation. -/ +theorem CompiledAttachment.applyOwnershipPreservesFrom_sourceStoreImage + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {fuel : Nat} {store : IxIR1.Store} + (image : attached.SourceStoreImage store) : + IxIR1.Sim.ApplyOwnershipPreservesFrom + attached.simulationSourceContext fuel store := by + intro store' function args value rest ownership run + exact (attached.applyGo_owned_of_sourceStoreImage image ownership run).2 + +/-- At an HPT-ambiguous case, exact source-heap provenance identifies the +runtime constructor as a member of the producer universe. The attachment's +residual coverage audit therefore supplies the complete parallel target +branch selection. -/ +theorem CompiledAttachment.constructorSwitchSelection_of_residual_nonempty + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {targetScrutinee : Atom} + {generated : Block} {outgoing : List Lower.EdgeTrace} + {children : List Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children)) + {sourceStore : IxIR1.Store} {location : Nat} {box : IxIR1.NodeBox} + {identity : CtorId} {fields : Array IxIR1.RVal} + {fieldCount alternativeIndex : Nat} {body : IxIR1.Code} + (ambiguous : attached.sidecars.exactConstructorAt? site sourceScrutinee = + none) + (image : attached.SourceStoreImage sourceStore) + (sourceGet : sourceStore.get? location = some box) + (node : box.node = .ctorN identity fields) + (sourceAlternative : Lower.sourceAlternativeAtTag? alternatives + identity.cidx = + some (.mk identity.cidx fieldCount body, alternativeIndex)) + (fieldArity : fields.size = fieldCount) : + Nonempty (ConstructorSwitchSelection targetScrutinee generated outgoing + children identity) := by + obtain ⟨rawStore, storeImage, constructorsValid⟩ := image + have runtimeKnown : attached.sidecars.constructorKnown identity + fields.size = true := by + cases box with + | mk world rc boxNode => + change boxNode = .ctorN identity fields at node + subst boxNode + exact constructorsValid.constructorKnown sourceGet + have known : ∃ info ∈ attached.sidecars.constructors, + info.identity = identity ∧ info.arity = fieldCount := + attached.sidecars.constructorKnown_witness + (by simpa [fieldArity] using runtimeKnown) + obtain ⟨constructors, targetPeel, _, terminator⟩ := + Lower.CodeTrace.switchSyntax_of_match + (functionTrace.descendantSyntaxMatches descendant) + have rootCoverage := + attached.sidecars.functionCodeResidualCaseTargetsMatch + attached.traceResidualCaseTargetsProduced functionMember + have localCoverage := + attached.sidecars.codeResidualCaseTargetsMatch_descendant rootCoverage + descendant + obtain ⟨target, targetAlternative⟩ := + attached.sidecars.residualCaseTarget_of_codeResidualCaseTargetsMatch + localCoverage ambiguous known sourceAlternative terminator + have targetMember : target ∈ constructors := + Array.mem_of_find?_eq_some targetAlternative + obtain ⟨index, targetAt⟩ := (Array.mem_iff_getElem?).mp targetMember + have branchMatch := Lower.CodeTrace.switchNodeBranchesMatch_of_match + (functionTrace.descendantSwitchBranchesMatch descendant) + have branchMatch' := branchMatch + unfold Lower.switchNodeBranchesMatch at branchMatch' + rw [terminator] at branchMatch' + simp only [Bool.and_eq_true] at branchMatch' + obtain ⟨⟨⟨outgoingLength, childrenLength⟩, _⟩, _⟩ := branchMatch' + have targetBound : index < constructors.size := + (Array.getElem?_eq_some_iff.mp targetAt).1 + have edgeBound : index < outgoing.length := by + have lengthEq := beq_iff_eq.mp outgoingLength + omega + have childBound : index < children.length := by + have lengthEq := beq_iff_eq.mp childrenLength + omega + let edge := outgoing[index]'edgeBound + let child := children[index]'childBound + have edgeAt : outgoing[index]? = some edge := + List.getElem?_eq_some_iff.mpr ⟨edgeBound, rfl⟩ + have childAt : children[index]? = some child := + List.getElem?_eq_some_iff.mpr ⟨childBound, rfl⟩ + exact ⟨ + { constructors + targetPeel + index + target + edge + child + terminator + targetAt + targetAlternative + edgeAt + childAt }⟩ + +/-- Proof-relevant residual constructor selection derived wholly from an +attached producer artifact and its reachable source-heap image. -/ +noncomputable def CompiledAttachment.constructorSwitchSelection_of_residual + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {targetScrutinee : Atom} + {generated : Block} {outgoing : List Lower.EdgeTrace} + {children : List Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children)) + {sourceStore : IxIR1.Store} {location : Nat} {box : IxIR1.NodeBox} + {identity : CtorId} {fields : Array IxIR1.RVal} + {fieldCount alternativeIndex : Nat} {body : IxIR1.Code} + (ambiguous : attached.sidecars.exactConstructorAt? site sourceScrutinee = + none) + (image : attached.SourceStoreImage sourceStore) + (sourceGet : sourceStore.get? location = some box) + (node : box.node = .ctorN identity fields) + (sourceAlternative : Lower.sourceAlternativeAtTag? alternatives + identity.cidx = + some (.mk identity.cidx fieldCount body, alternativeIndex)) + (fieldArity : fields.size = fieldCount) : + ConstructorSwitchSelection targetScrutinee generated outgoing children + identity := + Classical.choice + (attached.constructorSwitchSelection_of_residual_nonempty functionMember + descendant ambiguous image sourceGet node sourceAlternative fieldArity) + +/-- Canonical IxIR₂ evaluator context named by an attached target artifact. -/ +def CompiledAttachment.simulationTargetContext + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) : Eval.Context := + Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas + +/-- Semantic/environment obligations shared by every branch of the exhaustive +fuel worker. Declaration and schema identities pin both evaluators to the +attached artifact. Reuse freedom and reachable-heap application ownership are +derived from the attachment, as are exact and ambiguous-HPT constructor +selections. -/ +structure SuccessfulSimulationContracts + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) (sourceContext : IxIR1.Ctx) (context : Eval.Context) : Type + where + sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts + targetDeclarations : context.declarations = + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas).declarations + targetSchemas : context.schemas = + attached.target.artifact.validationContext.schemas + +/-- Construct the worker contract over the exact contexts carried by an +attachment, discharging all identity fields definitionally. -/ +def CompiledAttachment.successfulSimulationContracts + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) : + SuccessfulSimulationContracts attached attached.simulationSourceContext + attached.simulationTargetContext := + { sourceDeclarations := rfl + targetDeclarations := rfl + targetSchemas := rfl } + +/-- Fuel zero is the vacuous base of the recursive trace worker: no IxIR₁ +code shape can return successfully without one control-fuel constructor. -/ +theorem successfulTraceSimulationAt_zero + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + (sourceContext : IxIR1.Ctx) (context : Eval.Context) + (interpretation : Eval.Interpretation) : + SuccessfulTraceSimulationAt attached sourceContext context interpretation + 0 := by + intro functionTrace trace sourceStore source frameRoots sourceOutput outcome + frame machine stack post member descendant state stores runtime ownership + sourceRun + rw [IxIR1.runCode.eq_def] at sourceRun + contradiction + +/-- The outermost empty continuation is a concrete successful-return handler: +one checked target return halts with the same value and exact related heap. -/ +theorem CompiledAttachment.haltReturnHandler + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + (sourceContext : IxIR1.Ctx) (context : Eval.Context) + (interpretation : Eval.Interpretation) + (functionTrace : Lower.FunctionTrace) + (sourceOutput : IxIR1.Store × IxIR1.RVal) : + SuccessfulReturnHandler attached sourceContext context interpretation + functionTrace [] [] sourceOutput sourceOutput + (fun sourceStore value machine => + machine.control = .halted value ∧ + Lower.Sim.StoreRel sourceStore machine.store) := by + intro returningTrace sourceFuel site blockId input entryValueCount sourceAtom + targetAtom generated sourceStore source frame machine returningMember + descendant state stores runtime ownership sourceRun resultWorld control + noCredits image + obtain ⟨value, outputEq, targetSteps, nextStores⟩ := + attached.simulate_traced_ret_halt_success descendant state stores sourceRun + resultWorld control noCredits + cases outputEq + have reached : ReachesPost context interpretation + (fun sourceStore value machine => + machine.control = .halted value ∧ + Lower.Sim.StoreRel sourceStore machine.store) + sourceStore value machine := + ⟨1, { machine with control := .halted value }, targetSteps, rfl, + nextStores⟩ + exact ⟨machine.heapFuel, by simpa using reached⟩ + +/-- Turn the smaller-fuel caller worker into the return handler for an +ordinary callee. The callee's terminal step restores the exact suspended +caller trace state; the caller worker then consumes its source continuation. +This lemma is the central `.resume` knot of the CPS induction. -/ +private theorem resumeReturnHandlerWithOwnership + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {callerFuel operationFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {callerTrace calleeTrace : Lower.FunctionTrace} + (callerMember : callerTrace ∈ attached.target.artifact.trace.functions) + {callSite : Lower.SourceSite} {callBlock : BlockId} + {callInput nextInput : Lower.Sim.EnvMap} + {callEntryValueCount callIndex : Nat} + {operation : IxIR1.Op} {instruction : Instr} {next : Lower.CodeTrace} + (callerDescendant : callerTrace.root.Descendant + (.letOp callSite callBlock callInput nextInput callEntryValueCount + operation callIndex instruction next)) + {callerStore outputStore finalStore : IxIR1.Store} + {callerSource : List IxIR1.RVal} {value finalValue : IxIR1.RVal} + {calleeFrameRoots callerFrameRoots : List IxIR1.Sim.Root} + {callerFrame : Eval.Frame} {rest : List Eval.Continuation} + (callerState : attached.sidecars.TraceStateRel callerTrace + (.letOp callSite callBlock callInput nextInput callEntryValueCount + operation callIndex instruction next) + callerStore callerSource callerFrame) + (binder : Lower.Instr.baselineBinderAtom callEntryValueCount instruction = + some (.reg callEntryValueCount)) + (delta : Lower.Instr.baselineValueDelta instruction = some 1) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceOperation : IxIR1.runOp sourceContext operationFuel + callerTrace.source callerStore callerSource operation = + .ok (outputStore, value)) + (callerRuntime : Lower.Sim.SourceRuntimeInvariant outputStore + (value :: callerSource)) + (callerOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next outputStore + (value :: callerSource) callerFrameRoots) + (callerRun : IxIR1.runCode sourceContext callerFuel callerTrace.source + outputStore (value :: callerSource) next.sourceCode = + .ok (finalStore, finalValue)) + (callerResultWorld : IxIR1.Sim.HasWorld finalStore + callerTrace.source.result finalValue) + (callerNoCredits : callerFrame.credits = #[]) + {outcome : IxIR1.Store × IxIR1.RVal} {post : SourceMachinePost} + (finish : SuccessfulReturnHandler attached sourceContext context + interpretation callerTrace callerFrameRoots rest + (finalStore, finalValue) outcome post) + (worker : SuccessfulTraceSimulationAt attached sourceContext context + interpretation callerFuel) : + SuccessfulReturnHandler attached sourceContext context interpretation + calleeTrace calleeFrameRoots + (.resume { callerFrame with pc := callerFrame.pc + 1 } :: rest) + (outputStore, value) outcome post := by + intro returningTrace returnFuel returnSite returnBlock returnInput + returnEntryValueCount sourceAtom targetAtom returnGenerated sourceStore + calleeSource calleeFrame machine returningMember calleeDescendant + calleeState stores calleeRuntime calleeOwnership sourceReturn resultWorld + control noCredits calleeImage + obtain ⟨returnedValue, sourceResolved, outputEq⟩ := + IxIR1.runCode_ret_success sourceReturn + have storeEq : sourceStore = outputStore := by + exact (congrArg Prod.fst outputEq).symm + have valueEq : returnedValue = value := by + exact (congrArg Prod.snd outputEq).symm + subst sourceStore + subst returnedValue + let nextCallerFrame : Eval.Frame := + { callerFrame with + pc := callerFrame.pc + 1 + values := callerFrame.values.push value } + obtain ⟨_, returnSteps, nextStores, nextState⟩ := + attached.simulate_traced_return_to_letOp_state + (sourceFuel := returnFuel) (context := context) + (interpretation := interpretation) callerMember + callerDescendant calleeDescendant callerState calleeState binder delta + stores sourceDeclarations sourceOperation sourceResolved control noCredits + (calleeState.target.resultWorld stores resultWorld) + have nextDescendant : callerTrace.root.Descendant next := by + exact .step callerDescendant (by simp [Lower.CodeTrace.children]) + have nextControl : + ({ machine with control := .running nextCallerFrame rest } : + Eval.Machine).control = .running nextCallerFrame rest := rfl + have nextNoCredits : nextCallerFrame.credits = #[] := by + simpa [nextCallerFrame] using callerNoCredits + have tail := worker (machine := + { machine with control := .running nextCallerFrame rest }) + (stack := rest) callerMember nextDescendant nextState nextStores + callerRuntime callerOwnership callerRun callerResultWorld nextControl + nextNoCredits calleeImage finish + obtain ⟨tailHeapFuel, tail⟩ := tail + let fundedMachine : Eval.Machine := { machine with heapFuel := tailHeapFuel } + have fundedStores : Lower.Sim.StoreRel outputStore fundedMachine.store := by + simpa [fundedMachine] using stores + have fundedControl : fundedMachine.control = .running calleeFrame + (.resume { callerFrame with pc := callerFrame.pc + 1 } :: rest) := by + simpa [fundedMachine] using control + obtain ⟨_, fundedReturnSteps, _, _⟩ := + attached.simulate_traced_return_to_letOp_state + (machine := fundedMachine) (sourceFuel := returnFuel) + (context := context) (interpretation := interpretation) callerMember + callerDescendant calleeDescendant callerState calleeState binder delta + fundedStores sourceDeclarations sourceOperation sourceResolved + fundedControl noCredits + (calleeState.target.resultWorld fundedStores resultWorld) + refine ⟨tailHeapFuel, ?_⟩ + simpa [fundedMachine] using tail.prepend fundedReturnSteps + +/-- An exact source result can resume one suspended target frame and then +reach the enclosing postcondition. This is the target-facing tail shared by +immediate `applyMore` results and by the ordinary return of an exactly +saturated recursive callee. -/ +def SuccessfulResumeContinuation + (context : Eval.Context) (interpretation : Eval.Interpretation) + (caller : Eval.Frame) (rest : List Eval.Continuation) + (sourceOutput outcome : IxIR1.Store × IxIR1.RVal) + (post : SourceMachinePost) : Prop := + ∀ {machine : Eval.Machine}, + Lower.Sim.StoreRel sourceOutput.1 machine.store → + machine.control = .running + { caller with values := caller.values.push sourceOutput.2 } rest → + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine + +/-- A successful resume continuation induces the universal return handler +for any retained callee on the corresponding `.resume` stack. The terminal +target step preserves heap fuel, so the continuation chooses its own suffix +budget unchanged. -/ +private theorem resumeReturnHandlerOfContinuation + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} + {context : Eval.Context} {interpretation : Eval.Interpretation} + (functionTrace : Lower.FunctionTrace) + (frameRoots : List IxIR1.Sim.Root) + (caller : Eval.Frame) (rest : List Eval.Continuation) + (sourceOutput outcome : IxIR1.Store × IxIR1.RVal) + (post : SourceMachinePost) + (continuation : SuccessfulResumeContinuation context interpretation + caller rest sourceOutput outcome post) : + SuccessfulReturnHandler attached sourceContext context interpretation + functionTrace frameRoots (.resume caller :: rest) sourceOutput outcome + post := by + intro returningTrace returnFuel site blockId input entryValueCount sourceAtom + targetAtom generated sourceStore source frame machine returningMember + descendant state stores runtime ownership sourceRun resultWorld control + noCredits image + obtain ⟨returnedValue, sourceResolved, outputEq⟩ := + IxIR1.runCode_ret_success sourceRun + have storeEq : sourceStore = sourceOutput.1 := by + exact (congrArg Prod.fst outputEq).symm + have valueEq : returnedValue = sourceOutput.2 := by + exact (congrArg Prod.snd outputEq).symm + subst sourceStore + subst returnedValue + let nextMachine : Eval.Machine := + { machine with + control := .running + { caller with values := caller.values.push sourceOutput.2 } rest } + have nextStores : Lower.Sim.StoreRel sourceOutput.1 nextMachine.store := by + simpa [nextMachine] using stores + have nextControl : nextMachine.control = .running + { caller with values := caller.values.push sourceOutput.2 } rest := rfl + have tail := continuation nextStores nextControl + obtain ⟨tailHeapFuel, tail⟩ := tail + let fundedMachine : Eval.Machine := { machine with heapFuel := tailHeapFuel } + let fundedNext : Eval.Machine := { nextMachine with heapFuel := tailHeapFuel } + have fundedStores : Lower.Sim.StoreRel sourceOutput.1 + fundedMachine.store := by + simpa [fundedMachine] using stores + have fundedControl : fundedMachine.control = + .running frame (.resume caller :: rest) := by + simpa [fundedMachine] using control + obtain ⟨_, returnSteps, _, _⟩ := + Lower.Sim.simulate_traced_ret_resume_state + (sourceContext := sourceContext) + (sourceCurrent := returningTrace.source) (sourceFuel := returnFuel) + (context := context) (interpretation := interpretation) + (machine := fundedMachine) + (callerSource := caller.values.toList.reverse) + (callerMapping := Lower.Sim.entryMap caller.values.size) + descendant state.target fundedStores (Lower.Sim.EnvRel.entry caller.values) + sourceResolved fundedControl noCredits + (state.target.resultWorld fundedStores resultWorld) + refine ⟨tailHeapFuel, ?_⟩ + have tail' : ReachesPost context interpretation post outcome.1 outcome.2 + fundedNext := by + simpa [fundedNext, nextMachine] using tail + simpa [fundedMachine, fundedNext, nextMachine] using + tail'.prepend returnSteps + +/-- Package a recursive caller worker as the exact resumed-frame continuation +consumed by every terminal `applyMore` branch. -/ +private theorem resumeContinuationOfWorker + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {callerFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {callerTrace : Lower.FunctionTrace} {next : Lower.CodeTrace} + (callerMember : callerTrace ∈ attached.target.artifact.trace.functions) + (nextDescendant : callerTrace.root.Descendant next) + {outputStore finalStore : IxIR1.Store} + {callerSource : List IxIR1.RVal} {value finalValue : IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + {resumeFrame nextFrame : Eval.Frame} {stack : List Eval.Continuation} + (nextFrameEq : nextFrame = + { resumeFrame with values := resumeFrame.values.push value }) + (nextState : attached.sidecars.TraceStateRel callerTrace next outputStore + (value :: callerSource) nextFrame) + (runtime : Lower.Sim.SourceRuntimeInvariant outputStore + (value :: callerSource)) + (image : attached.SourceStoreImage outputStore) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next outputStore + (value :: callerSource) frameRoots) + (callerRun : IxIR1.runCode sourceContext callerFuel callerTrace.source + outputStore (value :: callerSource) next.sourceCode = + .ok (finalStore, finalValue)) + (resultWorld : IxIR1.Sim.HasWorld finalStore + callerTrace.source.result finalValue) + (noCredits : nextFrame.credits = #[]) + {outcome : IxIR1.Store × IxIR1.RVal} {post : SourceMachinePost} + (finish : SuccessfulReturnHandler attached sourceContext context + interpretation callerTrace frameRoots stack + (finalStore, finalValue) outcome post) + (worker : SuccessfulTraceSimulationAt attached sourceContext context + interpretation callerFuel) : + SuccessfulResumeContinuation context interpretation resumeFrame stack + (outputStore, value) outcome post := by + intro machine stores control + apply worker callerMember nextDescendant nextState stores runtime ownership + callerRun resultWorld ?_ noCredits image finish + simpa [nextFrameEq] using control + +/-- A source-success decomposition of one dynamic `applyGo` chain aligned to +the checked target declarations and retained function traces. The recursive +over-saturated constructor stores the residual plan at the evaluator's +strictly smaller fuel; the other constructors are terminal dispatcher +outcomes. -/ +inductive ApplyMorePlan + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + (sourceContext : IxIR1.Ctx) (context : Eval.Context) : + Nat → IxIR1.Store → IxIR1.RVal → List IxIR1.RVal → + IxIR1.Store → IxIR1.RVal → Prop where + | erased {fuel : Nat} {sourceStore sourceReleased : IxIR1.Store} + {values : List IxIR1.RVal} + (sourceRelease : IxIR1.dropMany sourceContext fuel sourceStore values = + .ok sourceReleased) : + ApplyMorePlan attached sourceContext context (fuel + 1) sourceStore + .erased values sourceReleased .erased + | papUnder {fuel : Nat} + {sourceStore sourceRetained sourceReleased : IxIR1.Store} + {location : Nat} {box : IxIR1.NodeBox} + {address : Ixon.Address} {arity : Nat} + {captured : Array IxIR1.RVal} {values : List IxIR1.RVal} + (sourceGet : sourceStore.get? location = some box) + (node : box.node = .papN address arity captured) + (sourceRetain : IxIR1.dupVals sourceStore captured.toList = + .ok sourceRetained) + (sourceRelease : IxIR1.dropVal sourceContext fuel sourceRetained + (.loc location) = .ok sourceReleased) + (totalUnder : (captured.toList ++ values).length < arity) : + ApplyMorePlan attached sourceContext context (fuel + 1) sourceStore + (.loc location) values + (sourceReleased.allocNode .shared + (.papN address arity (captured ++ values.toArray))).1 + (.loc (sourceReleased.allocNode .shared + (.papN address arity (captured ++ values.toArray))).2) + | papSaturatedFn {fuel calleeFuel : Nat} + {sourceStore sourceRetained sourceReleased outputStore : IxIR1.Store} + {location : Nat} {box : IxIR1.NodeBox} + {address : Ixon.Address} {arity : Nat} + {captured : Array IxIR1.RVal} {values : List IxIR1.RVal} + {sourceDefinition : IxIR1.FnDef} {targetDefinition : Function} + {calleeTrace : Lower.FunctionTrace} {value : IxIR1.RVal} + (calleeMember : calleeTrace ∈ + attached.target.artifact.trace.functions) + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration address) sourceDefinition targetDefinition) + (sourceGet : sourceStore.get? location = some box) + (node : box.node = .papN address arity captured) + (sourceRetain : IxIR1.dupVals sourceStore captured.toList = + .ok sourceRetained) + (sourceRelease : IxIR1.dropVal sourceContext fuel sourceRetained + (.loc location) = .ok sourceReleased) + (totalExact : (captured.toList ++ values).length = arity) + (papArity : arity = sourceDefinition.arity) + (sourceDeclaration : sourceContext.decls address = + some (.fn sourceDefinition)) + (sourcePapSafe : sourceDefinition.papSafe = true) + (targetDeclaration : context.declarations address = + some (.fn targetDefinition)) + (calleeRun : IxIR1.runCode sourceContext calleeFuel sourceDefinition + sourceReleased (captured.toList ++ values).reverse + sourceDefinition.body = .ok (outputStore, value)) + (calleeResultWorld : IxIR1.Sim.HasWorld outputStore + sourceDefinition.result value) + (calleeSmaller : calleeFuel < fuel + 1) : + ApplyMorePlan attached sourceContext context (fuel + 1) sourceStore + (.loc location) values outputStore value + | papOverFn {fuel calleeFuel : Nat} + {sourceStore sourceRetained sourceReleased calledStore outputStore : + IxIR1.Store} + {location : Nat} {box : IxIR1.NodeBox} + {address : Ixon.Address} {arity : Nat} + {captured : Array IxIR1.RVal} {values : List IxIR1.RVal} + {sourceDefinition : IxIR1.FnDef} {targetDefinition : Function} + {calleeTrace : Lower.FunctionTrace} + {calledValue outputValue : IxIR1.RVal} + (calleeMember : calleeTrace ∈ + attached.target.artifact.trace.functions) + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration address) sourceDefinition targetDefinition) + (sourceGet : sourceStore.get? location = some box) + (node : box.node = .papN address arity captured) + (sourceRetain : IxIR1.dupVals sourceStore captured.toList = + .ok sourceRetained) + (sourceRelease : IxIR1.dropVal sourceContext fuel sourceRetained + (.loc location) = .ok sourceReleased) + (totalOver : arity < (captured.toList ++ values).length) + (papArity : arity = sourceDefinition.arity) + (sourceDeclaration : sourceContext.decls address = + some (.fn sourceDefinition)) + (sourcePapSafe : sourceDefinition.papSafe = true) + (targetDeclaration : context.declarations address = + some (.fn targetDefinition)) + (calleeRun : IxIR1.runCode sourceContext calleeFuel sourceDefinition + sourceReleased ((captured.toList ++ values).take arity).reverse + sourceDefinition.body = .ok (calledStore, calledValue)) + (calleeResultWorld : IxIR1.Sim.HasWorld calledStore + sourceDefinition.result calledValue) + (calleeSmaller : calleeFuel < fuel + 1) + (residual : ApplyMorePlan attached sourceContext context fuel calledStore + calledValue ((captured.toList ++ values).drop arity) outputStore + outputValue) : + ApplyMorePlan attached sourceContext context (fuel + 1) sourceStore + (.loc location) values outputStore outputValue + +/-- Every residual plan describes a finite successful source application. +The evaluator bound can exceed the plan's induction index: each stored callee +and release is raised to a common bound when their runs are composed. -/ +theorem ApplyMorePlan.sourceRun + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {context : Eval.Context} + {planFuel : Nat} {sourceStore outputStore : IxIR1.Store} + {function value : IxIR1.RVal} {arguments : List IxIR1.RVal} + (plan : ApplyMorePlan attached sourceContext context planFuel + sourceStore function arguments outputStore value) : + ∃ fuel, IxIR1.applyGo sourceContext fuel sourceStore function arguments = + .ok (outputStore, value) := by + induction plan with + | @erased fuel store released values sourceRelease => + exact ⟨fuel + 1, by + simp [IxIR1.applyGo, sourceRelease, bind, Except.bind]⟩ + | @papUnder fuel store retained released location box address arity captured + values sourceGet node sourceRetain sourceRelease totalUnder => + refine ⟨fuel + 1, ?_⟩ + simp only [IxIR1.applyGo, sourceGet, node, sourceRetain, sourceRelease, + totalUnder, if_true, bind, Except.bind] + have argumentsEq : (captured.toList ++ values).toArray = + captured ++ values.toArray := by + apply Array.toList_inj.mp + simp + rw [argumentsEq] + | papSaturatedFn _calleeMember _calleeMatch sourceGet node sourceRetain + sourceRelease totalExact papArity sourceDeclaration sourcePapSafe + _targetDeclaration calleeRun calleeResultWorld _calleeSmaller => + have called := IxIR1.invoke_of_body_run sourceDeclaration + (totalExact.trans papArity) calleeRun calleeResultWorld + obtain ⟨fuel, run⟩ := IxIR1.applyGo_exact_of_invoke sourceGet node + sourceRetain sourceRelease totalExact sourceDeclaration sourcePapSafe + called + exact ⟨fuel + 1, run⟩ + | papOverFn _calleeMember _calleeMatch sourceGet node sourceRetain + sourceRelease totalOver papArity sourceDeclaration sourcePapSafe + _targetDeclaration calleeRun calleeResultWorld _calleeSmaller + _residual ih => + have called := IxIR1.invoke_of_body_run (run := calleeRun) + sourceDeclaration (by + simpa only [List.length_take, + Nat.min_eq_left (Nat.le_of_lt totalOver)] using papArity) + calleeResultWorld + obtain ⟨residualFuel, residualRun⟩ := ih + obtain ⟨fuel, run⟩ := IxIR1.applyGo_over_of_invoke sourceGet node + sourceRetain sourceRelease totalOver sourceDeclaration sourcePapSafe + called residualRun + exact ⟨fuel + 1, run⟩ + +/-- Recover the two dynamic heap facts needed by a target PAP dispatch from +the invariants available at any retained source trace position. Keeping +these facts out of `ApplyMorePlan` makes the plan a pure decomposition of +`applyGo`; recursive return handlers re-establish them for their current +heap. -/ +private theorem CompiledAttachment.livePapFacts + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {functionTrace : Lower.FunctionTrace} {trace : Lower.CodeTrace} + {store : IxIR1.Store} {source : List IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + (member : functionTrace ∈ attached.target.artifact.trace.functions) + (descendant : functionTrace.root.Descendant trace) + (runtime : Lower.Sim.SourceRuntimeInvariant store source) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions trace store source frameRoots) + {location : Nat} {box : IxIR1.NodeBox} {address : Ixon.Address} + {arity : Nat} {captured : Array IxIR1.RVal} + (sourceGet : store.get? location = some box) + (node : box.node = .papN address arity captured) : + box.world = .shared ∧ captured.size < arity := by + obtain ⟨position, positionMember, coordinate⟩ := + attached.target.position member descendant + have exactOwnership := ownership position positionMember coordinate + refine ⟨exactOwnership.ownership.pap_shared sourceGet node, ?_⟩ + cases box with + | mk world rc actualNode => + simp only at node + subst actualNode + exact runtime.papsUnder.captured_lt sourceGet + +/-- A source declaration selected by the evaluator's first-match environment +selects the correspondingly retained target declaration and function trace. +The lookup-facing whole-program trace theorem handles duplicate raw keys in +the same way as both evaluator contexts. -/ +theorem CompiledAttachment.functionTrace_of_source_declaration + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {context : Eval.Context} + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (targetDeclarations : context.declarations = + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas).declarations) + {address : Ixon.Address} {sourceDefinition : IxIR1.FnDef} + (sourceDeclaration : sourceContext.decls address = + some (.fn sourceDefinition)) : + ∃ targetDefinition calleeTrace, + calleeTrace ∈ attached.target.artifact.trace.functions ∧ + Lower.FunctionTraceMatch calleeTrace (.declaration address) + sourceDefinition targetDefinition ∧ + context.declarations address = some (.fn targetDefinition) := by + have artifactLookup : + IxIR1.Env.ofList attached.target.artifact.source.declarations address = + some (.fn sourceDefinition) := by + rw [attached.targetSourceProduced] + rw [attached.sidecarDeclarationEnvironment] + rw [← sourceDeclarations] + exact sourceDeclaration + obtain ⟨targetDefinition, calleeTrace, targetLookup, calleeMember, + calleeMatch⟩ := + attached.target.artifact.functionTrace_of_source_lookup artifactLookup + refine ⟨targetDefinition, calleeTrace, calleeMember, calleeMatch, ?_⟩ + rw [targetDeclarations] + exact targetLookup + +/-- Inverse lookup-facing form of +`CompiledAttachment.functionTrace_of_source_declaration`. A concrete target function +selected by the evaluator determines the exact source declaration and +retained callee trace at the same address, including first-binding-wins +behavior for repeated raw declaration keys. -/ +theorem CompiledAttachment.functionTrace_of_target_declaration + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {context : Eval.Context} + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (targetDeclarations : context.declarations = + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas).declarations) + {address : Ixon.Address} {targetDefinition : Function} + (targetDeclaration : context.declarations address = + some (.fn targetDefinition)) : + ∃ sourceDefinition calleeTrace, + calleeTrace ∈ attached.target.artifact.trace.functions ∧ + Lower.FunctionTraceMatch calleeTrace (.declaration address) + sourceDefinition targetDefinition ∧ + sourceContext.decls address = some (.fn sourceDefinition) := by + have artifactLookup : + (attached.target.artifact.program.declarations.find? fun entry => + entry.1 == address).map (·.2) = some (.fn targetDefinition) := by + simpa [Eval.Context.ofProgram] using + (congrFun targetDeclarations address).symm.trans targetDeclaration + obtain ⟨sourceDefinition, calleeTrace, sourceLookup, calleeMember, + calleeMatch⟩ := + attached.target.artifact.functionTrace_of_target_lookup artifactLookup + refine ⟨sourceDefinition, calleeTrace, calleeMember, calleeMatch, ?_⟩ + rw [sourceDeclarations] + rw [← attached.sidecarDeclarationEnvironment] + rw [← attached.targetSourceProduced] + exact sourceLookup + +/-- Certified pipeline source environments contain no executable extern +declarations. This is the contradiction used when successful `invoke` +inversion exposes its scalar branch. -/ +theorem CompiledAttachment.sourceDeclaration_not_extern + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {address : Ixon.Address} {arity : Nat} + (sourceDeclaration : sourceContext.decls address = + some (.extern arity)) : False := by + apply attached.source.targetDeclEnv_ne_extern + change IxIR1.HPT.programDeclEnv + attached.source.lowering.result.artifacts address = + some (.extern arity) + rw [← sourceDeclarations] + exact sourceDeclaration + +/-- A successful target extern lookup is impossible for a certified pipeline +attachment. Declaration-order alignment reflects it to the source side, +whose emitted environment is closed to extern declarations. -/ +theorem CompiledAttachment.targetDeclaration_not_extern + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {context : Eval.Context} + (targetDeclarations : context.declarations = + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas).declarations) + {address : Ixon.Address} {arity : Nat} + (targetDeclaration : context.declarations address = + some (.extern arity)) : False := by + have artifactLookup : + (attached.target.artifact.program.declarations.find? fun entry => + entry.1 == address).map (·.2) = some (.extern arity) := by + simpa [Eval.Context.ofProgram] using + (congrFun targetDeclarations address).symm.trans targetDeclaration + have sourceLookup := + attached.target.artifact.sourceExtern_of_target_lookup artifactLookup + apply attached.source.targetDeclEnv_ne_extern + change IxIR1.HPT.programDeclEnv + attached.source.lowering.result.artifacts address = + some (.extern arity) + rw [← attached.sidecarDeclarationEnvironment] + rw [← attached.targetSourceProduced] + exact sourceLookup + +/-- Every successful source `applyGo` computation admits exactly the +evaluator-aligned plan consumed by `applyMoreReturnHandler_of_plan`. The +recursive over-application case follows the evaluator's predecessor fuel; +function invocation is inverted to expose the body run and result-world +check, while certified source/target declaration lookup supplies the retained +callee trace. -/ +theorem CompiledAttachment.applyMorePlan_of_applyGo + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {context : Eval.Context} + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (targetDeclarations : context.declarations = + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas).declarations) + {applyFuel : Nat} {sourceStore outputStore : IxIR1.Store} + {function outputValue : IxIR1.RVal} {values : List IxIR1.RVal} + (run : IxIR1.applyGo sourceContext applyFuel sourceStore function values = + .ok (outputStore, outputValue)) : + ApplyMorePlan attached sourceContext context applyFuel sourceStore function + values outputStore outputValue := by + induction applyFuel generalizing sourceStore function values outputStore + outputValue with + | zero => + rw [IxIR1.applyGo.eq_def] at run + contradiction + | succ fuel ih => + rw [IxIR1.applyGo.eq_def] at run + dsimp only at run + cases function with + | lit literal => simp at run + | erased => + cases sourceRelease : + IxIR1.dropMany sourceContext fuel sourceStore values with + | error error => + rw [sourceRelease] at run + simp only [bind, Except.bind] at run + contradiction + | ok sourceReleased => + rw [sourceRelease] at run + simp only [bind, Except.bind] at run + have outputEq : + (sourceReleased, IxIR1.RVal.erased) = + (outputStore, outputValue) := + Except.ok.inj run + cases outputEq + exact .erased sourceRelease + | loc location => + cases sourceGet : sourceStore.get? location with + | none => simp [sourceGet] at run + | some box => + simp only [sourceGet] at run + cases node : box.node with + | ctorN identity fields => + rw [node] at run + contradiction + | papN address arity captured => + rw [node] at run + dsimp only at run + cases sourceRetain : + IxIR1.dupVals sourceStore captured.toList with + | error error => + rw [sourceRetain] at run + simp only [bind, Except.bind] at run + contradiction + | ok sourceRetained => + rw [sourceRetain] at run + simp only [bind, Except.bind] at run + cases sourceRelease : IxIR1.dropVal sourceContext fuel + sourceRetained (.loc location) with + | error error => + rw [sourceRelease] at run + contradiction + | ok sourceReleased => + rw [sourceRelease] at run + let total := captured.toList ++ values + by_cases totalUnder : total.length < arity + · have totalUnderRaw : + (captured.toList ++ values).length < arity := by + simpa [total] using totalUnder + simp only [totalUnderRaw, if_true] at run + have totalArrayEq : + (captured.toList ++ values).toArray = + captured ++ values.toArray := by + apply Array.toList_inj.mp + simp + rw [totalArrayEq] at run + have outputEq : + (outputStore, outputValue) = + ((sourceReleased.allocNode .shared + (.papN address arity + (captured ++ values.toArray))).1, + .loc (sourceReleased.allocNode .shared + (.papN address arity + (captured ++ values.toArray))).2) := by + symm + simpa using Except.ok.inj run + cases outputEq + exact .papUnder sourceGet node sourceRetain + sourceRelease totalUnderRaw + · have totalNotUnderRaw : + ¬(captured.toList ++ values).length < arity := by + simpa [total] using totalUnder + simp only [totalNotUnderRaw, if_false] at run + cases totalExactBool : + (captured.toList ++ values).length == arity with + | false => + simp only [totalExactBool, Bool.false_eq_true, + if_false] at run + have totalNotExact : total.length ≠ arity := by + simpa [total] using totalExactBool + have totalOver : arity < total.length := by + omega + cases sourceDeclarationRaw : + sourceContext.decls address with + | none => simp [sourceDeclarationRaw] at run + | some declaration => + cases sourcePapSafeRaw : + IxIR1.declPapSafe declaration with + | false => + simp [sourceDeclarationRaw, + sourcePapSafeRaw] at run + | true => + simp only [sourceDeclarationRaw, + sourcePapSafeRaw, if_true] at run + cases invocationRun : IxIR1.invoke + sourceContext fuel address + ((captured.toList ++ values).take + arity) sourceReleased with + | error error => + rw [invocationRun] at run + contradiction + | ok called => + rcases called with + ⟨calledStore, calledValue⟩ + rw [invocationRun] at run + obtain ⟨calleeFuel, fuelEq, + invocation⟩ := + IxIR1.invoke_success invocationRun + cases invocation with + | @fn sourceDefinition bodyOutput + sourceDeclaration argumentArity + calleeRun resultRun => + have declarationEq : declaration = + .fn sourceDefinition := by + exact Option.some.inj + (sourceDeclarationRaw.symm.trans + sourceDeclaration) + subst declaration + have sourcePapSafe : + sourceDefinition.papSafe = + true := by + simpa [IxIR1.declPapSafe] using + sourcePapSafeRaw + obtain ⟨bodyOutputEq, + calleeResultWorld⟩ := + IxIR1.Sim.checkResultWorld_ok + resultRun + cases bodyOutputEq + obtain ⟨targetDefinition, + calleeTrace, calleeMember, + calleeMatch, + targetDeclaration⟩ := + attached.functionTrace_of_source_declaration + sourceDeclarations + targetDeclarations + sourceDeclaration + have suppliedLength : + (total.take arity).length = + arity := by + simp [List.length_take, + Nat.min_eq_left + (Nat.le_of_lt totalOver)] + have papArity : arity = + sourceDefinition.arity := + suppliedLength.symm.trans (by + simpa [total] using + argumentArity) + have residual := ih + (sourceStore := calledStore) + (function := calledValue) + (values := total.drop arity) + (outputStore := outputStore) + (outputValue := outputValue) + (by simpa [total] using run) + exact .papOverFn calleeMember + calleeMatch sourceGet node + sourceRetain sourceRelease + (by simpa [total] using + totalOver) + papArity sourceDeclaration + sourcePapSafe + targetDeclaration + (by simpa [total] using + calleeRun) + calleeResultWorld (by omega) + (by simpa [total] using + residual) + | @extern externArity externValue + sourceDeclaration _ _ _ => + exact False.elim + (attached.sourceDeclaration_not_extern + sourceDeclarations + sourceDeclaration) + | true => + simp only [totalExactBool, if_true] at run + have totalExact : total.length = arity := by + simpa [total] using totalExactBool + cases sourceDeclarationRaw : + sourceContext.decls address with + | none => simp [sourceDeclarationRaw] at run + | some declaration => + cases sourcePapSafeRaw : + IxIR1.declPapSafe declaration with + | false => + simp [sourceDeclarationRaw, + sourcePapSafeRaw] at run + | true => + simp only [sourceDeclarationRaw, + sourcePapSafeRaw, if_true] at run + obtain ⟨calleeFuel, fuelEq, + invocation⟩ := + IxIR1.invoke_success run + cases invocation with + | @fn sourceDefinition bodyOutput + sourceDeclaration argumentArity + calleeRun resultRun => + have declarationEq : declaration = + .fn sourceDefinition := by + exact Option.some.inj + (sourceDeclarationRaw.symm.trans + sourceDeclaration) + subst declaration + have sourcePapSafe : + sourceDefinition.papSafe = + true := by + simpa [IxIR1.declPapSafe] using + sourcePapSafeRaw + obtain ⟨bodyOutputEq, + calleeResultWorld⟩ := + IxIR1.Sim.checkResultWorld_ok + resultRun + cases bodyOutputEq + obtain ⟨targetDefinition, + calleeTrace, calleeMember, + calleeMatch, + targetDeclaration⟩ := + attached.functionTrace_of_source_declaration + sourceDeclarations + targetDeclarations + sourceDeclaration + have papArity : arity = + sourceDefinition.arity := + totalExact.symm.trans (by + simpa [total] using + argumentArity) + exact .papSaturatedFn calleeMember + calleeMatch sourceGet node + sourceRetain sourceRelease + (by simpa [total] using totalExact) + papArity sourceDeclaration + sourcePapSafe targetDeclaration + (by simpa [total] using calleeRun) + calleeResultWorld (by omega) + | @extern externArity externValue + sourceDeclaration _ _ _ => + exact False.elim + (attached.sourceDeclaration_not_extern + sourceDeclarations + sourceDeclaration) + +/-- Complete CPS composition for the `pure`/`move` trace branch. Source +success is inverted once, the generated target instruction takes one genuine +step, and the exact smaller-fuel worker continues from the retained child +trace with the same return handler. -/ +theorem CompiledAttachment.simulate_traced_pure_move_cps + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} {sourceAtom : IxIR1.Atom} + {targetAtom : Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.pure sourceAtom) index (.move targetAtom) next)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + {sourceOutput outcome : IxIR1.Store × IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.pure sourceAtom) index (.move targetAtom) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.pure sourceAtom) index (.move targetAtom) next) + sourceStore source frameRoots) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceRun : IxIR1.runCode sourceContext (sourceFuel + 2) + functionTrace.source sourceStore source + (.letOp (.pure sourceAtom) next.sourceCode) = .ok sourceOutput) + (resultWorld : IxIR1.Sim.HasWorld sourceOutput.1 + functionTrace.source.result sourceOutput.2) + (control : machine.control = .running frame stack) + (noCredits : frame.credits = #[]) + (image : attached.SourceStoreImage sourceStore) + {post : SourceMachinePost} + (finish : SuccessfulReturnHandler attached sourceContext context + interpretation functionTrace frameRoots stack sourceOutput outcome post) + (worker : SuccessfulTraceSimulationAt attached sourceContext context + interpretation (sourceFuel + 1)) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + obtain ⟨value, nextFrame, nextFrameEq, sourceResolved, continuationRun, + _, nextStores, nextState⟩ := + attached.simulate_traced_pure_move_success_step + (context := context) (interpretation := interpretation) functionMember + descendant state stores sourceDeclarations sourceRun control + subst nextFrame + have nextDescendant : functionTrace.root.Descendant next := by + exact .step descendant (by simp [Lower.CodeTrace.children]) + have nextRuntime : Lower.Sim.SourceRuntimeInvariant sourceStore + (value :: source) := + ⟨runtime.order, + IxIR1.Reclamation.ValuesInBounds.cons + (runtime.resolveAtom sourceResolved) runtime.rootsInBounds, + runtime.papsUnder⟩ + have nextOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next sourceStore + (value :: source) frameRoots := + Lower.Sim.SourceOwnershipAt.pure (checked := attached.target) + functionMember descendant ownership sourceResolved + let nextFrame : Eval.Frame := + { frame with + pc := frame.pc + 1 + values := frame.values.push value } + let nextMachine : Eval.Machine := + { machine with control := .running nextFrame stack } + have nextControl : nextMachine.control = .running nextFrame stack := rfl + have nextNoCredits : nextFrame.credits = #[] := by + simpa [nextFrame] using noCredits + have tail := worker (machine := nextMachine) (stack := stack) + functionMember nextDescendant nextState nextStores nextRuntime + nextOwnership continuationRun resultWorld nextControl nextNoCredits image + finish + obtain ⟨tailHeapFuel, tail⟩ := tail + let fundedMachine : Eval.Machine := { machine with heapFuel := tailHeapFuel } + have fundedStores : Lower.Sim.StoreRel sourceStore fundedMachine.store := by + simpa [fundedMachine] using stores + have fundedControl : fundedMachine.control = .running frame stack := by + simpa [fundedMachine] using control + obtain ⟨_, fundedStep, _, _⟩ := + attached.simulate_traced_pure_move_state + (sourceFuel := sourceFuel) (machine := fundedMachine) functionMember + descendant state fundedStores sourceDeclarations sourceResolved + fundedControl + refine ⟨tailHeapFuel, ?_⟩ + simpa [fundedMachine, nextMachine, nextFrame] using + tail.prepend (fundedStep.toSteps fundedControl) + +/-- Complete CPS composition for shared duplication. Both inert scalars and +live shared locations take one heap-fuel-preserving target step. -/ +theorem CompiledAttachment.simulate_traced_dup_retain_cps + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} {sourceAtom : IxIR1.Atom} + {targetAtom : Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.dup sourceAtom) index (.retainShared targetAtom) next)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + {sourceOutput outcome : IxIR1.Store × IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.dup sourceAtom) index (.retainShared targetAtom) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.dup sourceAtom) index (.retainShared targetAtom) next) + sourceStore source frameRoots) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceRun : IxIR1.runCode sourceContext (sourceFuel + 2) + functionTrace.source sourceStore source + (.letOp (.dup sourceAtom) next.sourceCode) = .ok sourceOutput) + (resultWorld : IxIR1.Sim.HasWorld sourceOutput.1 + functionTrace.source.result sourceOutput.2) + (control : machine.control = .running frame stack) + (noCredits : frame.credits = #[]) + (image : attached.SourceStoreImage sourceStore) + {post : SourceMachinePost} + (finish : SuccessfulReturnHandler attached sourceContext context + interpretation functionTrace frameRoots stack sourceOutput outcome post) + (worker : SuccessfulTraceSimulationAt attached sourceContext context + interpretation (sourceFuel + 1)) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + obtain ⟨middleStore, operationValue, operationRun, continuationRun⟩ := + IxIR1.runCode_letOp_success sourceRun + have middleImage : attached.SourceStoreImage middleStore := + attached.runOp_preservesSourceStoreImage sourceDeclarations functionMember + descendant state image operationRun + obtain ⟨value, sourceResolved, operationOutput⟩ := + IxIR1.runOp_dup_success operationRun + have nextDescendant : functionTrace.root.Descendant next := by + exact .step descendant (by simp [Lower.CodeTrace.children]) + have scalarCase (selected : IxIR1.RVal) + (selectedResolved : + IxIR1.resolveAtom source sourceAtom = .ok selected) + (scalar : Eval.RVal.isScalar selected = true) + (outputEq : (middleStore, operationValue) = + (sourceStore, selected)) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + have middleStoreEq : middleStore = sourceStore := + congrArg Prod.fst outputEq + have operationValueEq : operationValue = selected := + congrArg Prod.snd outputEq + subst middleStore + subst operationValue + obtain ⟨_, targetStep, nextStores, nextState⟩ := + attached.simulate_traced_dup_retain_scalar_state + (sourceFuel := sourceFuel) (context := context) + (interpretation := interpretation) functionMember descendant state + stores sourceDeclarations selectedResolved scalar control + have nextRuntime : Lower.Sim.SourceRuntimeInvariant sourceStore + (selected :: source) := + runtime.runOp rfl operationRun + have nextOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next sourceStore + (selected :: source) frameRoots := + Lower.Sim.SourceOwnershipAt.dup (checked := attached.target) + functionMember descendant ownership selectedResolved operationRun + let nextFrame : Eval.Frame := + { frame with + pc := frame.pc + 1 + values := frame.values.push selected } + let nextMachine : Eval.Machine := + { machine with control := .running nextFrame stack } + have nextControl : nextMachine.control = + .running nextFrame stack := rfl + have nextNoCredits : nextFrame.credits = #[] := by + simpa [nextFrame] using noCredits + have tail := worker (machine := nextMachine) (stack := stack) + functionMember nextDescendant nextState nextStores nextRuntime + nextOwnership continuationRun resultWorld nextControl nextNoCredits + middleImage finish + refine BudgetedReachesPost.prependPreserving + (before := machine) (middle := nextMachine) (prefixCount := 1) ?_ tail + intro heapFuel + let fundedMachine : Eval.Machine := { machine with heapFuel } + have fundedStores : + Lower.Sim.StoreRel sourceStore fundedMachine.store := by + simpa [fundedMachine] using stores + have fundedControl : fundedMachine.control = .running frame stack := by + simpa [fundedMachine] using control + obtain ⟨_, fundedStep, _, _⟩ := + attached.simulate_traced_dup_retain_scalar_state + (sourceFuel := sourceFuel) (context := context) + (interpretation := interpretation) (machine := fundedMachine) + functionMember descendant state fundedStores sourceDeclarations + selectedResolved scalar fundedControl + simpa [fundedMachine, nextMachine, nextFrame] using + fundedStep.toSteps fundedControl + cases value with + | lit literal => + exact scalarCase (.lit literal) sourceResolved (by rfl) operationOutput + | erased => + exact scalarCase .erased sourceResolved (by rfl) operationOutput + | loc location => + obtain ⟨box, sourceGet, shared, outputEq⟩ := operationOutput + let nextBox : IxIR1.NodeBox := { box with rc := box.rc + 1 } + let sourceStore' : IxIR1.Store := + (sourceStore.setBox location nextBox).rcTick + let targetStore' : Eval.Store := + (machine.store.setBox location nextBox).rcTick + have middleStoreEq : middleStore = sourceStore' := by + simpa [sourceStore', nextBox] using congrArg Prod.fst outputEq + have operationValueEq : operationValue = .loc location := + congrArg Prod.snd outputEq + subst middleStore + subst operationValue + obtain ⟨_, targetStep, nextStores, nextState⟩ := + attached.simulate_traced_dup_retain_shared_state + (sourceFuel := sourceFuel) (context := context) + (interpretation := interpretation) functionMember descendant state + stores sourceDeclarations sourceResolved sourceGet shared control + have nextRuntime : Lower.Sim.SourceRuntimeInvariant sourceStore' + (.loc location :: source) := by + apply runtime.runOp + (run := operationRun) + simp [sourceStore', nextBox, IxIR1.Store.setBox, IxIR1.Store.rcTick] + have nextOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next sourceStore' + (.loc location :: source) frameRoots := + Lower.Sim.SourceOwnershipAt.dup (checked := attached.target) + functionMember descendant ownership sourceResolved operationRun + let nextFrame : Eval.Frame := + { frame with + pc := frame.pc + 1 + values := frame.values.push (.loc location) } + let nextMachine : Eval.Machine := + { machine with + store := targetStore' + control := .running nextFrame stack } + have nextControl : nextMachine.control = + .running nextFrame stack := rfl + have nextNoCredits : nextFrame.credits = #[] := by + simpa [nextFrame] using noCredits + have nextStores' : + Lower.Sim.StoreRel sourceStore' nextMachine.store := by + simpa [nextMachine, targetStore', sourceStore', nextBox] using nextStores + have tail := worker (machine := nextMachine) (stack := stack) + functionMember nextDescendant nextState nextStores' nextRuntime + nextOwnership continuationRun resultWorld nextControl nextNoCredits + middleImage finish + refine BudgetedReachesPost.prependPreserving + (before := machine) (middle := nextMachine) (prefixCount := 1) ?_ tail + intro heapFuel + let fundedMachine : Eval.Machine := { machine with heapFuel } + have fundedStores : + Lower.Sim.StoreRel sourceStore fundedMachine.store := by + simpa [fundedMachine] using stores + have fundedControl : fundedMachine.control = .running frame stack := by + simpa [fundedMachine] using control + obtain ⟨_, fundedStep, _, _⟩ := + attached.simulate_traced_dup_retain_shared_state + (sourceFuel := sourceFuel) (context := context) + (interpretation := interpretation) (machine := fundedMachine) + functionMember descendant state fundedStores sourceDeclarations + sourceResolved sourceGet shared fundedControl + simpa [fundedMachine, nextMachine, nextFrame, targetStore', nextBox] using + fundedStep.toSteps fundedControl + +/-- Complete CPS composition for an HPT-certified constructor projection. -/ +theorem CompiledAttachment.simulate_traced_fetch_cps + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} {sourceAtom : IxIR1.Atom} + {targetAtom : Atom} {sourceField targetField : Nat} + {targetCid : IxIR1.CtorId} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.fetch sourceAtom sourceField) index + (.fetch targetAtom targetCid targetField) next)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + {sourceOutput outcome : IxIR1.Store × IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.fetch sourceAtom sourceField) index + (.fetch targetAtom targetCid targetField) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.fetch sourceAtom sourceField) index + (.fetch targetAtom targetCid targetField) next) + sourceStore source frameRoots) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceRun : IxIR1.runCode sourceContext (sourceFuel + 2) + functionTrace.source sourceStore source + (.letOp (.fetch sourceAtom sourceField) next.sourceCode) = + .ok sourceOutput) + (resultWorld : IxIR1.Sim.HasWorld sourceOutput.1 + functionTrace.source.result sourceOutput.2) + (control : machine.control = .running frame stack) + (noCredits : frame.credits = #[]) + (image : attached.SourceStoreImage sourceStore) + {post : SourceMachinePost} + (finish : SuccessfulReturnHandler attached sourceContext context + interpretation functionTrace frameRoots stack sourceOutput outcome post) + (worker : SuccessfulTraceSimulationAt attached sourceContext context + interpretation (sourceFuel + 1)) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + obtain ⟨middleStore, operationValue, operationRun, continuationRun⟩ := + IxIR1.runCode_letOp_success sourceRun + have middleImage : attached.SourceStoreImage middleStore := + attached.runOp_preservesSourceStoreImage sourceDeclarations functionMember + descendant state image operationRun + obtain ⟨location, box, identity, fields, value, sourceResolved, sourceGet, + node, fieldAt, outputEq⟩ := + IxIR1.runOp_fetch_success operationRun + have middleStoreEq : middleStore = sourceStore := + congrArg Prod.fst outputEq + have operationValueEq : operationValue = value := + congrArg Prod.snd outputEq + subst middleStore + subst operationValue + obtain ⟨_, targetStep, nextStores, nextState⟩ := + attached.simulate_traced_fetch_state_of_run_hpt + (sourceFuel := sourceFuel) (context := context) + (interpretation := interpretation) functionMember descendant state stores + sourceDeclarations operationRun control + have nextDescendant : functionTrace.root.Descendant next := by + exact .step descendant (by simp [Lower.CodeTrace.children]) + have nextRuntime : Lower.Sim.SourceRuntimeInvariant sourceStore + (value :: source) := + runtime.runOp rfl operationRun + have nextOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next sourceStore + (value :: source) frameRoots := + Lower.Sim.SourceOwnershipAt.fetch (checked := attached.target) + functionMember descendant ownership operationRun + let nextFrame : Eval.Frame := + { frame with + pc := frame.pc + 1 + values := frame.values.push value } + let nextMachine : Eval.Machine := + { machine with control := .running nextFrame stack } + have nextControl : nextMachine.control = .running nextFrame stack := rfl + have nextNoCredits : nextFrame.credits = #[] := by + simpa [nextFrame] using noCredits + have tail := worker (machine := nextMachine) (stack := stack) + functionMember nextDescendant nextState nextStores nextRuntime + nextOwnership continuationRun resultWorld nextControl nextNoCredits + middleImage finish + refine BudgetedReachesPost.prependPreserving + (before := machine) (middle := nextMachine) (prefixCount := 1) ?_ tail + intro heapFuel + let fundedMachine : Eval.Machine := { machine with heapFuel } + have fundedStores : + Lower.Sim.StoreRel sourceStore fundedMachine.store := by + simpa [fundedMachine] using stores + have fundedControl : fundedMachine.control = .running frame stack := by + simpa [fundedMachine] using control + obtain ⟨_, fundedStep, _, _⟩ := + attached.simulate_traced_fetch_state_of_run_hpt + (sourceFuel := sourceFuel) (context := context) + (interpretation := interpretation) (machine := fundedMachine) + functionMember descendant state fundedStores sourceDeclarations + operationRun fundedControl + simpa [fundedMachine, nextMachine, nextFrame] using + fundedStep.toSteps fundedControl + +/-- Complete CPS composition for an HPT-certified scalar-leaf shallow free. -/ +theorem CompiledAttachment.simulate_traced_free_freeUnique_cps + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} {sourceAtom : IxIR1.Atom} + {targetAtom : Atom} {targetCid : IxIR1.CtorId} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.free sourceAtom) index (.freeUnique targetAtom targetCid) next)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + {sourceOutput outcome : IxIR1.Store × IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.free sourceAtom) index (.freeUnique targetAtom targetCid) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.free sourceAtom) index (.freeUnique targetAtom targetCid) next) + sourceStore source frameRoots) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceRun : IxIR1.runCode sourceContext (sourceFuel + 2) + functionTrace.source sourceStore source + (.letOp (.free sourceAtom) next.sourceCode) = .ok sourceOutput) + (resultWorld : IxIR1.Sim.HasWorld sourceOutput.1 + functionTrace.source.result sourceOutput.2) + (control : machine.control = .running frame stack) + (noCredits : frame.credits = #[]) + (image : attached.SourceStoreImage sourceStore) + {post : SourceMachinePost} + (finish : SuccessfulReturnHandler attached sourceContext context + interpretation functionTrace frameRoots stack sourceOutput outcome post) + (worker : SuccessfulTraceSimulationAt attached sourceContext context + interpretation (sourceFuel + 1)) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + obtain ⟨middleStore, operationValue, operationRun, continuationRun⟩ := + IxIR1.runCode_letOp_success sourceRun + have middleImage : attached.SourceStoreImage middleStore := + attached.runOp_preservesSourceStoreImage sourceDeclarations functionMember + descendant state image operationRun + obtain ⟨location, box, sourceResolved, sourceGet, unique, outputEq⟩ := + IxIR1.runOp_free_success operationRun + have middleStoreEq : middleStore = sourceStore.kill location := + congrArg Prod.fst outputEq + have operationValueEq : operationValue = .erased := + congrArg Prod.snd outputEq + subst middleStore + subst operationValue + obtain ⟨fact, selected⟩ := + attached.scalarLeafAt?_of_free_descendant functionMember descendant + obtain ⟨exactBox, fields, exactGet, node, scalarFields⟩ := + attached.sidecars.scalarLeafAt?_runtime selected state.environment + sourceResolved + have boxEq : exactBox = box := + Option.some.inj (exactGet.symm.trans sourceGet) + subst exactBox + obtain ⟨_, targetStep, nextStores, nextTarget⟩ := + Lower.Sim.simulate_traced_free_freeUnique_state + (sourceContext := sourceContext) (sourceCurrent := functionTrace.source) + (sourceFuel := sourceFuel) (context := context) + (interpretation := interpretation) descendant state.target stores + sourceResolved sourceGet unique node scalarFields control + have nextState := attached.traceState_next_of_member functionMember state + descendant sourceDeclarations operationRun nextTarget + have nextDescendant : functionTrace.root.Descendant next := by + exact .step descendant (by simp [Lower.CodeTrace.children]) + have nextRuntime : Lower.Sim.SourceRuntimeInvariant + (sourceStore.kill location) (.erased :: source) := by + apply runtime.runOp + (run := operationRun) + simp [IxIR1.Store.kill] + have nextOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next + (sourceStore.kill location) (.erased :: source) frameRoots := + Lower.Sim.SourceOwnershipAt.free (checked := attached.target) + functionMember descendant ownership sourceResolved sourceGet unique node + scalarFields operationRun + let nextFrame : Eval.Frame := { frame with pc := frame.pc + 1 } + let nextMachine : Eval.Machine := + { machine with + store := machine.store.kill location + control := .running nextFrame stack } + have nextControl : nextMachine.control = .running nextFrame stack := rfl + have nextNoCredits : nextFrame.credits = #[] := by + simpa [nextFrame] using noCredits + have nextStores' : Lower.Sim.StoreRel (sourceStore.kill location) + nextMachine.store := by + simpa [nextMachine] using nextStores + have tail := worker (machine := nextMachine) (stack := stack) + functionMember nextDescendant nextState nextStores' nextRuntime + nextOwnership continuationRun resultWorld nextControl nextNoCredits + middleImage finish + refine BudgetedReachesPost.prependPreserving + (before := machine) (middle := nextMachine) (prefixCount := 1) ?_ tail + intro heapFuel + let fundedMachine : Eval.Machine := { machine with heapFuel } + have fundedStores : + Lower.Sim.StoreRel sourceStore fundedMachine.store := by + simpa [fundedMachine] using stores + have fundedControl : fundedMachine.control = .running frame stack := by + simpa [fundedMachine] using control + obtain ⟨_, fundedStep, _, _⟩ := + Lower.Sim.simulate_traced_free_freeUnique_state + (sourceContext := sourceContext) (sourceCurrent := functionTrace.source) + (sourceFuel := sourceFuel) (context := context) + (interpretation := interpretation) (machine := fundedMachine) + descendant state.target fundedStores sourceResolved sourceGet unique node + scalarFields fundedControl + simpa [fundedMachine, nextMachine, nextFrame] using + fundedStep.toSteps fundedControl + +/-- Complete CPS composition for shared destruction. Scalar releases reserve +one heap unit ahead of the continuation; recursive location releases use the +framed work-list plan to reserve exactly their local traversal cost plus the +continuation's independently selected budget. -/ +theorem CompiledAttachment.simulate_traced_drop_release_cps + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} {sourceAtom : IxIR1.Atom} + {targetAtom : Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.drop sourceAtom) index (.releaseShared targetAtom) next)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + {sourceOutput outcome : IxIR1.Store × IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.drop sourceAtom) index (.releaseShared targetAtom) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.drop sourceAtom) index (.releaseShared targetAtom) next) + sourceStore source frameRoots) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceRun : IxIR1.runCode sourceContext (sourceFuel + 2) + functionTrace.source sourceStore source + (.letOp (.drop sourceAtom) next.sourceCode) = .ok sourceOutput) + (resultWorld : IxIR1.Sim.HasWorld sourceOutput.1 + functionTrace.source.result sourceOutput.2) + (control : machine.control = .running frame stack) + (noCredits : frame.credits = #[]) + (image : attached.SourceStoreImage sourceStore) + {post : SourceMachinePost} + (finish : SuccessfulReturnHandler attached sourceContext context + interpretation functionTrace frameRoots stack sourceOutput outcome post) + (worker : SuccessfulTraceSimulationAt attached sourceContext context + interpretation (sourceFuel + 1)) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + obtain ⟨middleStore, operationValue, operationRun, continuationRun⟩ := + IxIR1.runCode_letOp_success sourceRun + have middleImage : attached.SourceStoreImage middleStore := + attached.runOp_preservesSourceStoreImage sourceDeclarations functionMember + descendant state image operationRun + obtain ⟨value, sourceResolved, operationOutput⟩ := + IxIR1.runOp_drop_success operationRun + have nextDescendant : functionTrace.root.Descendant next := by + exact .step descendant (by simp [Lower.CodeTrace.children]) + have scalarCase (selected : IxIR1.RVal) + (selectedResolved : + IxIR1.resolveAtom source sourceAtom = .ok selected) + (scalar : Eval.RVal.isScalar selected = true) + (outputEq : (middleStore, operationValue) = + (sourceStore, .erased)) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + have middleStoreEq : middleStore = sourceStore := + congrArg Prod.fst outputEq + have operationValueEq : operationValue = .erased := + congrArg Prod.snd outputEq + subst middleStore + subst operationValue + let nextFrame : Eval.Frame := { frame with pc := frame.pc + 1 } + let probeMachine : Eval.Machine := { machine with heapFuel := 1 } + have probeStores : Lower.Sim.StoreRel sourceStore probeMachine.store := by + simpa [probeMachine] using stores + have probeControl : probeMachine.control = .running frame stack := by + simpa [probeMachine] using control + obtain ⟨_, _, nextStores, nextState⟩ := + attached.simulate_traced_drop_release_scalar_state + (sourceFuel := sourceFuel) (targetHeapFuel := 0) + (context := context) (interpretation := interpretation) + (machine := probeMachine) functionMember descendant state probeStores + sourceDeclarations selectedResolved scalar + (heapFuel := by simp [probeMachine]) probeControl + let nextMachine : Eval.Machine := + { machine with control := .running nextFrame stack } + have nextStores' : + Lower.Sim.StoreRel sourceStore nextMachine.store := by + simpa [nextMachine, probeMachine] using nextStores + have nextRuntime : Lower.Sim.SourceRuntimeInvariant sourceStore + (.erased :: source) := + runtime.runOp rfl operationRun + have nextOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next sourceStore + (.erased :: source) frameRoots := + Lower.Sim.SourceOwnershipAt.drop (checked := attached.target) + functionMember descendant ownership operationRun + have nextControl : nextMachine.control = + .running nextFrame stack := rfl + have nextNoCredits : nextFrame.credits = #[] := by + simpa [nextFrame] using noCredits + have tail := worker (machine := nextMachine) (stack := stack) + functionMember nextDescendant nextState nextStores' nextRuntime + nextOwnership continuationRun resultWorld nextControl nextNoCredits + middleImage finish + obtain ⟨tailHeapFuel, tail⟩ := tail + let fundedMachine : Eval.Machine := + { machine with heapFuel := tailHeapFuel + 1 } + have fundedStores : + Lower.Sim.StoreRel sourceStore fundedMachine.store := by + simpa [fundedMachine] using stores + have fundedControl : fundedMachine.control = .running frame stack := by + simpa [fundedMachine] using control + obtain ⟨_, fundedStep, _, _⟩ := + attached.simulate_traced_drop_release_scalar_state + (sourceFuel := sourceFuel) (targetHeapFuel := tailHeapFuel) + (context := context) (interpretation := interpretation) + (machine := fundedMachine) functionMember descendant state + fundedStores sourceDeclarations selectedResolved scalar + (heapFuel := by simp [fundedMachine]) fundedControl + refine ⟨tailHeapFuel + 1, ?_⟩ + simpa [fundedMachine, nextMachine, nextFrame] using + tail.prepend (fundedStep.toSteps fundedControl) + cases value with + | lit literal => + exact scalarCase (.lit literal) sourceResolved (by rfl) operationOutput + | erased => + exact scalarCase .erased sourceResolved (by rfl) operationOutput + | loc location => + obtain ⟨sourceStore', sourceDropped, outputEq⟩ := operationOutput + have middleStoreEq : middleStore = sourceStore' := + congrArg Prod.fst outputEq + have operationValueEq : operationValue = .erased := + congrArg Prod.snd outputEq + subst middleStore + subst operationValue + have nextRuntime : Lower.Sim.SourceRuntimeInvariant sourceStore' + (.erased :: source) := + runtime.runOp (IxIR1.NoReuse.dropVal_reuses sourceDropped) + operationRun + have nextOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next sourceStore' + (.erased :: source) frameRoots := + Lower.Sim.SourceOwnershipAt.drop (checked := attached.target) + functionMember descendant ownership operationRun + obtain ⟨localFuel, targetStore, _, _, stepForSuffix, nextStores, + _, nextState⟩ := + attached.simulate_traced_drop_release_recursive_state_framed + (sourceFuel := sourceFuel) (context := context) + (interpretation := interpretation) functionMember descendant state + runtime.positiveSharedRC stores sourceDeclarations sourceResolved + sourceDropped control + let nextFrame : Eval.Frame := { frame with pc := frame.pc + 1 } + let nextMachine : Eval.Machine := + { store := targetStore + heapFuel := 0 + control := .running nextFrame stack } + have nextControl : nextMachine.control = + .running nextFrame stack := rfl + have nextNoCredits : nextFrame.credits = #[] := by + simpa [nextFrame] using noCredits + have tail := worker (machine := nextMachine) (stack := stack) + functionMember nextDescendant nextState nextStores nextRuntime + nextOwnership continuationRun resultWorld nextControl nextNoCredits + middleImage finish + obtain ⟨tailHeapFuel, tail⟩ := tail + have prefixControl : + ({ machine with heapFuel := localFuel + tailHeapFuel } : + Eval.Machine).control = .running frame stack := by + simpa using control + refine ⟨localFuel + tailHeapFuel, ?_⟩ + simpa [nextMachine, nextFrame] using + tail.prepend ((stepForSuffix tailHeapFuel).toSteps prefixControl) + +/-- Complete CPS composition for unique destruction, with the same backward +heap-budget discipline as shared release. -/ +theorem CompiledAttachment.simulate_traced_dropU_dropUnique_cps + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} {sourceAtom : IxIR1.Atom} + {targetAtom : Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.dropU sourceAtom) index (.dropUnique targetAtom) next)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + {sourceOutput outcome : IxIR1.Store × IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.dropU sourceAtom) index (.dropUnique targetAtom) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.dropU sourceAtom) index (.dropUnique targetAtom) next) + sourceStore source frameRoots) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceRun : IxIR1.runCode sourceContext (sourceFuel + 2) + functionTrace.source sourceStore source + (.letOp (.dropU sourceAtom) next.sourceCode) = .ok sourceOutput) + (resultWorld : IxIR1.Sim.HasWorld sourceOutput.1 + functionTrace.source.result sourceOutput.2) + (control : machine.control = .running frame stack) + (noCredits : frame.credits = #[]) + (image : attached.SourceStoreImage sourceStore) + {post : SourceMachinePost} + (finish : SuccessfulReturnHandler attached sourceContext context + interpretation functionTrace frameRoots stack sourceOutput outcome post) + (worker : SuccessfulTraceSimulationAt attached sourceContext context + interpretation (sourceFuel + 1)) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + obtain ⟨middleStore, operationValue, operationRun, continuationRun⟩ := + IxIR1.runCode_letOp_success sourceRun + have middleImage : attached.SourceStoreImage middleStore := + attached.runOp_preservesSourceStoreImage sourceDeclarations functionMember + descendant state image operationRun + obtain ⟨value, sourceResolved, operationOutput⟩ := + IxIR1.runOp_dropU_success operationRun + have nextDescendant : functionTrace.root.Descendant next := by + exact .step descendant (by simp [Lower.CodeTrace.children]) + have scalarCase (selected : IxIR1.RVal) + (selectedResolved : + IxIR1.resolveAtom source sourceAtom = .ok selected) + (scalar : Eval.RVal.isScalar selected = true) + (outputEq : (middleStore, operationValue) = + (sourceStore, .erased)) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + have middleStoreEq : middleStore = sourceStore := + congrArg Prod.fst outputEq + have operationValueEq : operationValue = .erased := + congrArg Prod.snd outputEq + subst middleStore + subst operationValue + let nextFrame : Eval.Frame := { frame with pc := frame.pc + 1 } + let probeMachine : Eval.Machine := { machine with heapFuel := 1 } + have probeStores : Lower.Sim.StoreRel sourceStore probeMachine.store := by + simpa [probeMachine] using stores + have probeControl : probeMachine.control = .running frame stack := by + simpa [probeMachine] using control + obtain ⟨_, _, nextStores, nextState⟩ := + attached.simulate_traced_dropU_dropUnique_scalar_state + (sourceFuel := sourceFuel) (targetHeapFuel := 0) + (context := context) (interpretation := interpretation) + (machine := probeMachine) functionMember descendant state probeStores + sourceDeclarations selectedResolved scalar + (heapFuel := by simp [probeMachine]) probeControl + let nextMachine : Eval.Machine := + { machine with control := .running nextFrame stack } + have nextStores' : + Lower.Sim.StoreRel sourceStore nextMachine.store := by + simpa [nextMachine, probeMachine] using nextStores + have nextRuntime : Lower.Sim.SourceRuntimeInvariant sourceStore + (.erased :: source) := + runtime.runOp rfl operationRun + have nextOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next sourceStore + (.erased :: source) frameRoots := + Lower.Sim.SourceOwnershipAt.dropU (checked := attached.target) + functionMember descendant ownership operationRun + have nextControl : nextMachine.control = + .running nextFrame stack := rfl + have nextNoCredits : nextFrame.credits = #[] := by + simpa [nextFrame] using noCredits + have tail := worker (machine := nextMachine) (stack := stack) + functionMember nextDescendant nextState nextStores' nextRuntime + nextOwnership continuationRun resultWorld nextControl nextNoCredits + middleImage finish + obtain ⟨tailHeapFuel, tail⟩ := tail + let fundedMachine : Eval.Machine := + { machine with heapFuel := tailHeapFuel + 1 } + have fundedStores : + Lower.Sim.StoreRel sourceStore fundedMachine.store := by + simpa [fundedMachine] using stores + have fundedControl : fundedMachine.control = .running frame stack := by + simpa [fundedMachine] using control + obtain ⟨_, fundedStep, _, _⟩ := + attached.simulate_traced_dropU_dropUnique_scalar_state + (sourceFuel := sourceFuel) (targetHeapFuel := tailHeapFuel) + (context := context) (interpretation := interpretation) + (machine := fundedMachine) functionMember descendant state + fundedStores sourceDeclarations selectedResolved scalar + (heapFuel := by simp [fundedMachine]) fundedControl + refine ⟨tailHeapFuel + 1, ?_⟩ + simpa [fundedMachine, nextMachine, nextFrame] using + tail.prepend (fundedStep.toSteps fundedControl) + cases value with + | lit literal => + exact scalarCase (.lit literal) sourceResolved (by rfl) operationOutput + | erased => + exact scalarCase .erased sourceResolved (by rfl) operationOutput + | loc location => + obtain ⟨sourceStore', sourceDropped, outputEq⟩ := operationOutput + have middleStoreEq : middleStore = sourceStore' := + congrArg Prod.fst outputEq + have operationValueEq : operationValue = .erased := + congrArg Prod.snd outputEq + subst middleStore + subst operationValue + have nextRuntime : Lower.Sim.SourceRuntimeInvariant sourceStore' + (.erased :: source) := + runtime.runOp (IxIR1.NoReuse.dropUVal_reuses sourceDropped) + operationRun + have nextOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next sourceStore' + (.erased :: source) frameRoots := + Lower.Sim.SourceOwnershipAt.dropU (checked := attached.target) + functionMember descendant ownership operationRun + obtain ⟨localFuel, targetStore, _, _exactDrop, stepForSuffix, nextStores, + nextState⟩ := + attached.simulate_traced_dropU_dropUnique_recursive_state_framed + (sourceFuel := sourceFuel) (context := context) + (interpretation := interpretation) functionMember descendant state + stores sourceDeclarations sourceResolved sourceDropped control + let nextFrame : Eval.Frame := { frame with pc := frame.pc + 1 } + let nextMachine : Eval.Machine := + { store := targetStore + heapFuel := 0 + control := .running nextFrame stack } + have nextControl : nextMachine.control = + .running nextFrame stack := rfl + have nextNoCredits : nextFrame.credits = #[] := by + simpa [nextFrame] using noCredits + have tail := worker (machine := nextMachine) (stack := stack) + functionMember nextDescendant nextState nextStores nextRuntime + nextOwnership continuationRun resultWorld nextControl nextNoCredits + middleImage finish + obtain ⟨tailHeapFuel, tail⟩ := tail + have prefixControl : + ({ machine with heapFuel := localFuel + tailHeapFuel } : + Eval.Machine).control = .running frame stack := by + simpa using control + refine ⟨localFuel + tailHeapFuel, ?_⟩ + simpa [nextMachine, nextFrame] using + tail.prepend ((stepForSuffix tailHeapFuel).toSteps prefixControl) + +/-- CPS composition for checked ordinary allocation. The checked trace +recovers the exact uniform schema and producer capabilities; the trace-indexed +source ownership invariant justifies the target field worlds. Allocation then +preserves the continuation's chosen heap budget. -/ +theorem CompiledAttachment.simulate_traced_alloc_checked_cps + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + (contextSchemas : context.schemas = + attached.target.artifact.validationContext.schemas) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} {sourceWorld targetWorld : Ixon.Owned} + {sourceCid targetCid : IxIR1.CtorId} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + {sourceOutput outcome : IxIR1.Store × IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next) + sourceStore source frameRoots) + (sourceRun : IxIR1.runCode sourceContext (sourceFuel + 2) + functionTrace.source sourceStore source + (.letOp (.alloc sourceWorld sourceCid sourceArguments) + next.sourceCode) = .ok sourceOutput) + (resultWorld : IxIR1.Sim.HasWorld sourceOutput.1 + functionTrace.source.result sourceOutput.2) + (control : machine.control = .running frame stack) + (noCredits : frame.credits = #[]) + (image : attached.SourceStoreImage sourceStore) + {post : SourceMachinePost} + (finish : SuccessfulReturnHandler attached sourceContext context + .logical functionTrace frameRoots stack sourceOutput outcome post) + (worker : SuccessfulTraceSimulationAt attached sourceContext context + .logical (sourceFuel + 1)) : + BudgetedReachesPost context .logical post outcome.1 outcome.2 + machine := by + obtain ⟨schema, checkedSchemaAt, _⟩ := + attached.target.allocationSchema functionMember descendant + have schemaAt : context.schemas sourceWorld sourceCid = some schema := by + rw [contextSchemas] + exact checkedSchemaAt + obtain ⟨values, sourceAllocation, targetAllocation, nextFrame, + sourceAllocationEq, targetAllocationEq, sourceResolved, + continuationRun, nextFrameEq, targetStep, nextStores, nextState⟩ := + attached.simulate_traced_alloc_checked_success_step + (context := context) (machine := machine) functionMember contextSchemas + descendant state stores sourceDeclarations sourceRun control schemaAt + ownership + subst sourceAllocation + subst targetAllocation + subst nextFrame + let node : IxIR1.Node := .ctorN sourceCid values.toArray + let sourceAllocation := sourceStore.allocNode sourceWorld node + let targetAllocation := machine.store.allocNode sourceWorld node + have nextDescendant : functionTrace.root.Descendant next := by + exact .step descendant (by simp [Lower.CodeTrace.children]) + have operationRun : IxIR1.runOp sourceContext (sourceFuel + 1) + functionTrace.source sourceStore source + (.alloc sourceWorld sourceCid sourceArguments) = + .ok (sourceAllocation.1, .loc sourceAllocation.2) := by + unfold IxIR1.runOp + simp only + rw [sourceResolved] + rfl + have nextImage : attached.SourceStoreImage sourceAllocation.1 := + attached.runOp_preservesSourceStoreImage sourceDeclarations functionMember + descendant state image operationRun + have nextRuntime : Lower.Sim.SourceRuntimeInvariant sourceAllocation.1 + (.loc sourceAllocation.2 :: source) := by + apply runtime.runOp (run := operationRun) + simp [sourceAllocation, node, IxIR1.Store.allocNode] + have nextOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next sourceAllocation.1 + (.loc sourceAllocation.2 :: source) frameRoots := + Lower.Sim.SourceOwnershipAt.alloc (checked := attached.target) + functionMember descendant ownership operationRun + let nextFrame : Eval.Frame := + { frame with + pc := frame.pc + 1 + values := frame.values.push (.loc sourceAllocation.2) } + let nextMachine : Eval.Machine := + { machine with + store := targetAllocation.1 + control := .running nextFrame stack } + have nextControl : nextMachine.control = .running nextFrame stack := rfl + have nextNoCredits : nextFrame.credits = #[] := by + simpa [nextFrame] using noCredits + have nextStores' : Lower.Sim.StoreRel sourceAllocation.1 + nextMachine.store := by + simpa [nextMachine, targetAllocation, sourceAllocation, node] using + nextStores + have tail := worker (machine := nextMachine) (stack := stack) + functionMember nextDescendant nextState nextStores' nextRuntime + nextOwnership continuationRun resultWorld nextControl nextNoCredits + nextImage finish + refine BudgetedReachesPost.prependPreserving + (before := machine) (middle := nextMachine) (prefixCount := 1) ?_ tail + intro heapFuel + let fundedMachine : Eval.Machine := { machine with heapFuel } + have fundedStores : + Lower.Sim.StoreRel sourceStore fundedMachine.store := by + simpa [fundedMachine] using stores + have fundedControl : fundedMachine.control = .running frame stack := by + simpa [fundedMachine] using control + obtain ⟨_, fundedStep, _, _⟩ := + attached.simulate_traced_alloc_checked_state + (sourceFuel := sourceFuel) (context := context) + (machine := fundedMachine) functionMember contextSchemas descendant + state fundedStores sourceDeclarations sourceResolved fundedControl + schemaAt ownership + simpa [fundedMachine, nextMachine, nextFrame, targetAllocation, + sourceAllocation, node] using fundedStep.toSteps fundedControl + +/-- Complete CPS composition for strictly under-saturated function PAP +allocation. Source success fixes the captured vector and fresh node; the +generated target allocation preserves the continuation's chosen heap budget. -/ +theorem CompiledAttachment.simulate_traced_papp_fn_cps + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {sourceDefinition : IxIR1.FnDef} {targetDefinition : Function} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} {sourceAddress targetAddress : Ixon.Address} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.papp sourceAddress sourceArguments) index + (.papp targetAddress targetArguments) next)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + {sourceOutput outcome : IxIR1.Store × IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.papp sourceAddress sourceArguments) index + (.papp targetAddress targetArguments) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.papp sourceAddress sourceArguments) index + (.papp targetAddress targetArguments) next) + sourceStore source frameRoots) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceDeclaration : sourceContext.decls sourceAddress = + some (.fn sourceDefinition)) + (targetDeclaration : context.declarations sourceAddress = + some (.fn targetDefinition)) + (arity : targetDefinition.signature.params.size = sourceDefinition.arity) + (papSafe : targetDefinition.signature.papSafe = true) + (sourceRun : IxIR1.runCode sourceContext (sourceFuel + 2) + functionTrace.source sourceStore source + (.letOp (.papp sourceAddress sourceArguments) next.sourceCode) = + .ok sourceOutput) + (resultWorld : IxIR1.Sim.HasWorld sourceOutput.1 + functionTrace.source.result sourceOutput.2) + (control : machine.control = .running frame stack) + (noCredits : frame.credits = #[]) + (image : attached.SourceStoreImage sourceStore) + {post : SourceMachinePost} + (finish : SuccessfulReturnHandler attached sourceContext context + interpretation functionTrace frameRoots stack sourceOutput outcome post) + (worker : SuccessfulTraceSimulationAt attached sourceContext context + interpretation (sourceFuel + 1)) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + obtain ⟨middleStore, operationValue, operationRun, continuationRun⟩ := + IxIR1.runCode_letOp_success sourceRun + have middleImage : attached.SourceStoreImage middleStore := + attached.runOp_preservesSourceStoreImage sourceDeclarations functionMember + descendant state image operationRun + obtain ⟨values, declaration, sourceResolved, declarationAt, under, + operationOutput⟩ := IxIR1.runOp_papp_success operationRun + have declarationEq : declaration = .fn sourceDefinition := by + exact Option.some.inj (declarationAt.symm.trans sourceDeclaration) + subst declaration + have under' : values.length < sourceDefinition.arity := by + simpa [IxIR1.declArity] using under + let node : IxIR1.Node := + .papN sourceAddress sourceDefinition.arity values.toArray + let sourceAllocation := sourceStore.allocNode .shared node + let targetAllocation := machine.store.allocNode .shared node + have middleStoreEq : middleStore = sourceAllocation.1 := by + simpa [sourceAllocation, node, IxIR1.declArity] using + congrArg Prod.fst operationOutput + have operationValueEq : operationValue = .loc sourceAllocation.2 := by + simpa [sourceAllocation, node, IxIR1.declArity] using + congrArg Prod.snd operationOutput + subst middleStore + subst operationValue + obtain ⟨_, targetStep, nextStores, nextState⟩ := + attached.simulate_traced_papp_fn_state + (sourceFuel := sourceFuel) (context := context) + (interpretation := interpretation) functionMember descendant state + stores sourceDeclarations sourceResolved sourceDeclaration + targetDeclaration arity papSafe under' noCredits control + have nextDescendant : functionTrace.root.Descendant next := by + exact .step descendant (by simp [Lower.CodeTrace.children]) + have nextRuntime : Lower.Sim.SourceRuntimeInvariant sourceAllocation.1 + (.loc sourceAllocation.2 :: source) := by + apply runtime.runOp (run := operationRun) + simp [sourceAllocation, node, IxIR1.Store.allocNode] + have nextOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next sourceAllocation.1 + (.loc sourceAllocation.2 :: source) frameRoots := + Lower.Sim.SourceOwnershipAt.papp (checked := attached.target) + functionMember descendant ownership operationRun + let nextFrame : Eval.Frame := + { frame with + pc := frame.pc + 1 + values := frame.values.push (.loc sourceAllocation.2) } + let nextMachine : Eval.Machine := + { machine with + store := targetAllocation.1 + control := .running nextFrame stack } + have nextControl : nextMachine.control = .running nextFrame stack := rfl + have nextNoCredits : nextFrame.credits = #[] := by + simpa [nextFrame] using noCredits + have nextStores' : Lower.Sim.StoreRel sourceAllocation.1 + nextMachine.store := by + simpa [nextMachine, targetAllocation, sourceAllocation, node] using + nextStores + have tail := worker (machine := nextMachine) (stack := stack) + functionMember nextDescendant nextState nextStores' nextRuntime + nextOwnership continuationRun resultWorld nextControl nextNoCredits + middleImage finish + refine BudgetedReachesPost.prependPreserving + (before := machine) (middle := nextMachine) (prefixCount := 1) ?_ tail + intro heapFuel + let fundedMachine : Eval.Machine := { machine with heapFuel } + have fundedStores : + Lower.Sim.StoreRel sourceStore fundedMachine.store := by + simpa [fundedMachine] using stores + have fundedControl : fundedMachine.control = .running frame stack := by + simpa [fundedMachine] using control + obtain ⟨_, fundedStep, _, _⟩ := + attached.simulate_traced_papp_fn_state + (sourceFuel := sourceFuel) (context := context) + (interpretation := interpretation) (machine := fundedMachine) + functionMember descendant state fundedStores sourceDeclarations + sourceResolved sourceDeclaration targetDeclaration arity papSafe under' + noCredits fundedControl + simpa [fundedMachine, nextMachine, nextFrame, targetAllocation, + sourceAllocation, node] using fundedStep.toSteps fundedControl + +/-- Complete CPS composition for the erased dynamic-application branch. +Residual shared arguments are released with an exact locally framed heap +budget, after which the smaller-fuel caller worker runs on the erased result. +-/ +theorem CompiledAttachment.simulate_traced_apply_erased_cps + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceFunction : IxIR1.Atom} {targetFunction : Atom} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next)) + {sourceStore sourceReleased : IxIR1.Store} + {source values : List IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + {sourceOutput outcome : IxIR1.Store × IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + sourceStore source frameRoots) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (functionResolved : + IxIR1.resolveAtom source sourceFunction = .ok .erased) + (argumentsResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (sourceRelease : IxIR1.dropMany sourceContext sourceFuel sourceStore + values = .ok sourceReleased) + (sourceRun : IxIR1.runCode sourceContext (sourceFuel + 3) + functionTrace.source sourceStore source + (.letOp (.apply sourceFunction sourceArguments) next.sourceCode) = + .ok sourceOutput) + (resultWorld : IxIR1.Sim.HasWorld sourceOutput.1 + functionTrace.source.result sourceOutput.2) + (control : machine.control = .running frame stack) + (noCredits : frame.credits = #[]) + (image : attached.SourceStoreImage sourceStore) + {post : SourceMachinePost} + (finish : SuccessfulReturnHandler attached sourceContext context + interpretation functionTrace frameRoots stack sourceOutput outcome post) + (worker : SuccessfulTraceSimulationAt attached sourceContext context + interpretation (sourceFuel + 2)) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + obtain ⟨middleStore, operationValue, operationRun, continuationRun⟩ := + IxIR1.runCode_letOp_success sourceRun + have sourceOperation : IxIR1.runOp sourceContext (sourceFuel + 2) + functionTrace.source sourceStore source + (.apply sourceFunction sourceArguments) = + .ok (sourceReleased, .erased) := by + rw [IxIR1.runOp.eq_def] + dsimp only + rw [functionResolved] + simp only [bind, Except.bind] + rw [argumentsResolved] + simp only + rw [IxIR1.applyGo.eq_def] + dsimp only + rw [sourceRelease] + rfl + have nextImage : attached.SourceStoreImage sourceReleased := + attached.runOp_preservesSourceStoreImage sourceDeclarations functionMember + descendant state image sourceOperation + have operationOutput : (middleStore, operationValue) = + (sourceReleased, .erased) := + Except.ok.inj (operationRun.symm.trans sourceOperation) + have middleStoreEq : middleStore = sourceReleased := + congrArg Prod.fst operationOutput + have operationValueEq : operationValue = .erased := + congrArg Prod.snd operationOutput + subst middleStore + subst operationValue + obtain ⟨targetHeapFuel, targetReleased, targetRelease, nextStores, + _⟩ := + Lower.Sim.dropMany_simulates_releaseSharedWork + runtime.positiveSharedRC stores sourceRelease + have nextDescendant : functionTrace.root.Descendant next := by + exact .step descendant (by simp [Lower.CodeTrace.children]) + have nextRuntime : Lower.Sim.SourceRuntimeInvariant sourceReleased + (.erased :: source) := + runtime.runOp (IxIR1.NoReuse.dropMany_reuses sourceRelease) + sourceOperation + have nextOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next sourceReleased + (.erased :: source) frameRoots := + Lower.Sim.SourceOwnershipAt.applyFrom (checked := attached.target) + functionMember descendant ownership + (attached.applyOwnershipPreservesFrom_sourceStoreImage_of_declarations + sourceDeclarations image) sourceOperation + let nextFrame : Eval.Frame := + { frame with + pc := frame.pc + 1 + values := frame.values.push .erased } + let nextMachine : Eval.Machine := + { store := targetReleased + heapFuel := 0 + control := .running nextFrame stack } + let exactMachine : Eval.Machine := + { machine with heapFuel := targetHeapFuel } + have exactControl : exactMachine.control = .running frame stack := by + simpa [exactMachine] using control + have exactTransfer : Eval.ApplyTransfer context interpretation + exactMachine.store exactMachine.heapFuel .erased values.toArray + { frame with pc := frame.pc + 1 } stack nextMachine := by + simpa [exactMachine, nextMachine, nextFrame] using + (Eval.ApplyTransfer.erased + (context := context) (interpretation := interpretation) + (resume := { frame with pc := frame.pc + 1 }) (stack := stack) + (by simpa using targetRelease)) + obtain ⟨_, nextState⟩ := + attached.simulate_traced_apply_transfer_state + (machine := exactMachine) (target := nextMachine) functionMember + descendant state sourceDeclarations functionResolved argumentsResolved + sourceOperation noCredits exactControl exactTransfer + have nextControl : nextMachine.control = .running nextFrame stack := rfl + have nextNoCredits : nextFrame.credits = #[] := by + simpa [nextFrame] using noCredits + have tail := worker (machine := nextMachine) (stack := stack) + functionMember nextDescendant nextState nextStores nextRuntime + nextOwnership continuationRun resultWorld nextControl nextNoCredits + nextImage finish + refine BudgetedReachesPost.prependFramed + (before := machine) (middle := nextMachine) (prefixCount := 1) + (localFuel := targetHeapFuel) ?_ tail + intro suffixFuel + let fundedMachine : Eval.Machine := + { machine with heapFuel := targetHeapFuel + suffixFuel } + let fundedNext : Eval.Machine := + { nextMachine with heapFuel := suffixFuel } + have fundedControl : fundedMachine.control = .running frame stack := by + simpa [fundedMachine] using control + have fundedRelease := Lower.Sim.releaseSharedWork_add_suffix + (suffix := suffixFuel) targetRelease + have fundedTransfer : Eval.ApplyTransfer context interpretation + fundedMachine.store fundedMachine.heapFuel .erased values.toArray + { frame with pc := frame.pc + 1 } stack fundedNext := by + simpa [fundedMachine, fundedNext, nextMachine, nextFrame] using + (Eval.ApplyTransfer.erased + (context := context) (interpretation := interpretation) + (resume := { frame with pc := frame.pc + 1 }) (stack := stack) + (by simpa using fundedRelease)) + obtain ⟨fundedStep, _⟩ := + attached.simulate_traced_apply_transfer_state + (machine := fundedMachine) (target := fundedNext) functionMember + descendant state sourceDeclarations functionResolved argumentsResolved + sourceOperation noCredits fundedControl fundedTransfer + simpa [fundedMachine, fundedNext] using + fundedStep.toSteps fundedControl + +/-- Complete CPS composition for under-saturated dynamic PAP application. +Captured values are retained, the old PAP is released, and the extended PAP +is allocated before the smaller-fuel caller worker resumes. -/ +theorem CompiledAttachment.simulate_traced_apply_pap_under_cps + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceFunction : IxIR1.Atom} {targetFunction : Atom} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next)) + {sourceStore sourceRetained sourceReleased : IxIR1.Store} + {source : List IxIR1.RVal} {location : Nat} {box : IxIR1.NodeBox} + {address : Ixon.Address} {arity : Nat} + {captured : Array IxIR1.RVal} {values : List IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + {sourceOutput outcome : IxIR1.Store × IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + sourceStore source frameRoots) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (functionResolved : + IxIR1.resolveAtom source sourceFunction = .ok (.loc location)) + (argumentsResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (sourceGet : sourceStore.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (sourceRetain : + IxIR1.dupVals sourceStore captured.toList = .ok sourceRetained) + (sourceRelease : IxIR1.dropVal sourceContext sourceFuel sourceRetained + (.loc location) = .ok sourceReleased) + (totalUnder : (captured.toList ++ values).length < arity) + (sourceRun : IxIR1.runCode sourceContext (sourceFuel + 3) + functionTrace.source sourceStore source + (.letOp (.apply sourceFunction sourceArguments) next.sourceCode) = + .ok sourceOutput) + (resultWorld : IxIR1.Sim.HasWorld sourceOutput.1 + functionTrace.source.result sourceOutput.2) + (control : machine.control = .running frame stack) + (noCredits : frame.credits = #[]) + (image : attached.SourceStoreImage sourceStore) + {post : SourceMachinePost} + (finish : SuccessfulReturnHandler attached sourceContext context + interpretation functionTrace frameRoots stack sourceOutput outcome post) + (worker : SuccessfulTraceSimulationAt attached sourceContext context + interpretation (sourceFuel + 2)) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + obtain ⟨middleStore, operationValue, operationRun, continuationRun⟩ := + IxIR1.runCode_letOp_success sourceRun + let pap : IxIR1.Node := + .papN address arity (captured ++ values.toArray) + let sourceAllocation := sourceReleased.allocNode .shared pap + let targetPap : IxIR1.Node := + .papN address arity (captured ++ values.toArray) + obtain ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + retainedStores, targetRelease, releasedStores, sourceOperation, _, + nextStores, nextState⟩ := + attached.simulate_traced_apply_pap_under_state + (sourceFuel := sourceFuel) (context := context) + (interpretation := interpretation) functionMember descendant state + stores runtime.positiveSharedRC sourceDeclarations functionResolved + argumentsResolved sourceGet shared node capturedUnder sourceRetain + sourceRelease totalUnder noCredits control + have operationRun' : IxIR1.runOp sourceContext (sourceFuel + 2) + functionTrace.source sourceStore source + (.apply sourceFunction sourceArguments) = + .ok (sourceAllocation.1, .loc sourceAllocation.2) := by + simpa [sourceAllocation, pap] using sourceOperation + have nextImage : attached.SourceStoreImage sourceAllocation.1 := + attached.runOp_preservesSourceStoreImage sourceDeclarations functionMember + descendant state image operationRun' + have operationOutput : (middleStore, operationValue) = + (sourceAllocation.1, .loc sourceAllocation.2) := by + apply Except.ok.inj (operationRun.symm.trans ?_) + simpa [sourceAllocation, pap] using sourceOperation + have middleStoreEq : middleStore = sourceAllocation.1 := + congrArg Prod.fst operationOutput + have operationValueEq : operationValue = .loc sourceAllocation.2 := + congrArg Prod.snd operationOutput + subst middleStore + subst operationValue + have nextDescendant : functionTrace.root.Descendant next := by + exact .step descendant (by simp [Lower.CodeTrace.children]) + have reuseEq : sourceAllocation.1.reuses = sourceStore.reuses := by + change sourceReleased.reuses = sourceStore.reuses + exact (IxIR1.NoReuse.dropVal_reuses sourceRelease).trans + (IxIR1.NoReuse.dupVals_reuses sourceRetain) + have nextRuntime : Lower.Sim.SourceRuntimeInvariant sourceAllocation.1 + (.loc sourceAllocation.2 :: source) := + runtime.runOp reuseEq operationRun' + have nextOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next sourceAllocation.1 + (.loc sourceAllocation.2 :: source) frameRoots := + Lower.Sim.SourceOwnershipAt.applyFrom (checked := attached.target) + functionMember descendant ownership + (attached.applyOwnershipPreservesFrom_sourceStoreImage_of_declarations + sourceDeclarations image) operationRun' + let targetAllocation := targetReleased.allocNode .shared targetPap + let nextFrame : Eval.Frame := + { frame with + pc := frame.pc + 1 + values := frame.values.push (.loc sourceAllocation.2) } + let nextMachine : Eval.Machine := + { store := targetAllocation.1 + heapFuel := 0 + control := .running nextFrame stack } + have nextControl : nextMachine.control = .running nextFrame stack := rfl + have nextNoCredits : nextFrame.credits = #[] := by + simpa [nextFrame] using noCredits + have nextStores' : Lower.Sim.StoreRel sourceAllocation.1 + nextMachine.store := by + simpa [nextMachine, targetAllocation, targetPap, sourceAllocation, pap] + using nextStores + have nextState' : attached.sidecars.TraceStateRel functionTrace next + sourceAllocation.1 (.loc sourceAllocation.2 :: source) nextFrame := by + simpa [sourceAllocation, pap, nextFrame] using nextState + have tail := worker (machine := nextMachine) (stack := stack) + functionMember nextDescendant nextState' nextStores' nextRuntime + nextOwnership continuationRun resultWorld nextControl nextNoCredits + nextImage finish + refine BudgetedReachesPost.prependFramed + (before := machine) (middle := nextMachine) (prefixCount := 1) + (localFuel := targetHeapFuel) ?_ tail + intro suffixFuel + let fundedMachine : Eval.Machine := + { machine with heapFuel := targetHeapFuel + suffixFuel } + let fundedNext : Eval.Machine := + { nextMachine with heapFuel := suffixFuel } + have fundedControl : fundedMachine.control = .running frame stack := by + simpa [fundedMachine] using control + have targetGet : fundedMachine.store.get? location = some box := by + unfold Eval.Store.get? + rw [stores.heap] + exact sourceGet + have targetUnder : (captured ++ values.toArray).size < arity := by + simpa using totalUnder + have fundedRelease := Lower.Sim.releaseSharedWork_add_suffix + (suffix := suffixFuel) targetRelease + have locationEq : targetAllocation.2 = sourceAllocation.2 := by + exact releasedStores.alloc_location .shared pap + have fundedTransfer := Eval.ApplyTransfer.papUnder + (context := context) (interpretation := interpretation) + (resume := { frame with pc := frame.pc + 1 }) (stack := stack) + targetGet shared node capturedUnder targetRetain fundedRelease targetUnder + dsimp only at fundedTransfer + rw [locationEq] at fundedTransfer + have fundedTransfer' : Eval.ApplyTransfer context interpretation + fundedMachine.store fundedMachine.heapFuel (.loc location) values.toArray + { frame with pc := frame.pc + 1 } stack fundedNext := by + simpa [fundedMachine, fundedNext, nextMachine, nextFrame, + targetAllocation, targetPap, sourceAllocation, pap] using fundedTransfer + obtain ⟨fundedStep, _⟩ := + attached.simulate_traced_apply_transfer_state + (machine := fundedMachine) (target := fundedNext) functionMember + descendant state sourceDeclarations functionResolved argumentsResolved + (by simpa [sourceAllocation, pap] using sourceOperation) noCredits + fundedControl fundedTransfer' + simpa [fundedMachine, fundedNext] using + fundedStep.toSteps fundedControl + +/-- Complete CPS composition for exact dynamic PAP saturation. The checked +apply capability transition constructs the all-shared callee entry and the +exact suspended caller roots; the callee worker returns through an ordinary +resume handler and the caller worker consumes the successful continuation. -/ +theorem CompiledAttachment.simulate_traced_apply_pap_saturated_cps + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} + {applyFuel calleeFuel callerFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {callerTrace calleeTrace : Lower.FunctionTrace} + (callerMember : callerTrace ∈ attached.target.artifact.trace.functions) + (calleeMember : calleeTrace ∈ attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceFunction : IxIR1.Atom} {targetFunction : Atom} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : callerTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next)) + {sourceDefinition : IxIR1.FnDef} {targetDefinition : Function} + {sourceStore sourceRetained sourceReleased outputStore finalStore : + IxIR1.Store} + {source : List IxIR1.RVal} {location : Nat} {box : IxIR1.NodeBox} + {address : Ixon.Address} {arity : Nat} + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration address) sourceDefinition targetDefinition) + {captured : Array IxIR1.RVal} {values : List IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + {value finalValue : IxIR1.RVal} + (state : attached.sidecars.TraceStateRel callerTrace + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + sourceStore source frameRoots) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (functionResolved : + IxIR1.resolveAtom source sourceFunction = .ok (.loc location)) + (argumentsResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (sourceGet : sourceStore.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (sourceRetain : + IxIR1.dupVals sourceStore captured.toList = .ok sourceRetained) + (sourceRelease : IxIR1.dropVal sourceContext applyFuel sourceRetained + (.loc location) = .ok sourceReleased) + (totalExact : (captured.toList ++ values).length = arity) + (papArity : arity = sourceDefinition.arity) + (sourceDeclaration : + sourceContext.decls address = some (.fn sourceDefinition)) + (sourcePapSafe : sourceDefinition.papSafe = true) + (targetDeclaration : + context.declarations address = some (.fn targetDefinition)) + (sourceOperation : IxIR1.runOp sourceContext (applyFuel + 2) + callerTrace.source sourceStore source + (.apply sourceFunction sourceArguments) = .ok (outputStore, value)) + (calleeRun : IxIR1.runCode sourceContext calleeFuel sourceDefinition + sourceReleased (captured.toList ++ values).reverse + sourceDefinition.body = .ok (outputStore, value)) + (calleeResultWorld : IxIR1.Sim.HasWorld outputStore + sourceDefinition.result value) + (callerRuntime : Lower.Sim.SourceRuntimeInvariant outputStore + (value :: source)) + (callerRun : IxIR1.runCode sourceContext callerFuel callerTrace.source + outputStore (value :: source) next.sourceCode = + .ok (finalStore, finalValue)) + (callerResultWorld : IxIR1.Sim.HasWorld finalStore + callerTrace.source.result finalValue) + (control : machine.control = .running frame stack) + (noCredits : frame.credits = #[]) + (image : attached.SourceStoreImage sourceStore) + {outcome : IxIR1.Store × IxIR1.RVal} {post : SourceMachinePost} + (finish : SuccessfulReturnHandler attached sourceContext context + interpretation callerTrace frameRoots stack + (finalStore, finalValue) outcome post) + (calleeWorker : SuccessfulTraceSimulationAt attached sourceContext context + interpretation calleeFuel) + (callerWorker : SuccessfulTraceSimulationAt attached sourceContext context + interpretation callerFuel) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + let sourceTotal := captured.toList ++ values + let targetTotal := captured ++ values.toArray + let resume : Eval.Frame := { frame with pc := frame.pc + 1 } + let calleeFrame : Eval.Frame := + { definition := targetDefinition, values := targetTotal } + obtain ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + _, targetRelease, releasedStores, _, _, calleeState, _⟩ := + attached.simulate_traced_apply_pap_saturated_enter_state + (sourceFuel := applyFuel) (context := context) + (interpretation := interpretation) callerMember calleeMember + descendant calleeMatch state stores runtime.positiveSharedRC + sourceDeclarations functionResolved argumentsResolved sourceGet shared + node capturedUnder sourceRetain sourceRelease totalExact papArity + sourceDeclaration sourcePapSafe targetDeclaration noCredits control + have papAt : sourceStore.get? location = + some ⟨.shared, box.rc, .papN address arity captured⟩ := by + simpa only [← shared, ← node] using sourceGet + have calleePapSafe : calleeTrace.generated.signature.papSafe = true := by + calc + calleeTrace.generated.signature.papSafe = + calleeTrace.source.papSafe := calleeTrace.sourcePapSafe + _ = sourceDefinition.papSafe := congrArg IxIR1.FnDef.papSafe + calleeMatch.source + _ = true := sourcePapSafe + have entryArity : sourceTotal.length = + calleeTrace.generated.signature.params.size := by + calc + sourceTotal.length = arity := by simpa [sourceTotal] using totalExact + _ = sourceDefinition.arity := papArity + _ = calleeTrace.source.arity := by rw [calleeMatch.source] + _ = calleeTrace.generated.signature.params.size := + calleeTrace.sourceArity.symm + obtain ⟨_, _, remaining, _, _, _, _, _, readyOwnership, + entryOwnership⟩ := + Lower.Sim.SourceOwnershipAt.applyPapEntry + (checked := attached.target) (sourceContext := sourceContext) + (sourceFuel := applyFuel) (supplied := sourceTotal) (residual := []) + callerMember calleeMember descendant ownership functionResolved + argumentsResolved papAt sourceRetain sourceRelease + (by simp [sourceTotal]) entryArity calleePapSafe + let suspendedRoots : List IxIR1.Sim.Root := + Lower.Sim.rootsForCapabilities remaining.toList source ++ frameRoots + have calleeOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions calleeTrace.root sourceReleased + sourceTotal.reverse suspendedRoots := by + simpa [suspendedRoots, IxIR1.Sim.rootsFor] using entryOwnership + have calleeRuntime : Lower.Sim.SourceRuntimeInvariant sourceReleased + sourceTotal.reverse := + Lower.Sim.SourceRuntimeInvariant.sharedEntry + ((runtime.order.dupVals sourceRetain).dropVal sourceRelease) + ((runtime.papsUnder.dupVals sourceRetain).dropVal sourceRelease) + (by simpa [suspendedRoots, List.append_assoc] using readyOwnership) + have retainedImage : attached.SourceStoreImage sourceRetained := + attached.dupVals_preservesSourceStoreImage image sourceRetain + have calleeImage : attached.SourceStoreImage sourceReleased := + attached.dropVal_preservesSourceStoreImage sourceDeclarations retainedImage + sourceRelease + have calleeRun' : IxIR1.runCode sourceContext calleeFuel + calleeTrace.source sourceReleased sourceTotal.reverse + calleeTrace.root.sourceCode = .ok (outputStore, value) := by + rw [calleeTrace.rootSourceCode, calleeMatch.source] + simpa [sourceTotal] using calleeRun + have calleeResultWorld' : IxIR1.Sim.HasWorld outputStore + calleeTrace.source.result value := by + simpa [calleeMatch.source] using calleeResultWorld + have callerOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next outputStore + (value :: source) frameRoots := + Lower.Sim.SourceOwnershipAt.applyFrom (checked := attached.target) + callerMember descendant ownership + (attached.applyOwnershipPreservesFrom_sourceStoreImage_of_declarations + sourceDeclarations image) sourceOperation + let calleeMachine : Eval.Machine := + { store := targetReleased + heapFuel := 0 + control := .running calleeFrame (.resume resume :: stack) } + have calleeStores : Lower.Sim.StoreRel sourceReleased + calleeMachine.store := by + simpa [calleeMachine] using releasedStores + have calleeState' : attached.sidecars.TraceStateRel calleeTrace + calleeTrace.root sourceReleased sourceTotal.reverse calleeFrame := by + simpa [sourceTotal, targetTotal, calleeFrame] using calleeState + have calleeControl : calleeMachine.control = + .running calleeFrame (.resume resume :: stack) := rfl + have calleeNoCredits : calleeFrame.credits = #[] := rfl + have returnHandler : SuccessfulReturnHandler attached sourceContext context + interpretation calleeTrace suspendedRoots (.resume resume :: stack) + (outputStore, value) outcome post := by + intro returningTrace returnFuel returnSite returnBlock returnInput + returnEntryValueCount returnAtom returnTarget returnGenerated returnStore + returnSource returnFrame returnMachine returningMember returnDescendant + returnState returnStores returnRuntime returnOwnership returnRun returnWorld + returnControl returnNoCredits returnImage + obtain ⟨returnedValue, _, returnOutputEq⟩ := + IxIR1.runCode_ret_success returnRun + have returnStoreEq : returnStore = outputStore := + (congrArg Prod.fst returnOutputEq).symm + have returnedValueEq : returnedValue = value := + (congrArg Prod.snd returnOutputEq).symm + subst returnStore + subst returnedValue + have handler : SuccessfulReturnHandler attached sourceContext context + interpretation returningTrace suspendedRoots + (.resume { frame with pc := frame.pc + 1 } :: stack) + (outputStore, value) outcome post := + resumeReturnHandlerWithOwnership attached + (sourceContext := sourceContext) (callerFuel := callerFuel) + (operationFuel := applyFuel + 2) (context := context) + (interpretation := interpretation) (calleeTrace := returningTrace) + (outcome := outcome) (post := post) callerMember descendant state + (binder := by rfl) (delta := by rfl) sourceDeclarations + sourceOperation callerRuntime callerOwnership callerRun + callerResultWorld noCredits finish callerWorker + apply handler returningMember returnDescendant returnState returnStores + returnRuntime returnOwnership returnRun returnWorld + · simpa [resume] using returnControl + · exact returnNoCredits + · exact returnImage + have tail := calleeWorker (machine := calleeMachine) + (stack := .resume resume :: stack) calleeMember + Lower.CodeTrace.Descendant.refl calleeState' calleeStores calleeRuntime + calleeOwnership calleeRun' calleeResultWorld' calleeControl + calleeNoCredits calleeImage returnHandler + refine BudgetedReachesPost.prependFramed + (before := machine) (middle := calleeMachine) (prefixCount := 1) + (localFuel := targetHeapFuel) ?_ tail + intro suffixFuel + let fundedMachine : Eval.Machine := + { machine with heapFuel := targetHeapFuel + suffixFuel } + let fundedCallee : Eval.Machine := + { calleeMachine with heapFuel := suffixFuel } + have fundedControl : fundedMachine.control = .running frame stack := by + simpa [fundedMachine] using control + have targetGet : fundedMachine.store.get? location = some box := by + unfold Eval.Store.get? + rw [stores.heap] + exact sourceGet + have fundedRelease := Lower.Sim.releaseSharedWork_add_suffix + (suffix := suffixFuel) targetRelease + have totalArrayEq : sourceTotal.toArray = targetTotal := by + apply Array.toList_inj.mp + simp [sourceTotal, targetTotal] + have targetSize : targetTotal.size = arity := by + simpa [sourceTotal, targetTotal] using totalExact + have targetPapSafe : targetDefinition.signature.papSafe = true := by + calc + targetDefinition.signature.papSafe = + calleeTrace.generated.signature.papSafe := by + rw [calleeMatch.generated] + _ = true := calleePapSafe + have targetParamArity : targetDefinition.signature.params.size = arity := by + calc + targetDefinition.signature.params.size = + calleeTrace.generated.signature.params.size := by + rw [calleeMatch.generated] + _ = calleeTrace.source.arity := calleeTrace.sourceArity + _ = sourceDefinition.arity := congrArg IxIR1.FnDef.arity + calleeMatch.source + _ = arity := papArity.symm + have suppliedEq : targetTotal.extract 0 arity = targetTotal := by + rw [← targetSize] + exact Array.extract_size + have suppliedArity : (targetTotal.extract 0 arity).size = + targetDefinition.signature.params.size := by + rw [suppliedEq, targetSize, targetParamArity] + have targetNonempty : targetDefinition.blocks.isEmpty = false := by + simpa [calleeMatch.generated] using calleeTrace.generatedNonempty + have fundedTransfer := Eval.ApplyTransfer.papFn + (context := context) (interpretation := interpretation) + (resume := resume) (stack := stack) targetGet shared node capturedUnder + targetRetain fundedRelease + (by simpa [targetTotal] using Nat.le_of_eq targetSize.symm) + targetDeclaration targetPapSafe suppliedArity targetNonempty + dsimp only at fundedTransfer + have remainingEmpty : + (targetTotal.extract arity targetTotal.size).isEmpty = true := by + simp [Array.isEmpty, Array.size_extract] + omega + rw [suppliedEq, remainingEmpty] at fundedTransfer + simp only [if_true] at fundedTransfer + have fundedTransfer' : Eval.ApplyTransfer context interpretation + fundedMachine.store fundedMachine.heapFuel (.loc location) + values.toArray resume stack fundedCallee := by + simpa [fundedMachine, fundedCallee, calleeMachine, calleeFrame, + sourceTotal, targetTotal] using fundedTransfer + obtain ⟨fundedStep, _⟩ := + attached.simulate_traced_apply_transfer_state + (machine := fundedMachine) (target := fundedCallee) callerMember + descendant state sourceDeclarations functionResolved argumentsResolved + sourceOperation noCredits fundedControl fundedTransfer' + simpa [fundedMachine, fundedCallee] using + fundedStep.toSteps fundedControl + +/-- Complete CPS composition for an erased return-time `applyMore` result. +Residual arguments are released with an exact local heap budget, and that +budget is framed over the already funded resumed-caller continuation. -/ +theorem CompiledAttachment.simulate_traced_ret_apply_more_erased_cps + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {returnFuel applyFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {returnFrame caller : Eval.Frame} + {rest : List Eval.Continuation} {returningTrace : Lower.FunctionTrace} + {returnSite : Lower.SourceSite} {returnBlock : BlockId} + {returnInput : Lower.Sim.EnvMap} {returnEntryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + {returnGenerated : Block} + (returnDescendant : returningTrace.root.Descendant + (.ret returnSite returnBlock returnInput returnEntryValueCount sourceAtom + targetAtom returnGenerated)) + {sourceStore sourceReleased : IxIR1.Store} + {source values : List IxIR1.RVal} + (state : attached.sidecars.TraceStateRel returningTrace + (.ret returnSite returnBlock returnInput returnEntryValueCount sourceAtom + targetAtom returnGenerated) sourceStore source returnFrame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (resultWorld : IxIR1.Sim.HasWorld sourceStore + returningTrace.source.result .erased) + (sourceRun : IxIR1.runCode sourceContext (returnFuel + 1) + returningTrace.source sourceStore source (.ret sourceAtom) = + .ok (sourceStore, .erased)) + (control : machine.control = + .running returnFrame (.applyMore values.toArray caller :: rest)) + (noCredits : returnFrame.credits = #[]) + (sourceRelease : IxIR1.dropMany sourceContext applyFuel sourceStore + values = .ok sourceReleased) + {outcome : IxIR1.Store × IxIR1.RVal} {post : SourceMachinePost} + (continuation : SuccessfulResumeContinuation context interpretation + caller rest (sourceReleased, .erased) outcome post) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + obtain ⟨targetHeapFuel, targetReleased, targetRelease, nextStores, _⟩ := + Lower.Sim.dropMany_simulates_releaseSharedWork runtime.positiveSharedRC + stores sourceRelease + let nextMachine : Eval.Machine := + { store := targetReleased + heapFuel := 0 + control := .running + { caller with values := caller.values.push .erased } rest } + have nextStores' : Lower.Sim.StoreRel sourceReleased + nextMachine.store := by + simpa [nextMachine] using nextStores + have nextControl : nextMachine.control = .running + { caller with values := caller.values.push .erased } rest := rfl + have tail := continuation nextStores' nextControl + refine BudgetedReachesPost.prependFramed + (before := machine) (middle := nextMachine) (prefixCount := 1) + (localFuel := targetHeapFuel) ?_ tail + intro suffixFuel + let fundedMachine : Eval.Machine := + { machine with heapFuel := targetHeapFuel + suffixFuel } + let fundedNext : Eval.Machine := + { nextMachine with heapFuel := suffixFuel } + have fundedStores : Lower.Sim.StoreRel sourceStore fundedMachine.store := by + simpa [fundedMachine] using stores + have fundedControl : fundedMachine.control = + .running returnFrame (.applyMore values.toArray caller :: rest) := by + simpa [fundedMachine] using control + have fundedRelease := Lower.Sim.releaseSharedWork_add_suffix + (suffix := suffixFuel) targetRelease + have fundedTransfer : Eval.ApplyTransfer context interpretation + fundedMachine.store fundedMachine.heapFuel .erased values.toArray caller + rest fundedNext := by + simpa [fundedMachine, fundedNext, nextMachine] using + (Eval.ApplyTransfer.erased + (context := context) (interpretation := interpretation) + (resume := caller) (stack := rest) fundedRelease) + obtain ⟨_, _, fundedSteps, _⟩ := + attached.simulate_traced_ret_apply_more_success + (machine := fundedMachine) (target := fundedNext) returnDescendant state + fundedStores sourceRun resultWorld fundedControl noCredits fundedTransfer + simpa [fundedMachine, fundedNext] using fundedSteps + +/-- Complete CPS composition for an under-saturated PAP returned to +`applyMore`. The longer PAP allocation resumes the caller immediately, while +the old PAP's exact release cost is framed over the resumed continuation. -/ +theorem CompiledAttachment.simulate_traced_ret_apply_more_pap_under_cps + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {returnFuel applyFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {returnFrame caller : Eval.Frame} + {rest : List Eval.Continuation} {returningTrace : Lower.FunctionTrace} + {returnSite : Lower.SourceSite} {returnBlock : BlockId} + {returnInput : Lower.Sim.EnvMap} {returnEntryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + {returnGenerated : Block} + (returnDescendant : returningTrace.root.Descendant + (.ret returnSite returnBlock returnInput returnEntryValueCount sourceAtom + targetAtom returnGenerated)) + {sourceStore sourceRetained sourceReleased : IxIR1.Store} + {source : List IxIR1.RVal} {location : Nat} {box : IxIR1.NodeBox} + {address : Ixon.Address} {arity : Nat} + {captured : Array IxIR1.RVal} {values : List IxIR1.RVal} + (state : attached.sidecars.TraceStateRel returningTrace + (.ret returnSite returnBlock returnInput returnEntryValueCount sourceAtom + targetAtom returnGenerated) sourceStore source returnFrame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (sourceResolved : + IxIR1.resolveAtom source sourceAtom = .ok (.loc location)) + (resultWorld : IxIR1.Sim.HasWorld sourceStore + returningTrace.source.result (.loc location)) + (sourceRun : IxIR1.runCode sourceContext (returnFuel + 1) + returningTrace.source sourceStore source (.ret sourceAtom) = + .ok (sourceStore, .loc location)) + (control : machine.control = + .running returnFrame (.applyMore values.toArray caller :: rest)) + (noCredits : returnFrame.credits = #[]) + (sourceGet : sourceStore.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (sourceRetain : + IxIR1.dupVals sourceStore captured.toList = .ok sourceRetained) + (sourceRelease : IxIR1.dropVal sourceContext applyFuel sourceRetained + (.loc location) = .ok sourceReleased) + (totalUnder : (captured.toList ++ values).length < arity) + {outcome : IxIR1.Store × IxIR1.RVal} {post : SourceMachinePost} + (continuation : SuccessfulResumeContinuation context interpretation + caller rest + ((sourceReleased.allocNode .shared + (.papN address arity (captured ++ values.toArray))).1, + .loc (sourceReleased.allocNode .shared + (.papN address arity (captured ++ values.toArray))).2) + outcome post) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + let pap : IxIR1.Node := + .papN address arity (captured ++ values.toArray) + let sourceAllocation := sourceReleased.allocNode .shared pap + obtain ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + _, targetRelease, releasedStores, _, _, _, nextStores⟩ := + attached.simulate_traced_ret_apply_more_pap_under_state + (returnFuel := returnFuel) (applyFuel := applyFuel) + (context := context) (interpretation := interpretation) returnDescendant + state stores runtime.positiveSharedRC sourceResolved resultWorld control + noCredits sourceGet shared node capturedUnder sourceRetain sourceRelease + totalUnder + let actualTargetAllocation := targetReleased.allocNode .shared pap + have nextStores' : Lower.Sim.StoreRel sourceAllocation.1 + actualTargetAllocation.1 := by + simpa [sourceAllocation, pap, actualTargetAllocation] using nextStores + have locationEq : actualTargetAllocation.2 = sourceAllocation.2 := + releasedStores.alloc_location .shared pap + let nextMachine : Eval.Machine := + { store := actualTargetAllocation.1 + heapFuel := 0 + control := .running + { caller with values := caller.values.push (.loc sourceAllocation.2) } + rest } + have nextStores'' : Lower.Sim.StoreRel sourceAllocation.1 + nextMachine.store := by + simpa [nextMachine] using nextStores' + have nextControl : nextMachine.control = .running + { caller with values := caller.values.push (.loc sourceAllocation.2) } + rest := rfl + have continuation' : SuccessfulResumeContinuation context interpretation + caller rest (sourceAllocation.1, .loc sourceAllocation.2) outcome post := by + change SuccessfulResumeContinuation context interpretation caller rest + (sourceAllocation.1, .loc sourceAllocation.2) outcome post at continuation + exact continuation + have tail := continuation' nextStores'' nextControl + refine BudgetedReachesPost.prependFramed + (before := machine) (middle := nextMachine) (prefixCount := 1) + (localFuel := targetHeapFuel) ?_ tail + intro suffixFuel + let fundedMachine : Eval.Machine := + { machine with heapFuel := targetHeapFuel + suffixFuel } + let fundedNext : Eval.Machine := + { nextMachine with heapFuel := suffixFuel } + have fundedStores : Lower.Sim.StoreRel sourceStore fundedMachine.store := by + simpa [fundedMachine] using stores + have fundedControl : fundedMachine.control = + .running returnFrame (.applyMore values.toArray caller :: rest) := by + simpa [fundedMachine] using control + have targetGet : fundedMachine.store.get? location = some box := by + unfold Eval.Store.get? + rw [stores.heap] + exact sourceGet + have targetUnder : (captured ++ values.toArray).size < arity := by + simpa using totalUnder + have fundedRelease := Lower.Sim.releaseSharedWork_add_suffix + (suffix := suffixFuel) targetRelease + have fundedTransfer := Eval.ApplyTransfer.papUnder + (context := context) (interpretation := interpretation) + (resume := caller) (stack := rest) targetGet shared node capturedUnder + targetRetain fundedRelease targetUnder + dsimp only at fundedTransfer + rw [locationEq] at fundedTransfer + have fundedTransfer' : Eval.ApplyTransfer context interpretation + fundedMachine.store fundedMachine.heapFuel (.loc location) + values.toArray caller rest fundedNext := by + simpa [fundedMachine, fundedNext, nextMachine, actualTargetAllocation, + sourceAllocation, pap] using fundedTransfer + obtain ⟨_, _, fundedSteps, _⟩ := + attached.simulate_traced_ret_apply_more_success + (machine := fundedMachine) (target := fundedNext) returnDescendant state + fundedStores sourceRun resultWorld fundedControl noCredits fundedTransfer' + simpa [fundedMachine, fundedNext] using fundedSteps + +/-- Complete CPS composition for an exactly saturated return-time `applyMore` +redispatch. Terminal ownership is reworlded to the shared PAP root, the PAP +retain/release prefix constructs the next callee's canonical entry, and the +local heap cost is framed over that callee's ordinary resume handler. -/ +theorem CompiledAttachment.simulate_traced_ret_apply_more_pap_saturated_cps + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} + {returnFuel applyFuel calleeFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {returnFrame caller : Eval.Frame} + {rest : List Eval.Continuation} + {returningTrace calleeTrace : Lower.FunctionTrace} + (returningMember : returningTrace ∈ + attached.target.artifact.trace.functions) + (calleeMember : calleeTrace ∈ + attached.target.artifact.trace.functions) + {returnSite : Lower.SourceSite} {returnBlock : BlockId} + {returnInput : Lower.Sim.EnvMap} {returnEntryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + {returnGenerated : Block} + (returnDescendant : returningTrace.root.Descendant + (.ret returnSite returnBlock returnInput returnEntryValueCount sourceAtom + targetAtom returnGenerated)) + {sourceDefinition : IxIR1.FnDef} {targetDefinition : Function} + {sourceStore sourceRetained sourceReleased outputStore : IxIR1.Store} + {source : List IxIR1.RVal} {location : Nat} {box : IxIR1.NodeBox} + {address : Ixon.Address} {arity : Nat} + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration address) sourceDefinition targetDefinition) + {captured : Array IxIR1.RVal} {values : List IxIR1.RVal} + {suspendedRoots : List IxIR1.Sim.Root} + {value : IxIR1.RVal} + (state : attached.sidecars.TraceStateRel returningTrace + (.ret returnSite returnBlock returnInput returnEntryValueCount sourceAtom + targetAtom returnGenerated) sourceStore source returnFrame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.ret returnSite returnBlock returnInput returnEntryValueCount sourceAtom + targetAtom returnGenerated) + sourceStore source + (IxIR1.Sim.rootsFor .shared values ++ suspendedRoots)) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceResolved : + IxIR1.resolveAtom source sourceAtom = .ok (.loc location)) + (resultWorld : IxIR1.Sim.HasWorld sourceStore + returningTrace.source.result (.loc location)) + (sourceRun : IxIR1.runCode sourceContext (returnFuel + 1) + returningTrace.source sourceStore source (.ret sourceAtom) = + .ok (sourceStore, .loc location)) + (control : machine.control = + .running returnFrame (.applyMore values.toArray caller :: rest)) + (noCredits : returnFrame.credits = #[]) + (image : attached.SourceStoreImage sourceStore) + (sourceGet : sourceStore.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (sourceRetain : + IxIR1.dupVals sourceStore captured.toList = .ok sourceRetained) + (sourceRelease : IxIR1.dropVal sourceContext applyFuel sourceRetained + (.loc location) = .ok sourceReleased) + (totalExact : (captured.toList ++ values).length = arity) + (papArity : arity = sourceDefinition.arity) + (sourceDeclaration : + sourceContext.decls address = some (.fn sourceDefinition)) + (sourcePapSafe : sourceDefinition.papSafe = true) + (targetDeclaration : + context.declarations address = some (.fn targetDefinition)) + (calleeRun : IxIR1.runCode sourceContext calleeFuel sourceDefinition + sourceReleased (captured.toList ++ values).reverse + sourceDefinition.body = .ok (outputStore, value)) + (calleeResultWorld : IxIR1.Sim.HasWorld outputStore + sourceDefinition.result value) + {outcome : IxIR1.Store × IxIR1.RVal} {post : SourceMachinePost} + (nextHandler : SuccessfulReturnHandler attached sourceContext context + interpretation calleeTrace suspendedRoots (.resume caller :: rest) + (outputStore, value) outcome post) + (calleeWorker : SuccessfulTraceSimulationAt attached sourceContext context + interpretation calleeFuel) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + let sourceTotal := captured.toList ++ values + let targetTotal := captured ++ values.toArray + let calleeFrame : Eval.Frame := + { definition := targetDefinition, values := targetTotal } + obtain ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + _, targetRelease, releasedStores, _, _, _, calleeState⟩ := + attached.simulate_traced_ret_apply_more_pap_saturated_enter_state + (returnFuel := returnFuel) (applyFuel := applyFuel) + (context := context) (interpretation := interpretation) calleeMember + returnDescendant calleeMatch state stores runtime.positiveSharedRC + sourceResolved resultWorld control noCredits sourceGet shared node + capturedUnder sourceRetain sourceRelease totalExact papArity + sourceDeclaration sourcePapSafe targetDeclaration + have papAt : sourceStore.get? location = + some ⟨.shared, box.rc, .papN address arity captured⟩ := by + simpa only [← shared, ← node] using sourceGet + have terminalOwnership := Lower.Sim.SourceOwnershipAt.returnRoot + (checked := attached.target) returningMember returnDescendant ownership + sourceResolved + have sharedResult : IxIR1.Sim.HasWorld sourceStore .shared + (.loc location) := ⟨box, sourceGet, shared⟩ + have returnedOwnership : IxIR1.Sim.RootOwnership sourceStore + (⟨.shared, .loc location⟩ :: + IxIR1.Sim.rootsFor .shared values ++ suspendedRoots) := + Lower.Sim.RootOwnership_reworldHead terminalOwnership sharedResult + have readyOwnership : IxIR1.Sim.RootOwnership sourceReleased + (IxIR1.Sim.rootsFor .shared sourceTotal ++ suspendedRoots) := by + simpa [sourceTotal] using IxIR1.Sim.applyGo_preparePap_owned papAt + returnedOwnership sourceRetain sourceRelease + have calleePapSafe : calleeTrace.generated.signature.papSafe = true := by + calc + calleeTrace.generated.signature.papSafe = + calleeTrace.source.papSafe := calleeTrace.sourcePapSafe + _ = sourceDefinition.papSafe := congrArg IxIR1.FnDef.papSafe + calleeMatch.source + _ = true := sourcePapSafe + have entryArity : sourceTotal.length = + calleeTrace.generated.signature.params.size := by + calc + sourceTotal.length = arity := by simpa [sourceTotal] using totalExact + _ = sourceDefinition.arity := papArity + _ = calleeTrace.source.arity := by rw [calleeMatch.source] + _ = calleeTrace.generated.signature.params.size := + calleeTrace.sourceArity.symm + have entryShape : + Lower.entryCapabilities calleeTrace.generated.signature = + Array.replicate sourceTotal.length (.owned .shared) := by + simpa [entryArity] using + attached.target.papSafeEntryCapabilities calleeMember calleePapSafe + have calleeOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions calleeTrace.root sourceReleased + sourceTotal.reverse suspendedRoots := by + intro entry entryMember entryCoordinate + rw [attached.target.entryCapabilities calleeMember entryMember + entryCoordinate] + exact Lower.Sim.SourceOwnershipInvariant.sharedEntry entryShape + readyOwnership + have calleeRuntime : Lower.Sim.SourceRuntimeInvariant sourceReleased + sourceTotal.reverse := + Lower.Sim.SourceRuntimeInvariant.sharedEntry + ((runtime.order.dupVals sourceRetain).dropVal sourceRelease) + ((runtime.papsUnder.dupVals sourceRetain).dropVal sourceRelease) + readyOwnership + have retainedImage : attached.SourceStoreImage sourceRetained := + attached.dupVals_preservesSourceStoreImage image sourceRetain + have calleeImage : attached.SourceStoreImage sourceReleased := + attached.dropVal_preservesSourceStoreImage sourceDeclarations retainedImage + sourceRelease + have calleeRun' : IxIR1.runCode sourceContext calleeFuel + calleeTrace.source sourceReleased sourceTotal.reverse + calleeTrace.root.sourceCode = .ok (outputStore, value) := by + rw [calleeTrace.rootSourceCode, calleeMatch.source] + simpa [sourceTotal] using calleeRun + have calleeResultWorld' : IxIR1.Sim.HasWorld outputStore + calleeTrace.source.result value := by + simpa [calleeMatch.source] using calleeResultWorld + let calleeMachine : Eval.Machine := + { store := targetReleased + heapFuel := 0 + control := .running calleeFrame (.resume caller :: rest) } + have calleeStores : Lower.Sim.StoreRel sourceReleased + calleeMachine.store := by + simpa [calleeMachine] using releasedStores + have calleeState' : attached.sidecars.TraceStateRel calleeTrace + calleeTrace.root sourceReleased sourceTotal.reverse calleeFrame := by + simpa [sourceTotal, targetTotal, calleeFrame] using calleeState + have calleeControl : calleeMachine.control = + .running calleeFrame (.resume caller :: rest) := rfl + have calleeNoCredits : calleeFrame.credits = #[] := rfl + have tail := calleeWorker (machine := calleeMachine) + (stack := .resume caller :: rest) calleeMember + Lower.CodeTrace.Descendant.refl calleeState' calleeStores calleeRuntime + calleeOwnership calleeRun' calleeResultWorld' calleeControl + calleeNoCredits calleeImage nextHandler + refine BudgetedReachesPost.prependFramed + (before := machine) (middle := calleeMachine) (prefixCount := 1) + (localFuel := targetHeapFuel) ?_ tail + intro suffixFuel + let fundedMachine : Eval.Machine := + { machine with heapFuel := targetHeapFuel + suffixFuel } + let fundedCallee : Eval.Machine := + { calleeMachine with heapFuel := suffixFuel } + have fundedStores : Lower.Sim.StoreRel sourceStore fundedMachine.store := by + simpa [fundedMachine] using stores + have fundedControl : fundedMachine.control = + .running returnFrame (.applyMore values.toArray caller :: rest) := by + simpa [fundedMachine] using control + have targetGet : fundedMachine.store.get? location = some box := by + unfold Eval.Store.get? + rw [stores.heap] + exact sourceGet + have fundedRelease := Lower.Sim.releaseSharedWork_add_suffix + (suffix := suffixFuel) targetRelease + have targetSize : targetTotal.size = arity := by + simpa [sourceTotal, targetTotal] using totalExact + have targetPapSafe : targetDefinition.signature.papSafe = true := by + calc + targetDefinition.signature.papSafe = + calleeTrace.generated.signature.papSafe := by + rw [calleeMatch.generated] + _ = true := calleePapSafe + have targetParamArity : + targetDefinition.signature.params.size = arity := by + calc + targetDefinition.signature.params.size = + calleeTrace.generated.signature.params.size := by + rw [calleeMatch.generated] + _ = calleeTrace.source.arity := calleeTrace.sourceArity + _ = sourceDefinition.arity := congrArg IxIR1.FnDef.arity + calleeMatch.source + _ = arity := papArity.symm + have suppliedEq : targetTotal.extract 0 arity = targetTotal := by + rw [← targetSize] + exact Array.extract_size + have suppliedArity : (targetTotal.extract 0 arity).size = + targetDefinition.signature.params.size := by + rw [suppliedEq, targetSize, targetParamArity] + have targetNonempty : targetDefinition.blocks.isEmpty = false := by + simpa [calleeMatch.generated] using calleeTrace.generatedNonempty + have fundedTransfer := Eval.ApplyTransfer.papFn + (context := context) (interpretation := interpretation) + (resume := caller) (stack := rest) targetGet shared node capturedUnder + targetRetain fundedRelease + (by simpa [targetTotal] using Nat.le_of_eq targetSize.symm) + targetDeclaration targetPapSafe suppliedArity targetNonempty + dsimp only at fundedTransfer + have remainingEmpty : + (targetTotal.extract arity targetTotal.size).isEmpty = true := by + simp [Array.isEmpty, Array.size_extract] + omega + rw [suppliedEq, remainingEmpty] at fundedTransfer + simp only [if_true] at fundedTransfer + have fundedTransfer' : Eval.ApplyTransfer context interpretation + fundedMachine.store fundedMachine.heapFuel (.loc location) + values.toArray caller rest fundedCallee := by + simpa [fundedMachine, fundedCallee, calleeMachine, calleeFrame, + sourceTotal, targetTotal] using fundedTransfer + obtain ⟨_, _, fundedSteps, _⟩ := + attached.simulate_traced_ret_apply_more_success + (machine := fundedMachine) (target := fundedCallee) returnDescendant + state fundedStores sourceRun resultWorld fundedControl noCredits + fundedTransfer' + simpa [fundedMachine, fundedCallee] using fundedSteps + +/-- Complete CPS composition for an over-saturated return-time `applyMore` +redispatch. The returning callee's terminal ownership exposes the shared PAP +and residual arguments, the PAP preparation splits the next callee's supplied +and residual roots, and the local retain/release cost is framed over the next +callee worker and its recursive `applyMore` handler. -/ +theorem CompiledAttachment.simulate_traced_ret_apply_more_pap_over_cps + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} + {returnFuel applyFuel calleeFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {returnFrame caller : Eval.Frame} + {rest : List Eval.Continuation} + {returningTrace calleeTrace : Lower.FunctionTrace} + (returningMember : returningTrace ∈ + attached.target.artifact.trace.functions) + (calleeMember : calleeTrace ∈ + attached.target.artifact.trace.functions) + {returnSite : Lower.SourceSite} {returnBlock : BlockId} + {returnInput : Lower.Sim.EnvMap} {returnEntryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + {returnGenerated : Block} + (returnDescendant : returningTrace.root.Descendant + (.ret returnSite returnBlock returnInput returnEntryValueCount sourceAtom + targetAtom returnGenerated)) + {sourceDefinition : IxIR1.FnDef} {targetDefinition : Function} + {sourceStore sourceRetained sourceReleased outputStore : IxIR1.Store} + {source : List IxIR1.RVal} {location : Nat} {box : IxIR1.NodeBox} + {address : Ixon.Address} {arity : Nat} + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration address) sourceDefinition targetDefinition) + {captured : Array IxIR1.RVal} {values : List IxIR1.RVal} + {suspendedRoots : List IxIR1.Sim.Root} + {value : IxIR1.RVal} + (state : attached.sidecars.TraceStateRel returningTrace + (.ret returnSite returnBlock returnInput returnEntryValueCount sourceAtom + targetAtom returnGenerated) sourceStore source returnFrame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.ret returnSite returnBlock returnInput returnEntryValueCount sourceAtom + targetAtom returnGenerated) + sourceStore source + (IxIR1.Sim.rootsFor .shared values ++ suspendedRoots)) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceResolved : + IxIR1.resolveAtom source sourceAtom = .ok (.loc location)) + (resultWorld : IxIR1.Sim.HasWorld sourceStore + returningTrace.source.result (.loc location)) + (sourceRun : IxIR1.runCode sourceContext (returnFuel + 1) + returningTrace.source sourceStore source (.ret sourceAtom) = + .ok (sourceStore, .loc location)) + (control : machine.control = + .running returnFrame (.applyMore values.toArray caller :: rest)) + (noCredits : returnFrame.credits = #[]) + (image : attached.SourceStoreImage sourceStore) + (sourceGet : sourceStore.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (sourceRetain : + IxIR1.dupVals sourceStore captured.toList = .ok sourceRetained) + (sourceRelease : IxIR1.dropVal sourceContext applyFuel sourceRetained + (.loc location) = .ok sourceReleased) + (totalOver : arity < (captured.toList ++ values).length) + (papArity : arity = sourceDefinition.arity) + (sourceDeclaration : + sourceContext.decls address = some (.fn sourceDefinition)) + (sourcePapSafe : sourceDefinition.papSafe = true) + (targetDeclaration : + context.declarations address = some (.fn targetDefinition)) + (calleeRun : IxIR1.runCode sourceContext calleeFuel sourceDefinition + sourceReleased ((captured.toList ++ values).take arity).reverse + sourceDefinition.body = .ok (outputStore, value)) + (calleeResultWorld : IxIR1.Sim.HasWorld outputStore + sourceDefinition.result value) + {outcome : IxIR1.Store × IxIR1.RVal} {post : SourceMachinePost} + (nextHandler : SuccessfulReturnHandler attached sourceContext context + interpretation calleeTrace + (IxIR1.Sim.rootsFor .shared + ((captured.toList ++ values).drop arity) ++ suspendedRoots) + (.applyMore + ((captured ++ values.toArray).extract arity + (captured ++ values.toArray).size) + caller :: rest) + (outputStore, value) outcome post) + (calleeWorker : SuccessfulTraceSimulationAt attached sourceContext context + interpretation calleeFuel) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + let sourceTotal := captured.toList ++ values + let sourceSupplied := sourceTotal.take arity + let sourceRemaining := sourceTotal.drop arity + let targetTotal := captured ++ values.toArray + let targetSupplied := targetTotal.extract 0 arity + let targetRemaining := targetTotal.extract arity targetTotal.size + let calleeFrame : Eval.Frame := + { definition := targetDefinition, values := targetSupplied } + obtain ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + _, targetRelease, releasedStores, _, _, _, remainingEq, calleeState⟩ := + attached.simulate_traced_ret_apply_more_pap_over_enter_state + (returnFuel := returnFuel) (applyFuel := applyFuel) + (context := context) (interpretation := interpretation) calleeMember + returnDescendant calleeMatch state stores runtime.positiveSharedRC + sourceResolved resultWorld control noCredits sourceGet shared node + capturedUnder sourceRetain sourceRelease totalOver papArity + sourceDeclaration sourcePapSafe targetDeclaration + have papAt : sourceStore.get? location = + some ⟨.shared, box.rc, .papN address arity captured⟩ := by + simpa only [← shared, ← node] using sourceGet + have terminalOwnership := Lower.Sim.SourceOwnershipAt.returnRoot + (checked := attached.target) returningMember returnDescendant ownership + sourceResolved + have sharedResult : IxIR1.Sim.HasWorld sourceStore .shared + (.loc location) := ⟨box, sourceGet, shared⟩ + have returnedOwnership : IxIR1.Sim.RootOwnership sourceStore + (⟨.shared, .loc location⟩ :: + IxIR1.Sim.rootsFor .shared values ++ suspendedRoots) := + Lower.Sim.RootOwnership_reworldHead terminalOwnership sharedResult + have preparedOwnership := IxIR1.Sim.applyGo_preparePap_owned papAt + returnedOwnership sourceRetain sourceRelease + have readyOwnership : IxIR1.Sim.RootOwnership sourceReleased + (IxIR1.Sim.rootsFor .shared sourceSupplied ++ + IxIR1.Sim.rootsFor .shared sourceRemaining ++ suspendedRoots) := by + simpa [sourceTotal, sourceSupplied, sourceRemaining, + IxIR1.Sim.rootsFor, List.append_assoc] using preparedOwnership + have calleePapSafe : calleeTrace.generated.signature.papSafe = true := by + calc + calleeTrace.generated.signature.papSafe = + calleeTrace.source.papSafe := calleeTrace.sourcePapSafe + _ = sourceDefinition.papSafe := congrArg IxIR1.FnDef.papSafe + calleeMatch.source + _ = true := sourcePapSafe + have suppliedArity : sourceSupplied.length = + calleeTrace.generated.signature.params.size := by + have sourceOver : arity < sourceTotal.length := by + simpa [sourceTotal] using totalOver + calc + sourceSupplied.length = arity := by + simp [sourceSupplied, Nat.min_eq_left (Nat.le_of_lt sourceOver)] + _ = sourceDefinition.arity := papArity + _ = calleeTrace.source.arity := by rw [calleeMatch.source] + _ = calleeTrace.generated.signature.params.size := + calleeTrace.sourceArity.symm + have entryShape : + Lower.entryCapabilities calleeTrace.generated.signature = + Array.replicate sourceSupplied.length (.owned .shared) := by + simpa [suppliedArity] using + attached.target.papSafeEntryCapabilities calleeMember calleePapSafe + have calleeOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions calleeTrace.root sourceReleased + sourceSupplied.reverse + (IxIR1.Sim.rootsFor .shared sourceRemaining ++ suspendedRoots) := by + intro entry entryMember entryCoordinate + rw [attached.target.entryCapabilities calleeMember entryMember + entryCoordinate] + exact Lower.Sim.SourceOwnershipInvariant.sharedEntry entryShape + (by simpa [List.append_assoc] using readyOwnership) + have calleeRuntime : Lower.Sim.SourceRuntimeInvariant sourceReleased + sourceSupplied.reverse := + Lower.Sim.SourceRuntimeInvariant.sharedEntry + ((runtime.order.dupVals sourceRetain).dropVal sourceRelease) + ((runtime.papsUnder.dupVals sourceRetain).dropVal sourceRelease) + (by simpa [List.append_assoc] using readyOwnership) + have retainedImage : attached.SourceStoreImage sourceRetained := + attached.dupVals_preservesSourceStoreImage image sourceRetain + have calleeImage : attached.SourceStoreImage sourceReleased := + attached.dropVal_preservesSourceStoreImage sourceDeclarations retainedImage + sourceRelease + have calleeRun' : IxIR1.runCode sourceContext calleeFuel + calleeTrace.source sourceReleased sourceSupplied.reverse + calleeTrace.root.sourceCode = .ok (outputStore, value) := by + rw [calleeTrace.rootSourceCode, calleeMatch.source] + simpa [sourceTotal, sourceSupplied] using calleeRun + have calleeResultWorld' : IxIR1.Sim.HasWorld outputStore + calleeTrace.source.result value := by + simpa [calleeMatch.source] using calleeResultWorld + let calleeMachine : Eval.Machine := + { store := targetReleased + heapFuel := 0 + control := .running calleeFrame + (.applyMore targetRemaining caller :: rest) } + have calleeStores : Lower.Sim.StoreRel sourceReleased + calleeMachine.store := by + simpa [calleeMachine] using releasedStores + have calleeState' : attached.sidecars.TraceStateRel calleeTrace + calleeTrace.root sourceReleased sourceSupplied.reverse calleeFrame := by + simpa [sourceTotal, sourceSupplied, targetTotal, targetSupplied, + calleeFrame] using calleeState + have calleeControl : calleeMachine.control = + .running calleeFrame (.applyMore targetRemaining caller :: rest) := rfl + have calleeNoCredits : calleeFrame.credits = #[] := rfl + have nextHandler' : SuccessfulReturnHandler attached sourceContext context + interpretation calleeTrace + (IxIR1.Sim.rootsFor .shared sourceRemaining ++ suspendedRoots) + (.applyMore targetRemaining caller :: rest) + (outputStore, value) outcome post := by + change SuccessfulReturnHandler attached sourceContext context + interpretation calleeTrace + (IxIR1.Sim.rootsFor .shared sourceRemaining ++ suspendedRoots) + (.applyMore targetRemaining caller :: rest) + (outputStore, value) outcome post at nextHandler + exact nextHandler + have tail := calleeWorker (machine := calleeMachine) + (stack := .applyMore targetRemaining caller :: rest) calleeMember + Lower.CodeTrace.Descendant.refl calleeState' calleeStores calleeRuntime + calleeOwnership calleeRun' calleeResultWorld' calleeControl + calleeNoCredits calleeImage nextHandler' + refine BudgetedReachesPost.prependFramed + (before := machine) (middle := calleeMachine) (prefixCount := 1) + (localFuel := targetHeapFuel) ?_ tail + intro suffixFuel + let fundedMachine : Eval.Machine := + { machine with heapFuel := targetHeapFuel + suffixFuel } + let fundedCallee : Eval.Machine := + { calleeMachine with heapFuel := suffixFuel } + have fundedStores : Lower.Sim.StoreRel sourceStore fundedMachine.store := by + simpa [fundedMachine] using stores + have fundedControl : fundedMachine.control = + .running returnFrame (.applyMore values.toArray caller :: rest) := by + simpa [fundedMachine] using control + have targetGet : fundedMachine.store.get? location = some box := by + unfold Eval.Store.get? + rw [stores.heap] + exact sourceGet + have fundedRelease := Lower.Sim.releaseSharedWork_add_suffix + (suffix := suffixFuel) targetRelease + have targetOver : arity < targetTotal.size := by + simpa [sourceTotal, targetTotal] using totalOver + have targetPapSafe : targetDefinition.signature.papSafe = true := by + calc + targetDefinition.signature.papSafe = + calleeTrace.generated.signature.papSafe := by + rw [calleeMatch.generated] + _ = true := calleePapSafe + have targetParamArity : + targetDefinition.signature.params.size = arity := by + calc + targetDefinition.signature.params.size = + calleeTrace.generated.signature.params.size := by + rw [calleeMatch.generated] + _ = calleeTrace.source.arity := calleeTrace.sourceArity + _ = sourceDefinition.arity := congrArg IxIR1.FnDef.arity + calleeMatch.source + _ = arity := papArity.symm + have targetSuppliedSize : targetSupplied.size = arity := by + simp [targetSupplied, Array.size_extract] + omega + have targetSuppliedArity : targetSupplied.size = + targetDefinition.signature.params.size := by + rw [targetSuppliedSize, targetParamArity] + have targetNonempty : targetDefinition.blocks.isEmpty = false := by + simpa [calleeMatch.generated] using calleeTrace.generatedNonempty + have fundedTransfer := Eval.ApplyTransfer.papFn + (context := context) (interpretation := interpretation) + (resume := caller) (stack := rest) targetGet shared node capturedUnder + targetRetain fundedRelease (Nat.le_of_lt targetOver) targetDeclaration + targetPapSafe targetSuppliedArity targetNonempty + dsimp only at fundedTransfer + have remainingNonempty : targetRemaining.isEmpty = false := by + simp [targetRemaining, Array.isEmpty, Array.size_extract] + omega + rw [remainingNonempty] at fundedTransfer + have fundedTransfer' : Eval.ApplyTransfer context interpretation + fundedMachine.store fundedMachine.heapFuel (.loc location) + values.toArray caller rest fundedCallee := by + simpa [fundedMachine, fundedCallee, calleeMachine, calleeFrame, + targetTotal, targetSupplied, targetRemaining] using fundedTransfer + obtain ⟨_, _, fundedSteps, _⟩ := + attached.simulate_traced_ret_apply_more_success + (machine := fundedMachine) (target := fundedCallee) returnDescendant + state fundedStores sourceRun resultWorld fundedControl noCredits + fundedTransfer' + simpa [fundedMachine, fundedCallee] using fundedSteps + +/-- Complete CPS composition for an over-saturated dynamic PAP application. +The checked apply transition partitions the source roots between the first +callee and its residual `applyMore` continuation; the first callee worker then +runs under the supplied recursively constructed return handler. -/ +theorem CompiledAttachment.simulate_traced_apply_pap_over_cps + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} + {applyFuel calleeFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {callerTrace calleeTrace : Lower.FunctionTrace} + (callerMember : callerTrace ∈ attached.target.artifact.trace.functions) + (calleeMember : calleeTrace ∈ attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceFunction : IxIR1.Atom} {targetFunction : Atom} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : callerTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next)) + {sourceDefinition : IxIR1.FnDef} {targetDefinition : Function} + {sourceStore sourceRetained sourceReleased outputStore : IxIR1.Store} + {source : List IxIR1.RVal} {location : Nat} {box : IxIR1.NodeBox} + {address : Ixon.Address} {arity : Nat} + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration address) sourceDefinition targetDefinition) + {captured : Array IxIR1.RVal} {values : List IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + {value : IxIR1.RVal} + (state : attached.sidecars.TraceStateRel callerTrace + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + sourceStore source frameRoots) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (functionResolved : + IxIR1.resolveAtom source sourceFunction = .ok (.loc location)) + (argumentsResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (sourceGet : sourceStore.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (sourceRetain : + IxIR1.dupVals sourceStore captured.toList = .ok sourceRetained) + (sourceRelease : IxIR1.dropVal sourceContext applyFuel sourceRetained + (.loc location) = .ok sourceReleased) + (totalOver : arity < (captured.toList ++ values).length) + (papArity : arity = sourceDefinition.arity) + (sourceDeclaration : + sourceContext.decls address = some (.fn sourceDefinition)) + (sourcePapSafe : sourceDefinition.papSafe = true) + (targetDeclaration : + context.declarations address = some (.fn targetDefinition)) + (calleeRun : IxIR1.runCode sourceContext calleeFuel sourceDefinition + sourceReleased ((captured.toList ++ values).take arity).reverse + sourceDefinition.body = .ok (outputStore, value)) + (calleeResultWorld : IxIR1.Sim.HasWorld outputStore + sourceDefinition.result value) + (control : machine.control = .running frame stack) + (noCredits : frame.credits = #[]) + (image : attached.SourceStoreImage sourceStore) + {outcome : IxIR1.Store × IxIR1.RVal} {post : SourceMachinePost} + (nextHandler : ∀ remaining : Array Lower.BindingCap, + SuccessfulReturnHandler attached sourceContext context interpretation + calleeTrace + (IxIR1.Sim.rootsFor .shared + ((captured.toList ++ values).drop arity) ++ + Lower.Sim.rootsForCapabilities remaining.toList source ++ frameRoots) + (.applyMore + ((captured ++ values.toArray).extract arity + (captured ++ values.toArray).size) + { frame with pc := frame.pc + 1 } :: stack) + (outputStore, value) outcome post) + (calleeWorker : SuccessfulTraceSimulationAt attached sourceContext context + interpretation calleeFuel) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + let sourceTotal := captured.toList ++ values + let sourceSupplied := sourceTotal.take arity + let sourceRemaining := sourceTotal.drop arity + let targetTotal := captured ++ values.toArray + let targetSupplied := targetTotal.extract 0 arity + let targetRemaining := targetTotal.extract arity targetTotal.size + let resume : Eval.Frame := { frame with pc := frame.pc + 1 } + let calleeFrame : Eval.Frame := + { definition := targetDefinition, values := targetSupplied } + obtain ⟨targetRetained, targetReleased, targetHeapFuel, targetRetain, + _, targetRelease, releasedStores, _, _, _, calleeState, _⟩ := + attached.simulate_traced_apply_pap_over_enter_state + (sourceFuel := applyFuel) (context := context) + (interpretation := interpretation) callerMember calleeMember descendant + calleeMatch state stores runtime.positiveSharedRC sourceDeclarations + functionResolved argumentsResolved sourceGet shared node capturedUnder + sourceRetain sourceRelease totalOver papArity sourceDeclaration + sourcePapSafe targetDeclaration noCredits control + have papAt : sourceStore.get? location = + some ⟨.shared, box.rc, .papN address arity captured⟩ := by + simpa only [← shared, ← node] using sourceGet + have calleePapSafe : calleeTrace.generated.signature.papSafe = true := by + calc + calleeTrace.generated.signature.papSafe = + calleeTrace.source.papSafe := calleeTrace.sourcePapSafe + _ = sourceDefinition.papSafe := congrArg IxIR1.FnDef.papSafe + calleeMatch.source + _ = true := sourcePapSafe + have suppliedArity : sourceSupplied.length = + calleeTrace.generated.signature.params.size := by + have sourceOver : arity < sourceTotal.length := by + simpa [sourceTotal] using totalOver + calc + sourceSupplied.length = arity := by + simp [sourceSupplied, Nat.min_eq_left (Nat.le_of_lt sourceOver)] + _ = sourceDefinition.arity := papArity + _ = calleeTrace.source.arity := by rw [calleeMatch.source] + _ = calleeTrace.generated.signature.params.size := + calleeTrace.sourceArity.symm + obtain ⟨_, _, remaining, _, _, _, _, _, readyOwnership, + entryOwnership⟩ := + Lower.Sim.SourceOwnershipAt.applyPapEntry + (checked := attached.target) (sourceContext := sourceContext) + (sourceFuel := applyFuel) (supplied := sourceSupplied) + (residual := sourceRemaining) callerMember calleeMember descendant + ownership functionResolved argumentsResolved papAt sourceRetain + sourceRelease (by + exact (List.take_append_drop arity sourceTotal).symm) + suppliedArity calleePapSafe + let suspendedRoots : List IxIR1.Sim.Root := + Lower.Sim.rootsForCapabilities remaining.toList source ++ frameRoots + have calleeOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions calleeTrace.root sourceReleased + sourceSupplied.reverse + (IxIR1.Sim.rootsFor .shared sourceRemaining ++ suspendedRoots) := by + simpa [suspendedRoots] using entryOwnership + have calleeRuntime : Lower.Sim.SourceRuntimeInvariant sourceReleased + sourceSupplied.reverse := + Lower.Sim.SourceRuntimeInvariant.sharedEntry + ((runtime.order.dupVals sourceRetain).dropVal sourceRelease) + ((runtime.papsUnder.dupVals sourceRetain).dropVal sourceRelease) + (by simpa [suspendedRoots, List.append_assoc] using readyOwnership) + have retainedImage : attached.SourceStoreImage sourceRetained := + attached.dupVals_preservesSourceStoreImage image sourceRetain + have calleeImage : attached.SourceStoreImage sourceReleased := + attached.dropVal_preservesSourceStoreImage sourceDeclarations retainedImage + sourceRelease + have calleeRun' : IxIR1.runCode sourceContext calleeFuel + calleeTrace.source sourceReleased sourceSupplied.reverse + calleeTrace.root.sourceCode = .ok (outputStore, value) := by + rw [calleeTrace.rootSourceCode, calleeMatch.source] + simpa [sourceTotal, sourceSupplied] using calleeRun + have calleeResultWorld' : IxIR1.Sim.HasWorld outputStore + calleeTrace.source.result value := by + simpa [calleeMatch.source] using calleeResultWorld + let calleeMachine : Eval.Machine := + { store := targetReleased + heapFuel := 0 + control := .running calleeFrame + (.applyMore targetRemaining resume :: stack) } + have calleeStores : Lower.Sim.StoreRel sourceReleased + calleeMachine.store := by + simpa [calleeMachine] using releasedStores + have calleeState' : attached.sidecars.TraceStateRel calleeTrace + calleeTrace.root sourceReleased sourceSupplied.reverse calleeFrame := by + simpa [sourceTotal, sourceSupplied, targetTotal, targetSupplied, + calleeFrame] using calleeState + have calleeControl : calleeMachine.control = + .running calleeFrame (.applyMore targetRemaining resume :: stack) := rfl + have calleeNoCredits : calleeFrame.credits = #[] := rfl + have nextHandler' : SuccessfulReturnHandler attached sourceContext context + interpretation calleeTrace + (IxIR1.Sim.rootsFor .shared sourceRemaining ++ suspendedRoots) + (.applyMore targetRemaining resume :: stack) + (outputStore, value) outcome post := by + intro returningTrace returnFuel returnSite returnBlock returnInput + returnEntryValueCount returnAtom returnTarget returnGenerated returnStore + returnSource returnFrame returnMachine returningMember returnDescendant + returnState returnStores returnRuntime returnOwnership returnRun returnWorld + returnControl returnNoCredits returnImage + exact nextHandler remaining returningMember returnDescendant returnState + returnStores returnRuntime + (by simpa [sourceTotal, sourceRemaining, suspendedRoots, + List.append_assoc] using returnOwnership) + returnRun returnWorld + (by simpa [targetTotal, targetRemaining, resume] using returnControl) + returnNoCredits returnImage + have tail := calleeWorker (machine := calleeMachine) + (stack := .applyMore targetRemaining resume :: stack) calleeMember + Lower.CodeTrace.Descendant.refl calleeState' calleeStores calleeRuntime + calleeOwnership calleeRun' calleeResultWorld' calleeControl + calleeNoCredits calleeImage nextHandler' + refine BudgetedReachesPost.prependFramed + (before := machine) (middle := calleeMachine) (prefixCount := 1) + (localFuel := targetHeapFuel) ?_ tail + intro suffixFuel + let fundedMachine : Eval.Machine := + { machine with heapFuel := targetHeapFuel + suffixFuel } + let fundedCallee : Eval.Machine := + { calleeMachine with heapFuel := suffixFuel } + have fundedControl : fundedMachine.control = .running frame stack := by + simpa [fundedMachine] using control + have targetGet : fundedMachine.store.get? location = some box := by + unfold Eval.Store.get? + rw [stores.heap] + exact sourceGet + have fundedRelease := Lower.Sim.releaseSharedWork_add_suffix + (suffix := suffixFuel) targetRelease + have targetOver : arity < targetTotal.size := by + simpa [sourceTotal, targetTotal] using totalOver + have targetPapSafe : targetDefinition.signature.papSafe = true := by + calc + targetDefinition.signature.papSafe = + calleeTrace.generated.signature.papSafe := by + rw [calleeMatch.generated] + _ = true := calleePapSafe + have targetParamArity : + targetDefinition.signature.params.size = arity := by + calc + targetDefinition.signature.params.size = + calleeTrace.generated.signature.params.size := by + rw [calleeMatch.generated] + _ = calleeTrace.source.arity := calleeTrace.sourceArity + _ = sourceDefinition.arity := congrArg IxIR1.FnDef.arity + calleeMatch.source + _ = arity := papArity.symm + have targetSuppliedSize : targetSupplied.size = arity := by + simp [targetSupplied, Array.size_extract] + omega + have targetSuppliedArity : targetSupplied.size = + targetDefinition.signature.params.size := by + rw [targetSuppliedSize, targetParamArity] + have targetNonempty : targetDefinition.blocks.isEmpty = false := by + simpa [calleeMatch.generated] using calleeTrace.generatedNonempty + have fundedTransfer := Eval.ApplyTransfer.papFn + (context := context) (interpretation := interpretation) + (resume := resume) (stack := stack) targetGet shared node capturedUnder + targetRetain fundedRelease (Nat.le_of_lt targetOver) targetDeclaration + targetPapSafe targetSuppliedArity targetNonempty + dsimp only at fundedTransfer + have remainingNonempty : targetRemaining.isEmpty = false := by + simp [targetRemaining, Array.isEmpty, Array.size_extract] + omega + rw [remainingNonempty] at fundedTransfer + have fundedTransfer' : Eval.ApplyTransfer context interpretation + fundedMachine.store fundedMachine.heapFuel (.loc location) + values.toArray resume stack fundedCallee := by + simpa [fundedMachine, fundedCallee, calleeMachine, calleeFrame, + targetTotal, targetSupplied, targetRemaining] using fundedTransfer + obtain ⟨fundedStep, _⟩ := + Lower.Sim.simulate_traced_apply_transfer_state + (machine := fundedMachine) (target := fundedCallee) descendant + state.target functionResolved argumentsResolved noCredits fundedControl + fundedTransfer' + simpa [fundedMachine, fundedCallee] using + fundedStep.toSteps fundedControl + +/-- Interpret an aligned successful `applyGo` plan as the universal +`applyMore` return handler required by the trace worker. Recursion follows +the plan's residual over-application edge, while every invoked function body +uses the corresponding strictly smaller source-fuel worker. -/ +theorem CompiledAttachment.applyMoreReturnHandler_of_plan + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} + {context : Eval.Context} {interpretation : Eval.Interpretation} + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {applyFuel : Nat} {sourceStore outputStore : IxIR1.Store} + {function outputValue : IxIR1.RVal} {values : List IxIR1.RVal} + (plan : ApplyMorePlan attached sourceContext context applyFuel sourceStore + function values outputStore outputValue) + (workers : ∀ fuel, fuel < applyFuel → + SuccessfulTraceSimulationAt attached sourceContext context + interpretation fuel) + {caller : Eval.Frame} {rest : List Eval.Continuation} + {outcome : IxIR1.Store × IxIR1.RVal} {post : SourceMachinePost} + (continuation : SuccessfulResumeContinuation context interpretation + caller rest (outputStore, outputValue) outcome post) + (functionTrace : Lower.FunctionTrace) + (suspendedRoots : List IxIR1.Sim.Root) : + SuccessfulReturnHandler attached sourceContext context interpretation + functionTrace (IxIR1.Sim.rootsFor .shared values ++ suspendedRoots) + (.applyMore values.toArray caller :: rest) (sourceStore, function) + outcome post := by + induction plan generalizing functionTrace suspendedRoots caller rest outcome + post with + | @erased fuel planStore planReleased planValues sourceRelease => + intro returningTrace returnFuel site blockId input entryValueCount + sourceAtom targetAtom generated returnStore source returnFrame machine + returningMember descendant state stores runtime ownership returnRun + resultWorld control noCredits image + obtain ⟨returnedValue, sourceResolved, outputEq⟩ := + IxIR1.runCode_ret_success returnRun + have storeEq : returnStore = planStore := by + simpa using (congrArg Prod.fst outputEq).symm + have valueEq : returnedValue = IxIR1.RVal.erased := + (congrArg Prod.snd outputEq).symm + subst returnStore + subst returnedValue + exact attached.simulate_traced_ret_apply_more_erased_cps + (sourceContext := sourceContext) (applyFuel := fuel) descendant state + stores runtime resultWorld returnRun control noCredits sourceRelease + continuation + | @papUnder fuel planStore retainedStore releasedStore location box address + arity captured planValues sourceGet node sourceRetain sourceRelease + totalUnder => + intro returningTrace returnFuel site blockId input entryValueCount + sourceAtom targetAtom generated returnStore source returnFrame machine + returningMember descendant state stores runtime ownership returnRun + resultWorld control noCredits image + obtain ⟨returnedValue, sourceResolved, outputEq⟩ := + IxIR1.runCode_ret_success returnRun + have storeEq : returnStore = planStore := by + simpa using (congrArg Prod.fst outputEq).symm + have valueEq : returnedValue = IxIR1.RVal.loc location := + (congrArg Prod.snd outputEq).symm + subst returnStore + subst returnedValue + obtain ⟨shared, capturedUnder⟩ := attached.livePapFacts returningMember + descendant runtime ownership sourceGet node + exact attached.simulate_traced_ret_apply_more_pap_under_cps + (sourceContext := sourceContext) (applyFuel := fuel) descendant state + stores runtime sourceResolved resultWorld returnRun control noCredits + sourceGet shared node capturedUnder sourceRetain sourceRelease totalUnder + continuation + | @papSaturatedFn fuel calleeFuel planStore retainedStore releasedStore + planOutputStore location box address arity captured planValues + sourceDefinition targetDefinition calleeTrace planOutputValue calleeMember + calleeMatch sourceGet node sourceRetain sourceRelease + totalExact papArity sourceDeclaration sourcePapSafe targetDeclaration + calleeRun calleeResultWorld calleeSmaller => + intro returningTrace returnFuel site blockId input entryValueCount + sourceAtom targetAtom generated returnStore source returnFrame machine + returningMember descendant state stores runtime ownership returnRun + resultWorld control noCredits image + obtain ⟨returnedValue, sourceResolved, outputEq⟩ := + IxIR1.runCode_ret_success returnRun + have storeEq : returnStore = planStore := by + simpa using (congrArg Prod.fst outputEq).symm + have valueEq : returnedValue = IxIR1.RVal.loc location := + (congrArg Prod.snd outputEq).symm + subst returnStore + subst returnedValue + obtain ⟨shared, capturedUnder⟩ := attached.livePapFacts returningMember + descendant runtime ownership sourceGet node + have nextHandler : SuccessfulReturnHandler attached sourceContext context + interpretation calleeTrace suspendedRoots (.resume caller :: rest) + (planOutputStore, planOutputValue) outcome post := + resumeReturnHandlerOfContinuation attached calleeTrace suspendedRoots + caller rest (planOutputStore, planOutputValue) outcome post + continuation + exact attached.simulate_traced_ret_apply_more_pap_saturated_cps + (sourceContext := sourceContext) (applyFuel := fuel) + (calleeFuel := calleeFuel) + returningMember calleeMember descendant calleeMatch state stores runtime + ownership sourceDeclarations sourceResolved resultWorld returnRun control + noCredits image + sourceGet shared node capturedUnder sourceRetain sourceRelease totalExact + papArity sourceDeclaration sourcePapSafe targetDeclaration calleeRun + calleeResultWorld nextHandler (workers calleeFuel calleeSmaller) + | @papOverFn fuel calleeFuel planStore retainedStore releasedStore calledStore + planOutputStore location box address arity captured planValues + sourceDefinition targetDefinition calleeTrace calledValue planOutputValue + calleeMember calleeMatch sourceGet node sourceRetain sourceRelease + totalOver papArity sourceDeclaration sourcePapSafe + targetDeclaration calleeRun calleeResultWorld calleeSmaller residual ih => + intro returningTrace returnFuel site blockId input entryValueCount + sourceAtom targetAtom generated returnStore source returnFrame machine + returningMember descendant state stores runtime ownership returnRun + resultWorld control noCredits image + obtain ⟨returnedValue, sourceResolved, outputEq⟩ := + IxIR1.runCode_ret_success returnRun + have storeEq : returnStore = planStore := by + simpa using (congrArg Prod.fst outputEq).symm + have valueEq : returnedValue = IxIR1.RVal.loc location := + (congrArg Prod.snd outputEq).symm + subst returnStore + subst returnedValue + obtain ⟨shared, capturedUnder⟩ := attached.livePapFacts returningMember + descendant runtime ownership sourceGet node + have residualWorkers : ∀ recursiveFuel, recursiveFuel < fuel → + SuccessfulTraceSimulationAt attached sourceContext context + interpretation recursiveFuel := by + intro recursiveFuel smaller + exact workers recursiveFuel (Nat.lt_trans smaller (Nat.lt_succ_self fuel)) + have residualHandler : SuccessfulReturnHandler attached sourceContext + context interpretation calleeTrace + (IxIR1.Sim.rootsFor .shared + ((captured.toList ++ planValues).drop arity) ++ suspendedRoots) + (.applyMore + ((captured ++ planValues.toArray).extract arity + (captured ++ planValues.toArray).size) + caller :: rest) + (calledStore, calledValue) outcome post := by + have handler : SuccessfulReturnHandler attached sourceContext context + interpretation calleeTrace + (IxIR1.Sim.rootsFor .shared + ((captured.toList ++ planValues).drop arity) ++ + suspendedRoots) + (.applyMore + ((captured.toList ++ planValues).drop arity).toArray caller :: + rest) + (calledStore, calledValue) outcome post := + ih residualWorkers continuation calleeTrace suspendedRoots + intro recursiveTrace recursiveReturnFuel recursiveSite recursiveBlock + recursiveInput recursiveEntryValueCount recursiveAtom recursiveTarget + recursiveGenerated recursiveStore recursiveSource recursiveFrame + recursiveMachine recursiveMember recursiveDescendant recursiveState + recursiveStores recursiveRuntime recursiveOwnership recursiveRun + recursiveWorld recursiveControl recursiveNoCredits recursiveImage + apply handler recursiveMember recursiveDescendant recursiveState + recursiveStores recursiveRuntime recursiveOwnership recursiveRun + recursiveWorld ?_ recursiveNoCredits recursiveImage + have remainingArrayEq : + ((captured ++ planValues.toArray).extract arity + (captured ++ planValues.toArray).size) = + ((captured.toList ++ planValues).drop arity).toArray := by + rw [show captured ++ planValues.toArray = + (captured.toList ++ planValues).toArray by + apply Array.toList_inj.mp + simp] + exact List.toArray_drop.symm + rw [← remainingArrayEq] + exact recursiveControl + exact attached.simulate_traced_ret_apply_more_pap_over_cps + (sourceContext := sourceContext) (applyFuel := fuel) + (calleeFuel := calleeFuel) + returningMember calleeMember descendant calleeMatch state stores runtime + ownership sourceDeclarations sourceResolved resultWorld returnRun control + noCredits image + sourceGet shared node capturedUnder sourceRetain sourceRelease totalOver + papArity sourceDeclaration sourcePapSafe targetDeclaration calleeRun + calleeResultWorld residualHandler (workers calleeFuel calleeSmaller) + +/-- Direct worker-facing form of `applyMoreReturnHandler_of_plan`: successful +source evaluation selects its exhaustive plan internally, so callers need +only the two installed declaration environments and the usual smaller-fuel +workers. -/ +theorem CompiledAttachment.applyMoreReturnHandler_of_applyGo + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} + {context : Eval.Context} {interpretation : Eval.Interpretation} + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (targetDeclarations : context.declarations = + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas).declarations) + {applyFuel : Nat} {sourceStore outputStore : IxIR1.Store} + {function outputValue : IxIR1.RVal} {values : List IxIR1.RVal} + (run : IxIR1.applyGo sourceContext applyFuel sourceStore function values = + .ok (outputStore, outputValue)) + (workers : ∀ fuel, fuel < applyFuel → + SuccessfulTraceSimulationAt attached sourceContext context + interpretation fuel) + {caller : Eval.Frame} {rest : List Eval.Continuation} + {outcome : IxIR1.Store × IxIR1.RVal} {post : SourceMachinePost} + (continuation : SuccessfulResumeContinuation context interpretation + caller rest (outputStore, outputValue) outcome post) + (functionTrace : Lower.FunctionTrace) + (suspendedRoots : List IxIR1.Sim.Root) : + SuccessfulReturnHandler attached sourceContext context interpretation + functionTrace (IxIR1.Sim.rootsFor .shared values ++ suspendedRoots) + (.applyMore values.toArray caller :: rest) (sourceStore, function) + outcome post := by + exact attached.applyMoreReturnHandler_of_plan + sourceDeclarations + (attached.applyMorePlan_of_applyGo sourceDeclarations targetDeclarations + run) + workers continuation functionTrace suspendedRoots + +/-- Complete CPS composition for an addressed ordinary function call. The +target enters the retained callee root in one step, the smaller-fuel callee +worker runs under an exact `.resume` handler, and that handler restores and +runs the caller's successful continuation. -/ +theorem CompiledAttachment.simulate_traced_call_fn_cps + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {callFuel calleeFuel callerFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {callerTrace calleeTrace : Lower.FunctionTrace} + (callerMember : callerTrace ∈ attached.target.artifact.trace.functions) + (calleeMember : calleeTrace ∈ attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} {sourceAddress targetAddress : Ixon.Address} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : callerTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.call sourceAddress sourceArguments) index + (.call targetAddress targetArguments) next)) + {sourceDefinition : IxIR1.FnDef} {targetDefinition : Function} + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration sourceAddress) sourceDefinition targetDefinition) + {sourceStore outputStore finalStore : IxIR1.Store} + {source : List IxIR1.RVal} {values : List IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + {value finalValue : IxIR1.RVal} + (state : attached.sidecars.TraceStateRel callerTrace + (.letOp site blockId input nextInput entryValueCount + (.call sourceAddress sourceArguments) index + (.call targetAddress targetArguments) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.call sourceAddress sourceArguments) index + (.call targetAddress targetArguments) next) + sourceStore source frameRoots) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (argumentArity : sourceDefinition.arity = values.length) + (sourceOperation : IxIR1.runOp sourceContext (callFuel + 1) + callerTrace.source sourceStore source + (.call sourceAddress sourceArguments) = .ok (outputStore, value)) + (calleeRun : IxIR1.runCode sourceContext calleeFuel sourceDefinition + sourceStore values.reverse sourceDefinition.body = + .ok (outputStore, value)) + (calleeResultWorld : IxIR1.Sim.HasWorld outputStore + sourceDefinition.result value) + (callerRuntime : Lower.Sim.SourceRuntimeInvariant outputStore + (value :: source)) + (callerRun : IxIR1.runCode sourceContext callerFuel callerTrace.source + outputStore (value :: source) next.sourceCode = + .ok (finalStore, finalValue)) + (callerResultWorld : IxIR1.Sim.HasWorld finalStore + callerTrace.source.result finalValue) + (targetDeclaration : context.declarations sourceAddress = + some (.fn targetDefinition)) + (control : machine.control = .running frame stack) + (noCredits : frame.credits = #[]) + (image : attached.SourceStoreImage sourceStore) + {outcome : IxIR1.Store × IxIR1.RVal} {post : SourceMachinePost} + (finish : SuccessfulReturnHandler attached sourceContext context + interpretation callerTrace frameRoots stack + (finalStore, finalValue) outcome post) + (calleeWorker : SuccessfulTraceSimulationAt attached sourceContext context + interpretation calleeFuel) + (callerWorker : SuccessfulTraceSimulationAt attached sourceContext context + interpretation callerFuel) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + let resume : Eval.Frame := { frame with pc := frame.pc + 1 } + let calleeFrame : Eval.Frame := + { definition := targetDefinition, values := values.toArray } + let calleeMachine : Eval.Machine := + { machine with + control := .running calleeFrame (.resume resume :: stack) } + obtain ⟨_, _, entryStores, calleeState⟩ := + attached.simulate_traced_call_fn_enter_state + (sourceContext := sourceContext) (sourceFuel := callFuel) + (context := context) (interpretation := interpretation) + calleeMember descendant + calleeMatch state stores sourceResolved argumentArity targetDeclaration + noCredits control + have signatureAt := attached.target.targetSignature calleeMember + calleeMatch.owner + obtain ⟨callPosition, remaining, callPositionMember, + callPositionCoordinate, consumed, _, entryOwnership⟩ := + Lower.Sim.SourceOwnershipAt.callEntry (checked := attached.target) + callerMember calleeMember descendant signatureAt ownership sourceResolved + let suspendedRoots : List IxIR1.Sim.Root := + Lower.Sim.rootsForCapabilities remaining.toList source ++ frameRoots + have calleeOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions calleeTrace.root sourceStore + values.reverse suspendedRoots := by + simpa [suspendedRoots] using entryOwnership + have calleeRuntime : Lower.Sim.SourceRuntimeInvariant sourceStore + values.reverse := runtime.resolveAtomsReverse sourceResolved + have calleeRun' : IxIR1.runCode sourceContext calleeFuel calleeTrace.source + sourceStore values.reverse calleeTrace.root.sourceCode = + .ok (outputStore, value) := by + rw [calleeTrace.rootSourceCode, calleeMatch.source] + exact calleeRun + have calleeResultWorld' : IxIR1.Sim.HasWorld outputStore + calleeTrace.source.result value := by + simpa [calleeMatch.source] using calleeResultWorld + have calleeControl : calleeMachine.control = + .running calleeFrame (.resume resume :: stack) := rfl + have calleeNoCredits : calleeFrame.credits = #[] := rfl + have returnHandler : SuccessfulReturnHandler attached sourceContext context + interpretation calleeTrace suspendedRoots (.resume resume :: stack) + (outputStore, value) outcome post := by + intro returningTrace returnFuel returnSite returnBlock returnInput + returnEntryValueCount returnAtom returnTarget returnGenerated returnStore + returnSource returnFrame returnMachine returningMember returnDescendant + returnState returnStores returnRuntime returnOwnership returnRun returnWorld + returnControl returnNoCredits returnImage + obtain ⟨returnedValue, returnResolved, returnOutputEq⟩ := + IxIR1.runCode_ret_success returnRun + have returnStoreEq : returnStore = outputStore := + (congrArg Prod.fst returnOutputEq).symm + have returnedValueEq : returnedValue = value := + (congrArg Prod.snd returnOutputEq).symm + subst returnStore + subst returnedValue + have terminalOwnership := Lower.Sim.SourceOwnershipAt.returnRoot + (checked := attached.target) returningMember returnDescendant + returnOwnership returnResolved + have calleeResultWorld'' : IxIR1.Sim.HasWorld outputStore + calleeTrace.generated.signature.result value := by + simpa [calleeTrace.sourceOrder.result] using calleeResultWorld' + have returnedOwnership : IxIR1.Sim.RootOwnership outputStore + (⟨calleeTrace.generated.signature.result, value⟩ :: suspendedRoots) := + Lower.Sim.RootOwnership_reworldHead terminalOwnership calleeResultWorld'' + have callerOwnership := Lower.Sim.SourceOwnershipAt.callResult + (checked := attached.target) callerMember signatureAt descendant + callPositionMember callPositionCoordinate ownership sourceResolved + consumed (by simpa [suspendedRoots] using returnedOwnership) + have handler : SuccessfulReturnHandler attached sourceContext context + interpretation returningTrace suspendedRoots + (.resume { frame with pc := frame.pc + 1 } :: stack) + (outputStore, value) outcome post := + resumeReturnHandlerWithOwnership attached + (sourceContext := sourceContext) (callerFuel := callerFuel) + (operationFuel := callFuel + 1) (context := context) + (interpretation := interpretation) (calleeTrace := returningTrace) + (outcome := outcome) (post := post) callerMember descendant state + (binder := by rfl) (delta := by rfl) sourceDeclarations + sourceOperation callerRuntime callerOwnership callerRun + callerResultWorld noCredits finish callerWorker + apply handler returningMember returnDescendant returnState returnStores + returnRuntime returnOwnership returnRun returnWorld + · simpa [resume] using returnControl + · exact returnNoCredits + · exact returnImage + have tail := calleeWorker (machine := calleeMachine) + (stack := .resume resume :: stack) calleeMember + Lower.CodeTrace.Descendant.refl + calleeState entryStores calleeRuntime calleeOwnership calleeRun' + calleeResultWorld' calleeControl calleeNoCredits image returnHandler + obtain ⟨tailHeapFuel, tail⟩ := tail + let fundedMachine : Eval.Machine := { machine with heapFuel := tailHeapFuel } + have fundedStores : Lower.Sim.StoreRel sourceStore fundedMachine.store := by + simpa [fundedMachine] using stores + have fundedControl : fundedMachine.control = .running frame stack := by + simpa [fundedMachine] using control + obtain ⟨_, fundedStep, _, _⟩ := + attached.simulate_traced_call_fn_enter_state + (sourceContext := sourceContext) (sourceFuel := callFuel) + (context := context) (interpretation := interpretation) + (machine := fundedMachine) calleeMember descendant calleeMatch state + fundedStores sourceResolved argumentArity targetDeclaration noCredits + fundedControl + refine ⟨tailHeapFuel, ?_⟩ + simpa [fundedMachine, calleeMachine, calleeFrame, resume] using + tail.prepend (fundedStep.toSteps fundedControl) + +/-- Complete CPS composition for a recursive self-call. The target enters +the same retained function root, the smaller-fuel worker executes that root +under an exact `.resume` handler, and the handler restores the caller's +successful continuation. -/ +theorem CompiledAttachment.simulate_traced_call_self_cps + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {callFuel calleeFuel callerFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.callSelf sourceArguments) index (.callSelf targetArguments) next)) + {sourceStore outputStore finalStore : IxIR1.Store} + {source : List IxIR1.RVal} {values : List IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + {value finalValue : IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.callSelf sourceArguments) index (.callSelf targetArguments) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.callSelf sourceArguments) index (.callSelf targetArguments) next) + sourceStore source frameRoots) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (argumentArity : functionTrace.source.arity = values.length) + (sourceOperation : IxIR1.runOp sourceContext (callFuel + 1) + functionTrace.source sourceStore source (.callSelf sourceArguments) = + .ok (outputStore, value)) + (calleeRun : IxIR1.runCode sourceContext calleeFuel + functionTrace.source sourceStore values.reverse + functionTrace.source.body = .ok (outputStore, value)) + (calleeResultWorld : IxIR1.Sim.HasWorld outputStore + functionTrace.source.result value) + (callerRuntime : Lower.Sim.SourceRuntimeInvariant outputStore + (value :: source)) + (callerRun : IxIR1.runCode sourceContext callerFuel functionTrace.source + outputStore (value :: source) next.sourceCode = + .ok (finalStore, finalValue)) + (callerResultWorld : IxIR1.Sim.HasWorld finalStore + functionTrace.source.result finalValue) + (control : machine.control = .running frame stack) + (noCredits : frame.credits = #[]) + (image : attached.SourceStoreImage sourceStore) + {outcome : IxIR1.Store × IxIR1.RVal} {post : SourceMachinePost} + (finish : SuccessfulReturnHandler attached sourceContext context + interpretation functionTrace frameRoots stack + (finalStore, finalValue) outcome post) + (calleeWorker : SuccessfulTraceSimulationAt attached sourceContext context + interpretation calleeFuel) + (callerWorker : SuccessfulTraceSimulationAt attached sourceContext context + interpretation callerFuel) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + let resume : Eval.Frame := { frame with pc := frame.pc + 1 } + let calleeFrame : Eval.Frame := + { definition := frame.definition, values := values.toArray } + let calleeMachine : Eval.Machine := + { machine with + control := .running calleeFrame (.resume resume :: stack) } + obtain ⟨_, _, entryStores, calleeState⟩ := + attached.simulate_traced_call_self_enter_state + (sourceContext := sourceContext) (sourceFuel := callFuel) + (context := context) (interpretation := interpretation) + functionMember descendant state stores sourceResolved argumentArity + noCredits control + obtain ⟨callPosition, remaining, callPositionMember, + callPositionCoordinate, consumed, _, entryOwnership⟩ := + Lower.Sim.SourceOwnershipAt.callSelfEntry (checked := attached.target) + functionMember descendant ownership sourceResolved + let suspendedRoots : List IxIR1.Sim.Root := + Lower.Sim.rootsForCapabilities remaining.toList source ++ frameRoots + have calleeOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions functionTrace.root sourceStore + values.reverse suspendedRoots := by + simpa [suspendedRoots] using entryOwnership + have calleeRuntime : Lower.Sim.SourceRuntimeInvariant sourceStore + values.reverse := runtime.resolveAtomsReverse sourceResolved + have calleeRun' : IxIR1.runCode sourceContext calleeFuel + functionTrace.source sourceStore values.reverse + functionTrace.root.sourceCode = .ok (outputStore, value) := by + rw [functionTrace.rootSourceCode] + exact calleeRun + have calleeControl : calleeMachine.control = + .running calleeFrame (.resume resume :: stack) := rfl + have calleeNoCredits : calleeFrame.credits = #[] := rfl + have returnHandler : SuccessfulReturnHandler attached sourceContext context + interpretation functionTrace suspendedRoots (.resume resume :: stack) + (outputStore, value) outcome post := by + intro returningTrace returnFuel returnSite returnBlock returnInput + returnEntryValueCount returnAtom returnTarget returnGenerated returnStore + returnSource returnFrame returnMachine returningMember returnDescendant + returnState returnStores returnRuntime returnOwnership returnRun returnWorld + returnControl returnNoCredits returnImage + obtain ⟨returnedValue, returnResolved, returnOutputEq⟩ := + IxIR1.runCode_ret_success returnRun + have returnStoreEq : returnStore = outputStore := + (congrArg Prod.fst returnOutputEq).symm + have returnedValueEq : returnedValue = value := + (congrArg Prod.snd returnOutputEq).symm + subst returnStore + subst returnedValue + have terminalOwnership := Lower.Sim.SourceOwnershipAt.returnRoot + (checked := attached.target) returningMember returnDescendant + returnOwnership returnResolved + have calleeResultWorld' : IxIR1.Sim.HasWorld outputStore + functionTrace.generated.signature.result value := by + simpa [functionTrace.sourceOrder.result] using calleeResultWorld + have returnedOwnership : IxIR1.Sim.RootOwnership outputStore + (⟨functionTrace.generated.signature.result, value⟩ :: suspendedRoots) := + Lower.Sim.RootOwnership_reworldHead terminalOwnership calleeResultWorld' + have callerOwnership := Lower.Sim.SourceOwnershipAt.callSelfResult + (checked := attached.target) functionMember descendant + callPositionMember callPositionCoordinate ownership sourceResolved + consumed (by simpa [suspendedRoots] using returnedOwnership) + have handler : SuccessfulReturnHandler attached sourceContext context + interpretation returningTrace suspendedRoots + (.resume { frame with pc := frame.pc + 1 } :: stack) + (outputStore, value) outcome post := + resumeReturnHandlerWithOwnership attached + (sourceContext := sourceContext) (callerFuel := callerFuel) + (operationFuel := callFuel + 1) (context := context) + (interpretation := interpretation) (calleeTrace := returningTrace) + (outcome := outcome) (post := post) functionMember descendant state + (binder := by rfl) (delta := by rfl) sourceDeclarations + sourceOperation callerRuntime callerOwnership callerRun + callerResultWorld noCredits finish callerWorker + apply handler returningMember returnDescendant returnState returnStores + returnRuntime returnOwnership returnRun returnWorld + · simpa [resume] using returnControl + · exact returnNoCredits + · exact returnImage + have tail := calleeWorker (machine := calleeMachine) + (stack := .resume resume :: stack) functionMember + Lower.CodeTrace.Descendant.refl calleeState entryStores calleeRuntime + calleeOwnership calleeRun' calleeResultWorld calleeControl + calleeNoCredits image returnHandler + obtain ⟨tailHeapFuel, tail⟩ := tail + let fundedMachine : Eval.Machine := { machine with heapFuel := tailHeapFuel } + have fundedStores : Lower.Sim.StoreRel sourceStore fundedMachine.store := by + simpa [fundedMachine] using stores + have fundedControl : fundedMachine.control = .running frame stack := by + simpa [fundedMachine] using control + obtain ⟨_, fundedStep, _, _⟩ := + attached.simulate_traced_call_self_enter_state + (sourceContext := sourceContext) (sourceFuel := callFuel) + (context := context) (interpretation := interpretation) + (machine := fundedMachine) functionMember descendant state fundedStores + sourceResolved argumentArity noCredits fundedControl + refine ⟨tailHeapFuel, ?_⟩ + simpa [fundedMachine, calleeMachine, calleeFrame, resume] using + tail.prepend (fundedStep.toSteps fundedControl) + +/-- Complete CPS composition for an addressed tail call. Because the target +keeps the continuation stack unchanged, the stack-generic return handler is +passed directly to the retained callee worker. -/ +theorem CompiledAttachment.simulate_traced_tail_call_fn_cps + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {callFuel calleeFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} + {callerTrace calleeTrace : Lower.FunctionTrace} + (callerMember : callerTrace ∈ attached.target.artifact.trace.functions) + (calleeMember : calleeTrace ∈ attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {address : Ixon.Address} {sourceArguments : Array IxIR1.Atom} + {generated : Block} + (descendant : callerTrace.root.Descendant + (.tailCall site blockId input entryValueCount address sourceArguments + generated)) + {sourceDefinition : IxIR1.FnDef} {targetDefinition : Function} + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration address) sourceDefinition targetDefinition) + {sourceStore outputStore : IxIR1.Store} + {source values : List IxIR1.RVal} {value : IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + (state : attached.sidecars.TraceStateRel callerTrace + (.tailCall site blockId input entryValueCount address sourceArguments + generated) sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.tailCall site blockId input entryValueCount address sourceArguments + generated) sourceStore source frameRoots) + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (argumentArity : sourceDefinition.arity = values.length) + (sourceRun : IxIR1.runCode sourceContext (callFuel + 2) + callerTrace.source sourceStore source + (.letOp (.call address sourceArguments) (.ret (.var 0))) = + .ok (outputStore, value)) + (calleeRun : IxIR1.runCode sourceContext calleeFuel sourceDefinition + sourceStore values.reverse sourceDefinition.body = + .ok (outputStore, value)) + (calleeResultWorld : IxIR1.Sim.HasWorld outputStore + sourceDefinition.result value) + (targetDeclaration : context.declarations address = + some (.fn targetDefinition)) + (control : machine.control = .running frame stack) + (noCredits : frame.credits = #[]) + (image : attached.SourceStoreImage sourceStore) + {outcome : IxIR1.Store × IxIR1.RVal} {post : SourceMachinePost} + (finish : SuccessfulReturnHandler attached sourceContext context + interpretation callerTrace frameRoots stack + (outputStore, value) outcome post) + (calleeWorker : SuccessfulTraceSimulationAt attached sourceContext context + interpretation calleeFuel) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + let calleeFrame : Eval.Frame := + { definition := targetDefinition, values := values.toArray } + let calleeMachine : Eval.Machine := + { machine with control := .running calleeFrame stack } + obtain ⟨sourceEquation, targetStep, entryStores, calleeState⟩ := + attached.simulate_traced_tail_call_fn_enter_state + (sourceContext := sourceContext) (sourceFuel := callFuel) + (context := context) (interpretation := interpretation) calleeMember + descendant calleeMatch state stores sourceResolved argumentArity + targetDeclaration noCredits control + have signatureAt := attached.target.targetSignature calleeMember + calleeMatch.owner + have calleeOwnership := Lower.Sim.SourceOwnershipAt.tailCallEntry + (checked := attached.target) callerMember calleeMember descendant + signatureAt ownership sourceResolved + have invokeRun : IxIR1.invoke sourceContext callFuel address values + sourceStore = .ok (outputStore, value) := by + rw [← sourceEquation] + exact sourceRun + have calleeRuntime : Lower.Sim.SourceRuntimeInvariant sourceStore + values.reverse := runtime.resolveAtomsReverse sourceResolved + have calleeRun' : IxIR1.runCode sourceContext calleeFuel calleeTrace.source + sourceStore values.reverse calleeTrace.root.sourceCode = + .ok (outputStore, value) := by + rw [calleeTrace.rootSourceCode, calleeMatch.source] + exact calleeRun + have calleeResultWorld' : IxIR1.Sim.HasWorld outputStore + calleeTrace.source.result value := by + simpa [calleeMatch.source] using calleeResultWorld + have calleeControl : calleeMachine.control = + .running calleeFrame stack := rfl + have calleeNoCredits : calleeFrame.credits = #[] := rfl + have tail := calleeWorker (machine := calleeMachine) (stack := stack) + calleeMember Lower.CodeTrace.Descendant.refl calleeState entryStores + calleeRuntime calleeOwnership calleeRun' calleeResultWorld' calleeControl + calleeNoCredits image finish + obtain ⟨tailHeapFuel, tail⟩ := tail + let fundedMachine : Eval.Machine := { machine with heapFuel := tailHeapFuel } + have fundedStores : Lower.Sim.StoreRel sourceStore fundedMachine.store := by + simpa [fundedMachine] using stores + have fundedControl : fundedMachine.control = .running frame stack := by + simpa [fundedMachine] using control + obtain ⟨_, fundedStep, _, _⟩ := + attached.simulate_traced_tail_call_fn_enter_state + (sourceContext := sourceContext) (sourceFuel := callFuel) + (context := context) (interpretation := interpretation) + (machine := fundedMachine) calleeMember descendant calleeMatch state + fundedStores sourceResolved argumentArity targetDeclaration noCredits + fundedControl + refine ⟨tailHeapFuel, ?_⟩ + simpa [fundedMachine, calleeMachine, calleeFrame] using + tail.prepend (fundedStep.toSteps fundedControl) + +/-- Complete CPS composition for a recursive self tail call. The same trace +root is re-entered with the existing continuation stack and return handler. -/ +theorem CompiledAttachment.simulate_traced_tail_call_self_cps + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {callFuel calleeFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceArguments : Array IxIR1.Atom} {generated : Block} + (descendant : functionTrace.root.Descendant + (.tailCallSelf site blockId input entryValueCount sourceArguments + generated)) + {sourceStore outputStore : IxIR1.Store} + {source values : List IxIR1.RVal} {value : IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + (state : attached.sidecars.TraceStateRel functionTrace + (.tailCallSelf site blockId input entryValueCount sourceArguments + generated) sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.tailCallSelf site blockId input entryValueCount sourceArguments + generated) sourceStore source frameRoots) + (sourceResolved : + IxIR1.resolveAtoms source sourceArguments = .ok values) + (argumentArity : functionTrace.source.arity = values.length) + (sourceRun : IxIR1.runCode sourceContext (callFuel + 2) + functionTrace.source sourceStore source + (.letOp (.callSelf sourceArguments) (.ret (.var 0))) = + .ok (outputStore, value)) + (calleeRun : IxIR1.runCode sourceContext calleeFuel + functionTrace.source sourceStore values.reverse + functionTrace.source.body = .ok (outputStore, value)) + (calleeResultWorld : IxIR1.Sim.HasWorld outputStore + functionTrace.source.result value) + (control : machine.control = .running frame stack) + (noCredits : frame.credits = #[]) + (image : attached.SourceStoreImage sourceStore) + {outcome : IxIR1.Store × IxIR1.RVal} {post : SourceMachinePost} + (finish : SuccessfulReturnHandler attached sourceContext context + interpretation functionTrace frameRoots stack + (outputStore, value) outcome post) + (calleeWorker : SuccessfulTraceSimulationAt attached sourceContext context + interpretation calleeFuel) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + let calleeFrame : Eval.Frame := + { definition := frame.definition, values := values.toArray } + let calleeMachine : Eval.Machine := + { machine with control := .running calleeFrame stack } + obtain ⟨sourceEquation, targetStep, entryStores, calleeState⟩ := + attached.simulate_traced_tail_call_self_enter_state + (sourceContext := sourceContext) (sourceFuel := callFuel) + (context := context) (interpretation := interpretation) functionMember + descendant state stores sourceResolved argumentArity noCredits control + have calleeOwnership := Lower.Sim.SourceOwnershipAt.tailCallSelfEntry + (checked := attached.target) functionMember descendant ownership + sourceResolved + have sourceEquationRun : (do + let out ← IxIR1.runCode sourceContext callFuel functionTrace.source + sourceStore values.reverse functionTrace.source.body + IxIR1.checkResultWorld functionTrace.source.result out) = + .ok (outputStore, value) := by + rw [← sourceEquation] + exact sourceRun + have calleeRuntime : Lower.Sim.SourceRuntimeInvariant sourceStore + values.reverse := runtime.resolveAtomsReverse sourceResolved + have calleeRun' : IxIR1.runCode sourceContext calleeFuel + functionTrace.source sourceStore values.reverse + functionTrace.root.sourceCode = .ok (outputStore, value) := by + rw [functionTrace.rootSourceCode] + exact calleeRun + have calleeControl : calleeMachine.control = + .running calleeFrame stack := rfl + have calleeNoCredits : calleeFrame.credits = #[] := rfl + have tail := calleeWorker (machine := calleeMachine) (stack := stack) + functionMember Lower.CodeTrace.Descendant.refl calleeState entryStores + calleeRuntime calleeOwnership calleeRun' calleeResultWorld calleeControl + calleeNoCredits image finish + obtain ⟨tailHeapFuel, tail⟩ := tail + let fundedMachine : Eval.Machine := { machine with heapFuel := tailHeapFuel } + have fundedStores : Lower.Sim.StoreRel sourceStore fundedMachine.store := by + simpa [fundedMachine] using stores + have fundedControl : fundedMachine.control = .running frame stack := by + simpa [fundedMachine] using control + obtain ⟨_, fundedStep, _, _⟩ := + attached.simulate_traced_tail_call_self_enter_state + (sourceContext := sourceContext) (sourceFuel := callFuel) + (context := context) (interpretation := interpretation) + (machine := fundedMachine) functionMember descendant state fundedStores + sourceResolved argumentArity noCredits fundedControl + refine ⟨tailHeapFuel, ?_⟩ + simpa [fundedMachine, calleeMachine, calleeFrame] using + tail.prepend (fundedStep.toSteps fundedControl) + +/-- Worker-facing addressed tail-call rule. Successful source evaluation is +inverted here to recover the retained callee, its smaller body fuel, and its +checked result world; the exhaustive induction only supplies workers below +the current outer fuel. -/ +theorem CompiledAttachment.simulate_traced_tail_call_cps_of_run + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {callFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + (contracts : SuccessfulSimulationContracts attached sourceContext context) + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {address : Ixon.Address} {sourceArguments : Array IxIR1.Atom} + {generated : Block} + (descendant : functionTrace.root.Descendant + (.tailCall site blockId input entryValueCount address sourceArguments + generated)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + {sourceOutput outcome : IxIR1.Store × IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.tailCall site blockId input entryValueCount address sourceArguments + generated) sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.tailCall site blockId input entryValueCount address sourceArguments + generated) sourceStore source frameRoots) + (sourceRun : IxIR1.runCode sourceContext (callFuel + 2) + functionTrace.source sourceStore source + (.letOp (.call address sourceArguments) (.ret (.var 0))) = + .ok sourceOutput) + (resultWorld : IxIR1.Sim.HasWorld sourceOutput.1 + functionTrace.source.result sourceOutput.2) + (control : machine.control = .running frame stack) + (noCredits : frame.credits = #[]) + (image : attached.SourceStoreImage sourceStore) + {post : SourceMachinePost} + (finish : SuccessfulReturnHandler attached sourceContext context + interpretation functionTrace frameRoots stack sourceOutput outcome post) + (workers : ∀ fuel, fuel < callFuel + 2 → + SuccessfulTraceSimulationAt attached sourceContext context + interpretation fuel) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + obtain ⟨middleStore, operationValue, operationRun, continuationRun⟩ := + IxIR1.runCode_letOp_success sourceRun + obtain ⟨values, sourceResolved, invokeRun⟩ := + IxIR1.runOp_call_success operationRun + obtain ⟨calleeFuel, callFuelEq, invoked⟩ := + IxIR1.invoke_success invokeRun + obtain ⟨returnedValue, returnedResolved, sourceOutputEq⟩ := + IxIR1.runCode_ret_success continuationRun + have returnedValueEq : returnedValue = operationValue := by + simpa [IxIR1.resolveAtom] using returnedResolved.symm + subst returnedValue + subst sourceOutput + cases invoked with + | @fn sourceDefinition bodyOutput sourceDeclaration argumentArity calleeRun + resultRun => + obtain ⟨bodyOutputEq, calleeResultWorld⟩ := + IxIR1.Sim.checkResultWorld_ok resultRun + cases bodyOutputEq + obtain ⟨targetDefinition, calleeTrace, calleeMember, calleeMatch, + targetDeclaration⟩ := + attached.functionTrace_of_source_declaration + contracts.sourceDeclarations contracts.targetDeclarations + sourceDeclaration + exact attached.simulate_traced_tail_call_fn_cps functionMember + calleeMember descendant calleeMatch state stores runtime ownership + sourceResolved argumentArity.symm sourceRun calleeRun + calleeResultWorld targetDeclaration control noCredits image finish + (workers calleeFuel (by omega)) + | @extern arity value sourceDeclaration _ _ _ => + exact False.elim (attached.sourceDeclaration_not_extern + contracts.sourceDeclarations sourceDeclaration) + +/-- Worker-facing self-tail-call rule, with evaluator inversion and result +checking discharged before entering the existing CPS adapter. -/ +theorem CompiledAttachment.simulate_traced_tail_call_self_cps_of_run + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {callFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceArguments : Array IxIR1.Atom} {generated : Block} + (descendant : functionTrace.root.Descendant + (.tailCallSelf site blockId input entryValueCount sourceArguments + generated)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + {sourceOutput outcome : IxIR1.Store × IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.tailCallSelf site blockId input entryValueCount sourceArguments + generated) sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.tailCallSelf site blockId input entryValueCount sourceArguments + generated) sourceStore source frameRoots) + (sourceRun : IxIR1.runCode sourceContext (callFuel + 2) + functionTrace.source sourceStore source + (.letOp (.callSelf sourceArguments) (.ret (.var 0))) = + .ok sourceOutput) + (resultWorld : IxIR1.Sim.HasWorld sourceOutput.1 + functionTrace.source.result sourceOutput.2) + (control : machine.control = .running frame stack) + (noCredits : frame.credits = #[]) + (image : attached.SourceStoreImage sourceStore) + {post : SourceMachinePost} + (finish : SuccessfulReturnHandler attached sourceContext context + interpretation functionTrace frameRoots stack sourceOutput outcome post) + (workers : ∀ fuel, fuel < callFuel + 2 → + SuccessfulTraceSimulationAt attached sourceContext context + interpretation fuel) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + obtain ⟨middleStore, operationValue, operationRun, continuationRun⟩ := + IxIR1.runCode_letOp_success sourceRun + obtain ⟨values, bodyOutput, sourceResolved, argumentArity, calleeRun, + resultRun⟩ := IxIR1.runOp_callSelf_success operationRun + obtain ⟨returnedValue, returnedResolved, sourceOutputEq⟩ := + IxIR1.runCode_ret_success continuationRun + have returnedValueEq : returnedValue = operationValue := by + simpa [IxIR1.resolveAtom] using returnedResolved.symm + subst returnedValue + subst sourceOutput + obtain ⟨bodyOutputEq, calleeResultWorld⟩ := + IxIR1.Sim.checkResultWorld_ok resultRun + cases bodyOutputEq + exact attached.simulate_traced_tail_call_self_cps functionMember descendant + state stores runtime ownership sourceResolved argumentArity.symm sourceRun + calleeRun calleeResultWorld control noCredits image finish + (workers callFuel (by omega)) + +/-- Worker-facing addressed call rule for an ordinary `letOp`. Source +evaluation determines the retained callee and both recursive fuels; the +shared no-reuse contract transports the caller runtime across invocation. -/ +theorem CompiledAttachment.simulate_traced_call_cps_of_run + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {callFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + (contracts : SuccessfulSimulationContracts attached sourceContext context) + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} {sourceAddress targetAddress : Ixon.Address} + {sourceArguments : Array IxIR1.Atom} {targetArguments : Array Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.call sourceAddress sourceArguments) index + (.call targetAddress targetArguments) next)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + {sourceOutput outcome : IxIR1.Store × IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.call sourceAddress sourceArguments) index + (.call targetAddress targetArguments) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.call sourceAddress sourceArguments) index + (.call targetAddress targetArguments) next) + sourceStore source frameRoots) + (sourceRun : IxIR1.runCode sourceContext (callFuel + 2) + functionTrace.source sourceStore source + (.letOp (.call sourceAddress sourceArguments) next.sourceCode) = + .ok sourceOutput) + (resultWorld : IxIR1.Sim.HasWorld sourceOutput.1 + functionTrace.source.result sourceOutput.2) + (control : machine.control = .running frame stack) + (noCredits : frame.credits = #[]) + (image : attached.SourceStoreImage sourceStore) + {post : SourceMachinePost} + (finish : SuccessfulReturnHandler attached sourceContext context + interpretation functionTrace frameRoots stack sourceOutput outcome post) + (workers : ∀ fuel, fuel < callFuel + 2 → + SuccessfulTraceSimulationAt attached sourceContext context + interpretation fuel) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + obtain ⟨middleStore, operationValue, operationRun, continuationRun⟩ := + IxIR1.runCode_letOp_success sourceRun + obtain ⟨values, sourceResolved, invokeRun⟩ := + IxIR1.runOp_call_success operationRun + obtain ⟨calleeFuel, callFuelEq, invoked⟩ := + IxIR1.invoke_success invokeRun + cases invoked with + | @fn sourceDefinition bodyOutput sourceDeclaration argumentArity calleeRun + resultRun => + obtain ⟨bodyOutputEq, calleeResultWorld⟩ := + IxIR1.Sim.checkResultWorld_ok resultRun + cases bodyOutputEq + obtain ⟨targetDefinition, calleeTrace, calleeMember, calleeMatch, + targetDeclaration⟩ := + attached.functionTrace_of_source_declaration + contracts.sourceDeclarations contracts.targetDeclarations + sourceDeclaration + have callerRuntime : Lower.Sim.SourceRuntimeInvariant middleStore + (operationValue :: source) := + runtime.runOp + (IxIR1.NoReuse.invoke_reuses_eq + (attached.sourceContextNoReuse contracts.sourceDeclarations) + invokeRun) + operationRun + exact attached.simulate_traced_call_fn_cps functionMember calleeMember + descendant calleeMatch state stores runtime ownership + contracts.sourceDeclarations sourceResolved argumentArity.symm + operationRun calleeRun calleeResultWorld callerRuntime + continuationRun resultWorld targetDeclaration control noCredits + image finish (workers calleeFuel (by omega)) + (workers (callFuel + 1) (by omega)) + | @extern arity value sourceDeclaration _ _ _ => + exact False.elim (attached.sourceDeclaration_not_extern + contracts.sourceDeclarations sourceDeclaration) + +/-- Worker-facing recursive self-call rule for an ordinary `letOp`. The +function-level no-reuse certificate supplies the caller runtime invariant +after the checked callee result is returned. -/ +theorem CompiledAttachment.simulate_traced_call_self_cps_of_run + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {callFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + (contracts : SuccessfulSimulationContracts attached sourceContext context) + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceArguments : Array IxIR1.Atom} {targetArguments : Array Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.callSelf sourceArguments) index (.callSelf targetArguments) next)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + {sourceOutput outcome : IxIR1.Store × IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.callSelf sourceArguments) index (.callSelf targetArguments) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.callSelf sourceArguments) index (.callSelf targetArguments) next) + sourceStore source frameRoots) + (sourceRun : IxIR1.runCode sourceContext (callFuel + 2) + functionTrace.source sourceStore source + (.letOp (.callSelf sourceArguments) next.sourceCode) = .ok sourceOutput) + (resultWorld : IxIR1.Sim.HasWorld sourceOutput.1 + functionTrace.source.result sourceOutput.2) + (control : machine.control = .running frame stack) + (noCredits : frame.credits = #[]) + (image : attached.SourceStoreImage sourceStore) + {post : SourceMachinePost} + (finish : SuccessfulReturnHandler attached sourceContext context + interpretation functionTrace frameRoots stack sourceOutput outcome post) + (workers : ∀ fuel, fuel < callFuel + 2 → + SuccessfulTraceSimulationAt attached sourceContext context + interpretation fuel) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + obtain ⟨middleStore, operationValue, operationRun, continuationRun⟩ := + IxIR1.runCode_letOp_success sourceRun + obtain ⟨values, bodyOutput, sourceResolved, argumentArity, calleeRun, + resultRun⟩ := IxIR1.runOp_callSelf_success operationRun + obtain ⟨bodyOutputEq, calleeResultWorld⟩ := + IxIR1.Sim.checkResultWorld_ok resultRun + cases bodyOutputEq + have callerRuntime : Lower.Sim.SourceRuntimeInvariant middleStore + (operationValue :: source) := + runtime.runOp + (IxIR1.NoReuse.runOp_reuses_eq + (attached.sourceContextNoReuse contracts.sourceDeclarations) + (attached.functionTraceNoReuse functionMember) (by trivial) + operationRun) + operationRun + exact attached.simulate_traced_call_self_cps functionMember descendant state + stores runtime ownership contracts.sourceDeclarations sourceResolved + argumentArity.symm operationRun calleeRun calleeResultWorld callerRuntime + continuationRun resultWorld control noCredits image finish + (workers callFuel (by omega)) (workers (callFuel + 1) (by omega)) + +/-- Worker-facing dynamic-application rule. The successful evaluator run is +decomposed into the erased, under-saturated, exactly saturated, or +over-saturated PAP plan; each plan constructor feeds the corresponding CPS +adapter, including the recursive `applyMore` return handler. -/ +theorem CompiledAttachment.simulate_traced_apply_cps_of_run + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {applyFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + (contracts : SuccessfulSimulationContracts attached sourceContext context) + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} {sourceFunction : IxIR1.Atom} + {targetFunction : Atom} {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + {sourceOutput outcome : IxIR1.Store × IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + sourceStore source frameRoots) + (sourceRun : IxIR1.runCode sourceContext (applyFuel + 3) + functionTrace.source sourceStore source + (.letOp (.apply sourceFunction sourceArguments) next.sourceCode) = + .ok sourceOutput) + (resultWorld : IxIR1.Sim.HasWorld sourceOutput.1 + functionTrace.source.result sourceOutput.2) + (control : machine.control = .running frame stack) + (noCredits : frame.credits = #[]) + (image : attached.SourceStoreImage sourceStore) + {post : SourceMachinePost} + (finish : SuccessfulReturnHandler attached sourceContext context + interpretation functionTrace frameRoots stack sourceOutput outcome post) + (workers : ∀ fuel, fuel < applyFuel + 3 → + SuccessfulTraceSimulationAt attached sourceContext context + interpretation fuel) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + obtain ⟨middleStore, operationValue, operationRun, continuationRun⟩ := + IxIR1.runCode_letOp_success sourceRun + have middleImage : attached.SourceStoreImage middleStore := + attached.runOp_preservesSourceStoreImage contracts.sourceDeclarations + functionMember descendant state image operationRun + obtain ⟨functionValue, values, functionResolved, argumentsResolved, + applyRun⟩ := IxIR1.runOp_apply_success operationRun + have plan := attached.applyMorePlan_of_applyGo + contracts.sourceDeclarations contracts.targetDeclarations applyRun + have callerRuntime : Lower.Sim.SourceRuntimeInvariant middleStore + (operationValue :: source) := + runtime.runOp + (IxIR1.NoReuse.applyGo_reuses_eq + (attached.sourceContextNoReuse contracts.sourceDeclarations) + applyRun) + operationRun + have callerOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next middleStore + (operationValue :: source) frameRoots := + Lower.Sim.SourceOwnershipAt.applyFrom (checked := attached.target) + functionMember descendant ownership + (attached.applyOwnershipPreservesFrom_sourceStoreImage_of_declarations + contracts.sourceDeclarations image) operationRun + have nextDescendant : functionTrace.root.Descendant next := by + exact .step descendant (by simp [Lower.CodeTrace.children]) + cases plan with + | @erased fuel planStore planReleased planValues sourceRelease => + exact attached.simulate_traced_apply_erased_cps functionMember descendant + state stores runtime ownership contracts.sourceDeclarations + functionResolved argumentsResolved sourceRelease + sourceRun resultWorld control noCredits image finish + (workers (applyFuel + 2) (by omega)) + | @papUnder fuel planStore retainedStore releasedStore location box address + arity captured planValues sourceGet node sourceRetain sourceRelease + totalUnder => + obtain ⟨shared, capturedUnder⟩ := attached.livePapFacts functionMember + descendant runtime ownership sourceGet node + exact attached.simulate_traced_apply_pap_under_cps functionMember + descendant state stores runtime ownership contracts.sourceDeclarations + functionResolved argumentsResolved sourceGet shared node capturedUnder + sourceRetain sourceRelease totalUnder sourceRun resultWorld control + noCredits image finish + (workers (applyFuel + 2) (by omega)) + | @papSaturatedFn fuel calleeFuel planStore retainedStore releasedStore + planOutputStore location box address arity captured planValues + sourceDefinition targetDefinition calleeTrace planOutputValue calleeMember + calleeMatch sourceGet node sourceRetain sourceRelease totalExact papArity + sourceDeclaration sourcePapSafe targetDeclaration calleeRun + calleeResultWorld calleeSmaller => + obtain ⟨shared, capturedUnder⟩ := attached.livePapFacts functionMember + descendant runtime ownership sourceGet node + exact attached.simulate_traced_apply_pap_saturated_cps functionMember + calleeMember descendant calleeMatch state stores runtime ownership + contracts.sourceDeclarations functionResolved argumentsResolved + sourceGet shared node capturedUnder sourceRetain sourceRelease + totalExact papArity sourceDeclaration sourcePapSafe targetDeclaration + operationRun calleeRun calleeResultWorld callerRuntime continuationRun + resultWorld control noCredits image finish + (workers calleeFuel (by omega)) + (workers (applyFuel + 2) (by omega)) + | @papOverFn fuel calleeFuel planStore retainedStore releasedStore calledStore + planOutputStore location box address arity captured planValues + sourceDefinition targetDefinition calleeTrace calledValue planOutputValue + calleeMember calleeMatch sourceGet node sourceRetain sourceRelease + totalOver papArity sourceDeclaration sourcePapSafe targetDeclaration + calleeRun calleeResultWorld calleeSmaller residual => + obtain ⟨shared, capturedUnder⟩ := attached.livePapFacts functionMember + descendant runtime ownership sourceGet node + obtain ⟨_, _, _, _, _, _, _, _, _, _, _, callerTargets⟩ := + attached.simulate_traced_apply_pap_over_enter_state + (context := context) (interpretation := interpretation) + functionMember calleeMember descendant calleeMatch state stores + runtime.positiveSharedRC contracts.sourceDeclarations + functionResolved argumentsResolved sourceGet shared node + capturedUnder sourceRetain sourceRelease totalOver papArity + sourceDeclaration sourcePapSafe targetDeclaration noCredits control + let resume : Eval.Frame := { frame with pc := frame.pc + 1 } + let nextFrame : Eval.Frame := + { frame with + pc := frame.pc + 1 + values := frame.values.push operationValue } + have nextState : attached.sidecars.TraceStateRel functionTrace next + middleStore (operationValue :: source) nextFrame := by + simpa [nextFrame] using + (callerTargets middleStore operationValue operationRun) + have nextNoCredits : nextFrame.credits = #[] := by + simpa [nextFrame] using noCredits + have continuation : SuccessfulResumeContinuation context interpretation + resume stack (middleStore, operationValue) outcome post := + resumeContinuationOfWorker attached functionMember nextDescendant + (by rfl) nextState callerRuntime middleImage callerOwnership continuationRun + resultWorld nextNoCredits finish + (workers (applyFuel + 2) (by omega)) + have nextHandler : ∀ remaining : Array Lower.BindingCap, + SuccessfulReturnHandler attached sourceContext context interpretation + calleeTrace + (IxIR1.Sim.rootsFor .shared + ((captured.toList ++ values).drop arity) ++ + Lower.Sim.rootsForCapabilities remaining.toList source ++ + frameRoots) + (.applyMore + ((captured ++ values.toArray).extract arity + (captured ++ values.toArray).size) + { frame with pc := frame.pc + 1 } :: stack) + (calledStore, calledValue) outcome post := by + intro remaining + have handler : SuccessfulReturnHandler attached sourceContext context + interpretation calleeTrace + (IxIR1.Sim.rootsFor .shared + ((captured.toList ++ values).drop arity) ++ + (Lower.Sim.rootsForCapabilities remaining.toList source ++ + frameRoots)) + (.applyMore ((captured.toList ++ values).drop arity).toArray + resume :: stack) + (calledStore, calledValue) outcome post := + attached.applyMoreReturnHandler_of_plan contracts.sourceDeclarations + residual + (fun recursiveFuel smaller => + workers recursiveFuel (by omega)) + continuation calleeTrace + (Lower.Sim.rootsForCapabilities remaining.toList source ++ + frameRoots) + intro returningTrace returnFuel returnSite returnBlock returnInput + returnEntryValueCount returnAtom returnTarget returnGenerated + returnStore returnSource returnFrame returnMachine returningMember + returnDescendant returnState returnStores returnRuntime + returnOwnership returnRun returnWorld returnControl returnNoCredits + returnImage + apply handler returningMember returnDescendant returnState returnStores + returnRuntime + · simpa [List.append_assoc] using returnOwnership + · exact returnRun + · exact returnWorld + · have remainingArrayEq : + ((captured ++ values.toArray).extract arity + (captured ++ values.toArray).size) = + ((captured.toList ++ values).drop arity).toArray := by + rw [show captured ++ values.toArray = + (captured.toList ++ values).toArray by + apply Array.toList_inj.mp + simp] + exact List.toArray_drop.symm + rw [← remainingArrayEq] + simpa [resume] using returnControl + · exact returnNoCredits + · exact returnImage + exact attached.simulate_traced_apply_pap_over_cps functionMember + calleeMember descendant calleeMatch state stores runtime ownership + contracts.sourceDeclarations functionResolved argumentsResolved + sourceGet shared node capturedUnder sourceRetain sourceRelease + totalOver papArity sourceDeclaration sourcePapSafe targetDeclaration + calleeRun calleeResultWorld control noCredits image nextHandler + (workers calleeFuel (by omega)) + +/-- Exhaustive worker-facing rule for a traced source operation. Checked +operation syntax leaves exactly one target instruction in every executable +case. Reuse has no legal IxIR₂ syntax, retained extern operations are ruled +out by attachment, and dynamic apply consumes one additional evaluator fuel +constructor before entering its complete PAP plan. -/ +theorem CompiledAttachment.simulate_traced_letOp_cps_of_run + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {operationFuel : Nat} + {context : Eval.Context} + (contracts : SuccessfulSimulationContracts attached sourceContext context) + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {operation : IxIR1.Op} {instruction : Instr} {next : Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount operation index + instruction next)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + {sourceOutput outcome : IxIR1.Store × IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.letOp site blockId input nextInput entryValueCount operation index + instruction next) sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount operation index + instruction next) sourceStore source frameRoots) + (sourceRun : IxIR1.runCode sourceContext (operationFuel + 2) + functionTrace.source sourceStore source + (.letOp operation next.sourceCode) = .ok sourceOutput) + (resultWorld : IxIR1.Sim.HasWorld sourceOutput.1 + functionTrace.source.result sourceOutput.2) + (control : machine.control = .running frame stack) + (noCredits : frame.credits = #[]) + (image : attached.SourceStoreImage sourceStore) + {post : SourceMachinePost} + (finish : SuccessfulReturnHandler attached sourceContext context .logical + functionTrace frameRoots stack sourceOutput outcome post) + (workers : ∀ fuel, fuel < operationFuel + 2 → + SuccessfulTraceSimulationAt attached sourceContext context .logical fuel) : + BudgetedReachesPost context .logical post outcome.1 outcome.2 machine := by + have operationSyntax := + functionTrace.descendantOperationSyntax descendant + cases operation with + | pure sourceAtom => + cases instruction <;> + simp only [Lower.OperationSyntax] at operationSyntax + case move targetAtom => + exact attached.simulate_traced_pure_move_cps functionMember descendant + state stores runtime ownership contracts.sourceDeclarations sourceRun + resultWorld control noCredits image finish + (workers (operationFuel + 1) (by omega)) + | alloc sourceWorld sourceCid sourceArguments => + cases instruction <;> + simp only [Lower.OperationSyntax] at operationSyntax + case alloc targetWorld targetCid targetArguments => + exact attached.simulate_traced_alloc_checked_cps functionMember + contracts.targetSchemas descendant state stores runtime + contracts.sourceDeclarations ownership sourceRun resultWorld control + noCredits image finish (workers (operationFuel + 1) (by omega)) + | reuse sourceTarget sourceCid sourceArguments => + cases instruction <;> + simp only [Lower.OperationSyntax] at operationSyntax + | free sourceAtom => + cases instruction <;> + simp only [Lower.OperationSyntax] at operationSyntax + case freeUnique targetAtom targetCid => + exact attached.simulate_traced_free_freeUnique_cps functionMember + descendant state stores runtime ownership + contracts.sourceDeclarations sourceRun resultWorld control noCredits + image finish (workers (operationFuel + 1) (by omega)) + | dup sourceAtom => + cases instruction <;> + simp only [Lower.OperationSyntax] at operationSyntax + case retainShared targetAtom => + exact attached.simulate_traced_dup_retain_cps functionMember descendant + state stores runtime ownership contracts.sourceDeclarations sourceRun + resultWorld control noCredits image finish + (workers (operationFuel + 1) (by omega)) + | drop sourceAtom => + cases instruction <;> + simp only [Lower.OperationSyntax] at operationSyntax + case releaseShared targetAtom => + exact attached.simulate_traced_drop_release_cps functionMember + descendant state stores runtime ownership + contracts.sourceDeclarations sourceRun resultWorld control noCredits + image finish (workers (operationFuel + 1) (by omega)) + | dropU sourceAtom => + cases instruction <;> + simp only [Lower.OperationSyntax] at operationSyntax + case dropUnique targetAtom => + exact attached.simulate_traced_dropU_dropUnique_cps functionMember + descendant state stores runtime ownership + contracts.sourceDeclarations sourceRun resultWorld control noCredits + image finish (workers (operationFuel + 1) (by omega)) + | fetch sourceAtom sourceField => + cases instruction <;> + simp only [Lower.OperationSyntax] at operationSyntax + case fetch targetAtom targetCid targetField => + exact attached.simulate_traced_fetch_cps functionMember descendant state + stores runtime ownership contracts.sourceDeclarations sourceRun + resultWorld control noCredits image finish + (workers (operationFuel + 1) (by omega)) + | call sourceAddress sourceArguments => + cases instruction <;> + simp only [Lower.OperationSyntax] at operationSyntax + case call targetAddress targetArguments => + exact attached.simulate_traced_call_cps_of_run contracts functionMember + descendant state stores runtime ownership sourceRun resultWorld + control noCredits image finish workers + | callSelf sourceArguments => + cases instruction <;> + simp only [Lower.OperationSyntax] at operationSyntax + case callSelf targetArguments => + exact attached.simulate_traced_call_self_cps_of_run contracts + functionMember descendant state stores runtime ownership sourceRun + resultWorld control noCredits image finish workers + | papp sourceAddress sourceArguments => + cases instruction <;> + simp only [Lower.OperationSyntax] at operationSyntax + case papp targetAddress targetArguments => + obtain ⟨middleStore, operationValue, operationRun, continuationRun⟩ := + IxIR1.runCode_letOp_success sourceRun + obtain ⟨values, declaration, sourceResolved, sourceDeclaration, + under, operationOutput⟩ := + IxIR1.runOp_papp_success operationRun + cases declaration with + | extern arity => + exact False.elim (attached.sourceDeclaration_not_extern + contracts.sourceDeclarations sourceDeclaration) + | fn sourceDefinition => + obtain ⟨targetDefinition, calleeTrace, calleeMember, calleeMatch, + targetDeclaration⟩ := + attached.functionTrace_of_source_declaration + contracts.sourceDeclarations contracts.targetDeclarations + sourceDeclaration + have sourcePapSafe : sourceDefinition.papSafe = true := + attached.pappSafe contracts.sourceDeclarations functionMember + descendant sourceDeclaration + have targetArity : targetDefinition.signature.params.size = + sourceDefinition.arity := by + calc + targetDefinition.signature.params.size = + calleeTrace.generated.signature.params.size := by + rw [calleeMatch.generated] + _ = calleeTrace.source.arity := calleeTrace.sourceArity + _ = sourceDefinition.arity := congrArg IxIR1.FnDef.arity + calleeMatch.source + have targetPapSafe : targetDefinition.signature.papSafe = true := by + calc + targetDefinition.signature.papSafe = + calleeTrace.generated.signature.papSafe := by + rw [calleeMatch.generated] + _ = calleeTrace.source.papSafe := calleeTrace.sourcePapSafe + _ = sourceDefinition.papSafe := congrArg IxIR1.FnDef.papSafe + calleeMatch.source + _ = true := sourcePapSafe + exact attached.simulate_traced_papp_fn_cps functionMember + descendant state stores runtime ownership + contracts.sourceDeclarations sourceDeclaration + targetDeclaration targetArity targetPapSafe sourceRun + resultWorld control noCredits image finish + (workers (operationFuel + 1) (by omega)) + | apply sourceFunction sourceArguments => + cases instruction <;> + simp only [Lower.OperationSyntax] at operationSyntax + case apply targetFunction targetArguments => + cases operationFuel with + | zero => + obtain ⟨middleStore, operationValue, operationRun, + continuationRun⟩ := IxIR1.runCode_letOp_success sourceRun + obtain ⟨functionValue, values, functionResolved, + argumentsResolved, applyRun⟩ := + IxIR1.runOp_apply_success operationRun + have impossible := attached.applyMorePlan_of_applyGo + contracts.sourceDeclarations contracts.targetDeclarations + applyRun + cases impossible + | succ applyFuel => + exact attached.simulate_traced_apply_cps_of_run contracts + functionMember descendant state stores runtime ownership + sourceRun resultWorld control noCredits image finish + (fun fuel smaller => workers fuel (by omega)) + | extern sourceAddress sourceArguments => + exact False.elim + (attached.sourceExtern_impossible functionMember descendant) + +/-- Complete CPS composition for a literal-zero switch branch. The checked +branch certificate supplies both the exact recursive child and a target step +that preserves the continuation's chosen heap budget. -/ +theorem CompiledAttachment.simulate_traced_switch_nat_zero_cps + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {alternatives : Array IxIR1.Alt} + {targetScrutinee : Atom} {generated : Block} + {outgoing : List Lower.EdgeTrace} {children : List Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + {sourceOutput outcome : IxIR1.Store × IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children) + sourceStore source frameRoots) + {alternativeIndex : Nat} {body : IxIR1.Code} + (sourceResolved : IxIR1.resolveAtom source sourceScrutinee = + .ok (.lit (.nat 0))) + (sourceAlternative : Lower.sourceAlternativeAtTag? alternatives 0 = + some (.mk 0 0 body, alternativeIndex)) + (branchRun : IxIR1.runCode sourceContext sourceFuel functionTrace.source + sourceStore source body = .ok sourceOutput) + (resultWorld : IxIR1.Sim.HasWorld sourceOutput.1 + functionTrace.source.result sourceOutput.2) + (control : machine.control = .running frame stack) + (noCredits : frame.credits = #[]) + (image : attached.SourceStoreImage sourceStore) + {post : SourceMachinePost} + (finish : SuccessfulReturnHandler attached sourceContext context + interpretation functionTrace frameRoots stack sourceOutput outcome post) + (worker : SuccessfulTraceSimulationAt attached sourceContext context + interpretation sourceFuel) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + obtain ⟨constructors, peel, branches, childFrame, terminator, edgeMember, + childMember, selected, childSource, childCode, targetStep, + targetPreserving, childNoCredits, childTarget⟩ := + Lower.Sim.simulate_traced_switch_nat_zero_state descendant state.target + sourceResolved control noCredits + have selectedEq : + (IxIR1.Alt.mk 0 0 branches.zero.body, + branches.zero.alternativeIndex) = + (.mk 0 0 body, alternativeIndex) := + Option.some.inj (selected.symm.trans sourceAlternative) + have bodyEq : branches.zero.body = body := + congrArg (fun pair : IxIR1.Alt × Nat => + match pair.1 with | .mk _ _ code => code) selectedEq + have childRun : IxIR1.runCode sourceContext sourceFuel + functionTrace.source sourceStore source + branches.zeroChild.sourceCode = .ok sourceOutput := by + rw [childCode, bodyEq] + exact branchRun + have childState := state.natZeroChild selected childSource childCode + childTarget + have childDescendant : + functionTrace.root.Descendant branches.zeroChild := + .step descendant childMember + have parentEnvironments : Lower.Sim.EnvRel source frame.values input := by + simpa [Lower.CodeTrace.sourceInputMap] using state.target.environments + have childOwnership := Lower.Sim.SourceOwnershipAt.switchNatZero + attached.target functionMember descendant terminator branches ownership + parentEnvironments + let childMachine : Eval.Machine := + { machine with control := .running childFrame stack } + have childStores : Lower.Sim.StoreRel sourceStore childMachine.store := by + simpa [childMachine] using stores + have childControl : childMachine.control = + .running childFrame stack := rfl + have tail := worker (machine := childMachine) (stack := stack) + functionMember childDescendant childState childStores runtime childOwnership + childRun resultWorld childControl childNoCredits image finish + refine BudgetedReachesPost.prependPreserving + (before := machine) (middle := childMachine) (prefixCount := 1) ?_ tail + intro heapFuel + have fundedControl : ({ machine with heapFuel } : Eval.Machine).control = + .running frame stack := by + simpa using control + simpa [childMachine] using + (targetPreserving heapFuel).toSteps fundedControl + +/-- Complete CPS composition for a literal-successor switch branch. The +peeled predecessor becomes the child's scalar head and ownership lenders are +shifted in lockstep with the target parameter prefix. -/ +theorem CompiledAttachment.simulate_traced_switch_nat_succ_cps + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {alternatives : Array IxIR1.Alt} + {targetScrutinee : Atom} {generated : Block} + {outgoing : List Lower.EdgeTrace} {children : List Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {predecessor : Nat} {frameRoots : List IxIR1.Sim.Root} + {sourceOutput outcome : IxIR1.Store × IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children) + sourceStore source frameRoots) + {alternativeIndex : Nat} {body : IxIR1.Code} + (sourceResolved : IxIR1.resolveAtom source sourceScrutinee = + .ok (.lit (.nat (predecessor + 1)))) + (sourceAlternative : Lower.sourceAlternativeAtTag? alternatives 1 = + some (.mk 1 1 body, alternativeIndex)) + (branchRun : IxIR1.runCode sourceContext sourceFuel functionTrace.source + sourceStore (.lit (.nat predecessor) :: source) body = + .ok sourceOutput) + (resultWorld : IxIR1.Sim.HasWorld sourceOutput.1 + functionTrace.source.result sourceOutput.2) + (control : machine.control = .running frame stack) + (noCredits : frame.credits = #[]) + (image : attached.SourceStoreImage sourceStore) + {post : SourceMachinePost} + (finish : SuccessfulReturnHandler attached sourceContext context + interpretation functionTrace frameRoots stack sourceOutput outcome post) + (worker : SuccessfulTraceSimulationAt attached sourceContext context + interpretation sourceFuel) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + obtain ⟨constructors, peel, branches, childFrame, terminator, edgeMember, + childMember, selected, childSource, childCode, targetStep, + targetPreserving, childNoCredits, childTarget⟩ := + Lower.Sim.simulate_traced_switch_nat_succ_state descendant state.target + sourceResolved control noCredits + have selectedEq : + (IxIR1.Alt.mk 1 1 branches.succ.body, + branches.succ.alternativeIndex) = + (.mk 1 1 body, alternativeIndex) := + Option.some.inj (selected.symm.trans sourceAlternative) + have bodyEq : branches.succ.body = body := + congrArg (fun pair : IxIR1.Alt × Nat => + match pair.1 with | .mk _ _ code => code) selectedEq + have childRun : IxIR1.runCode sourceContext sourceFuel + functionTrace.source sourceStore + (.lit (.nat predecessor) :: source) + branches.succChild.sourceCode = .ok sourceOutput := by + rw [childCode, bodyEq] + exact branchRun + have childState := state.natSuccChild selected childSource childCode + sourceResolved childTarget + have childDescendant : + functionTrace.root.Descendant branches.succChild := + .step descendant childMember + have parentEnvironments : Lower.Sim.EnvRel source frame.values input := by + simpa [Lower.CodeTrace.sourceInputMap] using state.target.environments + have childOwnership := Lower.Sim.SourceOwnershipAt.switchNatSucc + attached.target functionMember descendant terminator branches ownership + parentEnvironments (predecessor := predecessor) + have childRuntime := runtime.natSuccessor predecessor + let childMachine : Eval.Machine := + { machine with control := .running childFrame stack } + have childStores : Lower.Sim.StoreRel sourceStore childMachine.store := by + simpa [childMachine] using stores + have childControl : childMachine.control = + .running childFrame stack := rfl + have tail := worker (machine := childMachine) (stack := stack) + functionMember childDescendant childState childStores childRuntime + childOwnership childRun resultWorld childControl childNoCredits image finish + refine BudgetedReachesPost.prependPreserving + (before := machine) (middle := childMachine) (prefixCount := 1) ?_ tail + intro heapFuel + have fundedControl : ({ machine with heapFuel } : Eval.Machine).control = + .running frame stack := by + simpa using control + simpa [childMachine] using + (targetPreserving heapFuel).toSteps fundedControl + +/-- Complete CPS composition for a constructor switch branch. The target +dispatch and certified fetch prologue enter the exact recursive child, while +the attached schema invariant turns every fetched field into a borrow from +the selected constructor root. -/ +theorem CompiledAttachment.simulate_traced_switch_ctor_cps + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {targetScrutinee : Atom} + {generated : Block} {outgoing : List Lower.EdgeTrace} + {children : List Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {location : Nat} {box : IxIR1.NodeBox} {cid : CtorId} + {fields : Array IxIR1.RVal} {frameRoots : List IxIR1.Sim.Root} + {sourceOutput outcome : IxIR1.Store × IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children) + sourceStore source frameRoots) + (sourceResolved : IxIR1.resolveAtom source sourceScrutinee = + .ok (.loc location)) + (sourceGet : sourceStore.get? location = some box) + (node : box.node = .ctorN cid fields) + {tag fieldCount alternativeIndex : Nat} {body : IxIR1.Code} + (sourceAlternative : Lower.sourceAlternativeAtTag? alternatives cid.cidx = + some (.mk tag fieldCount body, alternativeIndex)) + (fieldArity : fields.size = fieldCount) + {constructors : Array CtorAlt} {targetPeel : Option NatPeel} + {index : Nat} {target : CtorAlt} {edge : Lower.EdgeTrace} + {child : Lower.CodeTrace} + (terminator : generated.terminator = + .switchValue targetScrutinee constructors targetPeel) + (targetAt : constructors[index]? = some target) + (targetAlternative : constructors.find? (fun candidate => + candidate.cid == cid) = some target) + (edgeAt : outgoing[index]? = some edge) + (childAt : children[index]? = some child) + (branchRun : IxIR1.runCode sourceContext sourceFuel functionTrace.source + sourceStore (fields.toList.reverse ++ source) body = .ok sourceOutput) + (resultWorld : IxIR1.Sim.HasWorld sourceOutput.1 + functionTrace.source.result sourceOutput.2) + (control : machine.control = .running frame stack) + (noCredits : frame.credits = #[]) + (image : attached.SourceStoreImage sourceStore) + {post : SourceMachinePost} + (finish : SuccessfulReturnHandler attached sourceContext context + interpretation functionTrace frameRoots stack sourceOutput outcome post) + (worker : SuccessfulTraceSimulationAt attached sourceContext context + interpretation sourceFuel) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + obtain ⟨childFrame, _edgeFrame, _childScrutinee, childSource, childCode, + targetSteps, targetPreserving, childNoCredits, nextStores, childTarget, + _parentBlockAt, _parentPc, _targetResolved, _targetGet, _transferred, + _switchStep, _childBlockAt, _childPc, _childResolved, _prologue⟩ := + Lower.Sim.simulate_traced_switch_ctor_state descendant state.target stores + sourceResolved sourceGet node sourceAlternative fieldArity terminator + targetAt targetAlternative edgeAt childAt control noCredits + have recursiveMatched := + functionTrace.descendantSwitchBranchesMatch descendant + have localMatched := + Lower.CodeTrace.switchNodeBranchesMatch_of_match recursiveMatched + have branch := Lower.constructorBranchMatchAt_of_switch_match + localMatched terminator targetAt edgeAt childAt + have targetCid : target.cid = cid := by + have matched : (target.cid == cid) = true := Array.find?_some + (p := fun candidate : CtorAlt => candidate.cid == cid) + (a := target) (xs := constructors) targetAlternative + exact beq_iff_eq.mp matched + have branchAlternative := branch.sourceAlternative + rw [targetCid, sourceAlternative] at branchAlternative + have alternativeEqual := Option.some.inj branchAlternative + have sourceFieldCount : branch.fieldCount = fieldCount := by + exact (congrArg (fun alternative : IxIR1.Alt × Nat => + match alternative.1 with | .mk _ fields _ => fields) + alternativeEqual).symm + have branchFieldArity : fields.size = branch.fieldCount := by + rw [sourceFieldCount] + exact fieldArity + have childRun : IxIR1.runCode sourceContext sourceFuel + functionTrace.source sourceStore (fields.toList.reverse ++ source) + child.sourceCode = .ok sourceOutput := by + rw [childCode] + exact branchRun + have childState := state.constructorChild sourceAlternative childSource + childCode sourceResolved sourceGet node fieldArity childTarget + have childMember : child ∈ children := List.mem_of_getElem? childAt + have childDescendant : functionTrace.root.Descendant child := + .step descendant childMember + have parentEnvironments : Lower.Sim.EnvRel source frame.values input := by + simpa [Lower.CodeTrace.sourceInputMap] using state.target.environments + have schemaFields : ∀ {world schema}, + attached.target.artifact.validationContext.schemas world cid = + some schema → + ∃ count, schema.fields = Array.replicate count world := by + intro world schema found + rw [attached.targetSchemasProduced] at found + exact attached.schema_fields_replicate found + have childOwnership := Lower.Sim.SourceOwnershipAt.switchCtor + attached.target functionMember descendant terminator targetAt childAt + branch ownership parentEnvironments sourceResolved sourceGet node + targetCid branchFieldArity schemaFields + have childRuntime := runtime.constructorBranch sourceGet node + let childMachine : Eval.Machine := + { machine with control := .running childFrame stack } + have childStores : Lower.Sim.StoreRel sourceStore childMachine.store := by + simpa [childMachine] using nextStores + have childControl : childMachine.control = + .running childFrame stack := rfl + have tail := worker (machine := childMachine) (stack := stack) + functionMember childDescendant childState childStores childRuntime + childOwnership childRun resultWorld childControl childNoCredits image finish + refine BudgetedReachesPost.prependPreserving + (before := machine) (middle := childMachine) + (prefixCount := 1 + fields.size) ?_ tail + intro heapFuel + simpa [childMachine] using targetPreserving heapFuel + +/-- Exhaustive CPS composition for a successful source `case`. The source +evaluator has already reduced the dispatch to one indexed constructor, +literal-zero, or literal-successor branch. Nat branches are selected wholly +from the retained lowering certificate. Constructor dispatch consumes one +focused witness for the corresponding emitted target; establishing that +witness from the attached source typing/constructor universe is deliberately +kept separate from the trace/fuel induction. -/ +theorem CompiledAttachment.simulate_traced_switch_cps + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Eval.Machine} {frame : Eval.Frame} + {stack : List Eval.Continuation} {functionTrace : Lower.FunctionTrace} + (functionMember : functionTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {targetScrutinee : Atom} + {generated : Block} {outgoing : List Lower.EdgeTrace} + {children : List Lower.CodeTrace} + (descendant : functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children)) + {sourceStore : IxIR1.Store} {source : List IxIR1.RVal} + {frameRoots : List IxIR1.Sim.Root} + {sourceOutput outcome : IxIR1.Store × IxIR1.RVal} + (state : attached.sidecars.TraceStateRel functionTrace + (.switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children) + sourceStore source frame) + (stores : Lower.Sim.StoreRel sourceStore machine.store) + (runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source) + (ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children) + sourceStore source frameRoots) + (selected : IndexedCaseSuccess sourceContext sourceFuel + functionTrace.source sourceStore source sourceScrutinee peelNat + alternatives sourceOutput) + (constructorSelection : + ∀ {location : Nat} {box : IxIR1.NodeBox} {cid : CtorId} + {fields : Array IxIR1.RVal} {fieldCount alternativeIndex : Nat} + {body : IxIR1.Code}, + IxIR1.resolveAtom source sourceScrutinee = .ok (.loc location) → + sourceStore.get? location = some box → + box.node = .ctorN cid fields → + Lower.sourceAlternativeAtTag? alternatives cid.cidx = + some (.mk cid.cidx fieldCount body, alternativeIndex) → + fields.size = fieldCount → + ConstructorSwitchSelection targetScrutinee generated outgoing children + cid) + (resultWorld : IxIR1.Sim.HasWorld sourceOutput.1 + functionTrace.source.result sourceOutput.2) + (control : machine.control = .running frame stack) + (noCredits : frame.credits = #[]) + (image : attached.SourceStoreImage sourceStore) + {post : SourceMachinePost} + (finish : SuccessfulReturnHandler attached sourceContext context + interpretation functionTrace frameRoots stack sourceOutput outcome post) + (worker : SuccessfulTraceSimulationAt attached sourceContext context + interpretation sourceFuel) : + BudgetedReachesPost context interpretation post outcome.1 outcome.2 + machine := by + cases selected with + | ctorBranch resolved found node sourceAlternative fieldArity branchRun => + let target := constructorSelection resolved found node sourceAlternative + fieldArity + exact attached.simulate_traced_switch_ctor_cps functionMember descendant + state stores runtime ownership resolved found node sourceAlternative + fieldArity target.terminator target.targetAt target.targetAlternative + target.edgeAt target.childAt branchRun resultWorld control noCredits + image finish worker + | natZero peels resolved sourceAlternative branchRun => + subst peelNat + exact attached.simulate_traced_switch_nat_zero_cps functionMember + descendant state stores runtime ownership resolved sourceAlternative + branchRun resultWorld control noCredits image finish worker + | natSucc peels resolved sourceAlternative branchRun => + subst peelNat + exact attached.simulate_traced_switch_nat_succ_cps functionMember + descendant state stores runtime ownership resolved sourceAlternative + branchRun resultWorld control noCredits image finish worker + +/-- Every successful retained source trace is simulated by the checked IxIR₂ +machine under logical extern interpretation. Strong induction is solely on +source evaluator fuel: local operations and switches recurse at the immediate +predecessor, calls recurse into both the strictly smaller callee and caller +continuation, and over-application follows its strictly descending plan. -/ +theorem CompiledAttachment.successfulTraceSimulation + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + (sourceContext : IxIR1.Ctx) (context : Eval.Context) + (contracts : SuccessfulSimulationContracts attached sourceContext context) : + ∀ fuel, SuccessfulTraceSimulationAt attached sourceContext context + .logical fuel := by + intro fuel + induction fuel using Nat.strongRecOn with + | ind fuel smallerWorkers => + cases fuel with + | zero => + exact successfulTraceSimulationAt_zero attached sourceContext context + .logical + | succ sourceFuel => + intro functionTrace trace sourceStore source frameRoots sourceOutput + outcome frame machine stack post functionMember descendant state + stores runtime ownership sourceRun resultWorld control noCredits + image finish + cases trace with + | ret site blockId input entryValueCount sourceAtom targetAtom + generated => + exact finish functionMember descendant state stores runtime + ownership sourceRun resultWorld control noCredits image + | tailCall site blockId input entryValueCount address sourceArguments + generated => + cases sourceFuel with + | zero => + obtain ⟨middleStore, operationValue, operationRun, + continuationRun⟩ := + IxIR1.runCode_letOp_success sourceRun + rw [IxIR1.runOp.eq_def] at operationRun + contradiction + | succ callFuel => + exact attached.simulate_traced_tail_call_cps_of_run contracts + functionMember descendant state stores runtime ownership + sourceRun resultWorld control noCredits image finish + (fun recursiveFuel smaller => + smallerWorkers recursiveFuel (by omega)) + | tailCallSelf site blockId input entryValueCount sourceArguments + generated => + cases sourceFuel with + | zero => + obtain ⟨middleStore, operationValue, operationRun, + continuationRun⟩ := + IxIR1.runCode_letOp_success sourceRun + rw [IxIR1.runOp.eq_def] at operationRun + contradiction + | succ callFuel => + exact attached.simulate_traced_tail_call_self_cps_of_run + functionMember descendant state stores runtime ownership + sourceRun resultWorld control noCredits image finish + (fun recursiveFuel smaller => + smallerWorkers recursiveFuel (by omega)) + | letOp site blockId input nextInput entryValueCount operation index + instruction next => + cases sourceFuel with + | zero => + obtain ⟨middleStore, operationValue, operationRun, + continuationRun⟩ := + IxIR1.runCode_letOp_success sourceRun + rw [IxIR1.runOp.eq_def] at operationRun + contradiction + | succ operationFuel => + exact attached.simulate_traced_letOp_cps_of_run contracts + functionMember descendant state stores runtime ownership + sourceRun resultWorld control noCredits image finish + (fun recursiveFuel smaller => + smallerWorkers recursiveFuel (by omega)) + | switchValue site blockId input entryValueCount sourceScrutinee + peelNat alternatives targetScrutinee generated outgoing + children => + have selected := indexedCaseSuccess_of_run sourceRun + exact attached.simulate_traced_switch_cps functionMember + descendant state stores runtime ownership selected + (fun resolved found node sourceAlternative fieldArity => + match exactEq : attached.sidecars.exactConstructorAt? + site sourceScrutinee with + | none => + attached.constructorSwitchSelection_of_residual + functionMember descendant exactEq image found node + sourceAlternative fieldArity + | some (fact, identity) => + attached.constructorSwitchSelection_of_exactHPT_runtime + functionMember descendant state exactEq resolved found + node) + resultWorld control noCredits image finish + (smallerWorkers sourceFuel (Nat.lt_succ_self sourceFuel)) + +/-- Public whole-main successful-run preservation for an attached baseline +lowering. The source and target budgets are intentionally independent: the +trace worker selects sufficient heap fuel backwards from recursive +destruction, while its finite step witness supplies the exact control fuel +accepted by `runMain`. -/ +theorem CompiledAttachment.successfulMainSimulation + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) + (sourceContext : IxIR1.Ctx) (context : Eval.Context) + (contracts : SuccessfulSimulationContracts attached sourceContext context) : + Lower.Sim.SuccessfulMainSimulation sourceContext context + attached.target.artifact.source.main + attached.target.artifact.source.mainResult + attached.target.artifact.program := by + intro sourceFuel sourceOutput sourceRun + obtain ⟨mainBodyRun, mainResultWorld⟩ := + IxIR1.Sim.runOwnedMain_ok sourceRun + have mainRun : IxIR1.runCode sourceContext sourceFuel + attached.target.artifact.mainTrace.source ({} : IxIR1.Store) [] + attached.target.artifact.mainTrace.root.sourceCode = .ok sourceOutput := by + rw [attached.target.artifact.mainSource, + attached.target.artifact.mainRootSourceCode] + exact mainBodyRun + have resultWorld : IxIR1.Sim.HasWorld sourceOutput.1 + attached.target.artifact.mainTrace.source.result sourceOutput.2 := by + rw [attached.target.artifact.mainSource] + exact mainResultWorld + let frame := Lower.Sim.initialMainFrame attached.target.artifact + let machine := Lower.Sim.initialMainMachine attached.target.artifact 0 + have state : attached.sidecars.TraceStateRel + attached.target.artifact.mainTrace + attached.target.artifact.mainTrace.root ({} : IxIR1.Store) [] frame := by + simpa [frame] using attached.initialMainTraceState + have stores : Lower.Sim.StoreRel ({} : IxIR1.Store) machine.store := by + simpa [machine, Lower.Sim.initialMainMachine] using + Lower.Sim.StoreRel.initial + have control : machine.control = .running frame [] := by + rfl + have noCredits : frame.credits = #[] := by + rfl + have reached := + (attached.successfulTraceSimulation sourceContext context contracts + sourceFuel) + attached.target.artifact.mainTraceMember + Lower.CodeTrace.Descendant.refl state stores + Lower.Sim.SourceRuntimeInvariant.empty + attached.initialMainSourceOwnership mainRun resultWorld control noCredits + attached.sourceStoreImage_empty + (attached.haltReturnHandler sourceContext context .logical + attached.target.artifact.mainTrace sourceOutput) + obtain ⟨heapFuel, controlFuel, final, steps, halted, finalStores⟩ := reached + cases final with + | mk targetStore heapRemaining finalControl => + dsimp only at halted + subst finalControl + let targetOutput : Eval.Result := + { store := targetStore + value := sourceOutput.2 + controlRemaining := 0 + heapRemaining } + refine ⟨controlFuel, heapFuel, targetOutput, ?_, ?_⟩ + · rw [Lower.Sim.runMain_eq_initialMainMachine] + have targetRun := steps.runMachine_halted + simpa [machine, targetOutput, Lower.Sim.initialMainMachine, + Eval.initialMachine] using targetRun + · exact { finalStores with value := rfl } + +/-- Canonical end-to-end entry point: the checked attachment alone simulates +every successful owned main run in its exact emitted evaluator contexts. -/ +theorem CompiledAttachment.successfulCanonicalMainSimulation + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : CompiledAttachment mainWorld lowerFuel) : + Lower.Sim.SuccessfulMainSimulation attached.simulationSourceContext + attached.simulationTargetContext attached.target.artifact.source.main + attached.target.artifact.source.mainResult + attached.target.artifact.program := + attached.successfulMainSimulation attached.simulationSourceContext + attached.simulationTargetContext + attached.successfulSimulationContracts + + +/-! Existing theorem names remain available for direct application. -/ +namespace Attached +export CompiledAttachment ( + declarationFunctionEntryTraceState + mainFunctionEntryTraceState + functionEntryTraceState + initialMainTraceState + initialMainSourceOwnership + traceState_next + traceState_next_of_member + mainTraceState_next + simulate_traced_pure_move_state + simulate_traced_pure_move_success_step + simulate_traced_alloc_checked_state + simulate_traced_alloc_checked_success_step + simulate_traced_dup_retain_scalar_state + simulate_traced_dup_retain_shared_state + simulate_traced_drop_release_scalar_state + simulate_traced_dropU_dropUnique_scalar_state + simulate_traced_dropU_dropUnique_recursive_state + simulate_traced_dropU_dropUnique_recursive_state_framed + simulate_traced_drop_release_recursive_state + simulate_traced_drop_release_recursive_state_framed + simulate_traced_papp_fn_state + simulate_traced_apply_transfer_state + simulate_traced_apply_erased_state + simulate_traced_apply_pap_under_state + simulate_traced_apply_pap_saturated_enter_state + simulate_traced_apply_pap_over_enter_state + simulate_traced_call_fn_enter_state + simulate_traced_call_self_enter_state + simulate_traced_tail_call_fn_enter_state + simulate_traced_tail_call_self_enter_state + simulate_traced_ret_apply_more_success + simulate_traced_ret_apply_more_pap_saturated_enter_state + simulate_traced_ret_apply_more_pap_over_enter_state + simulate_traced_ret_apply_more_pap_under_state + simulate_traced_ret_apply_more_erased_state + simulate_traced_return_to_letOp_state + simulate_traced_ret_halt_success + constructorSwitchSelection_of_exactHPT_nonempty + constructorSwitchSelection_of_exactHPT + constructorSwitchSelection_of_exactHPT_runtime + simulate_traced_fetch_state_of_run_hpt + simulate_traced_free_freeUnique_state_of_run_hpt + functionCodeConstructorsKnown + functionTraceConstructorsKnown + descendantOperationConstructorsKnown + sourceContextConstructorsKnown + SourceStoreImage + simulationSourceContext + simulationSourceContext_eq_addressedCtx + sourceRebuildSemanticAudit + sourceContextRenames + sourceContextRenamesOfDeclarations + sourceCodeAddressImage + functionSourceAddressImage + letOpAddressImages + rawApplyOwnership + sourceStoreImage_empty + runOp_preservesSourceStoreImage + dupVals_preservesSourceStoreImage + dropVal_preservesSourceStoreImage + dropMany_preservesSourceStoreImage + applyGo_exactImage + applyGo_owned_of_sourceStoreImage + applyGo_owned_of_sourceStoreImage_of_declarations + applyOwnershipPreservesFrom_sourceStoreImage_of_declarations + applyOwnershipPreservesFrom_sourceStoreImage + constructorSwitchSelection_of_residual_nonempty + constructorSwitchSelection_of_residual + simulationTargetContext + successfulSimulationContracts + haltReturnHandler + functionTrace_of_source_declaration + functionTrace_of_target_declaration + sourceDeclaration_not_extern + targetDeclaration_not_extern + applyMorePlan_of_applyGo + simulate_traced_pure_move_cps + simulate_traced_dup_retain_cps + simulate_traced_fetch_cps + simulate_traced_free_freeUnique_cps + simulate_traced_drop_release_cps + simulate_traced_dropU_dropUnique_cps + simulate_traced_alloc_checked_cps + simulate_traced_papp_fn_cps + simulate_traced_apply_erased_cps + simulate_traced_apply_pap_under_cps + simulate_traced_apply_pap_saturated_cps + simulate_traced_ret_apply_more_erased_cps + simulate_traced_ret_apply_more_pap_under_cps + simulate_traced_ret_apply_more_pap_saturated_cps + simulate_traced_ret_apply_more_pap_over_cps + simulate_traced_apply_pap_over_cps + applyMoreReturnHandler_of_plan + applyMoreReturnHandler_of_applyGo + simulate_traced_call_fn_cps + simulate_traced_call_self_cps + simulate_traced_tail_call_fn_cps + simulate_traced_tail_call_self_cps + simulate_traced_tail_call_cps_of_run + simulate_traced_tail_call_self_cps_of_run + simulate_traced_call_cps_of_run + simulate_traced_call_self_cps_of_run + simulate_traced_apply_cps_of_run + simulate_traced_letOp_cps_of_run + simulate_traced_switch_nat_zero_cps + simulate_traced_switch_nat_succ_cps + simulate_traced_switch_ctor_cps + simulate_traced_switch_cps + successfulTraceSimulation + successfulMainSimulation + successfulCanonicalMainSimulation) +end Attached + +end Ix.Compiler.IxIR2.Pipeline diff --git a/Ix/Compiler/IxIR2/ReservationHeap.lean b/Ix/Compiler/IxIR2/ReservationHeap.lean new file mode 100644 index 000000000..7ed33d6f7 --- /dev/null +++ b/Ix/Compiler/IxIR2/ReservationHeap.lean @@ -0,0 +1,233 @@ +import Ix.Compiler.IxIR2.HeapAccounting + +/-! +# Heap exclusion for reserved slots + +Ordinary allocation and destruction preserve every existing empty slot. The +only operation that fills such a slot is `reuseReservation`, at the location +named by its consumed credit. These facts apply throughout a callee, including +recursive destruction and dynamic application. +-/ + +namespace Ix.Compiler.IxIR2.Eval + +open Ix.Compiler.Ixon (Owned) +open Ix.Compiler.IxIR1 (RVal Node NodeBox) + +def Store.EmptySlot (store : Store) (location : Nat) : Prop := + store.heap.nodes[location]? = some none + +def EmptySlotsPreserved (before after : Store) : Prop := + ∀ location, before.EmptySlot location → after.EmptySlot location + +namespace EmptySlotsPreserved + +theorem refl (store : Store) : EmptySlotsPreserved store store := fun _ empty => empty + +theorem trans {first second third : Store} + (left : EmptySlotsPreserved first second) (right : EmptySlotsPreserved second third) : + EmptySlotsPreserved first third := fun location empty => right location (left location empty) + +theorem of_nodes {before after : Store} (same : after.heap.nodes = before.heap.nodes) : + EmptySlotsPreserved before after := by + intro location empty + simpa only [Store.EmptySlot, same] using empty + +theorem allocNode (store : Store) (world : Owned) (node : Node) : + EmptySlotsPreserved store (store.allocNode world node).1 := by + intro location empty + have bound := (Array.getElem?_eq_some_iff.mp empty).1 + simpa only [Store.EmptySlot, Store.allocNode_heap, IxIR1.Store.allocNode, + Array.getElem?_push_lt bound, Array.getElem?_eq_getElem bound] using empty + +theorem setBox {store : Store} {location : Nat} {old new : NodeBox} + (found : store.get? location = some old) : + EmptySlotsPreserved store (store.setBox location new) := by + intro reserved empty + have occupied := IxIR1.Sim.nodes_get?_of_get? found + have different : location ≠ reserved := by + intro same + subst reserved + rw [empty] at occupied + cases occupied + simpa only [Store.EmptySlot, Store.setBox, IxIR1.Store.setBox, + Array.set!_eq_setIfInBounds, + Array.getElem?_setIfInBounds_ne different] using empty + +theorem reserve (store : Store) (location : Nat) : + EmptySlotsPreserved store (store.reserve location) := by + intro reserved empty + by_cases same : location = reserved + · subst reserved + exact Array.getElem?_setIfInBounds_self_of_lt + (Array.getElem?_eq_some_iff.mp empty).1 + · simpa only [Store.EmptySlot, Store.reserve, + Array.getElem?_setIfInBounds_ne same] using empty + +theorem kill (store : Store) (location : Nat) : + EmptySlotsPreserved store (store.kill location) := + reserve store location + +theorem rcTick (store : Store) : EmptySlotsPreserved store store.rcTick := refl _ + +end EmptySlotsPreserved + +theorem Store.EmptySlot.not_live {store : Store} {location : Nat} + (empty : store.EmptySlot location) : store.get? location = none := by + change IxIR1.Store.get? store.heap location = none + unfold IxIR1.Store.get? + rw [empty] + rfl + +theorem Store.reserve_empty {store : Store} {location : Nat} {box : NodeBox} + (found : store.get? location = some box) : (store.reserve location).EmptySlot location := by + have occupied := IxIR1.Sim.nodes_get?_of_get? found + exact Array.getElem?_setIfInBounds_self_of_lt + (Array.getElem?_eq_some_iff.mp occupied).1 + +theorem retainShared_preservesEmpty {store output : Store} {value : RVal} + (run : retainShared store value = .ok output) : EmptySlotsPreserved store output := by + cases value with + | lit literal => cases run; exact .refl _ + | erased => cases run; exact .refl _ + | loc location => + cases found : store.get? location with + | none => simp [retainShared, found] at run + | some box => + by_cases shared : box.world = .shared + · simp [retainShared, found, shared] at run + subst output + exact (EmptySlotsPreserved.setBox found).trans (.rcTick _) + · simp [retainShared, found, shared] at run + +theorem RetainSharedMany.preservesEmpty {store output : Store} {values : Array RVal} + (run : RetainSharedMany store values output) : EmptySlotsPreserved store output := by + change values.foldlM retainShared store = .ok output at run + rw [← Array.foldlM_toList] at run + have loop : ∀ (values : List RVal) {store output : Store}, + values.foldlM retainShared store = .ok output → EmptySlotsPreserved store output := by + intro values + induction values with + | nil => intro store output run; cases run; exact .refl _ + | cons value rest ih => + intro store output run + rw [List.foldlM_cons] at run + cases head : retainShared store value with + | error error => simp [head, bind, Except.bind] at run + | ok middle => + simp only [head, bind, Except.bind] at run + exact (retainShared_preservesEmpty head).trans (ih run) + exact loop values.toList run + +theorem releaseSharedWork_preservesEmpty {fuel remaining : Nat} {store output : Store} + {values : List RVal} + (run : releaseSharedWork fuel store values = .ok (output, remaining)) : + EmptySlotsPreserved store output := by + induction fuel generalizing store values with + | zero => + cases values with + | nil => cases run; exact .refl _ + | cons value rest => simp [releaseSharedWork] at run + | succ fuel ih => + cases values with + | nil => cases run; exact .refl _ + | cons value rest => + cases value with + | lit literal => exact ih run + | erased => exact ih run + | loc location => + cases found : store.get? location with + | none => simp [releaseSharedWork, found] at run + | some box => + by_cases shared : box.world = .shared + · by_cases zero : box.rc = 0 + · simp [releaseSharedWork, found, shared, zero] at run + · by_cases unitRC : box.rc = 1 + · simp only [releaseSharedWork, found, shared, bne_self_eq_false, + Bool.false_eq_true, ↓reduceIte, unitRC, beq_self_eq_true] at run + exact (EmptySlotsPreserved.rcTick store).trans + ((EmptySlotsPreserved.kill _ location).trans (ih run)) + · simp [releaseSharedWork, found, shared, zero, unitRC] at run + have tickAt : store.rcTick.get? location = some box := found + exact (EmptySlotsPreserved.rcTick store).trans + ((EmptySlotsPreserved.setBox tickAt).trans (ih run)) + · simp [releaseSharedWork, found, shared] at run + +theorem dropUniqueWork_preservesEmpty {fuel remaining : Nat} {store output : Store} + {values : List RVal} + (run : dropUniqueWork fuel store values = .ok (output, remaining)) : + EmptySlotsPreserved store output := by + induction fuel generalizing store values with + | zero => + cases values with + | nil => cases run; exact .refl _ + | cons value rest => simp [dropUniqueWork] at run + | succ fuel ih => + cases values with + | nil => cases run; exact .refl _ + | cons value rest => + cases value with + | lit literal => exact ih run + | erased => exact ih run + | loc location => + cases found : store.get? location with + | none => simp [dropUniqueWork, found] at run + | some box => + by_cases unique : box.world = .unique + · cases node : box.node with + | papN address arity captured => simp [dropUniqueWork, found, unique, node] at run + | ctorN cid fields => + simp only [dropUniqueWork, found, unique, bne_self_eq_false, + Bool.false_eq_true, ↓reduceIte, node] at run + exact (EmptySlotsPreserved.kill store location).trans (ih run) + · simp [dropUniqueWork, found, unique] at run + +theorem Store.releaseReservation_preservesEmpty {store output : Store} {location : Nat} + (run : store.releaseReservation location = .ok output) : EmptySlotsPreserved store output := by + unfold Store.releaseReservation at run + split at run + · cases run + exact .refl _ + · cases run + +/-- Filling one reservation cannot affect any other reserved slot. The +machine credit invariant supplies the inequality from unique ownership. -/ +theorem Store.reuseReservation_preservesOther {store output : Store} + {location other payload : Nat} {world : Owned} {node : Node} + (run : store.reuseReservation location world node payload = .ok output) + (different : location ≠ other) (empty : store.EmptySlot other) : + output.EmptySlot other := by + unfold Store.reuseReservation at run + split at run + · cases run + simpa only [Store.EmptySlot, Store.withPeak_heap, + Array.getElem?_setIfInBounds_ne different] using empty + · cases run + +theorem ApplyTransferCase.preservesEmpty {context : Context} + {interpretation : Interpretation} {store : Store} {heapFuel : Nat} + {arguments : Array RVal} {resume : Frame} {stack : List Continuation} + {function : RVal} {target : Machine} + (classified : ApplyTransferCase context interpretation store heapFuel + arguments resume stack function target) : EmptySlotsPreserved store target.store := by + cases classified with + | erased released => exact releaseSharedWork_preservesEmpty released + | papUnder boxAt shared node capturedUnder retained released totalUnder => + exact (retained.preservesEmpty.trans (releaseSharedWork_preservesEmpty released)).trans + (EmptySlotsPreserved.allocNode _ _ _) + | papFn boxAt shared node capturedUnder retained released totalEnough + declaration papSafe suppliedArity nonempty => + exact retained.preservesEmpty.trans (releaseSharedWork_preservesEmpty released) + | papExtern boxAt shared node capturedUnder retained released totalEnough + declaration suppliedArity remainingEmpty called => + exact retained.preservesEmpty.trans (releaseSharedWork_preservesEmpty released) + +theorem ApplyTransfer.preservesEmpty {context : Context} + {interpretation : Interpretation} {store : Store} {heapFuel : Nat} + {arguments : Array RVal} {resume : Frame} {stack : List Continuation} + {function : RVal} {target : Machine} + (transferred : ApplyTransfer context interpretation store heapFuel function + arguments resume stack target) : EmptySlotsPreserved store target.store := + transferred.classify.preservesEmpty + +end Ix.Compiler.IxIR2.Eval diff --git a/Ix/Compiler/IxIR2/ReservationOwnership.lean b/Ix/Compiler/IxIR2/ReservationOwnership.lean new file mode 100644 index 000000000..e45f8c65b --- /dev/null +++ b/Ix/Compiler/IxIR2/ReservationOwnership.lean @@ -0,0 +1,187 @@ +import Ix.Compiler.IxIR2.ReservationHeap +import Ix.Compiler.IxIR2.CallResources + +/-! +# Linear ownership of physical reservations + +Credit consumption removes exactly one entry from a frame. Edge transfer moves +the complete remaining credit file. Reservations are unique across the active +frame and every continuation, and each names an existing empty heap slot. +-/ + +namespace Ix.Compiler.IxIR2.Eval + +def Credit.reservation? (credit : Credit) : Option Nat := + match credit.presence with + | .present location => location + | .absent => none + +def Frame.liveCredits (frame : Frame) : List Credit := frame.credits.toList.filterMap id + +def Frame.reservations (frame : Frame) : List Nat := + frame.liveCredits.filterMap Credit.reservation? + +def Continuation.reservations : Continuation → List Nat + | .resume frame | .applyMore _ frame => frame.reservations + +def Machine.reservations (machine : Machine) : List Nat := + match machine.control with + | .halted _ => [] + | .running frame stack => frame.reservations ++ stack.flatMap Continuation.reservations + +private theorem filterMap_set_none_perm {α : Type} {slots : List (Option α)} + {index : Nat} {value : α} (found : slots[index]? = some (some value)) : + (slots.filterMap id).Perm (value :: (slots.set index none).filterMap id) := by + induction slots generalizing index with + | nil => simp at found + | cons head tail ih => + cases index with + | zero => + simp only [List.getElem?_cons_zero, Option.some.injEq] at found + subst head + simp + | succ index => + simp only [List.getElem?_cons_succ] at found + cases head with + | none => simpa using ih found + | some head => + simpa using ((ih found).cons head).trans (List.Perm.swap _ _ _) + +theorem CreditTake.liveCredits {frame target : Frame} {index : Nat} {credit : Credit} + (taken : CreditTake frame index target credit) : + frame.liveCredits.Perm (credit :: target.liveCredits) := by + obtain ⟨rfl, found⟩ := taken.target_eq + simpa only [Frame.liveCredits, Array.toList_setIfInBounds] using + filterMap_set_none_perm (slots := frame.credits.toList) (by simpa using found) + +theorem CreditTake.reservations {frame target : Frame} {index : Nat} {credit : Credit} + (taken : CreditTake frame index target credit) : + frame.reservations.Perm (credit.reservation?.toList ++ target.reservations) := by + cases present : credit.reservation? <;> + simpa [Frame.reservations, List.filterMap_cons, present] using + taken.liveCredits.filterMap Credit.reservation? + +theorem CreditTakeSequence.liveCredits {frame target : Frame} {indices : List Nat} + {credits : List Credit} (taken : CreditTakeSequence frame indices target credits) : + frame.liveCredits.Perm (credits ++ target.liveCredits) := by + induction taken with + | nil => exact .refl _ + | cons head tail ih => exact head.liveCredits.trans (ih.cons _) + +theorem CreditTakeMany.liveCredits {frame target : Frame} {indices : Array Nat} + {credits : Array Credit} (taken : CreditTakeMany frame indices target credits) : + frame.liveCredits.Perm (credits.toList ++ target.liveCredits) := + taken.sequence.liveCredits + +theorem NoLiveCredits.liveCredits_nil {frame : Frame} (cleared : NoLiveCredits frame) : + frame.liveCredits = [] := by + apply List.filterMap_eq_nil_iff.mpr + intro credit member + have absent := Array.any_eq_false'.mp cleared credit (by simpa using member) + cases credit <;> simp_all + +theorem NoLiveCredits.reservations_nil {frame : Frame} (cleared : NoLiveCredits frame) : + frame.reservations = [] := by + simp [Frame.reservations, cleared.liveCredits_nil] + +theorem EdgeTransfer.liveCredits {frame target : Frame} {edge : Edge} + {implicitValues : Array RVal} (transferred : EdgeTransfer frame edge implicitValues target) : + frame.liveCredits.Perm target.liveCredits := by + obtain ⟨values, credits, after, block, _, taken, cleared, _, _, _, rfl⟩ := transferred.parts + have permuted := taken.liveCredits + rw [cleared.liveCredits_nil, List.append_nil] at permuted + simpa [Frame.liveCredits] using permuted + +theorem EdgeTransfer.reservations {frame target : Frame} {edge : Edge} + {implicitValues : Array RVal} (transferred : EdgeTransfer frame edge implicitValues target) : + frame.reservations.Perm target.reservations := + transferred.liveCredits.filterMap Credit.reservation? + +@[simp] theorem Frame.reservations_empty (definition : Function) (block pc : Nat) + (values : Array RVal) : + ({ definition, block, pc, values, credits := #[] } : Frame).reservations = [] := rfl + +@[simp] theorem Frame.reservations_push (frame : Frame) (credit : Credit) : + ({ frame with credits := frame.credits.push (some credit) } : Frame).reservations = + frame.reservations ++ credit.reservation?.toList := by + cases present : credit.reservation? <;> + simp [Frame.reservations, Frame.liveCredits, List.filterMap_append, present] + +structure ReservationsOwned (store : Store) (locations : List Nat) : Prop where + unique : locations.Nodup + empty : ∀ location ∈ locations, store.EmptySlot location + +namespace ReservationsOwned + +theorem nil (store : Store) : ReservationsOwned store [] := ⟨by simp, by simp⟩ + +theorem perm {store : Store} {left right : List Nat} + (owned : ReservationsOwned store left) (permuted : left.Perm right) : + ReservationsOwned store right := + ⟨permuted.nodup_iff.mp owned.unique, + fun location member => owned.empty location (permuted.mem_iff.mpr member)⟩ + +theorem preserve {before after : Store} {locations : List Nat} + (owned : ReservationsOwned before locations) (preserved : EmptySlotsPreserved before after) : + ReservationsOwned after locations := + ⟨owned.unique, fun location member => preserved location (owned.empty location member)⟩ + +theorem congr_nodes {before after : Store} {locations : List Nat} + (owned : ReservationsOwned before locations) + (same : after.heap.nodes = before.heap.nodes) : ReservationsOwned after locations := + owned.preserve (.of_nodes same) + +theorem cons_parts {store : Store} {location : Nat} {locations : List Nat} + (owned : ReservationsOwned store (location :: locations)) : + location ∉ locations ∧ store.EmptySlot location ∧ ReservationsOwned store locations := by + have unique := List.nodup_cons.mp owned.unique + exact ⟨unique.1, owned.empty location (by simp), unique.2, + fun other member => owned.empty other (by simp [member])⟩ + +theorem not_live {store : Store} {locations : List Nat} {location : Nat} + (owned : ReservationsOwned store locations) (member : location ∈ locations) : + store.get? location = none := (owned.empty location member).not_live + +theorem live_not_owned {store : Store} {locations : List Nat} {location : Nat} + {box : IxIR1.NodeBox} (owned : ReservationsOwned store locations) + (live : store.get? location = some box) : location ∉ locations := by + intro member + rw [owned.not_live member] at live + cases live + +theorem reserve {store : Store} {locations : List Nat} {location : Nat} + {box : IxIR1.NodeBox} (owned : ReservationsOwned store locations) + (live : store.get? location = some box) : + ReservationsOwned (store.reserve location) (locations ++ [location]) := by + have fresh := owned.live_not_owned live + refine ⟨?_, ?_⟩ + · rw [List.nodup_append] + refine ⟨owned.unique, by simp, ?_⟩ + intro other member last lastMember same + have lastEq : last = location := by simpa using lastMember + exact fresh ((same.trans lastEq) ▸ member) + · intro other member + simp only [List.mem_append, List.mem_singleton] at member + rcases member with member | rfl + · exact EmptySlotsPreserved.reserve store location other (owned.empty other member) + · exact Store.reserve_empty live + +theorem reuse {store output : Store} {location payload : Nat} {locations : List Nat} + {world : Ixon.Owned} {node : IxIR1.Node} + (owned : ReservationsOwned store (location :: locations)) + (reused : store.reuseReservation location world node payload = .ok output) : + ReservationsOwned output locations := by + obtain ⟨absent, _, rest⟩ := owned.cons_parts + exact ⟨rest.unique, fun other member => Store.reuseReservation_preservesOther reused + (fun same => absent (same ▸ member)) (rest.empty other member)⟩ + +end ReservationsOwned + +def Machine.ReservationOwnership (machine : Machine) : Prop := + ReservationsOwned machine.store machine.reservations + +theorem Machine.ReservationOwnership.callee_exclusion {machine : Machine} {location : Nat} + (owned : machine.ReservationOwnership) (reserved : location ∈ machine.reservations) : + machine.store.get? location = none := owned.not_live reserved + +end Ix.Compiler.IxIR2.Eval diff --git a/Ix/Compiler/IxIR2/ReservationSteps.lean b/Ix/Compiler/IxIR2/ReservationSteps.lean new file mode 100644 index 000000000..553767fe6 --- /dev/null +++ b/Ix/Compiler/IxIR2/ReservationSteps.lean @@ -0,0 +1,230 @@ +import Ix.Compiler.IxIR2.ReservationOwnership + +/-! +# Reservation ownership through actual executions + +Every successful physical step preserves a unique owning credit for each +reserved slot. Calls move those credits into one continuation; returns restore +them, and allocation/discard consumes them. The invariant is derived from an +initial machine, so callers do not supply a callee-exclusion assumption. +-/ + +namespace Ix.Compiler.IxIR2.Eval + +theorem Machine.ReservationOwnership.of_preserved {before after : Machine} + (owned : before.ReservationOwnership) + (preserved : EmptySlotsPreserved before.store after.store) + (credits : before.reservations.Perm after.reservations) : after.ReservationOwnership := + (owned.perm credits).preserve preserved + +theorem ApplyTransferCase.reservations {context : Context} {interpretation : Interpretation} + {store : Store} {heapFuel : Nat} {arguments : Array RVal} + {resume : Frame} {stack : List Continuation} {function : RVal} {target : Machine} + (classified : ApplyTransferCase context interpretation store heapFuel + arguments resume stack function target) : + target.reservations = resume.reservations ++ stack.flatMap Continuation.reservations := by + cases classified with + | erased => rfl + | papUnder => rfl + | papExtern => rfl + | papFn => + simp only [Machine.reservations, Frame.reservations_empty, List.nil_append, + List.flatMap_cons] + split <;> rfl + +theorem ApplyTransfer.reservationOwnership {context : Context} {interpretation : Interpretation} + {store : Store} {heapFuel : Nat} {arguments : Array RVal} + {resume : Frame} {stack : List Continuation} {function : RVal} {target : Machine} + (transferred : ApplyTransfer context interpretation store heapFuel function + arguments resume stack target) + (owned : (Machine.mk store heapFuel (.running resume stack)).ReservationOwnership) : + target.ReservationOwnership := + owned.of_preserved transferred.preservesEmpty (by rw [transferred.classify.reservations]; rfl) + +private theorem takeNoReservation {frame target : Frame} {index : Nat} {credit : Credit} + (taken : CreditTake frame index target credit) (absent : credit.reservation? = none) + (stack : List Continuation) : + (frame.reservations ++ stack.flatMap Continuation.reservations).Perm + (target.reservations ++ stack.flatMap Continuation.reservations) := by + simpa [absent] using taken.reservations.append_right (stack.flatMap Continuation.reservations) + +private theorem takeReservation {store : Store} {frame target : Frame} {index location : Nat} + {credit : Credit} {stack : List Continuation} + (owned : ReservationsOwned store + (frame.reservations ++ stack.flatMap Continuation.reservations)) + (taken : CreditTake frame index target credit) + (present : credit.presence = .present (some location)) : + ReservationsOwned store (location :: + (target.reservations ++ stack.flatMap Continuation.reservations)) := by + apply owned.perm + simpa [Credit.reservation?, present, List.append_assoc] using + taken.reservations.append_right (stack.flatMap Continuation.reservations) + +private theorem reserveAtFrame {store : Store} {frame : Frame} {stack : List Continuation} + {location : Nat} {box : IxIR1.NodeBox} + (owned : ReservationsOwned store + (frame.reservations ++ stack.flatMap Continuation.reservations)) + (found : store.get? location = some box) : + ReservationsOwned (store.reserve location) + ((frame.reservations ++ [location]) ++ stack.flatMap Continuation.reservations) := by + apply (owned.reserve found).perm + simpa only [List.append_assoc] using + (List.perm_append_comm (l₁ := stack.flatMap Continuation.reservations) + (l₂ := [location])).append_left frame.reservations + +theorem InstructionTransferCase.reservationOwnership {context : Context} + {store : Store} {heapFuel : Nat} {frame : Frame} {stack : List Continuation} + {instruction : Instr} {target : Machine} + (classified : InstructionTransferCase context .physical store heapFuel frame + stack instruction target) + (owned : (Machine.mk store heapFuel (.running frame stack)).ReservationOwnership) : + target.ReservationOwnership := by + cases classified with + | move resolved => exact owned + | alloc schemaAt resolved fields => + exact owned.of_preserved (EmptySlotsPreserved.allocNode _ _ _) (.refl _) + | allocWithAbsent schemaAt resolved fields taken layout absent => + exact owned.of_preserved (EmptySlotsPreserved.allocNode _ _ _) + (takeNoReservation taken (by simp [Credit.reservation?, absent]) stack) + | allocWithLogical mode => cases mode + | allocWithPhysical mode schemaAt resolved fields taken layout present reused => + exact (takeReservation (frame := { frame with pc := frame.pc + 1 }) + owned taken present).reuse reused + | discardAbsent taken absent => + exact owned.of_preserved (.refl _) + (takeNoReservation taken (by simp [Credit.reservation?, absent]) stack) + | discardLogical mode => cases mode + | discardPhysical mode taken present released => + exact (takeReservation (frame := { frame with pc := frame.pc + 1 }) + owned taken present).cons_parts.2.2.preserve + (Store.releaseReservation_preservesEmpty released) + | takeUniqueLogical mode => cases mode + | takeUniquePhysical mode schemaAt resolved viewed unitRC => + have reserved := reserveAtFrame owned viewed.parts.1 + simpa [Machine.ReservationOwnership, Machine.reservations, + Frame.reservations, Frame.liveCredits, Credit.reservation?] using reserved + | resetSharedLogicalHot mode => cases mode + | resetSharedPhysicalHot mode schemaAt resolved viewed unitRC => + have reserved := reserveAtFrame owned viewed.parts.1 + have reserved' := reserved.congr_nodes + (after := ((store.tickResetAttempt).reserve _).tickHotReset) rfl + simpa [Machine.ReservationOwnership, Machine.reservations, + Frame.reservations, Frame.liveCredits, Credit.reservation?] using reserved' + | resetSharedCold schemaAt resolved viewed shared retained => + have preserved : EmptySlotsPreserved store _ := + (EmptySlotsPreserved.setBox viewed.parts.1).trans + (retained.preservesEmpty) + exact owned.of_preserved preserved (by + simp [Machine.reservations, Frame.reservations, Frame.liveCredits] + rfl) + | retainShared resolved retained => + exact owned.of_preserved (retainShared_preservesEmpty retained) (.refl _) + | releaseShared resolved released => + exact owned.of_preserved (releaseSharedWork_preservesEmpty released) (.refl _) + | dropUnique resolved dropped => + exact owned.of_preserved (dropUniqueWork_preservesEmpty dropped) (.refl _) + | freeUnique resolved viewed scalarFields => + exact owned.of_preserved (EmptySlotsPreserved.kill _ _) (.refl _) + | fetch resolved boxAt node fieldAt => exact owned + | callFn noCredits resolved declaration arity nonempty => + exact owned.of_preserved (.refl _) (by + simp [Machine.reservations, Frame.reservations, Frame.liveCredits, Continuation.reservations]) + | callSelf noCredits resolved arity nonempty => + exact owned.of_preserved (.refl _) (by + simp [Machine.reservations, Frame.reservations, Frame.liveCredits, Continuation.reservations]) + | pappFn noCredits declaration papSafe resolved under => + exact owned.of_preserved (EmptySlotsPreserved.allocNode _ _ _) (.refl _) + | pappExtern noCredits declaration resolved under => + exact owned.of_preserved (EmptySlotsPreserved.allocNode _ _ _) (.refl _) + | apply noCredits functionResolved argumentsResolved transferred => + exact transferred.reservationOwnership owned + | extern noCredits resolved declaration argumentArity called => exact owned + +theorem TerminatorTransferCase.reservationOwnership {context : Context} + {store : Store} {heapFuel : Nat} {frame : Frame} {stack : List Continuation} + {terminator : Terminator} {target : Machine} + (classified : TerminatorTransferCase context .physical store heapFuel frame + stack terminator target) + (owned : (Machine.mk store heapFuel (.running frame stack)).ReservationOwnership) : + target.ReservationOwnership := by + cases classified with + | jump transferred => + exact owned.of_preserved (.refl _) (transferred.reservations.append_right _) + | switchCtor resolved boxAt node alternativeAt transferred => + exact owned.of_preserved (.refl _) (transferred.reservations.append_right _) + | switchNatZero resolved transferred => + exact owned.of_preserved (.refl _) (transferred.reservations.append_right _) + | switchNatSucc resolved transferred => + exact owned.of_preserved (.refl _) (transferred.reservations.append_right _) + | branchPresent lookedUp present transferred => + exact owned.of_preserved (.refl _) (transferred.reservations.append_right _) + | branchAbsent lookedUp absent transferred => + exact owned.of_preserved (.refl _) (transferred.reservations.append_right _) + | retResume resolved noCredits world => + exact owned.of_preserved (.refl _) (by + simp only [Machine.reservations, noCredits.reservations_nil, + List.nil_append, List.flatMap_cons, Continuation.reservations] + rfl) + | retHalt resolved noCredits world => exact .nil _ + | retApplyMore resolved noCredits world transferred => + apply transferred.reservationOwnership + simpa only [Machine.ReservationOwnership, Machine.reservations, List.flatMap_cons, + Continuation.reservations, noCredits.reservations_nil, List.nil_append] using owned + | tailCallFn noCredits resolved declaration arity nonempty => + exact owned.of_preserved (.refl _) (by + simp [Machine.reservations, noCredits.reservations_nil]) + | tailCallSelf noCredits resolved arity nonempty => + exact owned.of_preserved (.refl _) (by + simp [Machine.reservations, noCredits.reservations_nil]) + +theorem Step.reservationOwnership {context : Context} {before after : Machine} + (stepped : Step context .physical before after) (owned : before.ReservationOwnership) : + after.ReservationOwnership := by + cases stepped.classify with + | halted => exact owned + | instruction blockAt pc instructionAt classified => exact classified.reservationOwnership owned + | terminator blockAt pc terminatorAt classified => exact classified.reservationOwnership owned + +namespace Policy + +theorem suspendCall_reservations {context : Context} {before after : Machine} + {frame : Frame} {stack : List Continuation} {call : DirectCall} + (running : before.control = .running frame stack) + (called : suspendCall context before frame stack call = .ok after) : + after.reservations = before.reservations := by + obtain ⟨values, definition, _, _, _, _, rfl⟩ := suspendCall_iff.mp called + simp [Machine.reservations, running, Frame.reservations, Frame.liveCredits, + Continuation.reservations] + +theorem Step.reservationOwnership {policy : CreditPolicy} {context : Context} + {before after : Machine} (stepped : Step policy context .physical before after) + (owned : before.ReservationOwnership) : after.ReservationOwnership := by + rcases stepped.classify with original | ⟨frame, stack, call, _, running, _, called⟩ + · exact original.reservationOwnership owned + · exact owned.of_preserved (.of_nodes (by rw [(suspendCall_resources running called).1])) + (by rw [suspendCall_reservations running called]) + +theorem Steps.reservationOwnership {policy : CreditPolicy} {context : Context} + {count : Nat} {before after : Machine} + (steps : Steps policy context .physical count before after) + (owned : before.ReservationOwnership) : after.ReservationOwnership := by + induction steps with + | refl => exact owned + | cons running head tail ih => exact ih (head.reservationOwnership owned) + +theorem initialMachine_reservationOwnership (definition : Function) + (arguments : Array RVal) (heapFuel : Nat) (store : Store := {}) : + (initialMachine definition arguments heapFuel store).ReservationOwnership := .nil _ + +/-- Every reservation in every actual execution prefix has exactly one owning +credit and is excluded from the live heap, even through nested calls. -/ +theorem runMain_prefix_reservationOwnership {policy : CreditPolicy} {context : Context} + {program : Program} {heapFuel count : Nat} {middle : Machine} + (prefixSteps : Steps policy context .physical count + (initialMachine program.main #[] heapFuel) middle) : + middle.ReservationOwnership := + prefixSteps.reservationOwnership (initialMachine_reservationOwnership ..) + +end Policy + +end Ix.Compiler.IxIR2.Eval diff --git a/Ix/Compiler/IxIR2/Resources.lean b/Ix/Compiler/IxIR2/Resources.lean new file mode 100644 index 000000000..2cba948ac --- /dev/null +++ b/Ix/Compiler/IxIR2/Resources.lean @@ -0,0 +1,286 @@ +import Ix.Compiler.IxIR2.HeapAccounting + +/-! +# Resource accounting for actual physical executions + +Every allocated slot is either live, freed, or represented by a present credit +in the current frame or its continuations. Successful physical steps preserve +this balance. A successful main execution therefore has no outstanding +allocation beyond its live heap; reclamation reduces that heap to zero. +-/ + +namespace Ix.Compiler.IxIR2.Eval + +open Ix.Compiler.Ixon (Owned) +open Ix.Compiler.IxIR1 (Node NodeBox RVal) + +/-- Allocation accounting includes reservations held anywhere in the machine. -/ +def Machine.AllocationAccounting (machine : Machine) : Prop := + machine.store.live + machine.store.heap.frees + machine.presentCredits = + machine.store.heap.allocs + +theorem Machine.AllocationAccounting.of_heapBalance {before after : Machine} + (accounted : before.AllocationAccounting) + (balanced : HeapBalance before.store after.store) + (credits : after.presentCredits = before.presentCredits) : + after.AllocationAccounting := by + unfold Machine.AllocationAccounting at * + unfold HeapBalance at balanced + omega + +theorem ApplyTransferCase.allocationAccounting {context : Context} + {interpretation : Interpretation} {store : Store} {heapFuel : Nat} + {arguments : Array RVal} {resume : Frame} {stack : List Continuation} + {function : RVal} {target : Machine} + (classified : ApplyTransferCase context interpretation store heapFuel + arguments resume stack function target) + (accounted : (Machine.mk store heapFuel (.running resume stack)).AllocationAccounting) : + target.AllocationAccounting := by + cases classified with + | erased released => + exact accounted.of_heapBalance (releaseSharedWork_heapBalance released) rfl + | papUnder boxAt shared node capturedUnder retained released totalUnder => + exact accounted.of_heapBalance + ((retained.heapBalance.trans (releaseSharedWork_heapBalance released)).trans + (.allocNode ..)) rfl + | papFn boxAt shared node capturedUnder retained released totalEnough + declaration papSafe suppliedArity nonempty => + refine accounted.of_heapBalance ?_ ?_ + · exact retained.heapBalance.trans (releaseSharedWork_heapBalance released) + simp only [Machine.presentCredits_running, List.map_cons, List.sum_cons, + Frame.presentCredits, creditPresentCount_empty, Nat.zero_add] + split <;> rfl + | papExtern boxAt shared node capturedUnder retained released totalEnough + declaration suppliedArity remainingEmpty called => + exact accounted.of_heapBalance + (retained.heapBalance.trans (releaseSharedWork_heapBalance released)) rfl + +theorem ApplyTransfer.allocationAccounting {context : Context} + {interpretation : Interpretation} {store : Store} {heapFuel : Nat} + {arguments : Array RVal} {resume : Frame} {stack : List Continuation} + {function : RVal} {target : Machine} + (transferred : ApplyTransfer context interpretation store heapFuel function + arguments resume stack target) + (accounted : (Machine.mk store heapFuel (.running resume stack)).AllocationAccounting) : + target.AllocationAccounting := transferred.classify.allocationAccounting accounted + +theorem InstructionTransferCase.allocationAccounting {context : Context} + {store : Store} {heapFuel : Nat} {frame : Frame} {stack : List Continuation} + {instruction : Instr} {target : Machine} + (classified : InstructionTransferCase context .physical store heapFuel frame + stack instruction target) + (accounted : (Machine.mk store heapFuel (.running frame stack)).AllocationAccounting) : + target.AllocationAccounting := by + cases classified with + | move resolved => exact accounted + | alloc schemaAt resolved fields => + exact accounted.of_heapBalance (.allocNode ..) rfl + | allocWithAbsent schemaAt resolved fields taken layout absent => + refine accounted.of_heapBalance ?_ ?_ + · exact .allocNode .. + have count := taken.presentCredits + simpa [Machine.presentCredits_running, Frame.presentCredits, + Credit.weight_absent absent] using + congrArg (· + (stack.map Continuation.presentCredits).sum) count + | allocWithLogical mode => cases mode + | allocWithPhysical mode schemaAt resolved fields taken layout present reused => + have count := taken.presentCredits + have heap := Store.reuseReservation_accounting reused + simp only [Frame.presentCredits, Credit.weight_present present] at count + simp only [Machine.AllocationAccounting, Machine.presentCredits_running, + Frame.presentCredits] at accounted ⊢ + omega + | discardAbsent taken absent => + refine accounted.of_heapBalance ?_ ?_ + · exact .refl _ + have count := taken.presentCredits + simpa [Machine.presentCredits_running, Frame.presentCredits, + Credit.weight_absent absent] using + congrArg (· + (stack.map Continuation.presentCredits).sum) count + | discardLogical mode => cases mode + | discardPhysical mode taken present released => + have count := taken.presentCredits + have heap := Store.releaseReservation_accounting released + simp only [Frame.presentCredits, Credit.weight_present present] at count + simp only [Machine.AllocationAccounting, Machine.presentCredits_running, + Frame.presentCredits] at accounted ⊢ + omega + | takeUniqueLogical mode => cases mode + | takeUniquePhysical mode schemaAt resolved viewed unitRC => + have live := Store.live_reserve viewed.parts.1 + simp only [Machine.AllocationAccounting, Machine.presentCredits_running, + Frame.presentCredits, creditPresentCount_push, Credit.weight, + Credit.isPresent] at accounted ⊢ + change _ + _ + (_ + (if true then 1 else 0) + _) = _ + simp only [↓reduceIte] + change _ + store.heap.frees + _ = store.heap.allocs + omega + | resetSharedLogicalHot mode => cases mode + | resetSharedPhysicalHot mode schemaAt resolved viewed unitRC => + have live := Store.live_reserve viewed.parts.1 + simp only [Machine.AllocationAccounting, Machine.presentCredits_running, + Frame.presentCredits, creditPresentCount_push, Credit.weight, + Credit.isPresent] at accounted ⊢ + change (store.reserve _).live + store.heap.frees + + (creditPresentCount frame.credits + 1 + _) = store.heap.allocs + omega + | @resetSharedCold target cid schema location box fields outStore + schemaAt resolved viewed shared retained => + have updated := HeapBalance.setBox (new := { box with rc := box.rc - 1 }) viewed.parts.1 + have balanced : HeapBalance store outStore := updated.trans retained.heapBalance + refine accounted.of_heapBalance ?_ ?_ + · exact balanced + simp [Machine.presentCredits_running, Frame.presentCredits, + Credit.weight, Credit.isPresent] + | retainShared resolved retained => + exact accounted.of_heapBalance (retainShared_heapBalance retained) rfl + | releaseShared resolved released => + exact accounted.of_heapBalance (releaseShared_heapBalance released) rfl + | dropUnique resolved dropped => + exact accounted.of_heapBalance (dropUnique_heapBalance dropped) rfl + | freeUnique resolved viewed scalarFields => + exact accounted.of_heapBalance (.kill viewed.parts.1) rfl + | fetch resolved boxAt node fieldAt => exact accounted + | callFn noCredits resolved declaration arity nonempty => + refine accounted.of_heapBalance ?_ ?_ + · exact .refl _ + simp [Machine.presentCredits_running, Frame.presentCredits, + Continuation.presentCredits] + | callSelf noCredits resolved arity nonempty => + refine accounted.of_heapBalance ?_ ?_ + · exact .refl _ + simp [Machine.presentCredits_running, Frame.presentCredits, + Continuation.presentCredits] + | pappFn noCredits declaration papSafe resolved under => + exact accounted.of_heapBalance (.allocNode ..) rfl + | pappExtern noCredits declaration resolved under => + exact accounted.of_heapBalance (.allocNode ..) rfl + | apply noCredits functionResolved argumentsResolved transferred => + exact transferred.allocationAccounting accounted + | extern noCredits resolved declaration argumentArity called => exact accounted + +theorem TerminatorTransferCase.allocationAccounting {context : Context} + {store : Store} {heapFuel : Nat} {frame : Frame} {stack : List Continuation} + {terminator : Terminator} {target : Machine} + (classified : TerminatorTransferCase context .physical store heapFuel frame + stack terminator target) + (accounted : (Machine.mk store heapFuel (.running frame stack)).AllocationAccounting) : + target.AllocationAccounting := by + cases classified with + | jump transferred => + refine accounted.of_heapBalance ?_ ?_ + · exact .refl _ + simp only [Machine.presentCredits_running, transferred.presentCredits] + | switchCtor resolved boxAt node alternativeAt transferred => + refine accounted.of_heapBalance ?_ ?_ + · exact .refl _ + simp only [Machine.presentCredits_running, transferred.presentCredits] + | switchNatZero resolved transferred => + refine accounted.of_heapBalance ?_ ?_ + · exact .refl _ + simp only [Machine.presentCredits_running, transferred.presentCredits] + | switchNatSucc resolved transferred => + refine accounted.of_heapBalance ?_ ?_ + · exact .refl _ + simp only [Machine.presentCredits_running, transferred.presentCredits] + | branchPresent lookedUp present transferred => + refine accounted.of_heapBalance ?_ ?_ + · exact .refl _ + simp only [Machine.presentCredits_running, transferred.presentCredits] + | branchAbsent lookedUp absent transferred => + refine accounted.of_heapBalance ?_ ?_ + · exact .refl _ + simp only [Machine.presentCredits_running, transferred.presentCredits] + | retResume resolved noCredits world => + refine accounted.of_heapBalance ?_ ?_ + · exact .refl _ + have cleared := noCredits.presentCredits + change creditPresentCount frame.credits = 0 at cleared + simp [Machine.presentCredits_running, Frame.presentCredits, + Continuation.presentCredits, cleared] + | retHalt resolved noCredits world => + refine accounted.of_heapBalance ?_ ?_ + · exact .refl _ + change 0 = frame.presentCredits + 0 + rw [noCredits.presentCredits] + | retApplyMore resolved noCredits world transferred => + apply transferred.allocationAccounting + simpa only [Machine.AllocationAccounting, Machine.presentCredits_running, + List.map_cons, List.sum_cons, Continuation.presentCredits, + noCredits.presentCredits, Nat.zero_add] using accounted + | tailCallFn noCredits resolved declaration arity nonempty => + refine accounted.of_heapBalance ?_ ?_ + · exact .refl _ + have cleared := noCredits.presentCredits + change creditPresentCount frame.credits = 0 at cleared + simp [Machine.presentCredits_running, Frame.presentCredits, cleared] + | tailCallSelf noCredits resolved arity nonempty => + refine accounted.of_heapBalance ?_ ?_ + · exact .refl _ + have cleared := noCredits.presentCredits + change creditPresentCount frame.credits = 0 at cleared + simp [Machine.presentCredits_running, Frame.presentCredits, cleared] + +/-- Every actual successful physical step preserves allocation accounting. -/ +theorem Step.allocationAccounting {context : Context} {before after : Machine} + (stepped : Step context .physical before after) + (accounted : before.AllocationAccounting) : after.AllocationAccounting := by + cases stepped.classify with + | halted => exact accounted + | instruction blockAt pc instructionAt classified => + exact classified.allocationAccounting accounted + | terminator blockAt pc terminatorAt classified => + exact classified.allocationAccounting accounted + +theorem Steps.allocationAccounting {context : Context} {count : Nat} + {before after : Machine} (steps : Steps context .physical count before after) + (accounted : before.AllocationAccounting) : after.AllocationAccounting := by + induction steps with + | refl => exact accounted + | cons running head tail ih => exact ih (head.allocationAccounting accounted) + +/-- A successful physical runner has accounted for every reservation at halt. -/ +theorem runMachine_allocationAccounting {context : Context} {controlFuel : Nat} + {machine : Machine} {result : Result} + (run : runMachine context .physical controlFuel machine = .ok result) + (accounted : machine.AllocationAccounting) : + result.store.live + result.store.heap.frees = result.store.heap.allocs := by + obtain ⟨count, budget, steps⟩ := runMachine_steps run + simpa [Machine.AllocationAccounting, Machine.presentCredits] using + steps.allocationAccounting accounted + +theorem initialMachine_allocationAccounting (definition : Function) + (arguments : Array RVal) (heapFuel : Nat) : + (initialMachine definition arguments heapFuel).AllocationAccounting := rfl + +/-- The successful physical main has no outstanding allocation beyond its live +nodes. The entry facts are checked by the evaluator and also certified by the +compiler attachment. -/ +theorem runMain_allocationAccounting {context : Context} {program : Program} + {controlFuel heapFuel : Nat} {result : Result} + (arity : program.main.signature.params.size = 0) + (nonempty : program.main.blocks.isEmpty = false) + (run : runMain context .physical program controlFuel heapFuel = .ok result) : + result.store.live + result.store.heap.frees = result.store.heap.allocs := by + rw [runMain_eq_runMachine arity nonempty] at run + exact runMachine_allocationAccounting run (initialMachine_allocationAccounting ..) + +/-- Terminal resource contract for a shared result: the main has no unaccounted +reservation, and releasing its returned root empties the heap and balances all +fresh allocations with frees. Release fuel is independent of execution fuel. -/ +def Result.SharedResources (result : Result) : Prop := + result.store.live + result.store.heap.frees = result.store.heap.allocs ∧ + ∃ releaseFuel released remaining, + releaseShared releaseFuel result.store result.value = .ok (released, remaining) ∧ + released.live = 0 ∧ released.heap.allocs = released.heap.frees + +theorem Result.sharedResources_of_release {result : Result} + (accounted : result.store.live + result.store.heap.frees = result.store.heap.allocs) + {releaseFuel remaining : Nat} {released : Store} + (release : releaseShared releaseFuel result.store result.value = .ok (released, remaining)) + (empty : released.live = 0) : result.SharedResources := by + have balance := releaseShared_heapBalance release + unfold HeapBalance at balance + exact ⟨accounted, releaseFuel, released, remaining, release, empty, by omega⟩ + +end Ix.Compiler.IxIR2.Eval diff --git a/Ix/Compiler/IxIR2/Reuse.lean b/Ix/Compiler/IxIR2/Reuse.lean new file mode 100644 index 000000000..04f930223 --- /dev/null +++ b/Ix/Compiler/IxIR2/Reuse.lean @@ -0,0 +1,1747 @@ +import Ix.Compiler.IxIR2.EvalCounter +import Ix.Compiler.IxIR2.Liveness + +/-! +# Checked dynamic shared reuse insertion + +The optimizer recognizes the compiler-emitted consuming-case prefix produced +by `IxIR1.Lower.lowerRecursor`: every shared field is fetched and retained, +the shared parent is released at its checked last use, a compatible cell is +allocated, and the function tail-calls itself. Constructor arity, source +parameter position, allocation argument order, and tail argument order are +recovered from the block rather than fixed to the first reversal benchmark. + +The rewrite fuses those heap operations into `resetShared`, splits the +optional credit with `branchCredit`, and consumes the credit with `allocWith` +on both hot and cold paths. Existing blocks retain their IDs; the two credit +blocks are appended, so unrelated CFG edges need no renumbering. Both the +input and output cross the ordinary bounded IxIR₂ validator. The executable +traversal also retains a typed decision trace: every source block records the +exact shape, liveness, representation, and operand-mapping decision that +justified its rewrite or left it unchanged. That trace is the proof-facing +input to block/function/program simulation; this module does not yet claim +the completed semantic lifting theorem. +-/ + +namespace Ix.Compiler.IxIR2.Reuse + +open Ix.Compiler.Ixon (Owned) +open Ix.Compiler.IxIR2 + +/-- Stable counters for the deliberately narrow first insertion pass. -/ +structure Report where + scannedBlocks : Nat := 0 + shapeCandidates : Nat := 0 + livenessRejected : Nat := 0 + rewritten : Nat := 0 + incompatibleLayouts : Nat := 0 + unmappableOperands : Nat := 0 + helperBlocks : Nat := 0 + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +def Report.add (left right : Report) : Report := + { scannedBlocks := left.scannedBlocks + right.scannedBlocks + shapeCandidates := left.shapeCandidates + right.shapeCandidates + livenessRejected := left.livenessRejected + right.livenessRejected + rewritten := left.rewritten + right.rewritten + incompatibleLayouts := + left.incompatibleLayouts + right.incompatibleLayouts + unmappableOperands := left.unmappableOperands + right.unmappableOperands + helperBlocks := left.helperBlocks + right.helperBlocks } + +/-- A proof-carrying candidate position. Coverage is checked independently +of inference, and exactness at the proposed position supplies the local fact +needed before moving a consuming reset there. -/ +structure Placement (block : Block) where + value : ValueId + position : Nat + liveness : Liveness.CheckedBlock block + exact : liveness.summary.lastUse? value = some position + +namespace Placement + +theorem noUseAfter {block : Block} (placement : Placement block) : + ∀ index, (bound : index < (Liveness.blockUses block).size) → + (Liveness.blockUses block)[index].value = placement.value → + (Liveness.blockUses block)[index].position ≤ placement.position := + placement.liveness.no_use_after placement.exact + +end Placement + +/-- Infer a local solution, check it under the caller's resource policy, and +retain a placement only when the requested position is the exact last use. -/ +def inferPlacementWith (limits : Validate.Limits) (block : Block) + (value : ValueId) (position : Nat) : + Except Liveness.Error (Option (Placement block)) := + match Liveness.inferCheckedWith limits block with + | .error error => .error error + | .ok liveness => + if exact : liveness.summary.lastUse? value = some position then + .ok (some { value, position, liveness, exact }) + else + .ok none + +def inferPlacement (block : Block) (value : ValueId) (position : Nat) : + Except Liveness.Error (Option (Placement block)) := + inferPlacementWith Validate.defaultLimits block value position + +/-- A successful liveness placement retains the exact requested register and +instruction position. -/ +theorem inferPlacementWith_sound {limits : Validate.Limits} {block : Block} + {value position : Nat} {placement : Placement block} + (found : inferPlacementWith limits block value position = + .ok (some placement)) : + placement.value = value ∧ placement.position = position := by + unfold inferPlacementWith at found + split at found + · cases found + · split at found + · simp only [Except.ok.injEq, Option.some.injEq] at found + subst placement + exact ⟨rfl, rfl⟩ + · cases found + +/-- Information recovered from a general compiler-emitted consuming-case +prefix before consulting the representation schema. -/ +structure Shape where + parameterCount : Nat + source : ValueId + sourceConstructor : CtorId + fieldCount : Nat + releasePosition : Nat + allocationConstructor : CtorId + allocationArguments : Array Atom + tailArguments : Array Atom + +/-- Recognize the complete generic prefix +`fetchⁿ; retainSharedⁿ; releaseShared; alloc; tailCallSelf`. Result register +numbers follow directly from IxIR₂'s append-only block register discipline. -/ +def reuseShape? (block : Block) : Option Shape := + let instructionCount := block.instructions.size + if instructionCount < 4 then + none + else + let fieldCount := (instructionCount - 2) / 2 + let parameterCount := block.valueParams.size + match block.instructions[0]? with + | some (Instr.fetch (Atom.reg source) sourceConstructor 0) => + let fetchesMatch := (List.range fieldCount).all fun field => + block.instructions[field]? == + some (.fetch (.reg source) sourceConstructor field) + let retainsMatch := (List.range fieldCount).all fun field => + block.instructions[fieldCount + field]? == + some (.retainShared (.reg (parameterCount + field))) + if fieldCount == 0 || instructionCount != 2 * fieldCount + 2 || + source ≥ parameterCount || + block.valueParams[source]? != some (.owned .shared) || + !block.creditParams.isEmpty || !fetchesMatch || !retainsMatch then + none + else + match block.instructions[2 * fieldCount]?, + block.instructions[2 * fieldCount + 1]?, block.terminator with + | some (.releaseShared (.reg released)), + some (.alloc .shared allocationConstructor allocationArguments), + .tailCallSelf tailArguments => + if released == source then + some { + parameterCount + source + sourceConstructor + fieldCount + releasePosition := 2 * fieldCount + allocationConstructor + allocationArguments + tailArguments } + else + none + | _, _, _ => none + | _ => none + +namespace Shape + +/-- Exact baseline syntax certified by a successful generic-prefix match. -/ +structure Fits (block : Block) (shape : Shape) : Prop where + instructionCountAtLeastFour : 4 ≤ block.instructions.size + fieldCountPositive : 0 < shape.fieldCount + instructionCount : + block.instructions.size = 2 * shape.fieldCount + 2 + parameterCount : shape.parameterCount = block.valueParams.size + sourceBound : shape.source < shape.parameterCount + sourceOwned : + block.valueParams[shape.source]? = some (.owned .shared) + noCredits : block.creditParams = #[] + fetches : ∀ field, field < shape.fieldCount → + block.instructions[field]? = some + (.fetch (.reg shape.source) shape.sourceConstructor field) + retains : ∀ field, field < shape.fieldCount → + block.instructions[shape.fieldCount + field]? = some + (.retainShared (.reg (shape.parameterCount + field))) + release : block.instructions[shape.releasePosition]? = + some (.releaseShared (.reg shape.source)) + releasePosition : shape.releasePosition = 2 * shape.fieldCount + allocation : block.instructions[shape.releasePosition + 1]? = + some (.alloc .shared shape.allocationConstructor + shape.allocationArguments) + terminator : block.terminator = .tailCallSelf shape.tailArguments + +end Shape + +/-- Invert the executable recognizer into its exact generalized baseline +prefix. This is the structural induction interface used by block simulation. -/ +theorem reuseShape?_sound {block : Block} {shape : Shape} + (found : reuseShape? block = some shape) : Shape.Fits block shape := by + unfold reuseShape? at found + split at found + · simp at found + · rcases found with ⟨minSize, checks, final⟩ + split at final + · split at final + · simp only [Option.some.injEq] at final + rename_i _ source sourceConstructor firstAt _ _ _ released + allocationConstructor allocationArguments tailArguments + releaseAt allocationAt terminatorAt releaseEq + subst shape + rcases checks with + ⟨⟨⟨⟨⟨⟨two, instructionCount⟩, sourceBound⟩, sourceOwned⟩, + noCredits⟩, fetches⟩, retains⟩ + constructor + · exact minSize + · exact Nat.div_pos two (by omega) + · exact instructionCount + · rfl + · exact sourceBound + · exact sourceOwned + · exact noCredits + · exact fetches + · exact retains + · dsimp + rw [← releaseEq] + exact releaseAt + · rfl + · dsimp + exact allocationAt + · dsimp + exact terminatorAt + · simp at final + · simp at final + · simp at found + +structure Representation where + layout : LayoutId + +/-- Exact-layout eligibility. Layout identity alone is not allowed to hide +an inconsistent schema table: source and target field worlds must also agree, +and this dynamic lane currently consumes compiler-emitted shared retains. -/ +def representation? (context : Validate.Context) (shape : Shape) : + Option Representation := do + let sourceSchema ← context.schemas .shared shape.sourceConstructor + let allocationSchema ← context.schemas .shared shape.allocationConstructor + let expectedFields := Array.replicate shape.fieldCount .shared + if sourceSchema.fields == expectedFields && + allocationSchema.fields == sourceSchema.fields && + sourceSchema.layout == allocationSchema.layout then + some { layout := sourceSchema.layout } + else + none + +/-- Invert an accepted representation decision into the two exact schema +lookups and all three compatibility equations used by reset/allocation +simulation. -/ +theorem representation?_sound {context : Validate.Context} {shape : Shape} + {representation : Representation} + (found : representation? context shape = some representation) : + ∃ sourceSchema allocationSchema, + context.schemas .shared shape.sourceConstructor = some sourceSchema ∧ + context.schemas .shared shape.allocationConstructor = + some allocationSchema ∧ + sourceSchema.fields = Array.replicate shape.fieldCount .shared ∧ + allocationSchema.fields = sourceSchema.fields ∧ + sourceSchema.layout = allocationSchema.layout ∧ + representation.layout = sourceSchema.layout := by + unfold representation? at found + cases sourceAt : context.schemas .shared shape.sourceConstructor with + | none => simp [sourceAt] at found + | some sourceSchema => + cases allocationAt : + context.schemas .shared shape.allocationConstructor with + | none => simp [sourceAt, allocationAt] at found + | some allocationSchema => + refine ⟨sourceSchema, allocationSchema, rfl, rfl, ?_⟩ + simp [sourceAt, allocationAt] at found + rcases found with + ⟨⟨⟨sourceFields, allocationFields⟩, layouts⟩, + representationEq⟩ + subst representation + exact ⟨sourceFields, allocationFields, layouts, rfl⟩ + +def translateRegister? (shape : Shape) (value : ValueId) : + Option ValueId := + if value < shape.parameterCount then + if value == shape.source then + none + else if value < shape.source then + some (shape.fieldCount + value) + else + some (shape.fieldCount + (value - 1)) + else if value < shape.parameterCount + shape.fieldCount then + none + else if value < shape.parameterCount + 2 * shape.fieldCount then + some (value - (shape.parameterCount + shape.fieldCount)) + else if value == shape.parameterCount + 2 * shape.fieldCount then + some (shape.fieldCount + (shape.parameterCount - 1)) + else + none + +def translateAtom? (shape : Shape) : Atom → Option Atom + | .reg value => (translateRegister? shape value).map .reg + | .lit literal => some (.lit literal) + | .erased => some .erased + +def translateAtoms? (shape : Shape) (values : Array Atom) : + Option (Array Atom) := + (values.toList.mapM (translateAtom? shape)).map List.toArray + +def branchValues (shape : Shape) : Array Atom := + let fields := (List.range shape.fieldCount).map fun field => + .reg (shape.parameterCount + field) + let parameters := ((List.range shape.parameterCount).filter fun value => + value != shape.source).map fun value => .reg value + (fields ++ parameters).toArray + +structure Candidate (block : Block) where + placement : Placement block + sourceConstructor : CtorId + allocationConstructor : CtorId + layout : LayoutId + helperValueParams : Array ValueCap + resetValues : Array Atom + allocationArguments : Array Atom + tailArguments : Array Atom + +def candidate? (block : Block) (shape : Shape) + (representation : Representation) (placement : Placement block) : + Option (Candidate block) := do + let allocationArguments ← + translateAtoms? shape shape.allocationArguments + let tailArguments ← translateAtoms? shape shape.tailArguments + let helperValueParams := + Array.replicate shape.fieldCount (.owned .shared) ++ + (block.valueParams.toList.eraseIdx shape.source).toArray + some { + placement + sourceConstructor := shape.sourceConstructor + allocationConstructor := shape.allocationConstructor + layout := representation.layout + helperValueParams + resetValues := branchValues shape + allocationArguments + tailArguments } + +/-- Invert successful operand translation once, exposing the exact helper +operands and every structural field copied into the accepted candidate. -/ +theorem candidate?_sound {block : Block} {shape : Shape} + {representation : Representation} {placement : Placement block} + {candidate : Candidate block} + (found : candidate? block shape representation placement = + some candidate) : + translateAtoms? shape shape.allocationArguments = + some candidate.allocationArguments ∧ + translateAtoms? shape shape.tailArguments = + some candidate.tailArguments ∧ + candidate.placement = placement ∧ + candidate.sourceConstructor = shape.sourceConstructor ∧ + candidate.allocationConstructor = shape.allocationConstructor ∧ + candidate.layout = representation.layout ∧ + candidate.helperValueParams = + Array.replicate shape.fieldCount (.owned .shared) ++ + (block.valueParams.toList.eraseIdx shape.source).toArray ∧ + candidate.resetValues = branchValues shape := by + unfold candidate? at found + cases allocationAt : translateAtoms? shape shape.allocationArguments with + | none => simp [allocationAt] at found + | some allocationArguments => + cases tailAt : translateAtoms? shape shape.tailArguments with + | none => simp [allocationAt, tailAt] at found + | some tailArguments => + simp [allocationAt, tailAt] at found + subst candidate + exact ⟨rfl, rfl, rfl, rfl, rfl, rfl, rfl, rfl⟩ + +def creditBlock {block : Block} (candidate : Candidate block) + (credit : CreditCap) : Block := + { valueParams := candidate.helperValueParams + creditParams := #[credit] + instructions := #[ + .allocWith 0 .shared candidate.allocationConstructor + candidate.allocationArguments] + terminator := .tailCallSelf candidate.tailArguments } + +def resetBlock {block : Block} (candidate : Candidate block) + (hot cold : BlockId) : Block := + { valueParams := block.valueParams + creditParams := #[] + instructions := #[.resetShared (.reg candidate.placement.value) + candidate.sourceConstructor] + terminator := .branchCredit 0 + { target := hot + values := candidate.resetValues + credits := #[0] } + { target := cold + values := candidate.resetValues + credits := #[0] } } + +/-- Every premise used to accept one block rewrite, retained at the exact +source block. Proof consumers can recover the recognized baseline syntax, +the checked last-use placement, exact layout compatibility, and the translated +operand vectors without rerunning or inverting the optimizer. -/ +structure Site (limits : Validate.Limits) (context : Validate.Context) + (block : Block) where + shape : Shape + shapeFound : reuseShape? block = some shape + placement : Placement block + placementFound : inferPlacementWith limits block shape.source + shape.releasePosition = .ok (some placement) + representation : Representation + representationFound : representation? context shape = some representation + candidate : Candidate block + candidateFound : candidate? block shape representation placement = + some candidate + +namespace Site + +/-- The exact generalized baseline prefix retained by an accepted site. -/ +theorem fits {limits : Validate.Limits} {context : Validate.Context} + {block : Block} (site : Site limits context block) : + Shape.Fits block site.shape := + reuseShape?_sound site.shapeFound + +/-- The liveness witness is attached to the recognized source register at its +exact baseline release instruction. -/ +theorem placementCoordinates {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (site : Site limits context block) : + site.placement.value = site.shape.source ∧ + site.placement.position = site.shape.releasePosition := + inferPlacementWith_sound site.placementFound + +/-- No use of the recognized source occurs after the release position selected +by the accepted site. -/ +theorem noUseAfter {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (site : Site limits context block) : + ∀ index, (bound : index < (Liveness.blockUses block).size) → + (Liveness.blockUses block)[index].value = site.shape.source → + (Liveness.blockUses block)[index].position ≤ + site.shape.releasePosition := by + intro index bound sourceUse + have checked := site.placement.noUseAfter index bound + rw [site.placementCoordinates.1, site.placementCoordinates.2] at checked + exact checked sourceUse + +/-- Every instruction in an accepted source block belongs to its recognized +fetch/retain/release/allocation prefix. This inversion is useful outside the +local macro proof, where a suspended caller's call instruction rules out that +its block was accepted by the reuse pass. -/ +theorem instructionCases {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (site : Site limits context block) {position : Nat} {instruction : Instr} + (found : block.instructions[position]? = some instruction) : + (∃ field, field < site.shape.fieldCount ∧ + instruction = .fetch (.reg site.shape.source) + site.shape.sourceConstructor field) ∨ + (∃ field, field < site.shape.fieldCount ∧ + instruction = .retainShared + (.reg (site.shape.parameterCount + field))) ∨ + instruction = .releaseShared (.reg site.shape.source) ∨ + instruction = .alloc .shared site.shape.allocationConstructor + site.shape.allocationArguments := by + have positionBound : position < block.instructions.size := + (Array.getElem?_eq_some_iff.mp found).1 + have positionLimit : position < 2 * site.shape.fieldCount + 2 := by + simpa [site.fits.instructionCount] using positionBound + by_cases fetchRange : position < site.shape.fieldCount + · left + exact ⟨position, fetchRange, + Option.some.inj (found.symm.trans + (site.fits.fetches position fetchRange))⟩ + by_cases retainRange : position < 2 * site.shape.fieldCount + · right + left + let field := position - site.shape.fieldCount + have fieldBound : field < site.shape.fieldCount := by + dsimp [field] + omega + have positionEq : position = site.shape.fieldCount + field := by + dsimp [field] + omega + have retained := site.fits.retains field fieldBound + have found' : block.instructions[site.shape.fieldCount + field]? = + some instruction := by + simpa [positionEq] using found + exact ⟨field, fieldBound, Option.some.inj (found'.symm.trans retained)⟩ + have finalCases : position = 2 * site.shape.fieldCount ∨ + position = 2 * site.shape.fieldCount + 1 := by + omega + cases finalCases with + | inl releasePosition => + right + right + left + have positionEq : position = site.shape.releasePosition := by + rw [site.fits.releasePosition] + exact releasePosition + have found' : block.instructions[site.shape.releasePosition]? = + some instruction := by + simpa [positionEq] using found + exact Option.some.inj (found'.symm.trans site.fits.release) + | inr allocationPosition => + right + right + right + have positionEq : position = site.shape.releasePosition + 1 := by + rw [site.fits.releasePosition] + exact allocationPosition + have found' : block.instructions[site.shape.releasePosition + 1]? = + some instruction := by + simpa [positionEq] using found + exact Option.some.inj (found'.symm.trans site.fits.allocation) + +/-- Accepted source blocks contain no addressed call instruction. -/ +theorem noCall {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (site : Site limits context block) {position : Nat} + {address : Ixon.Address} {arguments : Array Atom} + (found : block.instructions[position]? = some (.call address arguments)) : + False := by + rcases site.instructionCases found with + ⟨field, bound, impossible⟩ | ⟨field, bound, impossible⟩ | + impossible | impossible <;> cases impossible + +/-- Accepted source blocks contain no recursive call instruction. -/ +theorem noCallSelf {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (site : Site limits context block) {position : Nat} + {arguments : Array Atom} + (found : block.instructions[position]? = some (.callSelf arguments)) : + False := by + rcases site.instructionCases found with + ⟨field, bound, impossible⟩ | ⟨field, bound, impossible⟩ | + impossible | impossible <;> cases impossible + +/-- Accepted source blocks contain no dynamic application instruction. -/ +theorem noApply {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (site : Site limits context block) {position : Nat} + {function : Atom} {arguments : Array Atom} + (found : block.instructions[position]? = some (.apply function arguments)) : + False := by + rcases site.instructionCases found with + ⟨field, bound, impossible⟩ | ⟨field, bound, impossible⟩ | + impossible | impossible <;> cases impossible + +/-- Accepted source blocks contain no ordinary move instruction. -/ +theorem noMove {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (site : Site limits context block) {position : Nat} {atom : Atom} + (found : block.instructions[position]? = some (.move atom)) : False := by + rcases site.instructionCases found with + ⟨field, bound, impossible⟩ | ⟨field, bound, impossible⟩ | + impossible | impossible <;> cases impossible + +/-- Accepted source blocks contain no unique-free instruction. -/ +theorem noFreeUnique {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (site : Site limits context block) {position : Nat} {atom : Atom} + {identity : CtorId} + (found : block.instructions[position]? = + some (.freeUnique atom identity)) : False := by + rcases site.instructionCases found with + ⟨field, bound, impossible⟩ | ⟨field, bound, impossible⟩ | + impossible | impossible <;> cases impossible + +/-- Accepted source blocks contain no function-partial-application +instruction. -/ +theorem noPapp {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (site : Site limits context block) {position : Nat} + {address : Ixon.Address} {arguments : Array Atom} + (found : block.instructions[position]? = + some (.papp address arguments)) : False := by + rcases site.instructionCases found with + ⟨field, bound, impossible⟩ | ⟨field, bound, impossible⟩ | + impossible | impossible <;> cases impossible + +/-- Accepted source blocks contain no unique-drop instruction. -/ +theorem noDropUnique {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (site : Site limits context block) {position : Nat} {atom : Atom} + (found : block.instructions[position]? = some (.dropUnique atom)) : + False := by + rcases site.instructionCases found with + ⟨field, bound, impossible⟩ | ⟨field, bound, impossible⟩ | + impossible | impossible <;> cases impossible + +/-- Accepted source blocks contain no unique allocation instruction. -/ +theorem noAllocUnique {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (site : Site limits context block) {position : Nat} {identity : CtorId} + {arguments : Array Atom} + (found : block.instructions[position]? = + some (.alloc .unique identity arguments)) : False := by + rcases site.instructionCases found with + ⟨field, bound, impossible⟩ | ⟨field, bound, impossible⟩ | + impossible | impossible <;> cases impossible + +/-- Core candidate fields are copied exactly from the recognized site; the +reset target additionally agrees with the liveness-checked source register. -/ +theorem candidateCore {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (site : Site limits context block) : + site.candidate.placement.value = site.shape.source ∧ + site.candidate.sourceConstructor = site.shape.sourceConstructor ∧ + site.candidate.allocationConstructor = + site.shape.allocationConstructor ∧ + site.candidate.layout = site.representation.layout := by + rcases candidate?_sound site.candidateFound with + ⟨_, _, placement, sourceConstructor, allocationConstructor, layout, + _, _⟩ + have sourceValue := congrArg (fun selected => selected.value) placement + exact ⟨sourceValue.trans site.placementCoordinates.1, sourceConstructor, + allocationConstructor, layout⟩ + +/-- Helper ABI and branch operands are copied from the recognized shape. -/ +theorem candidateVectors {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (site : Site limits context block) : + site.candidate.helperValueParams = + Array.replicate site.shape.fieldCount (.owned .shared) ++ + (block.valueParams.toList.eraseIdx site.shape.source).toArray ∧ + site.candidate.resetValues = branchValues site.shape := by + rcases candidate?_sound site.candidateFound with + ⟨_, _, _, _, _, _, helperValueParams, resetValues⟩ + exact ⟨helperValueParams, resetValues⟩ + +/-- Fully exposed syntax of the replacement block emitted for this site. -/ +theorem resetBlock_eq {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (site : Site limits context block) (hot cold : BlockId) : + resetBlock site.candidate hot cold = + { valueParams := block.valueParams + creditParams := #[] + instructions := #[.resetShared (.reg site.shape.source) + site.shape.sourceConstructor] + terminator := .branchCredit 0 + { target := hot + values := branchValues site.shape + credits := #[0] } + { target := cold + values := branchValues site.shape + credits := #[0] } } := by + simp [resetBlock, site.candidateCore.1, site.candidateCore.2.1, + site.candidateVectors.2] + +/-- An accepted source block is never literally its reset replacement. The +recognized source begins with a field fetch (and has positive field count), +whereas the replacement begins with `resetShared`. -/ +theorem ne_resetBlock {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (site : Site limits context block) (hot cold : BlockId) : + block ≠ resetBlock site.candidate hot cold := by + intro equal + have sizes := congrArg (fun selected => selected.instructions.size) equal + have resetSize : (resetBlock site.candidate hot cold).instructions.size = 1 := + by rfl + rw [resetSize] at sizes + rw [site.fits.instructionCount] at sizes + omega + +/-- Fully exposed syntax of either required- or optional-credit helper. -/ +theorem creditBlock_eq {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (site : Site limits context block) (credit : CreditCap) : + creditBlock site.candidate credit = + { valueParams := + Array.replicate site.shape.fieldCount (.owned .shared) ++ + (block.valueParams.toList.eraseIdx site.shape.source).toArray + creditParams := #[credit] + instructions := #[.allocWith 0 .shared + site.shape.allocationConstructor + site.candidate.allocationArguments] + terminator := .tailCallSelf site.candidate.tailArguments } := by + simp [creditBlock, site.candidateCore.2.2.1, + site.candidateVectors.1] + +/-- The exact source/allocation schemas and compatibility equations retained +by an accepted site. -/ +theorem schemas {limits : Validate.Limits} {context : Validate.Context} + {block : Block} (site : Site limits context block) : + ∃ sourceSchema allocationSchema, + context.schemas .shared site.shape.sourceConstructor = + some sourceSchema ∧ + context.schemas .shared site.shape.allocationConstructor = + some allocationSchema ∧ + sourceSchema.fields = + Array.replicate site.shape.fieldCount .shared ∧ + allocationSchema.fields = sourceSchema.fields ∧ + sourceSchema.layout = allocationSchema.layout ∧ + site.representation.layout = sourceSchema.layout := + representation?_sound site.representationFound + +/-- Schema facts in the exact form consumed by reset and `allocWith`: both +lookups succeed, both field vectors are uniformly shared, and the emitted +credit layout matches both constructors. -/ +theorem runtimeSchemas {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (site : Site limits context block) : + ∃ sourceSchema allocationSchema, + context.schemas .shared site.shape.sourceConstructor = + some sourceSchema ∧ + context.schemas .shared site.shape.allocationConstructor = + some allocationSchema ∧ + sourceSchema.fields = + Array.replicate site.shape.fieldCount .shared ∧ + allocationSchema.fields = sourceSchema.fields ∧ + site.candidate.layout = sourceSchema.layout ∧ + site.candidate.layout = allocationSchema.layout := by + obtain ⟨sourceSchema, allocationSchema, sourceAt, allocationAt, + sourceFields, allocationFields, layouts, representationLayout⟩ := + site.schemas + have candidateRepresentation := site.candidateCore.2.2.2 + have candidateSource := candidateRepresentation.trans representationLayout + exact ⟨sourceSchema, allocationSchema, sourceAt, allocationAt, + sourceFields, allocationFields, candidateSource, + candidateSource.trans layouts⟩ + +/-- Accepted allocation operands are the successful register translation of +the recognized baseline allocation operands. -/ +theorem allocationArgumentsFound {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (site : Site limits context block) : + translateAtoms? site.shape site.shape.allocationArguments = + some site.candidate.allocationArguments := + (candidate?_sound site.candidateFound).1 + +/-- Accepted tail operands are the successful register translation of the +recognized baseline tail operands. -/ +theorem tailArgumentsFound {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (site : Site limits context block) : + translateAtoms? site.shape site.shape.tailArguments = + some site.candidate.tailArguments := + (candidate?_sound site.candidateFound).2.1 + +end Site + +/-- Exhaustive checked decision for one source block. Rejection constructors +retain the exact failed phase as well, so an unchanged block is justified by +the same computation that produced the output rather than by a later Boolean +audit. -/ +inductive Decision (limits : Validate.Limits) (context : Validate.Context) + (block : Block) : Type where + | noShape (notFound : reuseShape? block = none) + | livenessError (shape : Shape) + (shapeFound : reuseShape? block = some shape) + (error : Liveness.Error) + (rejected : inferPlacementWith limits block shape.source + shape.releasePosition = .error error) + | livenessMiss (shape : Shape) + (shapeFound : reuseShape? block = some shape) + (rejected : inferPlacementWith limits block shape.source + shape.releasePosition = .ok none) + | representationMiss (shape : Shape) + (shapeFound : reuseShape? block = some shape) + (placement : Placement block) + (placementFound : inferPlacementWith limits block shape.source + shape.releasePosition = .ok (some placement)) + (notFound : representation? context shape = none) + | operandMiss (shape : Shape) + (shapeFound : reuseShape? block = some shape) + (placement : Placement block) + (placementFound : inferPlacementWith limits block shape.source + shape.releasePosition = .ok (some placement)) + (representation : Representation) + (representationFound : representation? context shape = + some representation) + (notFound : candidate? block shape representation placement = none) + | accepted (site : Site limits context block) + +/-- Run the recognizer exactly once and retain its dependent decision. -/ +def classifyBlock (limits : Validate.Limits) (context : Validate.Context) + (block : Block) : Decision limits context block := by + match shapeFound : reuseShape? block with + | none => exact .noShape shapeFound + | some shape => + match placementFound : inferPlacementWith limits block shape.source + shape.releasePosition with + | .error error => + exact .livenessError shape shapeFound error placementFound + | .ok none => + exact .livenessMiss shape shapeFound placementFound + | .ok (some placement) => + match representationFound : representation? context shape with + | none => + exact .representationMiss shape shapeFound placement + placementFound representationFound + | some representation => + match candidateFound : + candidate? block shape representation placement with + | none => + exact .operandMiss shape shapeFound placement placementFound + representation representationFound candidateFound + | some candidate => + exact .accepted { + shape + shapeFound + placement + placementFound + representation + representationFound + candidate + candidateFound } + +def Decision.report {limits : Validate.Limits} {context : Validate.Context} + {block : Block} (decision : Decision limits context block) : Report := + match decision with + | .noShape _ => { scannedBlocks := 1 } + | .livenessError .. | .livenessMiss .. => + { scannedBlocks := 1, shapeCandidates := 1, livenessRejected := 1 } + | .representationMiss .. => + { scannedBlocks := 1, shapeCandidates := 1, + incompatibleLayouts := 1 } + | .operandMiss .. => + { scannedBlocks := 1, shapeCandidates := 1, + unmappableOperands := 1 } + | .accepted _ => + { scannedBlocks := 1, shapeCandidates := 1, rewritten := 1, + helperBlocks := 2 } + +/-- Replacement occupying the source block's old ID. -/ +def Decision.replacement {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (decision : Decision limits context block) (originalCount helperOffset : Nat) : + Block := + match decision with + | .accepted site => + resetBlock site.candidate (originalCount + helperOffset) + (originalCount + helperOffset + 1) + | _ => block + +/-- Helper blocks appended for this decision, in hot/required then +cold/optional order. -/ +def Decision.helpers {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (decision : Decision limits context block) : List Block := + match decision with + | .accepted site => + [creditBlock site.candidate (.required site.candidate.layout), + creditBlock site.candidate (.optional site.candidate.layout)] + | _ => [] + +/-- Replacing an accepted block preserves its externally visible value +parameter ABI; rejected blocks are literal identities. -/ +theorem Decision.replacement_valueParams {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (decision : Decision limits context block) (originalCount helperOffset : Nat) : + (decision.replacement originalCount helperOffset).valueParams = + block.valueParams := by + cases decision with + | noShape => rfl + | livenessError => rfl + | livenessMiss => rfl + | representationMiss => rfl + | operandMiss => rfl + | accepted site => + simpa [Decision.replacement] using congrArg Block.valueParams + (site.resetBlock_eq (originalCount + helperOffset) + (originalCount + helperOffset + 1)) + +/-- The replacement also preserves the credit-parameter ABI. Accepted +source blocks are certified credit-free and reset blocks have the same empty +credit vector. -/ +theorem Decision.replacement_creditParams {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (decision : Decision limits context block) (originalCount helperOffset : Nat) : + (decision.replacement originalCount helperOffset).creditParams = + block.creditParams := by + cases decision with + | noShape => rfl + | livenessError => rfl + | livenessMiss => rfl + | representationMiss => rfl + | operandMiss => rfl + | accepted site => + calc + (Decision.replacement (.accepted site) originalCount + helperOffset).creditParams = #[] := by + simpa [Decision.replacement] using congrArg Block.creditParams + (site.resetBlock_eq (originalCount + helperOffset) + (originalCount + helperOffset + 1)) + _ = block.creditParams := site.fits.noCredits.symm + +/-- Heterogeneous decision list indexed by the exact source block list. -/ +inductive FunctionDecisions (limits : Validate.Limits) + (context : Validate.Context) : List Block → Type where + | nil : FunctionDecisions limits context [] + | cons {block : Block} {blocks : List Block} + (head : Decision limits context block) + (tail : FunctionDecisions limits context blocks) : + FunctionDecisions limits context (block :: blocks) + +def classifyBlocks (limits : Validate.Limits) (context : Validate.Context) : + (blocks : List Block) → FunctionDecisions limits context blocks + | [] => .nil + | block :: blocks => + .cons (classifyBlock limits context block) + (classifyBlocks limits context blocks) + +structure Realization where + originals : List Block := [] + helpers : List Block := [] + report : Report := {} + +namespace FunctionDecisions + +/-- Materialize a decision list while threading the number of helpers already +assigned IDs. Because every accepted site contributes its two helpers before +the tail is realized, their IDs agree with the append-only executable pass. -/ +def realize {limits : Validate.Limits} {context : Validate.Context} + (originalCount : Nat) : {blocks : List Block} → + FunctionDecisions limits context blocks → Nat → Realization + | [], .nil, _ => {} + | _ :: _, .cons head tail, helperOffset => + let generated := head.helpers + let rest := realize originalCount tail (helperOffset + generated.length) + { originals := head.replacement originalCount helperOffset :: + rest.originals + helpers := generated ++ rest.helpers + report := head.report.add rest.report } + +/-- Locate a block decision by its source block ID. `helperOffset` is the +number of helper blocks contributed by preceding source blocks. -/ +inductive At {limits : Validate.Limits} {context : Validate.Context} : + {blocks : List Block} → FunctionDecisions limits context blocks → + (index helperOffset : Nat) → (block : Block) → + Decision limits context block → Prop where + | zero {block : Block} {blocks : List Block} + {head : Decision limits context block} + {tail : FunctionDecisions limits context blocks} : + At (.cons head tail) 0 0 block head + | succ {headBlock block : Block} {blocks : List Block} + {head : Decision limits context headBlock} + {tail : FunctionDecisions limits context blocks} + {index helperOffset : Nat} + {decision : Decision limits context block} + (found : At tail index helperOffset block decision) : + At (.cons head tail) (index + 1) + (head.helpers.length + helperOffset) block decision + +theorem exists_at {limits : Validate.Limits} {context : Validate.Context} + {blocks : List Block} (decisions : FunctionDecisions limits context blocks) + (index : Nat) (bound : index < blocks.length) : + ∃ helperOffset block decision, + At decisions index helperOffset block decision := by + induction decisions generalizing index with + | nil => simp at bound + | @cons block blocks head tail ih => + cases index with + | zero => exact ⟨0, block, head, .zero⟩ + | succ index => + have tailBound : index < blocks.length := by + simpa using bound + obtain ⟨helperOffset, foundBlock, decision, found⟩ := + ih index tailBound + exact ⟨head.helpers.length + helperOffset, foundBlock, decision, + .succ found⟩ + +theorem At.source_get? {limits : Validate.Limits} + {context : Validate.Context} {blocks : List Block} + {decisions : FunctionDecisions limits context blocks} + {index helperOffset : Nat} {block : Block} + {decision : Decision limits context block} + (found : At decisions index helperOffset block decision) : + blocks[index]? = some block := by + induction found with + | zero => simp + | succ _ ih => simpa using ih + +@[simp] theorem realize_originals_length {limits : Validate.Limits} + {context : Validate.Context} {blocks : List Block} + (decisions : FunctionDecisions limits context blocks) + (originalCount helperOffset : Nat) : + (decisions.realize originalCount helperOffset).originals.length = + blocks.length := by + induction decisions generalizing helperOffset with + | nil => rfl + | cons head tail ih => + simp [realize, ih] + +theorem At.original_get? {limits : Validate.Limits} + {context : Validate.Context} {blocks : List Block} + {decisions : FunctionDecisions limits context blocks} + {index helperOffset : Nat} {block : Block} + {decision : Decision limits context block} + (found : At decisions index helperOffset block decision) + (originalCount startOffset : Nat) : + (decisions.realize originalCount startOffset).originals[index]? = + some (decision.replacement originalCount + (startOffset + helperOffset)) := by + induction found generalizing startOffset with + | zero => simp [realize] + | @succ headBlock block blocks head tail index helperOffset decision + found ih => + simpa [realize, Nat.add_assoc] using + ih (startOffset + head.helpers.length) + +theorem At.helper_get? {limits : Validate.Limits} + {context : Validate.Context} {blocks : List Block} + {decisions : FunctionDecisions limits context blocks} + {index helperOffset : Nat} {block : Block} + {decision : Decision limits context block} + (found : At decisions index helperOffset block decision) + {inside : Nat} {helper : Block} + (insideAt : decision.helpers[inside]? = some helper) + (originalCount startOffset : Nat) : + (decisions.realize originalCount startOffset).helpers[ + helperOffset + inside]? = some helper := by + induction found generalizing startOffset with + | zero => + simp only [realize, Nat.zero_add] + rw [List.getElem?_append_left] + · exact insideAt + · exact (List.getElem?_eq_some_iff.mp insideAt).choose + | @succ headBlock block blocks head tail index helperOffset decision + found ih => + simp only [realize] + rw [List.getElem?_append_right (by omega)] + simpa [Nat.add_assoc] using + ih insideAt (startOffset + head.helpers.length) + +theorem At.hot_helper_get? {limits : Validate.Limits} + {context : Validate.Context} {blocks : List Block} + {decisions : FunctionDecisions limits context blocks} + {index helperOffset : Nat} {block : Block} + {site : Site limits context block} + (found : At decisions index helperOffset block (.accepted site)) + (originalCount startOffset : Nat) : + (decisions.realize originalCount startOffset).helpers[helperOffset]? = + some (creditBlock site.candidate + (.required site.candidate.layout)) := by + simpa using found.helper_get? + (inside := 0) (by simp [Decision.helpers]) originalCount startOffset + +theorem At.cold_helper_get? {limits : Validate.Limits} + {context : Validate.Context} {blocks : List Block} + {decisions : FunctionDecisions limits context blocks} + {index helperOffset : Nat} {block : Block} + {site : Site limits context block} + (found : At decisions index helperOffset block (.accepted site)) + (originalCount startOffset : Nat) : + (decisions.realize originalCount startOffset).helpers[helperOffset + 1]? = + some (creditBlock site.candidate + (.optional site.candidate.layout)) := by + exact found.helper_get? + (inside := 1) (by simp [Decision.helpers]) originalCount startOffset + +end FunctionDecisions + +/-- Complete proof-carrying rewrite of one function. -/ +structure FunctionRewrite (limits : Validate.Limits) + (context : Validate.Context) (source : Function) where + decisions : FunctionDecisions limits context source.blocks.toList + +namespace FunctionRewrite + +def realization {limits : Validate.Limits} {context : Validate.Context} + {source : Function} (rewrite : FunctionRewrite limits context source) : + Realization := + rewrite.decisions.realize source.blocks.size 0 + +def definition {limits : Validate.Limits} {context : Validate.Context} + {source : Function} (rewrite : FunctionRewrite limits context source) : + Function := + { source with blocks := + (rewrite.realization.originals ++ rewrite.realization.helpers).toArray } + +def report {limits : Validate.Limits} {context : Validate.Context} + {source : Function} (rewrite : FunctionRewrite limits context source) : + Report := + rewrite.realization.report + +@[simp] theorem definition_signature {limits : Validate.Limits} + {context : Validate.Context} {source : Function} + (rewrite : FunctionRewrite limits context source) : + rewrite.definition.signature = source.signature := by + rfl + +/-- Every original block ID has one exhaustive source decision and resolves to +that decision's replacement at the same target ID. -/ +theorem decisionAt {limits : Validate.Limits} {context : Validate.Context} + {source : Function} (rewrite : FunctionRewrite limits context source) + (index : Nat) (bound : index < source.blocks.size) : + ∃ helperOffset block decision, + FunctionDecisions.At rewrite.decisions index helperOffset block + decision ∧ + source.blocks[index]? = some block ∧ + rewrite.definition.blocks[index]? = + some (decision.replacement source.blocks.size helperOffset) := by + have listBound : index < source.blocks.toList.length := by + simpa using bound + obtain ⟨helperOffset, block, decision, found⟩ := + FunctionDecisions.exists_at rewrite.decisions index listBound + have sourceAt : source.blocks[index]? = some block := by + simpa only [Array.getElem?_toList] using found.source_get? + let realized := rewrite.realization + have originalsLength : realized.originals.length = source.blocks.size := by + simp [realized, realization] + have originalAt : realized.originals[index]? = + some (decision.replacement source.blocks.size helperOffset) := by + simpa [realized, realization] using + found.original_get? source.blocks.size 0 + have originalBound : index < realized.originals.length := by + simpa [originalsLength] using bound + have targetAt : rewrite.definition.blocks[index]? = + some (decision.replacement source.blocks.size helperOffset) := by + change (realized.originals ++ realized.helpers).toArray[index]? = _ + rw [List.getElem?_toArray, List.getElem?_append_left originalBound] + exact originalAt + exact ⟨helperOffset, block, decision, found, sourceAt, targetAt⟩ + +/-- An accepted decision exposes all three target block lookups needed by the +semantic diamond: the reset replacement at the old ID and the appended hot +and cold credit blocks. -/ +theorem acceptedAt {limits : Validate.Limits} {context : Validate.Context} + {source : Function} (rewrite : FunctionRewrite limits context source) + {index helperOffset : Nat} {block : Block} + {site : Site limits context block} + (found : FunctionDecisions.At rewrite.decisions index helperOffset block + (.accepted site)) : + source.blocks[index]? = some block ∧ + rewrite.definition.blocks[index]? = + some (resetBlock site.candidate + (source.blocks.size + helperOffset) + (source.blocks.size + helperOffset + 1)) ∧ + rewrite.definition.blocks[source.blocks.size + helperOffset]? = + some (creditBlock site.candidate + (.required site.candidate.layout)) ∧ + rewrite.definition.blocks[source.blocks.size + helperOffset + 1]? = + some (creditBlock site.candidate + (.optional site.candidate.layout)) := by + let realized := rewrite.realization + have sourceAt : source.blocks[index]? = some block := by + simpa only [Array.getElem?_toList] using found.source_get? + have originalsLength : realized.originals.length = source.blocks.size := by + simp [realized, realization] + have originalAt : realized.originals[index]? = + some (resetBlock site.candidate + (source.blocks.size + helperOffset) + (source.blocks.size + helperOffset + 1)) := by + simpa [realized, realization, Decision.replacement] using + found.original_get? source.blocks.size 0 + have originalBound : index < realized.originals.length := by + rw [originalsLength] + simpa using (List.getElem?_eq_some_iff.mp found.source_get?).choose + have targetOriginal : rewrite.definition.blocks[index]? = + some (resetBlock site.candidate + (source.blocks.size + helperOffset) + (source.blocks.size + helperOffset + 1)) := by + change (realized.originals ++ realized.helpers).toArray[index]? = _ + rw [List.getElem?_toArray, List.getElem?_append_left originalBound] + exact originalAt + have hotAt : realized.helpers[helperOffset]? = + some (creditBlock site.candidate + (.required site.candidate.layout)) := by + simpa [realized, realization] using + found.hot_helper_get? source.blocks.size 0 + have coldAt : realized.helpers[helperOffset + 1]? = + some (creditBlock site.candidate + (.optional site.candidate.layout)) := by + simpa [realized, realization] using + found.cold_helper_get? source.blocks.size 0 + have targetHot : + rewrite.definition.blocks[source.blocks.size + helperOffset]? = + some (creditBlock site.candidate + (.required site.candidate.layout)) := by + change (realized.originals ++ realized.helpers).toArray[ + source.blocks.size + helperOffset]? = _ + rw [List.getElem?_toArray, ← originalsLength, + List.getElem?_append_right (by omega)] + simpa using hotAt + have targetCold : + rewrite.definition.blocks[source.blocks.size + helperOffset + 1]? = + some (creditBlock site.candidate + (.optional site.candidate.layout)) := by + change (realized.originals ++ realized.helpers).toArray[ + source.blocks.size + helperOffset + 1]? = _ + rw [List.getElem?_toArray, ← originalsLength, + List.getElem?_append_right (by omega)] + simpa [Nat.add_assoc] using coldAt + exact ⟨sourceAt, targetOriginal, targetHot, targetCold⟩ + +/-- At an accepted original block ID, the rewritten block cannot remain the +literal source block. This is the decision-level disjointness fact used to +show that unchanged synchronized blocks have no accepted-entry phase +obligation. -/ +theorem accepted_target_ne_source {limits : Validate.Limits} + {context : Validate.Context} {source : Function} + (rewrite : FunctionRewrite limits context source) + {index helperOffset : Nat} {block : Block} + {site : Site limits context block} + (found : FunctionDecisions.At rewrite.decisions index helperOffset block + (.accepted site)) : + rewrite.definition.blocks[index]? ≠ some block := by + intro unchanged + have target := (rewrite.acceptedAt found).2.1 + have equal : resetBlock site.candidate + (source.blocks.size + helperOffset) + (source.blocks.size + helperOffset + 1) = block := + Option.some.inj (target.symm.trans unchanged) + exact site.ne_resetBlock _ _ equal.symm + +/-- Exhaustive proof-facing classification of one original block ID. A +rejected decision exposes literal source/target block equality; an accepted +decision retains the dependent site witness from which `acceptedAt` recovers +the reset and both helper blocks. -/ +inductive BlockCase {limits : Validate.Limits} {context : Validate.Context} + {source : Function} (rewrite : FunctionRewrite limits context source) + (index : Nat) : Prop where + | unchanged {block : Block} + (sourceAt : source.blocks[index]? = some block) + (targetAt : rewrite.definition.blocks[index]? = some block) : + BlockCase rewrite index + | accepted {helperOffset : Nat} {block : Block} + {site : Site limits context block} + (found : FunctionDecisions.At rewrite.decisions index helperOffset + block (.accepted site)) : + BlockCase rewrite index + +/-- Every original block ID is either preserved literally or carries the +accepted-site witness needed by the semantic reset/reuse diamond. -/ +theorem blockCase {limits : Validate.Limits} {context : Validate.Context} + {source : Function} (rewrite : FunctionRewrite limits context source) + (index : Nat) (bound : index < source.blocks.size) : + BlockCase rewrite index := by + obtain ⟨helperOffset, block, decision, found, sourceAt, targetAt⟩ := + rewrite.decisionAt index bound + cases decision with + | noShape notFound => + exact .unchanged sourceAt + (by simpa [Decision.replacement] using targetAt) + | livenessError shape shapeFound error rejected => + exact .unchanged sourceAt + (by simpa [Decision.replacement] using targetAt) + | livenessMiss shape shapeFound rejected => + exact .unchanged sourceAt + (by simpa [Decision.replacement] using targetAt) + | representationMiss shape shapeFound placement placementFound notFound => + exact .unchanged sourceAt + (by simpa [Decision.replacement] using targetAt) + | operandMiss shape shapeFound placement placementFound representation + representationFound notFound => + exact .unchanged sourceAt + (by simpa [Decision.replacement] using targetAt) + | accepted site => + exact .accepted found + +/-- A successful source lookup supplies the bound needed for exhaustive +decision dispatch. -/ +theorem blockCaseOfLookup {limits : Validate.Limits} + {context : Validate.Context} {source : Function} + (rewrite : FunctionRewrite limits context source) + {index : Nat} {block : Block} + (found : source.blocks[index]? = some block) : + BlockCase rewrite index := by + have bound : index < source.blocks.size := + (Array.getElem?_eq_some_iff.mp found).choose + exact rewrite.blockCase index bound + +/-- Every original target ID retains the source block's incoming value and +credit ABI, even when its body is replaced by an accepted reset block. -/ +theorem targetBlockAbi {limits : Validate.Limits} + {context : Validate.Context} {source : Function} + (rewrite : FunctionRewrite limits context source) + {index : Nat} {block : Block} + (found : source.blocks[index]? = some block) : + ∃ targetBlock, + rewrite.definition.blocks[index]? = some targetBlock ∧ + targetBlock.valueParams = block.valueParams ∧ + targetBlock.creditParams = block.creditParams := by + have bound : index < source.blocks.size := + (Array.getElem?_eq_some_iff.mp found).choose + obtain ⟨helperOffset, selectedBlock, decision, _selected, + sourceAt, targetAt⟩ := rewrite.decisionAt index bound + have blockEq : selectedBlock = block := + Option.some.inj (sourceAt.symm.trans found) + subst selectedBlock + exact ⟨decision.replacement source.blocks.size helperOffset, targetAt, + decision.replacement_valueParams source.blocks.size helperOffset, + decision.replacement_creditParams source.blocks.size helperOffset⟩ + +/-- Rewriting cannot turn an executable function into an empty one: every +source block keeps an original target coordinate. -/ +theorem definition_blocks_nonempty {limits : Validate.Limits} + {context : Validate.Context} {source : Function} + (rewrite : FunctionRewrite limits context source) + (nonempty : source.blocks.isEmpty = false) : + rewrite.definition.blocks.isEmpty = false := by + have sourceEntryBound : 0 < source.blocks.size := by + apply Nat.pos_of_ne_zero + intro sizeZero + exact (Array.isEmpty_eq_false_iff.mp nonempty) + (Array.size_eq_zero_iff.mp sizeZero) + have sourceEntry : source.blocks[0]? = some source.blocks[0] := + Array.getElem?_eq_getElem sourceEntryBound + obtain ⟨targetEntry, targetEntryAt, _valueParams, _creditParams⟩ := + rewrite.targetBlockAbi sourceEntry + apply Array.isEmpty_eq_false_iff.mpr + intro targetEmpty + rw [targetEmpty] at targetEntryAt + simp at targetEntryAt + +end FunctionRewrite + +/-- Rewrite every independent matching block in one function while retaining +the exact ordered decision trace. -/ +def rewriteFunction (limits : Validate.Limits) (context : Validate.Context) + (definition : Function) : FunctionRewrite limits context definition := + { decisions := classifyBlocks limits context definition.blocks.toList } + +/-- Pure rewrite output, separated from validation so its exact result can be +retained in the checked API. -/ +structure Rewrite where + program : Program + report : Report + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- Ordered function traces indexed by the literal declaration list. Extern +entries are preserved exactly; function entries carry their dependent block +decision trace. -/ +inductive DeclarationDecisions (limits : Validate.Limits) + (context : Validate.Context) : + List (Ix.Compiler.Ixon.Address × Decl) → Type where + | nil : DeclarationDecisions limits context [] + | extern (address : Ix.Compiler.Ixon.Address) (arity : Nat) + {rest : List (Ix.Compiler.Ixon.Address × Decl)} + (tail : DeclarationDecisions limits context rest) : + DeclarationDecisions limits context + ((address, .extern arity) :: rest) + | fn (address : Ix.Compiler.Ixon.Address) (definition : Function) + {rest : List (Ix.Compiler.Ixon.Address × Decl)} + (head : FunctionRewrite limits context definition) + (tail : DeclarationDecisions limits context rest) : + DeclarationDecisions limits context + ((address, .fn definition) :: rest) + +def rewriteDeclarations (limits : Validate.Limits) + (context : Validate.Context) : + (declarations : List (Ix.Compiler.Ixon.Address × Decl)) → + DeclarationDecisions limits context declarations + | [] => .nil + | (address, .extern arity) :: rest => + .extern address arity (rewriteDeclarations limits context rest) + | (address, .fn definition) :: rest => + .fn address definition (rewriteFunction limits context definition) + (rewriteDeclarations limits context rest) + +namespace DeclarationDecisions + +def target {limits : Validate.Limits} {context : Validate.Context} : + {source : List (Ix.Compiler.Ixon.Address × Decl)} → + DeclarationDecisions limits context source → + List (Ix.Compiler.Ixon.Address × Decl) + | [], .nil => [] + | _, .extern address arity tail => + (address, .extern arity) :: target tail + | _, .fn address _ head tail => + (address, .fn head.definition) :: target tail + +def report {limits : Validate.Limits} {context : Validate.Context} : + {source : List (Ix.Compiler.Ixon.Address × Decl)} → + DeclarationDecisions limits context source → Report + | [], .nil => {} + | _, .extern _ _ tail => report tail + | _, .fn _ _ head tail => head.report.add (report tail) + +end DeclarationDecisions + +/-- Declaration-level relation exported by the rewrite trace. -/ +inductive DeclarationRel (limits : Validate.Limits) + (context : Validate.Context) : Decl → Decl → Prop where + | extern (arity : Nat) : DeclarationRel limits context + (.extern arity) (.extern arity) + | fn {source : Function} + (rewrite : FunctionRewrite limits context source) : + DeclarationRel limits context (.fn source) (.fn rewrite.definition) + +inductive DeclarationsRel (limits : Validate.Limits) + (context : Validate.Context) : + List (Ix.Compiler.Ixon.Address × Decl) → + List (Ix.Compiler.Ixon.Address × Decl) → Prop where + | nil : DeclarationsRel limits context [] [] + | extern (address : Ix.Compiler.Ixon.Address) (arity : Nat) + {sourceTarget : List (Ix.Compiler.Ixon.Address × Decl)} + {targetTail : List (Ix.Compiler.Ixon.Address × Decl)} + (tail : DeclarationsRel limits context sourceTarget targetTail) : + DeclarationsRel limits context + ((address, .extern arity) :: sourceTarget) + ((address, .extern arity) :: targetTail) + | fn (address : Ix.Compiler.Ixon.Address) {source : Function} + (rewrite : FunctionRewrite limits context source) + {sourceTail targetTail : List (Ix.Compiler.Ixon.Address × Decl)} + (tail : DeclarationsRel limits context sourceTail targetTail) : + DeclarationsRel limits context + ((address, .fn source) :: sourceTail) + ((address, .fn rewrite.definition) :: targetTail) + +theorem DeclarationDecisions.related {limits : Validate.Limits} + {context : Validate.Context} + {source : List (Ix.Compiler.Ixon.Address × Decl)} + (decisions : DeclarationDecisions limits context source) : + DeclarationsRel limits context source decisions.target := by + induction decisions with + | nil => exact .nil + | extern address arity tail ih => + exact .extern address arity ih + | fn address definition head tail ih => + exact .fn address head ih + +/-- Address lookup preserves extern declarations exactly. -/ +theorem DeclarationsRel.find?_extern {limits : Validate.Limits} + {context : Validate.Context} + {source target : List (Ix.Compiler.Ixon.Address × Decl)} + (related : DeclarationsRel limits context source target) + {address : Ix.Compiler.Ixon.Address} {arity : Nat} + (found : source.find? (fun entry => entry.1 == address) = + some (address, .extern arity)) : + target.find? (fun entry => entry.1 == address) = + some (address, .extern arity) := by + induction related with + | nil => simp at found + | extern current currentArity tail ih => + by_cases same : current = address + · subst current + simpa using found + · simpa [same] using ih (by simpa [same] using found) + | fn current rewrite tail ih => + by_cases same : current = address + · subst current + simp at found + · simpa [same] using ih (by simpa [same] using found) + +/-- A source function lookup selects the exact function rewrite retained at +the same target address. -/ +theorem DeclarationsRel.find?_fn {limits : Validate.Limits} + {context : Validate.Context} + {source target : List (Ix.Compiler.Ixon.Address × Decl)} + (related : DeclarationsRel limits context source target) + {address : Ix.Compiler.Ixon.Address} {definition : Function} + (found : source.find? (fun entry => entry.1 == address) = + some (address, .fn definition)) : + ∃ rewrite : FunctionRewrite limits context definition, + target.find? (fun entry => entry.1 == address) = + some (address, .fn rewrite.definition) := by + induction related with + | nil => simp at found + | extern current arity tail ih => + by_cases same : current = address + · subst current + simp at found + · obtain ⟨selected, selectedAt⟩ := + ih (by simpa [same] using found) + exact ⟨selected, by simpa [same] using selectedAt⟩ + | @fn current currentDefinition rewrite sourceTail targetTail tail ih => + by_cases same : current = address + · subst current + simp at found + subst definition + exact ⟨rewrite, by simp⟩ + · obtain ⟨selected, selectedAt⟩ := + ih (by simpa [same] using found) + exact ⟨selected, by simpa [same] using selectedAt⟩ + +/-- Complete typed trace for one program rewrite. -/ +structure Trace (limits : Validate.Limits) (context : Validate.Context) + (source : Program) where + declarations : DeclarationDecisions limits context source.declarations + main : FunctionRewrite limits context source.main + +namespace Trace + +def target {limits : Validate.Limits} {context : Validate.Context} + {source : Program} (trace : Trace limits context source) : Program := + { declarations := trace.declarations.target + main := trace.main.definition } + +def report {limits : Validate.Limits} {context : Validate.Context} + {source : Program} (trace : Trace limits context source) : Report := + trace.declarations.report.add trace.main.report + +def rewrite {limits : Validate.Limits} {context : Validate.Context} + {source : Program} (trace : Trace limits context source) : Rewrite := + { program := trace.target, report := trace.report } + +theorem declarations_related {limits : Validate.Limits} + {context : Validate.Context} {source : Program} + (trace : Trace limits context source) : + DeclarationsRel limits context source.declarations + trace.target.declarations := + trace.declarations.related + +@[simp] theorem target_main_signature {limits : Validate.Limits} + {context : Validate.Context} {source : Program} + (trace : Trace limits context source) : + trace.target.main.signature = source.main.signature := by + exact trace.main.definition_signature + +/-- Function lookup in the executable evaluator context selects the exact +function trace at the same address. -/ +theorem context_fn {limits : Validate.Limits} + {context : Validate.Context} {source : Program} + (trace : Trace limits context source) + {oracle : Ix.Compiler.Ixon.Address → List Eval.RVal → Option Eval.RVal} + {address : Ix.Compiler.Ixon.Address} {definition : Function} + (found : (Eval.Context.ofProgram source context.schemas oracle).declarations + address = some (.fn definition)) : + ∃ rewrite : FunctionRewrite limits context definition, + (Eval.Context.ofProgram trace.target context.schemas oracle).declarations + address = some (.fn rewrite.definition) := by + change (source.declarations.find? (fun entry => entry.1 == address)).map + (fun entry => entry.2) = some (.fn definition) at found + cases sourceFind : + source.declarations.find? (fun entry => entry.1 == address) with + | none => simp [sourceFind] at found + | some entry => + obtain ⟨entryAddress, entryDecl⟩ := entry + have addressEq : entryAddress = address := by + apply beq_iff_eq.mp + exact List.find?_some + (p := fun entry : Ix.Compiler.Ixon.Address × Decl => + entry.1 == address) sourceFind + subst entryAddress + have declarationEq : entryDecl = .fn definition := by + simpa [sourceFind] using found + subst entryDecl + obtain ⟨rewrite, targetFind⟩ := + trace.declarations_related.find?_fn sourceFind + exact ⟨rewrite, by + change (trace.target.declarations.find? + (fun entry => entry.1 == address)).map (fun entry => entry.2) = _ + simp [targetFind]⟩ + +/-- Extern lookup is preserved literally in the rewritten evaluator +context. -/ +theorem context_extern {limits : Validate.Limits} + {context : Validate.Context} {source : Program} + (trace : Trace limits context source) + {oracle : Ix.Compiler.Ixon.Address → List Eval.RVal → Option Eval.RVal} + {address : Ix.Compiler.Ixon.Address} {arity : Nat} + (found : (Eval.Context.ofProgram source context.schemas oracle).declarations + address = some (.extern arity)) : + (Eval.Context.ofProgram trace.target context.schemas oracle).declarations + address = some (.extern arity) := by + change (source.declarations.find? (fun entry => entry.1 == address)).map + (fun entry => entry.2) = some (.extern arity) at found + cases sourceFind : + source.declarations.find? (fun entry => entry.1 == address) with + | none => simp [sourceFind] at found + | some entry => + obtain ⟨entryAddress, entryDecl⟩ := entry + have addressEq : entryAddress = address := by + apply beq_iff_eq.mp + exact List.find?_some + (p := fun entry : Ix.Compiler.Ixon.Address × Decl => + entry.1 == address) sourceFind + subst entryAddress + have declarationEq : entryDecl = .extern arity := by + simpa [sourceFind] using found + subst entryDecl + have targetFind := + trace.declarations_related.find?_extern sourceFind + change (trace.target.declarations.find? + (fun entry => entry.1 == address)).map (fun entry => entry.2) = _ + simp [targetFind] + +end Trace + +/-- Produce the target and the proof-facing decision trace in one traversal. -/ +def traceProgramWith (limits : Validate.Limits) (context : Validate.Context) + (program : Program) : Trace limits context program := + { declarations := rewriteDeclarations limits context program.declarations + main := rewriteFunction limits context program.main } + +def rewriteProgramWith (limits : Validate.Limits) (context : Validate.Context) + (program : Program) : Rewrite := + (traceProgramWith limits context program).rewrite + +def rewriteProgram (context : Validate.Context) (program : Program) : Rewrite := + rewriteProgramWith Validate.defaultLimits context program + +inductive Error where + | invalidSource (error : Validate.Error) + | invalidTarget (error : Validate.Error) + deriving BEq, Repr + +/-- A rewrite whose source and target both passed the same bounded ownership, +credit, call, schema, and CFG checker. -/ +structure Output (limits : Validate.Limits) (context : Validate.Context) + (source : Program) where + rewrite : Rewrite + trace : Trace limits context source + traceProduces : trace.rewrite = rewrite + sourceStats : Validate.Stats + targetStats : Validate.Stats + sourceAccepted : + Validate.validateWith limits context source = .ok sourceStats + targetAccepted : + Validate.validateWith limits context rewrite.program = .ok targetStats + +namespace Output + +def target {limits : Validate.Limits} {context : Validate.Context} + {source : Program} (output : Output limits context source) : Program := + output.rewrite.program + +def report {limits : Validate.Limits} {context : Validate.Context} + {source : Program} (output : Output limits context source) : Report := + output.rewrite.report + +/-- The retained decision trace materializes the exact validated target. -/ +theorem trace_target {limits : Validate.Limits} {context : Validate.Context} + {source : Program} (output : Output limits context source) : + output.trace.target = output.target := by + exact congrArg Rewrite.program output.traceProduces + +/-- Report counters are computed from the same exhaustive trace. -/ +theorem trace_report {limits : Validate.Limits} {context : Validate.Context} + {source : Program} (output : Output limits context source) : + output.trace.report = output.report := by + exact congrArg Rewrite.report output.traceProduces + +theorem sourceValid {limits : Validate.Limits} {context : Validate.Context} + {source : Program} (output : Output limits context source) : + Validate.ValidWith limits context source := + ⟨output.sourceStats, output.sourceAccepted⟩ + +theorem targetValid {limits : Validate.Limits} {context : Validate.Context} + {source : Program} (output : Output limits context source) : + Validate.ValidWith limits context output.target := + ⟨output.targetStats, output.targetAccepted⟩ + +end Output + +/-- Validate, rewrite, and validate again under one explicit resource policy. -/ +def optimizeWith (limits : Validate.Limits) (context : Validate.Context) + (source : Program) : Except Error (Output limits context source) := + match sourceAccepted : Validate.validateWith limits context source with + | .error error => .error (.invalidSource error) + | .ok sourceStats => + let trace := traceProgramWith limits context source + let rewrite := trace.rewrite + match targetAccepted : + Validate.validateWith limits context rewrite.program with + | .error error => .error (.invalidTarget error) + | .ok targetStats => + .ok { rewrite, trace, traceProduces := rfl, sourceStats, targetStats, + sourceAccepted, targetAccepted } + +def optimize (context : Validate.Context) (source : Program) : + Except Error (Output Validate.defaultLimits context source) := + optimizeWith Validate.defaultLimits context source + +/-- A target-validation failure can occur only after the source passed the +same validator. This checked baseline is the fallback for an optional rewrite. -/ +theorem sourceValid_of_invalidTarget {limits : Validate.Limits} + {context : Validate.Context} {source : Program} {error : Validate.Error} + (rejected : optimizeWith limits context source = .error (.invalidTarget error)) : + Validate.ValidWith limits context source := by + unfold optimizeWith at rejected + split at rejected + next sourceError _sourceRejected => cases rejected + next stats accepted => exact ⟨stats, accepted⟩ + +/-- Invalid source input remains a compilation error; it is never a usable +fallback merely because optimization was optional. -/ +theorem sourceRejected_of_invalidSource {limits : Validate.Limits} + {context : Validate.Context} {source : Program} {error : Validate.Error} + (rejected : optimizeWith limits context source = .error (.invalidSource error)) : + Validate.validateWith limits context source = .error error := by + unfold optimizeWith at rejected + split at rejected + next sourceError accepted => + cases rejected + exact accepted + next _stats _accepted => + dsimp only at rejected + split at rejected <;> cases rejected + +/-- The production outcome names either the exact validated rewrite or the +exact rejected attempt which selects the already-validated baseline. -/ +inductive Selection (limits : Validate.Limits) (context : Validate.Context) + (source : Program) where + | optimized (output : Output limits context source) + (produced : optimizeWith limits context source = .ok output) + | baseline (error : Validate.Error) + (rejected : optimizeWith limits context source = .error (.invalidTarget error)) + +/-- A skipped optimization reports its target-validation error explicitly. -/ +inductive SelectionReport where + | applied (report : Report) + | skipped (error : Validate.Error) + deriving BEq, Repr + +namespace Selection + +def target {limits : Validate.Limits} {context : Validate.Context} + {source : Program} : Selection limits context source → Program + | .optimized output _ => output.target + | .baseline _ _ => source + +def report {limits : Validate.Limits} {context : Validate.Context} + {source : Program} : Selection limits context source → SelectionReport + | .optimized output _ => .applied output.report + | .baseline error _ => .skipped error + +/-- Production selection always returns a program accepted by the requested +bounded validator, including when the optional rewrite was rejected. -/ +theorem valid {limits : Validate.Limits} {context : Validate.Context} + {source : Program} (selection : Selection limits context source) : + Validate.ValidWith limits context selection.target := by + cases selection with + | optimized output _ => exact output.targetValid + | baseline _ rejected => exact sourceValid_of_invalidTarget rejected + +end Selection + +/-- Attempt dynamic reuse while preserving a checked baseline on target +rejection. Source-validation errors retain the diagnostic API's error type. -/ +def selectWith (limits : Validate.Limits) (context : Validate.Context) + (source : Program) : Except Error (Selection limits context source) := + match produced : optimizeWith limits context source with + | .ok output => .ok (.optimized output produced) + | .error (.invalidTarget error) => .ok (.baseline error produced) + | .error (.invalidSource error) => .error (.invalidSource error) + +def select (context : Validate.Context) (source : Program) : + Except Error (Selection Validate.defaultLimits context source) := + selectWith Validate.defaultLimits context source + +/-- Selection is total once the baseline is checked. The proof argument is +erased at runtime, and the optional optimizer still records its exact outcome. -/ +def selectCheckedWith (limits : Validate.Limits) (context : Validate.Context) + (source : Program) (valid : Validate.ValidWith limits context source) : + Selection limits context source := + match produced : optimizeWith limits context source with + | .ok output => .optimized output produced + | .error (.invalidTarget error) => .baseline error produced + | .error (.invalidSource error) => False.elim (by + obtain ⟨stats, accepted⟩ := valid + have rejected := sourceRejected_of_invalidSource produced + rw [accepted] at rejected + cases rejected) + +def selectChecked (context : Validate.Context) (source : Program) + (valid : Validate.ValidWith Validate.defaultLimits context source) : + Selection Validate.defaultLimits context source := + selectCheckedWith Validate.defaultLimits context source valid + + +end Ix.Compiler.IxIR2.Reuse diff --git a/Ix/Compiler/IxIR2/ReuseAllocation.lean b/Ix/Compiler/IxIR2/ReuseAllocation.lean new file mode 100644 index 000000000..b64e6ca94 --- /dev/null +++ b/Ix/Compiler/IxIR2/ReuseAllocation.lean @@ -0,0 +1,73 @@ +import Ix.Compiler.IxIR2.ReuseCost +import Ix.Compiler.IxIR2.AllocationEvents +import Ix.Compiler.IxIR2.ReuseResources + +/-! +# Comparative allocation and free observations + +Semantic heap correspondence preserves live-node counts. Combining this fact +with actual execution accounting and the separate allocation-event equation +yields both counter laws at halt. +-/ + + + +namespace Ix.Compiler.IxIR2.Eval + +/-- Comparative counters at successful physical halt. Each executed reuse +saves one fresh allocation and one terminal free relative to the baseline. -/ +structure Result.AllocationLaws (baseline selected : Result) : Prop where + allocations : baseline.store.heap.allocs = + selected.store.heap.allocs + selected.store.heap.reuses + frees : baseline.store.heap.frees = + selected.store.heap.frees + selected.store.heap.reuses + +theorem Result.AllocationLaws.of_accounting {baseline selected : Result} + {locRel : Nat → Nat → Prop} + (heaps : ReuseSim.StableHeapRel baseline.store selected.store locRel) + (events : baseline.store.allocationEvents = selected.store.allocationEvents) + (noReuse : baseline.store.heap.reuses = 0) + (baselineAccounted : baseline.store.live + baseline.store.heap.frees = baseline.store.heap.allocs) + (selectedAccounted : selected.store.live + selected.store.heap.frees = selected.store.heap.allocs) : + baseline.AllocationLaws selected := by + have live := heaps.live_eq + unfold Store.allocationEvents at events + constructor <;> omega + +/-- Both actual shared-result releases, with the same sufficient traversal +budget, retain the comparative free law after the heaps are empty. -/ +def Result.ReclaimedAllocationLaws (baseline selected : Result) : Prop := + ∃ releaseFuel baselineReleased selectedReleased remaining, + releaseShared releaseFuel baseline.store baseline.value = .ok (baselineReleased, remaining) ∧ + releaseShared releaseFuel selected.store selected.value = .ok (selectedReleased, remaining) ∧ + baselineReleased.live = 0 ∧ selectedReleased.live = 0 ∧ + baselineReleased.heap.allocs = baselineReleased.heap.frees ∧ + selectedReleased.heap.allocs = selectedReleased.heap.frees ∧ + baselineReleased.heap.frees = selectedReleased.heap.frees + selectedReleased.heap.reuses + +theorem Result.AllocationLaws.reclaimed {baseline selected : Result} + {locRel : Nat → Nat → Prop} + (laws : baseline.AllocationLaws selected) + (heaps : ReuseSim.StableHeapRel baseline.store selected.store locRel) + (values : IxIR1.Sim.RValIso locRel baseline.value selected.value) + (baselineResources : baseline.SharedResources) + (selectedResources : selected.SharedResources) : + baseline.ReclaimedAllocationLaws selected := by + obtain ⟨releaseFuel, baselineReleased, remaining, baselineRelease, baselineEmpty, + baselineBalance⟩ := baselineResources.2 + obtain ⟨selectedReleased, selectedRelease, selectedEmpty⟩ := + heaps.sharedReclamation values baselineRelease baselineEmpty + have selectedHeapBalance := releaseShared_heapBalance selectedRelease + have selectedBalance : selectedReleased.heap.allocs = selectedReleased.heap.frees := by + have accounted := selectedResources.1 + unfold HeapBalance at selectedHeapBalance + omega + have baselineCounters := releaseShared_allocationCounters baselineRelease + have selectedCounters := releaseShared_allocationCounters selectedRelease + refine ⟨releaseFuel, baselineReleased, selectedReleased, remaining, + baselineRelease, selectedRelease, baselineEmpty, selectedEmpty, + baselineBalance, selectedBalance, ?_⟩ + have allocations := laws.allocations + omega + +end Ix.Compiler.IxIR2.Eval diff --git a/Ix/Compiler/IxIR2/ReuseCost.lean b/Ix/Compiler/IxIR2/ReuseCost.lean new file mode 100644 index 000000000..c81464452 --- /dev/null +++ b/Ix/Compiler/IxIR2/ReuseCost.lean @@ -0,0 +1,287 @@ +import Ix.Compiler.IxIR2.CostSteps +import Ix.Compiler.IxIR2.ReuseSim + +/-! +# Heap correspondence and separate comparative costs + +Live nodes and outstanding references depend only on semantic heap contents. +RC and peak costs are kept in independent, compositional certificates. +-/ + +namespace Ix.Compiler.IxIR2.ReuseSim + +open Eval + +private theorem history_live_eq {baseline rewritten : Store} + (heap : IxIR1.Sim.HeapHistoryIso baseline.heap rewritten.heap) : + baseline.live = rewritten.live := by + classical + by_cases empty : baseline.live = 0 + · exact empty.trans (heap.right_live_eq_zero empty).symm + have present : ∃ box, some box ∈ baseline.heap.nodes := by + apply Classical.byContradiction + intro absent + simp only [not_exists] at absent + exact empty ((IxIR1.Reclamation.Store.live_eq_zero_iff_no_live_slot baseline.heap).2 absent) + obtain ⟨box, member⟩ := present + obtain ⟨location, slot⟩ := Array.mem_iff_getElem?.mp member + have found : baseline.get? location = some box := by + simp [Store.get?, IxIR1.Store.get?, slot] + obtain ⟨rewrittenLocation, locations⟩ := heap.left_total found + obtain ⟨rewrittenBox, rewrittenAt, _boxes⟩ := heap.boxes locations found + have baselineCount := Store.live_kill found + have rewrittenCount := Store.live_kill (store := rewritten) rewrittenAt + have remaining := history_live_eq + (baseline := baseline.kill location) (rewritten := rewritten.kill rewrittenLocation) + (heap.kill locations found rewrittenAt) + omega +termination_by baseline.live +decreasing_by + have _removed := Store.live_kill found + omega + +/-- Allocation-history renaming preserves the number of live nodes even +though dead slots, fresh-allocation counters, and physical addresses differ. -/ +theorem StableHeapRel.live_eq {baseline rewritten : Store} + {locRel : Nat → Nat → Prop} (heap : StableHeapRel baseline rewritten locRel) : + baseline.live = rewritten.live := by + cases heap with + | contents same => simp only [Store.live_eq_countP, same.nodes] + | isomorphic history => exact (history_live_eq history).symm + +end Ix.Compiler.IxIR2.ReuseSim + +namespace Ix.Compiler.IxIR2.ReuseSim + +open Eval +open Ix.Compiler.IxIR1.CostTrace + +/-- An empty live heap carries no outstanding reference-count work. -/ +theorem pendingRC_empty {store : Store} (empty : store.live = 0) : + store.pendingRC = 0 := by + have absent := (IxIR1.Reclamation.Store.live_eq_zero_iff_no_live_slot store.heap).1 empty + have loop : ∀ (slots : List (Option IxIR1.NodeBox)), + (∀ box, some box ∉ slots) → sharedRcPotentialList slots = 0 := by + intro slots + induction slots with + | nil => intro absent; rfl + | cons slot rest ih => + intro absent + cases slot with + | some box => exact False.elim (absent box (by simp)) + | none => + simpa [sharedRcPotentialList, slotSharedRcPotential] using + ih (fun box member => absent box (by simp [member])) + exact loop store.heap.nodes.toList (by simpa using absent) + +/-- Allocation-history renaming preserves all pending shared RC work. -/ +theorem history_pendingRC_eq {baseline rewritten : Store} + (heap : IxIR1.Sim.HeapHistoryIso baseline.heap rewritten.heap) : + baseline.pendingRC = rewritten.pendingRC := by + classical + by_cases empty : baseline.live = 0 + · rw [pendingRC_empty empty, pendingRC_empty (heap.right_live_eq_zero empty)] + have present : ∃ box, some box ∈ baseline.heap.nodes := by + apply Classical.byContradiction + intro absent + simp only [not_exists] at absent + exact empty ((IxIR1.Reclamation.Store.live_eq_zero_iff_no_live_slot baseline.heap).2 absent) + obtain ⟨box, member⟩ := present + obtain ⟨location, slot⟩ := Array.mem_iff_getElem?.mp member + have found : baseline.get? location = some box := by + simp [Store.get?, IxIR1.Store.get?, slot] + obtain ⟨rewrittenLocation, locations⟩ := heap.left_total found + obtain ⟨rewrittenBox, rewrittenAt, boxes⟩ := heap.boxes locations found + have leftRemoved := sharedRcPotential_kill (store := baseline.heap) found + have rightRemoved := sharedRcPotential_kill (store := rewritten.heap) rewrittenAt + have weights : slotSharedRcPotential (some box) = slotSharedRcPotential (some rewrittenBox) := by + rcases box with ⟨world, rc, node⟩ + rcases rewrittenBox with ⟨rewrittenWorld, rewrittenRC, rewrittenNode⟩ + have worlds := boxes.world + have counts := boxes.rc + dsimp at worlds counts + subst rewrittenWorld + subst rewrittenRC + cases world <;> rfl + have remaining := history_pendingRC_eq + (baseline := baseline.kill location) (rewritten := rewritten.kill rewrittenLocation) + (heap.kill locations found rewrittenAt) + change sharedRcPotential (baseline.heap.kill location) = + sharedRcPotential (rewritten.heap.kill rewrittenLocation) at remaining + unfold Store.pendingRC + omega +termination_by baseline.live +decreasing_by + have removed := Store.live_kill found + omega + +theorem StableHeapRel.pendingRC_eq {baseline rewritten : Store} + {locRel : Nat → Nat → Prop} (heap : StableHeapRel baseline rewritten locRel) : + baseline.pendingRC = rewritten.pendingRC := by + cases heap with + | contents same => simp only [Store.pendingRC, sharedRcPotential, same.nodes] + | isomorphic history => exact (history_pendingRC_eq history).symm + +end Ix.Compiler.IxIR2.ReuseSim + +namespace Ix.Compiler.IxIR2.Eval + +/-- Comparative observations, independent of the semantic heap relation. -/ +structure Store.CostBounds (baseline selected : Store) : Prop where + rcops : selected.heap.rcops ≤ baseline.heap.rcops + peakLive : selected.peakLiveNodes ≤ baseline.peakLiveNodes + +theorem Store.CostBounds.refl (store : Store) : store.CostBounds store := + ⟨Nat.le_refl _, Nat.le_refl _⟩ + +/-- RC increments compare additively; peak comparisons transport any incoming +peak bound. The peak counter already records every intermediate allocation. -/ +structure CostDelta (baselineBefore baselineAfter selectedBefore selectedAfter : Store) : Prop where + rcops : selectedAfter.heap.rcops + baselineBefore.heap.rcops ≤ + baselineAfter.heap.rcops + selectedBefore.heap.rcops + peakLive : selectedBefore.peakLiveNodes ≤ baselineBefore.peakLiveNodes → + selectedAfter.peakLiveNodes ≤ baselineAfter.peakLiveNodes + +namespace CostDelta + +theorem refl (baseline selected : Store) : CostDelta baseline baseline selected selected := + ⟨by omega, fun bound => bound⟩ + +theorem preserves {b₀ b₁ r₀ r₁ : Store} (delta : CostDelta b₀ b₁ r₀ r₁) + (before : b₀.CostBounds r₀) : b₁.CostBounds r₁ := + ⟨by have _ := delta.rcops; have _ := before.rcops; omega, delta.peakLive before.peakLive⟩ + +theorem trans {b₀ b₁ b₂ r₀ r₁ r₂ : Store} + (first : CostDelta b₀ b₁ r₀ r₁) (second : CostDelta b₁ b₂ r₁ r₂) : + CostDelta b₀ b₂ r₀ r₂ := + ⟨by have _ := first.rcops; have _ := second.rcops; omega, + fun bound => second.peakLive (first.peakLive bound)⟩ + +/-- Equal RC charges and allocation events in corresponding heaps imply +equal raw RC increments and preservation of the peak comparison. -/ +theorem of_observations {b₀ b₁ r₀ r₁ : Store} {events : Nat} {charge : Int} + (pendingBefore : b₀.pendingRC = r₀.pendingRC) + (pendingAfter : b₁.pendingRC = r₁.pendingRC) + (liveAfter : b₁.live = r₁.live) + (baselineRC : (b₁.amortizedRC : Int) = b₀.amortizedRC + charge) + (selectedRC : (r₁.amortizedRC : Int) = r₀.amortizedRC + charge) + (baselinePeak : b₁.peakLiveNodes = + if events = 0 then b₀.peakLiveNodes else max b₀.peakLiveNodes b₁.live) + (selectedPeak : r₁.peakLiveNodes = + if events = 0 then r₀.peakLiveNodes else max r₀.peakLiveNodes r₁.live) : + CostDelta b₀ b₁ r₀ r₁ := by + constructor + · change ((b₁.heap.rcops + b₁.pendingRC : Nat) : Int) = + (b₀.heap.rcops + b₀.pendingRC : Nat) + charge at baselineRC + change ((r₁.heap.rcops + r₁.pendingRC : Nat) : Int) = + (r₀.heap.rcops + r₀.pendingRC : Nat) + charge at selectedRC + omega + · intro bound + rw [baselinePeak, selectedPeak, liveAfter] + split + · exact bound + · omega + +/-- A physical hot reset performs no RC work. Both allocation endpoints +record their complete peaks after the retained baseline fields are released. -/ +theorem hot {baseline selected retained released physical : Store} + {fields : Array RVal} {location baselineLocation fuel remaining payloadUnits : Nat} + {baselineNode selectedNode : Node} + (retains : RetainSharedMany baseline fields retained) + (releases : releaseShared fuel retained (.loc baselineLocation) = .ok (released, remaining)) + (reuses : (ReuseSim.physicalHotResetStore selected location).reuseReservation + location .shared selectedNode payloadUnits = .ok physical) + (live : (released.allocNode .shared baselineNode).1.live = physical.live) : + CostDelta baseline (released.allocNode .shared baselineNode).1 selected physical := by + have retainedCosts := retains.observations + have releasedCosts := releaseShared_observations releases + have reusedCosts := Store.reuseReservation_observations reuses + constructor + · have retainedRC := retainedCosts.1 + have releasedRC := releasedCosts.1 + have selectedRC : physical.heap.rcops = selected.heap.rcops := reusedCosts.1 + simp only [Store.rcops_allocNode] + omega + · intro before + rw [Store.peakLive_allocNode, releasedCosts.2.2.1, retainedCosts.2.2.1, reusedCosts.2.2.1] + change max selected.peakLiveNodes physical.live ≤ max baseline.peakLiveNodes _ + omega + +/-- Cold reset retains the same fields and performs the same root decrement +as the baseline, including aliased fields and arbitrary prior counters. -/ +theorem cold {baseline selected baselineRetained selectedRetained : Store} + {baselineFields selectedFields : Array RVal} {baselineLocation selectedLocation : Nat} + {baselineBox selectedBox : NodeBox} {baselineNode selectedNode : Node} + (retains : RetainSharedMany baseline baselineFields baselineRetained) + (selectedRetains : RetainSharedMany + (ReuseSim.coldResetStartStore selected selectedLocation selectedBox) selectedFields selectedRetained) + (fields : referenceCountList baselineFields.toList = referenceCountList selectedFields.toList) + (live : ((ReuseSim.baselineDecrementStore baselineRetained baselineLocation baselineBox).allocNode + .shared baselineNode).1.live = (selectedRetained.allocNode .shared selectedNode).1.live) : + CostDelta baseline + ((ReuseSim.baselineDecrementStore baselineRetained baselineLocation baselineBox).allocNode + .shared baselineNode).1 selected (selectedRetained.allocNode .shared selectedNode).1 := by + have retainedCosts := retains.observations + have selectedCosts := selectedRetains.observations + constructor + · have baselineRC := retainedCosts.1 + have selectedRC := selectedCosts.1 + change selectedRetained.heap.rcops = selected.heap.rcops + 1 + _ at selectedRC + change selectedRetained.heap.rcops + baseline.heap.rcops ≤ + baselineRetained.heap.rcops + 1 + selected.heap.rcops + omega + · intro before + have baselinePeak := retainedCosts.2.2.1 + have selectedPeak : selectedRetained.peakLiveNodes = selected.peakLiveNodes := selectedCosts.2.2.1 + simp only [Store.peakLive_allocNode, selectedPeak] + change max selected.peakLiveNodes _ ≤ max baselineRetained.peakLiveNodes _ + rw [baselinePeak] + omega + +end CostDelta + +def Result.CostBounds (baseline selected : Result) : Prop := + baseline.store.CostBounds selected.store + +/-- Complete shared-result release preserves the comparative RC and peak +bounds, even with independent sufficient traversal budgets. -/ +theorem Store.CostBounds.releaseShared {baseline selected baselineReleased selectedReleased : Store} + {baselineValue selectedValue : RVal} {baselineFuel selectedFuel baselineRemaining selectedRemaining : Nat} + {locRel : Nat → Nat → Prop} (costs : baseline.CostBounds selected) + (heaps : ReuseSim.StableHeapRel baseline selected locRel) + (baselineRelease : Eval.releaseShared baselineFuel baseline baselineValue = + .ok (baselineReleased, baselineRemaining)) + (selectedRelease : Eval.releaseShared selectedFuel selected selectedValue = + .ok (selectedReleased, selectedRemaining)) + (baselineEmpty : baselineReleased.live = 0) (selectedEmpty : selectedReleased.live = 0) : + baselineReleased.CostBounds selectedReleased := by + have baselineObserved := releaseShared_observations baselineRelease + have selectedObserved := releaseShared_observations selectedRelease + constructor + · have baselineRC := baselineObserved.2.1 + have selectedRC := selectedObserved.2.1 + change baselineReleased.heap.rcops + baselineReleased.pendingRC = + baseline.heap.rcops + baseline.pendingRC at baselineRC + change selectedReleased.heap.rcops + selectedReleased.pendingRC = + selected.heap.rcops + selected.pendingRC at selectedRC + have pending := heaps.pendingRC_eq + have baselineZero := ReuseSim.pendingRC_empty baselineEmpty + have selectedZero := ReuseSim.pendingRC_empty selectedEmpty + have bound := costs.rcops + omega + · rw [baselineObserved.2.2.1, selectedObserved.2.2.1] + exact costs.peakLive + +/-- The same two actual reclamations carry R3's accounting and free law, +together with the comparative RC and peak bounds. -/ +def Result.ReclaimedCostLaws (baseline selected : Result) : Prop := + ∃ releaseFuel baselineReleased selectedReleased remaining, + releaseShared releaseFuel baseline.store baseline.value = .ok (baselineReleased, remaining) ∧ + releaseShared releaseFuel selected.store selected.value = .ok (selectedReleased, remaining) ∧ + baselineReleased.live = 0 ∧ selectedReleased.live = 0 ∧ + baselineReleased.heap.allocs = baselineReleased.heap.frees ∧ + selectedReleased.heap.allocs = selectedReleased.heap.frees ∧ + baselineReleased.heap.frees = selectedReleased.heap.frees + selectedReleased.heap.reuses ∧ + baselineReleased.CostBounds selectedReleased + +end Ix.Compiler.IxIR2.Eval diff --git a/Ix/Compiler/IxIR2/ReuseExamples.lean b/Ix/Compiler/IxIR2/ReuseExamples.lean new file mode 100644 index 000000000..d29a4139f --- /dev/null +++ b/Ix/Compiler/IxIR2/ReuseExamples.lean @@ -0,0 +1,977 @@ +import Ix.Compiler.IxIR1.Lower +import Ix.Compiler.IxIR2.Lower +import Ix.Compiler.IxIR2.Reuse + +/-! +# First compiler-emitted dynamic-reuse benchmark + +This fixture begins with a hand-written IxIR₀ recursor declaration, not an +IxIR₁ or IxIR₂ loop. The ordinary IxIR₀→IxIR₁ compiler emits the shared +field-retain/release/allocation recursion shape, the baseline IxIR₁→IxIR₂ +lowerer emits and validates its CFG, and `IxIR2.Reuse.optimize` recognizes and +validates the reset/reuse diamond. + +The unaliased run takes the hot branch for every cons and performs no fresh +loop allocation. A second source main deliberately retains the original +list in a returned pair; ownership propagation makes every reset cold and +leaves allocation counts equal to the baseline. Both cases compare the +IxIR₀ source observation, baseline IxIR₂ observation, rewritten logical +observation, and rewritten physical observation before reclaiming every +returned target heap. +-/ + +namespace Ix.Compiler.IxIR2.Reuse.Examples + +open Ix.Compiler.Ixon (Address Owned) +open Ix.Compiler.IxIR2 + +def nilAddress : Address := Address.replicate 0xd1 +def consAddress : Address := Address.replicate 0xd2 +def reverseAddress : Address := Address.replicate 0xd3 +def pairAddress : Address := Address.replicate 0xd4 +def otherConsAddress : Address := Address.replicate 0xd5 + +def nilId : CtorId := IxIR1.Lower.ctorIdOf nilAddress 0 +def consId : CtorId := IxIR1.Lower.ctorIdOf consAddress 1 +def pairId : CtorId := IxIR1.Lower.ctorIdOf pairAddress 0 +def otherConsId : CtorId := IxIR1.Lower.ctorIdOf otherConsAddress 1 + +def nilLayout : LayoutId := Address.replicate 0xe1 +def consLayout : LayoutId := Address.replicate 0xe2 +def pairLayout : LayoutId := Address.replicate 0xe3 +def otherConsLayout : LayoutId := Address.replicate 0xe4 + +private def app2 (fn left right : IxIR0.Expr) : IxIR0.Expr := + .app (.app fn left) right + +private def cons (head tail : IxIR0.Expr) : IxIR0.Expr := + app2 (.ref consAddress) head tail + +private def pair (left right : IxIR0.Expr) : IxIR0.Expr := + app2 (.ref pairAddress) left right + +private def list (values : List Nat) : IxIR0.Expr := + values.foldr (fun value tail => cons (.lit (.nat value)) tail) + (.ref nilAddress) + +/-- Rule environment: tail, head, accumulator, recursive self. -/ +def reverseConsRule : IxIR0.RecRule := + { fields := 2 + rhs := app2 (.var 3) (cons (.var 1) (.var 2)) (.var 0) } + +/-- The source declaration inventory. Reversal is a genuine IxIR₀ +recursor with the accumulator before the major premise. -/ +def sourceDeclarations : List (Address × IxIR0.Decl) := + [(nilAddress, .ctor 0 0), + (consAddress, .ctor 1 2), + (pairAddress, .ctor 0 2), + (reverseAddress, .recursor 1 false #[ + { fields := 0, rhs := .var 0 }, + reverseConsRule])] + +def unaliasedMain : IxIR0.Expr := + app2 (.ref reverseAddress) (.ref nilAddress) (list [1, 2, 3]) + +/-- `xs` is consumed once by reversal and once by the result pair. The +IxIR₀→IxIR₁ compiler inserts the root retain; cold resets propagate that +second ownership through the tail. -/ +def aliasedMain : IxIR0.Expr := + .letE .many (list [1, 2, 3]) + (.letE .many + (app2 (.ref reverseAddress) (.ref nilAddress) (.var 0)) + (pair (.var 0) (.var 1))) + +def loweringContext : Ix.Compiler.IxIR2.Lower.Context := + { parameterWorlds := fun address => + if address == reverseAddress then some #[.shared, .shared] + else none + schemas := fun world identity => + if world != .shared then none + else if identity == nilId then + some { layout := nilLayout, fields := #[] } + else if identity == consId then + some { layout := consLayout, fields := #[.shared, .shared] } + else if identity == pairId then + some { layout := pairLayout, fields := #[.shared, .shared] } + else + none + caseCtors := fun _ alternative => + if alternative == 0 then [nilId] + else if alternative == 1 then [consId] + else [] } + +inductive CompileError where + | ixir1 (message : String) + | baseline (error : Ix.Compiler.IxIR2.Lower.Error) + | reuse (error : Reuse.Error) + deriving Repr + +/-- All retained target artifacts come from executable compiler/checker APIs; +the structure contains no hand-written IxIR₁ or IxIR₂ code. -/ +structure Compiled (source : IxIR0.Expr) where + input : Ix.Compiler.IxIR2.Lower.Input + baseline : Ix.Compiler.IxIR2.Lower.Checked + optimized : Reuse.Output Validate.defaultLimits + baseline.artifact.validationContext baseline.artifact.program + +def compile (source : IxIR0.Expr) : Except CompileError (Compiled source) := + match IxIR1.Lower.lowerAll sourceDeclarations source .shared with + | .error message => .error (.ixir1 message) + | .ok (declarations, main) => + let input : Ix.Compiler.IxIR2.Lower.Input := + { declarations, main, mainResult := .shared } + match Ix.Compiler.IxIR2.Lower.lowerChecked loweringContext input with + | .error error => .error (.baseline error) + | .ok baseline => + match Reuse.optimize baseline.artifact.validationContext + baseline.artifact.program with + | .error error => .error (.reuse error) + | .ok optimized => .ok { input, baseline, optimized } + +private def sourceNats? : Nat → IxIR0.Value → Option (List Nat) + | 0, _ => none + | fuel + 1, .ctor address tag values => + if address == nilAddress && tag == 0 && values.isEmpty then + some [] + else if address == consAddress && tag == 1 then + match values with + | [.lit (.nat head), tail] => + (sourceNats? fuel tail).map (head :: ·) + | _ => none + else + none + | _, _ => none + +private def sourcePair? (fuel : Nat) : IxIR0.Value → + Option (List Nat × List Nat) + | .ctor address tag [left, right] => + if address == pairAddress && tag == 0 then do + return (← sourceNats? fuel left, ← sourceNats? fuel right) + else + none + | _ => none + +private def targetNats? : Nat → Eval.Store → Eval.RVal → + Option (List Nat) + | 0, _, _ => none + | fuel + 1, store, .loc location => do + let box ← store.get? location + match box.node with + | .ctorN identity values => + if identity == nilId && values.isEmpty then + some [] + else if identity == consId then + match values.toList with + | [.lit (.nat head), tail] => + (targetNats? fuel store tail).map (head :: ·) + | _ => none + else + none + | .papN .. => none + | _, _, _ => none + +private def targetPair? (fuel : Nat) (store : Eval.Store) : Eval.RVal → + Option (List Nat × List Nat) + | .loc location => do + let box ← store.get? location + match box.node with + | .ctorN identity values => + if identity == pairId then + match values.toList with + | [left, right] => + return (← targetNats? fuel store left, + ← targetNats? fuel store right) + | _ => none + else + none + | .papN .. => none + | _ => none + +private def sourceContext : IxIR0.Ctx := + { env := IxIR0.Env.ofList sourceDeclarations } + +private def targetContext (context : Validate.Context) + (program : Program) : Eval.Context := + Eval.Context.ofProgram program context.schemas + +private def released (result : Eval.Result) : Bool := + match Eval.releaseShared 1000 result.store result.value with + | .ok (store, _) => store.live == 0 + | .error _ => false + +private def terminalCounterLaw (logical physical : Eval.Result) : Bool := + let left := logical.store.counters + let right := physical.store.counters + left.allocs == right.allocs + right.reuses && + left.frees == right.frees + right.reuses && + left.rcops == right.rcops && + logical.store.live == physical.store.live && + left.resetAttempts == right.resetAttempts && + left.hotResets == right.hotResets && + left.coldResets == right.coldResets + +private def expectedReport : Reuse.Report := + { scannedBlocks := 4 + shapeCandidates := 1 + rewritten := 1 + incompatibleLayouts := 0 + helperBlocks := 2 } + +def ternarySourceAddress : Address := Address.replicate 0xd6 +def ternaryAllocationAddress : Address := Address.replicate 0xd7 +def ternaryFunctionAddress : Address := Address.replicate 0xd8 +def ternaryLayout : LayoutId := Address.replicate 0xe6 + +def ternarySourceId : CtorId := + IxIR1.Lower.ctorIdOf ternarySourceAddress 0 + +def ternaryAllocationId : CtorId := + IxIR1.Lower.ctorIdOf ternaryAllocationAddress 0 + +private def ownedSharedParam : Param := + { world := .shared, passing := .owned } + +/-- A valid non-benchmark shape with three fields and the consumed source in +parameter register one. Allocation and tail arguments are both permuted. -/ +def ternaryBlock : Block := + { valueParams := #[.owned .shared, .owned .shared, .owned .shared] + creditParams := #[] + instructions := #[ + .fetch (.reg 1) ternarySourceId 0, + .fetch (.reg 1) ternarySourceId 1, + .fetch (.reg 1) ternarySourceId 2, + .retainShared (.reg 3), + .retainShared (.reg 4), + .retainShared (.reg 5), + .releaseShared (.reg 1), + .alloc .shared ternaryAllocationId #[.reg 8, .reg 0, .reg 6]] + terminator := .tailCallSelf #[.reg 2, .reg 9, .reg 7] } + +def ternaryFunction : Function := + { signature := + { params := #[ownedSharedParam, ownedSharedParam, ownedSharedParam] + result := .shared + papSafe := false } + blocks := #[ternaryBlock] } + +private def trivialMain : Function := + { signature := { params := #[], result := .shared, papSafe := false } + blocks := #[ + { valueParams := #[] + creditParams := #[] + instructions := #[.alloc .shared nilId #[]] + terminator := .ret (.reg 0) }] } + +def ternaryProgram : Program := + { declarations := [(ternaryFunctionAddress, .fn ternaryFunction)] + main := trivialMain } + +def ternaryContext : Validate.Context := + { schemas := fun world identity => + if world != .shared then none + else if identity == ternarySourceId then + some { layout := ternaryLayout, + fields := #[.shared, .shared, .shared] } + else if identity == ternaryAllocationId then + some { layout := ternaryLayout, + fields := #[.shared, .shared, .shared] } + else if identity == nilId then + some { layout := nilLayout, fields := #[] } + else + none } + +/-- The generalized matcher consumes checked liveness and preserves register +meaning across a nonzero source parameter, three fields, and permutations. -/ +def generalizedShapeAccepted : Bool := + match Reuse.optimize ternaryContext ternaryProgram with + | .error _ => false + | .ok output => + output.report == + { scannedBlocks := 2 + shapeCandidates := 1 + rewritten := 1 + helperBlocks := 2 } && + match output.target.declarations with + | [(_, .fn definition)] => + match definition.blocks[0]?, definition.blocks[1]?, + definition.blocks[2]? with + | some reset, some hot, some cold => + reset.instructions == #[ + .resetShared (.reg 1) ternarySourceId] && + reset.terminator == .branchCredit 0 + { target := 1 + values := #[.reg 3, .reg 4, .reg 5, .reg 0, .reg 2] + credits := #[0] } + { target := 2 + values := #[.reg 3, .reg 4, .reg 5, .reg 0, .reg 2] + credits := #[0] } && + hot.valueParams == Array.replicate 5 (.owned .shared) && + hot.creditParams == #[.required ternaryLayout] && + hot.instructions == #[ + .allocWith 0 .shared ternaryAllocationId + #[.reg 2, .reg 3, .reg 0]] && + hot.terminator == .tailCallSelf #[.reg 4, .reg 5, .reg 1] && + cold.valueParams == hot.valueParams && + cold.creditParams == #[.optional ternaryLayout] && + cold.instructions == hot.instructions && + cold.terminator == hot.terminator + | _, _, _ => false + | _ => false + +def ternaryRewrite : + Reuse.FunctionRewrite Validate.defaultLimits ternaryContext ternaryFunction := + Reuse.rewriteFunction Validate.defaultLimits ternaryContext ternaryFunction + +/-- The proof-facing traversal retains an accepted dependent site for the +generalized three-field block, not merely a positive report counter. The +general `FunctionRewrite.acceptedAt` theorem turns this constructor into exact +reset/hot/cold target-block lookups. -/ +def generalizedDecisionTraceAccepted : Bool := + match ternaryRewrite.decisions with + | .cons (.accepted _) .nil => true + | _ => false + +/-- Even a syntactic prefix is left untouched when its source appears after +the proposed release. This exercises the liveness gate independently of the +whole-program validator, which would also reject this malformed ownership +flow. -/ +def lateSourceUseRejected : Bool := + let lateBlock : Block := + { ternaryBlock with + terminator := .tailCallSelf #[.reg 1, .reg 9, .reg 7] } + let lateFunction : Function := + { ternaryFunction with blocks := #[lateBlock] } + let source : Program := + { ternaryProgram with declarations := + [(ternaryFunctionAddress, .fn lateFunction)] } + let rewrite := Reuse.rewriteProgram ternaryContext source + rewrite.program == source && + rewrite.report == + { scannedBlocks := 2 + shapeCandidates := 1 + livenessRejected := 1 } + +/-- Structural evidence that the optimizer consumed the baseline compiler +shape and emitted the optional-credit diamond, rather than benchmarking a +prewritten reset program. -/ +def compilerShapeAndDiamond (compiled : Compiled source) : Bool := + let baselineShape := + match compiled.baseline.artifact.program.declarations.find? fun entry => + entry.1 == reverseAddress with + | some (_, .fn definition) => + match definition.blocks[2]? with + | some block => + block.instructions == #[ + .fetch (.reg 0) consId 0, + .fetch (.reg 0) consId 1, + .retainShared (.reg 2), + .retainShared (.reg 3), + .releaseShared (.reg 0), + .alloc .shared consId #[.reg 4, .reg 1]] && + block.terminator == .tailCallSelf #[.reg 6, .reg 5] + | none => false + | _ => false + let targetShape := + match compiled.optimized.target.declarations.find? fun entry => + entry.1 == reverseAddress with + | some (_, .fn definition) => + match definition.blocks[2]?, definition.blocks[3]?, + definition.blocks[4]? with + | some reset, some hot, some cold => + reset.instructions == #[.resetShared (.reg 0) consId] && + reset.terminator == .branchCredit 0 + { target := 3 + values := #[.reg 2, .reg 3, .reg 1] + credits := #[0] } + { target := 4 + values := #[.reg 2, .reg 3, .reg 1] + credits := #[0] } && + hot.creditParams == #[.required consLayout] && + hot.instructions == #[ + .allocWith 0 .shared consId #[.reg 0, .reg 2]] && + cold.creditParams == #[.optional consLayout] && + cold.instructions == #[ + .allocWith 0 .shared consId #[.reg 0, .reg 2]] + | _, _, _ => false + | _ => false + baselineShape && targetShape && + compiled.optimized.report == expectedReport && + let rerun := Reuse.rewriteProgram + compiled.baseline.artifact.validationContext compiled.optimized.target + rerun.program == compiled.optimized.target && rerun.report.rewritten == 0 + +private def runTargets (compiled : Compiled source) : + Except Eval.Error (Eval.Result × Eval.Result × Eval.Result) := do + let baselineProgram := compiled.baseline.artifact.program + let context := compiled.baseline.artifact.validationContext + let optimizedProgram := compiled.optimized.target + let baseline ← Eval.runMain (targetContext context baselineProgram) + .logical baselineProgram 100 100 + let logical ← Eval.runMain (targetContext context optimizedProgram) + .logical optimizedProgram 100 100 + let physical ← Eval.runMain (targetContext context optimizedProgram) + .physical optimizedProgram 100 100 + return (baseline, logical, physical) + +/-- Hot-path benchmark: source/baseline/logical/physical results all reverse +the list, all returned heaps reclaim fully, and the physical loop turns all +three replacement allocations into reuse. -/ +def unaliasedBenchmark : Bool := + match sourceContext.run unaliasedMain 1000, compile unaliasedMain with + | .ok source, .ok compiled => + compilerShapeAndDiamond compiled && + match runTargets compiled with + | .ok (baseline, logical, physical) => + sourceNats? 100 source == some [3, 2, 1] && + targetNats? 100 baseline.store baseline.value == + some [3, 2, 1] && + targetNats? 100 logical.store logical.value == + some [3, 2, 1] && + targetNats? 100 physical.store physical.value == + some [3, 2, 1] && + baseline.store.counters.allocs == 8 && + baseline.store.counters.reuses == 0 && + baseline.store.counters.frees == 4 && + baseline.store.counters.rcops == 10 && + baseline.store.counters.resetAttempts == 0 && + baseline.store.peakLiveNodes == 5 && + logical.store.counters.allocs == 8 && + logical.store.counters.reuses == 0 && + logical.store.counters.frees == 4 && + logical.store.counters.rcops == 1 && + physical.store.counters.allocs == 5 && + physical.store.counters.reuses == 3 && + physical.store.counters.frees == 1 && + physical.store.counters.rcops == 1 && + physical.store.counters.resetAttempts == 3 && + physical.store.counters.hotResets == 3 && + physical.store.counters.coldResets == 0 && + physical.store.counters.reusedPayloadUnits == 6 && + physical.store.peakLiveNodes == 5 && + terminalCounterLaw logical physical && + released baseline && released logical && released physical + | .error _ => false + | _, _ => false + +/-- Cold-path benchmark: retaining the original list makes every attempt +cold. The rewritten program allocates exactly as much as the baseline, +returns both lists unchanged, and fully reclaims both result graphs. -/ +def aliasedBenchmark : Bool := + match sourceContext.run aliasedMain 1000, compile aliasedMain with + | .ok source, .ok compiled => + compilerShapeAndDiamond compiled && + match runTargets compiled with + | .ok (baseline, logical, physical) => + sourcePair? 100 source == some ([3, 2, 1], [1, 2, 3]) && + targetPair? 100 baseline.store baseline.value == + some ([3, 2, 1], [1, 2, 3]) && + targetPair? 100 logical.store logical.value == + some ([3, 2, 1], [1, 2, 3]) && + targetPair? 100 physical.store physical.value == + some ([3, 2, 1], [1, 2, 3]) && + baseline.store.counters.allocs == 9 && + baseline.store.counters.reuses == 0 && + baseline.store.counters.frees == 0 && + baseline.store.counters.rcops == 8 && + baseline.store.counters.resetAttempts == 0 && + baseline.store.peakLiveNodes == 9 && + logical.store.counters.allocs == 9 && + logical.store.counters.reuses == 0 && + logical.store.counters.frees == 0 && + logical.store.counters.rcops == 8 && + physical.store.counters.allocs == baseline.store.counters.allocs && + physical.store.counters.reuses == 0 && + physical.store.counters.frees == 0 && + physical.store.counters.rcops == 8 && + physical.store.counters.resetAttempts == 3 && + physical.store.counters.hotResets == 0 && + physical.store.counters.coldResets == 3 && + physical.store.peakLiveNodes == 9 && + terminalCounterLaw logical physical && + released baseline && released logical && released physical + | .error _ => false + | _, _ => false + +private def zeroFieldChildAddress : Address := Address.replicate 0xd9 + +/-- The nil branch has no generated fetches. Its accepted prefix instead +consumes the second inherited parameter; the recursive call swaps the result +into the scrutinee position and exits through the cons branch. -/ +private def zeroFieldChildBody : IxIR1.Code := + .case (.var 0) false #[ + .mk 0 0 + (.letOp (.fetch (.var 1) 0) + (.letOp (.fetch (.var 2) 1) + (.letOp (.dup (.var 1)) + (.letOp (.dup (.var 1)) + (.letOp (.drop (.var 5)) + (.letOp (.alloc .shared consId #[.var 2, .var 1]) + (.letOp (.callSelf #[.var 6, .var 0]) + (.ret (.var 0))))))))), + .mk 1 2 (.letOp (.drop (.var 3)) (.ret (.var 3)))] + +private def zeroFieldChildMain (aliased : Bool) : IxIR1.Code := + .letOp (.alloc .shared nilId #[]) + (.letOp (.alloc .shared nilId #[]) + (.letOp (.alloc .shared consId #[.lit (.nat 42), .var 0]) + (if aliased then + .letOp (.dup (.var 0)) + (.letOp (.call zeroFieldChildAddress #[.var 0, .var 3]) + (.letOp (.alloc .shared pairId #[.var 0, .var 2]) + (.ret (.var 0)))) + else + .letOp (.call zeroFieldChildAddress #[.var 0, .var 2]) + (.ret (.var 0))))) + +private def zeroFieldChildInput (aliased : Bool) : Lower.Input := + { declarations := + [(zeroFieldChildAddress, + .fn { arity := 2, result := .shared, papSafe := false, + body := zeroFieldChildBody })] + main := zeroFieldChildMain aliased + mainResult := .shared } + +private def zeroFieldChildContext : Lower.Context := + { loweringContext with + parameterWorlds := fun address => + if address == zeroFieldChildAddress then some #[.shared, .shared] + else none + fetchCtor := fun site => + if site.owner == .declaration zeroFieldChildAddress && + site.branches == [0] && site.offset < 2 then some consId + else none } + +/-- This bounded fixture starts at IxIR₁. Both compiler checks and the reuse +validator must accept its empty generated prologue before runtime comparison. -/ +private def zeroFieldChildCompile (aliased : Bool) : Except CompileError + (Sigma fun baseline : Lower.Checked => + Reuse.Output Validate.defaultLimits baseline.artifact.validationContext + baseline.artifact.program) := do + let baseline ← (Lower.lowerChecked zeroFieldChildContext + (zeroFieldChildInput aliased)).mapError CompileError.baseline + let optimized ← (Reuse.optimize baseline.artifact.validationContext + baseline.artifact.program).mapError CompileError.reuse + return ⟨baseline, optimized⟩ + +private def zeroFieldChildShape (baseline : Lower.Checked) + (optimized : Reuse.Output Validate.defaultLimits + baseline.artifact.validationContext baseline.artifact.program) : Bool := + optimized.report == expectedReport && + match baseline.artifact.trace.functions.find? (fun trace => + trace.owner == .declaration zeroFieldChildAddress), + optimized.target.declarations.find? (fun entry => + entry.1 == zeroFieldChildAddress) with + | some trace, some (_, .fn definition) => + trace.root.switchBranchesMatch && + match trace.root, definition.blocks[1]? with + | .switchValue _ _ _ _ _ _ _ _ parent _ children, some reset => + (match parent.terminator, children[0]? with + | .switchValue _ alternatives _, some child => + child.targetPosition == .instruction 0 && child.headBlock.1 == 1 && + (match alternatives[0]? with + | some alternative => alternative.cid == nilId && + alternative.edge.target == 1 + | none => false) && + child.headBlock.2.instructions[0]? == + some (.fetch (.reg 1) consId 0) + | _, _ => false) && + reset.instructions == #[.resetShared (.reg 1) consId] + | _, _ => false + | _, _ => false + +/-- Empty constructor prologues can lead to hot or cold reuse of a different +inherited node. Compare both observations and reclaim every returned heap. -/ +def zeroFieldChildBenchmark (aliased : Bool) : Bool := + match zeroFieldChildCompile aliased with + | .error _ => false + | .ok ⟨baseline, optimized⟩ => + zeroFieldChildShape baseline optimized && + let baselineProgram := baseline.artifact.program + let context := baseline.artifact.validationContext + match Eval.runMain (targetContext context baselineProgram) + .physical baselineProgram 100 100, + Eval.runMain (targetContext context optimized.target) + .logical optimized.target 100 100, + Eval.runMain (targetContext context optimized.target) + .physical optimized.target 100 100 with + | .ok baseline, .ok logical, .ok physical => + let observed (result : Eval.Result) := + if aliased then + targetPair? 100 result.store result.value == + some ([42], [42]) + else + targetNats? 100 result.store result.value == some [42] + observed baseline && observed logical && observed physical && + baseline.store.counters.allocs == (if aliased then 5 else 4) && + baseline.store.counters.resetAttempts == 0 && + physical.store.counters.allocs == (if aliased then 5 else 3) && + physical.store.counters.reuses == (if aliased then 0 else 1) && + physical.store.counters.resetAttempts == 1 && + physical.store.counters.hotResets == (if aliased then 0 else 1) && + physical.store.counters.coldResets == (if aliased then 1 else 0) && + terminalCounterLaw logical physical && + released baseline && released logical && released physical + | _, _, _ => false + +private def incompatibleProgram (program : Program) : Program := + { program with + declarations := program.declarations.map fun entry => + if entry.1 != reverseAddress then entry + else + match entry.2 with + | .extern _ => entry + | .fn definition => + match definition.blocks[2]? with + | none => entry + | some block => + let instructions := block.instructions.setIfInBounds 5 + (.alloc .shared otherConsId #[.reg 4, .reg 1]) + let replacement : Block := { block with instructions } + (entry.1, .fn { definition with blocks := + definition.blocks.setIfInBounds 2 replacement }) } + +/-- Exact layout identity is a hard gate. A separately valid same-arity +allocation with another layout is reported and left structurally unchanged; +the validator is run on both sides of that no-op result. -/ +def incompatibleLayoutRejected : Bool := + match compile unaliasedMain with + | .error _ => false + | .ok compiled => + let source := incompatibleProgram compiled.baseline.artifact.program + let baselineContext := compiled.baseline.artifact.validationContext + let context : Validate.Context := + { baselineContext with + schemas := fun world identity => + if world == .shared && identity == otherConsId then + some { layout := otherConsLayout, + fields := #[.shared, .shared] } + else + baselineContext.schemas world identity } + match Reuse.optimize context source with + | .error _ => false + | .ok output => + output.target == source && + output.report == + { scannedBlocks := 4 + shapeCandidates := 1 + rewritten := 0 + incompatibleLayouts := 1 + helperBlocks := 0 } + +private def relayAddress : Address := Address.replicate 0xda +private def relayFactoryAddress : Address := Address.replicate 0xdb +private def factoryFactoryAddress : Address := Address.replicate 0xdc + +/-- Small IxIR₁ adapters around the IxIR₀-derived reversal. Saturating the +relay enters an addressed tail call, followed by reversal's self tail calls. +The two factories add nested over-application before reaching that relay. -/ +private def papReturnDeclarations : List (Address × IxIR1.Decl) := + [(relayAddress, .fn + { arity := 2, result := .shared, papSafe := true + body := .letOp (.call reverseAddress #[.var 1, .var 0]) + (.ret (.var 0)) }), + (relayFactoryAddress, .fn + { arity := 1, result := .shared, papSafe := true + body := .letOp (.papp relayAddress #[.var 0]) (.ret (.var 0)) }), + (factoryFactoryAddress, .fn + { arity := 1, result := .shared, papSafe := true + body := .letOp (.drop (.var 0)) + (.letOp (.papp relayFactoryAddress #[]) (.ret (.var 0))) })] + +private def papReturnMain (overApplied aliased : Bool) : IxIR1.Code := + let finish := if aliased then + .letOp (.alloc .shared pairId #[.var 0, .var 3]) (.ret (.var 0)) + else .ret (.var 0) + let application := if overApplied then + .letOp (.papp factoryFactoryAddress #[]) + (.letOp (.apply (.var 0) + #[.erased, .var (if aliased then 6 else 5), .var 1]) finish) + else + .letOp (.papp relayAddress #[.var (if aliased then 5 else 4)]) + (.letOp (.apply (.var 0) #[.var 1]) finish) + .letOp (.alloc .shared nilId #[]) + (.letOp (.alloc .shared nilId #[]) + (.letOp (.alloc .shared consId #[.lit (.nat 3), .var 0]) + (.letOp (.alloc .shared consId #[.lit (.nat 2), .var 0]) + (.letOp (.alloc .shared consId #[.lit (.nat 1), .var 0]) + (if aliased then .letOp (.dup (.var 0)) application + else application))))) + +private def papReturnCompile (overApplied aliased : Bool) : Except CompileError + (Sigma fun baseline : Lower.Checked => + Reuse.Output Validate.defaultLimits baseline.artifact.validationContext + baseline.artifact.program) := do + let (declarations, _) ← (IxIR1.Lower.lowerAll sourceDeclarations unaliasedMain + .shared).mapError CompileError.ixir1 + let context : Lower.Context := + { loweringContext with + parameterWorlds := fun address => + if address == relayAddress then some #[.shared, .shared] + else if address == relayFactoryAddress || address == factoryFactoryAddress + then some #[.shared] + else loweringContext.parameterWorlds address } + let baseline ← (Lower.lowerChecked context + { declarations := papReturnDeclarations ++ declarations + main := papReturnMain overApplied aliased + mainResult := .shared }).mapError CompileError.baseline + let optimized ← (Reuse.optimize baseline.artifact.validationContext + baseline.artifact.program).mapError CompileError.reuse + return ⟨baseline, optimized⟩ + +/-- A PAP caller survives both kinds of tail call and, optionally, nested +over-application. Every route compares all target interpretations, pins the +PAP ownership overhead, and fully reclaims both the result and any alias. -/ +def papTailReturnBenchmark (overApplied aliased : Bool) : Bool := + match papReturnCompile overApplied aliased with + | .error _ => false + | .ok ⟨baseline, optimized⟩ => + let baselineProgram := baseline.artifact.program + let context := baseline.artifact.validationContext + let relayTail := match baselineProgram.declarations.find? (fun entry => + entry.1 == relayAddress) with + | some (_, .fn definition) => + match definition.blocks[0]? with + | some block => block.instructions.isEmpty && + block.terminator == .tailCall reverseAddress #[.reg 0, .reg 1] + | none => false + | _ => false + relayTail && optimized.report == { expectedReport with scannedBlocks := 7 } && + match Eval.runMain (targetContext context baselineProgram) + .logical baselineProgram 1000 1000, + Eval.runMain (targetContext context baselineProgram) + .physical baselineProgram 1000 1000, + Eval.runMain (targetContext context optimized.target) + .logical optimized.target 1000 1000, + Eval.runMain (targetContext context optimized.target) + .physical optimized.target 1000 1000 with + | .ok baselineLogical, .ok baselinePhysical, .ok logical, .ok physical => + let observed := fun result : Eval.Result => + if aliased then targetPair? 100 result.store result.value == + some ([3, 2, 1], [1, 2, 3]) + else targetNats? 100 result.store result.value == some [3, 2, 1] + let papCount := if overApplied then 3 else 1 + let papRCOps := if overApplied then 5 else 3 + observed baselineLogical && observed baselinePhysical && + observed logical && observed physical && + baselineLogical.store.counters == baselinePhysical.store.counters && + baselinePhysical.store.counters.allocs == + (if aliased then 9 else 8) + papCount && + baselinePhysical.store.counters.frees == + (if aliased then 0 else 4) + papCount && + baselinePhysical.store.counters.rcops == + (if aliased then 8 else 10) + papRCOps && + physical.store.counters.allocs == + (if aliased then 9 else 5) + papCount && + physical.store.counters.frees == + (if aliased then 0 else 1) + papCount && + physical.store.counters.rcops == + (if aliased then 8 else 1) + papRCOps && + physical.store.counters.reuses == (if aliased then 0 else 3) && + physical.store.counters.hotResets == (if aliased then 0 else 3) && + physical.store.counters.coldResets == (if aliased then 3 else 0) && + terminalCounterLaw logical physical && + released baselineLogical && released baselinePhysical && + released logical && released physical + | _, _, _, _ => false + +#guard papTailReturnBenchmark false false +#guard papTailReturnBenchmark false true +#guard papTailReturnBenchmark true false +#guard papTailReturnBenchmark true true +#guard zeroFieldChildBenchmark false +#guard zeroFieldChildBenchmark true +#guard unaliasedBenchmark +#guard aliasedBenchmark +#guard incompatibleLayoutRejected +#guard generalizedShapeAccepted +#guard generalizedDecisionTraceAccepted +#guard lateSourceUseRejected + +private def returnedPapAddress : Address := Address.replicate 0xdd +private def terminalFactoryAddress : Address := Address.replicate 0xde + +/-- Small hand-written IxIR₁ functions force the two immediate residual +dispatcher outcomes: erased return or a PAP which still needs one argument. -/ +private def terminalReturnCompile (underApplied : Bool) : Except CompileError + (Sigma fun baseline : Lower.Checked => + Reuse.Output Validate.defaultLimits baseline.artifact.validationContext + baseline.artifact.program) := do + let returnedFunction : IxIR1.FnDef := + { arity := 3, result := .shared, papSafe := true + body := .letOp (.drop (.var 2)) + (.letOp (.drop (.var 2)) (.ret (.var 2))) } + let factory : IxIR1.FnDef := + { arity := 1, result := .shared, papSafe := true + body := if underApplied then + .letOp (.papp returnedPapAddress #[.var 0]) (.ret (.var 0)) + else .letOp (.drop (.var 0)) (.ret .erased) } + let context : Lower.Context := + { loweringContext with + parameterWorlds := fun address => + if address == terminalFactoryAddress then some #[.shared] + else if address == returnedPapAddress then some #[.shared, .shared, .shared] + else none } + let baseline ← (Lower.lowerChecked context + { declarations := [(terminalFactoryAddress, .fn factory), + (returnedPapAddress, .fn returnedFunction)] + main := .letOp (.alloc .shared nilId #[]) + (.letOp (.alloc .shared nilId #[]) + (.letOp (.papp terminalFactoryAddress #[]) + (.letOp (.apply (.var 0) #[.var 2, .var 1]) (.ret (.var 0))))) + mainResult := .shared }).mapError CompileError.baseline + let optimized ← (Reuse.optimize baseline.artifact.validationContext + baseline.artifact.program).mapError CompileError.reuse + return ⟨baseline, optimized⟩ + +private def terminalReturnObserved (underApplied : Bool) (result : Eval.Result) : Bool := + if !underApplied then result.value == .erased + else match result.value with + | .loc location => match result.store.get? location with + | some ⟨.shared, 1, .papN address 3 captured⟩ => + address == returnedPapAddress && captured.size == 2 && + captured[0]? != captured[1]? && captured.all (fun value => + match value with + | .loc child => match result.store.get? child with + | some ⟨.shared, 1, .ctorN identity fields⟩ => + identity == nilId && fields.isEmpty + | _ => false + | _ => false) + | _ => false + | _ => false + +/-- Residual application releases every erased argument or retains two +distinct captured owners in an extended PAP. All four interpretations agree +on the result, exact ownership overhead, and complete final reclamation. -/ +def immediateApplyMoreBenchmark (underApplied : Bool) : Bool := + match terminalReturnCompile underApplied with + | .error _ => false + | .ok ⟨baseline, optimized⟩ => + let baselineProgram := baseline.artifact.program + let context := baseline.artifact.validationContext + match Eval.runMain (targetContext context baselineProgram) + .logical baselineProgram 100 100, + Eval.runMain (targetContext context baselineProgram) + .physical baselineProgram 100 100, + Eval.runMain (targetContext context optimized.target) + .logical optimized.target 100 100, + Eval.runMain (targetContext context optimized.target) + .physical optimized.target 100 100 with + | .ok baselineLogical, .ok baselinePhysical, .ok logical, .ok physical => + optimized.report.rewritten == 0 && + ([baselineLogical, baselinePhysical, logical, physical].all fun result => + terminalReturnObserved underApplied result && released result && + result.store.counters.allocs == (if underApplied then 5 else 3) && + result.store.counters.frees == (if underApplied then 2 else 3) && + result.store.counters.rcops == (if underApplied then 4 else 3) && + result.store.live == (if underApplied then 3 else 0)) && + baselineLogical.store.counters == baselinePhysical.store.counters && + terminalCounterLaw logical physical + | _, _, _, _ => false + +/-- The normal selector uses the validated rewrite; constraining the number +of blocks to the baseline's three forces a real target-validation rejection +and executes the unchanged checked baseline with an explicit skip report. -/ +def productionSelectionBenchmark (fallback : Bool) : Bool := + match compile unaliasedMain with + | .error _ => false + | .ok compiled => + let source := compiled.baseline.artifact.program + let context := compiled.baseline.artifact.validationContext + let limits : Validate.Limits := + if fallback then { maxBlocksPerFunction := 3 } else Validate.defaultLimits + match Reuse.selectWith limits context source with + | .error _ => false + | .ok selected => + let expected : Reuse.SelectionReport := if fallback then + .skipped (.limit { owner := .declaration reverseAddress, block := 0 } + .blocksPerFunction 5 3) + else .applied expectedReport + selected.report == expected && + selected.target == (if fallback then source else compiled.optimized.target) && + match Eval.runMain (targetContext context selected.target) + .physical selected.target 1000 1000 with + | .error _ => false + | .ok result => + targetNats? 100 result.store result.value == some [3, 2, 1] && + result.store.counters.allocs == (if fallback then 8 else 5) && + result.store.counters.reuses == (if fallback then 0 else 3) && + released result + +/-- The production selector never turns rejected source input into a +successful baseline selection. -/ +def productionSelectionRejectsSource : Bool := + match compile unaliasedMain with + | .error _ => false + | .ok compiled => + match Reuse.selectWith { maxBlocksPerFunction := 0 } + compiled.baseline.artifact.validationContext + compiled.baseline.artifact.program with + | .error (.invalidSource error) => + error == .limit { owner := .declaration reverseAddress, block := 0 } + .blocksPerFunction 3 0 + | _ => false + +#guard immediateApplyMoreBenchmark false +#guard immediateApplyMoreBenchmark true +#guard productionSelectionBenchmark false +#guard productionSelectionBenchmark true +#guard productionSelectionRejectsSource + + +/-- Proof-carrying result of an ordinary executable benchmark check. -/ +structure CheckedBenchmark (benchmark : Bool) : Type where + accepted : benchmark = true + +def checkBenchmark (name : String) (benchmark : Bool) : + Except String (CheckedBenchmark benchmark) := + if accepted : benchmark = true then + .ok { accepted } + else + .error s!"{name} failed" + +def checkUnaliased : Except String (CheckedBenchmark unaliasedBenchmark) := + checkBenchmark "all-hot compiler-emitted reversal" unaliasedBenchmark + +def checkAliased : Except String (CheckedBenchmark aliasedBenchmark) := + checkBenchmark "all-cold compiler-emitted reversal" aliasedBenchmark + +def checkPapTailReturn (overApplied aliased : Bool) : + Except String (CheckedBenchmark (papTailReturnBenchmark overApplied aliased)) := + checkBenchmark + s!"PAP return through addressed/self tail calls (over={overApplied}, alias={aliased})" + (papTailReturnBenchmark overApplied aliased) + +def checkImmediateApplyMore (underApplied : Bool) : + Except String (CheckedBenchmark (immediateApplyMoreBenchmark underApplied)) := + checkBenchmark s!"immediate residual application (under={underApplied})" + (immediateApplyMoreBenchmark underApplied) + +def checkProductionSelection (fallback : Bool) : + Except String (CheckedBenchmark (productionSelectionBenchmark fallback)) := + checkBenchmark s!"production reuse selection (fallback={fallback})" + (productionSelectionBenchmark fallback) + +def checkProductionSourceRejection : + Except String (CheckedBenchmark productionSelectionRejectsSource) := + checkBenchmark "production reuse preserves source rejection" productionSelectionRejectsSource + +def checkZeroFieldChild (aliased : Bool) : + Except String (CheckedBenchmark (zeroFieldChildBenchmark aliased)) := + checkBenchmark (if aliased then "cold reuse after an empty constructor prologue" + else "hot reuse after an empty constructor prologue") + (zeroFieldChildBenchmark aliased) + +def checkIncompatibleLayout : + Except String (CheckedBenchmark incompatibleLayoutRejected) := + checkBenchmark "incompatible-layout rejection" incompatibleLayoutRejected + +def checkGeneralizedShape : + Except String (CheckedBenchmark generalizedShapeAccepted) := + checkBenchmark "generalized checked-liveness reuse shape" + generalizedShapeAccepted + +def checkLateSourceUse : + Except String (CheckedBenchmark lateSourceUseRejected) := + checkBenchmark "post-release source-use rejection" lateSourceUseRejected + +end Ix.Compiler.IxIR2.Reuse.Examples diff --git a/Ix/Compiler/IxIR2/ReuseHeapMap.lean b/Ix/Compiler/IxIR2/ReuseHeapMap.lean new file mode 100644 index 000000000..b729834b4 --- /dev/null +++ b/Ix/Compiler/IxIR2/ReuseHeapMap.lean @@ -0,0 +1,274 @@ +import Ix.Compiler.IxIR2.ReservationHeap + +/-! +# Allocation history for suspended reuse + +The map retains every baseline allocation, including dead registers in saved +callers. Physical reuse may give a dead allocation and a later allocation the +same image. Injectivity is required only for currently live baseline nodes. +This keeps saved registers stable while reserving and later refilling a slot. +-/ + +namespace Ix.Compiler.IxIR2.CallReuse.Sim + +open Ix.Compiler.IxIR2.Eval +open Ix.Compiler.IxIR1.Sim (NodeBoxIso RValIso RValsIso) + +def MapRel (mapping : Array Nat) (left right : Nat) : Prop := mapping[left]? = some right + +theorem MapRel.functional {mapping : Array Nat} {left first second : Nat} + (one : MapRel mapping left first) (two : MapRel mapping left second) : first = second := + Option.some.inj (one.symm.trans two) + +theorem MapRel.bound {mapping : Array Nat} {left right : Nat} + (related : MapRel mapping left right) : left < mapping.size := + (Array.getElem?_eq_some_iff.mp related).1 + +theorem MapRel.push {mapping : Array Nat} {left right : Nat} + (related : MapRel mapping left right) (location : Nat) : + MapRel (mapping.push location) left right := by + simpa only [MapRel, Array.getElem?_push_lt related.bound, + Array.getElem?_eq_getElem related.bound] using related + +theorem MapRel.fresh (mapping : Array Nat) (location : Nat) : + MapRel (mapping.push location) mapping.size location := Array.getElem?_push_size + +structure HeapMap (left right : Store) (mapping : Array Nat) : Prop where + size : mapping.size = left.heap.nodes.size + imageBound : ∀ {l r}, MapRel mapping l r → r < right.heap.nodes.size + forward : ∀ {l r box}, MapRel mapping l r → left.get? l = some box → + ∃ targetBox, right.get? r = some targetBox ∧ NodeBoxIso (MapRel mapping) box targetBox + injectiveLive : ∀ {first second target firstBox secondBox}, + MapRel mapping first target → MapRel mapping second target → + left.get? first = some firstBox → left.get? second = some secondBox → first = second + backward : ∀ {r box}, right.get? r = some box → + ∃ l sourceBox, MapRel mapping l r ∧ left.get? l = some sourceBox + +namespace HeapMap + +theorem empty : HeapMap ({} : Store) ({} : Store) #[] := by + constructor + · rfl + · intro l r related; simp [MapRel] at related + · intro l r box related; simp [MapRel] at related + · intro l k r box other related; simp [MapRel] at related + · intro r box found; simp [Store.get?, IxIR1.Store.get?] at found + +theorem left_total {left right : Store} {mapping : Array Nat} + (heap : HeapMap left right mapping) {location : Nat} {box : NodeBox} + (found : left.get? location = some box) : ∃ target, MapRel mapping location target := by + have bound := (Array.getElem?_eq_some_iff.mp (IxIR1.Sim.nodes_get?_of_get? found)).1 + rw [← heap.size] at bound + exact ⟨mapping[location], Array.getElem?_eq_getElem bound⟩ + +theorem get {left right : Store} {mapping : Array Nat} + (heap : HeapMap left right mapping) {location : Nat} {box : NodeBox} + (found : left.get? location = some box) : + ∃ target targetBox, MapRel mapping location target ∧ right.get? target = some targetBox ∧ + NodeBoxIso (MapRel mapping) box targetBox := by + obtain ⟨target, mapped⟩ := heap.left_total found + obtain ⟨targetBox, targetAt, boxes⟩ := heap.forward mapped found + exact ⟨target, targetBox, mapped, targetAt, boxes⟩ + +theorem different_images {left right : Store} {mapping : Array Nat} + (heap : HeapMap left right mapping) {first second x y : Nat} {a b : NodeBox} + (one : MapRel mapping first x) (two : MapRel mapping second y) + (firstAt : left.get? first = some a) (secondAt : left.get? second = some b) + (different : first ≠ second) : x ≠ y := by + intro same + exact different (heap.injectiveLive one (same ▸ two) firstAt secondAt) + +theorem congr {left right left' right' : Store} {mapping : Array Nat} + (heap : HeapMap left right mapping) + (leftNodes : left'.heap.nodes = left.heap.nodes) + (rightNodes : right'.heap.nodes = right.heap.nodes) : HeapMap left' right' mapping := by + have leftGet : ∀ location, left'.get? location = left.get? location := by + intro location; simp only [Store.get?, IxIR1.Store.get?, leftNodes] + have rightGet : ∀ location, right'.get? location = right.get? location := by + intro location; simp only [Store.get?, IxIR1.Store.get?, rightNodes] + exact { + size := by simpa only [leftNodes] using heap.size + imageBound := fun related => by simpa only [rightNodes] using heap.imageBound related + forward := fun related found => by + rw [leftGet] at found + simpa only [rightGet] using heap.forward related found + injectiveLive := fun one two firstAt secondAt => by + rw [leftGet] at firstAt secondAt + exact heap.injectiveLive one two firstAt secondAt + backward := fun found => by + rw [rightGet] at found + simpa only [leftGet] using heap.backward found } + +end HeapMap + +inductive SlotIso (mapping : Array Nat) : Option NodeBox → Option NodeBox → Prop where + | absent : SlotIso mapping none none + | present {left right : NodeBox} (boxes : NodeBoxIso (MapRel mapping) left right) : + SlotIso mapping (some left) (some right) + +theorem SlotIso.left {mapping : Array Nat} {left right : Option NodeBox} {box : NodeBox} + (related : SlotIso mapping left right) (found : left = some box) : + ∃ target, right = some target ∧ NodeBoxIso (MapRel mapping) box target := by + cases related with + | absent => cases found + | present boxes => cases found; exact ⟨_, rfl, boxes⟩ + +theorem SlotIso.right {mapping : Array Nat} {left right : Option NodeBox} {box : NodeBox} + (related : SlotIso mapping left right) (found : right = some box) : + ∃ source, left = some source ∧ NodeBoxIso (MapRel mapping) source box := by + cases related with + | absent => cases found + | present boxes => cases found; exact ⟨_, rfl, boxes⟩ + +/-- Change corresponding live slots, or remove both. The history array stays +unchanged, so all saved registers keep their original correspondence. -/ +theorem HeapMap.replace {left right left' right' : Store} {mapping : Array Nat} + (heap : HeapMap left right mapping) {l r : Nat} {oldLeft : NodeBox} + {newLeft newRight : Option NodeBox} (mapped : MapRel mapping l r) + (leftAt : left.get? l = some oldLeft) + (slots : SlotIso mapping newLeft newRight) + (leftSize : left'.heap.nodes.size = left.heap.nodes.size) + (rightSize : right'.heap.nodes.size = right.heap.nodes.size) + (leftGet : ∀ location, left'.get? location = + if location = l then newLeft else left.get? location) + (rightGet : ∀ location, right'.get? location = + if location = r then newRight else right.get? location) : + HeapMap left' right' mapping := by + have oldLive {location : Nat} {box : NodeBox} (found : left'.get? location = some box) : + ∃ old, left.get? location = some old := by + by_cases same : location = l + · exact ⟨oldLeft, same ▸ leftAt⟩ + · exact ⟨box, by simpa only [leftGet, same, ↓reduceIte] using found⟩ + refine { + size := heap.size.trans leftSize.symm + imageBound := fun related => by rw [rightSize]; exact heap.imageBound related + forward := ?_ + injectiveLive := ?_ + backward := ?_ } + · intro source target box related found + by_cases same : source = l + · subst source + have targetEq := related.functional mapped + subst target + have newAt : newLeft = some box := by simpa only [leftGet, ↓reduceIte] using found + obtain ⟨targetBox, targetAt, boxes⟩ := slots.left newAt + exact ⟨targetBox, by simpa only [rightGet, ↓reduceIte] using targetAt, boxes⟩ + · have oldAt : left.get? source = some box := by + simpa only [leftGet, same, ↓reduceIte] using found + obtain ⟨targetBox, targetAt, boxes⟩ := heap.forward related oldAt + have different := heap.different_images related mapped oldAt leftAt same + exact ⟨targetBox, by simpa only [rightGet, different, ↓reduceIte] using targetAt, boxes⟩ + · intro first second target a b one two firstAt secondAt + obtain ⟨oldA, oldFirst⟩ := oldLive firstAt + obtain ⟨oldB, oldSecond⟩ := oldLive secondAt + exact heap.injectiveLive one two oldFirst oldSecond + · intro target box found + by_cases same : target = r + · subst target + have newAt : newRight = some box := by simpa only [rightGet, ↓reduceIte] using found + obtain ⟨sourceBox, sourceAt, _⟩ := slots.right newAt + exact ⟨l, sourceBox, mapped, by simpa only [leftGet, ↓reduceIte] using sourceAt⟩ + · have oldAt : right.get? target = some box := by + simpa only [rightGet, same, ↓reduceIte] using found + obtain ⟨source, sourceBox, related, sourceAt⟩ := heap.backward oldAt + have different : source ≠ l := by + intro equal + subst source + exact same (related.functional mapped) + exact ⟨source, sourceBox, related, + by simpa only [leftGet, different, ↓reduceIte] using sourceAt⟩ + +/-- Append a new baseline allocation and map it to either a fresh or a +reserved physical slot. Old history entries are retained, even when dead +entries already name this physical location. Live injectivity follows from +the physical slot's exclusion from the live heap before it is filled. -/ +theorem HeapMap.extend {left right left' right' : Store} {mapping : Array Nat} + (heap : HeapMap left right mapping) {target : Nat} {newLeft newRight : NodeBox} + (empty : right.get? target = none) + (boxes : NodeBoxIso (MapRel mapping) newLeft newRight) + (leftSize : left'.heap.nodes.size = left.heap.nodes.size + 1) + (rightSize : right.heap.nodes.size ≤ right'.heap.nodes.size) + (targetBound : target < right'.heap.nodes.size) + (leftGet : ∀ location, left'.get? location = + if location = left.heap.nodes.size then some newLeft else left.get? location) + (rightGet : ∀ location, right'.get? location = + if location = target then some newRight else right.get? location) : + HeapMap left' right' (mapping.push target) := by + have oldMap {l r : Nat} (related : MapRel (mapping.push target) l r) + (old : l ≠ mapping.size) : MapRel mapping l r := by + simpa only [MapRel, Array.getElem?_push, old, ↓reduceIte] using related + have freshMap {r : Nat} (related : MapRel (mapping.push target) mapping.size r) : + r = target := (related.functional (MapRel.fresh mapping target)) + have oldLive {l : Nat} {box : NodeBox} (found : left.get? l = some box) : + l ≠ left.heap.nodes.size := + Nat.ne_of_lt (Array.getElem?_eq_some_iff.mp (IxIR1.Sim.nodes_get?_of_get? found)).1 + have oldImage {l r : Nat} {box : NodeBox} (mapped : MapRel mapping l r) + (found : left.get? l = some box) : r ≠ target := by + obtain ⟨rightBox, rightAt, _⟩ := heap.forward mapped found + intro same + subst r + rw [empty] at rightAt + cases rightAt + have lift : ∀ {l r}, MapRel mapping l r → MapRel (mapping.push target) l r := + fun related => related.push target + refine { + size := by simp only [Array.size_push, heap.size, leftSize] + imageBound := ?_ + forward := ?_ + injectiveLive := ?_ + backward := ?_ } + · intro l r related + by_cases fresh : l = mapping.size + · subst l + rw [freshMap related] + exact targetBound + · exact Nat.lt_of_lt_of_le (heap.imageBound (oldMap related fresh)) rightSize + · intro l r box related found + by_cases fresh : l = mapping.size + · subst l + have boxEq : box = newLeft := by + simpa only [leftGet, heap.size, ↓reduceIte, Option.some.injEq] using found.symm + subst box + have targetEq := freshMap related + subst r + exact ⟨newRight, by simp only [rightGet, ↓reduceIte], boxes.mono lift⟩ + · have leftOld : l ≠ left.heap.nodes.size := by simpa only [heap.size] using fresh + have before : left.get? l = some box := by + simpa only [leftGet, leftOld, ↓reduceIte] using found + have mapped := oldMap related fresh + obtain ⟨rightBox, rightAt, boxes⟩ := heap.forward mapped before + have different := oldImage mapped before + exact ⟨rightBox, by simpa only [rightGet, different, ↓reduceIte] using rightAt, + boxes.mono lift⟩ + · intro first second r a b one two firstAt secondAt + by_cases firstFresh : first = mapping.size + · by_cases secondFresh : second = mapping.size + · exact firstFresh.trans secondFresh.symm + · have oldSecond : left.get? second = some b := by + simpa only [leftGet, ← heap.size, secondFresh, ↓reduceIte] using secondAt + have impossible := oldImage (oldMap two secondFresh) oldSecond + subst first + exact False.elim (impossible (freshMap one)) + · by_cases secondFresh : second = mapping.size + · have oldFirst : left.get? first = some a := by + simpa only [leftGet, ← heap.size, firstFresh, ↓reduceIte] using firstAt + have impossible := oldImage (oldMap one firstFresh) oldFirst + subst second + exact False.elim (impossible (freshMap two)) + · have oldFirst : left.get? first = some a := by + simpa only [leftGet, ← heap.size, firstFresh, ↓reduceIte] using firstAt + have oldSecond : left.get? second = some b := by + simpa only [leftGet, ← heap.size, secondFresh, ↓reduceIte] using secondAt + exact heap.injectiveLive (oldMap one firstFresh) (oldMap two secondFresh) oldFirst oldSecond + · intro r box found + by_cases fresh : r = target + · subst r + exact ⟨mapping.size, newLeft, MapRel.fresh mapping target, + by simp only [leftGet, heap.size, ↓reduceIte]⟩ + · have before : right.get? r = some box := by + simpa only [rightGet, fresh, ↓reduceIte] using found + obtain ⟨l, leftBox, related, leftAt⟩ := heap.backward before + exact ⟨l, leftBox, related.push target, + by simpa only [leftGet, oldLive leftAt, ↓reduceIte] using leftAt⟩ + +end Ix.Compiler.IxIR2.CallReuse.Sim diff --git a/Ix/Compiler/IxIR2/ReuseHeapMapOps.lean b/Ix/Compiler/IxIR2/ReuseHeapMapOps.lean new file mode 100644 index 000000000..3dba41836 --- /dev/null +++ b/Ix/Compiler/IxIR2/ReuseHeapMapOps.lean @@ -0,0 +1,385 @@ +import Ix.Compiler.IxIR2.ReuseHeapMap +import Ix.Compiler.IxIR1.EvalIso + +/-! +# Executable heap operations under allocation history + +Successful baseline observations transport through the live part of the +history map. Destruction retains old names; allocation appends one name, +whether the target uses fresh storage or fills a suspended reservation. +-/ + +namespace Ix.Compiler.IxIR2.CallReuse.Sim + +open Ix.Compiler.IxIR2.Eval +open Ix.Compiler.Ixon (Owned) +open Ix.Compiler.IxIR1.Sim (NodeIso NodeBoxIso RValIso RValsIso) + +private theorem get_setBox {store : Store} {location : Nat} {old new : NodeBox} + (found : store.get? location = some old) (other : Nat) : + (store.setBox location new).get? other = + if other = location then some new else store.get? other := by + have bound := (Array.getElem?_eq_some_iff.mp (IxIR1.Sim.nodes_get?_of_get? found)).1 + by_cases same : other = location + · subst other + simp [Store.setBox, Store.get?, IxIR1.Store.setBox, IxIR1.Store.get?, + Array.set!_eq_setIfInBounds, bound] + · simp [Store.setBox, Store.get?, IxIR1.Store.setBox, IxIR1.Store.get?, + Array.set!_eq_setIfInBounds, same, Ne.symm same] + +private theorem get_kill (store : Store) (location other : Nat) : + (store.kill location).get? other = + if other = location then none else store.get? other := by + by_cases same : other = location + · subst other + simp [Store.kill, Store.get?, IxIR1.Store.kill, IxIR1.Store.get?, + Array.set!_eq_setIfInBounds, Array.getElem?_setIfInBounds] + · simp [Store.kill, Store.get?, IxIR1.Store.kill, IxIR1.Store.get?, + Array.set!_eq_setIfInBounds, same, Ne.symm same] + +private theorem get_alloc (store : Store) (world : Owned) (node : Node) (location : Nat) : + (store.allocNode world node).1.get? location = + if location = store.heap.nodes.size then some ⟨world, 1, node⟩ + else store.get? location := by + simp only [Store.get?, Store.allocNode_heap, IxIR1.Store.allocNode, + IxIR1.Store.get?, Array.getElem?_push] + split <;> rfl + +theorem setRc_world {store : Store} {location rc : Nat} {box : NodeBox} + (found : store.get? location = some box) (world : Owned) (value : RVal) : + RVal.hasWorld (store.setBox location { box with rc }) world value = + RVal.hasWorld store world value := by + cases value with + | lit => rfl + | erased => rfl + | loc other => + by_cases same : other = location + · subst other + simp only [RVal.hasWorld, get_setBox found, ↓reduceIte, found] + · simp only [RVal.hasWorld, get_setBox found, same, ↓reduceIte] + +theorem retain_world {store output : Store} {value : RVal} + (run : retainShared store value = .ok output) : + RVal.hasWorld store .shared value = true ∧ + ∀ world observed, RVal.hasWorld output world observed = RVal.hasWorld store world observed := by + cases value with + | lit => cases run; exact ⟨rfl, fun _ _ => rfl⟩ + | erased => cases run; exact ⟨rfl, fun _ _ => rfl⟩ + | loc location => + cases found : store.get? location with + | none => simp [retainShared, found] at run + | some box => + by_cases shared : box.world = .shared + · simp only [retainShared, found, shared, bne_self_eq_false, Bool.false_eq_true, + ↓reduceIte, Except.ok.injEq] at run + subst output + refine ⟨by simp [RVal.hasWorld, found, shared], ?_⟩ + intro world observed + change RVal.hasWorld (store.setBox location _) world observed = _ + simpa only [shared] using setRc_world (rc := box.rc + 1) found world observed + · simp [retainShared, found, shared] at run + +theorem retainMany_world {store output : Store} {values : Array RVal} + (run : RetainSharedMany store values output) : + ∀ value ∈ values.toList, RVal.hasWorld store .shared value = true := by + have loop : ∀ (values : List RVal) {store output : Store}, + values.foldlM retainShared store = .ok output → + ∀ value ∈ values, RVal.hasWorld store .shared value = true := by + intro values + induction values with + | nil => simp + | cons head tail ih => + intro store output run value member + rw [List.foldlM_cons] at run + cases first : retainShared store head with + | error error => simp [first, bind, Except.bind] at run + | ok middle => + simp only [first, bind, Except.bind] at run + have worlds := retain_world first + simp only [List.mem_cons] at member + rcases member with rfl | member + · exact worlds.1 + · rw [← worlds.2 .shared value] + exact ih run value member + change values.foldlM retainShared store = .ok output at run + rw [← Array.foldlM_toList] at run + exact loop values.toList run + +namespace HeapMap + +theorem rcTick {left right : Store} {mapping : Array Nat} + (heap : HeapMap left right mapping) : HeapMap left.rcTick right.rcTick mapping := + heap.congr rfl rfl + +theorem setBox {left right : Store} {mapping : Array Nat} + (heap : HeapMap left right mapping) {l r : Nat} {oldLeft newLeft newRight : NodeBox} + (mapped : MapRel mapping l r) (leftAt : left.get? l = some oldLeft) + (boxes : NodeBoxIso (MapRel mapping) newLeft newRight) : + HeapMap (left.setBox l newLeft) (right.setBox r newRight) mapping := by + obtain ⟨oldRight, rightAt, _⟩ := heap.forward mapped leftAt + exact heap.replace mapped leftAt (.present boxes) + (by simp [Store.setBox, IxIR1.Store.setBox]) + (by simp [Store.setBox, IxIR1.Store.setBox]) + (get_setBox leftAt) (get_setBox rightAt) + +theorem kill {left right : Store} {mapping : Array Nat} + (heap : HeapMap left right mapping) {l r : Nat} {oldLeft : NodeBox} + (mapped : MapRel mapping l r) (leftAt : left.get? l = some oldLeft) : + HeapMap (left.kill l) (right.kill r) mapping := + heap.replace mapped leftAt .absent + (by simp [Store.kill, IxIR1.Store.kill]) + (by simp [Store.kill, IxIR1.Store.kill]) + (get_kill left l) (get_kill right r) + +theorem reserve {left right : Store} {mapping : Array Nat} + (heap : HeapMap left right mapping) {l r : Nat} {oldLeft : NodeBox} + (mapped : MapRel mapping l r) (leftAt : left.get? l = some oldLeft) : + HeapMap (left.kill l) (right.reserve r) mapping := + (heap.kill mapped leftAt).congr rfl (by + simp only [Store.reserve, Store.kill, IxIR1.Store.kill, Array.set!_eq_setIfInBounds]) + +theorem alloc {left right : Store} {mapping : Array Nat} + (heap : HeapMap left right mapping) {world : Owned} {leftNode rightNode : Node} + (nodes : NodeIso (MapRel mapping) leftNode rightNode) : + HeapMap (left.allocNode world leftNode).1 (right.allocNode world rightNode).1 + (mapping.push right.heap.nodes.size) := by + apply heap.extend (target := right.heap.nodes.size) (newLeft := ⟨world, 1, leftNode⟩) + (newRight := ⟨world, 1, rightNode⟩) + · simp [Store.get?, IxIR1.Store.get?] + · exact ⟨rfl, rfl, nodes⟩ + · simp [IxIR1.Store.allocNode] + · simp [IxIR1.Store.allocNode] + · simp [IxIR1.Store.allocNode] + · exact get_alloc left world leftNode + · exact get_alloc right world rightNode + +theorem reuse {left right rightOut : Store} {mapping : Array Nat} + (heap : HeapMap left right mapping) {target payload : Nat} {world : Owned} + {leftNode rightNode : Node} (nodes : NodeIso (MapRel mapping) leftNode rightNode) + (run : right.reuseReservation target world rightNode payload = .ok rightOut) : + HeapMap (left.allocNode world leftNode).1 rightOut (mapping.push target) := by + unfold Store.reuseReservation at run + split at run + · rename_i empty + cases run + have bound := (Array.getElem?_eq_some_iff.mp empty).1 + apply heap.extend (newLeft := ⟨world, 1, leftNode⟩) + (newRight := ⟨world, 1, rightNode⟩) + · exact Store.EmptySlot.not_live empty + · exact ⟨rfl, rfl, nodes⟩ + · simp [IxIR1.Store.allocNode] + · simp only [Store.withPeak_heap, Array.size_setIfInBounds, Nat.le_refl] + · simpa only [Store.withPeak_heap, Array.size_setIfInBounds] using bound + · exact get_alloc left world leftNode + · intro location + by_cases same : location = target + · subst location + simp [Store.get?, Store.withPeak_heap, IxIR1.Store.get?, bound] + · simp [Store.get?, Store.withPeak_heap, IxIR1.Store.get?, same, Ne.symm same] + · cases run + +/-- Only successful source observations are required. A dead historical name +may now refer to reused storage, but successful source code cannot inspect it. -/ +theorem hasWorld {left right : Store} {mapping : Array Nat} + (heap : HeapMap left right mapping) {leftValue rightValue : RVal} {world : Owned} + (related : RValIso (MapRel mapping) leftValue rightValue) + (valid : RVal.hasWorld left world leftValue = true) : + RVal.hasWorld right world rightValue = true := by + cases related with + | lit => exact valid + | erased => exact valid + | @loc l r mapped => + cases found : left.get? l with + | none => simp [RVal.hasWorld, found] at valid + | some box => + obtain ⟨targetBox, rightAt, boxes⟩ := heap.forward mapped found + simpa only [RVal.hasWorld, found, rightAt, ← boxes.world] using valid + +theorem constructorView {left right : Store} {mapping : Array Nat} + (heap : HeapMap left right mapping) {l r : Nat} {world : Owned} {cid : CtorId} + {leftBox : NodeBox} {leftFields : Array RVal} (mapped : MapRel mapping l r) + (view : ConstructorView left l world cid leftBox leftFields) : + ∃ rightBox rightFields, + ConstructorView right r world cid rightBox rightFields ∧ + NodeBoxIso (MapRel mapping) leftBox rightBox ∧ + RValsIso (MapRel mapping) leftFields.toList rightFields.toList := by + obtain ⟨leftAt, leftWorld, leftNode⟩ := view.parts + obtain ⟨rightBox, rightAt, boxes⟩ := heap.forward mapped leftAt + have nodes := boxes.node + rw [leftNode] at nodes + cases rightNode : rightBox.node with + | papN address arity arguments => rw [rightNode] at nodes; cases nodes + | ctorN targetCid rightFields => + rw [rightNode] at nodes + cases nodes with + | ctor fields => + exact ⟨rightBox, rightFields, + .of_box rightAt (boxes.world.symm.trans leftWorld) rightNode, boxes, fields⟩ + +theorem retain {left right leftOut : Store} {mapping : Array Nat} + (heap : HeapMap left right mapping) {leftValue rightValue : RVal} + (related : RValIso (MapRel mapping) leftValue rightValue) + (run : retainShared left leftValue = .ok leftOut) : + ∃ rightOut, retainShared right rightValue = .ok rightOut ∧ + HeapMap leftOut rightOut mapping := by + cases related with + | lit => cases run; exact ⟨right, rfl, heap⟩ + | erased => cases run; exact ⟨right, rfl, heap⟩ + | @loc l r mapped => + cases found : left.get? l with + | none => simp [retainShared, found] at run + | some box => + by_cases shared : box.world = .shared + · simp [retainShared, found, shared] at run + subst leftOut + obtain ⟨targetBox, rightAt, boxes⟩ := heap.forward mapped found + refine ⟨(right.setBox r { targetBox with rc := targetBox.rc + 1 }).rcTick, ?_, ?_⟩ + · simp [retainShared, rightAt, ← boxes.world, shared] + · apply HeapMap.rcTick + apply heap.setBox mapped found + exact ⟨shared.symm.trans boxes.world, by simp only [boxes.rc], boxes.node⟩ + · simp [retainShared, found, shared] at run + +theorem retainMany {left right leftOut : Store} {mapping : Array Nat} + (heap : HeapMap left right mapping) {leftValues rightValues : Array RVal} + (related : RValsIso (MapRel mapping) leftValues.toList rightValues.toList) + (run : RetainSharedMany left leftValues leftOut) : + ∃ rightOut, RetainSharedMany right rightValues rightOut ∧ + HeapMap leftOut rightOut mapping := by + have loop : ∀ {leftValues rightValues : List RVal}, + RValsIso (MapRel mapping) leftValues rightValues → + ∀ {left right leftOut : Store}, HeapMap left right mapping → + leftValues.foldlM retainShared left = .ok leftOut → + ∃ rightOut, rightValues.foldlM retainShared right = .ok rightOut ∧ + HeapMap leftOut rightOut mapping := by + intro leftValues rightValues related + induction related with + | nil => intro left right leftOut heap run; cases run; exact ⟨right, rfl, heap⟩ + | @cons lval rval ls rs head tail ih => + intro left right leftOut heap run + rw [List.foldlM_cons] at run + cases first : retainShared left lval with + | error error => simp [first, bind, Except.bind] at run + | ok middle => + simp only [first, bind, Except.bind] at run + obtain ⟨rightMiddle, rightFirst, middleHeap⟩ := heap.retain head first + obtain ⟨rightOut, rest, final⟩ := ih middleHeap run + exact ⟨rightOut, by simpa only [List.foldlM_cons, rightFirst, bind, Except.bind] + using rest, final⟩ + change leftValues.foldlM retainShared left = .ok leftOut at run + rw [← Array.foldlM_toList] at run + obtain ⟨rightOut, rightRun, final⟩ := loop related heap run + refine ⟨rightOut, ?_, final⟩ + change rightValues.foldlM retainShared right = .ok rightOut + simpa only [← Array.foldlM_toList] using rightRun + +end HeapMap + +theorem nodeChildren_iso {mapping : Array Nat} {left right : Node} + (nodes : NodeIso (MapRel mapping) left right) : + RValsIso (MapRel mapping) (IxIR1.Sim.nodeChildren left) (IxIR1.Sim.nodeChildren right) := by + cases nodes <;> assumption + +theorem HeapMap.releaseWork {fuel remaining : Nat} {left right leftOut : Store} + {mapping : Array Nat} (heap : HeapMap left right mapping) + {leftValues rightValues : List RVal} + (related : RValsIso (MapRel mapping) leftValues rightValues) + (run : releaseSharedWork fuel left leftValues = .ok (leftOut, remaining)) : + ∃ rightOut, releaseSharedWork fuel right rightValues = .ok (rightOut, remaining) ∧ + HeapMap leftOut rightOut mapping := by + induction fuel generalizing left right leftValues rightValues with + | zero => + cases related with + | nil => cases run; exact ⟨right, rfl, heap⟩ + | cons head tail => simp [releaseSharedWork] at run + | succ fuel ih => + cases related with + | nil => cases run; exact ⟨right, rfl, heap⟩ + | @cons lval rval ls rs head tail => + cases head with + | lit => exact ih heap tail run + | erased => exact ih heap tail run + | @loc l r mapped => + cases found : left.get? l with + | none => simp [releaseSharedWork, found] at run + | some box => + by_cases shared : box.world = .shared + · obtain ⟨targetBox, rightAt, boxes⟩ := heap.forward mapped found + by_cases zero : box.rc = 0 + · simp [releaseSharedWork, found, shared, zero] at run + · by_cases unitRC : box.rc = 1 + · simp only [releaseSharedWork, found, shared, bne_self_eq_false, + Bool.false_eq_true, ↓reduceIte, unitRC, beq_self_eq_true] at run + have bothKilled := heap.rcTick.kill mapped (show left.rcTick.get? l = + some box from found) + have children := (nodeChildren_iso boxes.node).append tail + obtain ⟨rightOut, rightRun, output⟩ := ih bothKilled children run + refine ⟨rightOut, ?_, output⟩ + cases targetNode : targetBox.node <;> + simpa only [releaseSharedWork, rightAt, ← boxes.world, shared, + bne_self_eq_false, Bool.false_eq_true, ↓reduceIte, ← boxes.rc, + unitRC, beq_self_eq_true, Nat.reduceBEq, + IxIR1.Sim.nodeChildren, targetNode] using rightRun + · simp [releaseSharedWork, found, shared, zero, unitRC] at run + have bothSet := heap.rcTick.setBox mapped + (show left.rcTick.get? l = some box from found) + (show NodeBoxIso (MapRel mapping) + { box with rc := box.rc - 1 } + { targetBox with rc := targetBox.rc - 1 } from + ⟨boxes.world, congrArg (· - 1) boxes.rc, boxes.node⟩) + obtain ⟨rightOut, rightRun, output⟩ := ih bothSet tail (by + simpa only [shared] using run) + refine ⟨rightOut, ?_, output⟩ + simpa only [releaseSharedWork, rightAt, ← boxes.world, shared, + bne_self_eq_false, Bool.false_eq_true, ↓reduceIte, ← boxes.rc, + beq_iff_eq, zero, unitRC] using rightRun + · simp [releaseSharedWork, found, shared] at run + +theorem HeapMap.dropWork {fuel remaining : Nat} {left right leftOut : Store} + {mapping : Array Nat} (heap : HeapMap left right mapping) + {leftValues rightValues : List RVal} + (related : RValsIso (MapRel mapping) leftValues rightValues) + (run : dropUniqueWork fuel left leftValues = .ok (leftOut, remaining)) : + ∃ rightOut, dropUniqueWork fuel right rightValues = .ok (rightOut, remaining) ∧ + HeapMap leftOut rightOut mapping := by + induction fuel generalizing left right leftValues rightValues with + | zero => + cases related with + | nil => cases run; exact ⟨right, rfl, heap⟩ + | cons head tail => simp [dropUniqueWork] at run + | succ fuel ih => + cases related with + | nil => cases run; exact ⟨right, rfl, heap⟩ + | @cons lval rval ls rs head tail => + cases head with + | lit => exact ih heap tail run + | erased => exact ih heap tail run + | @loc l r mapped => + cases found : left.get? l with + | none => simp [dropUniqueWork, found] at run + | some box => + by_cases unique : box.world = .unique + · obtain ⟨targetBox, rightAt, boxes⟩ := heap.forward mapped found + have nodes := boxes.node + cases node : box.node with + | papN address arity arguments => + simp [dropUniqueWork, found, unique, node] at run + | ctorN cid fields => + simp only [dropUniqueWork, found, unique, bne_self_eq_false, + Bool.false_eq_true, ↓reduceIte, node] at run + rw [node] at nodes + cases targetNode : targetBox.node with + | papN address arity arguments => rw [targetNode] at nodes; cases nodes + | ctorN targetCid targetFields => + rw [targetNode] at nodes + cases nodes with + | ctor children => + obtain ⟨rightOut, rightRun, output⟩ := + ih (heap.kill mapped found) (children.append tail) run + refine ⟨rightOut, ?_, output⟩ + simpa only [dropUniqueWork, rightAt, ← boxes.world, unique, + bne_self_eq_false, Bool.false_eq_true, ↓reduceIte, targetNode] + using rightRun + · simp [dropUniqueWork, found, unique] at run + +end Ix.Compiler.IxIR2.CallReuse.Sim diff --git a/Ix/Compiler/IxIR2/ReuseHeapMapResults.lean b/Ix/Compiler/IxIR2/ReuseHeapMapResults.lean new file mode 100644 index 000000000..05b3ab8d6 --- /dev/null +++ b/Ix/Compiler/IxIR2/ReuseHeapMapResults.lean @@ -0,0 +1,182 @@ +import Ix.Compiler.IxIR2.ReuseHeapMapOps +import Ix.Compiler.IxIR2.ReuseCost + +/-! +# Semantic and cost observations of allocation history + +The history map has exactly the established live-heap meaning at closed +endpoints. Live-node counts and pending RC agree even during heap traversal, +when the work list temporarily owns children of an already removed node. +-/ + +namespace Ix.Compiler.IxIR2.CallReuse.Sim + +open Ix.Compiler.IxIR2.Eval +open Ix.Compiler.IxIR1.Sim (NodeIso NodeBoxIso RValIso RValsIso LiveRVal StoreClosed HeapIso) +open Ix.Compiler.IxIR1.CostTrace + +def LiveMapRel (left : Store) (mapping : Array Nat) (l r : Nat) : Prop := + MapRel mapping l r ∧ LiveRVal left.heap (.loc l) + +theorem values_liveMap {left : Store} {mapping : Array Nat} {leftValues rightValues : List RVal} + (related : RValsIso (MapRel mapping) leftValues rightValues) + (live : ∀ value ∈ leftValues, LiveRVal left.heap value) : + RValsIso (LiveMapRel left mapping) leftValues rightValues := by + induction related with + | nil => exact .nil + | @cons lval rval ls rs head tail ih => + refine .cons ?_ (ih (fun value member => live value (by simp [member]))) + cases head with + | @loc l r mapped => exact .loc ⟨mapped, live (.loc l) (by simp)⟩ + | lit => exact .lit + | erased => exact .erased + +theorem node_liveMap {left : Store} {mapping : Array Nat} {leftNode rightNode : Node} + (related : NodeIso (MapRel mapping) leftNode rightNode) + (live : ∀ value ∈ IxIR1.Sim.nodeChildren leftNode, LiveRVal left.heap value) : + NodeIso (LiveMapRel left mapping) leftNode rightNode := by + cases related with + | ctor fields => exact .ctor (values_liveMap fields live) + | pap arguments => exact .pap (values_liveMap arguments live) + +def HeapMap.toHeapIso {left right : Store} {mapping : Array Nat} + (heap : HeapMap left right mapping) (closed : StoreClosed left.heap) : + HeapIso left.heap right.heap where + locRel := LiveMapRel left mapping + left_unique := fun one two => one.1.functional two.1 + right_unique := by + intro l k r one two + obtain ⟨a, firstAt⟩ := one.2 + obtain ⟨b, secondAt⟩ := two.2 + exact heap.injectiveLive one.1 two.1 firstAt secondAt + left_total := by + intro l box found + obtain ⟨r, related⟩ := heap.left_total found + exact ⟨r, related, box, found⟩ + right_total := by + intro r box found + obtain ⟨l, leftBox, related, leftAt⟩ := heap.backward found + exact ⟨l, related, leftBox, leftAt⟩ + related_live := by + intro l r related + obtain ⟨mapped, leftBox, leftAt⟩ := related + obtain ⟨rightBox, rightAt, boxes⟩ := heap.forward mapped leftAt + refine ⟨leftBox, rightBox, leftAt, rightAt, boxes.world, boxes.rc, ?_⟩ + exact node_liveMap boxes.node (closed leftAt) + +theorem HeapMap.toHeapIso_value {left right : Store} {mapping : Array Nat} + (heap : HeapMap left right mapping) (closed : StoreClosed left.heap) + {leftValue rightValue : RVal} (related : RValIso (MapRel mapping) leftValue rightValue) + (live : LiveRVal left.heap leftValue) : + RValIso (heap.toHeapIso closed).locRel leftValue rightValue := by + cases related with + | loc mapped => exact .loc ⟨mapped, live⟩ + | lit => exact .lit + | erased => exact .erased + +/-- Live isomorphism is a valid history relation with no dead rows. -/ +def liveHistory {left right : IxIR1.Store} (iso : HeapIso left right) : + IxIR1.Sim.HeapHistoryIso left right where + locRel := iso.locRel + left_unique := iso.left_unique + right_unique := iso.right_unique + left_bound := by + intro l r related + obtain ⟨leftBox, _, leftAt, _, _⟩ := iso.related_live related + exact (Array.getElem?_eq_some_iff.mp (IxIR1.Sim.nodes_get?_of_get? leftAt)).1 + right_bound := by + intro l r related + obtain ⟨_, rightBox, _, rightAt, _⟩ := iso.related_live related + exact (Array.getElem?_eq_some_iff.mp (IxIR1.Sim.nodes_get?_of_get? rightAt)).1 + left_total := iso.left_total + right_total := iso.right_total + related := fun related => .inr (iso.related_live related) + +theorem HeapMap.toStable {left right : Store} {mapping : Array Nat} + (heap : HeapMap left right mapping) (closed : StoreClosed left.heap) : + ReuseSim.StableHeapRel left right (LiveMapRel left mapping) := + .isomorphic (liveHistory (heap.toHeapIso closed)).symm + +theorem HeapMap.right_empty {left right : Store} {mapping : Array Nat} + (heap : HeapMap left right mapping) (empty : left.live = 0) : right.live = 0 := by + apply (IxIR1.Reclamation.Store.live_eq_zero_iff_no_live_slot right.heap).2 + intro box member + obtain ⟨r, slot⟩ := Array.mem_iff_getElem?.mp member + have found : right.get? r = some box := by simp [Store.get?, IxIR1.Store.get?, slot] + obtain ⟨l, leftBox, _, leftAt⟩ := heap.backward found + have leftMember := Array.mem_iff_getElem?.mpr + ⟨l, IxIR1.Sim.nodes_get?_of_get? leftAt⟩ + exact (IxIR1.Reclamation.Store.live_eq_zero_iff_no_live_slot left.heap).1 empty + leftBox leftMember + +theorem HeapMap.live_eq {left right : Store} {mapping : Array Nat} + (heap : HeapMap left right mapping) : left.live = right.live := by + classical + by_cases empty : left.live = 0 + · exact empty.trans (heap.right_empty empty).symm + have present : ∃ box, some box ∈ left.heap.nodes := by + apply Classical.byContradiction + intro absent + simp only [not_exists] at absent + exact empty ((IxIR1.Reclamation.Store.live_eq_zero_iff_no_live_slot left.heap).2 absent) + obtain ⟨box, member⟩ := present + obtain ⟨l, slot⟩ := Array.mem_iff_getElem?.mp member + have found : left.get? l = some box := by simp [Store.get?, IxIR1.Store.get?, slot] + obtain ⟨r, rightBox, mapped, rightAt, _⟩ := heap.get found + have leftCount := Store.live_kill found + have rightCount := Store.live_kill rightAt + have remaining := (heap.kill mapped found).live_eq + omega +termination_by left.live +decreasing_by + have _removed := Store.live_kill found + omega + +theorem HeapMap.pendingRC_eq {left right : Store} {mapping : Array Nat} + (heap : HeapMap left right mapping) : left.pendingRC = right.pendingRC := by + classical + by_cases empty : left.live = 0 + · rw [ReuseSim.pendingRC_empty empty, ReuseSim.pendingRC_empty (heap.right_empty empty)] + have present : ∃ box, some box ∈ left.heap.nodes := by + apply Classical.byContradiction + intro absent + simp only [not_exists] at absent + exact empty ((IxIR1.Reclamation.Store.live_eq_zero_iff_no_live_slot left.heap).2 absent) + obtain ⟨box, member⟩ := present + obtain ⟨l, slot⟩ := Array.mem_iff_getElem?.mp member + have found : left.get? l = some box := by simp [Store.get?, IxIR1.Store.get?, slot] + obtain ⟨r, rightBox, mapped, rightAt, boxes⟩ := heap.get found + have leftRemoved := sharedRcPotential_kill (store := left.heap) found + have rightRemoved := sharedRcPotential_kill (store := right.heap) rightAt + have weights : slotSharedRcPotential (some box) = slotSharedRcPotential (some rightBox) := by + rcases box with ⟨world, rc, node⟩ + rcases rightBox with ⟨rightWorld, rightRC, rightNode⟩ + have worlds := boxes.world + have counts := boxes.rc + dsimp at worlds counts + subst rightWorld + subst rightRC + cases world <;> rfl + have remaining := (heap.kill mapped found).pendingRC_eq + change sharedRcPotential (left.heap.kill l) = sharedRcPotential (right.heap.kill r) at remaining + unfold Store.pendingRC + omega +termination_by left.live +decreasing_by + have _removed := Store.live_kill found + omega + +theorem HeapMap.costDelta {beforeLeft beforeRight afterLeft afterRight : Store} + {beforeMap afterMap : Array Nat} (before : HeapMap beforeLeft beforeRight beforeMap) + (after : HeapMap afterLeft afterRight afterMap) {events : Nat} {charge : Int} + (leftRC : (afterLeft.amortizedRC : Int) = beforeLeft.amortizedRC + charge) + (rightRC : (afterRight.amortizedRC : Int) = beforeRight.amortizedRC + charge) + (leftPeak : afterLeft.peakLiveNodes = if events = 0 then beforeLeft.peakLiveNodes + else max beforeLeft.peakLiveNodes afterLeft.live) + (rightPeak : afterRight.peakLiveNodes = if events = 0 then beforeRight.peakLiveNodes + else max beforeRight.peakLiveNodes afterRight.live) : + CostDelta beforeLeft afterLeft beforeRight afterRight := + .of_observations before.pendingRC_eq after.pendingRC_eq after.live_eq + leftRC rightRC leftPeak rightPeak + +end Ix.Compiler.IxIR2.CallReuse.Sim diff --git a/Ix/Compiler/IxIR2/ReuseLiveSim.lean b/Ix/Compiler/IxIR2/ReuseLiveSim.lean new file mode 100644 index 000000000..9dd753c0e --- /dev/null +++ b/Ix/Compiler/IxIR2/ReuseLiveSim.lean @@ -0,0 +1,27547 @@ +import Ix.Compiler.IxIR2.ReuseSim +import Ix.Compiler.IxIR2.PipelineSim +import Ix.Compiler.IxIR1.EvalHistory +import Ix.Compiler.IxIR2.AllocationEvents +import Ix.Compiler.IxIR2.ReuseCost + +/-! +# Liveness-indexed stable states for dynamic reuse + +`ReuseSim.StableFrameIso` relates every append-only value register. That is +convenient for local lockstep proofs, but it is too strong at a call boundary: +the evaluator suspends the complete caller frame, including dead registers +whose owners were transferred to the callee. A physical reset in that callee +may reuse such an address. The dead caller register is never read again, but +an all-register relation would nevertheless require its obsolete allocation +epoch to remain related to the new payload at the reused address. + +This module introduces the proof relation needed at the compiler boundary. +Only registers with a syntactic use at or after the frame's current program +counter are related. Pending `applyMore` arguments remain fully related, +because all of them are semantically live. The existing stronger relation +embeds into this one, while relation transport after physical reuse asks for +avoidance only of live slots. +-/ + +namespace Ix.Compiler.IxIR2.ReuseLiveSim + +open Ix.Compiler.IxIR2 +open Ix.Compiler.IxIR2.Eval +open Ix.Compiler.IxIR2.Reuse +open Ix.Compiler.IxIR2.ReuseSim +open Ix.Compiler.Ixon (Owned) + +private theorem blocks_nonempty_of_getElem {blocks : Array Block} + {index : Nat} {block : Block} (found : blocks[index]? = some block) : + blocks.isEmpty = false := by + apply Bool.eq_false_iff.mpr + intro empty + have blocksEmpty : blocks = #[] := Array.isEmpty_iff.mp empty + subst blocks + simp at found + +private theorem nodeIso_ctor_left {locRel : Nat → Nat → Prop} + {cid : CtorId} {baselineFields : Array RVal} + {rewrittenNode : IxIR1.Node} + (related : IxIR1.Sim.NodeIso locRel (.ctorN cid baselineFields) + rewrittenNode) : + ∃ rewrittenFields : Array RVal, + rewrittenNode = .ctorN cid rewrittenFields ∧ + IxIR1.Sim.RValsIso locRel baselineFields.toList + rewrittenFields.toList := by + cases related with + | ctor fields => exact ⟨_, rfl, fields⟩ + +private theorem nodeIso_pap_left {locRel : Nat → Nat → Prop} + {address : Ix.Compiler.Ixon.Address} {arity : Nat} + {baselineArguments : Array RVal} {rewrittenNode : IxIR1.Node} + (related : IxIR1.Sim.NodeIso locRel + (.papN address arity baselineArguments) rewrittenNode) : + ∃ rewrittenArguments : Array RVal, + rewrittenNode = .papN address arity rewrittenArguments ∧ + IxIR1.Sim.RValsIso locRel baselineArguments.toList + rewrittenArguments.toList := by + cases related with + | pap arguments => exact ⟨_, rfl, arguments⟩ + +private theorem rvalsIso_array_extract {locRel : Nat → Nat → Prop} + {baseline rewritten : Array RVal} + (related : IxIR1.Sim.RValsIso locRel baseline.toList rewritten.toList) + (start stop : Nat) : + IxIR1.Sim.RValsIso locRel + (baseline.extract start stop).toList + (rewritten.extract start stop).toList := by + simpa [List.extract_eq_take_drop] using + (related.drop start).take (stop - start) + +private theorem rvalsIso_length_eq {locRel : Nat → Nat → Prop} + {baseline rewritten : List RVal} + (related : IxIR1.Sim.RValsIso locRel baseline rewritten) : + baseline.length = rewritten.length := by + induction related with + | nil => rfl + | cons _ _ ih => simp [ih] + +private theorem rvalsIso_symm {locRel : Nat → Nat → Prop} + {baseline rewritten : List RVal} + (related : IxIR1.Sim.RValsIso locRel baseline rewritten) : + IxIR1.Sim.RValsIso + (fun rewrittenLocation baselineLocation => + locRel baselineLocation rewrittenLocation) + rewritten baseline := by + induction related with + | nil => exact .nil + | cons head tail ih => exact .cons head.symm ih + +private theorem rvalsIso_append_pair {locRel : Nat → Nat → Prop} + {baseline₁ rewritten₁ baseline₂ rewritten₂ : List RVal} + (first : IxIR1.Sim.RValsIso locRel baseline₁ rewritten₁) + (second : IxIR1.Sim.RValsIso locRel baseline₂ rewritten₂) : + IxIR1.Sim.RValsIso locRel + (baseline₁ ++ baseline₂) (rewritten₁ ++ rewritten₂) := by + induction first with + | nil => exact second + | cons head tail ih => exact .cons head ih + +private theorem rvalsIso_mono_rel {oldRel newRel : Nat → Nat → Prop} + (lift : ∀ {baseline rewritten}, + oldRel baseline rewritten → newRel baseline rewritten) : + ∀ {baseline rewritten : List RVal}, + IxIR1.Sim.RValsIso oldRel baseline rewritten → + IxIR1.Sim.RValsIso newRel baseline rewritten + | _, _, .nil => .nil + | _, _, .cons head tail => + .cons (head.mono lift) (rvalsIso_mono_rel lift tail) + +private theorem rvalsIso_getElem? {locRel : Nat → Nat → Prop} + {baseline rewritten : List RVal} + (related : IxIR1.Sim.RValsIso locRel baseline rewritten) + {index : Nat} {baselineValue : RVal} + (found : baseline[index]? = some baselineValue) : + ∃ rewrittenValue, + rewritten[index]? = some rewrittenValue ∧ + IxIR1.Sim.RValIso locRel baselineValue rewrittenValue := by + induction related generalizing index baselineValue with + | nil => simp at found + | @cons baselineHead rewrittenHead baselineTail rewrittenTail head tail ih => + cases index with + | zero => + simp only [List.getElem?_cons_zero, Option.some.injEq] at found + subst baselineValue + exact ⟨rewrittenHead, by simp, head⟩ + | succ index => + simp only [List.getElem?_cons_succ] at found ⊢ + exact ih found + +private theorem rvalsIso_array_getElem? {locRel : Nat → Nat → Prop} + {baseline rewritten : Array RVal} + (related : IxIR1.Sim.RValsIso locRel baseline.toList rewritten.toList) + {index : Nat} {baselineValue : RVal} + (found : baseline[index]? = some baselineValue) : + ∃ rewrittenValue, + rewritten[index]? = some rewrittenValue ∧ + IxIR1.Sim.RValIso locRel baselineValue rewrittenValue := by + have listFound : baseline.toList[index]? = some baselineValue := by + simpa using found + obtain ⟨rewrittenValue, rewrittenFound, valueRelated⟩ := + rvalsIso_getElem? related listFound + exact ⟨rewrittenValue, by simpa using rewrittenFound, valueRelated⟩ + +private theorem rvalsIso_restrict_left {locRel : Nat → Nat → Prop} + {baseline rewritten : List RVal} {removed : Nat} + (related : IxIR1.Sim.RValsIso locRel baseline rewritten) + (avoids : ∀ value ∈ baseline, value ≠ .loc removed) : + IxIR1.Sim.RValsIso + (fun baselineLocation rewrittenLocation => + locRel baselineLocation rewrittenLocation ∧ + baselineLocation ≠ removed) + baseline rewritten := by + induction related with + | nil => exact .nil + | @cons baselineValue rewrittenValue baselineTail rewrittenTail head tail ih => + have headAvoids : baselineValue ≠ .loc removed := + avoids baselineValue (by simp) + have tailAvoids : ∀ value ∈ baselineTail, value ≠ .loc removed := by + intro value member + exact avoids value (by simp [member]) + refine .cons ?_ (ih tailAvoids) + cases head with + | loc locationRelated => + exact .loc ⟨locationRelated, by + intro same + apply headAvoids + cases same + rfl⟩ + | lit => exact .lit + | erased => exact .erased + +private theorem rvalsIso_right_avoids_of_left + {baselineStore rewrittenStore : IxIR1.Store} + (iso : IxIR1.Sim.HeapIso rewrittenStore baselineStore) + {baselineRemoved rewrittenRemoved : Nat} + (removedRelated : iso.locRel rewrittenRemoved baselineRemoved) + {baseline rewritten : List RVal} + (related : IxIR1.Sim.RValsIso + (fun baselineLocation rewrittenLocation => + iso.locRel rewrittenLocation baselineLocation) + baseline rewritten) + (baselineAvoids : ∀ value ∈ baseline, + value ≠ .loc baselineRemoved) : + ∀ value ∈ rewritten, value ≠ .loc rewrittenRemoved := by + induction related with + | nil => simp + | @cons baselineValue rewrittenValue baselineTail rewrittenTail head tail ih => + have headAvoids : baselineValue ≠ .loc baselineRemoved := + baselineAvoids baselineValue (by simp) + have tailAvoids : ∀ value ∈ baselineTail, + value ≠ .loc baselineRemoved := by + intro value member + exact baselineAvoids value (by simp [member]) + intro value member + simp only [List.mem_cons] at member + rcases member with rfl | member + · cases head with + | loc locationRelated => + intro same + cases same + have baselineSame := + iso.left_unique locationRelated removedRelated + apply headAvoids + cases baselineSame + rfl + | lit => intro impossible; cases impossible + | erased => intro impossible; cases impossible + · exact ih tailAvoids value member + +/-- Register `value` has a syntactic use in the current source block at or +after `pc`. `Liveness.blockUses` includes the terminator and all outgoing +edge operands, so this also covers values needed by a future transfer. -/ +def ValueLiveFrom (source : Function) (blockId pc value : Nat) : Prop := + ∃ block, + source.blocks[blockId]? = some block ∧ + ∃ use ∈ Liveness.blockUses block, + use.value = value ∧ pc ≤ use.position + +/-- Every register operand of `atom` remains observable from this source +coordinate. Literals and erased operands require no register fact. -/ +def AtomLiveFrom (source : Function) (blockId pc : Nat) : Atom → Prop + | .reg value => ValueLiveFrom source blockId pc value + | .lit _ | .erased => True + +/-- Pointwise liveness for an operand vector. -/ +def AtomsLiveFrom (source : Function) (blockId pc : Nat) + (atoms : Array Atom) : Prop := + ∀ atom ∈ atoms.toList, AtomLiveFrom source blockId pc atom + +namespace AtomLiveFrom + +/-- Liveness at a later source coordinate implies liveness at every earlier +coordinate in the same block. -/ +theorem mono {source : Function} {blockId earlier later : Nat} {atom : Atom} + (live : AtomLiveFrom source blockId later atom) + (before : earlier ≤ later) : + AtomLiveFrom source blockId earlier atom := by + cases atom with + | reg value => + obtain ⟨block, blockAt, use, member, valueEq, position⟩ := live + exact ⟨block, blockAt, use, member, valueEq, + Nat.le_trans before position⟩ + | lit literal => trivial + | erased => trivial + +/-- An instruction operand is live at that instruction's coordinate. -/ +theorem instruction {source : Function} {blockId position : Nat} + {block : Block} {instruction : Instr} {atom : Atom} + (blockAt : source.blocks[blockId]? = some block) + (instructionAt : block.instructions[position]? = some instruction) + (operand : Liveness.InstrUsesAtom instruction atom) : + AtomLiveFrom source blockId position atom := by + cases atom with + | reg value => + exact ⟨block, blockAt, ⟨value, position⟩, + Liveness.instruction_reg_mem_blockUses instructionAt operand rfl, + rfl, Nat.le_refl position⟩ + | lit literal => trivial + | erased => trivial + +/-- A direct terminator operand is live at the terminator coordinate. -/ +theorem terminator {source : Function} {blockId position : Nat} + {block : Block} {atom : Atom} + (blockAt : source.blocks[blockId]? = some block) + (atTerminator : position = block.instructions.size) + (operand : Liveness.TerminatorUsesAtom block.terminator atom) : + AtomLiveFrom source blockId position atom := by + cases atom with + | reg value => + exact ⟨block, blockAt, ⟨value, block.instructions.size⟩, + Liveness.terminator_reg_mem_blockUses operand rfl, rfl, + Nat.le_of_eq atTerminator⟩ + | lit literal => trivial + | erased => trivial + +end AtomLiveFrom + +namespace AtomsLiveFrom + +/-- Pointwise operand liveness is monotone toward earlier coordinates. -/ +theorem mono {source : Function} {blockId earlier later : Nat} + {atoms : Array Atom} + (live : AtomsLiveFrom source blockId later atoms) + (before : earlier ≤ later) : + AtomsLiveFrom source blockId earlier atoms := by + intro atom member + exact (live atom member).mono before + +/-- Lift a proof that every vector element is an instruction operand into the +live-vector predicate at that instruction's coordinate. -/ +theorem instruction {source : Function} {blockId position : Nat} + {block : Block} {instruction : Instr} {atoms : Array Atom} + (blockAt : source.blocks[blockId]? = some block) + (instructionAt : block.instructions[position]? = some instruction) + (operands : ∀ atom ∈ atoms.toList, + Liveness.InstrUsesAtom instruction atom) : + AtomsLiveFrom source blockId position atoms := by + intro atom member + exact AtomLiveFrom.instruction blockAt instructionAt + (operands atom member) + +/-- Lift a proof that every edge atom is a terminator operand into the +live-vector predicate at the terminator coordinate. -/ +theorem terminatorEdge {source : Function} {blockId position : Nat} + {block : Block} {edge : Edge} + (blockAt : source.blocks[blockId]? = some block) + (atTerminator : position = block.instructions.size) + (operands : ∀ atom ∈ edge.values.toList, + Liveness.TerminatorUsesAtom block.terminator atom) : + AtomsLiveFrom source blockId position edge.values := by + intro atom member + exact AtomLiveFrom.terminator blockAt atTerminator + (operands atom member) + +theorem call {source : Function} {blockId position : Nat} + {block : Block} {address : Ix.Compiler.Ixon.Address} + {arguments : Array Atom} + (blockAt : source.blocks[blockId]? = some block) + (bound : position < block.instructions.size) + (instruction : block.instructions[position] = .call address arguments) : + AtomsLiveFrom source blockId position arguments := by + intro atom member + have instructionAt : block.instructions[position]? = + some (.call address arguments) := by + simpa [instruction] using Array.getElem?_eq_getElem bound + exact AtomLiveFrom.instruction blockAt instructionAt + (Liveness.InstrUsesAtom.call member) + +theorem callSelf {source : Function} {blockId position : Nat} + {block : Block} {arguments : Array Atom} + (blockAt : source.blocks[blockId]? = some block) + (bound : position < block.instructions.size) + (instruction : block.instructions[position] = .callSelf arguments) : + AtomsLiveFrom source blockId position arguments := by + intro atom member + have instructionAt : block.instructions[position]? = + some (.callSelf arguments) := by + simpa [instruction] using Array.getElem?_eq_getElem bound + exact AtomLiveFrom.instruction blockAt instructionAt + (Liveness.InstrUsesAtom.callSelf member) + +theorem tailCall {source : Function} {blockId position : Nat} + {block : Block} {address : Ix.Compiler.Ixon.Address} + {arguments : Array Atom} + (blockAt : source.blocks[blockId]? = some block) + (atTerminator : position = block.instructions.size) + (terminator : block.terminator = .tailCall address arguments) : + AtomsLiveFrom source blockId position arguments := by + intro atom member + apply AtomLiveFrom.terminator blockAt atTerminator + rw [terminator] + exact Liveness.TerminatorUsesAtom.tailCall member + +theorem tailCallSelf {source : Function} {blockId position : Nat} + {block : Block} {arguments : Array Atom} + (blockAt : source.blocks[blockId]? = some block) + (atTerminator : position = block.instructions.size) + (terminator : block.terminator = .tailCallSelf arguments) : + AtomsLiveFrom source blockId position arguments := by + intro atom member + apply AtomLiveFrom.terminator blockAt atTerminator + rw [terminator] + exact Liveness.TerminatorUsesAtom.tailCallSelf member + +end AtomsLiveFrom + +/-- A return operand is live at the terminator coordinate. -/ +theorem AtomLiveFrom.ret {source : Function} {blockId position : Nat} + {block : Block} {atom : Atom} + (blockAt : source.blocks[blockId]? = some block) + (atTerminator : position = block.instructions.size) + (terminator : block.terminator = .ret atom) : + AtomLiveFrom source blockId position atom := by + apply AtomLiveFrom.terminator blockAt atTerminator + rw [terminator] + exact Liveness.TerminatorUsesAtom.ret + +/-- Every register the accepted planner can observe is live when the +recognized allocation executes. Allocation operands are used immediately; +recursive-tail operands remain live through the block terminator. -/ +theorem plannerValueLiveAtAllocation {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} {blockId : Nat} + {block : Block} (site : Reuse.Site limits validation block) + (blockAt : source.blocks[blockId]? = some block) {sourceId : ValueId} + (relevant : PlannerValueRelevant site.shape sourceId) : + ValueLiveFrom source blockId (site.shape.releasePosition + 1) sourceId := by + rcases relevant with allocationMember | tailMember + · exact AtomLiveFrom.instruction blockAt site.fits.allocation + (Liveness.InstrUsesAtom.alloc allocationMember) + · have live : AtomLiveFrom source blockId block.instructions.size + (.reg sourceId) := by + apply AtomLiveFrom.terminator blockAt rfl + rw [site.fits.terminator] + exact Liveness.TerminatorUsesAtom.tailCallSelf tailMember + have allocationBound : site.shape.releasePosition + 1 < + block.instructions.size := + (Array.getElem?_eq_some_iff.mp site.fits.allocation).1 + exact live.mono (Nat.le_of_lt allocationBound) + +/-- Every register the accepted planner can observe is live at entry to the +recognized source block. -/ +theorem plannerValueLiveAtEntry {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} {blockId : Nat} + {block : Block} (site : Reuse.Site limits validation block) + (blockAt : source.blocks[blockId]? = some block) {sourceId : ValueId} + (relevant : PlannerValueRelevant site.shape sourceId) : + ValueLiveFrom source blockId 0 sourceId := by + have live : AtomLiveFrom source blockId (site.shape.releasePosition + 1) + (.reg sourceId) := + plannerValueLiveAtAllocation site blockAt relevant + exact live.mono (Nat.zero_le _) + +private theorem fetch_operand_eq {target atom : Atom} {cid : CtorId} + {field : Nat} + (operand : Liveness.InstrUsesAtom (.fetch target cid field) atom) : + atom = target := by + cases operand + rfl + +private theorem retainShared_operand_eq {target atom : Atom} + (operand : Liveness.InstrUsesAtom (.retainShared target) atom) : + atom = target := by + cases operand + rfl + +private theorem releaseShared_operand_eq {target atom : Atom} + (operand : Liveness.InstrUsesAtom (.releaseShared target) atom) : + atom = target := by + cases operand + rfl + +/-- Every accepted-block parameter that is live at entry is either the +distinguished reset source or an allocation/tail operand visible to the +planner. Retained fetched fields use append-only result registers, so they +cannot alias an inherited parameter slot. -/ +theorem Reuse.Site.entryLiveParameterCases {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} {blockId : Nat} + {block : Block} (site : Reuse.Site limits validation block) + (blockAt : source.blocks[blockId]? = some block) + {index : Nat} + (live : ValueLiveFrom source blockId 0 index) + (bound : index < site.shape.parameterCount) : + index = site.shape.source ∨ PlannerValueRelevant site.shape index := by + obtain ⟨actualBlock, actualAt, use, member, valueEq, _position⟩ := live + have blockEq : actualBlock = block := + Option.some.inj (actualAt.symm.trans blockAt) + subst actualBlock + have useValue : use.value = index := valueEq + cases Liveness.mem_blockUses member with + | inl instructionUse => + obtain ⟨instruction, instructionAt, operand⟩ := instructionUse + rcases site.instructionCases instructionAt with + ⟨field, fieldBound, instructionEq⟩ | + ⟨field, fieldBound, instructionEq⟩ | instructionEq | instructionEq + · rw [instructionEq] at operand + have atomEq := fetch_operand_eq operand + left + simpa [useValue] using atomEq + · rw [instructionEq] at operand + have atomEq := retainShared_operand_eq operand + have indexEq : index = site.shape.parameterCount + field := by + simpa [useValue] using atomEq + omega + · rw [instructionEq] at operand + have atomEq := releaseShared_operand_eq operand + left + simpa [useValue] using atomEq + · rw [instructionEq] at operand + cases operand with + | alloc atomMember => + right + left + have atomEq : (Atom.reg index) = .reg use.value := by + simp [useValue] + simpa [atomEq] using atomMember + | inr terminatorUse => + obtain ⟨_positionEq, operand⟩ := terminatorUse + rw [site.fits.terminator] at operand + cases operand with + | tailCallSelf atomMember => + right + right + simpa [useValue] using atomMember + +/-- An inherited register used at accepted-block entry remains observable +until the parent release. Fetches only inspect the parent, and every other +inherited use belongs to the later allocation or tail call. -/ +theorem Reuse.Site.entryLiveParameterBeforeRelease {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} {blockId : Nat} + {block : Block} (site : Reuse.Site limits validation block) + (blockAt : source.blocks[blockId]? = some block) + {index pc : Nat} + (live : ValueLiveFrom source blockId 0 index) + (bound : index < site.shape.parameterCount) + (beforeRelease : pc ≤ site.shape.releasePosition) : + ValueLiveFrom source blockId pc index := by + rcases Reuse.Site.entryLiveParameterCases site blockAt live bound with + sourceEq | relevant + · subst index + exact (AtomLiveFrom.instruction blockAt site.fits.release + Liveness.InstrUsesAtom.releaseShared).mono beforeRelease + · exact (show AtomLiveFrom source blockId (site.shape.releasePosition + 1) + (.reg index) from plannerValueLiveAtAllocation site blockAt relevant).mono + (by omega) + +/-- A constructor prologue inside an accepted block cannot extend into the +recognized retain batch. -/ +theorem Reuse.Site.fetchPrologueBound {limits : Validate.Limits} + {validation : Validate.Context} {block : Block} + (site : Reuse.Site limits validation block) + {atom : Atom} {cid : CtorId} {count : Nat} + (prologue : Lower.fetchPrologueMatches block.instructions atom cid count = + true) : + count ≤ site.shape.fieldCount := by + by_cases bound : count ≤ site.shape.fieldCount + · exact bound + · have fetchAt := Lower.fetchPrologueAt_of_match prologue + (show site.shape.fieldCount < count by omega) + have retainAt := site.fits.retains 0 site.fits.fieldCountPositive + simp only [Nat.add_zero] at retainAt + have impossible := Option.some.inj (fetchAt.symm.trans retainAt) + cases impossible + +/-- A nonempty constructor prologue in an accepted block identifies exactly +its reset source operand and full constructor identity. -/ +theorem Reuse.Site.fetchPrologueHead {limits : Validate.Limits} + {validation : Validate.Context} {block : Block} + (site : Reuse.Site limits validation block) + {atom : Atom} {cid : CtorId} {count : Nat} + (prologue : Lower.fetchPrologueMatches block.instructions atom cid count = + true) + (positive : 0 < count) : + atom = .reg site.shape.source ∧ cid = site.shape.sourceConstructor := by + have fetchAt := Lower.fetchPrologueAt_of_match prologue positive + have expected := site.fits.fetches 0 site.fits.fieldCountPositive + have same := Option.some.inj (fetchAt.symm.trans expected) + simpa only [Instr.fetch.injEq, and_true] using same + +/-- Pointwise location agreement restricted to values that can still be +observed by the source frame. Array length remains structural: both +executions retain the same append-only register numbering even when dead +payloads no longer agree. -/ +structure LiveValuesIso (source : Function) (blockId pc : Nat) + (locRel : Nat → Nat → Prop) (baseline rewritten : Array RVal) : Prop where + length : baseline.size = rewritten.size + related : ∀ {index : Nat} {baselineValue : RVal}, + ValueLiveFrom source blockId pc index → + baseline[index]? = some baselineValue → + ∃ rewrittenValue, + rewritten[index]? = some rewrittenValue ∧ + IxIR1.Sim.RValIso locRel baselineValue rewrittenValue + +namespace LiveValuesIso + +private theorem rvals_getElem? {locRel : Nat → Nat → Prop} : + ∀ {baseline rewritten : List RVal}, + IxIR1.Sim.RValsIso locRel baseline rewritten → + ∀ {index : Nat} {baselineValue : RVal}, + baseline[index]? = some baselineValue → + ∃ rewrittenValue, + rewritten[index]? = some rewrittenValue ∧ + IxIR1.Sim.RValIso locRel baselineValue rewrittenValue + | _, _, .nil, index, baselineValue, found => by simp at found + | _, _, .cons head tail, 0, baselineValue, found => by + simp only [List.getElem?_cons_zero, Option.some.injEq] at found + subst baselineValue + exact ⟨_, rfl, head⟩ + | _, _, .cons head tail, index + 1, baselineValue, found => by + simp only [List.getElem?_cons_succ] at found + exact rvals_getElem? tail found + +/-- The original all-register relation is a strengthening of live-register +agreement. -/ +theorem ofRValsIso {source : Function} {blockId pc : Nat} + {locRel : Nat → Nat → Prop} {baseline rewritten : Array RVal} + (values : IxIR1.Sim.RValsIso locRel baseline.toList rewritten.toList) : + LiveValuesIso source blockId pc locRel baseline rewritten := by + refine ⟨?_, ?_⟩ + · simpa using values.lengths + · intro index baselineValue _live found + have listFound : baseline.toList[index]? = some baselineValue := by + simpa using found + obtain ⟨rewrittenValue, rewrittenAt, related⟩ := + rvals_getElem? values listFound + exact ⟨rewrittenValue, by simpa using rewrittenAt, related⟩ + +/-- Future liveness is monotone when a frame advances. -/ +theorem advance {source : Function} {blockId pc : Nat} + {locRel : Nat → Nat → Prop} {baseline rewritten : Array RVal} + (values : LiveValuesIso source blockId pc locRel baseline rewritten) : + LiveValuesIso source blockId (pc + 1) locRel baseline rewritten := by + refine ⟨values.length, ?_⟩ + intro index baselineValue live found + apply values.related ?_ found + obtain ⟨block, blockAt, use, member, valueEq, position⟩ := live + exact ⟨block, blockAt, use, member, valueEq, Nat.le_trans + (Nat.le_add_right pc 1) position⟩ + +/-- Widening the location relation preserves live-register agreement. -/ +theorem mono {source : Function} {blockId pc : Nat} + {oldRel newRel : Nat → Nat → Prop} + {baseline rewritten : Array RVal} + (values : LiveValuesIso source blockId pc oldRel baseline rewritten) + (lift : ∀ {baselineLocation rewrittenLocation}, + oldRel baselineLocation rewrittenLocation → + newRel baselineLocation rewrittenLocation) : + LiveValuesIso source blockId pc newRel baseline rewritten := by + refine ⟨values.length, ?_⟩ + intro index baselineValue live found + obtain ⟨rewrittenValue, rewrittenAt, related⟩ := + values.related live found + exact ⟨rewrittenValue, rewrittenAt, related.mono lift⟩ + +private theorem rvalsIso_append_one {locRel : Nat → Nat → Prop} + {baseline rewritten : List RVal} + (values : IxIR1.Sim.RValsIso locRel baseline rewritten) + {baselineValue rewrittenValue : RVal} + (value : IxIR1.Sim.RValIso locRel baselineValue rewrittenValue) : + IxIR1.Sim.RValsIso locRel + (baseline ++ [baselineValue]) (rewritten ++ [rewrittenValue]) := by + induction values with + | nil => exact .cons value .nil + | cons head tail ih => exact .cons head ih + +/-- Appending a related value preserves live-register agreement. The new +slot may itself be live; every prior slot uses the original relation. -/ +theorem push {source : Function} {blockId pc : Nat} + {locRel : Nat → Nat → Prop} {baseline rewritten : Array RVal} + (values : LiveValuesIso source blockId pc locRel baseline rewritten) + {baselineValue rewrittenValue : RVal} + (value : IxIR1.Sim.RValIso locRel baselineValue rewrittenValue) : + LiveValuesIso source blockId pc locRel + (baseline.push baselineValue) (rewritten.push rewrittenValue) := by + refine ⟨by simp [values.length], ?_⟩ + intro index foundValue live found + rw [Array.getElem?_push] at found + by_cases last : index = baseline.size + · rw [if_pos last] at found + cases Option.some.inj found + refine ⟨rewrittenValue, ?_, value⟩ + rw [Array.getElem?_push, if_pos (last.trans values.length)] + · rw [if_neg last] at found + obtain ⟨targetValue, targetAt, related⟩ := + values.related live found + have targetNotLast : index ≠ rewritten.size := by + simpa [values.length] using last + refine ⟨targetValue, ?_, related⟩ + simpa [Array.getElem?_push, targetNotLast] using targetAt + +/-- Appending pointwise-related suffixes preserves live-register agreement. -/ +theorem append {source : Function} {blockId pc : Nat} + {locRel : Nat → Nat → Prop} {baseline rewritten : Array RVal} + (values : LiveValuesIso source blockId pc locRel baseline rewritten) + {baselineSuffix rewrittenSuffix : Array RVal} + (suffix : IxIR1.Sim.RValsIso locRel + baselineSuffix.toList rewrittenSuffix.toList) : + LiveValuesIso source blockId pc locRel + (baseline ++ baselineSuffix) (rewritten ++ rewrittenSuffix) := by + have suffixLength : baselineSuffix.size = rewrittenSuffix.size := by + simpa using suffix.lengths + refine ⟨by simp [values.length, suffixLength], ?_⟩ + intro index baselineValue live found + rw [Array.getElem?_append] at found + by_cases inPrefix : index < baseline.size + · rw [if_pos inPrefix] at found + obtain ⟨rewrittenValue, rewrittenAt, related⟩ := + values.related live found + have targetPrefix : index < rewritten.size := by + simpa [values.length] using inPrefix + refine ⟨rewrittenValue, ?_, related⟩ + simpa [Array.getElem?_append, targetPrefix] using rewrittenAt + · rw [if_neg inPrefix] at found + have listFound : baselineSuffix.toList[index - baseline.size]? = + some baselineValue := by + simpa using found + obtain ⟨rewrittenValue, rewrittenListAt, related⟩ := + suffix.get? listFound + have targetPrefix : ¬index < rewritten.size := by + simpa [values.length] using inPrefix + have rewrittenAt : rewrittenSuffix[index - rewritten.size]? = + some rewrittenValue := by + simpa [values.length] using rewrittenListAt + refine ⟨rewrittenValue, ?_, related⟩ + simpa [Array.getElem?_append, targetPrefix] using rewrittenAt + +/-- Resolve a live operand in two liveness-related register files. -/ +theorem resolveAtom {source : Function} {blockId pc : Nat} + {locRel : Nat → Nat → Prop} {baseline rewritten : Array RVal} + (values : LiveValuesIso source blockId pc locRel baseline rewritten) + {atom : Atom} (live : AtomLiveFrom source blockId pc atom) + {baselineValue : RVal} + (resolved : Eval.resolveAtom baseline atom = .ok baselineValue) : + ∃ rewrittenValue, + Eval.resolveAtom rewritten atom = .ok rewrittenValue ∧ + IxIR1.Sim.RValIso locRel baselineValue rewrittenValue := by + cases atom with + | reg index => + cases found : baseline[index]? with + | none => simp [Eval.resolveAtom, found] at resolved + | some actual => + simp [Eval.resolveAtom, found] at resolved + subst actual + obtain ⟨rewrittenValue, rewrittenAt, related⟩ := + values.related live found + exact ⟨rewrittenValue, + by simp [Eval.resolveAtom, rewrittenAt], related⟩ + | lit literal => + simp [Eval.resolveAtom] at resolved + subst baselineValue + exact ⟨.lit literal, by simp [Eval.resolveAtom], .lit⟩ + | erased => + simp [Eval.resolveAtom] at resolved + subst baselineValue + exact ⟨.erased, by simp [Eval.resolveAtom], .erased⟩ + +private theorem resolveList {source : Function} {blockId pc : Nat} + {locRel : Nat → Nat → Prop} {baseline rewritten : Array RVal} + (values : LiveValuesIso source blockId pc locRel baseline rewritten) : + ∀ {atoms : List Atom}, + (∀ atom ∈ atoms, AtomLiveFrom source blockId pc atom) → + ∀ {baselineInitial baselineResult : Array RVal}, + atoms.foldlM (fun output atom => do + return output.push (← Eval.resolveAtom baseline atom)) + baselineInitial = .ok baselineResult → + ∀ {rewrittenInitial : Array RVal}, + IxIR1.Sim.RValsIso locRel baselineInitial.toList + rewrittenInitial.toList → + ∃ rewrittenResult, + atoms.foldlM (fun output atom => do + return output.push (← Eval.resolveAtom rewritten atom)) + rewrittenInitial = .ok rewrittenResult ∧ + IxIR1.Sim.RValsIso locRel baselineResult.toList + rewrittenResult.toList := by + intro atoms live + induction atoms with + | nil => + intro baselineInitial baselineResult resolved rewrittenInitial related + change (Except.ok baselineInitial : Except Eval.Error (Array RVal)) = + .ok baselineResult at resolved + cases Except.ok.inj resolved + exact ⟨rewrittenInitial, rfl, related⟩ + | cons atom atoms ih => + intro baselineInitial baselineResult resolved rewrittenInitial related + rw [List.foldlM_cons] at resolved + cases baselineResolved : Eval.resolveAtom baseline atom with + | error error => + simp only [baselineResolved, bind, Except.bind] at resolved + cases resolved + | ok baselineValue => + simp only [baselineResolved, bind, Except.bind] at resolved + obtain ⟨rewrittenValue, rewrittenResolved, valueRelated⟩ := + values.resolveAtom (live atom (by simp)) baselineResolved + have tailLive : ∀ tailAtom ∈ atoms, + AtomLiveFrom source blockId pc tailAtom := by + intro tailAtom member + exact live tailAtom (by simp [member]) + have pushedRelated : IxIR1.Sim.RValsIso locRel + (baselineInitial.push baselineValue).toList + (rewrittenInitial.push rewrittenValue).toList := by + simpa using rvalsIso_append_one related valueRelated + obtain ⟨rewrittenResult, rewrittenRun, resultRelated⟩ := + ih tailLive resolved pushedRelated + refine ⟨rewrittenResult, ?_, resultRelated⟩ + rw [List.foldlM_cons, rewrittenResolved] + exact rewrittenRun + +/-- Resolve a vector whose register operands are live at the current source +coordinate. -/ +theorem resolveAtoms {source : Function} {blockId pc : Nat} + {locRel : Nat → Nat → Prop} {baseline rewritten baselineValues : Array RVal} + (values : LiveValuesIso source blockId pc locRel baseline rewritten) + {atoms : Array Atom} (live : AtomsLiveFrom source blockId pc atoms) + (resolved : Eval.resolveAtoms baseline atoms = .ok baselineValues) : + ∃ rewrittenValues, + Eval.resolveAtoms rewritten atoms = .ok rewrittenValues ∧ + IxIR1.Sim.RValsIso locRel baselineValues.toList + rewrittenValues.toList := by + unfold Eval.resolveAtoms at resolved ⊢ + rw [← Array.foldlM_toList] + apply resolveList values live + (by simpa only [Array.foldlM_toList] using resolved) + exact .nil + +end LiveValuesIso + +namespace MappedValuesInRoots + +theorem mono {shape : Reuse.Shape} {values : Array RVal} + {before after : List IxIR1.Sim.Root} + (mapped : MappedValuesInRoots shape values before) + (subset : ∀ root ∈ before, root ∈ after) : + MappedValuesInRoots shape values after := by + intro sourceId targetId sourceValue relevant translated found + have supported := mapped sourceId targetId sourceValue relevant translated + found + cases sourceValue with + | loc location => + obtain ⟨world, member⟩ := supported + exact ⟨world, subset _ member⟩ + | lit literal => trivial + | erased => trivial + +/-- Planner root support pulls back through a target-to-baseline heap +isomorphism when the planner-observable register file is live-related. -/ +theorem preimage {limits : Validate.Limits} {validation : Validate.Context} + {source : Function} {blockId : Nat} {block : Block} + (site : Reuse.Site limits validation block) + (blockAt : source.blocks[blockId]? = some block) + {baselineStore rewrittenStore : IxIR1.Store} + (iso : IxIR1.Sim.HeapIso rewrittenStore baselineStore) + {baselineValues rewrittenValues : Array RVal} + (values : LiveValuesIso source blockId 0 + (fun baselineLocation rewrittenLocation => + iso.locRel rewrittenLocation baselineLocation) + baselineValues rewrittenValues) + {baselineRoots rewrittenRoots : List IxIR1.Sim.Root} + (roots : IxIR1.Sim.RootsIso iso.locRel rewrittenRoots baselineRoots) + (mapped : MappedValuesInRoots site.shape baselineValues baselineRoots) : + MappedValuesInRoots site.shape rewrittenValues rewrittenRoots := by + intro sourceId targetId rewrittenValue relevant translated rewrittenAt + have rewrittenBound : sourceId < rewrittenValues.size := + (Array.getElem?_eq_some_iff.mp rewrittenAt).1 + have baselineBound : sourceId < baselineValues.size := by + rw [values.length] + exact rewrittenBound + obtain ⟨baselineValue, baselineAt⟩ : + ∃ baselineValue, baselineValues[sourceId]? = some baselineValue := + ⟨baselineValues[sourceId], by simp⟩ + obtain ⟨actualRewritten, actualRewrittenAt, related⟩ := + values.related (plannerValueLiveAtEntry site blockAt relevant) baselineAt + have rewrittenEq : actualRewritten = rewrittenValue := + Option.some.inj (actualRewrittenAt.symm.trans rewrittenAt) + subst actualRewritten + have baselineSupported := mapped sourceId targetId baselineValue relevant + translated baselineAt + cases baselineValue with + | loc baselineLocation => + obtain ⟨baselineWorld, baselineMember⟩ := baselineSupported + obtain ⟨rewrittenRoot, rewrittenMember, rootRelated⟩ := + roots.left_of_right_mem baselineMember + rcases rewrittenRoot with ⟨rewrittenWorld, rewrittenRootValue⟩ + cases rootRelated.value with + | loc rootLocationRelated => + cases related with + | loc valueLocationRelated => + have locationEq := + iso.right_unique rootLocationRelated valueLocationRelated + subst_vars + exact ⟨rewrittenWorld, rewrittenMember⟩ + | lit literal => cases related; trivial + | erased => cases related; trivial + +end MappedValuesInRoots + +/-- Only source-live registers in a rewritten frame must avoid an address +whose allocation epoch is about to be replaced. -/ +def LiveValuesAvoidLocation (source : Function) (blockId pc location : Nat) + (values : Array RVal) : Prop := + ∀ {index : Nat} {value : RVal}, + ValueLiveFrom source blockId pc index → + values[index]? = some value → + value ≠ .loc location + +/-- A source frame and its rewritten counterpart agree at the same stable +control coordinate, but only future-observable value registers are related. +Credits remain fully related because their presence is checked at every call, +return, and CFG transfer boundary. -/ +structure StableLiveFrameIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + (locRel : Nat → Nat → Prop) (baseline rewritten : Frame) : Prop where + baselineDefinition : baseline.definition = source + rewrittenDefinition : rewritten.definition = rewrite.definition + block : baseline.block = rewritten.block + pc : baseline.pc = rewritten.pc + values : LiveValuesIso source baseline.block baseline.pc locRel + baseline.values rewritten.values + credits : StableCreditsIso locRel + baseline.credits.toList rewritten.credits.toList + +namespace StableLiveFrameIso + +/-- Entry frames retain the stronger pointwise relation supplied by argument +resolution. -/ +theorem entry {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {locRel : Nat → Nat → Prop} + {baselineValues rewrittenValues : Array RVal} + (values : IxIR1.Sim.RValsIso locRel + baselineValues.toList rewrittenValues.toList) : + StableLiveFrameIso rewrite locRel + { definition := source, values := baselineValues } + { definition := rewrite.definition, values := rewrittenValues } := by + exact ⟨rfl, rfl, rfl, rfl, LiveValuesIso.ofRValsIso values, .nil⟩ + +/-- Every old stable frame is also a live-indexed stable frame. -/ +theorem ofStable {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {locRel : Nat → Nat → Prop} {baseline rewritten : Frame} + (frame : StableFrameIso rewrite locRel baseline rewritten) : + StableLiveFrameIso rewrite locRel baseline rewritten := + ⟨frame.baselineDefinition, frame.rewrittenDefinition, frame.block, frame.pc, + LiveValuesIso.ofRValsIso frame.values, frame.credits⟩ + +/-- Suspending an advanced caller preserves every value that can still be +read when that caller resumes. -/ +theorem advance {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {locRel : Nat → Nat → Prop} {baseline rewritten : Frame} + (frame : StableLiveFrameIso rewrite locRel baseline rewritten) : + StableLiveFrameIso rewrite locRel + { baseline with pc := baseline.pc + 1 } + { rewritten with pc := rewritten.pc + 1 } := by + refine ⟨frame.baselineDefinition, frame.rewrittenDefinition, frame.block, + congrArg (fun pc => pc + 1) frame.pc, ?_, frame.credits⟩ + simpa using frame.values.advance + +/-- Advancing a frame and appending a related result preserves the +live-indexed relation. -/ +theorem advancePush {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {locRel : Nat → Nat → Prop} {baseline rewritten : Frame} + (frame : StableLiveFrameIso rewrite locRel baseline rewritten) + {baselineValue rewrittenValue : RVal} + (value : IxIR1.Sim.RValIso locRel baselineValue rewrittenValue) : + StableLiveFrameIso rewrite locRel + { baseline with + pc := baseline.pc + 1 + values := baseline.values.push baselineValue } + { rewritten with + pc := rewritten.pc + 1 + values := rewritten.values.push rewrittenValue } := by + refine ⟨frame.baselineDefinition, frame.rewrittenDefinition, frame.block, + congrArg (fun pc => pc + 1) frame.pc, ?_, frame.credits⟩ + simpa using frame.values.advance.push value + +/-- Appending a related return result at an already-advanced caller +coordinate preserves live-register agreement. -/ +theorem push {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {locRel : Nat → Nat → Prop} {baseline rewritten : Frame} + (frame : StableLiveFrameIso rewrite locRel baseline rewritten) + {baselineValue rewrittenValue : RVal} + (value : IxIR1.Sim.RValIso locRel baselineValue rewrittenValue) : + StableLiveFrameIso rewrite locRel + { baseline with values := baseline.values.push baselineValue } + { rewritten with values := rewritten.values.push rewrittenValue } := by + exact ⟨frame.baselineDefinition, frame.rewrittenDefinition, frame.block, + frame.pc, frame.values.push value, frame.credits⟩ + +/-- A successful current-block lookup dispatches through the retained rewrite +decision even though dead value slots are not related. -/ +theorem blockCase {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {locRel : Nat → Nat → Prop} {baseline rewritten : Frame} + (frame : StableLiveFrameIso rewrite locRel baseline rewritten) + {block : Block} + (found : baseline.definition.blocks[baseline.block]? = some block) : + Reuse.FunctionRewrite.BlockCase rewrite baseline.block := by + have sourceAt : source.blocks[baseline.block]? = some block := by + rw [← frame.baselineDefinition] + exact found + exact rewrite.blockCaseOfLookup sourceAt + +/-- Widening the heap-location relation preserves a live-indexed frame. -/ +theorem mono {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {oldRel newRel : Nat → Nat → Prop} {baseline rewritten : Frame} + (frame : StableLiveFrameIso rewrite oldRel baseline rewritten) + (lift : ∀ {baselineLocation rewrittenLocation}, + oldRel baselineLocation rewrittenLocation → + newRel baselineLocation rewrittenLocation) : + StableLiveFrameIso rewrite newRel baseline rewritten := + ⟨frame.baselineDefinition, frame.rewrittenDefinition, frame.block, frame.pc, + frame.values.mono lift, frame.credits.mono lift⟩ + +/-- Credit lookup is unchanged: credit slots remain related pointwise. -/ +theorem creditLookup {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {locRel : Nat → Nat → Prop} {baseline rewritten : Frame} + (frame : StableLiveFrameIso rewrite locRel baseline rewritten) + {id : CreditId} {baselineCredit : Credit} + (lookedUp : CreditLookup baseline id baselineCredit) : + ∃ rewrittenCredit, + CreditLookup rewritten id rewrittenCredit ∧ + StableCreditIso locRel (some baselineCredit) + (some rewrittenCredit) := by + have baselineFound : baseline.credits[id]? = some (some baselineCredit) := + (CreditTake.of_lookup lookedUp).target_eq.2 + have baselineListFound : baseline.credits.toList[id]? = + some (some baselineCredit) := by + simpa using baselineFound + obtain ⟨rewrittenSlot, rewrittenListFound, related⟩ := + frame.credits.get? baselineListFound + cases rewrittenSlot with + | none => cases related + | some rewrittenCredit => + have rewrittenFound : rewritten.credits[id]? = + some (some rewrittenCredit) := by + simpa using rewrittenListFound + exact ⟨rewrittenCredit, CreditLookup.of_getElem rewrittenFound, related⟩ + +/-- No-live-credit checks transport independently of dead value slots. -/ +theorem noLiveCredits {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {locRel : Nat → Nat → Prop} {baseline rewritten : Frame} + (frame : StableLiveFrameIso rewrite locRel baseline rewritten) + (cleared : NoLiveCredits baseline) : NoLiveCredits rewritten := by + unfold NoLiveCredits at cleared ⊢ + rw [← Array.any_toList] at cleared ⊢ + rw [← frame.credits.any_isSome_eq] + exact cleared + +/-- Consume corresponding credit slots without changing the live value +coordinate. -/ +theorem takeIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {locRel : Nat → Nat → Prop} {baseline rewritten baselineNext : Frame} + (frame : StableLiveFrameIso rewrite locRel baseline rewritten) + {id : CreditId} {baselineCredit : Credit} + (taken : CreditTake baseline id baselineNext baselineCredit) : + ∃ rewrittenNext rewrittenCredit, + CreditTake rewritten id rewrittenNext rewrittenCredit ∧ + StableCreditIso locRel (some baselineCredit) + (some rewrittenCredit) ∧ + StableLiveFrameIso rewrite locRel baselineNext rewrittenNext := by + obtain ⟨baselineNextEq, baselineFound⟩ := taken.target_eq + have baselineLookup : CreditLookup baseline id baselineCredit := + CreditLookup.of_getElem baselineFound + obtain ⟨rewrittenCredit, rewrittenLookup, creditRelated⟩ := + frame.creditLookup baselineLookup + let rewrittenNext : Frame := + { rewritten with + credits := rewritten.credits.setIfInBounds id none } + have rewrittenTaken : CreditTake rewritten id rewrittenNext + rewrittenCredit := CreditTake.of_lookup rewrittenLookup + refine ⟨rewrittenNext, rewrittenCredit, rewrittenTaken, creditRelated, ?_⟩ + subst baselineNext + exact ⟨frame.baselineDefinition, frame.rewrittenDefinition, frame.block, + frame.pc, frame.values, frame.credits.array_set_none id⟩ + +/-- Batch credit consumption is equivariant under a live-indexed frame +relation because credit files remain pointwise related. -/ +theorem takeManyIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {locRel : Nat → Nat → Prop} {baseline rewritten baselineNext : Frame} + (frame : StableLiveFrameIso rewrite locRel baseline rewritten) + {ids : Array CreditId} {baselineCredits : Array Credit} + (taken : CreditTakeMany baseline ids baselineNext baselineCredits) : + ∃ rewrittenNext rewrittenCredits, + CreditTakeMany rewritten ids rewrittenNext rewrittenCredits ∧ + StableCreditsIso locRel + (baselineCredits.map some).toList + (rewrittenCredits.map some).toList ∧ + StableLiveFrameIso rewrite locRel baselineNext rewrittenNext := by + have follow : ∀ {baselineCurrent : Frame} {remaining : List CreditId} + {baselineTarget : Frame} {baselineOutput : List Credit}, + CreditTakeSequence baselineCurrent remaining baselineTarget + baselineOutput → + ∀ {rewrittenCurrent : Frame}, + StableLiveFrameIso rewrite locRel baselineCurrent rewrittenCurrent → + ∃ rewrittenTarget rewrittenOutput, + CreditTakeSequence rewrittenCurrent remaining rewrittenTarget + rewrittenOutput ∧ + StableCreditsIso locRel (baselineOutput.map some) + (rewrittenOutput.map some) ∧ + StableLiveFrameIso rewrite locRel baselineTarget + rewrittenTarget := by + intro baselineCurrent remaining baselineTarget baselineOutput sequence + induction sequence with + | nil current => + intro rewrittenCurrent related + exact ⟨rewrittenCurrent, [], .nil rewrittenCurrent, .nil, related⟩ + | @cons current middle target id remaining credit credits head tail ih => + intro rewrittenCurrent related + obtain ⟨rewrittenMiddle, rewrittenCredit, rewrittenHead, + creditRelated, middleRelated⟩ := related.takeIso head + obtain ⟨rewrittenTarget, rewrittenCredits, rewrittenTail, + creditsRelated, targetRelated⟩ := ih middleRelated + exact ⟨rewrittenTarget, rewrittenCredit :: rewrittenCredits, + .cons rewrittenHead rewrittenTail, + .cons creditRelated creditsRelated, targetRelated⟩ + obtain ⟨rewrittenNext, rewrittenOutput, rewrittenSequence, + outputRelated, nextRelated⟩ := follow taken.sequence frame + let rewrittenCredits : Array Credit := rewrittenOutput.toArray + have rewrittenTaken : CreditTakeMany rewritten ids rewrittenNext + rewrittenCredits := by + simpa [rewrittenCredits] using rewrittenSequence.toMany + refine ⟨rewrittenNext, rewrittenCredits, rewrittenTaken, ?_, nextRelated⟩ + simpa [rewrittenCredits] using outputRelated + +/-- Consume corresponding credit slots after advancing the instruction +coordinate. -/ +theorem advanceTakeIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {locRel : Nat → Nat → Prop} {baseline rewritten baselineNext : Frame} + (frame : StableLiveFrameIso rewrite locRel baseline rewritten) + {id : CreditId} {baselineCredit : Credit} + (taken : CreditTake { baseline with pc := baseline.pc + 1 } + id baselineNext baselineCredit) : + ∃ rewrittenNext rewrittenCredit, + CreditTake { rewritten with pc := rewritten.pc + 1 } + id rewrittenNext rewrittenCredit ∧ + StableCreditIso locRel (some baselineCredit) + (some rewrittenCredit) ∧ + StableLiveFrameIso rewrite locRel baselineNext rewrittenNext := by + obtain ⟨baselineNextEq, baselineFound⟩ := taken.target_eq + have baselineLookup : CreditLookup baseline id baselineCredit := + CreditLookup.of_getElem baselineFound + obtain ⟨rewrittenCredit, rewrittenLookup, creditRelated⟩ := + frame.creditLookup baselineLookup + let rewrittenNext : Frame := + { rewritten with + pc := rewritten.pc + 1 + credits := rewritten.credits.setIfInBounds id none } + have rewrittenTaken : CreditTake + { rewritten with pc := rewritten.pc + 1 } + id rewrittenNext rewrittenCredit := by + exact CreditTake.of_lookup (rewrittenLookup.congrDefinition + rewritten.definition) + refine ⟨rewrittenNext, rewrittenCredit, rewrittenTaken, creditRelated, ?_⟩ + subst baselineNext + exact ⟨frame.baselineDefinition, frame.rewrittenDefinition, frame.block, + congrArg (fun pc => pc + 1) frame.pc, frame.values.advance, + frame.credits.array_set_none id⟩ + +/-- Advance while appending related field vectors and one related credit. -/ +theorem advanceAppendCreditIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {locRel : Nat → Nat → Prop} {baseline rewritten : Frame} + (frame : StableLiveFrameIso rewrite locRel baseline rewritten) + {baselineFields rewrittenFields : Array RVal} + (fields : IxIR1.Sim.RValsIso locRel + baselineFields.toList rewrittenFields.toList) + {baselineCredit rewrittenCredit : Credit} + (credit : StableCreditIso locRel (some baselineCredit) + (some rewrittenCredit)) : + StableLiveFrameIso rewrite locRel + { baseline with + pc := baseline.pc + 1 + values := baseline.values ++ baselineFields + credits := baseline.credits.push (some baselineCredit) } + { rewritten with + pc := rewritten.pc + 1 + values := rewritten.values ++ rewrittenFields + credits := rewritten.credits.push (some rewrittenCredit) } := by + refine ⟨frame.baselineDefinition, frame.rewrittenDefinition, frame.block, + congrArg (fun pc => pc + 1) frame.pc, ?_, ?_⟩ + · simpa using frame.values.advance.append fields + · simpa using frame.credits.append (.cons credit .nil) + +/-- A checked edge transfer resolves only the edge operands, consumes the +fully related credit vector, and enters a target frame whose fresh ABI is +pointwise related. -/ +theorem edgeTransferIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {locRel : Nat → Nat → Prop} {baseline rewritten baselineTarget : Frame} + (frame : StableLiveFrameIso rewrite locRel baseline rewritten) + {edge : Edge} + (edgeLive : AtomsLiveFrom source baseline.block baseline.pc edge.values) + {baselineImplicit rewrittenImplicit : Array RVal} + (implicitValues : IxIR1.Sim.RValsIso locRel + baselineImplicit.toList rewrittenImplicit.toList) + (transferred : EdgeTransfer baseline edge baselineImplicit + baselineTarget) : + ∃ rewrittenTarget, + EdgeTransfer rewritten edge rewrittenImplicit rewrittenTarget ∧ + StableLiveFrameIso rewrite locRel baselineTarget rewrittenTarget := by + obtain ⟨baselineValues, baselineCredits, baselineAfter, sourceBlock, + baselineResolved, baselineTaken, baselineCleared, sourceBlockAt, + baselineValueArity, baselineCreditArity, baselineTargetEq⟩ := + transferred.parts + obtain ⟨rewrittenValues, rewrittenResolved, valuesRelated⟩ := + frame.values.resolveAtoms edgeLive baselineResolved + obtain ⟨rewrittenAfter, rewrittenCredits, rewrittenTaken, + creditsRelated, afterRelated⟩ := frame.takeManyIso baselineTaken + have rewrittenCleared : NoLiveCredits rewrittenAfter := + afterRelated.noLiveCredits baselineCleared + have sourceBlockAt' : source.blocks[edge.target]? = some sourceBlock := by + rw [← afterRelated.baselineDefinition] + exact sourceBlockAt + obtain ⟨rewrittenBlock, rewrittenBlockAt, valueParams, creditParams⟩ := + rewrite.targetBlockAbi sourceBlockAt' + have rewrittenBlockAt' : + rewrittenAfter.definition.blocks[edge.target]? = + some rewrittenBlock := by + rw [afterRelated.rewrittenDefinition] + exact rewrittenBlockAt + have allValuesRelated : IxIR1.Sim.RValsIso locRel + (baselineImplicit ++ baselineValues).toList + (rewrittenImplicit ++ rewrittenValues).toList := by + simpa using implicitValues.append valuesRelated + have valueSizes : (baselineImplicit ++ baselineValues).size = + (rewrittenImplicit ++ rewrittenValues).size := by + simpa using allValuesRelated.lengths + have rewrittenValueArity : + (rewrittenImplicit ++ rewrittenValues).size = + rewrittenBlock.valueParams.size := + valueSizes.symm.trans <| baselineValueArity.trans <| + (congrArg Array.size valueParams).symm + have creditSizes : baselineCredits.size = rewrittenCredits.size := by + simpa using creditsRelated.length_eq + have rewrittenCreditArity : rewrittenCredits.size = + rewrittenBlock.creditParams.size := + creditSizes.symm.trans <| baselineCreditArity.trans <| + (congrArg Array.size creditParams).symm + let rewrittenTarget : Frame := + { rewrittenAfter with + block := edge.target + pc := 0 + values := rewrittenImplicit ++ rewrittenValues + credits := rewrittenCredits.map some } + have rewrittenTransferred : EdgeTransfer rewritten edge rewrittenImplicit + rewrittenTarget := by + exact EdgeTransfer.of_parts rewrittenResolved rewrittenTaken + rewrittenCleared rewrittenBlockAt' rewrittenValueArity + rewrittenCreditArity + refine ⟨rewrittenTarget, rewrittenTransferred, ?_⟩ + subst baselineTarget + exact ⟨afterRelated.baselineDefinition, afterRelated.rewrittenDefinition, + rfl, rfl, LiveValuesIso.ofRValsIso allValuesRelated, creditsRelated⟩ + +/-- Replace a heap-location relation while preserving only the live register +pairs. Dead append-only slots may still contain the reused address and impose +no premise. -/ +theorem transportRelation {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {oldRel newRel : Nat → Nat → Prop} {removed : Nat} + {baseline rewritten : Frame} + (frame : StableLiveFrameIso rewrite oldRel baseline rewritten) + (avoids : LiveValuesAvoidLocation source rewritten.block rewritten.pc + removed rewritten.values) + (creditsAvoid : FrameCreditsAvoidLocation removed rewritten) + (lift : ∀ {baselineLocation rewrittenLocation}, + oldRel baselineLocation rewrittenLocation → + rewrittenLocation ≠ removed → + newRel baselineLocation rewrittenLocation) : + StableLiveFrameIso rewrite newRel baseline rewritten := by + refine ⟨frame.baselineDefinition, frame.rewrittenDefinition, frame.block, + frame.pc, ⟨frame.values.length, ?_⟩, + frame.credits.transportRelation creditsAvoid lift⟩ + intro index baselineValue live found + obtain ⟨rewrittenValue, rewrittenAt, related⟩ := + frame.values.related live found + have targetLive : ValueLiveFrom source rewritten.block rewritten.pc index := by + simpa [frame.block, frame.pc] using live + have targetAvoid : rewrittenValue ≠ .loc removed := + avoids targetLive rewrittenAt + refine ⟨rewrittenValue, rewrittenAt, ?_⟩ + cases related with + | loc locationRelated => + exact .loc (lift locationRelated (by + intro same + apply targetAvoid + cases same + rfl)) + | lit => exact .lit + | erased => exact .erased + +end StableLiveFrameIso + +/-- Existential function selection for a live-indexed stable frame. -/ +inductive StableLiveFrameRel (limits : Validate.Limits) + (validation : Validate.Context) (locRel : Nat → Nat → Prop) : + Frame → Frame → Prop where + | rewritten {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baseline rewritten : Frame} + (frame : StableLiveFrameIso rewrite locRel baseline rewritten) : + StableLiveFrameRel limits validation locRel baseline rewritten + +/-- Continuations use live-indexed caller frames. Every pending +over-application argument remains fully related. -/ +inductive StableLiveContinuationIso (limits : Validate.Limits) + (validation : Validate.Context) (locRel : Nat → Nat → Prop) : + Continuation → Continuation → Prop where + | resume {baseline rewritten : Frame} + (frame : StableLiveFrameRel limits validation locRel baseline rewritten) : + StableLiveContinuationIso limits validation locRel + (.resume baseline) (.resume rewritten) + | applyMore {baselineArguments rewrittenArguments : Array RVal} + {baseline rewritten : Frame} + (arguments : IxIR1.Sim.RValsIso locRel + baselineArguments.toList rewrittenArguments.toList) + (frame : StableLiveFrameRel limits validation locRel baseline rewritten) : + StableLiveContinuationIso limits validation locRel + (.applyMore baselineArguments baseline) + (.applyMore rewrittenArguments rewritten) + +inductive StableLiveStackIso (limits : Validate.Limits) + (validation : Validate.Context) (locRel : Nat → Nat → Prop) : + List Continuation → List Continuation → Prop where + | nil : StableLiveStackIso limits validation locRel [] [] + | cons {baseline rewritten : Continuation} + {baselineTail rewrittenTail : List Continuation} + (head : StableLiveContinuationIso limits validation locRel + baseline rewritten) + (tail : StableLiveStackIso limits validation locRel + baselineTail rewrittenTail) : + StableLiveStackIso limits validation locRel + (baseline :: baselineTail) (rewritten :: rewrittenTail) + +/-- Related argument vectors enter a related rewritten callee. -/ +theorem StableLiveFrameRel.entry {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {locRel : Nat → Nat → Prop} + {baselineValues rewrittenValues : Array RVal} + (values : IxIR1.Sim.RValsIso locRel + baselineValues.toList rewrittenValues.toList) : + StableLiveFrameRel limits validation locRel + { definition := source, values := baselineValues } + { definition := rewrite.definition, values := rewrittenValues } := + .rewritten rewrite (StableLiveFrameIso.entry rewrite values) + +/-- Widen the location relation of an existentially selected frame rewrite. -/ +theorem StableLiveFrameRel.mono {limits : Validate.Limits} + {validation : Validate.Context} {oldRel newRel : Nat → Nat → Prop} + {baseline rewritten : Frame} + (frame : StableLiveFrameRel limits validation oldRel baseline rewritten) + (lift : ∀ {baselineLocation rewrittenLocation}, + oldRel baselineLocation rewrittenLocation → + newRel baselineLocation rewrittenLocation) : + StableLiveFrameRel limits validation newRel baseline rewritten := by + cases frame with + | rewritten rewrite related => exact .rewritten rewrite (related.mono lift) + +/-- Append a related return value to an existentially selected suspended +caller frame. -/ +theorem StableLiveFrameRel.push {limits : Validate.Limits} + {validation : Validate.Context} {locRel : Nat → Nat → Prop} + {baseline rewritten : Frame} + (frame : StableLiveFrameRel limits validation locRel baseline rewritten) + {baselineValue rewrittenValue : RVal} + (value : IxIR1.Sim.RValIso locRel baselineValue rewrittenValue) : + StableLiveFrameRel limits validation locRel + { baseline with values := baseline.values.push baselineValue } + { rewritten with values := rewritten.values.push rewrittenValue } := by + cases frame with + | rewritten rewrite related => exact .rewritten rewrite (related.push value) + +/-- Widen the location relation through one continuation. -/ +theorem StableLiveContinuationIso.mono {limits : Validate.Limits} + {validation : Validate.Context} {oldRel newRel : Nat → Nat → Prop} + {baseline rewritten : Continuation} + (continuation : StableLiveContinuationIso limits validation oldRel + baseline rewritten) + (lift : ∀ {baselineLocation rewrittenLocation}, + oldRel baselineLocation rewrittenLocation → + newRel baselineLocation rewrittenLocation) : + StableLiveContinuationIso limits validation newRel baseline rewritten := by + cases continuation with + | resume frame => exact .resume (frame.mono lift) + | applyMore arguments frame => + exact .applyMore (arguments.mono lift) (frame.mono lift) + +/-- Choose matching resume or `applyMore` continuations from related excess +argument vectors. -/ +theorem StableLiveContinuationIso.applyMoreOrResumeIso + {limits : Validate.Limits} {validation : Validate.Context} + {locRel : Nat → Nat → Prop} + {baselineArguments rewrittenArguments : Array RVal} + {baseline rewritten : Frame} + (arguments : IxIR1.Sim.RValsIso locRel + baselineArguments.toList rewrittenArguments.toList) + (frame : StableLiveFrameRel limits validation locRel baseline rewritten) : + StableLiveContinuationIso limits validation locRel + (if baselineArguments.isEmpty then .resume baseline + else .applyMore baselineArguments baseline) + (if rewrittenArguments.isEmpty then .resume rewritten + else .applyMore rewrittenArguments rewritten) := by + have sizes : baselineArguments.size = rewrittenArguments.size := by + simpa using arguments.lengths + have emptyEq : baselineArguments.isEmpty = rewrittenArguments.isEmpty := by + simp [Array.isEmpty, sizes] + by_cases empty : baselineArguments.isEmpty + · have rewrittenEmpty : rewrittenArguments.isEmpty := by + simpa [emptyEq] using empty + simp only [empty, rewrittenEmpty] + exact .resume frame + · have rewrittenNonempty : ¬ rewrittenArguments.isEmpty := by + simpa [emptyEq] using empty + simp only [empty, rewrittenNonempty] + exact .applyMore arguments frame + +/-- Widen the location relation through a suspended stack. -/ +theorem StableLiveStackIso.mono {limits : Validate.Limits} + {validation : Validate.Context} {oldRel newRel : Nat → Nat → Prop} + {baseline rewritten : List Continuation} + (stack : StableLiveStackIso limits validation oldRel baseline rewritten) + (lift : ∀ {baselineLocation rewrittenLocation}, + oldRel baselineLocation rewrittenLocation → + newRel baselineLocation rewrittenLocation) : + StableLiveStackIso limits validation newRel baseline rewritten := by + induction stack with + | nil => exact .nil + | cons head tail ih => exact .cons (head.mono lift) ih + +/-! ## Compiler roots for observable suspended values -/ + +/-- Exact heap ownership makes a vector of shared values executable by the +batch retain primitive. Besides constructing the evaluator run, this records +one new external root per retained value in source order. Scalar values are +admitted as inert roots, while location retains increment the matching shared +node and preserve every remaining value's world. -/ +theorem retainSharedMany_of_rootOwnership + {store : Store} {values : List RVal} {roots : List IxIR1.Sim.Root} + (worlds : ∀ value ∈ values, + IxIR1.Sim.HasWorld store.heap .shared value) + (ownership : IxIR1.Sim.RootOwnership store.heap roots) : + ∃ target, + RetainSharedMany store values.toArray target ∧ + IxIR1.Sim.RootOwnership target.heap + (IxIR1.Sim.rootsFor .shared values ++ roots) ∧ + IxIR1.Sim.StoreGraphExtends store.heap target.heap := by + induction values generalizing store roots with + | nil => + exact ⟨store, RetainSharedMany.empty store, by + simpa [IxIR1.Sim.rootsFor] using ownership, + IxIR1.Sim.StoreGraphExtends.refl store.heap⟩ + | cons value values ih => + have valueWorld := worlds value (by simp) + have tailWorlds : ∀ child ∈ values, + IxIR1.Sim.HasWorld store.heap .shared child := by + intro child member + exact worlds child (by simp [member]) + cases value with + | lit literal => + have headRun : retainShared store (.lit literal) = .ok store := rfl + have headOwnership : IxIR1.Sim.RootOwnership store.heap + (⟨.shared, .lit literal⟩ :: roots) := + ownership.addNoLocation rfl + obtain ⟨target, tailRun, targetOwnership, extension⟩ := + ih tailWorlds headOwnership + refine ⟨target, RetainSharedMany.cons headRun tailRun, ?_, + extension⟩ + · apply targetOwnership.perm + simp [IxIR1.Sim.rootsFor] + | erased => + have headRun : retainShared store .erased = .ok store := rfl + have headOwnership : IxIR1.Sim.RootOwnership store.heap + (⟨.shared, .erased⟩ :: roots) := + ownership.addNoLocation rfl + obtain ⟨target, tailRun, targetOwnership, extension⟩ := + ih tailWorlds headOwnership + refine ⟨target, RetainSharedMany.cons headRun tailRun, ?_, + extension⟩ + · apply targetOwnership.perm + simp [IxIR1.Sim.rootsFor] + | loc location => + obtain ⟨box, found, boxWorld⟩ := valueWorld + cases box with + | mk world rc node => + simp only at boxWorld + subst world + let middle := incrementSharedStore store location + ⟨.shared, rc, node⟩ + have headRun : retainShared store (.loc location) = + .ok middle := by + have found' : store.get? location = + some ⟨.shared, rc, node⟩ := by + simpa [Store.get?] using found + simp [retainShared, found', middle, incrementSharedStore] + have headOwnership : IxIR1.Sim.RootOwnership middle.heap + (⟨.shared, .loc location⟩ :: roots) := by + simpa [middle] using ownership.retainShared found + have tailWorldsMiddle : ∀ child ∈ values, + IxIR1.Sim.HasWorld middle.heap .shared child := by + intro child member + exact (tailWorlds child member).monoStore + (IxIR1.Sim.StoreGraphExtends.incRcStore found) + obtain ⟨target, tailRun, targetOwnership, tailExtension⟩ := + ih tailWorldsMiddle headOwnership + refine ⟨target, RetainSharedMany.cons headRun tailRun, ?_, + IxIR1.Sim.StoreGraphExtends.trans + (IxIR1.Sim.StoreGraphExtends.incRcStore found) + tailExtension⟩ + · apply targetOwnership.perm + simp [IxIR1.Sim.rootsFor] + +/-- Opening the fields of an owned shared constructor therefore always has a +successful batch-retain execution. The output ownership is the exact +old-field/source/ambient root list needed by accepted reset accounting. -/ +theorem retainCtorFields_of_rootOwnership + {store : Store} {location rc : Nat} {cid : CtorId} + {fields : Array RVal} {rest : List IxIR1.Sim.Root} + (sourceAt : store.get? location = + some ⟨.shared, rc, .ctorN cid fields⟩) + (ownership : IxIR1.Sim.RootOwnership store.heap + (⟨.shared, .loc location⟩ :: rest)) : + ∃ target, + RetainSharedMany store fields target ∧ + IxIR1.Sim.RootOwnership target.heap + (IxIR1.Sim.rootsFor .shared fields.toList ++ + ⟨.shared, .loc location⟩ :: rest) ∧ + IxIR1.Sim.StoreGraphExtends store.heap target.heap := by + apply retainSharedMany_of_rootOwnership + · intro value member + exact ownership.edges_world sourceAt value (by + simpa [IxIR1.Sim.nodeChildren] using member) + · exact ownership + +/-- Address-bearing roots retain both the ownership world and the concrete +heap slot. Scalars are omitted because they contribute no incoming edge. -/ +private def rootAddress? : IxIR1.Sim.Root → Option (Ixon.Owned × Nat) + | ⟨world, .loc location⟩ => some (world, location) + | ⟨_, .lit _⟩ | ⟨_, .erased⟩ => none + +private def addressedRoots + (roots : List IxIR1.Sim.Root) : List IxIR1.Sim.Root := + (roots.filterMap rootAddress?).map fun (world, location) => + ⟨world, .loc location⟩ + +/-- An inert root carries a scalar value and therefore contributes no heap +ownership count. -/ +def inertRoot : IxIR1.Sim.Root → Bool + | ⟨_, .loc _⟩ => false + | ⟨_, .lit _⟩ | ⟨_, .erased⟩ => true + +def inertRoots (roots : List IxIR1.Sim.Root) : List IxIR1.Sim.Root := + roots.filter inertRoot + +private theorem address_count_eq_location_count + {store : IxIR1.Store} {roots : List IxIR1.Sim.Root} + (worlds : ∀ root ∈ roots, + IxIR1.Sim.HasWorld store root.world root.value) + {world : Ixon.Owned} {location rc : Nat} {node : IxIR1.Node} + (found : store.get? location = some ⟨world, rc, node⟩) : + List.count (world, location) (roots.filterMap rootAddress?) = + List.count location (roots.filterMap IxIR1.Sim.rootLocation?) := by + induction roots with + | nil => simp + | cons root roots ih => + have headWorld := worlds root (by simp) + have tailWorlds : ∀ candidate ∈ roots, + IxIR1.Sim.HasWorld store candidate.world candidate.value := by + intro candidate member + exact worlds candidate (by simp [member]) + have tail := ih tailWorlds + rcases root with ⟨rootWorld, value⟩ + cases value with + | lit literal => + change List.count (world, location) + (roots.filterMap rootAddress?) = + List.count location + (roots.filterMap IxIR1.Sim.rootLocation?) + exact tail + | erased => + change List.count (world, location) + (roots.filterMap rootAddress?) = + List.count location + (roots.filterMap IxIR1.Sim.rootLocation?) + exact tail + | loc rootLocation => + by_cases same : rootLocation = location + · subst rootLocation + obtain ⟨box, boxAt, boxWorld⟩ := headWorld + have boxEq : box = ⟨world, rc, node⟩ := + Option.some.inj (boxAt.symm.trans found) + subst box + have rootWorldEq : rootWorld = world := boxWorld.symm + subst rootWorld + change List.count (world, location) + ((world, location) :: roots.filterMap rootAddress?) = + List.count location + (location :: roots.filterMap IxIR1.Sim.rootLocation?) + simp [tail] + · have addressNe : (rootWorld, rootLocation) ≠ + (world, location) := by + intro equal + exact same (congrArg Prod.snd equal) + change List.count (world, location) + ((rootWorld, rootLocation) :: + roots.filterMap rootAddress?) = + List.count location + (rootLocation :: + roots.filterMap IxIR1.Sim.rootLocation?) + simp [addressNe, same, tail] + +private theorem address_absent_of_dead + {store : IxIR1.Store} {roots : List IxIR1.Sim.Root} + (worlds : ∀ root ∈ roots, + IxIR1.Sim.HasWorld store root.world root.value) + {world : Ixon.Owned} {location : Nat} + (dead : store.get? location = none) : + (world, location) ∉ roots.filterMap rootAddress? := by + intro member + rw [List.mem_filterMap] at member + obtain ⟨root, rootMember, address⟩ := member + rcases root with ⟨rootWorld, value⟩ + cases value with + | lit literal => simp [rootAddress?] at address + | erased => simp [rootAddress?] at address + | loc rootLocation => + simp only [rootAddress?, Option.some.injEq, Prod.mk.injEq] at address + obtain ⟨worldEq, locationEq⟩ := address + subst rootWorld + subst rootLocation + obtain ⟨box, boxAt, _⟩ := worlds _ rootMember + rw [dead] at boxAt + contradiction + +private theorem address_absent_of_world_ne + {store : IxIR1.Store} {roots : List IxIR1.Sim.Root} + (worlds : ∀ root ∈ roots, + IxIR1.Sim.HasWorld store root.world root.value) + {world actualWorld : Ixon.Owned} {location rc : Nat} + {node : IxIR1.Node} + (found : store.get? location = some ⟨actualWorld, rc, node⟩) + (different : world ≠ actualWorld) : + (world, location) ∉ roots.filterMap rootAddress? := by + intro member + rw [List.mem_filterMap] at member + obtain ⟨root, rootMember, address⟩ := member + rcases root with ⟨rootWorld, value⟩ + cases value with + | lit literal => simp [rootAddress?] at address + | erased => simp [rootAddress?] at address + | loc rootLocation => + simp only [rootAddress?, Option.some.injEq, Prod.mk.injEq] at address + obtain ⟨worldEq, locationEq⟩ := address + subst rootWorld + subst rootLocation + obtain ⟨box, boxAt, boxWorld⟩ := worlds _ rootMember + have boxEq : box = ⟨actualWorld, rc, node⟩ := + Option.some.inj (boxAt.symm.trans found) + subst box + exact different boxWorld.symm + +private theorem rootOwnership_addressCount_eq + {store : IxIR1.Store} {left right : List IxIR1.Sim.Root} + (leftOwned : IxIR1.Sim.RootOwnership store left) + (rightOwned : IxIR1.Sim.RootOwnership store right) + (address : Ixon.Owned × Nat) : + List.count address (left.filterMap rootAddress?) = + List.count address (right.filterMap rootAddress?) := by + rcases address with ⟨world, location⟩ + cases found : store.get? location with + | none => + rw [List.count_eq_zero.mpr + (address_absent_of_dead leftOwned.roots_world found), + List.count_eq_zero.mpr + (address_absent_of_dead rightOwned.roots_world found)] + | some box => + rcases box with ⟨actualWorld, rc, node⟩ + by_cases worldEq : world = actualWorld + · subst world + rw [address_count_eq_location_count leftOwned.roots_world found, + address_count_eq_location_count rightOwned.roots_world found] + have incomingEq : IxIR1.Sim.incoming store left location = + IxIR1.Sim.incoming store right location := by + cases actualWorld with + | shared => + exact (leftOwned.counts found).symm.trans + (rightOwned.counts found) + | unique => + exact (leftOwned.counts found).2.trans + (rightOwned.counts found).2.symm + simp only [IxIR1.Sim.incoming, List.count_append] at incomingEq + omega + · rw [List.count_eq_zero.mpr + (address_absent_of_world_ne leftOwned.roots_world found worldEq), + List.count_eq_zero.mpr + (address_absent_of_world_ne rightOwned.roots_world found worldEq)] + +private theorem addressedRoots_perm + {store : IxIR1.Store} {left right : List IxIR1.Sim.Root} + (leftOwned : IxIR1.Sim.RootOwnership store left) + (rightOwned : IxIR1.Sim.RootOwnership store right) : + (addressedRoots left).Perm (addressedRoots right) := by + have addresses : (left.filterMap rootAddress?).Perm + (right.filterMap rootAddress?) := by + rw [List.perm_iff_count] + exact rootOwnership_addressCount_eq leftOwned rightOwned + exact addresses.map fun (world, location) => + (⟨world, .loc location⟩ : IxIR1.Sim.Root) + +private theorem mem_addressedRoots_loc_iff + {roots : List IxIR1.Sim.Root} {world : Ixon.Owned} {location : Nat} : + (⟨world, .loc location⟩ : IxIR1.Sim.Root) ∈ addressedRoots roots ↔ + (⟨world, .loc location⟩ : IxIR1.Sim.Root) ∈ roots := by + constructor + · intro member + rw [addressedRoots, List.mem_map] at member + obtain ⟨⟨actualWorld, actualLocation⟩, addressMember, + rootEq⟩ := member + cases rootEq + rw [List.mem_filterMap] at addressMember + obtain ⟨root, rootMember, addressEq⟩ := addressMember + rcases root with ⟨rootWorld, value⟩ + cases value with + | loc rootLocation => + simp only [rootAddress?, Option.some.injEq, Prod.mk.injEq] at addressEq + obtain ⟨rootWorldEq, rootLocationEq⟩ := addressEq + subst rootWorld + subst rootLocation + exact rootMember + | lit literal => simp [rootAddress?] at addressEq + | erased => simp [rootAddress?] at addressEq + · intro member + rw [addressedRoots, List.mem_map] + refine ⟨(world, location), ?_, rfl⟩ + rw [List.mem_filterMap] + exact ⟨⟨world, .loc location⟩, member, rfl⟩ + +/-- Exact ownership transports support for every address-bearing planner +value between root presentations of the same heap. Scalar planner values do +not require a root witness, so differences in inert scalar padding are +irrelevant. -/ +theorem MappedValuesInRoots.transportOwnership + {shape : Reuse.Shape} {values : Array RVal} {store : IxIR1.Store} + {before after : List IxIR1.Sim.Root} + (mapped : MappedValuesInRoots shape values before) + (beforeOwned : IxIR1.Sim.RootOwnership store before) + (afterOwned : IxIR1.Sim.RootOwnership store after) : + MappedValuesInRoots shape values after := by + intro sourceId targetId sourceValue relevant translated found + have supported := mapped sourceId targetId sourceValue relevant translated + found + cases sourceValue with + | lit literal => trivial + | erased => trivial + | loc location => + obtain ⟨world, member⟩ := supported + have addressedMember : + (⟨world, .loc location⟩ : IxIR1.Sim.Root) ∈ + addressedRoots before := by + exact mem_addressedRoots_loc_iff.mpr member + have transported : + (⟨world, .loc location⟩ : IxIR1.Sim.Root) ∈ + addressedRoots after := + (addressedRoots_perm beforeOwned afterOwned).mem_iff.mp + addressedMember + exact ⟨world, by + exact mem_addressedRoots_loc_iff.mp transported⟩ + +private theorem addressed_inert_perm (roots : List IxIR1.Sim.Root) : + (addressedRoots roots ++ inertRoots roots).Perm roots := by + induction roots with + | nil => simp [addressedRoots, inertRoots] + | cons root roots ih => + rcases root with ⟨world, value⟩ + cases value with + | loc location => + change + (⟨world, .loc location⟩ :: + (addressedRoots roots ++ inertRoots roots)).Perm + (⟨world, .loc location⟩ :: roots) + exact ih.cons _ + | lit literal => + change + (addressedRoots roots ++ + ⟨world, .lit literal⟩ :: inertRoots roots).Perm + (⟨world, .lit literal⟩ :: roots) + exact List.perm_middle.trans (ih.cons _) + | erased => + change + (addressedRoots roots ++ + ⟨world, .erased⟩ :: inertRoots roots).Perm + (⟨world, .erased⟩ :: roots) + exact List.perm_middle.trans (ih.cons _) + +/-- Exact ownership uniquely determines the multiset of address-bearing +roots. Consequently two valid presentations can be balanced into an exact +`List.Perm` by appending only the other presentation's inert scalar roots. +This is the ownership-level bridge from compiler capability lists to the +field/root partitions consumed by physical reuse. -/ +theorem balanceInertRoots + {store : IxIR1.Store} {left right : List IxIR1.Sim.Root} + (leftOwned : IxIR1.Sim.RootOwnership store left) + (rightOwned : IxIR1.Sim.RootOwnership store right) : + (left ++ inertRoots right).Perm (right ++ inertRoots left) := by + have locations := addressedRoots_perm leftOwned rightOwned + have leftSplit := addressed_inert_perm left + have rightSplit := addressed_inert_perm right + have first : (left ++ inertRoots right).Perm + ((addressedRoots left ++ inertRoots left) ++ inertRoots right) := + leftSplit.symm.append_right _ + have locationStep : + ((addressedRoots left ++ inertRoots left) ++ inertRoots right).Perm + ((addressedRoots right ++ inertRoots left) ++ inertRoots right) := by + simpa [List.append_assoc] using + locations.append_right (inertRoots left ++ inertRoots right) + have inertStep : + ((addressedRoots right ++ inertRoots left) ++ inertRoots right).Perm + ((addressedRoots right ++ inertRoots right) ++ inertRoots left) := by + simpa [List.append_assoc] using + (List.perm_append_comm + (l₁ := inertRoots left) (l₂ := inertRoots right)).append_left + (addressedRoots right) + exact first.trans (locationStep.trans + (inertStep.trans (rightSplit.append_right _))) + +/-- Any scalar padding may be appended to an exact ownership presentation +without changing the heap's incoming-owner equations. -/ +theorem addInertRoots + {store : IxIR1.Store} {roots extra : List IxIR1.Sim.Root} + (ownership : IxIR1.Sim.RootOwnership store roots) : + IxIR1.Sim.RootOwnership store (roots ++ inertRoots extra) := by + induction extra with + | nil => simpa [inertRoots] using ownership + | cons root extra ih => + rcases root with ⟨world, value⟩ + cases value with + | loc location => simpa [inertRoots, inertRoot] using ih + | lit literal => + have added := ih.addNoLocation + (world := world) (value := (.lit literal : RVal)) rfl + apply added.perm + exact List.perm_middle.symm + | erased => + have added := ih.addNoLocation + (world := world) (value := (.erased : RVal)) rfl + apply added.perm + exact List.perm_middle.symm + +/-- Two exact pre-allocation ownership presentations induce the physical +reuse partition once each ambient tail is padded by the other side's inert +roots. Address-bearing roots are matched by exact incoming counts; scalar +padding supplies only the syntactic multiset balance required by `List.Perm`. +-/ +theorem fieldRootPartition + {store : IxIR1.Store} {oldFields newFields : List RVal} + {oldRest newRest : List IxIR1.Sim.Root} + (oldOwned : IxIR1.Sim.RootOwnership store + (IxIR1.Sim.rootsFor .shared oldFields ++ oldRest)) + (newOwned : IxIR1.Sim.RootOwnership store + (IxIR1.Sim.rootsFor .shared newFields ++ newRest)) : + (IxIR1.Sim.rootsFor .shared oldFields ++ + (oldRest ++ inertRoots + (IxIR1.Sim.rootsFor .shared newFields ++ newRest))).Perm + (IxIR1.Sim.rootsFor .shared newFields ++ + (newRest ++ inertRoots + (IxIR1.Sim.rootsFor .shared oldFields ++ oldRest))) := by + simpa [List.append_assoc] using balanceInertRoots oldOwned newOwned + +/-- The successful hot baseline retain/release prefix converts the accepted +parent owner into the old-field ownership presentation on the allocation +heap. Comparing it with any exact checked pre-allocation presentation yields +the physical-reuse partition; inert scalar roots are added symmetrically +because they have no representation in the heap's incoming counts. -/ +theorem hotPrefixFieldRootPartition + {store retained released : Store} {location : Nat} {cid : CtorId} + {oldFields newFields : Array RVal} {fieldFuel remaining : Nat} + {oldRest newRest : List IxIR1.Sim.Root} + (sourceAt : store.get? location = + some ⟨.shared, 1, .ctorN cid oldFields⟩) + (sourceOwned : IxIR1.Sim.RootOwnership store.heap + (⟨.shared, .loc location⟩ :: oldRest)) + (retainedRun : RetainSharedMany store oldFields retained) + (releasedRun : releaseShared (fieldFuel + 1) retained + (.loc location) = .ok (released, remaining)) + (newOwned : IxIR1.Sim.RootOwnership released.heap + (IxIR1.Sim.rootsFor .shared newFields.toList ++ newRest)) : + (IxIR1.Sim.rootsFor .shared oldFields.toList ++ + (oldRest ++ inertRoots + (IxIR1.Sim.rootsFor .shared newFields.toList ++ newRest))).Perm + (IxIR1.Sim.rootsFor .shared newFields.toList ++ + (newRest ++ inertRoots + (IxIR1.Sim.rootsFor .shared oldFields.toList ++ oldRest))) := by + have killedOwned : IxIR1.Sim.RootOwnership (store.heap.kill location) + (IxIR1.Sim.rootsFor .shared oldFields.toList ++ oldRest) := by + simpa [IxIR1.Sim.nodeChildren] using + sourceOwned.killSharedOne sourceAt + have logicalOwned : IxIR1.Sim.RootOwnership + (logicalHotResetStore store location).heap + (IxIR1.Sim.rootsFor .shared oldFields.toList ++ oldRest) := by + rw [logicalHotResetStore_heap] + exact killedOwned + have contents : HeapContentsEq released + (logicalHotResetStore store location) := + hotPrefix_contents sourceAt sourceOwned retainedRun releasedRun + have oldOwned : IxIR1.Sim.RootOwnership released.heap + (IxIR1.Sim.rootsFor .shared oldFields.toList ++ oldRest) := + contents.symm.rootOwnership logicalOwned + exact fieldRootPartition oldOwned newOwned + +/-- Full ownership package induced by `hotPrefixFieldRootPartition`. The +ambient lists chosen for the physical macro contain all original roots and +only add inert scalar padding; consequently both the entry ownership and the +checked allocation ownership remain exact. -/ +theorem hotPrefixFieldRootAccounting + {store retained released : Store} {location : Nat} {cid : CtorId} + {oldFields newFields : Array RVal} {fieldFuel remaining : Nat} + {oldRest newRest : List IxIR1.Sim.Root} + (sourceAt : store.get? location = + some ⟨.shared, 1, .ctorN cid oldFields⟩) + (sourceOwned : IxIR1.Sim.RootOwnership store.heap + (⟨.shared, .loc location⟩ :: oldRest)) + (retainedRun : RetainSharedMany store oldFields retained) + (releasedRun : releaseShared (fieldFuel + 1) retained + (.loc location) = .ok (released, remaining)) + (newOwned : IxIR1.Sim.RootOwnership released.heap + (IxIR1.Sim.rootsFor .shared newFields.toList ++ newRest)) : + IxIR1.Sim.RootOwnership store.heap + (⟨.shared, .loc location⟩ :: + (oldRest ++ inertRoots + (IxIR1.Sim.rootsFor .shared newFields.toList ++ newRest))) ∧ + IxIR1.Sim.RootOwnership released.heap + (IxIR1.Sim.rootsFor .shared newFields.toList ++ + (newRest ++ inertRoots + (IxIR1.Sim.rootsFor .shared oldFields.toList ++ oldRest))) ∧ + (IxIR1.Sim.rootsFor .shared oldFields.toList ++ + (oldRest ++ inertRoots + (IxIR1.Sim.rootsFor .shared newFields.toList ++ newRest))).Perm + (IxIR1.Sim.rootsFor .shared newFields.toList ++ + (newRest ++ inertRoots + (IxIR1.Sim.rootsFor .shared oldFields.toList ++ oldRest))) := by + have entryOwned := addInertRoots sourceOwned + (extra := IxIR1.Sim.rootsFor .shared newFields.toList ++ newRest) + have allocationOwned := addInertRoots newOwned + (extra := IxIR1.Sim.rootsFor .shared oldFields.toList ++ oldRest) + refine ⟨?_, ?_, hotPrefixFieldRootPartition sourceAt sourceOwned + retainedRun releasedRun newOwned⟩ + · simpa [List.append_assoc] using entryOwned + · simpa [List.append_assoc] using allocationOwned + +/-- Transport the complete padded hot-prefix accounting package through an +incoming target-to-baseline heap isomorphism. The rewritten root permutation +is induced by the baseline permutation and pointwise root isomorphisms; it is +not an independent premise. -/ +theorem hotPrefixFieldRootAccountingIso + {baselineStore rewrittenStore retained released : Store} + {baselineLocation rewrittenLocation : Nat} {cid : CtorId} + {baselineFields rewrittenFields baselineNewFields rewrittenNewFields : + Array RVal} + {fieldFuel remaining : Nat} + {oldRest newRest : List IxIR1.Sim.Root} + (inputIso : IxIR1.Sim.HeapIso rewrittenStore.heap baselineStore.heap) + (locations : inputIso.locRel rewrittenLocation baselineLocation) + (baselineAt : baselineStore.get? baselineLocation = + some ⟨.shared, 1, .ctorN cid baselineFields⟩) + (rewrittenAt : rewrittenStore.get? rewrittenLocation = + some ⟨.shared, 1, .ctorN cid rewrittenFields⟩) + (oldFieldsRelated : IxIR1.Sim.RValsIso inputIso.locRel + rewrittenFields.toList baselineFields.toList) + (baselineOwned : IxIR1.Sim.RootOwnership baselineStore.heap + (⟨.shared, .loc baselineLocation⟩ :: oldRest)) + (retainedRun : RetainSharedMany baselineStore baselineFields retained) + (releasedRun : releaseShared (fieldFuel + 1) retained + (.loc baselineLocation) = .ok (released, remaining)) + (baselineNewOwned : IxIR1.Sim.RootOwnership released.heap + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ newRest)) + (newFieldsRelated : IxIR1.Sim.RValsIso + (fun rewrittenCandidate baselineCandidate => + inputIso.locRel rewrittenCandidate baselineCandidate ∧ + rewrittenCandidate ≠ rewrittenLocation) + rewrittenNewFields.toList baselineNewFields.toList) : + let baselineBefore := oldRest ++ inertRoots + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ newRest) + let baselineAfter := newRest ++ inertRoots + (IxIR1.Sim.rootsFor .shared baselineFields.toList ++ oldRest) + ∃ rewrittenBefore rewrittenAfter : List IxIR1.Sim.Root, + IxIR1.Sim.RootsIso inputIso.locRel + (⟨.shared, .loc rewrittenLocation⟩ :: rewrittenBefore) + (⟨.shared, .loc baselineLocation⟩ :: baselineBefore) ∧ + IxIR1.Sim.RootOwnership baselineStore.heap + (⟨.shared, .loc baselineLocation⟩ :: baselineBefore) ∧ + IxIR1.Sim.RootOwnership rewrittenStore.heap + (⟨.shared, .loc rewrittenLocation⟩ :: rewrittenBefore) ∧ + (IxIR1.Sim.rootsFor .shared baselineFields.toList ++ + baselineBefore).Perm + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ + baselineAfter) ∧ + (IxIR1.Sim.rootsFor .shared rewrittenFields.toList ++ + rewrittenBefore).Perm + (IxIR1.Sim.rootsFor .shared rewrittenNewFields.toList ++ + rewrittenAfter) ∧ + IxIR1.Sim.RootsIso + (fun rewrittenCandidate baselineCandidate => + inputIso.locRel rewrittenCandidate baselineCandidate ∧ + rewrittenCandidate ≠ rewrittenLocation) + (IxIR1.Sim.rootsFor .shared rewrittenNewFields.toList ++ + rewrittenAfter) + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ + baselineAfter) := by + dsimp only + obtain ⟨baselineEntryOwned, baselineAllocationOwned, + baselinePartition⟩ := + hotPrefixFieldRootAccounting baselineAt baselineOwned retainedRun + releasedRun baselineNewOwned + let baselineBefore := oldRest ++ inertRoots + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ newRest) + let baselineAfter := newRest ++ inertRoots + (IxIR1.Sim.rootsFor .shared baselineFields.toList ++ oldRest) + let sourceRoot : IxIR1.Sim.RootIso inputIso.locRel + ⟨.shared, .loc rewrittenLocation⟩ + ⟨.shared, .loc baselineLocation⟩ := + ⟨rfl, .loc locations⟩ + obtain ⟨rewrittenBefore, entryRoots, rewrittenOwned⟩ := + inputIso.rootOwnershipPreimageCons sourceRoot baselineEntryOwned + have prefixContents : HeapContentsEq released + (logicalHotResetStore baselineStore baselineLocation) := + hotPrefix_contents baselineAt baselineOwned retainedRun releasedRun + have baselineKilledNewOwned : IxIR1.Sim.RootOwnership + (baselineStore.heap.kill baselineLocation) + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ + baselineAfter) := by + have logicalOwned := prefixContents.rootOwnership baselineAllocationOwned + simpa [logicalHotResetStore_heap] using logicalOwned + let killedIso := heapIsoKillShared inputIso locations rewrittenAt baselineAt + rewrittenOwned + have newFieldRoots : IxIR1.Sim.RootsIso killedIso.locRel + (IxIR1.Sim.rootsFor .shared rewrittenNewFields.toList) + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList) := by + apply IxIR1.Sim.RootsIso.rootsFor + change IxIR1.Sim.RValsIso + (fun rewrittenCandidate baselineCandidate => + inputIso.locRel rewrittenCandidate baselineCandidate ∧ + rewrittenCandidate ≠ rewrittenLocation) + rewrittenNewFields.toList baselineNewFields.toList + exact newFieldsRelated + obtain ⟨rewrittenAfter, allocationRoots, _rewrittenKilledNewOwned⟩ := + killedIso.rootOwnershipPreimageAppend newFieldRoots + baselineKilledNewOwned + have oldRoots : IxIR1.Sim.RootsIso inputIso.locRel + (IxIR1.Sim.rootsFor .shared rewrittenFields.toList ++ + rewrittenBefore) + (IxIR1.Sim.rootsFor .shared baselineFields.toList ++ + baselineBefore) := + (IxIR1.Sim.RootsIso.rootsFor .shared oldFieldsRelated).append + entryRoots.tail + have newRoots : IxIR1.Sim.RootsIso inputIso.locRel + (IxIR1.Sim.rootsFor .shared rewrittenNewFields.toList ++ + rewrittenAfter) + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ + baselineAfter) := by + apply allocationRoots.mono + intro left right related + exact related.1 + obtain ⟨permutedRoots, rewrittenPartition, relatedPermutedRoots⟩ := + oldRoots.permuteRight baselinePartition + have permutedEq : permutedRoots = + IxIR1.Sim.rootsFor .shared rewrittenNewFields.toList ++ + rewrittenAfter := + IxIR1.Sim.RootsIso.left_eq_of_right inputIso relatedPermutedRoots newRoots + subst permutedRoots + exact ⟨rewrittenBefore, rewrittenAfter, entryRoots, + baselineEntryOwned, rewrittenOwned, baselinePartition, + rewrittenPartition, by simpa [killedIso, heapIsoKillShared] using + allocationRoots⟩ + +/-- A suspended runtime value is either scalar or is represented by one of +the exact source roots framed around the active callee. -/ +def ValueSupportedByRoots (roots : List IxIR1.Sim.Root) : RVal → Prop + | .loc location => + ∃ world, (⟨world, .loc location⟩ : IxIR1.Sim.Root) ∈ roots + | .lit _ | .erased => True + +namespace ValueSupportedByRoots + +/-- Root support is monotone when an enclosing call adds more framed roots. -/ +theorem mono {before after : List IxIR1.Sim.Root} {value : RVal} + (supported : ValueSupportedByRoots before value) + (subset : ∀ root ∈ before, root ∈ after) : + ValueSupportedByRoots after value := by + cases value with + | loc location => + obtain ⟨world, member⟩ := supported + exact ⟨world, subset _ member⟩ + | lit literal => trivial + | erased => trivial + +/-- A root-supported value cannot name a future append location. -/ +theorem inBounds {store : IxIR1.Store} {roots : List IxIR1.Sim.Root} + {value : RVal} (supported : ValueSupportedByRoots roots value) + (ownership : IxIR1.Sim.RootOwnership store roots) : + IxIR1.Reclamation.ValueInBounds store value := by + cases value with + | loc location => + obtain ⟨world, member⟩ := supported + obtain ⟨box, found, _boxWorld⟩ := ownership.roots_world + ⟨world, .loc location⟩ member + exact IxIR1.Reclamation.RVal.inBounds_of_get? found + | lit literal => trivial + | erased => trivial + +/-- A framed root cannot name a unit-refcount shared node already accounted +for by the distinguished consuming root. -/ +theorem avoidsUnitShared {store : IxIR1.Store} {roots rest : List IxIR1.Sim.Root} + {value : RVal} {location : Nat} {node : IxIR1.Node} + (supported : ValueSupportedByRoots roots value) + (rootsInRest : ∀ root ∈ roots, root ∈ rest) + (found : store.get? location = some ⟨.shared, 1, node⟩) + (ownership : IxIR1.Sim.RootOwnership store + (⟨.shared, .loc location⟩ :: rest)) : + value ≠ .loc location := by + cases value with + | loc actual => + obtain ⟨world, member⟩ := supported + exact ownership.sole_root_ne found (rootsInRest _ member) + | lit literal => intro impossible; cases impossible + | erased => intro impossible; cases impossible + +end ValueSupportedByRoots + +/-- Every future-observable register of a suspended frame is represented by +the framed source roots. Calls suspend only frames with no live credits. -/ +structure LiveFrameSupportedByRoots (roots : List IxIR1.Sim.Root) + (frame : Frame) : Prop where + values : ∀ {index : Nat} {value : RVal}, + ValueLiveFrom frame.definition frame.block frame.pc index → + frame.values[index]? = some value → + ValueSupportedByRoots roots value + noCredits : frame.credits = #[] + +/-- The proof-side source input map covers every currently allocated target +register that can still be observed. The bound excludes a not-yet-pushed +result register when a caller frame is suspended around a call. -/ +def LiveFrameInputCoverage (input : Lower.Sim.EnvMap) (frame : Frame) : Prop := + ∀ {index : Nat}, + ValueLiveFrom frame.definition frame.block frame.pc index → + index < frame.values.size → + ∃ sourceIndex : Nat, + input[sourceIndex]? = some (some (Atom.reg index)) + +private theorem inputContainsReg_of_translateAtom + {input : Lower.Sim.EnvMap} {source : IxIR1.Atom} {value : Nat} + (translated : Lower.InputMap.translateAtom input source = + some (.reg value)) : + ∃ sourceIndex : Nat, + input[sourceIndex]? = some (some (Atom.reg value)) := by + cases source with + | var sourceIndex => + cases found : input[sourceIndex]? with + | none => simp [Lower.InputMap.translateAtom, found] at translated + | some slot => + cases slot with + | none => simp [Lower.InputMap.translateAtom, found] at translated + | some atom => + have atomEq : atom = .reg value := by + simpa [Lower.InputMap.translateAtom, found] using translated + subst atom + exact ⟨sourceIndex, found⟩ + | lit literal => simp [Lower.InputMap.translateAtom] at translated + | erased => simp [Lower.InputMap.translateAtom] at translated + +private theorem atomsListRel_inputContainsReg + {input : Lower.Sim.EnvMap} {source : List IxIR1.Atom} + {target : List Atom} {value : Nat} + (related : Lower.Sim.AtomsListRel input source target) + (member : Atom.reg value ∈ target) : + ∃ sourceIndex : Nat, + input[sourceIndex]? = some (some (Atom.reg value)) := by + induction related with + | nil => simp at member + | @cons sourceAtom targetAtom sourceAtoms targetAtoms translated rest ih => + cases List.mem_cons.mp member with + | inl same => + subst targetAtom + exact inputContainsReg_of_translateAtom translated + | inr member => exact ih member + +private theorem inputContainsReg_of_translateAtoms + {input : Lower.Sim.EnvMap} {source : Array IxIR1.Atom} + {target : Array Atom} {value : Nat} + (translated : Lower.InputMap.translateAtoms input source = some target) + (member : Atom.reg value ∈ target.toList) : + ∃ sourceIndex : Nat, + input[sourceIndex]? = some (some (Atom.reg value)) := + atomsListRel_inputContainsReg + (Lower.Sim.atomsRel_of_translateAtoms translated) member + +private theorem inputContainsReg_of_operationSyntax + {input : Lower.Sim.EnvMap} {source : IxIR1.Op} {target : Instr} + {value : Nat} (matchedSyntax : Lower.OperationSyntax input source target) + (operand : Liveness.InstrUsesAtom target (.reg value)) : + ∃ sourceIndex : Nat, + input[sourceIndex]? = some (some (Atom.reg value)) := by + cases operand with + | move => + cases source <;> simp [Lower.OperationSyntax] at matchedSyntax + exact inputContainsReg_of_translateAtom matchedSyntax + | alloc member => + cases source <;> simp [Lower.OperationSyntax] at matchedSyntax + exact inputContainsReg_of_translateAtoms matchedSyntax.2.2 member + | allocWith member => + cases source <;> simp [Lower.OperationSyntax] at matchedSyntax + | takeUnique => + cases source <;> simp [Lower.OperationSyntax] at matchedSyntax + | resetShared => + cases source <;> simp [Lower.OperationSyntax] at matchedSyntax + | retainShared => + cases source <;> simp [Lower.OperationSyntax] at matchedSyntax + exact inputContainsReg_of_translateAtom matchedSyntax + | releaseShared => + cases source <;> simp [Lower.OperationSyntax] at matchedSyntax + exact inputContainsReg_of_translateAtom matchedSyntax + | dropUnique => + cases source <;> simp [Lower.OperationSyntax] at matchedSyntax + exact inputContainsReg_of_translateAtom matchedSyntax + | freeUnique => + cases source <;> simp [Lower.OperationSyntax] at matchedSyntax + exact inputContainsReg_of_translateAtom matchedSyntax + | fetch => + cases source <;> simp [Lower.OperationSyntax] at matchedSyntax + exact inputContainsReg_of_translateAtom matchedSyntax.2 + | call member => + cases source <;> simp [Lower.OperationSyntax] at matchedSyntax + exact inputContainsReg_of_translateAtoms matchedSyntax.2 member + | callSelf member => + cases source <;> simp [Lower.OperationSyntax] at matchedSyntax + exact inputContainsReg_of_translateAtoms matchedSyntax member + | papp member => + cases source <;> simp [Lower.OperationSyntax] at matchedSyntax + exact inputContainsReg_of_translateAtoms matchedSyntax.2 member + | applyFunction => + cases source <;> simp [Lower.OperationSyntax] at matchedSyntax + exact inputContainsReg_of_translateAtom matchedSyntax.1 + | applyArgument member => + cases source <;> simp [Lower.OperationSyntax] at matchedSyntax + exact inputContainsReg_of_translateAtoms matchedSyntax.2 member + | extern member => + cases source <;> simp [Lower.OperationSyntax] at matchedSyntax + exact inputContainsReg_of_translateAtoms matchedSyntax.2 member + +private theorem inputContainsReg_of_explicitValues + {input : Lower.Sim.EnvMap} {value : Nat} + (member : Atom.reg value ∈ + (Lower.EdgeTrace.explicitValuesOf input).toList) : + ∃ sourceIndex : Nat, + input[sourceIndex]? = some (some (Atom.reg value)) := by + simp only [Lower.EdgeTrace.explicitValuesOf, Array.toList_map] at member + obtain ⟨slot, slotMem, mappedEq⟩ := List.mem_map.mp member + have slotArrayMem : slot ∈ input := by simpa using slotMem + obtain ⟨sourceIndex, inputAt⟩ := + (Array.mem_iff_getElem?).mp slotArrayMem + cases slot with + | none => simp at mappedEq + | some atom => + simp only at mappedEq + subst atom + exact ⟨sourceIndex, inputAt⟩ + +private theorem inputContainsReg_of_switchTerminator + {site : Lower.SourceSite} {block : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {targetScrutinee : Atom} + {generated : Block} {outgoing : List Lower.EdgeTrace} + {children : List Lower.CodeTrace} {value : Nat} + (syntaxMatched : (Lower.CodeTrace.switchValue site block input + entryValueCount sourceScrutinee peelNat alternatives targetScrutinee + generated outgoing children).syntaxMatches = true) + (branchesMatched : (Lower.CodeTrace.switchValue site block input + entryValueCount sourceScrutinee peelNat alternatives targetScrutinee + generated outgoing children).switchBranchesMatch = true) + (operand : Liveness.TerminatorUsesAtom generated.terminator + (.reg value)) : + ∃ sourceIndex : Nat, + input[sourceIndex]? = some (some (Atom.reg value)) := by + obtain ⟨constructors, targetPeel, translated, terminator⟩ := + Lower.CodeTrace.switchSyntax_of_match syntaxMatched + have localBranches := + Lower.CodeTrace.switchNodeBranchesMatch_of_match branchesMatched + rw [terminator] at operand + cases operand with + | switchScrutinee => + exact inputContainsReg_of_translateAtom translated + | @switchCtor _ _ _ alternative _ alternativeMem edgeOperand => + obtain ⟨index, targetListAt⟩ := + List.mem_iff_getElem?.mp alternativeMem + have targetAt : constructors[index]? = some alternative := by + simpa using targetListAt + have localCopy := localBranches + unfold Lower.switchNodeBranchesMatch at localCopy + rw [terminator] at localCopy + simp only [Bool.and_eq_true] at localCopy + obtain ⟨⟨⟨outgoingLength, childrenLength⟩, _⟩, _⟩ := localCopy + have targetBound : index < constructors.size := + (Array.getElem?_eq_some_iff.mp targetAt).1 + have edgeBound : index < outgoing.length := by + have lengthEq := beq_iff_eq.mp outgoingLength + omega + have childBound : index < children.length := by + have lengthEq := beq_iff_eq.mp childrenLength + omega + let edge := outgoing[index]'edgeBound + let child := children[index]'childBound + have edgeAt : outgoing[index]? = some edge := + List.getElem?_eq_some_iff.mpr ⟨edgeBound, rfl⟩ + have childAt : children[index]? = some child := + List.getElem?_eq_some_iff.mpr ⟨childBound, rfl⟩ + have branch := Lower.constructorBranchMatchAt_of_switch_match + localBranches terminator targetAt edgeAt childAt + cases edgeOperand with + | value valueMember => + apply inputContainsReg_of_explicitValues (input := input) + have explicitMember : Atom.reg value ∈ edge.explicitValues.toList := by + rw [← branch.edgeValues] + exact valueMember + simpa [Lower.EdgeTrace.explicitValues, + branch.edgeSourceInput] using explicitMember + | switchNatZero edgeOperand => + cases peelNat with + | false => + have localCopy := localBranches + unfold Lower.switchNodeBranchesMatch at localCopy + rw [terminator] at localCopy + simp at localCopy + | true => + let branches := Lower.natBranchPairMatch_of_switch_match + localBranches terminator + cases edgeOperand with + | value valueMember => + apply inputContainsReg_of_explicitValues (input := input) + have explicitMember : Atom.reg value ∈ + branches.zeroEdge.explicitValues.toList := by + rw [← branches.zero.edgeValues] + exact valueMember + simpa [Lower.EdgeTrace.explicitValues, + branches.zero.edgeSourceInput] using explicitMember + | switchNatSucc edgeOperand => + cases peelNat with + | false => + have localCopy := localBranches + unfold Lower.switchNodeBranchesMatch at localCopy + rw [terminator] at localCopy + simp at localCopy + | true => + let branches := Lower.natBranchPairMatch_of_switch_match + localBranches terminator + cases edgeOperand with + | value valueMember => + apply inputContainsReg_of_explicitValues (input := input) + have explicitMember : Atom.reg value ∈ + branches.succEdge.explicitValues.toList := by + rw [← branches.succ.edgeValues] + exact valueMember + simpa [Lower.EdgeTrace.explicitValues, + branches.succ.edgeSourceInput] using explicitMember + +private theorem baselineBinderAtom_ne_reg_of_lt + {entryValueCount value : Nat} {instruction : Instr} {head : Atom} + (binder : Lower.Instr.baselineBinderAtom entryValueCount instruction = + some head) + (bound : value < entryValueCount) : + head ≠ .reg value := by + cases instruction <;> + simp [Lower.Instr.baselineBinderAtom] at binder + all_goals subst head + all_goals simp_all + all_goals exact Nat.ne_of_gt bound + +private theorem inputContainsReg_of_singletonAppend + {input : Lower.Sim.EnvMap} {head : Atom} {value sourceIndex : Nat} + (different : head ≠ .reg value) + (found : (#[some head] ++ input)[sourceIndex]? = + some (some (Atom.reg value))) : + ∃ inputIndex : Nat, + input[inputIndex]? = some (some (Atom.reg value)) := by + cases sourceIndex with + | zero => + have same : head = .reg value := by + simpa [Array.getElem?_append] using found + exact (different same).elim + | succ inputIndex => + exact ⟨inputIndex, by + simpa [Array.getElem?_append] using found⟩ + +private theorem codeTrace_inputCoversFutureUse (trace : Lower.CodeTrace) : + trace.instructionsMatch = true → + trace.inputMapsMatch = true → + trace.syntaxMatches = true → + trace.switchBranchesMatch = true → + ∀ {value position : Nat}, + value < trace.entryValueCount → + (⟨value, position⟩ : Liveness.Use) ∈ + Liveness.blockUses trace.headBlock.2 → + trace.entryPc ≤ position → + ∃ sourceIndex : Nat, + trace.sourceInputMap[sourceIndex]? = + some (some (Atom.reg value)) := by + induction trace using Lower.CodeTrace.inductTree with + | retCase site block input entryValueCount sourceAtom targetAtom generated => + intro _ _ syntaxMatched _ value position _ member future + simp only [Lower.CodeTrace.headBlock] at member + simp only [Lower.CodeTrace.entryPc] at future + cases Liveness.mem_blockUses member with + | inl instructionUse => + obtain ⟨instruction, found, _⟩ := instructionUse + have positionBound : position < generated.instructions.size := + (Array.getElem?_eq_some_iff.mp found).1 + omega + | inr terminatorUse => + have syntaxFacts := Lower.CodeTrace.retSyntax_of_match syntaxMatched + rw [syntaxFacts.2] at terminatorUse + cases terminatorUse.2 with + | ret => exact inputContainsReg_of_translateAtom syntaxFacts.1 + | tailCallCase site block input entryValueCount address arguments generated => + intro _ _ syntaxMatched _ value position _ member future + simp only [Lower.CodeTrace.headBlock] at member + simp only [Lower.CodeTrace.entryPc] at future + cases Liveness.mem_blockUses member with + | inl instructionUse => + obtain ⟨instruction, found, _⟩ := instructionUse + have positionBound : position < generated.instructions.size := + (Array.getElem?_eq_some_iff.mp found).1 + omega + | inr terminatorUse => + obtain ⟨targetArguments, translated, terminator⟩ := + Lower.CodeTrace.tailCallSyntax_of_match syntaxMatched + rw [terminator] at terminatorUse + cases terminatorUse.2 with + | tailCall member => + exact inputContainsReg_of_translateAtoms translated member + | tailCallSelfCase site block input entryValueCount arguments generated => + intro _ _ syntaxMatched _ value position _ member future + simp only [Lower.CodeTrace.headBlock] at member + simp only [Lower.CodeTrace.entryPc] at future + cases Liveness.mem_blockUses member with + | inl instructionUse => + obtain ⟨instruction, found, _⟩ := instructionUse + have positionBound : position < generated.instructions.size := + (Array.getElem?_eq_some_iff.mp found).1 + omega + | inr terminatorUse => + obtain ⟨targetArguments, translated, terminator⟩ := + Lower.CodeTrace.tailCallSelfSyntax_of_match syntaxMatched + rw [terminator] at terminatorUse + cases terminatorUse.2 with + | tailCallSelf member => + exact inputContainsReg_of_translateAtoms translated member + | letOpCase site block input nextInput entryValueCount operation targetIndex + targetInstruction next ih => + intro instructionsMatched mapsMatched syntaxMatched branchesMatched + value position valueBound member future + simp only [Lower.CodeTrace.entryValueCount] at valueBound + simp only [Lower.CodeTrace.headBlock] at member + simp only [Lower.CodeTrace.entryPc] at future + have localMatch := + Lower.CodeTrace.letOpMatch_of_match instructionsMatched + have operationSyntax := + Lower.CodeTrace.letOpOperationSyntax_of_match syntaxMatched + by_cases current : position = targetIndex + · subst position + cases Liveness.mem_blockUses member with + | inl instructionUse => + obtain ⟨instruction, found, operand⟩ := instructionUse + have instructionEq : instruction = targetInstruction := + Option.some.inj (found.symm.trans localMatch.instructionAt) + subst instruction + exact inputContainsReg_of_operationSyntax operationSyntax operand + | inr terminatorUse => + have positionBound : targetIndex < + next.headBlock.2.instructions.size := + (Array.getElem?_eq_some_iff.mp localMatch.instructionAt).1 + have terminatorPosition : targetIndex = + next.headBlock.2.instructions.size := terminatorUse.1 + omega + · cases binderEq : + Lower.Instr.baselineBinderAtom entryValueCount targetInstruction with + | none => + simp [Lower.CodeTrace.inputMapsMatch, binderEq] at mapsMatched + | some head => + have mapFacts := Lower.CodeTrace.inputMapForgets_of_match + mapsMatched binderEq + have nextSyntax := + (Lower.CodeTrace.letOpSyntax_of_match syntaxMatched).2 + have nextBranches : next.switchBranchesMatch = true := by + simpa [Lower.CodeTrace.switchBranchesMatch] using branchesMatched + have nextValueBound : value < next.entryValueCount := by + rw [localMatch.nextValueCount] + omega + have nextFuture : next.entryPc ≤ position := by + rw [localMatch.nextPc] + omega + obtain ⟨sourceIndex, nextAt⟩ := ih localMatch.nextInstructions + mapFacts.2.2.2 nextSyntax nextBranches nextValueBound member + nextFuture + have nextInputAt : nextInput[sourceIndex]? = + some (some (Atom.reg value)) := by + simpa [localMatch.nextInput] using nextAt + have extendedAt := mapFacts.2.2.1 sourceIndex (.reg value) + nextInputAt + exact inputContainsReg_of_singletonAppend + (baselineBinderAtom_ne_reg_of_lt binderEq valueBound) extendedAt + | switchCase site block input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children _ => + intro _ _ syntaxMatched branchesMatched value position _ member future + simp only [Lower.CodeTrace.headBlock] at member + simp only [Lower.CodeTrace.entryPc] at future + cases Liveness.mem_blockUses member with + | inl instructionUse => + obtain ⟨instruction, found, _⟩ := instructionUse + have positionBound : position < generated.instructions.size := + (Array.getElem?_eq_some_iff.mp found).1 + omega + | inr terminatorUse => + exact inputContainsReg_of_switchTerminator syntaxMatched + branchesMatched terminatorUse.2 + +/-- Checked lowering traces account for every target register that remains +observable at a related runtime frame. This is the static coverage fact used +when a call turns that frame into framed source roots. -/ +theorem LiveFrameInputCoverage.ofCodeState + {functionTrace : Lower.FunctionTrace} {trace : Lower.CodeTrace} + {source : List RVal} {frame : Frame} + (state : Lower.Sim.CodeStateRel functionTrace trace source frame) + (descendant : functionTrace.root.Descendant trace) : + LiveFrameInputCoverage trace.sourceInputMap frame := by + intro index live indexBound + obtain ⟨block, blockAt, ⟨useValue, usePosition⟩, member, same, future⟩ := + live + simp only at same + subst useValue + have exactBlock := state.blockAt descendant + have blockEq : block = trace.headBlock.2 := + Option.some.inj (blockAt.symm.trans exactBlock) + subst block + have valueBound : index < trace.entryValueCount := by + simpa [state.valueCount] using indexBound + have traceFuture : trace.entryPc ≤ usePosition := by + simpa [state.pc] using future + exact codeTrace_inputCoversFutureUse trace + (functionTrace.descendantInstructionsMatch descendant) + (functionTrace.descendantInputMapsMatch descendant) + (functionTrace.descendantSyntaxMatches descendant) + (functionTrace.descendantSwitchBranchesMatch descendant) + valueBound member traceFuture + +/-- Pending over-application arguments are all observable; a resume frame +needs only its future-live registers. -/ +inductive LiveContinuationSupportedByRoots (roots : List IxIR1.Sim.Root) : + Continuation → Prop where + | resume {frame : Frame} : + LiveFrameSupportedByRoots roots frame → + LiveContinuationSupportedByRoots roots (.resume frame) + | applyMore {arguments : Array RVal} {frame : Frame} : + (∀ value ∈ arguments.toList, ValueSupportedByRoots roots value) → + LiveFrameSupportedByRoots roots frame → + LiveContinuationSupportedByRoots roots (.applyMore arguments frame) + +/-- The aggregate framed-root suffix supports every observable value in the +target continuation stack. -/ +inductive LiveStackSupportedByRoots (roots : List IxIR1.Sim.Root) : + List Continuation → Prop where + | nil : LiveStackSupportedByRoots roots [] + | cons {continuation : Continuation} {stack : List Continuation} : + LiveContinuationSupportedByRoots roots continuation → + LiveStackSupportedByRoots roots stack → + LiveStackSupportedByRoots roots (continuation :: stack) + +namespace LiveFrameSupportedByRoots + +private theorem ownedRoot_mem + {capabilities : Array Lower.BindingCap} {source : List RVal} + {index : Nat} {world : Ixon.Owned} {value : RVal} + (capabilityAt : capabilities[index]? = some (.owned world)) + (sourceAt : source[index]? = some value) : + (⟨world, value⟩ : IxIR1.Sim.Root) ∈ + Lower.Sim.rootsForCapabilities capabilities.toList source := by + have moved := Lower.Sim.rootsForCapabilities_setDead_perm + (capabilities := capabilities.toList) (source := source) + (index := index) (world := world) (value := value) + (by simpa using capabilityAt) (by simpa using sourceAt) + exact moved.mem_iff.mp (by simp) + +/-- At a checked no-borrow suspension point, environment correspondence and +live-input coverage turn the producer's surviving capability vector into +root support for the suspended target frame. -/ +theorem ofNoBorrows + {position : Lower.PositionTrace} {site : Lower.SourceSite} + {block : BlockId} {target : Lower.TargetPosition} + {store : IxIR1.Store} {source : List RVal} + {input : Lower.Sim.EnvMap} {frameRoots : List IxIR1.Sim.Root} + {frame : Frame} + (coordinate : position.coordinateMatches site block target input = true) + (environments : Lower.Sim.EnvRel source frame.values input) + (invariant : Lower.Sim.SourceOwnershipInvariant store source input + position.sourceCapabilities frameRoots) + (noBorrows : Lower.noBorrows position.sourceCapabilities = true) + (coverage : LiveFrameInputCoverage input frame) + (noCredits : frame.credits = #[]) : + LiveFrameSupportedByRoots + (Lower.Sim.rootsForCapabilities position.sourceCapabilities.toList + source) + frame := by + refine ⟨?_, noCredits⟩ + intro index value live valueAt + cases value with + | lit literal => trivial + | erased => trivial + | loc location => + have registerBound : index < frame.values.size := + (Array.getElem?_eq_some_iff.mp valueAt).1 + obtain ⟨sourceIndex, inputAt⟩ := coverage live registerBound + have inputBound : sourceIndex < input.size := + (Array.getElem?_eq_some_iff.mp inputAt).1 + have capabilitySize := + position.sourceCapabilities_size_of_coordinateMatch coordinate + have capabilityBound : sourceIndex < position.sourceCapabilities.size := + by simpa [capabilitySize] using inputBound + generalize capabilityEq : + position.sourceCapabilities[sourceIndex] = capability + have capabilityAt : position.sourceCapabilities[sourceIndex]? = + some capability := by + have found := Array.getElem?_eq_getElem capabilityBound + rw [capabilityEq] at found + exact found + have sourceBound : sourceIndex < source.length := by + rw [invariant.length, capabilitySize] + exact inputBound + let sourceValue := source[sourceIndex] + have sourceAt : source[sourceIndex]? = some sourceValue := by + simp [sourceValue] + have sourceResolved := environments sourceIndex sourceValue (.reg index) + sourceAt inputAt + have targetResolved : Eval.resolveAtom frame.values (.reg index) = + .ok (.loc location) := by + simp [Eval.resolveAtom, valueAt] + have sourceValueEq : sourceValue = .loc location := + Except.ok.inj (sourceResolved.symm.trans targetResolved) + have capabilityMatches : + capability.matchesInput (some (.reg index)) = true := by + unfold Lower.PositionTrace.coordinateMatches at coordinate + simp only [Bool.and_eq_true] at coordinate + have point := List.all_eq_true.mp coordinate.2 sourceIndex + (List.mem_range.mpr inputBound) + simpa [capabilityAt, inputAt] using point + cases capability with + | scalar => + have holds := invariant.holds capabilityAt sourceAt + rw [sourceValueEq] at holds + simp [Lower.Sim.CapabilityHolds, IxIR1.Sim.rvalLocation?] at holds + | owned world => + refine ⟨world, ?_⟩ + rw [← sourceValueEq] + exact ownedRoot_mem capabilityAt sourceAt + | borrowed world lender => + have listAt : position.sourceCapabilities.toList[sourceIndex]? = + some (.borrowed world lender) := by + simpa using capabilityAt + have member : (.borrowed world lender : Lower.BindingCap) ∈ + position.sourceCapabilities.toList := + List.mem_of_getElem? listAt + unfold Lower.noBorrows at noBorrows + have point := List.all_eq_true.mp noBorrows _ member + simp [Lower.BindingCap.isBorrowed] at point + | dead => + simp [Lower.BindingCap.matchesInput] at capabilityMatches + +/-- A value-producing suspension whose checked successor prepends one owned +result capability supports every register that is live in the suspended +caller. Call and self-call audits instantiate this common trace argument. -/ +private theorem ofSuspensionCore + {callerTrace : Lower.FunctionTrace} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {operation : IxIR1.Op} {instruction : Instr} {next : Lower.CodeTrace} + (descendant : callerTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount operation index + instruction next)) + {after : Lower.PositionTrace} + (afterCoordinate : after.coordinateMatches next.source next.sourceBlock + next.targetPosition next.sourceInputMap = true) + {store : IxIR1.Store} {source : List RVal} + {remaining : Array Lower.BindingCap} {resultWorld : Ixon.Owned} + (afterCapabilities : + #[.owned resultWorld] ++ remaining = after.sourceCapabilities) + (remainingSize : remaining.size = input.size) + (remainingHolds : + ∀ {sourceIndex : Nat} {capability : Lower.BindingCap} + {selected : RVal}, + remaining[sourceIndex]? = some capability → + source[sourceIndex]? = some selected → + Lower.Sim.CapabilityHolds store capability selected) + (noBorrows : Lower.noBorrows remaining = true) + {frame : Frame} + (state : Lower.Sim.CodeStateRel callerTrace + (.letOp site blockId input nextInput entryValueCount operation index + instruction next) source frame) + (binder : Lower.Instr.baselineBinderAtom entryValueCount instruction = + some (.reg entryValueCount)) + (delta : Lower.Instr.baselineValueDelta instruction = some 1) + (noCredits : frame.credits = #[]) : + LiveFrameSupportedByRoots + (Lower.Sim.rootsForCapabilities remaining.toList source) + { frame with pc := frame.pc + 1 } := by + have nextDescendant : callerTrace.root.Descendant next := + .step descendant (by simp [Lower.CodeTrace.children]) + have localMatch := callerTrace.descendantLetOpMatch descendant + have mapFacts := Lower.CodeTrace.inputMapForgets_of_match + (callerTrace.descendantInputMapsMatch descendant) binder + refine ⟨?_, by simpa using noCredits⟩ + intro targetValue runtimeValue live valueAt + change ValueLiveFrom frame.definition frame.block (frame.pc + 1) + targetValue at live + change frame.values[targetValue]? = some runtimeValue at valueAt + have targetBound : targetValue < frame.values.size := + (Array.getElem?_eq_some_iff.mp valueAt).1 + have entryBound : targetValue < entryValueCount := by + simpa [Lower.CodeTrace.entryValueCount, state.valueCount] using targetBound + obtain ⟨liveBlock, liveBlockAt, ⟨useValue, usePosition⟩, useMember, + useValueEq, liveFuture⟩ := live + simp only at useValueEq + subst useValue + have exactBlock := state.blockAt descendant + have liveBlockEq : liveBlock = next.headBlock.2 := by + apply Option.some.inj + exact liveBlockAt.symm.trans (by + simpa [Lower.CodeTrace.headBlock] using exactBlock) + subst liveBlock + have nextFuture : next.entryPc ≤ usePosition := by + rw [localMatch.1.nextPc] + have framePc : frame.pc = index := by + simpa [Lower.CodeTrace.entryPc] using state.pc + simpa [framePc] using liveFuture + have nextValueBound : targetValue < next.entryValueCount := by + rw [localMatch.1.nextValueCount, delta] + simp only [Option.getD] + omega + obtain ⟨sourceMapIndex, nextAt⟩ := codeTrace_inputCoversFutureUse next + (callerTrace.descendantInstructionsMatch nextDescendant) + (callerTrace.descendantInputMapsMatch nextDescendant) + (callerTrace.descendantSyntaxMatches nextDescendant) + (callerTrace.descendantSwitchBranchesMatch nextDescendant) + nextValueBound useMember nextFuture + have nextInputAt : nextInput[sourceMapIndex]? = + some (some (Atom.reg targetValue)) := by + simpa [localMatch.1.nextInput] using nextAt + cases sourceMapIndex with + | zero => + have resultRegister : nextInput[0]? = + some (some (Atom.reg entryValueCount)) := by + simpa using mapFacts.2.1 + have impossible : entryValueCount = targetValue := by + simpa using resultRegister.symm.trans nextInputAt + omega + | succ sourceIndex => + have extendedAt := mapFacts.2.2.1 (sourceIndex + 1) + (.reg targetValue) nextInputAt + have inputAt : input[sourceIndex]? = + some (some (Atom.reg targetValue)) := by + simpa [Array.getElem?_append] using extendedAt + have inputBound : sourceIndex < input.size := + (Array.getElem?_eq_some_iff.mp inputAt).1 + have remainingBound : sourceIndex < remaining.size := by + rw [remainingSize] + exact inputBound + generalize capabilityEq : remaining[sourceIndex] = capability + have capabilityAt : remaining[sourceIndex]? = some capability := by + have found := Array.getElem?_eq_getElem remainingBound + rw [capabilityEq] at found + exact found + have afterCapabilityAt : after.sourceCapabilities[sourceIndex + 1]? = + some capability := by + rw [← afterCapabilities] + simpa [Array.getElem?_append] using capabilityAt + have nextInputBound : sourceIndex + 1 < next.sourceInputMap.size := + (Array.getElem?_eq_some_iff.mp nextAt).1 + have capabilityMatches : + capability.matchesInput (some (.reg targetValue)) = true := by + unfold Lower.PositionTrace.coordinateMatches at afterCoordinate + simp only [Bool.and_eq_true] at afterCoordinate + have point := List.all_eq_true.mp afterCoordinate.2 + (sourceIndex + 1) (List.mem_range.mpr nextInputBound) + simpa [afterCapabilityAt, nextAt] using point + have sourceCount : source.length = input.size := by + simpa [Lower.CodeTrace.sourceInputMap] using state.sourceCount + have sourceBound : sourceIndex < source.length := by + rw [sourceCount] + exact inputBound + let sourceValue := source[sourceIndex] + have sourceAt : source[sourceIndex]? = some sourceValue := by + simp [sourceValue] + have sourceResolved := state.environments sourceIndex sourceValue + (.reg targetValue) sourceAt inputAt + have targetResolved : Eval.resolveAtom frame.values (.reg targetValue) = + .ok runtimeValue := by + simp [Eval.resolveAtom, valueAt] + have sourceValueEq : sourceValue = runtimeValue := + Except.ok.inj (sourceResolved.symm.trans targetResolved) + cases runtimeValue with + | lit literal => trivial + | erased => trivial + | loc location => + cases capability with + | scalar => + have holds := remainingHolds capabilityAt sourceAt + rw [sourceValueEq] at holds + simp [Lower.Sim.CapabilityHolds, + IxIR1.Sim.rvalLocation?] at holds + | owned world => + refine ⟨world, ?_⟩ + rw [← sourceValueEq] + exact ownedRoot_mem capabilityAt sourceAt + | borrowed world lender => + have listAt : remaining.toList[sourceIndex]? = + some (.borrowed world lender) := by + simpa using capabilityAt + have member : (.borrowed world lender : Lower.BindingCap) ∈ + remaining.toList := List.mem_of_getElem? listAt + unfold Lower.noBorrows at noBorrows + have point := List.all_eq_true.mp noBorrows _ member + simp [Lower.BindingCap.isBorrowed] at point + | dead => + simp [Lower.BindingCap.matchesInput] at capabilityMatches + +/-- At an ordinary call, checked map progression and the audited +consume/result transition make the caller frame's future-live registers +exactly the roots framed around the callee. The not-yet-returned result slot +is excluded by the suspended frame's old value bound. -/ +theorem ofCallSuspension + {checked : Lower.Checked} {callerTrace : Lower.FunctionTrace} + (callerMember : callerTrace ∈ checked.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {sourceAddress targetAddress : Ixon.Address} + {sourceArguments : Array IxIR1.Atom} {targetArguments : Array Atom} + {next : Lower.CodeTrace} {signature : Signature} + (signatureAt : Lower.targetSignature? + checked.artifact.program.declarations sourceAddress = some signature) + (descendant : callerTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.call sourceAddress sourceArguments) index + (.call targetAddress targetArguments) next)) + {before : Lower.PositionTrace} + (beforeMember : before ∈ checked.artifact.trace.positions) + (beforeCoordinate : before.coordinateMatches site blockId + (.instruction index) input = true) + {store : IxIR1.Store} {source values : List RVal} + {frameRoots : List IxIR1.Sim.Root} + (invariant : Lower.Sim.SourceOwnershipInvariant store source input + before.sourceCapabilities frameRoots) + (resolved : IxIR1.resolveAtoms source sourceArguments = .ok values) + {remaining : Array Lower.BindingCap} + (consumed : Lower.callRemainingCapabilities? before.sourceCapabilities + input signature sourceArguments = some remaining) + (noBorrows : Lower.noBorrows remaining = true) + {frame : Frame} + (state : Lower.Sim.CodeStateRel callerTrace + (.letOp site blockId input nextInput entryValueCount + (.call sourceAddress sourceArguments) index + (.call targetAddress targetArguments) next) source frame) + (noCredits : frame.credits = #[]) : + LiveFrameSupportedByRoots + (Lower.Sim.rootsForCapabilities remaining.toList source) + { frame with pc := frame.pc + 1 } := by + have nextDescendant : callerTrace.root.Descendant next := + .step descendant (by simp [Lower.CodeTrace.children]) + obtain ⟨after, afterMember, afterCoordinate⟩ := + checked.position callerMember nextDescendant + have transition := checked.callTransition callerMember signatureAt descendant + beforeMember beforeCoordinate afterMember afterCoordinate + unfold Lower.PositionTrace.callResultMatches at transition + rw [consumed] at transition + simp only [Bool.and_eq_true, beq_iff_eq] at transition + have remainingFacts := invariant.callRemainingHolds resolved consumed + have capabilitySize : before.sourceCapabilities.size = input.size := + before.sourceCapabilities_size_of_coordinateMatch beforeCoordinate + have remainingSize : remaining.size = input.size := + remainingFacts.1.trans capabilitySize + exact ofSuspensionCore descendant afterCoordinate transition.2 remainingSize + remainingFacts.2 noBorrows state (by rfl) (by rfl) noCredits + +/-- A recursive self-call has the same suspended-caller root guarantee as an +addressed call, with the retained function's own signature supplying the +argument and result worlds. -/ +theorem ofCallSelfSuspension + {checked : Lower.Checked} {callerTrace : Lower.FunctionTrace} + (callerMember : callerTrace ∈ checked.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {sourceArguments : Array IxIR1.Atom} {targetArguments : Array Atom} + {next : Lower.CodeTrace} + (descendant : callerTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.callSelf sourceArguments) index (.callSelf targetArguments) next)) + {before : Lower.PositionTrace} + (beforeMember : before ∈ checked.artifact.trace.positions) + (beforeCoordinate : before.coordinateMatches site blockId + (.instruction index) input = true) + {store : IxIR1.Store} {source values : List RVal} + {frameRoots : List IxIR1.Sim.Root} + (invariant : Lower.Sim.SourceOwnershipInvariant store source input + before.sourceCapabilities frameRoots) + (resolved : IxIR1.resolveAtoms source sourceArguments = .ok values) + {remaining : Array Lower.BindingCap} + (consumed : Lower.callRemainingCapabilities? before.sourceCapabilities + input callerTrace.generated.signature sourceArguments = some remaining) + (noBorrows : Lower.noBorrows remaining = true) + {frame : Frame} + (state : Lower.Sim.CodeStateRel callerTrace + (.letOp site blockId input nextInput entryValueCount + (.callSelf sourceArguments) index (.callSelf targetArguments) next) + source frame) + (noCredits : frame.credits = #[]) : + LiveFrameSupportedByRoots + (Lower.Sim.rootsForCapabilities remaining.toList source) + { frame with pc := frame.pc + 1 } := by + have nextDescendant : callerTrace.root.Descendant next := + .step descendant (by simp [Lower.CodeTrace.children]) + obtain ⟨after, afterMember, afterCoordinate⟩ := + checked.position callerMember nextDescendant + have transition := checked.callSelfTransition callerMember descendant + beforeMember beforeCoordinate afterMember afterCoordinate + unfold Lower.PositionTrace.callResultMatches at transition + rw [consumed] at transition + simp only [Bool.and_eq_true, beq_iff_eq] at transition + have remainingFacts := invariant.callRemainingHolds resolved consumed + have capabilitySize : before.sourceCapabilities.size = input.size := + before.sourceCapabilities_size_of_coordinateMatch beforeCoordinate + have remainingSize : remaining.size = input.size := + remainingFacts.1.trans capabilitySize + exact ofSuspensionCore descendant afterCoordinate transition.2 remainingSize + remainingFacts.2 noBorrows state (by rfl) (by rfl) noCredits + +/-- A checked PAP application derives the first callee's ownership and the +caller resume frame's live-root support from one common producer position. +Keeping the two facts indexed by the same residual capability vector is what +lets a compiler stack witness remember the dynamic call precisely. -/ +theorem applyPapEntry + {checked : Lower.Checked} {callerTrace calleeTrace : Lower.FunctionTrace} + (callerMember : callerTrace ∈ checked.artifact.trace.functions) + (calleeMember : calleeTrace ∈ checked.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {sourceFunction : IxIR1.Atom} {sourceArguments : Array IxIR1.Atom} + {targetFunction : Atom} {targetArguments : Array Atom} + {next : Lower.CodeTrace} + (descendant : callerTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next)) + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {store retainedStore readyStore : IxIR1.Store} + {source : List RVal} {location rc : Nat} + {address : Ixon.Address} {arity : Nat} + {captured : Array RVal} {arguments supplied residual : List RVal} + {frameRoots : List IxIR1.Sim.Root} + (ownership : Lower.Sim.SourceOwnershipAt + checked.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + store source frameRoots) + (functionResolved : IxIR1.resolveAtom source sourceFunction = + .ok (.loc location)) + (argumentsResolved : IxIR1.resolveAtoms source sourceArguments = + .ok arguments) + (papAt : store.get? location = + some ⟨.shared, rc, .papN address arity captured⟩) + (retained : IxIR1.dupVals store captured.toList = .ok retainedStore) + (released : IxIR1.dropVal sourceContext sourceFuel retainedStore + (.loc location) = .ok readyStore) + (split : captured.toList ++ arguments = supplied ++ residual) + (entryArity : supplied.length = + calleeTrace.generated.signature.params.size) + (papSafe : calleeTrace.generated.signature.papSafe = true) + {frame : Frame} + (state : Lower.Sim.CodeStateRel callerTrace + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) source frame) + (noCredits : frame.credits = #[]) : + ∃ remaining : Array Lower.BindingCap, + IxIR1.Sim.RootOwnership readyStore + (IxIR1.Sim.rootsFor .shared supplied ++ + IxIR1.Sim.rootsFor .shared residual ++ + Lower.Sim.rootsForCapabilities remaining.toList source ++ + frameRoots) ∧ + Lower.Sim.SourceOwnershipAt checked.artifact.trace.positions + calleeTrace.root readyStore supplied.reverse + (IxIR1.Sim.rootsFor .shared residual ++ + Lower.Sim.rootsForCapabilities remaining.toList source ++ + frameRoots) ∧ + LiveFrameSupportedByRoots + (Lower.Sim.rootsForCapabilities remaining.toList source) + { frame with pc := frame.pc + 1 } := by + have nextDescendant : callerTrace.root.Descendant next := + .step descendant (by simp [Lower.CodeTrace.children]) + obtain ⟨after, afterMember, afterCoordinate⟩ := + checked.position callerMember nextDescendant + obtain ⟨before, beforeMember, beforeCoordinate, transition⟩ := + checked.applyTransition callerMember descendant afterMember afterCoordinate + unfold Lower.PositionTrace.applyResultMatches at transition + unfold Lower.applyCapabilities? at transition + cases functionConsumed : Lower.consumeCapability? + before.sourceCapabilities input .shared sourceFunction with + | none => simp [functionConsumed] at transition + | some afterFunction => + simp only [functionConsumed, Option.bind_eq_bind, + Option.bind_some] at transition + cases argumentsConsumed : Lower.consumeCapabilitiesList? afterFunction + input .shared sourceArguments.toList with + | none => simp [argumentsConsumed] at transition + | some remaining => + simp only [argumentsConsumed, Option.bind_some] at transition + change (Lower.noBorrows (#[.owned .shared] ++ remaining) && + (#[.owned .shared] ++ remaining == + after.sourceCapabilities)) = true at transition + simp only [Bool.and_eq_true, beq_iff_eq] at transition + have beforeInvariant := ownership before beforeMember (by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceBlock, + Lower.CodeTrace.targetPosition, + Lower.CodeTrace.sourceInputMap] using beforeCoordinate) + change Lower.Sim.SourceOwnershipInvariant store source input + before.sourceCapabilities frameRoots at beforeInvariant + have readyOwnership := beforeInvariant.preparePapEntry + functionResolved argumentsResolved functionConsumed + argumentsConsumed papAt retained released split + have entryShape : Lower.entryCapabilities + calleeTrace.generated.signature = + Array.replicate supplied.length (.owned .shared) := by + simpa [entryArity] using + checked.papSafeEntryCapabilities calleeMember papSafe + have calleeOwnership : Lower.Sim.SourceOwnershipAt + checked.artifact.trace.positions calleeTrace.root readyStore + supplied.reverse + (IxIR1.Sim.rootsFor .shared residual ++ + Lower.Sim.rootsForCapabilities remaining.toList source ++ + frameRoots) := by + intro entry entryMember entryCoordinate + rw [checked.entryCapabilities calleeMember entryMember + entryCoordinate] + exact Lower.Sim.SourceOwnershipInvariant.sharedEntry entryShape + (by simpa [List.append_assoc] using readyOwnership) + have remainingFacts := beforeInvariant.applyRemainingHolds + functionResolved argumentsResolved functionConsumed + argumentsConsumed + have capabilitySize : before.sourceCapabilities.size = input.size := + before.sourceCapabilities_size_of_coordinateMatch beforeCoordinate + have remainingSize : remaining.size = input.size := + remainingFacts.1.trans capabilitySize + have remainingNoBorrows : Lower.noBorrows remaining = true := by + have fullNoBorrows := transition.1 + simp [Lower.noBorrows] at fullNoBorrows + simpa [Lower.noBorrows] using fullNoBorrows.2 + have suspended := ofSuspensionCore descendant afterCoordinate + transition.2 remainingSize remainingFacts.2 remainingNoBorrows + state (by rfl) (by rfl) noCredits + exact ⟨remaining, readyOwnership, calleeOwnership, suspended⟩ + +theorem mono {before after : List IxIR1.Sim.Root} {frame : Frame} + (supported : LiveFrameSupportedByRoots before frame) + (subset : ∀ root ∈ before, root ∈ after) : + LiveFrameSupportedByRoots after frame := by + exact ⟨fun live found => (supported.values live found).mono subset, + supported.noCredits⟩ + +/-- Live-frame root support discharges the reuse planner's mapped-value +obligation whenever every planner-observable register is live at the current +coordinate. Only location values consume the root-support evidence. -/ +theorem mappedValuesInRoots {shape : Reuse.Shape} + {roots : List IxIR1.Sim.Root} {frame : Frame} + (supported : LiveFrameSupportedByRoots roots frame) + (live : ∀ {sourceId : ValueId}, PlannerValueRelevant shape sourceId → + ValueLiveFrom frame.definition frame.block frame.pc sourceId) : + MappedValuesInRoots shape frame.values roots := by + intro sourceId targetId sourceValue relevant _translated found + have valueSupported := supported.values (live relevant) found + cases sourceValue with + | loc location => exact valueSupported + | lit literal => trivial + | erased => trivial + +/-- At the accepted allocation coordinate, syntax alone supplies the +planner-liveness premise needed to turn active-frame root support into the +physical macro's mapped-value evidence. -/ +theorem mappedValuesAtPlannerAllocation {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} {blockId : Nat} + {block : Block} (site : Reuse.Site limits validation block) + (blockAt : source.blocks[blockId]? = some block) + {roots : List IxIR1.Sim.Root} {frame : Frame} + (supported : LiveFrameSupportedByRoots roots frame) + (definition : frame.definition = source) + (frameBlock : frame.block = blockId) + (pc : frame.pc = site.shape.releasePosition + 1) : + MappedValuesInRoots site.shape frame.values roots := by + apply supported.mappedValuesInRoots + intro sourceId relevant + simpa [definition, frameBlock, pc] using + plannerValueLiveAtAllocation site blockAt relevant + +end LiveFrameSupportedByRoots + +namespace LiveContinuationSupportedByRoots + +theorem mono {before after : List IxIR1.Sim.Root} + {continuation : Continuation} + (supported : LiveContinuationSupportedByRoots before continuation) + (subset : ∀ root ∈ before, root ∈ after) : + LiveContinuationSupportedByRoots after continuation := by + cases supported with + | resume frame => exact .resume (frame.mono subset) + | applyMore arguments frame => + exact .applyMore + (fun value member => (arguments value member).mono subset) + (frame.mono subset) + +end LiveContinuationSupportedByRoots + +namespace LiveStackSupportedByRoots + +theorem mono {before after : List IxIR1.Sim.Root} + {stack : List Continuation} + (supported : LiveStackSupportedByRoots before stack) + (subset : ∀ root ∈ before, root ∈ after) : + LiveStackSupportedByRoots after stack := by + induction supported with + | nil => exact .nil + | cons head tail ih => exact .cons (head.mono subset) ih + +end LiveStackSupportedByRoots + +namespace ValueSupportedByRoots + +/-- Root support and exact ownership make a supported value live. -/ +theorem liveRVal {store : IxIR1.Store} {roots : List IxIR1.Sim.Root} + {value : RVal} (supported : ValueSupportedByRoots roots value) + (ownership : IxIR1.Sim.RootOwnership store roots) : + IxIR1.Sim.LiveRVal store value := by + cases value with + | loc location => + obtain ⟨world, member⟩ := supported + obtain ⟨box, found, _world⟩ := ownership.roots_world + ⟨world, .loc location⟩ member + exact ⟨box, found⟩ + | lit literal => trivial + | erased => trivial + +end ValueSupportedByRoots + +private theorem rValIso_toHeapIso_of_live + {baselineStore rewrittenStore : IxIR1.Store} + (history : IxIR1.Sim.HeapHistoryIso baselineStore rewrittenStore) + (closed : IxIR1.Sim.StoreClosed baselineStore) + {baselineValue rewrittenValue : RVal} + (related : IxIR1.Sim.RValIso history.locRel baselineValue rewrittenValue) + (live : IxIR1.Sim.LiveRVal baselineStore baselineValue) : + IxIR1.Sim.RValIso (history.toHeapIso closed).locRel + baselineValue rewrittenValue := by + cases related with + | @loc baselineLocation rewrittenLocation locations => + obtain ⟨box, found⟩ := live + exact .loc (history.toHeapIso_rel closed locations found) + | lit => exact .lit + | erased => exact .erased + +private theorem rvalsIso_toHeapIso_of_supported + {baselineStore rewrittenStore : IxIR1.Store} + (history : IxIR1.Sim.HeapHistoryIso baselineStore rewrittenStore) + (closed : IxIR1.Sim.StoreClosed baselineStore) + {roots : List IxIR1.Sim.Root} + (ownership : IxIR1.Sim.RootOwnership baselineStore roots) : + ∀ {baselineValues rewrittenValues : List RVal}, + IxIR1.Sim.RValsIso history.locRel baselineValues rewrittenValues → + (∀ value ∈ baselineValues, ValueSupportedByRoots roots value) → + IxIR1.Sim.RValsIso (history.toHeapIso closed).locRel + baselineValues rewrittenValues + | _, _, .nil, _ => .nil + | _, _, .cons head tail, supported => by + exact .cons + (rValIso_toHeapIso_of_live history closed head + ((supported _ (by simp)).liveRVal ownership)) + (rvalsIso_toHeapIso_of_supported history closed ownership tail + fun value member => supported value (by simp [member])) + +namespace LiveValuesIso + +/-- Drop historical dead rows from a live-register relation when every +future-observable baseline value is known to denote a live heap slot (or is a +scalar). This is the direct adapter used when liveness comes from producer +capabilities rather than membership in the external root multiset. -/ +theorem toHeapIsoOfLive + {source : Function} {blockId pc : Nat} + {baselineStore rewrittenStore : IxIR1.Store} + (history : IxIR1.Sim.HeapHistoryIso baselineStore rewrittenStore) + (closed : IxIR1.Sim.StoreClosed baselineStore) + {baseline rewritten : Array RVal} + (values : LiveValuesIso source blockId pc history.locRel + baseline rewritten) + (valueLive : ∀ {index : Nat} {value : RVal}, + ValueLiveFrom source blockId pc index → + baseline[index]? = some value → + IxIR1.Sim.LiveRVal baselineStore value) : + LiveValuesIso source blockId pc (history.toHeapIso closed).locRel + baseline rewritten := by + refine ⟨values.length, ?_⟩ + intro index baselineValue live found + obtain ⟨rewrittenValue, rewrittenAt, related⟩ := + values.related live found + exact ⟨rewrittenValue, rewrittenAt, + rValIso_toHeapIso_of_live history closed related (valueLive live found)⟩ + +/-- Drop historical dead rows from a live-register relation when the +baseline values observed by the frame are supported by exact roots. -/ +theorem toHeapIsoOfSupported + {source : Function} {blockId pc : Nat} + {baselineStore rewrittenStore : IxIR1.Store} + (history : IxIR1.Sim.HeapHistoryIso baselineStore rewrittenStore) + (closed : IxIR1.Sim.StoreClosed baselineStore) + {roots : List IxIR1.Sim.Root} + (ownership : IxIR1.Sim.RootOwnership baselineStore roots) + {baseline rewritten : Array RVal} + (values : LiveValuesIso source blockId pc history.locRel + baseline rewritten) + (supported : ∀ {index : Nat} {value : RVal}, + ValueLiveFrom source blockId pc index → + baseline[index]? = some value → + ValueSupportedByRoots roots value) : + LiveValuesIso source blockId pc (history.toHeapIso closed).locRel + baseline rewritten := by + exact values.toHeapIsoOfLive history closed fun live found => + (supported live found).liveRVal ownership + +end LiveValuesIso + +namespace StableLiveFrameIso + +/-- Root-supported live registers and an empty credit file allow a frame to +forget historical dead rows. -/ +theorem toHeapIsoOfSupported + {limits : Validate.Limits} {validation : Validate.Context} + {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {baselineStore rewrittenStore : IxIR1.Store} + (history : IxIR1.Sim.HeapHistoryIso baselineStore rewrittenStore) + (closed : IxIR1.Sim.StoreClosed baselineStore) + {roots : List IxIR1.Sim.Root} + (ownership : IxIR1.Sim.RootOwnership baselineStore roots) + {baseline rewritten : Frame} + (frame : StableLiveFrameIso rewrite history.locRel baseline rewritten) + (supported : LiveFrameSupportedByRoots roots baseline) : + StableLiveFrameIso rewrite (history.toHeapIso closed).locRel + baseline rewritten := by + refine ⟨frame.baselineDefinition, frame.rewrittenDefinition, frame.block, + frame.pc, frame.values.toHeapIsoOfSupported history closed ownership + (fun live found => supported.values (by + simpa [frame.baselineDefinition] using live) found), ?_⟩ + have rewrittenCreditsSize : rewritten.credits.size = 0 := by + simpa [supported.noCredits] using frame.credits.length_eq.symm + have rewrittenCredits : rewritten.credits = #[] := + Array.eq_empty_of_size_eq_zero rewrittenCreditsSize + rw [supported.noCredits, rewrittenCredits] + exact .nil + +end StableLiveFrameIso + +namespace StableLiveContinuationIso + +/-- Root-supported continuation values retain their relation after history +is restricted to live heap locations. -/ +theorem toHeapIsoOfSupported + {limits : Validate.Limits} {validation : Validate.Context} + {baselineStore rewrittenStore : IxIR1.Store} + (history : IxIR1.Sim.HeapHistoryIso baselineStore rewrittenStore) + (closed : IxIR1.Sim.StoreClosed baselineStore) + {roots : List IxIR1.Sim.Root} + (ownership : IxIR1.Sim.RootOwnership baselineStore roots) + {baseline rewritten : Continuation} + (continuation : StableLiveContinuationIso limits validation + history.locRel baseline rewritten) + (supported : LiveContinuationSupportedByRoots roots baseline) : + StableLiveContinuationIso limits validation + (history.toHeapIso closed).locRel baseline rewritten := by + cases continuation with + | resume frame => + cases supported with + | resume frameSupported => + cases frame with + | rewritten rewrite related => + exact .resume (.rewritten rewrite + (related.toHeapIsoOfSupported history closed ownership + frameSupported)) + | applyMore arguments frame => + cases supported with + | applyMore argumentsSupported frameSupported => + cases frame with + | rewritten rewrite related => + exact .applyMore + (rvalsIso_toHeapIso_of_supported history closed ownership + arguments argumentsSupported) + (.rewritten rewrite + (related.toHeapIsoOfSupported history closed ownership + frameSupported)) + +end StableLiveContinuationIso + +namespace StableLiveStackIso + +/-- Exact compiler root support lets a suspended-stack relation forget every +dead/dead allocation-history row and retain only the live heap bijection. -/ +theorem toHeapIsoOfSupported + {limits : Validate.Limits} {validation : Validate.Context} + {baselineStore rewrittenStore : IxIR1.Store} + (history : IxIR1.Sim.HeapHistoryIso baselineStore rewrittenStore) + (closed : IxIR1.Sim.StoreClosed baselineStore) + {roots : List IxIR1.Sim.Root} + (ownership : IxIR1.Sim.RootOwnership baselineStore roots) + {baseline rewritten : List Continuation} + (stack : StableLiveStackIso limits validation history.locRel + baseline rewritten) + (supported : LiveStackSupportedByRoots roots baseline) : + StableLiveStackIso limits validation + (history.toHeapIso closed).locRel baseline rewritten := by + induction stack with + | nil => exact .nil + | cons head tail ih => + cases supported with + | cons headSupported tailSupported => + exact .cons + (head.toHeapIsoOfSupported history closed ownership headSupported) + (ih tailSupported) + +end StableLiveStackIso + +private theorem rvalsIso_identity_of_inBounds + {store : IxIR1.Store} {locRel : Nat → Nat → Prop} + (self : ∀ {location : Nat}, location < store.nodes.size → + locRel location location) : + ∀ {values : List RVal}, + IxIR1.Reclamation.ValuesInBounds store values → + IxIR1.Sim.RValsIso locRel values values + | [], _ => .nil + | value :: values, bounds => by + have tailBounds : IxIR1.Reclamation.ValuesInBounds store values := by + intro found member + exact bounds found (by simp [member]) + have tail := rvalsIso_identity_of_inBounds self tailBounds + cases value with + | loc location => + exact .cons (.loc (self (bounds (.loc location) (by simp)))) tail + | lit literal => exact .cons .lit tail + | erased => exact .cons .erased tail + +/-- Re-index an equality-related live register file by any identity relation +that covers the baseline's already-allocated locations. -/ +theorem LiveValuesIso.identityOfInBounds + {source : Function} {blockId pc : Nat} + {store : IxIR1.Store} {locRel : Nat → Nat → Prop} + {baseline rewritten : Array RVal} + (values : LiveValuesIso source blockId pc + (fun left right => left = right) baseline rewritten) + (self : ∀ {location : Nat}, location < store.nodes.size → + locRel location location) + (bounds : ∀ {index : Nat} {value : RVal}, + ValueLiveFrom source blockId pc index → + baseline[index]? = some value → + IxIR1.Reclamation.ValueInBounds store value) : + LiveValuesIso source blockId pc locRel baseline rewritten := by + refine ⟨values.length, ?_⟩ + intro index baselineValue live found + obtain ⟨rewrittenValue, rewrittenAt, related⟩ := + values.related live found + have valueEq := related.eq_of_location_eq + subst rewrittenValue + refine ⟨baselineValue, rewrittenAt, ?_⟩ + cases baselineValue with + | loc location => exact .loc (self (bounds live found)) + | lit literal => exact .lit + | erased => exact .erased + +/-- Re-index an equality-related frame when its future-live baseline values +are in bounds and its compiler-produced credit file is empty. -/ +theorem StableLiveFrameIso.identityOfInBounds + {limits : Validate.Limits} {validation : Validate.Context} + {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {store : IxIR1.Store} {locRel : Nat → Nat → Prop} + {baseline rewritten : Frame} + (frame : StableLiveFrameIso rewrite (fun left right => left = right) + baseline rewritten) + (self : ∀ {location : Nat}, location < store.nodes.size → + locRel location location) + (bounds : ∀ {index : Nat} {value : RVal}, + ValueLiveFrom source baseline.block baseline.pc index → + baseline.values[index]? = some value → + IxIR1.Reclamation.ValueInBounds store value) + (noCredits : baseline.credits = #[]) : + StableLiveFrameIso rewrite locRel baseline rewritten := by + have creditsEq : baseline.credits.toList = rewritten.credits.toList := + frame.credits.eq_of_location_eq + have baselineCredits : baseline.credits.toList = [] := by + simp [noCredits] + have rewrittenCredits : rewritten.credits.toList = [] := by + rw [← creditsEq] + exact baselineCredits + refine ⟨frame.baselineDefinition, frame.rewrittenDefinition, frame.block, + frame.pc, frame.values.identityOfInBounds self bounds, ?_⟩ + rw [baselineCredits, rewrittenCredits] + exact .nil + +/-- Re-index an equality-related suspended continuation using compiler root +support for every observable baseline value. -/ +theorem StableLiveContinuationIso.identityOfSupported + {limits : Validate.Limits} {validation : Validate.Context} + {store : IxIR1.Store} {roots : List IxIR1.Sim.Root} + {locRel : Nat → Nat → Prop} + (self : ∀ {location : Nat}, location < store.nodes.size → + locRel location location) + (ownership : IxIR1.Sim.RootOwnership store roots) + {baseline rewritten : Continuation} + (continuation : StableLiveContinuationIso limits validation + (fun left right => left = right) baseline rewritten) + (supported : LiveContinuationSupportedByRoots roots baseline) : + StableLiveContinuationIso limits validation locRel baseline rewritten := by + cases continuation with + | resume frame => + cases supported with + | resume support => + cases frame with + | rewritten rewrite related => + exact .resume (.rewritten rewrite + (related.identityOfInBounds self + (fun live found => + (support.values (by + simpa [related.baselineDefinition] using live) + found).inBounds ownership) + support.noCredits)) + | applyMore arguments frame => + cases supported with + | applyMore argumentSupport frameSupport => + cases frame with + | rewritten rewrite related => + exact .applyMore (by + rw [← arguments.eq_of_location_eq] + apply rvalsIso_identity_of_inBounds self + intro value member + exact (argumentSupport value member).inBounds ownership) + (.rewritten rewrite + (related.identityOfInBounds self + (fun live found => + (frameSupport.values (by + simpa [related.baselineDefinition] using live) + found).inBounds ownership) + frameSupport.noCredits)) + +/-- Re-index an equality-related suspended stack using the aggregate compiler +root ownership that supports all of its observable baseline values. -/ +theorem StableLiveStackIso.identityOfSupported + {limits : Validate.Limits} {validation : Validate.Context} + {store : IxIR1.Store} {roots : List IxIR1.Sim.Root} + {locRel : Nat → Nat → Prop} + (self : ∀ {location : Nat}, location < store.nodes.size → + locRel location location) + (ownership : IxIR1.Sim.RootOwnership store roots) + {baseline rewritten : List Continuation} + (stack : StableLiveStackIso limits validation + (fun left right => left = right) baseline rewritten) + (supported : LiveStackSupportedByRoots roots baseline) : + StableLiveStackIso limits validation locRel baseline rewritten := by + induction stack with + | nil => exact .nil + | cons head tail ih => + cases supported with + | cons supportedHead supportedTail => + exact .cons + (head.identityOfSupported self ownership supportedHead) + (ih supportedTail) + +/-! The indexed avoidance predicates retain each continuation's source +function alongside the stable proof. -/ + +inductive StableLiveContinuationAvoids (limits : Validate.Limits) + (validation : Validate.Context) (locRel : Nat → Nat → Prop) + (location : Nat) : Continuation → Continuation → Prop where + | resume {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {baseline rewritten : Frame} + (frame : StableLiveFrameIso rewrite locRel baseline rewritten) + (avoids : LiveValuesAvoidLocation source rewritten.block rewritten.pc + location rewritten.values) + (credits : FrameCreditsAvoidLocation location rewritten) : + StableLiveContinuationAvoids limits validation locRel location + (.resume baseline) + (.resume rewritten) + | applyMore {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {baselineArguments rewrittenArguments : Array RVal} + {baseline rewritten : Frame} + (arguments : IxIR1.Sim.RValsIso locRel + baselineArguments.toList rewrittenArguments.toList) + (argumentAvoids : ∀ value ∈ rewrittenArguments.toList, + value ≠ .loc location) + (frame : StableLiveFrameIso rewrite locRel baseline rewritten) + (avoids : LiveValuesAvoidLocation source rewritten.block rewritten.pc + location rewritten.values) + (credits : FrameCreditsAvoidLocation location rewritten) : + StableLiveContinuationAvoids limits validation locRel location + (.applyMore baselineArguments baseline) + (.applyMore rewrittenArguments rewritten) + +inductive StableLiveStackAvoids (limits : Validate.Limits) + (validation : Validate.Context) (locRel : Nat → Nat → Prop) + (location : Nat) : List Continuation → List Continuation → Prop where + | nil : StableLiveStackAvoids limits validation locRel location [] [] + | cons {baseline rewritten : Continuation} + {baselineTail rewrittenTail : List Continuation} + (head : StableLiveContinuationAvoids limits validation locRel location + baseline rewritten) + (tail : StableLiveStackAvoids limits validation locRel location + baselineTail rewrittenTail) : + StableLiveStackAvoids limits validation locRel location + (baseline :: baselineTail) (rewritten :: rewrittenTail) + +namespace StableLiveFrameIso + +/-- Exact unit-refcount ownership of the active source excludes its target +counterpart from every related future-live register and credit slot in a +suspended frame. -/ +private theorem avoidsOfSupportedUnit {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {baselineStore rewrittenStore : IxIR1.Store} + (iso : IxIR1.Sim.HeapIso rewrittenStore baselineStore) + {baselineLocation rewrittenLocation : Nat} {node : IxIR1.Node} + {roots rest : List IxIR1.Sim.Root} + (locations : iso.locRel rewrittenLocation baselineLocation) + (found : baselineStore.get? baselineLocation = + some ⟨.shared, 1, node⟩) + (ownership : IxIR1.Sim.RootOwnership baselineStore + (⟨.shared, .loc baselineLocation⟩ :: rest)) + (rootsInRest : ∀ root ∈ roots, root ∈ rest) + {baseline rewritten : Frame} + (frame : StableLiveFrameIso rewrite + (fun baselineLocation rewrittenLocation => + iso.locRel rewrittenLocation baselineLocation) + baseline rewritten) + (supported : LiveFrameSupportedByRoots roots baseline) : + LiveValuesAvoidLocation source rewritten.block rewritten.pc + rewrittenLocation rewritten.values ∧ + FrameCreditsAvoidLocation rewrittenLocation rewritten := by + have baselineAvoids : LiveValuesAvoidLocation source baseline.block + baseline.pc baselineLocation baseline.values := by + intro index value live valueAt + apply (supported.values (by + simpa [frame.baselineDefinition] using live) valueAt).avoidsUnitShared + rootsInRest found ownership + constructor + · intro index rewrittenValue live rewrittenAt + have rewrittenBound : index < rewritten.values.size := + (Array.getElem?_eq_some_iff.mp rewrittenAt).1 + have baselineBound : index < baseline.values.size := by + rw [frame.values.length] + exact rewrittenBound + let baselineValue := baseline.values[index] + have baselineAt : baseline.values[index]? = some baselineValue := by + simp [baselineValue] + have baselineLive : ValueLiveFrom source baseline.block baseline.pc index := + by simpa [frame.block, frame.pc] using live + obtain ⟨actualRewritten, actualAt, related⟩ := + frame.values.related baselineLive baselineAt + have actualEq : actualRewritten = rewrittenValue := + Option.some.inj (actualAt.symm.trans rewrittenAt) + subst actualRewritten + have baselineDifferent : baselineValue ≠ .loc baselineLocation := + baselineAvoids baselineLive baselineAt + have singletonRelated : IxIR1.Sim.RValsIso + (fun baselineLocation rewrittenLocation => + iso.locRel rewrittenLocation baselineLocation) + [baselineValue] [rewrittenValue] := .cons related .nil + exact rvalsIso_right_avoids_of_left iso locations singletonRelated + (by + intro value member + have same : value = baselineValue := by simpa using member + subst value + exact baselineDifferent) + rewrittenValue (by simp) + · have rewrittenCreditSize : rewritten.credits.size = 0 := by + simpa [supported.noCredits] using frame.credits.length_eq.symm + have rewrittenCredits : rewritten.credits = #[] := + Array.eq_empty_of_size_eq_zero rewrittenCreditSize + unfold FrameCreditsAvoidLocation + rw [rewrittenCredits] + trivial + +end StableLiveFrameIso + +namespace StableLiveContinuationIso + +/-- Upgrade one related continuation to the avoidance relation using only +its baseline framed-root support. -/ +private theorem avoidsOfSupportedUnit {limits : Validate.Limits} + {validation : Validate.Context} + {baselineStore rewrittenStore : IxIR1.Store} + (iso : IxIR1.Sim.HeapIso rewrittenStore baselineStore) + {baselineLocation rewrittenLocation : Nat} {node : IxIR1.Node} + {roots rest : List IxIR1.Sim.Root} + (locations : iso.locRel rewrittenLocation baselineLocation) + (found : baselineStore.get? baselineLocation = + some ⟨.shared, 1, node⟩) + (ownership : IxIR1.Sim.RootOwnership baselineStore + (⟨.shared, .loc baselineLocation⟩ :: rest)) + (rootsInRest : ∀ root ∈ roots, root ∈ rest) + {baseline rewritten : Continuation} + (continuation : StableLiveContinuationIso limits validation + (fun baselineLocation rewrittenLocation => + iso.locRel rewrittenLocation baselineLocation) + baseline rewritten) + (supported : LiveContinuationSupportedByRoots roots baseline) : + StableLiveContinuationAvoids limits validation + (fun baselineLocation rewrittenLocation => + iso.locRel rewrittenLocation baselineLocation) + rewrittenLocation baseline rewritten := by + cases continuation with + | resume frame => + cases supported with + | resume supportedFrame => + cases frame with + | rewritten rewrite related => + obtain ⟨valuesAvoid, creditsAvoid⟩ := + related.avoidsOfSupportedUnit iso locations found ownership + rootsInRest supportedFrame + exact .resume related valuesAvoid creditsAvoid + | applyMore arguments frame => + cases supported with + | applyMore supportedArguments supportedFrame => + cases frame with + | rewritten rewrite related => + have baselineArgumentAvoids := fun value member => + (supportedArguments value member).avoidsUnitShared + rootsInRest found ownership + have rewrittenArgumentAvoids := + rvalsIso_right_avoids_of_left iso locations arguments + baselineArgumentAvoids + obtain ⟨valuesAvoid, creditsAvoid⟩ := + related.avoidsOfSupportedUnit iso locations found ownership + rootsInRest supportedFrame + exact .applyMore arguments rewrittenArgumentAvoids related + valuesAvoid creditsAvoid + +end StableLiveContinuationIso + +namespace StableLiveStackIso + +/-- Turn compiler framed-root support into the precise avoidance witness +needed to replace one allocation-history pair during physical reuse. Dead +append-only registers remain outside both the premise and conclusion. -/ +theorem avoidsOfSupportedUnit {limits : Validate.Limits} + {validation : Validate.Context} + {baselineStore rewrittenStore : IxIR1.Store} + (iso : IxIR1.Sim.HeapIso rewrittenStore baselineStore) + {baselineLocation rewrittenLocation : Nat} {node : IxIR1.Node} + {roots rest : List IxIR1.Sim.Root} + (locations : iso.locRel rewrittenLocation baselineLocation) + (found : baselineStore.get? baselineLocation = + some ⟨.shared, 1, node⟩) + (ownership : IxIR1.Sim.RootOwnership baselineStore + (⟨.shared, .loc baselineLocation⟩ :: rest)) + (rootsInRest : ∀ root ∈ roots, root ∈ rest) + {baseline rewritten : List Continuation} + (stack : StableLiveStackIso limits validation + (fun baselineLocation rewrittenLocation => + iso.locRel rewrittenLocation baselineLocation) + baseline rewritten) + (supported : LiveStackSupportedByRoots roots baseline) : + StableLiveStackAvoids limits validation + (fun baselineLocation rewrittenLocation => + iso.locRel rewrittenLocation baselineLocation) + rewrittenLocation baseline rewritten := by + induction stack with + | nil => exact .nil + | cons head tail ih => + cases supported with + | cons supportedHead supportedTail => + exact .cons + (head.avoidsOfSupportedUnit iso locations found ownership + rootsInRest supportedHead) + (ih supportedTail) + +end StableLiveStackIso + +namespace StableLiveContinuationAvoids + +private theorem rvals_transportRelation + {oldRel newRel : Nat → Nat → Prop} {removed : Nat} + {baseline rewritten : List RVal} + (related : IxIR1.Sim.RValsIso oldRel baseline rewritten) + (avoids : ∀ value ∈ rewritten, value ≠ .loc removed) + (lift : ∀ {baselineLocation rewrittenLocation}, + oldRel baselineLocation rewrittenLocation → + rewrittenLocation ≠ removed → + newRel baselineLocation rewrittenLocation) : + IxIR1.Sim.RValsIso newRel baseline rewritten := by + induction related with + | nil => exact .nil + | @cons baselineValue rewrittenValue baselineTail rewrittenTail head tail ih => + have tailAvoid : ∀ value ∈ rewrittenTail, + value ≠ IxIR1.RVal.loc removed := by + intro value member + exact avoids value (by simp [member]) + have newTail := ih tailAvoid + cases head with + | @loc baselineLocation rewrittenLocation locationRelated => + have headAvoid : (IxIR1.RVal.loc rewrittenLocation) ≠ + IxIR1.RVal.loc removed := + avoids _ (by simp) + have different : rewrittenLocation ≠ removed := by + intro same + apply headAvoid + cases same + rfl + exact .cons (.loc (lift locationRelated different)) newTail + | lit => exact .cons .lit newTail + | erased => exact .cons .erased newTail + +/-- Transport one continuation after a physical address is assigned a new +allocation epoch. -/ +theorem transportRelation {limits : Validate.Limits} + {validation : Validate.Context} {oldRel newRel : Nat → Nat → Prop} + {removed : Nat} {baseline rewritten : Continuation} + (continuation : StableLiveContinuationAvoids limits validation oldRel + removed baseline rewritten) + (lift : ∀ {baselineLocation rewrittenLocation}, + oldRel baselineLocation rewrittenLocation → + rewrittenLocation ≠ removed → + newRel baselineLocation rewrittenLocation) : + StableLiveContinuationIso limits validation newRel baseline rewritten := by + cases continuation with + | resume frame avoids credits => + exact .resume (.rewritten _ + (frame.transportRelation avoids credits lift)) + | applyMore arguments argumentAvoids frame avoids credits => + have transportedArguments := + rvals_transportRelation arguments argumentAvoids lift + exact .applyMore transportedArguments (.rewritten _ + (frame.transportRelation avoids credits lift)) + +end StableLiveContinuationAvoids + +namespace StableLiveStackAvoids + +/-- Transport a whole suspended stack while imposing no condition on dead +append-only caller registers. -/ +theorem transportRelation {limits : Validate.Limits} + {validation : Validate.Context} {oldRel newRel : Nat → Nat → Prop} + {removed : Nat} {baseline rewritten : List Continuation} + (stack : StableLiveStackAvoids limits validation oldRel removed baseline + rewritten) + (lift : ∀ {baselineLocation rewrittenLocation}, + oldRel baselineLocation rewrittenLocation → + rewrittenLocation ≠ removed → + newRel baselineLocation rewrittenLocation) : + StableLiveStackIso limits validation newRel baseline rewritten := by + induction stack with + | nil => exact .nil + | cons head tail ih => + exact .cons (head.transportRelation lift) ih + +end StableLiveStackAvoids + +/-- The original all-register continuation relation embeds into the +live-indexed relation. -/ +theorem StableContinuationIso.toLive {limits : Validate.Limits} + {validation : Validate.Context} {locRel : Nat → Nat → Prop} + {baseline rewritten : Continuation} + (continuation : StableContinuationIso limits validation locRel + baseline rewritten) : + StableLiveContinuationIso limits validation locRel baseline rewritten := by + cases continuation with + | resume frame => + cases frame with + | rewritten rewrite related => + exact .resume (.rewritten rewrite + (StableLiveFrameIso.ofStable related)) + | applyMore arguments frame => + cases frame with + | rewritten rewrite related => + exact .applyMore arguments (.rewritten rewrite + (StableLiveFrameIso.ofStable related)) + +/-- The original all-register stack relation embeds into the live-indexed +relation. -/ +theorem StableStackIso.toLive {limits : Validate.Limits} + {validation : Validate.Context} {locRel : Nat → Nat → Prop} + {baseline rewritten : List Continuation} + (stack : StableStackIso limits validation locRel baseline rewritten) : + StableLiveStackIso limits validation locRel baseline rewritten := by + induction stack with + | nil => exact .nil + | cons head tail ih => + exact .cons (StableContinuationIso.toLive head) ih + +/-- Live-indexed stable control states. -/ +inductive StableLiveControlIso (limits : Validate.Limits) + (validation : Validate.Context) (locRel : Nat → Nat → Prop) : + Control → Control → Prop where + | running {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (frame : StableLiveFrameRel limits validation locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation locRel + baselineStack rewrittenStack) : + StableLiveControlIso limits validation locRel + (.running baselineFrame baselineStack) + (.running rewrittenFrame rewrittenStack) + | halted {baselineValue rewrittenValue : RVal} + (value : IxIR1.Sim.RValIso locRel baselineValue rewrittenValue) : + StableLiveControlIso limits validation locRel + (.halted baselineValue) (.halted rewrittenValue) + +/-- Machine relation that is stable under physical address reuse in the +presence of dead suspended registers. -/ +inductive StableLiveMachineRel (limits : Validate.Limits) + (validation : Validate.Context) (baseline rewritten : Machine) : Prop where + | related (locRel : Nat → Nat → Prop) + (heap : StableHeapRel baseline.store rewritten.store locRel) + (fuel : baseline.heapFuel ≤ rewritten.heapFuel) + (control : StableLiveControlIso limits validation locRel + baseline.control rewritten.control) : + StableLiveMachineRel limits validation baseline rewritten + +theorem StableLiveMachineRel.live_eq {limits : Validate.Limits} {validation : Validate.Context} + {baseline rewritten : Machine} (related : StableLiveMachineRel limits validation baseline rewritten) : + baseline.store.live = rewritten.store.live := by + cases related with + | related locRel heap fuel control => exact heap.live_eq + +/-- The four instruction forms that may occur inside a recognized baseline +reuse prefix. They require a block-decision split: an unchanged block advances +one instruction, while an accepted block is consumed only by its whole macro. -/ +inductive AcceptedPrefixInstruction : Instr → Prop where + | fetch (target : Atom) (cid : CtorId) (field : Nat) : + AcceptedPrefixInstruction (.fetch target cid field) + | retainShared (target : Atom) : + AcceptedPrefixInstruction (.retainShared target) + | releaseShared (target : Atom) : + AcceptedPrefixInstruction (.releaseShared target) + | allocShared (cid : CtorId) (arguments : Array Atom) : + AcceptedPrefixInstruction (.alloc .shared cid arguments) + +/-- A concrete running machine is poised at one instruction belonging to the +recognized-prefix instruction family. This packages the evaluator-facing +syntax needed by compiler-aware dispatch without assuming the block itself +was accepted by the optimizer. -/ +structure AcceptedPrefixInstructionAt (machine : Machine) where + frame : Frame + stack : List Continuation + block : Block + instruction : Instr + control : machine.control = .running frame stack + blockAt : frame.definition.blocks[frame.block]? = some block + pc : frame.pc < block.instructions.size + instructionAt : block.instructions[frame.pc] = instruction + acceptedPrefix : AcceptedPrefixInstruction instruction + +/-- At a synchronized frame selected by an accepted rewrite decision, the +baseline evaluator is still at block entry. This phase condition deliberately +belongs to synchronization boundaries rather than `StableLiveFrameIso`: +accepted-prefix proofs relate internal nonzero program counters locally. -/ +def StableLiveFrameIso.AcceptedEntry {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {locRel : Nat → Nat → Prop} {baseline rewritten : Frame} + (_frame : StableLiveFrameIso rewrite locRel baseline rewritten) : Prop := + ∀ {helperOffset : Nat} {block : Block} + {site : Reuse.Site limits validation block}, + Reuse.FunctionDecisions.At rewrite.decisions baseline.block + helperOffset block (.accepted site) → + baseline.pc = 0 + +/-- Every live frame decomposition of a synchronized machine pair places an +accepted source block at entry. Quantifying over the decomposition keeps the +phase fact independent of proof identity while tying its rewrite to both +concrete controls through `StableLiveFrameIso`. -/ +def StableLiveAcceptedEntry (limits : Validate.Limits) + (validation : Validate.Context) (baseline rewritten : Machine) : Prop := + ∀ {locRel : Nat → Nat → Prop} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation}, + baseline.control = .running baselineFrame baselineStack → + rewritten.control = .running rewrittenFrame rewrittenStack → + (frame : StableLiveFrameIso rewrite locRel baselineFrame rewrittenFrame) → + frame.AcceptedEntry + +/-- A synchronized pair whose baseline control is at program counter zero +satisfies the accepted-entry phase independently of its current block. -/ +theorem StableLiveAcceptedEntry.ofPcZero {limits : Validate.Limits} + {validation : Validate.Context} {baseline rewritten : Machine} + {frame : Frame} {stack : List Continuation} + (control : baseline.control = .running frame stack) + (pc : frame.pc = 0) : + StableLiveAcceptedEntry limits validation baseline rewritten := by + intro locRel source rewrite baselineFrame rewrittenFrame baselineStack + rewrittenStack baselineControl _rewrittenControl _related + intro helperOffset block site found + have controls : Control.running frame stack = + .running baselineFrame baselineStack := control.symm.trans baselineControl + injection controls with frameEq _stackEq + simpa [← frameEq] using pc + +/-- A halted baseline has no running accepted-site phase obligation. -/ +theorem StableLiveAcceptedEntry.halted {limits : Validate.Limits} + {validation : Validate.Context} {baseline rewritten : Machine} + {value : RVal} (control : baseline.control = .halted value) : + StableLiveAcceptedEntry limits validation baseline rewritten := by + intro locRel source rewrite baselineFrame rewrittenFrame baselineStack + rewrittenStack baselineControl + rw [control] at baselineControl + cases baselineControl + +/-- A synchronized running pair whose current source and rewritten blocks are +literally the same has no accepted-site obligation. An accepted decision +necessarily installs a reset block different from its recognized source +block. This covers nonzero ordinary successors inside unchanged blocks. -/ +theorem StableLiveAcceptedEntry.ofSameBlock {limits : Validate.Limits} + {validation : Validate.Context} {baseline rewritten : Machine} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} {block : Block} + (baselineControl : baseline.control = + .running baselineFrame baselineStack) + (rewrittenControl : rewritten.control = + .running rewrittenFrame rewrittenStack) + (baselineAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (rewrittenAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) : + StableLiveAcceptedEntry limits validation baseline rewritten := by + intro locRel source rewrite currentBaseline currentRewritten currentStack + currentRewrittenStack currentBaselineControl currentRewrittenControl frame + have baselineControls : Control.running baselineFrame baselineStack = + .running currentBaseline currentStack := + baselineControl.symm.trans currentBaselineControl + have rewrittenControls : Control.running rewrittenFrame rewrittenStack = + .running currentRewritten currentRewrittenStack := + rewrittenControl.symm.trans currentRewrittenControl + injection baselineControls with baselineFrameEq _baselineStackEq + injection rewrittenControls with rewrittenFrameEq _rewrittenStackEq + subst currentBaseline + subst currentRewritten + intro helperOffset selectedBlock site found + have sourceAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact baselineAt + have targetAt : rewrite.definition.blocks[baselineFrame.block]? = + some block := by + rw [← frame.rewrittenDefinition, frame.block] + exact rewrittenAt + have selectedSource := (rewrite.acceptedAt found).1 + have blockEq : block = selectedBlock := + Option.some.inj (sourceAt.symm.trans selectedSource) + have selectedTarget : rewrite.definition.blocks[baselineFrame.block]? = + some selectedBlock := by + simpa [blockEq] using targetAt + exact False.elim (rewrite.accepted_target_ne_source found selectedTarget) + +/-- If the current source block admits no accepted-site witness, its program +counter is irrelevant to the accepted-entry phase. This form is used for +resumed callers: the instruction that created their continuation is a call or +dynamic application, none of which can occur in an accepted reset source. -/ +theorem StableLiveAcceptedEntry.ofSourceBlockExcluded + {limits : Validate.Limits} {validation : Validate.Context} + {baseline rewritten : Machine} {frame : Frame} + {stack : List Continuation} {block : Block} + (control : baseline.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + (excluded : ∀ _site : Reuse.Site limits validation block, False) : + StableLiveAcceptedEntry limits validation baseline rewritten := by + intro locRel source rewrite currentBaseline currentRewritten currentStack + currentRewrittenStack currentControl _rewrittenControl related + have controls : Control.running frame stack = + .running currentBaseline currentStack := control.symm.trans currentControl + injection controls with frameEq _stackEq + subst currentBaseline + intro helperOffset selectedBlock site found + have sourceAt : source.blocks[frame.block]? = some block := by + rw [← related.baselineDefinition] + exact blockAt + have selectedSource := (rewrite.acceptedAt found).1 + have blockEq : block = selectedBlock := + Option.some.inj (sourceAt.symm.trans selectedSource) + subst selectedBlock + exact False.elim (excluded site) + +/-- A frame resumed after an addressed call cannot be an accepted block at a +nonzero program counter, because accepted source prefixes contain no call. -/ +theorem StableLiveAcceptedEntry.ofCallResume {limits : Validate.Limits} + {validation : Validate.Context} {baseline rewritten : Machine} + {frame : Frame} {stack : List Continuation} {block : Block} + (control : baseline.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + {position : Nat} {address : Ixon.Address} {arguments : Array Atom} + (instructionAt : block.instructions[position]? = + some (.call address arguments)) : + StableLiveAcceptedEntry limits validation baseline rewritten := + StableLiveAcceptedEntry.ofSourceBlockExcluded control blockAt fun site => + site.noCall instructionAt + +/-- A frame resumed after a recursive call likewise cannot be an accepted +block at a nonzero program counter. -/ +theorem StableLiveAcceptedEntry.ofCallSelfResume {limits : Validate.Limits} + {validation : Validate.Context} {baseline rewritten : Machine} + {frame : Frame} {stack : List Continuation} {block : Block} + (control : baseline.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + {position : Nat} {arguments : Array Atom} + (instructionAt : block.instructions[position]? = + some (.callSelf arguments)) : + StableLiveAcceptedEntry limits validation baseline rewritten := + StableLiveAcceptedEntry.ofSourceBlockExcluded control blockAt fun site => + site.noCallSelf instructionAt + +/-- A frame resumed after dynamic over-application cannot be an accepted +block at a nonzero program counter. -/ +theorem StableLiveAcceptedEntry.ofApplyResume {limits : Validate.Limits} + {validation : Validate.Context} {baseline rewritten : Machine} + {frame : Frame} {stack : List Continuation} {block : Block} + (control : baseline.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + {position : Nat} {function : Atom} {arguments : Array Atom} + (instructionAt : block.instructions[position]? = + some (.apply function arguments)) : + StableLiveAcceptedEntry limits validation baseline rewritten := + StableLiveAcceptedEntry.ofSourceBlockExcluded control blockAt fun site => + site.noApply instructionAt + +/-- Advancing past an ordinary move cannot leave a synchronized pair inside +an accepted source block, because accepted reset prefixes contain no move. -/ +theorem StableLiveAcceptedEntry.ofMoveAdvance {limits : Validate.Limits} + {validation : Validate.Context} {baseline rewritten : Machine} + {frame : Frame} {stack : List Continuation} {block : Block} + (control : baseline.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + {position : Nat} {atom : Atom} + (instructionAt : block.instructions[position]? = some (.move atom)) : + StableLiveAcceptedEntry limits validation baseline rewritten := + StableLiveAcceptedEntry.ofSourceBlockExcluded control blockAt fun site => + site.noMove instructionAt + +/-- Advancing past a unique-free instruction preserves accepted-entry phase +by excluding the current source block from the reuse recognizer. -/ +theorem StableLiveAcceptedEntry.ofFreeUniqueAdvance + {limits : Validate.Limits} {validation : Validate.Context} + {baseline rewritten : Machine} {frame : Frame} + {stack : List Continuation} {block : Block} + (control : baseline.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + {position : Nat} {atom : Atom} {identity : CtorId} + (instructionAt : block.instructions[position]? = + some (.freeUnique atom identity)) : + StableLiveAcceptedEntry limits validation baseline rewritten := + StableLiveAcceptedEntry.ofSourceBlockExcluded control blockAt fun site => + site.noFreeUnique instructionAt + +/-- Advancing past a function partial application preserves phase because +that instruction cannot occur in a recognized reset source. -/ +theorem StableLiveAcceptedEntry.ofPappAdvance {limits : Validate.Limits} + {validation : Validate.Context} {baseline rewritten : Machine} + {frame : Frame} {stack : List Continuation} {block : Block} + (control : baseline.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + {position : Nat} {address : Ixon.Address} {arguments : Array Atom} + (instructionAt : block.instructions[position]? = + some (.papp address arguments)) : + StableLiveAcceptedEntry limits validation baseline rewritten := + StableLiveAcceptedEntry.ofSourceBlockExcluded control blockAt fun site => + site.noPapp instructionAt + +/-- Advancing past a unique drop preserves phase because accepted reset +prefixes contain only shared release. -/ +theorem StableLiveAcceptedEntry.ofDropUniqueAdvance + {limits : Validate.Limits} {validation : Validate.Context} + {baseline rewritten : Machine} {frame : Frame} + {stack : List Continuation} {block : Block} + (control : baseline.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + {position : Nat} {atom : Atom} + (instructionAt : block.instructions[position]? = + some (.dropUnique atom)) : + StableLiveAcceptedEntry limits validation baseline rewritten := + StableLiveAcceptedEntry.ofSourceBlockExcluded control blockAt fun site => + site.noDropUnique instructionAt + +/-- Advancing past a unique allocation preserves phase because recognized +reset sources allocate only shared constructors. -/ +theorem StableLiveAcceptedEntry.ofAllocUniqueAdvance + {limits : Validate.Limits} {validation : Validate.Context} + {baseline rewritten : Machine} {frame : Frame} + {stack : List Continuation} {block : Block} + (control : baseline.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + {position : Nat} {identity : CtorId} {arguments : Array Atom} + (instructionAt : block.instructions[position]? = + some (.alloc .unique identity arguments)) : + StableLiveAcceptedEntry limits validation baseline rewritten := + StableLiveAcceptedEntry.ofSourceBlockExcluded control blockAt fun site => + site.noAllocUnique instructionAt + +/-- At an accepted synchronized block, the phase invariant exposes both the +zero program counter and exactly the entry-live parameter relation consumed by +the physical reuse macro. Dead entry slots remain outside that relation. -/ +theorem StableLiveAcceptedEntry.valuesAtEntry {limits : Validate.Limits} + {validation : Validate.Context} {baseline rewritten : Machine} + (phase : StableLiveAcceptedEntry limits validation baseline rewritten) + {locRel : Nat → Nat → Prop} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (baselineControl : baseline.control = + .running baselineFrame baselineStack) + (rewrittenControl : rewritten.control = + .running rewrittenFrame rewrittenStack) + (frame : StableLiveFrameIso rewrite locRel baselineFrame rewrittenFrame) + {helperOffset : Nat} {block : Block} + {site : Reuse.Site limits validation block} + (found : Reuse.FunctionDecisions.At rewrite.decisions + baselineFrame.block helperOffset block (.accepted site)) : + baselineFrame.pc = 0 ∧ + LiveValuesIso source baselineFrame.block 0 locRel + baselineFrame.values rewrittenFrame.values := by + have pc := phase baselineControl rewrittenControl frame found + exact ⟨pc, by simpa [pc] using frame.values⟩ + +/-- Construct a live-indexed machine relation from a baseline-to-rewritten +allocation history. -/ +theorem StableLiveMachineRel.history {limits : Validate.Limits} + {validation : Validate.Context} {baseline rewritten : Machine} + (heap : IxIR1.Sim.HeapHistoryIso baseline.store.heap + rewritten.store.heap) + (fuel : baseline.heapFuel ≤ rewritten.heapFuel) + (control : StableLiveControlIso limits validation heap.locRel + baseline.control rewritten.control) : + StableLiveMachineRel limits validation baseline rewritten := by + exact .related heap.locRel (.isomorphic heap.symm) fuel control + +/-- Related recursive arguments and a live-related suspended stack form the +control state reached after an accepted reset macro. -/ +theorem StableLiveControlIso.recursiveCall {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {locRel : Nat → Nat → Prop} + {baselineValues rewrittenValues : Array RVal} + {baselineStack rewrittenStack : List Continuation} + (values : IxIR1.Sim.RValsIso locRel + baselineValues.toList rewrittenValues.toList) + (stack : StableLiveStackIso limits validation locRel + baselineStack rewrittenStack) : + StableLiveControlIso limits validation locRel + (.running { definition := source, values := baselineValues } + baselineStack) + (.running { definition := rewrite.definition, values := rewrittenValues } + rewrittenStack) := + .running (StableLiveFrameRel.entry rewrite values) stack + +/-- Exact-content accepted endpoints need only live agreement in suspended +frames. -/ +theorem StableLiveMachineRel.contentsRecursiveCall {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineValues rewrittenValues : Array RVal} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (values : IxIR1.Sim.RValsIso (fun left right => left = right) + baselineValues.toList rewrittenValues.toList) + (stack : StableLiveStackIso limits validation + (fun left right => left = right) baselineStack rewrittenStack) : + StableLiveMachineRel limits validation + { store := baselineStore + heapFuel := baselineFuel + control := .running + { definition := source, values := baselineValues } baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition, values := rewrittenValues } + rewrittenStack } := + .related (fun left right => left = right) (.contents heap) fuel + (StableLiveControlIso.recursiveCall rewrite values stack) + +/-- Isomorphic accepted endpoints likewise retain only future-observable +suspended registers. -/ +theorem StableLiveMachineRel.isomorphicRecursiveCall + {limits : Validate.Limits} {validation : Validate.Context} + {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineValues rewrittenValues : Array RVal} + {baselineStack rewrittenStack : List Continuation} + (iso : IxIR1.Sim.HeapIso rewrittenStore.heap baselineStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (values : IxIR1.Sim.RValsIso + (fun baselineLocation rewrittenLocation => + iso.locRel rewrittenLocation baselineLocation) + baselineValues.toList rewrittenValues.toList) + (stack : StableLiveStackIso limits validation + (fun baselineLocation rewrittenLocation => + iso.locRel rewrittenLocation baselineLocation) + baselineStack rewrittenStack) : + StableLiveMachineRel limits validation + { store := baselineStore + heapFuel := baselineFuel + control := .running + { definition := source, values := baselineValues } baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition, values := rewrittenValues } + rewrittenStack } := + .related + (fun baselineLocation rewrittenLocation => + iso.locRel rewrittenLocation baselineLocation) + (.isomorphic (heapIsoToHistory iso)) fuel + (StableLiveControlIso.recursiveCall rewrite values stack) + +/-- Invert a live-indexed relation whose baseline endpoint has halted. -/ +theorem StableLiveMachineRel.haltedParts {limits : Validate.Limits} + {validation : Validate.Context} + {baselineStore : Store} {baselineFuel : Nat} {baselineValue : RVal} + {rewritten : Machine} + (relation : StableLiveMachineRel limits validation + { store := baselineStore + heapFuel := baselineFuel + control := .halted baselineValue } + rewritten) : + ∃ rewrittenStore rewrittenFuel rewrittenValue locRel, + rewritten = + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .halted rewrittenValue } ∧ + StableHeapRel baselineStore rewrittenStore locRel ∧ + baselineFuel ≤ rewrittenFuel ∧ + IxIR1.Sim.RValIso locRel baselineValue rewrittenValue := by + cases rewritten with + | mk rewrittenStore rewrittenFuel rewrittenControl => + cases relation with + | related locRel heap fuel control => + cases control with + | halted value => + exact ⟨rewrittenStore, rewrittenFuel, _, locRel, rfl, heap, + fuel, value⟩ + +/-- Every old stable machine relation is a strengthening of the new +live-indexed relation. -/ +theorem StableMachineRel.toLive {limits : Validate.Limits} + {validation : Validate.Context} {baseline rewritten : Machine} + (machine : StableMachineRel limits validation baseline rewritten) : + StableLiveMachineRel limits validation baseline rewritten := by + cases baseline with + | mk baselineStore baselineFuel baselineControl => + cases rewritten with + | mk rewrittenStore rewrittenFuel rewrittenControl => + cases machine with + | related locRel heap fuel control => + refine .related locRel heap fuel ?_ + cases control with + | running frame stack => + cases frame with + | rewritten rewrite related => + exact .running (.rewritten rewrite + (StableLiveFrameIso.ofStable related)) + (StableStackIso.toLive stack) + | halted value => exact .halted value + +/-! ## Unchanged call and return boundaries -/ + +/-- An unchanged move observes only its current operand and appends a related +result. -/ +theorem unchangedMoveStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {atom : Atom} {baselineValue : RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = .move atom) + (resolved : Eval.resolveAtom baselineFrame.values atom = .ok baselineValue) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values.push baselineValue } + baselineStack } + ∃ rewrittenValue, + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values.push rewrittenValue } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have instructionAt : block.instructions[baselineFrame.pc]? = + some (.move atom) := by + simpa [instruction] using Array.getElem?_eq_getElem pc + have atomLive := AtomLiveFrom.instruction sourceBlockAt instructionAt + Liveness.InstrUsesAtom.move + obtain ⟨rewrittenValue, targetResolved, valueRelated⟩ := + frame.values.resolveAtom atomLive resolved + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .move atom := by + simpa only [← frame.pc] using instruction + refine ⟨rewrittenValue, + Step.move rfl sourceAt pc instruction resolved, + Step.move rfl targetAt targetPc targetInstruction targetResolved, ?_⟩ + exact StableLiveMachineRel.history heap fuel + (.running (.rewritten rewrite (frame.advancePush valueRelated)) stack) + +/-- Constructor projection follows a related live source location and appends +the corresponding field value. -/ +theorem unchangedFetchStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {atom : Atom} {cid : CtorId} {field : Nat} + {baselineLocation : Nat} {baselineBox : IxIR1.NodeBox} + {baselineFields : Array RVal} {baselineValue : RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .fetch atom cid field) + (resolved : Eval.resolveAtom baselineFrame.values atom = + .ok (.loc baselineLocation)) + (boxAt : baselineStore.get? baselineLocation = some baselineBox) + (node : baselineBox.node = .ctorN cid baselineFields) + (fieldAt : baselineFields[field]? = some baselineValue) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values.push baselineValue } + baselineStack } + ∃ rewrittenValue, + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values.push rewrittenValue } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext ∧ + StableLiveFrameIso rewrite heap.locRel + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values.push baselineValue } + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values.push rewrittenValue } := by + dsimp only + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have instructionAt : block.instructions[baselineFrame.pc]? = + some (.fetch atom cid field) := by + simpa [instruction] using Array.getElem?_eq_getElem pc + have atomLive := AtomLiveFrom.instruction sourceBlockAt instructionAt + Liveness.InstrUsesAtom.fetch + obtain ⟨rewrittenResolved, targetResolved, resolvedRelated⟩ := + frame.values.resolveAtom atomLive resolved + cases resolvedRelated with + | @loc _ rewrittenLocation locations => + obtain ⟨rewrittenBox, rewrittenAt, boxes⟩ := + heap.boxes locations (by + change baselineStore.heap.get? baselineLocation = some baselineBox + exact boxAt) + have nodes : IxIR1.Sim.NodeIso heap.locRel + (.ctorN cid baselineFields) rewrittenBox.node := by + simpa only [← node] using boxes.node + obtain ⟨rewrittenFields, rewrittenNode, fieldsRelated⟩ := + nodeIso_ctor_left nodes + have baselineListAt : baselineFields.toList[field]? = + some baselineValue := by + simpa using fieldAt + obtain ⟨rewrittenValue, rewrittenListAt, valueRelated⟩ := + fieldsRelated.get? baselineListAt + have rewrittenFieldAt : rewrittenFields[field]? = + some rewrittenValue := by + simpa using rewrittenListAt + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .fetch atom cid field := by + simpa only [← frame.pc] using instruction + have nextFrame := frame.advancePush valueRelated + refine ⟨rewrittenValue, + Step.fetch rfl sourceAt pc instruction resolved boxAt node fieldAt, + Step.fetch rfl targetAt targetPc targetInstruction targetResolved + ?_ rewrittenNode rewrittenFieldAt, ?_, nextFrame⟩ + · change rewrittenStore.heap.get? rewrittenLocation = + some rewrittenBox + exact rewrittenAt + · exact StableLiveMachineRel.history heap fuel + (.running (.rewritten rewrite nextFrame) stack) + +/-- Internal lockstep induction for a constructor child's generated fetch +prologue when that child block is preserved literally by the reuse pass. The +successor-frame witness returned by `unchangedFetchStepLiveIso` keeps the same +rewrite and heap history available at every field. -/ +private theorem unchangedFetchPrologueFromLiveIso + {limits : Validate.Limits} {validation : Validate.Context} + {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {atom : Atom} {cid : CtorId} + {baselineLocation : Nat} {baselineBox : IxIR1.NodeBox} + {fields : Array RVal} + (blockAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetDefinitionAt : + rewrite.definition.blocks[baselineFrame.block]? = some block) + (prologue : Lower.fetchPrologueMatches block.instructions atom cid + fields.size = true) + (resolved : Eval.resolveAtom baselineFrame.values atom = + .ok (.loc baselineLocation)) + (boxAt : baselineStore.get? baselineLocation = some baselineBox) + (node : baselineBox.node = .ctorN cid fields) : + ∀ (remaining index : Nat), index + remaining = fields.size → + ∀ {rewrittenFrame : Frame}, + StableLiveFrameIso rewrite heap.locRel + (Lower.Sim.fetchPrefixFrame baselineFrame fields index) + rewrittenFrame → + ∃ rewrittenFinalFrame, + Steps baselineContext interpretation remaining + { store := baselineStore + heapFuel := baselineFuel + control := .running + (Lower.Sim.fetchPrefixFrame baselineFrame fields index) + baselineStack } + { store := baselineStore + heapFuel := baselineFuel + control := .running + (Lower.Sim.fetchPrefixFrame baselineFrame fields + fields.size) + baselineStack } ∧ + Steps rewrittenContext interpretation remaining + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFinalFrame rewrittenStack } ∧ + StableLiveMachineRel limits validation + { store := baselineStore + heapFuel := baselineFuel + control := .running + (Lower.Sim.fetchPrefixFrame baselineFrame fields + fields.size) + baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFinalFrame rewrittenStack } ∧ + StableLiveFrameIso rewrite heap.locRel + (Lower.Sim.fetchPrefixFrame baselineFrame fields fields.size) + rewrittenFinalFrame := by + intro remaining + induction remaining with + | zero => + intro index total rewrittenFrame currentFrame + have indexEq : index = fields.size := by omega + subst index + exact ⟨rewrittenFrame, .refl _, .refl _, + StableLiveMachineRel.history heap fuel + (.running (.rewritten rewrite currentFrame) stack), + currentFrame⟩ + | succ remaining ih => + intro index total rewrittenFrame currentFrame + have indexBound : index < fields.size := by omega + have instructionAt := + Lower.fetchPrologueAt_of_match prologue indexBound + obtain ⟨pcBound, instruction⟩ := + Array.getElem?_eq_some_iff.mp instructionAt + have fieldAt : fields[index]? = some fields[index] := + Array.getElem?_eq_some_iff.mpr ⟨indexBound, rfl⟩ + have currentResolved : + Eval.resolveAtom + (Lower.Sim.fetchPrefixFrame baselineFrame fields index).values + atom = .ok (.loc baselineLocation) := by + simpa [Lower.Sim.fetchPrefixFrame] using + Lower.Sim.resolveAtom_append_old + (suffix := fields.extract 0 index) resolved + have currentBlockAt : + (Lower.Sim.fetchPrefixFrame baselineFrame fields index).definition.blocks[ + (Lower.Sim.fetchPrefixFrame baselineFrame fields index).block]? = + some block := by + simpa [Lower.Sim.fetchPrefixFrame] using blockAt + have currentTargetAt : + rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block := by + rw [currentFrame.rewrittenDefinition, ← currentFrame.block] + simpa [Lower.Sim.fetchPrefixFrame] using targetDefinitionAt + have currentPc : + (Lower.Sim.fetchPrefixFrame baselineFrame fields index).pc < + block.instructions.size := by + simpa [Lower.Sim.fetchPrefixFrame] using pcBound + have currentInstruction : + block.instructions[ + (Lower.Sim.fetchPrefixFrame baselineFrame fields index).pc] = + .fetch atom cid index := by + simpa [Lower.Sim.fetchPrefixFrame] using instruction + obtain ⟨rewrittenValue, baselineStep, rewrittenStep, _headRelated, + nextFrame⟩ := + unchangedFetchStepLiveIso rewrite heap fuel currentFrame stack + currentBlockAt currentTargetAt currentPc currentInstruction + currentResolved boxAt node fieldAt + have extractSucc : fields.extract 0 (index + 1) = + (fields.extract 0 index).push fields[index] := + Array.extract_succ_right (by omega) indexBound + have nextBaselineFrame : + { Lower.Sim.fetchPrefixFrame baselineFrame fields index with + pc := (Lower.Sim.fetchPrefixFrame baselineFrame fields index).pc + 1 + values := + (Lower.Sim.fetchPrefixFrame baselineFrame fields index).values.push + fields[index] } = + Lower.Sim.fetchPrefixFrame baselineFrame fields (index + 1) := by + cases baselineFrame + unfold Lower.Sim.fetchPrefixFrame + rw [extractSucc, Array.push_append] + rw [nextBaselineFrame] at baselineStep nextFrame + obtain ⟨rewrittenFinalFrame, baselineTail, rewrittenTail, finalRelated, + finalFrame⟩ := + ih (index + 1) (by omega) nextFrame + exact ⟨rewrittenFinalFrame, + .cons rfl baselineStep baselineTail, + .cons rfl rewrittenStep rewrittenTail, + finalRelated, finalFrame⟩ + +/-- A complete generated constructor-field prologue stays in lockstep across +an allocation history when its child block is unchanged. Besides the related +endpoint, the theorem returns accepted-entry phase from literal block identity, +so constructor dispatch need not claim phase at an accepted child's internal +post-fetch program counter. -/ +theorem unchangedFetchPrologueStepsLiveIso + {limits : Validate.Limits} {validation : Validate.Context} + {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {atom : Atom} {cid : CtorId} + {baselineLocation : Nat} {baselineBox : IxIR1.NodeBox} + {fields : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (startPc : baselineFrame.pc = 0) + (prologue : Lower.fetchPrologueMatches block.instructions atom cid + fields.size = true) + (resolved : Eval.resolveAtom baselineFrame.values atom = + .ok (.loc baselineLocation)) + (boxAt : baselineStore.get? baselineLocation = some baselineBox) + (node : baselineBox.node = .ctorN cid fields) : + let baselineFinalFrame : Frame := + { baselineFrame with + pc := fields.size + values := baselineFrame.values ++ fields } + ∃ rewrittenFinalFrame, + Steps baselineContext interpretation fields.size + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFinalFrame baselineStack } ∧ + Steps rewrittenContext interpretation fields.size + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFinalFrame rewrittenStack } ∧ + StableLiveMachineRel limits validation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFinalFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFinalFrame rewrittenStack } ∧ + StableLiveAcceptedEntry limits validation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFinalFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFinalFrame rewrittenStack } := by + dsimp only + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have targetDefinitionAt : + rewrite.definition.blocks[baselineFrame.block]? = some block := by + rw [← frame.rewrittenDefinition, frame.block] + exact targetAt + have startFrame : + Lower.Sim.fetchPrefixFrame baselineFrame fields 0 = baselineFrame := by + cases baselineFrame with + | mk definition blockId pc values credits => + dsimp only at startPc ⊢ + subst pc + simp [Lower.Sim.fetchPrefixFrame] + obtain ⟨rewrittenFinalFrame, baselineSteps, rewrittenSteps, related, + finalFrame⟩ := + unchangedFetchPrologueFromLiveIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) + (interpretation := interpretation) rewrite heap fuel stack sourceAt + targetDefinitionAt prologue resolved boxAt node fields.size 0 (by simp) + (rewrittenFrame := rewrittenFrame) (by rw [startFrame]; exact frame) + have finalBaselineFrame : + Lower.Sim.fetchPrefixFrame baselineFrame fields fields.size = + { baselineFrame with + pc := fields.size + values := baselineFrame.values ++ fields } := by + cases baselineFrame + simp [Lower.Sim.fetchPrefixFrame] + rw [startFrame, finalBaselineFrame] at baselineSteps + rw [finalBaselineFrame] at related finalFrame + have rewrittenFinalAt : + rewrittenFinalFrame.definition.blocks[rewrittenFinalFrame.block]? = + some block := by + rw [finalFrame.rewrittenDefinition, ← finalFrame.block] + simpa using targetDefinitionAt + exact ⟨rewrittenFinalFrame, baselineSteps, rewrittenSteps, related, + StableLiveAcceptedEntry.ofSameBlock rfl rfl + (by simpa using sourceAt) rewrittenFinalAt⟩ + +/-- Shallow unique reclamation follows a live source operand and preserves +the history row after killing both corresponding locations. -/ +theorem unchangedFreeUniqueStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {atom : Atom} {cid : CtorId} + {baselineLocation : Nat} {baselineBox : IxIR1.NodeBox} + {baselineFields : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .freeUnique atom cid) + (resolved : Eval.resolveAtom baselineFrame.values atom = + .ok (.loc baselineLocation)) + (boxAt : baselineStore.get? baselineLocation = some baselineBox) + (unique : baselineBox.world = .unique) + (node : baselineBox.node = .ctorN cid baselineFields) + (scalarFields : baselineFields.all RVal.isScalar = true) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with + store := baselineStore.kill baselineLocation + control := .running + { baselineFrame with pc := baselineFrame.pc + 1 } + baselineStack } + ∃ rewrittenLocation, + let rewrittenNext : Machine := + { rewrittenMachine with + store := rewrittenStore.kill rewrittenLocation + control := .running + { rewrittenFrame with pc := rewrittenFrame.pc + 1 } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have instructionAt : block.instructions[baselineFrame.pc]? = + some (.freeUnique atom cid) := by + simpa [instruction] using Array.getElem?_eq_getElem pc + have atomLive := AtomLiveFrom.instruction sourceBlockAt instructionAt + Liveness.InstrUsesAtom.freeUnique + obtain ⟨rewrittenResolved, targetResolved, resolvedRelated⟩ := + frame.values.resolveAtom atomLive resolved + cases resolvedRelated with + | @loc _ rewrittenLocation locations => + obtain ⟨rewrittenBox, rewrittenAt, boxes⟩ := + heap.boxes locations (by + change baselineStore.heap.get? baselineLocation = some baselineBox + exact boxAt) + have nodes : IxIR1.Sim.NodeIso heap.locRel + (.ctorN cid baselineFields) rewrittenBox.node := by + simpa only [← node] using boxes.node + obtain ⟨rewrittenFields, rewrittenNode, fieldsRelated⟩ := + nodeIso_ctor_left nodes + have fieldsEq : baselineFields = rewrittenFields := by + apply Array.toList_inj.mp + apply fieldsRelated.eq_of_allScalar + rw [Array.all_toList] + exact scalarFields + have rewrittenScalar : rewrittenFields.all RVal.isScalar = true := by + rw [← fieldsEq] + exact scalarFields + have rewrittenUnique : rewrittenBox.world = .unique := + boxes.world.symm.trans unique + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .freeUnique atom cid := by + simpa only [← frame.pc] using instruction + let outputHeap : IxIR1.Sim.HeapHistoryIso + (baselineStore.kill baselineLocation).heap + (rewrittenStore.kill rewrittenLocation).heap := + heap.kill locations (by + change baselineStore.heap.get? baselineLocation = some baselineBox + exact boxAt) rewrittenAt + refine ⟨rewrittenLocation, + Step.freeUnique rfl sourceAt pc instruction resolved boxAt unique node + scalarFields, + Step.freeUnique rfl targetAt targetPc targetInstruction targetResolved + ?_ rewrittenUnique rewrittenNode rewrittenScalar, ?_⟩ + · change rewrittenStore.heap.get? rewrittenLocation = some rewrittenBox + exact rewrittenAt + · have outputFrame : StableLiveFrameIso rewrite outputHeap.locRel + { baselineFrame with pc := baselineFrame.pc + 1 } + { rewrittenFrame with pc := rewrittenFrame.pc + 1 } := by + change StableLiveFrameIso rewrite heap.locRel _ _ + exact frame.advance + have outputStack : StableLiveStackIso limits validation + outputHeap.locRel baselineStack rewrittenStack := by + change StableLiveStackIso limits validation heap.locRel _ _ + exact stack + exact StableLiveMachineRel.history outputHeap fuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- Fresh allocation resolves only the constructor's live argument operands, +then extends the heap history and appends the related fresh locations. -/ +theorem unchangedAllocStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + (schemas : baselineContext.schemas = rewrittenContext.schemas) + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {world : Owned} {cid : CtorId} + {arguments : Array Atom} {schema : CtorSchema} + {baselineValues : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .alloc world cid arguments) + (schemaAt : baselineContext.schemas world cid = some schema) + (resolved : Eval.resolveAtoms baselineFrame.values arguments = + .ok baselineValues) + (fieldWorlds : FieldWorlds baselineStore schema baselineValues) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineAllocation := + baselineStore.allocNode world (.ctorN cid baselineValues) + let baselineNext : Machine := + { store := baselineAllocation.1 + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values.push (.loc baselineAllocation.2) } + baselineStack } + ∃ rewrittenValues, + let rewrittenAllocation := + rewrittenStore.allocNode world (.ctorN cid rewrittenValues) + let rewrittenNext : Machine := + { store := rewrittenAllocation.1 + heapFuel := rewrittenFuel + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values.push + (.loc rewrittenAllocation.2) } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have instructionAt : block.instructions[baselineFrame.pc]? = + some (.alloc world cid arguments) := by + simpa [instruction] using Array.getElem?_eq_getElem pc + have argumentsLive : AtomsLiveFrom source baselineFrame.block + baselineFrame.pc arguments := + AtomsLiveFrom.instruction sourceBlockAt instructionAt (by + intro atom member + exact Liveness.InstrUsesAtom.alloc member) + obtain ⟨rewrittenValues, targetResolved, valuesRelated⟩ := + frame.values.resolveAtoms argumentsLive resolved + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .alloc world cid arguments := by + simpa only [← frame.pc] using instruction + have targetSchemaAt : rewrittenContext.schemas world cid = some schema := by + rw [← schemas] + exact schemaAt + have targetFieldWorlds : FieldWorlds rewrittenStore schema rewrittenValues := + fieldWorlds.transport (heapHistoryIso_fieldValuesWorldEq heap valuesRelated) + let baselineAllocation := + baselineStore.allocNode world (.ctorN cid baselineValues) + let rewrittenAllocation := + rewrittenStore.allocNode world (.ctorN cid rewrittenValues) + let outputHeap : IxIR1.Sim.HeapHistoryIso baselineAllocation.1.heap + rewrittenAllocation.1.heap := + heap.alloc (.ctor valuesRelated) + have oldExtends : ∀ {baselineLocation rewrittenLocation}, + heap.locRel baselineLocation rewrittenLocation → + outputHeap.locRel baselineLocation rewrittenLocation := by + intro baselineLocation rewrittenLocation related + exact .inr related + have resultRelated : IxIR1.Sim.RValIso outputHeap.locRel + (.loc baselineAllocation.2) (.loc rewrittenAllocation.2) := by + exact .loc (.inl ⟨rfl, rfl⟩) + have outputFrame := (frame.mono oldExtends).advancePush resultRelated + have outputStack := stack.mono oldExtends + refine ⟨rewrittenValues, + by simpa [baselineAllocation] using + (Step.alloc (context := baselineContext) + (interpretation := interpretation) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction schemaAt resolved fieldWorlds), + by simpa [rewrittenAllocation] using + (Step.alloc (context := rewrittenContext) + (interpretation := interpretation) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetSchemaAt targetResolved + targetFieldWorlds), ?_⟩ + exact StableLiveMachineRel.history outputHeap fuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- An absent `allocWith` credit is consumed after resolving the live +constructor operands; both executions then allocate related fresh nodes. -/ +theorem unchangedAllocWithAbsentStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + (schemas : baselineContext.schemas = rewrittenContext.schemas) + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTaken : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {creditId : CreditId} {credit : Credit} + {world : Owned} {cid : CtorId} {arguments : Array Atom} + {schema : CtorSchema} {baselineValues : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .allocWith creditId world cid arguments) + (schemaAt : baselineContext.schemas world cid = some schema) + (resolved : Eval.resolveAtoms baselineFrame.values arguments = + .ok baselineValues) + (fieldWorlds : FieldWorlds baselineStore schema baselineValues) + (taken : CreditTake { baselineFrame with + pc := baselineFrame.pc + 1 } creditId baselineTaken credit) + (layout : credit.layout = schema.layout) + (absent : credit.presence = .absent) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineAllocation := + baselineStore.allocNode world (.ctorN cid baselineValues) + let baselineNext : Machine := + { store := baselineAllocation.1 + heapFuel := baselineFuel + control := .running + { baselineTaken with + values := baselineTaken.values.push (.loc baselineAllocation.2) } + baselineStack } + ∃ (rewrittenValues : Array RVal) (rewrittenTaken : Frame), + let rewrittenAllocation := + rewrittenStore.allocNode world (.ctorN cid rewrittenValues) + let rewrittenNext : Machine := + { store := rewrittenAllocation.1 + heapFuel := rewrittenFuel + control := .running + { rewrittenTaken with + values := rewrittenTaken.values.push + (.loc rewrittenAllocation.2) } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have instructionAt : block.instructions[baselineFrame.pc]? = + some (.allocWith creditId world cid arguments) := by + simpa [instruction] using Array.getElem?_eq_getElem pc + have argumentsLive : AtomsLiveFrom source baselineFrame.block + baselineFrame.pc arguments := + AtomsLiveFrom.instruction sourceBlockAt instructionAt (by + intro atom member + exact Liveness.InstrUsesAtom.allocWith member) + obtain ⟨rewrittenValues, targetResolved, valuesRelated⟩ := + frame.values.resolveAtoms argumentsLive resolved + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .allocWith creditId world cid arguments := by + simpa only [← frame.pc] using instruction + have targetSchemaAt : rewrittenContext.schemas world cid = some schema := by + rw [← schemas] + exact schemaAt + have targetFieldWorlds : FieldWorlds rewrittenStore schema rewrittenValues := + fieldWorlds.transport (heapHistoryIso_fieldValuesWorldEq heap valuesRelated) + obtain ⟨rewrittenTaken, rewrittenCredit, targetTaken, creditRelated, + takenFrame⟩ := frame.advanceTakeIso taken + obtain ⟨layoutRelated, targetAbsent⟩ := + creditRelated.absent_parts absent + have targetLayout : rewrittenCredit.layout = schema.layout := + layoutRelated.symm.trans layout + let baselineAllocation := + baselineStore.allocNode world (.ctorN cid baselineValues) + let rewrittenAllocation := + rewrittenStore.allocNode world (.ctorN cid rewrittenValues) + let outputHeap : IxIR1.Sim.HeapHistoryIso baselineAllocation.1.heap + rewrittenAllocation.1.heap := + heap.alloc (.ctor valuesRelated) + have oldExtends : ∀ {baselineLocation rewrittenLocation}, + heap.locRel baselineLocation rewrittenLocation → + outputHeap.locRel baselineLocation rewrittenLocation := by + intro baselineLocation rewrittenLocation related + exact .inr related + have resultRelated : IxIR1.Sim.RValIso outputHeap.locRel + (.loc baselineAllocation.2) (.loc rewrittenAllocation.2) := + .loc (.inl ⟨rfl, rfl⟩) + have outputFrame := (takenFrame.mono oldExtends).push resultRelated + have outputStack := stack.mono oldExtends + refine ⟨rewrittenValues, rewrittenTaken, + by simpa [baselineAllocation] using + (Step.allocWithAbsent (context := baselineContext) + (interpretation := interpretation) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction schemaAt resolved fieldWorlds taken layout + absent), + by simpa [rewrittenAllocation] using + (Step.allocWithAbsent (context := rewrittenContext) + (interpretation := interpretation) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetSchemaAt targetResolved + targetFieldWorlds targetTaken targetLayout targetAbsent), ?_⟩ + exact StableLiveMachineRel.history outputHeap fuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- A logical `allocWith` credit is consumed after resolving the live +constructor operands; both executions allocate related fresh nodes. -/ +theorem unchangedAllocWithLogicalStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + (schemas : baselineContext.schemas = rewrittenContext.schemas) + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTaken : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {creditId : CreditId} {credit : Credit} + {world : Owned} {cid : CtorId} {arguments : Array Atom} + {schema : CtorSchema} {baselineValues : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .allocWith creditId world cid arguments) + (schemaAt : baselineContext.schemas world cid = some schema) + (resolved : Eval.resolveAtoms baselineFrame.values arguments = + .ok baselineValues) + (fieldWorlds : FieldWorlds baselineStore schema baselineValues) + (taken : CreditTake { baselineFrame with + pc := baselineFrame.pc + 1 } creditId baselineTaken credit) + (layout : credit.layout = schema.layout) + (present : credit.presence = .present none) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineAllocation := + baselineStore.allocNode world (.ctorN cid baselineValues) + let baselineNext : Machine := + { store := baselineAllocation.1 + heapFuel := baselineFuel + control := .running + { baselineTaken with + values := baselineTaken.values.push (.loc baselineAllocation.2) } + baselineStack } + ∃ (rewrittenValues : Array RVal) (rewrittenTaken : Frame), + let rewrittenAllocation := + rewrittenStore.allocNode world (.ctorN cid rewrittenValues) + let rewrittenNext : Machine := + { store := rewrittenAllocation.1 + heapFuel := rewrittenFuel + control := .running + { rewrittenTaken with + values := rewrittenTaken.values.push + (.loc rewrittenAllocation.2) } + rewrittenStack } + Step baselineContext .logical baselineMachine baselineNext ∧ + Step rewrittenContext .logical rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have instructionAt : block.instructions[baselineFrame.pc]? = + some (.allocWith creditId world cid arguments) := by + simpa [instruction] using Array.getElem?_eq_getElem pc + have argumentsLive : AtomsLiveFrom source baselineFrame.block + baselineFrame.pc arguments := + AtomsLiveFrom.instruction sourceBlockAt instructionAt (by + intro atom member + exact Liveness.InstrUsesAtom.allocWith member) + obtain ⟨rewrittenValues, targetResolved, valuesRelated⟩ := + frame.values.resolveAtoms argumentsLive resolved + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .allocWith creditId world cid arguments := by + simpa only [← frame.pc] using instruction + have targetSchemaAt : rewrittenContext.schemas world cid = some schema := by + rw [← schemas] + exact schemaAt + have targetFieldWorlds : FieldWorlds rewrittenStore schema rewrittenValues := + fieldWorlds.transport (heapHistoryIso_fieldValuesWorldEq heap valuesRelated) + obtain ⟨rewrittenTaken, rewrittenCredit, targetTaken, creditRelated, + takenFrame⟩ := frame.advanceTakeIso taken + obtain ⟨layoutRelated, targetPresent⟩ := + creditRelated.logical_parts present + have targetLayout : rewrittenCredit.layout = schema.layout := + layoutRelated.symm.trans layout + let baselineAllocation := + baselineStore.allocNode world (.ctorN cid baselineValues) + let rewrittenAllocation := + rewrittenStore.allocNode world (.ctorN cid rewrittenValues) + let outputHeap : IxIR1.Sim.HeapHistoryIso baselineAllocation.1.heap + rewrittenAllocation.1.heap := + heap.alloc (.ctor valuesRelated) + have oldExtends : ∀ {baselineLocation rewrittenLocation}, + heap.locRel baselineLocation rewrittenLocation → + outputHeap.locRel baselineLocation rewrittenLocation := by + intro baselineLocation rewrittenLocation related + exact .inr related + have resultRelated : IxIR1.Sim.RValIso outputHeap.locRel + (.loc baselineAllocation.2) (.loc rewrittenAllocation.2) := + .loc (.inl ⟨rfl, rfl⟩) + have outputFrame := (takenFrame.mono oldExtends).push resultRelated + have outputStack := stack.mono oldExtends + refine ⟨rewrittenValues, rewrittenTaken, + by simpa [baselineAllocation] using + (Step.allocWithLogical (context := baselineContext) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction schemaAt resolved fieldWorlds taken layout + present), + by simpa [rewrittenAllocation] using + (Step.allocWithLogical (context := rewrittenContext) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetSchemaAt targetResolved + targetFieldWorlds targetTaken targetLayout targetPresent), ?_⟩ + exact StableLiveMachineRel.history outputHeap fuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- Physical `allocWith` resolves its live operands, consumes corresponding +reservations, and revives their history row with related constructor nodes. -/ +theorem unchangedAllocWithPhysicalStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + (schemas : baselineContext.schemas = rewrittenContext.schemas) + {baselineStore rewrittenStore baselineOut : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTaken : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {creditId : CreditId} {credit : Credit} + {world : Owned} {cid : CtorId} {arguments : Array Atom} + {schema : CtorSchema} {baselineValues : Array RVal} + {baselineLocation : Nat} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .allocWith creditId world cid arguments) + (schemaAt : baselineContext.schemas world cid = some schema) + (resolved : Eval.resolveAtoms baselineFrame.values arguments = + .ok baselineValues) + (fieldWorlds : FieldWorlds baselineStore schema baselineValues) + (taken : CreditTake { baselineFrame with + pc := baselineFrame.pc + 1 } creditId baselineTaken credit) + (layout : credit.layout = schema.layout) + (present : credit.presence = .present (some baselineLocation)) + (reused : baselineStore.reuseReservation baselineLocation world + (.ctorN cid baselineValues) schema.fields.size = .ok baselineOut) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { store := baselineOut + heapFuel := baselineFuel + control := .running + { baselineTaken with + values := baselineTaken.values.push (.loc baselineLocation) } + baselineStack } + ∃ (rewrittenValues : Array RVal) (rewrittenTaken : Frame) + (rewrittenLocation : Nat) (rewrittenOut : Store), + let rewrittenNext : Machine := + { store := rewrittenOut + heapFuel := rewrittenFuel + control := .running + { rewrittenTaken with + values := rewrittenTaken.values.push (.loc rewrittenLocation) } + rewrittenStack } + rewrittenStore.reuseReservation rewrittenLocation world + (.ctorN cid rewrittenValues) schema.fields.size = .ok rewrittenOut ∧ + Step baselineContext .physical baselineMachine baselineNext ∧ + Step rewrittenContext .physical rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have instructionAt : block.instructions[baselineFrame.pc]? = + some (.allocWith creditId world cid arguments) := by + simpa [instruction] using Array.getElem?_eq_getElem pc + have argumentsLive : AtomsLiveFrom source baselineFrame.block + baselineFrame.pc arguments := + AtomsLiveFrom.instruction sourceBlockAt instructionAt (by + intro atom member + exact Liveness.InstrUsesAtom.allocWith member) + obtain ⟨rewrittenValues, targetResolved, valuesRelated⟩ := + frame.values.resolveAtoms argumentsLive resolved + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .allocWith creditId world cid arguments := by + simpa only [← frame.pc] using instruction + have targetSchemaAt : rewrittenContext.schemas world cid = some schema := by + rw [← schemas] + exact schemaAt + have targetFieldWorlds : FieldWorlds rewrittenStore schema rewrittenValues := + fieldWorlds.transport (heapHistoryIso_fieldValuesWorldEq heap valuesRelated) + obtain ⟨rewrittenTaken, rewrittenCredit, targetTaken, creditRelated, + takenFrame⟩ := frame.advanceTakeIso taken + obtain ⟨rewrittenLocation, layoutRelated, targetPresent, locations⟩ := + creditRelated.physical_parts present + have targetLayout : rewrittenCredit.layout = schema.layout := + layoutRelated.symm.trans layout + obtain ⟨rewrittenOut, outputHeap, targetReused, outputRelation⟩ := + reuseReservation_historyIso heap locations (.ctor valuesRelated) reused + have outputFrame : StableLiveFrameIso rewrite outputHeap.locRel + { baselineTaken with + values := baselineTaken.values.push (.loc baselineLocation) } + { rewrittenTaken with + values := rewrittenTaken.values.push (.loc rewrittenLocation) } := by + rw [outputRelation] + exact takenFrame.push (.loc locations) + have outputStack : StableLiveStackIso limits validation outputHeap.locRel + baselineStack rewrittenStack := by + rw [outputRelation] + exact stack + refine ⟨rewrittenValues, rewrittenTaken, rewrittenLocation, rewrittenOut, + targetReused, + Step.allocWithPhysical + (context := baselineContext) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction schemaAt resolved fieldWorlds taken layout + present reused, + Step.allocWithPhysical + (context := rewrittenContext) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetSchemaAt targetResolved + targetFieldWorlds targetTaken targetLayout targetPresent targetReused, + ?_⟩ + exact StableLiveMachineRel.history outputHeap fuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- Logical unique extraction follows its live constructor root, kills both +locations, and appends related fields with matching logical credits. -/ +theorem unchangedTakeUniqueLogicalStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + (schemas : baselineContext.schemas = rewrittenContext.schemas) + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {target : Atom} {cid : CtorId} + {schema : CtorSchema} {baselineLocation : Nat} + {baselineBox : IxIR1.NodeBox} {baselineFields : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .takeUnique target cid) + (schemaAt : baselineContext.schemas .unique cid = some schema) + (resolved : Eval.resolveAtom baselineFrame.values target = + .ok (.loc baselineLocation)) + (viewed : ConstructorView baselineStore baselineLocation .unique cid + baselineBox baselineFields) + (unitRC : baselineBox.rc = 1) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let credit : Credit := + { layout := schema.layout, presence := .present none } + let baselineNext : Machine := + { store := baselineStore.kill baselineLocation + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values ++ baselineFields + credits := baselineFrame.credits.push (some credit) } + baselineStack } + ∃ (rewrittenLocation : Nat) (rewrittenFields : Array RVal), + let rewrittenNext : Machine := + { store := rewrittenStore.kill rewrittenLocation + heapFuel := rewrittenFuel + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values ++ rewrittenFields + credits := rewrittenFrame.credits.push (some credit) } + rewrittenStack } + Step baselineContext .logical baselineMachine baselineNext ∧ + Step rewrittenContext .logical rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have instructionAt : block.instructions[baselineFrame.pc]? = + some (.takeUnique target cid) := by + simpa [instruction] using Array.getElem?_eq_getElem pc + have targetLive := AtomLiveFrom.instruction sourceBlockAt instructionAt + Liveness.InstrUsesAtom.takeUnique + obtain ⟨rewrittenResolved, targetResolved, resolvedRelated⟩ := + frame.values.resolveAtom targetLive resolved + cases resolvedRelated with + | @loc _ rewrittenLocation locations => + obtain ⟨baselineAt, baselineWorld, baselineNode⟩ := viewed.parts + obtain ⟨rewrittenBox, rewrittenAt, boxes⟩ := + heap.boxes locations (by + change baselineStore.heap.get? baselineLocation = some baselineBox + exact baselineAt) + have nodes : IxIR1.Sim.NodeIso heap.locRel + (.ctorN cid baselineFields) rewrittenBox.node := by + simpa only [← baselineNode] using boxes.node + obtain ⟨rewrittenFields, rewrittenNode, fieldsRelated⟩ := + nodeIso_ctor_left nodes + have rewrittenWorld : rewrittenBox.world = .unique := + boxes.world.symm.trans baselineWorld + have rewrittenRc : rewrittenBox.rc = 1 := + boxes.rc.symm.trans unitRC + have targetViewed : ConstructorView rewrittenStore rewrittenLocation + .unique cid rewrittenBox rewrittenFields := by + apply ConstructorView.of_box + · change rewrittenStore.heap.get? rewrittenLocation = some rewrittenBox + exact rewrittenAt + · exact rewrittenWorld + · exact rewrittenNode + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .takeUnique target cid := by + simpa only [← frame.pc] using instruction + have targetSchemaAt : rewrittenContext.schemas .unique cid = + some schema := by + rw [← schemas] + exact schemaAt + let outputHeap := heap.kill locations (by + change baselineStore.heap.get? baselineLocation = some baselineBox + exact baselineAt) rewrittenAt + have outputFrame : StableLiveFrameIso rewrite outputHeap.locRel + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values ++ baselineFields + credits := baselineFrame.credits.push + (some { layout := schema.layout, presence := .present none }) } + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values ++ rewrittenFields + credits := rewrittenFrame.credits.push + (some { layout := schema.layout, presence := .present none }) } := by + change StableLiveFrameIso rewrite heap.locRel _ _ + exact frame.advanceAppendCreditIso fieldsRelated + (.logical schema.layout) + have outputStack : StableLiveStackIso limits validation + outputHeap.locRel baselineStack rewrittenStack := by + change StableLiveStackIso limits validation heap.locRel _ _ + exact stack + refine ⟨rewrittenLocation, rewrittenFields, + Step.takeUniqueLogical + (context := baselineContext) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction schemaAt resolved viewed unitRC, + Step.takeUniqueLogical + (context := rewrittenContext) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetSchemaAt targetResolved + targetViewed rewrittenRc, ?_⟩ + exact StableLiveMachineRel.history outputHeap fuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- Physical unique extraction follows its live constructor root, reserves +both locations, and appends related fields with physical credits. -/ +theorem unchangedTakeUniquePhysicalStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + (schemas : baselineContext.schemas = rewrittenContext.schemas) + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {target : Atom} {cid : CtorId} + {schema : CtorSchema} {baselineLocation : Nat} + {baselineBox : IxIR1.NodeBox} {baselineFields : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .takeUnique target cid) + (schemaAt : baselineContext.schemas .unique cid = some schema) + (resolved : Eval.resolveAtom baselineFrame.values target = + .ok (.loc baselineLocation)) + (viewed : ConstructorView baselineStore baselineLocation .unique cid + baselineBox baselineFields) + (unitRC : baselineBox.rc = 1) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineCredit : Credit := + { layout := schema.layout, + presence := .present (some baselineLocation) } + let baselineNext : Machine := + { store := baselineStore.reserve baselineLocation + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values ++ baselineFields + credits := baselineFrame.credits.push (some baselineCredit) } + baselineStack } + ∃ (rewrittenLocation : Nat) (rewrittenFields : Array RVal), + let rewrittenCredit : Credit := + { layout := schema.layout, + presence := .present (some rewrittenLocation) } + let rewrittenNext : Machine := + { store := rewrittenStore.reserve rewrittenLocation + heapFuel := rewrittenFuel + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values ++ rewrittenFields + credits := rewrittenFrame.credits.push (some rewrittenCredit) } + rewrittenStack } + Step baselineContext .physical baselineMachine baselineNext ∧ + Step rewrittenContext .physical rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have instructionAt : block.instructions[baselineFrame.pc]? = + some (.takeUnique target cid) := by + simpa [instruction] using Array.getElem?_eq_getElem pc + have targetLive := AtomLiveFrom.instruction sourceBlockAt instructionAt + Liveness.InstrUsesAtom.takeUnique + obtain ⟨rewrittenResolved, targetResolved, resolvedRelated⟩ := + frame.values.resolveAtom targetLive resolved + cases resolvedRelated with + | @loc _ rewrittenLocation locations => + obtain ⟨baselineAt, baselineWorld, baselineNode⟩ := viewed.parts + obtain ⟨rewrittenBox, rewrittenAt, boxes⟩ := + heap.boxes locations (by + change baselineStore.heap.get? baselineLocation = some baselineBox + exact baselineAt) + have nodes : IxIR1.Sim.NodeIso heap.locRel + (.ctorN cid baselineFields) rewrittenBox.node := by + simpa only [← baselineNode] using boxes.node + obtain ⟨rewrittenFields, rewrittenNode, fieldsRelated⟩ := + nodeIso_ctor_left nodes + have rewrittenWorld : rewrittenBox.world = .unique := + boxes.world.symm.trans baselineWorld + have rewrittenRc : rewrittenBox.rc = 1 := + boxes.rc.symm.trans unitRC + have targetViewed : ConstructorView rewrittenStore rewrittenLocation + .unique cid rewrittenBox rewrittenFields := by + apply ConstructorView.of_box + · change rewrittenStore.heap.get? rewrittenLocation = some rewrittenBox + exact rewrittenAt + · exact rewrittenWorld + · exact rewrittenNode + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .takeUnique target cid := by + simpa only [← frame.pc] using instruction + have targetSchemaAt : rewrittenContext.schemas .unique cid = + some schema := by + rw [← schemas] + exact schemaAt + let outputHeap := reserve_historyIso heap locations (by + change baselineStore.heap.get? baselineLocation = some baselineBox + exact baselineAt) rewrittenAt + have outputFrame : StableLiveFrameIso rewrite outputHeap.locRel + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values ++ baselineFields + credits := baselineFrame.credits.push + (some { layout := schema.layout, presence := + .present (some baselineLocation) }) } + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values ++ rewrittenFields + credits := rewrittenFrame.credits.push + (some { layout := schema.layout, presence := + .present (some rewrittenLocation) }) } := by + change StableLiveFrameIso rewrite heap.locRel _ _ + exact frame.advanceAppendCreditIso fieldsRelated + (.physical locations) + have outputStack : StableLiveStackIso limits validation + outputHeap.locRel baselineStack rewrittenStack := by + change StableLiveStackIso limits validation heap.locRel _ _ + exact stack + refine ⟨rewrittenLocation, rewrittenFields, + Step.takeUniquePhysical + (context := baselineContext) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction schemaAt resolved viewed unitRC, + Step.takeUniquePhysical + (context := rewrittenContext) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetSchemaAt targetResolved + targetViewed rewrittenRc, ?_⟩ + exact StableLiveMachineRel.history outputHeap fuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- A logical hot shared reset follows its live unit-refcount root, kills both +locations, and appends related fields with logical credits. -/ +theorem unchangedResetSharedLogicalHotStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + (schemas : baselineContext.schemas = rewrittenContext.schemas) + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {target : Atom} {cid : CtorId} + {schema : CtorSchema} {baselineLocation : Nat} + {baselineBox : IxIR1.NodeBox} {baselineFields : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .resetShared target cid) + (schemaAt : baselineContext.schemas .shared cid = some schema) + (resolved : Eval.resolveAtom baselineFrame.values target = + .ok (.loc baselineLocation)) + (viewed : ConstructorView baselineStore baselineLocation .shared cid + baselineBox baselineFields) + (unitRC : baselineBox.rc = 1) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let credit : Credit := + { layout := schema.layout, presence := .present none } + let baselineNext : Machine := + { store := ((baselineStore.tickResetAttempt).kill + baselineLocation).tickHotReset + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values ++ baselineFields + credits := baselineFrame.credits.push (some credit) } + baselineStack } + ∃ (rewrittenLocation : Nat) (rewrittenFields : Array RVal), + let rewrittenNext : Machine := + { store := ((rewrittenStore.tickResetAttempt).kill + rewrittenLocation).tickHotReset + heapFuel := rewrittenFuel + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values ++ rewrittenFields + credits := rewrittenFrame.credits.push (some credit) } + rewrittenStack } + Step baselineContext .logical baselineMachine baselineNext ∧ + Step rewrittenContext .logical rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have instructionAt : block.instructions[baselineFrame.pc]? = + some (.resetShared target cid) := by + simpa [instruction] using Array.getElem?_eq_getElem pc + have targetLive := AtomLiveFrom.instruction sourceBlockAt instructionAt + Liveness.InstrUsesAtom.resetShared + obtain ⟨rewrittenResolved, targetResolved, resolvedRelated⟩ := + frame.values.resolveAtom targetLive resolved + cases resolvedRelated with + | @loc _ rewrittenLocation locations => + obtain ⟨rewrittenBox, rewrittenFields, rewrittenAt, targetViewed, + boxes, fieldsRelated⟩ := + constructorView_historyIso heap locations viewed + obtain ⟨baselineAt, _, _⟩ := viewed.parts + have rewrittenRc : rewrittenBox.rc = 1 := + boxes.rc.symm.trans unitRC + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .resetShared target cid := by + simpa only [← frame.pc] using instruction + have targetSchemaAt : rewrittenContext.schemas .shared cid = + some schema := by + rw [← schemas] + exact schemaAt + let killed := heap.kill locations (by + change baselineStore.heap.get? baselineLocation = some baselineBox + exact baselineAt) (by + change rewrittenStore.heap.get? rewrittenLocation = some rewrittenBox + exact rewrittenAt) + let outputHeap : IxIR1.Sim.HeapHistoryIso + (((baselineStore.tickResetAttempt).kill + baselineLocation).tickHotReset).heap + (((rewrittenStore.tickResetAttempt).kill + rewrittenLocation).tickHotReset).heap := by + simpa [Eval.Store.tickResetAttempt, Eval.Store.tickHotReset] using killed + have outputFrame : StableLiveFrameIso rewrite outputHeap.locRel + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values ++ baselineFields + credits := baselineFrame.credits.push + (some { layout := schema.layout, presence := .present none }) } + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values ++ rewrittenFields + credits := rewrittenFrame.credits.push + (some { layout := schema.layout, presence := .present none }) } := by + change StableLiveFrameIso rewrite heap.locRel _ _ + exact frame.advanceAppendCreditIso fieldsRelated + (.logical schema.layout) + have outputStack : StableLiveStackIso limits validation + outputHeap.locRel baselineStack rewrittenStack := by + change StableLiveStackIso limits validation heap.locRel _ _ + exact stack + refine ⟨rewrittenLocation, rewrittenFields, + Step.resetSharedLogicalHot + (context := baselineContext) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction schemaAt resolved viewed unitRC, + Step.resetSharedLogicalHot + (context := rewrittenContext) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetSchemaAt targetResolved + targetViewed rewrittenRc, ?_⟩ + exact StableLiveMachineRel.history outputHeap fuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- A physical hot shared reset follows its live unit-refcount root, reserves +both locations, and appends related fields with physical credits. -/ +theorem unchangedResetSharedPhysicalHotStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + (schemas : baselineContext.schemas = rewrittenContext.schemas) + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {target : Atom} {cid : CtorId} + {schema : CtorSchema} {baselineLocation : Nat} + {baselineBox : IxIR1.NodeBox} {baselineFields : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .resetShared target cid) + (schemaAt : baselineContext.schemas .shared cid = some schema) + (resolved : Eval.resolveAtom baselineFrame.values target = + .ok (.loc baselineLocation)) + (viewed : ConstructorView baselineStore baselineLocation .shared cid + baselineBox baselineFields) + (unitRC : baselineBox.rc = 1) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineCredit : Credit := + { layout := schema.layout, + presence := .present (some baselineLocation) } + let baselineNext : Machine := + { store := ((baselineStore.tickResetAttempt).reserve + baselineLocation).tickHotReset + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values ++ baselineFields + credits := baselineFrame.credits.push (some baselineCredit) } + baselineStack } + ∃ (rewrittenLocation : Nat) (rewrittenFields : Array RVal), + let rewrittenCredit : Credit := + { layout := schema.layout, + presence := .present (some rewrittenLocation) } + let rewrittenNext : Machine := + { store := ((rewrittenStore.tickResetAttempt).reserve + rewrittenLocation).tickHotReset + heapFuel := rewrittenFuel + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values ++ rewrittenFields + credits := rewrittenFrame.credits.push (some rewrittenCredit) } + rewrittenStack } + Step baselineContext .physical baselineMachine baselineNext ∧ + Step rewrittenContext .physical rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have instructionAt : block.instructions[baselineFrame.pc]? = + some (.resetShared target cid) := by + simpa [instruction] using Array.getElem?_eq_getElem pc + have targetLive := AtomLiveFrom.instruction sourceBlockAt instructionAt + Liveness.InstrUsesAtom.resetShared + obtain ⟨rewrittenResolved, targetResolved, resolvedRelated⟩ := + frame.values.resolveAtom targetLive resolved + cases resolvedRelated with + | @loc _ rewrittenLocation locations => + obtain ⟨rewrittenBox, rewrittenFields, rewrittenAt, targetViewed, + boxes, fieldsRelated⟩ := + constructorView_historyIso heap locations viewed + obtain ⟨baselineAt, _, _⟩ := viewed.parts + have rewrittenRc : rewrittenBox.rc = 1 := + boxes.rc.symm.trans unitRC + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .resetShared target cid := by + simpa only [← frame.pc] using instruction + have targetSchemaAt : rewrittenContext.schemas .shared cid = + some schema := by + rw [← schemas] + exact schemaAt + let reserved := reserve_historyIso + (left := baselineStore.tickResetAttempt) + (right := rewrittenStore.tickResetAttempt) heap locations (by + simpa [Eval.Store.tickResetAttempt, Eval.Store.get?] using + baselineAt) (by + simpa [Eval.Store.tickResetAttempt, Eval.Store.get?] using + rewrittenAt) + let outputHeap : IxIR1.Sim.HeapHistoryIso + (((baselineStore.tickResetAttempt).reserve + baselineLocation).tickHotReset).heap + (((rewrittenStore.tickResetAttempt).reserve + rewrittenLocation).tickHotReset).heap := by + simpa [Eval.Store.tickHotReset] using reserved + have outputFrame : StableLiveFrameIso rewrite outputHeap.locRel + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values ++ baselineFields + credits := baselineFrame.credits.push + (some { layout := schema.layout, presence := + .present (some baselineLocation) }) } + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values ++ rewrittenFields + credits := rewrittenFrame.credits.push + (some { layout := schema.layout, presence := + .present (some rewrittenLocation) }) } := by + change StableLiveFrameIso rewrite heap.locRel _ _ + exact frame.advanceAppendCreditIso fieldsRelated + (.physical locations) + have outputStack : StableLiveStackIso limits validation + outputHeap.locRel baselineStack rewrittenStack := by + change StableLiveStackIso limits validation heap.locRel _ _ + exact stack + refine ⟨rewrittenLocation, rewrittenFields, + Step.resetSharedPhysicalHot + (context := baselineContext) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction schemaAt resolved viewed unitRC, + Step.resetSharedPhysicalHot + (context := rewrittenContext) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetSchemaAt targetResolved + targetViewed rewrittenRc, ?_⟩ + exact StableLiveMachineRel.history outputHeap fuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- A cold shared reset follows its live shared root, transports the parent +decrement and field-retain loop, and appends an absent credit. -/ +theorem unchangedResetSharedColdStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + (schemas : baselineContext.schemas = rewrittenContext.schemas) + {baselineStore rewrittenStore baselineOut : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {target : Atom} {cid : CtorId} + {schema : CtorSchema} {baselineLocation : Nat} + {baselineBox : IxIR1.NodeBox} {baselineFields : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .resetShared target cid) + (schemaAt : baselineContext.schemas .shared cid = some schema) + (resolved : Eval.resolveAtom baselineFrame.values target = + .ok (.loc baselineLocation)) + (viewed : ConstructorView baselineStore baselineLocation .shared cid + baselineBox baselineFields) + (shared : 1 < baselineBox.rc) + (retained : RetainSharedMany + ((((baselineStore.tickResetAttempt).setBox baselineLocation + { baselineBox with rc := baselineBox.rc - 1 }).rcTick).tickColdReset) + baselineFields baselineOut) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let credit : Credit := + { layout := schema.layout, presence := .absent } + let baselineNext : Machine := + { store := baselineOut + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values ++ baselineFields + credits := baselineFrame.credits.push (some credit) } + baselineStack } + ∃ (rewrittenFields : Array RVal) (rewrittenOut : Store), + let rewrittenNext : Machine := + { store := rewrittenOut + heapFuel := rewrittenFuel + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values ++ rewrittenFields + credits := rewrittenFrame.credits.push (some credit) } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have instructionAt : block.instructions[baselineFrame.pc]? = + some (.resetShared target cid) := by + simpa [instruction] using Array.getElem?_eq_getElem pc + have targetLive := AtomLiveFrom.instruction sourceBlockAt instructionAt + Liveness.InstrUsesAtom.resetShared + obtain ⟨rewrittenResolved, targetResolved, resolvedRelated⟩ := + frame.values.resolveAtom targetLive resolved + cases resolvedRelated with + | @loc _ rewrittenLocation locations => + obtain ⟨rewrittenBox, rewrittenFields, rewrittenAt, targetViewed, + boxes, fieldsRelated⟩ := + constructorView_historyIso heap locations viewed + obtain ⟨baselineAt, _, _⟩ := viewed.parts + have rewrittenShared : 1 < rewrittenBox.rc := by + rw [← boxes.rc] + exact shared + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .resetShared target cid := by + simpa only [← frame.pc] using instruction + have targetSchemaAt : rewrittenContext.schemas .shared cid = + some schema := by + rw [← schemas] + exact schemaAt + let updated := heap.setBox locations (by + change baselineStore.heap.get? baselineLocation = some baselineBox + exact baselineAt) (by + change rewrittenStore.heap.get? rewrittenLocation = some rewrittenBox + exact rewrittenAt) + (show IxIR1.Sim.NodeBoxIso heap.locRel + { baselineBox with rc := baselineBox.rc - 1 } + { rewrittenBox with rc := rewrittenBox.rc - 1 } from + ⟨boxes.world, congrArg (fun rc => rc - 1) boxes.rc, boxes.node⟩) + let beforeHistory : IxIR1.Sim.HeapHistoryIso + ((((baselineStore.tickResetAttempt).setBox baselineLocation + { baselineBox with rc := baselineBox.rc - 1 }).rcTick).tickColdReset).heap + ((((rewrittenStore.tickResetAttempt).setBox rewrittenLocation + { rewrittenBox with rc := rewrittenBox.rc - 1 }).rcTick).tickColdReset).heap := by + simpa [Eval.Store.tickResetAttempt, Eval.Store.tickColdReset] using + updated.rcTick + have retainedFields : IxIR1.Sim.RValsIso beforeHistory.locRel + baselineFields.toList rewrittenFields.toList := by + change IxIR1.Sim.RValsIso heap.locRel _ _ + exact fieldsRelated + obtain ⟨rewrittenOut, outputHeap, targetRetained, outputRelation⟩ := + retainSharedMany_historyIso beforeHistory retainedFields retained + have outputFrame : StableLiveFrameIso rewrite outputHeap.locRel + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values ++ baselineFields + credits := baselineFrame.credits.push + (some { layout := schema.layout, presence := .absent }) } + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values ++ rewrittenFields + credits := rewrittenFrame.credits.push + (some { layout := schema.layout, presence := .absent }) } := by + rw [outputRelation] + change StableLiveFrameIso rewrite heap.locRel _ _ + exact frame.advanceAppendCreditIso fieldsRelated + (.absent schema.layout) + have outputStack : StableLiveStackIso limits validation + outputHeap.locRel baselineStack rewrittenStack := by + rw [outputRelation] + change StableLiveStackIso limits validation beforeHistory.locRel _ _ + change StableLiveStackIso limits validation heap.locRel _ _ + exact stack + refine ⟨rewrittenFields, rewrittenOut, + Step.resetSharedCold + (context := baselineContext) (interpretation := interpretation) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction schemaAt resolved viewed shared retained, + Step.resetSharedCold + (context := rewrittenContext) (interpretation := interpretation) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetSchemaAt targetResolved + targetViewed rewrittenShared targetRetained, ?_⟩ + exact StableLiveMachineRel.history outputHeap fuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- Shared retain resolves its live operand, updates corresponding refcounts, +and appends the related values. -/ +theorem unchangedRetainSharedStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore baselineOut : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {atom : Atom} {baselineValue : RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .retainShared atom) + (resolved : Eval.resolveAtom baselineFrame.values atom = .ok baselineValue) + (retained : retainShared baselineStore baselineValue = .ok baselineOut) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { store := baselineOut + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values.push baselineValue } + baselineStack } + ∃ rewrittenValue rewrittenOut, + let rewrittenNext : Machine := + { store := rewrittenOut + heapFuel := rewrittenFuel + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values.push rewrittenValue } + rewrittenStack } + retainShared rewrittenStore rewrittenValue = .ok rewrittenOut ∧ + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have instructionAt : block.instructions[baselineFrame.pc]? = + some (.retainShared atom) := by + simpa [instruction] using Array.getElem?_eq_getElem pc + have atomLive := AtomLiveFrom.instruction sourceBlockAt instructionAt + Liveness.InstrUsesAtom.retainShared + obtain ⟨rewrittenValue, targetResolved, valueRelated⟩ := + frame.values.resolveAtom atomLive resolved + obtain ⟨rewrittenOut, outputHeap, targetRetained, outputRelation⟩ := + retainShared_historyIso heap valueRelated retained + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .retainShared atom := by + simpa only [← frame.pc] using instruction + have outputFrame : StableLiveFrameIso rewrite outputHeap.locRel + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values.push baselineValue } + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values.push rewrittenValue } := by + rw [outputRelation] + exact frame.advancePush valueRelated + have outputStack : StableLiveStackIso limits validation outputHeap.locRel + baselineStack rewrittenStack := by + rw [outputRelation] + exact stack + refine ⟨rewrittenValue, rewrittenOut, targetRetained, + Step.retainShared rfl sourceAt pc instruction resolved retained, + Step.retainShared rfl targetAt targetPc targetInstruction targetResolved + targetRetained, ?_⟩ + exact StableLiveMachineRel.history outputHeap fuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- Deep shared release follows the graph rooted at its live operand and +preserves the target's traversal-fuel advantage. -/ +theorem unchangedReleaseSharedStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore baselineOut : Store} + {baselineFuel rewrittenFuel baselineRemaining : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {atom : Atom} {baselineValue : RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .releaseShared atom) + (resolved : Eval.resolveAtom baselineFrame.values atom = .ok baselineValue) + (released : releaseShared baselineFuel baselineStore baselineValue = + .ok (baselineOut, baselineRemaining)) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { store := baselineOut + heapFuel := baselineRemaining + control := .running + { baselineFrame with pc := baselineFrame.pc + 1 } + baselineStack } + ∃ rewrittenValue rewrittenOut rewrittenRemaining, + let rewrittenNext : Machine := + { store := rewrittenOut + heapFuel := rewrittenRemaining + control := .running + { rewrittenFrame with pc := rewrittenFrame.pc + 1 } + rewrittenStack } + releaseShared rewrittenFuel rewrittenStore rewrittenValue = + .ok (rewrittenOut, rewrittenRemaining) ∧ + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have instructionAt : block.instructions[baselineFrame.pc]? = + some (.releaseShared atom) := by + simpa [instruction] using Array.getElem?_eq_getElem pc + have atomLive := AtomLiveFrom.instruction sourceBlockAt instructionAt + Liveness.InstrUsesAtom.releaseShared + obtain ⟨rewrittenValue, targetResolved, valueRelated⟩ := + frame.values.resolveAtom atomLive resolved + obtain ⟨rewrittenOut, rewrittenRemaining, outputHeap, targetReleased, + outputFuel, outputRelation⟩ := + releaseSharedWork_historyIso heap fuel + (.cons valueRelated .nil) (by + unfold releaseShared at released + exact released) + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .releaseShared atom := by + simpa only [← frame.pc] using instruction + have outputFrame : StableLiveFrameIso rewrite outputHeap.locRel + { baselineFrame with pc := baselineFrame.pc + 1 } + { rewrittenFrame with pc := rewrittenFrame.pc + 1 } := by + rw [outputRelation] + exact frame.advance + have outputStack : StableLiveStackIso limits validation outputHeap.locRel + baselineStack rewrittenStack := by + rw [outputRelation] + exact stack + refine ⟨rewrittenValue, rewrittenOut, rewrittenRemaining, + by simpa [releaseShared] using targetReleased, + Step.releaseShared rfl sourceAt pc instruction resolved released, + Step.releaseShared rfl targetAt targetPc targetInstruction targetResolved + (by simpa [releaseShared] using targetReleased), ?_⟩ + exact StableLiveMachineRel.history outputHeap outputFuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- Deep unique destruction follows the graph rooted at its live operand and +preserves the target's traversal-fuel advantage. -/ +theorem unchangedDropUniqueStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore baselineOut : Store} + {baselineFuel rewrittenFuel baselineRemaining : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {atom : Atom} {baselineValue : RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .dropUnique atom) + (resolved : Eval.resolveAtom baselineFrame.values atom = .ok baselineValue) + (dropped : dropUnique baselineFuel baselineStore baselineValue = + .ok (baselineOut, baselineRemaining)) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { store := baselineOut + heapFuel := baselineRemaining + control := .running + { baselineFrame with pc := baselineFrame.pc + 1 } + baselineStack } + ∃ rewrittenValue rewrittenOut rewrittenRemaining, + let rewrittenNext : Machine := + { store := rewrittenOut + heapFuel := rewrittenRemaining + control := .running + { rewrittenFrame with pc := rewrittenFrame.pc + 1 } + rewrittenStack } + dropUnique rewrittenFuel rewrittenStore rewrittenValue = + .ok (rewrittenOut, rewrittenRemaining) ∧ + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have instructionAt : block.instructions[baselineFrame.pc]? = + some (.dropUnique atom) := by + simpa [instruction] using Array.getElem?_eq_getElem pc + have atomLive := AtomLiveFrom.instruction sourceBlockAt instructionAt + Liveness.InstrUsesAtom.dropUnique + obtain ⟨rewrittenValue, targetResolved, valueRelated⟩ := + frame.values.resolveAtom atomLive resolved + obtain ⟨rewrittenOut, rewrittenRemaining, outputHeap, targetDropped, + outputFuel, outputRelation⟩ := + dropUniqueWork_historyIso heap fuel (.cons valueRelated .nil) (by + unfold dropUnique at dropped + exact dropped) + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .dropUnique atom := by + simpa only [← frame.pc] using instruction + have outputFrame : StableLiveFrameIso rewrite outputHeap.locRel + { baselineFrame with pc := baselineFrame.pc + 1 } + { rewrittenFrame with pc := rewrittenFrame.pc + 1 } := by + rw [outputRelation] + exact frame.advance + have outputStack : StableLiveStackIso limits validation outputHeap.locRel + baselineStack rewrittenStack := by + rw [outputRelation] + exact stack + refine ⟨rewrittenValue, rewrittenOut, rewrittenRemaining, + by simpa [dropUnique] using targetDropped, + Step.dropUnique rfl sourceAt pc instruction resolved dropped, + Step.dropUnique rfl targetAt targetPc targetInstruction targetResolved + (by simpa [dropUnique] using targetDropped), ?_⟩ + exact StableLiveMachineRel.history outputHeap outputFuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- Discarding an absent credit advances and consumes corresponding credit +slots without imposing any value-register premise. -/ +theorem unchangedDiscardCreditAbsentStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTaken : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {creditId : CreditId} {credit : Credit} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .discardCredit creditId) + (taken : CreditTake { baselineFrame with + pc := baselineFrame.pc + 1 } creditId baselineTaken credit) + (absent : credit.presence = .absent) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineTaken baselineStack } + ∃ rewrittenTaken : Frame, + let rewrittenNext : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenTaken rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .discardCredit creditId := by + simpa only [← frame.pc] using instruction + obtain ⟨rewrittenTaken, rewrittenCredit, targetTaken, creditRelated, + takenFrame⟩ := frame.advanceTakeIso taken + obtain ⟨_, targetAbsent⟩ := creditRelated.absent_parts absent + refine ⟨rewrittenTaken, + Step.discardCreditAbsent + (context := baselineContext) (interpretation := interpretation) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction taken absent, + Step.discardCreditAbsent + (context := rewrittenContext) (interpretation := interpretation) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetTaken targetAbsent, ?_⟩ + exact StableLiveMachineRel.history heap fuel + (.running (.rewritten rewrite takenFrame) stack) + +/-- Discarding a logical credit consumes corresponding slots and leaves the +heap history unchanged. -/ +theorem unchangedDiscardCreditLogicalStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTaken : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {creditId : CreditId} {credit : Credit} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .discardCredit creditId) + (taken : CreditTake { baselineFrame with + pc := baselineFrame.pc + 1 } creditId baselineTaken credit) + (present : credit.presence = .present none) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineTaken baselineStack } + ∃ rewrittenTaken : Frame, + let rewrittenNext : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenTaken rewrittenStack } + Step baselineContext .logical baselineMachine baselineNext ∧ + Step rewrittenContext .logical rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .discardCredit creditId := by + simpa only [← frame.pc] using instruction + obtain ⟨rewrittenTaken, rewrittenCredit, targetTaken, creditRelated, + takenFrame⟩ := frame.advanceTakeIso taken + obtain ⟨_, targetPresent⟩ := creditRelated.logical_parts present + refine ⟨rewrittenTaken, + Step.discardCreditLogical + (context := baselineContext) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction taken present, + Step.discardCreditLogical + (context := rewrittenContext) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetTaken targetPresent, ?_⟩ + exact StableLiveMachineRel.history heap fuel + (.running (.rewritten rewrite takenFrame) stack) + +/-- Discarding a physical credit releases corresponding reserved locations +and transports the live frame across the unchanged location relation. -/ +theorem unchangedDiscardCreditPhysicalStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {baselineStore rewrittenStore baselineOut : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTaken : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {creditId : CreditId} {credit : Credit} + {baselineLocation : Nat} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .discardCredit creditId) + (taken : CreditTake { baselineFrame with + pc := baselineFrame.pc + 1 } creditId baselineTaken credit) + (present : credit.presence = .present (some baselineLocation)) + (released : baselineStore.releaseReservation baselineLocation = + .ok baselineOut) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { store := baselineOut + heapFuel := baselineFuel + control := .running baselineTaken baselineStack } + ∃ (rewrittenTaken : Frame) (rewrittenLocation : Nat) + (rewrittenOut : Store), + let rewrittenNext : Machine := + { store := rewrittenOut + heapFuel := rewrittenFuel + control := .running rewrittenTaken rewrittenStack } + rewrittenStore.releaseReservation rewrittenLocation = .ok rewrittenOut ∧ + Step baselineContext .physical baselineMachine baselineNext ∧ + Step rewrittenContext .physical rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .discardCredit creditId := by + simpa only [← frame.pc] using instruction + obtain ⟨rewrittenTaken, rewrittenCredit, targetTaken, creditRelated, + takenFrame⟩ := frame.advanceTakeIso taken + obtain ⟨rewrittenLocation, _, targetPresent, locations⟩ := + creditRelated.physical_parts present + obtain ⟨rewrittenOut, outputHeap, targetReleased, outputRelation⟩ := + releaseReservation_historyIso heap locations released + have outputFrame : StableLiveFrameIso rewrite outputHeap.locRel + baselineTaken rewrittenTaken := by + rw [outputRelation] + exact takenFrame + have outputStack : StableLiveStackIso limits validation outputHeap.locRel + baselineStack rewrittenStack := by + rw [outputRelation] + exact stack + refine ⟨rewrittenTaken, rewrittenLocation, rewrittenOut, targetReleased, + Step.discardCreditPhysical + (context := baselineContext) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction taken present released, + Step.discardCreditPhysical + (context := rewrittenContext) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetTaken targetPresent + targetReleased, ?_⟩ + exact StableLiveMachineRel.history outputHeap fuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- Function PAP construction resolves only its live captures and extends the +allocation history with related PAP nodes. -/ +theorem unchangedPappFnStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {callerSource calleeSource : Function} + (callerRewrite : Reuse.FunctionRewrite limits validation callerSource) + (calleeRewrite : Reuse.FunctionRewrite limits validation calleeSource) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso callerRewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {address : Ix.Compiler.Ixon.Address} + {arguments : Array Atom} {baselineValues : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .papp address arguments) + (noCredits : NoLiveCredits baselineFrame) + (baselineDeclaration : baselineContext.declarations address = + some (.fn calleeSource)) + (rewrittenDeclaration : rewrittenContext.declarations address = + some (.fn calleeRewrite.definition)) + (papSafe : calleeSource.signature.papSafe = true) + (resolved : Eval.resolveAtoms baselineFrame.values arguments = + .ok baselineValues) + (under : baselineValues.size < calleeSource.signature.params.size) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineAllocation := baselineStore.allocNode .shared + (.papN address calleeSource.signature.params.size baselineValues) + let baselineNext : Machine := + { store := baselineAllocation.1 + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values.push (.loc baselineAllocation.2) } + baselineStack } + ∃ rewrittenValues : Array RVal, + let rewrittenAllocation := rewrittenStore.allocNode .shared + (.papN address calleeSource.signature.params.size rewrittenValues) + let rewrittenNext : Machine := + { store := rewrittenAllocation.1 + heapFuel := rewrittenFuel + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values.push + (.loc rewrittenAllocation.2) } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have sourceBlockAt : callerSource.blocks[baselineFrame.block]? = + some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have instructionAt : block.instructions[baselineFrame.pc]? = + some (.papp address arguments) := by + simpa [instruction] using Array.getElem?_eq_getElem pc + have argumentsLive : AtomsLiveFrom callerSource baselineFrame.block + baselineFrame.pc arguments := + AtomsLiveFrom.instruction sourceBlockAt instructionAt (by + intro atom member + exact Liveness.InstrUsesAtom.papp member) + obtain ⟨rewrittenValues, targetResolved, valuesRelated⟩ := + frame.values.resolveAtoms argumentsLive resolved + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .papp address arguments := by + simpa only [← frame.pc] using instruction + have targetNoCredits := frame.noLiveCredits noCredits + have targetPapSafe : calleeRewrite.definition.signature.papSafe = true := by + simpa using papSafe + have sizeEq : baselineValues.size = rewrittenValues.size := by + simpa using valuesRelated.lengths + have targetUnder : + rewrittenValues.size < calleeRewrite.definition.signature.params.size := by + rw [← sizeEq, calleeRewrite.definition_signature] + exact under + let baselineAllocation := baselineStore.allocNode .shared + (.papN address calleeSource.signature.params.size baselineValues) + let rewrittenAllocation := rewrittenStore.allocNode .shared + (.papN address calleeSource.signature.params.size rewrittenValues) + let outputHeap : IxIR1.Sim.HeapHistoryIso baselineAllocation.1.heap + rewrittenAllocation.1.heap := heap.alloc (.pap valuesRelated) + have oldExtends : ∀ {baselineLocation rewrittenLocation}, + heap.locRel baselineLocation rewrittenLocation → + outputHeap.locRel baselineLocation rewrittenLocation := by + intro baselineLocation rewrittenLocation related + exact .inr related + have resultRelated : IxIR1.Sim.RValIso outputHeap.locRel + (.loc baselineAllocation.2) (.loc rewrittenAllocation.2) := + .loc (.inl ⟨rfl, rfl⟩) + have outputFrame := (frame.mono oldExtends).advancePush resultRelated + have outputStack := stack.mono oldExtends + refine ⟨rewrittenValues, + by simpa [baselineAllocation] using + (Step.pappFnCleared + (context := baselineContext) (interpretation := interpretation) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction noCredits baselineDeclaration papSafe + resolved under), + by simpa [rewrittenAllocation, calleeRewrite.definition_signature] using + (Step.pappFnCleared + (context := rewrittenContext) (interpretation := interpretation) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetNoCredits + rewrittenDeclaration targetPapSafe targetResolved targetUnder), ?_⟩ + exact StableLiveMachineRel.history outputHeap fuel + (.running (.rewritten callerRewrite outputFrame) outputStack) + +/-- Extern PAP construction resolves only its live captures and extends the +allocation history with related PAP nodes. -/ +theorem unchangedPappExternStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {address : Ix.Compiler.Ixon.Address} + {arguments : Array Atom} {baselineValues : Array RVal} {arity : Nat} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .papp address arguments) + (noCredits : NoLiveCredits baselineFrame) + (baselineDeclaration : baselineContext.declarations address = + some (.extern arity)) + (rewrittenDeclaration : rewrittenContext.declarations address = + some (.extern arity)) + (resolved : Eval.resolveAtoms baselineFrame.values arguments = + .ok baselineValues) + (under : baselineValues.size < arity) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineAllocation := baselineStore.allocNode .shared + (.papN address arity baselineValues) + let baselineNext : Machine := + { store := baselineAllocation.1 + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values.push (.loc baselineAllocation.2) } + baselineStack } + ∃ rewrittenValues : Array RVal, + let rewrittenAllocation := rewrittenStore.allocNode .shared + (.papN address arity rewrittenValues) + let rewrittenNext : Machine := + { store := rewrittenAllocation.1 + heapFuel := rewrittenFuel + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values.push + (.loc rewrittenAllocation.2) } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have instructionAt : block.instructions[baselineFrame.pc]? = + some (.papp address arguments) := by + simpa [instruction] using Array.getElem?_eq_getElem pc + have argumentsLive : AtomsLiveFrom source baselineFrame.block + baselineFrame.pc arguments := + AtomsLiveFrom.instruction sourceBlockAt instructionAt (by + intro atom member + exact Liveness.InstrUsesAtom.papp member) + obtain ⟨rewrittenValues, targetResolved, valuesRelated⟩ := + frame.values.resolveAtoms argumentsLive resolved + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .papp address arguments := by + simpa only [← frame.pc] using instruction + have targetNoCredits := frame.noLiveCredits noCredits + have sizeEq : baselineValues.size = rewrittenValues.size := by + simpa using valuesRelated.lengths + have targetUnder : rewrittenValues.size < arity := by + rw [← sizeEq] + exact under + let baselineAllocation := baselineStore.allocNode .shared + (.papN address arity baselineValues) + let rewrittenAllocation := rewrittenStore.allocNode .shared + (.papN address arity rewrittenValues) + let outputHeap : IxIR1.Sim.HeapHistoryIso baselineAllocation.1.heap + rewrittenAllocation.1.heap := heap.alloc (.pap valuesRelated) + have oldExtends : ∀ {baselineLocation rewrittenLocation}, + heap.locRel baselineLocation rewrittenLocation → + outputHeap.locRel baselineLocation rewrittenLocation := by + intro baselineLocation rewrittenLocation related + exact .inr related + have resultRelated : IxIR1.Sim.RValIso outputHeap.locRel + (.loc baselineAllocation.2) (.loc rewrittenAllocation.2) := + .loc (.inl ⟨rfl, rfl⟩) + have outputFrame := (frame.mono oldExtends).advancePush resultRelated + have outputStack := stack.mono oldExtends + refine ⟨rewrittenValues, + by simpa [baselineAllocation] using + (Step.pappExternCleared + (context := baselineContext) (interpretation := interpretation) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction noCredits baselineDeclaration resolved + under), + by simpa [rewrittenAllocation] using + (Step.pappExternCleared + (context := rewrittenContext) (interpretation := interpretation) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetNoCredits + rewrittenDeclaration targetResolved targetUnder), ?_⟩ + exact StableLiveMachineRel.history outputHeap fuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- A scalar extern call resolves only its live argument operands; related +scalar vectors and the common oracle result are literally equal. -/ +theorem unchangedExternStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + (oracles : baselineContext.oracle = rewrittenContext.oracle) + {block : Block} {address : Ix.Compiler.Ixon.Address} + {arguments : Array Atom} {baselineValues : Array RVal} + {arity : Nat} {value : RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .extern address arguments) + (noCredits : NoLiveCredits baselineFrame) + (resolved : Eval.resolveAtoms baselineFrame.values arguments = + .ok baselineValues) + (baselineDeclaration : baselineContext.declarations address = + some (.extern arity)) + (rewrittenDeclaration : rewrittenContext.declarations address = + some (.extern arity)) + (argumentArity : baselineValues.size = arity) + (called : ScalarOracleCall baselineContext address baselineValues value) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values.push value } + baselineStack } + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values.push value } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have instructionAt : block.instructions[baselineFrame.pc]? = + some (.extern address arguments) := by + simpa [instruction] using Array.getElem?_eq_getElem pc + have argumentsLive : AtomsLiveFrom source baselineFrame.block + baselineFrame.pc arguments := + AtomsLiveFrom.instruction sourceBlockAt instructionAt (by + intro atom member + exact Liveness.InstrUsesAtom.extern member) + obtain ⟨rewrittenValues, targetResolved, valuesRelated⟩ := + frame.values.resolveAtoms argumentsLive resolved + obtain ⟨argumentsScalar, valueScalar⟩ := called.scalar + have listEq : baselineValues.toList = rewrittenValues.toList := by + apply valuesRelated.eq_of_allScalar + rw [Array.all_toList] + exact argumentsScalar + have valuesEq : baselineValues = rewrittenValues := + Array.toList_inj.mp listEq + subst rewrittenValues + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .extern address arguments := by + simpa only [← frame.pc] using instruction + have targetNoCredits := frame.noLiveCredits noCredits + have targetCalled : + ScalarOracleCall rewrittenContext address baselineValues value := + called.congrOracle oracles + refine ⟨ + Step.externCleared rfl sourceAt pc instruction noCredits resolved + baselineDeclaration argumentArity called, + Step.externCleared rfl targetAt targetPc targetInstruction targetNoCredits + targetResolved rewrittenDeclaration argumentArity targetCalled, ?_⟩ + exact StableLiveMachineRel.history heap fuel + (.running + (.rewritten rewrite + (frame.advancePush + (IxIR1.Sim.RValIso.refl_of_scalar valueScalar))) + stack) + +/-- A recursive call only needs agreement for its syntactically live argument +registers. The complete caller is suspended after advancing its program +counter, at which point newly dead transferred registers cease to constrain +the relation. -/ +theorem unchangedCallSelfStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {arguments : Array Atom} + {baselineValues : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .callSelf arguments) + (noCredits : NoLiveCredits baselineFrame) + (resolved : Eval.resolveAtoms baselineFrame.values arguments = + .ok baselineValues) + (arity : baselineValues.size = + baselineFrame.definition.signature.params.size) + (nonempty : baselineFrame.definition.blocks.isEmpty = false) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with + control := .running + { definition := baselineFrame.definition, values := baselineValues } + (.resume { baselineFrame with pc := baselineFrame.pc + 1 } :: + baselineStack) } + ∃ rewrittenValues, + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running + { definition := rewrittenFrame.definition, + values := rewrittenValues } + (.resume { rewrittenFrame with pc := rewrittenFrame.pc + 1 } :: + rewrittenStack) } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have argumentsLive := AtomsLiveFrom.callSelf sourceBlockAt pc instruction + obtain ⟨rewrittenValues, targetResolved, valuesRelated⟩ := + frame.values.resolveAtoms argumentsLive resolved + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .callSelf arguments := by + simpa only [← frame.pc] using instruction + have targetNoCredits := frame.noLiveCredits noCredits + have sizeEq : baselineValues.size = rewrittenValues.size := by + simpa using valuesRelated.lengths + have sourceArity : baselineValues.size = source.signature.params.size := by + simpa [frame.baselineDefinition] using arity + have targetArity : rewrittenValues.size = + rewrittenFrame.definition.signature.params.size := by + rw [← sizeEq, frame.rewrittenDefinition, rewrite.definition_signature] + exact sourceArity + have targetNonempty : rewrittenFrame.definition.blocks.isEmpty = false := + blocks_nonempty_of_getElem targetAt + refine ⟨rewrittenValues, + Step.callSelfCleared rfl sourceAt pc instruction noCredits resolved arity + nonempty, + Step.callSelfCleared rfl targetAt targetPc targetInstruction + targetNoCredits targetResolved targetArity targetNonempty, ?_⟩ + have callee : StableLiveFrameRel limits validation heap.locRel + { definition := baselineFrame.definition, values := baselineValues } + { definition := rewrittenFrame.definition, values := rewrittenValues } := by + rw [frame.baselineDefinition, frame.rewrittenDefinition] + exact StableLiveFrameRel.entry rewrite valuesRelated + have resume : StableLiveContinuationIso limits validation heap.locRel + (.resume { baselineFrame with pc := baselineFrame.pc + 1 }) + (.resume { rewrittenFrame with pc := rewrittenFrame.pc + 1 }) := + .resume (.rewritten rewrite frame.advance) + exact StableLiveMachineRel.history heap fuel + (.running callee (.cons resume stack)) + +/-- A direct call selects the related callee rewrite while preserving the +live-indexed suspended caller. -/ +theorem unchangedCallFnStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {callerSource calleeSource : Function} + (callerRewrite : Reuse.FunctionRewrite limits validation callerSource) + (calleeRewrite : Reuse.FunctionRewrite limits validation calleeSource) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso callerRewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {address : Ix.Compiler.Ixon.Address} + {arguments : Array Atom} {baselineValues : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .call address arguments) + (noCredits : NoLiveCredits baselineFrame) + (resolved : Eval.resolveAtoms baselineFrame.values arguments = + .ok baselineValues) + (baselineDeclaration : baselineContext.declarations address = + some (.fn calleeSource)) + (rewrittenDeclaration : rewrittenContext.declarations address = + some (.fn calleeRewrite.definition)) + (arity : baselineValues.size = calleeSource.signature.params.size) + (nonempty : calleeSource.blocks.isEmpty = false) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with + control := .running + { definition := calleeSource, values := baselineValues } + (.resume { baselineFrame with pc := baselineFrame.pc + 1 } :: + baselineStack) } + ∃ rewrittenValues, + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running + { definition := calleeRewrite.definition, + values := rewrittenValues } + (.resume { rewrittenFrame with pc := rewrittenFrame.pc + 1 } :: + rewrittenStack) } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have sourceBlockAt : callerSource.blocks[baselineFrame.block]? = + some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have argumentsLive := AtomsLiveFrom.call sourceBlockAt pc instruction + obtain ⟨rewrittenValues, targetResolved, valuesRelated⟩ := + frame.values.resolveAtoms argumentsLive resolved + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .call address arguments := by + simpa only [← frame.pc] using instruction + have targetNoCredits := frame.noLiveCredits noCredits + have sizeEq : baselineValues.size = rewrittenValues.size := by + simpa using valuesRelated.lengths + have targetArity : rewrittenValues.size = + calleeRewrite.definition.signature.params.size := by + rw [← sizeEq, calleeRewrite.definition_signature] + exact arity + have targetNonempty : calleeRewrite.definition.blocks.isEmpty = false := + calleeRewrite.definition_blocks_nonempty nonempty + refine ⟨rewrittenValues, + Step.callFnCleared rfl sourceAt pc instruction noCredits resolved + baselineDeclaration arity nonempty, + Step.callFnCleared rfl targetAt targetPc targetInstruction + targetNoCredits targetResolved rewrittenDeclaration targetArity + targetNonempty, ?_⟩ + have callee : StableLiveFrameRel limits validation heap.locRel + { definition := calleeSource, values := baselineValues } + { definition := calleeRewrite.definition, values := rewrittenValues } := + StableLiveFrameRel.entry calleeRewrite valuesRelated + have resume : StableLiveContinuationIso limits validation heap.locRel + (.resume { baselineFrame with pc := baselineFrame.pc + 1 }) + (.resume { rewrittenFrame with pc := rewrittenFrame.pc + 1 }) := + .resume (.rewritten callerRewrite frame.advance) + exact StableLiveMachineRel.history heap fuel + (.running callee (.cons resume stack)) + +/-- An unchanged jump relates exactly the selected edge operands and enters a +fresh pointwise-related target ABI. -/ +theorem unchangedJumpStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTarget : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {edge : Edge} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = .jump edge) + (transferred : EdgeTransfer baselineFrame edge #[] baselineTarget) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with + control := .running baselineTarget baselineStack } + ∃ rewrittenTarget : Frame, + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running rewrittenTarget rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have edgeLive : AtomsLiveFrom source baselineFrame.block baselineFrame.pc + edge.values := + AtomsLiveFrom.terminatorEdge sourceBlockAt pc (by + intro atom member + rw [terminator] + exact Liveness.TerminatorUsesAtom.jump + (Liveness.EdgeUsesAtom.value member)) + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + obtain ⟨rewrittenTarget, rewrittenTransfer, targetFrame⟩ := + frame.edgeTransferIso edgeLive (.nil) transferred + refine ⟨rewrittenTarget, + Step.jump rfl sourceAt pc terminator transferred, + Step.jump rfl targetAt targetPc terminator rewrittenTransfer, ?_⟩ + exact StableLiveMachineRel.history heap fuel + (.running (.rewritten rewrite targetFrame) stack) + +/-- The zero arm observes the live scrutinee and relates the selected edge +operands. -/ +theorem unchangedSwitchNatZeroStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTarget : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {scrutinee : Atom} {constructors : Array CtorAlt} + {peel : NatPeel} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = + .switchValue scrutinee constructors (some peel)) + (resolved : Eval.resolveAtom baselineFrame.values scrutinee = + .ok (.lit (.nat 0))) + (transferred : EdgeTransfer baselineFrame peel.zero #[] baselineTarget) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with control := .running baselineTarget baselineStack } + ∃ rewrittenTarget : Frame, + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running rewrittenTarget rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have scrutineeLive : AtomLiveFrom source baselineFrame.block + baselineFrame.pc scrutinee := + AtomLiveFrom.terminator sourceBlockAt pc (by + rw [terminator] + exact Liveness.TerminatorUsesAtom.switchScrutinee) + have edgeLive : AtomsLiveFrom source baselineFrame.block baselineFrame.pc + peel.zero.values := + AtomsLiveFrom.terminatorEdge sourceBlockAt pc (by + intro atom member + rw [terminator] + exact Liveness.TerminatorUsesAtom.switchNatZero + (Liveness.EdgeUsesAtom.value member)) + obtain ⟨rewrittenValue, targetResolved, valueRelated⟩ := + frame.values.resolveAtom scrutineeLive resolved + cases valueRelated with + | lit => + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + obtain ⟨rewrittenTarget, rewrittenTransfer, targetFrame⟩ := + frame.edgeTransferIso edgeLive (.nil) transferred + refine ⟨rewrittenTarget, + Step.switchNatZero rfl sourceAt pc terminator resolved transferred, + Step.switchNatZero rfl targetAt targetPc terminator targetResolved + rewrittenTransfer, ?_⟩ + exact StableLiveMachineRel.history heap fuel + (.running (.rewritten rewrite targetFrame) stack) + +/-- The successor arm additionally prepends the same scalar predecessor to +the related edge values. -/ +theorem unchangedSwitchNatSuccStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTarget : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {scrutinee : Atom} {constructors : Array CtorAlt} + {peel : NatPeel} {predecessor : Nat} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = + .switchValue scrutinee constructors (some peel)) + (resolved : Eval.resolveAtom baselineFrame.values scrutinee = + .ok (.lit (.nat (predecessor + 1)))) + (transferred : EdgeTransfer baselineFrame peel.succ + #[.lit (.nat predecessor)] baselineTarget) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with control := .running baselineTarget baselineStack } + ∃ rewrittenTarget : Frame, + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running rewrittenTarget rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have scrutineeLive : AtomLiveFrom source baselineFrame.block + baselineFrame.pc scrutinee := + AtomLiveFrom.terminator sourceBlockAt pc (by + rw [terminator] + exact Liveness.TerminatorUsesAtom.switchScrutinee) + have edgeLive : AtomsLiveFrom source baselineFrame.block baselineFrame.pc + peel.succ.values := + AtomsLiveFrom.terminatorEdge sourceBlockAt pc (by + intro atom member + rw [terminator] + exact Liveness.TerminatorUsesAtom.switchNatSucc + (Liveness.EdgeUsesAtom.value member)) + obtain ⟨rewrittenValue, targetResolved, valueRelated⟩ := + frame.values.resolveAtom scrutineeLive resolved + cases valueRelated with + | lit => + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + obtain ⟨rewrittenTarget, rewrittenTransfer, targetFrame⟩ := + frame.edgeTransferIso edgeLive (.cons .lit .nil) transferred + refine ⟨rewrittenTarget, + Step.switchNatSucc rfl sourceAt pc terminator resolved transferred, + Step.switchNatSucc rfl targetAt targetPc terminator targetResolved + rewrittenTransfer, ?_⟩ + exact StableLiveMachineRel.history heap fuel + (.running (.rewritten rewrite targetFrame) stack) + +/-- Constructor dispatch follows the related scrutinee location and relates +the chosen alternative's edge operands. -/ +theorem unchangedSwitchCtorStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTarget : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {scrutinee : Atom} {constructors : Array CtorAlt} + {natPeel : Option NatPeel} {baselineLocation : Nat} {box : NodeBox} + {cid : CtorId} {fields : Array RVal} {alternative : CtorAlt} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = + .switchValue scrutinee constructors natPeel) + (resolved : Eval.resolveAtom baselineFrame.values scrutinee = + .ok (.loc baselineLocation)) + (boxAt : baselineStore.get? baselineLocation = some box) + (node : box.node = .ctorN cid fields) + (alternativeAt : constructors.find? (fun candidate => + candidate.cid == cid) = some alternative) + (transferred : EdgeTransfer baselineFrame alternative.edge #[] + baselineTarget) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with control := .running baselineTarget baselineStack } + ∃ rewrittenTarget : Frame, + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running rewrittenTarget rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext ∧ + StableLiveFrameIso rewrite heap.locRel baselineTarget + rewrittenTarget := by + dsimp only + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have scrutineeLive : AtomLiveFrom source baselineFrame.block + baselineFrame.pc scrutinee := + AtomLiveFrom.terminator sourceBlockAt pc (by + rw [terminator] + exact Liveness.TerminatorUsesAtom.switchScrutinee) + have alternativeMember : alternative ∈ constructors.toList := by + simpa using Array.mem_of_find?_eq_some alternativeAt + have edgeLive : AtomsLiveFrom source baselineFrame.block baselineFrame.pc + alternative.edge.values := + AtomsLiveFrom.terminatorEdge sourceBlockAt pc (by + intro atom member + rw [terminator] + exact Liveness.TerminatorUsesAtom.switchCtor alternativeMember + (Liveness.EdgeUsesAtom.value member)) + obtain ⟨rewrittenValue, targetResolved, valueRelated⟩ := + frame.values.resolveAtom scrutineeLive resolved + cases valueRelated with + | @loc _ rewrittenLocation locations => + obtain ⟨rewrittenBox, targetBoxAt, boxesRelated⟩ := + heap.boxes locations (by + change baselineStore.heap.get? baselineLocation = some box + exact boxAt) + have nodesRelated : IxIR1.Sim.NodeIso heap.locRel + (.ctorN cid fields) rewrittenBox.node := by + rw [← node] + exact boxesRelated.node + obtain ⟨rewrittenFields, targetNode, _fieldsRelated⟩ := + nodeIso_ctor_left nodesRelated + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + obtain ⟨rewrittenTarget, rewrittenTransfer, targetFrame⟩ := + frame.edgeTransferIso edgeLive (.nil) transferred + refine ⟨rewrittenTarget, + Step.switchCtor rfl sourceAt pc terminator resolved boxAt node + alternativeAt transferred, + Step.switchCtor rfl targetAt targetPc terminator targetResolved + (by + change rewrittenStore.heap.get? rewrittenLocation = + some rewrittenBox + exact targetBoxAt) + targetNode alternativeAt rewrittenTransfer, ?_, targetFrame⟩ + exact StableLiveMachineRel.history heap fuel + (.running (.rewritten rewrite targetFrame) stack) + +/-- A constructor switch followed by its complete generated field-fetch +prologue synchronizes automatically when both the parent and selected child +blocks are preserved literally. The child decision is checked at entry, and +accepted-entry phase is established only at the post-prologue endpoint. -/ +theorem unchangedSwitchCtorPrologueStepsLiveIso + {limits : Validate.Limits} {validation : Validate.Context} + {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineChildFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {parentBlock : Block} {scrutinee childScrutinee : Atom} + {constructors : Array CtorAlt} {natPeel : Option NatPeel} + {baselineLocation : Nat} {box : NodeBox} + {cid : CtorId} {fields : Array RVal} {alternative : CtorAlt} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some parentBlock) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some parentBlock) + (pc : baselineFrame.pc = parentBlock.instructions.size) + (terminator : parentBlock.terminator = + .switchValue scrutinee constructors natPeel) + (resolved : Eval.resolveAtom baselineFrame.values scrutinee = + .ok (.loc baselineLocation)) + (boxAt : baselineStore.get? baselineLocation = some box) + (node : box.node = .ctorN cid fields) + (alternativeAt : constructors.find? (fun candidate => + candidate.cid == cid) = some alternative) + (transferred : EdgeTransfer baselineFrame alternative.edge #[] + baselineChildFrame) + {childBlock : Block} + (childAt : baselineChildFrame.definition.blocks[baselineChildFrame.block]? = + some childBlock) + (childTargetAt : + rewrite.definition.blocks[baselineChildFrame.block]? = some childBlock) + (childPc : baselineChildFrame.pc = 0) + (prologue : Lower.fetchPrologueMatches childBlock.instructions + childScrutinee cid fields.size = true) + (childResolved : Eval.resolveAtom baselineChildFrame.values + childScrutinee = .ok (.loc baselineLocation)) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineFinalFrame : Frame := + { baselineChildFrame with + pc := fields.size + values := baselineChildFrame.values ++ fields } + let baselineFinal : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFinalFrame baselineStack } + ∃ rewrittenFinalFrame, + let rewrittenFinal : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFinalFrame rewrittenStack } + Steps baselineContext interpretation (1 + fields.size) + baselineMachine baselineFinal ∧ + Steps rewrittenContext interpretation (1 + fields.size) + rewrittenMachine rewrittenFinal ∧ + StableLiveMachineRel limits validation baselineFinal rewrittenFinal ∧ + StableLiveAcceptedEntry limits validation baselineFinal + rewrittenFinal := by + dsimp only + obtain ⟨rewrittenChildFrame, baselineSwitch, rewrittenSwitch, + _childRelated, childFrame⟩ := + unchangedSwitchCtorStepLiveIso rewrite heap fuel frame stack sourceAt + targetAt pc terminator resolved boxAt node alternativeAt transferred + have rewrittenChildAt : + rewrittenChildFrame.definition.blocks[rewrittenChildFrame.block]? = + some childBlock := by + rw [childFrame.rewrittenDefinition, ← childFrame.block] + exact childTargetAt + obtain ⟨rewrittenFinalFrame, baselinePrologue, rewrittenPrologue, related, + acceptedEntry⟩ := + unchangedFetchPrologueStepsLiveIso rewrite heap fuel childFrame stack + childAt rewrittenChildAt childPc prologue childResolved boxAt node + exact ⟨rewrittenFinalFrame, + (baselineSwitch.toSteps rfl).trans baselinePrologue, + (rewrittenSwitch.toSteps rfl).trans rewrittenPrologue, + related, acceptedEntry⟩ + +/-- A present optional credit selects its branch while only the selected +edge's value operands need to be related. -/ +theorem unchangedBranchCreditPresentStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTarget : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {creditId : CreditId} {credit : Credit} + {someEdge noneEdge : Edge} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = + .branchCredit creditId someEdge noneEdge) + (lookedUp : CreditLookup baselineFrame creditId credit) + (present : credit.isPresent = true) + (transferred : EdgeTransfer baselineFrame someEdge #[] baselineTarget) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with control := .running baselineTarget baselineStack } + ∃ rewrittenTarget : Frame, + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running rewrittenTarget rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have edgeLive : AtomsLiveFrom source baselineFrame.block baselineFrame.pc + someEdge.values := + AtomsLiveFrom.terminatorEdge sourceBlockAt pc (by + intro atom member + rw [terminator] + exact Liveness.TerminatorUsesAtom.branchSome + (Liveness.EdgeUsesAtom.value member)) + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + obtain ⟨rewrittenCredit, targetLookup, creditRelated⟩ := + frame.creditLookup lookedUp + have targetPresent : rewrittenCredit.isPresent = true := by + rw [← creditRelated.present_parts.2] + exact present + obtain ⟨rewrittenTarget, rewrittenTransfer, targetFrame⟩ := + frame.edgeTransferIso edgeLive (.nil) transferred + refine ⟨rewrittenTarget, + Step.branchCreditPresent rfl sourceAt pc terminator lookedUp present + transferred, + Step.branchCreditPresent rfl targetAt targetPc terminator targetLookup + targetPresent rewrittenTransfer, ?_⟩ + exact StableLiveMachineRel.history heap fuel + (.running (.rewritten rewrite targetFrame) stack) + +/-- An absent optional credit selects the fallback branch while only that +edge's value operands need to be related. -/ +theorem unchangedBranchCreditAbsentStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTarget : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {creditId : CreditId} {credit : Credit} + {someEdge noneEdge : Edge} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = + .branchCredit creditId someEdge noneEdge) + (lookedUp : CreditLookup baselineFrame creditId credit) + (absent : credit.isPresent = false) + (transferred : EdgeTransfer baselineFrame noneEdge #[] baselineTarget) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with control := .running baselineTarget baselineStack } + ∃ rewrittenTarget : Frame, + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running rewrittenTarget rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have edgeLive : AtomsLiveFrom source baselineFrame.block baselineFrame.pc + noneEdge.values := + AtomsLiveFrom.terminatorEdge sourceBlockAt pc (by + intro atom member + rw [terminator] + exact Liveness.TerminatorUsesAtom.branchNone + (Liveness.EdgeUsesAtom.value member)) + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + obtain ⟨rewrittenCredit, targetLookup, creditRelated⟩ := + frame.creditLookup lookedUp + have targetAbsent : rewrittenCredit.isPresent = false := by + rw [← creditRelated.present_parts.2] + exact absent + obtain ⟨rewrittenTarget, rewrittenTransfer, targetFrame⟩ := + frame.edgeTransferIso edgeLive (.nil) transferred + refine ⟨rewrittenTarget, + Step.branchCreditAbsent rfl sourceAt pc terminator lookedUp absent + transferred, + Step.branchCreditAbsent rfl targetAt targetPc terminator targetLookup + targetAbsent rewrittenTransfer, ?_⟩ + exact StableLiveMachineRel.history heap fuel + (.running (.rewritten rewrite targetFrame) stack) + +/-- A recursive tail call resolves only live terminator operands and re-enters +the two versions of the current function. -/ +theorem unchangedTailCallSelfStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {arguments : Array Atom} + {baselineValues : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = .tailCallSelf arguments) + (noCredits : NoLiveCredits baselineFrame) + (resolved : Eval.resolveAtoms baselineFrame.values arguments = + .ok baselineValues) + (arity : baselineValues.size = + baselineFrame.definition.signature.params.size) + (nonempty : baselineFrame.definition.blocks.isEmpty = false) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with + control := .running + { definition := baselineFrame.definition, values := baselineValues } + baselineStack } + ∃ rewrittenValues, + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running + { definition := rewrittenFrame.definition, + values := rewrittenValues } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have argumentsLive := + AtomsLiveFrom.tailCallSelf sourceBlockAt pc terminator + obtain ⟨rewrittenValues, targetResolved, valuesRelated⟩ := + frame.values.resolveAtoms argumentsLive resolved + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + have targetNoCredits := frame.noLiveCredits noCredits + have sizeEq : baselineValues.size = rewrittenValues.size := by + simpa using valuesRelated.lengths + have sourceArity : baselineValues.size = source.signature.params.size := by + simpa [frame.baselineDefinition] using arity + have targetArity : rewrittenValues.size = + rewrittenFrame.definition.signature.params.size := by + rw [← sizeEq, frame.rewrittenDefinition, rewrite.definition_signature] + exact sourceArity + have targetNonempty : rewrittenFrame.definition.blocks.isEmpty = false := + blocks_nonempty_of_getElem targetAt + refine ⟨rewrittenValues, + Step.tailCallSelfCleared rfl sourceAt pc terminator noCredits resolved + arity nonempty, + Step.tailCallSelfCleared rfl targetAt targetPc terminator targetNoCredits + targetResolved targetArity targetNonempty, ?_⟩ + have callee : StableLiveFrameRel limits validation heap.locRel + { definition := baselineFrame.definition, values := baselineValues } + { definition := rewrittenFrame.definition, values := rewrittenValues } := by + rw [frame.baselineDefinition, frame.rewrittenDefinition] + exact StableLiveFrameRel.entry rewrite valuesRelated + exact StableLiveMachineRel.history heap fuel (.running callee stack) + +/-- A direct tail call enters the retained rewrite of the selected callee. -/ +theorem unchangedTailCallFnStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {callerSource calleeSource : Function} + (callerRewrite : Reuse.FunctionRewrite limits validation callerSource) + (calleeRewrite : Reuse.FunctionRewrite limits validation calleeSource) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso callerRewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {address : Ix.Compiler.Ixon.Address} + {arguments : Array Atom} {baselineValues : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = .tailCall address arguments) + (noCredits : NoLiveCredits baselineFrame) + (resolved : Eval.resolveAtoms baselineFrame.values arguments = + .ok baselineValues) + (baselineDeclaration : baselineContext.declarations address = + some (.fn calleeSource)) + (rewrittenDeclaration : rewrittenContext.declarations address = + some (.fn calleeRewrite.definition)) + (arity : baselineValues.size = calleeSource.signature.params.size) + (nonempty : calleeSource.blocks.isEmpty = false) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with + control := .running + { definition := calleeSource, values := baselineValues } + baselineStack } + ∃ rewrittenValues, + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running + { definition := calleeRewrite.definition, + values := rewrittenValues } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have sourceBlockAt : callerSource.blocks[baselineFrame.block]? = + some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have argumentsLive := AtomsLiveFrom.tailCall sourceBlockAt pc terminator + obtain ⟨rewrittenValues, targetResolved, valuesRelated⟩ := + frame.values.resolveAtoms argumentsLive resolved + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + have targetNoCredits := frame.noLiveCredits noCredits + have sizeEq : baselineValues.size = rewrittenValues.size := by + simpa using valuesRelated.lengths + have targetArity : rewrittenValues.size = + calleeRewrite.definition.signature.params.size := by + rw [← sizeEq, calleeRewrite.definition_signature] + exact arity + have targetNonempty : calleeRewrite.definition.blocks.isEmpty = false := + calleeRewrite.definition_blocks_nonempty nonempty + refine ⟨rewrittenValues, + Step.tailCallFnCleared rfl sourceAt pc terminator noCredits resolved + baselineDeclaration arity nonempty, + Step.tailCallFnCleared rfl targetAt targetPc terminator targetNoCredits + targetResolved rewrittenDeclaration targetArity targetNonempty, ?_⟩ + exact StableLiveMachineRel.history heap fuel + (.running (StableLiveFrameRel.entry calleeRewrite valuesRelated) stack) + +/-- Returning to a suspended caller appends the related result at the caller's +already-advanced coordinate. -/ +theorem unchangedRetResumeStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineCaller rewrittenCaller : Frame} + {baselineRest rewrittenRest : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (caller : StableLiveFrameRel limits validation heap.locRel + baselineCaller rewrittenCaller) + (rest : StableLiveStackIso limits validation heap.locRel + baselineRest rewrittenRest) + {block : Block} {atom : Atom} {baselineValue : RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = .ret atom) + (resolved : Eval.resolveAtom baselineFrame.values atom = .ok baselineValue) + (noCredits : NoLiveCredits baselineFrame) + (world : baselineValue.hasWorld baselineStore + baselineFrame.definition.signature.result = true) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame + (.resume baselineCaller :: baselineRest) } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame + (.resume rewrittenCaller :: rewrittenRest) } + let baselineNext : Machine := + { baselineMachine with + control := .running + { baselineCaller with + values := baselineCaller.values.push baselineValue } + baselineRest } + ∃ rewrittenValue, + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running + { rewrittenCaller with + values := rewrittenCaller.values.push rewrittenValue } + rewrittenRest } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have atomLive := AtomLiveFrom.ret sourceBlockAt pc terminator + obtain ⟨rewrittenValue, targetResolved, valueRelated⟩ := + frame.values.resolveAtom atomLive resolved + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + have targetNoCredits := frame.noLiveCredits noCredits + have resultWorldEq : rewrittenFrame.definition.signature.result = + baselineFrame.definition.signature.result := by + rw [frame.rewrittenDefinition, rewrite.definition_signature, + frame.baselineDefinition] + have targetWorld : rewrittenValue.hasWorld rewrittenStore + rewrittenFrame.definition.signature.result = true := by + rw [resultWorldEq, + ← Ix.Compiler.IxIR2.ReuseSim.heapHistoryIso_rvalHasWorld_eq heap + valueRelated] + exact world + refine ⟨rewrittenValue, + Step.retResumeCleared rfl sourceAt pc terminator resolved noCredits world, + Step.retResumeCleared rfl targetAt targetPc terminator targetResolved + targetNoCredits targetWorld, ?_⟩ + exact StableLiveMachineRel.history heap fuel + (.running (caller.push valueRelated) rest) + +/-- An outermost return halts with a related result under live-only register +agreement. -/ +theorem unchangedRetHaltStepLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + {block : Block} {atom : Atom} {baselineValue : RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = .ret atom) + (resolved : Eval.resolveAtom baselineFrame.values atom = .ok baselineValue) + (noCredits : NoLiveCredits baselineFrame) + (world : baselineValue.hasWorld baselineStore + baselineFrame.definition.signature.result = true) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame [] } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame [] } + let baselineNext : Machine := + { baselineMachine with control := .halted baselineValue } + ∃ rewrittenValue, + let rewrittenNext : Machine := + { rewrittenMachine with control := .halted rewrittenValue } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableLiveMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have atomLive := AtomLiveFrom.ret sourceBlockAt pc terminator + obtain ⟨rewrittenValue, targetResolved, valueRelated⟩ := + frame.values.resolveAtom atomLive resolved + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + have targetNoCredits := frame.noLiveCredits noCredits + have resultWorldEq : rewrittenFrame.definition.signature.result = + baselineFrame.definition.signature.result := by + rw [frame.rewrittenDefinition, rewrite.definition_signature, + frame.baselineDefinition] + have targetWorld : rewrittenValue.hasWorld rewrittenStore + rewrittenFrame.definition.signature.result = true := by + rw [resultWorldEq, + ← Ix.Compiler.IxIR2.ReuseSim.heapHistoryIso_rvalHasWorld_eq heap + valueRelated] + exact world + refine ⟨rewrittenValue, + Step.retHaltCleared rfl sourceAt pc terminator resolved noCredits world, + Step.retHaltCleared rfl targetAt targetPc terminator targetResolved + targetNoCredits targetWorld, ?_⟩ + exact StableLiveMachineRel.history heap fuel (.halted valueRelated) + +/-! ## Live accepted macros from exact-content states -/ + +/-- The live logical-hot accepted macro is compositional over exact semantic heap +contents and heap-fuel dominance. In particular, source and target stores +may already differ in every observational counter; only their live node array +must agree. -/ +theorem acceptedHotLogicalStableLiveSimulation {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {index helperOffset : Nat} {block : Block} + {site : Reuse.Site limits validation block} + (found : Reuse.FunctionDecisions.At rewrite.decisions index helperOffset + block (.accepted site)) + {baselineContext rewrittenContext : Eval.Context} + (baselineSchemas : baselineContext.schemas = validation.schemas) + (rewrittenSchemas : rewrittenContext.schemas = validation.schemas) + {baselineStore rewrittenStore baselineRetained baselineReleased : Store} + (heap : HeapContentsEq baselineStore rewrittenStore) + {parameters fields newFields callValues : Array RVal} + {location fieldFuel remaining rewrittenFuel : Nat} + {baselineStack rewrittenStack : List Continuation} + (stack : StableLiveStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {ambient : List IxIR1.Sim.Root} {allocationSchema : CtorSchema} + (fuel : fieldFuel + 1 ≤ rewrittenFuel) + (allocationSchemaAt : + baselineContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (sourceResolved : resolveAtom parameters (.reg site.shape.source) = + .ok (.loc location)) + (sourceBoxAt : baselineStore.get? location = some + ⟨.shared, 1, .ctorN site.shape.sourceConstructor fields⟩) + (owned : IxIR1.Sim.RootOwnership baselineStore.heap + (⟨.shared, .loc location⟩ :: ambient)) + (retained : RetainSharedMany baselineStore fields baselineRetained) + (released : releaseShared (fieldFuel + 1) baselineRetained + (.loc location) = .ok (baselineReleased, remaining)) + (allocationResolved : resolveAtoms + (baselinePrefixValues parameters fields) + site.shape.allocationArguments = .ok newFields) + (baselineFieldWorlds : + FieldWorlds baselineReleased allocationSchema newFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc (baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields)).2)) + site.shape.tailArguments = .ok callValues) + (arity : callValues.size = source.signature.params.size) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := parameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := index + values := parameters + credits := #[] } + rewrittenStack } + let baselineAllocation := baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + let rewrittenAllocation := + (logicalHotResetStore rewrittenStore location).allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + let baselineTarget : Machine := + { store := baselineAllocation.1 + heapFuel := remaining + control := .running + { definition := source, values := callValues } baselineStack } + let rewrittenTarget : Machine := + { store := rewrittenAllocation.1 + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition, values := callValues } + rewrittenStack } + Steps baselineContext .logical (2 * site.shape.fieldCount + 3) + baselineMachine baselineTarget ∧ + Steps rewrittenContext .logical 4 rewrittenMachine rewrittenTarget ∧ + StableLiveMachineRel limits validation baselineTarget rewrittenTarget := by + dsimp only + obtain ⟨sourceAt, resetAt, hotAt, _coldAt⟩ := rewrite.acceptedAt found + obtain ⟨sourceSchema, siteAllocationSchema, sourceSchemaAt, + siteAllocationSchemaAt, _sourceFields, _allocationFields, + sourceLayout, allocationLayout⟩ := + evalRuntimeSchemas site baselineSchemas + have allocationSchemaEq : siteAllocationSchema = allocationSchema := by + exact Option.some.inj (siteAllocationSchemaAt.symm.trans allocationSchemaAt) + subst siteAllocationSchema + have rewrittenSourceSchemaAt : + rewrittenContext.schemas .shared site.shape.sourceConstructor = + some sourceSchema := by + simpa [baselineSchemas, rewrittenSchemas] using sourceSchemaAt + have rewrittenAllocationSchemaAt : + rewrittenContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema := by + simpa [baselineSchemas, rewrittenSchemas] using allocationSchemaAt + have rewrittenBoxAt : rewrittenStore.get? location = some + ⟨.shared, 1, .ctorN site.shape.sourceConstructor fields⟩ := by + rw [← heap.get?_eq location] + exact sourceBoxAt + have baselineResetContents : HeapContentsEq baselineReleased + (logicalHotResetStore baselineStore location) := + hotPrefix_contents sourceBoxAt owned retained released + have resetCongruence : HeapContentsEq + (logicalHotResetStore baselineStore location) + (logicalHotResetStore rewrittenStore location) := by + simpa [logicalHotResetStore] using + (((heap.tickResetAttempt).kill location).tickHotReset) + have resetContents : HeapContentsEq baselineReleased + (logicalHotResetStore rewrittenStore location) := + baselineResetContents.trans resetCongruence + let baselineAllocation := baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + let rewrittenAllocation := + (logicalHotResetStore rewrittenStore location).allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + have allocationContents : HeapContentsEq baselineAllocation.1 + rewrittenAllocation.1 := by + simpa [baselineAllocation, rewrittenAllocation] using + resetContents.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + have allocationLocation : baselineAllocation.2 = + rewrittenAllocation.2 := by + simpa [baselineAllocation, rewrittenAllocation] using + resetContents.allocNode_location .shared + (.ctorN site.shape.allocationConstructor newFields) + have rewrittenFieldWorlds : FieldWorlds + (logicalHotResetStore rewrittenStore location) + allocationSchema newFields := + resetContents.fieldWorlds baselineFieldWorlds + have rewrittenTailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc rewrittenAllocation.2)) + site.shape.tailArguments = .ok callValues := by + rw [← allocationLocation] + simpa [baselineAllocation] using tailResolved + have sourceNonempty : source.blocks.isEmpty = false := + blocks_nonempty_of_getElem sourceAt + have rewrittenNonempty : rewrite.definition.blocks.isEmpty = false := + blocks_nonempty_of_getElem resetAt + have rewrittenArity : callValues.size = + rewrite.definition.signature.params.size := by + simpa using arity + let baselineMachine : Machine := + { store := baselineStore + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := parameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := index + values := parameters + credits := #[] } + rewrittenStack } + have baselineExecution : Steps baselineContext .logical + (2 * site.shape.fieldCount + 3) baselineMachine + { store := baselineAllocation.1 + heapFuel := remaining + control := .running + { definition := source, values := callValues } baselineStack } := by + simpa [baselineMachine, baselineAllocation] using + baselineAcceptedControl site + (context := baselineContext) (interpretation := .logical) + (definition := source) (blockId := index) + (parameters := parameters) (fields := fields) + (newFields := newFields) (callValues := callValues) + (location := location) (machine := baselineMachine) + (retainedStore := baselineRetained) + (releasedStore := baselineReleased) (remaining := remaining) + (allocationSchema := allocationSchema) (stack := baselineStack) + sourceAt (by rfl) parameterCount fieldCount sourceResolved sourceBoxAt + rfl retained released allocationSchemaAt allocationResolved + baselineFieldWorlds tailResolved arity sourceNonempty + have rewrittenExecution : Steps rewrittenContext .logical 4 + rewrittenMachine + { store := rewrittenAllocation.1 + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition, values := callValues } + rewrittenStack } := by + simpa [rewrittenMachine, rewrittenAllocation, logicalHotResetStore] using + hotLogicalAcceptedControl site + (context := rewrittenContext) (definition := rewrite.definition) + (resetId := index) (hotId := source.blocks.size + helperOffset) + (coldId := source.blocks.size + helperOffset + 1) + (parameters := parameters) (fields := fields) + (newFields := newFields) (callValues := callValues) + (location := location) + (box := ⟨.shared, 1, + .ctorN site.shape.sourceConstructor fields⟩) + (sourceSchema := sourceSchema) (allocationSchema := allocationSchema) + (machine := rewrittenMachine) (stack := rewrittenStack) + resetAt hotAt rewrittenSourceSchemaAt rewrittenAllocationSchemaAt + sourceLayout allocationLayout (by rfl) parameterCount fieldCount + sourceResolved (ConstructorView.of_box rewrittenBoxAt rfl rfl) rfl + allocationResolved + (by simpa [logicalHotResetStore] using rewrittenFieldWorlds) + (by simpa [rewrittenAllocation, logicalHotResetStore] using + rewrittenTailResolved) + rewrittenArity rewrittenNonempty + have outputFuel : remaining ≤ rewrittenFuel := + Nat.le_trans (releaseShared_remaining_le released) fuel + exact ⟨by simpa [baselineMachine, baselineAllocation] using baselineExecution, + by simpa [rewrittenMachine, rewrittenAllocation] using rewrittenExecution, + StableLiveMachineRel.contentsRecursiveCall rewrite allocationContents outputFuel + (IxIR1.Sim.RValsIso.refl callValues.toList) stack⟩ + +/-- The live cold accepted macro is likewise compositional over exact semantic +contents. The baseline retain batch is transported to the rewritten store; +the two parent decrements then agree in contents while the rewritten reset +adds only observational counters. -/ +theorem acceptedColdStableLiveSimulation {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {index helperOffset : Nat} {block : Block} + {site : Reuse.Site limits validation block} + (found : Reuse.FunctionDecisions.At rewrite.decisions index helperOffset + block (.accepted site)) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + (baselineSchemas : baselineContext.schemas = validation.schemas) + (rewrittenSchemas : rewrittenContext.schemas = validation.schemas) + {baselineStore rewrittenStore baselineRetained : Store} + (heap : HeapContentsEq baselineStore rewrittenStore) + {parameters fields newFields callValues : Array RVal} + {location fieldFuel rewrittenFuel rc retainedRc : Nat} + {baselineStack rewrittenStack : List Continuation} + (stack : StableLiveStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {allocationSchema : CtorSchema} + (fuel : fieldFuel + 1 ≤ rewrittenFuel) + (allocationSchemaAt : + baselineContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (sourceResolved : resolveAtom parameters (.reg site.shape.source) = + .ok (.loc location)) + (sourceBoxAt : baselineStore.get? location = some + ⟨.shared, rc, .ctorN site.shape.sourceConstructor fields⟩) + (shared : 1 < rc) + (retained : RetainSharedMany baselineStore fields baselineRetained) + (retainedAt : baselineRetained.get? location = some + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩) + (allocationResolved : resolveAtoms + (baselinePrefixValues parameters fields) + site.shape.allocationArguments = .ok newFields) + (baselineFieldWorlds : FieldWorlds + (baselineDecrementStore baselineRetained location + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩) + allocationSchema newFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc ((baselineDecrementStore baselineRetained location + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩).allocNode .shared + (.ctorN site.shape.allocationConstructor newFields)).2)) + site.shape.tailArguments = .ok callValues) + (arity : callValues.size = source.signature.params.size) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := parameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := index + values := parameters + credits := #[] } + rewrittenStack } + let baselineReleased := baselineDecrementStore baselineRetained location + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩ + let baselineAllocation := baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + ∃ rewrittenRetained, + let rewrittenReleased := baselineDecrementStore rewrittenRetained location + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩ + let rewrittenReset := rewrittenReleased.tickResetAttempt.tickColdReset + let rewrittenAllocation := rewrittenReset.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + let baselineTarget : Machine := + { store := baselineAllocation.1 + heapFuel := fieldFuel + control := .running + { definition := source, values := callValues } baselineStack } + let rewrittenTarget : Machine := + { store := rewrittenAllocation.1 + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition, values := callValues } + rewrittenStack } + RetainSharedMany rewrittenStore fields rewrittenRetained ∧ + Steps baselineContext interpretation + (2 * site.shape.fieldCount + 3) baselineMachine baselineTarget ∧ + Steps rewrittenContext interpretation 4 rewrittenMachine + rewrittenTarget ∧ + StableLiveMachineRel limits validation baselineTarget rewrittenTarget := by + dsimp only + obtain ⟨sourceAt, resetAt, _hotAt, coldAt⟩ := rewrite.acceptedAt found + obtain ⟨sourceSchema, siteAllocationSchema, sourceSchemaAt, + siteAllocationSchemaAt, _sourceFields, _allocationFields, + sourceLayout, allocationLayout⟩ := + evalRuntimeSchemas site baselineSchemas + have allocationSchemaEq : siteAllocationSchema = allocationSchema := by + exact Option.some.inj (siteAllocationSchemaAt.symm.trans allocationSchemaAt) + subst siteAllocationSchema + have rewrittenSourceSchemaAt : + rewrittenContext.schemas .shared site.shape.sourceConstructor = + some sourceSchema := by + simpa [baselineSchemas, rewrittenSchemas] using sourceSchemaAt + have rewrittenAllocationSchemaAt : + rewrittenContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema := by + simpa [baselineSchemas, rewrittenSchemas] using allocationSchemaAt + have rewrittenBoxAt : rewrittenStore.get? location = some + ⟨.shared, rc, .ctorN site.shape.sourceConstructor fields⟩ := by + rw [← heap.get?_eq location] + exact sourceBoxAt + obtain ⟨rewrittenRetained, rewrittenRetainedRun, retainedContents⟩ := + heap.retainSharedMany retained + have rewrittenRetainedAt : rewrittenRetained.get? location = some + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩ := by + rw [← retainedContents.get?_eq location] + exact retainedAt + obtain ⟨actualRetainedRc, actualRetainedAt, baselineReleasedRun, + _baselineResetRetained, _baselineHeapEq⟩ := + coldPrefix_commutes (heapFuel := fieldFuel) sourceBoxAt shared retained + have actualBoxEq : + (⟨.shared, actualRetainedRc, + .ctorN site.shape.sourceConstructor fields⟩ : IxIR1.NodeBox) = + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩ := + Option.some.inj (actualRetainedAt.symm.trans retainedAt) + have actualRcEq : actualRetainedRc = retainedRc := by + cases actualBoxEq + rfl + subst actualRetainedRc + obtain ⟨rewrittenActualRc, rewrittenActualAt, _rewrittenReleasedRun, + rewrittenResetRetained, _rewrittenHeapEq⟩ := + coldPrefix_commutes (heapFuel := fieldFuel) rewrittenBoxAt shared + rewrittenRetainedRun + have rewrittenBoxEq : + (⟨.shared, rewrittenActualRc, + .ctorN site.shape.sourceConstructor fields⟩ : IxIR1.NodeBox) = + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩ := + Option.some.inj (rewrittenActualAt.symm.trans rewrittenRetainedAt) + have rewrittenRcEq : rewrittenActualRc = retainedRc := by + cases rewrittenBoxEq + rfl + subst rewrittenActualRc + let baselineReleased := baselineDecrementStore baselineRetained location + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩ + let rewrittenReleased := baselineDecrementStore rewrittenRetained location + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩ + let rewrittenReset := rewrittenReleased.tickResetAttempt.tickColdReset + have releasedContents : HeapContentsEq baselineReleased + rewrittenReleased := by + simpa [baselineReleased, rewrittenReleased, baselineDecrementStore] using + (retainedContents.rcTick.setBox location + { (⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩ : IxIR1.NodeBox) with + rc := retainedRc - 1 }) + have resetContents : HeapContentsEq baselineReleased rewrittenReset := by + apply releasedContents.trans + exact ⟨rfl⟩ + let baselineAllocation := baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + let rewrittenAllocation := rewrittenReset.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + have allocationContents : HeapContentsEq baselineAllocation.1 + rewrittenAllocation.1 := by + simpa [baselineAllocation, rewrittenAllocation] using + resetContents.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + have allocationLocation : baselineAllocation.2 = + rewrittenAllocation.2 := by + simpa [baselineAllocation, rewrittenAllocation] using + resetContents.allocNode_location .shared + (.ctorN site.shape.allocationConstructor newFields) + have rewrittenFieldWorlds : + FieldWorlds rewrittenReset allocationSchema newFields := + resetContents.fieldWorlds baselineFieldWorlds + have rewrittenTailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc rewrittenAllocation.2)) + site.shape.tailArguments = .ok callValues := by + rw [← allocationLocation] + simpa [baselineReleased, baselineAllocation] using tailResolved + have sourceNonempty : source.blocks.isEmpty = false := + blocks_nonempty_of_getElem sourceAt + have rewrittenNonempty : rewrite.definition.blocks.isEmpty = false := + blocks_nonempty_of_getElem resetAt + have rewrittenArity : callValues.size = + rewrite.definition.signature.params.size := by + simpa using arity + let baselineMachine : Machine := + { store := baselineStore + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := parameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := index + values := parameters + credits := #[] } + rewrittenStack } + have baselineExecution : Steps baselineContext interpretation + (2 * site.shape.fieldCount + 3) baselineMachine + { store := baselineAllocation.1 + heapFuel := fieldFuel + control := .running + { definition := source, values := callValues } baselineStack } := by + simpa [baselineMachine, baselineReleased, baselineAllocation] using + baselineAcceptedControl site + (context := baselineContext) (interpretation := interpretation) + (definition := source) (blockId := index) + (parameters := parameters) (fields := fields) + (newFields := newFields) (callValues := callValues) + (location := location) (machine := baselineMachine) + (retainedStore := baselineRetained) + (releasedStore := baselineReleased) (remaining := fieldFuel) + (allocationSchema := allocationSchema) (stack := baselineStack) + sourceAt (by rfl) parameterCount fieldCount sourceResolved sourceBoxAt + rfl retained (by simpa [baselineReleased] using baselineReleasedRun) + allocationSchemaAt allocationResolved + (by simpa [baselineReleased] using baselineFieldWorlds) + (by simpa [baselineReleased, baselineAllocation] using tailResolved) + arity sourceNonempty + have rewrittenExecution : Steps rewrittenContext interpretation 4 + rewrittenMachine + { store := rewrittenAllocation.1 + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition, values := callValues } + rewrittenStack } := by + simpa [rewrittenMachine, rewrittenReset, rewrittenReleased, + rewrittenAllocation] using + coldAcceptedControl site + (context := rewrittenContext) (interpretation := interpretation) + (definition := rewrite.definition) (resetId := index) + (hotId := source.blocks.size + helperOffset) + (coldId := source.blocks.size + helperOffset + 1) + (parameters := parameters) (fields := fields) + (newFields := newFields) (callValues := callValues) + (location := location) + (box := ⟨.shared, rc, + .ctorN site.shape.sourceConstructor fields⟩) + (sourceSchema := sourceSchema) (allocationSchema := allocationSchema) + (machine := rewrittenMachine) (resetStore := rewrittenReset) + (stack := rewrittenStack) resetAt coldAt rewrittenSourceSchemaAt + rewrittenAllocationSchemaAt sourceLayout allocationLayout (by rfl) + parameterCount fieldCount sourceResolved + (ConstructorView.of_box rewrittenBoxAt rfl rfl) shared + (by simpa [rewrittenMachine, coldResetStartStore, rewrittenReset, + rewrittenReleased] using + rewrittenResetRetained) + allocationResolved + (by simpa [rewrittenReset] using rewrittenFieldWorlds) + (by simpa [rewrittenAllocation] using rewrittenTailResolved) + rewrittenArity rewrittenNonempty + have outputFuel : fieldFuel ≤ rewrittenFuel := by omega + refine ⟨rewrittenRetained, rewrittenRetainedRun, ?_, ?_, ?_⟩ + · simpa [baselineMachine, baselineReleased, baselineAllocation] using + baselineExecution + · simpa [rewrittenMachine, rewrittenReleased, rewrittenReset, + rewrittenAllocation] using rewrittenExecution + · exact StableLiveMachineRel.contentsRecursiveCall rewrite allocationContents + outputFuel (IxIR1.Sim.RValsIso.refl callValues.toList) stack + +/-! ## Live accepted physical macro from an isomorphic state -/ + +/-- A physical hot accepted block composes with an existing live-location +bijection. Baseline and rewritten register files, constructor fields, and +continuations may already use different locations. The consumed source pair +is replaced by the reused-target/fresh-baseline pair, all surviving pairs are +preserved, and both executions rejoin at a stable recursive-call state. -/ +theorem acceptedHotPhysicalStableLiveSimulationIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {index helperOffset : Nat} {block : Block} + {site : Reuse.Site limits validation block} + (found : Reuse.FunctionDecisions.At rewrite.decisions index helperOffset + block (.accepted site)) + {baselineContext rewrittenContext : Eval.Context} + (baselineSchemas : baselineContext.schemas = validation.schemas) + (rewrittenSchemas : rewrittenContext.schemas = validation.schemas) + {baselineStore rewrittenStore baselineRetained baselineReleased : Store} + (inputIso : IxIR1.Sim.HeapIso rewrittenStore.heap baselineStore.heap) + {baselineParameters rewrittenParameters baselineFields rewrittenFields + baselineNewFields rewrittenNewFields baselineCallValues : Array RVal} + {baselineLocation rewrittenLocation fieldFuel remaining rewrittenFuel : + Nat} + {baselineStack rewrittenStack : List Continuation} + (parameters : LiveValuesIso source index 0 + (fun baselineLocation rewrittenLocation => + inputIso.locRel rewrittenLocation baselineLocation) + baselineParameters rewrittenParameters) + (stackAvoids : StableLiveStackAvoids limits validation + (fun baselineLocation rewrittenLocation => + inputIso.locRel rewrittenLocation baselineLocation) + rewrittenLocation baselineStack rewrittenStack) + {baselineBefore baselineAfter rewrittenBefore rewrittenAfter : + List IxIR1.Sim.Root} + {allocationSchema : CtorSchema} + (fuel : fieldFuel + 1 ≤ rewrittenFuel) + (locations : inputIso.locRel rewrittenLocation baselineLocation) + (allocationSchemaAt : + baselineContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (parameterCount : baselineParameters.size = site.shape.parameterCount) + (fieldCount : baselineFields.size = site.shape.fieldCount) + (baselineSourceResolved : + resolveAtom baselineParameters (.reg site.shape.source) = + .ok (.loc baselineLocation)) + (rewrittenSourceResolved : + resolveAtom rewrittenParameters (.reg site.shape.source) = + .ok (.loc rewrittenLocation)) + (baselineAt : baselineStore.get? baselineLocation = some + ⟨.shared, 1, + .ctorN site.shape.sourceConstructor baselineFields⟩) + (rewrittenAt : rewrittenStore.get? rewrittenLocation = some + ⟨.shared, 1, + .ctorN site.shape.sourceConstructor rewrittenFields⟩) + (baselineOwned : IxIR1.Sim.RootOwnership baselineStore.heap + (⟨.shared, .loc baselineLocation⟩ :: baselineBefore)) + (rewrittenOwned : IxIR1.Sim.RootOwnership rewrittenStore.heap + (⟨.shared, .loc rewrittenLocation⟩ :: rewrittenBefore)) + (retained : RetainSharedMany baselineStore baselineFields + baselineRetained) + (released : releaseShared (fieldFuel + 1) baselineRetained + (.loc baselineLocation) = .ok (baselineReleased, remaining)) + (baselinePartition : + (IxIR1.Sim.rootsFor .shared baselineFields.toList ++ + baselineBefore).Perm + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ + baselineAfter)) + (rewrittenPartition : + (IxIR1.Sim.rootsFor .shared rewrittenFields.toList ++ + rewrittenBefore).Perm + (IxIR1.Sim.rootsFor .shared rewrittenNewFields.toList ++ + rewrittenAfter)) + (mapped : MappedValuesInRoots site.shape + (baselinePrefixValues rewrittenParameters rewrittenFields) + (IxIR1.Sim.rootsFor .shared rewrittenNewFields.toList ++ + rewrittenAfter)) + (baselineAllocationResolved : resolveAtoms + (baselinePrefixValues baselineParameters baselineFields) + site.shape.allocationArguments = .ok baselineNewFields) + (rewrittenAllocationResolved : resolveAtoms + (baselinePrefixValues rewrittenParameters rewrittenFields) + site.shape.allocationArguments = .ok rewrittenNewFields) + (baselineFieldWorlds : + FieldWorlds baselineReleased allocationSchema baselineNewFields) + (rewrittenFieldWorlds : FieldWorlds + (physicalHotResetStore rewrittenStore rewrittenLocation) + allocationSchema rewrittenNewFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues baselineParameters baselineFields).push + (.loc (baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor baselineNewFields)).2)) + site.shape.tailArguments = .ok baselineCallValues) + (arity : baselineCallValues.size = source.signature.params.size) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := baselineParameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := index + values := rewrittenParameters + credits := #[] } + rewrittenStack } + let baselineAllocation := baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor baselineNewFields) + ∃ physical : Store, + ∃ outputIso : IxIR1.Sim.HeapIso physical.heap + baselineAllocation.1.heap, + ∃ physicalCallValues : Array RVal, + physicalHotReuseStore rewrittenStore rewrittenLocation + (.ctorN site.shape.allocationConstructor rewrittenNewFields) + allocationSchema.fields.size = .ok physical ∧ + IxIR1.Sim.RootOwnership physical.heap + (⟨.shared, .loc rewrittenLocation⟩ :: rewrittenAfter) ∧ + IxIR1.Sim.RootOwnership baselineAllocation.1.heap + (⟨.shared, .loc baselineAllocation.2⟩ :: baselineAfter) ∧ + outputIso.locRel rewrittenLocation baselineAllocation.2 ∧ + (∀ {rewrittenCandidate baselineCandidate : Nat}, + inputIso.locRel rewrittenCandidate baselineCandidate → + rewrittenCandidate ≠ rewrittenLocation → + outputIso.locRel rewrittenCandidate baselineCandidate) ∧ + Steps baselineContext .physical (2 * site.shape.fieldCount + 3) + baselineMachine + { store := baselineAllocation.1 + heapFuel := remaining + control := .running + { definition := source, values := baselineCallValues } + baselineStack } ∧ + Steps rewrittenContext .physical 4 rewrittenMachine + { store := physical + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition, values := physicalCallValues } + rewrittenStack } ∧ + IxIR1.Sim.RValsIso + (fun baselineCandidate rewrittenCandidate => + outputIso.locRel rewrittenCandidate baselineCandidate) + baselineCallValues.toList physicalCallValues.toList ∧ + StableLiveStackIso limits validation + (fun baselineCandidate rewrittenCandidate => + outputIso.locRel rewrittenCandidate baselineCandidate) + baselineStack rewrittenStack ∧ + StableLiveMachineRel limits validation + { store := baselineAllocation.1 + heapFuel := remaining + control := .running + { definition := source, values := baselineCallValues } + baselineStack } + { store := physical + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition, values := physicalCallValues } + rewrittenStack } := by + dsimp only + obtain ⟨sourceAt, resetAt, hotAt, _coldAt⟩ := rewrite.acceptedAt found + obtain ⟨sourceSchema, siteAllocationSchema, sourceSchemaAt, + siteAllocationSchemaAt, sourceSchemaFields, allocationSchemaFields, + sourceLayout, allocationLayout⟩ := + evalRuntimeSchemas site baselineSchemas + have allocationSchemaEq : siteAllocationSchema = allocationSchema := by + exact Option.some.inj (siteAllocationSchemaAt.symm.trans allocationSchemaAt) + subst siteAllocationSchema + have rewrittenSourceSchemaAt : + rewrittenContext.schemas .shared site.shape.sourceConstructor = + some sourceSchema := by + simpa [baselineSchemas, rewrittenSchemas] using sourceSchemaAt + have rewrittenAllocationSchemaAt : + rewrittenContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema := by + simpa [baselineSchemas, rewrittenSchemas] using allocationSchemaAt + have uniformAllocationFields : allocationSchema.fields = + Array.replicate site.shape.fieldCount .shared := + allocationSchemaFields.trans sourceSchemaFields + have parameterSizes : baselineParameters.size = rewrittenParameters.size := by + exact parameters.length + have rewrittenParameterCount : rewrittenParameters.size = + site.shape.parameterCount := parameterSizes.symm.trans parameterCount + obtain ⟨leftBox, rightBox, leftLive, rightLive, boxesRelated⟩ := + inputIso.related_live locations + have leftBoxEq : leftBox = + ⟨.shared, 1, + .ctorN site.shape.sourceConstructor rewrittenFields⟩ := + Option.some.inj (leftLive.symm.trans rewrittenAt) + have rightBoxEq : rightBox = + ⟨.shared, 1, + .ctorN site.shape.sourceConstructor baselineFields⟩ := + Option.some.inj (rightLive.symm.trans baselineAt) + subst leftBox + subst rightBox + have rewrittenToBaselineFields : IxIR1.Sim.RValsIso inputIso.locRel + rewrittenFields.toList baselineFields.toList := by + cases boxesRelated.node with + | ctor related => exact related + have fieldsRelated : IxIR1.Sim.RValsIso + (fun baselineLocation rewrittenLocation => + inputIso.locRel rewrittenLocation baselineLocation) + baselineFields.toList rewrittenFields.toList := + rvalsIso_symm rewrittenToBaselineFields + have fieldSizes : baselineFields.size = rewrittenFields.size := by + simpa using rvalsIso_length_eq fieldsRelated + have rewrittenFieldCount : rewrittenFields.size = site.shape.fieldCount := + fieldSizes.symm.trans fieldCount + have prefixLive : LiveValuesIso source index 0 + (fun baselineLocation rewrittenLocation => + inputIso.locRel rewrittenLocation baselineLocation) + (baselinePrefixValues baselineParameters baselineFields) + (baselinePrefixValues rewrittenParameters rewrittenFields) := by + simpa [baselinePrefixValues] using + (parameters.append fieldsRelated).append fieldsRelated + have allocationLiveAt : AtomsLiveFrom source index + (site.shape.releasePosition + 1) + site.shape.allocationArguments := + AtomsLiveFrom.instruction sourceAt site.fits.allocation (by + intro atom member + exact Liveness.InstrUsesAtom.alloc member) + have allocationLive : AtomsLiveFrom source index 0 + site.shape.allocationArguments := + allocationLiveAt.mono (Nat.zero_le _) + obtain ⟨actualRewrittenNewFields, actualRewrittenResolved, + newFieldsRelated⟩ := + prefixLive.resolveAtoms allocationLive baselineAllocationResolved + have actualNewFieldsEq : actualRewrittenNewFields = rewrittenNewFields := + Except.ok.inj + (actualRewrittenResolved.symm.trans rewrittenAllocationResolved) + subst actualRewrittenNewFields + have prefixContents : HeapContentsEq baselineReleased + (logicalHotResetStore baselineStore baselineLocation) := + hotPrefix_contents baselineAt baselineOwned retained released + have baselineMissing : baselineReleased.get? baselineLocation = none := by + rw [prefixContents.get?_eq baselineLocation] + change (logicalHotResetStore baselineStore baselineLocation).heap.get? + baselineLocation = none + rw [logicalHotResetStore_heap] + exact IxIR1.Sim.get?_kill_same baselineAt + have baselineNewFieldsAvoid : ∀ value ∈ baselineNewFields.toList, + value ≠ .loc baselineLocation := + FieldWorlds.avoidsMissing uniformAllocationFields baselineFieldWorlds + baselineMissing + have rewrittenNewFieldsAvoid : ∀ value ∈ rewrittenNewFields.toList, + value ≠ .loc rewrittenLocation := + rvalsIso_right_avoids_of_left inputIso locations newFieldsRelated + baselineNewFieldsAvoid + have restrictedNewFields : IxIR1.Sim.RValsIso + (fun rewrittenCandidate baselineCandidate => + inputIso.locRel rewrittenCandidate baselineCandidate ∧ + rewrittenCandidate ≠ rewrittenLocation) + rewrittenNewFields.toList baselineNewFields.toList := + rvalsIso_restrict_left (rvalsIso_symm newFieldsRelated) + rewrittenNewFieldsAvoid + let baselineAllocation := baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor baselineNewFields) + obtain ⟨physical, reused, outputIso, physicalOwned, + baselineAllocationOwned, outputResult, outputExtends⟩ := + hotPrefixReuse_sound_under_iso + (baselineStore := baselineStore) (rewrittenStore := rewrittenStore) + (baselineRetained := baselineRetained) + (baselineReleased := baselineReleased) + (baselineLocation := baselineLocation) + (rewrittenLocation := rewrittenLocation) + (oldCid := site.shape.sourceConstructor) + (newCid := site.shape.allocationConstructor) + (baselineFields := baselineFields) (rewrittenFields := rewrittenFields) + (baselineNewFields := baselineNewFields) + (rewrittenNewFields := rewrittenNewFields) (fieldFuel := fieldFuel) + (remaining := remaining) (baselineBefore := baselineBefore) + (baselineAfter := baselineAfter) (rewrittenBefore := rewrittenBefore) + (rewrittenAfter := rewrittenAfter) allocationSchema.fields.size inputIso + locations baselineAt rewrittenAt baselineOwned rewrittenOwned retained + released baselinePartition rewrittenPartition restrictedNewFields + obtain ⟨physicalAgain, reusedAgain, physicalHeap⟩ := + physicalHotReuseStore_ok + (.ctorN site.shape.allocationConstructor rewrittenNewFields) + allocationSchema.fields.size rewrittenAt + have physicalEq : physicalAgain = physical := + Except.ok.inj (reusedAgain.symm.trans reused) + subst physicalAgain + have physicalAt : physical.get? rewrittenLocation = some + ⟨.shared, 1, + .ctorN site.shape.allocationConstructor rewrittenNewFields⟩ := by + change physical.heap.get? rewrittenLocation = _ + rw [physicalHeap] + exact IxIR1.Sim.get?_reuseSharedNodeStore_same rewrittenAt + let outputRel : Nat → Nat → Prop := + fun baselineCandidate rewrittenCandidate => + outputIso.locRel rewrittenCandidate baselineCandidate + have translatedPrefix : TranslatedValuesIso site.shape outputRel + (baselinePrefixValues baselineParameters baselineFields) + (helperEntryValues site.shape.source rewrittenParameters + rewrittenFields) := by + intro sourceId targetId baselineValue relevant translated baselineValueAt + obtain ⟨rewrittenValue, rewrittenValueAt, inputValueRelated⟩ := + prefixLive.related + (plannerValueLiveAtEntry site sourceAt relevant) baselineValueAt + have helperValueAt := + valuesRel_helperEntry rewrittenParameterCount rewrittenFieldCount + site.fits.sourceBound sourceId targetId translated + rw [rewrittenValueAt] at helperValueAt + have supported := + mapped sourceId targetId rewrittenValue relevant translated + rewrittenValueAt + have rewrittenValueAvoid : rewrittenValue ≠ .loc rewrittenLocation := + by + cases rewrittenValue with + | loc location => + obtain ⟨world, member⟩ := supported + rcases List.mem_append.mp member with fieldMember | survivorMember + · rw [IxIR1.Sim.rootsFor, List.mem_map] at fieldMember + obtain ⟨field, fieldMem, rootEq⟩ := fieldMember + have fieldEq : field = .loc location := + congrArg IxIR1.Sim.Root.value rootEq + subst field + exact rewrittenNewFieldsAvoid _ fieldMem + · exact physicalOwned.sole_root_ne physicalAt survivorMember + | lit literal => intro impossible; cases impossible + | erased => intro impossible; cases impossible + have outputValueRelated : IxIR1.Sim.RValIso outputRel + baselineValue rewrittenValue := by + cases inputValueRelated with + | loc locationRelated => + apply IxIR1.Sim.RValIso.loc + apply outputExtends locationRelated + intro same + apply rewrittenValueAvoid + cases same + rfl + | lit => exact .lit + | erased => exact .erased + exact ⟨rewrittenValue, helperValueAt.symm, outputValueRelated⟩ + have baselinePrefixSize : + (baselinePrefixValues baselineParameters baselineFields).size = + site.shape.parameterCount + 2 * site.shape.fieldCount := by + simp [baselinePrefixValues, parameterCount, fieldCount, Nat.two_mul] + have rewrittenHelperSize : + (helperEntryValues site.shape.source rewrittenParameters + rewrittenFields).size = + site.shape.fieldCount + (site.shape.parameterCount - 1) := by + simp [helperEntryValues, List.length_eraseIdx, rewrittenParameterCount, + rewrittenFieldCount, site.fits.sourceBound] + have translatedAfterAllocation : TranslatedValuesIso site.shape outputRel + ((baselinePrefixValues baselineParameters baselineFields).push + (.loc baselineAllocation.2)) + ((helperEntryValues site.shape.source rewrittenParameters + rewrittenFields).push (.loc rewrittenLocation)) := + TranslatedValuesIso.pushResult translatedPrefix (.loc outputResult) + baselinePrefixSize rewrittenHelperSize site.fits.sourceBound + have sourceNonempty : source.blocks.isEmpty = false := + blocks_nonempty_of_getElem sourceAt + have rewrittenNonempty : rewrite.definition.blocks.isEmpty = false := + blocks_nonempty_of_getElem resetAt + have rewrittenArity : baselineCallValues.size = + rewrite.definition.signature.params.size := by + simpa using arity + let baselineMachine : Machine := + { store := baselineStore + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := baselineParameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := index + values := rewrittenParameters + credits := #[] } + rewrittenStack } + have baselineExecution : Steps baselineContext .physical + (2 * site.shape.fieldCount + 3) baselineMachine + { store := baselineAllocation.1 + heapFuel := remaining + control := .running + { definition := source, values := baselineCallValues } + baselineStack } := by + simpa [baselineMachine, baselineAllocation] using + baselineAcceptedControl site + (context := baselineContext) (interpretation := .physical) + (definition := source) (blockId := index) + (parameters := baselineParameters) (fields := baselineFields) + (newFields := baselineNewFields) (callValues := baselineCallValues) + (location := baselineLocation) (machine := baselineMachine) + (retainedStore := baselineRetained) + (releasedStore := baselineReleased) (remaining := remaining) + (allocationSchema := allocationSchema) (stack := baselineStack) + sourceAt (by rfl) parameterCount fieldCount baselineSourceResolved + baselineAt rfl retained released allocationSchemaAt + baselineAllocationResolved baselineFieldWorlds tailResolved arity + sourceNonempty + obtain ⟨physicalCallValues, rewrittenExecution, callsRelated⟩ := + hotPhysicalAcceptedControlTranslated site + (context := rewrittenContext) (definition := rewrite.definition) + (resetId := index) (hotId := source.blocks.size + helperOffset) + (coldId := source.blocks.size + helperOffset + 1) + (parameters := rewrittenParameters) (fields := rewrittenFields) + (newFields := rewrittenNewFields) + (baselineTailValues := + (baselinePrefixValues baselineParameters baselineFields).push + (.loc baselineAllocation.2)) + (baselineCallValues := baselineCallValues) + (location := rewrittenLocation) + (box := ⟨.shared, 1, + .ctorN site.shape.sourceConstructor rewrittenFields⟩) + (sourceSchema := sourceSchema) (allocationSchema := allocationSchema) + (machine := rewrittenMachine) (stack := rewrittenStack) + (store := physical) (locRel := outputRel) resetAt hotAt + rewrittenSourceSchemaAt rewrittenAllocationSchemaAt sourceLayout + allocationLayout (by rfl) rewrittenParameterCount rewrittenFieldCount + rewrittenSourceResolved + (ConstructorView.of_box rewrittenAt rfl rfl) rfl + rewrittenAllocationResolved + (by simpa [physicalHotResetStore] using rewrittenFieldWorlds) + (by simpa [physicalHotReuseStore, physicalHotResetStore] using reused) + translatedAfterAllocation + (by simpa [baselineAllocation] using tailResolved) rewrittenArity + rewrittenNonempty + have outputStack : StableLiveStackIso limits validation outputRel + baselineStack rewrittenStack := + stackAvoids.transportRelation (by + intro baselineCandidate rewrittenCandidate related different + exact outputExtends related different) + have outputFuel : remaining ≤ rewrittenFuel := + Nat.le_trans (releaseShared_remaining_le released) fuel + have relatedMachine : StableLiveMachineRel limits validation + { store := baselineAllocation.1 + heapFuel := remaining + control := .running + { definition := source, values := baselineCallValues } + baselineStack } + { store := physical + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition, values := physicalCallValues } + rewrittenStack } := + StableLiveMachineRel.isomorphicRecursiveCall rewrite outputIso outputFuel + callsRelated outputStack + exact ⟨physical, outputIso, physicalCallValues, reused, physicalOwned, + by simpa [baselineAllocation] using baselineAllocationOwned, + by simpa [baselineAllocation] using outputResult, + outputExtends, + by simpa [baselineMachine, baselineAllocation] using baselineExecution, + by simpa [rewrittenMachine] using rewrittenExecution, + callsRelated, outputStack, relatedMachine⟩ + +/-! ## Liveness-indexed dynamic application -/ + +/-- Erased dynamic application releases corresponding arguments and resumes +live-related callers with the common erased value. -/ +theorem unchangedApplyTransferErasedLiveIso {limits : Validate.Limits} + {validation : Validate.Context} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore baselineOut : Store} + {baselineFuel rewrittenFuel baselineRemaining : Nat} + {baselineArguments rewrittenArguments : Array RVal} + {baselineResume rewrittenResume : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (arguments : IxIR1.Sim.RValsIso heap.locRel + baselineArguments.toList rewrittenArguments.toList) + (resume : StableLiveFrameRel limits validation heap.locRel + baselineResume rewrittenResume) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + (released : releaseSharedWork baselineFuel baselineStore + baselineArguments.toList = .ok (baselineOut, baselineRemaining)) : + let baselineTarget : Machine := + { store := baselineOut + heapFuel := baselineRemaining + control := .running + { baselineResume with + values := baselineResume.values.push .erased } + baselineStack } + ∃ rewrittenOut rewrittenRemaining, + let rewrittenTarget : Machine := + { store := rewrittenOut + heapFuel := rewrittenRemaining + control := .running + { rewrittenResume with + values := rewrittenResume.values.push .erased } + rewrittenStack } + releaseSharedWork rewrittenFuel rewrittenStore + rewrittenArguments.toList = .ok (rewrittenOut, rewrittenRemaining) ∧ + ApplyTransfer baselineContext interpretation baselineStore + baselineFuel .erased baselineArguments baselineResume baselineStack + baselineTarget ∧ + ApplyTransfer rewrittenContext interpretation rewrittenStore + rewrittenFuel .erased rewrittenArguments rewrittenResume + rewrittenStack rewrittenTarget ∧ + StableLiveMachineRel limits validation baselineTarget + rewrittenTarget := by + dsimp only + obtain ⟨rewrittenOut, rewrittenRemaining, outputHeap, targetReleased, + outputFuel, outputRelation⟩ := + releaseSharedWork_historyIso heap fuel arguments released + have outputResume : StableLiveFrameRel limits validation outputHeap.locRel + { baselineResume with values := baselineResume.values.push .erased } + { rewrittenResume with values := rewrittenResume.values.push .erased } := by + rw [outputRelation] + exact resume.push .erased + have outputStack : StableLiveStackIso limits validation outputHeap.locRel + baselineStack rewrittenStack := by + rw [outputRelation] + exact stack + refine ⟨rewrittenOut, rewrittenRemaining, targetReleased, + ApplyTransfer.erased released, ApplyTransfer.erased targetReleased, ?_⟩ + exact StableLiveMachineRel.history outputHeap outputFuel + (.running outputResume outputStack) + +/-- Under-saturated PAP application preserves live caller frames while +retaining captures, releasing the old PAP, and allocating related extensions. -/ +theorem unchangedApplyTransferPapUnderLiveIso {limits : Validate.Limits} + {validation : Validate.Context} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore baselineRetained baselineReleased : Store} + {baselineFuel rewrittenFuel baselineRemaining : Nat} + {baselineLocation rewrittenLocation : Nat} + {baselineBox : IxIR1.NodeBox} + {address : Ix.Compiler.Ixon.Address} {arity : Nat} + {baselineCaptured baselineArguments rewrittenArguments : Array RVal} + {baselineResume rewrittenResume : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (locations : heap.locRel baselineLocation rewrittenLocation) + (arguments : IxIR1.Sim.RValsIso heap.locRel + baselineArguments.toList rewrittenArguments.toList) + (resume : StableLiveFrameRel limits validation heap.locRel + baselineResume rewrittenResume) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + (boxAt : baselineStore.get? baselineLocation = some baselineBox) + (shared : baselineBox.world = .shared) + (node : baselineBox.node = .papN address arity baselineCaptured) + (capturedUnder : baselineCaptured.size < arity) + (retained : RetainSharedMany baselineStore baselineCaptured + baselineRetained) + (released : releaseSharedWork baselineFuel baselineRetained + [.loc baselineLocation] = .ok (baselineReleased, baselineRemaining)) + (totalUnder : (baselineCaptured ++ baselineArguments).size < arity) : + let baselineAllocation := baselineReleased.allocNode .shared + (.papN address arity (baselineCaptured ++ baselineArguments)) + let baselineTarget : Machine := + { store := baselineAllocation.1 + heapFuel := baselineRemaining + control := .running + { baselineResume with + values := baselineResume.values.push (.loc baselineAllocation.2) } + baselineStack } + ∃ (rewrittenCaptured : Array RVal) + (rewrittenRetained rewrittenReleased : Store) + (rewrittenRemaining : Nat), + let rewrittenAllocation := rewrittenReleased.allocNode .shared + (.papN address arity (rewrittenCaptured ++ rewrittenArguments)) + let rewrittenTarget : Machine := + { store := rewrittenAllocation.1 + heapFuel := rewrittenRemaining + control := .running + { rewrittenResume with + values := rewrittenResume.values.push + (.loc rewrittenAllocation.2) } + rewrittenStack } + RetainSharedMany rewrittenStore rewrittenCaptured rewrittenRetained ∧ + releaseSharedWork rewrittenFuel rewrittenRetained + [.loc rewrittenLocation] = + .ok (rewrittenReleased, rewrittenRemaining) ∧ + ApplyTransfer baselineContext interpretation baselineStore + baselineFuel (.loc baselineLocation) baselineArguments baselineResume + baselineStack baselineTarget ∧ + ApplyTransfer rewrittenContext interpretation rewrittenStore + rewrittenFuel (.loc rewrittenLocation) rewrittenArguments + rewrittenResume rewrittenStack rewrittenTarget ∧ + StableLiveMachineRel limits validation baselineTarget + rewrittenTarget := by + dsimp only + obtain ⟨rewrittenBox, rewrittenAt, boxes⟩ := heap.boxes locations (by + change baselineStore.heap.get? baselineLocation = some baselineBox + exact boxAt) + have papNodes : IxIR1.Sim.NodeIso heap.locRel + (.papN address arity baselineCaptured) rewrittenBox.node := by + simpa only [← node] using boxes.node + obtain ⟨rewrittenCaptured, rewrittenNode, capturedRelated⟩ := + nodeIso_pap_left papNodes + have rewrittenShared : rewrittenBox.world = .shared := + boxes.world.symm.trans shared + have rewrittenCapturedUnder : rewrittenCaptured.size < arity := by + have sizes : baselineCaptured.size = rewrittenCaptured.size := by + simpa using capturedRelated.lengths + rw [← sizes] + exact capturedUnder + have totalRelated : IxIR1.Sim.RValsIso heap.locRel + (baselineCaptured ++ baselineArguments).toList + (rewrittenCaptured ++ rewrittenArguments).toList := by + simpa using capturedRelated.append arguments + have rewrittenTotalUnder : + (rewrittenCaptured ++ rewrittenArguments).size < arity := by + have sizes : (baselineCaptured ++ baselineArguments).size = + (rewrittenCaptured ++ rewrittenArguments).size := by + simpa using totalRelated.lengths + rw [← sizes] + exact totalUnder + obtain ⟨rewrittenRetained, retainedHeap, targetRetained, + retainedRelation⟩ := + retainSharedMany_historyIso heap capturedRelated retained + have retainedLocation : retainedHeap.locRel baselineLocation + rewrittenLocation := by + rw [retainedRelation] + exact locations + obtain ⟨rewrittenReleased, rewrittenRemaining, releasedHeap, + targetReleased, outputFuel, releasedRelation⟩ := + releaseSharedWork_historyIso retainedHeap fuel + (.cons (.loc retainedLocation) .nil) released + have totalReleased : IxIR1.Sim.RValsIso releasedHeap.locRel + (baselineCaptured ++ baselineArguments).toList + (rewrittenCaptured ++ rewrittenArguments).toList := by + rw [releasedRelation, retainedRelation] + exact totalRelated + let baselineAllocation := baselineReleased.allocNode .shared + (.papN address arity (baselineCaptured ++ baselineArguments)) + let rewrittenAllocation := rewrittenReleased.allocNode .shared + (.papN address arity (rewrittenCaptured ++ rewrittenArguments)) + let outputHeap : IxIR1.Sim.HeapHistoryIso baselineAllocation.1.heap + rewrittenAllocation.1.heap := releasedHeap.alloc (.pap totalReleased) + have oldExtends : ∀ {leftLocation rightLocation}, + heap.locRel leftLocation rightLocation → + outputHeap.locRel leftLocation rightLocation := by + intro leftLocation rightLocation related + apply Or.inr + rw [releasedRelation, retainedRelation] + exact related + have outputResume := (resume.mono oldExtends).push + (IxIR1.Sim.RValIso.loc (Or.inl ⟨rfl, rfl⟩)) + have outputStack := stack.mono oldExtends + refine ⟨rewrittenCaptured, rewrittenRetained, rewrittenReleased, + rewrittenRemaining, targetRetained, targetReleased, + ApplyTransfer.papUnder boxAt shared node capturedUnder retained released + totalUnder, + ApplyTransfer.papUnder (by + change rewrittenStore.heap.get? rewrittenLocation = some rewrittenBox + exact rewrittenAt) rewrittenShared rewrittenNode rewrittenCapturedUnder + targetRetained targetReleased rewrittenTotalUnder, ?_⟩ + exact StableLiveMachineRel.history outputHeap outputFuel + (.running outputResume outputStack) + +/-- Saturated or over-saturated PAP application preserves the live caller, +relates supplied and excess slices, and enters the selected callee rewrite. -/ +theorem unchangedApplyTransferPapFnLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {calleeSource : Function} + (calleeRewrite : Reuse.FunctionRewrite limits validation calleeSource) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore baselineRetained baselineReleased : Store} + {baselineFuel rewrittenFuel baselineRemaining : Nat} + {baselineLocation rewrittenLocation : Nat} + {baselineBox : IxIR1.NodeBox} + {address : Ix.Compiler.Ixon.Address} {arity : Nat} + {baselineCaptured baselineArguments rewrittenArguments : Array RVal} + {baselineResume rewrittenResume : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (locations : heap.locRel baselineLocation rewrittenLocation) + (arguments : IxIR1.Sim.RValsIso heap.locRel + baselineArguments.toList rewrittenArguments.toList) + (resume : StableLiveFrameRel limits validation heap.locRel + baselineResume rewrittenResume) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + (boxAt : baselineStore.get? baselineLocation = some baselineBox) + (shared : baselineBox.world = .shared) + (node : baselineBox.node = .papN address arity baselineCaptured) + (capturedUnder : baselineCaptured.size < arity) + (retained : RetainSharedMany baselineStore baselineCaptured + baselineRetained) + (released : releaseSharedWork baselineFuel baselineRetained + [.loc baselineLocation] = .ok (baselineReleased, baselineRemaining)) + (totalEnough : arity ≤ (baselineCaptured ++ baselineArguments).size) + (baselineDeclaration : baselineContext.declarations address = + some (.fn calleeSource)) + (rewrittenDeclaration : rewrittenContext.declarations address = + some (.fn calleeRewrite.definition)) + (papSafe : calleeSource.signature.papSafe = true) + (suppliedArity : + ((baselineCaptured ++ baselineArguments).extract 0 arity).size = + calleeSource.signature.params.size) + (nonempty : calleeSource.blocks.isEmpty = false) : + let baselineTotal := baselineCaptured ++ baselineArguments + let baselineSupplied := baselineTotal.extract 0 arity + let baselineExcess := baselineTotal.extract arity baselineTotal.size + let baselineContinuation : Continuation := + if baselineExcess.isEmpty then .resume baselineResume + else .applyMore baselineExcess baselineResume + let baselineTarget : Machine := + { store := baselineReleased + heapFuel := baselineRemaining + control := .running + { definition := calleeSource, values := baselineSupplied } + (baselineContinuation :: baselineStack) } + ∃ (rewrittenCaptured : Array RVal) + (rewrittenRetained rewrittenReleased : Store) + (rewrittenRemaining : Nat), + let rewrittenTotal := rewrittenCaptured ++ rewrittenArguments + let rewrittenSupplied := rewrittenTotal.extract 0 arity + let rewrittenExcess := rewrittenTotal.extract arity rewrittenTotal.size + let rewrittenContinuation : Continuation := + if rewrittenExcess.isEmpty then .resume rewrittenResume + else .applyMore rewrittenExcess rewrittenResume + let rewrittenTarget : Machine := + { store := rewrittenReleased + heapFuel := rewrittenRemaining + control := .running + { definition := calleeRewrite.definition, + values := rewrittenSupplied } + (rewrittenContinuation :: rewrittenStack) } + RetainSharedMany rewrittenStore rewrittenCaptured rewrittenRetained ∧ + releaseSharedWork rewrittenFuel rewrittenRetained + [.loc rewrittenLocation] = + .ok (rewrittenReleased, rewrittenRemaining) ∧ + ApplyTransfer baselineContext interpretation baselineStore + baselineFuel (.loc baselineLocation) baselineArguments baselineResume + baselineStack baselineTarget ∧ + ApplyTransfer rewrittenContext interpretation rewrittenStore + rewrittenFuel (.loc rewrittenLocation) rewrittenArguments + rewrittenResume rewrittenStack rewrittenTarget ∧ + StableLiveMachineRel limits validation baselineTarget + rewrittenTarget := by + dsimp only + obtain ⟨rewrittenBox, rewrittenAt, boxes⟩ := heap.boxes locations (by + change baselineStore.heap.get? baselineLocation = some baselineBox + exact boxAt) + have papNodes : IxIR1.Sim.NodeIso heap.locRel + (.papN address arity baselineCaptured) rewrittenBox.node := by + simpa only [← node] using boxes.node + obtain ⟨rewrittenCaptured, rewrittenNode, capturedRelated⟩ := + nodeIso_pap_left papNodes + have rewrittenShared : rewrittenBox.world = .shared := + boxes.world.symm.trans shared + have rewrittenCapturedUnder : rewrittenCaptured.size < arity := by + have sizes : baselineCaptured.size = rewrittenCaptured.size := by + simpa using capturedRelated.lengths + rw [← sizes] + exact capturedUnder + have totalRelated : IxIR1.Sim.RValsIso heap.locRel + (baselineCaptured ++ baselineArguments).toList + (rewrittenCaptured ++ rewrittenArguments).toList := by + simpa using capturedRelated.append arguments + have totalSizes : (baselineCaptured ++ baselineArguments).size = + (rewrittenCaptured ++ rewrittenArguments).size := by + simpa using totalRelated.lengths + have rewrittenTotalEnough : + arity ≤ (rewrittenCaptured ++ rewrittenArguments).size := by + rw [← totalSizes] + exact totalEnough + have suppliedRelated : IxIR1.Sim.RValsIso heap.locRel + ((baselineCaptured ++ baselineArguments).extract 0 arity).toList + ((rewrittenCaptured ++ rewrittenArguments).extract 0 arity).toList := + rvalsIso_array_extract totalRelated 0 arity + have excessRelated : IxIR1.Sim.RValsIso heap.locRel + ((baselineCaptured ++ baselineArguments).extract arity + (baselineCaptured ++ baselineArguments).size).toList + ((rewrittenCaptured ++ rewrittenArguments).extract arity + (rewrittenCaptured ++ rewrittenArguments).size).toList := by + have extracted := rvalsIso_array_extract totalRelated arity + (baselineCaptured ++ baselineArguments).size + simpa [totalSizes] using extracted + have targetPapSafe : + calleeRewrite.definition.signature.papSafe = true := by + simpa using papSafe + have targetSuppliedArity : + ((rewrittenCaptured ++ rewrittenArguments).extract 0 arity).size = + calleeRewrite.definition.signature.params.size := by + have sizes : + ((baselineCaptured ++ baselineArguments).extract 0 arity).size = + ((rewrittenCaptured ++ rewrittenArguments).extract 0 arity).size := by + simpa using suppliedRelated.lengths + rw [← sizes, calleeRewrite.definition_signature] + exact suppliedArity + have targetNonempty : + calleeRewrite.definition.blocks.isEmpty = false := + calleeRewrite.definition_blocks_nonempty nonempty + obtain ⟨rewrittenRetained, retainedHeap, targetRetained, + retainedRelation⟩ := + retainSharedMany_historyIso heap capturedRelated retained + have retainedLocation : retainedHeap.locRel baselineLocation + rewrittenLocation := by + rw [retainedRelation] + exact locations + obtain ⟨rewrittenReleased, rewrittenRemaining, releasedHeap, + targetReleased, outputFuel, releasedRelation⟩ := + releaseSharedWork_historyIso retainedHeap fuel + (.cons (.loc retainedLocation) .nil) released + have suppliedReleased : IxIR1.Sim.RValsIso releasedHeap.locRel + ((baselineCaptured ++ baselineArguments).extract 0 arity).toList + ((rewrittenCaptured ++ rewrittenArguments).extract 0 arity).toList := by + rw [releasedRelation, retainedRelation] + exact suppliedRelated + have excessReleased : IxIR1.Sim.RValsIso releasedHeap.locRel + ((baselineCaptured ++ baselineArguments).extract arity + (baselineCaptured ++ baselineArguments).size).toList + ((rewrittenCaptured ++ rewrittenArguments).extract arity + (rewrittenCaptured ++ rewrittenArguments).size).toList := by + rw [releasedRelation, retainedRelation] + exact excessRelated + have resumeReleased : StableLiveFrameRel limits validation + releasedHeap.locRel baselineResume rewrittenResume := by + rw [releasedRelation, retainedRelation] + exact resume + have stackReleased : StableLiveStackIso limits validation + releasedHeap.locRel baselineStack rewrittenStack := by + rw [releasedRelation, retainedRelation] + exact stack + let continuation := StableLiveContinuationIso.applyMoreOrResumeIso + excessReleased resumeReleased + refine ⟨rewrittenCaptured, rewrittenRetained, rewrittenReleased, + rewrittenRemaining, targetRetained, targetReleased, + ApplyTransfer.papFn boxAt shared node capturedUnder retained released + totalEnough baselineDeclaration papSafe suppliedArity nonempty, + ApplyTransfer.papFn (by + change rewrittenStore.heap.get? rewrittenLocation = some rewrittenBox + exact rewrittenAt) rewrittenShared rewrittenNode rewrittenCapturedUnder + targetRetained targetReleased rewrittenTotalEnough rewrittenDeclaration + targetPapSafe targetSuppliedArity targetNonempty, ?_⟩ + exact StableLiveMachineRel.history releasedHeap outputFuel + (.running (StableLiveFrameRel.entry calleeRewrite suppliedReleased) + (.cons continuation stackReleased)) + +/-- Exactly saturated application of a related extern PAP transports its +ownership work and resumes live callers with the common scalar result. -/ +theorem unchangedApplyTransferPapExternLiveIso {limits : Validate.Limits} + {validation : Validate.Context} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore baselineRetained baselineReleased : Store} + {baselineFuel rewrittenFuel baselineRemaining : Nat} + {baselineLocation rewrittenLocation : Nat} + {baselineBox : IxIR1.NodeBox} + {address : Ix.Compiler.Ixon.Address} {arity expectedArity : Nat} + {baselineCaptured baselineArguments rewrittenArguments : Array RVal} + {value : RVal} {baselineResume rewrittenResume : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (locations : heap.locRel baselineLocation rewrittenLocation) + (arguments : IxIR1.Sim.RValsIso heap.locRel + baselineArguments.toList rewrittenArguments.toList) + (resume : StableLiveFrameRel limits validation heap.locRel + baselineResume rewrittenResume) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + (oracles : baselineContext.oracle = rewrittenContext.oracle) + (boxAt : baselineStore.get? baselineLocation = some baselineBox) + (shared : baselineBox.world = .shared) + (node : baselineBox.node = .papN address arity baselineCaptured) + (capturedUnder : baselineCaptured.size < arity) + (retained : RetainSharedMany baselineStore baselineCaptured + baselineRetained) + (released : releaseSharedWork baselineFuel baselineRetained + [.loc baselineLocation] = .ok (baselineReleased, baselineRemaining)) + (totalEnough : arity ≤ (baselineCaptured ++ baselineArguments).size) + (baselineDeclaration : baselineContext.declarations address = + some (.extern expectedArity)) + (rewrittenDeclaration : rewrittenContext.declarations address = + some (.extern expectedArity)) + (suppliedArity : + ((baselineCaptured ++ baselineArguments).extract 0 arity).size = + expectedArity) + (remainingEmpty : + ((baselineCaptured ++ baselineArguments).extract arity + (baselineCaptured ++ baselineArguments).size).isEmpty = true) + (called : ScalarOracleCall baselineContext address + ((baselineCaptured ++ baselineArguments).extract 0 arity) value) : + let baselineTarget : Machine := + { store := baselineReleased + heapFuel := baselineRemaining + control := .running + { baselineResume with + values := baselineResume.values.push value } + baselineStack } + ∃ (rewrittenCaptured : Array RVal) + (rewrittenRetained rewrittenReleased : Store) + (rewrittenRemaining : Nat), + let rewrittenTarget : Machine := + { store := rewrittenReleased + heapFuel := rewrittenRemaining + control := .running + { rewrittenResume with + values := rewrittenResume.values.push value } + rewrittenStack } + RetainSharedMany rewrittenStore rewrittenCaptured rewrittenRetained ∧ + releaseSharedWork rewrittenFuel rewrittenRetained + [.loc rewrittenLocation] = + .ok (rewrittenReleased, rewrittenRemaining) ∧ + ApplyTransfer baselineContext interpretation baselineStore + baselineFuel (.loc baselineLocation) baselineArguments baselineResume + baselineStack baselineTarget ∧ + ApplyTransfer rewrittenContext interpretation rewrittenStore + rewrittenFuel (.loc rewrittenLocation) rewrittenArguments + rewrittenResume rewrittenStack rewrittenTarget ∧ + StableLiveMachineRel limits validation baselineTarget + rewrittenTarget := by + dsimp only + obtain ⟨rewrittenBox, rewrittenAt, boxes⟩ := heap.boxes locations (by + change baselineStore.heap.get? baselineLocation = some baselineBox + exact boxAt) + have papNodes : IxIR1.Sim.NodeIso heap.locRel + (.papN address arity baselineCaptured) rewrittenBox.node := by + simpa only [← node] using boxes.node + obtain ⟨rewrittenCaptured, rewrittenNode, capturedRelated⟩ := + nodeIso_pap_left papNodes + have rewrittenShared : rewrittenBox.world = .shared := + boxes.world.symm.trans shared + have rewrittenCapturedUnder : rewrittenCaptured.size < arity := by + have sizes : baselineCaptured.size = rewrittenCaptured.size := by + simpa using capturedRelated.lengths + rw [← sizes] + exact capturedUnder + have totalRelated : IxIR1.Sim.RValsIso heap.locRel + (baselineCaptured ++ baselineArguments).toList + (rewrittenCaptured ++ rewrittenArguments).toList := by + simpa using capturedRelated.append arguments + have totalSizes : (baselineCaptured ++ baselineArguments).size = + (rewrittenCaptured ++ rewrittenArguments).size := by + simpa using totalRelated.lengths + have rewrittenTotalEnough : + arity ≤ (rewrittenCaptured ++ rewrittenArguments).size := by + rw [← totalSizes] + exact totalEnough + have suppliedRelated : IxIR1.Sim.RValsIso heap.locRel + ((baselineCaptured ++ baselineArguments).extract 0 arity).toList + ((rewrittenCaptured ++ rewrittenArguments).extract 0 arity).toList := + rvalsIso_array_extract totalRelated 0 arity + have excessRelated : IxIR1.Sim.RValsIso heap.locRel + ((baselineCaptured ++ baselineArguments).extract arity + (baselineCaptured ++ baselineArguments).size).toList + ((rewrittenCaptured ++ rewrittenArguments).extract arity + (rewrittenCaptured ++ rewrittenArguments).size).toList := by + have extracted := rvalsIso_array_extract totalRelated arity + (baselineCaptured ++ baselineArguments).size + simpa [totalSizes] using extracted + have targetSuppliedArity : + ((rewrittenCaptured ++ rewrittenArguments).extract 0 arity).size = + expectedArity := by + have sizes : + ((baselineCaptured ++ baselineArguments).extract 0 arity).size = + ((rewrittenCaptured ++ rewrittenArguments).extract 0 arity).size := by + simpa using suppliedRelated.lengths + rw [← sizes] + exact suppliedArity + have targetRemainingEmpty : + ((rewrittenCaptured ++ rewrittenArguments).extract arity + (rewrittenCaptured ++ rewrittenArguments).size).isEmpty = true := by + have lengths := excessRelated.lengths + have sizes : + ((baselineCaptured ++ baselineArguments).extract arity + (baselineCaptured ++ baselineArguments).size).size = + ((rewrittenCaptured ++ rewrittenArguments).extract arity + (rewrittenCaptured ++ rewrittenArguments).size).size := by + simpa only [Array.length_toList] using lengths + have emptyEq : + ((baselineCaptured ++ baselineArguments).extract arity + (baselineCaptured ++ baselineArguments).size).isEmpty = + ((rewrittenCaptured ++ rewrittenArguments).extract arity + (rewrittenCaptured ++ rewrittenArguments).size).isEmpty := by + simp only [Array.isEmpty] + rw [sizes] + rw [← emptyEq] + exact remainingEmpty + obtain ⟨argumentsScalar, valueScalar⟩ := called.scalar + have suppliedListsEq : + ((baselineCaptured ++ baselineArguments).extract 0 arity).toList = + ((rewrittenCaptured ++ rewrittenArguments).extract 0 arity).toList := by + apply suppliedRelated.eq_of_allScalar + rw [Array.all_toList] + exact argumentsScalar + have suppliedEq : + (baselineCaptured ++ baselineArguments).extract 0 arity = + (rewrittenCaptured ++ rewrittenArguments).extract 0 arity := + Array.toList_inj.mp suppliedListsEq + have targetCalled : ScalarOracleCall rewrittenContext address + ((rewrittenCaptured ++ rewrittenArguments).extract 0 arity) value := by + rw [← suppliedEq] + exact called.congrOracle oracles + obtain ⟨rewrittenRetained, retainedHeap, targetRetained, + retainedRelation⟩ := + retainSharedMany_historyIso heap capturedRelated retained + have retainedLocation : retainedHeap.locRel baselineLocation + rewrittenLocation := by + rw [retainedRelation] + exact locations + obtain ⟨rewrittenReleased, rewrittenRemaining, releasedHeap, + targetReleased, outputFuel, releasedRelation⟩ := + releaseSharedWork_historyIso retainedHeap fuel + (.cons (.loc retainedLocation) .nil) released + have outputResume : StableLiveFrameRel limits validation + releasedHeap.locRel + { baselineResume with values := baselineResume.values.push value } + { rewrittenResume with values := rewrittenResume.values.push value } := by + rw [releasedRelation, retainedRelation] + exact resume.push (IxIR1.Sim.RValIso.refl_of_scalar valueScalar) + have outputStack : StableLiveStackIso limits validation releasedHeap.locRel + baselineStack rewrittenStack := by + rw [releasedRelation, retainedRelation] + exact stack + refine ⟨rewrittenCaptured, rewrittenRetained, rewrittenReleased, + rewrittenRemaining, targetRetained, targetReleased, + ApplyTransfer.papExtern boxAt shared node capturedUnder retained released + totalEnough baselineDeclaration suppliedArity remainingEmpty called, + ApplyTransfer.papExtern (by + change rewrittenStore.heap.get? rewrittenLocation = some rewrittenBox + exact rewrittenAt) rewrittenShared rewrittenNode rewrittenCapturedUnder + targetRetained targetReleased rewrittenTotalEnough rewrittenDeclaration + targetSuppliedArity targetRemainingEmpty targetCalled, ?_⟩ + exact StableLiveMachineRel.history releasedHeap outputFuel + (.running outputResume outputStack) + +/-- Exhaustive allocation-history simulation of dynamic application over +live-indexed resume frames and stacks. -/ +theorem unchangedApplyTransferLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {sourceProgram : Program} + (trace : Reuse.Trace limits validation sourceProgram) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFunction rewrittenFunction : RVal} + {baselineArguments rewrittenArguments : Array RVal} + {baselineResume rewrittenResume : Frame} + {baselineStack rewrittenStack : List Continuation} + {baselineTarget : Machine} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (function : IxIR1.Sim.RValIso heap.locRel + baselineFunction rewrittenFunction) + (arguments : IxIR1.Sim.RValsIso heap.locRel + baselineArguments.toList rewrittenArguments.toList) + (resume : StableLiveFrameRel limits validation heap.locRel + baselineResume rewrittenResume) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + (transferred : ApplyTransfer + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation baselineStore baselineFuel baselineFunction + baselineArguments baselineResume baselineStack baselineTarget) : + ∃ rewrittenTarget, + ApplyTransfer + (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation rewrittenStore rewrittenFuel rewrittenFunction + rewrittenArguments rewrittenResume rewrittenStack rewrittenTarget ∧ + StableLiveMachineRel limits validation baselineTarget + rewrittenTarget := by + have classified := transferred.classify + cases classified with + | erased released => + cases function with + | erased => + obtain ⟨rewrittenOut, rewrittenRemaining, targetReleased, + sourceTransfer, targetTransfer, related⟩ := + unchangedApplyTransferErasedLiveIso + (baselineContext := Eval.Context.ofProgram sourceProgram + validation.schemas oracle) + (rewrittenContext := Eval.Context.ofProgram trace.target + validation.schemas oracle) + heap fuel arguments resume stack released + exact ⟨_, targetTransfer, related⟩ + | papUnder boxAt shared node capturedUnder retained released totalUnder => + cases function with + | @loc _ rewrittenLocation locations => + obtain ⟨rewrittenCaptured, rewrittenRetained, rewrittenReleased, + rewrittenRemaining, targetRetained, targetReleased, + sourceTransfer, targetTransfer, related⟩ := + unchangedApplyTransferPapUnderLiveIso + (baselineContext := Eval.Context.ofProgram sourceProgram + validation.schemas oracle) + (rewrittenContext := Eval.Context.ofProgram trace.target + validation.schemas oracle) + heap fuel locations arguments resume stack boxAt shared node + capturedUnder retained released totalUnder + exact ⟨_, targetTransfer, related⟩ + | papFn boxAt shared node capturedUnder retained released totalEnough + declaration papSafe suppliedArity nonempty => + cases function with + | @loc _ rewrittenLocation locations => + obtain ⟨calleeRewrite, targetDeclaration⟩ := + trace.context_fn declaration + obtain ⟨rewrittenCaptured, rewrittenRetained, rewrittenReleased, + rewrittenRemaining, targetRetained, targetReleased, + sourceTransfer, targetTransfer, related⟩ := + unchangedApplyTransferPapFnLiveIso calleeRewrite heap fuel locations + arguments resume stack boxAt shared node capturedUnder retained + released totalEnough declaration targetDeclaration papSafe + suppliedArity nonempty + exact ⟨_, targetTransfer, related⟩ + | papExtern boxAt shared node capturedUnder retained released totalEnough + declaration suppliedArity remainingEmpty called => + cases function with + | @loc _ rewrittenLocation locations => + have targetDeclaration := trace.context_extern declaration + obtain ⟨rewrittenCaptured, rewrittenRetained, rewrittenReleased, + rewrittenRemaining, targetRetained, targetReleased, + sourceTransfer, targetTransfer, related⟩ := + unchangedApplyTransferPapExternLiveIso + (baselineContext := Eval.Context.ofProgram sourceProgram + validation.schemas oracle) + (rewrittenContext := Eval.Context.ofProgram trace.target + validation.schemas oracle) + heap fuel locations arguments resume stack rfl boxAt shared node + capturedUnder retained released totalEnough declaration + targetDeclaration suppliedArity remainingEmpty called + exact ⟨_, targetTransfer, related⟩ + +/-- A source `apply` instruction determines a matching target transfer from +syntax-derived liveness of its function and argument operands. -/ +theorem unchangedApplyStepOfTraceLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {sourceProgram : Program} + (trace : Reuse.Trace limits validation sourceProgram) + {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + {baselineTarget : Machine} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {functionAtom : Atom} {argumentAtoms : Array Atom} + {baselineFunction : RVal} {baselineArguments : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .apply functionAtom argumentAtoms) + (noCredits : NoLiveCredits baselineFrame) + (functionResolved : Eval.resolveAtom baselineFrame.values functionAtom = + .ok baselineFunction) + (argumentsResolved : Eval.resolveAtoms baselineFrame.values argumentAtoms = + .ok baselineArguments) + (transferred : ApplyTransfer + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation baselineStore baselineFuel baselineFunction + baselineArguments { baselineFrame with pc := baselineFrame.pc + 1 } + baselineStack baselineTarget) : + ∃ rewrittenTarget, + Step (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + baselineTarget ∧ + Step (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + rewrittenTarget ∧ + StableLiveMachineRel limits validation baselineTarget + rewrittenTarget := by + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have instructionAt : block.instructions[baselineFrame.pc]? = + some (.apply functionAtom argumentAtoms) := by + simpa [instruction] using Array.getElem?_eq_getElem pc + have functionLive := AtomLiveFrom.instruction sourceBlockAt instructionAt + Liveness.InstrUsesAtom.applyFunction + have argumentsLive : AtomsLiveFrom source baselineFrame.block + baselineFrame.pc argumentAtoms := + AtomsLiveFrom.instruction sourceBlockAt instructionAt (by + intro atom member + exact Liveness.InstrUsesAtom.applyArgument member) + obtain ⟨rewrittenFunction, targetFunctionResolved, functionRelated⟩ := + frame.values.resolveAtom functionLive functionResolved + obtain ⟨rewrittenArguments, targetArgumentsResolved, argumentsRelated⟩ := + frame.values.resolveAtoms argumentsLive argumentsResolved + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .apply functionAtom argumentAtoms := by + simpa only [← frame.pc] using instruction + have targetNoCredits := frame.noLiveCredits noCredits + have resume : StableLiveFrameRel limits validation heap.locRel + { baselineFrame with pc := baselineFrame.pc + 1 } + { rewrittenFrame with pc := rewrittenFrame.pc + 1 } := + .rewritten rewrite frame.advance + obtain ⟨rewrittenTarget, targetTransferred, related⟩ := + unchangedApplyTransferLiveIso trace heap fuel functionRelated + argumentsRelated resume stack transferred + refine ⟨rewrittenTarget, + Step.applyCleared rfl sourceAt pc instruction noCredits functionResolved + argumentsResolved transferred, + Step.applyCleared rfl targetAt targetPc targetInstruction targetNoCredits + targetFunctionResolved targetArgumentsResolved targetTransferred, + related⟩ + +/-- A return through `applyMore` resolves the live return operand and feeds +the fully related pending argument vectors through dynamic application. -/ +theorem unchangedRetApplyMoreStepOfTraceLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {sourceProgram : Program} + (trace : Reuse.Trace limits validation sourceProgram) + {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineCaller rewrittenCaller : Frame} + {baselineArguments rewrittenArguments : Array RVal} + {baselineRest rewrittenRest : List Continuation} + {baselineTarget : Machine} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (arguments : IxIR1.Sim.RValsIso heap.locRel + baselineArguments.toList rewrittenArguments.toList) + (caller : StableLiveFrameRel limits validation heap.locRel + baselineCaller rewrittenCaller) + (rest : StableLiveStackIso limits validation heap.locRel + baselineRest rewrittenRest) + {block : Block} {atom : Atom} {baselineValue : RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = .ret atom) + (resolved : Eval.resolveAtom baselineFrame.values atom = .ok baselineValue) + (noCredits : NoLiveCredits baselineFrame) + (world : baselineValue.hasWorld baselineStore + baselineFrame.definition.signature.result = true) + (transferred : ApplyTransfer + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation baselineStore baselineFuel baselineValue + baselineArguments baselineCaller baselineRest baselineTarget) : + ∃ rewrittenTarget, + Step (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame + (.applyMore baselineArguments baselineCaller :: baselineRest) } + baselineTarget ∧ + Step (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame + (.applyMore rewrittenArguments rewrittenCaller :: + rewrittenRest) } + rewrittenTarget ∧ + StableLiveMachineRel limits validation baselineTarget + rewrittenTarget := by + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rw [← frame.baselineDefinition] + exact sourceAt + have atomLive := AtomLiveFrom.ret sourceBlockAt pc terminator + obtain ⟨rewrittenValue, targetResolved, valueRelated⟩ := + frame.values.resolveAtom atomLive resolved + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + have targetNoCredits := frame.noLiveCredits noCredits + have resultWorldEq : rewrittenFrame.definition.signature.result = + baselineFrame.definition.signature.result := by + rw [frame.rewrittenDefinition, rewrite.definition_signature, + frame.baselineDefinition] + have targetWorld : rewrittenValue.hasWorld rewrittenStore + rewrittenFrame.definition.signature.result = true := by + rw [resultWorldEq, + ← Ix.Compiler.IxIR2.ReuseSim.heapHistoryIso_rvalHasWorld_eq heap + valueRelated] + exact world + obtain ⟨rewrittenTarget, targetTransferred, related⟩ := + unchangedApplyTransferLiveIso trace heap fuel valueRelated arguments caller + rest transferred + refine ⟨rewrittenTarget, + Step.retApplyMoreCleared rfl sourceAt pc terminator resolved noCredits + world transferred, + Step.retApplyMoreCleared rfl targetAt targetPc terminator targetResolved + targetNoCredits targetWorld targetTransferred, + related⟩ + +/-! ## Exhaustive liveness-indexed unchanged-block dispatch -/ + +set_option maxHeartbeats 1000000 in +/-- Every successful instruction in an unchanged block is equivariant under +an arbitrary allocation-history isomorphism using only future-live registers. -/ +theorem unchangedInstructionStepOfTraceLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {sourceProgram : Program} + (trace : Reuse.Trace limits validation sourceProgram) + {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {instruction : Instr} {baselineTarget : Machine} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instructionAt : block.instructions[baselineFrame.pc] = instruction) + (classified : InstructionTransferCase + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation baselineStore baselineFuel baselineFrame baselineStack + instruction baselineTarget) : + ∃ rewrittenTarget, + Step (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + baselineTarget ∧ + Step (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + rewrittenTarget ∧ + StableLiveMachineRel limits validation baselineTarget rewrittenTarget := by + let baselineContext := + Eval.Context.ofProgram sourceProgram validation.schemas oracle + let rewrittenContext := + Eval.Context.ofProgram trace.target validation.schemas oracle + cases classified with + | move resolved => + obtain ⟨rewrittenValue, sourceStep, targetStep, related⟩ := + unchangedMoveStepLiveIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt resolved + exact ⟨_, sourceStep, targetStep, related⟩ + | alloc schemaAt resolved fields => + obtain ⟨rewrittenValues, sourceStep, targetStep, related⟩ := + unchangedAllocStepLiveIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite rfl heap fuel frame + stack sourceAt targetAt pc instructionAt schemaAt resolved fields + exact ⟨_, sourceStep, targetStep, related⟩ + | allocWithAbsent schemaAt resolved fields taken layout absent => + obtain ⟨rewrittenValues, rewrittenTaken, sourceStep, targetStep, + related⟩ := + unchangedAllocWithAbsentStepLiveIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite rfl heap fuel frame + stack sourceAt targetAt pc instructionAt schemaAt resolved fields + taken layout absent + exact ⟨_, sourceStep, targetStep, related⟩ + | allocWithLogical mode schemaAt resolved fields taken layout present => + cases mode + obtain ⟨rewrittenValues, rewrittenTaken, sourceStep, targetStep, + related⟩ := + unchangedAllocWithLogicalStepLiveIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite rfl heap fuel frame + stack sourceAt targetAt pc instructionAt schemaAt resolved fields + taken layout present + exact ⟨_, sourceStep, targetStep, related⟩ + | allocWithPhysical mode schemaAt resolved fields taken layout present + reused => + cases mode + obtain ⟨rewrittenValues, rewrittenTaken, rewrittenLocation, + rewrittenOut, targetReused, sourceStep, targetStep, related⟩ := + unchangedAllocWithPhysicalStepLiveIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite rfl heap fuel frame + stack sourceAt targetAt pc instructionAt schemaAt resolved fields + taken layout present reused + exact ⟨_, sourceStep, targetStep, related⟩ + | discardAbsent taken absent => + obtain ⟨rewrittenTaken, sourceStep, targetStep, related⟩ := + unchangedDiscardCreditAbsentStepLiveIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt taken absent + exact ⟨_, sourceStep, targetStep, related⟩ + | discardLogical mode taken present => + cases mode + obtain ⟨rewrittenTaken, sourceStep, targetStep, related⟩ := + unchangedDiscardCreditLogicalStepLiveIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt taken present + exact ⟨_, sourceStep, targetStep, related⟩ + | discardPhysical mode taken present released => + cases mode + obtain ⟨rewrittenTaken, rewrittenLocation, rewrittenOut, + targetReleased, sourceStep, targetStep, related⟩ := + unchangedDiscardCreditPhysicalStepLiveIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt taken present released + exact ⟨_, sourceStep, targetStep, related⟩ + | takeUniqueLogical mode schemaAt resolved viewed unitRC => + cases mode + obtain ⟨rewrittenLocation, rewrittenFields, sourceStep, targetStep, + related⟩ := + unchangedTakeUniqueLogicalStepLiveIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite rfl heap fuel frame + stack sourceAt targetAt pc instructionAt schemaAt resolved viewed + unitRC + exact ⟨_, sourceStep, targetStep, related⟩ + | takeUniquePhysical mode schemaAt resolved viewed unitRC => + cases mode + obtain ⟨rewrittenLocation, rewrittenFields, sourceStep, targetStep, + related⟩ := + unchangedTakeUniquePhysicalStepLiveIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite rfl heap fuel frame + stack sourceAt targetAt pc instructionAt schemaAt resolved viewed + unitRC + exact ⟨_, sourceStep, targetStep, related⟩ + | resetSharedLogicalHot mode schemaAt resolved viewed unitRC => + cases mode + obtain ⟨rewrittenLocation, rewrittenFields, sourceStep, targetStep, + related⟩ := + unchangedResetSharedLogicalHotStepLiveIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite rfl heap fuel frame + stack sourceAt targetAt pc instructionAt schemaAt resolved viewed + unitRC + exact ⟨_, sourceStep, targetStep, related⟩ + | resetSharedPhysicalHot mode schemaAt resolved viewed unitRC => + cases mode + obtain ⟨rewrittenLocation, rewrittenFields, sourceStep, targetStep, + related⟩ := + unchangedResetSharedPhysicalHotStepLiveIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite rfl heap fuel frame + stack sourceAt targetAt pc instructionAt schemaAt resolved viewed + unitRC + exact ⟨_, sourceStep, targetStep, related⟩ + | resetSharedCold schemaAt resolved viewed shared retained => + obtain ⟨rewrittenFields, rewrittenOut, sourceStep, targetStep, + related⟩ := + unchangedResetSharedColdStepLiveIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite rfl heap fuel frame + stack sourceAt targetAt pc instructionAt schemaAt resolved viewed + shared retained + exact ⟨_, sourceStep, targetStep, related⟩ + | retainShared resolved retained => + obtain ⟨rewrittenValue, rewrittenOut, targetRetained, sourceStep, + targetStep, related⟩ := + unchangedRetainSharedStepLiveIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt resolved retained + exact ⟨_, sourceStep, targetStep, related⟩ + | releaseShared resolved released => + obtain ⟨rewrittenValue, rewrittenOut, rewrittenRemaining, + targetReleased, sourceStep, targetStep, related⟩ := + unchangedReleaseSharedStepLiveIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt resolved released + exact ⟨_, sourceStep, targetStep, related⟩ + | dropUnique resolved dropped => + obtain ⟨rewrittenValue, rewrittenOut, rewrittenRemaining, + targetDropped, sourceStep, targetStep, related⟩ := + unchangedDropUniqueStepLiveIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt resolved dropped + exact ⟨_, sourceStep, targetStep, related⟩ + | freeUnique resolved viewed scalarFields => + obtain ⟨boxAt, unique, node⟩ := viewed.parts + obtain ⟨rewrittenLocation, sourceStep, targetStep, related⟩ := + unchangedFreeUniqueStepLiveIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt resolved boxAt unique node + scalarFields + exact ⟨_, sourceStep, targetStep, related⟩ + | fetch resolved boxAt node fieldAt => + obtain ⟨rewrittenValue, sourceStep, targetStep, related, _nextFrame⟩ := + unchangedFetchStepLiveIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt resolved boxAt node fieldAt + exact ⟨_, sourceStep, targetStep, related⟩ + | callFn noCredits resolved declaration arity nonempty => + obtain ⟨calleeRewrite, targetDeclaration⟩ := + trace.context_fn declaration + obtain ⟨rewrittenValues, sourceStep, targetStep, related⟩ := + unchangedCallFnStepLiveIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite calleeRewrite heap fuel + frame stack sourceAt targetAt pc instructionAt noCredits resolved + declaration targetDeclaration arity nonempty + exact ⟨_, sourceStep, targetStep, related⟩ + | callSelf noCredits resolved arity nonempty => + obtain ⟨rewrittenValues, sourceStep, targetStep, related⟩ := + unchangedCallSelfStepLiveIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt noCredits resolved arity nonempty + exact ⟨_, sourceStep, targetStep, related⟩ + | pappFn noCredits declaration papSafe resolved under => + obtain ⟨calleeRewrite, targetDeclaration⟩ := + trace.context_fn declaration + obtain ⟨rewrittenValues, sourceStep, targetStep, related⟩ := + unchangedPappFnStepLiveIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite calleeRewrite heap fuel + frame stack sourceAt targetAt pc instructionAt noCredits declaration + targetDeclaration papSafe resolved under + exact ⟨_, sourceStep, targetStep, related⟩ + | pappExtern noCredits declaration resolved under => + have targetDeclaration := trace.context_extern declaration + obtain ⟨rewrittenValues, sourceStep, targetStep, related⟩ := + unchangedPappExternStepLiveIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt noCredits declaration + targetDeclaration resolved under + exact ⟨_, sourceStep, targetStep, related⟩ + | apply noCredits functionResolved argumentsResolved transferred => + exact unchangedApplyStepOfTraceLiveIso trace rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt noCredits functionResolved + argumentsResolved transferred + | extern noCredits resolved declaration argumentArity called => + have targetDeclaration := trace.context_extern declaration + obtain ⟨sourceStep, targetStep, related⟩ := + unchangedExternStepLiveIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + rfl sourceAt targetAt pc instructionAt noCredits resolved declaration + targetDeclaration argumentArity called + exact ⟨_, sourceStep, targetStep, related⟩ + +/-- An unchanged instruction from the accepted-prefix family advances both +machines inside the same literal block. The related endpoint therefore +satisfies accepted-entry phase without requiring a syntax exclusion: an +accepted decision could not have left that target block unchanged. -/ +theorem unchangedAcceptedPrefixInstructionStepOfTraceLiveIso + {limits : Validate.Limits} + {validation : Validate.Context} {sourceProgram : Program} + (trace : Reuse.Trace limits validation sourceProgram) + {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {instruction : Instr} {baselineTarget : Machine} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instructionAt : block.instructions[baselineFrame.pc] = instruction) + (classified : InstructionTransferCase + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation baselineStore baselineFuel baselineFrame baselineStack + instruction baselineTarget) + (acceptedPrefix : AcceptedPrefixInstruction instruction) : + ∃ rewrittenTarget, + Step (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + baselineTarget ∧ + Step (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + rewrittenTarget ∧ + StableLiveMachineRel limits validation baselineTarget + rewrittenTarget ∧ + StableLiveAcceptedEntry limits validation baselineTarget + rewrittenTarget := by + let baselineContext := + Eval.Context.ofProgram sourceProgram validation.schemas oracle + let rewrittenContext := + Eval.Context.ofProgram trace.target validation.schemas oracle + cases acceptedPrefix with + | fetch target cid field => + cases classified with + | fetch resolved boxAt node fieldAt => + obtain ⟨rewrittenValue, sourceStep, targetStep, related, + _nextFrame⟩ := + unchangedFetchStepLiveIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame + stack sourceAt targetAt pc instructionAt resolved boxAt node + fieldAt + exact ⟨_, sourceStep, targetStep, related, + StableLiveAcceptedEntry.ofSameBlock rfl rfl + (by simpa using sourceAt) (by simpa using targetAt)⟩ + | retainShared target => + cases classified with + | retainShared resolved retained => + obtain ⟨rewrittenValue, rewrittenOut, targetRetained, sourceStep, + targetStep, related⟩ := + unchangedRetainSharedStepLiveIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame + stack sourceAt targetAt pc instructionAt resolved retained + exact ⟨_, sourceStep, targetStep, related, + StableLiveAcceptedEntry.ofSameBlock rfl rfl + (by simpa using sourceAt) (by simpa using targetAt)⟩ + | releaseShared target => + cases classified with + | releaseShared resolved released => + obtain ⟨rewrittenValue, rewrittenOut, rewrittenRemaining, + targetReleased, sourceStep, targetStep, related⟩ := + unchangedReleaseSharedStepLiveIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame + stack sourceAt targetAt pc instructionAt resolved released + exact ⟨_, sourceStep, targetStep, related, + StableLiveAcceptedEntry.ofSameBlock rfl rfl + (by simpa using sourceAt) (by simpa using targetAt)⟩ + | allocShared cid arguments => + cases classified with + | alloc schemaAt resolved fields => + obtain ⟨rewrittenValues, sourceStep, targetStep, related⟩ := + unchangedAllocStepLiveIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite rfl heap fuel + frame stack sourceAt targetAt pc instructionAt schemaAt resolved + fields + exact ⟨_, sourceStep, targetStep, related, + StableLiveAcceptedEntry.ofSameBlock rfl rfl + (by simpa using sourceAt) (by simpa using targetAt)⟩ + +set_option maxHeartbeats 1000000 in +/-- Every successful terminator in an unchanged block is equivariant under +an arbitrary allocation-history isomorphism using only future-live registers. -/ +theorem unchangedTerminatorStepOfTraceLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {sourceProgram : Program} + (trace : Reuse.Trace limits validation sourceProgram) + {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {terminator : Terminator} {baselineTarget : Machine} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminatorAt : block.terminator = terminator) + (classified : TerminatorTransferCase + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation baselineStore baselineFuel baselineFrame baselineStack + terminator baselineTarget) : + ∃ rewrittenTarget, + Step (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + baselineTarget ∧ + Step (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + rewrittenTarget ∧ + StableLiveMachineRel limits validation baselineTarget rewrittenTarget := by + let baselineContext := + Eval.Context.ofProgram sourceProgram validation.schemas oracle + let rewrittenContext := + Eval.Context.ofProgram trace.target validation.schemas oracle + cases classified with + | jump transferred => + obtain ⟨rewrittenFrameTarget, sourceStep, targetStep, related⟩ := + unchangedJumpStepLiveIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc terminatorAt transferred + exact ⟨_, sourceStep, targetStep, related⟩ + | switchCtor resolved boxAt node alternativeAt transferred => + obtain ⟨rewrittenFrameTarget, sourceStep, targetStep, related, + _targetFrame⟩ := + unchangedSwitchCtorStepLiveIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc terminatorAt resolved boxAt node alternativeAt + transferred + exact ⟨_, sourceStep, targetStep, related⟩ + | switchNatZero resolved transferred => + obtain ⟨rewrittenFrameTarget, sourceStep, targetStep, related⟩ := + unchangedSwitchNatZeroStepLiveIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc terminatorAt resolved transferred + exact ⟨_, sourceStep, targetStep, related⟩ + | switchNatSucc resolved transferred => + obtain ⟨rewrittenFrameTarget, sourceStep, targetStep, related⟩ := + unchangedSwitchNatSuccStepLiveIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc terminatorAt resolved transferred + exact ⟨_, sourceStep, targetStep, related⟩ + | branchPresent lookedUp present transferred => + obtain ⟨rewrittenFrameTarget, sourceStep, targetStep, related⟩ := + unchangedBranchCreditPresentStepLiveIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc terminatorAt lookedUp present transferred + exact ⟨_, sourceStep, targetStep, related⟩ + | branchAbsent lookedUp absent transferred => + obtain ⟨rewrittenFrameTarget, sourceStep, targetStep, related⟩ := + unchangedBranchCreditAbsentStepLiveIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc terminatorAt lookedUp absent transferred + exact ⟨_, sourceStep, targetStep, related⟩ + | retResume resolved noCredits world => + cases stack with + | cons head rest => + cases head with + | resume caller => + obtain ⟨rewrittenValue, sourceStep, targetStep, related⟩ := + unchangedRetResumeStepLiveIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel + frame caller rest sourceAt targetAt pc terminatorAt resolved + noCredits world + exact ⟨_, sourceStep, targetStep, related⟩ + | retHalt resolved noCredits world => + cases stack + obtain ⟨rewrittenValue, sourceStep, targetStep, related⟩ := + unchangedRetHaltStepLiveIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame + sourceAt targetAt pc terminatorAt resolved noCredits world + exact ⟨_, sourceStep, targetStep, related⟩ + | retApplyMore resolved noCredits world transferred => + cases stack with + | cons head rest => + cases head with + | applyMore arguments caller => + exact unchangedRetApplyMoreStepOfTraceLiveIso trace rewrite heap + fuel frame arguments caller rest sourceAt targetAt pc + terminatorAt resolved noCredits world transferred + | tailCallFn noCredits resolved declaration arity nonempty => + obtain ⟨calleeRewrite, targetDeclaration⟩ := + trace.context_fn declaration + obtain ⟨rewrittenValues, sourceStep, targetStep, related⟩ := + unchangedTailCallFnStepLiveIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite calleeRewrite heap fuel + frame stack sourceAt targetAt pc terminatorAt noCredits resolved + declaration targetDeclaration arity nonempty + exact ⟨_, sourceStep, targetStep, related⟩ + | tailCallSelf noCredits resolved arity nonempty => + obtain ⟨rewrittenValues, sourceStep, targetStep, related⟩ := + unchangedTailCallSelfStepLiveIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc terminatorAt noCredits resolved arity nonempty + exact ⟨_, sourceStep, targetStep, related⟩ + +/-- A source step at a literally preserved block is matched under any +allocation-history isomorphism. Instruction and terminator classification +remain entirely behind the public evaluator interfaces. -/ +theorem unchangedStepOfTraceLiveIso {limits : Validate.Limits} + {validation : Validate.Context} {sourceProgram : Program} + (trace : Reuse.Trace limits validation sourceProgram) + {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {baselineTarget : Machine} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (stepped : Step + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + baselineTarget) : + ∃ rewrittenTarget, + Step (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + rewrittenTarget ∧ + StableLiveMachineRel limits validation baselineTarget rewrittenTarget := by + have classified := stepped.classify + cases classified with + | instruction classifiedAt pc instructionAt instructionCase => + have blockEq := Option.some.inj (classifiedAt.symm.trans sourceAt) + cases blockEq + obtain ⟨rewrittenTarget, _sourceStep, targetStep, related⟩ := + unchangedInstructionStepOfTraceLiveIso trace rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt instructionCase + exact ⟨rewrittenTarget, targetStep, related⟩ + | terminator classifiedAt pc terminatorAt terminatorCase => + have blockEq := Option.some.inj (classifiedAt.symm.trans sourceAt) + cases blockEq + obtain ⟨rewrittenTarget, _sourceStep, targetStep, related⟩ := + unchangedTerminatorStepOfTraceLiveIso trace rewrite heap fuel frame stack + sourceAt targetAt pc terminatorAt terminatorCase + exact ⟨rewrittenTarget, targetStep, related⟩ + +theorem instructionAllocationEvents_history + {limits : Validate.Limits} {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {baselineStore rewrittenStore : Store} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + {baselineFrame rewrittenFrame : Frame} + (frame : StableLiveFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + {block : Block} {instruction : Instr} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = some block) + (pc : baselineFrame.pc < block.instructions.size) + (instructionAt : block.instructions[baselineFrame.pc] = instruction) + {context : Eval.Context} {interpretation : Interpretation} {heapFuel : Nat} + {stack : List Continuation} {target : Machine} + (classified : InstructionTransferCase context interpretation baselineStore heapFuel + baselineFrame stack instruction target) : + instructionAllocationEvents baselineStore baselineFrame instruction = + instructionAllocationEvents rewrittenStore rewrittenFrame instruction := by + cases instruction <;> try rfl + case apply functionAtom argumentAtoms => + cases classified with + | apply noCredits functionResolved argumentsResolved transferred => + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rwa [frame.baselineDefinition] at sourceAt + have atIndex : block.instructions[baselineFrame.pc]? = + some (.apply functionAtom argumentAtoms) := by + simpa [instructionAt] using Array.getElem?_eq_getElem pc + have functionLive := AtomLiveFrom.instruction sourceBlockAt atIndex + Liveness.InstrUsesAtom.applyFunction + have argumentsLive := AtomsLiveFrom.instruction sourceBlockAt atIndex + (atoms := argumentAtoms) (by + intro atom member + exact Liveness.InstrUsesAtom.applyArgument member) + obtain ⟨rewrittenFunction, targetFunction, functions⟩ := + frame.values.resolveAtom functionLive functionResolved + obtain ⟨rewrittenArguments, targetArguments, arguments⟩ := + frame.values.resolveAtoms argumentsLive argumentsResolved + simp only [instructionAllocationEvents, functionResolved, argumentsResolved, + targetFunction, targetArguments] + exact applyAllocationEvents_history heap functions (by simpa using arguments.lengths) + +theorem terminatorAllocationEvents_history + {limits : Validate.Limits} {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {baselineStore rewrittenStore : Store} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + {baselineFrame rewrittenFrame : Frame} + (frame : StableLiveFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + {baselineStack rewrittenStack : List Continuation} + (stack : StableLiveStackIso limits validation heap.locRel baselineStack rewrittenStack) + {block : Block} {terminator : Terminator} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminatorAt : block.terminator = terminator) + {context : Eval.Context} {interpretation : Interpretation} {heapFuel : Nat} + {target : Machine} + (classified : TerminatorTransferCase context interpretation baselineStore heapFuel + baselineFrame baselineStack terminator target) : + terminatorAllocationEvents baselineStore baselineFrame baselineStack terminator = + terminatorAllocationEvents rewrittenStore rewrittenFrame rewrittenStack terminator := by + cases terminator <;> try rfl + case ret atom => + cases stack with + | nil => rfl + | cons head tail => + cases head with + | resume caller => rfl + | applyMore arguments caller => + cases classified with + | retApplyMore resolved noCredits world transferred => + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rwa [frame.baselineDefinition] at sourceAt + obtain ⟨rewrittenValue, targetResolved, values⟩ := + frame.values.resolveAtom + (AtomLiveFrom.ret sourceBlockAt pc terminatorAt) resolved + simp only [terminatorAllocationEvents, resolved, targetResolved] + exact applyAllocationEvents_history heap values (by simpa using arguments.lengths) + +/-- Two successful steps in the same unchanged block have equal allocation +event increments. Operand liveness and the history relation also cover +dynamic partial application and returns through pending arguments. -/ +theorem unchangedStep_allocationDelta + {limits : Validate.Limits} {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {baselineStore rewrittenStore : Store} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + {baselineFrame rewrittenFrame : Frame} + (frame : StableLiveFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + {baselineStack rewrittenStack : List Continuation} + (stack : StableLiveStackIso limits validation heap.locRel baselineStack rewrittenStack) + {block : Block} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = some block) + {baselineContext rewrittenContext : Eval.Context} {interpretation : Interpretation} + {baselineFuel rewrittenFuel : Nat} {baselineTarget rewrittenTarget : Machine} + (baselineStep : Step baselineContext interpretation + ⟨baselineStore, baselineFuel, .running baselineFrame baselineStack⟩ baselineTarget) + (rewrittenStep : Step rewrittenContext interpretation + ⟨rewrittenStore, rewrittenFuel, .running rewrittenFrame rewrittenStack⟩ rewrittenTarget) : + AllocationDelta baselineStore baselineTarget.store rewrittenStore rewrittenTarget.store := by + cases baselineStep.classify with + | instruction found pc instructionAt classified => + have blockEq := Option.some.inj (found.symm.trans sourceAt) + subst block + have targetPc := pc + rw [frame.pc] at targetPc + have targetInstruction := instructionAt + simp only [frame.pc] at targetInstruction + have baseline := classified.allocationEvents + have rewritten := rewrittenStep.instructionAllocationEvents targetAt targetPc targetInstruction + have cost := instructionAllocationEvents_history heap frame sourceAt pc instructionAt classified + rw [← cost] at rewritten + exact AllocationDelta.of_increments baseline rewritten + | terminator found pc terminatorAt classified => + have blockEq := Option.some.inj (found.symm.trans sourceAt) + subst block + have targetPc : rewrittenFrame.pc = _ := frame.pc.symm.trans pc + have baseline := classified.allocationEvents + have rewritten := rewrittenStep.terminatorAllocationEvents targetAt targetPc terminatorAt + have cost := terminatorAllocationEvents_history heap frame stack sourceAt pc terminatorAt classified + rw [← cost] at rewritten + exact AllocationDelta.of_increments baseline rewritten + + +theorem instructionRCCharge_history + {limits : Validate.Limits} {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {baselineStore rewrittenStore : Store} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + {baselineFrame rewrittenFrame : Frame} + (frame : StableLiveFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + {block : Block} {instruction : Instr} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = some block) + (pc : baselineFrame.pc < block.instructions.size) + (instructionAt : block.instructions[baselineFrame.pc] = instruction) + {context : Eval.Context} {interpretation : Interpretation} {heapFuel : Nat} + {stack : List Continuation} {target : Machine} + (classified : InstructionTransferCase context interpretation baselineStore heapFuel + baselineFrame stack instruction target) : + instructionRCCharge baselineStore baselineFrame instruction = + instructionRCCharge rewrittenStore rewrittenFrame instruction := by + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rwa [frame.baselineDefinition] at sourceAt + have atIndex : block.instructions[baselineFrame.pc]? = some instruction := by + simpa [instructionAt] using Array.getElem?_eq_getElem pc + cases instruction <;> try rfl + case retainShared atom => + cases classified with + | retainShared resolved retained => + obtain ⟨rewrittenValue, targetResolved, values⟩ := frame.values.resolveAtom + (AtomLiveFrom.instruction sourceBlockAt atIndex Liveness.InstrUsesAtom.retainShared) resolved + simp only [instructionRCCharge, resolved, targetResolved] + cases values <;> rfl + case resetShared atom cid => + have lift : ∀ {value}, resolveAtom baselineFrame.values atom = .ok value → + instructionRCCharge baselineStore baselineFrame (.resetShared atom cid) = + instructionRCCharge rewrittenStore rewrittenFrame (.resetShared atom cid) := by + intro value resolved + obtain ⟨rewrittenValue, targetResolved, values⟩ := frame.values.resolveAtom + (AtomLiveFrom.instruction sourceBlockAt atIndex Liveness.InstrUsesAtom.resetShared) resolved + simpa only [instructionRCCharge, resolved, targetResolved] using resetRCCharge_history heap values + cases classified <;> exact lift (by assumption) + case apply functionAtom argumentAtoms => + cases classified with + | apply noCredits functionResolved argumentsResolved transferred => + obtain ⟨rewrittenFunction, targetFunction, functions⟩ := frame.values.resolveAtom + (AtomLiveFrom.instruction sourceBlockAt atIndex Liveness.InstrUsesAtom.applyFunction) + functionResolved + obtain ⟨rewrittenArguments, targetArguments, arguments⟩ := frame.values.resolveAtoms + (AtomsLiveFrom.instruction sourceBlockAt atIndex (atoms := argumentAtoms) (by + intro atom member; exact Liveness.InstrUsesAtom.applyArgument member)) argumentsResolved + simp only [instructionRCCharge, functionResolved, argumentsResolved, + targetFunction, targetArguments] + exact applyRCCharge_history heap functions (by simpa using arguments.lengths) + +theorem terminatorRCCharge_history + {limits : Validate.Limits} {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {baselineStore rewrittenStore : Store} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + {baselineFrame rewrittenFrame : Frame} + (frame : StableLiveFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + {baselineStack rewrittenStack : List Continuation} + (stack : StableLiveStackIso limits validation heap.locRel baselineStack rewrittenStack) + {block : Block} {terminator : Terminator} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminatorAt : block.terminator = terminator) + {context : Eval.Context} {interpretation : Interpretation} {heapFuel : Nat} + {target : Machine} + (classified : TerminatorTransferCase context interpretation baselineStore heapFuel + baselineFrame baselineStack terminator target) : + terminatorRCCharge baselineStore baselineFrame baselineStack terminator = + terminatorRCCharge rewrittenStore rewrittenFrame rewrittenStack terminator := by + cases terminator <;> try rfl + case ret atom => + cases stack with + | nil => rfl + | cons head tail => + cases head with + | resume caller => rfl + | applyMore arguments caller => + cases classified with + | retApplyMore resolved noCredits world transferred => + have sourceBlockAt : source.blocks[baselineFrame.block]? = some block := by + rwa [frame.baselineDefinition] at sourceAt + obtain ⟨rewrittenValue, targetResolved, values⟩ := frame.values.resolveAtom + (AtomLiveFrom.ret sourceBlockAt pc terminatorAt) resolved + simp only [terminatorRCCharge, resolved, targetResolved] + exact applyRCCharge_history heap values (by simpa using arguments.lengths) + +/-- Ordinary matched steps compare their exact RC charges and recorded peaks. +The independent cost certificate does not alter the semantic relation. -/ +theorem unchangedStep_costDelta + {limits : Validate.Limits} {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {baselineStore rewrittenStore : Store} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + {baselineFrame rewrittenFrame : Frame} + (frame : StableLiveFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + {baselineStack rewrittenStack : List Continuation} + (stack : StableLiveStackIso limits validation heap.locRel baselineStack rewrittenStack) + {block : Block} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = some block) + {baselineContext rewrittenContext : Eval.Context} {interpretation : Interpretation} + {baselineFuel rewrittenFuel : Nat} {baselineTarget rewrittenTarget : Machine} + (baselineStep : Step baselineContext interpretation + ⟨baselineStore, baselineFuel, .running baselineFrame baselineStack⟩ baselineTarget) + (rewrittenStep : Step rewrittenContext interpretation + ⟨rewrittenStore, rewrittenFuel, .running rewrittenFrame rewrittenStack⟩ rewrittenTarget) + (related : StableLiveMachineRel limits validation baselineTarget rewrittenTarget) : + CostDelta baselineStore baselineTarget.store rewrittenStore rewrittenTarget.store := by + obtain ⟨locRel, outputHeaps, _fuel, _control⟩ := related + cases baselineStep.classify with + | instruction found pc instructionAt classified => + have blockEq := Option.some.inj (found.symm.trans sourceAt) + subst block + have targetPc := pc + rw [frame.pc] at targetPc + have targetInstruction := instructionAt + simp only [frame.pc] at targetInstruction + have rewritten := rewrittenStep.instructionCosts targetAt targetPc targetInstruction + have charge := instructionRCCharge_history heap frame sourceAt pc instructionAt classified + have events := instructionAllocationEvents_history heap frame sourceAt pc instructionAt classified + rw [← charge, ← events] at rewritten + exact CostDelta.of_observations (history_pendingRC_eq heap) outputHeaps.pendingRC_eq + outputHeaps.live_eq classified.rcCharge rewritten.1 classified.peakLive rewritten.2 + | terminator found pc terminatorAt classified => + have blockEq := Option.some.inj (found.symm.trans sourceAt) + subst block + have targetPc : rewrittenFrame.pc = _ := frame.pc.symm.trans pc + have rewritten := rewrittenStep.terminatorCosts targetAt targetPc terminatorAt + have charge := terminatorRCCharge_history heap frame stack sourceAt pc terminatorAt classified + have events := terminatorAllocationEvents_history heap frame stack sourceAt pc terminatorAt classified + rw [← charge, ← events] at rewritten + exact CostDelta.of_observations (history_pendingRC_eq heap) outputHeaps.pendingRC_eq + outputHeaps.live_eq classified.rcCharge rewritten.1 classified.peakLive rewritten.2 + + +/-! ## Liveness-indexed macro and whole-run lifting -/ + +/-- A synchronization macro whose endpoints use the live-indexed machine +relation. -/ +inductive StableLiveMacroSimulation (limits : Validate.Limits) + (validation : Validate.Context) (baselineContext rewrittenContext : + Eval.Context) (interpretation : Interpretation) + (baselineStart rewrittenStart : Machine) : Prop where + | intro (baselineCount rewrittenCount : Nat) + (baselinePositive : 0 < baselineCount) + (rewrittenPositive : 0 < rewrittenCount) + (baselineTarget rewrittenTarget : Machine) + (baselineSteps : Steps baselineContext interpretation baselineCount + baselineStart baselineTarget) + (rewrittenSteps : Steps rewrittenContext interpretation rewrittenCount + rewrittenStart rewrittenTarget) + (related : StableLiveMachineRel limits validation baselineTarget + rewrittenTarget) + +/-- A live-indexed synchronization macro whose baseline length remains visible +in its type. Accepted-site attachment uses this index to identify the +semantic baseline endpoint with the independently reconstructed compiler +endpoint by fixed-length determinism. Separate certificates record equal +allocation events and compare RC/peak costs without strengthening the semantic +relation. -/ +inductive StableLiveMacroSimulationAt (limits : Validate.Limits) + (validation : Validate.Context) (baselineContext rewrittenContext : + Eval.Context) (interpretation : Interpretation) + (baselineCount : Nat) (baselineStart rewrittenStart : Machine) : Prop where + | intro (baselinePositive : 0 < baselineCount) + (rewrittenCount : Nat) (rewrittenPositive : 0 < rewrittenCount) + (baselineTarget rewrittenTarget : Machine) + (baselineSteps : Steps baselineContext interpretation baselineCount + baselineStart baselineTarget) + (rewrittenSteps : Steps rewrittenContext interpretation rewrittenCount + rewrittenStart rewrittenTarget) + (related : StableLiveMachineRel limits validation baselineTarget + rewrittenTarget) + (allocationDelta : AllocationDelta baselineStart.store baselineTarget.store + rewrittenStart.store rewrittenTarget.store) + (costDelta : CostDelta baselineStart.store baselineTarget.store + rewrittenStart.store rewrittenTarget.store) + +/-- Forget the visible baseline length of an indexed synchronization macro. -/ +theorem StableLiveMacroSimulationAt.simulation {limits : Validate.Limits} + {validation : Validate.Context} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} {baselineCount : Nat} + {baselineStart rewrittenStart : Machine} + (step : StableLiveMacroSimulationAt limits validation baselineContext + rewrittenContext interpretation baselineCount baselineStart + rewrittenStart) : + StableLiveMacroSimulation limits validation baselineContext + rewrittenContext interpretation baselineStart rewrittenStart := by + cases step with + | intro baselinePositive rewrittenCount rewrittenPositive baselineTarget + rewrittenTarget baselineSteps rewrittenSteps related _allocationDelta _costDelta => + exact .intro baselineCount rewrittenCount baselinePositive + rewrittenPositive baselineTarget rewrittenTarget baselineSteps + rewrittenSteps related + +/-- A live-indexed synchronization macro together with preservation of the +compiler/runtime invariant chosen by its caller. -/ +inductive StableLiveMacroInvariantStep (limits : Validate.Limits) + (validation : Validate.Context) (baselineContext rewrittenContext : + Eval.Context) (interpretation : Interpretation) + (invariant : Machine → Machine → Prop) + (baselineStart rewrittenStart : Machine) : Prop where + | intro (baselineCount rewrittenCount : Nat) + (baselinePositive : 0 < baselineCount) + (rewrittenPositive : 0 < rewrittenCount) + (baselineTarget rewrittenTarget : Machine) + (baselineSteps : Steps baselineContext interpretation baselineCount + baselineStart baselineTarget) + (rewrittenSteps : Steps rewrittenContext interpretation rewrittenCount + rewrittenStart rewrittenTarget) + (related : StableLiveMachineRel limits validation baselineTarget + rewrittenTarget) + (preserved : invariant baselineTarget rewrittenTarget) + +/-- Forget invariant preservation while retaining the live-indexed endpoint +relation. -/ +theorem StableLiveMacroInvariantStep.simulation {limits : Validate.Limits} + {validation : Validate.Context} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {invariant : Machine → Machine → Prop} + {baselineStart rewrittenStart : Machine} + (step : StableLiveMacroInvariantStep limits validation baselineContext + rewrittenContext interpretation invariant baselineStart + rewrittenStart) : + StableLiveMacroSimulation limits validation baselineContext + rewrittenContext interpretation baselineStart rewrittenStart := by + cases step with + | intro baselineCount rewrittenCount baselinePositive rewrittenPositive + baselineTarget rewrittenTarget baselineSteps rewrittenSteps related + _preserved => + exact .intro baselineCount rewrittenCount baselinePositive + rewrittenPositive baselineTarget rewrittenTarget baselineSteps + rewrittenSteps related + +/-- Strengthen a live-indexed synchronization macro after proving the global +invariant at its endpoint. -/ +theorem StableLiveMacroSimulation.preserveInvariant + {limits : Validate.Limits} {validation : Validate.Context} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {invariant : Machine → Machine → Prop} + {baselineStart rewrittenStart : Machine} + (simulation : StableLiveMacroSimulation limits validation baselineContext + rewrittenContext interpretation baselineStart rewrittenStart) + (preserved : ∀ {baselineCount rewrittenCount : Nat} + {baselineTarget rewrittenTarget : Machine}, + Steps baselineContext interpretation baselineCount baselineStart + baselineTarget → + Steps rewrittenContext interpretation rewrittenCount rewrittenStart + rewrittenTarget → + StableLiveMachineRel limits validation baselineTarget rewrittenTarget → + invariant baselineTarget rewrittenTarget) : + StableLiveMacroInvariantStep limits validation baselineContext + rewrittenContext interpretation invariant baselineStart + rewrittenStart := by + cases simulation with + | intro baselineCount rewrittenCount baselinePositive rewrittenPositive + baselineTarget rewrittenTarget baselineSteps rewrittenSteps related => + exact .intro baselineCount rewrittenCount baselinePositive + rewrittenPositive baselineTarget rewrittenTarget baselineSteps + rewrittenSteps related (preserved baselineSteps rewrittenSteps related) + +/-- Package two related one-step transitions as a live-indexed unchanged +macro. -/ +theorem StableLiveMacroSimulation.ofStepsOne {limits : Validate.Limits} + {validation : Validate.Context} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStart rewrittenStart baselineTarget rewrittenTarget : Machine} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (baselineRunning : baselineStart.control = + .running baselineFrame baselineStack) + (rewrittenRunning : rewrittenStart.control = + .running rewrittenFrame rewrittenStack) + (baselineStep : Step baselineContext interpretation baselineStart + baselineTarget) + (rewrittenStep : Step rewrittenContext interpretation rewrittenStart + rewrittenTarget) + (related : StableLiveMachineRel limits validation baselineTarget + rewrittenTarget) : + StableLiveMacroSimulation limits validation baselineContext + rewrittenContext interpretation baselineStart rewrittenStart := by + exact .intro 1 1 (by omega) (by omega) baselineTarget rewrittenTarget + (baselineStep.toSteps baselineRunning) + (rewrittenStep.toSteps rewrittenRunning) related + +/-- Every macro proved under the older all-register endpoint relation also +provides a live-indexed macro. -/ +theorem StableMacroSimulation.toLive {limits : Validate.Limits} + {validation : Validate.Context} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStart rewrittenStart : Machine} + (simulation : StableMacroSimulation limits validation baselineContext + rewrittenContext interpretation baselineStart rewrittenStart) : + StableLiveMacroSimulation limits validation baselineContext + rewrittenContext interpretation baselineStart rewrittenStart := by + cases simulation with + | intro baselineCount rewrittenCount baselinePositive rewrittenPositive + baselineTarget rewrittenTarget baselineSteps rewrittenSteps related => + exact .intro baselineCount rewrittenCount baselinePositive + rewrittenPositive baselineTarget rewrittenTarget baselineSteps + rewrittenSteps + (Ix.Compiler.IxIR2.ReuseLiveSim.StableMachineRel.toLive related) + +/-- Package the live logical-hot accepted-site theorem as a synchronization macro. +The premises are the runtime facts needed by the optimization, rather than an +already-packaged simulation result. -/ +theorem acceptedHotLogicalStableLiveMacroSimulation {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {index helperOffset : Nat} {block : Block} + {site : Reuse.Site limits validation block} + (found : Reuse.FunctionDecisions.At rewrite.decisions index helperOffset + block (.accepted site)) + {baselineContext rewrittenContext : Eval.Context} + (baselineSchemas : baselineContext.schemas = validation.schemas) + (rewrittenSchemas : rewrittenContext.schemas = validation.schemas) + {baselineStore rewrittenStore baselineRetained baselineReleased : Store} + (heap : HeapContentsEq baselineStore rewrittenStore) + {parameters fields newFields callValues : Array RVal} + {location fieldFuel remaining rewrittenFuel : Nat} + {baselineStack rewrittenStack : List Continuation} + (stack : StableLiveStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {ambient : List IxIR1.Sim.Root} {allocationSchema : CtorSchema} + (fuel : fieldFuel + 1 ≤ rewrittenFuel) + (allocationSchemaAt : + baselineContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (sourceResolved : resolveAtom parameters (.reg site.shape.source) = + .ok (.loc location)) + (sourceBoxAt : baselineStore.get? location = some + ⟨.shared, 1, .ctorN site.shape.sourceConstructor fields⟩) + (owned : IxIR1.Sim.RootOwnership baselineStore.heap + (⟨.shared, .loc location⟩ :: ambient)) + (retained : RetainSharedMany baselineStore fields baselineRetained) + (released : releaseShared (fieldFuel + 1) baselineRetained + (.loc location) = .ok (baselineReleased, remaining)) + (allocationResolved : resolveAtoms + (baselinePrefixValues parameters fields) + site.shape.allocationArguments = .ok newFields) + (baselineFieldWorlds : + FieldWorlds baselineReleased allocationSchema newFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc (baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields)).2)) + site.shape.tailArguments = .ok callValues) + (arity : callValues.size = source.signature.params.size) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := parameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := index + values := parameters + credits := #[] } + rewrittenStack } + StableLiveMacroSimulation limits validation baselineContext rewrittenContext + .logical baselineMachine rewrittenMachine := by + dsimp only + obtain ⟨baselineSteps, rewrittenSteps, related⟩ := + acceptedHotLogicalStableLiveSimulation rewrite found baselineSchemas + rewrittenSchemas heap stack fuel allocationSchemaAt parameterCount + fieldCount sourceResolved sourceBoxAt owned retained released + allocationResolved baselineFieldWorlds tailResolved arity + exact .intro (2 * site.shape.fieldCount + 3) 4 (by omega) (by omega) _ _ + baselineSteps rewrittenSteps related + +/-- Package the live cold accepted-site theorem as a synchronization macro. The +cold branch is common to logical and physical interpretations. -/ +theorem acceptedColdStableLiveMacroSimulation {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {index helperOffset : Nat} {block : Block} + {site : Reuse.Site limits validation block} + (found : Reuse.FunctionDecisions.At rewrite.decisions index helperOffset + block (.accepted site)) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + (baselineSchemas : baselineContext.schemas = validation.schemas) + (rewrittenSchemas : rewrittenContext.schemas = validation.schemas) + {baselineStore rewrittenStore baselineRetained : Store} + (heap : HeapContentsEq baselineStore rewrittenStore) + {parameters fields newFields callValues : Array RVal} + {location fieldFuel rewrittenFuel rc retainedRc : Nat} + {baselineStack rewrittenStack : List Continuation} + (stack : StableLiveStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {allocationSchema : CtorSchema} + (fuel : fieldFuel + 1 ≤ rewrittenFuel) + (allocationSchemaAt : + baselineContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (sourceResolved : resolveAtom parameters (.reg site.shape.source) = + .ok (.loc location)) + (sourceBoxAt : baselineStore.get? location = some + ⟨.shared, rc, .ctorN site.shape.sourceConstructor fields⟩) + (shared : 1 < rc) + (retained : RetainSharedMany baselineStore fields baselineRetained) + (retainedAt : baselineRetained.get? location = some + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩) + (allocationResolved : resolveAtoms + (baselinePrefixValues parameters fields) + site.shape.allocationArguments = .ok newFields) + (baselineFieldWorlds : FieldWorlds + (baselineDecrementStore baselineRetained location + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩) + allocationSchema newFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc ((baselineDecrementStore baselineRetained location + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩).allocNode .shared + (.ctorN site.shape.allocationConstructor newFields)).2)) + site.shape.tailArguments = .ok callValues) + (arity : callValues.size = source.signature.params.size) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := parameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := index + values := parameters + credits := #[] } + rewrittenStack } + StableLiveMacroSimulation limits validation baselineContext rewrittenContext + interpretation baselineMachine rewrittenMachine := by + dsimp only + obtain ⟨_rewrittenRetained, _retained, baselineSteps, rewrittenSteps, + related⟩ := + acceptedColdStableLiveSimulation rewrite found baselineSchemas + rewrittenSchemas heap stack fuel allocationSchemaAt parameterCount + fieldCount sourceResolved sourceBoxAt shared retained retainedAt + allocationResolved baselineFieldWorlds tailResolved arity + exact .intro (2 * site.shape.fieldCount + 3) 4 (by omega) (by omega) _ _ + baselineSteps rewrittenSteps related + +/-- Package the live physical-hot accepted-site theorem as a synchronization +macro. Unlike the exact-content wrappers, the input registers and suspended +continuations may already be related by a nontrivial allocation-history +bijection; the wrapped theorem replaces that relation at the reused location +and preserves it everywhere else that remains reachable. -/ +theorem acceptedHotPhysicalStableLiveMacroSimulationIso + {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {index helperOffset : Nat} {block : Block} + {site : Reuse.Site limits validation block} + (found : Reuse.FunctionDecisions.At rewrite.decisions index helperOffset + block (.accepted site)) + {baselineContext rewrittenContext : Eval.Context} + (baselineSchemas : baselineContext.schemas = validation.schemas) + (rewrittenSchemas : rewrittenContext.schemas = validation.schemas) + {baselineStore rewrittenStore baselineRetained baselineReleased : Store} + (inputIso : IxIR1.Sim.HeapIso rewrittenStore.heap baselineStore.heap) + {baselineParameters rewrittenParameters baselineFields rewrittenFields + baselineNewFields rewrittenNewFields baselineCallValues : Array RVal} + {baselineLocation rewrittenLocation fieldFuel remaining rewrittenFuel : + Nat} + {baselineStack rewrittenStack : List Continuation} + (parameters : LiveValuesIso source index 0 + (fun baselineLocation rewrittenLocation => + inputIso.locRel rewrittenLocation baselineLocation) + baselineParameters rewrittenParameters) + (stackAvoids : StableLiveStackAvoids limits validation + (fun baselineLocation rewrittenLocation => + inputIso.locRel rewrittenLocation baselineLocation) + rewrittenLocation baselineStack rewrittenStack) + {baselineBefore baselineAfter rewrittenBefore rewrittenAfter : + List IxIR1.Sim.Root} + {allocationSchema : CtorSchema} + (fuel : fieldFuel + 1 ≤ rewrittenFuel) + (locations : inputIso.locRel rewrittenLocation baselineLocation) + (allocationSchemaAt : + baselineContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (parameterCount : baselineParameters.size = site.shape.parameterCount) + (fieldCount : baselineFields.size = site.shape.fieldCount) + (baselineSourceResolved : + resolveAtom baselineParameters (.reg site.shape.source) = + .ok (.loc baselineLocation)) + (rewrittenSourceResolved : + resolveAtom rewrittenParameters (.reg site.shape.source) = + .ok (.loc rewrittenLocation)) + (baselineAt : baselineStore.get? baselineLocation = some + ⟨.shared, 1, + .ctorN site.shape.sourceConstructor baselineFields⟩) + (rewrittenAt : rewrittenStore.get? rewrittenLocation = some + ⟨.shared, 1, + .ctorN site.shape.sourceConstructor rewrittenFields⟩) + (baselineOwned : IxIR1.Sim.RootOwnership baselineStore.heap + (⟨.shared, .loc baselineLocation⟩ :: baselineBefore)) + (rewrittenOwned : IxIR1.Sim.RootOwnership rewrittenStore.heap + (⟨.shared, .loc rewrittenLocation⟩ :: rewrittenBefore)) + (retained : RetainSharedMany baselineStore baselineFields + baselineRetained) + (released : releaseShared (fieldFuel + 1) baselineRetained + (.loc baselineLocation) = .ok (baselineReleased, remaining)) + (baselinePartition : + (IxIR1.Sim.rootsFor .shared baselineFields.toList ++ + baselineBefore).Perm + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ + baselineAfter)) + (rewrittenPartition : + (IxIR1.Sim.rootsFor .shared rewrittenFields.toList ++ + rewrittenBefore).Perm + (IxIR1.Sim.rootsFor .shared rewrittenNewFields.toList ++ + rewrittenAfter)) + (mapped : MappedValuesInRoots site.shape + (baselinePrefixValues rewrittenParameters rewrittenFields) + rewrittenAfter) + (baselineAllocationResolved : resolveAtoms + (baselinePrefixValues baselineParameters baselineFields) + site.shape.allocationArguments = .ok baselineNewFields) + (rewrittenAllocationResolved : resolveAtoms + (baselinePrefixValues rewrittenParameters rewrittenFields) + site.shape.allocationArguments = .ok rewrittenNewFields) + (baselineFieldWorlds : + FieldWorlds baselineReleased allocationSchema baselineNewFields) + (rewrittenFieldWorlds : FieldWorlds + (physicalHotResetStore rewrittenStore rewrittenLocation) + allocationSchema rewrittenNewFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues baselineParameters baselineFields).push + (.loc (baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor baselineNewFields)).2)) + site.shape.tailArguments = .ok baselineCallValues) + (arity : baselineCallValues.size = source.signature.params.size) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := baselineParameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := index + values := rewrittenParameters + credits := #[] } + rewrittenStack } + StableLiveMacroSimulation limits validation baselineContext rewrittenContext + .physical baselineMachine rewrittenMachine := by + dsimp only + have mappedFull : MappedValuesInRoots site.shape + (baselinePrefixValues rewrittenParameters rewrittenFields) + (IxIR1.Sim.rootsFor .shared rewrittenNewFields.toList ++ + rewrittenAfter) := + MappedValuesInRoots.mono mapped (by + intro root member + exact List.mem_append_right _ member) + obtain ⟨_physical, _outputIso, _physicalCallValues, _reused, + _physicalOwned, _baselineOwned, _outputResult, _outputExtends, + baselineSteps, rewrittenSteps, _callsRelated, _outputStack, related⟩ := + acceptedHotPhysicalStableLiveSimulationIso rewrite found baselineSchemas + rewrittenSchemas inputIso parameters stackAvoids fuel locations allocationSchemaAt parameterCount + fieldCount baselineSourceResolved rewrittenSourceResolved baselineAt + rewrittenAt baselineOwned rewrittenOwned retained released + baselinePartition rewrittenPartition mappedFull + baselineAllocationResolved + rewrittenAllocationResolved baselineFieldWorlds rewrittenFieldWorlds + tailResolved arity + exact .intro (2 * site.shape.fieldCount + 3) 4 (by omega) (by omega) _ _ + baselineSteps rewrittenSteps related + +/-- Physical-hot synchronization derived from baseline ownership accounting. +The incoming isomorphism supplies rewritten ownership, root permutation, and +planner-root support. -/ +theorem acceptedHotPhysicalStableLiveMacroSimulationIsoOfAccountingAt + {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {index helperOffset : Nat} {block : Block} + {site : Reuse.Site limits validation block} + (found : Reuse.FunctionDecisions.At rewrite.decisions index helperOffset + block (.accepted site)) + {baselineContext rewrittenContext : Eval.Context} + (baselineSchemas : baselineContext.schemas = validation.schemas) + (rewrittenSchemas : rewrittenContext.schemas = validation.schemas) + {baselineStore rewrittenStore baselineRetained baselineReleased : Store} + (inputIso : IxIR1.Sim.HeapIso rewrittenStore.heap baselineStore.heap) + {baselineParameters rewrittenParameters baselineFields rewrittenFields + baselineNewFields rewrittenNewFields baselineCallValues : Array RVal} + {baselineLocation rewrittenLocation fieldFuel remaining rewrittenFuel : + Nat} + {baselineStack rewrittenStack : List Continuation} + (parameters : LiveValuesIso source index 0 + (fun baselineLocation rewrittenLocation => + inputIso.locRel rewrittenLocation baselineLocation) + baselineParameters rewrittenParameters) + (stackAvoids : StableLiveStackAvoids limits validation + (fun baselineLocation rewrittenLocation => + inputIso.locRel rewrittenLocation baselineLocation) + rewrittenLocation baselineStack rewrittenStack) + {oldRest newRest : List IxIR1.Sim.Root} + {allocationSchema : CtorSchema} + (fuel : fieldFuel + 1 ≤ rewrittenFuel) + (locations : inputIso.locRel rewrittenLocation baselineLocation) + (allocationSchemaAt : + baselineContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (parameterCount : baselineParameters.size = site.shape.parameterCount) + (fieldCount : baselineFields.size = site.shape.fieldCount) + (baselineSourceResolved : + resolveAtom baselineParameters (.reg site.shape.source) = + .ok (.loc baselineLocation)) + (rewrittenSourceResolved : + resolveAtom rewrittenParameters (.reg site.shape.source) = + .ok (.loc rewrittenLocation)) + (baselineAt : baselineStore.get? baselineLocation = some + ⟨.shared, 1, + .ctorN site.shape.sourceConstructor baselineFields⟩) + (rewrittenAt : rewrittenStore.get? rewrittenLocation = some + ⟨.shared, 1, + .ctorN site.shape.sourceConstructor rewrittenFields⟩) + (baselineOwned : IxIR1.Sim.RootOwnership baselineStore.heap + (⟨.shared, .loc baselineLocation⟩ :: oldRest)) + (retained : RetainSharedMany baselineStore baselineFields + baselineRetained) + (released : releaseShared (fieldFuel + 1) baselineRetained + (.loc baselineLocation) = .ok (baselineReleased, remaining)) + (baselineNewOwned : IxIR1.Sim.RootOwnership baselineReleased.heap + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ newRest)) + (baselineMapped : MappedValuesInRoots site.shape + (baselinePrefixValues baselineParameters baselineFields) + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ + (newRest ++ inertRoots + (IxIR1.Sim.rootsFor .shared baselineFields.toList ++ oldRest)))) + (baselineAllocationResolved : resolveAtoms + (baselinePrefixValues baselineParameters baselineFields) + site.shape.allocationArguments = .ok baselineNewFields) + (rewrittenAllocationResolved : resolveAtoms + (baselinePrefixValues rewrittenParameters rewrittenFields) + site.shape.allocationArguments = .ok rewrittenNewFields) + (baselineFieldWorlds : + FieldWorlds baselineReleased allocationSchema baselineNewFields) + (rewrittenFieldWorlds : FieldWorlds + (physicalHotResetStore rewrittenStore rewrittenLocation) + allocationSchema rewrittenNewFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues baselineParameters baselineFields).push + (.loc (baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor baselineNewFields)).2)) + site.shape.tailArguments = .ok baselineCallValues) + (arity : baselineCallValues.size = source.signature.params.size) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := baselineParameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := index + values := rewrittenParameters + credits := #[] } + rewrittenStack } + StableLiveMacroSimulationAt limits validation baselineContext + rewrittenContext .physical (2 * site.shape.fieldCount + 3) + baselineMachine rewrittenMachine := by + dsimp only + obtain ⟨sourceAt, _resetAt, _hotAt, _coldAt⟩ := rewrite.acceptedAt found + obtain ⟨leftBox, rightBox, leftLive, rightLive, boxesRelated⟩ := + inputIso.related_live locations + have leftBoxEq : leftBox = + ⟨.shared, 1, + .ctorN site.shape.sourceConstructor rewrittenFields⟩ := + Option.some.inj (leftLive.symm.trans rewrittenAt) + have rightBoxEq : rightBox = + ⟨.shared, 1, + .ctorN site.shape.sourceConstructor baselineFields⟩ := + Option.some.inj (rightLive.symm.trans baselineAt) + subst leftBox + subst rightBox + have oldFieldsRelated : IxIR1.Sim.RValsIso inputIso.locRel + rewrittenFields.toList baselineFields.toList := by + cases boxesRelated.node with + | ctor related => exact related + have fieldsRelated : IxIR1.Sim.RValsIso + (fun baselineLocation rewrittenLocation => + inputIso.locRel rewrittenLocation baselineLocation) + baselineFields.toList rewrittenFields.toList := + rvalsIso_symm oldFieldsRelated + have prefixLive : LiveValuesIso source index 0 + (fun baselineLocation rewrittenLocation => + inputIso.locRel rewrittenLocation baselineLocation) + (baselinePrefixValues baselineParameters baselineFields) + (baselinePrefixValues rewrittenParameters rewrittenFields) := by + simpa [baselinePrefixValues] using + (parameters.append fieldsRelated).append fieldsRelated + have allocationLiveAt : AtomsLiveFrom source index + (site.shape.releasePosition + 1) + site.shape.allocationArguments := + AtomsLiveFrom.instruction sourceAt site.fits.allocation (by + intro atom member + exact Liveness.InstrUsesAtom.alloc member) + have allocationLive : AtomsLiveFrom source index 0 + site.shape.allocationArguments := + allocationLiveAt.mono (Nat.zero_le _) + obtain ⟨actualRewrittenNewFields, actualRewrittenResolved, + newFieldsRelated⟩ := + prefixLive.resolveAtoms allocationLive baselineAllocationResolved + have actualNewFieldsEq : actualRewrittenNewFields = rewrittenNewFields := + Except.ok.inj + (actualRewrittenResolved.symm.trans rewrittenAllocationResolved) + subst actualRewrittenNewFields + have prefixContents : HeapContentsEq baselineReleased + (logicalHotResetStore baselineStore baselineLocation) := + hotPrefix_contents baselineAt baselineOwned retained released + have baselineMissing : baselineReleased.get? baselineLocation = none := by + rw [prefixContents.get?_eq baselineLocation] + change (logicalHotResetStore baselineStore baselineLocation).heap.get? + baselineLocation = none + rw [logicalHotResetStore_heap] + exact IxIR1.Sim.get?_kill_same baselineAt + obtain ⟨sourceSchema, siteAllocationSchema, sourceSchemaAt, + siteAllocationSchemaAt, sourceSchemaFields, allocationSchemaFields, + sourceLayout, allocationLayout⟩ := + evalRuntimeSchemas site baselineSchemas + have allocationSchemaEq : siteAllocationSchema = allocationSchema := by + exact Option.some.inj (siteAllocationSchemaAt.symm.trans allocationSchemaAt) + subst siteAllocationSchema + have uniformAllocationFields : allocationSchema.fields = + Array.replicate site.shape.fieldCount .shared := + allocationSchemaFields.trans sourceSchemaFields + have baselineNewFieldsAvoid : ∀ value ∈ baselineNewFields.toList, + value ≠ .loc baselineLocation := + FieldWorlds.avoidsMissing uniformAllocationFields baselineFieldWorlds + baselineMissing + have rewrittenNewFieldsAvoid : ∀ value ∈ rewrittenNewFields.toList, + value ≠ .loc rewrittenLocation := + rvalsIso_right_avoids_of_left inputIso locations newFieldsRelated + baselineNewFieldsAvoid + have restrictedNewFields : IxIR1.Sim.RValsIso + (fun rewrittenCandidate baselineCandidate => + inputIso.locRel rewrittenCandidate baselineCandidate ∧ + rewrittenCandidate ≠ rewrittenLocation) + rewrittenNewFields.toList baselineNewFields.toList := + rvalsIso_restrict_left (rvalsIso_symm newFieldsRelated) + rewrittenNewFieldsAvoid + obtain ⟨rewrittenBefore, rewrittenAfter, _entryRoots, + baselineEntryOwned, rewrittenOwned, baselinePartition, + rewrittenPartition, allocationRoots⟩ := + hotPrefixFieldRootAccountingIso inputIso locations baselineAt rewrittenAt + oldFieldsRelated baselineOwned retained released baselineNewOwned + restrictedNewFields + have fullRoots : IxIR1.Sim.RootsIso inputIso.locRel + (IxIR1.Sim.rootsFor .shared rewrittenNewFields.toList ++ + rewrittenAfter) + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ + (newRest ++ inertRoots + (IxIR1.Sim.rootsFor .shared baselineFields.toList ++ oldRest))) := by + simpa using allocationRoots.mono (fun {_ _} related => related.1) + have rewrittenMapped : MappedValuesInRoots site.shape + (baselinePrefixValues rewrittenParameters rewrittenFields) + (IxIR1.Sim.rootsFor .shared rewrittenNewFields.toList ++ + rewrittenAfter) := + MappedValuesInRoots.preimage site sourceAt inputIso prefixLive fullRoots + baselineMapped + obtain ⟨_physical, _outputIso, _physicalCallValues, _reused, + _physicalOwned, _baselineOwned, _outputResult, _outputExtends, + baselineSteps, rewrittenSteps, _callsRelated, _outputStack, related⟩ := + acceptedHotPhysicalStableLiveSimulationIso rewrite found baselineSchemas + rewrittenSchemas inputIso parameters stackAvoids fuel locations + allocationSchemaAt parameterCount fieldCount baselineSourceResolved + rewrittenSourceResolved baselineAt rewrittenAt baselineEntryOwned + rewrittenOwned retained released baselinePartition rewrittenPartition + rewrittenMapped baselineAllocationResolved rewrittenAllocationResolved + baselineFieldWorlds rewrittenFieldWorlds tailResolved arity + refine .intro (by omega) 4 (by omega) _ _ baselineSteps rewrittenSteps + related (AllocationDelta.of_increments (count := 1) ?_ ?_) + (CostDelta.hot retained released _reused related.live_eq) + · dsimp only + rw [Store.allocationEvents_allocNode, releaseShared_allocationEvents released, + retained.allocationEvents] + · simpa [physicalHotResetStore] using Store.reuseReservation_allocationEvents _reused + +/-- Compatibility wrapper that forgets the baseline-length index. -/ +theorem acceptedHotPhysicalStableLiveMacroSimulationIsoOfAccounting + {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {index helperOffset : Nat} {block : Block} + {site : Reuse.Site limits validation block} + (found : Reuse.FunctionDecisions.At rewrite.decisions index helperOffset + block (.accepted site)) + {baselineContext rewrittenContext : Eval.Context} + (baselineSchemas : baselineContext.schemas = validation.schemas) + (rewrittenSchemas : rewrittenContext.schemas = validation.schemas) + {baselineStore rewrittenStore baselineRetained baselineReleased : Store} + (inputIso : IxIR1.Sim.HeapIso rewrittenStore.heap baselineStore.heap) + {baselineParameters rewrittenParameters baselineFields rewrittenFields + baselineNewFields rewrittenNewFields baselineCallValues : Array RVal} + {baselineLocation rewrittenLocation fieldFuel remaining rewrittenFuel : + Nat} + {baselineStack rewrittenStack : List Continuation} + (parameters : LiveValuesIso source index 0 + (fun baselineLocation rewrittenLocation => + inputIso.locRel rewrittenLocation baselineLocation) + baselineParameters rewrittenParameters) + (stackAvoids : StableLiveStackAvoids limits validation + (fun baselineLocation rewrittenLocation => + inputIso.locRel rewrittenLocation baselineLocation) + rewrittenLocation baselineStack rewrittenStack) + {oldRest newRest : List IxIR1.Sim.Root} + {allocationSchema : CtorSchema} + (fuel : fieldFuel + 1 ≤ rewrittenFuel) + (locations : inputIso.locRel rewrittenLocation baselineLocation) + (allocationSchemaAt : + baselineContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (parameterCount : baselineParameters.size = site.shape.parameterCount) + (fieldCount : baselineFields.size = site.shape.fieldCount) + (baselineSourceResolved : + resolveAtom baselineParameters (.reg site.shape.source) = + .ok (.loc baselineLocation)) + (rewrittenSourceResolved : + resolveAtom rewrittenParameters (.reg site.shape.source) = + .ok (.loc rewrittenLocation)) + (baselineAt : baselineStore.get? baselineLocation = some + ⟨.shared, 1, + .ctorN site.shape.sourceConstructor baselineFields⟩) + (rewrittenAt : rewrittenStore.get? rewrittenLocation = some + ⟨.shared, 1, + .ctorN site.shape.sourceConstructor rewrittenFields⟩) + (baselineOwned : IxIR1.Sim.RootOwnership baselineStore.heap + (⟨.shared, .loc baselineLocation⟩ :: oldRest)) + (retained : RetainSharedMany baselineStore baselineFields + baselineRetained) + (released : releaseShared (fieldFuel + 1) baselineRetained + (.loc baselineLocation) = .ok (baselineReleased, remaining)) + (baselineNewOwned : IxIR1.Sim.RootOwnership baselineReleased.heap + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ newRest)) + (baselineMapped : MappedValuesInRoots site.shape + (baselinePrefixValues baselineParameters baselineFields) + (newRest ++ inertRoots + (IxIR1.Sim.rootsFor .shared baselineFields.toList ++ oldRest))) + (baselineAllocationResolved : resolveAtoms + (baselinePrefixValues baselineParameters baselineFields) + site.shape.allocationArguments = .ok baselineNewFields) + (rewrittenAllocationResolved : resolveAtoms + (baselinePrefixValues rewrittenParameters rewrittenFields) + site.shape.allocationArguments = .ok rewrittenNewFields) + (baselineFieldWorlds : + FieldWorlds baselineReleased allocationSchema baselineNewFields) + (rewrittenFieldWorlds : FieldWorlds + (physicalHotResetStore rewrittenStore rewrittenLocation) + allocationSchema rewrittenNewFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues baselineParameters baselineFields).push + (.loc (baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor baselineNewFields)).2)) + site.shape.tailArguments = .ok baselineCallValues) + (arity : baselineCallValues.size = source.signature.params.size) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := baselineParameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := index + values := rewrittenParameters + credits := #[] } + rewrittenStack } + StableLiveMacroSimulation limits validation baselineContext rewrittenContext + .physical baselineMachine rewrittenMachine := by + have baselineMappedFull : MappedValuesInRoots site.shape + (baselinePrefixValues baselineParameters baselineFields) + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ + (newRest ++ inertRoots + (IxIR1.Sim.rootsFor .shared baselineFields.toList ++ oldRest))) := + MappedValuesInRoots.mono baselineMapped (by + intro root member + exact List.mem_append_right _ member) + exact (acceptedHotPhysicalStableLiveMacroSimulationIsoOfAccountingAt + rewrite found baselineSchemas rewrittenSchemas inputIso parameters + stackAvoids fuel locations allocationSchemaAt parameterCount fieldCount + baselineSourceResolved rewrittenSourceResolved baselineAt rewrittenAt + baselineOwned retained released baselineNewOwned baselineMappedFull + baselineAllocationResolved rewrittenAllocationResolved + baselineFieldWorlds rewrittenFieldWorlds tailResolved arity).simulation + +/-- A live cold accepted site remains a synchronization macro after an earlier +physical reuse has changed concrete locations. The source retain/release +prefix is first commuted into the cold-reset order, that order is transported +through the incoming allocation history, and corresponding fresh allocations +extend the history for the recursive call. -/ +theorem acceptedColdStableLiveMacroSimulationIsoAt + {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {index helperOffset : Nat} {block : Block} + {site : Reuse.Site limits validation block} + (found : Reuse.FunctionDecisions.At rewrite.decisions index helperOffset + block (.accepted site)) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + (baselineSchemas : baselineContext.schemas = validation.schemas) + (rewrittenSchemas : rewrittenContext.schemas = validation.schemas) + {baselineStore rewrittenStore baselineRetained : Store} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + {baselineParameters rewrittenParameters baselineFields + baselineNewFields baselineCallValues : Array RVal} + {baselineLocation fieldFuel rewrittenFuel rc retainedRc : Nat} + {baselineStack rewrittenStack : List Continuation} + (parameters : LiveValuesIso source index 0 heap.locRel + baselineParameters rewrittenParameters) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {allocationSchema : CtorSchema} + (fuel : fieldFuel + 1 ≤ rewrittenFuel) + (allocationSchemaAt : + baselineContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (parameterCount : baselineParameters.size = site.shape.parameterCount) + (fieldCount : baselineFields.size = site.shape.fieldCount) + (baselineSourceResolved : + resolveAtom baselineParameters (.reg site.shape.source) = + .ok (.loc baselineLocation)) + (baselineAt : baselineStore.get? baselineLocation = some + ⟨.shared, rc, + .ctorN site.shape.sourceConstructor baselineFields⟩) + (shared : 1 < rc) + (retained : RetainSharedMany baselineStore baselineFields + baselineRetained) + (retainedAt : baselineRetained.get? baselineLocation = some + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor baselineFields⟩) + (baselineAllocationResolved : resolveAtoms + (baselinePrefixValues baselineParameters baselineFields) + site.shape.allocationArguments = .ok baselineNewFields) + (baselineFieldWorlds : FieldWorlds + (baselineDecrementStore baselineRetained baselineLocation + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor baselineFields⟩) + allocationSchema baselineNewFields) + (baselineTailResolved : resolveAtoms + ((baselinePrefixValues baselineParameters baselineFields).push + (.loc ((baselineDecrementStore baselineRetained baselineLocation + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor baselineFields⟩).allocNode + .shared + (.ctorN site.shape.allocationConstructor + baselineNewFields)).2)) + site.shape.tailArguments = .ok baselineCallValues) + (arity : baselineCallValues.size = source.signature.params.size) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := baselineParameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := index + values := rewrittenParameters + credits := #[] } + rewrittenStack } + StableLiveMacroSimulationAt limits validation baselineContext + rewrittenContext interpretation (2 * site.shape.fieldCount + 3) + baselineMachine rewrittenMachine := by + dsimp only + obtain ⟨sourceAt, resetAt, _hotAt, coldAt⟩ := rewrite.acceptedAt found + obtain ⟨sourceSchema, siteAllocationSchema, sourceSchemaAt, + siteAllocationSchemaAt, _sourceFields, _allocationFields, + sourceLayout, allocationLayout⟩ := + evalRuntimeSchemas site baselineSchemas + have allocationSchemaEq : siteAllocationSchema = allocationSchema := by + exact Option.some.inj + (siteAllocationSchemaAt.symm.trans allocationSchemaAt) + subst siteAllocationSchema + have rewrittenSourceSchemaAt : + rewrittenContext.schemas .shared site.shape.sourceConstructor = + some sourceSchema := by + simpa [baselineSchemas, rewrittenSchemas] using sourceSchemaAt + have rewrittenAllocationSchemaAt : + rewrittenContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema := by + simpa [baselineSchemas, rewrittenSchemas] using allocationSchemaAt + have sourceLiveAtRelease : AtomLiveFrom source index + site.shape.releasePosition (.reg site.shape.source) := + AtomLiveFrom.instruction sourceAt site.fits.release + Liveness.InstrUsesAtom.releaseShared + have sourceLive : AtomLiveFrom source index 0 (.reg site.shape.source) := + sourceLiveAtRelease.mono (Nat.zero_le _) + obtain ⟨rewrittenSourceValue, rewrittenSourceResolved, + sourceValueRelated⟩ := + parameters.resolveAtom sourceLive baselineSourceResolved + cases sourceValueRelated with + | @loc _ rewrittenLocation locations => + have baselineViewed : ConstructorView baselineStore baselineLocation + .shared site.shape.sourceConstructor + ⟨.shared, rc, + .ctorN site.shape.sourceConstructor baselineFields⟩ + baselineFields := + ConstructorView.of_box baselineAt rfl rfl + obtain ⟨rewrittenBox, rewrittenFields, rewrittenAt, + rewrittenViewed, boxes, fieldsRelated⟩ := + constructorView_historyIso heap locations baselineViewed + have rewrittenShared : 1 < rewrittenBox.rc := by + rw [← boxes.rc] + exact shared + have parameterSizes : baselineParameters.size = + rewrittenParameters.size := parameters.length + have rewrittenParameterCount : rewrittenParameters.size = + site.shape.parameterCount := + parameterSizes.symm.trans parameterCount + have fieldSizes : baselineFields.size = rewrittenFields.size := by + simpa using rvalsIso_length_eq fieldsRelated + have rewrittenFieldCount : rewrittenFields.size = + site.shape.fieldCount := fieldSizes.symm.trans fieldCount + have prefixLive : LiveValuesIso source index 0 heap.locRel + (baselinePrefixValues baselineParameters baselineFields) + (baselinePrefixValues rewrittenParameters rewrittenFields) := by + simpa [baselinePrefixValues] using + (parameters.append fieldsRelated).append fieldsRelated + have allocationLiveAt : AtomsLiveFrom source index + (site.shape.releasePosition + 1) + site.shape.allocationArguments := + AtomsLiveFrom.instruction sourceAt site.fits.allocation (by + intro atom member + exact Liveness.InstrUsesAtom.alloc member) + have allocationLive : AtomsLiveFrom source index 0 + site.shape.allocationArguments := + allocationLiveAt.mono (Nat.zero_le _) + obtain ⟨rewrittenNewFields, rewrittenAllocationResolved, + newFieldsRelated⟩ := + prefixLive.resolveAtoms allocationLive baselineAllocationResolved + obtain ⟨actualRetainedRc, actualRetainedAt, baselineReleasedRun, + baselineResetRetained, baselineResetHeapEq⟩ := + coldPrefix_commutes (heapFuel := fieldFuel) baselineAt shared retained + have retainedBoxesEqual : + (⟨.shared, actualRetainedRc, + .ctorN site.shape.sourceConstructor baselineFields⟩ : + IxIR1.NodeBox) = + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor baselineFields⟩ := + Option.some.inj (actualRetainedAt.symm.trans retainedAt) + have retainedRcEqual : actualRetainedRc = retainedRc := by + cases retainedBoxesEqual + rfl + subst actualRetainedRc + let baselineReleased := + baselineDecrementStore baselineRetained baselineLocation + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor baselineFields⟩ + let baselineResetStore := + baselineReleased.tickResetAttempt.tickColdReset + let baselineBox : IxIR1.NodeBox := + ⟨.shared, rc, + .ctorN site.shape.sourceConstructor baselineFields⟩ + let updated := heap.setBox locations + (show baselineStore.heap.get? baselineLocation = some baselineBox from + baselineAt) + (show rewrittenStore.heap.get? rewrittenLocation = some rewrittenBox + from rewrittenAt) + (show IxIR1.Sim.NodeBoxIso heap.locRel + { baselineBox with rc := baselineBox.rc - 1 } + { rewrittenBox with rc := rewrittenBox.rc - 1 } from + ⟨boxes.world, + congrArg (fun count => count - 1) boxes.rc, boxes.node⟩) + let beforeRetains : IxIR1.Sim.HeapHistoryIso + (coldResetStartStore baselineStore baselineLocation + baselineBox).heap + (coldResetStartStore rewrittenStore rewrittenLocation + rewrittenBox).heap := by + simpa [coldResetStartStore, Eval.Store.tickResetAttempt, + Eval.Store.tickColdReset] using updated.rcTick + have relatedRetainedFields : IxIR1.Sim.RValsIso + beforeRetains.locRel baselineFields.toList rewrittenFields.toList := + by + change IxIR1.Sim.RValsIso heap.locRel _ _ + exact fieldsRelated + obtain ⟨rewrittenResetStore, afterRetains, + rewrittenResetRetained, afterRetainsRelation⟩ := + retainSharedMany_historyIso beforeRetains relatedRetainedFields + (by + simpa [baselineBox, baselineReleased, baselineResetStore] using + baselineResetRetained) + have baselineResetHeapEq' : baselineReleased.heap = + baselineResetStore.heap := by + simpa [baselineReleased, baselineResetStore] using + baselineResetHeapEq + let afterCold : IxIR1.Sim.HeapHistoryIso baselineReleased.heap + rewrittenResetStore.heap := + afterRetains.nodesEq + (congrArg IxIR1.Store.nodes baselineResetHeapEq') rfl + have afterColdRelation : afterCold.locRel = heap.locRel := by + calc + afterCold.locRel = afterRetains.locRel := rfl + _ = beforeRetains.locRel := afterRetainsRelation + _ = heap.locRel := rfl + have newFieldsAfterCold : IxIR1.Sim.RValsIso afterCold.locRel + baselineNewFields.toList rewrittenNewFields.toList := by + rw [afterColdRelation] + exact newFieldsRelated + have rewrittenFieldWorlds : FieldWorlds rewrittenResetStore + allocationSchema rewrittenNewFields := + baselineFieldWorlds.transport + (heapHistoryIso_fieldValuesWorldEq afterCold newFieldsAfterCold) + let baselineAllocation := baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor baselineNewFields) + let rewrittenAllocation := rewrittenResetStore.allocNode .shared + (.ctorN site.shape.allocationConstructor rewrittenNewFields) + let allocationHistory : IxIR1.Sim.HeapHistoryIso + baselineAllocation.1.heap rewrittenAllocation.1.heap := + afterCold.alloc (.ctor newFieldsAfterCold) + have oldExtends : ∀ {baselineCandidate rewrittenCandidate : Nat}, + heap.locRel baselineCandidate rewrittenCandidate → + allocationHistory.locRel baselineCandidate rewrittenCandidate := + by + intro baselineCandidate rewrittenCandidate related + apply Or.inr + rw [afterColdRelation] + exact related + have prefixAfterAllocation : LiveValuesIso source index 0 + allocationHistory.locRel + (baselinePrefixValues baselineParameters baselineFields) + (baselinePrefixValues rewrittenParameters rewrittenFields) := + prefixLive.mono oldExtends + have resultRelated : IxIR1.Sim.RValIso allocationHistory.locRel + (.loc baselineAllocation.2) (.loc rewrittenAllocation.2) := + .loc (.inl ⟨rfl, rfl⟩) + have tailInputsRelated : LiveValuesIso source index 0 + allocationHistory.locRel + ((baselinePrefixValues baselineParameters baselineFields).push + (.loc baselineAllocation.2)) + ((baselinePrefixValues rewrittenParameters rewrittenFields).push + (.loc rewrittenAllocation.2)) := + prefixAfterAllocation.push resultRelated + have tailLiveAt : AtomsLiveFrom source index block.instructions.size + site.shape.tailArguments := + AtomsLiveFrom.tailCallSelf sourceAt rfl site.fits.terminator + have tailLive : AtomsLiveFrom source index 0 + site.shape.tailArguments := + tailLiveAt.mono (Nat.zero_le _) + obtain ⟨rewrittenCallValues, rewrittenTailResolved, + callValuesRelated⟩ := + tailInputsRelated.resolveAtoms tailLive + (by simpa [baselineAllocation, baselineReleased] using + baselineTailResolved) + have callSizes : baselineCallValues.size = rewrittenCallValues.size := by + simpa using rvalsIso_length_eq callValuesRelated + have rewrittenArity : rewrittenCallValues.size = + rewrite.definition.signature.params.size := by + simpa using callSizes.symm.trans arity + have sourceNonempty : source.blocks.isEmpty = false := + blocks_nonempty_of_getElem sourceAt + have rewrittenNonempty : rewrite.definition.blocks.isEmpty = false := + blocks_nonempty_of_getElem resetAt + let baselineMachine : Machine := + { store := baselineStore + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := baselineParameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := index + values := rewrittenParameters + credits := #[] } + rewrittenStack } + have baselineExecution : Steps baselineContext interpretation + (2 * site.shape.fieldCount + 3) baselineMachine + { store := baselineAllocation.1 + heapFuel := fieldFuel + control := .running + { definition := source, values := baselineCallValues } + baselineStack } := by + simpa [baselineMachine, baselineAllocation, baselineReleased] using + baselineAcceptedControl site + (context := baselineContext) (interpretation := interpretation) + (definition := source) (blockId := index) + (parameters := baselineParameters) (fields := baselineFields) + (newFields := baselineNewFields) + (callValues := baselineCallValues) + (location := baselineLocation) (machine := baselineMachine) + (retainedStore := baselineRetained) + (releasedStore := baselineReleased) (remaining := fieldFuel) + (allocationSchema := allocationSchema) (stack := baselineStack) + sourceAt (by rfl) parameterCount fieldCount + baselineSourceResolved baselineAt rfl retained + (by simpa [baselineReleased] using baselineReleasedRun) + allocationSchemaAt baselineAllocationResolved + (by simpa [baselineReleased] using baselineFieldWorlds) + (by simpa [baselineAllocation, baselineReleased] using + baselineTailResolved) + arity sourceNonempty + have rewrittenExecution : Steps rewrittenContext interpretation 4 + rewrittenMachine + { store := rewrittenAllocation.1 + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition, + values := rewrittenCallValues } + rewrittenStack } := by + simpa [rewrittenMachine, rewrittenAllocation] using + coldAcceptedControl site + (context := rewrittenContext) + (interpretation := interpretation) + (definition := rewrite.definition) (resetId := index) + (hotId := source.blocks.size + helperOffset) + (coldId := source.blocks.size + helperOffset + 1) + (parameters := rewrittenParameters) (fields := rewrittenFields) + (newFields := rewrittenNewFields) + (callValues := rewrittenCallValues) + (location := rewrittenLocation) (box := rewrittenBox) + (sourceSchema := sourceSchema) + (allocationSchema := allocationSchema) + (machine := rewrittenMachine) (resetStore := rewrittenResetStore) + (stack := rewrittenStack) resetAt coldAt rewrittenSourceSchemaAt + rewrittenAllocationSchemaAt sourceLayout allocationLayout + (by rfl) rewrittenParameterCount rewrittenFieldCount + (by simpa using rewrittenSourceResolved) rewrittenViewed + rewrittenShared + (by + simpa [rewrittenMachine, coldResetStartStore] using + rewrittenResetRetained) + rewrittenAllocationResolved rewrittenFieldWorlds + (by simpa [rewrittenAllocation] using rewrittenTailResolved) + rewrittenArity rewrittenNonempty + have outputStack : StableLiveStackIso limits validation + allocationHistory.locRel baselineStack rewrittenStack := + stack.mono oldExtends + have outputFuel : fieldFuel ≤ rewrittenFuel := by omega + have related : StableLiveMachineRel limits validation + { store := baselineAllocation.1 + heapFuel := fieldFuel + control := .running + { definition := source, values := baselineCallValues } + baselineStack } + { store := rewrittenAllocation.1 + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition, + values := rewrittenCallValues } + rewrittenStack } := + StableLiveMachineRel.history allocationHistory outputFuel + (.running + (.rewritten rewrite + (StableLiveFrameIso.entry rewrite callValuesRelated)) + outputStack) + refine .intro (by omega) 4 (by omega) _ _ baselineExecution + rewrittenExecution related (AllocationDelta.of_increments (count := 1) ?_ ?_) + (CostDelta.cold retained rewrittenResetRetained + (referenceCountList_iso fieldsRelated) related.live_eq) + · change baselineAllocation.1.allocationEvents = baselineStore.allocationEvents + 1 + simp only [baselineAllocation, baselineReleased, baselineDecrementStore, + Store.allocationEvents_allocNode, Store.allocationEvents_setBox, + Store.allocationEvents_rcTick, retained.allocationEvents] + · change rewrittenAllocation.1.allocationEvents = rewrittenStore.allocationEvents + 1 + simp only [rewrittenAllocation, Store.allocationEvents_allocNode] + have events := rewrittenResetRetained.allocationEvents + simpa [coldResetStartStore] using events + +/-- Compatibility wrapper that forgets the baseline-length index. -/ +theorem acceptedColdStableLiveMacroSimulationIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {index helperOffset : Nat} {block : Block} + {site : Reuse.Site limits validation block} + (found : Reuse.FunctionDecisions.At rewrite.decisions index helperOffset + block (.accepted site)) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + (baselineSchemas : baselineContext.schemas = validation.schemas) + (rewrittenSchemas : rewrittenContext.schemas = validation.schemas) + {baselineStore rewrittenStore baselineRetained : Store} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + {baselineParameters rewrittenParameters baselineFields + baselineNewFields baselineCallValues : Array RVal} + {baselineLocation fieldFuel rewrittenFuel rc retainedRc : Nat} + {baselineStack rewrittenStack : List Continuation} + (parameters : LiveValuesIso source index 0 heap.locRel + baselineParameters rewrittenParameters) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {allocationSchema : CtorSchema} + (fuel : fieldFuel + 1 ≤ rewrittenFuel) + (allocationSchemaAt : + baselineContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (parameterCount : baselineParameters.size = site.shape.parameterCount) + (fieldCount : baselineFields.size = site.shape.fieldCount) + (baselineSourceResolved : + resolveAtom baselineParameters (.reg site.shape.source) = + .ok (.loc baselineLocation)) + (baselineAt : baselineStore.get? baselineLocation = some + ⟨.shared, rc, + .ctorN site.shape.sourceConstructor baselineFields⟩) + (shared : 1 < rc) + (retained : RetainSharedMany baselineStore baselineFields + baselineRetained) + (retainedAt : baselineRetained.get? baselineLocation = some + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor baselineFields⟩) + (baselineAllocationResolved : resolveAtoms + (baselinePrefixValues baselineParameters baselineFields) + site.shape.allocationArguments = .ok baselineNewFields) + (baselineFieldWorlds : FieldWorlds + (baselineDecrementStore baselineRetained baselineLocation + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor baselineFields⟩) + allocationSchema baselineNewFields) + (baselineTailResolved : resolveAtoms + ((baselinePrefixValues baselineParameters baselineFields).push + (.loc ((baselineDecrementStore baselineRetained baselineLocation + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor baselineFields⟩).allocNode + .shared + (.ctorN site.shape.allocationConstructor + baselineNewFields)).2)) + site.shape.tailArguments = .ok baselineCallValues) + (arity : baselineCallValues.size = source.signature.params.size) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := baselineParameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := index + values := rewrittenParameters + credits := #[] } + rewrittenStack } + StableLiveMacroSimulation limits validation baselineContext rewrittenContext + interpretation baselineMachine rewrittenMachine := by + exact (acceptedColdStableLiveMacroSimulationIsoAt rewrite found + baselineSchemas rewrittenSchemas heap parameters stack fuel + allocationSchemaAt parameterCount fieldCount baselineSourceResolved + baselineAt shared retained retainedAt baselineAllocationResolved + baselineFieldWorlds baselineTailResolved arity).simulation + +/-- Exhaustive synchronization dispatch from an allocation-history-related +live state. Ordinary blocks use the relation-aware one-step theorem; accepted +blocks remain a single macro obligation for the global invariant. -/ +theorem stableLiveMacroStepOfTraceIso {limits : Validate.Limits} + {validation : Validate.Context} {sourceProgram : Program} + (trace : Reuse.Trace limits validation sourceProgram) + {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {baselineStepTarget : Machine} + (stepped : Step + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + baselineStepTarget) + (accepted : ∀ {helperOffset : Nat} {block : Block} + {site : Reuse.Site limits validation block}, + Reuse.FunctionDecisions.At rewrite.decisions baselineFrame.block + helperOffset block (.accepted site) → + StableLiveMacroSimulation limits validation + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) : + StableLiveMacroSimulation limits validation + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } := by + have dispatch : ∀ {block : Block}, + baselineFrame.definition.blocks[baselineFrame.block]? = some block → + StableLiveMacroSimulation limits validation + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } := by + intro block blockAt + cases frame.blockCase blockAt with + | unchanged sourceAt targetAt => + have sourceBlockAt : source.blocks[baselineFrame.block]? = + some block := by + rw [← frame.baselineDefinition] + exact blockAt + have blockEq := Option.some.inj (sourceAt.symm.trans sourceBlockAt) + cases blockEq + have rewrittenBlockAt : + rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block := by + rw [frame.rewrittenDefinition, ← frame.block] + exact targetAt + obtain ⟨rewrittenTarget, rewrittenStep, related⟩ := + unchangedStepOfTraceLiveIso trace rewrite heap fuel frame stack blockAt + rewrittenBlockAt stepped + exact StableLiveMacroSimulation.ofStepsOne rfl rfl stepped rewrittenStep + related + | accepted found => + exact accepted found + cases stepped.classify with + | instruction blockAt _pc _instructionAt _instructionCase => + exact dispatch blockAt + | terminator blockAt _pc _terminatorAt _terminatorCase => + exact dispatch blockAt + +/-- Strong induction over invariant-preserving live-indexed macros. -/ +theorem stableLiveFiniteExecutionOfMacroInvariant + {limits : Validate.Limits} {validation : Validate.Context} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + (invariant : Machine → Machine → Prop) + (related : ∀ {baseline rewritten}, invariant baseline rewritten → + StableLiveMachineRel limits validation baseline rewritten) + (advance : ∀ {baseline rewritten baselineNext : Machine} + {frame : Frame} {stack : List Continuation}, + invariant baseline rewritten → + baseline.control = .running frame stack → + Step baselineContext interpretation baseline baselineNext → + StableLiveMacroInvariantStep limits validation baselineContext + rewrittenContext interpretation invariant baseline rewritten) + {baselineCount : Nat} {baselineStart rewrittenStart baselineFinal : + Machine} + {finalStore : Store} {finalHeapFuel : Nat} {finalValue : RVal} + (initial : invariant baselineStart rewrittenStart) + (baselineSteps : Steps baselineContext interpretation baselineCount + baselineStart baselineFinal) + (halted : baselineFinal = + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue }) : + ∃ rewrittenCount rewrittenFinal, + Steps rewrittenContext interpretation rewrittenCount rewrittenStart + rewrittenFinal ∧ + invariant baselineFinal rewrittenFinal ∧ + StableLiveMachineRel limits validation baselineFinal rewrittenFinal := by + induction baselineCount using Nat.strongRecOn generalizing baselineStart + rewrittenStart baselineFinal with + | ind baselineCount smaller => + cases baselineSteps with + | refl => + exact ⟨0, rewrittenStart, .refl rewrittenStart, initial, + related initial⟩ + | @cons count before middle after frame stack running head tail => + have synchronizedStep := advance initial running head + cases synchronizedStep with + | intro macroBaselineCount macroRewrittenCount baselinePositive + rewrittenPositive macroBaselineTarget macroRewrittenTarget + macroBaselineSteps macroRewrittenSteps macroRelated preserved => + obtain ⟨suffixCount, totalCount, suffixSteps⟩ := + macroBaselineSteps.cancelPrefixToHalted + (Steps.cons running head tail) halted + have suffixSmaller : suffixCount < Nat.succ count := by + omega + obtain ⟨suffixRewrittenCount, rewrittenFinal, + suffixRewrittenSteps, finalInvariant, finalRelated⟩ := + smaller suffixCount suffixSmaller preserved suffixSteps halted + exact ⟨macroRewrittenCount + suffixRewrittenCount, + rewrittenFinal, + macroRewrittenSteps.trans suffixRewrittenSteps, + finalInvariant, finalRelated⟩ + +/-- Strong induction over invariant-preserving live-indexed macros where the +local dispatcher may inspect the actual remaining baseline execution. This +is strictly stronger than `stableLiveFiniteExecutionOfMacroInvariant`: it is +needed by multi-step rewrites whose first evaluator step is fuel-preserving, +while a later step in the same recognized prefix consumes heap fuel. The +remaining execution is evidence, not an oracle for the rewritten run; prefix +cancellation still checks every macro returned by the dispatcher against the +unique baseline execution. -/ +theorem stableLiveFiniteExecutionOfGuidedMacroInvariant + {limits : Validate.Limits} {validation : Validate.Context} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + (invariant : Machine → Machine → Prop) + (related : ∀ {baseline rewritten}, invariant baseline rewritten → + StableLiveMachineRel limits validation baseline rewritten) + (advance : ∀ {baseline rewritten baselineNext baselineFinal : Machine} + {frame : Frame} {stack : List Continuation} {suffixCount : Nat} + {finalStore : Store} {finalHeapFuel : Nat} {finalValue : RVal}, + invariant baseline rewritten → + baseline.control = .running frame stack → + Step baselineContext interpretation baseline baselineNext → + Steps baselineContext interpretation suffixCount baselineNext + baselineFinal → + baselineFinal = + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue } → + StableLiveMacroInvariantStep limits validation baselineContext + rewrittenContext interpretation invariant baseline rewritten) + {baselineCount : Nat} {baselineStart rewrittenStart baselineFinal : + Machine} + {finalStore : Store} {finalHeapFuel : Nat} {finalValue : RVal} + (initial : invariant baselineStart rewrittenStart) + (baselineSteps : Steps baselineContext interpretation baselineCount + baselineStart baselineFinal) + (halted : baselineFinal = + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue }) : + ∃ rewrittenCount rewrittenFinal, + Steps rewrittenContext interpretation rewrittenCount rewrittenStart + rewrittenFinal ∧ + invariant baselineFinal rewrittenFinal ∧ + StableLiveMachineRel limits validation baselineFinal rewrittenFinal := by + induction baselineCount using Nat.strongRecOn generalizing baselineStart + rewrittenStart baselineFinal with + | ind baselineCount smaller => + cases baselineSteps with + | refl => + exact ⟨0, rewrittenStart, .refl rewrittenStart, initial, + related initial⟩ + | @cons count before middle after frame stack running head tail => + have synchronizedStep := advance initial running head tail halted + cases synchronizedStep with + | intro macroBaselineCount macroRewrittenCount baselinePositive + rewrittenPositive macroBaselineTarget macroRewrittenTarget + macroBaselineSteps macroRewrittenSteps macroRelated preserved => + obtain ⟨suffixCount, totalCount, suffixSteps⟩ := + macroBaselineSteps.cancelPrefixToHalted + (Steps.cons running head tail) halted + have suffixSmaller : suffixCount < Nat.succ count := by + omega + obtain ⟨suffixRewrittenCount, rewrittenFinal, + suffixRewrittenSteps, finalInvariant, finalRelated⟩ := + smaller suffixCount suffixSmaller preserved suffixSteps halted + exact ⟨macroRewrittenCount + suffixRewrittenCount, + rewrittenFinal, + macroRewrittenSteps.trans suffixRewrittenSteps, + finalInvariant, finalRelated⟩ + +/-- Exact runner corollary for the liveness-indexed whole-execution lift. -/ +theorem stableLiveRunMachineOfMacroInvariant + {limits : Validate.Limits} {validation : Validate.Context} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + (invariant : Machine → Machine → Prop) + (related : ∀ {baseline rewritten}, invariant baseline rewritten → + StableLiveMachineRel limits validation baseline rewritten) + (advance : ∀ {baseline rewritten baselineNext : Machine} + {frame : Frame} {stack : List Continuation}, + invariant baseline rewritten → + baseline.control = .running frame stack → + Step baselineContext interpretation baseline baselineNext → + StableLiveMacroInvariantStep limits validation baselineContext + rewrittenContext interpretation invariant baseline rewritten) + {baselineCount : Nat} {baselineStart rewrittenStart : Machine} + {finalStore : Store} {finalHeapFuel : Nat} {finalValue : RVal} + (initial : invariant baselineStart rewrittenStart) + (baselineSteps : Steps baselineContext interpretation baselineCount + baselineStart + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue }) : + ∃ rewrittenCount rewrittenStore rewrittenHeapFuel rewrittenValue locRel, + let rewrittenFinal : Machine := + { store := rewrittenStore + heapFuel := rewrittenHeapFuel + control := .halted rewrittenValue } + Steps rewrittenContext interpretation rewrittenCount rewrittenStart + rewrittenFinal ∧ + invariant + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue } + rewrittenFinal ∧ + StableHeapRel finalStore rewrittenStore locRel ∧ + finalHeapFuel ≤ rewrittenHeapFuel ∧ + IxIR1.Sim.RValIso locRel finalValue rewrittenValue ∧ + Eval.runMachine rewrittenContext interpretation rewrittenCount + rewrittenStart = + .ok + { store := rewrittenStore + value := rewrittenValue + controlRemaining := 0 + heapRemaining := rewrittenHeapFuel } := by + obtain ⟨rewrittenCount, rewrittenFinal, rewrittenSteps, finalInvariant, + finalRelated⟩ := + stableLiveFiniteExecutionOfMacroInvariant invariant related advance initial + baselineSteps rfl + obtain ⟨rewrittenStore, rewrittenHeapFuel, rewrittenValue, locRel, + rewrittenFinalEq, finalHeap, finalFuel, finalValueRelated⟩ := + finalRelated.haltedParts + subst rewrittenFinal + refine ⟨rewrittenCount, rewrittenStore, rewrittenHeapFuel, rewrittenValue, + locRel, rewrittenSteps, finalInvariant, finalHeap, finalFuel, + finalValueRelated, ?_⟩ + exact rewrittenSteps.runMachine_halted + +/-- Exact runner corollary for execution-guided live-indexed macros. The +dispatcher receives the concrete suffix to the halted baseline endpoint, so +it can invert later resource-consuming steps in a recognized prefix without +strengthening the machine invariant with a global fuel bound. -/ +theorem stableLiveRunMachineOfGuidedMacroInvariant + {limits : Validate.Limits} {validation : Validate.Context} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + (invariant : Machine → Machine → Prop) + (related : ∀ {baseline rewritten}, invariant baseline rewritten → + StableLiveMachineRel limits validation baseline rewritten) + (advance : ∀ {baseline rewritten baselineNext baselineFinal : Machine} + {frame : Frame} {stack : List Continuation} {suffixCount : Nat} + {finalStore : Store} {finalHeapFuel : Nat} {finalValue : RVal}, + invariant baseline rewritten → + baseline.control = .running frame stack → + Step baselineContext interpretation baseline baselineNext → + Steps baselineContext interpretation suffixCount baselineNext + baselineFinal → + baselineFinal = + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue } → + StableLiveMacroInvariantStep limits validation baselineContext + rewrittenContext interpretation invariant baseline rewritten) + {baselineCount : Nat} {baselineStart rewrittenStart : Machine} + {finalStore : Store} {finalHeapFuel : Nat} {finalValue : RVal} + (initial : invariant baselineStart rewrittenStart) + (baselineSteps : Steps baselineContext interpretation baselineCount + baselineStart + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue }) : + ∃ rewrittenCount rewrittenStore rewrittenHeapFuel rewrittenValue locRel, + let rewrittenFinal : Machine := + { store := rewrittenStore + heapFuel := rewrittenHeapFuel + control := .halted rewrittenValue } + Steps rewrittenContext interpretation rewrittenCount rewrittenStart + rewrittenFinal ∧ + invariant + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue } + rewrittenFinal ∧ + StableHeapRel finalStore rewrittenStore locRel ∧ + finalHeapFuel ≤ rewrittenHeapFuel ∧ + IxIR1.Sim.RValIso locRel finalValue rewrittenValue ∧ + Eval.runMachine rewrittenContext interpretation rewrittenCount + rewrittenStart = + .ok + { store := rewrittenStore + value := rewrittenValue + controlRemaining := 0 + heapRemaining := rewrittenHeapFuel } := by + obtain ⟨rewrittenCount, rewrittenFinal, rewrittenSteps, finalInvariant, + finalRelated⟩ := + stableLiveFiniteExecutionOfGuidedMacroInvariant invariant related advance + initial baselineSteps rfl + obtain ⟨rewrittenStore, rewrittenHeapFuel, rewrittenValue, locRel, + rewrittenFinalEq, finalHeap, finalFuel, finalValueRelated⟩ := + finalRelated.haltedParts + subst rewrittenFinal + refine ⟨rewrittenCount, rewrittenStore, rewrittenHeapFuel, rewrittenValue, + locRel, rewrittenSteps, finalInvariant, finalHeap, finalFuel, + finalValueRelated, ?_⟩ + exact rewrittenSteps.runMachine_halted + +/-! ## Compiler-attachment state -/ + +/-- A checked lowering attachment paired with the exact validated dynamic +reuse output produced from its IxIR₂ program. Retaining the executable +equation makes the optimizer invocation, its dependent trace, and the +compiler attachment one proof-facing artifact. -/ +structure OptimizedAttachment + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : Pipeline.CompiledAttachment mainWorld lowerFuel) where + output : Reuse.Output Validate.defaultLimits + attached.target.artifact.validationContext + attached.target.artifact.program + produced : Reuse.optimize attached.target.artifact.validationContext + attached.target.artifact.program = .ok output + +/-- Run reuse insertion at the exact checked compiler boundary. -/ +def optimizeAttachment + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : Pipeline.CompiledAttachment mainWorld lowerFuel) : + Except Reuse.Error (OptimizedAttachment attached) := + match produced : Reuse.optimize + attached.target.artifact.validationContext + attached.target.artifact.program with + | .error error => .error error + | .ok output => .ok { output, produced } + +/-- Production selection at the checked compiler boundary is total. A +rejected optional rewrite retains the exact baseline and a typed skip report. -/ +def selectAttachment + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : Pipeline.CompiledAttachment mainWorld lowerFuel) : + Reuse.Selection Validate.defaultLimits + attached.target.artifact.validationContext attached.target.artifact.program := + Reuse.selectChecked attached.target.artifact.validationContext + attached.target.artifact.program attached.target.valid + +/-- Source-side restoration data aligned with the target's ordinary-call +continuation stack. Each resume frame remembers the exact checked call site, +pre-call semantic state, and surviving capability vector needed to rebuild +the caller after a return. Tail calls leave this stack unchanged. -/ +inductive CompilerStackState + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : Pipeline.CompiledAttachment mainWorld lowerFuel) : + List IxIR1.Sim.Root → List Continuation → Type where + | nil : CompilerStackState attached [] [] + | addressed + {callerTrace : Lower.FunctionTrace} + (callerMember : callerTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {sourceAddress targetAddress : Ixon.Address} + {sourceArguments : Array IxIR1.Atom} {targetArguments : Array Atom} + {next : Lower.CodeTrace} + {calleeTrace : Lower.FunctionTrace} + (calleeMember : calleeTrace ∈ + attached.target.artifact.trace.functions) + {sourceDefinition : IxIR1.FnDef} {targetDefinition : Function} + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration sourceAddress) sourceDefinition targetDefinition) + (callerDescendant : callerTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.call sourceAddress sourceArguments) index + (.call targetAddress targetArguments) next)) + {callerStore : IxIR1.Store} {callerSource values : List RVal} + {callerFrameRoots : List IxIR1.Sim.Root} + {callerFrame : Frame} {callerStack : List Continuation} + (callerState : attached.sidecars.TraceStateRel callerTrace + (.letOp site blockId input nextInput entryValueCount + (.call sourceAddress sourceArguments) index + (.call targetAddress targetArguments) next) + callerStore callerSource callerFrame) + (callerRuntime : Lower.Sim.SourceRuntimeInvariant callerStore + callerSource) + (callerOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.call sourceAddress sourceArguments) index + (.call targetAddress targetArguments) next) + callerStore callerSource callerFrameRoots) + (callerStackRoots : LiveStackSupportedByRoots callerFrameRoots + callerStack) + (callerImage : attached.SourceStoreImage callerStore) + (callerNoCredits : callerFrame.credits = #[]) + (resolved : IxIR1.resolveAtoms callerSource sourceArguments = .ok values) + {before : Lower.PositionTrace} {remaining : Array Lower.BindingCap} + (signatureAt : Lower.targetSignature? + attached.target.artifact.program.declarations sourceAddress = + some calleeTrace.generated.signature) + (beforeMember : before ∈ attached.target.artifact.trace.positions) + (beforeCoordinate : before.coordinateMatches site blockId + (.instruction index) input = true) + (consumed : Lower.callRemainingCapabilities? before.sourceCapabilities + input calleeTrace.generated.signature sourceArguments = some remaining) + (tail : CompilerStackState attached callerFrameRoots callerStack) : + CompilerStackState attached + (Lower.Sim.rootsForCapabilities remaining.toList callerSource ++ + callerFrameRoots) + (.resume { callerFrame with pc := callerFrame.pc + 1 } :: callerStack) + | applyExact + {callerTrace : Lower.FunctionTrace} + (callerMember : callerTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {sourceFunction : IxIR1.Atom} {targetFunction : Atom} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} {next : Lower.CodeTrace} + (callerDescendant : callerTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next)) + {callerStore : IxIR1.Store} {callerSource : List RVal} + {callerFrameRoots : List IxIR1.Sim.Root} + {callerFrame : Frame} {callerStack : List Continuation} + (callerState : attached.sidecars.TraceStateRel callerTrace + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + callerStore callerSource callerFrame) + (callerRuntime : Lower.Sim.SourceRuntimeInvariant callerStore + callerSource) + (callerOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + callerStore callerSource callerFrameRoots) + (callerStackRoots : LiveStackSupportedByRoots callerFrameRoots + callerStack) + (callerImage : attached.SourceStoreImage callerStore) + (callerNoCredits : callerFrame.credits = #[]) + {remaining : Array Lower.BindingCap} + (tail : CompilerStackState attached callerFrameRoots callerStack) : + CompilerStackState attached + (Lower.Sim.rootsForCapabilities remaining.toList callerSource ++ + callerFrameRoots) + (.resume { callerFrame with pc := callerFrame.pc + 1 } :: callerStack) + | applyMore + {callerTrace : Lower.FunctionTrace} + (callerMember : callerTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {sourceFunction : IxIR1.Atom} {targetFunction : Atom} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} {next : Lower.CodeTrace} + (callerDescendant : callerTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next)) + {callerStore : IxIR1.Store} {callerSource : List RVal} + {callerFrameRoots : List IxIR1.Sim.Root} + {callerFrame : Frame} {callerStack : List Continuation} + (callerState : attached.sidecars.TraceStateRel callerTrace + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + callerStore callerSource callerFrame) + (callerRuntime : Lower.Sim.SourceRuntimeInvariant callerStore + callerSource) + (callerOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + callerStore callerSource callerFrameRoots) + (callerStackRoots : LiveStackSupportedByRoots callerFrameRoots + callerStack) + (callerImage : attached.SourceStoreImage callerStore) + (callerNoCredits : callerFrame.credits = #[]) + {remaining : Array Lower.BindingCap} + (callerFrameSupported : LiveFrameSupportedByRoots + (Lower.Sim.rootsForCapabilities remaining.toList callerSource) + { callerFrame with pc := callerFrame.pc + 1 }) + {sourceResidual : List RVal} {targetResidual : Array RVal} + (residuals : targetResidual.toList = sourceResidual) + (tail : CompilerStackState attached callerFrameRoots callerStack) : + CompilerStackState attached + (IxIR1.Sim.rootsFor .shared sourceResidual ++ + (Lower.Sim.rootsForCapabilities remaining.toList callerSource ++ + callerFrameRoots)) + (.applyMore targetResidual + { callerFrame with pc := callerFrame.pc + 1 } :: callerStack) + | self + {callerTrace : Lower.FunctionTrace} + (callerMember : callerTrace ∈ + attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {sourceArguments : Array IxIR1.Atom} {targetArguments : Array Atom} + {next : Lower.CodeTrace} + (callerDescendant : callerTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.callSelf sourceArguments) index (.callSelf targetArguments) next)) + {callerStore : IxIR1.Store} {callerSource values : List RVal} + {callerFrameRoots : List IxIR1.Sim.Root} + {callerFrame : Frame} {callerStack : List Continuation} + (callerState : attached.sidecars.TraceStateRel callerTrace + (.letOp site blockId input nextInput entryValueCount + (.callSelf sourceArguments) index (.callSelf targetArguments) next) + callerStore callerSource callerFrame) + (callerRuntime : Lower.Sim.SourceRuntimeInvariant callerStore + callerSource) + (callerOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.callSelf sourceArguments) index (.callSelf targetArguments) next) + callerStore callerSource callerFrameRoots) + (callerStackRoots : LiveStackSupportedByRoots callerFrameRoots + callerStack) + (callerImage : attached.SourceStoreImage callerStore) + (callerNoCredits : callerFrame.credits = #[]) + (resolved : IxIR1.resolveAtoms callerSource sourceArguments = .ok values) + {before : Lower.PositionTrace} {remaining : Array Lower.BindingCap} + (beforeMember : before ∈ attached.target.artifact.trace.positions) + (beforeCoordinate : before.coordinateMatches site blockId + (.instruction index) input = true) + (consumed : Lower.callRemainingCapabilities? before.sourceCapabilities + input callerTrace.generated.signature sourceArguments = some remaining) + (tail : CompilerStackState attached callerFrameRoots callerStack) : + CompilerStackState attached + (Lower.Sim.rootsForCapabilities remaining.toList callerSource ++ + callerFrameRoots) + (.resume { callerFrame with pc := callerFrame.pc + 1 } :: callerStack) + +/-- Executable source completion evidence for the ordinary call at the head +of a compiler stack. Its dependent match recovers the exact suspended caller, +operation, and output store/value while ruling out an empty continuation. -/ +def CompilerStackReturn + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : Pipeline.CompiledAttachment mainWorld lowerFuel) (sourceContext : IxIR1.Ctx) : + {roots : List IxIR1.Sim.Root} → {stack : List Continuation} → + CompilerStackState attached roots stack → IxIR1.Store → RVal → Prop + | _, _, .nil, _, _ => False + | _, _, .addressed + (callerTrace := callerTrace) (sourceAddress := sourceAddress) + (sourceArguments := sourceArguments) + (sourceDefinition := sourceDefinition) (callerStore := callerStore) + (callerSource := callerSource) + _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _, outputStore, value => + ∃ callFuel, + sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts ∧ + sourceContext.decls sourceAddress = some (.fn sourceDefinition) ∧ + IxIR1.runOp sourceContext (callFuel + 1) callerTrace.source + callerStore callerSource (.call sourceAddress sourceArguments) = + .ok (outputStore, value) + | _, _, .self + (callerTrace := callerTrace) (sourceArguments := sourceArguments) + (callerStore := callerStore) (callerSource := callerSource) + _ _ _ _ _ _ _ _ _ _ _ _ _, outputStore, value => + ∃ callFuel, + sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts ∧ + IxIR1.runOp sourceContext (callFuel + 1) callerTrace.source + callerStore callerSource (.callSelf sourceArguments) = + .ok (outputStore, value) + | _, _, .applyExact + (callerTrace := callerTrace) (sourceFunction := sourceFunction) + (sourceArguments := sourceArguments) (callerStore := callerStore) + (callerSource := callerSource) + _ _ _ _ _ _ _ _ _, outputStore, value => + ∃ applyFuel, + sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts ∧ + IxIR1.runOp sourceContext (applyFuel + 2) callerTrace.source + callerStore callerSource (.apply sourceFunction sourceArguments) = + .ok (outputStore, value) + | _, _, .applyMore _ _ _ _ _ _ _ _ _ _ _, _, _ => False + +/-- A successful residual plan for an `applyMore` continuation. The current +callee result is the function fed to this dispatcher; source history separately +reconstructs the original suspended application from the plan's result. -/ +def CompilerApplyMoreReturn + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : Pipeline.CompiledAttachment mainWorld lowerFuel) (sourceContext : IxIR1.Ctx) + (context : Eval.Context) : + {roots : List IxIR1.Sim.Root} → {stack : List Continuation} → + CompilerStackState attached roots stack → IxIR1.Store → RVal → Prop + | _, _, .applyMore (sourceResidual := sourceResidual) + _ _ _ _ _ _ _ _ _ _ _, sourceStore, function => + ∃ applyFuel outputStore outputValue, + sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts ∧ + Pipeline.ApplyMorePlan attached sourceContext context applyFuel + sourceStore function sourceResidual outputStore outputValue + | _, _, _, _, _ => False + +/-- What the active source computation must reconstruct for its suspended +caller. For over-application, the first callee contributes a prefix which +accepts any later successful residual application. -/ +def CompilerStackCompletion + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : Pipeline.CompiledAttachment mainWorld lowerFuel) (sourceContext : IxIR1.Ctx) : + {roots : List IxIR1.Sim.Root} → {stack : List Continuation} → + CompilerStackState attached roots stack → IxIR1.Store → RVal → Prop + | _, _, .nil, _, _ => True + | _, _, .applyMore + (callerTrace := callerTrace) (sourceFunction := sourceFunction) + (sourceArguments := sourceArguments) (callerStore := callerStore) + (callerSource := callerSource) (sourceResidual := sourceResidual) + _ _ _ _ _ _ _ _ _ _ _, sourceStore, function => + ∀ {fuel : Nat} {out : IxIR1.Store × RVal}, + IxIR1.applyGo sourceContext fuel sourceStore function sourceResidual = + .ok out → + ∃ operationFuel, + IxIR1.runOp sourceContext (operationFuel + 1) callerTrace.source + callerStore callerSource (.apply sourceFunction sourceArguments) = + .ok out + | _, _, callStack, sourceStore, value => + CompilerStackReturn attached sourceContext callStack sourceStore value + +/-- Composable source history for every suspended caller. The active +completion implication follows the current frame through tail calls; the +recursive half retains the history to restore when this caller resumes. -/ +def CompilerStackHistory + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : Pipeline.CompiledAttachment mainWorld lowerFuel) (sourceContext : IxIR1.Ctx) + {roots : List IxIR1.Sim.Root} {stack : List Continuation} + (callStack : CompilerStackState attached roots stack) + (point : IxIR1.CodePoint) : Prop := + (∀ {out : IxIR1.Store × RVal}, point.Runs sourceContext out → + IxIR1.Sim.HasWorld out.1 point.current.result out.2 → + CompilerStackCompletion attached sourceContext callStack out.1 out.2) ∧ + match callStack with + | .nil => True + | .addressed + (callerTrace := callerTrace) (sourceAddress := sourceAddress) + (sourceArguments := sourceArguments) (next := next) + (callerStore := callerStore) (callerSource := callerSource) + _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ tail => + CompilerStackHistory attached sourceContext tail + ⟨callerTrace.source, callerStore, callerSource, + .letOp (.call sourceAddress sourceArguments) next.sourceCode⟩ + | .self + (callerTrace := callerTrace) (sourceArguments := sourceArguments) + (next := next) (callerStore := callerStore) (callerSource := callerSource) + _ _ _ _ _ _ _ _ _ _ _ _ tail => + CompilerStackHistory attached sourceContext tail + ⟨callerTrace.source, callerStore, callerSource, + .letOp (.callSelf sourceArguments) next.sourceCode⟩ + | .applyExact + (callerTrace := callerTrace) (sourceFunction := sourceFunction) + (sourceArguments := sourceArguments) (next := next) + (callerStore := callerStore) (callerSource := callerSource) + _ _ _ _ _ _ _ _ tail => + CompilerStackHistory attached sourceContext tail + ⟨callerTrace.source, callerStore, callerSource, + .letOp (.apply sourceFunction sourceArguments) next.sourceCode⟩ + | .applyMore + (callerTrace := callerTrace) (sourceFunction := sourceFunction) + (sourceArguments := sourceArguments) (next := next) + (callerStore := callerStore) (callerSource := callerSource) + _ _ _ _ _ _ _ _ _ _ tail => + CompilerStackHistory attached sourceContext tail + ⟨callerTrace.source, callerStore, callerSource, + .letOp (.apply sourceFunction sourceArguments) next.sourceCode⟩ + +/-- Advance the active source history while retaining all suspended callers. -/ +theorem CompilerStackHistory.advance + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {sourceContext : IxIR1.Ctx} + {roots : List IxIR1.Sim.Root} {stack : List Continuation} + {callStack : CompilerStackState attached roots stack} + {before after : IxIR1.CodePoint} + (history : CompilerStackHistory attached sourceContext callStack before) + (step : IxIR1.ExecutionHistory sourceContext before after) : + CompilerStackHistory attached sourceContext callStack after := by + cases callStack <;> simp only [CompilerStackHistory] at history ⊢ + all_goals exact ⟨fun run world => history.1 (step.complete run world) + (step.resultWorld.symm ▸ world), history.2⟩ + +/-- Complete the active source computation, leaving its caller evidence in +the exact form selected by the typed continuation stack. -/ +theorem CompilerStackHistory.complete + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {sourceContext : IxIR1.Ctx} + {roots : List IxIR1.Sim.Root} {stack : List Continuation} + {callStack : CompilerStackState attached roots stack} + {point : IxIR1.CodePoint} {out : IxIR1.Store × RVal} + (history : CompilerStackHistory attached sourceContext callStack point) + (run : point.Runs sourceContext out) + (world : IxIR1.Sim.HasWorld out.1 point.current.result out.2) : + CompilerStackCompletion attached sourceContext callStack out.1 out.2 := by + cases callStack <;> simp only [CompilerStackHistory] at history + all_goals exact history.1 run world + +/-- An ordinary target resume selects ordinary source completion evidence. -/ +theorem CompilerStackCompletion.ordinary + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {sourceContext : IxIR1.Ctx} + {roots : List IxIR1.Sim.Root} {stack : List Continuation} + {callStack : CompilerStackState attached roots stack} + {sourceStore : IxIR1.Store} {value : RVal} + (completed : CompilerStackCompletion attached sourceContext callStack + sourceStore value) + {caller : Frame} {rest : List Continuation} + (stackEq : stack = .resume caller :: rest) : + CompilerStackReturn attached sourceContext callStack sourceStore value := by + cases callStack <;> simp only [CompilerStackCompletion] at completed + all_goals first | exact completed | cases stackEq + +/-- Source/HPT/ownership evidence at one running baseline IxIR₂ machine. +This is the machine-local state already threaded by `PipelineSim`, separated +from a particular successful source result so it can serve as the baseline +half of the reuse invariant. -/ +structure CompilerRunningState + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : Pipeline.CompiledAttachment mainWorld lowerFuel) (machine : Machine) where + functionTrace : Lower.FunctionTrace + trace : Lower.CodeTrace + sourceStore : IxIR1.Store + source : List RVal + frameRoots : List IxIR1.Sim.Root + frame : Frame + stack : List Continuation + member : functionTrace ∈ attached.target.artifact.trace.functions + descendant : functionTrace.root.Descendant trace + traceState : attached.sidecars.TraceStateRel functionTrace trace sourceStore + source frame + stores : Lower.Sim.StoreRel sourceStore machine.store + runtime : Lower.Sim.SourceRuntimeInvariant sourceStore source + ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions trace sourceStore source + frameRoots + stackRoots : LiveStackSupportedByRoots frameRoots stack + callStack : CompilerStackState attached frameRoots stack + history : CompilerStackHistory attached attached.simulationSourceContext + callStack ⟨functionTrace.source, sourceStore, source, trace.sourceCode⟩ + image : attached.SourceStoreImage sourceStore + control : machine.control = .running frame stack + noCredits : frame.credits = #[] + +/-- Compiler state at a synchronization boundary. Halted states need no +further accepted-site evidence; running states retain the full attachment +witness above. -/ +inductive CompilerState + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : Pipeline.CompiledAttachment mainWorld lowerFuel) : Machine → Prop where + | running {machine : Machine} : CompilerRunningState attached machine → + CompilerState attached machine + | halted {machine : Machine} {value : RVal} : + machine.control = .halted value → CompilerState attached machine + +/-- A positive baseline execution whose endpoint carries the concrete +compiler invariant. This is the baseline half of a synchronization macro; +constructor switching uses it because its recursive trace state appears only +after edge transfer and the generated field-fetch prologue. -/ +inductive CompilerMacroStep + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : Pipeline.CompiledAttachment mainWorld lowerFuel) (context : Eval.Context) + (interpretation : Interpretation) (start : Machine) : Prop where + | intro (count : Nat) (positive : 0 < count) (target : Machine) + (steps : Steps context interpretation count start target) + (compiler : CompilerState attached target) : + CompilerMacroStep attached context interpretation start + +/-- A fixed-length compiler macro whose endpoint is also known to be a legal +synchronization boundary for every related rewritten endpoint. Accepted +reuse prefixes produce this stronger object at their recursive self-entry. -/ +inductive CompilerAcceptedMacroStepAt + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : Pipeline.CompiledAttachment mainWorld lowerFuel) (context : Eval.Context) + (interpretation : Interpretation) (count : Nat) + (start : Machine) : Prop where + | intro (positive : 0 < count) (target : Machine) + (steps : Steps context interpretation count start target) + (compiler : CompilerState attached target) + (acceptedEntry : ∀ {rewrittenTarget : Machine}, + StableLiveMachineRel Validate.defaultLimits + attached.target.artifact.validationContext target + rewrittenTarget → + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext target + rewrittenTarget) : + CompilerAcceptedMacroStepAt attached context interpretation count start + +/-- Forget the fixed length and synchronization phase of a compiler macro. -/ +theorem CompilerAcceptedMacroStepAt.compilerMacro + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {context : Eval.Context} + {interpretation : Interpretation} {count : Nat} {start : Machine} + (step : CompilerAcceptedMacroStepAt attached context interpretation count + start) : + CompilerMacroStep attached context interpretation start := by + cases step with + | intro positive target steps compiler _acceptedEntry => + exact .intro count positive target steps compiler + +/-- Two running-step sequences of the same length from the same machine have +the same endpoint. This lifts one-step evaluator determinism to the fixed +length macros used by compiler reconstruction. -/ +theorem Steps.deterministic {context : Eval.Context} + {interpretation : Interpretation} {count : Nat} + {start leftTarget rightTarget : Machine} + (left : Steps context interpretation count start leftTarget) + (right : Steps context interpretation count start rightTarget) : + leftTarget = rightTarget := by + induction left generalizing rightTarget with + | refl => + cases right + rfl + | @cons count before middle leftTarget frame stack running head tail ih => + cases right with + | @cons _ _ rightMiddle rightTarget _ _ _ rightHead rightTail => + have middleEq : middle = rightMiddle := + head.deterministic rightHead + subst rightMiddle + exact ih rightTail + +/-- Forget the retained ordinal and recover the evaluator's exact tag lookup. -/ +private theorem sourceAlternativeFind + {alternatives : Array IxIR1.Alt} {tag index : Nat} + {alternative : IxIR1.Alt} + (found : Lower.sourceAlternativeAtTag? alternatives tag = + some (alternative, index)) : + alternatives.find? (fun candidate => candidate.cidx == tag) = + some alternative := by + calc + alternatives.find? (fun candidate => candidate.cidx == tag) = + (Lower.sourceAlternativeAtTag? alternatives tag).map Prod.fst := by + rw [Lower.sourceAlternativeAtTag?_map_fst] + apply congrArg (fun predicate : IxIR1.Alt → Bool => alternatives.find? predicate) + funext candidate + cases candidate + rfl + _ = some alternative := by rw [found]; rfl + +namespace CompilerRunningState + +/-- Record a completed source operation in the suspended caller histories. -/ +theorem historyStepOp + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {operation : IxIR1.Op} {instruction : Instr} {next : Lower.CodeTrace} + (traceEq : state.trace = .letOp site blockId input nextInput entryValueCount + operation index instruction next) + {fuel : Nat} {nextStore : IxIR1.Store} {value : RVal} + (run : IxIR1.runOp attached.simulationSourceContext fuel + state.functionTrace.source state.sourceStore state.source operation = + .ok (nextStore, value)) : + CompilerStackHistory attached attached.simulationSourceContext state.callStack + ⟨state.functionTrace.source, nextStore, value :: state.source, + next.sourceCode⟩ := by + apply state.history.advance + simpa [traceEq, Lower.CodeTrace.sourceCode] using + (IxIR1.ExecutionHistory.stepOp (next := next.sourceCode) run) + +/-- Immediate operations use the same source history under any compatible +declaration context, including callers with a different scalar oracle. -/ +theorem historyImmediateOp + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {machine : Machine} + (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {operation : IxIR1.Op} {instruction : Instr} {next : Lower.CodeTrace} + (traceEq : state.trace = .letOp site blockId input nextInput entryValueCount + operation index instruction next) + (declarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {fuel : Nat} {nextStore : IxIR1.Store} {value : RVal} + (run : IxIR1.runOp sourceContext fuel state.functionTrace.source + state.sourceStore state.source operation = .ok (nextStore, value)) + (immediate : operation.isImmediate = true) : + CompilerStackHistory attached attached.simulationSourceContext state.callStack + ⟨state.functionTrace.source, nextStore, value :: state.source, + next.sourceCode⟩ := by + apply state.historyStepOp traceEq + rw [IxIR1.runOp_immediate_ctx_eq sourceContext + attached.simulationSourceContext declarations.symm _ _ _ _ _ immediate] + exact run + +/-- Rebuild the original dynamic-application caller once an `applyMore` +dispatcher reaches an immediate result. This factors the caller-side HPT, +ownership, runtime, heap-image, and live-stack reconstruction shared by the +erased and under-saturated return branches. -/ +private def resumedApplyCaller + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {operationFuel : Nat} + {callerTrace : Lower.FunctionTrace} + (callerMember : callerTrace ∈ attached.target.artifact.trace.functions) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {sourceFunction : IxIR1.Atom} {targetFunction : Atom} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} {next : Lower.CodeTrace} + (callerDescendant : callerTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next)) + {callerStore outputStore : IxIR1.Store} {callerSource : List RVal} + {callerFrameRoots : List IxIR1.Sim.Root} + {callerFrame : Frame} {callerStack : List Continuation} + (callerState : attached.sidecars.TraceStateRel callerTrace + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + callerStore callerSource callerFrame) + (callerRuntime : Lower.Sim.SourceRuntimeInvariant callerStore callerSource) + (callerOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + callerStore callerSource callerFrameRoots) + (callerStackRoots : LiveStackSupportedByRoots callerFrameRoots callerStack) + (callerImage : attached.SourceStoreImage callerStore) + (callerNoCredits : callerFrame.credits = #[]) + (tail : CompilerStackState attached callerFrameRoots callerStack) + (callerHistory : CompilerStackHistory attached attached.simulationSourceContext + tail ⟨callerTrace.source, callerStore, callerSource, + .letOp (.apply sourceFunction sourceArguments) next.sourceCode⟩) + (sourceDeclarations : attached.simulationSourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {value : RVal} + (operationRun : IxIR1.runOp attached.simulationSourceContext (operationFuel + 1) + callerTrace.source + callerStore callerSource (.apply sourceFunction sourceArguments) = + .ok (outputStore, value)) + {targetStore : Store} {heapFuel : Nat} + (stores : Lower.Sim.StoreRel outputStore targetStore) : + let nextCallerFrame : Frame := + { callerFrame with + pc := callerFrame.pc + 1 + values := callerFrame.values.push value } + CompilerRunningState attached + { store := targetStore + heapFuel := heapFuel + control := .running nextCallerFrame callerStack } := by + dsimp only + let nextCallerFrame : Frame := + { callerFrame with + pc := callerFrame.pc + 1 + values := callerFrame.values.push value } + have nextTarget : Lower.Sim.CodeStateRel callerTrace next + (value :: callerSource) nextCallerFrame := by + simpa [nextCallerFrame] using + (callerState.target.letOpValueNext callerDescendant (by rfl) (by rfl) + value) + have nextTraceState := attached.traceState_next_of_member callerMember + callerState callerDescendant sourceDeclarations operationRun nextTarget + have nextRuntime : Lower.Sim.SourceRuntimeInvariant outputStore + (value :: callerSource) := + callerRuntime.runOp + (IxIR1.NoReuse.runOp_reuses_eq + (attached.sourceContextNoReuse sourceDeclarations) + (attached.functionTraceNoReuse callerMember) (by trivial) operationRun) + operationRun + have nextOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next outputStore + (value :: callerSource) callerFrameRoots := + Lower.Sim.SourceOwnershipAt.applyFrom (checked := attached.target) + callerMember callerDescendant callerOwnership + (attached.applyOwnershipPreservesFrom_sourceStoreImage_of_declarations + sourceDeclarations callerImage) operationRun + have nextImage : attached.SourceStoreImage outputStore := + attached.runOp_preservesSourceStoreImage sourceDeclarations callerMember + callerDescendant callerState callerImage operationRun + have nextDescendant : callerTrace.root.Descendant next := + .step callerDescendant (by simp [Lower.CodeTrace.children]) + exact + { functionTrace := callerTrace + trace := next + sourceStore := outputStore + source := value :: callerSource + frameRoots := callerFrameRoots + frame := nextCallerFrame + stack := callerStack + member := callerMember + descendant := nextDescendant + traceState := nextTraceState + stores := stores + runtime := nextRuntime + ownership := nextOwnership + stackRoots := callerStackRoots + callStack := tail + history := callerHistory.advance (IxIR1.ExecutionHistory.stepOp operationRun) + image := nextImage + control := by rfl + noCredits := by simpa [nextCallerFrame] using callerNoCredits } + +/-- Select the exact producer capability vector and dynamic root ownership +at the running trace coordinate. -/ +theorem currentOwnership + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) : + ∃ position, + position ∈ attached.target.artifact.trace.positions ∧ + position.coordinateMatches state.trace.source state.trace.sourceBlock + state.trace.targetPosition state.trace.sourceInputMap = true ∧ + Lower.Sim.SourceOwnershipInvariant state.sourceStore state.source + state.trace.sourceInputMap position.sourceCapabilities + state.frameRoots := by + obtain ⟨position, member, coordinate⟩ := + attached.target.position state.member state.descendant + exact ⟨position, member, coordinate, + state.ownership position member coordinate⟩ + +/-- Current-frame coverage is a static consequence of the checked lowering +trace retained by the compiler state, rather than an independently preserved +runtime assumption. -/ +theorem coverage + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) : + LiveFrameInputCoverage state.trace.sourceInputMap state.frame := + LiveFrameInputCoverage.ofCodeState state.traceState.target state.descendant + +/-- At an accepted compiler-produced block entry, the runtime value-vector +length is the site's parameter ABI. This is reconstructed from the recursive +lowering trace rather than supplied by a semantic caller. -/ +theorem acceptedSiteParameterCount + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (baselineDefinition : state.frame.definition = source) + {helperOffset : Nat} {block : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block} + (accepted : Reuse.FunctionDecisions.At rewrite.decisions state.frame.block + helperOffset block (.accepted site)) + (pc : state.frame.pc = 0) : + state.frame.values.size = site.shape.parameterCount := by + obtain ⟨sourceAt, _resetAt, _hotAt, _coldAt⟩ := + rewrite.acceptedAt accepted + have currentBlockAt : + state.frame.definition.blocks[state.frame.block]? = some block := by + rw [baselineDefinition] + exact sourceAt + have exactBlock := state.traceState.target.blockAt state.descendant + have blockEq : block = state.trace.headBlock.2 := + Option.some.inj (currentBlockAt.symm.trans exactBlock) + have tracePc : state.trace.entryPc = 0 := + state.traceState.target.pc.symm.trans pc + calc + state.frame.values.size = state.trace.entryValueCount := + state.traceState.target.valueCount + _ = state.trace.headBlock.2.valueParams.size := + state.functionTrace.descendantEntryValueCount state.descendant tracePc + _ = block.valueParams.size := by rw [blockEq] + _ = site.shape.parameterCount := site.fits.parameterCount.symm + +/-- Recover the exact source owner behind a future-live inherited target +parameter and focus it at the head of the dynamic root list. The residual +roots retain every suspended-frame root, so the result feeds both the +logical accepted macros and the physical stack-avoidance bridge. -/ +theorem ownedParameterRoot + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {block : Block} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + {index : Nat} {world : Ixon.Owned} {value : RVal} + (parameterAt : block.valueParams[index]? = some (ValueCap.owned world)) + (live : ValueLiveFrom state.frame.definition state.frame.block + state.frame.pc index) + (valueAt : state.frame.values[index]? = some value) : + ∃ (position : Lower.PositionTrace) (sourceIndex : Nat) + (rest : List IxIR1.Sim.Root), + position ∈ attached.target.artifact.trace.positions ∧ + position.coordinateMatches state.trace.source state.trace.sourceBlock + state.trace.targetPosition state.trace.sourceInputMap = true ∧ + state.trace.sourceInputMap[sourceIndex]? = + some (some (Atom.reg index)) ∧ + state.source[sourceIndex]? = some value ∧ + position.sourceCapabilities[sourceIndex]? = + some (Lower.BindingCap.owned world) ∧ + IxIR1.Sim.RootOwnership state.sourceStore + (⟨world, value⟩ :: rest) ∧ + ∀ root ∈ state.frameRoots, root ∈ rest := by + obtain ⟨position, member, coordinate, ownership⟩ := + state.currentOwnership + have valueBound : index < state.frame.values.size := + (Array.getElem?_eq_some_iff.mp valueAt).1 + obtain ⟨sourceIndex, inputAt⟩ := state.coverage live valueBound + have inputBound : sourceIndex < state.trace.sourceInputMap.size := + (Array.getElem?_eq_some_iff.mp inputAt).1 + have capabilitySize := + position.sourceCapabilities_size_of_coordinateMatch coordinate + have sourceBound : sourceIndex < state.source.length := by + rw [ownership.length, capabilitySize] + exact inputBound + let sourceValue := state.source[sourceIndex] + have sourceAt : state.source[sourceIndex]? = some sourceValue := by + simp [sourceValue] + have sourceResolved := state.traceState.target.environments sourceIndex + sourceValue (Atom.reg index) sourceAt inputAt + have targetResolved : Eval.resolveAtom state.frame.values (Atom.reg index) = + .ok value := by + simp [Eval.resolveAtom, valueAt] + have sourceValueEq : sourceValue = value := + Except.ok.inj (sourceResolved.symm.trans targetResolved) + have sourceAtValue : state.source[sourceIndex]? = some value := + sourceAt.trans (congrArg some sourceValueEq) + have exactBlock := state.traceState.target.blockAt state.descendant + have blockEq : block = state.trace.headBlock.2 := + Option.some.inj (blockAt.symm.trans exactBlock) + subst block + have capabilityAt := attached.target.ownedParameterCapability state.member + state.descendant member coordinate inputAt parameterAt + obtain ⟨rest, focused, rootsInRest⟩ := + ownership.focusOwned capabilityAt sourceAtValue + exact ⟨position, sourceIndex, rest, member, coordinate, inputAt, + sourceAtValue, capabilityAt, focused, rootsInRest⟩ + +/-- At any point up to the recognized release, an accepted site's source +parameter is the distinguished shared owner in the compiler's exact dynamic +root multiset. This specializes `ownedParameterRoot` to the syntax and +liveness facts retained by `Reuse.Site`. -/ +theorem acceptedSiteSourceRoot + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (baselineDefinition : state.frame.definition = source) + {helperOffset : Nat} {block : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block} + (found : Reuse.FunctionDecisions.At rewrite.decisions state.frame.block + helperOffset block (.accepted site)) + (pc : state.frame.pc ≤ site.shape.releasePosition) + {location : Nat} + (resolved : Eval.resolveAtom state.frame.values + (.reg site.shape.source) = .ok (.loc location)) : + ∃ rest : List IxIR1.Sim.Root, + IxIR1.Sim.RootOwnership state.sourceStore + (⟨.shared, .loc location⟩ :: rest) ∧ + ∀ root ∈ state.frameRoots, root ∈ rest := by + have sourceAt := (rewrite.acceptedAt found).1 + have blockAt : state.frame.definition.blocks[state.frame.block]? = + some block := by + rw [baselineDefinition] + exact sourceAt + have sourceLiveAtRelease : AtomLiveFrom source state.frame.block + site.shape.releasePosition (.reg site.shape.source) := + AtomLiveFrom.instruction sourceAt site.fits.release + Liveness.InstrUsesAtom.releaseShared + have sourceLive : ValueLiveFrom state.frame.definition state.frame.block + state.frame.pc site.shape.source := by + have earlier := sourceLiveAtRelease.mono pc + simpa [baselineDefinition, AtomLiveFrom] using earlier + have valueAt : state.frame.values[site.shape.source]? = + some (.loc location) := by + cases foundValue : state.frame.values[site.shape.source]? with + | none => simp [Eval.resolveAtom, foundValue] at resolved + | some value => + have valueEq : value = .loc location := by + simpa [Eval.resolveAtom, foundValue] using resolved + subst value + rfl + obtain ⟨_position, _sourceIndex, rest, _member, _coordinate, _inputAt, + _sourceValueAt, _capabilityAt, ownership, rootsInRest⟩ := + state.ownedParameterRoot blockAt site.fits.sourceOwned sourceLive valueAt + exact ⟨rest, ownership, rootsInRest⟩ + +/-- At an accepted source root, an incoming live-heap isomorphism determines +an exact rewritten ownership presentation with the related source root fixed +at its head. -/ +theorem acceptedSiteSourceRootIso + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (baselineDefinition : state.frame.definition = source) + {helperOffset : Nat} {block : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block} + (accepted : Reuse.FunctionDecisions.At rewrite.decisions state.frame.block + helperOffset block (.accepted site)) + (pc : state.frame.pc ≤ site.shape.releasePosition) + {baselineLocation rewrittenLocation : Nat} + (resolved : Eval.resolveAtom state.frame.values + (.reg site.shape.source) = .ok (.loc baselineLocation)) + {rewrittenStore : IxIR1.Store} + (iso : IxIR1.Sim.HeapIso rewrittenStore state.sourceStore) + (locations : iso.locRel rewrittenLocation baselineLocation) : + ∃ baselineRest rewrittenRest : List IxIR1.Sim.Root, + IxIR1.Sim.RootOwnership state.sourceStore + (⟨.shared, .loc baselineLocation⟩ :: baselineRest) ∧ + IxIR1.Sim.RootsIso iso.locRel + (⟨.shared, .loc rewrittenLocation⟩ :: rewrittenRest) + (⟨.shared, .loc baselineLocation⟩ :: baselineRest) ∧ + IxIR1.Sim.RootOwnership rewrittenStore + (⟨.shared, .loc rewrittenLocation⟩ :: rewrittenRest) ∧ + ∀ root ∈ state.frameRoots, root ∈ baselineRest := by + obtain ⟨baselineRest, baselineOwned, rootsInRest⟩ := + state.acceptedSiteSourceRoot rewrite baselineDefinition accepted pc + resolved + let head : IxIR1.Sim.RootIso iso.locRel + ⟨.shared, .loc rewrittenLocation⟩ + ⟨.shared, .loc baselineLocation⟩ := + ⟨rfl, .loc locations⟩ + obtain ⟨rewrittenRest, roots, rewrittenOwned⟩ := + iso.rootOwnershipPreimageCons head baselineOwned + exact ⟨baselineRest, rewrittenRest, baselineOwned, roots, + rewrittenOwned, rootsInRest⟩ + +/-- At a borrow-free checked position for the current trace coordinate, the +compiler's environment, ownership, and liveness facts support every +future-observable value in the active frame by the position's exact owned +roots. Borrowed capabilities are intentionally excluded here: their dynamic +invariant supplies a reachability path from a lender, not a direct root for +the borrowed value itself. -/ +theorem activeFrameSupportedAt + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {position : Lower.PositionTrace} + (member : position ∈ attached.target.artifact.trace.positions) + (coordinate : position.coordinateMatches state.trace.source + state.trace.sourceBlock state.trace.targetPosition + state.trace.sourceInputMap = true) + (noBorrows : Lower.noBorrows position.sourceCapabilities = true) : + LiveFrameSupportedByRoots + (Lower.Sim.rootsForCapabilities position.sourceCapabilities.toList + state.source) + state.frame := + LiveFrameSupportedByRoots.ofNoBorrows coordinate + state.traceState.target.environments + (state.ownership position member coordinate) noBorrows state.coverage + state.noCredits + +/-- Specialize active-frame support at an accepted planner allocation. Once +the producer audit supplies a borrow-free current capability vector, static +planner liveness discharges the mapped-value root premise used by physical +reuse. -/ +theorem mappedValuesAtPlannerAllocationOfNoBorrows + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {position : Lower.PositionTrace} + (member : position ∈ attached.target.artifact.trace.positions) + (coordinate : position.coordinateMatches state.trace.source + state.trace.sourceBlock state.trace.targetPosition + state.trace.sourceInputMap = true) + (noBorrows : Lower.noBorrows position.sourceCapabilities = true) + {block : Block} + (site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block) + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc = site.shape.releasePosition + 1) : + MappedValuesInRoots site.shape state.frame.values + (Lower.Sim.rootsForCapabilities position.sourceCapabilities.toList + state.source) := + LiveFrameSupportedByRoots.mappedValuesAtPlannerAllocation site blockAt + (state.activeFrameSupportedAt member coordinate noBorrows) rfl rfl pc + +/-- Changing only the target evaluator's heap budget preserves every +source/compiler fact in a running state. This is the transport used to fund +recursive release before composing it with a suffix execution. -/ +def withHeapFuel + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {machine : Machine} (state : CompilerRunningState attached machine) + (heapFuel : Nat) : + CompilerRunningState attached { machine with heapFuel := heapFuel } := + { state with + stores := by simpa using state.stores + control := by simpa using state.control } + +/-- A reconstructed running endpoint is also the compiler state at any other +endpoint of the same evaluator step. This is the bridge from the specialized +transition lemmas below back to a caller-supplied baseline step. -/ +theorem compilerStateOfStep + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {before generated actual : Machine} + (state : CompilerRunningState attached generated) + (generatedStep : Eval.Step context interpretation before generated) + (actualStep : Eval.Step context interpretation before actual) : + CompilerState attached actual := by + have targetEq : generated = actual := + generatedStep.deterministic actualStep + subst actual + exact .running state + +/-- Recover the evaluator-facing prefix instruction at the current compiler +trace node. This is the common packaging bridge for fetch, shared retain, +shared release, and shared allocation transitions: their compiler step lemmas +already carry the same `letOp` equation, so no endpoint phase proof is needed +to select the prefix-dispatch arm. -/ +def acceptedPrefixInstructionAt + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {operation : IxIR1.Op} {instruction : Instr} {next : Lower.CodeTrace} + (traceEq : state.trace = + .letOp site blockId input nextInput entryValueCount operation index + instruction next) + (acceptedPrefix : AcceptedPrefixInstruction instruction) : + AcceptedPrefixInstructionAt machine := by + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount operation index + instruction next) := by + rw [← traceEq] + exact state.descendant + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount operation index + instruction next) state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + obtain ⟨blockAt, pc, instructionAt⟩ := + traceState.target.instructionAt descendant + exact + { frame := state.frame + stack := state.stack + block := next.headBlock.2 + instruction := instruction + control := state.control + blockAt := blockAt + pc := pc + instructionAt := (Array.getElem?_eq_some_iff.mp instructionAt).2 + acceptedPrefix := acceptedPrefix } + +/-- Advance a compiler running state across a traced source `pure` operation +and its generated target `move`. The heap is unchanged, while the resolved +value is pushed on both environments. -/ +theorem stepPure + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + (traceEq : state.trace = + .letOp site blockId input nextInput entryValueCount + (.pure sourceAtom) index (.move targetAtom) next) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {value : RVal} + (sourceResolved : + IxIR1.resolveAtom state.source sourceAtom = .ok value) : + let nextFrame : Frame := + { state.frame with + pc := state.frame.pc + 1 + values := state.frame.values.push value } + let nextMachine : Machine := + { machine with control := .running nextFrame state.stack } + ∃ _ : CompilerRunningState attached nextMachine, + IxIR1.runOp sourceContext (sourceFuel + 1) + state.functionTrace.source state.sourceStore state.source + (.pure sourceAtom) = .ok (state.sourceStore, value) ∧ + Eval.Step context interpretation machine nextMachine ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext nextMachine + rewritten := by + dsimp only + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.pure sourceAtom) index (.move targetAtom) next) := by + rw [← traceEq] + exact state.descendant + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount + (.pure sourceAtom) index (.move targetAtom) next) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.pure sourceAtom) index (.move targetAtom) next) + state.sourceStore state.source state.frameRoots := by + rw [← traceEq] + exact state.ownership + let nextFrame : Frame := + { state.frame with + pc := state.frame.pc + 1 + values := state.frame.values.push value } + let nextMachine : Machine := + { machine with control := .running nextFrame state.stack } + obtain ⟨sourceRun, targetStep, nextStores, nextTraceState⟩ := + attached.simulate_traced_pure_move_state + (sourceFuel := sourceFuel) state.member descendant traceState state.stores + sourceDeclarations sourceResolved state.control + have nextRuntime : Lower.Sim.SourceRuntimeInvariant state.sourceStore + (value :: state.source) := + state.runtime.runOpNoReuse + (attached.sourceContextNoReuse sourceDeclarations) + (attached.functionTraceNoReuse state.member) (by trivial) sourceRun + have nextOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next state.sourceStore + (value :: state.source) state.frameRoots := + Lower.Sim.SourceOwnershipAt.pure (checked := attached.target) + state.member descendant ownership sourceResolved + have nextImage : attached.SourceStoreImage state.sourceStore := + attached.runOp_preservesSourceStoreImage sourceDeclarations state.member + descendant traceState state.image sourceRun + have nextDescendant : state.functionTrace.root.Descendant next := + .step descendant (by simp [Lower.CodeTrace.children]) + have nextState : CompilerRunningState attached nextMachine := + { functionTrace := state.functionTrace + trace := next + sourceStore := state.sourceStore + source := value :: state.source + frameRoots := state.frameRoots + frame := nextFrame + stack := state.stack + member := state.member + descendant := nextDescendant + traceState := by simpa [nextFrame] using nextTraceState + stores := by simpa [nextMachine] using nextStores + runtime := nextRuntime + ownership := nextOwnership + stackRoots := state.stackRoots + callStack := state.callStack + history := state.historyImmediateOp traceEq sourceDeclarations sourceRun rfl + image := nextImage + control := by rfl + noCredits := by simpa [nextFrame] using state.noCredits } + obtain ⟨currentBlockAt, _currentPcBound, moveAt⟩ := + traceState.target.instructionAt descendant + have nextBlockAt : nextFrame.definition.blocks[nextFrame.block]? = + some next.headBlock.2 := by + simpa [nextFrame] using currentBlockAt + exact ⟨nextState, sourceRun, + by simpa [nextMachine, nextFrame] using targetStep, + fun _rewritten => StableLiveAcceptedEntry.ofMoveAdvance rfl nextBlockAt + (by simpa [nextFrame] using moveAt)⟩ + +/-- Advance a compiler running state across one HPT-certified constructor +projection. The source heap is unchanged, while the fetched value is pushed +on both environments. -/ +theorem stepFetch + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + {sourceField targetField : Nat} {targetCid : IxIR1.CtorId} + (traceEq : state.trace = + .letOp site blockId input nextInput entryValueCount + (.fetch sourceAtom sourceField) index + (.fetch targetAtom targetCid targetField) next) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {value : RVal} + (operationRun : IxIR1.runOp sourceContext (sourceFuel + 1) + state.functionTrace.source state.sourceStore state.source + (.fetch sourceAtom sourceField) = .ok (state.sourceStore, value)) : + let nextFrame : Frame := + { state.frame with + pc := state.frame.pc + 1 + values := state.frame.values.push value } + let nextMachine : Machine := + { machine with control := .running nextFrame state.stack } + ∃ _ : CompilerRunningState attached nextMachine, + IxIR1.runOp sourceContext (sourceFuel + 1) + state.functionTrace.source state.sourceStore state.source + (.fetch sourceAtom sourceField) = + .ok (state.sourceStore, value) ∧ + Eval.Step context interpretation machine nextMachine := by + dsimp only + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.fetch sourceAtom sourceField) index + (.fetch targetAtom targetCid targetField) next) := by + rw [← traceEq] + exact state.descendant + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount + (.fetch sourceAtom sourceField) index + (.fetch targetAtom targetCid targetField) next) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.fetch sourceAtom sourceField) index + (.fetch targetAtom targetCid targetField) next) + state.sourceStore state.source state.frameRoots := by + rw [← traceEq] + exact state.ownership + let nextFrame : Frame := + { state.frame with + pc := state.frame.pc + 1 + values := state.frame.values.push value } + let nextMachine : Machine := + { machine with control := .running nextFrame state.stack } + obtain ⟨sourceRun, targetStep, nextStores, nextTraceState⟩ := + attached.simulate_traced_fetch_state_of_run_hpt state.member descendant + traceState state.stores sourceDeclarations operationRun state.control + have nextRuntime : Lower.Sim.SourceRuntimeInvariant state.sourceStore + (value :: state.source) := + state.runtime.runOpNoReuse + (attached.sourceContextNoReuse sourceDeclarations) + (attached.functionTraceNoReuse state.member) (by trivial) operationRun + have nextOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next state.sourceStore + (value :: state.source) state.frameRoots := + Lower.Sim.SourceOwnershipAt.fetch (checked := attached.target) + state.member descendant ownership operationRun + have nextImage : attached.SourceStoreImage state.sourceStore := + attached.runOp_preservesSourceStoreImage sourceDeclarations state.member + descendant traceState state.image operationRun + have nextDescendant : state.functionTrace.root.Descendant next := + .step descendant (by simp [Lower.CodeTrace.children]) + have nextState : CompilerRunningState attached nextMachine := + { functionTrace := state.functionTrace + trace := next + sourceStore := state.sourceStore + source := value :: state.source + frameRoots := state.frameRoots + frame := nextFrame + stack := state.stack + member := state.member + descendant := nextDescendant + traceState := by simpa [nextFrame] using nextTraceState + stores := by simpa [nextMachine] using nextStores + runtime := nextRuntime + ownership := nextOwnership + stackRoots := state.stackRoots + callStack := state.callStack + history := state.historyImmediateOp traceEq sourceDeclarations sourceRun rfl + image := nextImage + control := by rfl + noCredits := by simpa [nextFrame] using state.noCredits } + exact ⟨nextState, sourceRun, + by simpa [nextMachine, nextFrame] using targetStep⟩ + +/-- Advance a compiler running state across an HPT-certified shallow unique +free. The erased constructor identity and scalar-field condition are recovered +from the attachment, and the matching location is killed in both heaps. -/ +theorem stepFreeUnique + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + {targetCid : IxIR1.CtorId} + (traceEq : state.trace = + .letOp site blockId input nextInput entryValueCount + (.free sourceAtom) index (.freeUnique targetAtom targetCid) next) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {outputStore : IxIR1.Store} + (sourceRun : IxIR1.runOp sourceContext (sourceFuel + 1) + state.functionTrace.source state.sourceStore state.source + (.free sourceAtom) = .ok (outputStore, .erased)) : + ∃ location, + outputStore = state.sourceStore.kill location ∧ + let nextFrame : Frame := { state.frame with pc := state.frame.pc + 1 } + let nextMachine : Machine := + { machine with + store := machine.store.kill location + control := .running nextFrame state.stack } + ∃ _ : CompilerRunningState attached nextMachine, + Eval.Step context interpretation machine nextMachine ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext nextMachine + rewritten := by + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.free sourceAtom) index (.freeUnique targetAtom targetCid) next) := by + rw [← traceEq] + exact state.descendant + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount + (.free sourceAtom) index (.freeUnique targetAtom targetCid) next) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.free sourceAtom) index (.freeUnique targetAtom targetCid) next) + state.sourceStore state.source state.frameRoots := by + rw [← traceEq] + exact state.ownership + obtain ⟨location, box, sourceResolved, sourceGet, unique, output⟩ := + IxIR1.runOp_free_success sourceRun + have outputStoreEq : outputStore = state.sourceStore.kill location := + congrArg Prod.fst output + subst outputStore + obtain ⟨fact, selected⟩ := + attached.scalarLeafAt?_of_free_descendant state.member descendant + obtain ⟨exactBox, fields, exactGet, node, scalarFields⟩ := + attached.sidecars.scalarLeafAt?_runtime selected traceState.environment + sourceResolved + have boxEq : exactBox = box := + Option.some.inj (exactGet.symm.trans sourceGet) + subst exactBox + let nextFrame : Frame := { state.frame with pc := state.frame.pc + 1 } + let nextMachine : Machine := + { machine with + store := machine.store.kill location + control := .running nextFrame state.stack } + obtain ⟨_, targetStep, nextStores, nextTarget⟩ := + Lower.Sim.simulate_traced_free_freeUnique_state + (sourceContext := sourceContext) + (sourceCurrent := state.functionTrace.source) + (sourceFuel := sourceFuel) descendant traceState.target state.stores + sourceResolved sourceGet unique node scalarFields state.control + have nextTraceState := attached.traceState_next_of_member state.member + traceState descendant sourceDeclarations sourceRun nextTarget + have nextRuntime : Lower.Sim.SourceRuntimeInvariant + (state.sourceStore.kill location) (.erased :: state.source) := + state.runtime.runOp (by rfl) sourceRun + have nextOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next + (state.sourceStore.kill location) (.erased :: state.source) + state.frameRoots := + Lower.Sim.SourceOwnershipAt.free (checked := attached.target) + state.member descendant ownership sourceResolved sourceGet unique node + scalarFields sourceRun + have nextImage : attached.SourceStoreImage + (state.sourceStore.kill location) := + attached.runOp_preservesSourceStoreImage sourceDeclarations state.member + descendant traceState state.image sourceRun + have nextDescendant : state.functionTrace.root.Descendant next := + .step descendant (by simp [Lower.CodeTrace.children]) + have nextState : CompilerRunningState attached nextMachine := + { functionTrace := state.functionTrace + trace := next + sourceStore := state.sourceStore.kill location + source := .erased :: state.source + frameRoots := state.frameRoots + frame := nextFrame + stack := state.stack + member := state.member + descendant := nextDescendant + traceState := by simpa [nextFrame] using nextTraceState + stores := by simpa [nextMachine] using nextStores + runtime := nextRuntime + ownership := nextOwnership + stackRoots := state.stackRoots + callStack := state.callStack + history := state.historyImmediateOp traceEq sourceDeclarations sourceRun rfl + image := nextImage + control := by rfl + noCredits := by simpa [nextFrame] using state.noCredits } + obtain ⟨currentBlockAt, _currentPcBound, freeAt⟩ := + traceState.target.instructionAt descendant + have nextBlockAt : nextFrame.definition.blocks[nextFrame.block]? = + some next.headBlock.2 := by + simpa [nextFrame] using currentBlockAt + exact ⟨location, rfl, nextState, + by simpa [nextMachine, nextFrame] using targetStep, + fun _rewritten => + StableLiveAcceptedEntry.ofFreeUniqueAdvance rfl nextBlockAt + (by simpa [nextFrame] using freeAt)⟩ + +/-- Advance a compiler running state across scalar duplication. Both heaps +remain unchanged, while the duplicated scalar is pushed on both environments. -/ +theorem stepRetainScalar + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + (traceEq : state.trace = + .letOp site blockId input nextInput entryValueCount + (.dup sourceAtom) index (.retainShared targetAtom) next) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {value : RVal} + (sourceResolved : IxIR1.resolveAtom state.source sourceAtom = .ok value) + (scalar : Eval.RVal.isScalar value = true) : + let nextFrame : Frame := + { state.frame with + pc := state.frame.pc + 1 + values := state.frame.values.push value } + let nextMachine : Machine := + { machine with control := .running nextFrame state.stack } + ∃ _ : CompilerRunningState attached nextMachine, + IxIR1.runOp sourceContext (sourceFuel + 1) + state.functionTrace.source state.sourceStore state.source + (.dup sourceAtom) = .ok (state.sourceStore, value) ∧ + Eval.Step context interpretation machine nextMachine := by + dsimp only + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.dup sourceAtom) index (.retainShared targetAtom) next) := by + rw [← traceEq] + exact state.descendant + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount + (.dup sourceAtom) index (.retainShared targetAtom) next) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.dup sourceAtom) index (.retainShared targetAtom) next) + state.sourceStore state.source state.frameRoots := by + rw [← traceEq] + exact state.ownership + let nextFrame : Frame := + { state.frame with + pc := state.frame.pc + 1 + values := state.frame.values.push value } + let nextMachine : Machine := + { machine with control := .running nextFrame state.stack } + obtain ⟨sourceRun, targetStep, nextStores, nextTraceState⟩ := + attached.simulate_traced_dup_retain_scalar_state + (sourceFuel := sourceFuel) state.member descendant traceState state.stores + sourceDeclarations sourceResolved scalar state.control + have nextRuntime : Lower.Sim.SourceRuntimeInvariant state.sourceStore + (value :: state.source) := + state.runtime.runOpNoReuse + (attached.sourceContextNoReuse sourceDeclarations) + (attached.functionTraceNoReuse state.member) (by trivial) sourceRun + have nextOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next state.sourceStore + (value :: state.source) state.frameRoots := + Lower.Sim.SourceOwnershipAt.dup (checked := attached.target) + state.member descendant ownership sourceResolved sourceRun + have nextImage : attached.SourceStoreImage state.sourceStore := + attached.runOp_preservesSourceStoreImage sourceDeclarations state.member + descendant traceState state.image sourceRun + have nextDescendant : state.functionTrace.root.Descendant next := + .step descendant (by simp [Lower.CodeTrace.children]) + have nextState : CompilerRunningState attached nextMachine := + { functionTrace := state.functionTrace + trace := next + sourceStore := state.sourceStore + source := value :: state.source + frameRoots := state.frameRoots + frame := nextFrame + stack := state.stack + member := state.member + descendant := nextDescendant + traceState := by simpa [nextFrame] using nextTraceState + stores := by simpa [nextMachine] using nextStores + runtime := nextRuntime + ownership := nextOwnership + stackRoots := state.stackRoots + callStack := state.callStack + history := state.historyImmediateOp traceEq sourceDeclarations sourceRun rfl + image := nextImage + control := by rfl + noCredits := by simpa [nextFrame] using state.noCredits } + exact ⟨nextState, sourceRun, + by simpa [nextMachine, nextFrame] using targetStep⟩ + +/-- Advance a compiler running state across shared duplication/retention. +The matching source and target boxes receive the same incremented refcount, +and the retained location is pushed on both environments. -/ +theorem stepRetainShared + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + (traceEq : state.trace = + .letOp site blockId input nextInput entryValueCount + (.dup sourceAtom) index (.retainShared targetAtom) next) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {location : Nat} {box : IxIR1.NodeBox} + (sourceResolved : + IxIR1.resolveAtom state.source sourceAtom = .ok (.loc location)) + (sourceGet : state.sourceStore.get? location = some box) + (shared : box.world = .shared) : + let nextBox : IxIR1.NodeBox := { box with rc := box.rc + 1 } + let sourceStore' := (state.sourceStore.setBox location nextBox).rcTick + let targetStore' := (machine.store.setBox location nextBox).rcTick + let nextFrame : Frame := + { state.frame with + pc := state.frame.pc + 1 + values := state.frame.values.push (.loc location) } + let nextMachine : Machine := + { machine with + store := targetStore' + control := .running nextFrame state.stack } + ∃ _ : CompilerRunningState attached nextMachine, + IxIR1.runOp sourceContext (sourceFuel + 1) + state.functionTrace.source state.sourceStore state.source + (.dup sourceAtom) = .ok (sourceStore', .loc location) ∧ + Eval.Step context interpretation machine nextMachine := by + dsimp only + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.dup sourceAtom) index (.retainShared targetAtom) next) := by + rw [← traceEq] + exact state.descendant + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount + (.dup sourceAtom) index (.retainShared targetAtom) next) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.dup sourceAtom) index (.retainShared targetAtom) next) + state.sourceStore state.source state.frameRoots := by + rw [← traceEq] + exact state.ownership + let nextBox : IxIR1.NodeBox := { box with rc := box.rc + 1 } + let sourceStore' := (state.sourceStore.setBox location nextBox).rcTick + let targetStore' := (machine.store.setBox location nextBox).rcTick + let nextFrame : Frame := + { state.frame with + pc := state.frame.pc + 1 + values := state.frame.values.push (.loc location) } + let nextMachine : Machine := + { machine with + store := targetStore' + control := .running nextFrame state.stack } + obtain ⟨sourceRun, targetStep, nextStores, nextTraceState⟩ := + attached.simulate_traced_dup_retain_shared_state + (sourceFuel := sourceFuel) state.member descendant traceState state.stores + sourceDeclarations sourceResolved sourceGet shared state.control + have nextRuntime : Lower.Sim.SourceRuntimeInvariant sourceStore' + (.loc location :: state.source) := + state.runtime.runOpNoReuse + (attached.sourceContextNoReuse sourceDeclarations) + (attached.functionTraceNoReuse state.member) (by trivial) sourceRun + have nextOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next sourceStore' + (.loc location :: state.source) state.frameRoots := + Lower.Sim.SourceOwnershipAt.dup (checked := attached.target) + state.member descendant ownership sourceResolved sourceRun + have nextImage : attached.SourceStoreImage sourceStore' := + attached.runOp_preservesSourceStoreImage sourceDeclarations state.member + descendant traceState state.image sourceRun + have nextDescendant : state.functionTrace.root.Descendant next := + .step descendant (by simp [Lower.CodeTrace.children]) + have nextState : CompilerRunningState attached nextMachine := + { functionTrace := state.functionTrace + trace := next + sourceStore := sourceStore' + source := .loc location :: state.source + frameRoots := state.frameRoots + frame := nextFrame + stack := state.stack + member := state.member + descendant := nextDescendant + traceState := by simpa [nextFrame] using nextTraceState + stores := by + simpa [nextMachine, targetStore', sourceStore', nextBox] using + nextStores + runtime := nextRuntime + ownership := nextOwnership + stackRoots := state.stackRoots + callStack := state.callStack + history := state.historyImmediateOp traceEq sourceDeclarations sourceRun rfl + image := nextImage + control := by rfl + noCredits := by simpa [nextFrame] using state.noCredits } + exact ⟨nextState, sourceRun, + by simpa [nextMachine, nextFrame, targetStore', nextBox] using targetStep⟩ + +/-- A checked terminal allocation exposes a borrow-free producer vector at +every matching current position. The proof is the focused recursive audit +retained by lowering, not a semantic caller assumption. -/ +theorem terminalAllocationNoBorrows + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {machine : Machine} + (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {sourceWorld : Ixon.Owned} {sourceCid : IxIR1.CtorId} + {sourceArguments : Array IxIR1.Atom} {targetInstruction : Instr} + {tailSite : Lower.SourceSite} {tailBlockId : BlockId} + {tailInput : Lower.Sim.EnvMap} {tailEntryValueCount : Nat} + {tailSourceArguments : Array IxIR1.Atom} {generated : Block} + (traceEq : state.trace = + .letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index targetInstruction + (.tailCallSelf tailSite tailBlockId tailInput tailEntryValueCount + tailSourceArguments generated)) + {position : Lower.PositionTrace} + (member : position ∈ attached.target.artifact.trace.positions) + (coordinate : position.coordinateMatches site blockId + (.instruction index) input = true) : + Lower.noBorrows position.sourceCapabilities = true := by + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index targetInstruction + (.tailCallSelf tailSite tailBlockId tailInput tailEntryValueCount + tailSourceArguments generated)) := by + rw [← traceEq] + exact state.descendant + exact attached.target.terminalAllocationPositionNoBorrows state.member + descendant member coordinate + +/-- Recover the exact pre-allocation root accounting at a checked constructor +allocation. The retained continuation position certifies that sequential +capability consumption succeeds; the dynamic source invariant then exposes +the consumed field roots followed by every surviving source and suspended +frame root. The result is stated on the evaluator heap so accepted-site +proofs do not need to reopen the compiler's exact store relation. -/ +theorem allocationReadyOwnership + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {machine : Machine} + (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} {sourceWorld targetWorld : Ixon.Owned} + {sourceCid targetCid : IxIR1.CtorId} + {sourceArguments : Array IxIR1.Atom} {targetArguments : Array Atom} + (traceEq : state.trace = + .letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next) + {values : List RVal} + (sourceResolved : + IxIR1.resolveAtoms state.source sourceArguments = .ok values) : + ∃ (before after : Lower.PositionTrace) + (remaining : Array Lower.BindingCap), + before ∈ attached.target.artifact.trace.positions ∧ + after ∈ attached.target.artifact.trace.positions ∧ + before.coordinateMatches site blockId (.instruction index) input = + true ∧ + after.coordinateMatches next.source next.sourceBlock + next.targetPosition next.sourceInputMap = true ∧ + Lower.consumeCapabilitiesList? before.sourceCapabilities input + sourceWorld sourceArguments.toList = some remaining ∧ + after.sourceCapabilities = #[.owned sourceWorld] ++ remaining ∧ + IxIR1.Sim.RootOwnership machine.store.heap + (IxIR1.Sim.rootsFor sourceWorld values ++ + Lower.Sim.rootsForCapabilities remaining.toList state.source ++ + state.frameRoots) := by + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next) := by + rw [← traceEq] + exact state.descendant + have nextDescendant : state.functionTrace.root.Descendant next := + .step descendant (by simp [Lower.CodeTrace.children]) + obtain ⟨after, afterMember, afterCoordinate⟩ := + attached.target.position state.member nextDescendant + obtain ⟨before, beforeMember, beforeCoordinate, transitionMatch⟩ := + attached.target.allocationTransition state.member descendant afterMember + afterCoordinate + have ownershipAt : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next) + state.sourceStore state.source state.frameRoots := by + rw [← traceEq] + exact state.ownership + have invariant := ownershipAt before beforeMember (by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceBlock, + Lower.CodeTrace.targetPosition, Lower.CodeTrace.sourceInputMap] using + beforeCoordinate) + change Lower.Sim.SourceOwnershipInvariant state.sourceStore state.source + input before.sourceCapabilities state.frameRoots at invariant + unfold Lower.PositionTrace.allocationResultMatches at transitionMatch + cases transitionEq : Lower.allocationCapabilities? + before.sourceCapabilities input sourceWorld sourceArguments with + | none => simp [transitionEq] at transitionMatch + | some expected => + have expectedEq : expected = after.sourceCapabilities := by + simpa [transitionEq, beq_iff_eq] using transitionMatch + obtain ⟨remaining, consumed, expectedCapabilities, ownership⟩ := + invariant.allocationReadyOwnership sourceResolved transitionEq + refine ⟨before, after, remaining, beforeMember, afterMember, + beforeCoordinate, afterCoordinate, consumed, ?_, ?_⟩ + · rw [← expectedEq] + exact expectedCapabilities + · rw [state.stores.heap] + exact ownership + +/-- Recover the evaluator field-world evidence at a checked allocation directly +from the running compiler witness. This is the accepted-site boundary form of +the ownership fact already used internally by `stepAlloc`: callers supply only +the traced source resolution and the schema selected by the evaluator context. -/ +theorem allocationFieldWorlds + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {context : Eval.Context} {machine : Machine} + (state : CompilerRunningState attached machine) + (contextSchemas : context.schemas = + attached.target.artifact.validationContext.schemas) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} {sourceWorld targetWorld : Ixon.Owned} + {sourceCid targetCid : IxIR1.CtorId} + {sourceArguments : Array IxIR1.Atom} {targetArguments : Array Atom} + (traceEq : state.trace = + .letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next) + {schema : CtorSchema} {values : List RVal} + (sourceResolved : + IxIR1.resolveAtoms state.source sourceArguments = .ok values) + (schemaAt : context.schemas sourceWorld sourceCid = some schema) : + Eval.FieldWorlds machine.store schema values.toArray := by + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next) := by + rw [← traceEq] + exact state.descendant + have ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next) + state.sourceStore state.source state.frameRoots := by + rw [← traceEq] + exact state.ownership + have checkedSchemaAt : + attached.target.artifact.validationContext.schemas sourceWorld sourceCid = + some schema := by + rw [← contextSchemas] + exact schemaAt + exact state.stores.fieldWorlds_of_checked_allocation_capabilities + state.member descendant ownership sourceResolved checkedSchemaAt + +/-- Advance a compiler running state across a checked constructor allocation +under either evaluator interpretation. The checked schema and source ownership +justify the target field worlds, and both stores allocate the same node at +corresponding locations. -/ +theorem stepAlloc + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} + (state : CompilerRunningState attached machine) + (contextSchemas : context.schemas = + attached.target.artifact.validationContext.schemas) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} {sourceWorld targetWorld : Ixon.Owned} + {sourceCid targetCid : IxIR1.CtorId} + {sourceArguments : Array IxIR1.Atom} {targetArguments : Array Atom} + (traceEq : state.trace = + .letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {schema : CtorSchema} {values : List RVal} + (sourceResolved : + IxIR1.resolveAtoms state.source sourceArguments = .ok values) + (schemaAt : context.schemas sourceWorld sourceCid = some schema) : + let node : IxIR1.Node := .ctorN sourceCid values.toArray + let sourceAllocation := state.sourceStore.allocNode sourceWorld node + let targetAllocation := machine.store.allocNode sourceWorld node + let nextFrame : Frame := + { state.frame with + pc := state.frame.pc + 1 + values := state.frame.values.push (.loc sourceAllocation.2) } + let nextMachine : Machine := + { machine with + store := targetAllocation.1 + control := .running nextFrame state.stack } + ∃ _ : CompilerRunningState attached nextMachine, + IxIR1.runOp sourceContext (sourceFuel + 1) + state.functionTrace.source state.sourceStore state.source + (.alloc sourceWorld sourceCid sourceArguments) = + .ok (sourceAllocation.1, .loc sourceAllocation.2) ∧ + Eval.Step context interpretation machine nextMachine ∧ + (targetWorld = .unique → + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext nextMachine + rewritten) := by + dsimp only + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next) := by + rw [← traceEq] + exact state.descendant + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) next) + state.sourceStore state.source state.frameRoots := by + rw [← traceEq] + exact state.ownership + let node : IxIR1.Node := .ctorN sourceCid values.toArray + let sourceAllocation := state.sourceStore.allocNode sourceWorld node + let targetAllocation := machine.store.allocNode sourceWorld node + let nextFrame : Frame := + { state.frame with + pc := state.frame.pc + 1 + values := state.frame.values.push (.loc sourceAllocation.2) } + let nextMachine : Machine := + { machine with + store := targetAllocation.1 + control := .running nextFrame state.stack } + obtain ⟨sourceRun, targetStep, nextStores, nextTraceState⟩ := + attached.simulate_traced_alloc_checked_state + (sourceFuel := sourceFuel) state.member contextSchemas descendant traceState + state.stores sourceDeclarations sourceResolved state.control schemaAt + ownership + have nextRuntime : Lower.Sim.SourceRuntimeInvariant sourceAllocation.1 + (.loc sourceAllocation.2 :: state.source) := + state.runtime.runOpNoReuse + (attached.sourceContextNoReuse sourceDeclarations) + (attached.functionTraceNoReuse state.member) (by trivial) sourceRun + have nextOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next sourceAllocation.1 + (.loc sourceAllocation.2 :: state.source) state.frameRoots := + Lower.Sim.SourceOwnershipAt.alloc (checked := attached.target) + state.member descendant ownership sourceRun + have nextImage : attached.SourceStoreImage sourceAllocation.1 := + attached.runOp_preservesSourceStoreImage sourceDeclarations state.member + descendant traceState state.image sourceRun + have nextDescendant : state.functionTrace.root.Descendant next := + .step descendant (by simp [Lower.CodeTrace.children]) + have nextState : CompilerRunningState attached nextMachine := + { functionTrace := state.functionTrace + trace := next + sourceStore := sourceAllocation.1 + source := .loc sourceAllocation.2 :: state.source + frameRoots := state.frameRoots + frame := nextFrame + stack := state.stack + member := state.member + descendant := nextDescendant + traceState := by simpa [nextFrame] using nextTraceState + stores := by + simpa [nextMachine, targetAllocation, sourceAllocation, node] using + nextStores + runtime := nextRuntime + ownership := nextOwnership + stackRoots := state.stackRoots + callStack := state.callStack + history := state.historyImmediateOp traceEq sourceDeclarations sourceRun rfl + image := nextImage + control := by rfl + noCredits := by simpa [nextFrame] using state.noCredits } + obtain ⟨currentBlockAt, _currentPcBound, allocAt⟩ := + traceState.target.instructionAt descendant + have nextBlockAt : nextFrame.definition.blocks[nextFrame.block]? = + some next.headBlock.2 := by + simpa [nextFrame] using currentBlockAt + exact ⟨nextState, sourceRun, + by + simpa [nextMachine, nextFrame, targetAllocation, sourceAllocation, + node] using targetStep, + fun targetUnique _rewritten => + StableLiveAcceptedEntry.ofAllocUniqueAdvance rfl nextBlockAt + (by simpa [nextFrame, targetUnique] using allocAt)⟩ + +/-- Advance a compiler running state across a strictly under-saturated +function partial application. The captured shared arguments are installed in +matching fresh PAP nodes and the fresh location is pushed on both environments. -/ +theorem stepPapp + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {targetDefinition : Function} + {machine : Machine} (state : CompilerRunningState attached machine) + {sourceDefinition : IxIR1.FnDef} + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} {sourceAddress targetAddress : Ixon.Address} + {sourceArguments : Array IxIR1.Atom} {targetArguments : Array Atom} + (traceEq : state.trace = + .letOp site blockId input nextInput entryValueCount + (.papp sourceAddress sourceArguments) index + (.papp targetAddress targetArguments) next) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {values : List RVal} + (sourceResolved : + IxIR1.resolveAtoms state.source sourceArguments = .ok values) + (sourceDeclaration : + sourceContext.decls sourceAddress = some (.fn sourceDefinition)) + (targetDeclaration : + context.declarations sourceAddress = some (.fn targetDefinition)) + (arity : + targetDefinition.signature.params.size = sourceDefinition.arity) + (papSafe : targetDefinition.signature.papSafe = true) + (under : values.length < sourceDefinition.arity) : + let node := IxIR1.Node.papN sourceAddress sourceDefinition.arity + values.toArray + let sourceAllocation := state.sourceStore.allocNode .shared node + let targetAllocation := machine.store.allocNode .shared node + let nextFrame : Frame := + { state.frame with + pc := state.frame.pc + 1 + values := state.frame.values.push (.loc sourceAllocation.2) } + let nextMachine : Machine := + { machine with + store := targetAllocation.1 + control := .running nextFrame state.stack } + ∃ _ : CompilerRunningState attached nextMachine, + IxIR1.runOp sourceContext (sourceFuel + 1) + state.functionTrace.source state.sourceStore state.source + (.papp sourceAddress sourceArguments) = + .ok (sourceAllocation.1, .loc sourceAllocation.2) ∧ + Eval.Step context interpretation machine nextMachine ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext nextMachine + rewritten := by + dsimp only + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.papp sourceAddress sourceArguments) index + (.papp targetAddress targetArguments) next) := by + rw [← traceEq] + exact state.descendant + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount + (.papp sourceAddress sourceArguments) index + (.papp targetAddress targetArguments) next) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.papp sourceAddress sourceArguments) index + (.papp targetAddress targetArguments) next) + state.sourceStore state.source state.frameRoots := by + rw [← traceEq] + exact state.ownership + let node := IxIR1.Node.papN sourceAddress sourceDefinition.arity + values.toArray + let sourceAllocation := state.sourceStore.allocNode .shared node + let targetAllocation := machine.store.allocNode .shared node + let nextFrame : Frame := + { state.frame with + pc := state.frame.pc + 1 + values := state.frame.values.push (.loc sourceAllocation.2) } + let nextMachine : Machine := + { machine with + store := targetAllocation.1 + control := .running nextFrame state.stack } + obtain ⟨sourceRun, targetStep, nextStores, nextTraceState⟩ := + attached.simulate_traced_papp_fn_state + (sourceFuel := sourceFuel) state.member descendant traceState state.stores + sourceDeclarations sourceResolved sourceDeclaration targetDeclaration + arity papSafe under state.noCredits state.control + have nextRuntime : Lower.Sim.SourceRuntimeInvariant sourceAllocation.1 + (.loc sourceAllocation.2 :: state.source) := by + apply state.runtime.runOp (run := sourceRun) + simp [IxIR1.Store.allocNode] + have nextOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next sourceAllocation.1 + (.loc sourceAllocation.2 :: state.source) state.frameRoots := + Lower.Sim.SourceOwnershipAt.papp (checked := attached.target) + state.member descendant ownership sourceRun + have nextImage : attached.SourceStoreImage sourceAllocation.1 := + attached.runOp_preservesSourceStoreImage sourceDeclarations state.member + descendant traceState state.image sourceRun + have nextDescendant : state.functionTrace.root.Descendant next := + .step descendant (by simp [Lower.CodeTrace.children]) + have nextState : CompilerRunningState attached nextMachine := + { functionTrace := state.functionTrace + trace := next + sourceStore := sourceAllocation.1 + source := .loc sourceAllocation.2 :: state.source + frameRoots := state.frameRoots + frame := nextFrame + stack := state.stack + member := state.member + descendant := nextDescendant + traceState := by simpa [nextFrame] using nextTraceState + stores := by + simpa [nextMachine, targetAllocation, sourceAllocation, node] using + nextStores + runtime := nextRuntime + ownership := nextOwnership + stackRoots := state.stackRoots + callStack := state.callStack + history := state.historyImmediateOp traceEq sourceDeclarations sourceRun rfl + image := nextImage + control := by rfl + noCredits := by simpa [nextFrame] using state.noCredits } + obtain ⟨currentBlockAt, _currentPcBound, pappAt⟩ := + traceState.target.instructionAt descendant + have nextBlockAt : nextFrame.definition.blocks[nextFrame.block]? = + some next.headBlock.2 := by + simpa [nextFrame] using currentBlockAt + exact ⟨nextState, sourceRun, + by + simpa [nextMachine, nextFrame, targetAllocation, sourceAllocation, + node] using targetStep, + fun _rewritten => StableLiveAcceptedEntry.ofPappAdvance rfl nextBlockAt + (by simpa [nextFrame] using pappAt)⟩ + +/-- Advance a compiler running state across scalar unique drop. One unit of +heap work is consumed, but neither source nor target heap changes. -/ +theorem stepDropUniqueScalar + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel targetHeapFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + (traceEq : state.trace = + .letOp site blockId input nextInput entryValueCount + (.dropU sourceAtom) index (.dropUnique targetAtom) next) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {value : RVal} + (sourceResolved : IxIR1.resolveAtom state.source sourceAtom = .ok value) + (scalar : Eval.RVal.isScalar value = true) + (heapFuel : machine.heapFuel = targetHeapFuel + 1) : + let nextFrame : Frame := { state.frame with pc := state.frame.pc + 1 } + let nextMachine : Machine := + { store := machine.store + heapFuel := targetHeapFuel + control := .running nextFrame state.stack } + ∃ _ : CompilerRunningState attached nextMachine, + IxIR1.runOp sourceContext (sourceFuel + 1) + state.functionTrace.source state.sourceStore state.source + (.dropU sourceAtom) = .ok (state.sourceStore, .erased) ∧ + Eval.Step context interpretation machine nextMachine ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext nextMachine + rewritten := by + dsimp only + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.dropU sourceAtom) index (.dropUnique targetAtom) next) := by + rw [← traceEq] + exact state.descendant + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount + (.dropU sourceAtom) index (.dropUnique targetAtom) next) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.dropU sourceAtom) index (.dropUnique targetAtom) next) + state.sourceStore state.source state.frameRoots := by + rw [← traceEq] + exact state.ownership + let nextFrame : Frame := { state.frame with pc := state.frame.pc + 1 } + let nextMachine : Machine := + { store := machine.store + heapFuel := targetHeapFuel + control := .running nextFrame state.stack } + obtain ⟨sourceRun, targetStep, nextStores, nextTraceState⟩ := + attached.simulate_traced_dropU_dropUnique_scalar_state + (sourceFuel := sourceFuel) state.member descendant traceState state.stores + sourceDeclarations sourceResolved scalar heapFuel state.control + have nextRuntime : Lower.Sim.SourceRuntimeInvariant state.sourceStore + (.erased :: state.source) := + state.runtime.runOp rfl sourceRun + have nextOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next state.sourceStore + (.erased :: state.source) state.frameRoots := + Lower.Sim.SourceOwnershipAt.dropU (checked := attached.target) + state.member descendant ownership sourceRun + have nextImage : attached.SourceStoreImage state.sourceStore := + attached.runOp_preservesSourceStoreImage sourceDeclarations state.member + descendant traceState state.image sourceRun + have nextDescendant : state.functionTrace.root.Descendant next := + .step descendant (by simp [Lower.CodeTrace.children]) + have nextState : CompilerRunningState attached nextMachine := + { functionTrace := state.functionTrace + trace := next + sourceStore := state.sourceStore + source := .erased :: state.source + frameRoots := state.frameRoots + frame := nextFrame + stack := state.stack + member := state.member + descendant := nextDescendant + traceState := by simpa [nextFrame] using nextTraceState + stores := by simpa [nextMachine] using nextStores + runtime := nextRuntime + ownership := nextOwnership + stackRoots := state.stackRoots + callStack := state.callStack + history := state.historyImmediateOp traceEq sourceDeclarations sourceRun rfl + image := nextImage + control := by rfl + noCredits := by simpa [nextFrame] using state.noCredits } + obtain ⟨currentBlockAt, _currentPcBound, dropAt⟩ := + traceState.target.instructionAt descendant + have nextBlockAt : nextFrame.definition.blocks[nextFrame.block]? = + some next.headBlock.2 := by + simpa [nextFrame] using currentBlockAt + exact ⟨nextState, sourceRun, + by simpa [nextMachine, nextFrame] using targetStep, + fun _rewritten => + StableLiveAcceptedEntry.ofDropUniqueAdvance rfl nextBlockAt + (by simpa [nextFrame] using dropAt)⟩ + +/-- Advance a compiler running state across recursive unique destruction. The +locally sufficient traversal budget is exposed additively, allowing any +independently funded suffix to follow the destructive step. -/ +theorem stepDropUnique + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + (traceEq : state.trace = + .letOp site blockId input nextInput entryValueCount + (.dropU sourceAtom) index (.dropUnique targetAtom) next) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {sourceStore' : IxIR1.Store} {location : Nat} + (sourceResolved : + IxIR1.resolveAtom state.source sourceAtom = .ok (.loc location)) + (sourceDropped : IxIR1.dropUVal sourceContext sourceFuel + state.sourceStore (.loc location) = .ok sourceStore') : + ∃ localFuel targetStore, + IxIR1.runOp sourceContext (sourceFuel + 1) + state.functionTrace.source state.sourceStore state.source + (.dropU sourceAtom) = .ok (sourceStore', .erased) ∧ + Eval.dropUnique localFuel machine.store (.loc location) = + .ok (targetStore, 0) ∧ + ∀ suffixFuel, + let fundedMachine : Machine := + { machine with heapFuel := localFuel + suffixFuel } + let nextFrame : Frame := + { state.frame with pc := state.frame.pc + 1 } + let nextMachine : Machine := + { store := targetStore + heapFuel := suffixFuel + control := .running nextFrame state.stack } + ∃ _ : CompilerRunningState attached fundedMachine, + ∃ _ : CompilerRunningState attached nextMachine, + Eval.Step context interpretation fundedMachine nextMachine ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext nextMachine + rewritten := by + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.dropU sourceAtom) index (.dropUnique targetAtom) next) := by + rw [← traceEq] + exact state.descendant + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount + (.dropU sourceAtom) index (.dropUnique targetAtom) next) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.dropU sourceAtom) index (.dropUnique targetAtom) next) + state.sourceStore state.source state.frameRoots := by + rw [← traceEq] + exact state.ownership + obtain ⟨localFuel, targetStore, sourceRun, exactDrop, stepForSuffix, + nextStores, nextTraceState⟩ := + attached.simulate_traced_dropU_dropUnique_recursive_state_framed + state.member descendant traceState state.stores sourceDeclarations + sourceResolved sourceDropped state.control + have nextRuntime : Lower.Sim.SourceRuntimeInvariant sourceStore' + (.erased :: state.source) := + state.runtime.runOp (IxIR1.NoReuse.dropUVal_reuses sourceDropped) sourceRun + have nextOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next sourceStore' + (.erased :: state.source) state.frameRoots := + Lower.Sim.SourceOwnershipAt.dropU (checked := attached.target) + state.member descendant ownership sourceRun + have nextImage : attached.SourceStoreImage sourceStore' := + attached.runOp_preservesSourceStoreImage sourceDeclarations state.member + descendant traceState state.image sourceRun + have nextDescendant : state.functionTrace.root.Descendant next := + .step descendant (by simp [Lower.CodeTrace.children]) + refine ⟨localFuel, targetStore, sourceRun, exactDrop, ?_⟩ + intro suffixFuel + dsimp only + let fundedMachine : Machine := + { machine with heapFuel := localFuel + suffixFuel } + let nextFrame : Frame := { state.frame with pc := state.frame.pc + 1 } + let nextMachine : Machine := + { store := targetStore + heapFuel := suffixFuel + control := .running nextFrame state.stack } + have fundedState : CompilerRunningState attached fundedMachine := + withHeapFuel state (localFuel + suffixFuel) + have nextState : CompilerRunningState attached nextMachine := + { functionTrace := state.functionTrace + trace := next + sourceStore := sourceStore' + source := .erased :: state.source + frameRoots := state.frameRoots + frame := nextFrame + stack := state.stack + member := state.member + descendant := nextDescendant + traceState := by simpa [nextFrame] using nextTraceState + stores := by simpa [nextMachine] using nextStores + runtime := nextRuntime + ownership := nextOwnership + stackRoots := state.stackRoots + callStack := state.callStack + history := state.historyImmediateOp traceEq sourceDeclarations sourceRun rfl + image := nextImage + control := by rfl + noCredits := by simpa [nextFrame] using state.noCredits } + obtain ⟨currentBlockAt, _currentPcBound, dropAt⟩ := + traceState.target.instructionAt descendant + have nextBlockAt : nextFrame.definition.blocks[nextFrame.block]? = + some next.headBlock.2 := by + simpa [nextFrame] using currentBlockAt + exact ⟨fundedState, nextState, + by + simpa [fundedMachine, nextMachine, nextFrame] using + stepForSuffix suffixFuel, + fun _rewritten => + StableLiveAcceptedEntry.ofDropUniqueAdvance rfl nextBlockAt + (by simpa [nextFrame] using dropAt)⟩ + +/-- Advance a compiler running state across scalar shared release. One unit of +heap work is consumed, but neither source nor target heap changes. -/ +theorem stepReleaseScalar + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel targetHeapFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + (traceEq : state.trace = + .letOp site blockId input nextInput entryValueCount + (.drop sourceAtom) index (.releaseShared targetAtom) next) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {value : RVal} + (sourceResolved : IxIR1.resolveAtom state.source sourceAtom = .ok value) + (scalar : Eval.RVal.isScalar value = true) + (heapFuel : machine.heapFuel = targetHeapFuel + 1) : + let nextFrame : Frame := { state.frame with pc := state.frame.pc + 1 } + let nextMachine : Machine := + { store := machine.store + heapFuel := targetHeapFuel + control := .running nextFrame state.stack } + ∃ _ : CompilerRunningState attached nextMachine, + IxIR1.runOp sourceContext (sourceFuel + 1) + state.functionTrace.source state.sourceStore state.source + (.drop sourceAtom) = .ok (state.sourceStore, .erased) ∧ + Eval.Step context interpretation machine nextMachine := by + dsimp only + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.drop sourceAtom) index (.releaseShared targetAtom) next) := by + rw [← traceEq] + exact state.descendant + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount + (.drop sourceAtom) index (.releaseShared targetAtom) next) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.drop sourceAtom) index (.releaseShared targetAtom) next) + state.sourceStore state.source state.frameRoots := by + rw [← traceEq] + exact state.ownership + let nextFrame : Frame := { state.frame with pc := state.frame.pc + 1 } + let nextMachine : Machine := + { store := machine.store + heapFuel := targetHeapFuel + control := .running nextFrame state.stack } + obtain ⟨sourceRun, targetStep, nextStores, nextTraceState⟩ := + attached.simulate_traced_drop_release_scalar_state + (sourceFuel := sourceFuel) state.member descendant traceState state.stores + sourceDeclarations sourceResolved scalar heapFuel state.control + have nextRuntime : Lower.Sim.SourceRuntimeInvariant state.sourceStore + (.erased :: state.source) := + state.runtime.runOp rfl sourceRun + have nextOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next state.sourceStore + (.erased :: state.source) state.frameRoots := + Lower.Sim.SourceOwnershipAt.drop (checked := attached.target) + state.member descendant ownership sourceRun + have nextImage : attached.SourceStoreImage state.sourceStore := + attached.runOp_preservesSourceStoreImage sourceDeclarations state.member + descendant traceState state.image sourceRun + have nextDescendant : state.functionTrace.root.Descendant next := + .step descendant (by simp [Lower.CodeTrace.children]) + have nextState : CompilerRunningState attached nextMachine := + { functionTrace := state.functionTrace + trace := next + sourceStore := state.sourceStore + source := .erased :: state.source + frameRoots := state.frameRoots + frame := nextFrame + stack := state.stack + member := state.member + descendant := nextDescendant + traceState := by simpa [nextFrame] using nextTraceState + stores := by simpa [nextMachine] using nextStores + runtime := nextRuntime + ownership := nextOwnership + stackRoots := state.stackRoots + callStack := state.callStack + history := state.historyImmediateOp traceEq sourceDeclarations sourceRun rfl + image := nextImage + control := by rfl + noCredits := by simpa [nextFrame] using state.noCredits } + exact ⟨nextState, sourceRun, + by simpa [nextMachine, nextFrame] using targetStep⟩ + +/-- Advance a compiler running state across recursive shared release. The +local fuel consumed by recursive reclamation is exposed additively, so every +chosen suffix budget has both a funded predecessor compiler state and a +successor compiler state with exactly that suffix budget. -/ +theorem stepReleaseShared + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} {sourceAtom : IxIR1.Atom} {targetAtom : Atom} + (traceEq : state.trace = + .letOp site blockId input nextInput entryValueCount + (.drop sourceAtom) index (.releaseShared targetAtom) next) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {sourceStore' : IxIR1.Store} {location : Nat} + (sourceResolved : + IxIR1.resolveAtom state.source sourceAtom = .ok (.loc location)) + (sourceDropped : IxIR1.dropVal sourceContext sourceFuel + state.sourceStore (.loc location) = .ok sourceStore') : + ∃ localFuel targetStore, + IxIR1.runOp sourceContext (sourceFuel + 1) + state.functionTrace.source state.sourceStore state.source + (.drop sourceAtom) = .ok (sourceStore', .erased) ∧ + Eval.releaseShared localFuel machine.store (.loc location) = + .ok (targetStore, 0) ∧ + ∀ suffixFuel, + let fundedMachine : Machine := + { machine with heapFuel := localFuel + suffixFuel } + let nextFrame : Frame := + { state.frame with pc := state.frame.pc + 1 } + let nextMachine : Machine := + { store := targetStore + heapFuel := suffixFuel + control := .running nextFrame state.stack } + ∃ _ : CompilerRunningState attached fundedMachine, + ∃ _ : CompilerRunningState attached nextMachine, + Eval.Step context interpretation fundedMachine nextMachine := by + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.drop sourceAtom) index (.releaseShared targetAtom) next) := by + rw [← traceEq] + exact state.descendant + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount + (.drop sourceAtom) index (.releaseShared targetAtom) next) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.drop sourceAtom) index (.releaseShared targetAtom) next) + state.sourceStore state.source state.frameRoots := by + rw [← traceEq] + exact state.ownership + obtain ⟨localFuel, targetStore, sourceRun, exactRelease, stepForSuffix, nextStores, + _, nextTraceState⟩ := + attached.simulate_traced_drop_release_recursive_state_framed + (sourceFuel := sourceFuel) state.member descendant traceState + state.runtime.positiveSharedRC state.stores sourceDeclarations + sourceResolved sourceDropped state.control + have nextRuntime : Lower.Sim.SourceRuntimeInvariant sourceStore' + (.erased :: state.source) := + state.runtime.runOp (IxIR1.NoReuse.dropVal_reuses sourceDropped) sourceRun + have nextOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next sourceStore' + (.erased :: state.source) state.frameRoots := + Lower.Sim.SourceOwnershipAt.drop (checked := attached.target) + state.member descendant ownership sourceRun + have nextImage : attached.SourceStoreImage sourceStore' := + attached.runOp_preservesSourceStoreImage sourceDeclarations state.member + descendant traceState state.image sourceRun + have nextDescendant : state.functionTrace.root.Descendant next := + .step descendant (by simp [Lower.CodeTrace.children]) + refine ⟨localFuel, targetStore, sourceRun, exactRelease, ?_⟩ + intro suffixFuel + dsimp only + let fundedMachine : Machine := + { machine with heapFuel := localFuel + suffixFuel } + let nextFrame : Frame := { state.frame with pc := state.frame.pc + 1 } + let nextMachine : Machine := + { store := targetStore + heapFuel := suffixFuel + control := .running nextFrame state.stack } + have fundedState : CompilerRunningState attached fundedMachine := + withHeapFuel state (localFuel + suffixFuel) + have nextState : CompilerRunningState attached nextMachine := + { functionTrace := state.functionTrace + trace := next + sourceStore := sourceStore' + source := .erased :: state.source + frameRoots := state.frameRoots + frame := nextFrame + stack := state.stack + member := state.member + descendant := nextDescendant + traceState := by simpa [nextFrame] using nextTraceState + stores := by simpa [nextMachine] using nextStores + runtime := nextRuntime + ownership := nextOwnership + stackRoots := state.stackRoots + callStack := state.callStack + history := state.historyImmediateOp traceEq sourceDeclarations sourceRun rfl + image := nextImage + control := by rfl + noCredits := by simpa [nextFrame] using state.noCredits } + exact ⟨fundedState, nextState, by + simpa [fundedMachine, nextMachine, nextFrame] using + stepForSuffix suffixFuel⟩ + +/-- A related running compiler state whose program counter is inside its head +instruction array must be at a retained source operation node. -/ +theorem traceLetOp_of_pc_lt + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + (pc : state.frame.pc < state.trace.headBlock.2.instructions.size) : + ∃ (site : Lower.SourceSite) (blockId : BlockId) + (input nextInput : Lower.Sim.EnvMap) (entryValueCount : Nat) + (operation : IxIR1.Op) (index : Nat) (instruction : Instr) + (next : Lower.CodeTrace), + state.trace = .letOp site blockId input nextInput entryValueCount + operation index instruction next := by + generalize traceEq : state.trace = trace + cases trace with + | ret site blockId input entryValueCount sourceAtom targetAtom generated => + have statePc := state.traceState.target.pc + rw [traceEq] at pc statePc + simp only [Lower.CodeTrace.headBlock, Lower.CodeTrace.entryPc] at pc statePc + omega + | tailCall site blockId input entryValueCount address arguments generated => + have statePc := state.traceState.target.pc + rw [traceEq] at pc statePc + simp only [Lower.CodeTrace.headBlock, Lower.CodeTrace.entryPc] at pc statePc + omega + | tailCallSelf site blockId input entryValueCount arguments generated => + have statePc := state.traceState.target.pc + rw [traceEq] at pc statePc + simp only [Lower.CodeTrace.headBlock, Lower.CodeTrace.entryPc] at pc statePc + omega + | letOp site blockId input nextInput entryValueCount operation index + instruction next => + exact ⟨site, blockId, input, nextInput, entryValueCount, operation, + index, instruction, next, rfl⟩ + | switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children => + have statePc := state.traceState.target.pc + rw [traceEq] at pc statePc + simp only [Lower.CodeTrace.headBlock, Lower.CodeTrace.entryPc] at pc statePc + omega + +/-- Recover the exact source operation and checked source/target syntax at a +concrete instruction of the running target frame. -/ +theorem currentLetOp + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {block : Block} {targetInstruction : Instr} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc < block.instructions.size) + (instruction : block.instructions[state.frame.pc] = targetInstruction) : + ∃ (site : Lower.SourceSite) (blockId : BlockId) + (input nextInput : Lower.Sim.EnvMap) (entryValueCount : Nat) + (operation : IxIR1.Op) (index : Nat) (next : Lower.CodeTrace), + state.trace = .letOp site blockId input nextInput entryValueCount + operation index targetInstruction next ∧ + Lower.OperationSyntax input operation targetInstruction := by + have exactBlock := state.traceState.target.blockAt state.descendant + have blockEq : block = state.trace.headBlock.2 := + Option.some.inj (blockAt.symm.trans exactBlock) + have headPc : state.frame.pc < + state.trace.headBlock.2.instructions.size := by + simpa [← blockEq] using pc + obtain ⟨site, blockId, input, nextInput, entryValueCount, operation, + index, actualInstruction, next, traceEq⟩ := + state.traceLetOp_of_pc_lt headPc + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount operation index + actualInstruction next) := by + rw [← traceEq] + exact state.descendant + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount operation index + actualInstruction next) state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + obtain ⟨traceBlockAt, _tracePc, traceInstructionAt⟩ := + traceState.target.instructionAt descendant + have nextBlockEq : block = next.headBlock.2 := + Option.some.inj (blockAt.symm.trans traceBlockAt) + have targetInstructionAt : next.headBlock.2.instructions[state.frame.pc]? = + some targetInstruction := by + rw [← nextBlockEq] + exact Array.getElem?_eq_some_iff.mpr ⟨pc, instruction⟩ + have instructionEq : actualInstruction = targetInstruction := + Option.some.inj (traceInstructionAt.symm.trans targetInstructionAt) + subst actualInstruction + exact ⟨site, blockId, input, nextInput, entryValueCount, operation, + index, next, traceEq, + state.functionTrace.descendantOperationSyntax descendant⟩ + +/-- Reconstruct the compiler successor for a concrete target `move`. The +checked environment map reflects the resolved target operand back to the +source `pure`, after which the existing transition supplies both the running +compiler state and the accepted-entry exclusion for a move-containing block. -/ +theorem stepPureOfTarget + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {block : Block} {targetAtom : Atom} {value : RVal} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc < block.instructions.size) + (instruction : block.instructions[state.frame.pc] = .move targetAtom) + (targetResolved : Eval.resolveAtom state.frame.values targetAtom = + .ok value) : + let nextFrame : Frame := + { state.frame with + pc := state.frame.pc + 1 + values := state.frame.values.push value } + let nextMachine : Machine := + { machine with control := .running nextFrame state.stack } + ∃ _ : CompilerRunningState attached nextMachine, + Eval.Step context interpretation machine nextMachine ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext nextMachine + rewritten := by + dsimp only + obtain ⟨site, blockId, input, nextInput, entryValueCount, operation, + index, next, traceEq, operationSyntax⟩ := + state.currentLetOp blockAt pc instruction + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount operation index + (.move targetAtom) next) state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + cases operation with + | pure sourceAtom => + change Lower.InputMap.translateAtom input sourceAtom = + some targetAtom at operationSyntax + have sourceCount : state.source.length = input.size := by + simpa [Lower.CodeTrace.sourceInputMap] using + traceState.target.sourceCount + have sourceResolved : IxIR1.resolveAtom state.source sourceAtom = + .ok value := + Lower.Sim.resolveAtom_of_envRel_target + traceState.target.environments sourceCount operationSyntax + targetResolved + obtain ⟨nextState, _sourceRun, targetStep, acceptedEntry⟩ := + state.stepPure (sourceFuel := sourceFuel) (context := context) + (interpretation := interpretation) traceEq sourceDeclarations + sourceResolved + exact ⟨nextState, targetStep, acceptedEntry⟩ + | alloc sourceWorld sourceCid sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | reuse sourceAtom sourceCid sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | free sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | dup sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | drop sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | dropU sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | fetch sourceAtom sourceField => + simp [Lower.OperationSyntax] at operationSyntax + | call sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | callSelf sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | papp sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | apply sourceFunction sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | extern sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + +/-- Focus the owner consumed by the current checked destruction operation. +The flat producer trace certifies a successful consume transition; a concrete +location result rules out its scalar alternative, leaving the exact owner in +the requested world. -/ +theorem destructionOwnedRoot + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {operation : IxIR1.Op} {instruction : Instr} {next : Lower.CodeTrace} + {world : Ixon.Owned} {sourceAtom : IxIR1.Atom} + (traceEq : state.trace = + .letOp site blockId input nextInput entryValueCount operation index + instruction next) + (destruction : Lower.destructionSpec? operation = + some (world, sourceAtom)) + {location : Nat} + (resolved : IxIR1.resolveAtom state.source sourceAtom = + .ok (.loc location)) : + ∃ rest : List IxIR1.Sim.Root, + IxIR1.Sim.RootOwnership state.sourceStore + (⟨world, .loc location⟩ :: rest) := by + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount operation index + instruction next) := by + rw [← traceEq] + exact state.descendant + have nextDescendant : state.functionTrace.root.Descendant next := + .step descendant (by simp [Lower.CodeTrace.children]) + obtain ⟨after, afterMember, afterCoordinate⟩ := + attached.target.position state.member nextDescendant + obtain ⟨before, beforeMember, beforeCoordinate, transition⟩ := + attached.target.destructionTransition state.member destruction descendant + afterMember afterCoordinate + have ownership : Lower.Sim.SourceOwnershipInvariant state.sourceStore + state.source input before.sourceCapabilities state.frameRoots := by + have selected := state.ownership before beforeMember + rw [traceEq] at selected + exact selected (by simpa [Lower.CodeTrace.source, + Lower.CodeTrace.sourceBlock, Lower.CodeTrace.targetPosition, + Lower.CodeTrace.sourceInputMap] using beforeCoordinate) + unfold Lower.PositionTrace.destructionResultMatches at transition + cases consumedResult : Lower.destructionCapabilities? + before.sourceCapabilities input world sourceAtom with + | none => simp [consumedResult] at transition + | some afterCapabilities => + unfold Lower.destructionCapabilities? at consumedResult + cases consumed : Lower.consumeCapability? before.sourceCapabilities + input world sourceAtom with + | none => simp [consumed] at consumedResult + | some remaining => + cases sourceAtom with + | lit literal => simp [IxIR1.resolveAtom] at resolved + | erased => simp [IxIR1.resolveAtom] at resolved + | var sourceIndex => + cases sourceAt : state.source[sourceIndex]? with + | none => simp [IxIR1.resolveAtom, sourceAt] at resolved + | some sourceValue => + have sourceValueEq : sourceValue = .loc location := by + simpa [IxIR1.resolveAtom, sourceAt] using resolved + subst sourceValue + cases capabilityAt : before.sourceCapabilities[sourceIndex]? + <;> simp [Lower.consumeCapability?, Lower.sourceCapability?, + capabilityAt] at consumed + case some capability => + cases capability with + | scalar => + have scalar := ownership.holds capabilityAt sourceAt + simp [Lower.Sim.CapabilityHolds, + IxIR1.Sim.rvalLocation?] at scalar + | dead => simp at consumed + | borrowed borrowWorld lender => simp at consumed + | owned actualWorld => + by_cases worldEq : actualWorld = world + · subst actualWorld + obtain ⟨rest, focused, _rootsInRest⟩ := + ownership.focusOwned capabilityAt sourceAt + exact ⟨rest, focused⟩ + · simp [worldEq] at consumed + +/-- Reconstruct a compiler transition from the concrete target-side fetch at +the current trace coordinate. -/ +theorem stepFetchOfTarget + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {block : Block} {targetAtom : Atom} {targetCid : CtorId} + {field location rc : Nat} {world : Owned} {fields : Array RVal} + {value : RVal} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc < block.instructions.size) + (instruction : block.instructions[state.frame.pc] = + .fetch targetAtom targetCid field) + (targetResolved : Eval.resolveAtom state.frame.values targetAtom = + .ok (.loc location)) + (targetGet : machine.store.get? location = + some ⟨world, rc, .ctorN targetCid fields⟩) + (fieldAt : fields[field]? = some value) : + let nextFrame : Frame := + { state.frame with + pc := state.frame.pc + 1 + values := state.frame.values.push value } + let nextMachine : Machine := + { machine with control := .running nextFrame state.stack } + ∃ _ : CompilerRunningState attached nextMachine, + Eval.Step context interpretation machine nextMachine := by + dsimp only + obtain ⟨site, blockId, input, nextInput, entryValueCount, operation, + index, next, traceEq, operationSyntax⟩ := + state.currentLetOp blockAt pc instruction + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount operation index + (.fetch targetAtom targetCid field) next) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + cases operation with + | fetch sourceAtom sourceField => + change sourceField = field ∧ + Lower.InputMap.translateAtom input sourceAtom = some targetAtom + at operationSyntax + obtain ⟨fieldEq, translated⟩ := operationSyntax + subst sourceField + have sourceCount : state.source.length = input.size := by + simpa [Lower.CodeTrace.sourceInputMap] using + traceState.target.sourceCount + have sourceResolved : IxIR1.resolveAtom state.source sourceAtom = + .ok (.loc location) := + Lower.Sim.resolveAtom_of_envRel_target + traceState.target.environments sourceCount translated targetResolved + have sourceGet : state.sourceStore.get? location = + some ⟨world, rc, .ctorN targetCid fields⟩ := by + unfold Eval.Store.get? at targetGet + rw [state.stores.heap] at targetGet + exact targetGet + have sourceRun := IxIR1.Sim.runOp_fetch + (ctx := sourceContext) (fuel := sourceFuel) + (cur := state.functionTrace.source) sourceResolved sourceGet fieldAt + obtain ⟨nextState, _sourceRun, targetStep⟩ := + state.stepFetch (sourceFuel := sourceFuel) (context := context) + (interpretation := interpretation) traceEq sourceDeclarations + sourceRun + exact ⟨nextState, targetStep⟩ + | pure sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | alloc sourceWorld sourceCid sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | reuse sourceAtom sourceCid sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | free sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | dup sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | drop sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | dropU sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | call sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | callSelf sourceArguments => simp [Lower.OperationSyntax] at operationSyntax + | papp sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | apply sourceFunction sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | extern sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + +/-- Reconstruct a shallow unique-free compiler transition from its concrete +target runtime case. The lowering environment reflects the selected location +back to the source `free`; evaluator determinism then identifies the checked +compiler endpoint with the caller's concrete target endpoint. -/ +theorem stepFreeUniqueOfTarget + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {block : Block} {targetAtom : Atom} {targetCid : CtorId} + {location : Nat} {box : NodeBox} {fields : Array RVal} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc < block.instructions.size) + (instruction : block.instructions[state.frame.pc] = + .freeUnique targetAtom targetCid) + (targetResolved : Eval.resolveAtom state.frame.values targetAtom = + .ok (.loc location)) + (viewed : ConstructorView machine.store location .unique targetCid box + fields) + (scalarFields : fields.all RVal.isScalar = true) : + let nextFrame : Frame := { state.frame with pc := state.frame.pc + 1 } + let nextMachine : Machine := + { machine with + store := machine.store.kill location + control := .running nextFrame state.stack } + ∃ _ : CompilerRunningState attached nextMachine, + Eval.Step context interpretation machine nextMachine ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext nextMachine + rewritten := by + dsimp only + obtain ⟨site, blockId, input, nextInput, entryValueCount, operation, + index, next, traceEq, operationSyntax⟩ := + state.currentLetOp blockAt pc instruction + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount operation index + (.freeUnique targetAtom targetCid) next) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + cases operation with + | free sourceAtom => + change Lower.InputMap.translateAtom input sourceAtom = + some targetAtom at operationSyntax + have sourceCount : state.source.length = input.size := by + simpa [Lower.CodeTrace.sourceInputMap] using + traceState.target.sourceCount + have sourceResolved : IxIR1.resolveAtom state.source sourceAtom = + .ok (.loc location) := + Lower.Sim.resolveAtom_of_envRel_target + traceState.target.environments sourceCount operationSyntax + targetResolved + obtain ⟨targetGet, unique, _node⟩ := viewed.parts + have sourceGet : state.sourceStore.get? location = some box := by + unfold Eval.Store.get? at targetGet + rw [state.stores.heap] at targetGet + exact targetGet + rcases box with ⟨boxWorld, boxRc, boxNode⟩ + dsimp only at unique + subst boxWorld + have sourceRun : IxIR1.runOp sourceContext (sourceFuel + 1) + state.functionTrace.source state.sourceStore state.source + (.free sourceAtom) = + .ok (state.sourceStore.kill location, .erased) := by + apply IxIR1.Sim.runOp_free sourceResolved + exact sourceGet + obtain ⟨generatedLocation, outputStoreEq, generatedState, + generatedStep, generatedEntry⟩ := + state.stepFreeUnique (context := context) + (interpretation := interpretation) traceEq sourceDeclarations + sourceRun + have concreteStep : Eval.Step context interpretation machine + { machine with + store := machine.store.kill location + control := .running + { state.frame with pc := state.frame.pc + 1 } state.stack } := + by + simpa only [← state.control] using + (InstructionTransferCase.freeUnique + (context := context) (interpretation := interpretation) + (store := machine.store) (heapFuel := machine.heapFuel) + (frame := state.frame) (stack := state.stack) + targetResolved viewed scalarFields).step blockAt pc instruction + have targetEq := generatedStep.deterministic concreteStep + rw [targetEq] at generatedState generatedStep generatedEntry + exact ⟨generatedState, generatedStep, generatedEntry⟩ + | pure sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | alloc sourceWorld sourceCid sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | reuse sourceAtom sourceCid sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | dup sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | drop sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | dropU sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | fetch sourceAtom sourceField => + simp [Lower.OperationSyntax] at operationSyntax + | call sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | callSelf sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | papp sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | apply sourceFunction sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | extern sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + +/-- Reconstruct a compiler transition from a concrete target shared-retain, +including the scalar no-op branch. -/ +theorem stepRetainOfTarget + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {block : Block} {targetAtom : Atom} {value : RVal} {targetStore : Store} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc < block.instructions.size) + (instruction : block.instructions[state.frame.pc] = + .retainShared targetAtom) + (targetResolved : Eval.resolveAtom state.frame.values targetAtom = + .ok value) + (retained : Eval.retainShared machine.store value = .ok targetStore) : + let nextFrame : Frame := + { state.frame with + pc := state.frame.pc + 1 + values := state.frame.values.push value } + let nextMachine : Machine := + { store := targetStore + heapFuel := machine.heapFuel + control := .running nextFrame state.stack } + ∃ _ : CompilerRunningState attached nextMachine, + Eval.Step context interpretation machine nextMachine := by + dsimp only + obtain ⟨site, blockId, input, nextInput, entryValueCount, operation, + index, next, traceEq, operationSyntax⟩ := + state.currentLetOp blockAt pc instruction + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount operation index + (.retainShared targetAtom) next) state.sourceStore state.source + state.frame := by + rw [← traceEq] + exact state.traceState + cases operation with + | dup sourceAtom => + change Lower.InputMap.translateAtom input sourceAtom = + some targetAtom at operationSyntax + have sourceCount : state.source.length = input.size := by + simpa [Lower.CodeTrace.sourceInputMap] using + traceState.target.sourceCount + have sourceResolved : IxIR1.resolveAtom state.source sourceAtom = + .ok value := + Lower.Sim.resolveAtom_of_envRel_target + traceState.target.environments sourceCount operationSyntax + targetResolved + cases value with + | lit literal => + have storeEq : targetStore = machine.store := by + have reverse : machine.store = targetStore := by + simpa [Eval.retainShared] using retained + exact reverse.symm + subst targetStore + obtain ⟨nextState, _sourceRun, targetStep⟩ := + state.stepRetainScalar (sourceFuel := sourceFuel) + (context := context) (interpretation := interpretation) traceEq + sourceDeclarations sourceResolved rfl + exact ⟨nextState, targetStep⟩ + | erased => + have storeEq : targetStore = machine.store := by + have reverse : machine.store = targetStore := by + simpa [Eval.retainShared] using retained + exact reverse.symm + subst targetStore + obtain ⟨nextState, _sourceRun, targetStep⟩ := + state.stepRetainScalar (sourceFuel := sourceFuel) + (context := context) (interpretation := interpretation) traceEq + sourceDeclarations sourceResolved rfl + exact ⟨nextState, targetStep⟩ + | loc location => + cases targetGet : machine.store.get? location with + | none => simp [Eval.retainShared, targetGet] at retained + | some box => + cases boxWorld : box.world with + | unique => + simp [Eval.retainShared, targetGet, boxWorld] at retained + | shared => + have storeEq : targetStore = + (machine.store.setBox location + { box with rc := box.rc + 1 }).rcTick := by + have reverse : + (machine.store.setBox location + { box with rc := box.rc + 1 }).rcTick = + targetStore := by + simpa [Eval.retainShared, targetGet, boxWorld] using + retained + exact reverse.symm + subst targetStore + have sourceGet : state.sourceStore.get? location = + some box := by + unfold Eval.Store.get? at targetGet + rw [state.stores.heap] at targetGet + exact targetGet + obtain ⟨nextState, _sourceRun, targetStep⟩ := + state.stepRetainShared (sourceFuel := sourceFuel) + (context := context) (interpretation := interpretation) + traceEq sourceDeclarations sourceResolved sourceGet + boxWorld + exact ⟨nextState, targetStep⟩ + | pure sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | alloc sourceWorld sourceCid sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | reuse sourceAtom sourceCid sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | free sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | drop sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | dropU sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | fetch sourceAtom sourceField => simp [Lower.OperationSyntax] at operationSyntax + | call sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | callSelf sourceArguments => simp [Lower.OperationSyntax] at operationSyntax + | papp sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | apply sourceFunction sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | extern sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + +/-- Reconstruct an arbitrary checked shared release from its concrete target +runtime result. Scalars are the one-unit no-op case. For a location, the +producer destruction audit focuses the consumed shared owner, source progress +constructs a deep drop, and release uniqueness aligns its local budget with +the target step's actual remaining heap fuel. -/ +theorem stepReleaseOfTarget + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {block : Block} {targetAtom : Atom} {value : RVal} + {targetStore : Store} {remaining : Nat} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc < block.instructions.size) + (instruction : block.instructions[state.frame.pc] = + .releaseShared targetAtom) + (targetResolved : Eval.resolveAtom state.frame.values targetAtom = + .ok value) + (released : Eval.releaseShared machine.heapFuel machine.store value = + .ok (targetStore, remaining)) : + let nextFrame : Frame := { state.frame with pc := state.frame.pc + 1 } + let nextMachine : Machine := + { store := targetStore + heapFuel := remaining + control := .running nextFrame state.stack } + ∃ _ : CompilerRunningState attached nextMachine, + Eval.Step context interpretation machine nextMachine := by + dsimp only + obtain ⟨site, blockId, input, nextInput, entryValueCount, operation, + index, next, traceEq, operationSyntax⟩ := + state.currentLetOp blockAt pc instruction + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount operation index + (.releaseShared targetAtom) next) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + cases operation with + | drop sourceAtom => + change Lower.InputMap.translateAtom input sourceAtom = + some targetAtom at operationSyntax + have sourceCount : state.source.length = input.size := by + simpa [Lower.CodeTrace.sourceInputMap] using + traceState.target.sourceCount + have sourceResolved : IxIR1.resolveAtom state.source sourceAtom = + .ok value := + Lower.Sim.resolveAtom_of_envRel_target + traceState.target.environments sourceCount operationSyntax + targetResolved + cases value with + | lit literal => + cases fuelEq : machine.heapFuel with + | zero => + simp [fuelEq, Eval.releaseShared, Eval.releaseSharedWork] + at released + | succ targetHeapFuel => + have outputEq : (machine.store, targetHeapFuel) = + (targetStore, remaining) := by + simpa [fuelEq, Eval.releaseShared, Eval.releaseSharedWork] + using released + injection outputEq with storeEq remainingEq + subst targetStore + subst remaining + obtain ⟨nextState, _sourceRun, targetStep⟩ := + state.stepReleaseScalar (sourceContext := sourceContext) + (sourceFuel := 0) (context := context) + (interpretation := interpretation) traceEq + sourceDeclarations sourceResolved rfl fuelEq + exact ⟨nextState, targetStep⟩ + | erased => + cases fuelEq : machine.heapFuel with + | zero => + simp [fuelEq, Eval.releaseShared, Eval.releaseSharedWork] + at released + | succ targetHeapFuel => + have outputEq : (machine.store, targetHeapFuel) = + (targetStore, remaining) := by + simpa [fuelEq, Eval.releaseShared, Eval.releaseSharedWork] + using released + injection outputEq with storeEq remainingEq + subst targetStore + subst remaining + obtain ⟨nextState, _sourceRun, targetStep⟩ := + state.stepReleaseScalar (sourceContext := sourceContext) + (sourceFuel := 0) (context := context) + (interpretation := interpretation) traceEq + sourceDeclarations sourceResolved rfl fuelEq + exact ⟨nextState, targetStep⟩ + | loc location => + obtain ⟨rest, sourceOwned⟩ := + state.destructionOwnedRoot traceEq rfl sourceResolved + obtain ⟨sourceFuel, sourceStore', sourceDropped, + _nextOwned⟩ := + IxIR1.dropVal_progress (ctx := sourceContext) sourceOwned + obtain ⟨localFuel, localStore, _sourceRun, exactLocalRelease, + stepForSuffix⟩ := + state.stepReleaseShared (context := context) + (interpretation := interpretation) traceEq sourceDeclarations + sourceResolved sourceDropped + have localWork : Eval.releaseSharedWork localFuel machine.store + [.loc location] = .ok (localStore, 0) := by + simpa [Eval.releaseShared] using exactLocalRelease + have actualWork : Eval.releaseSharedWork machine.heapFuel + machine.store [.loc location] = .ok (targetStore, remaining) := by + simpa [Eval.releaseShared] using released + obtain ⟨storeEq, fuelEq⟩ := + Lower.Sim.releaseSharedWork_success_unique localWork actualWork + subst localStore + have fundedEq : localFuel + remaining = machine.heapFuel := by + simpa using fuelEq + obtain ⟨_fundedState, nextState, targetStep⟩ := + stepForSuffix remaining + have machineEq : ({ machine with + heapFuel := localFuel + remaining } : Machine) = machine := by + cases machine + simp_all + rw [machineEq] at targetStep + exact ⟨nextState, targetStep⟩ + | pure sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | alloc sourceWorld sourceCid sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | reuse sourceAtom sourceCid sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | free sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | dup sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | dropU sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | fetch sourceAtom sourceField => + simp [Lower.OperationSyntax] at operationSyntax + | call sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | callSelf sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | papp sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | apply sourceFunction sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | extern sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + +/-- Reconstruct an arbitrary checked unique drop from its concrete target +runtime result. The proof mirrors shared release: scalar drops consume one +unit directly, while a focused unique source owner produces an exact local +traversal whose store and residual budget are fixed by success uniqueness. -/ +theorem stepDropUniqueOfTarget + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {block : Block} {targetAtom : Atom} {value : RVal} + {targetStore : Store} {remaining : Nat} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc < block.instructions.size) + (instruction : block.instructions[state.frame.pc] = + .dropUnique targetAtom) + (targetResolved : Eval.resolveAtom state.frame.values targetAtom = + .ok value) + (dropped : Eval.dropUnique machine.heapFuel machine.store value = + .ok (targetStore, remaining)) : + let nextFrame : Frame := { state.frame with pc := state.frame.pc + 1 } + let nextMachine : Machine := + { store := targetStore + heapFuel := remaining + control := .running nextFrame state.stack } + ∃ _ : CompilerRunningState attached nextMachine, + Eval.Step context interpretation machine nextMachine ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext nextMachine + rewritten := by + dsimp only + obtain ⟨site, blockId, input, nextInput, entryValueCount, operation, + index, next, traceEq, operationSyntax⟩ := + state.currentLetOp blockAt pc instruction + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount operation index + (.dropUnique targetAtom) next) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + cases operation with + | dropU sourceAtom => + change Lower.InputMap.translateAtom input sourceAtom = + some targetAtom at operationSyntax + have sourceCount : state.source.length = input.size := by + simpa [Lower.CodeTrace.sourceInputMap] using + traceState.target.sourceCount + have sourceResolved : IxIR1.resolveAtom state.source sourceAtom = + .ok value := + Lower.Sim.resolveAtom_of_envRel_target + traceState.target.environments sourceCount operationSyntax + targetResolved + cases value with + | lit literal => + cases fuelEq : machine.heapFuel with + | zero => + simp [fuelEq, Eval.dropUnique, Eval.dropUniqueWork] at dropped + | succ targetHeapFuel => + have outputEq : (machine.store, targetHeapFuel) = + (targetStore, remaining) := by + simpa [fuelEq, Eval.dropUnique, Eval.dropUniqueWork] + using dropped + injection outputEq with storeEq remainingEq + subst targetStore + subst remaining + obtain ⟨nextState, _sourceRun, targetStep, acceptedEntry⟩ := + state.stepDropUniqueScalar (sourceContext := sourceContext) + (sourceFuel := 0) (context := context) + (interpretation := interpretation) traceEq + sourceDeclarations sourceResolved rfl fuelEq + exact ⟨nextState, targetStep, acceptedEntry⟩ + | erased => + cases fuelEq : machine.heapFuel with + | zero => + simp [fuelEq, Eval.dropUnique, Eval.dropUniqueWork] at dropped + | succ targetHeapFuel => + have outputEq : (machine.store, targetHeapFuel) = + (targetStore, remaining) := by + simpa [fuelEq, Eval.dropUnique, Eval.dropUniqueWork] + using dropped + injection outputEq with storeEq remainingEq + subst targetStore + subst remaining + obtain ⟨nextState, _sourceRun, targetStep, acceptedEntry⟩ := + state.stepDropUniqueScalar (sourceContext := sourceContext) + (sourceFuel := 0) (context := context) + (interpretation := interpretation) traceEq + sourceDeclarations sourceResolved rfl fuelEq + exact ⟨nextState, targetStep, acceptedEntry⟩ + | loc location => + obtain ⟨rest, sourceOwned⟩ := + state.destructionOwnedRoot traceEq rfl sourceResolved + obtain ⟨sourceFuel, sourceStore', sourceDropped, + _nextOwned⟩ := + IxIR1.dropUVal_progress (ctx := sourceContext) sourceOwned + obtain ⟨localFuel, localStore, _sourceRun, exactLocalDrop, + stepForSuffix⟩ := + state.stepDropUnique (context := context) + (interpretation := interpretation) traceEq sourceDeclarations + sourceResolved sourceDropped + have localWork : Eval.dropUniqueWork localFuel machine.store + [.loc location] = .ok (localStore, 0) := by + simpa [Eval.dropUnique] using exactLocalDrop + have actualWork : Eval.dropUniqueWork machine.heapFuel + machine.store [.loc location] = .ok (targetStore, remaining) := by + simpa [Eval.dropUnique] using dropped + obtain ⟨storeEq, fuelEq⟩ := + Lower.Sim.dropUniqueWork_success_unique localWork actualWork + subst localStore + have fundedEq : localFuel + remaining = machine.heapFuel := by + simpa using fuelEq + obtain ⟨_fundedState, nextState, targetStep, acceptedEntry⟩ := + stepForSuffix remaining + have machineEq : ({ machine with + heapFuel := localFuel + remaining } : Machine) = machine := by + cases machine + simp_all + rw [machineEq] at targetStep + exact ⟨nextState, targetStep, acceptedEntry⟩ + | pure sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | alloc sourceWorld sourceCid sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | reuse sourceAtom sourceCid sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | free sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | dup sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | drop sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | fetch sourceAtom sourceField => + simp [Lower.OperationSyntax] at operationSyntax + | call sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | callSelf sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | papp sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | apply sourceFunction sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | extern sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + +/-- Reconstruct the accepted site's shared release from the concrete target +transition. Exact producer ownership supplies a successful source drop; the +release uniqueness law then aligns its synthesized local budget with the +caller's actual budget and residual suffix. -/ +theorem stepAcceptedReleaseOfTarget + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (baselineDefinition : state.frame.definition = source) + {helperOffset : Nat} {block : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block} + (accepted : Reuse.FunctionDecisions.At rewrite.decisions state.frame.block + helperOffset block (.accepted site)) + (pc : state.frame.pc = site.shape.releasePosition) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {location remaining : Nat} {targetStore : Store} + (targetResolved : + Eval.resolveAtom state.frame.values (.reg site.shape.source) = + .ok (.loc location)) + (released : + Eval.releaseShared machine.heapFuel machine.store (.loc location) = + .ok (targetStore, remaining)) : + let nextFrame : Frame := { state.frame with pc := state.frame.pc + 1 } + let nextMachine : Machine := + { store := targetStore + heapFuel := remaining + control := .running nextFrame state.stack } + ∃ _ : CompilerRunningState attached nextMachine, + Eval.Step context interpretation machine nextMachine := by + dsimp only + have sourceAt := (rewrite.acceptedAt accepted).1 + have blockAt : state.frame.definition.blocks[state.frame.block]? = + some block := by + rw [baselineDefinition] + exact sourceAt + have releaseAt : block.instructions[state.frame.pc]? = + some (.releaseShared (.reg site.shape.source)) := by + rw [pc] + exact site.fits.release + obtain ⟨pcBound, instruction⟩ := + Array.getElem?_eq_some_iff.mp releaseAt + obtain ⟨traceSite, blockId, input, nextInput, entryValueCount, operation, + index, next, traceEq, operationSyntax⟩ := + state.currentLetOp blockAt pcBound instruction + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp traceSite blockId input nextInput entryValueCount operation index + (.releaseShared (.reg site.shape.source)) next) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + cases operation with + | drop sourceAtom => + change Lower.InputMap.translateAtom input sourceAtom = + some (.reg site.shape.source) at operationSyntax + have sourceCount : state.source.length = input.size := by + simpa [Lower.CodeTrace.sourceInputMap] using + traceState.target.sourceCount + have sourceResolved : IxIR1.resolveAtom state.source sourceAtom = + .ok (.loc location) := + Lower.Sim.resolveAtom_of_envRel_target + traceState.target.environments sourceCount operationSyntax + targetResolved + obtain ⟨rest, sourceOwned, _rootsInRest⟩ := + state.acceptedSiteSourceRoot rewrite baselineDefinition accepted + (by omega) targetResolved + obtain ⟨sourceFuel, sourceStore', sourceDropped, _nextOwned⟩ := + IxIR1.dropVal_progress (ctx := sourceContext) sourceOwned + obtain ⟨localFuel, localStore, _sourceRun, exactLocalRelease, + stepForSuffix⟩ := + state.stepReleaseShared (context := context) + (interpretation := interpretation) traceEq sourceDeclarations + sourceResolved sourceDropped + have localWork : Eval.releaseSharedWork localFuel machine.store + [.loc location] = .ok (localStore, 0) := by + simpa [Eval.releaseShared] using exactLocalRelease + have actualWork : Eval.releaseSharedWork machine.heapFuel machine.store + [.loc location] = .ok (targetStore, remaining) := by + simpa [Eval.releaseShared] using released + obtain ⟨storeEq, fuelEq⟩ := + Lower.Sim.releaseSharedWork_success_unique localWork actualWork + subst localStore + have fundedEq : localFuel + remaining = machine.heapFuel := by + simpa using fuelEq + obtain ⟨_fundedState, nextState, targetStep⟩ := + stepForSuffix remaining + have machineEq : ({ machine with heapFuel := localFuel + remaining } : + Machine) = machine := by + cases machine + simp_all + rw [machineEq] at targetStep + exact ⟨nextState, targetStep⟩ + | pure sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | alloc sourceWorld sourceCid sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | reuse sourceAtom sourceCid sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | free sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | dup sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | dropU sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | fetch sourceAtom sourceField => simp [Lower.OperationSyntax] at operationSyntax + | call sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | callSelf sourceArguments => simp [Lower.OperationSyntax] at operationSyntax + | papp sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | apply sourceFunction sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | extern sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + +/-- Recover the exact retained source return and translated operand from a +concrete target return coordinate. -/ +theorem currentReturn + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {block : Block} {targetAtom : Atom} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc = block.instructions.size) + (terminator : block.terminator = .ret targetAtom) : + ∃ (site : Lower.SourceSite) (blockId : BlockId) + (input : Lower.Sim.EnvMap) (entryValueCount : Nat) + (sourceAtom : IxIR1.Atom) (generated : Block), + state.trace = .ret site blockId input entryValueCount sourceAtom + targetAtom generated ∧ + Lower.InputMap.translateAtom input sourceAtom = some targetAtom := by + have exactBlock := state.traceState.target.blockAt state.descendant + have blockEq : block = state.trace.headBlock.2 := + Option.some.inj (blockAt.symm.trans exactBlock) + generalize traceEq : state.trace = trace at blockEq + cases trace with + | ret site blockId input entryValueCount sourceAtom actualTarget generated => + simp only [Lower.CodeTrace.headBlock] at blockEq terminator + have descendant : state.functionTrace.root.Descendant + (.ret site blockId input entryValueCount sourceAtom actualTarget + generated) := by + rw [← traceEq] + exact state.descendant + obtain ⟨translated, generatedTerminator⟩ := + Lower.CodeTrace.retSyntax_of_match + (state.functionTrace.descendantSyntaxMatches descendant) + rw [blockEq, generatedTerminator] at terminator + have targetEq : actualTarget = targetAtom := by injection terminator + subst actualTarget + exact ⟨site, blockId, input, entryValueCount, sourceAtom, generated, + rfl, translated⟩ + | tailCall site blockId input entryValueCount address sourceArguments + generated => + simp only [Lower.CodeTrace.headBlock] at blockEq terminator + have descendant : state.functionTrace.root.Descendant + (.tailCall site blockId input entryValueCount address sourceArguments + generated) := by + rw [← traceEq] + exact state.descendant + obtain ⟨actualArguments, _translated, generatedTerminator⟩ := + Lower.CodeTrace.tailCallSyntax_of_match + (state.functionTrace.descendantSyntaxMatches descendant) + rw [blockEq, generatedTerminator] at terminator + cases terminator + | tailCallSelf site blockId input entryValueCount sourceArguments generated => + simp only [Lower.CodeTrace.headBlock] at blockEq terminator + have descendant : state.functionTrace.root.Descendant + (.tailCallSelf site blockId input entryValueCount sourceArguments + generated) := by + rw [← traceEq] + exact state.descendant + obtain ⟨actualArguments, _translated, generatedTerminator⟩ := + Lower.CodeTrace.tailCallSelfSyntax_of_match + (state.functionTrace.descendantSyntaxMatches descendant) + rw [blockEq, generatedTerminator] at terminator + cases terminator + | letOp site blockId input nextInput entryValueCount operation index + instruction next => + simp only [Lower.CodeTrace.headBlock] at blockEq terminator + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount operation index + instruction next) := by + rw [← traceEq] + exact state.descendant + have statePc := state.traceState.target.pc + rw [traceEq] at statePc + simp only [Lower.CodeTrace.entryPc] at statePc + have instructionAt := + (state.functionTrace.descendantLetOpMatch descendant).1.instructionAt + have instructionBound := + (Array.getElem?_eq_some_iff.mp instructionAt).1 + rw [← blockEq] at instructionBound + omega + | switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children => + simp only [Lower.CodeTrace.headBlock] at blockEq terminator + have descendant : state.functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee + peelNat alternatives targetScrutinee generated outgoing + children) := by + rw [← traceEq] + exact state.descendant + obtain ⟨constructors, natPeel, _translated, generatedTerminator⟩ := + Lower.CodeTrace.switchSyntax_of_match + (state.functionTrace.descendantSyntaxMatches descendant) + rw [blockEq, generatedTerminator] at terminator + cases terminator + +/-- Recover the exact retained source switch, translated scrutinee, and Nat +peel-shape agreement from a concrete target switch coordinate. -/ +theorem currentSwitchValue + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {block : Block} {targetScrutinee : Atom} + {constructors : Array CtorAlt} {natPeel : Option NatPeel} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc = block.instructions.size) + (terminator : block.terminator = + .switchValue targetScrutinee constructors natPeel) : + ∃ (site : Lower.SourceSite) (blockId : BlockId) + (input : Lower.Sim.EnvMap) (entryValueCount : Nat) + (sourceScrutinee : IxIR1.Atom) (peelNat : Bool) + (alternatives : Array IxIR1.Alt) (generated : Block) + (outgoing : List Lower.EdgeTrace) (children : List Lower.CodeTrace), + state.trace = + .switchValue site blockId input entryValueCount sourceScrutinee + peelNat alternatives targetScrutinee generated outgoing children ∧ + Lower.InputMap.translateAtom input sourceScrutinee = + some targetScrutinee ∧ + generated.terminator = + .switchValue targetScrutinee constructors natPeel ∧ + peelNat = natPeel.isSome := by + have exactBlock := state.traceState.target.blockAt state.descendant + have blockEq : block = state.trace.headBlock.2 := + Option.some.inj (blockAt.symm.trans exactBlock) + generalize traceEq : state.trace = trace at blockEq + cases trace with + | ret site blockId input entryValueCount sourceAtom targetAtom generated => + simp only [Lower.CodeTrace.headBlock] at blockEq terminator + have descendant : state.functionTrace.root.Descendant + (.ret site blockId input entryValueCount sourceAtom targetAtom + generated) := by + rw [← traceEq] + exact state.descendant + have emitted := (Lower.CodeTrace.retSyntax_of_match + (state.functionTrace.descendantSyntaxMatches descendant)).2 + rw [blockEq, emitted] at terminator + cases terminator + | tailCall site blockId input entryValueCount address sourceArguments + generated => + simp only [Lower.CodeTrace.headBlock] at blockEq terminator + have descendant : state.functionTrace.root.Descendant + (.tailCall site blockId input entryValueCount address sourceArguments + generated) := by + rw [← traceEq] + exact state.descendant + obtain ⟨actualArguments, _translated, emitted⟩ := + Lower.CodeTrace.tailCallSyntax_of_match + (state.functionTrace.descendantSyntaxMatches descendant) + rw [blockEq, emitted] at terminator + cases terminator + | tailCallSelf site blockId input entryValueCount sourceArguments generated => + simp only [Lower.CodeTrace.headBlock] at blockEq terminator + have descendant : state.functionTrace.root.Descendant + (.tailCallSelf site blockId input entryValueCount sourceArguments + generated) := by + rw [← traceEq] + exact state.descendant + obtain ⟨actualArguments, _translated, emitted⟩ := + Lower.CodeTrace.tailCallSelfSyntax_of_match + (state.functionTrace.descendantSyntaxMatches descendant) + rw [blockEq, emitted] at terminator + cases terminator + | letOp site blockId input nextInput entryValueCount operation index + instruction next => + simp only [Lower.CodeTrace.headBlock] at blockEq terminator + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount operation index + instruction next) := by + rw [← traceEq] + exact state.descendant + have statePc := state.traceState.target.pc + rw [traceEq] at statePc + simp only [Lower.CodeTrace.entryPc] at statePc + have instructionAt := + (state.functionTrace.descendantLetOpMatch descendant).1.instructionAt + have instructionBound := + (Array.getElem?_eq_some_iff.mp instructionAt).1 + rw [← blockEq] at instructionBound + omega + | switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives actualScrutinee generated outgoing children => + simp only [Lower.CodeTrace.headBlock] at blockEq terminator + have descendant : state.functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee + peelNat alternatives actualScrutinee generated outgoing + children) := by + rw [← traceEq] + exact state.descendant + obtain ⟨actualConstructors, actualNatPeel, translated, emitted⟩ := + Lower.CodeTrace.switchSyntax_of_match + (state.functionTrace.descendantSyntaxMatches descendant) + rw [blockEq, emitted] at terminator + have scrutineeEq : actualScrutinee = targetScrutinee := by + injection terminator + have constructorsEq : actualConstructors = constructors := by + injection terminator + have natPeelEq : actualNatPeel = natPeel := by + injection terminator + subst actualScrutinee + subst actualConstructors + subst actualNatPeel + have recursiveMatched := + state.functionTrace.descendantSwitchBranchesMatch descendant + have localMatched := + Lower.CodeTrace.switchNodeBranchesMatch_of_match recursiveMatched + obtain ⟨_shapeScrutinee, _shapeConstructors, _shapeNatPeel, + shapeTerminator, _outgoingLength, _childrenLength, peelShape⟩ := + Lower.switchBranchShape_of_match localMatched + have peelEq : peelNat = natPeel.isSome := by + have shapeEq := shapeTerminator.symm.trans emitted + injection shapeEq with _ _ natEq + simpa [natEq] using peelShape + exact ⟨site, blockId, input, entryValueCount, sourceScrutinee, + peelNat, alternatives, generated, outgoing, children, rfl, + translated, emitted, peelEq⟩ + +/-- Recover the exact retained addressed-tail-call node and its translated +source arguments from a concrete terminator coordinate. -/ +theorem currentTailCall + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {block : Block} {targetAddress : Ixon.Address} + {targetArguments : Array Atom} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc = block.instructions.size) + (terminator : block.terminator = + .tailCall targetAddress targetArguments) : + ∃ (site : Lower.SourceSite) (blockId : BlockId) + (input : Lower.Sim.EnvMap) (entryValueCount : Nat) + (sourceAddress : Ixon.Address) + (sourceArguments : Array IxIR1.Atom) (generated : Block), + state.trace = .tailCall site blockId input entryValueCount + sourceAddress sourceArguments generated ∧ + sourceAddress = targetAddress ∧ + Lower.InputMap.translateAtoms input sourceArguments = + some targetArguments := by + have exactBlock := state.traceState.target.blockAt state.descendant + have blockEq : block = state.trace.headBlock.2 := + Option.some.inj (blockAt.symm.trans exactBlock) + generalize traceEq : state.trace = trace at blockEq + cases trace with + | ret site blockId input entryValueCount sourceAtom targetAtom generated => + simp only [Lower.CodeTrace.headBlock] at blockEq terminator + have descendant : state.functionTrace.root.Descendant + (.ret site blockId input entryValueCount sourceAtom targetAtom + generated) := by + rw [← traceEq] + exact state.descendant + have syntaxFacts := Lower.CodeTrace.retSyntax_of_match + (state.functionTrace.descendantSyntaxMatches descendant) + rw [blockEq, syntaxFacts.2] at terminator + cases terminator + | tailCall site blockId input entryValueCount sourceAddress sourceArguments + generated => + simp only [Lower.CodeTrace.headBlock] at blockEq terminator + have descendant : state.functionTrace.root.Descendant + (.tailCall site blockId input entryValueCount sourceAddress + sourceArguments generated) := by + rw [← traceEq] + exact state.descendant + obtain ⟨actualArguments, translated, generatedTerminator⟩ := + Lower.CodeTrace.tailCallSyntax_of_match + (state.functionTrace.descendantSyntaxMatches descendant) + rw [blockEq, generatedTerminator] at terminator + have addressEq : sourceAddress = targetAddress := by + injection terminator + have argumentsEq : actualArguments = targetArguments := by + injection terminator + subst actualArguments + exact ⟨site, blockId, input, entryValueCount, sourceAddress, + sourceArguments, generated, rfl, addressEq, translated⟩ + | tailCallSelf site blockId input entryValueCount sourceArguments generated => + simp only [Lower.CodeTrace.headBlock] at blockEq terminator + have descendant : state.functionTrace.root.Descendant + (.tailCallSelf site blockId input entryValueCount sourceArguments + generated) := by + rw [← traceEq] + exact state.descendant + obtain ⟨actualArguments, _translated, generatedTerminator⟩ := + Lower.CodeTrace.tailCallSelfSyntax_of_match + (state.functionTrace.descendantSyntaxMatches descendant) + rw [blockEq, generatedTerminator] at terminator + cases terminator + | letOp site blockId input nextInput entryValueCount operation index + instruction next => + simp only [Lower.CodeTrace.headBlock] at blockEq terminator + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount operation index + instruction next) := by + rw [← traceEq] + exact state.descendant + have statePc := state.traceState.target.pc + rw [traceEq] at statePc + simp only [Lower.CodeTrace.entryPc] at statePc + have instructionAt := + (state.functionTrace.descendantLetOpMatch descendant).1.instructionAt + have instructionBound := + (Array.getElem?_eq_some_iff.mp instructionAt).1 + rw [← blockEq] at instructionBound + omega + | switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children => + simp only [Lower.CodeTrace.headBlock] at blockEq terminator + have descendant : state.functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee + peelNat alternatives targetScrutinee generated outgoing + children) := by + rw [← traceEq] + exact state.descendant + obtain ⟨constructors, natPeel, _translated, generatedTerminator⟩ := + Lower.CodeTrace.switchSyntax_of_match + (state.functionTrace.descendantSyntaxMatches descendant) + rw [blockEq, generatedTerminator] at terminator + cases terminator + +/-- Recover the exact retained self-tail-call node and its translated source +arguments from a concrete terminator coordinate. -/ +theorem currentTailCallSelf + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {block : Block} {targetArguments : Array Atom} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc = block.instructions.size) + (terminator : block.terminator = .tailCallSelf targetArguments) : + ∃ (site : Lower.SourceSite) (blockId : BlockId) + (input : Lower.Sim.EnvMap) (entryValueCount : Nat) + (sourceArguments : Array IxIR1.Atom) (generated : Block), + state.trace = .tailCallSelf site blockId input entryValueCount + sourceArguments generated ∧ + Lower.InputMap.translateAtoms input sourceArguments = + some targetArguments := by + have exactBlock := state.traceState.target.blockAt state.descendant + have blockEq : block = state.trace.headBlock.2 := + Option.some.inj (blockAt.symm.trans exactBlock) + generalize traceEq : state.trace = trace at blockEq + cases trace with + | ret site blockId input entryValueCount sourceAtom targetAtom generated => + simp only [Lower.CodeTrace.headBlock] at blockEq terminator + have descendant : state.functionTrace.root.Descendant + (.ret site blockId input entryValueCount sourceAtom targetAtom + generated) := by + rw [← traceEq] + exact state.descendant + have syntaxFacts := Lower.CodeTrace.retSyntax_of_match + (state.functionTrace.descendantSyntaxMatches descendant) + rw [blockEq, syntaxFacts.2] at terminator + cases terminator + | tailCall site blockId input entryValueCount address sourceArguments + generated => + simp only [Lower.CodeTrace.headBlock] at blockEq terminator + have descendant : state.functionTrace.root.Descendant + (.tailCall site blockId input entryValueCount address sourceArguments + generated) := by + rw [← traceEq] + exact state.descendant + obtain ⟨target, _translated, generatedTerminator⟩ := + Lower.CodeTrace.tailCallSyntax_of_match + (state.functionTrace.descendantSyntaxMatches descendant) + rw [blockEq, generatedTerminator] at terminator + cases terminator + | tailCallSelf site blockId input entryValueCount sourceArguments generated => + simp only [Lower.CodeTrace.headBlock] at blockEq terminator + have descendant : state.functionTrace.root.Descendant + (.tailCallSelf site blockId input entryValueCount sourceArguments + generated) := by + rw [← traceEq] + exact state.descendant + obtain ⟨actualArguments, translated, generatedTerminator⟩ := + Lower.CodeTrace.tailCallSelfSyntax_of_match + (state.functionTrace.descendantSyntaxMatches descendant) + rw [blockEq, generatedTerminator] at terminator + have argumentsEq : actualArguments = targetArguments := by + injection terminator + subst actualArguments + exact ⟨site, blockId, input, entryValueCount, sourceArguments, + generated, rfl, translated⟩ + | letOp site blockId input nextInput entryValueCount operation index + instruction next => + simp only [Lower.CodeTrace.headBlock] at blockEq terminator + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount operation index + instruction next) := by + rw [← traceEq] + exact state.descendant + have statePc := state.traceState.target.pc + rw [traceEq] at statePc + simp only [Lower.CodeTrace.entryPc] at statePc + have instructionAt := + (state.functionTrace.descendantLetOpMatch descendant).1.instructionAt + have instructionBound := + (Array.getElem?_eq_some_iff.mp instructionAt).1 + rw [← blockEq] at instructionBound + omega + | switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children => + simp only [Lower.CodeTrace.headBlock] at blockEq terminator + have descendant : state.functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee + peelNat alternatives targetScrutinee generated outgoing + children) := by + rw [← traceEq] + exact state.descendant + obtain ⟨constructors, natPeel, _translated, generatedTerminator⟩ := + Lower.CodeTrace.switchSyntax_of_match + (state.functionTrace.descendantSyntaxMatches descendant) + rw [blockEq, generatedTerminator] at terminator + cases terminator + +/-- Recover a terminal source allocation and its immediately following +self-tail trace from the last concrete target instruction. This packages the +structural facts needed by allocation ownership and the focused no-borrow +audit without requiring callers to reconstruct the recursive trace shape. -/ +theorem currentTerminalAllocation + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {block : Block} {targetWorld : Ixon.Owned} {targetCid : CtorId} + {targetArguments tailArguments : Array Atom} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (last : state.frame.pc + 1 = block.instructions.size) + (instruction : block.instructions[state.frame.pc] = + .alloc targetWorld targetCid targetArguments) + (terminator : block.terminator = .tailCallSelf tailArguments) : + ∃ (site : Lower.SourceSite) (blockId : BlockId) + (input nextInput : Lower.Sim.EnvMap) (entryValueCount index : Nat) + (sourceWorld : Ixon.Owned) (sourceCid : IxIR1.CtorId) + (sourceArguments : Array IxIR1.Atom) + (tailSite : Lower.SourceSite) (tailBlockId : BlockId) + (tailInput : Lower.Sim.EnvMap) (tailEntryValueCount : Nat) + (tailSourceArguments : Array IxIR1.Atom) (generated : Block), + state.trace = + .letOp site blockId input nextInput entryValueCount + (.alloc sourceWorld sourceCid sourceArguments) index + (.alloc targetWorld targetCid targetArguments) + (.tailCallSelf tailSite tailBlockId tailInput tailEntryValueCount + tailSourceArguments generated) ∧ + sourceWorld = targetWorld ∧ + Lower.InputMap.translateAtoms input sourceArguments = + some targetArguments ∧ + Lower.InputMap.translateAtoms tailInput tailSourceArguments = + some tailArguments := by + have pcBound : state.frame.pc < block.instructions.size := by omega + obtain ⟨site, blockId, input, nextInput, entryValueCount, operation, + index, next, traceEq, operationSyntax⟩ := + state.currentLetOp blockAt pcBound instruction + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount operation index + (.alloc targetWorld targetCid targetArguments) next) := by + rw [← traceEq] + exact state.descendant + have letMatch := state.functionTrace.descendantLetOpMatch descendant + have nextSyntax := + (Lower.CodeTrace.letOpSyntax_of_match + (state.functionTrace.descendantSyntaxMatches descendant)).2 + have exactBlock := state.traceState.target.blockAt state.descendant + have blockEq : block = next.headBlock.2 := by + rw [traceEq] at exactBlock + exact Option.some.inj (blockAt.symm.trans exactBlock) + have statePc := state.traceState.target.pc + rw [traceEq] at statePc + simp only [Lower.CodeTrace.entryPc] at statePc + have nextTerminalPc : next.entryPc = next.headBlock.2.instructions.size := by + calc + next.entryPc = index + 1 := letMatch.1.nextPc + _ = state.frame.pc + 1 := by rw [statePc] + _ = block.instructions.size := last + _ = next.headBlock.2.instructions.size := by rw [blockEq] + have nextTerminator : next.headBlock.2.terminator = + .tailCallSelf tailArguments := by + rw [← blockEq] + exact terminator + obtain ⟨tailSite, tailBlockId, tailInput, tailEntryValueCount, + tailSourceArguments, generated, nextEq, tailTranslated⟩ := + next.tailCallSelf_of_terminal nextSyntax letMatch.1.nextInstructions + nextTerminalPc nextTerminator + subst next + cases operation with + | alloc sourceWorld sourceCid sourceArguments => + change sourceWorld = targetWorld ∧ sourceCid = targetCid ∧ + Lower.InputMap.translateAtoms input sourceArguments = + some targetArguments at operationSyntax + obtain ⟨rfl, rfl, translated⟩ := operationSyntax + exact ⟨site, blockId, input, nextInput, entryValueCount, index, + sourceWorld, sourceCid, sourceArguments, tailSite, tailBlockId, + tailInput, tailEntryValueCount, tailSourceArguments, generated, + traceEq, rfl, translated, tailTranslated⟩ + | pure sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | reuse sourceAtom sourceCid sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | free sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | dup sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | drop sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | dropU sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | fetch sourceAtom sourceField => + simp [Lower.OperationSyntax] at operationSyntax + | call sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | callSelf sourceArguments => simp [Lower.OperationSyntax] at operationSyntax + | papp sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | apply sourceFunction sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | extern sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + +/-- Reconstruct a checked ordinary allocation from the concrete target +instruction, reflecting its operand vector back through the compiler's exact +environment map. -/ +theorem stepAllocOfTarget + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + (contextSchemas : context.schemas = + attached.target.artifact.validationContext.schemas) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {block : Block} {world : Owned} {cid : CtorId} + {arguments : Array Atom} {schema : CtorSchema} {values : Array RVal} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc < block.instructions.size) + (instruction : block.instructions[state.frame.pc] = + .alloc world cid arguments) + (schemaAt : context.schemas world cid = some schema) + (resolved : Eval.resolveAtoms state.frame.values arguments = .ok values) : + let node : IxIR1.Node := .ctorN cid values + let allocation := machine.store.allocNode world node + let nextFrame : Frame := + { state.frame with + pc := state.frame.pc + 1 + values := state.frame.values.push (.loc allocation.2) } + let nextMachine : Machine := + { machine with + store := allocation.1 + control := .running nextFrame state.stack } + ∃ _ : CompilerRunningState attached nextMachine, + Eval.Step context interpretation machine nextMachine ∧ + (world = .unique → + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext nextMachine + rewritten) := by + dsimp only + obtain ⟨site, blockId, input, nextInput, entryValueCount, operation, + index, next, traceEq, operationSyntax⟩ := + state.currentLetOp blockAt pc instruction + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount operation index + (.alloc world cid arguments) next) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + cases operation with + | alloc sourceWorld sourceCid sourceArguments => + change sourceWorld = world ∧ sourceCid = cid ∧ + Lower.InputMap.translateAtoms input sourceArguments = some arguments + at operationSyntax + obtain ⟨worldEq, cidEq, translated⟩ := operationSyntax + subst sourceWorld + subst sourceCid + have atoms := Lower.Sim.atomsRel_of_translateAtoms translated + have sourceCount : state.source.length = input.size := by + simpa [Lower.CodeTrace.sourceInputMap] using + traceState.target.sourceCount + have sourceResolved : + IxIR1.resolveAtoms state.source sourceArguments = + .ok values.toList := + Lower.Sim.resolveAtoms_of_envRel_target + traceState.target.environments sourceCount atoms resolved + obtain ⟨nextState, _sourceRun, targetStep, acceptedEntry⟩ := + state.stepAlloc (sourceFuel := sourceFuel) (context := context) + (interpretation := interpretation) contextSchemas traceEq + sourceDeclarations sourceResolved schemaAt + have locationEq : + (state.sourceStore.allocNode world (.ctorN cid values)).2 = + (machine.store.allocNode world (.ctorN cid values)).2 := by + exact (state.stores.alloc_location world (.ctorN cid values)).symm + rw [locationEq] at nextState targetStep acceptedEntry + exact ⟨by simpa using nextState, by simpa using targetStep, + by simpa using acceptedEntry⟩ + | pure sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | reuse sourceAtom sourceCid sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | free sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | dup sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | drop sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | dropU sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | fetch sourceAtom sourceField => simp [Lower.OperationSyntax] at operationSyntax + | call sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | callSelf sourceArguments => simp [Lower.OperationSyntax] at operationSyntax + | papp sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | apply sourceFunction sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | extern sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + +/-- Reconstruct a checked function partial application from the concrete +target instruction. Target declaration lookup selects the exact retained +source callee, while the checked environment map reflects the captured +arguments back to the source evaluator. -/ +theorem stepPappOfTarget + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (targetDeclarations : context.declarations = + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas).declarations) + {block : Block} {address : Ixon.Address} {arguments : Array Atom} + {values : Array RVal} {definition : Function} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc < block.instructions.size) + (instruction : block.instructions[state.frame.pc] = + .papp address arguments) + (targetDeclaration : context.declarations address = some (.fn definition)) + (papSafe : definition.signature.papSafe = true) + (resolved : Eval.resolveAtoms state.frame.values arguments = .ok values) + (under : values.size < definition.signature.params.size) : + let allocation := machine.store.allocNode .shared + (.papN address definition.signature.params.size values) + let nextFrame : Frame := + { state.frame with + pc := state.frame.pc + 1 + values := state.frame.values.push (.loc allocation.2) } + let nextMachine : Machine := + { machine with + store := allocation.1 + control := .running nextFrame state.stack } + ∃ _ : CompilerRunningState attached nextMachine, + Eval.Step context interpretation machine nextMachine ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext nextMachine + rewritten := by + dsimp only + obtain ⟨site, blockId, input, nextInput, entryValueCount, operation, + index, next, traceEq, operationSyntax⟩ := + state.currentLetOp blockAt pc instruction + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount operation index + (.papp address arguments) next) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + cases operation with + | papp sourceAddress sourceArguments => + change sourceAddress = address ∧ + Lower.InputMap.translateAtoms input sourceArguments = some arguments + at operationSyntax + obtain ⟨rfl, translated⟩ := operationSyntax + obtain ⟨sourceDefinition, calleeTrace, _calleeMember, calleeMatch, + sourceDeclaration⟩ := + attached.functionTrace_of_target_declaration sourceDeclarations + targetDeclarations targetDeclaration + have sourceCount : state.source.length = input.size := by + simpa [Lower.CodeTrace.sourceInputMap] using + traceState.target.sourceCount + have atoms := Lower.Sim.atomsRel_of_translateAtoms translated + have sourceResolved : + IxIR1.resolveAtoms state.source sourceArguments = .ok values.toList := + Lower.Sim.resolveAtoms_of_envRel_target + traceState.target.environments sourceCount atoms resolved + have arity : definition.signature.params.size = + sourceDefinition.arity := by + calc + definition.signature.params.size = + calleeTrace.generated.signature.params.size := by + rw [calleeMatch.generated] + _ = calleeTrace.source.arity := calleeTrace.sourceArity + _ = sourceDefinition.arity := + congrArg IxIR1.FnDef.arity calleeMatch.source + have sourceUnder : values.toList.length < sourceDefinition.arity := by + simpa [arity] using under + obtain ⟨nextState, _sourceRun, targetStep, acceptedEntry⟩ := + state.stepPapp (sourceFuel := sourceFuel) (context := context) + (interpretation := interpretation) traceEq sourceDeclarations + sourceResolved sourceDeclaration targetDeclaration arity papSafe + sourceUnder + have locationEq : + (state.sourceStore.allocNode .shared + (.papN sourceAddress sourceDefinition.arity values)).2 = + (machine.store.allocNode .shared + (.papN sourceAddress sourceDefinition.arity values)).2 := + (state.stores.alloc_location .shared + (.papN sourceAddress sourceDefinition.arity values)).symm + rw [locationEq] at nextState targetStep acceptedEntry + exact ⟨by simpa [arity] using nextState, + by simpa [arity] using targetStep, + by simpa [arity] using acceptedEntry⟩ + | pure sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | alloc sourceWorld sourceCid sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | reuse sourceAtom sourceCid sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | free sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | dup sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | drop sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | dropU sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | fetch sourceAtom sourceField => + simp [Lower.OperationSyntax] at operationSyntax + | call sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | callSelf sourceArguments => simp [Lower.OperationSyntax] at operationSyntax + | apply sourceFunction sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | extern sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + +/-- Reflect the concrete function and argument values of a target dynamic +application back through the checked lowering environment. -/ +theorem currentApply + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {machine : Machine} (state : CompilerRunningState attached machine) + {block : Block} {targetFunction : Atom} + {targetArguments : Array Atom} {function : RVal} + {arguments : Array RVal} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc < block.instructions.size) + (instruction : block.instructions[state.frame.pc] = + .apply targetFunction targetArguments) + (functionResolved : Eval.resolveAtom state.frame.values targetFunction = + .ok function) + (argumentsResolved : Eval.resolveAtoms state.frame.values + targetArguments = .ok arguments) : + ∃ (site : Lower.SourceSite) (blockId : BlockId) + (input nextInput : Lower.Sim.EnvMap) (entryValueCount index : Nat) + (sourceFunction : IxIR1.Atom) + (sourceArguments : Array IxIR1.Atom) (next : Lower.CodeTrace), + state.trace = + .letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next ∧ + IxIR1.resolveAtom state.source sourceFunction = .ok function ∧ + IxIR1.resolveAtoms state.source sourceArguments = + .ok arguments.toList := by + obtain ⟨site, blockId, input, nextInput, entryValueCount, operation, + index, next, traceEq, operationSyntax⟩ := + state.currentLetOp blockAt pc instruction + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount operation index + (.apply targetFunction targetArguments) next) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + cases operation with + | apply sourceFunction sourceArguments => + change Lower.InputMap.translateAtom input sourceFunction = + some targetFunction ∧ + Lower.InputMap.translateAtoms input sourceArguments = + some targetArguments at operationSyntax + obtain ⟨functionTranslated, argumentsTranslated⟩ := operationSyntax + have sourceCount : state.source.length = input.size := by + simpa [Lower.CodeTrace.sourceInputMap] using + traceState.target.sourceCount + have sourceFunctionResolved : + IxIR1.resolveAtom state.source sourceFunction = .ok function := + Lower.Sim.resolveAtom_of_envRel_target + traceState.target.environments sourceCount functionTranslated + functionResolved + have atoms := Lower.Sim.atomsRel_of_translateAtoms argumentsTranslated + have sourceArgumentsResolved : + IxIR1.resolveAtoms state.source sourceArguments = + .ok arguments.toList := + Lower.Sim.resolveAtoms_of_envRel_target + traceState.target.environments sourceCount atoms argumentsResolved + exact ⟨site, blockId, input, nextInput, entryValueCount, index, + sourceFunction, sourceArguments, next, traceEq, + sourceFunctionResolved, sourceArgumentsResolved⟩ + | pure sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | alloc sourceWorld sourceCid sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | reuse sourceAtom sourceCid sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | free sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | dup sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | drop sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | dropU sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | fetch sourceAtom sourceField => + simp [Lower.OperationSyntax] at operationSyntax + | call sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | callSelf sourceArguments => simp [Lower.OperationSyntax] at operationSyntax + | papp sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | extern sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + +/-- Focus the exact shared roots consumed at a checked dynamic-application +coordinate. The suffix records the surviving source capabilities and framed +roots, but callers need not inspect it to establish evaluator progress. -/ +theorem applyInputOwnership + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {sourceFunction : IxIR1.Atom} {targetFunction : Atom} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} {next : Lower.CodeTrace} + (traceEq : state.trace = + .letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + {function : RVal} {arguments : List RVal} + (functionResolved : IxIR1.resolveAtom state.source sourceFunction = + .ok function) + (argumentsResolved : IxIR1.resolveAtoms state.source sourceArguments = + .ok arguments) : + ∃ remaining : Array Lower.BindingCap, + IxIR1.Sim.RootOwnership state.sourceStore + (⟨.shared, function⟩ :: IxIR1.Sim.rootsFor .shared arguments ++ + Lower.Sim.rootsForCapabilities remaining.toList state.source ++ + state.frameRoots) := by + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) := by + rw [← traceEq] + exact state.descendant + have ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + state.sourceStore state.source state.frameRoots := by + rw [← traceEq] + exact state.ownership + have nextDescendant : state.functionTrace.root.Descendant next := + .step descendant (by simp [Lower.CodeTrace.children]) + obtain ⟨after, afterMember, afterCoordinate⟩ := + attached.target.position state.member nextDescendant + obtain ⟨before, beforeMember, beforeCoordinate, transition⟩ := + attached.target.applyTransition state.member descendant afterMember + afterCoordinate + unfold Lower.PositionTrace.applyResultMatches at transition + unfold Lower.applyCapabilities? at transition + cases functionConsumed : Lower.consumeCapability? + before.sourceCapabilities input .shared sourceFunction with + | none => simp [functionConsumed] at transition + | some afterFunction => + simp only [functionConsumed, Option.bind_eq_bind, Option.bind_some] + at transition + cases argumentsConsumed : Lower.consumeCapabilitiesList? afterFunction + input .shared sourceArguments.toList with + | none => simp [argumentsConsumed] at transition + | some remaining => + have beforeInvariant : Lower.Sim.SourceOwnershipInvariant + state.sourceStore state.source input + before.sourceCapabilities state.frameRoots := + ownership before beforeMember (by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceBlock, + Lower.CodeTrace.targetPosition, + Lower.CodeTrace.sourceInputMap] using beforeCoordinate) + exact ⟨remaining, beforeInvariant.applyInputOwnership + functionResolved argumentsResolved functionConsumed + argumentsConsumed⟩ + +/-- Checked ownership also makes the common PAP preparation prefix total: +retain every captured shared value, then release the consumed PAP root with +some finite source budget. -/ +theorem applyPapPreparation + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {sourceFunction : IxIR1.Atom} {targetFunction : Atom} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} {next : Lower.CodeTrace} + (traceEq : state.trace = + .letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + {location : Nat} {box : IxIR1.NodeBox} + {address : Ixon.Address} {arity : Nat} {captured : Array RVal} + {arguments : List RVal} + (functionResolved : IxIR1.resolveAtom state.source sourceFunction = + .ok (.loc location)) + (argumentsResolved : IxIR1.resolveAtoms state.source sourceArguments = + .ok arguments) + (sourceGet : state.sourceStore.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (sourceContext : IxIR1.Ctx) : + ∃ sourceFuel sourceRetained sourceReleased, + IxIR1.dupVals state.sourceStore captured.toList = .ok sourceRetained ∧ + IxIR1.dropVal sourceContext sourceFuel sourceRetained + (.loc location) = .ok sourceReleased := by + obtain ⟨remaining, inputOwnership⟩ := + state.applyInputOwnership traceEq functionResolved argumentsResolved + have capturedWorlds : ∀ value ∈ captured.toList, + IxIR1.Sim.HasWorld state.sourceStore .shared value := by + intro value member + have world := inputOwnership.edges_world sourceGet value (by + rw [node] + simpa [IxIR1.Sim.nodeChildren] using member) + simpa [shared] using world + obtain ⟨sourceRetained, sourceRetain⟩ := + IxIR1.LowerSim.dupVals_progress_of_hasWorld capturedWorlds + have retainedOwnership : IxIR1.Sim.RootOwnership sourceRetained + (IxIR1.Sim.rootsFor .shared captured.toList ++ + ⟨.shared, .loc location⟩ :: + IxIR1.Sim.rootsFor .shared arguments ++ + Lower.Sim.rootsForCapabilities remaining.toList state.source ++ + state.frameRoots) := by + simpa [List.append_assoc] using + IxIR1.Sim.dupVals_borrowedMany_preserves inputOwnership + capturedWorlds sourceRetain + have papFirst : IxIR1.Sim.RootOwnership sourceRetained + (⟨.shared, .loc location⟩ :: + IxIR1.Sim.rootsFor .shared captured.toList ++ + IxIR1.Sim.rootsFor .shared arguments ++ + Lower.Sim.rootsForCapabilities remaining.toList state.source ++ + state.frameRoots) := by + apply retainedOwnership.perm + simp [List.append_assoc] + obtain ⟨sourceFuel, sourceReleased, sourceRelease, + _releasedOwnership⟩ := + IxIR1.dropVal_progress (ctx := sourceContext) papFirst + exact ⟨sourceFuel, sourceRetained, sourceReleased, sourceRetain, + sourceRelease⟩ + +/-- Advance a compiler running state across erased dynamic application. +Releasing the residual shared arguments may consume an input-dependent heap +budget, so the transition exposes that budget additively and carries any +independently chosen suffix fuel through the single dispatcher step. -/ +theorem stepApplyErased + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceFunction : IxIR1.Atom} {targetFunction : Atom} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (traceEq : state.trace = + .letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {sourceReleased : IxIR1.Store} {values : List RVal} + (functionResolved : + IxIR1.resolveAtom state.source sourceFunction = .ok .erased) + (argumentsResolved : + IxIR1.resolveAtoms state.source sourceArguments = .ok values) + (sourceRelease : IxIR1.dropMany sourceContext sourceFuel + state.sourceStore values = .ok sourceReleased) : + ∃ localFuel targetStore, + IxIR1.runOp sourceContext (sourceFuel + 2) + state.functionTrace.source state.sourceStore state.source + (.apply sourceFunction sourceArguments) = + .ok (sourceReleased, .erased) ∧ + Eval.releaseSharedWork localFuel machine.store values = + .ok (targetStore, 0) ∧ + ∀ suffixFuel, + let fundedMachine : Machine := + { machine with heapFuel := localFuel + suffixFuel } + let nextFrame : Frame := + { state.frame with + pc := state.frame.pc + 1 + values := state.frame.values.push .erased } + let nextMachine : Machine := + { store := targetStore + heapFuel := suffixFuel + control := .running nextFrame state.stack } + ∃ _ : CompilerRunningState attached fundedMachine, + ∃ _ : CompilerRunningState attached nextMachine, + Eval.Step context interpretation fundedMachine nextMachine ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext nextMachine + rewritten := by + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) := by + rw [← traceEq] + exact state.descendant + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + state.sourceStore state.source state.frameRoots := by + rw [← traceEq] + exact state.ownership + have sourceRun : IxIR1.runOp sourceContext (sourceFuel + 2) + state.functionTrace.source state.sourceStore state.source + (.apply sourceFunction sourceArguments) = + .ok (sourceReleased, .erased) := by + rw [IxIR1.runOp.eq_def] + dsimp only + rw [functionResolved] + simp only [bind, Except.bind] + rw [argumentsResolved] + simp only + rw [IxIR1.applyGo.eq_def] + dsimp only + rw [sourceRelease] + rfl + obtain ⟨localFuel, targetStore, targetRelease, nextStores, _⟩ := + Lower.Sim.dropMany_simulates_releaseSharedWork + state.runtime.positiveSharedRC state.stores sourceRelease + have nextRuntime : Lower.Sim.SourceRuntimeInvariant sourceReleased + (.erased :: state.source) := + state.runtime.runOp (IxIR1.NoReuse.dropMany_reuses sourceRelease) + sourceRun + have nextOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next sourceReleased + (.erased :: state.source) state.frameRoots := + Lower.Sim.SourceOwnershipAt.applyFrom (checked := attached.target) + state.member descendant ownership + (attached.applyOwnershipPreservesFrom_sourceStoreImage_of_declarations + sourceDeclarations state.image) sourceRun + have nextImage : attached.SourceStoreImage sourceReleased := + attached.runOp_preservesSourceStoreImage sourceDeclarations state.member + descendant traceState state.image sourceRun + have nextDescendant : state.functionTrace.root.Descendant next := + .step descendant (by simp [Lower.CodeTrace.children]) + refine ⟨localFuel, targetStore, sourceRun, targetRelease, ?_⟩ + intro suffixFuel + dsimp only + let fundedMachine : Machine := + { machine with heapFuel := localFuel + suffixFuel } + let nextFrame : Frame := + { state.frame with + pc := state.frame.pc + 1 + values := state.frame.values.push .erased } + let nextMachine : Machine := + { store := targetStore + heapFuel := suffixFuel + control := .running nextFrame state.stack } + have fundedState : CompilerRunningState attached fundedMachine := + withHeapFuel state (localFuel + suffixFuel) + have fundedControl : fundedMachine.control = + .running state.frame state.stack := by + simpa [fundedMachine] using state.control + have fundedRelease := Lower.Sim.releaseSharedWork_add_suffix + (suffix := suffixFuel) targetRelease + have transferred : Eval.ApplyTransfer context interpretation + fundedMachine.store fundedMachine.heapFuel .erased values.toArray + { state.frame with pc := state.frame.pc + 1 } state.stack nextMachine := by + simpa [fundedMachine, nextMachine, nextFrame] using + (Eval.ApplyTransfer.erased + (context := context) (interpretation := interpretation) + (resume := { state.frame with pc := state.frame.pc + 1 }) + (stack := state.stack) (by simpa using fundedRelease)) + obtain ⟨targetStep, nextTraceState⟩ := + attached.simulate_traced_apply_transfer_state + (machine := fundedMachine) (target := nextMachine) state.member + descendant traceState sourceDeclarations functionResolved + argumentsResolved sourceRun state.noCredits fundedControl transferred + have nextState : CompilerRunningState attached nextMachine := + { functionTrace := state.functionTrace + trace := next + sourceStore := sourceReleased + source := .erased :: state.source + frameRoots := state.frameRoots + frame := nextFrame + stack := state.stack + member := state.member + descendant := nextDescendant + traceState := by simpa [nextFrame] using nextTraceState + stores := by simpa [nextMachine] using nextStores + runtime := nextRuntime + ownership := nextOwnership + stackRoots := state.stackRoots + callStack := state.callStack + history := by + apply state.historyStepOp traceEq + rw [IxIR1.runOp_apply_erased_ctx_eq sourceContext + attached.simulationSourceContext _ _ _ _ _ _ functionResolved] + exact sourceRun + image := nextImage + control := by rfl + noCredits := by simpa [nextFrame] using state.noCredits } + obtain ⟨currentBlockAt, _currentPcBound, applyAt⟩ := + traceState.target.instructionAt descendant + have nextBlockAt : nextFrame.definition.blocks[nextFrame.block]? = + some next.headBlock.2 := by + simpa [nextFrame] using currentBlockAt + exact ⟨fundedState, nextState, by + simpa [fundedMachine, nextMachine] using targetStep, + fun _rewritten => StableLiveAcceptedEntry.ofApplyResume rfl nextBlockAt + (by simpa [nextFrame] using applyAt)⟩ + +/-- Reconstruct erased dynamic application from its concrete target work +result. Checked input ownership makes the source argument release total; +work-list uniqueness then recovers the exact residual target budget. -/ +theorem stepApplyErasedOfTarget + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {block : Block} {targetFunction : Atom} + {targetArguments : Array Atom} {arguments : Array RVal} + {targetStore : Store} {remainingFuel : Nat} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc < block.instructions.size) + (instruction : block.instructions[state.frame.pc] = + .apply targetFunction targetArguments) + (functionResolved : Eval.resolveAtom state.frame.values targetFunction = + .ok .erased) + (argumentsResolved : Eval.resolveAtoms state.frame.values + targetArguments = .ok arguments) + (released : Eval.releaseSharedWork machine.heapFuel machine.store + arguments.toList = .ok (targetStore, remainingFuel)) : + let nextFrame : Frame := + { state.frame with + pc := state.frame.pc + 1 + values := state.frame.values.push .erased } + let nextMachine : Machine := + { store := targetStore + heapFuel := remainingFuel + control := .running nextFrame state.stack } + ∃ _ : CompilerRunningState attached nextMachine, + Eval.Step context interpretation machine nextMachine ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext nextMachine + rewritten := by + dsimp only + obtain ⟨site, blockId, input, nextInput, entryValueCount, index, + sourceFunction, sourceArguments, next, traceEq, + sourceFunctionResolved, sourceArgumentsResolved⟩ := + state.currentApply blockAt pc instruction functionResolved + argumentsResolved + obtain ⟨remaining, inputOwnership⟩ := + state.applyInputOwnership traceEq sourceFunctionResolved + sourceArgumentsResolved + have argumentOwnership : IxIR1.Sim.RootOwnership state.sourceStore + (IxIR1.Sim.rootsFor .shared arguments.toList ++ + Lower.Sim.rootsForCapabilities remaining.toList state.source ++ + state.frameRoots) := by + exact inputOwnership.dropNoLocation rfl + obtain ⟨sourceFuel, sourceReleased, sourceRelease, + _releasedOwnership⟩ := + IxIR1.dropMany_progress (ctx := sourceContext) + (values := arguments.toList) + (rest := Lower.Sim.rootsForCapabilities remaining.toList state.source ++ + state.frameRoots) + (by simpa [List.append_assoc] using argumentOwnership) + obtain ⟨localFuel, localStore, _sourceRun, localRelease, + stepForSuffix⟩ := + state.stepApplyErased (context := context) + (interpretation := interpretation) traceEq sourceDeclarations + sourceFunctionResolved sourceArgumentsResolved sourceRelease + obtain ⟨_storeEq, fuelEq⟩ := + Lower.Sim.releaseSharedWork_success_unique localRelease released + have fundedEq : localFuel + remainingFuel = machine.heapFuel := by + simpa using fuelEq + obtain ⟨_fundedState, nextState, generatedStep, acceptedEntry⟩ := + stepForSuffix remainingFuel + have fundedMachineEq : + ({ machine with heapFuel := localFuel + remainingFuel } : Machine) = + machine := by + cases machine + simp_all + rw [fundedMachineEq] at generatedStep + have concreteTransfer : Eval.ApplyTransfer context interpretation + machine.store machine.heapFuel .erased arguments + { state.frame with pc := state.frame.pc + 1 } state.stack + { store := targetStore + heapFuel := remainingFuel + control := .running + { state.frame with + pc := state.frame.pc + 1 + values := state.frame.values.push .erased } + state.stack } := + Eval.ApplyTransfer.erased released + have concreteStep : Eval.Step context interpretation machine + { store := targetStore + heapFuel := remainingFuel + control := .running + { state.frame with + pc := state.frame.pc + 1 + values := state.frame.values.push .erased } + state.stack } := + Eval.Step.applyCleared state.control blockAt pc instruction + (by simp [Eval.NoLiveCredits, state.noCredits]) functionResolved + argumentsResolved concreteTransfer + have targetEq := generatedStep.deterministic concreteStep + rw [targetEq] at nextState generatedStep acceptedEntry + exact ⟨nextState, generatedStep, acceptedEntry⟩ + +/-- A compiler running state from the validator-gated attachment cannot be +positioned at a source extern operation: that boundary rejects externs before +IxIR₂ lowering. This closes the apparent extern successor case by +contradiction rather than by assuming an oracle contract. -/ +theorem externImpossible + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} {sourceAddress targetAddress : Ixon.Address} + {sourceArguments : Array IxIR1.Atom} {targetArguments : Array Atom} + (traceEq : state.trace = + .letOp site blockId input nextInput entryValueCount + (.extern sourceAddress sourceArguments) index + (.extern targetAddress targetArguments) next) : False := by + apply attached.sourceExtern_impossible state.member + rw [← traceEq] + exact state.descendant + +/-- Advance a compiler running state across an under-saturated dynamic PAP +application. The dispatcher retains the captured values, releases the old PAP, +allocates the extended PAP, and preserves an arbitrary suffix heap budget. -/ +theorem stepApplyPapUnder + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceFunction : IxIR1.Atom} {targetFunction : Atom} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (traceEq : state.trace = + .letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {sourceRetained sourceReleased : IxIR1.Store} + {location : Nat} {box : IxIR1.NodeBox} + {address : Ixon.Address} {arity : Nat} + {captured : Array RVal} {values : List RVal} + (functionResolved : IxIR1.resolveAtom state.source sourceFunction = + .ok (.loc location)) + (argumentsResolved : IxIR1.resolveAtoms state.source sourceArguments = + .ok values) + (sourceGet : state.sourceStore.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (sourceRetain : IxIR1.dupVals state.sourceStore captured.toList = + .ok sourceRetained) + (sourceRelease : IxIR1.dropVal sourceContext sourceFuel sourceRetained + (.loc location) = .ok sourceReleased) + (totalUnder : (captured.toList ++ values).length < arity) : + let pap : IxIR1.Node := + .papN address arity (captured ++ values.toArray) + let sourceAllocation := sourceReleased.allocNode .shared pap + ∃ localFuel targetRetained targetReleased, + IxIR1.runOp sourceContext (sourceFuel + 2) + state.functionTrace.source state.sourceStore state.source + (.apply sourceFunction sourceArguments) = + .ok (sourceAllocation.1, .loc sourceAllocation.2) ∧ + Eval.RetainSharedMany machine.store captured targetRetained ∧ + Eval.releaseSharedWork localFuel targetRetained [.loc location] = + .ok (targetReleased, 0) ∧ + ∀ suffixFuel, + let fundedMachine : Machine := + { machine with heapFuel := localFuel + suffixFuel } + let nextFrame : Frame := + { state.frame with + pc := state.frame.pc + 1 + values := state.frame.values.push (.loc sourceAllocation.2) } + let nextMachine : Machine := + { store := (targetReleased.allocNode .shared pap).1 + heapFuel := suffixFuel + control := .running nextFrame state.stack } + ∃ _ : CompilerRunningState attached fundedMachine, + ∃ _ : CompilerRunningState attached nextMachine, + Eval.Step context interpretation fundedMachine nextMachine ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext nextMachine + rewritten := by + dsimp only + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) := by + rw [← traceEq] + exact state.descendant + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + state.sourceStore state.source state.frameRoots := by + rw [← traceEq] + exact state.ownership + let pap : IxIR1.Node := + .papN address arity (captured ++ values.toArray) + let sourceAllocation := sourceReleased.allocNode .shared pap + obtain ⟨targetRetained, targetReleased, localFuel, targetRetain, + _retainedStores, targetRelease, releasedStores, sourceOperation, _, + nextStores, _⟩ := + attached.simulate_traced_apply_pap_under_state + (sourceFuel := sourceFuel) (context := context) + (interpretation := interpretation) state.member descendant traceState + state.stores state.runtime.positiveSharedRC sourceDeclarations + functionResolved argumentsResolved sourceGet shared node capturedUnder + sourceRetain sourceRelease totalUnder state.noCredits state.control + have sourceRun : IxIR1.runOp sourceContext (sourceFuel + 2) + state.functionTrace.source state.sourceStore state.source + (.apply sourceFunction sourceArguments) = + .ok (sourceAllocation.1, .loc sourceAllocation.2) := by + simpa [sourceAllocation, pap] using sourceOperation + have reuseEq : sourceAllocation.1.reuses = state.sourceStore.reuses := by + change sourceReleased.reuses = state.sourceStore.reuses + exact (IxIR1.NoReuse.dropVal_reuses sourceRelease).trans + (IxIR1.NoReuse.dupVals_reuses sourceRetain) + have nextRuntime : Lower.Sim.SourceRuntimeInvariant sourceAllocation.1 + (.loc sourceAllocation.2 :: state.source) := + state.runtime.runOp reuseEq sourceRun + have nextOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next sourceAllocation.1 + (.loc sourceAllocation.2 :: state.source) state.frameRoots := + Lower.Sim.SourceOwnershipAt.applyFrom (checked := attached.target) + state.member descendant ownership + (attached.applyOwnershipPreservesFrom_sourceStoreImage_of_declarations + sourceDeclarations state.image) sourceRun + have nextImage : attached.SourceStoreImage sourceAllocation.1 := + attached.runOp_preservesSourceStoreImage sourceDeclarations state.member + descendant traceState state.image sourceRun + have nextDescendant : state.functionTrace.root.Descendant next := + .step descendant (by simp [Lower.CodeTrace.children]) + let targetAllocation := targetReleased.allocNode .shared pap + have locationEq : targetAllocation.2 = sourceAllocation.2 := by + exact releasedStores.alloc_location .shared pap + refine ⟨localFuel, targetRetained, targetReleased, sourceRun, + targetRetain, targetRelease, ?_⟩ + intro suffixFuel + let fundedMachine : Machine := + { machine with heapFuel := localFuel + suffixFuel } + let nextFrame : Frame := + { state.frame with + pc := state.frame.pc + 1 + values := state.frame.values.push (.loc sourceAllocation.2) } + let nextMachine : Machine := + { store := targetAllocation.1 + heapFuel := suffixFuel + control := .running nextFrame state.stack } + have fundedState : CompilerRunningState attached fundedMachine := + withHeapFuel state (localFuel + suffixFuel) + have fundedControl : fundedMachine.control = + .running state.frame state.stack := by + simpa [fundedMachine] using state.control + have targetGet : fundedMachine.store.get? location = some box := by + unfold Eval.Store.get? + rw [state.stores.heap] + exact sourceGet + have targetUnder : (captured ++ values.toArray).size < arity := by + simpa using totalUnder + have fundedRelease := Lower.Sim.releaseSharedWork_add_suffix + (suffix := suffixFuel) targetRelease + have transferred := Eval.ApplyTransfer.papUnder + (context := context) (interpretation := interpretation) + (resume := { state.frame with pc := state.frame.pc + 1 }) + (stack := state.stack) targetGet shared node capturedUnder targetRetain + fundedRelease targetUnder + dsimp only at transferred + rw [locationEq] at transferred + have transferred' : Eval.ApplyTransfer context interpretation + fundedMachine.store fundedMachine.heapFuel (.loc location) values.toArray + { state.frame with pc := state.frame.pc + 1 } state.stack nextMachine := by + simpa [fundedMachine, nextMachine, nextFrame, targetAllocation, + sourceAllocation, pap] using transferred + obtain ⟨targetStep, nextTraceState⟩ := + attached.simulate_traced_apply_transfer_state + (machine := fundedMachine) (target := nextMachine) state.member + descendant traceState sourceDeclarations functionResolved + argumentsResolved sourceRun state.noCredits fundedControl transferred' + have nextState : CompilerRunningState attached nextMachine := + { functionTrace := state.functionTrace + trace := next + sourceStore := sourceAllocation.1 + source := .loc sourceAllocation.2 :: state.source + frameRoots := state.frameRoots + frame := nextFrame + stack := state.stack + member := state.member + descendant := nextDescendant + traceState := by simpa [nextFrame] using nextTraceState + stores := by + simpa [nextMachine, targetAllocation, sourceAllocation, pap] using + nextStores + runtime := nextRuntime + ownership := nextOwnership + stackRoots := state.stackRoots + callStack := state.callStack + history := by + apply state.historyStepOp traceEq + rw [IxIR1.runOp_apply_under_ctx_eq sourceContext + attached.simulationSourceContext _ _ _ _ _ _ functionResolved + argumentsResolved sourceGet node totalUnder] + exact sourceRun + image := nextImage + control := by rfl + noCredits := by simpa [nextFrame] using state.noCredits } + obtain ⟨currentBlockAt, _currentPcBound, applyAt⟩ := + traceState.target.instructionAt descendant + have nextBlockAt : nextFrame.definition.blocks[nextFrame.block]? = + some next.headBlock.2 := by + simpa [nextFrame] using currentBlockAt + exact ⟨fundedState, nextState, by + simpa [fundedMachine, nextMachine] using targetStep, + fun _rewritten => StableLiveAcceptedEntry.ofApplyResume rfl nextBlockAt + (by simpa [nextFrame] using applyAt)⟩ + +/-- Reconstruct an under-saturated PAP application from the concrete target +transfer. Source ownership supplies the retain/release prefix, while +determinism aligns the newly allocated PAP location with the target result. -/ +theorem stepApplyPapUnderOfTarget + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {block : Block} {targetFunction : Atom} + {targetArguments : Array Atom} {arguments : Array RVal} + {location : Nat} {box : NodeBox} {address : Ixon.Address} {arity : Nat} + {captured : Array RVal} {retainedStore releasedStore : Store} + {remainingFuel : Nat} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc < block.instructions.size) + (instruction : block.instructions[state.frame.pc] = + .apply targetFunction targetArguments) + (functionResolved : Eval.resolveAtom state.frame.values targetFunction = + .ok (.loc location)) + (argumentsResolved : Eval.resolveAtoms state.frame.values + targetArguments = .ok arguments) + (targetGet : machine.store.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (retained : Eval.RetainSharedMany machine.store captured retainedStore) + (released : Eval.releaseSharedWork machine.heapFuel retainedStore + [.loc location] = .ok (releasedStore, remainingFuel)) + (totalUnder : (captured ++ arguments).size < arity) : + let allocation := releasedStore.allocNode .shared + (.papN address arity (captured ++ arguments)) + let nextFrame : Frame := + { state.frame with + pc := state.frame.pc + 1 + values := state.frame.values.push (.loc allocation.2) } + let nextMachine : Machine := + { store := allocation.1 + heapFuel := remainingFuel + control := .running nextFrame state.stack } + ∃ _ : CompilerRunningState attached nextMachine, + Eval.Step context interpretation machine nextMachine ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext nextMachine + rewritten := by + dsimp only + obtain ⟨site, blockId, input, nextInput, entryValueCount, index, + sourceFunction, sourceArguments, next, traceEq, + sourceFunctionResolved, sourceArgumentsResolved⟩ := + state.currentApply blockAt pc instruction functionResolved + argumentsResolved + have sourceGet : state.sourceStore.get? location = some box := by + have found := targetGet + unfold Eval.Store.get? at found + rw [state.stores.heap] at found + exact found + obtain ⟨sourceFuel, sourceRetained, sourceReleased, sourceRetain, + sourceRelease⟩ := + state.applyPapPreparation traceEq sourceFunctionResolved + sourceArgumentsResolved sourceGet shared node sourceContext + have sourceTotalUnder : + (captured.toList ++ arguments.toList).length < arity := by + simpa using totalUnder + obtain ⟨localFuel, generatedRetained, generatedReleased, _sourceRun, + generatedRetain, generatedRelease, stepForSuffix⟩ := + state.stepApplyPapUnder (context := context) + (interpretation := interpretation) traceEq sourceDeclarations + sourceFunctionResolved sourceArgumentsResolved sourceGet shared node + capturedUnder sourceRetain sourceRelease sourceTotalUnder + have retainedEq : generatedRetained = retainedStore := by + unfold Eval.RetainSharedMany at generatedRetain retained + rw [generatedRetain] at retained + injection retained + rw [retainedEq] at generatedRelease + obtain ⟨_releasedEq, fuelEq⟩ := + Lower.Sim.releaseSharedWork_success_unique generatedRelease released + have fundedEq : localFuel + remainingFuel = machine.heapFuel := by + simpa using fuelEq + obtain ⟨_fundedState, nextState, generatedStep, acceptedEntry⟩ := + stepForSuffix remainingFuel + have fundedMachineEq : + ({ machine with heapFuel := localFuel + remainingFuel } : Machine) = + machine := by + cases machine + simp_all + rw [fundedMachineEq] at generatedStep + have concreteTransfer : Eval.ApplyTransfer context interpretation + machine.store machine.heapFuel (.loc location) arguments + { state.frame with pc := state.frame.pc + 1 } state.stack + (let allocation := releasedStore.allocNode .shared + (.papN address arity (captured ++ arguments)) + { store := allocation.1 + heapFuel := remainingFuel + control := .running + { state.frame with + pc := state.frame.pc + 1 + values := state.frame.values.push (.loc allocation.2) } + state.stack }) := + Eval.ApplyTransfer.papUnder targetGet shared node capturedUnder retained + released totalUnder + have concreteStep : Eval.Step context interpretation machine + (let allocation := releasedStore.allocNode .shared + (.papN address arity (captured ++ arguments)) + { store := allocation.1 + heapFuel := remainingFuel + control := .running + { state.frame with + pc := state.frame.pc + 1 + values := state.frame.values.push (.loc allocation.2) } + state.stack }) := + Eval.Step.applyCleared state.control blockAt pc instruction + (by simp [Eval.NoLiveCredits, state.noCredits]) functionResolved + argumentsResolved concreteTransfer + have targetEq := generatedStep.deterministic concreteStep + rw [targetEq] at nextState generatedStep acceptedEntry + exact ⟨nextState, generatedStep, acceptedEntry⟩ + +/-- Enter the callee selected by an exactly saturated shared PAP. The +compiler stack records the suspended dynamic-application site, while one +common residual capability vector supports both the callee ownership suffix +and the caller resume frame. -/ +theorem enterApplyPapExact + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {applyFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceFunction : IxIR1.Atom} {targetFunction : Atom} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (traceEq : state.trace = + .letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + {calleeTrace : Lower.FunctionTrace} + (calleeMember : calleeTrace ∈ attached.target.artifact.trace.functions) + {sourceDefinition : IxIR1.FnDef} {targetDefinition : Function} + {sourceRetained sourceReleased : IxIR1.Store} + {location : Nat} {box : IxIR1.NodeBox} + {address : Ixon.Address} {arity : Nat} + {captured : Array RVal} {values : List RVal} + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration address) sourceDefinition targetDefinition) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (functionResolved : IxIR1.resolveAtom state.source sourceFunction = + .ok (.loc location)) + (argumentsResolved : IxIR1.resolveAtoms state.source sourceArguments = + .ok values) + (sourceGet : state.sourceStore.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (sourceRetain : IxIR1.dupVals state.sourceStore captured.toList = + .ok sourceRetained) + (sourceRelease : IxIR1.dropVal sourceContext applyFuel sourceRetained + (.loc location) = .ok sourceReleased) + (totalExact : (captured.toList ++ values).length = arity) + (papArity : arity = sourceDefinition.arity) + (sourceDeclaration : + sourceContext.decls address = some (.fn sourceDefinition)) + (sourcePapSafe : sourceDefinition.papSafe = true) + (targetDeclaration : + context.declarations address = some (.fn targetDefinition)) : + let sourceTotal := captured.toList ++ values + let targetTotal := captured ++ values.toArray + let resume : Frame := { state.frame with pc := state.frame.pc + 1 } + let calleeFrame : Frame := + { definition := targetDefinition, values := targetTotal } + ∃ localFuel targetRetained targetReleased, + IxIR1.runOp sourceContext (applyFuel + 2) + state.functionTrace.source state.sourceStore state.source + (.apply sourceFunction sourceArguments) = + IxIR1.invoke sourceContext applyFuel address sourceTotal + sourceReleased ∧ + Eval.RetainSharedMany machine.store captured targetRetained ∧ + Eval.releaseSharedWork localFuel targetRetained [.loc location] = + .ok (targetReleased, 0) ∧ + ∀ suffixFuel, + let fundedMachine : Machine := + { machine with heapFuel := localFuel + suffixFuel } + let calleeMachine : Machine := + { store := targetReleased + heapFuel := suffixFuel + control := .running calleeFrame + (.resume resume :: state.stack) } + ∃ _ : CompilerRunningState attached fundedMachine, + ∃ _ : CompilerRunningState attached calleeMachine, + Eval.Step context interpretation fundedMachine calleeMachine ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext calleeMachine + rewritten := by + dsimp only + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) := by + rw [← traceEq] + exact state.descendant + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have callerOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + state.sourceStore state.source state.frameRoots := by + rw [← traceEq] + exact state.ownership + let sourceTotal := captured.toList ++ values + let targetTotal := captured ++ values.toArray + let resume : Frame := { state.frame with pc := state.frame.pc + 1 } + let calleeFrame : Frame := + { definition := targetDefinition, values := targetTotal } + obtain ⟨targetRetained, targetReleased, localFuel, targetRetain, + _retainedStores, targetRelease, releasedStores, sourceEquation, _, + calleeTraceState, _⟩ := + attached.simulate_traced_apply_pap_saturated_enter_state + (sourceFuel := applyFuel) (context := context) + (interpretation := interpretation) state.member calleeMember descendant + calleeMatch traceState state.stores state.runtime.positiveSharedRC + sourceDeclarations functionResolved argumentsResolved sourceGet shared + node capturedUnder sourceRetain sourceRelease totalExact papArity + sourceDeclaration sourcePapSafe targetDeclaration state.noCredits + state.control + have papAt : state.sourceStore.get? location = + some ⟨.shared, box.rc, .papN address arity captured⟩ := by + simpa only [← shared, ← node] using sourceGet + have calleePapSafe : calleeTrace.generated.signature.papSafe = true := by + calc + calleeTrace.generated.signature.papSafe = + calleeTrace.source.papSafe := calleeTrace.sourcePapSafe + _ = sourceDefinition.papSafe := congrArg IxIR1.FnDef.papSafe + calleeMatch.source + _ = true := sourcePapSafe + have entryArity : sourceTotal.length = + calleeTrace.generated.signature.params.size := by + calc + sourceTotal.length = arity := by + simpa [sourceTotal] using totalExact + _ = sourceDefinition.arity := papArity + _ = calleeTrace.source.arity := by rw [calleeMatch.source] + _ = calleeTrace.generated.signature.params.size := + calleeTrace.sourceArity.symm + obtain ⟨remaining, readyOwnership, entryOwnership, suspendedFrame⟩ := + LiveFrameSupportedByRoots.applyPapEntry + (checked := attached.target) (sourceContext := sourceContext) + (sourceFuel := applyFuel) (supplied := sourceTotal) (residual := []) + state.member calleeMember descendant callerOwnership functionResolved + argumentsResolved papAt sourceRetain sourceRelease + (by simp [sourceTotal]) entryArity calleePapSafe traceState.target + state.noCredits + let suspendedRoots : List IxIR1.Sim.Root := + Lower.Sim.rootsForCapabilities remaining.toList state.source ++ + state.frameRoots + have calleeOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions calleeTrace.root sourceReleased + sourceTotal.reverse suspendedRoots := by + simpa [suspendedRoots, IxIR1.Sim.rootsFor] using entryOwnership + have calleeRuntime : Lower.Sim.SourceRuntimeInvariant sourceReleased + sourceTotal.reverse := + Lower.Sim.SourceRuntimeInvariant.sharedEntry + ((state.runtime.order.dupVals sourceRetain).dropVal sourceRelease) + ((state.runtime.papsUnder.dupVals sourceRetain).dropVal sourceRelease) + (by simpa [suspendedRoots, IxIR1.Sim.rootsFor, List.append_assoc] using + readyOwnership) + have retainedImage : attached.SourceStoreImage sourceRetained := + attached.dupVals_preservesSourceStoreImage state.image sourceRetain + have calleeImage : attached.SourceStoreImage sourceReleased := + attached.dropVal_preservesSourceStoreImage sourceDeclarations retainedImage + sourceRelease + have suspendedFrame' : LiveFrameSupportedByRoots suspendedRoots resume := + suspendedFrame.mono (fun root member => + List.mem_append_left state.frameRoots member) + have oldStack : LiveStackSupportedByRoots suspendedRoots state.stack := + state.stackRoots.mono (fun root member => + List.mem_append_right + (Lower.Sim.rootsForCapabilities remaining.toList state.source) member) + have calleeStack : LiveStackSupportedByRoots suspendedRoots + (.resume resume :: state.stack) := + .cons (.resume suspendedFrame') oldStack + refine ⟨localFuel, targetRetained, targetReleased, sourceEquation, + targetRetain, targetRelease, ?_⟩ + intro suffixFuel + let fundedMachine : Machine := + { machine with heapFuel := localFuel + suffixFuel } + let calleeMachine : Machine := + { store := targetReleased + heapFuel := suffixFuel + control := .running calleeFrame (.resume resume :: state.stack) } + have fundedState : CompilerRunningState attached fundedMachine := + withHeapFuel state (localFuel + suffixFuel) + have fundedControl : fundedMachine.control = + .running state.frame state.stack := by + simpa [fundedMachine] using state.control + have targetGet : fundedMachine.store.get? location = some box := by + unfold Eval.Store.get? + rw [state.stores.heap] + exact sourceGet + have fundedRelease := Lower.Sim.releaseSharedWork_add_suffix + (suffix := suffixFuel) targetRelease + have totalArrayEq : sourceTotal.toArray = targetTotal := by + apply Array.toList_inj.mp + simp [sourceTotal, targetTotal] + have targetSize : targetTotal.size = arity := by + simpa [sourceTotal, targetTotal] using totalExact + have targetPapSafe : targetDefinition.signature.papSafe = true := by + calc + targetDefinition.signature.papSafe = + calleeTrace.generated.signature.papSafe := by + rw [calleeMatch.generated] + _ = true := calleePapSafe + have targetParamArity : targetDefinition.signature.params.size = arity := by + calc + targetDefinition.signature.params.size = + calleeTrace.generated.signature.params.size := by + rw [calleeMatch.generated] + _ = calleeTrace.source.arity := calleeTrace.sourceArity + _ = sourceDefinition.arity := congrArg IxIR1.FnDef.arity + calleeMatch.source + _ = arity := papArity.symm + have suppliedEq : targetTotal.extract 0 arity = targetTotal := by + rw [← targetSize] + exact Array.extract_size + have suppliedArity : (targetTotal.extract 0 arity).size = + targetDefinition.signature.params.size := by + rw [suppliedEq, targetSize, targetParamArity] + have targetNonempty : targetDefinition.blocks.isEmpty = false := by + simpa [calleeMatch.generated] using calleeTrace.generatedNonempty + have transferred := Eval.ApplyTransfer.papFn + (context := context) (interpretation := interpretation) + (resume := resume) (stack := state.stack) targetGet shared node + capturedUnder targetRetain fundedRelease + (by simpa [targetTotal] using Nat.le_of_eq targetSize.symm) + targetDeclaration targetPapSafe suppliedArity targetNonempty + dsimp only at transferred + have remainingEmpty : + (targetTotal.extract arity targetTotal.size).isEmpty = true := by + simp [Array.isEmpty, Array.size_extract] + omega + rw [suppliedEq, remainingEmpty] at transferred + simp only [if_true] at transferred + have transferred' : Eval.ApplyTransfer context interpretation + fundedMachine.store fundedMachine.heapFuel (.loc location) values.toArray + resume state.stack calleeMachine := by + simpa [fundedMachine, calleeMachine, calleeFrame, sourceTotal, + targetTotal] using transferred + obtain ⟨targetStep, _⟩ := + Lower.Sim.simulate_traced_apply_transfer_state descendant traceState.target + functionResolved argumentsResolved state.noCredits fundedControl + transferred' + have calleeState : CompilerRunningState attached calleeMachine := + { functionTrace := calleeTrace + trace := calleeTrace.root + sourceStore := sourceReleased + source := sourceTotal.reverse + frameRoots := suspendedRoots + frame := calleeFrame + stack := .resume resume :: state.stack + member := calleeMember + descendant := .refl + traceState := by + simpa [sourceTotal, targetTotal, calleeFrame] using calleeTraceState + stores := by simpa [calleeMachine] using releasedStores + runtime := calleeRuntime + ownership := calleeOwnership + stackRoots := calleeStack + callStack := .applyExact state.member descendant traceState state.runtime + callerOwnership state.stackRoots state.image state.noCredits + state.callStack + history := by + simp only [CompilerStackHistory] + refine ⟨?_, ?_⟩ + · rintro out ⟨bodyFuel, bodyRun⟩ world + simp only [CompilerStackCompletion, CompilerStackReturn] + have bodyRun' : IxIR1.runCode attached.simulationSourceContext + bodyFuel sourceDefinition sourceReleased sourceTotal.reverse + sourceDefinition.body = .ok out := by + simpa only [calleeTrace.rootSourceCode, calleeMatch.source] using bodyRun + have world' : IxIR1.Sim.HasWorld out.1 sourceDefinition.result out.2 := by + simpa only [calleeMatch.source] using world + have canonicalDeclaration : attached.simulationSourceContext.decls + address = some (.fn sourceDefinition) := by + change IxIR1.HPT.programDeclEnv + attached.source.lowering.result.artifacts address = _ + rw [← sourceDeclarations] + exact sourceDeclaration + have canonicalRelease : IxIR1.dropVal attached.simulationSourceContext + applyFuel sourceRetained (.loc location) = .ok sourceReleased := by + rw [IxIR1.Sim.dropVal_ctx_eq sourceContext] + exact sourceRelease + have called := IxIR1.invoke_of_body_run canonicalDeclaration + (totalExact.trans papArity) bodyRun' world' + obtain ⟨operationFuel, operationRun⟩ := + IxIR1.runOp_apply_exact_of_invoke + (current := state.functionTrace.source) functionResolved + argumentsResolved sourceGet node sourceRetain canonicalRelease + totalExact canonicalDeclaration sourcePapSafe called + exact ⟨operationFuel, rfl, operationRun⟩ + · simpa [traceEq, Lower.CodeTrace.sourceCode] using state.history + image := calleeImage + control := by rfl + noCredits := by rfl } + exact ⟨fundedState, calleeState, by + simpa [fundedMachine, calleeMachine] using targetStep, + fun _rewritten => StableLiveAcceptedEntry.ofPcZero rfl rfl⟩ + +/-- Enter the first callee selected by an over-saturated shared PAP. The +compiler stack records both the suspended application site and the exact +residual argument vector observed by `applyMore`; those residual values are +framed as shared roots around the active callee. -/ +theorem enterApplyPapOver + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {applyFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceFunction : IxIR1.Atom} {targetFunction : Atom} + {sourceArguments : Array IxIR1.Atom} + {targetArguments : Array Atom} + (traceEq : state.trace = + .letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + {calleeTrace : Lower.FunctionTrace} + (calleeMember : calleeTrace ∈ attached.target.artifact.trace.functions) + {sourceDefinition : IxIR1.FnDef} {targetDefinition : Function} + {sourceRetained sourceReleased : IxIR1.Store} + {location : Nat} {box : IxIR1.NodeBox} + {address : Ixon.Address} {arity : Nat} + {captured : Array RVal} {values : List RVal} + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration address) sourceDefinition targetDefinition) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (functionResolved : IxIR1.resolveAtom state.source sourceFunction = + .ok (.loc location)) + (argumentsResolved : IxIR1.resolveAtoms state.source sourceArguments = + .ok values) + (sourceGet : state.sourceStore.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (sourceRetain : IxIR1.dupVals state.sourceStore captured.toList = + .ok sourceRetained) + (sourceRelease : IxIR1.dropVal sourceContext applyFuel sourceRetained + (.loc location) = .ok sourceReleased) + (totalOver : arity < (captured.toList ++ values).length) + (papArity : arity = sourceDefinition.arity) + (sourceDeclaration : + sourceContext.decls address = some (.fn sourceDefinition)) + (sourcePapSafe : sourceDefinition.papSafe = true) + (targetDeclaration : + context.declarations address = some (.fn targetDefinition)) : + let sourceTotal := captured.toList ++ values + let sourceSupplied := sourceTotal.take arity + let sourceRemaining := sourceTotal.drop arity + let targetTotal := captured ++ values.toArray + let targetSupplied := targetTotal.extract 0 arity + let targetRemaining := targetTotal.extract arity targetTotal.size + let resume : Frame := { state.frame with pc := state.frame.pc + 1 } + let calleeFrame : Frame := + { definition := targetDefinition, values := targetSupplied } + ∃ localFuel targetRetained targetReleased, + IxIR1.runOp sourceContext (applyFuel + 2) + state.functionTrace.source state.sourceStore state.source + (.apply sourceFunction sourceArguments) = + (do + let (nextStore, result) ← + IxIR1.invoke sourceContext applyFuel address sourceSupplied + sourceReleased + IxIR1.applyGo sourceContext applyFuel nextStore result + sourceRemaining) ∧ + Eval.RetainSharedMany machine.store captured targetRetained ∧ + Eval.releaseSharedWork localFuel targetRetained [.loc location] = + .ok (targetReleased, 0) ∧ + ∀ suffixFuel, + let fundedMachine : Machine := + { machine with heapFuel := localFuel + suffixFuel } + let calleeMachine : Machine := + { store := targetReleased + heapFuel := suffixFuel + control := .running calleeFrame + (.applyMore targetRemaining resume :: state.stack) } + ∃ _ : CompilerRunningState attached fundedMachine, + ∃ _ : CompilerRunningState attached calleeMachine, + Eval.Step context interpretation fundedMachine calleeMachine ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext calleeMachine + rewritten := by + dsimp only + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) := by + rw [← traceEq] + exact state.descendant + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have callerOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.apply sourceFunction sourceArguments) index + (.apply targetFunction targetArguments) next) + state.sourceStore state.source state.frameRoots := by + rw [← traceEq] + exact state.ownership + let sourceTotal := captured.toList ++ values + let sourceSupplied := sourceTotal.take arity + let sourceRemaining := sourceTotal.drop arity + let targetTotal := captured ++ values.toArray + let targetSupplied := targetTotal.extract 0 arity + let targetRemaining := targetTotal.extract arity targetTotal.size + let resume : Frame := { state.frame with pc := state.frame.pc + 1 } + let calleeFrame : Frame := + { definition := targetDefinition, values := targetSupplied } + obtain ⟨targetRetained, targetReleased, localFuel, targetRetain, + _retainedStores, targetRelease, releasedStores, sourceEquation, _, + remainingEq, calleeTraceState, _⟩ := + attached.simulate_traced_apply_pap_over_enter_state + (sourceFuel := applyFuel) (context := context) + (interpretation := interpretation) state.member calleeMember descendant + calleeMatch traceState state.stores state.runtime.positiveSharedRC + sourceDeclarations functionResolved argumentsResolved sourceGet shared + node capturedUnder sourceRetain sourceRelease totalOver papArity + sourceDeclaration sourcePapSafe targetDeclaration state.noCredits + state.control + change targetRemaining.toList = sourceRemaining at remainingEq + change attached.sidecars.TraceStateRel calleeTrace calleeTrace.root + sourceReleased sourceSupplied.reverse calleeFrame at calleeTraceState + have papAt : state.sourceStore.get? location = + some ⟨.shared, box.rc, .papN address arity captured⟩ := by + simpa only [← shared, ← node] using sourceGet + have calleePapSafe : calleeTrace.generated.signature.papSafe = true := by + calc + calleeTrace.generated.signature.papSafe = + calleeTrace.source.papSafe := calleeTrace.sourcePapSafe + _ = sourceDefinition.papSafe := congrArg IxIR1.FnDef.papSafe + calleeMatch.source + _ = true := sourcePapSafe + have suppliedLength : sourceSupplied.length = arity := by + have bound : arity ≤ sourceTotal.length := by + simpa [sourceTotal] using Nat.le_of_lt totalOver + simp [sourceSupplied, bound] + have entryArity : sourceSupplied.length = + calleeTrace.generated.signature.params.size := by + calc + sourceSupplied.length = arity := suppliedLength + _ = sourceDefinition.arity := papArity + _ = calleeTrace.source.arity := by rw [calleeMatch.source] + _ = calleeTrace.generated.signature.params.size := + calleeTrace.sourceArity.symm + obtain ⟨remaining, readyOwnership, entryOwnership, suspendedFrame⟩ := + LiveFrameSupportedByRoots.applyPapEntry + (checked := attached.target) (sourceContext := sourceContext) + (sourceFuel := applyFuel) (supplied := sourceSupplied) + (residual := sourceRemaining) state.member calleeMember descendant + callerOwnership functionResolved argumentsResolved papAt sourceRetain + sourceRelease (by simp [sourceTotal, sourceSupplied, sourceRemaining]) + entryArity calleePapSafe traceState.target state.noCredits + let suspendedRoots : List IxIR1.Sim.Root := + Lower.Sim.rootsForCapabilities remaining.toList state.source ++ + state.frameRoots + let calleeRoots : List IxIR1.Sim.Root := + IxIR1.Sim.rootsFor .shared sourceRemaining ++ suspendedRoots + have calleeOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions calleeTrace.root sourceReleased + sourceSupplied.reverse calleeRoots := by + simpa [calleeRoots, suspendedRoots] using entryOwnership + have calleeRuntime : Lower.Sim.SourceRuntimeInvariant sourceReleased + sourceSupplied.reverse := + Lower.Sim.SourceRuntimeInvariant.sharedEntry + ((state.runtime.order.dupVals sourceRetain).dropVal sourceRelease) + ((state.runtime.papsUnder.dupVals sourceRetain).dropVal sourceRelease) + (by + simpa [calleeRoots, suspendedRoots, IxIR1.Sim.rootsFor, + List.append_assoc] using readyOwnership) + have retainedImage : attached.SourceStoreImage sourceRetained := + attached.dupVals_preservesSourceStoreImage state.image sourceRetain + have calleeImage : attached.SourceStoreImage sourceReleased := + attached.dropVal_preservesSourceStoreImage sourceDeclarations retainedImage + sourceRelease + have suspendedFrame' : LiveFrameSupportedByRoots suspendedRoots resume := + suspendedFrame.mono (fun root member => + List.mem_append_left state.frameRoots member) + have callerFrameSupported : LiveFrameSupportedByRoots calleeRoots resume := + suspendedFrame'.mono (fun root member => + List.mem_append_right (IxIR1.Sim.rootsFor .shared sourceRemaining) member) + have residualSupported : ∀ value ∈ targetRemaining.toList, + ValueSupportedByRoots calleeRoots value := by + intro value member + have sourceMember : value ∈ sourceRemaining := by + exact remainingEq ▸ member + cases value with + | loc location => + exact ⟨.shared, List.mem_append_left suspendedRoots (by + simp [IxIR1.Sim.rootsFor, sourceMember])⟩ + | lit literal => trivial + | erased => trivial + have oldStack : LiveStackSupportedByRoots calleeRoots state.stack := + state.stackRoots.mono (fun root member => + List.mem_append_right (IxIR1.Sim.rootsFor .shared sourceRemaining) + (List.mem_append_right + (Lower.Sim.rootsForCapabilities remaining.toList state.source) + member)) + have calleeStack : LiveStackSupportedByRoots calleeRoots + (.applyMore targetRemaining resume :: state.stack) := + .cons (.applyMore residualSupported callerFrameSupported) oldStack + refine ⟨localFuel, targetRetained, targetReleased, sourceEquation, + targetRetain, targetRelease, ?_⟩ + intro suffixFuel + let fundedMachine : Machine := + { machine with heapFuel := localFuel + suffixFuel } + let calleeMachine : Machine := + { store := targetReleased + heapFuel := suffixFuel + control := .running calleeFrame + (.applyMore targetRemaining resume :: state.stack) } + have fundedState : CompilerRunningState attached fundedMachine := + withHeapFuel state (localFuel + suffixFuel) + have fundedControl : fundedMachine.control = + .running state.frame state.stack := by + simpa [fundedMachine] using state.control + have targetGet : fundedMachine.store.get? location = some box := by + unfold Eval.Store.get? + rw [state.stores.heap] + exact sourceGet + have fundedRelease := Lower.Sim.releaseSharedWork_add_suffix + (suffix := suffixFuel) targetRelease + have targetOver : arity < targetTotal.size := by + simpa [sourceTotal, targetTotal] using totalOver + have targetPapSafe : targetDefinition.signature.papSafe = true := by + calc + targetDefinition.signature.papSafe = + calleeTrace.generated.signature.papSafe := by + rw [calleeMatch.generated] + _ = true := calleePapSafe + have targetParamArity : targetDefinition.signature.params.size = arity := by + calc + targetDefinition.signature.params.size = + calleeTrace.generated.signature.params.size := by + rw [calleeMatch.generated] + _ = calleeTrace.source.arity := calleeTrace.sourceArity + _ = sourceDefinition.arity := congrArg IxIR1.FnDef.arity + calleeMatch.source + _ = arity := papArity.symm + have targetSuppliedSize : targetSupplied.size = arity := by + simp [targetSupplied, Array.size_extract] + omega + have targetSuppliedArity : targetSupplied.size = + targetDefinition.signature.params.size := by + rw [targetSuppliedSize, targetParamArity] + have targetNonempty : targetDefinition.blocks.isEmpty = false := by + simpa [calleeMatch.generated] using calleeTrace.generatedNonempty + have transferred := Eval.ApplyTransfer.papFn + (context := context) (interpretation := interpretation) + (resume := resume) (stack := state.stack) targetGet shared node + capturedUnder targetRetain fundedRelease (Nat.le_of_lt targetOver) + targetDeclaration targetPapSafe targetSuppliedArity targetNonempty + dsimp only at transferred + have remainingNonempty : targetRemaining.isEmpty = false := by + simp [targetRemaining, Array.isEmpty, Array.size_extract] + omega + rw [remainingNonempty] at transferred + have transferred' : Eval.ApplyTransfer context interpretation + fundedMachine.store fundedMachine.heapFuel (.loc location) values.toArray + resume state.stack calleeMachine := by + simpa [fundedMachine, calleeMachine, calleeFrame, targetTotal, + targetSupplied, targetRemaining] using transferred + obtain ⟨targetStep, _⟩ := + Lower.Sim.simulate_traced_apply_transfer_state descendant traceState.target + functionResolved argumentsResolved state.noCredits fundedControl + transferred' + have calleeState : CompilerRunningState attached calleeMachine := + { functionTrace := calleeTrace + trace := calleeTrace.root + sourceStore := sourceReleased + source := sourceSupplied.reverse + frameRoots := calleeRoots + frame := calleeFrame + stack := .applyMore targetRemaining resume :: state.stack + member := calleeMember + descendant := .refl + traceState := calleeTraceState + stores := by simpa [calleeMachine] using releasedStores + runtime := calleeRuntime + ownership := calleeOwnership + stackRoots := calleeStack + callStack := .applyMore state.member descendant traceState state.runtime + callerOwnership state.stackRoots state.image state.noCredits + suspendedFrame remainingEq (remaining := remaining) state.callStack + history := by + simp only [CompilerStackHistory] + refine ⟨?_, ?_⟩ + · rintro out ⟨bodyFuel, bodyRun⟩ world + simp only [CompilerStackCompletion] + have bodyRun' : IxIR1.runCode attached.simulationSourceContext + bodyFuel sourceDefinition sourceReleased sourceSupplied.reverse + sourceDefinition.body = .ok out := by + simpa only [calleeTrace.rootSourceCode, calleeMatch.source] using bodyRun + have world' : IxIR1.Sim.HasWorld out.1 sourceDefinition.result out.2 := by + simpa only [calleeMatch.source] using world + have canonicalDeclaration : attached.simulationSourceContext.decls + address = some (.fn sourceDefinition) := by + change IxIR1.HPT.programDeclEnv + attached.source.lowering.result.artifacts address = _ + rw [← sourceDeclarations] + exact sourceDeclaration + have canonicalRelease : IxIR1.dropVal attached.simulationSourceContext + applyFuel sourceRetained (.loc location) = .ok sourceReleased := by + rw [IxIR1.Sim.dropVal_ctx_eq sourceContext] + exact sourceRelease + have called := IxIR1.invoke_of_body_run canonicalDeclaration + (suppliedLength.trans papArity) bodyRun' world' + intro residualFuel final residualRun + obtain ⟨operationFuel, operationRun⟩ := + IxIR1.runOp_apply_over_of_invoke + (current := state.functionTrace.source) functionResolved + argumentsResolved sourceGet node sourceRetain canonicalRelease + totalOver canonicalDeclaration sourcePapSafe called residualRun + exact ⟨operationFuel + 1, operationRun⟩ + · simpa [traceEq, Lower.CodeTrace.sourceCode] using state.history + image := calleeImage + control := by rfl + noCredits := by rfl } + exact ⟨fundedState, calleeState, targetStep, + fun _rewritten => StableLiveAcceptedEntry.ofPcZero rfl rfl⟩ + +/-- Reconstruct every concrete dynamic-application transfer. Erased and +under-saturated cases resume locally; function PAPs enter either an exact or +over-saturated callee; extern PAPs are impossible for an attached closed +program. -/ +theorem stepApplyOfTarget + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine target : Machine} + (state : CompilerRunningState attached machine) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (targetDeclarations : context.declarations = + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas).declarations) + {block : Block} {targetFunction : Atom} + {targetArguments : Array Atom} {function : RVal} + {arguments : Array RVal} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc < block.instructions.size) + (instruction : block.instructions[state.frame.pc] = + .apply targetFunction targetArguments) + (functionResolved : Eval.resolveAtom state.frame.values targetFunction = + .ok function) + (argumentsResolved : Eval.resolveAtoms state.frame.values + targetArguments = .ok arguments) + (transferred : Eval.ApplyTransfer context interpretation machine.store + machine.heapFuel function arguments + { state.frame with pc := state.frame.pc + 1 } state.stack target) : + ∃ _ : CompilerRunningState attached target, + Eval.Step context interpretation machine target ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext target rewritten := by + have noCredits : Eval.NoLiveCredits state.frame := by + simp [Eval.NoLiveCredits, state.noCredits] + have concreteStep : Eval.Step context interpretation machine target := + Eval.Step.applyCleared state.control blockAt pc instruction noCredits + functionResolved argumentsResolved transferred + cases transferred.classify with + | erased released => + exact state.stepApplyErasedOfTarget sourceDeclarations blockAt pc + instruction functionResolved argumentsResolved released + | papUnder boxAt shared node capturedUnder retained released totalUnder => + exact state.stepApplyPapUnderOfTarget sourceDeclarations blockAt pc + instruction functionResolved argumentsResolved boxAt shared node + capturedUnder retained released totalUnder + | papExtern boxAt shared node capturedUnder retained released totalEnough + declaration suppliedArity remainingEmpty called => + exact (attached.targetDeclaration_not_extern targetDeclarations + declaration).elim + | @papFn location box address arity captured retainedStore releasedStore + remainingFuel definition boxAt shared node capturedUnder retained + released totalEnough declaration papSafe suppliedArity nonempty => + obtain ⟨site, blockId, input, nextInput, entryValueCount, index, + sourceFunction, sourceArguments, next, traceEq, + sourceFunctionResolved, sourceArgumentsResolved⟩ := + state.currentApply blockAt pc instruction functionResolved + argumentsResolved + have sourceGet : state.sourceStore.get? location = some box := by + have found := boxAt + unfold Eval.Store.get? at found + rw [state.stores.heap] at found + exact found + obtain ⟨sourceFuel, sourceRetained, sourceReleased, sourceRetain, + sourceRelease⟩ := + state.applyPapPreparation traceEq sourceFunctionResolved + sourceArgumentsResolved sourceGet shared node sourceContext + obtain ⟨sourceDefinition, calleeTrace, calleeMember, calleeMatch, + sourceDeclaration⟩ := + attached.functionTrace_of_target_declaration sourceDeclarations + targetDeclarations declaration + have targetExtractSize : + ((captured ++ arguments).extract 0 arity).size = arity := by + rw [Array.size_extract, Nat.sub_zero, + Nat.min_eq_left totalEnough] + have papArity : arity = sourceDefinition.arity := by + calc + arity = definition.signature.params.size := + targetExtractSize.symm.trans suppliedArity + _ = calleeTrace.generated.signature.params.size := by + rw [calleeMatch.generated] + _ = calleeTrace.source.arity := calleeTrace.sourceArity + _ = sourceDefinition.arity := congrArg IxIR1.FnDef.arity + calleeMatch.source + have sourcePapSafe : sourceDefinition.papSafe = true := by + calc + sourceDefinition.papSafe = calleeTrace.source.papSafe := + congrArg IxIR1.FnDef.papSafe calleeMatch.source.symm + _ = calleeTrace.generated.signature.papSafe := + calleeTrace.sourcePapSafe.symm + _ = definition.signature.papSafe := by rw [calleeMatch.generated] + _ = true := papSafe + have sourceEnough : arity ≤ + (captured.toList ++ arguments.toList).length := by + simpa using totalEnough + by_cases totalExact : + (captured.toList ++ arguments.toList).length = arity + · obtain ⟨localFuel, generatedRetained, generatedReleased, + _sourceEquation, generatedRetain, generatedRelease, + stepForSuffix⟩ := + state.enterApplyPapExact traceEq calleeMember calleeMatch + sourceDeclarations sourceFunctionResolved sourceArgumentsResolved + sourceGet shared node capturedUnder sourceRetain sourceRelease + totalExact papArity sourceDeclaration sourcePapSafe declaration + have retainedEq : generatedRetained = retainedStore := by + unfold Eval.RetainSharedMany at generatedRetain retained + rw [generatedRetain] at retained + injection retained + rw [retainedEq] at generatedRelease + obtain ⟨_releasedEq, fuelEq⟩ := + Lower.Sim.releaseSharedWork_success_unique generatedRelease released + have fundedEq : localFuel + remainingFuel = machine.heapFuel := by + simpa using fuelEq + obtain ⟨_fundedState, nextState, generatedStep, acceptedEntry⟩ := + stepForSuffix remainingFuel + have fundedMachineEq : + ({ machine with heapFuel := localFuel + remainingFuel } : + Machine) = machine := by + cases machine + simp_all + rw [fundedMachineEq] at generatedStep + have targetEq := generatedStep.deterministic concreteStep + rw [targetEq] at nextState generatedStep acceptedEntry + exact ⟨nextState, generatedStep, acceptedEntry⟩ + · have totalOver : arity < + (captured.toList ++ arguments.toList).length := by omega + obtain ⟨localFuel, generatedRetained, generatedReleased, + _sourceEquation, generatedRetain, generatedRelease, + stepForSuffix⟩ := + state.enterApplyPapOver traceEq calleeMember calleeMatch + sourceDeclarations sourceFunctionResolved sourceArgumentsResolved + sourceGet shared node capturedUnder sourceRetain sourceRelease + totalOver papArity sourceDeclaration sourcePapSafe declaration + have retainedEq : generatedRetained = retainedStore := by + unfold Eval.RetainSharedMany at generatedRetain retained + rw [generatedRetain] at retained + injection retained + rw [retainedEq] at generatedRelease + obtain ⟨_releasedEq, fuelEq⟩ := + Lower.Sim.releaseSharedWork_success_unique generatedRelease released + have fundedEq : localFuel + remainingFuel = machine.heapFuel := by + simpa using fuelEq + obtain ⟨_fundedState, nextState, generatedStep, acceptedEntry⟩ := + stepForSuffix remainingFuel + have fundedMachineEq : + ({ machine with heapFuel := localFuel + remainingFuel } : + Machine) = machine := by + cases machine + simp_all + rw [fundedMachineEq] at generatedStep + have targetEq := generatedStep.deterministic concreteStep + rw [targetEq] at nextState generatedStep acceptedEntry + exact ⟨nextState, generatedStep, acceptedEntry⟩ + +/-- Enter an addressed ordinary call while preserving the full compiler +running invariant. The checked capability transition supplies both the +callee's framed roots and semantic support for the newly suspended caller. -/ +theorem enterCall + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} {sourceAddress targetAddress : Ixon.Address} + {sourceArguments : Array IxIR1.Atom} {targetArguments : Array Atom} + (traceEq : state.trace = + .letOp site blockId input nextInput entryValueCount + (.call sourceAddress sourceArguments) index + (.call targetAddress targetArguments) next) + {calleeTrace : Lower.FunctionTrace} + (calleeMember : calleeTrace ∈ attached.target.artifact.trace.functions) + {sourceDefinition : IxIR1.FnDef} {targetDefinition : Function} + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration sourceAddress) sourceDefinition targetDefinition) + (sourceDeclaration : attached.simulationSourceContext.decls + sourceAddress = some (.fn sourceDefinition)) + {values : List RVal} + (sourceResolved : + IxIR1.resolveAtoms state.source sourceArguments = .ok values) + (argumentArity : sourceDefinition.arity = values.length) + (targetDeclaration : context.declarations sourceAddress = + some (.fn targetDefinition)) : + let resume : Frame := { state.frame with pc := state.frame.pc + 1 } + let calleeFrame : Frame := + { definition := targetDefinition, values := values.toArray } + let calleeMachine : Machine := + { machine with + control := .running calleeFrame (.resume resume :: state.stack) } + ∃ _ : CompilerRunningState attached calleeMachine, + IxIR1.runOp sourceContext (sourceFuel + 1) state.functionTrace.source + state.sourceStore state.source + (.call sourceAddress sourceArguments) = + IxIR1.invoke sourceContext sourceFuel sourceAddress values + state.sourceStore ∧ + Eval.Step context interpretation machine calleeMachine ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext calleeMachine + rewritten := by + dsimp only + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.call sourceAddress sourceArguments) index + (.call targetAddress targetArguments) next) := by + rw [← traceEq] + exact state.descendant + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount + (.call sourceAddress sourceArguments) index + (.call targetAddress targetArguments) next) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.call sourceAddress sourceArguments) index + (.call targetAddress targetArguments) next) + state.sourceStore state.source state.frameRoots := by + rw [← traceEq] + exact state.ownership + let resume : Frame := { state.frame with pc := state.frame.pc + 1 } + let calleeFrame : Frame := + { definition := targetDefinition, values := values.toArray } + let calleeMachine : Machine := + { machine with + control := .running calleeFrame (.resume resume :: state.stack) } + obtain ⟨sourceEquation, targetStep, entryStores, calleeState⟩ := + attached.simulate_traced_call_fn_enter_state + (sourceContext := sourceContext) (sourceFuel := sourceFuel) + (context := context) (interpretation := interpretation) + calleeMember descendant calleeMatch traceState state.stores + sourceResolved argumentArity targetDeclaration state.noCredits + state.control + have signatureAt := attached.target.targetSignature calleeMember + calleeMatch.owner + obtain ⟨callPosition, remaining, callPositionMember, + callPositionCoordinate, consumed, noBorrows, entryOwnership⟩ := + Lower.Sim.SourceOwnershipAt.callEntry (checked := attached.target) + state.member calleeMember descendant signatureAt ownership sourceResolved + have callInvariant : Lower.Sim.SourceOwnershipInvariant state.sourceStore + state.source input callPosition.sourceCapabilities state.frameRoots := + ownership callPosition callPositionMember (by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceBlock, + Lower.CodeTrace.targetPosition, Lower.CodeTrace.sourceInputMap] using + callPositionCoordinate) + have suspendedFrame : LiveFrameSupportedByRoots + (Lower.Sim.rootsForCapabilities remaining.toList state.source) + resume := by + simpa [resume] using LiveFrameSupportedByRoots.ofCallSuspension + state.member signatureAt descendant callPositionMember + callPositionCoordinate callInvariant sourceResolved consumed noBorrows + traceState.target state.noCredits + let suspendedRoots : List IxIR1.Sim.Root := + Lower.Sim.rootsForCapabilities remaining.toList state.source ++ + state.frameRoots + have suspendedFrame' : LiveFrameSupportedByRoots suspendedRoots resume := + suspendedFrame.mono (fun root member => + List.mem_append_left state.frameRoots member) + have oldStack : LiveStackSupportedByRoots suspendedRoots state.stack := + state.stackRoots.mono (fun root member => + List.mem_append_right + (Lower.Sim.rootsForCapabilities remaining.toList state.source) + member) + have nextStack : LiveStackSupportedByRoots suspendedRoots + (.resume resume :: state.stack) := + .cons (.resume suspendedFrame') oldStack + have calleeOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions calleeTrace.root + state.sourceStore values.reverse suspendedRoots := by + simpa [suspendedRoots] using entryOwnership + have calleeRuntime : Lower.Sim.SourceRuntimeInvariant state.sourceStore + values.reverse := state.runtime.resolveAtomsReverse sourceResolved + have nextState : CompilerRunningState attached calleeMachine := + { functionTrace := calleeTrace + trace := calleeTrace.root + sourceStore := state.sourceStore + source := values.reverse + frameRoots := suspendedRoots + frame := calleeFrame + stack := .resume resume :: state.stack + member := calleeMember + descendant := .refl + traceState := by simpa [calleeFrame] using calleeState + stores := by simpa [calleeMachine] using entryStores + runtime := calleeRuntime + ownership := calleeOwnership + stackRoots := nextStack + callStack := .addressed state.member calleeMember calleeMatch descendant + traceState state.runtime ownership state.stackRoots state.image + state.noCredits sourceResolved signatureAt callPositionMember + callPositionCoordinate consumed state.callStack + history := by + simp only [CompilerStackHistory] + refine ⟨?_, ?_⟩ + · rintro out ⟨bodyFuel, bodyRun⟩ world + simp only [CompilerStackCompletion, CompilerStackReturn] + have bodyRun' : IxIR1.runCode attached.simulationSourceContext + bodyFuel sourceDefinition state.sourceStore values.reverse + sourceDefinition.body = .ok out := by + simpa only [calleeTrace.rootSourceCode, calleeMatch.source] using bodyRun + have world' : IxIR1.Sim.HasWorld out.1 sourceDefinition.result out.2 := by + simpa only [calleeMatch.source] using world + exact ⟨bodyFuel + 1, rfl, sourceDeclaration, + IxIR1.runOp_call_of_body_run sourceResolved sourceDeclaration + argumentArity.symm bodyRun' world'⟩ + · simpa [traceEq, Lower.CodeTrace.sourceCode] using state.history + image := state.image + control := by rfl + noCredits := by rfl } + exact ⟨nextState, sourceEquation, + by simpa [calleeMachine] using targetStep, + fun _rewritten => StableLiveAcceptedEntry.ofPcZero rfl rfl⟩ + +/-- Reconstruct addressed call entry from a concrete target instruction. +The inverse declaration lookup identifies the retained source callee, and +the checked input map reflects the target argument vector to its source +counterpart. -/ +theorem enterCallOfTarget + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (targetDeclarations : context.declarations = + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas).declarations) + {block : Block} {address : Ixon.Address} {arguments : Array Atom} + {values : Array RVal} {definition : Function} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc < block.instructions.size) + (instruction : block.instructions[state.frame.pc] = + .call address arguments) + (resolved : Eval.resolveAtoms state.frame.values arguments = .ok values) + (targetDeclaration : context.declarations address = some (.fn definition)) + (arity : values.size = definition.signature.params.size) : + let resume : Frame := { state.frame with pc := state.frame.pc + 1 } + let calleeFrame : Frame := { definition, values } + let calleeMachine : Machine := + { machine with + control := .running calleeFrame (.resume resume :: state.stack) } + ∃ _ : CompilerRunningState attached calleeMachine, + Eval.Step context interpretation machine calleeMachine ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext calleeMachine + rewritten := by + dsimp only + obtain ⟨site, blockId, input, nextInput, entryValueCount, operation, + index, next, traceEq, operationSyntax⟩ := + state.currentLetOp blockAt pc instruction + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount operation index + (.call address arguments) next) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + cases operation with + | call sourceAddress sourceArguments => + change sourceAddress = address ∧ + Lower.InputMap.translateAtoms input sourceArguments = some arguments + at operationSyntax + obtain ⟨rfl, translated⟩ := operationSyntax + obtain ⟨sourceDefinition, calleeTrace, calleeMember, calleeMatch, + sourceDeclaration⟩ := + attached.functionTrace_of_target_declaration sourceDeclarations + targetDeclarations targetDeclaration + have sourceCount : state.source.length = input.size := by + simpa [Lower.CodeTrace.sourceInputMap] using + traceState.target.sourceCount + have atoms := Lower.Sim.atomsRel_of_translateAtoms translated + have sourceResolved : + IxIR1.resolveAtoms state.source sourceArguments = .ok values.toList := + Lower.Sim.resolveAtoms_of_envRel_target + traceState.target.environments sourceCount atoms resolved + have sourceArity : sourceDefinition.arity = values.toList.length := by + calc + sourceDefinition.arity = calleeTrace.source.arity := + congrArg IxIR1.FnDef.arity calleeMatch.source.symm + _ = calleeTrace.generated.signature.params.size := + calleeTrace.sourceArity.symm + _ = definition.signature.params.size := by + rw [calleeMatch.generated] + _ = values.size := arity.symm + _ = values.toList.length := by simp + obtain ⟨nextState, _sourceEquation, targetStep, acceptedEntry⟩ := + state.enterCall (sourceContext := sourceContext) + (sourceFuel := sourceFuel) (context := context) + (interpretation := interpretation) traceEq calleeMember calleeMatch + (by + change IxIR1.HPT.programDeclEnv + attached.source.lowering.result.artifacts _ = _ + rw [← sourceDeclarations] + exact sourceDeclaration) + sourceResolved sourceArity targetDeclaration + exact ⟨by simpa using nextState, by simpa using targetStep, + by simpa using acceptedEntry⟩ + | pure sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | alloc sourceWorld sourceCid sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | reuse sourceAtom sourceCid sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | free sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | dup sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | drop sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | dropU sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | fetch sourceAtom sourceField => + simp [Lower.OperationSyntax] at operationSyntax + | callSelf sourceArguments => simp [Lower.OperationSyntax] at operationSyntax + | papp sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | apply sourceFunction sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | extern sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + +/-- Enter a recursive ordinary call while preserving the full compiler +running invariant and adding the supported caller frame to the root suffix. -/ +theorem enterCallSelf + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {next : Lower.CodeTrace} + {sourceArguments : Array IxIR1.Atom} {targetArguments : Array Atom} + (traceEq : state.trace = + .letOp site blockId input nextInput entryValueCount + (.callSelf sourceArguments) index (.callSelf targetArguments) next) + {values : List RVal} + (sourceResolved : + IxIR1.resolveAtoms state.source sourceArguments = .ok values) + (argumentArity : state.functionTrace.source.arity = values.length) : + let resume : Frame := { state.frame with pc := state.frame.pc + 1 } + let calleeFrame : Frame := + { definition := state.frame.definition, values := values.toArray } + let calleeMachine : Machine := + { machine with + control := .running calleeFrame (.resume resume :: state.stack) } + ∃ _ : CompilerRunningState attached calleeMachine, + IxIR1.runOp sourceContext (sourceFuel + 1) state.functionTrace.source + state.sourceStore state.source (.callSelf sourceArguments) = (do + let out ← IxIR1.runCode sourceContext sourceFuel + state.functionTrace.source state.sourceStore values.reverse + state.functionTrace.source.body + IxIR1.checkResultWorld state.functionTrace.source.result out) ∧ + Eval.Step context interpretation machine calleeMachine ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext calleeMachine + rewritten := by + dsimp only + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount + (.callSelf sourceArguments) index (.callSelf targetArguments) next) := by + rw [← traceEq] + exact state.descendant + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount + (.callSelf sourceArguments) index (.callSelf targetArguments) next) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.letOp site blockId input nextInput entryValueCount + (.callSelf sourceArguments) index (.callSelf targetArguments) next) + state.sourceStore state.source state.frameRoots := by + rw [← traceEq] + exact state.ownership + let resume : Frame := { state.frame with pc := state.frame.pc + 1 } + let calleeFrame : Frame := + { definition := state.frame.definition, values := values.toArray } + let calleeMachine : Machine := + { machine with + control := .running calleeFrame (.resume resume :: state.stack) } + obtain ⟨sourceEquation, targetStep, entryStores, calleeState⟩ := + attached.simulate_traced_call_self_enter_state + (sourceContext := sourceContext) (sourceFuel := sourceFuel) + (context := context) (interpretation := interpretation) + state.member descendant traceState state.stores sourceResolved + argumentArity state.noCredits state.control + obtain ⟨callPosition, remaining, callPositionMember, + callPositionCoordinate, consumed, noBorrows, entryOwnership⟩ := + Lower.Sim.SourceOwnershipAt.callSelfEntry (checked := attached.target) + state.member descendant ownership sourceResolved + have callInvariant : Lower.Sim.SourceOwnershipInvariant state.sourceStore + state.source input callPosition.sourceCapabilities state.frameRoots := + ownership callPosition callPositionMember (by + simpa [Lower.CodeTrace.source, Lower.CodeTrace.sourceBlock, + Lower.CodeTrace.targetPosition, Lower.CodeTrace.sourceInputMap] using + callPositionCoordinate) + have suspendedFrame : LiveFrameSupportedByRoots + (Lower.Sim.rootsForCapabilities remaining.toList state.source) + resume := by + simpa [resume] using LiveFrameSupportedByRoots.ofCallSelfSuspension + state.member descendant callPositionMember callPositionCoordinate + callInvariant sourceResolved consumed noBorrows traceState.target + state.noCredits + let suspendedRoots : List IxIR1.Sim.Root := + Lower.Sim.rootsForCapabilities remaining.toList state.source ++ + state.frameRoots + have suspendedFrame' : LiveFrameSupportedByRoots suspendedRoots resume := + suspendedFrame.mono (fun root member => + List.mem_append_left state.frameRoots member) + have oldStack : LiveStackSupportedByRoots suspendedRoots state.stack := + state.stackRoots.mono (fun root member => + List.mem_append_right + (Lower.Sim.rootsForCapabilities remaining.toList state.source) + member) + have nextStack : LiveStackSupportedByRoots suspendedRoots + (.resume resume :: state.stack) := + .cons (.resume suspendedFrame') oldStack + have calleeOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions state.functionTrace.root + state.sourceStore values.reverse suspendedRoots := by + simpa [suspendedRoots] using entryOwnership + have calleeRuntime : Lower.Sim.SourceRuntimeInvariant state.sourceStore + values.reverse := state.runtime.resolveAtomsReverse sourceResolved + have nextState : CompilerRunningState attached calleeMachine := + { functionTrace := state.functionTrace + trace := state.functionTrace.root + sourceStore := state.sourceStore + source := values.reverse + frameRoots := suspendedRoots + frame := calleeFrame + stack := .resume resume :: state.stack + member := state.member + descendant := .refl + traceState := by simpa [calleeFrame] using calleeState + stores := by simpa [calleeMachine] using entryStores + runtime := calleeRuntime + ownership := calleeOwnership + stackRoots := nextStack + callStack := .self state.member descendant traceState state.runtime + ownership state.stackRoots state.image state.noCredits sourceResolved + callPositionMember callPositionCoordinate consumed state.callStack + history := by + simp only [CompilerStackHistory] + refine ⟨?_, ?_⟩ + · rintro out ⟨bodyFuel, bodyRun⟩ world + simp only [CompilerStackCompletion, CompilerStackReturn] + have bodyRun' : IxIR1.runCode attached.simulationSourceContext + bodyFuel state.functionTrace.source state.sourceStore values.reverse + state.functionTrace.source.body = .ok out := by + simpa only [state.functionTrace.rootSourceCode] using bodyRun + exact ⟨bodyFuel, rfl, IxIR1.runOp_callSelf_of_body_run sourceResolved + argumentArity.symm bodyRun' world⟩ + · simpa [traceEq, Lower.CodeTrace.sourceCode] using state.history + image := state.image + control := by rfl + noCredits := by rfl } + exact ⟨nextState, sourceEquation, + by simpa [calleeMachine] using targetStep, + fun _rewritten => StableLiveAcceptedEntry.ofPcZero rfl rfl⟩ + +/-- Reconstruct recursive ordinary-call entry from a concrete target +instruction and its resolved argument vector. -/ +theorem enterCallSelfOfTarget + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {block : Block} {arguments : Array Atom} {values : Array RVal} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc < block.instructions.size) + (instruction : block.instructions[state.frame.pc] = + .callSelf arguments) + (resolved : Eval.resolveAtoms state.frame.values arguments = .ok values) + (arity : values.size = state.frame.definition.signature.params.size) : + let resume : Frame := { state.frame with pc := state.frame.pc + 1 } + let calleeFrame : Frame := + { definition := state.frame.definition, values } + let calleeMachine : Machine := + { machine with + control := .running calleeFrame (.resume resume :: state.stack) } + ∃ _ : CompilerRunningState attached calleeMachine, + Eval.Step context interpretation machine calleeMachine ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext calleeMachine + rewritten := by + dsimp only + obtain ⟨site, blockId, input, nextInput, entryValueCount, operation, + index, next, traceEq, operationSyntax⟩ := + state.currentLetOp blockAt pc instruction + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.letOp site blockId input nextInput entryValueCount operation index + (.callSelf arguments) next) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + cases operation with + | callSelf sourceArguments => + change Lower.InputMap.translateAtoms input sourceArguments = + some arguments at operationSyntax + have sourceCount : state.source.length = input.size := by + simpa [Lower.CodeTrace.sourceInputMap] using + traceState.target.sourceCount + have atoms := Lower.Sim.atomsRel_of_translateAtoms operationSyntax + have sourceResolved : + IxIR1.resolveAtoms state.source sourceArguments = .ok values.toList := + Lower.Sim.resolveAtoms_of_envRel_target + traceState.target.environments sourceCount atoms resolved + have sourceArity : state.functionTrace.source.arity = + values.toList.length := by + calc + state.functionTrace.source.arity = + state.functionTrace.generated.signature.params.size := + state.functionTrace.sourceArity.symm + _ = state.frame.definition.signature.params.size := by + rw [traceState.target.definition] + _ = values.size := arity.symm + _ = values.toList.length := by simp + obtain ⟨nextState, _sourceEquation, targetStep, acceptedEntry⟩ := + state.enterCallSelf (sourceContext := sourceContext) + (sourceFuel := sourceFuel) (context := context) + (interpretation := interpretation) traceEq sourceResolved sourceArity + exact ⟨by simpa using nextState, by simpa using targetStep, + by simpa using acceptedEntry⟩ + | pure sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | alloc sourceWorld sourceCid sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | reuse sourceAtom sourceCid sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | free sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | dup sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | drop sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | dropU sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | fetch sourceAtom sourceField => + simp [Lower.OperationSyntax] at operationSyntax + | call sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | papp sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | apply sourceFunction sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | extern sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + +/-- Enter an addressed tail call without growing the continuation stack. All +local owners transfer to the callee, so the existing framed-root suffix and +its live stack support are preserved exactly. -/ +theorem enterTailCall + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {address : Ixon.Address} {sourceArguments : Array IxIR1.Atom} + {generated : Block} + (traceEq : state.trace = + .tailCall site blockId input entryValueCount address sourceArguments + generated) + {calleeTrace : Lower.FunctionTrace} + (calleeMember : calleeTrace ∈ attached.target.artifact.trace.functions) + {sourceDefinition : IxIR1.FnDef} {targetDefinition : Function} + (calleeMatch : Lower.FunctionTraceMatch calleeTrace + (.declaration address) sourceDefinition targetDefinition) + (sourceDeclaration : attached.simulationSourceContext.decls + address = some (.fn sourceDefinition)) + {values : List RVal} + (sourceResolved : + IxIR1.resolveAtoms state.source sourceArguments = .ok values) + (argumentArity : sourceDefinition.arity = values.length) + (targetDeclaration : context.declarations address = + some (.fn targetDefinition)) : + let calleeFrame : Frame := + { definition := targetDefinition, values := values.toArray } + let calleeMachine : Machine := + { machine with control := .running calleeFrame state.stack } + ∃ _ : CompilerRunningState attached calleeMachine, + IxIR1.runCode sourceContext (sourceFuel + 2) state.functionTrace.source + state.sourceStore state.source + (.letOp (.call address sourceArguments) (.ret (.var 0))) = + IxIR1.invoke sourceContext sourceFuel address values + state.sourceStore ∧ + Eval.Step context interpretation machine calleeMachine ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext calleeMachine + rewritten := by + dsimp only + have descendant : state.functionTrace.root.Descendant + (.tailCall site blockId input entryValueCount address sourceArguments + generated) := by + rw [← traceEq] + exact state.descendant + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.tailCall site blockId input entryValueCount address sourceArguments + generated) state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.tailCall site blockId input entryValueCount address sourceArguments + generated) state.sourceStore state.source state.frameRoots := by + rw [← traceEq] + exact state.ownership + let calleeFrame : Frame := + { definition := targetDefinition, values := values.toArray } + let calleeMachine : Machine := + { machine with control := .running calleeFrame state.stack } + obtain ⟨sourceEquation, targetStep, entryStores, calleeState⟩ := + attached.simulate_traced_tail_call_fn_enter_state + (sourceContext := sourceContext) (sourceFuel := sourceFuel) + (context := context) (interpretation := interpretation) + calleeMember descendant calleeMatch traceState state.stores + sourceResolved argumentArity targetDeclaration state.noCredits + state.control + have signatureAt := attached.target.targetSignature calleeMember + calleeMatch.owner + have calleeOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions calleeTrace.root + state.sourceStore values.reverse state.frameRoots := + Lower.Sim.SourceOwnershipAt.tailCallEntry (checked := attached.target) + state.member calleeMember descendant signatureAt ownership sourceResolved + have calleeRuntime : Lower.Sim.SourceRuntimeInvariant state.sourceStore + values.reverse := state.runtime.resolveAtomsReverse sourceResolved + have nextState : CompilerRunningState attached calleeMachine := + { functionTrace := calleeTrace + trace := calleeTrace.root + sourceStore := state.sourceStore + source := values.reverse + frameRoots := state.frameRoots + frame := calleeFrame + stack := state.stack + member := calleeMember + descendant := .refl + traceState := by simpa [calleeFrame] using calleeState + stores := by simpa [calleeMachine] using entryStores + runtime := calleeRuntime + ownership := calleeOwnership + stackRoots := state.stackRoots + callStack := state.callStack + history := by + apply state.history.advance + have resultWorld : state.functionTrace.source.result = + sourceDefinition.result := by + calc + state.functionTrace.source.result = + state.functionTrace.generated.signature.result := + state.functionTrace.sourceResult.symm + _ = calleeTrace.generated.signature.result := + (attached.target.tailCallResult state.member signatureAt + descendant).symm + _ = sourceDefinition.result := calleeTrace.sourceResult.trans + (congrArg IxIR1.FnDef.result calleeMatch.source) + simpa only [traceEq, Lower.CodeTrace.sourceCode, + calleeTrace.rootSourceCode, calleeMatch.source] using + (IxIR1.ExecutionHistory.tailCall sourceResolved sourceDeclaration + argumentArity.symm resultWorld) + image := state.image + control := by rfl + noCredits := by rfl } + exact ⟨nextState, sourceEquation, + by simpa [calleeMachine] using targetStep, + fun _rewritten => StableLiveAcceptedEntry.ofPcZero rfl rfl⟩ + +/-- Reconstruct addressed tail-call entry from a concrete target terminator. +The checked terminal syntax, inverse declaration lookup, and exact input map +together recover the source tail call and retained callee. -/ +theorem enterTailCallOfTarget + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + (targetDeclarations : context.declarations = + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas).declarations) + {block : Block} {address : Ixon.Address} {arguments : Array Atom} + {values : Array RVal} {definition : Function} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc = block.instructions.size) + (terminator : block.terminator = .tailCall address arguments) + (resolved : Eval.resolveAtoms state.frame.values arguments = .ok values) + (targetDeclaration : context.declarations address = some (.fn definition)) + (arity : values.size = definition.signature.params.size) : + let calleeFrame : Frame := { definition, values } + let calleeMachine : Machine := + { machine with control := .running calleeFrame state.stack } + ∃ _ : CompilerRunningState attached calleeMachine, + Eval.Step context interpretation machine calleeMachine ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext calleeMachine + rewritten := by + dsimp only + obtain ⟨site, blockId, input, entryValueCount, sourceAddress, + sourceArguments, generated, traceEq, addressEq, translated⟩ := + state.currentTailCall blockAt pc terminator + subst address + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.tailCall site blockId input entryValueCount sourceAddress + sourceArguments generated) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + obtain ⟨sourceDefinition, calleeTrace, calleeMember, calleeMatch, + sourceDeclaration⟩ := + attached.functionTrace_of_target_declaration sourceDeclarations + targetDeclarations targetDeclaration + have sourceCount : state.source.length = input.size := by + simpa [Lower.CodeTrace.sourceInputMap] using + traceState.target.sourceCount + have atoms := Lower.Sim.atomsRel_of_translateAtoms translated + have sourceResolved : + IxIR1.resolveAtoms state.source sourceArguments = .ok values.toList := + Lower.Sim.resolveAtoms_of_envRel_target + traceState.target.environments sourceCount atoms resolved + have sourceArity : sourceDefinition.arity = values.toList.length := by + calc + sourceDefinition.arity = calleeTrace.source.arity := + congrArg IxIR1.FnDef.arity calleeMatch.source.symm + _ = calleeTrace.generated.signature.params.size := + calleeTrace.sourceArity.symm + _ = definition.signature.params.size := by rw [calleeMatch.generated] + _ = values.size := arity.symm + _ = values.toList.length := by simp + obtain ⟨nextState, _sourceEquation, targetStep, acceptedEntry⟩ := + state.enterTailCall (sourceContext := sourceContext) + (sourceFuel := sourceFuel) (context := context) + (interpretation := interpretation) traceEq calleeMember calleeMatch + (by + change IxIR1.HPT.programDeclEnv + attached.source.lowering.result.artifacts _ = _ + rw [← sourceDeclarations] + exact sourceDeclaration) + sourceResolved sourceArity targetDeclaration + exact ⟨by simpa using nextState, by simpa using targetStep, + by simpa using acceptedEntry⟩ + +/-- Enter a recursive tail call with the existing continuation stack and +framed-root suffix unchanged. -/ +theorem enterTailCallSelf + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceArguments : Array IxIR1.Atom} {generated : Block} + (traceEq : state.trace = + .tailCallSelf site blockId input entryValueCount sourceArguments + generated) + {values : List RVal} + (sourceResolved : + IxIR1.resolveAtoms state.source sourceArguments = .ok values) + (argumentArity : state.functionTrace.source.arity = values.length) : + let calleeFrame : Frame := + { definition := state.frame.definition, values := values.toArray } + let calleeMachine : Machine := + { machine with control := .running calleeFrame state.stack } + ∃ _ : CompilerRunningState attached calleeMachine, + IxIR1.runCode sourceContext (sourceFuel + 2) state.functionTrace.source + state.sourceStore state.source + (.letOp (.callSelf sourceArguments) (.ret (.var 0))) = (do + let out ← IxIR1.runCode sourceContext sourceFuel + state.functionTrace.source state.sourceStore values.reverse + state.functionTrace.source.body + IxIR1.checkResultWorld state.functionTrace.source.result out) ∧ + Eval.Step context interpretation machine calleeMachine ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext calleeMachine + rewritten := by + dsimp only + have descendant : state.functionTrace.root.Descendant + (.tailCallSelf site blockId input entryValueCount sourceArguments + generated) := by + rw [← traceEq] + exact state.descendant + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.tailCallSelf site blockId input entryValueCount sourceArguments + generated) state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.tailCallSelf site blockId input entryValueCount sourceArguments + generated) state.sourceStore state.source state.frameRoots := by + rw [← traceEq] + exact state.ownership + let calleeFrame : Frame := + { definition := state.frame.definition, values := values.toArray } + let calleeMachine : Machine := + { machine with control := .running calleeFrame state.stack } + obtain ⟨sourceEquation, targetStep, entryStores, calleeState⟩ := + attached.simulate_traced_tail_call_self_enter_state + (sourceContext := sourceContext) (sourceFuel := sourceFuel) + (context := context) (interpretation := interpretation) + state.member descendant traceState state.stores sourceResolved + argumentArity state.noCredits state.control + have calleeOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions state.functionTrace.root + state.sourceStore values.reverse state.frameRoots := + Lower.Sim.SourceOwnershipAt.tailCallSelfEntry + (checked := attached.target) state.member descendant ownership + sourceResolved + have calleeRuntime : Lower.Sim.SourceRuntimeInvariant state.sourceStore + values.reverse := state.runtime.resolveAtomsReverse sourceResolved + have nextState : CompilerRunningState attached calleeMachine := + { functionTrace := state.functionTrace + trace := state.functionTrace.root + sourceStore := state.sourceStore + source := values.reverse + frameRoots := state.frameRoots + frame := calleeFrame + stack := state.stack + member := state.member + descendant := .refl + traceState := by simpa [calleeFrame] using calleeState + stores := by simpa [calleeMachine] using entryStores + runtime := calleeRuntime + ownership := calleeOwnership + stackRoots := state.stackRoots + callStack := state.callStack + history := by + apply state.history.advance + simpa only [traceEq, Lower.CodeTrace.sourceCode, + state.functionTrace.rootSourceCode] using + (IxIR1.ExecutionHistory.tailCallSelf sourceResolved argumentArity.symm) + image := state.image + control := by rfl + noCredits := by rfl } + exact ⟨nextState, sourceEquation, + by simpa [calleeMachine] using targetStep, + fun _rewritten => StableLiveAcceptedEntry.ofPcZero rfl rfl⟩ + +/-- Reconstruct recursive self-tail entry from the concrete target +terminator. Checked syntax and the exact environment map reflect the target +argument vector back to the source call. -/ +theorem enterTailCallSelfOfTarget + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {block : Block} {targetArguments : Array Atom} {values : Array RVal} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc = block.instructions.size) + (terminator : block.terminator = .tailCallSelf targetArguments) + (resolved : Eval.resolveAtoms state.frame.values targetArguments = + .ok values) + (argumentArity : values.size = + state.frame.definition.signature.params.size) : + let calleeFrame : Frame := + { definition := state.frame.definition, values := values } + let calleeMachine : Machine := + { machine with control := .running calleeFrame state.stack } + ∃ _ : CompilerRunningState attached calleeMachine, + Eval.Step context interpretation machine calleeMachine := by + dsimp only + obtain ⟨site, blockId, input, entryValueCount, sourceArguments, generated, + traceEq, translated⟩ := + state.currentTailCallSelf blockAt pc terminator + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.tailCallSelf site blockId input entryValueCount sourceArguments + generated) state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have sourceCount : state.source.length = input.size := by + simpa [Lower.CodeTrace.sourceInputMap] using + traceState.target.sourceCount + have atoms := Lower.Sim.atomsRel_of_translateAtoms translated + have sourceResolved : IxIR1.resolveAtoms state.source sourceArguments = + .ok values.toList := + Lower.Sim.resolveAtoms_of_envRel_target traceState.target.environments + sourceCount atoms resolved + have sourceArity : state.functionTrace.source.arity = values.toList.length := by + calc + state.functionTrace.source.arity = + state.functionTrace.generated.signature.params.size := + state.functionTrace.sourceArity.symm + _ = state.frame.definition.signature.params.size := by + rw [traceState.target.definition] + _ = values.size := argumentArity.symm + _ = values.toList.length := by simp + obtain ⟨nextState, _sourceEquation, targetStep, _acceptedEntry⟩ := + state.enterTailCallSelf (sourceContext := sourceContext) + (sourceFuel := sourceFuel) (context := context) + (interpretation := interpretation) traceEq sourceResolved sourceArity + exact ⟨by simpa using nextState, by simpa using targetStep⟩ + +private theorem fetchedPrefixValues_succ + {parameters fields : Array RVal} {count : Nat} + (bound : count < fields.size) : + (fetchedPrefixValues parameters fields count).push fields[count] = + fetchedPrefixValues parameters fields (count + 1) := by + apply Array.toList_inj.mp + simp only [fetchedPrefixValues, Array.toList_push, Array.toList_append] + rw [← List.take_append_getElem (l := fields.toList) + (i := count) (by simpa using bound)] + simp [List.append_assoc] + +/-- Thread the compiler invariant through every recognized field fetch of an +accepted baseline prefix. -/ +theorem fetchPrefixState + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {block : Block} + (site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block) + {parameters fields : Array RVal} {location : Nat} + {box : IxIR1.NodeBox} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc = 0) + (frameValues : state.frame.values = parameters) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (sourceResolved : resolveAtom parameters (.reg site.shape.source) = + .ok (.loc location)) + (boxAt : machine.store.get? location = some box) + (node : box.node = .ctorN site.shape.sourceConstructor fields) : + let nextFrame : Frame := + { state.frame with + pc := site.shape.fieldCount + values := parameters ++ fields } + let nextMachine : Machine := + { machine with control := .running nextFrame state.stack } + ∃ _ : CompilerRunningState attached nextMachine, + Steps context interpretation site.shape.fieldCount machine nextMachine := by + dsimp only + rcases box with ⟨boxWorld, boxRc, boxNode⟩ + dsimp only at node + subst boxNode + have initialFrameEq : + ({ state.frame with pc := 0, values := parameters } : Frame) = + state.frame := by + generalize state.frame = original at pc frameValues ⊢ + cases original + simp only [Frame.mk.injEq, true_and] + exact ⟨pc.symm, frameValues.symm, True.intro⟩ + let atCount (count : Nat) : Machine := + { machine with + control := .running + { state.frame with + pc := count + values := fetchedPrefixValues parameters fields count } + state.stack } + have loop : ∀ count, count ≤ site.shape.fieldCount → + ∃ _ : CompilerRunningState attached (atCount count), + Steps context interpretation count machine (atCount count) := by + intro count countLe + induction count with + | zero => + have atZero : atCount 0 = machine := by + have controlEq : (atCount 0).control = machine.control := by + simpa [atCount, fetchedPrefixValues, initialFrameEq] using + state.control.symm + cases machine + simpa [atCount] using controlEq + rw [atZero] + exact ⟨state, Steps.refl machine⟩ + | succ count ih => + have countBound : count < site.shape.fieldCount := by omega + obtain ⟨prefixState, prefixSteps⟩ := ih (by omega) + let currentFrame : Frame := + { state.frame with + pc := count + values := fetchedPrefixValues parameters fields count } + have controlEq : + (.running prefixState.frame prefixState.stack : Control) = + .running currentFrame state.stack := by + calc + _ = (atCount count).control := prefixState.control.symm + _ = _ := by rfl + have prefixFrameEq : prefixState.frame = currentFrame := by + injection controlEq + have prefixStackEq : prefixState.stack = state.stack := by + injection controlEq + have currentBlockAt : + prefixState.frame.definition.blocks[prefixState.frame.block]? = + some block := by + simpa [prefixFrameEq, currentFrame] using blockAt + have instructionAt := site.fits.fetches count countBound + obtain ⟨pcBound, instruction⟩ := + Array.getElem?_eq_some_iff.mp instructionAt + have currentPcBound : + prefixState.frame.pc < block.instructions.size := by + simpa [prefixFrameEq, currentFrame] using pcBound + have currentInstruction : + block.instructions[prefixState.frame.pc] = + .fetch (.reg site.shape.source) + site.shape.sourceConstructor count := by + simpa [prefixFrameEq, currentFrame] using instruction + have resolved : resolveAtom prefixState.frame.values + (.reg site.shape.source) = .ok (.loc location) := by + simpa [prefixFrameEq, currentFrame, fetchedPrefixValues, + resolveAtom, Array.getElem?_append, parameterCount, + site.fits.sourceBound] using sourceResolved + have currentBoxAt : (atCount count).store.get? location = + some ⟨boxWorld, boxRc, + .ctorN site.shape.sourceConstructor fields⟩ := by + simpa [atCount] using boxAt + have fieldBound : count < fields.size := by + simpa [fieldCount] using countBound + have fieldAt : fields[count]? = some fields[count] := + Array.getElem?_eq_some_iff.mpr ⟨fieldBound, rfl⟩ + obtain ⟨nextState, targetStep⟩ := + prefixState.stepFetchOfTarget (sourceContext := sourceContext) + (sourceFuel := 0) (context := context) + (interpretation := interpretation) sourceDeclarations + currentBlockAt currentPcBound currentInstruction resolved + currentBoxAt fieldAt + have nextMachineEq : + ({ atCount count with + control := .running + { prefixState.frame with + pc := prefixState.frame.pc + 1 + values := prefixState.frame.values.push fields[count] } + prefixState.stack } : Machine) = atCount (count + 1) := by + simp [atCount, prefixFrameEq, prefixStackEq, currentFrame, + fetchedPrefixValues_succ fieldBound] + rw [nextMachineEq] at nextState targetStep + exact ⟨nextState, by + simpa [Nat.succ_eq_add_one] using + prefixSteps.trans (targetStep.toSteps prefixState.control)⟩ + obtain ⟨nextState, steps⟩ := + loop site.shape.fieldCount (Nat.le_refl _) + have allFields : + (fields.toList.take site.shape.fieldCount).toArray = fields := by + rw [← fieldCount] + change (fields.toList.take fields.toList.length).toArray = fields + rw [List.take_length] + have atFinal : atCount site.shape.fieldCount = + { machine with + control := .running + { state.frame with + pc := site.shape.fieldCount + values := parameters ++ fields } + state.stack } := by + simp [atCount, fetchedPrefixValues, allFields] + rw [atFinal] at nextState steps + exact ⟨nextState, steps⟩ + +/-- Thread the compiler invariant through an arbitrary suffix of recognized +shared retains after the field-fetch phase. -/ +theorem retainSuffixState + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {block : Block} + (site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block) + {parameters fields : Array RVal} {processed remaining : List RVal} + {finalStore : Store} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (split : fields.toList = processed ++ remaining) + (pc : state.frame.pc = site.shape.fieldCount + processed.length) + (frameValues : state.frame.values = + parameters ++ fields ++ processed.toArray) + (retained : RetainSharedMany machine.store remaining.toArray finalStore) : + let nextFrame : Frame := + { state.frame with + pc := site.shape.fieldCount + (processed ++ remaining).length + values := parameters ++ fields ++ + (processed ++ remaining).toArray } + let nextMachine : Machine := + { store := finalStore + heapFuel := machine.heapFuel + control := .running nextFrame state.stack } + ∃ _ : CompilerRunningState attached nextMachine, + Steps context interpretation remaining.length machine nextMachine := by + dsimp only + induction remaining generalizing processed machine with + | nil => + change (.ok machine.store : Except Eval.Error Store) = .ok finalStore + at retained + have finalStoreEq : finalStore = machine.store := + (Except.ok.inj retained).symm + subst finalStore + have nextFrameEq : + ({ state.frame with + pc := site.shape.fieldCount + (processed ++ []).length + values := parameters ++ fields ++ + (processed ++ []).toArray } : Frame) = state.frame := by + generalize state.frame = original at pc frameValues ⊢ + cases original + simp only [List.append_nil, Frame.mk.injEq, true_and] + exact ⟨pc.symm, frameValues.symm, True.intro⟩ + have targetEq : + ({ store := machine.store + heapFuel := machine.heapFuel + control := .running + { state.frame with + pc := site.shape.fieldCount + (processed ++ []).length + values := parameters ++ fields ++ + (processed ++ []).toArray } + state.stack } : Machine) = machine := by + rw [nextFrameEq] + cases machine + simpa using state.control.symm + rw [targetEq] + exact ⟨state, Steps.refl machine⟩ + | cons value remaining ih => + obtain ⟨middle, headRetained, tailRetained⟩ := + RetainSharedMany.cons_inv retained + have fieldIndexBound : processed.length < site.shape.fieldCount := by + have lengths := congrArg List.length split + simp only [List.length_append, List.length_cons] at lengths + have fieldsLength : fields.toList.length = site.shape.fieldCount := by + simp [fieldCount] + omega + have fieldAt : fields[processed.length]? = some value := by + rw [Array.getElem?_eq_some_iff] + refine ⟨?_, ?_⟩ + · simpa [fieldCount] using fieldIndexBound + · have listAt : fields.toList[processed.length]? = some value := by + rw [split, List.getElem?_append_right (Nat.le_refl _)] + simp + exact Option.some.inj + ((List.getElem?_eq_getElem (l := fields.toList) + (i := processed.length) (by simpa [fieldCount] using + fieldIndexBound)).symm.trans listAt) + have fieldEq : fields[processed.length] = value := + (Array.getElem?_eq_some_iff.mp fieldAt).2 + have resolved : resolveAtom state.frame.values + (.reg (site.shape.parameterCount + processed.length)) = + .ok value := by + simp [frameValues, resolveAtom, Array.getElem?_append, + parameterCount, fieldCount, fieldIndexBound, fieldEq, + show ¬site.shape.parameterCount + processed.length < + site.shape.parameterCount by omega] + have instructionAt := site.fits.retains processed.length fieldIndexBound + obtain ⟨pcBound, instruction⟩ := + Array.getElem?_eq_some_iff.mp instructionAt + have currentPcBound : state.frame.pc < block.instructions.size := by + simpa [pc] using pcBound + have currentInstruction : block.instructions[state.frame.pc] = + .retainShared + (.reg (site.shape.parameterCount + processed.length)) := by + simpa [pc] using instruction + obtain ⟨headState, headStep⟩ := + state.stepRetainOfTarget (sourceContext := sourceContext) + (sourceFuel := 0) (context := context) + (interpretation := interpretation) sourceDeclarations blockAt + currentPcBound currentInstruction resolved headRetained + let headFrame : Frame := + { state.frame with + pc := state.frame.pc + 1 + values := state.frame.values.push value } + let headMachine : Machine := + { store := middle + heapFuel := machine.heapFuel + control := .running headFrame state.stack } + have headControlEq : + (.running headState.frame headState.stack : Control) = + .running headFrame state.stack := by + calc + _ = headMachine.control := headState.control.symm + _ = _ := by rfl + have headFrameEq : headState.frame = headFrame := by + injection headControlEq + have headStackEq : headState.stack = state.stack := by + injection headControlEq + have nextBlockAt : + headState.frame.definition.blocks[headState.frame.block]? = + some block := by + simpa [headFrameEq, headFrame] using blockAt + have nextPc : headState.frame.pc = + site.shape.fieldCount + (processed ++ [value]).length := by + simp [headFrameEq, headFrame, pc, Nat.add_assoc] + have nextValues : headState.frame.values = + parameters ++ fields ++ (processed ++ [value]).toArray := by + simp [headFrameEq, headFrame, frameValues] + have nextSplit : fields.toList = + (processed ++ [value]) ++ remaining := by + simpa [List.append_assoc] using split + obtain ⟨nextState, tailSteps⟩ := + ih headState nextBlockAt nextSplit nextPc nextValues tailRetained + rw [headFrameEq, headStackEq] at nextState tailSteps + have headStep' : Step context interpretation machine headMachine := by + simpa [headMachine, headFrame] using headStep + exact ⟨by simpa [headMachine, headFrame, Nat.add_assoc] using nextState, + by + simpa [headMachine, headFrame, Nat.add_assoc, Nat.add_comm] using + (headStep'.toSteps state.control).trans tailSteps⟩ + +/-- Execute every recognized shared retain after the accepted field-fetch +prefix while retaining the compiler witness at the exact endpoint. -/ +theorem retainPrefixState + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {block : Block} + (site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block) + {parameters fields : Array RVal} {retainedStore : Store} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (pc : state.frame.pc = site.shape.fieldCount) + (frameValues : state.frame.values = parameters ++ fields) + (retained : RetainSharedMany machine.store fields retainedStore) : + let nextFrame : Frame := + { state.frame with + pc := 2 * site.shape.fieldCount + values := baselinePrefixValues parameters fields } + let nextMachine : Machine := + { store := retainedStore + heapFuel := machine.heapFuel + control := .running nextFrame state.stack } + ∃ _ : CompilerRunningState attached nextMachine, + Steps context interpretation site.shape.fieldCount machine + nextMachine := by + dsimp only + have result := state.retainSuffixState + (sourceContext := sourceContext) (context := context) + (interpretation := interpretation) sourceDeclarations site blockAt + parameterCount fieldCount (processed := []) (remaining := fields.toList) + (by simp) (by simpa using pc) (by simpa using frameValues) + (by simpa using retained) + obtain ⟨nextState, steps⟩ := result + simp at nextState steps + have pcEq : site.shape.fieldCount + fields.size = + 2 * site.shape.fieldCount := by + rw [fieldCount, Nat.two_mul] + rw [pcEq] at nextState + exact ⟨by simpa [baselinePrefixValues] using nextState, + by simpa [baselinePrefixValues, fieldCount, Nat.two_mul, + Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using steps⟩ + +/-- The complete accepted baseline prefix preserves the compiler invariant +through every fetch, retain, recursive release, allocation, and recursive +self-tail entry. Its endpoint is packaged as the positive compiler macro used +to attach the semantic reuse simulation. -/ +theorem acceptedPrefixCompilerMacroAtOfFetched + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (frame : Frame) (stack : List Continuation) + (contextSchemas : context.schemas = + attached.target.artifact.validationContext.schemas) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (baselineDefinition : frame.definition = source) + {helperOffset : Nat} {block : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block} + (accepted : Reuse.FunctionDecisions.At rewrite.decisions frame.block + helperOffset block (.accepted site)) + {parameters fields newFields callValues : Array RVal} + {location remaining : Nat} + {retainedStore releasedStore : Store} + {allocationSchema : CtorSchema} + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (sourceResolved : resolveAtom parameters (.reg site.shape.source) = + .ok (.loc location)) + (retained : RetainSharedMany machine.store fields retainedStore) + (released : releaseShared machine.heapFuel retainedStore + (.loc location) = .ok (releasedStore, remaining)) + (schemaAt : context.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (allocationResolved : resolveAtoms + (baselinePrefixValues parameters fields) + site.shape.allocationArguments = .ok newFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc (releasedStore.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields)).2)) + site.shape.tailArguments = .ok callValues) + (arity : callValues.size = source.signature.params.size) + (fetchState : CompilerRunningState attached + { machine with + control := .running + { frame with + pc := site.shape.fieldCount + values := parameters ++ fields } + stack }) + (fetchSteps : Steps context interpretation site.shape.fieldCount machine + { machine with + control := .running + { frame with + pc := site.shape.fieldCount + values := parameters ++ fields } + stack }) : + CompilerAcceptedMacroStepAt attached context interpretation + (2 * site.shape.fieldCount + 3) machine := by + obtain ⟨sourceAt, _resetAt, _hotAt, _coldAt⟩ := + rewrite.acceptedAt accepted + have blockAt : frame.definition.blocks[frame.block]? = + some block := by + rw [baselineDefinition] + exact sourceAt + let afterFetchFrame : Frame := + { frame with + pc := site.shape.fieldCount + values := parameters ++ fields } + let afterFetch : Machine := + { machine with control := .running afterFetchFrame stack } + have fetchControlEq : + (.running fetchState.frame fetchState.stack : Control) = + .running afterFetchFrame stack := by + calc + _ = afterFetch.control := fetchState.control.symm + _ = _ := by rfl + have fetchFrameEq : fetchState.frame = afterFetchFrame := by + injection fetchControlEq + have fetchStackEq : fetchState.stack = stack := by + injection fetchControlEq + have fetchBlockAt : + fetchState.frame.definition.blocks[fetchState.frame.block]? = + some block := by + simpa [fetchFrameEq, afterFetchFrame] using blockAt + let afterRetainFrame : Frame := + { frame with + pc := 2 * site.shape.fieldCount + values := baselinePrefixValues parameters fields } + let afterRetains : Machine := + { store := retainedStore + heapFuel := machine.heapFuel + control := .running afterRetainFrame stack } + obtain ⟨retainStateRaw, retainStepsRaw⟩ := + fetchState.retainPrefixState (sourceContext := sourceContext) + (context := context) (interpretation := interpretation) + sourceDeclarations site fetchBlockAt parameterCount fieldCount + (by simp [fetchFrameEq, afterFetchFrame]) + (by simp [fetchFrameEq, afterFetchFrame]) + (by simpa [afterFetch] using retained) + have retainMachineEq : + ({ store := retainedStore + heapFuel := afterFetch.heapFuel + control := .running + { fetchState.frame with + pc := 2 * site.shape.fieldCount + values := baselinePrefixValues parameters fields } + fetchState.stack } : Machine) = afterRetains := by + simp [afterFetch, afterRetains, fetchFrameEq, fetchStackEq, + afterFetchFrame, afterRetainFrame] + rw [retainMachineEq] at retainStateRaw retainStepsRaw + let retainState : CompilerRunningState attached afterRetains := retainStateRaw + have retainControlEq : + (.running retainState.frame retainState.stack : Control) = + .running afterRetainFrame stack := by + calc + _ = afterRetains.control := retainState.control.symm + _ = _ := by rfl + have retainFrameEq : retainState.frame = afterRetainFrame := by + injection retainControlEq + have retainStackEq : retainState.stack = stack := by + injection retainControlEq + have retainedSourceResolved : resolveAtom retainState.frame.values + (.reg site.shape.source) = .ok (.loc location) := by + simpa [retainFrameEq, afterRetainFrame, baselinePrefixValues, + resolveAtom, Array.getElem?_append, parameterCount, + site.fits.sourceBound] using sourceResolved + have retainBaselineDefinition : retainState.frame.definition = source := by + simpa [retainFrameEq, afterRetainFrame] using baselineDefinition + have retainAccepted : Reuse.FunctionDecisions.At rewrite.decisions + retainState.frame.block helperOffset block (.accepted site) := by + simpa [retainFrameEq, afterRetainFrame] using accepted + have retainPc : retainState.frame.pc = site.shape.releasePosition := by + simp [retainFrameEq, afterRetainFrame, site.fits.releasePosition] + let afterReleaseFrame : Frame := + { frame with + pc := 2 * site.shape.fieldCount + 1 + values := baselinePrefixValues parameters fields } + let afterRelease : Machine := + { store := releasedStore + heapFuel := remaining + control := .running afterReleaseFrame stack } + obtain ⟨releaseStateRaw, releaseStepRaw⟩ := + retainState.stepAcceptedReleaseOfTarget + (sourceContext := sourceContext) (context := context) + (interpretation := interpretation) rewrite retainBaselineDefinition + retainAccepted retainPc sourceDeclarations retainedSourceResolved + (by simpa [afterRetains] using released) + have releaseMachineEq : + ({ store := releasedStore + heapFuel := remaining + control := .running + { retainState.frame with pc := retainState.frame.pc + 1 } + retainState.stack } : Machine) = afterRelease := by + simp [afterRelease, afterReleaseFrame, retainFrameEq, retainStackEq, + afterRetainFrame] + rw [releaseMachineEq] at releaseStateRaw releaseStepRaw + let releaseState : CompilerRunningState attached afterRelease := + releaseStateRaw + have releaseControlEq : + (.running releaseState.frame releaseState.stack : Control) = + .running afterReleaseFrame stack := by + calc + _ = afterRelease.control := releaseState.control.symm + _ = _ := by rfl + have releaseFrameEq : releaseState.frame = afterReleaseFrame := by + injection releaseControlEq + have releaseStackEq : releaseState.stack = stack := by + injection releaseControlEq + have releaseBlockAt : + releaseState.frame.definition.blocks[releaseState.frame.block]? = + some block := by + simpa [releaseFrameEq, afterReleaseFrame] using blockAt + have allocationAt := site.fits.allocation + rw [site.fits.releasePosition] at allocationAt + obtain ⟨allocationPcBound, allocationInstruction⟩ := + Array.getElem?_eq_some_iff.mp allocationAt + have releasePcBound : releaseState.frame.pc < block.instructions.size := by + simpa [releaseFrameEq, afterReleaseFrame] using allocationPcBound + have releaseInstruction : block.instructions[releaseState.frame.pc] = + .alloc .shared site.shape.allocationConstructor + site.shape.allocationArguments := by + simpa [releaseFrameEq, afterReleaseFrame] using allocationInstruction + have releaseAllocationResolved : resolveAtoms releaseState.frame.values + site.shape.allocationArguments = .ok newFields := by + simpa [releaseFrameEq, afterReleaseFrame] using allocationResolved + let allocation := releasedStore.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + let afterAllocationFrame : Frame := + { frame with + pc := 2 * site.shape.fieldCount + 2 + values := (baselinePrefixValues parameters fields).push + (.loc allocation.2) } + let afterAllocation : Machine := + { store := allocation.1 + heapFuel := remaining + control := .running afterAllocationFrame stack } + obtain ⟨allocationStateRaw, allocationStepRaw, _allocationEntry⟩ := + releaseState.stepAllocOfTarget (sourceContext := sourceContext) + (sourceFuel := 0) (context := context) + (interpretation := interpretation) contextSchemas sourceDeclarations + releaseBlockAt releasePcBound releaseInstruction schemaAt + releaseAllocationResolved + have allocationMachineEq : + ({ store := allocation.1 + heapFuel := afterRelease.heapFuel + control := .running + { releaseState.frame with + pc := releaseState.frame.pc + 1 + values := releaseState.frame.values.push (.loc allocation.2) } + releaseState.stack } : Machine) = afterAllocation := by + simp [afterRelease, afterAllocation, afterAllocationFrame, + releaseFrameEq, releaseStackEq, afterReleaseFrame, allocation] + rw [allocationMachineEq] at allocationStateRaw allocationStepRaw + let allocationState : CompilerRunningState attached afterAllocation := + allocationStateRaw + have allocationControlEq : + (.running allocationState.frame allocationState.stack : Control) = + .running afterAllocationFrame stack := by + calc + _ = afterAllocation.control := allocationState.control.symm + _ = _ := by rfl + have allocationFrameEq : allocationState.frame = afterAllocationFrame := by + injection allocationControlEq + have allocationStackEq : allocationState.stack = stack := by + injection allocationControlEq + have allocationBlockAt : + allocationState.frame.definition.blocks[allocationState.frame.block]? = + some block := by + simpa [allocationFrameEq, afterAllocationFrame] using blockAt + have allocationPc : allocationState.frame.pc = block.instructions.size := by + simpa [allocationFrameEq, afterAllocationFrame] using + site.fits.instructionCount.symm + have allocationTerminator : block.terminator = + .tailCallSelf site.shape.tailArguments := site.fits.terminator + have allocationTailResolved : resolveAtoms allocationState.frame.values + site.shape.tailArguments = .ok callValues := by + simpa [allocationFrameEq, afterAllocationFrame, allocation] using + tailResolved + have allocationArity : callValues.size = + allocationState.frame.definition.signature.params.size := by + simpa [allocationFrameEq, afterAllocationFrame, baselineDefinition] using + arity + let finalFrame : Frame := + { definition := source, values := callValues } + let finalMachine : Machine := + { store := allocation.1 + heapFuel := remaining + control := .running finalFrame stack } + obtain ⟨finalStateRaw, tailStepRaw⟩ := + allocationState.enterTailCallSelfOfTarget + (sourceContext := sourceContext) (sourceFuel := 0) + (context := context) (interpretation := interpretation) + allocationBlockAt allocationPc allocationTerminator + allocationTailResolved allocationArity + have finalMachineEq : + ({ afterAllocation with + control := .running + { definition := allocationState.frame.definition + values := callValues } + allocationState.stack } : Machine) = finalMachine := by + simp [afterAllocation, finalMachine, finalFrame, allocationFrameEq, + allocationStackEq, afterAllocationFrame, baselineDefinition] + rw [finalMachineEq] at finalStateRaw tailStepRaw + have fetchRetainSteps : Steps context interpretation + (2 * site.shape.fieldCount) machine afterRetains := by + simpa [Nat.two_mul] using fetchSteps.trans retainStepsRaw + have allSteps : Steps context interpretation + (2 * site.shape.fieldCount + 3) machine finalMachine := by + have releaseOne := releaseStepRaw.toSteps retainState.control + have allocationOne := allocationStepRaw.toSteps releaseState.control + have tailOne := tailStepRaw.toSteps allocationState.control + simpa [Nat.add_assoc] using + (((fetchRetainSteps.trans releaseOne).trans allocationOne).trans tailOne) + exact .intro (by omega) finalMachine allSteps (.running finalStateRaw) + (fun {_rewrittenTarget} _related => + StableLiveAcceptedEntry.ofPcZero rfl rfl) + +/-- At a traced zero-PC entry, construct the fetched compiler state and +reuse the same retain/release/allocation/tail composition as a case child. -/ +theorem acceptedPrefixCompilerMacroAt + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + (contextSchemas : context.schemas = + attached.target.artifact.validationContext.schemas) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (baselineDefinition : state.frame.definition = source) + {helperOffset : Nat} {block : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block} + (accepted : Reuse.FunctionDecisions.At rewrite.decisions state.frame.block + helperOffset block (.accepted site)) + (pc : state.frame.pc = 0) + {parameters fields newFields callValues : Array RVal} + {location rc remaining : Nat} + {retainedStore releasedStore : Store} + {allocationSchema : CtorSchema} + (frameValues : state.frame.values = parameters) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (sourceResolved : resolveAtom parameters (.reg site.shape.source) = + .ok (.loc location)) + (boxAt : machine.store.get? location = some + ⟨.shared, rc, .ctorN site.shape.sourceConstructor fields⟩) + (retained : RetainSharedMany machine.store fields retainedStore) + (released : releaseShared machine.heapFuel retainedStore + (.loc location) = .ok (releasedStore, remaining)) + (schemaAt : context.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (allocationResolved : resolveAtoms + (baselinePrefixValues parameters fields) + site.shape.allocationArguments = .ok newFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc (releasedStore.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields)).2)) + site.shape.tailArguments = .ok callValues) + (arity : callValues.size = source.signature.params.size) : + CompilerAcceptedMacroStepAt attached context interpretation + (2 * site.shape.fieldCount + 3) machine := by + have blockAt : state.frame.definition.blocks[state.frame.block]? = + some block := by + rw [baselineDefinition] + exact (rewrite.acceptedAt accepted).1 + obtain ⟨fetchState, fetchSteps⟩ := + state.fetchPrefixState (sourceContext := sourceContext) + (context := context) (interpretation := interpretation) + sourceDeclarations site blockAt pc frameValues parameterCount fieldCount + sourceResolved boxAt rfl + exact acceptedPrefixCompilerMacroAtOfFetched state.frame state.stack + contextSchemas sourceDeclarations rewrite baselineDefinition accepted + parameterCount fieldCount sourceResolved retained released schemaAt + allocationResolved tailResolved arity fetchState fetchSteps + +/-- Compatibility wrapper that forgets the fixed length and accepted-entry +phase while retaining the original compiler-macro API. -/ +theorem acceptedPrefixCompilerMacro + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + (contextSchemas : context.schemas = + attached.target.artifact.validationContext.schemas) + (sourceDeclarations : sourceContext.decls = + IxIR1.HPT.programDeclEnv attached.source.lowering.result.artifacts) + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (baselineDefinition : state.frame.definition = source) + {helperOffset : Nat} {block : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block} + (accepted : Reuse.FunctionDecisions.At rewrite.decisions state.frame.block + helperOffset block (.accepted site)) + (pc : state.frame.pc = 0) + {parameters fields newFields callValues : Array RVal} + {location rc remaining : Nat} + {retainedStore releasedStore : Store} + {allocationSchema : CtorSchema} + (frameValues : state.frame.values = parameters) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (sourceResolved : resolveAtom parameters (.reg site.shape.source) = + .ok (.loc location)) + (boxAt : machine.store.get? location = some + ⟨.shared, rc, .ctorN site.shape.sourceConstructor fields⟩) + (retained : RetainSharedMany machine.store fields retainedStore) + (released : releaseShared machine.heapFuel retainedStore + (.loc location) = .ok (releasedStore, remaining)) + (schemaAt : context.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (allocationResolved : resolveAtoms + (baselinePrefixValues parameters fields) + site.shape.allocationArguments = .ok newFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc (releasedStore.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields)).2)) + site.shape.tailArguments = .ok callValues) + (arity : callValues.size = source.signature.params.size) : + CompilerMacroStep attached context interpretation machine := by + exact (state.acceptedPrefixCompilerMacroAt contextSchemas + sourceDeclarations rewrite baselineDefinition accepted pc frameValues + parameterCount fieldCount sourceResolved boxAt retained released schemaAt + allocationResolved tailResolved arity).compilerMacro + +/-- Advance a compiler running state through the zero arm of a checked Nat +switch. The generated edge transfer and exact recursive child are recovered +entirely from the lowering trace. -/ +theorem stepSwitchNatZero + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {alternatives : Array IxIR1.Alt} + {targetScrutinee : Atom} {generated : Block} + {outgoing : List Lower.EdgeTrace} {children : List Lower.CodeTrace} + (traceEq : state.trace = + .switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children) + (sourceResolved : IxIR1.resolveAtom state.source sourceScrutinee = + .ok (.lit (.nat 0))) : + ∃ childFrame, + let nextMachine : Machine := + { machine with control := .running childFrame state.stack } + ∃ _ : CompilerRunningState attached nextMachine, + Eval.Step context interpretation machine nextMachine ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext nextMachine + rewritten := by + have descendant : state.functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children) := by + rw [← traceEq] + exact state.descendant + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children) + state.sourceStore state.source state.frameRoots := by + rw [← traceEq] + exact state.ownership + obtain ⟨constructors, peel, branches, childFrame, terminator, _edgeMember, + childMember, sourceAlternative, childSource, childCode, targetStep, + _targetPreserving, childNoCredits, childTarget⟩ := + Lower.Sim.simulate_traced_switch_nat_zero_state descendant + traceState.target sourceResolved state.control state.noCredits + have nextTraceState := traceState.natZeroChild sourceAlternative childSource + childCode childTarget + have parentEnvironments : Lower.Sim.EnvRel state.source + state.frame.values input := by + simpa [Lower.CodeTrace.sourceInputMap] using + traceState.target.environments + have nextOwnership := Lower.Sim.SourceOwnershipAt.switchNatZero + attached.target state.member descendant terminator branches ownership + parentEnvironments + have nextDescendant : state.functionTrace.root.Descendant + branches.zeroChild := + .step descendant childMember + let nextMachine : Machine := + { machine with control := .running childFrame state.stack } + have nextState : CompilerRunningState attached nextMachine := + { functionTrace := state.functionTrace + trace := branches.zeroChild + sourceStore := state.sourceStore + source := state.source + frameRoots := state.frameRoots + frame := childFrame + stack := state.stack + member := state.member + descendant := nextDescendant + traceState := nextTraceState + stores := by simpa [nextMachine] using state.stores + runtime := state.runtime + ownership := nextOwnership + stackRoots := state.stackRoots + callStack := state.callStack + history := by + apply state.history.advance + simpa [traceEq, Lower.CodeTrace.sourceCode, childCode] using + (IxIR1.ExecutionHistory.caseNatZero (tag := 0) sourceResolved + (sourceAlternativeFind sourceAlternative)) + image := state.image + control := by rfl + noCredits := childNoCredits } + have nextPc : childFrame.pc = 0 := + nextTraceState.target.pc.trans branches.zero.childPc + exact ⟨childFrame, nextState, + by simpa [nextMachine] using targetStep, + fun _rewritten => StableLiveAcceptedEntry.ofPcZero rfl nextPc⟩ + +/-- Advance a compiler running state through the successor arm of a checked +Nat switch. The peeled predecessor becomes the scalar head of the recursive +source environment and the checked ownership vector shifts with it. -/ +theorem stepSwitchNatSucc + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount predecessor : Nat} + {sourceScrutinee : IxIR1.Atom} {alternatives : Array IxIR1.Alt} + {targetScrutinee : Atom} {generated : Block} + {outgoing : List Lower.EdgeTrace} {children : List Lower.CodeTrace} + (traceEq : state.trace = + .switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children) + (sourceResolved : IxIR1.resolveAtom state.source sourceScrutinee = + .ok (.lit (.nat (predecessor + 1)))) : + ∃ childFrame, + let nextMachine : Machine := + { machine with control := .running childFrame state.stack } + ∃ _ : CompilerRunningState attached nextMachine, + Eval.Step context interpretation machine nextMachine ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext nextMachine + rewritten := by + have descendant : state.functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children) := by + rw [← traceEq] + exact state.descendant + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children) + state.sourceStore state.source state.frameRoots := by + rw [← traceEq] + exact state.ownership + obtain ⟨constructors, peel, branches, childFrame, terminator, _edgeMember, + childMember, sourceAlternative, childSource, childCode, targetStep, + _targetPreserving, childNoCredits, childTarget⟩ := + Lower.Sim.simulate_traced_switch_nat_succ_state descendant + traceState.target sourceResolved state.control state.noCredits + have nextTraceState := traceState.natSuccChild sourceAlternative childSource + childCode sourceResolved childTarget + have parentEnvironments : Lower.Sim.EnvRel state.source + state.frame.values input := by + simpa [Lower.CodeTrace.sourceInputMap] using + traceState.target.environments + have nextOwnership := Lower.Sim.SourceOwnershipAt.switchNatSucc + attached.target state.member descendant terminator branches ownership + parentEnvironments (predecessor := predecessor) + have nextRuntime := state.runtime.natSuccessor predecessor + have nextDescendant : state.functionTrace.root.Descendant + branches.succChild := + .step descendant childMember + let nextMachine : Machine := + { machine with control := .running childFrame state.stack } + have nextState : CompilerRunningState attached nextMachine := + { functionTrace := state.functionTrace + trace := branches.succChild + sourceStore := state.sourceStore + source := .lit (.nat predecessor) :: state.source + frameRoots := state.frameRoots + frame := childFrame + stack := state.stack + member := state.member + descendant := nextDescendant + traceState := nextTraceState + stores := by simpa [nextMachine] using state.stores + runtime := nextRuntime + ownership := nextOwnership + stackRoots := state.stackRoots + callStack := state.callStack + history := by + apply state.history.advance + simpa [traceEq, Lower.CodeTrace.sourceCode, childCode] using + (IxIR1.ExecutionHistory.caseNatSucc (tag := 1) sourceResolved + (sourceAlternativeFind sourceAlternative)) + image := state.image + control := by rfl + noCredits := childNoCredits } + have nextPc : childFrame.pc = 0 := + nextTraceState.target.pc.trans branches.succ.childPc + exact ⟨childFrame, nextState, + by simpa [nextMachine] using targetStep, + fun _rewritten => StableLiveAcceptedEntry.ofPcZero rfl nextPc⟩ + +/-- Reconstruct the checked Nat-zero branch from the concrete target switch +transfer and align its edge-selected endpoint by evaluator determinism. -/ +theorem stepSwitchNatZeroOfTarget + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {block : Block} {targetScrutinee : Atom} + {constructors : Array CtorAlt} {peel : NatPeel} {targetFrame : Frame} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc = block.instructions.size) + (terminator : block.terminator = + .switchValue targetScrutinee constructors (some peel)) + (resolved : Eval.resolveAtom state.frame.values targetScrutinee = + .ok (.lit (.nat 0))) + (transferred : Eval.EdgeTransfer state.frame peel.zero #[] targetFrame) : + let nextMachine : Machine := + { machine with control := .running targetFrame state.stack } + ∃ _ : CompilerRunningState attached nextMachine, + Eval.Step context interpretation machine nextMachine ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext nextMachine + rewritten := by + dsimp only + obtain ⟨site, blockId, input, entryValueCount, sourceScrutinee, + peelNat, alternatives, generated, outgoing, children, traceEq, + translated, _generatedTerminator, peelShape⟩ := + state.currentSwitchValue blockAt pc terminator + have peelTrue : peelNat = true := by simpa using peelShape + subst peelNat + simp only [Option.isSome] at traceEq + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have sourceCount : state.source.length = input.size := by + simpa [Lower.CodeTrace.sourceInputMap] using + traceState.target.sourceCount + have sourceResolved : IxIR1.resolveAtom state.source sourceScrutinee = + .ok (.lit (.nat 0)) := + Lower.Sim.resolveAtom_of_envRel_target traceState.target.environments + sourceCount translated resolved + obtain ⟨childFrame, nextState, generatedStep, acceptedEntry⟩ := + state.stepSwitchNatZero (context := context) + (interpretation := interpretation) traceEq sourceResolved + have canonicalEq : + ({ store := machine.store + heapFuel := machine.heapFuel + control := .running state.frame state.stack } : Machine) = machine := by + simpa only using congrArg + (fun control => ({ machine with control } : Machine)) state.control.symm + have actualStep : Eval.Step context interpretation machine + { machine with control := .running targetFrame state.stack } := by + have step := (Eval.TerminatorTransferCase.switchNatZero + (context := context) (interpretation := interpretation) + (store := machine.store) (heapFuel := machine.heapFuel) + (frame := state.frame) (stack := state.stack) resolved transferred).step + blockAt pc terminator + rw [canonicalEq] at step + exact step + have targetEq : + ({ machine with control := .running childFrame state.stack } : Machine) = + { machine with control := .running targetFrame state.stack } := + generatedStep.deterministic actualStep + rw [targetEq] at nextState generatedStep acceptedEntry + exact ⟨nextState, generatedStep, acceptedEntry⟩ + +/-- Reconstruct the checked Nat-successor branch from the concrete target +switch transfer, including the peeled predecessor binding. -/ +theorem stepSwitchNatSuccOfTarget + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {block : Block} {targetScrutinee : Atom} + {constructors : Array CtorAlt} {peel : NatPeel} {predecessor : Nat} + {targetFrame : Frame} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc = block.instructions.size) + (terminator : block.terminator = + .switchValue targetScrutinee constructors (some peel)) + (resolved : Eval.resolveAtom state.frame.values targetScrutinee = + .ok (.lit (.nat (predecessor + 1)))) + (transferred : Eval.EdgeTransfer state.frame peel.succ + #[.lit (.nat predecessor)] targetFrame) : + let nextMachine : Machine := + { machine with control := .running targetFrame state.stack } + ∃ _ : CompilerRunningState attached nextMachine, + Eval.Step context interpretation machine nextMachine ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext nextMachine + rewritten := by + dsimp only + obtain ⟨site, blockId, input, entryValueCount, sourceScrutinee, + peelNat, alternatives, generated, outgoing, children, traceEq, + translated, _generatedTerminator, peelShape⟩ := + state.currentSwitchValue blockAt pc terminator + have peelTrue : peelNat = true := by simpa using peelShape + subst peelNat + simp only [Option.isSome] at traceEq + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.switchValue site blockId input entryValueCount sourceScrutinee true + alternatives targetScrutinee generated outgoing children) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have sourceCount : state.source.length = input.size := by + simpa [Lower.CodeTrace.sourceInputMap] using + traceState.target.sourceCount + have sourceResolved : IxIR1.resolveAtom state.source sourceScrutinee = + .ok (.lit (.nat (predecessor + 1))) := + Lower.Sim.resolveAtom_of_envRel_target traceState.target.environments + sourceCount translated resolved + obtain ⟨childFrame, nextState, generatedStep, acceptedEntry⟩ := + state.stepSwitchNatSucc (context := context) + (interpretation := interpretation) traceEq sourceResolved + have canonicalEq : + ({ store := machine.store + heapFuel := machine.heapFuel + control := .running state.frame state.stack } : Machine) = machine := by + simpa only using congrArg + (fun control => ({ machine with control } : Machine)) state.control.symm + have actualStep : Eval.Step context interpretation machine + { machine with control := .running targetFrame state.stack } := by + have step := (Eval.TerminatorTransferCase.switchNatSucc + (context := context) (interpretation := interpretation) + (store := machine.store) (heapFuel := machine.heapFuel) + (frame := state.frame) (stack := state.stack) resolved transferred).step + blockAt pc terminator + rw [canonicalEq] at step + exact step + have targetEq : + ({ machine with control := .running childFrame state.stack } : Machine) = + { machine with control := .running targetFrame state.stack } := + generatedStep.deterministic actualStep + rw [targetEq] at nextState generatedStep acceptedEntry + exact ⟨nextState, generatedStep, acceptedEntry⟩ + +/-- Advance a compiler running state through a checked constructor switch, +its generated edge transfer, and the child's certified field-fetch prologue. +This is necessarily a positive macro rather than a single step: the recursive +trace child begins only after all constructor fields have been installed. The +result retains both the edge-entry bridge and the complete parent/child facts +needed to classify the selected child independently in the reuse trace. -/ +theorem stepsSwitchCtor + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {targetScrutinee : Atom} + {generated : Block} {outgoing : List Lower.EdgeTrace} + {children : List Lower.CodeTrace} + (traceEq : state.trace = + .switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children) + {location : Nat} {box : IxIR1.NodeBox} {cid : CtorId} + {fields : Array RVal} + (sourceResolved : IxIR1.resolveAtom state.source sourceScrutinee = + .ok (.loc location)) + (sourceGet : state.sourceStore.get? location = some box) + (node : box.node = .ctorN cid fields) + {tag fieldCount alternativeIndex : Nat} {body : IxIR1.Code} + (sourceAlternative : Lower.sourceAlternativeAtTag? alternatives cid.cidx = + some (.mk tag fieldCount body, alternativeIndex)) + (fieldArity : fields.size = fieldCount) + {constructors : Array CtorAlt} {targetPeel : Option NatPeel} + {index : Nat} {target : CtorAlt} {edge : Lower.EdgeTrace} + {child : Lower.CodeTrace} + (terminator : generated.terminator = + .switchValue targetScrutinee constructors targetPeel) + (targetAt : constructors[index]? = some target) + (targetAlternative : constructors.find? (fun candidate => + candidate.cid == cid) = some target) + (edgeAt : outgoing[index]? = some edge) + (childAt : children[index]? = some child) : + ∃ finalFrame edgeFrame childScrutinee, + let nextMachine : Machine := + { machine with control := .running finalFrame state.stack } + ∃ _ : CompilerRunningState attached nextMachine, + Eval.Steps context interpretation (1 + fields.size) machine + nextMachine ∧ + state.frame.definition.blocks[state.frame.block]? = some generated ∧ + state.frame.pc = generated.instructions.size ∧ + Eval.resolveAtom state.frame.values targetScrutinee = + .ok (.loc location) ∧ + machine.store.get? location = some box ∧ + Eval.EdgeTransfer state.frame target.edge #[] edgeFrame ∧ + Eval.Step context interpretation machine + { machine with control := .running edgeFrame state.stack } ∧ + edgeFrame.definition.blocks[edgeFrame.block]? = + some child.headBlock.2 ∧ + edgeFrame.pc = 0 ∧ + Eval.resolveAtom edgeFrame.values childScrutinee = + .ok (.loc location) ∧ + Lower.fetchPrologueMatches child.headBlock.2.instructions + childScrutinee cid fields.size = true ∧ + finalFrame = { edgeFrame with + pc := fields.size + values := edgeFrame.values ++ fields } := by + have descendant : state.functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children) := by + rw [← traceEq] + exact state.descendant + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children) + state.sourceStore state.source state.frameRoots := by + rw [← traceEq] + exact state.ownership + obtain ⟨finalFrame, edgeFrame, childScrutinee, childSource, childCode, + targetSteps, _targetPreserving, childNoCredits, nextStores, childTarget, + parentBlockAt, parentPc, targetResolved, targetGet, transferred, + switchStep, childBlockAt, childPc, childResolved, prologue, + finalFrameEq⟩ := + Lower.Sim.simulate_traced_switch_ctor_state descendant traceState.target + state.stores sourceResolved sourceGet node sourceAlternative fieldArity + terminator targetAt targetAlternative edgeAt childAt state.control + state.noCredits + have recursiveMatched := + state.functionTrace.descendantSwitchBranchesMatch descendant + have localMatched := + Lower.CodeTrace.switchNodeBranchesMatch_of_match recursiveMatched + have branch := Lower.constructorBranchMatchAt_of_switch_match + localMatched terminator targetAt edgeAt childAt + have targetCid : target.cid = cid := by + have matched : (target.cid == cid) = true := Array.find?_some + (p := fun candidate : CtorAlt => candidate.cid == cid) + (a := target) (xs := constructors) targetAlternative + exact beq_iff_eq.mp matched + have branchAlternative := branch.sourceAlternative + rw [targetCid, sourceAlternative] at branchAlternative + have alternativeEqual := Option.some.inj branchAlternative + have sourceFieldCount : branch.fieldCount = fieldCount := by + exact (congrArg (fun alternative : IxIR1.Alt × Nat => + match alternative.1 with | .mk _ fields _ => fields) + alternativeEqual).symm + have branchFieldArity : fields.size = branch.fieldCount := by + rw [sourceFieldCount] + exact fieldArity + have nextTraceState := traceState.constructorChild sourceAlternative + childSource childCode sourceResolved sourceGet node fieldArity childTarget + have parentEnvironments : Lower.Sim.EnvRel state.source + state.frame.values input := by + simpa [Lower.CodeTrace.sourceInputMap] using + traceState.target.environments + have schemaFields : ∀ {world schema}, + attached.target.artifact.validationContext.schemas world cid = + some schema → + ∃ count, schema.fields = Array.replicate count world := by + intro world schema found + rw [attached.targetSchemasProduced] at found + exact attached.schema_fields_replicate found + have nextOwnership := Lower.Sim.SourceOwnershipAt.switchCtor + attached.target state.member descendant terminator targetAt childAt branch + ownership parentEnvironments sourceResolved sourceGet node targetCid + branchFieldArity schemaFields + have nextRuntime := state.runtime.constructorBranch sourceGet node + have childMember : child ∈ children := List.mem_of_getElem? childAt + have nextDescendant : state.functionTrace.root.Descendant child := + .step descendant childMember + let nextMachine : Machine := + { machine with control := .running finalFrame state.stack } + have nextState : CompilerRunningState attached nextMachine := + { functionTrace := state.functionTrace + trace := child + sourceStore := state.sourceStore + source := fields.toList.reverse ++ state.source + frameRoots := state.frameRoots + frame := finalFrame + stack := state.stack + member := state.member + descendant := nextDescendant + traceState := nextTraceState + stores := by simpa [nextMachine] using nextStores + runtime := nextRuntime + ownership := nextOwnership + stackRoots := state.stackRoots + callStack := state.callStack + history := by + apply state.history.advance + have selected : alternatives.find? (fun alt => alt.cidx == cid.cidx) = + some (.mk tag fieldCount body) := by + exact sourceAlternativeFind sourceAlternative + simpa [traceEq, Lower.CodeTrace.sourceCode, childCode] using + (IxIR1.ExecutionHistory.caseCtor sourceResolved sourceGet node + selected fieldArity) + image := state.image + control := by rfl + noCredits := childNoCredits } + exact ⟨finalFrame, edgeFrame, childScrutinee, nextState, + by simpa [nextMachine] using targetSteps, + parentBlockAt, parentPc, targetResolved, targetGet, transferred, + switchStep, childBlockAt, childPc, childResolved, prologue, finalFrameEq⟩ + +/-- Package checked constructor switching as the baseline half of a positive +compiler-aware synchronization macro. Unlike the literal switch successor, +the endpoint after edge transfer and field fetching is a recursive compiler +boundary. -/ +theorem switchCtorMacro + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {targetScrutinee : Atom} + {generated : Block} {outgoing : List Lower.EdgeTrace} + {children : List Lower.CodeTrace} + (traceEq : state.trace = + .switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children) + {location : Nat} {box : IxIR1.NodeBox} {cid : CtorId} + {fields : Array RVal} + (sourceResolved : IxIR1.resolveAtom state.source sourceScrutinee = + .ok (.loc location)) + (sourceGet : state.sourceStore.get? location = some box) + (node : box.node = .ctorN cid fields) + {tag fieldCount alternativeIndex : Nat} {body : IxIR1.Code} + (sourceAlternative : Lower.sourceAlternativeAtTag? alternatives cid.cidx = + some (.mk tag fieldCount body, alternativeIndex)) + (fieldArity : fields.size = fieldCount) + {constructors : Array CtorAlt} {targetPeel : Option NatPeel} + {index : Nat} {target : CtorAlt} {edge : Lower.EdgeTrace} + {child : Lower.CodeTrace} + (terminator : generated.terminator = + .switchValue targetScrutinee constructors targetPeel) + (targetAt : constructors[index]? = some target) + (targetAlternative : constructors.find? (fun candidate => + candidate.cid == cid) = some target) + (edgeAt : outgoing[index]? = some edge) + (childAt : children[index]? = some child) : + CompilerMacroStep attached context interpretation machine := by + obtain ⟨finalFrame, _edgeFrame, _childScrutinee, nextState, targetSteps, + _parentBlockAt, _parentPc, _targetResolved, _targetGet, _transferred, + _switchStep, _childBlockAt, _childPc, _childResolved, _prologue, + _finalFrameEq⟩ := + state.stepsSwitchCtor traceEq sourceResolved sourceGet node + sourceAlternative fieldArity terminator targetAt targetAlternative + edgeAt childAt + exact .intro (1 + fields.size) (by omega) + { machine with control := .running finalFrame state.stack } + targetSteps (.running nextState) + +/-- Proof-relevant lowering data recovered from one concrete target +constructor selection. It names the exact retained source alternative and +parallel edge/child trace entries needed by both the compiler-only and paired +reuse macros. -/ +inductive CompilerSwitchCtorCase + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + (targetScrutinee : Atom) (constructors : Array CtorAlt) + (targetPeel : Option NatPeel) (location : Nat) (box : IxIR1.NodeBox) + (cid : CtorId) (fields : Array RVal) (alternative : CtorAlt) : Prop where + | intro {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {generated : Block} + {outgoing : List Lower.EdgeTrace} {children : List Lower.CodeTrace} + {tag fieldCount alternativeIndex index : Nat} {body : IxIR1.Code} + {edge : Lower.EdgeTrace} {child : Lower.CodeTrace} + (traceEq : state.trace = + .switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children) + (sourceResolved : IxIR1.resolveAtom state.source sourceScrutinee = + .ok (.loc location)) + (sourceGet : state.sourceStore.get? location = some box) + (node : box.node = .ctorN cid fields) + (sourceAlternative : Lower.sourceAlternativeAtTag? alternatives cid.cidx = + some (.mk tag fieldCount body, alternativeIndex)) + (fieldArity : fields.size = fieldCount) + (terminator : generated.terminator = + .switchValue targetScrutinee constructors targetPeel) + (targetAt : constructors[index]? = some alternative) + (alternativeAt : constructors.find? (fun candidate => + candidate.cid == cid) = some alternative) + (edgeAt : outgoing[index]? = some edge) + (childAt : children[index]? = some child) : + CompilerSwitchCtorCase state targetScrutinee constructors targetPeel + location box cid fields alternative + +/-- Forget a reconstructed constructor case to its positive compiler macro. -/ +theorem CompilerSwitchCtorCase.compilerMacro + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + {state : CompilerRunningState attached machine} + {targetScrutinee : Atom} {constructors : Array CtorAlt} + {targetPeel : Option NatPeel} {location : Nat} {box : IxIR1.NodeBox} + {cid : CtorId} {fields : Array RVal} {alternative : CtorAlt} + (selected : CompilerSwitchCtorCase state targetScrutinee constructors + targetPeel location box cid fields alternative) + {context : Eval.Context} {interpretation : Eval.Interpretation} : + CompilerMacroStep attached context interpretation machine := by + cases selected with + | intro traceEq sourceResolved sourceGet node sourceAlternative fieldArity + terminator targetAt alternativeAt edgeAt childAt => + exact state.switchCtorMacro traceEq sourceResolved sourceGet node + sourceAlternative fieldArity terminator targetAt alternativeAt edgeAt + childAt + +/-- Reconstruct the complete checked constructor case from the concrete +target switch selection. The checked capability transition fixes the selected +source alternative's schema arity, while reachable-heap provenance fixes the +runtime constructor's arity against that same schema. -/ +theorem switchCtorCaseOfTarget + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {machine : Machine} (state : CompilerRunningState attached machine) + {block : Block} {targetScrutinee : Atom} + {constructors : Array CtorAlt} {targetPeel : Option NatPeel} + {location : Nat} {box : IxIR1.NodeBox} {cid : CtorId} + {fields : Array RVal} {alternative : CtorAlt} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc = block.instructions.size) + (terminator : block.terminator = + .switchValue targetScrutinee constructors targetPeel) + (resolved : Eval.resolveAtom state.frame.values targetScrutinee = + .ok (.loc location)) + (boxAt : machine.store.get? location = some box) + (node : box.node = .ctorN cid fields) + (alternativeAt : constructors.find? (fun candidate => + candidate.cid == cid) = some alternative) : + CompilerSwitchCtorCase state targetScrutinee constructors targetPeel + location box cid fields alternative := by + obtain ⟨site, blockId, input, entryValueCount, sourceScrutinee, + peelNat, alternatives, generated, outgoing, children, traceEq, + translated, generatedTerminator, _peelShape⟩ := + state.currentSwitchValue blockAt pc terminator + have descendant : state.functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children) := by + rw [← traceEq] + exact state.descendant + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have sourceCount : state.source.length = input.size := by + simpa [Lower.CodeTrace.sourceInputMap] using + traceState.target.sourceCount + have sourceResolved : IxIR1.resolveAtom state.source sourceScrutinee = + .ok (.loc location) := + Lower.Sim.resolveAtom_of_envRel_target traceState.target.environments + sourceCount translated resolved + have sourceGet : state.sourceStore.get? location = some box := by + simpa [Eval.Store.get?, state.stores.heap] using boxAt + have targetMember : alternative ∈ constructors := + Array.mem_of_find?_eq_some alternativeAt + obtain ⟨index, targetAt⟩ := (Array.mem_iff_getElem?).mp targetMember + have localMatched := Lower.CodeTrace.switchNodeBranchesMatch_of_match + (state.functionTrace.descendantSwitchBranchesMatch descendant) + have localCopy := localMatched + unfold Lower.switchNodeBranchesMatch at localCopy + rw [generatedTerminator] at localCopy + simp only [Bool.and_eq_true] at localCopy + obtain ⟨⟨⟨outgoingLength, childrenLength⟩, _⟩, _⟩ := localCopy + have targetBound : index < constructors.size := + (Array.getElem?_eq_some_iff.mp targetAt).1 + have edgeBound : index < outgoing.length := by + have lengthEq := beq_iff_eq.mp outgoingLength + omega + have childBound : index < children.length := by + have lengthEq := beq_iff_eq.mp childrenLength + omega + let edge := outgoing[index]'edgeBound + let child := children[index]'childBound + have edgeAt : outgoing[index]? = some edge := + List.getElem?_eq_some_iff.mpr ⟨edgeBound, rfl⟩ + have childAt : children[index]? = some child := + List.getElem?_eq_some_iff.mpr ⟨childBound, rfl⟩ + have branch := Lower.constructorBranchMatchAt_of_switch_match + localMatched generatedTerminator targetAt edgeAt childAt + have targetCid : alternative.cid = cid := by + have matched : (alternative.cid == cid) = true := Array.find?_some + (p := fun candidate : CtorAlt => candidate.cid == cid) + (a := alternative) (xs := constructors) alternativeAt + exact beq_iff_eq.mp matched + have sourceAlternative := branch.sourceAlternative + rw [targetCid] at sourceAlternative + obtain ⟨world, schema, schemaAt, schemaArity⟩ := + attached.target.constructorBranchSchemaArity state.member descendant + generatedTerminator targetAt childAt branch + have targetSchemaAt : + attached.target.artifact.validationContext.schemas world cid = + some schema := by + rw [← targetCid] + exact schemaAt + obtain ⟨_rawStore, _imageEq, constructorsValid⟩ := state.image + have known : attached.sidecars.constructorKnown cid fields.size = true := by + cases box with + | mk boxWorld rc boxNode => + change boxNode = .ctorN cid fields at node + subst boxNode + exact constructorsValid.constructorKnown sourceGet + have loweringSchemaAt : attached.loweringContext.schemas world cid = + some schema := by + rw [← attached.targetSchemasProduced] + exact targetSchemaAt + have runtimeFields : schema.fields = Array.replicate fields.size world := + attached.schema_fields_of_constructorKnown known loweringSchemaAt + have runtimeArity : schema.fields.size = fields.size := by + rw [runtimeFields] + simp + have fieldArity : fields.size = branch.fieldCount := + runtimeArity.symm.trans schemaArity + exact .intro traceEq sourceResolved sourceGet node sourceAlternative + fieldArity generatedTerminator targetAt alternativeAt edgeAt childAt + +/-- Compiler-macro projection of `switchCtorCaseOfTarget`. -/ +theorem switchCtorMacroOfTarget + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {block : Block} {targetScrutinee : Atom} + {constructors : Array CtorAlt} {targetPeel : Option NatPeel} + {location : Nat} {box : IxIR1.NodeBox} {cid : CtorId} + {fields : Array RVal} {alternative : CtorAlt} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc = block.instructions.size) + (terminator : block.terminator = + .switchValue targetScrutinee constructors targetPeel) + (resolved : Eval.resolveAtom state.frame.values targetScrutinee = + .ok (.loc location)) + (boxAt : machine.store.get? location = some box) + (node : box.node = .ctorN cid fields) + (alternativeAt : constructors.find? (fun candidate => + candidate.cid == cid) = some alternative) : + CompilerMacroStep attached context interpretation machine := + (state.switchCtorCaseOfTarget blockAt pc terminator resolved boxAt node + alternativeAt).compilerMacro + +/-- A return with an empty continuation stack reaches a halted compiler state. +The checked return capability audit derives the result-world fact required by +the target evaluator, so it is not an external premise. -/ +theorem returnHalt + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {generated : Block} + (traceEq : state.trace = + .ret site blockId input entryValueCount sourceAtom targetAtom generated) + (stackEq : state.stack = []) {value : RVal} + (sourceResolved : + IxIR1.resolveAtom state.source sourceAtom = .ok value) : + let haltedMachine : Machine := + { machine with control := .halted value } + IxIR1.runCode sourceContext (sourceFuel + 1) + state.functionTrace.source state.sourceStore state.source + (.ret sourceAtom) = .ok (state.sourceStore, value) ∧ + Eval.Steps context interpretation 1 machine haltedMachine ∧ + CompilerState attached haltedMachine ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext haltedMachine + rewritten := by + dsimp only + have descendant : state.functionTrace.root.Descendant + (.ret site blockId input entryValueCount sourceAtom targetAtom + generated) := by + rw [← traceEq] + exact state.descendant + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.ret site blockId input entryValueCount sourceAtom targetAtom generated) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.ret site blockId input entryValueCount sourceAtom targetAtom generated) + state.sourceStore state.source state.frameRoots := by + rw [← traceEq] + exact state.ownership + have terminalOwnership := Lower.Sim.SourceOwnershipAt.returnRoot + (checked := attached.target) state.member descendant ownership + sourceResolved + have generatedWorld : IxIR1.Sim.HasWorld state.sourceStore + state.functionTrace.generated.signature.result value := + terminalOwnership.roots_world + ⟨state.functionTrace.generated.signature.result, value⟩ (by simp) + have sourceWorld : IxIR1.Sim.HasWorld state.sourceStore + state.functionTrace.source.result value := by + simpa [state.functionTrace.sourceResult] using generatedWorld + have targetWorld := traceState.target.resultWorld state.stores sourceWorld + have control : machine.control = .running state.frame [] := by + simpa [stackEq] using state.control + obtain ⟨sourceRun, targetSteps, _⟩ := + Lower.Sim.simulate_traced_ret_halt_state + (sourceContext := sourceContext) + (sourceCurrent := state.functionTrace.source) + (sourceFuel := sourceFuel) (context := context) + (interpretation := interpretation) descendant traceState.target + state.stores sourceResolved control state.noCredits targetWorld + exact ⟨sourceRun, targetSteps, .halted rfl, + fun _rewritten => StableLiveAcceptedEntry.halted rfl⟩ + +/-- Reconstruct an empty-stack compiler return directly from the concrete +target return operand. The checked environment map supplies the source +operand, while terminal ownership derives the result-world check. -/ +theorem returnHaltOfTarget + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {sourceContext : IxIR1.Ctx} {sourceFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {block : Block} {targetAtom : Atom} {value : RVal} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc = block.instructions.size) + (terminator : block.terminator = .ret targetAtom) + (stackEq : state.stack = []) + (resolved : Eval.resolveAtom state.frame.values targetAtom = .ok value) : + let haltedMachine : Machine := { machine with control := .halted value } + Eval.Step context interpretation machine haltedMachine ∧ + CompilerState attached haltedMachine ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext haltedMachine + rewritten := by + dsimp only + obtain ⟨site, blockId, input, entryValueCount, sourceAtom, generated, + traceEq, translated⟩ := + state.currentReturn blockAt pc terminator + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.ret site blockId input entryValueCount sourceAtom targetAtom generated) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have sourceCount : state.source.length = input.size := by + simpa [Lower.CodeTrace.sourceInputMap] using + traceState.target.sourceCount + have sourceResolved : IxIR1.resolveAtom state.source sourceAtom = + .ok value := + Lower.Sim.resolveAtom_of_envRel_target traceState.target.environments + sourceCount translated resolved + obtain ⟨_sourceRun, targetSteps, compiler, acceptedEntry⟩ := + state.returnHalt (sourceContext := sourceContext) + (sourceFuel := sourceFuel) (context := context) + (interpretation := interpretation) traceEq stackEq sourceResolved + have targetStep : Eval.Step context interpretation machine + { machine with control := .halted value } := by + cases targetSteps with + | cons _running head tail => + cases tail + exact head + exact ⟨targetStep, compiler, acceptedEntry⟩ + +/-- A checked source return closes the active history, even when intervening +tail calls have replaced the frame originally entered by the caller. -/ +theorem returnCompletion + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {generated : Block} + (traceEq : state.trace = + .ret site blockId input entryValueCount sourceAtom targetAtom generated) + {value : RVal} + (sourceResolved : IxIR1.resolveAtom state.source sourceAtom = .ok value) : + CompilerStackCompletion attached attached.simulationSourceContext + state.callStack state.sourceStore value := by + have descendant : state.functionTrace.root.Descendant + (.ret site blockId input entryValueCount sourceAtom targetAtom generated) := by + rw [← traceEq] + exact state.descendant + have ownership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.ret site blockId input entryValueCount sourceAtom targetAtom generated) + state.sourceStore state.source state.frameRoots := by + rw [← traceEq] + exact state.ownership + have terminal := Lower.Sim.SourceOwnershipAt.returnRoot + (checked := attached.target) state.member descendant ownership sourceResolved + have world : IxIR1.Sim.HasWorld state.sourceStore + state.functionTrace.source.result value := by + have generatedWorld := terminal.roots_world + ⟨state.functionTrace.generated.signature.result, value⟩ (by simp) + simpa [state.functionTrace.sourceResult] using generatedWorld + apply state.history.complete (out := (state.sourceStore, value)) _ world + refine ⟨1, ?_⟩ + simp [traceEq, Lower.CodeTrace.sourceCode, IxIR1.runCode, + sourceResolved, bind, Except.bind] + +/-- A checked callee return pops one +ordinary-call continuation and reconstruct the full compiler running state of +the suspended caller. The indexed stack witness restores the caller trace, +ownership suffix, live-stack support, heap image, and recursive stack tail. -/ +theorem returnResume + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {returnFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {generated : Block} + (traceEq : state.trace = + .ret site blockId input entryValueCount sourceAtom targetAtom generated) + {value : RVal} + (sourceResolved : + IxIR1.resolveAtom state.source sourceAtom = .ok value) + {caller : Frame} {rest : List Continuation} + (stackEq : state.stack = .resume caller :: rest) : + ∃ nextMachine : Machine, + ∃ _ : CompilerRunningState attached nextMachine, + IxIR1.runCode attached.simulationSourceContext (returnFuel + 1) + state.functionTrace.source state.sourceStore state.source + (.ret sourceAtom) = .ok (state.sourceStore, value) ∧ + Eval.Steps context interpretation 1 machine nextMachine ∧ + ∀ {rewritten : Machine}, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext nextMachine + rewritten := by + have completed := (state.returnCompletion traceEq sourceResolved).ordinary stackEq + rcases state with ⟨functionTrace, trace, sourceStore, source, frameRoots, + frame, stack, member, descendant, traceState, stores, runtime, ownership, + stackRoots, callStack, history, image, control, noCredits⟩ + dsimp only at traceEq sourceResolved completed ⊢ + have returnDescendant : functionTrace.root.Descendant + (.ret site blockId input entryValueCount sourceAtom targetAtom + generated) := by + rw [← traceEq] + exact descendant + have returnState : attached.sidecars.TraceStateRel functionTrace + (.ret site blockId input entryValueCount sourceAtom targetAtom generated) + sourceStore source frame := by + rw [← traceEq] + exact traceState + have returnOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.ret site blockId input entryValueCount sourceAtom targetAtom generated) + sourceStore source frameRoots := by + rw [← traceEq] + exact ownership + have terminalOwnership := Lower.Sim.SourceOwnershipAt.returnRoot + (checked := attached.target) member returnDescendant returnOwnership + sourceResolved + have generatedWorld : IxIR1.Sim.HasWorld sourceStore + functionTrace.generated.signature.result value := + terminalOwnership.roots_world + ⟨functionTrace.generated.signature.result, value⟩ (by simp) + have sourceWorld : IxIR1.Sim.HasWorld sourceStore + functionTrace.source.result value := by + simpa [functionTrace.sourceResult] using generatedWorld + have targetWorld := returnState.target.resultWorld stores sourceWorld + cases callStack with + | nil => + simp [CompilerStackReturn] at completed + | @addressed callerTrace callerMember callSite callBlock callInput nextInput + callEntryValueCount callIndex sourceAddress targetAddress sourceArguments + targetArguments next calleeTrace calleeMember sourceDefinition + targetDefinition calleeMatch callerDescendant callerStore callerSource + values callerFrameRoots callerFrame callerStack callerState callerRuntime + callerOwnership callerStackRoots callerImage callerNoCredits resolved + before remaining signatureAt beforeMember beforeCoordinate consumed tail => + simp only [CompilerStackReturn] at completed + simp only [CompilerStackHistory] at history + obtain ⟨callFuel, sourceDeclarations, sourceDeclaration, operationRun⟩ := + completed + have expectedWorld : IxIR1.Sim.HasWorld sourceStore + calleeTrace.generated.signature.result value := by + have declaredWorld := IxIR1.Sim.runOp_call_result_hasWorld resolved + sourceDeclaration operationRun + simpa [calleeTrace.sourceResult, calleeMatch.source] using declaredWorld + have returnedOwnership : IxIR1.Sim.RootOwnership sourceStore + (⟨calleeTrace.generated.signature.result, value⟩ :: + (Lower.Sim.rootsForCapabilities remaining.toList callerSource ++ + callerFrameRoots)) := + Lower.Sim.RootOwnership_reworldHead terminalOwnership expectedWorld + have nextOwnership := Lower.Sim.SourceOwnershipAt.callResult + (checked := attached.target) callerMember signatureAt callerDescendant + beforeMember beforeCoordinate callerOwnership resolved consumed + returnedOwnership + let nextCallerFrame : Frame := + { callerFrame with + pc := callerFrame.pc + 1 + values := callerFrame.values.push value } + let nextMachine : Machine := + { machine with control := .running nextCallerFrame callerStack } + obtain ⟨sourceReturn, targetSteps, nextStores, nextTraceState⟩ := + attached.simulate_traced_return_to_letOp_state + (sourceFuel := returnFuel) (operationFuel := callFuel + 1) + (context := context) (interpretation := interpretation) + callerMember callerDescendant returnDescendant callerState returnState + (binder := by rfl) (delta := by rfl) stores sourceDeclarations + operationRun sourceResolved control noCredits targetWorld + have nextRuntime : Lower.Sim.SourceRuntimeInvariant sourceStore + (value :: callerSource) := + callerRuntime.runOp + (IxIR1.NoReuse.runOp_reuses_eq + (attached.sourceContextNoReuse sourceDeclarations) + (attached.functionTraceNoReuse callerMember) (by trivial) + operationRun) + operationRun + have nextImage : attached.SourceStoreImage sourceStore := + attached.runOp_preservesSourceStoreImage sourceDeclarations + callerMember callerDescendant callerState callerImage operationRun + have nextDescendant : callerTrace.root.Descendant next := + .step callerDescendant (by simp [Lower.CodeTrace.children]) + have nextState : CompilerRunningState attached nextMachine := + { functionTrace := callerTrace + trace := next + sourceStore := sourceStore + source := value :: callerSource + frameRoots := callerFrameRoots + frame := nextCallerFrame + stack := callerStack + member := callerMember + descendant := nextDescendant + traceState := by simpa [nextCallerFrame] using nextTraceState + stores := by simpa [nextMachine] using nextStores + runtime := nextRuntime + ownership := nextOwnership + stackRoots := callerStackRoots + callStack := tail + history := history.2.advance (IxIR1.ExecutionHistory.stepOp operationRun) + image := nextImage + control := by rfl + noCredits := by + simpa [nextCallerFrame] using callerNoCredits } + obtain ⟨callerBlockAt, _callerPcBound, callAt⟩ := + callerState.target.instructionAt callerDescendant + have nextBlockAt : nextCallerFrame.definition.blocks[ + nextCallerFrame.block]? = some next.headBlock.2 := by + simpa [nextCallerFrame] using callerBlockAt + have acceptedEntry : ∀ {rewritten : Machine}, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext nextMachine + rewritten := by + intro rewritten + exact StableLiveAcceptedEntry.ofCallResume rfl nextBlockAt + (by simpa [nextCallerFrame] using callAt) + exact ⟨nextMachine, nextState, sourceReturn, + by simpa [nextMachine, nextCallerFrame] using targetSteps, + acceptedEntry⟩ + | @self callerTrace callerMember callSite callBlock callInput nextInput + callEntryValueCount callIndex sourceArguments targetArguments next + callerDescendant callerStore callerSource values callerFrameRoots + callerFrame callerStack callerState callerRuntime callerOwnership + callerStackRoots callerImage callerNoCredits resolved before remaining + beforeMember beforeCoordinate consumed tail => + simp only [CompilerStackReturn] at completed + simp only [CompilerStackHistory] at history + obtain ⟨callFuel, sourceDeclarations, operationRun⟩ := completed + have expectedWorld : IxIR1.Sim.HasWorld sourceStore + callerTrace.generated.signature.result value := by + have declaredWorld := IxIR1.Sim.runOp_callSelf_result_hasWorld resolved + operationRun + simpa [callerTrace.sourceResult] using declaredWorld + have returnedOwnership : IxIR1.Sim.RootOwnership sourceStore + (⟨callerTrace.generated.signature.result, value⟩ :: + (Lower.Sim.rootsForCapabilities remaining.toList callerSource ++ + callerFrameRoots)) := + Lower.Sim.RootOwnership_reworldHead terminalOwnership expectedWorld + have nextOwnership := Lower.Sim.SourceOwnershipAt.callSelfResult + (checked := attached.target) callerMember callerDescendant beforeMember + beforeCoordinate callerOwnership resolved consumed returnedOwnership + let nextCallerFrame : Frame := + { callerFrame with + pc := callerFrame.pc + 1 + values := callerFrame.values.push value } + let nextMachine : Machine := + { machine with control := .running nextCallerFrame callerStack } + obtain ⟨sourceReturn, targetSteps, nextStores, nextTraceState⟩ := + attached.simulate_traced_return_to_letOp_state + (sourceFuel := returnFuel) (operationFuel := callFuel + 1) + (context := context) (interpretation := interpretation) + callerMember callerDescendant returnDescendant callerState returnState + (binder := by rfl) (delta := by rfl) stores sourceDeclarations + operationRun sourceResolved control noCredits targetWorld + have nextRuntime : Lower.Sim.SourceRuntimeInvariant sourceStore + (value :: callerSource) := + callerRuntime.runOp + (IxIR1.NoReuse.runOp_reuses_eq + (attached.sourceContextNoReuse sourceDeclarations) + (attached.functionTraceNoReuse callerMember) (by trivial) + operationRun) + operationRun + have nextImage : attached.SourceStoreImage sourceStore := + attached.runOp_preservesSourceStoreImage sourceDeclarations + callerMember callerDescendant callerState callerImage operationRun + have nextDescendant : callerTrace.root.Descendant next := + .step callerDescendant (by simp [Lower.CodeTrace.children]) + have nextState : CompilerRunningState attached nextMachine := + { functionTrace := callerTrace + trace := next + sourceStore := sourceStore + source := value :: callerSource + frameRoots := callerFrameRoots + frame := nextCallerFrame + stack := callerStack + member := callerMember + descendant := nextDescendant + traceState := by simpa [nextCallerFrame] using nextTraceState + stores := by simpa [nextMachine] using nextStores + runtime := nextRuntime + ownership := nextOwnership + stackRoots := callerStackRoots + callStack := tail + history := history.2.advance (IxIR1.ExecutionHistory.stepOp operationRun) + image := nextImage + control := by rfl + noCredits := by + simpa [nextCallerFrame] using callerNoCredits } + obtain ⟨callerBlockAt, _callerPcBound, callAt⟩ := + callerState.target.instructionAt callerDescendant + have nextBlockAt : nextCallerFrame.definition.blocks[ + nextCallerFrame.block]? = some next.headBlock.2 := by + simpa [nextCallerFrame] using callerBlockAt + have acceptedEntry : ∀ {rewritten : Machine}, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext nextMachine + rewritten := by + intro rewritten + exact StableLiveAcceptedEntry.ofCallSelfResume rfl nextBlockAt + (by simpa [nextCallerFrame] using callAt) + exact ⟨nextMachine, nextState, sourceReturn, + by simpa [nextMachine, nextCallerFrame] using targetSteps, + acceptedEntry⟩ + | @applyExact callerTrace callerMember applySite applyBlock applyInput + nextInput applyEntryValueCount applyIndex sourceFunction targetFunction + sourceArguments targetArguments next callerDescendant callerStore + callerSource callerFrameRoots callerFrame callerStack callerState + callerRuntime callerOwnership callerStackRoots callerImage + callerNoCredits remaining tail => + simp only [CompilerStackReturn] at completed + simp only [CompilerStackHistory] at history + obtain ⟨applyFuel, sourceDeclarations, operationRun⟩ := completed + have nextOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions next sourceStore + (value :: callerSource) callerFrameRoots := + Lower.Sim.SourceOwnershipAt.applyFrom (checked := attached.target) + callerMember callerDescendant callerOwnership + (attached.applyOwnershipPreservesFrom_sourceStoreImage_of_declarations + sourceDeclarations callerImage) operationRun + let nextCallerFrame : Frame := + { callerFrame with + pc := callerFrame.pc + 1 + values := callerFrame.values.push value } + let nextMachine : Machine := + { machine with control := .running nextCallerFrame callerStack } + obtain ⟨sourceReturn, targetSteps, nextStores, nextTraceState⟩ := + attached.simulate_traced_return_to_letOp_state + (sourceFuel := returnFuel) (operationFuel := applyFuel + 2) + (context := context) (interpretation := interpretation) + callerMember callerDescendant returnDescendant callerState returnState + (binder := by rfl) (delta := by rfl) stores sourceDeclarations + operationRun sourceResolved control noCredits targetWorld + have nextRuntime : Lower.Sim.SourceRuntimeInvariant sourceStore + (value :: callerSource) := + callerRuntime.runOp + (IxIR1.NoReuse.runOp_reuses_eq + (attached.sourceContextNoReuse sourceDeclarations) + (attached.functionTraceNoReuse callerMember) (by trivial) + operationRun) + operationRun + have nextImage : attached.SourceStoreImage sourceStore := + attached.runOp_preservesSourceStoreImage sourceDeclarations + callerMember callerDescendant callerState callerImage operationRun + have nextDescendant : callerTrace.root.Descendant next := + .step callerDescendant (by simp [Lower.CodeTrace.children]) + have nextState : CompilerRunningState attached nextMachine := + { functionTrace := callerTrace + trace := next + sourceStore := sourceStore + source := value :: callerSource + frameRoots := callerFrameRoots + frame := nextCallerFrame + stack := callerStack + member := callerMember + descendant := nextDescendant + traceState := by simpa [nextCallerFrame] using nextTraceState + stores := by simpa [nextMachine] using nextStores + runtime := nextRuntime + ownership := nextOwnership + stackRoots := callerStackRoots + callStack := tail + history := history.2.advance (IxIR1.ExecutionHistory.stepOp operationRun) + image := nextImage + control := by rfl + noCredits := by + simpa [nextCallerFrame] using callerNoCredits } + obtain ⟨callerBlockAt, _callerPcBound, applyAt⟩ := + callerState.target.instructionAt callerDescendant + have nextBlockAt : nextCallerFrame.definition.blocks[ + nextCallerFrame.block]? = some next.headBlock.2 := by + simpa [nextCallerFrame] using callerBlockAt + have acceptedEntry : ∀ {rewritten : Machine}, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext nextMachine + rewritten := by + intro rewritten + exact StableLiveAcceptedEntry.ofApplyResume rfl nextBlockAt + (by simpa [nextCallerFrame] using applyAt) + exact ⟨nextMachine, nextState, sourceReturn, + by simpa [nextMachine, nextCallerFrame] using targetSteps, + acceptedEntry⟩ + | applyMore _ _ _ _ _ _ _ _ _ _ _ => + simp [CompilerStackReturn] at completed + +/-- Reconstruct an ordinary return from a concrete target step. The source +operand is reflected from the checked environment, and source completion +comes entirely from the compiler history. -/ +theorem returnResumeOfTarget + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine target : Machine} (state : CompilerRunningState attached machine) + {block : Block} {targetAtom : Atom} {value : RVal} + {caller : Frame} {rest : List Continuation} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc = block.instructions.size) + (terminator : block.terminator = .ret targetAtom) + (stackEq : state.stack = .resume caller :: rest) + (resolved : Eval.resolveAtom state.frame.values targetAtom = .ok value) + (actualStep : Eval.Step context interpretation machine target) : + ∃ _ : CompilerRunningState attached target, + Eval.Step context interpretation machine target ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext target rewritten := by + obtain ⟨site, blockId, input, entryValueCount, sourceAtom, generated, + traceEq, translated⟩ := state.currentReturn blockAt pc terminator + have traceState : attached.sidecars.TraceStateRel state.functionTrace + (.ret site blockId input entryValueCount sourceAtom targetAtom generated) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have sourceCount : state.source.length = input.size := by + simpa [Lower.CodeTrace.sourceInputMap] using traceState.target.sourceCount + have sourceResolved : IxIR1.resolveAtom state.source sourceAtom = + .ok value := Lower.Sim.resolveAtom_of_envRel_target + traceState.target.environments sourceCount translated resolved + obtain ⟨nextMachine, nextState, _sourceReturn, targetSteps, acceptedEntry⟩ := + state.returnResume (returnFuel := 0) (context := context) + (interpretation := interpretation) traceEq sourceResolved stackEq + have generatedStep : Eval.Step context interpretation machine nextMachine := by + cases targetSteps with + | cons _running head tail => + cases tail + exact head + have targetEq := generatedStep.deterministic actualStep + subst nextMachine + exact ⟨nextState, actualStep, fun _ => acceptedEntry⟩ + +/-- Reconstruct the source PAP preparation from an owned return value and +the concrete target retain/release prefix. The resulting store relation uses +the target's actual remaining heap budget. -/ +private theorem returnedPapPreparation + {sourceContext : IxIR1.Ctx} + {sourceStore : IxIR1.Store} {targetStore targetRetained targetReleased : Store} + {heapFuel remainingFuel location : Nat} {box : IxIR1.NodeBox} + {address : Ixon.Address} {arity : Nat} {captured : Array RVal} + {roots : List IxIR1.Sim.Root} + (ownership : IxIR1.Sim.RootOwnership sourceStore + (⟨.shared, .loc location⟩ :: roots)) + (stores : Lower.Sim.StoreRel sourceStore targetStore) + (positive : Lower.Sim.PositiveSharedRC sourceStore) + (sourceGet : sourceStore.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (retained : Eval.RetainSharedMany targetStore captured targetRetained) + (released : Eval.releaseSharedWork heapFuel targetRetained [.loc location] = + .ok (targetReleased, remainingFuel)) : + ∃ sourceFuel sourceRetained sourceReleased, + IxIR1.dupVals sourceStore captured.toList = .ok sourceRetained ∧ + IxIR1.dropVal sourceContext sourceFuel sourceRetained (.loc location) = + .ok sourceReleased ∧ + Lower.Sim.StoreRel sourceReleased targetReleased := by + have capturedWorlds : ∀ value ∈ captured.toList, + IxIR1.Sim.HasWorld sourceStore .shared value := by + intro value member + have world := ownership.edges_world sourceGet value (by + rw [node] + simpa [IxIR1.Sim.nodeChildren] using member) + simpa [shared] using world + obtain ⟨sourceRetained, sourceRetain⟩ := + IxIR1.LowerSim.dupVals_progress_of_hasWorld capturedWorlds + have retainedOwnership := IxIR1.Sim.dupVals_borrowedMany_preserves + ownership capturedWorlds sourceRetain + have papFirst : IxIR1.Sim.RootOwnership sourceRetained + (⟨.shared, .loc location⟩ :: + IxIR1.Sim.rootsFor .shared captured.toList ++ roots) := by + apply retainedOwnership.perm + simp + obtain ⟨sourceFuel, sourceReleased, sourceRelease, _⟩ := + IxIR1.dropVal_progress (ctx := sourceContext) papFirst + obtain ⟨generatedRetained, generatedReleased, _localFuel, generatedRetain, + _retainedStores, generatedRelease, releasedStores⟩ := + Lower.Sim.simulate_apply_pap_prepare stores positive sourceRetain sourceRelease + have retainedEq : generatedRetained = targetRetained := by + unfold Eval.RetainSharedMany at generatedRetain retained + rw [generatedRetain] at retained + injection retained + rw [retainedEq] at generatedRelease + obtain ⟨releasedEq, _fuelEq⟩ := + Lower.Sim.releaseSharedWork_success_unique generatedRelease released + exact ⟨sourceFuel, sourceRetained, sourceReleased, sourceRetain, + sourceRelease, releasedEq ▸ releasedStores⟩ + +/-- Advance residual application directly from the successful target +dispatcher. Immediate results restore the original caller; saturation enters +the next callee with the same saved caller and a composed source history. -/ +theorem returnApplyMoreTransfer + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine target : Machine} (state : CompilerRunningState attached machine) + (targetDeclarations : context.declarations = + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas).declarations) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {generated : Block} + (traceEq : state.trace = + .ret site blockId input entryValueCount sourceAtom targetAtom generated) + {value : RVal} + (sourceResolved : IxIR1.resolveAtom state.source sourceAtom = .ok value) + {caller : Frame} {arguments : Array RVal} {rest : List Continuation} + (stackEq : state.stack = .applyMore arguments caller :: rest) + (transferred : Eval.ApplyTransfer context interpretation machine.store + machine.heapFuel value arguments caller rest target) : + ∃ _ : CompilerRunningState attached target, + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext target rewritten := by + have completed := state.returnCompletion traceEq sourceResolved + rcases state with ⟨functionTrace, trace, sourceStore, source, frameRoots, + frame, stack, member, descendant, traceState, stores, runtime, ownership, + stackRoots, callStack, history, image, control, noCredits⟩ + dsimp only at traceEq sourceResolved stackEq completed + have returnDescendant : functionTrace.root.Descendant + (.ret site blockId input entryValueCount sourceAtom targetAtom generated) := by + rw [← traceEq] + exact descendant + have returnOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.ret site blockId input entryValueCount sourceAtom targetAtom generated) + sourceStore source frameRoots := by + rw [← traceEq] + exact ownership + have terminalOwnership := Lower.Sim.SourceOwnershipAt.returnRoot + (checked := attached.target) member returnDescendant returnOwnership sourceResolved + cases callStack with + | nil => cases stackEq + | addressed => cases stackEq + | self => cases stackEq + | applyExact => cases stackEq + | @applyMore callerTrace callerMember applySite applyBlock applyInput + nextInput applyEntryValueCount applyIndex sourceFunction targetFunction + sourceArguments targetArguments next callerDescendant callerStore + callerSource callerFrameRoots callerFrame callerStack callerState + callerRuntime callerOwnership callerStackRoots callerImage + callerNoCredits remaining callerFrameSupported sourceResidual + targetResidual residuals tail => + obtain ⟨headEq, restEq⟩ := List.cons.inj stackEq + obtain ⟨rfl, rfl⟩ := Continuation.applyMore.inj headEq + subst rest + simp only [CompilerStackCompletion] at completed + simp only [CompilerStackHistory] at history + let resume : Frame := { callerFrame with pc := callerFrame.pc + 1 } + let suspendedRoots := + Lower.Sim.rootsForCapabilities remaining.toList callerSource ++ callerFrameRoots + obtain ⟨callerBlockAt, _callerPcBound, applyAt⟩ := + callerState.target.instructionAt callerDescendant + have resumeResult : ∀ {outputStore : IxIR1.Store} {outputValue : RVal} + {targetStore : Store} {remainingFuel fuel : Nat}, + IxIR1.applyGo attached.simulationSourceContext fuel sourceStore value + sourceResidual = .ok (outputStore, outputValue) → + Lower.Sim.StoreRel outputStore targetStore → + ∃ _ : CompilerRunningState attached + { store := targetStore + heapFuel := remainingFuel + control := .running + { resume with values := resume.values.push outputValue } callerStack }, + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext + { store := targetStore + heapFuel := remainingFuel + control := .running + { resume with values := resume.values.push outputValue } callerStack } + rewritten := by + intro outputStore outputValue targetStore remainingFuel fuel applied outputStores + obtain ⟨operationFuel, operationRun⟩ := completed applied + refine ⟨?_, ?_⟩ + · simpa [resume] using resumedApplyCaller callerMember callerDescendant + callerState callerRuntime callerOwnership callerStackRoots callerImage + callerNoCredits tail history.2 rfl operationRun + (heapFuel := remainingFuel) outputStores + · intro rewritten + exact StableLiveAcceptedEntry.ofApplyResume rfl + (by simpa [resume] using callerBlockAt) + (by simpa [resume] using applyAt) + cases transferred.classify with + | @erased outStore outHeapFuel released => + have argumentsOwnership : IxIR1.Sim.RootOwnership sourceStore + (IxIR1.Sim.rootsFor .shared sourceResidual ++ suspendedRoots) := + terminalOwnership.dropNoLocation rfl + obtain ⟨sourceFuel, sourceReleased, sourceRelease, _⟩ := + IxIR1.dropMany_progress (ctx := attached.simulationSourceContext) + argumentsOwnership + obtain ⟨_localFuel, generatedReleased, generatedRelease, + releasedStores, _⟩ := + Lower.Sim.dropMany_simulates_releaseSharedWork runtime.positiveSharedRC + stores sourceRelease + rw [residuals] at released + obtain ⟨releasedEq, _fuelEq⟩ := + Lower.Sim.releaseSharedWork_success_unique generatedRelease released + have sourceApply : IxIR1.applyGo attached.simulationSourceContext + (sourceFuel + 1) sourceStore .erased sourceResidual = + .ok (sourceReleased, .erased) := by + simp [IxIR1.applyGo, sourceRelease, bind, Except.bind] + exact resumeResult sourceApply (releasedEq ▸ releasedStores) + | papExtern _ _ _ _ _ _ _ declaration _ _ _ => + exact (attached.targetDeclaration_not_extern targetDeclarations declaration).elim + | @papUnder location box address arity captured targetRetained targetReleased + remainingFuel boxAt shared node _capturedUnder retained released totalUnder => + have sourceGet : sourceStore.get? location = some box := by + simpa [Eval.Store.get?, stores.heap] using boxAt + have sharedWorld : IxIR1.Sim.HasWorld sourceStore .shared (.loc location) := + ⟨box, sourceGet, shared⟩ + have returnedOwnership := + Lower.Sim.RootOwnership_reworldHead terminalOwnership sharedWorld + obtain ⟨sourceFuel, sourceRetained, sourceReleased, sourceRetain, + sourceRelease, releasedStores⟩ := + returnedPapPreparation (sourceContext := attached.simulationSourceContext) + returnedOwnership stores runtime.positiveSharedRC sourceGet shared node + retained released + let pap := IxIR1.Node.papN address arity (captured ++ targetResidual) + have sourceUnder : captured.size + sourceResidual.length < arity := by + simpa [← residuals] using totalUnder + have payloadEq : (captured.toList ++ sourceResidual).toArray = + captured ++ targetResidual := by + apply Array.toList_inj.mp + simp [residuals] + have sourceApply : IxIR1.applyGo attached.simulationSourceContext + (sourceFuel + 1) sourceStore (.loc location) sourceResidual = + .ok ((sourceReleased.allocNode .shared pap).1, + .loc (sourceReleased.allocNode .shared pap).2) := by + simp [IxIR1.applyGo, sourceGet, node, sourceRetain, sourceRelease, + sourceUnder, payloadEq, pap, bind, Except.bind] + have locationEq := releasedStores.alloc_location .shared pap + obtain ⟨resumedState, resumedEntry⟩ := + resumeResult sourceApply (releasedStores.alloc .shared pap) + (remainingFuel := remainingFuel) + rw [← locationEq] at resumedState resumedEntry + exact ⟨resumedState, resumedEntry⟩ + | @papFn location box address arity captured targetRetained targetReleased + remainingFuel definition boxAt shared node _capturedUnder retained + released totalEnough declaration papSafe suppliedArity _nonempty => + have sourceGet : sourceStore.get? location = some box := by + simpa [Eval.Store.get?, stores.heap] using boxAt + have sharedWorld : IxIR1.Sim.HasWorld sourceStore .shared (.loc location) := + ⟨box, sourceGet, shared⟩ + have returnedOwnership := + Lower.Sim.RootOwnership_reworldHead terminalOwnership sharedWorld + obtain ⟨sourceFuel, sourceRetained, sourceReleased, sourceRetain, + sourceRelease, releasedStores⟩ := + returnedPapPreparation (sourceContext := attached.simulationSourceContext) + returnedOwnership stores runtime.positiveSharedRC sourceGet shared node + retained released + obtain ⟨sourceDefinition, calleeTrace, calleeMember, calleeMatch, + sourceDeclaration⟩ := + attached.functionTrace_of_target_declaration + (sourceContext := attached.simulationSourceContext) rfl + targetDeclarations declaration + let sourceTotal := captured.toList ++ sourceResidual + let sourceSupplied := sourceTotal.take arity + let sourceRemaining := sourceTotal.drop arity + let targetTotal := captured ++ targetResidual + let targetSupplied := targetTotal.extract 0 arity + let targetRemaining := targetTotal.extract arity targetTotal.size + let calleeFrame : Frame := { definition, values := targetSupplied } + let calleeRoots := IxIR1.Sim.rootsFor .shared sourceRemaining ++ suspendedRoots + have totalValues : targetTotal.toList = sourceTotal := by + simp [targetTotal, sourceTotal, residuals] + have totalLength : targetTotal.size = sourceTotal.length := by + simpa using congrArg List.length totalValues + have suppliedValues : targetSupplied.toList = sourceSupplied := by + change (targetTotal.extract 0 arity).toList = sourceSupplied + rw [Array.toList_extract, List.extract_eq_take_drop, totalValues] + simp [sourceSupplied] + have remainingValues : targetRemaining.toList = sourceRemaining := by + change (targetTotal.extract arity targetTotal.size).toList = sourceRemaining + rw [Array.toList_extract, List.extract_eq_take_drop, totalValues, totalLength] + exact List.take_of_length_le (by simp) + have sourceEnough : arity ≤ sourceTotal.length := by + simpa [sourceTotal, ← residuals] using totalEnough + have suppliedLength : sourceSupplied.length = arity := by + simp [sourceSupplied, sourceEnough] + have targetLength : targetSupplied.size = arity := by + have lengthEq := congrArg List.length suppliedValues + simpa [suppliedLength] using lengthEq + have papArity : arity = sourceDefinition.arity := by + calc + arity = definition.signature.params.size := targetLength.symm.trans suppliedArity + _ = calleeTrace.generated.signature.params.size := by rw [calleeMatch.generated] + _ = calleeTrace.source.arity := calleeTrace.sourceArity + _ = sourceDefinition.arity := congrArg IxIR1.FnDef.arity calleeMatch.source + have calleePapSafe : calleeTrace.generated.signature.papSafe = true := by + simpa [calleeMatch.generated] using papSafe + have sourcePapSafe : sourceDefinition.papSafe = true := by + simpa [calleeTrace.sourcePapSafe, calleeMatch.source] using calleePapSafe + have entryArity : sourceSupplied.length = + calleeTrace.generated.signature.params.size := by + rw [suppliedLength, papArity, calleeTrace.sourceArity, calleeMatch.source] + have papAt : sourceStore.get? location = + some ⟨.shared, box.rc, .papN address arity captured⟩ := by + simpa only [← shared, ← node] using sourceGet + have preparedOwnership := IxIR1.Sim.applyGo_preparePap_owned papAt + returnedOwnership sourceRetain sourceRelease + have readyOwnership : IxIR1.Sim.RootOwnership sourceReleased + (IxIR1.Sim.rootsFor .shared sourceSupplied ++ calleeRoots) := by + change IxIR1.Sim.RootOwnership sourceReleased + (IxIR1.Sim.rootsFor .shared sourceTotal ++ suspendedRoots) at preparedOwnership + have splitTotal : sourceTotal = sourceSupplied ++ sourceRemaining := + (List.take_append_drop arity sourceTotal).symm + rw [splitTotal] at preparedOwnership + simpa only [IxIR1.Sim.rootsFor, List.map_append, List.append_assoc, + calleeRoots] using preparedOwnership + have entryShape : Lower.entryCapabilities calleeTrace.generated.signature = + Array.replicate sourceSupplied.length (.owned .shared) := by + simpa [entryArity] using + attached.target.papSafeEntryCapabilities calleeMember calleePapSafe + have calleeOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions calleeTrace.root sourceReleased + sourceSupplied.reverse calleeRoots := by + intro entry entryMember entryCoordinate + rw [attached.target.entryCapabilities calleeMember entryMember entryCoordinate] + exact Lower.Sim.SourceOwnershipInvariant.sharedEntry entryShape readyOwnership + have calleeRuntime : Lower.Sim.SourceRuntimeInvariant sourceReleased + sourceSupplied.reverse := + Lower.Sim.SourceRuntimeInvariant.sharedEntry + ((runtime.order.dupVals sourceRetain).dropVal sourceRelease) + ((runtime.papsUnder.dupVals sourceRetain).dropVal sourceRelease) readyOwnership + have calleeImage : attached.SourceStoreImage sourceReleased := + attached.dropVal_preservesSourceStoreImage rfl + (attached.dupVals_preservesSourceStoreImage image sourceRetain) sourceRelease + have calleeTraceState : attached.sidecars.TraceStateRel calleeTrace + calleeTrace.root sourceReleased sourceSupplied.reverse calleeFrame := by + have entry := attached.functionEntryTraceState (sourceStore := sourceReleased) + calleeMember targetSupplied (by + rw [targetLength, papArity, calleeMatch.source]) + simpa only [suppliedValues, calleeMatch.generated, calleeFrame] using entry + have suspendedFrame : LiveFrameSupportedByRoots suspendedRoots resume := + callerFrameSupported.mono (fun root member => + List.mem_append_left callerFrameRoots member) + have suspendedStack : LiveStackSupportedByRoots suspendedRoots callerStack := + callerStackRoots.mono (fun root member => + List.mem_append_right + (Lower.Sim.rootsForCapabilities remaining.toList callerSource) member) + by_cases totalExact : sourceTotal.length = arity + · have suppliedExact : sourceSupplied = sourceTotal := by + exact List.take_of_length_le (Nat.le_of_eq totalExact) + have remainingNil : sourceRemaining = [] := by + simp [sourceRemaining, totalExact] + have remainingEmpty : targetRemaining.isEmpty = true := by + apply Array.isEmpty_iff.mpr + apply Array.toList_inj.mp + simpa [remainingNil] using remainingValues + let calleeMachine : Machine := + { store := targetReleased + heapFuel := remainingFuel + control := .running calleeFrame (.resume resume :: callerStack) } + have nextState : CompilerRunningState attached calleeMachine := + { functionTrace := calleeTrace + trace := calleeTrace.root + sourceStore := sourceReleased + source := sourceSupplied.reverse + frameRoots := suspendedRoots + frame := calleeFrame + stack := .resume resume :: callerStack + member := calleeMember + descendant := .refl + traceState := calleeTraceState + stores := releasedStores + runtime := calleeRuntime + ownership := by simpa [calleeRoots, remainingNil, IxIR1.Sim.rootsFor] using calleeOwnership + stackRoots := .cons (.resume suspendedFrame) suspendedStack + callStack := .applyExact callerMember callerDescendant callerState callerRuntime + callerOwnership callerStackRoots callerImage callerNoCredits tail + history := by + simp only [CompilerStackHistory] + refine ⟨?_, history.2⟩ + rintro out ⟨bodyFuel, bodyRun⟩ world + simp only [CompilerStackCompletion, CompilerStackReturn] + have bodyRun' : IxIR1.runCode attached.simulationSourceContext bodyFuel + sourceDefinition sourceReleased sourceTotal.reverse sourceDefinition.body = + .ok out := by + simpa only [calleeTrace.rootSourceCode, calleeMatch.source, suppliedExact] using bodyRun + have called := IxIR1.invoke_of_body_run sourceDeclaration + (totalExact.trans papArity) bodyRun' + (by simpa only [calleeMatch.source] using world) + obtain ⟨applyFuel, applied⟩ := IxIR1.applyGo_exact_of_invoke + sourceGet node sourceRetain sourceRelease totalExact + sourceDeclaration sourcePapSafe called + obtain ⟨operationFuel, operationRun⟩ := completed applied + exact ⟨operationFuel, rfl, IxIR1.runOp_mono (by omega) operationRun⟩ + image := calleeImage + control := rfl + noCredits := rfl } + refine ⟨?_, ?_⟩ + · simpa only [calleeMachine, calleeFrame, targetSupplied, targetRemaining, + targetTotal, remainingEmpty, if_true, resume] using nextState + · intro rewritten + exact StableLiveAcceptedEntry.ofPcZero rfl rfl + · have totalOver : arity < sourceTotal.length := by omega + have remainingNonempty : targetRemaining.isEmpty = false := by + have remainingSize : targetRemaining.size = sourceTotal.length - arity := by + simpa [sourceRemaining] using congrArg List.length remainingValues + simp [Array.isEmpty, remainingSize] + omega + have framedCaller : LiveFrameSupportedByRoots calleeRoots resume := + suspendedFrame.mono (fun root member => + List.mem_append_right (IxIR1.Sim.rootsFor .shared sourceRemaining) member) + have framedStack : LiveStackSupportedByRoots calleeRoots callerStack := + suspendedStack.mono (fun root member => + List.mem_append_right (IxIR1.Sim.rootsFor .shared sourceRemaining) member) + have residualSupported : ∀ value ∈ targetRemaining.toList, + ValueSupportedByRoots calleeRoots value := by + intro value member + have sourceMember : value ∈ sourceRemaining := remainingValues ▸ member + cases value with + | loc location => + exact ⟨.shared, List.mem_append_left suspendedRoots (by + simp [IxIR1.Sim.rootsFor, sourceMember])⟩ + | lit literal => trivial + | erased => trivial + let calleeMachine : Machine := + { store := targetReleased + heapFuel := remainingFuel + control := .running calleeFrame + (.applyMore targetRemaining resume :: callerStack) } + have nextState : CompilerRunningState attached calleeMachine := + { functionTrace := calleeTrace + trace := calleeTrace.root + sourceStore := sourceReleased + source := sourceSupplied.reverse + frameRoots := calleeRoots + frame := calleeFrame + stack := .applyMore targetRemaining resume :: callerStack + member := calleeMember + descendant := .refl + traceState := calleeTraceState + stores := releasedStores + runtime := calleeRuntime + ownership := calleeOwnership + stackRoots := .cons (.applyMore residualSupported framedCaller) framedStack + callStack := .applyMore callerMember callerDescendant callerState callerRuntime + callerOwnership callerStackRoots callerImage callerNoCredits + callerFrameSupported remainingValues tail + history := by + simp only [CompilerStackHistory] + refine ⟨?_, history.2⟩ + rintro middle ⟨bodyFuel, bodyRun⟩ world + simp only [CompilerStackCompletion] + intro residualFuel out residualRun + have bodyRun' : IxIR1.runCode attached.simulationSourceContext bodyFuel + sourceDefinition sourceReleased sourceSupplied.reverse sourceDefinition.body = + .ok middle := by + simpa only [calleeTrace.rootSourceCode, calleeMatch.source] using bodyRun + have called := IxIR1.invoke_of_body_run sourceDeclaration + (suppliedLength.trans papArity) bodyRun' + (by simpa only [calleeMatch.source] using world) + obtain ⟨applyFuel, applied⟩ := IxIR1.applyGo_over_of_invoke + sourceGet node sourceRetain sourceRelease totalOver + sourceDeclaration sourcePapSafe called residualRun + exact completed applied + image := calleeImage + control := rfl + noCredits := rfl } + refine ⟨?_, ?_⟩ + · simpa only [calleeMachine, calleeFrame, targetSupplied, targetRemaining, + targetTotal, remainingNonempty, Bool.false_eq_true, if_false, resume] using nextState + · intro rewritten + exact StableLiveAcceptedEntry.ofPcZero rfl rfl + +/-- Reconstruct every `applyMore` return from its target operands and actual +transfer, without a successful source suffix or callee simulation worker. -/ +theorem returnApplyMoreOfTarget + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine target : Machine} (state : CompilerRunningState attached machine) + (targetDeclarations : context.declarations = + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas).declarations) + {block : Block} {atom : Atom} {value : RVal} + {caller : Frame} {arguments : Array RVal} {rest : List Continuation} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc = block.instructions.size) + (terminator : block.terminator = .ret atom) + (stackEq : state.stack = .applyMore arguments caller :: rest) + (resolved : Eval.resolveAtom state.frame.values atom = .ok value) + (transferred : Eval.ApplyTransfer context interpretation machine.store + machine.heapFuel value arguments caller rest target) : + ∃ _ : CompilerRunningState attached target, + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext target rewritten := by + obtain ⟨site, blockId, input, entryValueCount, sourceAtom, generated, + traceEq, translated⟩ := state.currentReturn blockAt pc terminator + have returnState : attached.sidecars.TraceStateRel state.functionTrace + (.ret site blockId input entryValueCount sourceAtom atom generated) + state.sourceStore state.source state.frame := by + rw [← traceEq] + exact state.traceState + have sourceCount : state.source.length = input.size := by + simpa [Lower.CodeTrace.sourceInputMap] using returnState.target.sourceCount + have sourceResolved : IxIR1.resolveAtom state.source sourceAtom = .ok value := + Lower.Sim.resolveAtom_of_envRel_target returnState.target.environments + sourceCount translated resolved + exact state.returnApplyMoreTransfer targetDeclarations traceEq sourceResolved + stackEq transferred + + +/-- A return into the typed `applyMore` stack executes the complete residual +dynamic-application chain and reconstructs the original suspended compiler +caller. The evaluator-aligned `ApplyMorePlan` selects erased, under-, exact-, +and recursively over-saturated redispatches; the existing strong-fuel workers +run every newly entered callee, while the final continuation restores the +source runtime, ownership, image, live stack, and typed stack tail. -/ +theorem returnApplyMore + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {returnFuel : Nat} + {context : Eval.Context} {interpretation : Eval.Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceAtom : IxIR1.Atom} {targetAtom : Atom} {generated : Block} + (traceEq : state.trace = + .ret site blockId input entryValueCount sourceAtom targetAtom generated) + {value : RVal} + (sourceResolved : + IxIR1.resolveAtom state.source sourceAtom = .ok value) + (completed : CompilerApplyMoreReturn attached attached.simulationSourceContext context + state.callStack state.sourceStore value) + (workers : ∀ fuel, + Pipeline.SuccessfulTraceSimulationAt attached attached.simulationSourceContext context + interpretation fuel) : + IxIR1.runCode attached.simulationSourceContext (returnFuel + 1) + state.functionTrace.source state.sourceStore state.source + (.ret sourceAtom) = .ok (state.sourceStore, value) ∧ + ∃ outputStore outputValue, + Pipeline.BudgetedReachesPost context interpretation + (fun _ _ final => + Nonempty (CompilerRunningState attached final) ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext final rewritten) + outputStore outputValue machine := by + have sourceCompletion := state.returnCompletion traceEq sourceResolved + rcases state with ⟨functionTrace, trace, sourceStore, source, frameRoots, + frame, stack, member, descendant, traceState, stores, runtime, ownership, + stackRoots, callStack, history, image, control, noCredits⟩ + dsimp only at traceEq sourceResolved completed sourceCompletion ⊢ + have returnDescendant : functionTrace.root.Descendant + (.ret site blockId input entryValueCount sourceAtom targetAtom + generated) := by + rw [← traceEq] + exact descendant + have returnState : attached.sidecars.TraceStateRel functionTrace + (.ret site blockId input entryValueCount sourceAtom targetAtom generated) + sourceStore source frame := by + rw [← traceEq] + exact traceState + have returnOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.ret site blockId input entryValueCount sourceAtom targetAtom generated) + sourceStore source frameRoots := by + rw [← traceEq] + exact ownership + have terminalOwnership := Lower.Sim.SourceOwnershipAt.returnRoot + (checked := attached.target) member returnDescendant returnOwnership + sourceResolved + have generatedWorld : IxIR1.Sim.HasWorld sourceStore + functionTrace.generated.signature.result value := + terminalOwnership.roots_world + ⟨functionTrace.generated.signature.result, value⟩ (by simp) + have sourceWorld : IxIR1.Sim.HasWorld sourceStore + functionTrace.source.result value := by + simpa [functionTrace.sourceResult] using generatedWorld + have sourceReturn : IxIR1.runCode attached.simulationSourceContext (returnFuel + 1) + functionTrace.source sourceStore source (.ret sourceAtom) = + .ok (sourceStore, value) := by + rw [IxIR1.runCode.eq_def] + dsimp only + rw [sourceResolved] + rfl + refine ⟨sourceReturn, ?_⟩ + cases callStack with + | nil => simp [CompilerApplyMoreReturn] at completed + | addressed _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ => + simp [CompilerApplyMoreReturn] at completed + | applyExact _ _ _ _ _ _ _ _ _ => + simp [CompilerApplyMoreReturn] at completed + | self _ _ _ _ _ _ _ _ _ _ _ _ _ => + simp [CompilerApplyMoreReturn] at completed + | @applyMore callerTrace callerMember applySite applyBlock applyInput + nextInput applyEntryValueCount applyIndex sourceFunction targetFunction + sourceArguments targetArguments next callerDescendant callerStore + callerSource callerFrameRoots callerFrame callerStack callerState + callerRuntime callerOwnership callerStackRoots callerImage + callerNoCredits remaining callerFrameSupported sourceResidual + targetResidual residuals tail => + simp only [CompilerApplyMoreReturn] at completed + simp only [CompilerStackHistory] at history + obtain ⟨applyFuel, outputStore, outputValue, + sourceDeclarations, plan⟩ := completed + simp only [CompilerStackCompletion] at sourceCompletion + obtain ⟨residualFuel, residualRun⟩ := plan.sourceRun + obtain ⟨operationFuel, operationRun⟩ := sourceCompletion residualRun + let resume : Frame := + { callerFrame with pc := callerFrame.pc + 1 } + let suspendedRoots : List IxIR1.Sim.Root := + Lower.Sim.rootsForCapabilities remaining.toList callerSource ++ + callerFrameRoots + obtain ⟨callerBlockAt, _callerPcBound, applyAt⟩ := + callerState.target.instructionAt callerDescendant + have residualArray : targetResidual = sourceResidual.toArray := by + apply Array.toList_inj.mp + simpa using residuals + have framedOwnership : Lower.Sim.SourceOwnershipAt + attached.target.artifact.trace.positions + (.ret site blockId input entryValueCount sourceAtom targetAtom + generated) sourceStore source + (IxIR1.Sim.rootsFor .shared sourceResidual ++ suspendedRoots) := by + simpa [suspendedRoots] using returnOwnership + have applyControl : machine.control = .running frame + (.applyMore sourceResidual.toArray resume :: callerStack) := by + simpa [resume, residualArray] using control + let post : Pipeline.SourceMachinePost := + fun _ _ final => + Nonempty (CompilerRunningState attached final) ∧ + ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext final rewritten + have continuation : Pipeline.SuccessfulResumeContinuation context + interpretation resume callerStack (outputStore, outputValue) + (outputStore, outputValue) post := by + intro finalMachine finalStores finalControl + have finalState : CompilerRunningState attached + { store := finalMachine.store + heapFuel := finalMachine.heapFuel + control := .running + { resume with values := resume.values.push outputValue } + callerStack } := by + simpa [resume] using + (resumedApplyCaller callerMember callerDescendant callerState + callerRuntime callerOwnership callerStackRoots callerImage + callerNoCredits tail history.2 sourceDeclarations operationRun + (heapFuel := finalMachine.heapFuel) finalStores) + have exactState : CompilerRunningState attached finalMachine := by + change CompilerRunningState attached + { finalMachine with + control := .running + { resume with values := resume.values.push outputValue } + callerStack } at finalState + rw [← finalControl] at finalState + simpa using finalState + have finalBlockAt : + ({ resume with values := resume.values.push outputValue } : + Frame).definition.blocks[ + ({ resume with values := resume.values.push outputValue } : + Frame).block]? = some next.headBlock.2 := by + simpa [resume] using callerBlockAt + have finalAcceptedEntry : ∀ rewritten, + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext finalMachine + rewritten := by + intro rewritten + exact StableLiveAcceptedEntry.ofApplyResume finalControl finalBlockAt + (by simpa [resume] using applyAt) + refine ⟨finalMachine.heapFuel, ?_⟩ + simpa [post] using + (Pipeline.ReachesPost.refl (post := post) + (And.intro ⟨exactState⟩ finalAcceptedEntry)) + have handler : Pipeline.SuccessfulReturnHandler attached attached.simulationSourceContext + context interpretation functionTrace + (IxIR1.Sim.rootsFor .shared sourceResidual ++ suspendedRoots) + (.applyMore sourceResidual.toArray resume :: callerStack) + (sourceStore, value) (outputStore, outputValue) post := + attached.applyMoreReturnHandler_of_plan sourceDeclarations plan + (fun fuel _ => workers fuel) continuation functionTrace + suspendedRoots + have reaches := handler member returnDescendant returnState stores + runtime framedOwnership sourceReturn sourceWorld applyControl noCredits + image + exact ⟨outputStore, outputValue, reaches⟩ + +/-- The baseline evaluator heap is literally the source heap named by the +compiler state. -/ +theorem heap_eq + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) : + machine.store.heap = state.sourceStore := + state.stores.heap + +/-- A concrete source constructor selected by an accepted site has exactly +the field count recorded by the reuse shape. Runtime constructor provenance +and the accepted validator schema both resolve through the same first +identity-indexed sidecar row, so duplicate sidecar entries cannot make the +two arities disagree. -/ +theorem acceptedSiteSourceFieldCount + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {block : Block} + (site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block) + {location rc : Nat} {fields : Array RVal} + (sourceAt : machine.store.get? location = some + ⟨.shared, rc, .ctorN site.shape.sourceConstructor fields⟩) : + fields.size = site.shape.fieldCount := by + have sourceStoreAt : state.sourceStore.get? location = some + ⟨.shared, rc, .ctorN site.shape.sourceConstructor fields⟩ := by + rw [← state.heap_eq] + exact sourceAt + obtain ⟨_sourceStore, _image, constructorsValid⟩ := state.image + have known : attached.sidecars.constructorKnown + site.shape.sourceConstructor fields.size = true := + constructorsValid.constructorKnown sourceStoreAt + obtain ⟨sourceSchema, _allocationSchema, sourceSchemaAt, + _allocationSchemaAt, sourceFields, _allocationFields, + _sourceLayout, _allocationLayout⟩ := site.runtimeSchemas + have loweringSourceSchemaAt : attached.loweringContext.schemas .shared + site.shape.sourceConstructor = some sourceSchema := by + rw [← attached.targetSchemasProduced] + exact sourceSchemaAt + have runtimeFields : sourceSchema.fields = + Array.replicate fields.size Ixon.Owned.shared := + attached.schema_fields_of_constructorKnown known loweringSourceSchemaAt + have repeated : Array.replicate fields.size Ixon.Owned.shared = + Array.replicate site.shape.fieldCount Ixon.Owned.shared := + runtimeFields.symm.trans sourceFields + have sizes := congrArg Array.size repeated + simpa using sizes + +/-- A nonempty constructor-child prologue identifies the accepted reset +source. Producer ownership fixes its shared world, and the checked schema +makes the generated prologue exactly the recognized fetch prefix. -/ +theorem acceptedCtorChildSource + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {store : Store} {heapFuel : Nat} + (frame : Frame) (stack : List Continuation) + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (definition : frame.definition = source) + {helperOffset : Nat} {block : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block} + (accepted : Reuse.FunctionDecisions.At rewrite.decisions frame.block + helperOffset block (.accepted site)) + {fields : Array RVal} + (parameterCount : frame.values.size = site.shape.parameterCount) + (state : CompilerRunningState attached + { store + heapFuel + control := .running + { frame with + pc := fields.size + values := frame.values ++ fields } stack }) + {atom : Atom} {cid : CtorId} {location : Nat} {box : NodeBox} + (prologue : Lower.fetchPrologueMatches block.instructions atom cid + fields.size = true) + (positive : 0 < fields.size) + (resolved : resolveAtom frame.values atom = .ok (.loc location)) + (boxAt : store.get? location = some box) + (node : box.node = .ctorN cid fields) : + ∃ rc, + fields.size = site.shape.fieldCount ∧ + resolveAtom frame.values (.reg site.shape.source) = + .ok (.loc location) ∧ + store.get? location = some + ⟨.shared, rc, .ctorN site.shape.sourceConstructor fields⟩ := by + obtain ⟨atomEq, cidEq⟩ := Reuse.Site.fetchPrologueHead site prologue positive + subst atom + subst cid + have bound := Reuse.Site.fetchPrologueBound site prologue + have controlEq : + (.running state.frame state.stack : Control) = + .running + { frame with + pc := fields.size + values := frame.values ++ fields } stack := state.control.symm + have stateFrameEq : state.frame = + { frame with + pc := fields.size + values := frame.values ++ fields } := by + injection controlEq + have stateDefinition : state.frame.definition = source := by + simpa [stateFrameEq] using definition + have stateAccepted : Reuse.FunctionDecisions.At rewrite.decisions + state.frame.block helperOffset block (.accepted site) := by + simpa [stateFrameEq] using accepted + have pcBound : state.frame.pc ≤ site.shape.releasePosition := by + simp only [stateFrameEq, site.fits.releasePosition] + omega + have stateResolved : resolveAtom state.frame.values + (.reg site.shape.source) = .ok (.loc location) := by + simpa [stateFrameEq, resolveAtom, Array.getElem?_append, parameterCount, + site.fits.sourceBound] using resolved + obtain ⟨rest, ownership, _rootsInRest⟩ := + state.acceptedSiteSourceRoot rewrite stateDefinition stateAccepted pcBound + stateResolved + have sourceBoxAt : state.sourceStore.get? location = some box := by + rw [← state.heap_eq] + exact boxAt + obtain ⟨worldBox, worldAt, worldEq⟩ := + ownership.roots_world ⟨.shared, .loc location⟩ (by simp) + have worldBoxEq : worldBox = box := + Option.some.inj (worldAt.symm.trans sourceBoxAt) + have boxWorld : box.world = .shared := by + rw [← worldBoxEq] + exact worldEq + cases box with + | mk world rc actualNode => + simp only at boxWorld + subst world + change actualNode = .ctorN site.shape.sourceConstructor fields at node + subst actualNode + exact ⟨rc, state.acceptedSiteSourceFieldCount site boxAt, + resolved, boxAt⟩ + +/-- The first successful evaluator step at an accepted block entry must be +the shape's zeroth fetch. Compiler ownership refines the fetched constructor +box to the shared world expected by the accepted schema. -/ +theorem acceptedEntrySourceOfStep + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (baselineDefinition : state.frame.definition = source) + {helperOffset : Nat} {acceptedBlock : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext acceptedBlock} + (accepted : Reuse.FunctionDecisions.At rewrite.decisions state.frame.block + helperOffset acceptedBlock (.accepted site)) + (pc : state.frame.pc = 0) + {context : Eval.Context} {interpretation : Interpretation} + {target : Machine} + (stepped : Step context interpretation machine target) : + ∃ (location rc : Nat) (fields : Array RVal), + resolveAtom state.frame.values (.reg site.shape.source) = + .ok (.loc location) ∧ + machine.store.get? location = some + ⟨.shared, rc, + .ctorN site.shape.sourceConstructor fields⟩ := by + have sourceAt := (rewrite.acceptedAt accepted).1 + have acceptedBlockAt : state.frame.definition.blocks[state.frame.block]? = + some acceptedBlock := by + rw [baselineDefinition] + exact sourceAt + have canonicalEq : + ({ store := machine.store + heapFuel := machine.heapFuel + control := .running state.frame state.stack } : Machine) = machine := by + simpa only using congrArg + (fun control => ({ machine with control } : Machine)) state.control.symm + have canonicalStep : Step context interpretation + { store := machine.store + heapFuel := machine.heapFuel + control := .running state.frame state.stack } + target := by + rw [canonicalEq] + exact stepped + cases canonicalStep.classify with + | instruction blockAt stepPc instructionAt classified => + have blockEq : acceptedBlock = _ := + Option.some.inj (acceptedBlockAt.symm.trans blockAt) + subst_vars + have firstAt := site.fits.fetches 0 site.fits.fieldCountPositive + obtain ⟨_firstBound, firstInstruction⟩ := + Array.getElem?_eq_some_iff.mp firstAt + have stepPcZero : state.frame.pc = 0 := pc + have classifiedFetch : InstructionTransferCase context interpretation + machine.store machine.heapFuel state.frame state.stack + (Instr.fetch (.reg site.shape.source) + site.shape.sourceConstructor 0) target := by + simpa [stepPcZero, firstInstruction] using classified + cases classifiedFetch with + | @fetch targetAtom cid field location box fields value resolved boxAt + node fieldAt => + have sourceBoxAt : state.sourceStore.get? location = some box := by + unfold Eval.Store.get? at boxAt + rw [state.heap_eq] at boxAt + exact boxAt + obtain ⟨rest, ownership, _rootsInRest⟩ := + state.acceptedSiteSourceRoot rewrite rfl accepted + (by omega) resolved + obtain ⟨worldBox, worldAt, worldEq⟩ := + ownership.roots_world + ⟨Ixon.Owned.shared, .loc location⟩ (by simp) + have worldBoxEq : worldBox = box := + Option.some.inj (worldAt.symm.trans sourceBoxAt) + have boxWorld : box.world = .shared := by + rw [← worldBoxEq] + exact worldEq + cases box with + | mk world rc actualNode => + simp only at boxWorld + subst world + change actualNode = + .ctorN site.shape.sourceConstructor fields at node + subst actualNode + exact ⟨location, rc, fields, resolved, boxAt⟩ + | terminator blockAt terminal _terminatorAt _classified => + have blockEq : acceptedBlock = _ := + Option.some.inj (acceptedBlockAt.symm.trans blockAt) + subst_vars + have minimum := site.fits.instructionCountAtLeastFour + omega + +/-- Dynamic ownership closes the baseline heap named by every compiler +running state. -/ +theorem heapClosed + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) : + IxIR1.Sim.StoreClosed machine.store.heap := by + obtain ⟨_position, _member, _coordinate, current⟩ := + state.currentOwnership + rw [state.heap_eq] + exact current.ownership.storeClosed + +/-- At an accepted site, exact producer ownership makes the entire baseline +field-retain prefix executable before any branch-specific reasoning. The +result exposes both the retained root multiset and the parent's post-retain +box, while preserving every suspended-frame root inside the ambient tail. -/ +theorem acceptedSiteRetainedFields + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (baselineDefinition : state.frame.definition = source) + {helperOffset : Nat} {block : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block} + (accepted : Reuse.FunctionDecisions.At rewrite.decisions state.frame.block + helperOffset block (.accepted site)) + (pc : state.frame.pc ≤ site.shape.releasePosition) + {location rc : Nat} {fields : Array RVal} + (resolved : Eval.resolveAtom state.frame.values + (.reg site.shape.source) = .ok (.loc location)) + (sourceAt : machine.store.get? location = + some ⟨.shared, rc, .ctorN site.shape.sourceConstructor fields⟩) : + ∃ (rest : List IxIR1.Sim.Root) (retained : Store) (retainedRc : Nat), + IxIR1.Sim.RootOwnership machine.store.heap + (⟨.shared, .loc location⟩ :: rest) ∧ + (∀ root ∈ state.frameRoots, root ∈ rest) ∧ + RetainSharedMany machine.store fields retained ∧ + retained.get? location = some + ⟨.shared, retainedRc, .ctorN site.shape.sourceConstructor fields⟩ ∧ + IxIR1.Sim.RootOwnership retained.heap + (IxIR1.Sim.rootsFor .shared fields.toList ++ + ⟨.shared, .loc location⟩ :: rest) := by + obtain ⟨rest, sourceOwnership, rootsInRest⟩ := + state.acceptedSiteSourceRoot rewrite baselineDefinition accepted pc + resolved + have ownership : IxIR1.Sim.RootOwnership machine.store.heap + (⟨.shared, .loc location⟩ :: rest) := by + rw [state.heap_eq] + exact sourceOwnership + obtain ⟨retained, retainedRun, retainedOwnership, extension⟩ := + retainCtorFields_of_rootOwnership sourceAt ownership + have sourceHeapAt : machine.store.heap.get? location = + some ⟨.shared, rc, .ctorN site.shape.sourceConstructor fields⟩ := + sourceAt + obtain ⟨retainedRc, retainedAt⟩ := extension sourceHeapAt + exact ⟨rest, retained, retainedRc, ownership, rootsInRest, retainedRun, + retainedAt, retainedOwnership⟩ + +/-- Every future-observable value in the active compiler frame names an +already allocated baseline slot. The checked input-map coverage finds its +source value, and the source runtime invariant supplies the bound. -/ +theorem liveValueInBounds + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {index : Nat} {value : RVal} + (live : ValueLiveFrom state.frame.definition state.frame.block + state.frame.pc index) + (found : state.frame.values[index]? = some value) : + IxIR1.Reclamation.ValueInBounds machine.store.heap value := by + have targetBound : index < state.frame.values.size := + (Array.getElem?_eq_some_iff.mp found).1 + obtain ⟨sourceIndex, inputAt⟩ := state.coverage live targetBound + have inputBound : sourceIndex < state.trace.sourceInputMap.size := + (Array.getElem?_eq_some_iff.mp inputAt).1 + have sourceBound : sourceIndex < state.source.length := by + rw [state.traceState.target.sourceCount] + exact inputBound + let sourceValue := state.source[sourceIndex] + have sourceAt : state.source[sourceIndex]? = some sourceValue := by + simp [sourceValue] + have sourceResolved := state.traceState.target.environments sourceIndex + sourceValue (.reg index) sourceAt inputAt + have targetResolved : Eval.resolveAtom state.frame.values (.reg index) = + .ok value := by + simp [Eval.resolveAtom, found] + have valueEq : sourceValue = value := + Except.ok.inj (sourceResolved.symm.trans targetResolved) + subst value + have sourceInBounds := state.runtime.rootsInBounds sourceValue + (List.mem_of_getElem? sourceAt) + simpa [state.heap_eq] using sourceInBounds + +/-- Every future-observable inherited value at an accepted block entry is +live in the baseline heap. Checked input-map coverage identifies the source +slot, and the parameter-capability audit rules out a dead producer binding; +owners and borrows carry `HasWorld`, while scalar bindings cannot contain a +location. -/ +theorem acceptedParameterValueLive + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (baselineDefinition : state.frame.definition = source) + {helperOffset : Nat} {block : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block} + (accepted : Reuse.FunctionDecisions.At rewrite.decisions state.frame.block + helperOffset block (.accepted site)) + (pc : state.frame.pc ≤ site.shape.releasePosition) + {index : Nat} {value : RVal} + (inherited : index < site.shape.parameterCount) + (live : ValueLiveFrom source state.frame.block 0 index) + (found : state.frame.values[index]? = some value) : + IxIR1.Sim.LiveRVal machine.store.heap value := by + have targetBound : index < state.frame.values.size := + (Array.getElem?_eq_some_iff.mp found).1 + have parameterBound : index < block.valueParams.size := by + rw [← site.fits.parameterCount] + exact inherited + let parameter := block.valueParams[index] + have parameterAt : block.valueParams[index]? = some parameter := by + simp [parameter, parameterBound] + have currentBlockAt : state.frame.definition.blocks[state.frame.block]? = + some block := by + rw [baselineDefinition] + exact (rewrite.acceptedAt accepted).1 + have exactBlock := state.traceState.target.blockAt state.descendant + have blockEq : block = state.trace.headBlock.2 := + Option.some.inj (currentBlockAt.symm.trans exactBlock) + have traceParameterAt : + state.trace.headBlock.2.valueParams[index]? = some parameter := by + rw [← blockEq] + exact parameterAt + obtain ⟨position, member, coordinate, ownership⟩ := + state.currentOwnership + have stateLive : ValueLiveFrom state.frame.definition state.frame.block + state.frame.pc index := by + rw [baselineDefinition] + exact Reuse.Site.entryLiveParameterBeforeRelease site + (rewrite.acceptedAt accepted).1 live inherited pc + obtain ⟨sourceIndex, inputAt⟩ := state.coverage stateLive targetBound + have inputBound : sourceIndex < state.trace.sourceInputMap.size := + (Array.getElem?_eq_some_iff.mp inputAt).1 + have sourceBound : sourceIndex < state.source.length := by + rw [state.traceState.target.sourceCount] + exact inputBound + let sourceValue := state.source[sourceIndex] + have sourceAt : state.source[sourceIndex]? = some sourceValue := by + simp [sourceValue, sourceBound] + have sourceResolved := state.traceState.target.environments sourceIndex + sourceValue (.reg index) sourceAt inputAt + have targetResolved : Eval.resolveAtom state.frame.values (.reg index) = + .ok value := by + simp [Eval.resolveAtom, found] + have valueEq : sourceValue = value := + Except.ok.inj (sourceResolved.symm.trans targetResolved) + obtain ⟨capability, capabilityAt, capabilityMatch⟩ := + attached.target.parameterCapability state.member state.descendant member + coordinate inputAt traceParameterAt + have holds := ownership.holds capabilityAt sourceAt + have holdsValue : Lower.Sim.CapabilityHolds state.sourceStore capability + value := by + rwa [valueEq] at holds + rw [state.heap_eq] + cases capability with + | scalar => + cases value with + | loc location => + simp [Lower.Sim.CapabilityHolds, + IxIR1.Sim.rvalLocation?] at holdsValue + | lit literal => trivial + | erased => trivial + | owned world => + cases value with + | loc location => + obtain ⟨box, boxAt, _world⟩ := holdsValue + exact ⟨box, boxAt⟩ + | lit literal => trivial + | erased => trivial + | borrowed world lender => + cases value with + | loc location => + obtain ⟨box, boxAt, _world⟩ := holdsValue + exact ⟨box, boxAt⟩ + | lit literal => trivial + | erased => trivial + | dead => simp [Lower.BindingCap.matchesParameter] at capabilityMatch + +/-- Specialize inherited-parameter liveness to a traced zero-PC entry. -/ +theorem acceptedEntryValueLive + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (baselineDefinition : state.frame.definition = source) + {helperOffset : Nat} {block : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block} + (accepted : Reuse.FunctionDecisions.At rewrite.decisions state.frame.block + helperOffset block (.accepted site)) + (pc : state.frame.pc = 0) + {index : Nat} {value : RVal} + (live : ValueLiveFrom source state.frame.block 0 index) + (found : state.frame.values[index]? = some value) : + IxIR1.Sim.LiveRVal machine.store.heap value := by + have parameterCount := + state.acceptedSiteParameterCount rewrite baselineDefinition accepted pc + have inherited : index < site.shape.parameterCount := by + rw [← parameterCount] + exact (Array.getElem?_eq_some_iff.mp found).1 + exact state.acceptedParameterValueLive rewrite baselineDefinition accepted + (by omega) inherited live found + +/-- A compiler state's framed-root invariant supplies enough support to +discard dead allocation-history rows from any related suspended stack. -/ +theorem stackToHeapIso + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {rewrittenStore : IxIR1.Store} + (history : IxIR1.Sim.HeapHistoryIso machine.store.heap rewrittenStore) + {limits : Validate.Limits} {validation : Validate.Context} + {rewrittenStack : List Continuation} + (stack : StableLiveStackIso limits validation history.locRel + state.stack rewrittenStack) : + StableLiveStackIso limits validation + (history.toHeapIso state.heapClosed).locRel + state.stack rewrittenStack := by + obtain ⟨position, _member, _coordinate, current⟩ := + state.currentOwnership + let roots := Lower.Sim.rootsForCapabilities + position.sourceCapabilities.toList state.source ++ state.frameRoots + have ownership : IxIR1.Sim.RootOwnership machine.store.heap roots := by + rw [state.heap_eq] + exact current.ownership + have supported : LiveStackSupportedByRoots roots state.stack := + state.stackRoots.mono (fun root member => + List.mem_append_right _ member) + exact stack.toHeapIsoOfSupported history state.heapClosed ownership supported + +/-- Exact-content live states admitted by the compiler can be re-indexed by +the canonical allocation history. Bounds are required only for the active +frame's future-live registers and the suspended stack's observable values; +dead append-only registers remain unconstrained. -/ +theorem historyOfContents + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {rewrittenStore : Store} {source : Function} + {rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source} + {rewrittenFrame : Frame} + {rewrittenStack : List Continuation} + (heap : HeapContentsEq machine.store rewrittenStore) + (frame : StableLiveFrameIso rewrite (fun left right => left = right) + state.frame rewrittenFrame) + (stack : StableLiveStackIso Validate.defaultLimits + attached.target.artifact.validationContext + (fun left right => left = right) state.stack rewrittenStack) : + ∃ history : IxIR1.Sim.HeapHistoryIso machine.store.heap + rewrittenStore.heap, + StableLiveFrameIso rewrite history.locRel state.frame rewrittenFrame ∧ + StableLiveStackIso Validate.defaultLimits + attached.target.artifact.validationContext history.locRel + state.stack rewrittenStack := by + obtain ⟨position, _member, _coordinate, current⟩ := + state.currentOwnership + let roots := Lower.Sim.rootsForCapabilities + position.sourceCapabilities.toList state.source ++ state.frameRoots + have ownership : IxIR1.Sim.RootOwnership machine.store.heap roots := by + rw [state.heap_eq] + exact current.ownership + have supported : LiveStackSupportedByRoots roots state.stack := + state.stackRoots.mono (fun root member => + List.mem_append_right _ member) + let base := IxIR1.Sim.HeapHistoryIso.refl machine.store.heap + state.heapClosed + let history : IxIR1.Sim.HeapHistoryIso machine.store.heap + rewrittenStore.heap := + base.nodesEq rfl heap.nodes.symm + have self : ∀ {location : Nat}, + location < machine.store.heap.nodes.size → + history.locRel location location := by + intro location bound + exact ⟨rfl, bound⟩ + refine ⟨history, frame.identityOfInBounds self ?_ state.noCredits, + stack.identityOfSupported self ownership supported⟩ + intro index value live found + exact state.liveValueInBounds + (by simpa [frame.baselineDefinition] using live) found + +/-- Exact ownership of a unit-refcount current root turns the compiler's +framed-root support and an existing live stack relation into the physical +reuse stack-avoidance witness. -/ +theorem stackAvoidsOfSupportedUnit + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {limits : Validate.Limits} {validation : Validate.Context} + {rewrittenStore : IxIR1.Store} + (iso : IxIR1.Sim.HeapIso rewrittenStore state.sourceStore) + {baselineLocation rewrittenLocation : Nat} {node : IxIR1.Node} + {rest : List IxIR1.Sim.Root} + (locations : iso.locRel rewrittenLocation baselineLocation) + (found : state.sourceStore.get? baselineLocation = + some ⟨.shared, 1, node⟩) + (ownership : IxIR1.Sim.RootOwnership state.sourceStore + (⟨.shared, .loc baselineLocation⟩ :: rest)) + (rootsInRest : ∀ root ∈ state.frameRoots, root ∈ rest) + {rewrittenStack : List Continuation} + (stack : StableLiveStackIso limits validation + (fun baselineLocation rewrittenLocation => + iso.locRel rewrittenLocation baselineLocation) + state.stack rewrittenStack) : + StableLiveStackAvoids limits validation + (fun baselineLocation rewrittenLocation => + iso.locRel rewrittenLocation baselineLocation) + rewrittenLocation state.stack rewrittenStack := + stack.avoidsOfSupportedUnit iso locations found ownership rootsInRest + state.stackRoots + +/-- An accepted unit-refcount source parameter automatically avoids every +observable location in the related rewritten continuation stack. The +accepted-site syntax supplies liveness, the checked parameter audit supplies +the source owner, and the compiler's framed-root invariant supplies stack +support. -/ +theorem acceptedSiteStackAvoidsOfUnit + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (baselineDefinition : state.frame.definition = source) + {helperOffset : Nat} {block : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block} + (accepted : Reuse.FunctionDecisions.At rewrite.decisions state.frame.block + helperOffset block (.accepted site)) + (pc : state.frame.pc ≤ site.shape.releasePosition) + {baselineLocation rewrittenLocation : Nat} + (resolved : Eval.resolveAtom state.frame.values + (.reg site.shape.source) = .ok (.loc baselineLocation)) + {rewrittenStore : IxIR1.Store} + (iso : IxIR1.Sim.HeapIso rewrittenStore state.sourceStore) + (locations : iso.locRel rewrittenLocation baselineLocation) + {node : IxIR1.Node} + (sourceAt : state.sourceStore.get? baselineLocation = + some ⟨.shared, 1, node⟩) + {rewrittenStack : List Continuation} + (stack : StableLiveStackIso Validate.defaultLimits + attached.target.artifact.validationContext + (fun baselineLocation rewrittenLocation => + iso.locRel rewrittenLocation baselineLocation) + state.stack rewrittenStack) : + StableLiveStackAvoids Validate.defaultLimits + attached.target.artifact.validationContext + (fun baselineLocation rewrittenLocation => + iso.locRel rewrittenLocation baselineLocation) + rewrittenLocation state.stack rewrittenStack := by + obtain ⟨rest, ownership, rootsInRest⟩ := + state.acceptedSiteSourceRoot rewrite baselineDefinition accepted pc + resolved + exact state.stackAvoidsOfSupportedUnit iso locations sourceAt ownership + rootsInRest stack + +/-- Restrict an incoming allocation history to its live heap and discharge +the target-side obligations of a physical-hot accepted macro from baseline +producer accounting. In particular, the compiler invariant proves every +entry-live parameter is allocated, supports the suspended stack away from +the consumed source, and transports allocation field worlds across the +post-kill history. -/ +theorem acceptedHotPhysicalStableLiveMacroSimulationHistoryAtOfParameters + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (baselineDefinition : state.frame.definition = source) + {helperOffset : Nat} {block : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block} + (accepted : Reuse.FunctionDecisions.At rewrite.decisions state.frame.block + helperOffset block (.accepted site)) + (pc : state.frame.pc ≤ site.shape.releasePosition) + {baselineParameters : Array RVal} + (parameterCount : baselineParameters.size = site.shape.parameterCount) + (parameterValues : ∀ {index : Nat}, index < site.shape.parameterCount → + state.frame.values[index]? = baselineParameters[index]?) + {baselineContext rewrittenContext : Eval.Context} + (baselineSchemas : baselineContext.schemas = + attached.target.artifact.validationContext.schemas) + (rewrittenSchemas : rewrittenContext.schemas = + attached.target.artifact.validationContext.schemas) + {rewrittenStore baselineRetained baselineReleased : Store} + (history : IxIR1.Sim.HeapHistoryIso machine.store.heap + rewrittenStore.heap) + {rewrittenParameters : Array RVal} + {rewrittenStack : List Continuation} + (parameters : LiveValuesIso source state.frame.block 0 history.locRel + baselineParameters rewrittenParameters) + (stack : StableLiveStackIso Validate.defaultLimits + attached.target.artifact.validationContext history.locRel + state.stack rewrittenStack) + {baselineFields baselineNewFields baselineCallValues : Array RVal} + {baselineLocation fieldFuel remaining rewrittenFuel : Nat} + {oldRest newRest : List IxIR1.Sim.Root} + {allocationSchema : CtorSchema} + (fuel : fieldFuel + 1 ≤ rewrittenFuel) + (allocationSchemaAt : + baselineContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (fieldCount : baselineFields.size = site.shape.fieldCount) + (baselineSourceResolved : + resolveAtom baselineParameters (.reg site.shape.source) = + .ok (.loc baselineLocation)) + (baselineAt : machine.store.get? baselineLocation = some + ⟨.shared, 1, + .ctorN site.shape.sourceConstructor baselineFields⟩) + (baselineOwned : IxIR1.Sim.RootOwnership machine.store.heap + (⟨.shared, .loc baselineLocation⟩ :: oldRest)) + (rootsInRest : ∀ root ∈ state.frameRoots, root ∈ oldRest) + (retained : RetainSharedMany machine.store baselineFields + baselineRetained) + (released : releaseShared (fieldFuel + 1) baselineRetained + (.loc baselineLocation) = .ok (baselineReleased, remaining)) + (baselineNewOwned : IxIR1.Sim.RootOwnership baselineReleased.heap + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ newRest)) + (baselineMapped : MappedValuesInRoots site.shape + (baselinePrefixValues baselineParameters baselineFields) + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ + (newRest ++ inertRoots + (IxIR1.Sim.rootsFor .shared baselineFields.toList ++ oldRest)))) + (baselineAllocationResolved : resolveAtoms + (baselinePrefixValues baselineParameters baselineFields) + site.shape.allocationArguments = .ok baselineNewFields) + (baselineFieldWorlds : + FieldWorlds baselineReleased allocationSchema baselineNewFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues baselineParameters baselineFields).push + (.loc (baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor baselineNewFields)).2)) + site.shape.tailArguments = .ok baselineCallValues) + (arity : baselineCallValues.size = source.signature.params.size) : + let baselineMachine : Machine := + { store := machine.store + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := state.frame.block + values := baselineParameters + credits := #[] } + state.stack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := state.frame.block + values := rewrittenParameters + credits := #[] } + rewrittenStack } + StableLiveMacroSimulationAt Validate.defaultLimits + attached.target.artifact.validationContext baselineContext + rewrittenContext .physical (2 * site.shape.fieldCount + 3) + baselineMachine rewrittenMachine := by + dsimp only + let live := history.toHeapIso state.heapClosed + let inputIso := live.symm + have liveParameters : LiveValuesIso source state.frame.block 0 live.locRel + baselineParameters rewrittenParameters := + parameters.toHeapIsoOfLive history state.heapClosed + (by + intro index value live found + have inherited : index < site.shape.parameterCount := by + rw [← parameterCount] + exact (Array.getElem?_eq_some_iff.mp found).1 + exact state.acceptedParameterValueLive rewrite baselineDefinition + accepted pc inherited live ((parameterValues inherited).trans found)) + have liveStack : StableLiveStackIso Validate.defaultLimits + attached.target.artifact.validationContext live.locRel + state.stack rewrittenStack := + state.stackToHeapIso history stack + obtain ⟨sourceAt, _resetAt, _hotAt, _coldAt⟩ := + rewrite.acceptedAt accepted + have sourceLiveAtRelease : AtomLiveFrom source state.frame.block + site.shape.releasePosition (.reg site.shape.source) := + AtomLiveFrom.instruction sourceAt site.fits.release + Liveness.InstrUsesAtom.releaseShared + have sourceLive : AtomLiveFrom source state.frame.block 0 + (.reg site.shape.source) := + sourceLiveAtRelease.mono (Nat.zero_le _) + obtain ⟨rewrittenSourceValue, rewrittenSourceResolved, + sourceValueRelated⟩ := + liveParameters.resolveAtom sourceLive baselineSourceResolved + cases sourceValueRelated with + | @loc _ rewrittenLocation locations => + obtain ⟨baselineBox, rewrittenBox, baselineLive, rewrittenLive, + boxesRelated⟩ := live.related_live locations + have baselineBoxEq : baselineBox = + ⟨.shared, 1, + .ctorN site.shape.sourceConstructor baselineFields⟩ := + Option.some.inj (baselineLive.symm.trans baselineAt) + subst baselineBox + obtain ⟨rewrittenFields, rewrittenNode, fieldsRelated⟩ := + nodeIso_ctor_left boxesRelated.node + have rewrittenBoxEq : rewrittenBox = + ⟨.shared, 1, + .ctorN site.shape.sourceConstructor rewrittenFields⟩ := by + cases rewrittenBox + cases boxesRelated.world + cases boxesRelated.rc + cases rewrittenNode + rfl + subst rewrittenBox + have rewrittenAt : rewrittenStore.get? rewrittenLocation = some + ⟨.shared, 1, + .ctorN site.shape.sourceConstructor rewrittenFields⟩ := + rewrittenLive + have prefixLive : LiveValuesIso source state.frame.block 0 + live.locRel + (baselinePrefixValues baselineParameters baselineFields) + (baselinePrefixValues rewrittenParameters rewrittenFields) := by + simpa [baselinePrefixValues] using + (liveParameters.append fieldsRelated).append fieldsRelated + have allocationLiveAt : AtomsLiveFrom source state.frame.block + (site.shape.releasePosition + 1) + site.shape.allocationArguments := + AtomsLiveFrom.instruction sourceAt site.fits.allocation (by + intro atom member + exact Liveness.InstrUsesAtom.alloc member) + have allocationLive : AtomsLiveFrom source state.frame.block 0 + site.shape.allocationArguments := + allocationLiveAt.mono (Nat.zero_le _) + obtain ⟨rewrittenNewFields, rewrittenAllocationResolved, + newFieldsRelated⟩ := + prefixLive.resolveAtoms allocationLive baselineAllocationResolved + let head : IxIR1.Sim.RootIso inputIso.locRel + ⟨.shared, .loc rewrittenLocation⟩ + ⟨.shared, .loc baselineLocation⟩ := + ⟨rfl, .loc locations⟩ + obtain ⟨rewrittenRest, _rootsRelated, rewrittenOwned⟩ := + inputIso.rootOwnershipPreimageCons head baselineOwned + have stackAvoids : StableLiveStackAvoids Validate.defaultLimits + attached.target.artifact.validationContext live.locRel + rewrittenLocation state.stack rewrittenStack := by + exact liveStack.avoidsOfSupportedUnit inputIso locations baselineAt + baselineOwned rootsInRest state.stackRoots + have prefixContents : HeapContentsEq baselineReleased + (logicalHotResetStore machine.store baselineLocation) := + hotPrefix_contents baselineAt baselineOwned retained released + have baselineResetWorlds : FieldWorlds + (logicalHotResetStore machine.store baselineLocation) + allocationSchema baselineNewFields := + prefixContents.fieldWorlds baselineFieldWorlds + obtain ⟨_sourceSchema, siteAllocationSchema, _sourceSchemaAt, + siteAllocationSchemaAt, sourceSchemaFields, + allocationSchemaFields, _sourceLayout, _allocationLayout⟩ := + evalRuntimeSchemas site baselineSchemas + have allocationSchemaEq : siteAllocationSchema = allocationSchema := + Option.some.inj + (siteAllocationSchemaAt.symm.trans allocationSchemaAt) + subst siteAllocationSchema + have uniformAllocationFields : allocationSchema.fields = + Array.replicate site.shape.fieldCount .shared := + allocationSchemaFields.trans sourceSchemaFields + have baselineMissing : baselineReleased.get? baselineLocation = + none := by + rw [prefixContents.get?_eq baselineLocation] + change (logicalHotResetStore machine.store baselineLocation).heap.get? + baselineLocation = none + rw [logicalHotResetStore_heap] + exact IxIR1.Sim.get?_kill_same baselineAt + have baselineNewFieldsAvoid : + ∀ value ∈ baselineNewFields.toList, + value ≠ .loc baselineLocation := + FieldWorlds.avoidsMissing uniformAllocationFields + baselineFieldWorlds baselineMissing + have rewrittenNewFieldsAvoid : + ∀ value ∈ rewrittenNewFields.toList, + value ≠ .loc rewrittenLocation := + rvalsIso_right_avoids_of_left inputIso locations + newFieldsRelated baselineNewFieldsAvoid + have restrictedNewFields : IxIR1.Sim.RValsIso + (fun rewrittenCandidate baselineCandidate => + inputIso.locRel rewrittenCandidate baselineCandidate ∧ + rewrittenCandidate ≠ rewrittenLocation) + rewrittenNewFields.toList baselineNewFields.toList := + rvalsIso_restrict_left + (IxIR1.Sim.RValsIso.symm newFieldsRelated) + rewrittenNewFieldsAvoid + let killed := heapIsoKillShared inputIso locations rewrittenAt + baselineAt rewrittenOwned + let killedHistory := heapIsoToHistory killed + have physicalNodes : + (physicalHotResetStore rewrittenStore rewrittenLocation).heap.nodes = + (rewrittenStore.heap.kill rewrittenLocation).nodes := by + rw [physicalHotResetStore_nodes] + rfl + have logicalNodes : + (logicalHotResetStore machine.store baselineLocation).heap.nodes = + (machine.store.heap.kill baselineLocation).nodes := by + rw [logicalHotResetStore_heap] + let resetHistory : IxIR1.Sim.HeapHistoryIso + (physicalHotResetStore rewrittenStore rewrittenLocation).heap + (logicalHotResetStore machine.store baselineLocation).heap := + killedHistory.nodesEq physicalNodes logicalNodes + have baselineToRewrittenNewFields : IxIR1.Sim.RValsIso + resetHistory.symm.locRel baselineNewFields.toList + rewrittenNewFields.toList := by + exact IxIR1.Sim.RValsIso.symm restrictedNewFields + have rewrittenFieldWorlds : FieldWorlds + (physicalHotResetStore rewrittenStore rewrittenLocation) + allocationSchema rewrittenNewFields := + baselineResetWorlds.transport + (heapHistoryIso_fieldValuesWorldEq resetHistory.symm + baselineToRewrittenNewFields) + exact acceptedHotPhysicalStableLiveMacroSimulationIsoOfAccountingAt + rewrite accepted baselineSchemas rewrittenSchemas inputIso + liveParameters stackAvoids fuel locations allocationSchemaAt + parameterCount fieldCount baselineSourceResolved + rewrittenSourceResolved baselineAt rewrittenAt baselineOwned + retained released baselineNewOwned baselineMapped + baselineAllocationResolved rewrittenAllocationResolved + baselineFieldWorlds rewrittenFieldWorlds tailResolved arity + + +/-- Specialize the inherited-parameter macro to a traced zero-PC entry. -/ +theorem acceptedHotPhysicalStableLiveMacroSimulationHistoryAt + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (baselineDefinition : state.frame.definition = source) + {helperOffset : Nat} {block : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block} + (accepted : Reuse.FunctionDecisions.At rewrite.decisions state.frame.block + helperOffset block (.accepted site)) + (pc : state.frame.pc = 0) + {baselineContext rewrittenContext : Eval.Context} + (baselineSchemas : baselineContext.schemas = + attached.target.artifact.validationContext.schemas) + (rewrittenSchemas : rewrittenContext.schemas = + attached.target.artifact.validationContext.schemas) + {rewrittenStore baselineRetained baselineReleased : Store} + (history : IxIR1.Sim.HeapHistoryIso machine.store.heap + rewrittenStore.heap) + {rewrittenParameters : Array RVal} + {rewrittenStack : List Continuation} + (parameters : LiveValuesIso source state.frame.block 0 history.locRel + state.frame.values rewrittenParameters) + (stack : StableLiveStackIso Validate.defaultLimits + attached.target.artifact.validationContext history.locRel + state.stack rewrittenStack) + {baselineFields baselineNewFields baselineCallValues : Array RVal} + {baselineLocation fieldFuel remaining rewrittenFuel : Nat} + {oldRest newRest : List IxIR1.Sim.Root} + {allocationSchema : CtorSchema} + (fuel : fieldFuel + 1 ≤ rewrittenFuel) + (allocationSchemaAt : + baselineContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (fieldCount : baselineFields.size = site.shape.fieldCount) + (baselineSourceResolved : + resolveAtom state.frame.values (.reg site.shape.source) = + .ok (.loc baselineLocation)) + (baselineAt : machine.store.get? baselineLocation = some + ⟨.shared, 1, + .ctorN site.shape.sourceConstructor baselineFields⟩) + (baselineOwned : IxIR1.Sim.RootOwnership machine.store.heap + (⟨.shared, .loc baselineLocation⟩ :: oldRest)) + (rootsInRest : ∀ root ∈ state.frameRoots, root ∈ oldRest) + (retained : RetainSharedMany machine.store baselineFields + baselineRetained) + (released : releaseShared (fieldFuel + 1) baselineRetained + (.loc baselineLocation) = .ok (baselineReleased, remaining)) + (baselineNewOwned : IxIR1.Sim.RootOwnership baselineReleased.heap + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ newRest)) + (baselineMapped : MappedValuesInRoots site.shape + (baselinePrefixValues state.frame.values baselineFields) + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ + (newRest ++ inertRoots + (IxIR1.Sim.rootsFor .shared baselineFields.toList ++ oldRest)))) + (baselineAllocationResolved : resolveAtoms + (baselinePrefixValues state.frame.values baselineFields) + site.shape.allocationArguments = .ok baselineNewFields) + (baselineFieldWorlds : + FieldWorlds baselineReleased allocationSchema baselineNewFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues state.frame.values baselineFields).push + (.loc (baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor baselineNewFields)).2)) + site.shape.tailArguments = .ok baselineCallValues) + (arity : baselineCallValues.size = source.signature.params.size) : + let baselineMachine : Machine := + { store := machine.store + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := state.frame.block + values := state.frame.values + credits := #[] } + state.stack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := state.frame.block + values := rewrittenParameters + credits := #[] } + rewrittenStack } + StableLiveMacroSimulationAt Validate.defaultLimits + attached.target.artifact.validationContext baselineContext + rewrittenContext .physical (2 * site.shape.fieldCount + 3) + baselineMachine rewrittenMachine := by + exact state.acceptedHotPhysicalStableLiveMacroSimulationHistoryAtOfParameters + rewrite baselineDefinition accepted (by omega) + (state.acceptedSiteParameterCount rewrite baselineDefinition accepted pc) + (by intro index bound; rfl) baselineSchemas rewrittenSchemas history + parameters stack fuel allocationSchemaAt fieldCount baselineSourceResolved + baselineAt baselineOwned rootsInRest retained released baselineNewOwned + baselineMapped baselineAllocationResolved baselineFieldWorlds tailResolved + arity + +/-- Compatibility wrapper that forgets the baseline-length index. -/ +theorem acceptedHotPhysicalStableLiveMacroSimulationHistory + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (baselineDefinition : state.frame.definition = source) + {helperOffset : Nat} {block : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block} + (accepted : Reuse.FunctionDecisions.At rewrite.decisions state.frame.block + helperOffset block (.accepted site)) + (pc : state.frame.pc = 0) + {baselineContext rewrittenContext : Eval.Context} + (baselineSchemas : baselineContext.schemas = + attached.target.artifact.validationContext.schemas) + (rewrittenSchemas : rewrittenContext.schemas = + attached.target.artifact.validationContext.schemas) + {rewrittenStore baselineRetained baselineReleased : Store} + (history : IxIR1.Sim.HeapHistoryIso machine.store.heap + rewrittenStore.heap) + {rewrittenParameters : Array RVal} + {rewrittenStack : List Continuation} + (parameters : LiveValuesIso source state.frame.block 0 history.locRel + state.frame.values rewrittenParameters) + (stack : StableLiveStackIso Validate.defaultLimits + attached.target.artifact.validationContext history.locRel + state.stack rewrittenStack) + {baselineFields baselineNewFields baselineCallValues : Array RVal} + {baselineLocation fieldFuel remaining rewrittenFuel : Nat} + {oldRest newRest : List IxIR1.Sim.Root} + {allocationSchema : CtorSchema} + (fuel : fieldFuel + 1 ≤ rewrittenFuel) + (allocationSchemaAt : + baselineContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (fieldCount : baselineFields.size = site.shape.fieldCount) + (baselineSourceResolved : + resolveAtom state.frame.values (.reg site.shape.source) = + .ok (.loc baselineLocation)) + (baselineAt : machine.store.get? baselineLocation = some + ⟨.shared, 1, + .ctorN site.shape.sourceConstructor baselineFields⟩) + (baselineOwned : IxIR1.Sim.RootOwnership machine.store.heap + (⟨.shared, .loc baselineLocation⟩ :: oldRest)) + (rootsInRest : ∀ root ∈ state.frameRoots, root ∈ oldRest) + (retained : RetainSharedMany machine.store baselineFields + baselineRetained) + (released : releaseShared (fieldFuel + 1) baselineRetained + (.loc baselineLocation) = .ok (baselineReleased, remaining)) + (baselineNewOwned : IxIR1.Sim.RootOwnership baselineReleased.heap + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ newRest)) + (baselineMapped : MappedValuesInRoots site.shape + (baselinePrefixValues state.frame.values baselineFields) + (newRest ++ inertRoots + (IxIR1.Sim.rootsFor .shared baselineFields.toList ++ oldRest))) + (baselineAllocationResolved : resolveAtoms + (baselinePrefixValues state.frame.values baselineFields) + site.shape.allocationArguments = .ok baselineNewFields) + (baselineFieldWorlds : + FieldWorlds baselineReleased allocationSchema baselineNewFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues state.frame.values baselineFields).push + (.loc (baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor baselineNewFields)).2)) + site.shape.tailArguments = .ok baselineCallValues) + (arity : baselineCallValues.size = source.signature.params.size) : + let baselineMachine : Machine := + { store := machine.store + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := state.frame.block + values := state.frame.values + credits := #[] } + state.stack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := state.frame.block + values := rewrittenParameters + credits := #[] } + rewrittenStack } + StableLiveMacroSimulation Validate.defaultLimits + attached.target.artifact.validationContext baselineContext + rewrittenContext .physical baselineMachine rewrittenMachine := by + have baselineMappedFull : MappedValuesInRoots site.shape + (baselinePrefixValues state.frame.values baselineFields) + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ + (newRest ++ inertRoots + (IxIR1.Sim.rootsFor .shared baselineFields.toList ++ oldRest))) := + MappedValuesInRoots.mono baselineMapped (by + intro root member + exact List.mem_append_right _ member) + exact (state.acceptedHotPhysicalStableLiveMacroSimulationHistoryAt rewrite + baselineDefinition accepted pc baselineSchemas rewrittenSchemas history + parameters stack fuel allocationSchemaAt fieldCount + baselineSourceResolved baselineAt baselineOwned rootsInRest retained + released baselineNewOwned baselineMappedFull baselineAllocationResolved + baselineFieldWorlds tailResolved arity).simulation + +/-- Dispatch an accepted physical-runtime site from allocation history using +only baseline producer facts. Exact ownership rules out a zero refcount. A +unit count enters the live-heap physical reuse adapter above; every larger +count is the history-aware cold macro after identifying the non-final release +store and residual fuel. -/ +theorem acceptedPhysicalStableLiveMacroSimulationHistoryAtOfParameters + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (baselineDefinition : state.frame.definition = source) + {helperOffset : Nat} {block : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block} + (accepted : Reuse.FunctionDecisions.At rewrite.decisions state.frame.block + helperOffset block (.accepted site)) + (pc : state.frame.pc ≤ site.shape.releasePosition) + {baselineParameters : Array RVal} + (parameterCount : baselineParameters.size = site.shape.parameterCount) + (parameterValues : ∀ {index : Nat}, index < site.shape.parameterCount → + state.frame.values[index]? = baselineParameters[index]?) + {baselineContext rewrittenContext : Eval.Context} + (baselineSchemas : baselineContext.schemas = + attached.target.artifact.validationContext.schemas) + (rewrittenSchemas : rewrittenContext.schemas = + attached.target.artifact.validationContext.schemas) + {rewrittenStore baselineRetained baselineReleased : Store} + (history : IxIR1.Sim.HeapHistoryIso machine.store.heap + rewrittenStore.heap) + {rewrittenParameters : Array RVal} + {rewrittenStack : List Continuation} + (parameters : LiveValuesIso source state.frame.block 0 history.locRel + baselineParameters rewrittenParameters) + (stack : StableLiveStackIso Validate.defaultLimits + attached.target.artifact.validationContext history.locRel + state.stack rewrittenStack) + {baselineFields baselineNewFields baselineCallValues : Array RVal} + {baselineLocation fieldFuel remaining rewrittenFuel rc retainedRc : Nat} + {oldRest newRest : List IxIR1.Sim.Root} + {allocationSchema : CtorSchema} + (fuel : fieldFuel + 1 ≤ rewrittenFuel) + (allocationSchemaAt : + baselineContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (fieldCount : baselineFields.size = site.shape.fieldCount) + (baselineSourceResolved : + resolveAtom baselineParameters (.reg site.shape.source) = + .ok (.loc baselineLocation)) + (baselineAt : machine.store.get? baselineLocation = some + ⟨.shared, rc, + .ctorN site.shape.sourceConstructor baselineFields⟩) + (baselineOwned : IxIR1.Sim.RootOwnership machine.store.heap + (⟨.shared, .loc baselineLocation⟩ :: oldRest)) + (rootsInRest : ∀ root ∈ state.frameRoots, root ∈ oldRest) + (retained : RetainSharedMany machine.store baselineFields + baselineRetained) + (retainedAt : baselineRetained.get? baselineLocation = some + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor baselineFields⟩) + (released : releaseShared (fieldFuel + 1) baselineRetained + (.loc baselineLocation) = .ok (baselineReleased, remaining)) + (baselineNewOwned : IxIR1.Sim.RootOwnership baselineReleased.heap + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ newRest)) + (baselineMapped : MappedValuesInRoots site.shape + (baselinePrefixValues baselineParameters baselineFields) + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ + (newRest ++ inertRoots + (IxIR1.Sim.rootsFor .shared baselineFields.toList ++ oldRest)))) + (baselineAllocationResolved : resolveAtoms + (baselinePrefixValues baselineParameters baselineFields) + site.shape.allocationArguments = .ok baselineNewFields) + (baselineFieldWorlds : + FieldWorlds baselineReleased allocationSchema baselineNewFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues baselineParameters baselineFields).push + (.loc (baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor baselineNewFields)).2)) + site.shape.tailArguments = .ok baselineCallValues) + (arity : baselineCallValues.size = source.signature.params.size) : + let baselineMachine : Machine := + { store := machine.store + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := state.frame.block + values := baselineParameters + credits := #[] } + state.stack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := state.frame.block + values := rewrittenParameters + credits := #[] } + rewrittenStack } + StableLiveMacroSimulationAt Validate.defaultLimits + attached.target.artifact.validationContext baselineContext + rewrittenContext .physical (2 * site.shape.fieldCount + 3) + baselineMachine rewrittenMachine := by + have positive : 0 < rc := baselineOwned.shared_rc_pos baselineAt + by_cases unit : rc = 1 + · subst rc + exact state.acceptedHotPhysicalStableLiveMacroSimulationHistoryAtOfParameters + rewrite baselineDefinition accepted pc parameterCount parameterValues + baselineSchemas rewrittenSchemas history + parameters stack fuel allocationSchemaAt fieldCount + baselineSourceResolved baselineAt baselineOwned rootsInRest retained + released baselineNewOwned baselineMapped baselineAllocationResolved + baselineFieldWorlds tailResolved arity + · have shared : 1 < rc := by omega + obtain ⟨actualRetainedRc, actualRetainedAt, expectedReleased, + _resetRetained, _heapEq⟩ := + coldPrefix_commutes (heapFuel := fieldFuel) baselineAt shared retained + have retainedRcEq : actualRetainedRc = retainedRc := by + have boxesEq := Option.some.inj + (actualRetainedAt.symm.trans retainedAt) + exact congrArg IxIR1.NodeBox.rc boxesEq + subst actualRetainedRc + have outputsEq : + (baselineDecrementStore baselineRetained baselineLocation + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor baselineFields⟩, + fieldFuel) = (baselineReleased, remaining) := + Except.ok.inj (expectedReleased.symm.trans released) + injection outputsEq with storeEq fuelEq + subst baselineReleased + subst remaining + exact acceptedColdStableLiveMacroSimulationIsoAt rewrite accepted + baselineSchemas rewrittenSchemas history parameters stack fuel + allocationSchemaAt parameterCount fieldCount baselineSourceResolved + baselineAt shared retained retainedAt baselineAllocationResolved + baselineFieldWorlds tailResolved arity + + +/-- Specialize the inherited-parameter macro to a traced zero-PC entry. -/ +theorem acceptedPhysicalStableLiveMacroSimulationHistoryAt + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (baselineDefinition : state.frame.definition = source) + {helperOffset : Nat} {block : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block} + (accepted : Reuse.FunctionDecisions.At rewrite.decisions state.frame.block + helperOffset block (.accepted site)) + (pc : state.frame.pc = 0) + {baselineContext rewrittenContext : Eval.Context} + (baselineSchemas : baselineContext.schemas = + attached.target.artifact.validationContext.schemas) + (rewrittenSchemas : rewrittenContext.schemas = + attached.target.artifact.validationContext.schemas) + {rewrittenStore baselineRetained baselineReleased : Store} + (history : IxIR1.Sim.HeapHistoryIso machine.store.heap + rewrittenStore.heap) + {rewrittenParameters : Array RVal} + {rewrittenStack : List Continuation} + (parameters : LiveValuesIso source state.frame.block 0 history.locRel + state.frame.values rewrittenParameters) + (stack : StableLiveStackIso Validate.defaultLimits + attached.target.artifact.validationContext history.locRel + state.stack rewrittenStack) + {baselineFields baselineNewFields baselineCallValues : Array RVal} + {baselineLocation fieldFuel remaining rewrittenFuel rc retainedRc : Nat} + {oldRest newRest : List IxIR1.Sim.Root} + {allocationSchema : CtorSchema} + (fuel : fieldFuel + 1 ≤ rewrittenFuel) + (allocationSchemaAt : + baselineContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (fieldCount : baselineFields.size = site.shape.fieldCount) + (baselineSourceResolved : + resolveAtom state.frame.values (.reg site.shape.source) = + .ok (.loc baselineLocation)) + (baselineAt : machine.store.get? baselineLocation = some + ⟨.shared, rc, + .ctorN site.shape.sourceConstructor baselineFields⟩) + (baselineOwned : IxIR1.Sim.RootOwnership machine.store.heap + (⟨.shared, .loc baselineLocation⟩ :: oldRest)) + (rootsInRest : ∀ root ∈ state.frameRoots, root ∈ oldRest) + (retained : RetainSharedMany machine.store baselineFields + baselineRetained) + (retainedAt : baselineRetained.get? baselineLocation = some + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor baselineFields⟩) + (released : releaseShared (fieldFuel + 1) baselineRetained + (.loc baselineLocation) = .ok (baselineReleased, remaining)) + (baselineNewOwned : IxIR1.Sim.RootOwnership baselineReleased.heap + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ newRest)) + (baselineMapped : MappedValuesInRoots site.shape + (baselinePrefixValues state.frame.values baselineFields) + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ + (newRest ++ inertRoots + (IxIR1.Sim.rootsFor .shared baselineFields.toList ++ oldRest)))) + (baselineAllocationResolved : resolveAtoms + (baselinePrefixValues state.frame.values baselineFields) + site.shape.allocationArguments = .ok baselineNewFields) + (baselineFieldWorlds : + FieldWorlds baselineReleased allocationSchema baselineNewFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues state.frame.values baselineFields).push + (.loc (baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor baselineNewFields)).2)) + site.shape.tailArguments = .ok baselineCallValues) + (arity : baselineCallValues.size = source.signature.params.size) : + let baselineMachine : Machine := + { store := machine.store + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := state.frame.block + values := state.frame.values + credits := #[] } + state.stack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := state.frame.block + values := rewrittenParameters + credits := #[] } + rewrittenStack } + StableLiveMacroSimulationAt Validate.defaultLimits + attached.target.artifact.validationContext baselineContext + rewrittenContext .physical (2 * site.shape.fieldCount + 3) + baselineMachine rewrittenMachine := by + exact state.acceptedPhysicalStableLiveMacroSimulationHistoryAtOfParameters + rewrite baselineDefinition accepted (by omega) + (state.acceptedSiteParameterCount rewrite baselineDefinition accepted pc) + (by intro index bound; rfl) baselineSchemas rewrittenSchemas history + parameters stack fuel allocationSchemaAt fieldCount baselineSourceResolved + baselineAt baselineOwned rootsInRest retained retainedAt released + baselineNewOwned baselineMapped baselineAllocationResolved + baselineFieldWorlds tailResolved arity + +/-- Compatibility wrapper that forgets the baseline-length index. -/ +theorem acceptedPhysicalStableLiveMacroSimulationHistory + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (baselineDefinition : state.frame.definition = source) + {helperOffset : Nat} {block : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block} + (accepted : Reuse.FunctionDecisions.At rewrite.decisions state.frame.block + helperOffset block (.accepted site)) + (pc : state.frame.pc = 0) + {baselineContext rewrittenContext : Eval.Context} + (baselineSchemas : baselineContext.schemas = + attached.target.artifact.validationContext.schemas) + (rewrittenSchemas : rewrittenContext.schemas = + attached.target.artifact.validationContext.schemas) + {rewrittenStore baselineRetained baselineReleased : Store} + (history : IxIR1.Sim.HeapHistoryIso machine.store.heap + rewrittenStore.heap) + {rewrittenParameters : Array RVal} + {rewrittenStack : List Continuation} + (parameters : LiveValuesIso source state.frame.block 0 history.locRel + state.frame.values rewrittenParameters) + (stack : StableLiveStackIso Validate.defaultLimits + attached.target.artifact.validationContext history.locRel + state.stack rewrittenStack) + {baselineFields baselineNewFields baselineCallValues : Array RVal} + {baselineLocation fieldFuel remaining rewrittenFuel rc retainedRc : Nat} + {oldRest newRest : List IxIR1.Sim.Root} + {allocationSchema : CtorSchema} + (fuel : fieldFuel + 1 ≤ rewrittenFuel) + (allocationSchemaAt : + baselineContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (fieldCount : baselineFields.size = site.shape.fieldCount) + (baselineSourceResolved : + resolveAtom state.frame.values (.reg site.shape.source) = + .ok (.loc baselineLocation)) + (baselineAt : machine.store.get? baselineLocation = some + ⟨.shared, rc, + .ctorN site.shape.sourceConstructor baselineFields⟩) + (baselineOwned : IxIR1.Sim.RootOwnership machine.store.heap + (⟨.shared, .loc baselineLocation⟩ :: oldRest)) + (rootsInRest : ∀ root ∈ state.frameRoots, root ∈ oldRest) + (retained : RetainSharedMany machine.store baselineFields + baselineRetained) + (retainedAt : baselineRetained.get? baselineLocation = some + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor baselineFields⟩) + (released : releaseShared (fieldFuel + 1) baselineRetained + (.loc baselineLocation) = .ok (baselineReleased, remaining)) + (baselineNewOwned : IxIR1.Sim.RootOwnership baselineReleased.heap + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ newRest)) + (baselineMapped : MappedValuesInRoots site.shape + (baselinePrefixValues state.frame.values baselineFields) + (newRest ++ inertRoots + (IxIR1.Sim.rootsFor .shared baselineFields.toList ++ oldRest))) + (baselineAllocationResolved : resolveAtoms + (baselinePrefixValues state.frame.values baselineFields) + site.shape.allocationArguments = .ok baselineNewFields) + (baselineFieldWorlds : + FieldWorlds baselineReleased allocationSchema baselineNewFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues state.frame.values baselineFields).push + (.loc (baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor baselineNewFields)).2)) + site.shape.tailArguments = .ok baselineCallValues) + (arity : baselineCallValues.size = source.signature.params.size) : + let baselineMachine : Machine := + { store := machine.store + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := state.frame.block + values := state.frame.values + credits := #[] } + state.stack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := state.frame.block + values := rewrittenParameters + credits := #[] } + rewrittenStack } + StableLiveMacroSimulation Validate.defaultLimits + attached.target.artifact.validationContext baselineContext + rewrittenContext .physical baselineMachine rewrittenMachine := by + have baselineMappedFull : MappedValuesInRoots site.shape + (baselinePrefixValues state.frame.values baselineFields) + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ + (newRest ++ inertRoots + (IxIR1.Sim.rootsFor .shared baselineFields.toList ++ oldRest))) := + MappedValuesInRoots.mono baselineMapped (by + intro root member + exact List.mem_append_right _ member) + exact (state.acceptedPhysicalStableLiveMacroSimulationHistoryAt rewrite + baselineDefinition accepted pc baselineSchemas rewrittenSchemas history + parameters stack fuel allocationSchemaAt fieldCount + baselineSourceResolved baselineAt baselineOwned rootsInRest retained + retainedAt released baselineNewOwned baselineMappedFull + baselineAllocationResolved baselineFieldWorlds tailResolved arity).simulation + +/-- The attached closed main establishes every field of the compiler runtime +state at the exact machine consumed by `runMain`. -/ +def initial + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + (attached : Pipeline.CompiledAttachment mainWorld lowerFuel) (heapFuel : Nat) : + CompilerRunningState attached + (Lower.Sim.initialMainMachine attached.target.artifact heapFuel) := by + let frame := Lower.Sim.initialMainFrame attached.target.artifact + let machine := Lower.Sim.initialMainMachine attached.target.artifact heapFuel + refine + { functionTrace := attached.target.artifact.mainTrace + trace := attached.target.artifact.mainTrace.root + sourceStore := {} + source := [] + frameRoots := [] + frame := frame + stack := [] + member := attached.target.artifact.mainTraceMember + descendant := .refl + traceState := by + simpa [frame] using attached.initialMainTraceState + stores := by + simpa [machine, Lower.Sim.initialMainMachine] using + Lower.Sim.StoreRel.initial + runtime := Lower.Sim.SourceRuntimeInvariant.empty + ownership := attached.initialMainSourceOwnership + stackRoots := .nil + callStack := .nil + history := by simp [CompilerStackHistory, CompilerStackCompletion] + image := attached.sourceStoreImage_empty + control := by rfl + noCredits := by rfl } + +end CompilerRunningState + +/-- Global invariant for the compiler/reuse composition: the +baseline state is justified by the lowering attachment and the two machines +are related modulo only future-observable registers. Allocation-event equality +and RC/peak bounds are separate components. Compiler-aware macros preserve the invariant, with +accepted-site runtime premises reconstructed from actual execution. -/ +structure AttachedStableState + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + (baseline rewritten : Machine) : Prop where + compiler : CompilerState attached baseline + related : StableLiveMachineRel Validate.defaultLimits + attached.target.artifact.validationContext baseline rewritten + acceptedEntry : StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext baseline rewritten + allocations : baseline.store.allocationEvents = rewritten.store.allocationEvents + costs : baseline.store.CostBounds rewritten.store + + +/-- A synchronization macro paired with the concrete compiler state at its +baseline endpoint and separate allocation and cost deltas. This is the local +preservation object consumed by the whole-execution compiler/reuse invariant. -/ +inductive AttachedStableMacroStep + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + (baselineContext rewrittenContext : Eval.Context) + (interpretation : Interpretation) + (baselineStart rewrittenStart : Machine) : Prop where + | intro (baselineCount rewrittenCount : Nat) + (baselinePositive : 0 < baselineCount) + (rewrittenPositive : 0 < rewrittenCount) + (baselineTarget rewrittenTarget : Machine) + (baselineSteps : Steps baselineContext interpretation baselineCount + baselineStart baselineTarget) + (rewrittenSteps : Steps rewrittenContext interpretation rewrittenCount + rewrittenStart rewrittenTarget) + (related : StableLiveMachineRel Validate.defaultLimits + attached.target.artifact.validationContext baselineTarget + rewrittenTarget) + (acceptedEntry : StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext baselineTarget + rewrittenTarget) + (compiler : CompilerState attached baselineTarget) + (allocationDelta : AllocationDelta baselineStart.store baselineTarget.store + rewrittenStart.store rewrittenTarget.store) + (costDelta : CostDelta baselineStart.store baselineTarget.store + rewrittenStart.store rewrittenTarget.store) : + AttachedStableMacroStep optimized baselineContext rewrittenContext + interpretation baselineStart rewrittenStart + +/-- Forget the compiler endpoint while retaining both positive executions and +their live-indexed machine relation. -/ +theorem AttachedStableMacroStep.simulation + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {optimized : OptimizedAttachment attached} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStart rewrittenStart : Machine} + (step : AttachedStableMacroStep optimized baselineContext + rewrittenContext interpretation baselineStart rewrittenStart) : + StableLiveMacroSimulation Validate.defaultLimits + attached.target.artifact.validationContext baselineContext + rewrittenContext interpretation baselineStart rewrittenStart := by + cases step with + | intro baselineCount rewrittenCount baselinePositive rewrittenPositive + baselineTarget rewrittenTarget baselineSteps rewrittenSteps related _ _ _ _ => + exact .intro baselineCount rewrittenCount baselinePositive + rewrittenPositive baselineTarget rewrittenTarget baselineSteps + rewrittenSteps related + +/-- Join fixed-length semantic reuse with the independently reconstructed +compiler prefix. Since both baseline executions have the same start and +length, evaluator determinism identifies their endpoints; the compiler state +and accepted-entry phase can therefore be attached without assuming a +generic macro-length uniqueness principle. -/ +theorem CompilerAcceptedMacroStepAt.attach + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {optimized : OptimizedAttachment attached} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} {count : Nat} + {baselineStart rewrittenStart : Machine} + (compilerMacro : CompilerAcceptedMacroStepAt attached baselineContext + interpretation count baselineStart) + (semantic : StableLiveMacroSimulationAt Validate.defaultLimits + attached.target.artifact.validationContext baselineContext + rewrittenContext interpretation count baselineStart rewrittenStart) : + AttachedStableMacroStep optimized baselineContext rewrittenContext + interpretation baselineStart rewrittenStart := by + cases compilerMacro with + | intro baselinePositive compilerTarget compilerSteps compiler + acceptedEntry => + cases semantic with + | intro _semanticPositive rewrittenCount rewrittenPositive + baselineTarget rewrittenTarget baselineSteps rewrittenSteps + related allocationDelta costDelta => + have targetEq : baselineTarget = compilerTarget := + Ix.Compiler.IxIR2.ReuseLiveSim.Steps.deterministic baselineSteps + compilerSteps + subst compilerTarget + exact .intro count rewrittenCount baselinePositive + rewrittenPositive baselineTarget rewrittenTarget baselineSteps + rewrittenSteps related (acceptedEntry related) compiler allocationDelta costDelta + +/-- Normalize a heap-budget update at a running frame after exposing the +fields fixed by an accepted block entry. -/ +private theorem machineWithHeapFuel_eq_runningEntry + {machine : Machine} {frame : Frame} {stack : List Continuation} + {source : Function} {heapFuel : Nat} + (control : machine.control = .running frame stack) + (definition : frame.definition = source) + (pc : frame.pc = 0) (credits : frame.credits = #[]) : + ({ machine with heapFuel := heapFuel } : Machine) = + { store := machine.store + heapFuel := heapFuel + control := .running + { definition := source + block := frame.block + values := frame.values + credits := #[] } + stack } := by + cases frame + simp_all + +/-- Attach the complete compiler-certified accepted prefix to the physical +hot/cold semantic dispatcher. The semantic theorem and compiler theorem see +the same funded baseline machine and the same visible prefix length, so their +recursive-call endpoints are identified by `Steps.deterministic`. -/ +theorem CompilerRunningState.acceptedPhysicalStableMacroStepHistoryOfFetched + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (frame : Frame) (baselineStack : List Continuation) + (control : machine.control = .running frame baselineStack) + (optimized : OptimizedAttachment attached) + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (baselineDefinition : frame.definition = source) + {helperOffset : Nat} {block : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block} + (accepted : Reuse.FunctionDecisions.At rewrite.decisions frame.block + helperOffset block (.accepted site)) + (pc : frame.pc = 0) + {baselineContext rewrittenContext : Eval.Context} + (baselineSchemas : baselineContext.schemas = + attached.target.artifact.validationContext.schemas) + (rewrittenSchemas : rewrittenContext.schemas = + attached.target.artifact.validationContext.schemas) + {baselineFields : Array RVal} + (parameterCount : frame.values.size = site.shape.parameterCount) + (fieldCount : baselineFields.size = site.shape.fieldCount) + (fetchState : CompilerRunningState attached + { machine with + control := .running + { frame with + pc := site.shape.fieldCount + values := frame.values ++ baselineFields } baselineStack }) + (fetchSteps : Steps baselineContext .physical site.shape.fieldCount machine + { machine with + control := .running + { frame with + pc := site.shape.fieldCount + values := frame.values ++ baselineFields } baselineStack }) + {rewrittenStore baselineRetained baselineReleased : Store} + (history : IxIR1.Sim.HeapHistoryIso machine.store.heap + rewrittenStore.heap) + {rewrittenParameters : Array RVal} + {rewrittenStack : List Continuation} + (parameters : LiveValuesIso source frame.block 0 history.locRel + frame.values rewrittenParameters) + (stack : StableLiveStackIso Validate.defaultLimits + attached.target.artifact.validationContext history.locRel + baselineStack rewrittenStack) + {baselineNewFields baselineCallValues : Array RVal} + {baselineLocation fieldFuel remaining rewrittenFuel rc retainedRc : Nat} + {oldRest newRest : List IxIR1.Sim.Root} + {allocationSchema : CtorSchema} + (fuel : fieldFuel + 1 ≤ rewrittenFuel) + (budget : machine.heapFuel = fieldFuel + 1) + (allocationSchemaAt : + baselineContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (baselineSourceResolved : + resolveAtom frame.values (.reg site.shape.source) = + .ok (.loc baselineLocation)) + (baselineAt : machine.store.get? baselineLocation = some + ⟨.shared, rc, + .ctorN site.shape.sourceConstructor baselineFields⟩) + (baselineOwned : IxIR1.Sim.RootOwnership machine.store.heap + (⟨.shared, .loc baselineLocation⟩ :: oldRest)) + (rootsInRest : ∀ root ∈ fetchState.frameRoots, root ∈ oldRest) + (retained : RetainSharedMany machine.store baselineFields + baselineRetained) + (retainedAt : baselineRetained.get? baselineLocation = some + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor baselineFields⟩) + (released : releaseShared (fieldFuel + 1) baselineRetained + (.loc baselineLocation) = .ok (baselineReleased, remaining)) + (baselineNewOwned : IxIR1.Sim.RootOwnership baselineReleased.heap + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ newRest)) + (baselineMapped : MappedValuesInRoots site.shape + (baselinePrefixValues frame.values baselineFields) + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ + (newRest ++ inertRoots + (IxIR1.Sim.rootsFor .shared baselineFields.toList ++ oldRest)))) + (baselineAllocationResolved : resolveAtoms + (baselinePrefixValues frame.values baselineFields) + site.shape.allocationArguments = .ok baselineNewFields) + (baselineFieldWorlds : + FieldWorlds baselineReleased allocationSchema baselineNewFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues frame.values baselineFields).push + (.loc (baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor baselineNewFields)).2)) + site.shape.tailArguments = .ok baselineCallValues) + (arity : baselineCallValues.size = source.signature.params.size) : + let baselineMachine : Machine := machine + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := frame.block + values := rewrittenParameters + credits := #[] } + rewrittenStack } + AttachedStableMacroStep optimized baselineContext rewrittenContext + .physical baselineMachine rewrittenMachine := by + dsimp only + let afterFetchFrame : Frame := + { frame with + pc := site.shape.fieldCount + values := frame.values ++ baselineFields } + have fetchControlEq : + (.running fetchState.frame fetchState.stack : Control) = + .running afterFetchFrame baselineStack := fetchState.control.symm + have fetchFrameEq : fetchState.frame = afterFetchFrame := by + injection fetchControlEq + have fetchStackEq : fetchState.stack = baselineStack := by + injection fetchControlEq + have fetchedDefinition : fetchState.frame.definition = source := by + simpa [fetchFrameEq, afterFetchFrame] using baselineDefinition + have fetchedAccepted : Reuse.FunctionDecisions.At rewrite.decisions + fetchState.frame.block helperOffset block (.accepted site) := by + simpa [fetchFrameEq, afterFetchFrame] using accepted + have fetchedPc : fetchState.frame.pc ≤ site.shape.releasePosition := by + simp [fetchFrameEq, afterFetchFrame, site.fits.releasePosition] + omega + have parameterValues : ∀ {index : Nat}, index < site.shape.parameterCount → + fetchState.frame.values[index]? = frame.values[index]? := by + intro index bound + simp [fetchFrameEq, afterFetchFrame, Array.getElem?_append, + parameterCount, bound] + have fetchedParameters : LiveValuesIso source fetchState.frame.block 0 + history.locRel frame.values rewrittenParameters := by + simpa [fetchFrameEq, afterFetchFrame] using parameters + have fetchedStack : StableLiveStackIso Validate.defaultLimits + attached.target.artifact.validationContext history.locRel + fetchState.stack rewrittenStack := by + simpa [fetchStackEq] using stack + let sourceContext : IxIR1.Ctx := + { decls := IxIR1.HPT.programDeclEnv + attached.source.lowering.result.artifacts } + have compilerMacro : CompilerAcceptedMacroStepAt attached baselineContext + .physical (2 * site.shape.fieldCount + 3) machine := + CompilerRunningState.acceptedPrefixCompilerMacroAtOfFetched frame + baselineStack (sourceContext := sourceContext) baselineSchemas rfl + rewrite baselineDefinition accepted parameterCount fieldCount + baselineSourceResolved retained (by simpa [budget] using released) + allocationSchemaAt baselineAllocationResolved tailResolved arity + fetchState fetchSteps + have semanticCanonical := + fetchState.acceptedPhysicalStableLiveMacroSimulationHistoryAtOfParameters + rewrite fetchedDefinition fetchedAccepted fetchedPc parameterCount + parameterValues baselineSchemas rewrittenSchemas history + fetchedParameters fetchedStack fuel allocationSchemaAt fieldCount + baselineSourceResolved baselineAt baselineOwned rootsInRest retained + retainedAt released baselineNewOwned baselineMapped + baselineAllocationResolved baselineFieldWorlds tailResolved arity + dsimp only at semanticCanonical + have noCredits : frame.credits = #[] := by + simpa [fetchFrameEq, afterFetchFrame] using fetchState.noCredits + have baselineEq : machine = + { store := machine.store + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := frame.block + values := frame.values + credits := #[] } + baselineStack } := by + have funded := machineWithHeapFuel_eq_runningEntry + (heapFuel := fieldFuel + 1) control baselineDefinition pc noCredits + have machineEq : ({ machine with heapFuel := fieldFuel + 1 } : Machine) = + machine := by + exact congrArg (fun heapFuel => ({ machine with heapFuel } : Machine)) + budget.symm + exact machineEq.symm.trans funded + apply compilerMacro.attach + rw [baselineEq] + simpa only [fetchFrameEq, fetchStackEq, afterFetchFrame] using + semanticCanonical + +/-- Specialize the fetched-state bridge to an ordinary traced entry. -/ +theorem CompilerRunningState.acceptedPhysicalStableMacroStepHistory + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + (optimized : OptimizedAttachment attached) + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (baselineDefinition : state.frame.definition = source) + {helperOffset : Nat} {block : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block} + (accepted : Reuse.FunctionDecisions.At rewrite.decisions state.frame.block + helperOffset block (.accepted site)) + (pc : state.frame.pc = 0) + {baselineContext rewrittenContext : Eval.Context} + (baselineSchemas : baselineContext.schemas = + attached.target.artifact.validationContext.schemas) + (rewrittenSchemas : rewrittenContext.schemas = + attached.target.artifact.validationContext.schemas) + {rewrittenStore baselineRetained baselineReleased : Store} + (history : IxIR1.Sim.HeapHistoryIso machine.store.heap + rewrittenStore.heap) + {rewrittenParameters : Array RVal} + {rewrittenStack : List Continuation} + (parameters : LiveValuesIso source state.frame.block 0 history.locRel + state.frame.values rewrittenParameters) + (stack : StableLiveStackIso Validate.defaultLimits + attached.target.artifact.validationContext history.locRel + state.stack rewrittenStack) + {baselineFields baselineNewFields baselineCallValues : Array RVal} + {baselineLocation fieldFuel remaining rewrittenFuel rc retainedRc : Nat} + {oldRest newRest : List IxIR1.Sim.Root} + {allocationSchema : CtorSchema} + (fuel : fieldFuel + 1 ≤ rewrittenFuel) + (allocationSchemaAt : + baselineContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (fieldCount : baselineFields.size = site.shape.fieldCount) + (baselineSourceResolved : + resolveAtom state.frame.values (.reg site.shape.source) = + .ok (.loc baselineLocation)) + (baselineAt : machine.store.get? baselineLocation = some + ⟨.shared, rc, + .ctorN site.shape.sourceConstructor baselineFields⟩) + (baselineOwned : IxIR1.Sim.RootOwnership machine.store.heap + (⟨.shared, .loc baselineLocation⟩ :: oldRest)) + (rootsInRest : ∀ root ∈ state.frameRoots, root ∈ oldRest) + (retained : RetainSharedMany machine.store baselineFields + baselineRetained) + (retainedAt : baselineRetained.get? baselineLocation = some + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor baselineFields⟩) + (released : releaseShared (fieldFuel + 1) baselineRetained + (.loc baselineLocation) = .ok (baselineReleased, remaining)) + (baselineNewOwned : IxIR1.Sim.RootOwnership baselineReleased.heap + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ newRest)) + (baselineMapped : MappedValuesInRoots site.shape + (baselinePrefixValues state.frame.values baselineFields) + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ + (newRest ++ inertRoots + (IxIR1.Sim.rootsFor .shared baselineFields.toList ++ oldRest)))) + (baselineAllocationResolved : resolveAtoms + (baselinePrefixValues state.frame.values baselineFields) + site.shape.allocationArguments = .ok baselineNewFields) + (baselineFieldWorlds : + FieldWorlds baselineReleased allocationSchema baselineNewFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues state.frame.values baselineFields).push + (.loc (baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor baselineNewFields)).2)) + site.shape.tailArguments = .ok baselineCallValues) + (arity : baselineCallValues.size = source.signature.params.size) : + let baselineMachine : Machine := { machine with heapFuel := fieldFuel + 1 } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := state.frame.block + values := rewrittenParameters + credits := #[] } + rewrittenStack } + AttachedStableMacroStep optimized baselineContext rewrittenContext + .physical baselineMachine rewrittenMachine := by + dsimp only + have parameterCount := + state.acceptedSiteParameterCount rewrite baselineDefinition accepted pc + let baselineMachine : Machine := { machine with heapFuel := fieldFuel + 1 } + let baselineState : CompilerRunningState attached baselineMachine := + state.withHeapFuel (fieldFuel + 1) + let sourceContext : IxIR1.Ctx := + { decls := IxIR1.HPT.programDeclEnv + attached.source.lowering.result.artifacts } + have compilerMacro : CompilerAcceptedMacroStepAt attached baselineContext + .physical (2 * site.shape.fieldCount + 3) baselineMachine := by + exact baselineState.acceptedPrefixCompilerMacroAt + (sourceContext := sourceContext) baselineSchemas rfl rewrite + baselineDefinition accepted pc rfl parameterCount fieldCount + baselineSourceResolved (by simpa [baselineMachine] using baselineAt) + (by simpa [baselineMachine] using retained) + (by simpa [baselineMachine] using released) allocationSchemaAt + baselineAllocationResolved tailResolved arity + have semanticCanonical := + state.acceptedPhysicalStableLiveMacroSimulationHistoryAt rewrite + baselineDefinition accepted pc baselineSchemas rewrittenSchemas history + parameters stack fuel allocationSchemaAt fieldCount + baselineSourceResolved baselineAt baselineOwned rootsInRest retained + retainedAt released baselineNewOwned baselineMapped + baselineAllocationResolved baselineFieldWorlds tailResolved arity + dsimp only at semanticCanonical + have baselineEq : baselineMachine = + { store := machine.store + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := state.frame.block + values := state.frame.values + credits := #[] } + state.stack } := by + exact machineWithHeapFuel_eq_runningEntry state.control + baselineDefinition pc state.noCredits + have semantic : StableLiveMacroSimulationAt Validate.defaultLimits + attached.target.artifact.validationContext baselineContext + rewrittenContext .physical (2 * site.shape.fieldCount + 3) + baselineMachine + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := state.frame.block + values := rewrittenParameters + credits := #[] } + rewrittenStack } := by + rw [baselineEq] + exact semanticCanonical + exact compilerMacro.attach semantic + +/-- Invert the concrete baseline suffix at an accepted entry. The actual +execution supplies the release budget, allocation operands/worlds, and +recursive tail arguments; compiler reconstruction supplies the matching +source trace and exact ownership accounting. -/ +theorem CompilerRunningState.acceptedPhysicalStableMacroStepHistoryOfFetchedExecution + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (frame : Frame) (baselineStack : List Continuation) + (control : machine.control = .running frame baselineStack) + (optimized : OptimizedAttachment attached) + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (baselineDefinition : frame.definition = source) + {helperOffset : Nat} {block : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block} + (accepted : Reuse.FunctionDecisions.At rewrite.decisions frame.block + helperOffset block (.accepted site)) + (pc : frame.pc = 0) + {baselineContext rewrittenContext : Eval.Context} + (baselineSchemas : baselineContext.schemas = + attached.target.artifact.validationContext.schemas) + (rewrittenSchemas : rewrittenContext.schemas = + attached.target.artifact.validationContext.schemas) + {fields : Array RVal} {location rc : Nat} + (parameterCount : frame.values.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (sourceResolved : resolveAtom frame.values (.reg site.shape.source) = + .ok (.loc location)) + (sourceAt : machine.store.get? location = some + ⟨.shared, rc, .ctorN site.shape.sourceConstructor fields⟩) + (fetchState : CompilerRunningState attached + { machine with + control := .running + { frame with + pc := site.shape.fieldCount + values := frame.values ++ fields } baselineStack }) + (fetchSteps : Steps baselineContext .physical site.shape.fieldCount machine + { machine with + control := .running + { frame with + pc := site.shape.fieldCount + values := frame.values ++ fields } baselineStack }) + {rewrittenStore : Store} {rewrittenFuel : Nat} + (history : IxIR1.Sim.HeapHistoryIso machine.store.heap + rewrittenStore.heap) + {rewrittenParameters : Array RVal} + {rewrittenStack : List Continuation} + (parameters : LiveValuesIso source frame.block 0 history.locRel + frame.values rewrittenParameters) + (stack : StableLiveStackIso Validate.defaultLimits + attached.target.artifact.validationContext history.locRel + baselineStack rewrittenStack) + (fuel : machine.heapFuel ≤ rewrittenFuel) + {baselineNext baselineFinal : Machine} {suffixCount : Nat} + {finalStore : Store} {finalHeapFuel : Nat} {finalValue : RVal} + (stepped : Step baselineContext .physical machine baselineNext) + (suffix : Steps baselineContext .physical suffixCount baselineNext + baselineFinal) + (halted : baselineFinal = + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue }) : + AttachedStableMacroStep optimized baselineContext rewrittenContext + .physical machine + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := frame.block + values := rewrittenParameters + credits := #[] } + rewrittenStack } := by + obtain ⟨sourceAtBlock, _resetAt, _hotAt, _coldAt⟩ := + rewrite.acceptedAt accepted + have blockAt : frame.definition.blocks[frame.block]? = + some block := by + rw [baselineDefinition] + exact sourceAtBlock + let sourceContext : IxIR1.Ctx := + { decls := IxIR1.HPT.programDeclEnv + attached.source.lowering.result.artifacts } + let afterFetchFrame : Frame := + { frame with + pc := site.shape.fieldCount + values := frame.values ++ fields } + let afterFetch : Machine := + { machine with control := .running afterFetchFrame baselineStack } + have fetchControlEq : + (.running fetchState.frame fetchState.stack : Control) = + .running afterFetchFrame baselineStack := by + calc + _ = afterFetch.control := fetchState.control.symm + _ = _ := by rfl + have fetchFrameEq : fetchState.frame = afterFetchFrame := by + injection fetchControlEq + have fetchStackEq : fetchState.stack = baselineStack := by + injection fetchControlEq + have fetchBlockAt : + fetchState.frame.definition.blocks[fetchState.frame.block]? = + some block := by + simpa [fetchFrameEq, afterFetchFrame] using blockAt + have fetchedDefinition : fetchState.frame.definition = source := by + simpa [fetchFrameEq, afterFetchFrame] using baselineDefinition + have fetchedAccepted : Reuse.FunctionDecisions.At rewrite.decisions + fetchState.frame.block helperOffset block (.accepted site) := by + simpa [fetchFrameEq, afterFetchFrame] using accepted + have fetchedPc : fetchState.frame.pc ≤ site.shape.releasePosition := by + simp [fetchFrameEq, afterFetchFrame, site.fits.releasePosition] + omega + have fetchedSourceResolved : resolveAtom fetchState.frame.values + (.reg site.shape.source) = .ok (.loc location) := by + simpa [fetchFrameEq, afterFetchFrame, resolveAtom, Array.getElem?_append, + parameterCount, site.fits.sourceBound] using sourceResolved + obtain ⟨oldRest, retainedStore, retainedRc, baselineOwned, rootsInRest, + retained, retainedAt, _retainedOwned⟩ := + fetchState.acceptedSiteRetainedFields rewrite fetchedDefinition + fetchedAccepted fetchedPc fetchedSourceResolved sourceAt + let afterRetainFrame : Frame := + { frame with + pc := 2 * site.shape.fieldCount + values := baselinePrefixValues frame.values fields } + let afterRetains : Machine := + { store := retainedStore + heapFuel := machine.heapFuel + control := .running afterRetainFrame baselineStack } + obtain ⟨retainStateRaw, retainStepsRaw⟩ := + fetchState.retainPrefixState (sourceContext := sourceContext) + (context := baselineContext) (interpretation := .physical) rfl site + fetchBlockAt parameterCount fieldCount + (by simp [fetchFrameEq, afterFetchFrame]) + (by simp [fetchFrameEq, afterFetchFrame]) + (by simpa [afterFetch] using retained) + have retainMachineEq : + ({ store := retainedStore + heapFuel := afterFetch.heapFuel + control := .running + { fetchState.frame with + pc := 2 * site.shape.fieldCount + values := baselinePrefixValues frame.values fields } + fetchState.stack } : Machine) = afterRetains := by + simp [afterFetch, afterRetains, fetchFrameEq, fetchStackEq, + afterFetchFrame, afterRetainFrame] + rw [retainMachineEq] at retainStateRaw retainStepsRaw + let retainState : CompilerRunningState attached afterRetains := + retainStateRaw + have retainControlEq : + (.running retainState.frame retainState.stack : Control) = + .running afterRetainFrame baselineStack := by + calc + _ = afterRetains.control := retainState.control.symm + _ = _ := by rfl + have retainFrameEq : retainState.frame = afterRetainFrame := by + injection retainControlEq + have retainStackEq : retainState.stack = baselineStack := by + injection retainControlEq + have fetchRetainSteps : Steps baselineContext .physical + (2 * site.shape.fieldCount) machine afterRetains := by + simpa [Nat.two_mul] using fetchSteps.trans retainStepsRaw + have total : Steps baselineContext .physical (1 + suffixCount) machine + baselineFinal := (stepped.toSteps control).trans suffix + obtain ⟨remainingCount, _countEq, remainingSteps⟩ := + fetchRetainSteps.cancelPrefixToHalted total halted + generalize finalEq : baselineFinal = actualFinal at remainingSteps halted + cases remainingSteps with + | refl => + have impossible := congrArg Machine.control halted + simp [afterRetains] at impossible + | @cons releaseTailCount _ releaseTarget _ releaseFrame releaseStack + releaseRunning releaseStep releaseTail => + have retainBaselineDefinition : retainState.frame.definition = source := by + simpa [retainFrameEq, afterRetainFrame] using baselineDefinition + have retainAccepted : Reuse.FunctionDecisions.At rewrite.decisions + retainState.frame.block helperOffset block (.accepted site) := by + simpa [retainFrameEq, afterRetainFrame] using accepted + have retainPc : retainState.frame.pc = site.shape.releasePosition := by + simp [retainFrameEq, afterRetainFrame, site.fits.releasePosition] + have retainSourceResolved : resolveAtom retainState.frame.values + (.reg site.shape.source) = .ok (.loc location) := by + simpa [retainFrameEq, afterRetainFrame, baselinePrefixValues, + resolveAtom, Array.getElem?_append, parameterCount, + site.fits.sourceBound] using sourceResolved + change Step baselineContext .physical + { store := retainedStore + heapFuel := machine.heapFuel + control := .running afterRetainFrame baselineStack } + releaseTarget at releaseStep + cases releaseStep.classify with + | instruction actualBlockAt actualPc instructionAt transfer => + have canonicalBlockAt : afterRetainFrame.definition.blocks[ + afterRetainFrame.block]? = some block := by + simpa [afterRetainFrame] using blockAt + have actualBlockEq : block = _ := Option.some.inj + (canonicalBlockAt.symm.trans actualBlockAt) + cases actualBlockEq + have expectedRelease : + block.instructions[afterRetainFrame.pc] = + .releaseShared (.reg site.shape.source) := by + obtain ⟨_releaseBound, releaseInstruction⟩ := + Array.getElem?_eq_some_iff.mp site.fits.release + simpa [afterRetainFrame, site.fits.releasePosition] using + releaseInstruction + have instructionEq := instructionAt.symm.trans expectedRelease + cases instructionEq + cases transfer with + | @releaseShared _ value releasedStore remainingFuel + actualResolved actualReleased => + have canonicalResolved : resolveAtom afterRetainFrame.values + (.reg site.shape.source) = .ok (.loc location) := by + simpa [retainFrameEq] using retainSourceResolved + have valueEq : value = .loc location := + Except.ok.inj (actualResolved.symm.trans canonicalResolved) + subst value + let afterReleaseFrame : Frame := + { frame with + pc := 2 * site.shape.fieldCount + 1 + values := baselinePrefixValues frame.values fields } + let afterRelease : Machine := + { store := releasedStore + heapFuel := remainingFuel + control := .running afterReleaseFrame baselineStack } + obtain ⟨releaseStateRaw, generatedReleaseStepRaw⟩ := + retainState.stepAcceptedReleaseOfTarget + (sourceContext := sourceContext) + (context := baselineContext) (interpretation := .physical) + rewrite retainBaselineDefinition retainAccepted retainPc rfl + retainSourceResolved + (by simpa [afterRetains] using actualReleased) + have releaseMachineEq : + ({ store := releasedStore + heapFuel := remainingFuel + control := .running + { retainState.frame with + pc := retainState.frame.pc + 1 } + retainState.stack } : Machine) = afterRelease := by + simp [afterRelease, afterReleaseFrame, retainFrameEq, + retainStackEq, afterRetainFrame] + rw [releaseMachineEq] at releaseStateRaw generatedReleaseStepRaw + have actualReleaseMachineEq : + ({ store := releasedStore + heapFuel := remainingFuel + control := .running + { afterRetainFrame with + pc := afterRetainFrame.pc + 1 } + baselineStack } : Machine) = afterRelease := by + simp [afterRelease, afterReleaseFrame, afterRetainFrame] + rw [actualReleaseMachineEq] at releaseTail + let releaseState : CompilerRunningState attached afterRelease := + releaseStateRaw + have releaseControlEq : + (.running releaseState.frame releaseState.stack : Control) = + .running afterReleaseFrame baselineStack := by + calc + _ = afterRelease.control := releaseState.control.symm + _ = _ := by rfl + have releaseFrameEq : releaseState.frame = afterReleaseFrame := by + injection releaseControlEq + have releaseStackEq : releaseState.stack = baselineStack := by + injection releaseControlEq + have releaseBlockAt : releaseState.frame.definition.blocks[ + releaseState.frame.block]? = some block := by + simpa [releaseFrameEq, afterReleaseFrame] using blockAt + have releasePc : releaseState.frame.pc = + site.shape.releasePosition + 1 := by + simp [releaseFrameEq, afterReleaseFrame, + site.fits.releasePosition] + generalize tailFinalEq : actualFinal = tailFinal at releaseTail halted + cases releaseTail with + | refl => + have impossible := congrArg Machine.control halted + simp [afterRelease] at impossible + | @cons allocationTailCount _ allocationTarget _ + allocationFrame allocationStack allocationRunning + allocationStep allocationTail => + change Step baselineContext .physical + { store := releasedStore + heapFuel := remainingFuel + control := .running afterReleaseFrame baselineStack } + allocationTarget at allocationStep + cases allocationStep.classify with + | instruction actualBlockAt actualPc instructionAt transfer => + have canonicalBlockAt : + afterReleaseFrame.definition.blocks[ + afterReleaseFrame.block]? = some block := by + simpa [afterReleaseFrame] using blockAt + have actualBlockEq : block = _ := Option.some.inj + (canonicalBlockAt.symm.trans actualBlockAt) + cases actualBlockEq + have expectedAllocation : + block.instructions[afterReleaseFrame.pc] = + .alloc .shared + site.shape.allocationConstructor + site.shape.allocationArguments := by + obtain ⟨_allocationBound, allocationInstruction⟩ := + Array.getElem?_eq_some_iff.mp site.fits.allocation + simpa [afterReleaseFrame, + site.fits.releasePosition] using + allocationInstruction + have instructionEq := + instructionAt.symm.trans expectedAllocation + cases instructionEq + cases transfer with + | @alloc _ _ _ allocationSchema newFields schemaAt + actualAllocationResolved allocationWorlds => + have releaseAllocationResolved : resolveAtoms + releaseState.frame.values + site.shape.allocationArguments = + .ok newFields := by + simpa [releaseFrameEq] using + actualAllocationResolved + have releasePcBound : releaseState.frame.pc < + block.instructions.size := by + simpa [releaseFrameEq] using actualPc + have releaseInstruction : + block.instructions[releaseState.frame.pc] = + .alloc .shared + site.shape.allocationConstructor + site.shape.allocationArguments := by + simpa [releaseFrameEq] using expectedAllocation + have allocationLast : releaseState.frame.pc + 1 = + block.instructions.size := by + rw [releasePc, site.fits.releasePosition, + site.fits.instructionCount] + obtain ⟨traceSite, traceBlockId, input, nextInput, + entryValueCount, traceIndex, sourceWorld, + sourceCid, sourceArguments, tailSite, + tailBlockId, tailInput, tailEntryValueCount, + tailSourceArguments, generated, traceEq, + sourceWorldEq, + allocationTranslated, tailTranslated⟩ := + releaseState.currentTerminalAllocation + releaseBlockAt allocationLast releaseInstruction + site.fits.terminator + have exactTraceState := releaseState.traceState + rw [traceEq] at exactTraceState + have sourceCount : releaseState.source.length = + input.size := by + simpa [Lower.CodeTrace.sourceInputMap] using + exactTraceState.target.sourceCount + have sourceAtoms := + Lower.Sim.atomsRel_of_translateAtoms + allocationTranslated + have sourceAllocationResolved : + IxIR1.resolveAtoms releaseState.source + sourceArguments = .ok newFields.toList := + Lower.Sim.resolveAtoms_of_envRel_target + exactTraceState.target.environments sourceCount + sourceAtoms releaseAllocationResolved + obtain ⟨beforePosition, afterPosition, + remainingCapabilities, beforeMember, afterMember, + beforeCoordinate, afterCoordinate, consumed, + afterCapabilities, allocationReadyOwned⟩ := + releaseState.allocationReadyOwnership traceEq + sourceAllocationResolved + have noBorrows := + releaseState.terminalAllocationNoBorrows traceEq + beforeMember beforeCoordinate + have plannerCoordinate : + beforePosition.coordinateMatches + releaseState.trace.source + releaseState.trace.sourceBlock + releaseState.trace.targetPosition + releaseState.trace.sourceInputMap = true := by + simpa [traceEq, Lower.CodeTrace.source, + Lower.CodeTrace.sourceBlock, + Lower.CodeTrace.targetPosition, + Lower.CodeTrace.sourceInputMap] using + beforeCoordinate + have mappedBefore := + releaseState.mappedValuesAtPlannerAllocationOfNoBorrows + beforeMember plannerCoordinate noBorrows site + releaseBlockAt releasePc + have beforeInvariant := releaseState.ownership + beforePosition beforeMember plannerCoordinate + have beforeOwned : IxIR1.Sim.RootOwnership + releasedStore.heap + (Lower.Sim.rootsForCapabilities + beforePosition.sourceCapabilities.toList + releaseState.source ++ + releaseState.frameRoots) := by + change IxIR1.Sim.RootOwnership + afterRelease.store.heap _ + rw [releaseState.heap_eq] + exact beforeInvariant.ownership + have mappedFramed : MappedValuesInRoots site.shape + releaseState.frame.values + (Lower.Sim.rootsForCapabilities + beforePosition.sourceCapabilities.toList + releaseState.source ++ + releaseState.frameRoots) := + MappedValuesInRoots.mono mappedBefore (by + intro root member + exact List.mem_append_left _ member) + let newRest : List IxIR1.Sim.Root := + Lower.Sim.rootsForCapabilities + remainingCapabilities.toList + releaseState.source ++ + releaseState.frameRoots + subst sourceWorld + have baselineNewOwned : IxIR1.Sim.RootOwnership + releasedStore.heap + (IxIR1.Sim.rootsFor .shared newFields.toList ++ + newRest) := by + simpa [afterRelease, newRest] using + allocationReadyOwned + have mappedNew : MappedValuesInRoots site.shape + releaseState.frame.values + (IxIR1.Sim.rootsFor .shared newFields.toList ++ + newRest) := + MappedValuesInRoots.transportOwnership mappedFramed + beforeOwned baselineNewOwned + have mappedCanonical : MappedValuesInRoots site.shape + (baselinePrefixValues frame.values fields) + (IxIR1.Sim.rootsFor .shared newFields.toList ++ + newRest) := by + simpa [releaseFrameEq, afterReleaseFrame] using + mappedNew + have baselineMapped : MappedValuesInRoots site.shape + (baselinePrefixValues frame.values fields) + (IxIR1.Sim.rootsFor .shared newFields.toList ++ + (newRest ++ inertRoots + (IxIR1.Sim.rootsFor .shared fields.toList ++ + oldRest))) := by + apply MappedValuesInRoots.mono mappedCanonical + intro root member + rcases List.mem_append.mp member with member | member + · exact List.mem_append_left _ member + · exact List.mem_append_right _ + (List.mem_append_left _ member) + let allocation := releasedStore.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + let afterAllocationFrame : Frame := + { frame with + pc := 2 * site.shape.fieldCount + 2 + values := + (baselinePrefixValues frame.values + fields).push (.loc allocation.2) } + let afterAllocation : Machine := + { store := allocation.1 + heapFuel := remainingFuel + control := .running afterAllocationFrame + baselineStack } + obtain ⟨allocationStateRaw, + generatedAllocationStepRaw, + _allocationEntry⟩ := + releaseState.stepAllocOfTarget + (sourceContext := sourceContext) (sourceFuel := 0) + (context := baselineContext) + (interpretation := .physical) baselineSchemas rfl + releaseBlockAt releasePcBound releaseInstruction + schemaAt releaseAllocationResolved + have allocationMachineEq : + ({ store := allocation.1 + heapFuel := afterRelease.heapFuel + control := .running + { releaseState.frame with + pc := releaseState.frame.pc + 1 + values := releaseState.frame.values.push + (.loc allocation.2) } + releaseState.stack } : Machine) = + afterAllocation := by + simp [afterRelease, afterAllocation, + afterAllocationFrame, releaseFrameEq, + releaseStackEq, afterReleaseFrame, allocation] + rw [allocationMachineEq] at allocationStateRaw generatedAllocationStepRaw + have actualAllocationMachineEq : + (let actualAllocation := + releasedStore.allocNode .shared + (.ctorN site.shape.allocationConstructor + newFields); + ({ store := actualAllocation.1 + heapFuel := remainingFuel + control := .running + { afterReleaseFrame with + pc := afterReleaseFrame.pc + 1 + values := afterReleaseFrame.values.push + (.loc actualAllocation.2) } + baselineStack } : Machine)) = + afterAllocation := by + simp [afterAllocation, afterAllocationFrame, + afterReleaseFrame, allocation] + rw [actualAllocationMachineEq] at allocationTail + let allocationState : CompilerRunningState attached + afterAllocation := allocationStateRaw + have allocationControlEq : + (.running allocationState.frame + allocationState.stack : Control) = + .running afterAllocationFrame baselineStack := by + calc + _ = afterAllocation.control := + allocationState.control.symm + _ = _ := by rfl + have allocationFrameEq : allocationState.frame = + afterAllocationFrame := by + injection allocationControlEq + have allocationStackEq : allocationState.stack = + baselineStack := by + injection allocationControlEq + have allocationBlockAt : + allocationState.frame.definition.blocks[ + allocationState.frame.block]? = some block := by + simpa [allocationFrameEq, afterAllocationFrame] + using blockAt + have allocationPc : allocationState.frame.pc = + block.instructions.size := by + simpa [allocationFrameEq, afterAllocationFrame] + using site.fits.instructionCount.symm + generalize allocationFinalEq : tailFinal = + allocationFinal at allocationTail halted + cases allocationTail with + | refl => + have impossible := congrArg Machine.control halted + simp [afterAllocation] at impossible + | @cons tailCount _ tailTarget _ tailFrame tailStack + tailRunning tailStep tailSuffix => + change Step baselineContext .physical + { store := allocation.1 + heapFuel := remainingFuel + control := .running afterAllocationFrame + baselineStack } + tailTarget at tailStep + generalize stackEq : baselineStack = actualStack + at tailStep + cases tailStep.classify with + | instruction actualBlockAt actualPc + instructionAt transfer => + have canonicalBlockAt : + afterAllocationFrame.definition.blocks[ + afterAllocationFrame.block]? = + some block := by + simpa [afterAllocationFrame] using blockAt + have actualBlockEq : block = _ := + Option.some.inj + (canonicalBlockAt.symm.trans + actualBlockAt) + cases actualBlockEq + have allocationPcEq : + afterAllocationFrame.pc = + block.instructions.size := by + simpa [allocationFrameEq] using + allocationPc + omega + | terminator actualBlockAt actualPc terminatorAt + transfer => + have canonicalBlockAt : + afterAllocationFrame.definition.blocks[ + afterAllocationFrame.block]? = + some block := by + simpa [afterAllocationFrame] using blockAt + have actualBlockEq : block = _ := + Option.some.inj + (canonicalBlockAt.symm.trans + actualBlockAt) + cases actualBlockEq + have expectedTerminator : + block.terminator = + .tailCallSelf + site.shape.tailArguments := + site.fits.terminator + have terminatorEq := + terminatorAt.symm.trans expectedTerminator + cases terminatorEq + cases transfer with + | @tailCallSelf _ _ callValues noCredits + actualTailResolved actualArity nonempty => + have canonicalAllocationResolved : + resolveAtoms + (baselinePrefixValues + frame.values fields) + site.shape.allocationArguments = + .ok newFields := by + simpa [afterReleaseFrame] using + actualAllocationResolved + have canonicalTailResolved : + resolveAtoms + ((baselinePrefixValues + frame.values fields).push + (.loc + (releasedStore.allocNode + .shared + (.ctorN + site.shape.allocationConstructor + newFields)).2)) + site.shape.tailArguments = + .ok callValues := by + simpa [afterAllocationFrame, + allocation] using + actualTailResolved + have canonicalArity : callValues.size = + source.signature.params.size := by + simpa [afterAllocationFrame, + baselineDefinition] using + actualArity + cases fuelEq : machine.heapFuel with + | zero => + simp [fuelEq, Eval.releaseShared, + Eval.releaseSharedWork] at actualReleased + | succ fieldFuel => + have funded : fieldFuel + 1 ≤ + rewrittenFuel := by + simpa [fuelEq, + Nat.succ_eq_add_one] using fuel + have canonicalReleased : + releaseShared (fieldFuel + 1) + retainedStore (.loc location) = + .ok (releasedStore, + remainingFuel) := by + simpa [fuelEq, + Nat.succ_eq_add_one] using + actualReleased + have ready := + CompilerRunningState.acceptedPhysicalStableMacroStepHistoryOfFetched + frame baselineStack control + optimized rewrite + baselineDefinition accepted pc + baselineSchemas rewrittenSchemas + parameterCount fieldCount + fetchState fetchSteps + history parameters stack funded + (by simp [fuelEq]) + schemaAt sourceResolved sourceAt + baselineOwned rootsInRest + retained retainedAt + canonicalReleased + baselineNewOwned baselineMapped + canonicalAllocationResolved + allocationWorlds + canonicalTailResolved + canonicalArity + exact ready + | terminator actualBlockAt actualPc terminatorAt transfer => + have canonicalBlockAt : + afterReleaseFrame.definition.blocks[ + afterReleaseFrame.block]? = some block := by + simpa [afterReleaseFrame] using blockAt + have actualBlockEq : block = _ := Option.some.inj + (canonicalBlockAt.symm.trans actualBlockAt) + cases actualBlockEq + have allocationBound := + (Array.getElem?_eq_some_iff.mp site.fits.allocation).1 + have allocationPcEq : afterReleaseFrame.pc = + site.shape.releasePosition + 1 := by + simp [afterReleaseFrame, site.fits.releasePosition] + rw [allocationPcEq] at actualPc + omega + | terminator actualBlockAt actualPc terminatorAt transfer => + have releaseBound := + (Array.getElem?_eq_some_iff.mp site.fits.release).1 + have canonicalBlockAt : afterRetainFrame.definition.blocks[ + afterRetainFrame.block]? = some block := by + simpa [afterRetainFrame] using blockAt + have actualBlockEq : block = _ := Option.some.inj + (canonicalBlockAt.symm.trans actualBlockAt) + cases actualBlockEq + have releasePcEq : afterRetainFrame.pc = + site.shape.releasePosition := by + simp [afterRetainFrame, site.fits.releasePosition] + rw [releasePcEq] at actualPc + omega + + +/-- Reconstruct fetched compiler evidence at an ordinary accepted entry, +then use the shared successful-suffix proof. -/ +theorem CompilerRunningState.acceptedPhysicalStableMacroStepHistoryOfExecution + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + (optimized : OptimizedAttachment attached) + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (baselineDefinition : state.frame.definition = source) + {helperOffset : Nat} {block : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block} + (accepted : Reuse.FunctionDecisions.At rewrite.decisions state.frame.block + helperOffset block (.accepted site)) + (pc : state.frame.pc = 0) + {baselineContext rewrittenContext : Eval.Context} + (baselineSchemas : baselineContext.schemas = + attached.target.artifact.validationContext.schemas) + (rewrittenSchemas : rewrittenContext.schemas = + attached.target.artifact.validationContext.schemas) + {rewrittenStore : Store} {rewrittenFuel : Nat} + (history : IxIR1.Sim.HeapHistoryIso machine.store.heap + rewrittenStore.heap) + {rewrittenParameters : Array RVal} + {rewrittenStack : List Continuation} + (parameters : LiveValuesIso source state.frame.block 0 history.locRel + state.frame.values rewrittenParameters) + (stack : StableLiveStackIso Validate.defaultLimits + attached.target.artifact.validationContext history.locRel + state.stack rewrittenStack) + (fuel : machine.heapFuel ≤ rewrittenFuel) + {baselineNext baselineFinal : Machine} {suffixCount : Nat} + {finalStore : Store} {finalHeapFuel : Nat} {finalValue : RVal} + (stepped : Step baselineContext .physical machine baselineNext) + (suffix : Steps baselineContext .physical suffixCount baselineNext + baselineFinal) + (halted : baselineFinal = + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue }) : + AttachedStableMacroStep optimized baselineContext rewrittenContext + .physical machine + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := state.frame.block + values := rewrittenParameters + credits := #[] } + rewrittenStack } := by + obtain ⟨location, rc, fields, sourceResolved, sourceAt⟩ := + state.acceptedEntrySourceOfStep rewrite baselineDefinition accepted pc + stepped + have fieldCount := state.acceptedSiteSourceFieldCount site sourceAt + have blockAt : state.frame.definition.blocks[state.frame.block]? = + some block := by + rw [baselineDefinition] + exact (rewrite.acceptedAt accepted).1 + have parameterCount := + state.acceptedSiteParameterCount rewrite baselineDefinition accepted pc + let sourceContext : IxIR1.Ctx := + { decls := IxIR1.HPT.programDeclEnv + attached.source.lowering.result.artifacts } + obtain ⟨fetchState, fetchSteps⟩ := + state.fetchPrefixState (sourceContext := sourceContext) + (context := baselineContext) (interpretation := .physical) rfl site + blockAt pc rfl parameterCount fieldCount sourceResolved sourceAt rfl + exact CompilerRunningState.acceptedPhysicalStableMacroStepHistoryOfFetchedExecution + state.frame state.stack state.control optimized rewrite baselineDefinition + accepted pc baselineSchemas rewrittenSchemas parameterCount fieldCount + sourceResolved sourceAt fetchState fetchSteps history parameters stack + fuel stepped suffix halted + +/-- Pair two related single steps with the compiler state reconstructed at the +baseline successor. -/ +theorem AttachedStableMacroStep.ofStepsOne + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {optimized : OptimizedAttachment attached} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStart rewrittenStart baselineTarget rewrittenTarget : Machine} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (baselineRunning : baselineStart.control = + .running baselineFrame baselineStack) + (rewrittenRunning : rewrittenStart.control = + .running rewrittenFrame rewrittenStack) + (baselineStep : Step baselineContext interpretation baselineStart + baselineTarget) + (rewrittenStep : Step rewrittenContext interpretation rewrittenStart + rewrittenTarget) + (related : StableLiveMachineRel Validate.defaultLimits + attached.target.artifact.validationContext baselineTarget + rewrittenTarget) + (acceptedEntry : StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext baselineTarget + rewrittenTarget) + (compiler : CompilerState attached baselineTarget) + (allocationDelta : AllocationDelta baselineStart.store baselineTarget.store + rewrittenStart.store rewrittenTarget.store) + (costDelta : CostDelta baselineStart.store baselineTarget.store + rewrittenStart.store rewrittenTarget.store) : + AttachedStableMacroStep optimized baselineContext rewrittenContext + interpretation baselineStart rewrittenStart := + .intro 1 1 (by omega) (by omega) baselineTarget rewrittenTarget + (baselineStep.toSteps baselineRunning) + (rewrittenStep.toSteps rewrittenRunning) related acceptedEntry compiler allocationDelta costDelta + +/-- At a synchronized accepted entry, the rewritten frame is literally the +canonical frame used by the accepted-prefix macro. The live relation fixes +its definition, block, and program counter; exact credit-file length turns +the compiler's empty baseline credit file into an empty rewritten one. -/ +private theorem StableLiveFrameIso.rewritten_eq_entry + {limits : Validate.Limits} {validation : Validate.Context} + {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {locRel : Nat → Nat → Prop} {baseline rewritten : Frame} + (frame : StableLiveFrameIso rewrite locRel baseline rewritten) + (pc : baseline.pc = 0) (noCredits : baseline.credits = #[]) : + rewritten = + { definition := rewrite.definition + block := baseline.block + values := rewritten.values + credits := #[] } := by + have rewrittenCreditSize : rewritten.credits.size = 0 := by + simpa [noCredits] using frame.credits.length_eq.symm + have rewrittenCredits : rewritten.credits = #[] := + Array.eq_empty_of_size_eq_zero rewrittenCreditSize + have rewrittenPc : rewritten.pc = 0 := frame.pc.symm.trans pc + cases baseline + cases rewritten + simp only [Frame.mk.injEq] + exact ⟨frame.rewrittenDefinition, frame.block.symm, rewrittenPc, + True.intro, rewrittenCredits⟩ + +/-- Compose an accepted constructor child's actual successful suffix with the +compiler state after its generated fetch prologue. Empty prologues already +start at a compiler entry; nonempty prologues coincide with the recognized +fetch batch and use the shared fetched-state macro. -/ +theorem acceptedCtorChildPhysicalMacroOfExecution + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + {baselineContext rewrittenContext : Eval.Context} + (baselineSchemas : baselineContext.schemas = + attached.target.artifact.validationContext.schemas) + (rewrittenSchemas : rewrittenContext.schemas = + attached.target.artifact.validationContext.schemas) + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel baselineFrame + rewrittenFrame) + (stack : StableLiveStackIso Validate.defaultLimits + attached.target.artifact.validationContext heap.locRel baselineStack + rewrittenStack) + {helperOffset : Nat} {block : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block} + (accepted : Reuse.FunctionDecisions.At rewrite.decisions baselineFrame.block + helperOffset block (.accepted site)) + (pc : baselineFrame.pc = 0) + (parameterCount : baselineFrame.values.size = site.shape.parameterCount) + {fields : Array RVal} + (childState : CompilerRunningState attached + { store := baselineStore + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := fields.size + values := baselineFrame.values ++ fields } baselineStack }) + {childScrutinee : Atom} {cid : CtorId} {location : Nat} {box : NodeBox} + (prologue : Lower.fetchPrologueMatches block.instructions childScrutinee cid + fields.size = true) + (resolved : resolveAtom baselineFrame.values childScrutinee = + .ok (.loc location)) + (boxAt : baselineStore.get? location = some box) + (node : box.node = .ctorN cid fields) + {baselineNext baselineFinal : Machine} {suffixCount : Nat} + {finalStore : Store} {finalHeapFuel : Nat} {finalValue : RVal} + (stepped : Step baselineContext .physical + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } baselineNext) + (suffix : Steps baselineContext .physical suffixCount baselineNext + baselineFinal) + (halted : baselineFinal = + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue }) : + AttachedStableMacroStep optimized baselineContext rewrittenContext .physical + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } := by + have childControlEq : + (.running childState.frame childState.stack : Control) = + .running + { baselineFrame with + pc := fields.size + values := baselineFrame.values ++ fields } baselineStack := + childState.control.symm + have childFrameEq : childState.frame = + { baselineFrame with + pc := fields.size + values := baselineFrame.values ++ fields } := by + injection childControlEq + have noCredits : baselineFrame.credits = #[] := by + simpa [childFrameEq] using childState.noCredits + have rewrittenEq := frame.rewritten_eq_entry pc noCredits + have parameters : LiveValuesIso source baselineFrame.block 0 heap.locRel + baselineFrame.values rewrittenFrame.values := by + simpa [pc] using frame.values + rw [rewrittenEq] + by_cases empty : fields.size = 0 + · have fieldsEmpty : fields = #[] := Array.eq_empty_of_size_eq_zero empty + have entryEq : + { baselineFrame with + pc := fields.size + values := baselineFrame.values ++ fields } = baselineFrame := by + simp [fieldsEmpty, ← pc] + have entryState : CompilerRunningState attached + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } := by + simpa only [entryEq] using childState + have entryControlEq : + (.running entryState.frame entryState.stack : Control) = + .running baselineFrame baselineStack := entryState.control.symm + have entryFrameEq : entryState.frame = baselineFrame := by + injection entryControlEq + have entryStackEq : entryState.stack = baselineStack := by + injection entryControlEq + have ready := entryState.acceptedPhysicalStableMacroStepHistoryOfExecution + optimized rewrite + (by simpa [entryFrameEq] using frame.baselineDefinition) + (by simpa [entryFrameEq] using accepted) + (by simpa [entryFrameEq] using pc) + baselineSchemas rewrittenSchemas heap + (by simpa [entryFrameEq] using parameters) + (by simpa [entryStackEq] using stack) fuel stepped suffix halted + simpa only [entryFrameEq, entryStackEq] using ready + · obtain ⟨rc, fieldCount, sourceResolved, sourceAt⟩ := + CompilerRunningState.acceptedCtorChildSource baselineFrame baselineStack + rewrite frame.baselineDefinition accepted parameterCount childState + prologue (by omega) resolved boxAt node + have fetchState : CompilerRunningState attached + { store := baselineStore + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := site.shape.fieldCount + values := baselineFrame.values ++ fields } baselineStack } := by + simpa only [fieldCount] using childState + have blockAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block := by + rw [frame.baselineDefinition] + exact (rewrite.acceptedAt accepted).1 + have fetchSteps : Steps baselineContext .physical site.shape.fieldCount + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := baselineStore + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := site.shape.fieldCount + values := baselineFrame.values ++ fields } baselineStack } := by + have steps := Lower.Sim.simulate_fetch_prologue + (context := baselineContext) (interpretation := .physical) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl blockAt pc prologue resolved boxAt node + simpa only [fieldCount] using steps + exact CompilerRunningState.acceptedPhysicalStableMacroStepHistoryOfFetchedExecution + baselineFrame baselineStack rfl optimized rewrite frame.baselineDefinition + accepted pc baselineSchemas rewrittenSchemas parameterCount fieldCount + sourceResolved sourceAt fetchState fetchSteps heap parameters stack fuel + stepped suffix halted + +/-- Prefix one related evaluator step to an existing compiler-aware macro. +This is the composition used when an unchanged constructor switch enters a +child whose own block decision is accepted. -/ +theorem AttachedStableMacroStep.prependStepsOne + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {optimized : OptimizedAttachment attached} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStart rewrittenStart baselineMiddle rewrittenMiddle : Machine} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (tail : AttachedStableMacroStep optimized baselineContext + rewrittenContext interpretation baselineMiddle rewrittenMiddle) + (baselineRunning : baselineStart.control = + .running baselineFrame baselineStack) + (rewrittenRunning : rewrittenStart.control = + .running rewrittenFrame rewrittenStack) + (baselineStep : Step baselineContext interpretation baselineStart + baselineMiddle) + (rewrittenStep : Step rewrittenContext interpretation rewrittenStart + rewrittenMiddle) + (allocationDelta : AllocationDelta baselineStart.store baselineMiddle.store + rewrittenStart.store rewrittenMiddle.store) + (costDelta : CostDelta baselineStart.store baselineMiddle.store + rewrittenStart.store rewrittenMiddle.store) : + AttachedStableMacroStep optimized baselineContext rewrittenContext + interpretation baselineStart rewrittenStart := by + cases tail with + | intro baselineCount rewrittenCount baselinePositive rewrittenPositive + baselineTarget rewrittenTarget baselineSteps rewrittenSteps related + acceptedEntry compiler tailDelta tailCosts => + exact .intro (1 + baselineCount) (1 + rewrittenCount) (by omega) + (by omega) baselineTarget rewrittenTarget + ((baselineStep.toSteps baselineRunning).trans baselineSteps) + ((rewrittenStep.toSteps rewrittenRunning).trans rewrittenSteps) + related acceptedEntry compiler (allocationDelta.trans tailDelta) (costDelta.trans tailCosts) + +/-- Attach the compiler endpoint to a constructor switch whose selected child +block is preserved literally. The semantic proof executes the switch and the +whole generated fetch prologue on both machines; fixed-length determinism +identifies its baseline endpoint with the independently reconstructed compiler +endpoint. -/ +theorem AttachedStableMacroStep.ofUnchangedSwitchCtorPrologue + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {optimized : OptimizedAttachment attached} + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineChildFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso Validate.defaultLimits + attached.target.artifact.validationContext heap.locRel baselineStack + rewrittenStack) + {parentBlock : Block} {scrutinee childScrutinee : Atom} + {constructors : Array CtorAlt} {natPeel : Option NatPeel} + {baselineLocation : Nat} {box : NodeBox} + {cid : CtorId} {fields : Array RVal} {alternative : CtorAlt} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some parentBlock) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some parentBlock) + (pc : baselineFrame.pc = parentBlock.instructions.size) + (terminator : parentBlock.terminator = + .switchValue scrutinee constructors natPeel) + (resolved : Eval.resolveAtom baselineFrame.values scrutinee = + .ok (.loc baselineLocation)) + (boxAt : baselineStore.get? baselineLocation = some box) + (node : box.node = .ctorN cid fields) + (alternativeAt : constructors.find? (fun candidate => + candidate.cid == cid) = some alternative) + (transferred : EdgeTransfer baselineFrame alternative.edge #[] + baselineChildFrame) + {childBlock : Block} + (childAt : baselineChildFrame.definition.blocks[ + baselineChildFrame.block]? = some childBlock) + (childTargetAt : rewrite.definition.blocks[baselineChildFrame.block]? = + some childBlock) + (childPc : baselineChildFrame.pc = 0) + (prologue : Lower.fetchPrologueMatches childBlock.instructions + childScrutinee cid fields.size = true) + (childResolved : Eval.resolveAtom baselineChildFrame.values + childScrutinee = .ok (.loc baselineLocation)) + {compilerTarget : Machine} + (compilerSteps : Steps baselineContext interpretation (1 + fields.size) + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + compilerTarget) + (compiler : CompilerState attached compilerTarget) : + AttachedStableMacroStep optimized baselineContext rewrittenContext + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } := by + obtain ⟨rewrittenFinalFrame, baselineSteps, rewrittenSteps, related, + acceptedEntry⟩ := + unchangedSwitchCtorPrologueStepsLiveIso rewrite heap fuel frame stack + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) + (interpretation := interpretation) + sourceAt targetAt pc terminator resolved boxAt node alternativeAt + transferred childAt childTargetAt childPc prologue childResolved + have targetEq := + Ix.Compiler.IxIR2.ReuseLiveSim.Steps.deterministic baselineSteps + compilerSteps + subst compilerTarget + exact .intro (1 + fields.size) (1 + fields.size) (by omega) (by omega) + _ _ baselineSteps rewrittenSteps related acceptedEntry compiler (.refl _ _) (.refl _ _) + +/-- An unchanged parent constructor switch dispatches on the selected child +block's own rewrite decision. A preserved child executes its complete fetch +prologue in lockstep. An accepted child delegates at entry, then prefixes the +related constructor-switch step to that child macro. -/ +theorem AttachedStableMacroStep.ofSwitchCtorChildBlockCase + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {optimized : OptimizedAttachment attached} + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineChildFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso Validate.defaultLimits + attached.target.artifact.validationContext heap.locRel baselineStack + rewrittenStack) + {parentBlock : Block} {scrutinee childScrutinee : Atom} + {constructors : Array CtorAlt} {natPeel : Option NatPeel} + {baselineLocation : Nat} {box : NodeBox} + {cid : CtorId} {fields : Array RVal} {alternative : CtorAlt} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some parentBlock) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some parentBlock) + (pc : baselineFrame.pc = parentBlock.instructions.size) + (terminator : parentBlock.terminator = + .switchValue scrutinee constructors natPeel) + (resolved : Eval.resolveAtom baselineFrame.values scrutinee = + .ok (.loc baselineLocation)) + (boxAt : baselineStore.get? baselineLocation = some box) + (node : box.node = .ctorN cid fields) + (alternativeAt : constructors.find? (fun candidate => + candidate.cid == cid) = some alternative) + (transferred : EdgeTransfer baselineFrame alternative.edge #[] + baselineChildFrame) + {childBlock : Block} + (childAt : baselineChildFrame.definition.blocks[ + baselineChildFrame.block]? = some childBlock) + (childPc : baselineChildFrame.pc = 0) + (prologue : Lower.fetchPrologueMatches childBlock.instructions + childScrutinee cid fields.size = true) + (childResolved : Eval.resolveAtom baselineChildFrame.values + childScrutinee = .ok (.loc baselineLocation)) + {compilerTarget : Machine} + (compilerSteps : Steps baselineContext interpretation (1 + fields.size) + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + compilerTarget) + (compiler : CompilerState attached compilerTarget) + (accepted : ∀ {rewrittenChildFrame : Frame} {helperOffset : Nat} + {selectedBlock : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext selectedBlock}, + StableLiveFrameIso rewrite heap.locRel baselineChildFrame + rewrittenChildFrame → + Reuse.FunctionDecisions.At rewrite.decisions baselineChildFrame.block + helperOffset selectedBlock (.accepted site) → + AttachedStableMacroStep optimized baselineContext rewrittenContext + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineChildFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenChildFrame rewrittenStack }) : + AttachedStableMacroStep optimized baselineContext rewrittenContext + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } := by + have childSourceAt : source.blocks[baselineChildFrame.block]? = + some childBlock := by + rw [← frame.baselineDefinition, ← transferred.definition] + exact childAt + obtain ⟨rewrittenChildFrame, baselineSwitch, rewrittenSwitch, + _childRelated, childFrame⟩ := + unchangedSwitchCtorStepLiveIso rewrite heap fuel frame stack + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) + (interpretation := interpretation) + sourceAt targetAt pc terminator resolved boxAt node alternativeAt + transferred + cases rewrite.blockCaseOfLookup childSourceAt with + | unchanged selectedSourceAt childTargetAt => + have blockEq := Option.some.inj + (selectedSourceAt.symm.trans childSourceAt) + cases blockEq + exact AttachedStableMacroStep.ofUnchangedSwitchCtorPrologue rewrite + heap fuel frame stack sourceAt targetAt pc terminator resolved boxAt + node alternativeAt transferred childAt childTargetAt childPc prologue + childResolved compilerSteps compiler + | accepted found => + exact (accepted childFrame found).prependStepsOne rfl rfl + baselineSwitch rewrittenSwitch (.refl _ _) (.refl _ _) + +/-- Turn the lowering compiler's constructor reconstruction into the complete +reuse-aware macro for an unchanged parent block. The lowering witness fixes +the exact child entry and fetch prologue; the preceding child-block dispatcher +then chooses lockstep execution or an accepted-site macro at that entry. -/ +theorem attachedStableSwitchCtorMacroOfCompilerState + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {rewrittenStore : Store} {rewrittenFuel : Nat} + {rewrittenFrame : Frame} + {rewrittenStack : List Continuation} + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (heap : IxIR1.Sim.HeapHistoryIso machine.store.heap rewrittenStore.heap) + (fuel : machine.heapFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel state.frame + rewrittenFrame) + (stack : StableLiveStackIso Validate.defaultLimits + attached.target.artifact.validationContext heap.locRel state.stack + rewrittenStack) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {targetScrutinee : Atom} + {generated : Block} {outgoing : List Lower.EdgeTrace} + {children : List Lower.CodeTrace} + (traceEq : state.trace = + .switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children) + {location : Nat} {box : IxIR1.NodeBox} {cid : CtorId} + {fields : Array RVal} + (sourceResolved : IxIR1.resolveAtom state.source sourceScrutinee = + .ok (.loc location)) + (sourceGet : state.sourceStore.get? location = some box) + (node : box.node = .ctorN cid fields) + {tag fieldCount alternativeIndex : Nat} {body : IxIR1.Code} + (sourceAlternative : Lower.sourceAlternativeAtTag? alternatives cid.cidx = + some (.mk tag fieldCount body, alternativeIndex)) + (fieldArity : fields.size = fieldCount) + {constructors : Array CtorAlt} {targetPeel : Option NatPeel} + {index : Nat} {target : CtorAlt} {edge : Lower.EdgeTrace} + {child : Lower.CodeTrace} + (terminator : generated.terminator = + .switchValue targetScrutinee constructors targetPeel) + (targetAt : constructors[index]? = some target) + (targetAlternative : constructors.find? (fun candidate => + candidate.cid == cid) = some target) + (edgeAt : outgoing[index]? = some edge) + (childAt : children[index]? = some child) + (rewrittenParentAt : rewrite.definition.blocks[state.frame.block]? = + some generated) + (accepted : ∀ {baselineChildFrame rewrittenChildFrame : Frame} + {helperOffset : Nat} {selectedBlock : Block} + {acceptedSite : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext selectedBlock}, + StableLiveFrameIso rewrite heap.locRel baselineChildFrame + rewrittenChildFrame → + Reuse.FunctionDecisions.At rewrite.decisions baselineChildFrame.block + helperOffset selectedBlock (.accepted acceptedSite) → + AttachedStableMacroStep optimized baselineContext rewrittenContext + interpretation + { store := machine.store + heapFuel := machine.heapFuel + control := .running baselineChildFrame state.stack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenChildFrame rewrittenStack }) : + AttachedStableMacroStep optimized baselineContext rewrittenContext + interpretation machine + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } := by + obtain ⟨finalFrame, edgeFrame, childScrutinee, nextState, targetSteps, + parentBlockAt, parentPc, targetResolved, targetGet, transferred, + _switchStep, childBlockAt, childPc, childResolved, prologue, + _finalFrameEq⟩ := + state.stepsSwitchCtor traceEq sourceResolved sourceGet node + sourceAlternative fieldArity terminator targetAt targetAlternative + edgeAt childAt + have rewrittenBlockAt : rewrittenFrame.definition.blocks[ + rewrittenFrame.block]? = some generated := by + rw [frame.rewrittenDefinition, ← frame.block] + exact rewrittenParentAt + have canonicalEq : + ({ store := machine.store + heapFuel := machine.heapFuel + control := .running state.frame state.stack } : Machine) = + machine := by + simpa only using congrArg + (fun control => ({ machine with control } : Machine)) state.control.symm + have canonicalSteps : Steps baselineContext interpretation + (1 + fields.size) + { store := machine.store + heapFuel := machine.heapFuel + control := .running state.frame state.stack } + { machine with control := .running finalFrame state.stack } := by + rw [canonicalEq] + exact targetSteps + have ready := AttachedStableMacroStep.ofSwitchCtorChildBlockCase rewrite + heap fuel frame stack parentBlockAt rewrittenBlockAt parentPc terminator + targetResolved targetGet node targetAlternative transferred childBlockAt + childPc prologue childResolved canonicalSteps (.running nextState) accepted + rw [canonicalEq] at ready + exact ready + +/-- Resolve the selected constructor child's reuse decision using the exact +lowering endpoint and successful baseline suffix. Both preserved and accepted +children produce their compiler-aware physical macro internally. -/ +theorem attachedPhysicalSwitchCtorMacroOfCompilerState + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + {baselineContext rewrittenContext : Eval.Context} + (baselineSchemas : baselineContext.schemas = + attached.target.artifact.validationContext.schemas) + (rewrittenSchemas : rewrittenContext.schemas = + attached.target.artifact.validationContext.schemas) + {machine : Machine} (state : CompilerRunningState attached machine) + {rewrittenStore : Store} {rewrittenFuel : Nat} + {rewrittenFrame : Frame} + {rewrittenStack : List Continuation} + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (heap : IxIR1.Sim.HeapHistoryIso machine.store.heap rewrittenStore.heap) + (fuel : machine.heapFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel state.frame + rewrittenFrame) + (stack : StableLiveStackIso Validate.defaultLimits + attached.target.artifact.validationContext heap.locRel state.stack + rewrittenStack) + {site : Lower.SourceSite} {blockId : BlockId} + {input : Lower.Sim.EnvMap} {entryValueCount : Nat} + {sourceScrutinee : IxIR1.Atom} {peelNat : Bool} + {alternatives : Array IxIR1.Alt} {targetScrutinee : Atom} + {generated : Block} {outgoing : List Lower.EdgeTrace} + {children : List Lower.CodeTrace} + (traceEq : state.trace = + .switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children) + {location : Nat} {box : IxIR1.NodeBox} {cid : CtorId} + {fields : Array RVal} + (sourceResolved : IxIR1.resolveAtom state.source sourceScrutinee = + .ok (.loc location)) + (sourceGet : state.sourceStore.get? location = some box) + (node : box.node = .ctorN cid fields) + {tag fieldCount alternativeIndex : Nat} {body : IxIR1.Code} + (sourceAlternative : Lower.sourceAlternativeAtTag? alternatives cid.cidx = + some (.mk tag fieldCount body, alternativeIndex)) + (fieldArity : fields.size = fieldCount) + {constructors : Array CtorAlt} {targetPeel : Option NatPeel} + {index : Nat} {target : CtorAlt} {edge : Lower.EdgeTrace} + {child : Lower.CodeTrace} + (terminator : generated.terminator = + .switchValue targetScrutinee constructors targetPeel) + (targetAt : constructors[index]? = some target) + (targetAlternative : constructors.find? (fun candidate => + candidate.cid == cid) = some target) + (edgeAt : outgoing[index]? = some edge) + (childAt : children[index]? = some child) + (rewrittenParentAt : rewrite.definition.blocks[state.frame.block]? = + some generated) + {baselineNext baselineFinal : Machine} {suffixCount : Nat} + {finalStore : Store} {finalHeapFuel : Nat} {finalValue : RVal} + (stepped : Step baselineContext .physical machine baselineNext) + (suffix : Steps baselineContext .physical suffixCount baselineNext + baselineFinal) + (halted : baselineFinal = + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue }) : + AttachedStableMacroStep optimized baselineContext rewrittenContext + .physical machine + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } := by + obtain ⟨finalFrame, edgeFrame, childScrutinee, nextState, targetSteps, + parentBlockAt, parentPc, targetResolved, targetGet, transferred, + switchStep, childBlockAt, childPc, childResolved, prologue, + finalFrameEq⟩ := + state.stepsSwitchCtor (context := baselineContext) + (interpretation := .physical) traceEq sourceResolved sourceGet node + sourceAlternative fieldArity terminator targetAt targetAlternative + edgeAt childAt + have rewrittenBlockAt : rewrittenFrame.definition.blocks[ + rewrittenFrame.block]? = some generated := by + rw [frame.rewrittenDefinition, ← frame.block] + exact rewrittenParentAt + have canonicalEq : + ({ store := machine.store + heapFuel := machine.heapFuel + control := .running state.frame state.stack } : Machine) = + machine := by + simpa only using congrArg + (fun control => ({ machine with control } : Machine)) state.control.symm + have canonicalSteps : Steps baselineContext .physical (1 + fields.size) + { store := machine.store + heapFuel := machine.heapFuel + control := .running state.frame state.stack } + { machine with control := .running finalFrame state.stack } := by + rw [canonicalEq] + exact targetSteps + have childSourceAt : source.blocks[edgeFrame.block]? = + some child.headBlock.2 := by + rw [← frame.baselineDefinition, ← transferred.definition] + exact childBlockAt + cases rewrite.blockCaseOfLookup childSourceAt with + | unchanged selectedSourceAt childTargetAt => + have blockEq := Option.some.inj + (selectedSourceAt.symm.trans childSourceAt) + cases blockEq + have ready := AttachedStableMacroStep.ofUnchangedSwitchCtorPrologue rewrite + (optimized := optimized) (rewrittenContext := rewrittenContext) + heap fuel frame stack parentBlockAt rewrittenBlockAt parentPc terminator + targetResolved targetGet node targetAlternative transferred childBlockAt + childTargetAt childPc prologue childResolved canonicalSteps + (.running nextState) + rw [canonicalEq] at ready + exact ready + | @accepted helperOffset selectedBlock acceptedSite found => + have selectedSourceAt := (rewrite.acceptedAt found).1 + have selectedBlockEq : selectedBlock = child.headBlock.2 := + Option.some.inj (selectedSourceAt.symm.trans childSourceAt) + subst selectedBlock + obtain ⟨rewrittenChildFrame, baselineSwitch, rewrittenSwitch, + _childRelated, childFrame⟩ := + unchangedSwitchCtorStepLiveIso rewrite heap fuel frame stack + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) + (interpretation := .physical) + parentBlockAt rewrittenBlockAt parentPc terminator targetResolved + targetGet node targetAlternative transferred + obtain ⟨values, credits, after, edgeBlock, _edgeResolved, _creditsTaken, + _noCredits, edgeBlockAt, valueArity, _creditArity, edgeFrameEq⟩ := + transferred.parts + have edgeBlockAt' : edgeFrame.definition.blocks[edgeFrame.block]? = + some edgeBlock := by + simpa [edgeFrameEq] using edgeBlockAt + have edgeBlockEq : edgeBlock = child.headBlock.2 := + Option.some.inj (edgeBlockAt'.symm.trans childBlockAt) + have parameterCount : edgeFrame.values.size = + acceptedSite.shape.parameterCount := by + rw [acceptedSite.fits.parameterCount, ← edgeBlockEq] + simpa [edgeFrameEq] using valueArity + have childCompiler : CompilerRunningState attached + { store := machine.store + heapFuel := machine.heapFuel + control := .running + { edgeFrame with + pc := fields.size + values := edgeFrame.values ++ fields } state.stack } := by + simpa only [finalFrameEq] using nextState + have total : Steps baselineContext .physical (1 + suffixCount) machine + baselineFinal := (stepped.toSteps state.control).trans suffix + obtain ⟨remainingCount, _countEq, childSuffix⟩ := + (switchStep.toSteps state.control).cancelPrefixToHalted total halted + generalize finalEq : baselineFinal = actualFinal at childSuffix halted + cases childSuffix with + | refl => + have impossible := congrArg Machine.control halted + simp at impossible + | @cons count _ childNext _ actualFrame actualStack running childStep + childTail => + have childMacro := acceptedCtorChildPhysicalMacroOfExecution optimized + baselineSchemas rewrittenSchemas rewrite heap fuel childFrame stack + found childPc parameterCount childCompiler prologue childResolved + targetGet node childStep childTail halted + have ready := childMacro.prependStepsOne rfl rfl + baselineSwitch rewrittenSwitch (.refl _ _) (.refl _ _) + rw [canonicalEq] at ready + exact ready + +/-- Turn a concrete target constructor selection into the complete paired +reuse macro. The reconstructed lowering witness chooses the exact recursive +child; the current parent cannot itself be an accepted reset block because +accepted source blocks terminate in `tailCallSelf`, so its switch is preserved +literally. Only an independently accepted child remains delegated. -/ +theorem attachedStableSwitchCtorMacroOfTarget + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {machine : Machine} (state : CompilerRunningState attached machine) + {rewrittenStore : Store} {rewrittenFuel : Nat} + {rewrittenFrame : Frame} {rewrittenStack : List Continuation} + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (heap : IxIR1.Sim.HeapHistoryIso machine.store.heap rewrittenStore.heap) + (fuel : machine.heapFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel state.frame + rewrittenFrame) + (stack : StableLiveStackIso Validate.defaultLimits + attached.target.artifact.validationContext heap.locRel state.stack + rewrittenStack) + {block : Block} {targetScrutinee : Atom} + {constructors : Array CtorAlt} {targetPeel : Option NatPeel} + {location : Nat} {box : IxIR1.NodeBox} {cid : CtorId} + {fields : Array RVal} {alternative : CtorAlt} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc = block.instructions.size) + (terminator : block.terminator = + .switchValue targetScrutinee constructors targetPeel) + (resolved : Eval.resolveAtom state.frame.values targetScrutinee = + .ok (.loc location)) + (boxAt : machine.store.get? location = some box) + (node : box.node = .ctorN cid fields) + (alternativeAt : constructors.find? (fun candidate => + candidate.cid == cid) = some alternative) + (accepted : ∀ {baselineChildFrame rewrittenChildFrame : Frame} + {helperOffset : Nat} {selectedBlock : Block} + {acceptedSite : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext selectedBlock}, + StableLiveFrameIso rewrite heap.locRel baselineChildFrame + rewrittenChildFrame → + Reuse.FunctionDecisions.At rewrite.decisions baselineChildFrame.block + helperOffset selectedBlock (.accepted acceptedSite) → + AttachedStableMacroStep optimized baselineContext rewrittenContext + interpretation + { store := machine.store + heapFuel := machine.heapFuel + control := .running baselineChildFrame state.stack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenChildFrame rewrittenStack }) : + AttachedStableMacroStep optimized baselineContext rewrittenContext + interpretation machine + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } := by + have selected := state.switchCtorCaseOfTarget blockAt pc terminator resolved + boxAt node alternativeAt + cases selected with + | @intro site blockId input entryValueCount sourceScrutinee peelNat + alternatives generated outgoing children tag fieldCount alternativeIndex + index body edge child traceEq sourceResolved sourceGet node + sourceAlternative fieldArity generatedTerminator targetAt alternativeAt + edgeAt childAt => + have descendant : state.functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee + peelNat alternatives targetScrutinee generated outgoing + children) := by + rw [← traceEq] + exact state.descendant + have generatedAt : state.frame.definition.blocks[state.frame.block]? = + some generated := by + have exactBlock := state.traceState.target.blockAt state.descendant + rw [traceEq] at exactBlock + exact exactBlock + cases frame.blockCase generatedAt with + | unchanged sourceAt rewrittenParentAt => + have generatedSourceAt : source.blocks[state.frame.block]? = + some generated := by + rw [← frame.baselineDefinition] + exact generatedAt + have sourceBlockEq : _ = generated := + Option.some.inj (sourceAt.symm.trans generatedSourceAt) + cases sourceBlockEq + exact attachedStableSwitchCtorMacroOfCompilerState optimized state + rewrite heap fuel frame stack traceEq sourceResolved sourceGet node + sourceAlternative fieldArity generatedTerminator targetAt + alternativeAt edgeAt childAt rewrittenParentAt accepted + | @accepted helperOffset selectedBlock acceptedSite found => + have generatedSourceAt : source.blocks[state.frame.block]? = + some generated := by + rw [← frame.baselineDefinition] + exact generatedAt + have selectedSourceAt := (rewrite.acceptedAt found).1 + have selectedBlockEq : selectedBlock = generated := + Option.some.inj (selectedSourceAt.symm.trans generatedSourceAt) + subst selectedBlock + have expected := acceptedSite.fits.terminator + rw [generatedTerminator] at expected + cases expected + +/-- A successful physical constructor selection determines its own paired +macro, including an accepted child, from checked lowering data and the actual +remaining baseline execution. -/ +theorem attachedPhysicalSwitchCtorMacroOfTarget + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + {baselineContext rewrittenContext : Eval.Context} + (baselineSchemas : baselineContext.schemas = + attached.target.artifact.validationContext.schemas) + (rewrittenSchemas : rewrittenContext.schemas = + attached.target.artifact.validationContext.schemas) + {machine : Machine} (state : CompilerRunningState attached machine) + {rewrittenStore : Store} {rewrittenFuel : Nat} + {rewrittenFrame : Frame} {rewrittenStack : List Continuation} + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (heap : IxIR1.Sim.HeapHistoryIso machine.store.heap rewrittenStore.heap) + (fuel : machine.heapFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel state.frame + rewrittenFrame) + (stack : StableLiveStackIso Validate.defaultLimits + attached.target.artifact.validationContext heap.locRel state.stack + rewrittenStack) + {block : Block} {targetScrutinee : Atom} + {constructors : Array CtorAlt} {targetPeel : Option NatPeel} + {location : Nat} {box : IxIR1.NodeBox} {cid : CtorId} + {fields : Array RVal} {alternative : CtorAlt} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc = block.instructions.size) + (terminator : block.terminator = + .switchValue targetScrutinee constructors targetPeel) + (resolved : Eval.resolveAtom state.frame.values targetScrutinee = + .ok (.loc location)) + (boxAt : machine.store.get? location = some box) + (node : box.node = .ctorN cid fields) + (alternativeAt : constructors.find? (fun candidate => + candidate.cid == cid) = some alternative) + {baselineNext baselineFinal : Machine} {suffixCount : Nat} + {finalStore : Store} {finalHeapFuel : Nat} {finalValue : RVal} + (stepped : Step baselineContext .physical machine baselineNext) + (suffix : Steps baselineContext .physical suffixCount baselineNext + baselineFinal) + (halted : baselineFinal = + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue }) : + AttachedStableMacroStep optimized baselineContext rewrittenContext + .physical machine + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } := by + have selected := state.switchCtorCaseOfTarget blockAt pc terminator resolved + boxAt node alternativeAt + cases selected with + | @intro site blockId input entryValueCount sourceScrutinee peelNat + alternatives generated outgoing children tag fieldCount alternativeIndex + index body edge child traceEq sourceResolved sourceGet node + sourceAlternative fieldArity generatedTerminator targetAt alternativeAt + edgeAt childAt => + have descendant : state.functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee + peelNat alternatives targetScrutinee generated outgoing + children) := by + rw [← traceEq] + exact state.descendant + have generatedAt : state.frame.definition.blocks[state.frame.block]? = + some generated := by + have exactBlock := state.traceState.target.blockAt state.descendant + rw [traceEq] at exactBlock + exact exactBlock + cases frame.blockCase generatedAt with + | unchanged sourceAt rewrittenParentAt => + have generatedSourceAt : source.blocks[state.frame.block]? = + some generated := by + rw [← frame.baselineDefinition] + exact generatedAt + have sourceBlockEq : _ = generated := + Option.some.inj (sourceAt.symm.trans generatedSourceAt) + cases sourceBlockEq + exact attachedPhysicalSwitchCtorMacroOfCompilerState optimized + baselineSchemas rewrittenSchemas state + rewrite heap fuel frame stack traceEq sourceResolved sourceGet node + sourceAlternative fieldArity generatedTerminator targetAt + alternativeAt edgeAt childAt rewrittenParentAt stepped suffix halted + | @accepted helperOffset selectedBlock acceptedSite found => + have generatedSourceAt : source.blocks[state.frame.block]? = + some generated := by + rw [← frame.baselineDefinition] + exact generatedAt + have selectedSourceAt := (rewrite.acceptedAt found).1 + have selectedBlockEq : selectedBlock = generated := + Option.some.inj (selectedSourceAt.symm.trans generatedSourceAt) + subst selectedBlock + have expected := acceptedSite.fits.terminator + rw [generatedTerminator] at expected + cases expected + +/-- Compiler progress available at one trace-dispatch boundary. Most source +steps expose a compiler state and accepted-entry phase at their literal +one-step successor. Recognized-prefix instructions defer that phase to the +current block-decision split, while larger synchronization gaps expose an +already-assembled positive compiler-aware macro. -/ +inductive AttachedCompilerAdvance + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + (baselineContext rewrittenContext : Eval.Context) + (interpretation : Interpretation) + (baselineStart rewrittenStart baselineStepTarget : Machine) : Prop where + | step (compiler : CompilerState attached baselineStepTarget) + (acceptedEntry : ∀ {rewrittenTarget : Machine}, + StableLiveMachineRel Validate.defaultLimits + attached.target.artifact.validationContext baselineStepTarget + rewrittenTarget → + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext baselineStepTarget + rewrittenTarget) : + AttachedCompilerAdvance optimized baselineContext rewrittenContext + interpretation baselineStart rewrittenStart baselineStepTarget + | prefixStep (compiler : CompilerState attached baselineStepTarget) + (prefixAt : AcceptedPrefixInstructionAt baselineStart) : + AttachedCompilerAdvance optimized baselineContext rewrittenContext + interpretation baselineStart rewrittenStart baselineStepTarget + | macro (ready : AttachedStableMacroStep optimized baselineContext + rewrittenContext interpretation baselineStart rewrittenStart) : + AttachedCompilerAdvance optimized baselineContext rewrittenContext + interpretation baselineStart rewrittenStart baselineStepTarget + +/-- Package a concrete compiler successor for any retained `letOp` whose +target instruction belongs to the accepted-prefix family. The current +compiler trace reconstructs the exact instruction witness consumed by the +block-decision dispatcher. -/ +theorem AttachedCompilerAdvance.prefixStepOfLetOp + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {optimized : OptimizedAttachment attached} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStart rewrittenStart baselineStepTarget : Machine} + (state : CompilerRunningState attached baselineStart) + (compiler : CompilerState attached baselineStepTarget) + {site : Lower.SourceSite} {blockId : BlockId} + {input nextInput : Lower.Sim.EnvMap} {entryValueCount index : Nat} + {operation : IxIR1.Op} {instruction : Instr} {next : Lower.CodeTrace} + (traceEq : state.trace = + .letOp site blockId input nextInput entryValueCount operation index + instruction next) + (acceptedPrefix : AcceptedPrefixInstruction instruction) : + AttachedCompilerAdvance optimized baselineContext rewrittenContext + interpretation baselineStart rewrittenStart baselineStepTarget := + .prefixStep compiler + (state.acceptedPrefixInstructionAt traceEq acceptedPrefix) + +/-- Package an ordinary compiler successor known to be at block entry. The +accepted-entry obligation is independent of the rewritten endpoint relation +once the baseline program counter is zero. -/ +theorem AttachedCompilerAdvance.stepOfPcZero + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {optimized : OptimizedAttachment attached} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStart rewrittenStart baselineStepTarget : Machine} + (compiler : CompilerState attached baselineStepTarget) + {frame : Frame} {stack : List Continuation} + (control : baselineStepTarget.control = .running frame stack) + (pc : frame.pc = 0) : + AttachedCompilerAdvance optimized baselineContext rewrittenContext + interpretation baselineStart rewrittenStart baselineStepTarget := by + apply AttachedCompilerAdvance.step compiler + intro rewrittenTarget _related + exact StableLiveAcceptedEntry.ofPcZero control pc + +/-- Package an ordinary halted compiler successor. It has no running +accepted-site phase obligation. -/ +theorem AttachedCompilerAdvance.stepOfHalted + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {optimized : OptimizedAttachment attached} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStart rewrittenStart baselineStepTarget : Machine} + (compiler : CompilerState attached baselineStepTarget) + {value : RVal} (control : baselineStepTarget.control = .halted value) : + AttachedCompilerAdvance optimized baselineContext rewrittenContext + interpretation baselineStart rewrittenStart baselineStepTarget := by + apply AttachedCompilerAdvance.step compiler + intro rewrittenTarget _related + exact StableLiveAcceptedEntry.halted control + +/-- Package a compiler successor resumed after an addressed call. Accepted +source blocks contain no such suspending instruction, so the resumed program +counter may be nonzero without violating the synchronization phase. -/ +theorem AttachedCompilerAdvance.stepOfCallResume + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {optimized : OptimizedAttachment attached} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStart rewrittenStart baselineStepTarget : Machine} + (compiler : CompilerState attached baselineStepTarget) + {frame : Frame} {stack : List Continuation} {block : Block} + (control : baselineStepTarget.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + {position : Nat} {address : Ixon.Address} {arguments : Array Atom} + (instructionAt : block.instructions[position]? = + some (.call address arguments)) : + AttachedCompilerAdvance optimized baselineContext rewrittenContext + interpretation baselineStart rewrittenStart baselineStepTarget := by + apply AttachedCompilerAdvance.step compiler + intro rewrittenTarget _related + exact StableLiveAcceptedEntry.ofCallResume control blockAt instructionAt + +/-- Package a compiler successor resumed after a recursive call. -/ +theorem AttachedCompilerAdvance.stepOfCallSelfResume + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {optimized : OptimizedAttachment attached} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStart rewrittenStart baselineStepTarget : Machine} + (compiler : CompilerState attached baselineStepTarget) + {frame : Frame} {stack : List Continuation} {block : Block} + (control : baselineStepTarget.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + {position : Nat} {arguments : Array Atom} + (instructionAt : block.instructions[position]? = + some (.callSelf arguments)) : + AttachedCompilerAdvance optimized baselineContext rewrittenContext + interpretation baselineStart rewrittenStart baselineStepTarget := by + apply AttachedCompilerAdvance.step compiler + intro rewrittenTarget _related + exact StableLiveAcceptedEntry.ofCallSelfResume control blockAt instructionAt + +/-- Package a compiler successor resumed after a dynamic application, +including the final endpoint of a recursive `applyMore` chain. -/ +theorem AttachedCompilerAdvance.stepOfApplyResume + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {optimized : OptimizedAttachment attached} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStart rewrittenStart baselineStepTarget : Machine} + (compiler : CompilerState attached baselineStepTarget) + {frame : Frame} {stack : List Continuation} {block : Block} + (control : baselineStepTarget.control = .running frame stack) + (blockAt : frame.definition.blocks[frame.block]? = some block) + {position : Nat} {function : Atom} {arguments : Array Atom} + (instructionAt : block.instructions[position]? = + some (.apply function arguments)) : + AttachedCompilerAdvance optimized baselineContext rewrittenContext + interpretation baselineStart rewrittenStart baselineStepTarget := by + apply AttachedCompilerAdvance.step compiler + intro rewrittenTarget _related + exact StableLiveAcceptedEntry.ofApplyResume control blockAt instructionAt + +/-- Complete baseline compiler-macro evidence with a positive rewritten run +and a stable live endpoint relation, producing the positive arm consumed by +trace dispatch. -/ +theorem CompilerMacroStep.attach + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {optimized : OptimizedAttachment attached} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStart rewrittenStart baselineStepTarget : Machine} + (compilerMacro : CompilerMacroStep attached baselineContext interpretation + baselineStart) + (rewritten : ∀ {baselineCount : Nat} {baselineTarget : Machine}, + Steps baselineContext interpretation baselineCount baselineStart + baselineTarget → + CompilerState attached baselineTarget → + ∃ rewrittenCount rewrittenTarget, + 0 < rewrittenCount ∧ + Steps rewrittenContext interpretation rewrittenCount + rewrittenStart rewrittenTarget ∧ + StableLiveMachineRel Validate.defaultLimits + attached.target.artifact.validationContext baselineTarget + rewrittenTarget ∧ + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext baselineTarget + rewrittenTarget ∧ + AllocationDelta baselineStart.store baselineTarget.store + rewrittenStart.store rewrittenTarget.store ∧ + CostDelta baselineStart.store baselineTarget.store + rewrittenStart.store rewrittenTarget.store) : + AttachedCompilerAdvance optimized baselineContext rewrittenContext + interpretation baselineStart rewrittenStart baselineStepTarget := by + cases compilerMacro with + | intro baselineCount baselinePositive baselineTarget baselineSteps compiler => + obtain ⟨rewrittenCount, rewrittenTarget, rewrittenPositive, + rewrittenSteps, related, acceptedEntry, allocationDelta, costDelta⟩ := + rewritten baselineSteps compiler + exact AttachedCompilerAdvance.«macro» + (.intro baselineCount rewrittenCount baselinePositive + rewrittenPositive baselineTarget rewrittenTarget baselineSteps + rewrittenSteps related acceptedEntry compiler allocationDelta costDelta) + +/-- Compiler-side classification of one concrete physical instruction. +Every non-apply constructor carries complete compiler progress. Dynamic +application retains its exact transfer evidence as the only residual seam. -/ +inductive AttachedCompilerInstructionCase + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + (baselineContext rewrittenContext : Eval.Context) + (machine rewritten baselineNext : Machine) + (state : CompilerRunningState attached machine) + (instruction : Instr) : Prop where + | advance (ready : AttachedCompilerAdvance optimized baselineContext + rewrittenContext .physical machine rewritten baselineNext) : + AttachedCompilerInstructionCase optimized baselineContext + rewrittenContext machine rewritten baselineNext state instruction + | apply {functionAtom : Atom} {argumentAtoms : Array Atom} + {function : RVal} {arguments : Array RVal} + (instructionEq : instruction = .apply functionAtom argumentAtoms) + (functionResolved : + Eval.resolveAtom state.frame.values functionAtom = .ok function) + (argumentsResolved : + Eval.resolveAtoms state.frame.values argumentAtoms = .ok arguments) + (transferred : Eval.ApplyTransfer baselineContext .physical + machine.store machine.heapFuel function arguments + { state.frame with pc := state.frame.pc + 1 } state.stack + baselineNext) : + AttachedCompilerInstructionCase optimized baselineContext + rewrittenContext machine rewritten baselineNext state instruction + +/-- Classify every concrete baseline instruction using the checked compiler +trace. Reuse-only instructions cannot occur in lowered code, and target +extern declarations are excluded by the closed-world attachment. -/ +theorem attachedPhysicalInstructionCase + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {machine rewritten baselineNext : Machine} + (state : CompilerRunningState attached machine) + {block : Block} {instruction : Instr} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc < block.instructions.size) + (instructionAt : block.instructions[state.frame.pc] = instruction) + (classified : InstructionTransferCase + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + .physical machine.store machine.heapFuel state.frame state.stack + instruction baselineNext) : + AttachedCompilerInstructionCase optimized + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (Eval.Context.ofProgram optimized.output.trace.target + attached.target.artifact.validationContext.schemas oracle) + machine rewritten baselineNext state instruction := by + let sourceContext := attached.simulationSourceContext + cases classified with + | move resolved => + obtain ⟨nextState, _targetStep, acceptedEntry⟩ := + state.stepPureOfTarget + (sourceContext := sourceContext) (sourceFuel := 0) + (context := Eval.Context.ofProgram + attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (interpretation := .physical) rfl blockAt pc instructionAt resolved + exact .advance + (.step (.running nextState) (fun _related => acceptedEntry _)) + | @alloc world cid arguments schema values schemaAt resolved fields => + obtain ⟨nextState, _targetStep, acceptedEntry⟩ := + state.stepAllocOfTarget + (sourceContext := sourceContext) (sourceFuel := 0) + (context := Eval.Context.ofProgram + attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (interpretation := .physical) rfl rfl blockAt pc instructionAt + schemaAt resolved + cases world with + | unique => + exact .advance (.step (.running nextState) + (fun _related => acceptedEntry rfl _)) + | shared => + obtain ⟨site, blockId, input, nextInput, entryValueCount, + operation, index, next, traceEq, _operationSyntax⟩ := + state.currentLetOp blockAt pc instructionAt + exact .advance (AttachedCompilerAdvance.prefixStepOfLetOp state + (.running nextState) traceEq (by constructor)) + | allocWithAbsent schemaAt resolved fields taken layout absent => + obtain ⟨site, blockId, input, nextInput, entryValueCount, + operation, index, next, traceEq, operationSyntax⟩ := + state.currentLetOp blockAt pc instructionAt + cases operation <;> simp [Lower.OperationSyntax] at operationSyntax + | allocWithLogical mode schemaAt resolved fields taken layout present => + obtain ⟨site, blockId, input, nextInput, entryValueCount, + operation, index, next, traceEq, operationSyntax⟩ := + state.currentLetOp blockAt pc instructionAt + cases operation <;> simp [Lower.OperationSyntax] at operationSyntax + | allocWithPhysical mode schemaAt resolved fields taken layout present + reused => + obtain ⟨site, blockId, input, nextInput, entryValueCount, + operation, index, next, traceEq, operationSyntax⟩ := + state.currentLetOp blockAt pc instructionAt + cases operation <;> simp [Lower.OperationSyntax] at operationSyntax + | discardAbsent taken absent => + obtain ⟨site, blockId, input, nextInput, entryValueCount, + operation, index, next, traceEq, operationSyntax⟩ := + state.currentLetOp blockAt pc instructionAt + cases operation <;> simp [Lower.OperationSyntax] at operationSyntax + | discardLogical mode taken present => + obtain ⟨site, blockId, input, nextInput, entryValueCount, + operation, index, next, traceEq, operationSyntax⟩ := + state.currentLetOp blockAt pc instructionAt + cases operation <;> simp [Lower.OperationSyntax] at operationSyntax + | discardPhysical mode taken present released => + obtain ⟨site, blockId, input, nextInput, entryValueCount, + operation, index, next, traceEq, operationSyntax⟩ := + state.currentLetOp blockAt pc instructionAt + cases operation <;> simp [Lower.OperationSyntax] at operationSyntax + | takeUniqueLogical mode schemaAt resolved viewed unitRC => + obtain ⟨site, blockId, input, nextInput, entryValueCount, + operation, index, next, traceEq, operationSyntax⟩ := + state.currentLetOp blockAt pc instructionAt + cases operation <;> simp [Lower.OperationSyntax] at operationSyntax + | takeUniquePhysical mode schemaAt resolved viewed unitRC => + obtain ⟨site, blockId, input, nextInput, entryValueCount, + operation, index, next, traceEq, operationSyntax⟩ := + state.currentLetOp blockAt pc instructionAt + cases operation <;> simp [Lower.OperationSyntax] at operationSyntax + | resetSharedLogicalHot mode schemaAt resolved viewed unitRC => + obtain ⟨site, blockId, input, nextInput, entryValueCount, + operation, index, next, traceEq, operationSyntax⟩ := + state.currentLetOp blockAt pc instructionAt + cases operation <;> simp [Lower.OperationSyntax] at operationSyntax + | resetSharedPhysicalHot mode schemaAt resolved viewed unitRC => + obtain ⟨site, blockId, input, nextInput, entryValueCount, + operation, index, next, traceEq, operationSyntax⟩ := + state.currentLetOp blockAt pc instructionAt + cases operation <;> simp [Lower.OperationSyntax] at operationSyntax + | resetSharedCold schemaAt resolved viewed shared retained => + obtain ⟨site, blockId, input, nextInput, entryValueCount, + operation, index, next, traceEq, operationSyntax⟩ := + state.currentLetOp blockAt pc instructionAt + cases operation <;> simp [Lower.OperationSyntax] at operationSyntax + | retainShared resolved retained => + obtain ⟨nextState, _targetStep⟩ := state.stepRetainOfTarget + (sourceContext := sourceContext) (sourceFuel := 0) + (context := Eval.Context.ofProgram + attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (interpretation := .physical) rfl blockAt pc instructionAt resolved + retained + obtain ⟨site, blockId, input, nextInput, entryValueCount, + operation, index, next, traceEq, _operationSyntax⟩ := + state.currentLetOp blockAt pc instructionAt + exact .advance (AttachedCompilerAdvance.prefixStepOfLetOp state + (.running nextState) traceEq (by constructor)) + | releaseShared resolved released => + obtain ⟨nextState, _targetStep⟩ := state.stepReleaseOfTarget + (sourceContext := sourceContext) + (context := Eval.Context.ofProgram + attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (interpretation := .physical) rfl blockAt pc instructionAt resolved + released + obtain ⟨site, blockId, input, nextInput, entryValueCount, + operation, index, next, traceEq, _operationSyntax⟩ := + state.currentLetOp blockAt pc instructionAt + exact .advance (AttachedCompilerAdvance.prefixStepOfLetOp state + (.running nextState) traceEq (by constructor)) + | dropUnique resolved dropped => + obtain ⟨nextState, _targetStep, acceptedEntry⟩ := + state.stepDropUniqueOfTarget + (sourceContext := sourceContext) + (context := Eval.Context.ofProgram + attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (interpretation := .physical) rfl blockAt pc instructionAt resolved + dropped + exact .advance + (.step (.running nextState) (fun _related => acceptedEntry _)) + | freeUnique resolved viewed scalarFields => + obtain ⟨nextState, _targetStep, acceptedEntry⟩ := + state.stepFreeUniqueOfTarget + (sourceContext := sourceContext) (sourceFuel := 0) + (context := Eval.Context.ofProgram + attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (interpretation := .physical) rfl blockAt pc instructionAt resolved + viewed scalarFields + exact .advance + (.step (.running nextState) (fun _related => acceptedEntry _)) + | @fetch target cid field location box fields value resolved boxAt node + fieldAt => + rcases box with ⟨world, rc, targetNode⟩ + change targetNode = .ctorN cid fields at node + subst targetNode + obtain ⟨nextState, _targetStep⟩ := state.stepFetchOfTarget + (sourceContext := sourceContext) (sourceFuel := 0) + (context := Eval.Context.ofProgram + attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (interpretation := .physical) rfl blockAt pc instructionAt resolved + boxAt fieldAt + obtain ⟨site, blockId, input, nextInput, entryValueCount, + operation, index, next, traceEq, _operationSyntax⟩ := + state.currentLetOp blockAt pc instructionAt + exact .advance (AttachedCompilerAdvance.prefixStepOfLetOp state + (.running nextState) traceEq (by constructor)) + | callFn noCredits resolved declaration arity nonempty => + obtain ⟨nextState, _targetStep, acceptedEntry⟩ := + state.enterCallOfTarget + (sourceContext := sourceContext) (sourceFuel := 0) + (context := Eval.Context.ofProgram + attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (interpretation := .physical) rfl rfl blockAt pc instructionAt + resolved declaration arity + exact .advance + (.step (.running nextState) (fun _related => acceptedEntry _)) + | callSelf noCredits resolved arity nonempty => + obtain ⟨nextState, _targetStep, acceptedEntry⟩ := + state.enterCallSelfOfTarget + (sourceContext := sourceContext) (sourceFuel := 0) + (context := Eval.Context.ofProgram + attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (interpretation := .physical) blockAt pc instructionAt resolved arity + exact .advance + (.step (.running nextState) (fun _related => acceptedEntry _)) + | pappFn noCredits declaration papSafe resolved under => + obtain ⟨nextState, _targetStep, acceptedEntry⟩ := + state.stepPappOfTarget + (sourceContext := sourceContext) (sourceFuel := 0) + (context := Eval.Context.ofProgram + attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (interpretation := .physical) rfl rfl blockAt pc instructionAt + declaration papSafe resolved under + exact .advance + (.step (.running nextState) (fun _related => acceptedEntry _)) + | pappExtern noCredits declaration resolved under => + exact (attached.targetDeclaration_not_extern rfl declaration).elim + | apply noCredits functionResolved argumentsResolved transferred => + exact .apply rfl functionResolved argumentsResolved transferred + | extern noCredits resolved declaration argumentArity called => + obtain ⟨site, blockId, input, nextInput, entryValueCount, + operation, index, next, traceEq, operationSyntax⟩ := + state.currentLetOp blockAt pc instructionAt + cases operation with + | extern sourceAddress sourceArguments => + exact (state.externImpossible traceEq).elim + | pure sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | alloc sourceWorld sourceCid sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | reuse sourceAtom sourceCid sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | free sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | dup sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | drop sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | dropU sourceAtom => simp [Lower.OperationSyntax] at operationSyntax + | fetch sourceAtom sourceField => + simp [Lower.OperationSyntax] at operationSyntax + | call sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | callSelf sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | papp sourceAddress sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + | apply sourceFunction sourceArguments => + simp [Lower.OperationSyntax] at operationSyntax + +/-- Discharge the residual dynamic-apply arm of an instruction +classification. This separates exhaustive syntactic reconstruction from the +semantic application proof used by the callback-free wrapper below. -/ +theorem AttachedCompilerInstructionCase.resolve + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {optimized : OptimizedAttachment attached} + {baselineContext rewrittenContext : Eval.Context} + {machine rewritten baselineNext : Machine} + {state : CompilerRunningState attached machine} + {instruction : Instr} + (classified : AttachedCompilerInstructionCase optimized baselineContext + rewrittenContext machine rewritten baselineNext state instruction) + (applyAdvance : ∀ {functionAtom : Atom} + {argumentAtoms : Array Atom} {function : RVal} + {arguments : Array RVal}, + instruction = .apply functionAtom argumentAtoms → + Eval.resolveAtom state.frame.values functionAtom = .ok function → + Eval.resolveAtoms state.frame.values argumentAtoms = .ok arguments → + Eval.ApplyTransfer baselineContext .physical machine.store + machine.heapFuel function arguments + { state.frame with pc := state.frame.pc + 1 } state.stack + baselineNext → + AttachedCompilerAdvance optimized baselineContext rewrittenContext + .physical machine rewritten baselineNext) : + AttachedCompilerAdvance optimized baselineContext rewrittenContext + .physical machine rewritten baselineNext := by + cases classified with + | advance ready => exact ready + | apply instructionEq functionResolved argumentsResolved transferred => + exact applyAdvance instructionEq functionResolved argumentsResolved + transferred + +/-- Every successful physical instruction in an attached baseline program +has callback-free compiler progress. The intermediate instruction +classification isolates dynamic application, and `stepApplyOfTarget` +discharges that final semantic branch from checked ownership. -/ +theorem attachedPhysicalInstructionAdvance + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {machine rewritten baselineNext : Machine} + (state : CompilerRunningState attached machine) + {block : Block} {instruction : Instr} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc < block.instructions.size) + (instructionAt : block.instructions[state.frame.pc] = instruction) + (classified : InstructionTransferCase + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + .physical machine.store machine.heapFuel state.frame state.stack + instruction baselineNext) : + AttachedCompilerAdvance optimized + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (Eval.Context.ofProgram optimized.output.trace.target + attached.target.artifact.validationContext.schemas oracle) + .physical machine rewritten baselineNext := by + apply (attachedPhysicalInstructionCase optimized state blockAt pc + instructionAt classified).resolve + intro functionAtom argumentAtoms function arguments instructionEq + functionResolved argumentsResolved transferred + rw [instructionEq] at instructionAt + obtain ⟨nextState, _targetStep, acceptedEntry⟩ := + state.stepApplyOfTarget + (sourceContext := attached.simulationSourceContext) + (context := Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (interpretation := .physical) rfl rfl blockAt pc instructionAt + functionResolved argumentsResolved transferred + exact .step (.running nextState) + (fun _related => acceptedEntry _) + +/-- The four terminator families emitted by structured lowering. -/ +inductive CompilerTerminatorSyntax : Terminator → Prop where + | ret (atom : Atom) : CompilerTerminatorSyntax (.ret atom) + | tailCall (address : Ixon.Address) (arguments : Array Atom) : + CompilerTerminatorSyntax (.tailCall address arguments) + | tailCallSelf (arguments : Array Atom) : + CompilerTerminatorSyntax (.tailCallSelf arguments) + | switchValue (scrutinee : Atom) (constructors : Array CtorAlt) + (natPeel : Option NatPeel) : + CompilerTerminatorSyntax (.switchValue scrutinee constructors natPeel) + +/-- A checked compiler trace cannot expose reuse-only jump or credit-branch +terminators at a source synchronization coordinate. -/ +theorem CompilerRunningState.currentTerminatorSyntax + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} {machine : Machine} + (state : CompilerRunningState attached machine) + {block : Block} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc = block.instructions.size) : + CompilerTerminatorSyntax block.terminator := by + have exactBlock := state.traceState.target.blockAt state.descendant + have blockEq : block = state.trace.headBlock.2 := + Option.some.inj (blockAt.symm.trans exactBlock) + generalize traceEq : state.trace = trace at blockEq + cases trace with + | ret site blockId input entryValueCount sourceAtom targetAtom generated => + simp only [Lower.CodeTrace.headBlock] at blockEq + have descendant : state.functionTrace.root.Descendant + (.ret site blockId input entryValueCount sourceAtom targetAtom + generated) := by + rw [← traceEq] + exact state.descendant + have emitted := (Lower.CodeTrace.retSyntax_of_match + (state.functionTrace.descendantSyntaxMatches descendant)).2 + rw [blockEq, emitted] + exact .ret _ + | tailCall site blockId input entryValueCount address sourceArguments + generated => + simp only [Lower.CodeTrace.headBlock] at blockEq + have descendant : state.functionTrace.root.Descendant + (.tailCall site blockId input entryValueCount address sourceArguments + generated) := by + rw [← traceEq] + exact state.descendant + obtain ⟨arguments, _translated, emitted⟩ := + Lower.CodeTrace.tailCallSyntax_of_match + (state.functionTrace.descendantSyntaxMatches descendant) + rw [blockEq, emitted] + exact .tailCall _ _ + | tailCallSelf site blockId input entryValueCount sourceArguments generated => + simp only [Lower.CodeTrace.headBlock] at blockEq + have descendant : state.functionTrace.root.Descendant + (.tailCallSelf site blockId input entryValueCount sourceArguments + generated) := by + rw [← traceEq] + exact state.descendant + obtain ⟨arguments, _translated, emitted⟩ := + Lower.CodeTrace.tailCallSelfSyntax_of_match + (state.functionTrace.descendantSyntaxMatches descendant) + rw [blockEq, emitted] + exact .tailCallSelf _ + | letOp site blockId input nextInput entryValueCount operation index + instruction next => + simp only [Lower.CodeTrace.headBlock] at blockEq + have descendant : state.functionTrace.root.Descendant + (.letOp site blockId input nextInput entryValueCount operation index + instruction next) := by + rw [← traceEq] + exact state.descendant + have statePc := state.traceState.target.pc + rw [traceEq] at statePc + simp only [Lower.CodeTrace.entryPc] at statePc + have instructionAt := + (state.functionTrace.descendantLetOpMatch descendant).1.instructionAt + have instructionBound := + (Array.getElem?_eq_some_iff.mp instructionAt).1 + rw [← blockEq] at instructionBound + omega + | switchValue site blockId input entryValueCount sourceScrutinee peelNat + alternatives targetScrutinee generated outgoing children => + simp only [Lower.CodeTrace.headBlock] at blockEq + have descendant : state.functionTrace.root.Descendant + (.switchValue site blockId input entryValueCount sourceScrutinee + peelNat alternatives targetScrutinee generated outgoing + children) := by + rw [← traceEq] + exact state.descendant + obtain ⟨constructors, natPeel, _translated, emitted⟩ := + Lower.CodeTrace.switchSyntax_of_match + (state.functionTrace.descendantSyntaxMatches descendant) + rw [blockEq, emitted] + exact .switchValue _ _ _ + +/-- Compiler progress for a target terminator, with only constructor macros +and nonterminal returns retained as typed residuals. -/ +inductive AttachedCompilerTerminatorCase + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + (baselineContext rewrittenContext : Eval.Context) + (machine rewritten : Machine) + (state : CompilerRunningState attached machine) : + Terminator → Machine → Prop where + | advance {terminator baselineNext} + (ready : AttachedCompilerAdvance optimized baselineContext + rewrittenContext .physical machine rewritten baselineNext) : + AttachedCompilerTerminatorCase optimized baselineContext + rewrittenContext machine rewritten state terminator baselineNext + | switchCtor {scrutinee : Atom} {constructors : Array CtorAlt} + {natPeel : Option NatPeel} {location : Nat} {box : IxIR1.NodeBox} + {cid : CtorId} {fields : Array RVal} {alternative : CtorAlt} + {target : Frame} + (compilerMacro : CompilerMacroStep attached baselineContext .physical + machine) + (resolved : Eval.resolveAtom state.frame.values scrutinee = + .ok (.loc location)) + (boxAt : machine.store.get? location = some box) + (node : box.node = .ctorN cid fields) + (alternativeAt : constructors.find? (fun candidate => + candidate.cid == cid) = some alternative) + (transferred : Eval.EdgeTransfer state.frame alternative.edge #[] target) : + AttachedCompilerTerminatorCase optimized baselineContext + rewrittenContext machine rewritten state + (.switchValue scrutinee constructors natPeel) + { machine with control := .running target state.stack } + | retResume {caller : Frame} {rest : List Continuation} + {atom : Atom} {value : RVal} + (stackEq : state.stack = .resume caller :: rest) + (resolved : Eval.resolveAtom state.frame.values atom = .ok value) + (noCredits : Eval.NoLiveCredits state.frame) + (world : value.hasWorld machine.store + state.frame.definition.signature.result = true) : + AttachedCompilerTerminatorCase optimized baselineContext + rewrittenContext machine rewritten state (.ret atom) + { store := machine.store + heapFuel := machine.heapFuel + control := .running + { caller with values := caller.values.push value } rest } + | retApplyMore {caller : Frame} {arguments : Array RVal} + {rest : List Continuation} {atom : Atom} {value : RVal} + {target : Machine} + (stackEq : state.stack = .applyMore arguments caller :: rest) + (resolved : Eval.resolveAtom state.frame.values atom = .ok value) + (noCredits : Eval.NoLiveCredits state.frame) + (world : value.hasWorld machine.store + state.frame.definition.signature.result = true) + (transferred : Eval.ApplyTransfer baselineContext .physical + machine.store machine.heapFuel value arguments caller rest target) : + AttachedCompilerTerminatorCase optimized baselineContext + rewrittenContext machine rewritten state (.ret atom) target + +/-- Exhaustively reconstruct compiler progress for all target terminators +except constructor macros and returns that cross a continuation boundary. -/ +theorem attachedPhysicalTerminatorCase + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {machine rewritten baselineNext : Machine} + (state : CompilerRunningState attached machine) + {block : Block} {terminator : Terminator} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc = block.instructions.size) + (terminatorAt : block.terminator = terminator) + (classified : Eval.TerminatorTransferCase + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + .physical machine.store machine.heapFuel state.frame state.stack + terminator baselineNext) : + AttachedCompilerTerminatorCase optimized + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (Eval.Context.ofProgram optimized.output.trace.target + attached.target.artifact.validationContext.schemas oracle) + machine rewritten state terminator baselineNext := by + let sourceContext := attached.simulationSourceContext + generalize stackEq : state.stack = currentStack at classified + cases classified with + | jump transferred => + have shape := state.currentTerminatorSyntax blockAt pc + rw [terminatorAt] at shape + cases shape + | switchCtor resolved boxAt node alternativeAt transferred => + rw [← stackEq] + exact .switchCtor + (state.switchCtorMacroOfTarget blockAt pc terminatorAt resolved boxAt + node alternativeAt) + resolved boxAt node alternativeAt transferred + | switchNatZero resolved transferred => + rw [← stackEq] + obtain ⟨nextState, _targetStep, acceptedEntry⟩ := + state.stepSwitchNatZeroOfTarget + (context := Eval.Context.ofProgram + attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (interpretation := .physical) blockAt pc terminatorAt resolved + transferred + exact .advance + (.step (.running nextState) (fun _related => acceptedEntry _)) + | switchNatSucc resolved transferred => + rw [← stackEq] + obtain ⟨nextState, _targetStep, acceptedEntry⟩ := + state.stepSwitchNatSuccOfTarget + (context := Eval.Context.ofProgram + attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (interpretation := .physical) blockAt pc terminatorAt resolved + transferred + exact .advance + (.step (.running nextState) (fun _related => acceptedEntry _)) + | branchPresent lookedUp present transferred => + have shape := state.currentTerminatorSyntax blockAt pc + rw [terminatorAt] at shape + cases shape + | branchAbsent lookedUp absent transferred => + have shape := state.currentTerminatorSyntax blockAt pc + rw [terminatorAt] at shape + cases shape + | retResume resolved noCredits world => + exact .retResume stackEq resolved noCredits world + | retHalt resolved noCredits world => + obtain ⟨_targetStep, compiler, acceptedEntry⟩ := + state.returnHaltOfTarget + (sourceContext := sourceContext) (sourceFuel := 0) + (context := Eval.Context.ofProgram + attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (interpretation := .physical) blockAt pc terminatorAt stackEq resolved + exact .advance + (.step compiler (fun _related => acceptedEntry _)) + | retApplyMore resolved noCredits world transferred => + exact .retApplyMore stackEq resolved noCredits world transferred + | tailCallFn noCredits resolved declaration arity nonempty => + rw [← stackEq] + obtain ⟨nextState, _targetStep, acceptedEntry⟩ := + state.enterTailCallOfTarget + (sourceContext := sourceContext) (sourceFuel := 0) + (context := Eval.Context.ofProgram + attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (interpretation := .physical) rfl rfl blockAt pc terminatorAt + resolved declaration arity + exact .advance + (.step (.running nextState) (fun _related => acceptedEntry _)) + | tailCallSelf noCredits resolved arity nonempty => + rw [← stackEq] + obtain ⟨nextState, _targetStep⟩ := + state.enterTailCallSelfOfTarget + (sourceContext := sourceContext) (sourceFuel := 0) + (context := Eval.Context.ofProgram + attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (interpretation := .physical) blockAt pc terminatorAt resolved arity + exact .advance + (.stepOfPcZero (.running nextState) rfl rfl) + +/-- Resolve the three semantic residuals left by exhaustive terminator +classification. Constructor handlers receive the already reconstructed +positive compiler macro; return handlers retain only the continuation history +that is not recoverable from the current leaf state alone. -/ +theorem AttachedCompilerTerminatorCase.resolve + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {optimized : OptimizedAttachment attached} + {baselineContext rewrittenContext : Eval.Context} + {machine rewritten baselineNext : Machine} + {state : CompilerRunningState attached machine} + {terminator : Terminator} + (classified : AttachedCompilerTerminatorCase optimized baselineContext + rewrittenContext machine rewritten state terminator baselineNext) + (switchCtorAdvance : ∀ {scrutinee : Atom} + {constructors : Array CtorAlt} {natPeel : Option NatPeel} + {location : Nat} {box : IxIR1.NodeBox} {cid : CtorId} + {fields : Array RVal} {alternative : CtorAlt} {target : Frame}, + terminator = .switchValue scrutinee constructors natPeel → + CompilerMacroStep attached baselineContext .physical machine → + Eval.resolveAtom state.frame.values scrutinee = .ok (.loc location) → + machine.store.get? location = some box → + box.node = .ctorN cid fields → + constructors.find? (fun candidate => candidate.cid == cid) = + some alternative → + Eval.EdgeTransfer state.frame alternative.edge #[] target → + AttachedCompilerAdvance optimized baselineContext rewrittenContext + .physical machine rewritten + { machine with control := .running target state.stack }) + (retResumeAdvance : ∀ {caller : Frame} {rest : List Continuation} + {atom : Atom} {value : RVal}, + terminator = .ret atom → + state.stack = .resume caller :: rest → + Eval.resolveAtom state.frame.values atom = .ok value → + Eval.NoLiveCredits state.frame → + value.hasWorld machine.store state.frame.definition.signature.result = + true → + AttachedCompilerAdvance optimized baselineContext rewrittenContext + .physical machine rewritten + { store := machine.store + heapFuel := machine.heapFuel + control := .running + { caller with values := caller.values.push value } rest }) + (retApplyMoreAdvance : ∀ {caller : Frame} {arguments : Array RVal} + {rest : List Continuation} {atom : Atom} {value : RVal} + {target : Machine}, + terminator = .ret atom → + state.stack = .applyMore arguments caller :: rest → + Eval.resolveAtom state.frame.values atom = .ok value → + Eval.NoLiveCredits state.frame → + value.hasWorld machine.store state.frame.definition.signature.result = + true → + Eval.ApplyTransfer baselineContext .physical machine.store + machine.heapFuel value arguments caller rest target → + AttachedCompilerAdvance optimized baselineContext rewrittenContext + .physical machine rewritten target) : + AttachedCompilerAdvance optimized baselineContext rewrittenContext + .physical machine rewritten baselineNext := by + cases classified with + | advance ready => exact ready + | switchCtor compilerMacro resolved boxAt node alternativeAt transferred => + exact switchCtorAdvance rfl compilerMacro resolved boxAt node + alternativeAt transferred + | retResume stackEq resolved noCredits world => + exact retResumeAdvance rfl stackEq resolved noCredits world + | retApplyMore stackEq resolved noCredits world transferred => + exact retApplyMoreAdvance rfl stackEq resolved noCredits world + transferred + +/-- Resolve constructor terminators all the way to a paired positive macro +under a concrete allocation history and successful baseline suffix. The +selected child's compiler and physical reuse macro and ordinary caller +resumption are reconstructed internally. Only residual `applyMore` dispatch +remains explicit. -/ +theorem attachedPhysicalTerminatorAdvanceHistory + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {machine baselineNext : Machine} + (state : CompilerRunningState attached machine) + {rewrittenStore : Store} {rewrittenFuel : Nat} + {rewrittenFrame : Frame} {rewrittenStack : List Continuation} + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + (heap : IxIR1.Sim.HeapHistoryIso machine.store.heap rewrittenStore.heap) + (fuel : machine.heapFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel state.frame + rewrittenFrame) + (stack : StableLiveStackIso Validate.defaultLimits + attached.target.artifact.validationContext heap.locRel state.stack + rewrittenStack) + {block : Block} {terminator : Terminator} + (blockAt : state.frame.definition.blocks[state.frame.block]? = some block) + (pc : state.frame.pc = block.instructions.size) + (terminatorAt : block.terminator = terminator) + (classified : Eval.TerminatorTransferCase + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + .physical machine.store machine.heapFuel state.frame state.stack + terminator baselineNext) + {baselineFinal : Machine} {suffixCount : Nat} + {finalStore : Store} {finalHeapFuel : Nat} {finalValue : RVal} + (suffix : Steps + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + .physical suffixCount baselineNext baselineFinal) + (halted : baselineFinal = + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue }) : + AttachedCompilerAdvance optimized + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (Eval.Context.ofProgram optimized.output.trace.target + attached.target.artifact.validationContext.schemas oracle) + .physical machine + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + baselineNext := by + have canonicalEq : + ({ store := machine.store + heapFuel := machine.heapFuel + control := .running state.frame state.stack } : Machine) = + machine := by + simpa only using congrArg + (fun control => ({ machine with control } : Machine)) state.control.symm + have stepped : Step + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + .physical machine baselineNext := by + have head := classified.step blockAt pc terminatorAt + rwa [canonicalEq] at head + apply (attachedPhysicalTerminatorCase optimized state blockAt pc terminatorAt + classified).resolve + · intro scrutinee constructors natPeel location box cid fields alternative + target terminatorEq _compilerMacro resolved boxAt node alternativeAt + _transferred + exact .macro + (attachedPhysicalSwitchCtorMacroOfTarget optimized rfl rfl state rewrite + heap fuel frame stack blockAt pc (terminatorAt.trans terminatorEq) + resolved boxAt node alternativeAt stepped suffix halted) + · intro caller rest atom value terminatorEq stackEq resolved noCredits world + have returnStep : Eval.Step + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + .physical machine + { machine with + control := .running + { caller with values := caller.values.push value } rest } := + Eval.Step.retResumeCleared (by rw [state.control, stackEq]) blockAt pc + (terminatorAt.trans terminatorEq) resolved noCredits world + obtain ⟨nextState, _step, acceptedEntry⟩ := + state.returnResumeOfTarget blockAt pc (terminatorAt.trans terminatorEq) + stackEq resolved returnStep + exact .step (.running nextState) (fun _ => acceptedEntry _) + · intro caller arguments rest atom value target terminatorEq stackEq + resolved _noCredits _world transferred + obtain ⟨nextState, acceptedEntry⟩ := + state.returnApplyMoreOfTarget + (context := Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (interpretation := .physical) (target := target) rfl blockAt pc + (terminatorAt.trans terminatorEq) stackEq resolved transferred + exact .step (.running nextState) (fun _ => acceptedEntry _) + +/-- Exhaustive compiler-aware synchronization dispatch from an +allocation-history-related live state. Literally preserved blocks carry the +compiler state at the ordinary one-step successor; accepted blocks remain one +local compiler-aware macro obligation. -/ +theorem attachedStableMacroStepOfTraceIsoOfStep + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + {sourceProgram : Program} + (trace : Reuse.Trace Validate.defaultLimits + attached.target.artifact.validationContext sourceProgram) + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso Validate.defaultLimits + attached.target.artifact.validationContext heap.locRel + baselineStack rewrittenStack) + {baselineStepTarget : Machine} + (stepped : Step + (Eval.Context.ofProgram sourceProgram + attached.target.artifact.validationContext.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + baselineStepTarget) + (compilerNext : CompilerState attached baselineStepTarget) + (acceptedEntryNext : ∀ {rewrittenTarget : Machine}, + StableLiveMachineRel Validate.defaultLimits + attached.target.artifact.validationContext baselineStepTarget + rewrittenTarget → + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext baselineStepTarget + rewrittenTarget) + (accepted : ∀ {helperOffset : Nat} {block : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block}, + Reuse.FunctionDecisions.At rewrite.decisions baselineFrame.block + helperOffset block (.accepted site) → + AttachedStableMacroStep optimized + (Eval.Context.ofProgram sourceProgram + attached.target.artifact.validationContext.schemas oracle) + (Eval.Context.ofProgram trace.target + attached.target.artifact.validationContext.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) : + AttachedStableMacroStep optimized + (Eval.Context.ofProgram sourceProgram + attached.target.artifact.validationContext.schemas oracle) + (Eval.Context.ofProgram trace.target + attached.target.artifact.validationContext.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } := by + have dispatch : ∀ {block : Block}, + baselineFrame.definition.blocks[baselineFrame.block]? = some block → + AttachedStableMacroStep optimized + (Eval.Context.ofProgram sourceProgram + attached.target.artifact.validationContext.schemas oracle) + (Eval.Context.ofProgram trace.target + attached.target.artifact.validationContext.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } := by + intro block blockAt + cases frame.blockCase blockAt with + | unchanged sourceAt targetAt => + have sourceBlockAt : source.blocks[baselineFrame.block]? = + some block := by + rw [← frame.baselineDefinition] + exact blockAt + have blockEq := Option.some.inj (sourceAt.symm.trans sourceBlockAt) + cases blockEq + have rewrittenBlockAt : + rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block := by + rw [frame.rewrittenDefinition, ← frame.block] + exact targetAt + obtain ⟨rewrittenTarget, rewrittenStep, related⟩ := + unchangedStepOfTraceLiveIso trace rewrite heap fuel frame stack blockAt + rewrittenBlockAt stepped + exact AttachedStableMacroStep.ofStepsOne rfl rfl stepped rewrittenStep + related (acceptedEntryNext related) compilerNext + (unchangedStep_allocationDelta heap frame stack blockAt rewrittenBlockAt + stepped rewrittenStep) + (unchangedStep_costDelta heap frame stack blockAt rewrittenBlockAt + stepped rewrittenStep related) + | accepted found => + exact accepted found + cases stepped.classify with + | instruction blockAt _pc _instructionAt _instructionCase => + exact dispatch blockAt + | terminator blockAt _pc _terminatorAt _terminatorCase => + exact dispatch blockAt + +/-- Dispatch one baseline instruction from the syntactic family used by a +recognized reuse prefix. If the enclosing block was left unchanged, both +machines take the same literal instruction and the resulting same-block +relation supplies accepted-entry phase. If the block was accepted, the +intermediate prefix state is deliberately skipped and the whole-site macro +owns synchronization. -/ +theorem attachedStableMacroStepOfTraceIsoOfPrefixStep + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + {sourceProgram : Program} + (trace : Reuse.Trace Validate.defaultLimits + attached.target.artifact.validationContext sourceProgram) + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso Validate.defaultLimits + attached.target.artifact.validationContext heap.locRel + baselineStack rewrittenStack) + {baselineStepTarget : Machine} + (stepped : Step + (Eval.Context.ofProgram sourceProgram + attached.target.artifact.validationContext.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + baselineStepTarget) + (compilerNext : CompilerState attached baselineStepTarget) + (prefixAt : AcceptedPrefixInstructionAt + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + (accepted : ∀ {helperOffset : Nat} {block : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block}, + Reuse.FunctionDecisions.At rewrite.decisions baselineFrame.block + helperOffset block (.accepted site) → + AttachedStableMacroStep optimized + (Eval.Context.ofProgram sourceProgram + attached.target.artifact.validationContext.schemas oracle) + (Eval.Context.ofProgram trace.target + attached.target.artifact.validationContext.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) : + AttachedStableMacroStep optimized + (Eval.Context.ofProgram sourceProgram + attached.target.artifact.validationContext.schemas oracle) + (Eval.Context.ofProgram trace.target + attached.target.artifact.validationContext.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } := by + obtain ⟨prefixFrame, prefixStack, block, instruction, control, blockAt, + pc, instructionAt, acceptedPrefix⟩ := prefixAt + change (.running baselineFrame baselineStack : Control) = + .running prefixFrame prefixStack at control + injection control with frameEq stackEq + subst prefixFrame + subst prefixStack + cases frame.blockCase blockAt with + | unchanged sourceAt targetAt => + have sourceBlockAt : source.blocks[baselineFrame.block]? = + some block := by + rw [← frame.baselineDefinition] + exact blockAt + have blockEq := Option.some.inj (sourceAt.symm.trans sourceBlockAt) + cases blockEq + have rewrittenBlockAt : + rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block := by + rw [frame.rewrittenDefinition, ← frame.block] + exact targetAt + cases stepped.classify with + | instruction classifiedBlockAt _classifiedPc classifiedInstructionAt + classified => + have classifiedBlockEq := + Option.some.inj (classifiedBlockAt.symm.trans blockAt) + cases classifiedBlockEq + have classifiedInstructionEq := + classifiedInstructionAt.symm.trans instructionAt + cases classifiedInstructionEq + obtain ⟨rewrittenTarget, baselineStep, rewrittenStep, related, + acceptedEntry⟩ := + unchangedAcceptedPrefixInstructionStepOfTraceLiveIso trace rewrite + heap fuel frame stack blockAt rewrittenBlockAt pc instructionAt + classified acceptedPrefix + exact AttachedStableMacroStep.ofStepsOne rfl rfl baselineStep + rewrittenStep related acceptedEntry compilerNext + (unchangedStep_allocationDelta heap frame stack blockAt rewrittenBlockAt + baselineStep rewrittenStep) + (unchangedStep_costDelta heap frame stack blockAt rewrittenBlockAt + baselineStep rewrittenStep related) + | terminator classifiedBlockAt terminal _terminatorAt _classified => + have classifiedBlockEq := + Option.some.inj (classifiedBlockAt.symm.trans blockAt) + cases classifiedBlockEq + omega + | accepted found => + exact accepted found + +/-- Trace dispatch with an explicit positive-macro arm. This removes the +false requirement that every compiler trace boundary coincide with the +evaluator's immediate successor: a constructor switch can supply its +edge-plus-fetch macro directly, while ordinary steps reuse the exhaustive +one-step dispatcher above. -/ +theorem attachedStableMacroStepOfTraceIso + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + {sourceProgram : Program} + (trace : Reuse.Trace Validate.defaultLimits + attached.target.artifact.validationContext sourceProgram) + {source : Function} + (rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableLiveFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableLiveStackIso Validate.defaultLimits + attached.target.artifact.validationContext heap.locRel + baselineStack rewrittenStack) + {baselineStepTarget : Machine} + (stepped : Step + (Eval.Context.ofProgram sourceProgram + attached.target.artifact.validationContext.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + baselineStepTarget) + (advance : AttachedCompilerAdvance optimized + (Eval.Context.ofProgram sourceProgram + attached.target.artifact.validationContext.schemas oracle) + (Eval.Context.ofProgram trace.target + attached.target.artifact.validationContext.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + baselineStepTarget) + (accepted : ∀ {helperOffset : Nat} {block : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block}, + Reuse.FunctionDecisions.At rewrite.decisions baselineFrame.block + helperOffset block (.accepted site) → + AttachedStableMacroStep optimized + (Eval.Context.ofProgram sourceProgram + attached.target.artifact.validationContext.schemas oracle) + (Eval.Context.ofProgram trace.target + attached.target.artifact.validationContext.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) : + AttachedStableMacroStep optimized + (Eval.Context.ofProgram sourceProgram + attached.target.artifact.validationContext.schemas oracle) + (Eval.Context.ofProgram trace.target + attached.target.artifact.validationContext.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } := by + cases advance with + | step compilerNext acceptedEntryNext => + exact attachedStableMacroStepOfTraceIsoOfStep optimized trace rewrite + heap fuel frame stack stepped compilerNext acceptedEntryNext accepted + | prefixStep compilerNext prefixAt => + exact attachedStableMacroStepOfTraceIsoOfPrefixStep optimized trace + rewrite heap fuel frame stack stepped compilerNext prefixAt accepted + | «macro» ready => exact ready + +/-- Uniform compiler-aware synchronization over either arm of +`StableHeapRel`. Allocation-history states dispatch directly. Exact-content +states are first re-indexed by the compiler's bounded canonical history, so +ordinary steps stay automatic while accepted sites retain their original +exact-content premises. -/ +theorem attachedStableMacroStepOfTraceRel + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (compiler : CompilerRunningState attached + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + (relation : StableLiveMachineRel Validate.defaultLimits + attached.target.artifact.validationContext + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + (acceptedEntry : StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + {baselineStepTarget : Machine} + (stepped : Step + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + baselineStepTarget) + (advance : AttachedCompilerAdvance optimized + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (Eval.Context.ofProgram optimized.output.trace.target + attached.target.artifact.validationContext.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + baselineStepTarget) + (accepted : ∀ {locRel : Nat → Nat → Prop} + {source : Function} + {rewrite : Reuse.FunctionRewrite Validate.defaultLimits + attached.target.artifact.validationContext source}, + StableHeapRel baselineStore rewrittenStore locRel → + StableLiveFrameIso rewrite locRel baselineFrame rewrittenFrame → + StableLiveStackIso Validate.defaultLimits + attached.target.artifact.validationContext locRel + baselineStack rewrittenStack → + ∀ {helperOffset : Nat} {block : Block} + {site : Reuse.Site Validate.defaultLimits + attached.target.artifact.validationContext block}, + Reuse.FunctionDecisions.At rewrite.decisions baselineFrame.block + helperOffset block (.accepted site) → + baselineFrame.pc = 0 → + LiveValuesIso source baselineFrame.block 0 locRel + baselineFrame.values rewrittenFrame.values → + AttachedStableMacroStep optimized + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (Eval.Context.ofProgram optimized.output.trace.target + attached.target.artifact.validationContext.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) : + AttachedStableMacroStep optimized + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (Eval.Context.ofProgram optimized.output.trace.target + attached.target.artifact.validationContext.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } := by + cases relation with + | related locRel heap fuel control => + cases control with + | running frames stack => + cases frames with + | rewritten rewrite frame => + cases heap with + | isomorphic iso => + apply attachedStableMacroStepOfTraceIso optimized + optimized.output.trace rewrite iso.symm fuel frame stack + stepped advance + intro helperOffset block site found + obtain ⟨pc, parameters⟩ := + acceptedEntry.valuesAtEntry rfl rfl frame found + exact accepted (.isomorphic iso) frame stack found pc + parameters + | contents same => + have controlEq : + Control.running baselineFrame baselineStack = + .running compiler.frame compiler.stack := by + simpa using compiler.control + injection controlEq with frameEq stackEq + have compilerFrame : StableLiveFrameIso rewrite + (fun left right => left = right) compiler.frame + rewrittenFrame := by + simpa [← frameEq] using frame + have compilerStack : StableLiveStackIso + Validate.defaultLimits + attached.target.artifact.validationContext + (fun left right => left = right) compiler.stack + rewrittenStack := by + simpa [← stackEq] using stack + obtain ⟨history, historyFrame, historyStack⟩ := + compiler.historyOfContents same compilerFrame compilerStack + apply attachedStableMacroStepOfTraceIso optimized + optimized.output.trace rewrite history fuel + (by simpa [frameEq] using historyFrame) + (by simpa [stackEq] using historyStack) + stepped advance + intro helperOffset block site found + obtain ⟨pc, parameters⟩ := + acceptedEntry.valuesAtEntry rfl rfl frame found + exact accepted (.contents same) frame stack found pc + parameters + +/-- Physical trace dispatch with the accepted-site arm synthesized from the +actual remaining baseline execution. Exact-content relations are first +re-indexed by the compiler's canonical live allocation history; history arms +use their existing orientation directly. Thus the only accepted-site +callback reaching the trace dispatcher is the concrete suffix inversion +above. -/ +theorem attachedPhysicalStableMacroStepOfTraceRelGuided + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (compiler : CompilerRunningState attached + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + (relation : StableLiveMachineRel Validate.defaultLimits + attached.target.artifact.validationContext + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + (acceptedEntry : StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + {baselineStepTarget baselineFinal : Machine} {suffixCount : Nat} + {finalStore : Store} {finalHeapFuel : Nat} {finalValue : RVal} + (stepped : Step + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + .physical + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + baselineStepTarget) + (suffix : Steps + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + .physical suffixCount baselineStepTarget baselineFinal) + (halted : baselineFinal = + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue }) + (advance : AttachedCompilerAdvance optimized + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (Eval.Context.ofProgram optimized.output.trace.target + attached.target.artifact.validationContext.schemas oracle) + .physical + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + baselineStepTarget) : + AttachedStableMacroStep optimized + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (Eval.Context.ofProgram optimized.output.trace.target + attached.target.artifact.validationContext.schemas oracle) + .physical + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } := by + have compilerControl : + (.running baselineFrame baselineStack : Control) = + .running compiler.frame compiler.stack := by + simpa using compiler.control + injection compilerControl with baselineFrameEq baselineStackEq + have fuel : baselineFuel ≤ rewrittenFuel := by + cases relation with + | related _ _ fuel _ => exact fuel + apply attachedStableMacroStepOfTraceRel optimized compiler relation + acceptedEntry stepped advance + intro locRel source rewrite heap frame stack helperOffset block site found + _pc _parameters + have compilerFrame : StableLiveFrameIso rewrite locRel compiler.frame + rewrittenFrame := by + simpa [← baselineFrameEq] using frame + have compilerStack : StableLiveStackIso Validate.defaultLimits + attached.target.artifact.validationContext locRel compiler.stack + rewrittenStack := by + simpa [← baselineStackEq] using stack + have compilerFound : Reuse.FunctionDecisions.At rewrite.decisions + compiler.frame.block helperOffset block (.accepted site) := by + simpa [← baselineFrameEq] using found + obtain ⟨compilerPc, compilerParameters⟩ := + acceptedEntry.valuesAtEntry compiler.control rfl compilerFrame + compilerFound + cases heap with + | isomorphic iso => + have ready := + compiler.acceptedPhysicalStableMacroStepHistoryOfExecution + (baselineContext := Eval.Context.ofProgram + attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (rewrittenContext := Eval.Context.ofProgram + optimized.output.trace.target + attached.target.artifact.validationContext.schemas oracle) + optimized rewrite compilerFrame.baselineDefinition compilerFound + compilerPc rfl rfl iso.symm compilerParameters compilerStack fuel + stepped suffix halted + have rewrittenFrameEq := + compilerFrame.rewritten_eq_entry compilerPc compiler.noCredits + rw [← rewrittenFrameEq] at ready + exact ready + + | contents same => + obtain ⟨history, historyFrame, historyStack⟩ := + compiler.historyOfContents same compilerFrame compilerStack + obtain ⟨historyPc, historyParameters⟩ := + acceptedEntry.valuesAtEntry compiler.control rfl historyFrame + compilerFound + have ready := + compiler.acceptedPhysicalStableMacroStepHistoryOfExecution + (baselineContext := Eval.Context.ofProgram + attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (rewrittenContext := Eval.Context.ofProgram + optimized.output.trace.target + attached.target.artifact.validationContext.schemas oracle) + optimized rewrite historyFrame.baselineDefinition compilerFound + historyPc rfl rfl history historyParameters historyStack fuel stepped + suffix halted + have rewrittenFrameEq := + historyFrame.rewritten_eq_entry historyPc compiler.noCredits + rw [← rewrittenFrameEq] at ready + exact ready + +/-- A live-related rewritten machine is running whenever its baseline is. +This small inversion keeps the generalized guided dispatcher independent of +the concrete frame decomposition chosen by its caller. -/ +theorem StableLiveMachineRel.rewrittenRunning + {limits : Validate.Limits} {validation : Validate.Context} + {baseline rewritten : Machine} {baselineFrame : Frame} + {baselineStack : List Continuation} + (relation : StableLiveMachineRel limits validation baseline rewritten) + (running : baseline.control = + .running baselineFrame baselineStack) : + ∃ rewrittenFrame rewrittenStack, + rewritten.control = .running rewrittenFrame rewrittenStack := by + cases relation with + | related locRel heap fuel control => + rw [running] at control + generalize rewrittenControlEq : rewritten.control = rewrittenControl + at control + cases control with + | running frame stack => exact ⟨_, _, rfl⟩ + +/-- Reconstruct compiler progress for every successful physical baseline +head. Constructor macros use the actual halted suffix; all other instructions +and returns reconstruct their next compiler state directly. -/ +theorem attachedPhysicalCompilerAdvance + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {baseline rewritten baselineNext baselineFinal : Machine} + {suffixCount : Nat} {finalStore : Store} {finalHeapFuel : Nat} + {finalValue : RVal} + (compiler : CompilerRunningState attached baseline) + (relation : StableLiveMachineRel Validate.defaultLimits + attached.target.artifact.validationContext baseline rewritten) + (stepped : Step + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + .physical baseline baselineNext) + (suffix : Steps + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + .physical suffixCount baselineNext baselineFinal) + (halted : baselineFinal = + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue }) : + AttachedCompilerAdvance optimized + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (Eval.Context.ofProgram optimized.output.trace.target + attached.target.artifact.validationContext.schemas oracle) + .physical baseline rewritten baselineNext := by + have canonicalEq : + ({ store := baseline.store + heapFuel := baseline.heapFuel + control := .running compiler.frame compiler.stack } : Machine) = + baseline := by + simpa only using congrArg + (fun control => ({ baseline with control } : Machine)) compiler.control.symm + have canonicalStep : Step + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + .physical + { store := baseline.store + heapFuel := baseline.heapFuel + control := .running compiler.frame compiler.stack } baselineNext := by + rwa [canonicalEq] + cases canonicalStep.classify with + | instruction blockAt pc instructionAt classified => + exact attachedPhysicalInstructionAdvance optimized compiler blockAt pc + instructionAt classified + | terminator blockAt pc terminatorAt classified => + cases relation with + | related locRel heap fuel control => + rw [compiler.control] at control + generalize rewrittenControlEq : rewritten.control = rewrittenControl at control + cases control with + | @running _ rewrittenFrame _ rewrittenStack frames stack => + cases frames with + | @rewritten source rewrite _ _ frame => + have rewrittenEq : + ({ store := rewritten.store + heapFuel := rewritten.heapFuel + control := .running rewrittenFrame rewrittenStack } : Machine) = rewritten := by + simpa only using congrArg + (fun control => ({ rewritten with control } : Machine)) + rewrittenControlEq.symm + rw [← rewrittenEq] + cases heap with + | isomorphic iso => + exact attachedPhysicalTerminatorAdvanceHistory optimized compiler + rewrite iso.symm fuel frame stack blockAt pc terminatorAt + classified suffix halted + | contents same => + obtain ⟨history, historyFrame, historyStack⟩ := + compiler.historyOfContents same frame stack + exact attachedPhysicalTerminatorAdvanceHistory optimized compiler + rewrite history fuel historyFrame historyStack blockAt pc + terminatorAt classified suffix halted + + +/-- Physical guided dispatch reconstructs compiler progress and accepted +macros internally. The live control relation recovers the rewritten running +frame from the abstract current machines. -/ +theorem attachedPhysicalStableMacroStepGuided + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {baseline rewritten baselineNext baselineFinal : Machine} + {frame : Frame} {stack : List Continuation} {suffixCount : Nat} + {finalStore : Store} {finalHeapFuel : Nat} {finalValue : RVal} + (compiler : CompilerRunningState attached baseline) + (relation : StableLiveMachineRel Validate.defaultLimits + attached.target.artifact.validationContext baseline rewritten) + (acceptedEntry : StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext baseline rewritten) + (running : baseline.control = .running frame stack) + (stepped : Step + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + .physical baseline baselineNext) + (suffix : Steps + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + .physical suffixCount baselineNext baselineFinal) + (halted : baselineFinal = + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue }) : + AttachedStableMacroStep optimized + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + (Eval.Context.ofProgram optimized.output.trace.target + attached.target.artifact.validationContext.schemas oracle) + .physical baseline rewritten := by + have advance := attachedPhysicalCompilerAdvance optimized compiler relation + stepped suffix halted + obtain ⟨rewrittenFrame, rewrittenStack, rewrittenRunning⟩ := + relation.rewrittenRunning running + have baselineEq : baseline = + { store := baseline.store + heapFuel := baseline.heapFuel + control := .running frame stack } := by + cases baseline + simpa only [Machine.mk.injEq, true_and] using running + have rewrittenEq : rewritten = + { store := rewritten.store + heapFuel := rewritten.heapFuel + control := .running rewrittenFrame rewrittenStack } := by + cases rewritten + simpa only [Machine.mk.injEq, true_and] using rewrittenRunning + rw [baselineEq] at compiler relation acceptedEntry stepped advance ⊢ + rw [rewrittenEq] at relation acceptedEntry advance ⊢ + exact attachedPhysicalStableMacroStepOfTraceRelGuided optimized compiler + relation acceptedEntry stepped suffix halted advance + +/-- Every compiler-aware macro is exactly an invariant-preserving macro for +`AttachedStableState`. -/ +theorem AttachedStableMacroStep.invariantStep + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {optimized : OptimizedAttachment attached} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStart rewrittenStart : Machine} + (step : AttachedStableMacroStep optimized baselineContext + rewrittenContext interpretation baselineStart rewrittenStart) + (allocations : baselineStart.store.allocationEvents = + rewrittenStart.store.allocationEvents) + (costs : baselineStart.store.CostBounds rewrittenStart.store) : + StableLiveMacroInvariantStep Validate.defaultLimits + attached.target.artifact.validationContext baselineContext + rewrittenContext interpretation (AttachedStableState optimized) + baselineStart rewrittenStart := by + cases step with + | intro baselineCount rewrittenCount baselinePositive rewrittenPositive + baselineTarget rewrittenTarget baselineSteps rewrittenSteps related + acceptedEntry compiler allocationDelta costDelta => + exact .intro baselineCount rewrittenCount baselinePositive + rewrittenPositive baselineTarget rewrittenTarget baselineSteps + rewrittenSteps related + ⟨compiler, related, acceptedEntry, allocationDelta.preserves allocations, + costDelta.preserves costs⟩ + +/-- Upgrade an existing live macro after reconstructing the compiler state at +the baseline endpoint selected by that macro. -/ +theorem StableLiveMacroSimulation.preserveCompiler + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {optimized : OptimizedAttachment attached} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStart rewrittenStart : Machine} + (simulation : StableLiveMacroSimulation Validate.defaultLimits + attached.target.artifact.validationContext baselineContext + rewrittenContext interpretation baselineStart rewrittenStart) + (preserved : ∀ {baselineCount rewrittenCount : Nat} + {baselineTarget rewrittenTarget : Machine}, + Steps baselineContext interpretation baselineCount baselineStart + baselineTarget → + Steps rewrittenContext interpretation rewrittenCount rewrittenStart + rewrittenTarget → + StableLiveMachineRel Validate.defaultLimits + attached.target.artifact.validationContext baselineTarget + rewrittenTarget → + CompilerState attached baselineTarget ∧ + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext baselineTarget + rewrittenTarget ∧ + AllocationDelta baselineStart.store baselineTarget.store + rewrittenStart.store rewrittenTarget.store ∧ + CostDelta baselineStart.store baselineTarget.store + rewrittenStart.store rewrittenTarget.store) : + AttachedStableMacroStep optimized baselineContext rewrittenContext + interpretation baselineStart rewrittenStart := by + cases simulation with + | intro baselineCount rewrittenCount baselinePositive rewrittenPositive + baselineTarget rewrittenTarget baselineSteps rewrittenSteps related => + obtain ⟨compiler, acceptedEntry, allocationDelta, costDelta⟩ := + preserved baselineSteps rewrittenSteps related + exact .intro baselineCount rewrittenCount baselinePositive + rewrittenPositive baselineTarget rewrittenTarget baselineSteps + rewrittenSteps related acceptedEntry compiler allocationDelta costDelta + +/-- Eliminate the halted compiler alternative at a running baseline state and +turn a local compiler-aware macro into preservation of the paired invariant. -/ +theorem AttachedStableState.advanceInvariant + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + {optimized : OptimizedAttachment attached} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baseline rewritten : Machine} + {frame : Frame} {stack : List Continuation} + (state : AttachedStableState optimized baseline rewritten) + (running : baseline.control = .running frame stack) + (advance : CompilerRunningState attached baseline → + StableLiveMachineRel Validate.defaultLimits + attached.target.artifact.validationContext baseline rewritten → + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext baseline rewritten → + AttachedStableMacroStep optimized baselineContext rewrittenContext + interpretation baseline rewritten) : + StableLiveMacroInvariantStep Validate.defaultLimits + attached.target.artifact.validationContext baselineContext + rewrittenContext interpretation (AttachedStableState optimized) + baseline rewritten := by + cases state.compiler with + | running compiler => + exact (advance compiler state.related state.acceptedEntry).invariantStep state.allocations state.costs + | halted stopped => + have impossible : False := by + rw [stopped] at running + cases running + exact impossible.elim + +/-- Strong finite-execution induction specialized to the concrete +compiler/reuse invariant. Its only local obligation receives the full running +compiler witness, current live machine relation, and accepted-entry phase. -/ +theorem attachedStableFiniteExecution + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + (advance : ∀ {baseline rewritten baselineNext : Machine} + {frame : Frame} {stack : List Continuation}, + CompilerRunningState attached baseline → + StableLiveMachineRel Validate.defaultLimits + attached.target.artifact.validationContext baseline rewritten → + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext baseline rewritten → + baseline.control = .running frame stack → + Step baselineContext interpretation baseline baselineNext → + AttachedStableMacroStep optimized baselineContext rewrittenContext + interpretation baseline rewritten) + {baselineCount : Nat} {baselineStart rewrittenStart baselineFinal : + Machine} + {finalStore : Store} {finalHeapFuel : Nat} {finalValue : RVal} + (initial : AttachedStableState optimized baselineStart rewrittenStart) + (baselineSteps : Steps baselineContext interpretation baselineCount + baselineStart baselineFinal) + (halted : baselineFinal = + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue }) : + ∃ rewrittenCount rewrittenFinal, + Steps rewrittenContext interpretation rewrittenCount rewrittenStart + rewrittenFinal ∧ + AttachedStableState optimized baselineFinal rewrittenFinal ∧ + StableLiveMachineRel Validate.defaultLimits + attached.target.artifact.validationContext baselineFinal + rewrittenFinal := by + apply stableLiveFiniteExecutionOfMacroInvariant + (AttachedStableState optimized) (fun state => state.related) ?_ initial + baselineSteps halted + intro baseline rewritten baselineNext frame stack state running stepped + exact state.advanceInvariant running fun compiler related acceptedEntry => + advance compiler related acceptedEntry running stepped + +/-- Execution-guided specialization of the concrete compiler/reuse +invariant. Besides the current compiler state and head step, the local +obligation receives the real suffix to the halted baseline endpoint. This is +the sound dispatch interface for accepted reuse prefixes whose later release +step, but not their first fetch step, witnesses sufficient heap fuel. -/ +theorem attachedStableFiniteExecutionGuided + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + (advance : ∀ {baseline rewritten baselineNext baselineFinal : Machine} + {frame : Frame} {stack : List Continuation} {suffixCount : Nat} + {finalStore : Store} {finalHeapFuel : Nat} {finalValue : RVal}, + CompilerRunningState attached baseline → + StableLiveMachineRel Validate.defaultLimits + attached.target.artifact.validationContext baseline rewritten → + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext baseline rewritten → + baseline.control = .running frame stack → + Step baselineContext interpretation baseline baselineNext → + Steps baselineContext interpretation suffixCount baselineNext + baselineFinal → + baselineFinal = + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue } → + AttachedStableMacroStep optimized baselineContext rewrittenContext + interpretation baseline rewritten) + {baselineCount : Nat} {baselineStart rewrittenStart baselineFinal : + Machine} + {finalStore : Store} {finalHeapFuel : Nat} {finalValue : RVal} + (initial : AttachedStableState optimized baselineStart rewrittenStart) + (baselineSteps : Steps baselineContext interpretation baselineCount + baselineStart baselineFinal) + (halted : baselineFinal = + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue }) : + ∃ rewrittenCount rewrittenFinal, + Steps rewrittenContext interpretation rewrittenCount rewrittenStart + rewrittenFinal ∧ + AttachedStableState optimized baselineFinal rewrittenFinal ∧ + StableLiveMachineRel Validate.defaultLimits + attached.target.artifact.validationContext baselineFinal + rewrittenFinal := by + apply stableLiveFiniteExecutionOfGuidedMacroInvariant + (AttachedStableState optimized) (fun state => state.related) ?_ initial + baselineSteps halted + intro baseline rewritten baselineNext baselineFinal frame stack suffixCount + finalStore finalHeapFuel finalValue state running stepped suffix halted + exact state.advanceInvariant running fun compiler related acceptedEntry => + advance compiler related acceptedEntry running stepped suffix halted + +/-- Exact `runMachine` corollary for compiler-aware live macros. In addition to +the related halted observation, the result retains the compiler state at the +baseline terminal machine. -/ +theorem attachedStableRunMachine + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + (advance : ∀ {baseline rewritten baselineNext : Machine} + {frame : Frame} {stack : List Continuation}, + CompilerRunningState attached baseline → + StableLiveMachineRel Validate.defaultLimits + attached.target.artifact.validationContext baseline rewritten → + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext baseline rewritten → + baseline.control = .running frame stack → + Step baselineContext interpretation baseline baselineNext → + AttachedStableMacroStep optimized baselineContext rewrittenContext + interpretation baseline rewritten) + {baselineCount : Nat} {baselineStart rewrittenStart : Machine} + {finalStore : Store} {finalHeapFuel : Nat} {finalValue : RVal} + (initial : AttachedStableState optimized baselineStart rewrittenStart) + (baselineSteps : Steps baselineContext interpretation baselineCount + baselineStart + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue }) : + ∃ rewrittenCount rewrittenStore rewrittenHeapFuel rewrittenValue locRel, + let rewrittenFinal : Machine := + { store := rewrittenStore + heapFuel := rewrittenHeapFuel + control := .halted rewrittenValue } + Steps rewrittenContext interpretation rewrittenCount rewrittenStart + rewrittenFinal ∧ + AttachedStableState optimized + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue } + rewrittenFinal ∧ + ReuseSim.StableHeapRel finalStore rewrittenStore locRel ∧ + finalHeapFuel ≤ rewrittenHeapFuel ∧ + IxIR1.Sim.RValIso locRel finalValue rewrittenValue ∧ + Eval.runMachine rewrittenContext interpretation rewrittenCount + rewrittenStart = + .ok + { store := rewrittenStore + value := rewrittenValue + controlRemaining := 0 + heapRemaining := rewrittenHeapFuel } := by + apply stableLiveRunMachineOfMacroInvariant + (AttachedStableState optimized) (fun state => state.related) ?_ initial + baselineSteps + intro baseline rewritten baselineNext frame stack state running stepped + exact state.advanceInvariant running fun compiler related acceptedEntry => + advance compiler related acceptedEntry running stepped + +/-- Exact `runMachine` corollary for the execution-guided concrete +compiler/reuse invariant. -/ +theorem attachedStableRunMachineGuided + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + (advance : ∀ {baseline rewritten baselineNext baselineFinal : Machine} + {frame : Frame} {stack : List Continuation} {suffixCount : Nat} + {finalStore : Store} {finalHeapFuel : Nat} {finalValue : RVal}, + CompilerRunningState attached baseline → + StableLiveMachineRel Validate.defaultLimits + attached.target.artifact.validationContext baseline rewritten → + StableLiveAcceptedEntry Validate.defaultLimits + attached.target.artifact.validationContext baseline rewritten → + baseline.control = .running frame stack → + Step baselineContext interpretation baseline baselineNext → + Steps baselineContext interpretation suffixCount baselineNext + baselineFinal → + baselineFinal = + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue } → + AttachedStableMacroStep optimized baselineContext rewrittenContext + interpretation baseline rewritten) + {baselineCount : Nat} {baselineStart rewrittenStart : Machine} + {finalStore : Store} {finalHeapFuel : Nat} {finalValue : RVal} + (initial : AttachedStableState optimized baselineStart rewrittenStart) + (baselineSteps : Steps baselineContext interpretation baselineCount + baselineStart + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue }) : + ∃ rewrittenCount rewrittenStore rewrittenHeapFuel rewrittenValue locRel, + let rewrittenFinal : Machine := + { store := rewrittenStore + heapFuel := rewrittenHeapFuel + control := .halted rewrittenValue } + Steps rewrittenContext interpretation rewrittenCount rewrittenStart + rewrittenFinal ∧ + AttachedStableState optimized + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue } + rewrittenFinal ∧ + ReuseSim.StableHeapRel finalStore rewrittenStore locRel ∧ + finalHeapFuel ≤ rewrittenHeapFuel ∧ + IxIR1.Sim.RValIso locRel finalValue rewrittenValue ∧ + Eval.runMachine rewrittenContext interpretation rewrittenCount + rewrittenStart = + .ok + { store := rewrittenStore + value := rewrittenValue + controlRemaining := 0 + heapRemaining := rewrittenHeapFuel } := by + apply stableLiveRunMachineOfGuidedMacroInvariant + (AttachedStableState optimized) (fun state => state.related) ?_ initial + baselineSteps + intro baseline rewritten baselineNext baselineFinal frame stack suffixCount + finalStore finalHeapFuel finalValue state running stepped suffix halted + exact state.advanceInvariant running fun compiler related acceptedEntry => + advance compiler related acceptedEntry running stepped suffix halted + +/-- Whole physical finite execution from the compiler/reuse invariant. +Compiler progress and accepted-site macros are reconstructed internally from +the concrete baseline execution through its halted endpoint. -/ +theorem attachedPhysicalStableFiniteExecution + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {baselineCount : Nat} {baselineStart rewrittenStart baselineFinal : + Machine} + {finalStore : Store} {finalHeapFuel : Nat} {finalValue : RVal} + (initial : AttachedStableState optimized baselineStart rewrittenStart) + (baselineSteps : Steps + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + .physical baselineCount baselineStart baselineFinal) + (halted : baselineFinal = + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue }) : + ∃ rewrittenCount rewrittenFinal, + Steps + (Eval.Context.ofProgram optimized.output.trace.target + attached.target.artifact.validationContext.schemas oracle) + .physical rewrittenCount rewrittenStart rewrittenFinal ∧ + AttachedStableState optimized baselineFinal rewrittenFinal ∧ + StableLiveMachineRel Validate.defaultLimits + attached.target.artifact.validationContext baselineFinal + rewrittenFinal := by + apply attachedStableFiniteExecutionGuided optimized ?_ initial baselineSteps + halted + intro baseline rewritten baselineNext baselineFinal frame stack suffixCount + finalStore finalHeapFuel finalValue compiler relation acceptedEntry running + stepped suffix halted + exact attachedPhysicalStableMacroStepGuided optimized compiler relation + acceptedEntry running stepped suffix halted + +/-- Exact rewritten `runMachine` result for a successful physical baseline +execution. The initial compiler/reuse invariant supplies all progress; callers +need no operation, return, or accepted-site callbacks. -/ +theorem attachedPhysicalStableRunMachine + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {baselineCount : Nat} {baselineStart rewrittenStart : Machine} + {finalStore : Store} {finalHeapFuel : Nat} {finalValue : RVal} + (initial : AttachedStableState optimized baselineStart rewrittenStart) + (baselineSteps : Steps + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + .physical baselineCount baselineStart + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue }) : + ∃ rewrittenCount rewrittenStore rewrittenHeapFuel rewrittenValue locRel, + let rewrittenFinal : Machine := + { store := rewrittenStore + heapFuel := rewrittenHeapFuel + control := .halted rewrittenValue } + Steps + (Eval.Context.ofProgram optimized.output.trace.target + attached.target.artifact.validationContext.schemas oracle) + .physical rewrittenCount rewrittenStart rewrittenFinal ∧ + AttachedStableState optimized + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue } + rewrittenFinal ∧ + ReuseSim.StableHeapRel finalStore rewrittenStore locRel ∧ + finalHeapFuel ≤ rewrittenHeapFuel ∧ + IxIR1.Sim.RValIso locRel finalValue rewrittenValue ∧ + Eval.runMachine + (Eval.Context.ofProgram optimized.output.trace.target + attached.target.artifact.validationContext.schemas oracle) + .physical rewrittenCount rewrittenStart = + .ok + { store := rewrittenStore + value := rewrittenValue + controlRemaining := 0 + heapRemaining := rewrittenHeapFuel } := by + apply attachedStableRunMachineGuided optimized ?_ initial baselineSteps + intro baseline rewritten baselineNext baselineFinal frame stack suffixCount + finalStore finalHeapFuel finalValue compiler relation acceptedEntry running + stepped suffix halted + exact attachedPhysicalStableMacroStepGuided optimized compiler relation + acceptedEntry running stepped suffix halted + + +namespace OptimizedAttachment + +def baselineInitialMachine + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} (_optimized : OptimizedAttachment attached) + (heapFuel : Nat) : Machine := + Lower.Sim.initialMainMachine attached.target.artifact heapFuel + +def rewrittenInitialMachine + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} (optimized : OptimizedAttachment attached) + (heapFuel : Nat) : Machine := + Eval.initialMachine optimized.output.trace.target.main #[] heapFuel + +/-- The concrete compiler/reuse relation holds at the two exact initial main +machines. -/ +theorem initial + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} (optimized : OptimizedAttachment attached) + {baselineFuel rewrittenFuel : Nat} + (fuel : baselineFuel ≤ rewrittenFuel) : + AttachedStableState optimized + (optimized.baselineInitialMachine baselineFuel) + (optimized.rewrittenInitialMachine rewrittenFuel) := by + refine ⟨CompilerState.running + (CompilerRunningState.initial attached baselineFuel), ?_, ?_, rfl, .refl _⟩ + · apply StableLiveMachineRel.history IxIR1.Sim.HeapHistoryIso.empty fuel + exact .running + (.rewritten optimized.output.trace.main + (StableLiveFrameIso.entry optimized.output.trace.main + IxIR1.Sim.RValsIso.nil)) + .nil + · apply StableLiveAcceptedEntry.ofPcZero + (frame := Lower.Sim.initialMainFrame attached.target.artifact) + (stack := []) + · rfl + · rfl + +/-- The exact validated reuse output preserves every successful physical +baseline main run. Both programs start with the same heap budget; the rewritten +run returns a related heap and value with at least as much heap fuel remaining. +Independent counter invariants preserve allocation events and compare RC work +and all recorded live-node peaks. -/ +theorem physicalMainSimulationWithCosts + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {controlFuel heapFuel : Nat} {baselineResult : Eval.Result} + (baselineRun : Eval.runMain + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + .physical attached.target.artifact.program controlFuel heapFuel = + .ok baselineResult) : + ∃ rewrittenControlFuel rewrittenResult locRel, + Eval.runMain + (Eval.Context.ofProgram optimized.output.target + attached.target.artifact.validationContext.schemas oracle) + .physical optimized.output.target rewrittenControlFuel heapFuel = + .ok rewrittenResult ∧ + StableHeapRel baselineResult.store rewrittenResult.store locRel ∧ + IxIR1.Sim.RValIso locRel baselineResult.value rewrittenResult.value ∧ + baselineResult.heapRemaining ≤ rewrittenResult.heapRemaining ∧ + rewrittenResult.controlRemaining = 0 ∧ + baselineResult.store.allocationEvents = rewrittenResult.store.allocationEvents ∧ + baselineResult.CostBounds rewrittenResult := by + have baselineMachineRun : Eval.runMachine + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + .physical controlFuel (optimized.baselineInitialMachine heapFuel) = + .ok baselineResult := by + rwa [Lower.Sim.runMain_eq_initialMainMachine] at baselineRun + obtain ⟨baselineCount, _controlBudget, baselineSteps⟩ := + Eval.runMachine_steps baselineMachineRun + obtain ⟨rewrittenCount, rewrittenStore, rewrittenHeapFuel, rewrittenValue, + locRel, _rewrittenSteps, finalInvariant, heap, fuel, value, rewrittenRun⟩ := + attachedPhysicalStableRunMachine optimized (optimized.initial (Nat.le_refl heapFuel)) + baselineSteps + let rewrittenResult : Eval.Result := + { store := rewrittenStore + value := rewrittenValue + controlRemaining := 0 + heapRemaining := rewrittenHeapFuel } + refine ⟨rewrittenCount, rewrittenResult, locRel, ?_, heap, value, fuel, rfl, + finalInvariant.allocations, finalInvariant.costs⟩ + rw [← optimized.output.trace_target] + have mainArity : optimized.output.trace.target.main.signature.params.size = 0 := by + rw [optimized.output.trace.target_main_signature] + exact attached.target.artifact.mainArity + have mainNonempty : optimized.output.trace.target.main.blocks.isEmpty = false := + optimized.output.trace.main.definition_blocks_nonempty attached.target.artifact.mainNonempty + rw [Eval.runMain_eq_runMachine mainArity mainNonempty] + exact rewrittenRun + +/-- Compatibility projection retaining R3's allocation-event endpoint. -/ +theorem physicalMainSimulationWithAllocationEvents + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {controlFuel heapFuel : Nat} {baselineResult : Eval.Result} + (baselineRun : Eval.runMain + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + .physical attached.target.artifact.program controlFuel heapFuel = .ok baselineResult) : + ∃ rewrittenControlFuel rewrittenResult locRel, + Eval.runMain + (Eval.Context.ofProgram optimized.output.target + attached.target.artifact.validationContext.schemas oracle) + .physical optimized.output.target rewrittenControlFuel heapFuel = .ok rewrittenResult ∧ + StableHeapRel baselineResult.store rewrittenResult.store locRel ∧ + IxIR1.Sim.RValIso locRel baselineResult.value rewrittenResult.value ∧ + baselineResult.heapRemaining ≤ rewrittenResult.heapRemaining ∧ + rewrittenResult.controlRemaining = 0 ∧ + baselineResult.store.allocationEvents = rewrittenResult.store.allocationEvents := by + obtain ⟨count, result, locRel, run, heap, value, fuel, control, events, _costs⟩ := + optimized.physicalMainSimulationWithCosts baselineRun + exact ⟨count, result, locRel, run, heap, value, fuel, control, events⟩ + +/-- Compatibility projection retaining the original semantic endpoint. -/ +theorem physicalMainSimulation + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (optimized : OptimizedAttachment attached) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {controlFuel heapFuel : Nat} {baselineResult : Eval.Result} + (baselineRun : Eval.runMain + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + .physical attached.target.artifact.program controlFuel heapFuel = .ok baselineResult) : + ∃ rewrittenControlFuel rewrittenResult locRel, + Eval.runMain + (Eval.Context.ofProgram optimized.output.target + attached.target.artifact.validationContext.schemas oracle) + .physical optimized.output.target rewrittenControlFuel heapFuel = .ok rewrittenResult ∧ + StableHeapRel baselineResult.store rewrittenResult.store locRel ∧ + IxIR1.Sim.RValIso locRel baselineResult.value rewrittenResult.value ∧ + baselineResult.heapRemaining ≤ rewrittenResult.heapRemaining ∧ + rewrittenResult.controlRemaining = 0 := by + obtain ⟨count, result, locRel, run, heap, value, fuel, control, _events⟩ := + optimized.physicalMainSimulationWithAllocationEvents baselineRun + exact ⟨count, result, locRel, run, heap, value, fuel, control⟩ + + +end OptimizedAttachment + +/-- RC and peak bounds hold on both actual selection branches, together with +R3's allocation events and the unchanged semantic heap and value relations. -/ +theorem selectedPhysicalMainSimulationWithCosts + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (selection : Reuse.Selection Validate.defaultLimits + attached.target.artifact.validationContext attached.target.artifact.program) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {controlFuel heapFuel : Nat} {baselineResult : Eval.Result} + (baselineRun : Eval.runMain + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + .physical attached.target.artifact.program controlFuel heapFuel = .ok baselineResult) : + ∃ selectedControlFuel selectedResult locRel, + Eval.runMain + (Eval.Context.ofProgram selection.target + attached.target.artifact.validationContext.schemas oracle) + .physical selection.target selectedControlFuel heapFuel = .ok selectedResult ∧ + StableHeapRel baselineResult.store selectedResult.store locRel ∧ + IxIR1.Sim.RValIso locRel baselineResult.value selectedResult.value ∧ + baselineResult.heapRemaining ≤ selectedResult.heapRemaining ∧ + baselineResult.store.allocationEvents = selectedResult.store.allocationEvents ∧ + baselineResult.CostBounds selectedResult := by + cases selection with + | optimized output produced => + let optimized : OptimizedAttachment attached := { output, produced } + obtain ⟨count, result, locRel, run, heap, value, fuel, _control, events, costs⟩ := + optimized.physicalMainSimulationWithCosts baselineRun + exact ⟨count, result, locRel, run, heap, value, fuel, events, costs⟩ + | baseline _error _rejected => + exact ⟨controlFuel, baselineResult, (fun left right => left = right), + baselineRun, .contents (HeapContentsEq.refl baselineResult.store), + IxIR1.Sim.RValIso.refl baselineResult.value, Nat.le_refl _, rfl, .refl _⟩ + +/-- Both selection branches preserve allocation-event totals along the actual +physical execution. The checked baseline branch uses the identical run. -/ +theorem selectedPhysicalMainSimulationWithAllocationEvents + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (selection : Reuse.Selection Validate.defaultLimits + attached.target.artifact.validationContext attached.target.artifact.program) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {controlFuel heapFuel : Nat} {baselineResult : Eval.Result} + (baselineRun : Eval.runMain + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + .physical attached.target.artifact.program controlFuel heapFuel = .ok baselineResult) : + ∃ selectedControlFuel selectedResult locRel, + Eval.runMain + (Eval.Context.ofProgram selection.target + attached.target.artifact.validationContext.schemas oracle) + .physical selection.target selectedControlFuel heapFuel = .ok selectedResult ∧ + StableHeapRel baselineResult.store selectedResult.store locRel ∧ + IxIR1.Sim.RValIso locRel baselineResult.value selectedResult.value ∧ + baselineResult.heapRemaining ≤ selectedResult.heapRemaining ∧ + baselineResult.store.allocationEvents = selectedResult.store.allocationEvents := by + cases selection with + | optimized output produced => + let optimized : OptimizedAttachment attached := { output, produced } + obtain ⟨count, result, locRel, run, heap, value, fuel, _control, events⟩ := + optimized.physicalMainSimulationWithAllocationEvents baselineRun + exact ⟨count, result, locRel, run, heap, value, fuel, events⟩ + | baseline _error _rejected => + exact ⟨controlFuel, baselineResult, (fun left right => left = right), + baselineRun, .contents (HeapContentsEq.refl baselineResult.store), + IxIR1.Sim.RValIso.refl baselineResult.value, Nat.le_refl _, rfl⟩ + +/-- Production selection preserves a successful physical baseline main run +whether reuse succeeds or falls back. `selectAttachment` supplies this +selection directly from the checked compiler artifact. -/ +theorem selectedPhysicalMainSimulation + {mainWorld : Ixon.Owned} {lowerFuel : Nat} + {attached : Pipeline.CompiledAttachment mainWorld lowerFuel} + (selection : Reuse.Selection Validate.defaultLimits + attached.target.artifact.validationContext attached.target.artifact.program) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {controlFuel heapFuel : Nat} {baselineResult : Eval.Result} + (baselineRun : Eval.runMain + (Eval.Context.ofProgram attached.target.artifact.program + attached.target.artifact.validationContext.schemas oracle) + .physical attached.target.artifact.program controlFuel heapFuel = + .ok baselineResult) : + ∃ selectedControlFuel selectedResult locRel, + Eval.runMain + (Eval.Context.ofProgram selection.target + attached.target.artifact.validationContext.schemas oracle) + .physical selection.target selectedControlFuel heapFuel = + .ok selectedResult ∧ + StableHeapRel baselineResult.store selectedResult.store locRel ∧ + IxIR1.Sim.RValIso locRel baselineResult.value selectedResult.value ∧ + baselineResult.heapRemaining ≤ selectedResult.heapRemaining := by + cases selection with + | optimized output produced => + let optimized : OptimizedAttachment attached := { output, produced } + obtain ⟨count, result, locRel, run, heap, value, fuel, _control⟩ := + optimized.physicalMainSimulation baselineRun + exact ⟨count, result, locRel, run, heap, value, fuel⟩ + | baseline _error _rejected => + exact ⟨controlFuel, baselineResult, (fun left right => left = right), + baselineRun, .contents (HeapContentsEq.refl baselineResult.store), + IxIR1.Sim.RValIso.refl baselineResult.value, Nat.le_refl _⟩ + + +end Ix.Compiler.IxIR2.ReuseLiveSim diff --git a/Ix/Compiler/IxIR2/ReuseResources.lean b/Ix/Compiler/IxIR2/ReuseResources.lean new file mode 100644 index 000000000..35136a0ec --- /dev/null +++ b/Ix/Compiler/IxIR2/ReuseResources.lean @@ -0,0 +1,40 @@ +import Ix.Compiler.IxIR2.Resources +import Ix.Compiler.IxIR2.ReuseSim + +/-! Shared-result reclamation transported through the existing semantic heap +relation. Allocation accounting is proved separately from actual physical +execution; it is not added to `StableHeapRel`. -/ + +namespace Ix.Compiler.IxIR2.ReuseSim + +open Eval + +/-- Releasing related roots at the same traversal budget preserves successful +reclamation across exact contents and allocation-history isomorphisms. -/ +theorem StableHeapRel.sharedReclamation {baseline rewritten released : Store} + {locRel : Nat → Nat → Prop} {baselineValue rewrittenValue : RVal} + (heaps : StableHeapRel baseline rewritten locRel) + (values : IxIR1.Sim.RValIso locRel baselineValue rewrittenValue) + {fuel remaining : Nat} + (release : releaseShared fuel baseline baselineValue = .ok (released, remaining)) + (empty : released.live = 0) : + ∃ output, + releaseShared fuel rewritten rewrittenValue = .ok (output, remaining) ∧ + output.live = 0 := by + cases heaps with + | contents same => + have equal : baselineValue = rewrittenValue := by + cases values with + | loc related => exact congrArg IxIR1.RVal.loc related + | lit => rfl + | erased => rfl + subst rewrittenValue + obtain ⟨output, run, outputHeaps⟩ := same.releaseShared release + refine ⟨output, run, ?_⟩ + simpa only [Store.live_eq_countP, ← outputHeaps.nodes] using empty + | isomorphic iso => + obtain ⟨output, outputHeap, run, relation⟩ := + releaseSharedWork_historyIso_sameFuel iso.symm (.cons values .nil) release + exact ⟨output, run, outputHeap.right_live_eq_zero empty⟩ + +end Ix.Compiler.IxIR2.ReuseSim diff --git a/Ix/Compiler/IxIR2/ReuseSim.lean b/Ix/Compiler/IxIR2/ReuseSim.lean new file mode 100644 index 000000000..845ee1ba8 --- /dev/null +++ b/Ix/Compiler/IxIR2/ReuseSim.lean @@ -0,0 +1,19042 @@ +import Ix.Compiler.IxIR1.EvalIso +import Ix.Compiler.IxIR2.Reuse + +/-! +# Semantic seam for dynamic shared reuse + +This module connects the concrete IxIR₂ hot-reset stores to the exact +ownership and live-heap isomorphism developed for IxIR₁ heaps. The local +theorem is deliberately independent of a particular CFG: physical +reservation/reuse is related to logical shallow-free/fresh-allocation for an +arbitrary shared constructor replacement and arbitrary surrounding roots. +-/ + +namespace Ix.Compiler.IxIR2.ReuseSim + +open Ix.Compiler.Ixon (Owned) +open Ix.Compiler.IxIR2 +open Ix.Compiler.IxIR2.Eval +open Ix.Compiler.IxIR2.Reuse + (Shape translateRegister? translateAtom? translateAtoms? branchValues) + +/-! ## Operand-translation semantics -/ + +/-- Runtime value files agree at every register mapping accepted by the reuse +planner. Registers deliberately rejected by `translateRegister?` need no +target counterpart. -/ +def ValuesRel (shape : Shape) (source target : Array RVal) : Prop := + ∀ sourceId targetId, + translateRegister? shape sourceId = some targetId → + source[sourceId]? = target[targetId]? + +/-- Every successful register translation is either the distinguished +allocation-result mapping at both file ends, or lies strictly before both +ends. -/ +theorem translateRegister?_range {shape : Shape} {sourceId targetId : Nat} + (sourceBound : shape.source < shape.parameterCount) + (translated : translateRegister? shape sourceId = some targetId) : + (sourceId = shape.parameterCount + 2 * shape.fieldCount ∧ + targetId = shape.fieldCount + (shape.parameterCount - 1)) ∨ + (sourceId < shape.parameterCount + 2 * shape.fieldCount ∧ + targetId < shape.fieldCount + (shape.parameterCount - 1)) := by + have parameterPositive : 0 < shape.parameterCount := + Nat.lt_of_le_of_lt (Nat.zero_le shape.source) sourceBound + unfold translateRegister? at translated + split at translated + · have sourceParameter : sourceId < shape.parameterCount := by assumption + split at translated + · cases translated + · split at translated + · simp only [Option.some.injEq] at translated + subst targetId + have beforeSource : sourceId < shape.source := by assumption + have targetBound : sourceId < shape.parameterCount - 1 := + Nat.lt_of_lt_of_le beforeSource + (Nat.le_sub_one_of_lt sourceBound) + right + constructor + · omega + · exact Nat.add_lt_add_left targetBound shape.fieldCount + · simp only [Option.some.injEq] at translated + subst targetId + have notBefore : ¬sourceId < shape.source := by assumption + have notSourceBool : ¬(sourceId == shape.source) = true := by + assumption + have sourceNe : sourceId ≠ shape.source := by + intro same + subst sourceId + exact notSourceBool (by simp) + have sourceLt : shape.source < sourceId := + Nat.lt_of_le_of_ne (Nat.le_of_not_gt notBefore) sourceNe.symm + have oneLe : 1 ≤ sourceId := + Nat.succ_le_iff.mpr + (Nat.lt_of_le_of_lt (Nat.zero_le shape.source) sourceLt) + have targetBound : sourceId - 1 < shape.parameterCount - 1 := + Nat.sub_lt_sub_right oneLe sourceParameter + right + constructor + · omega + · exact Nat.add_lt_add_left targetBound shape.fieldCount + · split at translated + · cases translated + · split at translated + · have retainedEnd : + sourceId < shape.parameterCount + 2 * shape.fieldCount := by + assumption + have retainedStart : + ¬sourceId < shape.parameterCount + shape.fieldCount := by + assumption + simp only [Option.some.injEq] at translated + subst targetId + right + constructor + · exact retainedEnd + · have start : shape.parameterCount + shape.fieldCount ≤ sourceId := + Nat.le_of_not_gt retainedStart + have fieldIndex : sourceId - + (shape.parameterCount + shape.fieldCount) < + shape.fieldCount := by + apply (Nat.sub_lt_iff_lt_add start).2 + rw [Nat.two_mul] at retainedEnd + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using + retainedEnd + exact Nat.lt_of_lt_of_le fieldIndex + (Nat.le_add_right shape.fieldCount (shape.parameterCount - 1)) + · split at translated + · have sourceEq : sourceId = + shape.parameterCount + 2 * shape.fieldCount := + beq_iff_eq.mp (by assumption) + simp only [Option.some.injEq] at translated + subst targetId + exact Or.inl ⟨sourceEq, rfl⟩ + · cases translated + +/-- Appending the same freshly allocated value to both register files extends +the relation across the planner's distinguished result-register mapping. -/ +theorem ValuesRel.pushResult {shape : Shape} {source target : Array RVal} + {result : RVal} (related : ValuesRel shape source target) + (sourceSize : source.size = + shape.parameterCount + 2 * shape.fieldCount) + (targetSize : target.size = + shape.fieldCount + (shape.parameterCount - 1)) + (sourceBound : shape.source < shape.parameterCount) : + ValuesRel shape (source.push result) (target.push result) := by + intro sourceId targetId translated + rcases translateRegister?_range sourceBound translated with + ⟨sourceEnd, targetEnd⟩ | ⟨sourceBefore, targetBefore⟩ + · subst sourceId + subst targetId + rw [← sourceSize, ← targetSize] + simp + · have sourceNe : sourceId ≠ source.size := by + rw [sourceSize] + exact Nat.ne_of_lt sourceBefore + have targetNe : targetId ≠ target.size := by + rw [targetSize] + exact Nat.ne_of_lt targetBefore + simpa [Array.getElem?_push, sourceNe, targetNe] using + related sourceId targetId translated + +/-- Runtime register file after the recognized baseline fetch/retain prefix. -/ +def baselinePrefixValues (parameters fields : Array RVal) : Array RVal := + parameters ++ fields ++ fields + +/-- Runtime register file entering either generated credit helper: reset fields +first, followed by the original parameters with the consumed source removed. -/ +def helperEntryValues (source : ValueId) (parameters fields : Array RVal) : + Array RVal := + fields ++ (parameters.toList.eraseIdx source).toArray + +/-- The planner's register translation exactly relates the concrete baseline +prefix file to the concrete helper-entry file. This includes the not-yet- +allocated result register: both sides are out of bounds at its mapped index. -/ +theorem valuesRel_helperEntry {shape : Shape} + {parameters fields : Array RVal} + (parameterCount : parameters.size = shape.parameterCount) + (fieldCount : fields.size = shape.fieldCount) + (sourceBound : shape.source < shape.parameterCount) : + ValuesRel shape (baselinePrefixValues parameters fields) + (helperEntryValues shape.source parameters fields) := by + intro sourceId targetId translated + unfold translateRegister? at translated + split at translated + · have sourceParameter : sourceId < shape.parameterCount := by assumption + split at translated + · cases translated + · have notSourceBool : ¬(sourceId == shape.source) = true := by assumption + split at translated + · have beforeSource : sourceId < shape.source := by assumption + simp only [Option.some.injEq] at translated + subst targetId + simp [baselinePrefixValues, helperEntryValues, + Array.getElem?_append, parameterCount, fieldCount, + List.getElem?_eraseIdx, sourceParameter, beforeSource] + · have notBeforeSource : ¬sourceId < shape.source := by assumption + have sourceNe : sourceId ≠ shape.source := by + intro same + subst sourceId + exact notSourceBool (by simp) + have sourceLt : shape.source < sourceId := + Nat.lt_of_le_of_ne (Nat.le_of_not_gt notBeforeSource) sourceNe.symm + simp only [Option.some.injEq] at translated + subst targetId + have eraseSide : ¬sourceId - 1 < shape.source := by + rw [← Nat.pred_eq_sub_one] + exact Nat.not_lt_of_ge (Nat.le_pred_of_lt sourceLt) + have oneLe : 1 ≤ sourceId := + Nat.succ_le_iff.mpr + (Nat.lt_of_le_of_lt (Nat.zero_le shape.source) sourceLt) + have indexEq : sourceId - 1 + 1 = sourceId := + Nat.sub_add_cancel oneLe + simp [baselinePrefixValues, helperEntryValues, + Array.getElem?_append, parameterCount, fieldCount, + List.getElem?_eraseIdx, sourceParameter, eraseSide, indexEq] + · have afterParameters : ¬sourceId < shape.parameterCount := by assumption + split at translated + · cases translated + · have afterFetched : + ¬sourceId < shape.parameterCount + shape.fieldCount := by + assumption + split at translated + · have beforeRetainedEnd : + sourceId < shape.parameterCount + 2 * shape.fieldCount := by + assumption + simp only [Option.some.injEq] at translated + subst targetId + have retainedStart : + shape.parameterCount + shape.fieldCount ≤ sourceId := + Nat.le_of_not_gt afterFetched + have fieldIndexShape : + sourceId - (shape.parameterCount + shape.fieldCount) < + shape.fieldCount := by + apply (Nat.sub_lt_iff_lt_add retainedStart).2 + rw [Nat.two_mul] at beforeRetainedEnd + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using + beforeRetainedEnd + have sourceMiddle : + ¬sourceId - shape.parameterCount < shape.fieldCount := by + intro middle + have parameterLe : shape.parameterCount ≤ sourceId := + Nat.le_trans (Nat.le_add_right _ _) retainedStart + have upper := (Nat.sub_lt_iff_lt_add parameterLe).1 middle + omega + have indexEq : + sourceId - shape.parameterCount - shape.fieldCount = + sourceId - (shape.parameterCount + shape.fieldCount) := + (Nat.sub_add_eq sourceId shape.parameterCount + shape.fieldCount).symm + simp [baselinePrefixValues, helperEntryValues, + Array.getElem?_append, parameterCount, fieldCount, + afterParameters, sourceMiddle, fieldIndexShape, indexEq] + · split at translated + · have sourceEq : sourceId = + shape.parameterCount + 2 * shape.fieldCount := + beq_iff_eq.mp (by assumption) + simp only [Option.some.injEq] at translated + subst targetId + subst sourceId + have sourceNone : + (baselinePrefixValues parameters fields)[ + shape.parameterCount + 2 * shape.fieldCount]? = none := by + apply Array.getElem?_eq_none_iff.mpr + simp [baselinePrefixValues, parameterCount, fieldCount, + Nat.two_mul] + have targetNone : + (helperEntryValues shape.source parameters fields)[ + shape.fieldCount + (shape.parameterCount - 1)]? = none := by + apply Array.getElem?_eq_none_iff.mpr + simp [helperEntryValues, List.length_eraseIdx, parameterCount, + fieldCount, sourceBound] + rw [sourceNone, targetNone] + · cases translated + +/-- After both allocation instructions append the same result value, the +canonical baseline/helper register files remain related for tail operands. -/ +theorem valuesRel_afterAllocation {shape : Shape} + {parameters fields : Array RVal} {result : RVal} + (parameterCount : parameters.size = shape.parameterCount) + (fieldCount : fields.size = shape.fieldCount) + (sourceBound : shape.source < shape.parameterCount) : + ValuesRel shape + ((baselinePrefixValues parameters fields).push result) + ((helperEntryValues shape.source parameters fields).push result) := by + apply ValuesRel.pushResult + (valuesRel_helperEntry parameterCount fieldCount sourceBound) + · simp [baselinePrefixValues, parameterCount, fieldCount, Nat.two_mul] + · simp [helperEntryValues, List.length_eraseIdx, parameterCount, + fieldCount, sourceBound] + · exact sourceBound + +/-- The concrete helper-entry value vector has exactly the ABI length emitted +for either helper block. -/ +theorem helperEntryValues_size {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (site : Reuse.Site limits context block) + {parameters fields : Array RVal} + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) : + (helperEntryValues site.shape.source parameters fields).size = + site.candidate.helperValueParams.size := by + rw [site.candidateVectors.1] + simp [helperEntryValues, List.length_eraseIdx, parameterCount, fieldCount, + site.fits.parameterCount] + +private theorem eraseIdx_map {α β : Type} (f : α → β) : + ∀ (values : List α) (index : Nat), + (values.map f).eraseIdx index = (values.eraseIdx index).map f := by + intro values + induction values with + | nil => intro index; cases index <;> rfl + | cons value values ih => + intro index + cases index with + | zero => rfl + | succ index => + simp only [List.map_cons, List.eraseIdx_cons_succ] + rw [ih] + +private theorem filter_range_ne_eq_eraseIdx (count source : Nat) + (bound : source < count) : + (List.range count).filter (fun value => value != source) = + (List.range count).eraseIdx source := by + induction count generalizing source with + | zero => omega + | succ count ih => + cases source with + | zero => + rw [show count + 1 = Nat.succ count by omega, + List.range_succ_eq_map] + simp only [List.filter_cons, List.filter_map, List.eraseIdx_zero, + List.tail_cons] + have keepAll : + List.filter ((fun value => value != 0) ∘ Nat.succ) + (List.range count) = List.range count := by + apply List.filter_eq_self.mpr + intro value member + simp [Function.comp_apply] + rw [keepAll] + simp + | succ source => + have tailBound : source < count := by omega + rw [show count + 1 = Nat.succ count by omega, + List.range_succ_eq_map] + simp only [List.filter_cons, bne_iff_ne, ne_eq, + Nat.zero_ne_add_one, not_false_eq_true, ↓reduceIte, + List.filter_map, List.eraseIdx_cons_succ] + rw [eraseIdx_map] + have predicate : + ((fun value => value != source + 1) ∘ Nat.succ) = + (fun value => value != source) := by + funext value + simp [Function.comp_apply] + rw [predicate] + rw [ih source tailBound] + +private theorem mapM_eq_ok_of_getElem {ε α β : Type} + (f : α → Except ε β) : + ∀ (input : List α) (output : List β), + input.length = output.length → + (∀ (index : Nat) (source : α) (target : β), + input[index]? = some source → + output[index]? = some target → + f source = .ok target) → + input.mapM f = .ok output := by + intro input + induction input with + | nil => + intro output lengths pointwise + cases output with + | nil => rfl + | cons target output => simp at lengths + | cons source input ih => + intro output lengths pointwise + cases output with + | nil => simp at lengths + | cons target output => + have head := pointwise 0 source target (by rfl) (by rfl) + have tailPointwise : ∀ (index : Nat) (tailSource : α) + (tailTarget : β), + input[index]? = some tailSource → + output[index]? = some tailTarget → + f tailSource = .ok tailTarget := by + intro index tailSource tailTarget sourceAt targetAt + exact pointwise (index + 1) tailSource tailTarget + (by simpa using sourceAt) (by simpa using targetAt) + simp only [List.length_cons] at lengths + simp [List.mapM_cons, head, ih output (Nat.succ.inj lengths) + tailPointwise] + rfl + +private theorem resolveFold_of_mapM {values : Array RVal} : + ∀ {atoms : List Atom} {output : List RVal}, + atoms.mapM (resolveAtom values) = .ok output → + ∀ initial : Array RVal, + atoms.foldlM (fun current atom => do + return current.push (← resolveAtom values atom)) initial = + .ok (initial ++ output.toArray) := by + intro atoms + induction atoms with + | nil => + intro output resolved initial + change Except.ok [] = Except.ok output at resolved + injection resolved with outputEq + subst output + simp [List.foldlM_nil, pure, Except.pure] + | cons atom atoms ih => + intro output resolved initial + cases headAt : resolveAtom values atom with + | error error => + simp [List.mapM_cons, headAt, bind, Except.bind] at resolved + | ok value => + cases tailAt : atoms.mapM (resolveAtom values) with + | error error => + simp [List.mapM_cons, headAt, tailAt, bind, Except.bind] at resolved + | ok tail => + simp [List.mapM_cons, headAt, tailAt, bind, Except.bind, + pure, Except.pure] at resolved + subst output + rw [List.foldlM_cons] + simp only [headAt, bind, Except.bind, pure, Except.pure] + change atoms.foldlM (fun current atom => do + return current.push (← resolveAtom values atom)) + (initial.push value) = + .ok (initial ++ (value :: tail).toArray) + rw [ih tailAt] + congr 1 + apply Array.ext' + simp + +private theorem resolveAtoms_of_mapM {values : Array RVal} + {atoms : Array Atom} {output : List RVal} + (resolved : atoms.toList.mapM (resolveAtom values) = .ok output) : + resolveAtoms values atoms = .ok output.toArray := by + unfold resolveAtoms + rw [← Array.foldlM_toList] + simpa using resolveFold_of_mapM resolved #[] + +private theorem resolveAtom_reg_of_getElem {values : Array RVal} + {index : Nat} {value : RVal} + (found : values[index]? = some value) : + resolveAtom values (.reg index) = .ok value := by + simp [resolveAtom, found] + +/-- The generated branch operand vector resolves to exactly the canonical +helper-entry register file. This is the runtime half of the reset-to-helper +CFG transfer and holds for any constructor arity and source parameter slot. -/ +theorem branchValues_resolve {shape : Shape} + {parameters fields : Array RVal} + (parameterCount : parameters.size = shape.parameterCount) + (fieldCount : fields.size = shape.fieldCount) + (sourceBound : shape.source < shape.parameterCount) : + resolveAtoms (parameters ++ fields) (branchValues shape) = + .ok (helperEntryValues shape.source parameters fields) := by + let fieldAtoms : List Atom := + (List.range shape.fieldCount).map fun field => + .reg (shape.parameterCount + field) + let parameterAtoms : List Atom := + ((List.range shape.parameterCount).filter fun value => + value != shape.source).map fun value => .reg value + have fieldsMapped : + fieldAtoms.mapM (resolveAtom (parameters ++ fields)) = + .ok fields.toList := by + apply mapM_eq_ok_of_getElem + · simp [fieldAtoms, fieldCount] + · intro index atom value atomAt valueAt + have indexBound : index < shape.fieldCount := by + have := (List.getElem?_eq_some_iff.mp atomAt).choose + simpa [fieldAtoms] using this + simp only [fieldAtoms, List.getElem?_map, + List.getElem?_range indexBound, Option.map_some, + Option.some.injEq] at atomAt + subst atom + have fieldAt : fields[index]? = some value := by + simpa only [Array.getElem?_toList] using valueAt + have afterParameters : + ¬shape.parameterCount + index < parameters.size := by + rw [parameterCount] + omega + have indexEq : shape.parameterCount + index - parameters.size = + index := by + rw [parameterCount] + omega + apply resolveAtom_reg_of_getElem + rw [Array.getElem?_append, if_neg afterParameters, indexEq] + exact fieldAt + have parametersMapped : + parameterAtoms.mapM (resolveAtom (parameters ++ fields)) = + .ok (parameters.toList.eraseIdx shape.source) := by + unfold parameterAtoms + rw [filter_range_ne_eq_eraseIdx _ _ sourceBound] + apply mapM_eq_ok_of_getElem + · simp [List.length_eraseIdx, sourceBound, parameterCount] + · intro index atom value atomAt valueAt + have erasedBound : + index < (parameters.toList.eraseIdx shape.source).length := + (List.getElem?_eq_some_iff.mp valueAt).choose + rw [List.getElem?_map, List.getElem?_eraseIdx] at atomAt + rw [List.getElem?_eraseIdx] at valueAt + split at atomAt <;> split at valueAt + · rename_i beforeSource _ + have rangeBound : index < shape.parameterCount := + Nat.lt_trans beforeSource sourceBound + rw [List.getElem?_range rangeBound] at atomAt + simp only [Option.map_some, Option.some.injEq] at atomAt + subst atom + have parameterAt : parameters[index]? = some value := by + simpa only [Array.getElem?_toList] using valueAt + have parameterIndex : index < parameters.size := by + rw [parameterCount] + exact rangeBound + apply resolveAtom_reg_of_getElem + rw [Array.getElem?_append, if_pos parameterIndex] + exact parameterAt + · rename_i beforeSource notBeforeSource + omega + · rename_i notBeforeSource beforeSource + omega + · rename_i notBeforeSource _ + have rangeBound : index + 1 < shape.parameterCount := by + simp [List.length_eraseIdx, sourceBound, parameterCount] at erasedBound + omega + rw [List.getElem?_range rangeBound] at atomAt + simp only [Option.map_some, Option.some.injEq] at atomAt + subst atom + have parameterAt : parameters[index + 1]? = some value := by + simpa only [Array.getElem?_toList] using valueAt + have parameterIndex : index + 1 < parameters.size := by + rw [parameterCount] + exact rangeBound + apply resolveAtom_reg_of_getElem + rw [Array.getElem?_append, if_pos parameterIndex] + exact parameterAt + have mapped : + (fieldAtoms ++ parameterAtoms).mapM + (resolveAtom (parameters ++ fields)) = + .ok (fields.toList ++ parameters.toList.eraseIdx shape.source) := by + simp [List.mapM_append, fieldsMapped, parametersMapped, bind, + Except.bind, pure, Except.pure] + have resolved := resolveAtoms_of_mapM mapped + have atomsEq : (fieldAtoms ++ parameterAtoms).toArray = + branchValues shape := by + simp [branchValues, fieldAtoms, parameterAtoms] + have outputEq : + (fields.toList ++ parameters.toList.eraseIdx shape.source).toArray = + helperEntryValues shape.source parameters fields := by + apply Array.ext' + simp [helperEntryValues] + change resolveAtoms (parameters ++ fields) + (fieldAtoms ++ parameterAtoms).toArray = + .ok (fields.toList ++ + parameters.toList.eraseIdx shape.source).toArray at resolved + rw [atomsEq, outputEq] at resolved + exact resolved + +/-- A reset successor transfers its one linear credit and the canonical +branch value vector into either generated helper block. -/ +theorem helperEdgeTransfer {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (site : Reuse.Site limits context block) + {frame : Frame} {target : BlockId} {capability : CreditCap} + {credit : Credit} {parameters fields : Array RVal} + (frameValues : frame.values = parameters ++ fields) + (frameCredits : frame.credits = #[some credit]) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (blockAt : frame.definition.blocks[target]? = + some (Reuse.creditBlock site.candidate capability)) : + EdgeTransfer frame + { target + values := site.candidate.resetValues + credits := #[0] } + #[] + { frame with + block := target + pc := 0 + values := helperEntryValues site.shape.source parameters fields + credits := #[some credit] } := by + let after : Frame := + { frame with credits := frame.credits.setIfInBounds 0 none } + have creditAt : frame.credits[0]? = some (some credit) := by + simp [frameCredits] + have taken : CreditTake frame 0 after credit := by + simpa [after] using CreditTake.of_lookup + (CreditLookup.of_getElem creditAt) + have takenMany : CreditTakeMany frame #[0] after #[credit] := + CreditTakeMany.single taken + have afterCredits : after.credits = #[none] := by + simp [after, frameCredits, Array.setIfInBounds] + have cleared : NoLiveCredits after := by + simp [NoLiveCredits, afterCredits] + have resolved : resolveAtoms frame.values site.candidate.resetValues = + .ok (helperEntryValues site.shape.source parameters fields) := by + rw [frameValues, site.candidateVectors.2] + exact branchValues_resolve parameterCount fieldCount site.fits.sourceBound + have transferred := EdgeTransfer.of_parts + (frame := frame) (after := after) + (edge := { target, values := site.candidate.resetValues, credits := #[0] }) + (implicitValues := #[]) + (values := helperEntryValues site.shape.source parameters fields) + (credits := #[credit]) + (block := Reuse.creditBlock site.candidate capability) + resolved takenMany cleared blockAt + (by simpa [Reuse.creditBlock] using + helperEntryValues_size site parameterCount fieldCount) + (by simp [Reuse.creditBlock]) + simpa [after] using transferred + +/-- A unit-refcount logical reset and its present-credit branch reach the +required helper in exactly two machine steps. All operand reordering and +linear credit transfer are discharged from the accepted site. -/ +theorem hotLogicalControlPrefix {limits : Validate.Limits} + {validation : Validate.Context} {sourceBlock : Block} + (site : Reuse.Site limits validation sourceBlock) + {context : Eval.Context} {definition : Function} + {resetId hotId coldId : BlockId} + {parameters fields : Array RVal} {location : Nat} {box : IxIR1.NodeBox} + {sourceSchema : CtorSchema} {machine : Machine} + {stack : List Continuation} + (resetAt : definition.blocks[resetId]? = + some (Reuse.resetBlock site.candidate hotId coldId)) + (hotAt : definition.blocks[hotId]? = some + (Reuse.creditBlock site.candidate + (.required site.candidate.layout))) + (schemaAt : context.schemas .shared site.shape.sourceConstructor = + some sourceSchema) + (control : machine.control = .running + { definition + block := resetId + pc := 0 + values := parameters + credits := #[] } stack) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (resolved : resolveAtom parameters (.reg site.shape.source) = + .ok (.loc location)) + (viewed : ConstructorView machine.store location .shared + site.shape.sourceConstructor box fields) + (unitRC : box.rc = 1) : + Steps context .logical 2 machine + { machine with + store := ((machine.store.tickResetAttempt).kill location).tickHotReset + control := .running + { definition + block := hotId + pc := 0 + values := helperEntryValues site.shape.source parameters fields + credits := #[some + { layout := sourceSchema.layout + presence := .present none }] } + stack } := by + let initial : Frame := + { definition + block := resetId + pc := 0 + values := parameters + credits := #[] } + let credit : Credit := + { layout := sourceSchema.layout, presence := .present none } + let middle : Frame := + { initial with + pc := 1 + values := parameters ++ fields + credits := #[some credit] } + let target : Frame := + { definition + block := hotId + pc := 0 + values := helperEntryValues site.shape.source parameters fields + credits := #[some credit] } + have resetStep : Step context .logical machine + { machine with + store := ((machine.store.tickResetAttempt).kill location).tickHotReset + control := .running middle stack } := by + have step := Step.resetSharedLogicalHot + (context := context) (machine := machine) + (frame := initial) (stack := stack) + (block := Reuse.resetBlock site.candidate hotId coldId) + (target := .reg site.shape.source) + (cid := site.shape.sourceConstructor) + (schema := sourceSchema) (location := location) (box := box) + (fields := fields) + (by simpa [initial] using control) resetAt + (by simp [initial, site.resetBlock_eq]) + (by simp [initial, site.resetBlock_eq]) schemaAt + (by simpa [initial] using resolved) viewed unitRC + simpa [initial, middle, credit] using step + have transferred : EdgeTransfer middle + { target := hotId + values := site.candidate.resetValues + credits := #[0] } + #[] target := by + simpa [middle, target, credit] using + helperEdgeTransfer site (frame := middle) (target := hotId) + (capability := .required site.candidate.layout) (credit := credit) + (parameters := parameters) (fields := fields) + (by simp [middle]) (by simp [middle]) parameterCount + fieldCount (by simpa [middle, initial] using hotAt) + have branchStep : Step context .logical + { machine with + store := ((machine.store.tickResetAttempt).kill location).tickHotReset + control := .running middle stack } + { machine with + store := ((machine.store.tickResetAttempt).kill location).tickHotReset + control := .running target stack } := by + apply Step.branchCreditPresent + (frame := middle) (target := target) + (block := Reuse.resetBlock site.candidate hotId coldId) + (creditId := 0) + (credit := credit) + (someEdge := + { target := hotId + values := site.candidate.resetValues + credits := #[0] }) + (noneEdge := + { target := coldId + values := site.candidate.resetValues + credits := #[0] }) + · rfl + · simpa [middle, initial] using resetAt + · simp [middle, Reuse.resetBlock] + · rfl + · apply CreditLookup.of_getElem + simp [middle, credit] + · rfl + · exact transferred + have first := resetStep.toSteps (by simpa [initial] using control) + have second := branchStep.toSteps (by rfl) + simpa [target, credit] using first.trans second + +/-- The physical unit-refcount arm reaches the same required helper/value +file in two steps while its credit carries the reserved source location. -/ +theorem hotPhysicalControlPrefix {limits : Validate.Limits} + {validation : Validate.Context} {sourceBlock : Block} + (site : Reuse.Site limits validation sourceBlock) + {context : Eval.Context} {definition : Function} + {resetId hotId coldId : BlockId} + {parameters fields : Array RVal} {location : Nat} {box : IxIR1.NodeBox} + {sourceSchema : CtorSchema} {machine : Machine} + {stack : List Continuation} + (resetAt : definition.blocks[resetId]? = + some (Reuse.resetBlock site.candidate hotId coldId)) + (hotAt : definition.blocks[hotId]? = some + (Reuse.creditBlock site.candidate + (.required site.candidate.layout))) + (schemaAt : context.schemas .shared site.shape.sourceConstructor = + some sourceSchema) + (control : machine.control = .running + { definition + block := resetId + pc := 0 + values := parameters + credits := #[] } stack) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (resolved : resolveAtom parameters (.reg site.shape.source) = + .ok (.loc location)) + (viewed : ConstructorView machine.store location .shared + site.shape.sourceConstructor box fields) + (unitRC : box.rc = 1) : + Steps context .physical 2 machine + { machine with + store := + ((machine.store.tickResetAttempt).reserve location).tickHotReset + control := .running + { definition + block := hotId + pc := 0 + values := helperEntryValues site.shape.source parameters fields + credits := #[some + { layout := sourceSchema.layout + presence := .present (some location) }] } + stack } := by + let initial : Frame := + { definition + block := resetId + pc := 0 + values := parameters + credits := #[] } + let credit : Credit := + { layout := sourceSchema.layout, presence := .present (some location) } + let middle : Frame := + { initial with + pc := 1 + values := parameters ++ fields + credits := #[some credit] } + let target : Frame := + { definition + block := hotId + pc := 0 + values := helperEntryValues site.shape.source parameters fields + credits := #[some credit] } + have resetStep : Step context .physical machine + { machine with + store := + ((machine.store.tickResetAttempt).reserve location).tickHotReset + control := .running middle stack } := by + have step := Step.resetSharedPhysicalHot + (context := context) (machine := machine) + (frame := initial) (stack := stack) + (block := Reuse.resetBlock site.candidate hotId coldId) + (target := .reg site.shape.source) + (cid := site.shape.sourceConstructor) + (schema := sourceSchema) (location := location) (box := box) + (fields := fields) + (by simpa [initial] using control) resetAt + (by simp [initial, site.resetBlock_eq]) + (by simp [initial, site.resetBlock_eq]) schemaAt + (by simpa [initial] using resolved) viewed unitRC + simpa [initial, middle, credit] using step + have transferred : EdgeTransfer middle + { target := hotId + values := site.candidate.resetValues + credits := #[0] } + #[] target := by + simpa [middle, target, credit] using + helperEdgeTransfer site (frame := middle) (target := hotId) + (capability := .required site.candidate.layout) (credit := credit) + (parameters := parameters) (fields := fields) + (by simp [middle]) (by simp [middle]) parameterCount + fieldCount (by simpa [middle, initial] using hotAt) + have branchStep : Step context .physical + { machine with + store := + ((machine.store.tickResetAttempt).reserve location).tickHotReset + control := .running middle stack } + { machine with + store := + ((machine.store.tickResetAttempt).reserve location).tickHotReset + control := .running target stack } := by + apply Step.branchCreditPresent + (frame := middle) (target := target) + (block := Reuse.resetBlock site.candidate hotId coldId) + (creditId := 0) + (credit := credit) + (someEdge := + { target := hotId + values := site.candidate.resetValues + credits := #[0] }) + (noneEdge := + { target := coldId + values := site.candidate.resetValues + credits := #[0] }) + · rfl + · simpa [middle, initial] using resetAt + · simp [middle, Reuse.resetBlock] + · rfl + · apply CreditLookup.of_getElem + simp [middle, credit] + · rfl + · exact transferred + have first := resetStep.toSteps (by simpa [initial] using control) + have second := branchStep.toSteps (by rfl) + simpa [target, credit] using first.trans second + +/-- The multiply-referenced reset arm reaches the optional-credit helper in +two steps under either interpretation. The evaluator's exact retained store +is threaded unchanged through the CFG branch. -/ +theorem coldControlPrefix {limits : Validate.Limits} + {validation : Validate.Context} {sourceBlock : Block} + (site : Reuse.Site limits validation sourceBlock) + {context : Eval.Context} {interpretation : Interpretation} + {definition : Function} {resetId hotId coldId : BlockId} + {parameters fields : Array RVal} {location : Nat} {box : IxIR1.NodeBox} + {sourceSchema : CtorSchema} {machine : Machine} {store : Store} + {stack : List Continuation} + (resetAt : definition.blocks[resetId]? = + some (Reuse.resetBlock site.candidate hotId coldId)) + (coldAt : definition.blocks[coldId]? = some + (Reuse.creditBlock site.candidate + (.optional site.candidate.layout))) + (schemaAt : context.schemas .shared site.shape.sourceConstructor = + some sourceSchema) + (control : machine.control = .running + { definition + block := resetId + pc := 0 + values := parameters + credits := #[] } stack) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (resolved : resolveAtom parameters (.reg site.shape.source) = + .ok (.loc location)) + (viewed : ConstructorView machine.store location .shared + site.shape.sourceConstructor box fields) + (shared : 1 < box.rc) + (retained : RetainSharedMany + ((((machine.store.tickResetAttempt).setBox location + { box with rc := box.rc - 1 }).rcTick).tickColdReset) + fields store) : + Steps context interpretation 2 machine + { machine with + store + control := .running + { definition + block := coldId + pc := 0 + values := helperEntryValues site.shape.source parameters fields + credits := #[some + { layout := sourceSchema.layout + presence := .absent }] } + stack } := by + let initial : Frame := + { definition + block := resetId + pc := 0 + values := parameters + credits := #[] } + let credit : Credit := + { layout := sourceSchema.layout, presence := .absent } + let middle : Frame := + { initial with + pc := 1 + values := parameters ++ fields + credits := #[some credit] } + let target : Frame := + { definition + block := coldId + pc := 0 + values := helperEntryValues site.shape.source parameters fields + credits := #[some credit] } + have resetStep : Step context interpretation machine + { machine with store, control := .running middle stack } := by + have step := Step.resetSharedCold + (context := context) (interpretation := interpretation) + (machine := machine) (frame := initial) (stack := stack) + (block := Reuse.resetBlock site.candidate hotId coldId) + (target := .reg site.shape.source) + (cid := site.shape.sourceConstructor) + (schema := sourceSchema) (location := location) (box := box) + (fields := fields) (store := store) + (by simpa [initial] using control) resetAt + (by simp [initial, site.resetBlock_eq]) + (by simp [initial, site.resetBlock_eq]) schemaAt + (by simpa [initial] using resolved) viewed shared retained + simpa [initial, middle, credit] using step + have transferred : EdgeTransfer middle + { target := coldId + values := site.candidate.resetValues + credits := #[0] } + #[] target := by + simpa [middle, target, credit] using + helperEdgeTransfer site (frame := middle) (target := coldId) + (capability := .optional site.candidate.layout) (credit := credit) + (parameters := parameters) (fields := fields) + (by simp [middle]) (by simp [middle]) parameterCount + fieldCount (by simpa [middle, initial] using coldAt) + have branchStep : Step context interpretation + { machine with store, control := .running middle stack } + { machine with store, control := .running target stack } := by + apply Step.branchCreditAbsent + (frame := middle) (target := target) + (block := Reuse.resetBlock site.candidate hotId coldId) + (creditId := 0) + (credit := credit) + (someEdge := + { target := hotId + values := site.candidate.resetValues + credits := #[0] }) + (noneEdge := + { target := coldId + values := site.candidate.resetValues + credits := #[0] }) + · rfl + · simpa [middle, initial] using resetAt + · simp [middle, Reuse.resetBlock] + · rfl + · apply CreditLookup.of_getElem + simp [middle, credit] + · rfl + · exact transferred + have first := resetStep.toSteps (by simpa [initial] using control) + have second := branchStep.toSteps (by rfl) + simpa [target, credit] using first.trans second + +/-- Successful resolution of a translated atom returns the same runtime +value. The premise is intentionally success-directed: missing source and +target registers carry register-specific diagnostic strings. -/ +theorem resolveAtom_translate {shape : Shape} {source target : Array RVal} + {atom translated : Atom} {value : RVal} + (related : ValuesRel shape source target) + (translation : translateAtom? shape atom = some translated) + (resolved : resolveAtom source atom = .ok value) : + resolveAtom target translated = .ok value := by + cases atom with + | reg sourceId => + cases translatedAt : translateRegister? shape sourceId with + | none => simp [translateAtom?, translatedAt] at translation + | some targetId => + simp [translateAtom?, translatedAt] at translation + subst translated + cases sourceAt : source[sourceId]? with + | none => simp [resolveAtom, sourceAt] at resolved + | some actual => + simp [resolveAtom, sourceAt] at resolved + subst actual + have targetAt := related sourceId targetId translatedAt + rw [sourceAt] at targetAt + have targetAt' : target[targetId]? = some value := targetAt.symm + simp [resolveAtom, targetAt'] + | lit literal => + simp [translateAtom?] at translation + subst translated + simpa [resolveAtom] using resolved + | erased => + simp [translateAtom?] at translation + subst translated + simpa [resolveAtom] using resolved + +private theorem resolveList_translate {shape : Shape} + {source target : Array RVal} (related : ValuesRel shape source target) : + ∀ {atoms translated : List Atom}, + atoms.mapM (translateAtom? shape) = some translated → + ∀ (initial result : Array RVal), + atoms.foldlM (fun output atom => do + return output.push (← resolveAtom source atom)) initial = + .ok result → + translated.foldlM (fun output atom => do + return output.push (← resolveAtom target atom)) initial = + .ok result := by + intro atoms + induction atoms with + | nil => + intro translated translation initial result resolved + simp at translation + subst translated + simpa using resolved + | cons atom atoms ih => + intro translated translation initial result resolved + cases atomAt : translateAtom? shape atom with + | none => simp [List.mapM_cons, atomAt] at translation + | some translatedAtom => + cases tailAt : atoms.mapM (translateAtom? shape) with + | none => simp [List.mapM_cons, atomAt, tailAt] at translation + | some translatedAtoms => + simp [List.mapM_cons, atomAt, tailAt] at translation + subst translated + rw [List.foldlM_cons] + rw [List.foldlM_cons] at resolved + cases sourceResolved : resolveAtom source atom with + | error error => + simp only [sourceResolved, bind, Except.bind] at resolved + cases resolved + | ok value => + simp only [sourceResolved, bind, Except.bind] at resolved + have targetResolved : + resolveAtom target translatedAtom = .ok value := + resolveAtom_translate related atomAt sourceResolved + rw [targetResolved] + simp only [bind, Except.bind] + apply ih tailAt (initial.push value) result + exact resolved + +/-- Successful batch resolution is preserved by the planner's accepted atom +translation, with both sides producing the identical value vector. -/ +theorem resolveAtoms_translate {shape : Shape} + {source target : Array RVal} (related : ValuesRel shape source target) + {atoms translated : Array Atom} {values : Array RVal} + (translation : translateAtoms? shape atoms = some translated) + (resolved : resolveAtoms source atoms = .ok values) : + resolveAtoms target translated = .ok values := by + unfold translateAtoms? at translation + cases mappedAt : atoms.toList.mapM (translateAtom? shape) with + | none => simp [mappedAt] at translation + | some translatedAtoms => + simp [mappedAt] at translation + subst translated + unfold resolveAtoms at resolved ⊢ + rw [← Array.foldlM_toList] + apply resolveList_translate related mappedAt #[] values + simpa only [Array.foldlM_toList] using resolved + +/-- The accepted-site trace turns successful baseline allocation-operand +resolution into the exact helper-block operand resolution. -/ +theorem resolveAllocationArguments {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (site : Reuse.Site limits context block) + {source target values : Array RVal} + (related : ValuesRel site.shape source target) + (resolved : resolveAtoms source site.shape.allocationArguments = + .ok values) : + resolveAtoms target site.candidate.allocationArguments = .ok values := + resolveAtoms_translate related site.allocationArgumentsFound resolved + +/-- The same accepted-site mapping preserves the tail-call argument vector +after baseline and helper allocation states have been related. -/ +theorem resolveTailArguments {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (site : Reuse.Site limits context block) + {source target values : Array RVal} + (related : ValuesRel site.shape source target) + (resolved : resolveAtoms source site.shape.tailArguments = .ok values) : + resolveAtoms target site.candidate.tailArguments = .ok values := + resolveAtoms_translate related site.tailArgumentsFound resolved + +/-- Accepted validator schemas are also the evaluator schemas whenever the +enclosing execution context carries the checked schema table. -/ +theorem evalRuntimeSchemas {limits : Validate.Limits} + {validation : Validate.Context} {block : Block} + (site : Reuse.Site limits validation block) {context : Eval.Context} + (schemas : context.schemas = validation.schemas) : + ∃ sourceSchema allocationSchema, + context.schemas .shared site.shape.sourceConstructor = + some sourceSchema ∧ + context.schemas .shared site.shape.allocationConstructor = + some allocationSchema ∧ + sourceSchema.fields = + Array.replicate site.shape.fieldCount .shared ∧ + allocationSchema.fields = sourceSchema.fields ∧ + site.candidate.layout = sourceSchema.layout ∧ + site.candidate.layout = allocationSchema.layout := by + rw [schemas] + exact site.runtimeSchemas + +private theorem blocks_nonempty_of_getElem {blocks : Array Block} + {index : Nat} {block : Block} (found : blocks[index]? = some block) : + blocks.isEmpty = false := by + apply Bool.eq_false_iff.mpr + intro empty + have blocksEmpty : blocks = #[] := Array.isEmpty_iff.mp empty + subst blocks + simp at found + +/-- A baseline register remains observable to an accepted rewrite exactly when +the recognized allocation or recursive tail call reads it. The reset block may +forward additional ABI slots, but helper-local liveness is allowed to forget +those values immediately. -/ +def PlannerValueRelevant (shape : Shape) (sourceId : ValueId) : Prop := + .reg sourceId ∈ shape.allocationArguments.toList ∨ + .reg sourceId ∈ shape.tailArguments.toList + +def PlannerAtomRelevant (shape : Shape) : Atom → Prop + | .reg sourceId => PlannerValueRelevant shape sourceId + | .lit _ | .erased => True + +/-- Observable register values selected by the planner agree modulo a location +relation. The implication form is sufficient for operand resolution and +permits both dead forwarded parameters and the distinguished, not-yet-allocated +result mapping to be out of bounds. -/ +def TranslatedValuesIso (shape : Shape) (locRel : Nat → Nat → Prop) + (source target : Array RVal) : Prop := + ∀ sourceId targetId sourceValue, + PlannerValueRelevant shape sourceId → + translateRegister? shape sourceId = some targetId → + source[sourceId]? = some sourceValue → + ∃ targetValue, + target[targetId]? = some targetValue ∧ + IxIR1.Sim.RValIso locRel sourceValue targetValue + +/-- A location value is represented by one of the surrounding semantic +roots. Scalars require no heap-root witness. -/ +def PlannerValueInRoots (roots : List IxIR1.Sim.Root) : RVal → Prop + | .loc location => + ∃ world, (⟨world, .loc location⟩ : IxIR1.Sim.Root) ∈ roots + | .lit _ | .erased => True + +/-- Every observable source register that the reuse planner preserves has +the root support needed by physical address replacement. The consumed source +register, discarded fetch temporaries, dead forwarded parameters, and scalar +values are deliberately outside the heap-root obligation. -/ +def MappedValuesInRoots (shape : Shape) (values : Array RVal) + (roots : List IxIR1.Sim.Root) : Prop := + ∀ sourceId targetId sourceValue, + PlannerValueRelevant shape sourceId → + translateRegister? shape sourceId = some targetId → + values[sourceId]? = some sourceValue → + PlannerValueInRoots roots sourceValue + +/-- Root-level self-relatedness discharges self-relatedness for every +planner-preserved register. -/ +theorem MappedValuesInRoots.selfRelated {shape : Shape} + {values : Array RVal} {roots : List IxIR1.Sim.Root} + {locRel : Nat → Nat → Prop} + (mapped : MappedValuesInRoots shape values roots) + (rootsRelated : ∀ root ∈ roots, + IxIR1.Sim.RValIso locRel root.value root.value) : + ∀ sourceId targetId sourceValue, + PlannerValueRelevant shape sourceId → + translateRegister? shape sourceId = some targetId → + values[sourceId]? = some sourceValue → + IxIR1.Sim.RValIso locRel sourceValue sourceValue := by + intro sourceId targetId sourceValue relevant translated sourceAt + have supported := + mapped sourceId targetId sourceValue relevant translated sourceAt + cases sourceValue with + | loc location => + obtain ⟨world, member⟩ := supported + exact rootsRelated ⟨world, .loc location⟩ member + | lit literal => exact .lit + | erased => exact .erased + +/-- Exact planner register agreement lifts to location-renaming agreement +when each live source value is self-related. -/ +theorem ValuesRel.toTranslatedValuesIso {shape : Shape} + {source target : Array RVal} {locRel : Nat → Nat → Prop} + (related : ValuesRel shape source target) + (selfRelated : ∀ (sourceId targetId : Nat) (sourceValue : RVal), + PlannerValueRelevant shape sourceId → + translateRegister? shape sourceId = some targetId → + source[sourceId]? = some sourceValue → + IxIR1.Sim.RValIso locRel sourceValue sourceValue) : + TranslatedValuesIso shape locRel source target := by + intro sourceId targetId sourceValue relevant translated sourceAt + have targetAt := related sourceId targetId translated + rw [sourceAt] at targetAt + exact ⟨sourceValue, targetAt.symm, + selfRelated sourceId targetId sourceValue relevant translated sourceAt⟩ + +private theorem rvalsIso_append {locRel : Nat → Nat → Prop} + {left right : List RVal} + (related : IxIR1.Sim.RValsIso locRel left right) + {leftValue rightValue : RVal} + (valueRelated : IxIR1.Sim.RValIso locRel leftValue rightValue) : + IxIR1.Sim.RValsIso locRel + (left ++ [leftValue]) (right ++ [rightValue]) := by + induction related with + | nil => exact .cons valueRelated .nil + | cons head tail ih => exact .cons head ih + +/-- Appending a common suffix preserves an identity-location value relation. -/ +private theorem rvalsIso_append_refl + {left right : List RVal} + (related : IxIR1.Sim.RValsIso (fun l r => l = r) left right) + (suffix : List RVal) : + IxIR1.Sim.RValsIso (fun l r => l = r) + (left ++ suffix) (right ++ suffix) := by + induction related with + | nil => simpa using IxIR1.Sim.RValsIso.refl suffix + | cons head tail ih => exact .cons head ih + +private theorem rvalsIso_length_eq {locRel : Nat → Nat → Prop} + {left right : List RVal} + (related : IxIR1.Sim.RValsIso locRel left right) : + left.length = right.length := by + induction related with + | nil => rfl + | cons _ _ ih => simp [ih] + +private theorem rvalsIso_symm {locRel : Nat → Nat → Prop} + {left right : List RVal} + (related : IxIR1.Sim.RValsIso locRel left right) : + IxIR1.Sim.RValsIso (fun rightLocation leftLocation => + locRel leftLocation rightLocation) right left := by + induction related with + | nil => exact .nil + | cons head tail ih => exact .cons head.symm ih + +private theorem rvalsIso_append_pair {locRel : Nat → Nat → Prop} + {left₁ right₁ left₂ right₂ : List RVal} + (first : IxIR1.Sim.RValsIso locRel left₁ right₁) + (second : IxIR1.Sim.RValsIso locRel left₂ right₂) : + IxIR1.Sim.RValsIso locRel (left₁ ++ left₂) (right₁ ++ right₂) := by + induction first with + | nil => exact second + | cons head tail ih => exact .cons head ih + +/-- Pointwise enlargement of a runtime-location relation preserves related +value vectors. This local public-proof helper is used when corresponding +fresh allocations extend an existing allocation history. -/ +private theorem rvalsIso_mono_rel {oldRel newRel : Nat → Nat → Prop} + (lift : ∀ {left right}, oldRel left right → newRel left right) : + ∀ {left right : List RVal}, + IxIR1.Sim.RValsIso oldRel left right → + IxIR1.Sim.RValsIso newRel left right + | _, _, .nil => .nil + | _, _, .cons head tail => .cons (head.mono lift) (rvalsIso_mono_rel lift tail) + +private theorem rvalsIso_array_extract {locRel : Nat → Nat → Prop} + {left right : Array RVal} + (related : IxIR1.Sim.RValsIso locRel left.toList right.toList) + (start stop : Nat) : + IxIR1.Sim.RValsIso locRel + (left.extract start stop).toList (right.extract start stop).toList := by + simpa [List.extract_eq_take_drop] using + (related.drop start).take (stop - start) + +private theorem rvalsIso_transport_avoiding_right + {oldRel newRel : Nat → Nat → Prop} {removed : Nat} + (lift : ∀ {leftLocation rightLocation}, + oldRel leftLocation rightLocation → + rightLocation ≠ removed → + newRel leftLocation rightLocation) + {left right : List RVal} + (related : IxIR1.Sim.RValsIso oldRel left right) + (avoids : ∀ value ∈ right, value ≠ .loc removed) : + IxIR1.Sim.RValsIso newRel left right := by + induction related with + | nil => exact .nil + | @cons leftValue rightValue lefts rights head tail ih => + have headAvoids : rightValue ≠ .loc removed := + avoids rightValue (by simp) + have tailAvoids : ∀ value ∈ rights, value ≠ .loc removed := by + intro value member + exact avoids value (by simp [member]) + refine .cons ?_ (ih tailAvoids) + cases head with + | loc locationRelated => + apply IxIR1.Sim.RValIso.loc + apply lift locationRelated + intro same + apply headAvoids + cases same + rfl + | lit => exact .lit + | erased => exact .erased + +private theorem rvalsIso_getElem? {locRel : Nat → Nat → Prop} + {left right : List RVal} + (related : IxIR1.Sim.RValsIso locRel left right) + {index : Nat} {leftValue : RVal} + (found : left[index]? = some leftValue) : + ∃ rightValue, + right[index]? = some rightValue ∧ + IxIR1.Sim.RValIso locRel leftValue rightValue := by + induction related generalizing index leftValue with + | nil => simp at found + | @cons leftHead rightHead leftTail rightTail head tail ih => + cases index with + | zero => + simp only [List.getElem?_cons_zero, Option.some.injEq] at found + subst leftValue + exact ⟨rightHead, by simp, head⟩ + | succ index => + simp only [List.getElem?_cons_succ] at found ⊢ + exact ih found + +private theorem rvalsIso_array_getElem? {locRel : Nat → Nat → Prop} + {left right : Array RVal} + (related : IxIR1.Sim.RValsIso locRel left.toList right.toList) + {index : Nat} {leftValue : RVal} + (found : left[index]? = some leftValue) : + ∃ rightValue, + right[index]? = some rightValue ∧ + IxIR1.Sim.RValIso locRel leftValue rightValue := by + have listFound : left.toList[index]? = some leftValue := by + simpa using found + obtain ⟨rightValue, rightFound, valueRelated⟩ := + rvalsIso_getElem? related listFound + exact ⟨rightValue, by simpa using rightFound, valueRelated⟩ + +/-- Resolving the same atom in pointwise-related register files produces +related runtime values. -/ +theorem resolveAtom_iso {locRel : Nat → Nat → Prop} + {left right : Array RVal} + (related : IxIR1.Sim.RValsIso locRel left.toList right.toList) + {atom : Atom} {leftValue : RVal} + (resolved : resolveAtom left atom = .ok leftValue) : + ∃ rightValue, + resolveAtom right atom = .ok rightValue ∧ + IxIR1.Sim.RValIso locRel leftValue rightValue := by + cases atom with + | reg index => + cases found : left[index]? with + | none => simp [resolveAtom, found] at resolved + | some actual => + simp [resolveAtom, found] at resolved + subst actual + obtain ⟨rightValue, rightFound, valueRelated⟩ := + rvalsIso_array_getElem? related found + exact ⟨rightValue, by simp [resolveAtom, rightFound], valueRelated⟩ + | lit literal => + simp [resolveAtom] at resolved + subst leftValue + exact ⟨.lit literal, by simp [resolveAtom], .lit⟩ + | erased => + simp [resolveAtom] at resolved + subst leftValue + exact ⟨.erased, by simp [resolveAtom], .erased⟩ + +private theorem resolveList_iso {locRel : Nat → Nat → Prop} + {left right : Array RVal} + (related : IxIR1.Sim.RValsIso locRel left.toList right.toList) : + ∀ {atoms : List Atom} {leftInitial leftResult : Array RVal}, + atoms.foldlM (fun output atom => do + return output.push (← resolveAtom left atom)) leftInitial = + .ok leftResult → + ∀ {rightInitial : Array RVal}, + IxIR1.Sim.RValsIso locRel leftInitial.toList rightInitial.toList → + ∃ rightResult, + atoms.foldlM (fun output atom => do + return output.push (← resolveAtom right atom)) rightInitial = + .ok rightResult ∧ + IxIR1.Sim.RValsIso locRel leftResult.toList + rightResult.toList := by + intro atoms + induction atoms with + | nil => + intro leftInitial leftResult resolved rightInitial initialRelated + change (Except.ok leftInitial : Except Error (Array RVal)) = + .ok leftResult at resolved + have same : leftInitial = leftResult := Except.ok.inj resolved + subst leftResult + exact ⟨rightInitial, rfl, initialRelated⟩ + | cons atom atoms ih => + intro leftInitial leftResult resolved rightInitial initialRelated + rw [List.foldlM_cons] at resolved + cases leftResolved : resolveAtom left atom with + | error error => + simp only [leftResolved, bind, Except.bind] at resolved + cases resolved + | ok leftValue => + simp only [leftResolved, bind, Except.bind] at resolved + obtain ⟨rightValue, rightResolved, valueRelated⟩ := + resolveAtom_iso related leftResolved + have pushedRelated : IxIR1.Sim.RValsIso locRel + (leftInitial.push leftValue).toList + (rightInitial.push rightValue).toList := by + simpa using rvalsIso_append initialRelated valueRelated + obtain ⟨rightResult, rightRun, resultRelated⟩ := + ih resolved pushedRelated + refine ⟨rightResult, ?_, resultRelated⟩ + rw [List.foldlM_cons, rightResolved] + exact rightRun + +/-- Batch resolution of an unchanged atom vector is equivariant under any +pointwise runtime-location relation. -/ +theorem resolveAtoms_iso {locRel : Nat → Nat → Prop} + {left right leftValues : Array RVal} + (related : IxIR1.Sim.RValsIso locRel left.toList right.toList) + {atoms : Array Atom} + (resolved : resolveAtoms left atoms = .ok leftValues) : + ∃ rightValues, + resolveAtoms right atoms = .ok rightValues ∧ + IxIR1.Sim.RValsIso locRel leftValues.toList rightValues.toList := by + unfold resolveAtoms at resolved ⊢ + rw [← Array.foldlM_toList] + apply resolveList_iso related + (by simpa only [Array.foldlM_toList] using resolved) + exact .nil + +/-- Appending related result values extends the planner's translated register +relation across its distinguished result-register mapping. -/ +theorem TranslatedValuesIso.pushResult {shape : Shape} + {source target : Array RVal} {locRel : Nat → Nat → Prop} + {sourceResult targetResult : RVal} + (related : TranslatedValuesIso shape locRel source target) + (resultRelated : IxIR1.Sim.RValIso locRel sourceResult targetResult) + (sourceSize : source.size = + shape.parameterCount + 2 * shape.fieldCount) + (targetSize : target.size = + shape.fieldCount + (shape.parameterCount - 1)) + (sourceBound : shape.source < shape.parameterCount) : + TranslatedValuesIso shape locRel + (source.push sourceResult) (target.push targetResult) := by + intro sourceId targetId sourceValue relevant translated sourceAt + rcases translateRegister?_range sourceBound translated with + ⟨sourceEnd, targetEnd⟩ | ⟨sourceBefore, targetBefore⟩ + · subst sourceId + subst targetId + rw [← sourceSize] at sourceAt + simp at sourceAt + subst sourceValue + refine ⟨targetResult, ?_, resultRelated⟩ + rw [← targetSize] + simp + · have sourceNe : sourceId ≠ source.size := by + rw [sourceSize] + exact Nat.ne_of_lt sourceBefore + have targetNe : targetId ≠ target.size := by + rw [targetSize] + exact Nat.ne_of_lt targetBefore + have sourceAtOld : source[sourceId]? = some sourceValue := by + simpa [Array.getElem?_push, sourceNe] using sourceAt + obtain ⟨targetValue, targetAt, valueRelated⟩ := + related sourceId targetId sourceValue relevant translated sourceAtOld + refine ⟨targetValue, ?_, valueRelated⟩ + simpa [Array.getElem?_push, targetNe] using targetAt + +/-- Resolving one translated atom preserves its runtime value modulo the +chosen location relation. -/ +theorem resolveAtom_translate_iso {shape : Shape} + {locRel : Nat → Nat → Prop} {source target : Array RVal} + (related : TranslatedValuesIso shape locRel source target) + {atom translated : Atom} {sourceValue : RVal} + (relevant : PlannerAtomRelevant shape atom) + (translation : translateAtom? shape atom = some translated) + (resolved : resolveAtom source atom = .ok sourceValue) : + ∃ targetValue, + resolveAtom target translated = .ok targetValue ∧ + IxIR1.Sim.RValIso locRel sourceValue targetValue := by + cases atom with + | reg sourceId => + cases translatedAt : translateRegister? shape sourceId with + | none => simp [translateAtom?, translatedAt] at translation + | some targetId => + simp [translateAtom?, translatedAt] at translation + subst translated + cases sourceAt : source[sourceId]? with + | none => simp [resolveAtom, sourceAt] at resolved + | some actual => + simp [resolveAtom, sourceAt] at resolved + subst actual + obtain ⟨targetValue, targetAt, valueRelated⟩ := + related sourceId targetId sourceValue relevant translatedAt + sourceAt + exact + ⟨targetValue, by simp [resolveAtom, targetAt], valueRelated⟩ + | lit literal => + simp [translateAtom?] at translation + subst translated + simp [resolveAtom] at resolved + subst sourceValue + exact ⟨.lit literal, by simp [resolveAtom], .lit⟩ + | erased => + simp [translateAtom?] at translation + subst translated + simp [resolveAtom] at resolved + subst sourceValue + exact ⟨.erased, by simp [resolveAtom], .erased⟩ + +private theorem resolveList_translate_iso {shape : Shape} + {locRel : Nat → Nat → Prop} {source target : Array RVal} + (related : TranslatedValuesIso shape locRel source target) : + ∀ {atoms translated : List Atom}, + (∀ atom ∈ atoms, PlannerAtomRelevant shape atom) → + atoms.mapM (translateAtom? shape) = some translated → + ∀ {sourceInitial sourceResult : Array RVal}, + atoms.foldlM (fun output atom => do + return output.push (← resolveAtom source atom)) sourceInitial = + .ok sourceResult → + ∀ {targetInitial : Array RVal}, + IxIR1.Sim.RValsIso locRel sourceInitial.toList + targetInitial.toList → + ∃ targetResult, + translated.foldlM (fun output atom => do + return output.push (← resolveAtom target atom)) targetInitial = + .ok targetResult ∧ + IxIR1.Sim.RValsIso locRel sourceResult.toList + targetResult.toList := by + intro atoms + induction atoms with + | nil => + intro translated _relevant translation sourceInitial sourceResult resolved + targetInitial initialRelated + simp at translation + subst translated + change (Except.ok sourceInitial : Except Error (Array RVal)) = + .ok sourceResult at resolved + have sourceEq : sourceInitial = sourceResult := Except.ok.inj resolved + subst sourceResult + exact ⟨targetInitial, rfl, initialRelated⟩ + | cons atom atoms ih => + intro translated relevant translation sourceInitial sourceResult resolved + targetInitial initialRelated + cases atomAt : translateAtom? shape atom with + | none => simp [List.mapM_cons, atomAt] at translation + | some translatedAtom => + cases tailAt : atoms.mapM (translateAtom? shape) with + | none => simp [List.mapM_cons, atomAt, tailAt] at translation + | some translatedAtoms => + simp [List.mapM_cons, atomAt, tailAt] at translation + subst translated + rw [List.foldlM_cons] at resolved + cases sourceResolved : resolveAtom source atom with + | error error => + simp only [sourceResolved, bind, Except.bind] at resolved + cases resolved + | ok sourceValue => + simp only [sourceResolved, bind, Except.bind] at resolved + obtain ⟨targetValue, targetResolved, valueRelated⟩ := + resolveAtom_translate_iso related + (relevant atom (by simp)) atomAt sourceResolved + have pushedRelated : IxIR1.Sim.RValsIso locRel + (sourceInitial.push sourceValue).toList + (targetInitial.push targetValue).toList := by + simpa using rvalsIso_append initialRelated valueRelated + obtain ⟨targetResult, targetRun, resultRelated⟩ := + ih (fun tailAtom member => + relevant tailAtom (by simp [member])) tailAt resolved + pushedRelated + refine ⟨targetResult, ?_, resultRelated⟩ + rw [List.foldlM_cons, targetResolved] + change translatedAtoms.foldlM (fun output atom => do + return output.push (← resolveAtom target atom)) + (targetInitial.push targetValue) = .ok targetResult + exact targetRun + +/-- Batch operand resolution commutes with the planner translation modulo an +arbitrary runtime-location relation. -/ +theorem resolveAtoms_translate_iso {shape : Shape} + {locRel : Nat → Nat → Prop} {source target : Array RVal} + (related : TranslatedValuesIso shape locRel source target) + {atoms translated : Array Atom} {sourceValues : Array RVal} + (relevant : ∀ atom ∈ atoms.toList, + PlannerAtomRelevant shape atom) + (translation : translateAtoms? shape atoms = some translated) + (resolved : resolveAtoms source atoms = .ok sourceValues) : + ∃ targetValues, + resolveAtoms target translated = .ok targetValues ∧ + IxIR1.Sim.RValsIso locRel sourceValues.toList targetValues.toList := by + unfold translateAtoms? at translation + cases mappedAt : atoms.toList.mapM (translateAtom? shape) with + | none => simp [mappedAt] at translation + | some translatedAtoms => + simp [mappedAt] at translation + subst translated + unfold resolveAtoms at resolved ⊢ + rw [← Array.foldlM_toList] + apply resolveList_translate_iso related relevant mappedAt + (by simpa only [Array.foldlM_toList] using resolved) + exact .nil + +/-- Accepted allocation operands resolve on the helper side to values related +to the baseline operands by the chosen location relation. -/ +theorem resolveAllocationArguments_iso {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (site : Reuse.Site limits context block) + {locRel : Nat → Nat → Prop} {source target sourceValues : Array RVal} + (related : TranslatedValuesIso site.shape locRel source target) + (resolved : resolveAtoms source site.shape.allocationArguments = + .ok sourceValues) : + ∃ targetValues, + resolveAtoms target site.candidate.allocationArguments = + .ok targetValues ∧ + IxIR1.Sim.RValsIso locRel sourceValues.toList targetValues.toList := + resolveAtoms_translate_iso related (by + intro atom member + cases atom with + | reg sourceId => exact .inl member + | lit | erased => trivial) site.allocationArgumentsFound resolved + +/-- Accepted tail operands resolve on the helper side to values related to +the baseline operands by the chosen location relation. -/ +theorem resolveTailArguments_iso {limits : Validate.Limits} + {context : Validate.Context} {block : Block} + (site : Reuse.Site limits context block) + {locRel : Nat → Nat → Prop} {source target sourceValues : Array RVal} + (related : TranslatedValuesIso site.shape locRel source target) + (resolved : resolveAtoms source site.shape.tailArguments = + .ok sourceValues) : + ∃ targetValues, + resolveAtoms target site.candidate.tailArguments = .ok targetValues ∧ + IxIR1.Sim.RValsIso locRel sourceValues.toList targetValues.toList := + resolveAtoms_translate_iso related (by + intro atom member + cases atom with + | reg sourceId => exact .inr member + | lit | erased => trivial) site.tailArgumentsFound resolved + +/-- The concrete canonical baseline/helper entry files are related modulo any +location relation that self-relates the surviving baseline values. -/ +theorem translatedValuesIso_helperEntry {shape : Shape} + {parameters fields : Array RVal} {locRel : Nat → Nat → Prop} + (parameterCount : parameters.size = shape.parameterCount) + (fieldCount : fields.size = shape.fieldCount) + (sourceBound : shape.source < shape.parameterCount) + (selfRelated : ∀ (sourceId targetId : Nat) (sourceValue : RVal), + PlannerValueRelevant shape sourceId → + translateRegister? shape sourceId = some targetId → + (baselinePrefixValues parameters fields)[sourceId]? = + some sourceValue → + IxIR1.Sim.RValIso locRel sourceValue sourceValue) : + TranslatedValuesIso shape locRel + (baselinePrefixValues parameters fields) + (helperEntryValues shape.source parameters fields) := + (valuesRel_helperEntry parameterCount fieldCount sourceBound).toTranslatedValuesIso + selfRelated + +/-- Appending two related allocation results to the canonical baseline and +helper files yields the location-renaming relation required by tail operand +resolution. -/ +theorem translatedValuesIso_afterAllocation {shape : Shape} + {parameters fields : Array RVal} {locRel : Nat → Nat → Prop} + {sourceResult targetResult : RVal} + (parameterCount : parameters.size = shape.parameterCount) + (fieldCount : fields.size = shape.fieldCount) + (sourceBound : shape.source < shape.parameterCount) + (selfRelated : ∀ (sourceId targetId : Nat) (sourceValue : RVal), + PlannerValueRelevant shape sourceId → + translateRegister? shape sourceId = some targetId → + (baselinePrefixValues parameters fields)[sourceId]? = + some sourceValue → + IxIR1.Sim.RValIso locRel sourceValue sourceValue) + (resultRelated : + IxIR1.Sim.RValIso locRel sourceResult targetResult) : + TranslatedValuesIso shape locRel + ((baselinePrefixValues parameters fields).push sourceResult) + ((helperEntryValues shape.source parameters fields).push + targetResult) := by + apply TranslatedValuesIso.pushResult + (translatedValuesIso_helperEntry parameterCount fieldCount sourceBound + selfRelated) resultRelated + · simp [baselinePrefixValues, parameterCount, fieldCount, Nat.two_mul] + · simp [helperEntryValues, List.length_eraseIdx, parameterCount, + fieldCount, sourceBound] + · exact sourceBound + +/-- An absent optional credit performs fresh allocation and then the helper's +self tail call in exactly two steps. Allocation and tail operand resolution +are transported from the recognized baseline register files. -/ +theorem absentHelperControl {limits : Validate.Limits} + {validation : Validate.Context} {sourceBlock : Block} + (site : Reuse.Site limits validation sourceBlock) + {context : Eval.Context} {interpretation : Interpretation} + {definition : Function} {helperId : BlockId} + {parameters fields newFields callValues : Array RVal} + {allocationSchema : CtorSchema} {machine : Machine} + {stack : List Continuation} + (helperAt : definition.blocks[helperId]? = some + (Reuse.creditBlock site.candidate + (.optional site.candidate.layout))) + (schemaAt : context.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (layout : site.candidate.layout = allocationSchema.layout) + (control : machine.control = .running + { definition + block := helperId + pc := 0 + values := helperEntryValues site.shape.source parameters fields + credits := #[some + { layout := site.candidate.layout + presence := .absent }] } stack) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (allocationResolved : resolveAtoms + (baselinePrefixValues parameters fields) + site.shape.allocationArguments = .ok newFields) + (fieldWorlds : FieldWorlds machine.store allocationSchema newFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc (machine.store.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields)).2)) + site.shape.tailArguments = .ok callValues) + (arity : callValues.size = definition.signature.params.size) + (nonempty : definition.blocks.isEmpty = false) : + let allocation := machine.store.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + Steps context interpretation 2 machine + { machine with + store := allocation.1 + control := .running { definition, values := callValues } stack } := by + dsimp only + let credit : Credit := + { layout := site.candidate.layout, presence := .absent } + let initial : Frame := + { definition + block := helperId + pc := 0 + values := helperEntryValues site.shape.source parameters fields + credits := #[some credit] } + let advanced : Frame := + { initial with pc := 1, credits := #[none] } + let allocation := machine.store.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + let afterAllocation : Frame := + { advanced with + values := (helperEntryValues site.shape.source parameters fields).push + (.loc allocation.2) } + have helperResolved : resolveAtoms initial.values + site.candidate.allocationArguments = .ok newFields := by + apply resolveAllocationArguments site + (valuesRel_helperEntry parameterCount fieldCount site.fits.sourceBound) + simpa [initial] using allocationResolved + have creditAt : ({ initial with pc := initial.pc + 1 } : Frame).credits[0]? = + some (some credit) := by + simp [initial, credit] + have taken : CreditTake { initial with pc := initial.pc + 1 } 0 + advanced credit := by + have := CreditTake.of_lookup (CreditLookup.of_getElem creditAt) + simpa [initial, advanced, Array.setIfInBounds] using this + have allocationStep : Step context interpretation machine + { machine with + store := allocation.1 + control := .running afterAllocation stack } := by + have step := Step.allocWithAbsent + (context := context) (interpretation := interpretation) + (machine := machine) (frame := initial) (next := advanced) + (stack := stack) + (block := Reuse.creditBlock site.candidate + (.optional site.candidate.layout)) + (creditId := 0) (credit := credit) (world := .shared) + (cid := site.shape.allocationConstructor) + (arguments := site.candidate.allocationArguments) + (schema := allocationSchema) (values := newFields) + (by simpa [initial] using control) helperAt + (by simp [initial, site.creditBlock_eq]) + (by simp [initial, site.creditBlock_eq]) schemaAt helperResolved + fieldWorlds taken layout rfl + simpa [allocation, afterAllocation, advanced, initial, credit] using step + have helperTailResolved : resolveAtoms afterAllocation.values + site.candidate.tailArguments = .ok callValues := by + apply resolveTailArguments site + (valuesRel_afterAllocation parameterCount fieldCount + site.fits.sourceBound) + simpa [afterAllocation, advanced, initial, allocation] using tailResolved + have noCredits : NoLiveCredits afterAllocation := by + simp [NoLiveCredits, afterAllocation, advanced] + have tailStep : Step context interpretation + { machine with + store := allocation.1 + control := .running afterAllocation stack } + { machine with + store := allocation.1 + control := .running { definition, values := callValues } stack } := by + apply Step.tailCallSelfCleared + (frame := afterAllocation) (stack := stack) + (block := Reuse.creditBlock site.candidate + (.optional site.candidate.layout)) + (arguments := site.candidate.tailArguments) (values := callValues) + · rfl + · simpa [afterAllocation, advanced, initial] using helperAt + · simp [afterAllocation, advanced, Reuse.creditBlock] + · rfl + · exact noCredits + · exact helperTailResolved + · simpa [afterAllocation, advanced, initial] using arity + · simpa [afterAllocation, advanced, initial] using nonempty + have first := allocationStep.toSteps (by simpa [initial] using control) + have second := tailStep.toSteps (by rfl) + simpa [allocation] using first.trans second + +/-- A present logical credit records a reuse opportunity, performs the same +fresh semantic allocation as the baseline, and then enters the recursive +self call in exactly two steps. -/ +theorem logicalPresentHelperControl {limits : Validate.Limits} + {validation : Validate.Context} {sourceBlock : Block} + (site : Reuse.Site limits validation sourceBlock) + {context : Eval.Context} {definition : Function} {helperId : BlockId} + {parameters fields newFields callValues : Array RVal} + {allocationSchema : CtorSchema} {machine : Machine} + {stack : List Continuation} + (helperAt : definition.blocks[helperId]? = some + (Reuse.creditBlock site.candidate + (.required site.candidate.layout))) + (schemaAt : context.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (layout : site.candidate.layout = allocationSchema.layout) + (control : machine.control = .running + { definition + block := helperId + pc := 0 + values := helperEntryValues site.shape.source parameters fields + credits := #[some + { layout := site.candidate.layout + presence := .present none }] } stack) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (allocationResolved : resolveAtoms + (baselinePrefixValues parameters fields) + site.shape.allocationArguments = .ok newFields) + (fieldWorlds : FieldWorlds machine.store allocationSchema newFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc (machine.store.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields)).2)) + site.shape.tailArguments = .ok callValues) + (arity : callValues.size = definition.signature.params.size) + (nonempty : definition.blocks.isEmpty = false) : + let allocation := machine.store.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + Steps context .logical 2 machine + { machine with + store := allocation.1 + control := .running { definition, values := callValues } stack } := by + dsimp only + let credit : Credit := + { layout := site.candidate.layout, presence := .present none } + let initial : Frame := + { definition + block := helperId + pc := 0 + values := helperEntryValues site.shape.source parameters fields + credits := #[some credit] } + let advanced : Frame := + { initial with pc := 1, credits := #[none] } + let allocation := machine.store.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + let afterAllocation : Frame := + { advanced with + values := (helperEntryValues site.shape.source parameters fields).push + (.loc allocation.2) } + have helperResolved : resolveAtoms initial.values + site.candidate.allocationArguments = .ok newFields := by + apply resolveAllocationArguments site + (valuesRel_helperEntry parameterCount fieldCount site.fits.sourceBound) + simpa [initial] using allocationResolved + have creditAt : ({ initial with pc := initial.pc + 1 } : Frame).credits[0]? = + some (some credit) := by + simp [initial, credit] + have taken : CreditTake { initial with pc := initial.pc + 1 } 0 + advanced credit := by + have := CreditTake.of_lookup (CreditLookup.of_getElem creditAt) + simpa [initial, advanced, Array.setIfInBounds] using this + have allocationStep : Step context .logical machine + { machine with + store := allocation.1 + control := .running afterAllocation stack } := by + have step := Step.allocWithLogical + (context := context) (machine := machine) (frame := initial) + (next := advanced) (stack := stack) + (block := Reuse.creditBlock site.candidate + (.required site.candidate.layout)) + (creditId := 0) (credit := credit) (world := .shared) + (cid := site.shape.allocationConstructor) + (arguments := site.candidate.allocationArguments) + (schema := allocationSchema) (values := newFields) + (by simpa [initial] using control) helperAt + (by simp [initial, site.creditBlock_eq]) + (by simp [initial, site.creditBlock_eq]) schemaAt helperResolved + fieldWorlds taken layout rfl + simpa [allocation, afterAllocation, advanced, initial, credit] using step + have helperTailResolved : resolveAtoms afterAllocation.values + site.candidate.tailArguments = .ok callValues := by + apply resolveTailArguments site + (valuesRel_afterAllocation parameterCount fieldCount + site.fits.sourceBound) + simpa [afterAllocation, advanced, initial, allocation] using tailResolved + have noCredits : NoLiveCredits afterAllocation := by + simp [NoLiveCredits, afterAllocation, advanced] + have tailStep : Step context .logical + { machine with + store := allocation.1 + control := .running afterAllocation stack } + { machine with + store := allocation.1 + control := .running { definition, values := callValues } stack } := by + apply Step.tailCallSelfCleared + (frame := afterAllocation) (stack := stack) + (block := Reuse.creditBlock site.candidate + (.required site.candidate.layout)) + (arguments := site.candidate.tailArguments) (values := callValues) + · rfl + · simpa [afterAllocation, advanced, initial] using helperAt + · simp [afterAllocation, advanced, Reuse.creditBlock] + · rfl + · exact noCredits + · exact helperTailResolved + · simpa [afterAllocation, advanced, initial] using arity + · simpa [afterAllocation, advanced, initial] using nonempty + have first := allocationStep.toSteps (by simpa [initial] using control) + have second := tailStep.toSteps (by rfl) + simpa [allocation] using first.trans second + +/-- The accepted logical hot arm reaches its recursive self call in four +genuine steps: reset, credit branch, fresh allocation, and tail call. -/ +theorem hotLogicalAcceptedControl {limits : Validate.Limits} + {validation : Validate.Context} {sourceBlock : Block} + (site : Reuse.Site limits validation sourceBlock) + {context : Eval.Context} {definition : Function} + {resetId hotId coldId : BlockId} + {parameters fields newFields callValues : Array RVal} + {location : Nat} {box : IxIR1.NodeBox} + {sourceSchema allocationSchema : CtorSchema} {machine : Machine} + {stack : List Continuation} + (resetAt : definition.blocks[resetId]? = + some (Reuse.resetBlock site.candidate hotId coldId)) + (hotAt : definition.blocks[hotId]? = some + (Reuse.creditBlock site.candidate + (.required site.candidate.layout))) + (sourceSchemaAt : context.schemas .shared site.shape.sourceConstructor = + some sourceSchema) + (allocationSchemaAt : + context.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (sourceLayout : site.candidate.layout = sourceSchema.layout) + (allocationLayout : site.candidate.layout = allocationSchema.layout) + (control : machine.control = .running + { definition + block := resetId + pc := 0 + values := parameters + credits := #[] } stack) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (sourceResolved : resolveAtom parameters (.reg site.shape.source) = + .ok (.loc location)) + (viewed : ConstructorView machine.store location .shared + site.shape.sourceConstructor box fields) + (unitRC : box.rc = 1) + (allocationResolved : resolveAtoms + (baselinePrefixValues parameters fields) + site.shape.allocationArguments = .ok newFields) + (fieldWorlds : FieldWorlds + (((machine.store.tickResetAttempt).kill location).tickHotReset) + allocationSchema newFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc ((((machine.store.tickResetAttempt).kill location).tickHotReset + ).allocNode .shared + (.ctorN site.shape.allocationConstructor newFields)).2)) + site.shape.tailArguments = .ok callValues) + (arity : callValues.size = definition.signature.params.size) + (nonempty : definition.blocks.isEmpty = false) : + let resetStore := + ((machine.store.tickResetAttempt).kill location).tickHotReset + let allocation := resetStore.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + Steps context .logical 4 machine + { machine with + store := allocation.1 + control := .running { definition, values := callValues } stack } := by + dsimp only + let resetStore := + ((machine.store.tickResetAttempt).kill location).tickHotReset + let helperMachine : Machine := + { machine with + store := resetStore + control := .running + { definition + block := hotId + pc := 0 + values := helperEntryValues site.shape.source parameters fields + credits := #[some + { layout := site.candidate.layout + presence := .present none }] } + stack } + let allocation := resetStore.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + have prefixSteps : Steps context .logical 2 machine helperMachine := by + simpa [helperMachine, resetStore, sourceLayout] using + hotLogicalControlPrefix site resetAt hotAt sourceSchemaAt control + parameterCount fieldCount sourceResolved viewed unitRC + have helperSteps : Steps context .logical 2 helperMachine + { helperMachine with + store := allocation.1 + control := .running { definition, values := callValues } stack } := by + simpa [helperMachine, allocation, resetStore] using + logicalPresentHelperControl site (machine := helperMachine) hotAt + allocationSchemaAt allocationLayout (by rfl) parameterCount fieldCount + allocationResolved (by simpa [helperMachine, resetStore] using + fieldWorlds) + (by simpa [helperMachine, allocation, resetStore] using tailResolved) + arity nonempty + simpa [helperMachine, allocation, resetStore] using + prefixSteps.trans helperSteps + +/-- The accepted cold arm reaches its recursive self call in four genuine +steps under either credit interpretation. -/ +theorem coldAcceptedControl {limits : Validate.Limits} + {validation : Validate.Context} {sourceBlock : Block} + (site : Reuse.Site limits validation sourceBlock) + {context : Eval.Context} {interpretation : Interpretation} + {definition : Function} {resetId hotId coldId : BlockId} + {parameters fields newFields callValues : Array RVal} + {location : Nat} {box : IxIR1.NodeBox} + {sourceSchema allocationSchema : CtorSchema} {machine : Machine} + {resetStore : Store} {stack : List Continuation} + (resetAt : definition.blocks[resetId]? = + some (Reuse.resetBlock site.candidate hotId coldId)) + (coldAt : definition.blocks[coldId]? = some + (Reuse.creditBlock site.candidate + (.optional site.candidate.layout))) + (sourceSchemaAt : context.schemas .shared site.shape.sourceConstructor = + some sourceSchema) + (allocationSchemaAt : + context.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (sourceLayout : site.candidate.layout = sourceSchema.layout) + (allocationLayout : site.candidate.layout = allocationSchema.layout) + (control : machine.control = .running + { definition + block := resetId + pc := 0 + values := parameters + credits := #[] } stack) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (sourceResolved : resolveAtom parameters (.reg site.shape.source) = + .ok (.loc location)) + (viewed : ConstructorView machine.store location .shared + site.shape.sourceConstructor box fields) + (shared : 1 < box.rc) + (retained : RetainSharedMany + ((((machine.store.tickResetAttempt).setBox location + { box with rc := box.rc - 1 }).rcTick).tickColdReset) + fields resetStore) + (allocationResolved : resolveAtoms + (baselinePrefixValues parameters fields) + site.shape.allocationArguments = .ok newFields) + (fieldWorlds : FieldWorlds resetStore allocationSchema newFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc (resetStore.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields)).2)) + site.shape.tailArguments = .ok callValues) + (arity : callValues.size = definition.signature.params.size) + (nonempty : definition.blocks.isEmpty = false) : + let allocation := resetStore.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + Steps context interpretation 4 machine + { machine with + store := allocation.1 + control := .running { definition, values := callValues } stack } := by + dsimp only + let helperMachine : Machine := + { machine with + store := resetStore + control := .running + { definition + block := coldId + pc := 0 + values := helperEntryValues site.shape.source parameters fields + credits := #[some + { layout := site.candidate.layout + presence := .absent }] } + stack } + let allocation := resetStore.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + have prefixSteps : Steps context interpretation 2 machine helperMachine := by + simpa [helperMachine, sourceLayout] using + coldControlPrefix site resetAt coldAt sourceSchemaAt control + parameterCount fieldCount sourceResolved viewed shared retained + have helperSteps : Steps context interpretation 2 helperMachine + { helperMachine with + store := allocation.1 + control := .running { definition, values := callValues } stack } := by + simpa [helperMachine, allocation] using + absentHelperControl site (machine := helperMachine) coldAt + allocationSchemaAt allocationLayout (by rfl) parameterCount fieldCount + allocationResolved (by simpa [helperMachine] using fieldWorlds) + (by simpa [helperMachine, allocation] using tailResolved) + arity nonempty + simpa [helperMachine, allocation] using prefixSteps.trans helperSteps + +/-- A present physical credit rewrites the reserved source slot and then +enters the recursive self call in exactly two steps. Unlike the logical +theorem, the tail operands are stated in the physical register file: relating +its reused location to the baseline's fresh location is the heap-isomorphism +obligation of the surrounding simulation. -/ +theorem physicalPresentHelperControl {limits : Validate.Limits} + {validation : Validate.Context} {sourceBlock : Block} + (site : Reuse.Site limits validation sourceBlock) + {context : Eval.Context} {definition : Function} {helperId : BlockId} + {parameters fields newFields callValues : Array RVal} + {allocationSchema : CtorSchema} {machine : Machine} + {stack : List Continuation} {location : Nat} {store : Store} + (helperAt : definition.blocks[helperId]? = some + (Reuse.creditBlock site.candidate + (.required site.candidate.layout))) + (schemaAt : context.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (layout : site.candidate.layout = allocationSchema.layout) + (control : machine.control = .running + { definition + block := helperId + pc := 0 + values := helperEntryValues site.shape.source parameters fields + credits := #[some + { layout := site.candidate.layout + presence := .present (some location) }] } stack) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (allocationResolved : resolveAtoms + (baselinePrefixValues parameters fields) + site.shape.allocationArguments = .ok newFields) + (fieldWorlds : FieldWorlds machine.store allocationSchema newFields) + (reused : machine.store.reuseReservation location .shared + (.ctorN site.shape.allocationConstructor newFields) + allocationSchema.fields.size = .ok store) + (tailResolved : resolveAtoms + ((helperEntryValues site.shape.source parameters fields).push + (.loc location)) + site.candidate.tailArguments = .ok callValues) + (arity : callValues.size = definition.signature.params.size) + (nonempty : definition.blocks.isEmpty = false) : + Steps context .physical 2 machine + { machine with + store + control := .running { definition, values := callValues } stack } := by + let credit : Credit := + { layout := site.candidate.layout, + presence := .present (some location) } + let initial : Frame := + { definition + block := helperId + pc := 0 + values := helperEntryValues site.shape.source parameters fields + credits := #[some credit] } + let advanced : Frame := + { initial with pc := 1, credits := #[none] } + let afterAllocation : Frame := + { advanced with + values := (helperEntryValues site.shape.source parameters fields).push + (.loc location) } + have helperResolved : resolveAtoms initial.values + site.candidate.allocationArguments = .ok newFields := by + apply resolveAllocationArguments site + (valuesRel_helperEntry parameterCount fieldCount site.fits.sourceBound) + simpa [initial] using allocationResolved + have creditAt : ({ initial with pc := initial.pc + 1 } : Frame).credits[0]? = + some (some credit) := by + simp [initial, credit] + have taken : CreditTake { initial with pc := initial.pc + 1 } 0 + advanced credit := by + have := CreditTake.of_lookup (CreditLookup.of_getElem creditAt) + simpa [initial, advanced, Array.setIfInBounds] using this + have allocationStep : Step context .physical machine + { machine with + store + control := .running afterAllocation stack } := by + have step := Step.allocWithPhysical + (context := context) (machine := machine) (frame := initial) + (next := advanced) (stack := stack) + (block := Reuse.creditBlock site.candidate + (.required site.candidate.layout)) + (creditId := 0) (credit := credit) (world := .shared) + (cid := site.shape.allocationConstructor) + (arguments := site.candidate.allocationArguments) + (schema := allocationSchema) (values := newFields) + (location := location) (store := store) + (by simpa [initial] using control) helperAt + (by simp [initial, site.creditBlock_eq]) + (by simp [initial, site.creditBlock_eq]) schemaAt helperResolved + fieldWorlds taken layout rfl reused + simpa [afterAllocation, advanced, initial, credit] using step + have noCredits : NoLiveCredits afterAllocation := by + simp [NoLiveCredits, afterAllocation, advanced] + have tailStep : Step context .physical + { machine with + store + control := .running afterAllocation stack } + { machine with + store + control := .running { definition, values := callValues } stack } := by + apply Step.tailCallSelfCleared + (frame := afterAllocation) (stack := stack) + (block := Reuse.creditBlock site.candidate + (.required site.candidate.layout)) + (arguments := site.candidate.tailArguments) (values := callValues) + · rfl + · simpa [afterAllocation, advanced, initial] using helperAt + · simp [afterAllocation, advanced, Reuse.creditBlock] + · rfl + · exact noCredits + · simpa [afterAllocation, advanced, initial] using tailResolved + · simpa [afterAllocation, advanced, initial] using arity + · simpa [afterAllocation, advanced, initial] using nonempty + have first := allocationStep.toSteps (by simpa [initial] using control) + have second := tailStep.toSteps (by rfl) + simpa using first.trans second + +/-- Physical helper execution transported from baseline tail resolution. +The recursive argument vectors are related by the post-reuse heap +isomorphism rather than equated. -/ +theorem physicalPresentHelperControlIso {limits : Validate.Limits} + {validation : Validate.Context} {sourceBlock : Block} + (site : Reuse.Site limits validation sourceBlock) + {context : Eval.Context} {definition : Function} {helperId : BlockId} + {parameters fields newFields baselineCallValues : Array RVal} + {allocationSchema : CtorSchema} {machine : Machine} + {stack : List Continuation} {location baselineLocation : Nat} + {store : Store} {baselineHeap : IxIR1.Store} + (helperAt : definition.blocks[helperId]? = some + (Reuse.creditBlock site.candidate + (.required site.candidate.layout))) + (schemaAt : context.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (layout : site.candidate.layout = allocationSchema.layout) + (control : machine.control = .running + { definition + block := helperId + pc := 0 + values := helperEntryValues site.shape.source parameters fields + credits := #[some + { layout := site.candidate.layout + presence := .present (some location) }] } stack) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (allocationResolved : resolveAtoms + (baselinePrefixValues parameters fields) + site.shape.allocationArguments = .ok newFields) + (fieldWorlds : FieldWorlds machine.store allocationSchema newFields) + (reused : machine.store.reuseReservation location .shared + (.ctorN site.shape.allocationConstructor newFields) + allocationSchema.fields.size = .ok store) + (iso : IxIR1.Sim.HeapIso store.heap baselineHeap) + (selfRelated : ∀ (sourceId targetId : Nat) (sourceValue : RVal), + PlannerValueRelevant site.shape sourceId → + translateRegister? site.shape sourceId = some targetId → + (baselinePrefixValues parameters fields)[sourceId]? = + some sourceValue → + IxIR1.Sim.RValIso (fun baseline physical => + iso.locRel physical baseline) sourceValue sourceValue) + (resultRelated : iso.locRel location baselineLocation) + (tailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc baselineLocation)) + site.shape.tailArguments = .ok baselineCallValues) + (arity : baselineCallValues.size = definition.signature.params.size) + (nonempty : definition.blocks.isEmpty = false) : + ∃ physicalCallValues, + Steps context .physical 2 machine + { machine with + store + control := .running + { definition, values := physicalCallValues } stack } ∧ + IxIR1.Sim.RValsIso (fun baseline physical => + iso.locRel physical baseline) + baselineCallValues.toList physicalCallValues.toList := by + have registerRelation : TranslatedValuesIso site.shape + (fun baseline physical => iso.locRel physical baseline) + ((baselinePrefixValues parameters fields).push + (.loc baselineLocation)) + ((helperEntryValues site.shape.source parameters fields).push + (.loc location)) := + translatedValuesIso_afterAllocation parameterCount fieldCount + site.fits.sourceBound selfRelated (.loc resultRelated) + obtain ⟨physicalCallValues, physicalTailResolved, callsRelated⟩ := + resolveTailArguments_iso site registerRelation tailResolved + have sizeEq : baselineCallValues.size = physicalCallValues.size := by + simpa using rvalsIso_length_eq callsRelated + have physicalArity : physicalCallValues.size = + definition.signature.params.size := sizeEq.symm.trans arity + refine ⟨physicalCallValues, ?_, callsRelated⟩ + exact physicalPresentHelperControl site helperAt schemaAt layout control + parameterCount fieldCount allocationResolved fieldWorlds reused + physicalTailResolved physicalArity nonempty + +/-- Physical helper execution from an arbitrary translated baseline register +file. Unlike `physicalPresentHelperControlIso`, this interface does not +require the preserved operands to be literally equal on both sides, so it can +consume a location relation inherited from an earlier physical reuse. -/ +theorem physicalPresentHelperControlTranslated {limits : Validate.Limits} + {validation : Validate.Context} {sourceBlock : Block} + (site : Reuse.Site limits validation sourceBlock) + {context : Eval.Context} {definition : Function} {helperId : BlockId} + {parameters fields newFields baselineTailValues baselineCallValues : + Array RVal} + {allocationSchema : CtorSchema} {machine : Machine} + {stack : List Continuation} {location : Nat} + {store : Store} {locRel : Nat → Nat → Prop} + (helperAt : definition.blocks[helperId]? = some + (Reuse.creditBlock site.candidate + (.required site.candidate.layout))) + (schemaAt : context.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (layout : site.candidate.layout = allocationSchema.layout) + (control : machine.control = .running + { definition + block := helperId + pc := 0 + values := helperEntryValues site.shape.source parameters fields + credits := #[some + { layout := site.candidate.layout + presence := .present (some location) }] } stack) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (allocationResolved : resolveAtoms + (baselinePrefixValues parameters fields) + site.shape.allocationArguments = .ok newFields) + (fieldWorlds : FieldWorlds machine.store allocationSchema newFields) + (reused : machine.store.reuseReservation location .shared + (.ctorN site.shape.allocationConstructor newFields) + allocationSchema.fields.size = .ok store) + (registerRelation : TranslatedValuesIso site.shape locRel + baselineTailValues + ((helperEntryValues site.shape.source parameters fields).push + (.loc location))) + (tailResolved : resolveAtoms baselineTailValues + site.shape.tailArguments = .ok baselineCallValues) + (arity : baselineCallValues.size = definition.signature.params.size) + (nonempty : definition.blocks.isEmpty = false) : + ∃ physicalCallValues, + Steps context .physical 2 machine + { machine with + store + control := .running + { definition, values := physicalCallValues } stack } ∧ + IxIR1.Sim.RValsIso locRel baselineCallValues.toList + physicalCallValues.toList := by + obtain ⟨physicalCallValues, physicalTailResolved, callsRelated⟩ := + resolveTailArguments_iso site registerRelation tailResolved + have sizeEq : baselineCallValues.size = physicalCallValues.size := by + simpa using rvalsIso_length_eq callsRelated + have physicalArity : physicalCallValues.size = + definition.signature.params.size := sizeEq.symm.trans arity + refine ⟨physicalCallValues, ?_, callsRelated⟩ + exact physicalPresentHelperControl site helperAt schemaAt layout control + parameterCount fieldCount allocationResolved fieldWorlds reused + physicalTailResolved physicalArity nonempty + +/-- The accepted physical hot arm reaches a recursively related call in four +genuine target steps: reset, credit branch, reserved-slot allocation, and +self tail call. -/ +theorem hotPhysicalAcceptedControlIso {limits : Validate.Limits} + {validation : Validate.Context} {sourceBlock : Block} + (site : Reuse.Site limits validation sourceBlock) + {context : Eval.Context} {definition : Function} + {resetId hotId coldId : BlockId} + {parameters fields newFields baselineCallValues : Array RVal} + {location baselineLocation : Nat} {box : IxIR1.NodeBox} + {sourceSchema allocationSchema : CtorSchema} {machine : Machine} + {stack : List Continuation} {store : Store} + {baselineHeap : IxIR1.Store} + (resetAt : definition.blocks[resetId]? = + some (Reuse.resetBlock site.candidate hotId coldId)) + (hotAt : definition.blocks[hotId]? = some + (Reuse.creditBlock site.candidate + (.required site.candidate.layout))) + (sourceSchemaAt : context.schemas .shared site.shape.sourceConstructor = + some sourceSchema) + (allocationSchemaAt : + context.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (sourceLayout : site.candidate.layout = sourceSchema.layout) + (allocationLayout : site.candidate.layout = allocationSchema.layout) + (control : machine.control = .running + { definition + block := resetId + pc := 0 + values := parameters + credits := #[] } stack) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (sourceResolved : resolveAtom parameters (.reg site.shape.source) = + .ok (.loc location)) + (viewed : ConstructorView machine.store location .shared + site.shape.sourceConstructor box fields) + (unitRC : box.rc = 1) + (allocationResolved : resolveAtoms + (baselinePrefixValues parameters fields) + site.shape.allocationArguments = .ok newFields) + (fieldWorlds : FieldWorlds + (((machine.store.tickResetAttempt).reserve location).tickHotReset) + allocationSchema newFields) + (reused : Eval.Store.reuseReservation + (((machine.store.tickResetAttempt).reserve location).tickHotReset) + location .shared + (.ctorN site.shape.allocationConstructor newFields) + allocationSchema.fields.size = Except.ok store) + (iso : IxIR1.Sim.HeapIso store.heap baselineHeap) + (selfRelated : ∀ (sourceId targetId : Nat) (sourceValue : RVal), + PlannerValueRelevant site.shape sourceId → + translateRegister? site.shape sourceId = some targetId → + (baselinePrefixValues parameters fields)[sourceId]? = + some sourceValue → + IxIR1.Sim.RValIso (fun baseline physical => + iso.locRel physical baseline) sourceValue sourceValue) + (resultRelated : iso.locRel location baselineLocation) + (tailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc baselineLocation)) + site.shape.tailArguments = .ok baselineCallValues) + (arity : baselineCallValues.size = definition.signature.params.size) + (nonempty : definition.blocks.isEmpty = false) : + ∃ physicalCallValues, + Steps context .physical 4 machine + { machine with + store + control := .running + { definition, values := physicalCallValues } stack } ∧ + IxIR1.Sim.RValsIso (fun baseline physical => + iso.locRel physical baseline) + baselineCallValues.toList physicalCallValues.toList := by + let helperMachine : Machine := + { machine with + store := ((machine.store.tickResetAttempt).reserve location).tickHotReset + control := .running + { definition + block := hotId + pc := 0 + values := helperEntryValues site.shape.source parameters fields + credits := #[some + { layout := site.candidate.layout + presence := .present (some location) }] } + stack } + have prefixSteps : Steps context .physical 2 machine helperMachine := by + simpa [helperMachine, sourceLayout] using + hotPhysicalControlPrefix site resetAt hotAt sourceSchemaAt control + parameterCount fieldCount sourceResolved viewed unitRC + obtain ⟨physicalCallValues, helperSteps, callsRelated⟩ := + physicalPresentHelperControlIso site + (machine := helperMachine) (store := store) + (baselineHeap := baselineHeap) hotAt allocationSchemaAt + allocationLayout (by rfl) parameterCount fieldCount + allocationResolved (by simpa [helperMachine] using fieldWorlds) + (by simpa [helperMachine] using reused) iso selfRelated resultRelated + tailResolved arity nonempty + refine ⟨physicalCallValues, ?_, callsRelated⟩ + simpa [helperMachine] using prefixSteps.trans helperSteps + +/-- Four-step physical accepted execution from an arbitrary translated +baseline tail register file. This is the control half of composing physical +reuse with an already-isomorphic input state. -/ +theorem hotPhysicalAcceptedControlTranslated {limits : Validate.Limits} + {validation : Validate.Context} {sourceBlock : Block} + (site : Reuse.Site limits validation sourceBlock) + {context : Eval.Context} {definition : Function} + {resetId hotId coldId : BlockId} + {parameters fields newFields baselineTailValues baselineCallValues : + Array RVal} + {location : Nat} {box : IxIR1.NodeBox} + {sourceSchema allocationSchema : CtorSchema} {machine : Machine} + {stack : List Continuation} {store : Store} + {locRel : Nat → Nat → Prop} + (resetAt : definition.blocks[resetId]? = + some (Reuse.resetBlock site.candidate hotId coldId)) + (hotAt : definition.blocks[hotId]? = some + (Reuse.creditBlock site.candidate + (.required site.candidate.layout))) + (sourceSchemaAt : context.schemas .shared site.shape.sourceConstructor = + some sourceSchema) + (allocationSchemaAt : + context.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (sourceLayout : site.candidate.layout = sourceSchema.layout) + (allocationLayout : site.candidate.layout = allocationSchema.layout) + (control : machine.control = .running + { definition + block := resetId + pc := 0 + values := parameters + credits := #[] } stack) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (sourceResolved : resolveAtom parameters (.reg site.shape.source) = + .ok (.loc location)) + (viewed : ConstructorView machine.store location .shared + site.shape.sourceConstructor box fields) + (unitRC : box.rc = 1) + (allocationResolved : resolveAtoms + (baselinePrefixValues parameters fields) + site.shape.allocationArguments = .ok newFields) + (fieldWorlds : FieldWorlds + (((machine.store.tickResetAttempt).reserve location).tickHotReset) + allocationSchema newFields) + (reused : Eval.Store.reuseReservation + (((machine.store.tickResetAttempt).reserve location).tickHotReset) + location .shared + (.ctorN site.shape.allocationConstructor newFields) + allocationSchema.fields.size = Except.ok store) + (registerRelation : TranslatedValuesIso site.shape locRel + baselineTailValues + ((helperEntryValues site.shape.source parameters fields).push + (.loc location))) + (tailResolved : resolveAtoms baselineTailValues + site.shape.tailArguments = .ok baselineCallValues) + (arity : baselineCallValues.size = definition.signature.params.size) + (nonempty : definition.blocks.isEmpty = false) : + ∃ physicalCallValues, + Steps context .physical 4 machine + { machine with + store + control := .running + { definition, values := physicalCallValues } stack } ∧ + IxIR1.Sim.RValsIso locRel baselineCallValues.toList + physicalCallValues.toList := by + let helperMachine : Machine := + { machine with + store := ((machine.store.tickResetAttempt).reserve location).tickHotReset + control := .running + { definition + block := hotId + pc := 0 + values := helperEntryValues site.shape.source parameters fields + credits := #[some + { layout := site.candidate.layout + presence := .present (some location) }] } + stack } + have prefixSteps : Steps context .physical 2 machine helperMachine := by + simpa [helperMachine, sourceLayout] using + hotPhysicalControlPrefix site resetAt hotAt sourceSchemaAt control + parameterCount fieldCount sourceResolved viewed unitRC + obtain ⟨physicalCallValues, helperSteps, callsRelated⟩ := + physicalPresentHelperControlTranslated site + (machine := helperMachine) (store := store) hotAt allocationSchemaAt + allocationLayout (by rfl) parameterCount fieldCount allocationResolved + (by simpa [helperMachine] using fieldWorlds) + (by simpa [helperMachine] using reused) registerRelation tailResolved + arity nonempty + refine ⟨physicalCallValues, ?_, callsRelated⟩ + simpa [helperMachine] using prefixSteps.trans helperSteps + +/-! ## Recognized baseline-block control -/ + +/-- Values after fetching the first `count` constructor fields. -/ +def fetchedPrefixValues (parameters fields : Array RVal) (count : Nat) : + Array RVal := + parameters ++ (fields.toList.take count).toArray + +private theorem fetchedPrefixValues_succ {parameters fields : Array RVal} + {count : Nat} (bound : count < fields.size) : + (fetchedPrefixValues parameters fields count).push fields[count] = + fetchedPrefixValues parameters fields (count + 1) := by + apply Array.toList_inj.mp + simp only [fetchedPrefixValues, Array.toList_push, Array.toList_append] + rw [← List.take_append_getElem (l := fields.toList) + (i := count) (by simpa using bound)] + simp [List.append_assoc] + +/-- Execute all recognized fetches from an accepted baseline block. -/ +theorem fetchPrefixControl {limits : Validate.Limits} + {validation : Validate.Context} {block : Block} + (site : Reuse.Site limits validation block) + {context : Eval.Context} {interpretation : Interpretation} + {definition : Function} {blockId : BlockId} + {parameters fields : Array RVal} {location : Nat} + {box : IxIR1.NodeBox} {machine : Machine} + {stack : List Continuation} + (blockAt : definition.blocks[blockId]? = some block) + (control : machine.control = .running + { definition + block := blockId + pc := 0 + values := parameters + credits := #[] } stack) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (sourceResolved : resolveAtom parameters (.reg site.shape.source) = + .ok (.loc location)) + (boxAt : machine.store.get? location = some box) + (node : box.node = .ctorN site.shape.sourceConstructor fields) : + Steps context interpretation site.shape.fieldCount machine + { machine with + control := .running + { definition + block := blockId + pc := site.shape.fieldCount + values := parameters ++ fields + credits := #[] } + stack } := by + have loop : ∀ count, count ≤ site.shape.fieldCount → + Steps context interpretation count machine + { machine with + control := .running + { definition + block := blockId + pc := count + values := fetchedPrefixValues parameters fields count + credits := #[] } + stack } := by + intro count countLe + induction count with + | zero => + simpa [fetchedPrefixValues, ← control] using Steps.refl machine + | succ count ih => + have countBound : count < site.shape.fieldCount := by omega + have prefixSteps := ih (by omega) + let before : Machine := + { machine with + control := .running + { definition + block := blockId + pc := count + values := fetchedPrefixValues parameters fields count + credits := #[] } + stack } + have instructionAt := site.fits.fetches count countBound + obtain ⟨pcBound, instruction⟩ := + Array.getElem?_eq_some_iff.mp instructionAt + have resolved : resolveAtom + (fetchedPrefixValues parameters fields count) + (.reg site.shape.source) = .ok (.loc location) := by + simpa [fetchedPrefixValues, resolveAtom, + Array.getElem?_append, parameterCount, + site.fits.sourceBound] using sourceResolved + have fieldBound : count < fields.size := by + simpa [fieldCount] using countBound + have fieldAt : fields[count]? = some fields[count] := + Array.getElem?_eq_some_iff.mpr ⟨fieldBound, rfl⟩ + have step : Step context interpretation before + { before with + control := .running + { definition + block := blockId + pc := count + 1 + values := fetchedPrefixValues parameters fields (count + 1) + credits := #[] } + stack } := by + have fetched := Step.fetch + (context := context) (interpretation := interpretation) + (machine := before) + (frame := + { definition + block := blockId + pc := count + values := fetchedPrefixValues parameters fields count + credits := #[] }) + (stack := stack) (block := block) + (atom := .reg site.shape.source) + (cid := site.shape.sourceConstructor) (field := count) + (location := location) (box := box) (fields := fields) + (value := fields[count]) rfl blockAt pcBound instruction resolved + (by simpa [before] using boxAt) node fieldAt + simpa [fetchedPrefixValues_succ fieldBound] using fetched + have one := step.toSteps (by rfl) + simpa [before, Nat.succ_eq_add_one] using prefixSteps.trans one + have result := loop site.shape.fieldCount (Nat.le_refl _) + have allFields : (fields.toList.take site.shape.fieldCount).toArray = + fields := by + rw [← fieldCount] + change (fields.toList.take fields.toList.length).toArray = fields + rw [List.take_length] + simpa [fetchedPrefixValues, allFields] using result + +private theorem retainedPrefix_push {parameters fields : Array RVal} + (processed : List RVal) (value : RVal) : + (parameters ++ fields ++ processed.toArray).push value = + parameters ++ fields ++ (processed ++ [value]).toArray := by + apply Array.toList_inj.mp + simp + +private theorem retainSuffixControl {limits : Validate.Limits} + {validation : Validate.Context} {block : Block} + (site : Reuse.Site limits validation block) + {context : Eval.Context} {interpretation : Interpretation} + {definition : Function} {blockId : BlockId} + {parameters fields : Array RVal} {processed remaining : List RVal} + {startStore finalStore : Store} {heapFuel : Nat} + {stack : List Continuation} + (blockAt : definition.blocks[blockId]? = some block) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (split : fields.toList = processed ++ remaining) + (retained : RetainSharedMany startStore remaining.toArray finalStore) : + Steps context interpretation remaining.length + { store := startStore + heapFuel + control := .running + { definition + block := blockId + pc := site.shape.fieldCount + processed.length + values := parameters ++ fields ++ processed.toArray + credits := #[] } + stack } + { store := finalStore + heapFuel + control := .running + { definition + block := blockId + pc := site.shape.fieldCount + (processed ++ remaining).length + values := parameters ++ fields ++ + (processed ++ remaining).toArray + credits := #[] } + stack } := by + induction remaining generalizing processed startStore with + | nil => + change (.ok startStore : Except Error Store) = .ok finalStore at retained + have storeEq := Except.ok.inj retained + subst finalStore + simpa using (Steps.refl + ({ store := startStore + heapFuel + control := .running + { definition + block := blockId + pc := site.shape.fieldCount + processed.length + values := parameters ++ fields ++ processed.toArray + credits := #[] } + stack } : Machine)) + | cons value remaining ih => + obtain ⟨middle, headRetained, tailRetained⟩ := + RetainSharedMany.cons_inv retained + have fieldIndexBound : processed.length < site.shape.fieldCount := by + have lengths := congrArg List.length split + simp only [List.length_append, List.length_cons] at lengths + have fieldsLength : fields.toList.length = site.shape.fieldCount := by + simp [fieldCount] + omega + have fieldAt : fields[processed.length]? = some value := by + rw [Array.getElem?_eq_some_iff] + refine ⟨?_, ?_⟩ + · simpa [fieldCount] using fieldIndexBound + · have listAt : fields.toList[processed.length]? = some value := by + rw [split, List.getElem?_append_right (Nat.le_refl _)] + simp + exact Option.some.inj + ((List.getElem?_eq_getElem (l := fields.toList) + (i := processed.length) (by simpa [fieldCount] using + fieldIndexBound)).symm.trans listAt) + have fieldEq : fields[processed.length] = value := + (Array.getElem?_eq_some_iff.mp fieldAt).2 + have resolved : resolveAtom + (parameters ++ fields ++ processed.toArray) + (.reg (site.shape.parameterCount + processed.length)) = + .ok value := by + simp [resolveAtom, Array.getElem?_append, parameterCount, + fieldCount, fieldIndexBound, fieldEq, + show ¬site.shape.parameterCount + processed.length < + site.shape.parameterCount by omega] + have instructionAt := site.fits.retains processed.length fieldIndexBound + obtain ⟨pcBound, instruction⟩ := + Array.getElem?_eq_some_iff.mp instructionAt + let before : Machine := + { store := startStore + heapFuel + control := .running + { definition + block := blockId + pc := site.shape.fieldCount + processed.length + values := parameters ++ fields ++ processed.toArray + credits := #[] } + stack } + let afterHead : Machine := + { store := middle + heapFuel + control := .running + { definition + block := blockId + pc := site.shape.fieldCount + (processed ++ [value]).length + values := parameters ++ fields ++ + (processed ++ [value]).toArray + credits := #[] } + stack } + have headStep : Step context interpretation before afterHead := by + have step := Step.retainShared + (context := context) (interpretation := interpretation) + (machine := before) + (frame := + { definition + block := blockId + pc := site.shape.fieldCount + processed.length + values := parameters ++ fields ++ processed.toArray + credits := #[] }) + (stack := stack) (block := block) + (atom := .reg (site.shape.parameterCount + processed.length)) + (value := value) (store := middle) rfl blockAt pcBound instruction + resolved headRetained + simpa [before, afterHead, retainedPrefix_push, List.length_append, + Nat.add_assoc] using step + have tailSteps := ih (processed := processed ++ [value]) + (startStore := middle) (by simpa [List.append_assoc] using split) + tailRetained + have one := headStep.toSteps (by rfl) + simpa [before, afterHead, List.append_assoc, Nat.add_comm] using + one.trans tailSteps + +/-- Execute every recognized retain after all fields have been fetched. -/ +theorem retainPrefixControl {limits : Validate.Limits} + {validation : Validate.Context} {block : Block} + (site : Reuse.Site limits validation block) + {context : Eval.Context} {interpretation : Interpretation} + {definition : Function} {blockId : BlockId} + {parameters fields : Array RVal} {store retainedStore : Store} + {heapFuel : Nat} {stack : List Continuation} + (blockAt : definition.blocks[blockId]? = some block) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (retained : RetainSharedMany store fields retainedStore) : + Steps context interpretation site.shape.fieldCount + { store + heapFuel + control := .running + { definition + block := blockId + pc := site.shape.fieldCount + values := parameters ++ fields + credits := #[] } + stack } + { store := retainedStore + heapFuel + control := .running + { definition + block := blockId + pc := 2 * site.shape.fieldCount + values := baselinePrefixValues parameters fields + credits := #[] } + stack } := by + have steps := retainSuffixControl site + (context := context) (interpretation := interpretation) + (definition := definition) (blockId := blockId) + (parameters := parameters) (fields := fields) + (processed := []) (remaining := fields.toList) + (startStore := store) (finalStore := retainedStore) + (heapFuel := heapFuel) (stack := stack) blockAt parameterCount + fieldCount (by simp) (by simpa using retained) + simpa [baselinePrefixValues, fieldCount, Nat.two_mul, + Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using steps + +/-- Execute the entire arbitrary-arity baseline block recognized at an +accepted reuse site. -/ +theorem baselineAcceptedControl {limits : Validate.Limits} + {validation : Validate.Context} {block : Block} + (site : Reuse.Site limits validation block) + {context : Eval.Context} {interpretation : Interpretation} + {definition : Function} {blockId : BlockId} + {parameters fields newFields callValues : Array RVal} + {location : Nat} {box : IxIR1.NodeBox} {machine : Machine} + {retainedStore releasedStore : Store} {remaining : Nat} + {allocationSchema : CtorSchema} {stack : List Continuation} + (blockAt : definition.blocks[blockId]? = some block) + (control : machine.control = .running + { definition + block := blockId + pc := 0 + values := parameters + credits := #[] } stack) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (sourceResolved : resolveAtom parameters (.reg site.shape.source) = + .ok (.loc location)) + (boxAt : machine.store.get? location = some box) + (node : box.node = .ctorN site.shape.sourceConstructor fields) + (retained : RetainSharedMany machine.store fields retainedStore) + (released : releaseShared machine.heapFuel retainedStore (.loc location) = + .ok (releasedStore, remaining)) + (schemaAt : context.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (allocationResolved : resolveAtoms + (baselinePrefixValues parameters fields) + site.shape.allocationArguments = .ok newFields) + (fieldWorlds : FieldWorlds releasedStore allocationSchema newFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc (releasedStore.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields)).2)) + site.shape.tailArguments = .ok callValues) + (arity : callValues.size = definition.signature.params.size) + (nonempty : definition.blocks.isEmpty = false) : + let allocation := releasedStore.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + Steps context interpretation (2 * site.shape.fieldCount + 3) machine + { store := allocation.1 + heapFuel := remaining + control := .running { definition, values := callValues } stack } := by + dsimp only + let afterFetches : Machine := + { machine with + control := .running + { definition + block := blockId + pc := site.shape.fieldCount + values := parameters ++ fields + credits := #[] } + stack } + let afterRetains : Machine := + { store := retainedStore + heapFuel := machine.heapFuel + control := .running + { definition + block := blockId + pc := 2 * site.shape.fieldCount + values := baselinePrefixValues parameters fields + credits := #[] } + stack } + let afterRelease : Machine := + { store := releasedStore + heapFuel := remaining + control := .running + { definition + block := blockId + pc := 2 * site.shape.fieldCount + 1 + values := baselinePrefixValues parameters fields + credits := #[] } + stack } + let allocation := releasedStore.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + let afterAllocation : Machine := + { store := allocation.1 + heapFuel := remaining + control := .running + { definition + block := blockId + pc := 2 * site.shape.fieldCount + 2 + values := (baselinePrefixValues parameters fields).push + (.loc allocation.2) + credits := #[] } + stack } + have fetches : Steps context interpretation site.shape.fieldCount machine + afterFetches := by + simpa [afterFetches] using + fetchPrefixControl site blockAt control parameterCount fieldCount + sourceResolved boxAt node + have retains : Steps context interpretation site.shape.fieldCount + afterFetches afterRetains := by + simpa [afterFetches, afterRetains] using + retainPrefixControl site (context := context) + (interpretation := interpretation) (definition := definition) + (blockId := blockId) (parameters := parameters) (fields := fields) + (store := machine.store) (retainedStore := retainedStore) + (heapFuel := machine.heapFuel) (stack := stack) blockAt parameterCount + fieldCount retained + have prefixSteps : Steps context interpretation (2 * site.shape.fieldCount) + machine afterRetains := by + simpa [Nat.two_mul] using fetches.trans retains + have sourceResolvedAfter : resolveAtom + (baselinePrefixValues parameters fields) (.reg site.shape.source) = + .ok (.loc location) := by + simpa [baselinePrefixValues, resolveAtom, Array.getElem?_append, + parameterCount, site.fits.sourceBound] using sourceResolved + have releaseAt := site.fits.release + rw [site.fits.releasePosition] at releaseAt + obtain ⟨releasePc, releaseInstruction⟩ := + Array.getElem?_eq_some_iff.mp releaseAt + have releaseStep : Step context interpretation afterRetains afterRelease := by + have step := Step.releaseShared + (context := context) (interpretation := interpretation) + (machine := afterRetains) + (frame := + { definition + block := blockId + pc := 2 * site.shape.fieldCount + values := baselinePrefixValues parameters fields + credits := #[] }) + (stack := stack) (block := block) + (atom := .reg site.shape.source) (value := .loc location) + (store := releasedStore) (heapFuel := remaining) rfl blockAt releasePc + releaseInstruction sourceResolvedAfter (by simpa [afterRetains] using + released) + simpa [afterRetains, afterRelease] using step + have allocationAt := site.fits.allocation + rw [site.fits.releasePosition] at allocationAt + obtain ⟨allocationPc, allocationInstruction⟩ := + Array.getElem?_eq_some_iff.mp allocationAt + have allocationStep : Step context interpretation afterRelease + afterAllocation := by + have step := Step.alloc + (context := context) (interpretation := interpretation) + (machine := afterRelease) + (frame := + { definition + block := blockId + pc := 2 * site.shape.fieldCount + 1 + values := baselinePrefixValues parameters fields + credits := #[] }) + (stack := stack) (block := block) (world := .shared) + (cid := site.shape.allocationConstructor) + (arguments := site.shape.allocationArguments) + (schema := allocationSchema) (values := newFields) rfl blockAt + allocationPc allocationInstruction schemaAt allocationResolved + (by simpa [afterRelease] using fieldWorlds) + simpa [afterRelease, afterAllocation, allocation] using step + have tailStep : Step context interpretation afterAllocation + { store := allocation.1 + heapFuel := remaining + control := .running { definition, values := callValues } stack } := by + apply Step.tailCallSelf + (frame := + { definition + block := blockId + pc := 2 * site.shape.fieldCount + 2 + values := (baselinePrefixValues parameters fields).push + (.loc allocation.2) + credits := #[] }) + (stack := stack) (block := block) + (arguments := site.shape.tailArguments) (values := callValues) + · rfl + · simpa [afterAllocation] using blockAt + · exact site.fits.instructionCount.symm + · exact site.fits.terminator + · rfl + · simpa [allocation] using tailResolved + · exact arity + · exact nonempty + have releaseOne := releaseStep.toSteps (by rfl) + have allocationOne := allocationStep.toSteps (by rfl) + have tailOne := tailStep.toSteps (by rfl) + simpa [allocation] using + ((prefixSteps.trans releaseOne).trans allocationOne).trans tailOne + +/-! ## Concrete hot-path stores -/ + +/-- Store produced by the logical unit-refcount arm of `resetShared`. -/ +def logicalHotResetStore (store : Store) (location : Nat) : Store := + ((store.tickResetAttempt).kill location).tickHotReset + +/-- Store produced by the physical unit-refcount arm of `resetShared`. -/ +def physicalHotResetStore (store : Store) (location : Nat) : Store := + ((store.tickResetAttempt).reserve location).tickHotReset + +/-- Logical consumption of a present credit allocates the replacement at a +fresh location. -/ +def logicalHotReuseStore (store : Store) (location : Nat) + (node : IxIR1.Node) : Store × Nat := + (logicalHotResetStore store location).allocNode .shared node + +/-- Physical consumption of a present credit revives the reserved source +slot. -/ +def physicalHotReuseStore (store : Store) (location : Nat) + (node : IxIR1.Node) (payloadUnits : Nat) : Except Error Store := + (physicalHotResetStore store location).reuseReservation location .shared + node payloadUnits + +/-! ## Baseline shared-release algebra -/ + +/-- The store update performed when a shared release sees more than one +owner. Keeping this operation explicit lets the cold-reset proof commute a +parent decrement with the batch of field retains. -/ +def baselineDecrementStore (store : Store) (location : Nat) + (box : IxIR1.NodeBox) : Store := + store.rcTick.setBox location { box with rc := box.rc - 1 } + +/-- The successful location branch of one shared retain. -/ +def incrementSharedStore (store : Store) (location : Nat) + (box : IxIR1.NodeBox) : Store := + (store.setBox location { box with rc := box.rc + 1 }).rcTick + +@[simp] theorem baselineDecrementStore_heap (store : Store) + (location : Nat) (box : IxIR1.NodeBox) : + (baselineDecrementStore store location box).heap = + IxIR1.Sim.decRcStore store.heap location box := by + rfl + +@[simp] theorem incrementSharedStore_heap (store : Store) + (location : Nat) (box : IxIR1.NodeBox) : + (incrementSharedStore store location box).heap = + IxIR1.Sim.incRcStore store.heap location box := by + rfl + +theorem get?_baselineDecrementStore_same {store : Store} {location : Nat} + {box : IxIR1.NodeBox} (hget : store.get? location = some box) : + (baselineDecrementStore store location box).get? location = + some { box with rc := box.rc - 1 } := by + exact IxIR1.Sim.get?_decRcStore_same hget + +theorem get?_baselineDecrementStore_other {store : Store} + {location other : Nat} {box otherBox : IxIR1.NodeBox} + (hne : location ≠ other) (hlive : store.get? location = some box) + (hget : store.get? other = some otherBox) : + (baselineDecrementStore store location box).get? other = + some otherBox := by + exact IxIR1.Sim.get?_decRcStore_other hne hlive hget + +theorem get?_incrementSharedStore_same {store : Store} {location : Nat} + {box : IxIR1.NodeBox} (hget : store.get? location = some box) : + (incrementSharedStore store location box).get? location = + some { box with rc := box.rc + 1 } := by + exact IxIR1.Sim.get?_incRcStore_same hget + +theorem get?_incrementSharedStore_other {store : Store} + {location other : Nat} {box otherBox : IxIR1.NodeBox} + (hne : location ≠ other) (hlive : store.get? location = some box) + (hget : store.get? other = some otherBox) : + (incrementSharedStore store location box).get? other = some otherBox := by + exact IxIR1.Sim.get?_incRcStore_other hne hlive hget + +theorem get?_of_incrementSharedStore_other {store : Store} + {location other : Nat} {box otherBox : IxIR1.NodeBox} + (hne : location ≠ other) (hlive : store.get? location = some box) + (hget : (incrementSharedStore store location box).get? other = + some otherBox) : + store.get? other = some otherBox := by + exact IxIR1.Sim.get?_of_incRcStore_other hne hlive hget + +private theorem increment_increment_other (store : Store) + (first second : Nat) (firstBox secondBox : IxIR1.NodeBox) + (hne : first ≠ second) : + incrementSharedStore + (incrementSharedStore store first firstBox) second secondBox = + incrementSharedStore + (incrementSharedStore store second secondBox) first firstBox := by + cases store with + | mk heap resetAttempts hotResets coldResets reusedPayloadUnits peakLiveNodes => + cases heap with + | mk nodes allocs reuses frees rcops => + simp only [incrementSharedStore, Eval.Store.rcTick, + Eval.Store.setBox, IxIR1.Store.rcTick, IxIR1.Store.setBox, + Array.set!_eq_setIfInBounds] + congr 2 + exact Array.setIfInBounds_comm _ _ hne + +private theorem decrement_increment_other (store : Store) + (target child : Nat) (targetBox childBox : IxIR1.NodeBox) + (hne : child ≠ target) : + baselineDecrementStore + (incrementSharedStore store child childBox) target targetBox = + incrementSharedStore + (baselineDecrementStore store target targetBox) child childBox := by + cases store with + | mk heap resetAttempts hotResets coldResets reusedPayloadUnits peakLiveNodes => + cases heap with + | mk nodes allocs reuses frees rcops => + simp only [baselineDecrementStore, incrementSharedStore, + Eval.Store.rcTick, Eval.Store.setBox, IxIR1.Store.rcTick, + IxIR1.Store.setBox, Array.set!_eq_setIfInBounds] + congr 2 + exact Array.setIfInBounds_comm _ _ hne + +private theorem decrement_increment_same (store : Store) (target rc : Nat) + (node : IxIR1.Node) (hmany : 1 < rc) : + baselineDecrementStore + (incrementSharedStore store target ⟨.shared, rc, node⟩) target + ⟨.shared, rc + 1, node⟩ = + incrementSharedStore + (baselineDecrementStore store target ⟨.shared, rc, node⟩) target + ⟨.shared, rc - 1, node⟩ := by + cases store with + | mk heap resetAttempts hotResets coldResets reusedPayloadUnits peakLiveNodes => + cases heap with + | mk nodes allocs reuses frees rcops => + simp only [baselineDecrementStore, incrementSharedStore, + Eval.Store.rcTick, Eval.Store.setBox, IxIR1.Store.rcTick, + IxIR1.Store.setBox, Array.set!_eq_setIfInBounds, + Array.setIfInBounds_setIfInBounds] + have hsub : rc - 1 + 1 = rc := Nat.sub_add_cancel (by omega) + simp [hsub] + +/-- Successful shared retains commute. Besides supporting the hot-prefix +cancellation proof, this records that the compiler may retain projected +fields in any order without changing the resulting store. -/ +theorem retainShared_commute {store afterFirst final : Store} + {first second : RVal} + (firstRun : retainShared store first = .ok afterFirst) + (secondRun : retainShared afterFirst second = .ok final) : + ∃ afterSecond, + retainShared store second = .ok afterSecond ∧ + retainShared afterSecond first = .ok final := by + cases first with + | lit literal => + have storeEq : store = afterFirst := by + simpa [retainShared] using firstRun + subst afterFirst + exact ⟨final, secondRun, by simp [retainShared]⟩ + | erased => + have storeEq : store = afterFirst := by + simpa [retainShared] using firstRun + subst afterFirst + exact ⟨final, secondRun, by simp [retainShared]⟩ + | loc firstLocation => + cases firstAt : store.get? firstLocation with + | none => simp [retainShared, firstAt] at firstRun + | some firstBox => + cases firstBox with + | mk firstWorld firstRc firstNode => + cases firstWorld with + | unique => simp [retainShared, firstAt] at firstRun + | shared => + have afterFirstEq : + incrementSharedStore store firstLocation + ⟨.shared, firstRc, firstNode⟩ = afterFirst := by + simpa [retainShared, firstAt, incrementSharedStore] using + firstRun + subst afterFirst + cases second with + | lit literal => + have finalEq : + incrementSharedStore store firstLocation + ⟨.shared, firstRc, firstNode⟩ = final := by + simpa [retainShared] using secondRun + subst final + exact ⟨store, by simp [retainShared], firstRun⟩ + | erased => + have finalEq : + incrementSharedStore store firstLocation + ⟨.shared, firstRc, firstNode⟩ = final := by + simpa [retainShared] using secondRun + subst final + exact ⟨store, by simp [retainShared], firstRun⟩ + | loc secondLocation => + by_cases same : firstLocation = secondLocation + · subst secondLocation + exact ⟨incrementSharedStore store firstLocation + ⟨.shared, firstRc, firstNode⟩, + firstRun, secondRun⟩ + · cases secondAt : + (incrementSharedStore store firstLocation + ⟨.shared, firstRc, firstNode⟩).get? + secondLocation with + | none => simp [retainShared, secondAt] at secondRun + | some secondBox => + cases secondBox with + | mk secondWorld secondRc secondNode => + cases secondWorld with + | unique => + simp [retainShared, secondAt] at secondRun + | shared => + have finalEq : + incrementSharedStore + (incrementSharedStore store + firstLocation + ⟨.shared, firstRc, firstNode⟩) + secondLocation + ⟨.shared, secondRc, secondNode⟩ = + final := by + simp only [retainShared] at secondRun + rw [secondAt] at secondRun + simpa [incrementSharedStore] using secondRun + subst final + have secondOriginal := + get?_of_incrementSharedStore_other same + firstAt secondAt + let afterSecond := + incrementSharedStore store secondLocation + ⟨.shared, secondRc, secondNode⟩ + have runSecond : + retainShared store (.loc secondLocation) = + .ok afterSecond := by + simp [retainShared, secondOriginal, + afterSecond, incrementSharedStore] + have firstAfterSecond := + get?_incrementSharedStore_other + (Ne.symm same) secondOriginal firstAt + refine ⟨afterSecond, runSecond, ?_⟩ + have runFirst : + retainShared afterSecond + (.loc firstLocation) = + .ok (incrementSharedStore afterSecond + firstLocation + ⟨.shared, firstRc, firstNode⟩) := by + simp only [retainShared] + rw [firstAfterSecond] + rfl + rw [runFirst] + exact congrArg Except.ok + (increment_increment_other store + firstLocation secondLocation + ⟨.shared, firstRc, firstNode⟩ + ⟨.shared, secondRc, secondNode⟩ + same).symm + +/-- Rotate the first retain of a successful batch to the end. This is the +algebraic normalization used by the hot proof to place one retain directly +beside the matching release. -/ +theorem RetainSharedMany.rotate_head {store target : Store} + {head : RVal} {tail : List RVal} + (run : RetainSharedMany store (head :: tail).toArray target) : + ∃ middle, + RetainSharedMany store tail.toArray middle ∧ + retainShared middle head = .ok target := by + induction tail generalizing store target head with + | nil => + obtain ⟨afterHead, headRun, emptyRun⟩ := + Eval.RetainSharedMany.cons_inv (run := run) + change (.ok afterHead : Except Error Store) = .ok target at emptyRun + injection emptyRun with targetEq + subst target + exact ⟨store, RetainSharedMany.empty _, headRun⟩ + | cons second rest ih => + obtain ⟨afterHead, headRun, tailRun⟩ := + Eval.RetainSharedMany.cons_inv (run := run) + obtain ⟨afterBoth, secondRun, restRun⟩ := + Eval.RetainSharedMany.cons_inv (run := tailRun) + obtain ⟨afterSecond, secondFirst, headSecond⟩ := + retainShared_commute headRun secondRun + have rotatedInput : + RetainSharedMany afterSecond (head :: rest).toArray target := + RetainSharedMany.cons headSecond restRun + obtain ⟨middle, restFirst, headLast⟩ := ih rotatedInput + exact ⟨middle, RetainSharedMany.cons secondFirst restFirst, headLast⟩ + +/-- Retaining a value other than `target` leaves the target box exactly +unchanged. -/ +theorem retainShared_preserves_box {store retained : Store} + {target : Nat} {targetBox : IxIR1.NodeBox} {value : RVal} + (targetAt : store.get? target = some targetBox) + (different : value ≠ .loc target) + (run : retainShared store value = .ok retained) : + retained.get? target = some targetBox := by + cases value with + | lit literal => + have storeEq : store = retained := by + simpa [retainShared] using run + subst retained + exact targetAt + | erased => + have storeEq : store = retained := by + simpa [retainShared] using run + subst retained + exact targetAt + | loc location => + have locationNe : location ≠ target := by + intro same + subst location + exact different rfl + cases valueAt : store.get? location with + | none => simp [retainShared, valueAt] at run + | some valueBox => + cases valueBox with + | mk world rc node => + cases world with + | unique => simp [retainShared, valueAt] at run + | shared => + have retainedEq : + incrementSharedStore store location + ⟨.shared, rc, node⟩ = retained := by + simpa [retainShared, valueAt, incrementSharedStore] using run + subst retained + exact get?_incrementSharedStore_other locationNe valueAt + targetAt + +/-- A batch of retains leaves an unrelated box exactly unchanged. -/ +theorem RetainSharedMany.preserves_box {store retained : Store} + {target : Nat} {targetBox : IxIR1.NodeBox} {values : List RVal} + (targetAt : store.get? target = some targetBox) + (different : ∀ value ∈ values, value ≠ .loc target) + (run : RetainSharedMany store values.toArray retained) : + retained.get? target = some targetBox := by + induction values generalizing store with + | nil => + change (.ok store : Except Error Store) = .ok retained at run + injection run with storeEq + subst retained + exact targetAt + | cons value values ih => + obtain ⟨middle, head, tail⟩ := + Eval.RetainSharedMany.cons_inv (run := run) + have middleAt := retainShared_preserves_box targetAt + (different value (by simp)) head + exact ih middleAt (fun candidate member => + different candidate (by simp [member])) tail + +private theorem kill_increment_other (store : Store) (target child : Nat) + (box : IxIR1.NodeBox) (hne : child ≠ target) : + (incrementSharedStore store child box).kill target = + incrementSharedStore (store.kill target) child box := by + cases store with + | mk heap resetAttempts hotResets coldResets reusedPayloadUnits peakLiveNodes => + cases heap with + | mk nodes allocs reuses frees rcops => + simp only [incrementSharedStore, Eval.Store.kill, + Eval.Store.setBox, Eval.Store.rcTick, IxIR1.Store.kill, + IxIR1.Store.setBox, IxIR1.Store.rcTick, + Array.set!_eq_setIfInBounds] + congr 2 + exact Array.setIfInBounds_comm _ _ hne + +/-- A retain of a non-parent value commutes with killing the parent. -/ +theorem retainShared_kill_commute {store retained : Store} + {target : Nat} {targetBox : IxIR1.NodeBox} {value : RVal} + (targetAt : store.get? target = some targetBox) + (different : value ≠ .loc target) + (run : retainShared store value = .ok retained) : + retainShared (store.kill target) value = .ok (retained.kill target) := by + cases value with + | lit literal => + have storeEq : store = retained := by + simpa [retainShared] using run + subst retained + rfl + | erased => + have storeEq : store = retained := by + simpa [retainShared] using run + subst retained + rfl + | loc location => + have locationNe : location ≠ target := by + intro same + subst location + exact different rfl + cases valueAt : store.get? location with + | none => simp [retainShared, valueAt] at run + | some valueBox => + cases valueBox with + | mk world rc node => + cases world with + | unique => simp [retainShared, valueAt] at run + | shared => + have retainedEq : + incrementSharedStore store location + ⟨.shared, rc, node⟩ = retained := by + simpa [retainShared, valueAt, incrementSharedStore] using run + subst retained + have valueAfterKill : (store.kill target).get? location = + some ⟨.shared, rc, node⟩ := + IxIR1.Sim.get?_kill_other (Ne.symm locationNe) targetAt + valueAt + rw [show retainShared (store.kill target) (.loc location) = + .ok (incrementSharedStore (store.kill target) location + ⟨.shared, rc, node⟩) by + simp [retainShared, valueAfterKill, incrementSharedStore]] + exact congrArg Except.ok + (kill_increment_other store target location + ⟨.shared, rc, node⟩ locationNe).symm + +/-- Batch field retention commutes with killing an unrelated parent. -/ +theorem RetainSharedMany.kill_commute {store retained : Store} + {target : Nat} {targetBox : IxIR1.NodeBox} {values : List RVal} + (targetAt : store.get? target = some targetBox) + (different : ∀ value ∈ values, value ≠ .loc target) + (run : RetainSharedMany store values.toArray retained) : + RetainSharedMany (store.kill target) values.toArray + (retained.kill target) := by + induction values generalizing store with + | nil => + change (.ok store : Except Error Store) = .ok retained at run + injection run with storeEq + subst retained + exact RetainSharedMany.empty _ + | cons value values ih => + obtain ⟨middle, head, tail⟩ := + Eval.RetainSharedMany.cons_inv (run := run) + have valueDifferent := different value (by simp) + have headKilled := retainShared_kill_commute targetAt valueDifferent head + have middleAt := retainShared_preserves_box targetAt valueDifferent head + have tailKilled := ih middleAt (fun candidate member => + different candidate (by simp [member])) tail + exact RetainSharedMany.cons headKilled tailKilled + +/-- One successful field retain commutes with the non-final decrement of a +shared parent. The result also exposes the parent's updated box so the +statement can be iterated when a field aliases the parent. -/ +theorem retainShared_decrement_commute {store retained : Store} + {target rc : Nat} {node : IxIR1.Node} {value : RVal} + (hget : store.get? target = some ⟨.shared, rc, node⟩) + (hmany : 1 < rc) + (hretain : retainShared store value = .ok retained) : + ∃ retainedRc, + retained.get? target = some ⟨.shared, retainedRc, node⟩ ∧ + 1 < retainedRc ∧ + retainShared + (baselineDecrementStore store target ⟨.shared, rc, node⟩) + value = + .ok (baselineDecrementStore retained target + ⟨.shared, retainedRc, node⟩) := by + cases value with + | lit literal => + simp [retainShared] at hretain + subst retained + exact ⟨rc, hget, hmany, rfl⟩ + | erased => + simp [retainShared] at hretain + subst retained + exact ⟨rc, hget, hmany, rfl⟩ + | loc child => + cases hchild : store.get? child with + | none => simp [retainShared, hchild] at hretain + | some childBox => + cases childBox with + | mk childWorld childRc childNode => + cases childWorld with + | unique => simp [retainShared, hchild] at hretain + | shared => + have retainedEq : + incrementSharedStore store child + ⟨.shared, childRc, childNode⟩ = retained := by + simpa [retainShared, hchild, incrementSharedStore] using + hretain + subst retained + by_cases heq : child = target + · subst child + have boxEq : + (⟨.shared, childRc, childNode⟩ : IxIR1.NodeBox) = + ⟨.shared, rc, node⟩ := + Option.some.inj (hchild.symm.trans hget) + cases boxEq + refine ⟨rc + 1, + get?_incrementSharedStore_same hget, + by omega, ?_⟩ + have decremented := get?_baselineDecrementStore_same hget + rw [show retainShared + (baselineDecrementStore store target + ⟨.shared, rc, node⟩) (.loc target) = + .ok (incrementSharedStore + (baselineDecrementStore store target + ⟨.shared, rc, node⟩) target + ⟨.shared, rc - 1, node⟩) by + simp [retainShared, decremented, incrementSharedStore]] + exact congrArg Except.ok + (decrement_increment_same store target rc node hmany).symm + · refine ⟨rc, + get?_incrementSharedStore_other heq hchild hget, + hmany, ?_⟩ + have childAfter := get?_baselineDecrementStore_other + (Ne.symm heq) hget hchild + rw [show retainShared + (baselineDecrementStore store target + ⟨.shared, rc, node⟩) (.loc child) = + .ok (incrementSharedStore + (baselineDecrementStore store target + ⟨.shared, rc, node⟩) child + ⟨.shared, childRc, childNode⟩) by + simp [retainShared, childAfter, incrementSharedStore]] + exact congrArg Except.ok + (decrement_increment_other store target child + ⟨.shared, rc, node⟩ + ⟨.shared, childRc, childNode⟩ heq).symm + +/-- A whole successful field-retain prefix commutes with a non-final parent +decrement. The theorem permits repeated fields and even a parent-valued +field; the updated parent box is threaded explicitly through the induction. -/ +theorem RetainSharedMany.decrement_commute {store retained : Store} + {target rc : Nat} {node : IxIR1.Node} {values : List RVal} + (hget : store.get? target = some ⟨.shared, rc, node⟩) + (hmany : 1 < rc) + (run : RetainSharedMany store values.toArray retained) : + ∃ retainedRc, + retained.get? target = some ⟨.shared, retainedRc, node⟩ ∧ + 1 < retainedRc ∧ + RetainSharedMany + (baselineDecrementStore store target ⟨.shared, rc, node⟩) + values.toArray + (baselineDecrementStore retained target + ⟨.shared, retainedRc, node⟩) := by + induction values generalizing store retained rc node with + | nil => + change (.ok store : Except Error Store) = .ok retained at run + injection run with storeEq + subst retained + exact ⟨rc, hget, hmany, RetainSharedMany.empty _⟩ + | cons value values ih => + obtain ⟨middle, head, tail⟩ := + Eval.RetainSharedMany.cons_inv (run := run) + obtain ⟨middleRc, middleAt, middleMany, headCommutes⟩ := + retainShared_decrement_commute hget hmany head + obtain ⟨retainedRc, retainedAt, retainedMany, tailCommutes⟩ := + ih middleAt middleMany tail + exact ⟨retainedRc, retainedAt, retainedMany, + RetainSharedMany.cons headCommutes tailCommutes⟩ + +/-- Reset-attempt accounting commutes with a successful shared retain. -/ +theorem retainShared_tickResetAttempt {store retained : Store} + {value : RVal} (run : retainShared store value = .ok retained) : + retainShared store.tickResetAttempt value = + .ok retained.tickResetAttempt := by + cases value with + | lit literal => + have storeEq : store = retained := by + simpa [retainShared] using run + subst retained + rfl + | erased => + have storeEq : store = retained := by + simpa [retainShared] using run + subst retained + rfl + | loc location => + cases hget : store.get? location with + | none => simp [retainShared, hget] at run + | some box => + cases box with + | mk world rc node => + cases world with + | unique => simp [retainShared, hget] at run + | shared => + have retainedEq : + incrementSharedStore store location + ⟨.shared, rc, node⟩ = retained := by + simpa [retainShared, hget, incrementSharedStore] using run + subst retained + have heapGet : store.heap.get? location = + some ⟨.shared, rc, node⟩ := hget + simp [retainShared, heapGet, incrementSharedStore, + Eval.Store.tickResetAttempt, Eval.Store.get?, + Eval.Store.setBox, Eval.Store.rcTick] + +/-- Cold-reset accounting commutes with a successful shared retain. -/ +theorem retainShared_tickColdReset {store retained : Store} + {value : RVal} (run : retainShared store value = .ok retained) : + retainShared store.tickColdReset value = + .ok retained.tickColdReset := by + cases value with + | lit literal => + have storeEq : store = retained := by + simpa [retainShared] using run + subst retained + rfl + | erased => + have storeEq : store = retained := by + simpa [retainShared] using run + subst retained + rfl + | loc location => + cases hget : store.get? location with + | none => simp [retainShared, hget] at run + | some box => + cases box with + | mk world rc node => + cases world with + | unique => simp [retainShared, hget] at run + | shared => + have retainedEq : + incrementSharedStore store location + ⟨.shared, rc, node⟩ = retained := by + simpa [retainShared, hget, incrementSharedStore] using run + subst retained + have heapGet : store.heap.get? location = + some ⟨.shared, rc, node⟩ := hget + simp [retainShared, heapGet, incrementSharedStore, + Eval.Store.tickColdReset, Eval.Store.get?, + Eval.Store.setBox, Eval.Store.rcTick] + +/-- Batch field retention is insensitive to when reset-attempt accounting is +recorded. -/ +theorem RetainSharedMany.tickResetAttempt {store retained : Store} + {values : List RVal} + (run : RetainSharedMany store values.toArray retained) : + RetainSharedMany store.tickResetAttempt values.toArray + retained.tickResetAttempt := by + induction values generalizing store retained with + | nil => + change (.ok store : Except Error Store) = .ok retained at run + injection run with storeEq + subst retained + exact RetainSharedMany.empty _ + | cons value values ih => + obtain ⟨middle, head, tail⟩ := + Eval.RetainSharedMany.cons_inv (run := run) + exact RetainSharedMany.cons + (retainShared_tickResetAttempt head) (ih tail) + +/-- Batch field retention is insensitive to when cold-reset accounting is +recorded. -/ +theorem RetainSharedMany.tickColdReset {store retained : Store} + {values : List RVal} + (run : RetainSharedMany store values.toArray retained) : + RetainSharedMany store.tickColdReset values.toArray + retained.tickColdReset := by + induction values generalizing store retained with + | nil => + change (.ok store : Except Error Store) = .ok retained at run + injection run with storeEq + subst retained + exact RetainSharedMany.empty _ + | cons value values ih => + obtain ⟨middle, head, tail⟩ := + Eval.RetainSharedMany.cons_inv (run := run) + exact RetainSharedMany.cons + (retainShared_tickColdReset head) (ih tail) + +/-! ## Counter-insensitive heap congruence -/ + +/-- Exact semantic heap state, deliberately forgetting allocation/reset cost +counters. Unlike `HeapIso`, this relation keeps location identities fixed; +it is the right intermediate relation for cancellation of baseline RC +traffic. -/ +structure HeapContentsEq (left right : Store) : Prop where + nodes : left.heap.nodes = right.heap.nodes + +namespace HeapContentsEq + +theorem refl (store : Store) : HeapContentsEq store store := ⟨rfl⟩ + +theorem symm {left right : Store} (h : HeapContentsEq left right) : + HeapContentsEq right left := ⟨h.nodes.symm⟩ + +theorem trans {first second third : Store} + (h₁ : HeapContentsEq first second) (h₂ : HeapContentsEq second third) : + HeapContentsEq first third := ⟨h₁.nodes.trans h₂.nodes⟩ + +theorem get?_eq {left right : Store} (h : HeapContentsEq left right) + (location : Nat) : left.get? location = right.get? location := by + simp [Eval.Store.get?, IxIR1.Store.get?, h.nodes] + +/-- Exact heap contents make dynamic ownership-world checks identical at a +fixed runtime value. -/ +theorem rvalHasWorld_eq {left right : Store} (h : HeapContentsEq left right) + (world : Owned) (value : RVal) : + RVal.hasWorld left world value = RVal.hasWorld right world value := by + cases value with + | loc location => + simp [RVal.hasWorld, h.get?_eq location] + | lit literal => rfl + | erased => rfl + +/-- Field validation transports across counter-insensitive exact heap +contents without a second executable checker premise. -/ +theorem fieldWorlds {left right : Store} (h : HeapContentsEq left right) + {schema : CtorSchema} {values : Array RVal} + (worlds : FieldWorlds left schema values) : + FieldWorlds right schema values := + FieldWorlds.congrStore + (fun world value => h.rvalHasWorld_eq world value) worlds + +theorem fieldWorlds_iff {left right : Store} (h : HeapContentsEq left right) + {schema : CtorSchema} {values : Array RVal} : + FieldWorlds left schema values ↔ FieldWorlds right schema values := + ⟨h.fieldWorlds, h.symm.fieldWorlds⟩ + +/-- Constructor views are preserved at fixed locations. -/ +theorem constructorView {left right : Store} (h : HeapContentsEq left right) + {location : Nat} {world : Owned} {cid : CtorId} + {box : IxIR1.NodeBox} {fields : Array RVal} + (viewed : ConstructorView left location world cid box fields) : + ConstructorView right location world cid box fields := + ConstructorView.congrStore (h.get?_eq location) viewed + +/-- One successful shared retain is congruent under exact semantic heap +contents, including its refcount update. -/ +theorem retainShared {left right leftOut : Store} + (h : HeapContentsEq left right) {value : RVal} + (run : Eval.retainShared left value = .ok leftOut) : + ∃ rightOut, + Eval.retainShared right value = .ok rightOut ∧ + HeapContentsEq leftOut rightOut := by + cases value with + | lit literal => + have leftEq : left = leftOut := by + simpa [Eval.retainShared] using run + subst leftOut + exact ⟨right, by simp [Eval.retainShared], h⟩ + | erased => + have leftEq : left = leftOut := by + simpa [Eval.retainShared] using run + subst leftOut + exact ⟨right, by simp [Eval.retainShared], h⟩ + | loc location => + cases leftAt : left.get? location with + | none => simp [Eval.retainShared, leftAt] at run + | some box => + have rightAt : right.get? location = some box := by + rw [← h.get?_eq location] + exact leftAt + cases box with + | mk boxWorld rc node => + cases boxWorld with + | unique => simp [Eval.retainShared, leftAt] at run + | shared => + have leftOutEq : + (left.setBox location + ⟨.shared, rc + 1, node⟩).rcTick = leftOut := by + simpa [Eval.retainShared, leftAt] using run + subst leftOut + refine ⟨(right.setBox location + ⟨.shared, rc + 1, node⟩).rcTick, ?_, ?_⟩ + · simp [Eval.retainShared, rightAt] + · constructor + simp [Eval.Store.setBox, Eval.Store.rcTick, + IxIR1.Store.setBox, IxIR1.Store.rcTick, h.nodes] + +/-- Batch shared retain is congruent under exact semantic heap contents. -/ +theorem retainSharedMany {left right leftOut : Store} + (h : HeapContentsEq left right) {values : Array RVal} + (run : RetainSharedMany left values leftOut) : + ∃ rightOut, + RetainSharedMany right values rightOut ∧ + HeapContentsEq leftOut rightOut := by + have loop : ∀ (entries : List RVal) {left right leftOut : Store}, + HeapContentsEq left right → + RetainSharedMany left entries.toArray leftOut → + ∃ rightOut, + RetainSharedMany right entries.toArray rightOut ∧ + HeapContentsEq leftOut rightOut := by + intro entries + induction entries with + | nil => + intro left right leftOut contents retained + change (.ok left : Except Error Store) = .ok leftOut at retained + injection retained with leftEq + subst leftOut + exact ⟨right, rfl, contents⟩ + | cons head tail ih => + intro left right leftOut contents retained + obtain ⟨leftMiddle, headRun, tailRun⟩ := + Eval.RetainSharedMany.cons_inv (run := retained) + obtain ⟨rightMiddle, rightHead, middleContents⟩ := + contents.retainShared headRun + obtain ⟨rightOut, rightTail, finalContents⟩ := + ih middleContents tailRun + exact ⟨rightOut, + Eval.RetainSharedMany.cons rightHead rightTail, finalContents⟩ + have normalized : + RetainSharedMany left values.toList.toArray leftOut := by + simpa using run + obtain ⟨rightOut, rightRun, contents⟩ := + loop values.toList h normalized + exact ⟨rightOut, by simpa using rightRun, contents⟩ + +theorem rcTick {left right : Store} (h : HeapContentsEq left right) : + HeapContentsEq left.rcTick right.rcTick := by + exact ⟨h.nodes⟩ + +theorem setBox {left right : Store} (h : HeapContentsEq left right) + (location : Nat) (box : IxIR1.NodeBox) : + HeapContentsEq (left.setBox location box) (right.setBox location box) := by + constructor + simp [Eval.Store.setBox, IxIR1.Store.setBox, h.nodes] + +theorem kill {left right : Store} (h : HeapContentsEq left right) + (location : Nat) : + HeapContentsEq (left.kill location) (right.kill location) := by + constructor + simp [Eval.Store.kill, IxIR1.Store.kill, h.nodes] + +theorem reserve {left right : Store} (h : HeapContentsEq left right) + (location : Nat) : + HeapContentsEq (left.reserve location) (right.reserve location) := by + constructor + simp [Eval.Store.reserve, h.nodes] + +theorem tickResetAttempt {left right : Store} + (h : HeapContentsEq left right) : + HeapContentsEq left.tickResetAttempt right.tickResetAttempt := + ⟨h.nodes⟩ + +theorem tickHotReset {left right : Store} (h : HeapContentsEq left right) : + HeapContentsEq left.tickHotReset right.tickHotReset := + ⟨h.nodes⟩ + +theorem tickColdReset {left right : Store} (h : HeapContentsEq left right) : + HeapContentsEq left.tickColdReset right.tickColdReset := + ⟨h.nodes⟩ + +/-- Releasing the same reserved slot succeeds congruently in exact-content +stores; only observational free counters may differ. -/ +theorem releaseReservation {left right leftOut : Store} + (h : HeapContentsEq left right) {location : Nat} + (run : left.releaseReservation location = .ok leftOut) : + ∃ rightOut, + right.releaseReservation location = .ok rightOut ∧ + HeapContentsEq leftOut rightOut := by + cases found : left.heap.nodes[location]? with + | none => + simp [Eval.Store.releaseReservation, found] at run + | some slot => + cases slot with + | some box => + simp [Eval.Store.releaseReservation, found] at run + | none => + have rightAt : right.heap.nodes[location]? = some none := by + rw [← h.nodes] + exact found + have leftOutEq : + { left with + heap := { left.heap with frees := left.heap.frees + 1 } } = + leftOut := by + simpa [Eval.Store.releaseReservation, found] using run + subst leftOut + refine ⟨ + { right with + heap := { right.heap with frees := right.heap.frees + 1 } }, + ?_, ⟨h.nodes⟩⟩ + simp [Eval.Store.releaseReservation, rightAt] + +/-- Reusing the same reserved slot with the same payload is congruent under +exact heap contents. -/ +theorem reuseReservation {left right leftOut : Store} + (h : HeapContentsEq left right) {location : Nat} {world : Owned} + {node : IxIR1.Node} {payloadUnits : Nat} + (run : left.reuseReservation location world node payloadUnits = + .ok leftOut) : + ∃ rightOut, + right.reuseReservation location world node payloadUnits = .ok rightOut ∧ + HeapContentsEq leftOut rightOut := by + cases found : left.heap.nodes[location]? with + | none => + simp [Eval.Store.reuseReservation, found] at run + | some slot => + cases slot with + | some box => + simp [Eval.Store.reuseReservation, found] at run + | none => + have rightAt : right.heap.nodes[location]? = some none := by + rw [← h.nodes] + exact found + cases rightRun : + right.reuseReservation location world node payloadUnits with + | error error => + simp [Eval.Store.reuseReservation, rightAt] at rightRun + | ok rightOut => + refine ⟨rightOut, rfl, ?_⟩ + have leftNodes := congrArg + (fun result : Except Error Store => + result.map (fun output => output.heap.nodes)) run + have rightNodes := congrArg + (fun result : Except Error Store => + result.map (fun output => output.heap.nodes)) rightRun + have leftNodes' : + left.heap.nodes.setIfInBounds location + (some { world, rc := 1, node }) = + leftOut.heap.nodes := by + simpa [Eval.Store.reuseReservation, found, Except.map] + using leftNodes + have rightNodes' : + right.heap.nodes.setIfInBounds location + (some { world, rc := 1, node }) = + rightOut.heap.nodes := by + simpa [Eval.Store.reuseReservation, rightAt, Except.map] + using rightNodes + constructor + exact leftNodes'.symm.trans + ((congrArg + (fun nodes => nodes.setIfInBounds location + (some { world, rc := 1, node })) h.nodes).trans + rightNodes') + +theorem allocNode {left right : Store} (h : HeapContentsEq left right) + (world : Owned) (node : IxIR1.Node) : + HeapContentsEq (left.allocNode world node).1 + (right.allocNode world node).1 := by + constructor + simp [Eval.Store.allocNode, IxIR1.Store.allocNode, h.nodes] + +theorem allocNode_location {left right : Store} + (h : HeapContentsEq left right) (world : Owned) (node : IxIR1.Node) : + (left.allocNode world node).2 = (right.allocNode world node).2 := by + simp [Eval.Store.allocNode, IxIR1.Store.allocNode, h.nodes] + +theorem hasWorld {left right : Store} (h : HeapContentsEq left right) + {world : Owned} {value : RVal} + (live : IxIR1.Sim.HasWorld left.heap world value) : + IxIR1.Sim.HasWorld right.heap world value := by + cases value with + | lit literal => trivial + | erased => trivial + | loc location => + obtain ⟨box, boxAt, boxWorld⟩ := live + refine ⟨box, ?_, boxWorld⟩ + change right.get? location = some box + rw [← h.get?_eq location] + exact boxAt + +/-- Exact node-array equality transports exact ownership without changing +the root list. -/ +theorem rootOwnership {left right : Store} (h : HeapContentsEq left right) + {roots : List IxIR1.Sim.Root} + (owned : IxIR1.Sim.RootOwnership left.heap roots) : + IxIR1.Sim.RootOwnership right.heap roots := by + refine ⟨?_, ?_, ?_, ?_⟩ + · intro root member + exact h.hasWorld (owned.roots_world root member) + · intro location box boxAt child member + have leftAt : left.heap.get? location = some box := by + change left.get? location = some box + rw [h.get?_eq location] + exact boxAt + exact h.hasWorld (owned.edges_world leftAt child member) + · intro location box address arity arguments boxAt node + have leftAt : left.heap.get? location = some box := by + change left.get? location = some box + rw [h.get?_eq location] + exact boxAt + exact owned.pap_shared leftAt node + · intro location box boxAt + have leftAt : left.heap.get? location = some box := by + change left.get? location = some box + rw [h.get?_eq location] + exact boxAt + simpa [IxIR1.Sim.incoming, IxIR1.Sim.edgeLocations, h.nodes] using + owned.counts leftAt + +/-- Fixed-location heap contents induce a live-heap isomorphism; cost +counters and dead-slot metadata remain unobservable. -/ +def toHeapIso {left right : Store} (h : HeapContentsEq left right) + (closed : IxIR1.Sim.StoreClosed left.heap) : + IxIR1.Sim.HeapIso left.heap right.heap := + let identity := IxIR1.Sim.HeapIso.refl left.heap closed + { locRel := identity.locRel + left_unique := identity.left_unique + right_unique := identity.right_unique + left_total := identity.left_total + right_total := by + intro location box rightAt + have leftAt : left.heap.get? location = some box := by + change left.get? location = some box + rw [h.get?_eq location] + exact rightAt + exact identity.right_total leftAt + related_live := by + intro leftLocation rightLocation related + obtain ⟨leftBox, rightBox, leftAt, rightAt, boxes⟩ := + identity.related_live related + have rightAt' : right.heap.get? rightLocation = some rightBox := by + change right.get? rightLocation = some rightBox + rw [← h.get?_eq rightLocation] + exact rightAt + exact ⟨leftBox, rightBox, leftAt, rightAt', boxes⟩ } + +theorem toHeapIso_rel_self {left right : Store} + (h : HeapContentsEq left right) + (closed : IxIR1.Sim.StoreClosed left.heap) {location : Nat} + {box : IxIR1.NodeBox} (live : left.get? location = some box) : + (h.toHeapIso closed).locRel location location := by + change location = location ∧ ∃ box, left.heap.get? location = some box + exact ⟨rfl, box, live⟩ + +end HeapContentsEq + +/-- A live-heap isomorphism is a valid initial allocation-history +isomorphism. It simply has no dead/dead rows yet; later reclamation steps +may retain those rows so stale, unreachable register slots remain related. -/ +def heapIsoToHistory {left right : IxIR1.Store} + (iso : IxIR1.Sim.HeapIso left right) : + IxIR1.Sim.HeapHistoryIso left right where + locRel := iso.locRel + left_unique := iso.left_unique + right_unique := iso.right_unique + left_bound := by + intro leftLocation rightLocation related + obtain ⟨leftBox, _rightBox, leftAt, _rightAt, _boxes⟩ := + iso.related_live related + exact (Array.getElem?_eq_some_iff.mp + (IxIR1.Sim.nodes_get?_of_get? leftAt)).1 + right_bound := by + intro leftLocation rightLocation related + obtain ⟨_leftBox, rightBox, _leftAt, rightAt, _boxes⟩ := + iso.related_live related + exact (Array.getElem?_eq_some_iff.mp + (IxIR1.Sim.nodes_get?_of_get? rightAt)).1 + left_total := iso.left_total + right_total := iso.right_total + related := by + intro leftLocation rightLocation related + exact .inr (iso.related_live related) + +private theorem nodeIso_ctor_left {locRel : Nat → Nat → Prop} + {cid : CtorId} {leftFields : Array RVal} {rightNode : IxIR1.Node} + (related : IxIR1.Sim.NodeIso locRel (.ctorN cid leftFields) rightNode) : + ∃ rightFields : Array RVal, + rightNode = .ctorN cid rightFields ∧ + IxIR1.Sim.RValsIso locRel leftFields.toList rightFields.toList := by + cases related with + | ctor fields => exact ⟨_, rfl, fields⟩ + +private theorem nodeIso_pap_left {locRel : Nat → Nat → Prop} + {address : Ix.Compiler.Ixon.Address} {arity : Nat} + {leftArguments : Array RVal} {rightNode : IxIR1.Node} + (related : IxIR1.Sim.NodeIso locRel + (.papN address arity leftArguments) rightNode) : + ∃ rightArguments : Array RVal, + rightNode = .papN address arity rightArguments ∧ + IxIR1.Sim.RValsIso locRel + leftArguments.toList rightArguments.toList := by + cases related with + | pap arguments => exact ⟨_, rfl, arguments⟩ + +/-! ## Removing a related hot-reset source -/ + +private theorem rvalsIso_restrict_left {locRel : Nat → Nat → Prop} + {left right : List RVal} {removed : Nat} + (related : IxIR1.Sim.RValsIso locRel left right) + (avoids : ∀ value ∈ left, value ≠ .loc removed) : + IxIR1.Sim.RValsIso + (fun leftLocation rightLocation => + locRel leftLocation rightLocation ∧ leftLocation ≠ removed) + left right := by + induction related with + | nil => exact .nil + | @cons leftValue rightValue lefts rights head tail ih => + have headAvoids : leftValue ≠ .loc removed := + avoids leftValue (by simp) + have tailAvoids : ∀ value ∈ lefts, value ≠ .loc removed := by + intro value member + exact avoids value (by simp [member]) + refine .cons ?_ (ih tailAvoids) + cases head with + | loc locationRelated => + apply IxIR1.Sim.RValIso.loc + refine ⟨locationRelated, ?_⟩ + intro same + apply headAvoids + cases same + rfl + | lit => exact .lit + | erased => exact .erased + +private theorem rvalsIso_right_avoids_of_left + {leftStore rightStore : IxIR1.Store} + (iso : IxIR1.Sim.HeapIso rightStore leftStore) + {leftRemoved rightRemoved : Nat} + (removedRelated : iso.locRel rightRemoved leftRemoved) + {left right : List RVal} + (related : IxIR1.Sim.RValsIso + (fun leftLocation rightLocation => + iso.locRel rightLocation leftLocation) left right) + (leftAvoids : ∀ value ∈ left, value ≠ .loc leftRemoved) : + ∀ value ∈ right, value ≠ .loc rightRemoved := by + induction related with + | nil => simp + | @cons leftValue rightValue lefts rights head tail ih => + have headAvoids : leftValue ≠ .loc leftRemoved := + leftAvoids leftValue (by simp) + have tailAvoids : ∀ value ∈ lefts, value ≠ .loc leftRemoved := by + intro value member + exact leftAvoids value (by simp [member]) + intro value member + simp only [List.mem_cons] at member + rcases member with rfl | member + · cases head with + | loc locationRelated => + intro same + cases same + have leftSame := iso.left_unique locationRelated removedRelated + apply headAvoids + cases leftSame + rfl + | lit => intro impossible; cases impossible + | erased => intro impossible; cases impossible + · exact ih tailAvoids value member + +private theorem nodeIso_restrict_left {locRel : Nat → Nat → Prop} + {left right : IxIR1.Node} {removed : Nat} + (related : IxIR1.Sim.NodeIso locRel left right) + (avoids : ∀ value ∈ IxIR1.Sim.nodeChildren left, + value ≠ .loc removed) : + IxIR1.Sim.NodeIso + (fun leftLocation rightLocation => + locRel leftLocation rightLocation ∧ leftLocation ≠ removed) + left right := by + cases related with + | ctor values => + apply IxIR1.Sim.NodeIso.ctor + apply rvalsIso_restrict_left values + simpa [IxIR1.Sim.nodeChildren] using avoids + | pap values => + apply IxIR1.Sim.NodeIso.pap + apply rvalsIso_restrict_left values + simpa [IxIR1.Sim.nodeChildren] using avoids + +/-- Removing two related unit-refcount shared nodes preserves the existing +live-heap bijection on every surviving location. Exact ownership on the left +excludes hidden incoming heap edges to the consumed node, which is precisely +what permits the location pair to be removed from the relation. -/ +def heapIsoKillShared {left right : IxIR1.Store} + (iso : IxIR1.Sim.HeapIso left right) + {leftLocation rightLocation : Nat} + {leftNode rightNode : IxIR1.Node} {leftRest : List IxIR1.Sim.Root} + (locations : iso.locRel leftLocation rightLocation) + (leftAt : left.get? leftLocation = + some ⟨.shared, 1, leftNode⟩) + (rightAt : right.get? rightLocation = + some ⟨.shared, 1, rightNode⟩) + (leftOwned : IxIR1.Sim.RootOwnership left + (⟨.shared, .loc leftLocation⟩ :: leftRest)) : + IxIR1.Sim.HeapIso (left.kill leftLocation) + (right.kill rightLocation) := by + let kept : Nat → Nat → Prop := fun leftCandidate rightCandidate => + iso.locRel leftCandidate rightCandidate ∧ + leftCandidate ≠ leftLocation + refine + { locRel := kept + left_unique := ?_ + right_unique := ?_ + left_total := ?_ + right_total := ?_ + related_live := ?_ } + · intro leftCandidate right₁ right₂ first second + exact iso.left_unique first.1 second.1 + · intro left₁ left₂ rightCandidate first second + exact iso.right_unique first.1 second.1 + · intro leftCandidate box live + have different : leftLocation ≠ leftCandidate := by + intro same + subst leftCandidate + rw [IxIR1.Sim.get?_kill_same leftAt] at live + contradiction + have original : left.get? leftCandidate = some box := + IxIR1.Sim.get?_of_kill_other different leftAt live + obtain ⟨rightCandidate, related⟩ := iso.left_total original + exact ⟨rightCandidate, related, Ne.symm different⟩ + · intro rightCandidate box live + have different : rightLocation ≠ rightCandidate := by + intro same + subst rightCandidate + rw [IxIR1.Sim.get?_kill_same rightAt] at live + contradiction + have original : right.get? rightCandidate = some box := + IxIR1.Sim.get?_of_kill_other different rightAt live + obtain ⟨leftCandidate, related⟩ := iso.right_total original + have leftDifferent : leftCandidate ≠ leftLocation := by + intro same + subst leftCandidate + exact different (iso.left_unique locations related) + exact ⟨leftCandidate, related, leftDifferent⟩ + · intro leftCandidate rightCandidate related + obtain ⟨leftBox, rightBox, leftLive, rightLive, boxes⟩ := + iso.related_live related.1 + have rightDifferent : rightLocation ≠ rightCandidate := by + intro same + subst rightCandidate + exact related.2 (iso.right_unique related.1 locations) + have leftKilled : (left.kill leftLocation).get? leftCandidate = + some leftBox := + IxIR1.Sim.get?_kill_other (Ne.symm related.2) leftAt leftLive + have rightKilled : (right.kill rightLocation).get? rightCandidate = + some rightBox := + IxIR1.Sim.get?_kill_other rightDifferent rightAt rightLive + refine ⟨leftBox, rightBox, leftKilled, rightKilled, + boxes.world, boxes.rc, ?_⟩ + apply nodeIso_restrict_left boxes.node + intro child member + exact leftOwned.sole_child_ne leftAt leftLive member + +/-- The restricted post-kill relation contains every old related pair whose +left endpoint is not the consumed source location. -/ +theorem heapIsoKillShared_rel {left right : IxIR1.Store} + (iso : IxIR1.Sim.HeapIso left right) + {leftLocation rightLocation : Nat} + {leftNode rightNode : IxIR1.Node} {leftRest : List IxIR1.Sim.Root} + (locations : iso.locRel leftLocation rightLocation) + (leftAt : left.get? leftLocation = + some ⟨.shared, 1, leftNode⟩) + (rightAt : right.get? rightLocation = + some ⟨.shared, 1, rightNode⟩) + (leftOwned : IxIR1.Sim.RootOwnership left + (⟨.shared, .loc leftLocation⟩ :: leftRest)) + {leftCandidate rightCandidate : Nat} + (related : iso.locRel leftCandidate rightCandidate) + (different : leftCandidate ≠ leftLocation) : + (heapIsoKillShared iso locations leftAt rightAt leftOwned).locRel + leftCandidate rightCandidate := by + exact ⟨related, different⟩ + +/-! ## Field worlds under live-heap isomorphism -/ + +/-- Related runtime values have the same dynamic ownership observation under +an allocation-history isomorphism. A historical dead/dead pair reports +`false` on both sides. -/ +theorem heapHistoryIso_rvalHasWorld_eq {left right : Store} + (iso : IxIR1.Sim.HeapHistoryIso left.heap right.heap) + {leftValue rightValue : RVal} + (related : IxIR1.Sim.RValIso iso.locRel leftValue rightValue) + (world : Owned) : + RVal.hasWorld left world leftValue = + RVal.hasWorld right world rightValue := by + cases related with + | loc locationRelated => + rcases iso.related locationRelated with dead | live + · simp [RVal.hasWorld, Eval.Store.get?, dead.1, dead.2] + · obtain ⟨leftBox, rightBox, leftAt, rightAt, boxes⟩ := live + simp [RVal.hasWorld, Eval.Store.get?, leftAt, rightAt, boxes.world] + | lit => rfl + | erased => rfl + +theorem heapHistoryIso_fieldValuesWorldEq {left right : Store} + (iso : IxIR1.Sim.HeapHistoryIso left.heap right.heap) : + ∀ {leftValues rightValues : List RVal}, + IxIR1.Sim.RValsIso iso.locRel leftValues rightValues → + FieldValuesWorldEq left right leftValues rightValues + | _, _, .nil => .nil + | _, _, .cons head tail => + .cons (fun world => heapHistoryIso_rvalHasWorld_eq iso head world) + (heapHistoryIso_fieldValuesWorldEq iso tail) + +/-- Constructor inspection transports across corresponding live locations, +returning the related target box and field vector. -/ +theorem constructorView_historyIso {left right : Store} + (heap : IxIR1.Sim.HeapHistoryIso left.heap right.heap) + {leftLocation rightLocation : Nat} + (locations : heap.locRel leftLocation rightLocation) + {world : Owned} {cid : CtorId} {leftBox : IxIR1.NodeBox} + {leftFields : Array RVal} + (viewed : ConstructorView left leftLocation world cid leftBox leftFields) : + ∃ (rightBox : IxIR1.NodeBox) (rightFields : Array RVal), + right.get? rightLocation = some rightBox ∧ + ConstructorView right rightLocation world cid rightBox rightFields ∧ + IxIR1.Sim.NodeBoxIso heap.locRel leftBox rightBox ∧ + IxIR1.Sim.RValsIso heap.locRel + leftFields.toList rightFields.toList := by + obtain ⟨leftAt, leftWorld, leftNode⟩ := viewed.parts + obtain ⟨rightBox, rightAt, boxes⟩ := heap.boxes locations (by + change left.heap.get? leftLocation = some leftBox + exact leftAt) + have nodes : IxIR1.Sim.NodeIso heap.locRel + (.ctorN cid leftFields) rightBox.node := by + simpa only [← leftNode] using boxes.node + obtain ⟨rightFields, rightNode, fields⟩ := nodeIso_ctor_left nodes + have rightWorld : rightBox.world = world := + boxes.world.symm.trans leftWorld + have rightViewed : ConstructorView right rightLocation world cid rightBox + rightFields := ConstructorView.of_box rightAt rightWorld rightNode + exact ⟨rightBox, rightFields, rightAt, rightViewed, boxes, fields⟩ + +/-- An in-bounds location whose live-node lookup is empty is an actual dead +slot, rather than an out-of-bounds address. -/ +private theorem reservedSlot_of_bound {heap : IxIR1.Store} {location : Nat} + (bound : location < heap.nodes.size) + (dead : heap.get? location = none) : + heap.nodes[location]? = some none := by + obtain ⟨slot, slotAt⟩ : ∃ slot, heap.nodes[location]? = some slot := by + refine ⟨heap.nodes[location], ?_⟩ + exact Array.getElem?_eq_some_iff.mpr ⟨bound, rfl⟩ + cases slot with + | none => exact slotAt + | some box => + have live : heap.get? location = some box := by + simp [IxIR1.Store.get?, slotAt] + rw [dead] at live + contradiction + +/-- Reserving corresponding live locations preserves allocation history. +The IxIR₂ reservation does not count a free, so only its node-array effect +is compared with the history-level kill operation. -/ +def reserve_historyIso {left right : Store} + (heap : IxIR1.Sim.HeapHistoryIso left.heap right.heap) + {leftLocation rightLocation : Nat} + (locations : heap.locRel leftLocation rightLocation) + {leftBox rightBox : IxIR1.NodeBox} + (leftAt : left.get? leftLocation = some leftBox) + (rightAt : right.get? rightLocation = some rightBox) : + IxIR1.Sim.HeapHistoryIso + (left.reserve leftLocation).heap + (right.reserve rightLocation).heap := by + let killed := heap.kill locations leftAt rightAt + exact killed.nodesEq + (by + simp [Eval.Store.reserve, IxIR1.Store.kill, + Array.set!_eq_setIfInBounds]) + (by + simp [Eval.Store.reserve, IxIR1.Store.kill, + Array.set!_eq_setIfInBounds]) + +/-- Releasing corresponding physical reservations succeeds on both sides and +does not change their allocation-history relation. -/ +theorem releaseReservation_historyIso {left right leftOut : Store} + (heap : IxIR1.Sim.HeapHistoryIso left.heap right.heap) + {leftLocation rightLocation : Nat} + (locations : heap.locRel leftLocation rightLocation) + (run : left.releaseReservation leftLocation = .ok leftOut) : + ∃ rightOut, + ∃ outputHeap : IxIR1.Sim.HeapHistoryIso leftOut.heap rightOut.heap, + right.releaseReservation rightLocation = .ok rightOut ∧ + outputHeap.locRel = heap.locRel := by + cases found : left.heap.nodes[leftLocation]? with + | none => + simp [Eval.Store.releaseReservation, found] at run + | some slot => + cases slot with + | some box => + simp [Eval.Store.releaseReservation, found] at run + | none => + have leftDead : left.heap.get? leftLocation = none := by + simp [IxIR1.Store.get?, found] + have rightDead : right.heap.get? rightLocation = none := by + rcases heap.related locations with dead | live + · exact dead.2 + · obtain ⟨leftBox, rightBox, leftLive, _, _⟩ := live + rw [leftDead] at leftLive + contradiction + have rightReserved : right.heap.nodes[rightLocation]? = some none := + reservedSlot_of_bound (heap.right_bound locations) rightDead + have leftOutEq : + { left with + heap := { left.heap with frees := left.heap.frees + 1 } } = + leftOut := by + simpa [Eval.Store.releaseReservation, found] using run + subst leftOut + let rightOut : Store := + { right with + heap := { right.heap with frees := right.heap.frees + 1 } } + let outputHeap := heap.nodesEq (nextLeft := + { left.heap with frees := left.heap.frees + 1 }) + (nextRight := + { right.heap with frees := right.heap.frees + 1 }) rfl rfl + refine ⟨rightOut, outputHeap, ?_, rfl⟩ + simp [rightOut, Eval.Store.releaseReservation, rightReserved] + +/-- Reusing corresponding physical reservations with related payload nodes +revives their dead history row. The two concrete locations may differ. -/ +theorem reuseReservation_historyIso {left right leftOut : Store} + (heap : IxIR1.Sim.HeapHistoryIso left.heap right.heap) + {leftLocation rightLocation : Nat} + (locations : heap.locRel leftLocation rightLocation) + {world : Owned} {leftNode rightNode : IxIR1.Node} + (nodes : IxIR1.Sim.NodeIso heap.locRel leftNode rightNode) + {payloadUnits : Nat} + (run : left.reuseReservation leftLocation world leftNode payloadUnits = + .ok leftOut) : + ∃ rightOut, + ∃ outputHeap : IxIR1.Sim.HeapHistoryIso leftOut.heap rightOut.heap, + right.reuseReservation rightLocation world rightNode payloadUnits = + .ok rightOut ∧ + outputHeap.locRel = heap.locRel := by + cases found : left.heap.nodes[leftLocation]? with + | none => + simp [Eval.Store.reuseReservation, found] at run + | some slot => + cases slot with + | some box => + simp [Eval.Store.reuseReservation, found] at run + | none => + have leftDead : left.heap.get? leftLocation = none := by + simp [IxIR1.Store.get?, found] + have rightDead : right.heap.get? rightLocation = none := by + rcases heap.related locations with dead | live + · exact dead.2 + · obtain ⟨leftBox, rightBox, leftLive, _, _⟩ := live + rw [leftDead] at leftLive + contradiction + have rightReserved : right.heap.nodes[rightLocation]? = some none := + reservedSlot_of_bound (heap.right_bound locations) rightDead + cases targetRun : right.reuseReservation rightLocation world + rightNode payloadUnits with + | error error => + simp [Eval.Store.reuseReservation, rightReserved] at targetRun + | ok rightOut => + have leftNodes := congrArg + (fun result : Except Error Store => + result.map (fun output => output.heap.nodes)) run + have rightNodes := congrArg + (fun result : Except Error Store => + result.map (fun output => output.heap.nodes)) targetRun + have leftNodes' : + left.heap.nodes.setIfInBounds leftLocation + (some { world, rc := 1, node := leftNode }) = + leftOut.heap.nodes := by + simpa [Eval.Store.reuseReservation, found, Except.map] + using leftNodes + have rightNodes' : + right.heap.nodes.setIfInBounds rightLocation + (some { world, rc := 1, node := rightNode }) = + rightOut.heap.nodes := by + simpa [Eval.Store.reuseReservation, rightReserved, Except.map] + using rightNodes + let revived := heap.revive locations leftDead rightDead + (show IxIR1.Sim.NodeBoxIso heap.locRel + ⟨world, 1, leftNode⟩ ⟨world, 1, rightNode⟩ from + ⟨rfl, rfl, nodes⟩) + let outputHeap := revived.nodesEq + (by + simpa [IxIR1.Store.setBox, + Array.set!_eq_setIfInBounds] using leftNodes'.symm) + (by + simpa [IxIR1.Store.setBox, + Array.set!_eq_setIfInBounds] using rightNodes'.symm) + exact ⟨rightOut, outputHeap, rfl, rfl⟩ + +/-- One shared retain is equivariant under allocation history. Its output +history keeps every entry relation, including any pre-existing dead rows. -/ +theorem retainShared_historyIso {left right leftOut : Store} + (heap : IxIR1.Sim.HeapHistoryIso left.heap right.heap) + {leftValue rightValue : RVal} + (value : IxIR1.Sim.RValIso heap.locRel leftValue rightValue) + (run : retainShared left leftValue = .ok leftOut) : + ∃ rightOut, + ∃ outputHeap : IxIR1.Sim.HeapHistoryIso leftOut.heap rightOut.heap, + retainShared right rightValue = .ok rightOut ∧ + outputHeap.locRel = heap.locRel := by + cases value with + | lit => + simp [retainShared] at run + subst leftOut + exact ⟨right, heap, rfl, rfl⟩ + | erased => + simp [retainShared] at run + subst leftOut + exact ⟨right, heap, rfl, rfl⟩ + | @loc leftLocation rightLocation related => + cases leftAt : left.get? leftLocation with + | none => simp [retainShared, leftAt] at run + | some leftBox => + obtain ⟨rightBox, rightAt, boxes⟩ := heap.boxes related (by + change left.heap.get? leftLocation = some leftBox + exact leftAt) + cases leftBox with + | mk leftWorld leftRc leftNode => + cases leftWorld with + | unique => simp [retainShared, leftAt] at run + | shared => + have rightWorld : rightBox.world = .shared := by + exact boxes.world.symm + simp [retainShared, leftAt] at run + subst leftOut + let rightOut := + (right.setBox rightLocation + { rightBox with rc := rightBox.rc + 1 }).rcTick + have rightAtStore : right.get? rightLocation = + some rightBox := by + exact rightAt + have rightRun : retainShared right (.loc rightLocation) = + .ok rightOut := by + simp [retainShared, rightAtStore, rightWorld, rightOut] + let setHistory := heap.setBox related + (by + change left.heap.get? leftLocation = + some ⟨.shared, leftRc, leftNode⟩ + exact leftAt) + rightAt + (show IxIR1.Sim.NodeBoxIso heap.locRel + { (⟨.shared, leftRc, leftNode⟩ : IxIR1.NodeBox) with + rc := leftRc + 1 } + { rightBox with rc := rightBox.rc + 1 } from + ⟨boxes.world, congrArg (fun rc => rc + 1) boxes.rc, + boxes.node⟩) + let outputHistory := setHistory.rcTick + exact ⟨rightOut, outputHistory, rightRun, rfl⟩ + +private theorem retainSharedMany_historyIso_rel + {rel : Nat → Nat → Prop} {leftValues rightValues : List RVal} + (values : IxIR1.Sim.RValsIso rel leftValues rightValues) : + ∀ {left right leftOut : Store} + (heap : IxIR1.Sim.HeapHistoryIso left.heap right.heap), + heap.locRel = rel → + RetainSharedMany left leftValues.toArray leftOut → + ∃ rightOut, + ∃ outputHeap : IxIR1.Sim.HeapHistoryIso leftOut.heap rightOut.heap, + RetainSharedMany right rightValues.toArray rightOut ∧ + outputHeap.locRel = rel := by + induction values with + | nil => + intro left right leftOut heap heapRelation run + have leftEmpty : RetainSharedMany left #[] left := + RetainSharedMany.empty left + have leftOutEq : leftOut = left := by + unfold RetainSharedMany at run leftEmpty + exact Except.ok.inj (run.symm.trans leftEmpty) + subst leftOut + exact ⟨right, heap, RetainSharedMany.empty right, heapRelation⟩ + | @cons leftHead rightHead leftTail rightTail head tail ih => + intro left right leftOut heap heapRelation run + obtain ⟨leftMiddle, leftHeadRun, leftTailRun⟩ := run.cons_inv + have headRelated : IxIR1.Sim.RValIso heap.locRel + leftHead rightHead := by + rw [heapRelation] + exact head + obtain ⟨rightMiddle, middleHeap, rightHeadRun, middleRelation⟩ := + retainShared_historyIso heap headRelated leftHeadRun + obtain ⟨rightOut, outputHeap, rightTailRun, outputRelation⟩ := + ih middleHeap (middleRelation.trans heapRelation) leftTailRun + refine ⟨rightOut, outputHeap, + RetainSharedMany.cons rightHeadRun rightTailRun, outputRelation⟩ + +/-- Batch shared retain preserves the allocation-history relation while +allowing each side to update the corresponding concrete locations. -/ +theorem retainSharedMany_historyIso {left right leftOut : Store} + (heap : IxIR1.Sim.HeapHistoryIso left.heap right.heap) + {leftValues rightValues : List RVal} + (values : IxIR1.Sim.RValsIso heap.locRel leftValues rightValues) + (run : RetainSharedMany left leftValues.toArray leftOut) : + ∃ rightOut, + ∃ outputHeap : IxIR1.Sim.HeapHistoryIso leftOut.heap rightOut.heap, + RetainSharedMany right rightValues.toArray rightOut ∧ + outputHeap.locRel = heap.locRel := + retainSharedMany_historyIso_rel values heap rfl run + +/-- Deep shared release is equivariant at a common traversal-fuel index. +Corresponding kills retain dead/dead history rows, and corresponding +decrements preserve the same location relation. -/ +theorem releaseSharedWork_historyIso_sameFuel : + ∀ {fuel : Nat} {left right leftOut : Store} + {leftValues rightValues : List RVal} {remaining : Nat} + (heap : IxIR1.Sim.HeapHistoryIso left.heap right.heap), + IxIR1.Sim.RValsIso heap.locRel leftValues rightValues → + releaseSharedWork fuel left leftValues = .ok (leftOut, remaining) → + ∃ rightOut, + ∃ outputHeap : IxIR1.Sim.HeapHistoryIso leftOut.heap rightOut.heap, + releaseSharedWork fuel right rightValues = + .ok (rightOut, remaining) ∧ + outputHeap.locRel = heap.locRel := by + intro fuel + induction fuel with + | zero => + intro left right leftOut leftValues rightValues remaining heap values run + cases values with + | nil => + simp only [releaseSharedWork] at run ⊢ + have pairEq : (left, 0) = (leftOut, remaining) := + Except.ok.inj run + cases pairEq + exact ⟨right, heap, rfl, rfl⟩ + | cons head tail => simp [releaseSharedWork] at run + | succ fuel ih => + intro left right leftOut leftValues rightValues remaining heap values run + cases values with + | nil => + simp only [releaseSharedWork] at run ⊢ + have pairEq : (left, fuel + 1) = (leftOut, remaining) := + Except.ok.inj run + cases pairEq + exact ⟨right, heap, rfl, rfl⟩ + | @cons leftValue rightValue leftRest rightRest head tail => + cases head with + | lit => + simp only [releaseSharedWork] at run ⊢ + exact ih heap tail run + | erased => + simp only [releaseSharedWork] at run ⊢ + exact ih heap tail run + | @loc leftLocation rightLocation locations => + cases leftAt : left.get? leftLocation with + | none => simp [releaseSharedWork, leftAt] at run + | some leftBox => + obtain ⟨rightBox, rightAt, boxes⟩ := + heap.boxes locations (by + change left.heap.get? leftLocation = some leftBox + exact leftAt) + cases leftBox with + | mk leftWorld leftRc leftNode => + cases leftWorld with + | unique => simp [releaseSharedWork, leftAt] at run + | shared => + cases rightBox with + | mk rightWorld rightRc rightNode => + have worldEq := boxes.world + have rcEq := boxes.rc + simp only at worldEq rcEq + subst rightWorld + subst rightRc + have rightAtStore : right.get? rightLocation = + some ⟨.shared, leftRc, rightNode⟩ := by + exact rightAt + have nodes : IxIR1.Sim.NodeIso heap.locRel + leftNode rightNode := boxes.node + by_cases zero : leftRc = 0 + · subst leftRc + simp [releaseSharedWork, leftAt] at run + · by_cases unit : leftRc = 1 + · subst leftRc + cases leftNode with + | ctorN cid leftFields => + obtain ⟨rightFields, rightNodeEq, + fieldsRelated⟩ := + nodeIso_ctor_left nodes + let nextHeap := + (heap.rcTick).kill locations + (by + change left.heap.rcTick.get? + leftLocation = some + ⟨.shared, 1, + .ctorN cid leftFields⟩ + exact leftAt) + (by + change right.heap.rcTick.get? + rightLocation = some + ⟨.shared, 1, rightNode⟩ + exact rightAt) + have nextValues : IxIR1.Sim.RValsIso + nextHeap.locRel + (leftFields.toList ++ leftRest) + (rightFields.toList ++ rightRest) := + fieldsRelated.append tail + simp [releaseSharedWork, leftAt, + rightAtStore, rightNodeEq] at run ⊢ + obtain ⟨rightOut, outputHeap, rightRun, + outputRelation⟩ := ih + (left := left.rcTick.kill leftLocation) + (right := right.rcTick.kill + rightLocation) + nextHeap nextValues run + refine ⟨rightOut, rightRun, outputHeap, ?_⟩ + exact outputRelation.trans (by rfl) + | papN address arity leftArguments => + obtain ⟨rightArguments, rightNodeEq, + argumentsRelated⟩ := + nodeIso_pap_left nodes + let nextHeap := + (heap.rcTick).kill locations + (by + change left.heap.rcTick.get? + leftLocation = some + ⟨.shared, 1, .papN address + arity leftArguments⟩ + exact leftAt) + (by + change right.heap.rcTick.get? + rightLocation = some + ⟨.shared, 1, rightNode⟩ + exact rightAt) + have nextValues : IxIR1.Sim.RValsIso + nextHeap.locRel + (leftArguments.toList ++ leftRest) + (rightArguments.toList ++ + rightRest) := + argumentsRelated.append tail + simp [releaseSharedWork, leftAt, + rightAtStore, rightNodeEq] at run ⊢ + obtain ⟨rightOut, outputHeap, rightRun, + outputRelation⟩ := ih + (left := left.rcTick.kill leftLocation) + (right := right.rcTick.kill + rightLocation) + nextHeap nextValues run + refine ⟨rightOut, rightRun, outputHeap, ?_⟩ + exact outputRelation.trans (by rfl) + · have nonzero : (leftRc == 0) = false := + beq_eq_false_iff_ne.mpr zero + have nonunit : (leftRc == 1) = false := + beq_eq_false_iff_ne.mpr unit + let nextHeap := + (heap.rcTick).setBox locations + (by + change left.heap.rcTick.get? + leftLocation = some + ⟨.shared, leftRc, leftNode⟩ + exact leftAt) + (by + change right.heap.rcTick.get? + rightLocation = some + ⟨.shared, leftRc, rightNode⟩ + exact rightAt) + (show IxIR1.Sim.NodeBoxIso heap.locRel + ⟨.shared, leftRc - 1, leftNode⟩ + ⟨.shared, leftRc - 1, rightNode⟩ + from ⟨rfl, rfl, nodes⟩) + simp [releaseSharedWork, leftAt, + rightAtStore, nonzero, nonunit] at run ⊢ + obtain ⟨rightOut, outputHeap, rightRun, + outputRelation⟩ := ih + (left := left.rcTick.setBox leftLocation + ⟨.shared, leftRc - 1, leftNode⟩) + (right := right.rcTick.setBox rightLocation + ⟨.shared, leftRc - 1, rightNode⟩) + nextHeap tail run + refine ⟨rightOut, rightRun, outputHeap, ?_⟩ + exact outputRelation.trans (by rfl) + +/-- Deep unique destruction is allocation-history equivariant at a common +fuel index. -/ +theorem dropUniqueWork_historyIso_sameFuel : + ∀ {fuel : Nat} {left right leftOut : Store} + {leftValues rightValues : List RVal} {remaining : Nat} + (heap : IxIR1.Sim.HeapHistoryIso left.heap right.heap), + IxIR1.Sim.RValsIso heap.locRel leftValues rightValues → + dropUniqueWork fuel left leftValues = .ok (leftOut, remaining) → + ∃ rightOut, + ∃ outputHeap : IxIR1.Sim.HeapHistoryIso leftOut.heap rightOut.heap, + dropUniqueWork fuel right rightValues = + .ok (rightOut, remaining) ∧ + outputHeap.locRel = heap.locRel := by + intro fuel + induction fuel with + | zero => + intro left right leftOut leftValues rightValues remaining heap values run + cases values with + | nil => + simp only [dropUniqueWork] at run ⊢ + have pairEq : (left, 0) = (leftOut, remaining) := + Except.ok.inj run + cases pairEq + exact ⟨right, heap, rfl, rfl⟩ + | cons head tail => simp [dropUniqueWork] at run + | succ fuel ih => + intro left right leftOut leftValues rightValues remaining heap values run + cases values with + | nil => + simp only [dropUniqueWork] at run ⊢ + have pairEq : (left, fuel + 1) = (leftOut, remaining) := + Except.ok.inj run + cases pairEq + exact ⟨right, heap, rfl, rfl⟩ + | @cons leftValue rightValue leftRest rightRest head tail => + cases head with + | lit => + simp only [dropUniqueWork] at run ⊢ + exact ih heap tail run + | erased => + simp only [dropUniqueWork] at run ⊢ + exact ih heap tail run + | @loc leftLocation rightLocation locations => + cases leftAt : left.get? leftLocation with + | none => simp [dropUniqueWork, leftAt] at run + | some leftBox => + obtain ⟨rightBox, rightAt, boxes⟩ := + heap.boxes locations (by + change left.heap.get? leftLocation = some leftBox + exact leftAt) + cases leftBox with + | mk leftWorld leftRc leftNode => + cases leftWorld with + | shared => simp [dropUniqueWork, leftAt] at run + | unique => + cases rightBox with + | mk rightWorld rightRc rightNode => + have worldEq := boxes.world + have rcEq := boxes.rc + simp only at worldEq rcEq + subst rightWorld + subst rightRc + have rightAtStore : right.get? rightLocation = + some ⟨.unique, leftRc, rightNode⟩ := by + exact rightAt + have nodes : IxIR1.Sim.NodeIso heap.locRel + leftNode rightNode := boxes.node + cases leftNode with + | papN address arity arguments => + simp [dropUniqueWork, leftAt] at run + | ctorN cid leftFields => + obtain ⟨rightFields, rightNodeEq, + fieldsRelated⟩ := nodeIso_ctor_left nodes + let nextHeap := heap.kill locations + (by + change left.heap.get? leftLocation = some + ⟨.unique, leftRc, + .ctorN cid leftFields⟩ + exact leftAt) + (by + change right.heap.get? rightLocation = + some ⟨.unique, leftRc, rightNode⟩ + exact rightAt) + have nextValues : IxIR1.Sim.RValsIso + nextHeap.locRel + (leftFields.toList ++ leftRest) + (rightFields.toList ++ rightRest) := + fieldsRelated.append tail + simp [dropUniqueWork, leftAt, rightAtStore, + rightNodeEq] at run ⊢ + obtain ⟨rightOut, outputHeap, rightRun, + outputRelation⟩ := ih + (left := left.kill leftLocation) + (right := right.kill rightLocation) + nextHeap nextValues run + refine ⟨rightOut, rightRun, outputHeap, ?_⟩ + exact outputRelation.trans (by rfl) + +/-- Related runtime values report the same dynamic ownership world in +isomorphic evaluator heaps. -/ +theorem heapIso_rvalHasWorld_eq {left right : Store} + (iso : IxIR1.Sim.HeapIso left.heap right.heap) + {leftValue rightValue : RVal} + (related : IxIR1.Sim.RValIso iso.locRel leftValue rightValue) + (world : Owned) : + RVal.hasWorld left world leftValue = + RVal.hasWorld right world rightValue := by + cases related with + | loc locationRelated => + obtain ⟨leftBox, rightBox, leftAt, rightAt, boxes⟩ := + iso.related_live locationRelated + simp [RVal.hasWorld, Eval.Store.get?, leftAt, rightAt, boxes.world] + | lit => rfl + | erased => rfl + +/-- Uniform constructor-field validation transports pointwise across a live +heap isomorphism and its related value vector. -/ +theorem heapIso_fieldWorlds_of_replicate {left right : Store} + (iso : IxIR1.Sim.HeapIso left.heap right.heap) + {schema : CtorSchema} {leftValues rightValues : Array RVal} + {world : Owned} {count : Nat} + (schemaFields : schema.fields = Array.replicate count world) + (related : IxIR1.Sim.RValsIso iso.locRel + leftValues.toList rightValues.toList) + (fieldWorlds : FieldWorlds left schema leftValues) : + FieldWorlds right schema rightValues := by + obtain ⟨leftCount, leftWorlds⟩ := + fieldWorlds.to_replicate schemaFields + have valueCounts : leftValues.size = rightValues.size := by + simpa using rvalsIso_length_eq related + have rightCount : rightValues.size = count := + valueCounts.symm.trans leftCount + have transfer : ∀ {lefts rights : List RVal}, + IxIR1.Sim.RValsIso iso.locRel lefts rights → + (∀ value ∈ lefts, RVal.hasWorld left world value = true) → + ∀ value ∈ rights, RVal.hasWorld right world value = true := by + intro lefts rights valuesRelated + induction valuesRelated with + | nil => simp + | @cons leftValue rightValue lefts rights head tail ih => + intro sourceWorlds value member + simp only [List.mem_cons] at member + rcases member with rfl | member + · rw [← heapIso_rvalHasWorld_eq iso head world] + exact sourceWorlds leftValue (by simp) + · apply ih + · intro sourceValue sourceMember + exact sourceWorlds sourceValue (by simp [sourceMember]) + · exact member + exact FieldWorlds.of_replicate schemaFields rightCount + (transfer related leftWorlds) + +/-- Values accepted by a uniform field schema cannot name a missing heap +location. This is the local freshness fact used when restricting an existing +heap bijection after a hot reset consumes its source node. -/ +theorem FieldWorlds.avoidsMissing {store : Store} {schema : CtorSchema} + {values : Array RVal} {world : Owned} {count location : Nat} + (schemaFields : schema.fields = Array.replicate count world) + (worlds : FieldWorlds store schema values) + (missing : store.get? location = none) : + ∀ value ∈ values.toList, value ≠ .loc location := by + obtain ⟨_count, valuesWorld⟩ := worlds.to_replicate schemaFields + intro value member + have valueWorld := valuesWorld value member + cases value with + | loc actual => + intro same + cases same + simp [RVal.hasWorld, missing] at valueWorld + | lit literal => intro impossible; cases impossible + | erased => intro impossible; cases impossible + +/-- A scalar, or a live shared location with a positive refcount. This is +the local safety fact needed to show that releasing a freshly retained field +takes the non-final branch. -/ +def SharedPositive (store : Store) : RVal → Prop + | .loc location => + ∃ rc node, store.get? location = some ⟨.shared, rc, node⟩ ∧ 0 < rc + | .lit _ | .erased => True + +/-- Every field edge of an exactly owned shared node points to a positive +shared value (or is scalar). -/ +theorem sharedChild_positive {store : Store} {parent parentRc : Nat} + {node : IxIR1.Node} {roots : List IxIR1.Sim.Root} {child : RVal} + (parentAt : store.get? parent = + some ⟨.shared, parentRc, node⟩) + (owned : IxIR1.Sim.RootOwnership store.heap roots) + (member : child ∈ IxIR1.Sim.nodeChildren node) : + SharedPositive store child := by + cases child with + | lit literal => trivial + | erased => trivial + | loc childLocation => + have childWorld := owned.edges_world parentAt (.loc childLocation) member + obtain ⟨childBox, childAt, childBoxWorld⟩ := childWorld + cases childBox with + | mk world rc childNode => + change world = .shared at childBoxWorld + subst world + have count := owned.counts childAt + change rc = IxIR1.Sim.incoming store.heap roots childLocation at count + have edge : childLocation ∈ IxIR1.Sim.edgeLocations store.heap := + IxIR1.Sim.child_location_mem_edgeLocations parentAt member + have positiveIncoming : + 0 < IxIR1.Sim.incoming store.heap roots childLocation := by + rw [IxIR1.Sim.incoming, List.count_pos_iff] + exact List.mem_append_right _ edge + exact ⟨rc, childNode, childAt, by omega⟩ + +/-- Killing a different live slot preserves positivity. -/ +theorem SharedPositive.kill {store : Store} {value : RVal} + {target : Nat} {targetBox : IxIR1.NodeBox} + (positive : SharedPositive store value) + (targetAt : store.get? target = some targetBox) + (different : value ≠ .loc target) : + SharedPositive (store.kill target) value := by + cases value with + | lit literal => trivial + | erased => trivial + | loc location => + obtain ⟨rc, node, valueAt, rcPositive⟩ := positive + have targetNe : target ≠ location := by + intro same + subst location + exact different rfl + exact ⟨rc, node, + IxIR1.Sim.get?_kill_other targetNe targetAt valueAt, rcPositive⟩ + +/-- Retaining any value preserves positivity of every already-positive shared +value. -/ +theorem SharedPositive.retain {store retained : Store} + {preserved changed : RVal} + (positive : SharedPositive store preserved) + (run : retainShared store changed = .ok retained) : + SharedPositive retained preserved := by + cases preserved with + | lit literal => trivial + | erased => trivial + | loc protectedLocation => + obtain ⟨protectedRc, protectedNode, protectedAt, protectedPositive⟩ := + positive + cases changed with + | lit literal => + have storeEq : store = retained := by + simpa [retainShared] using run + subst retained + exact ⟨protectedRc, protectedNode, protectedAt, protectedPositive⟩ + | erased => + have storeEq : store = retained := by + simpa [retainShared] using run + subst retained + exact ⟨protectedRc, protectedNode, protectedAt, protectedPositive⟩ + | loc changedLocation => + cases changedAt : store.get? changedLocation with + | none => simp [retainShared, changedAt] at run + | some changedBox => + cases changedBox with + | mk changedWorld changedRc changedNode => + cases changedWorld with + | unique => simp [retainShared, changedAt] at run + | shared => + have retainedEq : + incrementSharedStore store changedLocation + ⟨.shared, changedRc, changedNode⟩ = retained := by + simpa [retainShared, changedAt, incrementSharedStore] + using run + subst retained + by_cases same : changedLocation = protectedLocation + · subst changedLocation + have boxEq : + (⟨.shared, changedRc, changedNode⟩ : + IxIR1.NodeBox) = + ⟨.shared, protectedRc, protectedNode⟩ := + Option.some.inj (changedAt.symm.trans protectedAt) + cases boxEq + exact ⟨protectedRc + 1, protectedNode, + get?_incrementSharedStore_same protectedAt, by omega⟩ + · exact ⟨protectedRc, protectedNode, + get?_incrementSharedStore_other same changedAt + protectedAt, + protectedPositive⟩ + +/-- A successful batch of retains preserves positivity of every previously +positive shared value. -/ +theorem RetainSharedMany.preserve_positive {store retained : Store} + {values : List RVal} {preserved : RVal} + (run : RetainSharedMany store values.toArray retained) + (positive : SharedPositive store preserved) : + SharedPositive retained preserved := by + induction values generalizing store with + | nil => + change (.ok store : Except Error Store) = .ok retained at run + injection run with storeEq + subst retained + exact positive + | cons value values ih => + obtain ⟨middle, head, tail⟩ := + Eval.RetainSharedMany.cons_inv (run := run) + exact ih tail (positive.retain head) + +private theorem setIfInBounds_existing {entries : Array (Option IxIR1.NodeBox)} + {location : Nat} {box : IxIR1.NodeBox} + (found : entries[location]? = some (some box)) : + entries.setIfInBounds location (some box) = entries := by + apply Array.ext_getElem? + intro other + by_cases same : location = other + · subst other + obtain ⟨bound, atLocation⟩ := Array.getElem?_eq_some_iff.mp found + simp [bound, atLocation] + · simp [same] + +/-- Releasing a just-retained positive shared value cancels its refcount +increment in the semantic heap, even when the release starts from a store +whose accounting counters differ. The remaining work list and heap-fuel +suffix are exposed unchanged. -/ +theorem releaseRetainedHead {base retained releaseStart : Store} + {value : RVal} {rest : List RVal} {heapFuel : Nat} + (positive : SharedPositive base value) + (retainedRun : retainShared base value = .ok retained) + (contents : HeapContentsEq releaseStart retained) : + ∃ afterHead, + releaseSharedWork (heapFuel + 1) releaseStart (value :: rest) = + releaseSharedWork heapFuel afterHead rest ∧ + HeapContentsEq afterHead base := by + cases value with + | lit literal => + have baseEq : base = retained := by + simpa [retainShared] using retainedRun + subst retained + exact ⟨releaseStart, rfl, contents⟩ + | erased => + have baseEq : base = retained := by + simpa [retainShared] using retainedRun + subst retained + exact ⟨releaseStart, rfl, contents⟩ + | loc location => + obtain ⟨rc, node, baseAt, rcPositive⟩ := positive + have retainedEq : + incrementSharedStore base location ⟨.shared, rc, node⟩ = + retained := by + simpa [retainShared, baseAt, incrementSharedStore] using retainedRun + subst retained + have retainedAt := get?_incrementSharedStore_same baseAt + have releaseAt : releaseStart.get? location = + some ⟨.shared, rc + 1, node⟩ := by + rw [contents.get?_eq location] + exact retainedAt + let afterHead := baselineDecrementStore releaseStart location + ⟨.shared, rc + 1, node⟩ + refine ⟨afterHead, ?_, ?_⟩ + · have nonzero : (rc + 1 == 0) = false := + beq_eq_false_iff_ne.mpr (by omega) + have nonunit : (rc + 1 == 1) = false := + beq_eq_false_iff_ne.mpr (by omega) + simp [releaseSharedWork, releaseAt, nonzero, nonunit, + afterHead, baselineDecrementStore] + · constructor + have baseNodesAt : base.heap.nodes[location]? = + some (some ⟨.shared, rc, node⟩) := + IxIR1.Sim.nodes_get?_of_get? baseAt + have restored := setIfInBounds_existing baseNodesAt + simpa [afterHead, baselineDecrementStore, incrementSharedStore, + Eval.Store.setBox, Eval.Store.rcTick, IxIR1.Store.setBox, + IxIR1.Store.rcTick, Array.set!_eq_setIfInBounds, contents.nodes] + using restored + +/-- Retaining a vector of positive shared fields and subsequently releasing +the same vector restores the exact node array. The release may start from a +counter-different store, which is needed after the parent's hot shallow +free. -/ +theorem retainedFields_release_roundtrip : + ∀ {base retained releaseStart output : Store} {values : List RVal} + {heapFuel remaining : Nat}, + (∀ value ∈ values, SharedPositive base value) → + RetainSharedMany base values.toArray retained → + HeapContentsEq releaseStart retained → + releaseSharedWork heapFuel releaseStart values = + .ok (output, remaining) → + HeapContentsEq output base := by + intro base retained releaseStart output values + induction values generalizing base retained releaseStart output with + | nil => + intro heapFuel remaining _ retainedRun contents releaseRun + change (.ok base : Except Error Store) = .ok retained at retainedRun + injection retainedRun with retainedEq + subst retained + have releaseEq : + (.ok (releaseStart, heapFuel) : Except Error (Store × Nat)) = + .ok (output, remaining) := by + cases heapFuel <;> simpa [releaseSharedWork] using releaseRun + have pairEq : (releaseStart, heapFuel) = (output, remaining) := + Except.ok.inj releaseEq + cases pairEq + exact contents + | cons head tail ih => + intro heapFuel remaining positives retainedRun contents releaseRun + cases heapFuel with + | zero => simp [releaseSharedWork] at releaseRun + | succ heapFuel => + obtain ⟨middle, tailRetained, headRetained⟩ := + RetainSharedMany.rotate_head retainedRun + have headPositive : SharedPositive base head := + positives head (by simp) + have headPositiveMiddle : SharedPositive middle head := + RetainSharedMany.preserve_positive tailRetained headPositive + obtain ⟨afterHead, releaseHead, afterHeadContents⟩ := + releaseRetainedHead headPositiveMiddle headRetained contents + rw [releaseHead] at releaseRun + apply ih + · intro value member + exact positives value (by simp [member]) + · exact tailRetained + · exact afterHeadContents + · exact releaseRun + +/-- The compiler-emitted hot baseline prefix—retain every projected field, +then deep-release the unit-refcount parent—has exactly the same node array as +the logical hot reset's shallow parent kill. + +The premise is the baseline evaluator's successful release equation. The +proof derives its child-work suffix, cancels every retain/release pair, and +uses exact ownership to rule out a self-field pointing back to the unit +parent. -/ +theorem hotPrefix_contents {store baselineRetained output : Store} + {target : Nat} {cid : CtorId} {fields : Array RVal} + {fieldFuel remaining : Nat} {ambient : List IxIR1.Sim.Root} + (targetAt : store.get? target = + some ⟨.shared, 1, .ctorN cid fields⟩) + (owned : IxIR1.Sim.RootOwnership store.heap + (⟨.shared, .loc target⟩ :: ambient)) + (retained : RetainSharedMany store fields baselineRetained) + (released : releaseShared (fieldFuel + 1) baselineRetained + (.loc target) = .ok (output, remaining)) : + HeapContentsEq output (logicalHotResetStore store target) := by + have different : ∀ value ∈ fields.toList, value ≠ .loc target := by + intro value member + apply owned.sole_child_ne targetAt targetAt + simpa [IxIR1.Sim.nodeChildren] using member + have retainedList : + RetainSharedMany store fields.toList.toArray baselineRetained := by + simpa using retained + have retainedTarget : baselineRetained.get? target = + some ⟨.shared, 1, .ctorN cid fields⟩ := + RetainSharedMany.preserves_box targetAt different retainedList + have childRelease : + releaseSharedWork fieldFuel + (baselineRetained.rcTick.kill target) fields.toList = + .ok (output, remaining) := by + unfold releaseShared at released + simpa [releaseSharedWork, retainedTarget] using released + have retainedAfterKill : + RetainSharedMany (store.kill target) fields.toList.toArray + (baselineRetained.kill target) := + RetainSharedMany.kill_commute targetAt different retainedList + have positives : ∀ value ∈ fields.toList, + SharedPositive (store.kill target) value := by + intro value member + exact (sharedChild_positive targetAt owned + (by simpa [IxIR1.Sim.nodeChildren] using member)).kill targetAt + (different value member) + have releaseStartContents : + HeapContentsEq (baselineRetained.rcTick.kill target) + (baselineRetained.kill target) := ⟨rfl⟩ + have restored : HeapContentsEq output (store.kill target) := + retainedFields_release_roundtrip positives retainedAfterKill + releaseStartContents childRelease + exact restored.trans ⟨rfl⟩ + +/-- Deep shared release is congruent under exact node-array equality. It +therefore cannot observe the reset and RC accounting differences intentionally +forgotten by `HeapContentsEq`. -/ +theorem releaseSharedWork_contents_congr : + ∀ {fuel : Nat} {left right : Store} {values : List RVal} + {leftOut : Store} {remaining : Nat}, + HeapContentsEq left right → + releaseSharedWork fuel left values = .ok (leftOut, remaining) → + ∃ rightOut, + releaseSharedWork fuel right values = .ok (rightOut, remaining) ∧ + HeapContentsEq leftOut rightOut := by + intro fuel + induction fuel with + | zero => + intro left right values leftOut remaining heaps run + cases values with + | nil => + simp only [releaseSharedWork] at run ⊢ + have pairEq : (left, 0) = (leftOut, remaining) := + Except.ok.inj run + cases pairEq + exact ⟨right, rfl, heaps⟩ + | cons value rest => simp [releaseSharedWork] at run + | succ fuel ih => + intro left right values leftOut remaining heaps run + cases values with + | nil => + simp only [releaseSharedWork] at run ⊢ + have pairEq : (left, fuel + 1) = (leftOut, remaining) := + Except.ok.inj run + cases pairEq + exact ⟨right, rfl, heaps⟩ + | cons value rest => + cases value with + | lit literal => + simp only [releaseSharedWork] at run ⊢ + exact ih heaps run + | erased => + simp only [releaseSharedWork] at run ⊢ + exact ih heaps run + | loc location => + have lookup := heaps.get?_eq location + cases leftAt : left.get? location with + | none => simp [releaseSharedWork, leftAt] at run + | some box => + have rightAt : right.get? location = some box := by + rw [← lookup] + exact leftAt + cases box with + | mk world rc node => + cases world with + | unique => + simp [releaseSharedWork, leftAt] at run + | shared => + by_cases zero : rc = 0 + · subst rc + simp [releaseSharedWork, leftAt] at run + · by_cases unit : rc = 1 + · subst rc + simp [releaseSharedWork, leftAt, rightAt] + at run ⊢ + exact ih (heaps.rcTick.kill location) run + · have nonzero : (rc == 0) = false := + beq_eq_false_iff_ne.mpr zero + have nonunit : (rc == 1) = false := + beq_eq_false_iff_ne.mpr unit + simp [releaseSharedWork, leftAt, rightAt, + nonzero, nonunit] at run ⊢ + exact ih + ((heaps.rcTick).setBox location + ⟨.shared, rc - 1, node⟩) run + +/-- The public single-value release operation inherits exact-content +congruence from its work-list implementation. -/ +theorem HeapContentsEq.releaseShared {left right leftOut : Store} + (heaps : HeapContentsEq left right) {fuel remaining : Nat} + {value : RVal} + (run : releaseShared fuel left value = .ok (leftOut, remaining)) : + ∃ rightOut, + releaseShared fuel right value = .ok (rightOut, remaining) ∧ + HeapContentsEq leftOut rightOut := by + unfold Eval.releaseShared at run ⊢ + exact releaseSharedWork_contents_congr heaps run + +/-- Extra heap fuel is preserved as extra remainder by a successful shared +release traversal. -/ +theorem releaseSharedWork_addFuel : + ∀ {fuel : Nat} {store output : Store} {values : List RVal} + {remaining : Nat} (extra : Nat), + releaseSharedWork fuel store values = .ok (output, remaining) → + releaseSharedWork (fuel + extra) store values = + .ok (output, remaining + extra) := by + intro fuel + induction fuel with + | zero => + intro store output values remaining extra run + cases values with + | nil => + simp only [releaseSharedWork] at run ⊢ + have pairEq : (store, 0) = (output, remaining) := + Except.ok.inj run + cases pairEq + rfl + | cons value rest => simp [releaseSharedWork] at run + | succ fuel ih => + intro store output values remaining extra run + cases values with + | nil => + simp only [releaseSharedWork] at run ⊢ + have pairEq : (store, fuel + 1) = (output, remaining) := + Except.ok.inj run + cases pairEq + rfl + | cons value rest => + rw [show fuel + 1 + extra = (fuel + extra) + 1 by omega] + cases value with + | lit literal => + simp only [releaseSharedWork] at run ⊢ + exact ih extra run + | erased => + simp only [releaseSharedWork] at run ⊢ + exact ih extra run + | loc location => + cases found : store.get? location with + | none => simp [releaseSharedWork, found] at run + | some box => + cases box with + | mk world rc node => + cases world with + | unique => simp [releaseSharedWork, found] at run + | shared => + by_cases zero : rc = 0 + · subst rc + simp [releaseSharedWork, found] at run + · by_cases unit : rc = 1 + · subst rc + simp [releaseSharedWork, found] at run ⊢ + exact ih extra run + · have nonzero : (rc == 0) = false := + beq_eq_false_iff_ne.mpr zero + have nonunit : (rc == 1) = false := + beq_eq_false_iff_ne.mpr unit + simp [releaseSharedWork, found, nonzero, + nonunit] at run ⊢ + exact ih extra run + +/-- Deep shared release with extra target fuel preserves fuel dominance; the +additional target budget remains as an equal additive suffix. -/ +theorem releaseSharedWork_historyIso {left right leftOut : Store} + (heap : IxIR1.Sim.HeapHistoryIso left.heap right.heap) + {leftFuel rightFuel remaining : Nat} + {leftValues rightValues : List RVal} + (fuel : leftFuel ≤ rightFuel) + (values : IxIR1.Sim.RValsIso heap.locRel leftValues rightValues) + (run : releaseSharedWork leftFuel left leftValues = + .ok (leftOut, remaining)) : + ∃ rightOut rightRemaining, + ∃ outputHeap : IxIR1.Sim.HeapHistoryIso leftOut.heap rightOut.heap, + releaseSharedWork rightFuel right rightValues = + .ok (rightOut, rightRemaining) ∧ + remaining ≤ rightRemaining ∧ + outputHeap.locRel = heap.locRel := by + obtain ⟨rightOut, outputHeap, sameFuelRun, outputRelation⟩ := + releaseSharedWork_historyIso_sameFuel heap values run + let extra := rightFuel - leftFuel + have extended := releaseSharedWork_addFuel extra sameFuelRun + have fuelEq : leftFuel + extra = rightFuel := Nat.add_sub_of_le fuel + refine ⟨rightOut, remaining + extra, outputHeap, ?_, + Nat.le_add_right remaining extra, outputRelation⟩ + simpa [fuelEq] using extended + +/-- A successful shared release cannot increase its heap-fuel remainder. -/ +theorem releaseSharedWork_remaining_le : + ∀ {fuel : Nat} {store output : Store} {values : List RVal} + {remaining : Nat}, + releaseSharedWork fuel store values = .ok (output, remaining) → + remaining ≤ fuel := by + intro fuel + induction fuel with + | zero => + intro store output values remaining run + cases values with + | nil => + simp only [releaseSharedWork] at run + have pairEq : (store, 0) = (output, remaining) := + Except.ok.inj run + cases pairEq + exact Nat.le_refl 0 + | cons value rest => simp [releaseSharedWork] at run + | succ fuel ih => + intro store output values remaining run + cases values with + | nil => + simp only [releaseSharedWork] at run + have pairEq : (store, fuel + 1) = (output, remaining) := + Except.ok.inj run + cases pairEq + exact Nat.le_refl _ + | cons value rest => + have finish : remaining ≤ fuel → remaining ≤ fuel + 1 := + Nat.le_succ_of_le + cases value with + | lit literal => + simp only [releaseSharedWork] at run + exact finish (ih run) + | erased => + simp only [releaseSharedWork] at run + exact finish (ih run) + | loc location => + cases found : store.get? location with + | none => simp [releaseSharedWork, found] at run + | some box => + cases box with + | mk world rc node => + cases world with + | unique => simp [releaseSharedWork, found] at run + | shared => + by_cases zero : rc = 0 + · subst rc + simp [releaseSharedWork, found] at run + · by_cases unit : rc = 1 + · subst rc + simp [releaseSharedWork, found] at run + exact finish (ih run) + · have nonzero : (rc == 0) = false := + beq_eq_false_iff_ne.mpr zero + have nonunit : (rc == 1) = false := + beq_eq_false_iff_ne.mpr unit + simp [releaseSharedWork, found, nonzero, + nonunit] at run + exact finish (ih run) + +/-- Batch shared release transports across exact heap contents while allowing +the rewritten machine to start with additional traversal fuel. -/ +theorem HeapContentsEq.releaseSharedWork_of_le {left right leftOut : Store} + (heaps : HeapContentsEq left right) + {baselineFuel rewrittenFuel remaining : Nat} {values : List RVal} + (fuel : baselineFuel ≤ rewrittenFuel) + (run : releaseSharedWork baselineFuel left values = + .ok (leftOut, remaining)) : + ∃ rightOut rightRemaining, + releaseSharedWork rewrittenFuel right values = + .ok (rightOut, rightRemaining) ∧ + HeapContentsEq leftOut rightOut ∧ + remaining ≤ rightRemaining := by + obtain ⟨rightOut, sameFuelRun, outputHeaps⟩ := + releaseSharedWork_contents_congr heaps run + let extra := rewrittenFuel - baselineFuel + have extended := releaseSharedWork_addFuel extra sameFuelRun + have fuelEq : baselineFuel + extra = rewrittenFuel := by + exact Nat.add_sub_of_le fuel + refine ⟨rightOut, remaining + extra, ?_, outputHeaps, + Nat.le_add_right remaining extra⟩ + simpa [fuelEq] using extended + +theorem releaseShared_remaining_le {fuel remaining : Nat} + {store output : Store} {value : RVal} + (run : Eval.releaseShared fuel store value = .ok (output, remaining)) : + remaining ≤ fuel := by + unfold Eval.releaseShared at run + exact releaseSharedWork_remaining_le run + +theorem releaseShared_addFuel {fuel remaining : Nat} + {store output : Store} {value : RVal} (extra : Nat) + (run : Eval.releaseShared fuel store value = .ok (output, remaining)) : + Eval.releaseShared (fuel + extra) store value = + .ok (output, remaining + extra) := by + unfold Eval.releaseShared at run ⊢ + exact releaseSharedWork_addFuel extra run + +/-- Exact-content release simulation permits the rewritten machine to carry +additional heap fuel, as it does after replacing deep release by reset. -/ +theorem HeapContentsEq.releaseShared_of_le {left right leftOut : Store} + (heaps : HeapContentsEq left right) + {baselineFuel rewrittenFuel remaining : Nat} {value : RVal} + (fuel : baselineFuel ≤ rewrittenFuel) + (run : Eval.releaseShared baselineFuel left value = + .ok (leftOut, remaining)) : + ∃ rightOut rightRemaining, + Eval.releaseShared rewrittenFuel right value = + .ok (rightOut, rightRemaining) ∧ + HeapContentsEq leftOut rightOut ∧ + remaining ≤ rightRemaining := by + obtain ⟨rightOut, sameFuelRun, outputHeaps⟩ := + heaps.releaseShared run + let extra := rewrittenFuel - baselineFuel + have extended := releaseShared_addFuel extra sameFuelRun + have fuelEq : baselineFuel + extra = rewrittenFuel := by + exact Nat.add_sub_of_le fuel + refine ⟨rightOut, remaining + extra, ?_, outputHeaps, + Nat.le_add_right remaining extra⟩ + simpa [fuelEq] using extended + +/-- Deep unique destruction is likewise insensitive to accounting counters +when the semantic node arrays agree. -/ +theorem dropUniqueWork_contents_congr : + ∀ {fuel : Nat} {left right : Store} {values : List RVal} + {leftOut : Store} {remaining : Nat}, + HeapContentsEq left right → + dropUniqueWork fuel left values = .ok (leftOut, remaining) → + ∃ rightOut, + dropUniqueWork fuel right values = .ok (rightOut, remaining) ∧ + HeapContentsEq leftOut rightOut := by + intro fuel + induction fuel with + | zero => + intro left right values leftOut remaining heaps run + cases values with + | nil => + simp only [dropUniqueWork] at run ⊢ + have pairEq : (left, 0) = (leftOut, remaining) := + Except.ok.inj run + cases pairEq + exact ⟨right, rfl, heaps⟩ + | cons value rest => simp [dropUniqueWork] at run + | succ fuel ih => + intro left right values leftOut remaining heaps run + cases values with + | nil => + simp only [dropUniqueWork] at run ⊢ + have pairEq : (left, fuel + 1) = (leftOut, remaining) := + Except.ok.inj run + cases pairEq + exact ⟨right, rfl, heaps⟩ + | cons value rest => + cases value with + | lit literal => + simp only [dropUniqueWork] at run ⊢ + exact ih heaps run + | erased => + simp only [dropUniqueWork] at run ⊢ + exact ih heaps run + | loc location => + have lookup := heaps.get?_eq location + cases leftAt : left.get? location with + | none => simp [dropUniqueWork, leftAt] at run + | some box => + have rightAt : right.get? location = some box := by + rw [← lookup] + exact leftAt + cases box with + | mk world rc node => + cases world with + | shared => simp [dropUniqueWork, leftAt] at run + | unique => + cases node with + | papN address arity arguments => + simp [dropUniqueWork, leftAt] at run + | ctorN cid fields => + simp [dropUniqueWork, leftAt, rightAt] at run ⊢ + exact ih (heaps.kill location) run + +/-- The public single-value unique drop inherits exact-content congruence. -/ +theorem HeapContentsEq.dropUnique {left right leftOut : Store} + (heaps : HeapContentsEq left right) {fuel remaining : Nat} + {value : RVal} + (run : Eval.dropUnique fuel left value = .ok (leftOut, remaining)) : + ∃ rightOut, + Eval.dropUnique fuel right value = .ok (rightOut, remaining) ∧ + HeapContentsEq leftOut rightOut := by + unfold Eval.dropUnique at run ⊢ + exact dropUniqueWork_contents_congr heaps run + +/-- Extra heap fuel is preserved as extra remainder by successful unique +destruction. -/ +theorem dropUniqueWork_addFuel : + ∀ {fuel : Nat} {store output : Store} {values : List RVal} + {remaining : Nat} (extra : Nat), + dropUniqueWork fuel store values = .ok (output, remaining) → + dropUniqueWork (fuel + extra) store values = + .ok (output, remaining + extra) := by + intro fuel + induction fuel with + | zero => + intro store output values remaining extra run + cases values with + | nil => + simp only [dropUniqueWork] at run ⊢ + have pairEq : (store, 0) = (output, remaining) := + Except.ok.inj run + cases pairEq + rfl + | cons value rest => simp [dropUniqueWork] at run + | succ fuel ih => + intro store output values remaining extra run + cases values with + | nil => + simp only [dropUniqueWork] at run ⊢ + have pairEq : (store, fuel + 1) = (output, remaining) := + Except.ok.inj run + cases pairEq + rfl + | cons value rest => + rw [show fuel + 1 + extra = (fuel + extra) + 1 by omega] + cases value with + | lit literal => + simp only [dropUniqueWork] at run ⊢ + exact ih extra run + | erased => + simp only [dropUniqueWork] at run ⊢ + exact ih extra run + | loc location => + cases found : store.get? location with + | none => simp [dropUniqueWork, found] at run + | some box => + cases box with + | mk world rc node => + cases world with + | shared => simp [dropUniqueWork, found] at run + | unique => + cases node with + | papN address arity arguments => + simp [dropUniqueWork, found] at run + | ctorN cid fields => + simp [dropUniqueWork, found] at run ⊢ + exact ih extra run + +/-- Unique destruction with extra target fuel preserves the history relation +and leaves the extra budget as an additive suffix. -/ +theorem dropUniqueWork_historyIso {left right leftOut : Store} + (heap : IxIR1.Sim.HeapHistoryIso left.heap right.heap) + {leftFuel rightFuel remaining : Nat} + {leftValues rightValues : List RVal} + (fuel : leftFuel ≤ rightFuel) + (values : IxIR1.Sim.RValsIso heap.locRel leftValues rightValues) + (run : dropUniqueWork leftFuel left leftValues = + .ok (leftOut, remaining)) : + ∃ rightOut rightRemaining, + ∃ outputHeap : IxIR1.Sim.HeapHistoryIso leftOut.heap rightOut.heap, + dropUniqueWork rightFuel right rightValues = + .ok (rightOut, rightRemaining) ∧ + remaining ≤ rightRemaining ∧ + outputHeap.locRel = heap.locRel := by + obtain ⟨rightOut, outputHeap, sameFuelRun, outputRelation⟩ := + dropUniqueWork_historyIso_sameFuel heap values run + let extra := rightFuel - leftFuel + have extended := dropUniqueWork_addFuel extra sameFuelRun + have fuelEq : leftFuel + extra = rightFuel := Nat.add_sub_of_le fuel + refine ⟨rightOut, remaining + extra, outputHeap, ?_, + Nat.le_add_right remaining extra, outputRelation⟩ + simpa [fuelEq] using extended + +theorem dropUniqueWork_remaining_le : + ∀ {fuel : Nat} {store output : Store} {values : List RVal} + {remaining : Nat}, + dropUniqueWork fuel store values = .ok (output, remaining) → + remaining ≤ fuel := by + intro fuel + induction fuel with + | zero => + intro store output values remaining run + cases values with + | nil => + simp only [dropUniqueWork] at run + have pairEq : (store, 0) = (output, remaining) := + Except.ok.inj run + cases pairEq + exact Nat.le_refl 0 + | cons value rest => simp [dropUniqueWork] at run + | succ fuel ih => + intro store output values remaining run + cases values with + | nil => + simp only [dropUniqueWork] at run + have pairEq : (store, fuel + 1) = (output, remaining) := + Except.ok.inj run + cases pairEq + exact Nat.le_refl _ + | cons value rest => + have finish : remaining ≤ fuel → remaining ≤ fuel + 1 := + Nat.le_succ_of_le + cases value with + | lit literal => + simp only [dropUniqueWork] at run + exact finish (ih run) + | erased => + simp only [dropUniqueWork] at run + exact finish (ih run) + | loc location => + cases found : store.get? location with + | none => simp [dropUniqueWork, found] at run + | some box => + cases box with + | mk world rc node => + cases world with + | shared => simp [dropUniqueWork, found] at run + | unique => + cases node with + | papN address arity arguments => + simp [dropUniqueWork, found] at run + | ctorN cid fields => + simp [dropUniqueWork, found] at run + exact finish (ih run) + +theorem dropUnique_addFuel {fuel remaining : Nat} + {store output : Store} {value : RVal} (extra : Nat) + (run : Eval.dropUnique fuel store value = .ok (output, remaining)) : + Eval.dropUnique (fuel + extra) store value = + .ok (output, remaining + extra) := by + unfold Eval.dropUnique at run ⊢ + exact dropUniqueWork_addFuel extra run + +theorem HeapContentsEq.dropUnique_of_le {left right leftOut : Store} + (heaps : HeapContentsEq left right) + {baselineFuel rewrittenFuel remaining : Nat} {value : RVal} + (fuel : baselineFuel ≤ rewrittenFuel) + (run : Eval.dropUnique baselineFuel left value = + .ok (leftOut, remaining)) : + ∃ rightOut rightRemaining, + Eval.dropUnique rewrittenFuel right value = + .ok (rightOut, rightRemaining) ∧ + HeapContentsEq leftOut rightOut ∧ + remaining ≤ rightRemaining := by + obtain ⟨rightOut, sameFuelRun, outputHeaps⟩ := heaps.dropUnique run + let extra := rewrittenFuel - baselineFuel + have extended := dropUnique_addFuel extra sameFuelRun + have fuelEq : baselineFuel + extra = rewrittenFuel := by + exact Nat.add_sub_of_le fuel + refine ⟨rightOut, remaining + extra, ?_, outputHeaps, + Nat.le_add_right remaining extra⟩ + simpa [fuelEq] using extended + +/-- The store at which the executable cold reset begins retaining projected +fields. -/ +def coldResetStartStore (store : Store) (location : Nat) + (box : IxIR1.NodeBox) : Store := + ((((store.tickResetAttempt).setBox location + { box with rc := box.rc - 1 }).rcTick).tickColdReset) + +theorem coldResetStartStore_eq (store : Store) (location : Nat) + (box : IxIR1.NodeBox) : + coldResetStartStore store location box = + (baselineDecrementStore store location box).tickResetAttempt.tickColdReset := by + cases store with + | mk heap resetAttempts hotResets coldResets reusedPayloadUnits peakLiveNodes => + cases heap with + | mk nodes allocs reuses frees rcops => + rfl + +/-- The compiler's baseline cold prefix and `resetShared`'s cold operation +produce the same semantic heap. More precisely, from the baseline batch of +field retains this theorem constructs both the subsequent non-final parent +release and the exact batch retain required by the reset evaluator. Their +stores differ only by reset-observation counters, so their heap components +are definitionally equal. + +No distinctness premise is needed: repeated fields and a field that aliases +the parent are covered by `RetainSharedMany.decrement_commute`. -/ +theorem coldPrefix_commutes {store baselineRetained : Store} + {target rc : Nat} {cid : CtorId} {fields : Array RVal} + {heapFuel : Nat} + (hget : store.get? target = + some ⟨.shared, rc, .ctorN cid fields⟩) + (hmany : 1 < rc) + (retained : RetainSharedMany store fields baselineRetained) : + ∃ retainedRc, + baselineRetained.get? target = + some ⟨.shared, retainedRc, .ctorN cid fields⟩ ∧ + releaseShared (heapFuel + 1) baselineRetained (.loc target) = + .ok (baselineDecrementStore baselineRetained target + ⟨.shared, retainedRc, .ctorN cid fields⟩, heapFuel) ∧ + RetainSharedMany + (coldResetStartStore store target + ⟨.shared, rc, .ctorN cid fields⟩) + fields + ((baselineDecrementStore baselineRetained target + ⟨.shared, retainedRc, .ctorN cid fields⟩).tickResetAttempt.tickColdReset) ∧ + (baselineDecrementStore baselineRetained target + ⟨.shared, retainedRc, .ctorN cid fields⟩).heap = + ((baselineDecrementStore baselineRetained target + ⟨.shared, retainedRc, .ctorN cid fields⟩).tickResetAttempt.tickColdReset).heap := by + have retainedList : + RetainSharedMany store fields.toList.toArray baselineRetained := by + simpa using retained + obtain ⟨retainedRc, retainedAt, retainedMany, commuted⟩ := + RetainSharedMany.decrement_commute hget hmany retainedList + have released : + releaseShared (heapFuel + 1) baselineRetained (.loc target) = + .ok (baselineDecrementStore baselineRetained target + ⟨.shared, retainedRc, .ctorN cid fields⟩, heapFuel) := by + simp [releaseShared, releaseSharedWork, retainedAt, + baselineDecrementStore, + show (retainedRc == 0) = false by + exact beq_eq_false_iff_ne.mpr (by omega), + show (retainedRc == 1) = false by + exact beq_eq_false_iff_ne.mpr (by omega)] + have resetAttemptRetained := + RetainSharedMany.tickResetAttempt commuted + have resetRetained := + RetainSharedMany.tickColdReset resetAttemptRetained + rw [← coldResetStartStore_eq] at resetRetained + simpa using ⟨retainedRc, retainedAt, released, resetRetained, rfl⟩ + +/-- A non-final shared release performs exactly one refcount decrement and +spends exactly one unit of heap fuel. -/ +theorem releaseShared_nonfinal {store : Store} {location rc : Nat} + {node : IxIR1.Node} {heapFuel : Nat} + (hget : store.get? location = some ⟨.shared, rc, node⟩) + (hmany : 1 < rc) : + releaseShared (heapFuel + 1) store (.loc location) = + .ok (baselineDecrementStore store location + ⟨.shared, rc, node⟩, heapFuel) := by + simp [releaseShared, releaseSharedWork, hget, baselineDecrementStore, + show (rc == 0) = false by exact beq_eq_false_iff_ne.mpr (by omega), + show (rc == 1) = false by exact beq_eq_false_iff_ne.mpr (by omega)] + +@[simp] theorem logicalHotResetStore_heap (store : Store) (location : Nat) : + (logicalHotResetStore store location).heap = store.heap.kill location := + rfl + +@[simp] theorem physicalHotResetStore_nodes (store : Store) + (location : Nat) : + (physicalHotResetStore store location).heap.nodes = + store.heap.nodes.setIfInBounds location none := + rfl + +@[simp] theorem logicalHotReuseStore_heap (store : Store) (location : Nat) + (node : IxIR1.Node) : + (logicalHotReuseStore store location node).1.heap = + ((store.heap.kill location).allocNode .shared node).1 := + rfl + +@[simp] theorem logicalHotReuseStore_location (store : Store) + (location : Nat) (node : IxIR1.Node) : + (logicalHotReuseStore store location node).2 = + ((store.heap.kill location).allocNode .shared node).2 := + rfl + +/-- A live source slot becomes the empty in-bounds reservation expected by +the physical credit. -/ +theorem physicalHotResetStore_reserved {store : Store} {location : Nat} + {box : IxIR1.NodeBox} (hget : store.get? location = some box) : + (physicalHotResetStore store location).heap.nodes[location]? = + some none := by + have hnodes : store.heap.nodes[location]? = some (some box) := + IxIR1.Sim.nodes_get?_of_get? hget + obtain ⟨hlt, _⟩ := Array.getElem?_eq_some_iff.mp hnodes + simp [physicalHotResetStore, Eval.Store.tickResetAttempt, + Eval.Store.tickHotReset, Eval.Store.reserve, + hlt] + +/-- Successful concrete physical credit consumption has exactly the IxIR₁ +shared in-place-reuse heap. IxIR₂-only reset and payload counters remain +outside that semantic heap equation. -/ +theorem physicalHotReuseStore_ok {store : Store} {location : Nat} + {oldBox : IxIR1.NodeBox} (node : IxIR1.Node) (payloadUnits : Nat) + (hget : store.get? location = some oldBox) : + ∃ result, + physicalHotReuseStore store location node payloadUnits = .ok result ∧ + result.heap = + IxIR1.Sim.reuseSharedNodeStore store.heap location node := by + unfold physicalHotReuseStore Eval.Store.reuseReservation + rw [physicalHotResetStore_reserved hget] + refine ⟨_, rfl, ?_⟩ + rw [IxIR1.Sim.reuseSharedNodeStore_eq_direct] + simp [physicalHotResetStore, Eval.Store.tickResetAttempt, + Eval.Store.tickHotReset, Eval.Store.reserve, + IxIR1.Store.setBox, Array.set!_eq_setIfInBounds] + +/-! ## Hot shared-reuse soundness -/ + +/-- Concrete physical hot reuse and concrete logical hot reuse preserve exact +ownership and are related by a live-location bijection. The reused physical +slot corresponds to the logical allocator's fresh append location; every +other live location corresponds to itself. + +This is the heap-algebra leaf needed by the block simulation. Its +`List.Perm` premise is the compositional ownership interface for arbitrary +field and tail-argument permutations recovered by the checked planner. -/ +theorem hotReuse_sound {store : Store} {target : Nat} + {oldNode newNode : IxIR1.Node} {before after : List IxIR1.Sim.Root} + (payloadUnits : Nat) + (hget : store.get? target = some ⟨.shared, 1, oldNode⟩) + (hown : IxIR1.Sim.RootOwnership store.heap + (⟨.shared, .loc target⟩ :: before)) + (hpartition : + (IxIR1.Sim.rootsFor .shared (IxIR1.Sim.nodeChildren oldNode) ++ + before).Perm + (IxIR1.Sim.rootsFor .shared (IxIR1.Sim.nodeChildren newNode) ++ + after)) + (hworld : IxIR1.Sim.NodeWorld .shared newNode) : + ∃ physical, + physicalHotReuseStore store target newNode payloadUnits = .ok physical ∧ + ∃ iso : IxIR1.Sim.HeapIso physical.heap + (logicalHotReuseStore store target newNode).1.heap, + IxIR1.Sim.RootOwnership physical.heap + (⟨.shared, .loc target⟩ :: after) ∧ + IxIR1.Sim.RootOwnership + (logicalHotReuseStore store target newNode).1.heap + (⟨.shared, + .loc (logicalHotReuseStore store target newNode).2⟩ :: after) ∧ + iso.locRel target (logicalHotReuseStore store target newNode).2 := by + obtain ⟨physical, reused, physicalHeap⟩ := + physicalHotReuseStore_ok newNode payloadUnits hget + obtain ⟨iso, physicalOwned, logicalOwned, resultRelated⟩ := + IxIR1.Sim.reuse_shared_sound hget hown hpartition hworld + refine ⟨physical, reused, ?_⟩ + rw [physicalHeap] + exact ⟨iso, physicalOwned, logicalOwned, resultRelated⟩ + +/-- Concrete hot reuse additionally self-relates every surviving external +root. This is the value-transport interface needed when the recursive +continuation retains locations other than the replaced result. -/ +theorem hotReuse_sound_with_survivors {store : Store} {target : Nat} + {oldNode newNode : IxIR1.Node} {before after : List IxIR1.Sim.Root} + (payloadUnits : Nat) + (hget : store.get? target = some ⟨.shared, 1, oldNode⟩) + (hown : IxIR1.Sim.RootOwnership store.heap + (⟨.shared, .loc target⟩ :: before)) + (hpartition : + (IxIR1.Sim.rootsFor .shared (IxIR1.Sim.nodeChildren oldNode) ++ + before).Perm + (IxIR1.Sim.rootsFor .shared (IxIR1.Sim.nodeChildren newNode) ++ + after)) + (hworld : IxIR1.Sim.NodeWorld .shared newNode) : + ∃ physical, + physicalHotReuseStore store target newNode payloadUnits = .ok physical ∧ + ∃ iso : IxIR1.Sim.HeapIso physical.heap + (logicalHotReuseStore store target newNode).1.heap, + IxIR1.Sim.RootOwnership physical.heap + (⟨.shared, .loc target⟩ :: after) ∧ + IxIR1.Sim.RootOwnership + (logicalHotReuseStore store target newNode).1.heap + (⟨.shared, + .loc (logicalHotReuseStore store target newNode).2⟩ :: after) ∧ + iso.locRel target (logicalHotReuseStore store target newNode).2 ∧ + ∀ root ∈ after, + IxIR1.Sim.RValIso iso.locRel root.value root.value := by + obtain ⟨physical, reused, physicalHeap⟩ := + physicalHotReuseStore_ok newNode payloadUnits hget + obtain ⟨iso, physicalOwned, logicalOwned, resultRelated, + survivorsRelated⟩ := + IxIR1.Sim.reuse_shared_sound_with_survivors hget hown hpartition hworld + refine ⟨physical, reused, ?_⟩ + rw [physicalHeap] + exact ⟨iso, physicalOwned, logicalOwned, resultRelated, + survivorsRelated⟩ + +/-- End-to-end hot-prefix leaf for the insertion proof. Starting from the +actual successful baseline retain/release prefix, ordinary fresh allocation +is related to physical reset/reuse by a live-location bijection. Thus this +theorem combines the previously separate baseline-prefix cancellation and +physical/logical reuse leaves at the first point where the rewritten block +can rejoin its tail call. -/ +theorem hotPrefixReuse_sound {store baselineRetained baselineReleased : Store} + {target : Nat} {oldCid newCid : CtorId} + {fields newFields : Array RVal} {fieldFuel remaining : Nat} + {before after : List IxIR1.Sim.Root} + (payloadUnits : Nat) + (targetAt : store.get? target = + some ⟨.shared, 1, .ctorN oldCid fields⟩) + (owned : IxIR1.Sim.RootOwnership store.heap + (⟨.shared, .loc target⟩ :: before)) + (retained : RetainSharedMany store fields baselineRetained) + (released : releaseShared (fieldFuel + 1) baselineRetained + (.loc target) = .ok (baselineReleased, remaining)) + (partition : + (IxIR1.Sim.rootsFor .shared fields.toList ++ before).Perm + (IxIR1.Sim.rootsFor .shared newFields.toList ++ after)) + (newWorld : IxIR1.Sim.NodeWorld .shared (.ctorN newCid newFields)) : + let baselineAllocation := + baselineReleased.allocNode .shared (.ctorN newCid newFields) + ∃ physical, + physicalHotReuseStore store target (.ctorN newCid newFields) + payloadUnits = .ok physical ∧ + ∃ iso : IxIR1.Sim.HeapIso physical.heap baselineAllocation.1.heap, + IxIR1.Sim.RootOwnership physical.heap + (⟨.shared, .loc target⟩ :: after) ∧ + IxIR1.Sim.RootOwnership baselineAllocation.1.heap + (⟨.shared, .loc baselineAllocation.2⟩ :: after) ∧ + iso.locRel target baselineAllocation.2 := by + dsimp only + have prefixContents : + HeapContentsEq baselineReleased (logicalHotResetStore store target) := + hotPrefix_contents targetAt owned retained released + have allocationContents : + HeapContentsEq + (baselineReleased.allocNode .shared (.ctorN newCid newFields)).1 + (logicalHotReuseStore store target + (.ctorN newCid newFields)).1 := by + simpa [logicalHotReuseStore] using + prefixContents.allocNode .shared (.ctorN newCid newFields) + have allocationLocation : + (baselineReleased.allocNode .shared (.ctorN newCid newFields)).2 = + (logicalHotReuseStore store target + (.ctorN newCid newFields)).2 := by + simpa [logicalHotReuseStore] using + prefixContents.allocNode_location .shared (.ctorN newCid newFields) + obtain ⟨physical, reused, logicalIso, physicalOwned, logicalOwned, + resultRelated⟩ := + hotReuse_sound (store := store) (target := target) + (oldNode := .ctorN oldCid fields) + (newNode := .ctorN newCid newFields) + (before := before) (after := after) payloadUnits targetAt owned + partition newWorld + have baselineOwned : + IxIR1.Sim.RootOwnership + (baselineReleased.allocNode .shared + (.ctorN newCid newFields)).1.heap + (⟨.shared, + .loc (baselineReleased.allocNode .shared + (.ctorN newCid newFields)).2⟩ :: after) := by + apply allocationContents.symm.rootOwnership + rw [allocationLocation] + exact logicalOwned + have logicalClosed : IxIR1.Sim.StoreClosed + (logicalHotReuseStore store target + (.ctorN newCid newFields)).1.heap := + IxIR1.Sim.RootOwnership.storeClosed logicalOwned + let logicalToBaseline := allocationContents.symm.toHeapIso logicalClosed + let iso := logicalIso.trans logicalToBaseline + have logicalResultLive := logicalOwned.roots_world + (⟨.shared, + .loc (logicalHotReuseStore store target + (.ctorN newCid newFields)).2⟩ : IxIR1.Sim.Root) (by simp) + obtain ⟨logicalResultBox, logicalResultAt, _⟩ := logicalResultLive + have logicalToBaselineResult : + logicalToBaseline.locRel + (logicalHotReuseStore store target (.ctorN newCid newFields)).2 + (baselineReleased.allocNode .shared + (.ctorN newCid newFields)).2 := by + have selfRelated := allocationContents.symm.toHeapIso_rel_self + logicalClosed logicalResultAt + rw [allocationLocation] + exact selfRelated + refine ⟨physical, reused, iso, physicalOwned, baselineOwned, ?_⟩ + exact ⟨_, resultRelated, logicalToBaselineResult⟩ + +/-- The complete hot-prefix theorem additionally transports every surviving +external root through the composed physical-to-baseline heap isomorphism. +The reused result maps to the fresh baseline allocation, while all other +continuation roots remain self-related. -/ +theorem hotPrefixReuse_sound_with_survivors + {store baselineRetained baselineReleased : Store} + {target : Nat} {oldCid newCid : CtorId} + {fields newFields : Array RVal} {fieldFuel remaining : Nat} + {before after : List IxIR1.Sim.Root} + (payloadUnits : Nat) + (targetAt : store.get? target = + some ⟨.shared, 1, .ctorN oldCid fields⟩) + (owned : IxIR1.Sim.RootOwnership store.heap + (⟨.shared, .loc target⟩ :: before)) + (retained : RetainSharedMany store fields baselineRetained) + (released : releaseShared (fieldFuel + 1) baselineRetained + (.loc target) = .ok (baselineReleased, remaining)) + (partition : + (IxIR1.Sim.rootsFor .shared fields.toList ++ before).Perm + (IxIR1.Sim.rootsFor .shared newFields.toList ++ after)) + (newWorld : IxIR1.Sim.NodeWorld .shared (.ctorN newCid newFields)) : + let baselineAllocation := + baselineReleased.allocNode .shared (.ctorN newCid newFields) + ∃ physical, + physicalHotReuseStore store target (.ctorN newCid newFields) + payloadUnits = .ok physical ∧ + ∃ iso : IxIR1.Sim.HeapIso physical.heap baselineAllocation.1.heap, + IxIR1.Sim.RootOwnership physical.heap + (⟨.shared, .loc target⟩ :: after) ∧ + IxIR1.Sim.RootOwnership baselineAllocation.1.heap + (⟨.shared, .loc baselineAllocation.2⟩ :: after) ∧ + iso.locRel target baselineAllocation.2 ∧ + ∀ root ∈ after, + IxIR1.Sim.RValIso iso.locRel root.value root.value := by + dsimp only + have prefixContents : + HeapContentsEq baselineReleased (logicalHotResetStore store target) := + hotPrefix_contents targetAt owned retained released + have allocationContents : + HeapContentsEq + (baselineReleased.allocNode .shared (.ctorN newCid newFields)).1 + (logicalHotReuseStore store target + (.ctorN newCid newFields)).1 := by + simpa [logicalHotReuseStore] using + prefixContents.allocNode .shared (.ctorN newCid newFields) + have allocationLocation : + (baselineReleased.allocNode .shared (.ctorN newCid newFields)).2 = + (logicalHotReuseStore store target + (.ctorN newCid newFields)).2 := by + simpa [logicalHotReuseStore] using + prefixContents.allocNode_location .shared (.ctorN newCid newFields) + obtain ⟨physical, reused, logicalIso, physicalOwned, logicalOwned, + resultRelated, survivorsRelated⟩ := + hotReuse_sound_with_survivors (store := store) (target := target) + (oldNode := .ctorN oldCid fields) + (newNode := .ctorN newCid newFields) + (before := before) (after := after) payloadUnits targetAt owned + partition newWorld + have baselineOwned : + IxIR1.Sim.RootOwnership + (baselineReleased.allocNode .shared + (.ctorN newCid newFields)).1.heap + (⟨.shared, + .loc (baselineReleased.allocNode .shared + (.ctorN newCid newFields)).2⟩ :: after) := by + apply allocationContents.symm.rootOwnership + rw [allocationLocation] + exact logicalOwned + have logicalClosed : IxIR1.Sim.StoreClosed + (logicalHotReuseStore store target + (.ctorN newCid newFields)).1.heap := + IxIR1.Sim.RootOwnership.storeClosed logicalOwned + let logicalToBaseline := allocationContents.symm.toHeapIso logicalClosed + let iso := logicalIso.trans logicalToBaseline + have logicalResultLive := logicalOwned.roots_world + (⟨.shared, + .loc (logicalHotReuseStore store target + (.ctorN newCid newFields)).2⟩ : IxIR1.Sim.Root) (by simp) + obtain ⟨logicalResultBox, logicalResultAt, _⟩ := logicalResultLive + have logicalToBaselineResult : + logicalToBaseline.locRel + (logicalHotReuseStore store target (.ctorN newCid newFields)).2 + (baselineReleased.allocNode .shared + (.ctorN newCid newFields)).2 := by + have selfRelated := allocationContents.symm.toHeapIso_rel_self + logicalClosed logicalResultAt + rw [allocationLocation] + exact selfRelated + refine ⟨physical, reused, iso, physicalOwned, baselineOwned, + ⟨_, resultRelated, logicalToBaselineResult⟩, ?_⟩ + intro root member + have logicalSelf := survivorsRelated root member + have logicalToBaselineSelf : IxIR1.Sim.RValIso + logicalToBaseline.locRel root.value root.value := by + cases root with + | mk world value => + cases value with + | lit literal => exact .lit + | erased => exact .erased + | loc location => + obtain ⟨box, live, _⟩ := logicalOwned.roots_world + ⟨world, .loc location⟩ (by simp [member]) + exact .loc (allocationContents.symm.toHeapIso_rel_self + logicalClosed live) + exact logicalSelf.trans logicalToBaselineSelf + +/-- Physical hot reuse composes with an already-existing target-to-baseline +heap bijection. The consumed location pair is removed, corresponding fresh +allocations extend the restricted relation, and physical in-place reuse is +then composed on the target side. Every old related pair except the consumed +one remains related by the resulting bijection. -/ +theorem hotPrefixReuse_sound_under_iso + {baselineStore rewrittenStore baselineRetained baselineReleased : Store} + {baselineLocation rewrittenLocation : Nat} + {oldCid newCid : CtorId} + {baselineFields rewrittenFields baselineNewFields rewrittenNewFields : + Array RVal} + {fieldFuel remaining : Nat} + {baselineBefore baselineAfter rewrittenBefore rewrittenAfter : + List IxIR1.Sim.Root} + (payloadUnits : Nat) + (inputIso : IxIR1.Sim.HeapIso rewrittenStore.heap baselineStore.heap) + (locations : inputIso.locRel rewrittenLocation baselineLocation) + (baselineAt : baselineStore.get? baselineLocation = some + ⟨.shared, 1, .ctorN oldCid baselineFields⟩) + (rewrittenAt : rewrittenStore.get? rewrittenLocation = some + ⟨.shared, 1, .ctorN oldCid rewrittenFields⟩) + (baselineOwned : IxIR1.Sim.RootOwnership baselineStore.heap + (⟨.shared, .loc baselineLocation⟩ :: baselineBefore)) + (rewrittenOwned : IxIR1.Sim.RootOwnership rewrittenStore.heap + (⟨.shared, .loc rewrittenLocation⟩ :: rewrittenBefore)) + (retained : RetainSharedMany baselineStore baselineFields + baselineRetained) + (released : releaseShared (fieldFuel + 1) baselineRetained + (.loc baselineLocation) = .ok (baselineReleased, remaining)) + (baselinePartition : + (IxIR1.Sim.rootsFor .shared baselineFields.toList ++ + baselineBefore).Perm + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ + baselineAfter)) + (rewrittenPartition : + (IxIR1.Sim.rootsFor .shared rewrittenFields.toList ++ + rewrittenBefore).Perm + (IxIR1.Sim.rootsFor .shared rewrittenNewFields.toList ++ + rewrittenAfter)) + (newFieldsRelated : IxIR1.Sim.RValsIso + (fun rewrittenCandidate baselineCandidate => + inputIso.locRel rewrittenCandidate baselineCandidate ∧ + rewrittenCandidate ≠ rewrittenLocation) + rewrittenNewFields.toList baselineNewFields.toList) : + let baselineAllocation := baselineReleased.allocNode .shared + (.ctorN newCid baselineNewFields) + ∃ physical, + physicalHotReuseStore rewrittenStore rewrittenLocation + (.ctorN newCid rewrittenNewFields) payloadUnits = .ok physical ∧ + ∃ outputIso : IxIR1.Sim.HeapIso physical.heap + baselineAllocation.1.heap, + IxIR1.Sim.RootOwnership physical.heap + (⟨.shared, .loc rewrittenLocation⟩ :: rewrittenAfter) ∧ + IxIR1.Sim.RootOwnership baselineAllocation.1.heap + (⟨.shared, .loc baselineAllocation.2⟩ :: baselineAfter) ∧ + outputIso.locRel rewrittenLocation baselineAllocation.2 ∧ + ∀ {rewrittenCandidate baselineCandidate : Nat}, + inputIso.locRel rewrittenCandidate baselineCandidate → + rewrittenCandidate ≠ rewrittenLocation → + outputIso.locRel rewrittenCandidate baselineCandidate := by + dsimp only + let baselineAllocation := baselineReleased.allocNode .shared + (.ctorN newCid baselineNewFields) + let baselineLogicalAllocation := + logicalHotReuseStore baselineStore baselineLocation + (.ctorN newCid baselineNewFields) + let rewrittenLogicalAllocation := + logicalHotReuseStore rewrittenStore rewrittenLocation + (.ctorN newCid rewrittenNewFields) + have prefixContents : HeapContentsEq baselineReleased + (logicalHotResetStore baselineStore baselineLocation) := + hotPrefix_contents baselineAt baselineOwned retained released + have allocationContents : HeapContentsEq baselineAllocation.1 + baselineLogicalAllocation.1 := by + simpa [baselineAllocation, baselineLogicalAllocation, + logicalHotReuseStore] using + prefixContents.allocNode .shared (.ctorN newCid baselineNewFields) + have allocationLocation : baselineAllocation.2 = + baselineLogicalAllocation.2 := by + simpa [baselineAllocation, baselineLogicalAllocation, + logicalHotReuseStore] using + prefixContents.allocNode_location .shared + (.ctorN newCid baselineNewFields) + obtain ⟨_baselinePhysical, _baselineReused, _baselineIso, + _baselinePhysicalOwned, baselineAllocationOwned, _baselineResult⟩ := + hotPrefixReuse_sound + (store := baselineStore) (baselineRetained := baselineRetained) + (baselineReleased := baselineReleased) (target := baselineLocation) + (oldCid := oldCid) (newCid := newCid) (fields := baselineFields) + (newFields := baselineNewFields) (fieldFuel := fieldFuel) + (remaining := remaining) (before := baselineBefore) + (after := baselineAfter) payloadUnits baselineAt baselineOwned retained + released baselinePartition trivial + have baselineLogicalOwned : IxIR1.Sim.RootOwnership + baselineLogicalAllocation.1.heap + (⟨.shared, .loc baselineLogicalAllocation.2⟩ :: baselineAfter) := by + rw [← allocationLocation] + exact allocationContents.rootOwnership + (by simpa [baselineAllocation] using baselineAllocationOwned) + have baselineLogicalClosed : IxIR1.Sim.StoreClosed + baselineLogicalAllocation.1.heap := + IxIR1.Sim.RootOwnership.storeClosed baselineLogicalOwned + let baselineExactIso := + allocationContents.symm.toHeapIso baselineLogicalClosed + obtain ⟨physical, reused, physicalHeap⟩ := + physicalHotReuseStore_ok (.ctorN newCid rewrittenNewFields) payloadUnits + rewrittenAt + have rewrittenPhysicalOwnedRaw : IxIR1.Sim.RootOwnership + (IxIR1.Sim.reuseSharedNodeStore rewrittenStore.heap rewrittenLocation + (.ctorN newCid rewrittenNewFields)) + (⟨.shared, .loc rewrittenLocation⟩ :: rewrittenAfter) := + rewrittenOwned.reuseSharedNode rewrittenAt rewrittenPartition trivial + let killedIso := heapIsoKillShared inputIso locations rewrittenAt baselineAt + rewrittenOwned + have newNodesRelated : IxIR1.Sim.NodeIso killedIso.locRel + (.ctorN newCid rewrittenNewFields) (.ctorN newCid baselineNewFields) := by + apply IxIR1.Sim.NodeIso.ctor + change IxIR1.Sim.RValsIso + (fun rewrittenCandidate baselineCandidate => + inputIso.locRel rewrittenCandidate baselineCandidate ∧ + rewrittenCandidate ≠ rewrittenLocation) + rewrittenNewFields.toList baselineNewFields.toList + exact newFieldsRelated + let crossRaw : IxIR1.Sim.HeapIso + ((rewrittenStore.heap.kill rewrittenLocation).allocNode .shared + (.ctorN newCid rewrittenNewFields)).1 + ((baselineStore.heap.kill baselineLocation).allocNode .shared + (.ctorN newCid baselineNewFields)).1 := + killedIso.alloc (world := .shared) newNodesRelated + let localRaw := IxIR1.Sim.HeapIso.reuseShared rewrittenAt + rewrittenPhysicalOwnedRaw + let outputIso := (localRaw.trans crossRaw).trans baselineExactIso + have localResultRaw : localRaw.locRel rewrittenLocation + ((rewrittenStore.heap.kill rewrittenLocation).allocNode .shared + (.ctorN newCid rewrittenNewFields)).2 := by + change IxIR1.Sim.reuseRel rewrittenStore.heap rewrittenLocation + rewrittenLocation + ((rewrittenStore.heap.kill rewrittenLocation).allocNode .shared + (.ctorN newCid rewrittenNewFields)).2 + exact .inl ⟨rfl, by simp [IxIR1.Store.kill, IxIR1.Store.allocNode]⟩ + have crossResultRaw : crossRaw.locRel + ((rewrittenStore.heap.kill rewrittenLocation).allocNode .shared + (.ctorN newCid rewrittenNewFields)).2 + ((baselineStore.heap.kill baselineLocation).allocNode .shared + (.ctorN newCid baselineNewFields)).2 := by + exact .inl ⟨rfl, rfl⟩ + have baselineLogicalResultAt : baselineLogicalAllocation.1.get? + baselineLogicalAllocation.2 = + some ⟨.shared, 1, .ctorN newCid baselineNewFields⟩ := by + exact IxIR1.Sim.HeapIso.get?_allocNode_new + (logicalHotResetStore baselineStore baselineLocation).heap .shared + (.ctorN newCid baselineNewFields) + have exactResultSelf : baselineExactIso.locRel + baselineLogicalAllocation.2 baselineLogicalAllocation.2 := by + exact allocationContents.symm.toHeapIso_rel_self baselineLogicalClosed + baselineLogicalResultAt + have exactResult : baselineExactIso.locRel + baselineLogicalAllocation.2 baselineAllocation.2 := by + rw [allocationLocation] + exact exactResultSelf + have outputResult : outputIso.locRel rewrittenLocation + baselineAllocation.2 := by + exact ⟨baselineLogicalAllocation.2, + ⟨rewrittenLogicalAllocation.2, localResultRaw, crossResultRaw⟩, + exactResult⟩ + refine ⟨physical, reused, ?_⟩ + rw [physicalHeap] + refine ⟨outputIso, rewrittenPhysicalOwnedRaw, + by simpa [baselineAllocation] using baselineAllocationOwned, + outputResult, ?_⟩ + intro rewrittenCandidate baselineCandidate related different + obtain ⟨rewrittenBox, baselineBox, rewrittenLive, baselineLive, _boxes⟩ := + inputIso.related_live related + have localSelfRaw : localRaw.locRel rewrittenCandidate + rewrittenCandidate := by + change IxIR1.Sim.reuseRel rewrittenStore.heap rewrittenLocation + rewrittenCandidate rewrittenCandidate + exact .inr ⟨rfl, different, rewrittenBox, rewrittenLive⟩ + have killedRelated : killedIso.locRel rewrittenCandidate + baselineCandidate := + heapIsoKillShared_rel inputIso locations rewrittenAt baselineAt + rewrittenOwned related different + have crossOldRaw : crossRaw.locRel rewrittenCandidate + baselineCandidate := + .inr killedRelated + have baselineDifferent : baselineLocation ≠ baselineCandidate := by + intro same + subst baselineCandidate + exact different (inputIso.right_unique related locations) + have baselineKilledLive : + (baselineStore.heap.kill baselineLocation).get? baselineCandidate = + some baselineBox := + IxIR1.Sim.get?_kill_other baselineDifferent baselineAt baselineLive + have baselineLogicalLive : baselineLogicalAllocation.1.get? + baselineCandidate = some baselineBox := by + exact IxIR1.Sim.HeapIso.get?_allocNode_old + (world := .shared) (node := .ctorN newCid baselineNewFields) + baselineKilledLive + have exactOld : baselineExactIso.locRel baselineCandidate + baselineCandidate := + allocationContents.symm.toHeapIso_rel_self baselineLogicalClosed + baselineLogicalLive + exact ⟨baselineCandidate, + ⟨rewrittenCandidate, localSelfRaw, crossOldRaw⟩, exactOld⟩ + +/-- The complete accepted logical hot rewrite agrees with the concrete +baseline retain/release/allocation prefix and reaches the same recursive +argument vector. -/ +theorem hotLogicalAcceptedPrefix {limits : Validate.Limits} + {validation : Validate.Context} {sourceBlock : Block} + (site : Reuse.Site limits validation sourceBlock) + {context : Eval.Context} {definition : Function} + {resetId hotId coldId : BlockId} + {parameters fields newFields callValues : Array RVal} + {location : Nat} {sourceSchema allocationSchema : CtorSchema} + {machine : Machine} {baselineRetained baselineReleased : Store} + {stack : List Continuation} {fieldFuel remaining : Nat} + {ambient : List IxIR1.Sim.Root} + (resetAt : definition.blocks[resetId]? = + some (Reuse.resetBlock site.candidate hotId coldId)) + (hotAt : definition.blocks[hotId]? = some + (Reuse.creditBlock site.candidate + (.required site.candidate.layout))) + (sourceSchemaAt : context.schemas .shared site.shape.sourceConstructor = + some sourceSchema) + (allocationSchemaAt : + context.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (sourceLayout : site.candidate.layout = sourceSchema.layout) + (allocationLayout : site.candidate.layout = allocationSchema.layout) + (control : machine.control = .running + { definition + block := resetId + pc := 0 + values := parameters + credits := #[] } stack) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (sourceResolved : resolveAtom parameters (.reg site.shape.source) = + .ok (.loc location)) + (targetAt : machine.store.get? location = some + ⟨.shared, 1, .ctorN site.shape.sourceConstructor fields⟩) + (owned : IxIR1.Sim.RootOwnership machine.store.heap + (⟨.shared, .loc location⟩ :: ambient)) + (retained : RetainSharedMany machine.store fields baselineRetained) + (released : releaseShared (fieldFuel + 1) baselineRetained + (.loc location) = .ok (baselineReleased, remaining)) + (allocationResolved : resolveAtoms + (baselinePrefixValues parameters fields) + site.shape.allocationArguments = .ok newFields) + (fieldWorlds : FieldWorlds baselineReleased allocationSchema newFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc (baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields)).2)) + site.shape.tailArguments = .ok callValues) + (arity : callValues.size = definition.signature.params.size) + (nonempty : definition.blocks.isEmpty = false) : + let baselineAllocation := baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + let logicalAllocation := + (logicalHotResetStore machine.store location).allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + Steps context .logical 4 machine + { machine with + store := logicalAllocation.1 + control := .running { definition, values := callValues } stack } ∧ + HeapContentsEq baselineAllocation.1 logicalAllocation.1 ∧ + baselineAllocation.2 = logicalAllocation.2 := by + dsimp only + let baselineAllocation := baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + let logicalAllocation := + (logicalHotResetStore machine.store location).allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + have prefixContents : HeapContentsEq baselineReleased + (logicalHotResetStore machine.store location) := + hotPrefix_contents targetAt owned retained released + have allocationContents : + HeapContentsEq baselineAllocation.1 logicalAllocation.1 := by + simpa [baselineAllocation, logicalAllocation] using + prefixContents.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + have allocationLocation : + baselineAllocation.2 = logicalAllocation.2 := by + simpa [baselineAllocation, logicalAllocation] using + prefixContents.allocNode_location .shared + (.ctorN site.shape.allocationConstructor newFields) + have logicalFieldWorlds : FieldWorlds + (logicalHotResetStore machine.store location) + allocationSchema newFields := + prefixContents.fieldWorlds fieldWorlds + have logicalTailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc logicalAllocation.2)) + site.shape.tailArguments = .ok callValues := by + rw [← allocationLocation] + simpa [baselineAllocation] using tailResolved + have viewed : ConstructorView machine.store location .shared + site.shape.sourceConstructor + ⟨.shared, 1, .ctorN site.shape.sourceConstructor fields⟩ fields := + ConstructorView.of_box targetAt rfl rfl + have execution : Steps context .logical 4 machine + { machine with + store := logicalAllocation.1 + control := .running { definition, values := callValues } stack } := by + simpa [logicalAllocation, logicalHotResetStore] using + hotLogicalAcceptedControl site resetAt hotAt sourceSchemaAt + allocationSchemaAt sourceLayout allocationLayout control + parameterCount fieldCount sourceResolved viewed rfl + allocationResolved + (by simpa [logicalHotResetStore] using logicalFieldWorlds) + (by simpa [logicalAllocation, logicalHotResetStore] using + logicalTailResolved) + arity nonempty + exact ⟨execution, allocationContents, allocationLocation⟩ + +/-- The complete accepted cold rewrite reaches the same recursive argument +vector as any baseline prefix with equal semantic heap contents. -/ +theorem coldAcceptedPrefix {limits : Validate.Limits} + {validation : Validate.Context} {sourceBlock : Block} + (site : Reuse.Site limits validation sourceBlock) + {context : Eval.Context} {interpretation : Interpretation} + {definition : Function} {resetId hotId coldId : BlockId} + {parameters fields newFields callValues : Array RVal} + {location : Nat} {box : IxIR1.NodeBox} + {sourceSchema allocationSchema : CtorSchema} {machine : Machine} + {resetStore baselineReleased : Store} {stack : List Continuation} + (resetAt : definition.blocks[resetId]? = + some (Reuse.resetBlock site.candidate hotId coldId)) + (coldAt : definition.blocks[coldId]? = some + (Reuse.creditBlock site.candidate + (.optional site.candidate.layout))) + (sourceSchemaAt : context.schemas .shared site.shape.sourceConstructor = + some sourceSchema) + (allocationSchemaAt : + context.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (sourceLayout : site.candidate.layout = sourceSchema.layout) + (allocationLayout : site.candidate.layout = allocationSchema.layout) + (control : machine.control = .running + { definition + block := resetId + pc := 0 + values := parameters + credits := #[] } stack) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (sourceResolved : resolveAtom parameters (.reg site.shape.source) = + .ok (.loc location)) + (viewed : ConstructorView machine.store location .shared + site.shape.sourceConstructor box fields) + (shared : 1 < box.rc) + (retained : RetainSharedMany + ((((machine.store.tickResetAttempt).setBox location + { box with rc := box.rc - 1 }).rcTick).tickColdReset) + fields resetStore) + (contents : HeapContentsEq baselineReleased resetStore) + (allocationResolved : resolveAtoms + (baselinePrefixValues parameters fields) + site.shape.allocationArguments = .ok newFields) + (fieldWorlds : FieldWorlds baselineReleased allocationSchema newFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc (baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields)).2)) + site.shape.tailArguments = .ok callValues) + (arity : callValues.size = definition.signature.params.size) + (nonempty : definition.blocks.isEmpty = false) : + let baselineAllocation := baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + let resetAllocation := resetStore.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + Steps context interpretation 4 machine + { machine with + store := resetAllocation.1 + control := .running { definition, values := callValues } stack } ∧ + HeapContentsEq baselineAllocation.1 resetAllocation.1 ∧ + baselineAllocation.2 = resetAllocation.2 := by + dsimp only + let baselineAllocation := baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + let resetAllocation := resetStore.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + have allocationContents : + HeapContentsEq baselineAllocation.1 resetAllocation.1 := by + simpa [baselineAllocation, resetAllocation] using + contents.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + have allocationLocation : + baselineAllocation.2 = resetAllocation.2 := by + simpa [baselineAllocation, resetAllocation] using + contents.allocNode_location .shared + (.ctorN site.shape.allocationConstructor newFields) + have resetTailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc resetAllocation.2)) + site.shape.tailArguments = .ok callValues := by + rw [← allocationLocation] + simpa [baselineAllocation] using tailResolved + have resetFieldWorlds : + FieldWorlds resetStore allocationSchema newFields := + contents.fieldWorlds fieldWorlds + have execution : Steps context interpretation 4 machine + { machine with + store := resetAllocation.1 + control := .running { definition, values := callValues } stack } := by + simpa [resetAllocation] using + coldAcceptedControl site resetAt coldAt sourceSchemaAt + allocationSchemaAt sourceLayout allocationLayout control + parameterCount fieldCount sourceResolved viewed shared retained + allocationResolved resetFieldWorlds + (by simpa [resetAllocation] using resetTailResolved) arity nonempty + exact ⟨execution, allocationContents, allocationLocation⟩ + +/-- The complete physical hot rewrite at one accepted site, from reset-block +entry through a recursive call whose argument vector is related to the +baseline call by the resulting heap isomorphism. -/ +theorem hotPhysicalAcceptedPrefixIso {limits : Validate.Limits} + {validation : Validate.Context} {sourceBlock : Block} + (site : Reuse.Site limits validation sourceBlock) + {context : Eval.Context} {definition : Function} + {resetId hotId coldId : BlockId} + {parameters fields newFields baselineCallValues : Array RVal} + {location : Nat} {sourceSchema allocationSchema : CtorSchema} + {machine : Machine} {baselineRetained baselineReleased : Store} + {stack : List Continuation} {fieldFuel remaining : Nat} + {before after : List IxIR1.Sim.Root} + (resetAt : definition.blocks[resetId]? = + some (Reuse.resetBlock site.candidate hotId coldId)) + (hotAt : definition.blocks[hotId]? = some + (Reuse.creditBlock site.candidate + (.required site.candidate.layout))) + (sourceSchemaAt : context.schemas .shared site.shape.sourceConstructor = + some sourceSchema) + (allocationSchemaAt : + context.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (sourceLayout : site.candidate.layout = sourceSchema.layout) + (allocationLayout : site.candidate.layout = allocationSchema.layout) + (control : machine.control = .running + { definition + block := resetId + pc := 0 + values := parameters + credits := #[] } stack) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (sourceResolved : resolveAtom parameters (.reg site.shape.source) = + .ok (.loc location)) + (targetAt : machine.store.get? location = some + ⟨.shared, 1, .ctorN site.shape.sourceConstructor fields⟩) + (retained : RetainSharedMany machine.store fields baselineRetained) + (released : releaseShared (fieldFuel + 1) baselineRetained + (.loc location) = .ok (baselineReleased, remaining)) + (owned : IxIR1.Sim.RootOwnership machine.store.heap + (⟨.shared, .loc location⟩ :: before)) + (partition : + (IxIR1.Sim.rootsFor .shared fields.toList ++ before).Perm + (IxIR1.Sim.rootsFor .shared newFields.toList ++ after)) + (newWorld : IxIR1.Sim.NodeWorld .shared + (.ctorN site.shape.allocationConstructor newFields)) + (mapped : MappedValuesInRoots site.shape + (baselinePrefixValues parameters fields) after) + (allocationResolved : resolveAtoms + (baselinePrefixValues parameters fields) + site.shape.allocationArguments = .ok newFields) + (fieldWorlds : FieldWorlds + (((machine.store.tickResetAttempt).reserve location).tickHotReset) + allocationSchema newFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc (baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields)).2)) + site.shape.tailArguments = .ok baselineCallValues) + (arity : baselineCallValues.size = definition.signature.params.size) + (nonempty : definition.blocks.isEmpty = false) : + let baselineAllocation := baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + ∃ physical, + physicalHotReuseStore machine.store location + (.ctorN site.shape.allocationConstructor newFields) + allocationSchema.fields.size = .ok physical ∧ + ∃ iso : IxIR1.Sim.HeapIso physical.heap baselineAllocation.1.heap, + IxIR1.Sim.RootOwnership physical.heap + (⟨.shared, .loc location⟩ :: after) ∧ + IxIR1.Sim.RootOwnership baselineAllocation.1.heap + (⟨.shared, .loc baselineAllocation.2⟩ :: after) ∧ + iso.locRel location baselineAllocation.2 ∧ + ∃ physicalCallValues, + Steps context .physical 4 machine + { machine with + store := physical + control := .running + { definition, values := physicalCallValues } stack } ∧ + IxIR1.Sim.RValsIso (fun baseline physicalLocation => + iso.locRel physicalLocation baseline) + baselineCallValues.toList physicalCallValues.toList := by + dsimp only + obtain ⟨physical, reused, iso, physicalOwned, baselineOwned, + resultRelated, survivorsRelated⟩ := + hotPrefixReuse_sound_with_survivors + (store := machine.store) + (baselineRetained := baselineRetained) + (baselineReleased := baselineReleased) + (target := location) + (oldCid := site.shape.sourceConstructor) + (newCid := site.shape.allocationConstructor) + (fields := fields) (newFields := newFields) + (fieldFuel := fieldFuel) (remaining := remaining) + (before := before) (after := after) + allocationSchema.fields.size targetAt owned retained released partition + newWorld + have rootsReverse : ∀ root ∈ after, + IxIR1.Sim.RValIso + (fun baseline physicalLocation => iso.locRel physicalLocation baseline) + root.value root.value := by + intro root member + exact (survivorsRelated root member).symm + have selfRelated := mapped.selfRelated rootsReverse + have viewed : ConstructorView machine.store location .shared + site.shape.sourceConstructor + ⟨.shared, 1, .ctorN site.shape.sourceConstructor fields⟩ fields := + ConstructorView.of_box targetAt rfl rfl + obtain ⟨physicalCallValues, execution, callsRelated⟩ := + hotPhysicalAcceptedControlIso site resetAt hotAt sourceSchemaAt + allocationSchemaAt sourceLayout allocationLayout control parameterCount + fieldCount sourceResolved viewed rfl allocationResolved fieldWorlds + (by simpa [physicalHotReuseStore, physicalHotResetStore] using reused) + iso selfRelated resultRelated tailResolved arity nonempty + exact ⟨physical, reused, iso, physicalOwned, baselineOwned, resultRelated, + physicalCallValues, execution, callsRelated⟩ + +/-! ## Accepted function-rewrite simulations -/ + +/-- At an accepted function-rewrite decision, the original baseline block and +the logical hot replacement both reach the same recursive argument vector. +The theorem obtains every CFG lookup and both constructor layouts from the +proof-carrying rewrite rather than requiring callers to restate them. -/ +theorem acceptedHotLogicalSimulation {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {index helperOffset : Nat} {block : Block} + {site : Reuse.Site limits validation block} + (found : Reuse.FunctionDecisions.At rewrite.decisions index helperOffset + block (.accepted site)) + {baselineContext rewrittenContext : Eval.Context} + (baselineSchemas : baselineContext.schemas = validation.schemas) + (rewrittenSchemas : rewrittenContext.schemas = validation.schemas) + {store baselineRetained baselineReleased : Store} + {parameters fields newFields callValues : Array RVal} + {location fieldFuel remaining : Nat} + {baselineStack rewrittenStack : List Continuation} + {ambient : List IxIR1.Sim.Root} {allocationSchema : CtorSchema} + (allocationSchemaAt : + baselineContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (sourceResolved : resolveAtom parameters (.reg site.shape.source) = + .ok (.loc location)) + (targetAt : store.get? location = some + ⟨.shared, 1, .ctorN site.shape.sourceConstructor fields⟩) + (owned : IxIR1.Sim.RootOwnership store.heap + (⟨.shared, .loc location⟩ :: ambient)) + (retained : RetainSharedMany store fields baselineRetained) + (released : releaseShared (fieldFuel + 1) baselineRetained + (.loc location) = .ok (baselineReleased, remaining)) + (allocationResolved : resolveAtoms + (baselinePrefixValues parameters fields) + site.shape.allocationArguments = .ok newFields) + (baselineFieldWorlds : + FieldWorlds baselineReleased allocationSchema newFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc (baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields)).2)) + site.shape.tailArguments = .ok callValues) + (arity : callValues.size = source.signature.params.size) : + let baselineMachine : Machine := + { store + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := parameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store + heapFuel := fieldFuel + 1 + control := .running + { definition := rewrite.definition + block := index + values := parameters + credits := #[] } + rewrittenStack } + let baselineAllocation := baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + let logicalAllocation := + (logicalHotResetStore store location).allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + Steps baselineContext .logical (2 * site.shape.fieldCount + 3) + baselineMachine + { store := baselineAllocation.1 + heapFuel := remaining + control := .running + { definition := source, values := callValues } baselineStack } ∧ + Steps rewrittenContext .logical 4 rewrittenMachine + { rewrittenMachine with + store := logicalAllocation.1 + control := .running + { definition := rewrite.definition, values := callValues } + rewrittenStack } ∧ + HeapContentsEq baselineAllocation.1 logicalAllocation.1 ∧ + baselineAllocation.2 = logicalAllocation.2 := by + dsimp only + obtain ⟨sourceAt, resetAt, hotAt, _coldAt⟩ := rewrite.acceptedAt found + obtain ⟨sourceSchema, siteAllocationSchema, sourceSchemaAt, + siteAllocationSchemaAt, _sourceFields, _allocationFields, + sourceLayout, allocationLayout⟩ := + evalRuntimeSchemas site baselineSchemas + have allocationSchemaEq : siteAllocationSchema = allocationSchema := by + exact Option.some.inj (siteAllocationSchemaAt.symm.trans allocationSchemaAt) + subst siteAllocationSchema + have rewrittenSourceSchemaAt : + rewrittenContext.schemas .shared site.shape.sourceConstructor = + some sourceSchema := by + simpa [baselineSchemas, rewrittenSchemas] using sourceSchemaAt + have rewrittenAllocationSchemaAt : + rewrittenContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema := by + simpa [baselineSchemas, rewrittenSchemas] using allocationSchemaAt + let baselineMachine : Machine := + { store + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := parameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store + heapFuel := fieldFuel + 1 + control := .running + { definition := rewrite.definition + block := index + values := parameters + credits := #[] } + rewrittenStack } + let baselineAllocation := baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + let logicalAllocation := + (logicalHotResetStore store location).allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + have sourceNonempty : source.blocks.isEmpty = false := + blocks_nonempty_of_getElem sourceAt + have targetNonempty : rewrite.definition.blocks.isEmpty = false := + blocks_nonempty_of_getElem resetAt + have targetArity : + callValues.size = rewrite.definition.signature.params.size := by + simpa using arity + have baselineControl : baselineMachine.control = .running + { definition := source + block := index + pc := 0 + values := parameters + credits := #[] } + baselineStack := by + rfl + have rewrittenControl : rewrittenMachine.control = .running + { definition := rewrite.definition + block := index + pc := 0 + values := parameters + credits := #[] } + rewrittenStack := by + rfl + have baselineExecution : Steps baselineContext .logical + (2 * site.shape.fieldCount + 3) baselineMachine + { store := baselineAllocation.1 + heapFuel := remaining + control := .running + { definition := source, values := callValues } baselineStack } := by + simpa [baselineMachine, baselineAllocation] using + baselineAcceptedControl site + (context := baselineContext) (interpretation := .logical) + (definition := source) (blockId := index) + (parameters := parameters) (fields := fields) + (newFields := newFields) (callValues := callValues) + (location := location) (machine := baselineMachine) + (retainedStore := baselineRetained) + (releasedStore := baselineReleased) (remaining := remaining) + (allocationSchema := allocationSchema) (stack := baselineStack) + sourceAt baselineControl parameterCount fieldCount sourceResolved + targetAt rfl retained released allocationSchemaAt allocationResolved + baselineFieldWorlds tailResolved arity sourceNonempty + obtain ⟨logicalExecution, contents, allocationLocation⟩ := + hotLogicalAcceptedPrefix site + (context := rewrittenContext) (definition := rewrite.definition) + (resetId := index) (hotId := source.blocks.size + helperOffset) + (coldId := source.blocks.size + helperOffset + 1) + (parameters := parameters) (fields := fields) + (newFields := newFields) (callValues := callValues) + (location := location) (sourceSchema := sourceSchema) + (allocationSchema := allocationSchema) (machine := rewrittenMachine) + (baselineRetained := baselineRetained) + (baselineReleased := baselineReleased) (stack := rewrittenStack) + (fieldFuel := fieldFuel) (remaining := remaining) (ambient := ambient) + resetAt hotAt rewrittenSourceSchemaAt rewrittenAllocationSchemaAt + sourceLayout + allocationLayout rewrittenControl parameterCount fieldCount + sourceResolved targetAt owned retained released allocationResolved + baselineFieldWorlds tailResolved targetArity targetNonempty + exact ⟨baselineExecution, + by simpa [rewrittenMachine, logicalAllocation] using logicalExecution, + by simpa [baselineAllocation, logicalAllocation] using contents, + by simpa [baselineAllocation, logicalAllocation] using + allocationLocation⟩ + +/-- At an accepted decision whose source has more than one shared owner, the +baseline retain/release prefix and the rewritten cold reset commute. Thus +both actual CFGs reach the same call arguments and heaps with identical live +contents, although reset-observation counters may differ. -/ +theorem acceptedColdSimulation {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {index helperOffset : Nat} {block : Block} + {site : Reuse.Site limits validation block} + (found : Reuse.FunctionDecisions.At rewrite.decisions index helperOffset + block (.accepted site)) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + (baselineSchemas : baselineContext.schemas = validation.schemas) + (rewrittenSchemas : rewrittenContext.schemas = validation.schemas) + {store baselineRetained : Store} + {parameters fields newFields callValues : Array RVal} + {location fieldFuel rc retainedRc : Nat} + {baselineStack rewrittenStack : List Continuation} + {allocationSchema : CtorSchema} + (allocationSchemaAt : + baselineContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (sourceResolved : resolveAtom parameters (.reg site.shape.source) = + .ok (.loc location)) + (targetAt : store.get? location = some + ⟨.shared, rc, .ctorN site.shape.sourceConstructor fields⟩) + (shared : 1 < rc) + (retained : RetainSharedMany store fields baselineRetained) + (retainedAt : baselineRetained.get? location = some + ⟨.shared, retainedRc, .ctorN site.shape.sourceConstructor fields⟩) + (allocationResolved : resolveAtoms + (baselinePrefixValues parameters fields) + site.shape.allocationArguments = .ok newFields) + (baselineFieldWorlds : FieldWorlds + (baselineDecrementStore baselineRetained location + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩) + allocationSchema newFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc ((baselineDecrementStore baselineRetained location + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩).allocNode .shared + (.ctorN site.shape.allocationConstructor newFields)).2)) + site.shape.tailArguments = .ok callValues) + (arity : callValues.size = source.signature.params.size) : + let baselineMachine : Machine := + { store + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := parameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store + heapFuel := fieldFuel + 1 + control := .running + { definition := rewrite.definition + block := index + values := parameters + credits := #[] } + rewrittenStack } + let baselineReleased := baselineDecrementStore baselineRetained location + ⟨.shared, retainedRc, .ctorN site.shape.sourceConstructor fields⟩ + let resetStore := baselineReleased.tickResetAttempt.tickColdReset + let baselineAllocation := baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + let resetAllocation := resetStore.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + Steps baselineContext interpretation (2 * site.shape.fieldCount + 3) + baselineMachine + { store := baselineAllocation.1 + heapFuel := fieldFuel + control := .running + { definition := source, values := callValues } baselineStack } ∧ + Steps rewrittenContext interpretation 4 rewrittenMachine + { rewrittenMachine with + store := resetAllocation.1 + control := .running + { definition := rewrite.definition, values := callValues } + rewrittenStack } ∧ + HeapContentsEq baselineAllocation.1 resetAllocation.1 ∧ + baselineAllocation.2 = resetAllocation.2 := by + dsimp only + obtain ⟨sourceAt, resetAt, _hotAt, coldAt⟩ := rewrite.acceptedAt found + obtain ⟨sourceSchema, siteAllocationSchema, sourceSchemaAt, + siteAllocationSchemaAt, _sourceFields, _allocationFields, + sourceLayout, allocationLayout⟩ := + evalRuntimeSchemas site baselineSchemas + have allocationSchemaEq : siteAllocationSchema = allocationSchema := by + exact Option.some.inj (siteAllocationSchemaAt.symm.trans allocationSchemaAt) + subst siteAllocationSchema + have rewrittenSourceSchemaAt : + rewrittenContext.schemas .shared site.shape.sourceConstructor = + some sourceSchema := by + simpa [baselineSchemas, rewrittenSchemas] using sourceSchemaAt + have rewrittenAllocationSchemaAt : + rewrittenContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema := by + simpa [baselineSchemas, rewrittenSchemas] using allocationSchemaAt + obtain ⟨actualRetainedRc, actualRetainedAt, released, + resetRetained, heapsEqual⟩ := + coldPrefix_commutes (heapFuel := fieldFuel) targetAt shared retained + have retainedBoxesEqual : + (⟨.shared, actualRetainedRc, + .ctorN site.shape.sourceConstructor fields⟩ : IxIR1.NodeBox) = + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩ := + Option.some.inj (actualRetainedAt.symm.trans retainedAt) + have retainedRcEqual : actualRetainedRc = retainedRc := by + cases retainedBoxesEqual + rfl + subst actualRetainedRc + let baselineMachine : Machine := + { store + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := parameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store + heapFuel := fieldFuel + 1 + control := .running + { definition := rewrite.definition + block := index + values := parameters + credits := #[] } + rewrittenStack } + let baselineReleased := baselineDecrementStore baselineRetained location + ⟨.shared, retainedRc, .ctorN site.shape.sourceConstructor fields⟩ + let resetStore := baselineReleased.tickResetAttempt.tickColdReset + let baselineAllocation := baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + let resetAllocation := resetStore.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + have sourceNonempty : source.blocks.isEmpty = false := + blocks_nonempty_of_getElem sourceAt + have targetNonempty : rewrite.definition.blocks.isEmpty = false := + blocks_nonempty_of_getElem resetAt + have targetArity : + callValues.size = rewrite.definition.signature.params.size := by + simpa using arity + have baselineControl : baselineMachine.control = .running + { definition := source + block := index + pc := 0 + values := parameters + credits := #[] } + baselineStack := by + rfl + have rewrittenControl : rewrittenMachine.control = .running + { definition := rewrite.definition + block := index + pc := 0 + values := parameters + credits := #[] } + rewrittenStack := by + rfl + have contents : HeapContentsEq baselineReleased resetStore := by + refine ⟨?_⟩ + simpa [baselineReleased, resetStore] using + congrArg IxIR1.Store.nodes heapsEqual + have viewed : ConstructorView rewrittenMachine.store location .shared + site.shape.sourceConstructor + ⟨.shared, rc, .ctorN site.shape.sourceConstructor fields⟩ fields := + ConstructorView.of_box targetAt rfl rfl + have baselineExecution : Steps baselineContext interpretation + (2 * site.shape.fieldCount + 3) baselineMachine + { store := baselineAllocation.1 + heapFuel := fieldFuel + control := .running + { definition := source, values := callValues } baselineStack } := by + simpa [baselineMachine, baselineReleased, baselineAllocation] using + baselineAcceptedControl site + (context := baselineContext) (interpretation := interpretation) + (definition := source) (blockId := index) + (parameters := parameters) (fields := fields) + (newFields := newFields) (callValues := callValues) + (location := location) (machine := baselineMachine) + (retainedStore := baselineRetained) + (releasedStore := baselineReleased) (remaining := fieldFuel) + (allocationSchema := allocationSchema) (stack := baselineStack) + sourceAt baselineControl parameterCount fieldCount sourceResolved + targetAt rfl retained (by simpa [baselineReleased] using released) + allocationSchemaAt allocationResolved + (by simpa [baselineReleased] using baselineFieldWorlds) + (by simpa [baselineReleased] using tailResolved) arity + sourceNonempty + obtain ⟨coldExecution, allocationContents, allocationLocation⟩ := + coldAcceptedPrefix site + (context := rewrittenContext) (interpretation := interpretation) + (definition := rewrite.definition) (resetId := index) + (hotId := source.blocks.size + helperOffset) + (coldId := source.blocks.size + helperOffset + 1) + (parameters := parameters) (fields := fields) + (newFields := newFields) (callValues := callValues) + (location := location) + (box := ⟨.shared, rc, + .ctorN site.shape.sourceConstructor fields⟩) + (sourceSchema := sourceSchema) (allocationSchema := allocationSchema) + (machine := rewrittenMachine) (resetStore := resetStore) + (baselineReleased := baselineReleased) (stack := rewrittenStack) + resetAt coldAt rewrittenSourceSchemaAt rewrittenAllocationSchemaAt + sourceLayout + allocationLayout rewrittenControl parameterCount fieldCount + sourceResolved viewed shared + (by simpa [coldResetStartStore, resetStore, baselineReleased] using + resetRetained) + contents allocationResolved + (by simpa [baselineReleased] using baselineFieldWorlds) + (by simpa [baselineReleased] using tailResolved) targetArity + targetNonempty + exact ⟨baselineExecution, + by simpa [rewrittenMachine, resetStore, baselineReleased, + resetAllocation] using coldExecution, + by simpa [baselineAllocation, resetAllocation, baselineReleased, + resetStore] using + allocationContents, + by simpa [baselineAllocation, resetAllocation, baselineReleased, + resetStore] using + allocationLocation⟩ + +/-- At an accepted unit-refcount decision, the original baseline block and +the physical hot replacement both execute to recursive calls. The resulting +heaps and argument vectors are related by the concrete reuse location +bijection, so this statement does not assume that fresh allocation happened +to choose the reused address. -/ +theorem acceptedHotPhysicalSimulationIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {index helperOffset : Nat} {block : Block} + {site : Reuse.Site limits validation block} + (found : Reuse.FunctionDecisions.At rewrite.decisions index helperOffset + block (.accepted site)) + {baselineContext rewrittenContext : Eval.Context} + (baselineSchemas : baselineContext.schemas = validation.schemas) + (rewrittenSchemas : rewrittenContext.schemas = validation.schemas) + {store baselineRetained baselineReleased : Store} + {parameters fields newFields baselineCallValues : Array RVal} + {location fieldFuel remaining : Nat} + {baselineStack rewrittenStack : List Continuation} + {before after : List IxIR1.Sim.Root} + {allocationSchema : CtorSchema} + (allocationSchemaAt : + baselineContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (sourceResolved : resolveAtom parameters (.reg site.shape.source) = + .ok (.loc location)) + (targetAt : store.get? location = some + ⟨.shared, 1, .ctorN site.shape.sourceConstructor fields⟩) + (retained : RetainSharedMany store fields baselineRetained) + (released : releaseShared (fieldFuel + 1) baselineRetained + (.loc location) = .ok (baselineReleased, remaining)) + (owned : IxIR1.Sim.RootOwnership store.heap + (⟨.shared, .loc location⟩ :: before)) + (partition : + (IxIR1.Sim.rootsFor .shared fields.toList ++ before).Perm + (IxIR1.Sim.rootsFor .shared newFields.toList ++ after)) + (newWorld : IxIR1.Sim.NodeWorld .shared + (.ctorN site.shape.allocationConstructor newFields)) + (mapped : MappedValuesInRoots site.shape + (baselinePrefixValues parameters fields) after) + (allocationResolved : resolveAtoms + (baselinePrefixValues parameters fields) + site.shape.allocationArguments = .ok newFields) + (baselineFieldWorlds : + FieldWorlds baselineReleased allocationSchema newFields) + (physicalFieldWorlds : FieldWorlds + (physicalHotResetStore store location) allocationSchema newFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc (baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields)).2)) + site.shape.tailArguments = .ok baselineCallValues) + (arity : baselineCallValues.size = source.signature.params.size) : + let baselineMachine : Machine := + { store + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := parameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store + heapFuel := fieldFuel + 1 + control := .running + { definition := rewrite.definition + block := index + values := parameters + credits := #[] } + rewrittenStack } + let baselineAllocation := baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + Steps baselineContext .physical (2 * site.shape.fieldCount + 3) + baselineMachine + { store := baselineAllocation.1 + heapFuel := remaining + control := .running + { definition := source, values := baselineCallValues } + baselineStack } ∧ + ∃ physical, + physicalHotReuseStore store location + (.ctorN site.shape.allocationConstructor newFields) + allocationSchema.fields.size = .ok physical ∧ + ∃ iso : IxIR1.Sim.HeapIso physical.heap baselineAllocation.1.heap, + IxIR1.Sim.RootOwnership physical.heap + (⟨.shared, .loc location⟩ :: after) ∧ + IxIR1.Sim.RootOwnership baselineAllocation.1.heap + (⟨.shared, .loc baselineAllocation.2⟩ :: after) ∧ + iso.locRel location baselineAllocation.2 ∧ + ∃ physicalCallValues, + Steps rewrittenContext .physical 4 rewrittenMachine + { rewrittenMachine with + store := physical + control := .running + { definition := rewrite.definition + values := physicalCallValues } + rewrittenStack } ∧ + IxIR1.Sim.RValsIso (fun baseline physicalLocation => + iso.locRel physicalLocation baseline) + baselineCallValues.toList physicalCallValues.toList := by + dsimp only + obtain ⟨sourceAt, resetAt, hotAt, _coldAt⟩ := rewrite.acceptedAt found + obtain ⟨sourceSchema, siteAllocationSchema, sourceSchemaAt, + siteAllocationSchemaAt, _sourceFields, _allocationFields, + sourceLayout, allocationLayout⟩ := + evalRuntimeSchemas site baselineSchemas + have allocationSchemaEq : siteAllocationSchema = allocationSchema := by + exact Option.some.inj (siteAllocationSchemaAt.symm.trans allocationSchemaAt) + subst siteAllocationSchema + have rewrittenSourceSchemaAt : + rewrittenContext.schemas .shared site.shape.sourceConstructor = + some sourceSchema := by + simpa [baselineSchemas, rewrittenSchemas] using sourceSchemaAt + have rewrittenAllocationSchemaAt : + rewrittenContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema := by + simpa [baselineSchemas, rewrittenSchemas] using allocationSchemaAt + let baselineMachine : Machine := + { store + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := parameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store + heapFuel := fieldFuel + 1 + control := .running + { definition := rewrite.definition + block := index + values := parameters + credits := #[] } + rewrittenStack } + let baselineAllocation := baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + have sourceNonempty : source.blocks.isEmpty = false := + blocks_nonempty_of_getElem sourceAt + have targetNonempty : rewrite.definition.blocks.isEmpty = false := + blocks_nonempty_of_getElem resetAt + have targetArity : baselineCallValues.size = + rewrite.definition.signature.params.size := by + simpa using arity + have baselineControl : baselineMachine.control = .running + { definition := source + block := index + pc := 0 + values := parameters + credits := #[] } + baselineStack := by + rfl + have rewrittenControl : rewrittenMachine.control = .running + { definition := rewrite.definition + block := index + pc := 0 + values := parameters + credits := #[] } + rewrittenStack := by + rfl + have baselineExecution : Steps baselineContext .physical + (2 * site.shape.fieldCount + 3) baselineMachine + { store := baselineAllocation.1 + heapFuel := remaining + control := .running + { definition := source, values := baselineCallValues } + baselineStack } := by + simpa [baselineMachine, baselineAllocation] using + baselineAcceptedControl site + (context := baselineContext) (interpretation := .physical) + (definition := source) (blockId := index) + (parameters := parameters) (fields := fields) + (newFields := newFields) (callValues := baselineCallValues) + (location := location) (machine := baselineMachine) + (retainedStore := baselineRetained) + (releasedStore := baselineReleased) (remaining := remaining) + (allocationSchema := allocationSchema) (stack := baselineStack) + sourceAt baselineControl parameterCount fieldCount sourceResolved + targetAt rfl retained released allocationSchemaAt allocationResolved + baselineFieldWorlds tailResolved arity sourceNonempty + obtain ⟨physical, reused, iso, physicalOwned, baselineOwned, + resultRelated, physicalCallValues, physicalExecution, callsRelated⟩ := + hotPhysicalAcceptedPrefixIso site + (context := rewrittenContext) (definition := rewrite.definition) + (resetId := index) (hotId := source.blocks.size + helperOffset) + (coldId := source.blocks.size + helperOffset + 1) + (parameters := parameters) (fields := fields) + (newFields := newFields) (baselineCallValues := baselineCallValues) + (location := location) (sourceSchema := sourceSchema) + (allocationSchema := allocationSchema) (machine := rewrittenMachine) + (baselineRetained := baselineRetained) + (baselineReleased := baselineReleased) (stack := rewrittenStack) + (fieldFuel := fieldFuel) (remaining := remaining) + (before := before) (after := after) + resetAt hotAt rewrittenSourceSchemaAt rewrittenAllocationSchemaAt + sourceLayout + allocationLayout rewrittenControl parameterCount fieldCount + sourceResolved targetAt retained released owned partition newWorld mapped + allocationResolved physicalFieldWorlds tailResolved targetArity + targetNonempty + exact ⟨baselineExecution, physical, reused, iso, + by simpa [baselineAllocation] using physicalOwned, + by simpa [baselineAllocation] using baselineOwned, + by simpa [baselineAllocation] using resultRelated, + physicalCallValues, + by simpa [rewrittenMachine] using physicalExecution, + callsRelated⟩ + +/-! ## Stable whole-program relation -/ + +/-- Credits in two executions agree modulo the same location relation as +ordinary runtime values. Logical reservations carry no address; physical +reservations carry corresponding (possibly numerically different) dead heap +slots. -/ +inductive StableCreditIso (locRel : Nat → Nat → Prop) : + Option Credit → Option Credit → Prop where + | consumed : StableCreditIso locRel none none + | absent (layout : LayoutId) : StableCreditIso locRel + (some { layout, presence := .absent }) + (some { layout, presence := .absent }) + | logical (layout : LayoutId) : StableCreditIso locRel + (some { layout, presence := .present none }) + (some { layout, presence := .present none }) + | physical {layout : LayoutId} {baselineLocation rewrittenLocation : Nat} + (location : locRel baselineLocation rewrittenLocation) : + StableCreditIso locRel + (some { layout, presence := .present (some baselineLocation) }) + (some { layout, presence := .present (some rewrittenLocation) }) + +/-- Pointwise credit-file isomorphism. -/ +inductive StableCreditsIso (locRel : Nat → Nat → Prop) : + List (Option Credit) → List (Option Credit) → Prop where + | nil : StableCreditsIso locRel [] [] + | cons {baseline rewritten : Option Credit} + {baselineTail rewrittenTail : List (Option Credit)} + (head : StableCreditIso locRel baseline rewritten) + (tail : StableCreditsIso locRel baselineTail rewrittenTail) : + StableCreditsIso locRel (baseline :: baselineTail) + (rewritten :: rewrittenTail) + +namespace StableCreditIso + +theorem mono {oldRel newRel : Nat → Nat → Prop} + (lift : ∀ {baselineLocation rewrittenLocation}, + oldRel baselineLocation rewrittenLocation → + newRel baselineLocation rewrittenLocation) + {baseline rewritten : Option Credit} + (credit : StableCreditIso oldRel baseline rewritten) : + StableCreditIso newRel baseline rewritten := by + cases credit with + | consumed => exact .consumed + | absent layout => exact .absent layout + | logical layout => exact .logical layout + | physical location => exact .physical (lift location) + +theorem refl : ∀ credit : Option Credit, + StableCreditIso (fun left right => left = right) credit credit + | none => .consumed + | some ⟨layout, .absent⟩ => .absent layout + | some ⟨layout, .present none⟩ => .logical layout + | some ⟨_layout, .present (some _location)⟩ => .physical rfl + +theorem eq_of_location_eq {baseline rewritten : Option Credit} + (credit : StableCreditIso (fun left right => left = right) + baseline rewritten) : baseline = rewritten := by + cases credit with + | consumed => rfl + | absent layout => rfl + | logical layout => rfl + | physical location => cases location; rfl + +theorem isSome_eq {locRel : Nat → Nat → Prop} + {baseline rewritten : Option Credit} + (credit : StableCreditIso locRel baseline rewritten) : + baseline.isSome = rewritten.isSome := by + cases credit <;> rfl + +theorem present_parts {locRel : Nat → Nat → Prop} + {baseline rewritten : Credit} + (credit : StableCreditIso locRel (some baseline) (some rewritten)) : + baseline.layout = rewritten.layout ∧ + baseline.isPresent = rewritten.isPresent := by + cases credit with + | absent layout => exact ⟨rfl, rfl⟩ + | logical layout => exact ⟨rfl, rfl⟩ + | physical location => exact ⟨rfl, rfl⟩ + +theorem absent_parts {locRel : Nat → Nat → Prop} + {baseline rewritten : Credit} + (credit : StableCreditIso locRel (some baseline) (some rewritten)) + (absent : baseline.presence = .absent) : + baseline.layout = rewritten.layout ∧ + rewritten.presence = .absent := by + cases credit <;> simp_all + +theorem logical_parts {locRel : Nat → Nat → Prop} + {baseline rewritten : Credit} + (credit : StableCreditIso locRel (some baseline) (some rewritten)) + (logical : baseline.presence = .present none) : + baseline.layout = rewritten.layout ∧ + rewritten.presence = .present none := by + cases credit <;> simp_all + +theorem physical_parts {locRel : Nat → Nat → Prop} + {baseline rewritten : Credit} {baselineLocation : Nat} + (credit : StableCreditIso locRel (some baseline) (some rewritten)) + (physical : baseline.presence = .present (some baselineLocation)) : + ∃ rewrittenLocation, + baseline.layout = rewritten.layout ∧ + rewritten.presence = .present (some rewrittenLocation) ∧ + locRel baselineLocation rewrittenLocation := by + cases credit <;> simp_all + +end StableCreditIso + +namespace StableCreditsIso + +theorem mono {oldRel newRel : Nat → Nat → Prop} + (lift : ∀ {baselineLocation rewrittenLocation}, + oldRel baselineLocation rewrittenLocation → + newRel baselineLocation rewrittenLocation) : + ∀ {baseline rewritten : List (Option Credit)}, + StableCreditsIso oldRel baseline rewritten → + StableCreditsIso newRel baseline rewritten + | _, _, .nil => .nil + | _, _, .cons head tail => .cons (head.mono lift) (mono lift tail) + +theorem refl : ∀ credits : List (Option Credit), + StableCreditsIso (fun left right => left = right) credits credits + | [] => .nil + | credit :: rest => .cons (StableCreditIso.refl credit) (refl rest) + +theorem eq_of_location_eq {baseline rewritten : List (Option Credit)} + (credits : StableCreditsIso (fun left right => left = right) + baseline rewritten) : baseline = rewritten := by + induction credits with + | nil => rfl + | cons head tail ih => rw [head.eq_of_location_eq, ih] + +theorem length_eq {locRel : Nat → Nat → Prop} + {baseline rewritten : List (Option Credit)} + (credits : StableCreditsIso locRel baseline rewritten) : + baseline.length = rewritten.length := by + induction credits with + | nil => rfl + | cons _ _ ih => simp [ih] + +theorem append {locRel : Nat → Nat → Prop} + {baseline₁ rewritten₁ baseline₂ rewritten₂ : List (Option Credit)} + (first : StableCreditsIso locRel baseline₁ rewritten₁) + (second : StableCreditsIso locRel baseline₂ rewritten₂) : + StableCreditsIso locRel (baseline₁ ++ baseline₂) + (rewritten₁ ++ rewritten₂) := by + induction first with + | nil => exact second + | cons head tail ih => exact .cons head ih + +theorem get? {locRel : Nat → Nat → Prop} + {baseline rewritten : List (Option Credit)} + (credits : StableCreditsIso locRel baseline rewritten) + {index : Nat} {baselineCredit : Option Credit} + (found : baseline[index]? = some baselineCredit) : + ∃ rewrittenCredit, + rewritten[index]? = some rewrittenCredit ∧ + StableCreditIso locRel baselineCredit rewrittenCredit := by + induction credits generalizing index baselineCredit with + | nil => simp at found + | cons head tail ih => + cases index with + | zero => + simp only [List.getElem?_cons_zero] at found ⊢ + cases found + exact ⟨_, rfl, head⟩ + | succ index => + simp only [List.getElem?_cons_succ] at found ⊢ + exact ih found + +theorem set_none {locRel : Nat → Nat → Prop} : + ∀ {baseline rewritten : List (Option Credit)}, + StableCreditsIso locRel baseline rewritten → + ∀ index, + StableCreditsIso locRel (baseline.set index none) + (rewritten.set index none) + | [], [], .nil, _ => .nil + | _ :: _, _ :: _, .cons _head tail, 0 => .cons .consumed tail + | _ :: _, _ :: _, .cons head tail, index + 1 => + .cons head (set_none tail index) + +theorem array_set_none {locRel : Nat → Nat → Prop} + {baseline rewritten : Array (Option Credit)} + (credits : StableCreditsIso locRel baseline.toList rewritten.toList) + (index : Nat) : + StableCreditsIso locRel + (baseline.setIfInBounds index none).toList + (rewritten.setIfInBounds index none).toList := by + simpa [Array.toList_setIfInBounds] using credits.set_none index + +theorem any_isSome_eq {locRel : Nat → Nat → Prop} + {baseline rewritten : List (Option Credit)} + (credits : StableCreditsIso locRel baseline rewritten) : + baseline.any Option.isSome = rewritten.any Option.isSome := by + induction credits with + | nil => rfl + | cons head tail ih => + simp only [List.any_cons, head.isSome_eq, ih] + +end StableCreditsIso + +/-- A physical credit does not reserve the distinguished location. Logical, +absent, and consumed credits contain no concrete heap address. -/ +def CreditAvoidsLocation (location : Nat) : Option Credit → Prop + | some { presence := .present (some reserved), .. } => reserved ≠ location + | _ => True + +def CreditsAvoidLocation (location : Nat) : List (Option Credit) → Prop + | [] => True + | credit :: rest => + CreditAvoidsLocation location credit ∧ CreditsAvoidLocation location rest + +theorem StableCreditIso.transportRelation + {oldRel newRel : Nat → Nat → Prop} {removed : Nat} + {baseline rewritten : Option Credit} + (credit : StableCreditIso oldRel baseline rewritten) + (avoids : CreditAvoidsLocation removed rewritten) + (lift : ∀ {baselineLocation rewrittenLocation}, + oldRel baselineLocation rewrittenLocation → + rewrittenLocation ≠ removed → + newRel baselineLocation rewrittenLocation) : + StableCreditIso newRel baseline rewritten := by + cases credit with + | consumed => exact .consumed + | absent layout => exact .absent layout + | logical layout => exact .logical layout + | physical location => exact .physical (lift location avoids) + +theorem StableCreditsIso.transportRelation + {oldRel newRel : Nat → Nat → Prop} {removed : Nat} + {baseline rewritten : List (Option Credit)} + (credits : StableCreditsIso oldRel baseline rewritten) + (avoids : CreditsAvoidLocation removed rewritten) + (lift : ∀ {baselineLocation rewrittenLocation}, + oldRel baselineLocation rewrittenLocation → + rewrittenLocation ≠ removed → + newRel baselineLocation rewrittenLocation) : + StableCreditsIso newRel baseline rewritten := by + induction credits with + | nil => exact .nil + | cons head tail ih => + exact .cons (head.transportRelation avoids.1 lift) + (ih avoids.2) + +/-- A source frame and its rewritten counterpart occupy the same control +position and carry pointwise related runtime values. Stable boundaries have +pointwise related credit files; the generated reset/helper diamond is treated +as the four-step macro transition proved above. -/ +structure StableFrameIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + (locRel : Nat → Nat → Prop) (baseline rewritten : Frame) : Prop where + baselineDefinition : baseline.definition = source + rewrittenDefinition : rewritten.definition = rewrite.definition + block : baseline.block = rewritten.block + pc : baseline.pc = rewritten.pc + values : IxIR1.Sim.RValsIso locRel + baseline.values.toList rewritten.values.toList + credits : StableCreditsIso locRel + baseline.credits.toList rewritten.credits.toList + +/-- Existentially select the retained function rewrite governing a stable +frame pair. Direct-call lookup in `Reuse.Trace` constructs exactly this +witness for callees. -/ +inductive StableFrameRel (limits : Validate.Limits) + (validation : Validate.Context) (locRel : Nat → Nat → Prop) : + Frame → Frame → Prop where + | rewritten {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baseline rewritten : Frame} + (frame : StableFrameIso rewrite locRel baseline rewritten) : + StableFrameRel limits validation locRel baseline rewritten + +inductive StableContinuationIso (limits : Validate.Limits) + (validation : Validate.Context) (locRel : Nat → Nat → Prop) : + Continuation → Continuation → Prop where + | resume {baseline rewritten : Frame} + (frame : StableFrameRel limits validation locRel baseline rewritten) : + StableContinuationIso limits validation locRel + (.resume baseline) (.resume rewritten) + | applyMore {baselineArguments rewrittenArguments : Array RVal} + {baseline rewritten : Frame} + (arguments : IxIR1.Sim.RValsIso locRel + baselineArguments.toList rewrittenArguments.toList) + (frame : StableFrameRel limits validation locRel baseline rewritten) : + StableContinuationIso limits validation locRel + (.applyMore baselineArguments baseline) + (.applyMore rewrittenArguments rewritten) + +inductive StableStackIso (limits : Validate.Limits) + (validation : Validate.Context) (locRel : Nat → Nat → Prop) : + List Continuation → List Continuation → Prop where + | nil : StableStackIso limits validation locRel [] [] + | cons {baseline rewritten : Continuation} + {baselineTail rewrittenTail : List Continuation} + (head : StableContinuationIso limits validation locRel + baseline rewritten) + (tail : StableStackIso limits validation locRel + baselineTail rewrittenTail) : + StableStackIso limits validation locRel + (baseline :: baselineTail) (rewritten :: rewrittenTail) + +/-- Runtime values retained in a suspended frame avoid one location. Credit +reservations are controlled separately by the no-live-credit invariant and do +not denote ordinary live heap roots. -/ +def FrameValuesAvoidLocation (location : Nat) (frame : Frame) : Prop := + ∀ value ∈ frame.values.toList, value ≠ .loc location + +def FrameCreditsAvoidLocation (location : Nat) (frame : Frame) : Prop := + CreditsAvoidLocation location frame.credits.toList + +def ContinuationValuesAvoidLocation (location : Nat) : + Continuation → Prop + | .resume frame => FrameValuesAvoidLocation location frame + | .applyMore arguments frame => + (∀ value ∈ arguments.toList, value ≠ .loc location) ∧ + FrameValuesAvoidLocation location frame + +def ContinuationCreditsAvoidLocation (location : Nat) : + Continuation → Prop + | .resume frame => FrameCreditsAvoidLocation location frame + | .applyMore _ frame => FrameCreditsAvoidLocation location frame + +def StackValuesAvoidLocation (location : Nat) : + List Continuation → Prop + | [] => True + | continuation :: rest => + ContinuationValuesAvoidLocation location continuation ∧ + StackValuesAvoidLocation location rest + +def StackCreditsAvoidLocation (location : Nat) : + List Continuation → Prop + | [] => True + | continuation :: rest => + ContinuationCreditsAvoidLocation location continuation ∧ + StackCreditsAvoidLocation location rest + +theorem StableFrameIso.mono {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {oldRel newRel : Nat → Nat → Prop} {baseline rewritten : Frame} + (frame : StableFrameIso rewrite oldRel baseline rewritten) + (lift : ∀ {baselineLocation rewrittenLocation}, + oldRel baselineLocation rewrittenLocation → + newRel baselineLocation rewrittenLocation) : + StableFrameIso rewrite newRel baseline rewritten := + ⟨frame.baselineDefinition, frame.rewrittenDefinition, frame.block, frame.pc, + frame.values.mono lift, frame.credits.mono lift⟩ + +theorem StableFrameRel.mono {limits : Validate.Limits} + {validation : Validate.Context} {oldRel newRel : Nat → Nat → Prop} + {baseline rewritten : Frame} + (frame : StableFrameRel limits validation oldRel baseline rewritten) + (lift : ∀ {baselineLocation rewrittenLocation}, + oldRel baselineLocation rewrittenLocation → + newRel baselineLocation rewrittenLocation) : + StableFrameRel limits validation newRel baseline rewritten := by + cases frame with + | rewritten rewrite related => exact .rewritten rewrite (related.mono lift) + +theorem StableContinuationIso.mono {limits : Validate.Limits} + {validation : Validate.Context} {oldRel newRel : Nat → Nat → Prop} + {baseline rewritten : Continuation} + (continuation : StableContinuationIso limits validation oldRel + baseline rewritten) + (lift : ∀ {baselineLocation rewrittenLocation}, + oldRel baselineLocation rewrittenLocation → + newRel baselineLocation rewrittenLocation) : + StableContinuationIso limits validation newRel baseline rewritten := by + cases continuation with + | resume frame => exact .resume (frame.mono lift) + | applyMore arguments frame => + exact .applyMore (arguments.mono lift) (frame.mono lift) + +theorem StableStackIso.mono {limits : Validate.Limits} + {validation : Validate.Context} {oldRel newRel : Nat → Nat → Prop} + {baseline rewritten : List Continuation} + (stack : StableStackIso limits validation oldRel baseline rewritten) + (lift : ∀ {baselineLocation rewrittenLocation}, + oldRel baselineLocation rewrittenLocation → + newRel baselineLocation rewrittenLocation) : + StableStackIso limits validation newRel baseline rewritten := by + induction stack with + | nil => exact .nil + | cons head tail ih => exact .cons (head.mono lift) ih + +/-- Change the location relation of a stable frame when every rewritten value +survives and each old related location pair embeds into the new relation. -/ +theorem StableFrameIso.transportRelation {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {oldRel newRel : Nat → Nat → Prop} {removed : Nat} + {baseline rewritten : Frame} + (frame : StableFrameIso rewrite oldRel baseline rewritten) + (avoids : FrameValuesAvoidLocation removed rewritten) + (creditsAvoid : FrameCreditsAvoidLocation removed rewritten) + (lift : ∀ {baselineLocation rewrittenLocation}, + oldRel baselineLocation rewrittenLocation → + rewrittenLocation ≠ removed → + newRel baselineLocation rewrittenLocation) : + StableFrameIso rewrite newRel baseline rewritten := + ⟨frame.baselineDefinition, frame.rewrittenDefinition, frame.block, frame.pc, + rvalsIso_transport_avoiding_right lift frame.values avoids, + frame.credits.transportRelation creditsAvoid lift⟩ + +theorem StableFrameRel.transportRelation {limits : Validate.Limits} + {validation : Validate.Context} {oldRel newRel : Nat → Nat → Prop} + {removed : Nat} {baseline rewritten : Frame} + (frame : StableFrameRel limits validation oldRel baseline rewritten) + (avoids : FrameValuesAvoidLocation removed rewritten) + (creditsAvoid : FrameCreditsAvoidLocation removed rewritten) + (lift : ∀ {baselineLocation rewrittenLocation}, + oldRel baselineLocation rewrittenLocation → + rewrittenLocation ≠ removed → + newRel baselineLocation rewrittenLocation) : + StableFrameRel limits validation newRel baseline rewritten := by + cases frame with + | rewritten rewrite related => + exact .rewritten rewrite + (related.transportRelation avoids creditsAvoid lift) + +theorem StableContinuationIso.transportRelation + {limits : Validate.Limits} {validation : Validate.Context} + {oldRel newRel : Nat → Nat → Prop} {removed : Nat} + {baseline rewritten : Continuation} + (continuation : StableContinuationIso limits validation oldRel + baseline rewritten) + (avoids : ContinuationValuesAvoidLocation removed rewritten) + (creditsAvoid : ContinuationCreditsAvoidLocation removed rewritten) + (lift : ∀ {baselineLocation rewrittenLocation}, + oldRel baselineLocation rewrittenLocation → + rewrittenLocation ≠ removed → + newRel baselineLocation rewrittenLocation) : + StableContinuationIso limits validation newRel baseline rewritten := by + cases continuation with + | resume frame => + exact .resume (frame.transportRelation avoids creditsAvoid lift) + | applyMore arguments frame => + exact .applyMore + (rvalsIso_transport_avoiding_right lift arguments avoids.1) + (frame.transportRelation avoids.2 creditsAvoid lift) + +/-- An already-related suspended stack remains related after physical reuse +when its rewritten values do not mention the consumed source location. -/ +theorem StableStackIso.transportRelation {limits : Validate.Limits} + {validation : Validate.Context} {oldRel newRel : Nat → Nat → Prop} + {removed : Nat} {baseline rewritten : List Continuation} + (stack : StableStackIso limits validation oldRel baseline rewritten) + (avoids : StackValuesAvoidLocation removed rewritten) + (creditsAvoid : StackCreditsAvoidLocation removed rewritten) + (lift : ∀ {baselineLocation rewrittenLocation}, + oldRel baselineLocation rewrittenLocation → + rewrittenLocation ≠ removed → + newRel baselineLocation rewrittenLocation) : + StableStackIso limits validation newRel baseline rewritten := by + induction stack with + | nil => exact .nil + | cons head tail ih => + exact .cons + (head.transportRelation avoids.1 creditsAvoid.1 lift) + (ih avoids.2 creditsAvoid.2) + +inductive StableControlIso (limits : Validate.Limits) + (validation : Validate.Context) (locRel : Nat → Nat → Prop) : + Control → Control → Prop where + | running {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (frame : StableFrameRel limits validation locRel + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation locRel + baselineStack rewrittenStack) : + StableControlIso limits validation locRel + (.running baselineFrame baselineStack) + (.running rewrittenFrame rewrittenStack) + | halted {baselineValue rewrittenValue : RVal} + (value : IxIR1.Sim.RValIso locRel baselineValue rewrittenValue) : + StableControlIso limits validation locRel + (.halted baselineValue) (.halted rewrittenValue) + +/-- Stable heaps are either fixed-address equal in semantic contents or +related by a physical-to-baseline allocation-history bijection. Historical +dead/dead rows keep stale but unreachable register and credit locations +compositional across ordinary reclamation steps. -/ +inductive StableHeapRel (baseline rewritten : Store) : + (Nat → Nat → Prop) → Prop where + | contents (same : HeapContentsEq baseline rewritten) : + StableHeapRel baseline rewritten (fun left right => left = right) + | isomorphic + (iso : IxIR1.Sim.HeapHistoryIso rewritten.heap baseline.heap) : + StableHeapRel baseline rewritten + (fun baselineLocation rewrittenLocation => + iso.locRel rewrittenLocation baselineLocation) + +/-- Stable machine states combine heap and control relations. The rewritten +machine retains at least the baseline heap budget because reset/reuse removes +baseline traversal work; observational counters remain outside this semantic +relation. -/ +inductive StableMachineRel (limits : Validate.Limits) + (validation : Validate.Context) (baseline rewritten : Machine) : Prop where + | related (locRel : Nat → Nat → Prop) + (heap : StableHeapRel baseline.store rewritten.store locRel) + (fuel : baseline.heapFuel ≤ rewritten.heapFuel) + (control : StableControlIso limits validation locRel + baseline.control rewritten.control) : + StableMachineRel limits validation baseline rewritten + +/-- Build the stable machine relation from a baseline-to-rewritten allocation +history. `StableHeapRel` stores the symmetric orientation so its public +location relation continues to run from baseline values to rewritten values. -/ +theorem StableMachineRel.history {limits : Validate.Limits} + {validation : Validate.Context} {baseline rewritten : Machine} + (heap : IxIR1.Sim.HeapHistoryIso baseline.store.heap + rewritten.store.heap) + (fuel : baseline.heapFuel ≤ rewritten.heapFuel) + (control : StableControlIso limits validation heap.locRel + baseline.control rewritten.control) : + StableMachineRel limits validation baseline rewritten := by + exact .related heap.locRel (.isomorphic heap.symm) fuel control + +/-- Inversion of the uniform machine relation at a halted baseline state. +The rewritten state must also be halted, with a related result value and the +same heap/fuel witnesses retained for the runner-level theorem. -/ +theorem StableMachineRel.haltedParts {limits : Validate.Limits} + {validation : Validate.Context} + {baselineStore : Store} {baselineFuel : Nat} {baselineValue : RVal} + {rewritten : Machine} + (relation : StableMachineRel limits validation + { store := baselineStore + heapFuel := baselineFuel + control := .halted baselineValue } + rewritten) : + ∃ rewrittenStore rewrittenFuel rewrittenValue locRel, + rewritten = + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .halted rewrittenValue } ∧ + StableHeapRel baselineStore rewrittenStore locRel ∧ + baselineFuel ≤ rewrittenFuel ∧ + IxIR1.Sim.RValIso locRel baselineValue rewrittenValue := by + cases rewritten with + | mk rewrittenStore rewrittenFuel rewrittenControl => + cases relation with + | related locRel heap fuel control => + cases control with + | halted value => + exact ⟨rewrittenStore, rewrittenFuel, _, locRel, rfl, heap, + fuel, value⟩ + +theorem StableFrameIso.entry {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {locRel : Nat → Nat → Prop} + {baselineValues rewrittenValues : Array RVal} + (values : IxIR1.Sim.RValsIso locRel + baselineValues.toList rewrittenValues.toList) : + StableFrameIso rewrite locRel + { definition := source, values := baselineValues } + { definition := rewrite.definition, values := rewrittenValues } := by + exact ⟨rfl, rfl, rfl, rfl, values, .nil⟩ + +theorem StableFrameIso.atPosition {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {locRel : Nat → Nat → Prop} {block pc : Nat} + {baselineValues rewrittenValues : Array RVal} + {credits : Array (Option Credit)} + (values : IxIR1.Sim.RValsIso locRel + baselineValues.toList rewrittenValues.toList) + (creditsRelated : StableCreditsIso locRel + credits.toList credits.toList) : + StableFrameIso rewrite locRel + { definition := source + block + pc + values := baselineValues + credits } + { definition := rewrite.definition + block + pc + values := rewrittenValues + credits } := by + exact ⟨rfl, rfl, rfl, rfl, values, creditsRelated⟩ + +/-- A successful current-block lookup in a related source frame dispatches +through the rewrite's exhaustive unchanged/accepted decision. -/ +theorem StableFrameIso.blockCase {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {locRel : Nat → Nat → Prop} {baseline rewritten : Frame} + (frame : StableFrameIso rewrite locRel baseline rewritten) + {block : Block} + (found : baseline.definition.blocks[baseline.block]? = some block) : + Reuse.FunctionRewrite.BlockCase rewrite baseline.block := by + have sourceAt : source.blocks[baseline.block]? = some block := by + rw [← frame.baselineDefinition] + exact found + exact rewrite.blockCaseOfLookup sourceAt + +/-- Advancing related frames and appending related results preserves the +stable frame relation. -/ +theorem StableFrameIso.advancePush {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {locRel : Nat → Nat → Prop} {baseline rewritten : Frame} + (frame : StableFrameIso rewrite locRel baseline rewritten) + {baselineValue rewrittenValue : RVal} + (value : IxIR1.Sim.RValIso locRel baselineValue rewrittenValue) : + StableFrameIso rewrite locRel + { baseline with + pc := baseline.pc + 1 + values := baseline.values.push baselineValue } + { rewritten with + pc := rewritten.pc + 1 + values := rewritten.values.push rewrittenValue } := by + refine ⟨frame.baselineDefinition, frame.rewrittenDefinition, + frame.block, congrArg (fun pc => pc + 1) frame.pc, ?_, frame.credits⟩ + simpa using rvalsIso_append frame.values value + +/-- Appending a result to related value files, without advancing control, is +the frame operation performed when an ordinary return resumes its caller. -/ +theorem StableFrameIso.push {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {locRel : Nat → Nat → Prop} {baseline rewritten : Frame} + (frame : StableFrameIso rewrite locRel baseline rewritten) + {baselineValue rewrittenValue : RVal} + (value : IxIR1.Sim.RValIso locRel baselineValue rewrittenValue) : + StableFrameIso rewrite locRel + { baseline with values := baseline.values.push baselineValue } + { rewritten with values := rewritten.values.push rewrittenValue } := by + refine ⟨frame.baselineDefinition, frame.rewrittenDefinition, + frame.block, frame.pc, ?_, frame.credits⟩ + simpa using rvalsIso_append frame.values value + +theorem StableFrameIso.advance {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {locRel : Nat → Nat → Prop} {baseline rewritten : Frame} + (frame : StableFrameIso rewrite locRel baseline rewritten) : + StableFrameIso rewrite locRel + { baseline with pc := baseline.pc + 1 } + { rewritten with pc := rewritten.pc + 1 } := by + exact ⟨frame.baselineDefinition, frame.rewrittenDefinition, + frame.block, congrArg (fun pc => pc + 1) frame.pc, + frame.values, frame.credits⟩ + +/-- A successful credit lookup in one related frame finds a related credit in +the other frame. -/ +theorem StableFrameIso.creditLookup {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {locRel : Nat → Nat → Prop} {baseline rewritten : Frame} + (frame : StableFrameIso rewrite locRel baseline rewritten) + {id : CreditId} {baselineCredit : Credit} + (lookedUp : CreditLookup baseline id baselineCredit) : + ∃ rewrittenCredit, + CreditLookup rewritten id rewrittenCredit ∧ + StableCreditIso locRel (some baselineCredit) + (some rewrittenCredit) := by + have baselineFound : baseline.credits[id]? = + some (some baselineCredit) := + (CreditTake.of_lookup lookedUp).target_eq.2 + have baselineListFound : baseline.credits.toList[id]? = + some (some baselineCredit) := by + simpa using baselineFound + obtain ⟨rewrittenSlot, rewrittenListFound, related⟩ := + frame.credits.get? baselineListFound + cases rewrittenSlot with + | none => cases related + | some rewrittenCredit => + have rewrittenFound : rewritten.credits[id]? = + some (some rewrittenCredit) := by + simpa using rewrittenListFound + exact ⟨rewrittenCredit, CreditLookup.of_getElem rewrittenFound, related⟩ + +theorem StableFrameIso.noLiveCredits {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {locRel : Nat → Nat → Prop} {baseline rewritten : Frame} + (frame : StableFrameIso rewrite locRel baseline rewritten) + (cleared : NoLiveCredits baseline) : NoLiveCredits rewritten := by + unfold NoLiveCredits at cleared ⊢ + rw [← Array.any_toList] at cleared ⊢ + rw [← frame.credits.any_isSome_eq] + exact cleared + +/-- Consuming corresponding credit slots without changing control preserves +the frame relation and returns related authorities. -/ +theorem StableFrameIso.takeIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {locRel : Nat → Nat → Prop} {baseline rewritten baselineNext : Frame} + (frame : StableFrameIso rewrite locRel baseline rewritten) + {id : CreditId} {baselineCredit : Credit} + (taken : CreditTake baseline id baselineNext baselineCredit) : + ∃ rewrittenNext rewrittenCredit, + CreditTake rewritten id rewrittenNext rewrittenCredit ∧ + StableCreditIso locRel (some baselineCredit) + (some rewrittenCredit) ∧ + StableFrameIso rewrite locRel baselineNext rewrittenNext := by + obtain ⟨baselineNextEq, baselineFound⟩ := taken.target_eq + have baselineLookup : CreditLookup baseline id baselineCredit := + CreditLookup.of_getElem baselineFound + obtain ⟨rewrittenCredit, rewrittenLookup, creditRelated⟩ := + frame.creditLookup baselineLookup + let rewrittenNext : Frame := + { rewritten with + credits := rewritten.credits.setIfInBounds id none } + have rewrittenTaken : CreditTake rewritten id rewrittenNext + rewrittenCredit := CreditTake.of_lookup rewrittenLookup + refine ⟨rewrittenNext, rewrittenCredit, rewrittenTaken, creditRelated, ?_⟩ + subst baselineNext + exact ⟨frame.baselineDefinition, frame.rewrittenDefinition, frame.block, + frame.pc, frame.values, frame.credits.array_set_none id⟩ + +/-- Batch edge-credit consumption is equivariant under the stable frame +relation. The transferred credit vector is related pointwise, including +transport of physical reservation locations. -/ +theorem StableFrameIso.takeManyIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {locRel : Nat → Nat → Prop} {baseline rewritten baselineNext : Frame} + (frame : StableFrameIso rewrite locRel baseline rewritten) + {ids : Array CreditId} {baselineCredits : Array Credit} + (taken : CreditTakeMany baseline ids baselineNext baselineCredits) : + ∃ rewrittenNext rewrittenCredits, + CreditTakeMany rewritten ids rewrittenNext rewrittenCredits ∧ + StableCreditsIso locRel + (baselineCredits.map some).toList + (rewrittenCredits.map some).toList ∧ + StableFrameIso rewrite locRel baselineNext rewrittenNext := by + have follow : ∀ {baselineCurrent : Frame} {remaining : List CreditId} + {baselineTarget : Frame} {baselineOutput : List Credit}, + CreditTakeSequence baselineCurrent remaining baselineTarget + baselineOutput → + ∀ {rewrittenCurrent : Frame}, + StableFrameIso rewrite locRel baselineCurrent rewrittenCurrent → + ∃ rewrittenTarget rewrittenOutput, + CreditTakeSequence rewrittenCurrent remaining rewrittenTarget + rewrittenOutput ∧ + StableCreditsIso locRel (baselineOutput.map some) + (rewrittenOutput.map some) ∧ + StableFrameIso rewrite locRel baselineTarget rewrittenTarget := by + intro baselineCurrent remaining baselineTarget baselineOutput sequence + induction sequence with + | nil current => + intro rewrittenCurrent related + exact ⟨rewrittenCurrent, [], .nil rewrittenCurrent, .nil, related⟩ + | @cons current middle target id remaining credit credits head tail ih => + intro rewrittenCurrent related + obtain ⟨rewrittenMiddle, rewrittenCredit, rewrittenHead, + creditRelated, middleRelated⟩ := related.takeIso head + obtain ⟨rewrittenTarget, rewrittenCredits, rewrittenTail, + creditsRelated, targetRelated⟩ := ih middleRelated + exact ⟨rewrittenTarget, rewrittenCredit :: rewrittenCredits, + .cons rewrittenHead rewrittenTail, + .cons creditRelated creditsRelated, targetRelated⟩ + obtain ⟨rewrittenNext, rewrittenOutput, rewrittenSequence, + outputRelated, nextRelated⟩ := follow taken.sequence frame + let rewrittenCredits : Array Credit := rewrittenOutput.toArray + have rewrittenTaken : CreditTakeMany rewritten ids rewrittenNext + rewrittenCredits := by + simpa [rewrittenCredits] using rewrittenSequence.toMany + refine ⟨rewrittenNext, rewrittenCredits, rewrittenTaken, ?_, nextRelated⟩ + simpa [rewrittenCredits] using outputRelated + +/-- Consuming corresponding credit slots preserves the frame relation and +returns related logical or physical authorities. -/ +theorem StableFrameIso.advanceTakeIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {locRel : Nat → Nat → Prop} {baseline rewritten baselineNext : Frame} + (frame : StableFrameIso rewrite locRel baseline rewritten) + {id : CreditId} {baselineCredit : Credit} + (taken : CreditTake { baseline with pc := baseline.pc + 1 } + id baselineNext baselineCredit) : + ∃ rewrittenNext rewrittenCredit, + CreditTake { rewritten with pc := rewritten.pc + 1 } + id rewrittenNext rewrittenCredit ∧ + StableCreditIso locRel (some baselineCredit) + (some rewrittenCredit) ∧ + StableFrameIso rewrite locRel baselineNext rewrittenNext := by + obtain ⟨baselineNextEq, baselineFound⟩ := taken.target_eq + have baselineLookup : CreditLookup baseline id baselineCredit := + CreditLookup.of_getElem baselineFound + obtain ⟨rewrittenCredit, rewrittenLookup, creditRelated⟩ := + frame.creditLookup baselineLookup + let rewrittenNext : Frame := + { rewritten with + pc := rewritten.pc + 1 + credits := rewritten.credits.setIfInBounds id none } + have rewrittenTaken : CreditTake + { rewritten with pc := rewritten.pc + 1 } + id rewrittenNext rewrittenCredit := by + exact CreditTake.of_lookup (rewrittenLookup.congrDefinition + rewritten.definition) + refine ⟨rewrittenNext, rewrittenCredit, rewrittenTaken, creditRelated, ?_⟩ + subst baselineNext + exact ⟨frame.baselineDefinition, frame.rewrittenDefinition, frame.block, + congrArg (fun pc => pc + 1) frame.pc, frame.values, + frame.credits.array_set_none id⟩ + +/-- Consuming a constructor appends corresponding field vectors and credits +while advancing otherwise-related frames. -/ +theorem StableFrameIso.advanceAppendCreditIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {locRel : Nat → Nat → Prop} {baseline rewritten : Frame} + (frame : StableFrameIso rewrite locRel baseline rewritten) + {baselineFields rewrittenFields : Array RVal} + (fields : IxIR1.Sim.RValsIso locRel + baselineFields.toList rewrittenFields.toList) + {baselineCredit rewrittenCredit : Credit} + (credit : StableCreditIso locRel (some baselineCredit) + (some rewrittenCredit)) : + StableFrameIso rewrite locRel + { baseline with + pc := baseline.pc + 1 + values := baseline.values ++ baselineFields + credits := baseline.credits.push (some baselineCredit) } + { rewritten with + pc := rewritten.pc + 1 + values := rewritten.values ++ rewrittenFields + credits := rewritten.credits.push (some rewrittenCredit) } := by + refine ⟨frame.baselineDefinition, frame.rewrittenDefinition, + frame.block, congrArg (fun pc => pc + 1) frame.pc, ?_, ?_⟩ + · simpa using rvalsIso_append_pair frame.values fields + · simpa using frame.credits.append (.cons credit .nil) + +/-- Consuming a constructor appends its common field vector and a common +credit while advancing otherwise-related exact-location frames. -/ +theorem StableFrameIso.advanceAppendCredit {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {baseline rewritten : Frame} + (frame : StableFrameIso rewrite (fun left right => left = right) + baseline rewritten) + (fields : Array RVal) (credit : Credit) : + StableFrameIso rewrite (fun left right => left = right) + { baseline with + pc := baseline.pc + 1 + values := baseline.values ++ fields + credits := baseline.credits.push (some credit) } + { rewritten with + pc := rewritten.pc + 1 + values := rewritten.values ++ fields + credits := rewritten.credits.push (some credit) } := by + refine ⟨frame.baselineDefinition, frame.rewrittenDefinition, + frame.block, congrArg (fun pc => pc + 1) frame.pc, ?_, ?_⟩ + · simpa using rvalsIso_append_refl frame.values fields.toList + · simpa using frame.credits.append + (.cons (StableCreditIso.refl (some credit)) .nil) + +/-- Under identity location transport, related frame value files are +literally equal. -/ +theorem StableFrameIso.values_eq {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {baseline rewritten : Frame} + (frame : StableFrameIso rewrite (fun left right => left = right) + baseline rewritten) : + baseline.values = rewritten.values := by + apply Array.toList_inj.mp + exact frame.values.eq_of_location_eq + +/-- Under identity location transport, related credit files are literally +equal. -/ +theorem StableFrameIso.credits_eq {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {baseline rewritten : Frame} + (frame : StableFrameIso rewrite (fun left right => left = right) + baseline rewritten) : + baseline.credits = rewritten.credits := by + apply Array.toList_inj.mp + exact frame.credits.eq_of_location_eq + +theorem StableFrameIso.rewritten_eq {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {baseline rewritten : Frame} + (frame : StableFrameIso rewrite (fun left right => left = right) + baseline rewritten) : + rewritten = { baseline with definition := rewrite.definition } := by + have definitionEq := frame.rewrittenDefinition + have blockEq := frame.block + have pcEq := frame.pc + have valuesEq := frame.values_eq + have creditsEq := frame.credits_eq + cases baseline with + | mk baselineDefinition baselineBlock baselinePc baselineValues + baselineCredits => + cases rewritten with + | mk rewrittenDefinition rewrittenBlock rewrittenPc rewrittenValues + rewrittenCredits => + simp only at definitionEq blockEq pcEq valuesEq creditsEq ⊢ + rw [definitionEq, ← blockEq, ← pcEq, ← valuesEq, + ← creditsEq] + +/-- Consuming one credit after advancing control is definition-insensitive. +The rewritten frame consumes the same slot and lands in the canonical frame +obtained by replacing only the source definition. -/ +theorem StableFrameIso.advanceTake {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {baseline rewritten baselineNext : Frame} + (frame : StableFrameIso rewrite (fun left right => left = right) + baseline rewritten) + {id : CreditId} {credit : Credit} + (taken : CreditTake { baseline with pc := baseline.pc + 1 } + id baselineNext credit) : + CreditTake { rewritten with pc := rewritten.pc + 1 } + id { baselineNext with definition := rewrite.definition } credit ∧ + StableFrameIso rewrite (fun left right => left = right) + baselineNext { baselineNext with definition := rewrite.definition } := by + have rewrittenTaken := taken.congrDefinition rewrite.definition + have startEq : + ({ rewritten with pc := rewritten.pc + 1 } : Frame) = + { { baseline with pc := baseline.pc + 1 } with + definition := rewrite.definition } := by + rw [frame.rewritten_eq] + rw [startEq] + refine ⟨rewrittenTaken, ?_⟩ + obtain ⟨nextEq, _⟩ := taken.target_eq + subst baselineNext + exact ⟨frame.baselineDefinition, rfl, rfl, rfl, + IxIR1.Sim.RValsIso.refl baseline.values.toList, + StableCreditsIso.refl _⟩ + +/-- A checked edge transfer is equivariant under related value registers and +credit files. The target-block ABI theorem supplies the only rewrite-specific +fact needed at the destination. -/ +theorem StableFrameIso.edgeTransferIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {locRel : Nat → Nat → Prop} {baseline rewritten baselineTarget : Frame} + (frame : StableFrameIso rewrite locRel baseline rewritten) + {edge : Edge} + {baselineImplicit rewrittenImplicit : Array RVal} + (implicitValues : IxIR1.Sim.RValsIso locRel + baselineImplicit.toList rewrittenImplicit.toList) + (transferred : EdgeTransfer baseline edge baselineImplicit + baselineTarget) : + ∃ rewrittenTarget, + EdgeTransfer rewritten edge rewrittenImplicit rewrittenTarget ∧ + StableFrameIso rewrite locRel baselineTarget rewrittenTarget := by + obtain ⟨baselineValues, baselineCredits, baselineAfter, sourceBlock, + baselineResolved, baselineTaken, baselineCleared, sourceBlockAt, + baselineValueArity, baselineCreditArity, baselineTargetEq⟩ := + transferred.parts + obtain ⟨rewrittenValues, rewrittenResolved, valuesRelated⟩ := + resolveAtoms_iso frame.values baselineResolved + obtain ⟨rewrittenAfter, rewrittenCredits, rewrittenTaken, + creditsRelated, afterRelated⟩ := frame.takeManyIso baselineTaken + have rewrittenCleared : NoLiveCredits rewrittenAfter := + afterRelated.noLiveCredits baselineCleared + have sourceBlockAt' : source.blocks[edge.target]? = some sourceBlock := by + rw [← afterRelated.baselineDefinition] + exact sourceBlockAt + obtain ⟨rewrittenBlock, rewrittenBlockAt, valueParams, creditParams⟩ := + rewrite.targetBlockAbi sourceBlockAt' + have rewrittenBlockAt' : + rewrittenAfter.definition.blocks[edge.target]? = + some rewrittenBlock := by + rw [afterRelated.rewrittenDefinition] + exact rewrittenBlockAt + have allValuesRelated : IxIR1.Sim.RValsIso locRel + (baselineImplicit ++ baselineValues).toList + (rewrittenImplicit ++ rewrittenValues).toList := by + simpa using rvalsIso_append_pair implicitValues valuesRelated + have valueSizes : (baselineImplicit ++ baselineValues).size = + (rewrittenImplicit ++ rewrittenValues).size := by + simpa using rvalsIso_length_eq allValuesRelated + have rewrittenValueArity : + (rewrittenImplicit ++ rewrittenValues).size = + rewrittenBlock.valueParams.size := + valueSizes.symm.trans <| baselineValueArity.trans <| + (congrArg Array.size valueParams).symm + have creditSizes : baselineCredits.size = rewrittenCredits.size := by + simpa using creditsRelated.length_eq + have rewrittenCreditArity : rewrittenCredits.size = + rewrittenBlock.creditParams.size := + creditSizes.symm.trans <| baselineCreditArity.trans <| + (congrArg Array.size creditParams).symm + let rewrittenTarget : Frame := + { rewrittenAfter with + block := edge.target + pc := 0 + values := rewrittenImplicit ++ rewrittenValues + credits := rewrittenCredits.map some } + have rewrittenTransferred : EdgeTransfer rewritten edge rewrittenImplicit + rewrittenTarget := by + exact EdgeTransfer.of_parts rewrittenResolved rewrittenTaken + rewrittenCleared rewrittenBlockAt' rewrittenValueArity + rewrittenCreditArity + refine ⟨rewrittenTarget, rewrittenTransferred, ?_⟩ + subst baselineTarget + exact ⟨afterRelated.baselineDefinition, afterRelated.rewrittenDefinition, + rfl, rfl, allValuesRelated, creditsRelated⟩ + +/-- A checked edge out of a stable source frame executes in the rewritten +definition at the same block ID. `FunctionRewrite.targetBlockAbi` supplies +exactly the target-block compatibility required by `EdgeTransfer`. -/ +theorem StableFrameIso.edgeTransfer {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + {rewrite : Reuse.FunctionRewrite limits validation source} + {baseline rewritten baselineTarget : Frame} + (frame : StableFrameIso rewrite (fun left right => left = right) + baseline rewritten) + {edge : Edge} {implicitValues : Array RVal} + (transferred : EdgeTransfer baseline edge implicitValues baselineTarget) : + EdgeTransfer rewritten edge implicitValues + { baselineTarget with definition := rewrite.definition } ∧ + StableFrameIso rewrite (fun left right => left = right) + baselineTarget + { baselineTarget with definition := rewrite.definition } := by + obtain ⟨sourceTargetBlock, sourceTargetAt⟩ := transferred.targetBlock + have sourceTargetAt' : source.blocks[edge.target]? = + some sourceTargetBlock := by + rw [← frame.baselineDefinition] + exact sourceTargetAt + obtain ⟨rewrittenTargetBlock, rewrittenTargetAt, valueParams, + creditParams⟩ := rewrite.targetBlockAbi sourceTargetAt' + have rewrittenTransfer := transferred.congrDefinition sourceTargetAt + rewrittenTargetAt valueParams creditParams + rw [← frame.rewritten_eq] at rewrittenTransfer + have baselineTargetDefinition : baselineTarget.definition = source := + transferred.definition.trans frame.baselineDefinition + refine ⟨rewrittenTransfer, ?_⟩ + exact ⟨baselineTargetDefinition, rfl, rfl, rfl, + IxIR1.Sim.RValsIso.refl baselineTarget.values.toList, + StableCreditsIso.refl baselineTarget.credits.toList⟩ + +theorem StableFrameRel.entry {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {locRel : Nat → Nat → Prop} + {baselineValues rewrittenValues : Array RVal} + (values : IxIR1.Sim.RValsIso locRel + baselineValues.toList rewrittenValues.toList) : + StableFrameRel limits validation locRel + { definition := source, values := baselineValues } + { definition := rewrite.definition, values := rewrittenValues } := + .rewritten rewrite (StableFrameIso.entry rewrite values) + +theorem StableFrameRel.push {limits : Validate.Limits} + {validation : Validate.Context} {locRel : Nat → Nat → Prop} + {baseline rewritten : Frame} + (frame : StableFrameRel limits validation locRel baseline rewritten) + {baselineValue rewrittenValue : RVal} + (value : IxIR1.Sim.RValIso locRel baselineValue rewrittenValue) : + StableFrameRel limits validation locRel + { baseline with values := baseline.values.push baselineValue } + { rewritten with values := rewritten.values.push rewrittenValue } := by + cases frame with + | rewritten rewrite related => + exact .rewritten rewrite (related.push value) + +/-- Related recursive arguments and an already-related continuation stack +form the stable control state reached by every accepted-site theorem. -/ +theorem StableControlIso.recursiveCall {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {locRel : Nat → Nat → Prop} + {baselineValues rewrittenValues : Array RVal} + {baselineStack rewrittenStack : List Continuation} + (values : IxIR1.Sim.RValsIso locRel + baselineValues.toList rewrittenValues.toList) + (stack : StableStackIso limits validation locRel + baselineStack rewrittenStack) : + StableControlIso limits validation locRel + (.running { definition := source, values := baselineValues } + baselineStack) + (.running { definition := rewrite.definition, values := rewrittenValues } + rewrittenStack) := + .running (StableFrameRel.entry rewrite values) stack + +/-- Exact-content recursive-call states inhabit the uniform machine relation +with identity location transport. -/ +theorem StableMachineRel.contentsRecursiveCall {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineValues rewrittenValues : Array RVal} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (values : IxIR1.Sim.RValsIso (fun left right => left = right) + baselineValues.toList rewrittenValues.toList) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) : + StableMachineRel limits validation + { store := baselineStore + heapFuel := baselineFuel + control := .running + { definition := source, values := baselineValues } baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition, values := rewrittenValues } + rewrittenStack } := + .related (fun left right => left = right) (.contents heap) fuel + (StableControlIso.recursiveCall rewrite values stack) + +/-- Physical recursive-call states inhabit the same relation using the +target-to-baseline heap bijection produced by reuse soundness. -/ +theorem StableMachineRel.isomorphicRecursiveCall + {limits : Validate.Limits} {validation : Validate.Context} + {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineValues rewrittenValues : Array RVal} + {baselineStack rewrittenStack : List Continuation} + (iso : IxIR1.Sim.HeapIso rewrittenStore.heap baselineStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (values : IxIR1.Sim.RValsIso + (fun baselineLocation rewrittenLocation => + iso.locRel rewrittenLocation baselineLocation) + baselineValues.toList rewrittenValues.toList) + (stack : StableStackIso limits validation + (fun baselineLocation rewrittenLocation => + iso.locRel rewrittenLocation baselineLocation) + baselineStack rewrittenStack) : + StableMachineRel limits validation + { store := baselineStore + heapFuel := baselineFuel + control := .running + { definition := source, values := baselineValues } baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition, values := rewrittenValues } + rewrittenStack } := + .related + (fun baselineLocation rewrittenLocation => + iso.locRel rewrittenLocation baselineLocation) + (.isomorphic (heapIsoToHistory iso)) + fuel + (StableControlIso.recursiveCall rewrite values stack) + +theorem StableContinuationIso.applyMoreOrResume + {limits : Validate.Limits} {validation : Validate.Context} + {baseline rewritten : Frame} + (arguments : Array RVal) + (frame : StableFrameRel limits validation (fun left right => left = right) + baseline rewritten) : + StableContinuationIso limits validation (fun left right => left = right) + (if arguments.isEmpty then .resume baseline + else .applyMore arguments baseline) + (if arguments.isEmpty then .resume rewritten + else .applyMore arguments rewritten) := by + by_cases empty : arguments.isEmpty + · simp only [empty] + exact .resume frame + · simp only [empty] + exact .applyMore (IxIR1.Sim.RValsIso.refl arguments.toList) frame + +theorem StableContinuationIso.applyMoreOrResumeIso + {limits : Validate.Limits} {validation : Validate.Context} + {locRel : Nat → Nat → Prop} + {baselineArguments rewrittenArguments : Array RVal} + {baseline rewritten : Frame} + (arguments : IxIR1.Sim.RValsIso locRel + baselineArguments.toList rewrittenArguments.toList) + (frame : StableFrameRel limits validation locRel baseline rewritten) : + StableContinuationIso limits validation locRel + (if baselineArguments.isEmpty then .resume baseline + else .applyMore baselineArguments baseline) + (if rewrittenArguments.isEmpty then .resume rewritten + else .applyMore rewrittenArguments rewritten) := by + have sizes : baselineArguments.size = rewrittenArguments.size := by + simpa using rvalsIso_length_eq arguments + have emptyEq : baselineArguments.isEmpty = rewrittenArguments.isEmpty := by + simp [Array.isEmpty, sizes] + by_cases empty : baselineArguments.isEmpty + · have rewrittenEmpty : rewrittenArguments.isEmpty := by + simpa [emptyEq] using empty + simp only [empty, rewrittenEmpty] + exact .resume frame + · have rewrittenNonempty : ¬rewrittenArguments.isEmpty := by + simpa [emptyEq] using empty + simp only [empty, rewrittenNonempty] + exact .applyMore arguments frame + +/-! ## Accepted macros from exact-content states -/ + +/-- The logical hot accepted macro is compositional over exact semantic heap +contents and heap-fuel dominance. In particular, source and target stores +may already differ in every observational counter; only their live node array +must agree. -/ +theorem acceptedHotLogicalStableSimulation {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {index helperOffset : Nat} {block : Block} + {site : Reuse.Site limits validation block} + (found : Reuse.FunctionDecisions.At rewrite.decisions index helperOffset + block (.accepted site)) + {baselineContext rewrittenContext : Eval.Context} + (baselineSchemas : baselineContext.schemas = validation.schemas) + (rewrittenSchemas : rewrittenContext.schemas = validation.schemas) + {baselineStore rewrittenStore baselineRetained baselineReleased : Store} + (heap : HeapContentsEq baselineStore rewrittenStore) + {parameters fields newFields callValues : Array RVal} + {location fieldFuel remaining rewrittenFuel : Nat} + {baselineStack rewrittenStack : List Continuation} + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {ambient : List IxIR1.Sim.Root} {allocationSchema : CtorSchema} + (fuel : fieldFuel + 1 ≤ rewrittenFuel) + (allocationSchemaAt : + baselineContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (sourceResolved : resolveAtom parameters (.reg site.shape.source) = + .ok (.loc location)) + (sourceBoxAt : baselineStore.get? location = some + ⟨.shared, 1, .ctorN site.shape.sourceConstructor fields⟩) + (owned : IxIR1.Sim.RootOwnership baselineStore.heap + (⟨.shared, .loc location⟩ :: ambient)) + (retained : RetainSharedMany baselineStore fields baselineRetained) + (released : releaseShared (fieldFuel + 1) baselineRetained + (.loc location) = .ok (baselineReleased, remaining)) + (allocationResolved : resolveAtoms + (baselinePrefixValues parameters fields) + site.shape.allocationArguments = .ok newFields) + (baselineFieldWorlds : + FieldWorlds baselineReleased allocationSchema newFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc (baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields)).2)) + site.shape.tailArguments = .ok callValues) + (arity : callValues.size = source.signature.params.size) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := parameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := index + values := parameters + credits := #[] } + rewrittenStack } + let baselineAllocation := baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + let rewrittenAllocation := + (logicalHotResetStore rewrittenStore location).allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + let baselineTarget : Machine := + { store := baselineAllocation.1 + heapFuel := remaining + control := .running + { definition := source, values := callValues } baselineStack } + let rewrittenTarget : Machine := + { store := rewrittenAllocation.1 + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition, values := callValues } + rewrittenStack } + Steps baselineContext .logical (2 * site.shape.fieldCount + 3) + baselineMachine baselineTarget ∧ + Steps rewrittenContext .logical 4 rewrittenMachine rewrittenTarget ∧ + StableMachineRel limits validation baselineTarget rewrittenTarget := by + dsimp only + obtain ⟨sourceAt, resetAt, hotAt, _coldAt⟩ := rewrite.acceptedAt found + obtain ⟨sourceSchema, siteAllocationSchema, sourceSchemaAt, + siteAllocationSchemaAt, _sourceFields, _allocationFields, + sourceLayout, allocationLayout⟩ := + evalRuntimeSchemas site baselineSchemas + have allocationSchemaEq : siteAllocationSchema = allocationSchema := by + exact Option.some.inj (siteAllocationSchemaAt.symm.trans allocationSchemaAt) + subst siteAllocationSchema + have rewrittenSourceSchemaAt : + rewrittenContext.schemas .shared site.shape.sourceConstructor = + some sourceSchema := by + simpa [baselineSchemas, rewrittenSchemas] using sourceSchemaAt + have rewrittenAllocationSchemaAt : + rewrittenContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema := by + simpa [baselineSchemas, rewrittenSchemas] using allocationSchemaAt + have rewrittenBoxAt : rewrittenStore.get? location = some + ⟨.shared, 1, .ctorN site.shape.sourceConstructor fields⟩ := by + rw [← heap.get?_eq location] + exact sourceBoxAt + have baselineResetContents : HeapContentsEq baselineReleased + (logicalHotResetStore baselineStore location) := + hotPrefix_contents sourceBoxAt owned retained released + have resetCongruence : HeapContentsEq + (logicalHotResetStore baselineStore location) + (logicalHotResetStore rewrittenStore location) := by + simpa [logicalHotResetStore] using + (((heap.tickResetAttempt).kill location).tickHotReset) + have resetContents : HeapContentsEq baselineReleased + (logicalHotResetStore rewrittenStore location) := + baselineResetContents.trans resetCongruence + let baselineAllocation := baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + let rewrittenAllocation := + (logicalHotResetStore rewrittenStore location).allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + have allocationContents : HeapContentsEq baselineAllocation.1 + rewrittenAllocation.1 := by + simpa [baselineAllocation, rewrittenAllocation] using + resetContents.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + have allocationLocation : baselineAllocation.2 = + rewrittenAllocation.2 := by + simpa [baselineAllocation, rewrittenAllocation] using + resetContents.allocNode_location .shared + (.ctorN site.shape.allocationConstructor newFields) + have rewrittenFieldWorlds : FieldWorlds + (logicalHotResetStore rewrittenStore location) + allocationSchema newFields := + resetContents.fieldWorlds baselineFieldWorlds + have rewrittenTailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc rewrittenAllocation.2)) + site.shape.tailArguments = .ok callValues := by + rw [← allocationLocation] + simpa [baselineAllocation] using tailResolved + have sourceNonempty : source.blocks.isEmpty = false := + blocks_nonempty_of_getElem sourceAt + have rewrittenNonempty : rewrite.definition.blocks.isEmpty = false := + blocks_nonempty_of_getElem resetAt + have rewrittenArity : callValues.size = + rewrite.definition.signature.params.size := by + simpa using arity + let baselineMachine : Machine := + { store := baselineStore + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := parameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := index + values := parameters + credits := #[] } + rewrittenStack } + have baselineExecution : Steps baselineContext .logical + (2 * site.shape.fieldCount + 3) baselineMachine + { store := baselineAllocation.1 + heapFuel := remaining + control := .running + { definition := source, values := callValues } baselineStack } := by + simpa [baselineMachine, baselineAllocation] using + baselineAcceptedControl site + (context := baselineContext) (interpretation := .logical) + (definition := source) (blockId := index) + (parameters := parameters) (fields := fields) + (newFields := newFields) (callValues := callValues) + (location := location) (machine := baselineMachine) + (retainedStore := baselineRetained) + (releasedStore := baselineReleased) (remaining := remaining) + (allocationSchema := allocationSchema) (stack := baselineStack) + sourceAt (by rfl) parameterCount fieldCount sourceResolved sourceBoxAt + rfl retained released allocationSchemaAt allocationResolved + baselineFieldWorlds tailResolved arity sourceNonempty + have rewrittenExecution : Steps rewrittenContext .logical 4 + rewrittenMachine + { store := rewrittenAllocation.1 + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition, values := callValues } + rewrittenStack } := by + simpa [rewrittenMachine, rewrittenAllocation, logicalHotResetStore] using + hotLogicalAcceptedControl site + (context := rewrittenContext) (definition := rewrite.definition) + (resetId := index) (hotId := source.blocks.size + helperOffset) + (coldId := source.blocks.size + helperOffset + 1) + (parameters := parameters) (fields := fields) + (newFields := newFields) (callValues := callValues) + (location := location) + (box := ⟨.shared, 1, + .ctorN site.shape.sourceConstructor fields⟩) + (sourceSchema := sourceSchema) (allocationSchema := allocationSchema) + (machine := rewrittenMachine) (stack := rewrittenStack) + resetAt hotAt rewrittenSourceSchemaAt rewrittenAllocationSchemaAt + sourceLayout allocationLayout (by rfl) parameterCount fieldCount + sourceResolved (ConstructorView.of_box rewrittenBoxAt rfl rfl) rfl + allocationResolved + (by simpa [logicalHotResetStore] using rewrittenFieldWorlds) + (by simpa [rewrittenAllocation, logicalHotResetStore] using + rewrittenTailResolved) + rewrittenArity rewrittenNonempty + have outputFuel : remaining ≤ rewrittenFuel := + Nat.le_trans (releaseShared_remaining_le released) fuel + exact ⟨by simpa [baselineMachine, baselineAllocation] using baselineExecution, + by simpa [rewrittenMachine, rewrittenAllocation] using rewrittenExecution, + StableMachineRel.contentsRecursiveCall rewrite allocationContents outputFuel + (IxIR1.Sim.RValsIso.refl callValues.toList) stack⟩ + +/-- The cold accepted macro is likewise compositional over exact semantic +contents. The baseline retain batch is transported to the rewritten store; +the two parent decrements then agree in contents while the rewritten reset +adds only observational counters. -/ +theorem acceptedColdStableSimulation {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {index helperOffset : Nat} {block : Block} + {site : Reuse.Site limits validation block} + (found : Reuse.FunctionDecisions.At rewrite.decisions index helperOffset + block (.accepted site)) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + (baselineSchemas : baselineContext.schemas = validation.schemas) + (rewrittenSchemas : rewrittenContext.schemas = validation.schemas) + {baselineStore rewrittenStore baselineRetained : Store} + (heap : HeapContentsEq baselineStore rewrittenStore) + {parameters fields newFields callValues : Array RVal} + {location fieldFuel rewrittenFuel rc retainedRc : Nat} + {baselineStack rewrittenStack : List Continuation} + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {allocationSchema : CtorSchema} + (fuel : fieldFuel + 1 ≤ rewrittenFuel) + (allocationSchemaAt : + baselineContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (sourceResolved : resolveAtom parameters (.reg site.shape.source) = + .ok (.loc location)) + (sourceBoxAt : baselineStore.get? location = some + ⟨.shared, rc, .ctorN site.shape.sourceConstructor fields⟩) + (shared : 1 < rc) + (retained : RetainSharedMany baselineStore fields baselineRetained) + (retainedAt : baselineRetained.get? location = some + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩) + (allocationResolved : resolveAtoms + (baselinePrefixValues parameters fields) + site.shape.allocationArguments = .ok newFields) + (baselineFieldWorlds : FieldWorlds + (baselineDecrementStore baselineRetained location + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩) + allocationSchema newFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc ((baselineDecrementStore baselineRetained location + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩).allocNode .shared + (.ctorN site.shape.allocationConstructor newFields)).2)) + site.shape.tailArguments = .ok callValues) + (arity : callValues.size = source.signature.params.size) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := parameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := index + values := parameters + credits := #[] } + rewrittenStack } + let baselineReleased := baselineDecrementStore baselineRetained location + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩ + let baselineAllocation := baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + ∃ rewrittenRetained, + let rewrittenReleased := baselineDecrementStore rewrittenRetained location + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩ + let rewrittenReset := rewrittenReleased.tickResetAttempt.tickColdReset + let rewrittenAllocation := rewrittenReset.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + let baselineTarget : Machine := + { store := baselineAllocation.1 + heapFuel := fieldFuel + control := .running + { definition := source, values := callValues } baselineStack } + let rewrittenTarget : Machine := + { store := rewrittenAllocation.1 + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition, values := callValues } + rewrittenStack } + RetainSharedMany rewrittenStore fields rewrittenRetained ∧ + Steps baselineContext interpretation + (2 * site.shape.fieldCount + 3) baselineMachine baselineTarget ∧ + Steps rewrittenContext interpretation 4 rewrittenMachine + rewrittenTarget ∧ + StableMachineRel limits validation baselineTarget rewrittenTarget := by + dsimp only + obtain ⟨sourceAt, resetAt, _hotAt, coldAt⟩ := rewrite.acceptedAt found + obtain ⟨sourceSchema, siteAllocationSchema, sourceSchemaAt, + siteAllocationSchemaAt, _sourceFields, _allocationFields, + sourceLayout, allocationLayout⟩ := + evalRuntimeSchemas site baselineSchemas + have allocationSchemaEq : siteAllocationSchema = allocationSchema := by + exact Option.some.inj (siteAllocationSchemaAt.symm.trans allocationSchemaAt) + subst siteAllocationSchema + have rewrittenSourceSchemaAt : + rewrittenContext.schemas .shared site.shape.sourceConstructor = + some sourceSchema := by + simpa [baselineSchemas, rewrittenSchemas] using sourceSchemaAt + have rewrittenAllocationSchemaAt : + rewrittenContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema := by + simpa [baselineSchemas, rewrittenSchemas] using allocationSchemaAt + have rewrittenBoxAt : rewrittenStore.get? location = some + ⟨.shared, rc, .ctorN site.shape.sourceConstructor fields⟩ := by + rw [← heap.get?_eq location] + exact sourceBoxAt + obtain ⟨rewrittenRetained, rewrittenRetainedRun, retainedContents⟩ := + heap.retainSharedMany retained + have rewrittenRetainedAt : rewrittenRetained.get? location = some + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩ := by + rw [← retainedContents.get?_eq location] + exact retainedAt + obtain ⟨actualRetainedRc, actualRetainedAt, baselineReleasedRun, + _baselineResetRetained, _baselineHeapEq⟩ := + coldPrefix_commutes (heapFuel := fieldFuel) sourceBoxAt shared retained + have actualBoxEq : + (⟨.shared, actualRetainedRc, + .ctorN site.shape.sourceConstructor fields⟩ : IxIR1.NodeBox) = + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩ := + Option.some.inj (actualRetainedAt.symm.trans retainedAt) + have actualRcEq : actualRetainedRc = retainedRc := by + cases actualBoxEq + rfl + subst actualRetainedRc + obtain ⟨rewrittenActualRc, rewrittenActualAt, _rewrittenReleasedRun, + rewrittenResetRetained, _rewrittenHeapEq⟩ := + coldPrefix_commutes (heapFuel := fieldFuel) rewrittenBoxAt shared + rewrittenRetainedRun + have rewrittenBoxEq : + (⟨.shared, rewrittenActualRc, + .ctorN site.shape.sourceConstructor fields⟩ : IxIR1.NodeBox) = + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩ := + Option.some.inj (rewrittenActualAt.symm.trans rewrittenRetainedAt) + have rewrittenRcEq : rewrittenActualRc = retainedRc := by + cases rewrittenBoxEq + rfl + subst rewrittenActualRc + let baselineReleased := baselineDecrementStore baselineRetained location + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩ + let rewrittenReleased := baselineDecrementStore rewrittenRetained location + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩ + let rewrittenReset := rewrittenReleased.tickResetAttempt.tickColdReset + have releasedContents : HeapContentsEq baselineReleased + rewrittenReleased := by + simpa [baselineReleased, rewrittenReleased, baselineDecrementStore] using + (retainedContents.rcTick.setBox location + { (⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩ : IxIR1.NodeBox) with + rc := retainedRc - 1 }) + have resetContents : HeapContentsEq baselineReleased rewrittenReset := by + apply releasedContents.trans + exact ⟨rfl⟩ + let baselineAllocation := baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + let rewrittenAllocation := rewrittenReset.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + have allocationContents : HeapContentsEq baselineAllocation.1 + rewrittenAllocation.1 := by + simpa [baselineAllocation, rewrittenAllocation] using + resetContents.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields) + have allocationLocation : baselineAllocation.2 = + rewrittenAllocation.2 := by + simpa [baselineAllocation, rewrittenAllocation] using + resetContents.allocNode_location .shared + (.ctorN site.shape.allocationConstructor newFields) + have rewrittenFieldWorlds : + FieldWorlds rewrittenReset allocationSchema newFields := + resetContents.fieldWorlds baselineFieldWorlds + have rewrittenTailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc rewrittenAllocation.2)) + site.shape.tailArguments = .ok callValues := by + rw [← allocationLocation] + simpa [baselineReleased, baselineAllocation] using tailResolved + have sourceNonempty : source.blocks.isEmpty = false := + blocks_nonempty_of_getElem sourceAt + have rewrittenNonempty : rewrite.definition.blocks.isEmpty = false := + blocks_nonempty_of_getElem resetAt + have rewrittenArity : callValues.size = + rewrite.definition.signature.params.size := by + simpa using arity + let baselineMachine : Machine := + { store := baselineStore + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := parameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := index + values := parameters + credits := #[] } + rewrittenStack } + have baselineExecution : Steps baselineContext interpretation + (2 * site.shape.fieldCount + 3) baselineMachine + { store := baselineAllocation.1 + heapFuel := fieldFuel + control := .running + { definition := source, values := callValues } baselineStack } := by + simpa [baselineMachine, baselineReleased, baselineAllocation] using + baselineAcceptedControl site + (context := baselineContext) (interpretation := interpretation) + (definition := source) (blockId := index) + (parameters := parameters) (fields := fields) + (newFields := newFields) (callValues := callValues) + (location := location) (machine := baselineMachine) + (retainedStore := baselineRetained) + (releasedStore := baselineReleased) (remaining := fieldFuel) + (allocationSchema := allocationSchema) (stack := baselineStack) + sourceAt (by rfl) parameterCount fieldCount sourceResolved sourceBoxAt + rfl retained (by simpa [baselineReleased] using baselineReleasedRun) + allocationSchemaAt allocationResolved + (by simpa [baselineReleased] using baselineFieldWorlds) + (by simpa [baselineReleased, baselineAllocation] using tailResolved) + arity sourceNonempty + have rewrittenExecution : Steps rewrittenContext interpretation 4 + rewrittenMachine + { store := rewrittenAllocation.1 + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition, values := callValues } + rewrittenStack } := by + simpa [rewrittenMachine, rewrittenReset, rewrittenReleased, + rewrittenAllocation] using + coldAcceptedControl site + (context := rewrittenContext) (interpretation := interpretation) + (definition := rewrite.definition) (resetId := index) + (hotId := source.blocks.size + helperOffset) + (coldId := source.blocks.size + helperOffset + 1) + (parameters := parameters) (fields := fields) + (newFields := newFields) (callValues := callValues) + (location := location) + (box := ⟨.shared, rc, + .ctorN site.shape.sourceConstructor fields⟩) + (sourceSchema := sourceSchema) (allocationSchema := allocationSchema) + (machine := rewrittenMachine) (resetStore := rewrittenReset) + (stack := rewrittenStack) resetAt coldAt rewrittenSourceSchemaAt + rewrittenAllocationSchemaAt sourceLayout allocationLayout (by rfl) + parameterCount fieldCount sourceResolved + (ConstructorView.of_box rewrittenBoxAt rfl rfl) shared + (by simpa [rewrittenMachine, coldResetStartStore, rewrittenReset, + rewrittenReleased] using + rewrittenResetRetained) + allocationResolved + (by simpa [rewrittenReset] using rewrittenFieldWorlds) + (by simpa [rewrittenAllocation] using rewrittenTailResolved) + rewrittenArity rewrittenNonempty + have outputFuel : fieldFuel ≤ rewrittenFuel := by omega + refine ⟨rewrittenRetained, rewrittenRetainedRun, ?_, ?_, ?_⟩ + · simpa [baselineMachine, baselineReleased, baselineAllocation] using + baselineExecution + · simpa [rewrittenMachine, rewrittenReleased, rewrittenReset, + rewrittenAllocation] using rewrittenExecution + · exact StableMachineRel.contentsRecursiveCall rewrite allocationContents + outputFuel (IxIR1.Sim.RValsIso.refl callValues.toList) stack + +/-! ## Accepted physical macro from an isomorphic state -/ + +/-- A physical hot accepted block composes with an existing live-location +bijection. Baseline and rewritten register files, constructor fields, and +continuations may already use different locations. The consumed source pair +is replaced by the reused-target/fresh-baseline pair, all surviving pairs are +preserved, and both executions rejoin at a stable recursive-call state. -/ +theorem acceptedHotPhysicalStableSimulationIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {index helperOffset : Nat} {block : Block} + {site : Reuse.Site limits validation block} + (found : Reuse.FunctionDecisions.At rewrite.decisions index helperOffset + block (.accepted site)) + {baselineContext rewrittenContext : Eval.Context} + (baselineSchemas : baselineContext.schemas = validation.schemas) + (rewrittenSchemas : rewrittenContext.schemas = validation.schemas) + {baselineStore rewrittenStore baselineRetained baselineReleased : Store} + (inputIso : IxIR1.Sim.HeapIso rewrittenStore.heap baselineStore.heap) + {baselineParameters rewrittenParameters baselineFields rewrittenFields + baselineNewFields rewrittenNewFields baselineCallValues : Array RVal} + {baselineLocation rewrittenLocation fieldFuel remaining rewrittenFuel : + Nat} + {baselineStack rewrittenStack : List Continuation} + (parameters : IxIR1.Sim.RValsIso + (fun baselineLocation rewrittenLocation => + inputIso.locRel rewrittenLocation baselineLocation) + baselineParameters.toList rewrittenParameters.toList) + (stack : StableStackIso limits validation + (fun baselineLocation rewrittenLocation => + inputIso.locRel rewrittenLocation baselineLocation) + baselineStack rewrittenStack) + (stackAvoids : StackValuesAvoidLocation rewrittenLocation rewrittenStack) + (stackCreditsAvoids : + StackCreditsAvoidLocation rewrittenLocation rewrittenStack) + {baselineBefore baselineAfter rewrittenBefore rewrittenAfter : + List IxIR1.Sim.Root} + {allocationSchema : CtorSchema} + (fuel : fieldFuel + 1 ≤ rewrittenFuel) + (locations : inputIso.locRel rewrittenLocation baselineLocation) + (allocationSchemaAt : + baselineContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (parameterCount : baselineParameters.size = site.shape.parameterCount) + (fieldCount : baselineFields.size = site.shape.fieldCount) + (baselineSourceResolved : + resolveAtom baselineParameters (.reg site.shape.source) = + .ok (.loc baselineLocation)) + (rewrittenSourceResolved : + resolveAtom rewrittenParameters (.reg site.shape.source) = + .ok (.loc rewrittenLocation)) + (baselineAt : baselineStore.get? baselineLocation = some + ⟨.shared, 1, + .ctorN site.shape.sourceConstructor baselineFields⟩) + (rewrittenAt : rewrittenStore.get? rewrittenLocation = some + ⟨.shared, 1, + .ctorN site.shape.sourceConstructor rewrittenFields⟩) + (baselineOwned : IxIR1.Sim.RootOwnership baselineStore.heap + (⟨.shared, .loc baselineLocation⟩ :: baselineBefore)) + (rewrittenOwned : IxIR1.Sim.RootOwnership rewrittenStore.heap + (⟨.shared, .loc rewrittenLocation⟩ :: rewrittenBefore)) + (retained : RetainSharedMany baselineStore baselineFields + baselineRetained) + (released : releaseShared (fieldFuel + 1) baselineRetained + (.loc baselineLocation) = .ok (baselineReleased, remaining)) + (baselinePartition : + (IxIR1.Sim.rootsFor .shared baselineFields.toList ++ + baselineBefore).Perm + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ + baselineAfter)) + (rewrittenPartition : + (IxIR1.Sim.rootsFor .shared rewrittenFields.toList ++ + rewrittenBefore).Perm + (IxIR1.Sim.rootsFor .shared rewrittenNewFields.toList ++ + rewrittenAfter)) + (mapped : MappedValuesInRoots site.shape + (baselinePrefixValues rewrittenParameters rewrittenFields) + (IxIR1.Sim.rootsFor .shared rewrittenNewFields.toList ++ + rewrittenAfter)) + (baselineAllocationResolved : resolveAtoms + (baselinePrefixValues baselineParameters baselineFields) + site.shape.allocationArguments = .ok baselineNewFields) + (rewrittenAllocationResolved : resolveAtoms + (baselinePrefixValues rewrittenParameters rewrittenFields) + site.shape.allocationArguments = .ok rewrittenNewFields) + (baselineFieldWorlds : + FieldWorlds baselineReleased allocationSchema baselineNewFields) + (rewrittenFieldWorlds : FieldWorlds + (physicalHotResetStore rewrittenStore rewrittenLocation) + allocationSchema rewrittenNewFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues baselineParameters baselineFields).push + (.loc (baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor baselineNewFields)).2)) + site.shape.tailArguments = .ok baselineCallValues) + (arity : baselineCallValues.size = source.signature.params.size) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := baselineParameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := index + values := rewrittenParameters + credits := #[] } + rewrittenStack } + let baselineAllocation := baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor baselineNewFields) + ∃ physical : Store, + ∃ outputIso : IxIR1.Sim.HeapIso physical.heap + baselineAllocation.1.heap, + ∃ physicalCallValues : Array RVal, + physicalHotReuseStore rewrittenStore rewrittenLocation + (.ctorN site.shape.allocationConstructor rewrittenNewFields) + allocationSchema.fields.size = .ok physical ∧ + IxIR1.Sim.RootOwnership physical.heap + (⟨.shared, .loc rewrittenLocation⟩ :: rewrittenAfter) ∧ + IxIR1.Sim.RootOwnership baselineAllocation.1.heap + (⟨.shared, .loc baselineAllocation.2⟩ :: baselineAfter) ∧ + outputIso.locRel rewrittenLocation baselineAllocation.2 ∧ + (∀ {rewrittenCandidate baselineCandidate : Nat}, + inputIso.locRel rewrittenCandidate baselineCandidate → + rewrittenCandidate ≠ rewrittenLocation → + outputIso.locRel rewrittenCandidate baselineCandidate) ∧ + Steps baselineContext .physical (2 * site.shape.fieldCount + 3) + baselineMachine + { store := baselineAllocation.1 + heapFuel := remaining + control := .running + { definition := source, values := baselineCallValues } + baselineStack } ∧ + Steps rewrittenContext .physical 4 rewrittenMachine + { store := physical + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition, values := physicalCallValues } + rewrittenStack } ∧ + IxIR1.Sim.RValsIso + (fun baselineCandidate rewrittenCandidate => + outputIso.locRel rewrittenCandidate baselineCandidate) + baselineCallValues.toList physicalCallValues.toList ∧ + StableStackIso limits validation + (fun baselineCandidate rewrittenCandidate => + outputIso.locRel rewrittenCandidate baselineCandidate) + baselineStack rewrittenStack ∧ + StableMachineRel limits validation + { store := baselineAllocation.1 + heapFuel := remaining + control := .running + { definition := source, values := baselineCallValues } + baselineStack } + { store := physical + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition, values := physicalCallValues } + rewrittenStack } := by + dsimp only + obtain ⟨sourceAt, resetAt, hotAt, _coldAt⟩ := rewrite.acceptedAt found + obtain ⟨sourceSchema, siteAllocationSchema, sourceSchemaAt, + siteAllocationSchemaAt, sourceSchemaFields, allocationSchemaFields, + sourceLayout, allocationLayout⟩ := + evalRuntimeSchemas site baselineSchemas + have allocationSchemaEq : siteAllocationSchema = allocationSchema := by + exact Option.some.inj (siteAllocationSchemaAt.symm.trans allocationSchemaAt) + subst siteAllocationSchema + have rewrittenSourceSchemaAt : + rewrittenContext.schemas .shared site.shape.sourceConstructor = + some sourceSchema := by + simpa [baselineSchemas, rewrittenSchemas] using sourceSchemaAt + have rewrittenAllocationSchemaAt : + rewrittenContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema := by + simpa [baselineSchemas, rewrittenSchemas] using allocationSchemaAt + have uniformAllocationFields : allocationSchema.fields = + Array.replicate site.shape.fieldCount .shared := + allocationSchemaFields.trans sourceSchemaFields + have parameterSizes : baselineParameters.size = rewrittenParameters.size := by + simpa using rvalsIso_length_eq parameters + have rewrittenParameterCount : rewrittenParameters.size = + site.shape.parameterCount := parameterSizes.symm.trans parameterCount + obtain ⟨leftBox, rightBox, leftLive, rightLive, boxesRelated⟩ := + inputIso.related_live locations + have leftBoxEq : leftBox = + ⟨.shared, 1, + .ctorN site.shape.sourceConstructor rewrittenFields⟩ := + Option.some.inj (leftLive.symm.trans rewrittenAt) + have rightBoxEq : rightBox = + ⟨.shared, 1, + .ctorN site.shape.sourceConstructor baselineFields⟩ := + Option.some.inj (rightLive.symm.trans baselineAt) + subst leftBox + subst rightBox + have rewrittenToBaselineFields : IxIR1.Sim.RValsIso inputIso.locRel + rewrittenFields.toList baselineFields.toList := by + cases boxesRelated.node with + | ctor related => exact related + have fieldsRelated : IxIR1.Sim.RValsIso + (fun baselineLocation rewrittenLocation => + inputIso.locRel rewrittenLocation baselineLocation) + baselineFields.toList rewrittenFields.toList := + rvalsIso_symm rewrittenToBaselineFields + have fieldSizes : baselineFields.size = rewrittenFields.size := by + simpa using rvalsIso_length_eq fieldsRelated + have rewrittenFieldCount : rewrittenFields.size = site.shape.fieldCount := + fieldSizes.symm.trans fieldCount + have prefixRelated : IxIR1.Sim.RValsIso + (fun baselineLocation rewrittenLocation => + inputIso.locRel rewrittenLocation baselineLocation) + (baselinePrefixValues baselineParameters baselineFields).toList + (baselinePrefixValues rewrittenParameters rewrittenFields).toList := by + simpa [baselinePrefixValues] using + rvalsIso_append_pair + (rvalsIso_append_pair parameters fieldsRelated) fieldsRelated + obtain ⟨actualRewrittenNewFields, actualRewrittenResolved, + newFieldsRelated⟩ := + resolveAtoms_iso prefixRelated baselineAllocationResolved + have actualNewFieldsEq : actualRewrittenNewFields = rewrittenNewFields := + Except.ok.inj + (actualRewrittenResolved.symm.trans rewrittenAllocationResolved) + subst actualRewrittenNewFields + have prefixContents : HeapContentsEq baselineReleased + (logicalHotResetStore baselineStore baselineLocation) := + hotPrefix_contents baselineAt baselineOwned retained released + have baselineMissing : baselineReleased.get? baselineLocation = none := by + rw [prefixContents.get?_eq baselineLocation] + change (logicalHotResetStore baselineStore baselineLocation).heap.get? + baselineLocation = none + rw [logicalHotResetStore_heap] + exact IxIR1.Sim.get?_kill_same baselineAt + have baselineNewFieldsAvoid : ∀ value ∈ baselineNewFields.toList, + value ≠ .loc baselineLocation := + FieldWorlds.avoidsMissing uniformAllocationFields baselineFieldWorlds + baselineMissing + have rewrittenNewFieldsAvoid : ∀ value ∈ rewrittenNewFields.toList, + value ≠ .loc rewrittenLocation := + rvalsIso_right_avoids_of_left inputIso locations newFieldsRelated + baselineNewFieldsAvoid + have restrictedNewFields : IxIR1.Sim.RValsIso + (fun rewrittenCandidate baselineCandidate => + inputIso.locRel rewrittenCandidate baselineCandidate ∧ + rewrittenCandidate ≠ rewrittenLocation) + rewrittenNewFields.toList baselineNewFields.toList := + rvalsIso_restrict_left (rvalsIso_symm newFieldsRelated) + rewrittenNewFieldsAvoid + let baselineAllocation := baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor baselineNewFields) + obtain ⟨physical, reused, outputIso, physicalOwned, + baselineAllocationOwned, outputResult, outputExtends⟩ := + hotPrefixReuse_sound_under_iso + (baselineStore := baselineStore) (rewrittenStore := rewrittenStore) + (baselineRetained := baselineRetained) + (baselineReleased := baselineReleased) + (baselineLocation := baselineLocation) + (rewrittenLocation := rewrittenLocation) + (oldCid := site.shape.sourceConstructor) + (newCid := site.shape.allocationConstructor) + (baselineFields := baselineFields) (rewrittenFields := rewrittenFields) + (baselineNewFields := baselineNewFields) + (rewrittenNewFields := rewrittenNewFields) (fieldFuel := fieldFuel) + (remaining := remaining) (baselineBefore := baselineBefore) + (baselineAfter := baselineAfter) (rewrittenBefore := rewrittenBefore) + (rewrittenAfter := rewrittenAfter) allocationSchema.fields.size inputIso + locations baselineAt rewrittenAt baselineOwned rewrittenOwned retained + released baselinePartition rewrittenPartition restrictedNewFields + obtain ⟨physicalAgain, reusedAgain, physicalHeap⟩ := + physicalHotReuseStore_ok + (.ctorN site.shape.allocationConstructor rewrittenNewFields) + allocationSchema.fields.size rewrittenAt + have physicalEq : physicalAgain = physical := + Except.ok.inj (reusedAgain.symm.trans reused) + subst physicalAgain + have physicalAt : physical.get? rewrittenLocation = some + ⟨.shared, 1, + .ctorN site.shape.allocationConstructor rewrittenNewFields⟩ := by + change physical.heap.get? rewrittenLocation = _ + rw [physicalHeap] + exact IxIR1.Sim.get?_reuseSharedNodeStore_same rewrittenAt + let outputRel : Nat → Nat → Prop := + fun baselineCandidate rewrittenCandidate => + outputIso.locRel rewrittenCandidate baselineCandidate + have translatedPrefix : TranslatedValuesIso site.shape outputRel + (baselinePrefixValues baselineParameters baselineFields) + (helperEntryValues site.shape.source rewrittenParameters + rewrittenFields) := by + intro sourceId targetId baselineValue relevant translated baselineValueAt + obtain ⟨rewrittenValue, rewrittenValueAt, inputValueRelated⟩ := + rvalsIso_array_getElem? prefixRelated baselineValueAt + have helperValueAt := + valuesRel_helperEntry rewrittenParameterCount rewrittenFieldCount + site.fits.sourceBound sourceId targetId translated + rw [rewrittenValueAt] at helperValueAt + have supported := + mapped sourceId targetId rewrittenValue relevant translated + rewrittenValueAt + have rewrittenValueAvoid : rewrittenValue ≠ .loc rewrittenLocation := + by + cases rewrittenValue with + | loc location => + obtain ⟨world, member⟩ := supported + rcases List.mem_append.mp member with fieldMember | survivorMember + · rw [IxIR1.Sim.rootsFor, List.mem_map] at fieldMember + obtain ⟨field, fieldMem, rootEq⟩ := fieldMember + have fieldEq : field = .loc location := + congrArg IxIR1.Sim.Root.value rootEq + subst field + exact rewrittenNewFieldsAvoid _ fieldMem + · exact physicalOwned.sole_root_ne physicalAt survivorMember + | lit literal => intro impossible; cases impossible + | erased => intro impossible; cases impossible + have outputValueRelated : IxIR1.Sim.RValIso outputRel + baselineValue rewrittenValue := by + cases inputValueRelated with + | loc locationRelated => + apply IxIR1.Sim.RValIso.loc + apply outputExtends locationRelated + intro same + apply rewrittenValueAvoid + cases same + rfl + | lit => exact .lit + | erased => exact .erased + exact ⟨rewrittenValue, helperValueAt.symm, outputValueRelated⟩ + have baselinePrefixSize : + (baselinePrefixValues baselineParameters baselineFields).size = + site.shape.parameterCount + 2 * site.shape.fieldCount := by + simp [baselinePrefixValues, parameterCount, fieldCount, Nat.two_mul] + have rewrittenHelperSize : + (helperEntryValues site.shape.source rewrittenParameters + rewrittenFields).size = + site.shape.fieldCount + (site.shape.parameterCount - 1) := by + simp [helperEntryValues, List.length_eraseIdx, rewrittenParameterCount, + rewrittenFieldCount, site.fits.sourceBound] + have translatedAfterAllocation : TranslatedValuesIso site.shape outputRel + ((baselinePrefixValues baselineParameters baselineFields).push + (.loc baselineAllocation.2)) + ((helperEntryValues site.shape.source rewrittenParameters + rewrittenFields).push (.loc rewrittenLocation)) := + TranslatedValuesIso.pushResult translatedPrefix (.loc outputResult) + baselinePrefixSize rewrittenHelperSize site.fits.sourceBound + have sourceNonempty : source.blocks.isEmpty = false := + blocks_nonempty_of_getElem sourceAt + have rewrittenNonempty : rewrite.definition.blocks.isEmpty = false := + blocks_nonempty_of_getElem resetAt + have rewrittenArity : baselineCallValues.size = + rewrite.definition.signature.params.size := by + simpa using arity + let baselineMachine : Machine := + { store := baselineStore + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := baselineParameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := index + values := rewrittenParameters + credits := #[] } + rewrittenStack } + have baselineExecution : Steps baselineContext .physical + (2 * site.shape.fieldCount + 3) baselineMachine + { store := baselineAllocation.1 + heapFuel := remaining + control := .running + { definition := source, values := baselineCallValues } + baselineStack } := by + simpa [baselineMachine, baselineAllocation] using + baselineAcceptedControl site + (context := baselineContext) (interpretation := .physical) + (definition := source) (blockId := index) + (parameters := baselineParameters) (fields := baselineFields) + (newFields := baselineNewFields) (callValues := baselineCallValues) + (location := baselineLocation) (machine := baselineMachine) + (retainedStore := baselineRetained) + (releasedStore := baselineReleased) (remaining := remaining) + (allocationSchema := allocationSchema) (stack := baselineStack) + sourceAt (by rfl) parameterCount fieldCount baselineSourceResolved + baselineAt rfl retained released allocationSchemaAt + baselineAllocationResolved baselineFieldWorlds tailResolved arity + sourceNonempty + obtain ⟨physicalCallValues, rewrittenExecution, callsRelated⟩ := + hotPhysicalAcceptedControlTranslated site + (context := rewrittenContext) (definition := rewrite.definition) + (resetId := index) (hotId := source.blocks.size + helperOffset) + (coldId := source.blocks.size + helperOffset + 1) + (parameters := rewrittenParameters) (fields := rewrittenFields) + (newFields := rewrittenNewFields) + (baselineTailValues := + (baselinePrefixValues baselineParameters baselineFields).push + (.loc baselineAllocation.2)) + (baselineCallValues := baselineCallValues) + (location := rewrittenLocation) + (box := ⟨.shared, 1, + .ctorN site.shape.sourceConstructor rewrittenFields⟩) + (sourceSchema := sourceSchema) (allocationSchema := allocationSchema) + (machine := rewrittenMachine) (stack := rewrittenStack) + (store := physical) (locRel := outputRel) resetAt hotAt + rewrittenSourceSchemaAt rewrittenAllocationSchemaAt sourceLayout + allocationLayout (by rfl) rewrittenParameterCount rewrittenFieldCount + rewrittenSourceResolved + (ConstructorView.of_box rewrittenAt rfl rfl) rfl + rewrittenAllocationResolved + (by simpa [physicalHotResetStore] using rewrittenFieldWorlds) + (by simpa [physicalHotReuseStore, physicalHotResetStore] using reused) + translatedAfterAllocation + (by simpa [baselineAllocation] using tailResolved) rewrittenArity + rewrittenNonempty + have outputStack : StableStackIso limits validation outputRel + baselineStack rewrittenStack := + stack.transportRelation stackAvoids stackCreditsAvoids (by + intro baselineCandidate rewrittenCandidate related different + exact outputExtends related different) + have outputFuel : remaining ≤ rewrittenFuel := + Nat.le_trans (releaseShared_remaining_le released) fuel + have relatedMachine : StableMachineRel limits validation + { store := baselineAllocation.1 + heapFuel := remaining + control := .running + { definition := source, values := baselineCallValues } + baselineStack } + { store := physical + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition, values := physicalCallValues } + rewrittenStack } := + StableMachineRel.isomorphicRecursiveCall rewrite outputIso outputFuel + callsRelated outputStack + exact ⟨physical, outputIso, physicalCallValues, reused, physicalOwned, + by simpa [baselineAllocation] using baselineAllocationOwned, + by simpa [baselineAllocation] using outputResult, + outputExtends, + by simpa [baselineMachine, baselineAllocation] using baselineExecution, + by simpa [rewrittenMachine] using rewrittenExecution, + callsRelated, outputStack, relatedMachine⟩ + +/-! ## Allocation-history unchanged execution -/ + +/-- An unchanged `move` is equivariant under an arbitrary allocation-history +isomorphism. Unlike the exact-content theorem below, the target register may +contain a numerically different but related location. -/ +theorem unchangedMoveStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {atom : Atom} {baselineValue : RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = .move atom) + (resolved : resolveAtom baselineFrame.values atom = .ok baselineValue) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values.push baselineValue } + baselineStack } + ∃ rewrittenValue, + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values.push rewrittenValue } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + obtain ⟨rewrittenValue, targetResolved, valueRelated⟩ := + resolveAtom_iso frame.values resolved + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .move atom := by + simpa only [← frame.pc] using instruction + refine ⟨rewrittenValue, + Step.move rfl sourceAt pc instruction resolved, + Step.move rfl targetAt targetPc targetInstruction targetResolved, ?_⟩ + exact StableMachineRel.history heap fuel + (.running (.rewritten rewrite (frame.advancePush valueRelated)) stack) + +/-- Constructor projection follows corresponding locations and fields through +an allocation-history isomorphism. -/ +theorem unchangedFetchStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {atom : Atom} {cid : CtorId} {field : Nat} + {baselineLocation : Nat} {baselineBox : IxIR1.NodeBox} + {baselineFields : Array RVal} {baselineValue : RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .fetch atom cid field) + (resolved : resolveAtom baselineFrame.values atom = + .ok (.loc baselineLocation)) + (boxAt : baselineStore.get? baselineLocation = some baselineBox) + (node : baselineBox.node = .ctorN cid baselineFields) + (fieldAt : baselineFields[field]? = some baselineValue) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values.push baselineValue } + baselineStack } + ∃ rewrittenValue, + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values.push rewrittenValue } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + obtain ⟨rewrittenResolved, targetResolved, resolvedRelated⟩ := + resolveAtom_iso frame.values resolved + cases resolvedRelated with + | @loc _ rewrittenLocation locations => + obtain ⟨rewrittenBox, rewrittenAt, boxes⟩ := + heap.boxes locations (by + change baselineStore.heap.get? baselineLocation = some baselineBox + exact boxAt) + have nodes : IxIR1.Sim.NodeIso heap.locRel + (.ctorN cid baselineFields) rewrittenBox.node := by + simpa only [← node] using boxes.node + obtain ⟨rewrittenFields, rewrittenNode, fieldsRelated⟩ := + nodeIso_ctor_left nodes + obtain ⟨rewrittenValue, rewrittenFieldAt, valueRelated⟩ := + rvalsIso_array_getElem? fieldsRelated fieldAt + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .fetch atom cid field := by + simpa only [← frame.pc] using instruction + refine ⟨rewrittenValue, + Step.fetch rfl sourceAt pc instruction resolved boxAt node fieldAt, + Step.fetch rfl targetAt targetPc targetInstruction targetResolved + ?_ rewrittenNode rewrittenFieldAt, ?_⟩ + · change rewrittenStore.heap.get? rewrittenLocation = some rewrittenBox + exact rewrittenAt + · exact StableMachineRel.history heap fuel + (.running + (.rewritten rewrite (frame.advancePush valueRelated)) stack) + +/-- Shallow unique reclamation kills corresponding live locations while +retaining their pair as a dead/dead history row. This is the first unchanged +case that cannot be expressed compositionally with a live-only `HeapIso`. -/ +theorem unchangedFreeUniqueStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {atom : Atom} {cid : CtorId} + {baselineLocation : Nat} {baselineBox : IxIR1.NodeBox} + {baselineFields : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .freeUnique atom cid) + (resolved : resolveAtom baselineFrame.values atom = + .ok (.loc baselineLocation)) + (boxAt : baselineStore.get? baselineLocation = some baselineBox) + (unique : baselineBox.world = .unique) + (node : baselineBox.node = .ctorN cid baselineFields) + (scalarFields : baselineFields.all RVal.isScalar = true) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with + store := baselineStore.kill baselineLocation + control := .running + { baselineFrame with pc := baselineFrame.pc + 1 } + baselineStack } + ∃ rewrittenLocation, + let rewrittenNext : Machine := + { rewrittenMachine with + store := rewrittenStore.kill rewrittenLocation + control := .running + { rewrittenFrame with pc := rewrittenFrame.pc + 1 } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + obtain ⟨rewrittenResolved, targetResolved, resolvedRelated⟩ := + resolveAtom_iso frame.values resolved + cases resolvedRelated with + | @loc _ rewrittenLocation locations => + obtain ⟨rewrittenBox, rewrittenAt, boxes⟩ := + heap.boxes locations (by + change baselineStore.heap.get? baselineLocation = some baselineBox + exact boxAt) + have nodes : IxIR1.Sim.NodeIso heap.locRel + (.ctorN cid baselineFields) rewrittenBox.node := by + simpa only [← node] using boxes.node + obtain ⟨rewrittenFields, rewrittenNode, fieldsRelated⟩ := + nodeIso_ctor_left nodes + have fieldsEq : baselineFields = rewrittenFields := by + apply Array.toList_inj.mp + apply fieldsRelated.eq_of_allScalar + rw [Array.all_toList] + exact scalarFields + have rewrittenScalar : rewrittenFields.all RVal.isScalar = true := by + rw [← fieldsEq] + exact scalarFields + have rewrittenUnique : rewrittenBox.world = .unique := + boxes.world.symm.trans unique + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .freeUnique atom cid := by + simpa only [← frame.pc] using instruction + let outputHeap : IxIR1.Sim.HeapHistoryIso + (baselineStore.kill baselineLocation).heap + (rewrittenStore.kill rewrittenLocation).heap := + heap.kill locations (by + change baselineStore.heap.get? baselineLocation = some baselineBox + exact boxAt) rewrittenAt + refine ⟨rewrittenLocation, + Step.freeUnique rfl sourceAt pc instruction resolved boxAt unique node + scalarFields, + Step.freeUnique rfl targetAt targetPc targetInstruction targetResolved + ?_ rewrittenUnique rewrittenNode rewrittenScalar, ?_⟩ + · change rewrittenStore.heap.get? rewrittenLocation = some rewrittenBox + exact rewrittenAt + · have outputFrame : StableFrameIso rewrite outputHeap.locRel + { baselineFrame with pc := baselineFrame.pc + 1 } + { rewrittenFrame with pc := rewrittenFrame.pc + 1 } := by + change StableFrameIso rewrite heap.locRel _ _ + exact frame.advance + have outputStack : StableStackIso limits validation outputHeap.locRel + baselineStack rewrittenStack := by + change StableStackIso limits validation heap.locRel _ _ + exact stack + exact StableMachineRel.history outputHeap fuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- Fresh constructor allocation extends the history with the two fresh +locations and transports the schema check across related field vectors. -/ +theorem unchangedAllocStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + (schemas : baselineContext.schemas = rewrittenContext.schemas) + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {world : Owned} {cid : CtorId} + {arguments : Array Atom} {schema : CtorSchema} + {baselineValues : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .alloc world cid arguments) + (schemaAt : baselineContext.schemas world cid = some schema) + (resolved : resolveAtoms baselineFrame.values arguments = + .ok baselineValues) + (fieldWorlds : FieldWorlds baselineStore schema baselineValues) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineAllocation := + baselineStore.allocNode world (.ctorN cid baselineValues) + let baselineNext : Machine := + { store := baselineAllocation.1 + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values.push (.loc baselineAllocation.2) } + baselineStack } + ∃ rewrittenValues, + let rewrittenAllocation := + rewrittenStore.allocNode world (.ctorN cid rewrittenValues) + let rewrittenNext : Machine := + { store := rewrittenAllocation.1 + heapFuel := rewrittenFuel + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values.push + (.loc rewrittenAllocation.2) } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + obtain ⟨rewrittenValues, targetResolved, valuesRelated⟩ := + resolveAtoms_iso frame.values resolved + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .alloc world cid arguments := by + simpa only [← frame.pc] using instruction + have targetSchemaAt : rewrittenContext.schemas world cid = some schema := by + rw [← schemas] + exact schemaAt + have targetFieldWorlds : FieldWorlds rewrittenStore schema rewrittenValues := + fieldWorlds.transport (heapHistoryIso_fieldValuesWorldEq heap valuesRelated) + let baselineAllocation := + baselineStore.allocNode world (.ctorN cid baselineValues) + let rewrittenAllocation := + rewrittenStore.allocNode world (.ctorN cid rewrittenValues) + let outputHeap : IxIR1.Sim.HeapHistoryIso baselineAllocation.1.heap + rewrittenAllocation.1.heap := + heap.alloc (.ctor valuesRelated) + have oldExtends : ∀ {baselineLocation rewrittenLocation}, + heap.locRel baselineLocation rewrittenLocation → + outputHeap.locRel baselineLocation rewrittenLocation := by + intro baselineLocation rewrittenLocation related + exact .inr related + have resultRelated : IxIR1.Sim.RValIso outputHeap.locRel + (.loc baselineAllocation.2) (.loc rewrittenAllocation.2) := by + exact .loc (.inl ⟨rfl, rfl⟩) + have outputFrame := (frame.mono oldExtends).advancePush resultRelated + have outputStack := stack.mono oldExtends + refine ⟨rewrittenValues, + by simpa [baselineAllocation] using + (Step.alloc (context := baselineContext) + (interpretation := interpretation) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction schemaAt resolved fieldWorlds), + by simpa [rewrittenAllocation] using + (Step.alloc (context := rewrittenContext) + (interpretation := interpretation) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetSchemaAt targetResolved + targetFieldWorlds), ?_⟩ + exact StableMachineRel.history outputHeap fuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- An absent `allocWith` credit is consumed at corresponding frame slots; +both executions then make related fresh allocations. -/ +theorem unchangedAllocWithAbsentStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + (schemas : baselineContext.schemas = rewrittenContext.schemas) + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTaken : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {creditId : CreditId} {credit : Credit} + {world : Owned} {cid : CtorId} {arguments : Array Atom} + {schema : CtorSchema} {baselineValues : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .allocWith creditId world cid arguments) + (schemaAt : baselineContext.schemas world cid = some schema) + (resolved : resolveAtoms baselineFrame.values arguments = + .ok baselineValues) + (fieldWorlds : FieldWorlds baselineStore schema baselineValues) + (taken : CreditTake { baselineFrame with + pc := baselineFrame.pc + 1 } creditId baselineTaken credit) + (layout : credit.layout = schema.layout) + (absent : credit.presence = .absent) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineAllocation := + baselineStore.allocNode world (.ctorN cid baselineValues) + let baselineNext : Machine := + { store := baselineAllocation.1 + heapFuel := baselineFuel + control := .running + { baselineTaken with + values := baselineTaken.values.push (.loc baselineAllocation.2) } + baselineStack } + ∃ (rewrittenValues : Array RVal) (rewrittenTaken : Frame), + let rewrittenAllocation := + rewrittenStore.allocNode world (.ctorN cid rewrittenValues) + let rewrittenNext : Machine := + { store := rewrittenAllocation.1 + heapFuel := rewrittenFuel + control := .running + { rewrittenTaken with + values := rewrittenTaken.values.push + (.loc rewrittenAllocation.2) } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + obtain ⟨rewrittenValues, targetResolved, valuesRelated⟩ := + resolveAtoms_iso frame.values resolved + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .allocWith creditId world cid arguments := by + simpa only [← frame.pc] using instruction + have targetSchemaAt : rewrittenContext.schemas world cid = some schema := by + rw [← schemas] + exact schemaAt + have targetFieldWorlds : FieldWorlds rewrittenStore schema rewrittenValues := + fieldWorlds.transport (heapHistoryIso_fieldValuesWorldEq heap valuesRelated) + obtain ⟨rewrittenTaken, rewrittenCredit, targetTaken, creditRelated, + takenFrame⟩ := frame.advanceTakeIso taken + obtain ⟨layoutRelated, targetAbsent⟩ := + creditRelated.absent_parts absent + have targetLayout : rewrittenCredit.layout = schema.layout := + layoutRelated.symm.trans layout + let baselineAllocation := + baselineStore.allocNode world (.ctorN cid baselineValues) + let rewrittenAllocation := + rewrittenStore.allocNode world (.ctorN cid rewrittenValues) + let outputHeap : IxIR1.Sim.HeapHistoryIso baselineAllocation.1.heap + rewrittenAllocation.1.heap := + heap.alloc (.ctor valuesRelated) + have oldExtends : ∀ {baselineLocation rewrittenLocation}, + heap.locRel baselineLocation rewrittenLocation → + outputHeap.locRel baselineLocation rewrittenLocation := by + intro baselineLocation rewrittenLocation related + exact .inr related + have resultRelated : IxIR1.Sim.RValIso outputHeap.locRel + (.loc baselineAllocation.2) (.loc rewrittenAllocation.2) := + .loc (.inl ⟨rfl, rfl⟩) + have outputFrame := (takenFrame.mono oldExtends).push resultRelated + have outputStack := stack.mono oldExtends + refine ⟨rewrittenValues, rewrittenTaken, + by simpa [baselineAllocation] using + (Step.allocWithAbsent (context := baselineContext) + (interpretation := interpretation) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction schemaAt resolved fieldWorlds taken layout + absent), + by simpa [rewrittenAllocation] using + (Step.allocWithAbsent (context := rewrittenContext) + (interpretation := interpretation) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetSchemaAt targetResolved + targetFieldWorlds targetTaken targetLayout targetAbsent), ?_⟩ + exact StableMachineRel.history outputHeap fuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- A logical `allocWith` credit is consumed at corresponding frame slots; +both executions then make related fresh allocations. -/ +theorem unchangedAllocWithLogicalStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + (schemas : baselineContext.schemas = rewrittenContext.schemas) + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTaken : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {creditId : CreditId} {credit : Credit} + {world : Owned} {cid : CtorId} {arguments : Array Atom} + {schema : CtorSchema} {baselineValues : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .allocWith creditId world cid arguments) + (schemaAt : baselineContext.schemas world cid = some schema) + (resolved : resolveAtoms baselineFrame.values arguments = + .ok baselineValues) + (fieldWorlds : FieldWorlds baselineStore schema baselineValues) + (taken : CreditTake { baselineFrame with + pc := baselineFrame.pc + 1 } creditId baselineTaken credit) + (layout : credit.layout = schema.layout) + (present : credit.presence = .present none) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineAllocation := + baselineStore.allocNode world (.ctorN cid baselineValues) + let baselineNext : Machine := + { store := baselineAllocation.1 + heapFuel := baselineFuel + control := .running + { baselineTaken with + values := baselineTaken.values.push (.loc baselineAllocation.2) } + baselineStack } + ∃ (rewrittenValues : Array RVal) (rewrittenTaken : Frame), + let rewrittenAllocation := + rewrittenStore.allocNode world (.ctorN cid rewrittenValues) + let rewrittenNext : Machine := + { store := rewrittenAllocation.1 + heapFuel := rewrittenFuel + control := .running + { rewrittenTaken with + values := rewrittenTaken.values.push + (.loc rewrittenAllocation.2) } + rewrittenStack } + Step baselineContext .logical baselineMachine baselineNext ∧ + Step rewrittenContext .logical rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + obtain ⟨rewrittenValues, targetResolved, valuesRelated⟩ := + resolveAtoms_iso frame.values resolved + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .allocWith creditId world cid arguments := by + simpa only [← frame.pc] using instruction + have targetSchemaAt : rewrittenContext.schemas world cid = some schema := by + rw [← schemas] + exact schemaAt + have targetFieldWorlds : FieldWorlds rewrittenStore schema rewrittenValues := + fieldWorlds.transport (heapHistoryIso_fieldValuesWorldEq heap valuesRelated) + obtain ⟨rewrittenTaken, rewrittenCredit, targetTaken, creditRelated, + takenFrame⟩ := frame.advanceTakeIso taken + obtain ⟨layoutRelated, targetPresent⟩ := + creditRelated.logical_parts present + have targetLayout : rewrittenCredit.layout = schema.layout := + layoutRelated.symm.trans layout + let baselineAllocation := + baselineStore.allocNode world (.ctorN cid baselineValues) + let rewrittenAllocation := + rewrittenStore.allocNode world (.ctorN cid rewrittenValues) + let outputHeap : IxIR1.Sim.HeapHistoryIso baselineAllocation.1.heap + rewrittenAllocation.1.heap := + heap.alloc (.ctor valuesRelated) + have oldExtends : ∀ {baselineLocation rewrittenLocation}, + heap.locRel baselineLocation rewrittenLocation → + outputHeap.locRel baselineLocation rewrittenLocation := by + intro baselineLocation rewrittenLocation related + exact .inr related + have resultRelated : IxIR1.Sim.RValIso outputHeap.locRel + (.loc baselineAllocation.2) (.loc rewrittenAllocation.2) := + .loc (.inl ⟨rfl, rfl⟩) + have outputFrame := (takenFrame.mono oldExtends).push resultRelated + have outputStack := stack.mono oldExtends + refine ⟨rewrittenValues, rewrittenTaken, + by simpa [baselineAllocation] using + (Step.allocWithLogical (context := baselineContext) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction schemaAt resolved fieldWorlds taken layout + present), + by simpa [rewrittenAllocation] using + (Step.allocWithLogical (context := rewrittenContext) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetSchemaAt targetResolved + targetFieldWorlds targetTaken targetLayout targetPresent), ?_⟩ + exact StableMachineRel.history outputHeap fuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- Physical `allocWith` consumes corresponding (possibly differently +numbered) reservations and revives their history row with related nodes. -/ +theorem unchangedAllocWithPhysicalStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + (schemas : baselineContext.schemas = rewrittenContext.schemas) + {baselineStore rewrittenStore baselineOut : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTaken : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {creditId : CreditId} {credit : Credit} + {world : Owned} {cid : CtorId} {arguments : Array Atom} + {schema : CtorSchema} {baselineValues : Array RVal} + {baselineLocation : Nat} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .allocWith creditId world cid arguments) + (schemaAt : baselineContext.schemas world cid = some schema) + (resolved : resolveAtoms baselineFrame.values arguments = + .ok baselineValues) + (fieldWorlds : FieldWorlds baselineStore schema baselineValues) + (taken : CreditTake { baselineFrame with + pc := baselineFrame.pc + 1 } creditId baselineTaken credit) + (layout : credit.layout = schema.layout) + (present : credit.presence = .present (some baselineLocation)) + (reused : baselineStore.reuseReservation baselineLocation world + (.ctorN cid baselineValues) schema.fields.size = .ok baselineOut) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { store := baselineOut + heapFuel := baselineFuel + control := .running + { baselineTaken with + values := baselineTaken.values.push (.loc baselineLocation) } + baselineStack } + ∃ (rewrittenValues : Array RVal) (rewrittenTaken : Frame) + (rewrittenLocation : Nat) (rewrittenOut : Store), + let rewrittenNext : Machine := + { store := rewrittenOut + heapFuel := rewrittenFuel + control := .running + { rewrittenTaken with + values := rewrittenTaken.values.push (.loc rewrittenLocation) } + rewrittenStack } + rewrittenStore.reuseReservation rewrittenLocation world + (.ctorN cid rewrittenValues) schema.fields.size = .ok rewrittenOut ∧ + Step baselineContext .physical baselineMachine baselineNext ∧ + Step rewrittenContext .physical rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + obtain ⟨rewrittenValues, targetResolved, valuesRelated⟩ := + resolveAtoms_iso frame.values resolved + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .allocWith creditId world cid arguments := by + simpa only [← frame.pc] using instruction + have targetSchemaAt : rewrittenContext.schemas world cid = some schema := by + rw [← schemas] + exact schemaAt + have targetFieldWorlds : FieldWorlds rewrittenStore schema rewrittenValues := + fieldWorlds.transport (heapHistoryIso_fieldValuesWorldEq heap valuesRelated) + obtain ⟨rewrittenTaken, rewrittenCredit, targetTaken, creditRelated, + takenFrame⟩ := frame.advanceTakeIso taken + obtain ⟨rewrittenLocation, layoutRelated, targetPresent, locations⟩ := + creditRelated.physical_parts present + have targetLayout : rewrittenCredit.layout = schema.layout := + layoutRelated.symm.trans layout + obtain ⟨rewrittenOut, outputHeap, targetReused, outputRelation⟩ := + reuseReservation_historyIso heap locations (.ctor valuesRelated) reused + have outputFrame : StableFrameIso rewrite outputHeap.locRel + { baselineTaken with + values := baselineTaken.values.push (.loc baselineLocation) } + { rewrittenTaken with + values := rewrittenTaken.values.push (.loc rewrittenLocation) } := by + rw [outputRelation] + exact takenFrame.push (.loc locations) + have outputStack : StableStackIso limits validation outputHeap.locRel + baselineStack rewrittenStack := by + rw [outputRelation] + exact stack + refine ⟨rewrittenValues, rewrittenTaken, rewrittenLocation, rewrittenOut, + targetReused, + Step.allocWithPhysical + (context := baselineContext) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction schemaAt resolved fieldWorlds taken layout + present reused, + Step.allocWithPhysical + (context := rewrittenContext) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetSchemaAt targetResolved + targetFieldWorlds targetTaken targetLayout targetPresent targetReused, + ?_⟩ + exact StableMachineRel.history outputHeap fuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- Discarding related absent credits consumes corresponding frame slots and +leaves the allocation history unchanged. -/ +theorem unchangedDiscardCreditAbsentStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTaken : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {creditId : CreditId} {credit : Credit} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .discardCredit creditId) + (taken : CreditTake { baselineFrame with + pc := baselineFrame.pc + 1 } creditId baselineTaken credit) + (absent : credit.presence = .absent) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineTaken baselineStack } + ∃ rewrittenTaken : Frame, + let rewrittenNext : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenTaken rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .discardCredit creditId := by + simpa only [← frame.pc] using instruction + obtain ⟨rewrittenTaken, rewrittenCredit, targetTaken, creditRelated, + takenFrame⟩ := frame.advanceTakeIso taken + obtain ⟨_, targetAbsent⟩ := creditRelated.absent_parts absent + refine ⟨rewrittenTaken, + Step.discardCreditAbsent + (context := baselineContext) (interpretation := interpretation) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction taken absent, + Step.discardCreditAbsent + (context := rewrittenContext) (interpretation := interpretation) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetTaken targetAbsent, ?_⟩ + exact StableMachineRel.history heap fuel + (.running (.rewritten rewrite takenFrame) stack) + +/-- Discarding related logical credits consumes corresponding frame slots and +leaves the allocation history unchanged. -/ +theorem unchangedDiscardCreditLogicalStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTaken : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {creditId : CreditId} {credit : Credit} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .discardCredit creditId) + (taken : CreditTake { baselineFrame with + pc := baselineFrame.pc + 1 } creditId baselineTaken credit) + (present : credit.presence = .present none) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineTaken baselineStack } + ∃ rewrittenTaken : Frame, + let rewrittenNext : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenTaken rewrittenStack } + Step baselineContext .logical baselineMachine baselineNext ∧ + Step rewrittenContext .logical rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .discardCredit creditId := by + simpa only [← frame.pc] using instruction + obtain ⟨rewrittenTaken, rewrittenCredit, targetTaken, creditRelated, + takenFrame⟩ := frame.advanceTakeIso taken + obtain ⟨_, targetPresent⟩ := creditRelated.logical_parts present + refine ⟨rewrittenTaken, + Step.discardCreditLogical + (context := baselineContext) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction taken present, + Step.discardCreditLogical + (context := rewrittenContext) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetTaken targetPresent, ?_⟩ + exact StableMachineRel.history heap fuel + (.running (.rewritten rewrite takenFrame) stack) + +/-- Discarding related physical credits releases corresponding reserved +slots, which may have different concrete addresses. -/ +theorem unchangedDiscardCreditPhysicalStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {baselineStore rewrittenStore baselineOut : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTaken : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {creditId : CreditId} {credit : Credit} + {baselineLocation : Nat} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .discardCredit creditId) + (taken : CreditTake { baselineFrame with + pc := baselineFrame.pc + 1 } creditId baselineTaken credit) + (present : credit.presence = .present (some baselineLocation)) + (released : baselineStore.releaseReservation baselineLocation = + .ok baselineOut) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { store := baselineOut + heapFuel := baselineFuel + control := .running baselineTaken baselineStack } + ∃ (rewrittenTaken : Frame) (rewrittenLocation : Nat) + (rewrittenOut : Store), + let rewrittenNext : Machine := + { store := rewrittenOut + heapFuel := rewrittenFuel + control := .running rewrittenTaken rewrittenStack } + rewrittenStore.releaseReservation rewrittenLocation = .ok rewrittenOut ∧ + Step baselineContext .physical baselineMachine baselineNext ∧ + Step rewrittenContext .physical rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .discardCredit creditId := by + simpa only [← frame.pc] using instruction + obtain ⟨rewrittenTaken, rewrittenCredit, targetTaken, creditRelated, + takenFrame⟩ := frame.advanceTakeIso taken + obtain ⟨rewrittenLocation, _, targetPresent, locations⟩ := + creditRelated.physical_parts present + obtain ⟨rewrittenOut, outputHeap, targetReleased, outputRelation⟩ := + releaseReservation_historyIso heap locations released + have outputFrame : StableFrameIso rewrite outputHeap.locRel + baselineTaken rewrittenTaken := by + rw [outputRelation] + exact takenFrame + have outputStack : StableStackIso limits validation outputHeap.locRel + baselineStack rewrittenStack := by + rw [outputRelation] + exact stack + refine ⟨rewrittenTaken, rewrittenLocation, rewrittenOut, targetReleased, + Step.discardCreditPhysical + (context := baselineContext) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction taken present released, + Step.discardCreditPhysical + (context := rewrittenContext) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetTaken targetPresent + targetReleased, ?_⟩ + exact StableMachineRel.history outputHeap fuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- Logical unique extraction follows a related constructor, kills both +locations, and appends related fields plus matching logical credits. -/ +theorem unchangedTakeUniqueLogicalStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + (schemas : baselineContext.schemas = rewrittenContext.schemas) + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {target : Atom} {cid : CtorId} + {schema : CtorSchema} {baselineLocation : Nat} + {baselineBox : IxIR1.NodeBox} {baselineFields : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .takeUnique target cid) + (schemaAt : baselineContext.schemas .unique cid = some schema) + (resolved : resolveAtom baselineFrame.values target = + .ok (.loc baselineLocation)) + (viewed : ConstructorView baselineStore baselineLocation .unique cid + baselineBox baselineFields) + (unitRC : baselineBox.rc = 1) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let credit : Credit := + { layout := schema.layout, presence := .present none } + let baselineNext : Machine := + { store := baselineStore.kill baselineLocation + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values ++ baselineFields + credits := baselineFrame.credits.push (some credit) } + baselineStack } + ∃ (rewrittenLocation : Nat) (rewrittenFields : Array RVal), + let rewrittenNext : Machine := + { store := rewrittenStore.kill rewrittenLocation + heapFuel := rewrittenFuel + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values ++ rewrittenFields + credits := rewrittenFrame.credits.push (some credit) } + rewrittenStack } + Step baselineContext .logical baselineMachine baselineNext ∧ + Step rewrittenContext .logical rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + obtain ⟨rewrittenResolved, targetResolved, resolvedRelated⟩ := + resolveAtom_iso frame.values resolved + cases resolvedRelated with + | @loc _ rewrittenLocation locations => + obtain ⟨baselineAt, baselineWorld, baselineNode⟩ := viewed.parts + obtain ⟨rewrittenBox, rewrittenAt, boxes⟩ := + heap.boxes locations (by + change baselineStore.heap.get? baselineLocation = some baselineBox + exact baselineAt) + have nodes : IxIR1.Sim.NodeIso heap.locRel + (.ctorN cid baselineFields) rewrittenBox.node := by + simpa only [← baselineNode] using boxes.node + obtain ⟨rewrittenFields, rewrittenNode, fieldsRelated⟩ := + nodeIso_ctor_left nodes + have rewrittenWorld : rewrittenBox.world = .unique := + boxes.world.symm.trans baselineWorld + have rewrittenRc : rewrittenBox.rc = 1 := + boxes.rc.symm.trans unitRC + have targetViewed : ConstructorView rewrittenStore rewrittenLocation + .unique cid rewrittenBox rewrittenFields := by + apply ConstructorView.of_box + · change rewrittenStore.heap.get? rewrittenLocation = some rewrittenBox + exact rewrittenAt + · exact rewrittenWorld + · exact rewrittenNode + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .takeUnique target cid := by + simpa only [← frame.pc] using instruction + have targetSchemaAt : rewrittenContext.schemas .unique cid = + some schema := by + rw [← schemas] + exact schemaAt + let outputHeap := heap.kill locations (by + change baselineStore.heap.get? baselineLocation = some baselineBox + exact baselineAt) rewrittenAt + have outputFrame : StableFrameIso rewrite outputHeap.locRel + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values ++ baselineFields + credits := baselineFrame.credits.push + (some { layout := schema.layout, presence := .present none }) } + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values ++ rewrittenFields + credits := rewrittenFrame.credits.push + (some { layout := schema.layout, presence := .present none }) } := by + change StableFrameIso rewrite heap.locRel _ _ + exact frame.advanceAppendCreditIso fieldsRelated + (.logical schema.layout) + have outputStack : StableStackIso limits validation outputHeap.locRel + baselineStack rewrittenStack := by + change StableStackIso limits validation heap.locRel _ _ + exact stack + refine ⟨rewrittenLocation, rewrittenFields, + Step.takeUniqueLogical + (context := baselineContext) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction schemaAt resolved viewed unitRC, + Step.takeUniqueLogical + (context := rewrittenContext) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetSchemaAt targetResolved + targetViewed rewrittenRc, ?_⟩ + exact StableMachineRel.history outputHeap fuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- Physical unique extraction reserves corresponding constructor slots and +records location-related physical credits. -/ +theorem unchangedTakeUniquePhysicalStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + (schemas : baselineContext.schemas = rewrittenContext.schemas) + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {target : Atom} {cid : CtorId} + {schema : CtorSchema} {baselineLocation : Nat} + {baselineBox : IxIR1.NodeBox} {baselineFields : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .takeUnique target cid) + (schemaAt : baselineContext.schemas .unique cid = some schema) + (resolved : resolveAtom baselineFrame.values target = + .ok (.loc baselineLocation)) + (viewed : ConstructorView baselineStore baselineLocation .unique cid + baselineBox baselineFields) + (unitRC : baselineBox.rc = 1) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineCredit : Credit := + { layout := schema.layout, + presence := .present (some baselineLocation) } + let baselineNext : Machine := + { store := baselineStore.reserve baselineLocation + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values ++ baselineFields + credits := baselineFrame.credits.push (some baselineCredit) } + baselineStack } + ∃ (rewrittenLocation : Nat) (rewrittenFields : Array RVal), + let rewrittenCredit : Credit := + { layout := schema.layout, + presence := .present (some rewrittenLocation) } + let rewrittenNext : Machine := + { store := rewrittenStore.reserve rewrittenLocation + heapFuel := rewrittenFuel + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values ++ rewrittenFields + credits := rewrittenFrame.credits.push (some rewrittenCredit) } + rewrittenStack } + Step baselineContext .physical baselineMachine baselineNext ∧ + Step rewrittenContext .physical rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + obtain ⟨rewrittenResolved, targetResolved, resolvedRelated⟩ := + resolveAtom_iso frame.values resolved + cases resolvedRelated with + | @loc _ rewrittenLocation locations => + obtain ⟨baselineAt, baselineWorld, baselineNode⟩ := viewed.parts + obtain ⟨rewrittenBox, rewrittenAt, boxes⟩ := + heap.boxes locations (by + change baselineStore.heap.get? baselineLocation = some baselineBox + exact baselineAt) + have nodes : IxIR1.Sim.NodeIso heap.locRel + (.ctorN cid baselineFields) rewrittenBox.node := by + simpa only [← baselineNode] using boxes.node + obtain ⟨rewrittenFields, rewrittenNode, fieldsRelated⟩ := + nodeIso_ctor_left nodes + have rewrittenWorld : rewrittenBox.world = .unique := + boxes.world.symm.trans baselineWorld + have rewrittenRc : rewrittenBox.rc = 1 := + boxes.rc.symm.trans unitRC + have targetViewed : ConstructorView rewrittenStore rewrittenLocation + .unique cid rewrittenBox rewrittenFields := by + apply ConstructorView.of_box + · change rewrittenStore.heap.get? rewrittenLocation = some rewrittenBox + exact rewrittenAt + · exact rewrittenWorld + · exact rewrittenNode + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .takeUnique target cid := by + simpa only [← frame.pc] using instruction + have targetSchemaAt : rewrittenContext.schemas .unique cid = + some schema := by + rw [← schemas] + exact schemaAt + let outputHeap := reserve_historyIso heap locations (by + change baselineStore.heap.get? baselineLocation = some baselineBox + exact baselineAt) rewrittenAt + have outputFrame : StableFrameIso rewrite outputHeap.locRel + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values ++ baselineFields + credits := baselineFrame.credits.push + (some { layout := schema.layout, presence := + .present (some baselineLocation) }) } + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values ++ rewrittenFields + credits := rewrittenFrame.credits.push + (some { layout := schema.layout, presence := + .present (some rewrittenLocation) }) } := by + change StableFrameIso rewrite heap.locRel _ _ + exact frame.advanceAppendCreditIso fieldsRelated + (.physical locations) + have outputStack : StableStackIso limits validation outputHeap.locRel + baselineStack rewrittenStack := by + change StableStackIso limits validation heap.locRel _ _ + exact stack + refine ⟨rewrittenLocation, rewrittenFields, + Step.takeUniquePhysical + (context := baselineContext) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction schemaAt resolved viewed unitRC, + Step.takeUniquePhysical + (context := rewrittenContext) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetSchemaAt targetResolved + targetViewed rewrittenRc, ?_⟩ + exact StableMachineRel.history outputHeap fuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- A logical hot shared reset follows a related unit-refcount constructor, +kills both locations, and records matching logical credits. -/ +theorem unchangedResetSharedLogicalHotStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + (schemas : baselineContext.schemas = rewrittenContext.schemas) + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {target : Atom} {cid : CtorId} + {schema : CtorSchema} {baselineLocation : Nat} + {baselineBox : IxIR1.NodeBox} {baselineFields : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .resetShared target cid) + (schemaAt : baselineContext.schemas .shared cid = some schema) + (resolved : resolveAtom baselineFrame.values target = + .ok (.loc baselineLocation)) + (viewed : ConstructorView baselineStore baselineLocation .shared cid + baselineBox baselineFields) + (unitRC : baselineBox.rc = 1) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let credit : Credit := + { layout := schema.layout, presence := .present none } + let baselineNext : Machine := + { store := ((baselineStore.tickResetAttempt).kill + baselineLocation).tickHotReset + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values ++ baselineFields + credits := baselineFrame.credits.push (some credit) } + baselineStack } + ∃ (rewrittenLocation : Nat) (rewrittenFields : Array RVal), + let rewrittenNext : Machine := + { store := ((rewrittenStore.tickResetAttempt).kill + rewrittenLocation).tickHotReset + heapFuel := rewrittenFuel + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values ++ rewrittenFields + credits := rewrittenFrame.credits.push (some credit) } + rewrittenStack } + Step baselineContext .logical baselineMachine baselineNext ∧ + Step rewrittenContext .logical rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + obtain ⟨rewrittenResolved, targetResolved, resolvedRelated⟩ := + resolveAtom_iso frame.values resolved + cases resolvedRelated with + | @loc _ rewrittenLocation locations => + obtain ⟨rewrittenBox, rewrittenFields, rewrittenAt, targetViewed, + boxes, fieldsRelated⟩ := + constructorView_historyIso heap locations viewed + obtain ⟨baselineAt, _, _⟩ := viewed.parts + have rewrittenRc : rewrittenBox.rc = 1 := + boxes.rc.symm.trans unitRC + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .resetShared target cid := by + simpa only [← frame.pc] using instruction + have targetSchemaAt : rewrittenContext.schemas .shared cid = + some schema := by + rw [← schemas] + exact schemaAt + let killed := heap.kill locations (by + change baselineStore.heap.get? baselineLocation = some baselineBox + exact baselineAt) (by + change rewrittenStore.heap.get? rewrittenLocation = some rewrittenBox + exact rewrittenAt) + let outputHeap : IxIR1.Sim.HeapHistoryIso + (((baselineStore.tickResetAttempt).kill + baselineLocation).tickHotReset).heap + (((rewrittenStore.tickResetAttempt).kill + rewrittenLocation).tickHotReset).heap := by + simpa [Eval.Store.tickResetAttempt, Eval.Store.tickHotReset] using killed + have outputFrame : StableFrameIso rewrite outputHeap.locRel + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values ++ baselineFields + credits := baselineFrame.credits.push + (some { layout := schema.layout, presence := .present none }) } + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values ++ rewrittenFields + credits := rewrittenFrame.credits.push + (some { layout := schema.layout, presence := .present none }) } := by + change StableFrameIso rewrite heap.locRel _ _ + exact frame.advanceAppendCreditIso fieldsRelated + (.logical schema.layout) + have outputStack : StableStackIso limits validation outputHeap.locRel + baselineStack rewrittenStack := by + change StableStackIso limits validation heap.locRel _ _ + exact stack + refine ⟨rewrittenLocation, rewrittenFields, + Step.resetSharedLogicalHot + (context := baselineContext) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction schemaAt resolved viewed unitRC, + Step.resetSharedLogicalHot + (context := rewrittenContext) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetSchemaAt targetResolved + targetViewed rewrittenRc, ?_⟩ + exact StableMachineRel.history outputHeap fuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- A physical hot shared reset reserves corresponding constructor slots and +records location-related physical credits. -/ +theorem unchangedResetSharedPhysicalHotStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + (schemas : baselineContext.schemas = rewrittenContext.schemas) + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {target : Atom} {cid : CtorId} + {schema : CtorSchema} {baselineLocation : Nat} + {baselineBox : IxIR1.NodeBox} {baselineFields : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .resetShared target cid) + (schemaAt : baselineContext.schemas .shared cid = some schema) + (resolved : resolveAtom baselineFrame.values target = + .ok (.loc baselineLocation)) + (viewed : ConstructorView baselineStore baselineLocation .shared cid + baselineBox baselineFields) + (unitRC : baselineBox.rc = 1) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineCredit : Credit := + { layout := schema.layout, + presence := .present (some baselineLocation) } + let baselineNext : Machine := + { store := ((baselineStore.tickResetAttempt).reserve + baselineLocation).tickHotReset + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values ++ baselineFields + credits := baselineFrame.credits.push (some baselineCredit) } + baselineStack } + ∃ (rewrittenLocation : Nat) (rewrittenFields : Array RVal), + let rewrittenCredit : Credit := + { layout := schema.layout, + presence := .present (some rewrittenLocation) } + let rewrittenNext : Machine := + { store := ((rewrittenStore.tickResetAttempt).reserve + rewrittenLocation).tickHotReset + heapFuel := rewrittenFuel + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values ++ rewrittenFields + credits := rewrittenFrame.credits.push (some rewrittenCredit) } + rewrittenStack } + Step baselineContext .physical baselineMachine baselineNext ∧ + Step rewrittenContext .physical rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + obtain ⟨rewrittenResolved, targetResolved, resolvedRelated⟩ := + resolveAtom_iso frame.values resolved + cases resolvedRelated with + | @loc _ rewrittenLocation locations => + obtain ⟨rewrittenBox, rewrittenFields, rewrittenAt, targetViewed, + boxes, fieldsRelated⟩ := + constructorView_historyIso heap locations viewed + obtain ⟨baselineAt, _, _⟩ := viewed.parts + have rewrittenRc : rewrittenBox.rc = 1 := + boxes.rc.symm.trans unitRC + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .resetShared target cid := by + simpa only [← frame.pc] using instruction + have targetSchemaAt : rewrittenContext.schemas .shared cid = + some schema := by + rw [← schemas] + exact schemaAt + let reserved := reserve_historyIso + (left := baselineStore.tickResetAttempt) + (right := rewrittenStore.tickResetAttempt) heap locations (by + simpa [Eval.Store.tickResetAttempt, Eval.Store.get?] using + baselineAt) (by + simpa [Eval.Store.tickResetAttempt, Eval.Store.get?] using + rewrittenAt) + let outputHeap : IxIR1.Sim.HeapHistoryIso + (((baselineStore.tickResetAttempt).reserve + baselineLocation).tickHotReset).heap + (((rewrittenStore.tickResetAttempt).reserve + rewrittenLocation).tickHotReset).heap := by + simpa [Eval.Store.tickHotReset] using reserved + have outputFrame : StableFrameIso rewrite outputHeap.locRel + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values ++ baselineFields + credits := baselineFrame.credits.push + (some { layout := schema.layout, presence := + .present (some baselineLocation) }) } + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values ++ rewrittenFields + credits := rewrittenFrame.credits.push + (some { layout := schema.layout, presence := + .present (some rewrittenLocation) }) } := by + change StableFrameIso rewrite heap.locRel _ _ + exact frame.advanceAppendCreditIso fieldsRelated + (.physical locations) + have outputStack : StableStackIso limits validation outputHeap.locRel + baselineStack rewrittenStack := by + change StableStackIso limits validation heap.locRel _ _ + exact stack + refine ⟨rewrittenLocation, rewrittenFields, + Step.resetSharedPhysicalHot + (context := baselineContext) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction schemaAt resolved viewed unitRC, + Step.resetSharedPhysicalHot + (context := rewrittenContext) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetSchemaAt targetResolved + targetViewed rewrittenRc, ?_⟩ + exact StableMachineRel.history outputHeap fuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- A cold shared reset transports the parent decrement and field-retain loop +through allocation history, then appends related fields and absent credits. -/ +theorem unchangedResetSharedColdStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + (schemas : baselineContext.schemas = rewrittenContext.schemas) + {baselineStore rewrittenStore baselineOut : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {target : Atom} {cid : CtorId} + {schema : CtorSchema} {baselineLocation : Nat} + {baselineBox : IxIR1.NodeBox} {baselineFields : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .resetShared target cid) + (schemaAt : baselineContext.schemas .shared cid = some schema) + (resolved : resolveAtom baselineFrame.values target = + .ok (.loc baselineLocation)) + (viewed : ConstructorView baselineStore baselineLocation .shared cid + baselineBox baselineFields) + (shared : 1 < baselineBox.rc) + (retained : RetainSharedMany + ((((baselineStore.tickResetAttempt).setBox baselineLocation + { baselineBox with rc := baselineBox.rc - 1 }).rcTick).tickColdReset) + baselineFields baselineOut) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let credit : Credit := + { layout := schema.layout, presence := .absent } + let baselineNext : Machine := + { store := baselineOut + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values ++ baselineFields + credits := baselineFrame.credits.push (some credit) } + baselineStack } + ∃ (rewrittenFields : Array RVal) (rewrittenOut : Store), + let rewrittenNext : Machine := + { store := rewrittenOut + heapFuel := rewrittenFuel + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values ++ rewrittenFields + credits := rewrittenFrame.credits.push (some credit) } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + obtain ⟨rewrittenResolved, targetResolved, resolvedRelated⟩ := + resolveAtom_iso frame.values resolved + cases resolvedRelated with + | @loc _ rewrittenLocation locations => + obtain ⟨rewrittenBox, rewrittenFields, rewrittenAt, targetViewed, + boxes, fieldsRelated⟩ := + constructorView_historyIso heap locations viewed + obtain ⟨baselineAt, _, _⟩ := viewed.parts + have rewrittenShared : 1 < rewrittenBox.rc := by + rw [← boxes.rc] + exact shared + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .resetShared target cid := by + simpa only [← frame.pc] using instruction + have targetSchemaAt : rewrittenContext.schemas .shared cid = + some schema := by + rw [← schemas] + exact schemaAt + let updated := heap.setBox locations (by + change baselineStore.heap.get? baselineLocation = some baselineBox + exact baselineAt) (by + change rewrittenStore.heap.get? rewrittenLocation = some rewrittenBox + exact rewrittenAt) + (show IxIR1.Sim.NodeBoxIso heap.locRel + { baselineBox with rc := baselineBox.rc - 1 } + { rewrittenBox with rc := rewrittenBox.rc - 1 } from + ⟨boxes.world, congrArg (fun rc => rc - 1) boxes.rc, boxes.node⟩) + let beforeHistory : IxIR1.Sim.HeapHistoryIso + ((((baselineStore.tickResetAttempt).setBox baselineLocation + { baselineBox with rc := baselineBox.rc - 1 }).rcTick).tickColdReset).heap + ((((rewrittenStore.tickResetAttempt).setBox rewrittenLocation + { rewrittenBox with rc := rewrittenBox.rc - 1 }).rcTick).tickColdReset).heap := by + simpa [Eval.Store.tickResetAttempt, Eval.Store.tickColdReset] using + updated.rcTick + have retainedFields : IxIR1.Sim.RValsIso beforeHistory.locRel + baselineFields.toList rewrittenFields.toList := by + change IxIR1.Sim.RValsIso heap.locRel _ _ + exact fieldsRelated + obtain ⟨rewrittenOut, outputHeap, targetRetained, outputRelation⟩ := + retainSharedMany_historyIso beforeHistory retainedFields retained + have outputFrame : StableFrameIso rewrite outputHeap.locRel + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values ++ baselineFields + credits := baselineFrame.credits.push + (some { layout := schema.layout, presence := .absent }) } + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values ++ rewrittenFields + credits := rewrittenFrame.credits.push + (some { layout := schema.layout, presence := .absent }) } := by + rw [outputRelation] + change StableFrameIso rewrite heap.locRel _ _ + exact frame.advanceAppendCreditIso fieldsRelated + (.absent schema.layout) + have outputStack : StableStackIso limits validation outputHeap.locRel + baselineStack rewrittenStack := by + rw [outputRelation] + change StableStackIso limits validation beforeHistory.locRel _ _ + change StableStackIso limits validation heap.locRel _ _ + exact stack + refine ⟨rewrittenFields, rewrittenOut, + Step.resetSharedCold + (context := baselineContext) (interpretation := interpretation) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction schemaAt resolved viewed shared retained, + Step.resetSharedCold + (context := rewrittenContext) (interpretation := interpretation) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetSchemaAt targetResolved + targetViewed rewrittenShared targetRetained, ?_⟩ + exact StableMachineRel.history outputHeap fuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- Shared retain updates corresponding refcounts and appends the related +resolved values to the two frames. -/ +theorem unchangedRetainSharedStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore baselineOut : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {atom : Atom} {baselineValue : RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .retainShared atom) + (resolved : resolveAtom baselineFrame.values atom = .ok baselineValue) + (retained : retainShared baselineStore baselineValue = .ok baselineOut) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { store := baselineOut + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values.push baselineValue } + baselineStack } + ∃ rewrittenValue rewrittenOut, + let rewrittenNext : Machine := + { store := rewrittenOut + heapFuel := rewrittenFuel + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values.push rewrittenValue } + rewrittenStack } + retainShared rewrittenStore rewrittenValue = .ok rewrittenOut ∧ + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + obtain ⟨rewrittenValue, targetResolved, valueRelated⟩ := + resolveAtom_iso frame.values resolved + obtain ⟨rewrittenOut, outputHeap, targetRetained, outputRelation⟩ := + retainShared_historyIso heap valueRelated retained + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .retainShared atom := by + simpa only [← frame.pc] using instruction + have outputFrame : StableFrameIso rewrite outputHeap.locRel + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values.push baselineValue } + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values.push rewrittenValue } := by + rw [outputRelation] + exact frame.advancePush valueRelated + have outputStack : StableStackIso limits validation outputHeap.locRel + baselineStack rewrittenStack := by + rw [outputRelation] + exact stack + refine ⟨rewrittenValue, rewrittenOut, targetRetained, + Step.retainShared rfl sourceAt pc instruction resolved retained, + Step.retainShared rfl targetAt targetPc targetInstruction targetResolved + targetRetained, ?_⟩ + exact StableMachineRel.history outputHeap fuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- Deep shared release follows related child graphs, retains reclaimed pairs +as history rows, and preserves the rewritten machine's fuel advantage. -/ +theorem unchangedReleaseSharedStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore baselineOut : Store} + {baselineFuel rewrittenFuel baselineRemaining : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {atom : Atom} {baselineValue : RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .releaseShared atom) + (resolved : resolveAtom baselineFrame.values atom = .ok baselineValue) + (released : releaseShared baselineFuel baselineStore baselineValue = + .ok (baselineOut, baselineRemaining)) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { store := baselineOut + heapFuel := baselineRemaining + control := .running + { baselineFrame with pc := baselineFrame.pc + 1 } + baselineStack } + ∃ rewrittenValue rewrittenOut rewrittenRemaining, + let rewrittenNext : Machine := + { store := rewrittenOut + heapFuel := rewrittenRemaining + control := .running + { rewrittenFrame with pc := rewrittenFrame.pc + 1 } + rewrittenStack } + releaseShared rewrittenFuel rewrittenStore rewrittenValue = + .ok (rewrittenOut, rewrittenRemaining) ∧ + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + obtain ⟨rewrittenValue, targetResolved, valueRelated⟩ := + resolveAtom_iso frame.values resolved + obtain ⟨rewrittenOut, rewrittenRemaining, outputHeap, targetReleased, + outputFuel, outputRelation⟩ := + releaseSharedWork_historyIso heap fuel + (.cons valueRelated .nil) (by + unfold releaseShared at released + exact released) + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .releaseShared atom := by + simpa only [← frame.pc] using instruction + have outputFrame : StableFrameIso rewrite outputHeap.locRel + { baselineFrame with pc := baselineFrame.pc + 1 } + { rewrittenFrame with pc := rewrittenFrame.pc + 1 } := by + rw [outputRelation] + exact frame.advance + have outputStack : StableStackIso limits validation outputHeap.locRel + baselineStack rewrittenStack := by + rw [outputRelation] + exact stack + refine ⟨rewrittenValue, rewrittenOut, rewrittenRemaining, + by simpa [releaseShared] using targetReleased, + Step.releaseShared rfl sourceAt pc instruction resolved released, + Step.releaseShared rfl targetAt targetPc targetInstruction targetResolved + (by simpa [releaseShared] using targetReleased), ?_⟩ + exact StableMachineRel.history outputHeap outputFuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- Deep unique destruction follows corresponding constructor trees and +preserves the rewritten traversal-fuel advantage. -/ +theorem unchangedDropUniqueStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore baselineOut : Store} + {baselineFuel rewrittenFuel baselineRemaining : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {atom : Atom} {baselineValue : RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .dropUnique atom) + (resolved : resolveAtom baselineFrame.values atom = .ok baselineValue) + (dropped : dropUnique baselineFuel baselineStore baselineValue = + .ok (baselineOut, baselineRemaining)) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { store := baselineOut + heapFuel := baselineRemaining + control := .running + { baselineFrame with pc := baselineFrame.pc + 1 } + baselineStack } + ∃ rewrittenValue rewrittenOut rewrittenRemaining, + let rewrittenNext : Machine := + { store := rewrittenOut + heapFuel := rewrittenRemaining + control := .running + { rewrittenFrame with pc := rewrittenFrame.pc + 1 } + rewrittenStack } + dropUnique rewrittenFuel rewrittenStore rewrittenValue = + .ok (rewrittenOut, rewrittenRemaining) ∧ + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + obtain ⟨rewrittenValue, targetResolved, valueRelated⟩ := + resolveAtom_iso frame.values resolved + obtain ⟨rewrittenOut, rewrittenRemaining, outputHeap, targetDropped, + outputFuel, outputRelation⟩ := + dropUniqueWork_historyIso heap fuel (.cons valueRelated .nil) (by + unfold dropUnique at dropped + exact dropped) + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .dropUnique atom := by + simpa only [← frame.pc] using instruction + have outputFrame : StableFrameIso rewrite outputHeap.locRel + { baselineFrame with pc := baselineFrame.pc + 1 } + { rewrittenFrame with pc := rewrittenFrame.pc + 1 } := by + rw [outputRelation] + exact frame.advance + have outputStack : StableStackIso limits validation outputHeap.locRel + baselineStack rewrittenStack := by + rw [outputRelation] + exact stack + refine ⟨rewrittenValue, rewrittenOut, rewrittenRemaining, + by simpa [dropUnique] using targetDropped, + Step.dropUnique rfl sourceAt pc instruction resolved dropped, + Step.dropUnique rfl targetAt targetPc targetInstruction targetResolved + (by simpa [dropUnique] using targetDropped), ?_⟩ + exact StableMachineRel.history outputHeap outputFuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- A recursive call resolves related argument vectors, enters the two +versions of the current function, and suspends related callers. -/ +theorem unchangedCallSelfStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {arguments : Array Atom} + {baselineValues : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .callSelf arguments) + (noCredits : NoLiveCredits baselineFrame) + (resolved : resolveAtoms baselineFrame.values arguments = + .ok baselineValues) + (arity : baselineValues.size = + baselineFrame.definition.signature.params.size) + (nonempty : baselineFrame.definition.blocks.isEmpty = false) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with + control := .running + { definition := baselineFrame.definition, values := baselineValues } + (.resume { baselineFrame with pc := baselineFrame.pc + 1 } :: + baselineStack) } + ∃ rewrittenValues, + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running + { definition := rewrittenFrame.definition, + values := rewrittenValues } + (.resume { rewrittenFrame with pc := rewrittenFrame.pc + 1 } :: + rewrittenStack) } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + obtain ⟨rewrittenValues, targetResolved, valuesRelated⟩ := + resolveAtoms_iso frame.values resolved + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .callSelf arguments := by + simpa only [← frame.pc] using instruction + have targetNoCredits := frame.noLiveCredits noCredits + have sizeEq : baselineValues.size = rewrittenValues.size := by + simpa using rvalsIso_length_eq valuesRelated + have sourceArity : baselineValues.size = source.signature.params.size := by + simpa [frame.baselineDefinition] using arity + have targetArity : rewrittenValues.size = + rewrittenFrame.definition.signature.params.size := by + rw [← sizeEq, frame.rewrittenDefinition, rewrite.definition_signature] + exact sourceArity + have targetNonempty : rewrittenFrame.definition.blocks.isEmpty = false := + blocks_nonempty_of_getElem targetAt + refine ⟨rewrittenValues, + Step.callSelfCleared rfl sourceAt pc instruction noCredits resolved arity + nonempty, + Step.callSelfCleared rfl targetAt targetPc targetInstruction + targetNoCredits targetResolved targetArity targetNonempty, ?_⟩ + have callee : StableFrameRel limits validation heap.locRel + { definition := baselineFrame.definition, values := baselineValues } + { definition := rewrittenFrame.definition, values := rewrittenValues } := by + rw [frame.baselineDefinition, frame.rewrittenDefinition] + exact StableFrameRel.entry rewrite valuesRelated + have resume : StableContinuationIso limits validation heap.locRel + (.resume { baselineFrame with pc := baselineFrame.pc + 1 }) + (.resume { rewrittenFrame with pc := rewrittenFrame.pc + 1 }) := + .resume (.rewritten rewrite frame.advance) + exact StableMachineRel.history heap fuel + (.running callee (.cons resume stack)) + +/-- A direct call follows the declaration rewrite selected at the same +address and enters related callee argument vectors. -/ +theorem unchangedCallFnStepIso {limits : Validate.Limits} + {validation : Validate.Context} {callerSource calleeSource : Function} + (callerRewrite : Reuse.FunctionRewrite limits validation callerSource) + (calleeRewrite : Reuse.FunctionRewrite limits validation calleeSource) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso callerRewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {address : Ix.Compiler.Ixon.Address} + {arguments : Array Atom} {baselineValues : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .call address arguments) + (noCredits : NoLiveCredits baselineFrame) + (resolved : resolveAtoms baselineFrame.values arguments = + .ok baselineValues) + (baselineDeclaration : baselineContext.declarations address = + some (.fn calleeSource)) + (rewrittenDeclaration : rewrittenContext.declarations address = + some (.fn calleeRewrite.definition)) + (arity : baselineValues.size = calleeSource.signature.params.size) + (nonempty : calleeSource.blocks.isEmpty = false) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with + control := .running + { definition := calleeSource, values := baselineValues } + (.resume { baselineFrame with pc := baselineFrame.pc + 1 } :: + baselineStack) } + ∃ rewrittenValues, + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running + { definition := calleeRewrite.definition, + values := rewrittenValues } + (.resume { rewrittenFrame with pc := rewrittenFrame.pc + 1 } :: + rewrittenStack) } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + obtain ⟨rewrittenValues, targetResolved, valuesRelated⟩ := + resolveAtoms_iso frame.values resolved + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .call address arguments := by + simpa only [← frame.pc] using instruction + have targetNoCredits := frame.noLiveCredits noCredits + have sizeEq : baselineValues.size = rewrittenValues.size := by + simpa using rvalsIso_length_eq valuesRelated + have targetArity : rewrittenValues.size = + calleeRewrite.definition.signature.params.size := by + rw [← sizeEq, calleeRewrite.definition_signature] + exact arity + have targetNonempty : calleeRewrite.definition.blocks.isEmpty = false := + calleeRewrite.definition_blocks_nonempty nonempty + refine ⟨rewrittenValues, + Step.callFnCleared rfl sourceAt pc instruction noCredits resolved + baselineDeclaration arity nonempty, + Step.callFnCleared rfl targetAt targetPc targetInstruction + targetNoCredits targetResolved rewrittenDeclaration targetArity + targetNonempty, ?_⟩ + have callee : StableFrameRel limits validation heap.locRel + { definition := calleeSource, values := baselineValues } + { definition := calleeRewrite.definition, values := rewrittenValues } := + StableFrameRel.entry calleeRewrite valuesRelated + have resume : StableContinuationIso limits validation heap.locRel + (.resume { baselineFrame with pc := baselineFrame.pc + 1 }) + (.resume { rewrittenFrame with pc := rewrittenFrame.pc + 1 }) := + .resume (.rewritten callerRewrite frame.advance) + exact StableMachineRel.history heap fuel + (.running callee (.cons resume stack)) + +/-- Partial application of a function resolves related captures and extends +the allocation history with related PAP nodes. -/ +theorem unchangedPappFnStepIso {limits : Validate.Limits} + {validation : Validate.Context} {callerSource calleeSource : Function} + (callerRewrite : Reuse.FunctionRewrite limits validation callerSource) + (calleeRewrite : Reuse.FunctionRewrite limits validation calleeSource) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso callerRewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {address : Ix.Compiler.Ixon.Address} + {arguments : Array Atom} {baselineValues : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .papp address arguments) + (noCredits : NoLiveCredits baselineFrame) + (baselineDeclaration : baselineContext.declarations address = + some (.fn calleeSource)) + (rewrittenDeclaration : rewrittenContext.declarations address = + some (.fn calleeRewrite.definition)) + (papSafe : calleeSource.signature.papSafe = true) + (resolved : resolveAtoms baselineFrame.values arguments = + .ok baselineValues) + (under : baselineValues.size < calleeSource.signature.params.size) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineAllocation := baselineStore.allocNode .shared + (.papN address calleeSource.signature.params.size baselineValues) + let baselineNext : Machine := + { store := baselineAllocation.1 + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values.push (.loc baselineAllocation.2) } + baselineStack } + ∃ rewrittenValues : Array RVal, + let rewrittenAllocation := rewrittenStore.allocNode .shared + (.papN address calleeSource.signature.params.size rewrittenValues) + let rewrittenNext : Machine := + { store := rewrittenAllocation.1 + heapFuel := rewrittenFuel + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values.push + (.loc rewrittenAllocation.2) } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + obtain ⟨rewrittenValues, targetResolved, valuesRelated⟩ := + resolveAtoms_iso frame.values resolved + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .papp address arguments := by + simpa only [← frame.pc] using instruction + have targetNoCredits := frame.noLiveCredits noCredits + have targetPapSafe : calleeRewrite.definition.signature.papSafe = true := by + simpa using papSafe + have sizeEq : baselineValues.size = rewrittenValues.size := by + simpa using rvalsIso_length_eq valuesRelated + have targetUnder : + rewrittenValues.size < calleeRewrite.definition.signature.params.size := by + rw [← sizeEq, calleeRewrite.definition_signature] + exact under + let baselineAllocation := baselineStore.allocNode .shared + (.papN address calleeSource.signature.params.size baselineValues) + let rewrittenAllocation := rewrittenStore.allocNode .shared + (.papN address calleeSource.signature.params.size rewrittenValues) + let outputHeap : IxIR1.Sim.HeapHistoryIso baselineAllocation.1.heap + rewrittenAllocation.1.heap := heap.alloc (.pap valuesRelated) + have oldExtends : ∀ {baselineLocation rewrittenLocation}, + heap.locRel baselineLocation rewrittenLocation → + outputHeap.locRel baselineLocation rewrittenLocation := by + intro baselineLocation rewrittenLocation related + exact .inr related + have resultRelated : IxIR1.Sim.RValIso outputHeap.locRel + (.loc baselineAllocation.2) (.loc rewrittenAllocation.2) := + .loc (.inl ⟨rfl, rfl⟩) + have outputFrame := (frame.mono oldExtends).advancePush resultRelated + have outputStack := stack.mono oldExtends + refine ⟨rewrittenValues, + by simpa [baselineAllocation] using + (Step.pappFnCleared + (context := baselineContext) (interpretation := interpretation) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction noCredits baselineDeclaration papSafe + resolved under), + by simpa [rewrittenAllocation, calleeRewrite.definition_signature] using + (Step.pappFnCleared + (context := rewrittenContext) (interpretation := interpretation) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetNoCredits + rewrittenDeclaration targetPapSafe targetResolved targetUnder), ?_⟩ + exact StableMachineRel.history outputHeap fuel + (.running (.rewritten callerRewrite outputFrame) outputStack) + +/-- Partial application of an extern resolves related captures and extends +the allocation history with related PAP nodes. -/ +theorem unchangedPappExternStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {address : Ix.Compiler.Ixon.Address} + {arguments : Array Atom} {baselineValues : Array RVal} {arity : Nat} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .papp address arguments) + (noCredits : NoLiveCredits baselineFrame) + (baselineDeclaration : baselineContext.declarations address = + some (.extern arity)) + (rewrittenDeclaration : rewrittenContext.declarations address = + some (.extern arity)) + (resolved : resolveAtoms baselineFrame.values arguments = + .ok baselineValues) + (under : baselineValues.size < arity) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineAllocation := baselineStore.allocNode .shared + (.papN address arity baselineValues) + let baselineNext : Machine := + { store := baselineAllocation.1 + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values.push (.loc baselineAllocation.2) } + baselineStack } + ∃ rewrittenValues : Array RVal, + let rewrittenAllocation := rewrittenStore.allocNode .shared + (.papN address arity rewrittenValues) + let rewrittenNext : Machine := + { store := rewrittenAllocation.1 + heapFuel := rewrittenFuel + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values.push + (.loc rewrittenAllocation.2) } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + obtain ⟨rewrittenValues, targetResolved, valuesRelated⟩ := + resolveAtoms_iso frame.values resolved + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .papp address arguments := by + simpa only [← frame.pc] using instruction + have targetNoCredits := frame.noLiveCredits noCredits + have sizeEq : baselineValues.size = rewrittenValues.size := by + simpa using rvalsIso_length_eq valuesRelated + have targetUnder : rewrittenValues.size < arity := by + rw [← sizeEq] + exact under + let baselineAllocation := baselineStore.allocNode .shared + (.papN address arity baselineValues) + let rewrittenAllocation := rewrittenStore.allocNode .shared + (.papN address arity rewrittenValues) + let outputHeap : IxIR1.Sim.HeapHistoryIso baselineAllocation.1.heap + rewrittenAllocation.1.heap := heap.alloc (.pap valuesRelated) + have oldExtends : ∀ {baselineLocation rewrittenLocation}, + heap.locRel baselineLocation rewrittenLocation → + outputHeap.locRel baselineLocation rewrittenLocation := by + intro baselineLocation rewrittenLocation related + exact .inr related + have resultRelated : IxIR1.Sim.RValIso outputHeap.locRel + (.loc baselineAllocation.2) (.loc rewrittenAllocation.2) := + .loc (.inl ⟨rfl, rfl⟩) + have outputFrame := (frame.mono oldExtends).advancePush resultRelated + have outputStack := stack.mono oldExtends + refine ⟨rewrittenValues, + by simpa [baselineAllocation] using + (Step.pappExternCleared + (context := baselineContext) (interpretation := interpretation) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction noCredits baselineDeclaration resolved + under), + by simpa [rewrittenAllocation] using + (Step.pappExternCleared + (context := rewrittenContext) (interpretation := interpretation) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetNoCredits + rewrittenDeclaration targetResolved targetUnder), ?_⟩ + exact StableMachineRel.history outputHeap fuel + (.running (.rewritten rewrite outputFrame) outputStack) + +/-- A successful extern call forces related arguments to be literally equal +scalars, so the shared oracle returns the same scalar result on both sides. -/ +theorem unchangedExternStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + (oracles : baselineContext.oracle = rewrittenContext.oracle) + {block : Block} {address : Ix.Compiler.Ixon.Address} + {arguments : Array Atom} {baselineValues : Array RVal} + {arity : Nat} {value : RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .extern address arguments) + (noCredits : NoLiveCredits baselineFrame) + (resolved : resolveAtoms baselineFrame.values arguments = + .ok baselineValues) + (baselineDeclaration : baselineContext.declarations address = + some (.extern arity)) + (rewrittenDeclaration : rewrittenContext.declarations address = + some (.extern arity)) + (argumentArity : baselineValues.size = arity) + (called : ScalarOracleCall baselineContext address baselineValues value) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values.push value } + baselineStack } + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values.push value } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + obtain ⟨rewrittenValues, targetResolved, valuesRelated⟩ := + resolveAtoms_iso frame.values resolved + obtain ⟨argumentsScalar, valueScalar⟩ := called.scalar + have listEq : baselineValues.toList = rewrittenValues.toList := by + apply valuesRelated.eq_of_allScalar + rw [Array.all_toList] + exact argumentsScalar + have valuesEq : baselineValues = rewrittenValues := + Array.toList_inj.mp listEq + subst rewrittenValues + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .extern address arguments := by + simpa only [← frame.pc] using instruction + have targetNoCredits := frame.noLiveCredits noCredits + have targetCalled : + ScalarOracleCall rewrittenContext address baselineValues value := + called.congrOracle oracles + refine ⟨ + Step.externCleared rfl sourceAt pc instruction noCredits resolved + baselineDeclaration argumentArity called, + Step.externCleared rfl targetAt targetPc targetInstruction targetNoCredits + targetResolved rewrittenDeclaration argumentArity targetCalled, ?_⟩ + exact StableMachineRel.history heap fuel + (.running + (.rewritten rewrite + (frame.advancePush + (IxIR1.Sim.RValIso.refl_of_scalar valueScalar))) + stack) + +/-! ## Allocation-history dynamic application -/ + +/-- Erased dynamic application releases corresponding argument vectors and +resumes related callers with the common erased value. -/ +theorem unchangedApplyTransferErasedIso {limits : Validate.Limits} + {validation : Validate.Context} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore baselineOut : Store} + {baselineFuel rewrittenFuel baselineRemaining : Nat} + {baselineArguments rewrittenArguments : Array RVal} + {baselineResume rewrittenResume : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (arguments : IxIR1.Sim.RValsIso heap.locRel + baselineArguments.toList rewrittenArguments.toList) + (resume : StableFrameRel limits validation heap.locRel + baselineResume rewrittenResume) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + (released : releaseSharedWork baselineFuel baselineStore + baselineArguments.toList = .ok (baselineOut, baselineRemaining)) : + let baselineTarget : Machine := + { store := baselineOut + heapFuel := baselineRemaining + control := .running + { baselineResume with + values := baselineResume.values.push .erased } + baselineStack } + ∃ rewrittenOut rewrittenRemaining, + let rewrittenTarget : Machine := + { store := rewrittenOut + heapFuel := rewrittenRemaining + control := .running + { rewrittenResume with + values := rewrittenResume.values.push .erased } + rewrittenStack } + releaseSharedWork rewrittenFuel rewrittenStore + rewrittenArguments.toList = .ok (rewrittenOut, rewrittenRemaining) ∧ + ApplyTransfer baselineContext interpretation baselineStore + baselineFuel .erased baselineArguments baselineResume baselineStack + baselineTarget ∧ + ApplyTransfer rewrittenContext interpretation rewrittenStore + rewrittenFuel .erased rewrittenArguments rewrittenResume + rewrittenStack rewrittenTarget ∧ + StableMachineRel limits validation baselineTarget rewrittenTarget := by + dsimp only + obtain ⟨rewrittenOut, rewrittenRemaining, outputHeap, targetReleased, + outputFuel, outputRelation⟩ := + releaseSharedWork_historyIso heap fuel arguments released + have outputResume : StableFrameRel limits validation outputHeap.locRel + { baselineResume with values := baselineResume.values.push .erased } + { rewrittenResume with values := rewrittenResume.values.push .erased } := by + rw [outputRelation] + exact resume.push .erased + have outputStack : StableStackIso limits validation outputHeap.locRel + baselineStack rewrittenStack := by + rw [outputRelation] + exact stack + refine ⟨rewrittenOut, rewrittenRemaining, targetReleased, + ApplyTransfer.erased released, ApplyTransfer.erased targetReleased, ?_⟩ + exact StableMachineRel.history outputHeap outputFuel + (.running outputResume outputStack) + +/-- Under-saturated PAP application follows a related PAP, performs +corresponding retain/release work, and allocates related extended PAPs. -/ +theorem unchangedApplyTransferPapUnderIso {limits : Validate.Limits} + {validation : Validate.Context} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore baselineRetained baselineReleased : Store} + {baselineFuel rewrittenFuel baselineRemaining : Nat} + {baselineLocation rewrittenLocation : Nat} + {baselineBox : IxIR1.NodeBox} + {address : Ix.Compiler.Ixon.Address} {arity : Nat} + {baselineCaptured baselineArguments rewrittenArguments : Array RVal} + {baselineResume rewrittenResume : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (locations : heap.locRel baselineLocation rewrittenLocation) + (arguments : IxIR1.Sim.RValsIso heap.locRel + baselineArguments.toList rewrittenArguments.toList) + (resume : StableFrameRel limits validation heap.locRel + baselineResume rewrittenResume) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + (boxAt : baselineStore.get? baselineLocation = some baselineBox) + (shared : baselineBox.world = .shared) + (node : baselineBox.node = .papN address arity baselineCaptured) + (capturedUnder : baselineCaptured.size < arity) + (retained : RetainSharedMany baselineStore baselineCaptured + baselineRetained) + (released : releaseSharedWork baselineFuel baselineRetained + [.loc baselineLocation] = .ok (baselineReleased, baselineRemaining)) + (totalUnder : (baselineCaptured ++ baselineArguments).size < arity) : + let baselineAllocation := baselineReleased.allocNode .shared + (.papN address arity (baselineCaptured ++ baselineArguments)) + let baselineTarget : Machine := + { store := baselineAllocation.1 + heapFuel := baselineRemaining + control := .running + { baselineResume with + values := baselineResume.values.push (.loc baselineAllocation.2) } + baselineStack } + ∃ (rewrittenCaptured : Array RVal) + (rewrittenRetained rewrittenReleased : Store) + (rewrittenRemaining : Nat), + let rewrittenAllocation := rewrittenReleased.allocNode .shared + (.papN address arity (rewrittenCaptured ++ rewrittenArguments)) + let rewrittenTarget : Machine := + { store := rewrittenAllocation.1 + heapFuel := rewrittenRemaining + control := .running + { rewrittenResume with + values := rewrittenResume.values.push + (.loc rewrittenAllocation.2) } + rewrittenStack } + RetainSharedMany rewrittenStore rewrittenCaptured rewrittenRetained ∧ + releaseSharedWork rewrittenFuel rewrittenRetained + [.loc rewrittenLocation] = + .ok (rewrittenReleased, rewrittenRemaining) ∧ + ApplyTransfer baselineContext interpretation baselineStore + baselineFuel (.loc baselineLocation) baselineArguments baselineResume + baselineStack baselineTarget ∧ + ApplyTransfer rewrittenContext interpretation rewrittenStore + rewrittenFuel (.loc rewrittenLocation) rewrittenArguments + rewrittenResume rewrittenStack rewrittenTarget ∧ + StableMachineRel limits validation baselineTarget rewrittenTarget := by + dsimp only + obtain ⟨rewrittenBox, rewrittenAt, boxes⟩ := heap.boxes locations (by + change baselineStore.heap.get? baselineLocation = some baselineBox + exact boxAt) + have papNodes : IxIR1.Sim.NodeIso heap.locRel + (.papN address arity baselineCaptured) rewrittenBox.node := by + simpa only [← node] using boxes.node + obtain ⟨rewrittenCaptured, rewrittenNode, capturedRelated⟩ := + nodeIso_pap_left papNodes + have rewrittenShared : rewrittenBox.world = .shared := + boxes.world.symm.trans shared + have rewrittenCapturedUnder : rewrittenCaptured.size < arity := by + have sizes : baselineCaptured.size = rewrittenCaptured.size := by + simpa using rvalsIso_length_eq capturedRelated + rw [← sizes] + exact capturedUnder + have totalRelated : IxIR1.Sim.RValsIso heap.locRel + (baselineCaptured ++ baselineArguments).toList + (rewrittenCaptured ++ rewrittenArguments).toList := by + simpa using capturedRelated.append arguments + have rewrittenTotalUnder : + (rewrittenCaptured ++ rewrittenArguments).size < arity := by + have sizes : (baselineCaptured ++ baselineArguments).size = + (rewrittenCaptured ++ rewrittenArguments).size := by + simpa using rvalsIso_length_eq totalRelated + rw [← sizes] + exact totalUnder + obtain ⟨rewrittenRetained, retainedHeap, targetRetained, + retainedRelation⟩ := + retainSharedMany_historyIso heap capturedRelated retained + have retainedLocation : retainedHeap.locRel baselineLocation + rewrittenLocation := by + rw [retainedRelation] + exact locations + obtain ⟨rewrittenReleased, rewrittenRemaining, releasedHeap, + targetReleased, outputFuel, releasedRelation⟩ := + releaseSharedWork_historyIso retainedHeap fuel + (.cons (.loc retainedLocation) .nil) released + have totalReleased : IxIR1.Sim.RValsIso releasedHeap.locRel + (baselineCaptured ++ baselineArguments).toList + (rewrittenCaptured ++ rewrittenArguments).toList := by + rw [releasedRelation, retainedRelation] + exact totalRelated + let baselineAllocation := baselineReleased.allocNode .shared + (.papN address arity (baselineCaptured ++ baselineArguments)) + let rewrittenAllocation := rewrittenReleased.allocNode .shared + (.papN address arity (rewrittenCaptured ++ rewrittenArguments)) + let outputHeap : IxIR1.Sim.HeapHistoryIso baselineAllocation.1.heap + rewrittenAllocation.1.heap := releasedHeap.alloc (.pap totalReleased) + have oldExtends : ∀ {leftLocation rightLocation}, + heap.locRel leftLocation rightLocation → + outputHeap.locRel leftLocation rightLocation := by + intro leftLocation rightLocation related + apply Or.inr + rw [releasedRelation, retainedRelation] + exact related + have outputResume := (resume.mono oldExtends).push + (IxIR1.Sim.RValIso.loc (Or.inl ⟨rfl, rfl⟩)) + have outputStack := stack.mono oldExtends + refine ⟨rewrittenCaptured, rewrittenRetained, rewrittenReleased, + rewrittenRemaining, + targetRetained, targetReleased, + ApplyTransfer.papUnder boxAt shared node capturedUnder retained released + totalUnder, + ApplyTransfer.papUnder (by + change rewrittenStore.heap.get? rewrittenLocation = some rewrittenBox + exact rewrittenAt) rewrittenShared rewrittenNode rewrittenCapturedUnder + targetRetained targetReleased rewrittenTotalUnder, ?_⟩ + exact StableMachineRel.history outputHeap outputFuel + (.running outputResume outputStack) + +/-- Saturated or over-saturated application follows a related PAP, performs +corresponding ownership traffic, and enters related callee rewrites with +related supplied and excess argument slices. -/ +theorem unchangedApplyTransferPapFnIso {limits : Validate.Limits} + {validation : Validate.Context} {calleeSource : Function} + (calleeRewrite : Reuse.FunctionRewrite limits validation calleeSource) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore baselineRetained baselineReleased : Store} + {baselineFuel rewrittenFuel baselineRemaining : Nat} + {baselineLocation rewrittenLocation : Nat} + {baselineBox : IxIR1.NodeBox} + {address : Ix.Compiler.Ixon.Address} {arity : Nat} + {baselineCaptured baselineArguments rewrittenArguments : Array RVal} + {baselineResume rewrittenResume : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (locations : heap.locRel baselineLocation rewrittenLocation) + (arguments : IxIR1.Sim.RValsIso heap.locRel + baselineArguments.toList rewrittenArguments.toList) + (resume : StableFrameRel limits validation heap.locRel + baselineResume rewrittenResume) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + (boxAt : baselineStore.get? baselineLocation = some baselineBox) + (shared : baselineBox.world = .shared) + (node : baselineBox.node = .papN address arity baselineCaptured) + (capturedUnder : baselineCaptured.size < arity) + (retained : RetainSharedMany baselineStore baselineCaptured + baselineRetained) + (released : releaseSharedWork baselineFuel baselineRetained + [.loc baselineLocation] = .ok (baselineReleased, baselineRemaining)) + (totalEnough : arity ≤ (baselineCaptured ++ baselineArguments).size) + (baselineDeclaration : baselineContext.declarations address = + some (.fn calleeSource)) + (rewrittenDeclaration : rewrittenContext.declarations address = + some (.fn calleeRewrite.definition)) + (papSafe : calleeSource.signature.papSafe = true) + (suppliedArity : + ((baselineCaptured ++ baselineArguments).extract 0 arity).size = + calleeSource.signature.params.size) + (nonempty : calleeSource.blocks.isEmpty = false) : + let baselineTotal := baselineCaptured ++ baselineArguments + let baselineSupplied := baselineTotal.extract 0 arity + let baselineExcess := baselineTotal.extract arity baselineTotal.size + let baselineContinuation : Continuation := + if baselineExcess.isEmpty then .resume baselineResume + else .applyMore baselineExcess baselineResume + let baselineTarget : Machine := + { store := baselineReleased + heapFuel := baselineRemaining + control := .running + { definition := calleeSource, values := baselineSupplied } + (baselineContinuation :: baselineStack) } + ∃ (rewrittenCaptured : Array RVal) + (rewrittenRetained rewrittenReleased : Store) + (rewrittenRemaining : Nat), + let rewrittenTotal := rewrittenCaptured ++ rewrittenArguments + let rewrittenSupplied := rewrittenTotal.extract 0 arity + let rewrittenExcess := rewrittenTotal.extract arity rewrittenTotal.size + let rewrittenContinuation : Continuation := + if rewrittenExcess.isEmpty then .resume rewrittenResume + else .applyMore rewrittenExcess rewrittenResume + let rewrittenTarget : Machine := + { store := rewrittenReleased + heapFuel := rewrittenRemaining + control := .running + { definition := calleeRewrite.definition, + values := rewrittenSupplied } + (rewrittenContinuation :: rewrittenStack) } + RetainSharedMany rewrittenStore rewrittenCaptured rewrittenRetained ∧ + releaseSharedWork rewrittenFuel rewrittenRetained + [.loc rewrittenLocation] = + .ok (rewrittenReleased, rewrittenRemaining) ∧ + ApplyTransfer baselineContext interpretation baselineStore + baselineFuel (.loc baselineLocation) baselineArguments baselineResume + baselineStack baselineTarget ∧ + ApplyTransfer rewrittenContext interpretation rewrittenStore + rewrittenFuel (.loc rewrittenLocation) rewrittenArguments + rewrittenResume rewrittenStack rewrittenTarget ∧ + StableMachineRel limits validation baselineTarget rewrittenTarget := by + dsimp only + obtain ⟨rewrittenBox, rewrittenAt, boxes⟩ := heap.boxes locations (by + change baselineStore.heap.get? baselineLocation = some baselineBox + exact boxAt) + have papNodes : IxIR1.Sim.NodeIso heap.locRel + (.papN address arity baselineCaptured) rewrittenBox.node := by + simpa only [← node] using boxes.node + obtain ⟨rewrittenCaptured, rewrittenNode, capturedRelated⟩ := + nodeIso_pap_left papNodes + have rewrittenShared : rewrittenBox.world = .shared := + boxes.world.symm.trans shared + have rewrittenCapturedUnder : rewrittenCaptured.size < arity := by + have sizes : baselineCaptured.size = rewrittenCaptured.size := by + simpa using rvalsIso_length_eq capturedRelated + rw [← sizes] + exact capturedUnder + have totalRelated : IxIR1.Sim.RValsIso heap.locRel + (baselineCaptured ++ baselineArguments).toList + (rewrittenCaptured ++ rewrittenArguments).toList := by + simpa using capturedRelated.append arguments + have totalSizes : (baselineCaptured ++ baselineArguments).size = + (rewrittenCaptured ++ rewrittenArguments).size := by + simpa using rvalsIso_length_eq totalRelated + have rewrittenTotalEnough : + arity ≤ (rewrittenCaptured ++ rewrittenArguments).size := by + rw [← totalSizes] + exact totalEnough + have suppliedRelated : IxIR1.Sim.RValsIso heap.locRel + ((baselineCaptured ++ baselineArguments).extract 0 arity).toList + ((rewrittenCaptured ++ rewrittenArguments).extract 0 arity).toList := + rvalsIso_array_extract totalRelated 0 arity + have excessRelated : IxIR1.Sim.RValsIso heap.locRel + ((baselineCaptured ++ baselineArguments).extract arity + (baselineCaptured ++ baselineArguments).size).toList + ((rewrittenCaptured ++ rewrittenArguments).extract arity + (rewrittenCaptured ++ rewrittenArguments).size).toList := by + have extracted := rvalsIso_array_extract totalRelated arity + (baselineCaptured ++ baselineArguments).size + simpa [totalSizes] using extracted + have targetPapSafe : + calleeRewrite.definition.signature.papSafe = true := by + simpa using papSafe + have targetSuppliedArity : + ((rewrittenCaptured ++ rewrittenArguments).extract 0 arity).size = + calleeRewrite.definition.signature.params.size := by + have sizes : + ((baselineCaptured ++ baselineArguments).extract 0 arity).size = + ((rewrittenCaptured ++ rewrittenArguments).extract 0 arity).size := by + simpa using rvalsIso_length_eq suppliedRelated + rw [← sizes, calleeRewrite.definition_signature] + exact suppliedArity + have targetNonempty : + calleeRewrite.definition.blocks.isEmpty = false := + calleeRewrite.definition_blocks_nonempty nonempty + obtain ⟨rewrittenRetained, retainedHeap, targetRetained, + retainedRelation⟩ := + retainSharedMany_historyIso heap capturedRelated retained + have retainedLocation : retainedHeap.locRel baselineLocation + rewrittenLocation := by + rw [retainedRelation] + exact locations + obtain ⟨rewrittenReleased, rewrittenRemaining, releasedHeap, + targetReleased, outputFuel, releasedRelation⟩ := + releaseSharedWork_historyIso retainedHeap fuel + (.cons (.loc retainedLocation) .nil) released + have suppliedReleased : IxIR1.Sim.RValsIso releasedHeap.locRel + ((baselineCaptured ++ baselineArguments).extract 0 arity).toList + ((rewrittenCaptured ++ rewrittenArguments).extract 0 arity).toList := by + rw [releasedRelation, retainedRelation] + exact suppliedRelated + have excessReleased : IxIR1.Sim.RValsIso releasedHeap.locRel + ((baselineCaptured ++ baselineArguments).extract arity + (baselineCaptured ++ baselineArguments).size).toList + ((rewrittenCaptured ++ rewrittenArguments).extract arity + (rewrittenCaptured ++ rewrittenArguments).size).toList := by + rw [releasedRelation, retainedRelation] + exact excessRelated + have resumeReleased : StableFrameRel limits validation releasedHeap.locRel + baselineResume rewrittenResume := by + rw [releasedRelation, retainedRelation] + exact resume + have stackReleased : StableStackIso limits validation releasedHeap.locRel + baselineStack rewrittenStack := by + rw [releasedRelation, retainedRelation] + exact stack + let continuation := StableContinuationIso.applyMoreOrResumeIso + excessReleased resumeReleased + refine ⟨rewrittenCaptured, rewrittenRetained, rewrittenReleased, + rewrittenRemaining, targetRetained, targetReleased, + ApplyTransfer.papFn boxAt shared node capturedUnder retained released + totalEnough baselineDeclaration papSafe suppliedArity nonempty, + ApplyTransfer.papFn (by + change rewrittenStore.heap.get? rewrittenLocation = some rewrittenBox + exact rewrittenAt) rewrittenShared rewrittenNode rewrittenCapturedUnder + targetRetained targetReleased rewrittenTotalEnough rewrittenDeclaration + targetPapSafe targetSuppliedArity targetNonempty, ?_⟩ + exact StableMachineRel.history releasedHeap outputFuel + (.running (StableFrameRel.entry calleeRewrite suppliedReleased) + (.cons continuation stackReleased)) + +/-- Exactly saturated application of a related PAP to an extern transports +the ownership work, proves the supplied slices are the same scalars, and +resumes related callers with the common scalar result. -/ +theorem unchangedApplyTransferPapExternIso {limits : Validate.Limits} + {validation : Validate.Context} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore baselineRetained baselineReleased : Store} + {baselineFuel rewrittenFuel baselineRemaining : Nat} + {baselineLocation rewrittenLocation : Nat} + {baselineBox : IxIR1.NodeBox} + {address : Ix.Compiler.Ixon.Address} {arity expectedArity : Nat} + {baselineCaptured baselineArguments rewrittenArguments : Array RVal} + {value : RVal} {baselineResume rewrittenResume : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (locations : heap.locRel baselineLocation rewrittenLocation) + (arguments : IxIR1.Sim.RValsIso heap.locRel + baselineArguments.toList rewrittenArguments.toList) + (resume : StableFrameRel limits validation heap.locRel + baselineResume rewrittenResume) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + (oracles : baselineContext.oracle = rewrittenContext.oracle) + (boxAt : baselineStore.get? baselineLocation = some baselineBox) + (shared : baselineBox.world = .shared) + (node : baselineBox.node = .papN address arity baselineCaptured) + (capturedUnder : baselineCaptured.size < arity) + (retained : RetainSharedMany baselineStore baselineCaptured + baselineRetained) + (released : releaseSharedWork baselineFuel baselineRetained + [.loc baselineLocation] = .ok (baselineReleased, baselineRemaining)) + (totalEnough : arity ≤ (baselineCaptured ++ baselineArguments).size) + (baselineDeclaration : baselineContext.declarations address = + some (.extern expectedArity)) + (rewrittenDeclaration : rewrittenContext.declarations address = + some (.extern expectedArity)) + (suppliedArity : + ((baselineCaptured ++ baselineArguments).extract 0 arity).size = + expectedArity) + (remainingEmpty : + ((baselineCaptured ++ baselineArguments).extract arity + (baselineCaptured ++ baselineArguments).size).isEmpty = true) + (called : ScalarOracleCall baselineContext address + ((baselineCaptured ++ baselineArguments).extract 0 arity) value) : + let baselineTarget : Machine := + { store := baselineReleased + heapFuel := baselineRemaining + control := .running + { baselineResume with + values := baselineResume.values.push value } + baselineStack } + ∃ (rewrittenCaptured : Array RVal) + (rewrittenRetained rewrittenReleased : Store) + (rewrittenRemaining : Nat), + let rewrittenTarget : Machine := + { store := rewrittenReleased + heapFuel := rewrittenRemaining + control := .running + { rewrittenResume with + values := rewrittenResume.values.push value } + rewrittenStack } + RetainSharedMany rewrittenStore rewrittenCaptured rewrittenRetained ∧ + releaseSharedWork rewrittenFuel rewrittenRetained + [.loc rewrittenLocation] = + .ok (rewrittenReleased, rewrittenRemaining) ∧ + ApplyTransfer baselineContext interpretation baselineStore + baselineFuel (.loc baselineLocation) baselineArguments baselineResume + baselineStack baselineTarget ∧ + ApplyTransfer rewrittenContext interpretation rewrittenStore + rewrittenFuel (.loc rewrittenLocation) rewrittenArguments + rewrittenResume rewrittenStack rewrittenTarget ∧ + StableMachineRel limits validation baselineTarget rewrittenTarget := by + dsimp only + obtain ⟨rewrittenBox, rewrittenAt, boxes⟩ := heap.boxes locations (by + change baselineStore.heap.get? baselineLocation = some baselineBox + exact boxAt) + have papNodes : IxIR1.Sim.NodeIso heap.locRel + (.papN address arity baselineCaptured) rewrittenBox.node := by + simpa only [← node] using boxes.node + obtain ⟨rewrittenCaptured, rewrittenNode, capturedRelated⟩ := + nodeIso_pap_left papNodes + have rewrittenShared : rewrittenBox.world = .shared := + boxes.world.symm.trans shared + have rewrittenCapturedUnder : rewrittenCaptured.size < arity := by + have sizes : baselineCaptured.size = rewrittenCaptured.size := by + simpa using rvalsIso_length_eq capturedRelated + rw [← sizes] + exact capturedUnder + have totalRelated : IxIR1.Sim.RValsIso heap.locRel + (baselineCaptured ++ baselineArguments).toList + (rewrittenCaptured ++ rewrittenArguments).toList := by + simpa using capturedRelated.append arguments + have totalSizes : (baselineCaptured ++ baselineArguments).size = + (rewrittenCaptured ++ rewrittenArguments).size := by + simpa using rvalsIso_length_eq totalRelated + have rewrittenTotalEnough : + arity ≤ (rewrittenCaptured ++ rewrittenArguments).size := by + rw [← totalSizes] + exact totalEnough + have suppliedRelated : IxIR1.Sim.RValsIso heap.locRel + ((baselineCaptured ++ baselineArguments).extract 0 arity).toList + ((rewrittenCaptured ++ rewrittenArguments).extract 0 arity).toList := + rvalsIso_array_extract totalRelated 0 arity + have excessRelated : IxIR1.Sim.RValsIso heap.locRel + ((baselineCaptured ++ baselineArguments).extract arity + (baselineCaptured ++ baselineArguments).size).toList + ((rewrittenCaptured ++ rewrittenArguments).extract arity + (rewrittenCaptured ++ rewrittenArguments).size).toList := by + have extracted := rvalsIso_array_extract totalRelated arity + (baselineCaptured ++ baselineArguments).size + simpa [totalSizes] using extracted + have targetSuppliedArity : + ((rewrittenCaptured ++ rewrittenArguments).extract 0 arity).size = + expectedArity := by + have sizes : + ((baselineCaptured ++ baselineArguments).extract 0 arity).size = + ((rewrittenCaptured ++ rewrittenArguments).extract 0 arity).size := by + simpa using rvalsIso_length_eq suppliedRelated + rw [← sizes] + exact suppliedArity + have targetRemainingEmpty : + ((rewrittenCaptured ++ rewrittenArguments).extract arity + (rewrittenCaptured ++ rewrittenArguments).size).isEmpty = true := by + have lengths := rvalsIso_length_eq excessRelated + have sizes : + ((baselineCaptured ++ baselineArguments).extract arity + (baselineCaptured ++ baselineArguments).size).size = + ((rewrittenCaptured ++ rewrittenArguments).extract arity + (rewrittenCaptured ++ rewrittenArguments).size).size := by + simpa only [Array.length_toList] using lengths + have emptyEq : + ((baselineCaptured ++ baselineArguments).extract arity + (baselineCaptured ++ baselineArguments).size).isEmpty = + ((rewrittenCaptured ++ rewrittenArguments).extract arity + (rewrittenCaptured ++ rewrittenArguments).size).isEmpty := by + simp only [Array.isEmpty] + rw [sizes] + rw [← emptyEq] + exact remainingEmpty + obtain ⟨argumentsScalar, valueScalar⟩ := called.scalar + have suppliedListsEq : + ((baselineCaptured ++ baselineArguments).extract 0 arity).toList = + ((rewrittenCaptured ++ rewrittenArguments).extract 0 arity).toList := by + apply suppliedRelated.eq_of_allScalar + rw [Array.all_toList] + exact argumentsScalar + have suppliedEq : + (baselineCaptured ++ baselineArguments).extract 0 arity = + (rewrittenCaptured ++ rewrittenArguments).extract 0 arity := + Array.toList_inj.mp suppliedListsEq + have targetCalled : ScalarOracleCall rewrittenContext address + ((rewrittenCaptured ++ rewrittenArguments).extract 0 arity) value := by + rw [← suppliedEq] + exact called.congrOracle oracles + obtain ⟨rewrittenRetained, retainedHeap, targetRetained, + retainedRelation⟩ := + retainSharedMany_historyIso heap capturedRelated retained + have retainedLocation : retainedHeap.locRel baselineLocation + rewrittenLocation := by + rw [retainedRelation] + exact locations + obtain ⟨rewrittenReleased, rewrittenRemaining, releasedHeap, + targetReleased, outputFuel, releasedRelation⟩ := + releaseSharedWork_historyIso retainedHeap fuel + (.cons (.loc retainedLocation) .nil) released + have outputResume : StableFrameRel limits validation releasedHeap.locRel + { baselineResume with values := baselineResume.values.push value } + { rewrittenResume with values := rewrittenResume.values.push value } := by + rw [releasedRelation, retainedRelation] + exact resume.push (IxIR1.Sim.RValIso.refl_of_scalar valueScalar) + have outputStack : StableStackIso limits validation releasedHeap.locRel + baselineStack rewrittenStack := by + rw [releasedRelation, retainedRelation] + exact stack + refine ⟨rewrittenCaptured, rewrittenRetained, rewrittenReleased, + rewrittenRemaining, targetRetained, targetReleased, + ApplyTransfer.papExtern boxAt shared node capturedUnder retained released + totalEnough baselineDeclaration suppliedArity remainingEmpty called, + ApplyTransfer.papExtern (by + change rewrittenStore.heap.get? rewrittenLocation = some rewrittenBox + exact rewrittenAt) rewrittenShared rewrittenNode rewrittenCapturedUnder + targetRetained targetReleased rewrittenTotalEnough rewrittenDeclaration + targetSuppliedArity targetRemainingEmpty targetCalled, ?_⟩ + exact StableMachineRel.history releasedHeap outputFuel + (.running outputResume outputStack) + +/-- Exhaustive allocation-history simulation of dynamic application. The +source transfer selects its runtime branch; related values select the +corresponding target function and argument payloads. -/ +theorem unchangedApplyTransferIso {limits : Validate.Limits} + {validation : Validate.Context} {sourceProgram : Program} + (trace : Reuse.Trace limits validation sourceProgram) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFunction rewrittenFunction : RVal} + {baselineArguments rewrittenArguments : Array RVal} + {baselineResume rewrittenResume : Frame} + {baselineStack rewrittenStack : List Continuation} + {baselineTarget : Machine} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (function : IxIR1.Sim.RValIso heap.locRel + baselineFunction rewrittenFunction) + (arguments : IxIR1.Sim.RValsIso heap.locRel + baselineArguments.toList rewrittenArguments.toList) + (resume : StableFrameRel limits validation heap.locRel + baselineResume rewrittenResume) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + (transferred : ApplyTransfer + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation baselineStore baselineFuel baselineFunction + baselineArguments baselineResume baselineStack baselineTarget) : + ∃ rewrittenTarget, + ApplyTransfer + (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation rewrittenStore rewrittenFuel rewrittenFunction + rewrittenArguments rewrittenResume rewrittenStack rewrittenTarget ∧ + StableMachineRel limits validation baselineTarget rewrittenTarget := by + have classified := transferred.classify + cases classified with + | erased released => + cases function with + | erased => + obtain ⟨rewrittenOut, rewrittenRemaining, targetReleased, + sourceTransfer, targetTransfer, related⟩ := + unchangedApplyTransferErasedIso + (baselineContext := Eval.Context.ofProgram sourceProgram + validation.schemas oracle) + (rewrittenContext := Eval.Context.ofProgram trace.target + validation.schemas oracle) + heap fuel arguments resume stack released + exact ⟨_, targetTransfer, related⟩ + | papUnder boxAt shared node capturedUnder retained released totalUnder => + cases function with + | @loc _ rewrittenLocation locations => + obtain ⟨rewrittenCaptured, rewrittenRetained, rewrittenReleased, + rewrittenRemaining, targetRetained, targetReleased, + sourceTransfer, targetTransfer, related⟩ := + unchangedApplyTransferPapUnderIso + (baselineContext := Eval.Context.ofProgram sourceProgram + validation.schemas oracle) + (rewrittenContext := Eval.Context.ofProgram trace.target + validation.schemas oracle) + heap fuel locations arguments resume stack boxAt shared node + capturedUnder retained released totalUnder + exact ⟨_, targetTransfer, related⟩ + | papFn boxAt shared node capturedUnder retained released totalEnough + declaration papSafe suppliedArity nonempty => + cases function with + | @loc _ rewrittenLocation locations => + obtain ⟨calleeRewrite, targetDeclaration⟩ := + trace.context_fn declaration + obtain ⟨rewrittenCaptured, rewrittenRetained, rewrittenReleased, + rewrittenRemaining, targetRetained, targetReleased, + sourceTransfer, targetTransfer, related⟩ := + unchangedApplyTransferPapFnIso calleeRewrite heap fuel locations + arguments resume stack boxAt shared node capturedUnder retained + released totalEnough declaration targetDeclaration papSafe + suppliedArity nonempty + exact ⟨_, targetTransfer, related⟩ + | papExtern boxAt shared node capturedUnder retained released totalEnough + declaration suppliedArity remainingEmpty called => + cases function with + | @loc _ rewrittenLocation locations => + have targetDeclaration := trace.context_extern declaration + obtain ⟨rewrittenCaptured, rewrittenRetained, rewrittenReleased, + rewrittenRemaining, targetRetained, targetReleased, + sourceTransfer, targetTransfer, related⟩ := + unchangedApplyTransferPapExternIso + (baselineContext := Eval.Context.ofProgram sourceProgram + validation.schemas oracle) + (rewrittenContext := Eval.Context.ofProgram trace.target + validation.schemas oracle) + heap fuel locations arguments resume stack rfl boxAt shared node + capturedUnder retained released totalEnough declaration + targetDeclaration suppliedArity remainingEmpty called + exact ⟨_, targetTransfer, related⟩ + +/-- A source dynamic application in an unchanged block determines a target +application over related function and argument values. -/ +theorem unchangedApplyStepOfTraceIso {limits : Validate.Limits} + {validation : Validate.Context} {sourceProgram : Program} + (trace : Reuse.Trace limits validation sourceProgram) + {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + {baselineTarget : Machine} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {functionAtom : Atom} {argumentAtoms : Array Atom} + {baselineFunction : RVal} {baselineArguments : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .apply functionAtom argumentAtoms) + (noCredits : NoLiveCredits baselineFrame) + (functionResolved : resolveAtom baselineFrame.values functionAtom = + .ok baselineFunction) + (argumentsResolved : resolveAtoms baselineFrame.values argumentAtoms = + .ok baselineArguments) + (transferred : ApplyTransfer + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation baselineStore baselineFuel baselineFunction + baselineArguments { baselineFrame with pc := baselineFrame.pc + 1 } + baselineStack baselineTarget) : + ∃ rewrittenTarget, + Step (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + baselineTarget ∧ + Step (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + rewrittenTarget ∧ + StableMachineRel limits validation baselineTarget rewrittenTarget := by + obtain ⟨rewrittenFunction, targetFunctionResolved, functionRelated⟩ := + resolveAtom_iso frame.values functionResolved + obtain ⟨rewrittenArguments, targetArgumentsResolved, argumentsRelated⟩ := + resolveAtoms_iso frame.values argumentsResolved + have targetPc : rewrittenFrame.pc < block.instructions.size := by + rw [← frame.pc] + exact pc + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .apply functionAtom argumentAtoms := by + simpa only [← frame.pc] using instruction + have targetNoCredits := frame.noLiveCredits noCredits + have resume : StableFrameRel limits validation heap.locRel + { baselineFrame with pc := baselineFrame.pc + 1 } + { rewrittenFrame with pc := rewrittenFrame.pc + 1 } := + .rewritten rewrite frame.advance + obtain ⟨rewrittenTarget, targetTransferred, related⟩ := + unchangedApplyTransferIso trace heap fuel functionRelated argumentsRelated + resume stack transferred + refine ⟨rewrittenTarget, + Step.applyCleared rfl sourceAt pc instruction noCredits functionResolved + argumentsResolved transferred, + Step.applyCleared rfl targetAt targetPc targetInstruction targetNoCredits + targetFunctionResolved targetArgumentsResolved targetTransferred, + related⟩ + +/-! ## Exact-content dynamic application -/ + +/-- Erased dynamic application releases the same argument vector in both +machines, consuming at most the rewritten machine's additional heap fuel. -/ +theorem unchangedApplyTransferErased {limits : Validate.Limits} + {validation : Validate.Context} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore baselineOut : Store} + {baselineFuel rewrittenFuel baselineRemaining : Nat} + {arguments : Array RVal} + {baselineResume rewrittenResume : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (resume : StableFrameRel limits validation (fun left right => left = right) + baselineResume rewrittenResume) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + (released : releaseSharedWork baselineFuel baselineStore arguments.toList = + .ok (baselineOut, baselineRemaining)) : + let baselineTarget : Machine := + { store := baselineOut + heapFuel := baselineRemaining + control := .running + { baselineResume with + values := baselineResume.values.push .erased } + baselineStack } + ∃ rewrittenOut rewrittenRemaining, + let rewrittenTarget : Machine := + { store := rewrittenOut + heapFuel := rewrittenRemaining + control := .running + { rewrittenResume with + values := rewrittenResume.values.push .erased } + rewrittenStack } + releaseSharedWork rewrittenFuel rewrittenStore arguments.toList = + .ok (rewrittenOut, rewrittenRemaining) ∧ + ApplyTransfer baselineContext interpretation baselineStore + baselineFuel .erased arguments baselineResume baselineStack + baselineTarget ∧ + ApplyTransfer rewrittenContext interpretation rewrittenStore + rewrittenFuel .erased arguments rewrittenResume rewrittenStack + rewrittenTarget ∧ + StableMachineRel limits validation baselineTarget rewrittenTarget := by + dsimp only + obtain ⟨rewrittenOut, rewrittenRemaining, targetReleased, + outputHeap, outputFuel⟩ := + heap.releaseSharedWork_of_le fuel released + refine ⟨rewrittenOut, rewrittenRemaining, targetReleased, + ApplyTransfer.erased released, ApplyTransfer.erased targetReleased, ?_⟩ + exact .related (fun left right => left = right) (.contents outputHeap) + outputFuel + (.running (resume.push (IxIR1.Sim.RValIso.refl .erased)) stack) + +/-- Under-saturated PAP application performs congruent retain/release work, +allocates the same extended PAP payload, and resumes related callers with the +corresponding fresh location. -/ +theorem unchangedApplyTransferPapUnder {limits : Validate.Limits} + {validation : Validate.Context} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore baselineRetained baselineReleased : Store} + {baselineFuel rewrittenFuel baselineRemaining : Nat} + {location : Nat} {box : NodeBox} + {address : Ix.Compiler.Ixon.Address} {arity : Nat} + {captured arguments : Array RVal} + {baselineResume rewrittenResume : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (resume : StableFrameRel limits validation (fun left right => left = right) + baselineResume rewrittenResume) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + (boxAt : baselineStore.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (retained : RetainSharedMany baselineStore captured baselineRetained) + (released : releaseSharedWork baselineFuel baselineRetained + [.loc location] = .ok (baselineReleased, baselineRemaining)) + (totalUnder : (captured ++ arguments).size < arity) : + let baselineAllocation := baselineReleased.allocNode .shared + (.papN address arity (captured ++ arguments)) + let baselineTarget : Machine := + { store := baselineAllocation.1 + heapFuel := baselineRemaining + control := .running + { baselineResume with + values := baselineResume.values.push (.loc baselineAllocation.2) } + baselineStack } + ∃ rewrittenRetained rewrittenReleased rewrittenRemaining, + let rewrittenAllocation := rewrittenReleased.allocNode .shared + (.papN address arity (captured ++ arguments)) + let rewrittenTarget : Machine := + { store := rewrittenAllocation.1 + heapFuel := rewrittenRemaining + control := .running + { rewrittenResume with + values := rewrittenResume.values.push + (.loc rewrittenAllocation.2) } + rewrittenStack } + RetainSharedMany rewrittenStore captured rewrittenRetained ∧ + releaseSharedWork rewrittenFuel rewrittenRetained [.loc location] = + .ok (rewrittenReleased, rewrittenRemaining) ∧ + ApplyTransfer baselineContext interpretation baselineStore + baselineFuel (.loc location) arguments baselineResume baselineStack + baselineTarget ∧ + ApplyTransfer rewrittenContext interpretation rewrittenStore + rewrittenFuel (.loc location) arguments rewrittenResume + rewrittenStack rewrittenTarget ∧ + StableMachineRel limits validation baselineTarget rewrittenTarget := by + dsimp only + have targetBoxAt : rewrittenStore.get? location = some box := by + rw [← heap.get?_eq location] + exact boxAt + obtain ⟨rewrittenRetained, targetRetained, retainedHeap⟩ := + heap.retainSharedMany retained + obtain ⟨rewrittenReleased, rewrittenRemaining, targetReleased, + releasedHeap, outputFuel⟩ := + retainedHeap.releaseSharedWork_of_le fuel released + have locationEq : + (baselineReleased.allocNode .shared + (.papN address arity (captured ++ arguments))).2 = + (rewrittenReleased.allocNode .shared + (.papN address arity (captured ++ arguments))).2 := + releasedHeap.allocNode_location .shared + (.papN address arity (captured ++ arguments)) + have outputHeap : HeapContentsEq + (baselineReleased.allocNode .shared + (.papN address arity (captured ++ arguments))).1 + (rewrittenReleased.allocNode .shared + (.papN address arity (captured ++ arguments))).1 := + releasedHeap.allocNode .shared + (.papN address arity (captured ++ arguments)) + refine ⟨rewrittenRetained, rewrittenReleased, rewrittenRemaining, + targetRetained, targetReleased, ?_, ?_, ?_⟩ + · exact ApplyTransfer.papUnder boxAt shared node capturedUnder retained + released totalUnder + · exact ApplyTransfer.papUnder targetBoxAt shared node capturedUnder + targetRetained targetReleased totalUnder + · exact .related (fun left right => left = right) (.contents outputHeap) + outputFuel + (.running (resume.push (IxIR1.Sim.RValIso.loc locationEq)) stack) + +/-- Saturated and over-saturated PAP application enter related declaration +rewrites. The shared captured vector is retained/released congruently, while +the common excess vector selects related `resume` or `applyMore` +continuations. -/ +theorem unchangedApplyTransferPapFn {limits : Validate.Limits} + {validation : Validate.Context} {calleeSource : Function} + (calleeRewrite : Reuse.FunctionRewrite limits validation calleeSource) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore baselineRetained baselineReleased : Store} + {baselineFuel rewrittenFuel baselineRemaining : Nat} + {location : Nat} {box : NodeBox} + {address : Ix.Compiler.Ixon.Address} {arity : Nat} + {captured arguments : Array RVal} + {baselineResume rewrittenResume : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (resume : StableFrameRel limits validation (fun left right => left = right) + baselineResume rewrittenResume) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + (boxAt : baselineStore.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (retained : RetainSharedMany baselineStore captured baselineRetained) + (released : releaseSharedWork baselineFuel baselineRetained + [.loc location] = .ok (baselineReleased, baselineRemaining)) + (totalEnough : arity ≤ (captured ++ arguments).size) + (baselineDeclaration : baselineContext.declarations address = + some (.fn calleeSource)) + (rewrittenDeclaration : rewrittenContext.declarations address = + some (.fn calleeRewrite.definition)) + (papSafe : calleeSource.signature.papSafe = true) + (suppliedArity : + ((captured ++ arguments).extract 0 arity).size = + calleeSource.signature.params.size) + (nonempty : calleeSource.blocks.isEmpty = false) : + let total := captured ++ arguments + let supplied := total.extract 0 arity + let remaining := total.extract arity total.size + let baselineContinuation : Continuation := + if remaining.isEmpty then .resume baselineResume + else .applyMore remaining baselineResume + let rewrittenContinuation : Continuation := + if remaining.isEmpty then .resume rewrittenResume + else .applyMore remaining rewrittenResume + let baselineTarget : Machine := + { store := baselineReleased + heapFuel := baselineRemaining + control := .running + { definition := calleeSource, values := supplied } + (baselineContinuation :: baselineStack) } + ∃ rewrittenRetained rewrittenReleased rewrittenRemaining, + let rewrittenTarget : Machine := + { store := rewrittenReleased + heapFuel := rewrittenRemaining + control := .running + { definition := calleeRewrite.definition, values := supplied } + (rewrittenContinuation :: rewrittenStack) } + RetainSharedMany rewrittenStore captured rewrittenRetained ∧ + releaseSharedWork rewrittenFuel rewrittenRetained [.loc location] = + .ok (rewrittenReleased, rewrittenRemaining) ∧ + ApplyTransfer baselineContext interpretation baselineStore + baselineFuel (.loc location) arguments baselineResume baselineStack + baselineTarget ∧ + ApplyTransfer rewrittenContext interpretation rewrittenStore + rewrittenFuel (.loc location) arguments rewrittenResume + rewrittenStack rewrittenTarget ∧ + StableMachineRel limits validation baselineTarget rewrittenTarget := by + dsimp only + have targetBoxAt : rewrittenStore.get? location = some box := by + rw [← heap.get?_eq location] + exact boxAt + obtain ⟨rewrittenRetained, targetRetained, retainedHeap⟩ := + heap.retainSharedMany retained + obtain ⟨rewrittenReleased, rewrittenRemaining, targetReleased, + releasedHeap, outputFuel⟩ := + retainedHeap.releaseSharedWork_of_le fuel released + have targetPapSafe : + calleeRewrite.definition.signature.papSafe = true := by + simpa using papSafe + have targetSuppliedArity : + ((captured ++ arguments).extract 0 arity).size = + calleeRewrite.definition.signature.params.size := by + simpa using suppliedArity + have targetNonempty : + calleeRewrite.definition.blocks.isEmpty = false := + calleeRewrite.definition_blocks_nonempty nonempty + let supplied := (captured ++ arguments).extract 0 arity + let remaining := (captured ++ arguments).extract arity + (captured ++ arguments).size + have continuation : StableContinuationIso limits validation + (fun left right => left = right) + (if remaining.isEmpty then .resume baselineResume + else .applyMore remaining baselineResume) + (if remaining.isEmpty then .resume rewrittenResume + else .applyMore remaining rewrittenResume) := + StableContinuationIso.applyMoreOrResume remaining resume + refine ⟨rewrittenRetained, rewrittenReleased, rewrittenRemaining, + targetRetained, targetReleased, ?_, ?_, ?_⟩ + · exact ApplyTransfer.papFn boxAt shared node capturedUnder retained released + totalEnough baselineDeclaration papSafe suppliedArity nonempty + · exact ApplyTransfer.papFn targetBoxAt shared node capturedUnder + targetRetained targetReleased totalEnough rewrittenDeclaration + targetPapSafe targetSuppliedArity targetNonempty + · exact .related (fun left right => left = right) (.contents releasedHeap) + outputFuel + (.running + (StableFrameRel.entry calleeRewrite + (IxIR1.Sim.RValsIso.refl supplied.toList)) + (.cons continuation stack)) + +/-- Exactly saturated PAP application to a scalar extern observes the same +oracle value in both contexts and resumes related callers immediately. -/ +theorem unchangedApplyTransferPapExtern {limits : Validate.Limits} + {validation : Validate.Context} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore baselineRetained baselineReleased : Store} + {baselineFuel rewrittenFuel baselineRemaining : Nat} + {location : Nat} {box : NodeBox} + {address : Ix.Compiler.Ixon.Address} {arity expectedArity : Nat} + {captured arguments : Array RVal} {value : RVal} + {baselineResume rewrittenResume : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (resume : StableFrameRel limits validation (fun left right => left = right) + baselineResume rewrittenResume) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + (oracles : baselineContext.oracle = rewrittenContext.oracle) + (boxAt : baselineStore.get? location = some box) + (shared : box.world = .shared) + (node : box.node = .papN address arity captured) + (capturedUnder : captured.size < arity) + (retained : RetainSharedMany baselineStore captured baselineRetained) + (released : releaseSharedWork baselineFuel baselineRetained + [.loc location] = .ok (baselineReleased, baselineRemaining)) + (totalEnough : arity ≤ (captured ++ arguments).size) + (baselineDeclaration : baselineContext.declarations address = + some (.extern expectedArity)) + (rewrittenDeclaration : rewrittenContext.declarations address = + some (.extern expectedArity)) + (suppliedArity : + ((captured ++ arguments).extract 0 arity).size = expectedArity) + (remainingEmpty : + ((captured ++ arguments).extract arity + (captured ++ arguments).size).isEmpty = true) + (called : ScalarOracleCall baselineContext address + ((captured ++ arguments).extract 0 arity) value) : + let baselineTarget : Machine := + { store := baselineReleased + heapFuel := baselineRemaining + control := .running + { baselineResume with + values := baselineResume.values.push value } + baselineStack } + ∃ rewrittenRetained rewrittenReleased rewrittenRemaining, + let rewrittenTarget : Machine := + { store := rewrittenReleased + heapFuel := rewrittenRemaining + control := .running + { rewrittenResume with + values := rewrittenResume.values.push value } + rewrittenStack } + RetainSharedMany rewrittenStore captured rewrittenRetained ∧ + releaseSharedWork rewrittenFuel rewrittenRetained [.loc location] = + .ok (rewrittenReleased, rewrittenRemaining) ∧ + ScalarOracleCall rewrittenContext address + ((captured ++ arguments).extract 0 arity) value ∧ + ApplyTransfer baselineContext interpretation baselineStore + baselineFuel (.loc location) arguments baselineResume baselineStack + baselineTarget ∧ + ApplyTransfer rewrittenContext interpretation rewrittenStore + rewrittenFuel (.loc location) arguments rewrittenResume + rewrittenStack rewrittenTarget ∧ + StableMachineRel limits validation baselineTarget rewrittenTarget := by + dsimp only + have targetBoxAt : rewrittenStore.get? location = some box := by + rw [← heap.get?_eq location] + exact boxAt + obtain ⟨rewrittenRetained, targetRetained, retainedHeap⟩ := + heap.retainSharedMany retained + obtain ⟨rewrittenReleased, rewrittenRemaining, targetReleased, + releasedHeap, outputFuel⟩ := + retainedHeap.releaseSharedWork_of_le fuel released + have targetCalled : ScalarOracleCall rewrittenContext address + ((captured ++ arguments).extract 0 arity) value := + called.congrOracle oracles + refine ⟨rewrittenRetained, rewrittenReleased, rewrittenRemaining, + targetRetained, targetReleased, targetCalled, ?_, ?_, ?_⟩ + · exact ApplyTransfer.papExtern boxAt shared node capturedUnder retained + released totalEnough baselineDeclaration suppliedArity remainingEmpty + called + · exact ApplyTransfer.papExtern targetBoxAt shared node capturedUnder + targetRetained targetReleased totalEnough rewrittenDeclaration + suppliedArity remainingEmpty targetCalled + · exact .related (fun left right => left = right) (.contents releasedHeap) + outputFuel + (.running (resume.push (IxIR1.Sim.RValIso.refl value)) stack) + +/-- Exhaustive exact-content simulation of an arbitrary successful dynamic +dispatch. The evaluator's case witness selects the corresponding branch +proof, while the program rewrite trace supplies the related function or +preserved extern declaration at a PAP target. -/ +theorem unchangedApplyTransfer {limits : Validate.Limits} + {validation : Validate.Context} {sourceProgram : Program} + (trace : Reuse.Trace limits validation sourceProgram) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {function : RVal} {arguments : Array RVal} + {baselineResume rewrittenResume : Frame} + {baselineStack rewrittenStack : List Continuation} + {baselineTarget : Machine} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (resume : StableFrameRel limits validation (fun left right => left = right) + baselineResume rewrittenResume) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + (transferred : ApplyTransfer + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation baselineStore baselineFuel function arguments + baselineResume baselineStack baselineTarget) : + ∃ rewrittenTarget, + ApplyTransfer + (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation rewrittenStore rewrittenFuel function arguments + rewrittenResume rewrittenStack rewrittenTarget ∧ + StableMachineRel limits validation baselineTarget rewrittenTarget := by + have classified := transferred.classify + cases classified with + | erased released => + obtain ⟨rewrittenOut, rewrittenRemaining, targetReleased, + sourceTransfer, targetTransfer, related⟩ := + unchangedApplyTransferErased + (baselineContext := + Eval.Context.ofProgram sourceProgram validation.schemas oracle) + (rewrittenContext := + Eval.Context.ofProgram trace.target validation.schemas oracle) + (interpretation := interpretation) + heap fuel resume stack released + exact ⟨_, targetTransfer, related⟩ + | papUnder boxAt shared node capturedUnder retained released totalUnder => + obtain ⟨rewrittenRetained, rewrittenReleased, rewrittenRemaining, + targetRetained, targetReleased, sourceTransfer, targetTransfer, + related⟩ := + unchangedApplyTransferPapUnder + (baselineContext := + Eval.Context.ofProgram sourceProgram validation.schemas oracle) + (rewrittenContext := + Eval.Context.ofProgram trace.target validation.schemas oracle) + (interpretation := interpretation) + heap fuel resume stack boxAt shared node capturedUnder retained + released totalUnder + exact ⟨_, targetTransfer, related⟩ + | papFn boxAt shared node capturedUnder retained released totalEnough + declaration papSafe suppliedArity nonempty => + obtain ⟨calleeRewrite, targetDeclaration⟩ := trace.context_fn declaration + obtain ⟨rewrittenRetained, rewrittenReleased, rewrittenRemaining, + targetRetained, targetReleased, sourceTransfer, targetTransfer, + related⟩ := + unchangedApplyTransferPapFn calleeRewrite heap fuel resume stack boxAt + shared node capturedUnder retained released totalEnough declaration + targetDeclaration papSafe suppliedArity nonempty + exact ⟨_, targetTransfer, related⟩ + | papExtern boxAt shared node capturedUnder retained released totalEnough + declaration suppliedArity remainingEmpty called => + have targetDeclaration := trace.context_extern declaration + obtain ⟨rewrittenRetained, rewrittenReleased, rewrittenRemaining, + targetRetained, targetReleased, targetCalled, sourceTransfer, + targetTransfer, related⟩ := + unchangedApplyTransferPapExtern + (baselineContext := + Eval.Context.ofProgram sourceProgram validation.schemas oracle) + (rewrittenContext := + Eval.Context.ofProgram trace.target validation.schemas oracle) + (interpretation := interpretation) + heap fuel resume stack rfl boxAt shared node capturedUnder retained + released totalEnough declaration targetDeclaration suppliedArity + remainingEmpty called + exact ⟨_, targetTransfer, related⟩ + +/-- Lift any already-related dynamic dispatch through an unchanged `apply` +instruction. Branch-specific transfer theorems discharge the three +successful runtime shapes without duplicating instruction decoding. -/ +theorem unchangedApplyStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + {baselineTarget rewrittenTarget : Machine} + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + {block : Block} {functionAtom : Atom} {argumentAtoms : Array Atom} + {function : RVal} {arguments : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .apply functionAtom argumentAtoms) + (noCredits : NoLiveCredits baselineFrame) + (functionResolved : resolveAtom baselineFrame.values functionAtom = + .ok function) + (argumentsResolved : resolveAtoms baselineFrame.values argumentAtoms = + .ok arguments) + (baselineTransferred : ApplyTransfer baselineContext interpretation + baselineStore baselineFuel function arguments + { baselineFrame with pc := baselineFrame.pc + 1 } + baselineStack baselineTarget) + (rewrittenTransferred : ApplyTransfer rewrittenContext interpretation + rewrittenStore rewrittenFuel function arguments + { rewrittenFrame with pc := rewrittenFrame.pc + 1 } + rewrittenStack rewrittenTarget) + (related : StableMachineRel limits validation baselineTarget + rewrittenTarget) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + Step baselineContext interpretation baselineMachine baselineTarget ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenTarget ∧ + StableMachineRel limits validation baselineTarget rewrittenTarget := by + dsimp only + have pcs : baselineFrame.pc = rewrittenFrame.pc := frame.pc + have targetPc : rewrittenFrame.pc < block.instructions.size := by + omega + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .apply functionAtom argumentAtoms := by + simpa only [← pcs] using instruction + have targetNoCredits : NoLiveCredits rewrittenFrame := by + unfold NoLiveCredits at noCredits ⊢ + rw [← frame.credits_eq] + exact noCredits + have targetFunctionResolved : + resolveAtom rewrittenFrame.values functionAtom = .ok function := by + rw [← frame.values_eq] + exact functionResolved + have targetArgumentsResolved : + resolveAtoms rewrittenFrame.values argumentAtoms = .ok arguments := by + rw [← frame.values_eq] + exact argumentsResolved + exact ⟨ + Step.applyCleared rfl sourceAt pc instruction noCredits functionResolved + argumentsResolved baselineTransferred, + Step.applyCleared rfl targetAt targetPc targetInstruction targetNoCredits + targetFunctionResolved targetArgumentsResolved rewrittenTransferred, + related⟩ + +/-- A source `apply` transfer in an unchanged block is enough to produce the +rewritten transfer and stable successor. Runtime-case inversion and +declaration selection are discharged internally from the whole-program +rewrite trace. -/ +theorem unchangedApplyStepOfTrace {limits : Validate.Limits} + {validation : Validate.Context} {sourceProgram : Program} + (trace : Reuse.Trace limits validation sourceProgram) + {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + {baselineTarget : Machine} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {functionAtom : Atom} {argumentAtoms : Array Atom} + {function : RVal} {arguments : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .apply functionAtom argumentAtoms) + (noCredits : NoLiveCredits baselineFrame) + (functionResolved : resolveAtom baselineFrame.values functionAtom = + .ok function) + (argumentsResolved : resolveAtoms baselineFrame.values argumentAtoms = + .ok arguments) + (transferred : ApplyTransfer + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation baselineStore baselineFuel function arguments + { baselineFrame with pc := baselineFrame.pc + 1 } + baselineStack baselineTarget) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + ∃ rewrittenTarget, + Step (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation baselineMachine baselineTarget ∧ + Step (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation rewrittenMachine rewrittenTarget ∧ + StableMachineRel limits validation baselineTarget rewrittenTarget := by + dsimp only + have resume : StableFrameRel limits validation + (fun left right => left = right) + { baselineFrame with pc := baselineFrame.pc + 1 } + { rewrittenFrame with pc := rewrittenFrame.pc + 1 } := + .rewritten rewrite frame.advance + obtain ⟨rewrittenTarget, targetTransferred, related⟩ := + unchangedApplyTransfer trace heap fuel resume stack transferred + refine ⟨rewrittenTarget, ?_⟩ + exact unchangedApplyStep rewrite frame sourceAt targetAt pc instruction + noCredits functionResolved argumentsResolved transferred targetTransferred + related + +/-- Lift any already-related dynamic dispatch through an unchanged return-time +`applyMore` continuation. The active callee's result-world check transports +through exact heap contents and its preserved signature. -/ +theorem unchangedRetApplyMoreStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineCaller rewrittenCaller : Frame} + {arguments : Array RVal} + {baselineRest rewrittenRest : List Continuation} + {baselineTarget rewrittenTarget : Machine} + (heap : HeapContentsEq baselineStore rewrittenStore) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + {block : Block} {atom : Atom} {value : RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = .ret atom) + (resolved : resolveAtom baselineFrame.values atom = .ok value) + (noCredits : NoLiveCredits baselineFrame) + (world : value.hasWorld baselineStore + baselineFrame.definition.signature.result = true) + (baselineTransferred : ApplyTransfer baselineContext interpretation + baselineStore baselineFuel value arguments baselineCaller baselineRest + baselineTarget) + (rewrittenTransferred : ApplyTransfer rewrittenContext interpretation + rewrittenStore rewrittenFuel value arguments rewrittenCaller rewrittenRest + rewrittenTarget) + (related : StableMachineRel limits validation baselineTarget + rewrittenTarget) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame + (.applyMore arguments baselineCaller :: baselineRest) } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame + (.applyMore arguments rewrittenCaller :: rewrittenRest) } + Step baselineContext interpretation baselineMachine baselineTarget ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenTarget ∧ + StableMachineRel limits validation baselineTarget rewrittenTarget := by + dsimp only + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + have targetResolved : + resolveAtom rewrittenFrame.values atom = .ok value := by + rw [← frame.values_eq] + exact resolved + have targetNoCredits : NoLiveCredits rewrittenFrame := by + unfold NoLiveCredits at noCredits ⊢ + rw [← frame.credits_eq] + exact noCredits + have resultWorldEq : rewrittenFrame.definition.signature.result = + baselineFrame.definition.signature.result := by + rw [frame.rewrittenDefinition, rewrite.definition_signature, + frame.baselineDefinition] + have targetWorld : value.hasWorld rewrittenStore + rewrittenFrame.definition.signature.result = true := by + rw [resultWorldEq, ← heap.rvalHasWorld_eq] + exact world + exact ⟨ + Step.retApplyMoreCleared rfl sourceAt pc terminator resolved noCredits world + baselineTransferred, + Step.retApplyMoreCleared rfl targetAt targetPc terminator targetResolved + targetNoCredits targetWorld rewrittenTransferred, + related⟩ + +/-- A source return-time `applyMore` transfer likewise determines the target +transfer exhaustively from the rewrite trace. -/ +theorem unchangedRetApplyMoreStepOfTrace {limits : Validate.Limits} + {validation : Validate.Context} {sourceProgram : Program} + (trace : Reuse.Trace limits validation sourceProgram) + {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineCaller rewrittenCaller : Frame} + {arguments : Array RVal} + {baselineRest rewrittenRest : List Continuation} + {baselineTarget : Machine} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (caller : StableFrameRel limits validation (fun left right => left = right) + baselineCaller rewrittenCaller) + (rest : StableStackIso limits validation (fun left right => left = right) + baselineRest rewrittenRest) + {block : Block} {atom : Atom} {value : RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = .ret atom) + (resolved : resolveAtom baselineFrame.values atom = .ok value) + (noCredits : NoLiveCredits baselineFrame) + (world : value.hasWorld baselineStore + baselineFrame.definition.signature.result = true) + (transferred : ApplyTransfer + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation baselineStore baselineFuel value arguments baselineCaller + baselineRest baselineTarget) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame + (.applyMore arguments baselineCaller :: baselineRest) } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame + (.applyMore arguments rewrittenCaller :: rewrittenRest) } + ∃ rewrittenTarget, + Step (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation baselineMachine baselineTarget ∧ + Step (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation rewrittenMachine rewrittenTarget ∧ + StableMachineRel limits validation baselineTarget rewrittenTarget := by + dsimp only + obtain ⟨rewrittenTarget, targetTransferred, related⟩ := + unchangedApplyTransfer trace heap fuel caller rest transferred + refine ⟨rewrittenTarget, ?_⟩ + exact unchangedRetApplyMoreStep rewrite heap frame sourceAt targetAt pc + terminator resolved noCredits world transferred targetTransferred related + +/-! ## Unchanged-block lockstep cases -/ + +/-- The first unchanged instruction case: identical `move` code advances +both related frames in lockstep and preserves exact semantic heap contents. +This is the template consumed by the exhaustive no-op block induction. -/ +theorem unchangedMoveStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {atom : Atom} {value : RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = .move atom) + (resolved : resolveAtom baselineFrame.values atom = .ok value) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values.push value } + baselineStack } + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values.push value } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have pcs : baselineFrame.pc = rewrittenFrame.pc := frame.pc + have targetPc : rewrittenFrame.pc < block.instructions.size := by + omega + have targetInstruction : + block.instructions[rewrittenFrame.pc] = .move atom := by + simpa only [← pcs] using instruction + have targetResolved : + resolveAtom rewrittenFrame.values atom = .ok value := by + rw [← frame.values_eq] + exact resolved + refine ⟨Step.move rfl sourceAt pc instruction resolved, + Step.move rfl targetAt targetPc targetInstruction targetResolved, ?_⟩ + exact .related (fun left right => left = right) (.contents heap) fuel + (.running + (.rewritten rewrite (frame.advancePush (IxIR1.Sim.RValIso.refl value))) + stack) + +/-- Constructor projection from an unchanged block observes the same node and +appends the same field value on exact-content heaps. -/ +theorem unchangedFetchStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {atom : Atom} {cid : CtorId} {field location : Nat} + {box : IxIR1.NodeBox} {fields : Array RVal} {value : RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .fetch atom cid field) + (resolved : resolveAtom baselineFrame.values atom = .ok (.loc location)) + (boxAt : baselineStore.get? location = some box) + (node : box.node = .ctorN cid fields) + (fieldAt : fields[field]? = some value) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values.push value } + baselineStack } + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values.push value } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have pcs : baselineFrame.pc = rewrittenFrame.pc := frame.pc + have targetPc : rewrittenFrame.pc < block.instructions.size := by + omega + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .fetch atom cid field := by + simpa only [← pcs] using instruction + have targetResolved : + resolveAtom rewrittenFrame.values atom = .ok (.loc location) := by + rw [← frame.values_eq] + exact resolved + have targetBoxAt : rewrittenStore.get? location = some box := by + rw [← heap.get?_eq location] + exact boxAt + refine ⟨Step.fetch rfl sourceAt pc instruction resolved boxAt node fieldAt, + Step.fetch rfl targetAt targetPc targetInstruction targetResolved + targetBoxAt node fieldAt, ?_⟩ + exact .related (fun left right => left = right) (.contents heap) fuel + (.running + (.rewritten rewrite (frame.advancePush (IxIR1.Sim.RValIso.refl value))) + stack) + +/-- An unchanged shallow unique free kills the same fixed location on both +exact-content heaps. -/ +theorem unchangedFreeUniqueStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {atom : Atom} {cid : CtorId} {location : Nat} + {box : IxIR1.NodeBox} {fields : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .freeUnique atom cid) + (resolved : resolveAtom baselineFrame.values atom = .ok (.loc location)) + (boxAt : baselineStore.get? location = some box) + (unique : box.world = .unique) + (node : box.node = .ctorN cid fields) + (scalarFields : fields.all RVal.isScalar = true) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with + store := baselineStore.kill location + control := .running + { baselineFrame with pc := baselineFrame.pc + 1 } + baselineStack } + let rewrittenNext : Machine := + { rewrittenMachine with + store := rewrittenStore.kill location + control := .running + { rewrittenFrame with pc := rewrittenFrame.pc + 1 } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have pcs : baselineFrame.pc = rewrittenFrame.pc := frame.pc + have targetPc : rewrittenFrame.pc < block.instructions.size := by + omega + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .freeUnique atom cid := by + simpa only [← pcs] using instruction + have targetResolved : + resolveAtom rewrittenFrame.values atom = .ok (.loc location) := by + rw [← frame.values_eq] + exact resolved + have targetBoxAt : rewrittenStore.get? location = some box := by + rw [← heap.get?_eq location] + exact boxAt + refine ⟨Step.freeUnique rfl sourceAt pc instruction resolved boxAt unique + node scalarFields, + Step.freeUnique rfl targetAt targetPc targetInstruction targetResolved + targetBoxAt unique node scalarFields, ?_⟩ + exact .related (fun left right => left = right) + (.contents (heap.kill location)) fuel + (.running (.rewritten rewrite frame.advance) stack) + +/-- Ordinary allocation in an unchanged block chooses corresponding fresh +locations and preserves exact heap contents. -/ +theorem unchangedAllocStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + (schemas : baselineContext.schemas = rewrittenContext.schemas) + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {world : Owned} {cid : CtorId} + {arguments : Array Atom} {schema : CtorSchema} + {values : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .alloc world cid arguments) + (schemaAt : baselineContext.schemas world cid = some schema) + (resolved : resolveAtoms baselineFrame.values arguments = .ok values) + (fieldWorlds : FieldWorlds baselineStore schema values) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineAllocation := baselineStore.allocNode world (.ctorN cid values) + let rewrittenAllocation := + rewrittenStore.allocNode world (.ctorN cid values) + let baselineNext : Machine := + { store := baselineAllocation.1 + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values.push (.loc baselineAllocation.2) } + baselineStack } + let rewrittenNext : Machine := + { store := rewrittenAllocation.1 + heapFuel := rewrittenFuel + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values.push (.loc rewrittenAllocation.2) } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + let baselineAllocation := baselineStore.allocNode world (.ctorN cid values) + let rewrittenAllocation := + rewrittenStore.allocNode world (.ctorN cid values) + have pcs : baselineFrame.pc = rewrittenFrame.pc := frame.pc + have targetPc : rewrittenFrame.pc < block.instructions.size := by + omega + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .alloc world cid arguments := by + simpa only [← pcs] using instruction + have targetSchemaAt : rewrittenContext.schemas world cid = some schema := by + rw [← schemas] + exact schemaAt + have targetResolved : + resolveAtoms rewrittenFrame.values arguments = .ok values := by + rw [← frame.values_eq] + exact resolved + have targetFieldWorlds : FieldWorlds rewrittenStore schema values := + heap.fieldWorlds fieldWorlds + have locationEq : baselineAllocation.2 = rewrittenAllocation.2 := by + simpa [baselineAllocation, rewrittenAllocation] using + heap.allocNode_location world (.ctorN cid values) + have outputHeap : HeapContentsEq baselineAllocation.1 + rewrittenAllocation.1 := by + simpa [baselineAllocation, rewrittenAllocation] using + heap.allocNode world (.ctorN cid values) + have sourceStep := Step.alloc + (context := baselineContext) (interpretation := interpretation) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction schemaAt resolved fieldWorlds + have targetStep := Step.alloc + (context := rewrittenContext) (interpretation := interpretation) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetSchemaAt targetResolved + targetFieldWorlds + refine ⟨by simpa [baselineAllocation] using sourceStep, + by simpa [rewrittenAllocation] using targetStep, ?_⟩ + exact .related (fun left right => left = right) (.contents outputHeap) fuel + (.running + (.rewritten rewrite + (frame.advancePush (IxIR1.Sim.RValIso.loc locationEq))) + stack) + +/-- An unchanged `allocWith` fed an absent credit consumes the same slot and +falls back to corresponding fresh allocations on exact-content heaps. -/ +theorem unchangedAllocWithAbsentStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + (schemas : baselineContext.schemas = rewrittenContext.schemas) + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTaken : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {creditId : CreditId} {credit : Credit} + {world : Owned} {cid : CtorId} {arguments : Array Atom} + {schema : CtorSchema} {values : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .allocWith creditId world cid arguments) + (schemaAt : baselineContext.schemas world cid = some schema) + (resolved : resolveAtoms baselineFrame.values arguments = .ok values) + (fieldWorlds : FieldWorlds baselineStore schema values) + (taken : CreditTake { baselineFrame with + pc := baselineFrame.pc + 1 } creditId baselineTaken credit) + (layout : credit.layout = schema.layout) + (absent : credit.presence = .absent) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineAllocation := baselineStore.allocNode world (.ctorN cid values) + let rewrittenAllocation := + rewrittenStore.allocNode world (.ctorN cid values) + let rewrittenTaken := + { baselineTaken with definition := rewrite.definition } + let baselineNext : Machine := + { store := baselineAllocation.1 + heapFuel := baselineFuel + control := .running + { baselineTaken with + values := baselineTaken.values.push (.loc baselineAllocation.2) } + baselineStack } + let rewrittenNext : Machine := + { store := rewrittenAllocation.1 + heapFuel := rewrittenFuel + control := .running + { rewrittenTaken with + values := rewrittenTaken.values.push (.loc rewrittenAllocation.2) } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + let baselineAllocation := baselineStore.allocNode world (.ctorN cid values) + let rewrittenAllocation := + rewrittenStore.allocNode world (.ctorN cid values) + have pcs : baselineFrame.pc = rewrittenFrame.pc := frame.pc + have targetPc : rewrittenFrame.pc < block.instructions.size := by + omega + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .allocWith creditId world cid arguments := by + simpa only [← pcs] using instruction + have targetSchemaAt : rewrittenContext.schemas world cid = some schema := by + rw [← schemas] + exact schemaAt + have targetResolved : + resolveAtoms rewrittenFrame.values arguments = .ok values := by + rw [← frame.values_eq] + exact resolved + have targetFieldWorlds : FieldWorlds rewrittenStore schema values := + heap.fieldWorlds fieldWorlds + obtain ⟨targetTaken, takenFrame⟩ := frame.advanceTake taken + have locationEq : baselineAllocation.2 = rewrittenAllocation.2 := by + simpa [baselineAllocation, rewrittenAllocation] using + heap.allocNode_location world (.ctorN cid values) + have outputHeap : HeapContentsEq baselineAllocation.1 + rewrittenAllocation.1 := by + simpa [baselineAllocation, rewrittenAllocation] using + heap.allocNode world (.ctorN cid values) + have sourceStep := Step.allocWithAbsent + (context := baselineContext) (interpretation := interpretation) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction schemaAt resolved fieldWorlds taken layout + absent + have targetStep := Step.allocWithAbsent + (context := rewrittenContext) (interpretation := interpretation) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetSchemaAt targetResolved + targetFieldWorlds targetTaken layout absent + refine ⟨by simpa [baselineAllocation] using sourceStep, + by simpa [rewrittenAllocation] using targetStep, ?_⟩ + exact .related (fun left right => left = right) (.contents outputHeap) fuel + (.running + (.rewritten rewrite + (takenFrame.push (IxIR1.Sim.RValIso.loc locationEq))) + stack) + +/-- A present logical credit records the same opportunity in both runs; +semantic allocation remains fresh and lockstep. -/ +theorem unchangedAllocWithLogicalStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + (schemas : baselineContext.schemas = rewrittenContext.schemas) + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTaken : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {creditId : CreditId} {credit : Credit} + {world : Owned} {cid : CtorId} {arguments : Array Atom} + {schema : CtorSchema} {values : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .allocWith creditId world cid arguments) + (schemaAt : baselineContext.schemas world cid = some schema) + (resolved : resolveAtoms baselineFrame.values arguments = .ok values) + (fieldWorlds : FieldWorlds baselineStore schema values) + (taken : CreditTake { baselineFrame with + pc := baselineFrame.pc + 1 } creditId baselineTaken credit) + (layout : credit.layout = schema.layout) + (present : credit.presence = .present none) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineAllocation := baselineStore.allocNode world (.ctorN cid values) + let rewrittenAllocation := + rewrittenStore.allocNode world (.ctorN cid values) + let rewrittenTaken := + { baselineTaken with definition := rewrite.definition } + let baselineNext : Machine := + { store := baselineAllocation.1 + heapFuel := baselineFuel + control := .running + { baselineTaken with + values := baselineTaken.values.push (.loc baselineAllocation.2) } + baselineStack } + let rewrittenNext : Machine := + { store := rewrittenAllocation.1 + heapFuel := rewrittenFuel + control := .running + { rewrittenTaken with + values := rewrittenTaken.values.push (.loc rewrittenAllocation.2) } + rewrittenStack } + Step baselineContext .logical baselineMachine baselineNext ∧ + Step rewrittenContext .logical rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + let baselineAllocation := baselineStore.allocNode world (.ctorN cid values) + let rewrittenAllocation := + rewrittenStore.allocNode world (.ctorN cid values) + have pcs : baselineFrame.pc = rewrittenFrame.pc := frame.pc + have targetPc : rewrittenFrame.pc < block.instructions.size := by + omega + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .allocWith creditId world cid arguments := by + simpa only [← pcs] using instruction + have targetSchemaAt : rewrittenContext.schemas world cid = some schema := by + rw [← schemas] + exact schemaAt + have targetResolved : + resolveAtoms rewrittenFrame.values arguments = .ok values := by + rw [← frame.values_eq] + exact resolved + have targetFieldWorlds : FieldWorlds rewrittenStore schema values := + heap.fieldWorlds fieldWorlds + obtain ⟨targetTaken, takenFrame⟩ := frame.advanceTake taken + have locationEq : baselineAllocation.2 = rewrittenAllocation.2 := by + simpa [baselineAllocation, rewrittenAllocation] using + heap.allocNode_location world (.ctorN cid values) + have outputHeap : HeapContentsEq baselineAllocation.1 + rewrittenAllocation.1 := by + simpa [baselineAllocation, rewrittenAllocation] using + heap.allocNode world (.ctorN cid values) + have sourceStep := Step.allocWithLogical + (context := baselineContext) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction schemaAt resolved fieldWorlds taken layout + present + have targetStep := Step.allocWithLogical + (context := rewrittenContext) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetSchemaAt targetResolved + targetFieldWorlds targetTaken layout present + refine ⟨by simpa [baselineAllocation] using sourceStep, + by simpa [rewrittenAllocation] using targetStep, ?_⟩ + exact .related (fun left right => left = right) (.contents outputHeap) fuel + (.running + (.rewritten rewrite + (takenFrame.push (IxIR1.Sim.RValIso.loc locationEq))) + stack) + +/-- Physical `allocWith` reuses the same reserved fixed location in both +exact-content heaps and appends that location to related frames. -/ +theorem unchangedAllocWithPhysicalStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + (schemas : baselineContext.schemas = rewrittenContext.schemas) + {baselineStore rewrittenStore baselineOut : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTaken : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {creditId : CreditId} {credit : Credit} + {world : Owned} {cid : CtorId} {arguments : Array Atom} + {schema : CtorSchema} {values : Array RVal} {location : Nat} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .allocWith creditId world cid arguments) + (schemaAt : baselineContext.schemas world cid = some schema) + (resolved : resolveAtoms baselineFrame.values arguments = .ok values) + (fieldWorlds : FieldWorlds baselineStore schema values) + (taken : CreditTake { baselineFrame with + pc := baselineFrame.pc + 1 } creditId baselineTaken credit) + (layout : credit.layout = schema.layout) + (present : credit.presence = .present (some location)) + (reused : baselineStore.reuseReservation location world + (.ctorN cid values) schema.fields.size = .ok baselineOut) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let rewrittenTaken := + { baselineTaken with definition := rewrite.definition } + let baselineNext : Machine := + { store := baselineOut + heapFuel := baselineFuel + control := .running + { baselineTaken with + values := baselineTaken.values.push (.loc location) } + baselineStack } + ∃ rewrittenOut, + let rewrittenNext : Machine := + { store := rewrittenOut + heapFuel := rewrittenFuel + control := .running + { rewrittenTaken with + values := rewrittenTaken.values.push (.loc location) } + rewrittenStack } + rewrittenStore.reuseReservation location world (.ctorN cid values) + schema.fields.size = .ok rewrittenOut ∧ + Step baselineContext .physical baselineMachine baselineNext ∧ + Step rewrittenContext .physical rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have pcs : baselineFrame.pc = rewrittenFrame.pc := frame.pc + have targetPc : rewrittenFrame.pc < block.instructions.size := by + omega + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .allocWith creditId world cid arguments := by + simpa only [← pcs] using instruction + have targetSchemaAt : rewrittenContext.schemas world cid = some schema := by + rw [← schemas] + exact schemaAt + have targetResolved : + resolveAtoms rewrittenFrame.values arguments = .ok values := by + rw [← frame.values_eq] + exact resolved + have targetFieldWorlds : FieldWorlds rewrittenStore schema values := + heap.fieldWorlds fieldWorlds + obtain ⟨targetTaken, takenFrame⟩ := frame.advanceTake taken + obtain ⟨rewrittenOut, targetReused, outputHeap⟩ := + heap.reuseReservation reused + refine ⟨rewrittenOut, targetReused, + Step.allocWithPhysical + (context := baselineContext) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction schemaAt resolved fieldWorlds taken layout + present reused, + Step.allocWithPhysical + (context := rewrittenContext) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetSchemaAt targetResolved + targetFieldWorlds targetTaken layout present targetReused, ?_⟩ + exact .related (fun left right => left = right) (.contents outputHeap) fuel + (.running + (.rewritten rewrite + (takenFrame.push (IxIR1.Sim.RValIso.refl (.loc location)))) + stack) + +/-- Discarding an absent credit consumes the same frame slot and leaves both +exact-content heaps untouched. -/ +theorem unchangedDiscardCreditAbsentStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTaken : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {creditId : CreditId} {credit : Credit} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .discardCredit creditId) + (taken : CreditTake { baselineFrame with + pc := baselineFrame.pc + 1 } creditId baselineTaken credit) + (absent : credit.presence = .absent) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let rewrittenTaken := + { baselineTaken with definition := rewrite.definition } + let baselineNext : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineTaken baselineStack } + let rewrittenNext : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenTaken rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have pcs : baselineFrame.pc = rewrittenFrame.pc := frame.pc + have targetPc : rewrittenFrame.pc < block.instructions.size := by + omega + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .discardCredit creditId := by + simpa only [← pcs] using instruction + obtain ⟨targetTaken, takenFrame⟩ := frame.advanceTake taken + refine ⟨ + Step.discardCreditAbsent + (context := baselineContext) (interpretation := interpretation) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction taken absent, + Step.discardCreditAbsent + (context := rewrittenContext) (interpretation := interpretation) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetTaken absent, ?_⟩ + exact .related (fun left right => left = right) (.contents heap) fuel + (.running (.rewritten rewrite takenFrame) stack) + +/-- Discarding a present logical credit consumes the same slot without a +physical heap action. -/ +theorem unchangedDiscardCreditLogicalStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTaken : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {creditId : CreditId} {credit : Credit} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .discardCredit creditId) + (taken : CreditTake { baselineFrame with + pc := baselineFrame.pc + 1 } creditId baselineTaken credit) + (present : credit.presence = .present none) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let rewrittenTaken := + { baselineTaken with definition := rewrite.definition } + let baselineNext : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineTaken baselineStack } + let rewrittenNext : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenTaken rewrittenStack } + Step baselineContext .logical baselineMachine baselineNext ∧ + Step rewrittenContext .logical rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have pcs : baselineFrame.pc = rewrittenFrame.pc := frame.pc + have targetPc : rewrittenFrame.pc < block.instructions.size := by + omega + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .discardCredit creditId := by + simpa only [← pcs] using instruction + obtain ⟨targetTaken, takenFrame⟩ := frame.advanceTake taken + refine ⟨ + Step.discardCreditLogical + (context := baselineContext) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction taken present, + Step.discardCreditLogical + (context := rewrittenContext) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetTaken present, ?_⟩ + exact .related (fun left right => left = right) (.contents heap) fuel + (.running (.rewritten rewrite takenFrame) stack) + +/-- Discarding a physical credit releases the same reserved fixed location +in both exact-content heaps. -/ +theorem unchangedDiscardCreditPhysicalStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {baselineStore rewrittenStore baselineOut : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTaken : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {creditId : CreditId} {credit : Credit} + {location : Nat} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .discardCredit creditId) + (taken : CreditTake { baselineFrame with + pc := baselineFrame.pc + 1 } creditId baselineTaken credit) + (present : credit.presence = .present (some location)) + (released : baselineStore.releaseReservation location = .ok baselineOut) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let rewrittenTaken := + { baselineTaken with definition := rewrite.definition } + let baselineNext : Machine := + { store := baselineOut + heapFuel := baselineFuel + control := .running baselineTaken baselineStack } + ∃ rewrittenOut, + let rewrittenNext : Machine := + { store := rewrittenOut + heapFuel := rewrittenFuel + control := .running rewrittenTaken rewrittenStack } + rewrittenStore.releaseReservation location = .ok rewrittenOut ∧ + Step baselineContext .physical baselineMachine baselineNext ∧ + Step rewrittenContext .physical rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have pcs : baselineFrame.pc = rewrittenFrame.pc := frame.pc + have targetPc : rewrittenFrame.pc < block.instructions.size := by + omega + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .discardCredit creditId := by + simpa only [← pcs] using instruction + obtain ⟨targetTaken, takenFrame⟩ := frame.advanceTake taken + obtain ⟨rewrittenOut, targetReleased, outputHeap⟩ := + heap.releaseReservation released + refine ⟨rewrittenOut, targetReleased, + Step.discardCreditPhysical + (context := baselineContext) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction taken present released, + Step.discardCreditPhysical + (context := rewrittenContext) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetTaken present + targetReleased, ?_⟩ + exact .related (fun left right => left = right) (.contents outputHeap) fuel + (.running (.rewritten rewrite takenFrame) stack) + +/-- Logical unique extraction observes the same constructor, kills the same +fixed slot, and appends identical fields and required credit. -/ +theorem unchangedTakeUniqueLogicalStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + (schemas : baselineContext.schemas = rewrittenContext.schemas) + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {target : Atom} {cid : CtorId} + {schema : CtorSchema} {location : Nat} {box : IxIR1.NodeBox} + {fields : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .takeUnique target cid) + (schemaAt : baselineContext.schemas .unique cid = some schema) + (resolved : resolveAtom baselineFrame.values target = .ok (.loc location)) + (viewed : ConstructorView baselineStore location .unique cid box fields) + (unitRC : box.rc = 1) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let credit : Credit := + { layout := schema.layout, presence := .present none } + let baselineNext : Machine := + { store := baselineStore.kill location + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values ++ fields + credits := baselineFrame.credits.push (some credit) } + baselineStack } + let rewrittenNext : Machine := + { store := rewrittenStore.kill location + heapFuel := rewrittenFuel + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values ++ fields + credits := rewrittenFrame.credits.push (some credit) } + rewrittenStack } + Step baselineContext .logical baselineMachine baselineNext ∧ + Step rewrittenContext .logical rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have pcs : baselineFrame.pc = rewrittenFrame.pc := frame.pc + have targetPc : rewrittenFrame.pc < block.instructions.size := by + omega + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .takeUnique target cid := by + simpa only [← pcs] using instruction + have targetSchemaAt : rewrittenContext.schemas .unique cid = some schema := by + rw [← schemas] + exact schemaAt + have targetResolved : + resolveAtom rewrittenFrame.values target = .ok (.loc location) := by + rw [← frame.values_eq] + exact resolved + have targetViewed : + ConstructorView rewrittenStore location .unique cid box fields := + heap.constructorView viewed + refine ⟨ + Step.takeUniqueLogical + (context := baselineContext) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction schemaAt resolved viewed unitRC, + Step.takeUniqueLogical + (context := rewrittenContext) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetSchemaAt targetResolved + targetViewed unitRC, ?_⟩ + exact .related (fun left right => left = right) + (.contents (heap.kill location)) fuel + (.running + (.rewritten rewrite (frame.advanceAppendCredit fields + { layout := schema.layout, presence := .present none })) + stack) + +/-- Physical unique extraction reserves the same fixed slot and appends the +same location-bearing required credit in both runs. -/ +theorem unchangedTakeUniquePhysicalStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + (schemas : baselineContext.schemas = rewrittenContext.schemas) + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {target : Atom} {cid : CtorId} + {schema : CtorSchema} {location : Nat} {box : IxIR1.NodeBox} + {fields : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .takeUnique target cid) + (schemaAt : baselineContext.schemas .unique cid = some schema) + (resolved : resolveAtom baselineFrame.values target = .ok (.loc location)) + (viewed : ConstructorView baselineStore location .unique cid box fields) + (unitRC : box.rc = 1) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let credit : Credit := + { layout := schema.layout, presence := .present (some location) } + let baselineNext : Machine := + { store := baselineStore.reserve location + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values ++ fields + credits := baselineFrame.credits.push (some credit) } + baselineStack } + let rewrittenNext : Machine := + { store := rewrittenStore.reserve location + heapFuel := rewrittenFuel + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values ++ fields + credits := rewrittenFrame.credits.push (some credit) } + rewrittenStack } + Step baselineContext .physical baselineMachine baselineNext ∧ + Step rewrittenContext .physical rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have pcs : baselineFrame.pc = rewrittenFrame.pc := frame.pc + have targetPc : rewrittenFrame.pc < block.instructions.size := by + omega + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .takeUnique target cid := by + simpa only [← pcs] using instruction + have targetSchemaAt : rewrittenContext.schemas .unique cid = some schema := by + rw [← schemas] + exact schemaAt + have targetResolved : + resolveAtom rewrittenFrame.values target = .ok (.loc location) := by + rw [← frame.values_eq] + exact resolved + have targetViewed : + ConstructorView rewrittenStore location .unique cid box fields := + heap.constructorView viewed + refine ⟨ + Step.takeUniquePhysical + (context := baselineContext) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction schemaAt resolved viewed unitRC, + Step.takeUniquePhysical + (context := rewrittenContext) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetSchemaAt targetResolved + targetViewed unitRC, ?_⟩ + exact .related (fun left right => left = right) + (.contents (heap.reserve location)) fuel + (.running + (.rewritten rewrite (frame.advanceAppendCredit fields + { layout := schema.layout, + presence := .present (some location) })) + stack) + +/-- A hot logical shared reset kills the same fixed slot, records the same +counter-insensitive heap contents, and appends an identical present credit. -/ +theorem unchangedResetSharedLogicalHotStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + (schemas : baselineContext.schemas = rewrittenContext.schemas) + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {target : Atom} {cid : CtorId} + {schema : CtorSchema} {location : Nat} {box : IxIR1.NodeBox} + {fields : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .resetShared target cid) + (schemaAt : baselineContext.schemas .shared cid = some schema) + (resolved : resolveAtom baselineFrame.values target = .ok (.loc location)) + (viewed : ConstructorView baselineStore location .shared cid box fields) + (unitRC : box.rc = 1) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let credit : Credit := + { layout := schema.layout, presence := .present none } + let baselineNext : Machine := + { store := ((baselineStore.tickResetAttempt).kill location).tickHotReset + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values ++ fields + credits := baselineFrame.credits.push (some credit) } + baselineStack } + let rewrittenNext : Machine := + { store := ((rewrittenStore.tickResetAttempt).kill location).tickHotReset + heapFuel := rewrittenFuel + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values ++ fields + credits := rewrittenFrame.credits.push (some credit) } + rewrittenStack } + Step baselineContext .logical baselineMachine baselineNext ∧ + Step rewrittenContext .logical rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have pcs : baselineFrame.pc = rewrittenFrame.pc := frame.pc + have targetPc : rewrittenFrame.pc < block.instructions.size := by + omega + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .resetShared target cid := by + simpa only [← pcs] using instruction + have targetSchemaAt : rewrittenContext.schemas .shared cid = some schema := by + rw [← schemas] + exact schemaAt + have targetResolved : + resolveAtom rewrittenFrame.values target = .ok (.loc location) := by + rw [← frame.values_eq] + exact resolved + have targetViewed : + ConstructorView rewrittenStore location .shared cid box fields := + heap.constructorView viewed + refine ⟨ + Step.resetSharedLogicalHot + (context := baselineContext) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction schemaAt resolved viewed unitRC, + Step.resetSharedLogicalHot + (context := rewrittenContext) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetSchemaAt targetResolved + targetViewed unitRC, ?_⟩ + exact .related (fun left right => left = right) + (.contents (((heap.tickResetAttempt).kill location).tickHotReset)) fuel + (.running + (.rewritten rewrite (frame.advanceAppendCredit fields + { layout := schema.layout, presence := .present none })) + stack) + +/-- A hot physical shared reset reserves the same fixed slot and appends the +same location-bearing present credit in both runs. -/ +theorem unchangedResetSharedPhysicalHotStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + (schemas : baselineContext.schemas = rewrittenContext.schemas) + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {target : Atom} {cid : CtorId} + {schema : CtorSchema} {location : Nat} {box : IxIR1.NodeBox} + {fields : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .resetShared target cid) + (schemaAt : baselineContext.schemas .shared cid = some schema) + (resolved : resolveAtom baselineFrame.values target = .ok (.loc location)) + (viewed : ConstructorView baselineStore location .shared cid box fields) + (unitRC : box.rc = 1) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let credit : Credit := + { layout := schema.layout, presence := .present (some location) } + let baselineNext : Machine := + { store := + ((baselineStore.tickResetAttempt).reserve location).tickHotReset + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values ++ fields + credits := baselineFrame.credits.push (some credit) } + baselineStack } + let rewrittenNext : Machine := + { store := + ((rewrittenStore.tickResetAttempt).reserve location).tickHotReset + heapFuel := rewrittenFuel + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values ++ fields + credits := rewrittenFrame.credits.push (some credit) } + rewrittenStack } + Step baselineContext .physical baselineMachine baselineNext ∧ + Step rewrittenContext .physical rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have pcs : baselineFrame.pc = rewrittenFrame.pc := frame.pc + have targetPc : rewrittenFrame.pc < block.instructions.size := by + omega + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .resetShared target cid := by + simpa only [← pcs] using instruction + have targetSchemaAt : rewrittenContext.schemas .shared cid = some schema := by + rw [← schemas] + exact schemaAt + have targetResolved : + resolveAtom rewrittenFrame.values target = .ok (.loc location) := by + rw [← frame.values_eq] + exact resolved + have targetViewed : + ConstructorView rewrittenStore location .shared cid box fields := + heap.constructorView viewed + refine ⟨ + Step.resetSharedPhysicalHot + (context := baselineContext) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction schemaAt resolved viewed unitRC, + Step.resetSharedPhysicalHot + (context := rewrittenContext) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetSchemaAt targetResolved + targetViewed unitRC, ?_⟩ + exact .related (fun left right => left = right) + (.contents (((heap.tickResetAttempt).reserve location).tickHotReset)) fuel + (.running + (.rewritten rewrite (frame.advanceAppendCredit fields + { layout := schema.layout, + presence := .present (some location) })) + stack) + +/-- A cold shared reset transports the parent decrement and the entire field +retain loop across exact-content heaps, then appends the common absent credit. -/ +theorem unchangedResetSharedColdStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + (schemas : baselineContext.schemas = rewrittenContext.schemas) + {baselineStore rewrittenStore baselineOut : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {target : Atom} {cid : CtorId} + {schema : CtorSchema} {location : Nat} {box : IxIR1.NodeBox} + {fields : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .resetShared target cid) + (schemaAt : baselineContext.schemas .shared cid = some schema) + (resolved : resolveAtom baselineFrame.values target = .ok (.loc location)) + (viewed : ConstructorView baselineStore location .shared cid box fields) + (shared : 1 < box.rc) + (retained : RetainSharedMany + ((((baselineStore.tickResetAttempt).setBox location + { box with rc := box.rc - 1 }).rcTick).tickColdReset) + fields baselineOut) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let credit : Credit := + { layout := schema.layout, presence := .absent } + let baselineNext : Machine := + { store := baselineOut + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values ++ fields + credits := baselineFrame.credits.push (some credit) } + baselineStack } + ∃ rewrittenOut, + let rewrittenNext : Machine := + { store := rewrittenOut + heapFuel := rewrittenFuel + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values ++ fields + credits := rewrittenFrame.credits.push (some credit) } + rewrittenStack } + RetainSharedMany + ((((rewrittenStore.tickResetAttempt).setBox location + { box with rc := box.rc - 1 }).rcTick).tickColdReset) + fields rewrittenOut ∧ + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have pcs : baselineFrame.pc = rewrittenFrame.pc := frame.pc + have targetPc : rewrittenFrame.pc < block.instructions.size := by + omega + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .resetShared target cid := by + simpa only [← pcs] using instruction + have targetSchemaAt : rewrittenContext.schemas .shared cid = some schema := by + rw [← schemas] + exact schemaAt + have targetResolved : + resolveAtom rewrittenFrame.values target = .ok (.loc location) := by + rw [← frame.values_eq] + exact resolved + have targetViewed : + ConstructorView rewrittenStore location .shared cid box fields := + heap.constructorView viewed + have beforeRetain : HeapContentsEq + ((((baselineStore.tickResetAttempt).setBox location + { box with rc := box.rc - 1 }).rcTick).tickColdReset) + ((((rewrittenStore.tickResetAttempt).setBox location + { box with rc := box.rc - 1 }).rcTick).tickColdReset) := + ((((heap.tickResetAttempt).setBox location + { box with rc := box.rc - 1 }).rcTick).tickColdReset) + obtain ⟨rewrittenOut, targetRetained, outputHeap⟩ := + beforeRetain.retainSharedMany retained + refine ⟨rewrittenOut, targetRetained, + Step.resetSharedCold + (context := baselineContext) (interpretation := interpretation) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction schemaAt resolved viewed shared retained, + Step.resetSharedCold + (context := rewrittenContext) (interpretation := interpretation) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetSchemaAt targetResolved + targetViewed shared targetRetained, ?_⟩ + exact .related (fun left right => left = right) (.contents outputHeap) fuel + (.running + (.rewritten rewrite (frame.advanceAppendCredit fields + { layout := schema.layout, presence := .absent })) + stack) + +/-- An unchanged recursive call enters the two versions of the same function +and pushes related advanced caller frames. -/ +theorem unchangedCallSelfStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {arguments : Array Atom} {values : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .callSelf arguments) + (noCredits : NoLiveCredits baselineFrame) + (resolved : resolveAtoms baselineFrame.values arguments = .ok values) + (arity : values.size = + baselineFrame.definition.signature.params.size) + (nonempty : baselineFrame.definition.blocks.isEmpty = false) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with + control := .running + { definition := baselineFrame.definition, values } + (.resume { baselineFrame with pc := baselineFrame.pc + 1 } :: + baselineStack) } + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running + { definition := rewrittenFrame.definition, values } + (.resume { rewrittenFrame with pc := rewrittenFrame.pc + 1 } :: + rewrittenStack) } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have pcs : baselineFrame.pc = rewrittenFrame.pc := frame.pc + have targetPc : rewrittenFrame.pc < block.instructions.size := by + omega + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .callSelf arguments := by + simpa only [← pcs] using instruction + have targetNoCredits : NoLiveCredits rewrittenFrame := by + unfold NoLiveCredits at noCredits ⊢ + rw [← frame.credits_eq] + exact noCredits + have targetResolved : + resolveAtoms rewrittenFrame.values arguments = .ok values := by + rw [← frame.values_eq] + exact resolved + have sourceArity : values.size = source.signature.params.size := by + simpa [frame.baselineDefinition] using arity + have targetArity : values.size = + rewrittenFrame.definition.signature.params.size := by + simpa [frame.rewrittenDefinition] using sourceArity + have targetNonempty : rewrittenFrame.definition.blocks.isEmpty = false := + blocks_nonempty_of_getElem targetAt + have sourceStep := Step.callSelfCleared + (context := baselineContext) (interpretation := interpretation) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction noCredits resolved arity nonempty + have targetStep := Step.callSelfCleared + (context := rewrittenContext) (interpretation := interpretation) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetNoCredits targetResolved + targetArity targetNonempty + refine ⟨sourceStep, targetStep, ?_⟩ + have callee : StableFrameRel limits validation + (fun left right => left = right) + { definition := baselineFrame.definition, values } + { definition := rewrittenFrame.definition, values } := by + rw [frame.baselineDefinition, frame.rewrittenDefinition] + exact StableFrameRel.entry rewrite (IxIR1.Sim.RValsIso.refl values.toList) + have resume : StableContinuationIso limits validation + (fun left right => left = right) + (.resume { baselineFrame with pc := baselineFrame.pc + 1 }) + (.resume { rewrittenFrame with pc := rewrittenFrame.pc + 1 }) := + .resume (.rewritten rewrite frame.advance) + exact .related (fun left right => left = right) (.contents heap) fuel + (.running callee (.cons resume stack)) + +/-- An unchanged direct call follows the declaration rewrite selected at the +same address and pushes related advanced caller frames. -/ +theorem unchangedCallFnStep {limits : Validate.Limits} + {validation : Validate.Context} {callerSource calleeSource : Function} + (callerRewrite : Reuse.FunctionRewrite limits validation callerSource) + (calleeRewrite : Reuse.FunctionRewrite limits validation calleeSource) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso callerRewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {address : Ix.Compiler.Ixon.Address} + {arguments : Array Atom} {values : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .call address arguments) + (noCredits : NoLiveCredits baselineFrame) + (resolved : resolveAtoms baselineFrame.values arguments = .ok values) + (baselineDeclaration : baselineContext.declarations address = + some (.fn calleeSource)) + (rewrittenDeclaration : rewrittenContext.declarations address = + some (.fn calleeRewrite.definition)) + (arity : values.size = calleeSource.signature.params.size) + (nonempty : calleeSource.blocks.isEmpty = false) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with + control := .running { definition := calleeSource, values } + (.resume { baselineFrame with pc := baselineFrame.pc + 1 } :: + baselineStack) } + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running + { definition := calleeRewrite.definition, values } + (.resume { rewrittenFrame with pc := rewrittenFrame.pc + 1 } :: + rewrittenStack) } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have pcs : baselineFrame.pc = rewrittenFrame.pc := frame.pc + have targetPc : rewrittenFrame.pc < block.instructions.size := by + omega + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .call address arguments := by + simpa only [← pcs] using instruction + have targetNoCredits : NoLiveCredits rewrittenFrame := by + unfold NoLiveCredits at noCredits ⊢ + rw [← frame.credits_eq] + exact noCredits + have targetResolved : + resolveAtoms rewrittenFrame.values arguments = .ok values := by + rw [← frame.values_eq] + exact resolved + have targetArity : values.size = + calleeRewrite.definition.signature.params.size := by + simpa using arity + have targetNonempty : calleeRewrite.definition.blocks.isEmpty = false := + calleeRewrite.definition_blocks_nonempty nonempty + have sourceStep := Step.callFnCleared + (context := baselineContext) (interpretation := interpretation) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction noCredits resolved baselineDeclaration arity + nonempty + have targetStep := Step.callFnCleared + (context := rewrittenContext) (interpretation := interpretation) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetNoCredits targetResolved + rewrittenDeclaration targetArity targetNonempty + refine ⟨sourceStep, targetStep, ?_⟩ + have callee : StableFrameRel limits validation + (fun left right => left = right) + { definition := calleeSource, values } + { definition := calleeRewrite.definition, values } := + StableFrameRel.entry calleeRewrite (IxIR1.Sim.RValsIso.refl values.toList) + have resume : StableContinuationIso limits validation + (fun left right => left = right) + (.resume { baselineFrame with pc := baselineFrame.pc + 1 }) + (.resume { rewrittenFrame with pc := rewrittenFrame.pc + 1 }) := + .resume (.rewritten callerRewrite frame.advance) + exact .related (fun left right => left = right) (.contents heap) fuel + (.running callee (.cons resume stack)) + +/-- An unchanged partial application allocates equal PAP payloads in +exact-content heaps; the declaration rewrite preserves the target signature +and PAP-safety bit used by the runtime check. -/ +theorem unchangedPappFnStep {limits : Validate.Limits} + {validation : Validate.Context} {callerSource calleeSource : Function} + (callerRewrite : Reuse.FunctionRewrite limits validation callerSource) + (calleeRewrite : Reuse.FunctionRewrite limits validation calleeSource) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso callerRewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {address : Ix.Compiler.Ixon.Address} + {arguments : Array Atom} {values : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .papp address arguments) + (noCredits : NoLiveCredits baselineFrame) + (baselineDeclaration : baselineContext.declarations address = + some (.fn calleeSource)) + (rewrittenDeclaration : rewrittenContext.declarations address = + some (.fn calleeRewrite.definition)) + (papSafe : calleeSource.signature.papSafe = true) + (resolved : resolveAtoms baselineFrame.values arguments = .ok values) + (under : values.size < calleeSource.signature.params.size) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineAllocation := baselineStore.allocNode .shared + (.papN address calleeSource.signature.params.size values) + let rewrittenAllocation := rewrittenStore.allocNode .shared + (.papN address calleeSource.signature.params.size values) + let baselineNext : Machine := + { store := baselineAllocation.1 + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values.push (.loc baselineAllocation.2) } + baselineStack } + let rewrittenNext : Machine := + { store := rewrittenAllocation.1 + heapFuel := rewrittenFuel + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values.push (.loc rewrittenAllocation.2) } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + let baselineAllocation := baselineStore.allocNode .shared + (.papN address calleeSource.signature.params.size values) + let rewrittenAllocation := rewrittenStore.allocNode .shared + (.papN address calleeSource.signature.params.size values) + have pcs : baselineFrame.pc = rewrittenFrame.pc := frame.pc + have targetPc : rewrittenFrame.pc < block.instructions.size := by + omega + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .papp address arguments := by + simpa only [← pcs] using instruction + have targetNoCredits : NoLiveCredits rewrittenFrame := by + unfold NoLiveCredits at noCredits ⊢ + rw [← frame.credits_eq] + exact noCredits + have targetPapSafe : calleeRewrite.definition.signature.papSafe = true := by + simpa using papSafe + have targetResolved : + resolveAtoms rewrittenFrame.values arguments = .ok values := by + rw [← frame.values_eq] + exact resolved + have targetUnder : + values.size < calleeRewrite.definition.signature.params.size := by + simpa using under + have locationEq : baselineAllocation.2 = rewrittenAllocation.2 := by + simpa [baselineAllocation, rewrittenAllocation] using + heap.allocNode_location .shared + (.papN address calleeSource.signature.params.size values) + have outputHeap : HeapContentsEq baselineAllocation.1 + rewrittenAllocation.1 := by + simpa [baselineAllocation, rewrittenAllocation] using + heap.allocNode .shared + (.papN address calleeSource.signature.params.size values) + have sourceStep := Step.pappFnCleared + (context := baselineContext) (interpretation := interpretation) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction noCredits baselineDeclaration papSafe resolved + under + have targetStep := Step.pappFnCleared + (context := rewrittenContext) (interpretation := interpretation) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetNoCredits + rewrittenDeclaration targetPapSafe targetResolved targetUnder + refine ⟨by simpa [baselineAllocation] using sourceStep, + by simpa [rewrittenAllocation] using targetStep, ?_⟩ + exact .related (fun left right => left = right) (.contents outputHeap) fuel + (.running + (.rewritten callerRewrite + (frame.advancePush (IxIR1.Sim.RValIso.loc locationEq))) + stack) + +/-- An unchanged partial application of an extern allocates the same PAP in +exact-content heaps. Extern declarations are preserved literally by a +whole-program reuse trace, so unlike the function-targeted case there is no +callee rewrite to enter. -/ +theorem unchangedPappExternStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {address : Ix.Compiler.Ixon.Address} + {arguments : Array Atom} {values : Array RVal} {arity : Nat} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .papp address arguments) + (noCredits : NoLiveCredits baselineFrame) + (baselineDeclaration : baselineContext.declarations address = + some (.extern arity)) + (rewrittenDeclaration : rewrittenContext.declarations address = + some (.extern arity)) + (resolved : resolveAtoms baselineFrame.values arguments = .ok values) + (under : values.size < arity) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineAllocation := baselineStore.allocNode .shared + (.papN address arity values) + let rewrittenAllocation := rewrittenStore.allocNode .shared + (.papN address arity values) + let baselineNext : Machine := + { store := baselineAllocation.1 + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values.push (.loc baselineAllocation.2) } + baselineStack } + let rewrittenNext : Machine := + { store := rewrittenAllocation.1 + heapFuel := rewrittenFuel + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values.push (.loc rewrittenAllocation.2) } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + let baselineAllocation := baselineStore.allocNode .shared + (.papN address arity values) + let rewrittenAllocation := rewrittenStore.allocNode .shared + (.papN address arity values) + have pcs : baselineFrame.pc = rewrittenFrame.pc := frame.pc + have targetPc : rewrittenFrame.pc < block.instructions.size := by + omega + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .papp address arguments := by + simpa only [← pcs] using instruction + have targetNoCredits : NoLiveCredits rewrittenFrame := by + unfold NoLiveCredits at noCredits ⊢ + rw [← frame.credits_eq] + exact noCredits + have targetResolved : + resolveAtoms rewrittenFrame.values arguments = .ok values := by + rw [← frame.values_eq] + exact resolved + have locationEq : baselineAllocation.2 = rewrittenAllocation.2 := by + simpa [baselineAllocation, rewrittenAllocation] using + heap.allocNode_location .shared (.papN address arity values) + have outputHeap : HeapContentsEq baselineAllocation.1 + rewrittenAllocation.1 := by + simpa [baselineAllocation, rewrittenAllocation] using + heap.allocNode .shared (.papN address arity values) + have sourceStep := Step.pappExternCleared + (context := baselineContext) (interpretation := interpretation) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc instruction noCredits baselineDeclaration resolved under + have targetStep := Step.pappExternCleared + (context := rewrittenContext) (interpretation := interpretation) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc targetInstruction targetNoCredits + rewrittenDeclaration targetResolved under + refine ⟨by simpa [baselineAllocation] using sourceStep, + by simpa [rewrittenAllocation] using targetStep, ?_⟩ + exact .related (fun left right => left = right) (.contents outputHeap) fuel + (.running + (.rewritten rewrite + (frame.advancePush (IxIR1.Sim.RValIso.loc locationEq))) + stack) + +/-- An unchanged scalar extern instruction resolves the same preserved extern +declaration and observes the same oracle result. -/ +theorem unchangedExternStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + (oracles : baselineContext.oracle = rewrittenContext.oracle) + {block : Block} {address : Ix.Compiler.Ixon.Address} + {arguments : Array Atom} {values : Array RVal} + {arity : Nat} {value : RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .extern address arguments) + (noCredits : NoLiveCredits baselineFrame) + (resolved : resolveAtoms baselineFrame.values arguments = .ok values) + (baselineDeclaration : baselineContext.declarations address = + some (.extern arity)) + (rewrittenDeclaration : rewrittenContext.declarations address = + some (.extern arity)) + (argumentArity : values.size = arity) + (called : ScalarOracleCall baselineContext address values value) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values.push value } + baselineStack } + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values.push value } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have pcs : baselineFrame.pc = rewrittenFrame.pc := frame.pc + have targetPc : rewrittenFrame.pc < block.instructions.size := by + omega + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .extern address arguments := by + simpa only [← pcs] using instruction + have targetNoCredits : NoLiveCredits rewrittenFrame := by + unfold NoLiveCredits at noCredits ⊢ + rw [← frame.credits_eq] + exact noCredits + have targetResolved : + resolveAtoms rewrittenFrame.values arguments = .ok values := by + rw [← frame.values_eq] + exact resolved + have targetCalled : + ScalarOracleCall rewrittenContext address values value := + called.congrOracle oracles + refine ⟨Step.externCleared rfl sourceAt pc instruction noCredits resolved + baselineDeclaration argumentArity called, + Step.externCleared rfl targetAt targetPc targetInstruction targetNoCredits + targetResolved rewrittenDeclaration argumentArity targetCalled, ?_⟩ + exact .related (fun left right => left = right) (.contents heap) fuel + (.running + (.rewritten rewrite + (frame.advancePush (IxIR1.Sim.RValIso.refl value))) + stack) + +/-- An unchanged tail-recursive call re-enters the two versions of the +current function without changing either continuation stack. -/ +theorem unchangedTailCallSelfStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {arguments : Array Atom} {values : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = .tailCallSelf arguments) + (noCredits : NoLiveCredits baselineFrame) + (resolved : resolveAtoms baselineFrame.values arguments = .ok values) + (arity : values.size = + baselineFrame.definition.signature.params.size) + (nonempty : baselineFrame.definition.blocks.isEmpty = false) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with + control := .running + { definition := baselineFrame.definition, values } baselineStack } + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running + { definition := rewrittenFrame.definition, values } rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + have targetNoCredits : NoLiveCredits rewrittenFrame := by + unfold NoLiveCredits at noCredits ⊢ + rw [← frame.credits_eq] + exact noCredits + have targetResolved : + resolveAtoms rewrittenFrame.values arguments = .ok values := by + rw [← frame.values_eq] + exact resolved + have sourceArity : values.size = source.signature.params.size := by + simpa [frame.baselineDefinition] using arity + have targetArity : values.size = + rewrittenFrame.definition.signature.params.size := by + simpa [frame.rewrittenDefinition] using sourceArity + have targetNonempty : rewrittenFrame.definition.blocks.isEmpty = false := + blocks_nonempty_of_getElem targetAt + have sourceStep := Step.tailCallSelfCleared + (context := baselineContext) (interpretation := interpretation) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc terminator noCredits resolved arity nonempty + have targetStep := Step.tailCallSelfCleared + (context := rewrittenContext) (interpretation := interpretation) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc terminator targetNoCredits targetResolved + targetArity targetNonempty + refine ⟨sourceStep, targetStep, ?_⟩ + have callee : StableFrameRel limits validation + (fun left right => left = right) + { definition := baselineFrame.definition, values } + { definition := rewrittenFrame.definition, values } := by + rw [frame.baselineDefinition, frame.rewrittenDefinition] + exact StableFrameRel.entry rewrite (IxIR1.Sim.RValsIso.refl values.toList) + exact .related (fun left right => left = right) (.contents heap) fuel + (.running callee stack) + +/-- An unchanged direct tail call selects related source/target declarations +at the same address and enters the rewritten callee with the existing related +stacks. -/ +theorem unchangedTailCallFnStep {limits : Validate.Limits} + {validation : Validate.Context} {callerSource calleeSource : Function} + (callerRewrite : Reuse.FunctionRewrite limits validation callerSource) + (calleeRewrite : Reuse.FunctionRewrite limits validation calleeSource) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso callerRewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {address : Ix.Compiler.Ixon.Address} + {arguments : Array Atom} {values : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = .tailCall address arguments) + (noCredits : NoLiveCredits baselineFrame) + (resolved : resolveAtoms baselineFrame.values arguments = .ok values) + (baselineDeclaration : baselineContext.declarations address = + some (.fn calleeSource)) + (rewrittenDeclaration : rewrittenContext.declarations address = + some (.fn calleeRewrite.definition)) + (arity : values.size = calleeSource.signature.params.size) + (nonempty : calleeSource.blocks.isEmpty = false) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with + control := .running { definition := calleeSource, values } + baselineStack } + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running + { definition := calleeRewrite.definition, values } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + have targetNoCredits : NoLiveCredits rewrittenFrame := by + unfold NoLiveCredits at noCredits ⊢ + rw [← frame.credits_eq] + exact noCredits + have targetResolved : + resolveAtoms rewrittenFrame.values arguments = .ok values := by + rw [← frame.values_eq] + exact resolved + have targetArity : values.size = + calleeRewrite.definition.signature.params.size := by + simpa using arity + have targetNonempty : calleeRewrite.definition.blocks.isEmpty = false := + calleeRewrite.definition_blocks_nonempty nonempty + have sourceStep := Step.tailCallFnCleared + (context := baselineContext) (interpretation := interpretation) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack }) + rfl sourceAt pc terminator noCredits resolved baselineDeclaration arity + nonempty + have targetStep := Step.tailCallFnCleared + (context := rewrittenContext) (interpretation := interpretation) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) + rfl targetAt targetPc terminator targetNoCredits targetResolved + rewrittenDeclaration targetArity targetNonempty + refine ⟨sourceStep, targetStep, ?_⟩ + exact .related (fun left right => left = right) (.contents heap) fuel + (.running + (StableFrameRel.entry calleeRewrite + (IxIR1.Sim.RValsIso.refl values.toList)) + stack) + +/-- An unchanged return through an ordinary continuation pushes the same +value into related suspended callers. Exact heap contents also transport +the result-world check used by the return boundary. -/ +theorem unchangedRetResumeStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineCaller rewrittenCaller : Frame} + {baselineRest rewrittenRest : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (caller : StableFrameRel limits validation (fun left right => left = right) + baselineCaller rewrittenCaller) + (rest : StableStackIso limits validation (fun left right => left = right) + baselineRest rewrittenRest) + {block : Block} {atom : Atom} {value : RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = .ret atom) + (resolved : resolveAtom baselineFrame.values atom = .ok value) + (noCredits : NoLiveCredits baselineFrame) + (world : value.hasWorld baselineStore + baselineFrame.definition.signature.result = true) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame + (.resume baselineCaller :: baselineRest) } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame + (.resume rewrittenCaller :: rewrittenRest) } + let baselineNext : Machine := + { baselineMachine with + control := .running + { baselineCaller with + values := baselineCaller.values.push value } + baselineRest } + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running + { rewrittenCaller with + values := rewrittenCaller.values.push value } + rewrittenRest } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + have targetResolved : + resolveAtom rewrittenFrame.values atom = .ok value := by + rw [← frame.values_eq] + exact resolved + have targetNoCredits : NoLiveCredits rewrittenFrame := by + unfold NoLiveCredits at noCredits ⊢ + rw [← frame.credits_eq] + exact noCredits + have resultWorldEq : rewrittenFrame.definition.signature.result = + baselineFrame.definition.signature.result := by + rw [frame.rewrittenDefinition, rewrite.definition_signature, + frame.baselineDefinition] + have targetWorld : value.hasWorld rewrittenStore + rewrittenFrame.definition.signature.result = true := by + rw [resultWorldEq, ← heap.rvalHasWorld_eq] + exact world + have sourceStep := Step.retResumeCleared + (context := baselineContext) (interpretation := interpretation) + (machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame + (.resume baselineCaller :: baselineRest) }) + rfl sourceAt pc terminator resolved noCredits world + have targetStep := Step.retResumeCleared + (context := rewrittenContext) (interpretation := interpretation) + (machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame + (.resume rewrittenCaller :: rewrittenRest) }) + rfl targetAt targetPc terminator targetResolved targetNoCredits targetWorld + refine ⟨sourceStep, targetStep, ?_⟩ + exact .related (fun left right => left = right) (.contents heap) fuel + (.running (caller.push (IxIR1.Sim.RValIso.refl value)) rest) + +/-- The outermost unchanged return halts both machines with the same value. -/ +theorem unchangedRetHaltStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + {block : Block} {atom : Atom} {value : RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = .ret atom) + (resolved : resolveAtom baselineFrame.values atom = .ok value) + (noCredits : NoLiveCredits baselineFrame) + (world : value.hasWorld baselineStore + baselineFrame.definition.signature.result = true) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame [] } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame [] } + let baselineNext : Machine := + { baselineMachine with control := .halted value } + let rewrittenNext : Machine := + { rewrittenMachine with control := .halted value } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + have targetResolved : + resolveAtom rewrittenFrame.values atom = .ok value := by + rw [← frame.values_eq] + exact resolved + have targetNoCredits : NoLiveCredits rewrittenFrame := by + unfold NoLiveCredits at noCredits ⊢ + rw [← frame.credits_eq] + exact noCredits + have resultWorldEq : rewrittenFrame.definition.signature.result = + baselineFrame.definition.signature.result := by + rw [frame.rewrittenDefinition, rewrite.definition_signature, + frame.baselineDefinition] + have targetWorld : value.hasWorld rewrittenStore + rewrittenFrame.definition.signature.result = true := by + rw [resultWorldEq, ← heap.rvalHasWorld_eq] + exact world + refine ⟨Step.retHaltCleared rfl sourceAt pc terminator resolved noCredits world, + Step.retHaltCleared rfl targetAt targetPc terminator targetResolved + targetNoCredits targetWorld, ?_⟩ + exact .related (fun left right => left = right) (.contents heap) fuel + (.halted (IxIR1.Sim.RValIso.refl value)) + +/-- An unchanged jump transports its checked edge through the rewritten +function's preserved target-block ABI. -/ +theorem unchangedJumpStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTarget : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {edge : Edge} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = .jump edge) + (transferred : EdgeTransfer baselineFrame edge #[] baselineTarget) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let rewrittenTarget := + { baselineTarget with definition := rewrite.definition } + let baselineNext : Machine := + { baselineMachine with + control := .running baselineTarget baselineStack } + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running rewrittenTarget rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + obtain ⟨rewrittenTransfer, targetFrame⟩ := frame.edgeTransfer transferred + refine ⟨Step.jump rfl sourceAt pc terminator transferred, + Step.jump rfl targetAt targetPc terminator rewrittenTransfer, ?_⟩ + exact .related (fun left right => left = right) (.contents heap) fuel + (.running (.rewritten rewrite targetFrame) stack) + +/-- Constructor dispatch observes the same node in exact-content heaps and +then transports the selected edge through the rewritten target ABI. -/ +theorem unchangedSwitchCtorStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTarget : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {scrutinee : Atom} {constructors : Array CtorAlt} + {natPeel : Option NatPeel} {location : Nat} {box : NodeBox} + {cid : CtorId} {fields : Array RVal} {alternative : CtorAlt} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = + .switchValue scrutinee constructors natPeel) + (resolved : resolveAtom baselineFrame.values scrutinee = + .ok (.loc location)) + (boxAt : baselineStore.get? location = some box) + (node : box.node = .ctorN cid fields) + (alternativeAt : constructors.find? (fun candidate => + candidate.cid == cid) = some alternative) + (transferred : EdgeTransfer baselineFrame alternative.edge #[] + baselineTarget) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let rewrittenTarget := + { baselineTarget with definition := rewrite.definition } + let baselineNext : Machine := + { baselineMachine with + control := .running baselineTarget baselineStack } + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running rewrittenTarget rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + have targetResolved : resolveAtom rewrittenFrame.values scrutinee = + .ok (.loc location) := by + rw [← frame.values_eq] + exact resolved + have targetBoxAt : rewrittenStore.get? location = some box := by + rw [← heap.get?_eq] + exact boxAt + obtain ⟨rewrittenTransfer, targetFrame⟩ := + frame.edgeTransfer transferred + refine ⟨Step.switchCtor rfl sourceAt pc terminator resolved boxAt node + alternativeAt transferred, + Step.switchCtor rfl targetAt targetPc terminator targetResolved + targetBoxAt node alternativeAt rewrittenTransfer, ?_⟩ + exact .related (fun left right => left = right) (.contents heap) fuel + (.running (.rewritten rewrite targetFrame) stack) + +/-- The zero arm of an unchanged literal-Nat switch follows the corresponding +rewritten edge. -/ +theorem unchangedSwitchNatZeroStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTarget : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {scrutinee : Atom} {constructors : Array CtorAlt} + {peel : NatPeel} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = + .switchValue scrutinee constructors (some peel)) + (resolved : resolveAtom baselineFrame.values scrutinee = + .ok (.lit (.nat 0))) + (transferred : EdgeTransfer baselineFrame peel.zero #[] baselineTarget) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let rewrittenTarget := + { baselineTarget with definition := rewrite.definition } + let baselineNext : Machine := + { baselineMachine with + control := .running baselineTarget baselineStack } + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running rewrittenTarget rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + have targetResolved : resolveAtom rewrittenFrame.values scrutinee = + .ok (.lit (.nat 0)) := by + rw [← frame.values_eq] + exact resolved + obtain ⟨rewrittenTransfer, targetFrame⟩ := + frame.edgeTransfer transferred + refine ⟨Step.switchNatZero rfl sourceAt pc terminator resolved transferred, + Step.switchNatZero rfl targetAt targetPc terminator targetResolved + rewrittenTransfer, ?_⟩ + exact .related (fun left right => left = right) (.contents heap) fuel + (.running (.rewritten rewrite targetFrame) stack) + +/-- The successor arm of an unchanged literal-Nat switch preserves its +implicit predecessor value while transporting the explicit edge. -/ +theorem unchangedSwitchNatSuccStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTarget : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {scrutinee : Atom} {constructors : Array CtorAlt} + {peel : NatPeel} {predecessor : Nat} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = + .switchValue scrutinee constructors (some peel)) + (resolved : resolveAtom baselineFrame.values scrutinee = + .ok (.lit (.nat (predecessor + 1)))) + (transferred : EdgeTransfer baselineFrame peel.succ + #[.lit (.nat predecessor)] baselineTarget) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let rewrittenTarget := + { baselineTarget with definition := rewrite.definition } + let baselineNext : Machine := + { baselineMachine with + control := .running baselineTarget baselineStack } + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running rewrittenTarget rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + have targetResolved : resolveAtom rewrittenFrame.values scrutinee = + .ok (.lit (.nat (predecessor + 1))) := by + rw [← frame.values_eq] + exact resolved + obtain ⟨rewrittenTransfer, targetFrame⟩ := + frame.edgeTransfer transferred + refine ⟨Step.switchNatSucc rfl sourceAt pc terminator resolved transferred, + Step.switchNatSucc rfl targetAt targetPc terminator targetResolved + rewrittenTransfer, ?_⟩ + exact .related (fun left right => left = right) (.contents heap) fuel + (.running (.rewritten rewrite targetFrame) stack) + +/-- A present optional credit selects the same unchanged branch and carries +its checked edge into the rewritten definition. -/ +theorem unchangedBranchCreditPresentStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTarget : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {creditId : CreditId} {credit : Credit} + {someEdge noneEdge : Edge} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = + .branchCredit creditId someEdge noneEdge) + (lookedUp : CreditLookup baselineFrame creditId credit) + (present : credit.isPresent = true) + (transferred : EdgeTransfer baselineFrame someEdge #[] baselineTarget) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let rewrittenTarget := + { baselineTarget with definition := rewrite.definition } + let baselineNext : Machine := + { baselineMachine with + control := .running baselineTarget baselineStack } + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running rewrittenTarget rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + have targetLookup := lookedUp.congrDefinition rewrite.definition + rw [← frame.rewritten_eq] at targetLookup + obtain ⟨rewrittenTransfer, targetFrame⟩ := + frame.edgeTransfer transferred + refine ⟨Step.branchCreditPresent rfl sourceAt pc terminator lookedUp + present transferred, + Step.branchCreditPresent rfl targetAt targetPc terminator targetLookup + present rewrittenTransfer, ?_⟩ + exact .related (fun left right => left = right) (.contents heap) fuel + (.running (.rewritten rewrite targetFrame) stack) + +/-- An absent optional credit selects and transports the same fallback edge. -/ +theorem unchangedBranchCreditAbsentStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTarget : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {creditId : CreditId} {credit : Credit} + {someEdge noneEdge : Edge} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = + .branchCredit creditId someEdge noneEdge) + (lookedUp : CreditLookup baselineFrame creditId credit) + (absent : credit.isPresent = false) + (transferred : EdgeTransfer baselineFrame noneEdge #[] baselineTarget) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let rewrittenTarget := + { baselineTarget with definition := rewrite.definition } + let baselineNext : Machine := + { baselineMachine with + control := .running baselineTarget baselineStack } + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running rewrittenTarget rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + have targetLookup := lookedUp.congrDefinition rewrite.definition + rw [← frame.rewritten_eq] at targetLookup + obtain ⟨rewrittenTransfer, targetFrame⟩ := + frame.edgeTransfer transferred + refine ⟨Step.branchCreditAbsent rfl sourceAt pc terminator lookedUp + absent transferred, + Step.branchCreditAbsent rfl targetAt targetPc terminator targetLookup + absent rewrittenTransfer, ?_⟩ + exact .related (fun left right => left = right) (.contents heap) fuel + (.running (.rewritten rewrite targetFrame) stack) + +/-- An unchanged shared retain executes on both exact-content heaps and +preserves the stable relation. -/ +theorem unchangedRetainSharedStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore baselineOut : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {atom : Atom} {value : RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .retainShared atom) + (resolved : resolveAtom baselineFrame.values atom = .ok value) + (retained : Eval.retainShared baselineStore value = .ok baselineOut) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { store := baselineOut + heapFuel := baselineFuel + control := .running + { baselineFrame with + pc := baselineFrame.pc + 1 + values := baselineFrame.values.push value } + baselineStack } + ∃ rewrittenOut, + let rewrittenNext : Machine := + { store := rewrittenOut + heapFuel := rewrittenFuel + control := .running + { rewrittenFrame with + pc := rewrittenFrame.pc + 1 + values := rewrittenFrame.values.push value } + rewrittenStack } + Eval.retainShared rewrittenStore value = .ok rewrittenOut ∧ + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have pcs : baselineFrame.pc = rewrittenFrame.pc := frame.pc + have targetPc : rewrittenFrame.pc < block.instructions.size := by + omega + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .retainShared atom := by + simpa only [← pcs] using instruction + have targetResolved : + resolveAtom rewrittenFrame.values atom = .ok value := by + rw [← frame.values_eq] + exact resolved + obtain ⟨rewrittenOut, targetRetained, outputHeap⟩ := + heap.retainShared retained + refine ⟨rewrittenOut, targetRetained, + Step.retainShared rfl sourceAt pc instruction resolved retained, + Step.retainShared rfl targetAt targetPc targetInstruction + targetResolved targetRetained, ?_⟩ + exact .related (fun left right => left = right) (.contents outputHeap) fuel + (.running + (.rewritten rewrite (frame.advancePush (IxIR1.Sim.RValIso.refl value))) + stack) + +/-- An unchanged deep shared release remains executable when the rewritten +machine has at least the baseline heap fuel. Any saved fuel is carried into +the rewritten remainder. -/ +theorem unchangedReleaseSharedStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore baselineOut : Store} + {baselineFuel rewrittenFuel baselineRemaining : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {atom : Atom} {value : RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = + .releaseShared atom) + (resolved : resolveAtom baselineFrame.values atom = .ok value) + (released : Eval.releaseShared baselineFuel baselineStore value = + .ok (baselineOut, baselineRemaining)) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { store := baselineOut + heapFuel := baselineRemaining + control := .running + { baselineFrame with pc := baselineFrame.pc + 1 } + baselineStack } + ∃ rewrittenOut rewrittenRemaining, + let rewrittenNext : Machine := + { store := rewrittenOut + heapFuel := rewrittenRemaining + control := .running + { rewrittenFrame with pc := rewrittenFrame.pc + 1 } + rewrittenStack } + Eval.releaseShared rewrittenFuel rewrittenStore value = + .ok (rewrittenOut, rewrittenRemaining) ∧ + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have pcs : baselineFrame.pc = rewrittenFrame.pc := frame.pc + have targetPc : rewrittenFrame.pc < block.instructions.size := by + omega + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .releaseShared atom := by + simpa only [← pcs] using instruction + have targetResolved : + resolveAtom rewrittenFrame.values atom = .ok value := by + rw [← frame.values_eq] + exact resolved + obtain ⟨rewrittenOut, rewrittenRemaining, targetReleased, + outputHeap, outputFuel⟩ := + heap.releaseShared_of_le fuel released + refine ⟨rewrittenOut, rewrittenRemaining, targetReleased, + Step.releaseShared rfl sourceAt pc instruction resolved released, + Step.releaseShared rfl targetAt targetPc targetInstruction + targetResolved targetReleased, ?_⟩ + exact .related (fun left right => left = right) (.contents outputHeap) + outputFuel + (.running (.rewritten rewrite frame.advance) stack) + +/-- The unchanged unique-drop case has the same fuel-dominance behavior as +shared release. -/ +theorem unchangedDropUniqueStep {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore baselineOut : Store} + {baselineFuel rewrittenFuel baselineRemaining : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {atom : Atom} {value : RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instruction : block.instructions[baselineFrame.pc] = .dropUnique atom) + (resolved : resolveAtom baselineFrame.values atom = .ok value) + (dropped : Eval.dropUnique baselineFuel baselineStore value = + .ok (baselineOut, baselineRemaining)) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { store := baselineOut + heapFuel := baselineRemaining + control := .running + { baselineFrame with pc := baselineFrame.pc + 1 } + baselineStack } + ∃ rewrittenOut rewrittenRemaining, + let rewrittenNext : Machine := + { store := rewrittenOut + heapFuel := rewrittenRemaining + control := .running + { rewrittenFrame with pc := rewrittenFrame.pc + 1 } + rewrittenStack } + Eval.dropUnique rewrittenFuel rewrittenStore value = + .ok (rewrittenOut, rewrittenRemaining) ∧ + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have pcs : baselineFrame.pc = rewrittenFrame.pc := frame.pc + have targetPc : rewrittenFrame.pc < block.instructions.size := by + omega + have targetInstruction : block.instructions[rewrittenFrame.pc] = + .dropUnique atom := by + simpa only [← pcs] using instruction + have targetResolved : + resolveAtom rewrittenFrame.values atom = .ok value := by + rw [← frame.values_eq] + exact resolved + obtain ⟨rewrittenOut, rewrittenRemaining, targetDropped, + outputHeap, outputFuel⟩ := heap.dropUnique_of_le fuel dropped + refine ⟨rewrittenOut, rewrittenRemaining, targetDropped, + Step.dropUnique rfl sourceAt pc instruction resolved dropped, + Step.dropUnique rfl targetAt targetPc targetInstruction + targetResolved targetDropped, ?_⟩ + exact .related (fun left right => left = right) (.contents outputHeap) + outputFuel + (.running (.rewritten rewrite frame.advance) stack) + +/-! ## Exhaustive unchanged-block dispatch -/ + +set_option maxHeartbeats 1000000 in +/-- Every successful instruction in an unchanged block is equivariant under +an arbitrary allocation-history isomorphism. -/ +theorem unchangedInstructionStepOfTraceIso {limits : Validate.Limits} + {validation : Validate.Context} {sourceProgram : Program} + (trace : Reuse.Trace limits validation sourceProgram) + {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {instruction : Instr} {baselineTarget : Machine} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instructionAt : block.instructions[baselineFrame.pc] = instruction) + (classified : InstructionTransferCase + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation baselineStore baselineFuel baselineFrame baselineStack + instruction baselineTarget) : + ∃ rewrittenTarget, + Step (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + baselineTarget ∧ + Step (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + rewrittenTarget ∧ + StableMachineRel limits validation baselineTarget rewrittenTarget := by + let baselineContext := + Eval.Context.ofProgram sourceProgram validation.schemas oracle + let rewrittenContext := + Eval.Context.ofProgram trace.target validation.schemas oracle + cases classified with + | move resolved => + obtain ⟨rewrittenValue, sourceStep, targetStep, related⟩ := + unchangedMoveStepIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt resolved + exact ⟨_, sourceStep, targetStep, related⟩ + | alloc schemaAt resolved fields => + obtain ⟨rewrittenValues, sourceStep, targetStep, related⟩ := + unchangedAllocStepIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite rfl heap fuel frame + stack sourceAt targetAt pc instructionAt schemaAt resolved fields + exact ⟨_, sourceStep, targetStep, related⟩ + | allocWithAbsent schemaAt resolved fields taken layout absent => + obtain ⟨rewrittenValues, rewrittenTaken, sourceStep, targetStep, + related⟩ := + unchangedAllocWithAbsentStepIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite rfl heap fuel frame + stack sourceAt targetAt pc instructionAt schemaAt resolved fields + taken layout absent + exact ⟨_, sourceStep, targetStep, related⟩ + | allocWithLogical mode schemaAt resolved fields taken layout present => + cases mode + obtain ⟨rewrittenValues, rewrittenTaken, sourceStep, targetStep, + related⟩ := + unchangedAllocWithLogicalStepIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite rfl heap fuel frame + stack sourceAt targetAt pc instructionAt schemaAt resolved fields + taken layout present + exact ⟨_, sourceStep, targetStep, related⟩ + | allocWithPhysical mode schemaAt resolved fields taken layout present + reused => + cases mode + obtain ⟨rewrittenValues, rewrittenTaken, rewrittenLocation, + rewrittenOut, targetReused, sourceStep, targetStep, related⟩ := + unchangedAllocWithPhysicalStepIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite rfl heap fuel frame + stack sourceAt targetAt pc instructionAt schemaAt resolved fields + taken layout present reused + exact ⟨_, sourceStep, targetStep, related⟩ + | discardAbsent taken absent => + obtain ⟨rewrittenTaken, sourceStep, targetStep, related⟩ := + unchangedDiscardCreditAbsentStepIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt taken absent + exact ⟨_, sourceStep, targetStep, related⟩ + | discardLogical mode taken present => + cases mode + obtain ⟨rewrittenTaken, sourceStep, targetStep, related⟩ := + unchangedDiscardCreditLogicalStepIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt taken present + exact ⟨_, sourceStep, targetStep, related⟩ + | discardPhysical mode taken present released => + cases mode + obtain ⟨rewrittenTaken, rewrittenLocation, rewrittenOut, + targetReleased, sourceStep, targetStep, related⟩ := + unchangedDiscardCreditPhysicalStepIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt taken present released + exact ⟨_, sourceStep, targetStep, related⟩ + | takeUniqueLogical mode schemaAt resolved viewed unitRC => + cases mode + obtain ⟨rewrittenLocation, rewrittenFields, sourceStep, targetStep, + related⟩ := + unchangedTakeUniqueLogicalStepIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite rfl heap fuel frame + stack sourceAt targetAt pc instructionAt schemaAt resolved viewed + unitRC + exact ⟨_, sourceStep, targetStep, related⟩ + | takeUniquePhysical mode schemaAt resolved viewed unitRC => + cases mode + obtain ⟨rewrittenLocation, rewrittenFields, sourceStep, targetStep, + related⟩ := + unchangedTakeUniquePhysicalStepIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite rfl heap fuel frame + stack sourceAt targetAt pc instructionAt schemaAt resolved viewed + unitRC + exact ⟨_, sourceStep, targetStep, related⟩ + | resetSharedLogicalHot mode schemaAt resolved viewed unitRC => + cases mode + obtain ⟨rewrittenLocation, rewrittenFields, sourceStep, targetStep, + related⟩ := + unchangedResetSharedLogicalHotStepIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite rfl heap fuel frame + stack sourceAt targetAt pc instructionAt schemaAt resolved viewed + unitRC + exact ⟨_, sourceStep, targetStep, related⟩ + | resetSharedPhysicalHot mode schemaAt resolved viewed unitRC => + cases mode + obtain ⟨rewrittenLocation, rewrittenFields, sourceStep, targetStep, + related⟩ := + unchangedResetSharedPhysicalHotStepIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite rfl heap fuel frame + stack sourceAt targetAt pc instructionAt schemaAt resolved viewed + unitRC + exact ⟨_, sourceStep, targetStep, related⟩ + | resetSharedCold schemaAt resolved viewed shared retained => + obtain ⟨rewrittenFields, rewrittenOut, sourceStep, targetStep, + related⟩ := + unchangedResetSharedColdStepIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite rfl heap fuel frame + stack sourceAt targetAt pc instructionAt schemaAt resolved viewed + shared retained + exact ⟨_, sourceStep, targetStep, related⟩ + | retainShared resolved retained => + obtain ⟨rewrittenValue, rewrittenOut, targetRetained, sourceStep, + targetStep, related⟩ := + unchangedRetainSharedStepIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt resolved retained + exact ⟨_, sourceStep, targetStep, related⟩ + | releaseShared resolved released => + obtain ⟨rewrittenValue, rewrittenOut, rewrittenRemaining, + targetReleased, sourceStep, targetStep, related⟩ := + unchangedReleaseSharedStepIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt resolved released + exact ⟨_, sourceStep, targetStep, related⟩ + | dropUnique resolved dropped => + obtain ⟨rewrittenValue, rewrittenOut, rewrittenRemaining, + targetDropped, sourceStep, targetStep, related⟩ := + unchangedDropUniqueStepIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt resolved dropped + exact ⟨_, sourceStep, targetStep, related⟩ + | freeUnique resolved viewed scalarFields => + obtain ⟨boxAt, unique, node⟩ := viewed.parts + obtain ⟨rewrittenLocation, sourceStep, targetStep, related⟩ := + unchangedFreeUniqueStepIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt resolved boxAt unique node + scalarFields + exact ⟨_, sourceStep, targetStep, related⟩ + | fetch resolved boxAt node fieldAt => + obtain ⟨rewrittenValue, sourceStep, targetStep, related⟩ := + unchangedFetchStepIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt resolved boxAt node fieldAt + exact ⟨_, sourceStep, targetStep, related⟩ + | callFn noCredits resolved declaration arity nonempty => + obtain ⟨calleeRewrite, targetDeclaration⟩ := + trace.context_fn declaration + obtain ⟨rewrittenValues, sourceStep, targetStep, related⟩ := + unchangedCallFnStepIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite calleeRewrite heap fuel + frame stack sourceAt targetAt pc instructionAt noCredits resolved + declaration targetDeclaration arity nonempty + exact ⟨_, sourceStep, targetStep, related⟩ + | callSelf noCredits resolved arity nonempty => + obtain ⟨rewrittenValues, sourceStep, targetStep, related⟩ := + unchangedCallSelfStepIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt noCredits resolved arity nonempty + exact ⟨_, sourceStep, targetStep, related⟩ + | pappFn noCredits declaration papSafe resolved under => + obtain ⟨calleeRewrite, targetDeclaration⟩ := + trace.context_fn declaration + obtain ⟨rewrittenValues, sourceStep, targetStep, related⟩ := + unchangedPappFnStepIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite calleeRewrite heap fuel + frame stack sourceAt targetAt pc instructionAt noCredits declaration + targetDeclaration papSafe resolved under + exact ⟨_, sourceStep, targetStep, related⟩ + | pappExtern noCredits declaration resolved under => + have targetDeclaration := trace.context_extern declaration + obtain ⟨rewrittenValues, sourceStep, targetStep, related⟩ := + unchangedPappExternStepIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt noCredits declaration + targetDeclaration resolved under + exact ⟨_, sourceStep, targetStep, related⟩ + | apply noCredits functionResolved argumentsResolved transferred => + exact unchangedApplyStepOfTraceIso trace rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt noCredits functionResolved + argumentsResolved transferred + | extern noCredits resolved declaration argumentArity called => + have targetDeclaration := trace.context_extern declaration + obtain ⟨sourceStep, targetStep, related⟩ := + unchangedExternStepIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + rfl sourceAt targetAt pc instructionAt noCredits resolved declaration + targetDeclaration argumentArity called + exact ⟨_, sourceStep, targetStep, related⟩ + +set_option maxHeartbeats 1000000 in +/-- Every successful instruction in an unchanged block has a matching target +step and a stable exact-content successor. The public evaluator case witness +is exhaustive; the whole-program trace supplies any rewritten function or +preserved extern declaration selected dynamically. -/ +theorem unchangedInstructionStepOfTrace {limits : Validate.Limits} + {validation : Validate.Context} {sourceProgram : Program} + (trace : Reuse.Trace limits validation sourceProgram) + {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {instruction : Instr} {baselineTarget : Machine} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc < block.instructions.size) + (instructionAt : block.instructions[baselineFrame.pc] = instruction) + (classified : InstructionTransferCase + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation baselineStore baselineFuel baselineFrame baselineStack + instruction baselineTarget) : + ∃ rewrittenTarget, + Step (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + baselineTarget ∧ + Step (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + rewrittenTarget ∧ + StableMachineRel limits validation baselineTarget rewrittenTarget := by + let baselineContext := + Eval.Context.ofProgram sourceProgram validation.schemas oracle + let rewrittenContext := + Eval.Context.ofProgram trace.target validation.schemas oracle + cases classified with + | move resolved => + exact ⟨_, unchangedMoveStep (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt resolved⟩ + | alloc schemaAt resolved fields => + obtain ⟨sourceStep, targetStep, related⟩ := + unchangedAllocStep (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite rfl heap fuel frame + stack sourceAt targetAt pc instructionAt schemaAt resolved fields + exact ⟨_, sourceStep, targetStep, related⟩ + | allocWithAbsent schemaAt resolved fields taken layout absent => + exact ⟨_, unchangedAllocWithAbsentStep + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite rfl heap fuel frame + stack sourceAt targetAt pc instructionAt schemaAt resolved fields + taken layout absent⟩ + | allocWithLogical mode schemaAt resolved fields taken layout present => + cases mode + exact ⟨_, unchangedAllocWithLogicalStep + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite rfl heap fuel frame + stack sourceAt targetAt pc instructionAt schemaAt resolved fields + taken layout present⟩ + | allocWithPhysical mode schemaAt resolved fields taken layout present + reused => + cases mode + obtain ⟨rewrittenOut, targetReused, sourceStep, targetStep, related⟩ := + unchangedAllocWithPhysicalStep (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite rfl heap fuel frame + stack sourceAt targetAt pc instructionAt schemaAt resolved fields + taken layout present reused + exact ⟨_, sourceStep, targetStep, related⟩ + | discardAbsent taken absent => + exact ⟨_, unchangedDiscardCreditAbsentStep + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt taken absent⟩ + | discardLogical mode taken present => + cases mode + exact ⟨_, unchangedDiscardCreditLogicalStep + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt taken present⟩ + | discardPhysical mode taken present released => + cases mode + obtain ⟨rewrittenOut, targetReleased, sourceStep, targetStep, related⟩ := + unchangedDiscardCreditPhysicalStep + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt taken present released + exact ⟨_, sourceStep, targetStep, related⟩ + | takeUniqueLogical mode schemaAt resolved viewed unitRC => + cases mode + exact ⟨_, unchangedTakeUniqueLogicalStep + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite rfl heap fuel frame + stack sourceAt targetAt pc instructionAt schemaAt resolved viewed + unitRC⟩ + | takeUniquePhysical mode schemaAt resolved viewed unitRC => + cases mode + exact ⟨_, unchangedTakeUniquePhysicalStep + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite rfl heap fuel frame + stack sourceAt targetAt pc instructionAt schemaAt resolved viewed + unitRC⟩ + | resetSharedLogicalHot mode schemaAt resolved viewed unitRC => + cases mode + exact ⟨_, unchangedResetSharedLogicalHotStep + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite rfl heap fuel frame + stack sourceAt targetAt pc instructionAt schemaAt resolved viewed + unitRC⟩ + | resetSharedPhysicalHot mode schemaAt resolved viewed unitRC => + cases mode + exact ⟨_, unchangedResetSharedPhysicalHotStep + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite rfl heap fuel frame + stack sourceAt targetAt pc instructionAt schemaAt resolved viewed + unitRC⟩ + | resetSharedCold schemaAt resolved viewed shared retained => + obtain ⟨rewrittenOut, targetRetained, sourceStep, targetStep, related⟩ := + unchangedResetSharedColdStep (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite rfl heap fuel frame + stack sourceAt targetAt pc instructionAt schemaAt resolved viewed + shared retained + exact ⟨_, sourceStep, targetStep, related⟩ + | retainShared resolved retained => + obtain ⟨rewrittenOut, targetRetained, sourceStep, targetStep, related⟩ := + unchangedRetainSharedStep (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt resolved retained + exact ⟨_, sourceStep, targetStep, related⟩ + | releaseShared resolved released => + obtain ⟨rewrittenOut, rewrittenRemaining, targetReleased, sourceStep, + targetStep, related⟩ := + unchangedReleaseSharedStep (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt resolved released + exact ⟨_, sourceStep, targetStep, related⟩ + | dropUnique resolved dropped => + obtain ⟨rewrittenOut, rewrittenRemaining, targetDropped, sourceStep, + targetStep, related⟩ := + unchangedDropUniqueStep (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt resolved dropped + exact ⟨_, sourceStep, targetStep, related⟩ + | freeUnique resolved viewed scalarFields => + obtain ⟨boxAt, unique, node⟩ := viewed.parts + exact ⟨_, unchangedFreeUniqueStep (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt resolved boxAt unique node + scalarFields⟩ + | fetch resolved boxAt node fieldAt => + exact ⟨_, unchangedFetchStep (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt resolved boxAt node fieldAt⟩ + | callFn noCredits resolved declaration arity nonempty => + obtain ⟨calleeRewrite, targetDeclaration⟩ := + trace.context_fn declaration + exact ⟨_, unchangedCallFnStep (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite calleeRewrite heap fuel + frame stack sourceAt targetAt pc instructionAt noCredits resolved + declaration targetDeclaration arity nonempty⟩ + | callSelf noCredits resolved arity nonempty => + exact ⟨_, unchangedCallSelfStep (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt noCredits resolved arity nonempty⟩ + | pappFn noCredits declaration papSafe resolved under => + obtain ⟨calleeRewrite, targetDeclaration⟩ := + trace.context_fn declaration + exact ⟨_, unchangedPappFnStep (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite calleeRewrite heap fuel + frame stack sourceAt targetAt pc instructionAt noCredits declaration + targetDeclaration papSafe resolved under⟩ + | pappExtern noCredits declaration resolved under => + have targetDeclaration := trace.context_extern declaration + exact ⟨_, unchangedPappExternStep (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt noCredits declaration + targetDeclaration resolved under⟩ + | apply noCredits functionResolved argumentsResolved transferred => + exact unchangedApplyStepOfTrace trace rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt noCredits functionResolved + argumentsResolved transferred + | extern noCredits resolved declaration argumentArity called => + have targetDeclaration := trace.context_extern declaration + exact ⟨_, unchangedExternStep (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + rfl sourceAt targetAt pc instructionAt noCredits resolved declaration + targetDeclaration argumentArity called⟩ + +/-! ## Allocation-history unchanged terminators -/ + +/-- An unchanged jump transports related explicit values and linear credits +through the selected target-block ABI. -/ +theorem unchangedJumpStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTarget : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {edge : Edge} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = .jump edge) + (transferred : EdgeTransfer baselineFrame edge #[] baselineTarget) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with + control := .running baselineTarget baselineStack } + ∃ rewrittenTarget : Frame, + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running rewrittenTarget rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + obtain ⟨rewrittenTarget, rewrittenTransfer, targetFrame⟩ := + frame.edgeTransferIso (.nil) transferred + refine ⟨rewrittenTarget, + Step.jump rfl sourceAt pc terminator transferred, + Step.jump rfl targetAt targetPc terminator rewrittenTransfer, ?_⟩ + exact StableMachineRel.history heap fuel + (.running (.rewritten rewrite targetFrame) stack) + +/-- The zero arm of a Nat switch preserves its literal observation and +transports the selected edge under the heap history. -/ +theorem unchangedSwitchNatZeroStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTarget : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {scrutinee : Atom} {constructors : Array CtorAlt} + {peel : NatPeel} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = + .switchValue scrutinee constructors (some peel)) + (resolved : resolveAtom baselineFrame.values scrutinee = + .ok (.lit (.nat 0))) + (transferred : EdgeTransfer baselineFrame peel.zero #[] baselineTarget) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with control := .running baselineTarget baselineStack } + ∃ rewrittenTarget : Frame, + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running rewrittenTarget rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + obtain ⟨rewrittenValue, targetResolved, valueRelated⟩ := + resolveAtom_iso frame.values resolved + cases valueRelated with + | lit => + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + obtain ⟨rewrittenTarget, rewrittenTransfer, targetFrame⟩ := + frame.edgeTransferIso (.nil) transferred + refine ⟨rewrittenTarget, + Step.switchNatZero rfl sourceAt pc terminator resolved transferred, + Step.switchNatZero rfl targetAt targetPc terminator targetResolved + rewrittenTransfer, ?_⟩ + exact StableMachineRel.history heap fuel + (.running (.rewritten rewrite targetFrame) stack) + +/-- The successor arm preserves its scalar predecessor and transports the +selected edge under the heap history. -/ +theorem unchangedSwitchNatSuccStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTarget : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {scrutinee : Atom} {constructors : Array CtorAlt} + {peel : NatPeel} {predecessor : Nat} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = + .switchValue scrutinee constructors (some peel)) + (resolved : resolveAtom baselineFrame.values scrutinee = + .ok (.lit (.nat (predecessor + 1)))) + (transferred : EdgeTransfer baselineFrame peel.succ + #[.lit (.nat predecessor)] baselineTarget) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with control := .running baselineTarget baselineStack } + ∃ rewrittenTarget : Frame, + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running rewrittenTarget rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + obtain ⟨rewrittenValue, targetResolved, valueRelated⟩ := + resolveAtom_iso frame.values resolved + cases valueRelated with + | lit => + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + obtain ⟨rewrittenTarget, rewrittenTransfer, targetFrame⟩ := + frame.edgeTransferIso (.cons .lit .nil) transferred + refine ⟨rewrittenTarget, + Step.switchNatSucc rfl sourceAt pc terminator resolved transferred, + Step.switchNatSucc rfl targetAt targetPc terminator targetResolved + rewrittenTransfer, ?_⟩ + exact StableMachineRel.history heap fuel + (.running (.rewritten rewrite targetFrame) stack) + +/-- Constructor dispatch follows the related scrutinee location, observes a +constructor with the same identity, and transports its selected edge. -/ +theorem unchangedSwitchCtorStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTarget : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {scrutinee : Atom} {constructors : Array CtorAlt} + {natPeel : Option NatPeel} {baselineLocation : Nat} {box : NodeBox} + {cid : CtorId} {fields : Array RVal} {alternative : CtorAlt} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = + .switchValue scrutinee constructors natPeel) + (resolved : resolveAtom baselineFrame.values scrutinee = + .ok (.loc baselineLocation)) + (boxAt : baselineStore.get? baselineLocation = some box) + (node : box.node = .ctorN cid fields) + (alternativeAt : constructors.find? (fun candidate => + candidate.cid == cid) = some alternative) + (transferred : EdgeTransfer baselineFrame alternative.edge #[] + baselineTarget) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with control := .running baselineTarget baselineStack } + ∃ rewrittenTarget : Frame, + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running rewrittenTarget rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + obtain ⟨rewrittenValue, targetResolved, valueRelated⟩ := + resolveAtom_iso frame.values resolved + cases valueRelated with + | @loc _ rewrittenLocation locations => + obtain ⟨rewrittenBox, targetBoxAt, boxesRelated⟩ := + heap.boxes locations (by + change baselineStore.heap.get? baselineLocation = some box + exact boxAt) + have nodesRelated : IxIR1.Sim.NodeIso heap.locRel + (.ctorN cid fields) rewrittenBox.node := by + rw [← node] + exact boxesRelated.node + obtain ⟨rewrittenFields, targetNode, _fieldsRelated⟩ := + nodeIso_ctor_left nodesRelated + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + obtain ⟨rewrittenTarget, rewrittenTransfer, targetFrame⟩ := + frame.edgeTransferIso (.nil) transferred + refine ⟨rewrittenTarget, + Step.switchCtor rfl sourceAt pc terminator resolved boxAt node + alternativeAt transferred, + Step.switchCtor rfl targetAt targetPc terminator targetResolved + (by + change rewrittenStore.heap.get? rewrittenLocation = + some rewrittenBox + exact targetBoxAt) + targetNode alternativeAt rewrittenTransfer, ?_⟩ + exact StableMachineRel.history heap fuel + (.running (.rewritten rewrite targetFrame) stack) + +/-- A present optional credit selects the corresponding target branch; the +credit itself and all credits transferred by the edge may carry related +physical addresses. -/ +theorem unchangedBranchCreditPresentStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTarget : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {creditId : CreditId} {credit : Credit} + {someEdge noneEdge : Edge} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = + .branchCredit creditId someEdge noneEdge) + (lookedUp : CreditLookup baselineFrame creditId credit) + (present : credit.isPresent = true) + (transferred : EdgeTransfer baselineFrame someEdge #[] baselineTarget) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with control := .running baselineTarget baselineStack } + ∃ rewrittenTarget : Frame, + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running rewrittenTarget rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + obtain ⟨rewrittenCredit, targetLookup, creditRelated⟩ := + frame.creditLookup lookedUp + have targetPresent : rewrittenCredit.isPresent = true := by + rw [← creditRelated.present_parts.2] + exact present + obtain ⟨rewrittenTarget, rewrittenTransfer, targetFrame⟩ := + frame.edgeTransferIso (.nil) transferred + refine ⟨rewrittenTarget, + Step.branchCreditPresent rfl sourceAt pc terminator lookedUp present + transferred, + Step.branchCreditPresent rfl targetAt targetPc terminator targetLookup + targetPresent rewrittenTransfer, ?_⟩ + exact StableMachineRel.history heap fuel + (.running (.rewritten rewrite targetFrame) stack) + +/-- An absent optional credit selects the fallback target branch under the +same relation-aware edge transfer. -/ +theorem unchangedBranchCreditAbsentStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineTarget : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {creditId : CreditId} {credit : Credit} + {someEdge noneEdge : Edge} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = + .branchCredit creditId someEdge noneEdge) + (lookedUp : CreditLookup baselineFrame creditId credit) + (absent : credit.isPresent = false) + (transferred : EdgeTransfer baselineFrame noneEdge #[] baselineTarget) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with control := .running baselineTarget baselineStack } + ∃ rewrittenTarget : Frame, + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running rewrittenTarget rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + obtain ⟨rewrittenCredit, targetLookup, creditRelated⟩ := + frame.creditLookup lookedUp + have targetAbsent : rewrittenCredit.isPresent = false := by + rw [← creditRelated.present_parts.2] + exact absent + obtain ⟨rewrittenTarget, rewrittenTransfer, targetFrame⟩ := + frame.edgeTransferIso (.nil) transferred + refine ⟨rewrittenTarget, + Step.branchCreditAbsent rfl sourceAt pc terminator lookedUp absent + transferred, + Step.branchCreditAbsent rfl targetAt targetPc terminator targetLookup + targetAbsent rewrittenTransfer, ?_⟩ + exact StableMachineRel.history heap fuel + (.running (.rewritten rewrite targetFrame) stack) + +/-- A recursive tail call resolves a related argument vector and re-enters +the two versions of the current function without changing the related stack. -/ +theorem unchangedTailCallSelfStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {arguments : Array Atom} + {baselineValues : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = .tailCallSelf arguments) + (noCredits : NoLiveCredits baselineFrame) + (resolved : resolveAtoms baselineFrame.values arguments = + .ok baselineValues) + (arity : baselineValues.size = + baselineFrame.definition.signature.params.size) + (nonempty : baselineFrame.definition.blocks.isEmpty = false) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with + control := .running + { definition := baselineFrame.definition, values := baselineValues } + baselineStack } + ∃ rewrittenValues, + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running + { definition := rewrittenFrame.definition, + values := rewrittenValues } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + obtain ⟨rewrittenValues, targetResolved, valuesRelated⟩ := + resolveAtoms_iso frame.values resolved + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + have targetNoCredits := frame.noLiveCredits noCredits + have sizeEq : baselineValues.size = rewrittenValues.size := by + simpa using rvalsIso_length_eq valuesRelated + have sourceArity : baselineValues.size = source.signature.params.size := by + simpa [frame.baselineDefinition] using arity + have targetArity : rewrittenValues.size = + rewrittenFrame.definition.signature.params.size := by + rw [← sizeEq, frame.rewrittenDefinition, rewrite.definition_signature] + exact sourceArity + have targetNonempty : rewrittenFrame.definition.blocks.isEmpty = false := + blocks_nonempty_of_getElem targetAt + refine ⟨rewrittenValues, + Step.tailCallSelfCleared rfl sourceAt pc terminator noCredits resolved + arity nonempty, + Step.tailCallSelfCleared rfl targetAt targetPc terminator targetNoCredits + targetResolved targetArity targetNonempty, ?_⟩ + have callee : StableFrameRel limits validation heap.locRel + { definition := baselineFrame.definition, values := baselineValues } + { definition := rewrittenFrame.definition, values := rewrittenValues } := by + rw [frame.baselineDefinition, frame.rewrittenDefinition] + exact StableFrameRel.entry rewrite valuesRelated + exact StableMachineRel.history heap fuel (.running callee stack) + +/-- A direct tail call follows the declaration rewrite at the same address +and enters the related callee argument vectors. -/ +theorem unchangedTailCallFnStepIso {limits : Validate.Limits} + {validation : Validate.Context} {callerSource calleeSource : Function} + (callerRewrite : Reuse.FunctionRewrite limits validation callerSource) + (calleeRewrite : Reuse.FunctionRewrite limits validation calleeSource) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso callerRewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {address : Ix.Compiler.Ixon.Address} + {arguments : Array Atom} {baselineValues : Array RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = .tailCall address arguments) + (noCredits : NoLiveCredits baselineFrame) + (resolved : resolveAtoms baselineFrame.values arguments = + .ok baselineValues) + (baselineDeclaration : baselineContext.declarations address = + some (.fn calleeSource)) + (rewrittenDeclaration : rewrittenContext.declarations address = + some (.fn calleeRewrite.definition)) + (arity : baselineValues.size = calleeSource.signature.params.size) + (nonempty : calleeSource.blocks.isEmpty = false) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + let baselineNext : Machine := + { baselineMachine with + control := .running + { definition := calleeSource, values := baselineValues } + baselineStack } + ∃ rewrittenValues, + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running + { definition := calleeRewrite.definition, + values := rewrittenValues } + rewrittenStack } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + obtain ⟨rewrittenValues, targetResolved, valuesRelated⟩ := + resolveAtoms_iso frame.values resolved + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + have targetNoCredits := frame.noLiveCredits noCredits + have sizeEq : baselineValues.size = rewrittenValues.size := by + simpa using rvalsIso_length_eq valuesRelated + have targetArity : rewrittenValues.size = + calleeRewrite.definition.signature.params.size := by + rw [← sizeEq] + simpa using arity + have targetNonempty : calleeRewrite.definition.blocks.isEmpty = false := + calleeRewrite.definition_blocks_nonempty nonempty + refine ⟨rewrittenValues, + Step.tailCallFnCleared rfl sourceAt pc terminator noCredits resolved + baselineDeclaration arity nonempty, + Step.tailCallFnCleared rfl targetAt targetPc terminator targetNoCredits + targetResolved rewrittenDeclaration targetArity targetNonempty, ?_⟩ + exact StableMachineRel.history heap fuel + (.running (StableFrameRel.entry calleeRewrite valuesRelated) stack) + +/-- An ordinary return resolves related results, transports the result-world +check through the heap history, and pushes them into related suspended +callers. -/ +theorem unchangedRetResumeStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineCaller rewrittenCaller : Frame} + {baselineRest rewrittenRest : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (caller : StableFrameRel limits validation heap.locRel + baselineCaller rewrittenCaller) + (rest : StableStackIso limits validation heap.locRel + baselineRest rewrittenRest) + {block : Block} {atom : Atom} {baselineValue : RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = .ret atom) + (resolved : resolveAtom baselineFrame.values atom = .ok baselineValue) + (noCredits : NoLiveCredits baselineFrame) + (world : baselineValue.hasWorld baselineStore + baselineFrame.definition.signature.result = true) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame + (.resume baselineCaller :: baselineRest) } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame + (.resume rewrittenCaller :: rewrittenRest) } + let baselineNext : Machine := + { baselineMachine with + control := .running + { baselineCaller with + values := baselineCaller.values.push baselineValue } + baselineRest } + ∃ rewrittenValue, + let rewrittenNext : Machine := + { rewrittenMachine with + control := .running + { rewrittenCaller with + values := rewrittenCaller.values.push rewrittenValue } + rewrittenRest } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + obtain ⟨rewrittenValue, targetResolved, valueRelated⟩ := + resolveAtom_iso frame.values resolved + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + have targetNoCredits := frame.noLiveCredits noCredits + have resultWorldEq : rewrittenFrame.definition.signature.result = + baselineFrame.definition.signature.result := by + rw [frame.rewrittenDefinition, rewrite.definition_signature, + frame.baselineDefinition] + have targetWorld : rewrittenValue.hasWorld rewrittenStore + rewrittenFrame.definition.signature.result = true := by + rw [resultWorldEq, + ← heapHistoryIso_rvalHasWorld_eq heap valueRelated] + exact world + refine ⟨rewrittenValue, + Step.retResumeCleared rfl sourceAt pc terminator resolved noCredits world, + Step.retResumeCleared rfl targetAt targetPc terminator targetResolved + targetNoCredits targetWorld, ?_⟩ + exact StableMachineRel.history heap fuel + (.running (caller.push valueRelated) rest) + +/-- An outermost return halts with related results after transporting the +callee result-world check through the heap history. -/ +theorem unchangedRetHaltStepIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + {block : Block} {atom : Atom} {baselineValue : RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = .ret atom) + (resolved : resolveAtom baselineFrame.values atom = .ok baselineValue) + (noCredits : NoLiveCredits baselineFrame) + (world : baselineValue.hasWorld baselineStore + baselineFrame.definition.signature.result = true) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame [] } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame [] } + let baselineNext : Machine := + { baselineMachine with control := .halted baselineValue } + ∃ rewrittenValue, + let rewrittenNext : Machine := + { rewrittenMachine with control := .halted rewrittenValue } + Step baselineContext interpretation baselineMachine baselineNext ∧ + Step rewrittenContext interpretation rewrittenMachine rewrittenNext ∧ + StableMachineRel limits validation baselineNext rewrittenNext := by + dsimp only + obtain ⟨rewrittenValue, targetResolved, valueRelated⟩ := + resolveAtom_iso frame.values resolved + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + have targetNoCredits := frame.noLiveCredits noCredits + have resultWorldEq : rewrittenFrame.definition.signature.result = + baselineFrame.definition.signature.result := by + rw [frame.rewrittenDefinition, rewrite.definition_signature, + frame.baselineDefinition] + have targetWorld : rewrittenValue.hasWorld rewrittenStore + rewrittenFrame.definition.signature.result = true := by + rw [resultWorldEq, + ← heapHistoryIso_rvalHasWorld_eq heap valueRelated] + exact world + refine ⟨rewrittenValue, + Step.retHaltCleared rfl sourceAt pc terminator resolved noCredits world, + Step.retHaltCleared rfl targetAt targetPc terminator targetResolved + targetNoCredits targetWorld, ?_⟩ + exact StableMachineRel.history heap fuel (.halted valueRelated) + +/-- A return through `applyMore` resolves related return values and feeds the +related saved argument vectors through the exhaustive dynamic application +simulation. -/ +theorem unchangedRetApplyMoreStepOfTraceIso {limits : Validate.Limits} + {validation : Validate.Context} {sourceProgram : Program} + (trace : Reuse.Trace limits validation sourceProgram) + {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame baselineCaller rewrittenCaller : Frame} + {baselineArguments rewrittenArguments : Array RVal} + {baselineRest rewrittenRest : List Continuation} + {baselineTarget : Machine} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (arguments : IxIR1.Sim.RValsIso heap.locRel + baselineArguments.toList rewrittenArguments.toList) + (caller : StableFrameRel limits validation heap.locRel + baselineCaller rewrittenCaller) + (rest : StableStackIso limits validation heap.locRel + baselineRest rewrittenRest) + {block : Block} {atom : Atom} {baselineValue : RVal} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminator : block.terminator = .ret atom) + (resolved : resolveAtom baselineFrame.values atom = .ok baselineValue) + (noCredits : NoLiveCredits baselineFrame) + (world : baselineValue.hasWorld baselineStore + baselineFrame.definition.signature.result = true) + (transferred : ApplyTransfer + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation baselineStore baselineFuel baselineValue + baselineArguments baselineCaller baselineRest baselineTarget) : + ∃ rewrittenTarget, + Step (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame + (.applyMore baselineArguments baselineCaller :: baselineRest) } + baselineTarget ∧ + Step (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame + (.applyMore rewrittenArguments rewrittenCaller :: + rewrittenRest) } + rewrittenTarget ∧ + StableMachineRel limits validation baselineTarget rewrittenTarget := by + obtain ⟨rewrittenValue, targetResolved, valueRelated⟩ := + resolveAtom_iso frame.values resolved + have targetPc : rewrittenFrame.pc = block.instructions.size := + frame.pc.symm.trans pc + have targetNoCredits := frame.noLiveCredits noCredits + have resultWorldEq : rewrittenFrame.definition.signature.result = + baselineFrame.definition.signature.result := by + rw [frame.rewrittenDefinition, rewrite.definition_signature, + frame.baselineDefinition] + have targetWorld : rewrittenValue.hasWorld rewrittenStore + rewrittenFrame.definition.signature.result = true := by + rw [resultWorldEq, + ← heapHistoryIso_rvalHasWorld_eq heap valueRelated] + exact world + obtain ⟨rewrittenTarget, targetTransferred, related⟩ := + unchangedApplyTransferIso trace heap fuel valueRelated arguments caller + rest transferred + refine ⟨rewrittenTarget, + Step.retApplyMoreCleared rfl sourceAt pc terminator resolved noCredits + world transferred, + Step.retApplyMoreCleared rfl targetAt targetPc terminator targetResolved + targetNoCredits targetWorld targetTransferred, + related⟩ + +set_option maxHeartbeats 1000000 in +/-- Every successful terminator in an unchanged block is equivariant under +an arbitrary allocation-history isomorphism. -/ +theorem unchangedTerminatorStepOfTraceIso {limits : Validate.Limits} + {validation : Validate.Context} {sourceProgram : Program} + (trace : Reuse.Trace limits validation sourceProgram) + {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {terminator : Terminator} {baselineTarget : Machine} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminatorAt : block.terminator = terminator) + (classified : TerminatorTransferCase + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation baselineStore baselineFuel baselineFrame baselineStack + terminator baselineTarget) : + ∃ rewrittenTarget, + Step (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + baselineTarget ∧ + Step (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + rewrittenTarget ∧ + StableMachineRel limits validation baselineTarget rewrittenTarget := by + let baselineContext := + Eval.Context.ofProgram sourceProgram validation.schemas oracle + let rewrittenContext := + Eval.Context.ofProgram trace.target validation.schemas oracle + cases classified with + | jump transferred => + obtain ⟨rewrittenFrameTarget, sourceStep, targetStep, related⟩ := + unchangedJumpStepIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc terminatorAt transferred + exact ⟨_, sourceStep, targetStep, related⟩ + | switchCtor resolved boxAt node alternativeAt transferred => + obtain ⟨rewrittenFrameTarget, sourceStep, targetStep, related⟩ := + unchangedSwitchCtorStepIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc terminatorAt resolved boxAt node alternativeAt + transferred + exact ⟨_, sourceStep, targetStep, related⟩ + | switchNatZero resolved transferred => + obtain ⟨rewrittenFrameTarget, sourceStep, targetStep, related⟩ := + unchangedSwitchNatZeroStepIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc terminatorAt resolved transferred + exact ⟨_, sourceStep, targetStep, related⟩ + | switchNatSucc resolved transferred => + obtain ⟨rewrittenFrameTarget, sourceStep, targetStep, related⟩ := + unchangedSwitchNatSuccStepIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc terminatorAt resolved transferred + exact ⟨_, sourceStep, targetStep, related⟩ + | branchPresent lookedUp present transferred => + obtain ⟨rewrittenFrameTarget, sourceStep, targetStep, related⟩ := + unchangedBranchCreditPresentStepIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc terminatorAt lookedUp present transferred + exact ⟨_, sourceStep, targetStep, related⟩ + | branchAbsent lookedUp absent transferred => + obtain ⟨rewrittenFrameTarget, sourceStep, targetStep, related⟩ := + unchangedBranchCreditAbsentStepIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc terminatorAt lookedUp absent transferred + exact ⟨_, sourceStep, targetStep, related⟩ + | retResume resolved noCredits world => + cases stack with + | cons head rest => + cases head with + | resume caller => + obtain ⟨rewrittenValue, sourceStep, targetStep, related⟩ := + unchangedRetResumeStepIso + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel + frame caller rest sourceAt targetAt pc terminatorAt resolved + noCredits world + exact ⟨_, sourceStep, targetStep, related⟩ + | retHalt resolved noCredits world => + cases stack + obtain ⟨rewrittenValue, sourceStep, targetStep, related⟩ := + unchangedRetHaltStepIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame + sourceAt targetAt pc terminatorAt resolved noCredits world + exact ⟨_, sourceStep, targetStep, related⟩ + | retApplyMore resolved noCredits world transferred => + cases stack with + | cons head rest => + cases head with + | applyMore arguments caller => + exact unchangedRetApplyMoreStepOfTraceIso trace rewrite heap + fuel frame arguments caller rest sourceAt targetAt pc + terminatorAt resolved noCredits world transferred + | tailCallFn noCredits resolved declaration arity nonempty => + obtain ⟨calleeRewrite, targetDeclaration⟩ := + trace.context_fn declaration + obtain ⟨rewrittenValues, sourceStep, targetStep, related⟩ := + unchangedTailCallFnStepIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite calleeRewrite heap fuel + frame stack sourceAt targetAt pc terminatorAt noCredits resolved + declaration targetDeclaration arity nonempty + exact ⟨_, sourceStep, targetStep, related⟩ + | tailCallSelf noCredits resolved arity nonempty => + obtain ⟨rewrittenValues, sourceStep, targetStep, related⟩ := + unchangedTailCallSelfStepIso (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc terminatorAt noCredits resolved arity nonempty + exact ⟨_, sourceStep, targetStep, related⟩ + +/-- A source step at a literally preserved block is matched under any +allocation-history isomorphism. Instruction and terminator classification +remain entirely behind the public evaluator interfaces. -/ +theorem unchangedStepOfTraceIso {limits : Validate.Limits} + {validation : Validate.Context} {sourceProgram : Program} + (trace : Reuse.Trace limits validation sourceProgram) + {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {block : Block} {baselineTarget : Machine} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (stepped : Step + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + baselineTarget) : + ∃ rewrittenTarget, + Step (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + rewrittenTarget ∧ + StableMachineRel limits validation baselineTarget rewrittenTarget := by + have classified := stepped.classify + cases classified with + | instruction classifiedAt pc instructionAt instructionCase => + have blockEq := Option.some.inj (classifiedAt.symm.trans sourceAt) + cases blockEq + obtain ⟨rewrittenTarget, _sourceStep, targetStep, related⟩ := + unchangedInstructionStepOfTraceIso trace rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt instructionCase + exact ⟨rewrittenTarget, targetStep, related⟩ + | terminator classifiedAt pc terminatorAt terminatorCase => + have blockEq := Option.some.inj (classifiedAt.symm.trans sourceAt) + cases blockEq + obtain ⟨rewrittenTarget, _sourceStep, targetStep, related⟩ := + unchangedTerminatorStepOfTraceIso trace rewrite heap fuel frame stack + sourceAt targetAt pc terminatorAt terminatorCase + exact ⟨rewrittenTarget, targetStep, related⟩ + +/-- Every successful terminator in an unchanged block has a matching target +step and stable successor. Indexed stack cases expose ordinary returns, +outermost returns, and over-application returns without any private evaluator +unfolding. -/ +theorem unchangedTerminatorStepOfTrace {limits : Validate.Limits} + {validation : Validate.Context} {sourceProgram : Program} + (trace : Reuse.Trace limits validation sourceProgram) + {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {terminator : Terminator} {baselineTarget : Machine} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (pc : baselineFrame.pc = block.instructions.size) + (terminatorAt : block.terminator = terminator) + (classified : TerminatorTransferCase + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation baselineStore baselineFuel baselineFrame baselineStack + terminator baselineTarget) : + ∃ rewrittenTarget, + Step (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + baselineTarget ∧ + Step (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + rewrittenTarget ∧ + StableMachineRel limits validation baselineTarget rewrittenTarget := by + let baselineContext := + Eval.Context.ofProgram sourceProgram validation.schemas oracle + let rewrittenContext := + Eval.Context.ofProgram trace.target validation.schemas oracle + cases classified with + | jump transferred => + exact ⟨_, unchangedJumpStep (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc terminatorAt transferred⟩ + | switchCtor resolved boxAt node alternativeAt transferred => + exact ⟨_, unchangedSwitchCtorStep (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc terminatorAt resolved boxAt node alternativeAt + transferred⟩ + | switchNatZero resolved transferred => + exact ⟨_, unchangedSwitchNatZeroStep + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc terminatorAt resolved transferred⟩ + | switchNatSucc resolved transferred => + exact ⟨_, unchangedSwitchNatSuccStep + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc terminatorAt resolved transferred⟩ + | branchPresent lookedUp present transferred => + exact ⟨_, unchangedBranchCreditPresentStep + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc terminatorAt lookedUp present transferred⟩ + | branchAbsent lookedUp absent transferred => + exact ⟨_, unchangedBranchCreditAbsentStep + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc terminatorAt lookedUp absent transferred⟩ + | retResume resolved noCredits world => + cases stack with + | cons head rest => + cases head with + | resume caller => + exact ⟨_, unchangedRetResumeStep + (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame + caller rest sourceAt targetAt pc terminatorAt resolved + noCredits world⟩ + | retHalt resolved noCredits world => + cases stack + exact ⟨_, unchangedRetHaltStep (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame sourceAt + targetAt pc terminatorAt resolved noCredits world⟩ + | retApplyMore resolved noCredits world transferred => + cases stack with + | cons head rest => + cases head with + | applyMore arguments caller => + have argumentsEq := arguments.eq_of_location_eq + have arraysEq := Array.toList_inj.mp argumentsEq + subst_vars + exact unchangedRetApplyMoreStepOfTrace trace rewrite heap fuel + frame caller rest sourceAt targetAt pc terminatorAt resolved + noCredits world transferred + | tailCallFn noCredits resolved declaration arity nonempty => + obtain ⟨calleeRewrite, targetDeclaration⟩ := + trace.context_fn declaration + exact ⟨_, unchangedTailCallFnStep (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite calleeRewrite heap fuel + frame stack sourceAt targetAt pc terminatorAt noCredits resolved + declaration targetDeclaration arity nonempty⟩ + | tailCallSelf noCredits resolved arity nonempty => + exact ⟨_, unchangedTailCallSelfStep (baselineContext := baselineContext) + (rewrittenContext := rewrittenContext) rewrite heap fuel frame stack + sourceAt targetAt pc terminatorAt noCredits resolved arity nonempty⟩ + +/-- A single public source step at a literally preserved block is matched by +one target step. This is the whole-step unchanged arm: evaluator inversion, +instruction/terminator dispatch, declarations, heap effects, fuel, frames, +and continuation stacks are all discharged below this interface. -/ +theorem unchangedStepOfTrace {limits : Validate.Limits} + {validation : Validate.Context} {sourceProgram : Program} + (trace : Reuse.Trace limits validation sourceProgram) + {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {block : Block} {baselineTarget : Machine} + (sourceAt : baselineFrame.definition.blocks[baselineFrame.block]? = + some block) + (targetAt : rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block) + (stepped : Step + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + baselineTarget) : + ∃ rewrittenTarget, + Step (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } + rewrittenTarget ∧ + StableMachineRel limits validation baselineTarget rewrittenTarget := by + have classified := stepped.classify + cases classified with + | instruction classifiedAt pc instructionAt instructionCase => + have blockEq := Option.some.inj (classifiedAt.symm.trans sourceAt) + cases blockEq + obtain ⟨rewrittenTarget, _sourceStep, targetStep, related⟩ := + unchangedInstructionStepOfTrace trace rewrite heap fuel frame stack + sourceAt targetAt pc instructionAt instructionCase + exact ⟨rewrittenTarget, targetStep, related⟩ + | terminator classifiedAt pc terminatorAt terminatorCase => + have blockEq := Option.some.inj (classifiedAt.symm.trans sourceAt) + cases blockEq + obtain ⟨rewrittenTarget, _sourceStep, targetStep, related⟩ := + unchangedTerminatorStepOfTrace trace rewrite heap fuel frame stack + sourceAt targetAt pc terminatorAt terminatorCase + exact ⟨rewrittenTarget, targetStep, related⟩ + +/-- A synchronization-sized transition: each machine takes a positive finite +number of genuine running steps and the two endpoints satisfy the uniform +stable relation. Unchanged blocks use one step on each side; an accepted +reset/reuse block uses its complete source and replacement macros. -/ +inductive StableMacroSimulation (limits : Validate.Limits) + (validation : Validate.Context) (baselineContext rewrittenContext : + Eval.Context) (interpretation : Interpretation) + (baselineStart rewrittenStart : Machine) : Prop where + | intro (baselineCount rewrittenCount : Nat) + (baselinePositive : 0 < baselineCount) + (rewrittenPositive : 0 < rewrittenCount) + (baselineTarget rewrittenTarget : Machine) + (baselineSteps : Steps baselineContext interpretation baselineCount + baselineStart baselineTarget) + (rewrittenSteps : Steps rewrittenContext interpretation rewrittenCount + rewrittenStart rewrittenTarget) + (related : StableMachineRel limits validation baselineTarget + rewrittenTarget) + +/-- One synchronization macro together with preservation of a caller-chosen +global runtime invariant. Keeping the concrete endpoints in this relation +lets finite-run induction cancel the multi-step baseline prefix and recurse +from the exact synchronized states. -/ +inductive StableMacroInvariantStep (limits : Validate.Limits) + (validation : Validate.Context) (baselineContext rewrittenContext : + Eval.Context) (interpretation : Interpretation) + (invariant : Machine → Machine → Prop) + (baselineStart rewrittenStart : Machine) : Prop where + | intro (baselineCount rewrittenCount : Nat) + (baselinePositive : 0 < baselineCount) + (rewrittenPositive : 0 < rewrittenCount) + (baselineTarget rewrittenTarget : Machine) + (baselineSteps : Steps baselineContext interpretation baselineCount + baselineStart baselineTarget) + (rewrittenSteps : Steps rewrittenContext interpretation rewrittenCount + rewrittenStart rewrittenTarget) + (related : StableMachineRel limits validation baselineTarget + rewrittenTarget) + (preserved : invariant baselineTarget rewrittenTarget) + +/-- Forget invariant preservation and recover the ordinary synchronization +macro consumed by local simulation clients. -/ +theorem StableMacroInvariantStep.simulation {limits : Validate.Limits} + {validation : Validate.Context} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {invariant : Machine → Machine → Prop} + {baselineStart rewrittenStart : Machine} + (step : StableMacroInvariantStep limits validation baselineContext + rewrittenContext interpretation invariant baselineStart + rewrittenStart) : + StableMacroSimulation limits validation baselineContext rewrittenContext + interpretation baselineStart rewrittenStart := by + cases step with + | intro baselineCount rewrittenCount baselinePositive rewrittenPositive + baselineTarget rewrittenTarget baselineSteps rewrittenSteps related + _preserved => + exact .intro baselineCount rewrittenCount baselinePositive + rewrittenPositive baselineTarget rewrittenTarget baselineSteps + rewrittenSteps related + +/-- Strengthen a synchronization macro once the global invariant has been +proved at every endpoint exposed by that macro. -/ +theorem StableMacroSimulation.preserveInvariant {limits : Validate.Limits} + {validation : Validate.Context} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {invariant : Machine → Machine → Prop} + {baselineStart rewrittenStart : Machine} + (simulation : StableMacroSimulation limits validation baselineContext + rewrittenContext interpretation baselineStart rewrittenStart) + (preserved : ∀ {baselineCount rewrittenCount : Nat} + {baselineTarget rewrittenTarget : Machine}, + Steps baselineContext interpretation baselineCount baselineStart + baselineTarget → + Steps rewrittenContext interpretation rewrittenCount rewrittenStart + rewrittenTarget → + StableMachineRel limits validation baselineTarget rewrittenTarget → + invariant baselineTarget rewrittenTarget) : + StableMacroInvariantStep limits validation baselineContext + rewrittenContext interpretation invariant baselineStart + rewrittenStart := by + cases simulation with + | intro baselineCount rewrittenCount baselinePositive rewrittenPositive + baselineTarget rewrittenTarget baselineSteps rewrittenSteps related => + exact .intro baselineCount rewrittenCount baselinePositive + rewrittenPositive baselineTarget rewrittenTarget baselineSteps + rewrittenSteps related (preserved baselineSteps rewrittenSteps related) + +/-- Package a pair of related running one-step transitions as the degenerate +unchanged macro. -/ +theorem StableMacroSimulation.ofStepsOne {limits : Validate.Limits} + {validation : Validate.Context} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + {baselineStart rewrittenStart baselineTarget rewrittenTarget : Machine} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (baselineRunning : baselineStart.control = + .running baselineFrame baselineStack) + (rewrittenRunning : rewrittenStart.control = + .running rewrittenFrame rewrittenStack) + (baselineStep : Step baselineContext interpretation baselineStart + baselineTarget) + (rewrittenStep : Step rewrittenContext interpretation rewrittenStart + rewrittenTarget) + (related : StableMachineRel limits validation baselineTarget + rewrittenTarget) : + StableMacroSimulation limits validation baselineContext rewrittenContext + interpretation baselineStart rewrittenStart := by + exact .intro 1 1 (by omega) (by omega) baselineTarget rewrittenTarget + (baselineStep.toSteps baselineRunning) + (rewrittenStep.toSteps rewrittenRunning) related + +/-- Package the logical-hot accepted-site theorem as a synchronization macro. +The premises are the runtime facts needed by the optimization, rather than an +already-packaged simulation result. -/ +theorem acceptedHotLogicalStableMacroSimulation {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {index helperOffset : Nat} {block : Block} + {site : Reuse.Site limits validation block} + (found : Reuse.FunctionDecisions.At rewrite.decisions index helperOffset + block (.accepted site)) + {baselineContext rewrittenContext : Eval.Context} + (baselineSchemas : baselineContext.schemas = validation.schemas) + (rewrittenSchemas : rewrittenContext.schemas = validation.schemas) + {baselineStore rewrittenStore baselineRetained baselineReleased : Store} + (heap : HeapContentsEq baselineStore rewrittenStore) + {parameters fields newFields callValues : Array RVal} + {location fieldFuel remaining rewrittenFuel : Nat} + {baselineStack rewrittenStack : List Continuation} + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {ambient : List IxIR1.Sim.Root} {allocationSchema : CtorSchema} + (fuel : fieldFuel + 1 ≤ rewrittenFuel) + (allocationSchemaAt : + baselineContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (sourceResolved : resolveAtom parameters (.reg site.shape.source) = + .ok (.loc location)) + (sourceBoxAt : baselineStore.get? location = some + ⟨.shared, 1, .ctorN site.shape.sourceConstructor fields⟩) + (owned : IxIR1.Sim.RootOwnership baselineStore.heap + (⟨.shared, .loc location⟩ :: ambient)) + (retained : RetainSharedMany baselineStore fields baselineRetained) + (released : releaseShared (fieldFuel + 1) baselineRetained + (.loc location) = .ok (baselineReleased, remaining)) + (allocationResolved : resolveAtoms + (baselinePrefixValues parameters fields) + site.shape.allocationArguments = .ok newFields) + (baselineFieldWorlds : + FieldWorlds baselineReleased allocationSchema newFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc (baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor newFields)).2)) + site.shape.tailArguments = .ok callValues) + (arity : callValues.size = source.signature.params.size) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := parameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := index + values := parameters + credits := #[] } + rewrittenStack } + StableMacroSimulation limits validation baselineContext rewrittenContext + .logical baselineMachine rewrittenMachine := by + dsimp only + obtain ⟨baselineSteps, rewrittenSteps, related⟩ := + acceptedHotLogicalStableSimulation rewrite found baselineSchemas + rewrittenSchemas heap stack fuel allocationSchemaAt parameterCount + fieldCount sourceResolved sourceBoxAt owned retained released + allocationResolved baselineFieldWorlds tailResolved arity + exact .intro (2 * site.shape.fieldCount + 3) 4 (by omega) (by omega) _ _ + baselineSteps rewrittenSteps related + +/-- Package the cold accepted-site theorem as a synchronization macro. The +cold branch is common to logical and physical interpretations. -/ +theorem acceptedColdStableMacroSimulation {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {index helperOffset : Nat} {block : Block} + {site : Reuse.Site limits validation block} + (found : Reuse.FunctionDecisions.At rewrite.decisions index helperOffset + block (.accepted site)) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + (baselineSchemas : baselineContext.schemas = validation.schemas) + (rewrittenSchemas : rewrittenContext.schemas = validation.schemas) + {baselineStore rewrittenStore baselineRetained : Store} + (heap : HeapContentsEq baselineStore rewrittenStore) + {parameters fields newFields callValues : Array RVal} + {location fieldFuel rewrittenFuel rc retainedRc : Nat} + {baselineStack rewrittenStack : List Continuation} + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {allocationSchema : CtorSchema} + (fuel : fieldFuel + 1 ≤ rewrittenFuel) + (allocationSchemaAt : + baselineContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (parameterCount : parameters.size = site.shape.parameterCount) + (fieldCount : fields.size = site.shape.fieldCount) + (sourceResolved : resolveAtom parameters (.reg site.shape.source) = + .ok (.loc location)) + (sourceBoxAt : baselineStore.get? location = some + ⟨.shared, rc, .ctorN site.shape.sourceConstructor fields⟩) + (shared : 1 < rc) + (retained : RetainSharedMany baselineStore fields baselineRetained) + (retainedAt : baselineRetained.get? location = some + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩) + (allocationResolved : resolveAtoms + (baselinePrefixValues parameters fields) + site.shape.allocationArguments = .ok newFields) + (baselineFieldWorlds : FieldWorlds + (baselineDecrementStore baselineRetained location + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩) + allocationSchema newFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues parameters fields).push + (.loc ((baselineDecrementStore baselineRetained location + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor fields⟩).allocNode .shared + (.ctorN site.shape.allocationConstructor newFields)).2)) + site.shape.tailArguments = .ok callValues) + (arity : callValues.size = source.signature.params.size) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := parameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := index + values := parameters + credits := #[] } + rewrittenStack } + StableMacroSimulation limits validation baselineContext rewrittenContext + interpretation baselineMachine rewrittenMachine := by + dsimp only + obtain ⟨_rewrittenRetained, _retained, baselineSteps, rewrittenSteps, + related⟩ := + acceptedColdStableSimulation rewrite found baselineSchemas + rewrittenSchemas heap stack fuel allocationSchemaAt parameterCount + fieldCount sourceResolved sourceBoxAt shared retained retainedAt + allocationResolved baselineFieldWorlds tailResolved arity + exact .intro (2 * site.shape.fieldCount + 3) 4 (by omega) (by omega) _ _ + baselineSteps rewrittenSteps related + +/-- Package the physical-hot accepted-site theorem as a synchronization +macro. Unlike the exact-content wrappers, the input registers and suspended +continuations may already be related by a nontrivial allocation-history +bijection; the wrapped theorem replaces that relation at the reused location +and preserves it everywhere else that remains reachable. -/ +theorem acceptedHotPhysicalStableMacroSimulationIso + {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {index helperOffset : Nat} {block : Block} + {site : Reuse.Site limits validation block} + (found : Reuse.FunctionDecisions.At rewrite.decisions index helperOffset + block (.accepted site)) + {baselineContext rewrittenContext : Eval.Context} + (baselineSchemas : baselineContext.schemas = validation.schemas) + (rewrittenSchemas : rewrittenContext.schemas = validation.schemas) + {baselineStore rewrittenStore baselineRetained baselineReleased : Store} + (inputIso : IxIR1.Sim.HeapIso rewrittenStore.heap baselineStore.heap) + {baselineParameters rewrittenParameters baselineFields rewrittenFields + baselineNewFields rewrittenNewFields baselineCallValues : Array RVal} + {baselineLocation rewrittenLocation fieldFuel remaining rewrittenFuel : + Nat} + {baselineStack rewrittenStack : List Continuation} + (parameters : IxIR1.Sim.RValsIso + (fun baselineLocation rewrittenLocation => + inputIso.locRel rewrittenLocation baselineLocation) + baselineParameters.toList rewrittenParameters.toList) + (stack : StableStackIso limits validation + (fun baselineLocation rewrittenLocation => + inputIso.locRel rewrittenLocation baselineLocation) + baselineStack rewrittenStack) + (stackAvoids : StackValuesAvoidLocation rewrittenLocation rewrittenStack) + (stackCreditsAvoids : + StackCreditsAvoidLocation rewrittenLocation rewrittenStack) + {baselineBefore baselineAfter rewrittenBefore rewrittenAfter : + List IxIR1.Sim.Root} + {allocationSchema : CtorSchema} + (fuel : fieldFuel + 1 ≤ rewrittenFuel) + (locations : inputIso.locRel rewrittenLocation baselineLocation) + (allocationSchemaAt : + baselineContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (parameterCount : baselineParameters.size = site.shape.parameterCount) + (fieldCount : baselineFields.size = site.shape.fieldCount) + (baselineSourceResolved : + resolveAtom baselineParameters (.reg site.shape.source) = + .ok (.loc baselineLocation)) + (rewrittenSourceResolved : + resolveAtom rewrittenParameters (.reg site.shape.source) = + .ok (.loc rewrittenLocation)) + (baselineAt : baselineStore.get? baselineLocation = some + ⟨.shared, 1, + .ctorN site.shape.sourceConstructor baselineFields⟩) + (rewrittenAt : rewrittenStore.get? rewrittenLocation = some + ⟨.shared, 1, + .ctorN site.shape.sourceConstructor rewrittenFields⟩) + (baselineOwned : IxIR1.Sim.RootOwnership baselineStore.heap + (⟨.shared, .loc baselineLocation⟩ :: baselineBefore)) + (rewrittenOwned : IxIR1.Sim.RootOwnership rewrittenStore.heap + (⟨.shared, .loc rewrittenLocation⟩ :: rewrittenBefore)) + (retained : RetainSharedMany baselineStore baselineFields + baselineRetained) + (released : releaseShared (fieldFuel + 1) baselineRetained + (.loc baselineLocation) = .ok (baselineReleased, remaining)) + (baselinePartition : + (IxIR1.Sim.rootsFor .shared baselineFields.toList ++ + baselineBefore).Perm + (IxIR1.Sim.rootsFor .shared baselineNewFields.toList ++ + baselineAfter)) + (rewrittenPartition : + (IxIR1.Sim.rootsFor .shared rewrittenFields.toList ++ + rewrittenBefore).Perm + (IxIR1.Sim.rootsFor .shared rewrittenNewFields.toList ++ + rewrittenAfter)) + (mapped : MappedValuesInRoots site.shape + (baselinePrefixValues rewrittenParameters rewrittenFields) + rewrittenAfter) + (baselineAllocationResolved : resolveAtoms + (baselinePrefixValues baselineParameters baselineFields) + site.shape.allocationArguments = .ok baselineNewFields) + (rewrittenAllocationResolved : resolveAtoms + (baselinePrefixValues rewrittenParameters rewrittenFields) + site.shape.allocationArguments = .ok rewrittenNewFields) + (baselineFieldWorlds : + FieldWorlds baselineReleased allocationSchema baselineNewFields) + (rewrittenFieldWorlds : FieldWorlds + (physicalHotResetStore rewrittenStore rewrittenLocation) + allocationSchema rewrittenNewFields) + (tailResolved : resolveAtoms + ((baselinePrefixValues baselineParameters baselineFields).push + (.loc (baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor baselineNewFields)).2)) + site.shape.tailArguments = .ok baselineCallValues) + (arity : baselineCallValues.size = source.signature.params.size) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := baselineParameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := index + values := rewrittenParameters + credits := #[] } + rewrittenStack } + StableMacroSimulation limits validation baselineContext rewrittenContext + .physical baselineMachine rewrittenMachine := by + dsimp only + have mappedFull : MappedValuesInRoots site.shape + (baselinePrefixValues rewrittenParameters rewrittenFields) + (IxIR1.Sim.rootsFor .shared rewrittenNewFields.toList ++ + rewrittenAfter) := by + intro sourceId targetId sourceValue relevant translated found + have supported := mapped sourceId targetId sourceValue relevant translated + found + cases sourceValue with + | loc location => + obtain ⟨world, member⟩ := supported + exact ⟨world, List.mem_append_right _ member⟩ + | lit literal => trivial + | erased => trivial + obtain ⟨_physical, _outputIso, _physicalCallValues, _reused, + _physicalOwned, _baselineOwned, _outputResult, _outputExtends, + baselineSteps, rewrittenSteps, _callsRelated, _outputStack, related⟩ := + acceptedHotPhysicalStableSimulationIso rewrite found baselineSchemas + rewrittenSchemas inputIso parameters stack stackAvoids + stackCreditsAvoids fuel locations allocationSchemaAt parameterCount + fieldCount baselineSourceResolved rewrittenSourceResolved baselineAt + rewrittenAt baselineOwned rewrittenOwned retained released + baselinePartition rewrittenPartition mappedFull + baselineAllocationResolved + rewrittenAllocationResolved baselineFieldWorlds rewrittenFieldWorlds + tailResolved arity + exact .intro (2 * site.shape.fieldCount + 3) 4 (by omega) (by omega) _ _ + baselineSteps rewrittenSteps related + +/-- A cold accepted site remains a synchronization macro after an earlier +physical reuse has changed concrete locations. The source retain/release +prefix is first commuted into the cold-reset order, that order is transported +through the incoming allocation history, and corresponding fresh allocations +extend the history for the recursive call. -/ +theorem acceptedColdStableMacroSimulationIso {limits : Validate.Limits} + {validation : Validate.Context} {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {index helperOffset : Nat} {block : Block} + {site : Reuse.Site limits validation block} + (found : Reuse.FunctionDecisions.At rewrite.decisions index helperOffset + block (.accepted site)) + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + (baselineSchemas : baselineContext.schemas = validation.schemas) + (rewrittenSchemas : rewrittenContext.schemas = validation.schemas) + {baselineStore rewrittenStore baselineRetained : Store} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + {baselineParameters rewrittenParameters baselineFields + baselineNewFields baselineCallValues : Array RVal} + {baselineLocation fieldFuel rewrittenFuel rc retainedRc : Nat} + {baselineStack rewrittenStack : List Continuation} + (parameters : IxIR1.Sim.RValsIso heap.locRel + baselineParameters.toList rewrittenParameters.toList) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {allocationSchema : CtorSchema} + (fuel : fieldFuel + 1 ≤ rewrittenFuel) + (allocationSchemaAt : + baselineContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema) + (parameterCount : baselineParameters.size = site.shape.parameterCount) + (fieldCount : baselineFields.size = site.shape.fieldCount) + (baselineSourceResolved : + resolveAtom baselineParameters (.reg site.shape.source) = + .ok (.loc baselineLocation)) + (baselineAt : baselineStore.get? baselineLocation = some + ⟨.shared, rc, + .ctorN site.shape.sourceConstructor baselineFields⟩) + (shared : 1 < rc) + (retained : RetainSharedMany baselineStore baselineFields + baselineRetained) + (retainedAt : baselineRetained.get? baselineLocation = some + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor baselineFields⟩) + (baselineAllocationResolved : resolveAtoms + (baselinePrefixValues baselineParameters baselineFields) + site.shape.allocationArguments = .ok baselineNewFields) + (baselineFieldWorlds : FieldWorlds + (baselineDecrementStore baselineRetained baselineLocation + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor baselineFields⟩) + allocationSchema baselineNewFields) + (baselineTailResolved : resolveAtoms + ((baselinePrefixValues baselineParameters baselineFields).push + (.loc ((baselineDecrementStore baselineRetained baselineLocation + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor baselineFields⟩).allocNode + .shared + (.ctorN site.shape.allocationConstructor + baselineNewFields)).2)) + site.shape.tailArguments = .ok baselineCallValues) + (arity : baselineCallValues.size = source.signature.params.size) : + let baselineMachine : Machine := + { store := baselineStore + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := baselineParameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := index + values := rewrittenParameters + credits := #[] } + rewrittenStack } + StableMacroSimulation limits validation baselineContext rewrittenContext + interpretation baselineMachine rewrittenMachine := by + dsimp only + obtain ⟨sourceAt, resetAt, _hotAt, coldAt⟩ := rewrite.acceptedAt found + obtain ⟨sourceSchema, siteAllocationSchema, sourceSchemaAt, + siteAllocationSchemaAt, _sourceFields, _allocationFields, + sourceLayout, allocationLayout⟩ := + evalRuntimeSchemas site baselineSchemas + have allocationSchemaEq : siteAllocationSchema = allocationSchema := by + exact Option.some.inj + (siteAllocationSchemaAt.symm.trans allocationSchemaAt) + subst siteAllocationSchema + have rewrittenSourceSchemaAt : + rewrittenContext.schemas .shared site.shape.sourceConstructor = + some sourceSchema := by + simpa [baselineSchemas, rewrittenSchemas] using sourceSchemaAt + have rewrittenAllocationSchemaAt : + rewrittenContext.schemas .shared site.shape.allocationConstructor = + some allocationSchema := by + simpa [baselineSchemas, rewrittenSchemas] using allocationSchemaAt + obtain ⟨rewrittenSourceValue, rewrittenSourceResolved, + sourceValueRelated⟩ := + resolveAtom_iso parameters baselineSourceResolved + cases sourceValueRelated with + | @loc _ rewrittenLocation locations => + have baselineViewed : ConstructorView baselineStore baselineLocation + .shared site.shape.sourceConstructor + ⟨.shared, rc, + .ctorN site.shape.sourceConstructor baselineFields⟩ + baselineFields := + ConstructorView.of_box baselineAt rfl rfl + obtain ⟨rewrittenBox, rewrittenFields, rewrittenAt, + rewrittenViewed, boxes, fieldsRelated⟩ := + constructorView_historyIso heap locations baselineViewed + have rewrittenShared : 1 < rewrittenBox.rc := by + rw [← boxes.rc] + exact shared + have parameterSizes : baselineParameters.size = + rewrittenParameters.size := by + simpa using rvalsIso_length_eq parameters + have rewrittenParameterCount : rewrittenParameters.size = + site.shape.parameterCount := + parameterSizes.symm.trans parameterCount + have fieldSizes : baselineFields.size = rewrittenFields.size := by + simpa using rvalsIso_length_eq fieldsRelated + have rewrittenFieldCount : rewrittenFields.size = + site.shape.fieldCount := fieldSizes.symm.trans fieldCount + have prefixRelated : IxIR1.Sim.RValsIso heap.locRel + (baselinePrefixValues baselineParameters baselineFields).toList + (baselinePrefixValues rewrittenParameters rewrittenFields).toList := + by + simpa [baselinePrefixValues] using + rvalsIso_append_pair + (rvalsIso_append_pair parameters fieldsRelated) fieldsRelated + obtain ⟨rewrittenNewFields, rewrittenAllocationResolved, + newFieldsRelated⟩ := + resolveAtoms_iso prefixRelated baselineAllocationResolved + obtain ⟨actualRetainedRc, actualRetainedAt, baselineReleasedRun, + baselineResetRetained, baselineResetHeapEq⟩ := + coldPrefix_commutes (heapFuel := fieldFuel) baselineAt shared retained + have retainedBoxesEqual : + (⟨.shared, actualRetainedRc, + .ctorN site.shape.sourceConstructor baselineFields⟩ : + IxIR1.NodeBox) = + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor baselineFields⟩ := + Option.some.inj (actualRetainedAt.symm.trans retainedAt) + have retainedRcEqual : actualRetainedRc = retainedRc := by + cases retainedBoxesEqual + rfl + subst actualRetainedRc + let baselineReleased := + baselineDecrementStore baselineRetained baselineLocation + ⟨.shared, retainedRc, + .ctorN site.shape.sourceConstructor baselineFields⟩ + let baselineResetStore := + baselineReleased.tickResetAttempt.tickColdReset + let baselineBox : IxIR1.NodeBox := + ⟨.shared, rc, + .ctorN site.shape.sourceConstructor baselineFields⟩ + let updated := heap.setBox locations + (show baselineStore.heap.get? baselineLocation = some baselineBox from + baselineAt) + (show rewrittenStore.heap.get? rewrittenLocation = some rewrittenBox + from rewrittenAt) + (show IxIR1.Sim.NodeBoxIso heap.locRel + { baselineBox with rc := baselineBox.rc - 1 } + { rewrittenBox with rc := rewrittenBox.rc - 1 } from + ⟨boxes.world, + congrArg (fun count => count - 1) boxes.rc, boxes.node⟩) + let beforeRetains : IxIR1.Sim.HeapHistoryIso + (coldResetStartStore baselineStore baselineLocation + baselineBox).heap + (coldResetStartStore rewrittenStore rewrittenLocation + rewrittenBox).heap := by + simpa [coldResetStartStore, Eval.Store.tickResetAttempt, + Eval.Store.tickColdReset] using updated.rcTick + have relatedRetainedFields : IxIR1.Sim.RValsIso + beforeRetains.locRel baselineFields.toList rewrittenFields.toList := + by + change IxIR1.Sim.RValsIso heap.locRel _ _ + exact fieldsRelated + obtain ⟨rewrittenResetStore, afterRetains, + rewrittenResetRetained, afterRetainsRelation⟩ := + retainSharedMany_historyIso beforeRetains relatedRetainedFields + (by + simpa [baselineBox, baselineReleased, baselineResetStore] using + baselineResetRetained) + have baselineResetHeapEq' : baselineReleased.heap = + baselineResetStore.heap := by + simpa [baselineReleased, baselineResetStore] using + baselineResetHeapEq + let afterCold : IxIR1.Sim.HeapHistoryIso baselineReleased.heap + rewrittenResetStore.heap := + afterRetains.nodesEq + (congrArg IxIR1.Store.nodes baselineResetHeapEq') rfl + have afterColdRelation : afterCold.locRel = heap.locRel := by + calc + afterCold.locRel = afterRetains.locRel := rfl + _ = beforeRetains.locRel := afterRetainsRelation + _ = heap.locRel := rfl + have newFieldsAfterCold : IxIR1.Sim.RValsIso afterCold.locRel + baselineNewFields.toList rewrittenNewFields.toList := by + rw [afterColdRelation] + exact newFieldsRelated + have rewrittenFieldWorlds : FieldWorlds rewrittenResetStore + allocationSchema rewrittenNewFields := + baselineFieldWorlds.transport + (heapHistoryIso_fieldValuesWorldEq afterCold newFieldsAfterCold) + let baselineAllocation := baselineReleased.allocNode .shared + (.ctorN site.shape.allocationConstructor baselineNewFields) + let rewrittenAllocation := rewrittenResetStore.allocNode .shared + (.ctorN site.shape.allocationConstructor rewrittenNewFields) + let allocationHistory : IxIR1.Sim.HeapHistoryIso + baselineAllocation.1.heap rewrittenAllocation.1.heap := + afterCold.alloc (.ctor newFieldsAfterCold) + have oldExtends : ∀ {baselineCandidate rewrittenCandidate : Nat}, + heap.locRel baselineCandidate rewrittenCandidate → + allocationHistory.locRel baselineCandidate rewrittenCandidate := + by + intro baselineCandidate rewrittenCandidate related + apply Or.inr + rw [afterColdRelation] + exact related + have prefixAfterAllocation : IxIR1.Sim.RValsIso + allocationHistory.locRel + (baselinePrefixValues baselineParameters baselineFields).toList + (baselinePrefixValues rewrittenParameters rewrittenFields).toList := + rvalsIso_mono_rel oldExtends prefixRelated + have resultRelated : IxIR1.Sim.RValIso allocationHistory.locRel + (.loc baselineAllocation.2) (.loc rewrittenAllocation.2) := + .loc (.inl ⟨rfl, rfl⟩) + have tailInputsRelated : IxIR1.Sim.RValsIso allocationHistory.locRel + ((baselinePrefixValues baselineParameters baselineFields).push + (.loc baselineAllocation.2)).toList + ((baselinePrefixValues rewrittenParameters rewrittenFields).push + (.loc rewrittenAllocation.2)).toList := by + simpa using rvalsIso_append prefixAfterAllocation resultRelated + obtain ⟨rewrittenCallValues, rewrittenTailResolved, + callValuesRelated⟩ := + resolveAtoms_iso tailInputsRelated + (by simpa [baselineAllocation, baselineReleased] using + baselineTailResolved) + have callSizes : baselineCallValues.size = rewrittenCallValues.size := by + simpa using rvalsIso_length_eq callValuesRelated + have rewrittenArity : rewrittenCallValues.size = + rewrite.definition.signature.params.size := by + simpa using callSizes.symm.trans arity + have sourceNonempty : source.blocks.isEmpty = false := + blocks_nonempty_of_getElem sourceAt + have rewrittenNonempty : rewrite.definition.blocks.isEmpty = false := + blocks_nonempty_of_getElem resetAt + let baselineMachine : Machine := + { store := baselineStore + heapFuel := fieldFuel + 1 + control := .running + { definition := source + block := index + values := baselineParameters + credits := #[] } + baselineStack } + let rewrittenMachine : Machine := + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition + block := index + values := rewrittenParameters + credits := #[] } + rewrittenStack } + have baselineExecution : Steps baselineContext interpretation + (2 * site.shape.fieldCount + 3) baselineMachine + { store := baselineAllocation.1 + heapFuel := fieldFuel + control := .running + { definition := source, values := baselineCallValues } + baselineStack } := by + simpa [baselineMachine, baselineAllocation, baselineReleased] using + baselineAcceptedControl site + (context := baselineContext) (interpretation := interpretation) + (definition := source) (blockId := index) + (parameters := baselineParameters) (fields := baselineFields) + (newFields := baselineNewFields) + (callValues := baselineCallValues) + (location := baselineLocation) (machine := baselineMachine) + (retainedStore := baselineRetained) + (releasedStore := baselineReleased) (remaining := fieldFuel) + (allocationSchema := allocationSchema) (stack := baselineStack) + sourceAt (by rfl) parameterCount fieldCount + baselineSourceResolved baselineAt rfl retained + (by simpa [baselineReleased] using baselineReleasedRun) + allocationSchemaAt baselineAllocationResolved + (by simpa [baselineReleased] using baselineFieldWorlds) + (by simpa [baselineAllocation, baselineReleased] using + baselineTailResolved) + arity sourceNonempty + have rewrittenExecution : Steps rewrittenContext interpretation 4 + rewrittenMachine + { store := rewrittenAllocation.1 + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition, + values := rewrittenCallValues } + rewrittenStack } := by + simpa [rewrittenMachine, rewrittenAllocation] using + coldAcceptedControl site + (context := rewrittenContext) + (interpretation := interpretation) + (definition := rewrite.definition) (resetId := index) + (hotId := source.blocks.size + helperOffset) + (coldId := source.blocks.size + helperOffset + 1) + (parameters := rewrittenParameters) (fields := rewrittenFields) + (newFields := rewrittenNewFields) + (callValues := rewrittenCallValues) + (location := rewrittenLocation) (box := rewrittenBox) + (sourceSchema := sourceSchema) + (allocationSchema := allocationSchema) + (machine := rewrittenMachine) (resetStore := rewrittenResetStore) + (stack := rewrittenStack) resetAt coldAt rewrittenSourceSchemaAt + rewrittenAllocationSchemaAt sourceLayout allocationLayout + (by rfl) rewrittenParameterCount rewrittenFieldCount + (by simpa using rewrittenSourceResolved) rewrittenViewed + rewrittenShared + (by + simpa [rewrittenMachine, coldResetStartStore] using + rewrittenResetRetained) + rewrittenAllocationResolved rewrittenFieldWorlds + (by simpa [rewrittenAllocation] using rewrittenTailResolved) + rewrittenArity rewrittenNonempty + have outputStack : StableStackIso limits validation + allocationHistory.locRel baselineStack rewrittenStack := + stack.mono oldExtends + have outputFuel : fieldFuel ≤ rewrittenFuel := by omega + have related : StableMachineRel limits validation + { store := baselineAllocation.1 + heapFuel := fieldFuel + control := .running + { definition := source, values := baselineCallValues } + baselineStack } + { store := rewrittenAllocation.1 + heapFuel := rewrittenFuel + control := .running + { definition := rewrite.definition, + values := rewrittenCallValues } + rewrittenStack } := + StableMachineRel.history allocationHistory outputFuel + (.running + (.rewritten rewrite + (StableFrameIso.entry rewrite callValuesRelated)) + outputStack) + exact .intro (2 * site.shape.fieldCount + 3) 4 (by omega) (by omega) + _ _ baselineExecution rewrittenExecution related + +/-- Exhaustive synchronization dispatch from an exact-content stable state. +The rewrite's dependent block decision chooses either the proved public +one-step dispatcher or the accepted-site macro supplied by the global runtime +invariant. Thus later whole-run induction has exactly one accepted-site +obligation, rather than one obligation per ordinary instruction/terminator +shape. -/ +theorem stableMacroStepOfTrace {limits : Validate.Limits} + {validation : Validate.Context} {sourceProgram : Program} + (trace : Reuse.Trace limits validation sourceProgram) + {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : HeapContentsEq baselineStore rewrittenStore) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite (fun left right => left = right) + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation (fun left right => left = right) + baselineStack rewrittenStack) + {baselineStepTarget : Machine} + (stepped : Step + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + baselineStepTarget) + (accepted : ∀ {helperOffset : Nat} {block : Block} + {site : Reuse.Site limits validation block}, + Reuse.FunctionDecisions.At rewrite.decisions baselineFrame.block + helperOffset block (.accepted site) → + StableMacroSimulation limits validation + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) : + StableMacroSimulation limits validation + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } := by + have dispatch : ∀ {block : Block}, + baselineFrame.definition.blocks[baselineFrame.block]? = some block → + StableMacroSimulation limits validation + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } := by + intro block blockAt + cases frame.blockCase blockAt with + | unchanged sourceAt targetAt => + have sourceBlockAt : source.blocks[baselineFrame.block]? = + some block := by + rw [← frame.baselineDefinition] + exact blockAt + have blockEq := Option.some.inj (sourceAt.symm.trans sourceBlockAt) + cases blockEq + have rewrittenBlockAt : + rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block := by + rw [frame.rewrittenDefinition, ← frame.block] + exact targetAt + obtain ⟨rewrittenTarget, rewrittenStep, related⟩ := + unchangedStepOfTrace trace rewrite heap fuel frame stack blockAt + rewrittenBlockAt stepped + exact StableMacroSimulation.ofStepsOne rfl rfl stepped rewrittenStep + related + | accepted found => + exact accepted found + cases stepped.classify with + | instruction blockAt _pc _instructionAt _instructionCase => + exact dispatch blockAt + | terminator blockAt _pc _terminatorAt _terminatorCase => + exact dispatch blockAt + +/-- Exhaustive synchronization dispatch from an allocation-history-related +stable state. Ordinary blocks use the relation-aware one-step theorem; +accepted blocks remain a single macro obligation for the global invariant. -/ +theorem stableMacroStepOfTraceIso {limits : Validate.Limits} + {validation : Validate.Context} {sourceProgram : Program} + (trace : Reuse.Trace limits validation sourceProgram) + {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + (heap : IxIR1.Sim.HeapHistoryIso baselineStore.heap rewrittenStore.heap) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite heap.locRel + baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation heap.locRel + baselineStack rewrittenStack) + {baselineStepTarget : Machine} + (stepped : Step + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + baselineStepTarget) + (accepted : ∀ {helperOffset : Nat} {block : Block} + {site : Reuse.Site limits validation block}, + Reuse.FunctionDecisions.At rewrite.decisions baselineFrame.block + helperOffset block (.accepted site) → + StableMacroSimulation limits validation + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) : + StableMacroSimulation limits validation + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } := by + have dispatch : ∀ {block : Block}, + baselineFrame.definition.blocks[baselineFrame.block]? = some block → + StableMacroSimulation limits validation + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } := by + intro block blockAt + cases frame.blockCase blockAt with + | unchanged sourceAt targetAt => + have sourceBlockAt : source.blocks[baselineFrame.block]? = + some block := by + rw [← frame.baselineDefinition] + exact blockAt + have blockEq := Option.some.inj (sourceAt.symm.trans sourceBlockAt) + cases blockEq + have rewrittenBlockAt : + rewrittenFrame.definition.blocks[rewrittenFrame.block]? = + some block := by + rw [frame.rewrittenDefinition, ← frame.block] + exact targetAt + obtain ⟨rewrittenTarget, rewrittenStep, related⟩ := + unchangedStepOfTraceIso trace rewrite heap fuel frame stack blockAt + rewrittenBlockAt stepped + exact StableMacroSimulation.ofStepsOne rfl rfl stepped rewrittenStep + related + | accepted found => + exact accepted found + cases stepped.classify with + | instruction blockAt _pc _instructionAt _instructionCase => + exact dispatch blockAt + | terminator blockAt _pc _terminatorAt _terminatorCase => + exact dispatch blockAt + +/-- Uniform synchronization dispatch over either arm of `StableHeapRel`. +This is the macro-level interface consumed by a future whole-run induction: +the heap representation is no longer exposed to the caller. -/ +theorem stableMacroStepOfTraceRel {limits : Validate.Limits} + {validation : Validate.Context} {sourceProgram : Program} + (trace : Reuse.Trace limits validation sourceProgram) + {source : Function} + (rewrite : Reuse.FunctionRewrite limits validation source) + {oracle : Ix.Compiler.Ixon.Address → List RVal → Option RVal} + {interpretation : Interpretation} + {baselineStore rewrittenStore : Store} + {baselineFuel rewrittenFuel : Nat} + {baselineFrame rewrittenFrame : Frame} + {baselineStack rewrittenStack : List Continuation} + {locRel : Nat → Nat → Prop} + (heap : StableHeapRel baselineStore rewrittenStore locRel) + (fuel : baselineFuel ≤ rewrittenFuel) + (frame : StableFrameIso rewrite locRel baselineFrame rewrittenFrame) + (stack : StableStackIso limits validation locRel + baselineStack rewrittenStack) + {baselineStepTarget : Machine} + (stepped : Step + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + baselineStepTarget) + (accepted : ∀ {helperOffset : Nat} {block : Block} + {site : Reuse.Site limits validation block}, + Reuse.FunctionDecisions.At rewrite.decisions baselineFrame.block + helperOffset block (.accepted site) → + StableMacroSimulation limits validation + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack }) : + StableMacroSimulation limits validation + (Eval.Context.ofProgram sourceProgram validation.schemas oracle) + (Eval.Context.ofProgram trace.target validation.schemas oracle) + interpretation + { store := baselineStore + heapFuel := baselineFuel + control := .running baselineFrame baselineStack } + { store := rewrittenStore + heapFuel := rewrittenFuel + control := .running rewrittenFrame rewrittenStack } := by + cases heap with + | contents same => + exact stableMacroStepOfTrace trace rewrite same fuel frame stack stepped + accepted + | isomorphic iso => + exact stableMacroStepOfTraceIso trace rewrite iso.symm fuel frame stack + stepped accepted + +/-! ## Finite whole-machine synchronization -/ + +/-- A global invariant whose synchronized running states always admit one +invariant-preserving macro lifts every finite baseline execution ending in a +halt to a finite rewritten execution. Baseline macro prefixes are cancelled +from the unique small-step path, and strict positivity supplies the decreasing +measure for strong induction even though accepted sites consume more than one +baseline instruction. -/ +theorem stableFiniteExecutionOfMacroInvariant {limits : Validate.Limits} + {validation : Validate.Context} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + (invariant : Machine → Machine → Prop) + (related : ∀ {baseline rewritten}, invariant baseline rewritten → + StableMachineRel limits validation baseline rewritten) + (advance : ∀ {baseline rewritten baselineNext : Machine} + {frame : Frame} {stack : List Continuation}, + invariant baseline rewritten → + baseline.control = .running frame stack → + Step baselineContext interpretation baseline baselineNext → + StableMacroInvariantStep limits validation baselineContext + rewrittenContext interpretation invariant baseline rewritten) + {baselineCount : Nat} {baselineStart rewrittenStart baselineFinal : + Machine} + {finalStore : Store} {finalHeapFuel : Nat} {finalValue : RVal} + (initial : invariant baselineStart rewrittenStart) + (baselineSteps : Steps baselineContext interpretation baselineCount + baselineStart baselineFinal) + (halted : baselineFinal = + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue }) : + ∃ rewrittenCount rewrittenFinal, + Steps rewrittenContext interpretation rewrittenCount rewrittenStart + rewrittenFinal ∧ + invariant baselineFinal rewrittenFinal ∧ + StableMachineRel limits validation baselineFinal rewrittenFinal := by + induction baselineCount using Nat.strongRecOn generalizing baselineStart + rewrittenStart baselineFinal with + | ind baselineCount smaller => + cases baselineSteps with + | refl => + exact ⟨0, rewrittenStart, .refl rewrittenStart, initial, + related initial⟩ + | @cons count before middle after frame stack running head tail => + have synchronizedStep := advance initial running head + cases synchronizedStep with + | intro macroBaselineCount macroRewrittenCount baselinePositive + rewrittenPositive macroBaselineTarget macroRewrittenTarget + macroBaselineSteps macroRewrittenSteps macroRelated preserved => + obtain ⟨suffixCount, totalCount, suffixSteps⟩ := + macroBaselineSteps.cancelPrefixToHalted + (Steps.cons running head tail) halted + have suffixSmaller : suffixCount < Nat.succ count := by + omega + obtain ⟨suffixRewrittenCount, rewrittenFinal, + suffixRewrittenSteps, finalInvariant, finalRelated⟩ := + smaller suffixCount suffixSmaller preserved suffixSteps halted + exact ⟨macroRewrittenCount + suffixRewrittenCount, + rewrittenFinal, + macroRewrittenSteps.trans suffixRewrittenSteps, + finalInvariant, finalRelated⟩ + +/-- Runner-level form of `stableFiniteExecutionOfMacroInvariant`. A finite +halted baseline execution yields an exact rewritten control budget, a halted +rewritten result related through the final heap relation, and the corresponding +successful `runMachine` equation. -/ +theorem stableRunMachineOfMacroInvariant {limits : Validate.Limits} + {validation : Validate.Context} + {baselineContext rewrittenContext : Eval.Context} + {interpretation : Interpretation} + (invariant : Machine → Machine → Prop) + (related : ∀ {baseline rewritten}, invariant baseline rewritten → + StableMachineRel limits validation baseline rewritten) + (advance : ∀ {baseline rewritten baselineNext : Machine} + {frame : Frame} {stack : List Continuation}, + invariant baseline rewritten → + baseline.control = .running frame stack → + Step baselineContext interpretation baseline baselineNext → + StableMacroInvariantStep limits validation baselineContext + rewrittenContext interpretation invariant baseline rewritten) + {baselineCount : Nat} {baselineStart rewrittenStart : Machine} + {finalStore : Store} {finalHeapFuel : Nat} {finalValue : RVal} + (initial : invariant baselineStart rewrittenStart) + (baselineSteps : Steps baselineContext interpretation baselineCount + baselineStart + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue }) : + ∃ rewrittenCount rewrittenStore rewrittenHeapFuel rewrittenValue locRel, + let rewrittenFinal : Machine := + { store := rewrittenStore + heapFuel := rewrittenHeapFuel + control := .halted rewrittenValue } + Steps rewrittenContext interpretation rewrittenCount rewrittenStart + rewrittenFinal ∧ + invariant + { store := finalStore + heapFuel := finalHeapFuel + control := .halted finalValue } + rewrittenFinal ∧ + StableHeapRel finalStore rewrittenStore locRel ∧ + finalHeapFuel ≤ rewrittenHeapFuel ∧ + IxIR1.Sim.RValIso locRel finalValue rewrittenValue ∧ + Eval.runMachine rewrittenContext interpretation rewrittenCount + rewrittenStart = + .ok + { store := rewrittenStore + value := rewrittenValue + controlRemaining := 0 + heapRemaining := rewrittenHeapFuel } := by + obtain ⟨rewrittenCount, rewrittenFinal, rewrittenSteps, finalInvariant, + finalRelated⟩ := + stableFiniteExecutionOfMacroInvariant invariant related advance initial + baselineSteps rfl + obtain ⟨rewrittenStore, rewrittenHeapFuel, rewrittenValue, locRel, + rewrittenFinalEq, finalHeap, finalFuel, finalValueRelated⟩ := + finalRelated.haltedParts + subst rewrittenFinal + refine ⟨rewrittenCount, rewrittenStore, rewrittenHeapFuel, rewrittenValue, + locRel, rewrittenSteps, finalInvariant, finalHeap, finalFuel, + finalValueRelated, ?_⟩ + exact rewrittenSteps.runMachine_halted + +end Ix.Compiler.IxIR2.ReuseSim diff --git a/Ix/Compiler/IxIR2/ReuseSimExamples.lean b/Ix/Compiler/IxIR2/ReuseSimExamples.lean new file mode 100644 index 000000000..0d0673695 --- /dev/null +++ b/Ix/Compiler/IxIR2/ReuseSimExamples.lean @@ -0,0 +1,197 @@ +import Ix.Compiler.IxIR2.ReuseSim + +/-! +# Dynamic shared-reuse simulation fixtures + +The fixtures keep the semantic theorems honest without coupling them to the +larger reversal benchmark. The leaf case exercises physical reuse directly; +the linked case also runs the baseline retain/deep-release prefix and verifies +that its child refcount traffic cancels before the replacement is allocated. +-/ + +namespace Ix.Compiler.IxIR2.ReuseSim.Examples + +open Ix.Compiler.Ixon (Address Owned) +open Ix.Compiler.IxIR2.Eval + +private def blockAddress : Address := Address.replicate 0xa1 + +private def oldNode : IxIR1.Node := + .ctorN { block := blockAddress, indIdx := 0, cidx := 0 } #[] + +private def newNode : IxIR1.Node := + .ctorN { block := blockAddress, indIdx := 0, cidx := 1 } #[] + +private def childNode : IxIR1.Node := + .ctorN { block := blockAddress, indIdx := 1, cidx := 0 } #[] + +private def childHeap : IxIR1.Store := + (({} : IxIR1.Store).allocNode .shared childNode).1 + +private def childLocation : Nat := + (({} : IxIR1.Store).allocNode .shared childNode).2 + +private def linkedOldNode : IxIR1.Node := + .ctorN { block := blockAddress, indIdx := 2, cidx := 0 } + #[.loc childLocation] + +private def linkedNewNode : IxIR1.Node := + .ctorN { block := blockAddress, indIdx := 2, cidx := 1 } + #[.loc childLocation] + +private def linkedHeap : IxIR1.Store := + (childHeap.allocNode .shared linkedOldNode).1 + +private def linkedTarget : Nat := + (childHeap.allocNode .shared linkedOldNode).2 + +private def linkedStore : Store := + { heap := linkedHeap } + +private def initialHeap : IxIR1.Store := + (({} : IxIR1.Store).allocNode .shared oldNode).1 + +private def target : Nat := + (({} : IxIR1.Store).allocNode .shared oldNode).2 + +private def initialStore : Store := + { heap := initialHeap } + +private theorem target_live : + initialStore.get? target = some ⟨.shared, 1, oldNode⟩ := by + exact IxIR1.Sim.HeapIso.get?_allocNode_new + ({} : IxIR1.Store) .shared oldNode + +private theorem initial_owned : + IxIR1.Sim.RootOwnership initialStore.heap + [⟨.shared, .loc target⟩] := by + apply IxIR1.Sim.RootOwnership.allocNode (store := ({} : IxIR1.Store)) + · simpa [oldNode, IxIR1.Sim.nodeChildren, IxIR1.Sim.rootsFor] using + IxIR1.Sim.RootOwnership.empty + · trivial + +private theorem child_live : + linkedStore.get? childLocation = some ⟨.shared, 1, childNode⟩ := by + apply IxIR1.Sim.HeapIso.get?_allocNode_old + exact IxIR1.Sim.HeapIso.get?_allocNode_new + ({} : IxIR1.Store) .shared childNode + +private theorem linked_target_live : + linkedStore.get? linkedTarget = + some ⟨.shared, 1, linkedOldNode⟩ := by + exact IxIR1.Sim.HeapIso.get?_allocNode_new + childHeap .shared linkedOldNode + +private theorem child_owned : + IxIR1.Sim.RootOwnership childHeap + [⟨.shared, .loc childLocation⟩] := by + apply IxIR1.Sim.RootOwnership.allocNode (store := ({} : IxIR1.Store)) + · simpa [childNode, IxIR1.Sim.nodeChildren, + IxIR1.Sim.rootsFor] using IxIR1.Sim.RootOwnership.empty + · trivial + +private theorem linked_owned : + IxIR1.Sim.RootOwnership linkedStore.heap + [⟨.shared, .loc linkedTarget⟩] := by + apply IxIR1.Sim.RootOwnership.allocNode (store := childHeap) + · simpa [linkedOldNode, IxIR1.Sim.nodeChildren, + IxIR1.Sim.rootsFor] using child_owned + · trivial + +private def linkedRetainedStore : Store := + incrementSharedStore linkedStore childLocation + ⟨.shared, 1, childNode⟩ + +private theorem linked_retained : + RetainSharedMany linkedStore #[.loc childLocation] + linkedRetainedStore := by + refine RetainSharedMany.cons (middle := linkedRetainedStore) ?_ + (RetainSharedMany.empty _) + simp [retainShared, child_live, linkedRetainedStore, + incrementSharedStore] + +private theorem linkedRetained_child_live : + linkedRetainedStore.get? childLocation = + some ⟨.shared, 2, childNode⟩ := by + exact get?_incrementSharedStore_same child_live + +private theorem linkedRetained_target_live : + linkedRetainedStore.get? linkedTarget = + some ⟨.shared, 1, linkedOldNode⟩ := by + apply get?_incrementSharedStore_other + · decide + · exact child_live + · exact linked_target_live + +private def linkedReleaseStart : Store := + linkedRetainedStore.rcTick.kill linkedTarget + +private theorem linkedReleaseStart_child_live : + linkedReleaseStart.get? childLocation = + some ⟨.shared, 2, childNode⟩ := by + apply IxIR1.Sim.get?_kill_other + · decide + · exact linkedRetained_target_live + · exact linkedRetained_child_live + +private def linkedReleasedStore : Store := + baselineDecrementStore linkedReleaseStart childLocation + ⟨.shared, 2, childNode⟩ + +private theorem linked_released : + releaseShared 2 linkedRetainedStore (.loc linkedTarget) = + .ok (linkedReleasedStore, 0) := by + simp only [releaseShared, releaseSharedWork, linkedRetained_target_live, + linkedOldNode] + change releaseSharedWork 1 linkedReleaseStart [.loc childLocation] = _ + simp [releaseSharedWork, linkedReleaseStart_child_live, + linkedReleasedStore, baselineDecrementStore] + +/-- The concrete physical operation succeeds, and its heap is related to the +logical operation's heap by the same live-location bijection exported to the +general block proof. -/ +theorem leafHotReuseProducesRelatedHeaps : + ∃ physical logical, + physicalHotReuseStore initialStore target newNode 0 = .ok physical ∧ + logical = (logicalHotReuseStore initialStore target newNode).1 ∧ + Nonempty (IxIR1.Sim.HeapIso physical.heap logical.heap) := by + obtain ⟨physical, reused, iso, _, _, _⟩ := + hotReuse_sound (store := initialStore) (target := target) + (oldNode := oldNode) (newNode := newNode) + (before := []) (after := []) 0 target_live initial_owned + (by simp [oldNode, newNode, IxIR1.Sim.nodeChildren, + IxIR1.Sim.rootsFor]) + (by trivial) + exact ⟨physical, (logicalHotReuseStore initialStore target newNode).1, + reused, rfl, ⟨iso⟩⟩ + +/-- A one-child constructor exercises the whole baseline-prefix theorem: +retain the projected child, deep-release the unit parent, then allocate the +replacement. Physical reset/reuse reaches a heap isomorphic to that concrete +baseline execution. -/ +theorem linkedHotPrefixProducesRelatedHeaps : + ∃ physical, + physicalHotReuseStore linkedStore linkedTarget linkedNewNode 1 = + .ok physical ∧ + Nonempty (IxIR1.Sim.HeapIso physical.heap + (linkedReleasedStore.allocNode .shared linkedNewNode).1.heap) := by + obtain ⟨physical, reused, iso, _, _, _⟩ := + hotPrefixReuse_sound + (store := linkedStore) + (baselineRetained := linkedRetainedStore) + (baselineReleased := linkedReleasedStore) + (target := linkedTarget) + (oldCid := { block := blockAddress, indIdx := 2, cidx := 0 }) + (newCid := { block := blockAddress, indIdx := 2, cidx := 1 }) + (fields := #[.loc childLocation]) + (newFields := #[.loc childLocation]) + (fieldFuel := 1) + (remaining := 0) + (before := []) + (after := []) + 1 linked_target_live linked_owned linked_retained linked_released + (by simp [IxIR1.Sim.rootsFor]) + (by trivial) + exact ⟨physical, reused, ⟨iso⟩⟩ + +end Ix.Compiler.IxIR2.ReuseSim.Examples diff --git a/Ix/Compiler/IxIR2/SourcePipelineSim.lean b/Ix/Compiler/IxIR2/SourcePipelineSim.lean new file mode 100644 index 000000000..acf0669cf --- /dev/null +++ b/Ix/Compiler/IxIR2/SourcePipelineSim.lean @@ -0,0 +1,119 @@ +import Ix.Compiler.IxIR2.PipelinePhysical + +/-! General source-to-physical composition, retaining constructor-valued +observations and the complete heap graph. Scalar and closed Nat native +endpoints can share this source boundary. -/ +namespace Ix.Compiler.IxIR2.Pipeline +open Ix.Compiler Ix.Compiler.Pipeline Ix.Compiler.IxIR1.Lower Ix.Compiler.IxIR1.LowerSim + +theorem Attached.sourcePhysical + {constants : List (Ixon.Address × Ixon.Constant)} + {mainAddress : Ixon.Address} {config : Ix.Compiler.Pipeline.Config} + {eraseFuel lowerFuel : Nat} + (attached : Attached constants mainAddress config .shared eraseFuel lowerFuel) + {sourceFuel : Nat} {sourceValue : Ixon.Eval.Value} + (horacles : @Sim.OracleRel attached.source.memberScope + (validatedEvalCtx constants config).inlineSharing attached.source.rawCtx) + (hctx : (validatedEvalCtx constants config).SharingWF) + (hsource : Ixon.Eval.eval (validatedEvalCtx constants config) sourceFuel + (validatedMainFrame mainAddress) [] validatedMainSource = .ok sourceValue) : + ∃ rawValue ir1Fuel ir1Store ir1Value controlFuel heapFuel physicalResult, + @Sim.InlinedValRel (validatedEvalCtx constants config) attached.source.rawCtx + sourceValue rawValue attached.source.memberScope ∧ + MutualAddressedValueGraph + (IxIR0.MutualBlock.Renaming.apply attached.source.erasure.result.addressMap) + (attached.source.lowering.result.rebuildRename attached.source.lowering.raw) + attached.source.functionRel ir1Store rawValue ir1Value ∧ + IxIR1.runOwnedMain attached.compiled.simulationSourceContext .shared + attached.target.artifact.source.main ir1Fuel = .ok (ir1Store, ir1Value) ∧ + IxIR2.Eval.runMain attached.compiled.simulationTargetContext .physical + attached.target.artifact.program controlFuel heapFuel = .ok physicalResult ∧ + IxIR2.Lower.Sim.OutcomeRel (ir1Store, ir1Value) physicalResult := by + letI : Sim.MemberScope := attached.source.memberScope + have hframe : (validatedMainFrame mainAddress).SharingWF := by + constructor + · rfl + · intro index member found + simp [validatedMainFrame] at found + have hbelow : Ixon.Sharing.sharesBelow + (validatedMainFrame mainAddress).sharing.size validatedMainSource = true := rfl + have herase : EraseAddressed.run + (EraseValidator.eraseCtxOf (validatedEvalCtx constants config)) + constants attached.source.entry.target eraseFuel = .ok attached.source.erasure.result := by + rw [attached.source.entryTarget] + exact attached.source.erasure.runEq + obtain ⟨traceFuel, addressedValue, trace, sourceRelation⟩ := + CallAwareProjectionSafe.of_certifiedSharedClosed_addressed_with_members + (fun _ _ => none) + (IxIR0.Readdress.Oracle.readdress attached.source.erasure.result.addressMap (fun _ _ => none)) + attached.source.members attached.source.entry herase + (IxIR0.Readdress.Oracle.readdress_compatible + (IxIR0.Readdress.Oracle.Readdressable.empty attached.source.erasure.result.addressMap)) + horacles hctx hframe hbelow hsource + obtain ⟨rawValue, sourceRelation, addressedValueEq⟩ := sourceRelation + subst addressedValue + have lowered : (lowerAllAction attached.source.erasure.result.declarations + attached.source.erasure.result.main .shared lowerFuel).run {} = + .ok (attached.source.lowering.raw, attached.source.lowering.mainCode) + attached.source.lowering.finalState := by + simpa only [lowerAllIndexedAction_eq_lowerAllAction] using attached.source.lowering.lowerRun + have progress := lowerAllAction_main_progress_of_trace_sealed rfl lowered + (fun member => attached.source.exactTargetCtx_decls_of_mem (fun _ _ => none) member) + (attached.source.exactExtraRepresented (fun _ _ => none)) + (attached.source.exactCompilerContracts (fun _ _ => none)).1 + (attached.source.externValueContract (fun _ _ => none)) + (attached.source.externTraceProgressContract (fun _ _ => none)) trace + have simulation : SemanticForwardSimulation attached.source.addressedSourceCtx + (attached.source.exactTargetCtx (fun _ _ => none)) + attached.source.erasure.result.main attached.source.lowering.mainCode + attached.source.functionRel := by + apply lowerAllAction_semanticForwardSimulation_of_targetProgress_sealed rfl lowered + (fun member => attached.source.exactTargetCtx_decls_of_mem (fun _ _ => none) member) + (attached.source.exactExtraRepresented (fun _ _ => none)) + (attached.source.exactCompilerContracts (fun _ _ => none)).1 + (attached.source.externValueContract (fun _ _ => none)) + intro _ _ _ + exact progress + obtain ⟨ir1Fuel, rawStore, ir1Value, rawRun, graph⟩ := simulation trace.run + let rename := attached.source.lowering.result.rebuildRename attached.source.lowering.raw + let ir1Store := IxIR1.Readdress.Store.mapAddresses rename rawStore + have ownership := lowerAllAction_main_owned lowered + (attached.source.exactExtraRepresented (fun _ _ => none)) + (attached.source.exactCompilerContracts (fun _ _ => none)).1 rawRun + have rawWorld : IxIR1.Sim.HasWorld rawStore .shared ir1Value := + ownership.roots_world ⟨.shared, ir1Value⟩ (by simp) + have finalWorld : IxIR1.Sim.HasWorld ir1Store .shared ir1Value := + (IxIR1.Sim.hasWorld_mapAddresses_iff rename rawStore .shared ir1Value).mpr rawWorld + have sourceRun : IxIR1.runMain attached.compiled.simulationSourceContext + attached.source.lowering.result.main ir1Fuel = .ok (ir1Store, ir1Value) := by + have audit : attached.source.lowering.result.rebuildSemanticAudit + attached.source.lowering.raw attached.source.lowering.mainCode = true := + attached.compiled.sourceRebuildSemanticAudit + have renames : IxIR1.Readdress.Ctx.Renames rename + (attached.source.exactTargetCtx (fun _ _ => none)) + attached.compiled.simulationSourceContext := attached.compiled.sourceContextRenames + rw [attached.source.lowering.result.main_eq_rebuildMapAddresses audit] + rw [IxIR1.Readdress.runMain_mapAddresses renames + attached.source.lowering.mainCode ir1Fuel, rawRun] + rfl + have mainEq : attached.target.artifact.source.main = attached.source.lowering.result.main := by + rw [attached.targetSourceProduced, attached.inputProduced] + rfl + have resultEq : attached.target.artifact.source.mainResult = .shared := by + rw [attached.targetSourceProduced, attached.inputProduced] + have ownedRun : IxIR1.runOwnedMain attached.compiled.simulationSourceContext + attached.target.artifact.source.mainResult attached.target.artifact.source.main ir1Fuel = + .ok (ir1Store, ir1Value) := by + rw [mainEq, resultEq] + unfold IxIR1.runOwnedMain + change (IxIR1.runMain attached.compiled.simulationSourceContext + attached.source.lowering.result.main ir1Fuel >>= IxIR1.checkResultWorld .shared) = _ + rw [sourceRun] + simp [IxIR1.checkResultWorld, IxIR1.Sim.rval_hasWorld_eq_true_iff.mpr finalWorld] + obtain ⟨controlFuel, heapFuel, physicalResult, physicalRun, related⟩ := + attached.compiled.successfulPhysicalMainSimulation ownedRun + refine ⟨rawValue, ir1Fuel, ir1Store, ir1Value, controlFuel, heapFuel, physicalResult, + sourceRelation, ⟨rawStore, rfl, graph⟩, ?_, physicalRun, related⟩ + simpa only [resultEq] using ownedRun + +end Ix.Compiler.IxIR2.Pipeline diff --git a/Ix/Compiler/IxIR2/UniqueLower.lean b/Ix/Compiler/IxIR2/UniqueLower.lean new file mode 100644 index 000000000..db1c281bf --- /dev/null +++ b/Ix/Compiler/IxIR2/UniqueLower.lean @@ -0,0 +1,140 @@ +import Ix.Compiler.UniqueReuse.Lower +import Ix.Compiler.IxIR2.Pipeline +import Ix.Compiler.IxIR2.Reuse + +/-! A separate consuming translation rule for a checked unique recursor. +The ordinary lowerer's non-scalar shallow-free rejection remains intact. +Here the complete case/field/free shape is known: `takeUnique` transfers every +field, and `discardCredit` implements the original shallow free. Every output +crosses the ordinary call-local v0 validator before optional static reuse. -/ + +namespace Ix.Compiler.IxIR2.UniqueLower + +open Ix.Compiler.Ixon (Owned) +open Ix.Compiler.IxIR0.UniqueReverse (Schema Plan) +open Ix.Compiler.UniqueReuse (nilId consId functionAddress) + +def policyTag : String := "consuming-unique-recursor/1" +def reusePolicyTag : String := "static-unique-reuse/1" + +def schemas (schema : Schema) : Owned → CtorId → Option CtorSchema + | .unique, identity => + if identity == nilId schema then + some { layout := Pipeline.baselineLayout .unique identity, fields := #[] } + else if identity == consId schema then + some { layout := Pipeline.baselineLayout .unique identity, fields := #[.unique, .unique] } + else none + | .shared, _ => none + +def signature : Signature := + { params := #[{ world := .unique, passing := .owned }, { world := .unique, passing := .owned }] + result := .unique, papSafe := false } + +def entryBlock (schema : Schema) : Block := + { valueParams := #[.owned .unique, .owned .unique], creditParams := #[], instructions := #[] + terminator := .switchValue (.reg 1) #[ + { cid := nilId schema, edge := { target := 1, values := #[.reg 0, .reg 1], credits := #[] } }, + { cid := consId schema, edge := { target := 2, values := #[.reg 0, .reg 1], credits := #[] } }] none } + +def nilBlock (schema : Schema) : Block := + { valueParams := #[.owned .unique, .owned .unique], creditParams := #[] + instructions := #[.takeUnique (.reg 1) (nilId schema), .discardCredit 0] + terminator := .ret (.reg 0) } + +def consBlock (schema : Schema) (reuse : Bool) : Block := + { valueParams := #[.owned .unique, .owned .unique], creditParams := #[] + instructions := #[.takeUnique (.reg 1) (consId schema)] ++ + (if reuse then #[.allocWith 0 .unique (consId schema) #[.reg 2, .reg 0]] + else #[.discardCredit 0, .alloc .unique (consId schema) #[.reg 2, .reg 0]]) + terminator := .tailCallSelf #[.reg 4, .reg 3] } + +def function (schema : Schema) (reuse : Bool) : Function := + { signature, blocks := #[entryBlock schema, nilBlock schema, consBlock schema reuse] } + +def inputInstructions (plan : Plan) : Array Instr := + #[.alloc .unique (nilId plan.schema) #[]] ++ + (plan.values.reverse.mapIdx fun index value => + .alloc .unique (consId plan.schema) #[.lit (.nat value), .reg index]).toArray ++ + #[.alloc .unique (nilId plan.schema) #[]] + +def mainFunction (plan : Plan) : Function := + { signature := { params := #[], result := .unique, papSafe := false } + blocks := #[ + { valueParams := #[], creditParams := #[], instructions := inputInstructions plan + terminator := .tailCall (functionAddress plan.schema) + #[.reg (plan.values.length + 1), .reg plan.values.length] }] } + +def program (plan : Plan) (reuse : Bool) : Program := + { declarations := [(functionAddress plan.schema, .fn (function plan.schema reuse))] + main := mainFunction plan } + +def context (schema : Schema) : Validate.Context := { schemas := schemas schema } + +def input (plan : Plan) : Lower.Input := + { declarations := Ix.Compiler.UniqueReuse.declarations plan.schema + main := Ix.Compiler.UniqueReuse.mainCode plan, mainResult := .unique } + +structure Translation (source : Lower.Input) (plan : Plan) (limits : Validate.Limits) where + sourceEq : source = input plan + checked : Validate.Checked limits (context plan.schema) (program plan false) + +def translate (plan : Plan) (limits : Validate.Limits := Validate.defaultLimits) : + Except String (Translation (input plan) plan limits) := + match hc : Validate.validateWith limits (context plan.schema) (program plan false) with + | .error error => .error s!"consuming target rejected: {repr error}" + | .ok stats => .ok { sourceEq := rfl, checked := { stats, accepted := hc } } + +inductive Skip where + | disabled + | rewriteBudget + | liveness (detail : String) + | layout + | validation (error : Validate.Error) + deriving Repr + +structure ReusePolicy where + enabled : Bool := true + maxRewrites : Nat := 1 + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr + +inductive Selection (plan : Plan) (limits : Validate.Limits) where + | baseline (reason : Skip) (checked : Validate.Checked limits (context plan.schema) (program plan false)) + | optimized (placement : Reuse.Placement (consBlock plan.schema false)) + (valueEq : placement.value = 1) (positionEq : placement.position = 0) + (checked : Validate.Checked limits (context plan.schema) (program plan true)) + +def Selection.reused {plan : Plan} {limits : Validate.Limits} : Selection plan limits → Bool + | .baseline .. => false + | .optimized .. => true + +def Selection.program {plan : Plan} {limits : Validate.Limits} (selection : Selection plan limits) : Program := + UniqueLower.program plan selection.reused + +def Selection.checked {plan : Plan} {limits : Validate.Limits} (selection : Selection plan limits) : + Validate.Checked limits (context plan.schema) selection.program := by + cases selection with + | baseline _ checked => exact checked + | optimized _ _ _ checked => exact checked + +/-- The source instance fixes both constructors of this reuse site. Liveness +still certifies the actual consumed register, and complete validation checks +the target credit and field transfers. Any optional failure retains the exact +checked consuming baseline. -/ +def select (plan : Plan) (limits : Validate.Limits) + (baseline : Validate.Checked limits (context plan.schema) (program plan false)) + (policy : ReusePolicy := {}) : Selection plan limits := + if !policy.enabled then .baseline .disabled baseline + else if policy.maxRewrites == 0 then .baseline .rewriteBudget baseline + else match hp : Reuse.inferPlacementWith limits (consBlock plan.schema false) 1 0 with + | .error error => .baseline (.liveness s!"{repr error}") baseline + | .ok none => .baseline (.liveness "unique source has a later use") baseline + | .ok (some placement) => + have hm := Reuse.inferPlacementWith_sound hp + match schemas plan.schema .unique (consId plan.schema) with + | none => .baseline .layout baseline + | some _ => + match hc : Validate.validateWith limits (context plan.schema) (program plan true) with + | .error error => .baseline (.validation error) baseline + | .ok stats => .optimized placement hm.1 hm.2 { stats, accepted := hc } + +end Ix.Compiler.IxIR2.UniqueLower diff --git a/Ix/Compiler/IxIR2/Validate.lean b/Ix/Compiler/IxIR2/Validate.lean new file mode 100644 index 000000000..f9a8305ca --- /dev/null +++ b/Ix/Compiler/IxIR2/Validate.lean @@ -0,0 +1,1093 @@ +import Ix.Compiler.IxIR2.CreditPolicy +import Std.Data.HashMap + +/-! +# Bounded executable validation for IxIR₂ + +The checker treats the CFG and its capability annotations as untrusted input. +It reconstructs ownership flow within every block, checks complete transfer at +every edge, validates borrow/lender remapping, and keeps reuse credits linear +in a register file separate from ordinary values. + +All traversals are structurally finite, and explicit limits reject oversized +artifacts before they can make certificate checking unexpectedly expensive. +-/ + +namespace Ix.Compiler.IxIR2.Validate + +open Ix.Compiler.Ixon (Address Owned) +open Ix.Compiler.IxIR2 + +/-- Stable identity for the function currently being checked. -/ +inductive Owner where + | main + | declaration (address : Address) + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +structure Site where + owner : Owner + block : BlockId + instruction : Option Nat := none + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- A checked fact permitting the deliberately narrow v0 shallow-free rule. -/ +structure ScalarLeafFact where + owner : Owner + block : BlockId + value : ValueId + cid : CtorId + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- Trusted inputs selected by the enclosing certificate boundary. Constructor +schemas are keyed by world because unique and shared layouts may differ. -/ +structure Context where + schemas : Owned → CtorId → Option CtorSchema := fun _ _ => none + scalarLeaves : List ScalarLeafFact := [] + /-- Generic tooling may opt in; validator-gated compilation leaves this off. -/ + allowExtern : Bool := false + +/-- Explicit denial-of-service bounds for untrusted CFGs and sidecars. -/ +structure Limits where + maxDeclarations : Nat := 4096 + maxBlocks : Nat := 16384 + maxBlocksPerFunction : Nat := 4096 + maxInstructionsPerBlock : Nat := 65536 + maxValueParams : Nat := 4096 + maxCreditParams : Nat := 4096 + maxOperands : Nat := 4096 + maxAlternatives : Nat := 4096 + maxValueRegisters : Nat := 262144 + maxCreditRegisters : Nat := 262144 + maxScalarLeafFacts : Nat := 65536 + maxFlowWork : Nat := 16777216 + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +def defaultLimits : Limits := {} + +inductive Resource where + | declarations + | blocks + | blocksPerFunction + | instructionsPerBlock + | valueParameters + | creditParameters + | operands + | alternatives + | valueRegisters + | creditRegisters + | scalarLeafFacts + | flowWork + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- Coarse, stable rejection classes. Human-readable detail remains free to +improve without making callers parse strings. -/ +inductive Violation where + | signature + | schema + | register + | ownership + | borrow + | credit + | call + | controlFlow + | resources + | externBoundary + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +inductive Error where + | limit (site : Site) (resource : Resource) (actual maximum : Nat) + | duplicateDeclaration (address : Address) + | invalid (site : Site) (violation : Violation) (detail : String) + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +/-- Structural work accepted by a successful validation. -/ +structure Stats where + declarations : Nat := 0 + functions : Nat := 0 + blocks : Nat := 0 + instructions : Nat := 0 + edges : Nat := 0 + flowWork : Nat := 0 + deriving BEq, ReflBEq, LawfulBEq, DecidableEq, Repr, Inhabited + +def Stats.add (left right : Stats) : Stats := + { declarations := left.declarations + right.declarations + functions := left.functions + right.functions + blocks := left.blocks + right.blocks + instructions := left.instructions + right.instructions + edges := left.edges + right.edges + flowWork := left.flowWork + right.flowWork } + +private abbrev Check := Except Error + +private def failAt (site : Site) (violation : Violation) (detail : String) : + Check α := + .error (.invalid site violation detail) + +private def checkLimit (site : Site) (resource : Resource) + (actual maximum : Nat) : Check Unit := + if actual ≤ maximum then + return () + else + .error (.limit site resource actual maximum) + +private def instructionSite (site : Site) (index : Nat) : Site := + { site with instruction := some index } + +private def foldIdxM (xs : List α) (initial : σ) + (step : Nat → σ → α → Check σ) : Check σ := + let rec go (index : Nat) (state : σ) : List α → Check σ + | [] => return state + | value :: rest => do + let state ← step index state value + go (index + 1) state rest + go 0 initial xs + +/-! ## Sparse last-use indexing for non-lexical borrow death -/ + +private abbrev LastUses := Std.HashMap ValueId Nat + +private def recordAtomUse (position : Nat) (uses : LastUses) : Atom → LastUses + | .reg id => uses.insert id position + | .lit _ | .erased => uses + +private def recordAtomUses (position : Nat) (uses : LastUses) + (atoms : Array Atom) : LastUses := + atoms.foldl (recordAtomUse position) uses + +private def recordEdgeUses (position : Nat) (uses : LastUses) + (edge : Edge) : LastUses := + recordAtomUses position uses edge.values + +private def recordInstrUses (position : Nat) (uses : LastUses) : + Instr → LastUses + | .move value => recordAtomUse position uses value + | .alloc _ _ args | .allocWith _ _ _ args => + recordAtomUses position uses args + | .discardCredit _ => uses + | .takeUnique target _ | .resetShared target _ | + .retainShared target | .releaseShared target | .dropUnique target | + .freeUnique target _ | .fetch target _ _ => + recordAtomUse position uses target + | .call _ args | .callSelf args | .papp _ args | .extern _ args => + recordAtomUses position uses args + | .apply function args => + recordAtomUses position (recordAtomUse position uses function) args + +private def recordTerminatorUses (position : Nat) (uses : LastUses) : + Terminator → LastUses + | .jump edge => recordEdgeUses position uses edge + | .switchValue scrutinee constructors natPeel => + let uses := recordAtomUse position uses scrutinee + let uses := constructors.foldl + (fun current alternative => recordEdgeUses position current alternative.edge) uses + match natPeel with + | none => uses + | some peel => + recordEdgeUses position (recordEdgeUses position uses peel.zero) peel.succ + | .branchCredit _ someEdge noneEdge => + recordEdgeUses position (recordEdgeUses position uses someEdge) noneEdge + | .ret value => recordAtomUse position uses value + | .tailCall _ args | .tailCallSelf args => recordAtomUses position uses args + +private def lastUses (block : Block) : LastUses := + let rec go (position : Nat) (uses : LastUses) : List Instr → LastUses + | [] => recordTerminatorUses position uses block.terminator + | instruction :: rest => + go (position + 1) (recordInstrUses position uses instruction) rest + go 0 {} block.instructions.toList + +/-! ## Capability-flow state -/ + +private structure Flow where + values : Array ValueCap + valueLive : Array Bool + credits : Array CreditCap + creditLive : Array Bool + lastUses : LastUses + loanLastUses : LastUses + position : Nat + +private def valueCapIsOwner : ValueCap → Bool + | .owned _ => true + | _ => false + +private def recordLoanLastUse (uses : LastUses) (loans : LastUses) + (id : ValueId) (capability : ValueCap) : LastUses := + match capability, uses.get? id with + | .borrowed _ (.value lender), some finalUse => + let previous := (loans.get? lender).getD 0 + loans.insert lender (max previous finalUse) + | _, _ => loans + +private def Flow.ofBlock (block : Block) (uses : LastUses) : Flow := + let loans := (List.range block.valueParams.size).foldl (fun current id => + match (block.valueParams)[id]? with + | some capability => recordLoanLastUse uses current id capability + | none => current) {} + { values := block.valueParams + valueLive := block.valueParams.map valueCapIsOwner + credits := block.creditParams + creditLive := block.creditParams.map fun _ => true + lastUses := uses + loanLastUses := loans + position := 0 } + +private def Flow.pushValue (limits : Limits) (site : Site) + (flow : Flow) (capability : ValueCap) : Check Flow := do + let size := flow.values.size + 1 + checkLimit site .valueRegisters size limits.maxValueRegisters + let id := flow.values.size + return { flow with + values := flow.values.push capability + valueLive := flow.valueLive.push (valueCapIsOwner capability) + loanLastUses := recordLoanLastUse flow.lastUses flow.loanLastUses id capability } + +private def Flow.pushCredit (limits : Limits) (site : Site) + (flow : Flow) (capability : CreditCap) : Check Flow := do + let size := flow.credits.size + 1 + checkLimit site .creditRegisters size limits.maxCreditRegisters + return { flow with + credits := flow.credits.push capability + creditLive := flow.creditLive.push true } + +private def Flow.liveValue (flow : Flow) (id : ValueId) : Bool := + ((flow.valueLive)[id]?).getD false + +private def Flow.liveCredit (flow : Flow) (id : CreditId) : Bool := + ((flow.creditLive)[id]?).getD false + +private def Flow.killValue (flow : Flow) (id : ValueId) : Flow := + { flow with valueLive := flow.valueLive.setIfInBounds id false } + +private def Flow.killCredit (flow : Flow) (id : CreditId) : Flow := + { flow with creditLive := flow.creditLive.setIfInBounds id false } + +private def readReg (site : Site) (flow : Flow) (id : ValueId) : + Check ValueCap := do + let capability ← match (flow.values)[id]? with + | none => failAt site .register s!"unknown value register {id}" + | some capability => pure capability + match capability with + | .scalar => return .scalar + | .owned world => + if flow.liveValue id then + return .owned world + else + failAt site .ownership s!"value register {id} has already been consumed" + | .borrowed world .caller => return .borrowed world .caller + | .borrowed world (.value lender) => + match (flow.values)[lender]? with + | some (.owned lenderWorld) => + if lenderWorld != world then + failAt site .borrow + s!"borrow {id} and lender {lender} have different worlds" + else if flow.liveValue lender then + return .borrowed world (.value lender) + else + failAt site .borrow s!"borrow {id} outlives lender {lender}" + | _ => failAt site .borrow s!"borrow {id} has no owning lender {lender}" + +private def readAtom (site : Site) (flow : Flow) : Atom → Check ValueCap + | .reg id => readReg site flow id + | .lit _ | .erased => return .scalar + +private def ensureNoLiveLoans (site : Site) (flow : Flow) (lender : ValueId) + (_remaining : List Instr) (_terminator : Terminator) : Check Unit := + if (flow.loanLastUses.get? lender).any fun finalUse => flow.position < finalUse then + failAt site .borrow s!"owner {lender} is consumed before its last loan use" + else + return () + +/-- Consume an argument for an owned interface. Scalars dynamically satisfy +either world and therefore carry no token. -/ +private def consumeExpected (site : Site) (flow : Flow) (value : Atom) + (expected : Owned) (remaining : List Instr) (terminator : Terminator) : + Check Flow := do + match value with + | .lit _ | .erased => return flow + | .reg id => + match ← readReg site flow id with + | .scalar => return flow + | .owned world => + if world != expected then + failAt site .ownership s!"value {id} has the wrong ownership world" + else + ensureNoLiveLoans site flow id remaining terminator + return flow.killValue id + | .borrowed _ _ => + failAt site .ownership s!"borrowed value {id} cannot transfer ownership" + +/-- Consume a concrete heap owner; unlike an interface argument, a scalar is +not accepted. -/ +private def consumeConcrete (site : Site) (flow : Flow) (value : Atom) + (expected : Owned) (remaining : List Instr) (terminator : Terminator) : + Check (Flow × ValueId) := do + match value with + | .reg id => + match ← readReg site flow id with + | .owned world => + if world != expected then + failAt site .ownership s!"value {id} has the wrong ownership world" + else + ensureNoLiveLoans site flow id remaining terminator + return (flow.killValue id, id) + | .scalar => failAt site .ownership "a constructor location was required" + | .borrowed _ _ => failAt site .ownership "a borrowed constructor cannot be consumed" + | .lit _ | .erased => failAt site .ownership "a constructor location was required" + +private def observeExpected (site : Site) (flow : Flow) (value : Atom) + (expected : Owned) : Check Unit := do + match ← readAtom site flow value with + | .scalar => return () + | .owned world | .borrowed world _ => + if world == expected then + return () + else + failAt site .ownership "observed value has the wrong ownership world" + +private def requireStaticScalar (site : Site) (flow : Flow) + (value : Atom) : Check Unit := do + match ← readAtom site flow value with + | .scalar => return () + | _ => failAt site .externBoundary "extern operands must be statically scalar" + +private def getCredit (site : Site) (flow : Flow) (id : CreditId) : + Check CreditCap := do + match (flow.credits)[id]? with + | none => failAt site .register s!"unknown credit register {id}" + | some capability => + if flow.liveCredit id then + return capability + else + failAt site .credit s!"credit register {id} has already been consumed" + +private def consumeCredit (site : Site) (flow : Flow) (id : CreditId) + (layout : Option LayoutId := none) : Check Flow := do + let capability ← getCredit site flow id + match layout with + | none => return flow.killCredit id + | some expected => + let actual := match capability with + | .required found | .optional found => found + if actual == expected then + return flow.killCredit id + else + failAt site .credit "reuse credit has an incompatible layout" + +private def lookupSchema (limits : Limits) (context : Context) (site : Site) + (world : Owned) (cid : CtorId) : Check CtorSchema := do + let schema ← match context.schemas world cid with + | none => failAt site .schema "missing constructor schema" + | some schema => pure schema + checkLimit site .operands schema.fields.size limits.maxOperands + if schema.fields.all fun fieldWorld => fieldWorld == world then + return schema + else + failAt site .schema "v0 constructor fields do not agree with their representation world" + +private def appendFields (limits : Limits) (site : Site) (flow : Flow) + (fields : Array Owned) : Check Flow := + fields.toList.foldlM + (fun current world => current.pushValue limits site (.owned world)) flow + +private abbrev DeclarationIndex := Std.HashMap Address Decl + +private def declarationIndex (declarations : List (Address × Decl)) : + DeclarationIndex := + declarations.foldl (fun index entry => index.insert entry.1 entry.2) {} + +private def declarationAt? (index : DeclarationIndex) (address : Address) : + Option Decl := + index.get? address + +private def duplicateAddress? : List (Address × Decl) → Option Address := + let rec go (seen : Std.HashMap Address Unit) : + List (Address × Decl) → Option Address + | [] => none + | (address, _) :: rest => + if (seen.get? address).isSome then some address + else go (seen.insert address ()) rest + go {} + +/-! ## Instruction transfer -/ + +private def checkOperandCount (limits : Limits) (site : Site) + (operands : Array α) : Check Unit := + checkLimit site .operands operands.size limits.maxOperands + +private def edgeSyntaxWork (edge : Edge) : Nat := + 1 + edge.values.size + edge.credits.size + +private def instructionSyntaxWork : Instr → Nat + | .alloc _ _ arguments | .allocWith _ _ _ arguments | + .call _ arguments | .callSelf arguments | .papp _ arguments | + .extern _ arguments => 1 + arguments.size + | .apply _ arguments => 2 + arguments.size + | _ => 2 + +private def terminatorSyntaxWork : Terminator → Nat + | .jump edge => edgeSyntaxWork edge + | .switchValue _ constructors natPeel => + 2 + constructors.size * constructors.size + + constructors.foldl (fun total alternative => + total + edgeSyntaxWork alternative.edge) 0 + + match natPeel with + | none => 0 + | some peel => edgeSyntaxWork peel.zero + edgeSyntaxWork peel.succ + | .branchCredit _ someEdge noneEdge => + 1 + edgeSyntaxWork someEdge + edgeSyntaxWork noneEdge + | .ret _ => 2 + | .tailCall _ arguments | .tailCallSelf arguments => 1 + arguments.size + +private def checkEdgeSyntaxBounds (limits : Limits) (site : Site) + (edge : Edge) : Check Unit := do + checkOperandCount limits site edge.values + checkOperandCount limits site edge.credits + +private def checkInstructionSyntaxBounds (limits : Limits) (site : Site) : + Instr → Check Unit + | .alloc _ _ arguments | .allocWith _ _ _ arguments | + .call _ arguments | .callSelf arguments | .papp _ arguments | + .extern _ arguments | .apply _ arguments => + checkOperandCount limits site arguments + | _ => return () + +private def checkTerminatorSyntaxBounds (limits : Limits) (site : Site) : + Terminator → Check Unit + | .jump edge => checkEdgeSyntaxBounds limits site edge + | .switchValue _ constructors natPeel => do + let alternatives := constructors.size + if natPeel.isSome then 2 else 0 + checkLimit site .alternatives alternatives limits.maxAlternatives + for alternative in constructors do + checkEdgeSyntaxBounds limits site alternative.edge + match natPeel with + | none => return () + | some peel => + checkEdgeSyntaxBounds limits site peel.zero + checkEdgeSyntaxBounds limits site peel.succ + | .branchCredit _ someEdge noneEdge => do + checkEdgeSyntaxBounds limits site someEdge + checkEdgeSyntaxBounds limits site noneEdge + | .ret _ => return () + | .tailCall _ arguments | .tailCallSelf arguments => + checkOperandCount limits site arguments + +private def checkBlockSyntaxBounds (limits : Limits) (site : Site) + (block : Block) : Check Nat := do + for instruction in block.instructions do + checkInstructionSyntaxBounds limits site instruction + checkTerminatorSyntaxBounds limits site block.terminator + let work := block.instructions.foldl + (fun total instruction => total + instructionSyntaxWork instruction) 0 + + terminatorSyntaxWork block.terminator + checkLimit site .flowWork work limits.maxFlowWork + return work + +private def consumeFieldArguments (limits : Limits) (site : Site) + (flow : Flow) (arguments : Array Atom) (fields : Array Owned) + (remaining : List Instr) (terminator : Terminator) : Check Flow := do + checkOperandCount limits site arguments + if arguments.size != fields.size then + failAt site .schema "constructor argument count does not match its schema" + else + (arguments.toList.zip fields.toList).foldlM + (fun current pair => + consumeExpected site current pair.1 pair.2 remaining terminator) flow + +private def checkCallArity (limits : Limits) (site : Site) + (arguments : Array Atom) (signature : Signature) : Check Unit := do + checkOperandCount limits site arguments + if arguments.size == signature.params.size then + return () + else + failAt site .call "call arity does not match the addressed signature" + +/-- Owned arguments are processed before borrowed arguments. Thus passing an +owner and one of its loans to the same call is rejected regardless of their +parameter order. -/ +private def checkCallArguments (limits : Limits) (site : Site) (flow : Flow) + (arguments : Array Atom) (signature : Signature) + (remaining : List Instr) (terminator : Terminator) : Check Flow := do + checkCallArity limits site arguments signature + let pairs := arguments.toList.zip signature.params.toList + let flow ← pairs.foldlM (fun current pair => + match pair.2.passing with + | .owned => + consumeExpected site current pair.1 pair.2.world remaining terminator + | .borrowed => return current) flow + pairs.foldlM (fun current pair => do + match pair.2.passing with + | .owned => return current + | .borrowed => + observeExpected site current pair.1 pair.2.world + return current) flow + +private def checkPapSignature (site : Site) (signature : Signature) : + Check Unit := + if signature.papSafe && signature.result == .shared && + signature.params.all fun parameter => + parameter.passing == .owned && parameter.world == .shared then + return () + else + failAt site .call "partial application target is not papSafe" + +private def consumePapArguments (limits : Limits) (site : Site) (flow : Flow) + (arguments : Array Atom) (signature : Signature) + (remaining : List Instr) (terminator : Terminator) : Check Flow := do + checkOperandCount limits site arguments + checkPapSignature site signature + if arguments.size < signature.params.size then + arguments.toList.foldlM + (fun current argument => + consumeExpected site current argument .shared remaining terminator) flow + else + failAt site .call "partial application must be strictly under-saturated" + +private def consumeApplyArguments (limits : Limits) (site : Site) (flow : Flow) + (function : Atom) (arguments : Array Atom) (remaining : List Instr) + (terminator : Terminator) : Check Flow := do + checkOperandCount limits site arguments + let flow ← consumeExpected site flow function .shared remaining terminator + arguments.toList.foldlM + (fun current argument => + consumeExpected site current argument .shared remaining terminator) flow + +private def ensureNoLiveCallCredit (site : Site) (flow : Flow) : Check Unit := + if flow.creditLive.any id then + failAt site .credit "reuse credits cannot remain live across a call boundary" + else + return () + +private def appendCallResult (limits : Limits) (site : Site) (flow : Flow) + (signature : Signature) : Check Flow := + flow.pushValue limits site (.owned signature.result) + +private def validateInstruction (policy : CreditPolicy) + (limits : Limits) (context : Context) + (declarations : DeclarationIndex) (signature : Signature) (site : Site) + (flow : Flow) (instruction : Instr) (remaining : List Instr) + (terminator : Terminator) : Check Flow := do + match instruction with + | .move value => + match value with + | .lit _ | .erased => flow.pushValue limits site .scalar + | .reg id => + match ← readReg site flow id with + | .scalar => flow.pushValue limits site .scalar + | .borrowed world lender => + flow.pushValue limits site (.borrowed world lender) + | .owned world => + ensureNoLiveLoans site flow id remaining terminator + (flow.killValue id).pushValue limits site (.owned world) + | .alloc world cid arguments => + let schema ← lookupSchema limits context site world cid + let flow ← consumeFieldArguments limits site flow arguments schema.fields + remaining terminator + flow.pushValue limits site (.owned world) + | .allocWith credit world cid arguments => + let schema ← lookupSchema limits context site world cid + let flow ← consumeCredit site flow credit (some schema.layout) + let flow ← consumeFieldArguments limits site flow arguments schema.fields + remaining terminator + flow.pushValue limits site (.owned world) + | .discardCredit credit => consumeCredit site flow credit + | .takeUnique target cid => + let schema ← lookupSchema limits context site .unique cid + let (flow, _) ← consumeConcrete site flow target .unique remaining terminator + let flow ← appendFields limits site flow schema.fields + flow.pushCredit limits site (.required schema.layout) + | .resetShared target cid => + let schema ← lookupSchema limits context site .shared cid + let (flow, _) ← consumeConcrete site flow target .shared remaining terminator + let flow ← appendFields limits site flow schema.fields + flow.pushCredit limits site (.optional schema.layout) + | .retainShared target => + match ← readAtom site flow target with + | .scalar => flow.pushValue limits site .scalar + | .owned .shared | .borrowed .shared _ => + flow.pushValue limits site (.owned .shared) + | .owned .unique | .borrowed .unique _ => + failAt site .ownership "retainShared requires a shared value" + | .releaseShared target => + consumeExpected site flow target .shared remaining terminator + | .dropUnique target => + consumeExpected site flow target .unique remaining terminator + | .freeUnique target cid => + let _ ← lookupSchema limits context site .unique cid + let (flow, id) ← consumeConcrete site flow target .unique remaining terminator + if context.scalarLeaves.any fun fact => + fact.owner == site.owner && fact.block == site.block && + fact.value == id && fact.cid == cid then + return flow + else + failAt site .schema "freeUnique requires an exact checked scalar-leaf fact" + | .fetch target cid field => + let capability ← readAtom site flow target + let (world, lender) ← match capability, target with + | .owned world, .reg id => pure (world, BorrowLender.value id) + | .borrowed world lender, _ => pure (world, lender) + | .scalar, _ => failAt site .ownership "fetch requires a constructor location" + | .owned _, _ => failAt site .register "an owned fetch target must be a register" + let schema ← lookupSchema limits context site world cid + match (schema.fields)[field]? with + | none => failAt site .schema s!"constructor field {field} is out of bounds" + | some fieldWorld => + flow.pushValue limits site (.borrowed fieldWorld lender) + | .call function arguments => + if policy == .callLocalV0 then ensureNoLiveCallCredit site flow + match declarationAt? declarations function with + | some (.fn definition) => + let flow ← checkCallArguments limits site flow arguments + definition.signature remaining terminator + appendCallResult limits site flow definition.signature + | some (.extern _) => + failAt site .call "extern declarations must use the extern instruction" + | none => failAt site .call "call target is not declared" + | .callSelf arguments => + if policy == .callLocalV0 then ensureNoLiveCallCredit site flow + let flow ← checkCallArguments limits site flow arguments + signature remaining terminator + appendCallResult limits site flow signature + | .papp function arguments => + ensureNoLiveCallCredit site flow + match declarationAt? declarations function with + | some (.fn definition) => + let flow ← consumePapArguments limits site flow arguments + definition.signature remaining terminator + flow.pushValue limits site (.owned .shared) + | some (.extern arity) => + if !context.allowExtern then + failAt site .externBoundary "extern partial applications are forbidden" + else if arguments.size >= arity then + failAt site .call "extern partial application must be under-saturated" + else + checkOperandCount limits site arguments + for argument in arguments do + requireStaticScalar site flow argument + flow.pushValue limits site (.owned .shared) + | none => failAt site .call "partial-application target is not declared" + | .apply function arguments => + ensureNoLiveCallCredit site flow + let flow ← consumeApplyArguments limits site flow function arguments + remaining terminator + flow.pushValue limits site (.owned .shared) + | .extern function arguments => + ensureNoLiveCallCredit site flow + if !context.allowExtern then + failAt site .externBoundary "extern instructions are forbidden" + else + match declarationAt? declarations function with + | some (.extern arity) => + checkOperandCount limits site arguments + if arguments.size != arity then + failAt site .call "extern arity does not match its declaration" + else + for argument in arguments do + requireStaticScalar site flow argument + flow.pushValue limits site .scalar + | some (.fn _) => failAt site .call "extern target is a compiler function" + | none => failAt site .call "extern target is not declared" + +/-! ## Edge transfer and terminators -/ + +private inductive IncomingValue where + | implicitScalar + | explicit (value : Atom) + +private inductive SourceRoot where + | caller + | local (id : ValueId) + deriving BEq + +private def incomingCapability (site : Site) (flow : Flow) : + IncomingValue → Check ValueCap + | .implicitScalar => return .scalar + | .explicit value => readAtom site flow value + +private def incomingSourceRoot (incoming : IncomingValue) + (capability : ValueCap) : Option SourceRoot := + match incoming, capability with + | .explicit (.reg id), .owned _ => some (.local id) + | _, .borrowed _ .caller => some .caller + | _, .borrowed _ (.value lender) => some (.local lender) + | _, _ => none + +private def validateBorrowMapping (site : Site) (flow : Flow) + (incoming : List IncomingValue) (parameters : Array ValueCap) + (argument : IncomingValue) (world : Owned) (lender : BorrowLender) : + Check Unit := do + let capability ← incomingCapability site flow argument + match capability with + | .scalar => return () + | .owned sourceWorld | .borrowed sourceWorld _ => + if sourceWorld != world then + failAt site .borrow "borrowed edge argument has the wrong world" + else + match lender with + | .caller => + match incomingSourceRoot argument capability with + | some .caller => return () + | _ => failAt site .borrow "a caller-rooted target borrow requires a caller-rooted source borrow" + | .value targetLender => + match (parameters)[targetLender]?, incoming[targetLender]? with + | some (.owned lenderWorld), some lenderArgument => + if lenderWorld != world then + failAt site .borrow "target borrow and lender parameters have different worlds" + else + let lenderCapability ← incomingCapability site flow lenderArgument + match incomingSourceRoot lenderArgument lenderCapability, + incomingSourceRoot argument capability with + | some (.local expected), some (.local actual) => + if expected == actual then return () + else failAt site .borrow "edge borrow does not map to its transferred lender" + | _, _ => failAt site .borrow "edge borrow requires a concrete transferred local lender" + | _, _ => failAt site .borrow "target borrow names a non-owning or missing parameter" + +private def validateIncomingValue (site : Site) (flow : Flow) + (incoming : List IncomingValue) (parameters : Array ValueCap) + (argument : IncomingValue) (parameter : ValueCap) : Check Unit := do + match argument, parameter with + | .implicitScalar, .scalar => return () + | .implicitScalar, _ => + failAt site .controlFlow "the Nat successor predecessor requires a scalar parameter" + | .explicit _, _ => + let capability ← incomingCapability site flow argument + match parameter with + | .scalar => + match capability with + | .scalar => return () + | _ => failAt site .controlFlow "a possibly heap-bearing value cannot enter a scalar block parameter" + | .owned world => + match capability with + | .scalar => return () + | .owned sourceWorld => + if sourceWorld == world then return () + else failAt site .ownership "edge owner has the wrong world" + | .borrowed _ _ => failAt site .ownership "a borrowed edge value cannot enter an owning parameter" + | .borrowed world lender => + validateBorrowMapping site flow incoming parameters argument world lender + +private def consumeIncomingOwner (site : Site) (flow : Flow) + (argument : IncomingValue) (parameter : ValueCap) : Check Flow := do + match parameter, argument with + | .owned _, .implicitScalar => return flow + | .owned world, .explicit value => + match value with + | .lit _ | .erased => return flow + | .reg id => + match ← readReg site flow id with + | .scalar => return flow + | .owned sourceWorld => + if sourceWorld == world then return flow.killValue id + else failAt site .ownership "edge owner has the wrong world" + | .borrowed _ _ => failAt site .ownership "a borrowed edge value cannot transfer ownership" + | _, _ => return flow + +private def consumeIncomingCredit (site : Site) (flow : Flow) + (id : CreditId) (parameter : CreditCap) : Check Flow := do + let source ← getCredit site flow id + match parameter, source with + | .required targetLayout, .required sourceLayout => + if targetLayout == sourceLayout then return flow.killCredit id + else failAt site .credit "required edge credit has the wrong layout" + | .required _, .optional _ => + failAt site .credit "an optional credit cannot narrow to required" + | .optional targetLayout, .required sourceLayout + | .optional targetLayout, .optional sourceLayout => + if targetLayout == sourceLayout then return flow.killCredit id + else failAt site .credit "optional edge credit has the wrong layout" + +private def ensureExhausted (site : Site) (flow : Flow) : Check Unit := + if flow.valueLive.any id then + failAt site .resources "control transfer leaves an owned value behind" + else if flow.creditLive.any id then + failAt site .resources "control transfer leaves a reuse credit behind" + else + return () + +private def validateEdge (limits : Limits) (site : Site) (blocks : Array Block) + (flow : Flow) (edge : Edge) (implicit : List IncomingValue := []) : + Check Unit := do + checkOperandCount limits site edge.values + checkOperandCount limits site edge.credits + let target ← match (blocks)[edge.target]? with + | none => failAt site .controlFlow s!"edge targets missing block {edge.target}" + | some block => pure block + let incoming := implicit ++ edge.values.toList.map IncomingValue.explicit + if incoming.length != target.valueParams.size then + failAt site .controlFlow "edge value arity does not match target parameters" + else if edge.credits.size != target.creditParams.size then + failAt site .controlFlow "edge credit arity does not match target parameters" + else + let valuePairs := incoming.zip target.valueParams.toList + for pair in valuePairs do + validateIncomingValue site flow incoming target.valueParams pair.1 pair.2 + let flow ← valuePairs.foldlM + (fun current pair => consumeIncomingOwner site current pair.1 pair.2) flow + let creditPairs := edge.credits.toList.zip target.creditParams.toList + let flow ← creditPairs.foldlM + (fun current pair => consumeIncomingCredit site current pair.1 pair.2) flow + ensureExhausted site flow + +private def duplicateCtor? : List CtorId → Option CtorId := + let rec go (seen : List CtorId) : List CtorId → Option CtorId + | [] => none + | cid :: rest => + if seen.any (· == cid) then some cid else go (cid :: seen) rest + go [] + +private def checkTailArguments (limits : Limits) (site : Site) (flow : Flow) + (arguments : Array Atom) (signature : Signature) + (remaining : List Instr) (terminator : Terminator) : Check Flow := do + checkCallArity limits site arguments signature + let pairs := arguments.toList.zip signature.params.toList + let flow ← pairs.foldlM (fun current pair => + match pair.2.passing with + | .owned => + consumeExpected site current pair.1 pair.2.world remaining terminator + | .borrowed => return current) flow + pairs.foldlM (fun current pair => do + match pair.2.passing with + | .owned => return current + | .borrowed => + match ← readAtom site current pair.1 with + | .scalar => return current + | .borrowed world .caller => + if world == pair.2.world then return current + else failAt site .borrow "tail borrow has the wrong world" + | .borrowed _ (.value _) => failAt site .borrow "a borrow rooted in a local owner cannot escape through a tail call" + | .owned _ => failAt site .borrow "an owned local value cannot enter a borrowed tail parameter") flow + +private def validateTerminator (limits : Limits) (context : Context) + (declarations : DeclarationIndex) (signature : Signature) (site : Site) + (blocks : Array Block) (flow : Flow) (terminator : Terminator) : + Check Nat := do + match terminator with + | .jump edge => + validateEdge limits site blocks flow edge + return 1 + | .switchValue scrutinee constructors natPeel => + let alternatives := constructors.size + if natPeel.isSome then 2 else 0 + checkLimit site .alternatives alternatives limits.maxAlternatives + if alternatives == 0 then + failAt site .controlFlow "switchValue requires at least one alternative" + else + match duplicateCtor? (constructors.toList.map (·.cid)) with + | some _ => failAt site .controlFlow "switchValue repeats a constructor identity" + | none => + let capability ← readAtom site flow scrutinee + match capability with + | .owned world | .borrowed world _ => + for alternative in constructors do + let _ ← lookupSchema limits context site world alternative.cid + pure () + | .scalar => pure () + for alternative in constructors do + validateEdge limits site blocks flow alternative.edge + match natPeel with + | none => pure () + | some peel => + validateEdge limits site blocks flow peel.zero + validateEdge limits site blocks flow peel.succ [.implicitScalar] + return alternatives + | .branchCredit credit someEdge noneEdge => + match ← getCredit site flow credit with + | .required _ => failAt site .credit "branchCredit requires an optional credit" + | .optional layout => + let someFlow := + { flow with credits := flow.credits.setIfInBounds credit (.required layout) } + validateEdge limits site blocks someFlow someEdge + validateEdge limits site blocks flow noneEdge + return 2 + | .ret value => + let flow ← consumeExpected site flow value signature.result [] terminator + ensureExhausted site flow + return 0 + | .tailCall function arguments => + ensureNoLiveCallCredit site flow + match declarationAt? declarations function with + | some (.fn definition) => + if definition.signature.result != signature.result then + failAt site .call "tail-call result world does not match the caller" + else + let flow ← checkTailArguments limits site flow arguments + definition.signature [] terminator + ensureExhausted site flow + return 0 + | some (.extern _) => failAt site .call "tailCall cannot target an extern" + | none => failAt site .call "tail-call target is not declared" + | .tailCallSelf arguments => + ensureNoLiveCallCredit site flow + let flow ← checkTailArguments limits site flow arguments signature [] terminator + ensureExhausted site flow + return 0 + +/-! ## Blocks, functions, and whole programs -/ + +private def expectedEntryParams (signature : Signature) : Array ValueCap := + signature.params.map fun parameter => + match parameter.passing with + | .owned => .owned parameter.world + | .borrowed => .borrowed parameter.world .caller + +private def validateBlockParams (limits : Limits) (site : Site) + (block : Block) : Check Unit := do + checkLimit site .valueParameters block.valueParams.size limits.maxValueParams + checkLimit site .creditParameters block.creditParams.size limits.maxCreditParams + for parameter in block.valueParams do + match parameter with + | .borrowed world (.value lender) => + match (block.valueParams)[lender]? with + | some (.owned lenderWorld) => + if lenderWorld == world then pure () + else failAt site .borrow "block borrow and lender have different worlds" + | _ => failAt site .borrow "block borrow names a non-owning parameter" + | _ => pure () + +private def validateBlock (policy : CreditPolicy) + (limits : Limits) (context : Context) + (declarations : DeclarationIndex) (signature : Signature) (owner : Owner) + (blocks : Array Block) (blockId : BlockId) (block : Block) : Check Stats := do + let site : Site := { owner, block := blockId } + validateBlockParams limits site block + checkLimit site .instructionsPerBlock block.instructions.size + limits.maxInstructionsPerBlock + checkLimit site .valueRegisters block.valueParams.size limits.maxValueRegisters + checkLimit site .creditRegisters block.creditParams.size limits.maxCreditRegisters + let syntaxWork ← checkBlockSyntaxBounds limits site block + let uses := lastUses block + let rec instructions (index : Nat) (flow : Flow) : List Instr → Check Flow + | [] => return flow + | instruction :: remaining => do + let flow := { flow with position := index } + let flow ← validateInstruction policy limits context declarations signature + (instructionSite site index) flow instruction remaining block.terminator + instructions (index + 1) flow remaining + let flow ← instructions 0 (Flow.ofBlock block uses) block.instructions.toList + let flow := { flow with position := block.instructions.size } + let flowWork := syntaxWork + flow.values.size + flow.credits.size + checkLimit site .flowWork flowWork limits.maxFlowWork + let edges ← validateTerminator limits context declarations signature site blocks flow + block.terminator + let stats : Stats := + { blocks := 1 + instructions := block.instructions.size + edges := edges + flowWork := flowWork } + return stats + +private def validateSignature (limits : Limits) (site : Site) + (signature : Signature) : Check Unit := do + checkLimit site .valueParameters signature.params.size limits.maxValueParams + if signature.papSafe then + checkPapSignature site signature + else + return () + +private def validateFunction (policy : CreditPolicy) + (limits : Limits) (context : Context) + (declarations : DeclarationIndex) (owner : Owner) + (definition : Function) : Check Stats := do + let entrySite : Site := { owner, block := 0 } + validateSignature limits entrySite definition.signature + if definition.blocks.isEmpty then + failAt entrySite .controlFlow "function has no entry block" + else + checkLimit entrySite .blocksPerFunction definition.blocks.size + limits.maxBlocksPerFunction + let entry := definition.blocks[0]! + if entry.valueParams != expectedEntryParams definition.signature then + failAt entrySite .signature "entry value parameters do not match the function signature" + else if !entry.creditParams.isEmpty then + failAt entrySite .signature "function entry cannot accept reuse credits" + else + let stats ← foldIdxM definition.blocks.toList ({} : Stats) fun blockId current block => do + let blockStats ← validateBlock policy limits context declarations definition.signature owner + definition.blocks blockId block + let current := Stats.add current blockStats + checkLimit entrySite .flowWork current.flowWork limits.maxFlowWork + return current + return { stats with functions := stats.functions + 1 } + +private def structuralBlockCount (program : Program) : Nat := + program.main.blocks.size + program.declarations.foldl (fun total entry => + match entry.2 with + | .fn definition => total + definition.blocks.size + | .extern _ => total) 0 + +/-- Validate under an explicit, versioned credit boundary. Suspended credits +remain in the caller's flow, so its continuation must consume or discard them +and every outgoing edge must transfer them linearly. Function entries accept +no credits under either policy. -/ +def validateWithPolicy (policy : CreditPolicy) + (limits : Limits) (context : Context) (program : Program) : + Except Error Stats := do + let programSite : Site := { owner := .main, block := 0 } + checkLimit programSite .declarations program.declarations.length + limits.maxDeclarations + checkLimit programSite .scalarLeafFacts context.scalarLeaves.length + limits.maxScalarLeafFacts + checkLimit programSite .blocks (structuralBlockCount program) limits.maxBlocks + let declarationWork := program.declarations.length * 2 + checkLimit programSite .flowWork declarationWork limits.maxFlowWork + if !program.main.signature.params.isEmpty then + failAt programSite .signature "the distinguished main function must be nullary" + else match duplicateAddress? program.declarations with + | some address => .error (.duplicateDeclaration address) + | none => + let declarations := declarationIndex program.declarations + let declarationStats ← program.declarations.foldlM (fun current entry => do + let next ← match entry.2 with + | .fn definition => + validateFunction policy limits context declarations (.declaration entry.1) definition + | .extern arity => + if !context.allowExtern then + failAt { owner := .declaration entry.1, block := 0 } + .externBoundary "extern declarations are forbidden" + else + checkLimit programSite .operands arity limits.maxOperands + return {} + let current := Stats.add current next + checkLimit programSite .flowWork current.flowWork limits.maxFlowWork + return current) ({} : Stats) + let mainStats ← validateFunction policy limits context declarations .main program.main + let overhead : Stats := + { declarations := program.declarations.length + flowWork := declarationWork } + let stats := Stats.add (Stats.add declarationStats mainStats) overhead + checkLimit programSite .flowWork stats.flowWork limits.maxFlowWork + return stats + +/-- The existing checker retains the original call-local contract. -/ +def validateWith (limits : Limits) (context : Context) (program : Program) : + Except Error Stats := + validateWithPolicy .callLocalV0 limits context program + +def validate (context : Context) (program : Program) : Except Error Stats := + validateWith defaultLimits context program + +/-- Proof-facing acceptance predicate for an explicitly bounded check. -/ +def ValidWith (limits : Limits) (context : Context) (program : Program) : Prop := + ∃ stats, validateWith limits context program = .ok stats + +def Valid (context : Context) (program : Program) : Prop := + ValidWith defaultLimits context program + +/-- A checker result packaged with the equation consumed by later proofs. -/ +structure Checked (limits : Limits) (context : Context) (program : Program) where + stats : Stats + accepted : validateWith limits context program = .ok stats + +/-- Versioned acceptance retains the exact policy as part of its type. -/ +structure CheckedWithPolicy (policy : CreditPolicy) (limits : Limits) + (context : Context) (program : Program) where + stats : Stats + accepted : validateWithPolicy policy limits context program = .ok stats + +def Checked.withPolicy {limits : Limits} {context : Context} {program : Program} + (checked : Checked limits context program) : + CheckedWithPolicy .callLocalV0 limits context program := + ⟨checked.stats, checked.accepted⟩ + +end Ix.Compiler.IxIR2.Validate diff --git a/Ix/Compiler/IxIR2/ValidateExamples.lean b/Ix/Compiler/IxIR2/ValidateExamples.lean new file mode 100644 index 000000000..198cb3373 --- /dev/null +++ b/Ix/Compiler/IxIR2/ValidateExamples.lean @@ -0,0 +1,530 @@ +import Ix.Compiler.IxIR2.Validate + +/-! +# Executable IxIR₂ validator fixtures + +These guards are intentionally small enough to audit by eye. Together they +pin the accepted credit paths and the major fail-closed ownership boundaries. +-/ + +namespace Ix.Compiler.IxIR2.Validate.Examples + +open Ix.Compiler.Ixon (Address Owned) +open Ix.Compiler.IxIR2 + +private def blockAddress : Address := Address.replicate 0x21 +private def functionAddress : Address := Address.replicate 0x31 +private def harnessAddress : Address := Address.replicate 0x32 +private def externAddress : Address := Address.replicate 0x41 +private def uniqueLayout : LayoutId := Address.replicate 0x51 +private def sharedLayout : LayoutId := Address.replicate 0x52 +private def otherLayout : LayoutId := Address.replicate 0x53 + +private def nodeCtor : CtorId := + { block := blockAddress, indIdx := 0, cidx := 0 } + +private def otherCtor : CtorId := + { block := blockAddress, indIdx := 0, cidx := 1 } + +private def schemas : Owned → CtorId → Option CtorSchema + | .unique, cid => + if cid == nodeCtor then + some { layout := uniqueLayout, fields := #[.unique] } + else if cid == otherCtor then + some { layout := otherLayout, fields := #[.unique] } + else + none + | .shared, cid => + if cid == nodeCtor then + some { layout := sharedLayout, fields := #[.shared] } + else + none + +private def context : Context := { schemas } + +private def unarySignature (world : Owned) : Signature := + { params := #[{ world, passing := .owned }] + result := world + papSafe := false } + +private def nullarySignature (result : Owned := .shared) : Signature := + { params := #[], result, papSafe := false } + +/-- Keep the inner ownership fixtures unary and auditably small while checking +them as genuine nullary-main programs. -/ +private def closeFixture (program : Program) : Program := + match program.main.signature.params with + | #[{ world, passing := .owned }] => + { declarations := (harnessAddress, .fn program.main) :: program.declarations + main := + { signature := nullarySignature program.main.signature.result + blocks := #[ + { valueParams := #[] + creditParams := #[] + instructions := #[ + .alloc world nodeCtor #[.lit (.nat 0)], + .call harnessAddress #[.reg 0]] + terminator := .ret (.reg 1) }] } } + | _ => program + +private def accepts (program : Program) : Bool := + match validate context (closeFixture program) with + | .ok _ => true + | .error _ => false + +private def rejectsAs (violation : Violation) (program : Program) : Bool := + match validate context (closeFixture program) with + | .error (.invalid _ actual _) => actual == violation + | _ => false + +/-! A complete owner transfer across an ordinary two-block edge. -/ + +private def simpleJump : Program := + { declarations := [] + main := + { signature := unarySignature .unique + blocks := #[ + { valueParams := #[.owned .unique] + creditParams := #[] + instructions := #[] + terminator := .jump + { target := 1, values := #[.reg 0], credits := #[] } }, + { valueParams := #[.owned .unique] + creditParams := #[] + instructions := #[] + terminator := .ret (.reg 0) }] } } + +#guard accepts simpleJump + +#guard match validate context simpleJump with + | .error (.invalid _ .signature _) => true + | _ => false + +/-! Required credit: destructive take, exact-layout reuse, return. -/ + +private def requiredReuse : Program := + { declarations := [] + main := + { signature := unarySignature .unique + blocks := #[ + { valueParams := #[.owned .unique] + creditParams := #[] + instructions := #[ + .takeUnique (.reg 0) nodeCtor, + .allocWith 0 .unique nodeCtor #[.reg 1]] + terminator := .ret (.reg 2) }] } } + +#guard accepts requiredReuse + +private def discardTakenCredit : Program := + { declarations := [] + main := + { signature := unarySignature .unique + blocks := #[ + { valueParams := #[.owned .unique] + creditParams := #[] + instructions := #[ + .takeUnique (.reg 0) nodeCtor, + .discardCredit 0] + terminator := .ret (.reg 1) }] } } + +#guard accepts discardTakenCredit + +/-! Optional shared reset: the some branch refines to required, both paths +widen at the join, and `allocWith` consumes the joined optional credit. -/ + +private def optionalDiamond : Program := + { declarations := [] + main := + { signature := unarySignature .shared + blocks := #[ + { valueParams := #[.owned .shared] + creditParams := #[] + instructions := #[.resetShared (.reg 0) nodeCtor] + terminator := .branchCredit 0 + { target := 1, values := #[.reg 1], credits := #[0] } + { target := 2, values := #[.reg 1], credits := #[0] } }, + { valueParams := #[.owned .shared] + creditParams := #[.required sharedLayout] + instructions := #[] + terminator := .jump + { target := 3, values := #[.reg 0], credits := #[0] } }, + { valueParams := #[.owned .shared] + creditParams := #[.optional sharedLayout] + instructions := #[] + terminator := .jump + { target := 3, values := #[.reg 0], credits := #[0] } }, + { valueParams := #[.owned .shared] + creditParams := #[.optional sharedLayout] + instructions := #[.allocWith 0 .shared nodeCtor #[.reg 0]] + terminator := .ret (.reg 1) }] } } + +#guard accepts optionalDiamond + +/-! One dynamic IxIR₁ scrutinee can select a constructor edge or a peeled Nat +edge. The successor block receives its implicit predecessor first. -/ + +private def combinedSwitch : Program := + { declarations := [] + main := + { signature := unarySignature .unique + blocks := #[ + { valueParams := #[.owned .unique] + creditParams := #[] + instructions := #[] + terminator := .switchValue (.reg 0) + #[{ cid := nodeCtor + edge := { target := 1, values := #[.reg 0], credits := #[] } }] + (some + { zero := { target := 1, values := #[.reg 0], credits := #[] } + succ := { target := 2, values := #[.reg 0], credits := #[] } }) }, + { valueParams := #[.owned .unique] + creditParams := #[] + instructions := #[] + terminator := .ret (.reg 0) }, + { valueParams := #[.scalar, .owned .unique] + creditParams := #[] + instructions := #[] + terminator := .ret (.reg 1) }] } } + +#guard accepts combinedSwitch + +/-! Self calls use the containing signature, and tail-self transfer leaves no +local owner behind. -/ + +private def selfCall : Program := + { declarations := [] + main := + { signature := unarySignature .unique + blocks := #[ + { valueParams := #[.owned .unique] + creditParams := #[] + instructions := #[.callSelf #[.reg 0]] + terminator := .ret (.reg 1) }] } } + +private def tailSelf : Program := + { declarations := [] + main := + { signature := unarySignature .unique + blocks := #[ + { valueParams := #[.owned .unique] + creditParams := #[] + instructions := #[] + terminator := .tailCallSelf #[.reg 0] }] } } + +#guard accepts selfCall +#guard accepts tailSelf + +private def loopAndTailSelf : Program := + { declarations := [] + main := + { signature := unarySignature .unique + blocks := #[ + { valueParams := #[.owned .unique] + creditParams := #[] + instructions := #[] + terminator := .jump + { target := 1, values := #[.reg 0], credits := #[] } }, + { valueParams := #[.owned .unique] + creditParams := #[] + instructions := #[] + terminator := .switchValue (.reg 0) + #[{ cid := nodeCtor + edge := { target := 1, values := #[.reg 0], credits := #[] } }] + (some + { zero := { target := 2, values := #[.reg 0], credits := #[] } + succ := { target := 3, values := #[.reg 0], credits := #[] } }) }, + { valueParams := #[.owned .unique] + creditParams := #[] + instructions := #[] + terminator := .tailCallSelf #[.reg 0] }, + { valueParams := #[.scalar, .owned .unique] + creditParams := #[] + instructions := #[] + terminator := .tailCallSelf #[.reg 1] }] } } + +#guard accepts loopAndTailSelf + +private def borrowedCallee : Function := + { signature := + { params := #[{ world := .unique, passing := .borrowed }] + result := .unique + papSafe := false } + blocks := #[ + { valueParams := #[.borrowed .unique .caller] + creditParams := #[] + instructions := #[] + terminator := .ret (.lit (.nat 0)) }] } + +private def directBorrowedCall : Program := + { declarations := [(functionAddress, .fn borrowedCallee)] + main := + { signature := unarySignature .unique + blocks := #[ + { valueParams := #[.owned .unique] + creditParams := #[] + instructions := #[ + .call functionAddress #[.reg 0], + .dropUnique (.reg 0)] + terminator := .ret (.reg 1) }] } } + +#guard accepts directBorrowedCall + +/-! The leaf sidecar is exact in owner, block, value, and constructor. -/ + +private def scalarLeafContext : Context := + { schemas + scalarLeaves := + [{ owner := .declaration harnessAddress + block := 0 + value := 0 + cid := nodeCtor }] } + +private def scalarLeafFree : Program := + { declarations := [] + main := + { signature := unarySignature .unique + blocks := #[ + { valueParams := #[.owned .unique] + creditParams := #[] + instructions := #[.freeUnique (.reg 0) nodeCtor] + terminator := .ret (.lit (.nat 0)) }] } } + +#guard match validate scalarLeafContext (closeFixture scalarLeafFree) with + | .ok _ => true + | .error _ => false + +/-! ## Fail-closed fixtures -/ + +private def duplicateCredit : Program := + { declarations := [] + main := + { signature := unarySignature .unique + blocks := #[ + { valueParams := #[.owned .unique] + creditParams := #[] + instructions := #[.takeUnique (.reg 0) nodeCtor] + terminator := .jump + { target := 1, values := #[.reg 1], credits := #[0, 0] } }, + { valueParams := #[.owned .unique] + creditParams := #[.required uniqueLayout, .required uniqueLayout] + instructions := #[.discardCredit 0, .discardCredit 1] + terminator := .ret (.reg 0) }] } } + +#guard rejectsAs .credit duplicateCredit + +private def liveCreditAtReturn : Program := + { declarations := [] + main := + { signature := unarySignature .unique + blocks := #[ + { valueParams := #[.owned .unique] + creditParams := #[] + instructions := #[.takeUnique (.reg 0) nodeCtor] + terminator := .ret (.reg 1) }] } } + +#guard rejectsAs .resources liveCreditAtReturn + +private def liveCreditAtCall : Program := + { declarations := + [(functionAddress, + .fn + { signature := unarySignature .unique + blocks := #[ + { valueParams := #[.owned .unique] + creditParams := #[] + instructions := #[] + terminator := .ret (.reg 0) }] })] + main := + { signature := unarySignature .unique + blocks := #[ + { valueParams := #[.owned .unique] + creditParams := #[] + instructions := #[ + .takeUnique (.reg 0) nodeCtor, + .call functionAddress #[.reg 1]] + terminator := .ret (.reg 2) }] } } + +#guard rejectsAs .credit liveCreditAtCall + +private def useAfterTake : Program := + { declarations := [] + main := + { signature := unarySignature .unique + blocks := #[ + { valueParams := #[.owned .unique] + creditParams := #[] + instructions := #[ + .takeUnique (.reg 0) nodeCtor, + .move (.reg 0)] + terminator := .ret (.reg 1) }] } } + +#guard rejectsAs .ownership useAfterTake + +private def consumeLiveLender : Program := + { declarations := [] + main := + { signature := unarySignature .unique + blocks := #[ + { valueParams := #[.owned .unique] + creditParams := #[] + instructions := #[ + .fetch (.reg 0) nodeCtor 0, + .dropUnique (.reg 0), + .move (.reg 1)] + terminator := .ret (.lit (.nat 0)) }] } } + +#guard rejectsAs .borrow consumeLiveLender + +private def incompatibleLayout : Program := + { declarations := [] + main := + { signature := unarySignature .unique + blocks := #[ + { valueParams := #[.owned .unique] + creditParams := #[] + instructions := #[ + .takeUnique (.reg 0) nodeCtor, + .allocWith 0 .unique otherCtor #[.reg 1]] + terminator := .ret (.reg 2) }] } } + +#guard rejectsAs .credit incompatibleLayout + +private def optionalToRequired : Program := + { declarations := [] + main := + { signature := unarySignature .shared + blocks := #[ + { valueParams := #[.owned .shared] + creditParams := #[] + instructions := #[.resetShared (.reg 0) nodeCtor] + terminator := .jump + { target := 1, values := #[.reg 1], credits := #[0] } }, + { valueParams := #[.owned .shared] + creditParams := #[.required sharedLayout] + instructions := #[.discardCredit 0] + terminator := .ret (.reg 0) }] } } + +#guard rejectsAs .credit optionalToRequired + +private def missingTarget : Program := + { declarations := [] + main := + { signature := unarySignature .unique + blocks := #[ + { valueParams := #[.owned .unique] + creditParams := #[] + instructions := #[] + terminator := .jump + { target := 7, values := #[.reg 0], credits := #[] } }] } } + +#guard rejectsAs .controlFlow missingTarget + +private def malformedNatSuccessor : Program := + { declarations := [] + main := + { signature := unarySignature .unique + blocks := #[ + { valueParams := #[.owned .unique] + creditParams := #[] + instructions := #[] + terminator := .switchValue (.reg 0) #[] + (some + { zero := { target := 1, values := #[.reg 0], credits := #[] } + succ := { target := 2, values := #[.reg 0], credits := #[] } }) }, + { valueParams := #[.owned .unique] + creditParams := #[] + instructions := #[] + terminator := .ret (.reg 0) }, + { valueParams := #[.owned .unique, .owned .unique] + creditParams := #[] + instructions := #[] + terminator := .ret (.reg 1) }] } } + +#guard rejectsAs .controlFlow malformedNatSuccessor + +private def borrowedTailEscape : Program := + { declarations := + [(functionAddress, + .fn + { signature := + { params := #[{ world := .unique, passing := .borrowed }] + result := .unique + papSafe := false } + blocks := #[ + { valueParams := #[.borrowed .unique .caller] + creditParams := #[] + instructions := #[] + terminator := .ret (.lit (.nat 0)) }] })] + main := + { signature := unarySignature .unique + blocks := #[ + { valueParams := #[.owned .unique] + creditParams := #[] + instructions := #[.fetch (.reg 0) nodeCtor 0] + terminator := .tailCall functionAddress #[.reg 1] }] } } + +#guard rejectsAs .borrow borrowedTailEscape + +private def mismatchedTailResult : Program := + { declarations := + [(functionAddress, + .fn + { signature := nullarySignature .unique + blocks := #[ + { valueParams := #[] + creditParams := #[] + instructions := #[] + terminator := .ret .erased }] })] + main := + { signature := nullarySignature .shared + blocks := #[ + { valueParams := #[] + creditParams := #[] + instructions := #[] + terminator := .tailCall functionAddress #[] }] } } + +#guard rejectsAs .call mismatchedTailResult + +private def borrowedDynamicEntry : Program := + { declarations := [(functionAddress, .fn borrowedCallee)] + main := + { signature := unarySignature .unique + blocks := #[ + { valueParams := #[.owned .unique] + creditParams := #[] + instructions := #[.papp functionAddress #[]] + terminator := .ret (.reg 1) }] } } + +#guard rejectsAs .call borrowedDynamicEntry + +private def borrowedReturn : Program := + { declarations := [] + main := + { signature := unarySignature .unique + blocks := #[ + { valueParams := #[.owned .unique] + creditParams := #[] + instructions := #[.fetch (.reg 0) nodeCtor 0] + terminator := .ret (.reg 1) }] } } + +#guard rejectsAs .ownership borrowedReturn + +private def forbiddenExtern : Program := + { declarations := [(externAddress, .extern 0)] + main := + { signature := nullarySignature + blocks := #[ + { valueParams := #[] + creditParams := #[] + instructions := #[.extern externAddress #[]] + terminator := .ret (.reg 0) }] } } + +#guard rejectsAs .externBoundary forbiddenExtern + +#guard match validateWith { defaultLimits with maxBlocks := 1 } context + (closeFixture simpleJump) with + | .error (.limit _ .blocks 3 1) => true + | _ => false + +end Ix.Compiler.IxIR2.Validate.Examples diff --git a/Ix/Compiler/Ixon/Address.lean b/Ix/Compiler/Ixon/Address.lean new file mode 100644 index 000000000..b52a47557 --- /dev/null +++ b/Ix/Compiler/Ixon/Address.lean @@ -0,0 +1,214 @@ +import Ix.Compiler.Ixon.Serialize + +/-! +# Content addresses + +32-byte blake3 hashes of canonical artifact serializations. Ixon identity +follows ix's `docs/Ixon.md` and `docs/kernel_identity.md`; backend IRs have +independently versioned domains. This module is the pure data side; +`Ix.Compiler.Ixon.Hash` supplies BLAKE3 computation through the current FFI +ledger entry. +-/ + +namespace Ix.Compiler.Ixon + +/-- A content address whose 32-byte wire invariant is enforced by the type. -/ +structure Address where + hash : ByteArray + hash_size : hash.size = 32 + deriving DecidableEq + +namespace Address + +/-- Construct an address from a function over its 32 byte positions. -/ +def ofFn (f : Fin 32 → UInt8) : Address := + ⟨⟨Array.ofFn f⟩, by simp [ByteArray.size]⟩ + +/-- Construct a test/scaffolding address by repeating one byte. -/ +def replicate (b : UInt8) : Address := + ofFn fun _ => b + +/-- Read one of an address's 32 bytes. -/ +def get (a : Address) (i : Fin 32) : UInt8 := + a.hash[i.val]'(a.hash_size.symm ▸ i.isLt) + +/-- Synthetic address for member `idx` of a mutual block. This is shared by +the source evaluator's opaque-member oracle identity and the erased program's +environment key. It remains v1 scaffolding until members receive real content +addresses. -/ +def memberAddr (block : Address) (idx : Nat) : Address := + ofFn fun i => + if i.val < 24 then block.get i + else block.get i ^^^ + UInt8.ofNat (((idx + 1) >>> (8 * (i.val - 24))) % 256) + +/-- Lowercase fixed-width hexadecimal, matching ix's catalog/report spelling. -/ +def toHex (a : Address) : String := + a.hash.data.foldl (fun output byte => + output ++ hexDigitRepr (byte.toNat / 16) ++ + hexDigitRepr (byte.toNat % 16)) "" + +@[simp] theorem data_ofFn (f : Fin 32 → UInt8) : + (ofFn f).hash.data = Array.ofFn f := by + rfl + +@[simp] theorem get_mk (data : Array UInt8) (h : data.size = 32) + (i : Fin 32) : + (Address.mk ⟨data⟩ h).get i = data[i.val]'(by omega) := by + rfl + +@[simp] theorem get_ofFn (f : Fin 32 → UInt8) (i : Fin 32) : + (ofFn f).get i = f i := by + rw [show ofFn f = Address.mk ⟨Array.ofFn f⟩ + (by simp [ByteArray.size]) from rfl] + rw [get_mk] + rw [Array.getElem_ofFn] + +@[simp] theorem memberAddr_get (block : Address) (idx : Nat) (i : Fin 32) : + (memberAddr block idx).get i = + if i.val < 24 then block.get i + else block.get i ^^^ + UInt8.ofNat (((idx + 1) >>> (8 * (i.val - 24))) % 256) := by + simp [memberAddr] + +@[simp] theorem get_replicate (b : UInt8) (i : Fin 32) : + (replicate b).get i = b := by + rw [show replicate b = + Address.mk ⟨Array.ofFn (fun _ : Fin 32 => b)⟩ + (by simp [ByteArray.size]) from rfl] + rw [get_mk] + rw [Array.getElem_ofFn] + +/-- Construct from a byte array, checking the length. -/ +def ofBytes? (bytes : ByteArray) : Option Address := + if h : bytes.size = 32 then some ⟨bytes, h⟩ else none + +end Address + +instance : Inhabited Address := ⟨Address.replicate 0⟩ + +instance : BEq Address := ⟨fun a b => a.hash.data == b.hash.data⟩ + +instance : Hashable Address := ⟨fun a => hash a.hash.data⟩ + +instance : Repr Address := + ⟨fun a _ => "Address " ++ repr a.hash.data⟩ + +instance : ToString Address := ⟨Address.toHex⟩ + +instance : Serialize Address where + put a := putBytes a.hash + get := do + let bytes ← getBytes 32 + match Address.ofBytes? bytes with + | some a => return a + | none => throw "internal: getBytes returned a non-32-byte address" + +namespace Address + +/-- Address equality reflected by the compact byte-array `BEq` instance. -/ +theorem eq_of_beq {a b : Address} (h : (a == b) = true) : a = b := by + cases a with + | mk ah ahs => + cases b with + | mk bh bhs => + simp only [BEq.beq] at h + have hab : ah.data = bh.data := (beq_iff_eq).mp h + have : ah = bh := ByteArray.ext hab + cases this + rfl + +instance : ReflBEq Address where + rfl := by + intro address + change (address.hash.data == address.hash.data) = true + exact (beq_iff_eq).mpr rfl + +instance : LawfulBEq Address where + eq_of_beq := Address.eq_of_beq + +theorem ofBytes?_hash (a : Address) : Address.ofBytes? a.hash = some a := by + cases a with + | mk hash hash_size => + simp [Address.ofBytes?, hash_size] + +theorem put_spec (a : Address) : + PutSpec (Serialize.put a) a.hash := by + exact putBytes_spec a.hash + +theorem get_spec (a : Address) : + GetSpec (Serialize.get (self := inferInstance) : GetM Address) a.hash a := by + intro pre suffix + change (do + let bytes ← getBytes 32 + match Address.ofBytes? bytes with + | some a => return a + | none => throw "internal: getBytes returned a non-32-byte address").run + ⟨pre ++ a.hash ++ suffix, pre.size⟩ = _ + simp only [StateT.run_bind] + have hread := getBytes_spec a.hash pre suffix + rw [a.hash_size] at hread + rw [hread] + simp only [bind, Except.bind] + rw [ofBytes?_hash] + simp [a.hash_size] + rfl + +/-- The fixed-width address codec decodes every address it encodes. -/ +theorem roundtripLaw : Ixon.RoundtripLaw Address := by + intro a + change runGet Serialize.get (runPut (Serialize.put a)) = .ok a + rw [runPut_eq_of_spec (put_spec a)] + exact runGet_eq_ok_of_spec (get_spec a) + +/-- Every accepted address byte string is its unique 32-byte spelling. -/ +theorem canonicalLaw : Ixon.CanonicalLaw Address := by + intro input a h + change runPut (Serialize.put a) = input + rw [runPut_eq_of_spec (put_spec a)] + change runGet (do + let bytes ← getBytes 32 + match Address.ofBytes? bytes with + | some a => return a + | none => throw "internal: getBytes returned a non-32-byte address") input = .ok a at h + by_cases hlen : 32 ≤ input.size + · have hextract : (input.extract 0 32).size = 32 := by + simp [ByteArray.size_extract, hlen] + simp [runGet, getBytes, hlen, Address.ofBytes?, hextract] at h + by_cases hfull : 32 = input.size + · simp only [hfull, if_pos] at h + change Except.ok _ = Except.ok a at h + cases h + have hall := ByteArray.extract_append_eq_right + (a := ByteArray.empty) (b := input) (i := 0) (j := input.size) + (by simp) (by simp) + exact hall + · simp only [hfull] at h + change (Except.error _ : Except String Address) = Except.ok a at h + contradiction + · simp [runGet, getBytes, hlen] at h + change (Except.error _ : Except String Address) = Except.ok a at h + contradiction + +end Address + +/-! Elaboration-time invariant and codec checks. -/ + +private def bytes (n : Nat) (b : UInt8) : ByteArray := + ⟨(List.replicate n b).toArray⟩ + +#guard (Address.ofBytes? (bytes 31 0xAA)).isNone +#guard (Address.ofBytes? (bytes 32 0xAA)).isSome +#guard (Address.ofBytes? (bytes 33 0xAA)).isNone + +#guard ser (Address.replicate 0xAB) == bytes 32 0xAB + +private def rejects (input : ByteArray) : Bool := + match (de input : Except String Address) with + | .ok _ => false + | .error _ => true + +#guard rejects (bytes 31 0xAB) +#guard rejects (bytes 33 0xAB) + +end Ix.Compiler.Ixon diff --git a/Ix/Compiler/Ixon/Catalog.lean b/Ix/Compiler/Ixon/Catalog.lean new file mode 100644 index 000000000..7aeec9a6f --- /dev/null +++ b/Ix/Compiler/Ixon/Catalog.lean @@ -0,0 +1,770 @@ +import Ix.Compiler.Ixon.Merkle +import Ix.Compiler.Ixon.Sharing +import Ix.Compiler.AddressEnv + +/-! +# Resource-bounded ix catalog ingress + +An ix `.ixc` is a directory containing a binary `manifest` and either one +`